1:         .title  lout
   2: 
   3: 
   4:         .ident  /10may4/
   5: 
   6:         .mcall  (at)always,ch.mne,st.flg,ct.mne
   7:         .mcall  (at)bisbic
   8:         always
   9:         ch.mne
  10:         st.flg
  11:         ct.mne
  12: 
  13:         .mcall  (at)xmit,param,putlp
  14:         .macro  putlin  addr    ;use listing flags
  15:         .if dif <addr><r0>
  16:         mov     addr,r0
  17:         .endc
  18:         call    putlin
  19:         .endm
  20:         .mcall  (at)genswt,error
  21:         .mcall  (at)zwrite
  22:         .mcall  (at)genedt,setnz
  23:         .mcall  (at)scanw,next,zap
  24:         .mcall  (at)sdebug,ndebug
  25: 
  26: 
  27:         param   lpp,    60.             ;
  28:         param   ttllen, 32.
  29:         param   stllen, 64.
  30: 
  31:         .globl  codrol, errrol, lcdrol, symrol, secrol
  32:         .globl  lcbegl, linend, lcendl
  33:         .globl  linbuf, cdrsav, endp2l
  34: 
  35:         .globl  linnum, seqend, pagnum, pagext
  36:         .globl  ffcnt,  lppcnt
  37:         .globl  dflgbm, opclas
  38: 
  39: 
  40:         .globl  edmask, ed.cdr, ed.lc
  41: 
  42: 
  43: srclen  =       204             ;*********************
  44: octlen  =        60             ;*********************
  45: 
  46: mx.on   =lc.md!lc.mc!lc.ld!lc.toc!lc.sym!lc.cnd!lc.bin!lc.loc!lc.seq
  47: 
  48: 
  49: 
  50:         .globl  lc.cnd
  51:         .globl  exmflg
  52:         .globl  lstchn, cmochn, lstflg, putoc
  53:         .globl  mx.flg, my.flg
  54:         .globl  crfref
  55: 
  56:         .globl  clcfgs, clcloc, clcmax
  57:         .globl  clcnam, clcsec, cpopj
  58:         .globl  errbts
  59:         .globl  flags,  getchr, getnb,  getsym
  60:         .globl  mode
  61:         .globl  rolndx, rolupd
  62:         .globl  sector, setpf0, setpf1
  63:         .globl  setsym
  64:         .globl  symbol, tstarg, value
  65: 
  66:         .globl  expr,   pcroll, prgttl
  67:         .globl  setwrd, setbyt, tstr50, mulr50
  68:         .globl  r50unp
  69: 
  70:         .globl  setchr
  71: 
  72: ;globals defined in assembler
  73: 
  74:         .globl  setlc
  75: 
  76:         .globl  chrpnt, getr50, pass
  77:         .globl  putkb,  putkbl, putlp
  78: 
  79:         .globl  dnc,    movbyt, savreg, xmit0
  80:         .globl  linbuf, errcnt
  81: 
  82: ;globals defined in mcexec
  83: 
  84:         .globl  dattim
  85:         .globl  hdrttl
  86:         .globl  io.eof, io.tty, io.err
  87: 
  88:         .globl  ioftbl, cnttbl, buftbl
  89: 
  90: 
  91: 
  92:         .globl  argcnt, cttbl
  93:         .globl  endlin
  94:         .globl  getlin, lblend, lcendl, lcflag
  95:         .globl  lcmask, lc.mc,  lc.md,  lc.me
  96:         .globl  lst.kb, lst.lp, lstdev
  97:         xitsec                  ;start in default sector
  98: 
  99: endlin:                         ;end of line processor
 100:         call    savreg
 101:         clr     rolupd          ;set to fetch from code roll
 102:         tstb    cttbl(r5)       ;eol or semi-colon?
 103:         ble     lout1           ;  yes
 104:         error   19,q,<random junk at end of statement ignored>
 105: 
 106: lout1:  .if ndf xedcdr
 107:         movb    cdrsav,linbuf+72.       ;replace borrowed char
 108:         .endc
 109:         mov     pass,-(sp)      ;pass 1?
 110:         beq     9$              ;  yes
 111:         call    mx.mx           ; <<< REEDS june 81
 112:         mov     lstdev,(sp)     ;init listing flag
 113: 
 114:         tst     errbts          ;any errors?
 115:         bne     7$              ;  yes, go directly, do not collect, etc.
 116:         tstb    (sp)            ;any listing device?
 117:         beq     9$              ;  no
 118:         bit     #lc.ld,lcflag   ;listing directive?
 119:         bne     5$              ;  yes
 120:         tst     mx.flg          ; <<< REEDS june 81
 121:         bne     80$             ; <<< REEDS june 81: in mx mode we ignore .list
 122:         tst     lclvl           ;test over-under ride
 123:         blt     5$              ;if <0, list only if errors
 124:         bgt     8$              ;if >0, list unconditionally
 125: 80$:    bit     #lc.com,lcmask  ;comment suppression?
 126:         beq     2$              ;  no
 127:         mov     chrpnt,lcendl   ;yes, assume we're sitting at comment
 128: 2$:     bit     #lc.src,lcmask  ;line suppression?
 129:         beq     3$              ;  no
 130:         mov     #linbuf,lcendl  ;yes, point to start of buffer
 131: 3$:
 132:         .if ndf xmacro
 133:         tstb    <^pl rolsiz>+codrol+1   ;anything in code roll?
 134:         beq     4$              ;  no
 135:         bit     #lc.meb,lcmask  ;macro binary expansion?
 136:         bne     4$              ;  no
 137:         bic     #lc.me,lcflag   ;yes, ignore me flag
 138:         .endc
 139: 4$:     bit     lcmask,lcflag   ;anything suppressed?
 140:         beq     9$              ;  no, use current flags
 141: 5$:     clr     (sp)            ;yes, clear listing mode
 142:         br      9$
 143: 7$:     swab    (sp)            ;error, set to error flags
 144: 8$:     mov     #linbuf,lcbegl  ;list entire line
 145:         mov     #linend,lcendl
 146: 9$:     call    pcroll          ;process entry on code roll
 147: endl10: movb    (sp),lstreq     ;anything requested?
 148:         beq     endl20          ;  no
 149:         clrb    @lcendl         ;set asciz terminator
 150:         mov     #octbuf,r2
 151: 11$:    mov     #space*400+space,(r2)+  ;blank fill
 152:         cmp     #linbuf,r2      ;test for end (beginning of line buffer)
 153:         bne     11$
 154: 
 155: endl50: mov     #octbuf,r2      ;point to start of buffer
 156:         call    tsterr          ;set error flags
 157:         mov     #linnum,r0
 158:         mov     (r0)+,r1
 159:         cmp     r1,(r0)
 160:         beq     2$
 161:         mov     r1,(r0)
 162:         bit     #lc.seq,lcmask
 163:         bne     2$
 164:         mov     r2,r4
 165:         call    dnc
 166:         mov     #octbuf+7,r0
 167: 1$:     movb    -(r2),-(r0)
 168:         movb    #space,(r2)
 169:         cmp     r2,r4
 170:         bhi     1$
 171:         mov     #octbuf+7,r2
 172: 2$:     movb    #tab,(r2)+
 173: 21$:    mov     #pf0,r1
 174:         bit     #lc.loc,lcmask
 175:         bne     4$
 176:         tst     (r1)
 177:         beq     3$
 178:         call    setwrd
 179: 3$:     movb    #tab,(r2)+
 180: 4$:     clr     (r1)
 181:         mov     #pf1,r1
 182:         bit     #lc.bin,lcmask
 183:         bne     endl19
 184:         mov     #1,r4
 185:         bit     #lc.ttm,lcmask
 186:         beq     41$
 187:         cmpb    (r4)+,(r4)+             ; cheap increment by 2
 188: 41$:    tst     (r1)
 189:         beq     6$
 190: 5$:     call    setwdb
 191: 6$:     movb    #tab,(r2)+
 192:         clr     (r1)
 193:         dec     r4
 194:         beq     endl19
 195:         tst     rolupd
 196:         beq     6$
 197:         call    pcroll
 198:         br      5$
 199: endl19: mov     lcbegl,r1       ;point to start of listing line
 200:         call    movbyt          ;move over
 201:         putlin  #octbuf         ; test for header and list
 202:         call    err.pr
 203: endl20:
 204:         clrb    @lcbegl         ;don't dupe line
 205:         tst     rolupd          ;finished?
 206:         beq     endl30          ;  yes, don't loop
 207:         call    pcroll
 208:         beq     endl30          ;exit if empty
 209:         bit     #lc.bex!lc.bin,lcmask   ;binary extension suppressed?
 210:         beq     endl10          ;  no
 211:         br      endl20          ;yes, don't list
 212: 
 213: endl30: tst     (sp)+           ;prune listing flag
 214:         zap     codrol          ;clear the code roll
 215:         mov     clcloc,r0
 216:         cmp     r0,clcmax       ;new high for sector?
 217:         blos    31$             ;  no
 218:         mov     r0,clcmax       ;yes, set it
 219: 31$:    return
 220: 
 221: setwdb:                         ;list word or byte
 222:         tst     (r1)            ;anything for second field?
 223:         beq     9$              ;  no
 224:         mov     #setwrd,-(sp)   ;assume word
 225:         bit     #dflgbm,opclas  ;true?
 226:         beq     1$              ;  yes
 227:         mov     #setbyt,(sp)    ;no, byte
 228: 1$:     call    @(sp)+          ;call routine
 229:         bit     #77*400,(r1)    ;test for linker modification
 230:         beq     9$
 231: 
 232:         bit     #5100,(r1)      ;if one of these isnt set I dont know
 233:         bne     12$             ;what is going on, so lets mark it ?
 234:         movb    #'?,(r2)
 235:         br      9$
 236: 12$:
 237:         movb    #ch.xcl,(r2)    ; ' marks psect relocation
 238:         bit     #4000,(r1)
 239:         bne     10$
 240:         movb    #'",(r2)        ;  " location counter relocation
 241: 10$:
 242:         bit     #glbflg,(r1)
 243:         beq     2$
 244:         movb    #'G,(r2)
 245:         tst     symbol          ; harvard m11 uses global syms with funny
 246:         bne     2$              ; names for complex relocation
 247:         movb    #'C,(r2)
 248: 2$:     tstb    (r2)+
 249: 9$:     return
 250: 
 251: tsterr:                         ;test and process errors
 252:         mov     errbts,r0       ;any errors?
 253:         beq     9$              ;  no
 254:         bic     #err.,r0        ;yes, ".print"?
 255:         beq     4$              ;  yes
 256:         inc     errcnt          ;bump error count
 257:         call    err.sh
 258: 4$:     mov     #errmne-1,r1
 259: 1$:     tstb    (r1)+           ;move char pntr and clear carry
 260:         ror     errbts          ;rotate error bits
 261:         bcc     2$
 262:         movb    (r1),(r2)+
 263:         .if ndf xcref
 264:         movb    (r1),r0         ;fetch character
 265:         call    tstr50          ;convert to rad50
 266:         call    mulr50          ;left justify
 267:         call    mulr50
 268:         mov     r0,symbol       ;store
 269:         clr     symbol+2
 270:         mov     #errrol,rolndx  ;prepare to cref
 271:         call    crfref          ;do so
 272:         .endc
 273:         br      1$
 274: 
 275: 2$:     bne     1$
 276: 9$:     return
 277: 
 278: 
 279: .globl  fileln
 280: .globl  putli2
 281: err.sh::
 282:         call    savreg
 283:         tst     lstflg
 284:         bne     9$
 285: 
 286: ; printf("%s: line %d: %s\n", infile, fileln, errmess)
 287: 
 288:         mov     #err.bx,r2
 289:         tstb    err.by
 290:         beq     1$
 291:         mov     #err.by,r1
 292:         call    movbyt
 293:         mov     #err.s1,r1
 294:         call    movbyt
 295:         mov     fileln,r1
 296:         call    dnc
 297:         tst     err.xx
 298:         beq     2$
 299:         mov     #err.s2,r1
 300:         call    movbyt
 301: 1$:     mov     err.xx,r1
 302:         call    movbyt
 303:         clr     err.xx
 304: 2$:
 305:         clrb    (r2)
 306:         mov     #err.bx,r2
 307:         mov     #lst.kb,r4
 308:         call    putli2
 309: 9$:
 310:         return
 311: 
 312: .data
 313: err.s1: .asciz /: line /
 314: .even
 315: err.s2: .asciz  /: /
 316: 
 317: .bss
 318: err.bx: .blkw   60
 319: err.by::        .blkw   60
 320: 
 321:         entsec  impure
 322: errcnt: .blkw                   ;error counter
 323:         entsec  implin
 324: errbts: .blkw                   ;error flags
 325: err.xx::        .blkw           ;error message
 326:         xitsec
 327:         .if ndf xedcdr
 328:         genedt  cdr
 329:         entsec  impure
 330: cdrsav: .blkw                   ;saved char from card format
 331:         .endc
 332:         entsec  impure
 333: octbuf:
 334: octerp: .blkb   0
 335: octseq: .blkb   2
 336: octpf0: .blkb   7
 337: octpf1: .blkb   octlen-<.-octbuf>
 338: linbuf: .blkw   srclen/2
 339: linend: .blkw   1
 340: 
 341: .data
 342: tmpcnt  =       1
 343: errmne: .irpc   char,< abeilmnopqrtuz>
 344:         .ascii  /char/
 345:         .globl  err.'char
 346: err.'char=      tmpcnt
 347: tmpcnt  =       tmpcnt+tmpcnt
 348:         .endm
 349: 
 350:         xitsec
 351:         .globl  title,  sbttl
 352: 
 353: title:
 354:         call    getsym          ;get a symbol
 355:         bne     title1          ;  error if null
 356:         error   20,a,<missing title>
 357:         return
 358: 
 359: title1: mov     r0,prgttl       ;move into storage
 360:         mov     symbol+2,prgttl+2
 361:         call    setsym          ;point to start of title
 362:         mov     #ttlbuf,r2      ;point to buffer
 363:         movb    #ff,(r2)+       ;store page eject
 364:         clr     r3              ;clear position conter
 365: 2$:     .if ndf xedlc           ;>>>gh 7/20/78 to not automatically upper-case
 366:         bit     #ed.lc,edmask   ;lower case enabled?
 367:         bne     6$              ;  no, leave as upper case
 368:         mov     chrpnt,r5       ;fake for ovlay pic
 369:         movb    (r5),r5         ;fetch original character
 370: 6$:     .endc
 371:         movb    r5,(r2)         ;plunk the next char in the buffer
 372:         beq     5$              ;branch if end
 373:         cmp     r5,#tab         ;a tab?
 374:         bne     3$              ;  no
 375:         bis     #7,r3           ;yes, compensate
 376: 3$:     inc     r3              ;update position counter
 377:         cmp     r3,#ttllen      ;within bounds?
 378:         bhis    4$              ;  no
 379:         tstb    (r2)+           ;yes, move pointer
 380: 4$:     call    getchr          ;get the next character
 381:         bne     2$              ;loop if not end
 382: 5$:     movb    #tab,(r2)+      ;set separator
 383:         .globl  vernam
 384:         mov     vernam,r1
 385:         call    movbyt          ;set version number, etc.
 386:         mov     #dattim,r1
 387:         call    movbyt          ;date and time
 388:         mov     r2,ttlbrk       ;remember break point
 389:         clrb    (r2)
 390:         return
 391: 
 392:         .data
 393: defttl::        .asciz  /.main./        ;default title
 394: 
 395:         entsec  impure
 396: ttlbrk: .blkw                   ;break location
 397: ttlbuf: .blkb   ttllen-1!7+1+1  ;modulo tab + ff
 398:         .blkb   20.             ;intro msg
 399:         .iif ndf xtime, .blkb   20.     ;time & date
 400:         .blkb   20.             ;page number
 401:         .even
 402:         xitsec
 403: 
 404: 
 405: 
 406: sbttl:                          ;sub-title directive
 407:         mov     #stlbuf,r2      ;point to sub-title buffer
 408:         tst     pass            ;pass one?
 409:         beq     2$              ;  yes
 410: 1$:     .if ndf xedlc           ;>>>gh 7/20/78 to not automatically upper-case
 411:         bit     #ed.lc,edmask   ;lower case enabled?
 412:         bne     4$              ;  no, leave as upper case
 413:         mov     chrpnt,r5       ;fake for ovlay pic
 414:         movb    (r5),r5         ;fetch original character
 415: 4$:     .endc
 416:         movb    r5,(r2)+        ;move character in
 417:         beq     13$             ;  branch if end
 418:         call    getchr          ;get the next character
 419:         cmp     r2,#stlbuf+stllen-1     ;test for end
 420:         blo     1$
 421:         tstb    -(r2)           ;polish off line
 422:         br      1$
 423: 
 424: 2$:     bit     #lc.toc,lcmask
 425:         bne     13$
 426:         tstb    lstdev          ;any listing device?
 427:         beq     13$             ;  no, exit
 428:         tst     mx.flg          ; <<< REEDS june 81
 429:         bne     13$             ; <<<
 430:         mov     #toctxt,r1
 431:         call    movbyt          ;set table of contents
 432:         call    setsym          ;point to ".sbttl"
 433: 3$:     call    getr50          ;get radix-50 char
 434:         bgt     3$              ;stop at first terminator
 435:         mov     chrpnt,r2       ;set pointer
 436:         .if ndf xlcseq
 437:         mov     linnum,r0
 438:         call    10$
 439:         movb    #ch.sub,-(r2)
 440:         .iff
 441:         movb    #tab,-(r2)
 442:         .endc
 443:         mov     pagnum,r0
 444:         call    10$
 445:         movb    #space,-(r2)
 446: 
 447:         tst     lstflg
 448:         beq     15$
 449:         bisb    lstdev,lstreq
 450: 15$:    putlin  r2              ;output
 451:         return
 452: 
 453: 10$:    mov     #4,r4           ; << REEDS. changed to 4 digit field from 3
 454: 11$:    movb    #space,-(r2)
 455:         mov     r0,r1
 456:         beq     12$
 457:         clr     r0
 458:         div     #^d10,r0
 459:         add     #dig.0,r1
 460:         movb    r1,(r2)
 461: 12$:    sob     r4,11$
 462: 13$:    return
 463: 
 464: .data
 465: toctxt: .asciz  /table of contents/
 466: 
 467:         entsec  imppas
 468: stlbuf: .blkw   <stllen+2>/2    ;sub-title buffer
 469: 
 470:         xitsec
 471:         .globl  print,  error
 472: 
 473: 
 474:         .enabl  lsb
 475: 
 476: print:
 477:         error   0,<>,<user generated error>     ; null error (dont count)
 478:         br      error1
 479: 
 480: error:  error   53,p,<user generated error>
 481: error1: call    setpf0          ;print location field
 482:         call    expr            ;evaluate expression
 483:         beq     2$              ;branch if null
 484:         call    setpf1          ;non-null, list value
 485: 2$:     return
 486: 
 487:         .dsabl  lsb
 488: 
 489: 
 490:         .globl  rem
 491: 
 492: rem:                            ; ".rem" directive
 493:         mov     r5,r3           ;set terminating character
 494:         bne     rem1            ;branch if non-null
 495:         error   22,a,<missing delimiting character>
 496:                                 ;error, no delimiting character
 497:         return
 498: 
 499: rem1:   call    getchr          ;get the next character
 500: 2$:     tst     r5              ;end of line?
 501:         bne     3$              ;  no
 502:         call    endlin          ;yes, polish off line
 503:         call    getlin          ;get next line
 504:         beq     2$              ;loop if no eof
 505:         return                  ;eof, exit
 506: 
 507: 3$:     cmp     r5,r3           ;is this the terminator?
 508:         bne     rem1            ;  no
 509:         jmp     getnb           ;yes, bypass and exit
 510: 
 511:         .sbttl  listing control
 512: 
 513:         .globl  nlist,  list
 514: 
 515: nlist:  com     r3              ;make r3 -1
 516: list:
 517:         asl     r3              ;make r3 0/-2
 518:         inc     r3              ;now 1/-1
 519: 1$:     call    tstarg          ;test for another argument
 520:         bne     2$              ;  valid
 521:         tst     argcnt          ;null, first?
 522:         bne     list7           ;  no, we're through
 523:         inc     argcnt          ;yes, mark it
 524: 2$:     call    getsym          ;try for a symbol
 525:         scanw   lcdrol          ;look it up in the table
 526:         beq     6$              ;  error if not found
 527:         clr     r2
 528:         sec
 529: 3$:     rol     r2
 530:         sob     r0,3$
 531:         tst     exmflg          ;called from command string?
 532:         beq     11$             ;  no
 533:         bis     r2,lcmcsi       ;yes, set disable bits
 534:         bisbic  lcdeft          ;change the default values
 535:         br      12$             ;  and skip test
 536: 
 537: 11$:    bit     r2,lcmcsi       ;this flag off limits?
 538:         bne     5$              ;  yes
 539: 12$:    bic     r2,lcmask
 540:         bit     r2,#lc.         ;null?
 541:         beq     4$              ;  no
 542:         call    pagex           ;set listing control
 543:         add     r3,lclvl        ;yes, update level count
 544:         beq     5$              ;don't set flag if back to zero
 545: 4$:     tst     r3
 546:         bpl     5$              ;.list, branch
 547:         bis     r2,lcmask
 548: 5$:     br      1$              ;try for more
 549: 
 550: 6$:     error   23,a,<unknown .list/.nlist argument>
 551: list7:  return
 552: 
 553:         genswt  li,list         ;generate /li
 554:         genswt  nl,nlist        ;  and /nl switch entries
 555: 
 556:         .globl  page
 557: page:   inc     ffcnt           ;simulate ff after this line
 558: pagex:  bis     #lc.ld,lcflag   ;flag as listing directive
 559:         return
 560: 
 561:         .macro  genlct  mne,init        ;generate listing control table
 562: lc.'mne=        1
 563:         .rept   <.-lctbas>/2
 564: lc.'mne=        lc.'mne+lc.'mne
 565:         .endm
 566:         .rad50  /mne/
 567:         .if nb  <init>
 568:         lcinit= lcinit+lc.'mne
 569:         .endc
 570:         .endm
 571: 
 572: lcinit= 0
 573: 
 574:         entsec  lctsec
 575: lctbas  =       .
 576:         genlct  seq
 577:         genlct  loc
 578:         genlct  bin
 579:         genlct  src
 580:         genlct  com
 581:         genlct  bex
 582:         genlct  md
 583:         genlct  mc
 584:         genlct  me ,1
 585:         genlct  meb,1
 586:         genlct  cnd
 587:         genlct  ld ,1
 588:         genlct  ttm,1
 589:         genlct  toc
 590:         genlct  sym
 591:         genlct  <   >           ;null
 592: 
 593:         xitsec
 594: 
 595:         genswt  fl,profl
 596: flsbts= lc.seq!lc.loc!lc.bin!lc.bex!lc.me!lc.meb!lc.toc!lc.sym
 597: profl:
 598:         mov     #flsbts,lcmcsi
 599:         mov     #flsbts,lcmask
 600:         return
 601: 
 602: .globl  eddflt,ucflag
 603: uc.set::
 604:         bis     #ed.lc,eddflt
 605: um.set::
 606:         inc     ucflag
 607:         return
 608: 
 609: .data
 610: .even
 611: ucflag::        .word           ; if set, dont do case trnslation in macros
 612:         entsec  dpure
 613: lcdeft: .word   lcinit          ; default value for lcmask
 614:         xitsec
 615:         entsec  impure
 616: lcmask: .blkw                   ;mask bits
 617: lclvl:  .blkw                   ;level count
 618: lcmcsi: .blkw                   ;command string storage
 619: 
 620:         entsec  implin
 621: lcflag: .blkw                   ;flag bits
 622: lcbegl: .blkw                   ;pointer to start of line
 623: lcendl: .blkw                   ;pointer to end of line
 624: lblend: .blkw                   ;end of label (for parsing)
 625: 
 626:         xitsec
 627: 
 628: setlc:
 629:         mov     lcdeft,lcmask           ;default flags
 630:         clr     lclvl
 631:         clr     lcmcsi
 632:         return
 633: 
 634:         .sbttl  listing stuff
 635: 
 636: setpf0:                         ;set print field zero
 637:         sdebug  <setpf0>
 638:         mov     clcfgs,pf0      ;set current location flags
 639:         bisb    #100,pf0+1      ;assume word
 640:         mov     clcloc,pf0+2    ;set location
 641:         return
 642: 
 643: setpf1:                         ;set print field one
 644:         mov     mode,pf1        ;set mode of current value
 645:         bisb    #100,pf1+1      ;assume word
 646:         mov     value,pf1+2
 647:         return
 648: 
 649:         entsec  implin
 650: pf0:    .blkw   2
 651: pf1:    .blkw   2
 652:         xitsec
 653: endp2l:                         ;end pass2 listing
 654:         call    err.pr          ; flush out last error message
 655:         mov     #symtxt,r1
 656:         mov     #stlbuf,r2
 657:         call    movbyt          ;set "symbol table" sub-title
 658:         tstb    lstdev          ;any listing output?
 659:         beq     endp2d          ;  no
 660:         bit     #lc.sym,lcmask  ;symbol table suppression?
 661:         bne     endp2d          ;  yes
 662:         inc     ffcnt           ;force new page
 663:         clr     lppcnt          ;force new page
 664:         inc     pagnum
 665:         mov     #-1,pagext
 666:         clr     rolupd          ;set for symbol table scan
 667: 2$:     mov     #linbuf,r2      ;point to storage
 668: 3$:     next    symrol          ;get the next symbol
 669:         beq     endp2a          ;  no more
 670:         bit     #regflg,mode    ;register?
 671:         bne     3$              ;  yes, don't list
 672:         call    r50unp          ;unpack the symbol
 673:         mov     #endp2t,r3
 674:         call    endp2p
 675:         mov     #mode,r1        ;point to mode bits
 676:         bit     #defflg,(r1)    ;defined?
 677:         beq     4$              ;  no
 678:         call    setwrd
 679:         br      6$
 680: 
 681: 4$:     mov     #stars,r1
 682:         call    movbyt          ;undefined, substitute ******
 683: 6$:     call    endp2p
 684:         .iif df rsx11d, call    endp2x
 685:         mov     #sector,r1
 686:         cmpb    #1,(r1)
 687:         bge     10$
 688:         cmpb    -(r1),-(r1)
 689:         call    setbyt
 690: 10$:    movb    #tab,(r2)+      ;separator
 691:         cmp     r2,#linbuf+50.  ;enough for one line?
 692:         blo     3$              ;  no
 693:         call    endp2b          ;output line
 694:         br      2$              ;next line
 695: 
 696: 
 697: endp2a:                         ;	print .psect list
 698: 
 699:         .if ndf xrel
 700:         clr     rolupd          ;set for sector scan
 701: 21$:    call    endp2b          ;output line
 702:         next    secrol          ;get the next entry
 703:         beq     endp2d          ;  exit if end of roll
 704:         movb    #'<,(r2)+
 705:         call    r50unp          ;print the name,
 706:         movb    #'>,(r2)+
 707:         movb    #tab,(r2)+
 708:         mov     #value,r1
 709:         call    setwrd          ;  the value,
 710:         movb    #tab,(r2)+
 711:         mov     #sector-2,r1
 712:         call    setbyt          ;  and the entry number
 713:         movb    #tab,(r2)+
 714:         mov     #flags-2,r1
 715:         call    setbyt          ;  and the attributes
 716:         br      21$
 717:         .endc
 718: 
 719: endp2b: clrb    (r2)
 720:         mov     lstdev,lstreq   ; we want output
 721:         putlin  #linbuf
 722:         mov     #linbuf,r2      ;reset to start of buffer
 723: endp2d: return
 724: 
 725: endp2p: call    endp2x
 726: endp2x: mov     (r3)+,r0
 727:         bit     (r3)+,mode
 728:         bne     32$
 729:         swab    r0
 730: 32$:    movb    r0,(r2)+
 731:         return
 732: 
 733:         entsec  dpure
 734: endp2t:
 735:         .ascii  / =/
 736:         .word   lblflg
 737:         .ascii  /% /
 738:         .word   regflg
 739:         .ascii  /r /
 740:         .word   relflg
 741:         .ascii  /g /
 742:         .word   glbflg
 743:         .if df  rsx11d
 744:         .ascii  /x /
 745:         .word   dfgflg
 746:         .endc
 747: 
 748: .data
 749: stars:  .asciz  /******/
 750: symtxt: .asciz  /symbol table/
 751:         xitsec
 752: lst.kb= 1                       ;teletype listing
 753: lst.lp= 2                       ;lpt listing
 754: 
 755: 
 756:         xitsec
 757: 
 758: ;
 759: ; These routines are high level.  They make output go to
 760: ; more than one device, they add page headers.  The dogsbody
 761: ; low guy is 'putli2', who in turn calls on 'o.kblp', which
 762: ; interfaces with the file buffering guys directly.
 763: ;
 764: 
 765: putkb:  mov     #lst.kb,lstreq  ;set request
 766:         br      putlix
 767: 
 768: putkbl: mov     #lst.kb,lstreq  ;set for tty
 769: putlp:  tst     lstflg          ;doing a listing?
 770:         beq     putlix          ;no
 771:         bisb    lstdev,lstreq   ;lpt
 772: ;
 773: ; output a line plain & simple
 774: ;
 775: putlix:
 776:         call    savreg
 777:         mov     r0,r2
 778:         movb    lstreq,r4
 779:         call    putli2
 780:         return
 781: 
 782: putlin:                         ;output a line with page heading if needed
 783:         call    savreg          ;stack registers
 784:         mov     r0,r2           ;arg to r2
 785:         movb    lstreq,r4       ;get request
 786:         clr     lstreq          ;clear it
 787:         tst     r4
 788:         beq     9$              ;just exit if empty
 789:         bgt     2$              ;omit header if not listing
 790:         dec     lppcnt          ;yes, decrement count
 791:         bgt     2$              ;skip if not time
 792:         call    putpag
 793: 2$:
 794:         call    err.pr
 795:         call    putli2          ;print out the line
 796: 9$:     return
 797: 
 798: 
 799: putli2:
 800:         movb    (r2)+,r1        ;get a char.
 801:         beq     21$             ;end on null
 802:         call    o.kblp          ;transmit appropriately
 803:         br      putli2          ;till null
 804: 21$:
 805:         movb    #lf,r1          ; used to be cr/lf
 806:         call    o.kblp
 807:         bit     #lst.kb,r4      ;if sending to cmochn,
 808:         beq     9$              ;no
 809:         zwrite  cmo             ;yes, send it now
 810: 9$:     return
 811: 
 812: o.kblp: bic     #177600,r1      ;just 7 bits, please.
 813:         bit     #lst.kb,r4      ;cmo on?
 814:         beq     1$              ;no
 815:         mov     #cmochn,r0      ;yes
 816:         call    putoc
 817: 1$:     bit     #lst.lp,r4      ;lst on?
 818:         beq     2$              ;no
 819:         mov     #lstchn,r0      ;yes
 820:         call    putoc
 821: 2$:     return
 822: ; put out a page heading
 823: putpag:
 824:         ;mov	#lpp,lppcnt	;reset count
 825:         mov     #lpp-4,lppcnt   ;reset count, compensate for bug introduced
 826:                                 ;by rearranging pagination logic
 827:         mov     r2,-(sp)        ;stack current pointer
 828:         mov     ttlbrk,r2       ;end of pre-set title
 829:         tst     pass
 830:         beq     11$
 831:         mov     #pagmne,r1
 832:         call    movbyt          ;move "page" into position
 833:         mov     pagnum,r1
 834:         call    dnc             ;convert to decimal
 835:         inc     pagext
 836:         beq     11$
 837:         movb    #'-,(r2)+
 838:         mov     pagext,r1
 839:         inc     r1
 840:         call    dnc
 841: 11$:    clrb    (r2)
 842:         tst     mx.flg          ; <<< REEDS june 81
 843:         bne     100$
 844:         putlp   #ttlbuf         ;print title
 845:         putlp   #stlbuf         ;  sub-title,
 846: 100$:
 847:         putlp   #crlf           ;  and a blank line
 848:         mov     (sp)+,r2
 849:         return
 850:         entsec  impure
 851: lstreq: .blkw                   ;list request flags
 852: lstdev: .blkb   2               ;error(lh), listing(rh)
 853: 
 854: .data
 855: pagmne: .ascii  / page /
 856: crlf:   .asciz  //
 857:         xitsec
 858: 
 859: 
 860: 
 861: .macro  putl    x               ; printf("%s\n", mx.lin)
 862:         mov     x,mx.tmp
 863:         call    putl
 864:         .endm
 865: putl:
 866:         .irpc   xx,<012345>
 867:         mov     r'xx,-(sp)
 868:         .endm
 869:         mov     mx.tmp,r2
 870:         mov     #lst.lp,r4
 871:         call    putli2
 872:         .irpc   xx,<543210>
 873:         mov     (sp)+,r'xx
 874:         .endm
 875:         return
 876: 
 877: putsc:
 878:         call savreg
 879:         mov     mdepth,r4
 880: 1$:
 881:         movb    #';,r1
 882:         call    mx.put
 883:         dec     r4
 884:         bpl     1$
 885:         movb    #tab,r1
 886:         call    mx.put
 887:         return
 888: mx.put:
 889:         call savreg
 890:         mov     #lst.lp,r4
 891:         bic     #177600,r1
 892:         mov     #lstchn,r0
 893:         call    putoc
 894:         return
 895: mx.mx:
 896:         call savreg
 897:         tst     mx.flg
 898:         beq     1$
 899:         mov     #mx.on,lcmask
 900:         tst     errbts
 901:         beq     3$
 902:         putl    #mxstar
 903:         call    err.pr
 904: 3$:
 905:         tst     mx.2                    ; is it a .narg, etc. directive?
 906:         beq     2$
 907:         clr     mx.2
 908:         tst     my.flg
 909:         bne     20$
 910:         call    putsc                   ;	;.narg frodo
 911:         putl    #linbuf
 912: 20$:
 913:         putl    #mx.gen                 ;	; generates:
 914:         putl    #mx.pxx                 ;		frodo  = 5280
 915:         br      1$
 916: 2$:
 917:         tst     my.flg                  ; is it otherwise suppressed & are
 918:         bne     1$                      ; we listing such?
 919:         bit     lcmask,lcflag   ; anything supppressed?
 920:         beq     1$
 921:         call    putsc
 922:         putl    #linbuf
 923: 1$:
 924:         return
 925: 
 926: err.pr:
 927:         call    savreg
 928:         mov     r0,-(sp)
 929:         mov     r5,-(sp)
 930:         tst     err.xx
 931:         beq     1$
 932:         mov     #lst.kb,r4
 933:         tst     lstflg
 934:         beq     2$
 935:         mov     #lst.lp,r4
 936: 2$:
 937:         mov     err.xx,r2
 938:         call    putli2
 939:         clr     err.xx
 940: 1$:
 941:         mov     (sp)+,r5
 942:         mov     (sp)+,r0
 943:         return
 944: 
 945:         .bss
 946: mdepth::        .blkw   1
 947:         xitsec
 948:         entsec  mixed
 949: mx.gen::        .asciz  /;*** generates:/
 950: mxstar::        .asciz  /*** error ***/
 951: mx.pxx:         .ascii  <tab>
 952: mx.sym::        .ascii  /symbol =       /
 953: mx.num::        .ascii  /65000/
 954:         .even
 955: mx.2::          .blkw
 956: mx.tmp:         .blkw                   ;	space for putl(arg)
 957: 
 958:         .end
Last modified: 1982-12-11
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1658
Valid CSS Valid XHTML 1.0 Strict