1: / tmg 2: / main program and parsing rule interpreter 3: / 4: tracing = 1 5: f = r5 6: g = r4 7: i = r3 8: 9: sef=sec^sec; clf=clc^clc; bfs=bcs^bcs; bfc=bcc^bcc /fail indicator 10: 11: .globl flush,obuild,putch,iget,kput 12: .globl generate 13: .globl cfile,dfile,ofile,input 14: .globl main,succ,fail,errcom,pbundle,parse,diag 15: .globl alt,salt,stop,goto 16: .globl tables,start,end 17: .globl stkb,stke 18: .globl ktab 19: .globl trswitch,trace 20: .globl x,si,j,k,n,g1,env 21: 22: / begin here 23: / get arguments from shell 24: / arg1 is input file 25: / arg2 is output file (standard output if missing) 26: 27: main: 28: dec (sp) 29: beq 3f 30: mov 4(sp),0f 31: sys open;0:0;0 32: bes 1f 33: mov r0,input 34: dec (sp) 35: beq 3f 36: mov 6(sp),0f 37: sys creat;0:0;666 38: bes 1f 39: mov r0,ofile 40: 41: / set up tables 42: / initialize stack, for definitions see tmgc.s 43: / go interpret beginning at "start" 44: / finish up 45: 3: 46: mov $stkb,f 47: clr j(f) 48: clr k(f) 49: clr n(f) 50: mov f,g 51: add $g1,g 52: mov $start,r0 53: jsr pc,adv 54: jsr pc,flush 55: 1: 56: sys unlink;1f 57: sys exit 58: 1: 59: <alloc.d\0>;.even 60: / fatal processor error 61: /write a two letter message on diagnostic file 62: / get a dump 63: 64: errcom: 65: mov dfile,cfile 66: jsr pc,obuild 67: mov $1f,r0 68: jsr pc,obuild 69: jsr pc,flush 70: stop: 71: 4 72: 1: <--fatal\n\0>;.even 73: 74: / all functions that succeed come here 75: / test the exit indicator, and leave the rule if on 76: 77: succ: 78: inc succc 79: bit $1,x(f) 80: bne sret 81: contin: 82: inc continc 83: .if tracing 84: tst trswitch 85: beq 1f 86: mov $'r,r0 87: jsr pc,trace 88: 1: 89: .endif 90: / get interpreted instruction 91: / save its exit bit (bit 0) on stack 92: / distinguish type of instruction by ranges of value 93: 94: jsr pc,iget 95: mov r0,x(f) 96: bic $1,r0 97: .if .. 98: cmp r0,$.. 99: blo 1f 100: .endif 101: cmp r0,$start 102: blo 2f 103: cmp r0,$end 104: blo 3f 105: cmp r0,$tables 106: blo 2f 107: 108: / bad address 109: 1: 110: jsr r0,errcom 111: <bad address in parsing\0>;.even 112: 113: / machine coded function 114: 2: 115: jmp (r0) 116: 117: / tmg-coded rule, execute and test its success 118: / bfc = branch on fail clear 119: 3: 120: jsr pc,adv 121: bfc succ 122: 123: / all functions and rules that fail come here 124: / if exit bit is on do a fail return 125: / if following instruction is an alternate (recognized literally) 126: / do a goto, if a success alternate, do a nop 127: / otherwise do a fail return 128: 129: fail: 130: inc failc 131: bit $1,x(f) 132: bne fret 133: jsr pc,iget 134: mov r0,x(f) 135: bic $1,r0 136: cmp r0,$alt 137: beq salt 138: cmp r0,$salt 139: bne fret 140: 141: alt: 142: tst (i)+ 143: br succ 144: 145: salt: 146: jsr pc,iget 147: mov r0,i 148: br contin 149: 150: goto: 151: br salt 152: 153: / do a success return 154: / bundle translations delivered to this rule, 155: / pop stack frame 156: / restore interpreted instruction counter (i) 157: / update input cursor (j) for invoking rule 158: / update high water mark (k) in ktable 159: / if there was a translation delivered, add to stack frame 160: / clear the fail flag 161: 162: sret: 163: mov f,r0 164: add $g1,r0 165: jsr pc,pbundle 166: mov f,g 167: mov (f),f 168: mov si(f),i 169: mov j(g),j(f) 170: mov k(g),k(f) 171: tst r0 172: beq 1f 173: mov r0,(g)+ 174: 1: 175: clf 176: rts pc 177: 178: / do a fail return 179: / pop stack 180: / do not update j or k 181: / restore interpreted instruction counter 182: 183: fret: 184: mov f,g 185: mov (f),f 186: mov si(f),i 187: sef 188: rts pc 189: 190: / diag and parse builtins 191: / set current file to diagnostic or output 192: / save and restore ktable water mark around parse-translate 193: / also current file and next frame pointer (g) 194: / execute parsing rule 195: 196: diag: 197: mov dfile,r1 198: br 1f 199: parse: 200: mov ofile,r1 201: 1: 202: mov cfile,-(sp) 203: mov r1,cfile 204: mov k(f),-(sp) 205: mov g,-(sp) 206: jsr pc,iget 207: jsr pc,adv 208: bfs 1f 209: / rule succeeded 210: / if it delivered translation, put it in ktable and set 211: / instruction counter for 212: / translation generator to point there 213: / go generate 214: cmp g,(sp)+ 215: ble 2f 216: mov -(g),r0 217: jsr pc,kput 218: mov k(f),i 219: neg i 220: add $ktab,i 221: mov f,-(sp) 222: mov g,f 223: clr x(f) 224: jsr pc,generate 225: mov (sp)+,f 226: mov si(f),i 227: 2: 228: mov (sp)+,k(f) 229: mov (sp)+,cfile 230: jmp succ 231: 1: 232: mov (sp)+,g 233: mov (sp)+,k(f) 234: mov (sp)+,cfile 235: br fail 236: 237: / advance stack frame to invoke a parsing rule 238: / copy corsor, watr mark, ignored class to new frame 239: / set intial frame length to default (g1) 240: / check end of stack 241: / r0,r1 are new i,environment 242: 243: adv: 244: inc advc 245: mov f,(g) 246: mov i,si(f) 247: mov j(f),j(g) 248: mov k(f),k(g) 249: mov n(f),n(g) 250: mov g,f 251: add $g1,g 252: cmp g,$stke 253: bhis 1f 254: mov r0,i 255: mov r1,env(f) 256: jmp contin 257: 1: 258: jsr r0,errcom 259: <stack overflow\0>;.even 260: 261: /pbundle entered with pointer to earliest element of bunlde 262: /to reduce from the top of stack in r0 263: /exit with pointer to bundle in r0, or zero if bundle is empty 264: 265: pbundle: 266: cmp r0,g 267: blo 1f 268: clr r0 /empty bundle 269: rts pc 270: 1: 271: mov r0,-(sp) 272: mov r0,r1 273: mov (r1)+,r0 274: cmp r1,g 275: beq 2f /trivial bundle 276: 1: 277: mov r1,-(sp) 278: jsr pc,kput 279: mov (sp)+,r1 280: mov (r1)+,r0 281: cmp r1,g 282: blos 1b 283: mov k(f),r0 284: 2: 285: mov (sp)+,g 286: rts pc 287: 288: / tmg translation rule interpreter (generator) 289: / see tmgc.s for definitions 290: 291: tracing = 1 292: f = r5 293: .globl x,si,ek,ep,ek.fs,ep.fs,fs 294: .globl trswitch,trace 295: .globl start,end,tables,ktab,ktat 296: .globl errcom 297: .globl generate,.tp 298: i = r3 299: 300: / if exit bit is on pop stack frame restore inst counter and return 301: 302: generate: 303: bit $1,x(f) 304: beq gcontin 305: sub $fs,f 306: mov si(f),i 307: rts pc 308: gcontin: 309: .if tracing 310: tst trswitch 311: beq 1f 312: mov $'g,r0 313: jsr pc,trace 314: 1: 315: .endif 316: / get interpreted instruction, decode by range of values 317: 318: mov (i)+,r0 319: mov r0,x(f) 320: bic $1,r0 321: .if .. 322: cmp r0,$.. 323: blo badadr 324: .endif 325: cmp r0,$start 326: blo gf 327: cmp r0,$end 328: blo gc 329: cmp r0,$tables 330: blo gf 331: neg r0 332: cmp r0,$ktat 333: blo gk 334: badadr: 335: jsr r0,errcom 336: <bad address in translation\0>;.even 337: 338: / builtin translation function 339: gf: 340: jmp (r0) 341: 342: / tmg-coded translation subroutine 343: / execute it in current environment 344: gc: 345: mov i,si(f) 346: mov r0,i 347: mov ek(f),ek.fs(f) 348: mov ep(f),ep.fs(f) 349: add $fs,f 350: jsr pc,gcontin 351: br generate 352: 353: / delivered compound translation 354: / instruction counter is in ktable 355: / set the k environment for understanding 1, 2 ... 356: / to designate this frame 357: gk: 358: mov f,ek(f) 359: add $ktab,r0 360: mov r0,i 361: br gcontin 362: 363: / execute rule called for by 1 2 ... 364: / found relative to instruction counter in the k environment 365: / this frame becomes th p environment for 366: / any parameters passed with this invocation 367: / e.g. for 1(x) see also .tq 368: .tp: 369: movb (i)+,r0 370: movb (i)+,r2 371: inc r0 372: asl r0 373: mov i,si(f) 374: mov f,ep.fs(f) 375: mov ek(f),r1 376: mov si(r1),i 377: sub r0,i 378: add $fs,f 379: mov f,ek(f) 380: asl r2 381: beq 2f 382: /element is 1.1, 1.2, .. 2.1,... 383: mov (i),i 384: neg i 385: bge 1f 386: jsr r0,errcom 387: <not a bundle\0>;.even 388: 1: 389: cmp i,$ktat 390: bhis badadr 391: add $ktab,i 392: sub r2,i 393: 2: 394: jsr pc,gcontin 395: br generate 396: 397: / tmg output routines/ and iget 398: f = r5 399: i = r3 400: .globl env,si 401: .globl errcom 402: .globl cfile,lfile 403: .globl putch,obuild,iget,flush 404: .globl outb,outt,outw 405: .globl start 406: 407: / adds 1 or 2 characters in r0 to output 408: 409: putch: 410: clr -(sp) 411: mov r0,-(sp) 412: mov sp,r0 413: jsr pc,obuild 414: add $4,sp 415: rts pc 416: 417: / r0 points to string to put out on current output file (cfile) 418: / string terminated by 0 419: / if last file differed from current file, flush output buffer first 420: / in any case flush output buffer when its write pointer (outw) 421: / reaches its top (outt) 422: 423: obuild: 424: cmp cfile,lfile 425: beq 1f 426: mov r0,-(sp) 427: jsr pc,flush 428: mov (sp)+,r0 429: mov cfile,lfile 430: 1: 431: mov outw,r1 432: 1: 433: tstb (r0) 434: beq 1f 435: movb (r0)+,outb(r1) 436: inc r1 437: mov r1,outw 438: cmp r1,$outt 439: blt 1b 440: mov r0,-(sp) 441: jsr pc,flush 442: mov (sp)+,r0 443: br obuild 444: 1: 445: rts pc 446: 447: / copy output buffer onto last output file and clear buffer 448: 449: flush: 450: mov outw,0f 451: mov lfile,r0 452: sys write;outb;0:0 453: clr outw 454: rts pc 455: 456: 457: / get interpreted instruction for a parsing rule 458: / negative instruction is a pointer to a parameter in this 459: / stack fromae, fetch that instead 460: / put environment pointer in r1 461: 462: iget: 463: mov f,r1 464: mov (i)+,r0 465: bge 2f 466: mov r0,-(sp) /save the exit bit 467: bic $-2,(sp) 468: bic (sp),r0 469: 1: /chase parameter 470: mov env(r1),r1 471: add si(r1),r0 472: mov (r0),r0 473: blt 1b 474: mov env(r1),r1 475: bis (sp)+,r0 476: 2: 477: rts pc 478: /there followeth the driving tables 479: start: 480: 481: .data 482: succc: 0 483: continc: 0 484: failc: 0 485: advc: 0 486: .text