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