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

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