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 ,polled_vip_tables
11 ttl polled_vip_tables
12 editp on
13 pmc off
14 detail off
15 pcc off
16 *********************************************************************
17 *
18 * polled_vip_tables
19 *
20 * These control tables are designed to support the polled VIP
21 * communication protocol. Both controller polling and
22 * round-robin station polling are available.
23 *
24 * Coded November 1978 by Jerry Stern
25 *
26 *********************************************************************
27 rem
28 pvip null
29 rem
30 symdef pvstar
31 rem
32 symref begin
33 symref hungup
34 symref adbyte
35 symref cvaddr
36 rem
37 pmc save,on
38 tib
39 meters
40 csbits
41 tconst
42 pmc restore
43 ttls polled vip cct
44 cctdef
45 rem
46 ct.eot equ ct.sw+ct.t0s+ct.syn
47 rem
48 rem
49 base 64
50 vipcct null * cct for polled vip
51 rem * table 0 - terminate on eot, ignore syn
52 rem
53 vfd 9/ct.ncs,9/ct.ncs * 000 001
54 vfd 9/ct.ncs,9/ct.tb1 * 002 etx
55 vfd 9/ct.eot,9/ct.ncs * eot 005
56 vfd 9/ct.ncs,9/ct.ncs * 006 007
57 vfd 9/ct.ncs,9/ct.ncs * 010 011
58 vfd 9/ct.ncs,9/ct.ncs * 012 013
59 vfd 9/ct.ncs,9/ct.ncs * 014 015
60 vfd 9/ct.ncs,9/ct.ncs * 016 017
61 vfd 9/ct.ncs,9/ct.ncs * 020 021
62 vfd 9/ct.ncs,9/ct.ncs * 022 023
63 vfd 9/ct.ncs,9/ct.ncs * 024 025
64 vfd 9/ct.ign,9/ct.ncs * syn 027
65 vfd 9/ct.ncs,9/ct.ncs * 030 031
66 vfd 9/ct.ncs,9/ct.ncs * 032 033
67 vfd 9/ct.ncs,9/ct.ncs * 034 035
68 vfd 9/ct.ncs,9/ct.ncs * 036 037
69 dup 1,48
70 vfd 9/ct.ncs,9/ct.ncs * 040 - 177
71 rem
72 rem
73 rem * table 1 - store lrc char and switch to table 0
74 rem
75 dup 1,64
76 vfd 9/ct.ncs,9/ct.ncs * 000 - 177
77 rem
78 rem
79 rem
80 start pvip
81 ttls polled vip tib extension symbols
82 tibex poladr,char /* poll address */
83 tibex argadr,char /* address char subroutine arg */
84 tibex argsta,char /* status char subroutine arg */
85 tibex inadr,char /* input message address */
86 tibex insta,char /* input message status char */
87 tibex outdev,char /* output message device address */
88 tibex savdev,char /* pending output message device address */
89 tibex repadr,char /* station address for reply */
90 tibex reptyp,char /* reply type - ack or nak */
91 tibex dspsta,char /* display status */
92 tibex prtsta,char /* printer status */
93 tibex blkend,char /* end of block - etx or etb */
94 rem
95 tibex stat0,word /* line status/line control words */
96 tibex stat1,word
97 tibex stat2,word
98 tibex stat3,word
99 tibex nsbchn,word /* number of subchannels */
100 tibex sbchn1,word /* subchannel mask - part 1 */
101 tibex sbchn2,word /* subchannel mask - part 2 */
102 tibex curadr,word /* current poll address */
103 tibex inkcnt,word /* count of consecutive naks for bad input */
104 tibex onkcnt,word /* count of consecutive naks for bad output */
105 tibex itocnt,word /* count of consecutive timeouts */
106 tibex msgcnt,word /* count of status messages in input frame */
107 tibex qcount,word /* count of consecutive quiescent responses */
108 tibex ptime,word /* pause time between quiescent response cycles */
109 tibex wrtcnt,word /* count of consecutive writes */
110 tibex echom1,word /* echo mask - part 1 */
111 tibex echom2,word /* echo mask - part 2 */
112
113 rem
114 tibex tbxflg,word /* flag word */
115 idle bool 000001 /* ON if polling stopped */
116 quiet bool 000002 /* ON if got quiescent input frame */
117 datrcv bool 000004 /* ON if got input during output */
118 rflag bool 000010 /* ON if reading while writing */
119 textsw bool 000020 /* ON if got text msg in input frame */
120 rderr bool 000040 /* ON if error reading input frame */
121 cntrlr bool 000100 /* ON if controller polling enabled */
122 echosw bool 000200 /* ON if CRLF echoing enabled */
123 afrsw bool 000400 /* ON to await first response */
124 rdpar bool 001000 /* ON if parity error in input frame */
125 blderr bool 002000 /* ON if bdbld done */
126 rem /* return label for error handling */
127 tibex rtnlbl,word
128 ttls polled vip constant symbols
129 *** control characters ***
130 rem
131 dspdev bool 140 /* display device address */
132 prtdev bool 150 /* printer device address */
133 etb bool 027
134 prt bool 032 /* printer message type */
135 ctlpol bool 010 /* controller poll address */
136 eof bool 400 /* special end-of-frame marker */
137 pgof bool 156 /* page overflow status char */
138 rem
139 rem
140 *** line status types ***
141 rem
142 lstpst equ 1 /* printer status */
143 lstito equ 2 /* input timeout */
144 lstink equ 3 /* input nak */
145 lstonk equ 4 /* output nak */
146 lstbof equ 5 /* bad output frame */
147 lstoto equ 6 /* output timeout */
148 lstdst equ 7 /* display status */
149 lstchu equ 8 /* i hung up the channel */
150 rem
151 rem
152 *** line control types ***
153 rem
154 lctssp equ 1 /* start station polling */
155 lctscp equ 2 /* start controller polling */
156 lctstp equ 3 /* stop polling */
157 lctspt equ 4 /* set pause time */
158 lctsem equ 5 /* set echo mask */
159 lctafr equ 6 /* awit first poll response */
160 rem
161 rem
162 *** inscan control strings ***
163 rem
164 quiet1 chstr rescanmatcheot
165 quiet2 chstr matcheot
166 getsoh chstr rescanmatchsohignore
167 mormsg chstr searchsohignore
168 regmsg chstr strlrcmovchrinadrnxtchrmovchrinstanxtchrnxtchrnx
169 etc tchrmatchstxnxtchrserch2etxetbmovchrblkendignore
170 etc cmplrcignore
171 chgadr chstr replacrepadr
172 skpmsg chstr serch2etxetbignoreignorematchsohignore
173 rem
174 rem
175 *** outscn control strings ***
176 rem
177 outfrm chstr rescanendchnmatcheofreplaceotseteom
178 outadr chstr rescansearchsohignoremovchrrepadrsearchetxignore
179 etc ignoresearchsohignoremovchroutdev
180 setlrc chstr rescansearchsohignorestrlrcsearchetxignoreoutlrc
181 etc
182 nxtlrc chstr searchsohignorestrlrcsearchetxignoreoutlrc
183 setpol chstr rescansearchsohignorereplacpoladr
184 rem
185 rem
186 *** bldmsg control strings ***
187 rem
188 polmsg chstr synsynsynsynsohpoladrnullspacespacestxetxspac
189 etc esynsynsynsyneotseteom
190 repmsg chstr synsynsynsynsohrepadrnullspacespacestxetxspac
191 etc esynsynsynsynsohdspdevreptypspacespacestxetxs
192 etc pacesynsynsynsyneotseteom
193 rem
194 echmsg chstr synsynsynsynsohrepadrnullspacespacestxetxspac
195 etc esynsynsynsynsohdspdevreptypspacespacestxcrnl
196 etc etxspacesynsynsynsyneotseteom
197 ttls polled vip dialup and initialization
198 *********************************************************************
199 *
200 * Wait for line to dial up, i.e., wait for dsr to come on.
201 *
202 *********************************************************************
203 rem
204 pvstar tstflg tflisn,lisn /* told to listen ? */
205 wait 0,0,begin /* no, start over */
206 rem
207 lisn tstflg tfdlup,dulisn /* handle dialup line */
208 contrl sdtr+srts+stat /* ready full duplex line */
209 wait 0,0,cklisn
210 status cts+dsr,0,ckdlup
211 rem
212 dulisn contrl sdtr+rrts+stat /* ready halfduplex line */
213 wait 0,0,cklisn
214 status dsr,0,ckdlup
215 rem
216 ckdlup setime 1 /* wait for dsr to stabilize */
217 wait ckdsr,0,cklisn
218 rem
219 ckdsr contrl stat /* find out if dsr is still up */
220 wait 0,0,cklisn
221 status dsr,0,dialed /* yes, this is a real dial up */
222 status 0,dsr,hungup /* no, dsr vanished */
223 rem
224 cklisn tstflg tfhang,hang
225 tstflg tflisn,golisn
226 goto hungup
227 golisn waitm
228 rem
229 rem
230 *********************************************************************
231 *
232 * Line has dialed up. Initialize and signal dialup.
233 *
234 *********************************************************************
235 rem
236 dialed getext ,hang1 /* cant do anything without a tib extension */
237 setcct vipcct
238 config /* configure send and rcv odd parity */
239 smode fg.lpr+fg.lps+fg.lpo
240 rem
241 setflg tfmrcv /* use message rcv mode */
242 setlcl ptime,1 /* default pause time = 1 sec */
243 rem
244 signal dialup
245 ttls polled vip basic work loop
246 *********************************************************************
247 *
248 * Enter idle state. Do nothing until told to start polling.
249 *
250 *********************************************************************
251 rem
252 setlcf tbxflg,idle /* set idle state */
253 isleep wait 0,0,tstate /* wait for a line control order */
254 status 0,dsr,hang
255 rem
256 notidl clrlcf tbxflg,idle /* test-state handler transfers here */
257 dumpin
258 calsub dmpall
259 rem
260 setlcl qcount,0 /* initialize a few things */
261 setlcl wrtcnt,0
262 clrlcf tbxflg,quiet
263 setchr savdev,nochar
264 setlcf tbxflg,afrsw
265 rem
266 rem
267 *********************************************************************
268 *
269 * Find something to do. If there is output, send it. Otherwise,
270 * send a poll. Before polling, however, see if we should pause.
271 *
272 *********************************************************************
273 rem
274 getwrk setlcl inkcnt,0 /* reset error counters */
275 setlcl onkcnt,0
276 setlcl itocnt,0
277 rem
278 tstlcl wrtcnt,2,forcep /* force poll after 2 consecutive writes */
279 tstwrt writef /* have any output ? */
280 tstlcf tbxflg,idle,isleep /* if idle, go to sleep */
281 rem
282 tstlcf tbxflg,quiet,qcycle /* last response was quiescent ? */
283 forcep setlcl qcount,0 /* no, reset counter */
284 goto poll
285 rem
286 qcycle tstlcl ptime,0,poll /* no pause wanted */
287 tstlcf tbxflg,cntrlr,pause /* controller polling enabled ? */
288 addlcl qcount,1 /* no, bump counter */
289 tstlcv qcount,nsbchn,pause /* finished quiescent cycle ? */
290 goto poll /* no */
291 rem
292 pause setlcl qcount,0 /* reset counter */
293 setimv ptime /* set timer */
294 wait poll,writef,tstate /* wait for timer or anything else */
295 status 0,dsr,hang
296 eject
297 *********************************************************************
298 *
299 * Send output if we have a complete frame.
300 *
301 *********************************************************************
302 rem
303 writef addlcl wrtcnt,1 /* bump write counter */
304 clrlcf tbxflg,quiet /* for output, ignore quiescent response */
305 ckeot outscn outfrm,noeot /* is there a complete frame ? */
306 signal sndout /* yes, start the next one coming */
307 rem
308 outscn outadr,badout /* repadr <- select addr, outdev <- device addr */
309 setchr savdev,outdev /* save device address of this output */
310 setchr argadr,repadr
311 calasm swapps /* convert select addr to poll addr */
312 setchr poladr,argadr /* output frame ends with poll to this addr */
313 meterm 1
314 goto sndfrm /* send it */
315 rem
316 badout dmpout /* ugh, a bad output frame */
317 setchr savdev,nochar
318 setlcl stat0,lstbof /* indicate bad output frame */
319 linsta stat0 /* send line status */
320 goto getwrk
321 rem
322 noeot signal sndout /* ask for rest of frame */
323 meter2 m.cnt4,1
324 clrflg tfwabt /* so we can detect write abort at next wait */
325 setime 5 /* wait at most 5 secs */
326 wait otosta,ckeot,tswabt
327 status 0,dsr,hang
328 rem
329 otosta setlcl stat0,lstoto /* indicate output timeouts status */
330 linsta stat0 /* send line status */
331 dmpout /* discard incomplete output */
332 goto getwrk
333 eject
334 *********************************************************************
335 *
336 * Build a poll message.
337 *
338 *********************************************************************
339 rem
340 poll setlcl wrtcnt,0 /* reset write counter */
341 setlcf tbxflg,quiet /* assume quiescent response */
342 tstlcf tbxflg,cntrlr,cpoll /* controller polling enabled ? */
343 rem
344 calasm getspa /* get station poll address */
345 setchr argadr,poladr
346 calasm swapps /* convert to select address */
347 setchr repadr,argadr /* and save for reply */
348 goto poll1
349 rem
350 bldfld setlcl stat0,lstchu /* hung up the channel */
351 linsta stat0 /* tell host */
352 goto hang /* and say goodbye */
353 rem /* if i've been here, tell host and hangup */
354 bdbld tstlcf tbxflg,blderr,bldfld
355 setime 1 /* wait 1 sec and then retry */
356 wait bldwt,0,tstate
357 status 0,dsr,hang
358 bldwt setlcf tbxflg,blderr /* note that i've been here */
359 gotov rtnlbl /* back to where i'm told */
360
361 rem
362 cpoll setchr poladr,ctlpol /* prepare for controller poll */
363 setchr repadr,nochar /* don't know who will respond */
364 poll1 clrlcf tbxflg,blderr /* reset */
365 setlcl rtnlbl,poll1a /* where to go */
366 poll1a bldmsg polmsg,bdbld /* build the poll message */
367 poll2 clrlcf tbxflg,blderr /* reset */
368 setlcl rtnlbl,poll2a
369 poll2a outscn setlrc,bdbld
370 poll3 setchr outdev,nochar /* no output device, i.e., not a select msg */
371 eject
372 *********************************************************************
373 *
374 * Send the output frame and wait for a response.
375 *
376 *********************************************************************
377 rem
378 sndfrm calsub writer /* enter rcv mode and write the frame */
379 tstlcf tbxflg,datrcv,read /* got input during write ? */
380 tstlcf tbxflg,rdpar,read /* got par err for input during write? */
381 rem
382 setime 3 /* set 3 second timeout */
383 wait timout,0,tstate
384 status 0,dsr,hang
385 status brkchr,0,read
386 status exh,0,exhsta
387 status xte,0,xtesta
388 status parity,0,parsta
389 rem
390 timout meter2 m.cnt3,1
391 calsub stprcv /* timed out, leave rcv mode */
392 dumpin /* dump any incomplete input */
393 clrlcf tbxflg,quiet /* did not get quiescent response */
394 addlcl itocnt,1 /* bump counter */
395 tstlcl itocnt,3,itosta /* too many timeouts ? */
396 goto sndfrm /* not yet, send it again */
397 rem
398 itosta tstlcf tbxflg,afrsw,dmpfrm /* skip line status if waiting for response */
399 setlcl stat0,lstito /* indicate input timeout status */
400 setchr argadr,repadr
401 calasm ldstat /* put repadr in stat1 */
402 linsta stat0 /* send line status */
403 rem
404 dmpfrm dmpout /* dump whatever output we had */
405 cmpchr outdev,nochar,rstest /* if poll, check for pending output */
406 setchr savdev,nochar /* no pending output */
407 goto getwrk /* better luck next time */
408 rem
409 parsta setlcf tbxflg,rdpar /* parity error on input */
410 goto read /* meter it later */
411 exhsta meter2 m.exh,1
412 goto read
413 xtesta meter1 m.xte,1
414 eject
415 *********************************************************************
416 *
417 * Got an input frame. See what messages it contains.
418 *
419 *********************************************************************
420 rem
421 read calsub stprcv /* exit rcv mode */
422 clrlcf tbxflg,afrsw /* no longer awaiting first response */
423 setlcl itocnt,0 /* did not time out */
424 tstlcf tbxflg,rdpar,badpar /* parity error in input frame */
425 setchr reptyp,ack /* default reply is an ack */
426 setchr dspsta,nak /* default display status is NAK */
427 setchr prtsta,nochar /* default printer status is none */
428 clrlcf tbxflg,textsw+rderr /* init these flags */
429 setlcl msgcnt,0 /* init status message count */
430 rem
431 inscan quiet1,rdsoh /* type 1 quiescent frame ? */
432 goto endfrm /* yes */
433 rdsoh inscan getsoh,sndnak /* frame must start with soh */
434 inscan quiet2,notqui /* type 2 quiescent message ? */
435 goto endfrm /* yes */
436 notqui clrlcf tbxflg,quiet /* not a quiescent frame */
437 rem
438 rdloop setchr insta,nochar /* init message status */
439 setchr inadr,nochar /* init message address */
440 setchr blkend,nochar /* init block end char */
441 inscan regmsg,badmsg /* is there a regular message ? */
442 goto goodms /* yes, looks good */
443 rem
444 badmsg setlcf tbxflg,rderr /* a sick message */
445 goto nxtmsg
446 rem
447 badpar meter1 m.par,1 /* meter the parity error */
448 clrlcf tbxflg,rdpar /* reset the flag for next time */
449 goto sndnak /* nak the input frame */
450 rem
451 goodms cmpchr poladr,ctlpol,ckmcnt /* sent controller poll ? */
452 goto notpol /* no */
453 ckmcnt tstlcl msgcnt,0,ispol /* yes, is this first message ? */
454 goto notpol /* no */
455 rem
456 ispol setchr argadr,inadr /* get poll addr of responding station */
457 calasm swapps /* convert to select address */
458 setchr repadr,argadr /* that's who we reply to */
459 goto nxtmsg
460 rem
461 notpol cmpchr insta,null,txtmsg /* got a text message */
462 cmpchr insta,prt,txtmsg /* likewise */
463 rem
464 cmpchr inadr,dspdev,dspsav /* got display status */
465 cmpchr inadr,prtdev,prtsav /* got printer status */
466 rem
467 goto nxtmsg /* got garbage */
468 rem
469 dspsav setchr dspsta,insta /* save display status */
470 goto nxtmsg
471 rem
472 prtsav setchr prtsta,insta /* save printer status */
473 rem
474 nxtmsg inscan mormsg,endfrm /* more messages in input frame ? */
475 addlcl msgcnt,1 /* yes, bump status message count */
476 goto rdloop /* process next message */
477 rem
478 endfrm dumpin /* discard the input */
479 tstlcf tbxflg,rderr,sndnak /* might have lost text msg, so send nak */
480 goto dostat
481 rem
482 rem
483 *********************************************************************
484 *
485 * Got a text message. There can only be one text message per
486 * frame and it must be the last message. See if we sent a
487 * controller poll. If so, the first message of the frame
488 * will be a poll message which contains the responding station
489 * address. If not, we must change the device address in the
490 * text message to a station address to identify the message
491 * source.
492 *
493 *********************************************************************
494 rem
495 txtmsg tstlcf tbxflg,rderr,sndnak /* get a clean frame */
496 setlcf tbxflg,textsw /* remember getting text message */
497 cmpchr poladr,ctlpol,sndtxt /* sent controller poll ? */
498 rem
499 inscan getsoh,sndnak /* position to start of input frame */
500 findtx tstlcl msgcnt,0,chgtxt /* status message next ? */
501 addlcl msgcnt,-1 /* yes, decrement status message count */
502 inscan skpmsg,sndnak /* skip the status message */
503 goto findtx /* keep scanning for text message */
504 rem
505 chgtxt inscan chgadr,sndnak /* change the address */
506 sndtxt meterm 0
507 sendin /* send input to Multics */
508 goto reply /* send ack for text message */
509 eject
510 *********************************************************************
511 *
512 * Got bad input. Reply by sending a nak.
513 *
514 *********************************************************************
515 rem
516 sndnak dumpin /* discard bad input */
517 meter2 m.cnt1,1
518 clrlcf tbxflg,quiet /* not a quiescent response */
519 setchr reptyp,nak /* reply type is nak */
520 cmpchr repadr,nochar,dostat /* station adress known ? */
521 tstlcl inkcnt,3,inksta /* have we sent too many naks ? */
522 addlcl inkcnt,1 /* not yet, bump count */
523 goto reply
524 rem
525 inksta setlcl stat0,lstink /* indicate input nak status */
526 setchr argadr,repadr
527 calasm ldstat /* put repadr in stat1 */
528 linsta stat0 /* send line status */
529 rem
530 rem
531 *********************************************************************
532 *
533 * Reply to input frame. Send ack or nak frame.
534 *
535 *********************************************************************
536 rem
537 reply cmpchr reptyp,nak,reply3 /* ordinary nak message */
538 tstlcf tbxflg,echosw,reply2 /* echoing enabled ? */
539 goto reply3 /* no */
540 rem
541 reply2 calasm testem /* test echo mask for current station */
542 tstlcl temflg,0,reply3 /* temflg = 0 means don't echo */
543 clrlcf tbxflg,blderr /* first time here */
544 setlcl rtnlbl,repl2a /* set to come back there */
545 repl2a bldmsg echmsg,bdbld /* build reply frame with echo */
546 goto reply4
547 rem
548 reply3 clrlcf tbxflg,blderr /* reset */
549 setlcl rtnlbl,repl3a
550 repl3a bldmsg repmsg,bdbld /* build ordinary reply frame */
551 rem
552 reply4 clrlcf tbxflg,blderr /* reset */
553 setlcl rtnlbl,repl4a
554 repl4a outscn setlrc,bdbld /* put lrc on select message */
555 clrlcf tbxflg,blderr /* reset */
556 setlcl rtnlbl,repl4b
557 repl4b outscn nxtlrc,bdbld /* put lrc on status message */
558 rem
559 calsub write /* send it */
560 dmpout /* and throw it away */
561 eject
562 *********************************************************************
563 *
564 * Process saved input status. Delete output unless it must
565 * be resent. Note that the receipt of text input from a
566 * display implies that any output sent was ignored and must
567 * be resent.
568 *
569 *********************************************************************
570 rem
571 dostat cmpchr reptyp,nak,dspck /* did we nak the input ? */
572 setlcl inkcnt,0 /* no, reset counter */
573 rem
574 dspck cmpchr outdev,dspdev,dspsnt /* sent display output ? */
575 goto prtck1 /* no */
576 rem
577 dspsnt setchr argsta,dspsta /* set arg for cknak subr */
578 calsub cknak /* check for nak status */
579 cmpchr argsta,nak,prtck2 /* was it nak ? */
580 cmpchr dspsta,pgof,dsplst /* was it PGOF ? */
581 goto txtck /* no */
582 rem
583 dsplst setlcl stat0,lstdst /* send line status */
584 setchr argadr,repadr
585 calasm ldstat /* put repadr and dspsta in stat1 */
586 linsta stat0
587 rem
588 txtck tstlcf tbxflg,textsw,prtck2 /* text message received ? */
589 goto delout /* no, discard the output */
590 rem
591 prtck1 cmpchr outdev,prtdev,prtsnt /* sent printer output ? */
592 goto prtck2 /* no */
593 rem
594 prtsnt setchr argsta,prtsta /* set arg for cknak subr */
595 calsub cknak /* check for nak status */
596 cmpchr argsta,nak,rptest /* was it nak ? */
597 rem
598 delout dmpout /* discard the output frame */
599 setchr savdev,nochar /* no output pending */
600 rem
601 prtck2 cmpchr prtsta,nochar,rptest /* got printer status ? */
602 setlcl stat0,lstpst /* indicate printer status */
603 setchr argadr,repadr
604 setchr argsta,prtsta
605 calasm ldstat /* put repadr and prtsta in stat1 */
606 linsta stat0 /* send line status */
607 eject
608 *********************************************************************
609 *
610 * See if it is necessary to repoll the same station.
611 *
612 *********************************************************************
613 rem
614 rptest cmpchr repadr,nochar,ckdel /* station adress known ? */
615 cmpchr reptyp,nak,rptst2 /* did we nak the input ? */
616 tstlcf tbxflg,textsw,cketb /* got a text message ? */
617 goto ckdel /* no, don't have to repoll */
618 rem
619 cketb cmpchr blkend,etb,rptst2 /* did text block end with etb ? */
620 goto ckdel /* no */
621 rem
622 rptst2 cmpchr outdev,nochar,rptst3 /* last output was a poll, reuse it */
623 goto poll1 /* build a poll message */
624 rem
625 rptst3 cmpchr poladr,ctlpol,rptst4 /* was last poll to controller ? */
626 goto poll3 /* no, already have station poll */
627 rem
628 rptst4 setchr argadr,repadr /* get station select address */
629 calasm swapps /* convert to poll address */
630 setchr poladr,argadr
631 clrlcf tbxflg,blderr /* reset */
632 setlcl rtnlbl,rptst5
633 rptst5 outscn setpol,bdbld /* update into poll message */
634 goto poll2
635 rem
636 ckdel cmpchr outdev,nochar,delpol /* was last output a poll ? */
637 goto rstest /* no */
638 delpol dmpout /* yes, delete it */
639 rem
640 rem
641 *********************************************************************
642 *
643 * Check for pending output to be resent.
644 *
645 *********************************************************************
646 rem
647 rstest cmpchr savdev,nochar,getwrk /* if no saved output, start at top */
648 setchr outdev,savdev /* saved output now current again */
649 goto sndfrm /* resend it */
650 ttls polled vip test-state handler
651 *********************************************************************
652 *
653 * Test-state handler.
654 *
655 *********************************************************************
656 rem
657 tstate tstflg tfhang,hang
658 linctl stat0,tsret /* check for line control */
659 tstlcl stat0,lctssp,setspl /* start station polling */
660 tstlcl stat0,lctscp,setcpl /* start controller polling */
661 tstlcl stat0,lctstp,poloff /* stop polling */
662 tstlcl stat0,lctspt,setpt /* set pause time */
663 tstlcl stat0,lctsem,echomk /* set echo mask */
664 tstlcl stat0,lctafr,setafr /* set await first response switch */
665 tsret waitm
666 rem
667 setspl tstlcl stat1,0,poloff /* if zero subchan count, stop polling */
668 tstlcl stat2,0,cksta3 /* first part of subchan mask is zero ? */
669 goto dossp /* no */
670 cksta3 tstlcl stat3,0,poloff /* if zero subchan mask, stop polling */
671 rem
672 dossp setlcv nsbchn,stat1 /* copy subchannel count */
673 setlcv sbchn1,stat2 /* copy subchannel mask */
674 setlcv sbchn2,stat3
675 setlcl curadr,0 /* init current station address */
676 clrlcf tbxflg,cntrlr /* disable controller polling */
677 rem
678 tstlcf tbxflg,idle,notidl /* if idle, go to work */
679 waitm
680 rem
681 setcpl setlcf tbxflg,cntrlr /* enable controller polling */
682 tstlcf tbxflg,idle,notidl /* if idle, go to work */
683 waitm
684 rem
685 poloff setlcf tbxflg,idle /* enter idle state */
686 waitm
687 rem
688 setpt setlcv ptime,stat1 /* set pause time */
689 waitm
690 rem
691 echomk setlcv echom1,stat2 /* save echo mask */
692 setlcv echom2,stat3
693 tstlcl stat1,0,noecho /* stat1 = 0 means null mask */
694 setlcf tbxflg,echosw
695 waitm
696 noecho clrlcf tbxflg,echosw
697 waitm
698 rem
699 setafr setlcf tbxflg,afrsw /* await first poll response */
700 waitm
701 rem
702 tswabt tstflg tfwabt,wabort /* check for write abort */
703 goto tstate /* nope, do standard test-state stuff */
704 wabort dmpout /* discard output */
705 goto getwrk
706 ttls polled vip hangup and punt handlers
707 *********************************************************************
708 *
709 * Come here to hang up the line.
710 *
711 *********************************************************************
712 rem
713 hang unwind /* in case we jumped out of a subroutine */
714 retext /* free tib extension */
715 hang1 stpchn
716 dumpin
717 calsub dmpall
718 rem
719 contrl rdtr /* drop dtr */
720 clrflg tflisntfhang
721 signal hangup
722 goto hungup
723 ttls polled vip write subroutine
724 ************************************************************************
725 *
726 * subroutine to write the current output stuff.
727 * it can be called at "write", in which case only output
728 * is done, or it can be called at "writer", which
729 * also sets receive mode during the output. the flag
730 * "datrcv" in the tib ext will be set if data is read while
731 * the output is in progress.
732 *
733 * this routine was adapted from the bsc_tables counterpart
734 *
735 ************************************************************************
736 rem
737 write clrlcf tbxflg,rflag /* remember which entry */
738 goto write1
739 rem
740 writer setlcf tbxflg,rflag
741 rem
742 write1 setime 0
743 clrlcf tbxflg,datrcv
744 holdot /* hold all output */
745 rem
746 tstflg tfdlup,write3 /* half duplex */
747 goto write4 /* full duplex */
748 rem
749 write3 tstlcf tbxflg,rflag,write5 /* choose between dcw lists */
750 dcwlst
751 cmd sxmit+srts
752 output outmsg
753 cmd rxmit+rrts+sterm
754 goto write6
755 rem
756 write5 dcwlst
757 cmd sxmit+srec+srts
758 output outmsg
759 cmd rxmit+rrts+sterm
760 goto write6
761 rem
762 write4 tstlcf tbxflg,rflag,write7 /* choose between fulldpx dcwlists */
763 dcwlst
764 cmd sxmit
765 output outmsg
766 cmd rxmit+sterm
767 goto write6
768 rem
769 write7 dcwlst
770 cmd sxmit+srec
771 output outmsg
772 cmd rxmit+sterm
773 rem
774 write6 wait 0,0,tstate /* common wait block */
775 status 0,dsr,hang
776 status term,0,write9
777 status brkchr,0,write8 /* got input during output */
778 status parity,0,write2
779 rem
780 write2 setlcf tbxflg,rdpar /* remember parity error on input frame */
781 waitm /* continue waiting for output to finish */
782 rem
783 write8 setlcf tbxflg,datrcv /* remember data came in */
784 waitm
785 rem
786 write9 retsub
787 ttls polled vip utility routines
788 *********************************************************************
789 *
790 * Routine to exit receive mode.
791 *
792 *********************************************************************
793 rem
794 stprcv contrl rrec+smark
795 wait 0,0,tstate
796 status marker,0,rcvoff
797 rem
798 rcvoff retsub
799 rem
800 rem
801 *********************************************************************
802 *
803 * Routine to dump all output.
804 *
805 *********************************************************************
806 rem
807 dmpall dmpout
808 tstwrt dmpall
809 retsub
810 rem
811 rem
812 *********************************************************************
813 *
814 * Routine to handle received nak status.
815 *
816 *********************************************************************
817 rem
818 cknak cmpchr argsta,nak,cknak2 /* got a nak ? */
819 setlcl onkcnt,0 /* no, reset counter */
820 retsub
821 rem
822 cknak2 meter2 m.cnt2,1
823 addlcl onkcnt,1 /* bump count */
824 tstlcl onkcnt,3,cknak3 /* too many naks received ? */
825 retsub
826 rem
827 cknak3 setlcl onkcnt,0 /* pretend it was an ack */
828 setchr argsta,ack
829 rem
830 setlcl stat0,lstonk /* indicate output nak status */
831 setchr argadr,repadr
832 calasm ldstat /* put repadr in stat1 */
833 linsta stat0 /* send line status */
834 retsub
835 ttls polled vip assembler routines
836 *********************************************************************
837 *
838 * swapps - swap poll/select
839 *
840 * converts the address specified by argadr from a poll address
841 * to a corresponding select address or vice versa.
842 *
843 *********************************************************************
844 rem
845 swapps subr sps,x3
846 rem
847 lda l.a000-* =argadr get addr of argadr
848 tsy a.a000-*,* =adbyte convert it
849 oct 0 conversion failed, die
850 lda 0,3,b.0 get value of argadr
851 iera 96 flip the poll/select bits
852 sta 0,3,b.0 update argadr
853 rem
854 return swapps
855 eject
856 *********************************************************************
857 *
858 *
859 * ldstat - load status
860 *
861 * Stores an address character argadr and a status
862 * character argsta into stat1.
863 *
864 *********************************************************************
865 rem
866 ldstat subr lds,x3
867 rem
868 lda l.a003-* =argsta get addr of argsta
869 tsy a.a000-*,* =adbyte convert it
870 oct 0 conversion failed, die
871 lda 0,3,b.0 get value of argsta
872 lrs 9 shift into q
873 stq ldstmp-* save it
874 rem
875 lda l.a000-* =argadr get addr of argadr
876 tsy a.a000-*,* convert it
877 oct 0 conversion failed, die
878 lda 0,3,b.0 get value of argadr
879 ldq ldstmp-* get back argsta
880 lrs 9 combine with argadr
881 rem
882 ldx3 l.a004-* =stat1 get addr of stat1
883 tsy a.a001-*,* =cvaddr convert it
884 stq 0,3 store status in stat1
885 rem
886 return ldstat
887 rem
888 ldstmp bss 1
889 eject
890 *********************************************************************
891 *
892 * getspa - get station poll address
893 *
894 * Computes the address of the next station to poll based on the
895 * subchannel configuration data. Stores the poll address in
896 * poladr.
897 *
898 *********************************************************************
899 rem
900 getspa subr gsp,x2x3
901 rem
902 ldx3 l.a006-* =sbchn1 get addr of sbchn1
903 tsy a.a001-*,* =cvaddr convert it
904 lda 0,3 get value of sbchn1
905 ldq 1,3 get value of sbchn2 assumed adjacent
906 staq gspsc-* save subchannel mask
907 rem
908 ldx3 l.a010-* =curadr get addr of curadr
909 tsy a.a001-*,* =cvaddr convert it
910 lda 0,3 get value of curadr
911 ora l.a009-* =llr 0 make llr instruction
912 sta gsp010-* put in place
913 rem
914 ldaq gspsc-* get subchannel mask
915 gsp010 llr 0 rotate to current subchan
916 rem
917 ldx2 l.a007-* =37 init shift counter
918 gsp020 iacx2 -1 decrement shift counter
919 tze gsp025-* error, no subchans found
920 llr 1 rotate subchan mask
921 tmi gsp030-* subchan is configured
922 tra gsp020-* keep looking
923 rem
924 gsp025 oct 0 die
925 rem
926 gsp030 stx2 gsptmp-* store shift counter
927 lda l.a007-* =37 get original value
928 sba gsptmp-* get number of shifts
929 ada 0,3 add in starting address
930 cmpa l.a008-* =36 did we wrap around ?
931 tmi gsp035-* no
932 sba l.a008-* =36 yes, normalize
933 gsp035 sta 0,3 update curadr
934 sta gsptmp-* save a copy
935 rem
936 lda l.a001-* =poladr get addr of poladr
937 tsy a.a000-*,* =adbyte convert it
938 oct 0 conversion failed, die
939 ldq gsptmp-* get current subchan addr
940 iaq 32 convert to poll addr
941 stq 0,3,b.0 update poladr
942 rem
943 return getspa
944 rem
945 even
946 gspsc bss 2
947 gsptmp bss 1
948 eject
949 ******************************************************************
950 *
951 * testem - test echo mask
952 *
953 * tests the echo mask to see if echoing is required for
954 * the station whose select address is given by repadr.
955 *
956 ******************************************************************
957 rem
958 testem subr tem,x3
959 rem
960 ldx3 l.a002-* =echom1 get addr of echom1
961 tsy a.a001-*,* =cvaddr convert it
962 lda 0,3 get value of echom1
963 ldq 1,3 get value of echom2 assumed adjacent
964 staq temdbl-* save echo mask
965 rem
966 lda l.a005-* =repadr get addr of repadr
967 tsy a.a000-*,* =adbyte convert it
968 oct 0 conversion failed, die
969 lda 0,3,b.0 get value of repadr
970 iana 31 mask out high-order bits
971 ora l.a009-* =llr 0 make llr instruction
972 sta tem010-* put in place
973 rem
974 ila 1
975 sta temflg-* assume echo enabled
976 rem
977 ldaq temdbl-* get back echo mask
978 tem010 llr 0 rotate to station of interest
979 tmi temret-* echo is enabled
980 stz temflg-* echo is disabled
981 rem
982 temret return testem
983 rem
984 even
985 temdbl bss 2
986 temflg bss 1
987 eject
988 l.a000 vfd 18/argadr
989 l.a001 vfd 18/poladr
990 l.a002 vfd 18/echom1
991 l.a003 vfd 18/argsta
992 l.a004 vfd 18/stat1
993 l.a005 vfd 18/repadr
994 l.a006 vfd 18/sbchn1
995 l.a007 dec 37
996 l.a008 dec 36
997 l.a009 llr 0
998 l.a010 vfd 18/curadr
999 l.a011 oct 377777
1000 rem
1001 a.a000 ind adbyte
1002 a.a001 ind cvaddr
1003 rem
1004 end