Add original unix v6
This commit is contained in:
memnoth
@@ -0,0 +1,53 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fhd -- data segment header
|
||||
/
|
||||
|
||||
symsize = 1600.
|
||||
linsize = 800.
|
||||
namsize = 1200.
|
||||
smblsize = 399.
|
||||
|
||||
intcon = 4\<8+1 / type of integer constant
|
||||
realcon = 4\<8+2
|
||||
logcon = 2\<8+3 / type of logical constant
|
||||
log1con = 1\<8+3
|
||||
int1con = 1\<8+1
|
||||
int2con = 2\<8+1
|
||||
dblcon = 10\<8+2
|
||||
dcplxcon = 20\<8+4
|
||||
cplxcon = 10\<8+4
|
||||
|
||||
.globl data
|
||||
.globl ibuf
|
||||
.globl obuf
|
||||
.globl tbuf
|
||||
.globl line
|
||||
.globl eline
|
||||
.globl ifno
|
||||
.globl efno
|
||||
.globl errp
|
||||
.globl errb
|
||||
.globl eerrb
|
||||
.globl symtab
|
||||
.globl esymtab
|
||||
.globl esymp
|
||||
.globl symtp
|
||||
.globl namebuf
|
||||
.globl enamebuf
|
||||
.globl namep
|
||||
.globl symbuf
|
||||
.globl esymbuf
|
||||
.globl ch
|
||||
.globl ch1
|
||||
.globl progt
|
||||
.globl holquo
|
||||
.globl nxtaloc
|
||||
.globl imptab
|
||||
.globl nerror
|
||||
.globl temp
|
||||
.globl functm
|
||||
.globl edata
|
||||
.globl dsize
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx1 -- utility
|
||||
|
||||
.globl lookup
|
||||
/ lookup
|
||||
/ lookup string pointed at by r2
|
||||
/ in table pointed at by arg1
|
||||
/ r0 returns symbol number*2
|
||||
/ r2 is advanced by matched string
|
||||
/ registers used: r0,r2
|
||||
lookup:
|
||||
mov r1,-(sp)
|
||||
clr r0
|
||||
mov r2,-(sp)
|
||||
mov (r5)+,r1
|
||||
1:
|
||||
mov (sp),r2
|
||||
tstb (r1)
|
||||
beq 1f
|
||||
2:
|
||||
cmpb (r2)+,(r1)+
|
||||
bne 2f
|
||||
tstb (r1)
|
||||
bne 2b
|
||||
asl r0
|
||||
cmp (r5)+,(sp)+
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
2:
|
||||
tstb (r1)+
|
||||
bne 2b
|
||||
inc r0
|
||||
br 1b
|
||||
1:
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,134 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx2 -- error setting and printing
|
||||
|
||||
.globl error
|
||||
.globl perror
|
||||
|
||||
.globl tput
|
||||
.globl tdecml
|
||||
|
||||
error:
|
||||
inc nerror
|
||||
mov r0,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov (r5)+,r0
|
||||
mov $errb,r2
|
||||
1:
|
||||
cmp r2,errp
|
||||
bhis 1f
|
||||
cmp r0,(r2)+
|
||||
beq 2f
|
||||
tst (r2)+
|
||||
br 1b
|
||||
1:
|
||||
cmp r2,$eerrb
|
||||
bhis 2f
|
||||
mov r0,(r2)+
|
||||
mov r1,(r2)
|
||||
dec (r2)+ / r1 is often 1 too far
|
||||
mov r2,errp
|
||||
2:
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r0
|
||||
rts r5
|
||||
|
||||
perror:
|
||||
cmp errp,$errb
|
||||
beq 1f
|
||||
mov r1,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov ifno,r0
|
||||
jsr r5,tdecml
|
||||
mov $'\t,r0
|
||||
jsr r5,tput
|
||||
mov $line,r1
|
||||
2:
|
||||
movb (r1),r0
|
||||
beq 2f
|
||||
jsr r5,tput
|
||||
mov $errb+2,r2
|
||||
3:
|
||||
cmp r1,(r2)+
|
||||
bne 4f
|
||||
mov $1,r0
|
||||
sys write; mes2; 2 / bs, _
|
||||
br 3f
|
||||
4:
|
||||
cmp r2,errp
|
||||
blo 3b
|
||||
3:
|
||||
inc r1
|
||||
br 2b
|
||||
2:
|
||||
mov $errb,r1
|
||||
2:
|
||||
mov $1,r0
|
||||
sys write; mes1; 4
|
||||
3:
|
||||
sys open; errfil; 0
|
||||
bec 3f
|
||||
mov (r1)+,r0
|
||||
tst (r1)+
|
||||
jsr r5,tdecml
|
||||
cmp r1,errp
|
||||
bhis 2f
|
||||
mov $',,r0
|
||||
jsr r5,tput
|
||||
br 3b
|
||||
3:
|
||||
mov r0,-(sp)
|
||||
mov (r1)+,r2
|
||||
tst (r1)+
|
||||
3:
|
||||
dec r2
|
||||
ble 3f
|
||||
4:
|
||||
mov (sp),r0
|
||||
sys read; ich; 1
|
||||
bes 4f
|
||||
tst r0
|
||||
beq 4f
|
||||
cmpb ich,$'\n
|
||||
bne 4b
|
||||
br 3b
|
||||
3:
|
||||
mov (sp),r0
|
||||
sys read; ich; 1
|
||||
bes 4f
|
||||
tst r0
|
||||
beq 4f
|
||||
movb ich,r0
|
||||
cmp r0,$'\n
|
||||
beq 3f
|
||||
jsr r5,tput
|
||||
br 3b
|
||||
4:
|
||||
mov $1,r0
|
||||
sys write; mes3; 18.
|
||||
3:
|
||||
mov (sp)+,r0
|
||||
sys close
|
||||
cmp r1,$errp
|
||||
blo 2b
|
||||
2:
|
||||
mov $'\n,r0
|
||||
jsr r5,tput
|
||||
mov $errb,errp
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r1
|
||||
1:
|
||||
rts r5
|
||||
|
||||
mes1:
|
||||
<\n** >
|
||||
mes2:
|
||||
.byte 010, '_
|
||||
mes3:
|
||||
<Unknown diagnostic>
|
||||
errfil:
|
||||
</usr/fort/errors\0>
|
||||
.even
|
||||
.bss
|
||||
ich: .=.+2
|
||||
@@ -0,0 +1,49 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx3 -- get integer
|
||||
|
||||
.globl geti
|
||||
.globl ptemp
|
||||
|
||||
.globl putc
|
||||
.globl putw
|
||||
|
||||
geti:
|
||||
mov r1,-(sp)
|
||||
mov r3,-(sp)
|
||||
clr r3
|
||||
mov $symbuf,r0
|
||||
1:
|
||||
movb (r0)+,r1
|
||||
sub $'0,r1
|
||||
cmp r1,$9
|
||||
bhi 1f
|
||||
mpy $10.,r3
|
||||
add r1,r3
|
||||
br 1b
|
||||
1:
|
||||
mov r3,r0
|
||||
mov (sp)+,r3
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
|
||||
ptemp:
|
||||
mov r0,-(sp)
|
||||
mov r1,-(sp)
|
||||
mov (r5)+,r0 / character
|
||||
jsr r5,putc; tbuf
|
||||
mov *(r5)+,r0 / word
|
||||
jsr r5,putw; tbuf
|
||||
mov ifno,r0
|
||||
jsr r5,putw; tbuf
|
||||
mov (r5)+,r1 / string
|
||||
1:
|
||||
movb (r1),r0
|
||||
jsr r5,putc; tbuf
|
||||
tstb (r1)+
|
||||
bne 1b
|
||||
mov (sp)+,r1
|
||||
mov (sp)+,r0
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,364 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx4 -- get symbol
|
||||
|
||||
.globl getsym
|
||||
.globl getid
|
||||
.globl lookid
|
||||
.globl chrtab
|
||||
|
||||
.globl lookup
|
||||
.globl error
|
||||
.globl geti
|
||||
.globl holround
|
||||
/ getsym returns the next basic symbol
|
||||
|
||||
/ 0 name (symbol table entry in r3)
|
||||
/ 2 number (type in r3)
|
||||
/ 4 **
|
||||
/ 6 /
|
||||
/ 8 *
|
||||
/ 10 -
|
||||
/ 12 +
|
||||
/ 14 .lt.
|
||||
/ 16 .le.
|
||||
/ 18 .eq.
|
||||
/ 20 .ne.
|
||||
/ 22 .gt.
|
||||
/ 24 .ge.
|
||||
/ 26 .not.
|
||||
/ 28 .and.
|
||||
/ 30 .or.
|
||||
/ 32 (
|
||||
/ 34 )
|
||||
/ 36 ,
|
||||
/ 38 =
|
||||
/ 40 =|
|
||||
/
|
||||
getsym:
|
||||
mov r2,-(sp)
|
||||
mov r1,r2
|
||||
jsr r5,lookup; bastab
|
||||
br 1f
|
||||
mov r2,r1
|
||||
cmp r0,$4
|
||||
bhis 2f
|
||||
asr r0
|
||||
add $'0,r0
|
||||
movb r0,symbuf
|
||||
movb $12,symbuf+1
|
||||
clrb symbuf+2
|
||||
mov $logcon,r3 / logical*2
|
||||
mov $2,r0
|
||||
2:
|
||||
cmp r0,$32.
|
||||
bne 2f
|
||||
|
||||
/ check for possible complex constant
|
||||
|
||||
mov r1,-(sp)
|
||||
movb -2(r1),r0
|
||||
movb chrtab(r0),r0
|
||||
beq 4f
|
||||
cmp r0,$4
|
||||
blos 3f
|
||||
4:
|
||||
jsr r5,srconst
|
||||
br 3f
|
||||
mov r3,r2
|
||||
cmpb (r1)+,$',
|
||||
bne 3f
|
||||
jsr r5,srconst
|
||||
br 3f
|
||||
cmp r3,r2
|
||||
bhis 4f
|
||||
mov r2,r3
|
||||
4:
|
||||
cmpb (r1)+,$')
|
||||
bne 3f
|
||||
mov (sp)+,r1
|
||||
mov $symbuf,r2
|
||||
4:
|
||||
movb (r1)+,(r2)
|
||||
cmpb (r2)+,$')
|
||||
bne 4b
|
||||
clrb -(r2)
|
||||
mov $2,r0
|
||||
br 2f
|
||||
3:
|
||||
mov (sp)+,r1
|
||||
mov $32.,r0
|
||||
2:
|
||||
mov (sp)+,r2
|
||||
rts r5
|
||||
1:
|
||||
clr lstchr
|
||||
cmp r1,$line
|
||||
blos 1f
|
||||
movb -1(r1),lstchr
|
||||
1:
|
||||
mov $symbuf,r2
|
||||
movb (r1)+,r0
|
||||
movb r0,(r2)+
|
||||
bic $!177,r0
|
||||
movb chrtab(r0),r0
|
||||
jmp *1f(r0)
|
||||
1:
|
||||
eos
|
||||
let
|
||||
num
|
||||
per
|
||||
|
||||
eos:
|
||||
mov $40.,r0
|
||||
tstb -(r1)
|
||||
beq 2b
|
||||
jsr r5,error; 8.
|
||||
br 2b
|
||||
|
||||
let:
|
||||
dec r1
|
||||
jsr r5,getid
|
||||
br .+2 / cannot happen
|
||||
jsr r5,lookid; symbuf
|
||||
mov (sp)+,r2
|
||||
clr r0
|
||||
rts r5
|
||||
|
||||
num:
|
||||
mov $intcon,r3 / integer*4
|
||||
jsr r5,numst
|
||||
cmpb (r1),$'.
|
||||
bne 2f
|
||||
mov r2,-(sp)
|
||||
mov r1,r2
|
||||
jsr r5,lookup; bastab
|
||||
br 1f
|
||||
mov (sp)+,r2
|
||||
br 3f
|
||||
1:
|
||||
mov (sp)+,r2
|
||||
movb (r1)+,(r2)+
|
||||
br 1f
|
||||
2:
|
||||
cmpb (r1),$'h / hollerith const?
|
||||
bne 2f
|
||||
mov lstchr,r0
|
||||
cmpb chrtab(r0),$2 / letter?
|
||||
beq 2f / not h, then
|
||||
cmp r0,$'*
|
||||
beq 2f / e.g. real*4 h...
|
||||
clrb (r2)
|
||||
jsr r5,geti
|
||||
mov $symbuf,r2
|
||||
inc r1
|
||||
mov holround,-(sp)
|
||||
dec (sp)
|
||||
clr -(sp)
|
||||
4:
|
||||
movb (r1)+,(r2)+
|
||||
bne 5f
|
||||
jsr r5,error; 55.
|
||||
br 6f
|
||||
5:
|
||||
inc (sp)
|
||||
dec r0
|
||||
bgt 4b
|
||||
6:
|
||||
bit (sp),2(sp)
|
||||
beq 6f
|
||||
movb $' ,(r2)+
|
||||
inc (sp)
|
||||
br 6b
|
||||
6:
|
||||
mov (sp)+,r3
|
||||
tst (sp)+
|
||||
swab r3
|
||||
clrb r3
|
||||
bis $5,r3
|
||||
mov $2,r0
|
||||
mov (sp)+,r2
|
||||
rts r5
|
||||
|
||||
.bss
|
||||
lstchr: .=.+2
|
||||
.text
|
||||
|
||||
per:
|
||||
jsr r5,isnum
|
||||
br eos
|
||||
1:
|
||||
mov $realcon,r3 / real*4
|
||||
jsr r5,numst
|
||||
2:
|
||||
jsr r5,expon
|
||||
3:
|
||||
clrb (r2)
|
||||
mov $2,r0
|
||||
mov (sp)+,r2
|
||||
rts r5
|
||||
|
||||
isnum:
|
||||
movb (r1),r0
|
||||
cmpb chrtab(r0),$4
|
||||
bne 1f
|
||||
tst (r5)+
|
||||
1:
|
||||
rts r5
|
||||
|
||||
numst:
|
||||
jsr r5,isnum
|
||||
br 1b
|
||||
inc r1
|
||||
movb r0,(r2)+
|
||||
br numst
|
||||
|
||||
expon:
|
||||
cmpb (r1)+,$'e
|
||||
beq 1f
|
||||
cmpb -1(r1),$'d
|
||||
beq 1f
|
||||
2:
|
||||
dec r1
|
||||
rts r5
|
||||
1:
|
||||
cmpb (r1),$'+
|
||||
beq 1f
|
||||
cmpb (r1),$'-
|
||||
beq 1f
|
||||
jsr r5,isnum
|
||||
br 2b
|
||||
1:
|
||||
mov $realcon,r3 / real*4
|
||||
cmpb -(r1),$'e
|
||||
beq 1f
|
||||
mov $dblcon,r3 / real*8
|
||||
1:
|
||||
movb (r1)+,(r2)+
|
||||
movb (r1)+,(r2)+
|
||||
jsr r5,numst
|
||||
rts r5
|
||||
|
||||
getid:
|
||||
mov r0,-(sp)
|
||||
mov r2,-(sp)
|
||||
movb (r1),r0
|
||||
cmpb chrtab(r0),$2
|
||||
bne 3f
|
||||
tst (r5)+
|
||||
mov $symbuf,r2
|
||||
1:
|
||||
movb (r1)+,r0
|
||||
movb r0,(r2)+
|
||||
movb chrtab(r0),r0
|
||||
cmp r0,$2
|
||||
beq 1b
|
||||
cmp r0,$4
|
||||
beq 1b
|
||||
dec r1
|
||||
clrb (r2)
|
||||
movb $12,-(r2)
|
||||
3:
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r0
|
||||
rts r5
|
||||
|
||||
lookid:
|
||||
mov r0,-(sp)
|
||||
mov r2,-(sp)
|
||||
2:
|
||||
mov (r5),r2
|
||||
jsr r5,lookup; namebuf
|
||||
br 1f
|
||||
asl r0
|
||||
asl r0
|
||||
mov r0,r3
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r0
|
||||
tst (r5)+
|
||||
rts r5
|
||||
1:
|
||||
mov namep,r0
|
||||
add $8.,symtp
|
||||
1:
|
||||
movb (r2)+,(r0)+
|
||||
bne 1b
|
||||
mov r0,namep
|
||||
cmp r0,$enamebuf
|
||||
bhis 1f
|
||||
mov symtp,r0
|
||||
add $symtab,r0
|
||||
cmp r0,esymp
|
||||
blo 2b
|
||||
1:
|
||||
mov $1,r0
|
||||
sys write; ovfl; eovfl-ovfl
|
||||
clr r0
|
||||
sys seek; 0; 2
|
||||
mov $-1,r0
|
||||
sys exit
|
||||
|
||||
ovfl:
|
||||
<Symbol table overflow\n>
|
||||
eovfl:
|
||||
.even
|
||||
|
||||
srconst:
|
||||
cmpb (r1)+,$'+
|
||||
beq 1f
|
||||
cmpb -(r1),$'-
|
||||
bne 1f
|
||||
inc r1
|
||||
1:
|
||||
jsr r5,getsym
|
||||
cmp r0,$2
|
||||
bne 1f
|
||||
clrb r3
|
||||
add r3,r3
|
||||
bisb $cplxcon,r3
|
||||
tst (r5)+
|
||||
1:
|
||||
rts r5
|
||||
|
||||
chrtab:
|
||||
.byte 0,0,0,0,0,0,0,0
|
||||
.byte 0,0,0,0,0,0,0,0
|
||||
.byte 0,0,0,0,0,0,0,0
|
||||
.byte 0,0,0,0,0,0,0,0
|
||||
.byte 0,0,0,0,0,0,0,0
|
||||
.byte 0,0,0,0,0,0,6,0
|
||||
.byte 4,4,4,4,4,4,4,4
|
||||
.byte 4,4,0,0,0,0,0,0
|
||||
.byte 0,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,0,0,0,0,0
|
||||
.byte 0,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,2,2,2,2,2
|
||||
.byte 2,2,2,0,0,0,0,0
|
||||
|
||||
bastab:
|
||||
<.false.\0>
|
||||
<.true.\0>
|
||||
<**\0>
|
||||
</\0>
|
||||
<*\0>
|
||||
<-\0>
|
||||
<+\0>
|
||||
<.lt.\0>
|
||||
<.le.\0>
|
||||
<.eq.\0>
|
||||
<.ne.\0>
|
||||
<.gt.\0>
|
||||
<.ge.\0>
|
||||
<.not.\0>
|
||||
<.and.\0>
|
||||
<.or.\0>
|
||||
<(\0>
|
||||
<)\0>
|
||||
<,\0>
|
||||
<=\0>
|
||||
<\0>
|
||||
|
||||
@@ -0,0 +1,46 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx5 -- declare implicit
|
||||
|
||||
.globl declimpl
|
||||
.globl getname
|
||||
|
||||
declimpl:
|
||||
bit $7,symtab(r3)
|
||||
bne 1f / already declared
|
||||
jsr r5,getname
|
||||
movb symbuf,r0
|
||||
cmp r0,$'a
|
||||
blo 2f
|
||||
sub $6,r0 / map 'a -> 'Z+1
|
||||
2:
|
||||
asl r0
|
||||
bis imptab-[2*'A](r0),symtab(r3)
|
||||
1:
|
||||
bit $70,symtab(r3) / class
|
||||
bne 1f
|
||||
bis $10,symtab(r3) / simple
|
||||
1:
|
||||
rts r5
|
||||
|
||||
getname:
|
||||
mov r3,-(sp)
|
||||
clr r3
|
||||
mov $namebuf,r0
|
||||
1:
|
||||
cmp r3,(sp)
|
||||
bhis 1f
|
||||
2:
|
||||
tstb (r0)+
|
||||
bne 2b
|
||||
add $8,r3
|
||||
br 1b
|
||||
1:
|
||||
mov $symbuf,r3
|
||||
2:
|
||||
movb (r0)+,(r3)+
|
||||
bne 2b
|
||||
mov (sp)+,r3
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,31 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx6 -- teletype
|
||||
|
||||
.globl tput
|
||||
.globl tdecml
|
||||
|
||||
tdecml:
|
||||
mov r1,-(sp)
|
||||
jsr r5,td
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
|
||||
td:
|
||||
mov r0,r1
|
||||
clr r0
|
||||
dvd $10.,r0
|
||||
mov r1,-(sp)
|
||||
tst r0
|
||||
beq 1f
|
||||
jsr r5,td
|
||||
1:
|
||||
mov (sp)+,r0
|
||||
add $'0,r0
|
||||
|
||||
tput:
|
||||
movb r0,ch+1
|
||||
mov $1,r0
|
||||
sys write; ch+1; 1
|
||||
rts r5
|
||||
@@ -0,0 +1,34 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx7 -- passes advancement
|
||||
|
||||
.globl signon
|
||||
.globl signoff
|
||||
|
||||
|
||||
.globl pass2
|
||||
.globl pass3
|
||||
.globl pass4
|
||||
|
||||
signon:
|
||||
tst (r5)+
|
||||
rts r5
|
||||
|
||||
signoff:
|
||||
mov (r5)+,r0
|
||||
tst (sp)+
|
||||
dec r0
|
||||
asl r0
|
||||
jmp *passtab(r0)
|
||||
|
||||
passtab:
|
||||
pass2
|
||||
pass3
|
||||
pass4
|
||||
|
||||
.data
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,269 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx8 -- read source line
|
||||
|
||||
.globl getline
|
||||
.globl isagn
|
||||
.globl levzer
|
||||
|
||||
.globl error
|
||||
.globl getc
|
||||
.globl chrtab
|
||||
|
||||
getline:
|
||||
mov r3,-(sp)
|
||||
clr holquo
|
||||
clr r3 / line number
|
||||
clr line
|
||||
mov $line,r1
|
||||
1:
|
||||
jsr pc,get
|
||||
sub $'0,r0
|
||||
cmp r0,$9
|
||||
bhi 1f
|
||||
mpy $10.,r3
|
||||
add r0,r3
|
||||
br 1b
|
||||
1:
|
||||
add $'0,r0
|
||||
movb r0,ch
|
||||
mov r3,efno
|
||||
1:
|
||||
mov lino, ifno
|
||||
inc ifno
|
||||
jsr pc,get
|
||||
cmp r0,$'\n / nl
|
||||
beq 1f
|
||||
cmp r0,$''
|
||||
beq 2f
|
||||
cmp r0,$'"
|
||||
bne 3f
|
||||
2:
|
||||
mov r0,holquo
|
||||
add $4,r1 / room for h count
|
||||
mov r1,-(sp)
|
||||
2:
|
||||
jsr pc,get
|
||||
cmp r0,$'\n
|
||||
beq 4f
|
||||
cmp r0,holquo
|
||||
beq 2f
|
||||
bis $200,r0
|
||||
movb r0,(r1)+
|
||||
cmp r1,$eline-1
|
||||
blo 2b
|
||||
4:
|
||||
tst (sp)+
|
||||
br err1
|
||||
2:
|
||||
mov (sp)+,r3
|
||||
mov r1,-(sp)
|
||||
sub r3,r1
|
||||
movb $'h,-(r3)
|
||||
clr r0
|
||||
div $10.,r0
|
||||
add $'0,r1
|
||||
movb r1,-(r3)
|
||||
mov r0,r1
|
||||
clr r0
|
||||
div $10.,r0
|
||||
add $'0,r1
|
||||
movb r1,-(r3)
|
||||
add $'0,r0
|
||||
movb r0,-(r3)
|
||||
mov (sp)+,r1
|
||||
clr holquo
|
||||
br 1b
|
||||
3:
|
||||
cmp r0,$'h
|
||||
bne 2f
|
||||
clr r3 / quote count
|
||||
mov r1,-(sp)
|
||||
3:
|
||||
cmp r1,$line
|
||||
blos 4f
|
||||
movb -(r1),r0
|
||||
cmpb chrtab(r0),$4 / digit?
|
||||
beq 3b
|
||||
cmpb chrtab(r0),$2 / test letter
|
||||
beq 3f
|
||||
cmp r0,$'*
|
||||
beq 3f
|
||||
inc r1
|
||||
4:
|
||||
cmp r1,(sp)
|
||||
bhis 4f
|
||||
movb (r1)+,r0
|
||||
sub $'0,r0
|
||||
mpy $10.,r3
|
||||
add r0,r3
|
||||
br 4b
|
||||
4:
|
||||
mov r3,r0
|
||||
beq 3f
|
||||
mov r0,holquo
|
||||
mov (sp)+,r1
|
||||
movb $'h,(r1)+
|
||||
4:
|
||||
jsr pc,get
|
||||
cmp r0,$'\n
|
||||
bne 5f
|
||||
mov r0,ch
|
||||
mov $' ,r0
|
||||
5:
|
||||
bis $200,r0
|
||||
movb r0,(r1)+
|
||||
cmp r1,$eline-1
|
||||
bhis err1
|
||||
dec holquo
|
||||
bne 4b
|
||||
br 1b
|
||||
3:
|
||||
mov (sp)+,r1
|
||||
mov $'h,r0
|
||||
2:
|
||||
movb r0,(r1)+
|
||||
cmp r1,$eline-1
|
||||
blo 1b
|
||||
err1:
|
||||
jsr r5,error; 1.
|
||||
1:
|
||||
clrb (r1)+
|
||||
mov (sp)+,r3
|
||||
tstb line
|
||||
bne 1f
|
||||
jmp getline
|
||||
1:
|
||||
rts r5
|
||||
|
||||
isagn:
|
||||
jsr r5,levzer; '=
|
||||
br 1f
|
||||
br 3f
|
||||
1:
|
||||
mov r0,-(sp)
|
||||
jsr r5,levzer; ',
|
||||
br 4f
|
||||
jsr r5,levzer; '(
|
||||
br 1f
|
||||
tst (sp)+
|
||||
2:
|
||||
rts r5
|
||||
1:
|
||||
cmp (sp)+,r0
|
||||
blt 2b
|
||||
mov r1,-(sp)
|
||||
mov r0,r1
|
||||
inc r1
|
||||
jsr r5,levzer; ')
|
||||
br 1f
|
||||
1:
|
||||
mov (sp)+,r1
|
||||
cmpb 1(r0),$'=
|
||||
bne 3f
|
||||
rts r5
|
||||
|
||||
levzer:
|
||||
mov r1,r0
|
||||
clr -(sp)
|
||||
1:
|
||||
tst (sp)
|
||||
bne 2f
|
||||
cmpb (r0),(r5)
|
||||
beq 1f
|
||||
2:
|
||||
cmpb (r0),$'(
|
||||
bne 2f
|
||||
inc (sp)
|
||||
2:
|
||||
cmpb (r0),$')
|
||||
bne 2f
|
||||
dec (sp)
|
||||
blt 5f
|
||||
2:
|
||||
tstb (r0)+
|
||||
bne 1b
|
||||
5:
|
||||
tst (r5)+
|
||||
1:
|
||||
4:
|
||||
tst (sp)+
|
||||
3:
|
||||
tst (r5)+
|
||||
rts r5
|
||||
|
||||
get:
|
||||
movb ch,r0
|
||||
beq 1f
|
||||
clrb ch
|
||||
rts pc
|
||||
1:
|
||||
jsr pc,get1
|
||||
cmp r0,$'\n
|
||||
bne 2f
|
||||
jsr pc,get1
|
||||
cmp r0,$'&
|
||||
beq 1b
|
||||
movb r0,ch1
|
||||
mov $'\n,r0
|
||||
2:
|
||||
tst holquo
|
||||
bne 1f
|
||||
cmp $' ,r0
|
||||
beq 1b
|
||||
cmp $'\t,r0
|
||||
beq 1b
|
||||
1:
|
||||
cmp r0,$4 / test EOT
|
||||
bne 1f
|
||||
mov $1,r0
|
||||
sys write; mes; emes-mes
|
||||
mov $1,r0 / syntax errors detected
|
||||
sys exit
|
||||
1:
|
||||
rts pc
|
||||
|
||||
get1:
|
||||
movb ch1,r0
|
||||
beq 1f
|
||||
clrb ch1
|
||||
br 2f
|
||||
1:
|
||||
jsr r5,getc; ibuf
|
||||
bcs 1f
|
||||
bic $!177,r0
|
||||
beq 1b
|
||||
cmp r0,$'\n
|
||||
bne 2f
|
||||
inc lino
|
||||
2:
|
||||
tst nlflg
|
||||
beq 2f
|
||||
clr nlflg
|
||||
cmp r0,$'c
|
||||
bne 2f
|
||||
3:
|
||||
jsr pc,get1
|
||||
cmp r0,$'\n
|
||||
beq 1b
|
||||
cmp r0,$4
|
||||
bne 3b
|
||||
2:
|
||||
cmp r0,$'\n
|
||||
bne 2f
|
||||
inc nlflg
|
||||
2:
|
||||
rts pc
|
||||
1:
|
||||
mov $4,r0
|
||||
rts pc
|
||||
|
||||
.data
|
||||
nlflg: 1
|
||||
.text
|
||||
mes:
|
||||
<EOF on input\n\0>
|
||||
emes:
|
||||
.bss
|
||||
lino: .=.+2
|
||||
@@ -0,0 +1,125 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fx9 -- code
|
||||
|
||||
/ jsr r5,code; <string\0>; .even
|
||||
/ arg1
|
||||
/ arg2
|
||||
/ ...
|
||||
/
|
||||
/ args specified by %<c> in string.
|
||||
/ %s: string
|
||||
/ %d: decimal number
|
||||
/ %o: octal number
|
||||
/ %c: character
|
||||
/
|
||||
/ args are addresses
|
||||
/ or registers r0-r4
|
||||
|
||||
.globl code
|
||||
|
||||
.globl putc
|
||||
.globl getname
|
||||
|
||||
code:
|
||||
mov r4,-(sp)
|
||||
mov r3,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov r1,-(sp)
|
||||
mov r0,-(sp)
|
||||
mov r5,r4
|
||||
1:
|
||||
tstb (r5)+
|
||||
bne 1b
|
||||
inc r5
|
||||
bic $1,r5
|
||||
1:
|
||||
movb (r4)+,r0
|
||||
beq 1f
|
||||
cmp r0,$'%
|
||||
beq 2f
|
||||
jsr r5,putc; obuf
|
||||
br 1b
|
||||
2:
|
||||
movb (r4)+,r0
|
||||
beq 1f
|
||||
cmp r0,$'s
|
||||
beq cstr
|
||||
cmp r0,$'c
|
||||
beq cchr
|
||||
cmp r0,$'d
|
||||
beq cdec
|
||||
cmp r0,$'o
|
||||
beq coct
|
||||
cmp r0,$'n
|
||||
beq cnam
|
||||
jsr r5,putc; obuf
|
||||
br 1b
|
||||
cnam:
|
||||
jsr pc,cget
|
||||
mov r1,r3
|
||||
jsr r5,getname
|
||||
mov $symbuf,r1
|
||||
br 2f
|
||||
cstr:
|
||||
jsr pc,cget
|
||||
2:
|
||||
movb (r1)+,r0
|
||||
beq 1b
|
||||
cmp r0,$'\n
|
||||
beq 2b
|
||||
jsr r5,putc; obuf
|
||||
br 2b
|
||||
cchr:
|
||||
jsr pc,cget
|
||||
mov r1,r0
|
||||
jsr r5,putc; obuf
|
||||
mov r1,r0
|
||||
clrb r0
|
||||
swab r0
|
||||
beq 1b
|
||||
jsr r5,putc; obuf
|
||||
br 1b
|
||||
coct:
|
||||
jsr pc,cget
|
||||
mov $8.,r2
|
||||
br 2f
|
||||
cdec:
|
||||
jsr pc,cget
|
||||
mov $10.,r2
|
||||
2:
|
||||
jsr pc,2f
|
||||
br 1b
|
||||
2:
|
||||
clr r0
|
||||
dvd r2,r0
|
||||
mov r1,-(sp)
|
||||
mov r0,r1
|
||||
beq 2f
|
||||
jsr pc,2b
|
||||
2:
|
||||
mov (sp)+,r0
|
||||
add $'0,r0
|
||||
jsr r5,putc; obuf
|
||||
rts pc
|
||||
1:
|
||||
mov (sp)+,r0
|
||||
mov (sp)+,r1
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r3
|
||||
mov (sp)+,r4
|
||||
rts r5
|
||||
|
||||
cget:
|
||||
mov (r5)+,r1
|
||||
cmp r1,$4
|
||||
blos 1f
|
||||
rts pc
|
||||
1:
|
||||
asl r1
|
||||
add $2,r1
|
||||
add sp,r1
|
||||
mov (r1),r1
|
||||
rts pc
|
||||
|
||||
@@ -0,0 +1,36 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxa -- genop -- output a typed operator
|
||||
|
||||
.globl genop
|
||||
.globl newline
|
||||
|
||||
.globl code
|
||||
.globl typ
|
||||
|
||||
genop:
|
||||
mov r1,-(sp)
|
||||
mov r3,-(sp)
|
||||
bic $!7,r3
|
||||
movb typ(r3),r1
|
||||
mov (sp),r3
|
||||
clrb r3
|
||||
swab r3
|
||||
jsr r5,code
|
||||
< %c%c%d\0>; .even
|
||||
r1
|
||||
r0
|
||||
r3
|
||||
mov (sp)+,r3
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
|
||||
newline:
|
||||
jsr r5,code
|
||||
<\n\0>; .even
|
||||
rts r5
|
||||
|
||||
typ:
|
||||
<?irlc??g>
|
||||
|
||||
@@ -0,0 +1,32 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxb -- get integer constant or label
|
||||
|
||||
.globl geticon
|
||||
.globl getlab
|
||||
|
||||
.globl getsym
|
||||
.globl geti
|
||||
.globl ptemp
|
||||
|
||||
geticon:
|
||||
jsr r5,getsym
|
||||
cmp r0,$2
|
||||
bne 1f
|
||||
cmp r3,$intcon
|
||||
bne 1f
|
||||
jsr r5,geti
|
||||
tst (r5)+
|
||||
1:
|
||||
rts r5
|
||||
|
||||
getlab:
|
||||
jsr r5,geticon
|
||||
br 1f
|
||||
mov r0,temp
|
||||
jsr r5,ptemp; 'r; temp; line
|
||||
tst (r5)+
|
||||
1:
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,36 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxc -- size of array
|
||||
|
||||
.globl size
|
||||
.globl nelem
|
||||
|
||||
.globl error
|
||||
|
||||
size:
|
||||
movb symtab+1(r3),r0
|
||||
jsr r5,nelem
|
||||
inc r0
|
||||
bic $1,r0 / round to 0 mod 2
|
||||
rts r5
|
||||
|
||||
nelem:
|
||||
mov r1,-(sp)
|
||||
mov r0,r1
|
||||
mov symtab(r3),r0
|
||||
bic $!70,r0
|
||||
cmp r0,$20
|
||||
bne 1f
|
||||
mov symtab+2(r3),r0
|
||||
mov (r0)+,-(sp)
|
||||
2:
|
||||
mpy (r0)+,r1
|
||||
dec (sp)
|
||||
bgt 2b
|
||||
tst (sp)+
|
||||
1:
|
||||
mov r1,r0
|
||||
mov (sp)+,r1
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,50 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ xd -- tmp file 2 handl
|
||||
|
||||
.globl setln
|
||||
.globl getln
|
||||
|
||||
.globl tfil2
|
||||
.globl tfildiag
|
||||
.globl fopen
|
||||
.globl getc
|
||||
.globl getw
|
||||
.globl xbuf
|
||||
|
||||
setln:
|
||||
mov $tfil2,r0
|
||||
jsr r5,fopen; xbuf
|
||||
bcc 1f
|
||||
jmp tfildiag
|
||||
1:
|
||||
rts r5
|
||||
|
||||
getln:
|
||||
jsr r5,getc; xbuf
|
||||
bcs 3f
|
||||
mov r0,-(sp)
|
||||
jsr r5,getw; xbuf
|
||||
mov r0,efno
|
||||
jsr r5, getw; xbuf
|
||||
mov r0,ifno
|
||||
mov $line,r1
|
||||
1:
|
||||
jsr r5,getc; xbuf
|
||||
bcs 1f
|
||||
tst r0
|
||||
beq 1f
|
||||
bic $200,r0
|
||||
movb r0,(r1)+
|
||||
br 1b
|
||||
1:
|
||||
clrb (r1)+
|
||||
mov (sp)+,r0
|
||||
tst (r5)+
|
||||
rts r5
|
||||
3:
|
||||
mov xbuf,r0
|
||||
sys close
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,24 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ xe -- temp file junk
|
||||
|
||||
.globl tfildiag
|
||||
.globl tfil1, tfil2
|
||||
|
||||
tfildiag:
|
||||
mov $1,r0
|
||||
sys write; mes1; emes1-mes1
|
||||
clr r0
|
||||
sys seek; 0; 2
|
||||
mov $-1,r0 / failure return
|
||||
sys exit
|
||||
|
||||
mes1:
|
||||
<Temp file?\n>
|
||||
emes1:
|
||||
tfil1:
|
||||
<f.tmp1\0>
|
||||
tfil2:
|
||||
<f.tmp2\0>
|
||||
|
||||
@@ -0,0 +1,23 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxf -- format statements
|
||||
|
||||
.globl sform
|
||||
.globl sdata
|
||||
|
||||
.globl ptemp
|
||||
.globl error
|
||||
|
||||
sform:
|
||||
cmp progt,$6 / block data
|
||||
bne 1f
|
||||
jsr r5,error; 50.
|
||||
1:
|
||||
jsr r5,ptemp; 'f; efno; line
|
||||
rts r5
|
||||
|
||||
sdata:
|
||||
jsr r5,ptemp; 'd; efno; line
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,186 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxg -- declare implicit functions
|
||||
|
||||
.globl funimpl
|
||||
|
||||
.globl getname
|
||||
.globl lookup
|
||||
|
||||
funimpl:
|
||||
bit $7,symtab(r3)
|
||||
bne 1f
|
||||
jsr r5,getname
|
||||
mov r2,-(sp)
|
||||
mov $symbuf,r2
|
||||
jsr r5,lookup; funtab
|
||||
br 2f
|
||||
cmpb (r2),$'\n
|
||||
bne 2f
|
||||
asr r0
|
||||
movb funtabt(r0),r0
|
||||
mov r0,-(sp)
|
||||
bic $!17,r0
|
||||
bis typtab(r0),symtab(r3)
|
||||
mov (sp)+,r0
|
||||
asr r0
|
||||
asr r0
|
||||
asr r0
|
||||
asr r0
|
||||
bic $!17,r0
|
||||
mov typtab(r0),symtab+2(r3) / save argument conversion
|
||||
2: / in dimension pointer
|
||||
mov (sp)+,r2
|
||||
1:
|
||||
rts r5
|
||||
|
||||
typtab:
|
||||
intcon
|
||||
realcon
|
||||
dblcon
|
||||
cplxcon
|
||||
dcplxcon
|
||||
|
||||
funtab:
|
||||
<tanh\0>
|
||||
<sqrt\0>
|
||||
<sngl\0>
|
||||
<sin\0>
|
||||
<sign\0>
|
||||
<real\0>
|
||||
<mod\0>
|
||||
<min1\0>
|
||||
<min0\0>
|
||||
<max1\0>
|
||||
<max0\0>
|
||||
<isign\0>
|
||||
<int\0>
|
||||
<ifix\0>
|
||||
<idint\0>
|
||||
<idim\0>
|
||||
<iabs\0>
|
||||
<float\0>
|
||||
<exp\0>
|
||||
<dsqrt\0>
|
||||
<dsin\0>
|
||||
<dsign\0>
|
||||
<dreal\0>
|
||||
<dmod\0>
|
||||
<dmin1\0>
|
||||
<dmax1\0>
|
||||
<dlog10\0>
|
||||
<dlog\0>
|
||||
<dimag\0>
|
||||
<dim\0>
|
||||
<dexp\0>
|
||||
<dcsqrt\0>
|
||||
<dcsin\0>
|
||||
<dcos\0>
|
||||
<dconjg\0>
|
||||
<dcmplx\0>
|
||||
<dclog\0>
|
||||
<dcexp\0>
|
||||
<dccos\0>
|
||||
<dcabs\0>
|
||||
<dble\0>
|
||||
<datan2\0>
|
||||
<datan\0>
|
||||
<dabs\0>
|
||||
<csqrt\0>
|
||||
<csin\0>
|
||||
<cos\0>
|
||||
<conjg\0>
|
||||
<cmplx\0>
|
||||
<clog\0>
|
||||
<cexp\0>
|
||||
<ccos\0>
|
||||
<cabs\0>
|
||||
<atan2\0>
|
||||
<atan\0>
|
||||
<amod\0>
|
||||
<amin1\0>
|
||||
<amin0\0>
|
||||
<amax1\0>
|
||||
<amax0\0>
|
||||
<alog10\0>
|
||||
<alog\0>
|
||||
<aint\0>
|
||||
<aimag\0>
|
||||
<abs\0>
|
||||
<\0>
|
||||
|
||||
/ function type xy
|
||||
/ x = arg types
|
||||
/ y = result type
|
||||
/ 0 = integer
|
||||
/ 2 = real
|
||||
/ 4 = double
|
||||
/ 6 = complex
|
||||
/ 8 = doublecomplex
|
||||
funtabt:
|
||||
.byte 2\<4+2 / tanh
|
||||
.byte 2\<4+2 / sqrt
|
||||
.byte 4\<4+2 / sngl
|
||||
.byte 2\<4+2 / sin
|
||||
.byte 2\<4+2 / sign
|
||||
.byte 6\<4+2 / real
|
||||
.byte 0\<4+0 / mod
|
||||
.byte 2\<4+0 / min1
|
||||
.byte 0\<4+0 / min0
|
||||
.byte 2\<4+0 / max1
|
||||
.byte 0\<4+0 / max0
|
||||
.byte 0\<4+0 / isign
|
||||
.byte 2\<4+0 / int
|
||||
.byte 2\<4+0 / ifix
|
||||
.byte 4\<4+0 / idint
|
||||
.byte 0\<4+0 / idim
|
||||
.byte 0\<4+0 / iabs
|
||||
.byte 0\<4+2 / float
|
||||
.byte 2\<4+2 / exp
|
||||
.byte 4\<4+4 / dsqrt
|
||||
.byte 4\<4+4 / dsin
|
||||
.byte 4\<4+4 / dsign
|
||||
.byte 8\<4+4 / dreal
|
||||
.byte 4\<4+4 / dmod
|
||||
.byte 4\<4+4 / dmin1
|
||||
.byte 4\<4+4 / dmax1
|
||||
.byte 4\<4+4 / dlog10
|
||||
.byte 4\<4+4 / dlog
|
||||
.byte 8\<4+4 / dimag
|
||||
.byte 2\<4+2 / dim
|
||||
.byte 4\<4+4 / dexp
|
||||
.byte 8\<4+8 / dcsqrt
|
||||
.byte 8\<4+8 / dcsin
|
||||
.byte 4\<4+4 / dcos
|
||||
.byte 8\<4+8 / dconjg
|
||||
.byte 4\<4+8 / dcmplx
|
||||
.byte 8\<4+8 / dclog
|
||||
.byte 8\<4+8 / dcexp
|
||||
.byte 8\<4+8 / dccos
|
||||
.byte 8\<4+4 / dcabs
|
||||
.byte 2\<4+4 / dble
|
||||
.byte 4\<4+4 / datan2
|
||||
.byte 4\<4+4 / datan
|
||||
.byte 4\<4+4 / dabs
|
||||
.byte 6\<4+6 / csqrt
|
||||
.byte 6\<4+6 / csin
|
||||
.byte 2\<4+2 / cos
|
||||
.byte 6\<4+6 / conjg
|
||||
.byte 2\<4+6 / cmplx
|
||||
.byte 6\<4+6 / clog
|
||||
.byte 6\<4+6 / cexp
|
||||
.byte 6\<4+6 / ccos
|
||||
.byte 6\<4+2 / cabs
|
||||
.byte 2\<4+2 / atan2
|
||||
.byte 2\<4+2 / atan
|
||||
.byte 2\<4+2 / amod
|
||||
.byte 2\<4+2 / amin1
|
||||
.byte 0\<4+2 / amin0
|
||||
.byte 2\<4+2 / amax1
|
||||
.byte 0\<4+2 / amax0
|
||||
.byte 2\<4+2 / alog10
|
||||
.byte 2\<4+2 / alog
|
||||
.byte 2\<4+2 / aint
|
||||
.byte 6\<4+2 / aimag
|
||||
.byte 2\<4+2 / abs
|
||||
@@ -0,0 +1,77 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxh -- array constant offset
|
||||
|
||||
.globl consub
|
||||
|
||||
.globl getsym
|
||||
.globl geti
|
||||
.globl error
|
||||
.globl geticon
|
||||
|
||||
/ turn constant subscripts into offset.
|
||||
/ in: r3 -> symtab
|
||||
/ r1 -> just beyond (
|
||||
/ out:r0 has offset
|
||||
|
||||
consub:
|
||||
mov symtab(r3),r0
|
||||
bic $!70,r0
|
||||
cmp r0,$20 / test class == array
|
||||
beq 1f
|
||||
jsr r5,error; 17.
|
||||
clr r0
|
||||
rts r5
|
||||
1:
|
||||
mov r5,-(sp)
|
||||
mov r4,-(sp)
|
||||
mov r3,-(sp)
|
||||
mov r2,-(sp)
|
||||
clr r4 / accumulated offset
|
||||
mov symtab+2(r3),r2 / ptr to declarator
|
||||
mov (r2)+,-(sp) / dimensionality
|
||||
mov $1,r5 / prod of declarators
|
||||
1:
|
||||
jsr r5,geticon
|
||||
br 9f
|
||||
cmp r0,(r2)
|
||||
bgt 3f
|
||||
dec r0
|
||||
bge 2f
|
||||
3:
|
||||
jsr r5,error; 19. / out of range
|
||||
clr r0
|
||||
2:
|
||||
mov r5,-(sp)
|
||||
mpy r0,r5
|
||||
add r5,r4
|
||||
mov (sp)+,r5
|
||||
mpy (r2)+,r5
|
||||
jsr r5,getsym
|
||||
cmp r0,$36. / comma
|
||||
bne 1f
|
||||
dec (sp)
|
||||
bgt 1b
|
||||
jsr r5,error; 18. / wrong subscript count
|
||||
br 1b
|
||||
1:
|
||||
cmp r0,$34. / )
|
||||
beq 1f
|
||||
9:
|
||||
jsr r5,error; 20.
|
||||
clr r0
|
||||
1:
|
||||
cmp (sp)+,$1
|
||||
beq 1f
|
||||
jsr r5,error; 18. / subscript count
|
||||
1:
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r3
|
||||
movb symtab+1(r3),r5
|
||||
mpy r4,r5
|
||||
mov r5,r0
|
||||
mov (sp)+,r4
|
||||
mov (sp)+,r5
|
||||
rts r5
|
||||
|
||||
@@ -0,0 +1,145 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ quicker sort
|
||||
|
||||
/ mov $base,r1
|
||||
/ mov $base+[n*width],r2
|
||||
/ mov $width,r3
|
||||
/ jsr pc,qsort
|
||||
|
||||
/ r0,r1,r2,r3,r4 are used
|
||||
|
||||
.globl qsort
|
||||
.globl compare
|
||||
|
||||
qsort:
|
||||
mov r5,-(sp)
|
||||
mov r4,-(sp)
|
||||
bit $1,r3
|
||||
bne 1f
|
||||
bit $1,r1
|
||||
bne 1f
|
||||
cmp r3,$2
|
||||
bne 2f
|
||||
mov $exch1,exchange
|
||||
br 3f
|
||||
2:
|
||||
mov r3,r5
|
||||
clc
|
||||
ror r5
|
||||
mov r5,width
|
||||
mov $exchw,exchange
|
||||
br 3f
|
||||
1:
|
||||
mov $exchb,exchange
|
||||
3:
|
||||
jsr pc,qs1
|
||||
mov (sp)+,r4
|
||||
mov (sp)+,r5
|
||||
rts pc
|
||||
|
||||
qs1:
|
||||
mov r1,r5
|
||||
neg r5
|
||||
add r2,r5
|
||||
bgt 1f
|
||||
rts pc
|
||||
1:
|
||||
clr r4
|
||||
dvd r3,r4
|
||||
asr r4
|
||||
mpy r3,r4
|
||||
mov r5,r4
|
||||
add r1,r4
|
||||
|
||||
mov r1,-(sp)
|
||||
mov r2,-(sp)
|
||||
|
||||
loop:
|
||||
cmp r1,r4
|
||||
bhis loop1
|
||||
mov r1,r0
|
||||
jsr pc,compare
|
||||
bgt loop1
|
||||
add r3,r1
|
||||
br loop
|
||||
|
||||
loop1:
|
||||
cmp r2,r4
|
||||
blos 1f
|
||||
sub r3,r2
|
||||
mov r2,r0
|
||||
jsr pc,compare
|
||||
bge loop1
|
||||
|
||||
jsr pc,*exchange
|
||||
cmp r1,r4
|
||||
bne loop
|
||||
mov r2,r4
|
||||
br loop
|
||||
|
||||
1:
|
||||
cmp r1,r4
|
||||
beq 1f
|
||||
jsr pc,*exchange
|
||||
mov r1,r4
|
||||
br loop1
|
||||
|
||||
1:
|
||||
mov (sp)+,r2
|
||||
mov r4,-(sp)
|
||||
mov r4,r1
|
||||
add r3,r1
|
||||
mov r2,r0
|
||||
sub r1,r0
|
||||
sub 2(sp),r4
|
||||
cmp r0,r4
|
||||
blo 1f
|
||||
mov (sp)+,r0
|
||||
mov (sp)+,r4
|
||||
mov r1,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov r0,r2
|
||||
mov r4,r1
|
||||
1:
|
||||
jsr pc,qs1
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r1
|
||||
br qs1
|
||||
|
||||
exchb:
|
||||
mov r1,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov r3,r5
|
||||
1:
|
||||
movb (r1),r0
|
||||
movb (r2),(r1)+
|
||||
movb r0,(r2)+
|
||||
sob r5,1b
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r1
|
||||
rts pc
|
||||
|
||||
exchw:
|
||||
mov r1,-(sp)
|
||||
mov r2,-(sp)
|
||||
mov width,r5
|
||||
1:
|
||||
mov (r1),r0
|
||||
mov (r2),(r1)+
|
||||
mov r0,(r2)+
|
||||
sob r5,1b
|
||||
mov (sp)+,r2
|
||||
mov (sp)+,r1
|
||||
rts pc
|
||||
|
||||
exch1:
|
||||
mov (r1),r0
|
||||
mov (r2),(r1)
|
||||
mov r0,(r2)
|
||||
rts pc
|
||||
|
||||
.bss
|
||||
exchange: .=.+2
|
||||
width: .=.+2
|
||||
@@ -0,0 +1,100 @@
|
||||
/
|
||||
/
|
||||
|
||||
/ fxx -- data segment definition
|
||||
|
||||
.data
|
||||
.globl holround
|
||||
holround: 4
|
||||
|
||||
.bss
|
||||
|
||||
/ pass 1
|
||||
|
||||
.globl dimu
|
||||
dimu: .=.+2
|
||||
|
||||
/ pass 2
|
||||
|
||||
.globl eqvtab
|
||||
|
||||
/ pass 3 stuff
|
||||
|
||||
.globl conu
|
||||
.globl dou
|
||||
.globl blockp
|
||||
.globl dotabp
|
||||
.globl dotab
|
||||
.globl edotab
|
||||
.globl functn
|
||||
.globl blocks
|
||||
|
||||
conu: .=.+2
|
||||
dou: .=.+2
|
||||
blockp: .=.+2
|
||||
dotabp: .=.+2
|
||||
dotab: .=.+60.
|
||||
edotab:
|
||||
functn: .=.+2
|
||||
|
||||
/ pass 4
|
||||
|
||||
.globl negflg
|
||||
.globl repfact
|
||||
.globl contab
|
||||
.globl dattab
|
||||
|
||||
negflg: .=.+2
|
||||
repfact:.=.+2
|
||||
|
||||
/ general buffer
|
||||
|
||||
xbufsiz = 2200.
|
||||
|
||||
.globl xbuf
|
||||
|
||||
xbuf: .=.+xbufsiz
|
||||
|
||||
eqvtab = xbuf+518. / for pass 2
|
||||
|
||||
blocks = xbuf / for pass 3
|
||||
|
||||
dattab = xbuf+518. / for pass 4
|
||||
contab = xbuf+xbufsiz
|
||||
|
||||
/ for all passes
|
||||
|
||||
data:
|
||||
ibuf: .=.+518.
|
||||
obuf: .=.+518.
|
||||
tbuf: .=.+518.
|
||||
line: .=.+linsize
|
||||
eline: .=.+4
|
||||
ifno: .=.+2
|
||||
efno: .=.+2
|
||||
errp: .=.+2 / init(errb)
|
||||
errb: .=.+12.
|
||||
eerrb: / size 0 mod 4
|
||||
symtab: .=.+symsize
|
||||
esymtab:
|
||||
esymp: .=.+2 / init(esymtab)
|
||||
symtp: .=.+2
|
||||
namebuf:.=.+namsize
|
||||
enamebuf:
|
||||
namep: .=.+2 / init(namebuf)
|
||||
.=.+40 /fake
|
||||
.=.+1 / make odd
|
||||
symbuf: .=.+smblsize / init(<_>)
|
||||
esymbuf:
|
||||
ch: .=.+1
|
||||
ch1: .=.+1
|
||||
progt: .=.+2
|
||||
holquo: .=.+2
|
||||
nxtaloc:.=.+2
|
||||
imptab: .=.+[26.*2*2] / 26 letters, 2 alphabets, 2 bytes
|
||||
nerror: .=.+2
|
||||
temp: .=.+2
|
||||
functm: .=.+2
|
||||
edata:
|
||||
dsize =.-data
|
||||
|
||||
Reference in New Issue
Block a user