487 lines
7.4 KiB
ArmAsm
487 lines
7.4 KiB
ArmAsm
/ 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
|