Add original unix v6
This commit is contained in:
memnoth
@@ -0,0 +1,60 @@
|
||||
as tmga.s
|
||||
cmp a.out /usr/lib/tmga
|
||||
cp a.out /usr/lib/tmga
|
||||
|
||||
as tmgc.s
|
||||
cmp a.out /usr/lib/tmgc
|
||||
cp a.out /usr/lib/tmgc
|
||||
|
||||
chdir tmgb
|
||||
as any.s; mv a.out any.o
|
||||
as append.s; mv a.out append.o
|
||||
as arith.s; mv a.out arith.o
|
||||
as bundle.s; mv a.out bundle.o
|
||||
as char.s; mv a.out char.o
|
||||
as copy.s; mv a.out copy.o
|
||||
as cstr.s; mv a.out cstr.o
|
||||
as ctest.s; mv a.out ctest.o
|
||||
as decmal.s; mv a.out decmal.o
|
||||
as discd.s; mv a.out discd.o
|
||||
as emit.s; mv a.out emit.o
|
||||
as end.s; mv a.out end.o
|
||||
as f.s; mv a.out f.o
|
||||
as find.s; mv a.out find.o
|
||||
as getnam.s; mv a.out getnam.o
|
||||
as ignore.s; mv a.out ignore.o
|
||||
as inc.s; mv a.out inc.o
|
||||
as infix.s; mv a.out infix.o
|
||||
as jget.s; mv a.out jget.o
|
||||
as lvrv.s; mv a.out lvrv.o
|
||||
as mult.s; mv a.out mult.o
|
||||
as octal.s; mv a.out octal.o
|
||||
as params.s; mv a.out params.o
|
||||
as push.s; mv a.out push.o
|
||||
as putcal.s; mv a.out putcal.o
|
||||
as putdec.s; mv a.out putdec.o
|
||||
as putoct.s; mv a.out putoct.o
|
||||
as px.s; mv a.out px.o
|
||||
as reln.s; mv a.out reln.o
|
||||
as shift.s; mv a.out shift.o
|
||||
as stack.s; mv a.out stack.o
|
||||
as string.s; mv a.out string.o
|
||||
as table.s; mv a.out table.o
|
||||
as tq.s; mv a.out tq.o
|
||||
as trace.s; mv a.out trace.o
|
||||
as trans.s; mv a.out trans.o
|
||||
as tx.s; mv a.out tx.o
|
||||
as unary.s; mv a.out unary.o
|
||||
ar r /lib/tmgb *.o
|
||||
rm *.o
|
||||
|
||||
chdir ..
|
||||
as - tmgl.s
|
||||
ld -s /usr/lib/tmga a.out /usr/lib/tmgb /usr/lib/tmgc -ls
|
||||
cmp a.out /usr/lib/tmg
|
||||
cp a.out /usr/lib/tmg
|
||||
/usr/lib/tmg tmgl.t x
|
||||
cmp x tmgl.s
|
||||
cp x tmgl.s
|
||||
|
||||
rm a.out x
|
||||
@@ -0,0 +1,486 @@
|
||||
/ 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
|
||||
@@ -0,0 +1,17 @@
|
||||
i = r3
|
||||
f = r5
|
||||
.globl x,j
|
||||
.globl succ,fail
|
||||
.globl ctest,iget
|
||||
.globl any
|
||||
|
||||
any:
|
||||
mov j(f),-(sp)
|
||||
jsr pc,iget
|
||||
jsr pc,ctest
|
||||
bcs 1f
|
||||
mov (sp)+,j(f)
|
||||
jmp fail
|
||||
1:
|
||||
tst (sp)+
|
||||
jmp succ
|
||||
@@ -0,0 +1,16 @@
|
||||
.globl succ
|
||||
.globl putcstr,iget
|
||||
.globl append
|
||||
|
||||
append:
|
||||
jsr pc,iget
|
||||
mov r0,-(sp)
|
||||
1:
|
||||
movb *(sp),r0
|
||||
beq 1f
|
||||
jsr pc,putcstr
|
||||
inc (sp)
|
||||
br 1b
|
||||
1:
|
||||
tst (sp)+
|
||||
jmp succ
|
||||
@@ -0,0 +1,56 @@
|
||||
.globl succ,fail,iget
|
||||
.globl seekchar,getword,alterword
|
||||
.globl sprv,update
|
||||
.globl .l,.u,.p,.t,.st,
|
||||
|
||||
/ infix =
|
||||
.st:
|
||||
jsr pc,sprv
|
||||
mov (sp)+,(sp)
|
||||
mov (sp)+,(sp)
|
||||
/ update
|
||||
.u:
|
||||
jsr pc,update
|
||||
br 9f
|
||||
/ pop stack
|
||||
.p:
|
||||
jsr pc,sprv
|
||||
cmp (sp)+,(sp)+
|
||||
br 9f
|
||||
/ test stack
|
||||
.t:
|
||||
jsr pc,sprv
|
||||
mov (sp)+,(sp)+
|
||||
bne 9f
|
||||
jmp fail
|
||||
/ load named value
|
||||
/ rvalue into (sp), lvalue into 2(sp)
|
||||
.l:
|
||||
jsr pc,iget
|
||||
mov r0,-(sp)
|
||||
mov (r0),-(sp)
|
||||
br 9f
|
||||
/ update a stored value, used by all assignments
|
||||
update:
|
||||
cmp 2+2(sp),$-1
|
||||
beq 1f
|
||||
mov 0+2(sp),*2+2(sp)
|
||||
rts pc
|
||||
1:
|
||||
mov 4+2(sp),r1
|
||||
mov 6+2(sp),r0
|
||||
jsr pc,seekchar
|
||||
mov 0+2(sp),r0
|
||||
jsr pc,alterword
|
||||
/ make sp hold a simple rv (forget it might be a table value)
|
||||
sprv:
|
||||
mov (sp)+,r0
|
||||
cmp $-1,2(sp)
|
||||
bne 1f
|
||||
mov (sp)+,(sp)
|
||||
mov (sp)+,(sp)
|
||||
1:
|
||||
mov r0,pc
|
||||
9:
|
||||
jmp succ
|
||||
|
||||
@@ -0,0 +1,25 @@
|
||||
f = r5
|
||||
g = r4
|
||||
.globl g1
|
||||
.globl pbundle,iget
|
||||
.globl succ
|
||||
.globl bundle,reduce
|
||||
|
||||
reduce:
|
||||
jsr pc,iget
|
||||
mov (r0),r1
|
||||
mov g,r0
|
||||
asl r1
|
||||
sub r1,r0
|
||||
br 1f
|
||||
br 1f
|
||||
bundle:
|
||||
mov f,r0
|
||||
add $g1,r0
|
||||
1:
|
||||
jsr pc,pbundle
|
||||
tst r0
|
||||
beq 1f
|
||||
mov r0,(g)+
|
||||
1:
|
||||
jmp succ
|
||||
@@ -0,0 +1,18 @@
|
||||
f = r5
|
||||
i = r3
|
||||
.globl j
|
||||
.globl jget,iget
|
||||
.globl char
|
||||
.globl succ,fail
|
||||
|
||||
char:
|
||||
jsr pc,jget
|
||||
bne 1f
|
||||
tst (i)+
|
||||
jmp fail
|
||||
1:
|
||||
mov r0,-(sp)
|
||||
jsr pc,iget
|
||||
mov (sp)+,(r0)
|
||||
inc j(f)
|
||||
jmp succ
|
||||
@@ -0,0 +1,36 @@
|
||||
f = r5
|
||||
i = r3
|
||||
.globl x,k
|
||||
.globl ktab,ktat
|
||||
.globl putcall,obuild
|
||||
.globl errcom,succ,generate
|
||||
.globl rewcstr,getcstr
|
||||
.globl scopy
|
||||
|
||||
scopy:
|
||||
mov $2f+1,r0
|
||||
jsr pc,putcall
|
||||
jsr pc,rewcstr
|
||||
mov k(f),r2
|
||||
neg r2
|
||||
add $2,r2
|
||||
1:
|
||||
jsr pc,getcstr
|
||||
tst r0
|
||||
beq 1f
|
||||
movb r0,ktab(r2)
|
||||
inc r2
|
||||
cmp r2,$ktat
|
||||
blt 1b
|
||||
jsr r0,errcom
|
||||
<translation overflow\0>;.even
|
||||
1:
|
||||
clrb ktab(r2)
|
||||
bic $1,r2
|
||||
neg r2
|
||||
mov r2,k(f)
|
||||
jmp succ
|
||||
2:
|
||||
mov i,r0
|
||||
jsr pc,obuild
|
||||
jmp generate
|
||||
@@ -0,0 +1,75 @@
|
||||
.globl jget,iget
|
||||
.globl succ
|
||||
.globl create,rewind,putchar,getchar,allocate
|
||||
.globl smark
|
||||
.globl rewcstr,putcstr,getcstr,size
|
||||
|
||||
/ currnet string manipulations
|
||||
/ keep a initial fragment handy for quick access
|
||||
/go to allocator for the rest
|
||||
|
||||
smark:
|
||||
jsr pc,jget
|
||||
clr cstrw
|
||||
jmp succ
|
||||
|
||||
rewcstr:
|
||||
clr cstrr
|
||||
rts pc
|
||||
|
||||
putcstr:
|
||||
mov cstrw,r1
|
||||
inc cstrw
|
||||
cmp r1,$cstrt /is it quick access?
|
||||
bge 1f
|
||||
movb r0,cstrb(r1) /yes, stash the char
|
||||
rts pc
|
||||
1:
|
||||
bne 1f
|
||||
mov r0,-(sp) /first char to allocator
|
||||
mov symp,r1
|
||||
bne 2f
|
||||
mov $64,r0
|
||||
jsr pc,allocate
|
||||
mov r1,symp
|
||||
2:
|
||||
jsr pc,create
|
||||
mov (sp)+,r0
|
||||
1:
|
||||
mov symp,r1
|
||||
jsr pc,putchar
|
||||
rts pc
|
||||
|
||||
getcstr:
|
||||
mov cstrr,r1
|
||||
cmp r1,cstrw
|
||||
blt 1f
|
||||
clr r0 /end of string
|
||||
rts pc
|
||||
1:
|
||||
inc cstrr
|
||||
cmp r1,$cstrt
|
||||
bge 1f
|
||||
movb cstrb(r1),r0
|
||||
rts pc
|
||||
1:
|
||||
bne 1f
|
||||
mov symp,r1
|
||||
jsr pc,rewind
|
||||
1:
|
||||
mov symp,r1
|
||||
jsr pc,getchar
|
||||
rts pc
|
||||
|
||||
size:
|
||||
jsr pc,iget
|
||||
mov cstrw,(r0)
|
||||
jmp succ
|
||||
|
||||
cstrt = 16 /top of quick access current string
|
||||
.data
|
||||
symp: 0 /pointer to dynamicallly allocated current string
|
||||
cstrw: 0 /current string write pointer
|
||||
.bss
|
||||
cstrr: .=.+2 /read pointer
|
||||
cstrb: .=.+cstrt /base of quick access fragment
|
||||
@@ -0,0 +1,24 @@
|
||||
f = r5
|
||||
.globl j
|
||||
.globl classtab,jget
|
||||
.globl ctest
|
||||
.globl putcstr
|
||||
.globl succ
|
||||
|
||||
ctest:
|
||||
inc ctestc
|
||||
mov r0,-(sp)
|
||||
jsr pc,jget
|
||||
asl r0
|
||||
bit *(sp)+,classtab(r0)
|
||||
clc
|
||||
beq 1f
|
||||
asr r0
|
||||
jsr pc,putcstr
|
||||
inc j(f)
|
||||
sec
|
||||
1:
|
||||
rts pc
|
||||
|
||||
.data
|
||||
ctestc: 0
|
||||
@@ -0,0 +1,16 @@
|
||||
i = r3
|
||||
.globl putcall,iget,kput,putdec
|
||||
.globl generate,succ
|
||||
.globl decimal
|
||||
|
||||
decimal:
|
||||
mov $1f+1,r0
|
||||
jsr pc,putcall
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
jsr pc,kput
|
||||
jmp succ
|
||||
1:
|
||||
mov (i),r0
|
||||
jsr pc,putdec
|
||||
jmp generate
|
||||
@@ -0,0 +1,9 @@
|
||||
.globl release
|
||||
.globl discard
|
||||
.globl iget,succ
|
||||
|
||||
discard:
|
||||
jsr pc,iget
|
||||
mov (r0),r1
|
||||
jsr pc,release
|
||||
jmp succ
|
||||
@@ -0,0 +1,42 @@
|
||||
f=r5
|
||||
g=r4
|
||||
.globl ofile
|
||||
.globl dogen
|
||||
.globl succ
|
||||
.globl g1,k
|
||||
.globl emit
|
||||
|
||||
emit:
|
||||
mov f,-(sp)
|
||||
add $g1,(sp)
|
||||
mov g,r1
|
||||
1: /look for a translation
|
||||
cmp (sp),r1
|
||||
bge 3f /none at all
|
||||
bit -(r1),$100001
|
||||
beq 1b
|
||||
/move it to end of stak
|
||||
mov (r1)+,r0
|
||||
1:
|
||||
cmp g,r1
|
||||
ble 1f
|
||||
mov (r1),-2(r1)
|
||||
mov r0,(r1)+
|
||||
br 1b
|
||||
1:
|
||||
mov ofile,r0
|
||||
jsr pc,dogen
|
||||
mov g,r1
|
||||
1:
|
||||
cmp (sp),r1 /try to find prev value of k
|
||||
bge 1f /nothing more in this stack frame
|
||||
tst -(r1)
|
||||
bge 1b /this isnt a k pointer (negative)
|
||||
mov (r1),k(f)
|
||||
br 3f
|
||||
1:
|
||||
mov f,r0 /go back to prev stack frame
|
||||
mov k(r0),k(f)
|
||||
3:
|
||||
tst (sp)+
|
||||
jmp succ
|
||||
@@ -0,0 +1,3 @@
|
||||
.globl end
|
||||
/ the driving tables ended just before here
|
||||
end:
|
||||
@@ -0,0 +1,13 @@
|
||||
.globl .f
|
||||
.globl succ
|
||||
.globl seekchar,getword
|
||||
|
||||
.f:
|
||||
mov (sp),r0
|
||||
mov r0,6(sp)
|
||||
mov 4(sp),r1
|
||||
jsr pc,seekchar
|
||||
jsr pc,getword
|
||||
mov r0,(sp)
|
||||
mov $-1,2(sp)
|
||||
jmp succ
|
||||
@@ -0,0 +1,93 @@
|
||||
i=r3
|
||||
.globl lptr,rptr,sptr
|
||||
.globl succ,fail
|
||||
.globl iget
|
||||
.globl find,enter
|
||||
.globl seekchar,getword,getchar
|
||||
.globl putword,putchar,alterword
|
||||
.globl getcstr,rewcstr
|
||||
.globl length,rewind
|
||||
|
||||
index=0
|
||||
tablep=2
|
||||
temp=4
|
||||
which=6
|
||||
framel=10
|
||||
|
||||
find:
|
||||
mov pc,-(sp) /which(sp)
|
||||
br 1f
|
||||
enter:
|
||||
clr -(sp)
|
||||
1:
|
||||
jsr pc,rewcstr
|
||||
jsr pc,getcstr
|
||||
bne 1f
|
||||
tst (sp)+
|
||||
jmp fail
|
||||
1:
|
||||
clr -(sp) /temp(sp)
|
||||
jsr pc,iget
|
||||
mov (r0),-(sp) /tablep(sp)
|
||||
clr -(sp) /index(sp)
|
||||
|
||||
right:
|
||||
add $rptr,index(sp)
|
||||
br 1f
|
||||
left:
|
||||
add $lptr,index(sp)
|
||||
1: /get index of next entry
|
||||
mov tablep(sp),r1
|
||||
mov index(sp),r0
|
||||
jsr pc,seekchar
|
||||
jsr pc,getword
|
||||
tst r0
|
||||
beq nomore
|
||||
mov r0,index(sp)
|
||||
add $sptr,r0
|
||||
jsr pc,seekchar
|
||||
jsr pc,rewcstr
|
||||
1: /comparison loop
|
||||
mov tablep(sp),r1
|
||||
jsr pc,getchar
|
||||
mov r0,-(sp)
|
||||
jsr pc,getcstr
|
||||
cmp r0,(sp)+
|
||||
bgt right
|
||||
blt left
|
||||
tst r0
|
||||
beq found
|
||||
br 1b
|
||||
|
||||
nomore: /not in table
|
||||
tst which(sp)
|
||||
beq 1f
|
||||
tst (i)+ /exit from find
|
||||
add $framel,sp
|
||||
jmp fail
|
||||
1:
|
||||
mov tablep(sp),r1
|
||||
jsr pc,length
|
||||
mov r0,temp(sp)
|
||||
clr r0
|
||||
jsr pc,putword /scratch word
|
||||
jsr pc,putword /left pointer
|
||||
jsr pc,putword /right
|
||||
mov index(sp),r0
|
||||
jsr pc,seekchar
|
||||
mov temp(sp),r0
|
||||
mov r0,index(sp)
|
||||
jsr pc,alterword
|
||||
jsr pc,rewcstr
|
||||
1: /copy loop
|
||||
jsr pc,getcstr
|
||||
mov tablep(sp),r1
|
||||
jsr pc,putchar
|
||||
tst r0
|
||||
bne 1b
|
||||
|
||||
found:
|
||||
jsr pc,iget
|
||||
mov index(sp),(r0)
|
||||
add $framel,sp
|
||||
jmp succ
|
||||
@@ -0,0 +1,50 @@
|
||||
i = r3
|
||||
.globl putcall,kput,obuild
|
||||
.globl seekchar
|
||||
.globl getchar
|
||||
.globl outb, outw, outt
|
||||
.globl cfile, lfile, flush
|
||||
.globl iget
|
||||
.globl sptr
|
||||
.globl generate,succ
|
||||
.globl getnam
|
||||
|
||||
getnam:
|
||||
mov $1f+1,r0
|
||||
jsr pc,putcall
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
jsr pc,kput
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
jsr pc,kput
|
||||
jmp succ
|
||||
1:
|
||||
cmp cfile,lfile
|
||||
beq 1f
|
||||
jsr pc,flush
|
||||
mov cfile,lfile
|
||||
1:
|
||||
mov (i)+,r1
|
||||
mov r1,-(sp)
|
||||
mov (i)+,r0
|
||||
add $sptr,r0
|
||||
jsr pc,seekchar
|
||||
2:
|
||||
mov (sp),r1
|
||||
mov outw,r2
|
||||
1:
|
||||
jsr pc,getchar
|
||||
tst r0
|
||||
beq 1f
|
||||
movb r0,outb(r2)
|
||||
inc r2
|
||||
mov r2,outw
|
||||
cmp r2,$outt
|
||||
blt 1b
|
||||
/
|
||||
jsr pc,flush
|
||||
br 2b
|
||||
1:
|
||||
tst (sp)+
|
||||
jmp generate
|
||||
@@ -0,0 +1,9 @@
|
||||
f = r5
|
||||
.globl n
|
||||
.globl succ,iget
|
||||
.globl ignore
|
||||
|
||||
ignore:
|
||||
jsr pc,iget
|
||||
mov (r0),n(f)
|
||||
jmp succ
|
||||
@@ -0,0 +1,24 @@
|
||||
.globl succ,.u,update
|
||||
.globl .ia,.ib,.da,.db
|
||||
|
||||
/prefix ++
|
||||
.ib:
|
||||
inc (sp)
|
||||
jmp .u
|
||||
/prefix --
|
||||
.db:
|
||||
dec (sp)
|
||||
jmp .u
|
||||
/postfix++
|
||||
.ia:
|
||||
inc (sp)
|
||||
jsr pc,update
|
||||
dec (sp)
|
||||
jmp succ
|
||||
/potsfix --
|
||||
.da:
|
||||
dec (sp)
|
||||
jsr pc,update
|
||||
inc (sp)
|
||||
jmp succ
|
||||
|
||||
@@ -0,0 +1,35 @@
|
||||
.globl .p,sprv
|
||||
.globl .a,.s,.o,.n,.x
|
||||
|
||||
/ +
|
||||
.a:
|
||||
jsr pc,sprv
|
||||
add (sp),4(sp)
|
||||
br 9f
|
||||
|
||||
/ -
|
||||
.s:
|
||||
jsr pc,sprv
|
||||
sub (sp),4(sp)
|
||||
br 9f
|
||||
|
||||
/ |
|
||||
.o:
|
||||
jsr pc,sprv
|
||||
bis (sp),4(sp)
|
||||
br 9f
|
||||
|
||||
/ &
|
||||
.n:
|
||||
jsr pc,sprv
|
||||
com (sp)
|
||||
bic (sp),4(sp)
|
||||
br 9f
|
||||
|
||||
/ ^ exclusive or
|
||||
.x:
|
||||
jsr pc,sprv
|
||||
mov (sp),r0
|
||||
xor r0,4(sp)
|
||||
9:
|
||||
jmp .p
|
||||
@@ -0,0 +1,46 @@
|
||||
f = r5
|
||||
.globl j,n
|
||||
.globl input
|
||||
.globl classtab
|
||||
.globl jget
|
||||
|
||||
jget:
|
||||
inc jgetc
|
||||
3:
|
||||
mov j(f),r1
|
||||
mov r1,r0
|
||||
bic $inpt-1,r0
|
||||
bic r0,r1
|
||||
cmp r0,inpr
|
||||
beq 1f
|
||||
inc readc
|
||||
mov r0,inpr
|
||||
mov input,r0
|
||||
sys seek
|
||||
inpr: 1;0
|
||||
sys read;inpb;inpt
|
||||
2:
|
||||
cmp r0,$inpt
|
||||
bge 1f
|
||||
clrb inpb(r0)
|
||||
inc r0
|
||||
br 2b
|
||||
1:
|
||||
movb inpb(r1),r0
|
||||
asl r0
|
||||
bit n(f),classtab(r0)
|
||||
beq 1f
|
||||
inc j(f)
|
||||
inc r1
|
||||
cmp r1,$inpt
|
||||
blt 1b
|
||||
br 3b
|
||||
1:
|
||||
asr r0
|
||||
rts pc
|
||||
inpt = 128.
|
||||
.bss
|
||||
inpb: . = .+inpt
|
||||
.data
|
||||
jgetc: 0
|
||||
readc: 0
|
||||
@@ -0,0 +1,15 @@
|
||||
.globl .lv,.rv
|
||||
.globl succ
|
||||
|
||||
/ unary &
|
||||
|
||||
.lv:
|
||||
mov 2(sp),(sp)
|
||||
jmp succ
|
||||
|
||||
/ *
|
||||
|
||||
.rv:
|
||||
mov (sp),2(sp)
|
||||
mov *2(sp),(sp)
|
||||
jmp succ
|
||||
@@ -0,0 +1,26 @@
|
||||
.globl .m,.q,.r
|
||||
.globl .p,sprv
|
||||
|
||||
.m:
|
||||
jsr pc,sprv
|
||||
mov (sp),r0
|
||||
mpy 4(sp),r0
|
||||
mov r1,4(sp)
|
||||
br 1f
|
||||
|
||||
.q:
|
||||
jsr pc,sprv
|
||||
mov 4(sp),r1
|
||||
sxt r0
|
||||
dvd (sp),r0
|
||||
mov r0,4(sp)
|
||||
br 1f
|
||||
|
||||
.r:
|
||||
jsr pc,sprv
|
||||
mov 4(sp),r1
|
||||
sxt r0
|
||||
dvd (sp),r0
|
||||
mov r1,4(sp)
|
||||
1:
|
||||
jmp .p
|
||||
@@ -0,0 +1,16 @@
|
||||
i = r3
|
||||
.globl putcall,iget,kput,putoct
|
||||
.globl generate,succ
|
||||
.globl octal
|
||||
|
||||
octal:
|
||||
mov $1f+1,r0
|
||||
jsr pc,putcall
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
jsr pc,kput
|
||||
jmp succ
|
||||
1:
|
||||
mov (i),r0
|
||||
jsr pc,putoct
|
||||
jmp generate
|
||||
@@ -0,0 +1,13 @@
|
||||
f = r5
|
||||
.globl iget
|
||||
.globl env,si
|
||||
.globl succ
|
||||
.globl params
|
||||
|
||||
params:
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
asl r0
|
||||
mov env(f),r1
|
||||
add r0,si(r1)
|
||||
jmp succ
|
||||
@@ -0,0 +1,25 @@
|
||||
.globl succ
|
||||
.globl iget
|
||||
.globl push
|
||||
|
||||
push:
|
||||
jsr pc,iget
|
||||
mov (r0),r2
|
||||
mov r2,r1
|
||||
1:
|
||||
mov r1,-(sp)
|
||||
jsr pc,iget
|
||||
mov (sp)+,r1
|
||||
mov r0,-(sp)
|
||||
mov (r0),-(sp)
|
||||
dec r2
|
||||
bgt 1b
|
||||
mov r1,-(sp)
|
||||
jsr pc,succ
|
||||
/ preserve c bit from here on
|
||||
mov (sp)+,r2
|
||||
1:
|
||||
mov (sp)+,*(sp)+
|
||||
dec r2
|
||||
bgt 1b
|
||||
rts pc /pass sret or fret back to invoking rule
|
||||
@@ -0,0 +1,23 @@
|
||||
f = r5
|
||||
g = r4
|
||||
.globl k
|
||||
.globl errcom
|
||||
.globl ktab,ktat
|
||||
.globl putcall,kput
|
||||
|
||||
putcall:
|
||||
jsr pc,kput
|
||||
mov k(f),(g)+
|
||||
rts pc
|
||||
|
||||
kput:
|
||||
sub $2,k(f)
|
||||
mov k(f),r1
|
||||
neg r1
|
||||
mov r0,ktab(r1)
|
||||
cmp r1,$ktat
|
||||
bhis 1f
|
||||
rts pc
|
||||
1:
|
||||
jsr r0,errcom
|
||||
<translation overflow\0>;.even
|
||||
@@ -0,0 +1,29 @@
|
||||
.globl putch,obuild
|
||||
.globl putdec
|
||||
|
||||
putdec:
|
||||
tst r0
|
||||
bge 1f
|
||||
cmp r0,$100000
|
||||
beq 2f
|
||||
mov r0,-(sp)
|
||||
mov $'-,r0
|
||||
jsr pc,putch
|
||||
mov (sp)+,r0
|
||||
neg r0
|
||||
1:
|
||||
alsc $-16.,r0
|
||||
dvd $10.,r0
|
||||
beq 1f
|
||||
mov r1,-(sp)
|
||||
jsr pc,1b
|
||||
mov (sp)+,r1
|
||||
1:
|
||||
mov r1,r0
|
||||
add $'0,r0
|
||||
jmp putch
|
||||
2:
|
||||
mov $1f,r0
|
||||
jmp obuild
|
||||
1:
|
||||
<-32768\0>;.even
|
||||
@@ -0,0 +1,18 @@
|
||||
.globl putch,obuild
|
||||
.globl putoct
|
||||
|
||||
|
||||
putoct: mov r0,-(sp)
|
||||
bic $7,r0
|
||||
bic r0,(sp)
|
||||
clc
|
||||
ror r0
|
||||
ror r0
|
||||
ror r0
|
||||
beq 1f
|
||||
jsr pc,putoct
|
||||
1:
|
||||
mov (sp)+,r0
|
||||
add $'0,r0
|
||||
jsr pc,putch
|
||||
rts pc
|
||||
@@ -0,0 +1,38 @@
|
||||
f = r5
|
||||
i = r3
|
||||
.globl j,n
|
||||
.globl iget,jget
|
||||
.globl succ,fail
|
||||
.globl .px,.pxs
|
||||
|
||||
.pxs:
|
||||
mov i,r0
|
||||
tst (i)+
|
||||
br 1f
|
||||
.px:
|
||||
jsr pc,iget
|
||||
1:
|
||||
inc litc
|
||||
mov n(f),-(sp)
|
||||
mov j(f),-(sp)
|
||||
mov r0,-(sp)
|
||||
2:
|
||||
tstb *(sp)
|
||||
beq 2f
|
||||
jsr pc,jget
|
||||
cmpb r0,*(sp)
|
||||
beq 1f
|
||||
tst (sp)+
|
||||
mov (sp)+,j(f)
|
||||
mov (sp)+,n(f)
|
||||
jmp fail
|
||||
1:
|
||||
clr n(f)
|
||||
inc (sp)
|
||||
inc j(f)
|
||||
br 2b
|
||||
2:
|
||||
cmp (sp)+,(sp)+
|
||||
mov (sp)+,n(f)
|
||||
jmp succ
|
||||
litc: 0
|
||||
@@ -0,0 +1,45 @@
|
||||
.globl .p,sprv
|
||||
.globl .eq,.ne,.lt,.le,.gt,.ge
|
||||
|
||||
.eq:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
beq true
|
||||
br false
|
||||
|
||||
.ne:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
bne true
|
||||
br false
|
||||
.lt:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
blt true
|
||||
br false
|
||||
|
||||
.le:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
ble true
|
||||
br false
|
||||
|
||||
.gt:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
bgt true
|
||||
br false
|
||||
|
||||
.ge:
|
||||
jsr pc,sprv
|
||||
cmp 4(sp),(sp)
|
||||
bge true
|
||||
br false
|
||||
|
||||
true:
|
||||
mov $1,4(sp)
|
||||
jmp .p
|
||||
|
||||
false:
|
||||
clr 4(sp)
|
||||
jmp .p
|
||||
@@ -0,0 +1,14 @@
|
||||
.globl .p,sprv
|
||||
.globl .sr,.sl
|
||||
|
||||
/ >>
|
||||
.sr:
|
||||
neg (sp)
|
||||
|
||||
/ <<
|
||||
.sl:
|
||||
mov 4(sp),r1
|
||||
clr r0
|
||||
alsc (sp),r0
|
||||
mov r1,4(sp)
|
||||
jmp .p
|
||||
@@ -0,0 +1,76 @@
|
||||
/ builtins for shift-reduce parsking
|
||||
f = r5
|
||||
i = r3
|
||||
g = r4
|
||||
.globl succ,pbundle,goto,iget
|
||||
.globl g1
|
||||
.globl stack,unstack,gotab,accept
|
||||
|
||||
/stack label of present rule (state)
|
||||
/should come first in a rule
|
||||
|
||||
stack:
|
||||
mov i,(g)
|
||||
sub $2,(g)+
|
||||
jmp succ
|
||||
|
||||
/unstack(n) deletes last n stacked states
|
||||
/states are distinguishable from translations in not having
|
||||
/an exit bit ($1) nor being bundles ($100000)
|
||||
unstack:
|
||||
jsr pc,iget
|
||||
mov (r0),r0
|
||||
mov g,r1
|
||||
1:
|
||||
bit -(r1),$100001
|
||||
bne 1b
|
||||
dec r0
|
||||
bge 1b
|
||||
tst (r1)+
|
||||
br 1f
|
||||
|
||||
accept: /clean out all states from stack
|
||||
mov f,r1
|
||||
add $g1,r1
|
||||
1:
|
||||
mov r1,r0
|
||||
mov r1,-(sp)
|
||||
1:
|
||||
cmp r1,g
|
||||
bge 2f
|
||||
bit (r1)+,$100001
|
||||
beq 1b
|
||||
mov -2(r1),(r0)+
|
||||
br 1b
|
||||
2:
|
||||
mov r0,g
|
||||
mov (sp)+,r0
|
||||
jsr pc,pbundle
|
||||
tst r0
|
||||
beq 1f
|
||||
mov r0,(g)+
|
||||
1:
|
||||
jmp succ
|
||||
|
||||
/gotab(s1,t1,s2,t2,...sn,tn,0,t)
|
||||
/checks top of stack for states
|
||||
/s1,s2,... and goes to t1, t2 accordingly
|
||||
/if top of stack is not in table, goes to t
|
||||
|
||||
gotab:
|
||||
mov g,r0
|
||||
1:
|
||||
bit -(r0),$100001 /find top state
|
||||
bne 1b
|
||||
mov (r0),-(sp)
|
||||
1:
|
||||
jsr pc,iget
|
||||
tst (r0)
|
||||
beq 1f
|
||||
cmp (sp),r0
|
||||
beq 1f
|
||||
jsr pc,iget
|
||||
br 1b
|
||||
1:
|
||||
tst (sp)+
|
||||
jmp goto
|
||||
@@ -0,0 +1,18 @@
|
||||
f = r5
|
||||
i = r3
|
||||
.globl j
|
||||
.globl succ
|
||||
.globl ctest,iget
|
||||
.globl string
|
||||
|
||||
string:
|
||||
tst -(sp)
|
||||
jsr pc,iget
|
||||
1:
|
||||
mov j(f),(sp)
|
||||
mov r0,-(sp)
|
||||
jsr pc,ctest
|
||||
mov (sp)+,r0
|
||||
bcs 1b
|
||||
mov (sp)+,j(f)
|
||||
jmp succ
|
||||
@@ -0,0 +1,17 @@
|
||||
.globl allocate,putword,putchar
|
||||
.globl iget
|
||||
.globl succ
|
||||
.globl table
|
||||
|
||||
table:
|
||||
mov $10,r0
|
||||
jsr pc,allocate
|
||||
mov r1,-(sp)
|
||||
clr r0
|
||||
jsr pc,putword
|
||||
jsr pc,putword
|
||||
jsr pc,putword
|
||||
jsr pc,putchar
|
||||
jsr pc,iget
|
||||
mov (sp)+,(r0)
|
||||
jmp succ
|
||||
@@ -0,0 +1,28 @@
|
||||
f = r5
|
||||
i = r3
|
||||
.globl ek,ep,ek.fs,ep.fs,si,x,fs
|
||||
.globl generate
|
||||
.globl .tq,gpar
|
||||
|
||||
.tq:
|
||||
mov (i)+,r0
|
||||
mov i,si(f)
|
||||
mov ep(f),r1
|
||||
mov ep(r1),ep.fs(f)
|
||||
mov ek(r1),ek.fs(f)
|
||||
mov si(r1),r1
|
||||
asl r0
|
||||
sub r0,r1
|
||||
mov (r1),i
|
||||
add $fs,f
|
||||
clr x(f)
|
||||
jsr pc,generate
|
||||
jmp generate
|
||||
|
||||
gpar:
|
||||
mov (i)+,r0
|
||||
mov ep(f),r1
|
||||
asl r0
|
||||
add r0,si(r1)
|
||||
jmp generate
|
||||
.globl gq;gq=.tq
|
||||
@@ -0,0 +1,14 @@
|
||||
i = r3
|
||||
.globl putch,putoct
|
||||
.globl trswitch
|
||||
.globl trace
|
||||
|
||||
trace:
|
||||
jsr pc,putch
|
||||
mov i,r0
|
||||
jsr pc,putoct
|
||||
mov $'\n,r0
|
||||
jsr pc,putch
|
||||
rts pc
|
||||
.data
|
||||
trswitch: 0
|
||||
@@ -0,0 +1,8 @@
|
||||
g = r4
|
||||
.globl succ,iget
|
||||
.globl trans
|
||||
|
||||
trans:
|
||||
jsr pc,iget
|
||||
mov r0,(g)+
|
||||
jmp succ
|
||||
@@ -0,0 +1,14 @@
|
||||
i = r3
|
||||
.globl generate
|
||||
.globl obuild
|
||||
.globl .tx,.txs
|
||||
|
||||
.txs:
|
||||
mov i,r0
|
||||
tst (i)+
|
||||
br 1f
|
||||
.tx:
|
||||
mov (i)+,r0
|
||||
1:
|
||||
jsr pc,obuild
|
||||
jmp generate
|
||||
@@ -0,0 +1,27 @@
|
||||
.globl succ
|
||||
.globl .ng,.nt,.cm
|
||||
|
||||
/ !
|
||||
|
||||
.nt:
|
||||
tst (sp)
|
||||
beq 1f
|
||||
clr (sp)
|
||||
br 9f
|
||||
1:
|
||||
mov $1,(sp)
|
||||
br 9f
|
||||
|
||||
/unary -
|
||||
|
||||
.ng:
|
||||
neg (sp)
|
||||
br 9f
|
||||
|
||||
/ ~
|
||||
|
||||
.cm:
|
||||
com (sp)
|
||||
|
||||
9:
|
||||
jmp succ
|
||||
@@ -0,0 +1,71 @@
|
||||
/ tmg tables and global definitions
|
||||
|
||||
/ in addition to these definitions each routine
|
||||
/ follows the convention
|
||||
/ f = stack frame pointer during parse and translation
|
||||
/ g = stack frame end during parse
|
||||
/ i = interprested instruction counter during parse and translation
|
||||
|
||||
.globl tables
|
||||
.globl x,si,j,k,n,g1,env
|
||||
.globl ek,ek.fs,ep,ep.fs,fs
|
||||
.globl lptr,sptr,rptr
|
||||
.globl outb,outt,outw
|
||||
.globl stkt,stkb,stke
|
||||
.globl ktat,ktab
|
||||
.globl input,cfile,lfile,dfile,ofile
|
||||
|
||||
/ parse stack frame layout
|
||||
/ 0 is previous frame pointer
|
||||
/ return address in (sp)
|
||||
x = 2. /exit bit, nonzero at end of rule
|
||||
si = 4. / save location for instruction counter
|
||||
j = 6. / input cursor counts characters
|
||||
k = 8. / ktable water mark, last use location relative to base
|
||||
n = 10. /address of ignored character class
|
||||
env = 12. / frame pointer for static environment
|
||||
g1 = 14. / frame length during parse
|
||||
|
||||
/symbol table entry layout
|
||||
/word 0 is for customer
|
||||
lptr=2. /index of next entry on tree to left
|
||||
rptr=4. /index of next entry to right
|
||||
sptr=6. /first character of string in this entry
|
||||
/next char is in 7, etc
|
||||
|
||||
/ translation frame layout
|
||||
/ used as ek(f), ep(f), etc
|
||||
/ x and si have same meaning as in parse stack frame
|
||||
/ return address in (sp)
|
||||
ek = 0 / k environment, frame where bunlde address is in si
|
||||
ep = 6 / p environment, frame where si points to parameter list
|
||||
fs = 10 / frame size
|
||||
ek.fs = ek+fs / k environment in next frame
|
||||
ep.fs = ep+fs / p env in next frame
|
||||
|
||||
.data
|
||||
|
||||
tables = . /marks break between routines and tables
|
||||
|
||||
outt = 64. / output buffer top
|
||||
stkt = 800. /stack top for (f), not for (sp)
|
||||
ktat = 1200. / k table top
|
||||
|
||||
|
||||
input: -1 / stream number of input
|
||||
cfile: 1 / stream number of current output
|
||||
lfile: 1 / last current output
|
||||
dfile: 2 / diagnostic file
|
||||
ofile: 1 /output file
|
||||
|
||||
|
||||
outw: 0 / output write pointer, number of chars in buffer
|
||||
.bss
|
||||
outb: .=.+outt /output buffer
|
||||
|
||||
|
||||
|
||||
ktab: . = .+ktat / contains translation rules that have been bundled
|
||||
|
||||
stkb: . = .+stkt / stack, (f) ponts into this
|
||||
stke = . /stack end
|
||||
+2098
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,324 @@
|
||||
begin: ignore(blanks)
|
||||
pr1: comment\pr1
|
||||
parse(first)\pr2
|
||||
diag(error)
|
||||
pr2: comment\pr2
|
||||
parse(line)\pr2
|
||||
diag(error)\pr2
|
||||
putcharcl
|
||||
parse(last);
|
||||
|
||||
first: parse(( fref = {<1 > 1 *}))
|
||||
getfref line = { 2<:> 1 };
|
||||
|
||||
error: smark ignore(none) any(!<<>>) string(!<<;>>) scopy
|
||||
( <;> = {<;>} | null )
|
||||
= { * <??? > 2 1 * };
|
||||
|
||||
line:
|
||||
labels
|
||||
( charcl <;>
|
||||
| statement
|
||||
| numbers
|
||||
| trule <;> )
|
||||
= { 2 * 1 * };
|
||||
|
||||
numbers: number <;> numbers/done = { 2 * 1 };
|
||||
|
||||
labels: label labels/done = { 2 * 1 };
|
||||
|
||||
label: name <:> = { 1 <:> };
|
||||
|
||||
last: = { <.pn:1 .pxs;12> *
|
||||
<.tn:1 .txs;12> * };
|
||||
|
||||
comment: </*>
|
||||
co1: ignore(!<<*>>) <*> ignore(none) </>/co1;
|
||||
|
||||
statement: [csym=0] oldtab(dtt) oldtab(pat)
|
||||
( proc plst tlst <)> = (1){2 1 }
|
||||
| = (1){} noelem )
|
||||
stt1: bundle ( frag = (1){ 2(nil) * 1(q1) }\stt1
|
||||
| <;> ( ifelem = { 1(xbit) }
|
||||
| ={ 1(nil) * <1 succ> }
|
||||
) );
|
||||
|
||||
proc: smark ignore(none) <proc(>;
|
||||
|
||||
plst: list(pident)/null remote((octal(npa)))
|
||||
= { <params;> 1 * };
|
||||
|
||||
pident: ident newtab(pat,npa);
|
||||
|
||||
tlst: <;>/null [i=0] list((name [i++])) remote((octal(i)))
|
||||
= { <push;> 1 * 2 * };
|
||||
|
||||
frag: prule = (1){ 1(nil,q1) }
|
||||
| labels noelem = (1){ 1 };
|
||||
|
||||
/*in sequel q2 is where to go on fail,q1 is exit bit*/
|
||||
|
||||
prule: [sndt=ndt] disj
|
||||
( <|> [ndt=sndt] fref
|
||||
( ifeasy prule = (2){3(nil,nil)*<salt;>2*
|
||||
1(q2,q1)*2<:>}
|
||||
| prule fref = (2){4({*<alt;>1},q1)*<goto;>3*
|
||||
1<:>2(q2,q1)*3<:>} )
|
||||
noelem
|
||||
| () );
|
||||
|
||||
disj: pelem pdot
|
||||
( disj = (2){2(q2,nil) * 1(nil,q1)} ifelem/done ishard
|
||||
| () );
|
||||
|
||||
pelem: pprim = (2){1(q1)$2} iseasy
|
||||
| <(> push(1,sndt)
|
||||
( prule <)>
|
||||
| <)> = (2){} noelem );
|
||||
|
||||
pprim: ( special
|
||||
| rname ( <:> fail
|
||||
| (spdot|()) ignore(none)
|
||||
( <(> ignore(blanks) list(parg) <)>
|
||||
= (1){$1 2 * 1}
|
||||
| = (1){$1 1} )))
|
||||
( (</> = {<alt;>} | <\>={<salt;>})
|
||||
rname = (1){3(nil)*$1 2 1}
|
||||
| () );
|
||||
|
||||
pdot: <.>/done ignore(none) ident\alias
|
||||
([dtt?] | table(dtt) [ndt=0]) [ndt++];
|
||||
spdot: <.> ignore(none) not(( any(letter) ))
|
||||
alias: newtab(dtt,ndt);
|
||||
|
||||
parg: rname | remote(specparg);
|
||||
|
||||
specparg: number
|
||||
| charcl
|
||||
| <<> longlit
|
||||
| <*> = { <\n\0> }
|
||||
| <(> ( <)> = {<1 succ>}
|
||||
| push(3,dtt,ndt,sndt) [dtt=0]
|
||||
prule <)> oldtab(dtt)
|
||||
( ifelem = {1(nil,xbit) }
|
||||
| = {1(nil,nil)*<1 succ>}
|
||||
) );
|
||||
|
||||
iseasy: [easy = 1];
|
||||
ishard: [easy = 0];
|
||||
noelem: [easy = 2];
|
||||
ifelem: [easy!=2?];
|
||||
ifeasy: [easy==1?];
|
||||
|
||||
special: <=> (rname | remote(trule))
|
||||
= (1){ $1 <trans;1 > 1 }
|
||||
| <<> literal = (1){ $1 <.px> 1 }
|
||||
| <*> = (1){ $1 <.pn> }
|
||||
| <[> expr
|
||||
( <?> = {<.t>}
|
||||
| = {<.p>} )
|
||||
<]> = (1){ 2 * $1 1 };
|
||||
|
||||
rname: ( name tabval(pat,npa)/done
|
||||
| <$> number )
|
||||
= { <[-> 1 <\<1]> };
|
||||
|
||||
trule: oldtab(ptt)
|
||||
( tbody
|
||||
| <(> (number|tra) <)> tbody = {<gpar;> 2 * 1 } );
|
||||
tra: list(tident) octal(npt);
|
||||
|
||||
tident: ident newtab(ptt,npt);
|
||||
|
||||
tbody: <{> ( <}> = { <1 generate> }
|
||||
| trb);
|
||||
trb: telem ( <}> = { xbit 1 }
|
||||
| trb = { 2 * 1 } );
|
||||
|
||||
telem: <<> literal = { <.tx> 1 }
|
||||
| <*> = {<.tn>}
|
||||
| <$> number = { <.tq;> 1 }
|
||||
| number tdot = tpt
|
||||
| name te1\done te2\done;
|
||||
|
||||
te1: tabval(dtt,ndt) tdot = tpt;
|
||||
te2: tabval(ptt,npt) = {<.tq;>1};
|
||||
|
||||
tdot: (<.> number | ={<0>})
|
||||
( <(> list(targ) <)> | null)
|
||||
= { 2 <;> 1 };
|
||||
|
||||
targ: name|remote(tbody);
|
||||
|
||||
tpt: { <.tp;.byte > 2 <,> 1 };
|
||||
|
||||
literal: ( shortlit
|
||||
| remote(longlit) = { <;> 1} );
|
||||
|
||||
shortlit: ignore(none) smark any(litch) <>> scopy = { <s;'> 1 };
|
||||
|
||||
longlit: ignore(none) (<>> = { <\> <>> } | null) litb <>>
|
||||
= { <<> 2 1 <\0> <>;.even> };
|
||||
|
||||
litb: smark string(litch) scopy <\>/done
|
||||
litb = { 2 <\\> 1 };
|
||||
|
||||
expr: assignment | rv ;
|
||||
|
||||
assignment: lv assign expr = { 3 * 1 * 2 };
|
||||
|
||||
rv: prime
|
||||
rv1: bundle ( infix prime = { 3 * 1 * 2 }\rv1
|
||||
| rva = { 2 * 1 }
|
||||
| () );
|
||||
rva: <?> rv <:> rv fref fref
|
||||
= { <.t;alt;> 2 * 4 * <salt;> 1 * 2 <:> 3 * 1 <:> };
|
||||
|
||||
prime:
|
||||
lv suffix/done = { 2 * 1 }
|
||||
| prefix lv = { 1 * 2 }
|
||||
| <(> expr <)>
|
||||
| unary prime = { 1 * 2 }
|
||||
| remote(number) = { <.l;> 1 };
|
||||
|
||||
lv: ( rname = { <.l;> 1 }
|
||||
| <(> lv <)>
|
||||
| <*> prime = { 1 * <.rv> } )
|
||||
lv1: <[>/done bundle expr <]> = { 2 * 1 * <.f> }\lv1;
|
||||
|
||||
assign: <=> ignore(none) ( infix = { 1 * <.u> }
|
||||
| = { <.st> } );
|
||||
|
||||
infix: smark ignore(none)
|
||||
( <+> not((<+> not((<+>)) )) = {<.a>}
|
||||
| <-> = {<.s>}
|
||||
| <*> = {<.m>}
|
||||
| </> = {<.q>}
|
||||
| <%> = {<.r>}
|
||||
| <|> = {<.o>}
|
||||
| <^> = {<.x>}
|
||||
| <&> = {<.n>}
|
||||
| <==> = {<.eq>}
|
||||
| <!=> = {<.ne>}
|
||||
| <<=> = {<.le>}
|
||||
| <>=> = {<.ge>}
|
||||
| <<<> = {<.sl>}
|
||||
| <<> = {<.lt>}
|
||||
| <>> ( <>> = {<.sr>}
|
||||
| = {<.gt>} )
|
||||
);
|
||||
|
||||
prefix: smark ignore(none)
|
||||
( <&> = {<.lv>}
|
||||
| <++> = {<.ib>}
|
||||
| <--> = {<.db>}
|
||||
);
|
||||
|
||||
suffix: smark ignore(none)
|
||||
( <++> = {<.ia>}
|
||||
| <--> = {<.da>}
|
||||
);
|
||||
|
||||
unary: ( <!> = {<.nt>}
|
||||
| <-> = {<.ng>}
|
||||
| <~> = {<.cm>}
|
||||
);
|
||||
|
||||
charcl:
|
||||
( <!> ccla cclb | ccla )
|
||||
octal(classmask);
|
||||
ccla: (<<<>) [classmask = 1<<nclass++] [classmask?]/cherr
|
||||
ccl1: cclc <<<>\ccl1;
|
||||
cclc: ignore(none)
|
||||
|
||||
ccl3: <>>\ccl4 ccle\ccl3;
|
||||
ccl4: (<>> | cclx fail) (not((<>>)) | ccle);
|
||||
ccle: char(n) [*(2*n+&classes) =| classmask];
|
||||
cclb: zeron
|
||||
ccl5: [*(&classes+n) =^ classmask] testn\ccl5;
|
||||
cclx: [nclass--] zeron
|
||||
ccl6: [*(&classes+n) =& ~classmask] testn\ccl6;
|
||||
cherr: diag(( ={<too many char classes>} ));
|
||||
|
||||
zeron: [n=0];
|
||||
testn: [(n=+2)<400?];
|
||||
|
||||
putcharcl: zeron [classes=0]
|
||||
parse(( = { * <.globl classtab> * <classtab:> * } ))
|
||||
ptc1: [w = *(&classes+n)] parse((octal(w) = {1*}))
|
||||
bundle testn\ptc1;
|
||||
|
||||
classmask: 0;
|
||||
nclass: 0;
|
||||
classes:
|
||||
cl1: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl2: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl3: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl4: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl5: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl6: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl7: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
cl8: 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;
|
||||
|
||||
done: ;
|
||||
|
||||
create: [csym++]
|
||||
getcsym: octal(csym) = {<.> 1};
|
||||
|
||||
fref: [fsym++]
|
||||
getfref: octal(fsym) = { <..> 1 };
|
||||
|
||||
not: params(1) $1/done fail;
|
||||
|
||||
list: params(1) $1
|
||||
list1: bundle <,>/done $1 = { 2 * 1 }\list1;
|
||||
|
||||
remote: params(1) create parse(rem1,$1);
|
||||
rem1: params(1) getcsym $1 = { 2 <=.> * 1 * };
|
||||
|
||||
number: smark ignore(none) any(digit) string(digit) scopy;
|
||||
|
||||
name: ident scopy;
|
||||
|
||||
ident: smark ignore(none) any(letter) string(alpha);
|
||||
|
||||
oldtab: params(1) [$1?]/done discard($1) [$1=0];
|
||||
|
||||
newtab: params(2) ([$2?] | table($2) [$1=0])
|
||||
enter($2,i) [$2[i] = $1++];
|
||||
|
||||
tabval: params(2) [$2?] find($2,i) [i=$1-$2[i]] octal(i);
|
||||
|
||||
null: = nil;
|
||||
|
||||
xbit: {<1 >};
|
||||
|
||||
q1: { $1 };
|
||||
q2: { $2 };
|
||||
|
||||
nil: {};
|
||||
|
||||
blanks: <<
|
||||
>>;
|
||||
digit: <<0123456789>>;
|
||||
letter: <<abcdefghijklmnopqrstuvwxyz>>
|
||||
<<ABCDEFGHIJKLMNOPQRSTUVWXYZ>>;
|
||||
alpha: <<0123456789>>
|
||||
<<abcdefghijklmnopqrstuvwxyz>>
|
||||
<<ABCDEFGHIJKLMNOPQRSTUVWXYZ>>;
|
||||
litch: !<<\>>>;
|
||||
none: <<>>;
|
||||
|
||||
csym: 0;
|
||||
fsym: 0;
|
||||
easy: 0;
|
||||
w: 0;
|
||||
n: 0;
|
||||
dtt: 0; /*delivered translation table*/
|
||||
ndt: 0; /*numb of delivered translations*/
|
||||
sndt: 0; /*saved ndt at beginning of disjunctive term*/
|
||||
pat: 0; /*parsing rule parameter table*/
|
||||
npa: 0; /*number of parsing rule params*/
|
||||
ptt: 0; /*table of params of translation*/
|
||||
npt: 0; /*number of params of translation*/
|
||||
i: 0;
|
||||
Reference in New Issue
Block a user