# 2.11BSD#431 - /usr/src/new/m11/mac.m11

       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: 865 |