1:         .title  mac             ;macro handlers
   2: 
   3:         .ident  /03apr4/
   4: 
   5:         .mcall  (at)always,ch.mne,ct.mne
   6:         .mcall (at)putkb
   7:         .mcall  (at)sdebug ,ndebug
   8:         always
   9:         ch.mne
  10:         ct.mne
  11: 
  12:         .if ndf xmacro
  13: 
  14:         .mcall  (at)append,gencnd,error,scan,search
  15:         .mcall  (at)setnz,xmit,zap
  16: 
  17:         .globl  mx.flg                  ; defined in lout.m11
  18: 
  19:         .globl  smllvl, msbmrp, getmch, mactst
  20: 
  21:         .globl  absexp, aexp,   argcnt, asgmtf, chrpnt, cndmex
  22:         .globl  codrol, cradix
  23:         .globl  dflmac, dflsmc, dmarol, endflg
  24:         .globl  ed.lc,  edmask
  25:         .globl  endlin, finsml, getchr, getlin, getnb
  26:         .globl  mdepth
  27:         .globl  getr50, getsym, gsarg,  gsargf, inisml
  28:         .globl  insert, lblend, lcendl, lcflag, lcmask
  29:         .globl  lc.mc,  lc.me,  linbuf, lsgbas
  30:         .globl  mactop, macrol, mode,   pass, symbot,macovf,uplift,upbomb
  31:         .globl  r50unp, rolupd, savreg
  32:         .globl  setchr, setcli, setnb,  setpf0, setpf1
  33:         .globl  setsym, smlnam, smlfil, tstarg, value
  34:         .globl  symbol, lc.md,  xmit0
  35:         .globl  ucflag
  36: 
  37: 
  38:         .globl  crfdef, crfref
  39:         xitsec                  ;start in default sector
  40: 
  41: getmch:                         ;get a macro character
  42:         tst     getmcs          ;working on argument?
  43:         bne     18$             ;  yes
  44:         call    getmc2          ;move a character
  45:         bgt     4$              ;all set if .gt. zero
  46:         beq     2$              ;end if zero
  47:         cmp     r5,#mt.max      ;end of type?
  48:         bhi     10$             ;  no
  49:         mov     #vt,r5          ;yes, fudge return
  50:         call    savreg
  51:         jmp     endmac          ;close out expansion
  52: 
  53: 2$:     mov     r1,msbmrp       ;eol, store new pointer
  54:         bis     #lc.me,lcflag   ;flag as macro expansion
  55:         mov     #lf,r5          ;mark end
  56: 4$:     return
  57: 
  58: 10$:    mov     r1,getmcs       ;remember read pointer
  59:         mov     msbarg,r1
  60:         tst     (r1)+
  61:         mov     r5,r3           ;count
  62:         neg     r3              ;assume macro
  63:         cmp     msbtyp,#mt.mac  ;true?
  64:         beq     12$             ;  yes, use it
  65:         mov     msbcnt,r3       ;get arg number
  66: 12$:    dec     r3              ;move to proper arg
  67:         ble     18$             ;found
  68: 14$:    call    getmc2          ;get next char
  69:         bgt     14$             ;loop if pnz
  70:         beq     12$             ;new arg if zero
  71: 16$:    mov     getmcs,r1       ;reset read pointer
  72:         clr     getmcs          ;clear (used as flag)
  73:         br      getmch          ;null arg
  74: 
  75: 18$:    call    getmc2          ;get next character
  76:         ble     16$             ;finished if .le. zero
  77:         return
  78: 
  79: getmc2: bit     #bpmb-1,r1      ;macro, end of block?
  80:         bne     22$             ;  no
  81:         mov     -bpmb(r1),r1    ;yes, point to next block
  82:         tst     (r1)+           ;move past link
  83: 22$:    movb    (r1)+,r5        ;set in r5
  84:         return
  85: 
  86:         entsec  impure
  87: getmcs: .blkw                   ;macro pntr save while
  88:                                 ;processing args
  89:         xitsec
  90: 
  91:         .endc
  92:         .if ndf xmacro
  93: 
  94: mt.rpt= 177601
  95: mt.irp= 177602
  96: mt.mac= 177603
  97: mt.max= mt.mac
  98: 
  99:         .globl  rept,   endr,   endm
 100: 
 101: rept:                           ;repeat handler
 102:         call    absexp          ;evaluate count
 103:         mov     r0,-(sp)        ;save count
 104:         call    setpf1          ;mark the listing
 105:         call    getblk          ;get a storage block
 106:         clr     (r2)+           ;start in third word
 107:         clr     -(sp)           ;no arguments
 108:         mov     r0,-(sp)        ;  and start of block
 109:         tst     mx.flg          ; <<<
 110:         beq     1$              ; <<< REEDS june 81
 111:         bis     #lc.mc,lcflag   ; <<<
 112: 1$:                             ; <<<
 113:         call    endlin          ;polish off line
 114:         zap     dmarol          ;no dummy args for repeat
 115:         call    promt           ;use macro stuff
 116: 
 117:         mov     #mt.rpt,r5      ;fudge an "end of repeat"
 118: reptf:  call    wcimt
 119:         call    mpush           ;push previous macro block
 120:         mov     (sp)+,(r2)+     ;store text pointer
 121:         mov     (sp)+,(r2)+     ;store arg pointer
 122:         clr     (r2)+           ;counter
 123:         mov     (sp)+,(r2)+     ;max
 124:         call    setchr          ;restore character
 125: 
 126: endmac: mov     #msbcnt,r0      ;set pointer to count
 127:         inc     (r0)            ;bump it
 128:         cmp     (r0)+,(r0)+     ;through?
 129:         bgt     1$              ;  yes
 130:         mov     msbtxt,(r0)     ;no, set read pointer
 131:         add     #4,(r0)         ;bypass link
 132:         return
 133: 
 134: 1$:     clr     cndmex          ;clear mexit flag
 135:         jmp     mpop
 136: 
 137: endm:
 138:         error   56,o,<.endm out of context>
 139:         return
 140: endr:
 141:         error   57,o,<.endr out of context>
 142:         return
 143:         .iftf
 144:         .globl  opcerr
 145: opcerr: error   24,o,<opcode out of context>
 146:         return
 147: opcer1: error   25,o,<missing macro name>
 148:         return
 149:         .ift
 150:         .globl  macro,  macr
 151: 
 152: macro:
 153: macr:                           ;macro definition
 154:         call    gsarg           ;get the name
 155:         beq     opcer1          ;  error if null
 156: macrof:
 157:         call    tstarg          ;bypass possible comma
 158:         mov     symbol,macnam
 159:         mov     symbol+2,macnam+2
 160:         call    msrch           ;search the table
 161:          beq    1$              ;branch if null
 162:         call    decmac          ;decrement the reference
 163: 1$:
 164:         call    getblk          ;get a storage block
 165:         mov     r0,-(sp)        ;save pointer
 166:         call    msrch           ;getblk might have moved things
 167:         mov     (sp)+,(r4)      ;set pointer
 168:         call    insert          ;insert in table
 169:         call    crfdef
 170:         call    proma           ;process dummy args
 171:         clr     (r2)+           ;clear level count
 172:         mov     argcnt,(r2)+    ;keep number of args
 173:         mov     macgsb,(r2)+    ;  and generated symbol bits
 174:         bis     #lc.md,lcflag
 175:         call    endlin          ;polish off line
 176:         call    promt           ;process the text
 177:         call    getsym
 178:         beq     mac3
 179:         cmp     r0,macnam
 180:         bne     2$
 181:         cmp     symbol+2,macnam+2
 182:         beq     mac3
 183: 2$:     error   26,a,<.endm name doesn't match .macro name>
 184: mac3:   mov     #mt.mac,r5
 185:         call    wcimt           ;set end marker
 186:         call    setchr
 187:         return
 188: mactst:                         ;test for macro call
 189:         call    msrch           ;search for macro
 190:         beq     9$              ;  exit with zero if not found
 191:         call    setpf0          ;mark location
 192:         mov     r0,-(sp)        ;save text pointer
 193:         call    incmac          ;increment reference
 194:         cmp     (r0)+,(r0)+     ;move up a couple of slots
 195:         mov     (r0)+,argmax    ;set number of args
 196:         mov     (r0)+,macgsb    ;  and generated symbol bits
 197:         mov     r0,-(sp)        ;save pointer
 198:         call    crfref          ;cref it
 199:         call    promc           ;process call arguments
 200:         mov     r0,r3           ;save block pointer
 201:         mov     #mt.mac,r5
 202:         call    mpush           ;push nesting level
 203:         mov     (sp)+,msbmrp
 204:         mov     (sp)+,(r2)+     ;set text pointer
 205:         mov     r3,(r2)+        ;  and argument pointer
 206:         mov     argcnt,(r2)     ;fill in argument count
 207:         mov     (r2)+,(r2)+     ;  and replecate
 208:         call    setchr
 209:         setnz   r0              ;return non-zero
 210: 9$:     return
 211: 
 212: 
 213: msrch:  search  macrol          ;search macro roll
 214:         mov     value,r0        ;doesn't count if no pointer
 215:         return
 216:         .globl  irp,    irpc
 217: 
 218: irpc:   inc     r3
 219: irp:
 220:         call    gmarg
 221:         beq     1$
 222:         call    proma
 223:         call    rmarg
 224:         call    gmarg
 225:         beq     1$
 226:         mov     #177777,argmax  ;any number of arguments
 227:         call    promcf
 228:         mov     r0,r3
 229:         call    rmarg
 230:         call    getblk
 231:         clr     (r2)+
 232:         mov     argcnt,-(sp)
 233:         mov     r3,-(sp)
 234:         mov     r0,-(sp)
 235:         tst     mx.flg          ;
 236:         beq     111$;		; <<< REEDS june 81
 237:         bis     #lc.mc,lcflag   ;
 238: 111$:   call    endlin
 239:         call    promt
 240:         mov     #mt.irp,r5
 241:         jmp     reptf
 242: 
 243: 1$:     error   27,a,<illegal arguments>
 244:         return
 245: 
 246: proma:                          ;process macro args
 247:         zap     dmarol          ;clear dummy argument roll
 248:         clr     argcnt          ;get a fresh start with arguments
 249:         clr     macgsb          ;clear generated bit pattern
 250:         mov     #100000,-(sp)   ;stack first generated symbol bit
 251: 1$:     call    tstarg          ;any more args?
 252:         beq     3$              ;  no, quit and go home
 253:         cmp     #ch.qm,r5       ;yes, generated type?
 254:         bne     2$              ;  no
 255:         bis     (sp),macgsb     ;yes, set proper bit
 256:         call    getnb           ;bypass it
 257: 2$:     call    gsargf          ;get symbolic argument
 258:         append  dmarol          ;append to dma roll
 259:         clc
 260:         ror     (sp)            ;shift generated sym bit
 261:         br      1$
 262: 
 263: 3$:     tst     (sp)+           ;prune stack
 264:         return
 265: 
 266: 
 267: promc:  clr     r3
 268: promcf:
 269:         clr     argcnt
 270:         call    getblk
 271:         mov     r0,-(sp)
 272:         tst     r3
 273:         bne     prmc7
 274: prmc1:  cmp     argmax,argcnt
 275:         blos    prmc10
 276:         call    tstarg          ;bypass any comma
 277:         bne     9$              ;ok if non-null
 278:         tst     macgsb          ;null, any generated stuff left?
 279:         beq     prmc10          ;  no, through
 280: 9$:     cmp     #ch.bsl,r5      ; "\"?
 281:         beq     prmc20          ;  yes
 282:         call    gmargf          ;get argument
 283:         .if ndf xedlsb
 284:         tst     r5              ;any arguments?
 285:         bne     2$              ;  yes
 286:         tst     macgsb          ;no, generation requested?
 287:         bmi     prmc30          ;  yes
 288:         .endc
 289: 2$:     .if ndf xedlc           ;>>>gh 5/15/78 to not automatically upper-case
 290:         bit     #ed.lc,edmask   ;lower case enabled?
 291:         bne     3$              ;  no, leave as upper case
 292:         tst     ucflag
 293:         bne     3$
 294:         mov     chrpnt,r5       ;fake for ovlay pic
 295:         movb    (r5),r5         ;fetch original character
 296:         .endc
 297: 
 298: 3$:     call    wcimt
 299:         beq     prmc4
 300:         call    getchr
 301:         br      2$
 302: 
 303: prmc4:  call    rmarg
 304: prmc5:  asl     macgsb          ;move generation bit over one
 305:         br      prmc1
 306: 
 307: prmc6:  inc     argcnt
 308:         call    getchr
 309: prmc7:  .if ndf xedlc           ;>>>gh 5/15/78 to not automatically upper-case
 310:         bit     #ed.lc,edmask   ;lower case enabled?
 311:         bne     8$              ;  no, leave as upper case
 312:         tst     ucflag
 313:         bne     8$
 314:         mov     chrpnt,r5       ;fake for ovlay pic
 315:         movb    (r5),r5         ;fetch original character
 316:         .endc
 317: 8$:     call    wcimt
 318:         beq     prmc10
 319:         clr     r5
 320:         call    wcimt
 321:         br      prmc6
 322: 
 323: prmc10: com     r5
 324:         call    wcimt
 325:         com     r5
 326:         bit     #lc.mc,lcmask   ;macro call suppression?
 327:         beq     12$             ;  no
 328:         mov     lblend,r0       ;yes, have we a label?
 329:         beq     11$             ;  no, suppress entire line
 330:         mov     r0,lcendl       ;yes, list only label
 331:         br      12$
 332: 
 333: 11$:    bis     #lc.mc,lcflag
 334: 12$:    mov     (sp)+,r0
 335:         return
 336: prmc20: call    getnb           ; "\", bypass
 337:         call    absexp          ;evaluate expression, abs
 338:         mov     r5,-(sp)        ;stack character
 339:         mov     r3,-(sp)
 340:         mov     cradix,r3       ;break out in current radix
 341:         mov     r0,r1           ;value to r1
 342:         call    prmc40          ;convert to ascii
 343:         clr     r5
 344:         call    wcimt
 345:         mov     (sp)+,r3        ;restore regs
 346:         mov     (sp)+,r5
 347:         br      prmc5
 348: 
 349:         .if ndf xedlsb
 350: prmc30: inc     lsgbas          ;generated symbol, bump count
 351:         mov     lsgbas,r1       ;fetch it
 352:         add     #^d<64-1>,r1    ;start at 64.
 353:         bit     #177600,r1      ;gen symbols in range 64-127 only
 354:         beq     1$
 355:         error   54,t,<no generated symbols after 127$>
 356: 1$:
 357:         mov     r5,-(sp)        ;stack current char
 358:         mov     r3,-(sp)        ;and r3
 359:         mov     #10.,r3         ;make it decimal
 360:         call    prmc40          ;convert to ascii
 361:         mov     #ch.dol,r5
 362:         call    wcimt           ;write "$"
 363:         clr     r5
 364:         call    wcimt
 365:         mov     (sp)+,r3        ;restore regs
 366:         mov     (sp)+,r5
 367:         br      prmc4           ;return
 368:         .endc
 369: 
 370: prmc40:                         ;macro number converter
 371:         clr     r0
 372:         div     r3,r0
 373:         mov     r1,-(sp)        ;stack remainder
 374:         mov     r0,r1           ;set new number
 375:         beq     41$             ;down to zero?
 376:         call    prmc40          ;  no, recurse
 377: 41$:    mov     (sp)+,r5                ;get number
 378:         add     #dig.0,r5       ;convert to ascii
 379:         jmp     wcimt           ;write in tree and exit
 380: .globl  lst.kb,linbuf,putil2
 381: promt:
 382:         clr     r3
 383: 1$:     call    getlin
 384:         bne     2$
 385:         inc     macdfn
 386:         bis     #lc.md,lcflag
 387:         call    setcli
 388:         bit     #dflmac,r0
 389:         beq     63$
 390:         inc     r3
 391:         cmp     #endm,value     ; what a crock: .endm & .endr are synonyms
 392:         beq     10$             ; in spite of what the manual says
 393:         cmp     #endr,value
 394:         bne     3$
 395: 10$:    dec     r3
 396:         dec     r3
 397:         bpl     3$
 398: 2$:
 399:         clr     macdfn
 400:         return
 401: 63$:
 402:         .if ndf xsml
 403:         tst     smllvl          ;in system macro?
 404:         beq     3$              ;  no
 405:         bit     #dflsmc,r0      ;yes, nested?
 406:         beq     3$              ;  no
 407:         cmp     r5,#'(          ;check for prefix, crudely
 408:         bne     64$
 409:         call    getnb
 410:         call    getsym
 411:         cmp     r5,#')
 412:         bne     64$
 413:         call    getnb
 414: 64$:    call    smltst          ;yes, test for more
 415:         .endc
 416: 3$:     mov     #linbuf,chrpnt
 417:         call    setchr
 418: 4$:     call    getsym
 419:         beq     7$
 420:         scan    dmarol
 421:         mov     r0,r4
 422:         beq     5$
 423:         mov     rolupd,r5
 424:         neg     r5
 425:         dec     concnt
 426:         call    wcimt
 427:         dec     concnt
 428: 5$:     call    setsym
 429: 6$:     tst     r4
 430:         bne     61$
 431:         .if ndf xedlc           ;>>>gh 5/16/78 to not automatically upper-case
 432:         bit     #ed.lc,edmask   ;lower case enabled?
 433:         bne     21$             ;  no, leave as upper case
 434:         tst     ucflag
 435:         bne     21$
 436:         mov     chrpnt,r5       ;fake for ovlay pic
 437:         movb    (r5),r5         ;fetch original character
 438: 21$:    .endc
 439:         call    wcimt
 440: 61$:    call    getr50
 441:         bgt     6$
 442: 7$:     cmp     r5,#ch.xcl
 443:         beq     8$
 444:         .if ndf xedlc           ;>>>gh 5/16/78 to not automatically upper-case
 445:         bit     #ed.lc,edmask   ;lower case enabled?
 446:         bne     22$             ;  no, leave as upper case
 447:         tst     ucflag
 448:         bne     22$
 449:         mov     chrpnt,r5       ;fake for ovlay pic
 450:         movb    (r5),r5         ;fetch original character
 451: 22$:    .endc
 452:         call    wcimt
 453:         bne     9$
 454:         call    endlin
 455:         jmp     1$
 456: 
 457: 8$:     inc     concnt
 458: 9$:     call    getchr
 459:         br      4$
 460: 
 461:         .globl  narg,   nchr,   ntype,  mexit
 462:         .globl  mx.2,mx.sym,mx.num ,dnc
 463: 
 464: narg:                           ;number of arguments
 465:         call    gsarg           ;get a symbol
 466:         beq     ntyper          ;error if missing
 467:         mov     msbcnt+2,r3     ;set number
 468:         br      ntypex
 469: 
 470: nchr:                           ;number of characters
 471:         call    gsarg
 472:         beq     ntyper          ;  error id no symbol
 473:         call    gmarg           ;isolate argument
 474:         beq     ntypex          ;  zero if null
 475:         tst     r5              ;quick test for completion
 476:         beq     2$              ;  yes
 477: 1$:     inc     r3              ;bump count
 478:         call    getchr          ;get the next character
 479:         bne     1$              ;loop if not end
 480: 2$:     call    rmarg           ;remove arg delimiters
 481:         br      ntypex
 482: 
 483: ntype:                          ;test expression mode
 484:         call    gsarg           ;get the symbol
 485:         beq     ntyper          ;  error
 486:         call    tstarg          ;bypass any commas
 487:         mov     #symbol,r1
 488:         mov     (r1)+,-(sp)     ;preserve symbol
 489:         mov     (r1)+,-(sp)
 490:         call    aexp            ;evaluate
 491:         mov     r0,r3           ;set result
 492:         zap     codrol          ;clear any generated code
 493:         mov     (sp)+,-(r1)     ;restore symbol
 494:         mov     (sp)+,-(r1)
 495: ntypex: clr     mode            ;clear mode
 496:         mov     r3,value        ;  and set value
 497:         tst     mx.flg          ; <<< REEDS june 81
 498:         beq     100$            ; <<<
 499:         bis     #lc.mc,lcflag   ; <<<
 500:         mov     #1,mx.2         ; <<<
 501:         .irpc   xx,<012345>     ; <<<
 502:         mov     r'xx,-(sp)      ; <<<
 503:         .endm                   ; <<<
 504:         mov     #mx.sym,r2      ; <<<
 505:         call    r50unp          ; <<<
 506:         mov     #mx.num,r2      ; <<<
 507:         mov     value,r1        ; <<<
 508:         call    dnc             ; <<<
 509:         movb    #0,(r2)         ; <<<
 510:         .irpc   xx,<543210>     ; <<<
 511:         mov     (sp)+,r'xx      ; <<<
 512:         .endm                   ; <<<
 513: 100$:                           ; <<<
 514:         jmp     asgmtf          ;exit through assignment
 515: 
 516: ;
 517: ; there are mxpand problems here.
 518: ;
 519: ;
 520: ;
 521: ntyper: error   28,a,<no symbol to assign to>
 522:         br      ntypex
 523: 
 524: mexit:                          ;macro/repeat exit
 525:         mov     maclvl,cndmex   ;in macro?
 526:         bne     mex1            ;  yes, pop
 527:         error   29,o,<unbalanced .endm>         ;  no, error
 528: mex1:   return
 529: 
 530:         gencnd  b,      tcb
 531:         gencnd  nb,     tcb,    f
 532:         gencnd  idn,    tcid
 533:         gencnd  dif,    tcid,   f
 534: 
 535: 
 536: tcb:                            ; "ifb" conditional
 537:         beq     tcberx          ;ok if null
 538:         call    gmargf          ;isolate argument
 539:         call    setnb           ;bypass any blanks
 540:         beq     tcidt           ;true if pointing at delimiter
 541:         br      tcidf           ;else false
 542: 
 543: tcberr: error   30,a,<missing argument in 'if' construction>
 544:                                         ;naughty
 545: tcberx: return
 546: 
 547: tcid:                           ; "ifidn" conditional
 548:         beq     tcberr          ;error if null arg
 549:         call    gmargf          ;isolate first arg
 550:         mov     chrpnt,r1       ;save character pointer
 551:         tst     -(r0)
 552:         mov     -(r0),r2        ;pointer to terminator
 553:         call    rmarg           ;return this arg
 554:         call    gmarg           ;get the next
 555:         beq     tcberr
 556: 1$:     movb    (r1),r0         ;set character from first field
 557:         cmp     r1,r2           ;is it the last?
 558:         bne     2$              ;  no
 559:         clr     r0              ;yes, clear it
 560: 2$:     .if ndf xedlc           ;>>>gh 5/17/78 to properly compare upper and lower case
 561:         bit     #ed.lc,edmask   ;lower case enabled?
 562:         bne     3$              ;  no, leave as upper case
 563:         tst     ucflag
 564:         bne     3$
 565:         mov     chrpnt,r5       ;fake for ovlay pic
 566:         movb    (r5),r5         ;fetch original character
 567:         .endc
 568: 3$:     cmp     r0,r5           ;match?
 569:         bne     tcidf           ;  no
 570:         tst     r5              ;yes, finished?
 571:         beq     tcidt           ;  yes, good show
 572:         call    getchr          ;no, get the next character
 573:         inc     r1              ;advance first arg pointer
 574:         br      1$              ;try again
 575: 
 576: tcidf:  com     r3              ;false, toggle condition
 577: tcidt:  jmp     rmarg           ;ok, restore argument
 578: 
 579: gmarg:                          ;get macro argument
 580:         call    tstarg          ;test for null
 581:         beq     gmargx          ;  yes, just exit
 582: gmargf: call    savreg          ;stash registers
 583:         clr     r1              ;clear count
 584:         mov     #chrpnt,r2
 585:         mov     (r2),-(sp)      ;save initial character pointer
 586:         mov     #ch.lab,r3      ;assume "<>"
 587:         mov     #ch.rab,r4
 588:         cmp     r5,r3           ;true?
 589:         beq     11$             ;  yes
 590:         cmp     r5,#ch.uar      ;up-arrow?
 591:         beq     10$             ;  yes
 592: 1$:     bitb    #ct.pc-ct.com-ct.smc,cttbl(r5)  ;printing character?
 593:         beq     gm21            ;  no
 594:         call    getchr          ;yes, move on
 595:         br      1$
 596: 
 597: 10$:    call    getnb           ; "^", bypass it
 598:         beq     20$             ;error if null
 599:         mov     (r2),(sp)       ;set new pointer
 600:         com     r3              ;no "<" equivalent
 601:         .if ndf xedlc           ;>>>gh 5/17/78 to not automatically upper-case
 602:         bit     #ed.lc,edmask   ;lower case enabled?
 603:         bne     3$              ;  no, leave as upper case
 604:         tst     ucflag
 605:         bne     3$
 606:         mov     chrpnt,r5       ;fake for ovlay pic
 607:         movb    (r5),r5         ;fetch original character
 608: 3$:     .endc
 609:         mov     r5,r4           ;">" equivalent
 610: 11$:    call    getchr
 611:         beq     20$             ;  error if eol
 612:         .if ndf xedlc           ;>>>gh 5/17/78 to not automatically upper-case
 613:         bit     #ed.lc,edmask   ;lower case enabled?
 614:         bne     4$              ;  no, leave as upper case
 615:         tst     ucflag
 616:         bne     4$              ;  no, leave as upper case
 617:         mov     chrpnt,r5       ;fake for ovlay pic
 618:         movb    (r5),r5         ;fetch original character
 619: 4$:     .endc
 620:         cmp     r5,r3           ; "<"?
 621:         beq     12$             ;  yes
 622:         cmp     r5,r4           ;no, ">"?
 623:         bne     11$             ;  no, try again
 624:         dec     r1              ;yes, decrement level count
 625:         dec     r1
 626: 12$:    inc     r1
 627:         bpl     11$             ;loop if not through
 628:         inc     (sp)            ;point past "<"
 629:         bis     #100000,r5      ;must move past in rmarg
 630:         br      gm21
 631: 
 632: 20$:    error   31,a,<missing argument>
 633: gm21:   mov     gmapnt,r0       ;get current arg save pointer
 634:         bne     22$             ;branch if initialized
 635:         mov     #gmablk,r0      ;do so
 636: 22$:    mov     (r2),(r0)+      ;save pointer
 637:         mov     r5,(r0)+        ;  and character
 638:         clrb    @(r2)           ;set null terminator
 639:         mov     (sp)+,(r2)      ;point to start of arg
 640:         call    setchr          ;set register 5
 641:         mov     r0,gmapnt       ;save new buffer pointer
 642: gmargx: return
 643: rmarg:                          ;remove macro argument
 644:         mov     gmapnt,r0       ;set pointer to saved items
 645:         mov     -(r0),r5        ;set character
 646:         tst     -(r0)
 647:         movb    r5,@(r0)        ;restore virgin character
 648:         asl     r5
 649:         adc     (r0)
 650:         mov     (r0),chrpnt
 651:         call    setnb
 652:         mov     r0,gmapnt
 653:         return
 654: 
 655:         entsec  imppas
 656: gmapnt: .blkw   1               ;pointer to following buffer
 657: gmablk: .blkw   1               ;pointer to "borrowed" character
 658:         .blkw   1               ;character itself
 659:         .blkw   3*2             ;room for more pairs
 660:         xitsec
 661: wcimt:                          ;write character in macro tree
 662:         dec     concnt          ;any concatenation chars pending?
 663:         bmi     1$              ;  no
 664:         mov     r5,-(sp)        ;yes, stack current character
 665:         mov     #ch.xcl,r5
 666:         call    2$
 667:         mov     (sp)+,r5
 668:         br      wcimt
 669: 
 670: 1$:     clr     concnt
 671: 2$:     bit     #bpmb-1,r2      ;room in this block?
 672:         bne     3$              ;  yes
 673:         sub     #bpmb,r2        ;no, point to link
 674:         mov     r2,-(sp)
 675:         call    getblk
 676:         mov     r0,@(sp)+       ;set new link
 677: 3$:     movb    r5,(r2)+        ;write, leaving flags set
 678:         return
 679: 
 680: getblk:                         ;get a macro block
 681:         mov     r3,-(sp)
 682:         mov     macnxt,r0       ;test for block in garbage
 683:         bne     1$              ;  yes, use it
 684:         mov     mactop,r0       ;no, get a new one
 685:         add     #bpmb,mactop    ;set new pointer
 686:         mov     #macovf,upbomb  ; on error, print message & die
 687:         call    uplift          ; check if overran dynamic tables
 688:                                 ; if so, buy more core & shuffle
 689:                                 ; (on error, uplift won't return)
 690:         br      2$
 691: 
 692: 1$:     mov     (r0),macnxt     ;set new chain
 693: 2$:     mov     r0,r2
 694:         clr     (r2)+           ;clear link cell, point past it
 695:         mov     (sp)+,r3
 696:         return
 697: 
 698: 
 699: 
 700: incmac: inc     2(r0)           ;increment macro reference
 701:         return
 702: 
 703: decmac: dec     2(r0)           ;decrement macro storage
 704:         bpl     remmax          ;just exit if non-negative
 705: 
 706: remmac: mov     r0,-(sp)        ;save pointer
 707: 1$:     tst     (r0)            ;end of chain?
 708:         beq     2$              ;  yes
 709:         mov     (r0),r0         ;no, link
 710:         br      1$
 711: 
 712: 2$:     mov     macnxt,(r0)
 713:         mov     (sp)+,macnxt
 714: remmax: return
 715: mpush:                          ;push macro nesting level
 716:         inc     mdepth
 717:         call    getblk          ;get a storage block
 718:         tst     -(r2)           ;point to start
 719:         mov     #msbblk,r1      ;pointer to start of prototype
 720:         mov     r2,-(sp)        ;save destination
 721:         mov     r1,-(sp)        ;  and core pointers
 722: 1$:     mov     (r1),(r2)+      ;xfer an item
 723:         clr     (r1)+           ;clear core slot
 724:         cmp     #msbend,r1      ;through?
 725:         bne     1$              ;  no
 726:         mov     (sp)+,r2        ;yes, make core destination
 727:         mov     r5,(r2)+        ;save type
 728:         mov     (sp)+,(r2)+     ;  and previous block pointer
 729:         inc     maclvl          ;bump level count
 730:         return                  ;return with r2 pointing at msbtxt
 731: 
 732: mpop:                           ;pop macro nesting level
 733:         dec     mdepth          ;for lout.m11
 734:         mov     #msbarg+2,r2    ;point one slot past arg
 735:         mov     -(r2),r0        ;get pointer to arg block
 736:         beq     1$              ;branch if null
 737:         call    remmac          ;remove it
 738: 1$:     mov     -(r2),r0        ;point to text block
 739:         beq     2$              ;branch if null
 740:         call    decmac          ;decrement level
 741: 2$:     mov     -(r2),r1        ;get previous block
 742:         tst     -(r2)           ;point to start
 743:         mov     r1,r0           ;save block pointer
 744:         call    xmit0-<msbend-msbblk>   ;xfer block
 745:         clr     (r0)            ;clear link
 746:         call    remmac          ;return block for deposit
 747:         dec     maclvl          ;decrement level count
 748:         return
 749: 
 750: 
 751:         entsec  impure
 752: msbblk:                         ;pushable block (must be ordered)
 753: msbtyp: .blkw                   ;block type
 754: msbpbp: .blkw                   ;previous block pointer
 755: msbtxt: .blkw                   ;pointer to basic text block
 756: msbarg: .blkw                   ;pointer to arg block
 757: msbcnt: .blkw   2               ;repeat count, etc.
 758: msbmrp: .blkw                   ;macro read pointer
 759: msbend:                         ;end of ordered storage
 760: 
 761: macnxt: .blkw
 762: maclvl: .blkw                   ;macro level count
 763: concnt: .blkw
 764: argmax: .blkw
 765: macnam: .blkw   2
 766: macgsb: .blkw                   ;macro generated symbol bits
 767:         xitsec
 768:         .if ndf xsml
 769: 
 770:         .globl  mcall           ;.mcall
 771: 
 772: mcall:  bis     #lc.md,lcflag   ;for listing control
 773:         mov     #sysmac,-(sp)   ;assume system mcall
 774:         cmp     r5,#'(          ;named file?
 775:         bne     14$             ;  no, use system
 776:         mov     #smlfil,r1      ;yes, point to dest. for specified pathname.
 777:         mov     r1,(sp)         ;store as adr. of pathname being gathered
 778: 11$:    cmp     r1,#smlfil+34   ;any more room?
 779:         blo     12$             ;yes
 780:         dec     r1              ;no, cause truncation.
 781: 12$:    call    getnb           ;get next char. (ignoring blanks)
 782:         .if ndf xedlc
 783:         movb    @chrpnt,(r1)    ;store char.
 784:         bicb    #200,(r1)       ;turn off sign bit
 785:         .iff
 786:         movb    r5,(r1)         ;store char.
 787:         .endc
 788:         cmpb    (r1)+,#')
 789:         bne     11$             ;continue till ")"
 790:         clrb    -(r1)           ;end, make null
 791:         call    getnb           ;yes, bypass it
 792: 14$:    mov     (sp)+,smlnam    ;store pointer to asciz name
 793:         call    smltst          ;test for undefined arguments
 794:         jeq     5$              ;  branch if none
 795:         tst     pass            ;found some, pass one?
 796:         bne     41$             ;  no, error
 797: 1$:     call    inisml          ;get another file
 798:         beq     42$             ;  error if none
 799: 2$:     clr     r3              ;set count to zero
 800: 3$:     call    getlin          ;get a new line
 801:         bne     1$              ;try another file if eof
 802:         call    setcli          ;test for directive
 803:         bit     #dflmac,r0      ;macro/endm?
 804:         beq     3$              ;  no
 805:         mov     #value,r4       ;set for local and macrof
 806:         dec     r3              ;yes, assume .endm
 807:         cmp     #endm,(r4)      ;good guess?
 808:         beq     3$              ;  yes
 809:         cmp     #endr,(r4)      ;a synonym for .endm
 810:         beq     3$              ;  yes
 811:         inc     r3              ;no, bump count
 812:         inc     r3
 813:         cmp     #1,r3           ;outer level?
 814:         bne     3$              ;  no
 815:         call    gsarg           ;yes, get name
 816:         beq     44$             ;  error if null
 817:         search  macrol          ;search table
 818:         beq     3$              ;  ignore if not found
 819:         tst     (r4)            ;has it a value?
 820:          bne    3$              ;  no, not interested
 821:         call    macrof          ;good, define it
 822:         dec     smllvl          ;decrement count
 823:         bgt     2$              ;loop if more to go
 824:         br      5$              ;ok, clean up
 825: 
 826: 4$:     error   60,u ,<.mcall error>
 827:         br      5$
 828: 41$:    tst     err.xx          ; dont want this message to mask the others
 829:         bne     5$
 830:         error   61,u ,<macro not defined by .mcall>
 831:         br      5$
 832: 42$:    error   62,u ,<cannot open .mcall file>
 833:         br      5$
 834: 44$:    error   63,u ,<illegal .macro statement in .mcall>
 835: 5$:     clr     smllvl          ;make sure count is zapped
 836:         clr     endflg          ;ditto for end flag
 837:         jmp     finsml          ;be sure files are closed
 838: 
 839:         entsec  dpure
 840: sysmac:                 ;kludged to lower-case
 841:         .enabl lc
 842:         .asciz  +/usr/share/misc/sysmac+
 843: 
 844:         xitsec
 845: smltst:                         ;test mcall arguments
 846: 1$:     call    gsarg           ;fetch next argument
 847:         beq     3$              ;  exit if through
 848:         call    msrch           ;ok, test for macros
 849:         bne     2$              ;  found, not interested
 850:         call    insert          ;insert with zero pointer
 851:         inc     smllvl          ;bump count
 852: 2$:     call    crfdef          ;cref it
 853:         br      1$
 854: 
 855: 3$:     mov     smllvl,r0       ;finished, count to r0
 856:         return
 857: 
 858:         entsec  imppas
 859: smllvl: .blkw                   ;mcall hit count
 860:         xitsec
 861: 
 862:         .endc                   ;xsml
 863: 
 864:         .endc                   ;xmacro
 865: ;
 866: ; mac.er is called on reaching end of prog w/o .end file or when
 867: ; running out of core.
 868: ;
 869: .globl  lst.kb,putli2, mac.er, macdfn
 870: .text
 871: mac.er:
 872:         call    savreg
 873:         tst     macdfn
 874:         beq     9$
 875:         tst     pass
 876:         beq     9$
 877:         mov     #mac.xx,r2
 878:         mov     #lst.kb,r4
 879:         call    putli2
 880: 9$:     return
 881: .data
 882: mac.xx: .asciz /possibly unterminated .macro, .rept, .irp, or .irpc/
 883: .even
 884: .bss
 885: macdfn: .blkw
 886:         .end
Last modified: 1996-10-24
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 379
Valid CSS Valid XHTML 1.0 Strict