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 
  11           lbl       ,utilities
  12           ttl       fnp utility programs for mcs
  13 ***************************************************************************
  14 *
  15 *  note:  cs means "central system"
  16 *
  17 ***************************************************************************
  18 *         change list
  19 *
  20 *         modified on july 24, 1972 by rbs to add code to handle dia
  21 *
  22 *         modified october 1974 by rsc for new system
  23 *
  24 *         modified july 4 1979 by bsg for echo negotiation
  25 *
  26 *         modified 1979 august 23 by art beattie to add 'setptw', 'mvpgsc' and
  27 *            'mvpgtg' routines.
  28 *
  29 *         modified january 19, 1981 by robert coren to add metering
  30 *
  31 *         modified march 1982 by robert coren to add space management in high
  32 *             memory
  33 *
  34 ***************************************************************************
  35 
  36 * HISTORY COMMENTS:
  37 *  1) change(86-04-23,Coren), approve(86-04-23,MCR7300),
  38 *     audit(86-05-19,Beattie), install(86-07-10,MR12.0-1089):
  39 *     Modified november 1984 by robert coren to suppress check for eighth bit
  40 *     before looking character up in echo break table.
  41 *  2) change(88-01-15,Farley), approve(88-02-22,MCR7843),
  42 *     audit(88-02-22,Beattie), install(88-03-01,12.2-1029):
  43 *     added check in the inproc routine to see if there is no more room on the
  44 *     line for echo negotiation (t.scll=0) after echoing a character. If no
  45 *     room is left the input buffer should be sent to the host.
  46 *                                                      END HISTORY COMMENTS
  47           rem
  48           rem
  49           pcc       on
  50           pmc       off
  51           detail    on
  52           editp     on
  53           rem
  54           rem
  55           symdef    util
  56           rem
  57           rem       system service package
  58           symdef    meterc    counting meter subroutine
  59           symdef    metert    timing meter subroutine
  60           symdef    gettib    get a tib address
  61           symdef    exist     * summary of iom channels that exist
  62           symdef    hfv       hardware fault vector entry base address
  63           symdef    ignore    ignore interrupts routine
  64           symdef    badint    extraneous interrupts routine
  65           symdef    iomflt    iom channel fault routine
  66           symdef    conabt    console operator abort
  67           symdef    octasc    binary-octal ascii routine
  68           symdef    conchn    console channel number
  69           symdef    outprc    subroutine to process "output" subop
  70           symdef    fulbuf    subroutine to check if a buffer is full
  71           symdef    chkiv     checks interrupt vectors
  72           symdef    utsave    place where registers get saved
  73           symdef    puteco    subroutine to add char to echo buffer
  74           symdef    inproc    subroutine to copy chars into input buffers
  75           symdef    move      looks up chars in carriage movement table
  76           symdef    setptw    converts absolute address to a virtual address
  77           symdef    setbpt    converts buffer address to virtual
  78           symdef    cvabs     converts a virtual address to absolute
  79           symdef    mvpgsc    move data paging source address
  80           symdef    mvpgtg    move data paging target address
  81           symdef    mvplmm    move paged lower memory maximum address
  82           symdef    conman    set to -1 by init if console_man is in image
  83           rem
  84           symdef    getbuf
  85           symdef    frebuf
  86           symdef    frelbf
  87           symdef    getubf
  88           symdef    getbfh    get a buffer in high memory
  89           symdef    frebfh    free a buffer in high memory
  90           symdef    getmem
  91           symdef    fremem
  92           symdef    fresml
  93           symdef    getbfm    interrupt time metering area
  94           symdef    fpsel     'sel' instructions patched by init
  95           symdef    obsel
  96           rem
  97           symref    dicell    cs interrupt cells
  98           symref    dmbx      cs mailbox address
  99           symref    contip    interrupt processor for console terminate
 100           symref    wcon      routine to write on console
 101           symref    ctrl      control tables
 102           symref    istat     status entry of interpreter
 103           symref    itest     test-state entry of interpreter
 104           symref    trace
 105           symref    ecgifl    accept-input queuer
 106           symref    denq      dia enqueuing routine
 107           symref    derrq     dia error message queue
 108           symref    hcheck    hsla_man starts echoing
 109           symref    simclk    simulated clock value
 110           symref    dspqur    dispatcher queuer
 111           symref    secdsp    secondary dispatcher
 112           symref    mincs
 113           symref    mincd
 114           symref    mupdat
 115           rem
 116           rem
 117           pmc       save,on
 118 util      null
 119           start     util,4
 120           rem
 121           rem
 122           ttls      multiply and divide macros
 123           rem
 124 mpy       macro     (multiplier loca    tion-*)
 125           mpf       #1
 126           lrl       1
 127           endm      mpy
 128           rem
 129           rem
 130 dvd       macro     (divisor locatio    n-*)
 131           qls       1
 132           dvf       #1
 133           endm      dvd
 134           rem
 135           systm
 136           rem
 137           comreg
 138           rem
 139           tib
 140           rem
 141           meters
 142           rem
 143           intm
 144           rem
 145           sfcm      hsla
 146           rem
 147           buffer
 148           rem
 149           devtab
 150           rem
 151           dlytbl
 152           rem
 153           csbits
 154           rem
 155           pmc       restore
 156           ttls      miscellaneous symbols
 157           rem
 158 ************************************************************************
 159 *                   miscellaneous
 160 ************************************************************************
 161           rem
 162           rem
 163 k         equ       1024
 164 itprty    equ       7         priority for timeout routine
 165           rem
 166 bcdspc    bool      20
 167           rem
 168 null      bool      000
 169 space     bool      040
 170 blank     equ       space
 171 ht        bool      011
 172 tab       equ       ht
 173 lf        bool      012
 174 cr        bool      015
 175 rubout    bool      177
 176           rem
 177 mask6     bool      077
 178 mask7     bool      177
 179           rem
 180 hslafl    bool      1000
 181           rem                 return flags from inproc
 182 reteco    bool      001       char(s) put in echo buffer
 183 retsus    bool      002       output-suspend character
 184 retres    bool      004       output-resume character
 185           rem
 186 oct002    bool      002
 187 oct003    bool      003
 188 oct005    bool      005
 189 oct007    bool      007
 190 oct017    bool      017
 191 oct020    bool      020
 192 oct177    bool      177
 193 sndout    bool      105       "send output" mailbox opcode
 194 errmsg    bool      115       "error message" mailbox opcode
 195           rem
 196 fbdevc    bool      37        device code mask
 197 fcdevc    equ       13        device code lsb position
 198 dclock    bool      01        device code for fnp's clocks
 199 dprint    bool      06        device code for printer
 200 ddia      bool      02        device code for dia
 201 dcon      bool      05        device code for console
 202           rem
 203 brkall    equ       -1        break on every character
 204 brkctl    equ       -2        break on all control characters
 205 brknxt    equ       -3        break on char after specifed char
 206           rem
 207 ct.dev    equ       1         offset in ctrl of array of device table addrs
 208           rem
 209           rem
 210           rem
 211           rem       get and release buffer symbol definitions
 212           rem
 213 adrs      equ       0         address
 214 wrdsz     equ       1         number of words in buffer
 215 fwdpt     equ       2         forward pointer
 216 bckpt     equ       3         backward pointer
 217           rem
 218           rem
 219           rem       trace types
 220           rem
 221 mt.get    equ       1         allocating single buffer
 222 mt.fre    equ       2         freeing single buffer
 223 mt.gtc    equ       3         allocating buffer chain
 224 mt.frc    equ       4         freeing buffer chain
 225           rem
 226           rem
 227           ttls      miscellaneous external values
 228           rem
 229 ************************************************************************
 230 *
 231 *         Miscellaneous values shared by several modules, but kept here
 232 * for simplicity.
 233 *
 234 ************************************************************************
 235           rem
 236           rem
 237           rem
 238           rem       **********************************************
 239           rem       *
 240           rem       *      "exist" -- a summary of which IOM chans
 241           rem       * init found to exist.  the mapping
 242           rem       * used herein is: if bit N is on, the channel
 243           rem       * N has a valid channel attached to it.
 244           rem       *
 245           rem       **********************************************
 246           rem
 247           rem
 248 exist     bss       1
 249           rem
 250           rem
 251           ttls      fault processing routines
 252           rem       *********************************************************
 253           rem       *     first level fault processing
 254           rem       *********************************************************
 255           rem
 256 hfv       null
 257 f0        ind       **        pf
 258           tsy       fp-*
 259 f1        ind       **        po
 260           tsy       fp-*
 261 f2        ind       **        mp
 262           tsy       fp-*
 263 f3        ind       **        op
 264           tsy       fp-*
 265 f4        ind       **        ov
 266           tsy       fp-*
 267 f5        ind       **        im
 268           tsy       fp-*
 269 f6        ind       **        dc
 270           tsy       fp-*
 271 f7        ind       **        ii
 272           tsy       fp-*
 273           rem
 274           rem       the following "fault entry points" are not caused by any
 275           rem       of the eight above processor faults. they are entered
 276           rem       by software which detects the indicated condition.
 277           rem
 278 badint    ind       **        xi -- extraneous interrupt
 279           tsy       fp-*
 280 iomflt    ind       **        cf -- iom channel fault
 281           tsy       fp-*
 282 conabt    ind       **        cn -- console operator abort
 283           tsy       fp-*
 284           eject
 285           rem       *********************************************************
 286           rem       *     second level fault processing
 287           rem       *********************************************************
 288           rem
 289 fp        ind       **
 290           sti       save+1-*  save indicator register
 291           ldi       fp.inh-*  set "inh" and parity inh
 292           staq      save+2-*  save registers
 293           lda       iomflt+1-*          get iom channel fault vector
 294           sta       fvsave-*  and save it
 295           lda       l.a008-*  (tsy -1,*)
 296           sta       iomflt+1-*          so we don't get clobbered during fault handling
 297           stx1      save+4-*
 298           stx2      save+5-*
 299           stx3      save+6-*
 300           rier
 301           sta       save+7-*  save interrupt level enable register
 302           lda       a.a001-*,*          (etmb)
 303           sta       save+8-*  save elapsed timer value
 304           ldx1      fp-*      x1 = address+2 of original ic
 305           lda       -2,1      ar = original ic
 306           sta       save-*    save original instruction counter value
 307           rem
 308           cx1a                compute
 309           sba       a.a002-*  (f0+2) fault
 310           arl       1         number
 311           sta       fltnum-*  and save
 312           rem
 313           icmpa     9         is it an iom channel fault?
 314           tnz       fp006-*   no, continue
 315           ldx3      a.a012-*  addr(tyfts), fault status for chan 0
 316           lda       0,3       get fault status
 317           tze       fp001-*   not chan 0, check hsla channels
 318           icmpa     12        is status o14 on chan 0?
 319           tnz       fp006-*   no, go ahead and crash
 320           tra       fp004-*   yes, queue error message and resume work
 321           rem
 322 fp001     null                check for hsla parity error
 323           ldx3      a.a016-*  addr(h1fts), fault status for hsla 1
 324 fp002     null
 325           lda       0,3       get status
 326           tnz       fp003-*   non-zero, take a look at it
 327           iacx3     1         zero. was this last hsla fault status?
 328           cmpx3     a.a017-*  addr(h3fts) + 1
 329           tnz       fp002-*   no, check next one
 330           tra       fp006-*   yes, it's something else, crash
 331           rem
 332 fp003     null                non-zero hsla fault status
 333           cmpa      l.a007-*  =o415 (parity)
 334           tnz       fp006-*   other bad status, crash
 335           rem
 336 fp004     null                queue error message
 337           sta       rstat-*   save fault status
 338           rem
 339           ila       1         get error message code
 340           sta       rfault-*  save
 341           cx3a                get address of fault status word
 342           sba       a.a012-*  addr(tyfts) -- subtract origin to get chan no.
 343           sta       ric-*
 344           stz       rword-*   unused
 345           rem
 346           ilq       errmsg    get the opcode for derrq
 347           ldx2      a.a014-*  (=reason) get addr of data
 348           tsy       a.a013-*,*          (=derrq) queue the error_message
 349           rem
 350           stz       0,3       zero the fault status so we don't see it again
 351           tra       a.a015-*,*          restart the processor
 352           rem
 353 fp006     lda       fltnum-*  restor the fault number
 354           als       3
 355           ada       a.a009-*  (f.name) compute address
 356           cax1                of and
 357           rem                 get and save fault name
 358           ila       -4        (four doublewords worth)
 359           sta       fptemp-*
 360           ldx2      a.a010-*  addr(fltnam)
 361 fp008     null
 362           ldaq      0,1       pick up two words
 363           staq      0,2       store them
 364           iacx1     2         bump from and to pointers
 365           iacx2     2
 366           aos       fptemp-*  done?
 367           tnz       fp008-*   no, do it again
 368           rem
 369           rem
 370           rem
 371           rem
 372           rem       *********************************************************
 373           rem       *  mask all hsla's and lsla's
 374           rem       *********************************************************
 375           rem
 376           ila       h1ch      starting with first hsla channel
 377 fp009     null
 378           cax3                hang on to iom channel no.
 379           ora       l.a002-*  (=o730000) "sel" opcode
 380           sta       msksel-*
 381 msksel    zero                patched with sel instruction
 382           cioc      dispcw-*  issue mask pcw
 383           cx3a
 384           iaa       1         next iom channel
 385           icmpa     l6ch+1    finished lsla's?
 386           tmi       fp009-*   no, do it again
 387           rem
 388           rem
 389           rem       *********************************************************
 390           rem       *  set interrupt level enable register to enable
 391           rem       *  levels 0, 1, and 2 only.  set up ignore iv's
 392           rem       *  for all devices on levels 0, 1, and 2 except
 393           rem       *  console.
 394           rem       *********************************************************
 395           rem
 396           lda       l.a001-*  (=o700000)
 397           sier
 398           rem
 399           ldx3      l.a003-*  (=o000400)
 400           ldx2      a.a007-*  (sd.iv+48-3)
 401 fp010     null
 402           ldaq      -16,3     move iv's for levels 0, 1, and 2
 403           sta       0,2       to save area (sd.iv) and replace with
 404           stq       1,2       address of ignore routine
 405           lda       -14,3
 406           sta       2,2
 407           ldaq      a.a004-*  (ignore)
 408           staq      -16,3
 409           sta       -14,3
 410           iacx2     -3
 411           iacx3     -16
 412           tnz       fp010-*
 413           rem
 414           lda       conchn-*  re-initialize console iv's
 415           tmi       fp015-*
 416           als       4
 417           cax3
 418           lda       a.a008-*
 419           sta       2,3
 420           rem
 421           rem
 422           rem       ***************************************************
 423           rem       *  use software fault vector to write
 424           rem       *  farewell message on console
 425           rem       ***************************************************
 426           rem
 427 fp015     null
 428           ldx1      fltnum-*
 429           adcx1     a.a003-* (sfv)
 430           tsy       0,1*
 431           rem
 432           rem
 433           rem       *******************************************************
 434           rem       *   send cs reason for crash
 435           rem       *******************************************************
 436           rem
 437           rem
 438           lda       fltnum-*  get fault type code
 439           sta       rfault-*
 440           rem                 get cs address (word 6 of mailbox header)
 441           lda       a.a011-*,*          dmbx
 442           iaa       6
 443           sta       dcwlst-*  put it in dcw
 444           alp       18        fix parity
 445           tnz       fp16-*    odd, nothing to do
 446           lda       l.a005-*  parity bits
 447           orsa      dcwlst+1-*
 448           rem
 449 fp16      null                fix parity on second half of dcw
 450           lda       dcwlst+2-*
 451           alp       18
 452           tnz       fp17-*
 453           lda       l.a005-*
 454           orsa      dcwlst+3-*
 455           rem
 456 fp17      null                fix parity in list icw address for pcw
 457           lda       licadr-*
 458           alp       18
 459           tnz       fp18-*
 460           ldq       l.a006-*  =o060070
 461           tra       2
 462 fp18      null
 463           ilq       56        i.e., o000070
 464           staq      a.a005-*,*          dimb (dia pcw mailbox)
 465           rem
 466 fpsel     sel       **
 467           cioc      a.a005-*,*          dimb
 468           rem
 469           rem
 470           rem       *********************************************************
 471           rem       *  shut down all io devices
 472           rem       *********************************************************
 473           rem
 474           tsy       a.a006-*,*          (obit) disconnect the cs
 475           rem
 476           ldaq      diapcw-*  insert mask pcw into
 477           staq      a.a005-*,*          dia pcw mailbox
 478           rem
 479           ila       16        * pick up number of channels to mask
 480 fp020     cax3                * put current channel num in X3
 481           ora       l.a002-*  * (=o730000) get the "sel" op-code
 482           sta       fp030-*   * and store for execution
 483 fp030     zero                * (ALTRD) patched to "sel" instruction
 484           cioc      dispcw-*  * issue the masking PCW
 485           rem
 486 fp.040    cx3a                * get current channel into A reg
 487           iaa       -1        * subtract one from it
 488           tpl       fp020-*   * and if still positive, go mask it
 489           rem
 490           rem
 491           rem
 492           tra       stop-*    that's all, go to sleep
 493           eject
 494           even
 495 dispcw    oct       0,010000  mask bit on to disable channel
 496 diapcw    oct       0,070000  dia pcw with parity bits
 497 l.a001    oct       700000
 498 l.a002    oct       073000
 499 l.a003    zero      256
 500 l.a004    zero      oct020
 501 l.a005    oct       060000
 502 l.a006    oct       060070
 503 l.a007    oct       000415    iom parity fault status
 504 l.a008    tsy       -1,*      used to make fault vector into nop
 505           rem
 506 a.a001    ind       etmb      elapsed timer mailbox address
 507 a.a002    zero      f0+2
 508 a.a003    zero      sfv
 509           even
 510 a.a004    ind       ignore
 511           ind       ignore
 512 a.a005    ind       dimb      dia mailbox address
 513 a.a006    ind       obit
 514 a.a007    zero      sd.iv+48-3
 515 a.a008    ind       contip    console terminate interrupt proc.
 516 a.a009    zero      f.name
 517 a.a010    zero      fltnam
 518 a.a011    ind       dmbx
 519 a.a012    ind       tyfts
 520 a.a013    ind       derrq
 521 a.a014    ind       reason
 522 a.a015    ind       pwron
 523 a.a016    ind       h1fts     iom fault status word, hsla 1
 524 a.a017    ind       h3fts+1   1 word past iom fault status word for hsla 3
 525 a.a018    ind       iomflt+1  to restore branch address
 526 fp.inh    oct       030000
 527           rem
 528           even
 529 utsave    null                symdef symbol
 530 save      bss       9         (ic, i, a, q, x1, x2, x3, er, et)
 531 fltnum    bss       1         save current fault number
 532 fltnam    bss       8         save current fault name
 533 conchn    zero      tych      = console ch no.
 534 fptemp    bss       1
 535 fvsave    bss       1         place to save iom channel fault vector
 536           rem
 537           rem
 538           even
 539 reason    null                72 bits sent to cs to tell why we crashed
 540 rfault    bss       1         fault type code
 541 ric       bss       1         instruction counter
 542 rstat     bss       1         iom fault status if applicable
 543 rword     bss       1         contents of fault word, or iom channel
 544           rem
 545           even
 546 lsticw    zero      dcwlst,w.2
 547           oct       4
 548           rem
 549           rem                 dcw list for sending reason to cs
 550 dcwlst    zero                cs address (filled in later)
 551           oct       75        fnp -> cs opcode (parity added later)
 552           zero      reason,w.2          fnp address
 553           oct       2         tally (parity added later)
 554           zero
 555           oct       060070    disconnect opcode (with parity)
 556           zero      0,w.2
 557           oct       020000    (parity)
 558           rem
 559           rem
 560           even
 561 licadr    zero      lsticw,w.2
 562           rem
 563           rem
 564           rem
 565           even
 566 f.name    ascii     8,power off         fault mnemonic names
 567           ascii     8,power on
 568           ascii     8,memory parity
 569           ascii     8,illegal opcode
 570           ascii     8,overflow
 571           ascii     8,store fault
 572           ascii     8,divide check
 573           ascii     8,illegal int
 574           ascii     8,extra int
 575           ascii     8,iom fault
 576           ascii     8,console abort
 577           eject
 578           rem       *********************************************************
 579           rem       *     software fault vectors
 580           rem       *********************************************************
 581           rem
 582 sfv       null
 583           ind       ignore    pf
 584           ind       ignore    po
 585           ind       mempar    mp
 586           ind       illop     op
 587           ind       icprt     ov
 588           ind       icprt     im
 589           ind       icprt     dc
 590           ind       ignore    ii
 591           ind       ignore    xi
 592           ind       chflt     cf
 593           ind       ignore    cn
 594           rem
 595           rem
 596           rem
 597           eject
 598 ************************************************************************
 599 *         power off fault processing routine
 600 ************************************************************************
 601           rem
 602 stop      null
 603 pwroff    null
 604           ila       0         disable all interrupts and stop
 605           sier
 606           dis
 607           tra       -1
 608           rem
 609           rem
 610           rem
 611 ************************************************************************
 612 *         power turn on fault processing routine
 613 ************************************************************************
 614           rem
 615 pwron     null
 616           inh
 617           lda       save+7-*  restore interrupt level enable register
 618           sier
 619           lda       save+8-*  restore elapsed timer value
 620           sta       a.a001-*,* (etmb    )
 621           lda       fvsave-*  pick up saved iom channel fault vector
 622           sta       a.a018-*,*          (iomflt+1) restore it
 623           ldaq      save+2-*  restore arithmetic registers
 624           ldx1      save+4-*
 625           ldx2      save+5-*
 626           ldx3      save+6-*
 627           ldi       save+1-*
 628           tra       save-*,*  return to point of interruption
 629           rem
 630           rem
 631           rem
 632 ************************************************************************
 633 *         ignore interrupts routine
 634 ************************************************************************
 635           rem
 636 ignore    ind       **
 637           tra       -1,*
 638           rem
 639           eject
 640 ************************************************************************
 641 *         routine to print faulting ic (and possibly instruction)
 642 *         on console
 643 ************************************************************************
 644           rem
 645 illop     ind       **        this entry to print instruction as well
 646           aos       wflag-*   set flag
 647           lda       illop-*   copy return point
 648           sta       icprt-*
 649           tra       icp010-*
 650           rem
 651           rem                 this entry to print ic only
 652           rem
 653 icprt     ind       **
 654           stz       wflag-*
 655 icp010    null                both come to here
 656           ldx2      a.i007-*  addr(msgnam)
 657           ldx3      a.i005-*  addr(fltnam) get address of fault name
 658           ila       -4        4 doublewords worth
 659           sta       itemp-*   to move it into message
 660 icp020    null
 661           ldaq      0,3
 662           staq      0,2
 663           iacx2     2
 664           iacx3     2
 665           aos       itemp-*
 666           tnz       icp020-*  if not done, do next two words
 667           rem
 668           ldq       a.i006-*,*          (save) get ic value
 669           iaq       -1        really points to next instruction
 670           stq       itemp-*   save it
 671           stq       a.i012-*,*          (ric) save for sending to cs
 672           ldx3      a.i001-*  addr(icasci)
 673           rem                 now convert it to ascii and put it in
 674           tsy       a.i003-*,*          octasc
 675           rem
 676           szn       wflag-*   write out word too?
 677           tze       icp030-*  no, go write on console
 678           rem                 else convert instruction word
 679           rem                 to octal ascii and put in message
 680           ldx3      itemp-*
 681           ldq       0,3       got word
 682           stq       a.i013-*,*          (rword) save for sending to cs
 683           ldx3      a.i002-*  addr(wdasci)
 684           tsy       a.i003-*,*          octasc
 685           rem
 686           ila       16        increase tally in icw
 687           asa       flticw+1-*
 688           rem
 689 icp030    null                now write on console
 690           szn       conman-*  is console_man in image?
 691           tze       icprt-*,* no. skip console stuff and return
 692           tsy       a.i004-*,*          (wcon) yes. go do it
 693           zero      flticw    argument is address of data icw
 694           nop                 if no console, don't worry
 695           tra       icprt-*,* return to caller
 696           rem
 697           rem
 698 ************************************************************************
 699 *         routine to write out message for iom channel fault
 700 ************************************************************************
 701           rem
 702 chflt     subr      chf
 703           rem
 704           rem                 write the channel number and
 705           rem                 associated fault status
 706           rem
 707           rem                 we start by finding a non-zero fault status
 708           ilq       0         initialize channel number
 709           ldx3      a.i008-*  addr(iom fault status)
 710 chf010    null
 711           lda       0,3
 712           tnz       chf020-*  non-zero, we got it
 713           iaq       1         else bump channel number
 714           iacx3     1         and fault status pointer
 715           tra       chf010-*  and try again
 716           rem
 717 chf020    null                channel no. is in q
 718           sta       itemp-*   save fault status
 719           staq      a.i011-*,*          (rstat) save both for sending to cs
 720           ldx3      a.i009-*  addr(chnasc)
 721           tsy       a.i003-*,*          (octasc) convert channel no.
 722           rem
 723           lda       chnasc+2-*          pick up low-order 2 digits
 724           sta       chfnum-*  put them in console message
 725           rem
 726           ldq       itemp-*   get fault status and convert it to ascii
 727           ldx3      a.i010-*  addr(chfst)
 728           tsy       a.i003-*,*          octasc
 729           rem                 now just write the message out
 730           szn       conman-*  is console_man in image?
 731           tze       chfret-*  no. skip console stuff
 732           tsy       a.i004-*,*          (wcon) yes. go do it
 733           zero      chficw
 734           nop
 735           rem
 736 chfret    null
 737           return    chflt
 738           rem
 739           rem
 740 ************************************************************************
 741 *         routine to write out memory parity fault message
 742 *         we will go through all of memory until we find something
 743 *         that results in parity indicator coming on
 744 ************************************************************************
 745           rem
 746 mempar    subr      mmp
 747           stz       pagbas-*  initialize this
 748           lda       a.i015-*,*          (.crmem)
 749           cmpa      l.i001-*  (=o100000) more than 32k?
 750           tpl       mmp010-*  no
 751           sta       memlst-*  then that's the end
 752           tra       mmp020-*
 753 mmp010    lda       l.i002-*  (=o077777) more than 32k, first pass will stop there
 754           sta       memlst-*
 755           ldx3      a.i016-*,*          (.crpte)
 756           stz       0,3       disable paging for now
 757 mmp020    stz       tstadr-*  start at 0
 758           ldi       a.i014-*,*          fp.inh (make sure we start with clean indicators)
 759 mmp030    lda       tstadr-*,*          pick up contents of next word
 760           sti       tstind-*  see what happened to the indicators
 761           lda       l.i003-*  =o002000, parity error indicator bit
 762           cana      tstind-*  is it on?
 763           tnz       mmp050-*  yes, we found it
 764           lda       tstadr-*  no, we'll advance the address
 765           cmpa      memlst-*  finished this pass?
 766           tze       mmp040-*  yes
 767           aos       tstadr-*  no, increment test address
 768           tra       mmp030-*  and go around again
 769           rem
 770 mmp040    ldq       pagbas-*  see if current address is real or virtual
 771           tze       mmp045-*  it's real
 772           iaq       255       it's virtual, test for real limit
 773           cqa
 774 mmp045    cmpa      a.i015-*,*          (.crmem) have we reached the end?
 775           tpl       mmp060-*  yes, we didn't find it
 776           iaa       1         else do next page
 777           sta       pagbas-*  this is the base of it
 778           tsy       a.i017-*,*          (setptw)
 779           rem                 note that this is safe because we've tested here
 780           sta       tstadr-*  this is presumably 077400 (virtual page base)
 781           iaa       255       this is the last virtual address in it
 782           sta       memlst-*
 783           tra       mmp030-*  start again
 784           rem
 785 mmp050    null                here when we find a parity indicator
 786           cmpa      l.i004-*  (o077400) in window?
 787           tmi       mmp070-*  no, it's exact
 788           szn       pagbas-*  but we were really there?
 789           tze       mmp070-*  yes
 790           sba       l.i004-*  else reduce to offset within page
 791           ada       pagbas-*  add page address
 792           tra       mmp070-*  this is it
 793 mmp060    ila       -1        we never found it, use dummy value
 794 mmp070    sta       a.i012-*,*          (ric) save it to send to cs
 795           szn       conman-*  is there a console?
 796           tze       mmpret-*  no, we're done
 797           caq                 get value in q
 798           ldx3      a.i018-*  addr (mmpadr)
 799           tsy       a.i003-*,*          octasc
 800           tsy       a.i004-*,*          wcon
 801           zero      mmpicw
 802           nop
 803 mmpret    return    mempar
 804           rem
 805           rem
 806           rem
 807 a.i001    zero      icasci,b.0
 808 a.i002    zero      wdasci,b.0
 809 a.i003    ind       octasc    binary to octal ascii conversion routine
 810 a.i004    ind       wcon      console-writing routine
 811 a.i005    ind       fltnam
 812 a.i006    ind       save      contains ic
 813 a.i007    zero      msgnam
 814 a.i008    zero      fltst     iom fault status
 815 a.i009    zero      chnasc,b.0
 816 a.i010    zero      chfst,b.0
 817 a.i011    ind       rstat     used in sending crash info to cs
 818 a.i012    ind       ric       likewise
 819 a.i013    ind       rword     likewise
 820 a.i014    ind       fp.inh
 821 a.i015    ind       .crmem
 822 a.i016    ind       .crpte
 823 a.i017    ind       setptw
 824 a.i018    ind       mmpadr,b.0
 825           rem
 826 l.i001    oct       100000
 827 l.i002    oct       077777
 828 l.i003    oct       002000    parity error indicator
 829 l.i004    oct       077400    base of paging 'window'
 830           rem
 831 conman    oct       0         set to -1 by init if console_man is in image
 832           rem
 833           even
 834 flticw    icw       fltmsg,b.0,38
 835           zero                to force fltmsg odd to force msgnam even
 836           rem
 837           detail    save,off
 838 fltmsg    saci      cr,lnf
 839 msgnam    bss       8         fault name
 840           ascii     7,fault -- ic =
 841 icasci    bss       3
 842           ascii     4,, word =
 843           saci      sp,sp
 844 wdasci    bss       3
 845           rem
 846           rem
 847           even
 848 chficw    icw       chfmsg,b.0,48
 849           rem
 850 chfmsg    saci      cr,lnf
 851           ascii     10,iom fault: ch    annel
 852 chfnum    bss       1
 853           ascii     9,, fault status    -
 854 chfst     bss       3
 855           rem
 856           even
 857 mmpicw    icw       mmpmsg,b.0,34
 858           rem
 859 mmpmsg    saci      cr,lnf
 860           ascii     13,memory parity referencing
 861 mmpadr    bss       3
 862           detail    restore
 863           rem
 864           rem
 865 chnasc    bss       3
 866 wflag     bss       1
 867 itemp     bss       1
 868 memlst    bss       1         last address to test in each pass
 869 pagbas    bss       1         base of current page
 870 tstadr    bss       1         adress on which to test parity
 871 tstind    bss       1         indicators resulting from test
 872           rem
 873           rem
 874           eight
 875 sd.iv     bss       3*16  (level 0,     1, and 2 iv's at time of fault)
 876           ttls      obit -- notify cs of fnp's death
 877 ************************************************************************
 878 *
 879 * this subroutine will send an "emergency interrupt" to the cs,
 880 * thereby indicating that the fnp is about to crash
 881 *
 882 ************************************************************************
 883           rem
 884 obit      ind       **
 885           lda       obit0-*   as a last gesture of politeness, allow
 886           iaa       -1        the dia to xmt its last message
 887           tnz       -1
 888           rem
 889           lda       obit1-*,* get emergency interrupt cell
 890           iana      7         isolate it
 891           caq                 put in q
 892           qls       6         position
 893           adq       obit3-*   get interrupt cs command
 894           cqa                 save this in a
 895           qlp       18        get parity on this word
 896           tnz       2         already odd
 897           ora       obit4-*   make odd parity lower
 898           caq                 put correctly paritized word back in q
 899           lda       obit5-*   load word with 36 bit xfer mode bit on
 900           staq      obit2-*,*
 901           rem
 902 obsel     sel       **        so long, its been good to know you
 903           cioc      obit2-*,*
 904           tra       obit-*,*
 905           rem
 906           rem
 907           rem
 908 obit0     dec       3500
 909 obit1     ind       dicell
 910 obit2     ind       dimb
 911 obit3     oct       000073    upper half odd parity and int cs cmd
 912 obit4     oct       020000    lower half parity bit
 913 obit5     zero      0,w.2     word with 36-bit xfer mode
 914           ttls      bdecac -- binary-decimal ascii routine
 915 ************************************************************************
 916 * this routine converts a binary number into four ascii characters which
 917 * represent the decimal equivalent of the number.
 918 *
 919 * the input binary number must be non-negative and <= 9999 (23417, oct).
 920 *
 921 * calling sequence --
 922 *
 923 *         c(x3) = ch/wd address of where 1st digit is to be stored.
 924 *         c(ar) = the binary number to be converted.
 925 *         tsy     bdecac-*
 926 *
 927 * on return, x3 will point to the position following the 4th digit.
 928 ************************************************************************
 929           rem
 930 bdecac    ind       **
 931           sti       bdasvi-*  save indicators
 932           inh                 inhibit interrupts
 933           stx2      bdasx2-*  save x2
 934           ilq       -4        set loop counter
 935           stq       bdactr-*  for 4 iterations
 936           ldx2      bdacon-*  set x2 for 1st conversion constant
 937           rem
 938 bda1      null
 939           ilq       0         clear q-register
 940           lrs       18-1-3    build dividend multiplied by 8
 941           dvf       0,2       produce a bcd digit in a-register
 942           iora      48 (060)  convert it to ascii code
 943           sta       0,3,b.0   store in user's area
 944           cqa
 945           rem
 946           iacx3     0,b.1     bump pointer to next digit store position
 947           iacx2     1         bump pointer to next conversion constant
 948           aos       bdactr-*  ? done this 4 times, yet ?
 949           tnz       bda1-*    nope
 950           rem
 951           ldx2      bdasx2-*  restore x2
 952           ldi       bdasvi-*  restore indicators
 953           tra       bdecac-*,*          restore control to user
 954           rem
 955 bdasvi    bss       1         safe store indicators
 956 bdasx2    bss       1         safe store x2
 957 bdactr    bss       1         loop counter
 958 bdacon    zero      *+1       conversion constant initial pointer
 959           dec       8000,6400,5120,4096
 960           ttls      octal-to-bcd/ascii subroutines
 961 ************************************************************************
 962 * octbcd/octasc will convert the six octits in the quotient register
 963 * into six 6-bit/9-bit bcd/ascii characters and store them in sequential
 964 * positions beginning at the address in x3.
 965 *
 966 * calling sequence --
 967 *
 968 *         ldq     <octal word to be converted>
 969 *         ldx3    <ch/wd address for 1st character>
 970 *         tsy     <octbcd/octasc>
 971 ************************************************************************
 972           rem
 973 octbcd    ind       **
 974           stx2      octsv-*   save x2
 975           ldx2      octsv+1-* set x2 = 6
 976           ila       0
 977           lls       3
 978           sta       0,3,c.0   store character
 979           iacx3     0,c.1     bump character pointer
 980           iacx2     -1        ? finished ?
 981           tnz       -5        no
 982           ila       bcdspc    yes, store a space
 983           sta       0,3,c.0
 984           iacx3     0,c.1
 985           ldx2      octsv-*   restore x2
 986           tra       octbcd-*,*          return
 987           rem
 988 octasc    ind       **
 989           stx2      octsv-*   save x2
 990           ldx2      octsv+1-* set x2 = 6
 991           ila       6
 992           lls       3
 993           sta       0,3,b.0   store character
 994           iacx3     0,b.1     bump character pointer
 995           iacx2     -1        ? finished ?
 996           tnz       -5        no
 997           ldx2      octsv-*   restore x2
 998           tra       octasc-*,*          return
 999           rem
1000           rem
1001 octsv     bss       1
1002           dec       6
1003           ttls      get tib address routine
1004 ************************************************************************
1005 *
1006 *         gettib
1007 *
1008 *                   enter a - multics line number
1009 *
1010 *                   this routine will take a multics line number and
1011 *                   convert it to the associated real tib address which will
1012 *                   be returned in the a. if no tib exists, the
1013 *                   a will contain 0. In either case, the address of the
1014 *                   lsla or hsla table entry for the line will be returned
1015 *                   in the q
1016 *
1017 *                   a multics line number is a 10 bit value which is right
1018 *                   justified in the a. the rightmost 6 bits contain the
1019 *                   slot number/line number (starting with 0), the next 3 bits
1020 *                   hold the lsla or hsla number (starting with 0) and the
1021 *                   next bit is 1 if hsla or 0 if lsla
1022 *
1023 *                   line 1777 is a pseudo-channel used fro communication with
1024 *                   the colts executive; its tib address is held in .crtdt,
1025 *                   and it does not have the other associated data bases
1026 *
1027 ************************************************************************
1028           rem
1029 gettib    subr      gtb,(inh,x1)
1030           cmpa      l.h001-*  (=o1777) is this colts channel?
1031           tze       gtb020-*  yes, special case
1032           lrl       6         put line number in q
1033           iera      8         flip hsla/lsla flag (1 = lsla now)
1034           icana     8         test for hsla or lsla
1035           tnz       2         it is an lsla
1036           iaa       5         hsla, add to hsla number
1037           iaa       1         add 1 to lsla or hsla no.
1038           als       1         multiply hsla/lsla number by 2 (iom table entry s
1039           ada       a.h001-*,*          add iom table base
1040           cax1                and put in x1
1041           ila       0         clear a
1042           lls       6         refetch line number
1043           als       1         times 2
1044           ada       1,1       add table base address from iom table entry
1045           cax1                put addr of word 0 of table entry in x1
1046           ldq       1,1       get tib address from table
1047           llr       18        put tib addr in a, slot addr in q
1048 gtb010    return    gettib    return to caller
1049           rem
1050 gtb020    lda       a.h002-*,*          .crtdt
1051           ilq       0         no table entry for colts channel
1052           tra       gtb010-*  return
1053           rem
1054 a.h001    ind       .criom
1055 a.h002    ind       .crtdt
1056           rem
1057 l.h001    oct       1777
1058           ttls      chkiv -- procedure to check the interrupt vectors
1059           rem
1060 ************************************************************************
1061 *
1062 *         "chkiv" -- procedure to check that the Interrupt Vectors
1063 * are not destroyed.  This procedure does not verify that all IV's are
1064 * correct; it only checks the "reasonableness" of them.
1065 *
1066 *
1067 ************************************************************************
1068           rem
1069           rem
1070           rem
1071 chkiv     subr      chk,(inh,a,q,x1)
1072           rem
1073           ldaq      chkcnt-*  * let us add one to the call counter
1074           adaq      chkone-*  * add one ..
1075           staq      chkcnt-*  * and put back
1076           rem
1077           ila       0
1078           cax1
1079           rem
1080 chklp     lda       0,1
1081           cmpa      chkhgh-*
1082           tmi       chkstp-*
1083           iacx1     1
1084           cmpx1     chkmax-*
1085           tnz       chklp-*
1086           rem
1087           return    chkiv
1088           rem
1089 chkstp    die       6
1090           rem
1091           rem
1092 chkmax    oct       40        * number of locations to check
1093 chkhgh    oct       1000      * highest number which is not ok
1094           rem
1095           even
1096 chkone    dec       0,1       * double precision one
1097 chkcnt    dec       0,0
1098           rem
1099           ttls      inproc subroutine -- copy chars into input buffers
1100           rem
1101           rem       called by hsla_man and lsla_man as input characters
1102           rem       arrive in order to put them in input buffers in t.icp
1103           rem       chain; updates t.pos and puts characters in echo buffer
1104           rem       if appropriate, and may present status to the control tables.
1105           rem       implements echoplex, tabecho, echo negotiation, etc.
1106           rem
1107           rem       at entry:
1108           rem          a  contains 0 for 7-bit, nonzero for 6-bit chars
1109           rem          q  contains number of characters
1110           rem          x3 points to first character
1111           rem
1112           rem       returns in a:
1113           rem          bit 17 on if anything put in echo buffer
1114           rem          bit 16 on if output-suspend char received
1115           rem          bit 15 on if output-resume char received
1116           rem
1117 inproc    subr      inp,(x1,x2,x3)
1118           rem
1119           iaa       0         6- or 7-bit characters?
1120           tze       inp005-*  7
1121           ila       mask6     6
1122           tra       2
1123 inp005    ila       mask7
1124           sta       pmask-*   hang on to parity mask
1125           rem
1126           cqa                 get character count
1127           tze       a.b016-*,*          (inpbak) none, nothing to do
1128           iera      -1        negate it
1129           iaa       1
1130           sta       inrem-*   save negative version
1131           stz       inecho-*
1132           stz       insusp-*
1133           stz       inres-*
1134           stz       inq-*
1135           rem
1136           stz       inpte-*   initially
1137           cx3a                find out if input pointer is in buffer window
1138           ana       l.b025-*  =o077777 (get word part alone)
1139           cmpa      l.b030-*  =window, general addressing window
1140           tpl       inp006-*  it's there, therefore not in buffer window
1141           cmpa      l.b031-*  =bwndow, buffer window
1142           tmi       inp006-*  below it, in regular low memory
1143           ldx2      a.b022-*,*          .crbte
1144           lda       0,2       save contents of buffer pte
1145           sta       inpte-*
1146           rem
1147 inp006    lda       t.flg2,1  in iflow now?
1148           cana      l.b022-*  (=tfifc)
1149           tze       inp010-*
1150           lda       t.flg3,1  watching the time?
1151           cana      l.b021-*  =tfitim
1152           tze       inp010-*
1153           cana      l.b027-*  (=tfsked) inptim already scheduled?
1154           tnz       inp007-*  yes, don't do it again
1155           lda       t.line,1  we need absolute tib address
1156           tsy       a.b019-*,*          gettib
1157           cax1                into x1 for dspqur
1158           ldaq      a.b010-*  time, priority, address for inptim
1159           tsy       a.b011-*,*          (dspqur) make sure it runs
1160           ldx1      inpsx1-*  get x1 back
1161           lda       l.b027-*  =tfsked
1162           orsa      t.flg3,1  it's scheduled now
1163           rem
1164 inp007    stz       intime-*  initialize for recording current time
1165           lda       a.b012-*,*          (itmb) get interval timer
1166           sta       intime+1-*
1167           ldaq      a.b013-*,*          (simclk) and time it's due to go off
1168           sbaq      intime-*  now we have current time
1169           staq      t.itim,1  hang on to it
1170           rem
1171 inp010    stx3      inchrp-*  save char pointer
1172           ldq       0,3,b.0   get next char
1173           stq       inchar-*
1174           lda       t.flg3,1  if we're supposed to,
1175           cana      l.b028-*  (tf8in)
1176           tnz       inp012-*
1177           lda       pmask-*   fix parity on it
1178           ansa      inchar-*
1179 inp012    ldq       inchar-*  save as original value
1180           stq       inorig-*  in case lfecho changes it
1181           lda       t.flg2,1
1182           cana      l.b012-*  (=tffrmi) in frame mode?
1183           tze       inp015-*  no, don't bother checking
1184           lda       t.frmc,1
1185           arl       9         get frame-begin char alone
1186           tze       3         zero (null) means any
1187           cmpa      inchar-*  is this it?
1188           tnz       inp015-*  no, check for break
1189           lda       l.b010-*  =tffip
1190           orsa      t.flg2,1  frame in progress now
1191           rem
1192 inp015    null
1193           tsy       a.b015-*,*          (chkofc) see if it's output flow control char
1194           tra       a.b017-*,*          (inp300) chkofc fully processed the character
1195           ldq       inchar-*  get character back without parity
1196           rem                 now check carriage movement table
1197           lda       t.pos,1   save old column indicator
1198           sta       oldpos-*
1199           tsy       a.b004-*,*          =addr(move)
1200           tra       inp020-*  for line feed
1201           tra       inp030-*  for carriage return
1202           tra       inp050-*  for tab
1203           tra       inp060-*  for backspace (do nothing)
1204           tra       inp070-*  no hit
1205           rem
1206           rem
1207 inp020    null                line feed
1208           lda       l.b002-*  =tfcrec
1209           cana      t.flg,1   crecho mode?
1210           tze       inp100-*
1211           szn       oldpos-*  were we already in column 0?
1212           tze       inp100-*  if so, don't echo carriage return
1213           ilq       cr        put carriage return in echo buffer
1214           tsy       a.b003-*,*          =addr(puteco)
1215           tra       inp100-*
1216           rem
1217 inp030    null                carriage return
1218           lda       l.b003-*  =tflfec
1219           cana      t.flg,1   lfecho mode?
1220           tze       inp100-*
1221           lda       l.b004-*  =tfecpx
1222           cana      t.flg,1   echoplex mode?
1223           tze       inp040-*  no, go ahead
1224           ilq       cr        else have to echo cr explicitly
1225           tsy       a.b003-*,*          puteco
1226 inp040    null
1227           ilq       lf        put line feed in echo buffer
1228           rem                 and input buffer
1229           stq       inchar-*
1230           tsy       a.b003-*,*          =addr(puteco)
1231           tra       inp110-*
1232           rem
1233 inp050    null                tab
1234           cax2                save space count
1235           lda       l.b005-*  =tftbec
1236           cana      t.flg,1   tbecho mode?
1237           tze       inp100-*
1238           tsy       a.b003-*,*          puteco
1239           tra       inp110-*  don't echoplex it also
1240           rem
1241 inp060    null
1242           tra       inp100-*
1243           rem
1244 inp070    null
1245           lda       a.b006-*,*          mshift (set by move subroutine)
1246           tze       inp090-*  not a case shift character
1247           icmpa     1         yes, is it up-shift?
1248           tnz       inp080-*  no
1249           lda       l.b006-*  =tfupsf
1250           orsa      t.flg2,1  yes, turn flag on
1251           tra       inp100-*
1252 inp080    null                down-shift
1253           lda       l.b007-*  =^tfupsf
1254           ansa      t.flg2,1  turn flag off
1255           tra       inp100-*
1256           rem
1257 inp090    null
1258           lda       l.b006-*  =tfupsf
1259           cana      t.flg2,1  are we in uppercase?
1260           tze       inp100-*
1261           ila       64        yes, mark character
1262           orsa      inchar-*
1263           rem
1264 inp100    null
1265           ldq       inchar-*
1266           lda       l.b004-*  =tfecpx
1267           cana      t.flg,1   echoplex?
1268           tze       inp110-*
1269           rem                 yes, put char in echo buffer
1270           tsy       a.b003-*,*          =addr(puteco)
1271           tra       inp110-*  branch around literals & storage
1272           eject
1273 pmask     bss       1         parity mask
1274 inchrp    bss       1         pointer to current character
1275 inrem     bss       1         number of characters remaining (negative)
1276 inecho    bss       1         nonzero if something put in echo buffer
1277 insusp    bss       1         nonzero if output_suspend char received
1278 inres     bss       1         nonzero if output_resume char received
1279 inchar    bss       1         copy of current character
1280 inorig    bss       1         original contents of inchar
1281 oldpos    bss       1         original value of t.pos
1282 inenef    bss       1         echo negotiation flag
1283 inpte     bss       1         buffer pte when we started
1284 inpvir    bss       1         temporary storage for virtual address
1285 inq       bss       1         nonzero => can append to queued input chain
1286           even
1287 intime    bss       2         current time
1288           rem
1289           rem
1290 a.b001    ind       istat
1291 a.b002    ind       getubf
1292 a.b003    ind       puteco
1293 a.b004    ind       move
1294 a.b005    ind       fulbuf
1295 a.b006    ind       mshift
1296 a.b007    ind       hcheck
1297 a.b008    ind       echngo
1298 a.b009    ind       ecgifl
1299           even
1300 a.b010    vfd       12/1,6/itprty       1 second, and priority of inptim
1301           ind       inptim
1302 a.b011    ind       dspqur
1303 a.b012    ind       itmb      interval timer mailbox
1304 a.b013    ind       simclk    simulated clock value
1305 a.b014    ind       itest
1306 a.b015    ind       chkofc
1307 a.b016    ind       inpbak
1308 a.b017    ind       inp300
1309 *a.b018             unused
1310 a.b019    ind       gettib
1311 a.b020    ind       .crnbf
1312 a.b021    ind       setbpt
1313 a.b022    ind       .crbpe
1314 a.b023    ind       eforce
1315           rem
1316           rem
1317 l.b001    zero      0,b.0
1318 l.b002    vfd       18/tfcrec
1319 l.b003    vfd       18/tflfec
1320 l.b004    vfd       18/tfecpx
1321 l.b005    vfd       18/tftbec
1322 l.b006    vfd       18/tfupsf
1323 l.b007    vfd       o18//tfupsf
1324 l.b008    vfd       18/s.exh
1325 l.b009    vfd       18/s.prex
1326 l.b010    vfd       18/tffip
1327 l.b011    oct       000777
1328 l.b012    vfd       18/tffrmi
1329 l.b013    vfd       18/bffbrk
1330 l.b014    vfd       18/s.brch
1331 l.b015    vfd       18/tfbral
1332 l.b016    vfd       18/tfsftr
1333 l.b017    vfd       o18//tfwrit
1334 l.b018    vfd       18/hslafl
1335 l.b019    vfd       18/buftmk
1336 l.b020    oct       024000    "inhibit overflow" & "inhibit interrupts"
1337 l.b021    vfd       18/tfitim
1338 l.b022    vfd       18/tfifc
1339 *l.b023             unused
1340 *l.b024             unused
1341 l.b025    oct       077777
1342 l.b026    vfd       18/tfisus
1343 l.b027    vfd       18/tfsked
1344 l.b028    vfd       18/tf8in
1345 l.b029    dec       1         for adding to meters
1346 l.b030    vfd       18/window
1347 l.b031    vfd       18/bwndow
1348 l.b032    vfd       18/tfinq
1349           eject
1350 inp110    null
1351           stz       inenef-*  zero echnego did echo flag.
1352           szn       t.scll,1  are we echo-negotiating?
1353           tze       inp114-*
1354           lda       inchar-*  hand the character to echngo
1355           tsy       a.b008-*,*          (echngo) echo negotiably
1356           sta       inenef-*  remember whether he actually echoed.
1357 inp114    null
1358           szn       t.icp,1   are we already building an input chain?
1359           tnz       inp119-*  yes
1360           rem                 otherwise we might just want to add to t.dcp
1361           szn       inq-*     have we done so once already?
1362           tnz       inp116-*  yes, some of these tests are unnecessary
1363           lda       t.flg3,1  in breakall mode?
1364           cana      l.b015-*  tfbral
1365           tze       inp120-*  no, never mind
1366           cana      l.b032-*  (tfinq) is it safe to append?
1367           tze       inp120-*  no, don't try
1368 inp116    lda       t.dlst,1  get last buffer of queued input
1369           tze       inp120-*  surprise, there isn't one
1370           tsy       a.b021-*,*          (setbpt) get its virtual address
1371           cax3                find out if it's full
1372           tsy       a.b005-*,*          fulbuf
1373           tra       inp120-*  it is. oh well, we tried
1374           aos       inq-*     remember that that's where the character goes
1375           tra       inp200-*  and skip all the buffer manipulation stuff
1376           rem
1377 inp119    null                old chain
1378           lda       t.ilst,1  find out if last buffer is full
1379           tsy       a.b021-*,*          (setbpt) convert address to virtual
1380           cax3
1381           tsy       a.b005-*,*          fulbuf
1382           tra       2         it is
1383           tra       inp190-*  it isn't, branch around buffer allocation code
1384           rem
1385 inp120    null                check for exhaust condition
1386           stz       inq-*     can't add to dia chain now
1387           lda       t.icpl,1  how many buffers have we got so far?
1388           ada       t.dcpl,1
1389           icmpa     bufmax    too many?
1390           tmi       inp125-*  no
1391           lda       t.stat,1  yes, send exhaust status
1392           iana      s.dss     common bits only
1393           ora       l.b008-*  =s.exh
1394           tsy       a.b001-*,*          =addr(istat)
1395           tra       inp140-*
1396           rem
1397 inp125    lda       t.flg2,1  see if we should request input suspension
1398           cana      l.b022-*  =tfifc
1399           tze       inp130-*  mode isn't on, certainly not
1400           lda       t.icpl,1  chain long enough?
1401           icmpa     bufmax/2
1402           tpl       inp128-*  yes
1403           als       2         multiply by 4
1404           cmpa      a.b020-*,*          (.crnbf) more than 1/4 of remaining space?
1405           tmi       inp130-*  no, skip it
1406 inp128    ldq       t.ifch,1  yes, get input flow control chars
1407           qrl       9         get suspend char alone
1408           tsy       a.b023-*,*          (eforce) into echo buffer
1409           rem
1410 inp130    lda       t.icpl,1  have we got enough to send no matter what?
1411           icmpa     bufpre
1412           tmi       inp140-*  no
1413           lda       t.stat,1  yes, signal pre-exhaust status
1414           iana      s.dss     common bits only
1415           ora       l.b009-*  s.prex
1416           tsy       a.b001-*,*          =istat
1417           rem
1418 inp140    null
1419           rem
1420           rem                 get a fresh buffer
1421           ilq       bufsiz
1422           tsy       a.b002-*,*          =addr(getubf)
1423           tra       inp150-*  error, cannot get buffer
1424           aos       t.icpl,1  increment buffer count
1425           caq                 hold on to address
1426           tra       inp160-*  continue
1427           rem
1428           rem                 send exhaust status, forget input char
1429 inp150    cmeter    mincs,m.inaf,l.b029-*
1430           rem
1431           lda       t.stat,1  get tib status bits
1432           iana      s.tib     common bits only
1433           ora       l.b008-*  =s.exh
1434           tsy       a.b001-*,*          =addr(istat)
1435           tra       inp300-*  go to next slot
1436           rem
1437 inp160    szn       t.icp,1   new chain or old?
1438           tze       inp170-*  new
1439           rem                 old, chain new buffer on
1440           lda       t.ilst,1
1441           tsy       a.b021-*,*          setbpt
1442           cax2
1443           stq       bf.nxt,2
1444           tra       inp180-*
1445           rem
1446 inp170    null
1447           stq       t.icp,1   new buffer is input chain head
1448           rem
1449 inp180    null
1450           rem                 set new last buffer pointer
1451           stq       t.ilst,1
1452           cqa                 get virtual address
1453           tsy       a.b021-*,*          setbpt
1454           cax3                also save it for later
1455           iaa       bf.dta    to set new character pointer
1456           ora       l.b001-*  0,b.0
1457           sta       t.icch,1
1458           rem
1459 inp190    null
1460           stx3      inpvir-*  hang on to virtual buffer address
1461           ldx3      t.icch,1
1462           lda       inchar-*  now put data character in input buffer
1463           sta       0,3,b.0
1464           rem                 now increment tally
1465           ldx3      inpvir-*
1466           ila       1         add one to tally in last buffer
1467           asa       bf.tly,3
1468           rem                 increment char pointer
1469           ldx3      t.icch,1  increment character pointer
1470           iacx3     0,b.1
1471           stx3      t.icch,1
1472           rem
1473           lda       t.flg2,1  check for shifter
1474           cana      l.b016-*  =tsfstr
1475           tze       inp200-*  not an ibm type
1476           ila       63        yes it is, mask off possible shift
1477           ansa      inchar-*  when testing for break
1478 inp200    null
1479           lda       t.flg2,1  see if we're in a frame
1480           cana      l.b010-*  =tffip
1481           tze       inp210-*  nope
1482           lda       t.frmc,1  yes, get framing chars
1483           ana       l.b011-*  (=o000777) mask down to frame-end only
1484           cmpa      inorig-*  is this it?
1485           tze       inp250-*  yes, break
1486           tra       inp300-*  no, don't break
1487           rem
1488 inp210    null
1489           lda       t.flg2,1  check for input_suspend char
1490           cana      l.b022-*  (=tfifc) if appropriate
1491           tze       inp220-*  it isn't
1492           lda       t.ifch,1  get input flow control chars
1493           lrl       9         suspend in a low, resume in q high
1494           cmpa      inorig-*  received suspend char?
1495           tnz       inp220-*  no
1496           lda       t.icpl,1  yes, should we resume right away?
1497           icmpa     bufmax/2
1498           tmi       inp215-*  yes, chain is short enough
1499           lda       l.b026-*  =tfisus
1500           orsa      t.flg,1   else set suspended flag in tib
1501           tra       inp220-*
1502 inp215    qrl       9         get resume char in q low
1503           tsy       a.b023-*,*          eforce
1504           rem
1505 inp220    lda       t.flg3,1  get flags
1506           cana      l.b015-*  =tfbral
1507           tnz       inp250-*  in breakall mode, break on everything
1508           rem
1509           rem                 break list pointed to by t.brkp has maximum of
1510           rem                 8 characters, of which first is
1511           rem                 either a special code or a count.
1512           lda       t.brkp,1  get pointer to beginning of break list
1513           ora       l.b001-*  0,b.0
1514           cax3
1515           rem
1516           lda       0,3,b.0   get first char of break list
1517           tze       inp300-*  no break list, no break char.
1518           als       9         extend high-order bit of char
1519           ars       9         for immediate compare
1520           rem
1521           icmpa     brkall    break on every character?
1522           tze       inp250-*  yes, that includes this one
1523           rem
1524           icmpa     brkctl    break on all control chars?
1525           tnz       inp230-*
1526           lda       inchar-*  yes, find out if this is one
1527           icmpa     blank
1528           tmi       inp250-*  it is, break
1529           tra       inp300-*  else don't
1530           rem
1531 inp230    null                first char is count of list
1532           caq                 get it in q
1533           rem
1534 inp240    null                check for match
1535           iacx3     0,b.1     bump to next char in break list
1536           lda       0,3,b.0   pick it up
1537           cmpa      inchar-*
1538           tze       inp250-*  this one, break now
1539           rem                 get next char in break list
1540           iaq       -1        if there are any more
1541           tze       inp300-*
1542           tra       inp240-*
1543           rem
1544           rem
1545 inp250    null                we have a break char, send appropriate
1546           rem                 status to interpreter
1547           lda       l.b010-*  =tffip (frame in progress)
1548           iera      -1        always turned off by break
1549           ansa      t.flg2,1
1550           rem
1551           lda       t.line,1  hsla line?
1552           cana      l.b018-*  =hslafl
1553           tze       inp260-*  no, skip this
1554           ldx2      t.sfcm,1  else have to update input pointer
1555           ldx3      inchrp-*  address of char just processed
1556           iacx3     0,b.1     point to next char
1557           stx3      sf.nic,2  update pointer in sfcm
1558           szn       inecho-*  have we put anything in echo buffer?
1559           tze       inp260-*  no, proceed
1560           stz       inecho-*  yes, reset flag
1561           tsy       a.b007-*,*          (hcheck) and tell hsla_man now
1562           rem
1563 inp260    null
1564           lda       t.flg3,1  check for breakall super-optimization
1565           cana      l.b015-*  =tfbral
1566           tze       inp265-*  nope
1567           szn       inenef-*  did FNP echnego this char?
1568           tze       3         no, proceed
1569           szn       t.scll,1  is there room for more echnego?
1570           tnz       inp298-*  great, don't ship:  turn on tfwrit
1571           rem                 if there's input on the t.dcp chain that can
1572           rem                 be safely appended to (as determined above),
1573           rem                 simply put the current character into it; it
1574           rem                 will be included in an already queued
1575           rem                 accept_input
1576           rem
1577           szn       inq-*     is there input queued?
1578           tze       inp261-*  no, never mind
1579           lda       t.dlst,1  get the last buffer in the queued input
1580           tsy       a.b021-*,*          (setbpt) get virtual address
1581           sta       inpvir-*  save it
1582           cax3
1583           lda       bf.tly,3  get the current tally
1584           ana       l.b019-*  buftmk
1585           lrl       1         get number of words (saving possible odd char)
1586           aos       bf.tly,3  increment buffer tally
1587           iaa       bf.dta    account for buffer header
1588           ada       inpvir-*  add address of origin, we now have word address
1589           ora       l.b001-*  0,b.0
1590           cax3                x3 now points to correct word
1591           iaq       0         was there an odd number of characters?
1592           tpl       2         no
1593           iacx3     0,b.1     yes, advance character pointer
1594           lda       a.g008-*,*          (inorig) get the current character
1595           sta       0,3,b.0   store it in buffer
1596           tra       inp300-*  done
1597 inp261    null                if that didn't work, at least we can
1598           rem                 try to avoid running the control tables
1599           rem
1600           rem                 breakable chars come one at a time
1601           rem                 or the very last in an echoed chain.
1602           rem                 at any rate, we are gonna ship.
1603           rem
1604           lda       t.ilst,1  first char in some buffer, not echoed?
1605           cmpa      t.icp,1   only buffer in chain?
1606           tnz       inp262-*  no, leave break bit on or off as was set before.
1607           tsy       a.b021-*,*          (setbpt) get virtual address
1608           cax3
1609           lda       bf.tly,3  check out the tally
1610           ana       l.b019-*
1611           icmpa     1         1st char?
1612           tnz       inp262-*  no, dont mark as break chars
1613           lda       l.b013-*  otherwise, turn on break flag
1614           orsa      bf.flg,3
1615 inp262    null
1616           tsy       a.b009-*,*          (ecgifl), ech(nego) iflush
1617           tra       inp300-*
1618 inp265    null
1619           lda       t.ilst,1  get buffer pointer
1620           tsy       a.b021-*,*          make it virtual
1621           cax3                so as to set
1622           lda       l.b013-*  (=bffbrk) break flag
1623           orsa      bf.flg,3
1624           lda       t.stat,1  get tib status
1625           iana      s.dss     mask down to common bits
1626           ora       l.b014-*  (=s.brch) set break char received
1627           tsy       a.g009-*,*          =addr(istat)
1628           lda       t.flg,1   check for echoplex
1629           cana      l.b004-*  =tfecpx
1630           tze       inp300-*  no, we're done
1631 inp298    null                here for thoughts that want chance to echo
1632           lda       l.b017-*  =^tfwrit
1633           ansa      t.flg,1   turn it off to make sure we get a chance to echo
1634           rem
1635 inp300    null                through with that character
1636           szn       t.entp,1  is there a echnego table?
1637           tze       inp310-*  no
1638           szn       a.g010-*,*          (inenef) did echngo echo this char?
1639           tnz       inp310-*  yes, it was echoed. echngo zeroed sncc
1640           sti       inpind-*  save indicators - it was not echoed,
1641           ldi       l.b020-*  inhibit overflow- so count against sync ctr
1642           aos       t.sncc,1  aos the sync ctr
1643           ldi       inpind-*
1644 inp310    null
1645           lda       a.g011-*,*          (inpte) pte to restore?
1646           tze       inp320-*  no
1647           ldx2      a.g012-*,*          (.crbpe) yes
1648           sta       0,2       do it
1649 inp320    null
1650           ldx3      a.g005-*,*          (inchrp) recover char pointer
1651           iacx3     0,b.1     go to next
1652           aos       a.g006-*,*          (inrem) are there any more?
1653           tmi       a.g013-*,*          (inp010) yes, go do next one
1654           rem                 done, set return flags
1655           ila       0
1656           szn       a.g007-*,*          (inecho) did we put anything in echo buffer?
1657           tze       2         no
1658           iora      reteco
1659           szn       a.g001-*,*          (insusp) found an output_suspend char?
1660           tze       2         no
1661           iora      retsus
1662           szn       a.g002-*,*          (inres) how about output_resume?
1663           tze       2         no
1664           iora      retres
1665           rem
1666 inpbak    return    inproc
1667           ttls      chkofc -- looks for output flow control chars
1668           rem       this subroutine looks for output flow control characters
1669           rem       and sets appropriate flags. If it completely processes
1670           rem       the character (i.e., it is not to be echoed or stored)
1671           rem       it returns to the next location; otherwise it returns
1672           rem       one location further on
1673           rem
1674           rem
1675 chkofc    subr
1676           lda       t.flg2,1  oflow mode?
1677           cana      l.g001-*  =tfofc
1678           tze       chk030-*  no, forget it
1679           lda       t.ofch,1  we'll check for output flow control char
1680           lrl       9         get suspend char. first
1681           cmpa      a.g003-*,*          (inchar) is it?
1682           tnz       chk010-*   no, check for resume
1683           lda       t.flg2,1  yes, see if it's block acknowledgement
1684           cana      l.g002-*  =tfblak
1685           tnz       chk010-*  yes, so suspend char isn't interesting
1686           aos       a.g001-*,*          (insusp) indicate receipt of suspend character
1687           stz       a.g002-*,*          (inres) overrides any preceding resume char
1688           tra       chkret-*  don't echo or store char
1689 chk010    qrl       9         get resume char
1690           cmpq      a.g003-*,*          (inchar)  is our current char one?
1691           tnz       chk030-*
1692           lda       t.flg2,1  yes, block acknowledgement?
1693           cana      l.g002-*  =tfblak
1694           tnz       chk020-*  yes, we'll have to adjust message count
1695           stz       a.g001-*,*          (insusp) overrides any previous suspend character
1696           aos       a.g002-*,*          (inres) yes, mark that it's to be resumed
1697           tra       chkret-*  done with char (don't echo or store)
1698           rem
1699 chk020    null                ack
1700           lda       t.omct,1  get outstanding message count
1701           tze       chkret-*  don't let it go negative
1702           iaa       -1        else decrement it
1703           sta       t.omct,1
1704           icmpa     2         can we resume now?
1705           tpl       chkret-*  no
1706           tsy       a.g004-*,*          (itest) yes, tell interpreter
1707           tra       chkret-*  done with char (don't store or echo)
1708           rem
1709 chk030    aos       chkofc-*  to return + 1
1710 chkret    return    chkofc
1711           rem
1712           rem
1713 inpind    bss       1         save indicator reg
1714           rem
1715 a.g001    ind       insusp
1716 a.g002    ind       inres
1717 a.g003    ind       inchar
1718 a.g004    ind       itest
1719 a.g005    ind       inchrp
1720 a.g006    ind       inrem
1721 a.g007    ind       inecho
1722 a.g008    ind       inorig
1723 a.g009    ind       istat
1724 a.g010    ind       inenef
1725 a.g011    ind       inpte
1726 a.g012    ind       .crbpe
1727 a.g013    ind       inp010
1728           rem
1729 l.g001    vfd       18/tfofc
1730 l.g002    vfd       18/tfblak
1731           ttls      inptim -- subroutine to run 1 second after inproc
1732           rem
1733           rem       this subroutine is scheduled by inproc to run one second
1734           rem       later if a channel is in input flow control/timeout
1735           rem       mode. Its function is to see if more than half a second
1736           rem       has elapsed since the last time inproc was called on behalf
1737           rem       of the channel, and if so, to send an input_resume
1738           rem       character to it on the assumption that it decided to
1739           rem       suspend input.
1740           rem
1741           rem       x1 contains absolute tib address at entry
1742           rem
1743           rem
1744 inptim    null                transferred to by secondary dispatcher
1745           cx1a                copy absolute tib address into a
1746           sta       ipabs-*   save it for possible later call to dspqur
1747           tsy       a.e006-*,*          (setptw) virtualize it
1748           cax1                and back into x1
1749           ldaq      t.itim,1  get the time inproc last ran
1750           tze       a.e001-*,*          (secdsp) never, forget it
1751           lda       a.e002-*,*          (itmb) see how much later it is now
1752           sta       iptemp+1-*
1753           stz       iptemp-*
1754           ldaq      a.e003-*,*          (simclk) next timer runout time
1755           sbaq      iptemp-*  result is current time
1756           sbaq      t.itim,1  how long has it been?
1757           tmi       a.e001-*,*          hasn't happened yet (unlikely)
1758           iaa       0         more than 2**18 msec??
1759           tnz       itm010-*  well, that's sure more than half a second
1760           cmpq      l.e001-*  501(10) -- else, was it in fact?
1761           tpl       itm010-*  yes
1762           rem                 else we should check again in a second
1763           ldaq      a.e007-*,*          time, priority, address of this routine
1764           ldx1      ipabs-*   recover absolute tib address
1765           tsy       a.e008-*,*          (dspqur) make sure we get called again
1766           tra       a.e001-*,*          (secdsp) done
1767           rem
1768 itm010    ldq       t.ifch,1  it has been, so send resume char
1769           qls       9         get rid of suspend char
1770           qrl       9
1771           tsy       a.e004-*,*          eforce
1772           lda       l.e003-*  =^tfsked
1773           ansa      t.flg3,1  turn off scheduled flag
1774           lda       t.line,1  hsla line?
1775           cana      l.e002-*  =hslafl
1776           tze       a.e001-*,*          (secdsp) no, done
1777           tsy       a.e005-*,*          (hcheck) yes, make sure echoing happens
1778           tra       a.e001-*,*          (secdsp) finished now
1779           rem
1780           rem
1781 a.e001    ind       secdsp
1782 a.e002    ind       itmb
1783 a.e003    ind       simclk
1784 a.e004    ind       eforce
1785 a.e005    ind       hcheck
1786 a.e006    ind       setptw
1787 a.e007    ind       a.b010    contains word pair for dspqur
1788 a.e008    ind       dspqur
1789           rem
1790           rem
1791 l.e001    dec       501
1792 l.e002    vfd       18/hslafl
1793 l.e003    vfd       o18//tfsked
1794           rem
1795 ipabs     bss       1         absolute tib address (temp stored here)
1796           even
1797 iptemp    bss       2
1798           ttls      move subroutine does carriage movement
1799           rem
1800           rem       this subroutine looks in carriage movement
1801           rem       table supplied in device table for character
1802           rem       supplied in q reg.
1803           rem
1804           rem       returns:  0 -- linefeed char
1805           rem                 1 -- carriage return
1806           rem                 2 -- tab (a contains  no. of blanks)
1807           rem                 3 -- backspace
1808           rem                 4 -- no match
1809           rem
1810           rem       tib address assumed in x1 as always
1811           rem
1812 move      subr      mov,(q,x3)
1813           rem
1814           rem                 first find out if we should bother
1815           stz       mshift-*  initially not a shift char
1816           ldx3      a.m001-*  base of control tables
1817           ldx3      ct.dev,3  array of device table ptrs
1818           adcx3     t.type,1  indexed by terminal type
1819           lda       -1,3      -1 to convert index to offset
1820           ora       l.m001-*  (0, b.0) convert to char. addressing
1821           cax3                x3 now points to device table entry
1822           rem                 we want to check against carriage mvmt
1823           rem                 characters in device table entry
1824           rem
1825           lda       l.m004-*  =tfsftr
1826           cana      t.flg2,1
1827           tze       mov005-*  not a shifter, only look for carriage movement
1828           ila       6         else we have to look for shifts too
1829           tra       mov010-*
1830 mov005    null
1831           ila       4         limit
1832 mov010    sta       mlimit-*
1833           ila       0
1834 mov012    cmpq      dt.cmt,3,b.0
1835           tze       mov030-*  hit
1836           iaa       1         and increment counter
1837           cmpa      mlimit-*  end of table?
1838           tze       mov020-*  no hits
1839           iacx3     0,b.1     not last, bump pointer
1840           tra       mov012-*  check next char. in table
1841 *
1842 mov020    null                not a special carriage mvmt. char.
1843           lda       l.m004-*  =tfsftr
1844           cana      t.flg2,1
1845           tnz       mov025-*  if we don't have an ibm terminal,
1846           cqa                 find out if it's a control char.
1847           icmpa     rubout
1848           tze       mov027-*  if so, don't bump column pointer
1849           icmpa     space
1850           tmi       mov027-*
1851 mov025    lda       t.pos,1   make sure we're not over limit
1852           icmpa     255
1853           tpl       2         we are, don't increment
1854           aos       t.pos,1   else, push to next column
1855 mov027    ila       4         indicate no hit return
1856           tra       movbak-*
1857 *
1858 mov030    null
1859           rem                 hit on carriage movement table
1860           icmpa     4         was it a shift character?
1861           tmi       mov035-*  no, check for something else
1862           iaa       -3        yes, reduce it to 1 or 2
1863           sta       mshift-*  save it for later
1864           ila       4         return as though no hit
1865           tra       movbak-*  all done (carriage didn't move)
1866           rem
1867 mov035    null
1868           icmpa     2         cr or lf?
1869           tpl       mov040-*
1870           stz       t.pos,1   yes, zero column indicator
1871           tra       movbak-*
1872 mov040    null
1873           icmpa     3         backspace?
1874           tnz       mov050-*
1875           szn       t.pos,1   don't decrement column indicator if
1876           tze       movbak-*  it's already zero
1877           ila       -1
1878           asa       t.pos,1
1879           ila       3         bump return point for backspace
1880           tra       movbak-*
1881 *
1882 mov050    null                must be tab
1883           ila       0
1884           ldq       t.pos,1   get mod(t.pos, 10)
1885           cmpq      l.m005-*  (=255) make sure we're not over limit
1886           tpl       mov070-*  we are, don't increment t.pos
1887           cmpq      l.m002-*  =10
1888           tmi       mov060-*  if it's < 10, don't bother dividing
1889           dvd       (l.m002-*)          else divide by 10
1890           rem                 remainder is in q
1891 mov060    null
1892           stq       mtemp-*   save mod(t.pos,10)
1893           ila       10        t.pos<-t.pos+10-mod(t.pos,10)
1894           sba       mtemp-*
1895           asa       t.pos,1
1896 mov070    aos       move-*    bump return pointer for tab return
1897           aos       move-*    by hand because have to keep space count in a
1898           tra       2
1899           rem
1900 movbak    asa       move-*    bump return pointer appropriately
1901           return    move
1902           rem
1903           rem
1904 l.m001    zero      0,b.0
1905 l.m002    dec       10
1906 l.m003    vfd       18/tfcrec+tflfec+tftbec+tfecpx
1907 l.m004    vfd       18/tfsftr
1908 l.m005    dec       255
1909 a.m001    ind       ctrl      address of control tables
1910 mtemp     bss       1         temp for saving mod(t.pos,10)
1911 mshift    bss       1         char was case shift (1 for upper, 2 for lower)
1912 mlimit    bss       1         number of chars to scan in cmt
1913           ttls      echo buffer subroutines
1914           rem       echo buffer format
1915           rem
1916 eb.inp    equ       0         ptr to next place for input character
1917 eb.out    equ       1         ptr to next output character
1918 eb.tly    equ       2         current character count (upper half)
1919 eb.dta    equ       2         first data char (lower half)
1920 eb.end    equ       bufsiz    end of echo buffer
1921 ebsize    equ       bufsiz*2-5          maximum number of echo chars
1922           rem
1923           rem
1924           rem       puteco subroutine puts input character in
1925           rem       echo buffer. character is supplied in q
1926           rem       tib address on x1 as usual
1927           rem       if character is ht, space count is in x2
1928           rem
1929 hecho     null
1930 lecho     null                this is the external interface
1931 puteco    subr      put,(x2,x3,a,q)
1932           rem
1933           lda       t.flg2,1  frame in progress?
1934           cana      l.c006-*  =tffip
1935           tnz       putbak-*  yes, no echoing
1936           rem
1937           tsy       putone-*
1938           tra       putbak-*  if no more room, skip other stuff
1939           rem
1940           lda       t.line,1  hsla line?
1941           cana      l.c008-*  =hslafl
1942           tze       put070-*  no, lsla_man will handle delays later
1943           ldx2      t.dtp,1   yes, put delays in echo buffer
1944           tze       put039-*  no delay table, check tabecho
1945           lda       putsq-*   get echoed char
1946           icmpa     lf        linefeed?
1947           tnz       put020-*  no, try something else
1948           lda       dl.lf,2   yes, get linefeed delays
1949           tze       putbak-*  none, skip it
1950           tra       put030-*  go do it
1951           rem
1952 put020    icmpa     cr        carriage return?
1953           tnz       put040-*  nope
1954           lda       dl.cr,2   get cr delay factor
1955           mpy       (a.c002-*,*)        oldpos, original column position
1956           tze       putbak-*  no delays, skip it
1957           qrs       9         divide by 512
1958           iaq       3         for good measure
1959           cqa                 result into a
1960 put030    ilq       null      delay char
1961           tra       put050-*  go put nulls in echo buffer
1962           rem
1963 put039    lda       putsq-*   get character into a again
1964 put040    icmpa     tab       not cr or lf, is it tab?
1965           tnz       putbak-*  no, done
1966           lda       t.flg,1   tab echo?
1967           cana      l.c005-*  =tftbec
1968           tze       putbak-*  no, skip it
1969           lda       putsx2-*  get space count
1970           ilq       blank     get space char
1971           rem
1972 put050    null                here to store blanks or nulls in buffer
1973           iera      -1        negate count
1974           iaa       1
1975           sta       puttmp-*
1976 put060    tsy       putin-*   put one in
1977           tra       putbak-*  buffer full, no more
1978           aos       puttmp-*  count one
1979           tmi       put060-*  more, go do them
1980           tra       putbak-*  no more, finished
1981           rem
1982 put070    null                lsla line, may need to restore t.pos
1983           lda       t.flg,1   echoplex?
1984           cana      l.c004-*  =tfecpx
1985           tnz       put080-*  yes
1986           cana      l.c005-*  (=tftbec) no, try tab echo
1987           tze       putbak-*  no, done
1988           lda       putsq-*   get original char again
1989           icmpa     ht        is it a tab?
1990           tnz       putbak-*  no, not interesting
1991 put080    lda       a.c002-*,*          oldpos
1992           sta       t.pos,1
1993           rem
1994 putbak    return    puteco
1995           rem
1996           rem
1997 eforce    subr      efo,(a,q,x3)
1998           rem
1999           rem       short version of puteco that puts the character
2000           rem       in the echo buffer even if in a blk_xfer frame,
2001           rem       and doesn't bother about delays or tabs. called
2002           rem       for such things as input suspend/resume characters.
2003           rem
2004           rem       q contains character to be echoed.
2005           rem
2006           tsy       putone-*  this actually does all the work
2007           nop                 doesn't matter whether or not it succeeds
2008           return    eforce
2009           ttls      putin -- insert a char in the echo buffer
2010 putin     subr      pin,(a,q,x2)
2011           rem
2012           rem       this subroutine does the actual insertion in the
2013           rem       echo buffer
2014           rem
2015           rem       q contains character to insert
2016           rem       x3 points to echo buffer
2017           rem       returns to callpoint if echo buffer full,
2018           rem       to one loc. beyond otherwise
2019           rem
2020           lda       eb.tly,3  see if it's full
2021           arl       9
2022           icmpa     ebsize    check against maximum
2023           tmi       pin010-*
2024           lda       l.c003-*  (=tfbel) echo buffer is full,
2025           orsa      t.flg,1   set flag to send bell
2026           cmeter    mincd,m.ebof,l.c011-*  meter this
2027           tra       pinbak-*  and return
2028 pin010    null
2029           aos       putin-*   bump return pointer
2030           lda       t.line,1  if hsla line in tabecho, don't store tab
2031           cana      l.c008-*  =hslafl
2032           tze       pin015-*  not hsla, as you were
2033           cqa                 get character
2034           icmpa     tab
2035           tnz       pin015-*  not tab, go ahead
2036           lda       t.flg,1   check for tabecho
2037           cana      l.c005-*  tftbec
2038           tnz       pinbak-*  don't store it, we'll put in spaces later
2039 pin015    null
2040           ldx2      eb.inp,3  get input pointer
2041           rem                 we're ready to store char
2042           stq       0,2,b.0   do it
2043           iacx2     0,b.1     increment input pointer
2044           cx2a                find out if we went off end
2045           cana      l.c007-*  =o077777
2046           tze       pin020-*  we went off end of memory, in fact
2047           cana      l.c002-*  =o000037
2048           tnz       pin030-*
2049 pin020    cx3a                0 mod 32 (wraparound)
2050           ada       l.c001-*  so point to beginning again
2051 *
2052 pin030    null
2053           sta       eb.inp,3
2054           lda       l.c010-*  =o1000
2055           asa       eb.tly,3  increment tally
2056 pinbak    return    putin
2057           ttls      putone -- set up echo buffer
2058 putone    subr      puo,(q)
2059           rem
2060           rem       this subroutine allocates an echo buffer (if
2061           rem       necessary) and puts a character in it, updating
2062           rem       the "inecho" flag. It is called by puteco and eforce.
2063           rem
2064           rem       q contains character to echo
2065           rem       on exit, x3 points to the echo buffer if any
2066           rem       returns to callpoint if echo buffer full or no
2067           rem       buffer could be allocated, otherwise to one location
2068           rem       further on
2069           rem
2070           lda       t.echo,1  is there an echo buffer?
2071           tze       puo005-*  no, we'll have to get one
2072           tsy       a.c004-*,*          (setbpt) yes, get virtual address
2073           cax3
2074           tra       puo010-*  proceed
2075           rem                 set up echo buffer
2076 puo005    ilq       bufsiz
2077           tsy       a.c001-*,*          (getubf) get a buffer
2078           tra       puo020-*  couldn't get one, never mind
2079 *
2080           sta       t.echo,1  now we have it, save (absolute) address
2081           ldq       putsq-*   copy char back to q
2082           cx3a                get (virtual) pointer to
2083           ada       l.c001-*  first data char. save it in
2084           sta       eb.inp,3  input and
2085           sta       eb.out,3  output pointers
2086           stz       eb.tly,3  initialize tally
2087 puo010    tsy       putin-*   put the character in
2088           tra       puobak-*  if no more room, skip other stuff
2089           rem
2090           aos       putone-*
2091           ila       1         mark the echoed flag
2092           orsa      a.c003-*,*          inecho
2093 puobak    return    putone
2094           rem
2095 puo020    null                allocation failure, meter it
2096           cmeter    mincs,m.inaf,l.c011-*
2097           tra       puobak-*
2098           rem
2099           rem
2100 a.c001    ind       getubf    subr to get an unreserved buffer
2101 a.c002    ind       oldpos
2102 a.c003    ind       inecho
2103 a.c004    ind       setbpt
2104           rem
2105 l.c001    zero      eb.dta,b.1          offset of first char. position
2106 l.c002    oct       37        mask for mod 32
2107 l.c003    vfd       18/tfbel
2108 l.c004    vfd       18/tfecpx
2109 l.c005    vfd       18/tftbec
2110 l.c006    vfd       18/tffip
2111 l.c007    oct       077777
2112 l.c008    vfd       18/hslafl
2113 l.c009    vfd       18/tflfec
2114 l.c010    oct       1000
2115 l.c011    dec       1
2116           rem
2117           rem
2118 puttmp    bss       1
2119           ttls      negotiated echo handler
2120           rem
2121           rem       called by inproc when would normally
2122           rem       do echoplex echoing
2123           rem       x1 is tib, return a nonzero if echoed, 0 if did not.
2124           rem       inchar in a
2125           rem
2126 echngo    subr      eng
2127           rem
2128           sta       engich-*
2129           lda       t.flg3,1  breakall?
2130           cana      l.s002-*  =tfbral no echo if not
2131           tze       eng180-*
2132           szn       t.scll,1  is there room left to echo?
2133           tze       eng180-*  no, dont attempt to echo.
2134           lda       engich-*  Take a look at char
2135           rem
2136           rem       check char's bit in table.
2137           rem
2138           iana      15        get low bits
2139           ada       l.s001-*  build instruction
2140           sta       eng020-*
2141           lda       engich-*  get char
2142           arl       4         get high bits
2143           sta       engtmp-*
2144           ldx2      t.entp,1  damn well better be table
2145           tnz       2         or r0 screwed up
2146           die       99
2147           adcx2     engtmp-*  build word address
2148           lda       dl.hsz,2  get table word
2149 eng020    bss       1         test high bit
2150           tmi       eng180-*  this is a true break, no echo.
2151           rem
2152           rem       now we have to echo this thing.
2153           rem
2154           ldq       engich-*
2155           ila       0
2156           cax2
2157           tsy       a.s002-*,*          until we have something cleverer
2158           rem
2159           stz       t.sncc,1  we echoed this char, so zero the
2160           rem                 protocol sync count of chars not
2161           rem                 echoed since echoed char.
2162           rem
2163           rem       char has been echoed, update line length left.
2164           ila       -1
2165           asa       t.scll,1  decrement line space left
2166           rem                 and return nonzero a.
2167           tra       engret-*
2168           rem
2169 eng180    stz       t.scll,1  turn off all further echnego
2170           ila       0         say that we did not echo
2171           rem                 inproc will aos t.sncc apropriately
2172 engret    return    echngo
2173           rem
2174 l.s001    als       0         instruction template
2175 l.s002    vfd       18/tfbral
2176 a.s001    ind       ecgifl
2177 a.s002    ind       puteco
2178 engich    bss       1
2179 engtmp    bss       1
2180           rem
2181           ttls      outprc subroutine -- for output subop
2182           rem       subroutine called by both lsla_man and hsla_man
2183           rem       to process output subop of dcw list
2184           rem
2185           rem       x1 - virtual tib address
2186           rem
2187 opend     bool      77
2188 pradd     equ       1
2189 kyadd     equ       2
2190 outmsg    equ       3
2191 repeat    equ       4
2192 maxctl    equ       4         maximum number of words in addressing string
2193           rem
2194 nbftmk    bool      /buftmk
2195           rem
2196           rem
2197 outprc    subr      out,(a,q,x2,x3)
2198           rem
2199           rem
2200           lda       t.dcwa,1
2201           ora       l.o001-*  0,b.0
2202           cax3                point to first character of "output"
2203           rem
2204 out010    null
2205           iacx3     0,b.1     next char.
2206           lda       0,3,b.0   pick it up
2207           cmpa      l.o002-*  =o000400
2208           tpl       out020-*  if less than 400(8),
2209           tsy       a.o001-*,*          literal char is to be inserted in buffer
2210           rem                 (insert)
2211           tra       out010-*  and get next
2212           rem
2213 out020    null
2214           iana      255       we know high-order bit is on, so turn
2215           rem                 it off for easier comparison
2216           tze       out090-*  die if result is zero
2217           rem
2218           icmpa     opend
2219           tze       out200-*  end of subop
2220           rem
2221           icmpa     kyadd+1   printer or keyboard addressing?
2222           tpl       out050-*
2223           rem                 yes, get device table pointer
2224           rem                 but first check and make sure tfctrl is on
2225           caq
2226           lda       l.o003-*  =tfctrl
2227           cana      t.flg,1
2228           tze       out010-*  if it isn't, skip this item
2229           rem
2230           ldx2      a.o002-*  address of control tables
2231           ldx2      ct.dev,2
2232           adcx2     t.type,1
2233           ldx2      -1,2      now points to correct device tab entry
2234           cqa                 restore control char
2235           icmpa     kyadd
2236           tze       out030-*
2237           lda       dt.prt,2  get pointer to printer addr sequence
2238           szn       t.ocur,1  if there's already an output chain,
2239           tze       out028-*
2240           sta       otemp-*   put printer addr ahead of it
2241           ldq       t.ocp,1   which means putting it at head of pending output
2242           lda       t.olst,1  get end of t.ocur chain
2243           tsy       a.o004-*,*          (setbpt) virtualize it
2244           cax2
2245           stq       bf.nxt,2  hook t.ocp chain on at end
2246           lda       t.ocur,1  this becomes new t.ocp chain
2247           sta       t.ocp,1
2248           rem
2249           stz       t.ocur,1  clear current output chain
2250           stz       t.olst,1
2251           stz       t.ocnt,1
2252           rem
2253           lda       otemp-*   restore a register
2254 out028    null
2255           tra       2         skip over fetch of kybd string
2256 out030    null
2257           lda       dt.key,2  get keyboard addr sequence
2258           ora       l.o001-*  0,b.0
2259           cax2                point to beginning of string
2260           ldq       0,2,b.0   get character count in q
2261           rem
2262 out040    null
2263           iacx2     0,b.1     get next char.
2264           lda       0,2,b.0
2265           tsy       a.o001-*,*          (insert) put it in output buffer
2266           iaq       -1        more?
2267           tnz       out040-*  yes, get next addressing char
2268           tra       out010-*  else get next output char
2269           rem
2270 out050    null
2271           icmpa     outmsg    thread output message into chain?
2272           tnz       out080-*
2273           rem                 yes
2274           stz       ohldot-*  turn off local flag
2275           lda       t.ocp,1   get pointer to head of output chain
2276           tze       out075-*  if there isn't one, nothing to do
2277           caq                 save absolute address in q
2278           tsy       a.o004-*,*          (setbpt)
2279           cax2                get virtual in x2
2280           lda       bf.flg,2  get buffer flags
2281           cana      l.o010-*  check hold output buffer flag
2282           tze       out054-*  not on - usual outmsg
2283           stz       t.ocur,1
2284           rem
2285           aos       ohldot-*  turn on local flag
2286 out052    stq       t.olst,1
2287           cana      l.o011-*  check last buffer in message flag
2288           tnz       out054-*  yes - end of partial chain
2289           lda       bf.nxt,2  advance to next buffer
2290           tze       out054-*  end of chain
2291           caq                 hang on to absolute address
2292           tsy       a.o004-*,*          (setbpt) virtualize address
2293           cax2
2294           lda       bf.flg,2  get buffer flags
2295           tra       out052-*  loop
2296 out054    ldq       t.ocp,1   get pointer to output chain
2297           szn       t.ocur,1  are we currently working on one?
2298           tnz       out060-*
2299           stq       t.ocur,1  no, make head of chain current buffer
2300           cqa
2301           tsy       a.o004-*,*          setbpt
2302           iaa       bf.dta    and point t.occh to first char slot
2303           ora       l.o001-*  =0,b.0
2304           sta       t.occh,1
2305           lda       t.ocur,1
2306           szn       ohldot-*  check local flag
2307           tze       out070-*
2308           tra       out075-*  skip all this other stuff
2309           rem
2310 out060    null                there is a chain, make sure
2311           lda       t.olst,1  t.olst really points to last buffer
2312           tsy       a.o004-*,*          (setbpt) get virtual address
2313           cax2
2314           szn       bf.nxt,2
2315           tze       2
2316           die       11
2317           rem
2318           stq       bf.nxt,2  now hook new chain to last buffer
2319 out070    null
2320           aos       t.ocnt,1  increment output buffer count
2321           cqa                 convert to virtual for local storage
2322           tsy       a.o004-*,*          (setbpt)
2323           cax2
2324           stx2      obufad-*  save this address for later
2325           lda       t.flg2,1  block-acknowledgement mode?
2326           ana       l.o009-*  =tfblak+tfofc
2327           cmpa      l.o009-*  see if they're both on
2328           tnz       out071-*  no, proceed
2329           lda       bf.tly,2  yes, we must check to see if buffer ends in etb
2330           ana       l.o012-*  buftmk
2331           iaa       -1        back up one to get right word
2332           lrs       1         separate word and char parts of address
2333           ada       l.o013-*  (bf.dta,b.0) a now points to word of last char
2334           qls       0         one more char?
2335           tpl       2         no
2336           ora       l.o014-*  (0,b.1), yes, account for it
2337           ada       obufad-*  add address of base of buffer
2338           cax2                x2 now points to last char
2339           lda       t.ofch,1  get flow control chars
2340           arl       9         isolate eond-of-block char
2341           cmpa      0,2,b.0   is this it?
2342           tnz       out071-*  no, proceed normally
2343           aos       t.omct,1  yes, count the message
2344           ldx2      obufad-*  and break chain here
2345           cx2a                convert it ot absolute for permanent storage
2346           tsy       a.o005-*,*          cvabs
2347           sta       t.olst,1
2348           lda       bf.nxt,2  keep the remains in t.ocp
2349           sta       t.ocp,1
2350           stz       bf.nxt,2  detach the chain
2351           tze       out073-*  if there is no more, check for sendout
2352           tra       out075-*  else we're done -- don't turn on tfwrit
2353 out071    ldx2      obufad-*  restore current buffer address
2354           ldq       bf.nxt,2  search chain for new end
2355           tnz       out070-*
2356           rem
2357           lda       l.o008-*  (=tfwrit) turn on tfwrit now
2358           orsa      t.flg,1   not before.
2359           rem
2360           cx2a
2361           tsy       a.o005-*,*          (cvabs)
2362           sta       t.olst,1
2363           stz       t.ocp,1   zero output chain pointer to allow
2364           rem                 for new one
2365 out073    ila       bufthr    get output buffer threshold
2366           cmpa      t.ocnt,1  if we're not over it,
2367           tmi       out075-*
2368           ilq       sndout    ask for more output
2369           tsy       a.o003-*,*          denq
2370           rem
2371 out075    null
2372           iacx3     0,b.1     get next char
2373           lda       0,3,b.0   had better be end of subop
2374           cmpa      l.o005-*  =477
2375           tze       out200-*
2376           die       7
2377           rem
2378 out080    null                only remaining possibility
2379           icmpa     repeat    is repeat
2380           tze       out100-*
2381 out090    null
2382           die       9
2383           rem
2384 out100    null
2385           lda       0,3,b.1   get character to be repeated
2386           iacx3     1,b.0
2387           ldq       0,3,b.0   get repeat count
2388           tnz       2         where 0 means 512
2389           ldq       l.o006-*  =512
2390           rem
2391 out110    null
2392           tsy       a.o001-*,*          insert
2393           iaq       -1        repeat count exhausted?
2394           tnz       out110-*  no, do it again
2395           tra       out010-*  yes, get next item
2396           rem
2397           rem
2398 out200    null                end of output subop
2399           cx3a
2400           ana       l.o007-*  =o077777 convert to word addressing
2401           iaa       1         point to next word
2402           caq                 save new address
2403           sba       t.dcwa,1  get number of words processed
2404           sta       otemp-*
2405           lda       t.dcwl,1  decrement dcw length accordingly
2406           sba       otemp-*
2407           sta       t.dcwl,1
2408           stq       t.dcwa,1  save new dcw list pointer
2409           return    outprc
2410 *
2411           rem
2412           rem
2413 l.o001    zero      0,b.0     for character addressing
2414 l.o002    oct       400
2415 l.o003    vfd       18/tfctrl
2416 l.o004    vfd       18/maxctl
2417 l.o005    oct       477
2418 l.o006    dec       512
2419 l.o007    oct       77777
2420 l.o008    vfd       18/tfwrit
2421 l.o009    vfd       18/tfblak+tfofc
2422 l.o010    vfd       18/bffhld hold output buffer flag
2423 l.o011    vfd       18/bfflst last buffer in message flag
2424 l.o012    vfd       18/buftmk
2425 l.o013    zero      bf.dta,b.0
2426 l.o014    zero      0,b.1
2427           rem
2428 otemp     bss       1         temporary storage
2429 obufad    bss       1         temporary for buffer address
2430 ohldot    bss       1         flag - on if hold output buffers set
2431           rem
2432 a.o001    ind       insert
2433 a.o002    ind       ctrl
2434 a.o003    ind       denq
2435 a.o004    ind       setbpt
2436 a.o005    ind       cvabs
2437           rem
2438           ttls      insert -- subroutine to insert a char into output chain
2439           rem
2440           rem       insert called by outprc to insert char (passed in a)
2441           rem
2442 insert    subr      ins,(a,q,x2,x3)
2443           rem
2444           rem
2445           szn       t.ocur,1  is there a buffer chain?
2446           tnz       ins010-*
2447           rem                 no, must allocate a buffer
2448           ilq       bufsiz
2449           tsy       a.p001-*,*          getbfh
2450           die       10        die if we couldn't get one
2451           rem
2452           sta       t.ocur,1  this is now current buffer
2453           sta       t.olst,1  last one, too
2454           tsy       a.p002-*,*          setbpt
2455           cax3                now have virtual address in a and x3
2456           sta       insbuf-*  save it for later also
2457           iaa       bf.dta    point output char. pointer at
2458           ora       l.p001-*  (0,b.0)  first data char of new chain
2459           sta       t.occh,1
2460           tra       ins030-*
2461           rem
2462 ins010    null                find out if last buffer is full
2463           lda       t.olst,1
2464           tsy       a.p002-*,*          (setbpt)
2465           cax3
2466           tsy       l.p002-*,*          =addr(fulbuf)
2467           rem                 returns normally if full
2468           rem                 or +1 with tally in a
2469           tra       ins020-*
2470           stx3      insbuf-*  save virtual address for later
2471           lrs       1         get tally in words but save
2472           sta       itemp1-*  low-order bit in q
2473           cx3a
2474           iaa       bf.dta
2475           ada       itemp1-*
2476           ora       l.p001-*  0,b.0
2477           cax3
2478           qls       0         was tally odd?
2479           tpl       ins040-*
2480           iacx3     0,b.1     yes, bump data pointer
2481           tra       ins040-*
2482           rem
2483 ins020    null
2484           ilq       bufsiz    buffer was full, get another
2485           tsy       a.p001-*,*          getbfh
2486           die       10        die if we can't
2487           rem
2488           caq                 hang on to absoute address
2489           lda       t.olst,1
2490           tsy       a.p002-*,*          (setbpt)
2491           cax2
2492           stq       bf.nxt,2  save in old last buffer's
2493           rem                 forward pointer
2494           cqa                 have to revirtualize
2495           tsy       a.p002-*,*          to make sure pte is right
2496           cax3                save virtual address
2497           sta       insbuf-*  store it for later also
2498           iaa       bf.dta    point to first data char
2499           ora       l.p001-*  0,b.0
2500           stq       t.olst,1  set new last buffer
2501 ins030    null                mark this buffer as containing control chars
2502           caq                 save the a reg.
2503           lda       l.p006-*  =bffctl
2504           orsa      bf.flg,3
2505           cqa
2506           rem
2507           cax3
2508           rem
2509           rem
2510 ins040    null                x3 points to where char should go
2511           lda       inssa-*   get the char
2512           sta       0,3,b.0   store it in buffer
2513           ldx2      insbuf-*  get addressable pointer to buffer
2514           lda       bf.tly,2  get the old tally
2515           ana       l.p003-*  =buftmk
2516           iaa       1         bump it
2517           sta       itemp1-*  save it
2518           lda       l.p005-*  =^buftmk
2519           ansa      bf.tly,2  zero out tally field
2520           lda       itemp1-*  so as to replace it
2521           orsa      bf.tly,2
2522           return    insert
2523           rem
2524           rem
2525           rem
2526 l.p001    zero      0,b.0     character addressing
2527 l.p002    ind       fulbuf    routine to see if buffer full
2528 l.p003    vfd       18/buftmk
2529 l.p004    dec       4
2530 l.p005    vfd       18/nbftmk complement mask for tally
2531 l.p006    vfd       18/bffctl
2532           rem
2533 itemp1    bss       1         temporary storage
2534 insbuf    bss       1         virtual address of t.olst
2535           rem
2536 a.p001    ind       getbfh    buffer allocation routine
2537 a.p002    ind       setbpt
2538           rem
2539           ttls      fulbuf subroutine finds out if buffer is full
2540           rem
2541           rem       this subroutine, passed a buffer address in
2542           rem       x3, looks to see if tally indicates that buffer
2543           rem       is full.
2544           rem
2545           rem       returns to callpoint+1 if buffer is full
2546           rem       else to callpoint+2 with tally in a
2547           rem
2548 fulbuf    subr      ful
2549           rem
2550           lda       bf.siz,3
2551           arl       15        isolate size code
2552           iaa       1
2553           mpf       l.f002-*  =bufsiz
2554           rem                 mpf comes out double so it gives number of chars
2555           sbq       l.f001-*  =4 (4 chars worth of header)
2556           stq       ftemp-*
2557           lda       bf.tly,3  get tally
2558           ana       l.f003-*  =buftmk
2559           cmpa      ftemp-*   tally>=size?
2560           tpl       2         yes, regular return
2561           aos       fulbuf-*  else return+1
2562           return    fulbuf
2563           rem
2564           rem
2565 l.f001    dec       4         number words of buffer header
2566 l.f002    vfd       18/bufsiz
2567 l.f003    vfd       18/buftmk mask for buffer tally
2568 ftemp     bss       1
2569           ttls      metering subroutines
2570           rem
2571 ************************************************************************
2572 *
2573 *         meterc  -- adds one to a "counting" meter
2574 *
2575 *         index of meter to be incremented is passed in q reg.
2576 *
2577 ************************************************************************
2578           rem
2579 meterc    subr      mtc,(inh,q,x3)
2580           rem
2581           ldi       l.d001-*  (o024000) inhibit overflow
2582           cmpq      cmax-*    is value legal?
2583           tnc       mtc010-*
2584           aos       meterr-*  if not, meter invalid call
2585           tra       mtcbak-*  and return
2586           rem
2587 mtc010    null
2588           ldx3      mtcsq-*   ok, get meter name into x3
2589           aos       cmetrs-*,*          increment it
2590 mtcbak    return    meterc
2591           rem
2592           rem
2593 ************************************************************************
2594 *
2595 *         metert  -- increments a "time" meter
2596 *
2597 *         index of meter is passed in q reg.
2598 *         increment (in microseconds) is passed in a reg.
2599 *
2600 ************************************************************************
2601           rem
2602 metert    subr      mtt,(inh,a,q,x3)
2603           rem
2604           ldi       l.d001-*  (o024000) inhibit overflow
2605           cmpq      tmax-*    is meter index too big?
2606           tnc       mtt010-*  if so, meter that
2607           aos       meterr-*
2608           tra       mttbak-*  and return
2609           rem
2610 mtt010    qls       1         multiply by two for indexing
2611           stq       mttemp-*  (time meters are 2 words each)
2612           ldx3      mttemp-*  index into x3
2613           lrs       18        time into aq
2614           adaq      tmetrs-*,*          increment meter
2615           staq      tmetrs-*,*
2616 mttbak    return
2617           rem
2618           rem
2619           rem
2620 meterr    zero                invalid meter count
2621           rem
2622           rem
2623           rem
2624 l.d001    oct       024000    "inhibit overflow" & "inhibit interrupts"
2625           rem
2626           rem
2627 mttemp    bss       1
2628 tmax      zero      tmaxd/2   maximum value for "time" meters
2629           rem
2630           rem
2631 cmetrs    ind       *+1,3     "count" meters
2632           bss       50
2633 cmax      zero      *-cmetrs-1          maximum value for a count meter
2634           rem
2635           rem
2636 tmetrs    ind       tmorg,3   "timing" meters
2637           even
2638 tmorg     null
2639           bss       100
2640 tmaxd     equ       *-tmorg
2641           ttls      virtual/absolute address conversion routines
2642 ************************************************************************
2643 *
2644 *  setptw
2645 *         converts an 18 bit absolute address to a 15 bit virtual
2646 *         address and sets up the page table entry in the cpu page
2647 *         table.  this routine is only required if more than 32K of
2648 *         memory is configured for a dn6670.  a 'tra -1' is stored into
2649 *         setptw+1 by init if otherwise.
2650 *
2651 *  input:
2652 *         a reg - 18 bit absolute address
2653 *
2654 *  output:
2655 *         a reg - 15 bit virtual address
2656 *
2657 *  modified registers: none
2658 *
2659 ************************************************************************
2660           rem
2661           rem                 a 'tra -1,*' is stored in setptw+1 by init if
2662           rem                 only 32k is configured
2663 setptw    subr      ptw,(inh,x2)        cannot allow interruptions
2664           ldx2      a.v001-*,*          .crpte
2665           tsy       setpte-*
2666           ora       l.v001-*  concatenate with window address
2667           return    setptw    all done
2668           rem
2669           rem
2670 ************************************************************************
2671 *
2672 *  setbpt
2673 *      like setptw except used for buffer addresses. sets pte for buffer
2674 *      window rather than general address window
2675 *
2676 ************************************************************************
2677           rem
2678 setbpt    subr      bpt,(inh,x2)
2679           cmpa      l.v003-*  =o100000
2680           tmi       bptbak-*  not in high memory, leave it alone
2681           ldx2      a.v002-*,*          .crbpe
2682           tsy       setpte-*  to do the work
2683           ora       l.v002-*  (bwndow) concatenate window base
2684 bptbak    return    setbpt
2685           eject
2686 ************************************************************************
2687 *
2688 *  setpte
2689 *      common subroutine used to set a page table entry
2690 *
2691 *  input:
2692 *      a reg - 18 bit absolute address
2693 *      x2    - address of page table entry
2694 *
2695 *  output:
2696 *      a reg - low-order 8 bits of virtual address (offset in page)
2697 *
2698 ************************************************************************
2699           rem
2700 setpte    subr      spt
2701           sta       sargsv-*  save to provide offset
2702           iana      -256      get page number
2703           iora      pte.a     turn on active bit
2704           sta       0,2       put in relevant page table entry
2705           lda       sargsv-*  get page offset
2706           iana      255
2707           return    setpte
2708           rem
2709           rem
2710 ************************************************************************
2711 *
2712 *  cvabs
2713 *      routine to convert virtual address to absolute.
2714 *      assumes corresponding page table entry (buffer or tib/sfcm)
2715 *      points to correct page.
2716 *
2717 *  input:
2718 *      a reg - 15-bit virtual address
2719 *
2720 *  output:
2721 *      a reg - corresponding 18-bit absolute address
2722 *
2723 ************************************************************************
2724           rem
2725 cvabs     subr      cva,(inh,q,x2)
2726           cmpa      l.v002-*  (bwndow) make sure address is in a window
2727           tmi       cvabak-*  it's below
2728           cmpa      l.v003-*  (=o100000) not a virtual address at all
2729           tpl       cvabak-*  it's above
2730           caq                 hang on to address
2731           cmpa      l.v001-*  (window) which window is it in?
2732           tpl       cva010-*  tib/sfcm
2733           ldx2      a.v002-*,*          (.crbpe) buffer
2734           sba       l.v002-*  bwndow
2735           tra       cva020-*
2736 cva010    ldx2      a.v001-*,*          .crpte
2737           sba       l.v001-*  window
2738 cva020    sta       cvaoff-*  save offset within page
2739           lda       0,2       get real address of page base
2740           icana     pte.a     make sure it's active
2741           tnz       cva030-*  yes
2742           cqa                 no, restore original address
2743           tra       cvabak-*  return
2744 cva030    null
2745           iana      -256      reduce to address only
2746           ada       cvaoff-*  add offset
2747 cvabak    return    cvabs     done
2748           rem
2749 pte.r     bool      200       page table entry read only bit
2750 pte.s     bool      100       page table entry security bit
2751 pte.a     bool      40        page table entry active bit
2752 window    bool      77400     base address of paged memory
2753 bwndow    bool      77000     base address of buffer window
2754           rem
2755 a.v001    ind       .crpte
2756 a.v002    ind       .crbpe
2757           rem
2758 l.v001    vfd       18/window
2759 l.v002    vfd       18/bwndow
2760 l.v003    oct       100000    smallest address outside 32k
2761           rem
2762 sargsv    oct       0         storage for argument
2763 cvaoff    bss       1
2764           ttls      move with paging on source or target address
2765 ************************************************************************
2766 *
2767 *  mvpgsc
2768 *         this entry moves a block of data from an absolute location anywhere
2769 *         in the fnp memory using the paging mechanism to a target in the lower
2770 *         32k of fnp memory.
2771 *
2772 *  mvpgtg
2773 *         this entry moves a block of data from the lower 32k of fnp memory
2774 *         to a target anywhere in fnp memory using the paging mechanism.
2775 *
2776 *         either entry can be directed to cross page boundaries and to start
2777 *         and end anywhere in a page.  each time a page boundary is crossed
2778 *         the page table entry for the virtual window will be initialized.
2779 *
2780 *  input registers:
2781 *         x2        source address
2782 *         x3        target address
2783 *         q         length of move
2784 *
2785 *  output registers:
2786 *         none
2787 *
2788 *  modified registers: a, q, x2, x3
2789 *
2790 *  unmodified registers: x1
2791 *
2792 ************************************************************************
2793           rem
2794           rem
2795 *
2796 *  entry points
2797           rem
2798 mvpgsc    subr      mps,(inh)
2799           lda       mvpgsc-*  set up a common return point
2800           sta       mvpgtg-*
2801           lda       mpssi-*
2802           sta       mptsi-*
2803           stx2      mabsad-*  save as absolute address to virtualize
2804           lda       l.w001-*  'cax2' inst to set up x2 with virtual address
2805           sta       mvp080-*
2806           cx3a                for checking non-paged address
2807           tra       mvp000-*
2808           rem
2809 mvpgtg    subr      mpt,(inh)
2810           stx3      mabsad-*  save as absolute address to virtualize
2811           lda       l.w002-*  'cax3' inst to set up x3 with virtual address
2812           sta       mvp080-*
2813           cx2a                for checking non-paged address
2814 *
2815 *  check input values
2816           rem
2817 mvp000    null
2818           ldi       l.w004-*  (=o024000) inhibit overflow for logical adds
2819           sta       mtstad-*  save for compare
2820           stq       mrmlen-*  total length of move
2821           ldq       mvplmm-*  get last legal lower memory address
2822           cmpq      mtstad-*  is non-paged starting address below
2823           rem                  lower memory maximum?
2824           tpl       2         yes
2825           die       14        no. this shouldn't happen
2826           ada       mrmlen-*  calculate ending non-paged address
2827           iaa       -1
2828           sta       mtstad-*  save for compare
2829           cmpq      mtstad-*  is non-paged ending address below
2830           rem                  lower memory maximum?
2831           tpl       2         yes
2832           die       14        no. this shouldn't happen
2833           ldq       a.w001-*,*          (.crmem) get last legal absolute address
2834           cmpq      mabsad-*  is starting absolute address ok?
2835           tpl       2         yes
2836           die       14        no. this shouldn't happen
2837           lda       mabsad-*  calculate ending absolute address
2838           ada       mrmlen-*
2839           iaa       -1
2840           sta       mtstad-*  save for compare
2841           cmpq      mtstad-*  is this address ok?
2842           tpl       2         yes
2843           die       14        no. this shouldn't happen
2844           ldq       mrmlen-*  is length of move > 0?
2845           tnz       2         yes
2846           die       1         no. this shouldn't happen
2847 *
2848 *  set up length of first move
2849           rem
2850           lda       mabsad-*  calculate number of words in first page
2851           iana      -256
2852           ada       l.w003-*  (=256)
2853           sba       mabsad-*  now have it
2854           cmpa      mrmlen-*  will first pass move all?
2855           tnc       mvp020-*  no
2856           stz       mrmlen-*  yes
2857           tra       mvp040-*  go do it
2858           rem
2859 mvp020    null
2860           caq                 length of first move
2861           stq       mvllmp-*  save it for absolute address update
2862           iera      -1        calculate remaining length of total move after
2863           iaa       1          first pass
2864           asa       mrmlen-*
2865           rem
2866 mvp040    null
2867           lda       mabsad-*  setup to virtualize absolute address
2868 *
2869 *  virtualize source or target address
2870           rem
2871 mvp060    null                outer move loop point
2872           tsy       setptw-*  virtualize and set ptw
2873           rem
2874 mvp080    oct       0         this location is set to 'cax2' or 'cax3' inst
2875           rem
2876 *
2877 *  paged move loop
2878           rem
2879 mvp100    null                move no more than one page here
2880           lda       0,2       get one source word
2881           sta       0,3       store in target
2882           iacx2     1         update pointers
2883           iacx3     1
2884           iaq       -1        is current page moved?
2885           tnz       mvp100-*  no. continue move
2886 *
2887 *  check if whole move is finished
2888           rem
2889           ldq       mrmlen-*  has everything been moved?
2890           tze       mvpret-*  yes. return
2891 *
2892 *  update absolute address
2893           rem
2894           lda       mabsad-*  update absolute address
2895           ada       mvllmp-*   with length of last move pass
2896           sta       mabsad-*
2897 *
2898 *  set up length of next move pass
2899           rem
2900           sbq       l.w003-*  (=256) update length of total remaining move
2901           stq       mrmlen-*  is it negative?
2902           tmi       mvp110-*  yes
2903           ldq       l.w003-*  (=256) no. move a whole page
2904           stq       mvllmp-*
2905           tra       mvp060-*  move some more
2906           rem
2907 mvp110    null
2908           adq       l.w003-*  (=256) back up last subtract
2909           stz       mrmlen-*  last pass coming up
2910           tra       mvp060-*  go do it
2911           rem
2912 mvpret    null
2913           return    mvpgtg
2914           rem
2915           rem
2916 a.w001    ind       .crmem    last legal memory address
2917           rem
2918 l.w001    cax2
2919 l.w002    cax3
2920 l.w003    dec       256
2921 l.w004    oct       024000    inhibit interrupts and overflow
2922           rem
2923 mabsad    oct       0         absolute address
2924 mrmlen    oct       0         current remaining total length of move
2925 mtstad    oct       0         test address value for legalness
2926 mvllmp    oct       0         length of last move pass
2927 mvplmm    zero                move paged lower memory maximum address
2928           ttls      mcs space management routines
2929 ************************************************************************
2930 *
2931 *         format of buffer pool header
2932 *
2933 ************************************************************************
2934           rem
2935 fp.fst    equ       0         pointer to first free block
2936           rem
2937 ************************************************************************
2938 *
2939 *         format of free block
2940 *
2941 ************************************************************************
2942           rem
2943 fb.nxt    equ       0         next block pointer
2944 fb.siz    equ       1         size of this block in words
2945           eject
2946 ************************************************************************
2947 *
2948 *         subroutine to allocate buffer space in low memory.
2949 *         the request is rounded up to a 'bufsiz' boundary
2950 *         and removed from the full buffer pool.
2951 *
2952 *         calling sequence:
2953 *
2954 *                   q  =  size of space to allocate
2955 *
2956 *         returns:
2957 *
2958 *                   returns in line if request fails
2959 *                   takes skip return if request suceeds
2960 *                   x3 -> space allocated
2961 *
2962 ************************************************************************
2963           rem
2964 getbuf    subr      gbf,(inh,a,q,x1)
2965           tsy       a.y011-*,*          (timein) record time entered
2966           cqa                 number of words to allocate
2967           tsy       a.y005-*,*          (chksiz) check for valid size
2968           iaa       bufsiz-1  round to multiple of bufsiz
2969           iana      -bufsiz
2970           caq
2971           ldx1      a.y003-*  =addr(.crnxa) start of chain
2972           tsy       a.y006-*,*          (getspc) allocate the space
2973           tra       gbfnsp-*  failed
2974 gbfok     aos       getbuf-*  succeeded, setup skip return
2975           staq      gbfaq-*   safe store aq (smeter uses them)
2976           smeter    mincd,.mbufa,l.y001-*
2977           ldaq      gbfaq-*   restore them
2978           rem
2979 *         update .crnbf
2980           rem
2981           ars       bufshf    convert from words to buffers
2982           iera      -1        complement
2983           iaa       1
2984           asa       a.y001-*,*          update .crnbf
2985           tsy       a.y013-*,*          (setsc) set size code and clear buffer
2986           rem
2987           trace     mt.get,0,(x3,gbfsq,getbuf,gbfsx1)
2988           rem
2989 gbfbak    ila       0         indicate allocation call
2990           tsy       a.y012-*,*          extime
2991           return    getbuf
2992           rem
2993 *         request for buffers failed. try cleaning up small space
2994           rem
2995 gbfnsp    tsy       a.y002-*,*          (=fresml) this does cleanup
2996           tra       gbfng-*   didn't do any good
2997           tsy       a.y006-*,*          (getspc) retry request
2998           tra       gbfng-*   still fails
2999           tra       gbfok-*   this made request work
3000           rem
3001 gbfng     smeter    mincs,.malof,l.y001-*
3002           tra       gbfbak-*
3003           eject
3004 ************************************************************************
3005 *
3006 *         procedure for getting a small amount of memory. the
3007 *         calling sequence is the same as for getbuf, except
3008 *         the request is rounded to an even number, and the returned
3009 *         address will only be on an even boundary
3010 *
3011 ************************************************************************
3012           rem
3013 getmem    subr      gtm,(inh,a,q,x1)
3014           tsy       a.y011-*,*          timein
3015           cqa                 word count
3016           tsy       a.y005-*,*          (chksiz) check for valid size
3017           iaa       1         make it even
3018           iana      -2
3019 gbfsml    caq                 word count
3020           ldx1      a.y009-*  =addr(.crnxs)
3021           tsy       a.y006-*,*          (getspc) look in small space chain
3022           tra       gbfail-*  not there
3023           aos       getmem-*  found it, take skip
3024           tsy       a.y014-*,*          (clrbuf) go clear space
3025           rem
3026           trace     mt.get,0,(x3,gtmsq,getmem,gtmsx1)
3027           rem
3028 gtmbak    ila       0         indicate allocate call
3029           tsy       a.y012-*,*          extime
3030           return    getmem
3031           rem
3032 *         must allocate more buffers for small space
3033           rem
3034 gbfail    sta       gbftmp-*  save word count
3035           iaa       bufsiz-1  round to next multiple
3036           iana      -bufsiz
3037           caq
3038           ldx1      a.y007-*  =addr(.crnxa)
3039           tsy       a.y006-*,*          (getspc) get buffer
3040           tra       gtmng-*   failed, give up
3041           ldx1      a.y009-*  =addr(.crnxs)
3042           tsy       a.y004-*,*          (relspc) free in to small chain
3043           ars       bufshf    convert to buffers
3044           asa       a.y010-*,*          increment .crnbs
3045           iera      -1        complement
3046           iaa       1
3047           asa       a.y001-*,*          decrement .crnbf
3048           lda       gbftmp-*  get original word count
3049           tra       gbfsml-*  retry allocate
3050           rem
3051 gtmng     smeter    mincs,.malof,l.y001-*
3052           tra       gtmbak-*
3053           rem
3054           rem
3055 a.y001    ind       .crnbf
3056 a.y002    ind       fresml
3057 a.y003    ind       .crnxa
3058 a.y004    ind       relspc
3059 a.y005    ind       chksiz
3060 a.y006    ind       getspc
3061 a.y007    ind       .crnxa
3062 *a.y008             unused
3063 a.y009    ind       .crnxs
3064 a.y010    ind       .crnbs
3065 a.y011    ind       timein
3066 a.y012    ind       extime
3067 a.y013    ind       setsc
3068 a.y014    ind       clrbuf
3069           rem
3070 l.y001    dec       1
3071           rem
3072 gbftmp    bss       1
3073           even
3074 gbfaq     bss       2
3075           eject
3076 ************************************************************************
3077 *
3078 *         timein: records the elapsed timer at entry so that the time
3079 *         spent in the allocation/freeing routines can be metered
3080 *
3081 ************************************************************************
3082           rem
3083 timein    subr      tmn
3084           lda       a.x001-*,*          etmb
3085           sta       sttime-*  record time of entry
3086           return    timein
3087           rem
3088           rem
3089 ************************************************************************
3090 *
3091 *         extime: records elapsed time at exit from
3092 *         allocation/freeing routines, for metering.
3093 *         also meters current use of buffer pool
3094 *
3095 *         input:
3096 *             a reg contains 0 for allocate, 1 for free
3097 *
3098 ************************************************************************
3099           rem
3100 extime    subr      ext,(a,q,x2)
3101           lda       a.y001-*,*          (.crnbf)
3102           ada       a.y010-*,*          (.crnbs)
3103           als       bufshf    convert to words for metering
3104           sta       savcnt-*
3105           smeter    mupdat,.mspav,savcnt-*
3106           rem
3107           rem                 measure time spent
3108           lda       a.x001-*,*          etmb (current elapsed timer value)
3109           sta       sttimx-*  save it (for debugging)
3110           sba       sttime-*  a now contains time spent
3111           ldx1      extsa-*   get alloc/free indicator
3112           ldx2      a.x002-*,*          get pointer to relevant structure
3113           lrl       18        make time into doubleword
3114           staq      loctim-*  hang on to it
3115           adaq      it.tot,2  update running total
3116           staq      it.tot,2
3117           ldaq      loctim-*
3118           cmpq      it.max,2  new maximum?
3119           tmi       2
3120           stq       it.max,2  yes, save it
3121           ilq       1         see if it's more than 1 msec.
3122           cmpq      loctim+1-*
3123           tpl       ext010-*  nope
3124           adaq      it.gt1,2  yes, add 1 (which happens to be in aq)
3125           staq      it.gt1,2  to count of same
3126           ila       0
3127           ilq       1         get the one back
3128 ext010    adaq      it.inc,2  update increment count
3129           staq      it.inc,2
3130           return    extime
3131           rem
3132           rem
3133 a.x001    ind       etmb
3134 a.x002    ind       itaddr,1
3135           rem
3136 savcnt    bss       1         number of free words (for metering)
3137 sttime    bss       1         elapsed timer reading at entry
3138 sttimx    bss       1         elapsed timer reading at exit
3139 itaddr    ind       getbfm
3140           ind       frebfm
3141           rem
3142           even
3143 loctim    bss       2         elapsed time while in routine
3144 getbfm    bss       8         time meters for get calls
3145 frebfm    bss       8         time meters for free calls
3146           eject
3147 ************************************************************************
3148 *
3149 *         subroutine to fill in buffer size code
3150 *         and zero the rest of the buffer
3151 *
3152 *         input:
3153 *             q contains size in words
3154 *             x3 points to buffer
3155 *
3156 ************************************************************************
3157           rem
3158 setsc     subr      ssc,(a,q,x3)
3159           iaq       -32       reduce by one unit
3160           qls       15-bufshf align in word
3161           stq       bf.siz,3
3162           stz       bf.nxt,3
3163           lda       sscsq-*   total words
3164           iaa       -2        number left to clear
3165           iacx3     2         starting address to clear
3166           tsy       clrbuf-*
3167           return    setsc
3168           rem
3169 ************************************************************************
3170 *
3171 *         subroutine to clear buffer or allocated space
3172 *
3173 *         input:
3174 *             x3 points to space to be cleared
3175 *             a contains number of words to clear
3176 *
3177 ************************************************************************
3178           rem
3179 clrbuf    subr      clr,(a,q,x3)
3180           ars       1         number of double words to clear
3181           iera      -1        complement
3182           iaa       1
3183           sta       clrtmp-*
3184           ila       0         constants to store
3185           ilq       0
3186 clr010    staq      0,3       zero two words
3187           iacx3     2
3188           aos       clrtmp-*
3189           tnz       clr010-*
3190           return    clrbuf
3191           rem
3192           rem
3193 clrtmp    bss       1
3194           eject
3195 ************************************************************************
3196 *
3197 *         subroutine to free buffer space in low memory
3198 *
3199 *         calling sequence:
3200 *
3201 *                   x3 -> space to be freed
3202 *                   q  =  size of space (or 0 meaning use buffer size code)
3203 *
3204 ************************************************************************
3205           rem
3206 frebuf    subr      fbf,(inh,a,q,x1)
3207           tsy       a.n001-*,*          timein
3208           cqa                 pick up size
3209           tnz       fbf010-*  size is given
3210           lda       fb.siz,3  get size code
3211           arl       15
3212           iaa       1         number of buffers
3213           als       bufshf    convert to words
3214           tra       fbf020-*
3215 fbf010    tsy       chksiz-*  check for valid size
3216           iaa       bufsiz-1  round to multiple of bufsiz
3217           iana      -bufsiz
3218 fbf020    sta       fretmp-*  save buffer size temporarily
3219           rem
3220           trace     mt.fre,0,(x3,fretmp,frebuf,fbfsx1)
3221           rem
3222           lda       fretmp-*
3223           ldx1      a.n002-*  =addr(.crnxa) free from full buffer chain
3224           caq
3225           tsy       a.n003-*,*          relspc
3226           ars       bufshf    get buffer count
3227           asa       a.n004-*,*          update .crnbf
3228           ila       1         indicate free call
3229           tsy       a.n005-*,*          extime
3230           return    frebuf
3231           rem
3232 fretmp    bss       1
3233           eject
3234 ************************************************************************
3235 *
3236 *         similiar entry for freeing memory
3237 *
3238 ************************************************************************
3239           rem
3240 fremem    subr      frm,(inh,a,q,x1)
3241           tsy       a.n001-*,*          timein
3242           cqa                 word count
3243           tsy       chksiz-*  check for valid size
3244           iaa       1         make it even
3245           iana      -2
3246           sta       fretmp-*  save size
3247           rem
3248           trace     mt.fre,0,(x3,fretmp,fremem,frmsx1)
3249           rem
3250           ldq       fretmp-*  retrieve size
3251           ldx1      a.n006-*  =addr(.crnxs)
3252           tsy       a.n003-*,*          relspc
3253           ila       1         indicate free call
3254           tsy       a.n005-*,*          extime
3255           return    fremem
3256           rem
3257           rem
3258 a.n001    ind       timein
3259 a.n002    ind       .crnxa
3260 a.n003    ind       relspc
3261 a.n004    ind       .crnbf
3262 a.n005    ind       extime
3263 a.n006    ind       .crnxs
3264           eject
3265 ************************************************************************
3266 *
3267 *         subroutine to check for a valid buffer size in the a
3268 *
3269 ************************************************************************
3270           rem
3271 chksiz    oct       0
3272           szn       bfcksw-*  should we check?
3273           tnz       chksiz-*,*          no
3274           icmpa     1
3275           tpl       2
3276           die       1
3277           cmpa      maxsiz-*
3278           tmi       2
3279           die       2
3280           tra       chksiz-*,*
3281           rem
3282 maxsiz    ind       bfmsiz+1
3283           rem
3284           symdef    bfcksw    indicates whether calls are checked
3285           rem
3286 bfcksw    oct       1         start out as no
3287           eject
3288 ************************************************************************
3289 *
3290 *         getbfh -- get a buffer in extended memory. address boundary
3291 *         will be chosen based on buffer size so as to ensure that no
3292 *         buffer spans a page boundary
3293 *
3294 *         input:
3295 *             q -- size in words
3296 *
3297 *         output:
3298 *             a -- absolute address of allocated buffer
3299 *             x3 -- virtual   "     "        "     "
3300 *             buffer window page table entry set up appropriately
3301 *
3302 ************************************************************************
3303           rem
3304 getubf    null                name retained for compatibility
3305 getbfh    subr      gfh,(inh,q,x1,x2)
3306           tsy       a.j007-*,*          timein
3307           cqa                 hang on to size
3308           tsy       a.j006-*,*          chksiz
3309           iaa       bufsiz-1
3310           iana      -bufsiz   round size to nearest multiple of bufsiz
3311           caq                 this is size we'll use
3312           stq       size-*    put it in cold storage
3313           ila       0         clear the a
3314           iaq       -1        and shift size-1
3315           lls       18-bufshf so as to get number of bufsiz blocks
3316           cax2                in order to force appropriate boundary
3317           adcx2     a.j003-*  addr (bounds)
3318           lda       0,2       get the boundary in the a
3319           sta       bndry-*   save it
3320           stz       prvadr-*  initialize
3321           lda       a.j001-*,*          (.crnxe) start search
3322           tze       gfh025-*  no extended memory at all
3323           rem
3324 gfh010    sta       blkadr-*  block we're testing
3325           tsy       a.j002-*,*          (setbpt) get virtual address
3326           cax2
3327           cana      bndry-*   is it properly aligned?
3328           tnz       gfh020-*  no, go to next free block
3329           lda       fb.siz,2  yes, is it big enough?
3330           cmpa      size-*
3331           tpl       gfh030-*  yes, use it
3332           rem                 look at next block
3333 gfh020    lda       blkadr-*  save block address as previous
3334           sta       prvadr-*
3335           lda       fb.nxt,2  get next
3336           tnz       gfh010-*  if any
3337           rem                 no usable blocks in high memory,
3338           rem                 try low
3339 gfh025    ldx1      a.j004-*  addr (.crnxa)
3340           ldq       size-*
3341           tsy       a.j009-*,*          (getspc) regular space allocating subroutine
3342           tra       gfh070-*  forget it, no space to be had
3343           stx3      blkadr-*  ok
3344           rem                 meter instance of having to use low memory
3345           smeter    mincs,.mblow,l.j001-*
3346           rem
3347           tra       gfh060-*  join common code
3348           rem                 found usable block in high memory
3349 gfh030    null                a contains size
3350           stx2      blkvir-*  save virtual address
3351           ldq       fb.nxt,2  pick up address of next free block
3352           sba       size-*    size of remainder
3353           tze       gfh040-*  none
3354           adcx2     size-*    this is address of new free block
3355           stq       fb.nxt,2  put forward pointer in
3356           sta       fb.siz,2  and size
3357           lda       blkadr-*  now get absolute address of allocated block
3358           ada       size-*
3359           caq                 now, however we got here, address
3360 gfh040    null                of next block is in q
3361           lda       prvadr-*  get address of previous block
3362           tze       gfh050-*  if any
3363           tsy       a.j002-*,*          (setbpt) make it usable
3364           cax2
3365           stq       fb.nxt,2  rethread new next block
3366           lda       blkadr-*  now get allocated block address back
3367           tsy       a.j002-*,*          (setbpt)
3368           cax3
3369           tra       gfh060-*  go turn it into a buffer
3370           rem
3371 gfh050    stq       a.j001-*,*          (.crnxe) new head of free chain
3372           ldx3      blkvir-*  we haven't lost its page
3373 gfh060    aos       getbfh-*  take successful return
3374           ldq       size-*    set the size code and clear the buffer
3375           tsy       a.j005-*,*          setsc
3376           rem                 now update .crnbf
3377           cqa                 get size in a
3378           ars       bufshf    convert to buffers
3379           iera      -1        complement
3380           iaa       1
3381           asa       a.j010-*,*          .crnbf
3382           rem
3383           smeter    mincd,.mbufa,l.j001-*
3384           rem
3385           trace     mt.get,0,(blkadr,gfhsq,getbfh,gfhsx1)
3386           rem
3387 gfhbak    ila       0
3388           tsy       a.j008-*,*          extime
3389           lda       blkadr-*  absolute address as well
3390           return    getbfh
3391           rem
3392 gfh070    null                failure branch
3393           smeter    mincs,.malof,l.j001-*
3394           tra       gfhbak-*
3395           rem
3396           rem
3397 l.j001    dec       1
3398           rem
3399 a.j001    ind       .crnxe
3400 a.j002    ind       setbpt
3401 a.j003    ind       bounds
3402 a.j004    ind       .crnxa
3403 a.j005    ind       setsc
3404 a.j006    ind       chksiz
3405 a.j007    ind       timein
3406 a.j008    ind       extime
3407 a.j009    ind       getspc
3408 a.j010    ind       .crnbf
3409           rem
3410 size      bss       1
3411 prvadr    bss       1
3412 blkadr    bss       1
3413 blkvir    bss       1
3414 bndry     bss       1
3415           rem
3416 bounds    equ       *         array of strings for and'ing to ensure
3417           rem                 correct boundary -- indexed by buffer size
3418           oct       000037
3419           oct       000077
3420           oct       000177
3421           oct       000177
3422           oct       000177
3423           oct       000377
3424           oct       000377
3425           oct       000377
3426           oct       000377
3427           eject
3428 ************************************************************************
3429 *
3430 *         frebfh -- external entry to free a single buffer in high
3431 *         memory. internal subroutine frhbuf does most of the real work.
3432 *
3433 *         input:
3434 *             a contains absolute address of buffer to be freed
3435 *             q contains size in words (if zero, use size code in buffer)
3436 *
3437 ************************************************************************
3438           rem
3439 frebfh    subr      frb,(a,q,x2,x3)
3440           cmpa      l.l001-*  (bwndow) is buffer in fact in high memory?
3441           tnc       frb010-*  no, use frebuf
3442           cax2                hang on to absolute address
3443           tsy       a.l001-*,*          setbpt
3444           cax3                get virtual address in x3
3445           lda       frebfh-*  save return address
3446           sta       frertn-*  for trace call
3447           cx2a                get absolute address back in a
3448           tsy       a.l002-*,*          frhbuf
3449 frbbak    return    frebfh
3450           rem
3451 frb010    cax3                address in x3
3452           tsy       a.l003-*,*          frebuf
3453           tra       frbbak-*
3454           eject
3455 ************************************************************************
3456 *
3457 *         subroutine to free a buffer chain
3458 *
3459 *         calling sequence:
3460 *
3461 *                   a contains absolute address of buffer chain
3462 *
3463 ************************************************************************
3464           rem
3465 frelbf    subr      frl,(a,q,x2)
3466           rem
3467           trace     mt.frc,0,(frlsa,frelbf,x1,x3)
3468           rem
3469           ldq       frelbf-*  for trace calls on individual
3470           stq       frertn-*  buffers
3471           ilq       0         always use size in buffer
3472           lda       frlsa-*
3473 frl010    cmpa      l.l001-*  (bwndow) is buffer in high memory?
3474           tmi       frl030-*  no, use frebuf
3475           cax2                hang on to absolute address
3476           tsy       a.l001-*,*          setbpt
3477           cax3                get virtual into x3
3478           lda       bf.nxt,3  hold forward pointer
3479           sta       frlnxt-*  hang on to it
3480           cx2a                recover absolute address of buffer
3481           tsy       a.l002-*,*          (frhbuf) free one buffer
3482 frl020    lda       frlnxt-*  recover next pointer
3483           tnz       frl010-*  not at end yet
3484           return    frelbf
3485           rem
3486 frl030    cax3
3487           lda       bf.nxt,3
3488           sta       frlnxt-*
3489           tsy       a.l003-*,*          frebuf
3490           tra       frl020-*
3491           rem
3492           rem
3493 a.l001    ind       setbpt
3494 a.l002    ind       frhbuf
3495 a.l003    ind       frebuf
3496           rem
3497 l.l001    vfd       18/bwndow
3498           rem
3499 frlnxt    bss       1
3500 frertn    bss       1
3501           eject
3502 ************************************************************************
3503 *
3504 *         frhbuf -- subroutine to do the real work of freeing a buffer
3505 *         in high memory.
3506 *
3507 *         input:
3508 *             a - absolute address of buffer
3509 *             q - size in words
3510 *             x3 - virtual address of buffer
3511 *             buffer page table entry set up appropriately
3512 *
3513 ************************************************************************
3514           rem
3515 frhbuf    subr      frh,(inh,a,q,x1,x2,x3)
3516           sta       freadr-*
3517           tsy       a.k003-*,*          timein
3518           ldx2      a.k005-*,*          .crbpe
3519           lda       0,2       save pte
3520           sta       frepte-*  which callers may be counting on
3521           rem
3522           stz       frenxt-*  initialize
3523           stz       freprv-*
3524           cqa                 get size
3525           tnz       frh005-*  if supplied
3526           ldq       bf.siz,3  else derive it from buffer size code
3527           qrl       15
3528           iaq       1
3529           qls       bufshf
3530           tra       frh007-*
3531 frh005    iaa       bufsiz-1  round it to multiple of bufsiz
3532           iana      -bufsiz
3533           caq
3534 frh007    stq       fb.siz,3
3535           stq       fresiz-*
3536           trace     mt.fre,0,(freadr,fresiz,frertn,frhsx1)
3537           rem
3538           lda       a.k001-*,*          (.crnxe) get head of chain
3539           tze       frh060-*  no chain at the moment
3540 frh010    cmpa      freadr-*  see if new block comes before next free one
3541           tnc       frh030-*  no, look for next block
3542           tze       frhdie-*  oops, this is already free
3543           sta       frenxt-*  we've found the first block after the one we're
3544           cax2                freeing
3545           lda       freadr-*  get the original one back
3546           tsy       a.k002-*,*          (setbpt) get the pte right
3547           cax3
3548           stx2      fb.nxt,3  set its forward pointer
3549           lda       freprv-*  hook it on to previous one
3550           tnz       frh020-*  if any
3551           lda       freadr-*
3552           sta       a.k001-*,*          (.crnxe) none, this is head
3553           tra       frh050-*  combine ahead
3554           rem
3555 frh020    tsy       a.k002-*,*          (setbpt) get previous block's
3556           cax1                virtual address
3557           lda       freadr-*  thread new one to it
3558           sta       fb.nxt,1
3559           tra       frh040-*  combine behind
3560           rem
3561 frh030    sta       freprv-*  save most recent block address
3562           tsy       a.k002-*,*          (setbpt) get virtual address
3563           cax1                to look at forward pointer
3564           lda       fb.nxt,1
3565           tnz       frh010-*  if any
3566           sta       frenxt-*  no next pointer, remember that
3567           lda       freadr-*  thread new one to last found
3568           sta       fb.nxt,1
3569           tsy       a.k002-*,*          (setbpt) get new one's virtual
3570           cax3                address
3571           stz       fb.nxt,3  set its forward pointer
3572           rem
3573 frh040    null                try to combine with previous block
3574           lda       freprv-*
3575           caq
3576           tsy       a.k002-*,*          setbpt
3577           cax3                virtual address in x3
3578           adq       fb.siz,3  end of previous block
3579           cmpq      freadr-*  does it reach new one?
3580           tnc       frh050-*  no, can't combine
3581           tnz       frhdie-*  overlaps!
3582           lda       freprv-*  make sure they're in same page
3583           ana       l.k001-*  =o777400
3584           sta       frebas-*
3585           lda       freadr-*
3586           ana       l.k001-*  =o777400
3587           cmpa      frebas-*
3588           tnz       frh050-*  they are not, don't combine
3589           lda       frenxt-*  they are, so previous now points
3590           sta       fb.nxt,3  to next
3591           ldq       fb.siz,3
3592           adq       fresiz-*  and its size increases accordingly
3593           stq       fb.siz,3
3594           lda       freprv-*  and this the address of
3595           sta       freadr-*  the current block
3596           rem
3597 frh050    null                try to combine with following block
3598           lda       frenxt-*
3599           tze       frhbak-*  there is none, we're done
3600           ana       l.k001-*  =o777400
3601           sta       frebas-*  save base of next block's page
3602           lda       freadr-*
3603           ana       l.k001-*
3604           cmpa      frebas-*  compare with current one
3605           tnz       frhbak-*  different, can't combine
3606           lda       freadr-*  get current block
3607           caq
3608           tsy       a.k002-*,*          setbpt
3609           cax3                virtualized
3610           adq       fb.siz,3  see if it extends to next
3611           cmpq      frenxt-*
3612           tnc       frhbak-*  it doesn't
3613           tnz       frhdie-*  goes past it!
3614           lda       frenxt-*  to combine, get virtual address
3615           tsy       a.k002-*,*          (setbpt) of next block
3616           cax2                since they're in same page, both
3617           lda       fb.siz,3  are addressable
3618           ada       fb.siz,2  so combine their sizes
3619           sta       fb.siz,3  this is new size of current block
3620           lda       fb.nxt,2  which points past old next one
3621           sta       fb.nxt,3
3622           rem
3623 frhbak    ldx2      a.k005-*,*          .crbpe
3624           lda       frepte-*  restore original pte
3625           sta       0,2
3626           lda       fresiz-*  get size so as to update .crnbf
3627           ars       bufshf    convert to buffers
3628           asa       a.k006-*,*          .crnbf
3629           ila       1         mark as free call
3630           tsy       a.k004-*,*          extime
3631           return    frhbuf
3632           rem
3633 frh060    lda       freadr-*  this is only free block
3634           sta       a.k001-*,*          .crnxe
3635           stz       fb.nxt,3
3636           tra       frhbak-*
3637           rem
3638 frhdie    die       4         free blocks overlap
3639           rem
3640           rem
3641 a.k001    ind       .crnxe
3642 a.k002    ind       setbpt
3643 a.k003    ind       timein
3644 a.k004    ind       extime
3645 a.k005    ind       .crbpe
3646 a.k006    ind       .crnbf
3647           rem
3648 l.k001    oct       777400
3649           rem
3650 frenxt    bss       1
3651 freprv    bss       1
3652 freadr    bss       1
3653 fresiz    bss       1
3654 frebas    bss       1
3655 frepte    bss       1
3656           eject
3657 ************************************************************************
3658 *
3659 *         subroutine to find free space of a desired size
3660 *         it is unthreaded from the beginning of the smallest block
3661 *         large enough to hold it.
3662 *
3663 *         calling sequence:
3664 *
3665 *                   x1 -> buffer pool header
3666 *                   q  =  size of space needed, in words
3667 *
3668 *         returns:
3669 *
3670 *                   procedure takes skip return if it succeeds,
3671 *                   non-skip return if it fails.
3672 *
3673 *                   x3 -> space allocated
3674 *
3675 ************************************************************************
3676           rem
3677 getspc    subr      gsp,(a,x2)
3678           stz       prvblk-*  initialize some stuff
3679           stz       bstblk-*  will be addr of smallest block
3680           ldx3      bstblk-*  to zero the reg
3681           lda       a.z001-*,*          =.crmem, bigger that biggest free block
3682           ldx2      fp.fst,1  pick up pointer to first free block
3683 gsp040    tze       gsp010-*  end of chain
3684           cmpq      fb.siz,2  is this block big enough?
3685           tze       gsp020-*  exactly right, dont look anymore
3686           tpl       gsp030-*  too small, skip to next
3687           cmpa      fb.siz,2  is this a better (smaller) block to use?
3688           tze       gsp030-*  same, dont use it
3689           tmi       gsp030-*  already have smaller block
3690           stx2      bstblk-*  save pointer to best block
3691           ldx3      prvblk-*  rembember best blocks predessor
3692           lda       fb.siz,2  remember best blocks size
3693 gsp030    stx2      prvblk-*
3694           ldx2      fb.nxt,2  step to next block
3695           tra       gsp040-*
3696 gsp010    ldx2      bstblk-*  get pointer to best block
3697           tze       gspret-*  no block big enough, take error return
3698           stx3      prvblk-*  unthread subr needs this pointer
3699 gsp020    aos       getspc-*  call will succeed, setup skip return
3700           cx2a
3701           cax3                x2-x3 to unthread from beginning of block
3702           tsy       unthrd-*  unthread selected space
3703 gspret    return    getspc
3704           rem
3705 bstblk    bss       1
3706 a.z001    ind       .crmem
3707 a.z002    ind       .crnxa
3708 a.z003    ind       .crnbf
3709 a.z004    ind       .crnxs
3710 a.z005    ind       .crnbs
3711 a.z006    ind       fresml
3712 a.z007    ind       timein
3713 a.z008    ind       .crbuf
3714 a.z009    ind       extime
3715           rem
3716 l.z001    dec       1         for metering
3717           eject
3718 ************************************************************************
3719 *
3720 *         subroutine to unthread space from a free chain
3721 *
3722 *         calling sequence:
3723 *
3724 *                   x1 -> buffer poll header
3725 *                   x2 -> starting address to unthread
3726 *                   x3 -> free block space is coming from
3727 *                   q  =  size of block to unthread
3728 *                   prvblk contains address of free block which proceeds
3729 *                          the block pointed to by x2
3730 *
3731 ************************************************************************
3732           rem
3733 unthrd    subr      unt,(a,q,x2,x3)
3734           lda       fb.siz,3  size of entire block
3735           sba       untsq-*   amount of space that will be left
3736           sta       unttmp-*  this number will be useful later
3737           tze       untall-*  if zero, unthreading entire free block
3738           cx2a                addr of space to unthread
3739           sba       untsx3-*  amount of space before block unthreaded
3740           tze       untbeg-*  if 0, unthreding from beginning
3741           cmpa      unttmp-*  equal to size remaining?
3742           tze       untend-*  yes, unthreading from end of block
3743           rem
3744 *         unthreading from the middle of a free block
3745           rem
3746 untmid    sta       fb.siz,3  size of first partial block
3747           adq       untsx2-*  compute addr of second partial block
3748           lda       fb.nxt,3  hold forward pointer
3749           stq       fb.nxt,3  make first block point to second
3750           ldx2      fb.nxt,3  addr of second block
3751           ldq       unttmp-*  total space in both free blocks
3752           sbq       fb.siz,3  subtract out size of first block
3753           staq      fb.nxt,2  update pointer and size
3754           tra       untret-*
3755           rem
3756 *         unthreading from end of a free block
3757           rem
3758 untend    lda       unttmp-*  new size of partial block
3759           sta       fb.siz,3
3760           tra       untret-*  thats all to do
3761           rem
3762 *         unthread an entire free block
3763           rem
3764 untall    lda       fb.nxt,3  pick up pointer to next block
3765 untjon    ldx2      prvblk-*  addr of previous whole block
3766           tze       unthed-*  none, unthreading head
3767           sta       fb.nxt,2  make prev point to next
3768           tra       untret-*
3769 unthed    sta       fp.fst,1  new head of chain
3770           tra       untret-*
3771           rem
3772 *         unthreading from beginning of a free block
3773           rem
3774 untbeg    adcx2     untsq-*   compute address of new partial block
3775           lda       fb.nxt,3  it will now point forward
3776           ldq       unttmp-*  and this will be its size
3777           staq      fb.nxt,2  update block
3778           cx2a
3779           tra       untjon-*  go update preceeding block
3780           rem
3781 untret    return    unthrd
3782           rem
3783 unttmp    bss       1
3784 prvblk    bss       1
3785           eject
3786 ************************************************************************
3787 *
3788 *         subroutine to free space no longer needed. it is returned to
3789 *         the free pool and combined with any adjacent blocks
3790 *
3791 *         calling sequence:
3792 *
3793 *                   x1 -> free pool header
3794 *                   x3 -> block to free
3795 *                   q  =  size of block
3796 *
3797 ************************************************************************
3798           rem
3799 relspc    subr      rsp,(a,x2)
3800           cx3a                validate addr >= .crbuf
3801           cmpa      a.z008-*,*          =.crbuf
3802           tze       3
3803           tpl       2
3804           die       3
3805           stq       fb.siz,3  free block will need its size
3806           ldx2      fp.fst,1  pick up first block pointer
3807           tnz       rsp010-*  non-null chain
3808           stx3      fp.fst,1  freeing only block in chain
3809           stz       fb.nxt,3  no forward pointer
3810           tra       rspret-*
3811 rsp010    stz       prvblk-*
3812           stx3      rsptmp-*
3813 rsp030    cx2a                into 'a' for the compare
3814           cmpa      rsptmp-*  found spot for this block?
3815           tpl       rsp020-*  yes, goes before this block
3816           stx2      prvblk-*
3817           ldx2      fb.nxt,2  step foward
3818           tnz       rsp030-*
3819           rem
3820 *         free a block which goes at end of chain
3821           rem
3822           ldx2      prvblk-*
3823           stx3      fb.nxt,2  make old last point at new last
3824           stz       fb.nxt,3  make new last the end
3825           tra       rsp050-*
3826           rem
3827 *         freeing a block that is not at end
3828           rem
3829 rsp020    ldx2      prvblk-*  pick up proceeding block
3830           tnz       rsp040-*
3831           rem
3832 *         block goes at head of chain
3833           rem
3834           lda       fp.fst,1  old head
3835           stx3      fp.fst,1  new head
3836           sta       fb.nxt,3  make new head point at old head
3837           tra       rsp060-*
3838           rem
3839 *         block goes in middle
3840           rem
3841 rsp040    lda       fb.nxt,2  forward pointer from prev block
3842           stx3      fb.nxt,2  its new pointer is to this block
3843           sta       fb.nxt,3  forward pointer to next block
3844           rem
3845 *         combine new block with preceeding
3846           rem
3847 rsp050    cx2a                address of previous block
3848           ada       fb.siz,2  calculate end of previous block
3849           stx3      rsptmp-*  address of current block
3850           cmpa      rsptmp-*  check for join
3851           tmi       rsp060-*  don't join
3852           tze       rsp070-*  they do
3853           die       4         they overlap
3854 rsp070    lda       fb.nxt,3  block after current
3855           sta       fb.nxt,2  make previous point at it
3856           lda       fb.siz,3  size of current
3857           asa       fb.siz,2  add into size of previous
3858           cx2a
3859           cax3                make x3 point at new combined cuurrent block
3860           rem
3861 *         combine current block with following one
3862           rem
3863 rsp060    szn       fb.nxt,3  last block?
3864           tze       rspret-*  yes
3865           cx3a                address of current
3866           ada       fb.siz,3  end of current
3867           cmpa      fb.nxt,3  does it join with next?
3868           tmi       rspret-*  no
3869           tze       rsp080-*  yes
3870           die       4         overlap
3871 rsp080    ldx2      fb.nxt,3  address of next block
3872           lda       fb.siz,2  get next block size
3873           asa       fb.siz,3  add into current block size
3874           lda       fb.nxt,2  next blocks follower
3875           sta       fb.nxt,3  thrad after current
3876           rem
3877 rspret    ila       -1        put bad addr in x3
3878           cax3
3879           return    relspc
3880 rsptmp    bss       1
3881           eject
3882 ************************************************************************
3883 *
3884 *         subroutine to scan the small buffer chain and find any space
3885 *         that can be recombined into large buffers. it is called when
3886 *         we run out of real buffers as a last resort.
3887 *
3888 *         return:
3889 *
3890 *                   will take a skip return if any buffers were freed
3891 *
3892 ************************************************************************
3893           rem
3894 fresml    subr      fsm,(a,q,x1,x2,x3)
3895           stz       fsmcnt-*  zero count of buffers found
3896 fsm040    stz       prvblk-*  initialze to follow threads
3897           ldx3      a.z004-*,*          =addr(.crnxs) next small block
3898           tze       fsm010-*  empty chain
3899 fsm050    cx3a                start of free block
3900           ada       fb.siz,3  compute end address
3901           sta       fsmtmp-*  save
3902           cx3a
3903           iaa       bufsiz-1  round up to next buffer address
3904           iana      -bufsiz
3905           cmpa      fsmtmp-*  does next buffer start in free block?
3906           tpl       fsm020-*  no
3907           cax2                save buffer start address
3908           iaa       bufsiz    compute end of possible buffer address
3909           cmpa      fsmtmp-*  is buffer complete in block?
3910           tmi       fsm030-*  yes
3911           tnz       fsm020-*  no
3912 fsm030    ilq       bufsiz    setup to unthread the buffer we found
3913           ldx1      a.z004-*  =addr(.crnxs)
3914           tsy       unthrd-*  unthread from current chain
3915           ldx1      a.z002-*  =addr(.crnxa)
3916           cx2a
3917           cax3
3918           tsy       relspc-*  free in to regular buffer chain
3919           aos       fsmcnt-*  count buffers i found
3920           tra       fsm040-*  and continue
3921 fsm020    stx3      prvblk-*  step to next block
3922           ldx3      fb.nxt,3
3923           tnz       fsm050-*
3924 fsm010    lda       fsmcnt-*  count of buffers freed
3925           tze       fsmret-*  none
3926           aos       fresml-*   can take skip return
3927           asa       a.z003-*,*          update .crnbf
3928           iera      -1        complement count
3929           iaa       1
3930           asa       a.z005-*,*          update .crnbs
3931 fsmret    return    fresml
3932 fsmcnt    bss       1
3933 fsmtmp    bss       1
3934           end