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) change(86-04-23,Coren), approve(86-04-23,MCR7300),
 120 *     audit(86-05-19,Beattie), install(86-07-08,MR12.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-*,*          (badsts,2)
 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-*  addr(sterr), 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,(inh,x1)
 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,(x2,x3)
 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-*  addr(savmbx), 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,(inh,a,q)
 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,(a,q,x2,x3)
 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,(a,q,x1,x2,x3)
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,(inh,a,q,x2,x3)
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 buffer(s) 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-*  =addr(savmbx)
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-*(*),opcode,sm.lno(3))
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-*  (0,w.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.lno(3),sm.adr+1(3))
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.lno(3))
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.cd(3))
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-*  addr(alttab)
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-*  addr(wrutbl)
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-*  addr(ctrl)
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-*  addr(ctrl)
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,(q,x2)
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,(filtmp,filopc,t.line(1))
2659           rem
2660           lda       filopc-*  get op code again
2661           ldx2      a.v015-*  addr(rcdtab)
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-*  addr(ctrl)
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-*  addr(savmb)
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,(x2,x3)
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,(x2,x3)
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,(x1,x2,x3,q)
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,(x2,q)
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,(x2,x3,q)
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,(x2,x3)
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.cdl(3),sm.cd(3),sm.cd+1(3),sm.cd+2(3),s
3226           etc       m.cd+3(3))
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-*  (0,c.0) change x2 to 6bit chars
3256           cax2
3257           cx3a
3258           ora       l.t003-*  (0,b.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,(a,q,x3)
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,(a,q,x2,x3)
3439           rem
3440           lda       t.dcp,1   free any input chain(s)
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,(x2,x3)
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,(icount,t.line(1))
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.dat,b.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.dta,b.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-*  addr(dcws)
3649           stx3      a.i002-*,*          dcwadr
3650           stx3      curdcw-*  initialize dcw pointer
3651           stz       a.i003-*,*          initialize dcwlen
3652           ldx3      a.i004-*  addr(savmbx) -- 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,(a,q,x3)
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-*  addr(dcws)
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-*  addr(swmbx)
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-*  addr(dcws)
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 addr(swmbx) 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-*,*          (mbxfre,3) 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-*  addr(dcws)
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-*  addr(timw),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,(a,q,x2,x3)
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,(inh,a,q,x2,x3)
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,(x3,adqsq,curqln)
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.cql(3))
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,(a,q,x2,x3)
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.cql(3))
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,(a,x3)
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    (0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
4598           rem
4599 ivp       zero      invp
4600           rem
4601           rem
4602 enddia    equ       *
4603           end