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 * HISTORY COMMENTS:
  11 *  1) change(85-07-29,Cousins), approve(85-10-28,MCR7274),
  12 *     audit(85-07-29,Coren), install():
  13 *     change hardware status queue refresh mechanism
  14 *        to swap between a pair of queues.  This strategy avoids windows in
  15 *        refresh operation during which status can arrive unnoticed.
  16 *  2) change(85-10-28,Cousins), approve(85-10-28,MCR7275),
  17 *     audit(85-10-28,Coren), install():
  18 *     Change suspend/resume strategy to send a PCW with the transmit bit off
  19 *      instead of manipulating ICWs to force an exhaust condition.
  20 *  3) change(85-11-08,Coren), approve(85-11-08,MCR7275),
  21 *     audit(85-11-17,Beattie), install(88-09-20,MR12.2-1115):
  22 *     Make some corrections to the changes for suspend/resume.
  23 *  4) change(85-12-20,Kozlowski), approve(88-08-15,MCR7965),
  24 *     audit(88-09-08,Farley), install(88-09-20,MR12.2-1115):
  25 *     Add support to set speeds of 2400, 4800 and 9600 as required by
  26 *     autobaud_tables.
  27 *  5) change(88-07-22,Beattie), approve(88-08-15,MCR7965),
  28 *     audit(88-09-08,Farley), install(88-09-20,MR12.2-1115):
  29 *     Prepared for installation.
  30 *                                                      END HISTORY COMMENTS
  31 
  32           ttl       hsla_man - multics/fnp (mcs) hsla manager
  33           ttls      hsla_man - multics/fnp (mcs) hsla manager
  34           lbl       ,hsla_man
  35           editp     on
  36           pmc       on
  37           pcc       off
  38           base      8
  39 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  40 *
  41 *         hsla_man, hsla
  42 *
  43 *              This is hsla_man, the high speed line
  44 *         adaptor support routine for the multics/fnp
  45 *         communications system (mcs). It is driven by
  46 *         dcw lists supplied by the control_tables and
  47 *         interrupts from the various types of lines
  48 *         connected to the hsla subchannels.
  49 *
  50 *              Status from the interrupts is not
  51 *         processed at interrupt time, but is queued
  52 *         for later processing. This avoids problems of
  53 *         processing status for a line while the call side
  54 *         is changing parameters about that line.
  55 *
  56 *         coded 9/5/74 by mike grady
  57 *
  58 *         modified 79 jul 20 by art beattie to support dn6670
  59 *           extended memory.
  60 *
  61 *         modified july 1981 by robert coren to incorporate
  62 *            dave cousins' code for faster icw switching.
  63 *
  64 *         modified september 1984 by robert coren to fix several bugs:
  65 *            correct the order of storing icw words;
  66 *            set flow control characters in first half of a double cct;
  67 *            resume suspended output on quit;
  68 *            make mskchn free chains correctly if t.ocur is
  69 *             a non-first subset of t.ocp;
  70 *            fix oscan's check for overflowing t.pos with tabs;
  71 *            make hmode resume output if oflow turned off while
  72 *             suspended.
  73 *         modified april 1985 by robert coren to make scan subroutine not
  74 *            use page table entry if buffer address is in low memory.
  75 *
  76 *         modified sept 1985 by D. W. Cousins to do suspend and resume
  77 *            by turning off the pcw transmit bit instead of forcing
  78 *            an exhaust condition, which could result in a race with the
  79 *            hardware.
  80 *
  81 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  82           tib
  83           ttls      software communications region, hsla
  84           sfcm      hsla
  85           rem
  86           rem
  87           hwcm
  88           rem
  89           meters
  90           rem
  91           hslatb
  92           csbits
  93           devtab
  94           buffer
  95           rem
  96 hbfnch    equ       bufsiz*2-5          number of real spots in hsla input bfr
  97           rem
  98           comreg
  99           rem
 100           dlytbl
 101           ttls
 102           cctdef
 103           ttls      symrefs and symdefs
 104           symdef    hsla      primary sysdef
 105           symdef    hdcw      dcw list processor
 106           symdef    hintr     interrupt processor
 107 *         symdef    hbreak    change break list
 108           symdef    hgeti     get ptr and tally of input bfr
 109           symdef    hmode     chnage modes entry
 110           symdef    houtav    output has arrived entry
 111           symdef    hcfg      change confiuration
 112           symdef    hslajt    location of hsla jump tables
 113           symdef    setcct    setcct opblock handler
 114           symdef    shrcct    shared cct handler
 115           symdef    hcheck    to start echoing if possible
 116           symdef    cbufsz    change sf.bsz size for sync pre alloc buffer
 117           symdef    hunmsk    subroutine to unmask a subchannel
 118           rem
 119           rem
 120           symref    trace
 121           symref    outprc    processor for output sub-op
 122           symref    istat     entry in intrp for status
 123           symref    maskr     return point in control_tables after masking
 124           symref    itest     test-state entry of control_tables
 125           symref    invp      interrupt handler in scheduler
 126           symref    g3wjt     entry to get interrupt info
 127           symref    dspqur    secondary dispatcher
 128           symref    mdisp     return to master dispatcher
 129           symref    secdsp    return to secondary dispatcher
 130           symref    gettib    entry to get the tib addr
 131           symref    getbuf    entry to grab a buffer
 132           symref    getbfh    entry to grab a buffer from high memory
 133           symref    frebuf    entry to free a buffer
 134           symref    frebfh    entry to free a buffer in high memory
 135           symref    frelbf    entry to free a buffer chain
 136           symref    setbpt    entry to convert buffer address to virtual
 137           symref    cvabs     entry to convert address to absolute
 138           symref    denq      queuer for dia man requests
 139           symref    derrq     queuer for error messages to cs
 140           symref    meterc    metering subroutine
 141           symref    getmem
 142           symref    fremem
 143           symref    getcmt    get address of carriage mvmt tbl
 144           symref    inproc    processes input chars for asynchronous lines
 145           symref    setptw    set up page table word
 146           symref    mincs
 147           symref    mincd
 148           symref    mupdat    metering subroutines
 149           rem
 150           rem
 151           rem
 152 hsla      null
 153           start     hsla,6
 154           hslast
 155           ttls      hsla pcw op-codes and broadside commands
 156           rem
 157           rem       pcw command type codes
 158           rem
 159 pcw.0     bool      000000    command type 0 pcw
 160 pcw.1     bool      200000    cmd type 1 w/broadside
 161 pcw.2     bool      400000    config type 2 async
 162 pcw.3     bool      600000    config type 3 sync
 163           rem
 164           rem       op-codes
 165           rem
 166 p.nop     bool      000000    no operation
 167 p.ris     bool      010000    request input status
 168 p.ros     bool      020000    request output status
 169 p.rcs     bool      030000    request config status
 170 p.msk     bool      040000    set subchannel mask bit
 171 p.rmsk    bool      050000    reset subchannel mask bit
 172 p.sriw    bool      060000    switch receive icw
 173 p.ssiw    bool      070000    switch send icw
 174 p.init    bool      100000    initialize
 175 p.smsk    bool      110000    store subchannel mask register
 176           bool      120000
 177           bool      130000
 178 p.rsyn    bool      140000    re-sync the subchannel
 179 p.tlbk    bool      150000    transmit line break
 180           bool      160000
 181           bool      170000
 182           rem
 183           rem       broadside bits
 184           rem
 185 pb.rcv    bool      000400    set receive mode
 186 pb.xmt    bool      000200    set xmit mode
 187 pb.wam    bool      000100    set wraparound mode
 188 pb.dtr    bool      000040    set data terminal ready
 189 pb.rts    bool      000020    set request to send
 190 pb.mby    bool      000010    make busy
 191 pb.sxt    bool      000004    set supervisory transmit
 192 pb.tre    bool      000004    set tally runout enable (hdlc)
 193 pb.crq    bool      000002    set call request(acu)
 194 pb.msk    bool      000001
 195           rem
 196           rem       pcw type 2 (asynch confiuration) mode bits
 197           rem
 198 p2.5bt    bool      140000    5-bit characters
 199 p2.6bt    bool      150000    6-bit characters
 200 p2.7bt    bool      160000    7-bit characters
 201 p2.8bt    bool      170000    8-bit characters
 202 p2.mbt    bool      170000    mask for char size field
 203 p2.lpr    bool      000040    lateral parity receive
 204 p2.lps    bool      000020    lateral parity send
 205 p2.lpo    bool      000010    lateral parity odd
 206 p2.icw    bool      000004    two send icw's
 207 p2.cct    bool      000002    cct enable
 208 p2.spr    bool      000001
 209           rem
 210           rem
 211           rem       pcw type 3 (sync config)
 212           rem
 213 p3.itf    bool      000400    hdlc interframe time fill
 214 p3.beb    bool      000400    bsc ebcdic mode
 215 p3.btr    bool      000200    bsc transparent
 216           ttls      random bits, flags, and definitions
 217           rem
 218           rem       sub-op types for dcw list
 219           rem
 220 dl.cmd    equ       1         command sub-op
 221 dl.in     equ       2         input sub-op
 222 dl.out    equ       3         output sub-op
 223 dl.rdt    equ       4         read tally sub-op
 224 dl.sup    equ       5         additional command sub-op data
 225           rem
 226           rem       sub-op types for config list
 227           rem
 228 fg.smd    equ       1         set mode bit
 229 fg.rmd    equ       2         reset mode bit
 230 fg.bd     equ       3         change baud rate
 231           rem
 232           rem       control tables and cct stuff
 233           rem
 234 ct.dev    equ       1         offset of dev table ptr
 235           rem
 236 ttasci    equ       1         t.type value for ascii channels
 237           rem
 238 linmsk    bool      103
 239 sndout    bool      105       send output op for denq
 240 errmsg    bool      115       error message op for derrq
 241           rem
 242           rem
 243 lposhf    equ       5         amount to shift tfoddp to get p2.lpo
 244 lpsshf    equ       3         amount to shift tf8out to get p2.lps
 245           rem
 246           rem
 247 h1ch      equ       6         first hsla iom channel number
 248 h3ch      equ       8         last hsla iom channel number
 249           rem
 250 schdmn    equ       4         module number for scheduler invp
 251           rem
 252 minsiz    equ       bufsiz    size of smallest asynchronous input pseudo-buffer
 253           rem
 254 mxntty    equ       32        max number subchannels per hsla
 255 maxtty    equ       mxntty*3  max tty on hslas
 256           rem
 257 hpri      equ       6         priority of hsla_man hstprc
 258 hprip3    equ       3         high priority for ptro status
 259 hprip2    equ       2         highest priority for >9600 ptro status
 260           rem
 261 sw.dbg    equ       0         on if debugging the module
 262           rem
 263 nl        bool      12        new-line
 264 ff        bool      14        form-feed
 265 cr        bool      15        carriage return
 266 tab       bool      11        horizontal tab
 267 etx       bool      3
 268           rem
 269 bwndow    bool      077000    base address of paging window
 270           eject
 271 ************************************************************************
 272 *
 273 *         format of cct descriptor entry
 274 *         one exists for each shared cct
 275 *
 276 ************************************************************************
 277           rem
 278 cct.nx    equ       0         pointer to next entry
 279 cct.pr    equ       1         pointer to previous entry
 280 cct.ad    equ       2         address of the cct
 281 cct.sz    equ       3         length of the cct
 282 cct.rc    equ       4         referenct count
 283 cct.ln    equ       5         length of descriptor
 284           rem
 285           rem
 286           rem
 287           rem       equates for echo buffer things
 288           rem
 289 eb.inp    equ       0
 290 eb.otp    equ       1
 291 eb.tly    equ       2
 292 eb.dta    equ       2
 293           rem
 294 ebmax     equ       bufsiz*2-5
 295           ttls      trace types and switches
 296           rem
 297 tt.dcw    equ       1         trace hdcw calls
 298 tt.pcw    equ       2         trace pcw connects
 299 tt.int    equ       3         trace interrupts
 300 tt.sta    equ       4         trace status
 301 tt.ira    equ       5         trace icw recovery attempt
 302           rem
 303           rem
 304 ts.dcw    bool      000002
 305 ts.pcw    bool      000004
 306 ts.int    bool      000010
 307 ts.sta    bool      000020
 308           ttls      macros for hsla_man
 309           rem
 310           rem       macro to generate command bit lookup
 311           rem
 312 cmdtab    macro
 313           vfd       1/#2,17/#1
 314           ife       '#2','c.on',2
 315           vfd       18/#3
 316           ife       1,0,1
 317           vfd       o18//#3
 318           endm
 319           rem
 320           rem       macro to generate pcw lookup table
 321           rem
 322 pcwtab    macro
 323           vfd       18/#1
 324           vfd       18/#2
 325           endm
 326           rem
 327           rem       macro to generate config mode bit lookup table entry
 328           rem
 329 cfgtab    macro
 330           vfd       18/#1
 331           vfd       18/#2
 332           vfd       18/#3
 333           ind       #4
 334           endm
 335           rem
 336           rem       macro to generate status lookup tables
 337           rem
 338 stats     macro
 339           vfd       18/#1
 340           ind       #2
 341           endm
 342           rem
 343           rem       macro to setup status match table
 344           rem
 345 smap      macro
 346           vfd       18/#1
 347           vfd       18/#2
 348           endm
 349           rem
 350           rem       macro to do real divide
 351           rem
 352 dvd       macro
 353           qls       1
 354           dvf       #1
 355           endm
 356           eject
 357           rem
 358           rem       macro to do real multiply
 359           rem
 360 mpy       macro
 361           mpf       #1
 362           lrl       1
 363           endm
 364           rem
 365           rem       generates the odd word of a dn6670 paged data address icw
 366           rem         which allows iom to directly address 64k memory.
 367           rem       uses same format as icw pseudo-op except the address is
 368           rem         is not supplied and the third argument must be supplied.
 369           rem
 370 amicwo    macro
 371           vfd       2/2,3/#1,1/#3,12/#2
 372           endm      amicwo
 373           ttls      hdcw - hsla dcw list processor
 374           pmc       off
 375 hdcw      subr      dcw,(x1,x2,x3)      save the index regs
 376           rem
 377 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 378 *
 379 *         hdcw
 380 *
 381 *              subroutine called by interpreter to process
 382 *         a dcw list found in the control_tables.
 383 *
 384 *         Upon entry:
 385 *              x1 - virtual tib address
 386 *              t.dcwa - address of dcw list
 387 *              t.dcwl - dcw list length
 388 *
 389 *         returns:
 390 *
 391 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 392           rem
 393           ldx2      t.sfcm,1  get ptr to sfcm
 394           lda       sf.flg,2  get sfcm flags
 395           icana     sffech    some echo now?
 396           tze       dcw004-*  no, go ahead
 397           rem
 398           lda       t.dcwl,1  get count of times we've skipped out
 399           lrl       9         it's in upper half of t.dcwl
 400           iaa       1         increment it
 401           icmpa     60        over limit?
 402           tpl       dcw002-*  yes, force it through
 403           rem
 404           lls       9         restore lower half of word
 405           sta       t.dcwl,1  update count
 406           ilq       7         meter delayed processing
 407           tsy       a.a008-*,*          meterc
 408           tra       dcwret-*  done here for now
 409           rem
 410 dcw002    ila       sffech    we're going to force this off
 411           iera      -1
 412           ansa      sf.flg,2
 413           rem
 414           ila       pb.xmt    transmit mode too
 415           iera      -1
 416           ansa      sf.pcw,2
 417           rem
 418           ilq       8         meter overriding of sffech
 419           tsy       a.a008-*,*          meterc
 420           rem
 421 dcw004    ila       -1        we're going to process dcw list
 422           arl       9         wipe out count in upper half of t.dcwl
 423           ansa      t.dcwl,1
 424           rem
 425 dcw005    lda       t.dcwl,1  look for real work to be done
 426           tnz       2         sure, go do it.
 427           die       8
 428           rem
 429           ldx3      sf.hsl,2  get pointer to hsla table entry
 430           ldx3      ht.tib,3  get real tib address for trace
 431           trace     tt.dcw,ts.dcw,(x3,t.dcwa(1),t.dcwl(1))
 432           rem
 433           ldx3      t.dcwa,1  get ponter to dcw list
 434           lda       0,3       get first dcw
 435           arl       18-3      shift to get type
 436           icmpa     dl.cmd    is it a command dcw?
 437           tze       dcw010-*  yes, go process it
 438           rem
 439           icmpa     dl.in     is it input sub-op?
 440           tze       dcwret-*  yes, done
 441           rem
 442           icmpa     dl.rdt    is it a read tally sub-op?
 443           tze       dcwret-*  yes, done
 444           rem
 445           tsy       bldobf-*  look for output sub-op
 446           rem
 447           tra       dcwret-*  all done.
 448           rem
 449 dcw010    ldq       l.a005-*  (=p.ris) get request input status op
 450           stq       dcwpcw-*  save for later
 451           rem
 452           lda       t.stat,1  pick up tib status
 453           ana       l.a001-*  (=tsfxmt&tsfrcv) isolate rcv and xmt
 454           sta       dcwst-*   and save for later, also
 455           rem
 456           lda       a.a001-*  (=cmdtab) get addr of cmd table
 457           sta       cmdls-*   set for subr to use
 458           lda       a.a002-*  (=cmdend) get end of table addr
 459           sta       cmdle-*   also for subr
 460           tsy       cmdprc-*  process the command op
 461           rem
 462           szn       t.dcwl,1  any more dcw list left?
 463           tze       dcw020-*  no, done
 464           rem
 465           ldx3      t.dcwa,1  yes, get addr of dcw list
 466           lda       0,3       get the dcw
 467           arl       18-3      shift down to look at type
 468           rem
 469           icmpa     dl.sup    is it a supplemental cmd op?
 470           tnz       dcw020-*  no, continue
 471           rem
 472           lda       a.a011-*  (=suptab) get addr of sup table
 473           sta       cmdls-*   set for subr process
 474           lda       a.a012-*  (=supend) end of cmd table
 475           sta       cmdle-*   set also for subr
 476           tsy       cmdprc-*  process sup cmd op
 477           rem
 478 dcw020    lda       dcwst-*   get the old rcv & xmt modes
 479           ana       l.a003-*  (=tsfrcv) old rcv mode only
 480           era       l.a003-*  (=tsfrcv) ^old rcv mode now
 481           cana      t.stat,1  ^oldrcv&rcv, did we just enter rcv?
 482           tze       dcw030-*  no, continue...
 483           rem
 484           lda       sf.flg,2  synchronous line?
 485           cana      l.a010-*  =sffsyn
 486           tze       dcw025-*  no, don't set message size
 487           ldq       sf.mms,2  get max message size
 488           stq       sf.rms,2  reset residual message size
 489           rem
 490 dcw025    tsy       bldibf-*  go setup rcv data
 491           rem
 492           lda       l.a011-*  get control rcv mask
 493           iera      -1        invert bits
 494           ansa      t.flg2,1  turn off control rcv
 495           rem
 496 dcw030    lda       t.stat,1  get the tib status
 497           cana      l.a004-*  (=tsfxmt) in xmit mode?
 498           tze       dcw035-*  no
 499           rem
 500           szn       sf.ob0,2  get addr of first output
 501           tnz       dcw035-*  output still ready, skip
 502           szn       sf.ob1,2  check second
 503           tnz       dcw035-*  likewise
 504           rem
 505           tsy       bldobf-*  yes, setup output buffers
 506           tra       dcw040-*  done
 507           rem
 508 dcw035    lda       t.stat,1  get new xmit mode setting
 509           ana       l.a004-*  (=tsfxmt) leave only xmit mode
 510           era       l.a004-*  (=tsfxmt) invert for ^xmit
 511           cana      dcwst-*   ^xmit&oldxmit, did we just leave xmit mode?
 512           tze       dcw040-*  no, continue
 513           rem
 514           lda       l.a008-*  (=sffstp) get bit to indicate this
 515           ldx2      t.sfcm,1  get ptr to sfcm and
 516           orsa      sf.flg,2  turn it on in the sfcm
 517           rem
 518 dcw040    lda       l.a007-*  (=tsfbrk) shd we send line break?
 519           cana      t.stat,1  line break?
 520           tze       dcw050-*  no, skip it
 521           rem
 522           ldq       l.a006-*  (=p.tlbk) transmit line break op
 523           stq       dcwpcw-*  reset default op code
 524           rem
 525           iera      -1        complement tsfbrk
 526           ansa      t.stat,1  and turn it off in tib
 527           rem
 528 dcw050    ldx2      t.sfcm,1  get ptr to sfcm
 529           ldx3      a.a003-*  (=pcwtab) get ptr to pcw table
 530           lda       l.a014-*  (pb.msk) preserve "masked" bit
 531           ansa      sf.pcw,2  init rest of pcw to zero
 532           rem
 533 dcw055    lda       t.stat,1  get tib status bits
 534           cana      0,3       is this one on in tib?
 535           tze       dcw060-*  no, jump out
 536           rem
 537           lda       1,3       get pcw broadside bit
 538           orsa      sf.pcw,2  and or it into or pcw
 539           rem
 540 dcw060    iacx3     pcwlen    add in table element size
 541           cmpx3     a.a004-*  (=pcwend) at end of table?
 542           tnz       dcw055-*  no, loop
 543           rem
 544           lda       t.flg,1   check for suspended output
 545           cana      l.a012-*  =tfosus
 546           tze       dcw070-*  not suspended, all is well
 547           lda       l.a013-*  =^pb.xmt
 548           ansa      sf.pcw,2  if suspended we don't want xmit now
 549           rem
 550 dcw070    lda       dcwpcw-*  get the op-code
 551           tsy       a.a007-*,*          do a connect
 552           rem
 553           szn       t.dcwl,1  any more dcw list now?
 554           tze       dcwret-*  no, done
 555           rem
 556           lda       dcwpcw-*  get pcw just sent
 557           cmpa      l.a006-*  (=p.tlbk) sent line break?
 558           tnz       dcwret-*  no, done
 559           rem
 560           ldx3      t.dcwa,1  get addr of dcw list
 561           lda       0,3       get the next dcw
 562           arl       18-3      shift into position
 563           icmpa     dl.cmd    is it command?
 564           tze       dcw005-*  yes, process it now
 565           rem
 566 dcwret    return    hdcw      all done, go back
 567           rem
 568           rem
 569 dcwpcw    bss       1         (altrd) save pcw op-code for connect
 570 dcwst     bss       1         (altrd) status save for old rcv and xmt
 571           rem
 572           rem
 573 l.a001    vfd       18/tsfxmt+tsfrcv tib rcv and xmt
 574 l.a002    vfd       o18/400000          on/off bit in cmdtab
 575 l.a003    vfd       18/tsfrcv tib receive alone
 576 l.a004    vfd       18/tsfxmt tib transmit alone
 577 l.a005    vfd       18/p.ris  request input status op-code
 578 l.a006    vfd       18/p.tlbk transmit line break op-code
 579 l.a007    vfd       18/tsfbrk tib transmit line break
 580 l.a008    vfd       18/sffstp stop channel bit
 581 l.a009    oct       077777
 582 l.a010    vfd       18/sffsyn
 583 l.a011    vfd       18/tfcrcv
 584 l.a012    vfd       18/tfosus
 585 l.a013    vfd       o18//pb.xmt
 586 l.a014    vfd       18/pb.msk
 587           rem
 588           rem
 589 a.a001    ind       cmdtab    command bit lookup table
 590 a.a002    ind       cmdend
 591 a.a003    ind       pcwtab    pcw bit lookup table
 592 a.a004    ind       pcwend
 593 a.a005    ind       outprc    output sub-op processor
 594 a.a006    ind       seticw    setup icw's subr
 595 a.a007    ind       cioc      connect routine
 596 a.a008    ind       meterc
 597 *a.a009        unused
 598 a.a011    ind       suptab
 599 a.a012    ind       supend
 600           rem
 601           ttls      command and pcw lookup tables
 602           rem
 603           rem       command table
 604           rem
 605 cmdtab    null
 606           cmdtab    c.srec,c.on,tsfrcv
 607           cmdtab    c.rrec,c.off,tsfrcv
 608           cmdtab    c.sxmt,c.on,tsfxmt
 609           cmdtab    c.rxmt,c.off,tsfxmt
 610           cmdtab    c.sdtr,c.on,tsfdtr
 611           cmdtab    c.rdtr,c.off,tsfdtr
 612           cmdtab    c.ssup,c.on,tsfsxt
 613           cmdtab    c.rsup,c.off,tsfsxt
 614           cmdtab    c.stat,c.on,tsfst
 615           cmdtab    c.sbrk,c.on,tsfbrk
 616           cmdtab    c.smrk,c.on,tsfmrk
 617           cmdtab    c.strm,c.on,tsftrm
 618           cmdtab    c.srqs,c.on,tsfrts
 619           cmdtab    c.rrqs,c.off,tsfrts
 620 cmdend    equ       *
 621           rem
 622 suptab    null
 623           cmdtab    c.scrq,c.on,tsfcrq
 624           cmdtab    c.rcrq,c.off,tsfcrq
 625 supend    equ       *
 626           rem
 627 cmdlen    equ       2
 628           rem
 629 c.on      equ       0
 630 c.off     equ       1
 631           rem
 632           rem       pcw table
 633           rem
 634 pcwtab    null
 635           pcwtab    tsfrcv,pb.rcv
 636           pcwtab    tsfxmt,pb.xmt
 637           pcwtab    tsfdtr,pb.dtr
 638           pcwtab    tsfrts,pb.rts
 639           pcwtab    tsfsxt,pb.sxt
 640           pcwtab    tsfcrq,pb.crq
 641 pcwend    equ       *
 642           rem
 643 pcwlen    equ       2
 644           ttls      cmdprc - subr to process cmd op from list
 645 cmdprc    subr      cpr,(x1,x2)
 646           rem
 647 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 648 *
 649 *         cmdprc
 650 *
 651 *              this subroutine is internal proc for hdcw
 652 *         which processes type 1 and 5 dcw cmd blocks.
 653 *         it is list driven.
 654 *
 655 *         upon entry:
 656 *              x1 - virtual tib address
 657 *              cmdls - points to head of list
 658 *              cmdle - points to end of list
 659 *
 660 *         returns:
 661 *              tib flags set
 662 *
 663 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 664           rem
 665           ldx2      cmdls-*   get addr of command table
 666 cpr010    lda       0,3       pick up cmd bits
 667           ana       l.a009-*  leave only the cmd bits
 668           cana      0,2       is this cmd bit on in dcw?
 669           tze       cpr030-*  no, continue loop
 670           rem
 671           lda       0,2       look at function bit
 672           cana      l.a002-*  (=400000) is it on?
 673           tnz       cpr020-*  yes, we want to turn bit off in tib
 674           rem
 675           lda       1,2       pick up t.stat bits
 676           orsa      t.stat,1  and turn them on in the tib
 677           rem
 678           tra       cpr030-*  go look for more work
 679           rem
 680 cpr020    lda       1,2       get the correct bits
 681           ansa      t.stat,1  and turn them off in the tib
 682           rem
 683 cpr030    iacx2     cmdlen    increment table ptr
 684           cmpx2     cmdle-*   at the end of table?
 685           tnz       cpr010-*  nope, go for more
 686           rem
 687           aos       t.dcwa,1  increment dcw list addr
 688           ila       -1        and decrement the dcw list
 689           asa       t.dcwl,1  length word
 690           rem
 691           return    cmdprc
 692           rem
 693 cmdls     bss       1
 694 cmdle     bss       1
 695           ttls      bldobf - build output buffers from dcw list
 696 bldobf    subr      bob,(x1,x2,x3)
 697           rem
 698 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 699 *
 700 *         bldobf
 701 *
 702 *              subroutine to build output buffers from
 703 *         an output dcw. called by hdcw.
 704 *
 705 *         upon entry:
 706 *              x1 - virtual tib address
 707 *              t.dcwa - addr of output dcw
 708 *              t.dcwl - length of dcw list
 709 *
 710 *         returns:
 711 *              a pair of output buffers is ready to connect to.
 712 *
 713 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 714           rem
 715           lda       t.dcwl,1  is dcw list gone?
 716           tze       bobret-*  yes, exit
 717           rem
 718           ldx3      t.dcwa,1  get addr of first dcw
 719           lda       0,3       pick up that dcw
 720           arl       18-3      get the sub-op type
 721           icmpa     dl.out    is it output?
 722           tnz       bobret-*  no, exit
 723           rem
 724           tsy       a.a005-*,*          (=outprc) go process output subop
 725           rem
 726           ldx2      t.sfcm,1  get sfcm address
 727           lda       t.flg,1   check for output suspended
 728           cana      l.b007-*  =tfosus
 729           tnz       bobret-*  it is, wait for resume char
 730           tsy       a.a006-*,*          (=seticw) else set up the icw's
 731           rem
 732 bobret    return    bldobf    all done
 733           ttls      bldibf - build input buffers
 734 bldibf    subr      bib,(x1,x2,x3)
 735           rem
 736 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 737 *
 738 *         bldibf
 739 *
 740 *              this subroutine builds input buffers from dcw
 741 *         list. called by hdcw.
 742 *
 743 *         upon entry:
 744 *              x1 - virtual tib address
 745 *              t.dcwa - addr of dcw list
 746 *              t.dcwl - length of dcw list
 747 *
 748 *         returns:
 749 *              a pair of input buffers to connect to.
 750 *
 751 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 752           rem
 753           ldx2      t.sfcm,1  pick up sfcm addr
 754           ldx3      sf.hcm,2  pick up addr of hwcm
 755           rem
 756           iacx3     h.ric0    add in offset
 757           stx3      bibicw-*  save ptr to icw
 758           ldx3      t.sfcm,1  get ptr to sfcm again
 759           iacx3     sf.ib0    add in offset of ib1
 760           stx3      bibibp-*  and save taht too
 761           rem
 762           lda       sf.flg,2  get sfcm flags
 763           icana     sffcii    which icw is active?
 764           tze       bib010-*  primary, use it first
 765           rem
 766           ila       h.ric1-h.ric0       get diff
 767           asa       bibicw-*  add to save to get right one
 768           ila       sf.ib1-sf.ib0       get other diff
 769           asa       bibibp-*  and update ptr
 770           rem
 771 bib010    tsy       rboibf-*  setup old input buffer
 772           rem
 773           ila       sfhmk     pick up icw mask
 774           ersa      bibicw-*  switch icw ptr to alt
 775           ila       sfbfmk    pick up buffer mask
 776           ersa      bibibp-*
 777           rem
 778           lda       t.flg2,1  get tib flags
 779           cana      l.b015-*  (=tfcrcv) control rcv mode?
 780           tze       bib020-*  no, need another buffer
 781           rem
 782           stz       bibibp-*,*          zero input buffer ptr
 783           ldx3      bibicw-*  get icw addr
 784           lda       a.b009-*  (=bnispc) get addr of spare word
 785           ldq       l.b008-*  (=450000) get exhausted tally
 786           staq      0,3       set icw
 787           tra       bibret-*  done
 788           rem
 789 bib020    tsy       bnibuf-*  build a new input buffer
 790           rem
 791 bibret    return    bldibf    all done in here
 792           rem
 793           rem
 794           rem
 795 bibibp    bss       1         (altrd) ptr to sf.ib0/1
 796 bibicw    bss       1         (altrd) ptr to icw1/2
 797 bibcnt    bss       1         (altrd) count for cct copy
 798 bibabs    bss       1         (altrd) absolute ptr to reused buffer
 799 bibvir    bss       1         (altrd) virtual pointer to reused buffer
 800           rem
 801           rem
 802 l.b001    vfd       18/bufsmk buffer size code mask
 803 l.b002    zero      minsiz
 804 l.b003    vfd       18/sffsyn
 805 l.b004    vfd       18/tffrmi
 806 l.b005    zero      0,b.1
 807 l.b006    vfd       18/tfifc
 808 l.b007    vfd       18/tfosus
 809 l.b008    oct       450000
 810 l.b009    vfd       18/bfflst
 811 l.b010    ind       0,b.0
 812 l.b011    vfd       18/buftmk
 813           even
 814 *l.b012   unused
 815 l.b013    vfd       18/tfabf0
 816 l.b014    vfd       18/tfabf1
 817 l.b015    vfd       18/tfcrcv
 818 l.b016    vfd       18/tfmrcv
 819 l.b017    vfd       18/tffip
 820           rem
 821           rem
 822 a.b001    ind       getbfh
 823 a.b002    ind       setbpt
 824 a.b003    ind       bldicw
 825 a.b004    ind       .crpte
 826 *a.b005
 827 a.b006    ind       ghibuf
 828 *a.b007   unused
 829 *a.b008
 830 a.b009    ind       bnispc
 831           ttls      rboibf - rebuild old input buffer
 832 rboibf    subr      rbo,(x1)
 833           rem
 834 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 835 *
 836 *         rboibf
 837 *
 838 *              this routines checks for a partially filled
 839 *         input buffer. if one is found it is setup as the
 840 *         current input buffer, with correct icw and buffer
 841 *         tallies. if none is found bnibuf is called to allocate
 842 *         a fresh one.
 843 *
 844 *         upon entry:
 845 *              x1 - virtual tib address
 846 *              x2 - virtual sfcm address
 847 *              bibibp - ind word to sf.ib0/1
 848 *              bibicw - ind word to h.ric0/1
 849 *
 850 *         returns:
 851 *              icw and sf.ib0/1 setup
 852 *
 853 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 854           rem
 855           lda       sf.flg,2  synchronous line?
 856           cana      l.b003-*  =sffsyn
 857           tze       rbo050-*  no, don't reuse old buffer
 858           rem
 859           szn       t.icp,1   any input chain now?
 860           tze       rbo050-*  nope, no need to reuse any
 861           rem
 862           lda       t.ilst,1  get ptr to last buffer
 863           sta       bibabs-*
 864           tsy       a.b002-*,*          (setbpt) convert to virtual
 865           cax3
 866           lda       bf.tly,3  get tally
 867           ana       l.b011-*  (=buftmk) leave only tally
 868           sta       bibcnt-*  save it
 869           lda       bf.siz,3  get buffer size code
 870           arl       15        right adjust
 871           als       bufshf+1  convert to chars
 872           iaa       hbfnch    one buffer, less overhead
 873           cmpa      bibcnt-*  is buffer full (tally = size)?
 874           tze       rbo050-*  yes, can't add to it
 875           sta       rbotly-*  save max tally
 876           rem
 877           lda       t.flg2,1  get tib flags
 878           cana      l.b016-*  (=tfmrcv) message rcv mode ?
 879           tze       rbo005-*  no, continue
 880           lda       l.b009-*  (=bfflst)
 881           orsa      bf.flg,3  set buffer last flag
 882           tra       rbo050-*  get a shiny new buffer
 883           rem
 884 rbo005    stx3      bibvir-*  save buffer ptr
 885           lda       t.icp,1   get ptr to head of chain
 886           caq                 save it
 887           tsy       a.b002-*,*          setbpt
 888           cax3                get virtual address
 889           cmpq      bibabs-*  same as tail?
 890           tnz       rbo010-*  no
 891           rem
 892           stz       t.icp,1   zero all chain ptrs now
 893           stz       t.ilst,1
 894           tra       rbo030-*
 895           rem
 896 rbo010    lda       bf.nxt,3  get the next ptr
 897           cmpa      bibabs-*  does it point to last?
 898           tze       rbo020-*  yes, steal off chain
 899           lda       bf.nxt,3  bump to next on chain
 900           caq                 hang on to absolute address
 901           tsy       a.b002-*,*          setbpt
 902           cax3                get virtual in x3
 903           tra       rbo010-*  loop
 904           rem
 905 rbo020    stz       bf.nxt,3  clobber next pointer
 906           stq       t.ilst,1  make as new last
 907           rem
 908 rbo030    lda       bf.siz,3  get buffer size code
 909           arl       15        right adjust
 910           iera      -1        add one and negate
 911           asa       t.icpl,1  decrement chain length
 912           rem
 913           lda       bibabs-*  get ptr to buffer we will use
 914           sta       bibibp-*,*          put ptr into sfcm
 915           tsy       a.b002-*,*          setbpt
 916           cax3
 917           stz       bf.nxt,3  make next ptr zero
 918           lda       l.b001-*  get size code mask
 919           ansa      bf.tly,3  leave only size code
 920           lda       rbotly-*  get max tally
 921           orsa      bf.tly,3  put tally in buffer
 922           rem
 923           lda       bibcnt-*  get tally in buffer
 924           ars       1         divide to get word count
 925           ada       l.b010-*  (=0,b.0) add in addr bits
 926           iaa       bf.dta    add offset of data
 927           asa       bibvir-*  add into address of buffer
 928           lda       bibcnt-*  get tally again
 929           icana     1         is it odd?
 930           tze       rbo040-*  no
 931           rem
 932           ldx3      bibvir-*  get addr
 933           iacx3     0,b.1     bump up
 934           stx3      bibvir-*  put it back
 935 rbo040    lda       rbotly-*  get whole tally
 936           sba       bibcnt-*  leave icw tally
 937           caq                 put into q
 938           lda       bibvir-*  get virtual addr
 939           ldx3      bibicw-*  get ptr to icw
 940           tsy       a.b003-*,*          (bldicw) fill in icw now
 941           tra       rboret-*
 942           rem
 943 rbo050    null                no partial input buffer
 944           tsy       bnibuf-*  allocate a new one
 945           rem
 946 rboret    return    rboibf
 947           rem
 948 rbotly    bss       1
 949           ttls      bnibuf - build a new input buffer for the current icw
 950 bnibuf    subr      bni,(x1)
 951           rem
 952 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 953 *
 954 *         bnibuf
 955 *
 956 *              this routine allocates a new input buffer
 957 *         for the current icw and sets the tally.
 958 *
 959 *         upon entry:
 960 *              x1 - virtual tib address
 961 *              x2 - virtual sfcm address
 962 *              bibibp - ind word to sf.ib0/1
 963 *              bibicw - ind word to h.ric0/1
 964 *
 965 *         returns:
 966 *              icw and bf.tly setup
 967 *
 968 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 969           rem
 970           tsy       a.b006-*,*          (=ghibuf) get input buffer
 971           tra       2         error, no buffer
 972           tra       bni030-*  got buffer, continue
 973           rem
 974           rem                 failed to get buffer, best we can
 975           rem                 do now is to set exhaust bit in icw
 976           stz       bibibp-*,*          zero input buffer ptr
 977           ldx3      bibicw-*  get icw addr
 978           lda       a.b009-*  (=bnispc) get addr of spare word
 979           ldq       l.b008-*  (=450000) get exhausted tally
 980           staq      0,3       set icw
 981           tra       bniret-*  better luck next time
 982           rem
 983 bni030    szn       bibibp-*,*          be sure no old buffer left
 984           tze       2
 985           die       9
 986           rem
 987           sta       bibibp-*,*          store addr in sfcm ib1/2
 988           lda       sf.flg,2  synchronous line?
 989           cana      l.b003-*  =sffsyn
 990           tnz       bni040-*  yes, this buffer will go into an input chain
 991           cx3a                no, this is a "pseudo-buffer"
 992           ora       l.b005-*  (0,b.1) data starts in 2nd character
 993           tra       bni050-*
 994           rem
 995 bni040    iacx3     bf.dta    add in offset of start of data
 996           cx3a
 997           ora       l.b010-*  (=0,b.0) get the character addressing flags
 998           rem
 999 bni050    ldx3      bibicw-*  get ptr to icw
1000           tsy       bldicw-*  set it up
1001           lda       sf.flg,2  sync line?
1002           cana      l.b003-*  =sffsyn
1003           tze       bniret-*  no, don't bother with buffer size stuff
1004           ldq       sf.bsz,2  *get current buffer size
1005           tsy       cbufsz-*  *set sync prebuffer if needed
1006           rem
1007 bniret    return    bnibuf
1008           rem
1009 bnispc    bss       1         space to store char on tally runout
1010           ttls      bldicw - build a data icw
1011 **********************************************************************
1012 *
1013 *         bldicw: sets up a data icw for transfer to/from extended
1014 *         memory. translates an old-style 32k icw into extended form.
1015 *
1016 *         input:
1017 *            a  - character address (assumes buffer pte correct)
1018 *            q  - tally
1019 *            x3 - address of icw
1020 *
1021 *         output:
1022 *            an icw of the following form:
1023 *            word 0: 18-bit address
1024 *            word 1: bit 0 = 1
1025 *                    bit 1 = 0
1026 *                    bits 2-4: character addressing code
1027 *                    bit 5 = 0
1028 *                    bits 6-17 = tally
1029 *
1030 **********************************************************************
1031           rem
1032 bldicw    subr      bic,(inh,a,q)
1033           ana       l.v005-*  (o077777) get word part alone
1034           tsy       a.v003-*,*          (cvabs) convert to absolute
1035           sta       0,3       put it in icw
1036           lda       bicsa-*   get address back in a
1037           ana       l.v003-*  (o700000) get character code alone
1038           arl       2         move it to bits 2-4
1039           ora       l.v004-*  (o400000) get 18-bit address flag
1040           ora       bicsq-*   or in tally
1041           sta       1,3       this is second word
1042           return    bldicw
1043           ttls      cbufsz - change buffer size
1044 **********************************************************************
1045 *
1046 *         cbufsz - change buffer size in sfcm
1047 *
1048 *         this subroutine sets up the preallocated
1049 *         buffer chain queue for a given buffer size.
1050 *            q -- new size
1051 *           x1 -- tib address
1052 *
1053 *         written for icw switching problem by
1054 *                   D. W. Cousins on March 24,1981
1055 *
1056 ***********************************************************************
1057 cbufsz    subr      cbu,(x1,x2,x3)
1058           ldx2      t.sfcm,1  *load sfcm
1059           tze       cburet-*  *problem no sfcm
1060           cqa                 *set some indicators
1061           icmpa     32
1062           tmi       cbu010-*  *not if less then 32 words
1063           cmpa      l.v001-*  *(=401)check for max
1064           tmi       2         *within range
1065 cbu010    ldq       l.v002-*  *(=400)set to max
1066           stq       sf.bsz,2  *ok store it
1067           qrs       5         *set up table index
1068           iaq       -1        *
1069           cqa
1070           cax3
1071           ila       4
1072           sta       a.v001-*,*          *=pbfmax,3 set max buffer count
1073           tsy       a.v002-*,*          *=albchs
1074 cburet    return    cbufsz
1075 a.v001    ind       pbfmax,3  max buffer count for this pool
1076 a.v002    ind       albchs    allocated buffer check
1077 a.v003    ind       cvabs
1078           rem
1079 l.v001    oct       000401    max buffer + 1 in octal words
1080 l.v002    oct       000400    max in octal words for buffer
1081 l.v003    oct       700000
1082 l.v004    oct       400000
1083 l.v005    oct       077777
1084           ttls      ghibuf - get hsla input buffer
1085 ghibuf    subr      ghi
1086           rem
1087 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1088 *
1089 *         ghibuf
1090 *
1091 *         allocates an hsla input buffer of the proper size
1092 *
1093 *         upon entry:
1094 *              x1 - virtual tib address
1095 *              x2 - virtual sfcm address
1096 *
1097 *         return 1:
1098 *              no more buffers can/should be allocated
1099 *
1100 *         return 2:
1101 *              virtual buffer addr in x3, with size code and tally
1102 *               set up if appropriate
1103 *              absolute buffer address in a
1104 *              buffer tally in q
1105 *
1106 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1107           rem
1108           ilq       bufsiz    buffer size for control rcv mode
1109           lda       t.flg2,1  get tib flags
1110           cana      l.b015-*  control rcv mode?
1111           tnz       ghi025-*  yes
1112           rem
1113           ldq       sf.bsz,2  get regular buffer size
1114           cana      l.b016-*  (=tfmrcv) message rcv mode ?
1115           tnz       ghi015-*  yes, get size
1116           lda       sf.flg,2  synchronous line?
1117           cana      l.b003-*  =sffsyn
1118           tnz       ghi025-*  yes, use full size
1119           lda       t.flg2,1  no, are we in a frame?
1120           ldq       sf.fbs,2  if so, use frame buffer size
1121           cana      l.b017-*  =tffip
1122           tnz       ghi010-*  we are
1123           cana      l.b006-*  =tfifc
1124           tnz       ghi010-*  likewise if input flow control
1125           ldq       sf.bsz,2  but if in blk_xfer, use intermediate size
1126           cana      l.b004-*  =tffrmi
1127           tnz       ghi010-*  that's it
1128           ldq       l.b002-*  (=minsiz) else use minimum size
1129 ghi010    null                here to allocate asynchronous pseudo-buffer
1130           cmpq      l.b002-*  (=minsiz) is buffer nore than minimum size?
1131           tze       2         equal isn't larger
1132           tpl       ghi012-*  larger is
1133           lda       l.b013-*  (tfabf0) use one of the permanent ones
1134           cana      t.flg3,1  first one available?
1135           tze       ghi011-*  no, use second
1136           ldx3      t.abf0,1  yes, get it
1137           ersa      t.flg3,1  turn flag off
1138           tra       ghi01a-*
1139 ghi011    lda       l.b014-*  tfabf1
1140           cana      t.flg3,1  is other one available?
1141           tze       ghi012-*  no, we'll have to allocate
1142           ldx3      t.abf1,1  yes, get other permanent buffer
1143           ersa      t.flg3,1  mark it unavailable
1144 ghi01a    cx3a                convert address to virtual
1145           sta       ghiadr-*  butr save it first
1146           tsy       a.b002-*,*          setbpt
1147           cax3                back to x3
1148           ldq       0,3       get size (in upper half)
1149           qrl       8         convert to chars in lower half
1150           tra       ghi014-*
1151 ghi012    null                have to really allocate
1152           tsy       a.b001-*,*          getbfh
1153           tra       ghi040-*  couldn't get it
1154           sta       ghiadr-*  hang on to absolute address (virtual is in x3)
1155           cqa                 we have to store size in first char
1156           als       9
1157           sta       0,3
1158           stz       1,3       get rid of supposed size code
1159           stq       sf.csz,2  keep it here, too
1160           qls       1         convert to characters
1161 ghi014    lda       ghiadr-*  get address back
1162           iaq       -3        size char. and ***two*** extra char. at end
1163           aos       ghibuf-*  for successful return
1164           tra       ghiret-*  done
1165           rem
1166 ghi015    null                here for message receive mode
1167           szn       sf.mms,2  test max message size
1168           tze       ghi025-*  zero, ignore it
1169           rem
1170           lda       sf.rms,2  get residual message size
1171           tze       ghiret-*  zero, don't want buffer
1172           tmi       ghiret-*  negative, don't want buffer
1173           iaa       6         buffer overhead + round-up
1174           ars       1         convert to words
1175           sta       ghitmp-*  put in temporary
1176           cmpq      ghitmp-*  compare with buffer size
1177           tmi       ghi020-*  buffer size is smaller, use it
1178           caq                 use message size instead
1179           rem
1180 ghi020    tsy       a.z007-*,*          (=getbfh) get a buffer
1181           tra       ghi040-*  failed, make error return
1182           sta       ghiadr-*  succeeded, save absolute address
1183           rem
1184           qls       1         convert buffer size to characters
1185           iaq       -5        subtract overhead
1186           cqa                 move to a
1187           iera      -1        negate a
1188           iaa       1
1189           asa       sf.rms,2  decrement residual message size
1190           tra       ghi030-*  done
1191           rem
1192 ghi025    tsy       a.z007-*,*          (=getbfh) get a buffer
1193           tra       ghi040-*  failed, make error return
1194           sta       ghiadr-*  save absolute address
1195           rem
1196 ghi030    aos       ghibuf-*  setup normal return
1197           stz       bf.nxt,3  init the next ptr
1198           lda       bf.siz,3  get buffer size code
1199           arl       15        right adjust
1200           als       bufshf+1  convert to chars
1201           iaa       hbfnch    one buffer, less overhead
1202           orsa      bf.tly,3  put tally in buffer
1203           caq                 save tally in q
1204           lda       ghiadr-*  get absolute address back
1205           rem
1206 ghiret    return    ghibuf
1207           rem
1208 ghi040    null                allocation failed, meter it
1209           cmeter    mincs,m.inaf,l.z017-*
1210           tra       ghiret-*
1211           rem
1212 ghitmp    bss       1
1213 ghiadr    bss       1
1214           eject
1215           ttls      makcct - make cct based on modes
1216 ************************************************************************
1217 *
1218 *         subroutine to compute a cct for an ascii line.
1219 *         all modes (crecho,lfecho,tabecho,echoplex, etc.)
1220 *         are taken into account to compute the proper cct.
1221 *
1222 *         called with:
1223 *                   x1 - virtual tib address
1224 *
1225 ************************************************************************
1226           rem
1227 makcct    subr      mct,(x1,x2,x3,a,q)
1228           rem
1229 *         first, get memory for cct
1230           rem
1231           ilq       64        normal ones are 64 words
1232           stz       mctsbx-*  initialize indicator
1233           lda       t.flg2,1
1234           cana      l.z001-*  =tffrmi, check for blk_xfer mode
1235           tze       mct060-*  no
1236           lda       t.frmc,1  any framing chars?
1237           tze       mct060-*  no
1238           arl       9         is there a start char?
1239           tnz       mct059-*  yes
1240           aos       mctsbx-*  indicate single cct with block xfer
1241           tra       mct060-*
1242 mct059    iaq       64        must use double size
1243 mct060    stq       mctsz-*   remember size
1244           tsy       a.z001-*,*          =getmem
1245           die       9
1246           stx3      mctad-*   save address
1247           rem
1248 *         fill in default for all character positions.
1249 *         this is:
1250 *                   ct.ncs    for most modes
1251 *                   ct.mrk    for echoplex & breakall
1252           rem
1253           ldq       l.z002-*  =vfd 9/ct.ncs,9/ct.ncs
1254           szn       mctsbx-*  single cct with block xfer?
1255           tnz       mct005-*  yes, ignore other modes
1256           lda       t.flg,1
1257           cana      l.z003-*  =tfecpx, in echoplex mode?
1258           tze       2         no
1259           ldq       l.z004-*  =vfd 9/ct.mrk,9/ct.mrk use marker for echoplex
1260           lda       t.flg3,1
1261           cana      l.z005-*  =tfbral, in breakall mode
1262           tze       2         no
1263           ldq       l.z004-*  =vfd 9/ct.mrk,9/ct.mrk marker on all characters
1264 mct005    ila       64        store 64 copies
1265 mct010    stq       0,3
1266           iacx3     1
1267           iaa       -1
1268           tnz       mct010-*
1269           rem
1270 *         if double cct, second half is filled with
1271 *         ct.ncs + ct.tb1 (to stay in second cct when entered)
1272           rem
1273           lda       mctsz-*   get size
1274           icmpa     64
1275           tze       mct020-*  standard size
1276           ldq       l.z007-*  =vfd 9/ct.ncs+ct.tb1,9/ct.ncs+ct.tb1
1277           ila       64        store 64 copies
1278 mct030    stq       0,3
1279           iacx3     1
1280           iaa       -1
1281           tnz       mct030-*
1282           rem
1283 *         fill in special character codes
1284           rem
1285 mct020    ldx3      mctad-*   cct address
1286           szn       mctsbx-*  single cct with block xfer?
1287           tnz       mct055-*  yes, skip this stuff
1288           lda       t.flg3,1  check for breakall mode
1289           cana      l.z005-*  =tfbral
1290           tnz       mct050-*  skip for breakall mode,
1291           ila       nl        break on newline
1292           ilq       ct.mrk
1293           tsy       mctstr-*
1294           ila       ff        break on formfeed
1295           tsy       mctstr-*
1296           ila       etx       break on etx
1297           tsy       mctstr-*
1298           lda       t.flg,1   break on cr, if lfecho
1299           cana      l.z009-*  =tflfec
1300           tze       3
1301           ila       cr
1302           tsy       mctstr-*
1303           ilq       ct.mrk
1304           lda       t.flg,1   marker on tab, if tabecho
1305           cana      l.z008-*  =tftbec
1306           tze       3
1307           ila       tab
1308           tsy       mctstr-*
1309           rem
1310 *         fill in codes for blk_xfer mode
1311           rem
1312 mct050    lda       t.flg2,1
1313           cana      l.z001-*  =tffrmi
1314           tze       mct040-*
1315           lda       t.frmc,1  get framing chars
1316           tze       mct040-*  none, skip
1317           ilq       ct.tb1    switch to second cct
1318           ars       9         start char
1319           tsy       mctstr-*
1320           iacx3     64        switch to second cct
1321 mct055    lda       t.frmc,1  get framing chars
1322           ana       l.z010-*  =o777
1323           ilq       ct.mrk
1324           tsy       mctstr-*
1325           ldx3      mctad-*   get pointer to first cct back
1326 mct040    lda       t.flg2,1  check for input flow control
1327           cana      l.z006-*  =tfifc
1328           tze       mct080-*
1329           lda       t.ifch,1  yes
1330           arl       9         get suspend char
1331           tze       mct070-*  never mind, there is none
1332           ilq       ct.mrk    set marker for it
1333           tsy       mctstr-*
1334 mct070    lda       t.flg2,1  recover flag word
1335 mct080    cana      l.z015-*  (=tfofc) check output flow control
1336           tze       mct100-*
1337           cana      l.z016-*  (=tfblak) yes, block acknowledge also?
1338           tnz       mct090-*  yes, marker on ack char only
1339           lda       t.ofch,1  otherwise for both characters
1340           arl       9         get suspend char
1341           ilq       ct.mrk    marker in cct
1342           tsy       mctstr-*
1343 mct090    lda       t.ofch,1  nopw get resume char (or ack)
1344           ana       l.z010-*  =o777
1345           ilq       ct.mrk
1346           tsy       mctstr-*
1347           rem
1348 *         cct now ready, so store it
1349           rem
1350 mct100    ldx3      mctad-*   its address
1351           ldq       mctsz-*   its size
1352           tsy       shrcct-*
1353           tsy       a.z002-*,*          and release temp memory
1354           rem
1355           szn       mctsbx-*  single cct with block xfer?
1356           tze       mctret-*  no
1357           lda       l.z014-*  (=tffip) get frame in progress bit
1358           orsa      t.flg2,1  always on for this cct
1359           rem
1360 mctret    return    makcct
1361           rem
1362 mctsz     bss       1
1363 mctad     bss       1
1364 mctsbx    bss       1
1365           rem
1366           rem
1367 *         subroutine to store 1 cct character
1368           rem
1369 mctstr    subr      cst,(a,q)
1370           ars       1         get word offset
1371           stx3      csttmp-*  cct address
1372           ada       csttmp-*  word address
1373           ora       l.z011-*  =0,b.0 - make character addressing
1374           cax2
1375           lda       cstsa-*   get character again
1376           iana      1         isolate last bit
1377           tze       2         even
1378           iacx2     0,b.1     go to odd address
1379           stq       0,2,b.0   update cct
1380           return    mctstr
1381           rem
1382 csttmp    bss       1
1383           rem
1384 a.z001    ind       getmem
1385 a.z002    ind       fremem
1386 a.z003    ind       .crcct
1387 a.z004    ind       getbuf
1388 a.z005    ind       frebuf
1389 a.z006    ind       makcct
1390 a.z007    ind       getbfh
1391           rem
1392 l.z001    vfd       o18/tffrmi
1393 l.z002    vfd       9/ct.ncs,9/ct.ncs
1394 l.z003    vfd       o18/tfecpx
1395 l.z004    vfd       9/ct.mrk,9/ct.mrk
1396 l.z005    vfd       o18/tfbral
1397 l.z006    vfd       o18/tfifc
1398 l.z007    vfd       9/ct.ncs+ct.tb1,9/ct.ncs+ct.tb1
1399 l.z008    vfd       o18/tftbec
1400 l.z009    vfd       o18/tflfec
1401 l.z010    oct       777
1402 l.z011    ind       0,b.0
1403 l.z012    vfd       o18/sffdct
1404 l.z013    vfd       o18/sffsct
1405 l.z014    vfd       o18/tffip
1406 l.z015    vfd       o18/tfofc
1407 l.z016    vfd       o18/tfblak
1408 l.z017    dec       1
1409           eject
1410           ttls shrcct - subroutine to share and store ccts
1411 ************************************************************************
1412 *
1413 *         subroutine to store and share ccts
1414 *
1415 *         it is called with:
1416 *                   x3 -> cct
1417 *                   q = size (0 for no new cct)
1418 *
1419 *         the channel is update to use this cct, freeing the old cct
1420 *         if necessary. The new cct is shared with an existing cct if possible.
1421 *
1422 ************************************************************************
1423           rem
1424 shrcct    subr      sct,(a,q,x1,x2,x3)
1425           rem
1426 *         first, find the length of the cct. if the length is given
1427 *         as 64, check to see if a short cct can be used
1428           rem
1429           stq       sctsz-*   size as given
1430           cqa
1431           tze       sct010-*  no new cct
1432           icmpa     64        single cct?
1433           tnz       sct020-*  no, cant use short cct
1434           iaa       -16       check 64-16 words
1435           ldq       l.z002-*  =vfd 9/ct.ncs,9/ct.ncs
1436 sct030    cmpq      16,3      check all cct words
1437           tnz       sct020-*  cant use short cct
1438           iacx3     1
1439           iaa       -1
1440           tnz       sct030-*  loop
1441           ila       16        test passes - use short cct
1442           sta       sctsz-*
1443           rem
1444 *         now try to locate an existing cct that matches the new one
1445           rem
1446 sct020    stz       sctnds-*  pointer to new descriptor
1447           ldx1      a.z003-*,*          addr of first descriptor
1448           tze       sct010-*  none, no existing cct to share
1449 sct060    lda       sctsz-*   size of new cct
1450           cmpa      cct.sz,1  match against existing cct
1451           tnz       sct040-*  sizes dont match, skip word check
1452           ldx2      sctsx3-*  addr of callers cct
1453           ldx3      cct.ad,1  address of existing cct
1454 sct050    ldq       0,2       word to compare
1455           cmpq      0,3
1456           tnz       sct040-*  no match
1457           iacx2     1
1458           iacx3     1
1459           iaa       -1
1460           tnz       sct050-*
1461           stx1      sctnds-*  found matching cct in use
1462           lda       cct.ad,1  address of good cct
1463           ldx1      sctsx1-*  get tib address
1464           ldx2      t.sfcm,1
1465           cmpa      sf.cct,2  is this the cct already in use?
1466           tze       sctret-*  yes, all done
1467           tra       sct010-*
1468 sct040    ldx1      cct.nx,1  step to next cct descriptor
1469           tnz       sct060-*
1470           rem
1471 *         locate old cct descriptor and decrement usage
1472           rem
1473 sct010    stz       sctods-*  pointer to old descriptor
1474           ldx1      sctsx1-*  get tib address
1475           ldx2      t.sfcm,1
1476           lda       sf.flg,2
1477           cana      l.z012-*  =sffdct, useing dynamic cct?
1478           tze       sct070-*  no old cct to locate
1479           ldx1      a.z003-*,*          =.crcct
1480 sct090    tnz       2
1481           die       6         cant find cct descriptor
1482           ldx3      cct.ad,1  cct pointed to by this descrip
1483           cmpx3     sf.cct,2  this channels cct?
1484           tze       sct080-*  yes
1485           ldx1      cct.nx,1  keep looking
1486           tra       sct090-*
1487 sct080    stx1      sctods-*  save address
1488           rem
1489 *         setup descriptor for new cct if needed
1490           rem
1491 sct070    szn       sctsz-*   is there new cct?
1492           tnz       sct160-*  yes
1493           ila       0         addr of no cct
1494           ilq       0         not short flag
1495           tra       sct110-*
1496 sct160    ldx1      sctnds-*  new descriptor address
1497           tnz       sct170-*  all setup already
1498           ilq       cct.ln    allocate space for new descriptor
1499           tsy       a.z001-*,*          =getmem
1500           die       9
1501           stx3      sctnds-*
1502           ldx1      sctnds-*
1503           ldx3      a.z003-*,*          =.crcct, addr of first cct desc
1504           tze       2         new one is only desc
1505           stx1      cct.pr,3  make second desc point at first
1506           stx1      a.z003-*,*          new desc to head of chain
1507           stx3      cct.nx,1  make first point to second
1508           stz       cct.pr,1  no previous pointer
1509           rem
1510 *         allocate memory for new cct and copy it. memory must be 64-word aligned
1511           rem
1512           ldq       sctsq-*   origional size
1513           iaq       32        allocate extra 32 words to force alignment
1514           tsy       a.z004-*,*          =getbuf
1515           die       9
1516           cx3a                allocate address?
1517           icana     =o77      on 64-word boundry?
1518           tze       sct120-*  yes
1519           iaa       32        this will get to 64-word boundry
1520           sta       cct.ad,1  for the real cct
1521           tra       sct130-*
1522 sct120    sta       cct.ad,1  allocated address is aligned ok
1523           adcx3     sctsq-*   get addr of 32 words at end to free
1524 sct130    ilq       32        free the extra 32 words
1525           tsy       a.z005-*,*          =frebuf
1526           lda       sctsz-*   set size
1527           sta       cct.sz,1
1528           icmpa     16        is this 16 word cct
1529           tnz       sct140-*  no
1530           ldx3      cct.ad,1  can free last 32 words of 64 word buffer
1531           iacx3     32
1532           ilq       32
1533           tsy       a.z005-*,*          =frebuf
1534 sct140    ldx2      cct.ad,1  setup to copy cct
1535           ldx3      sctsx3-*
1536           lda       cct.sz,1
1537 sct150    ldq       0,3       copy loop
1538           stq       0,2
1539           iacx2     1
1540           iacx3     1
1541           iaa       -1
1542           tnz       sct150-*
1543           stz       cct.rc,1  zero reference count
1544 sct170    aos       cct.rc,1  new user of this cct
1545           ilq       0         flag meaning not short cct
1546           lda       cct.sz,1
1547           icmpa     16
1548           tnz       2
1549           ilq       1         it is short cct
1550           lda       cct.ad,1  address of cct
1551           rem
1552 *         make channel use the new cct (it maybe 0)
1553 *         a -> cct, q = short cct switch
1554 *         a descriptor cannot be referenced here (there may not be one)
1555           rem
1556 sct110    ldx1      sctsx1-*  tib address
1557           ldx2      t.sfcm,1
1558           sta       sf.cct,2  record cct address
1559           lda       l.z012-*  =sffdct, dynamic cct bit
1560           szn       sf.cct,2  is there cct
1561           tnz       2
1562           ila       0         reset bit
1563           era       sf.flg,2  get bit into word
1564           ana       l.z012-*  =sffdct
1565           ersa      sf.flg,2
1566           lda       l.z013-*  short cct bit
1567           iaq       0         test flag, is it short?
1568           tnz       2
1569           ila       0         not short
1570           era       sf.flg,2  store in flag word
1571           ana       l.z013-*  =sffsct
1572           ersa      sf.flg,2
1573           ldx3      sf.hcm,2  update hardware comm region too
1574           lda       sf.cct,2
1575           als       3
1576           iaq       0         short cct?
1577           tze       2         no
1578           iora      =o100     set short flag
1579           sta       h.baw,3   this effects he change officially
1580           rem
1581 *         all done with old cct for this line, free it if last user
1582           rem
1583           ldx1      sctods-*  old descriptor address
1584           tze       sctret-*  no old one
1585           ila       -1        decrement usage count
1586           asa       cct.rc,1
1587           tnz       sctret-*  no
1588           ldq       cct.sz,1  free the cct first
1589           ldx3      cct.ad,1
1590           tsy       a.z005-*,*          =frebuf
1591           ldx2      cct.pr,1  unthread descriptor
1592           ldx3      cct.nx,1
1593           tze       2
1594           stx2      cct.pr,3  make next point to previous
1595           iacx2     0         is there a previous?
1596           tze       3         no
1597           stx3      cct.nx,2  make prev point at next
1598           tra       2
1599           stx3      a.z003-*,*          =.crcct, make next first
1600           cx1a                free descriptor
1601           cax3
1602           ilq       cct.ln
1603           tsy       a.z002-*,*          =fremem
1604           rem
1605 sctret    return    shrcct
1606           rem
1607 sctsz     bss       1         size of cct
1608 sctods    bss       1         old descriptor address
1609 sctnds    bss       1         new descriptor address
1610           ttls      setcct - implements the setcct opblock
1611           rem
1612 ************************************************************************
1613 *
1614 *         subroutine use by the interpreter when it encounters a setcct opblock
1615 *
1616 *         x1 - virtual tib address
1617 *         a  =  arg to opblock
1618 *
1619 ************************************************************************
1620           rem
1621 setcct    subr      cct,(a,q,x2,x3)
1622           rem
1623           ldx2      t.sfcm,1
1624           ldx3      sf.hcm,2
1625           rem
1626           icmpa     scc.dl    delete cct?
1627           tze       cct010-*
1628           icmpa     scc.df    set default cct?
1629           tze       cct020-*
1630           icmpa     scc.bs    set to base of cct?
1631           tze       cct030-*
1632           rem
1633 *         argument is real cct address
1634           rem
1635           ilq       0         release dynamic cct, if any
1636           tsy       shrcct-*
1637           sta       sf.cct,2
1638           als       3         align for baw
1639           sta       h.baw,3
1640           tra       cctret-*
1641           rem
1642 *         process various coded requests
1643           rem
1644 cct010    ilq       0         delete current cct
1645           tsy       shrcct-*
1646           tra       cctret-*
1647 cct020    tsy       a.z006-*,*          build cct from modes
1648           tra       cctret-*
1649 cct030    ldq       sf.cct,2  set to base cct
1650           qls       3
1651           lda       sf.flg,2  get flags
1652           cana      l.z013-*  =sffsct, short cct?
1653           tze       2         no
1654           iaq       =o100     short cct bit for h.baw
1655           stq       h.baw,3
1656           rem
1657 cctret    return    setcct
1658           ttls      hbreak - entry point to change break list
1659 * hbreak  subr      brk,(x1,x3)
1660           rem
1661 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1662 *
1663 *         hbreak
1664 *
1665 *              entry to change the break list. causes
1666 *         hsla_man to build a new cct for the line.
1667 *
1668 *         upon entry:
1669 *              x1 - virtual tib address
1670 *              x3 - points to change break command data
1671 *
1672 *         returns:
1673 *
1674 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1675           rem
1676           rem
1677 *         well that is all for now
1678           rem
1679 *         return    hbreak
1680           ttls      hgeti - entry to collect input from current buffer
1681 hgeti     subr      hgi,(x2,x3)
1682           rem
1683 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1684 *
1685 *         hgeti
1686 *
1687 *         obtains a ptr to the unscanned portion of the current input buffer
1688 *         (if any)
1689 *         and the number of unscanned characters in the buffer.
1690 *
1691 *         upon entry:
1692 *              x1 - virtual tib address
1693 *              x3 - points to 2 words (returned)
1694 *
1695 *         returns:
1696 *              x3 -> 1st: virtual ptr to first unscanned character of buffer
1697 *                      2nd: tally
1698 *                      buffer page table entry set up
1699 *
1700 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1701           rem
1702           ldx2      t.sfcm,1  get virtual sfcm addr
1703           tsy       gettly-*  get current buffer addr & tally
1704           iaa       0         is there a buffer at all?
1705           tze       hgi020-*  no, done
1706           szn       sf.nic,2  any scanning done in this buffer?
1707           tze       hgi020-*  no, use as is
1708           sta       hgitly-*  save buffer tally temporarily
1709           cmpx3     sf.nic,2  scan pointer at beginning?
1710           tze       hgi010-*  yes, nothing new
1711           cx3a                convert current buffer pointer to word addr
1712           ana       l.r007-*  =o077777
1713           sta       hgibp-*   save
1714           lda       sf.nic,2  get scan pointer
1715           ana       l.r007-*  (=o077777) convert to word address
1716           sba       hgibp-*   number of words already scanned
1717           caq
1718           qls       1         convert to characters
1719           cx3a                started at odd character?
1720           cana      l.r008-*  =o100000
1721           tze       2         no
1722           iaq       -1        yes, one character less
1723           lda       sf.nic,2  stopped at odd character?
1724           cana      l.r008-*  =o100000
1725           tze       2         no
1726           iaq       1         yes, one character more
1727           ldx3      sf.nic,2  point to first unscanned char
1728           lda       hgitly-*  get original tally
1729           stq       hgitly-*  this is number already scanned
1730           sba       hgitly-*  result is number remaining
1731           tze       hgi010-*  none
1732           tpl       hgi020-*  negative would mean none
1733 hgi010    ila       0         return zero tally
1734           cax3                and zero buffer address
1735 hgi020    stx3      hgisx3-*,*          return buffer addr
1736           ldx3      hgisx3-*  restore x3
1737           sta       1,3       return tally
1738           rem
1739           return    hgeti
1740           rem
1741 hgitly    bss       1
1742 hgibp     bss       1
1743           ttls      gettly - get the addr and tally of the current input buffer
1744 gettly    subr      gtl,(x2,inh)
1745           rem
1746 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1747 *
1748 *         gettly
1749 *
1750 *         computes the tally of, i.e. the number of chars in,
1751 *         the current input buffer.  if the buffer is active
1752 *         (icw active), the tally is given by the difference
1753 *         between the max buffer tally and the icw tally.
1754 *         if not active, the tally is given by the tally
1755 *         field of the buffer.
1756 *
1757 *         upon entry:
1758 *              x1 - virtual tib address
1759 *
1760 *         returns:
1761 *              x3 - points to first char. current buffer (or zero if none)
1762 *               a - contains buffer tally (or zero if none)
1763 *
1764 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1765           rem
1766           ldx2      t.sfcm,1  get virtual sfcm address
1767           lda       sf.flg,2  get sfcm flags
1768           ldq       sf.ib0,2  get primary buffer addr
1769           icana     sffcii    alt buffer in use
1770           tze       2         no
1771           ldq       sf.ib1,2  get alt buffer addr
1772           rem
1773           iaq       0         do we have a buffer ?
1774           tnz       gtl010-*  yes, continue
1775           ila       0         return zero tally
1776           cax3                return zero buffer addr
1777           tra       gtlret-*
1778           rem
1779 gtl010    ldx3      sf.hcm,2  get hwcm addr
1780           iacx3     h.ric0    get primary rcv icw addr
1781           icana     sffcii    alt icw active ?
1782           tze       2         no
1783           iacx3     h.ric1-h.ric0       get alt rcv icw addr
1784           rem
1785           cqa                 move buffer addr to a
1786           tsy       a.r001-*,*          setbpt
1787           ldq       1,3       get icw tally
1788           cax3                move (virtual) buffer addr to x3
1789           lda       sf.flg,2  synchronous line?
1790           cana      l.r004-*  =sffsyn
1791           tnz       gtl020-*  yes, regular buffer
1792           cx3a                no, point to second char. of block
1793           ada       l.r006-*  0,b.1
1794           cax3
1795           lda       -1,3,b.1  pick up size from first char.
1796           als       1         convert to chars (allow for ***two*** at end)
1797           iaa       -3        a now contains max. tally
1798           tra       gtl030-*
1799           rem
1800 gtl020    null
1801           lda       bf.tly,3  get buffer tally word
1802           ana       l.r001-*  (=buftmk) leave only tally
1803           sta       gtltmp-*  hang on to max. tally
1804           cx3a                update pointer to first data char.
1805           ada       l.r005-*  =bf.dta,b.0
1806           cax3                back to x3
1807           lda       gtltmp-*  restore tally
1808           rem
1809 gtl030    null
1810           qls       5         get rid of character addressing bits
1811           qrl       5
1812           cmpq      l.r002-*  (=010000) icw tally exhausted ?
1813           tze       gtlret-*  yes, done
1814           rem
1815           stq       gtltmp-*  put icw tally in temp
1816           sba       gtltmp-*  subtract from max buffer tally
1817           rem
1818 gtlret    return    gettly
1819           rem
1820 gtltmp    bss       1
1821           rem
1822 a.r001    ind       setbpt
1823           rem
1824 l.r001    vfd       18/buftmk
1825 l.r002    oct       010000
1826 l.r003    vfd       o18/777000
1827 l.r004    vfd       18/sffsyn
1828 l.r005    zero      bf.dta,b.0
1829 l.r006    zero      0,b.1
1830 l.r007    oct       077777
1831 l.r008    oct       100000
1832           ttls      hcfg - entry point to change configuration of channel
1833 hcfg      subr      cfg,(x1,x2,x3)
1834           rem
1835 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1836 *
1837 *         hcfg
1838 *
1839 *              entry to change to the configuration of the channel
1840 *         the current config pcw (stored in the sfcm at sf.cfg) is
1841 *         is modified according to the sub-op's in the config list
1842 *         and a pcw type 2 is issued, the new current config pcw
1843 *         is stored in the sfcm.
1844 *
1845 *         upon entry:
1846 *              x1 - virtual tib address
1847 *              x2 - points to first config sub-op
1848 *
1849 *         returns:
1850 *             x2 - points to opblock after sub-ops
1851 *
1852 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
1853           rem
1854           ldx2      t.sfcm,1  get addr of sfcm
1855           ldaq      sf.cfg,2  get current config pcw
1856           staq      newcfg-*  newcfg will be modified
1857           ldx3      cfgsx2-*  get address of first sub-op
1858           rem
1859 cfg010    null                start of sub-op decoding loop
1860           lda       0,3       pick up sub-op
1861           ana       l.r003-*  =777000
1862           cmpa      l.r003-*  is this opblock, not a sub-op
1863           tze       cfg070-*  yes, done
1864           ila       0         zero a
1865           ldq       0,3       get sub-op
1866           lls       3         isolate sub-op code in a
1867           qrl       3         right justify sub-op data
1868           icmpa     fg.bd     changing the baud rate?
1869           tze       cfg050-*  go process baud sub-op
1870           rem
1871           rem                 mode sub-op (smode or rmode)
1872           rem                 find specified entry in cfgtab
1873           llr       18        swap a and q
1874           rem                 sub-op code is in q
1875           rem                 sub-op data is in a
1876           sta       cfgsub-*
1877 cfg019    ldx2      a.q001-*  get addr of config table (=cfgtab)
1878 cfg020    cana      0,2       compare sub-op data with cfgtab entry
1879           tze       cfg041-*  tra if desired bit not set
1880           lda       0,2       bit that just matched
1881           era       l.q002-*  (=777777) invert all bits
1882           ansa      cfgsub-*  turn off in arg - this bit done
1883           rem
1884           szn       3,2       check for subr
1885           tze       2         skip if no subr
1886           tsy       3,2*      call subr (subr must maintain x1, x2,
1887           rem                 x3, and q)
1888           rem
1889           lda       1,2       get first word of pcw mask
1890           cmpq      l.q001-*  check for rmode
1891           tnz       cfg030-*  transfer if smode
1892           rem
1893           rem                 reset a mode bit
1894           era       l.q002-*  invert the bits
1895           ansa      newcfg-*  reset the bit
1896           lda       2,2       get 2nd word of mask
1897           era       l.q002-*
1898           ansa      newcfg-*+1
1899           tra       cfg040-*
1900           rem
1901 cfg030    null                set a mode bit
1902           orsa      newcfg-*  set the bit in the new config pcw
1903           lda       2,2
1904           orsa      newcfg-*+1
1905           rem
1906 cfg040    null
1907           lda       cfgsub-*
1908           tze       cfg060-*  all bits processed
1909           tra       cfg019-*  back to next bit
1910           rem
1911 cfg041    iacx2     cfglen    next cfgtab entry
1912           cmpx2     a.q002-*  end of table?
1913           tnz       cfg020-*  nope, try again
1914           tra       cfg060-*  next config list entry
1915           rem
1916 cfg050    null                change baud rate
1917           qls       0         baud rate given?
1918           tnz       2         yes
1919           ldq       t.cntr,1  if not in control table, it is here
1920           ldx2      a.q004-*  (=cfgbds) addr of baud table
1921 cfg052    cmpq      0,2       does it match baud given
1922           tze       cfg051-*  yes
1923           iacx2     1         step to next entry
1924           cmpx2     a.q005-*  (cfgbds+cfgbdl) at end of table?
1925           tnz       cfg052-*  no
1926           die       2
1927           rem
1928 cfg051    stz       cfgsvf-*  this will be setting of ebcdic bit in sfcm
1929           cmpq      bd133-*   setting to 133 baud?
1930           tnz       cfg053-*  no
1931           lda       l.q010-*  (=sffebd) ebcdic bit for sfcm
1932           sta       cfgsvf-*
1933 cfg053    lda       l.q003-*  mask for pcw baud bits
1934           ansa      newcfg-*+1          turn off current bits
1935           lda       cfgflg-cfgbds,2     get pcw bits to set baud rate
1936           orsa      newcfg-*+1          and store in pcw
1937           stx2      cfgtmp-*  save baud table index
1938           ldx2      t.sfcm,1  get addr of sfcm from tib
1939           lda       l.q011-*  (=^sffebd)
1940           ansa      sf.flg,2  turn off ebcdic bit
1941           lda       cfgsvf-*  get new value
1942           orsa      sf.flg,2  and set it
1943           ldx2      sf.hsl,2  get hsla table addr from sfcm
1944           lda       l.q008-*  mask to turn off speed field
1945           ansa      ht.flg,2
1946           lda       cfgtmp-*  retreive baud table index
1947           sba       a.q004-*  get offset in table
1948           iaa       1         this gives final baud index
1949           orsa      ht.flg,2  save in hsla table
1950           rem
1951           rem                 check that pcw is type 2
1952           lda       newcfg-*
1953           ana       l.q006-*  zero all but pcw type code
1954           cmpa      l.q007-*  check for right type
1955           tze       cfg060-*
1956           die       2
1957           rem
1958 cfg060    null
1959           iacx3     1         next entry in config list
1960           tra       cfg010-*  go back for another entry
1961           rem
1962 cfg070    stx3      cfgsx2-*  all done, return bumbed addr to caller
1963           ldx2      t.sfcm,1  get sfcm addr again
1964           rem
1965           ldaq      newcfg-*  get new config pcw
1966           staq      sf.cfg,2  save it in sfcm
1967           rem
1968           rem                 now select channel and do cioc
1969           rem
1970           tsy       sndcfg-*
1971           return    hcfg      done
1972           rem
1973           even
1974 newcfg    bss       2         (altrd) pcw temp for new config pcw
1975 cfgsub    bss       1         (altrd) copy of sub-op data
1976 cfgtmp    bss       1
1977 cfgsvf    bss       1
1978           rem
1979 a.q001    ind       cfgtab
1980 a.q002    ind       cfgend
1981 a.q003    ind       cioc
1982 a.q004    ind       cfgbds
1983 a.q005    ind       cfgbds+cfgbdl
1984           rem
1985 l.q001    vfd       18/fg.rmd
1986 l.q002    vfd       o18/777777
1987 l.q003    vfd       o18/777400          mask to zero baud bits
1988 l.q004    sel       *-*       template select instruction
1989 l.q005    vfd       18/p.ssiw
1990 l.q006    vfd       o18/600000
1991 l.q007    vfd       o18/pcw.2
1992 l.q008    vfd       o18//htfspd
1993 l.q009    vfd       o18//p2.mbt
1994 l.q010    vfd       o18/sffebd
1995 l.q011    vfd       o18//sffebd
1996           rem
1997 cfgbds    dec       75        tables of bauds that can be configured
1998           dec       110
1999 bd133     dec       133
2000           dec       150
2001           dec       300
2002           dec       600
2003           dec       1050      shouldn't be here but dia_man understands
2004           dec       1200
2005           dec       1800
2006           dec       2400
2007           dec       4800
2008           dec       7200      filler to index into baud_rates properly
2009           dec       9600
2010 cfgbdl    equ       *-cfgbds
2011           rem                 pcw bits to set each baud
2012 cfgflg    oct       021         75 baud
2013           oct       200        110 baud
2014           oct       100        133 baud
2015           oct       040        150 baud
2016           oct       020        300 baud
2017           oct       161        600 baud
2018           oct       010       1050 baud
2019           oct       004       1200 baud
2020           oct       002       1800 baud
2021           oct       301       2400 baud
2022           oct       321       4800 baud
2023           oct       000       7200 baud (for indexing into baud_rates)
2024           oct       341       9600 baud
2025           rem
2026           ttls      config mode bits lookup table
2027 cfgtab    null
2028           cfgtab    fg.icw,p2.icw,0,cfgicw icw bit is in first word of pcw
2029           cfgtab    fg.lpr,p2.lpr,0,0
2030           cfgtab    fg.lps,p2.lps,0,0
2031           cfgtab    fg.lpo,p2.lpo,0,0
2032           cfgtab    fg.5bt,p2.5bt,0,cfgrsc
2033           cfgtab    fg.6bt,p2.6bt,0,cfgrsc
2034           cfgtab    fg.7bt,p2.7bt,0,cfgrsc
2035           cfgtab    fg.8bt,p2.8bt,0,cfgrsc
2036           cfgtab    fg.beb,0,p3.beb,0
2037           cfgtab    fg.btr,0,p3.btr,0
2038           cfgtab    fg.cct,p2.cct,0,0
2039 cfgend    equ       *
2040           rem
2041 cfglen    equ       4
2042           rem
2043 cfgicw    subr      icw
2044           rem
2045           rem       this subroutine is called when the number
2046           rem       of send icw's is being changed.
2047           rem       we always make sure that the channel is set to
2048           rem       use the primary send icw.
2049           rem
2050           lda       sf.flg,2  get tib flags
2051           icana     sffcoi    are we currently using alternate?
2052           tze       icwbak-*  transfer if not
2053           rem
2054           lda       l.q005-*  switch send icw pcw op-code
2055           tsy       a.q003-*,*          (=cioc) do a connect
2056 icwbak    null
2057           return    cfgicw    done
2058           rem
2059 *         subroutine to turn off the character size field in the pcw
2060           rem
2061 cfgrsc    subr      rsc
2062           lda       l.q009-*  (=^p2.mbt)
2063           ansa      newcfg-*
2064           return    cfgrsc
2065           rem
2066 *         subroutine to send the config pcw
2067           rem
2068 sndcfg    subr      snd,(x1,x2,x3)
2069           lda       t.line,1  get line no
2070           ars       6
2071           iana      7         turn off "is_hsla" bit
2072           iaa       h1ch      add in base hsla chan no to
2073           rem                 get iom chan no 6, 7, or 8
2074           ora       l.q004-*  (=sel 0) or in sel instruction
2075           sta       1         make a the next instruction
2076           sel       *-*       (patched) select correct channel
2077           rem
2078           ldx3      sf.hsl,2  get pointer to hsla table entry
2079           ldx3      ht.tib,3  get real tib address for trace
2080           trace     tt.pcw,ts.pcw,(x3,newcfg,newcfg+1)
2081           rem
2082           cioc      sf.cfg,2  hit the channel with the pcw
2083           return    sndcfg
2084           ttls      hmode - entry point to change modes
2085 hmode     subr      mod,(x1,x2,x3)
2086           rem
2087 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2088 *
2089 *         hmode
2090 *
2091 *              entry to notify us that certain mode bits
2092 *         have been changed, including those having to do
2093 *         with echoing, flow control, or parity.
2094 *
2095 *         upon entry:
2096 *              x1 - virtual tib address
2097 *
2098 *         returns:
2099 *
2100 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2101           rem
2102           ldx2      t.sfcm,1  get virtual sfcm address
2103           tze       modret-*  no sfcm, forget it
2104           lda       sf.flg,2  check for ebcd type
2105           cana      l.p013-*  =sffebd
2106           tnz       2         don't touch cct if it is
2107           tsy       a.p001-*,*          =makcct, select proper cct
2108           rem
2109           lda       t.flg2,1  find out if entered or left framei
2110           ana       l.p001-*  isolate tffrmi
2111           era       sf.flg,2  compare it against sffofr (same bit position)
2112           ana       l.p001-*  isolate relevant bit
2113           tze       mod010-*  not changed
2114           ersa      sf.flg,2  it is, change it in sfcm
2115           lda       l.p006-*  =sffnib
2116           orsa      sf.flg,2  we'll need a new input buffer
2117           rem
2118           lda       t.flg2,1  get tib flags
2119           cana      l.p001-*  (=tffrmi) frame input mode ?
2120           tnz       mod010-*  yes
2121           lda       l.p005-*  (=/tffip) cannot be frame in progress
2122           ansa      t.flg2,1  so turn off tffip
2123           rem
2124 mod010    lda       t.flg2,1  check for input flow control
2125           cana      l.p007-*  =tfifc
2126           tze       mod020-*  no
2127           lda       l.p006-*  =sffnib
2128           orsa      sf.flg,2  yes, we'll need a new input buffer
2129 mod020    lda       l.p012-*  p2.lps, on initially
2130           sta       tstcfg-*  we're going to see if we have to
2131           lda       t.flg3,1  change parity configuration
2132           ana       l.p008-*  tfoddp
2133           arl       lposhf    line it up on p2.lpo
2134           orsa      tstcfg-*  if on in tib, on in pcw
2135           lda       t.flg3,1  get flags again
2136           ana       l.p009-*  =tf8out
2137           arl       lpsshf    line it up on p2.lps
2138           ersa      tstcfg-*  on in tib => off in pcw, and vice versa
2139           lda       sf.cfg,2
2140           ana       l.p010-*  p2.lpo+p2.lps
2141           cmpa      tstcfg-*  have we changed either of these bits?
2142           tze       mod030-*  no, don't bother with new pcw
2143           lda       l.p011-*  ^(p2.lpo+p2.lps)
2144           ansa      sf.cfg,2  turn them off so we can start clean
2145           lda       tstcfg-*  get new values
2146           orsa      sf.cfg,2
2147           tsy       sndcfg-*  now set the pcw
2148           rem
2149 mod030    lda       t.flg2,1  check if we left oflow with output suspended
2150           cana      l.p020-*  =tfofc
2151           tnz       mod040-*  mode is on, never mind
2152           lda       t.flg,1   is output suspended now?
2153           cana      l.p021-*  =tfosus
2154           tze       mod040-*  no, no problem
2155           tsy       a.p012-*,*          (resout) yes, resume it
2156           rem
2157 mod040    lda       t.flg,1   get the tib flags
2158           cana      l.p002-*  (=tfcrec+lfec+tbec+ecpx) any echoing modes on?
2159           tze       modret-*
2160           rem
2161           szn       t.echo,1  is there an echo buffer?
2162           tnz       modret-*  yes, done
2163           rem
2164           ilq       bufsiz    allocate a buffer
2165           tsy       a.p002-*,*          (=getbfh)
2166           tra       modret-*  if couldn't get it, tough
2167           rem
2168           sta       t.echo,1  set absolute ptr to echo buffer
2169           cx3a                put virtual addr into a
2170           ada       l.p003-*  (=eb.dta,b.1) make ptr to data
2171           sta       eb.inp,3  set in ptr
2172           sta       eb.otp,3  set out ptr
2173           stz       eb.tly,3  zero the tallytoo
2174           rem
2175 modret    return    hmode
2176           rem
2177 tstcfg    bss       1         place for temporary parity bits
2178           rem
2179 a.p001    ind       makcct
2180 a.p002    ind       getbfh
2181 a.p003    ind       denq
2182 a.p004    ind       maskr     restart wait block in control_tables
2183 a.p005    ind       cioc
2184 a.p006    ind       frelbf
2185 a.p007    ind       frebuf
2186 a.p008    ind       setbpt
2187 a.p009    ind       fribuf
2188 a.p010    ind       fremem
2189 a.p011    ind       itest
2190 a.p012    ind       resout
2191           rem
2192 l.p001    vfd       18/tffrmi
2193 l.p002    vfd       18/tfcrec+tflfec+tftbec+tfecpx
2194 l.p003    ind       eb.dta,b.1
2195 l.p004    vfd       18/tfecpx
2196 l.p005    vfd       o18//tffip
2197 l.p006    vfd       18/sffnib
2198 l.p007    vfd       18/tfifc
2199 l.p008    vfd       18/tfoddp
2200 l.p009    vfd       18/tf8out
2201 l.p010    vfd       18/p2.lpo+p2.lps
2202 l.p011    vfd       o18//p2.lpo*/p2.lps
2203 l.p012    vfd       18/p2.lps
2204 l.p013    vfd       18/sffebd
2205 l.p014    vfd       o18//tflisn
2206 l.p015    vfd       18/tfmask
2207 l.p016    vfd       18/p.rmsk
2208 l.p017    vfd       18/sffsct+sffebd+sffdct+sffcii+sffcoi
2209 l.p018    vfd       18/sffbsc+sffsyn+sffhdl
2210 l.p019    oct       010000    icw exhaust bit
2211 l.p020    vfd       18/tfofc
2212 l.p021    vfd       18/tfosus
2213           ttls      subroutines for masking/unmasking channel
2214           rem
2215           rem       mskchn is called by the status processor when it discovers
2216           rem       that the interrupt handler masked a channel because of
2217           rem       excessive interrupts. its job is to report this to the
2218           rem       host (via denq), set a flag in the tib, and force the
2219           rem       channel to its starting point in the control tables. the
2220           rem       channel should remain dormant until the host sends a new
2221           rem       listen order.
2222           rem
2223           rem       x1 contains virtual tib address as usual
2224           rem       x2 contains virtual sfcm address
2225           rem
2226 mskchn    subr      msk,(x3)
2227           ilq       linmsk
2228           tsy       a.p003-*,*          denq
2229           lda       l.p014-*  =^tflisn
2230           ansa      t.flg,1   force listen flag off
2231           lda       l.p015-*  =tfmask
2232           orsa      t.flg3,1  and masked flag on
2233           rem                 now clear out all buffers (except t.dcp,
2234           rem                 which is dia_man's problem)
2235           stz       mocur-*   initialize ocur flag
2236           lda       t.ocp,1
2237           tze       msk010-*
2238 msk005    cmpa      t.ocur,1  is t.ocur included in t.ocp?
2239           tze       msk007-*  yes
2240           tsy       a.p008-*,*          (setbpt) not this one, look at next
2241           cax3
2242           lda       bf.nxt,3  pointer to next buffer
2243           tnz       msk005-*  if any
2244           tra       msk008-*  else no match, proceed
2245 msk007    aos       mocur-*   set flag to indicate overlap
2246 msk008    lda       t.ocp,1   get original pointer back
2247           tsy       a.p006-*,*          frelbf
2248 msk010    lda       t.ocur,1
2249           tze       msk020-*
2250           szn       mocur-*   was t.ocur chain subset of t.ocp chain?
2251           tnz       msk015-*  yes, it's already been freed
2252           tsy       a.p006-*,*          frelbf
2253 msk015    stz       t.ocur,1
2254 msk020    stz       t.ocp,1
2255           stz       sf.ob0,2
2256           stz       sf.ob1,2
2257           stz       t.ocnt,1  all output buffers flushed now
2258           lda       t.icp,1
2259           tze       msk050-*
2260           tsy       a.p006-*,*          frelbf
2261           stz       t.icp,1
2262           stz       t.icpl,1
2263 msk050    lda       sf.ib0,2
2264           tze       msk060-*
2265           tsy       a.p008-*,*          (setbpt) fribuf wants virtual address
2266           cax3                in x3
2267           tsy       a.p009-*,*          fribuf
2268           stz       sf.ib0,2
2269 msk060    lda       sf.ib1,2
2270           tze       msk070-*
2271           tsy       a.p008-*,*          (setbpt) fribuf wants virtual address
2272           cax3                in x3
2273           tsy       a.p009-*,*          fribuf
2274           stz       sf.ib1,2
2275 msk070    null                buffers all gone, wipe out temporary sfcm flags
2276           lda       l.p017-*  sfcm flags that should stay around
2277           ora       l.p018-*  and more of the same
2278           ansa      sf.flg,2  turning off any others that are on
2279           ldx3      sf.hcm,2  ruin all icws
2280           ila       0
2281           ldq       l.p019-*  =010000, exhaust bit
2282           staq      h.ric0,3
2283           staq      h.ric1,3
2284           staq      h.sic0,3
2285           staq      h.sic1,3
2286           stz       sf.nic,2  don't keep old character pointers
2287           rem
2288           lda       t.type,1  ascii or other?
2289           icmpa     ttasci
2290           tnz       msk075-*  non-ascii, check for tib extension
2291           lda       t.rcp,1   else check for replay chain
2292           tze       msk080-*  none, we're finished
2293           tsy       a.p006-*,*          (frelbf) free it
2294           stz       t.rcp,1   not there any more
2295           tra       msk080-*  done now
2296           rem
2297 msk075    ldx3      t.elnk,1  get address of tib extension to free it
2298           tze       msk080-*  none, do nothing
2299           stz       t.elnk,1  no longer has ext
2300           ldq       0,3       length
2301           iaq       1         plus control word
2302           tsy       a.p010-*,*          =fremem
2303           rem
2304 msk080    stz       t.reta,1
2305           lda       a.p004-*  address of restarting op block
2306           sta       t.cur,1   make channel start there next time
2307           tsy       a.p011-*,*          (itest) poke it so it goes to right tables
2308           return    mskchn
2309           rem
2310           rem
2311           rem
2312           rem       hunmsk is called by dia_man when a listen order is
2313           rem       received for a channel with tfmask on (i.e., that has
2314           rem       previously been masked). it resets the various masked bits,
2315           rem       re-establishes the sfcm status queue pointers, and unmasks
2316           rem       the channel.
2317           rem
2318           rem
2319 hunmsk    subr      unm,(inh,x2)
2320           ldx2      t.sfcm,1  we'll need the sfcm
2321           lda       sf.pcw,2
2322           icana     pb.msk    did we mask it, in fact?
2323           tze       unm010-*  no
2324           cx2a                get (virtual) address of
2325           iaa       sf.waq    software status queue
2326           sta       sf.nxp,2  and store it
2327           sta       sf.nxa,2  in sfcm
2328           lda       sf.ssl,2  get length of queue
2329           sta       sf.tly,2  initialize this too
2330           stz       sf.pcw,2  clear out the "masked" bit
2331           lda       l.p016-*  (=p.rmsk) get "reset mask" opcode
2332           tsy       a.p005-*,*          cioc
2333 unm010    lda       l.p015-*  =tfmask
2334           iera      -1        complement tib "masked" bit
2335           ansa      t.flg3,1  so as to turn it off
2336           return    hunmsk
2337           rem
2338           rem
2339           rem
2340 mocur     bss       1         indicator for whether t.ocp and t.ocur
2341           rem                 chains overlap
2342           ttls      cioc - connect subroutine
2343 cioc      subr      cio,(x1,x2,x3,inh)
2344           rem
2345 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2346 *
2347 *         cioc
2348 *
2349 *              subroutine to perform a connect to a hsla
2350 *         subchannel. a pcw type 1 is issued with the pcw
2351 *         broadside bits in the sfcm.
2352 *
2353 *         upon entry:
2354 *              a  - contains pcw op-code to use
2355 *              x1 - virtual tib address
2356 *
2357 *         returns:
2358 *
2359 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2360           rem
2361           sta       ciopcw-*  save the pcw op-code
2362           lda       l.c006-*  (=pcw.1) get command type code
2363           orsa      ciopcw-*  and put it into pcw
2364           lda       t.line,1  get the line number
2365           iana      31        (=o37) leave just subch number
2366           als       6         position it for pcw
2367           orsa      ciopcw-*  put into pcw
2368           rem
2369           ldx2      t.sfcm,1  get ptr to sfcm
2370           lda       sf.pcw,2  get pcw broadside bits
2371           sta       ciopcw+1-*          put them into pcw, too
2372           rem
2373           rem       pcw model setup, select chan and do cioc
2374           rem
2375           lda       t.line,1  get line no again
2376           ars       6
2377           iana      7         turn off "is_hsla" bit
2378           iaa       h1ch      add in base hsla chan no
2379           rem                 to get iom chan no 6, 7 or 8
2380           ora       l.c007-*  (=sel 0) or in select instruction
2381           sta       1         put it down to execute
2382           sel       0         (patched) select the right chan
2383           rem
2384           ldx3      sf.hsl,2  get pointer to hsla table entry
2385           ldx3      ht.tib,3  get real tib address for trace
2386           trace     tt.pcw,ts.pcw,(x3,ciopcw,ciopcw+1)
2387           rem
2388           cioc      ciopcw-*  hit channel with pcw
2389           return    cioc
2390           even
2391 ciopcw    bss       2         (altrd) pcw temp for cioc
2392           ttls      seticw - setup the output icw's
2393 seticw    subr      sic,(x1,x2,x3)
2394           rem
2395 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2396 *
2397 *         seticw
2398 *
2399 *              seticw setups the output icw's for the
2400 *         buffer chain pointed to by t.ocur. it assumes no
2401 *         active output icw and stores into both.
2402 *
2403 *         upon entry:
2404 *              x1 - virtual tib address
2405 *
2406 *         returns:
2407 *              both output icw's setup
2408 *
2409 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2410           rem
2411           ldx2      t.sfcm,1  get addr of sfcm
2412           ldx3      sf.hcm,2  get addr of hwcm region
2413           rem
2414           iacx3     h.sic0    add in offset
2415           stx3      sicicw-*  save it away
2416           ldx3      t.sfcm,1  get ptr to sfcm
2417           iacx3     sf.ob0    add in other offset
2418           stx3      sicobp-*  save it also
2419           rem
2420           lda       sf.flg,2  get sfcm flag word
2421           icana     sffcoi    which icw is active?
2422           tze       sic010-*  primary, use it first
2423           rem
2424           ila       h.sic1-h.sic0       get difference
2425           asa       sicicw-*  update ind word
2426           ila       sf.ob1-sf.ob0       get other difference
2427           asa       sicobp-*  save it also
2428           rem
2429 sic010    lda       t.ocur,1  pick up ptr to next output buffer
2430           sta       sicobp-*,*          put into the sfcm
2431           tsy       a.c005-*,*          setbpt
2432           cax3                get virtual address
2433           stx3      sicbuf-*  hang on to it
2434 sic020    cx3a                get ptr into the a
2435           tze       sicret-*  no buffer
2436           iaa       bf.dta    get offset of data
2437           ora       l.c005-*  (=0,b.0) or in the character  addressing
2438           caq                 hide it away
2439           rem
2440           lda       bf.tly,3  get the buffer tally
2441           ana       l.c001-*  (=buftmk) isolate the tally
2442           llr       18        switch a and q
2443           stx3      settmp-*
2444           ldx3      sicicw-*  get ptr to icw words
2445           tsy       a.c006-*,*          (bldicw) set up icw
2446           rem
2447           ldx3      settmp-*  get the buffer addr again
2448           tsy       a.c002-*,*          (=oscan) scan the buffer
2449           rem
2450           tsy       a.c001-*,*          (=outpar) output parity for ebcdic
2451           rem
2452 sic030    lda       bf.flg,3  get buffer flag bits
2453           cana      l.c002-*  (=bfflst) last buffer in msg?
2454           tnz       sic050-*  yes, pretty much done
2455           rem
2456           szn       bf.nxt,3  is there any more chain?
2457           tze       sicret-*  nope, all done here
2458           rem
2459           ila       sfhmk     get mask to switch icw ptr
2460           ersa      sicicw-*
2461           ila       sfbfmk    get mask to switch buffer ptrs
2462           ersa      sicobp-*
2463           rem
2464           lda       bf.nxt,3  get addr of next guy in chain
2465           sta       sicobp-*,*          and into sfcm
2466           tsy       a.c005-*,*          (setbpt) get virtual address
2467           cax3                we'll need it in x3 too
2468           iaa       bf.dta    get offset of data
2469           ora       l.c005-*  (=0,b.0) or in char addressing bits
2470           caq                 hang on to address
2471           rem
2472           lda       bf.tly,3  get the tally
2473           ana       l.c001-*  (=buftmk) isolate tally
2474           llr       18        switch a and q
2475           ldx3      sicicw-*  get ptr to icw
2476           tsy       a.c006-*,*          (bldicw) put into icw
2477           rem
2478           lda       t.ocur,1  get ptr to first buffer
2479           tsy       a.c005-*,*          setbpt
2480           cax3
2481           lda       bf.nxt,3  get next buffer addr
2482           tsy       a.c005-*,*          setbpt
2483           cax3
2484           tsy       a.c002-*,*          (=oscan) scan the buffer
2485           tsy       a.c001-*,*          (=outpar) output parity for ebcdic
2486           rem
2487           lda       bf.flg,3  get buffer flags
2488           cana      l.c002-*  (=bfflst) last buffer ?
2489           tze       sicret-*  no
2490           rem
2491 sic050    lda       l.c010-*  (=sffhdl) is it HDLC?
2492           cana      sf.flg,2
2493           tze       sicret-*  no
2494           lda       l.c008-*  (=tsftre) get tally runout enable bit
2495           orsa      t.stat,1  turn it on in tib status
2496           rem
2497           rem
2498 sicret    return    seticw
2499           rem
2500           rem
2501 sicicw    bss       1         (altrd) icw ptr
2502 sicobp    bss       1         (altrd) sf.ob0/1 ptr
2503 oddchr    bss       1
2504 settmp    bss       1
2505 sicbuf    bss       1         virtual pointer to current buffer
2506 sicnoc    bss       1         local address of next output character
2507           rem
2508 l.c001    vfd       18/buftmk
2509 l.c002    vfd       18/bfflst
2510 *l.c003             unused
2511 *l.c004             unused
2512 l.c005    ind       0,b.0
2513 l.c006    vfd       18/pcw.1  pcw type 1
2514 l.c007    sel       0         select instruction
2515 l.c008    vfd       18/tsftre
2516 l.c009    vfd       o18//tfwrit
2517 l.c010    vfd       18/sffhdl
2518           rem
2519 a.c001    ind       outpar
2520 a.c002    ind       oscan
2521 a.c003    ind       freout
2522 a.c004    ind       g3wjt
2523 a.c005    ind       setbpt
2524 a.c006    ind       bldicw
2525           ttls      hintr - hsla interrupt handler
2526 hintr     null
2527           rem
2528 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2529 *
2530 *         hintr
2531 *
2532 *              this routine handles interrupts for all of
2533 *         the hsla subchannels, and takes status from the
2534 *         hardware status buffer and queues it for process-
2535 *         ing by the scheduled status processor, hstprc. hstprc
2536 *         will be scheduled to process the status queue if it is
2537 *         not already scheduled.
2538 *
2539 *         upon entry:
2540 *              a call to g3jwt will return the third word of
2541 *              the jump table, as follows:
2542 *
2543 *                   bits 0-3    iom channel number
2544 *                   bits 4-5    hsla number(1-3)
2545 *                   bits 6-10   subchannel number(0-31)
2546 *                   bits 11-17  module number of hsla_man
2547 *
2548 *         returns:
2549 *              entries queued for hstprc
2550 *
2551 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
2552           rem
2553           tsy       a.c004-*,*          (=g3jwt) get third word of jump table
2554           stq       intjtw-*  save the result
2555           rem
2556           trace     tt.int,ts.int,(intjtw)
2557           ldq       intjtw-*
2558           cqa                 put copy into the a
2559           ars       12        shift down to get hsla number
2560           iana      3         leave only the hsla number
2561           iaa       -1        subtract one to get 0-2
2562           ora       l.d001-*  (=000010) turn on is_hsla bit
2563           als       6         shift back into proper position
2564           sta       intlno-*  save as part of line number
2565           rem
2566           cqa                 get another copy
2567           ars       7         shift down subchannel number
2568           iana      31        leave only subchan number
2569           orsa      intlno-*  put into line number
2570           rem
2571           lda       intlno-*  pick it up for call
2572           tsy       a.d005-*,*          (=gettib) get the tib addr
2573           iaa       0         set the indicators
2574           tze       intret-*  no tib, ignore interrupt
2575           rem
2576           sta       intrtb-*  save real tib address for dspqur
2577           tsy       a.d010-*,*          (setptw) virtualize real tib address
2578           sta       intvtb-*  save for easy reference
2579           cax1                put virtual tib address into x1
2580           ldx2      t.sfcm,1  get the virtual sfcm address
2581           tnz       2         should be non-zero
2582           die       10        nope, die
2583           rem
2584           lda       sf.ssl,2  figure out current number of pending status
2585           sba       sf.tly,2  to meter it
2586           sta       intcnt-*
2587           cmeter    mupdat,m.nst,intcnt-*
2588           rem
2589           stz       inthqf-*  clear status exhaust indicator
2590           stz       intsqo-*  clear status queue overflow switch
2591           ila       hpri      get basic priority
2592           sta       intskd-*  set in sked words
2593           rem
2594           ldx3      sf.hcm,2  get hardware comm region address
2595           lda       h.aicw+1,3 get second word of status icw
2596           cana      l.d002-*  is it exhausted?
2597           tze       int002-*  no
2598           aos       inthqf-*  indicate that is so for later
2599           rem
2600 int002    lda       t.sfcm,1  get address of sfcm
2601           iaa       sf.sta    add in the queue offset
2602           sta       intcrp-*  first status if primary
2603           rem
2604           lda       sf.flg,2  get sfcm flag word
2605           cana      l.d019-*  (=sffcai) is hardware alt buffer being used
2606           tnz       int004-*  yes
2607           rem
2608           lda       l.d019-*  (=sffcai) or in alt hardware status
2609           orsa      sf.flg,2
2610           lda       intcrp-*  get back address of status queu
2611           iaa       sf.shq-sf.sta add in the difference
2612           tra       int006-*
2613           rem
2614 int004    lda       l.d020-*  (=^sffcai)
2615           ansa      sf.flg,2  turn off alt indicator
2616           ldq       intcrp-*  get current position
2617           ila       sf.shq-sf.sta delta of hardware queue
2618           asa       intcrp-*  adjust first status pointer
2619           cqa                 get back orginal address for status
2620           rem
2621 int006    sta       intvir-*  temporarily save virtual address
2622           tsy       a.d007-*,*          (cvabs) get absolute address for icw
2623           ldq       intsai-*  second word of status icw
2624 int007    staq      h.aicw,3  store icw now
2625           nop                 buy some time
2626           cmpa      h.aicw,3  see if we change it
2627           tze       int008-*  yes all done
2628           ldx3      intvir-*  set to point to first status of this queue
2629           szn       0,3       set indicators
2630           tnz       int008-*  new status all done
2631           ldx3      sf.hcm,2  get hcm address
2632           tra       int007-*  try again
2633           rem
2634 int008    lda       intcrp-*  get first status to process
2635           iaa       sfhsiz*2+2 calc end of queue
2636           sta       intend-*  for later processing
2637           ldx3      intcrp-*  set to point to first status
2638           rem
2639           lda       sf.flg,2  get sfcm flags
2640           icana     sffisc    inactive subchannel?
2641           tnz       int050-*  yes, get out of here
2642           rem
2643 int010    lda       0,3       is this status word zero?
2644           tze       int050-*  yes, all done
2645           cana      l.d010-*  (=hs.rcs) rcv status ?
2646           tze       int014-*  no
2647           rem
2648           cana      l.d004-*  (=hs.tro) tally runout ?
2649           tze       int011-*  no
2650           rem
2651           rem                 tally runout means we just dropped out of
2652           rem                 rcv mode.  make sure we stay out.
2653           rem
2654           lda       l.d011-*  (=/pb.rcv)
2655           ansa      sf.pcw,2  turn off pcw rcv bit
2656           tra       int020-*
2657           rem
2658 int011    cana      l.d007-*  (=hs.siw) switching icw ?
2659           tze       int020-*  no, continue
2660           rem
2661           stx3      intcrp-*  save status queue addr
2662           caq                 put status word in q
2663           rem
2664           ldx3      sf.hcm,2  get hwcm addr
2665           iacx3     h.ric0    get primary rcv icw addr
2666           cana      l.d008-*  (=hs.aiw) alt icw active ?
2667           tze       2         no
2668           iacx3     h.ric1-h.ric0       get alt rcv icw addr
2669           rem
2670           lda       1,3       get icw tally
2671           ana       l.d009-*  (=007777) leave only tally
2672           sta       inttly-*  save it
2673           rem
2674           lda       l.d018-*  (=410000) get exhausted tally
2675           sta       1,3       put it in icw
2676           rem
2677           lda       sf.flg,2  synchronous?
2678           cana      l.d005-*  =sffsyn
2679           tnz       int012-*  yes
2680           cqa                 no, get first word of status again
2681           tra       int013-*  skip tally manipulation
2682 int012    cqa                 get status back in a
2683           ldx3      sf.ib0,2  get primary buffer addr
2684           cana      l.d008-*  (=hs.aiw) alt. icw active ?
2685           tze       2         no
2686           ldx3      sf.ib1,2  get alt buffer addr
2687           cx3a                virtualize it
2688           tsy       a.d001-*,*          setbpt
2689           cax3
2690           rem
2691           ldq       bf.tly,3  get max buffer tally
2692           sbq       inttly-*  subtract icw tally
2693           stq       bf.tly,3  put actual tally in buffer
2694           rem
2695 int013    ldx3      intcrp-*  restore status queue addr
2696           rem
2697 int014    cana      l.d007-*  (=hs.siw) switching icw ?
2698           tze       int020-*  no, process status at normal priority
2699           rem
2700 *         lda       sf.flg,2  get sfcm flags
2701 *         cana      l.d005-*  synchronous line ?
2702 *         tze       int015-*  no, use priority 3
2703 *         rem
2704 *         ldx2      sf.hsl,2  get address of hsla table
2705 *         lda       ht.flg,2  pick up word with speed
2706 *         ldx2      t.sfcm,1  restore x2
2707 *         iana      htfspd    leave only the channel speed
2708 *         icmpa     8         is it more than 9600 baud?
2709 *         tmi       int015-*  no, use priority 3
2710 *         rem
2711 *         ila       hprip2    use real high priority
2712 *         tra       2
2713           rem
2714 int015    ila       hprip3    get priority 3 for sked
2715           sta       intskd-*  reset scheduler priority
2716           rem
2717           lda       l.d014-*  =sffmsp
2718           iera      -1        if switching icws, turn it off
2719           ansa      sf.flg,2
2720           rem
2721 int020    szn       sf.tly,2  any room in status queue?
2722           tnz       int025-*  yes, continue
2723           rem
2724           szn       intsqo-*  status overflow occurred already ?
2725           tnz       int024-*  yes, skip it
2726           rem
2727           tsy       a.d015-*,*          handle status queue overflow
2728           aos       intsqo-*  remember it
2729           rem
2730 int024    stz       0,3       zero the ignored status
2731           tra       int030-*  leave here
2732           rem
2733 int025    lda       sf.flg,2  synchronous?
2734           cana      l.d005-*  =sffsyn
2735           tnz       int028-*  yes, skip the marker test
2736           lda       0,3       get first word of status
2737           cana      l.d013-*  (=hs.nms) marker status?
2738           tze       int028-*  nope
2739           lda       sf.flg,2  yes, is one already pending
2740           cana      l.d014-*  (=sffmsp)
2741           tze       int027-*  no, we'll have to store this one
2742           lda       0,3       (get first word of status back)
2743           cana      l.d015-*  yes, but are there any other interesting ones?
2744           tnz       int027-*  yep
2745           stz       0,3       ignore this status
2746           tra       int040-*
2747           rem
2748 int027    lda       0,3       get first word of status again
2749           cana      l.d007-*  (=hs.siw) switching icws?
2750           tnz       int028-*  then don't set flag
2751           lda       l.d014-*  =sffmsp
2752           orsa      sf.flg,2  turn it on
2753 int028    null
2754           ldaq      0,3       get the current status words
2755           staq      sf.nxa,2* put into the software queue
2756           stz       0,3       zero the current status
2757           rem
2758           cana      l.d007-*  *is it hs.siw for switching
2759           tze       int28a-*  *no continue
2760           cana      l.d010-*  *is it hs.rcv recieve only
2761           tze       int28a-*  *no again
2762           lda       sf.flg,2
2763           cana      l.d017-*  *(sffhdl+sffbsc) is it bsc or HDLC?
2764           tze       int28a-*  no
2765           tsy       a.d014-*,*          *(swphic) switch buffer now
2766           rem
2767 int28a    ila       -1        decrement the tally
2768           asa       sf.tly,2
2769           ila       4         increment the next available
2770           asa       sf.nxa,2  pointer
2771           rem
2772           lda       sf.ssl,2  get length of status queue
2773           als       2         in words
2774           sta       intsql-*
2775           cx2a                put sfcm ptr into a
2776           iaa       sf.waq
2777           ada       intsql-*  get ptr to end of status queue
2778           cmpa      sf.nxa,2  are we at end of queue?
2779           tnz       int030-*  nope, continue
2780           rem
2781           cx2a                copy sfcm ptr to a
2782           iaa       sf.waq    get ptr to beginning of queue
2783           sta       sf.nxa,2  put into q ptr, wrapping q
2784           rem
2785 int030    lda       sf.flg,2  get the sfcm flags
2786           icana     sffskd    is the status processor scheduled?
2787           tnz       int040-*  yes, continue
2788           rem
2789           ila       sffskd    get flag bit
2790           orsa      sf.flg,2  turn it on now
2791           rem
2792           ldx1      intrtb-*  get real tib address for dspqur
2793           ldaq      intskd-*  (queue element)
2794           tsy       a.d002-*,*          (=dspqur) queue hstprc to process status
2795           rem                 note: x1 contains real tib address
2796           ldx1      intvtb-*  restore virtual tib address to x1
2797           rem
2798 int040    iacx3     2         bump to next status
2799           cmpx3     intend-*  are we at end of buffer?
2800           tnz       int010-*  no, continue
2801           rem
2802 int050    szn       intsqo-*  did we overflow?
2803           tnz       int060-*  yes and we process it
2804           szn       inthqf-*  hardware overflow?
2805           tze       int060-*  no
2806           rem
2807           cmeter    mincs,m.hsqo,l.d016-*
2808           rem
2809           tsy       sqovfl-*  handle status queue overflow
2810           aos       intsqo-*  now process hardware the same as software
2811           rem
2812 int060    null
2813 int070    szn       intsqo-*  did we get another status queue overflow?
2814           tze       intret-*  no, all is well
2815           rem
2816           aos       sf.rct,2  bump the repeat count
2817           lda       sf.rct,2  get the new value
2818           icmpa     20        compare to some random number
2819           tmi       intret-*  no there yet, let channel run a bit more
2820           rem
2821           ldx2      t.sfcm,1  reset sfcm ptr
2822           ila       pb.msk    set software "mask" bit
2823           sta       sf.pcw,2  in pcw, and zero other bits (like dtr!!)
2824           lda       l.d003-*  (=p.msk) get mask op
2825           tsy       a.d009-*,*          (=cioc) connect to channel
2826           rem
2827 intret    tra       a.d004-*,*          (=mdisp) return to master dispatcher
2828           rem
2829           rem
2830 intcnt    bss       1         used for count of pending status
2831 intjtw    bss       1         (altrd) 3rd word of jump table
2832 inthqf    bss       1         hardware queue overflow
2833 intend    bss       1         (altrd) end of hardware status buffer
2834 intcrp    bss       1         (altrd) current hardware status ptr
2835 intrtb    bss       1         save for real tib address
2836 intvtb    bss       1         save for virtual tib address
2837 intsql    bss       1         length of software status queue
2838 intvir    bss       1         virtual address of head of hardware status queue
2839           rem
2840           even
2841 intskd    zero      hpri      priority of hstprc
2842           ind       hstprc    routine to be run
2843 intsai    amicwo    w.2,sfhsiz,0
2844           rem
2845           rem       following two words must be together for error message
2846 interr    dec       4         error code
2847 intlno    bss       1         (altrd) line number - tib type
2848           rem
2849 intsqo    bss       1
2850 inttly    bss       1
2851           rem
2852           rem
2853 l.d001    vfd       o18/000010          is_hsla bit
2854 l.d002    vfd       o18/010000
2855 l.d003    vfd       18/p.msk
2856 l.d004    vfd       18/hs.tro
2857 l.d005    vfd       18/sffsyn
2858 l.d006    oct       000130,000110
2859 l.d007    vfd       18/hs.siw
2860 l.d008    vfd       18/hs.aiw
2861 l.d009    oct       007777
2862 l.d010    vfd       18/hs.rcs
2863 l.d011    vfd       o18//pb.rcv
2864 l.d012    vfd       18/sffsqo
2865 l.d013    vfd       18/hs.nms
2866 l.d014    vfd       18/sffmsp
2867 l.d015    vfd       18/hs.siw+hs.ptr+hs.tro+hs.dss
2868 l.d016    dec       1
2869 l.d017    vfd       18/sffhdl+sffbsc
2870 l.d018    oct       410000    exhausted icw with 18-bit addressing on
2871 l.d019    vfd       18/sffcai altenate status buffer
2872 l.d020    vfd       o18//sffcai and mask for turning off alt status
2873           rem
2874 a.d001    ind       setbpt
2875 a.d002    ind       dspqur
2876 a.d003    ind       0,w.2
2877 a.d004    ind       mdisp
2878 a.d005    ind       gettib
2879 a.d006    ind       .crpte    pointer to variable cpu page table word
2880 a.d007    ind       cvabs
2881 *a.d008   unused
2882 a.d009    ind       cioc
2883 a.d010    ind       setptw    set up page table word
2884 a.d011    ind       stpcnt
2885 a.d012    ind       stpret
2886 a.d013    ind       stpswd
2887 a.d014    ind       swphic
2888 a.d015    ind       sqovfl
2889           ttls      preallocated buffer tables
2890           rem
2891           rem       preallocated chain table
2892           rem       a pointer to the preallocated buffer pool.
2893           rem
2894 pchtbl    oct       000000
2895           oct       000000
2896           oct       000000
2897           oct       000000
2898           oct       000000
2899           oct       000000
2900           oct       000000
2901           oct       000000
2902           rem
2903           rem       preallocated chain left table
2904           rem       the number of buffers in the preallocated chain
2905           rem
2906 pchlft    oct       000000
2907           oct       000000
2908           oct       000000
2909           oct       000000
2910           oct       000000
2911           oct       000000
2912           oct       000000
2913           oct       000000
2914           rem
2915           rem       preallocated buffer max count table
2916           rem
2917 pbfmax    oct       000000
2918           oct       000000
2919           oct       000000
2920           oct       000000
2921           oct       000000
2922           oct       000000
2923           oct       000000
2924           oct       000000
2925           ttls      albchs - allocate buffer check
2926 ******************************************************************************
2927 *
2928 *         albchs - alocate buffer check
2929 *
2930 *         This will check and allocate the preallocated buffer
2931 *         chains for any high speed sync lines.
2932 *         If no buffer can be allocated,
2933 *         the icw switching code will handle it when the time comes
2934 *         as an exhaust condition.
2935 *         Coded for switching icw problem by
2936 *                   D. W. Cousins on March 24, 1981
2937 *
2938 *****************************************************************************
2939 albchs    subr      alb,(a,q,x1,x2,x3)
2940           ila       0         *set up index for table
2941           cax2
2942 alb010    icmpa     8         *is it max yet
2943           tze       albret-*  *finish
2944           lda       a.w003-*,*          *(pbfmax,2) get max buffer for this line
2945           tze       alb040-*  *if zero no allocate
2946           sta       pamax-*   *store it temp for compare
2947 alb020    lda       a.w002-*,*          *(pchlft,2) number of buffer left
2948           cmpa      pamax-*   *compare number left to max
2949           tze       alb040-*  *already full
2950           tpl       alb040-*  *that all for now
2951           cx2a                *calc the bufer size
2952           iaa       1
2953           als       5
2954           caq                 *put it in q for getubf
2955           tsy       a.w004-*,*          *=getubf
2956           tra       alb030-*  *error no buffer
2957           sta       albabs-*  save absolute address
2958           lda       bf.siz,3  *get it real size
2959           arl       15
2960           als       bufshf+1
2961           iaa       hbfnch
2962           orsa      bf.tly,3
2963           ldx3      albabs-*  get absolute address again
2964           tsy       adtopa-*  *add it to the chain
2965           rem
2966           smeter    mincd,.mbfpa,l.w002-*
2967           rem
2968           tra       alb020-*  *go again
2969 alb030    null                *allocation failed it ok now
2970 alb040    iacx2     1         *inc the counter for next buffer
2971           cx2a                *get it to a for max test
2972           tra       alb010-*  *check again
2973 albret    return    albchs
2974           rem
2975 pamax     bss       1
2976 albabs    bss       1
2977           rem
2978 a.w001    ind       pchtbl,2  prellocated buffer chain
2979 a.w002    ind       pchlft,2  number of buffer left in chain
2980 a.w003    ind       pbfmax,2  max number of buffer in a chain
2981 a.w004    ind       getbfh    get user buffer
2982 a.w005    ind       frebfh    free buffer
2983 a.w006    ind       setbpt    virtualize buffer address
2984           rem
2985 l.w001    vfd       18/sffhdl+sffbsc
2986 l.w002    dec       1
2987           ttls      adtopa - add to preallocated chain
2988 ***********************************************************************
2989 *         adtopa - add to preallocated chain
2990 *
2991 *         This inhibited code adds a buffer to the
2992 *         preallocated chain for a particular buffer size.
2993 *
2994 *            x2 contains offset into buffer-size tables for the
2995 *                   given size.
2996 *
2997 *         This is to help icw switching problem
2998 *         coded by D. W. Cousins on March 24, 1981
2999 *
3000 *********************************************************************
3001 adtopa    subr      adt,(x1,inh)
3002           lda       a.w001-*,*          (pchtbl,2) get head of chain
3003           tze       adt020-*  *may be finish
3004 adt010    tsy       a.w006-*,*          setbpt
3005           cax1                *ok we got the virtual address
3006           lda       bf.nxt,1  *get the next address
3007           tze       adt030-*  *good we arrive
3008           tra       adt010-*  *again
3009 adt020    stx3      a.w001-*,*          *(pchtbl,2) store the address at the head
3010           tra       adt040-*  *all done
3011 adt030    stx3      bf.nxt,1  *store it in the buffer
3012 adt040    aos       a.w002-*,*          *(pchlft,2) add one to number of buffer in chain
3013           return    adtopa    *all done
3014           ttls      dumsbf - dump store buffer
3015 *******************************************************************
3016 *
3017 *         dumsbf - dump store buffer
3018 *
3019 *         icw switching stored the buffer address with the software
3020 *         status in the sfcm for bsc and hdlc channels. This will dump it.
3021 *
3022 *         Written by D. W. Cousins on April 13, 1981 for sicw problem
3023 *
3024 *******************************************************************
3025           rem
3026 dumsbf    subr      dsf,(x2)
3027           ldx2      t.sfcm,1  *some basic check
3028           lda       sf.flg,2
3029           cana      l.w001-*  * (sffhdl+sffbsc) is it bsc or hdlc?
3030           tze       dsfret-*  *no
3031           ilq       0         *going to tell frebuf to use buffer size
3032           lda       bftsa-*   *get the buffer
3033           tze       dsfret-*  *zero buffer address
3034           tsy       a.w005-*,*          *=frebfh
3035 dsfret    return    dumsbf
3036           rem
3037 bftx3     bss       1
3038 bftsa     bss       1
3039           ttls      sqovfl - status queue overflow
3040 sqovfl    subr      sqo(x2)
3041           rem
3042 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3043 *
3044 *         sqovfl
3045 *
3046 *         finds the last status stored in the software
3047 *         status queue and turns on the sqo bit.  also,
3048 *         takes the channel out of receive mode.
3049 *
3050 *         upon entry:
3051 *              x1 - virtual tib address
3052 *              x2 - virtual sfcm address
3053 *
3054 *         returns:
3055 *
3056 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3057           rem
3058           cmeter    mincs,m.ssqo,l.d016-*
3059           rem
3060           lda       l.d012-*  (=sffsqo)
3061           cana      sf.flg,2  status queue overflow pending ?
3062           tnz       sqoret-*  yes, done
3063           orsa      sf.flg,2  indicate status queue overflow
3064           rem
3065           lda       l.d011-*  (=/pb.rcv)
3066           ansa      sf.pcw,2  turn off pcw rcv bit
3067           ila       p.nop     get pcw nop command
3068           tsy       a.d009-*,*          (cioc) exit rcv mode
3069           rem
3070           lda       sf.ssl,2  get length of status queue
3071           qls       4         in words
3072           sta       sqosql-*
3073           cx2a                put sfcm addr in a
3074           iaa       sf.waq    get start of status queue addr
3075           cmpa      sf.nxa,2  next status at start of queue ?
3076           tnz       sqo010-*  no
3077           ada       sqosql-*  get end of queue addr
3078           tra       sqo020-*
3079           rem
3080 sqo010    null
3081           lda       sf.nxa,2  get next status addr
3082           rem
3083 sqo020    null
3084           iaa       -4        back up to last status
3085           cax2                put in x2
3086           rem
3087           ila       hs.sqo    get status queue overflow bit
3088           orsa      0,2       set sqo in last status
3089           rem
3090 sqoret    return    sqovfl
3091           rem
3092 sqosql    bss       1
3093           ttls      hstprc - hsla status processor
3094 hstprc    null                transfered to by secondary dispatcher
3095 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3096 *
3097 *         hstprc
3098 *
3099 *              this routine is the main guts of hsla_man.
3100 *         it is the scheduled status processor, which processes
3101 *         the status queued for it by hintr, the interrupt
3102 *         handling routine. All queued status for a line is processed
3103 *         by hstprc before it returns. some of this processing
3104 *         may result in the dcw interpreter or the control
3105 *         table interpreter being called.
3106 *
3107 *         upon entry:
3108 *              x1 - real tib address
3109 *
3110 *         returns:
3111 *
3112 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3113           rem
3114           cx1a                get real tib address in a
3115           sta       stptib-*  save for use with dspqur and trace
3116           tsy       a.d010-*,*          (setptw) virtualize real tib address
3117           cax1                virtual tib address goes in x1
3118           ldx2      t.sfcm,1  get virtual sfcm address
3119           rem
3120           lda       sf.ssl,2  figure out current number of pending status
3121           sba       sf.tly,2  to meter it
3122           sta       a.d011-*,*          (stpcnt)
3123           cmeter    mupdat,m.nst,(a.d011-*(*))
3124           rem
3125           lda       sf.tly,2  get queue tally
3126           cmpa      sf.ssl,2  is it at max?
3127           tze       a.e019-*,*          (stp210) yes, no work to be done here
3128           rem
3129           stz       a.d011-*,*          (stpcnt) zero status processed counter
3130           rem
3131 stp010    lda       sf.pcw,2  check to see if channel is masked
3132           icana     pb.msk
3133           tze       stp012-*  it isn't, proceed
3134           tsy       a.e026-*,*          (mskchn) it is, report it
3135           ila       sffskd    through processing status
3136           iera      -1        so turn off "scheduled" bit
3137           ansa      sf.flg,2
3138           stz       sf.rct,2
3139           tra       a.e027-*,*          (stpret) all finished
3140 stp012    aos       a.d011-*,*          (stpcnt) bump counter of number processed
3141           lda       a.d011-*,*          (stpcnt) get counter value
3142           icmpa     3         have we done to many in a row?
3143           tmi       stp015-*  no
3144           rem
3145           ldx1      stptib-*  yes. get real tib address
3146           ila       hpri      get default scheduling priority
3147           ldq       intskd-*+1          (=hstprc) get addr of status processor
3148           tsy       a.d002-*,*          (=dspqur) reschedule status processor
3149           tra       a.d012-*,*          (=stpret) done for now
3150           rem
3151 stp015    tsy       a.e023-*,*          (=albchs)
3152           ldaq      sf.nxp,2* pick up the next status to be processed
3153           staq      a.d013-*,*          (=stpswd) save it away
3154           ldx3      sf.nxp,2  *get address of current status
3155           lda       2,3       *get the buffer address
3156           sta       bftsa-*   *store it now
3157           stx3      bftx3-*   *save the address to it
3158           trace     tt.sta,ts.sta,(stptib,stpswd,stpswd+1)
3159           rem
3160           aos       sf.tly,2  increment the tally
3161           ila       4         and also the next ptr
3162           asa       sf.nxp,2  to the status q
3163           rem
3164           lda       sf.ssl,2  get size of status queue
3165           als       2         in words
3166           sta       stpsql-*
3167           cx2a                put x2 into a
3168           iaa       sf.waq    get ptr to end of queue
3169           ada       stpsql-*
3170           cmpa      sf.nxp,2  are we at the end?
3171           tnz       stp020-*  no, continue
3172           rem
3173           cx2a                put sfcm into a again
3174           iaa       sf.waq    make ptr to head of queue
3175           sta       sf.nxp,2  and reset ptr, wraping queue
3176           rem
3177 stp020    stz       stpmrk-*  init saved status
3178           lda       stpswd-*  get the first word of status
3179           cana      l.e001-*  (=hs.rcs) input status?
3180           tze       a.e020-*,*          (=stp100) no, output status
3181           eject
3182           rem       input status processor
3183           rem
3184           lda       t.stat,1
3185           ana       l.e006-*  (tsfst+tsfmrk+tsftrm) isolate requested status
3186           sta       stpmrk-*  save it for later
3187           iera      -1
3188           ansa      t.stat,1  turn off the tib flags
3189           rem
3190           lda       stpswd+1-*          get the 2nd status word
3191           arl       1         line up with tib rcv status bit
3192           ora       t.stat,1  or in tib status
3193           ana       l.e002-*  (=tsfrcv) leave only that, rcv mode?
3194           tnz       stp030-*  yes, continue
3195           rem
3196           tsy       a.e001-*,*          (=dmpbuf) dump any input buffers
3197           tsy       dumsbf-*  dump tempory store buffer
3198           rem
3199           lda       stpswd-*  get the first word of status
3200           cana      l.e007-*  (=hs.dss) any data set status changes?
3201           tze       stp080-*  no, skip rest of hardware status
3202           rem
3203           tsy       a.e009-*,*          (=ipdss) process the data set changes
3204           rem
3205           tra       a.e024-*,*          (stp095)
3206           rem
3207 stp030    lda       stpswd-*  get the status word
3208           ars       12        shift into line with the other bit
3209           era       sf.flg,2  x-or the other one in
3210           icana     sffcii    are the two bits the same?
3211           tze       stp040-*  yes, all ok
3212           rem
3213           lda       sf.flg,2  *must check for bsc and hdlc
3214           cana      l.e014-*  *(sffhdl+sffbsc) bsc or hdlc?  already got buffer
3215           tnz       stp040-*
3216           rem
3217           trace     tt.ira,ts.sta,(stptib) trace recovery try
3218           rem
3219           ldx3      sf.ib0,2  get ptr to first input buffer
3220           lda       sf.flg,2  get sfcm flag bits
3221           icana     sffcii    are we in alt buffer?
3222           tze       2         no
3223           ldx3      sf.ib1,2  get it here
3224           rem
3225           cx3a                any buffer?
3226           tze       stp035-*  no buffer
3227           rem
3228           rem                 need virtual address
3229           tsy       a.e025-*,*          setbpt
3230           cax3
3231           tsy       a.e013-*,*          (=ipterm) simulate terminate interrupt
3232           rem
3233 stp035    ila       sffcii    get bit
3234           ersa      sf.flg,2  invert it, we are right now?
3235           rem
3236 stp040    lda       sf.flg,2  *check line type
3237           cana      l.e014-*  *(sffhdl+sffbsc) is it bsc or hdlc?
3238           tze       stp045-*  *no
3239           lda       stpswd-*  switched icws?
3240           cana      l.e024-*  =hs.siw
3241           tze       stp045-*  no, buffer isn't stored with status
3242           ldx3      bftsa-*   *load the buffer address
3243           tra       stp050-*  *go to next step
3244 stp045    ldx3      sf.ib0,2  get primary buffer prt
3245           lda       sf.flg,2  get the sfcm flags
3246           icana     sffcii    alternate icw?
3247           tze       stp050-*  no, continue
3248           ldx3      sf.ib1,2  get the secondary buf ptr
3249           rem
3250 stp050    stx3      stpbuf-*  indicate which buffer
3251           iacx3     0         zero buffer address ?
3252           tnz       stp051-*  no
3253           lda       l.e018-*  get mask for status word 0
3254           ansa      stpswd-*  turn off bits that imply a buffer
3255           lda       l.e019-*  get mask for status word 1
3256           ansa      stpswd+1-*          turn off bits that imply a buffer
3257           rem
3258 stp051    lda       l.e014-*  (=sffbsc+sffhdl)
3259           cana      sf.flg,2  is it bisync or HDLC?
3260           tze       stp060-*  no
3261           rem
3262           rem       check bisync and hdlc status conditions
3263           rem
3264 stp052    lda       stpswd-*  get first status word
3265           cana      l.e007-*  (=hs.dss), data set status change?
3266           tze       2         no
3267           tsy       a.e009-*,*          (=ipdss), process it first
3268           rem
3269           lda       stpswd-*  *load status word
3270           cana      l.e004-*  =hs.siw
3271           tze       stp053-*  *not switching yet
3272           lda       bftsa-*   *load the buffer address
3273           tze       stp053-*  *no buffer get out
3274           tsy       a.e025-*,*          setbpt
3275           cax3                get virtual address in x3
3276           tsy       a.e015-*,*          *(=ipbfsw) switch buffers
3277           rem
3278 stp053    stz       stptra-*  zero status accumulation
3279           lda       l.e023-*  (=sffhdl)
3280           cana      sf.flg,2  HDLC line?
3281           tnz       stp05a-*  yes
3282           rem
3283           ldx3      a.e016-*  get bsc status map ptr
3284           lda       a.e017-*  get bsc status map end ptr
3285           sta       stpend-*  save it
3286           tra       stp05b-*
3287           rem
3288 stp05a    ldx3      a.e021-*  get hdlc status map ptr
3289           lda       a.e022-*  get hdlc status map end ptr
3290           sta       stpend-*  save it
3291           rem
3292 stp05b    lda       stpswd-*  get first status word
3293 stp054    cana      0,3       isolate interesting bits
3294           tnz       stp057-*  if on, set them
3295           rem
3296 stp056    iacx3     2         bump table ptr
3297           cmpx3     stpend-*  end of table ?
3298           tze       stp058-*  yes
3299           rem
3300           szn       0,3       switch words ?
3301           tnz       stp054-*  not yet
3302           rem
3303           lda       stpswd+1-*          get second status word
3304           tra       stp056-*
3305           rem
3306 stp057    caq                 save status word
3307           lda       1,3       get status bits
3308           orsa      stptra-*  turn them on
3309           cqa                 restore status word
3310           tra       stp056-*
3311           rem
3312 stp058    lda       stptra-*  check for any new status bits
3313           tze       stp080-*  none - try usual case
3314           rem
3315           lda       t.stat,1  get tib status flags
3316           iana      s.dss     leave only common bits
3317           ora       stptra-*  add interesting bits
3318           tsy       a.e004-*,*          (=istat) call interp to process status
3319           tra       stp075-*  continue
3320           rem
3321           even
3322 stpswd    bss       2         save area for status word
3323 stpbuf    bss       1         ptr to current buffer
3324 stptra    bss       1         addr of routine to run
3325 stpcnt    bss       1         count of processed status this call
3326 stpmrk    bss       1         saved copy of tsfst+tsfmrk+tsftrm
3327 stptib    bss       1         saved value of real tib address
3328 stpend    bss       1         set to bscend or hdcend
3329 stpsql    bss       1         length of software status queue
3330           rem
3331           rem
3332           rem
3333 l.e001    vfd       18/hs.rcs
3334 l.e002    vfd       18/tsfrcv
3335 l.e003    vfd       o18//tsfst
3336 l.e004    vfd       18/hs.siw
3337 l.e005    vfd       18/tsfmrk+tsftrm
3338 l.e006    vfd       18/tsfst+tsfmrk+tsftrm
3339 l.e007    vfd       18/hs.dss
3340 l.e008    vfd       o18/410000
3341 l.e009    vfd       18/sffstp
3342 l.e010    vfd       18/hs.nms
3343 l.e011    vfd       18/hs.ptr
3344 l.e012    vfd       18/tsfst
3345 l.e013    vfd       o18//sffsqo
3346 l.e014    vfd       18/sffhdl+sffbsc
3347 l.e015    vfd       18/hs.rcv
3348 l.e016    vfd       18/hs.xmt
3349 l.e017    vfd       18/s.xte
3350 l.e018    vfd       o18//hs.nms*/hs.dms*/hs.trm*/hs.ptr*/hs.per
3351 l.e019    vfd       o18//hs.rbt*/hs.crc
3352 l.e020    vfd       18/hs.per
3353 l.e021    vfd       18/s.prty
3354 *l.e022   unused
3355 l.e023    vfd       18/sffhdl
3356 l.e024    vfd       18/hs.siw
3357           rem
3358 a.e001    ind       dmpbuf
3359 a.e002    ind       istats
3360 a.e003    ind       iends
3361 a.e004    ind       istat
3362 a.e005    ind       ostats
3363 a.e006    ind       oends
3364 a.e007    ind       hdcw
3365 a.e008    ind       secdsp
3366 a.e009    ind       ipdss
3367 a.e010    ind       ipptro
3368 a.e011    ind       dssflg
3369 a.e012    ind       echock
3370 a.e013    ind       ipterm
3371 a.e014    ind       opptro
3372 a.e015    ind       ipbfsw
3373 a.e016    ind       bscsts
3374 a.e017    ind       bscend
3375 a.e018    ind       stp010
3376 a.e019    ind       stp210
3377 a.e020    ind       stp100
3378 a.e021    ind       hdcsts
3379 a.e022    ind       hdcend
3380 a.e023    ind       albchs
3381 a.e024    ind       stp095
3382 a.e025    ind       setbpt
3383 a.e026    ind       mskchn
3384 a.e027    ind       stpret
3385           rem
3386           ttls      status lookup tables for hstprc
3387           rem
3388           rem       input status table
3389           rem
3390 istats    stats     hs.tro,iptro
3391           stats     hs.trm,ipterm
3392           stats     hs.nms,ipmark
3393           stats     hs.ptr,ipptro
3394           stats     hs.xte,ipxte
3395           stats     hs.dss,ipdss
3396 iends     equ       *
3397           rem
3398           rem       output status table
3399           rem
3400 ostats    stats     hs.ptr,opptro
3401           stats     hs.tro,optro
3402           stats     hs.xte,opxte
3403 oends     equ       *
3404           rem
3405           rem       table to map bisync status to wait block status
3406           rem
3407 bscsts    smap      hs.trm,s.brch
3408           smap      hs.nms,s.bmk
3409           smap      hs.dms,s.bdmk
3410           smap      hs.xte,s.xte
3411           smap      hs.per,s.prty
3412           smap      hs.tro,s.xte
3413           smap      0,0
3414           smap      hs.rbt,s.rbt
3415           smap      hs.crc,s.prty
3416           smap      hs.rto,s.rto
3417 bscend    equ       *
3418           rem
3419           rem       table to map hdlc status to wait block status
3420           rem
3421 hdcsts    smap      hs.tro,s.exh
3422           smap      hs.isd,s.isd
3423           smap      hs.xte,s.xte
3424           smap      hs.fce,s.fcse
3425           smap      hs.rab,s.rabt
3426           smap      0,0
3427           smap      hs.byt,s.pbyt
3428           smap      hs.rbt,s.rbt
3429 hdcend    equ       *
3430           ttls      hstprc - hsla status processor
3431           eject
3432 stp060    lda       stpswd-*  get status word
3433           cana      l.e020-*  (=hs.per) parity error ?
3434           tze       stp062-*  no
3435           rem
3436           lda       t.stat,1  get tib status
3437           iana      s.dss     leave only interesting bits
3438           ora       l.e021-*  (=s.prty) set parity error status
3439           tsy       a.e004-*,*          (=istat) call interpreter
3440           rem
3441 stp062    ldx3      a.e002-*  (=istats) get status table ptr
3442           lda       stpswd-*  get the status word
3443 stp065    cana      0,3       is this status bit on?
3444           tnz       stp070-*  yes, call that routine
3445           rem
3446           iacx3     2         bump the ptr to next entry
3447           cmpx3     a.e003-*  (=iends) end of table?
3448           tnz       stp065-*  no, continue loop
3449           rem
3450           tra       stp080-*  continue status processing
3451           rem
3452 stp070    lda       1,3       get the routine to call
3453           sta       stptra-*  save this addr
3454           lda       stpbuf-*  get pointer to the current buffer
3455           tsy       a.e025-*,*          setbpt
3456           cax3
3457           tsy       stptra-*,*          go call that routine
3458           rem
3459           lda       stpswd-*  get status word
3460           cana      l.e010-*  (=hs.nms) was it marker status?
3461           tze       stp075-*  no, continue
3462           rem
3463           cana      l.e011-*  (=hs.ptr) ptro status also?
3464           tze       stp075-*  no
3465           rem
3466           tsy       a.e010-*,*          (=ipptro) process the ptro
3467           rem
3468 stp075    lda       stpswd-*  get the status word
3469           cana      l.e004-*  (=hs.siw) switching icw's?
3470           tze       stp095-*  no, continue
3471           rem
3472           ila       sffcii    get the icw indicator bit
3473           ersa      sf.flg,2  and flip the bit in flag word
3474           tra       stp095-*  finish the status processing
3475           rem
3476 stp080    lda       l.e009-*  (=sffstp) get the stop channel bit
3477           cana      sf.flg,2  did we just reset xmit mode?
3478           tze       stp090-*  no, done
3479           rem
3480           iera      -1        invert the bit
3481           ansa      sf.flg,2  and turn it off in the sfcm
3482           rem
3483           stz       sf.ob0,2  zero ptrs in case we
3484           stz       sf.ob1,2  just did a stop channel
3485           rem
3486           ldx3      sf.hcm,2  get ptr to hwcm
3487           lda       l.e008-*  (=410000) get the exhaust bit
3488           sta       h.sic0+1,3          store in both icws to
3489           sta       h.sic1+1,3          make sure hsla does not use again
3490           rem
3491 stp090    lda       stpswd-*  get the status word
3492           cana      l.e004-*  (=hs.siw) are we switching icw's?
3493           tze       stp092-*  no, continue
3494           rem
3495           ila       sffcii    get the icw bit
3496           ersa      sf.flg,2  invert it now
3497           rem
3498 stp092    lda       sf.flg,2  get sfcm flag bits
3499           icana     sffech    is echo in progress now?
3500           tnz       stp095-*  yes, skip it
3501           rem
3502           lda       sf.pcw,2  get pcw bits
3503           icana     pb.xmt    are we in xmit mode?
3504           tnz       stp095-*  yes, can't echo now
3505           rem
3506           tsy       a.e012-*,*          (=echock) check about echoing now
3507           tra       stp095-*  win, we started to echo
3508           tra       stp095-*  but who cares anyway.
3509           rem
3510 stp095    lda       stpmrk-*  any requested status?
3511           tze       stp200-*  no, continue
3512           cana      l.e005-*  (=tsfmrk+tsftrm) marker or terminate?
3513           tze       stp096-*  no
3514           rem
3515 *         only do terminate and/or marker status if hardware status agrees
3516 *         with tib status with respect to recieve and transmit modes
3517           rem
3518           lda       t.stat,1  pick up tib status
3519           als       1         line up tib rcv bit with hw rcv bit
3520           era       stpswd+1-*          get xor of rcv bits
3521           ana       l.e015-*  (=hs.rcv) isolate result
3522           tnz       stp096-*  bits were different
3523           lda       t.stat,1  get tib status bits again
3524           ars       1         line up xmt bits
3525           era       stpswd+1-*
3526           ana       l.e016-*  isolate xor of xmt bits
3527           tnz       stp096-*  bits were different
3528           rem
3529           lda       t.stat,1  get tib status
3530           iana      s.dss     but only the ones we want
3531           ora       stpmrk-*  get requested status bits
3532           ana       l.e003-*  (=/tsfst) but turn off this one
3533           caq                 save status bits
3534           lda       l.e005-*  (=tsfmrk+tsftrm)
3535           iera      -1        invert bits
3536           ansa      stpmrk-*  turn off marker and terminate
3537           cqa                 get saved status back in a
3538           rem
3539           tsy       a.e004-*,*          (=istat) call intrp to process status
3540           tra       stp200-*  done with rcv status
3541           rem
3542 stp096    lda       stpmrk-*
3543           cana      l.e012-*  (=tsfst) requested status?
3544           tze       stp200-*  no, all done with status
3545           rem
3546           lda       l.e012-*  (=tsfst) get the bit
3547           iera      -1        invert it
3548           ansa      stpmrk-*  turn it off
3549           rem
3550           aos       a.e011-*,*          (=dssflg) set flag to ipdss
3551           rem                 to indicate requested status
3552           tsy       a.e009-*,*          (=ipdss) process status
3553           tra       stp200-*  done
3554           eject
3555           rem       output status processor
3556           rem
3557 stp100    lda       stpswd-*  get the status word
3558           ars       11        align the icw bits
3559           era       sf.flg,2  leave only the one we want
3560           icana     sffcoi    should not be on!
3561           tze       stp105-*  good, all ok
3562           rem
3563           trace     tt.ira,ts.sta,(stptib) trace recovery try
3564           rem
3565           ldx3      sf.ob0,2  recover output buffers
3566           lda       sf.flg,2  get flags
3567           icana     sffcoi    alt output bfr?
3568           tze       2         no
3569           ldx3      sf.ob1,2  yes, get it
3570           rem
3571           cx3a                set indicators
3572           tze       stp101-*  no buffer
3573           rem
3574           tsy       a.e025-*,*          setbpt
3575           cax3                now we have virtual address
3576           tsy       a.e014-*,*          (=opptro) simulate ptro on buffer
3577           tra       stp105-*  it flipped indicator for us
3578           rem
3579 stp101    ila       sffcoi    get bit
3580           ersa      sf.flg,2  flip it
3581           rem
3582 stp105    ldx3      sf.ob0,2  get the current output buffer ptr
3583           lda       sf.flg,2  get the sfcm flags
3584           icana     sffcoi    are we using alternate icw?
3585           tze       stp110-*  no, primary in use
3586           ldx3      sf.ob1,2  get the alternate buf ptr
3587           rem
3588 stp110    stx3      stpbuf-*  save the buffer ptr
3589           ldx3      a.e005-*  (=ostats) get ptr to table of status
3590           rem
3591 stp120    lda       stpswd-*  get the status word
3592           cana      0,3       is this bit on?
3593           tnz       stp130-*  yes, call routine
3594           rem
3595           iacx3     2         increment ptr
3596           cmpx3     a.e006-*  (=oends) end of table?
3597           tnz       stp120-*  no, loop more
3598           rem
3599           lda       stpswd-*  get status word
3600           cana      l.e004-*  (=hs.siw) are we switching send icw's?
3601           tze       3         skip if not
3602           ila       sffcoi    get bit
3603           ersa      sf.flg,2  flip it
3604           tra       stp200-*  yes, all done
3605           rem
3606 stp130    lda       1,3       get addr of routine to call
3607           sta       stptra-*  save it
3608           lda       stpbuf-*  get buffer addr
3609           tsy       a.e025-*,*          setbpt
3610           cax3                now we have virtual address
3611           tsy       stptra-*,*          go to routine
3612           rem
3613           eject
3614 stp200    ila       hs.sqo
3615           cana      a.f008-*,*          (stpswd) status queue overflow ?
3616           tze       stp205-*  no
3617           rem
3618           lda       l.e013-*  (=/sffsqo)
3619           ansa      sf.flg,2  turn off status queue overflow flag
3620           rem
3621           lda       t.stat,1  get tib status bits
3622           iana      s.dss     but only the ones we want
3623           ora       l.e017-*  (=s.xte) set xte status
3624           tsy       a.e004-*,*          (=istat) call interpreter
3625           rem
3626 stp205    lda       a.f009-*,*          (stpmrk) in case requested status not performed
3627           orsa      t.stat,1  put back for next time
3628           lda       sf.tly,2  get the wrap around queue tally
3629           cmpa      sf.ssl,2  is queue empty?
3630           tnz       a.e018-*,*          (stp010) no, more status to be processed
3631           rem
3632 stp210    ila       sffskd    get the sCked flag
3633           iera      -1        invert it
3634           ansa      sf.flg,2  and store it into sfcm
3635           rem
3636           lda       sf.tly,2  tally still at max?
3637           cmpa      sf.ssl,2  well?
3638           tnz       a.e018-*,*          (=stp010) nope, process more status
3639           stz       sf.rct,2  zero sqo repeat count
3640           rem
3641           lda       a.f008-*,*          (=stpswd) get the status word
3642           cana      l.f008-*  (=hs.rcs) is this receive status?
3643           tze       stpret-*  nope, done
3644           rem
3645           szn       sf.ob0,2  are both of the output buffers gone yet?
3646           tnz       stpret-*  not first one
3647           szn       sf.ob1,2  second?
3648           tnz       stpret-*  nope, done
3649           rem
3650           lda       t.flg,1   is output suspended?
3651           cana      l.f012-*  =tfosus
3652           tnz       stpret-*  yes, we'l pick up rest of dcw list later
3653           rem
3654           lda       l.f009-*  (=sffhdl)
3655           cana      sf.flg,2  skip this for HDLC lines
3656           tnz       stpret-*
3657           rem
3658           lda       t.dcwl,1  is there a dcw list?
3659           tze       stpret-*  nope, done
3660           rem
3661           tsy       a.f011-*,*          (=hdcw) call the dcw list processor
3662           rem
3663 stpret    tra       a.f012-*,*          (=secdsp) return to secondary dispatcher
3664           rem
3665           rem
3666           ttls      dmpbuf - proc to dump input buffers when we exit rcv
3667 dmpbuf    subr      dmp,(x1,x2,x3)
3668           rem
3669 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3670 *
3671 *         dmpbuf
3672 *
3673 *              proc to dump the input buffers when we leave
3674 *         receive mode. If there is any input in the current
3675 *         input buffer, we will chain it onto the input
3676 *         chain, otherwise we will just free the buffers.
3677 *
3678 *         upon entry:
3679 *              x1 - virtual tib address
3680 *              x2 - virtual sfcm address
3681 *
3682 *         returns:
3683 *
3684 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3685           rem
3686           szn       sf.ib0,2  look to see if the buffers are already gone.
3687           tnz       dmp005-*  first one isn't, proceed
3688           szn       sf.ib1,2  it is, what about second?
3689           tze       dmpret-*  yes, all done
3690           rem
3691 dmp005    tsy       a.f004-*,*          (=gettly) get current buffer tally & addr
3692           sta       dmptmp-*  save buffer tally
3693           cx3a                is there a buffer ?
3694           tze       dmp050-*  no, skip null buffer
3695           lda       sf.flg,2  synchronous line?
3696           cana      l.f006-*  sffsyn
3697           tze       dmp010-*  no
3698           cx3a                yes, back to beginning of buffer
3699           sba       l.f007-*  bf.dta,b.0
3700           cax3
3701           tra       dmp020-*
3702 dmp010    null                asynchronous pseudo-buffer
3703           cx3a                just wipe out char. addressing
3704           ana       l.f001-*  =o077777
3705           cax3
3706 dmp020    szn       dmptmp-*  zero tally?
3707           tze       dmp040-*  yes, free buffer
3708           rem
3709           lda       sf.flg,2  synchronous?
3710           cana      l.f006-*  =sffsyn
3711           tnz       dmp030-*  yes, copy to input chain
3712           tsy       a.f003-*,*          (=scan) else scan chars
3713           stz       sf.nic,2  make sure next scan starts clean
3714           tra       dmp040-*  scan took care of copying to input chain
3715           rem
3716 dmp030    lda       l.f002-*  (=buftmk) get tally mask
3717           iera      -1        invert mask
3718           ansa      bf.tly,3  zero tally field
3719           lda       dmptmp-*  get back buffer tally
3720           orsa      bf.tly,3  put tally in buffer
3721           rem
3722           tsy       a.f002-*,*          (=parity) strip off parity bits
3723           rem
3724           tsy       a.f005-*,*          (=ichain) put buffer on input chain
3725           tra       dmp050-*  free second buffer
3726           rem
3727 dmp040    tsy       fribuf-*
3728           rem
3729 dmp050    cx3a
3730           tsy       a.f007-*,*          cvabs
3731           rem                 we need absolute address for this
3732           cmpa      sf.ib0,2  primary buffer addr in x3 ?
3733           tze       3         yes
3734           lda       sf.ib0,2  no, get primary buffer addr
3735           tra       2
3736           lda       sf.ib1,2  get alt. buffer addr
3737           tze       dmp060-*  skip null buffer
3738           tsy       a.f010-*,*          setbpt
3739           cax3                fribuf wants virtual address
3740           tsy       fribuf-*  free the buffer
3741           rem
3742 dmp060    stz       sf.ib0,2  zero the buffer ptrs
3743           stz       sf.ib1,2
3744           rem
3745 dmpret    return    dmpbuf    all done
3746           rem
3747           rem
3748           rem
3749           rem
3750 fribuf    subr      fri,(x3)  free an input buffer for dmpbuf
3751           rem
3752           lda       sf.flg,2  synchronous?
3753           cana      l.f006-*  =sffsyn
3754           tze       fri005-*  no
3755           cx3a                yes, get absolute address
3756           tsy       a.f007-*,*          cvabs
3757           tra       fri030-*  and free it
3758 fri005    cx3a                else find out if it's one of the permanent ones
3759           tsy       a.f007-*,*          cvabs
3760           cmpa      t.abf0,1  is it first one?
3761           tnz       fri010-*  no
3762           lda       l.f010-*  (tfabf0) yes
3763           orsa      t.flg3,1  mark it available
3764           tra       fribak-*  done
3765 fri010    cmpa      t.abf1,1  is it the other one?
3766           tnz       fri020-*  no, free it
3767           lda       l.f011-*  tfabf1
3768           orsa      t.flg3,1  mark 2nd one available
3769           tra       fribak-*
3770 fri020    ldq       0,3       else get size out of buffer
3771           qrl       9
3772           tra       fri040-*
3773           rem
3774 fri030    ilq       0         let frebfh determine size
3775 fri040    tsy       a.f001-*,*          frebfh
3776 fribak    return    fribuf
3777           rem
3778           rem
3779 dmptmp    bss       1
3780           rem
3781           rem
3782 l.f001    oct       077777
3783 l.f002    vfd       18/buftmk
3784 l.f003    vfd       18/tflfec+tfcrec+tftbec
3785 l.f004    vfd       18/s.prex
3786 l.f005    vfd       18/s.exh
3787 l.f006    vfd       18/sffsyn
3788 l.f007    zero      bf.dta,b.0
3789 l.f008    vfd       18/hs.rcs
3790 l.f009    vfd       18/sffhdl
3791 l.f010    vfd       18/tfabf0
3792 l.f011    vfd       18/tfabf1
3793 l.f012    vfd       18/tfosus
3794           rem
3795 a.f001    ind       frebfh
3796 a.f002    ind       parity
3797 a.f003    ind       scan
3798 a.f004    ind       gettly
3799 a.f005    ind       ichain
3800 a.f006    ind       istat
3801 a.f007    ind       cvabs
3802 a.f008    ind       stpswd
3803 a.f009    ind       stpmrk
3804 a.f010    ind       setbpt
3805 a.f011    ind       hdcw
3806 a.f012    ind       secdsp
3807           ttls      addbuf - add buffer to input chain
3808 addbuf    subr      abf
3809           rem
3810 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3811 *
3812 *         addbuf
3813 *
3814 *         adds a buffer to the end of the input chain and
3815 *         signals pre-exhaust and/or exhaust status if
3816 *         appropriate.
3817 *
3818 *         upon entry:
3819 *              x1 - virtual tib address
3820 *              x2 - virtual sfcm address
3821 *              x3 - buffer to be added to input chain
3822 *
3823 *         returns:
3824 *
3825 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3826           rem
3827           tsy       ichain-*  thread buffer onto input chain
3828           rem
3829           lda       sf.flg,2  get sfcm flags
3830           cana      l.f006-*  (=sffsyn) synch line ?
3831           tnz       abf010-*  yes, don't check pre-exhaust
3832           rem
3833           lda       t.icpl,1  get input chain length
3834           icmpa     10        at pre-exhaust limit ?
3835           tmi       abf011-*  no
3836           rem
3837           lda       t.stat,1  get tib status
3838           iana      s.dss     relevant bits only
3839           ora       l.f004-*  (=s.prex) set pre-exhaust status
3840           tsy       a.f006-*,*          (=istat) call interpreter
3841           rem
3842 abf010    null
3843           lda       l.f009-*  (=sffhdl)
3844           cana      sf.flg,2  is it HDLC?
3845           tnz       abfret-*  don't check for exaust
3846           rem
3847           lda       t.icpl,1  get input chain length again
3848 abf011    ada       t.dcpl,1  get total input buffer usage
3849           icmpa     40        at exhaust limit ?
3850           tmi       abfret-*  no, done
3851           rem
3852           lda       t.stat,1  get tib status
3853           iana      s.dss     relevant bits only
3854           ora       l.f005-*  (=s.exh) set exhaust status
3855           tsy       a.f006-*,*          (=istat) call interpreter
3856           rem
3857 abfret    return    addbuf
3858           ttls      ichain - thread buffer onto input chain
3859 ichain    subr      ich,(x2,x3)
3860           rem
3861 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3862 *
3863 *         ichain
3864 *
3865 *         threads a buffer onto the end of the input chain
3866 *         and updates the chain length (t.icpl)
3867 *
3868 *         upon entry:
3869 *              x1 - virtual tib address
3870 *              x3 - virtual address of buffer to be threaded
3871 *                   onto input chain
3872 *
3873 *         returns:
3874 *
3875 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3876           rem
3877           cx3a
3878           tsy       a.g006-*,*          (cvabs) get absolute address
3879           szn       t.ilst,1  any input chain ?
3880           tnz       ich010-*  yes
3881           rem
3882           sta       t.icp,1   start a new chain
3883           sta       t.ilst,1  end a new chain
3884           tra       ich020-*
3885           rem
3886 ich010    caq                 safe store
3887           lda       t.ilst,1  get addr of last buffer
3888           tsy       a.g007-*,*          setbpt
3889           cax2                virtual address into x2
3890           stq       bf.nxt,2  thread on new last buffer
3891           stq       t.ilst,1  update last ptr
3892           cqa                 set up pte for last buffer again
3893           tsy       a.g007-*,*          (address is already in x3)
3894           rem
3895 ich020    lda       bf.siz,3  get buffer size code
3896           arl       15        right adjust
3897           iaa       1         get true block count
3898           asa       t.icpl,1  update input chain length
3899           rem
3900           return    ichain
3901           ttls      ipterm - process input terminate status
3902 ipterm    subr      trm,(x1,x2,x3)
3903           rem
3904 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3905 *
3906 *         ipterm
3907 *
3908 *              process the input terminate status. this will
3909 *         be stored as a result of a user typing nis break
3910 *         character, and can only mean that it is time to
3911 *         ship his data to the cs.
3912 *
3913 *         upon entry:
3914 *              x1 - virtual tib address
3915 *              x2 - virtual sfcm address
3916 *              x3 - points to the current buffer
3917 *
3918 *         returns:
3919 *
3920 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3921           rem
3922           lda       l.g001-*  (=bffbrk) get the break bit
3923           orsa      bf.flg,3  turn it on in the buffer
3924           rem
3925           lda       sf.flg,2  synchronous line?
3926           cana      l.g004-*  =sffsyn
3927           tnz       trm010-*  no, don't bother scanning
3928           rem
3929           tsy       a.g005-*,*          (=scan) scan the input
3930           rem
3931 trm010    tsy       a.g002-*,*          (=setnib) setup new input buffer
3932           rem
3933           lda       sf.flg,2  synchronous?
3934           cana      l.g004-*  =sffsyn
3935           tze       trm020-*  no, scan took care of input chain
3936           tsy       a.g003-*,*          (=parity) strip off parity
3937           tsy       a.g008-*,*          (=addbuf) add buffer to input chain
3938           rem
3939 trm020    lda       t.stat,1  get the tib status bits
3940           iana      s.dss     but only the ones we want
3941           ora       l.g002-*  s.brch
3942           tsy       a.g001-*,*          (=istat) call status processor
3943           rem
3944           return    ipterm
3945           rem
3946 l.g001    vfd       18/bffbrk
3947 l.g002    vfd       18/s.brch
3948 l.g003    vfd       o18//sffmsp
3949 l.g004    vfd       18/sffsyn
3950           rem
3951 a.g001    ind       istat
3952 a.g002    ind       setnib
3953 a.g003    ind       parity
3954 a.g005    ind       scan
3955 a.g006    ind       cvabs
3956 a.g007    ind       setbpt
3957 a.g008    ind       addbuf
3958           ttls      ipmark - process input marker status
3959 ipmark    subr      mrk,(x1,x2,x3)
3960           rem
3961 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3962 *
3963 *         ipmark
3964 *
3965 *         process input marker status indicating one or more
3966 *         of the following events:
3967 *
3968 *         - any char received in echoplex or breakall mode
3969 *
3970 *         - tab received in tabecho mode
3971 *
3972 *         - frame begin char received in frame input mode
3973 *
3974 *         - any break character received
3975 *
3976 *         upon entry:
3977 *              x1 - virtual tib address
3978 *              x2 - virtual sfcm address
3979 *              x3 - points to buffer
3980 *
3981 *         returns:
3982 *
3983 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3984           rem
3985           lda       l.g003-*  =^sffmsp
3986           ansa      sf.flg,2  indicate no marker pending
3987           rem
3988           tsy       a.g005-*,*          (=scan) scan the input
3989           rem
3990           return    ipmark
3991           rem
3992           ttls      ipbfsw - process buffer switch for bisync and hdlc
3993 ipbfsw    subr      bsw
3994           rem
3995 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3996 *
3997 *         ipbfsw
3998 *
3999 *              process buffer switch for bisync and hdlc channels
4000 *
4001 *         upon entry:
4002 *              x1 - points to tib
4003 *              x2 - points to sfcm
4004 *              x3 - points to the current buffer (virtual address)
4005 *
4006 *         returns:
4007 *
4008 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4009           rem
4010           tsy       a.i008-*,*          (=parity) strip all parity
4011           rem
4012           tsy       a.i009-*,*          (=addbuf) add buffer to input chain
4013           stz       a.x001-*,*          *=bftsa  all finished, clear it
4014           ldx3      a.x002-*,*          *=bftx3 buffer address pointer
4015           stz       2,3
4016           stz       a.x002-*,*          *=bftx3 clear up old buffer address
4017           rem
4018 bswret    return    ipbfsw
4019 a.x001    ind       bftsa
4020 a.x002    ind       bftx3
4021           ttls      swphic - switch preallocated icw s
4022 **********************************************************************
4023 *
4024 *         swphic - switch with preallocated buffer for icw
4025 *
4026 *         This routine will start the icw switching process using
4027 *         the preallocated buffer pools. It sets up the registers
4028 *         and other variables to complete the switch. It will store
4029 *         the buffer in the software com area; it will not add it to
4030 *         the input chain in the tib.
4031 *
4032 *         upon entry:
4033 *          x1 - tib
4034 *          x2 - sfcm
4035 *
4036 *         returns:
4037 *
4038 *         Coded by D. W. Cousins for icw switch problem
4039 *
4040 **********************************************************************
4041 swphic    subr      swp,(i,x2,x3)
4042           cx2a                *get address of sfcm into a
4043           caq                 *place it into q
4044           iaq       sf.ib0    *add in offset
4045           lda       sf.flg,2  *get software flags
4046           sta       sfflag-*  *store them for later
4047           ana       l.y001-*  *=^sfcii mask
4048           sta       sf.flg,2
4049           lda       sf.nxa,2* *load the status word
4050           arl       12
4051           iana      sffcii    *mask all bits ecept alt icw
4052           orsa      sf.flg,2  *this should work
4053           lda       sf.flg,2  *get the flags for test
4054           icana     sffcii    *alternate buffer
4055           tze       2         *no
4056           iaq       sf.ib1-sf.ib0       *change offset
4057           stq       sfptr-*   *save it tempory
4058           ldq       sfptr-*,* *load the buffer address
4059           ldx3      sf.nxa,2  *load current ptr to status
4060           stq       2,3       *store buffer after the status
4061           lda       sf.bsz,2  *get this line buffer size
4062           ars       5         *get table index
4063           iaa       -1
4064           cax2
4065           inh
4066           ldq       a.y001-*,*          (=pchtbl,2) get the buffer address
4067           tze       swp010-*  no buffer
4068           ila       -1
4069           asa       a.y002-*,*          (=pchlft,2) reduce buffer total
4070           cqa
4071           sta       swpabs-*  save it for later
4072           tsy       a.y003-*,*          (setbpt)
4073           cax3                place virtual address into x3
4074           ldq       bf.nxt,3  get next address
4075           stq       a.y001-*,*          (=pchtbl,2) put it as the head
4076           ldi       swpsi-*
4077           stz       bf.nxt,3  zero next buffer pointer
4078           lda       bf.tly,3  get it tally
4079           ana       l.f002-*  =buftmk mask the tally
4080           caq                 place it in q
4081           ldx2      t.sfcm,1  get sfcm again
4082           lda       l.y002-*  =sffnib
4083           iera      -1
4084           ansa      sf.flg,2
4085           ansa      sfflag-*  *save it here also
4086           lda       swpabs-*  get absolute address back
4087           sta       sfptr-*,*
4088           rem
4089           stq       swpq-*    hang on to size
4090           smeter    mincd,.mupab,l.y003-*
4091           tra       swp020-*
4092           rem
4093 swp010    ila       0
4094           ldx2      t.sfcm,1  get sfcm again
4095           ldi       swpsi-*   restore interrupt state
4096           stz       sfptr-*,*
4097           cax3
4098           rem
4099           stq       swpq-*    hang on to size
4100           smeter    mincd,.mpanf,l.y003-*
4101           rem
4102 swp020    ldq       swpq-*
4103           tsy       nibicw-*
4104           lda       sfflag-*  *return old sf.flg
4105           sta       sf.flg,2
4106           return    swphic
4107           rem
4108 a.y001    ind       pchtbl,2
4109 a.y002    ind       pchlft,2
4110 a.y003    ind       setbpt
4111           rem
4112 l.y001    vfd       o18//sffcii
4113 l.y002    vfd       18/sffnib
4114 l.y003    dec       1
4115           rem
4116 sfflag    bss       1
4117 sfptr     bss       1
4118 swpq      bss       1
4119 swpabs    bss       1
4120           ttls      ipxte - process input transfer timing error
4121 ipxte     subr      ixt,(x1,x2,x3)
4122           rem
4123 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4124 *
4125 *         ipxte
4126 *
4127 *              process transfer timing errors. currently we
4128 *         will not expect these, and will crash on any.
4129 *
4130 *         upon entry:
4131 *
4132 *         returns:
4133 *
4134 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4135           rem
4136           die       4
4137           rem
4138           return    ipxte
4139           ttls      ipptro - process input pre-tally runout
4140 ipptro    subr      ipt,(x1,x2,x3)
4141           rem
4142 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4143 *
4144 *         ipptro
4145 *
4146 *              process input pre-tally runout status. this
4147 *         status is stored just before we switch to a new input
4148 *         buffer, and the old one should be put onto the input
4149 *         chain.
4150 *
4151 *         upon entry:
4152 *              x1 - virtual tib address
4153 *              x2 - virtual sfcm address
4154 *              x3 - points to the buffer
4155 *
4156 *         returns:
4157 *              with a new input buffer setup
4158 *
4159 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4160           rem
4161           lda       sf.flg,2  synchronous line?
4162           cana      l.i001-*  =sffsyn
4163           tnz       ipt010-*  yes, copy buffer directly to chain
4164           rem
4165           tsy       a.i001-*,*          (=scan) scan rest of input data
4166           tra       ipt030-*
4167           rem
4168 ipt010    tsy       a.i008-*,*          (=parity) remove parity bits
4169           tsy       a.i009-*,*          (=addbuf) add buffer to input chain
4170           rem
4171 ipt030    tsy       a.i005-*,*          (=setnib) setup new input buffer
4172           rem
4173           return    ipptro    bye
4174           ttls      iptro - process input tally runout
4175 iptro     subr      itr,(x1,x2,x3)
4176           rem
4177 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4178 *
4179 *         iptro
4180 *
4181 *              processs input tally runout status. this indicates
4182 *         an attempt to use an exhausted icw.  this could occur
4183 *         either because there was not enough time to set up a new
4184 *         buffer or because no buffer was available.  the latter
4185 *         case is indicated by a zero buffer address.  in this case,
4186 *         we signal exhaust status to the interpreter.  in the
4187 *         former case, we signal transfer timing error (xte) status.
4188 *
4189 *         upon entry:
4190 *              x1 - virtual tib address
4191 *              x2 - virtual sfcm address
4192 *              x3 - points to buffer
4193 *
4194 *         returns:
4195 *
4196 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4197           rem
4198           lda       t.stat,1  get tib status bits
4199           iana      s.dss     but only the ones we want
4200           rem
4201           iacx3     0         do we have a buffer?
4202           tze       3         no
4203           ora       l.i003-*  (=s.xte) set xte status
4204           tra       2
4205           ora       l.i009-*  (=s.exh) set exhaust status
4206           rem
4207           tsy       a.i004-*,*          (=istat) call interpreter
4208           rem
4209           return    iptro     all done
4210           rem
4211           rem
4212 l.i001    vfd       18/sffsyn
4213 *l.i002
4214 l.i003    vfd       18/s.xte
4215 *l.i004
4216 *l.i005             unused
4217 l.i006    vfd       18/tfecpx+tftbec
4218 *l.i007             unused
4219 l.i009    vfd       18/s.exh
4220           eject
4221 a.i001    ind       scan
4222 *a.i002
4223 *a.i003
4224 a.i004    ind       istat
4225 a.i005    ind       setnib
4226 *a.i007
4227 a.i008    ind       parity
4228 a.i009    ind       addbuf
4229           ttls      ipdss - process data set status change
4230 ipdss     subr      ids,(x1,x2,x3)
4231           rem
4232 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4233 *
4234 *         ipdss
4235 *
4236 *              process data set status changes. record the
4237 *         change and inform the control_tables.
4238 *
4239 *         upon entry:
4240 *              x1 - virtual tib address
4241 *              x2 - virtual sfcm address
4242 *              lower 18 bits of status in stpswd+1
4243 *
4244 *         returns:
4245 *
4246 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4247           rem
4248           stz       idsst-*   zero current status word
4249           ldx3      a.j002-*  (=hstat) get the address of the table
4250           rem
4251           lda       t.flg2,1  are we dialing out?
4252           cana      l.j002-*  =tfacu
4253           tnz       ids010-*  yes
4254           rem                 else we'll have to mask off acu bits
4255           lda       l.j003-*  ^hs.dlo & ^hs.pwi
4256           ansa      a.j006-*,*          =stpswd
4257           lda       l.j004-*  ^hs.ads & ^hs.acr
4258           ansa      a.j001-*,*          =stpswd+1
4259           rem
4260 ids010    lda       a.j001-*,*          (=stpswd+1) get the status word
4261           cana      0,3       is this a match?
4262           tze       ids020-*  no, keep looking
4263           rem
4264           lda       1,3       get the bit to set
4265           orsa      idsst-*   or into saved status
4266           rem
4267 ids020    iacx3     2         increment to next entry
4268           cmpx3     a.j003-*  (=ehstat) end of table?
4269           tnz       ids010-*  no, continue
4270           rem
4271           ldx3      a.j005-*  (=h1stat) get the address of the table for first
4272           rem
4273 ids030    lda       a.j006-*,*          (=stpswd) get the status word
4274           cana      0,3       is this a match
4275           tze       ids040-*  no, skip it
4276           rem
4277           lda       1,3       get the bit to set
4278           orsa      idsst-*   or into saved status
4279           rem
4280 ids040    iacx3     2         increment to next entry
4281           cmpx3     a.j007-*  (=endh1) end of table?
4282           tnz       ids030-*  no, continue
4283           rem
4284           ila       0         zero the a reg
4285           szn       dssflg-*  requested status?
4286           tze       2         no
4287           rem
4288           lda       l.j001-*  (=s.st) get status bit
4289           stz       dssflg-*  clear flag
4290           rem
4291           ora       idsst-*   get new data set status
4292           tsy       a.j004-*,*          (=istat) call interpreter w/status
4293           rem
4294           rem                 if this was line break, and output is suspended,
4295           rem                 resume it
4296           lda       idsst-*   get status flags
4297           cana      l.j005-*  =s.brk
4298           tze       ids050-*  wasn't line break, never mind
4299           lda       t.flg,1   was output suspended?
4300           cana      l.j006-*  =tfosus
4301           tze       ids050-*  no, don't worry about it
4302           tsy       a.j008-*,*          (resout) start output going again
4303 ids050    null
4304           ila       15        (=o17) mask for common bits
4305           rem                 cd+cts+dsr+src
4306           ansa      idsst-*   leave only those bits now
4307           iera      -1        flip over the mask
4308           ansa      t.stat,1  turn off the bits in the tib
4309           rem
4310           lda       idsst-*   get the real status bits
4311           orsa      t.stat,1  and turn only those on in the tib
4312           rem
4313           return    ipdss     all done
4314           rem
4315           rem
4316 idsst     bss       1         (altrd) loc for current dataset status
4317 dssflg    oct       0         (altrd) flag to indicate requested status
4318           rem
4319 hstat     smap      hs.dsr,s.dsr
4320           smap      hs.cts,s.cts
4321           smap      hs.cd,s.cd
4322           smap      hs.src,s.sprc
4323           smap      hs.ri,s.ring
4324           smap      hs.brk,s.brk
4325           smap      hs.acr,s.acr
4326           smap      hs.ads,s.ads
4327 ehstat    equ       *
4328           rem
4329 h1stat    smap      hs.dlo,s.dlo
4330           smap      hs.pwi,s.pwi
4331 endh1     equ       *
4332           rem
4333           rem
4334 l.j001    vfd       18/s.st
4335 l.j002    vfd       18/tfacu
4336 l.j003    vfd       o18//hs.dlo*/hs.pwi   ^(acu bits in first word)
4337 l.j004    vfd       o18//hs.acr*/hs.ads   ^(acu bits in second word)
4338 l.j005    vfd       18/s.brk
4339 l.j006    vfd       18/tfosus
4340           rem
4341 a.j001    ind       stpswd+1  status save word
4342 a.j002    ind       hstat
4343 a.j003    ind       ehstat
4344 a.j004    ind       istat
4345 a.j005    ind       h1stat
4346 a.j006    ind       stpswd
4347 a.j007    ind       endh1
4348 a.j008    ind       resout
4349           ttls      setnib - setup new input buffer
4350 setnib    subr      snb,(x1,x2,x3)
4351           rem
4352 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4353 *
4354 *         setnib
4355 *
4356 *              setup a new input buffer for the channel. the
4357 *         buffer will be allocated, and the icw setup
4358 *         ready to be used by the channel.
4359 *
4360 *         upon entry:
4361 *              x1 - virtual tib address
4362 *              x2 - virtual sfcm address
4363 *
4364 *         returns:
4365 *
4366 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4367           rem
4368           ldx3      a.h004-*,*          .crbpe
4369           lda       0,3       have to save buffer pte
4370           sta       snbpte-*
4371           rem
4372           cx2a                get sfcm addr into a
4373           caq                 now into the q
4374           iaq       sf.ib0    add in offset
4375           rem
4376           lda       sf.flg,2  get the flags
4377           icana     sffcii    alternate buffer?
4378           tze       snb010-*  no,
4379           rem
4380           iaq       sf.ib1-sf.ib0       change offset
4381           rem
4382 snb010    stq       snbptr-*  save the ptr
4383           rem
4384           lda       sf.flg,2  synchronous line?
4385           cana      l.h001-*  =sffsyn
4386           tnz       snb030-*  yes, always allocate afresh
4387           stz       sf.nic,2  async, clear current char. pointer
4388           lda       snbptr-*,*          is there one now?
4389           tze       snb030-*  no, we'll have to allocate one
4390           tsy       a.h003-*,*          (setbpt) yes, get virtual address
4391           cax3
4392           lda       sf.flg,2  get flag word back
4393           cana      l.h003-*  (sffnib) are we supposed to allocate one anyway?
4394           tnz       snb020-*  yes
4395           ldq       0,3       get size of current one
4396           qrl       9
4397           cmpq      sf.csz,2  is it correct?
4398           tnz       snb025-*  no
4399           qls       1         yes, convert it to characters
4400           iaq       -3        allow for overhead (***two*** at end)
4401           tra       snb050-*
4402           rem
4403 snb020    ldq       0,3       make sure we have the size
4404           qrl       9
4405 snb025    lda       snbptr-*,*          find out if it's a permanent one
4406           cmpa      t.abf0,1
4407           tnz       snb027-*  not first one
4408           lda       l.h005-*  (tfabf0) yes, mark it available
4409           orsa      t.flg3,1
4410           tra       snb030-*
4411 snb027    cmpa      t.abf1,1  second one?
4412           tnz       snb028-*  no, it's allocated
4413           lda       l.h006-*  tfabf1
4414           orsa      t.flg3,1  mark it available
4415           tra       snb030-*  get new one
4416 snb028    tsy       a.h001-*,*          (frebfh) free the old one
4417           rem
4418 snb030    tsy       a.h007-*,*          (=ghibuf) get input buffer
4419           tra       snb040-*  error, cannot get buffer
4420           rem
4421           sta       snbptr-*,*          store the buffer ptr
4422           rem
4423           lda       l.h003-*  =sffnib
4424           iera      -1        turn it off
4425           ansa      sf.flg,2
4426           tra       snb050-*  continue
4427           rem
4428 snb040    stz       snbptr-*,*          no buffer, zero buffer ptr
4429           ila       0
4430           cax3                and x3 too
4431           rem
4432 snb050    tsy       nibicw-*  setup icw
4433           rem
4434           ldx3      a.h004-*,*          .crbpe
4435           lda       snbpte-*  get saved pte back
4436           sta       0,3       restore it
4437           return    setnib
4438           rem
4439 snbptr    bss       1         (altrd) pointer to current buf ptr
4440 snbpte    bss       1         saved copy of buffer pte
4441           ttls      nibicw - setup new input icw
4442 nibicw    subr      nib,(inh,q,x1,x2,x3)
4443           rem
4444 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4445 *
4446 *         nibicw
4447 *
4448 *              setup new icw for the input buffer which is
4449 *         being setup. the buffer addr is in x3, and sffcii
4450 *         tells us which icw to setup.
4451 *
4452 *         upon entry:
4453 *              x1 - virtual tib address
4454 *              x2 - virtual sfcm address
4455 *              x3 - virtual buffer address
4456 *              q - contains buffer tally
4457 *
4458 *         returns:
4459 *
4460 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4461           rem
4462           lda       sf.hcm,2  get the hwcm ptr
4463           rem
4464           iaa       h.ric0    get ptr to icw
4465           sta       nibiwp-*  save it in temp
4466           rem
4467           lda       sf.flg,2  get the flags
4468           icana     sffcii    alternate buffer?
4469           tze       nib010-*  no, go
4470           rem
4471           lda       nibiwp-*  get the ptr
4472           iaa       h.ric1-h.ric0       add offset
4473           sta       nibiwp-*  save it in temp
4474           rem
4475 nib010    ldx3      nibsx3-*  restor buffer ptr to x3
4476           tze       nib020-*  zero buffer addr, special case
4477           rem
4478           lda       sf.flg,2  synchronous?
4479           cana      l.h001-*  =sffsyn
4480           tze       nib015-*  no
4481           cx3a                get buffer ptr into a reg
4482           ada       l.h002-*  bf.dta,b.0
4483           tra       nib016-*
4484 nib015    cx3a                get buffer ptr into a reg
4485           ora       l.h004-*  (=0,b.1) async, start at second char
4486 nib016    ldx3      nibiwp-*  get ptr to icw in x3
4487           rem
4488           ldq       nibsq-*   get buffer tally
4489           tsy       a.h002-*,*          (bldicw) and store into icw
4490           tra       nibret-*  done
4491           rem
4492 nib020    lda       a.h008-*  (=bnispc) get addr of spare word
4493           ldq       l.h007-*  (=450000) get exhausted tally
4494           staq      nibiwp-*,*          set icw
4495           rem
4496 nibret    return    nibicw
4497           rem
4498 nibiwp    bss       1         (altrd) icw ptr
4499           eject
4500           rem
4501 l.h001    vfd       18/sffsyn
4502 l.h002    ind       bf.dta,b.0
4503 l.h003    vfd       18/sffnib
4504 l.h004    zero      0,b.1
4505 l.h005    vfd       18/tfabf0
4506 l.h006    vfd       18/tfabf1
4507 l.h007    oct       450000
4508           rem
4509 a.h001    ind       frebfh
4510 a.h002    ind       bldicw
4511 a.h003    ind       setbpt
4512 a.h004    ind       .crbpe
4513 *a.h005
4514 *a.h006
4515 a.h007    ind       ghibuf
4516 a.h008    ind       bnispc
4517           ttls      parity - strip parity bits off input characters
4518 parity    subr      par,(x1,x2,x3)
4519           rem
4520 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4521 *
4522 *         parity
4523 *
4524 *              parity will remove the parity bits from the
4525 *         input data. status will have noted any parity errors
4526 *         for us.
4527 *
4528 *         upon entry:
4529 *              x1 - virtual tib address
4530 *              x2 - virtual sfcm address
4531 *              x3 - virtual buffer address
4532 *
4533 *         returns:
4534 *
4535 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4536           rem
4537           lda       t.flg3,1  see if we should bother
4538           cana      l.m007-*  =tf8in
4539           tnz       par030-*  no, keeping all 8 bits
4540           rem
4541           cx3a
4542           cmpa      l.m009-*  (=1000(8)) bad?
4543           tpl       2         no, continue
4544           die       1         gotcha
4545           rem
4546           lda       t.flg3,1  see if parity should be kept
4547           cana      l.m010-*  =tfkpar
4548           tnz       par030-*  dont strip parity
4549           rem
4550           ldq       l.m001-*  (=177177) get parity bits
4551           rem
4552           lda       sf.flg,2  get sfcm flags
4553           icana     sffebd    ebcdic characters?
4554           tze       par010-*  no,
4555           rem
4556           ldq       l.m002-*  (=077077) get the ebcdic parity mask
4557           rem
4558 par010    lda       bf.tly,3  get the buffer tally
4559           ana       l.m003-*  (=buftmk) leave only tally
4560           iaa       1         add one
4561           ars       1         divide by two
4562           sta       parcnt-*  store it here
4563           ila       0         get a zero
4564           ssa       parcnt-*  makes it negative
4565           rem
4566           iacx3     bf.dta    point to data in buffer
4567           cqa                 put parity mask into a reg
4568           rem
4569 par020    ansa      0,3       mask parity bits
4570           iacx3     1         bump ptr
4571           aos       parcnt-*  decrement count
4572           tmi       par020-*  loop
4573           rem
4574 par030    return    parity
4575           rem
4576 parcnt    bss       1
4577           rem
4578 l.m001    vfd       o18/177177
4579 l.m002    vfd       o18/077077
4580 l.m003    vfd       18/buftmk
4581 l.m004    vfd       18/tflfec
4582 l.m005    ind       0,b.0
4583 l.m006    vfd       18/tftbec
4584 l.m007    vfd       18/tf8in
4585 l.m008    vfd       18/tffip
4586 l.m009    oct       1000
4587 l.m010    vfd       18/tfkpar
4588           rem
4589           ttls      outpar - output parity for ebcdic terminals
4590 outpar    subr      opr,(x3)
4591           rem
4592 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4593 *
4594 *         outpar
4595 *
4596 *              outpar generates parity bits on 6-bit ebcdic
4597 *         data. odd parity only.
4598 *
4599 *         upon entry:
4600 *              x2 - virtual sfcm address
4601 *              x3 - virtual buffer address
4602 *
4603 *         returns:
4604 *              parity bits in buffer
4605 *
4606 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4607           rem
4608           lda       sf.flg,2  get the sfcm flag bits
4609           icana     sffebd    edcbic data?
4610           tze       oprret-*  no
4611           rem
4612           lda       bf.tly,3  get the buffer tally
4613           ana       l.m003-*  (=buftmk) leave only tally
4614           sta       oprcnt-*  save
4615           ila       0
4616           ssa       oprcnt-*  make negative
4617           rem
4618           lda       oprsx3-*  reload x3 value
4619           ora       l.m005-*  (=char bits)
4620           iaa       bf.dta    point at data
4621           cax3                put into x3
4622           rem
4623 opr010    lda       0,3,b.0   pick up char
4624           iana      63        drop to 6 bits
4625           alp       18        get the parity on it
4626           tnz       2         all ok now
4627           iora      64        or in 7th bit for odd-parity
4628           sta       0,3,b.0   replace char
4629           iacx3     0,3,b.1   bump ptr
4630           aos       oprcnt-*  decrement count
4631           tmi       opr010-*  loop for all chars
4632           rem
4633 oprret    return    outpar    done
4634           rem
4635 oprcnt    bss       1
4636           ttls      oscan - scan the output to get t.pos
4637 oscan     subr      scn,(x1,x2,x3,a)
4638           rem
4639 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4640 *
4641 *         oscan
4642 *
4643 *         scans an output buffer and updates the column
4644 *         position in t.pos accordingly.
4645 *
4646 *         upon entry:
4647 *              x1 - virtual tib address
4648 *              x3 - virtual buffer address
4649 *
4650 *         returns:
4651 *              updated column position in t.pos
4652 *
4653 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4654           rem
4655           ldx2      t.sfcm,1  get virtual sfcm address
4656           lda       sf.flg,2  asynchronous?
4657           cana      l.n004-*  =sffsyn
4658           tnz       scnret-*  no
4659           rem
4660           rem                 see if output scan is needed
4661           lda       t.flg,1   get tib flags
4662           cana      l.m006-*  (=tftbec) tabecho mode ?
4663           tnz       scn010-*  yes, must scan
4664           cana      l.n011-*  (=tfecpx+tfcrec) echoplex or crecho mode?
4665           tze       scnret-*  no, skip scan
4666           rem
4667           ldx2      t.dtp,1   any delay table ?
4668           tze       scnret-*  no, skip scan
4669           szn       dl.cr,2   any cr delays ?
4670           tze       scnret-*  no, skip scan
4671           rem
4672 scn010    lda       bf.tly,3  get buffer tally
4673           ana       l.n002-*  (=buftmk) leave only tally
4674           iaa       0         anything to scan ?
4675           tze       scnret-*  nope
4676           tmi       scnret-*  be serious
4677           sta       scntly-*  save tally
4678           rem
4679           cx3a                put buffer addr in a
4680           iaa       bf.dta    get addr of data
4681           ora       l.n001-*  (=0,b.0) make char address
4682           cax3                put it in x3
4683           tsy       a.o003-*,*          =getcmt, get the addr of cmt in x2
4684           stx2      scncmt-*  save addr
4685           rem
4686 scn020    ldx2      scncmt-*  get cmt addr
4687           stz       scnidx-*  zero index
4688           rem
4689           ilq       4-1       set max cmt table size
4690           lda       t.flg2,1  get tib flags
4691           cana      l.n006-*  (=tfsftr) is this one a shifter?
4692           tze       2         nope
4693           iaq       2         extend cmt, look at shifts
4694           rem
4695           lda       0,3,b.0   get the char we are interested in
4696           ana       l.n007-*  (=000177) mask out parity
4697           sta       scnchr-*  save it
4698 scn030    cmpa      0,2,b.0   is it a special char?
4699           tze       scn040-*  yes, process
4700           rem
4701           cmpq      scnidx-*  at max yet?
4702           tze       scn031-*  yes, character not found in cmt
4703           rem
4704           aos       scnidx-*  bump index word
4705           iacx2     0,b.1     bump cmt ptr
4706           tra       scn030-*  loop processing more cmt chars
4707           rem
4708           rem       not in cmt, must be regular char
4709           rem
4710 scn031    lda       t.flg2,1  get the tib flag bits
4711           cana      l.n006-*  (=tfsftr) shifty device?
4712           tze       scn035-*  no
4713           rem
4714           lda       t.flg2,1
4715           cana      l.n005-*  (=tfupsf) in upshift now?
4716           tze       scn037-*  no
4717           lda       0,3,b.0   get the char
4718           iora      64        set 100 bit
4719           sta       0,3,b.0   replace char
4720           tra       scn037-*
4721           rem
4722 scn035    lda       scnchr-*  get current character again
4723           icmpa     32        is it a printing char?
4724           tmi       scn200-*  no, get out
4725           rem
4726 scn037    lda       t.pos,1   get current position
4727           icmpa     255       over limit ?
4728           tpl       scn200-*  yes, don't increment
4729           rem
4730           aos       t.pos,1   increment position
4731           tra       scn200-*  continue
4732           rem
4733 scn040    ldx2      scnidx-*  get the index value
4734           tra       a.n001-*,*          (=scntbl,2*) go to right routine
4735           rem
4736 scntbl    ind       scn050    line-feed
4737           ind       scn060    carriage return
4738           ind       scn070    tab
4739           ind       scn080    backspace
4740           ind       scn090    upshift
4741           ind       scn100    downshift
4742           rem
4743 scn050    null                linefeed
4744           stz       t.pos,1   reset column position
4745           tra       scn200-*
4746           rem
4747 scn060    null                carriage return
4748           stz       t.pos,1   reset column position
4749           tra       scn200-*
4750           rem
4751 scn070    null                tab
4752           ldq       t.pos,1   get current position
4753           ila       0         prepare to divide aq
4754           dvd       l.n003-*  (=10) divide by 10
4755           stq       scntmp-*  save remainder
4756           rem
4757           ila       10        get max cols per tab
4758           sba       scntmp-*  get cols moved
4759           ada       t.pos,1   this will be new column position
4760           icmpa     255       over limit ?
4761           tpl       scn200-*  yes, don't increment
4762           sta       t.pos,1   update column position
4763           tra       scn200-*
4764           rem
4765 scn080    lda       t.pos,1   backspace
4766           tze       scn200-*  already in column 0, do nothing
4767           iaa       -1        otherwise decrement column position
4768           sta       t.pos,1
4769           tra       scn200-*  done
4770           rem
4771 scn090    lda       l.n005-*  (=tfupsf) set bit on
4772           orsa      t.flg2,1  in tib, we are upshifted now
4773           tra       scn200-*
4774           rem
4775 scn100    lda       l.n005-*  (=tfupsf) get bit
4776           iera      -1        complement it
4777           ansa      t.flg2,1  turn it off in tib
4778           rem
4779 scn200    iacx3     0,b.1     bump buffer ptr
4780           rem
4781           ila       -1        decrement
4782           asa       scntly-*  the scan tally
4783           tnz       scn020-*  loop for more
4784           rem
4785 scnret    return    oscan
4786           rem
4787           ttls      scan - scan and process an input buffer
4788 scan      subr      isc,(x1,x2,x3)
4789           rem
4790 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4791 *
4792 *         scan
4793 *
4794 *         calls inproc to scan an input buffer, update the column
4795 *         position in t.pos accordingly, perform echoing and
4796 *         beginning of frame detection when scanning the current
4797 *         input buffer.
4798 *
4799 *         upon entry:
4800 *              x1 - virtual tib address
4801 *              x3 - virtual buffer address
4802 *
4803 *         returns:
4804 *              updated column position in t.pos
4805 *
4806 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4807           rem
4808           ldx2      a.n006-*,*          .crbpe
4809           lda       0,2       save buffer pte
4810           sta       iscpte-*  which callers count on being preserved
4811           rem
4812           ldx2      t.sfcm,1  get virtual sfcm address
4813           lda       sf.flg,2  asynchronous?
4814           cana      l.n004-*  =sffsyn
4815           tnz       iscret-*  no
4816           rem
4817           lda       t.flg2,1  save tffip for later comparison
4818           ana       l.n012-*  =tffip
4819           sta       scnfrm-*
4820           rem
4821           ldx3      sf.hcm,2  get hwcm address
4822           lda       sf.nic,2  get addr of next char to process
4823           tnz       isc010-*  if any
4824           lda       iscsx3-*  otherwise, use beginning of buffer
4825           ora       l.n011-*  0,b.1
4826           rem
4827 isc010    sta       fstchr-*  temp store begin point
4828           ana       l.n008-*  (=o077777) make it word address
4829           sta       fstwrd-*
4830           lda       sf.flg,2  now find out which icw we're on
4831           icana     sffcii
4832           tze       2
4833           iacx3     h.ric1-h.ric0
4834           lda       iscpte-*  get page base address
4835           iana      -256      mask down to address only
4836           sta       iscbas-*
4837           ldaq      0,3       get address of hardware's next char
4838           rem                 make sure it's in high memory
4839           tmi       isc013-*  high-order bit is on, it is
4840           cmpa      l.n014-*  (bwndow)
4841           tmi       isc015-*  below buffer window, so skip page address
4842           rem                 manipulation
4843 isc013    sba       iscbas-*  get offset within page
4844           ada       l.n014-*  (bwndow) buffer window base address
4845 isc015    sta       nxtwrd-*  this is word part of next address
4846           llr       18        switch a and q
4847           als       2         shift out 18-bit addressing flag
4848           arl       15        get character addressing flag in low 3 bits
4849           qls       3         move word address up next to it
4850           lrl       3         now whole thing is in the q
4851           stq       nxtchr-*  save it
4852           lda       nxtwrd-*  get word address
4853           caq
4854           sbq       fstwrd-*  find word difference
4855           qls       1         convert to chars
4856           lda       l.n009-*  =o100000
4857           cana      fstchr-*  started on odd char?
4858           tze       2         no
4859           iaq       -1        yes, one character less
4860           cana      nxtchr-*  ended on odd char?
4861           tze       2         no
4862           iaq       1         yes, one character more
4863           iaq       0         is total any chars at all?
4864           tze       iscret-*  no
4865           tmi       iscret-*  and no
4866           rem
4867           lda       sf.flg,2  get ebcdic bit for inproc
4868           iana      sffebd
4869           ldx3      fstchr-*  get address
4870           tsy       a.n002-*,*          inproc
4871           ldx3      nxtchr-*  update scan pointer now
4872           stx3      sf.nic,2
4873           sta       scntmp-*  hang on to returned flags
4874           lda       t.flg2,1  did we enter or leave a frame?
4875           ana       l.n012-*  =tffip
4876           cmpa      scnfrm-*  same as before?
4877           tze       isc020-*  yes
4878           lda       l.n013-*  (=sffnib) no, we'll need a different buffer size
4879           orsa      sf.flg,2
4880 isc020    lda       scntmp-*  get returned flags
4881           icana     retsus    output_suspend char?
4882           tze       isc030-*  no
4883           tsy       a.n004-*,*          (susout) yes, manipulate icws
4884           tra       iscret-*  and done
4885 isc030    icana     retres    output_resume char?
4886           tze       isc040-*  no
4887           tsy       a.n005-*,*          (resout) yes, restore icws
4888           tra       iscret-*  done
4889 isc040    icana     reteco    inproc added char(s) to echo buffer?
4890           tze       iscret-*  no
4891           lda       sf.flg,2  get sfcm flag bits
4892           icana     sffech    echoing on now?
4893           tnz       iscret-*  yes, done
4894           rem
4895           lda       sf.pcw,2  look at pcw bits
4896           icana     pb.xmt    are we already xmiting?
4897           tnz       iscret-*  yes, done
4898           rem
4899           tsy       a.n003-*,*          (=echock) try to do echoing
4900           tra       iscret-*  echoing started
4901           rem
4902 iscret    ldx2      a.n006-*,*          .crbpe
4903           lda       iscpte-*  restore original pte
4904           sta       0,2
4905           return    scan
4906           rem
4907           rem
4908 scntmp    bss       1
4909 scncmt    bss       1
4910 scnidx    bss       1
4911 scntly    bss       1
4912 scnchr    bss       1
4913 scnfrm    bss       1
4914 fstchr    bss       1
4915 fstwrd    bss       1
4916 nxtchr    bss       1
4917 nxtwrd    bss       1
4918 iscbas    bss       1
4919 iscpte    bss       1
4920           rem
4921 l.n001    ind       0,b.0
4922 l.n002    vfd       18/buftmk
4923 l.n003    dec       10
4924 l.n004    vfd       18/sffsyn
4925 l.n005    vfd       18/tfupsf
4926 l.n006    vfd       18/tfsftr
4927 l.n007    oct       000177
4928 l.n008    oct       077777
4929 l.n009    oct       100000
4930 l.n010    vfd       18/tfcrec
4931 l.n011    ind       0,b.1
4932 l.n012    vfd       18/tffip
4933 l.n013    vfd       18/sffnib
4934 l.n014    vfd       18/bwndow
4935           rem
4936 a.n001    ind       scntbl,2*
4937 a.n002    ind       inproc
4938 a.n003    ind       echock
4939 a.n004    ind       susout
4940 a.n005    ind       resout
4941 a.n006    ind       .crbpe
4942           rem
4943           rem
4944 reteco    bool      000001
4945 retsus    bool      000002
4946 retres    bool      000004
4947           rem
4948           rem
4949 a.o001    ind       setbpt
4950 *a.o002
4951 a.o003    ind       getcmt
4952           rem
4953 *l.o001
4954 *l.o002
4955 l.o003    ind       eb.dta,b.1
4956 *l.o004
4957 *l.o005
4958 *l.o006
4959 *l.o007
4960 *l.o008
4961 *l.o009
4962 l.o010    vfd       18/tfrpon
4963           ttls      geteb - get chars from the echo buffer
4964 geteb     subr      geb,(x1,x2,x3)
4965           rem
4966 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4967 *
4968 *         geteb
4969 *
4970 *              subroutine to get the pointer and tally of
4971 *         chars in the echo buffer which are to be
4972 *         echoed now.
4973 *
4974 *         input:
4975 *              x1 - virtual tib address
4976 *              x2 - virtual sfcm address
4977 *
4978 *         output:
4979 *              a - char address of data
4980 *              q - tally in chars
4981 *
4982 *         calling sequence:
4983 *              tsy   geteb-*
4984 *              tra   fail-*  no more to echo
4985 *              tra   good-*  got some chars
4986 *
4987 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
4988           rem
4989           ldx3      t.echo,1  get ptr to echo buffer
4990           tze       geb005-*  none
4991           rem
4992           lda       t.flg2,1  get tib flag bits
4993           cana      l.o010-*  (=tfrpon) replay on?
4994           tnz       geb005-*  yes, inhibit removal from echo buffer
4995           rem
4996           cx3a                convert echo buffer address
4997           tsy       a.o001-*,*          (setbpt) to virtual
4998           cax3
4999           lda       eb.tly,3  get the echo buffer tally
5000           ars       9         shift
5001           tnz       geb010-*  we have some
5002           rem
5003 geb005    lls       36        zero aq
5004           tra       gebret-*  return, fail exit
5005           rem
5006 geb010    lda       eb.otp,3  get ptr to chars to be echoed
5007           als       3
5008           arl       3         drop char addressing
5009           sta       gebadr-*  save
5010           cx3a                get echo buf ptr again
5011           iaa       32        point to end
5012           sba       gebadr-*  get difference
5013           als       1         multiply by two
5014           sta       gebtly-*  save
5015           rem
5016           lda       eb.otp,3  get outptr
5017           ars       15        leave only char bits
5018           icana     1         is it odd char?
5019           tze       geb020-*  no, ok
5020           rem
5021           lda       gebtly-*  fix up the tally
5022           iaa       -1
5023           sta       gebtly-*
5024           rem
5025 geb020    ldx2      eb.otp,3  get ptr
5026           stx2      gebadr-*  save it
5027           lda       eb.tly,3  get the real tally
5028           lrs       9         into lower a
5029           cmpa      gebtly-*  compare against max possible
5030           tpl       geb030-*  more, use tally to end of buffer
5031           rem
5032           sta       gebtly-*  less, use real tally
5033           ldx2      eb.inp,3  advance otp to inp
5034           tra       geb040-*
5035           rem
5036 geb030    sta       gebtmp-*  save value of a reg
5037           cx3a                get ptr to base of buffer
5038           ada       l.o003-*  (=eb.dta,b.1) point to start of data
5039           cax2                put into x2 now
5040           lda       gebtmp-*  get back saved a reg
5041           rem
5042 geb040    sba       gebtly-*  get new tally
5043           lls       9         get back into position
5044           sta       eb.tly,3  put back into eb
5045           rem
5046           stx2      eb.otp,3  reset otp now
5047           rem
5048           aos       geteb-*   bump return addr to good
5049           ldaq      gebadr-*  get return args
5050           rem
5051 gebret    return    geteb
5052           rem
5053           even
5054 gebadr    bss       1
5055 gebtly    bss       1
5056           rem
5057 gebtmp    bss       1
5058           ttls      echock - check to see if any echoing to do
5059 echock    subr      eck,(x3)
5060           rem
5061 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5062 *
5063 *         echock
5064 *
5065 *              subroutine to test if any chars in echo buf
5066 *         and start echoing if there are.
5067 *
5068 *         upon entry:
5069 *              x1 - virtual tib address
5070 *              x2 - virtual sfcm address
5071 *
5072 *         returns:
5073 *              +1 - if echoing started
5074 *              +2 - if no echoing to do
5075 *
5076 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5077           rem
5078           lda       t.stat,1  make sure data set leads are up
5079           ana       l.t001-*  =tsfdtr+tsfdsr+tsfcts+tsfcd
5080           cmpa      l.t001-*  they must all be on
5081           tnz       eck020-*  we won't echo to a dead line
5082           rem
5083           lda       t.flg,1   nor to one whose output is suspended
5084           cana      l.t003-*  =tfosus
5085           tnz       eck020-*
5086           rem
5087           tsy       geteb-*   check the echo buffer
5088           tra       eck020-*  none, return +2
5089           rem
5090           staq      eckicw-*  save icw for now
5091           rem
5092           ldx3      sf.hcm,2  get ptr to hwcm region
5093           iacx3     h.sic0    point at primary icw
5094           rem
5095           lda       sf.flg,2  get flags
5096           icana     sffcoi    alternate icw?
5097           tze       eck010-*  no
5098           rem
5099           iacx3     h.sic1-h.sic0       bump up to alt
5100 eck010    ldaq      eckicw-*  get the icw to use
5101           tsy       a.t002-*,*          (bldicw) put into icw
5102           rem
5103           ila       sffech    get flag for echo
5104           orsa      sf.flg,2  turn it on
5105           rem
5106           ila       pb.xmt    get xmit mode for pcw
5107           orsa      sf.pcw,2  turn it on too
5108           rem
5109           lda       l.t002-*  (=p.nop) get pcw command
5110           tsy       a.t001-*,*          (=cioc) connect to channel
5111           rem
5112           tra       eckret-*  done
5113           rem
5114 eck020    aos       echock-*  bump return addr
5115           rem
5116 eckret    return    echock    return to caller
5117           even
5118 eckicw    bss       2
5119           rem
5120           rem
5121 a.t001    ind       cioc
5122 a.t002    ind       bldicw
5123           rem
5124           rem
5125 l.t001    vfd       18/tsfdtr+tsfdsr+tsfcts+tsfcd
5126 l.t002    vfd       18/p.nop
5127 l.t003    vfd       18/tfosus
5128           ttls      hcheck - start echoing if not in xmit
5129           rem
5130           rem
5131 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5132 *
5133 *         this routine is called by the inproc subroutine of the
5134 *         utilities in order to make sure echoing starts before sending
5135 *         status to the control tables.
5136 *
5137 *         upon entry:
5138 *              x1 - virtual tib address
5139 *
5140 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5141           rem
5142 hcheck    subr      hch,(x2)
5143           ldx2      t.sfcm,1
5144           lda       sf.pcw,2  find out if in xmit now
5145           icana     pb.xmt
5146           tnz       hchret-*  we are, deal with echoing later
5147           tsy       echock-*  else start it now
5148           tra       hchret-*  if there is any
5149 hchret    return    hcheck
5150           ttls      subroutines to suspend and resume output
5151           rem
5152           rem
5153 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5154 *
5155 *         this routine is called by scan if inproc returns an indication
5156 *         that an output_suspend character was received. It will turn off
5157 *         the transmitter by cioc with a pcw with ^pb.xmt off. If a
5158 *         tally runout occurs, it will not process it now but later when
5159 *         resume is performed. If pre-tally runout occurs, it will be
5160 *         processed normally and t.ocur will reflect the changes.
5161 *         upon entry:
5162 *             x1 - tib address
5163 *             x2 - sfcm address
5164 *
5165 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5166           rem
5167 susout    subr      sus,(x3,i)
5168           lda       t.flg,1   suspend already in progress?
5169           cana      l.s005-*  (=tfosus)
5170           tnz       susret-*  yes, punt for now
5171           lda       sf.pcw,2  in transmit at the moment?
5172           icana     pb.xmt
5173           tze       sus010-*  no, skip pcw manipulation
5174 *
5175 *         NOTE: inh is not really needed, but make a smooth
5176 *         transaction and insure minimum amount of output
5177 *         being transmitted at this time
5178 *
5179           inh                 <+><+><+><+><+><+><+><+><+><+>
5180           lda       l.s002-*  (=^pb.xmt) load mask to flip xmt
5181           ansa      sf.pcw,2  set xmt off in pcw
5182           lda       l.s007-*  =p.nop
5183           tsy       a.s002-*,* cioc
5184 sus010    lda       l.s005-*  (=tfosus)
5185           orsa      t.flg,1   mark tib to show output suspended
5186 susret    return    susout
5187           eject
5188 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5189 *
5190 *         this subroutine is called when inproc detects an output_resume
5191 *         character. It turns off the "output suspended" flag, then checks
5192 *         to see if anything is on t.ocur; if so it will restart the output
5193 *         channel by pcw connect, else it will simulate output TRO by
5194 *         calling the optro routine.
5195 *         upon entry:
5196 *             x1 - tib address
5197 *             x2 - sfcm address
5198 *
5199 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5200           rem
5201           rem
5202 resout    subr      res
5203           lda       t.flg,1   suspended?
5204           cana      l.s005-*  tfosus
5205           tze       resret-*  no, return
5206           lda       l.s006-*  ^tfosus
5207           ansa      t.flg,1   turn the flag off
5208           szn       t.ocur,1  any pending output chain?
5209           tze       res010-*  no, simulate tro
5210           ila       pb.xmt    else go back into transmit
5211           orsa      sf.pcw,2
5212           lda       l.s007-*  =p.nop
5213           tsy       a.s002-*,*          cioc
5214           tra       resret-*  done
5215           rem
5216 res010    tsy       a.s003-*,*          optro
5217 resret    return    resout
5218           rem
5219           rem
5220           rem
5221 *l.s001   unused
5222 l.s002    vfd       o18//pb.xmt         revert xmit pcw mask
5223 *l.s003   unused
5224 l.s004    oct       010000    icw exhaust and 0 tally
5225 l.s005    vfd       18/tfosus
5226 l.s006    vfd       o18//tfosus
5227 l.s007    vfd       18/p.nop  pcw no-op command
5228 *l.s008   unused
5229 *l.s009   unused
5230 *l.s010   unused
5231           rem
5232           rem
5233 *a.s001   unused
5234 a.s002    ind       cioc
5235 a.s003    ind       optro
5236           rem
5237           ttls      opptro - output pre-tally runout status
5238 opptro    subr      opt,(x1,x2,x3)
5239           rem
5240 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5241 *
5242 *         opptro
5243 *
5244 *              process the pre-tally runout status. this
5245 *         is stored as the hsla picks up the last char from
5246 *         the buffer and therefore we will setup a new output
5247 *         buffer and icw.
5248 *
5249 *         upon entry:
5250 *              x1 - virtual tib address
5251 *              x2 - virtual sfcm address
5252 *              x3 - virtual buffer address
5253 *
5254 *         returns:
5255 *
5256 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5257           rem
5258           lda       sf.flg,2  get the sfcm flafs
5259           icana     sffech    is a tab, cr, lf, echo in progress?
5260           tnz       optret-*  yes, all done here
5261           rem
5262           ldx3      a.k009-*,*          .crbpe
5263           lda       0,3       get current page base address
5264           sta       optpte-*  save it
5265           lda       t.ocur,1  get t.ocur, points to buffer just finished
5266           tze       opt015-*  somebody dumped while we weren't looking
5267           tsy       a.k007-*,*          setbpt
5268           cax3                virtual version of t.ocur
5269           lda       bf.flg,3  get buffer flags
5270           cana      l.k009-*  check hold output buffer flag
5271           tze       opt006-*  no - as usual
5272           cana      l.k010-*  check last buffer in message flag
5273           tze       opt006-*  no - as usual
5274           stz       t.ocur,1  break chain here
5275           tra       opt008-*
5276 opt006    null
5277           lda       bf.nxt,3  get the next ptr
5278           sta       t.ocur,1  update t.ocur
5279           rem
5280 opt008    null
5281           lda       sf.flg,2  get sfcm flag word
5282           icana     sffcoi    are we using alternate?
5283           tze       2         nope, continue
5284           iacx2     sf.ob1-sf.ob0       add offset of alternate
5285           stz       sf.ob0,2  zero correct buffer ptr (note use of x2)
5286           ldx2      t.sfcm,1  restore sfcm ptr
5287           rem
5288           szn       t.ocur,1  any more buffers left
5289           tze       opt010-*  no, zero last ptr also
5290           rem
5291           lda       t.ocur,1  get ptr to first
5292           tsy       a.k007-*,*          (setbpt)
5293           cax3                in virtual form
5294           lda       bf.flg,3  get buffer flags
5295           cana      l.k010-*  (=bfflst) last buffer in msg?
5296           tnz       opt015-*  yes, leave here
5297           rem
5298           szn       bf.nxt,3  look at next ptr in first
5299           tze       opt015-*  no more, all done
5300           rem
5301           ila       0         indicate sffcoi is inactive now
5302           tsy       a.k003-*,*          (=nobicw) setup new output icw
5303           rem
5304           tra       opt020-*  all done
5305           rem
5306 opt010    stz       t.olst,1  zero the last pointer
5307           rem
5308           lda       l.k018-*  (=tfwrit) get flag bit
5309           iera      -1        flip it over
5310           ansa      t.flg,1   and turn it off in tib
5311           rem
5312 opt015    ldx3      sf.hcm,2  we will now zero address field of icw
5313           lda       sf.flg,2  find out which one
5314           icana     sffcoi
5315           tze       2
5316           iacx3     h.sic1-h.sic0       adjust x3 accordingly
5317           stz       h.sic0,3  this will be correct icw
5318           rem
5319 opt020    ldx3      a.k009-*,*          .crbpe
5320           lda       optpte-*  get original pte back
5321           sta       0,3       restore it
5322           ldx3      optsx3-*  get ptr to buffer just finished
5323           tze       optret-*  someone did a stpchn, don't bother
5324           tsy       a.k002-*,*          (freout) free it and update count
5325 optret    null
5326           lda       a.k008-*,*          get saved status word
5327           cana      l.k007-*  (=hs.siw) are we switching icw's?
5328           tze       3         don't change sffcoi in not
5329           ila       sffcoi    get the current icw switch
5330           ersa      sf.flg,2  flip it over in flag word
5331           rem
5332 optfin    return    opptro
5333           rem
5334 optpte    bss       1         safe store for buffer pte
5335           ttls      houtav - hsla output available entry
5336 houtav    subr      hav,(x1,x2,x3)
5337           rem
5338 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5339 *
5340 *         houtav
5341 *
5342 *              routine to setup icws for output which may
5343 *         arrive at the right time from a send_output
5344 *         op to the cs.
5345 *
5346 *         upon entry:
5347 *              x1 - virtual tib address
5348 *
5349 *         returns:
5350 *
5351 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5352           rem
5353           ldx2      t.sfcm,1  get ptr to sfcm for this guy
5354           tze       havret-*  none, forget it
5355           ldx3      sf.hcm,2  get ptr to hwcm
5356           rem
5357           lda       h.sic0+1,3          get tally word of first
5358           ora       h.sic1+1,3          get tally word of second
5359           cana      l.k002-*  (=010000) is either exhaust bit on?
5360           tze       havret-*  no, made in plenty of time
5361           rem
5362           lda       t.flg,1   is output suspended?
5363           cana      l.k006-*  tfosus
5364           tnz       havret-*  yes, don't interfere
5365           rem
5366           lda       h.sic0+1,3          get first again
5367           ana       h.sic1+1,3          get the second
5368           cana      l.k002-*  (=010000) are they both on?
5369           tnz       havret-*  yes, return, too late to act
5370           rem
5371           lda       h.sic0+1,3          get first yet again
5372           cana      l.k002-*  (=010000) was this the one?
5373           tze       hav010-*  no
5374           lda       sf.flg,2  yes, see if software thinks it's active
5375           cana      l.k001-*  =sffcoi
5376           tze       havret-*  it does, there's status pending
5377           tra       hav020-*  go ahead
5378 hav010    lda       sf.flg,2  alternate was exhausted
5379           cana      l.k001-*  (=sffcoi) did we think it was active?
5380           tnz       havret-*  yes, there must be status pending
5381           rem
5382 hav020    lda       t.ocur,1  get ptr to t.ocur
5383           tsy       a.k007-*,*          setbpt
5384           cax3                virtual
5385           szn       bf.nxt,3  check to make sure all is ok
5386           tnz       2         yes
5387           die       12        no bad error
5388           rem
5389           ila       1         indicate that sffcoi is active now
5390           tsy       a.k003-*,*          (=nobicw) go setup icws
5391           rem
5392 havret    return    houtav
5393           ttls      nobicw - new output buffer icw setup
5394 nobicw    subr      nob,(a,x1,x2,x3)
5395           rem
5396 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5397 *
5398 *         nobicw
5399 *
5400 *              setup the output icw and buffer for the
5401 *         next output buffer in the chain.
5402 *
5403 *         upon entry:
5404 *              x1 - virtual tib address
5405 *              x2 - virtual sfcm address
5406 *              a = 0 sffcoi points to inactive icw
5407 *                    1 sffcoi points to active icw
5408 *
5409 *         returns:
5410 *
5411 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5412           rem
5413           ldq       sf.hcm,2  get addr of hwcm
5414           lda       t.sfcm,1  get addr of sfcm also
5415           rem
5416           iaq       h.sic0    get offset of icw 0
5417           iaa       sf.ob0    and buf0
5418           sta       nobibp-*  save it away
5419           stq       nobiwp-*  and this also
5420           rem
5421           lda       sf.flg,2  get the flags
5422           szn       nobsa-*   check input arg
5423           tze       2         normal, sffcoi points to inactive one
5424           iera      sffcoi    invert meaning of sffcoi
5425           rem
5426           icana     sffcoi    alt?
5427           tze       nob010-*  nope, continue
5428           rem
5429           ila       h.sic1-h.sic0       get the diff
5430           asa       nobiwp-*  update word
5431           ila       sf.ob1-sf.ob0       get other diff
5432           asa       nobibp-*  update word
5433           rem
5434 nob010    lda       t.ocur,1  get the current buffer ptr
5435           tsy       a.k007-*,*          setbpt
5436           cax3
5437           lda       bf.nxt,3  get the next guy
5438           sta       nobibp-*,*          put into sfcm
5439           tsy       a.k007-*,*          setbpt
5440           cax3                hang on to virtual address
5441           stx3      nobbuf-*  save it away as well
5442           rem
5443           iaa       bf.dta    add in offset of data
5444           ora       l.k003-*  (=0,b.0) get char addressing flags
5445           caq                 hang on to it
5446           rem
5447           lda       bf.tly,3  get the tally from buffer
5448           ana       l.k004-*  (=buftmk) isolate tally
5449           llr       18        switch a and q
5450           ldx3      nobiwp-*  get the icw ptr
5451           tsy       a.k010-*,*          (bldicw) store icw
5452           rem
5453           ldx3      nobbuf-*  get latest buffer pointer back
5454           lda       l.k016-*  (=sffhdl)
5455           cana      sf.flg,2  is it HDLC?
5456           tze       nob020-*  no
5457           lda       bf.flg,3  get buffer flags
5458           cana      l.k010-*  (=bfflst) last buffer ?
5459           tze       nob020-*  no
5460           rem
5461           lda       l.k014-*  (=pb.tre) get tally runout enable bit
5462           orsa      sf.pcw,2  turn it on in saved pcw
5463           lda       l.k013-*  (=p.ris) get pcw opcode
5464           tsy       a.k011-*,*          (=cioc) connect
5465           rem
5466 nob020    tsy       a.k005-*,*          (=oscan) scan output buffer
5467           tsy       a.k001-*,*          (=outpar) put parity on ebcdic
5468           rem
5469 nobret    return    nobicw
5470           rem
5471 nobibp    bss       1
5472 nobiwp    bss       1
5473 nobbuf    bss       1
5474           rem
5475           rem
5476           rem
5477 l.k001    vfd       18/sffcoi
5478 l.k002    vfd       o18/010000
5479 l.k003    ind       0,b.0
5480 l.k004    vfd       18/buftmk
5481 l.k005    vfd       18/p.nop
5482 l.k006    vfd       18/tfosus
5483 l.k007    vfd       18/hs.siw
5484 l.k008    vfd       18/bffctl
5485 l.k009    vfd       18/bffhld hold output buffer flag
5486 l.k010    vfd       18/bfflst last buffer in message flag
5487 l.k011    vfd       18/c.rrec+c.rdtr+c.sbrk
5488 l.k012    vfd       18/tfacu
5489 l.k013    vfd       18/p.ris
5490 l.k014    vfd       18/pb.tre
5491 *l.k015   see below
5492 l.k016    vfd       18/sffhdl
5493 *l.k017   unused
5494 l.k018    vfd       18/tfwrit
5495           even
5496 l.k015    oct       0,1       for adding 1 to doubleword
5497           even
5498 havcnt    bss       2
5499           rem
5500           rem
5501 a.k001    ind       outpar
5502 a.k002    ind       freout
5503 a.k003    ind       nobicw
5504 a.k004    ind       denq
5505 a.k005    ind       oscan
5506 a.k006    ind       echock
5507 a.k007    ind       setbpt
5508 a.k008    ind       stpswd    status save word
5509 a.k009    ind       .crbpe
5510 a.k010    ind       bldicw
5511 a.k011    ind       cioc
5512           ttls      optro - output tally runout status
5513 optro     subr      otr,(x1,x2,x3)
5514           rem
5515 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5516 *
5517 *         optro
5518 *
5519 *              process the tally runout status, this means
5520 *         that the output is finished, or that we didnt
5521 *         reconnect the next buffer in time.
5522 *
5523 *         NOTE: if output is in suspend state, this routine will
5524 *         be no-op by a tra to otrret.
5525 *
5526 *         upon entry:
5527 *              x1 & x2 -as usual
5528 *
5529 *         returns:
5530 *
5531 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5532           rem
5533           lda       t.flg,1   was output suspended?
5534           cana      l.l003-*  tfosus
5535           tze       otr050-*  no, normal processing
5536           rem
5537           tra       otrret-*  no processing for now
5538           rem
5539 otr050    szn       t.dcwl,1  any dcw list to do?
5540           tze       otr060-*  no, check echo
5541           rem
5542           ldx3      t.dcwa,1  get addr of said list
5543           lda       0,3       get the dcw
5544           arl       15        get op type
5545           icmpa     dl.cmd    is it cmd dcw?
5546           tnz       otr060-*  no, not so important
5547           rem
5548           lda       0,3       reload dcw
5549           cana      l.k011-*  (=c.rrec+c.rdtr+c.sbrk) ?
5550           tnz       otr070-*  yes, process dcw first
5551           rem
5552 otr060    tsy       a.k006-*,*          (=echock) test for echoing
5553           tra       otrret-*  good, there was some
5554           tra       otr070-*  no, cleanup the remains
5555           rem
5556 otr070    lda       sf.flg,2  get the sfcm flags
5557           icana     sffech    is a tab, cr, lf, echo in progress?
5558           tze       otr080-*  no, cleanup
5559           rem
5560           ila       sffech    get the echo flag
5561           iera      -1        invert the word
5562           ansa      sf.flg,2  and turn it off in sfcm
5563           rem
5564           ila       pb.xmt    get the xmt bit
5565           iera      -1
5566           ansa      sf.pcw,2  and turn it off in the pcw
5567           rem
5568 otr080    lda       t.dcwl,1  any dcw list?
5569           tze       otrret-*  nope, done
5570           icmpa     1         exactly one dcw left?
5571           tnz       otr100-*  no, process it like any other
5572           ldx3      t.dcwa,1  otherwise see if it's a normal end-of-output
5573           lda       0,3       get the subop
5574           cmpa      otrdc1-*  =(cmd rxmit+sterm)
5575           tnz       otr100-*   no, check for one other special
5576           stz       t.dcwl,1  we're going to take care of dcwlist now
5577           tsy       gentrm-*  do terminate status
5578           tra       otrret-*  done
5579           rem                 check for same but also turning off rts
5580 otr100    tsy       a.l003-*,*          (=hdcw) call dcw processor
5581           rem
5582 otrret    return    optro
5583           rem
5584           rem
5585 otrdc1    cmd       c.rxmt+c.strm
5586 otrdc2    cmd       c.rxmt+c.rrqs+c.strm
5587 otrdc3    cmd       c.rrqs
5588           ttls      opxte - output transfer timing error status
5589 opxte     subr      oxt,(x1)
5590           rem
5591 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5592 *
5593 *         opxte
5594 *
5595 *              output transfer timming errors are very
5596 *         unusual, and in debugging mode we will
5597 *         die on them, otherwise ctrl tables will
5598 *         be poked with status
5599 *
5600 *         upon entry:
5601 *              x1 - virtual tib address
5602 *              x2 - virtual sfcm address
5603 *
5604 *         returns:
5605 *
5606 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5607           rem
5608           lda       t.stat,1  get the tib status bits
5609           iana      s.dss     but only the ones we want
5610           ora       l.l002-*  (=s.xte) get the xte status
5611           tsy       a.l004-*,*          (=istat) call intrp
5612           rem
5613           ife       sw.dbg,1,1
5614           die       7
5615           rem
5616           return    opxte
5617           ttls      gentrm - subroutine to generate output terminate status
5618           rem
5619 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5620 *
5621 *         gentrm
5622 *
5623 *                   this subroutine is called by optro to generate terminate
5624 *         status and clean up after exiting transmit mode
5625 *
5626 *         upon entry:
5627 *                   x1 - virtual tib address
5628 *                   x2 - virtual sfcm address
5629 *
5630 *
5631 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
5632           rem
5633 gentrm    subr      gen
5634           stz       sf.ob0,2  xmit is down, no buffers now
5635           stz       sf.ob1,2
5636           ldx3      sf.hcm,2  get hardware comm address
5637           lda       l.l006-*  =o410000
5638           sta       h.sic0+1,3          mark both send icws exhausted
5639           sta       h.sic1+1,3
5640           lda       l.l007-*  =^tsfxmt
5641           ansa      t.stat,1  not in xmit now
5642           ila       pb.xmt    mark sf.pcw also
5643           iera      -1
5644           ansa      sf.pcw,2
5645           lda       t.stat,1  get current status
5646           iana      s.dss     interesting part
5647           ora       l.l008-*  (=s.term) set terminate status
5648           tsy       a.l004-*,*          istat
5649           return    gentrm
5650           rem
5651           rem
5652           rem
5653 *l.l001             unused
5654 l.l002    vfd       18/s.xte
5655 l.l003    vfd       18/tfosus
5656 l.l004    vfd       18/sffcoi
5657 *l.l005   unused
5658 l.l006    oct       410000    exhausted icw tally word
5659 l.l007    vfd       o18//tsfxmt
5660 l.l008    vfd       18/s.term
5661 *l.l009   unused
5662 *l.l010   unused
5663 l.l011    vfd       o18//tfosus
5664           rem
5665 a.l001    ind       otrdc3
5666 a.l002    ind       setbpt
5667 a.l003    ind       hdcw
5668 a.l004    ind       istat
5669 a.l005    ind       resout
5670           ttls      freout subroutine, frees output buffer
5671           rem
5672           rem       this subroutine is called when output from a buffer is
5673           rem       finished. its job is to free the buffer (unless its
5674           rem       bffhld flag is on), decrement t.ocnt, and issue a send_output
5675           rem       request if appropriate
5676           rem
5677           rem       at entry:
5678           rem          x1 cpntains virtual tib address
5679           rem          x3 contains virtual address of buffer
5680           rem
5681           rem
5682 freout    subr      fre,(x3)
5683           rem
5684           lda       bf.flg,3  get buffer flags
5685           cana      l.u001-*  check hold output buffer flag
5686           tnz       freret-*  yes - dont free the buffer
5687           rem
5688           cana      l.u002-*  (=bffctl) control info in this buffer?
5689           tnz       fre010-*  yes, don't decrement count
5690           rem
5691           ila       -1        get the minus one
5692           asa       t.ocnt,1  decrement counter
5693           rem
5694           lda       t.flg2,1  get 2nd word of tib flags
5695           cana      l.u003-*  check if we just used acu
5696           tnz       fre010-*  there's no output to ask for
5697           rem
5698           lda       t.ocnt,1  get new value of count
5699           icmpa     bufthr    are we at the threshold?
5700           tnz       fre010-*  no, continue
5701           rem
5702           szn       t.ocp,1   is there more output in the FNP already?
5703           tnz       fre010-*  yes, don't ask for more yet
5704           rem
5705           ilq       sndout    get the "send_output" op-code
5706           tsy       a.u001-*,*          (=denq) queue it up
5707           rem
5708 fre010    cx3a
5709           tsy       a.u003-*,*          (cvabs) get absolute address of buffer
5710           ilq       0         let frebfh get buffer size
5711           tsy       a.u002-*,*          (=frebfh) free the spent buffer
5712           rem
5713 freret    return    freout
5714           rem
5715           rem
5716 a.u001    ind       denq
5717 a.u002    ind       frebfh
5718 a.u003    ind       cvabs
5719           rem
5720 l.u001    vfd       18/bffhld
5721 l.u002    vfd       18/bffctl
5722 l.u003    vfd       18/tfacu
5723           ttls      hsla jump tables
5724           rem
5725           rem       macro to create jump tables
5726           rem
5727 jmptbl    macro
5728           crsm      on
5729           idrp      #1
5730 #3#1      ind       invp      interrupt processor (sked$invp)
5731           zero      0
5732           tsy       #3#1-*,*
5733 #2#1      vfd       4/h1ch+#1-1,2/#1,5/0,7/schdmn
5734           dup       5,31
5735           zero      0
5736           tsy       #3#1-*,*
5737 subch     set       *-#2#1
5738 subch     set       subch/3
5739           vfd       4/h1ch+#1-1,2/#1,5/subch,7/schdmn
5740           idrp
5741           endm      jmptbl
5742           rem
5743           rem
5744           rem
5745           rem
5746           rem       *********************************************************
5747           rem       *
5748           rem       * a jump table consists of a three word vector.
5749           rem       * a jump table is transferred to by the hardware upon an
5750           rem       * interrupt for this device.
5751           rem       *
5752           rem       * word 0 is tsy'ed to by the hardware and thus contains
5753           rem       *        the ic at the time of the interrupt
5754           rem       * word 1 contains the instruction tsy scheduler$invp
5755           rem       * word 2 contains a packed representation of the device
5756           rem       *        which interrupted -- it has:
5757           rem       *        4 bits of iom chan #,
5758           rem       *        2 bits device # (1 - 3 for hsla's),
5759           rem       *        5 bits subchannel # (0 - 37(8) for hsla's)
5760           rem       *        7 bits module # for the scheduler.
5761           rem       *
5762           rem       *********************************************************
5763           rem
5764           rem
5765 hslajt    null
5766           rem
5767           jmptbl    (1,2,3)
5768           rem
5769           end