1: .title expr - expression evaluator 2: 3: .ident /16jan4/ 4: 5: .mcall (at)always,st.flg,ch.mne,xmit,genedt 6: .mcall (at)sdebug 7: .mcall (at)jne,jeq 8: always 9: st.flg 10: ch.mne 11: .mcall (at)setnz,error,search 12: 13: .globl abserr, absexp, abstrm, abstst, expr 14: .globl exprg, relexp, reltst 15: 16: 17: .if df rsx11d 18: .globl ed.gbl, edmask, cpopj 19: .endc 20: 21: .globl chrpnt, clcnam, clcsec, cradix, mode 22: .globl cvtnum, dmprld, expflg, flags, lsrch 23: .globl getchr, getnb, getsym, insert 24: .globl pass, rellvl, rolndx, r50dot, savreg 25: .globl setnb, setrld, setsec, setsym, setxpr 26: .globl symbeg, symbol, symrol, pstrol, value 27: .globl secrol, objsec 28: 29: .globl crfref 30: .if ndf oldcod 31: cc.opr= 040 32: cc.nam= 020 33: cc.sec= 010 34: cc.val= 004 35: cc.dsp= 002 36: .endc 37: 38: 39: .macro chscan table ;character scan 40: mov #table,r0 41: call chscan 42: .endm 43: 44: .macro gchtbl char, addr ;gen char scan table 45: .word addr, char 46: .endm 47: xitsec ;start in default sector 48: 49: exprg: ;external expression 50: .if ndf oldcod 51: decb oprflg+1 ;flag "ok for external expression" 52: call expr ;process 53: incb oprflg+1 ;restore 54: tst r0 ;reset r0 flags 55: return 56: .endc 57: 58: expr: ;expression evaluation 59: call savreg ;save registers 60: call term ;try for a term 61: beq 5$ ;exit if null 62: clr -(sp) ;non-null, set register flag storage 63: 1$: call setxpr ;set expression registers 64: bis (r3),(sp) ;save register flag 65: chscan boptbl ;scan the binary operator table 66: beq 2$ ; branch if not found 67: call 10$ ;found, call handler 68: br 1$ ;test for more 69: 70: 2$: bic #-1-regflg,(sp) ;mask all but register flag 71: beq 6$ ;branch if not register 72: bit #177770,(r4) ;in bounds? 73: beq 6$ 74: error 70,r,<pdp-11 only has 8 registers> 75: br 77$ 76: 6$: asr rellvl ;test relocaton level 77: bne 3$ ;branch if not 0 or 1 78: bcc 4$ ;branch if 0 79: tst (sp) ;relocatable, test register flag 80: beq 4$ ;branch if not set 81: 7$: error 1,r,<cannot relocate a register> 82: 77$: clr (sp) ;clear register bit 83: br 4$ 84: 85: 3$: error 2,a,<improper relocation> 86: 4$: bis (sp)+,(r3) ;merge register bit 87: setnz r0 ;set true 88: 5$: return 89: 10$: 90: mov r0,-(sp) ;stack operator address 91: mov r1,r3 ;leave pointer to "symbol" in r3 92: mov (r1)+,-(sp) ;stack symbol 93: mov (r1)+,-(sp) 94: mov (r1)+,-(sp) ; mode, 95: mov (r1)+,-(sp) ; value, 96: mov (r1)+,-(sp) ; and rel level 97: call glbtrm ;evaluate next tern 98: mov #expbak+^d10,r1 ;set to unstack previous 99: mov (sp)+,-(r1) ;rel level 100: mov (sp)+,-(r1) ;value 101: mov r1,r2 ;r2 points to previous value 102: mov (sp)+,-(r1) ;mode 103: mov (sp)+,-(r1) 104: mov (sp)+,-(r1) ;r1 points to previous symbol 105: .if ndf oldcod 106: tst oprflg 107: bpl 11$ 108: tst pass 109: beq 11$ 110: bit #glbflg!relflg,mode 111: bne expxxx 112: bit #glbflg!relflg,expbak+4 113: bne expxxx 114: 11$: 115: .endc 116: mov @(sp)+,-(sp) 117: asr (sp) ;absolute only? 118: bcs 12$ ; no 119: bis -(r2),-(r4) ;yes, merge flags 120: call abstst ;test for absolute 121: cmp (r2)+,(r4)+ ;restore registers 122: 12$: asl (sp) ;even out address 123: jmp @(sp)+ ;exit through handler 124: .if ndf oldcod 125: expxxx: inc oprflg 126: mov #200,r0 127: mov #expbak,r1 128: call expyyy 129: mov (sp)+,r0 130: sub #boptbl,r0 131: asr r0 132: asr r0 133: add #201,r0 134: mov #symbol,r1 135: call expyyy 136: mov #symbol,r1 137: clr (r1)+ 138: movb oprflg,(r1)+ 139: clrb (r1)+ 140: mov #glbflg,(r1)+ 141: clr (r1)+ 142: return 143: 144: expyyy: mov r0,-(sp) 145: call setrld 146: mov r2,-(sp) 147: movb #cc.opr,(r2)+ 148: clr -(sp) 149: bit #glbflg!relflg,4(r1) 150: beq 2$ 151: bit #glbflg,4(r1) 152: bne 1$ 153: mov #cc.sec,(sp) 154: cmpb 5(r1),objsec 155: beq 2$ 156: 1$: bis #cc.nam,(sp) 157: .rept 4 158: movb (r1)+,(r2)+ 159: .endm 160: cmp -(r1),-(r1) 161: 2$: add #6,r1 162: tst (r1) 163: beq 3$ 164: bis #cc.val,(sp) 165: movb (r1)+,(r2)+ 166: movb (r1)+,(r2)+ 167: 3$: bisb (sp)+,@(sp)+ 168: movb (sp)+,(r2)+ 169: movb oprflg,(r2)+ 170: jmp dmprld 171: 172: entsec implin 173: oprflg: .blkw 174: xitsec 175: .endc 176: 177: entsec impure 178: expbak: .blkw 5 ;previous term storage 179: xitsec 180: entsec dpure 181: boptbl: ;binary op table 182: gchtbl ch.add, bopadd+1 ; "+" 183: gchtbl ch.sub, bopsub+1 ; "-" 184: gchtbl ch.mul, bopmul ; "*" 185: gchtbl ch.div, bopdiv ; "/" 186: gchtbl ch.and, bopand ; "&" 187: gchtbl ch.ior, bopior ; "!" 188: .word 0 189: xitsec 190: 191: bopsub: call reltst ;make sure no globals 192: neg (r4) ; -, negate value 193: neg rellvl ; and rellvl 194: 195: bopadd: add (r2)+,(r4)+ ; +, add values 196: add (r2),(r4) ; and relocation levels 197: cmp -(r2),-(r4) ;point back to values 198: bit #glbflg!relflg,-(r2) ;abs * xxx? 199: beq 3$ ; yes, all set 200: bit #glbflg!relflg,-(r4) ;xxx * abs? 201: beq 4$ ; yes, old flags 202: bitb #glbflg,(r2)+ ;error if either global 203: bne 5$ 204: bitb #glbflg,(r4)+ 205: bne 5$ 206: cmpb (r4),(r2) ;rel +- rel, same sector? 207: bne 5$ ; no, error 208: bisb #relflg,-(r4) 209: tst rellvl 210: bne 3$ 211: bic #177400!relflg,(r4) 212: 3$: return 213: 214: 4$: mov (r1)+,(r3)+ 215: mov (r1)+,(r3)+ 216: bis (r1)+,(r3)+ 217: return 218: 219: 5$: jmp abserr 220: 221: 222: bopand: com (r2) 223: bic (r2),(r4) 224: return 225: 226: bopior: bis (r2),(r4) 227: return 228: bopmul: ; * 229: mov (r2),r0 ;fetch first arg 230: mov r0,-(sp) ;save a copy 231: bpl 1$ ;positive? 232: neg r0 ; no, make it so 233: 1$: mov (r4),r3 ;set second arg 234: bpl 2$ ;branch if positive 235: neg r3 ;negative, make it + 236: com (sp) ;toggle result sign 237: 2$: mul r3,r0 ;multiply 238: mov r1,r0 ;set for exit 239: br bopdvx ;exit through divide 240: 241: bopdiv: ; / 242: mov (r4),r3 ;set divisor 243: mov r3,-(sp) ;save a copy 244: bpl 1$ ;branch if plus 245: neg r3 ;make it thus 246: 1$: mov (r2),r1 ;set quotient 247: bpl 2$ ;again!!! 248: neg r1 249: com (sp) 250: 2$: clr r0 ;operate 251: div r3,r0 252: 253: bopdvx: tst (sp)+ ;test result 254: bpl 1$ ; ok as is 255: neg r0 ;no, negate it 256: 1$: mov r0,(r4) ;set result 257: return 258: 259: ;special entry point to expr 260: ;null field causes error 261: ;r0 set to value 262: 263: glbtrm: call term 264: beq abserr 265: br abserx 266: 267: glbexp: ;non-null expression 268: call expr 269: beq abserr 270: br abserx 271: 272: reltrm: call glbtrm 273: br reltst 274: 275: relexp: 276: call glbexp 277: reltst: bit #glbflg,flags 278: beq abserx 279: br abserr 280: 281: abstrm: call glbtrm 282: br abstst 283: 284: absexp: 285: call glbexp 286: abstst: bit #glbflg!relflg,flags 287: beq abserx 288: abserr: clr mode 289: clr rellvl 290: abserf: error 3,a,<bad expression> 291: abserx: mov value,r0 ;return with value in r0 292: return 293: .sbttl term evaluator 294: 295: term: ;term evaluator 296: call savreg ;save registers 297: call setxpr ; and set "expression" type 298: clr (r3) ;clear mode 299: clr (r4) ; and value 300: call term10 ;process 301: bic #defflg!lblflg!mdfflg,(r3) ;clear extraneous 302: clr rellvl ;assume absolute 303: bit #relflg,(r3) ;true? 304: beq 1$ 305: inc rellvl ; no, relocatable 306: 1$: inc expflg ;mark as expression 307: jmp setnb ;exit with non-blank and r0 set 308: 309: term10: call getsym ;try for a symbol 310: jeq term20 ;branch if not a symbol 311: .if ndf xcref 312: mov #symrol,rolndx 313: call crfref 314: .endc 315: cmp symbol,r50dot ;location counter? 316: beq 14$ ; yes, treat special 317: search symrol ;search the symbol table 318: beq 16$ ;branch if not found 319: bit #mdfflg,(r3) ;multiply defined? 320: beq 11$ ; no 321: error 5,m,<multiply defined> 322: 11$: bit #defflg,(r3) ;defined? 323: beq 13$ ; no 324: call setsec ;refer by sector name 325: br 12$ 326: 327: 13$: bit #glbflg,(r3) ;no, global? 328: jne term28 ; yes 329: error 4,u,<undefined symbol> 330: sdebug <undef 1> 331: 12$: bic #glbflg,(r3) ;clear internal global flag 332: jmp term28 333: 334: 14$: mov #clcnam,r1 ;dot, move to working area 335: mov #symbol,r2 336: xmit 4 337: bicb #^c<relflg>,(r3) ;clear all but rel flag 338: jmp term28 339: 340: 16$: search pstrol ;not user defined, perhaps an op-code? 341: tst (r3) ;op code? 342: bmi 17$ ;yes 343: search symrol ;set search pointers 344: .if df rsx11d 345: bis #dfgflg!glbflg,(r3) 346: bit #ed.gbl,edmask 347: beq 20$ 348: bic #dfgflg!glbflg,(r3) 349: .endc 350: error 4,u,<undefined symbol> 351: sdebug <undef 2> 352: 20$: call insert ;not in table, insert as undefined 353: 17$: clr (r3) ;be sure mode is zero 354: jmp term28 355: 356: .iif df rsx11d, genedt gbl 357: 358: term20: 359: mov cradix,r2 ;assume number, current radix 360: 21$: mov chrpnt,symbeg ;in case of re-scan 361: call cvtnum ;convert 362: beq term30 ; nope, missed again 363: bpl 22$ ;number, any overflow? 364: error 7,t,<number too big> 365: 22$: cmp r5,#ch.dot ;number, decimal? 366: beq 24$ ; yes 367: .if ndf xedlsb 368: cmp r5,#ch.dol ;no, local symbol? 369: beq 24$ ; yes 370: .endc 371: tstb r0 ;no, any numbers out of range? 372: jeq term28 ; no 373: error 6,n,<digit illegal in current radix> 374: br 23$ 375: 376: 24$: cmp r2,#10. ;"." or "$", were we decimal? 377: beq 25$ ; yes 378: 23$: call setsym ;no, 379: mov #10.,r2 ; try again with decimal radix 380: br 21$ 381: 382: 25$: cmp r5,#ch.dot ;decimal? 383: beq term27 ; yes 384: .if ndf xedlsb 385: call lsrch ;no, local symbol 386: bne term27 ;branch if found 387: .endc 388: term26: error 8,u,<local symbol not defined> ; no, flag as undefined 389: term27: call getchr ;bypass dot or dollar 390: term28: call setnb ;return pointing to non-blank 391: setnz r0 ;flag as found 392: term29: return 393: term30: 394: chscan uoptbl ;scan unary operator table 395: beq term29 ; not there 396: clr r2 ;clear for future use 397: call @(r0)+ ;found, go and process 398: jmp term28 ;exit true 399: 400: 401: entsec dpure 402: uoptbl: 403: gchtbl ch.add, glbtrm ; "+" 404: gchtbl ch.sub, term42 ; "-" 405: gchtbl ch.qtm, term44 ; """ 406: gchtbl ch.xcl, term45 ; "'" 407: gchtbl ch.pct, term46 ; "%" 408: gchtbl ch.lab, term47 ; "<" 409: gchtbl ch.uar, term50 ; "^" 410: .word 0 411: xitsec 412: 413: term42: call abstrm ;evaluate absolute 414: neg (r4) ;negate value 415: return 416: 417: term44: inc r2 ; """, mark it 418: term45: mov r4,r1 ; "'", set temp store register 419: call setsym ;point back to operator 420: 1$: call getchr ;get the next character 421: beq term48 ;error if eol 422: .if ndf xedlc 423: movb @chrpnt,(r1) ;store absolute char 424: bicb #200,(r1)+ ;clear possible sign bit and index 425: .iff 426: movb r5,(r1)+ 427: .endc 428: dec r2 ;another character 429: beq 1$ ; yes 430: br term27 ;bypass last char 431: 432: term46: call abstrm ;register expression 433: bis #regflg,(r3) ;flag it 434: return 435: 436: term47: ; "<" 437: call glbexp ;process non-null expression 438: cmp r5,#ch.rab ;">"? 439: beq term27 ; yes, bypass and exit 440: term48: jmp abserf ;error, flag it 441: term50: ; "^" 442: chscan uartbl ;scan on next character 443: beq term48 ; invalid, error 444: jmp @(r0)+ ;call routine 445: 446: entsec dpure 447: uartbl: ;up arrow table 448: gchtbl let.c, term51 ; ^c 449: gchtbl let.d, term52 ; ^d 450: gchtbl let.o, term53 ; ^o 451: gchtbl let.b term54 ; ^b 452: gchtbl let.r, trmr50 ; ^r 453: .if ndf xfltg 454: gchtbl let.f, term55 ; ^f 455: .endc 456: .if ndf oldcod 457: gchtbl let.p, term56 ; ^p 458: .endc 459: .word 0 460: xitsec 461: 462: term51: call abstrm ;process absolute 463: com (r4) ;complement value 464: return 465: 466: term52: add #2.,r2 467: term53: add #6.,r2 468: term54: add #2.,r2 469: mov cradix,-(sp) ;stack current radix 470: mov r2,cradix ;replace with local 471: call glbtrm ;evaluate term 472: mov (sp)+,cradix ;restore radix 473: return 474: 475: .globl setr50,mulr50 476: r50gch: call getchr ;get next character 477: cmp r2,#3 ;filled word? 478: beq r50xit ; yes 479: trmr50: call setr50 ;test radix 50 480: call r50prc ;process the character 481: bcc r50gch ;if cc no terminator seen 482: 483: 1$: cmp r2,#3 ;filled word? 484: beq r50xit ; yes 485: clr r0 ; no - pad with blanks 486: call r50prc 487: br 1$ 488: 489: r50xit: return ;done with argument 490: 491: r50prc: cmp r0,#50 ;rad50? 492: bhis 1$ ; no 493: mov r0,-(sp) ;save current char 494: mov (r4),r0 ;get partial 495: call mulr50 ;multiply 496: add (sp)+,r0 ;add in current 497: mov r0,(r4) ;save 498: inc r2 ;bump count 499: clc ;no terminator seen 500: return 501: 502: 1$: sec ;terminator seen 503: return 504: 505: .if ndf xfltg 506: .globl fltg1w 507: term55: call fltg1w ;process one word floating 508: beq term48 ;error if null 509: return 510: .endc 511: .if ndf oldcod 512: term56: ; ^p 513: call mk.upp ;make upper case 514: cmp r5,#'l&^c40 ;low limit? 515: beq 1$ ; yes 516: cmp r5,#'h&^c40 ; high? 517: bne term48 ; no, error 518: inc r2 ;yes, reflect high 519: 1$: add #3,r2 ;make 3 or 4 520: mov r2,-(sp) ;save operator 521: call setrld ;set up rld 522: movb #cc.opr,(r2)+ ;flag operator 523: movb (sp)+,(r2)+ ;unary type 524: call getnb ;bypass char 525: call getsym ;get the argument 526: mov #secrol,rolndx 527: call crfref ;cref into proper roll 528: mov #symbol,r1 529: .rept 4 ;move into code buffer 530: movb (r1)+,(r2)+ 531: .endm 532: inc oprflg ;get unique number 533: movb oprflg,(r2)+ ;stuff it 534: call dmprld ;dump it 535: mov #symbol,r1 536: clr (r1)+ ;symbol is zero 537: movb oprflg,(r1)+ ; followed by unique numbwr 538: clrb (r1)+ 539: mov #glbflg,(r1)+ 540: clr (r1)+ 541: return 542: 543: .endc 544: chscan: ;character scan routine 545: call mk.upp ;make char. upper-case 546: 1$: tst (r0)+ ;end (zero)? 547: beq 2$ ; yes 548: cmp (r0)+,r5 ;this the one? 549: bne 1$ ; no 550: tst -(r0) ;yes, move pointer back 551: mov chrpnt,symbeg ;save current pointer 552: call getnb ;get next non-blank 553: tst -(r0) ;move addr or zero into r0 554: return 555: 556: 2$: clr r0 557: return 558: 559: 560: mk.upp: cmp r5,#141 ; between a - z ? 561: blt 1$ ;no 562: cmp r5,#172 563: bgt 1$ ;no 564: sub #40,r5 ;yes, make it upper-case 565: 1$: return 566: 567: .end
|
Last modified: 1982-12-11
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1758 |
|