1: ; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System
   2: ; Science Center, Harvard University
   3: .page
   4: 
   5: 
   6:         .title  lexer and printr and evaler
   7:                         ;forrest w. howard, jr
   8:                         ;center for research in computing technology
   9:                         ;aiken computation lab.
  10:                         ;cambridge, ma. 02138
  11: 
  12:         ;code for the print routine
  13:         ;code for lexer
  14:         ;code for strat
  15:         ;code for make
  16: 
  17: 
  18: ;if the onepage option of sparm.m11 is on, and this is
  19: ;a data-space only lisp, then we want to arrange for this
  20: ;entire set of code (and possibly shrdata) to be in
  21: ;private data space.  we have to round its length up
  22: ;to a multiple of 400(8) bytes, so that all else will
  23: ;fit in smoothly
  24: 
  25: ;if this is i&d, we ignore this stuff
  26: 
  27: .macro  .sharable
  28: 
  29:         .rsect  shrcode,con
  30: 
  31: .endm
  32: 
  33:         ;we will redefine this macro if necessary
  34: 
  35: .if     eq,multiseg
  36:  .if    ne,onepage
  37: 
  38:         .macro  .sharable
  39: 
  40:                 .rsect  onepage,con
  41:         .endm
  42:  .endc
  43: .endc
  44: 
  45: 
  46: 
  47:         .sharable
  48:         .enabl  lsb
  49: 
  50: printr: propush a
  51:         call 71$                ;this is the entry to the output routine
  52:         tst     (sp)+
  53:         retnil          ;print returns nil
  54: 
  55: 
  56: 
  57: 
  58: 71$:    tstb    intflg          ;bothered by ^c???
  59:         beq     100$            ;no, skip around
  60:         push    a
  61:         error   </^c received during print out/>,99$
  62: 99$:    pop     a               ;get a back
  63: 100$:   dispatch                ;branch according to what we have
  64:         jmp     numout          ;print the number
  65:         br      4$              ;print the list/s-expr
  66:         .word   0
  67:         jmp     atmout          ;print the atom(double quoted)
  68:         jmp     bcdout          ;print the symbol for bcd
  69:         jmp     portout         ;print the symbol for port
  70: 
  71: 
  72: 
  73: 
  74: 4$:     outstr  slp             ;output a  left-paren
  75: 73$:    cdr     a,-(sp)         ;save the rest of the list
  76:         car     a,a             ;get the car
  77:         call    71$             ;print the car
  78:         pop     a               ;get the cdr back
  79:         jmpifnil        a,22$,nl
  80:         outstr  sspc
  81:         dispatch                ;branch on what the cdr is
  82:         br       2$             ;if number, then need dot
  83:         .word   0
  84:         br       73$            ;for dtpr, continue on list
  85:         .word   0
  86:         br       21$            ;for atom, see if nil and then print dot
  87:                                 ; if necessary
  88:         .word   0
  89:         br       2$             ;for bcd
  90:         .word   0
  91:         br       2$             ;for port
  92: 
  93: 
  94: 
  95: 
  96: 
  97: 21$:
  98: 2$:     outstr  spersda         ;print  ". "
  99:         call    71$             ;print the thing
 100: 22$:    outstr  srp             ;output a  ")"
 101:         ret                     ;go back
 102: 
 103: 
 104: 
 105: 
 106:         .dsabl  lsb
 107: 
 108: 
 109: 
 110:         .sharable
 111: 
 112: ;ratomr		leaves result in a
 113:                 ;mungs b,j1-j3
 114: 
 115: 
 116: ratomr:
 117: seploop:        getca                   ;leaves next char on port in char and a
 118:         movb    ctable(a),j3            ;lets branch on bits 2-6 of byte
 119:         bic     #177601,j3
 120:         jmp     seploop(j3)
 121: 
 122: 
 123: 
 124: 
 125: rperd:  mov     #perda,a
 126:         ret
 127: rlpara: mov     #lpara,a                ;all these return the token
 128:         ret
 129: rrpara: mov     #rpara,a
 130:         ret
 131: rlbkta: mov     #lbkta,a
 132:         ret
 133: rrbkta: mov     #rbkta,a
 134:         ret
 135: reof:   mov     #aeof,a
 136:         ret
 137: rnum:   br      ratnum                  ;note that the range of 5 bits is not
 138: rerr:   br      bcerror                 ; enough to
 139: 
 140: rdq:    br      ratdq
 141: ratm:   br      ratatm
 142: 
 143: 
 144: rsqc:   mov     #asquote,a
 145:         ret
 146: 
 147: ratnum: mov     #strbuf,b               ;accept a number, and pass
 148:                                         ; it to strnum
 149:         movb    a,(b)+                  ;stash char
 150:         cmpb    a,#'-                   ;is it minus
 151:         bne     20$                     ;no, so no problems
 152:         mov     a,j2                    ;set up hash code
 153:         getca                           ;get next char
 154:         cmpb    a,#'-                   ;is it -- ???
 155:         beq     ratent                  ;-- is an atom
 156:         cmpb    ctable(a),#vnum         ;is next char number??
 157:         bne     ratent                  ;if this is not numeric, go to ratentry
 158: 11$:    cmp     b,#strbend              ;overflow of buffer
 159:         bhis    raterr                  ;yes
 160:         movb    a,(b)+                  ;pack a in buffer
 161: 20$:    getca                           ;get a new char
 162:         cmpb    a,#'-                   ;minus sign???
 163:         beq     12$
 164:         cmpb    ctable(a),#vnum
 165:         beq     11$                     ;if not loop
 166: 12$:    savec                           ;if is save it(who knows what it might
 167:                                         ; be)
 168:         clrb    (b)
 169:         jmp     strnum                  ;and convert
 170: raterr: error   </atom too long/>
 171: bcerror:error   </illegal character in atom/>
 172: 
 173: 
 174: 
 175: ratdq:  mov     #strbuf,b               ;here we do "funny" atoms
 176:         clr     j2                      ;clear for hashing
 177: 21$:    getca
 178:         cmpb    a,#'"                   ;is new char  "
 179:         beq     finup+4
 180: 22$:    movb    a,(b)+                  ;otherwise push it in puffer
 181:         xor     a,j2                    ;form hash code
 182:         cmp     b,#strbend              ;see if buffer is ok
 183:         blo     21$                     ;single error
 184:         br      raterr
 185: ratatm: clr     j2                      ;this is for regular atoms
 186:         mov     #strbuf,b               ;set up buffer pointer
 187: 31$:    movb    a,(b)+                  ;store char
 188:         cmp     b,#strbend              ;check for overflow
 189:         bhis    raterr                  ;single error
 190:         xor     a,j2                    ;form hash code
 191:         getca                           ;get next char
 192: ratent=* .
 193:         tstb    ctable(a)               ;see if a sep or break
 194:         bge     31$                     ;if not,loop
 195: finup:  savec                           ;if so,save it
 196:         clrb    (b)+                    ;move two null bytes into buffer
 197:         clrb    (b)+
 198: ;	jmp	find			;a
 199: 
 200:         vsep=0          ;redefinitions for the ctable
 201:         vdq=rdq-seploop
 202:         vnum=rnum-seploop
 203:         vsq=rsqc-seploop
 204:         vperd=rperd-seploop
 205:         vlpara=rlpara-seploop
 206:         vrpara=rrpara-seploop
 207:         vlbkta=rlbkta-seploop
 208:         vrbkta=rrbkta-seploop
 209:         veof=reof-seploop
 210:         vchar=ratm-seploop
 211:         verr=rerr-seploop
 212: 
 213: 
 214: 
 215: 
 216: ;this  is stuff for new rivest oblist switching
 217: 
 218:         .sharable
 219: 
 220: find:   sub     #strbuf,b
 221:         asr     b
 222: 
 223: .if     eq,hash
 224:         mov     xoblist,-(sp)
 225:  .iff
 226:         bic     #<^c hashm>,j2
 227:         asl     j2
 228:         mov     hasht(j2),-(sp)
 229: .endc
 230: 
 231: 
 232: ;recall at this point we have a,j1,j3 to play with
 233: ;b is the length of atom
 234: ;j2 is the hash code
 235: 
 236:         mov     (sp),j1         ;copy
 237: 1$:     jmpifnil j1,20$,nl      ;are we done?
 238:         car     j1,j3
 239:         add     #6,j3           ;get ptr to string
 240:         mov     #strbuf,a
 241: 2$:     cmp     (j3)+,(a)       ;are they equal?
 242:         bne     10$             ;no
 243:         inc     a               ;now see if high order byte 0
 244:         tstb    (a)+            ;is it?
 245:         bne     2$              ;no!!
 246: 
 247: ;here we have success
 248: 
 249:         car     j1,a            ;get answer
 250:         incb    noint           ;don't want to lose atoms
 251:         car     (sp),(j1)       ;switch things
 252:         mov     a,@(sp)+        ;and move our atom one forward
 253:         decb    noint           ;and let things back to normal
 254: 
 255: .if     ne,nilas0               ;in non-i&d case,
 256:  .if    eq,multiseg
 257:         cmp     a,#atmnil       ;see if we actually mean nil (0)
 258:         bne     13$
 259:         loadnil a
 260: 13$:
 261: .endc
 262: .endc
 263:         ret
 264: 
 265: 
 266: 10$:                            ;this is were we go for more
 267:         mov     j1,(sp)         ;move ptrs
 268:         cdr     j1,j1
 269:         br      1$
 270: 
 271: 20$:                            ;failure
 272:         tst     (sp)+
 273: ;	jmp	strat
 274: 
 275: 
 276: 
 277: 
 278: 
 279: 
 280:                 ;strat takes in b the number of words in the printname,
 281:                 ;and in j2 the hash-code for  the atom
 282:                 ;(if hashing is implemented)
 283: 
 284:         .sharable
 285: 
 286: 
 287: 
 288: strat:  mov     b,a             ;now we have to make the atom
 289:         call    gatom           ;get a blankatom with a char words
 290:         mov     a,j1            ;get place where chars go
 291:         add     #6,j1
 292:         mov     #strbuf,j3      ;get our character buffer
 293: 1$:     mov     (j3)+,(j1)+     ;move two chars
 294:         sob     b,1$            ;go back if not done
 295:         mov     a,b             ;get atom safe
 296:         call    gdtpr           ;and get dtpr
 297: .if     eq,hash
 298:         .ift
 299:         mov     xoblist,2(a)
 300:         mov     b,(a)
 301:         mov     a,xoblist
 302:         mov     b,a             ;and return atom
 303:          ret
 304:         .iff
 305:          mov    hasht(j2),2(a)
 306:         mov     b,(a)
 307:          mov    a,hasht(j2)
 308:         mov     b,a             ;again, return atom,...
 309:          ret
 310: .endc
Last modified: 1981-05-10
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1578
Valid CSS Valid XHTML 1.0 Strict