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 ttl multics/fnp direct interface adapter -- dia_man
11 lbl ,dia_man
12 pmc off
13 pcc on
14 editp on
15 rem
16 *************************************************************
17 *
18 * note: cs means "central system"
19 *
20 *************************************************************
21 *
22 * dia_man contains the code to control the direct interface
23 * adapter dia in order to handle communications between
24 * the fnp and multics. all such communications are transmitted
25 * by means of "mailboxes" of eight 36-bit words each
26 * which are supplied by the cs.
27 *
28 * dia activity is triggered by:
29 * 1) entries in the dia i/o request queues
30 * placed there by the denq entry
31 *
32 * 2) interrupts from the cs indicating that
33 * a mailbox is to be transmitted to the fnp
34 *
35 * the two basic scenarios are as follows
36 *
37 * 1) fnp-initiated i/o
38 *
39 * entry is placed in request queue by denq
40 * one queue for each line
41 * dgetwk which is scheduled at completion of i/o cycle
42 * finds entry and builds large mailbox which it writes
43 * into cs memory
44 * cs responds either by "freeing" the mailbox
45 * interrupt level 12-15 or by rewriting it with new
46 * information interrupt level 8-11, in either case
47 * causing an entry to be added to the mailbox queue;
48 * dia_man reads the mailbox as described below, interprets
49 * it and marks it free
50 * queue entries are freed immediately upon sending of the mailbox
51 * except in the case of input operations, which are freed
52 * when the input has been accepted
53 *
54 * 2) cs-initiated i/o
55 *
56 * cs sends interrupt to add entry to mailbox queue
57 * when dgetwk finds mailbox queue non-empty, it calls
58 * rdmbx to read the mailbox in from the cs
59 * dia_man does whatever is indicated by the contents of the
60 * mailbox, and when finished either writes a modified copy
61 * of the mailbox back to the cs or just informs the cs
62 * that the mailbox is free
63 *
64 *
65 * during such a cycle as described above, a global
66 * lock the "dia lock" is locked so that there is no attempt
67 * to process more than one mailbox at a time
68 *
69 * a "transaction control word" is used to indicate the
70 * current state of the dia i/o cycle in progress
71 *
72 * two interrupt handlers are used:
73 * dterm handles the interrupt that comes in at the com-
74 * pletion of each i/o operation and schedules
75 * the transaction processor dtrans to deal with the
76 * results of the i/o
77 *
78 * dmail handles the "mailbox ready" interrupt from the
79 * cs and adds an entry to the mailbox queue
80 *
81 * except when copying output buffers from the cs,
82 * dcws for dia i/o are built starting at location "dcws"
83 * in the "conect" subroutine
84 *
85 * the address and length of the current dcw list are
86 * also kept in "conect" so that if necessary the most
87 * recent i/o can simply be restarted by calling conect
88 * again
89 *
90 *
91 * labelling conventions:
92 *
93 * literals have names of the form l.xnnn
94 * where "x" is a letter that varies from subroutine
95 * to subroutine and "nnn" is a 3-digit number that starts
96 * over for each new value of "x"
97 *
98 * address constants have names of the form a.xnnn
99 * where "x" and "nnn" are as above
100 *
101 *
102 * coded August 1974 by Robert S. Coren
103 * modified December 1975 by Jay Goldman
104 * modified November 1978 by robert coren for fnp-initiated
105 * mailboxes.
106 * modified 4th of July, 1979 by Bernard Greenberg
107 * for FNP echo negotiation
108 * modified 1979 may by art beattie to support dn6670
109 * extended memory.
110 * modified September 1984 by Robert Coren to zero block
111 * count when turning off oflow and to call hmode when
112 * setting flow control characters.
113 * modified April 1985 by Robert Coren to include tfabf0
114 * and tfabf1 in "permanent" t.flg3 flags
115 *
116 *************************************************************
117
118 * HISTORY COMMENTS:
119 * 1) change86-04-23Coren, approve86-04-23MCR7300,
120 * audit86-05-19Beattie, install86-07-08MR12.0-1089:
121 * Modified November 1984 by Robert Coren to read echo negotiation break
122 * table from CS.
123 * END HISTORY COMMENTS
124
125 eject
126 symdef dia
127 symdef dterm
128 symdef dmail
129 symdef denq
130 symdef dindcw
131 symdef dicell
132 symdef dmbx
133 symdef derrq
134 symdef diajt
135 symdef dlist
136 symdef diconf
137 symdef ecgifl
138 symdef lctlck
139 symdef diasel 'sel' instruction in conect subroutine
140 rem
141 symref mdisp
142 symref secdsp
143 symref dspqur
144 symref g3wjt
145 symref getbuf
146 symref getbfh
147 symref frebuf
148 symref frebfh
149 symref frelbf
150 symref getmem
151 symref fremem
152 symref gettib
153 symref globsw
154 symref iwrite
155 symref itest
156 symref loutav,houtav
157 symref invp
158 symref hmode
159 symref trace
160 symref ctrl
161 symref brkptr
162 symref shrcct hsla_man subr to release cct
163 symref setptw set page table word
164 symref setbpt set buffer page table word
165 symref cvabs convert buffer address to absolute
166 symref mvpgsc move data paging source
167 symref mvpgtg move data paging target
168 symref hcfg hsla reconfigure subroutine
169 symref hunmsk unmask subchannel
170 symref mincs
171 symref mincd
172 symref mupdat
173 rem
174 ttls m a c r o s
175 rem
176 jumptb macro
177 idrp #1
178 jmps#1 zero
179 tsy ivp-*,*
180 vfd 4/0,7/#1,1/0,6/mbxmod
181 idrp
182 endm
183 rem
184 rem
185 rem
186 rem
187 mpy macro multiplier location-*
188 mpf #1
189 lrl 1
190 endm
191 rem
192 rem
193 dvd macro divisor location-*
194 qls 1
195 dvf #1
196 endm
197 rem
198 pmc save,on
199 systm
200 rem
201 comreg
202 rem
203 tib
204 rem
205 sfcm hsla
206 rem
207 meters
208 rem
209 devtab
210 rem
211 dlytbl
212 rem
213 buffer
214 rem
215 global
216 rem
217 hslatb
218 rem
219 csbits
220 rem
221 ttls dia mailbox opcodes
222 diaop
223 rem
224 alterp
225 rem
226 ttls symbol definitions
227 rem
228 rem transaction control word states
229 rem
230 tcfrst equ 0 first interrupt of session
231 tcdcwl equ 1 dcw list was read
232 tcdata equ 2 data was read
233 tcmbxr equ 3 mailbox was read
234 tcwrd equ 4 wrote data to cs
235 tcblst equ 5 blast message was read
236 tcpchm equ 6 reading data for patch_fnp order
237 tcdmpm equ 7 writing data for dump_fnp order
238 tcinmb equ 8 sent input in a mailbox
239 tcmetr equ 9 sent metering information
240 tcrecn equ 10 echo neg. table was read
241 tcreq equ 11 sent mailbox request count
242 tcfree equ 12 freed mailbox
243 tcwmbx equ 13 wrote mailbox to cs
244 rem
245 tcmax equ 14 maximum value of tcword + 1
246 maxbuf equ 20 maximum number of cs buffers
247 rem
248 rem
249 rem dia opcodes
250 rem
251 diatrg bool 65 transfer gate from cs to fnp
252 diadis bool 70 disconnect
253 diainf bool 71 interrupt fnp
254 diajmp bool 72 jump
255 diainc bool 73 interrupt cs
256 diardc bool 74 read configuration switches
257 diaftc bool 75 data transfer from fnp to cs
258 diactf bool 76 " " " cs to fnp
259 diawrp bool 77 wraparound
260 rem
261 rem
262 rem
263 ntflsn bool /tflisn for turning off listen flag
264 ntfacu bool /tfacu for turning off acu flag
265 lnmask bool 000700 lsla/hsla number in line number
266 submsk bool 000077 subchannel number in line number
267 hslafl bool 001000 hsla bit in line number
268 retry bool 400000 flag for retrying i/o request
269 rejflg bool 200000 flag indicating i/o request has been rejected
270 quitfl bool 100000 flag indicating a quit or hangup is in queue
271 nretry bool /retry*/rejflg
272 ntfwrt bool /tfwrit
273 fatal bool 777640 bits in status word indicating unrecoverable
274 rem error
275 maxerr equ 5 maximum number of consecutive dia errors
276 maxcke equ 2 maximum number of consecutive checksum errors
277 maxchn equ 24 max number of buffers sent to cs by 1 dcw list
278 rem
279 eb.tly equ 2 position in echo buffer of tally upper 9 bits
280 rem
281 qtib equ 0 offset from tib entry of tib address
282 qbuf equ 1 offset from tib entry of buffer address
283 rem
284 dtprty equ 0 priority for dtrans
285 gtprty equ 1 priority for dgetwk
286 rtprty equ gtprty priority for dretry
287 rem
288 rem
289 mqmask bool 17 mask for mailbox queue address
290 mnmask bool 37 mask for mailbox number in 3rd word
291 rem of jump table
292 rem
293 rem
294 rem parity for dcws
295 rem
296 pupper bool 040000 parity bit for bits 0-17
297 plower bool 020000 parity bit for bits 18-35
298 npbits bool /pupper*/plower both bits off
299 rem
300 absflg bool 400000 flag to indicate absolute addressing
301 rem
302 rem
303 rem cs mailbox header format
304 rem 36-bit offsets
305 rem
306 mh.pcw equ 0 peripheral control word
307 mh.cnt equ mh.pcw+1 mailbox request count
308 mh.tim equ mh.cnt+1 terminate interrupt multiplex word timw
309 mh.oct equ mh.tim+1 old request count
310 mh.sub equ mh.pcw+8 submailbox area
311 mh.fsb equ mh.sub+64 start of FNP-controlled submailboxes
312 rem
313 rem
314 rem cs submailbox
315 rem 18-bit offsets
316 rem
317 sm.lno equ 0 line number and fnp number
318 sm.fre equ sm.lno+1 number of free FNP buffers
319 sm.cdl equ sm.fre+1 command data length in 6-bit chars
320 sm.op equ sm.cdl+1 opcode and i/o command
321 sm.cd equ sm.op+1 command data 6 18-bit words
322 sm.adr equ sm.cd+6 cs data address
323 sm.len equ sm.adr+1 data length
324 sm.cks equ sm.len+4 checksum
325 rem
326 rem fields in fnp-controlled submailbox with
327 rem input-in-mailbox opcode
328 rem
329 sm.ict equ sm.cdl input character count
330 sm.dat equ sm.cd input data
331 sm.fcd equ sm.dat+50 flags with input data
332 rem
333 rem fields in fnp-controlled submailbox with
334 rem accept-input opcode
335 rem
336 sm.nbf equ 4 number of buffers in input chain
337 sm.dcw equ 6 start of pseudo-dcw list
338 rem
339 mbxmax equ 2*sm.fcd-2*sm.dat
340 rem
341 sm3msk bool 700000 mask for fnp number
342 smlmsk bool 001777 mask for line number
343 smomsk bool 777000 mask for opcode
344 smcmsk bool 000777 mask for i/o command
345 rem
346 mbxsz equ 16
347 fmbxsz equ 56 size of fnp-controlled mailbox
348 rem
349 ecbits equ 256 number of useful bits in echo negotiation
350 rem break table
351 ecnlen equ ecbits/16 resulting length in words
352 rem
353 bufinc bool 003000 mask for flags showing amount by which
354 rem buffer tally has been adjusted
355 rem
356 ttcolt equ 19 line type for colts executive channel
357 rem
358 trmmod equ 2
359 mbxmod equ 3
360 rem
361 rem
362 rem memory trace types
363 rem
364 mt.trm equ 1
365 mt.mbx equ 2
366 mt.rmb equ 3
367 mt.inq equ 4
368 mt.wcd equ 5
369 mt.ouq equ 6
370 mt.inc equ 7
371 mt.wmb equ 8
372 mt.fre equ 9
373 mt.wtx equ 10
374 mt.rtx equ 11
375 mt.alt equ 12
376 mt.acu equ 13
377 rem
378 rem printer trace switches
379 rem
380 tr.que bool 002
381 tr.mbx bool 004
382 tr.int bool 010
383 rem
384 ct.dev equ 1 offset in control tables of array of
385 rem device table pointers
386 ct.wru equ 4 offset in control tables of "wru" wait block
387 ct.dly equ 5 offset in control tables of first delay table
388 ct.brk equ 6 offset in control tables of send_break pointer
389 rem
390 dia null
391 start dia,2,c3mcsm0c0000
392 pmc restore
393 rem
394 ttls dterm -- handles terminate interrupts from dia
395 rem
396 rem this entry processes terminate interrupts.
397 rem it checks the status and if a recoverable
398 rem error occurred, it restarts the i/o.
399 rem if the i/o succeeded, it uses the transaction
400 rem control word tcword to see whether to schedule
401 rem the transaction processor or the "get-work" subroutine.
402 rem
403 rem
404 dterm null
405 rem
406 rem status should be 000001000000
407 lda stat-* high-order word of status
408 icmpa 1
409 tnz dte005-*
410 szn stat+1-* is low-order word 0?
411 tze dte010-* yes, all is well
412 dte005 null
413 rem
414 lda errcnt-* no, get error count
415 als 1 double error count to use as an offset
416 cax2
417 ldaq stat-* store bad status in table
418 staq a.a011-*,* badsts2
419 lda errcnt-* calc true count
420 iaa 1
421 sta bdstct-* number of consecutive io errors in table
422 rem
423 lda stat+1-* get right-hand word in a
424 ana l.a003-* see if it's one of the restartable ones
425 tze 2
426 die 2 it wasn't, die
427 rem
428 lda errcnt-* get error count again
429 icmpa maxerr reached maximum?
430 tmi 2
431 die 3 yes, that's all for you
432 rem
433 iaa 1 increment count
434 sta errcnt-*
435 ilq errmsg queue an error message to tell cs
436 ldx2 a.a007-* addrsterr, command data for error message
437 tsy a.a008-*,* derrq
438 rem
439 smeter mincs,.mdias,l.a004-*
440 rem
441 szn iopend-* did we have a connect pending?
442 tze 2 no, don't reconnect
443 tsy a.a003-*,* conect reconnect the i/o
444 tra a.a002-*,* return to master dispatcher
445 rem
446 rem i/o was all right
447 dte010 null
448 stz errcnt-* start error count over
449 szn iopend-* were we actually expecting something?
450 tze a.a002-*,* mdisp no, ignore it
451 stz iopend-* if we were, we have it now
452 rem
453 trace mt.trm,tr.int,a.a001-**
454 rem
455 lda a.a001-*,* tcword get transaction control word
456 tmi dte020-* it had better not be negative
457 tze dte040-* if it's zero, nothing to do
458 icmpa tcmax if it's over maximum
459 tmi 2 we die
460 dte020 die 4
461 icmpa tcinmb did we write a mailbox with input?
462 tze a.a002-*,* mdisp yes, don't do anything until we hear
463 rem more from multics
464 rem
465 icmpa tcreq one of the ones we have to act on?
466 tpl dte030-* no, just go unlock
467 rem yes, schedule transaction processor
468 ldaq l.a002-* priority and address of dtrans
469 tsy a.a004-*,* dspqur
470 tra a.a002-*,* back to master dispatcher
471 rem
472 dte030 null nothing to do, unlock dia and call gate
473 tsy a.a005-*,* unlock
474 dte040 null
475 tsy a.a006-*,* gate
476 tra a.a002-*,* back to master dispatcher
477 rem
478 rem
479 rem
480 a.a001 ind tcword transaction control word
481 a.a002 ind mdisp master dispatcher
482 a.a003 ind conect
483 a.a004 ind dspqur scheduling routine
484 a.a005 ind unlock
485 a.a006 ind gate
486 a.a007 ind sterr
487 a.a008 ind derrq
488 a.a009 ind shinp short input flag
489 a.a010 ind mbxfre,3 for marking FNP mailboxes free
490 a.a011 ind badsts,2 index into bad status table
491 rem
492 even
493 l.a001 oct 1,0 good status from dia
494 l.a002 zero dtprty priority and address for
495 ind dtrans scheduling dtrans
496 l.a003 vfd 18/fatal non-restartable dia errors
497 l.a004 dec 1
498 rem
499 rem
500 iopend dec 1 indicates whether i/o is pending
501 rem but set to 1 so first call to gate will happen
502 rem
503 even
504 errcnt oct 0 count of dia i/o errors
505 sterr dec 2 command data for reporting dia error
506 stat oct 1,0 place where dia status is to go
507 badsts bss 12 bad status table
508 bdstct oct 0 number of consecutive errors in table
509 rem
510 ttls dmail -- handler for mailbox interrupt
511 rem
512 rem this entry handles interrupt that comes in when
513 rem mailbox is read from cs
514 rem
515 rem it queues the mailbox for later processing
516 rem
517 dmail null get 3rd word of jump table
518 tsy a.b001-*,* g3wjt
519 rem word is in q
520 lls 11 shift mailbox number into a low
521 iana mnmask mask out rest of word
522 icmpa 12 is it to be read or just freed?
523 tmi dma010-* read
524 szn a.a009-*,* shinp is there short input pending?
525 tze dma010-* no, deal with it later
526 cax1 save mailbox number for trace
527 iaa -12 get mailbox # in range 0-3
528 cax3 mark it free now
529 lda a.a010-*,* mbxfre,3
530 icmpa inmbx is this the one?
531 tnz dma012-* no, free mailbox later
532 rem else do it now
533 stz a.a010-*,* mbxfre,3
534 stz a.a009-*,* zero the flag now
535 ila -1 and decrement mbx use count
536 asa a.b018-*,* mbused
537 ldaq l.a002-* scheduling stuff for dtrans
538 tsy a.a004-*,* dspqur -- make sure transaction processor runs
539 tra dma020-* done
540 dma010 null
541 cax1 get mailbox no. into x1
542 dma012 tsy upmbq-* update the mailbox queue
543 rem
544 cx1a get mailbox no. again
545 icmpa 8 ours originally?
546 tmi dma020-* no, done
547 iaa -8 get it in range 0-3
548 cax3 yes, look at saved opcode
549 lda a.a010-*,* mbxfre,3
550 icmpa inmbx input in mailbox?
551 tnz dma020-* no
552 rem yes, it must have been rejected
553 szn a.a009-*,* shinp were we working on it now?
554 tze dma020-* no, worry about it later
555 stz a.a009-*,* yes, clear the flag now
556 tsy a.a005-*,* unlock make sure mailbox gets read
557 rem
558 dma020 null
559 trace mt.mbx,tr.int,x1
560 tra a.b002-*,* return to master dispatcher
561 rem
562 rem
563 rem rpmbx is scheduled to cause reprocessing of a mailbox
564 rem because of lack of buffer space. to the rest of dia_man,
565 rem it will appear that an interrupt was received for the
566 rem mailbox and handled by dmail
567 rem
568 rem mailbox number is in x1
569 rem
570 rpmbx null
571 tsy upmbq-* update mailbox queue
572 tra a.b015-*,* return to secondary dispatcher
573 rem
574 ttls upmbq -- update mailbox queue
575 rem
576 rem mailbox number to be added to queue of mailboxes to be
577 rem processed is passed in x1
578 rem
579 upmbq subr upm,inhx1
580 rem
581 ldx2 mbqnxa-* get offset of next available slot
582 lda a.b014-*,* in mailbox queue
583 icmpa -1 is it free?
584 tnz upm010-* it had better be
585 lda mbqcnt-* get count, which had better be <16
586 icmpa 16
587 tmi upm020-*
588 upm010 die 1 mailbox queue overflowed
589 rem
590 upm020 null
591 aos mbqcnt-* increment queue count
592 stx1 a.b014-*,* store number in queue entry
593 rem
594 aos mbqnxa-* bump "next available" pointer
595 ila mqmask make it mod 16
596 ansa mbqnxa-*
597 rem
598 tsy a.b003-*,* gate to schedule dgetwk
599 return upmbq
600 rem
601 ttls rdmbx -- subroutine to read mailbox from cs
602 rem
603 rem this subroutine is called by dgetwk when mailbox
604 rem queue count is non-zero in order to read a mailbox from
605 rem the cs. The number of the mailbox is picked up from the
606 rem "next-to-process" entry of the mailbox queue
607 rem
608 rem the routine is entered with interrupts inhibited,
609 rem x1 points to saved copy of indicators for reenabling them
610 rem
611 rdmbx subr rdm,x2x3
612 rem
613 lda mbqcnt-* get mailbox queue count
614 tnz 2 if it's zero,
615 die 5 we screwed up somehow
616 rem
617 iaa -1 decrement it
618 sta mbqcnt-*
619 ldx2 mbqnxt-* get pointer to next entry to process
620 ldq a.b014-*,* pick up mailbox number
621 ila -1 and mark the entry as free
622 sta a.b014-*,*
623 aos mbqnxt-* bump the "next-to-process" pointer
624 ila mqmask force it mod 16
625 ansa mbqnxt-*
626 cqa get mailbox number
627 tmi rdm010-* make sure it's in range of
628 icmpa 16 0-15
629 tmi 2
630 rdm010 die 6
631 icmpa 12 mailbox to be read or just freed?
632 tmi rdm020-* read
633 iaa -12 freed, get number to be 0-3
634 cax3 to use as index to freed words
635 stz a.b016-*,* mbxfre,3
636 ila -1 and decrement mbx use count
637 asa a.b018-*,* mbused
638 ldi 0,1 ****enable interrupts now
639 ila tcfree set tcword to "freed mailbox"
640 sta a.b012-*,* tcword
641 rem
642 tsy a.b017-*,* unlock
643 tsy a.b003-*,* gate make sure dgtwrk runs
644 tra rdmbak-* done
645 rdm020 null we are to read mailbox
646 rem save mailbox number
647 sta a.b008-*,* mbxno
648 icmpa 8 fnp's or cs's?
649 tmi rdm030-* his
650 iaa -8 ours, make it 0 to 3
651 mpy l.b001-* fmbxsz/2 get size
652 iaq mh.fsb and correct offset
653 stq mbxadr-*
654 ila fmbxsz/2 size again
655 sta rdsize-* save it for later
656 tra rdm040-*
657 rdm030 null
658 als 3 multiply mbx no by 8 for addressing
659 iaa mh.sub get full offset in mailbox area
660 sta mbxadr-* save it
661 ila 8 get correct size for cs-controlled mailbox
662 sta rdsize-*
663 rdm040 null
664 rem
665 ldi 0,1 ****enable interrupts
666 stz a.b004-*,* count of consecutive checksum errors
667 rem
668 trace mt.rmb,tr.mbx,a.b008-**
669 rem
670 rem now set up dcw list to read the mailbox
671 rem
672 ldx3 a.b005-* get address of dcw area
673 lda a.b007-*,* csmbx get cs mailbox header addr
674 ada mbxadr-* add mailbox offset
675 ilq diactf get cs -> fnp opcode
676 staq 0,3
677 rem
678 ldq rdsize-* tally for reading mailbox
679 lda a.b006-* addrsavmbx, w.2
680 staq 2,3
681 rem
682 rem save dcw list address for conect subroutine
683 stx3 a.b009-*,* dcwadr
684 iacx3 4 point to next place for dcw
685 tsy a.b011-*,* bdisc set up disconnect dcw
686 rem save tally for conect subroutine
687 ila 4
688 sta a.b010-*,* dcwlen
689 rem
690 rem dcws are all set up
691 rem set transaction control word
692 rem to "mailbox read"
693 rem
694 ila tcmbxr
695 sta a.b012-*,* tcword
696 rem
697 tsy a.b013-*,* conect
698 rdmbak return rdmbx
699 eject
700 a.b001 ind g3wjt get 3rd word of jump table
701 a.b002 ind mdisp master dispatcher
702 a.b003 ind gate
703 a.b004 ind ckecnt count of consecutive checksum errors
704 a.b005 ind dcws static dcw list
705 a.b006 zero savmbx,w.2 fnp's copy of last-read mailbox
706 a.b007 ind csmbx cs address of mailbox header
707 a.b008 ind mbxno mailbox number
708 a.b009 ind dcwadr conect's address of dcw list
709 a.b010 ind dcwlen conect's dcw tally
710 a.b011 ind bdisc subroutine to build a disconnect dcw
711 a.b012 ind tcword transaction control word
712 a.b013 ind conect subroutine to connect to dia
713 a.b014 ind mbqhed,2 for accessing mailbox queue entries
714 a.b015 ind secdsp secondary dispatcher
715 a.b016 ind mbxfre,3
716 a.b017 ind unlock
717 a.b018 ind mbused
718 rem
719 rem
720 l.b001 zero fmbxsz/2
721 rem
722 rem
723 rdsize bss 1 size of this mailbox in 36-bit words
724 dmsvi bss 1 place to save indicators
725 mbxadr bss 1 offset for cs address of mailbox
726 mbqcnt oct 0 mailbox queue count
727 mbqnxa oct 0 next available entry in mailbox queue
728 mbqnxt oct 0 next entry in mailbox queue to process
729 rem
730 rem
731 base 16
732 rem mailbox queue
733 mbqhed dec -1,-1,-1,-1,-1,-1,-1,-1
734 dec -1,-1,-1,-1,-1,-1,-1,-1
735 rem
736 ttls gate -- subroutine to schedule dgetwk
737 rem
738 rem subroutine called when a task is completed to make
739 rem sure that dgetwk gets scheduled. dgetwk will figure
740 rem out if there's more work to do
741 rem
742 rem if dgetwk is already scheduled, we won't bother
743 rem
744 gate subr gat,inhaq
745 rem
746 szn gqued-* see if it's already queued
747 tnz gatbak-* it is, just return
748 rem
749 aos gqued-* else mark it queued now
750 ldaq l.c001-* get dgetwk's priority and address
751 tsy a.c001-*,* dspqur and schedule it
752 rem
753 gatbak return gate
754 rem
755 ttls dgetwk -- reads or requests a mailbox
756 rem
757 rem this routine is scheduled by gate to find out
758 rem if there's anything to do
759 rem more mailboxes to read or request
760 rem
761 rem if the dia lock is locked we will do nothing
762 rem
763 rem
764 dgetwk null
765 sti dgsvi-* hold on to indicators
766 inh ****inhibit interrupts
767 rem
768 smeter mupdat,.mimbx,mbused-* good time to update this
769 rem
770 stz gqued-* turn off "dgetwk queued" flag
771 szn a.c002-*,* =dilock is dia already locked?
772 tnz dgebak-* if it is, return
773 tsy a.c003-*,* =lock else, lock it
774 rem
775 szn a.c014-*,* mbqcnt any mailboxes waiting to be read?
776 tze dge005-* no, don't bother
777 ldx1 a.c016-* dgsvi get address of where indicators are stored
778 tsy a.c015-*,* rdmbx go read the mailbox
779 tra a.c018-*,* and return to secondary dispatcher
780 rem
781 dge005 szn qcnt-* anything in the queue?
782 tze dge030-* no, nothing to do
783 ldx3 a.c019-* addr mbxfre
784 ila -4 check if any are free
785 dge010 szn 0,3 this one?
786 tze dge020-* yes
787 iaa 1 no, are there more?
788 tze dge030-* no, we'll have to deal with it later
789 iacx3 1 look at next
790 tra dge010-*
791 rem
792 dge020 aos mbused-* keep count of mailboxes in use
793 iaa 12 make it in range 8-11
794 sta a.c020-*,* mbxno
795 ldx3 a.c022-* addr savmbx
796 tsy a.c021-*,* filmbx
797 tra dgebak-* all done
798 rem if we come here, nothing to do
799 dge030 null so just clear dia lock and return
800 tsy a.c017-*,* unlock
801 rem
802 dgebak null
803 ldi dgsvi-* ****restore indicators to enable
804 tra a.c018-*,* return to secondary dispatcher
805 rem
806 rem
807 rem
808 a.c001 ind dspqur scheduling routine
809 a.c002 ind dilock dia lock
810 a.c003 ind lock locking subroutine
811 a.c004 ind tcword transaction control word
812 a.c006 ind dcws static area for building dcw list
813 a.c007 ind dcwadr address of dcw list for conect
814 a.c008 ind dcwlen length of dcw list 36-bit words
815 *a.c009 unused
816 a.c010 ind csmbx cs mailbox header address
817 a.c011 ind bint subroutine to build interrupt dcw
818 a.c012 ind bdisc subroutine to build disconnect dcw
819 a.c013 ind conect subroutine to do connect to dia
820 a.c014 ind mbqcnt mailbox queue count
821 a.c015 ind rdmbx subroutine to read a mailbox from cs
822 a.c016 ind dgsvi saved indicators to pass to rdmbx
823 a.c017 ind unlock unlocking subroutine
824 a.c018 ind secdsp secondary dispatcher
825 a.c019 ind mbxfre
826 a.c020 ind mbxno
827 a.c021 ind filmbx
828 a.c022 ind savmbx mailbox save area
829 rem
830 l.c002 oct 004000 for masking overflow
831 even
832 l.c001 zero gtprty priority and address
833 ind dgetwk for scheduling dgetwk
834 rem
835 even
836 qcnt oct 0
837 mbxfre bss 4 words marked to show fnp mailboxes in use
838 mbused oct 0 number of inbound mailboxes now in use
839 gqued oct 0 "dgetwk is queued" flag
840 dgsvi bss 1 place to save indicators
841 rem
842 ttls denq -- subroutine to add entry to dia i/o queue
843 rem
844 rem this subroutine is called from outside dia_man
845 rem to queue a request for dia i/o.
846 rem
847 rem separate queues are maintained for each
848 rem line; a list of tibs and queue pointers is maintained
849 rem for finding the queue for each line.
850 rem
851 rem we will update the mailbox request count as long as
852 rem there are no "accept input" requests already
853 rem on the queue for this line; but there may never be more
854 rem than one mailbox request outstanding for an "accept input"
855 rem opcode for any line.
856 rem
857 rem if a quit or a hangup is queued, and there is a
858 rem rejected "accept input" at the head of
859 rem the queue, all accept inputs are cleansed from the queue
860 rem to ensure that the quit or hangup gets sent.
861 rem
862 rem at entry:
863 rem
864 rem q: opcode to be put in mailbox
865 rem x1: virtual tib address
866 rem
867 rem the opcode is stored in queue element
868 rem
869 rem queue consists of chained buffers, each pointing
870 rem to next buffer
871 rem elements are processed first in, first out
872 rem
873 denq subr den,aqx2x3
874 stz noai-* initialize
875 lda t.line,1 save line number for trace
876 sta a.d013-*,* curqln
877 cx1a need real tib address in a
878 ldx2 t.sfcm,1 assume this is an hsla tib
879 ldx2 sf.hsl,2 get hsla table entry for this channel
880 lda ht.tib,2 this is the real tib address
881 rem
882 den010 null
883 tsy a.d006-*,* getque
884 rem address of this tib's entry in list is in x2
885 lda densq-* is this to mask the line?
886 icmpa linmsk
887 tnz den030-* no, proceed normally
888 ilq 0 initialize q decrement
889 tsy a.d007-*,* getqai any accept inputs in queue?
890 tra den020-* no, queue linmsk now
891 lda 0,2 yes, look at first one
892 ana l.d009-* retry+rejflg see if it's active
893 cmpa l.d010-* retry only
894 tze denbak-* it is, do the rest when it finishes
895 ilq 1 otherwise, it's counted in the queue
896 den020 tsy a.d001-*,* qmask empty the queue and add linmsk
897 adq a.d011-*,* nnonai now have total number removed
898 stq dendec-* that had been counted in qcnt
899 lda a.d009-*,* qcnt
900 sba dendec-* decrement the count accordingly
901 sta a.d009-*,*
902 tra denbak-* finished now
903 rem
904 den030 tsy a.d007-*,* getqai find first accept input in queue
905 tra den060-* none, so must update request count
906 tra den070-* adding entry after a previous accept input
907 rem so no need to update request count
908 rem
909 den060 null add one to queue entry count
910 aos noai-* there's no accept input now
911 aos a.d009-*,* qcnt
912 tsy a.d003-*,* gate make sure dgetwk gets scheduled
913 rem to process queue
914 den070 ldx2 densx2-* get pointer to data
915 ldq densq-* and origional opcode
916 tsy a.d010-*,* adqent update queue
917 rem
918 cqa get opcode in a
919 icmpa accin is opcode "accept input"?
920 tnz den140-*
921 ila 1 get double-precision 1
922 lrl 18
923 szn noai-* first accept input for this line?
924 tnz den080-* yes
925 adaq prevai-* no, meter presence of previous one
926 staq prevai-*
927 tra den090-*
928 den080 adaq nprvai-* meter addition of accept input without one already
929 staq nprvai-*
930 den090 ldq t.icp,1 get pointer to head of chain
931 tnz 2 which must exist
932 die 19
933 rem
934 lda t.dlst,1 get last buffer of previous chain
935 tze den120-* if any
936 tsy a.d014-*,* setbpt
937 cax3 get virtual address
938 rem hook new chain onto
939 stq bf.nxt,3 previous one
940 tra den130-*
941 den120 null
942 rem no old chain, set up new chain pointer
943 stq t.dcp,1
944 den130 null
945 cqa get t.icp back
946 den131 tsy a.d014-*,* setbpt convert it
947 cax3
948 stz denbuf-* init buffer count
949 stz accum-* start counter
950 den132 lda bf.siz,3 count the number of 32-word blocks
951 arl 15 get size code in low-order 3 bits
952 iaa 1
953 asa t.dcpl,1 save length of t.dcp chain
954 szn bf.nxt,3 is this last buffer in chain?
955 tze den135-* yes, go mark it
956 lda bf.flg,3 is this the end of a message?
957 cana l.d001-* =bfflst
958 tnz den133-* yes, break chain here
959 lda bf.tly,3 no, increment running tally
960 ana l.d007-* =buftmk
961 ada accum-* new result
962 cmpa l.d008-* more than max chain length?
963 tpl den133-* yes
964 sta accum-* no, save new running tally
965 lda denbuf-* get buffer count
966 iaa 1 increment
967 icmpa maxchn more than max number of buffers ?
968 tpl den133-* yes
969 sta denbuf-* save new buffer count
970 lda bf.nxt,3 and check next
971 tsy a.d014-*,* setbpt
972 cax3
973 tra den132-*
974 rem
975 den133 ldx2 densx2-* put another accept input in queue
976 ldq densq-*
977 tsy a.d010-*,* =adqent
978 rem
979 den135 lda l.d001-* =bfflst
980 orsa bf.flg,3 mark buffer as last in request
981 lda bf.nxt,3 are there more?
982 tnz den131-* yes, start counting again
983 cx3a get absolute address to save
984 tsy a.d015-*,* cvabs
985 sta t.dlst,1 else mark end of chain
986 rem
987 stz t.icp,1 zero out tib fields so lsla_man or
988 stz t.ilst,1 hsla_man can start new chain
989 stz t.icpl,1
990 lda l.d012-* tfinq
991 orsa t.flg3,1 inproc may add characters to t.dcp chain
992 tra denbak-* all done
993 rem
994 den140 null is it quit or hangup?
995 icmpa brkcon check for quit
996 tze den150-* yup
997 icmpa lindis no, check for hangup
998 tnz denbak-* none of above, we're all done
999 den150 null we must cleanse any accept inputs from the queue
1000 stz t.scll,1 turn off echo negotiation
1001 tsy a.d007-*,* getqai are there any?
1002 tra denbak-* no, forget it
1003 lda 0,2 yes, has it been rejected?
1004 cana l.d005-* =rejflg
1005 tnz den160-*
1006 ora l.d006-* =quitfl if not, mark there's a quit
1007 sta 0,2 behind it in case it does get rejected
1008 tra denbak-*
1009 rem
1010 den160 null cleanse the queue
1011 tsy a.d008-*,* cleanq
1012 rem
1013 denbak return denq
1014 rem
1015 denbuf bss 1
1016 noai bss 1
1017 even
1018 prevai bss 2 count of accept inputs when one already
1019 present for the same channel
1020 nprvai bss 2 count of accept inputs added to queue
1021 without one already present
1022 ttls deque -- remove an accept input from an i/o queue
1023 rem
1024 rem the first item in the relevant line's i/o queue
1025 rem must be an "accept input"; it will be removed from the
1026 rem queue, and the mailbox request count will be updated
1027 rem
1028 rem x1: virtual tib address
1029 rem
1030 deque subr deq,aqx1x2x3
1031 rem
1032 lda a.n001-*,* tibadr get real tib address
1033 tsy a.d006-*,* getque
1034 rem x2 -> tib table entry
1035 tsy a.d007-*,* =getqai find first accept input
1036 die 16 none is fatal
1037 szn a.d011-*,* =nnonai be sure no other entries before accin
1038 tze 2 ok
1039 die 16
1040 rem
1041 tsy a.d012-*,* dlqent free accept input entry
1042 rem
1043 lda t.flg3,1 is the channel masked?
1044 cana l.d011-* tfmask
1045 tze deq005-* no, proceed
1046 tsy a.d001-*,* qmask now is the time to empty the queue
1047 tra deqbak-* that's it
1048 rem
1049 deq005 tsy a.d007-*,* =getqai find first accin in new queue
1050 tra deq010-* none
1051 lda l.d012-* tfinq
1052 orsa t.flg3,1 it's okay to add to existing t.dcp chain
1053 ila 1 must add 1 to req cnt for accin
1054 tra 2
1055 deq010 ila 0
1056 ada a.d011-*,* =nnonai add in entries before accin
1057 tze deqbak-* no requests in queue, return
1058 asa a.d009-*,* qcnt
1059 rem
1060 deqbak null all done
1061 return deque
1062 ttls dretry -- scheduled to retry accept input
1063 rem
1064 rem this entry is scheduled if an attempt to send
1065 rem input to the cs was rejected for lack of
1066 rem buffer space. it turns off the "rejected" flag
1067 rem in the first "accept input" entry for the tib
1068 rem pointed to by x1, and puts out a request for one mailbox
1069 rem
1070 rem if there is no rejected request queued for this
1071 rem line, we will do nothing
1072 rem
1073 rem x1 - real tib address
1074 rem
1075 dretry null
1076 rem
1077 cx1a need real tib address in a
1078 tsy a.d006-*,* getque
1079 tsy a.d007-*,* =getqai find first accept input
1080 tra drebak-* none, return
1081 lda 0,2 pick up queue entry
1082 cana l.d005-* =rejflg has it been rejected?
1083 tze drebak-* no, queue must have been cleaned
1084 rem we have one
1085 lda l.d004-* =nretry
1086 ansa 0,2 zero "retry" flag
1087 aos a.d009-*,* qcnt add one to count of queue entries
1088 tsy a.d003-*,* gate schedule dgetwk
1089 drebak tra a.d005-*,* return to secondary dispatcher
1090 rem
1091 rem
1092 a.d001 ind qmask subr that clears queue and adds linmsk
1093 a.d003 ind gate
1094 a.d005 ind secdsp secondary dispatcher
1095 a.d006 ind getque subroutine to find entry in tib queue list
1096 a.d007 ind getqai subr thats finds first accin in queue
1097 a.d008 ind cleanq cleans accept inputs out of queue
1098 a.d009 ind qcnt count of pending queue entries
1099 a.d010 ind adqent subr that adds entry to end of queue
1100 a.d011 ind nnonai counter set by getqai subr that indicates
1101 rem the number of entries before the first accin
1102 a.d012 ind dlqent subr that deletes entry from the queue
1103 a.d013 ind curqln line number for trace
1104 a.d014 ind setbpt
1105 a.d015 ind cvabs
1106 rem
1107 rem
1108 l.d001 vfd 18/bfflst
1109 l.d002 oct 37 for checking 0 mod 32
1110 l.d003 oct 004000 inhibit overflow indicator
1111 l.d004 vfd 18/nretry
1112 l.d005 vfd 18/rejflg
1113 l.d006 vfd 18/quitfl
1114 l.d007 vfd 18/buftmk
1115 l.d008 dec 2048 arbitrary maximum chain length
1116 l.d009 vfd o18/retry+rejflg
1117 l.d010 vfd 18/retry
1118 l.d011 vfd 18/tfmask
1119 l.d012 vfd 18/tfinq
1120 rem
1121 rem
1122 dendec bss 1 amount by which to decrement qcnt if masking
1123 accum bss 1 running length of chain in characters
1124 rem
1125 ttls derrq -- subroutine to add entry to error message queue
1126 rem
1127 rem this subroutine adds an entry to a special i/o
1128 rem queue for error messages. each entry contains an
1129 rem opcode and 4 words 72 bits of command data to be
1130 rem passed to the cs
1131 rem queue is allocated in buffers of which second word is zero,
1132 rem leaving room for 6 five-word entries
1133 rem
1134 rem because this routine can be called at interrupt
1135 rem time, it must save and restore the variables used
1136 rem to describe the current request queue
1137 rem
1138 rem at entry:
1139 rem
1140 rem q: opcode
1141 rem x2: address of command data
1142 rem
1143 derrq subr der,inhaqx2x3
1144 rem
1145 lda a.n005-*,* =curque
1146 ldq a.d013-*,* =curqln
1147 staq tcurq-* save these in temporary
1148 lda a.n009-*,* =curqbf
1149 sta tcurbf-* this too
1150 rem
1151 stz a.d013-*,* =curqln, zero line number
1152 lda a.n004-* get address of simulated tib table entry
1153 sta a.n005-*,* curque
1154 rem
1155 ldq dersq-* restore opcode to q
1156 adq l.n002-* =004000 indicate 4 words of data
1157 tsy a.d010-*,* adqent add entry to error queue
1158 aos a.n002-*,* qcnt
1159 rem now restore common values
1160 ldaq tcurq-*
1161 sta a.n005-*,* =curque
1162 stq a.d013-*,* =curqln
1163 lda tcurbf-*
1164 sta a.n009-*,* =curqbf
1165 return derrq
1166 rem
1167 rem
1168 a.n001 ind tibadr
1169 a.n002 ind qcnt
1170 a.n003 ind fremem
1171 a.n004 ind errqtb
1172 a.n005 ind curque
1173 a.n006 ind pchbuf
1174 a.n007 ind pchadr
1175 a.n008 ind pchlen
1176 a.n009 ind curqbf
1177 a.n010 ind tcword
1178 rem
1179 l.n002 oct 004000
1180 rem
1181 * the following two words simuulate a tib table entry for
1182 * the dia error queue. the first word corresponds to the
1183 * tib address word, but is not used here. the second word
1184 * points to the first buffer in the queue.
1185 rem
1186 errqtb oct 0
1187 errqbf oct 0
1188 even
1189 tcurq bss 1 temporary for saving curque
1190 tcurln bss 1 likewise for curqln
1191 tcurbf bss 1 likewise for curqbf
1192 rem
1193 tcword oct 0 transaction control word
1194 ttls dtrans -- transaction processor
1195 rem
1196 rem this subroutine is scheduled after dia i/o is finished
1197 rem in order to process the results of the i/o
1198 rem
1199 rem the transaction control word tcword
1200 rem indicates what was just done
1201 rem
1202 rem dia lock is locked at entry
1203 rem
1204 dtrans null
1205 lda a.n010-*,* tcword get transaction control word
1206 tze dtr100-* do nothing if it's zero
1207 icmpa tcreq is its value one that requires action?
1208 tpl dtr100-* no, go away
1209 rem
1210 lda a.n001-*,* tibadr get real address of relevant tib
1211 tsy a.e019-*,* setptw virtualize it
1212 cax1 need it in x1
1213 rem
1214 lda tcword-* get tcword back in a
1215 icmpa tcdcwl did we read dcw list?
1216 tnz dtr010-* if not, try something else
1217 rem if so, set up dcw list to read the data
1218 tsy a.e001-*,* rddata
1219 tra dtr200-* error return buffer allocation failed
1220 ila tcdata reset transaction control word
1221 sta tcword-* to "read data"
1222 tsy a.e002-*,* conect do the connect
1223 tra a.e003-*,* return to secondary dispatcher
1224 rem
1225 dtr010 null
1226 icmpa tcdata did we read data?
1227 tnz dtr050-* if not, try something else
1228 stz bflag-* indicate not blast write
1229 tsy write-* set up chains and notify control tables
1230 rem
1231 rem
1232 szn sndflg-* immediate send output response?
1233 tze dtr090-* no, just free mailbox and return
1234 ldx3 a.e033-* addr savmbx
1235 aos sm.cd,3 turn on send output flag in mbx
1236 cx3a
1237 tsy a.e034-*,* wmbx write mailbox back
1238 tra a.e003-*,* secdsp and done
1239 rem
1240 dtr050 null
1241 icmpa tcmbxr did we read a mailbox?
1242 tnz dtr060-*
1243 tsy a.e014-*,* decmbx yes, go decode it
1244 tra a.e003-*,* that's all
1245 rem
1246 dtr060 null
1247 icmpa tcblst did we read blast message?
1248 tnz dtr080-*
1249 ldx3 blbuf-* yes, get buffer address
1250 rem
1251 iacx3 2*bufsiz save address of second buffer
1252 stx3 blbuf2-*
1253 aos bflag-* so write will know this is blast
1254 rem
1255 ldx2 a.e029-*,* .crttb
1256 rem start scanning all tibs
1257 dtr065 null
1258 lda qtib,2 this is the real tib address
1259 tsy a.e019-*,* setptw virtualize it
1260 cax1 put in x1
1261 lda t.stat,1 find out if it's dialed up
1262 ana l.e010-* tsfcd+tsfdsr
1263 cmpa l.e010-* carrier and dsr both on?
1264 tnz dtr075-* not dialed up, look at next
1265 rem
1266 lda t.type,1 get line type
1267 icmpa 8 tn1200 on 202c?
1268 tze dtr070-* yes, treat like ascii
1269 icmpa 5 regular terminal type 1-4?
1270 tpl dtr075-* no, look at next tib
1271 icmpa 2 is it ibm-type?
1272 tze dtr068-* it's 1050
1273 icmpa 3 if not, 2741?
1274 tnz dtr070-* no
1275 dtr068 ldx3 blbuf2-* yes, point to ebcdic buffer
1276 ila 1 set ebcdic indicator
1277 tra dtr072-*
1278 rem
1279 dtr070 ldx3 blbuf-* ascii, point to ascii buffer
1280 ila 0 set ascii indicator
1281 dtr072 tsy gblast-* allocate output buffers
1282 tsy write-* update output chain, tell control tables
1283 rem
1284 dtr075 iacx2 2 look at next entry in tib list
1285 cmpx2 a.e030-*,* .crtte reached end?
1286 tnz dtr065-* no, look at next tib
1287 ilq 6*bufsiz yes, free message buffers
1288 ldx3 blbuf-*
1289 tsy a.e024-*,* frebuf
1290 rem
1291 tra dtr090-* free mailbox and return
1292 rem
1293 dtr080 icmpa tcpchm patching memory?
1294 tnz dtr084-* no
1295 ldx2 a.n006-*,* pchbuf yes. address of buffer
1296 ldx3 a.n007-*,* pchadr address to patch
1297 ldq a.n008-*,* pchlen length of patch
1298 tsy a.e018-*,* mvpgtg move the patch into place
1299 dtr083 null release buffer
1300 ldx3 a.n006-*,* pchbuf memory space to free
1301 ldq a.n008-*,* pchlen length of memory space
1302 tsy a.n003-*,* fremem
1303 tsy a.e009-*,* gate make sure dgetwk runs
1304 tra dtr100-* and done
1305 rem
1306 dtr084 icmpa tcdmpm dumping memory?
1307 tze dtr083-* yes. release temp memory space
1308 rem
1309 dtr085 icmpa tcinmb wrote data in mailbox?
1310 tnz dtr089-* no
1311 lda t.dcp,1 yes, must take buffers off chain now
1312 ldx3 t.dcp,1 for call to frelbf
1313 stz dnblks-* initialize count
1314 dtr086 tsy a.e037-*,* setbpt
1315 cax2 get virutal address in x2
1316 lda bf.siz,2 get buffer size
1317 arl 15 in 32-word blocks
1318 iaa 1
1319 asa dnblks-* update count
1320 lda bf.flg,2 this the last one?
1321 cana l.e005-* bfflst
1322 tnz dtr088-* yes
1323 lda bf.nxt,2 look at next
1324 tnz dtr086-*
1325 dtr088 ldq dnblks-* get block count
1326 tsy a.e017-*,* instrp take them off t.dcp chain
1327 cx3a
1328 tsy a.e005-*,* frelbf
1329 tsy a.e016-*,* deque remove accin from queue now
1330 ila tcfree set transaction control word to indicate
1331 sta tcword-* end of transaction
1332 tsy a.e009-*,* gate make sure dgetwk runs
1333 tra dtr100-* done with transaction
1334 rem
1335 dtr089 icmpa tcmetr sent metering info?
1336 tnz dtr110-*
1337 ldx3 a.e035-*,* gmebuf get address of temporary buffer
1338 ldq a.e036-*,* gmesiz
1339 tsy a.n003-*,* fremem we're through with it now
1340 tra dtr090-* free mailbox and return
1341 rem
1342 dtr090 null free mailbox and return
1343 tsy a.e013-*,* frembx
1344 tra a.e003-*,* and return to secondary dispatcher
1345 rem
1346 dtr100 null nothing to do, unlock dia lock
1347 tsy a.e023-*,* unlock
1348 tra a.e003-*,* return to secondary dispatcher
1349 rem
1350 dtr110 icmpa tcrecn did we read echo negotiation table?
1351 tnz dtr150-* no
1352 ldx2 a.e020-* addr pdcws point to the table
1353 tsy a.e021-*,* makecn
1354 tra dtr090-* free mailbox and return
1355 rem
1356 dtr150 null by default, we wrote data to cs
1357 rem free buffer chain that was sent
1358 lda a.e015-*,* oldhed
1359 tsy a.e005-*,* frelbf
1360 tsy a.e016-*,* deque remove accin from queue now
1361 tsy a.e009-*,* gate make sure dgetwk runs
1362 tra dtr100-* unlock & return
1363 rem
1364 rem
1365 dtr200 null attempt to allocate output buffers failed
1366 rem we will schedule rpmbx to reprocess the
1367 rem mailbox after 6 seconds
1368 ldx1 a.e027-*,* mbxno
1369 ldaq l.e008-* time, priority, and address of rpmbx
1370 tsy a.e028-*,* dspqur
1371 ila tcmax set transaction control word to illegal value
1372 sta tcword-*
1373 tra dtr100-*
1374 ttls write -- subroutine to set up for sending output
1375 write subr wri,x2
1376 stz sndflg-*
1377 lda t.flg3,1 is this for a line that's been masked?
1378 cana l.e013-* tfmask
1379 tze wri003-* no, proceed
1380 szn bflag-* for blast message?
1381 tnz wribak-* yes, done
1382 lda a.e007-*,* rhead else free the buffer chain now
1383 tsy a.e005-*,* frelbf since we certainly can't use it
1384 tra wribak-*
1385 rem
1386 wri003 lda l.e001-* =tfwrit
1387 cana t.flg,1 output in progress?
1388 tze wri005-* no, check t.ocp chain
1389 lda t.flg2,1 else see if it's in block acknowledge
1390 ana l.e009-* =tfblak+tfofc
1391 cmpa l.e009-* both on?
1392 tze wri005-* yes, don't chain to t.ocur
1393 lda t.echo,1 else check if there's pending echoing
1394 tze wri040-* obviously not, chain new stuff on
1395 tsy a.e037-*,* setbpt
1396 cax2
1397 lda eb.tly,2 there's an echo buffer, anything in it?
1398 arl 9 isolate tally
1399 tze wri040-* no, chain new stuff on
1400 wri005 null else check current chain pointer
1401 lda t.ocp,1 load the pointer
1402 tnz wri010-* already there, must chain on here too
1403 rem none, just set ptr
1404 lda a.e007-*,* =rhead set by rddata
1405 sta t.ocp,1 new output chain
1406 tra wri030-* skip out
1407 rem
1408 wri010 tsy a.e037-*,* setbpt
1409 cax2
1410 szn bf.nxt,2 any forward ptr this block?
1411 tze wri020-* no, chain in here
1412 lda bf.nxt,2 chain to next block
1413 tra wri010-* loop
1414 rem
1415 wri020 null
1416 cmeter mincs,m.over,l.e012-*
1417 rem
1418 lda a.e007-*,* =rhead get head of new chain
1419 sta bf.nxt,2 reset forward ptr in block
1420 rem
1421 wri030 null call "write" entry of control table interpreter
1422 tsy a.e010-*,* iwrite
1423 tra wribak-*
1424 rem
1425 wri040 null write is in progress
1426 szn t.ocur,1 make sure there's a real live chain
1427 tnz 2
1428 die 20 there had better be
1429 rem
1430 cmeter mincs,m.over,l.e012-*
1431 rem hook new output chain onto active chain
1432 lda t.olst,1 get old last buffer
1433 tsy a.e037-*,* setbpt
1434 cax2
1435 lda a.e007-*,* =rhead head of new data
1436 sta bf.nxt,2 attach new chain
1437 lda a.e008-*,* =rtail
1438 sta t.olst,1 update "last buffer"
1439 rem update output chain buffer count
1440 lda a.e025-*,* ndcws same as number of new buffers
1441 asa t.ocnt,1
1442 szn bflag-* is this for blast?
1443 tnz wri050-* yes, don't check for threshold
1444 ila bufthr is count over threshold now?
1445 cmpa t.ocnt,1
1446 tmi wri050-* yes, it's all right
1447 aos sndflg-* no, ask for more output
1448 rem
1449 wri050 null
1450 lda t.type,1 is this colts executive channel?
1451 icmpa ttcolt
1452 tze wribak-* yes, don't call anybody
1453 lda t.line,1 get line number to find out if it's
1454 rem hsla or lsla
1455 cana l.e002-* =hslafl
1456 rem call relevant "output available" entry
1457 tnz wri060-*
1458 tsy a.e011-*,* loutav
1459 tra wribak-*
1460 wri060 tsy a.e012-*,* houtav
1461 wribak return write
1462 ttls storage for dtrans and write
1463 rem
1464 a.e001 ind rddata subroutine to set up dcw lists to read data
1465 a.e002 ind conect
1466 a.e003 ind secdsp secondary dispatcher
1467 a.e004 ind dcwadr address of last-used dcw list
1468 a.e005 ind frelbf subroutine to free a linked list of input buffers
1469 a.e007 ind rhead head of buffer chain allocated by rddata
1470 a.e008 ind rtail tail " " " " " "
1471 a.e009 ind gate
1472 a.e010 ind iwrite
1473 a.e011 ind loutav lsla "output available" subroutine
1474 a.e012 ind houtav hsla " " "
1475 a.e013 ind frembx
1476 a.e014 ind decmbx
1477 a.e015 ind oldhed old head of input chain just sent
1478 a.e016 ind deque
1479 a.e017 ind instrp
1480 a.e018 ind mvpgtg move data paging target subroutine
1481 a.e019 ind setptw set page table word
1482 a.e020 ind pdcws
1483 a.e021 ind makecn
1484 a.e023 ind unlock
1485 a.e024 ind frebfh subroutine to free a single buffer
1486 a.e025 ind ndcws same as number of buffers read in
1487 a.e026 ind denq
1488 a.e027 ind mbxno
1489 a.e028 ind dspqur
1490 a.e029 ind .crttb head of tib list
1491 a.e030 ind .crtte end of tib list
1492 a.e032 ind getbfh
1493 a.e033 ind savmbx
1494 a.e034 ind wmbx
1495 a.e035 ind gmebuf
1496 a.e036 ind gmesiz
1497 a.e037 ind setbpt
1498 rem
1499 rem
1500 l.e001 vfd 18/tfwrit
1501 l.e002 vfd 18/hslafl
1502 l.e003 oct 37 for testing 0 mod 32
1503 l.e004 oct 004000 inhibit overflow indicator
1504 l.e005 vfd 18/bfflst
1505 l.e007 vfd 18/ntfwrt
1506 even
1507 l.e008 vfd 12/1,6/rtprty
1508 ind rpmbx for scheduling rpmbx after 1 second
1509 rem
1510 l.e009 vfd 18/tfblak+tfofc
1511 l.e010 vfd 18/tsfcd+tsfdsr
1512 l.e011 vfd 18/gbfbla "blast" flag for utilities
1513 l.e012 dec 1 for meter increment
1514 l.e013 vfd 18/tfmask
1515 rem
1516 rem
1517 dtrsvi bss 1 for saving indicators
1518 rem blast buffers are three consecutive
1519 rem double-size buffers
1520 rem first is ascii, second is ebcdic,
1521 rem third is correspondence
1522 blbuf bss 1 address of blast buffers
1523 blbuf2 bss 1 address of ebcdic blast buffers
1524 bflag bss 1 flag indicating blast call
1525 dnblks bss 1 number of 32-word blocks to take off chain
1526 ttls gblast -- subroutine to allocate buffers for blast output
1527 sndflg bss 1
1528 rem
1529 rem this subroutine allocates the buffers to be used
1530 rem to send a blast message to a particular line
1531 rem one double-size buffer is sent to ascii lines,
1532 rem or two to ebcdic lines.
1533 rem
1534 rem the message is copied into the allocated buffers
1535 rem
1536 rem Inputs:
1537 rem x3 points to source for message
1538 rem a is 0 for ascii or 1 for ebcdic
1539 rem
1540 gblast subr gbl,x2
1541 rem
1542 sta tflag-* save arguments
1543 stx3 gsrce-*
1544 rem
1545 ilq 2*bufsiz get double buffer size
1546 szn tflag-* ebcdic?
1547 tze 2 no
1548 qls 1 yes, double it again
1549 tsy a.e032-*,* getbuf
1550 die 10 if we can't get buffers, forget it
1551 rem
1552 sta gtarg-* store absolute target address
1553 stx3 vtarg-* and virtual also
1554 ldx2 gsrce-*
1555 stq gsize-*
1556 gbl010 ldaq 0,2 get two words of source
1557 staq 0,3 put them in target buffer
1558 iacx2 2
1559 iacx3 2
1560 ila -2 reduce count
1561 asa gsize-*
1562 tnz gbl010-* not exhausted, go around again
1563 rem
1564 lda gtarg-* get address of head buffer
1565 sta a.e007-*,* rhead where write will look for it
1566 ldx3 vtarg-* get virtual address back
1567 szn tflag-* ascii or ebcdic?
1568 tze gbl020-* ascii
1569 iaa 2*bufsiz ebcdic, set forward pointer
1570 sta bf.nxt,3
1571 tra 2
1572 gbl020 stz bf.nxt,3 ascii, only one buffer
1573 sta a.e008-*,* rtail
1574 return gblast
1575 rem
1576 rem
1577 tflag bss 1 ascii/ebcdic flag
1578 gsrce bss 1 address of source characters
1579 gtarg bss 1 address of target buffer
1580 vtarg bss 1 virtual address of target buffer
1581 gsize bss 1 size of target buffer
1582 rem
1583 ckecnt oct 0 consecutive checksum error count
1584 ttls decmbx -- routine to decode a mailbox from the cs
1585 rem
1586 rem this routine is called if transaction control word
1587 rem indicates that a mailbox has been read from the cs.
1588 rem it will interpret the mailbox that has been read into
1589 rem "savmbx" and take appropriate action depending on the
1590 rem i/o command and opcode in the mailbox
1591 rem
1592 rem
1593 decmbx subr dec
1594 ldx3 a.f018-* =addrsavmbx
1595 lda sm.lno,3 get line number from mailbox
1596 ana l.f001-* =smlmsk
1597 tnz dec005-* there's really a line number
1598 stz a.f017-*,* tibadr use 0
1599 tra dec010-* there's a 0 in the a for x1
1600 dec005 null convert to tib address
1601 tsy a.f003-*,* gettib
1602 sta a.f017-*,* tibadr save real tib address
1603 tsy a.e019-*,* setptw virtualize it
1604 dec010 cax1 x1 gets virtual tib address
1605 rem pick up i/o command
1606 ldq sm.op,3 get i/o command and opcode
1607 ila 0
1608 lls 9
1609 sta opcode-* save opcode
1610 rem
1611 ila 0
1612 lls 9 get i/o command into a
1613 icmpa wcd write command data?
1614 tnz dec210-* no, check for something else
1615 rem yes, search wcd table to determine
1616 rem where to go
1617 trace mt.wcd,tr.mbx,a.f023-**opcodesm.lno3
1618 rem
1619 ldx2 a.f004-* wcdtab
1620 lda opcode-*
1621 dec015 null
1622 cmpa 0,2 check opcode against table entry
1623 tze 1,2* if it matches, go where table says
1624 iacx2 2 else check next entry
1625 cmpx2 a.f025-*,* wcdend reached end?
1626 tnz dec015-* no, look at next entry
1627 die 8 else invalid
1628 rem
1629 rem
1630 dec020 null terminal accepted
1631 szn tibadr-* is this line really configured?
1632 tze dec100-* if not, forget it
1633 ilq sndout queue "send output"
1634 tsy a.f005-*,* denq
1635 tra dec100-*
1636 rem
1637 dec030 null disconnect line
1638 szn tibadr-* is there a tib?
1639 tze dec100-* no, don't try to do anything
1640 lda l.f002-* tfhang
1641 orsa t.flg,1 hang it up
1642 lda l.f003-* ntflsn
1643 ansa t.flg,1 turn off listen flag
1644 rem call test-state entry of interpreter
1645 tsy a.f006-*,* itest
1646 tra dec100-*
1647 rem
1648 dec040 null disconnect all lines
1649 lda l.f004-* gbfhng turn on "hung up" flag
1650 orsa a.f007-*,* globsw
1651 rem now hang up all dialed-up lines
1652 ldx2 a.f013-*,* .crttb
1653 rem
1654 dec045 null
1655 lda qtib,2 get real tib address
1656 tsy a.e019-*,* setptw virtualize it
1657 cax1 put virtual tib address in x1
1658 lda l.f002-* tfhang
1659 orsa t.flg,1 set hangup flag in tib
1660 tsy a.f006-*,* itest
1661 rem
1662 iacx2 2 look at next entry in tib list
1663 cmpx2 a.f039-*,* .crtte reached end?
1664 tnz dec045-* no, go around again
1665 tra dec100-*
1666 rem
1667 dec046 null don't accept calls
1668 lda l.f005-* gbfup
1669 iera -1 complement it
1670 ansa a.f007-*,* globsw turn it off
1671 tra dec100-* that's all
1672 rem
1673 dec050 null accept calls
1674 rem turn global "cs up" switch on
1675 lda l.f005-* gbfup
1676 orsa a.f007-*,* globsw
1677 lda sm.cd,3 get buffer limit for input
1678 sta a.f029-*,* blimit save for future use
1679 rem now call itest for all lines in case they need to
1680 rem start listening again
1681 ldx2 a.f013-*,* .crttb
1682 dec054 lda qtib,2 get tib address
1683 tze dec055-* none, skip it
1684 tsy a.e019-*,* setptw
1685 cax1 now have virtual tib address
1686 tsy a.f006-*,* itest
1687 dec055 iacx2 2 next entry in tib list
1688 cmpx2 a.f039-*,* .crtte reached the end?
1689 tnz dec054-* no, do the next one
1690 tra dec100-*
1691 rem
1692 dec060 null reject request
1693 rem i.e. cs didn't have room for input
1694 rem we will schedule retry routine to retry
1695 rem "accept input" one second from now
1696 tsy a.f008-*,* reject
1697 tra dec100-*
1698 rem
1699 dec065 null enter receive mode
1700 szn tibadr-* not if no line
1701 tze dec100-*
1702 lda l.f015-* tfercv
1703 orsa t.flg2,1 turn on flag in second word
1704 tsy a.f006-*,* itest tell interpreter
1705 tra dec100-* done
1706 rem
1707 dec070 null terminal rejected
1708 szn tibadr-* don't try to hang up nonexistent line
1709 tze dec100-*
1710 lda l.f002-* tfhang
1711 orsa t.flg,1 hang it up, tell interpreter
1712 tsy a.f006-*,* itest
1713 tra dec100-* done
1714 rem
1715 dec075 null set line type
1716 szn tibadr-* if no line, skip it
1717 tze dec100-*
1718 lda sm.cd,3 get new type
1719 sta t.type,1 set it in tib
1720 tra dec100-* that's all
1721 rem
1722 dec080 null checksum error
1723 ila 0 rewrite same mailbox as last time
1724 tsy a.f010-*,* wmbx
1725 tra a.f026-*,* decbak return now
1726 rem
1727 dec085 null blast message
1728 tsy a.f040-*,* rblast sets up dcw to read msg
1729 ila tcblst set transaction control word
1730 sta a.f021-*,* tcword
1731 tsy a.f002-*,* conect
1732 tra a.f026-*,* decbak
1733 rem
1734 dec090 null alter parameters, done by subroutine
1735 szn tibadr-* but not if there's no line
1736 tze dec100-*
1737 tsy a.f009-*,* alterp
1738 tra dec100-* done
1739 rem
1740 dec095 null dial out request
1741 szn tibadr-* but not if there's no line
1742 tze dec100-*
1743 tsy a.f032-*,* acusr done by subroutine
1744 tra dec100-*
1745 rem
1746 dec096 null dump memory
1747 stx3 dctemp-* save mailbox address
1748 ldq sm.cd+3,3 get length of area to dump
1749 stq pchlen-* so memory space can be freed later
1750 tsy a.f012-*,* getmem get equal amount of memory space
1751 die 10 failed
1752 stx3 pchbuf-* save address of buffer
1753 ldx3 dctemp-* retrieve mailbox address
1754 rem copy memory to dump into buffer, it may come
1755 rem from upper 32k
1756 ldx2 sm.cd+2,3 get source address
1757 ldq sm.cd+3,3 get length of memory to be dumped
1758 ldx3 pchbuf-* get address of target
1759 tsy a.f014-*,* mvpgsc move data paging source
1760 rem
1761 ldx3 dctemp-* retrieve mailbox address
1762 lda pchbuf-* put buffer address in mailbox
1763 sta sm.cd+2,3
1764 ila tcdmpm set tcword for dump_fnp order
1765 sta a.f021-*,* tcword
1766 ilq diaftc we'll be writing to cs
1767 tra dec098-* enter common code with patch_fnp order
1768 rem
1769 dec097 null patch memory
1770 stx3 dctemp-* save mailbox addr
1771 ldq sm.cd+3,3 get length of area to patch
1772 tsy a.f012-*,* getmem get equal amount of memory space
1773 die 10 failed
1774 stx3 pchbuf-* save address of patch buffer
1775 cx3a
1776 ldx3 dctemp-* get mailbox addr back
1777 ldq sm.cd+2,3 fnp address to patch
1778 stq pchadr-* save
1779 sta sm.cd+2,3 setup transfer to temp buffer
1780 ldq sm.cd+3,3 get length in words
1781 stq pchlen-* and save
1782 ila tcpchm set tcword for patch_fnp order
1783 sta a.f021-*,* tcword
1784 ilq diactf we'll be reading from cs
1785 dec098 ldx2 a.f033-* dcws
1786 stx2 a.f034-*,* dcwadr
1787 ila 10 space for five dcws
1788 sta a.f035-*,* dcwlen
1789 rem get cs address
1790 lda sm.cd+1,3 bottom 18 bits anyway
1791 staq 0,2 store along with opcode set above
1792 lda sm.cd,3 high-order 6 bits of cs address?
1793 tze dec099-* not there
1794 als 6 yes, put in dcw 24-29
1795 orsa 1,2
1796 rem
1797 dec099 null
1798 ldaq sm.cd+2,3 get fnp address and tally
1799 ora l.f016-* 0w.2
1800 iaq 1 convert tally to 36-bit words
1801 qrs 1
1802 staq 2,2 put them in dcw
1803 cx2a get dcw address
1804 iaa 4 updated
1805 cax3 into x3
1806 rem free the mailbox can't use frembx because
1807 rem it assumes a new dcw list
1808 tsy a.f036-*,* wtimw
1809 tsy a.f037-*,* bint
1810 iacx3 4
1811 tsy a.f038-*,* bdisc
1812 tsy a.f002-*,* conect
1813 tra a.f026-*,* decbak done
1814 rem
1815 dec100 null through with wcd, free the mailbox
1816 tsy a.f011-*,* frembx
1817 tra a.f026-*,* decbak and return
1818 rem
1819 dec101 null msgsiz
1820 lda t.line,1 find out if hsla line
1821 cana l.f007-* hslafl
1822 tze dec100-* it isn't, ignore this mailbox
1823 ldx2 t.sfcm,1 get sfcm address
1824 lda sm.cd,3 get new message size
1825 sta sf.mms,2 save it
1826 tra dec100-* done
1827 rem
1828 dec105 null fnp_break order
1829 tsy a.f041-*,* =brkptr subr to do break point request
1830 tra dec100-* done
1831 rem
1832 dec106 stx3 lctlmb-* line_control - save mbx addr
1833 tsy a.f006-*,* make test state call
1834 stz lctlmb-* this means line_control done
1835 tra dec100-*
1836 rem
1837 dec107 null set_delay
1838 szn tibadr-* any line?
1839 tze dec100-* not really
1840 cx3a get pointer to
1841 iaa sm.cd command data
1842 cax2 into x2
1843 tsy a.f044-*,* makdly
1844 tra dec100-*
1845 rem
1846 dec300 null set framing chars
1847 szn tibadr-* forget it if no line
1848 tze dec100-*
1849 lda sm.cd,3 get the characters
1850 sta t.frmc,1 save in tib
1851 lda t.line,1
1852 cana l.f007-* =hslafl
1853 tze dec100-* not hsla line, don't bother
1854 tsy a.f048-*,* =hmode
1855 tra dec100-*
1856 rem
1857 eject
1858 a.f001 ind gmeter sets up dcw list to report meters
1859 a.f002 ind conect
1860 a.f003 ind gettib translates line number to tib
1861 a.f004 ind wcdtab branch table for wcd opcodes
1862 a.f005 ind denq
1863 a.f006 ind itest interpreter's "test_state" entry
1864 a.f007 ind globsw global switch word
1865 a.f008 ind reject
1866 a.f009 ind alterp subroutine for "alter parameters"
1867 a.f010 ind wmbx
1868 a.f011 ind frembx
1869 a.f012 ind getmem
1870 a.f013 ind .crttb head of tib list
1871 a.f014 ind mvpgsc move data paging source subroutine
1872 a.f015 ind ecgifl echo negotiation input flush
1873 *a.f016 unused
1874 a.f017 ind tibadr some places can`t quite reach it
1875 a.f018 ind savmbx
1876 a.f019 ind rddcw
1877 a.f021 ind tcword transaction control word
1878 a.f022 ind indata subroutine to set up dcws for sending
1879 rem input to cs
1880 a.f023 ind mbxno
1881 a.f024 ind .crmet
1882 a.f025 ind wcdend
1883 a.f026 ind decbak return from this routine
1884 a.f027 ind setbpt
1885 a.f029 ind blimit
1886 *a.f030 unused
1887 rem
1888 a.f032 ind acusr for starting acu
1889 a.f033 ind dcws standard dcw area
1890 a.f034 ind dcwadr
1891 a.f035 ind dcwlen
1892 a.f036 ind wtimw updates timw
1893 a.f037 ind bint builds interrupt dcw
1894 a.f038 ind bdisc builds disconnect dcw
1895 a.f039 ind .crtte end of tib list
1896 a.f040 ind rblast
1897 a.f041 ind brkptr break point request handler
1898 *a.f042 unused
1899 *a.f043 unused
1900 a.f044 ind makdly
1901 *a.f045 unused
1902 *a.f046 unused
1903 *a.f047 unused
1904 a.f048 ind hmode subr that handles mode change for hsla lines
1905 rem
1906 rem
1907 l.f001 vfd 18/smlmsk
1908 l.f002 vfd 18/tfhang
1909 l.f003 vfd 18/ntflsn
1910 l.f004 vfd 18/gbfhng
1911 l.f005 vfd 18/gbfup
1912 l.f006 vfd 18/tfblak+tfofc
1913 l.f007 vfd 18/hslafl
1914 l.f008 vfd 18/lnmask
1915 l.f009 vfd 18/nretry
1916 l.f010 vfd 18/tfitim
1917 l.f011 vfd 18/tfblak
1918 l.f012 vfd o18//tfitim
1919 l.f013 vfd 18/tfctrl
1920 l.f014 vfd o18//tfblak
1921 l.f015 vfd 18/tfercv
1922 l.f016 zero 0,w.2
1923 l.f017 vfd 18/tfofc
1924 l.f018 vfd 18/tfdild
1925 l.f019 vfd 18/tfifc
1926 rem
1927 rem
1928 tibadr bss 1 real address of currently relevant tib
1929 opcode bss 1 opcode from mailbox
1930 dctemp bss 1 temporary
1931 lctlmb oct 0 contains mbx addr during line_control order
1932 pchbuf bss 1 address of patch buffer
1933 pchadr bss 1 address being patched
1934 pchlen bss 1 number of words to patch
1935 eject
1936 dec210 null not wcd
1937 icmpa wtx write text?
1938 tnz dec230-* no, try rtx
1939 lda opcode-* yes, get opcode
1940 icmpa accout must be accept output or
1941 tze dec220-* accept last output
1942 icmpa aclout
1943 tze dec220-*
1944 die 8 otherwise, forget it
1945 rem
1946 dec220 null set up to read dcw list
1947 rem
1948 trace mt.wtx,tr.mbx,a.f023-**sm.lno3sm.adr+13
1949 rem
1950 szn tibadr-* is there really a line?
1951 tze dec100-* if not, just free mailbox and return
1952 rem
1953 tsy a.f019-*,* rddcw
1954 rem
1955 rem set transaction control word to
1956 ila tcdcwl "dcw list read"
1957 sta a.f021-*,* tcword
1958 tsy a.f002-*,* conect
1959 tra decbak-* and return
1960 rem
1961 rem
1962 dec230 null i/o command is rtx or invalid
1963 icmpa rtx
1964 tze 2
1965 die 17
1966 rem
1967 rem it's rtx, opcode must be
1968 lda opcode-* input accepted
1969 icmpa inacc
1970 tze 2
1971 die 8
1972 rem
1973 trace mt.rtx,tr.mbx,a.f023-**sm.lno3
1974 rem
1975 rem put together dcw list for transmitting input
1976 rem to cs
1977 tsy a.f022-*,* indata
1978 rem
1979 ila tcwrd set transaction control word to "wrote data"
1980 sta a.f021-*,* tcword
1981 tsy a.f002-*,* conect
1982 rem
1983 decbak return decmbx
1984 rem
1985 dec350 null set echnego break table
1986 rem
1987 rem the table is too big to fit in a mailbox,
1988 rem so we'll read it into the pseudo-dcw area
1989 szn tibadr-*
1990 tze dec100-* no line?
1991 tsy a.f019-*,* rddcw
1992 ila tcrecn set tcword to "read echo neg. table"
1993 sta a.f021-*,* tcword
1994 tsy a.f002-*,* conect
1995 tra decbak-*
1996 rem
1997 dec360 null start echo negotiation
1998 rem which has the option to refuse echnegooin
1999 rem by zeroing t.scll for any reason whatsoever.
2000 szn tibadr-*
2001 tze dec100-* no line
2002 lda t.echo,1 is there pending echoing?
2003 tze dec370-* no
2004 tsy a.f027-*,* setbpt
2005 cax2
2006 lda eb.tly,2 maybe
2007 arl 9 isolate tally to make sure
2008 tnz dec380-* yes, can't echnego
2009 dec370 szn t.dcp,1 is there a dia-queued input chain?
2010 tnz dec380-* yes, don't negotiate
2011 tsy a.f015-*,* engifl get icp chain queued
2012 szn t.entp,1 make sure there had better be a table
2013 tze dec380-* punt if not
2014 lda sm.cd,3 get # of chars seen by ring 0
2015 cmpa t.sncc,1 is it the same as # of chars we sent out?
2016 tnz dec380-* no, can't echnego
2017 lda sm.cd+1,3 get screen length left, 0 works too.
2018 sta t.scll,1 ok, we're echo negotiating
2019 tra dec100-*
2020 dec380 null fail to start echo negotiation
2021 stz t.scll,1 shoulda been zero anyway for engogo
2022 tra dec100-*
2023 rem
2024 dec400 null stop echo negotiation
2025 szn tibadr-*
2026 tze dec100-*
2027 tsy a.f015-*,* get queued stuff out
2028 ilq engaof acknowledge_echnego_stop
2029 tsy a.f005-*,* denq send one
2030 tra dec380-* turn off negotiation
2031 rem
2032 dec440 null init echo negotiation
2033 szn tibadr-*
2034 tze dec100-* no line?
2035 tsy a.f015-*,* get the act synchronized
2036 stz t.sncc,1 synchronize ctrs
2037 ilq engain acknowledge_echnego_init
2038 tsy a.f005-*,* denq
2039 tra dec100-*
2040 rem
2041 dec450 null set input flow control chars
2042 lda sm.cd,3 get the characters
2043 sta t.ifch,1
2044 szn sm.cd+1,3 timeout options specified?
2045 tze dec455-* no
2046 lda l.f010-* =tfitim
2047 orsa t.flg3,1 yes, set it in tib
2048 tra dec458-*
2049 dec455 lda l.f012-* =^tfitim
2050 ansa t.flg3,1 otherwise, turn it off
2051 dec458 lda t.flg2,1 check if iflow already on
2052 cana l.f019-* =tfifc
2053 tze dec100-* no, never mind
2054 tsy a.f048-*,* hmode have to make sure cct is updated
2055 tra dec100-*
2056 rem
2057 dec460 null set output flow control chars
2058 lda sm.cd,3 get the chars
2059 cmpa t.ofch,1 have they changed?
2060 tze dec462-* no, may not want to reinitialize
2061 sta t.ofch,1 else store them
2062 tra dec463-* and skip other test
2063 dec462 lda t.flg2,1 check for modes already on
2064 ana l.f006-* =tfblak+tfofc
2065 cmpa l.f006-* both on?
2066 tze dec464-* yes, don't initialize block count
2067 dec463 stz t.omct,1 initialize message count
2068 dec464 szn sm.cd+1,3 block acknowledgement protocol?
2069 tze dec465-* no
2070 lda l.f011-* =tfblak
2071 orsa t.flg2,1 yes, set it in tib
2072 tra dec468-*
2073 dec465 lda l.f014-* =^tfblak
2074 ansa t.flg2,1 otherwise, turn it off
2075 dec468 lda t.flg2,1 see if mode is already on
2076 cana l.f017-* =tfofc
2077 tze dec100-* nope
2078 tsy a.f048-*,* hmode yes, have to make sure cct gets updated
2079 tra dec100-*
2080 rem
2081 dec470 null report meters
2082 szn a.f024-*,* .crmet is metering enabled?
2083 tze dec100-* no, just free mailbox
2084 tsy a.f001-*,* gmeter subroutine does it all
2085 tra decbak-*
2086 rem
2087 rem
2088 even
2089 savmbx bss fmbxsz copy of input mailbox
2090 rem
2091 eject
2092 rem
2093 rem This macro is used to set up a branch table fo
2094 rem mailbox opcodes. It generates a word containing
2095 rem the opcode to be checked for, and a word containing
2096 rem the address to branch to for that opcode.
2097 rem
2098 optab macro c,m
2099 zero #1
2100 ind #2
2101 rem
2102 endm optab
2103 rem
2104 wcdtab null table of locations for transfer
2105 rem on wcd opcodes
2106 optab termac,dec020
2107 optab dislin,dec030
2108 optab disall,dec040
2109 optab accall,dec050
2110 optab rejreq,dec060
2111 optab entrcv,dec065
2112 optab trmrej,dec070
2113 optab setcls,dec075
2114 optab cserr,dec080
2115 optab alter,dec090
2116 optab blast,dec085
2117 optab disacc,dec100
2118 optab incomp,dec100
2119 optab frmchr,dec300
2120 optab brack,dec100
2121 optab dodial,dec095
2122 optab dmpmem,dec096
2123 optab pchmem,dec097
2124 optab brkpnt,dec105
2125 optab noacc,dec046
2126 optab linctl,dec106
2127 optab setdly,dec107
2128 optab msgsiz,dec101
2129 optab engstb,dec350
2130 optab engogo,dec360
2131 optab engoff,dec400
2132 optab engini,dec440
2133 optab infcc,dec450
2134 optab outfcc,dec460
2135 optab rmeter,dec470
2136 wcdend zero * to mark end of table
2137 rem
2138 rem
2139 *
2140 * this subroutine is called by a linctl opblock to see if the
2141 * current test state call is caused by a line_control
2142 * order. the convention is that during a line_control order,
2143 * "lctlmb" is non-zero, and contains the mailbox addr
2144 *
2145 lctlck subr lct,a
2146 lda a.g007-*,* =lctlmb, pick up mailbox addr
2147 tze lctret-* not line contorl
2148 iaa sm.cd get addr of data
2149 cax3
2150 aos lctlck-* take skip return
2151 lctret return lctlck
2152 ttls alterp -- subroutine to handle "alter parameters"
2153 rem
2154 rem
2155 rem this subroutine does whatever is necessary when an
2156 rem "alter parameters" opcode is sent from the cs
2157 rem
2158 rem the subcommand to be performed is in the first 9
2159 rem bits of the command data in the mailbox
2160 rem for most of the subcommands currently implemented,
2161 rem the low-order bit of the first word of command
2162 rem data indicates "on" or "off"
2163 rem
2164 rem at entry:
2165 rem x1 -- virtual tib address
2166 rem x3 -- mailbox address
2167 rem
2168 alterp subr alt
2169 rem
2170 trace mt.alt,tr.mbx,sm.cd3
2171 rem
2172 stz caltst-* initialize "call itest" flag
2173 stz chmode-* and "call hmode" flag
2174 stz checho-* and "change acho mode" flag
2175 lda a.g009-* =t.flg,1
2176 sta flgptr-* initialize pointer to t.flg
2177 lda t.type,1 is this colts executive channel?
2178 icmpa ttcolt if so, we use a much shorter
2179 tze alt500-* list of subcommands
2180 lda sm.cd,3 get first 18 bits of command data
2181 lrl 9 isolate subcommand
2182 ldx2 a.g001-* addralttab
2183 alt010 null
2184 cmpa 0,2 does subcommand match table entry?
2185 tze 1,2* yes, go process it
2186 iacx2 2 no, check next
2187 cmpx2 a.g011-*,* altend if not at end of table
2188 tnz alt010-*
2189 die 8 else die
2190 rem
2191 alt020 null crecho
2192 lda l.g001-* =tfcrec
2193 tra alt135-* join common code
2194 rem
2195 alt030 null lfecho
2196 lda l.g002-* =tflfec
2197 tra alt135-*
2198 rem
2199 alt040 null tbecho
2200 lda l.g003-* =tftbec
2201 tra alt140-*
2202 rem
2203 alt050 null handle quit
2204 lda l.g004-* =tfquit
2205 tra alt150-*
2206 rem
2207 alt060 null listen
2208 tsy a.g012-*,* setsiz pick up buffer size from mailbox
2209 qrl 0 check flag
2210 tze alt065-* turning it off, don't worry
2211 lda t.flg3,1 was the channel masked?
2212 cana l.g027-* =tfmask
2213 tze alt065-* no
2214 tsy a.g013-*,* hunmsk yes, unmask it now
2215 alt065 lda l.g005-* =tflisn
2216 aos caltst-* call itest when done
2217 rem
2218 tra alt150-*
2219 rem
2220 alt070 null lock
2221 lda l.g008-* =tfctrl
2222 tra alt150-*
2223 rem
2224 alt080 null full duplex
2225 lda l.g009-* =tffdpx
2226 tra alt150-*
2227 rem
2228 alt090 null change-string
2229 tra altbak-* that's all
2230 rem
2231 alt100 null who-are-you
2232 rem must start control tables at special place
2233 rem to read answerback
2234 lda l.g005-* =tflisn
2235 cana t.flg,1 if line isn't listening,
2236 tze altbak-* don't bother
2237 rem
2238 ila -wruinc check list of line types for which wru is no good
2239 ldx2 a.g005-* addrwrutbl
2240 ldq t.type,1
2241 rem
2242 alt101 cmpq 0,2 is this one?
2243 tze alt102-* yes
2244 iacx2 1 look at next
2245 iaa 1 exhausted table?
2246 tnz alt101-* no
2247 rem
2248 ilq wrutim send "wru timeout" right away
2249 tsy a.g006-*,* denq
2250 tra altbak-*
2251 rem
2252 alt102 ldx2 a.g004-* addrctrl
2253 lda ct.wru,2 address of special wait block
2254 sta t.cur,1 tell interpreter to start there
2255 stz t.reta,1 in case we yanked it out of subr
2256 tsy a.g002-*,* itest
2257 tra altbak-*
2258 rem
2259 alt110 null echoplex mode
2260 lda l.g011-* =tfecpx
2261 tra alt135-*
2262 rem
2263 alt120 null framei mode
2264 lda t.line,1 hsla line?
2265 cana l.g010-* =hslafl
2266 tze alt125-* no, buffer sizes are uninteresting
2267 qrl 0 check the flag
2268 tze alt125-* turning it off, no buffer sizes
2269 ldx2 t.sfcm,1 get sfcm address
2270 lda sm.cd+1,3 get intermediate buffer size
2271 tsy rndsiz-* get it in words
2272 sta sf.bsz,2 save it
2273 lda sm.cd+2,3 get size to be used during frame
2274 tze 2 if any
2275 tsy rndsiz-* in words
2276 sta sf.fbs,2 save it
2277 rem
2278 alt125 null
2279 ila t.flg2-t.flg
2280 asa flgptr-* update flgptr to point to t.flg2
2281 lda l.g018-* tffrmi
2282 tra alt140-*
2283 rem
2284 alt135 aos checho-* echoing mode changed
2285 rem
2286 alt140 null
2287 aos chmode-*
2288 rem
2289 alt150 null flag on or off?
2290 qrl 0
2291 tze alt160-*
2292 orsa flgptr-*,* on
2293 tra alt170-*
2294 alt160 null off
2295 iera -1
2296 ansa flgptr-*,*
2297 rem
2298 alt170 null mode changed?
2299 szn chmode-*
2300 tze alt180-* no
2301 lda t.line,1 yes, hsla line?
2302 cana l.g010-* hslafl
2303 tze alt175-* no
2304 tsy a.g003-*,* call hmode
2305 rem
2306 alt175 szn checho-* did we change an echoing mode?
2307 tze alt180-* no
2308 lda t.flg,1
2309 cana l.g016-* tflfec+tfcrec+tfecpx
2310 tnz alt180-* echoing not all off
2311 tsy a.g008-*,* deldly we have stopped echoing, remove delay table
2312 stz t.dtp,1
2313 rem
2314 alt180 null call itest?
2315 szn caltst-*
2316 tze altbak-* no,return
2317 tsy a.g002-*,* itest
2318 tra altbak-*
2319 rem
2320 alt190 null dump input
2321 lda l.g013-* =tfrabt
2322 orsa t.flg2,1 set read abort flag
2323 tsy a.g002-*,* itest
2324 tra altbak-*
2325 rem
2326 alt200 null dump output
2327 lda l.g006-* =tfwabt
2328 orsa t.flg,1 on
2329 lda l.g007-* =^tfwrit
2330 ansa t.flg,1 tfwrit off
2331 tsy a.g002-*,* itest
2332 tra altbak-*
2333 rem
2334 alt210 null xmit hold
2335 lda l.g012-* =tfxhld
2336 qrl 0 on or off?
2337 tze alt220-*
2338 orsa t.flg2,1 on, just do it
2339 tra altbak-*
2340 alt220 null off, we'll have to do test-state also
2341 iera -1
2342 ansa t.flg2,1 turn flag off
2343 tsy a.g002-*,* itest
2344 tra altbak-*
2345 rem
2346 alt230 null replay mode
2347 lda l.g014-* =tfrply get bit
2348 rem
2349 alt240 qrl 0 on or off?
2350 tze alt245-* off, do it
2351 orsa t.flg2,1 turn it on
2352 tra altbak-*
2353 rem
2354 alt245 null
2355 iera -1 invert flag bit
2356 ansa t.flg2,1 turn it off
2357 tra altbak-*
2358 rem
2359 alt250 null polite mode
2360 lda l.g015-* =tfplit get the bit
2361 tra alt240-* common code to set second flag word bits
2362 rem
2363 alt260 null set buffer size
2364 tsy setsiz-* just do it
2365 tra altbak-* and begone
2366 rem
2367 alt270 null breakall mode
2368 ila t.flg3-t.flg
2369 asa flgptr-* make flgptr point to t.flg3
2370 lda l.g019-* =tfbral prepare to set breakall flag
2371 tra alt140-*
2372 rem
2373 alt280 null prefixnl mode
2374 ila t.flg2-t.flg
2375 asa flgptr-*
2376 lda l.g020-* =tfpfnl
2377 tra alt150-*
2378 rem
2379 alt290 null iflow mode
2380 ila t.flg2-t.flg make flgptr point to t.flg2
2381 asa flgptr-*
2382 lda t.line,1 is it hsla line?
2383 cana l.g010-* =hslafl
2384 tze alt295-*
2385 ldx2 t.sfcm,1 if so, have to update buffer size
2386 lda sm.cd+1,3 get it from mailbox
2387 tsy rndsiz-*
2388 sta sf.fbs,2
2389 alt295 lda l.g021-* =tfifc
2390 tra alt140-* go set it
2391 rem
2392 alt300 null oflow mode
2393 ila t.flg2-t.flg make flgptr point at t.flg2
2394 asa flgptr-*
2395 qrl 0 turning it on or off?
2396 tnz alt309-* on, go ahead
2397 lda t.flg2,1 off, was it block acknowledgement?
2398 cana l.g023-* =tfblak
2399 tze alt309-* no, hsla_man will take care of it
2400 stz t.omct,1 else must reset counter
2401 aos caltst-* and alert control tables
2402 alt309 lda l.g022-* =tfofc
2403 tra alt140-* go do it
2404 rem
2405 alt310 null odd parity
2406 ila t.flg3-t.flg make flgptr point at t.flg3
2407 asa flgptr-*
2408 lda l.g024-* =tfoddp
2409 tra alt140-*
2410 rem
2411 alt320 null no input parity
2412 ila t.flg3-t.flg make flgptr point at t.flg3
2413 asa flgptr-*
2414 lda l.g025-* =tf8in
2415 tra alt150-*
2416 rem
2417 alt330 null no output parity
2418 ila t.flg3-t.flg make flgptr point at t.flg3
2419 asa flgptr-*
2420 lda l.g026-* =tf8out
2421 tra alt140-*
2422 rem
2423 rem
2424 alt400 null send line break
2425 rem must start control tables at special place
2426 rem to send line break
2427 rem
2428 ldx2 a.g004-* addrctrl
2429 lda ct.brk,2 address of special wait block
2430 sta t.cur,1 tell interpreter to start there
2431 stz t.reta,1 in case we yanked it out of subr
2432 tsy a.g002-*,* itest
2433 tra altbak-*
2434 rem
2435 alt500 null come here for colts channel
2436 lda sm.cd,3 get ifrst 18 bits of command data
2437 lrl 9 isolate subcommand
2438 ldx2 a.g010-* addr alctab
2439 alt510 null
2440 cmpa 0,2 does subcommand match table entry?
2441 tze 1,2* yes, go process it
2442 iacx2 2 no, check next
2443 cmpx2 alcend-* reached end of table?
2444 tnz alt510-* no, look again
2445 tra altbak-* ignore any not in table
2446 rem
2447 altbak return alterp
2448 rem
2449 rem
2450 rem
2451 a.g001 ind alttab
2452 a.g002 ind itest "test_state" entry of interpreter
2453 a.g003 ind hmode "change-mode" entry of hsla_man
2454 a.g004 ind ctrl
2455 a.g005 ind wrutbl table of invalid "wru" line types
2456 a.g006 ind denq
2457 a.g007 ind lctlmb
2458 a.g008 ind deldly
2459 a.g009 ind t.flg,1 used to set up address variable for flag word
2460 a.g010 ind alctab
2461 a.g011 ind altend
2462 a.g012 ind setsiz
2463 a.g013 ind hunmsk
2464 rem
2465 l.g001 vfd 18/tfcrec
2466 l.g002 vfd 18/tflfec
2467 l.g003 vfd 18/tftbec
2468 l.g004 vfd 18/tfquit
2469 l.g005 vfd 18/tflisn
2470 l.g006 vfd 18/tfwabt
2471 l.g007 vfd 18/ntfwrt
2472 l.g008 vfd 18/tfctrl
2473 l.g009 vfd 18/tffdpx
2474 l.g010 vfd 18/hslafl
2475 l.g011 vfd 18/tfecpx
2476 l.g012 vfd 18/tfxhld
2477 l.g013 vfd 18/tfrabt
2478 l.g014 vfd 18/tfrply
2479 l.g015 vfd 18/tfplit
2480 l.g016 vfd 18/tflfec+tfcrec+tfecpx
2481 l.g017 vfd 18/bfmsiz
2482 l.g018 vfd 18/tffrmi
2483 l.g019 vfd 18/tfbral
2484 l.g020 vfd 18/tfpfnl
2485 l.g021 vfd 18/tfifc
2486 l.g022 vfd 18/tfofc
2487 l.g023 vfd 18/tfblak
2488 l.g024 vfd 18/tfoddp
2489 l.g025 vfd 18/tf8in
2490 l.g026 vfd 18/tf8out
2491 l.g027 vfd 18/tfmask
2492 rem
2493 rem
2494 caltst bss 1 flag indicating whether to call itest
2495 chmode bss 1 flag indicating mode change
2496 checho bss 1 flag indicating echo-mode change
2497 altemp bss 1 temporary storage
2498 atemp2 bss 1 more temporary storage
2499 flgptr ind ** this will be set with x1 modification
2500 rem
2501 rem
2502 alttab equ * branch table for alter parameters subcommands
2503 rem
2504 optab alcrec,alt020
2505 optab allfec,alt030
2506 optab altbec,alt040
2507 optab alquit,alt050
2508 optab allisn,alt060
2509 optab allock,alt070
2510 optab alfdpx,alt080
2511 optab alchng,alt090
2512 optab alwru,alt100
2513 optab alecpx,alt110
2514 optab aldpin,alt190
2515 optab aldump,alt200
2516 optab alxhld,alt210
2517 optab alrply,alt230
2518 optab alplit,alt250
2519 optab alfrmi,alt120
2520 optab alsetb,alt260
2521 optab albral,alt270
2522 optab alpfnl,alt280
2523 optab alifc,alt290
2524 optab alofc,alt300
2525 optab aloddp,alt310
2526 optab al8in,alt320
2527 optab al8out,alt330
2528 optab albrk,alt400
2529 altend zero * marks end of table
2530 rem
2531 rem
2532 alctab equ * branch table used for colts channel
2533 optab allisn,alt060
2534 optab aldpin,alt190
2535 optab aldump,alt200
2536 alcend zero * marks end of table
2537 rem
2538 rem table of line types for which wru is allowed
2539 wrutbl dec 1 ascii
2540 dec 2 1050
2541 dec 3 2741
2542 dec 8 202c6
2543 wruinc equ *-wrutbl length of table
2544 ttls rndsiz -- subroutine to convert buffer size to words
2545 rem
2546 rem this subroutine takes a buffer size in characters
2547 rem and returns it in words rounded up to the next
2548 rem multiple of 32
2549 rem
2550 rem input:
2551 rem a -- chars per buffer
2552 rem
2553 rem output:
2554 rem a -- buffer size in words
2555 rem
2556 rem
2557 rndsiz subr rnd
2558 iaa 71 round up to multiple of 32 words
2559 ars 6
2560 als 5 convert to words
2561 cmpa l.g017-* bfmsiz respect upper limit
2562 tmi 2
2563 lda l.g017-*
2564 return rndsiz
2565 rem
2566 rem
2567 * setsiz -- subroutine to set buffer size in sfcm
2568 rem
2569 rem
2570 rem copy input buffer size from mailbox to sf.bsz for
2571 rem listen order or set_buffer_size order dialout
2572 rem
2573 rem input:
2574 rem x1 -- virtual tib address
2575 rem x3 -- submailbox address
2576 rem
2577 rem output:
2578 rem buffer size stored in sf.bsz
2579 rem zero stored in sf.mms
2580 rem
2581 rem
2582 setsiz subr set,qx2
2583 lda t.line,1 is this an hsla line?
2584 cana l.g010-* hslafl
2585 tze setbak-* no, don't bother with sfcm stuff
2586 ldx2 t.sfcm,1
2587 tze setbak-* better leave it alone if no sfcm
2588 lda sm.cd+1,3 get buffer size in chars
2589 tsy rndsiz-* get it in words rounded up to multiple of 32
2590 sta sf.bsz,2 save size in sfcm
2591 stz sf.mms,2 start clean
2592 setbak return setsiz
2593 ttls filmbx -- subroutine to fill FNP-controlled mailbox from i/o queue
2594 rem
2595 rem
2596 rem this routine is called by dgetwk if the i/o queue is
2597 rem non-empty and there's a free mailbox for sending to the CS
2598 rem
2599 rem x3: mailbox save area address
2600 rem
2601 rem
2602 filmbx subr fil
2603 rem start by getting request from i/o queue
2604 tsy a.v027-*,* fetch
2605 lda 0,2 pick up opcode word from queue
2606 sta filopc-*
2607 stx2 filtmp-* save queue address
2608 als 9 put opcode in mailbox
2609 iora rcd with rcd
2610 sta sm.op,3
2611 stz sm.cdl,3 initialize command data length to zero
2612 stz sm.lno,3 likewise line number
2613 ila -1 correct the queue count
2614 asa a.v004-*,* qcnt
2615 lda filopc-* pick up opcode again
2616 ana l.v019-* =007000 see if any data words
2617 tze fil020-* none
2618 ars 9 compute nwords
2619 caq
2620 cx3a
2621 iaa sm.cd point at beginning of command data
2622 cax1
2623 ldx2 filtmp-* get opcode back
2624 fil010 null
2625 lda 1,2 pick up word from queue
2626 sta 0,1 store in mailbox
2627 iaq -1
2628 tze fil020-* all words moved in
2629 iacx1 1 bump pointers
2630 iacx2 1
2631 tra fil010-*
2632 rem
2633 fil020 null now dequeue the error message
2634 lda filopc-* pick up original opcode
2635 iana 255
2636 sta filopc-* save masked version
2637 icmpa errmsg sending an error message?
2638 tnz fil030-* no
2639 ldx2 filtmp-* addr of q entry
2640 ldx1 l.v004-* =0 so dlqent will know not to meter
2641 tsy a.v042-*,* =dlqent delete it
2642 tra fil120-* done
2643 rem
2644 fil030 ldx1 a.v043-*,* address of current queue
2645 lda qtib,1 get real tib addrss
2646 sta a.v001-*,* tibadr save real tib address
2647 tsy a.v006-*,* setptw virtualize it
2648 cax1 put virtual tib address in x1
2649 lda t.line,1 put line number in mailbox
2650 orsa sm.lno,3
2651 rem now deal with opcode
2652 lda filopc-*
2653 icmpa accin "accept input"?
2654 tze fil100-* yes, go do special stuff
2655 ldx2 filtmp-* get queue address
2656 tsy a.v042-*,* =dlqent and free it
2657 rem
2658 trace mt.ouq,tr.que,filtmpfilopct.line1
2659 rem
2660 lda filopc-* get op code again
2661 ldx2 a.v015-* addrrcdtab
2662 fil040 null search table for opcode
2663 cmpa 0,2 if found,
2664 tze 1,2* branch according to table
2665 iacx2 2 else go to next entry
2666 cmpx2 rcdend-* table exhausted?
2667 tnz fil040-*
2668 die 8 yes, invalid opcode
2669 rem
2670 rem
2671 fil050 null accept new terminal
2672 rem
2673 smeter mincs,.mndil,l.v001-*
2674 smeter mupdat,.mdilc,a.v007-**
2675 rem
2676 lda t.type,1 pass type back as command data
2677 stz sm.cd,3 cs looks at 36 bits
2678 sta sm.cd+1,3
2679 stz sm.cd+2,3 zero second 36 bits of command data
2680 stz sm.cd+3,3
2681 lda l.v017-* =tfauto
2682 cana t.flg,1 is the an autobaud line?
2683 tze fil060-* no
2684 ldx2 t.sfcm,1 address of software com region
2685 ldx2 sf.hsl,2 address of hsla table
2686 lda ht.flg,2 flag word
2687 iana htfspd isolate speed
2688 iaa -1 compute cs speed index
2689 icmpa 7 less then 1200?
2690 tmi 2 yes
2691 iaa -1 further fudge multics does not know 1050 baud
2692 sta sm.cd+3,3 and store in command data
2693 fil060 ila 12 set command data length also
2694 sta sm.cdl,3
2695 lda l.v018-* tfdild
2696 orsa t.flg2,1 mark it dialed up now
2697 tra fil120-*
2698 rem
2699 fil070 null line disconnected
2700 rem turn off listen flag in tib
2701 lda l.v003-* =^tflisn
2702 ansa t.flg,1
2703 lda l.v010-* get permanent t.flg bits
2704 ansa t.flg,1 turn off all the others
2705 lda l.v011-* get permanent t.flg2 bits
2706 ansa t.flg2,1 turn off all the others
2707 lda l.v014-* get permanent t.flg3 bits
2708 ansa t.flg3,1 turn off all the others
2709 rem
2710 rem if this type of line has tfctrl by default,
2711 rem leave it on
2712 ldx3 a.v024-* addrctrl
2713 ldx3 ct.dev,3 array of device table addresses
2714 adcx3 t.type,1 indexed by device type
2715 ldx3 -1,3 which starts at 1 not 0
2716 rem x3 -> relevant device table entry
2717 lda l.v012-* dtfctl
2718 cana dt.flg,3 should tfctrl be on?
2719 tze fil080-* no, leave it off
2720 lda l.v013-* =tfctrl
2721 orsa t.flg,1 turn it on
2722 rem
2723 fil080 null
2724 lda t.echo,1 is there an echo buffer?
2725 tze fil090-*
2726 ilq bufsiz if so, free it
2727 tsy a.v016-*,* frebfh
2728 stz t.echo,1
2729 rem
2730 fil090 null
2731 tsy a.v045-*,* deldly get rid of any delay table
2732 stz t.dtp,1 and remember that it's gone
2733 tsy a.v047-*,* deletb free echnego tbl if any
2734 stz t.entp,1 and remember that it's gone
2735 stz t.scll,1 turn off pendant echo negotiation
2736 stz t.sncc,1 Clear this for good luck
2737 rem
2738 smeter mincs,.mndil,l.v002-*
2739 smeter mupdat,.mdilc,a.v007-**
2740 rem if hsla line, free cct buffer if any
2741 lda t.line,1 is it hsla line?
2742 cana l.v007-* =hslafl
2743 tze fil120-* if not, don't bother
2744 lda t.type,1 make sure it's a real channel
2745 icmpa ttcolt and not just colts executive
2746 tze fil120-* nope
2747 ilq 0
2748 tsy a.v046-*,* shrcct
2749 tra fil120-* that's it for disconnected line
2750 rem
2751 rem
2752 fil100 null accept input
2753 ila 9 command data will be 54 bits
2754 sta sm.cdl,3
2755 rem get count of input characters to put in cmd
2756 tsy a.v017-*,* incnt data
2757 rem
2758 lda a.v030-*,* .crnbf get number of buffers left
2759 sta sm.fre,3 tell multics what it is
2760 szn a.v005-*,* shinp was it short input?
2761 tze fil120-* no
2762 ila inmbx yes, reset opcode
2763 sta filopc-*
2764 lda l.v005-* ^tfinq while, accept input is being processed,
2765 ansa t.flg3,1 don't allow appending to the last buffer
2766 tra fil120-*
2767 rem
2768 rem
2769 fil110 null send output
2770 ila 9 54 bits of command data
2771 sta sm.cdl,3 because we will put buffer count in same
2772 rem place as for accept input
2773 lda a.v030-*,* .crnbf get number of buffers remaining
2774 sta sm.fre,3
2775 rem
2776 rem
2777 fil120 null finished with rcd, now write mailbox
2778 rem back to cs
2779 lda filopc-*
2780 ldx2 a.v002-*,* mbxno
2781 sta a.v003-*,* mbxfre-8,2 mark mailbox with current opcode
2782 lda a.v018-* addrsavmb
2783 tsy a.v010-*,* wmbx
2784 filbak return filmbx
2785 eject
2786 rem
2787 rem
2788 a.v001 ind tibadr
2789 a.v002 ind mbxno
2790 a.v003 ind mbxfre-8,2
2791 a.v004 ind qcnt
2792 a.v005 ind shinp
2793 a.v006 ind setptw set up variable cpu page table word
2794 a.v007 ind .mndil
2795 *a.v008 unused
2796 *a.v009 unused
2797 a.v010 ind wmbx
2798 a.v015 ind rcdtab branch table for rcd opcodes
2799 a.v016 ind frebfh
2800 a.v017 ind incnt subroutine to count input characters
2801 a.v018 ind savmbx
2802 a.v024 ind ctrl
2803 a.v027 ind fetch
2804 a.v030 ind .crnbf
2805 a.v042 ind dlqent
2806 a.v043 ind curque
2807 a.v045 ind deldly
2808 a.v046 ind shrcct subr that shares or releases cct
2809 a.v047 ind deletb
2810 rem
2811 rem
2812 l.v001 dec 1
2813 l.v002 dec -1
2814 l.v003 vfd 18/ntflsn
2815 l.v004 dec 0
2816 l.v005 vfd o18//tfinq
2817 l.v007 vfd 18/hslafl
2818 l.v010 vfd 18/tfdlup+tfauto
2819 l.v011 vfd 18/tfsftr
2820 l.v012 vfd 18/dtfctl
2821 l.v013 vfd 18/tfctrl
2822 l.v014 vfd 18/tfbkpt+tfoddp+tfmask+tfabf0+tfabf1
2823 l.v017 vfd 18/tfauto
2824 l.v018 vfd 18/tfdild
2825 l.v019 oct 007000
2826 rem
2827 rem
2828 filtmp bss 1
2829 filopc bss 1
2830 rem
2831 rem
2832 rcdtab null branch table for rcd opcodes
2833 rem
2834 optab acctrm,fil050
2835 optab lindis,fil070
2836 optab sndout,fil110
2837 optab brkcon,fil120
2838 optab wrutim,fil120
2839 optab acupwi,fil120
2840 optab acudlo,fil120
2841 optab acuacr,fil120
2842 optab acung,fil120
2843 optab linsta,fil120
2844 optab engain,fil120
2845 optab engaof,fil120
2846 optab linmsk,fil070
2847 rcdend zero * to mark end of table
2848 rem
2849 ttls gmeter -- report meters to cs
2850 rem
2851 rem this subroutine sets up a dcw list to copy either
2852 rem per-channel or FNP-wide meters in response to a
2853 rem report-meters mailbox. The meters are copied to a
2854 rem temporary buffer both to avoid having them paged out and
2855 rem to make sure a consistent copy is sent.
2856 rem
2857 rem at entry:
2858 rem x1 contains address of tib or tibadr = 0 if for whole fnp
2859 rem x3 points to mailbox; sm.cd in mailbox contains address
2860 rem of cs buffer
2861 rem
2862 gmeter subr gme,x2x3
2863 szn a.s001-*,* tibadr for a subchannel?
2864 tze gme010-* no
2865 ldx2 t.metr,1 yes, get pointer to its meters
2866 ilq m.synl this is how much space they take up
2867 stq gmelen-*
2868 tra gme020-*
2869 gme010 ldx2 a.s002-* whole fnp, get addr .mdilc
2870 ilq .mleng size of metering area
2871 stq gmelen-* this is how much to copy
2872 iaq 14 extra stuff copied from elsewhere
2873 gme020 stq gmesiz-* save size
2874 tsy a.s003-*,* getmem
2875 die 10 please not
2876 stx3 gmebuf-* save address of buffer
2877 ldq gmelen-* get copying length
2878 gme030 lda 0,2 copy a word
2879 sta 0,3
2880 iacx2 1 move to next
2881 iacx3 1
2882 iaq -1 any more?
2883 tnz gme030-* yes
2884 rem
2885 szn a.s001-*,* tibadr for a subchannel?
2886 tnz gme040-* yes
2887 rem no, fill in some extra fnp-wide stuff
2888 ldx2 a.s010-* addr .crbdt
2889 ldaq 0,2 get bootload time
2890 staq 0,3
2891 ldaq 2,2 all 4 words of it
2892 staq 2,3
2893 ldx2 a.s011-*,* .crsked get pointer to idle meters
2894 ldaq 0,2 this is 8 words
2895 staq 4,3
2896 ldaq 2,2
2897 staq 6,3
2898 ldaq 4,2
2899 staq 8,3
2900 ldaq 6,2
2901 staq 10,3
2902 ldaq a.s012-*,* yelcnt get edac error count
2903 staq 12,3
2904 rem
2905 gme040 ldx2 a.s004-* addr dcws -- put dcw list in usual place
2906 stx2 a.s005-*,* dcwadr
2907 ila 4 set length
2908 sta a.s006-*,* dcwlen
2909 rem
2910 ldx3 gmesx3-* get mailbox pointer
2911 lda sm.cd,3 get cs address
2912 ilq diaftc fnp -> cs transfer
2913 staq 0,2
2914 lda gmebuf-* get pointer to data
2915 ora l.s001-* 0,w.2 for dia
2916 ldq gmesiz-* get data length
2917 qrs 1 in 36-bit words
2918 staq 2,2 rest of dcw
2919 iacx2 4 point to place for next dcw
2920 cx2a but bdisc wants it in x3
2921 cax3
2922 tsy a.s007-*,* bdisc disconnect dcw
2923 ila tcmetr set transaction control word
2924 sta a.s008-*,* tcword
2925 tsy a.s009-*,* conect
2926 return gmeter
2927 rem
2928 rem
2929 a.s001 ind tibadr
2930 a.s002 ind .mdilc
2931 a.s003 ind getmem
2932 a.s004 ind dcws
2933 a.s005 ind dcwadr
2934 a.s006 ind dcwlen
2935 a.s007 ind bdisc
2936 a.s008 ind tcword
2937 a.s009 ind conect
2938 a.s010 ind .crbdt
2939 a.s011 ind .crskd
2940 a.s012 ind yelcnt
2941 rem
2942 l.s001 zero 0,w.2
2943 rem
2944 rem
2945 gmebuf bss 1 address of temporary space for meters
2946 gmesiz bss 1 size of same
2947 gmelen bss 1 length to copy from metering area
2948 ttls makdly -- allocate new delay table
2949 rem
2950 rem this subroutine takes a list of delay values and associates
2951 rem them with a given line. It does this by searching the chain of delay
2952 rem tables starting at .crdly, and if it finds one matching the
2953 rem supplied values it increases its reference count; if
2954 rem none is found, it chains a new one on to the end. t.dtp is
2955 rem updated accordingly.
2956 rem
2957 rem input:
2958 rem x1 -> virtual tib address
2959 rem x2 -> array of 6 delay values
2960 rem
2961 rem
2962 makdly subr mak,x2x3
2963 rem
2964 ilq dl.siz-dl.hsz count of values
2965 ldx3 maksx2-* use x3 for tbl clobberably
2966 mak010 szn 0,3 find out if all are zero
2967 tnz mak020-* clearly not
2968 iacx3 1 check next
2969 iaq -1 are there more?
2970 tnz mak010-* yes
2971 ila 0
2972 cax3 indicate no table
2973 tra mak030-* and go delete old one
2974 rem
2975 mak020 null
2976 ldx3 a.p001-* addr .crdly -- start looking at existing tables
2977 ilq dl.siz-dl.hsz table size
2978 tsy a.p004-*,* =cmptbl x2 -> table
2979 tra mak040-* didnt find it, x3 is last
2980 rem come here if corresponding table already exists
2981 cmpx3 t.dtp,1 already in use by this line?
2982 tze makret-* yes, nothing to do
2983 aos dl.rfc,3 up the reference count
2984 rem
2985 mak030 null here to update t.dtp and free old table
2986 tsy deldly-* free old one
2987 stx3 t.dtp,1 save it in tib
2988 rem
2989 makret return makdly
2990 mak040 null table does not already exist
2991 ilq dl.siz allocate a new block
2992 tsy a.p002-*,* =newtbl
2993 tra mak030-*
2994 rem
2995 ttls deldly -- free delay table
2996 rem
2997 rem frees delay table pointed to by t.dtp
2998 rem if reference count > 1, just reduces it
2999 rem
3000 rem x1 -> virtual tib address
3001 rem
3002 rem
3003 deldly subr dld,x3
3004 rem
3005 ilq dl.siz use delay tbl size
3006 cx1a use t.dtp
3007 iaa t.dtp
3008 cax3 get tbl ptr in x3
3009 tsy deltbl-*
3010 return deldly
3011 rem
3012 rem delete any table
3013 rem delay or echnego
3014 rem x1 = tib not used
3015 rem x3 = ptr to tib tbl ptr word
3016 rem q = size of table for fremem
3017 rem
3018 deltbl subr del,x1x2x3q
3019 ldx3 0,3 is there an old table?
3020 tze delret-* no, forget it
3021 rem
3022 lda dl.rfc,3 anyone else using it?
3023 iaa -1
3024 sta dl.rfc,3 decrement ref count
3025 tnz delret-* someone else wants it, leave it alone
3026 rem
3027 ldx1 dl.bck,3 get pointer to previous block
3028 ldx2 dl.fwd,3 and next one
3029 tze 2 is no next one
3030 stx1 dl.bck,2 if there is, attach it to previous one
3031 stx2 dl.fwd,1 correct previous block's forward ptr
3032 rem note: even if freed block is first one, its
3033 rem backptr points to .crdly or .cretb
3034 rem
3035 rem q has right size at this point.
3036 tsy a.p003-*,* =fremem
3037 rem
3038 delret return deltbl
3039 rem
3040 rem
3041 rem
3042 a.p001 ind .crdly
3043 a.p002 ind newtbl
3044 a.p003 ind fremem
3045 a.p004 ind cmptbl
3046 rem
3047 ttls table sharing routines
3048 rem
3049 rem compare tables for sharing
3050 rem x1 => tib saved not used
3051 rem x2 => values in table
3052 rem x3 -> chain head
3053 rem q = size of table data
3054 rem
3055 cmptbl subr cmt,x2q
3056 rem
3057 cmt010 null
3058 lda 0,3 get next in chain
3059 tze cmt050-* there are no more
3060 sta cmtbuf-*
3061 cax3 find out if this one matches new one
3062 iacx3 dl.hsz start at first value
3063 cmt020 lda 0,2
3064 cmpa 0,3 values equal?
3065 tze cmt030-* yes, look at next
3066 ldx3 cmtbuf-* no, see if there are more in chain
3067 ldx2 cmtsx2-* restore pointer to first value
3068 ldq cmtsq-* restore count
3069 tra cmt010-*
3070 rem
3071 cmt030 iaq -1 checked all values?
3072 tze cmt040-* yes, we've found matching table
3073 iacx2 1 no, move to next value
3074 iacx3 1
3075 tra cmt020-* and test again
3076 rem
3077 cmt040 ldx3 cmtbuf-*
3078 aos cmptbl-*
3079 cmt050 return cmptbl
3080 rem
3081 cmtbuf bss 1
3082 rem
3083 rem
3084 rem subr to allocate a new table
3085 rem x2 -> table data
3086 rem x3 -> end of previous chain
3087 rem q = data size, incl.header
3088 rem return x3 -> new block
3089 rem
3090 newtbl subr nwt,x2x3q
3091 rem
3092 tsy a.p501-*,* =getmem
3093 die 10 if we can't get one, horrors.
3094 stx3 nwttmp-* this is the new one
3095 rem
3096 ldx2 nwtsx3-* thread it to previous one
3097 stx2 dl.bck,3
3098 stx3 dl.fwd,2
3099 ila 1 initialize reference count
3100 sta dl.rfc,3
3101 iacx3 dl.hsz point to first value
3102 ldx2 nwtsx2-* restore pointer to supplied values
3103 ldq nwtsq-* get table length
3104 iaq -dl.hsz dont copy the header!
3105 nwt010 lda 0,2
3106 sta 0,3
3107 iaq -1 got 'em all ?
3108 tze nwt020-* yes
3109 iacx2 1 no, get another
3110 iacx3 1
3111 tra nwt010-*
3112 nwt020 null
3113 ldx3 nwttmp-*
3114 stx3 nwtsx3-*
3115 return newtbl
3116 rem
3117 a.p501 ind getmem
3118 nwttmp bss 1
3119 rem
3120 ttls makecn - make echnego table
3121 rem
3122 rem make an echo negotiation bit table
3123 rem try to share it like a delay table
3124 rem
3125 rem
3126 makecn subr mnt,x2x3
3127 rem
3128 mnt010 null
3129 ldx3 a.y001-* addr .cretb -- start looking at existing tables
3130 ilq ecnlen table size
3131 tsy a.y002-*,* =cmptbl x2 -> table
3132 tra mnt040-* didnt find it, x3 is last
3133 rem come here if corresponding table already exists
3134 cmpx3 t.entp,1 already in use by this line?
3135 tze mnt030-* yes, nothing to do
3136 aos dl.rfc,3 up the reference count
3137 rem
3138 mnt020 null here to update t.dtp and free old table
3139 tsy deletb-* free old one
3140 stx3 t.entp,1 save it in tib
3141 rem
3142 mnt030 return makecn
3143 mnt040 null table does not already exist
3144 ilq dl.hsz+ecnlen allocate a new block
3145 tsy a.y003-*,* =newtbl
3146 tra mnt020-*
3147
3148 rem
3149 a.y001 ind .cretb
3150 a.y002 ind cmptbl
3151 a.y003 ind newtbl
3152 rem
3153 rem Free echo negotiation table
3154 deletb subr dle,x3
3155 rem
3156 ilq dl.hsz+ecnlen
3157 cx1a
3158 iaa t.entp
3159 cax3
3160 tsy a.y501-*,* =deltbl
3161 return deletb
3162 rem
3163 a.y501 ind deltbl
3164 rem
3165 ttls ecgifl -- echnego input flush to 6180
3166 rem send icp chains off to dcp chain dia queue
3167 rem so echnego sync requests work.
3168 rem
3169 ecgifl subr ecf
3170 rem
3171 szn t.icp,1 do we have an icp chain?
3172 tze ecfret-*
3173 ilq accin send accept input
3174 tsy a.y601-*,* denq
3175 ecfret return ecgifl
3176 rem
3177 a.y601 ind denq
3178 rem
3179 ttls rblast -- subroutine to set up dcw for reading blast message
3180 rem
3181 rem mailbox address passed in x3
3182 rem address field of mailbox word 10 points to
3183 rem 6-buffer area containing blast message in three languages
3184 rem two buffers per message
3185 rem
3186 rblast subr rbl,x3
3187 ldx2 a.t003-* dcws
3188 stx2 a.t004-*,* dcwadr tell conect to use usual dcw place
3189 ila 4
3190 sta a.t005-*,* dcwlen
3191 rem
3192 lda sm.adr,3 get cs address
3193 ilq diactf read cs opcode
3194 staq 0,2 into dcw
3195 ilq 6*bufsiz get three double buffers together
3196 tsy a.t001-*,* getbfh
3197 die 10 oh my god
3198 sta a.t007-*,* blbuf for dtrans
3199 ilq 3*bufsiz 3 buffers worth of 36-bit words
3200 staq 2,2 put in dcw
3201 lda l.t005-* =absflg
3202 orsa 3,2 put absolute address flag in dcw
3203 iacx2 4 next dcw
3204 cx2a
3205 cax3 into x3 for bdisc
3206 tsy a.t006-*,* bdisc build disconnect dcw
3207 return rblast done
3208 ttls acusr -- subroutine to handle dial out request
3209 rem
3210 rem this routine sets the tfacu flag in the tib and then
3211 rem it copies the phone number that has been passed
3212 rem to the fnp in the command data portion of the mailbox
3213 rem into a buffer coverting the 6bit bcd into 9bit
3214 rem and invokes the control table interpreter at the test state
3215 rem entry.
3216 rem
3217 acusr subr acu
3218 rem
3219 lda t.flg3,1 was the channel masked?
3220 cana l.t006-* =tfmask
3221 tze acu005-* no
3222 tsy a.t008-*,* hunmsk if so, unmask it now
3223 acu005 null
3224 rem
3225 trace mt.acu,tr.mbx,sm.cdl3sm.cd3sm.cd+13sm.cd+23s
3226 etc m.cd+33
3227 rem
3228 lda l.t001-* tfacu
3229 orsa t.flg2,1 set flag on
3230 rem now to get a buffer
3231 lda sm.cdl,3 get number of digits
3232 ana l.t007-* low-order 9 bits only
3233 tpl acu010-* must be at least 1 digit
3234 die 8 bad acu request, stop
3235 rem
3236 acu010 null
3237 cx3a getbuf restores all but x3
3238 cax2 x2 will contain addr of mailbox
3239 ilq bufsiz get a buffers worth
3240 tsy a.t001-*,* getbuf
3241 die 10 no buffers means bad problems
3242 stx3 t.ocp,1 remember absolute addr of buffer
3243 ldq sm.cdl,2 get number of digits
3244 qls 9 reduce to lower half-word only
3245 qrl 9
3246 stq 1,3 store as tally in buffer
3247 iacx3 bf.dta set x3 to addr of data part of buffer
3248 iacx2 sm.cd set x2 to addr of command data part of mailbox
3249 rem
3250 rem now to copy 6bit chars from mailbox into
3251 rem 9bit chars in buffer. number of characters
3252 rem to move is in q.
3253 rem
3254 cx2a
3255 ora l.t002-* 0c.0 change x2 to 6bit chars
3256 cax2
3257 cx3a
3258 ora l.t003-* 0b.0 change x3 to 9bit chars
3259 cax3
3260 rem
3261 acumvc null
3262 lda 0,2,c.0 load 6bits right justified other bits of q are zeroed
3263 sta 0,3,b.0 store rightmost 9bits
3264 iacx2 0,c.1 move 1 char to right
3265 iacx3 0,b.1 move 1 byte to right
3266 iaq -1 decrement count of digits remaining
3267 tpl acumvc-* stop when count goes to zero
3268 tsy a.t002-*,* itest
3269 return acusr
3270 rem
3271 a.t001 ind getbuf
3272 a.t002 ind itest "test_state" entry of interpreter
3273 a.t003 ind dcws
3274 a.t004 ind dcwadr
3275 a.t005 ind dcwlen
3276 a.t006 ind bdisc
3277 a.t007 ind blbuf place to store address of blast buffers
3278 a.t008 ind hunmsk
3279 rem
3280 l.t001 vfd 18/tfacu
3281 l.t002 zero 0,c.0 for setting '6bit char mode'
3282 l.t003 zero 0,b.0 for setting '9bit char mode'
3283 l.t004 zero 0,w.2 for setting 36-bit mode
3284 l.t005 vfd 18/absflg
3285 l.t006 vfd 18/tfmask
3286 l.t007 oct 000777
3287 rem
3288 ttls fetch -- subroutine to get next item to satisfy an rcd
3289 rem
3290 rem this routine first checks error message queue;
3291 rem otherwise entry is taken from queue for a tib
3292 rem inputs: none
3293 rem
3294 rem outputs:
3295 rem x2: pointer to queue entry
3296 rem
3297 fetch subr fet,aqx3
3298 rem
3299 szn a.o001-*,* =errqbf anyting in error queue?
3300 tze fet010-* no
3301 lda a.o002-* =errqtb addr of simulated tib table
3302 sta a.o007-*,* =curque
3303 tra fet050-*
3304 rem
3305 fet010 null
3306 ldx2 dqcur-* look at tib table entry whose turn it is
3307 tnz fet020-* if it's never been set,
3308 ldx2 a.o004-*,* set it to .crttb
3309 fet020 null
3310 cmpx2 a.o003-*,* .crtte time to wrap around?
3311 tnz 2
3312 ldx2 a.o004-*,* .crttb
3313 rem
3314 szn qbuf,2 is there a queue for this line?
3315 tnz fet040-* yes, go get something out of it
3316 fet030 null
3317 iacx2 2 look at next tib entry
3318 cmpx2 dqcur-* have we gone all the way around?
3319 tnz fet020-*
3320 die 9 yes, spurious rcd
3321 rem
3322 fet040 stx2 a.o007-*,* =curque save current tib table entry
3323 fet050 tsy a.o008-*,* =getqhd get head of queue
3324 die 8 queue can't be empty
3325 rem
3326 lda 0,2 pick up first word of entry
3327 tpl fet060-* not already picked up
3328 ldx2 a.o007-*,* pick up current queue
3329 tra fet030-* back tp bump to next
3330 fet060 iana 255 mask down to opcode
3331 tnz 2 make sure it's more or less legal
3332 die 8
3333 rem
3334 lda l.o001-* =400000 set active bit
3335 orsa 0,2
3336 ldx3 a.o007-*,* curque get current tib table entry
3337 cmpx3 a.o002-* errqtb is it error queue?
3338 tze fetbak-* yes
3339 iacx3 2 bump i/o queue to next tib
3340 stx3 dqcur-*
3341 fetbak return fetch
3342 rem
3343 rem
3344 a.o001 ind errqbf
3345 a.o002 ind errqtb
3346 a.o003 ind .crtte
3347 a.o004 ind .crttb
3348 rem
3349 a.o006 ind dlqent
3350 a.o007 ind curque
3351 a.o008 ind getqhd
3352 rem
3353 l.o001 oct 400000
3354 rem
3355 dqcur ind 0 pointer to entry in tib table whose turn it is
3356 ttls getque -- finds entry in tib i/o queue list
3357 rem
3358 rem this subroutine finds the entry in the tib i/o queue list
3359 rem for a given tib
3360 rem
3361 rem input:
3362 rem a: real tib address
3363 rem
3364 rem output:
3365 rem x2: address of entry in list
3366 rem
3367 rem if there is none, we will crash
3368 rem
3369 getque subr gtq
3370 rem
3371 ldx2 a.o004-*,* .crttb get pointer to tib table base
3372 gtq010 null
3373 cmpa qtib,2 is this the one?
3374 tze gtqbak-* yes, we got it
3375 iacx2 2 no, look at next
3376 cmpx2 a.o003-*,* .crtte
3377 tnz gtq010-* if there are any more
3378 die 22 else crash
3379 rem
3380 gtqbak stx2 a.o007-*,* =curque save current queue addr
3381 return getque
3382 ttls reject -- subroutine to reschedule rejected accept input
3383 rem
3384 rem this subroutine finds the rejected accept input for the tib
3385 rem pointed to by x1, marks it "rejected", and schedules
3386 rem dretry routine to try it again a second later
3387 rem
3388 rem x1 - virtual tib address
3389 rem
3390 reject subr rej
3391 lda a.q001-*,* tibadr need real tib address for getque
3392 tsy getque-*
3393 rem x2 -> tib queue entry
3394 tsy a.q004-*,* =getqai find first accept input
3395 die 16 better be one
3396 szn a.q005-*,* =nonnai better be nothing before it
3397 tze 2
3398 die 16
3399 rem
3400 lda 0,2 is there a quit or hangup behind it?
3401 cana l.q001-* =quitfl
3402 tze rej040-* no
3403 tsy a.q002-*,* cleanq yes, remove all accept inputs
3404 rem from queue
3405 tra rejbak-*
3406 rem
3407 rej040 null mark entry rejected
3408 ora l.q002-* =rejflg
3409 sta 0,2
3410 ldx1 a.q001-*,* tibadr need real address for dspqur
3411 ldaq l.q003-* delay time, priority, and address of dretry
3412 tsy a.q003-*,* dspqur
3413 rem
3414 rejbak return reject
3415 rem
3416 rem
3417 a.q001 ind tibadr real tib address
3418 a.q002 ind cleanq
3419 a.q003 ind dspqur
3420 a.q004 ind getqai
3421 a.q005 ind nnonai
3422 rem
3423 l.q001 vfd 18/quitfl
3424 l.q002 vfd 18/rejflg
3425 even
3426 l.q003 vfd 12/1,6/rtprty delay time, priority, and address
3427 ind dretry for scheduling dretry
3428 ttls cleanq -- remove accept inputs from queue with a reject
3429 rem
3430 rem this routine is called to remove all accept input requests
3431 rem from a line's i/o queue so that quits and hangups will go
3432 rem through although an input request has been rejected
3433 rem
3434 rem input:
3435 rem x1: virtual tib address
3436 rem x2: address of first accept input in queue
3437 rem
3438 cleanq subr cle,aqx2x3
3439 rem
3440 lda t.dcp,1 free any input chains
3441 tze cle003-*
3442 tsy a.r001-*,* frelbf
3443 stz t.dcp,1
3444 stz t.dlst,1
3445 stz t.dcpl,1
3446 cle003 null
3447 lda t.icp,1
3448 tze cle006-*
3449 tsy a.r001-*,*
3450 stz t.icp,1
3451 stz t.ilst,1
3452 stz t.icpl,1
3453 rem
3454 cle006 null
3455 lda a.q005-*,* =nnonai number of queue entries before first accin
3456 sta savnai-* will need this in a second
3457 tsy a.r003-*,* =dlqent delete the accept inpuut
3458 cle010 tsy a.r004-*,* =getqai find first accept input again
3459 tra cle020-* none, queue is clean
3460 tsy a.r003-*,* =dlqent delete this accept input
3461 tra cle010-* back to find another
3462 cle020 lda a.q005-*,* =nnonai this is total entries now in queue
3463 sba savnai-* subtract out number before the first accin
3464 rem that used to be there and get the number
3465 rem if new mailboxes needed
3466 tze 2 were none, do nothing
3467 asa a.r002-*,* qcnt
3468 rem
3469 return cleanq
3470 rem
3471 rem
3472 a.r001 ind frelbf
3473 a.r002 ind qcnt
3474 a.r003 ind dlqent
3475 a.r004 ind getqai
3476 rem
3477 savnai bss 1
3478 ttls incnt -- subroutine to get input character count
3479 rem
3480 rem this subroutine gets count of input characters
3481 rem for "accept input" in order to send the count to the
3482 rem cs
3483 rem it also sets the "break" flag in the mailbox if appropriate
3484 rem
3485 rem x1 -- virtual tib address
3486 rem x3 -- mailbox address
3487 rem
3488 incnt subr inc,x2x3
3489 rem
3490 stz icount-* initialize character count
3491 stz iflags-* and break char flag
3492 stz nbufs-* and buffer count
3493 lda a.h001-* addr tallys
3494 sta tallyp-* initialize temporary tally array pointer
3495 lda t.dcp,1 point to beginning of input chain
3496 rem
3497 inc010 null
3498 aos nbufs-* bump buffer count
3499 tsy a.h003-*,* setbpt
3500 cax2 get virtual address
3501 lda bf.tly,2 get tally from buffer
3502 ana l.h001-* =buftmk
3503 tnz 2 if it's zero, something's very wrong
3504 die 21
3505 rem
3506 asa icount-* add it into count
3507 sta tallyp-*,* save it in temporary array
3508 aos tallyp-* bump array pointer
3509 lda bf.flg,2 is break flag in buffer on?
3510 cana l.h002-* =bffbrk
3511 tze inc020-*
3512 ilq 1
3513 stq iflags-* yes, turn it on in mailbox
3514 rem
3515 inc020 null last buffer?
3516 cana l.h003-* =bfflst
3517 tze inc030-* no, go to next
3518 rem else we're done
3519 trace mt.inc,tr.que,icountt.line1
3520 rem
3521 szn t.ocp,1 is there any kind of output chain?
3522 tnz inc025-*
3523 szn t.ocur,1
3524 tze inc040-* no
3525 rem
3526 inc025 ila 2 yes, set flag in command data
3527 orsa iflags-*
3528 rem
3529 inc040 lda iflags-* store flags
3530 sta sm.fcd,3
3531 lda icount-* get total char count
3532 icmpa mbxmax will it fit in mailbox?
3533 tmi inc050-* yes, go copy the data
3534 sta sm.ict,3 no, put the char count in the mbx
3535 lda a.h002-* addr sm.dcw+1
3536 sta incdcw-* initialize pointer to dcws in mbx
3537 ila 0
3538 ldq nbufs-* get number of buffers in chain
3539 staq sm.nbf,3 put it in mbx
3540 rem we'll count it in q
3541 lda a.h001-* reinitialize pointer to temp array of tallies
3542 sta tallyp-*
3543 rem
3544 inc045 lda tallyp-*,* get next tally
3545 sta incdcw-*,* store it in mbx
3546 iaq -1 count it
3547 tze incbak-* finished when we reach zero
3548 aos tallyp-* bump pointers
3549 ila 2
3550 asa incdcw-*
3551 tra inc045-* back for next one
3552 rem
3553 inc050 ila inmbx change opcode
3554 als 9 to "input in mailbox"
3555 iora rcd keep it rcd
3556 sta sm.op,3
3557 cx3a
3558 ada l.h006-* sm.datb.0 point x3 at mailbox data area
3559 cax3
3560 lda t.dcp,1 point x2 at input chain
3561 sta oldhed-* save it for later freeing
3562 stz icount-* start count over
3563 inc060 tsy a.h003-*,* setbpt
3564 cax2
3565 lda bf.tly,2
3566 ana l.h001-* buftmk
3567 asa icount-* keep count of total number
3568 stx2 ibufp-* remember current buffer address
3569 caq hold running count in q
3570 cx2a
3571 ada l.h007-* bf.dtab.0 get pointer to data in buffer
3572 cax2
3573 inc080 lda 0,2,b.0 get a character form the buffer
3574 sta 0,3,b.0 store it in mailbox
3575 iacx2 0,b.1 bump pointers
3576 iacx3 0,b.1
3577 iaq -1 count the character
3578 tnz inc080-* if more, go get the next one
3579 ldx2 ibufp-* no more, get buffer pointer back in x2
3580 lda bf.flg,2 last one?
3581 cana l.h003-* bfflst
3582 tnz inc090-* yes, wrap it up
3583 lda bf.nxt,2 no, get forward pointer
3584 tra inc060-* process next buffer
3585 rem
3586 inc090 null
3587 lda icount-* get final count
3588 ldx3 incsx3-* get saved mailbox address
3589 sta sm.ict,3
3590 aos shinp-* set flag showing short input in progress
3591 rem
3592 incbak return incnt
3593 rem
3594 inc030 null
3595 lda bf.nxt,2
3596 tnz inc010-* go process next buffer
3597 rem if there isn't one, something's wrong
3598 die 11
3599 rem
3600 rem
3601 rem
3602 rem
3603 a.h001 ind tallys pointer to tally array
3604 a.h002 ind sm.dcw+1,3 pointer to lower half of dcws
3605 a.h003 ind setbpt
3606 rem
3607 rem
3608 l.h001 vfd 18/buftmk
3609 l.h002 vfd 18/bffbrk
3610 l.h003 vfd 18/bfflst
3611 l.h004 oct 777774
3612 *l.h005 unused
3613 l.h006 zero sm.dat,b.0
3614 l.h007 zero bf.dta,b.0
3615 l.h008 oct 777000
3616 rem
3617 nbufs bss 1 number of buffers processed so far
3618 icount bss 1 number of characters processed
3619 iflags bss 1 flags for sending back to multics
3620 increm bss 1 amount by which tally has beeen adjusted
3621 itally bss 1
3622 ibufp bss 1
3623 shinp bss 1 global dia_man flag indicating short input transaction
3624 tallyp bss 1 pointer to current element of tally array
3625 incdcw bss 1 pointer to current pseudo-dcw in mailbox
3626 tallys bss 24 temporary array of buffer tallies
3627 ttls indata -- sets up dcw list for rtx
3628 rem
3629 rem this subroutine sets up a dcw list for sending
3630 rem an input chain to the cs
3631 rem the mailbox in "savmbx" has the following information
3632 rem in 18-bit words 8-11:
3633 rem
3634 rem word 8: second address or 0
3635 rem word 9: second tally or 0
3636 rem word 10: data address
3637 rem word 11: tally
3638 rem
3639 rem words 8 and 9 are only used if cs is supplying
3640 rem two addresses because of wraparound in its circular
3641 rem input buffer
3642 rem
3643 rem tallies are in characters
3644 rem
3645 rem x1: virtual tib address
3646 rem
3647 indata subr ind
3648 ldx3 a.i001-* addrdcws
3649 stx3 a.i002-*,* dcwadr
3650 stx3 curdcw-* initialize dcw pointer
3651 stz a.i003-*,* initialize dcwlen
3652 ldx3 a.i004-* addrsavmbx -- get mailbox address
3653 rem
3654 lda t.dcp,1 get pointer to first buffer
3655 sta oldhed-* hang on to it for later freeing
3656 iacx3 sm.dcw point to dcw array in mbx
3657 stx3 pdcwa-*
3658 stz nblks-* initialize this too
3659 rem
3660 ind010 null
3661 sta curabs-* save absolute address of current buffer
3662 tsy a.i008-*,* setbpt
3663 cax2 get virtual address
3664 lda bf.siz,2 find out how many blocks long this buffer is
3665 arl 15
3666 iaa 1
3667 asa nblks-* keep running count
3668 lda bf.tly,2 get buffer tally
3669 ana l.i001-* =buftmk
3670 caq put tally in q
3671 lda curabs-* recover buffer address
3672 iaa bf.dta get fnp address in a
3673 tsy indcw-* make the dcw
3674 rem
3675 lda bf.flg,2 is this last buffer?
3676 cana l.i002-* =bfflst
3677 tnz ind050-* yes,finish up
3678 lda bf.nxt,2 no, get next buffer
3679 tnz ind010-*
3680 die 11 bad news if there isn't one
3681 rem
3682 ind050 null no more input buffers
3683 ldq nblks-*
3684 tsy instrp-* take buffers of dcp chain
3685 ldx3 curdcw-* get dcw address
3686 rem to set timw bit
3687 rem and make interrupt and disconnect dcws
3688 tsy a.i007-*,* wtimw which updates x3 itself
3689 tsy a.i005-*,* bint
3690 iacx3 4
3691 tsy a.i006-*,* bdisc
3692 ila 8 update dcw length
3693 asa a.i003-*,* dcwlen
3694 return indata all done
3695 rem
3696 ttls indcw -- build dcw for indata
3697 rem
3698 rem input:
3699 rem a -- fnp address
3700 rem q -- tally in characters
3701 rem
3702 rem curdcw contains address of dcw to be built
3703 rem pdcwa contains pointer to next pseudo-dcw
3704 rem containing cs address
3705 rem both of these are to be updated
3706 rem as is dcwlen no. of 36-bit words in dcw list
3707 rem
3708 indcw subr inw,aqx3
3709 rem
3710 ldx3 curdcw-* get dcw pointer
3711 iaq 3 convert tally to words
3712 qrs 2 words = char+3/4
3713 staq 2,3 put tally and fnp address in dcw
3714 lda l.i003-* =absflg
3715 orsa 3,3 mark dcw for absolute addressing
3716 ldaq pdcwa-*,* get next absolute cs address
3717 llr 6 get low-order 18 bits in a
3718 qls 12 isolate high-order part of address
3719 qrl 6 it ends up in bits 24-29 of dcw
3720 staq 0,3 store in dcw
3721 rem
3722 ila diaftc get opcode fnp -> cs transfer
3723 orsa 1,3 store in dcw
3724 ila 4
3725 asa curdcw-* update dcw pointer
3726 ila 2 and list length
3727 asa a.i003-*,* dcwlen
3728 asa pdcwa-*
3729 return indcw that's all
3730 ttls instrp -- subroutine to strip input buffers of t.dcp chain
3731 rem
3732 rem removes input buffers that have been sent from t.dcp chain
3733 rem and adjusts t.dcpl accordingly
3734 rem
3735 rem input:
3736 rem q -- number of buffers in chain sent
3737 rem
3738 instrp subr ins,q
3739 lda t.dcpl,1 we've removed some blocks from t.dcp chain
3740 sba inssq-* this many
3741 sta t.dcpl,1
3742 lda bf.nxt,2 save next-pointer from last buffer
3743 sta t.dcp,1 will be head of next input chain
3744 tnz 2 if there isn't another chain,
3745 stz t.dlst,1 kill tail pointer
3746 stz bf.nxt,2 zero next-pointer so chain can be freed
3747 return instrp
3748 ttls storage for indata and indcw
3749 rem
3750 a.i001 ind dcws
3751 a.i002 ind dcwadr
3752 a.i003 ind dcwlen
3753 a.i004 ind savmbx
3754 a.i005 ind bint
3755 a.i006 ind bdisc
3756 a.i007 ind wtimw
3757 a.i008 ind setbpt
3758 rem
3759 rem
3760 l.i001 vfd 18/buftmk
3761 l.i002 vfd 18/bfflst
3762 l.i003 vfd 18/absflg
3763 rem
3764 rem
3765 oldhed bss 1 head of input chain being sent
3766 curdcw bss 1 address of current dcw
3767 pdcwa bss 1 address of current pseudo-dcw in mailbox
3768 blimit bss 1 highest allowed cs address + one
3769 nblks bss 1 number of 32-word blocks used by input chain
3770 curabs bss 1 absolute address of current buffer
3771 rem
3772 ttls rddcw -- set up dcw list to read cs dcw list
3773 rem
3774 rem this subroutine is called when a decoded mailbox
3775 rem contains a wtx command
3776 rem
3777 rem the mailbox contains in words 10-11 the address
3778 rem and length in 36-bit words of a cs dcw list
3779 rem for transmitting the output data
3780 rem
3781 rem this routine creates dia dcw list to read the cs
3782 rem dcw list the "pseudo-dcws" into a static area
3783 rem
3784 rem x3 contains the mailbox address
3785 rem
3786 rddcw subr rdw,x3
3787 rem set up dcw address and length for conect
3788 ldx2 a.j001-* addrdcws
3789 stx2 a.j002-*,* dcwadr
3790 ila 4
3791 sta a.j003-*,* dcwlen
3792 rem
3793 ldaq sm.adr,3 get address and length of cs dcw list
3794 cmpa blimit-* make sure it's probably in buffer area
3795 tnc rdw010-* it isn't
3796 stq ndcws-* save length
3797 stq 3,2 put tally in dcw
3798 ilq diactf get cs->fnp transfer opcode
3799 staq 0,2 put it in dcw
3800 rem
3801 lda a.j006-* get address of pseudo-dcw area pdcws
3802 sta 2,2 put in fnp address of dcw
3803 rem
3804 iacx2 4 bump dcw pointer
3805 cx2a copy it into x3 to make disconnect dcw
3806 cax3
3807 tsy a.j005-*,* bdisc
3808 rdwbak return rddcw all done
3809 rem
3810 rdw010 die 20
3811 rem
3812 ttls rddata -- set up dcw list to read output data
3813 rem
3814 rem this subroutine uses the pseudo-dcws read from
3815 rem the cs by rddcw to set up a dia dcw list for
3816 rem reading in the output data itself
3817 rem
3818 rem the dcws will be built in a static area dcws and
3819 rem a chain of buffers will be allocated for the data
3820 rem
3821 rddata subr rdd
3822 rem
3823 ldx1 a.j001-* dcws get address of dcw list area
3824 stx1 a.j002-*,* dcwadr setup dcw list address for conect
3825 lda ndcws-* length of dcw list is
3826 iaa 1 2*ndcws+1 because of disconnect dcw
3827 als 1
3828 sta a.j003-*,* dcwlen setup dcw list length for conect
3829 rem
3830 ldx2 a.j006-* get pointer to first pseudo-dcw
3831 stz rhead-* init head of chain addr
3832 stz rtail-* init tail of chain addr
3833 lda ndcws-* get number of dcws
3834 iera -1 negate it
3835 iaa 1
3836 sta dcwcnt-* init loop counter
3837 rem
3838 rdd010 null
3839 ldq 1,2 get character tally
3840 tnz 2 zero ain't posssible
3841 die 20
3842 iaq 67 4 chars overhead + 63 to round up
3843 qrs 6 divide by 64 chars per buffer
3844 qls bufshf multiply by words per buffer
3845 tsy a.j004-*,* getbfh
3846 tra rdd030-* failed, go clean up
3847 caq put new buffer addr in q
3848 lda rtail-* get addr of prev buffer
3849 tze rdd015-* no prev buffer
3850 tsy a.j009-*,* setbpt
3851 cax3
3852 stq bf.nxt,3 chain to next buffer
3853 tra 2
3854 rdd015 stq rhead-* save head of chain
3855 stq rtail-* save tail of chain
3856 cqa put new buffer addr in a
3857 tsy a.j009-*,* setbpt
3858 cax3 convert it into x3
3859 rem
3860 lda 0,2 get cs address from pseudo-dcw
3861 tze rdd040-* zero address is unlikely to be right
3862 cmpa blimit-* so is one below the buffer area
3863 tnc rdd040-*
3864 ilq diactf cs -> fnp transfer opcode
3865 staq 0,1 put in dcw
3866 lda 1,2 get character tally
3867 orsa bf.tly,3 put it in buffer
3868 iaa 3 convert to words
3869 ars 2 right-adjust
3870 ora l.j002-* =absflg
3871 lrs 18 and put in q
3872 lda rtail-* get absolute buffer address
3873 iaa bf.dta get pointer to output buffer data
3874 staq 2,1 put fnp address and tally in dcw
3875 rem
3876 iacx1 4 point to next place for dcw
3877 aos dcwcnt-* increment loop counter
3878 tze rdd020-* done if zero
3879 iacx2 2 get addr of next pseudo-dcw
3880 tra rdd010-* build next dcw
3881 rem
3882 rdd020 null through building dcws
3883 rem except for disconnect
3884 cx1a put addr of next dcw ...
3885 cax3 in x3 for bdisc
3886 tsy a.j005-*,* bdisc
3887 aos rddata-* give success return
3888 rem
3889 rddbak return rddata
3890 rem
3891 rdd030 null couldn't allocate enough data buffers
3892 lda rhead-* must free data buffers
3893 tze rddbak-* none allocated yet
3894 tsy a.j008-*,* frelbf
3895 tra rddbak-* cleanup and take error exit
3896 rem
3897 rdd040 die 20
3898 ttls storage for rddcw and rddata
3899 rem
3900 a.j001 ind dcws static dcw list area
3901 a.j002 ind dcwadr conect's address of base of dcw list
3902 a.j003 ind dcwlen length of dcw list 36-bit words
3903 a.j004 ind getbfh subroutine to get a buffer from high memory
3904 a.j005 ind bdisc subroutine to make a disconnect dcw
3905 a.j006 ind pdcws address of static pseudo-dcw area
3906 a.j007 ind frebuf subroutine to release a single buffer
3907 a.j008 ind frelbf subroutine to free linked list of buffers
3908 a.j009 ind setbpt subroutine to convert buffer address to 15-bit
3909 rem
3910 rem
3911 l.j001 vfd 18/buftmk
3912 l.j002 vfd 18/absflg absolute address ing in dcw
3913 rem
3914 rem
3915 ndcws bss 1 number of cs dcws in list
3916 rhead bss 1 address of head of allocated output chain
3917 rtail bss 1 address of last buffer in allocated chain
3918 dcwcnt bss 1 dcw loop counter
3919 even
3920 pdcws bss 16*2 space for reading in pseudo-dcws
3921 ttls bint -- builds an "interrupt cs" dcw
3922 rem
3923 rem interrupt cell assignment has been set by init
3924 rem from configuration status
3925 rem
3926 rem x3 points to dcw to be built
3927 rem
3928 bint subr bin
3929 rem
3930 ldaq intdcw-* get interrupt cell and opcode
3931 staq 0,3
3932 lda l.z001-* 0,w.2
3933 ilq 0
3934 staq 2,3 this stuff will be ignored, but should be 36-bit
3935 return bint
3936 rem
3937 ttls bdisc -- builds a "disconnect" dcw
3938 rem
3939 rem a "disconnect" dcw will be put at the address
3940 rem pointed to by x3
3941 rem
3942 bdisc subr bdi
3943 rem
3944 ila 0
3945 ilq diadis disconnect opcode
3946 staq 0,3
3947 lda l.z001-* 0,w.2 make unused fnp address 36-bit addressing
3948 ilq 0
3949 staq 2,3
3950 return bdisc
3951 rem
3952 l.z001 zero 0,w.2
3953 rem
3954 even
3955 intdcw oct 0
3956 dindcw vfd 12/0,6/diainc interrupt cell is or'ed in at init time
3957 rem
3958 ttls lock and unlock -- control the dia lock
3959 rem
3960 rem no new dia activity is initiated while the dia
3961 rem lock is locked
3962 rem
3963 lock subr loc,inh
3964 rem
3965 szn dilock-* lock already locked?
3966 tze 2
3967 die 14 yes, we shouldn't be locking it again
3968 rem
3969 lda lock-* no, lock it with address of caller
3970 sta dilock-*
3971 return lock
3972 rem
3973 rem
3974 rem
3975 unlock subr unl,inh
3976 rem
3977 szn dilock-* is it unlocked?
3978 tnz 2
3979 die 15 then we shouldn't be trying to unlock it
3980 rem
3981 stz dilock-* unlock it now
3982 return unlock
3983 rem
3984 rem
3985 dilock oct 0 dia lock
3986 rem
3987 ttls conect -- connect to the dia
3988 rem
3989 rem this subroutine is called when it's time to
3990 rem do a connect to the dia
3991 rem
3992 rem it must:
3993 rem store the address and tally 36-bit words
3994 rem of the dcw list in the list icw
3995 rem
3996 rem calculate parity on all the dcws in the list
3997 rem
3998 rem put the list icw address in the pcw mailbox
3999 rem
4000 rem issue the connect
4001 rem
4002 rem dcwadr is preset with the address of the dcw list
4003 rem dcwlen is preset with the number of 36-bit words
4004 rem this is so that in case of an i/o error we can
4005 rem just use the same dcw list again
4006 rem
4007 conect subr con,inh
4008 rem
4009 lda a.k003-*,* globsw
4010 cana l.k005-* gbfhng is anyone listening at other end?
4011 tnz conbak-* no, don't bother doing connect
4012 rem
4013 lda dcwadr-* get pointer to head of list
4014 cax2
4015 ora l.k004-* 0.w,2
4016 ldq dcwlen-* get length
4017 staq lsticw-*
4018 rem
4019 rem now calculate parity on dcws
4020 rem set bit 21 to be odd parity with bits 0-17
4021 rem then set bit 22 to be odd parity with bits 18-35
4022 rem
4023 con010 null
4024 lda l.k001-* =npbits
4025 ansa 1,2 turn them both off first
4026 lda 0,2 get high-order word
4027 alp 18 get parity
4028 tnz con020-* already odd, do nothing
4029 lda l.k002-* =pupper
4030 orsa 1,2 or on upper parity bit
4031 rem
4032 con020 null
4033 lda 1,2 get second word
4034 alp 18
4035 tnz con030-* if already odd, don't bother it
4036 lda l.k003-* =plower
4037 orsa 1,2 or on lower parity bit
4038 rem
4039 con030 null on to next dcw word
4040 iaq -1 any more?
4041 tze con040-*
4042 iacx2 2 yes, bump pointer
4043 tra con010-* go around again
4044 rem
4045 con040 null parity all set
4046 ldaq licadr-* get address and parity of list icw
4047 staq a.k001-*,* dimb dia pcw mailbox
4048 rem refresh status icw
4049 ldaq sticw-* clean status icw model
4050 staq a.k002-*,* dist dia status icw
4051 ila 1 indicate that connect is pending
4052 sta a.k004-*,* iopend
4053 rem
4054 rem
4055 diasel sel ** patched by init for correct channel
4056 cioc a.k001-*,* dimb dia pcw mailbox
4057 rem that's it
4058 conbak return conect
4059 rem
4060 rem
4061 a.k001 ind dimb dia pcw mailbox
4062 a.k002 ind dist
4063 a.k003 ind globsw
4064 a.k004 ind iopend
4065 rem
4066 l.k001 vfd 18/npbits
4067 l.k002 vfd 18/pupper
4068 l.k003 vfd 18/plower
4069 l.k004 zero 0,w.2 36-bit addressing
4070 l.k005 vfd 18/gbfhng
4071 rem
4072 rem
4073 even
4074 lsticw icw dcws,w.2,4 list icw
4075 dlist null init uses this to do parity calculations
4076 sticw icw stat,w.2,1,1 dia status icw template
4077 rem with exhaust bit so we always see latest one
4078 rem
4079 even
4080 licadr zero lsticw,w.2 list icw address
4081 oct 70 init will or in parity
4082 rem
4083 dcwadr bss 1 address of dcw list
4084 dcwlen bss 1 length of dcw list 36-bit words
4085 even
4086 dcws bss 4*28 place where most dcw lists are created
4087 rem
4088 ttls wmbx -- write a mailbox to the cs
4089 rem
4090 rem this subroutine writes a mailbox to the cs after
4091 rem computing the checksum and storing it in the mailbox
4092 rem
4093 rem a contains address of mailbox to be written, which
4094 rem will first be copied into swmbx
4095 rem if a is 0, mailbox is already in swmbx, and
4096 rem is being rewritten because of checksum error
4097 rem
4098 rem mailbox number in mbxno will be used by wtimw
4099 rem to determine what bit to set in cs's
4100 rem "terminate interrupt multiplex word" timw
4101 rem and the mailbox size
4102 rem
4103 wmbx subr wmb
4104 rem
4105 cax3 get mailbox address
4106 tze wmb020-* if zero, use swmbx
4107 rem else we'll copy it in
4108 lda mbxno-*
4109 icmpa 8 fnp or cs origin?
4110 tmi 3 cs
4111 ila -fmbxsz/2 fnp, use large size
4112 tra 2
4113 ila -8 get repetition count
4114 sta rcnt-*
4115 iera -1 now make it positive
4116 iaa 1
4117 sta wsize-*
4118 ldx2 a.l001-* addrswmbx
4119 rem
4120 wmb010 null
4121 ldaq 0,3 pick up two words of mailbox
4122 staq 0,2 copy them
4123 aos rcnt-* is that all?
4124 tze wmb020-*
4125 iacx2 2 no, bump input and output pointers
4126 iacx3 2
4127 tra wmb010-* do it again
4128 rem
4129 wmb020 null set transaction control word
4130 szn a.l011-*,* shinp
4131 tze 3 if "short input", set it to
4132 ila tcinmb "sent input in mailbox"
4133 tra 2 else, set it
4134 ila tcwmbx to "wrote mailbox"
4135 sta a.l002-*,* tcword
4136 rem
4137 rem now set up dcw list
4138 trace mt.wmb,tr.mbx,mbxno
4139 rem
4140 ldx3 a.l004-* addrdcws
4141 stx3 a.l005-*,* dcwadr
4142 ila 10 10 words of dcws
4143 sta a.l006-*,* dcwlen
4144 rem
4145 lda mbxno-* get mailbox number
4146 icmpa 8 cs mailbox?
4147 tmi wmb030-* yes
4148 iaa -8 no, get it in range 0-3
4149 mpy l.l004-* fmbxsz use fnp size
4150 cqa
4151 iaa mh.fsb add base of fnp mailbox area
4152 tra wmb040-*
4153 wmb030 null
4154 als 3 for cs mailbox, use mailbox no. times 8
4155 iaa mh.sub and offset of submailbox 0
4156 wmb040 null
4157 ada csmbx-* add address of cs mailbox header
4158 ilq diaftc fnp->cs transfer opcode
4159 staq 0,3 cs address and opcode into dcw
4160 rem
4161 lda a.l001-* get addrswmbx in a
4162 ora l.l001-* 0,w.2
4163 ldq wsize-* tally for writing mailbox
4164 staq 2,3 into dcw
4165 iacx3 4 point to next dcw
4166 rem call subroutine to update timw
4167 tsy wtimw-*
4168 rem dcw pointer is also updated
4169 rem now put in interrupt and disconnect dcws
4170 tsy a.l007-*,* bint
4171 iacx3 4
4172 tsy a.l008-*,* bdisc
4173 rem all done, now just connect
4174 tsy a.l009-*,* conect
4175 return wmbx
4176 rem
4177 ttls frembx -- tells cs a mailbox is free
4178 rem
4179 rem this subroutine sets up a dcw list to or on
4180 rem the bit corresponding to a mailbox being frees in the
4181 rem cs's "terminate interrupt multiplex word" timw
4182 rem
4183 frembx subr fre
4184 rem set transaction control word
4185 ila tcfree to "mailbox freed"
4186 sta a.l002-*,* tcword
4187 rem
4188 trace mt.fre,tr.mbx,mbxno
4189 rem
4190 lda mbxno-* cs or fnp mailbox?
4191 icmpa 8
4192 tmi fre010-* cs
4193 icmpa 12 fnp, rewritten or not?
4194 tmi 2 yes
4195 iaa -4 no, get number in range 8-11
4196 iaa -8 now get it in range 0-3
4197 cax3
4198 stz a.l012-*,* mbxfre3 mark it free
4199 ila -1 decrement used count
4200 asa a.l015-*,* mbused
4201 tsy a.l013-*,* unlock unlock dia now
4202 tsy a.l014-*,* gate make sure dgetwk runs
4203 tra frebak-* no need to tell multics anything
4204 fre010 null
4205 ldx3 a.l004-* addrdcws
4206 stx3 a.l005-*,* dcwadr
4207 ila 8 8 words of dcws
4208 sta a.l006-*,* dcwlen
4209 tsy wtimw-* set up dcws to update timw
4210 rem set up interrupt and disconnect dcws
4211 tsy a.l007-*,* bint
4212 iacx3 4
4213 tsy a.l008-*,* bdisc
4214 rem do connect now
4215 tsy a.l009-*,* conect
4216 frebak return frembx
4217 rem
4218 ttls wtimw -- sets up dcws to update timw
4219 rem
4220 rem this subroutine sets up dcws to "or" in a bit
4221 rem corresponding to the mailbox number in "mbxno"
4222 rem to the cs's "terminate interrupt multiplex word" timw
4223 rem
4224 rem we will use the dia opcode "transfer gate", which means
4225 rem "read and clear cs and or fnp",
4226 rem followed by fnp->cs transfer
4227 rem
4228 rem x3 contains address of first dcw to be built
4229 rem on return it will point to next free spot in dcw list
4230 rem
4231 wtimw subr wti
4232 rem
4233 lda l.l002-* "arl 0" instruction
4234 ora mbxno-* make it "arl mbxno"
4235 sta wti010-* store it where we'll execute it
4236 rem get high-order bit for shifting
4237 lda l.l003-* =400000
4238 rem shift it
4239 wti010 zero shift instruction goes here
4240 sta timw-* result will be new timw
4241 rem now set up dcws
4242 lda csmbx-* cs address of mailbox header
4243 iaa mh.tim +offset of timw
4244 ilq diatrg "transfer gate" opcode
4245 staq 0,3
4246 ilq diaftc second dcw is same but with fnp->cs transfer
4247 staq 4,3
4248 rem
4249 lda a.l010-* addrtimw,w.2
4250 ilq 1 tally of one 36-bit word
4251 staq 2,3 this is for both dcws
4252 staq 6,3
4253 rem
4254 iacx3 8 update dcw pointer
4255 return wtimw that's all
4256 rem
4257 ttls storage for wmbx, frembx, wtimw
4258 rem
4259 a.l001 ind swmbx
4260 a.l002 ind tcword
4261 *a.l003 unused
4262 a.l004 ind dcws
4263 a.l005 ind dcwadr
4264 a.l006 ind dcwlen
4265 a.l007 ind bint
4266 a.l008 ind bdisc
4267 a.l009 ind conect
4268 a.l010 zero timw,w.2
4269 a.l011 ind shinp "short input" flag
4270 a.l012 ind mbxfre,3
4271 a.l013 ind unlock
4272 a.l014 ind gate
4273 a.l015 ind mbused
4274 rem
4275 rem
4276 l.l001 zero 0,w.2
4277 l.l002 arl 0 template for shift of mbxno bits
4278 l.l003 oct 400000
4279 l.l004 zero fmbxsz/2
4280 rem
4281 rem
4282 wsize bss 1 size of this mailbox in 36-bit words
4283 even
4284 timw bss 2 fnp's copy of cs timw
4285 rcnt bss 1 repetition count for copying mailbox
4286 mbxno bss 1 mailbox number
4287 rem
4288 even
4289 swmbx bss 56 mailbox to be written
4290 rem
4291 ttls dia configuration region
4292 rem
4293 rem
4294 even
4295 cspab oct port a and port b
4296 cspcd oct port c and port d
4297 csmbx oct cs mailbox address
4298 csics oct cs interrupt cell switch
4299 cslwa oct lower address bounds switches
4300 rem bits 0-8
4301 csupc oct upper address bounds switches
4302 rem bits 0-8
4303 rem bit 15 - store timer
4304 rem bit 16 - address bounds
4305 zerwd oct 0,0 36 bit zero word for end-of-file
4306 cssca oct cs system controller address
4307 rem
4308 dicell equ csics
4309 dmbx equ csmbx
4310 diconf equ cspab
4311 ttls qmask -- clear out a queue for masked channel
4312 rem
4313 ************************************************************
4314 *
4315 * This routine is called when it's time to add a
4316 * "mask channel" entry to a dia request queue. First
4317 * it clears out whatever is currently in the channel's
4318 * queue, and frees its t.dcp chain, if any.
4319 * It is called by denq when a linmsk op code is passed
4320 * to it, unless there's a currently active accept input in
4321 * in the queue; in the latter case, it is called by deque
4322 * when the accept input is finished. in either case, it is
4323 * the caller's responsibility to worry about decrementing
4324 * qcnt to account for the removed queue entries.
4325 *
4326 * input:
4327 * x1: virtual tib address
4328 * curque points to corresponding tib table entry
4329 *
4330 ************************************************************
4331 rem
4332 qmask subr qma,aqx2x3
4333 rem
4334 ldx3 a.m001-*,* curque
4335 qma010 ldx2 qbuf,3 get pointer to first entry in queue
4336 tze qma020-* none left
4337 stx2 curqbf-* make sure dlqent knows where to look
4338 tsy a.m002-*,* dlqent remove it
4339 tra qma010-* do next one
4340 qma020 lda t.dcp,1 if any queued input,
4341 tze qma030-*
4342 tsy a.m003-*,* frelbf not any more
4343 stz t.dcp,1
4344 stz t.dcpl,1
4345 stz t.dlst,1
4346 qma030 ilq linmsk get opcode
4347 tsy a.m004-*,* adqent
4348 aos a.m005-*,* qcnt update queue count
4349 tsy a.m006-*,* gate make sure dgetwk runs
4350 return qmask
4351 rem
4352 a.m001 ind curque
4353 a.m002 ind dlqent
4354 a.m003 ind frelbf
4355 a.m004 ind adqent
4356 a.m005 ind qcnt
4357 a.m006 ind gate
4358 ttls subroutines to manage dia queues
4359 rem
4360 ************************************************************
4361 *
4362 * One dia queue is maintained for each tib as well
4363 * as one for an error queue.
4364 * each queue consists of blocks linked
4365 * together with one entry per block.
4366 *
4367 * format of first word of a dia queue entry
4368 *
4369 * *******************************
4370 * * * * *
4371 * * flags * cnt * opcode *
4372 * * * * *
4373 * *******************************
4374 * 0 5 6 8 9 17
4375 *
4376 * followed by the number of data words specified in count
4377 *
4378 * format of a block in the dia queue
4379 *
4380 * word 0 qbnext - address of next buffer in chain
4381 * 0 specifies end of chain
4382 * word 1 qbsize - size of this block in words
4383 * word 2 qbdata - queue entries start here
4384 *
4385 ************************************************************
4386 rem
4387 * define buffer addresses
4388 rem
4389 qbnext equ 0 addr of next buffer
4390 qbsize equ 1 number of words in this block
4391 qbdata equ 2 data starts here
4392 rem
4393 * the queue handling routines set and/or depend on the
4394 * following variables:
4395 rem
4396 curque bss 1 must contain the address of the tib
4397 rem table entry for the current queue
4398 curqbf bss 1 address of buffer that contains current
4399 rem queue entry
4400 curqln bss 1 current line number, set for trace
4401 nnonai bss 1 set by getqai to indicate the number
4402 rem if non-accept input queue entries
4403 rem before the first accept input entry
4404 eject
4405 ************************************************************
4406 *
4407 * adqent - subroutine to add a new entry to a dia queue
4408 *
4409 * at input, the q contains the dia opcode in the lower
4410 * half and, if data is to be passed, the word count
4411 * in the upper half. if the word count is non-0,
4412 * x2 must contain the address of the data.
4413 *
4414 * this subroutine can be called by derrq at interrupt time,
4415 * and therefore must run inhibited
4416 *
4417 * there are no outputs.
4418 *
4419 ************************************************************
4420 rem
4421 adqent subr adq,inhaqx2x3
4422 cqa first word of queue entry
4423 ars 9 get word count
4424 iaa 1 allow 1 word for opcode
4425 sta adqsnw-* save number of words required
4426 rem
4427 * the new entry goes in the last buffer, so find it
4428 rem
4429 ldx2 curque-* tib table entry
4430 ldx3 qbuf,2 get buffer pointer
4431 tze adq010-* no buffers, go allocate one
4432 adq030 szn qbnext,3 is this last buffer?
4433 tze adq010-* yes
4434 ldx3 qbnext,3 follow thread
4435 tra adq030-*
4436 rem
4437 * must allocate a new buffer for this entry
4438 rem
4439 adq010 stx3 adqtmp-* save last buffer address
4440 lda adqsnw-* number of data words
4441 iaa 3 +1 for chain, +1 for size, +1 for rounding
4442 iana -2 force it even
4443 caq
4444 tsy a.u001-*,* =getmem allocate new entry
4445 die 10
4446 stq qbsize,3 save size
4447 szn qbuf,2 is this the first buffer for queue
4448 tze adq050-* yes
4449 ldx2 adqtmp-* get pointer to old last buffer
4450 stx3 qbnext,2 complete chain
4451 tra adq040-*
4452 adq050 stx3 qbuf,2 store as first buffer in chain
4453 rem
4454 * now a buffer has been found where the entry will fit
4455 rem
4456 adq040 stx3 curqbf-* this is the new current buffer
4457 iacx3 qbdata address of first word to use
4458 rem
4459 trace mt.inq,tr.que,x3adqsqcurqln
4460 rem
4461 lda adqsq-* pick up opcode from save area
4462 sta 0,3 store in queue
4463 iacx3 1 and bump pointer
4464 ars 9 get number of data words to copy
4465 tze adq060-* none
4466 ldx2 adqsx2-* get their address
4467 adq070 ldq 0,2 get a word
4468 stq 0,3 copy it
4469 iacx2 1 bump pointers
4470 iacx3 1
4471 iaa -1
4472 tnz adq070-* loop til copied
4473 adq060 szn curqln-* was this for s apecific line?
4474 tze adqbak-* no, skip metering
4475 rem
4476 ldx3 t.metr,1
4477 cmeter mincs,m.cql,l.u001-*
4478 cmeter mupdat,m.dql,m.cql3
4479 rem
4480 adqbak return adqent all done
4481 rem
4482 adqsnw bss 1
4483 adqtmp bss 1
4484 rem
4485 a.u001 ind getmem
4486 a.u002 ind fremem
4487 rem
4488 rem
4489 l.u001 dec 1 for metering
4490 l.u002 dec -1 likewise
4491 eject
4492 ************************************************************
4493 *
4494 * dlqent - suboutine to delete an entry for the queue.
4495 *
4496 * input - x2 must point at entry to delete
4497 *
4498 ************************************************************
4499 rem
4500 dlqent subr dlq,aqx2x3
4501 rem
4502 cx1a for a specific line?
4503 tze dlq010-* no, no metering
4504 ldx3 t.metr,1
4505 cmeter mincs,m.cql,l.u002-*
4506 cmeter mupdat,m.dql,m.cql3
4507 rem
4508 dlq010 ldx3 curqbf-* start of buffer
4509 ldx2 qbnext,3 hold onto pointer to next buffer
4510 ldq qbsize,3
4511 tsy a.u002-*,* =fremem free this buffer
4512 rem
4513 * rethread the buffer chain
4514 rem
4515 lda curqbf-* addr of buffer just freed
4516 ldx3 curque-* tib table entry
4517 cmpa qbuf,3 did we free first buffer in chain
4518 tnz dlq040-* no
4519 stx2 qbuf,3 yes, next buffer now first
4520 tra dlqret-*
4521 dlq040 ldx3 qbuf,3 follow buffer trail
4522 dlq060 cmpa qbnext,3 does this buffer point to one just freed?
4523 tze dlq050-* yes
4524 ldx3 qbnext,3
4525 tra dlq060-*
4526 dlq050 stx2 qbnext,3 thread out freed buffer
4527 dlqret return dlqent
4528 eject
4529 ************************************************************
4530 *
4531 * getqhd - subroutine to find first entry in a dia queue.
4532 *
4533 * no inputs
4534 *
4535 * output - if queue empty, return is inline
4536 * otherwise, a skip return is done, and x2 will point to the
4537 * first entry.
4538 *
4539 ************************************************************
4540 rem
4541 getqhd subr ghd
4542 rem
4543 ldx2 curque-* current tib table
4544 ldx2 qbuf,2 first buffer
4545 tze ghdret-* queue empty
4546 stx2 curqbf-* this becomes current buffer
4547 iacx2 qbdata data starts here
4548 aos getqhd-* found entry, so skip
4549 ghdret return getqhd
4550 rem
4551 rem
4552 ************************************************************
4553 *
4554 * getqai - subroutine to find first accept input in queue
4555 *
4556 * output - x2 points to accept input, if found, and
4557 * a skip return is made. if not found, the return is inline.
4558 * the variable nnonai is set to the number of queue
4559 * entries skipped over.
4560 *
4561 ************************************************************
4562 rem
4563 getqai subr gai,ax3
4564 rem
4565 stz nnonai-* zero counter initially
4566 tsy getqhd-* get head of queue
4567 tra gairet-* empty
4568 gai020 lda 0,2 pick up opcode
4569 iana 255
4570 icmpa accin found it?
4571 tze gai010-* yes
4572 aos nnonai-* count something else
4573 ldx3 curqbf-* get block address
4574 ldx2 qbnext,3 go to next
4575 tze gairet-* if any
4576 stx2 curqbf-* this is current buffer now
4577 iacx2 qbdata point at data
4578 tra gai020-* check for accin
4579 gai010 aos getqai-* skip return, found accin
4580 gairet return getqai
4581 ttls j u m p t a b l e s
4582 rem
4583 rem
4584 rem format:
4585 rem
4586 rem word 0 return addr after interrupt processed
4587 rem word 1 place to go on interrupt in dia_man
4588 rem word 2 ioc#,channel#,module#3
4589 rem
4590 rem
4591 diajt null used to find jump tables for setting up iv's
4592 jmptm zero terminate
4593 tsy ivp-*,*
4594 vfd 4/0,8/0,6/trmmod
4595 rem
4596 rem mailbox requests
4597 jumptb 0123456789101112131415
4598 rem
4599 ivp zero invp
4600 rem
4601 rem
4602 enddia equ *
4603 end