Mini-Unix/usr/source/tmg/tmga.s
/ tmg
/ main program and parsing rule interpreter
/
tracing = 1
f = r5
g = r4
i = r3
sef=sec^sec; clf=clc^clc; bfs=bcs^bcs; bfc=bcc^bcc /fail indicator
.globl flush,obuild,putch,iget,kput
.globl generate
.globl cfile,dfile,ofile,input
.globl main,succ,fail,errcom,pbundle,parse,diag
.globl alt,salt,stop,goto
.globl tables,start,end
.globl stkb,stke
.globl ktab
.globl trswitch,trace
.globl x,si,j,k,n,g1,env
/ begin here
/ get arguments from shell
/ arg1 is input file
/ arg2 is output file (standard output if missing)
main:
dec (sp)
beq 3f
mov 4(sp),0f
sys open;0:0;0
bes 1f
mov r0,input
dec (sp)
beq 3f
mov 6(sp),0f
sys creat;0:0;666
bes 1f
mov r0,ofile
/ set up tables
/ initialize stack, for definitions see tmgc.s
/ go interpret beginning at "start"
/ finish up
3:
mov $stkb,f
clr j(f)
clr k(f)
clr n(f)
mov f,g
add $g1,g
mov $start,r0
jsr pc,adv
jsr pc,flush
1:
sys unlink;1f
sys exit
1:
<alloc.d\0>;.even
/ fatal processor error
/write a two letter message on diagnostic file
/ get a dump
errcom:
mov dfile,cfile
jsr pc,obuild
mov $1f,r0
jsr pc,obuild
jsr pc,flush
stop:
4
1: <--fatal\n\0>;.even
/ all functions that succeed come here
/ test the exit indicator, and leave the rule if on
succ:
inc succc
bit $1,x(f)
bne sret
contin:
inc continc
.if tracing
tst trswitch
beq 1f
mov $'r,r0
jsr pc,trace
1:
.endif
/ get interpreted instruction
/ save its exit bit (bit 0) on stack
/ distinguish type of instruction by ranges of value
jsr pc,iget
mov r0,x(f)
bic $1,r0
.if ..
cmp r0,$..
blo 1f
.endif
cmp r0,$start
blo 2f
cmp r0,$end
blo 3f
cmp r0,$tables
blo 2f
/ bad address
1:
jsr r0,errcom
<bad address in parsing\0>;.even
/ machine coded function
2:
jmp (r0)
/ tmg-coded rule, execute and test its success
/ bfc = branch on fail clear
3:
jsr pc,adv
bfc succ
/ all functions and rules that fail come here
/ if exit bit is on do a fail return
/ if following instruction is an alternate (recognized literally)
/ do a goto, if a success alternate, do a nop
/ otherwise do a fail return
fail:
inc failc
bit $1,x(f)
bne fret
jsr pc,iget
mov r0,x(f)
bic $1,r0
cmp r0,$alt
beq salt
cmp r0,$salt
bne fret
alt:
tst (i)+
br succ
salt:
jsr pc,iget
mov r0,i
br contin
goto:
br salt
/ do a success return
/ bundle translations delivered to this rule,
/ pop stack frame
/ restore interpreted instruction counter (i)
/ update input cursor (j) for invoking rule
/ update high water mark (k) in ktable
/ if there was a translation delivered, add to stack frame
/ clear the fail flag
sret:
mov f,r0
add $g1,r0
jsr pc,pbundle
mov f,g
mov (f),f
mov si(f),i
mov j(g),j(f)
mov k(g),k(f)
tst r0
beq 1f
mov r0,(g)+
1:
clf
rts pc
/ do a fail return
/ pop stack
/ do not update j or k
/ restore interpreted instruction counter
fret:
mov f,g
mov (f),f
mov si(f),i
sef
rts pc
/ diag and parse builtins
/ set current file to diagnostic or output
/ save and restore ktable water mark around parse-translate
/ also current file and next frame pointer (g)
/ execute parsing rule
diag:
mov dfile,r1
br 1f
parse:
mov ofile,r1
1:
mov cfile,-(sp)
mov r1,cfile
mov k(f),-(sp)
mov g,-(sp)
jsr pc,iget
jsr pc,adv
bfs 1f
/ rule succeeded
/ if it delivered translation, put it in ktable and set
/ instruction counter for
/ translation generator to point there
/ go generate
cmp g,(sp)+
ble 2f
mov -(g),r0
jsr pc,kput
mov k(f),i
neg i
add $ktab,i
mov f,-(sp)
mov g,f
clr x(f)
jsr pc,generate
mov (sp)+,f
mov si(f),i
2:
mov (sp)+,k(f)
mov (sp)+,cfile
jmp succ
1:
mov (sp)+,g
mov (sp)+,k(f)
mov (sp)+,cfile
br fail
/ advance stack frame to invoke a parsing rule
/ copy corsor, watr mark, ignored class to new frame
/ set intial frame length to default (g1)
/ check end of stack
/ r0,r1 are new i,environment
adv:
inc advc
mov f,(g)
mov i,si(f)
mov j(f),j(g)
mov k(f),k(g)
mov n(f),n(g)
mov g,f
add $g1,g
cmp g,$stke
bhis 1f
mov r0,i
mov r1,env(f)
jmp contin
1:
jsr r0,errcom
<stack overflow\0>;.even
/pbundle entered with pointer to earliest element of bunlde
/to reduce from the top of stack in r0
/exit with pointer to bundle in r0, or zero if bundle is empty
pbundle:
cmp r0,g
blo 1f
clr r0 /empty bundle
rts pc
1:
mov r0,-(sp)
mov r0,r1
mov (r1)+,r0
cmp r1,g
beq 2f /trivial bundle
1:
mov r1,-(sp)
jsr pc,kput
mov (sp)+,r1
mov (r1)+,r0
cmp r1,g
blos 1b
mov k(f),r0
2:
mov (sp)+,g
rts pc
/ tmg translation rule interpreter (generator)
/ see tmgc.s for definitions
tracing = 1
f = r5
.globl x,si,ek,ep,ek.fs,ep.fs,fs
.globl trswitch,trace
.globl start,end,tables,ktab,ktat
.globl errcom
.globl generate,.tp
i = r3
/ if exit bit is on pop stack frame restore inst counter and return
generate:
bit $1,x(f)
beq gcontin
sub $fs,f
mov si(f),i
rts pc
gcontin:
.if tracing
tst trswitch
beq 1f
mov $'g,r0
jsr pc,trace
1:
.endif
/ get interpreted instruction, decode by range of values
mov (i)+,r0
mov r0,x(f)
bic $1,r0
.if ..
cmp r0,$..
blo badadr
.endif
cmp r0,$start
blo gf
cmp r0,$end
blo gc
cmp r0,$tables
blo gf
neg r0
cmp r0,$ktat
blo gk
badadr:
jsr r0,errcom
<bad address in translation\0>;.even
/ builtin translation function
gf:
jmp (r0)
/ tmg-coded translation subroutine
/ execute it in current environment
gc:
mov i,si(f)
mov r0,i
mov ek(f),ek.fs(f)
mov ep(f),ep.fs(f)
add $fs,f
jsr pc,gcontin
br generate
/ delivered compound translation
/ instruction counter is in ktable
/ set the k environment for understanding 1, 2 ...
/ to designate this frame
gk:
mov f,ek(f)
add $ktab,r0
mov r0,i
br gcontin
/ execute rule called for by 1 2 ...
/ found relative to instruction counter in the k environment
/ this frame becomes th p environment for
/ any parameters passed with this invocation
/ e.g. for 1(x) see also .tq
.tp:
movb (i)+,r0
movb (i)+,r2
inc r0
asl r0
mov i,si(f)
mov f,ep.fs(f)
mov ek(f),r1
mov si(r1),i
sub r0,i
add $fs,f
mov f,ek(f)
asl r2
beq 2f
/element is 1.1, 1.2, .. 2.1,...
mov (i),i
neg i
bge 1f
jsr r0,errcom
<not a bundle\0>;.even
1:
cmp i,$ktat
bhis badadr
add $ktab,i
sub r2,i
2:
jsr pc,gcontin
br generate
/ tmg output routines/ and iget
f = r5
i = r3
.globl env,si
.globl errcom
.globl cfile,lfile
.globl putch,obuild,iget,flush
.globl outb,outt,outw
.globl start
/ adds 1 or 2 characters in r0 to output
putch:
clr -(sp)
mov r0,-(sp)
mov sp,r0
jsr pc,obuild
add $4,sp
rts pc
/ r0 points to string to put out on current output file (cfile)
/ string terminated by 0
/ if last file differed from current file, flush output buffer first
/ in any case flush output buffer when its write pointer (outw)
/ reaches its top (outt)
obuild:
cmp cfile,lfile
beq 1f
mov r0,-(sp)
jsr pc,flush
mov (sp)+,r0
mov cfile,lfile
1:
mov outw,r1
1:
tstb (r0)
beq 1f
movb (r0)+,outb(r1)
inc r1
mov r1,outw
cmp r1,$outt
blt 1b
mov r0,-(sp)
jsr pc,flush
mov (sp)+,r0
br obuild
1:
rts pc
/ copy output buffer onto last output file and clear buffer
flush:
mov outw,0f
mov lfile,r0
sys write;outb;0:0
clr outw
rts pc
/ get interpreted instruction for a parsing rule
/ negative instruction is a pointer to a parameter in this
/ stack fromae, fetch that instead
/ put environment pointer in r1
iget:
mov f,r1
mov (i)+,r0
bge 2f
mov r0,-(sp) /save the exit bit
bic $-2,(sp)
bic (sp),r0
1: /chase parameter
mov env(r1),r1
add si(r1),r0
mov (r0),r0
blt 1b
mov env(r1),r1
bis (sp)+,r0
2:
rts pc
/there followeth the driving tables
start:
.data
succc: 0
continc: 0
failc: 0
advc: 0
.text