1 * ***********************************************************
2 * * *
3 * * Copyright, C Honeywell Information Systems Inc., 1982 *
4 * * *
5 * * Copyright c 1972 by Massachusetts Institute of *
6 * * Technology and Honeywell Information Systems, Inc. *
7 * * *
8 * ***********************************************************
9
10 lbl ,bsc_tables
11 ttl bsc_tables -- tables for bisync line type
12 editp on
13 pcc off
14 pmc off
15 detail off
16 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
17 *
18 * bsc_tables
19 *
20 * these tables are designed to run all types of bisync line
21 * discipline - ascii and ebcdic, transparent and non-
22 * transparent.
23 *
24 * coded by bob adsit may 1976
25 * completed and debugged by Larry Johnson, November 1976
26 * modified: 23 November 1980 by G. Palter to fix a bug
27 * which caused FNP crashes with a store fault
28 *
29 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
30 rem
31 bsc null
32 rem
33 symdef bsc
34 symdef bscstr
35 symdef bscacu return from autocall
36 symdef bsctst bisync test state handler
37 symdef bscwt write w/o recieve mode
38 symdef bscwtr write with recieve mocd
39 symdef bscrd read routine
40 symdef bsccki check input routine
41 symdef bsccko check output routine
42 symdef bscswa switch acks routine
43 symdef bscbad report bad block subroutine
44 symdef bshang when line hangs up
45 rem
46 symref begin
47 symref hungup
48 symref frebfh subroutine to free a buffer
49 symref setbpt subroutine to set buffer pte
50 symref cvabs subroutine to 'absolutize' an address
51 symref cvaddr subroutine to convert a tib extension address
52 symref st3270 start of 3270 control tables
53 symref sthasp start of hasp control tables
54 symref acutst make autocall
55 rem
56 pmc save,on
57 cctdef
58 rem
59 ct.bcc equ ct.t2s+ct.sw+ct.tb4
60 rem
61 base 64
62 rem
63 cct.ab null * cct for ascii binary synchronous devices
64 rem * table 0 - non transparent text and control sequences
65 rem
66 vfd 9/ct.ncs,9/ct.ncs * 000 001
67 vfd 9/ct.ncs,9/ct.etx * 002 etx
68 vfd 9/ct.nak,9/ct.nak * eot enq
69 vfd 9/ct.ncs,9/ct.ncs * 006 007
70 vfd 9/ct.ncs,9/ct.ncs * 010 011
71 vfd 9/ct.ncs,9/ct.ncs * 012 013
72 vfd 9/ct.ncs,9/ct.ncs * 014 015
73 vfd 9/ct.ncs,9/ct.ncs * 016 017
74 vfd 9/ct.tb1,9/ct.ncs * dle 021
75 vfd 9/ct.ncs,9/ct.ncs * 022 023
76 vfd 9/ct.ncs,9/ct.nak * 024 nak
77 vfd 9/ct.ign,9/ct.etx * 026 etb
78 vfd 9/ct.ncs,9/ct.ncs * 030 031
79 vfd 9/ct.ncs,9/ct.ncs * 032 033
80 vfd 9/ct.ncs,9/ct.ncs * 034 035
81 vfd 9/ct.ncs,9/ct.itb * 036 itb
82 rem
83 rem
84 dup 1,48
85 vfd 9/ct.ncs,9/ct.ncs
86 rem
87 rem * table 1 - looking at character following dle
88 rem
89 vfd 9/ct.ncs,9/ct.ncs * 000 001
90 vfd 9/ct.stx,9/ct.nak * stx etx
91 vfd 9/ct.nak,9/ct.nak * eot enq
92 vfd 9/ct.ncs,9/ct.ncs * 006 007
93 vfd 9/ct.ncs,9/ct.ncs * 010 011
94 vfd 9/ct.ncs,9/ct.ncs * 012 013
95 vfd 9/ct.ncs,9/ct.ncs * 014 015
96 vfd 9/ct.ncs,9/ct.ncs * 016 017
97 vfd 9/ct.ncs,9/ct.ncs * 020 021
98 vfd 9/ct.ncs,9/ct.ncs * 022 023
99 vfd 9/ct.ncs,9/ct.ncs * 024 025
100 vfd 9/ct.ncs,9/ct.nak * 026 etb
101 vfd 9/ct.ncs,9/ct.ncs * 030 031
102 vfd 9/ct.ncs,9/ct.ncs * 032 033
103 vfd 9/ct.ncs,9/ct.ncs * 034 035
104 vfd 9/ct.ncs,9/ct.mtb * 036 itb
105 vfd 9/ct.ncs,9/ct.ncs * 040 041
106 vfd 9/ct.ncs,9/ct.ncs * 042 043
107 vfd 9/ct.ncs,9/ct.ncs * 044 045
108 vfd 9/ct.ncs,9/ct.ncs * 046 047
109 vfd 9/ct.ncs,9/ct.ncs * 050 051
110 vfd 9/ct.ncs,9/ct.ncs * 052 053
111 vfd 9/ct.ncs,9/ct.ncs * 054 055
112 vfd 9/ct.ncs,9/ct.ncs * 056 057
113 vfd 9/ct.nak,9/ct.nak * ak0 ak1
114 vfd 9/ct.ncs,9/ct.ncs * 062 063
115 vfd 9/ct.ncs,9/ct.ncs * 064 065
116 vfd 9/ct.ncs,9/ct.ncs * 066 067
117 vfd 9/ct.ncs,9/ct.ncs * 070 071
118 vfd 9/ct.ncs,9/ct.nak * 072 wak
119 vfd 9/ct.nak,9/ct.ncs * rvi 075
120 vfd 9/ct.ncs,9/ct.ncs * 076 077
121 rem
122 rem
123 dup 1,32
124 vfd 9/ct.ncs,9/ct.ncs
125 rem
126 rem * table 2 - transparent text
127 rem
128 vfd 9/ct.tb2,9/ct.tb2 * 000 001
129 vfd 9/ct.tb2,9/ct.tb2 * 002 003
130 vfd 9/ct.tb2,9/ct.tb2 * 004 005
131 vfd 9/ct.tb2,9/ct.tb2 * 006 007
132 vfd 9/ct.tb2,9/ct.tb2 * 010 011
133 vfd 9/ct.tb2,9/ct.tb2 * 012 013
134 vfd 9/ct.tb2,9/ct.tb2 * 014 015
135 vfd 9/ct.tb2,9/ct.tb2 * 016 017
136 vfd 9/ct.tb3,9/ct.tb2 * dle 021
137 vfd 9/ct.tb2,9/ct.tb2 * 022 023
138 vfd 9/ct.tb2,9/ct.tb2 * 024 025
139 vfd 9/ct.tb2,9/ct.tb2 * 026 027
140 vfd 9/ct.tb2,9/ct.tb2 * 030 031
141 vfd 9/ct.tb2,9/ct.tb2 * 032 033
142 vfd 9/ct.tb2,9/ct.tb2 * 034 035
143 vfd 9/ct.tb2,9/ct.tb2 * 036 037
144 rem
145 rem
146 dup 1,48
147 vfd 9/ct.tb2,9/ct.tb2
148 rem
149 rem * table 3 - looking for end of transparent text
150 rem
151 vfd 9/ct.tb2,9/ct.tb2 * 000 001
152 vfd 9/ct.tb2,9/ct.bcc * 002 etx
153 vfd 9/ct.tb2,9/ct.nak * 004 enq
154 vfd 9/ct.tb2,9/ct.tb2 * 006 007
155 vfd 9/ct.tb2,9/ct.tb2 * 010 011
156 vfd 9/ct.tb2,9/ct.tb2 * 012 013
157 vfd 9/ct.tb2,9/ct.tb2 * 014 015
158 vfd 9/ct.tb2,9/ct.tb2 * 016 017
159 vfd 9/ct.tb2,9/ct.tb2 * 020 021
160 vfd 9/ct.tb2,9/ct.tb2 * 022 023
161 vfd 9/ct.tb2,9/ct.tb2 * 024 025
162 vfd 9/ct.tb2,9/ct.bcc * 026 etb
163 vfd 9/ct.tb2,9/ct.tb2 * 030 031
164 vfd 9/ct.tb2,9/ct.tb2 * 032 033
165 vfd 9/ct.tb2,9/ct.tb2 * 034 035
166 vfd 9/ct.tb2,9/ct.mtb * 036 itb
167 rem
168 rem
169 dup 1,48
170 vfd 9/ct.tb2,9/ct.tb2
171 rem
172 rem * table 4 - end of text and control sequences
173 rem * ignoring all characters
174 rem * setcct micro-op must take us out of here for next
175 rem * data message or control sequence
176 rem
177 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 000 001
178 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 002 003
179 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 004 005
180 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 006 007
181 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 010 011
182 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 012 013
183 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 014 015
184 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 016 017
185 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 020 021
186 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 022 023
187 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 024 025
188 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 026 027
189 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 030 031
190 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 032 033
191 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 034 035
192 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4 * 036 037
193 rem
194 rem
195 dup 1,48
196 vfd 9/ct.ign+ct.tb4,9/ct.ign+ct.tb4
197 rem
198 start bsc,,c3bism0b0000
199 tib
200 sfcm hsla
201 meters
202 csbits
203 tconst
204 buffer
205 bscdat
206 pmc restore
207 rem
208 rem /* input scan control strings */
209 rem
210 inenq chstr rescanmatchenq
211 inenqs chstr rescansearchenq
212 ineot chstr rescanmatchtibeot
213 inack chstr rescanmatchdleignorematchtiback
214 innak chstr rescanmatchtibnak
215 indisc chstr rescanmatchdleignorematchtibeot
216 inwack chstr rescanmatchdleignorematchwack
217 inrvi chstr rescanmatchdleignorematchrvi
218 rem
219 rem /* output bldmsg control strings */
220 rem
221 otack chstr dletibackseteom
222 otnak chstr tibnakseteom
223 otenq chstr enqseteom
224 oteot chstr tibeotseteom
225 otdisc chstr dletibeotseteom
226 otwack chstr dlewackseteom
227 otttd chstr stxenqseteom
228 otrvi chstr dlerviseteom
229 rem
230 rem
231 rem
232 rem
233 ttls dialup control for bisync lines
234 ************************************************************************
235 *
236 * wait for bisync line to dial up. we distinguish here between
237 * half and full duplex lines in how we handle
238 * rts/cts during initialization
239 *
240 ************************************************************************
241 rem
242 bscstr tstflg tfacu,acutst /* must dial telephone first */
243 tstflg tflisn,lisn /* shall we listen for channel? */
244 wait 0,0,begin
245 rem
246 lisn tstflg tfdlup,lisnhf
247 contrl sdtr+srts+stat /* ready fulldpx channel for operation */
248 rem
249 waitfl wait 0,0,bstlsn /* wait for channel to come ready */
250 status cd+cts+dsr,0,bsdial /* go it now */
251 rem
252 lisnhf contrl sdtr+rrts+stat /* ready half dumplex chan for operation */
253 waithf wait 0,0,bstlsn
254 status dsr,0,bsdial
255 rem
256 bstlsn tstflg tfhang,bshang /* do hangup if requested */
257 tstflg tflisn,lisnok /* is listen still on? */
258 goto hungup /* no, bail out */
259 lisnok waitm
260 rem
261 bscacu contrl stat /* return from autocall, be sure line is up */
262 tstflg tfdlup,waithf
263 goto waitfl
264 rem
265 ************************************************************************
266 *
267 * line has dialed up. do software initialization
268 *
269 ************************************************************************
270 rem
271 bsdial getext ,bserr /* setup tib extension */
272 setlcl exflg1,0 /* reset all flags */
273 setlcl exflg2,0
274 setlcl bidlmt,0 /* start off with indefinite bidding */
275 setlcl ttdlmt,0
276 setlcl ttdtim,5
277 setlcl naklmt,3
278 reinit calasm bsinit /* call subr to setup some flags */
279 tstlcf exflg1,codasc,bsasci /* do ascii initialization */
280 goto bsebcd /* do ebcdic initialization */
281 rem
282 rem
283 rem bisync initialization of code dependent char values
284 rem
285 rem /* bisync - ascii */
286 rem
287 bsasci setchr ack0,aack0 /* establish ascii values */
288 setchr ack1,aack1
289 setchr enq,aenq
290 setchr tibnak,anak
291 setchr tibeot,aeot
292 setchr rvi,arvi
293 setchr wack,awack
294 setchr etb,aetb
295 setcct cct.ab /* ascii needs cct */
296 goto bstart /* get to work */
297 rem
298 rem /* bisync - ebcdic */
299 rem
300 bsebcd setchr ack0,eack0 /* establish ebcdic values */
301 setchr ack1,eack1
302 setchr enq,eenq
303 setchr tibnak,enak
304 setchr tibeot,eeot
305 setchr rvi,ervi
306 setchr wack,ewack
307 setchr etb,eetb
308 setcct scc.dl /* dont need cct for ebcdic */
309 rem
310 bstart tstlcf exflg1,dialed,ck3270 /* skip if dialup part already done */
311 calsub dmpall /* toss out any left over output */
312 dumpin /* also any input */
313 signal dialup /* tell ring-0 about this line */
314 setlcf exflg1,dialed
315 rem
316 rem /* find something to do */
317 rem
318 bswork tstflg tfhang,bshang /* hangup, if directed */
319 clrlcf exflg1,datrcv
320 tstlcf exflg1,cfgpnd,gocfg /* reconfig now if needed */
321 setflg tfmrcv /* we are msg receive mode user */
322 tstwrt bswrit /* if output present, try write */
323 goto bsread
324 rem
325 ************************************************************************
326 *
327 * switch here to ibm 3270 control tables if requested
328 *
329 ************************************************************************
330 rem
331 ck3270 tstlcf exflg2,ib3270,go3270 /* requested 3270 mode? */
332 tstlcf exflg2,haspmd,gohasp /* hasp mode selected? */
333 goto bswork
334 go3270 tstlcl a3270,badadr,bswork /* dont do it if not in core */
335 clrlcf exflg1,cfgok
336 tstflg tfhang,bshang /* last chance to bail out */
337 goto st3270 /* become a 3270 */
338 gohasp tstlcl ahasp,badadr,bswork /* ignore if hasp not configued */
339 clrlcf exflg1,cfgok
340 tstflg tfhang,bshang
341 goto sthasp
342 a3270 ind st3270
343 ahasp ind sthasp
344 badadr bool 776
345 ttls bisync read routines
346 ************************************************************************
347 *
348 * wait here for enq. this can either be a line bid
349 * or the writers response to our wack
350 *
351 ************************************************************************
352 rem
353 bsread setchr tiback,ack0 /* prime ack value */
354 clrlcf exflg1,naksw+nakksw+wacksw+rvisw+needrv+ctlmsg
355 tstlcf exflg1,cfgpnd,gocfg /* reconfigure now if needed */
356 setlcf exflg1,cfgok /* can accept reconfig op now */
357 setime 30 /* dont wait forever if stuff to write */
358 tstwrt wtenqx
359 setime 0
360 wtenqx setcct scc.bs /* initialize cct back to base */
361 setflg tfcrcv /* can use control rcv for line bids */
362 contrl srec+rxmit /* setup for read */
363 rem
364 wtenq setlcf exflg2,lookot /* watch for output during read */
365 calsub read
366 tstlcf exflg2,gotot,bswrit /* got something to write */
367 tstlcf exflg2,timout,bidto /* timed out, nothing happened */
368 rem
369 ************************************************************************
370 *
371 * got some input, so check it
372 *
373 ************************************************************************
374 rem
375 tstlcf exflg1,alwbid,bidsok /* branch if accepting bids */
376 goto dumpi /* throw this away */
377 bidsok inscan inenq,notbid /* look for line bid */
378 dumpin /* toss out line bid */
379 goto doread
380 rem
381 notbid tstlcf exflg1,wacksw,chkdsc /* must be exactly enq if wack */
382 inscan inenqs,chkdsc /* search for enq */
383 dumpin /* got it */
384 goto doread
385 chkdsc inscan indisc,dumpi /* look for disconnect */
386 goto dumpi /* got it, hangup */
387 rem
388 dumpi dumpin /* toss out garbage */
389 setime 20
390 tstlcf exflg1,wacksw,wtenqx
391 goto bswork /* keep looking */
392 rem
393 bidto tstlcf exflg1,wacksw,readto /* treat as timeout if waiting for wack */
394 goto bswork
395 eject
396 ************************************************************************
397 *
398 * respond to the previous transmission. this could have been a
399 * line bid, or we could be ackknowlidgine the previous msg.
400 *
401 ************************************************************************
402 rem
403 doread tstlcf exflg1,wacksw,bldwak /* is wack maybe needed? */
404 bldack tstlcf exflg1,needrv,bldrvi /* should use rvi, not ack */
405 useack bldmsg otack,bserr /* build buffer with ack msg */
406 goto dored2
407 bldrvi tstlcf exflg1,rvisw,useack /* send ack if rvi already used */
408 setlcf exflg1,rvisw /* try rvi */
409 bldmsg otrvi,bserr
410 goto dored2
411 bldwak clrlcf exflg1,wacksw
412 tstfld t.dcp,0,bldack /* ok to send ack now, dia caught up */
413 setime -100 /* before wacking, pause - things may get better */
414 wait chkwak,0,bstest
415 status 0,dsr,bshang
416 chkwak tstfld t.dcp,0,bldack /* temp wait worked, no need to wack at all */
417 setlcf exflg1,wacksw /* another wack may be required later */
418 bldmsg otwack,bserr /* build a wack message */
419 meter2 m.cnt4,1 /* count it */
420 dored2 clrlcf exflg1,nakksw /* clear nak sent flag */
421 holdot /* hold ack msg */
422 sndrsp clrlcf exflg1,naksw /* clear nak required flag */
423 setlcf exflg1,ctlmsg /* remeber this is control message */
424 calsub writer /* write out response */
425 rem
426 dmpout /* toss out response */
427 clrlcf exflg1,ctlmsg /* no longer have control message */
428 setime 20 /* 20 seconds for input */
429 tstlcf exflg1,wacksw,wtenq /* if we wacked msg, go wait for enq */
430 rem
431 ************************************************************************
432 *
433 * block has been read, so check it
434 *
435 ************************************************************************
436 rem
437 calsub read /* rad data block */
438 tstlcf exflg2,timout,readto /* time out */
439 tstlcf exflg1,naksw,sndnak /* must nak */
440 calasm chkims /* check for valid input block */
441 tstlcl result,resack,gotdat
442 tstlcl result,resenq,rptrsp
443 tstlcl result,reseot,gteot
444 goto sndnak
445 rem
446 ************************************************************************
447 *
448 * must nak the current block
449 *
450 ************************************************************************
451 rem
452 sndnak dumpin /* toss out input */
453 meter2 m.cnt1,1
454 rptnak bldmsg otnak,bserr /* respond with nak */
455 setlcf exflg1,nakksw /* set nak sent flag */
456 holdot /* hold nak msg */
457 goto sndrsp
458 rem
459 ************************************************************************
460 *
461 * read eot. return to line contention mode
462 *
463 ************************************************************************
464 rem
465 gteot sendin /* ship eot to multics */
466 goto bswork /* end of input blocks */
467 rem
468 ************************************************************************
469 *
470 * read a good block. ack it and ship to multics
471 *
472 ************************************************************************
473 rem
474 gotdat tstfld t.dcp,0,doack /* before shipping msg, see if dia_man caught up */
475 tstlcl wackcd,1,sndnak /* see if wacks or naks wanted */
476 setlcf exflg1,wacksw /* must send wack to slow sender down */
477 doack meterm 0 /* count the message */
478 sendin
479 calsub advack /* advance to next ack */
480 tstwrt setrvi /* if there is output, use rvi */
481 goto doread /* continue with input */
482 setrvi setlcf exflg1,needrv
483 goto doread
484 rem
485 ************************************************************************
486 *
487 * asked to repeat out previous response
488 *
489 ************************************************************************
490 rem
491 rptrsp dumpin /* toss out any input */
492 tstlcf exflg1,nakksw,rptnak /* repeat nak */
493 bldmsg otack,bserr /* repeat ack */
494 holdot /* hold ack msg */
495 goto sndrsp /* send it */
496 rem
497 ************************************************************************
498 *
499 * time out while waiting for input
500 *
501 ************************************************************************
502 rem
503 readto meter2 m.cnt3,1
504 dumpin /* toss out input */
505 bldmsg otdisc,bserr /* respond with disconnect */
506 setlcf exflg1,ctlmsg /* have a control message */
507 holdot /* hold disconnect msg */
508 calsub write /* write the eot */
509 dmpout
510 clrlcf exflg1,ctlmsg
511 goto bswork
512 rem
513 ************************************************************************
514 *
515 * come here when reconfiguration needed. the rmode and smode
516 * opblocks have already been set up in the tib extension
517 *
518 ************************************************************************
519 rem
520 gocfg clrlcf exflg1,cfgpnd+cfgok
521 unwind
522 calsub rcvoff
523 dumpin
524 setlcv gocfgr,cfgrmd /* copy mode settings into inline code */
525 setlcv gocfgs,cfgsmd
526 config
527 gocfgr rmode 0
528 gocfgs smode 0
529 goto reinit /* go setup tib extension for new modes */
530 ttls bisync write routines
531 ************************************************************************
532 *
533 * start here with something to write. the message to write
534 * is checked to insure it is valid and complete. when it
535 * is, the line will be bid for.
536 *
537 ************************************************************************
538 rem
539 bswrit clrlcf exflg1,naksw+nakksw+wacksw+cfgok+ttdsw+ntrsw+ctlmsg
540 setlcl bidcnt,0 /* no bids yet */
541 calasm chkoms /* check output message */
542 tstlcl result,resinc,getmor /* message incomplete */
543 tstlcl result,resack,sndenq /* good message */
544 tstlcl result,resnul,bsread /* no buffers at all yet, go wait */
545 tstlcl result,resntr,setntr /* found non-trans block in trans mode */
546 dmpout
547 tstlcl result,reseot,bswork /* user asked to send eot, ignore */
548 calsub rptbad /* report back a bad block */
549 goto bsread /* dmpout did the sndout */
550 rem
551 getmor signal sndout /* need more output from ring-0 */
552 goto bsread /* not complete */
553 rem
554 ************************************************************************
555 *
556 * there is now a valid message to write, so bid for
557 * the line.
558 *
559 ************************************************************************
560 rem
561 setntr setlcf exflg1,ntrsw /* remember non-transparent message */
562 sndenq calsub rcvoff /* turn off receive */
563 dumpin /* toss out any input */
564 rem
565 tstlcl bidlmt,0,gobid /* send bid if no limit */
566 tstlcv bidlmt,bidcnt,bdfail /* check for limit */
567 addlcl bidcnt,1
568 rem
569 gobid bldmsg otenq,bserr /* setup line bid */
570 setchr tiback,ack0 /* prime ack value */
571 holdot /* hold line bid */
572 setlcf exflg1,ctlmsg /* have a control message */
573 setflg tfcrcv /* use control rcv for efficiency */
574 rem
575 calsub writer /* write a line bid */
576 eject
577 ************************************************************************
578 *
579 * line bid has been sent, so now wait for a response.
580 *
581 ************************************************************************
582 rem
583 dmpout /* toss out enq */
584 clrlcf exflg1,ctlmsg
585 setime 3 /* 3 secs for response */
586 rem
587 calsub read /* read response */
588 tstlcf exflg2,timout,sndenq /* no response */
589 rem
590 ************************************************************************
591 *
592 * some response has been received from the bid, so
593 * analyze it here.
594 * if the response is an ack, we will start transmitting. if
595 * the response is enq another line bid be will go to start
596 * reading. any other response or no response is ignored any
597 * the bid will be repeated.
598 *
599 ************************************************************************
600 rem
601 inscan inenq,chkack /* look for line bid */
602 dumpin /* toss out enq */
603 goto doread /* input over output */
604 rem
605 chkack inscan inack,sndenq /* look for ack */
606 dumpin /* toss out ack */
607 calsub advack /* advance to next ack */
608 goto sdout
609 rem
610 ************************************************************************
611 *
612 * line bidding has failed. report back to multics
613 *
614 ************************************************************************
615 rem
616 bdfail meter2 m.cnt8,1
617 setlcl ctlop,lstbdf /* code to report bid failure */
618 setlcl ctlvl1,0
619 linsta ctlop
620 goto bsread
621 eject
622 ************************************************************************
623 *
624 * transmit a data block
625 *
626 ************************************************************************
627 rem
628 sdout calasm tsthld /* see if hold flag already is on */
629 tstlcl tempsw,1,skphld /* if so, we have already been */
630 rem /* here for this message and must not do */
631 rem /* another send output */
632 meterm 1 /* here to make sure we count it only once */
633 holdot /* hold output message */
634 signal sndout /* get next data message from ring-0 */
635 skphld setlcl nakcnt,0 /* reset count of naks */
636 setlcl enqcnt,0 /* reset count of bad resp and timout */
637 clrlcf exflg1,ttdsw
638 setlcl ttdcnt,0
639 rem
640 rptout tstlcf exflg1,ntrsw,rptot2 /* must go to non-trans mode */
641 goto rptot3
642 rptot2 config
643 rmode fg.btr /* turn off transparency */
644 rptot3 setflg tfcrcv /* can use control rcv for ack */
645 calsub writer /* repeat response */
646 rem
647 ************************************************************************
648 *
649 * data block has been transmitted, wait for response.
650 *
651 ************************************************************************
652 rem
653 sntout setime 3 /* 3 secs for response */
654 rem
655 calsub read
656 tstlcf exflg2,timout,rspto
657 rem
658 ************************************************************************
659 *
660 * a response has been received to our transmission.
661 * that response is analyzed here. possibles replies are:
662 *
663 * ack msg recieved ok, the next will be sent
664 * nack error in msg, retransmit
665 * eot throw out msg, rtuurn to line contention
666 * dle-eot same as eot
667 * wack treated as positive response, but we
668 * must sned enqs to see when it is ok to send
669 * next message.
670 *
671 * if there is any other response, it is assumed to be a garbled
672 * message and we will send enq to have it repeated.
673 *
674 ************************************************************************
675 rem
676 tstlcf exflg1,ntrsw,gotrs0 /* must go back to transparent */
677 goto gotrs1
678 gotrs0 config
679 smode fg.btr
680 gotrs1 inscan innak,gotrs2 /* check for nak */
681 goto gotnak
682 gotrs2 inscan inack,gotrs3 /* check for ack */
683 goto gudack
684 gotrs3 inscan indisc,gotrs4 /* check for dle,eot */
685 goto likeot
686 gotrs4 inscan inwack,gotrs5 /* check for wack */
687 goto gotwck
688 gotrs5 inscan inrvi,gotrs6 /* check for rvi */
689 goto gotrvi
690 gotrs6 inscan ineot,rspagn /* check for eot */
691 rem
692 ************************************************************************
693 *
694 * response is an eot. throw out msg and go back to line
695 * contention mode.
696 *
697 ************************************************************************
698 rem
699 likeot dumpin
700 goto bswork
701 rem
702 ************************************************************************
703 *
704 * the response is an ack. throw out current message
705 *
706 ************************************************************************
707 rem
708 gudack dumpin /* toss out ack */
709 calsub advack /* advance to next ack */
710 tstlcf exflg1,wacksw,skpdmp /* if previously wacked, msg already gone */
711 dmpout /* toss out data sent */
712 clrlcf exflg1,ntrsw
713 skpdmp clrlcf exflg1,wacksw
714 rem
715 ************************************************************************
716 *
717 * now look for next message. if one is not ready in the
718 * specified time limit, we will give up and send an
719 * eot.
720 *
721 ************************************************************************
722 rem
723 chkout calasm chkoms /* check output message */
724 tstlcl result,resack,sdout /* good message */
725 tstlcl result,resntr,fndntr /* got non-transparent msg */
726 tstlcl result,resinc,getout /* incomplete message */
727 tstlcl result,resnul,justwt /* wait, data should be coming */
728 dmpout /* throw away bad stuff */
729 tstlcl result,reseot,sndeot /* asked for eot */
730 calsub rptbad /* report bad block */
731 goto justwt /* skip sndout, dmpout did it */
732 getout signal sndout /* get next data message from ring-0 */
733 justwt setimv ttdtim /* wait before sending eot */
734 wait sndttd,chkout,bstest
735 status 0,dsr,bshang
736 fndntr setlcf exflg1,ntrsw /* must reconfigure for this msg */
737 goto sdout
738 rem
739 ************************************************************************
740 *
741 * next message not ready soon enough. we must either send a ttd
742 * or and eot
743 *
744 ************************************************************************
745 rem
746 sndttd tstlcv ttdcnt,ttdlmt,sndeot /* eot if too many already */
747 addlcl ttdcnt,1
748 bldmsg otttd,bserr /* constucte ttd message */
749 setlcf exflg1,ctlmsg
750 holdot
751 setflg tfcrcv
752 calsub writer /* transmit it */
753 setlcf exflg1,ttdsw
754 dmpout /* throw out ttd */
755 clrlcf exflg1,ctlmsg
756 goto sntout
757 rem
758 * come here when nak received in response to ttd
759 rem
760 ttdnak clrlcf exflg1,ttdsw
761 goto chkout /* go see if message ready now */
762 rem
763 ************************************************************************
764 *
765 * here when eot must be sent. this can be because Multics
766 * requested it, too many errors occured, or because the
767 * next message was not available soon enough.
768 *
769 ************************************************************************
770 rem
771 sndeot bldmsg oteot,bserr /* setup eot */
772 setlcf exflg1,ctlmsg
773 holdot /* hold eot msg */
774 calsub write
775 rem
776 dmpout /* toss out eot msg */
777 clrlcf exflg1,ctlmsg
778 goto bsread /* wait 3 secs before next write */
779 rem
780 ************************************************************************
781 *
782 * here when the response to out transmission is a nak.
783 * we will retransmit unless that has been done too many times
784 * already.
785 *
786 ************************************************************************
787 rem
788 gotnak dumpin /* toss out nak */
789 tstlcf exflg1,ttdsw,ttdnak /* nak in response to our ttd */
790 meter2 m.cnt2,1
791 tstlcv nakcnt,naklmt,manynk /* too many naks? */
792 addlcl nakcnt,1 /* count another */
793 addlcl nakmtr,1
794 goto rptout /* repeat data */
795 manynk meter2 m.cnt6,1
796 setlcl ctlop,lstnak /* report excessive naks */
797 setlcl ctlvl1,0
798 linsta ctlop
799 dmpout
800 goto sndeot
801 nakmtr oct 0
802 rem
803 ************************************************************************
804 *
805 * the response to out message was a wack. this is a posituve
806 * response, but we must send enqs looking for an ack before sending
807 * the next message.
808 *
809 ************************************************************************
810 rem
811 gotwck dumpin /* toss out wack */
812 meter2 m.cnt5,1
813 tstlcf exflg1,wacksw,waitwk /* dont dmpout unless this is first wack */
814 dmpout
815 setlcf exflg1,wacksw
816 waitwk setime 1 /* wait a while before retry */
817 wait tryenq,0,bstest
818 rem
819 ************************************************************************
820 *
821 * rvi received in response to our transmission.
822 * tell multics and treat as an ack
823 *
824 ************************************************************************
825 rem
826 gotrvi tstlcf exflg1,ttdsw,sndeot /* in response to our ttd */
827 dmpout /* treat as good ack */
828 goto sndeot /* turn line around */
829 rem
830 ************************************************************************
831 *
832 * come here to send an enq because of a wack, a garbled
833 * response, or no response.
834 *
835 ************************************************************************
836 rem
837 rspto meter2 m.cnt3,1
838 calsub rcvoff /* turn off receive */
839 tstlcf exflg1,ntrsw,rspto1 /* must go back to transparent */
840 goto rspagn
841 rspto1 config
842 smode fg.btr
843 rspagn meter2 m.cnt7,1
844 dumpin /* toss out input */
845 tstlcl enqcnt,enqlmt,sndeot /* test for limit exceeded */
846 addlcl enqcnt,1
847 tryenq bldmsg otenq,bserr /* setup enq */
848 holdot /* hold enq msg */
849 setlcf exflg1,ctlmsg
850 setflg tfcrcv
851 calsub writer
852 rem
853 dmpout /* toss out enq */
854 clrlcf exflg1,ctlmsg
855 goto sntout /* wait for response */
856 ttls bisync test-state routine
857 ************************************************************************
858 *
859 * bisync test state handler
860 *
861 ************************************************************************
862 rem
863 bsctst null /* external calls state here */
864 bstest tstflg tfhang,bshang /* hangup, if directed */
865 linctl ctlop,tstret /* check for line control call */
866 tstlcl ctlop,lctbid,setbid /* 1 = set bid limit */
867 tstlcl ctlop,lctabd,accbid /* 2 = set bids ok flag */
868 tstlcl ctlop,lctcfg,recfg /* 3 = reconfigure */
869 tstlcl ctlop,lctttd,setttd /* 4 = set ttd params */
870 tstlcl ctlop,lcttwr,testwr /* 5 = report write status */
871 tstlcl ctlop,lct327,set327 /* 6 = set ibm3270 mode */
872 tstlcl ctlop,lctpla,setpla /* 7 = set polling address */
873 tstlcl ctlop,lctsla,setsla /* 9 = set selection address */
874 tstlcl ctlop,lctmst,setmst /* 11 = set master of slave */
875 tstlcl ctlop,lcthsp,sethsp /* 12 = set hasp mode */
876 tstlcl ctlop,lctnak,setnkl /* 13 = set nak limit */
877 tstlcl testrt,0,tstret /* extra handler */
878 gotov testrt /* if so, call it */
879 tstret waitm
880 rem
881 setbid setlcv bidlmt,ctlvl1 /* set bid limit */
882 waitm
883 rem
884 accbid setlcf exflg1,alwbid /* read side can take bids now */
885 waitm
886 rem
887 setttd setlcv ttdtim,ctlvl1 /* time interval */
888 setlcv ttdlmt,ctlvl2 /* max to send */
889 waitm
890 rem
891 set327 setlcf exflg2,ib3270
892 waitm
893 rem
894 setpla setlcv polad1,ctlvl1 /* copy addr */
895 setlcv polad2,ctlvl2
896 setlcv polad3,ctlvl3
897 waitm
898 rem
899 setsla setlcv selad1,ctlvl1 /* set selection address */
900 setlcv selad2,ctlvl2
901 setlcv selad3,ctlvl3
902 waitm
903 rem
904 setmst clrlcf exflg2,master /* assume secondary */
905 tstlcl ctlvl1,0,tstret
906 setlcf exflg2,master
907 waitm
908 rem
909 sethsp setlcf exflg2,haspmd
910 waitm
911 rem
912 setnkl setlcv naklmt,ctlvl1
913 waitm
914 rem
915 ************************************************************************
916 *
917 * order is to report write status. a line_status signal will be
918 * returned indicating wheterh or not there is data in the fnp
919 * yet to be written. if 'ctlmsg' is off, and output chain
920 * represents data to write. if 'ctlmsg' is on, the first output
921 * buffer is a control sequence, not data, and the second buffer
922 * must be checked. with a special asm subr
923 *
924 ************************************************************************
925 rem
926 testwr setlcl ctlop,lstrwr /* code for reporting write */
927 setlcl ctlvl1,1 /* assume data present */
928 tstlcf exflg1,ctlmsg,testw1 /* is there a control message? */
929 tstwrt testw2 /* there is output */
930 setlcl ctlvl1,0 /* indicate none */
931 testw2 linsta ctlop /* send back answer */
932 waitm
933 testw1 calasm tstbf2 /* check second buffer */
934 setlcv ctlvl1,tempsw /* copy answer */
935 goto testw2
936 rem
937 ************************************************************************
938 *
939 * here when test state call is to reconfigure. the rmode and
940 * smode blocks needed are built in the tib extenstion, and
941 * the actual reconfiguration is either done now, or pending
942 * depending on 'cfgok'.
943 *
944 ************************************************************************
945 rem
946 recfg setlcv cfgrmd,recfgr /* initialize rmode and smode words */
947 setlcv cfgsmd,recfgs
948 tstlcl ctlvl1,0,recfg1 /* non-tran ascii */
949 tstlcl ctlvl1,1,recfg2 /* non-tran ebcdic */
950 tstlcl ctlvl1,2,recfg3 /* tran ascii */
951 tstlcl ctlvl1,3,recfg4 /* tran ebcidc */
952 waitm
953 recfg1 setlcf cfgrmd,fg.beb+fg.btr /* non-trans ascii */
954 setlcf cfgsmd,fg.lpr+fg.lps+fg.lpo+fg.cct
955 goto recfg5
956 recfg2 setlcf cfgrmd,fg.btr+fg.lpr+fg.lps+fg.lpo+fg.cct /* non-trans ebcdic */
957 setlcf cfgsmd,fg.beb
958 goto recfg5
959 recfg3 setlcf cfgrmd,fg.beb /* trans ascii */
960 setlcf cfgsmd,fg.btr+fg.cct+fg.lps+fg.lpr+fg.lpo
961 goto recfg5
962 recfg4 setlcf cfgsmd,fg.beb+fg.btr /* trans ebcdic */
963 setlcf cfgrmd,fg.lpr+fg.lps+fg.lpo+fg.cct
964 recfg5 setlcf exflg1,cfgpnd /* reconfig now pending */
965 tstlcf exflg1,cfgok,gocfg /* if now is a good time */
966 waitm
967 recfgr rmode 0
968 recfgs smode 0
969 rem
970 rem
971 ************************************************************************
972 *
973 * come here to hangup
974 *
975 ************************************************************************
976 rem
977 bshang retext
978 unwind
979 stpchn /* stop channel */
980 calsub dmpall /* toss out any output */
981 dumpin /* toss out any input */
982 clrflg tfwabttfrabt /* clear abort flags */
983 clrflg tflisntfhang /* clear listen, hang flags */
984 signal hangup /* tell ring-0 */
985 goto hungup /* that's all folks */
986 rem
987 bserr punt 100 /* bad condition-bombs away */
988 ttls bisync opblock subroutines
989 ************************************************************************
990 *
991 * subroutine to switch acks
992 *
993 ************************************************************************
994 rem
995 bscswa null
996 advack cmpchr tiback,ack0,prime1 /* test for ack0 */
997 setchr tiback,ack0 /* prime to ack0 */
998 retsub /* return */
999 prime1 setchr tiback,ack1 /* prime to ack1 */
1000 retsub /* return */
1001 rem
1002 ************************************************************************
1003 *
1004 * subroutine to turn off recieve mode
1005 *
1006 ************************************************************************
1007 rem
1008 rcvoff setime 1
1009 contrl rrec+smark
1010 wait rcvoff,0,bstest
1011 status marker,0,rcvofx
1012 status 0,dsr,bshang
1013 rcvofx retsub
1014 rem
1015 ************************************************************************
1016 *
1017 * subroutine to dump the entire output chain
1018 *
1019 ************************************************************************
1020 rem
1021 dmpall dmpout
1022 tstwrt dmpall
1023 retsub
1024 rem
1025 ************************************************************************
1026 *
1027 * report a bad block bad to multics
1028 *
1029 ************************************************************************
1030 rem
1031 bscbad null /* external entry */
1032 rptbad setlcl ctlop,lstbbk
1033 setlcl ctlvl1,0
1034 linsta ctlop
1035 retsub
1036 eject
1037 ************************************************************************
1038 *
1039 * subroutine to write the current output stuff.
1040 * it can be called at "write", in which case only output
1041 * is done, or it can be called at "writer", which
1042 * also sets receive mode during the output. the flag
1043 * "datrcv" in the tib ext will be set if data is read while
1044 * the output is in progress.
1045 *
1046 ************************************************************************
1047 rem
1048 bscwt null
1049 write clrlcf exflg1,rflag /* remember which entry */
1050 goto write1
1051 rem
1052 bscwtr null
1053 writer setlcf exflg1,rflag
1054 rem
1055 write1 setime 0
1056 setcct scc.bs /* back to base cct */
1057 clrlcf exflg1,datrcv
1058 rem
1059 tstflg tfdlup,write3 /* half duplex */
1060 goto write4 /* full duplex */
1061 rem
1062 write3 tstlcf exflg1,rflag,write5 /* choose between dcw lists */
1063 dcwlst
1064 cmd sxmit+srts
1065 output outmsg
1066 cmd rxmit+rrts+sterm
1067 goto write6
1068 rem
1069 write5 dcwlst
1070 cmd sxmit+srec+srts
1071 output outmsg
1072 cmd rxmit+rrts+sterm
1073 goto write6
1074 rem
1075 write4 tstlcf exflg1,rflag,write7 /* choose between fulldpx dcwlists */
1076 dcwlst
1077 cmd sxmit
1078 output outmsg
1079 cmd rxmit+sterm
1080 goto write6
1081 rem
1082 write7 dcwlst
1083 cmd sxmit+srec
1084 output outmsg
1085 cmd rxmit+sterm
1086 rem
1087 write6 wait 0,write2,bstest /* common wait block */
1088 status 0,dsr,bshang
1089 status term,0,write9
1090 status brkchr,0,write8 /* got input during output */
1091 status parity,0,wpar
1092 status bscrcv,0,write8
1093 status exh,0,wexh
1094 rem
1095 wpar meter1 m.par,1
1096 goto write8
1097 rem
1098 wexh meter2 m.exh,1
1099 write8 setlcf exflg1,datrcv /* remember data came in */
1100 waitm
1101 rem
1102 write2 setlcf exflg2,outarv /* flag saying output arrived */
1103 waitm
1104 rem
1105 write9 retsub
1106 eject
1107 ************************************************************************
1108 *
1109 * common subroutine to do input
1110 *
1111 ************************************************************************
1112 rem
1113 bscrd null
1114 read clrlcf exflg1,naksw /* no error yet */
1115 clrlcf exflg2,timout+gotot
1116 tstlcf exflg1,datrcv,read8 /* input already here */
1117 tstlcf exflg1,codasc,read1 /* ascii input */
1118 rem
1119 ************************************************************************
1120 *
1121 * wait for input ebcdic
1122 *
1123 ************************************************************************
1124 rem
1125 wait read10,read11,bstest /* wait for ebcdic input */
1126 status 0,dsr,bshang
1127 status xte,0,rxte
1128 status bscrcv+parity,0,rpar
1129 status bscrcv,0,read8
1130 status rcvto,0,read3
1131 status exh,0,rexh
1132 status parity,0,read2
1133 rem
1134 rxte meter1 m.xte,1
1135 goto read3
1136 rem
1137 rpar meter1 m.par,1
1138 goto read3
1139 rem
1140 read2 meter1 m.par,1
1141 setlcf exflg1,naksw
1142 clrlcf exflg1,cfgok
1143 waitm
1144 read3 setlcf exflg1,naksw
1145 goto read8
1146 rem
1147 ************************************************************************
1148 *
1149 * wait for input ascii
1150 *
1151 ************************************************************************
1152 rem
1153 read1 wait read10,read11,bstest /* wait for ascii input */
1154 status 0,dsr,bshang /* no dsr, may have hungup */
1155 status bscrcv+bscdmk,0,read8 /* dle,stx,...,dle,etxetb or enq */
1156 status bscrcv,0,read3 /* ...,dle,etxetbitb or enq */
1157 status bscdmk+bscmrk,0,read5 /* dle,stx,...,dle,itb */
1158 status bscdmk+brkchr,0,read6 /* dle,stx,...,dle,etxetb or enq */
1159 status bscdmk,0,read4 /* dle,stx,... */
1160 status brkchr,0,read8 /* non-transparent text or control sequence */
1161 status rcvto,0,read3 /* receive time out */
1162 status exh,0,rexh
1163 rem
1164 read4 clrlcf exflg1,cfgok
1165 wait read10,read14,bstest /* transparent text */
1166 status 0,dsr,bshang /* no dsr, may have hungup */
1167 status bscrcv,0,read3 /* ...,dle,enq */
1168 status brkchr,0,read6 /* ...,dle,etxetb or enq */
1169 status bscmrk,0,read5 /* ...,dle,itb */
1170 status exh,0,rexh
1171 rem
1172 read5 clrlcf exflg1,cfgok
1173 wait read10,read14,bstest /* wait for rbt after itb */
1174 status 0,dsr,bshang /* no dsr, may have hungup */
1175 status parity,0,read7 /* crc error */
1176 status bscrcv,0,read4 /* good itb block */
1177 status exh,0,rexh
1178 rem
1179 read6 clrlcf exflg1,cfgok
1180 wait read10,read14,bstest /* wait for rbt after etx or etb */
1181 status 0,dsr,bshang /* no dsr, may have hungup */
1182 status parity,0,rpar /* crc error */
1183 status bscrcv,0,read8 /* good block */
1184 status exh,0,rexh
1185 rem
1186 read7 meter1 m.par,1
1187 setlcf exflg1,naksw /* remember nak required */
1188 goto read4
1189 rem
1190 ************************************************************************
1191 *
1192 * input terminated, reset recieve mode */
1193 *
1194 ************************************************************************
1195 rem
1196 rexh meter2 m.exh,1
1197 read8 clrlcf exflg1,cfgok
1198 read13 setime 1 /* retry if it takes too long */
1199 contrl rrec+smark
1200 wait read13,read14,bstest
1201 status 0,dsr,bshang
1202 status marker,0,read9
1203 rem
1204 read9 clrlcf exflg2,lookot
1205 retsub
1206 rem
1207 ************************************************************************
1208 *
1209 * timeout during input
1210 *
1211 ************************************************************************
1212 rem
1213 read10 setlcf exflg2,timout
1214 goto read8
1215 rem
1216 ************************************************************************
1217 *
1218 * got write during read
1219 *
1220 ************************************************************************
1221 rem
1222 read11 setlcf exflg2,outarv /* remember output for hasp */
1223 tstlcf exflg2,lookot,read12 /* see if we care */
1224 waitm /* no */
1225 read12 setlcf exflg2,gotot
1226 goto read8
1227 read14 setlcf exflg2,outarv
1228 waitm
1229 ttls bisync assembler subroutines
1230 ************************************************************************
1231 *
1232 * subroutine called when a bisync line dials up. it
1233 * sets some flags and pointers in the tib extension
1234 *
1235 ************************************************************************
1236 rem
1237 bsinit subr
1238 rem
1239 * generate an index, based on mode
1240 * 0=non-transparent ascii
1241 * 1=non-transparent ebcdic
1242 * 2= transparent ascii
1243 * 3= transparent ebcdic
1244 rem
1245 ldx2 l.a001-* =0
1246 ldx3 t.sfcm,1 software comm region
1247 lda sf.cfg+1,3 second word of config pcw
1248 cana l.a008-* =400, ebcdic bit
1249 tze bsi010-* off
1250 iacx2 1
1251 lda l.a013-* =tfkpar
1252 orsa t.flg3,1 indicate that parity is to be kept
1253 tra bsi020-*
1254 bsi010 lda l.a014-* =^tfkpar
1255 ansa t.flg3,1 parity not to be kept
1256 bsi020 lda sf.cfg+1,3 get second word of pcw back
1257 icana =o200 check transparent bit
1258 tze 2 off
1259 iacx2 2
1260 rem
1261 * get flags for tib extension flag word
1262 rem
1263 ldx3 l.a002-* =exflg1
1264 tsy a.a001-*,* =cvaddr
1265 lda l.a009-* mask to turn off all config bits
1266 ansa 0,3
1267 lda l.a003-*,* get flags from table
1268 orsa 0,3
1269 rem
1270 * get address of ascii or ebcdic table
1271 rem
1272 ldx3 l.a004-* =chartb
1273 tsy a.a001-*,* =cvaddr
1274 lda l.a005-*,*
1275 sta 0,3
1276 rem
1277 * get address of state transition table
1278 rem
1279 ldx3 l.a006-* =stattb
1280 tsy a.a001-*,* =cvaddr
1281 lda l.a007-*,* get addr
1282 sta 0,3
1283 rem
1284 ldx2 l.a001-*
1285 return bsinit
1286 rem
1287 a.a001 ind cvaddr
1288 a.a002 ind setbpt
1289 rem
1290 l.a001 oct 0
1291 l.a002 vfd 18/exflg1
1292 l.a003 ind *+1,2
1293 vfd o18/trnoff+codasc
1294 vfd o18/trnoff+codebc
1295 vfd o18/trnon+codasc
1296 vfd o18/trnon+codebc
1297 l.a004 vfd 18/chartb
1298 l.a005 ind *+1,2
1299 ind atab
1300 ind etab
1301 ind atab
1302 ind etab
1303 l.a006 vfd 18/stattb
1304 l.a007 ind *+1,2
1305 ind sttnta
1306 ind sttnte
1307 ind stttrn
1308 ind stttrn
1309 l.a008 oct 400
1310 l.a009 vfd o18//trnon*/trnoff*/codebc*/codasc
1311 l.a010 vfd 18/bffhld
1312 l.a013 vfd 18/tfkpar
1313 l.a014 vfd o18//tfkpar
1314 eject
1315 ************************************************************************
1316 *
1317 * test to see if the hold output flag is on for the
1318 * current write message
1319 *
1320 ************************************************************************
1321 rem
1322 tsthld subr
1323 stz tempsw-*
1324 lda t.ocp,1
1325 tsy a.a002-*,* setbpt
1326 cax3 get virtual address
1327 lda bf.flg,3
1328 cana l.a010-* =bfflst
1329 tze 2
1330 aos tempsw-*
1331 return tsthld
1332 tempsw bss 1
1333 rem
1334 ************************************************************************
1335 *
1336 * test1 to see if there is a second write buffer
1337 *
1338 ************************************************************************
1339 rem
1340 tstbf2 subr
1341 stz tempsw-* say no
1342 lda t.ocp,1 addr of first buffer
1343 tze tstbfr-*
1344 tsy a.a002-*,* setbpt
1345 cax3
1346 szn bf.nxt,3 more?
1347 tze tstbfr-* no
1348 aos tempsw-*
1349 tstbfr return tstbf2
1350 eject
1351 ************************************************************************
1352 *
1353 * subroutine that checks the validity of bisync messages
1354 *
1355 ************************************************************************
1356 rem
1357 * entry point to check output message
1358 *
1359 bsccko null
1360 chkoms subr
1361 stz iosw-*
1362 aos iosw-* non-zero indicates output
1363 tra chk010-*
1364 rem
1365 * entry point to check input messages
1366 rem
1367 bsccki null
1368 chkims subr
1369 stz iosw-* zero indciates input
1370 rem
1371 * common path
1372 rem
1373 chk010 stz ntrflg-* no non-transparent msg
1374 ila result get addr of anser in tib ext
1375 cax3
1376 tsy a.a001-*,* =cvaddr
1377 stx3 ireslt-*
1378 stz ireslt-*,*
1379 tsy chkini-* get pointer to first buffer
1380 tra tttnul-* none, msg incomplete
1381 ldx3 l.b001-* =chartb
1382 tsy a.b001-*,* =cvaddr
1383 lda 0,3 get pointer to character table
1384 sta tabadr-* and save
1385 lda chartb-stattb,3 get table address
1386 sta astate-*
1387 sta curstt-* current state is 0
1388 rem
1389 * loop thru each character
1390 rem
1391 chk020 tsy chkget-*
1392 tra tttinc-* no more, msg incomplete
1393 ada curstt-* get index into current state table
1394 cax2
1395 lda 0,2 current action code
1396 tpl 0,2* + means branch address
1397 ila 0
1398 sba 0,2 get new state
1399 chk030 mpf l.b003-* =statel
1400 lls 17
1401 ada astate-* addr of new state entry
1402 sta curstt-*
1403 tra chk020-* and back around
1404 rem
1405 * message is incomplete
1406 rem
1407 tttnul ila resnul no data at all
1408 sta ireslt-*,*
1409 tttinc szn iosw-* input or output?
1410 tze tttnak-* nak inputete input
1411 lda nbufs-* get count of bufs in output msg
1412 icmpa 4*bufmax over max?
1413 tpl tttnak-* yes, this is garbage
1414 tra chkret-*
1415 rem
1416 * bad message, should be nakked
1417 rem
1418 tttnak ila resnak
1419 sta ireslt-*,*
1420 tra chkret-*
1421 rem
1422 * message was an enq
1423 rem
1424 tttenq ila resenq
1425 sta ireslt-*,*
1426 tra chkret-*
1427 rem
1428 * message was an eot
1429 rem
1430 ttteot ila reseot
1431 sta ireslt-*,*
1432 tra tttak3-*
1433 rem
1434 * message was non-transparent while in transparent mode
1435 * setup to rescan message in appropriate non-transparent mode
1436 rem
1437 tttntr aos ntrflg-* flag as non-tranaparent
1438 lda tabadr-* check ascii or ebcdic
1439 cmpa a.b003-* =addr atab
1440 tze tttnt1-* ascii
1441 lda a.b004-* addr of ebcdic state table
1442 tra tttnt2-*
1443 rem
1444 tttnt1 lda a.b005-* addr of ascii state table
1445 tttnt2 sta astate-*
1446 sta curstt-*
1447 tsy chkini-* setup to rescan
1448 nop
1449 tra chk020-* and rescan
1450 rem
1451 * special functions
1452 rem
1453 * function 1 - zero lrc and go to state 1
1454 rem
1455 tttsp1 stz lrcwrd-*
1456 stz lrcprv-*
1457 ila 1
1458 tra chk030-*
1459 rem
1460 * function 2 - check lrc and go to ack
1461 rem
1462 tttsp2 tsy chklrc-*
1463 tra tttnak-* error
1464 tra tttack-* ok
1465 rem
1466 * function 3 - check lrc and go to state 4
1467 rem
1468 tttsp3 tsy chklrc-*
1469 tra tttnak-* error
1470 ila 4
1471 tra chk030-*
1472 rem
1473 * good message
1474 rem
1475 tttack ila resack
1476 szn ntrflg-* was it non-transparent
1477 tze 2 no
1478 ila resntr
1479 sta ireslt-*,*
1480 tttak3 szn iosw-* input or output?
1481 tze tttak1-* input
1482 tsy chkget-* if output, there should be no more chars
1483 tra tttak2-* that is true
1484 tra tttnak-* bad output msg
1485 tttak2 ldx2 curbuf-* pointer to last buffer
1486 lda l.b006-* =bfflst, flag as last
1487 orsa bf.flg,2
1488 tra chkret-*
1489 tttak1 tsy chkdel-* trim extraneous stuff from input
1490 lda t.ilst,1 set break in last buffer
1491 tsy a.b006-*,* setbpt
1492 cax2
1493 lda l.b008-* =bffbrk
1494 orsa bf.flg,2
1495 rem
1496 * return
1497 rem
1498 chkret ldx2 l.b007-* =0
1499 szn iosw-* check which entry
1500 tze chkrti-*
1501 return chkoms
1502 chkrti return chkims
1503 rem
1504 * subroutine to get pointer to first buffer
1505 rem
1506 chkini subr
1507 stz nbufs-* initialize buffer counter
1508 ldx2 t.icp,1 input bufer chain
1509 szn iosw-* is it input?
1510 tze 2 yes
1511 ldx2 t.ocp,1 output buffer chain
1512 tsy chkbuf-* setup pointers
1513 tra 2 non-skip return means no buffers
1514 aos chkini-* skip return means buffer ok, so we skip too
1515 return chkini
1516 rem
1517 * routine which, given a buffer, sets up a pointer and tally
1518 rem
1519 chkbuf subr
1520 cx2a
1521 tze chkb01-* no buffer
1522 aos chkbuf-* there is a buffer, so return will skip
1523 tsy a.b006-*,* setbpt
1524 cax2
1525 sta curbuf-* save virtual pointer to buffer
1526 iaa bf.dta-1 make pointer to char-1
1527 ora l.b004-*
1528 sta curptr-*
1529 lda bf.tly,2 get tally from buffer
1530 ana l.b005-* =buftmk
1531 sta curcnt-*
1532 aos nbufs-* count buffers
1533 chkb01 return chkbuf
1534 rem
1535 * subroutine to fetch and decode the next character
1536 rem
1537 chkget subr
1538 chkgt0 szn curcnt-* any chars left in buf?
1539 tnz chkgt1-* yes
1540 ldx2 curbuf-* start of buffer
1541 lda bf.flg,2 pick up flag word
1542 cana l.b006-* =buflst, last buffer in msg?
1543 tnz chkgt2-* yes, return, no more chars
1544 ldx2 bf.nxt,2 next buffer
1545 tsy chkbuf-* set it up
1546 tra chkgt2-* no more buffers
1547 tra chkgt0-* go get char from this buffer
1548 chkgt1 aos chkget-* so return will skip
1549 ila -1
1550 asa curcnt-* count character
1551 ldx2 curptr-* pointer to previous char
1552 iacx2 0,b.1
1553 stx2 curptr-* save pointer for next call
1554 lda 0,2,b.0 get current char
1555 ldq lrcwrd-* save copy of lrc before this char
1556 stq lrcprv-*
1557 ersa lrcwrd-* update lrc
1558 icmpa 64 is it text?
1559 tmi chkgt3-* no
1560 ila tb.cha load text code
1561 tra chkgt2-*
1562 chkgt3 ada tabadr-* get addr of table entry for char
1563 cax2
1564 lda 0,2 get type code
1565 chkgt2 return chkget
1566 rem
1567 * subroutine that truncates the input buffer chain, starting with the next
1568 * character. this is called in case extra data was stored by the
1569 * hsla sub-channel before receive mode was turned off.
1570 rem
1571 chkdel subr
1572 ldx2 curbuf-* buffer that shouldd be last
1573 lda bf.tly,2 get current tally
1574 sba curcnt-* subtract any chars not needed
1575 sta bf.tly,2
1576 ana l.b005-* look at tally
1577 tze chkdl1-* it's zero, find previous one
1578 cx2a get absolute address
1579 tsy a.b007-*,* cvabs
1580 tra chkdl3-* ok to use
1581 chkdl1 lda t.icp,1 following loop gets ptr to prev buf
1582 chkdl2 tsy a.b006-*,* setbpt
1583 cax2
1584 lda bf.nxt,2
1585 cmpa curbuf-* find buf that points to curbuf
1586 tnz chkdl2-* not yet
1587 chkdl3 sta t.ilst,1 this is really last buffer
1588 lda bf.nxt,2 get first buffer to free
1589 stz bf.nxt,2 make chain stop here
1590 tze chkdl4-* no buffers to free
1591 chkdl5 sta freadr-* hold on to buffer address
1592 tsy a.b006-*,* setbpt
1593 cax3 get it in virtual form
1594 lda bf.nxt,3 save next pointer in case more bufs
1595 sta curbuf-*
1596 ldx2 bf.siz,3 get size word from buffer
1597 lda freadr-* get address for freeing
1598 ilq 0 let frebuf get buffer size
1599 tsy a.b002-*,* =frebfh
1600 cx2a get saved size word
1601 arl 15 =number of 32 word buffers - 1
1602 iera -1 add 1 and negate
1603 asa t.icpl,1
1604 lda curbuf-* see if more to free
1605 tnz chkdl5-*
1606 chkdl4 return chkdel
1607 rem
1608 rem
1609 * function to check or generate lrc
1610 rem
1611 chklrc subr
1612 ldx2 curptr-* addr of lrc in msg
1613 lda lrcprv-* value computed so far
1614 szn iosw-* input or output?
1615 tze chklr1-* input
1616 sta 0,2,b.0 output - store lrc
1617 tra chklr2-* done
1618 chklr1 cmpa 0,2,b.0 input - lrc correct?
1619 tnz chklr3-* no, take error return
1620 chklr2 aos chklrc-* setup skip return
1621 chklr3 return chklrc
1622 rem
1623 ireslt bss 1 addr of final answer
1624 rem
1625 iosw bss 1 0=input call, 1=output call
1626 astate bss 1 addr of state table
1627 curstt bss 1 address of current state
1628 tabadr bss 1 addr of either atab or etab
1629 curbuf bss 1 current virtual buffer pointer
1630 curptr bss 1 current virtual character pointer
1631 curcnt bss 1 current tally in buffer
1632 lrcwrd bss 1 lrc accumulation word
1633 lrcprv bss 1 lrc accumulation before current char
1634 nbufs bss 1 count buffers in a chain
1635 ntrflg bss 1 flag for non-trans in trans mode
1636 freadr bss 1 absolute address of buffer to be freed
1637 rem
1638 a.b001 ind cvaddr
1639 a.b002 ind frebfh
1640 a.b003 ind atab
1641 a.b004 ind sttnte
1642 a.b005 ind sttnta
1643 a.b006 ind setbpt
1644 a.b007 ind cvabs
1645 rem
1646 l.b001 vfd 18/chartb
1647 l.b002 vfd 18/stattb
1648 l.b003 vfd 18/statel
1649 l.b004 ind 0,b.1
1650 l.b005 vfd 18/buftmk
1651 l.b006 vfd 18/bfflst
1652 l.b007 oct 0
1653 l.b008 vfd 18/bffbrk
1654 eject
1655 *
1656 * state transition tables for checking bisync message formats
1657 *
1658 statel equ 9 length of entry for one state
1659 *
1660 * table for transparent ascii or ebcdic
1661 *
1662 stttrn null
1663 *
1664 * state 0 - looking at start of message
1665 *
1666 ind tttnak normal character is error here
1667 ind tttntr stx means non-transparent block
1668 ind tttnak etx is error here
1669 ind tttnak etb is error here
1670 ind tttenq enq is a valid msg
1671 ind ttteot eot is valid msg
1672 ind tttnak itb is error here
1673 dec -1 dle means enter state 1
1674 ind tttntr soh means non-transparent block
1675 *
1676 * state 1 - first character was a dle
1677 *
1678 ind tttnak text char is error here
1679 dec -2 stx means start message
1680 ind tttnak etx is error here
1681 ind tttnak etb is error here
1682 ind tttenq dle-enq is valid msg
1683 ind ttteot dle-eot is valid msg
1684 ind tttnak itb is error here
1685 ind tttnak dle is error here
1686 ind tttnak dle-soh is error
1687 *
1688 * state 2 - msg started dle-stx
1689 *
1690 dec -2
1691 dec -2
1692 dec -2
1693 dec -2
1694 dec -2
1695 dec -2
1696 dec -2
1697 dec -3 dle is only interesting char here
1698 dec -2
1699 *
1700 * state 3 - found dle in text
1701 *
1702 dec -2 text char is data
1703 ind tttnak dle-stx is error
1704 ind tttack dle-etx is good end
1705 ind tttack dle-etb is good end
1706 ind tttnak dle-enq is error
1707 ind tttnak dle-eot is error
1708 dec -4 dle-itb is end of int block
1709 dec -2 dle-dle is data
1710 ind tttnak dle-soh is error
1711 *
1712 * state 4 - found dle-itb in text
1713 *
1714 ind tttnak
1715 ind tttnak
1716 ind tttnak
1717 ind tttnak
1718 ind tttnak
1719 ind tttnak
1720 ind tttnak
1721 dec -5 only good character is dle
1722 ind tttnak
1723 *
1724 * state 5 - found dle after itb in text
1725 *
1726 ind tttnak text char is error here
1727 dec -2 stx starts another block
1728 ind tttack etx ends block
1729 ind tttack etb ends block
1730 ind tttnak enq is error
1731 ind tttnak eot is error
1732 dec -2 itb is null block
1733 ind tttnak dle is error here
1734 ind tttnak soh is error
1735 eject
1736 *
1737 * state transition table for non-transparent ebcdic
1738 *
1739 sttnte null
1740 *
1741 * state 0 - looking at start of message
1742 *
1743 ind tttnak text char is error
1744 dec -1 stx starts message
1745 ind tttnak etx is error
1746 ind tttnak etb is error
1747 ind tttenq enq is valid message
1748 ind ttteot eot is valid message
1749 ind tttnak itb is error here
1750 ind tttnak dle is error here
1751 dec -3 soh starts header
1752 *
1753 * state 1 - found stx at front
1754 *
1755 dec -1 text char is valid
1756 ind tttnak stx error here
1757 ind tttack etx is good end
1758 ind tttack etb ius good end
1759 ind tttnak enq is error
1760 ind tttnak eot is error
1761 dec -2 itb is end of int block
1762 dec -1 dle is text char
1763 ind tttnak soh is error
1764 *
1765 * state 2 - found itb in text
1766 *
1767 dec -1 text can start without stx
1768 dec -1 stx starts new block
1769 ind tttack etx is good end
1770 ind tttack etb is good end
1771 ind tttnak enq is error
1772 ind tttnak eot is error
1773 dec -2 itb is null int block
1774 dec -1 dle is just the first data char here
1775 ind tttnak soh is error
1776 *
1777 * state 3 - found soh
1778 *
1779 dec -3 text ok
1780 dec -1 stx starts text
1781 ind tttack etx good end
1782 ind tttack etb good end
1783 ind tttnak enq is error
1784 ind tttnak eot is error
1785 ind tttnak itb is error
1786 dec -3 dle is data
1787 ind tttnak soh is error
1788 eject
1789 *
1790 * state transition table for non-transparent ascii
1791 *
1792 sttnta null
1793 *
1794 * state 0 - looking at start of message
1795 *
1796 ind tttnak text char is error
1797 ind tttsp1 stx - zero lrc and go to state 1
1798 ind tttnak etx is error
1799 ind tttnak etb is error
1800 ind tttenq enq
1801 ind ttteot eot
1802 ind tttnak itb is error
1803 ind tttnak dle is error
1804 ind tttnak soh is error
1805 *
1806 * state 1 - found stx
1807 *
1808 dec -1 text char ok
1809 ind tttnak stx is error
1810 dec -2 etx - go to state 2
1811 dec -2 etb - go to state 2
1812 ind tttenq enq
1813 ind ttteot eot
1814 dec -3 itb - go to state 3
1815 dec -1 dle is got text
1816 ind tttnak soh is error
1817 *
1818 * state 2 - check lrc after etx or etb
1819 *
1820 ind tttsp2 check char and go to tttack
1821 ind tttsp2
1822 ind tttsp2
1823 ind tttsp2
1824 ind tttsp2
1825 ind tttsp2
1826 ind tttsp2
1827 ind tttsp2
1828 ind tttsp2
1829 *
1830 * state 3 -check lrc after itb
1831 *
1832 ind tttsp3 check lrc and goto state 4
1833 ind tttsp3
1834 ind tttsp3
1835 ind tttsp3
1836 ind tttsp3
1837 ind tttsp3
1838 ind tttsp3
1839 ind tttsp3
1840 ind tttsp3
1841 *
1842 * state 4 - looking for stx after itb
1843 *
1844 ind tttnak text is error
1845 ind tttsp1 stx - reset lrc and goto 1
1846 ind tttnak etx is error
1847 ind tttnak etb is error
1848 ind tttenq
1849 ind ttteot
1850 ind tttnak itb is error
1851 ind tttnak dle is error
1852 ind tttnak soh is error
1853 eject
1854 * tables for recognizing interesting characters in
1855 * ascii or ebcdic data
1856 *
1857 gentb macro c,m
1858 org *-64+#1
1859 crsm save,off
1860 ife '#2','',1
1861 vfd 18/tb.#1
1862 ine '#2','',1
1863 vfd 18/tb.#2
1864 crsm restore
1865 org *-#1-1+64
1866 endm gentb
1867 rem
1868 tb.cha equ 0 non-control character
1869 tb.stx equ 1
1870 tb.etx equ 2
1871 tb.etb equ 3
1872 tb.enq equ 4
1873 tb.eot equ 5
1874 tb.itb equ 6
1875 tb.dle equ 7
1876 tb.soh equ 8
1877 rem
1878 atab null ascii table
1879 dup 1,64 start with 64 words of zero
1880 oct 0
1881 gentb aenq,enq and then fill in improtant chars
1882 gentb aetb,etb
1883 gentb aeot,eot
1884 gentb soh
1885 gentb stx
1886 gentb etx
1887 gentb dle
1888 gentb itb
1889 rem
1890 rem
1891 etab null ebcidc table
1892 dup 1,64 start with 64 words of zero
1893 oct 0
1894 gentb eenq,enq fill in interesting chars
1895 gentb eetb,etb
1896 gentb eeot,eot
1897 gentb soh
1898 gentb stx
1899 gentb etx
1900 gentb dle
1901 gentb itb
1902 ttls bisync options
1903 rem
1904 * the following word controls what the bisync read side will
1905 * do in a wait-acknowledgement situation. if "0", the block
1906 * just read will be accepted with a wack. if "1", the
1907 * block will be rejected with an nak.
1908 rem
1909 wackcd oct 0
1910 rem
1911 * the following equ defines how many times the write side
1912 * of this module will send enq to have a bad response
1913 * or no response repeated before giving up and sending an
1914 * eot.
1915 rem
1916 enqlmt equ 3
1917 rem
1918 end