1: .title xlat 2: 3: .ident /09may4/ 4: 5: .mcall (at)always,ch.mne,st.flg,ct.mne 6: always 7: ch.mne 8: st.flg 9: ct.mne 10: 11: .mcall (at)xmit 12: .mcall (at)genswt,error,genedt 13: .mcall (at)search,scan,scanw,zap 14: .mcall (at)bisbic 15: .mcall (at)sdebug,ndebug 16: 17: .globl secini, stmnt 18: .globl edmask, seted, setmax, propc 19: 20: .globl cndwrd, lsybas, lsbset, lc.cnd, opclas 21: .globl exmflg, err.u 22: 23: .globl codrol, secrol, psarol, edtrol 24: .globl symrol, pstrol 25: 26: .globl dflcnd, dflgev, dflgbm, dflgdg 27: .globl wrdsym 28: 29: .globl crfdef, crfref 30: 31: .globl clcfgs, clcloc, clcmax 32: .globl clcnam, clcsec, cpopj, cradix, cvtnum 33: .globl edmask, endvec, errbts, expflg 34: .globl flags, getchr, getnb, getsym, insert 35: .globl lsrch, mode, psdflt 36: .globl r50dot 37: .globl sector, setnb, setpf0, setpf1 38: .globl setsec, setsym, setxpr, stcode 39: .globl symbol, symbeg, tstarg, value 40: 41: .globl abstrm, abstst 42: .globl expr, exprg, relexp 43: .globl reltst, setdsp, setimm 44: .globl tstr50, mulr50 45: .globl mactst 46: .globl setcli 47: 48: .globl absexp, chrpnt 49: .globl savreg, xmit0 50: .globl gsarg, gsargf, argcnt 51: 52: .globl aexp, asgmtf, cndmex, cttbl 53: .globl endflg 54: .globl lblend, lcflag 55: .sbttl statement processor 56: 57: xitsec ;start in default sector 58: 59: stmnt: 60: mov cndwrd,r0 ;in conditional? 61: bis cndmex,r0 ; or mexit? 62: bne 40$ ; yes, branch if suppressed 63: call getsym 64: beq 20$ 65: cmp r5,#ch.col ; ":" 66: beq label 67: cmp r5,#ch.equ ; "=" 68: bne 1$ ; no 69: jmp asgmt ;yes, process it 70: 71: 1$: .if ndf xmacro 72: call mactst ;test for a macro 73: bne 42$ ; yes, already processed 74: .endc 75: 76: search pstrol 77: beq 30$ 78: call crfref 79: 10$: jmp propc ;process op code 80: 20$: 81: .if ndf xedlsb 82: mov #10.,r2 ;not symbol, perhaps local symbol? 83: mov chrpnt,symbeg ;in case of re-scan 84: call cvtnum 85: beq 30$ ; no 86: cmp r5,#ch.dol ;number, terminated by "$"? 87: bne 30$ ; no 88: call getnb 89: cmp r5,#ch.col 90: bne 30$ 91: .if ndf rsx11d 92: mov clcloc,r0 93: sub lsybas,r0 ;compute local offset 94: bit #177400,r0 ;in range 95: beq 21$ ; yes 96: error 70,a,<local offset out of range> ;no, error 97: .endc 98: 21$: call lsrch ;yes, do a local symbol search 99: br labelf ;exit through label processor 100: .endc 101: 102: 30$: call setsym ;reset char pointer and flags 103: tstb cttbl(r5) 104: ble 42$ ;null if end of line 105: mov #wrdsym,r1 ;neither, fudge ".word" directive 106: mov #symbol,r2 107: xmit 4 108: br 10$ 109: 110: 40$: call setcli ;unsat conditional, test directive 111: bmi 41$ ; branch if eof 112: bit #dflcnd,r0 ;conditional? 113: bne 10$ ; yes, process it 114: bis #lc.cnd,lcflag ;mark as unsat conditional 115: 41$: clr r5 116: 42$: return ;ignore line 117: setcli: 118: 1$: call getsym ;try for symbol 119: .if ndf xedlsb 120: bne 3$ ;branch if found 121: bitb #ct.num,cttbl(r5) ;perhaps a local? 122: beq 5$ ; no 123: 2$: call getchr ;perhaps, test next 124: bitb #ct.alp!ct.num,cttbl(r5) ;alpha/numeric? 125: bne 2$ ; yes, try again 126: call setnb ;no, bypass any blanks 127: .iff 128: beq 5$ ; exit if no symbol 129: .endc 130: 3$: cmp r5,#ch.equ ;assignment (=)? 131: beq 5$ ; yes, ignore this line 132: cmp r5,#ch.col ;label (:)? 133: bne 4$ ; no 134: call getnb ;yes, bypass colon 135: br 1$ ; and continue 136: 137: 4$: search pstrol ;try for op-code 138: mov mode,r0 ;mode to r0 139: bpl 6$ ;branch if directive 140: 5$: clr r0 ;false 141: 6$: return 142: 143: label: ;label processor 144: .enabl lsb 145: cmp symbol,r50dot ;period? 146: beq 4$ ; yes, error 147: .if ndf xedlsb 148: call lsbset ;flag start of new local symbol block 149: .endc 150: search symrol ;no, search the symbol table 151: call crfdef 152: labelf: call setxpr ;set expression registers 153: bit #dfgflg,(r3) ; <<< REEDS has it been marked 'x' 154: beq 33$ ; <<< no, thats OK 155: bic #dfgflg!glbflg,(r3); <<<yes: it was 'x' mode 156: ; <<< clear 'gx': we are really defining it now 157: 33$: clr dfgtmp ; <<< seems like a good idea. 158: call getnb ;bypass colon 159: .if ne,mk.symbol 160: cmp r5,#ch.col 161: bne 10$ 162: mov #glbflg,dfgtmp 163: call getnb 164: 10$: cmp r5,#ch.mul 165: bne 32$ 166: bis #200,dfgtmp 167: call getnb 168: 32$: .endc 169: bit #defflg,(r3) ;already defined? 170: bne 1$ ; yes 171: mov clcfgs,r0 ;no, get current location characteristics 172: bic #377-<relflg>,r0 ;clear all but relocation flag 173: bis #defflg!lblflg,r0 ;flag as label 174: .if ne,mk.symbol 175: bis dfgtmp,r0 176: .endc 177: bis r0,(r3) ;set mode 178: mov clcloc,(r4) ; and current location 179: br 3$ ;insert 180: 181: 1$: bit #lblflg,(r3) ;defined, as label? 182: beq 2$ ; no, invalid 183: cmp clcloc,(r4) ;has anybody moved? 184: bne 2$ ; yes 185: cmpb clcsec,(r2) ;same sector? 186: beq 3$ ; yes, ok 187: 2$: error 32,p,<phase error in label definition>;no, flag error 188: bis #mdfflg,(r3) ;flag as multiply defined 189: 3$: call insert ;insert/update 190: call setpf0 ;be sure to print location field 191: br 5$ 192: 193: 4$: error 33,q,<illegal label> 194: 5$: mov chrpnt,lblend ;mark end of label 195: .if ne,mk.symbol 196: clr dfgtmp 197: entsec impure 198: dfgtmp: .blkw 199: xitsec 200: .endc 201: jmp stmnt ;try for more 202: .dsabl lsb 203: 204: .sbttl assignment processor 205: 206: asgmt: 207: call getnb ;bypass "=" 208: .if ne,mk.symbol 209: cmp r5,#ch.equ 210: bne 10$ 211: mov #glbflg,dfgtmp 212: call getnb 213: 10$: cmp r5,#ch.mul 214: bne 32$ 215: bis #200,dfgtmp 216: call getnb 217: 32$: .iftf 218: mov #symbol+4,r1 ;set mix-master register 219: mov -(r1),-(sp) ;stack symbol 220: mov -(r1),-(sp) 221: call relexp ;get non-external expression 222: mov (sp)+,(r1)+ ;restore symbol 223: mov (sp)+,(r1)+ 224: bit #err.u,errbts ;any undefined's? 225: bne asgmtx ; yes, don't define 226: asgmtf: call setpf1 ;set listing field 227: call setxpr ;set expression registers 228: bit #err.a,errbts 229: bne asgmtx 230: bis #defflg,(r3) ;flag as defined 231: mov (r3),-(sp) ;no, stack value 232: mov (r4),-(sp) 233: search symrol ;search symbol table 234: mov (sp)+,(r4) ;restore value 235: bic #^c<glbflg>,(r3) 236: bis (sp)+,(r3) 237: cmp (r1),r50dot ;messing with the pc? 238: beq 1$ ; yes 239: .ift 240: bis dfgtmp,(r3) ;i hope 241: .iftf 242: call insert ;insert new value 243: br asgmtx 244: 245: 1$: cmpb (r2),clcsec ;same sector? 246: bne 2$ ; no, error 247: mov (r4),clcloc ;yes, set new location 248: br asgmtx 249: 250: 2$: error 34,m,<label multiply defined> 251: asgmtx: call crfdef 252: .ift 253: clr dfgtmp 254: .endc 255: return 256: 257: .sbttl op code processor 258: error 35,z,<op code not in standard set> 259: propc: ;process op code 260: mov #mode,r4 ;point to mode 261: mov (r4),r1 ;leave result in r1 262: mov r1,opclas ;flag op class 263: clr (r4)+ ;set to zero, point to value 264: mov #clcloc,r2 ;point r2 to location counter 265: bit #100000+dflgev,r1 ;op code or even directive? 266: beq 1$ ; no 267: bit #1,(r2) ;yes, currently even? 268: beq 1$ ; yes 269: inc (r2) ;no, make it even 270: error 36,b,<odd addressing error> ; and flag error 271: 1$: tst r1 ;op-code? 272: bmi 10$ ; yes 273: mov (r4),-(sp) ;no, directive. 274: clr (r4) ;clear value 275: clr r3 ;start with r3=0 276: call @(sp)+ ;call the handler 277: bit #dflgdg,opclas ;data generating directive? 278: jeq prop23 ; no 279: tstb <^pl rolsiz>+codrol+1 ;yes, any generated? 280: jne prop23 ; yes, all set 281: clr mode ;no, store a zero byte/word 282: clr value 283: jmp stcode 284: 285: 10$: call stcode ;stuff basic value 286: .globl pdp10,fltg1w ; defined in exec.m11 and in fltg.m11 287: bit pdp10,r1 ; <<< REEDS june 81 288: beq 100$ ; <<< 289: error 35,z,<op code not in standard set> ; <<< 290: 100$: ; <<< 291: swab r1 292: bic #177600,r1 ;clear high order bits 293: asl r1 294: asl r1 ;four bytes per table entry 295: clr -(sp) ;set a stopper 296: mov opjtbl+2(r1),-(sp) ;stack second arg 297: mov opjtbl(r1),r1 ;set the first argument 298: 12$: mov r1,-(sp) ;save a copy of the arg 299: call tstarg ;comma test 300: clr r0 ;function register 301: bic #000001,r1 ;clear shift bit 302: call (r1) ;call proper routine 303: aslb opclas ;move cref destruction into place 304: asrb opclas ;restore rest of flags 305: ror (sp)+ ;shift required? 306: bcc 13$ ; no 307: swab r0 ;yes, shift left siz 308: asr r0 309: asr r0 310: 13$: mov <^pl rolbas>+codrol,r1 311: bis r0,6(r1) ;set expression bits 312: mov (sp)+,r1 ;get next arg from stack 313: bne 12$ ;branch if not terminator 314: 315: .if ndf xzerr 316: mov <^pl rolbas>+codrol,r1 317: mov 6(r1),r0 ;set for "z" error tests 318: mov r0,r1 319: bic #000007,r1 320: cmp #000120,r1 ; jmp (r)+ 321: beq 22$ 322: bic #000700,r1 323: cmp #004020,r1 ; jsr x,(r1)+ 324: beq 22$ 325: mov r0,r1 326: bit #007000,r1 ;first arg type 0? 327: jne prop23 ; no, ok 328: bic #100777,r1 329: jeq prop23 330: cmp #070000,r1 ;double address type? 331: jeq prop23 ; no 332: mov r0,r1 333: bic #170017,r1 334: cmp #000760,r1 ; mov pc,[@]x(r) 335: beq 22$ 336: bic #177717,r1 337: cmp #000020,r1 ; (r)+ 338: beq 21$ 339: cmp #000040,r1 ; -(r) 340: jne prop23 341: 21$: mov r0,r1 342: rol r1 343: rol r1 344: swab r1 345: sub r0,r1 346: bit #000007,r1 ; r1=r2 347: jne prop23 348: 22$: error 37,z,<unpredictable instruction> 349: prop23: 350: .endc 351: 352: return 353: .macro genopj number,subr1,subr2 ;op code jump table 354: .globl opcl'number 355: opcl'number= <.-opjtbl>/4 356: .iif nb <subr1>, .word subr1 357: .iif b <subr1>, .word cpopj 358: .iif nb <subr2>, .word subr2 359: .iif b <subr2>, .word cpopj 360: .endm 361: 362: .data 363: opjtbl: ;op code jump table 364: genopj 00 365: genopj 01, aexp 366: genopj 02, aexp+1, aexp 367: genopj 03, regexp 368: genopj 04, brop 369: genopj 05, regexp+1, aexp 370: genopj 06, trapop 371: 372: .if ndf x45!x40 373: genopj 07, aexp, regexp+1 374: genopj 08, regexp+1, sobop 375: genopj 09, aexp, regexp+1 376: .endc 377: .if ndf x45 378: genopj 10, markop 379: genopj 11, aexp, drgexp+1 380: genopj 12, drgexp+1, aexp 381: genopj 13, splop 382: genopj 14, aexp, drgexp+1 383: .endc 384: 385: 386: entsec implin 387: opclas: .blkw ;op code class 388: xitsec 389: regexp: ;register expression 390: call absexp ;evaluate absolute 391: bit #177770,r0 ;any overflow? 392: beq reg1 ; no 393: error 38,r,<no such register number> ;yes, flag error 394: bic #177770,r0 ;clear overflow 395: reg1: return 396: 397: brop: ;branch displacement type 398: call relexp 399: cmpb sector,clcsec 400: bne 5$ 401: sub clcloc,r0 402: asr r0 403: bcs 2$ 404: dec r0 405: movb r0,r3 ;extend sign 406: cmp r0,r3 ;proper? 407: beq 3$ ; yes 408: 2$: error 81,a,<too far to branch> 409: 4$: mov #000377,r0 410: 3$: bic #177400,r0 ;clear possible high bits 411: return 412: 5$: error 80,a,<branch out of current psect> 413: br 4$ 414: 415: trapop: ;trap type 416: call setxpr ;set expression registers 417: mov (r4),-(sp) ;save the value 418: call exprg ;call external expression 419: bit #relflg!glbflg,(r3) ;absolute? 420: bne 1$ ; no 421: mov (r4),r0 ;value to merge 422: bit #^c377,r0 ;any high order bits? 423: bne 1$ ; yes, fall through 424: tst (sp)+ ;no, prune 425: return 426: 427: 1$: zap codrol ;clear code roll 428: bis #dflgbm,opclas ;flag as byte mode 429: call setimm ;set immediate mode 430: call stcode ;store address 431: mov #100000,(r3) ;set for absolute byte 432: swab (sp) 433: mov (sp)+,(r4) ;set origional value 434: call stcode 435: clr r0 436: return 437: .if ndf x45 438: 439: drgexp: ;double register expression 440: call regexp ;evaluate normal 441: mov #177774,r3 ;test for overflow 442: br maskr3 443: 444: splop: ;spl type 445: call absexp 446: mov #177770,r3 ;only three bits allowed 447: br maskr3 448: 449: .endc 450: .if ndf x45!x40 451: 452: sobop: ;sob operator 453: call brop ;free-load off branch operator 454: movb r0,r0 ;extend sign 455: neg r0 ;positive for backwards 456: br maskb6 ;mask to six bits 457: 458: markop: ;mark operator 459: call absexp ;evaluate absolute 460: maskb6: mov #177700,r3 ;set to mask high order 461: maskr3: bit r3,r0 ;overflow? 462: beq mark1 ; no 463: error 39,t,<low order byte only> ;yes, flag truncation error 464: bic r3,r0 ;clear excess 465: mark1: return 466: 467: .endc 468: ; address mode flags 469: 470: am.def = 10 ;deferred mode 471: am.inc = 20 ;auto-increment mode 472: am.dec = 40 ;auto-decrement mode 473: am.ndx = 60 ;index mode 474: am.pc = 07 ;pc mode addressing 475: am.imm = am.inc+am.pc ;immediate mode 476: am.rel = am.ndx+am.pc ;relative mode 477: 478: aexp: call savreg ;address expression evaluation 479: call setxpr ; and set "expression" type 480: inc expflg 481: clr -(sp) ;accumulate on top of stack 482: 2$: mov chrpnt,symbeg ;save in event of rescan 483: cmp r5,#ch.ind ;indirect? 484: bne 6$ ; no 485: call getnb ;yes, bypass it 486: tst (sp) ;"@", second time around? 487: beq 4$ ; no 488: error 40,q,<questionable expression syntax> 489: 4$: bis #am.def,(sp) ;set it 490: br 2$ 491: 492: 6$: cmp r5,#ch.hsh ;literal (#) 493: bne 10$ ; no 494: call getnb 495: .globl veritas 496: mov opclas,-(sp) ; <<< REEDS june 81: fixed harvard fp bug 497: swab (sp) ; <<< addf #10.3,r0 means: add 10.3 to fr0 498: bic #^c77,(sp) ; <<< 499: cmp #11.,(sp)+ ; <<< is this an FP instrction? 500: bne 7$ ; <<< 501: tst veritas ; see if user WANTS harvard fp bug 502: bne 7$ ; Yes: treat it as octal 503: call fltg1w ; <<< No, treat it as FP 504: bne 9$ ; <<< 505: 7$: ; <<< 506: call aexpxp ;evaluate expression 507: 9$: bis #am.imm,(sp) ;set bits 508: br aexp32 ;use common exit 509: 510: 10$: cmp r5,#ch.sub ;auto-decrement (-) 511: bne 12$ 512: call getnb 513: cmp r5,#ch.lp ;followed by "("? 514: bne aexp20 ; not a chance 515: call aexplp ;process parens 516: bis #am.dec,(sp) 517: br aexp36 518: 519: 12$: cmp r5,#ch.lp ; "(" 520: bne aexp22 521: call aexplp ;evaluate register 522: cmp r5,#ch.add ;auto-increment (+)? 523: bne 14$ ; no 524: call getnb ;yes, polish it off 525: bis #am.inc,(sp) ;set bits 526: br aexp36 527: 528: 14$: bit #am.def,(sp) ;indirect seen? 529: bne 16$ ; yes 530: bis #am.def,(sp) ;no, set bit 531: br aexp36 532: 533: 16$: clr (r3) ;mode 534: clr (r4) ; and value 535: br aexp30 536: aexp20: call setsym ;auto-dec failure, point to - 537: aexp22: call aexpxp ;get an expression 538: cmp r5,#ch.lp ;indexed? 539: beq 24$ ; yes 540: bit #regflg,(r3) ;flags 541: bne aexp36 542: .if ndf xedpic!xedama 543: tst (sp) 544: bne 23$ 545: .if ndf xedpic 546: bit #ed.pic,edmask 547: bne 1$ 548: bit #glbflg,(r3) 549: bne 2$ 550: cmpb (r2),clcsec 551: beq 23$ 552: br 2$ 553: 1$: 554: .endc 555: .if ndf xedama 556: bit #ed.ama,edmask ;absolute mode requested? 557: bne 23$ ; no 558: .endc 559: 2$: bis #am.imm!am.def,(sp) ;ok, set abs mode 560: br aexp32 561: .endc 562: 563: 23$: bis #am.rel,(sp) ;no 564: call setdsp ;set displacement 565: br aexp34 566: 567: 24$: bit #regflg,(r3) ;flags 568: beq 26$ 569: error 41,r,<illegal use of register> 570: bic #regflg,(r3) ;flags 571: 26$: mov (r1)+,-(sp) ;stack current value 572: mov (r1)+,-(sp) 573: mov (r1)+,-(sp) 574: mov (r1)+,-(sp) 575: call aexplp ;process index 576: mov (sp)+,-(r1) ;restore 577: mov (sp)+,-(r1) 578: mov (sp)+,-(r1) 579: mov (sp)+,-(r1) 580: aexp30: bis r0,(sp) 581: bis #am.ndx,(sp) 582: aexp32: call setimm 583: aexp34: call stcode 584: clr r0 585: aexp36: bis (sp)+,r0 586: return 587: aexplp: ;aexp paren processor 588: call getnb ;bypass paren 589: call regexp ;get a register expression 590: cmp r5,#ch.rp ;happy ending ")"? 591: bne 1$ ; no 592: jmp getnb ;yes, bypass and exit 593: 594: 1$: error 42,q,<missign right ')'> ;no 595: return 596: 597: .if ndf xedama 598: genedt ama ;absolute mode addressing 599: .endc 600: .if ndf xedpic 601: genedt pic ;pic mode 602: .endc 603: 604: aexpxp: call exprg ;evaluate potential external 605: bne aex1 ; branch if non-null 606: error 43,a,<missing expression> ;null, error 607: aex1: mov value,r0 ;set value 608: return 609: .sbttl directives 610: 611: 612: .if ndf xrel 613: 614: .globl globl 615: globl: ;global handler 616: globl1: call gsarg ;get a symbol 617: beq globl3 ; end 618: search symrol ;no, search user symbol table 619: bit #regflg,flags ;register? 620: bne 2$ ; yes, error 621: .iif df rsx11d, bic #dfgflg,flags 622: bis #glbflg,flags ;no, flag as globl 623: call insert ;update/insert 624: call crfdef 625: br globl1 626: 627: 2$: error 44,r,<illegal register usage> 628: br globl1 629: 630: globl3: return 631: .endc 632: 633: 634: .globl end 635: 636: end: ;temp end directive 637: call expr ;evaluate the expression 638: bne 1$ ; branch if non-null 639: inc (r4) ;null, make it a one 640: 1$: call reltst ;no globals allowed 641: inc endflg 642: call setsec 643: call setpf1 ;list field 1 644: mov #symbol,r1 645: mov #endvec,r2 646: xmit 4 ;move to end vector 647: return 648: 649: 650: entsec impure 651: endvec: .blkw 4 ;end vector storage 652: 653: xitsec 654: .if ndf xrel 655: 656: .globl asect, csect 657: 658: asect: 659: call setmax ;clean up current sector 660: asectf: 661: mov r50abs,symbol ;set ". abs." 662: mov r50abs+2,symbol+2 663: mov asdflt,r3 664: br csectf ;use common exit 665: 666: csect: 667: call setmax ;clean up current sector 668: mov psdflt,r3 ; unnamed .csect = unnamed .psect 669: call tstarg ;get argument (or null) 670: beq 1$ 671: mov csdflt,r3 ; well, its got a name so it really is a csect 672: 1$: call getsym 673: csectf: scan secrol ;scan for match 674: bne psectf ; branch if match 675: movb r3,mode 676: movb <^pl rolsiz>+1+secrol,sector 677: br psectf 678: .globl psect 679: 680: psect: 681: call setmax 682: call tstarg 683: beq 10$ 684: tst veritas 685: beq 10$ 686: mov csdflt,silly ; user wants funny Harvard modes for 687: ; named .psects 688: br 11$ 689: 10$: mov psdflt,silly ; no -ha flag or blank .psect 690: 11$: inc argcnt 691: call getsym 692: scan secrol 693: bne 1$ 694: movb silly,mode 695: movb <^pl rolsiz>+1+secrol,sector 696: 1$: mov #clcnam,r3 697: .rept 5 698: mov -(r3),-(sp) 699: .endr 700: 2$: call tstarg 701: beq 3$ 702: call getsym 703: scanw psarol 704: beq psecta 705: mov #symbol+2,r0 706: bisb (r0),4(sp) 707: bicb 1(r0),4(sp) 708: br 2$ 709: 3$: 710: mov (sp)+,(r3)+ 711: mov (sp)+,(r3)+ 712: scan secrol 713: mov (sp)+,(r3)+ 714: mov (sp)+,(r3)+ 715: mov (sp)+,(r3)+ 716: psectf: call insert 717: call crfref 718: mov #symbol,r1 719: mov #clcnam,r2 720: .globl xmit5 721: xmit 5 722: jmp lsbset 723: psecta: add #12,sp ; compensate for the big push 724: error 45,a,<illegal .psect attribute> 725: psect9: return 726: 727: .bss 728: silly: .blkw 1 729: 730: .data 731: 732: .macro genpsa mne,set,reset 733: .rad50 /mne/ 734: .byte set,reset 735: .endm 736: 737: entsec psasec 738: genpsa rel, relflg, 739: genpsa abs, , relflg 740: genpsa gbl, glbflg, 741: genpsa lcl, , glbflg 742: genpsa ovr, ovrflg, 743: genpsa con, , ovrflg 744: genpsa low, , ; these do nothing. they 745: genpsa hgh, , ; exist for backwards compat. 746: .if gt ft.unx 747: genpsa shr, shrflg, bssflg 748: genpsa prv, , shrflg!bssflg 749: genpsa bss, bssflg, shrflg!insflg 750: genpsa ins, insflg, bssflg 751: genpsa dat, , insflg!bssflg 752: genpsa b, bssflg, shrflg!insflg 753: genpsa i, insflg, bssflg 754: genpsa d, , insflg!bssflg 755: genpsa ro, shrflg, bssflg 756: genpsa rw, , shrflg!bssflg 757: .endc 758: 759: xitsec 760: 761: .data 762: psdflt: .word pattrs ; the default values are defined in at.sml 763: asdflt:: .word aattrs 764: csdflt:: .word cattrs 765: xitsec 766: 767: xitsec 768: 769: .endc ;xrel 770: absset: 771: tst exmflg 772: beq secini 773: tstb clcsec 774: bmi psect9 775: secini: 776: call asectf ;move onto roll 777: clr symbol ;ditto for blank csect 778: clr symbol+2 779: mov psdflt,r3 780: bit #ed.abs,edmask ;abs mode? 781: beq 1$ 782: jmp csectf ; not abs mode. 783: 1$: 784: return 785: 786: genedt abs,absset 787: 788: 789: 790: .data 791: 792: r50abs: .rad50 /. abs./ 793: 794: xitsec 795: .if ndf xrel 796: 797: setmax: ;set max and enter onto roll 798: call savreg ;play it safe 799: mov #clcnam,r1 800: mov #symbol,r2 801: xmit 2 ;move name to symbol 802: scan secrol ;scan sector roll 803: xmit 3 ;set remainder of entries 804: jmp insert ;update roll and exit 805: 806: .endc 807: .globl blkw, blkb, even, odd, radix, eot 808: 809: 810: blkw: inc r3 ;flag word type 811: blkb: call expr ;evaluate the expression 812: bne 1$ ;branch if non-null 813: inc (r4) ;null, make it one 814: 1$: call abstst ;must be absolute 815: 2$: add r0,(r2) ;update pc 816: asr r3 ;word? 817: bcs 2$ ; yes, double value 818: return 819: 820: even: inc (r2) ;increment the pc 821: bic #1,(r2) ;clear if no carry 822: return 823: 824: odd: bis #1,(r2) ;set low order pc byte 825: eot: return 826: 827: radix: mov cradix,r2 ;save in case of failure 828: mov #10.,cradix 829: call absexp 830: cmp r0,#2. 831: blt 1$ 832: cmp r0,#10. 833: ble rad2$ 834: 1$: error 46,a,<illegal radix> 835: mov r2,r0 836: rad2$: mov r0,cradix 837: jmp setpf1 838: 839: entsec imppas ;impure area 840: cradix: .blkw ;current radix 841: 842: xitsec ;back to normal 843: 844: 845: .sbttl data-generating directives 846: 847: .globl byte, word 848: 849: 850: word: inc r3 ;"word" directive, set to 2 851: byte: 852: inc r3 ;"byte" directive, set to 1 853: mov (r2),-(sp) ;stack current pc 854: 1$: call tstarg ;test for argument 855: bne 3$ ; good arg 856: cmp (r2),(sp) ;end, any processed? 857: bne 2$ ; yes, exit 858: 3$: call exprg ;process general expression 859: call setimm ;convert to object format 860: call stcode ;put on code roll 861: add r3,(r2) ;update pc 862: br 1$ ;test for more 863: 864: 2$: mov (sp)+,(r2) ;restore initial pc 865: return 866: .globl rad50, ascii, asciz 867: 868: 869: asciz: inc r3 ; ".asciz", set to 1 870: ascii: inc r3 ; ".ascii", set to 0 871: rad50: 872: dec r3 ; ".rad50", set to -1 873: call 23$ ;init regs 874: 1$: mov r5,r2 ;set terminator 875: beq 8$ ;error if eol 876: 2$: cmp r5,#ch.lab ; "<", expression? 877: beq 10$ ; yes 878: 3$: call getchr ;no, get next char 879: mov r5,r0 ;set in work register 880: beq 8$ ;error if eol 881: cmp r5,r2 ;terminator? 882: beq 5$ ; yes 883: tst r3 ;no 884: bmi 9$ ;branch if rad50 885: .if ndf xedlc 886: mov chrpnt,r0 ;fake for ovlay pic 887: movb (r0),r0 ;fetch possible lower case 888: bic #177600,r0 ;clear possible sign bit 889: .endc 890: br 4$ 891: 892: 9$: call tstr50 ;test radix 50 893: 4$: call 20$ ;process the item 894: br 3$ ;back for another 895: 896: 5$: call getnb ;bypass terminator 897: 6$: tstb cttbl(r5) ;eol or comment? 898: bgt 1$ ; no 899: br 7$ 900: 901: 8$: error 47,a,<premature end of line> ;error, flag and exit 902: 7$: clr r0 ;yes, prepare to clean up 903: tst r3 ;test mode 904: beq 24$ ;normal exit if .ascii 905: bpl 20$ ;one zero byte if .asciz 906: tst r1 ;.rad50, anything in progress? 907: beq 24$ 908: call 20$ ;yes, process 909: br 6$ ;loop until word completed 910: 911: 10$: mov (r4),-(sp) ;"<expression>", save partial 912: call abstrm ;absolute term, setting r0 913: mov (sp)+,(r4) ;restore partial 914: call 20$ ;process byte 915: br 6$ ;test for end 916: 20$: tst r3 ;rad50? 917: bpl 22$ ; no 918: cmp r0,#50 ;yes, within range? 919: blo 21$ ; yes 920: error 48,t,<illegal rad50 character> ;no, error 921: 21$: mov r0,-(sp) ;save current char 922: mov (r4),r0 ;get partial 923: call mulr50 ;multiply 924: add (sp)+,r0 ;add in current 925: mov r0,(r4) ;save 926: inc r1 ;bump count 927: cmp r1,#3 ;word complete? 928: bne 24$ ; no 929: 22$: mov r0,(r4) ;stuff in value 930: call setimm ;convert to obj mode 931: call stcode ;stow it 932: 23$: clr r1 ;clear loop count 933: clr (r4) ; and value 934: 24$: return 935: .sbttl enabl/dsabl functions 936: 937: 938: 939: .globl enabl, dsabl, bisbic 940: 941: dsabl: com r3 ;r3=-1 942: enabl: ;r3=0 943: 1$: call gsarg ;get a symbolic argument 944: beq endabl ;end if null 945: scanw edtrol ;search the table 946: beq 7$ ; not there, error 947: mov symbol+4,r2 ;get proper bit 948: tst exmflg ;called from command string? 949: beq 3$ ; no 950: bisbic eddflt ; yes. set default bits 951: bis r2,edmcsi ; and set disable bits 952: br 4$ ; and bypass test 953: 954: 3$: bic edmcsi,r2 ;over-ridden from csi? 955: 4$: bisbic edmask ;set appropriate bits 956: mov symbol+2,-(sp) ;make it pic 957: tst r3 ;set flags 958: call @(sp)+ ;call routine 959: br 1$ 960: 961: 7$: error 49,a,<illegal .enabl/.dsabl argument> 962: endabl: return 963: 964: bisbic: ; address of arg on stack 965: ; if r3 < 0, set bits of r2 into arg 966: ; else clear them 967: ; this meshes with .list & .enabl: 968: ; .list r3 = 1 969: ; .nlist r3 = -1 970: ; .enabl r3 = 0 971: ; .dsabl r3 = -1 972: tst r3 973: blt 1$ 974: bic r2,@2(sp) 975: br 2$ 976: 1$: bis r2,@2(sp) 977: 2$: rts pc 978: entsec impure 979: edmask: .blkw ;contains set flags 980: edmcsi: .blkw ;bits for csi override 981: xitsec 982: 983: entsec mixed 984: 985: eddflt::.word ^c<ed.pnc+ed.reg+ed.lc+ed.gbl> ;default values for edmask 986: ; bit 1 ==> .dsabl 987: ; bit 0 ==> .enabl 988: ;^c<ed.pnc+ed.lc> = non rsx11d choice 989: xitsec 990: seted: 991: mov eddflt,edmask 992: ;clr edmcsi experiment 993: return 994: 995: 996: genswt en,enabl ;generate /en 997: genswt ds,dsabl ; and /ds switch table entries 998: 999: tmpcnt= 1 1000: .irp x,<abs,ama,cdr,fpt,gbl,lc ,lsb,pic,pnc,reg,crf> 1001: .globl ed.'x 1002: ed.'x = tmpcnt 1003: tmpcnt=tmpcnt+tmpcnt 1004: .endm 1005: gsarg: ;get a symbolic argument 1006: .enabl lsb 1007: call tstarg ;test general 1008: beq gsa.2$ ; exit null 1009: gsargf: call getsym ;arg, try for symbol 1010: bne 5$ ; error if not symbol 1011: error 59,a,<unknown symbol> 1012: br gsa.2$ 1013: 5$: cmp r0,r50dot ; "."? 1014: bne 3$ ; no, ok 1015: 1$: error 50,a,<illegal use of '.'> 1016: gsa.2$: clr symbol 1017: clr symbol+2 1018: clr r0 ;treat all errors as null 1019: 3$: return 1020: .dsabl lsb 1021: 1022: 1023: tstarg: ;test argument 1024: 1$: movb cttbl(r5),r0 ;get characteristics 1025: ble 12$ ;through if eol or semi-colon 1026: tst argcnt ;first argument? 1027: beq 11$ ; yes, good as is 1028: bit #ct.com,r0 ;no, comma? 1029: bne 10$ ; yes, bypass it 1030: tst expflg ;no, was one required? 1031: beq 2$ ; no 1032: error 51,a,<comma required> 1033: 2$: cmp chrpnt,argpnt ;did anybody use anything? 1034: bne 11$ ; yes, ok 1035: 3$: call getchr ;no, bypass to avoid loops 1036: bitb #ct.pc+ct.sp+ct.tab-ct.com-ct.smc,cttbl(r5) 1037: bne 3$ ; yes, bypass 1038: call setnb ;no, set to non-blank 1039: error 52,a,<separator required> 1040: br 1$ ;now try again 1041: 1042: 10$: call getnb ;bypass comma 1043: 11$: inc argcnt ;increment argument count 1044: 12$: clr expflg 1045: mov chrpnt,argpnt ;save pointer 1046: bic #177600,r0 ;set flags 1047: return 1048: 1049: 1050: entsec implin ;clear each line 1051: argcnt: .blkw ;argument count 1052: argpnt: .blkw ;start of last argument 1053: expflg: .blkw ;set when comma required 1054: 1055: .data 1056: r50dot: .rad50 /. / 1057: 1058: xitsec 1059: .end
|
Last modified: 1982-12-11
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1990 |
|