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

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