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

Defined functions

.tp declared in line 297; defined in line 368; used 101 times
adv defined in line 243; used 3 times
alt declared in line 15; defined in line 141; used 80 times
badadr defined in line 334; used 2 times
bfc defined in line 9; used 1 times
bfs defined in line 9; used 1 times
clf defined in line 9; used 1 times
contin defined in line 81; used 2 times
diag declared in line 14; defined in line 196; used 4 times
errcom declared in line 14296401; defined in line 64; used 7 times
f defined in line 398; used 57 times
fail declared in line 14; defined in line 129; used 5 times
flush declared in line 11403; defined in line 449; used 6 times
fret defined in line 183; used 2 times
g defined in line 6; used 23 times
gc defined in line 344; used 1 times
gcontin defined in line 308; used 4 times
generate declared in line 12297; defined in line 302; used 8 times
gf defined in line 339; used 2 times
gk defined in line 357; used 1 times
goto declared in line 15; defined in line 150; used 64 times
i defined in line 399; used 27 times
iget declared in line 11403; defined in line 462; used 6 times
main declared in line 14; defined in line 27; used 1 times
  • in line 14
obuild declared in line 11403; defined in line 423; used 6 times
parse declared in line 14; defined in line 199; used 8 times
pbundle declared in line 14; defined in line 265; used 2 times
putch declared in line 11403; defined in line 409; used 2 times
salt declared in line 15; defined in line 145; used 39 times
sef defined in line 9; used 1 times
sret defined in line 162; used 1 times
  • in line 80
start declared in line 16295405; defined in line 479; used 6 times
stop declared in line 15; defined in line 70; used 1 times
  • in line 15
succ declared in line 14; defined in line 77; used 29 times
tracing defined in line 291; used 2 times

Defined variables

advc defined in line 485; used 1 times
continc defined in line 483; used 1 times
  • in line 82
failc defined in line 484; used 1 times
succc defined in line 482; used 1 times
  • in line 78
Last modified: 1975-05-14
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 625
Valid CSS Valid XHTML 1.0 Strict