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: 1835
Valid CSS Valid XHTML 1.0 Strict