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/lib/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: 1982-12-11
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 473 |
|