1: / 2: / 3: 4: / fx4 -- get symbol 5: 6: .globl getsym 7: .globl getid 8: .globl lookid 9: .globl chrtab 10: 11: .globl lookup 12: .globl error 13: .globl geti 14: .globl holround 15: / getsym returns the next basic symbol 16: 17: / 0 name (symbol table entry in r3) 18: / 2 number (type in r3) 19: / 4 ** 20: / 6 / 21: / 8 * 22: / 10 - 23: / 12 + 24: / 14 .lt. 25: / 16 .le. 26: / 18 .eq. 27: / 20 .ne. 28: / 22 .gt. 29: / 24 .ge. 30: / 26 .not. 31: / 28 .and. 32: / 30 .or. 33: / 32 ( 34: / 34 ) 35: / 36 , 36: / 38 = 37: / 40 =| 38: / 39: getsym: 40: mov r2,-(sp) 41: mov r1,r2 42: jsr r5,lookup; bastab 43: br 1f 44: mov r2,r1 45: cmp r0,$4 46: bhis 2f 47: asr r0 48: add $'0,r0 49: movb r0,symbuf 50: movb $12,symbuf+1 51: clrb symbuf+2 52: mov $logcon,r3 / logical*2 53: mov $2,r0 54: 2: 55: cmp r0,$32. 56: bne 2f 57: 58: / check for possible complex constant 59: 60: mov r1,-(sp) 61: movb -2(r1),r0 62: movb chrtab(r0),r0 63: beq 4f 64: cmp r0,$4 65: blos 3f 66: 4: 67: jsr r5,srconst 68: br 3f 69: mov r3,r2 70: cmpb (r1)+,$', 71: bne 3f 72: jsr r5,srconst 73: br 3f 74: cmp r3,r2 75: bhis 4f 76: mov r2,r3 77: 4: 78: cmpb (r1)+,$') 79: bne 3f 80: mov (sp)+,r1 81: mov $symbuf,r2 82: 4: 83: movb (r1)+,(r2) 84: cmpb (r2)+,$') 85: bne 4b 86: clrb -(r2) 87: mov $2,r0 88: br 2f 89: 3: 90: mov (sp)+,r1 91: mov $32.,r0 92: 2: 93: mov (sp)+,r2 94: rts r5 95: 1: 96: clr lstchr 97: cmp r1,$line 98: blos 1f 99: movb -1(r1),lstchr 100: 1: 101: mov $symbuf,r2 102: movb (r1)+,r0 103: movb r0,(r2)+ 104: bic $!177,r0 105: movb chrtab(r0),r0 106: jmp *1f(r0) 107: 1: 108: eos 109: let 110: num 111: per 112: 113: eos: 114: mov $40.,r0 115: tstb -(r1) 116: beq 2b 117: jsr r5,error; 8. 118: br 2b 119: 120: let: 121: dec r1 122: jsr r5,getid 123: br .+2 / cannot happen 124: jsr r5,lookid; symbuf 125: mov (sp)+,r2 126: clr r0 127: rts r5 128: 129: num: 130: mov $intcon,r3 / integer*4 131: jsr r5,numst 132: cmpb (r1),$'. 133: bne 2f 134: mov r2,-(sp) 135: mov r1,r2 136: jsr r5,lookup; bastab 137: br 1f 138: mov (sp)+,r2 139: br 3f 140: 1: 141: mov (sp)+,r2 142: movb (r1)+,(r2)+ 143: br 1f 144: 2: 145: cmpb (r1),$'h / hollerith const? 146: bne 2f 147: mov lstchr,r0 148: cmpb chrtab(r0),$2 / letter? 149: beq 2f / not h, then 150: cmp r0,$'* 151: beq 2f / e.g. real*4 h... 152: clrb (r2) 153: jsr r5,geti 154: mov $symbuf,r2 155: inc r1 156: mov holround,-(sp) 157: dec (sp) 158: clr -(sp) 159: 4: 160: movb (r1)+,(r2)+ 161: bne 5f 162: jsr r5,error; 55. 163: br 6f 164: 5: 165: inc (sp) 166: dec r0 167: bgt 4b 168: 6: 169: bit (sp),2(sp) 170: beq 6f 171: movb $' ,(r2)+ 172: inc (sp) 173: br 6b 174: 6: 175: mov (sp)+,r3 176: tst (sp)+ 177: swab r3 178: clrb r3 179: bis $5,r3 180: mov $2,r0 181: mov (sp)+,r2 182: rts r5 183: 184: .bss 185: lstchr: .=.+2 186: .text 187: 188: per: 189: jsr r5,isnum 190: br eos 191: 1: 192: mov $realcon,r3 / real*4 193: jsr r5,numst 194: 2: 195: jsr r5,expon 196: 3: 197: clrb (r2) 198: mov $2,r0 199: mov (sp)+,r2 200: rts r5 201: 202: isnum: 203: movb (r1),r0 204: cmpb chrtab(r0),$4 205: bne 1f 206: tst (r5)+ 207: 1: 208: rts r5 209: 210: numst: 211: jsr r5,isnum 212: br 1b 213: inc r1 214: movb r0,(r2)+ 215: br numst 216: 217: expon: 218: cmpb (r1)+,$'e 219: beq 1f 220: cmpb -1(r1),$'d 221: beq 1f 222: 2: 223: dec r1 224: rts r5 225: 1: 226: cmpb (r1),$'+ 227: beq 1f 228: cmpb (r1),$'- 229: beq 1f 230: jsr r5,isnum 231: br 2b 232: 1: 233: mov $realcon,r3 / real*4 234: cmpb -(r1),$'e 235: beq 1f 236: mov $dblcon,r3 / real*8 237: 1: 238: movb (r1)+,(r2)+ 239: movb (r1)+,(r2)+ 240: jsr r5,numst 241: rts r5 242: 243: getid: 244: mov r0,-(sp) 245: mov r2,-(sp) 246: movb (r1),r0 247: cmpb chrtab(r0),$2 248: bne 3f 249: tst (r5)+ 250: mov $symbuf,r2 251: 1: 252: movb (r1)+,r0 253: movb r0,(r2)+ 254: movb chrtab(r0),r0 255: cmp r0,$2 256: beq 1b 257: cmp r0,$4 258: beq 1b 259: dec r1 260: clrb (r2) 261: movb $12,-(r2) 262: 3: 263: mov (sp)+,r2 264: mov (sp)+,r0 265: rts r5 266: 267: lookid: 268: mov r0,-(sp) 269: mov r2,-(sp) 270: 2: 271: mov (r5),r2 272: jsr r5,lookup; namebuf 273: br 1f 274: asl r0 275: asl r0 276: mov r0,r3 277: mov (sp)+,r2 278: mov (sp)+,r0 279: tst (r5)+ 280: rts r5 281: 1: 282: mov namep,r0 283: add $8.,symtp 284: 1: 285: movb (r2)+,(r0)+ 286: bne 1b 287: mov r0,namep 288: cmp r0,$enamebuf 289: bhis 1f 290: mov symtp,r0 291: add $symtab,r0 292: cmp r0,esymp 293: blo 2b 294: 1: 295: mov $1,r0 296: sys write; ovfl; eovfl-ovfl 297: clr r0 298: sys seek; 0; 2 299: mov $-1,r0 300: sys exit 301: 302: ovfl: 303: <Symbol table overflow\n> 304: eovfl: 305: .even 306: 307: srconst: 308: cmpb (r1)+,$'+ 309: beq 1f 310: cmpb -(r1),$'- 311: bne 1f 312: inc r1 313: 1: 314: jsr r5,getsym 315: cmp r0,$2 316: bne 1f 317: clrb r3 318: add r3,r3 319: bisb $cplxcon,r3 320: tst (r5)+ 321: 1: 322: rts r5 323: 324: chrtab: 325: .byte 0,0,0,0,0,0,0,0 326: .byte 0,0,0,0,0,0,0,0 327: .byte 0,0,0,0,0,0,0,0 328: .byte 0,0,0,0,0,0,0,0 329: .byte 0,0,0,0,0,0,0,0 330: .byte 0,0,0,0,0,0,6,0 331: .byte 4,4,4,4,4,4,4,4 332: .byte 4,4,0,0,0,0,0,0 333: .byte 0,2,2,2,2,2,2,2 334: .byte 2,2,2,2,2,2,2,2 335: .byte 2,2,2,2,2,2,2,2 336: .byte 2,2,2,0,0,0,0,0 337: .byte 0,2,2,2,2,2,2,2 338: .byte 2,2,2,2,2,2,2,2 339: .byte 2,2,2,2,2,2,2,2 340: .byte 2,2,2,0,0,0,0,0 341: 342: bastab: 343: <.false.\0> 344: <.true.\0> 345: <**\0> 346: </\0> 347: <*\0> 348: <-\0> 349: <+\0> 350: <.lt.\0> 351: <.le.\0> 352: <.eq.\0> 353: <.ne.\0> 354: <.gt.\0> 355: <.ge.\0> 356: <.not.\0> 357: <.and.\0> 358: <.or.\0> 359: <(\0> 360: <)\0> 361: <,\0> 362: <=\0> 363: <\0>
|
Last modified: 1975-07-17
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 498 |
|