jona/unix-v6
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add original unix v6

Browse Source
This commit is contained in:
memnoth
2018-01-27 22:35:41 +09:00
commit 2c7099ee50
664 changed files with 106254 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
source/as/as11.s
+106
View File
@@ -0,0 +1,106 @@
/
/
/ PDP-11 assembler pass 0
indir = 0
jmp start
go:
jsr pc,assem
movb pof,r0
sys write; outbuf; 512.
movb pof,r0
sys close
movb fbfil,r0
sys close
tstb errflg
bne aexit
jsr r5,fcreat; a.tmp3
mov r0,r1
mov symend,0f
sub $usymtab,0f
sys indir; 9f
.data
9: sys write; usymtab; 0:..
.text
mov r1,r0
sys close
sys exec; 2f; 1f
mov $2f,r0
jsr r5,filerr; "?\n
aexit:
sys unlink; a.tmp1
sys unlink; a.tmp2
sys unlink; a.tmp3
sys exit
.data
1:
2f
a.tmp1
a.tmp2
a.tmp3
unglob:
3f
0
.text
2:
fpass2:
</lib/as2\0>
3:
<-g\0>
.even
filerr:
mov r4,-(sp)
mov r0,r4
mov r4,0f
clr r0
1:
tstb (r4)+
beq 1f
inc r0
br 1b
1:
mov r0,1f
mov $1,r0
sys indir; 9f
.data
9: sys write; 0:0; 1:0
.text
mov r5,0f
mov $1,r0
sys indir; 9f
.data
9: sys write; 0:0; 2
.text
tst (r5)+
mov (sp)+,r4
rts r5
fcreat:
mov r4,-(sp)
mov (r5)+,r4
mov r4,0f
1:
sys indir; 9f
.data
9: sys stat; 0:..; outbuf
.text
bec 2f
mov r4,0f
sys indir; 9f
.data
9: sys creat; 0:..; 444
.text
bes 2f
mov (sp)+,r4
rts r5
2:
incb 9.(r4)
cmpb 9.(r4),$'z
blos 1b
mov r4,r0
jsr r5,filerr; "?\n
sys exit
source/as/as12.s
+70
View File
@@ -0,0 +1,70 @@
/
/
/ a2 -- pdp-11 assembler pass 1
error:
incb errflg
mov r0,-(sp)
mov r1,-(sp)
mov (r5)+,r0
tst *curarg
beq 1f
mov r0,-(sp)
mov *curarg,r0
clr *curarg
jsr r5,filerr; '\n
mov (sp)+,r0
1:
mov r2,-(sp)
mov r3,-(sp)
mov line,r3
movb r0,1f
mov $1f+6,r0
mov $4,r1
2:
clr r2
dvd $10.,r2
add $'0,r3
movb r3,-(r0)
mov r2,r3
sob r1,2b
mov $1,r0
sys write; 1f; 7
mov (sp)+,r3
mov (sp)+,r2
mov (sp)+,r1
mov (sp)+,r0
rts r5
.data
1: <f xxxx\n>
.even
.text
betwen:
cmp r0,(r5)+
blt 1f
cmp (r5)+,r0
blt 2f
1:
tst (r5)+
2:
rts r5
putw:
tst ifflg
beq 1f
cmp r4,$'\n
bne 2f
1:
mov r4,*obufp
add $2,obufp
cmp obufp,$outbuf+512.
blo 2f
mov $outbuf,obufp
movb pof,r0
sys write; outbuf; 512.
2:
rts pc
source/as/as13.s
+131
View File
@@ -0,0 +1,131 @@
/
/
/ a3 -- pdp-11 assembler pass 1
assem:
jsr pc,readop
jsr pc,checkeos
br ealoop
tst ifflg
beq 3f
cmp r4,$200
blos assem
cmpb (r4),$21 /if
bne 2f
inc ifflg
2:
cmpb (r4),$22 /endif
bne assem
dec ifflg
br assem
3:
mov r4,-(sp)
jsr pc,readop
cmp r4,$'=
beq 4f
cmp r4,$':
beq 1f
mov r4,savop
mov (sp)+,r4
jsr pc,opline
br ealoop
1:
mov (sp)+,r4
cmp r4,$200
bhis 1f
cmp r4,$1 / digit
beq 3f
jsr r5,error; 'x
br assem
1:
bitb $37,(r4)
beq 1f
jsr r5,error; 'm
1:
bisb dot-2,(r4)
mov dot,2(r4)
br assem
3:
mov numval,r0
jsr pc,fbcheck
movb dotrel,curfbr(r0)
asl r0
movb dotrel,nxtfb
mov dot,nxtfb+2
movb r0,nxtfb+1
mov dot,curfb(r0)
movb fbfil,r0
sys write; nxtfb; 4
br assem
4:
jsr pc,readop
jsr pc,expres
mov (sp)+,r1
cmp r1,$200
bhis 1f
jsr r5,error; 'x
br ealoop
1:
cmp r1,$dotrel
bne 2f
bic $40,r3
cmp r3,dotrel
bne 1f
2:
bicb $37,(r1)
bic $!37,r3
bne 2f
clr r2
2:
bisb r3,(r1)
mov r2,2(r1)
br ealoop
1:
jsr r5,error; '.
movb $2,dotrel
ealoop:
cmp r4,$';
beq assem1
cmp r4,$'\n
bne 1f
inc line
br assem1
1:
cmp r4,$'\e
bne 2f
tst ifflg
beq 1f
jsr r5,error; 'x
1:
rts pc
2:
jsr r5,error; 'x
2:
jsr pc,checkeos
br assem1
jsr pc,readop
br 2b
assem1:
jmp assem
fbcheck:
cmp r0,$9.
bhi 1f
rts pc
1:
jsr r5,error; 'f
clr r0
rts pc
checkeos:
cmp r4,$'\n
beq 1f
cmp r4,$';
beq 1f
cmp r4,$'\e
beq 1f
add $2,(sp)
1:
rts pc
source/as/as14.s
+231
View File
@@ -0,0 +1,231 @@
/
/
/ a4 -- pdp-11 assembler pass1
rname:
mov r1,-(sp)
mov r2,-(sp)
mov r3,-(sp)
mov $8,r5
mov $symbol+8.,r2
clr -(r2)
clr -(r2)
clr -(r2)
clr -(r2)
clr -(sp)
clr -(sp)
cmp r0,$'~ / symbol not for hash table
bne 1f
inc 2(sp)
clr ch
1:
jsr pc,rch
movb chartab(r0),r3
ble 1f
add r3,(sp)
swab (sp)
dec r5
blt 1b
movb r3,(r2)+
br 1b
1:
mov r0,ch
mov (sp)+,r1
clr r0
tst (sp)+
beq 1f
mov symend,r4
br 4f
1:
div $hshsiz,r0
ashc $1,r0
add $hshtab,r1
1:
sub r0,r1
cmp r1,$hshtab
bhi 2f
add $2*hshsiz,r1
2:
mov $symbol,r2
mov -(r1),r4
beq 3f
cmp (r2)+,(r4)+
bne 1b
cmp (r2)+,(r4)+
bne 1b
cmp (r2)+,(r4)+
bne 1b
cmp (r2)+,(r4)+
bne 1b
br 1f
3:
mov symend,r4
mov r4,(r1)
4:
mov $symbol,r2
mov r4,-(sp)
add $20,r4
cmp r4,0f
blos 4f
add $512.,0f
sys indir; 9f
.data
9: sys break; 0:end
.text
4:
mov (sp)+,r4
mov (r2)+,(r4)+
mov (r2)+,(r4)+
mov (r2)+,(r4)+
mov (r2)+,(r4)+
clr (r4)+
clr (r4)+
mov r4,symend
sub $4,r4
1:
mov r4,-(sp)
mov r4,r3
sub $8,r3
cmp r3,$usymtab
blo 1f
sub $usymtab,r3
clr r2
div $3,r2
mov r2,r4
add $4000,r4 / user symbol
br 2f
1:
sub $symtab,r3
clr r2
div $3,r2
mov r2,r4
add $1000,r4 / builtin symbol
2:
jsr pc,putw
mov (sp)+,r4
mov (sp)+,r3
mov (sp)+,r2
mov (sp)+,r1
tst (sp)+
rts pc
number:
mov r2,-(sp)
mov r3,-(sp)
mov r5,-(sp)
clr r1
clr r5
1:
jsr pc,rch
jsr r5,betwen; '0; '9
br 1f
sub $'0,r0
mpy $10.,r5
add r0,r5
als $3,r1
add r0,r1
br 1b
1:
cmp r0,$'b
beq 1f
cmp r0,$'f
beq 1f
cmp r0,$'.
bne 2f
mov r5,r1
clr r0
2:
movb r0,ch
mov r1,r0
mov (sp)+,r5
mov (sp)+,r3
mov (sp)+,r2
rts pc
1:
mov r0,r3
mov r5,r0
jsr pc,fbcheck
add $141,r0
cmp r3,$'b
beq 1f
add $10.,r0
1:
mov r0,r4
mov (sp)+,r5
mov (sp)+,r3
mov (sp)+,r2
add $2,(sp)
rts pc
rch:
movb ch,r0
beq 1f
clrb ch
rts pc
1:
dec inbfcnt
blt 2f
movb *inbfp,r0
inc inbfp
bic $!177,r0
beq 1b
rts pc
2:
movb fin,r0
beq 3f
sys read; inbuf;512.
bcs 2f
tst r0
beq 2f
mov r0,inbfcnt
mov $inbuf,inbfp
br 1b
2:
movb fin,r0
clrb fin
sys close
3:
decb nargs
bgt 2f
mov $'\e,r0
rts pc
2:
tst ifflg
beq 2f
jsr r5,error; 'i
jmp aexit
2:
mov curarg,r0
tst (r0)+
mov (r0),0f
mov r0,curarg
incb fileflg
sys indir; 9f
.data
9: sys open; 0:0; 0
.text
bec 2f
mov 0b,r0
jsr r5,filerr; <?\n>
jmp aexit
2:
movb r0,fin
mov $1,line
mov r4,-(sp)
mov r1,-(sp)
mov $5,r4
jsr pc,putw
mov *curarg,r1
2:
movb (r1)+,r4
beq 2f
jsr pc,putw
br 2b
2:
mov $-1,r4
jsr pc,putw
mov (sp)+,r1
mov (sp)+,r4
br 1b
source/as/as15.s
+170
View File
@@ -0,0 +1,170 @@
/
/
/ a5 -- pdp-11 assembler pass 1
readop:
mov savop,r4
beq 1f
clr savop
rts pc
1:
jsr pc,8f
jsr pc,putw
rts pc
8:
jsr pc,rch
_readop:
mov r0,r4
movb chartab(r0),r1
bgt rdname
jmp *1f-2(r1)
fixor
escp
8b
retread
dquote
garb
squote
rdname
skip
rdnum
retread
string
1:
escp:
jsr pc,rch
mov $esctab,r1
1:
cmpb r0,(r1)+
beq 1f
tstb (r1)+
bne 1b
rts pc
1:
movb (r1),r4
rts pc
esctab:
.byte '/, '/
.byte '\<, 035
.byte '>, 036
.byte '%, 037
.byte 0, 0
fixor:
mov $037,r4
retread:
rts pc
rdname:
movb r0,ch
cmp r1,$'0
blo 1f
cmp r1,$'9
blos rdnum
1:
jmp rname
rdnum:
jsr pc,number
br 1f
rts pc
squote:
jsr pc,rsch
br 1f
dquote:
jsr pc,rsch
mov r0,-(sp)
jsr pc,rsch
swab r0
bis (sp)+,r0
1:
mov r0,numval
mov $1,r4
jsr pc,putw
mov numval,r4
jsr pc,putw
mov $1,r4
tst (sp)+
rts pc
skip:
jsr pc,rch
mov r0,r4
cmp r0,$'\e
beq 1f
cmp r0,$'\n
bne skip
1:
rts pc
garb:
jsr r5,error; 'g
br 8b
string:
mov $'<,r4
jsr pc,putw
clr numval
1:
jsr pc,rsch
tst r1
bne 1f
mov r0,r4
bis $400,r4
jsr pc,putw
inc numval
br 1b
1:
mov $-1,r4
jsr pc,putw
mov $'<,r4
tst (sp)+
rts pc
rsch:
jsr pc,rch
cmp r0,$'\e
beq 4f
cmp r0,$'\n
beq 4f
clr r1
cmp r0,$'\\
bne 3f
jsr pc,rch
mov $schar,r2
1:
cmpb (r2)+,r0
beq 2f
tstb (r2)+
bpl 1b
rts pc
2:
movb (r2)+,r0
clr r1
rts pc
3:
cmp r0,$'>
bne 1f
inc r1
1:
rts pc
4:
jsr r5,error; '<
jmp aexit
schar:
.byte 'n, 012
.byte 't, 011
.byte 'e, 004
.byte '0, 000
.byte 'r, 015
.byte 'a, 006
.byte 'p, 033
.byte 0, -1
source/as/as16.s
+291
View File
@@ -0,0 +1,291 @@
/
/
/ a6 -- pdp-11 assembler pass 1
opline:
mov r4,r0
jsr r5,betwen; 0; 200
br 1f
cmp r0,$'<
bne xpr
jmp opl17
xpr:
jsr pc,expres
add $2,dot
rts pc
1:
movb (r4),r0
cmp r0,$24
beq xpr
jsr r5,betwen; 5; 36
br xpr
mov r0,-(sp)
jsr pc,readop
mov (sp)+,r0
asl r0
jmp *1f-12(r0)
1:
opl13 / map fop freg,fdst to double
opl6
opl7
opl10
opl11
opl13 / map fld/fst to double
opl13
opl13 / map fop fsrc,freg to double
opl15
opl16
opl17
opl20
opl21
opl22
opl23
xpr
opl25
opl26
opl27
opl13 / map mul s,r to double
opl31
opl32
xpr
xpr
opl35
opl36
/ jbr
opl35:
mov $4,-(sp)
br 1f
/ jeq, etc
opl36:
mov $6,-(sp)
1:
jsr pc,expres
cmp r3,dotrel
bne 1f
sub dot,r2
bge 1f
cmp r2,$-376
blt 1f
mov $2,(sp)
1:
add (sp)+,dot
rts pc
/double
opl13:
opl7:
jsr pc,addres
op2:
cmp r4,$',
beq 1f
jsr pc,errora
rts pc
1:
jsr pc,readop
opl15: / single operand
jsr pc,addres
add $2,dot
rts pc
opl31: / sob
jsr pc,expres
cmp r4,$',
beq 1f
jsr pc,errora
1:
jsr pc,readop
/branch
opl6:
opl10:
opl11:
jsr pc,expres
add $2,dot
rts pc
/ .byte
opl16:
jsr pc,expres
inc dot
cmp r4,$',
bne 1f
jsr pc,readop
br opl16
1:
rts pc
/ < (.ascii)
opl17:
add numval,dot
jsr pc,readop
rts pc
/.even
opl20:
inc dot
bic $1,dot
rts pc
/.if
opl21:
jsr pc,expres
tst r3
bne 1f
jsr r5,error; 'U
1:
tst r2
bne opl22
inc ifflg
opl22: /endif
rts pc
/.globl
opl23:
cmp r4,$200
blo 1f
bisb $40,(r4)
jsr pc,readop
cmp r4,$',
bne 1f
jsr pc,readop
br opl23
1:
rts pc
opl25:
opl26:
opl27:
mov dotrel,r1
asl r1
mov dot,savdot-4(r1)
mov savdot-[2*25](r0),dot
asr r0
sub $25-2,r0
mov r0,dotrel
rts pc
/ .common
opl32:
cmp r4,$200
blo 1f
bis $40,(r4)
jsr pc,readop
cmp r4,$',
bne 1f
jsr pc,readop
jsr pc,expres
rts pc
1:
jsr r5,error; 'x
rts pc
addres:
cmp r4,$'(
beq alp
cmp r4,$'-
beq amin
cmp r4,$'$
beq adoll
cmp r4,$'*
beq astar
getx:
jsr pc,expres
cmp r4,$'(
bne 2f
jsr pc,readop
jsr pc,expres
jsr pc,checkreg
jsr pc,checkrp
add $2,dot
clr r0
rts pc
2:
cmp r3,$24 / register type
bne 1f
jsr pc,checkreg
clr r0
rts pc
1:
add $2,dot
clr r0
rts pc
alp:
jsr pc,readop
jsr pc,expres
jsr pc,checkrp
jsr pc,checkreg
cmp r4,$'+
bne 1f
jsr pc,readop
clr r0
rts pc
1:
mov $2,r0
rts pc
amin:
jsr pc,readop
cmp r4,$'(
beq 1f
mov r4,savop
mov $'-,r4
br getx
1:
jsr pc,readop
jsr pc,expres
jsr pc,checkrp
jsr pc,checkreg
clr r0
rts pc
adoll:
jsr pc,readop
jsr pc,expres
add $2,dot
clr r0
rts pc
astar:
jsr pc,readop
cmp r4,$'*
bne 1f
jsr r5,error; '*
1:
jsr pc,addres
add r0,dot
rts pc
errora:
jsr r5,error; 'a
rts pc
checkreg:
cmp r2,$7
bhi 1f
cmp r3,$1
beq 2f
cmp r3,$4
bhi 2f
1:
jsr pc,errora
2:
rts pc
errore:
jsr r5,error; 'e
rts pc
checkrp:
cmp r4,$')
beq 1f
jsr r5,error; ')
rts pc
1:
jsr pc,readop
rts pc
source/as/as17.s
+220
View File
@@ -0,0 +1,220 @@
/
/
/ a7 -- pdp-11 assembler pass 1
expres:
mov r5,-(sp)
mov $'+,-(sp)
clr opfound
clr r2
mov $1,r3
br 1f
advanc:
jsr pc,readop
1:
mov r4,r0
jsr r5,betwen; 0; 177
br .+4
br 7f
movb (r4),r0
mov 2(r4),r1
br oprand
7:
cmp r4,$141
blo 1f
cmp r4,$141+10.
bhis 2f
movb curfbr-141(r4),r0
asl r4
mov curfb-[2*141](r4),r2
bpl oprand
jsr r5,error; 'f
br oprand
2:
clr r3
clr r2
br oprand
1:
mov $esw1,r1
1:
cmp (r1)+,r4
beq 1f
tst (r1)+
bne 1b
tst opfound
bne 2f
jsr pc,errore
2:
tst (sp)+
mov (sp)+,r5
rts pc
1:
jmp *(r1)
esw1:
'+; binop
'-; binop
'*; binop
'/; binop
'&; binop
037; binop
035; binop
036; binop
'%; binop
'[; brack
'^; binop
1; exnum
'!; binop
0; 0
binop:
cmpb (sp),$'+
beq 1f
jsr pc,errore
1:
movb r4,(sp)
br advanc
exnum:
mov numval,r1
mov $1,r0
br oprand
brack:
mov r2,-(sp)
mov r3,-(sp)
jsr pc,readop
jsr pc,expres
cmp r4,$']
beq 1f
jsr r5,error; ']
1:
mov r3,r0
mov r2,r1
mov (sp)+,r3
mov (sp)+,r2
oprand:
inc opfound
mov $exsw2,r5
1:
cmp (sp),(r5)+
beq 1f
tst (r5)+
bne 1b
br eoprnd
1:
jmp *(r5)
exsw2:
'+; exadd
'-; exsub
'*; exmul
'/; exdiv
037; exor
'&; exand
035;exlsh
036;exrsh
'%; exmod
'!; exnot
'^; excmbin
0; 0
excmbin:
mov r0,r3 / give left flag of right
br eoprnd
exrsh:
neg r1
beq exlsh
inc r1
clc
ror r2
exlsh:
jsr r5,combin; 0
als r1,r2
br eoprnd
exmod:
jsr r5,combin; 0
mov r1,-(sp)
mov r2,r1
clr r0
dvd (sp)+,r0
mov r1,r2
br eoprnd
exadd:
jsr r5,combin; 0
add r1,r2
br eoprnd
exsub:
jsr r5,combin; 1
sub r1,r2
br eoprnd
exand:
jsr r5,combin; 0
com r1
bic r1,r2
br eoprnd
exor:
jsr r5,combin; 0
bis r1,r2
br eoprnd
exmul:
jsr r5,combin; 0
mpy r2,r1
mov r1,r2
br eoprnd
exdiv:
jsr r5,combin; 0
mov r1,-(sp)
mov r2,r1
clr r0
dvd (sp)+,r0
mov r0,r2
br eoprnd
exnot:
jsr r5,combin; 0
com r1
add r1,r2
br eoprnd
eoprnd:
mov $'+,(sp)
jmp advanc
combin:
mov r0,-(sp)
bis r3,(sp)
bic $!40,(sp)
bic $!37,r0
bic $!37,r3
cmp r0,r3
ble 1f
mov r0,-(sp)
mov r3,r0
mov (sp)+,r3
1:
tst r0
beq 1f
tst (r5)+
beq 2f
cmp r0,r3
bne 2f
mov $1,r3
br 2f
1:
tst (r5)+
clr r3
2:
bis (sp)+,r3
rts r5
source/as/as18.s
+65
View File
@@ -0,0 +1,65 @@
/
/
/ a8 -- pdp-11 assembler pass 1
chartab:
.byte -14,-14,-14,-14,-02,-14,-14,-14
.byte -14,-22, -2,-14,-14,-22,-14,-14
.byte -14,-14,-14,-14,-14,-14,-14,-14
.byte -14,-14,-14,-14,-14,-14,-14,-14
.byte -22,-20,-16,-14,-20,-20,-20,-12
.byte -20,-20,-20,-20,-20,-20,056,-06
.byte 060,061,062,063,064,065,066,067
.byte 070,071,-20,-02,-00,-20,-14,-14
.byte -14,101,102,103,104,105,106,107
.byte 110,111,112,113,114,115,116,117
.byte 120,121,122,123,124,125,126,127
.byte 130,131,132,-20,-24,-20,-20,137
.byte -14,141,142,143,144,145,146,147
.byte 150,151,152,153,154,155,156,157
.byte 160,161,162,163,164,165,166,167
.byte 170,171,172,-14,-26,-14,176,-14
.data
namedone:.byte 0
a.tmp1: </tmp/atm1a\0>
a.tmp2: </tmp/atm2a\0>
a.tmp3: </tmp/atm3a\0>
.even
curfb:
-1;-1;-1;-1;-1;-1;-1;-1;-1;-1
obufp: outbuf
symend: usymtab
.bss
curfbr: .=.+10.
savdot: .=.+6
bufcnt: .=.+2
hshsiz = 1553.
hshtab: .=2*hshsiz+.
pof: .=.+1
wordf: .=.+1
fin: .=.+1
fbfil: .=.+1
fileflg:.=.+1
errflg: .=.+1
ch: .=.+1
.even
symbol: .=.+8.
obufc: .=.+2
outbuf: .=.+512.
line: .=.+2
inbfcnt:.=.+2
ifflg: .=.+2
inbfp: .=.+2
nargs: .=.+2
curarg: .=.+2
opfound:.=.+2
savop: .=.+2
numval: .=.+2
nxtfb: .=.+4
usymtab:.=.+36.
end:
.text
source/as/as19.s
+347
View File
@@ -0,0 +1,347 @@
/
/
/ a9 -- pdp-11 assembler pass 1
eae = 0
/ key to types
/ 0 undefined
/ 1 absolute
/ 2 text
/ 3 data
/ 4 bss
/ 5 flop freg,dst (movfo, = stcfd)
/ 6 branch
/ 7 jsr
/ 10 rts
/ 11 sys
/ 12 movf (=ldf,stf)
/ 13 double operand (mov)
/ 14 flop fsrc,freg (addf)
/ 15 single operand (clr)
/ 16 .byte
/ 17 string (.ascii, "<")
/ 20 .even
/ 21 .if
/ 22 .endif
/ 23 .globl
/ 24 register
/ 25 .text
/ 26 .data
/ 27 .bss
/ 30 mul,div, etc
/ 31 sob
/ 32 .comm
/ 33 estimated text
/ 34 estimated data
/ 35 jbr
/ 36 jeq, jne, etc
.data
symtab:
/ special variables
<.\0\0\0\0\0\0\0>; dotrel:02; dot:000000
<..\0\0\0\0\0\0>; 01; dotdot:000000
/ register
<r0\0\0\0\0\0\0>; 24;000000
<r1\0\0\0\0\0\0>; 24;000001
<r2\0\0\0\0\0\0>; 24;000002
<r3\0\0\0\0\0\0>; 24;000003
<r4\0\0\0\0\0\0>; 24;000004
<r5\0\0\0\0\0\0>; 24;000005
<sp\0\0\0\0\0\0>; 24;000006
<pc\0\0\0\0\0\0>; 24;000007
.if eae
/eae & switches
<csw\0\0\0\0\0>; 01;177570
<div\0\0\0\0\0>; 01;177300
<ac\0\0\0\0\0\0>; 01;177302
<mq\0\0\0\0\0\0>; 01;177304
<mul\0\0\0\0\0>; 01;177306
<sc\0\0\0\0\0\0>; 01;177310
<sr\0\0\0\0\0\0>; 01;177311
<nor\0\0\0\0\0>; 01;177312
<lsh\0\0\0\0\0>; 01;177314
<ash\0\0\0\0\0>; 01;177316
.endif
/ system calls
<exit\0\0\0\0>; 01;0000001
<fork\0\0\0\0>; 01;0000002
<read\0\0\0\0>; 01;0000003
<write\0\0\0>; 01;0000004
<open\0\0\0\0>; 01;0000005
<close\0\0\0>; 01;0000006
<wait\0\0\0\0>; 01;0000007
<creat\0\0\0>; 01;0000010
<link\0\0\0\0>; 01;0000011
<unlink\0\0>; 01;0000012
<exec\0\0\0\0>; 01;0000013
<chdir\0\0\0>; 01;0000014
<time\0\0\0\0>; 01;0000015
<makdir\0\0>; 01;0000016
<chmod\0\0\0>; 01;0000017
<chown\0\0\0>; 01;0000020
<break\0\0\0>; 01;0000021
<stat\0\0\0\0>; 01;0000022
<seek\0\0\0\0>; 01;0000023
<tell\0\0\0\0>; 01;0000024
<mount\0\0\0>; 01;0000025
<umount\0\0>; 01;0000026
<setuid\0\0>; 01;0000027
<getuid\0\0>; 01;0000030
<stime\0\0\0>; 01;0000031
<fstat\0\0\0>; 01;0000034
<mdate\0\0\0>; 01;0000036
<stty\0\0\0\0>; 01;0000037
<gtty\0\0\0\0>; 01;0000040
<nice\0\0\0\0>; 01;0000042
<signal\0\0>; 01;0000060
/ double operand
<mov\0\0\0\0\0>; 13;0010000
<movb\0\0\0\0>; 13;0110000
<cmp\0\0\0\0\0>; 13;0020000
<cmpb\0\0\0\0>; 13;0120000
<bit\0\0\0\0\0>; 13;0030000
<bitb\0\0\0\0>; 13;0130000
<bic\0\0\0\0\0>; 13;0040000
<bicb\0\0\0\0>; 13;0140000
<bis\0\0\0\0\0>; 13;0050000
<bisb\0\0\0\0>; 13;0150000
<add\0\0\0\0\0>; 13;0060000
<sub\0\0\0\0\0>; 13;0160000
/ branch
<br\0\0\0\0\0\0>; 06;0000400
<bne\0\0\0\0\0>; 06;0001000
<beq\0\0\0\0\0>; 06;0001400
<bge\0\0\0\0\0>; 06;0002000
<blt\0\0\0\0\0>; 06;0002400
<bgt\0\0\0\0\0>; 06;0003000
<ble\0\0\0\0\0>; 06;0003400
<bpl\0\0\0\0\0>; 06;0100000
<bmi\0\0\0\0\0>; 06;0100400
<bhi\0\0\0\0\0>; 06;0101000
<blos\0\0\0\0>; 06;0101400
<bvc\0\0\0\0\0>; 06;0102000
<bvs\0\0\0\0\0>; 06;0102400
<bhis\0\0\0\0>; 06;0103000
<bec\0\0\0\0\0>; 06;0103000
<bcc\0\0\0\0\0>; 06;0103000
<blo\0\0\0\0\0>; 06;0103400
<bcs\0\0\0\0\0>; 06;0103400
<bes\0\0\0\0\0>; 06;0103400
/ jump/branch type
<jbr\0\0\0\0\0>; 35;0000400
<jne\0\0\0\0\0>; 36;0001000
<jeq\0\0\0\0\0>; 36;0001400
<jge\0\0\0\0\0>; 36;0002000
<jlt\0\0\0\0\0>; 36;0002400
<jgt\0\0\0\0\0>; 36;0003000
<jle\0\0\0\0\0>; 36;0003400
<jpl\0\0\0\0\0>; 36;0100000
<jmi\0\0\0\0\0>; 36;0100400
<jhi\0\0\0\0\0>; 36;0101000
<jlos\0\0\0\0>; 36;0101400
<jvc\0\0\0\0\0>; 36;0102000
<jvs\0\0\0\0\0>; 36;0102400
<jhis\0\0\0\0>; 36;0103000
<jec\0\0\0\0\0>; 36;0103000
<jcc\0\0\0\0\0>; 36;0103000
<jlo\0\0\0\0\0>; 36;0103400
<jcs\0\0\0\0\0>; 36;0103400
<jes\0\0\0\0\0>; 36;0103400
/ single operand
<clr\0\0\0\0\0>; 15;0005000
<clrb\0\0\0\0>; 15;0105000
<com\0\0\0\0\0>; 15;0005100
<comb\0\0\0\0>; 15;0105100
<inc\0\0\0\0\0>; 15;0005200
<incb\0\0\0\0>; 15;0105200
<dec\0\0\0\0\0>; 15;0005300
<decb\0\0\0\0>; 15;0105300
<neg\0\0\0\0\0>; 15;0005400
<negb\0\0\0\0>; 15;0105400
<adc\0\0\0\0\0>; 15;0005500
<adcb\0\0\0\0>; 15;0105500
<sbc\0\0\0\0\0>; 15;0005600
<sbcb\0\0\0\0>; 15;0105600
<tst\0\0\0\0\0>; 15;0005700
<tstb\0\0\0\0>; 15;0105700
<ror\0\0\0\0\0>; 15;0006000
<rorb\0\0\0\0>; 15;0106000
<rol\0\0\0\0\0>; 15;0006100
<rolb\0\0\0\0>; 15;0106100
<asr\0\0\0\0\0>; 15;0006200
<asrb\0\0\0\0>; 15;0106200
<asl\0\0\0\0\0>; 15;0006300
<aslb\0\0\0\0>; 15;0106300
<jmp\0\0\0\0\0>; 15;0000100
<swab\0\0\0\0>; 15;0000300
/ jsr
<jsr\0\0\0\0\0>; 07;0004000
/ rts
<rts\0\0\0\0\0>; 010;000200
/ simple operand
<sys\0\0\0\0\0>; 011;104400
/ flag-setting
<clc\0\0\0\0\0>; 01;0000241
<clv\0\0\0\0\0>; 01;0000242
<clz\0\0\0\0\0>; 01;0000244
<cln\0\0\0\0\0>; 01;0000250
<sec\0\0\0\0\0>; 01;0000261
<sev\0\0\0\0\0>; 01;0000262
<sez\0\0\0\0\0>; 01;0000264
<sen\0\0\0\0\0>; 01;0000270
/ floating point ops
<cfcc\0\0\0\0>; 01;170000
<setf\0\0\0\0>; 01;170001
<setd\0\0\0\0>; 01;170011
<seti\0\0\0\0>; 01;170002
<setl\0\0\0\0>; 01;170012
<clrf\0\0\0\0>; 15;170400
<negf\0\0\0\0>; 15;170700
<absf\0\0\0\0>; 15;170600
<tstf\0\0\0\0>; 15;170500
<movf\0\0\0\0>; 12;172400
<movif\0\0\0>; 14;177000
<movfi\0\0\0>; 05;175400
<movof\0\0\0>; 14;177400
<movfo\0\0\0>; 05;176000
<addf\0\0\0\0>; 14;172000
<subf\0\0\0\0>; 14;173000
<mulf\0\0\0\0>; 14;171000
<divf\0\0\0\0>; 14;174400
<cmpf\0\0\0\0>; 14;173400
<modf\0\0\0\0>; 14;171400
<movie\0\0\0>; 14;176400
<movei\0\0\0>; 05;175000
<ldfps\0\0\0>; 15;170100
<stfps\0\0\0>; 15;170200
<fr0\0\0\0\0\0>; 24;000000
<fr1\0\0\0\0\0>; 24;000001
<fr2\0\0\0\0\0>; 24;000002
<fr3\0\0\0\0\0>; 24;000003
<fr4\0\0\0\0\0>; 24;000004
<fr5\0\0\0\0\0>; 24;000005
/ 11/45 operations
<als\0\0\0\0\0>; 30;072000
<alsc\0\0\0\0>; 30;073000
<mpy\0\0\0\0\0>; 30;070000
.if eae-1
<mul\0\0\0\0\0>; 30;070000
<div\0\0\0\0\0>; 30;071000
<ash\0\0\0\0\0>; 30;072000
<ashc\0\0\0\0>; 30;073000
.endif
<dvd\0\0\0\0\0>; 30;071000
<xor\0\0\0\0\0>; 07;074000
<sxt\0\0\0\0\0>; 15;006700
<mark\0\0\0\0>; 11;006400
<sob\0\0\0\0\0>; 31;077000
/ specials
<.byte\0\0\0>; 16;000000
<.even\0\0\0>; 20;000000
<.if\0\0\0\0\0>; 21;000000
<.endif\0\0>; 22;000000
<.globl\0\0>; 23;000000
<.text\0\0\0>; 25;000000
<.data\0\0\0>; 26;000000
<.bss\0\0\0\0>; 27;000000
<.comm\0\0\0>; 32;000000
ebsymtab:
start:
sys signal; 2; 1
ror r0
bcs 1f
sys signal; 2; aexit
1:
mov sp,r5
mov (r5)+,r0
cmpb *2(r5),$'-
bne 1f
tst (r5)+
dec r0
br 2f
1:
clr unglob
2:
movb r0,nargs
mov r5,curarg
jsr r5,fcreat; a.tmp1
movb r0,pof
jsr r5,fcreat; a.tmp2
movb r0,fbfil
jsr pc,setup
jmp go
setup:
mov $symtab,r1
1:
clr r3
mov $8,r2
mov r1,-(sp)
2:
movb (r1)+,r4
beq 2f
add r4,r3
swab r3
sob r2,2b
2:
clr r2
div $hshsiz,r2
ashc $1,r2
add $hshtab,r3
4:
sub r2,r3
cmp r3,$hshtab
bhi 3f
add $2*hshsiz,r3
3:
tst -(r3)
bne 4b
mov (sp)+,r1
mov r1,(r3)
add $12.,r1
cmp r1,$ebsymtab
blo 1b
rts pc
/overlay buffer
inbuf = setup
. =inbuf+512.
source/as/as21.s
+258
View File
@@ -0,0 +1,258 @@
/
/
/ a21 -- pdp-11 assembler pass 2
indir = 0
main:
sys signal; 2; 1
ror r0
bcs 1f
sys signal; 2; aexit
1:
jmp start
/ set up sizes and origins
go:
/ read in symbol table
mov $usymtab,r1
1:
jsr pc,getw
bvs 1f
add $14,symsiz / count symbols
jsr pc,getw
jsr pc,getw
jsr pc,getw
jsr pc,getw
mov r4,r0
bic $!37,r0
cmp r0,$2 /text
blo 2f
cmp r0,$3 /data
bhi 2f
add $31,r4 /mark "estimated"
mov r4,(r1)+
jsr pc,getw
mov r4,(r1)+
br 3f
2:
clr (r1)+
clr (r1)+
jsr pc,getw
3:
jsr pc,setbrk
br 1b
1:
/ read in f-b definitions
mov r1,fbbufp
movb fbfil,fin
clr ibufc
1:
jsr pc,getw
bvs 1f
add $31,r4 / "estimated"
mov r4,(r1)+
jsr pc,getw
mov r4,(r1)+
jsr pc,setbrk
br 1b
1:
mov r1,endtable
mov $100000,(r1)+
/ set up input text file; initialize f-b table
jsr pc,setup
/ do pass 1
jsr pc,assem
/ prepare for pass 2
cmp outmod,$777
beq 1f
jmp aexit
1:
clr dot
mov $2,dotrel
mov $..,dotdot
clr brtabp
movb fin,r0
sys close
jsr r5,ofile; a.tmp1
movb r0,fin
clr ibufc
jsr pc,setup
inc passno
inc bsssiz
bic $1,bsssiz
mov txtsiz,r1
inc r1
bic $1,r1
mov r1,txtsiz
mov datsiz,r2
inc r2
bic $1,r2
mov r2,datsiz
mov r1,r3
mov r3,datbase / txtsiz
mov r3,savdot+2
add r2,r3
mov r3,bssbase / txtsiz+datsiz
mov r3,savdot+4
asl r3
add $20,r3
mov r3,symseek / 2*txtsiz+2*datsiz+20
sub r2,r3
mov r3,drelseek / 2*txtsiz+datsiz
sub r1,r3
mov r3,trelseek / txtsiz+datsiz+20
sub r2,r3
mov r3,datseek / txtsiz+20
mov $usymtab,r1
1:
jsr pc,doreloc
add $4,r1
cmp r1,endtable
blo 1b
clr r0
jsr r5,oset; txtp
mov trelseek,r0
jsr r5,oset; relp
mov $8.,r2
mov $txtmagic,r1
1:
mov (r1)+,r0
jsr r5,putw; txtp
dec r2
bne 1b
jsr pc,assem
/polish off text and relocation
jsr r5,flush; txtp
jsr r5,flush; relp
/ append full symbol table
mov symf,r0
mov r0,fin
sys seek; 0; 0;
clr ibufc
mov symseek,r0
jsr r5,oset; txtp
mov $usymtab,r1
1:
jsr pc,getw
bvs 1f
mov r4,r0
jsr r5,putw; txtp
jsr pc,getw
mov r4,r0
jsr r5,putw; txtp
jsr pc,getw
mov r4,r0
jsr r5,putw; txtp
jsr pc,getw
mov r4,r0
jsr r5,putw; txtp
mov (r1)+,r0
jsr r5,putw; txtp
mov (r1)+,r0
jsr r5,putw; txtp
jsr pc,getw
jsr pc,getw
br 1b
1:
jsr r5,flush; txtp
jmp aexit
.data
aexit:
mov a.tmp1,0f
sys unlink; 0:..
mov a.tmp2,0f
sys unlink; 0:..
mov a.tmp3,0f
sys unlink; 0:..
sys chmod; a.out; outmod: 777
sys exit
.text
filerr:
mov *(r5),r5
1:
movb (r5)+,ch
beq 1f
mov $1,r0
sys write; ch; 1
br 1b
1:
mov $1,r0
sys write; qnl; 2
jmp aexit
doreloc:
movb (r1),r0
bne 1f
bisb defund,(r1)
1:
bic $!37,r0
cmp r0,$5
bhis 1f
cmp r0,$3
blo 1f
beq 2f
add bssbase,2(r1)
rts pc
2:
add datbase,2(r1)
1:
rts pc
setbrk:
mov r1,-(sp)
add $20,r1
cmp r1,0f
blo 1f
add $512.,0f
sys indir; 9f
.data
9: sys break; 0: end
.text
1:
mov (sp)+,r1
rts pc
setup:
mov $curfb,r4
1:
clr (r4)+
cmp r4,$curfb+40.
blo 1b
mov txtfil,fin
clr ibufc
clr r4
1:
jsr pc,fbadv
tstb (r4)+
cmp r4,$10.
blt 1b
rts pc
ofile:
mov *(r5),0f
sys indir; 9f
.data
9: sys open; 0:..; 0
.text
bes 1f
tst (r5)+
rts r5
1:
jmp filerr
source/as/as22.s
+151
View File
@@ -0,0 +1,151 @@
/
/
/ a2 -- pdp-11 assembler pass 2
outw:
cmp dot-2,$4
beq 9f
bit $1,dot
bne 1f
add $2,dot
tstb passno
beq 8f
clr -(sp)
rol r3
adc (sp)
asr r3 / get relative pc bit
cmp r3,$40
bne 2f
/ external references
mov $666,outmod / make nonexecutable
mov xsymbol,r3
sub $usymtab,r3
asl r3
bis $4,r3 / external relocation
br 3f
2:
bic $40,r3 / clear any ext bits
cmp r3,$5
blo 4f
cmp r3,$33 / est. text, data
beq 6f
cmp r3,$34
bne 7f
6:
jsr r5,error; 'r
7:
mov $1,r3 / make absolute
4:
cmp r3,$2
blo 5f
cmp r3,$4
bhi 5f
tst (sp)
bne 4f
add dotdot,r2
br 4f
5:
tst (sp)
beq 4f
sub dotdot,r2
4:
dec r3
bpl 3f
clr r3
3:
asl r3
bis (sp)+,r3
mov r2,r0
jsr r5,putw; txtp
add $2,*tseekp
mov r3,r0
jsr r5,putw; relp
add $2,*rseekp
8:
rts pc
1:
jsr r5,error; 'o
clr r3
jsr pc,outb
rts pc
9:
jsr r5,error; 'x
rts pc
outb:
cmp dot-2,$4 / test bss mode
beq 9b
cmp r3,$1
blos 1f
jsr r5,error; 'r
1:
tstb passno
beq 2f
mov r2,r0
bit $1,dot
bne 1f
jsr r5,putw; txtp
clr r0
jsr r5,putw; relp
add $2,*rseekp
add $2,*tseekp
br 2f
1:
mov txtp,r0
movb r2,-1(r0)
2:
inc dot
rts pc
error:
mov $666,outmod / make nonexecutable
mov r3,-(sp)
mov r2,-(sp)
mov r1,-(sp)
mov r0,-(sp)
mov $argb,r1
1:
movb (r1),ch
beq 1f
clrb (r1)+
mov $1,r0
sys write; ch; 1
br 1b
1:
mov (r5)+,r0
movb r0,0f
mov line,r3
mov $0f+6,r0
mov $4,r1
2:
clr r2
dvd $10.,r2
add $'0,r3
movb r3,-(r0)
mov r2,r3
sob r1,2b
mov $1,r0
sys write; 0f; 7
mov (sp)+,r0
mov (sp)+,r1
mov (sp)+,r2
mov (sp)+,r3
rts r5
.data
0: <f xxxx\n>
.even
.text
betwen:
cmp r0,(r5)+
blt 1f
cmp (r5)+,r0
blt 2f
1:
tst (r5)+
2:
rts r5
source/as/as23.s
+165
View File
@@ -0,0 +1,165 @@
/
/
/ a3 -- pdp-11 assembler pass 2
assem:
jsr pc,readop
cmp r4,$5
beq 2f
cmp r4,$'<
beq 2f
jsr pc,checkeos
br eal1
mov r4,-(sp)
cmp (sp),$1
bne 1f
mov $2,(sp)
jsr pc,getw
mov r4,numval
1:
jsr pc,readop
cmp r4,$'=
beq 4f
cmp r4,$':
beq 1f
mov r4,savop
mov (sp)+,r4
2:
jsr pc,opline
dotmax:
tstb passno
bne eal1
movb dotrel,r0
asl r0
cmp dot,txtsiz-4(r0)
blos ealoop
mov dot,txtsiz-4(r0)
eal1:
jmp ealoop
1:
mov (sp)+,r4
cmp r4,$200
bhis 1f
cmp r4,$2
beq 3f
jsr r5,error; 'x
br assem
1:
tstb passno
bne 2f
movb (r4),r0
bic $!37,r0
beq 5f
cmp r0,$33
blt 6f
cmp r0,$34
ble 5f
6:
jsr r5,error; 'm
5:
bic $37,(r4)
bis dotrel,(r4)
mov 2(r4),brdelt
sub dot,brdelt
mov dot,2(r4)
br assem
2:
cmp dot,2(r4)
beq assem
jsr r5,error; 'p
br assem
3:
mov numval,r4
jsr pc,fbadv
asl r4
mov curfb(r4),r0
movb dotrel,(r0)
mov 2(r0),brdelt
sub dot,brdelt
mov dot,2(r0)
br assem
4:
jsr pc,readop
jsr pc,expres
mov (sp)+,r1
cmp r1,$symtab /test for dot
bne 1f
bic $40,r3
cmp r3,dotrel / can't change relocation
bne 2f
cmp r3,$4 / bss
bne 3f
mov r2,dot
br dotmax
3:
sub dot,r2
bmi 2f
mov r2,-(sp)
3:
dec (sp)
bmi 3f
clr r2
mov $1,r3
jsr pc,outb
br 3b
3:
tst (sp)+
br dotmax
2:
jsr r5,error; '.
br ealoop
1:
cmp r3,$40
bne 1f
jsr r5,error; 'r
1:
bic $37,(r1)
bic $!37,r3
bne 1f
clr r2
1:
bisb r3,(r1)
mov r2,2(r1)
ealoop:
cmp r4,$'\n
beq 1f
cmp r4,$'\e
bne 9f
rts pc
1:
inc line
9:
jmp assem
checkeos:
cmp r4,$'\n
beq 1f
cmp r4,$';
beq 1f
cmp r4,$'\e
beq 1f
add $2,(sp)
1:
rts pc
fbadv:
asl r4
mov nxtfb(r4),r1
mov r1,curfb(r4)
bne 1f
mov fbbufp,r1
br 2f
1:
add $4,r1
2:
cmpb 1(r1),r4
beq 1f
tst (r1)
bpl 1b
1:
mov r1,nxtfb(r4)
asr r4
rts pc
source/as/as24.s
+113
View File
@@ -0,0 +1,113 @@
/
/
/ a4 -- pdp-11 assembler pass 2
oset:
mov r2,-(sp)
mov (r5)+,r1
mov r0,r2
bic $!777,r0
add r1,r0
add $6,r0
mov r0,(r1)+ / next slot
mov r1,r0
add $1004,r0
mov r0,(r1)+ / buf max
mov r2,(r1)+ / seek addr
mov (sp)+,r2
rts r5
putw:
mov r1,-(sp)
mov r2,-(sp)
mov (r5)+,r2
mov (r2)+,r1 / slot
cmp r1,(r2) / buf max
bhis 1f
mov r0,(r1)+
mov r1,-(r2)
br 2f
1:
tst (r2)+
mov r0,-(sp)
jsr r5,flush1
mov (sp)+,r0
mov r0,*(r2)+
add $2,-(r2)
2:
mov (sp)+,r2
mov (sp)+,r1
rts r5
flush:
mov (r5)+,r2
cmp (r2)+,(r2)+
flush1:
mov (r2)+,r1
mov r1,0f / seek address
mov fout,r0
sys indir; 9f
.data
9: sys seek; 0:..; 0
.text
bic $!777,r1
add r2,r1 / write address
mov r1,0f
mov r2,r0
bis $777,-(r2)
inc (r2) / new seek addr
cmp -(r2),-(r2)
sub (r2),r1
neg r1
mov r1,0f+2 / count
mov r0,(r2) / new next slot
mov fout,r0
sys indir; 9f
.data
9: sys write; 0:..; ..
.text
rts r5
readop:
mov savop,r4
beq 1f
clr savop
rts pc
1:
jsr pc,getw1
cmp r4,$200
blo 1f
cmp r4,$4000
blo 2f
add $usymtab-4000,r4
rts pc
2:
add $symtab-1000,r4
1:
rts pc
getw:
mov savop,r4
beq getw1
clr savop
rts pc
getw1:
dec ibufc
bgt 1f
movb fin,r0
sys read; inbuf; 512.
bes 3f
asr r0
mov r0,ibufc
bne 2f
3:
mov $4,r4
sev
rts pc
2:
mov $inbuf,ibufp
1:
mov *ibufp,r4
add $2,ibufp
rts pc
source/as/as25.s
+4
View File
@@ -0,0 +1,4 @@
/
/
/ as25 is empty
source/as/as26.s
+559
View File
@@ -0,0 +1,559 @@
/
/
/ a6 -- pdp-11 assembler pass 2
opline:
mov r4,r0
jsr r5,betwen; 0; 177
br 2f
cmp r4,$5
beq opeof
cmp r4,$'<
bne xpr
jmp opl17
xxpr:
tst (sp)+
xpr:
jsr pc,expres
jsr pc,outw
rts pc
2:
movb (r4),r0
cmp r0,$24 /reg
beq xpr
cmp r0,$33 /est text
beq xpr
cmp r0,$34 / est data
beq xpr
jsr r5,betwen; 5; 36
br xpr
mov 2(r4),-(sp)
mov r0,-(sp)
jsr pc,readop
mov (sp)+,r0
asl r0
mov $adrbuf,r5
clr swapf
mov $-1,rlimit
jmp *1f-10.(r0)
1:
opl5
opl6
opl7
opl10
opl11
opl12
opl13
opl14
opl15
opl16
opl17
opl20
opl21
opl22
opl23
xxpr
opl25
opl26
opl27
opl30
opl31
opl32
xxpr
xxpr
opl35
opl36
opeof:
mov $1,line
mov $20,-(sp)
mov $argb,r1
1:
jsr pc,getw
tst r4
bmi 1f
movb r4,(r1)+
dec (sp)
bgt 1b
tstb -(r1)
br 1b
1:
movb $'\n,(r1)+
clrb (r1)+
tst (sp)+
rts pc
opl30: / mpy, dvd etc
inc swapf
mov $1000,rlimit
br opl13
opl14: / flop freg,fsrc
inc swapf
opl5: / flop src,freg
mov $400,rlimit
/double
opl13:
jsr pc,addres
op2a:
mov r2,-(sp)
jsr pc,readop
op2b:
jsr pc,addres
tst swapf
beq 1f
mov (sp),r0
mov r2,(sp)
mov r0,r2
1:
swab (sp)
asr (sp)
asr (sp)
cmp (sp),rlimit
blo 1f
jsr r5,error; 'x
1:
bis (sp)+,r2
bis (sp)+,r2
clr r3
jsr pc,outw
mov $adrbuf,r1
1:
cmp r1,r5
bhis 1f
mov (r1)+,r2
mov (r1)+,r3
mov (r1)+,xsymbol
jsr pc,outw
br 1b
1:
rts pc
opl15: / single operand
clr -(sp)
br op2b
opl12: / movf
mov $400,rlimit
jsr pc,addres
cmp r2,$4 / see if source is fregister
blo 1f
inc swapf
br op2a
1:
mov $174000,(sp)
br op2a
/ jbr
opl35:
/ jeq, jne, etc
opl36:
jsr pc,expres
tstb passno
bne 1f
mov r2,r0
jsr pc,setbr
tst r2
beq 2f
cmp (sp),$br
beq 2f
add $2,r2
2:
add r2,dot / if doesn't fit
add $2,dot
tst (sp)+
rts pc
1:
jsr pc,getbr
bcc dobranch
mov (sp)+,r0
mov r2,-(sp)
mov r3,-(sp)
cmp r0,$br
beq 2f
mov $402,r2
xor r0,r2 / flip cond, add ".+6"
mov $1,r3
jsr pc,outw
2:
mov $1,r3
mov $jmp+37,r2
jsr pc,outw
mov (sp)+,r3
mov (sp)+,r2
jsr pc,outw
rts pc
/sob
opl31: / sob
jsr pc,expres
jsr pc,checkreg
swab r2
asr r2
asr r2
bis r2,(sp)
jsr pc,readop
jsr pc,expres
tstb passno
beq 3f
sub dot,r2
neg r2
mov r2,r0
jsr r5,betwen; -2; 175
br 2f
add $4,r2
br 1f
/branch
opl6:
jsr pc,expres
tstb passno
beq 3f
dobranch:
sub dot,r2
mov r2,r0
jsr r5,betwen; -254.; 256.
br 2f
1:
bit $1,r2
bne 2f
cmp r3,dot-2 / same relocation as .
bne 2f
asr r2
dec r2
bic $177400,r2
3:
bis (sp)+,r2
clr r3
jsr pc,outw
rts pc
2:
jsr r5,error; 'b
clr r2
br 3b
/jsr
opl7:
jsr pc,expres
jsr pc,checkreg
jmp op2a
/ rts
opl10:
jsr pc,expres
jsr pc,checkreg
br 1f
/ sys, emt etc
opl11:
jsr pc,expres
cmp r2,$64.
bhis 0f
cmp r3,$1
ble 1f
0:
jsr pc,errora
1:
bis (sp)+,r2
jsr pc,outw
rts pc
/ .byte
opl16:
jsr pc,expres
jsr pc,outb
cmp r4,$',
bne 1f
jsr pc,readop
br opl16
1:
tst (sp)+
rts pc
/ < (.ascii)
opl17:
jsr pc,getw
mov $1,r3
mov r4,r2
bmi 2f
bic $!377,r2
jsr pc,outb
br opl17
2:
jsr pc,getw
rts pc
/.even
opl20:
bit $1,dot
beq 1f
cmp dot-2,$4
beq 2f / bss mode
clr r2
clr r3
jsr pc,outb
br 1f
2:
inc dot
1:
tst (sp)+
rts pc
opl21: /if
jsr pc,expres
opl22:
oplret:
tst (sp)+
rts pc
/.globl
opl23:
cmp r4,$200
blo 1f
bisb $40,(r4)
jsr pc,readop
cmp r4,$',
bne 1f
jsr pc,readop
br opl23
1:
tst (sp)+
rts pc
/ .text, .data, .bss
opl25:
opl26:
opl27:
inc dot
bic $1,dot
mov r0,-(sp)
mov dot-2,r1
asl r1
mov dot,savdot-4(r1)
tstb passno
beq 1f
jsr r5,flush; txtp
jsr r5,flush; relp
mov (sp),r2
add $txtseek-[2*25],r2
mov r2,tseekp
mov (r2),r0
jsr r5,oset; txtp
add $trelseek-txtseek,r2
mov (r2),r0
mov r2,rseekp
jsr r5,oset; relp
1:
mov (sp)+,r0
mov savdot-[2*25](r0),dot
asr r0
sub $25-2,r0
mov r0,dot-2 / new . relocation
tst (sp)+
rts pc
opl32:
cmp r4,$200
blo 1f
mov r4,-(sp)
jsr pc,readop
jsr pc,readop
jsr pc,expres
mov (sp)+,r0
bit $37,(r0)
bne 1f
bis $40,(r0)
mov r2,2(r0)
1:
tst (sp)+
rts pc
addres:
clr -(sp)
4:
cmp r4,$'(
beq alp
cmp r4,$'-
beq amin
cmp r4,$'$
beq adoll
cmp r4,$'*
bne getx
jmp astar
getx:
jsr pc,expres
cmp r4,$'(
bne 2f
jsr pc,readop
mov r2,(r5)+
mov r3,(r5)+
mov xsymbol,(r5)+
jsr pc,expres
jsr pc,checkreg
jsr pc,checkrp
bis $60,r2
bis (sp)+,r2
rts pc
2:
cmp r3,$24
bne 1f
jsr pc,checkreg
bis (sp)+,r2
rts pc
1:
mov r3,-(sp)
bic $40,r3
mov (sp)+,r3
bis $100000,r3
sub dot,r2
sub $4,r2
cmp r5,$adrbuf
beq 1f
sub $2,r2
1:
mov r2,(r5)+ / index
mov r3,(r5)+ / index reloc.
mov xsymbol,(r5)+ / index global
mov $67,r2 / address mode
bis (sp)+,r2
rts pc
alp:
jsr pc,readop
jsr pc,expres
jsr pc,checkrp
jsr pc,checkreg
cmp r4,$'+
beq 1f
tst (sp)+
beq 2f
bis $70,r2
clr (r5)+
clr (r5)+
mov xsymbol,(r5)+
rts pc
2:
bis $10,r2
rts pc
1:
jsr pc,readop
bis $20,r2
bis (sp)+,r2
rts pc
amin:
jsr pc,readop
cmp r4,$'(
beq 1f
mov r4,savop
mov $'-,r4
br getx
1:
jsr pc,readop
jsr pc,expres
jsr pc,checkrp
jsr pc,checkreg
bis (sp)+,r2
bis $40,r2
rts pc
adoll:
jsr pc,readop
jsr pc,expres
mov r2,(r5)+
mov r3,(r5)+
mov xsymbol,(r5)+
mov (sp)+,r2
bis $27,r2
rts pc
astar:
tst (sp)
beq 1f
jsr r5,error; '*
1:
mov $10,(sp)
jsr pc,readop
jmp 4b
errora:
jsr r5,error; 'a
rts pc
checkreg:
cmp r2,$7
bhi 1f
cmp r1,$1
blos 2f
cmp r3,$5
blo 1f
2:
rts pc
1:
jsr pc,errora
clr r2
clr r3
rts pc
errore:
jsr r5,error; 'e
rts pc
checkrp:
cmp r4,$')
beq 1f
jsr r5,error; ')
rts pc
1:
jsr pc,readop
rts pc
setbr:
mov brtabp,r1
cmp r1,$brlen
blt 1f
mov $2,r2
rts pc
1:
inc brtabp
clr -(sp)
sub dot,r0
ble 1f
sub brdelt,r0
1:
jsr r5,betwen; -254.; 256.
br 1f
br 2f
1:
mov r1,-(sp)
bic $!7,(sp)
mov $1,r0
ash (sp)+,r0
ash $-3,r1
bisb r0,brtab(r1)
mov $2,(sp)
2:
mov (sp)+,r2
rts pc
getbr:
mov brtabp,r1
cmp r1,$brlen
blt 1f
sec
rts pc
1:
mov r1,-(sp)
bic $!7,(sp)
neg (sp)
inc brtabp
ash $-3,r1
movb brtab(r1),r1
ash (sp)+,r1
ror r1 / 0-bit into c-bit
rts pc
source/as/as27.s
+294
View File
@@ -0,0 +1,294 @@
/
/
/ a7 -- pdp-11 assembler
expres:
clr xsymbol
expres1:
mov r5,-(sp)
mov $'+,-(sp)
clr r2
mov $1,r3
br 1f
advanc:
jsr pc,readop
1:
mov r4,r0
jsr r5,betwen; 0; 177
br .+4
br 7f
movb (r4),r0
tst r0
bne 1f
tstb passno
beq 1f
jsr r5,error; 'u
1:
cmp r0,$40
bne 1f
mov r4,xsymbol
clr r1
br oprand
1:
mov 2(r4),r1
br oprand
7:
cmp r4,$141
blo 1f
asl r4
mov curfb-[2*141](r4),r0
mov 2(r0),r1
movb (r0),r0
br oprand
1:
mov $esw1,r1
1:
cmp (r1)+,r4
beq 1f
tst (r1)+
bne 1b
tst (sp)+
mov (sp)+,r5
rts pc
1:
jmp *(r1)
esw1:
'+; binop
'-; binop
'*; binop
'/; binop
'&; binop
037; binop
035; binop
036; binop
'%; binop
'[; brack
'^; binop
1; exnum
2; exnum1
'!; binop
200; 0
binop:
cmpb (sp),$'+
beq 1f
jsr pc,errore
1:
movb r4,(sp)
br advanc
exnum1:
mov numval,r1
br 1f
exnum:
jsr pc,getw
mov r4,r1
1:
mov $1,r0
br oprand
brack:
mov r2,-(sp)
mov r3,-(sp)
jsr pc,readop
jsr pc,expres1
cmp r4,$']
beq 1f
jsr r5,error; ']
1:
mov r3,r0
mov r2,r1
mov (sp)+,r3
mov (sp)+,r2
oprand:
mov $exsw2,r5
1:
cmp (sp),(r5)+
beq 1f
tst (r5)+
bne 1b
br eoprnd
1:
jmp *(r5)
exsw2:
'+; exadd
'-; exsub
'*; exmul
'/; exdiv
037; exor
'&; exand
035;exlsh
036;exrsh
'%; exmod
'^; excmbin
'!; exnot
200; 0
excmbin:
mov r0,r3
br eoprnd
exrsh:
neg r1
beq exlsh
inc r1
clc
ror r2
exlsh:
jsr r5,combin; relte2
als r1,r2
br eoprnd
exmod:
jsr r5,combin; relte2
mov r3,r0
mov r2,r3
clr r2
dvd r1,r2
mov r3,r2
mov r0,r3
br eoprnd
exadd:
jsr r5,combin; reltp2
add r1,r2
br eoprnd
exsub:
jsr r5,combin; reltm2
sub r1,r2
br eoprnd
exand:
jsr r5,combin; relte2
com r1
bic r1,r2
br eoprnd
exor:
jsr r5,combin; relte2
bis r1,r2
br eoprnd
exmul:
jsr r5,combin; relte2
mpy r2,r1
mov r1,r2
br eoprnd
exdiv:
jsr r5,combin; relte2
mov r3,r0
mov r2,r3
clr r2
dvd r1,r2
mov r0,r3
br eoprnd
exnot:
jsr r5,combin; relte2
com r1
add r1,r2
br eoprnd
eoprnd:
mov $'+,(sp)
jmp advanc
combin:
tstb passno
bne combin1
mov r0,-(sp)
bis r3,(sp)
bic $!40,(sp)
bic $!37,r0
bic $!37,r3
cmp r0,r3
ble 1f
mov r0,-(sp)
mov r3,r0
mov (sp)+,r3
1:
tst r0
beq 1f
cmp (r5)+,$reltm2
bne 2f
cmp r0,r3
bne 2f
mov $1,r3
br 2f
1:
tst (r5)+
clr r3
2:
bis (sp)+,r3
rts r5
combin1:
mov r1,-(sp)
clr maxtyp
jsr pc,maprel
mov r0,r1
mpy $6,r1
mov r3,r0
jsr pc,maprel
add (r5)+,r0
add r1,r0
movb (r0),r3
bpl 1f
cmp r3,$-1
beq 2f
jsr r5,error; 'r
2:
mov maxtyp,r3
1:
mov (sp)+,r1
rts r5
maprel:
cmp r0,$40
bne 1f
mov $5,r0
rts pc
1:
bic $!37,r0
cmp r0,maxtyp
blos 1f
mov r0,maxtyp
1:
cmp r0,$5
blos 1f
mov $1,r0
1:
rts pc
X = -2
M = -1
reltp2:
.byte 0, 0, 0, 0, 0, 0
.byte 0, M, 2, 3, 4,40
.byte 0, 2, X, X, X, X
.byte 0, 3, X, X, X, X
.byte 0, 4, X, X, X, X
.byte 0,40, X, X, X, X
reltm2:
.byte 0, 0, 0, 0, 0, 0
.byte 0, M, 2, 3, 4,40
.byte 0, X, 1, X, X, X
.byte 0, X, X, 1, X, X
.byte 0, X, X, X, 1, X
.byte 0, X, X, X, X, X
relte2:
.byte 0, 0, 0, 0, 0, 0
.byte 0, M, X, X, X, X
.byte 0, X, X, X, X, X
.byte 0, X, X, X, X, X
.byte 0, X, X, X, X, X
.byte 0, X, X, X, X, X
source/as/as28.s
+77
View File
@@ -0,0 +1,77 @@
/
/
/ as8 -- PDP-11 assembler pass 2
qnl: <?\n>
a.out: <a.out\0>
.even
a.outp: a.out
.data
a.tmp1: 0
a.tmp2: 0
a.tmp3: 0
tseekp: txtseek
rseekp: trelseek
txtmagic:
br .+20
txtsiz: .=.+2
datsiz: .=.+2
bsssiz: .=.+2
symsiz: .=.+2
stksiz: .=.+2
exorig: .=.+2
.=.+2
txtseek: 20
datseek:.=.+2
.=.+2
trelseek:.=.+2
drelseek:.=.+2
.=.+2
symseek:.=.+2
.bss
brlen = 1024.
brtab: .=.+[brlen\/8.]
brtabp: .=.+2
brdelt: .=.+2
fbbufp: .=.+2
defund: .=.+2
savdot: .=.+6
datbase:.=.+2
bssbase:.=.+2
fbfil: .=.+2
fin: .=.+2
ibufc: .=.+2
txtfil: .=.+2
symf: .=.+2
adrbuf: .=.+12.
xsymbol:.=.+2
fout: .=.+2
ch: .=.+2
wordf: .=.+2
argb: .=.+22.
line: .=.+2
savop: .=.+2
curfb: .=.+20.
nxtfb: .=.+20.
numval: .=.+2
maxtyp: .=.+2
relfil: .=.+2
ibufp: .=.+2
txtp: .=.+6+512.
relp: .=.+6+512.
swapf: .=.+2
rlimit: .=.+2
passno: .=.+2
endtable:.=.+2
usymtab:.=.+20.
end:
.text
source/as/as29.s
+280
View File
@@ -0,0 +1,280 @@
/
/
/ as9 -- PDP-11 assembler pass 2
eae = 0
.data
symtab:
/ special variables
dotrel: 02; dot:000000 /.
01; dotdot:000000 /..
/ register
24;000000 /r0
24;000001 /r1
24;000002 /r2
24;000003 /r3
24;000004 /r4
24;000005 /r5
24;000006 /sp
24;000007 /pc
.if eae
/eae & switches
01;177570 /csw
01;177300 /div
01;177302 /ac
01;177304 /mq
01;177306 /mul
01;177310 /sc
01;177311 /sr
01;177312 /nor
01;177314 /lsh
01;177316 /ash
.endif
/ system calls
01;0000001 /exit
01;0000002 /fork
01;0000003 /read
01;0000004 /write
01;0000005 /open
01;0000006 /close
01;0000007 /wait
01;0000010 /creat
01;0000011 /link
01;0000012 /unlink
01;0000013 /exec
01;0000014 /chdir
01;0000015 /time
01;0000016 /makdir
01;0000017 /chmod
01;0000020 /chown
01;0000021 /break
01;0000022 /stat
01;0000023 /seek
01;0000024 /tell
01;0000025 /mount
01;0000026 /umount
01;0000027 /setuid
01;0000030 /getuid
01;0000031 /stime
01;0000034 /fstat
01;0000036 /mdate
01;0000037 /stty
01;0000040 /gtty
01;0000042 /nice
01;0000060 /signal
/ double operand
13;0010000 /mov
13;0110000 /movb
13;0020000 /cmp
13;0120000 /cmpb
13;0030000 /bit
13;0130000 /bitb
13;0040000 /bic
13;0140000 /bicb
13;0050000 /bis
13;0150000 /bisb
13;0060000 /add
13;0160000 /sub
/ branch
06;0000400 /br
06;0001000 /bne
06;0001400 /beq
06;0002000 /bge
06;0002400 /blt
06;0003000 /bgt
06;0003400 /ble
06;0100000 /bpl
06;0100400 /bmi
06;0101000 /bhi
06;0101400 /blos
06;0102000 /bvc
06;0102400 /bvs
06;0103000 /bhis
06;0103000 /bec
06;0103000 /bcc
06;0103400 /blo
06;0103400 /bcs
06;0103400 /bes
/ jump/ branch type
35;0000400 /jbr
36;0001000 /jne
36;0001400 /jeq
36;0002000 /jge
36;0002400 /jlt
36;0003000 /jgt
36;0003400 /jle
36;0100000 /jpl
36;0100400 /jmi
36;0101000 /jhi
36;0101400 /jlos
36;0102000 /jvc
36;0102400 /jvs
36;0103000 /jhis
36;0103000 /jec
36;0103000 /jcc
36;0103400 /jlo
36;0103400 /jcs
36;0103400 /jes
/ single operand
15;0005000 /clr
15;0105000 /clrb
15;0005100 /com
15;0105100 /comb
15;0005200 /inc
15;0105200 /incb
15;0005300 /dec
15;0105300 /decb
15;0005400 /neg
15;0105400 /negb
15;0005500 /adc
15;0105500 /adcb
15;0005600 /sbc
15;0105600 /sbcb
15;0005700 /tst
15;0105700 /tstb
15;0006000 /ror
15;0106000 /rorb
15;0006100 /rol
15;0106100 /rolb
15;0006200 /asr
15;0106200 /asrb
15;0006300 /asl
15;0106300 /aslb
15;0000100 /jmp
15;0000300 /swab
/ jsr
07;0004000 /jsr
/ rts
10;000200 /rts
/ simple operand
11;104400 /sys
/ flag-setting
01;0000241 /clc
01;0000242 /clv
01;0000244 /clz
01;0000250 /cln
01;0000261 /sec
01;0000262 /sev
01;0000264 /sez
01;0000270 /sen
/ floating point ops
01;170000 / cfcc
01;170001 / setf
01;170011 / setd
01;170002 / seti
01;170012 / setl
15;170400 / clrf
15;170700 / negf
15;170600 / absf
15;170500 / tstf
12;172400 / movf
14;177000 / movif
05;175400 / movfi
14;177400 / movof
05;176000 / movfo
14;172000 / addf
14;173000 / subf
14;171000 / mulf
14;174400 / divf
14;173400 / cmpf
14;171400 / modf
14;176400 / movie
05;175000 / movei
15;170100 / ldfps
15;170200 / stfps
24;000000 / fr0
24;000001 / fr1
24;000002 / fr2
24;000003 / fr3
24;000004 / fr4
24;000005 / fr5
/ 11/45 operations
30;072000 /als (ash)
30;073000 /alsc (ashc)
30;070000 /mpy
.if eae-1
30;070000/ mul
30;071000 / div
30;072000 / ash
30;073000 /ashc
.endif
30;071000 /dvd
07;074000 /xor
15;006700 /sxt
11;006400 /mark
31;077000 /sob
/ specials
16;000000 /.byte
20;000000 /.even
21;000000 /.if
22;000000 /.endif
23;000000 /.globl
25;000000 /.text
26;000000 /.data
27;000000 /.bss
32;000000 /.comm
start:
cmp (sp),$4
bge 1f
jmp aexit
1:
cmp (sp)+,$5
blt 1f
mov $40,defund / globalize all undefineds
1:
tst (sp)+
mov (sp)+,a.tmp1
mov (sp)+,a.tmp2
mov (sp)+,a.tmp3
jsr r5,ofile; a.tmp1
movb r0,txtfil
jsr r5,ofile; a.tmp2
movb r0,fbfil
jsr r5,ofile; a.tmp3
movb r0,symf
movb r0,fin
sys creat; a.out; 0
bec 1f
jsr r5,filerr; a.outp
1:
movb r0,fout
jmp go
/ overlaid buffer
inbuf = start
. = inbuf+512.
source/as/run
+9
View File
@@ -0,0 +1,9 @@
as as1?.s
ld -s -n a.out
cmp a.out /bin/as
cp a.out /bin/as
as as2?.s
ld -s -n a.out
cmp a.out /lib/as2
cp a.out /lib/as2
rm a.out
source/c/c00.c
+709
View File
@@ -0,0 +1,709 @@
#
/* C compiler
*
*
*
* Called from cc:
* c0 source temp1 temp2 [ profileflag ]
* temp1 contains some ascii text and the binary expression
* trees. Each tree is introduced by the # character.
* Strings are put on temp2, which cc tacks onto
* temp1 for assembly.
*/
#include "c0h.c"
int isn 1;
int stflg 1;
int peeksym -1;
int line 1;
int debug 0;
int dimp 0;
struct tname funcblk { NAME, 0, 0, REG, 0, 0 };
int *treespace { osspace };
struct kwtab {
char *kwname;
int kwval;
} kwtab[]
{
"int", INT,
"char", CHAR,
"float", FLOAT,
"double", DOUBLE,
"struct", STRUCT,
"long", LONG,
"auto", AUTO,
"extern", EXTERN,
"static", STATIC,
"register", REG,
"goto", GOTO,
"return", RETURN,
"if", IF,
"while", WHILE,
"else", ELSE,
"switch", SWITCH,
"case", CASE,
"break", BREAK,
"continue", CONTIN,
"do", DO,
"default", DEFAULT,
"for", FOR,
"sizeof", SIZEOF,
0, 0,
};
main(argc, argv)
char *argv[];
{
extern fin;
register char *sp;
register i;
register struct kwtab *ip;
if(argc<3) {
error("Arg count");
exit(1);
}
if((fin=open(argv[1],0))<0) {
error("Can't find %s", argv[1]);
exit(1);
}
if (fcreat(argv[2], obuf)<0 || fcreat(argv[3], sbuf)<0) {
error("Can't create temp");
exit(1);
}
if (argc>4)
proflg++;
/*
* The hash table locations of the keywords
* are marked; if an identifier hashes to one of
* these locations, it is looked up in in the keyword
* table first.
*/
for (ip=kwtab; (sp = ip->kwname); ip++) {
i = 0;
while (*sp)
i =+ *sp++;
hshtab[i%hshsiz].hflag = FKEYW;
}
while(!eof) {
extdef();
blkend();
}
outcode("B", EOF);
strflg++;
outcode("B", EOF);
fflush(obuf);
fflush(sbuf);
exit(nerror!=0);
}
/*
* Look up the identifier in symbuf in the symbol table.
* If it hashes to the same spot as a keyword, try the keyword table
* first. An initial "." is ignored in the hash.
* Return is a ptr to the symbol table entry.
*/
lookup()
{
int ihash;
register struct hshtab *rp;
register char *sp, *np;
ihash = 0;
sp = symbuf;
if (*sp=='.')
sp++;
while (sp<symbuf+ncps)
ihash =+ *sp++;
rp = &hshtab[ihash%hshsiz];
if (rp->hflag&FKEYW)
if (findkw())
return(KEYW);
while (*(np = rp->name)) {
for (sp=symbuf; sp<symbuf+ncps;)
if (*np++ != *sp++)
goto no;
csym = rp;
return(NAME);
no:
if (++rp >= &hshtab[hshsiz])
rp = hshtab;
}
if(++hshused >= hshsiz) {
error("Symbol table overflow");
exit(1);
}
rp->hclass = 0;
rp->htype = 0;
rp->hoffset = 0;
rp->dimp = 0;
rp->hflag =| xdflg;
sp = symbuf;
for (np=rp->name; sp<symbuf+ncps;)
*np++ = *sp++;
csym = rp;
return(NAME);
}
/*
* Search the keyword table.
* Ignore initial "." to avoid member-of-structure
* problems.
*/
findkw()
{
register struct kwtab *kp;
register char *p1, *p2;
char *wp;
wp = symbuf;
if (*wp=='.')
wp++;
for (kp=kwtab; (p2 = kp->kwname); kp++) {
p1 = wp;
while (*p1 == *p2++)
if (*p1++ == '\0') {
cval = kp->kwval;
return(1);
}
}
return(0);
}
/*
* Return the next symbol from the input.
* peeksym is a pushed-back symbol, peekc is a pushed-back
* character (after peeksym).
* mosflg means that the next symbol, if an identifier,
* is a member of structure or a structure tag, and it
* gets a "." prepended to it to distinguish
* it from other identifiers.
*/
symbol() {
register c;
register char *sp;
if (peeksym>=0) {
c = peeksym;
peeksym = -1;
if (c==NAME)
mosflg = 0;
return(c);
}
if (peekc) {
c = peekc;
peekc = 0;
} else
if (eof)
return(EOF);
else
c = getchar();
loop:
switch(ctab[c]) {
case INSERT: /* ignore newlines */
inhdr = 1;
c = getchar();
goto loop;
case NEWLN:
if (!inhdr)
line++;
inhdr = 0;
case SPACE:
c = getchar();
goto loop;
case EOF:
eof++;
return(0);
case PLUS:
return(subseq(c,PLUS,INCBEF));
case MINUS:
return(subseq(c,subseq('>',MINUS,ARROW),DECBEF));
case ASSIGN:
if (subseq(' ',0,1)) return(ASSIGN);
c = symbol();
if (c>=PLUS && c<=EXOR) {
if (spnextchar() != ' '
&& (c==MINUS || c==AND || c==TIMES)) {
error("Warning: assignment operator assumed");
nerror--;
}
return(c+ASPLUS-PLUS);
}
if (c==ASSIGN)
return(EQUAL);
peeksym = c;
return(ASSIGN);
case LESS:
if (subseq(c,0,1)) return(LSHIFT);
return(subseq('=',LESS,LESSEQ));
case GREAT:
if (subseq(c,0,1)) return(RSHIFT);
return(subseq('=',GREAT,GREATEQ));
case EXCLA:
return(subseq('=',EXCLA,NEQUAL));
case DIVIDE:
if (subseq('*',1,0))
return(DIVIDE);
while ((c = spnextchar()) != EOF) {
peekc = 0;
if (c=='*') {
if (spnextchar() == '/') {
peekc = 0;
c = getchar();
goto loop;
}
}
}
eof++;
error("Nonterminated comment");
return(0);
case PERIOD:
case DIGIT:
peekc = c;
if ((c=getnum(c=='0'?8:10)) == FCON)
cval = isn++;
return(c);
case DQUOTE:
return(getstr());
case SQUOTE:
return(getcc());
case LETTER:
sp = symbuf;
if (mosflg) {
*sp++ = '.';
mosflg = 0;
}
while(ctab[c]==LETTER || ctab[c]==DIGIT) {
if (sp<symbuf+ncps) *sp++ = c;
c = getchar();
}
while(sp<symbuf+ncps)
*sp++ = '\0';
peekc = c;
if ((c=lookup())==KEYW && cval==SIZEOF)
c = SIZEOF;
return(c);
case AND:
return(subseq('&', AND, LOGAND));
case OR:
return(subseq('|', OR, LOGOR));
case UNKN:
error("Unknown character");
c = getchar();
goto loop;
}
return(ctab[c]);
}
/*
* If the next input character is c, return a and advance.
* Otherwise push back the character and return a.
*/
subseq(c,a,b)
{
if (spnextchar() != c)
return(a);
peekc = 0;
return(b);
}
/*
* Read a double-quoted string, placing it on the
* string buffer.
*/
getstr()
{
register int c;
register char *sp;
nchstr = 1;
sp = savstr;
while((c=mapch('"')) >= 0) {
nchstr++;
if (sp >= &savstr[STRSIZ]) {
sp = savstr;
error("String too long");
}
*sp++ = c;
}
strptr = sp;
cval = isn++;
return(STRING);
}
/*
* Write out a string, either in-line
* or in the string temp file labelled by
* lab.
*/
putstr(lab)
{
register char *sp;
if (lab) {
strflg++;
outcode("BNB", LABEL, lab, BDATA);
} else
outcode("B", BDATA);
for (sp = savstr; sp<strptr; )
outcode("1N", *sp++ & 0377);
outcode("100");
strflg = 0;
}
/*
* read a single-quoted character constant.
* The routine is sensitive to the layout of
* characters in a word.
*/
getcc()
{
register int c, cc;
register char *ccp;
cval = 0;
ccp = &cval;
cc = 0;
while((c=mapch('\'')) >= 0)
if(cc++ < NCPW)
*ccp++ = c;
if(cc>NCPW)
error("Long character constant");
return(CON);
}
/*
* Read a character in a string or character constant,
* detecting the end of the string.
* It implements the escape sequences.
*/
mapch(ac)
{
register int a, c, n;
static mpeek;
c = ac;
if (a = mpeek)
mpeek = 0;
else
a = getchar();
loop:
if (a==c)
return(-1);
switch(a) {
case '\n':
case '\0':
error("Nonterminated string");
peekc = a;
return(-1);
case '\\':
switch (a=getchar()) {
case 't':
return('\t');
case 'n':
return('\n');
case 'b':
return('\b');
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
n = 0;
c = 0;
while (++c<=3 && '0'<=a && a<='7') {
n =<< 3;
n =+ a-'0';
a = getchar();
}
mpeek = a;
return(n);
case 'r':
return('\r');
case '\n':
if (!inhdr)
line++;
inhdr = 0;
a = getchar();
goto loop;
}
}
return(a);
}
/*
* Read an expression and return a pointer to its tree.
* It's the classical bottom-up, priority-driven scheme.
* The initflg prevents the parse from going past
* "," or ":" because those delimitesrs are special
* in initializer (and some other) expressions.
*/
tree()
{
#define SEOF 200
#define SSIZE 20
int *op, opst[SSIZE], *pp, prst[SSIZE];
register int andflg, o;
register struct hshtab *cs;
int p, ps, os;
space = treespace;
op = opst;
pp = prst;
cp = cmst;
*op = SEOF;
*pp = 06;
andflg = 0;
advanc:
switch (o=symbol()) {
case NAME:
cs = csym;
if (cs->hclass==0 && cs->htype==0)
if(nextchar()=='(') {
/* set function */
cs->hclass = EXTERN;
cs->htype = FUNC;
} else if (initflg)
cs->hclass = EXTERN;
else {
/* set label */
cs->htype = ARRAY;
if (cs->hoffset==0)
cs->hoffset = isn++;
}
*cp++ = copname(cs);
goto tand;
case FCON:
if (!initflg)
outcode("BBNB1N1N1N1N0B", DATA,LABEL,
cval, WDATA, fcval, PROG);
case CON:
case SFCON:
*cp++ = block(1,o,(o==CON?INT:DOUBLE),0,cval);
goto tand;
/* fake a static char array */
case STRING:
putstr(cval);
*cp++ = block(3, NAME, ARRAY+CHAR,0,STATIC,0,cval);
tand:
if(cp>=cmst+cmsiz) {
error("Expression overflow");
exit(1);
}
if (andflg)
goto syntax;
andflg = 1;
goto advanc;
case INCBEF:
case DECBEF:
if (andflg)
o =+ 2;
goto oponst;
case COMPL:
case EXCLA:
case SIZEOF:
if (andflg)
goto syntax;
goto oponst;
case MINUS:
if (!andflg) {
if ((peeksym=symbol())==FCON) {
fcval = - fcval;
goto advanc;
}
if (peeksym==SFCON) {
fcval = - fcval;
cval =^ 0100000;
goto advanc;
}
o = NEG;
}
andflg = 0;
goto oponst;
case AND:
case TIMES:
if (andflg)
andflg = 0; else
if(o==AND)
o = AMPER;
else
o = STAR;
goto oponst;
case LPARN:
if (andflg) {
o = symbol();
if (o==RPARN)
o = MCALL;
else {
peeksym = o;
o = CALL;
andflg = 0;
}
}
goto oponst;
case RBRACK:
case RPARN:
if (!andflg)
goto syntax;
goto oponst;
case DOT:
case ARROW:
mosflg++;
break;
}
/* binaries */
if (!andflg)
goto syntax;
andflg = 0;
oponst:
p = (opdope[o]>>9) & 077;
if ((o==COMMA || o==COLON) && initflg)
p = 05;
opon1:
ps = *pp;
if (p>ps || p==ps && (opdope[o]&RASSOC)!=0) {
switch (o) {
case INCAFT:
case DECAFT:
p = 37;
break;
case LPARN:
case LBRACK:
case CALL:
p = 04;
}
if (op >= &opst[SSIZE-1]) {
error("expression overflow");
exit(1);
}
*++op = o;
*++pp = p;
goto advanc;
}
--pp;
switch (os = *op--) {
case SEOF:
peeksym = o;
build(0); /* flush conversions */
return(*--cp);
case CALL:
if (o!=RPARN)
goto syntax;
build(os);
goto advanc;
case MCALL:
*cp++ = block(0,0,0,0); /* 0 arg call */
os = CALL;
break;
case INCBEF:
case INCAFT:
case DECBEF:
case DECAFT:
*cp++ = block(1, CON, INT, 0, 1);
break;
case LPARN:
if (o!=RPARN)
goto syntax;
goto advanc;
case LBRACK:
if (o!=RBRACK)
goto syntax;
build(LBRACK);
goto advanc;
}
build(os);
goto opon1;
syntax:
error("Expression syntax");
errflush(o);
return(0);
}
/*
* Generate a tree node for a name.
* All the relevant info from the symbol table is
* copied out, including the name if it's an external.
* This is because the symbol table is gone in the next
* pass, so a ptr isn't sufficient.
*/
copname(acs)
struct hshtab *acs;
{
register struct hshtab *cs;
register struct tname *tp;
register char *cp1;
int i;
char *cp2;
cs = acs;
tp = gblock(sizeof(*tp)/NCPW);
tp->op = NAME;
tp->type = cs->htype;
tp->dimp = cs->hdimp;
if ((tp->class = cs->hclass)==0)
tp->class = STATIC;
tp->offset = 0;
tp->nloc = cs->hoffset;
if (cs->hclass==EXTERN) {
gblock((ncps-NCPW)/NCPW);
cp1 = tp->nname;
cp2 = cs->name;
i = ncps;
do {
*cp1++ = *cp2++;
} while (--i);
}
if (cs->hflag&FFIELD)
tp->class = FMOS;
return(tp);
}
source/c/c01.c
+521
View File
@@ -0,0 +1,521 @@
#
/*
* C compiler
*
*
*/
#include "c0h.c"
/*
* Called from tree, this routine takes the top 1, 2, or 3
* operands on the expression stack, makes a new node with
* the operator op, and puts it on the stack.
* Essentially all the work is in inserting
* appropriate conversions.
*/
build(op) {
register int t1;
int t2, t3, t;
struct tnode *p3, *disarray();
register struct tnode *p1, *p2;
int d, dope, leftc, cvn, pcvn;
/*
* a[i] => *(a+i)
*/
if (op==LBRACK) {
build(PLUS);
op = STAR;
}
dope = opdope[op];
if ((dope&BINARY)!=0) {
p2 = chkfun(disarray(*--cp));
t2 = p2->type;
}
p1 = *--cp;
/*
* sizeof gets turned into a number here.
* Bug: sizeof(structure-member-array) is 2 because
* the array has been turned into a ptr already.
*/
if (op==SIZEOF) {
t1 = length(p1);
p1->op = CON;
p1->type = INT;
p1->dimp = 0;
p1->value = t1;
*cp++ = p1;
return;
}
if (op!=AMPER) {
p1 = disarray(p1);
if (op!=CALL)
p1 = chkfun(p1);
}
t1 = p1->type;
pcvn = 0;
t = INT;
switch (op) {
/* end of expression */
case 0:
*cp++ = p1;
return;
/* no-conversion operators */
case QUEST:
if (p2->op!=COLON)
error("Illegal conditional");
t = t2;
case COMMA:
case LOGAND:
case LOGOR:
*cp++ = block(2, op, t, 0, p1, p2);
return;
case CALL:
if ((t1&XTYPE) != FUNC)
error("Call of non-function");
*cp++ = block(2,CALL,decref(t1),p1->dimp,p1,p2);
return;
case STAR:
if (p1->op==AMPER ) {
*cp++ = p1->tr1;
return;
}
if ((t1&XTYPE) == FUNC)
error("Illegal indirection");
*cp++ = block(1,STAR,decref(t1),p1->dimp,p1);
return;
case AMPER:
if (p1->op==STAR) {
p1->tr1->dimp = p1->dimp;
p1->tr1->type = incref(t1);
*cp++ = p1->tr1;
return;
}
if (p1->op==NAME) {
*cp++ = block(1,op,incref(t1),p1->dimp,p1);
return;
}
error("Illegal lvalue");
break;
/*
* a->b goes to (*a).b
*/
case ARROW:
*cp++ = p1;
chkw(p1, -1);
p1->type = PTR+STRUCT;
build(STAR);
p1 = *--cp;
/*
* In a.b, a fairly complicated process has to
* be used to make the left operand look
* as if it had the type of the second.
* Also, the offset in the structure has to be
* given a special type to prevent conversion.
*/
case DOT:
if (p2->op!=NAME || (p2->class!=MOS && p2->class!=FMOS))
error("Illegal structure ref");
*cp++ = p1;
t = t2;
if ((t&XTYPE) == ARRAY) {
t = decref(t);
p2->ssp++;
}
setype(p1, t, p2->dimp);
build(AMPER);
*cp++ = block(1,CON,NOTYPE,0,p2->nloc);
build(PLUS);
if ((t2&XTYPE) != ARRAY)
build(STAR);
if (p2->class == FMOS)
*cp++ = block(2, FSEL, t, 0, *--cp, p2->dimp);
return;
}
if ((dope&LVALUE)!=0)
chklval(p1);
if ((dope&LWORD)!=0)
chkw(p1, LONG);
if ((dope&RWORD)!=0)
chkw(p2, LONG);
if ((dope&BINARY)==0) {
if (op==ITOF)
t1 = DOUBLE;
else if (op==FTOI)
t1 = INT;
if (!fold(op, p1, 0))
*cp++ = block(1,op,t1,p1->dimp,p1);
return;
}
cvn = 0;
if (t1==STRUCT || t2==STRUCT) {
error("Unimplemented structure operation");
t1 = t2 = INT;
}
if (t2==NOTYPE) {
t = t1;
p2->type = INT; /* no int cv for struct */
t2 = INT;
} else
cvn = cvtab[lintyp(t1)][lintyp(t2)];
leftc = (cvn>>4)&017;
cvn =& 017;
t = leftc? t2:t1;
if (dope&ASSGOP) {
t = t1;
if (op==ASSIGN && (cvn==ITP||cvn==PTI))
cvn = leftc = 0;
if (leftc)
cvn = leftc;
leftc = 0;
} else if (op==COLON && t1>=PTR && t1==t2)
cvn = 0;
else if (dope&RELAT) {
if (op>=LESSEQ && (t1>=PTR || t2>=PTR))
op =+ LESSEQP-LESSEQ;
if (cvn==PTI)
cvn = 0;
}
if (cvn==PTI) {
cvn = 0;
if (op==MINUS) {
t = INT;
pcvn++;
} else {
if (t1!=t2 || t1!=(PTR+CHAR))
cvn = XX;
}
}
if (cvn) {
t1 = plength(p1);
t2 = plength(p2);
if (cvn==XX || (cvn==PTI&&t1!=t2))
error("Illegal conversion");
else if (leftc)
p1 = convert(p1, t, cvn, t2);
else
p2 = convert(p2, t, cvn, t1);
}
if (dope&RELAT)
t = INT;
if (fold(op, p1, p2)==0)
*cp++ = block(2,op,t,(p1->dimp==0? p2:p1)->dimp,p1,p2);
if (pcvn && t1!=(PTR+CHAR)) {
p1 = *--cp;
*cp++ = convert(p1, 0, PTI, plength(p1->tr1));
}
}
/*
* Generate the appropirate conversion operator.
* For pointer <=> integer this is a multiplication
* or division, otherwise a special operator.
*/
convert(p, t, cvn, len)
struct tnode *p;
{
register int n;
switch(cvn) {
case PTI:
case ITP:
if (len==1)
return(p);
return(block(2, (cvn==PTI?DIVIDE:TIMES), t, 0, p,
block(1, CON, 0, 0, len)));
case ITF:
n = ITOF;
break;
case FTI:
n = FTOI;
break;
case ITL:
n = ITOL;
break;
case LTI:
n = LTOI;
break;
case FTL:
n = FTOL;
break;
case LTF:
n = LTOF;
break;
}
return(block(1, n, t, 0, p));
}
/*
* Traverse an expression tree, adjust things
* so the types of things in it are consistent
* with the view that its top node has
* type at.
* Used with structure references.
*/
setype(ap, at, adimptr)
struct tnode *ap;
{
register struct tnode *p;
register t, dimptr;
p = ap;
t = at;
dimptr = adimptr;
p->type = t;
if (dimptr != -1)
p->dimp = dimptr;
switch(p->op) {
case AMPER:
setype(p->tr1, decref(t), dimptr);
return;
case STAR:
setype(p->tr1, incref(t), dimptr);
return;
case PLUS:
case MINUS:
setype(p->tr1, t, dimptr);
}
}
/*
* A mention of a function name is turned into
* a pointer to that function.
*/
chkfun(ap)
struct tnode *ap;
{
register struct tnode *p;
register int t;
p = ap;
if (((t = p->type)&XTYPE)==FUNC)
return(block(1,AMPER,incref(t),p->dimp,p));
return(p);
}
/*
* A mention of an array is turned into
* a pointer to the base of the array.
*/
struct tnode *disarray(ap)
struct tnode *ap;
{
register int t;
register struct tnode *p;
p = ap;
/* check array & not MOS */
if (((t = p->type)&XTYPE)!=ARRAY || p->op==NAME&&p->class==MOS)
return(p);
p->ssp++;
*cp++ = p;
setype(p, decref(t), -1);
build(AMPER);
return(*--cp);
}
/*
* make sure that p is a ptr to a node
* with type int or char or 'okt.'
* okt might be nonexistent or 'long'
* (e.g. for <<).
*/
chkw(p, okt)
struct tnode *p;
{
register int t;
if ((t=p->type)>CHAR && t<PTR && t!=okt)
error("Integer operand required");
return;
}
/*
*'linearize' a type for looking up in the
* conversion table
*/
lintyp(t)
{
switch(t) {
case INT:
case CHAR:
return(0);
case FLOAT:
case DOUBLE:
return(1);
case LONG:
return(2);
default:
return(3);
}
}
/*
* Report an error.
*/
error(s, p1, p2, p3, p4, p5, p6)
{
nerror++;
printf("%d: ", line);
printf(s, p1, p2, p3, p4, p5, p6);
printf("\n");
}
/*
* Generate a node in an expression tree,
* setting the operator, type, degree (unused in this pass)
* and the operands.
*/
block(an, op, t, d, p1,p2,p3)
int *p1, *p2, *p3;
{
register int *ap, *p, n;
int *oldp;
n = an+3;
p = gblock(n);
oldp = p;
ap = &op;
do {
*p++ = *ap++;
} while (--n);
return(oldp);
}
/*
* Assign an unitialized block for use in the
* expression tree.
*/
gblock(n)
{
register int *p;
p = space;
if ((space =+ n) >= &osspace[OSSIZ]) {
error("Expression overflow");
exit(1);
}
return(p);
}
/*
* Check that a tree can be used as an lvalue.
*/
chklval(ap)
struct tnode *ap;
{
register struct tnode *p;
p = ap;
if (p->op!=NAME && p->op!=STAR)
error("Lvalue required");
}
/*
* reduce some forms of `constant op constant'
* to a constant. More of this is done in the next pass
* but this is used to allow constant expressions
* to be used in switches and array bounds.
*/
fold(op, ap1, ap2)
struct tnode *ap1, *ap2;
{
register struct tnode *p1;
register int v1, v2;
p1 = ap1;
if (p1->op!=CON || (ap2!=0 && ap2->op!=CON))
return(0);
v1 = p1->value;
v2 = ap2->value;
switch (op) {
case PLUS:
v1 =+ v2;
break;
case MINUS:
v1 =- v2;
break;
case TIMES:
v1 =* v2;
break;
case DIVIDE:
v1 =/ v2;
break;
case MOD:
v1 =% v2;
break;
case AND:
v1 =& v2;
break;
case OR:
v1 =| v2;
break;
case EXOR:
v1 =^ v2;
break;
case NEG:
v1 = - v1;
break;
case COMPL:
v1 = ~ v1;
break;
case LSHIFT:
v1 =<< v2;
break;
case RSHIFT:
v1 =>> v2;
break;
default:
return(0);
}
p1->value = v1;
*cp++ = p1;
return(1);
}
/*
* Compile an expression expected to have constant value,
* for example an array bound or a case value.
*/
conexp()
{
register struct tnode *t;
initflg++;
if (t = tree())
if (t->op != CON)
error("Constant required");
initflg--;
return(t->value);
}
source/c/c02.c
+673
View File
@@ -0,0 +1,673 @@
#
/* C compiler
*
*
*/
#include "c0h.c"
/*
* Process a single external definition
*/
extdef()
{
register o, elsize;
int type, sclass;
register struct hshtab *ds;
if(((o=symbol())==EOF) || o==SEMI)
return;
peeksym = o;
type = INT;
sclass = EXTERN;
xdflg = FNDEL;
if ((elsize = getkeywords(&sclass, &type)) == -1 && peeksym!=NAME)
goto syntax;
if (type==STRUCT)
blkhed();
do {
defsym = 0;
decl1(EXTERN, type, 0, elsize);
if ((ds=defsym)==0)
return;
funcsym = ds;
ds->hflag =| FNDEL;
outcode("BS", SYMDEF, ds->name);
xdflg = 0;
if ((ds->type&XTYPE)==FUNC) {
if ((peeksym=symbol())==LBRACE || peeksym==KEYW) {
funcblk.type = decref(ds->type);
cfunc(ds->name);
return;
}
} else
cinit(ds);
} while ((o=symbol())==COMMA);
if (o==SEMI)
return;
syntax:
if (o==RBRACE) {
error("Too many }'s");
peeksym = 0;
return;
}
error("External definition syntax");
errflush(o);
statement(0);
}
/*
* Process a function definition.
*/
cfunc(cs)
char *cs;
{
register savdimp;
savdimp = dimp;
outcode("BBS", PROG, RLABEL, cs);
declist(ARG);
regvar = 5;
retlab = isn++;
if ((peeksym = symbol()) != LBRACE)
error("Compound statement required");
statement(1);
outcode("BNB", LABEL, retlab, RETRN);
dimp = savdimp;
}
/*
* Process the initializers for an external definition.
*/
cinit(ds)
struct hshtab *ds;
{
register basetype, nel, ninit;
int o, width, realwidth;
nel = 1;
basetype = ds->type;
/*
* If it's an array, find the number of elements.
* "basetype" is the type of thing it's an array of.
*/
while ((basetype&XTYPE)==ARRAY) {
if ((nel = dimtab[ds->ssp&0377])==0)
nel = 1;
basetype = decref(basetype);
}
realwidth = width = length(ds) / nel;
/*
* Pretend a structure is kind of an array of integers.
* This is a kludge.
*/
if (basetype==STRUCT) {
nel =* realwidth/2;
width = 2;
}
if ((peeksym=symbol())==COMMA || peeksym==SEMI) {
outcode("BSN",CSPACE,ds->name,(nel*width+ALIGN)&~ALIGN);
return;
}
ninit = 0;
outcode("BBS", DATA, NLABEL, ds->name);
if ((o=symbol())==LBRACE) {
do
ninit = cinit1(ds, basetype, width, ninit, nel);
while ((o=symbol())==COMMA);
if (o!=RBRACE)
peeksym = o;
} else {
peeksym = o;
ninit = cinit1(ds, basetype, width, 0, nel);
}
/*
* Above we pretended that a structure was a bunch of integers.
* Readjust in accordance with reality.
* First round up partial initializations.
*/
if (basetype==STRUCT) {
if (o = 2*ninit % realwidth)
outcode("BN", SSPACE, realwidth-o);
ninit = (2*ninit+realwidth-2) / realwidth;
nel =/ realwidth/2;
}
/*
* If there are too few initializers, allocate
* more storage.
* If there are too many initializers, extend
* the declared size for benefit of "sizeof"
*/
if (ninit<nel)
outcode("BN", SSPACE, (nel-ninit)*realwidth);
else if (ninit>nel) {
if ((ds->type&XTYPE)==ARRAY)
dimtab[ds->ssp&0377] = ninit;
nel = ninit;
}
/*
* If it's not an array, only one initializer is allowed.
*/
if (ninit>1 && (ds->type&XTYPE)!=ARRAY)
error("Too many initializers");
if (((nel&width)&ALIGN))
outcode("B", EVEN);
}
/*
* Process a single expression in a sequence of initializers
* for an external. Mainly, it's for checking
* type compatibility.
*/
cinit1(ds, type, awidth, aninit, nel)
struct hshtab *ds;
{
float sf;
register struct tnode *s;
register width, ninit;
width = awidth;
ninit = aninit;
if ((peeksym=symbol())==STRING && type==CHAR) {
peeksym = -1;
if (ninit)
bxdec();
putstr(0);
if (nel>nchstr) {
strflg++;
outcode("BN", SSPACE, nel-nchstr);
strflg = 0;
nchstr = nel;
}
return(nchstr);
}
if (peeksym==RBRACE)
return(ninit);
initflg++;
s = tree();
initflg = 0;
switch(width) {
case 1:
if (s->op != CON)
goto bad;
outcode("B1N0", BDATA, s->value);
break;
case 2:
if (s->op==CON) {
outcode("B1N0", WDATA, s->value);
break;
}
if (s->op==FCON || s->op==SFCON) {
if (type==STRUCT) {
ninit =+ 3;
goto prflt;
}
goto bad;
}
rcexpr(block(1,INIT,0,0,s));
break;
case 4:
sf = fcval;
outcode("B1N1N0", WDATA, sf);
goto flt;
case 8:
prflt:
outcode("B1N1N1N1N0", WDATA, fcval);
flt:
if (s->op==FCON || s->op==SFCON)
break;
default:
bad:
bxdec();
}
return(++ninit);
}
bxdec()
{
error("Inconsistent external initialization");
}
/*
* Process one statement in a function.
*/
statement(d)
{
register o, o1, o2;
int o3, o4;
struct tnode *np;
stmt:
switch(o=symbol()) {
case EOF:
error("Unexpected EOF");
case SEMI:
return;
case LBRACE:
if (d) {
if (proflg)
outcode("BN", PROFIL, isn++);
outcode("BN", SAVE, blkhed());
}
while (!eof) {
if ((o=symbol())==RBRACE)
return;
peeksym = o;
statement(0);
}
error("Missing '}'");
return;
case KEYW:
switch(cval) {
case GOTO:
if (o1 = simplegoto())
branch(o1);
else
dogoto();
goto semi;
case RETURN:
doret();
goto semi;
case IF:
np = pexpr();
o2 = 0;
if ((o1=symbol())==KEYW) switch (cval) {
case GOTO:
if (o2=simplegoto())
goto simpif;
cbranch(np, o2=isn++, 0);
dogoto();
label(o2);
goto hardif;
case RETURN:
if (nextchar()==';') {
o2 = retlab;
goto simpif;
}
cbranch(np, o1=isn++, 0);
doret();
label(o1);
o2++;
goto hardif;
case BREAK:
o2 = brklab;
goto simpif;
case CONTIN:
o2 = contlab;
simpif:
chconbrk(o2);
cbranch(np, o2, 1);
hardif:
if ((o=symbol())!=SEMI)
goto syntax;
if ((o1=symbol())==KEYW && cval==ELSE)
goto stmt;
peeksym = o1;
return;
}
peeksym = o1;
cbranch(np, o1=isn++, 0);
statement(0);
if ((o=symbol())==KEYW && cval==ELSE) {
o2 = isn++;
branch(o2);
label(o1);
statement(0);
label(o2);
return;
}
peeksym = o;
label(o1);
return;
case WHILE:
o1 = contlab;
o2 = brklab;
label(contlab = isn++);
cbranch(pexpr(), brklab=isn++, 0);
statement(0);
branch(contlab);
label(brklab);
contlab = o1;
brklab = o2;
return;
case BREAK:
chconbrk(brklab);
branch(brklab);
goto semi;
case CONTIN:
chconbrk(contlab);
branch(contlab);
goto semi;
case DO:
o1 = contlab;
o2 = brklab;
contlab = isn++;
brklab = isn++;
label(o3 = isn++);
statement(0);
label(contlab);
contlab = o1;
if ((o=symbol())==KEYW && cval==WHILE) {
cbranch(tree(), o3, 1);
label(brklab);
brklab = o2;
goto semi;
}
goto syntax;
case CASE:
o1 = conexp();
if ((o=symbol())!=COLON)
goto syntax;
if (swp==0) {
error("Case not in switch");
goto stmt;
}
if(swp>=swtab+swsiz) {
error("Switch table overflow");
} else {
swp->swlab = isn;
(swp++)->swval = o1;
label(isn++);
}
goto stmt;
case SWITCH:
o1 = brklab;
brklab = isn++;
np = pexpr();
chkw(np, -1);
rcexpr(block(1,RFORCE,0,0,np));
pswitch();
brklab = o1;
return;
case DEFAULT:
if (swp==0)
error("Default not in switch");
if ((o=symbol())!=COLON)
goto syntax;
label(deflab = isn++);
goto stmt;
case FOR:
o1 = contlab;
o2 = brklab;
contlab = isn++;
brklab = isn++;
if (o=forstmt())
goto syntax;
label(brklab);
contlab = o1;
brklab = o2;
return;
}
error("Unknown keyword");
goto syntax;
case NAME:
if (nextchar()==':') {
peekc = 0;
o1 = csym;
if (o1->hclass>0) {
error("Redefinition");
goto stmt;
}
o1->hclass = STATIC;
o1->htype = ARRAY;
if (o1->hoffset==0)
o1->hoffset = isn++;
label(o1->hoffset);
goto stmt;
}
}
peeksym = o;
rcexpr(tree());
semi:
if ((o=symbol())==SEMI)
return;
syntax:
error("Statement syntax");
errflush(o);
}
/*
* Process a for statement.
*/
forstmt()
{
register int l, o, sline;
int sline1, *ss;
struct tnode *st;
if ((o=symbol()) != LPARN)
return(o);
if ((o=symbol()) != SEMI) { /* init part */
peeksym = o;
rcexpr(tree());
if ((o=symbol()) != SEMI)
return(o);
}
label(contlab);
if ((o=symbol()) != SEMI) { /* test part */
peeksym = o;
rcexpr(block(1,CBRANCH,tree(),brklab,0));
if ((o=symbol()) != SEMI)
return(o);
}
if ((peeksym=symbol()) == RPARN) { /* incr part */
peeksym = -1;
statement(0);
branch(contlab);
return(0);
}
l = contlab;
contlab = isn++;
st = tree();
sline = line;
if ((o=symbol()) != RPARN)
return(o);
ss = treespace;
treespace = space;
statement(0);
sline1 = line;
line = sline;
label(contlab);
rcexpr(st);
line = sline1;
treespace = ss;
branch(l);
return(0);
}
/*
* A parenthesized expression,
* as after "if".
*/
pexpr()
{
register o, t;
if ((o=symbol())!=LPARN)
goto syntax;
t = tree();
if ((o=symbol())!=RPARN)
goto syntax;
return(t);
syntax:
error("Statement syntax");
errflush(o);
return(0);
}
/*
* The switch stateent, which involves collecting the
* constants and labels for the cases.
*/
pswitch()
{
register struct swtab *cswp, *sswp;
int dl, swlab;
cswp = sswp = swp;
if (swp==0)
cswp = swp = swtab;
branch(swlab=isn++);
dl = deflab;
deflab = 0;
statement(0);
branch(brklab);
label(swlab);
if (deflab==0)
deflab = brklab;
outcode("BNN", SWIT, deflab, line);
for (; cswp < swp; cswp++)
outcode("NN", cswp->swlab, cswp->swval);
outcode("0");
label(brklab);
deflab = dl;
swp = sswp;
}
/*
* blkhed is called at the start of each function.
* It reads the declarations at the start;
* then assigns storage locations for the
* parameters (which have been linked into a list,
* in order of appearance).
* This list is necessary because in
* f(a, b) float b; int a; ...
* the names are seen before the types.
* Also, the routine adjusts structures involved
* in some kind of forward-referencing.
*/
blkhed()
{
register pl;
register struct hshtab *cs;
autolen = 6;
declist(0);
pl = 4;
while(paraml) {
parame->hoffset = 0;
cs = paraml;
paraml = paraml->hoffset;
if (cs->htype==FLOAT)
cs->htype = DOUBLE;
cs->hoffset = pl;
cs->hclass = AUTO;
if ((cs->htype&XTYPE) == ARRAY) {
cs->htype =- (ARRAY-PTR); /* set ptr */
cs->ssp++; /* pop dims */
}
pl =+ rlength(cs);
}
for (cs=hshtab; cs<hshtab+hshsiz; cs++) {
if (cs->name[0] == '\0')
continue;
/* check tagged structure */
if (cs->hclass>KEYWC && (cs->htype&TYPE)==RSTRUCT) {
cs->lenp = dimtab[cs->lenp&0377]->lenp;
cs->htype = cs->htype&~TYPE | STRUCT;
}
if (cs->hclass == STRTAG && dimtab[cs->lenp&0377]==0)
error("Undefined structure: %.8s", cs->name);
if (cs->hclass == ARG)
error("Not an argument: %.8s", cs->name);
if (stflg)
prste(cs);
}
space = treespace;
outcode("BN", SETREG, regvar);
return(autolen);
}
/*
* After a function definition, delete local
* symbols.
* Also complain about undefineds.
*/
blkend() {
register struct hshtab *cs;
for (cs=hshtab; cs<hshtab+hshsiz; cs++) {
if (cs->name[0]) {
if (cs->hclass==0 && (cs->hflag&FNUND)==0) {
error("%.8s undefined", cs->name);
cs->hflag =| FNUND;
}
if((cs->hflag&FNDEL)==0) {
cs->name[0] = '\0';
hshused--;
cs->hflag =& ~(FNUND|FFIELD);
}
}
}
}
/*
* write out special definitions of local symbols for
* benefit of the debugger. None of these are used
* by the assembler except to save them.
*/
prste(acs)
{
register struct hshtab *cs;
register nkind;
cs = acs;
switch (cs->hclass) {
case REG:
nkind = RNAME;
break;
case AUTO:
nkind = ANAME;
break;
case STATIC:
nkind = SNAME;
break;
default:
return;
}
outcode("BSN", nkind, cs->name, cs->hoffset);
}
/*
* In case of error, skip to the next
* statement delimiter.
*/
errflush(ao)
{
register o;
o = ao;
while(o>RBRACE) /* ; { } */
o = symbol();
peeksym = o;
}
source/c/c03.c
+412
View File
@@ -0,0 +1,412 @@
#
/*
* C compiler, phase 1
*
*
* Handles processing of declarations,
* except for top-level processing of
* externals.
*/
#include "c0h.c"
/*
* Process a sequence of declaration statements
*/
declist(sclass)
{
register sc, elsize, offset;
int type;
offset = 0;
sc = sclass;
while ((elsize = getkeywords(&sclass, &type)) != -1) {
offset = declare(sclass, type, offset, elsize);
sclass = sc;
}
return(offset+align(INT, offset, 0));
}
/*
* Read the keywords introducing a declaration statement
*/
getkeywords(scptr, tptr)
int *scptr, *tptr;
{
register skw, tkw, longf;
int o, elsize, isadecl, ismos;
isadecl = 0;
longf = 0;
tkw = -1;
skw = *scptr;
elsize = 0;
ismos = skw==MOS;
for (;;) {
mosflg = ismos;
switch ((o=symbol())==KEYW? cval: -1) {
case AUTO:
case STATIC:
case EXTERN:
case REG:
if (skw && skw!=cval)
error("Conflict in storage class");
skw = cval;
break;
case LONG:
longf++;
break;
case STRUCT:
o = STRUCT;
elsize = strdec(&o, ismos);
cval = o;
case INT:
case CHAR:
case FLOAT:
case DOUBLE:
if (tkw>=0)
error("Type clash");
tkw = cval;
break;
default:
peeksym = o;
if (isadecl==0)
return(-1);
if (tkw<0)
tkw = INT;
if (skw==0)
skw = AUTO;
if (longf) {
if (tkw==FLOAT)
tkw = DOUBLE;
else if (tkw==INT)
tkw = LONG;
else
error("Misplaced 'long'");
}
*scptr = skw;
*tptr = tkw;
return(elsize);
}
isadecl++;
}
}
/*
* Process a structure declaration; a subroutine
* of getkeywords.
*/
strdec(tkwp, mosf)
int *tkwp;
{
register elsize, o;
register struct hshtab *ssym;
int savebits;
struct hshtab *ds;
mosflg = 1;
ssym = 0;
if ((o=symbol())==NAME) {
ssym = csym;
if (ssym->hclass==0) {
ssym->hclass = STRTAG;
ssym->lenp = dimp;
chkdim();
dimtab[dimp++] = 0;
}
if (ssym->hclass != STRTAG)
redec();
mosflg = mosf;
o = symbol();
}
mosflg = 0;
if (o != LBRACE) {
if (ssym==0) {
syntax:
decsyn(o);
return(0);
}
if (ssym->hclass!=STRTAG)
error("Bad structure name");
if ((elsize = dimtab[ssym->lenp&0377])==0) {
*tkwp = RSTRUCT;
elsize = ssym;
}
peeksym = o;
} else {
ds = defsym;
mosflg = 0;
savebits = bitoffs;
bitoffs = 0;
elsize = declist(MOS);
bitoffs = savebits;
defsym = ds;
if ((o = symbol()) != RBRACE)
goto syntax;
if (ssym) {
if (dimtab[ssym->lenp&0377])
error("%.8s redeclared", ssym->name);
dimtab[ssym->lenp&0377] = elsize;
}
}
return(elsize);
}
/*
* Check that the dimension table has not overflowed
*/
chkdim()
{
if (dimp >= dimsiz) {
error("Dimension/struct table overflow");
exit(1);
}
}
/*
* Process a comma-separated list of declarators
*/
declare(askw, tkw, offset, elsize)
{
register int o;
register int skw;
skw = askw;
do {
offset =+ decl1(skw, tkw, offset, elsize);
} while ((o=symbol()) == COMMA);
if (o==SEMI || o==RPARN && skw==ARG1)
return(offset);
decsyn(o);
}
/*
* Process a single declarator
*/
decl1(askw, tkw, offset, elsize)
{
int t1, chkoff, a;
register int type, skw;
register struct hshtab *dsym;
skw = askw;
chkoff = 0;
mosflg = skw==MOS;
if ((peeksym=symbol())==SEMI || peeksym==RPARN)
return(0);
/*
* Filler field
*/
if (peeksym==COLON && skw==MOS) {
peeksym = -1;
t1 = conexp();
elsize = align(tkw, offset, t1);
bitoffs =+ t1;
return(elsize);
}
if ((t1=getype()) < 0)
goto syntax;
type = 0;
do
type = type<<TYLEN | (t1 & XTYPE);
while (((t1=>>TYLEN) & XTYPE)!=0);
type =| tkw;
dsym = defsym;
if (!(dsym->hclass==0
|| (skw==ARG && dsym->hclass==ARG1)
|| (skw==EXTERN && dsym->hclass==EXTERN && dsym->htype==type)))
if (skw==MOS && dsym->hclass==MOS && dsym->htype==type)
chkoff = 1;
else {
redec();
goto syntax;
}
dsym->htype = type;
if (skw)
dsym->hclass = skw;
if (skw==ARG1) {
if (paraml==0)
paraml = dsym;
else
parame->hoffset = dsym;
parame = dsym;
}
if (elsize && ((type&TYPE)==RSTRUCT || (type&TYPE)==STRUCT)) {
dsym->lenp = dimp;
chkdim();
dimtab[dimp++] = elsize;
}
elsize = 0;
if (skw==MOS) {
elsize = length(dsym);
t1 = 0;
if ((peeksym = symbol())==COLON) {
elsize = 0;
peeksym = -1;
t1 = conexp();
dsym->hflag =| FFIELD;
}
a = align(type, offset, t1);
elsize =+ a;
offset =+ a;
if (t1) {
if (chkoff && (dsym->bitoffs!=bitoffs
|| dsym->flen!=t1))
redec();
dsym->bitoffs = bitoffs;
dsym->flen = t1;
bitoffs =+ t1;
}
if (chkoff && dsym->hoffset != offset)
redec();
dsym->hoffset = offset;
}
if ((dsym->htype&XTYPE)==FUNC) {
if (dsym->hclass!=EXTERN && dsym->hclass!=AUTO)
error("Bad function");
dsym->hclass = EXTERN;
}
if (dsym->hclass==AUTO) {
autolen =+ rlength(dsym);
dsym->hoffset = -autolen;
} else if (dsym->hclass==STATIC) {
dsym->hoffset = isn;
outcode("BBNBNB", BSS, LABEL, isn++,
SSPACE, rlength(dsym), PROG);
} else if (dsym->hclass==REG) {
if ((type&TYPE)>CHAR && (type&XTYPE)==0
|| (type&XTYPE)>PTR || regvar<3)
error("Bad register %o", type);
dsym->hoffset = --regvar;
}
syntax:
return(elsize);
}
/*
* Read a declarator and get the implied type
*/
getype()
{
register int o, type;
register struct hshtab *ds;
switch(o=symbol()) {
case TIMES:
return(getype()<<TYLEN | PTR);
case LPARN:
type = getype();
if ((o=symbol()) != RPARN)
goto syntax;
goto getf;
case NAME:
defsym = ds = csym;
type = 0;
ds->ssp = dimp;
getf:
switch(o=symbol()) {
case LPARN:
if (xdflg) {
xdflg = 0;
ds = defsym;
declare(ARG1, 0, 0, 0);
defsym = ds;
xdflg++;
} else
if ((o=symbol()) != RPARN)
goto syntax;
type = type<<TYLEN | FUNC;
goto getf;
case LBRACK:
chkdim();
if ((o=symbol()) != RBRACK) {
peeksym = o;
cval = conexp();
for (o=ds->ssp&0377; o<dimp; o++)
dimtab[o] =* cval;
dimtab[dimp++] = cval;
if ((o=symbol())!=RBRACK)
goto syntax;
} else
dimtab[dimp++] = 1;
type = type<<TYLEN | ARRAY;
goto getf;
}
peeksym = o;
return(type);
}
syntax:
decsyn(o);
return(-1);
}
/*
* Enforce alignment restrictions in structures,
* including bit-field considerations.
*/
align(type, offset, aflen)
{
register a, t, flen;
char *ftl;
flen = aflen;
a = offset;
t = type;
ftl = "Field too long";
if (flen==0 && bitoffs) {
a =+ (bitoffs-1) / NBPC;
bitoffs = 0;
}
while ((t&XTYPE)==ARRAY)
t = decref(t);
if (t!=CHAR) {
a = (a+ALIGN) & ~ALIGN;
if (a>offset)
bitoffs = 0;
}
if (flen) {
if (type==INT) {
if (flen > NBPW)
error(ftl);
if (flen+bitoffs > NBPW) {
bitoffs = 0;
a =+ NCPW;
}
} else if (type==CHAR) {
if (flen > NBPC)
error(ftl);
if (flen+bitoffs > NCPW) {
bitoffs = 0;
a =+ 1;
}
} else
error("Bad type for field");
}
return(a-offset);
}
/*
* Complain about syntax error in declaration
*/
decsyn(o)
{
error("Declaration syntax");
errflush(o);
}
/*
* Complain about a redeclaration
*/
redec()
{
error("%.8s redeclared", defsym->name);
}
source/c/c04.c
+343
View File
@@ -0,0 +1,343 @@
#
/*
* C compiler
*
*
*/
#include "c0h.c"
/*
* Reduce the degree-of-reference by one.
* e.g. turn "ptr-to-int" into "int".
*/
decref(at)
{
register t;
t = at;
if ((t & ~TYPE) == 0) {
error("Illegal indirection");
return(t);
}
return((t>>TYLEN) & ~TYPE | t&TYPE);
}
/*
* Increase the degree of reference by
* one; e.g. turn "int" to "ptr-to-int".
*/
incref(t)
{
return(((t&~TYPE)<<TYLEN) | (t&TYPE) | PTR);
}
/*
* Make a tree that causes a branch to lbl
* if the tree's value is non-zero together with the cond.
*/
cbranch(tree, lbl, cond)
struct tnode *tree;
{
rcexpr(block(1,CBRANCH,tree,lbl,cond));
}
/*
* Write out a tree.
*/
rcexpr(tree)
struct tnode *tree;
{
treeout(tree);
outcode("BN", EXPR, line);
}
treeout(atree)
struct tnode *atree;
{
register struct tnode *tree;
if ((tree = atree) == 0)
return;
switch(tree->op) {
case 0:
outcode("B", NULL);
return;
case NAME:
outcode("BNN", NAME, tree->class, tree->type);
if (tree->class==EXTERN)
outcode("S", tree->nname);
else
outcode("N", tree->nloc);
return;
case CON:
case FCON:
case SFCON:
outcode("BNN", tree->op, tree->type, tree->value);
return;
case FSEL:
treeout(tree->tr1);
outcode("BNN", tree->op, tree->type, tree->tr2);
return;
case CBRANCH:
treeout(tree->btree);
outcode("BNN", tree->op, tree->lbl, tree->cond);
return;
default:
treeout(tree->tr1);
if (opdope[tree->op]&BINARY)
treeout(tree->tr2);
outcode("BN", tree->op, tree->type);
return;
}
}
/*
* Generate a branch
*/
branch(lab) {
outcode("BN", BRANCH, lab);
}
/*
* Generate a label
*/
label(l) {
outcode("BN", LABEL, l);
}
/*
* ap is a tree node whose type
* is some kind of pointer; return the size of the object
* to which the pointer points.
*/
plength(ap)
struct tname *ap;
{
register t, l;
register struct tname *p;
p = ap;
if (p==0 || ((t=p->type)&~TYPE) == 0) /* not a reference */
return(1);
p->type = decref(t);
l = length(p);
p->type = t;
return(l);
}
/*
* return the number of bytes in the object
* whose tree node is acs.
*/
length(acs)
struct tnode *acs;
{
register t, n;
register struct tnode *cs;
cs = acs;
t = cs->type;
n = 1;
while ((t&XTYPE) == ARRAY) {
t = decref(t);
n = dimtab[cs->ssp&0377];
}
if ((t&~TYPE)==FUNC)
return(0);
if (t>=PTR)
return(2*n);
switch(t&TYPE) {
case INT:
return(2*n);
case CHAR:
return(n);
case FLOAT:
case LONG:
return(4*n);
case DOUBLE:
return(8*n);
case STRUCT:
return(n * dimtab[cs->lenp&0377]);
case RSTRUCT:
error("Bad structure");
return(0);
}
error("Compiler error (length)");
}
/*
* The number of bytes in an object, rounded up to a word.
*/
rlength(cs)
struct tnode *cs;
{
return((length(cs)+ALIGN) & ~ALIGN);
}
/*
* After an "if (...) goto", look to see if the transfer
* is to a simple label.
*/
simplegoto()
{
register struct hshtab *csp;
if ((peeksym=symbol())==NAME && nextchar()==';') {
csp = csym;
if (csp->hclass==0 && csp->htype==0) {
csp->htype = ARRAY;
if (csp->hoffset==0)
csp->hoffset = isn++;
}
if ((csp->hclass==0||csp->hclass==STATIC)
&& csp->htype==ARRAY) {
peeksym = -1;
return(csp->hoffset);
}
}
return(0);
}
/*
* Return the next non-white-space character
*/
nextchar()
{
while (spnextchar()==' ')
peekc = 0;
return(peekc);
}
/*
* Return the next character, translating all white space
* to blank and handling line-ends.
*/
spnextchar()
{
register c;
if ((c = peekc)==0)
c = getchar();
if (c=='\t')
c = ' ';
else if (c=='\n') {
c = ' ';
if (inhdr==0)
line++;
inhdr = 0;
} else if (c=='\001') { /* SOH, insert marker */
inhdr++;
c = ' ';
}
peekc = c;
return(c);
}
/*
* is a break or continue legal?
*/
chconbrk(l)
{
if (l==0)
error("Break/continue error");
}
/*
* The goto statement.
*/
dogoto()
{
register struct tnode *np;
*cp++ = tree();
build(STAR);
chkw(np = *--cp, -1);
rcexpr(block(1,JUMP,0,0,np));
}
/*
* The return statement, which has to convert
* the returned object to the function's type.
*/
doret()
{
register struct tnode *t;
if (nextchar() != ';') {
t = tree();
*cp++ = &funcblk;
*cp++ = t;
build(ASSIGN);
cp[-1] = cp[-1]->tr2;
build(RFORCE);
rcexpr(*--cp);
}
branch(retlab);
}
/*
* write out a character to the usual output
* or to the string file
*/
putchar(c)
{
write(1, &c, 1);
}
outcode(s, a)
char *s;
{
register char *sp;
register *ap, *bufp;
int n;
char *np;
bufp = obuf;
if (strflg)
bufp = sbuf;
ap = &a;
for (;;) switch(*s++) {
case 'B':
putw(*ap++ | (0376<<8), bufp);
continue;
case 'N':
putw(*ap++, bufp);
continue;
case 'S':
np = *ap++;
n = ncps;
while (n-- && *np) {
putc(*np++, bufp);
}
putc(0, bufp);
continue;
case '1':
putw(1, bufp);
continue;
case '0':
putw(0, bufp);
continue;
case '\0':
return;
}
error("Botch in outcode");
}
source/c/c05.c
+176
View File
@@ -0,0 +1,176 @@
#
#include "c0h.c"
/*
* info on operators:
* 01-- is binary operator
* 02-- left (or only) operand must be lvalue
* 04-- is relational operator
* 010-- is assignment-type operator
* 020-- non-float req. on left
* 040-- non-float req. on right
* 0100-- is commutative
* 0200-- is right, not left-associative
* 0400-- is leaf of tree
* *0XX000-- XX is priority of operator
*/
int opdope[] {
000000, /* EOF */
000000, /* ; */
000000, /* { */
000000, /* } */
036000, /* [ */
002000, /* ] */
036000, /* ( */
002000, /* ) */
014201, /* : */
007001, /* , */
000000, /* field selection */
000000, /* 11 */
000000, /* 12 */
000000, /* 13 */
000000, /* 14 */
000000, /* 15 */
000000, /* 16 */
000000, /* 17 */
000000, /* 18 */
000000, /* 19 */
000400, /* name */
000400, /* short constant */
000400, /* string */
000400, /* float */
000400, /* double */
000000, /* 25 */
000000, /* 26 */
000000, /* 27 */
000000, /* 28 */
000000, /* 29 */
034203, /* ++pre */
034203, /* --pre */
034203, /* ++post */
034203, /* --post */
034220, /* !un */
034202, /* &un */
034220, /* *un */
034200, /* -un */
034220, /* ~un */
036001, /* . (structure reference) */
030101, /* + */
030001, /* - */
032101, /* * */
032001, /* / */
032001, /* % */
026061, /* >> */
026061, /* << */
020161, /* & */
017161, /* | */
017161, /* ^ */
036001, /* -> */
000000, /* int -> double */
000000, /* double -> int */
016001, /* && */
015001, /* || */
030001, /* &~ */
000000, /* 56 */
000000, /* 57 */
000000, /* 58 */
000000, /* 59 */
022005, /* == */
022005, /* != */
024005, /* <= */
024005, /* < */
024005, /* >= */
024005, /* > */
024005, /* <p */
024005, /* <=p */
024005, /* >p */
024005, /* >=p */
012213, /* =+ */
012213, /* =- */
012213, /* =* */
012213, /* =/ */
012213, /* =% */
012253, /* =>> */
012253, /* =<< */
012253, /* =& */
012253, /* =| */
012253, /* =^ */
012213, /* = */
000000, /* 81 */
000000, /* 82 */
000000, /* 83 */
000000, /* 84 */
000000, /* 85 */
000000, /* 86 */
000000, /* 87 */
000000, /* 88 */
000000, /* 89 */
014201, /* ? */
034200, /* sizeof */
000000, /* 92 */
000000, /* 93 */
000000, /* 94 */
000000, /* 95 */
000000, /* 96 */
000000, /* 97 */
000000, /* 98 */
000000, /* 99 */
036001, /* call */
036001, /* mcall */
000000, /* goto */
000000, /* jump cond */
000000, /* branch cond */
000000, /* 105 */
000000, /* 106 */
000000, /* 107 */
000000, /* 108 */
000000, /* 109 */
000000 /* force r0 */
};
/*
* conversion table:
* FTI: float (or double) to integer
* ITF: integer to float
* ITP: integer to pointer
* ITL: integer to long
* LTI: long to integer
* LTF: long to float
* FTL: float to long
* PTI: pointer to integer
* XX: usually illegal
* When FTI, LTI, FTL are added in they specify
* that it is the left operand that should be converted.
* For + this is done and the conversion is turned back into
* ITF, ITL, LTF.
* For = however the left operand can't be converted
* and the specified conversion is applied to the rhs.
*/
char cvtab[4][4] {
/* int double long ptr */
/* int */ 0, (FTI<<4)+ITF, (LTI<<4)+ITL, (ITP<<4)+ITP,
/* double */ ITF, 0, LTF, XX,
/* long */ ITL, (FTL<<4)+LTF, 0, XX,
/* ptr */ ITP, XX, XX, PTI
};
/*
* character type table
*/
char ctab[] {
EOF, INSERT, UNKN, UNKN, UNKN, UNKN, UNKN, UNKN,
UNKN, SPACE, NEWLN, UNKN, UNKN, UNKN, UNKN, UNKN,
UNKN, UNKN, UNKN, UNKN, UNKN, UNKN, UNKN, UNKN,
UNKN, UNKN, UNKN, UNKN, UNKN, UNKN, UNKN, UNKN,
SPACE, EXCLA, DQUOTE, UNKN, UNKN, MOD, AND, SQUOTE,
LPARN, RPARN, TIMES, PLUS, COMMA, MINUS, PERIOD, DIVIDE,
DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT, DIGIT,
DIGIT, DIGIT, COLON, SEMI, LESS, ASSIGN, GREAT, QUEST,
UNKN, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LBRACK, UNKN, RBRACK, EXOR, LETTER,
UNKN, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER, LETTER,
LETTER, LETTER, LETTER, LBRACE, OR, RBRACE, COMPL, UNKN
};
source/c/c0h.c
+351
View File
@@ -0,0 +1,351 @@
#
/*
C compiler-- pass 1 header
*/
/*
parameters
*/
#define ncps 8
#define hshsiz 200
#define cmsiz 40
#define swsiz 200
#define OSSIZ 500
#define dimsiz 100
#define NBPW 16
#define NBPC 8
#define NCPW 2
#define STRSIZ 256
struct tnode {
int op;
int type;
int dimp;
struct tnode *tr1, *tr2;
};
struct {
int op;
int type;
char ssp; /* subscript list */
char lenp; /* structure length */
};
struct tname {
int op;
int type;
int dimp;
int class;
int offset;
int nloc;
};
struct txname {
int op;
int type;
int dimp;
int class;
int offset;
char nname[ncps];
};
struct tconst {
int op;
int type;
int dimp;
int value;
};
struct hshtab {
char hclass;
char hflag;
int htype;
int hdimp;
int hoffset;
char name[ncps];
};
struct {
char hclass;
char hflag;
int htype;
char flen; /* Field length */
char bitoffs; /* Offset of field */
};
struct swtab {
int swlab;
int swval;
};
struct bnode {
int bop;
struct tnode *btree;
int lbl;
int cond;
};
char cvtab[4][4];
char savstr[STRSIZ];
char *strptr;
int opdope[];
char ctab[];
char symbuf[ncps+2];
int hshused;
struct hshtab hshtab[hshsiz];
int *space;
int *cp;
int cmst[cmsiz];
int isn;
struct swtab swtab[swsiz];
struct swtab *swp;
int contlab;
int brklab;
int retlab;
int deflab;
int nauto;
int autolen;
int peeksym;
int peekc;
int eof;
int line;
int osspace[OSSIZ];
int *treespace;
struct hshtab *defsym;
struct hshtab *funcsym;
int xdflg;
int proflg;
int stflg;
struct hshtab *csym;
int cval;
double fcval;
int nchstr;
int nerror;
struct hshtab *paraml;
struct hshtab *parame;
int strflg;
int mosflg;
int initflg;
int inhdr;
int dimtab[dimsiz];
char obuf[518];
char sbuf[518];
int dimp;
int regvar;
int bitoffs;
struct tname funcblk;
/*
operators
*/
#define EOF 0
#define SEMI 1
#define LBRACE 2
#define RBRACE 3
#define LBRACK 4
#define RBRACK 5
#define LPARN 6
#define RPARN 7
#define COLON 8
#define COMMA 9
#define FSEL 10
#define KEYW 19
#define NAME 20
#define CON 21
#define STRING 22
#define FCON 23
#define SFCON 24
#define SIZEOF 91
#define INCBEF 30
#define DECBEF 31
#define INCAFT 32
#define DECAFT 33
#define EXCLA 34
#define AMPER 35
#define STAR 36
#define NEG 37
#define COMPL 38
#define DOT 39
#define PLUS 40
#define MINUS 41
#define TIMES 42
#define DIVIDE 43
#define MOD 44
#define RSHIFT 45
#define LSHIFT 46
#define AND 47
#define OR 48
#define EXOR 49
#define ARROW 50
#define ITOF 51
#define FTOI 52
#define LOGAND 53
#define LOGOR 54
#define FTOL 56
#define LTOF 57
#define ITOL 58
#define LTOI 59
#define EQUAL 60
#define NEQUAL 61
#define LESSEQ 62
#define LESS 63
#define GREATEQ 64
#define GREAT 65
#define LESSEQP 66
#define LESSP 67
#define GREATQP 68
#define GREATP 69
#define ASPLUS 70
#define ASMINUS 71
#define ASTIMES 72
#define ASDIV 73
#define ASMOD 74
#define ASRSH 75
#define ASLSH 76
#define ASSAND 77
#define ASOR 78
#define ASXOR 79
#define ASSIGN 80
#define QUEST 90
#define CALL 100
#define MCALL 101
#define JUMP 102
#define CBRANCH 103
#define INIT 104
#define SETREG 105
#define RFORCE 110
#define BRANCH 111
#define LABEL 112
#define NLABEL 113
#define RLABEL 114
/*
types
*/
#define INT 0
#define CHAR 1
#define FLOAT 2
#define DOUBLE 3
#define STRUCT 4
#define RSTRUCT 5
#define LONG 6
#define NOTYPE 7 /* used internally */
#define ALIGN 01
#define TYPE 07
#define TYLEN 2
#define XTYPE (03<<3)
#define PTR 010
#define FUNC 020
#define ARRAY 030
/*
storage classes
*/
#define KEYWC 1
#define MOS 10
#define AUTO 11
#define EXTERN 12
#define STATIC 13
#define REG 14
#define STRTAG 15
#define ARG 16
#define ARG1 17
#define FMOS 18
/*
keywords
*/
#define GOTO 20
#define RETURN 21
#define IF 22
#define WHILE 23
#define ELSE 24
#define SWITCH 25
#define CASE 26
#define BREAK 27
#define CONTIN 28
#define DO 29
#define DEFAULT 30
#define FOR 31
/*
characters
*/
#define INSERT 119
#define PERIOD 120
#define SQUOTE 121
#define DQUOTE 122
#define LETTER 123
#define DIGIT 124
#define NEWLN 125
#define SPACE 126
#define UNKN 127
/*
* Special operators in intermediate code
*/
#define BDATA 200
#define WDATA 201
#define PROG 202
#define DATA 203
#define BSS 204
#define CSPACE 205
#define SSPACE 206
#define SYMDEF 207
#define SAVE 208
#define RETRN 209
#define EVEN 210
#define PROFIL 212
#define SWIT 213
#define EXPR 214
#define SNAME 215
#define RNAME 216
#define ANAME 217
#define NULL 218
/*
Flag bits
*/
#define BINARY 01
#define LVALUE 02
#define RELAT 04
#define ASSGOP 010
#define LWORD 020
#define RWORD 040
#define COMMUTE 0100
#define RASSOC 0200
#define LEAF 0400
/*
* Conversion codes
*/
#define ITF 1
#define ITL 2
#define LTF 3
#define ITP 4
#define PTI 5
#define FTI 6
#define LTI 7
#define FTL 8
#define XX 15
/*
* symbol table flags
*/
#define FNDEL 01
#define FNUND 02
#define FKEYW 04
#define FFIELD 020
source/c/c0t.s
+159
View File
@@ -0,0 +1,159 @@
/ assure fake printf (no floating)
.globl fltused; fltused = 0
/ convert stream to number; result is type.
/ value in cval or fcval
fpp = 1
.globl _getnum
.globl _peekc
.globl _getchar
.globl _cval
.globl _fcval
.globl _error
_getnum:
.if fpp
movif $10.,fr3
clrf fr0
.endif
clr nfract
clr totdig
clr decpt
clr _cval
mov 2(sp),base
mov r2,-(sp)
1:
jsr r5,getdig
br 2f
.if fpp
mulf fr3,fr0
movif r0,fr1
addf fr1,fr0
.endif
inc nfract
br 1b
2:
tst decpt
bne 1f
clr nfract
cmp r0,$'.
bne 1f
mov pc,decpt
br 1b
1:
tst totdig
beq 1f
cmp r0,$'e
bne 1f
clr -(sp)
clr _cval
mov pc,decpt
clr _cval
mov $10.,base
jsr pc,_getchar
cmp r0,$'+
beq 2f
cmp r0,$'-
bne 3f
inc (sp)
br 2f
3:
mov r0,_peekc
2:
jsr r5,getdig
br 2f
br 2b
2:
tst (sp)+
beq 2f
neg _cval
2:
sub _cval,nfract
1:
mov r0,_peekc
tst totdig
bne 1f
mov $39.,r0 / "." operator
9:
mov (sp)+,r2
rts pc
1:
tst decpt
bne 1f
mov $21.,r0 / fixed constant
br 9b
1:
.if fpp
movif $1,fr2
mov nfract,r2
mov r2,-(sp)
beq 2f
bgt 1f
neg r2
1:
mulf fr3,fr2
sob r2,1b
2:
tst (sp)+
ble 1f
divf fr2,fr0
br 2f
1:
mulf fr2,fr0
2:
mov $_fcval,r0
movf fr0,(r0)
tst (r0)+
tst (r0)+
bne 1f
tst (r0)+
bne 1f
tst (r0)+
bne 1f
mov $24.,r0
mov _fcval,_cval
br 9b
1:
mov $23.,r0
br 9b
.endif
.if 1-fpp
mov $fperr,-(sp)
jsr pc,_error
tst (sp)+
mov $21.,r0
br 9b
fperr: <No floating point!\0>; .even
.endif
getdig:
mov _peekc,r0
beq 1f
clr _peekc
br 2f
1:
jsr pc,_getchar
2:
sub $'0,r0
cmp r0,$9.
bhi 1f
inc totdig
mov _cval,r1
mul base,r1
add r0,r1
mov r1,_cval
tst (r5)+
rts r5
1:
add $'0,r0
rts r5
.bss
base: .=.+2
nfract: .=.+2
decpt: .=.+2
totdig: .=.+2
source/c/c10.c
+922
View File
@@ -0,0 +1,922 @@
#
/*
C compiler, part 2
*/
#include "c1h.c"
char maprel[] { EQUAL, NEQUAL, GREATEQ, GREAT, LESSEQ,
LESS, GREATQP, GREATP, LESSEQP, LESSP
};
char notrel[] { NEQUAL, EQUAL, GREAT, GREATEQ, LESS,
LESSEQ, GREATP, GREATQP, LESSP, LESSEQP
};
struct tconst czero { CON, INT, 0, 0};
struct tconst cone { CON, INT, 0, 1};
struct tconst fczero { SFCON, DOUBLE, 0, 0 };
struct table *cregtab;
int nreg 3;
int isn 10000;
int namsiz 8;
main(argc, argv)
char *argv[];
{
extern fout;
if (argc<4) {
error("Arg count");
exit(1);
}
if(fopen(argv[1], ascbuf)<0) {
error("Missing temp file");
exit(1);
}
if ((fout = creat(argv[3], 0666)) < 0) {
error("Can't create %s", argv[3]);
exit(1);
}
spacep = treespace;
getree();
/*
* If any floating-point instructions
* were used, generate a reference which
* pulls in the floating-point part of printf.
*/
if (nfloat)
printf(".globl fltused\n");
/*
* tack on the string file.
*/
close(ascbuf[0]);
if (fopen(argv[2], ascbuf)<0) {
error("Missing temp file");
exit(1);
}
printf(".globl\n.data\n");
getree();
flush();
exit(nerror!=0);
}
/*
* Given a tree, a code table, and a
* count of available registers, find the code table
* for the appropriate operator such that the operands
* are of the right type and the number of registers
* required is not too large.
* Return a ptr to the table entry or 0 if none found.
*/
char *match(atree, table, nrleft)
struct tnode *atree;
struct table *table;
{
int op, d1, d2, t1, t2, dope;
struct tnode *p2;
register struct tnode *p1, *tree;
register struct optab *opt;
if ((tree=atree)==0)
return(0);
if (table==lsptab)
table = sptab;
if ((op = tree->op)==0)
return(0);
dope = opdope[op];
if ((dope&LEAF) == 0)
p1 = tree->tr1;
else
p1 = tree;
t1 = p1->type;
d1 = dcalc(p1, nrleft);
if ((dope&BINARY)!=0) {
p2 = tree->tr2;
/*
* If a subtree starts off with a conversion operator,
* try for a match with the conversion eliminated.
* E.g. int = double can be done without generating
* the converted int in a register by
* movf double,fr0; movfi fr0,int .
*/
if(opdope[p1->op]&CNVRT && (opdope[p2->op]&CNVRT)==0) {
tree->tr1 = p1->tr1;
if (opt = match(tree, table, nrleft))
return(opt);
tree->tr1 = p1;
} else if (opdope[p2->op]&CNVRT && (opdope[p1->op]&CNVRT)==0) {
tree->tr2 = p2->tr1;
if (opt = match(tree, table, nrleft))
return(opt);
tree->tr2 = p2;
}
t2 = p2->type;
d2 = dcalc(p2, nrleft);
}
for (; table->op!=op; table++)
if (table->op==0)
return(0);
for (opt = table->tabp; opt->tabdeg1!=0; opt++) {
if (d1 > (opt->tabdeg1&077)
|| (opt->tabdeg1 >= 0100 && (p1->op != STAR)))
continue;
if (notcompat(p1, opt->tabtyp1, op)) {
continue;
}
if ((opdope[op]&BINARY)!=0 && p2!=0) {
if (d2 > (opt->tabdeg2&077)
|| (opt->tabdeg2 >= 0100) && (p2->op != STAR) )
continue;
if (notcompat(p2,opt->tabtyp2, 0))
continue;
}
return(opt);
}
return(0);
}
/*
* Given a tree, a code table, and a register,
* produce code to evaluate the tree with the appropriate table.
* Registers reg and upcan be used.
* If there is a value, it is desired that it appear in reg.
* The routine returns the register in which the value actually appears.
* This routine must work or there is an error.
* If the table called for is cctab, sptab, or efftab,
* and tree can't be done using the called-for table,
* another try is made.
* If the tree can't be compiled using cctab, regtab is
* used and a "tst" instruction is produced.
* If the tree can't be compiled using sptab,
* regtab is used and the register is pushed on the stack.
* If the tree can't be compiled using efftab,
* just use regtab.
* Regtab must succeed or an "op not found" error results.
*
* A number of special cases are recognized, and
* there is an interaction with the optimizer routines.
*/
rcexpr(atree, atable, reg)
struct tnode *atree;
struct table *atable;
{
register r;
int modf, nargs, recurf;
register struct tnode *tree;
register struct table *table;
table = atable;
recurf = 0;
if (reg<0) {
recurf++;
reg = ~reg;
if (reg>=020) {
reg =- 020;
recurf++;
}
}
if((tree=atree)==0)
return(0);
switch (tree->op) {
/*
* A conditional branch
*/
case CBRANCH:
cbranch(optim(tree->btree), tree->lbl, tree->cond, 0);
return(0);
/*
* An initializing expression
*/
case INIT:
if (tree->tr1->op == AMPER)
tree->tr1 = tree->tr1->tr1;
if (tree->tr1->op==NAME)
pname(tree->tr1);
else if (tree->tr1==CON)
psoct(tree->tr1->value);
else
error("Illegal initialization");
putchar('\n');
return(0);
/*
* Put the value of an expression in r0,
* for a switch or a return
*/
case RFORCE:
if((r=rcexpr(tree->tr1, regtab, reg)) != 0)
printf("mov%c r%d,r0\n", isfloat(tree->tr1), r);
return(0);
/*
* sequential execution
*/
case COMMA:
rcexpr(tree->tr1, efftab, reg);
atree = tree = tree->tr2;
break;
/*
* In the generated &~ operator,
* fiddle things so a PDP-11 "bit"
* instruction will be produced when cctab is used.
*/
case NAND:
if (table==cctab) {
tree->op = TAND;
tree->tr2 = optim(block(1, COMPL, INT, 0, tree->tr2));
}
break;
/*
* Handle a subroutine call. It has to be done
* here because if cexpr got called twice, the
* arguments might be compiled twice.
* There is also some fiddling so the
* first argument, in favorable circumstances,
* goes to (sp) instead of -(sp), reducing
* the amount of stack-popping.
*/
case CALL:
r = 0;
nargs = 0;
modf = 0;
if (tree->tr1->op!=NAME) { /* get nargs right */
nargs++;
nstack++;
}
tree = tree->tr2;
if(tree->op) {
while (tree->op==COMMA) {
r =+ comarg(tree->tr2, &modf);
tree = tree->tr1;
nargs++;
}
r =+ comarg(tree, &modf);
nargs++;
}
tree = atree;
tree->op = CALL2;
if (modf && tree->tr1->op==NAME && tree->tr1->class==EXTERN)
tree->op = CALL1;
cexpr(tree, regtab, reg);
popstk(r);
nstack =- nargs;
if (table==efftab || table==regtab)
return(0);
r = 0;
goto fixup;
/*
* Longs need special treatment.
*/
case ASLSH:
case LSHIFT:
if (tree->type==LONG) {
if (tree->tr2->op==ITOL)
tree->tr2 = tree->tr2->tr1;
if (tree->op==ASLSH)
tree->op = ASLSHL;
else
tree->op = LLSHIFT;
}
break;
/*
* Try to change * and / to shifts.
*/
case TIMES:
case DIVIDE:
case ASTIMES:
case ASDIV:
tree = pow2(tree);
}
/*
* Try to find postfix ++ and -- operators that can be
* pulled out and done after the rest of the expression
*/
if (table!=cctab && table!=cregtab && recurf<2
&& (opdope[tree->op]&LEAF)==0) {
if (r=delay(&atree, table, reg)) {
tree = atree;
table = efftab;
reg = r-1;
}
}
/*
* Basically, try to reorder the computation
* so reg = x+y is done as reg = x; reg =+ y
*/
if (recurf==0 && reorder(&atree, table, reg)) {
if (table==cctab && atree->op==NAME)
return(reg);
}
tree = atree;
if (table==efftab && tree->op==NAME)
return(reg);
if ((r=cexpr(tree, table, reg))>=0)
return(r);
if (table!=regtab) {
if((r=cexpr(tree, regtab, reg))>=0) {
fixup:
modf = isfloat(tree);
if (table==sptab || table==lsptab) {
if (tree->type==LONG) {
printf("mov\tr%d,-(sp)\n",r+1);
nstack++;
}
printf("mov%c r%d,%c(sp)\n", modf, r,
table==sptab? '-':0);
nstack++;
}
if (table==cctab)
printf("tst%c r%d\n", modf, r);
return(r);
}
}
if (tree->op>0 && tree->op<RFORCE && opntab[tree->op])
error("No code table for op: %s", opntab[tree->op]);
else
error("No code table for op %d", tree->op);
return(reg);
}
/*
* Try to compile the tree with the code table using
* registers areg and up. If successful,
* return the register where the value actually ended up.
* If unsuccessful, return -1.
*
* Most of the work is the macro-expansion of the
* code table.
*/
cexpr(atree, table, areg)
struct tnode *atree;
struct table *table;
{
int c, r;
register struct tnode *p, *p1, *tree;
struct table *ctable;
struct tnode *p2;
char *string;
int reg, reg1, rreg, flag, opd;
char *opt;
tree = atree;
reg = areg;
p1 = tree->tr2;
c = tree->op;
opd = opdope[c];
/*
* When the value of a relational or a logical expression is
* desired, more work must be done.
*/
if ((opd&RELAT||c==LOGAND||c==LOGOR||c==EXCLA) && table!=cctab) {
cbranch(tree, c=isn++, 1, reg);
rcexpr(&czero, table, reg);
branch(isn, 0);
label(c);
rcexpr(&cone, table, reg);
label(isn++);
return(reg);
}
if(c==QUEST) {
if (table==cctab)
return(-1);
cbranch(tree->tr1, c=isn++, 0, reg);
flag = nstack;
rreg = rcexpr(p1->tr1, table, reg);
nstack = flag;
branch(r=isn++, 0);
label(c);
reg = rcexpr(p1->tr2, table, rreg);
if (rreg!=reg)
printf("mov%c r%d,r%d\n",
isfloat(tree),reg,rreg);
label(r);
return(rreg);
}
reg = oddreg(tree, reg);
reg1 = reg+1;
/*
* long values take 2 registers.
*/
if (tree->type==LONG && tree->op!=ITOL)
reg1++;
/*
* Leaves of the expression tree
*/
if ((r = chkleaf(tree, table, reg)) >= 0)
return(r);
/*
* x + (-1) is better done as x-1.
*/
if ((tree->op==PLUS||tree->op==ASPLUS) &&
(p1=tree->tr2)->op == CON && p1->value == -1) {
p1->value = 1;
tree->op =+ (MINUS-PLUS);
}
if (table==cregtab)
table = regtab;
/*
* The following peculiar code depends on the fact that
* if you just want the codition codes set, efftab
* will generate the right code unless the operator is
* postfix ++ or --. Unravelled, if the table is
* cctab and the operator is not special, try first
* for efftab; if the table isn't, if the operator is,
* or the first match fails, try to match
* with the table actually asked for.
*/
if (table!=cctab || c==INCAFT || c==DECAFT
|| (opt = match(tree, efftab, nreg-reg)) == 0)
if ((opt=match(tree, table, nreg-reg))==0)
return(-1);
string = opt->tabstring;
p1 = tree->tr1;
p2 = 0;
if (opdope[tree->op]&BINARY)
p2 = tree->tr2;
loop:
/*
* The 0200 bit asks for a tab.
*/
if ((c = *string++) & 0200) {
c =& 0177;
putchar('\t');
}
switch (c) {
case '\0':
if (!isfloat(tree))
if (tree->op==DIVIDE || tree->op==ASDIV)
reg--;
return(reg);
/* A1 */
case 'A':
p = p1;
goto adr;
/* A2 */
case 'B':
p = p2;
goto adr;
adr:
c = 0;
if (*string=='\'') {
c = 1;
string++;
} else if (*string=='+') {
c = 2;
string++;
}
pname(p, c);
goto loop;
/* I */
case 'M':
if ((c = *string)=='\'')
string++;
else
c = 0;
prins(tree->op, c, instab);
goto loop;
/* B1 */
case 'C':
if ((opd&LEAF) != 0)
p = tree;
else
p = p1;
goto pbyte;
/* BF */
case 'P':
p = tree;
goto pb1;
/* B2 */
case 'D':
p = p2;
pbyte:
if (p->type==CHAR)
putchar('b');
pb1:
if (isfloat(p))
putchar('f');
goto loop;
/* BE */
case 'L':
if (p1->type==CHAR || p2->type==CHAR)
putchar('b');
p = tree;
goto pb1;
/* F */
case 'G':
p = p1;
flag = 01;
goto subtre;
/* S */
case 'K':
p = p2;
flag = 02;
goto subtre;
/* H */
case 'H':
p = tree;
flag = 04;
subtre:
ctable = regtab;
c = *string++ - 'A';
if (*string=='!') {
string++;
c =| 020; /* force right register */
}
if ((c&02)!=0)
ctable = sptab;
if ((c&04)!=0)
ctable = cctab;
if ((flag&01) && ctable==regtab && (c&01)==0
&& (tree->op==DIVIDE||tree->op==MOD
|| tree->op==ASDIV||tree->op==ASMOD))
ctable = cregtab;
if ((c&01)!=0) {
p = p->tr1;
if(collcon(p) && ctable!=sptab) {
if (p->op==STAR)
p = p->tr1;
p = p->tr1;
}
}
if (table==lsptab && ctable==sptab)
ctable = lsptab;
if (c&010)
r = reg1;
else
if (opdope[p->op]&LEAF || p->degree < 2)
r = reg;
else
r = areg;
rreg = rcexpr(p, ctable, r);
if (ctable!=regtab && ctable!=cregtab)
goto loop;
if (c&010) {
if (c&020 && rreg!=reg1)
printf("mov%c r%d,r%d\n",
isfloat(tree),rreg,reg1);
else
reg1 = rreg;
} else if (rreg!=reg)
if ((c&020)==0 && oddreg(tree, 0)==0 && (flag&04 ||
flag&01
&& xdcalc(p2, nreg-rreg-1) <= (opt->tabdeg2&077)
|| flag&02
&& xdcalc(p1,nreg-rreg-1) <= (opt->tabdeg1&077))) {
reg = rreg;
reg1 = rreg+1;
} else
printf("mov%c\tr%d,r%d\n",
isfloat(tree), rreg, reg);
goto loop;
/* R */
case 'I':
r = reg;
if (*string=='-') {
string++;
r--;
}
goto preg;
/* R1 */
case 'J':
r = reg1;
preg:
if (*string=='+') {
string++;
r++;
}
if (r>nreg)
error("Register overflow: simplify expression");
printf("r%d", r);
goto loop;
case '-': /* check -(sp) */
if (*string=='(') {
nstack++;
if (table!=lsptab)
putchar('-');
goto loop;
}
break;
case ')': /* check (sp)+ */
putchar(')');
if (*string=='+')
nstack--;
goto loop;
/* #1 */
case '#':
p = p1->tr1;
goto nmbr;
/* #2 */
case '"':
p = p2->tr1;
nmbr:
if(collcon(p)) {
if (p->op==STAR) {
printf("*");
p = p->tr1;
}
if ((p = p->tr2)->op == CON) {
if (p->value)
psoct(p->value);
} else if (p->op==AMPER)
pname(p->tr1, 0);
}
goto loop;
case 'T': /* "tst R" if 1st op not in cctab */
if (dcalc(p1, 5)>12 && !match(p1, cctab, 10))
printf("tst r%d\n", reg);
goto loop;
case 'V': /* adc or sbc as required for longs */
switch(tree->op) {
case PLUS:
case ASPLUS:
case INCBEF:
case INCAFT:
printf("adc");
break;
case MINUS:
case ASMINUS:
case NEG:
case DECBEF:
case DECAFT:
printf("sbc");
break;
default:
while ((c = *string++)!='\n' && c!='\0');
break;
}
goto loop;
}
putchar(c);
goto loop;
}
/*
* This routine just calls sreorder (below)
* on the subtrees and then on the tree itself.
* It returns non-zero if anything changed.
*/
reorder(treep, table, reg)
struct tnode **treep;
struct table *table;
{
register r, r1;
register struct tnode *p;
p = *treep;
if (opdope[p->op]&LEAF)
return(0);
r1 = 0;
while(sreorder(&p->tr1, table, reg))
r1++;
if (opdope[p->op]&BINARY)
while(sreorder(&p->tr2, table, reg))
r1++;
r = 0;
while (sreorder(treep, table, reg))
r++;
*treep = optim(*treep);
return(r);
}
/*
* Basically this routine carries out two kinds of optimization.
* First, it observes that "x + (reg = y)" where actually
* the = is any assignment op is better done as "reg=y; x+reg".
* In this case rcexpr is called to do the first part and the
* tree is modified so the name of the register
* replaces the assignment.
* Moreover, expressions like "reg = x+y" are best done as
* "reg = x; reg =+ y" (so long as "reg" and "y" are not the same!).
*/
sreorder(treep, table, reg)
struct tnode **treep;
struct table *table;
{
register struct tnode *p, *p1;
p = *treep;
if (opdope[p->op]&LEAF)
return(0);
if (p->op==PLUS)
if (reorder(&p->tr2, table, reg))
*treep = p = optim(p);
p1 = p->tr1;
if (p->op==STAR || p->op==PLUS) {
if (reorder(&p->tr1, table, reg))
*treep = p = optim(p);
p1 = p->tr1;
}
if (p1->op==NAME) switch(p->op) {
case ASLSH:
case ASRSH:
case ASSIGN:
if (p1->class != REG || isfloat(p->tr2))
return(0);
if (p->op==ASSIGN) switch (p->tr2->op) {
case TIMES:
case DIVIDE:
if (!ispow2(p->tr2))
break;
p->tr2 = pow2(p->tr2);
case PLUS:
case MINUS:
case AND:
case NAND:
case OR:
case EXOR:
case LSHIFT:
case RSHIFT:
p1 = p->tr2->tr2;
if (xdcalc(p1) > 12
|| p1->op==NAME
&&(p1->nloc==p->tr1->nloc
|| p1->regno==p->tr1->nloc))
return(0);
p1 = p->tr2;
p->tr2 = p1->tr1;
if (p1->tr1->op!=NAME
|| p1->tr1->class!=REG
|| p1->tr1->nloc!=p->tr1->nloc)
rcexpr(p, efftab, reg);
p->tr2 = p1->tr2;
p->op = p1->op + ASPLUS - PLUS;
*treep = p;
return(1);
}
goto OK;
case ASTIMES:
case ASDIV:
if (!ispow2(p))
return(0);
case ASPLUS:
case ASMINUS:
case ASSAND:
case ASSNAND:
case ASOR:
case ASXOR:
case DECBEF:
case INCBEF:
OK:
if (table==cctab||table==cregtab)
reg =+ 020;
rcexpr(optim(p), efftab, ~reg);
*treep = p1;
return(1);
}
return(0);
}
/*
* Delay handles postfix ++ and --
* It observes that "x + y++" is better
* treated as "x + y; y++".
* If the operator is ++ or -- itself,
* it calls rcexpr to load the operand, letting
* the calling instance of rcexpr to do the
* ++ using efftab.
* Otherwise it uses sdelay to search for inc/dec
* among the operands.
*/
delay(treep, table, reg)
struct tnode **treep;
{
register struct tnode *p, *p1;
register r;
p = *treep;
if (table!=efftab && (p->op==INCAFT||p->op==DECAFT)
&& p->tr1->op==NAME) {
return(1+rcexpr(p->tr1, table, reg));
}
p1 = 0;
if (opdope[p->op]&BINARY)
p1 = sdelay(&p->tr2);
if (p1==0)
p1 = sdelay(&p->tr1);
if (p1) {
r = rcexpr(optim(p), table, reg);
*treep = p1;
return(r+1);
}
return(0);
}
sdelay(ap)
struct tnode **ap;
{
register struct tnode *p, *p1;
p = *ap;
if ((p->op==INCAFT||p->op==DECAFT) && p->tr1->op==NAME) {
*ap = ncopy(p->tr1);
return(p);
}
if (p->op==STAR || p->op==PLUS)
if (p1=sdelay(&p->tr1))
return(p1);
if (p->op==PLUS)
return(sdelay(&p->tr2));
return(0);
}
/*
* Copy a tree node for a register variable.
* Used by sdelay because if *reg-- is turned
* into *reg; reg-- the *reg will in turn
* be changed to some offset class, accidentally
* modifying the reg--.
*/
ncopy(ap)
struct tname *ap;
{
register struct tname *p;
p = ap;
if (p->class!=REG)
return(p);
return(block(3, NAME, p->type, p->elsize, p->tr1,
p->offset, p->nloc));
}
/*
* If the tree can be immediately loaded into a register,
* produce code to do so and return success.
*/
chkleaf(atree, table, reg)
struct tnode *atree;
{
struct tnode lbuf;
register struct tnode *tree;
tree = atree;
if (tree->op!=STAR && dcalc(tree, nreg-reg) > 12)
return(-1);
lbuf.op = LOAD;
lbuf.type = tree->type;
lbuf.degree = tree->degree;
lbuf.tr1 = tree;
return(rcexpr(&lbuf, table, reg));
}
/*
* Compile a function argument.
* If the stack is currently empty, put it in (sp)
* rather than -(sp); this will save a pop.
* Return the number of bytes pushed,
* for future popping.
*/
comarg(atree, flagp)
int *flagp;
{
register struct tnode *tree;
register retval;
tree = atree;
if (nstack || isfloat(tree) || tree->type==LONG) {
rcexpr(tree, sptab, 0);
retval = arlength(tree->type);
} else {
(*flagp)++;
rcexpr(tree, lsptab, 0);
retval = 0;
}
return(retval);
}
source/c/c11.c
+849
View File
@@ -0,0 +1,849 @@
#
/*
* C compiler
*/
#include "c1h.c"
max(a, b)
{
if (a>b)
return(a);
return(b);
}
degree(at)
struct tnode *at;
{
register struct tnode *t, *t1;
if ((t=at)==0 || t->op==0)
return(0);
if (t->op == CON)
return(-3);
if (t->op == AMPER)
return(-2);
if (t->op==ITOL && (t1 = isconstant(t)) && t1->value>= 0)
return(-2);
if ((opdope[t->op] & LEAF) != 0) {
if (t->type==CHAR || t->type==FLOAT)
return(1);
return(0);
}
return(t->degree);
}
pname(ap, flag)
struct tnode *ap;
{
register i;
register struct tnode *p;
p = ap;
loop:
switch(p->op) {
case SFCON:
case CON:
printf("$");
psoct(p->value);
return;
case FCON:
printf("L%d", p->value);
return;
case NAME:
i = p->offset;
if (flag==2)
i =+ 2;
if (i) {
psoct(i);
if (p->class!=OFFS)
putchar('+');
if (p->class==REG)
regerr();
}
switch(p->class) {
case SOFFS:
case XOFFS:
pbase(p);
case OFFS:
printf("(r%d)", p->regno);
return;
case EXTERN:
case STATIC:
pbase(p);
return;
case REG:
printf("r%d", p->nloc);
return;
}
error("Compiler error: pname");
return;
case AMPER:
putchar('$');
p = p->tr1;
if (p->op==NAME && p->class==REG)
regerr();
goto loop;
case AUTOI:
printf("(r%d)%c", p->nloc, flag==1?0:'+');
return;
case AUTOD:
printf("%c(r%d)", flag==1?0:'-', p->nloc);
return;
case STAR:
p = p->tr1;
putchar('*');
goto loop;
}
error("pname called illegally");
}
regerr()
{
error("Illegal use of register");
}
pbase(ap)
struct tnode *ap;
{
register struct tnode *p;
p = ap;
if (p->class==SOFFS || p->class==STATIC)
printf("L%d", p->nloc);
else
printf("_%.8s", &(p->nloc));
}
xdcalc(ap, nrleft)
struct tnode *ap;
{
register struct tnode *p;
register d;
p = ap;
d = dcalc(p, nrleft);
if (d<20 && p->type==CHAR) {
if (nrleft>=1)
d = 20;
else
d = 24;
}
return(d);
}
dcalc(ap, nrleft)
struct tnode *ap;
{
register struct tnode *p, *p1;
if ((p=ap)==0)
return(0);
switch (p->op) {
case NAME:
if (p->class==REG)
return(9);
case AMPER:
case FCON:
case AUTOI:
case AUTOD:
return(12);
case CON:
case SFCON:
if (p->value==0)
return(4);
if (p->value==1)
return(5);
if (p->value > 0)
return(8);
return(12);
case STAR:
p1 = p->tr1;
if (p1->op==NAME||p1->op==CON||p1->op==AUTOI||p1->op==AUTOD)
if (p->type!=LONG)
return(12);
}
if (p->type==LONG)
nrleft--;
return(p->degree <= nrleft? 20: 24);
}
notcompat(ap, ast, op)
struct tnode *ap;
{
register at, st;
register struct tnode *p;
p = ap;
at = p->type;
st = ast;
if (st==0) /* word, byte */
return(at>CHAR && at<PTR);
if (st==1) /* word */
return(at>INT && at<PTR);
st =- 2;
if ((at&(~(TYPE+XTYPE))) != 0)
at = 020;
if ((at&(~TYPE)) != 0)
at = at&TYPE | 020;
if (st==FLOAT && at==DOUBLE)
at = FLOAT;
if (p->op==NAME && p->class==REG && op==ASSIGN && st==CHAR)
return(0);
return(st != at);
}
prins(op, c, itable)
struct instab *itable;
{
register struct instab *insp;
register char *ip;
for (insp=itable; insp->op != 0; insp++) {
if (insp->op == op) {
ip = c? insp->str2: insp->str1;
if (ip==0)
break;
printf("%s", ip);
return;
}
}
error("No match' for op %d", op);
}
collcon(ap)
struct tnode *ap;
{
register op;
register struct tnode *p;
p = ap;
if (p->op==STAR)
p = p->tr1;
if (p->op==PLUS) {
op = p->tr2->op;
if (op==CON || op==AMPER)
return(1);
}
return(0);
}
isfloat(at)
struct tnode *at;
{
register struct tnode *t;
t = at;
if ((opdope[t->op]&RELAT)!=0)
t = t->tr1;
if (t->type==FLOAT || t->type==DOUBLE) {
nfloat = 1;
return('f');
}
return(0);
}
oddreg(t, areg)
struct tnode *t;
{
register reg;
reg = areg;
if (!isfloat(t))
switch(t->op) {
case DIVIDE:
case MOD:
case ASDIV:
case ASMOD:
reg++;
case TIMES:
case ASTIMES:
return(reg|1);
}
return(reg);
}
arlength(t)
{
if (t>=PTR)
return(2);
switch(t) {
case INT:
case CHAR:
return(2);
case LONG:
return(4);
case FLOAT:
case DOUBLE:
return(8);
}
return(1024);
}
/*
* Strings for switch code.
*/
char dirsw[] {"\
cmp r0,$%o\n\
jhi L%d\n\
asl r0\n\
jmp *L%d(r0)\n\
.data\n\
L%d:\
" };
char simpsw[] {"\
mov $L%d,r1\n\
mov r0,L%d\n\
L%d:cmp r0,(r1)+\n\
jne L%d\n\
jmp *L%d-L%d(r1)\n\
.data\n\
L%d:\
"};
char hashsw[] {"\
mov r0,r1\n\
clr r0\n\
div $%o,r0\n\
asl r1\n\
add $L%d,r1\n\
mov r0,*(r1)+\n\
mov (r1)+,r1\n\
L%d:cmp r0,-(r1)\n\
jne L%d\n\
jmp *L%d-L%d(r1)\n\
.data\n\
L%d:\
"};
pswitch(afp, alp, deflab)
struct swtab *afp, *alp;
{
int tlab, ncase, i, j, tabs, worst, best, range;
register struct swtab *swp, *fp, *lp;
int poctab[swsiz];
fp = afp;
lp = alp;
if (fp==lp) {
printf("jbr L%d\n", deflab);
return;
}
tlab = isn++;
if (sort(fp, lp))
return;
ncase = lp-fp;
lp--;
range = lp->swval - fp->swval;
/* direct switch */
if (range>0 && range <= 3*ncase) {
if (fp->swval)
printf("sub $%o,r0\n", fp->swval);
printf(dirsw, range, deflab, isn, isn);
isn++;
for (i=fp->swval; i<=lp->swval; i++) {
if (i==fp->swval) {
printf("L%d\n", fp->swlab);
fp++;
} else
printf("L%d\n", deflab);
}
goto esw;
}
/* simple switch */
if (ncase<8) {
i = isn++;
j = isn++;
printf(simpsw, i, j, isn, isn, j, i, i);
isn++;
for (; fp<=lp; fp++)
printf("%o\n", fp->swval);
printf("L%d:..\n", j);
for (fp = afp; fp<=lp; fp++)
printf("L%d\n", fp->swlab);
printf("L%d\n", deflab);
goto esw;
}
/* hash switch */
best = 077777;
for (i=ncase/4; i<=ncase/2; i++) {
for (j=0; j<i; j++)
poctab[j] = 0;
for (swp=fp; swp<=lp; swp++)
poctab[lrem(0, swp->swval, i)]++;
worst = 0;
for (j=0; j<i; j++)
if (poctab[j]>worst)
worst = poctab[j];
if (i*worst < best) {
tabs = i;
best = i*worst;
}
}
i = isn++;
printf(hashsw, tabs, isn, i, i, isn+tabs+1, isn+1, isn);
isn++;
for (i=0; i<=tabs; i++)
printf("L%d\n", isn+i);
for (i=0; i<tabs; i++) {
printf("L%d:..\n", isn++);
for (swp=fp; swp<=lp; swp++)
if (lrem(0, swp->swval, tabs) == i)
printf("%o\n", ldiv(0, swp->swval, tabs));
}
printf("L%d:", isn++);
for (i=0; i<tabs; i++) {
printf("L%d\n", deflab);
for (swp=fp; swp<=lp; swp++)
if (lrem(0, swp->swval, tabs) == i)
printf("L%d\n", swp->swlab);
}
esw:
printf(".text\n");
}
sort(afp, alp)
struct swtab *afp, *alp;
{
register struct swtab *cp, *fp, *lp;
int intch, t;
fp = afp;
lp = alp;
while (fp < --lp) {
intch = 0;
for (cp=fp; cp<lp; cp++) {
if (cp->swval == cp[1].swval) {
error("Duplicate case (%d)", cp->swval);
return(1);
}
if (cp->swval > cp[1].swval) {
intch++;
t = cp->swval;
cp->swval = cp[1].swval;
cp[1].swval = t;
t = cp->swlab;
cp->swlab = cp[1].swlab;
cp[1].swlab = t;
}
}
if (intch==0)
break;
}
return(0);
}
ispow2(atree)
{
register int d;
register struct tnode *tree;
tree = atree;
if (!isfloat(tree) && tree->tr2->op==CON) {
d = tree->tr2->value;
if (d>1 && (d&(d-1))==0)
return(d);
}
return(0);
}
pow2(atree)
struct tnode *atree;
{
register int d, i;
register struct tnode *tree;
tree = atree;
if (d = ispow2(tree)) {
for (i=0; (d=>>1)!=0; i++);
tree->tr2->value = i;
d = tree->op;
tree->op = d==TIMES? LSHIFT:
(d==DIVIDE? RSHIFT:
(d==ASTIMES? ASLSH: ASRSH));
tree = optim(tree);
}
return(tree);
}
cbranch(atree, albl, cond, areg)
struct tnode *atree;
{
int l1, op;
register lbl, reg;
register struct tnode *tree;
lbl = albl;
reg = areg;
if ((tree=atree)==0)
return;
switch(tree->op) {
case LOGAND:
if (cond) {
cbranch(tree->tr1, l1=isn++, 0, reg);
cbranch(tree->tr2, lbl, 1, reg);
label(l1);
} else {
cbranch(tree->tr1, lbl, 0, reg);
cbranch(tree->tr2, lbl, 0, reg);
}
return;
case LOGOR:
if (cond) {
cbranch(tree->tr1, lbl, 1, reg);
cbranch(tree->tr2, lbl, 1, reg);
} else {
cbranch(tree->tr1, l1=isn++, 1, reg);
cbranch(tree->tr2, lbl, 0, reg);
label(l1);
}
return;
case EXCLA:
cbranch(tree->tr1, lbl, !cond, reg);
return;
case COMMA:
rcexpr(tree->tr1, efftab, reg);
tree = tree->tr2;
break;
}
op = tree->op;
if (tree->type==LONG || opdope[op]&RELAT&&tree->tr1->type==LONG) {
if (tree->type!=LONG) {
tree->op = MINUS;
tree->type = LONG;
tree = optim(tree);
} else
op = NEQUAL;
rcexpr(tree, regtab, 0);
printf("ashc $0,r0\n");
branch(lbl, op, !cond);
return;
}
rcexpr(tree, cctab, reg);
op = tree->op;
if ((opdope[op]&RELAT)==0)
op = NEQUAL;
else {
l1 = tree->tr2->op;
if ((l1==CON || l1==SFCON) && tree->tr2->value==0)
op =+ 200; /* special for ptr tests */
else
op = maprel[op-EQUAL];
}
if (isfloat(tree))
printf("cfcc\n");
branch(lbl, op, !cond);
}
branch(lbl, aop, c)
{
register op;
if(op=aop)
prins(op, c, branchtab);
else
printf("jbr");
printf("\tL%d\n", lbl);
}
label(l)
{
printf("L%d:", l);
}
popstk(a)
{
switch(a) {
case 0:
return;
case 2:
printf("tst (sp)+\n");
return;
case 4:
printf("cmp (sp)+,(sp)+\n");
return;
}
printf("add $%o,sp\n", a);
}
error(s, p1, p2, p3, p4, p5, p6)
{
register f;
extern fout;
nerror++;
flush();
f = fout;
fout = 1;
printf("%d: ", line);
printf(s, p1, p2, p3, p4, p5, p6);
putchar('\n');
flush();
fout = f;
}
psoct(an)
{
register int n, sign;
sign = 0;
if ((n = an) < 0) {
n = -n;
sign = '-';
}
printf("%c%o", sign, n);
}
/*
* Read in an intermediate file.
*/
getree()
{
struct tnode *expstack[20];
register struct tnode **sp;
register t, op;
static char s[9];
struct swtab *swp;
spacep = treespace;
sp = expstack;
for (;;) {
if (sp >= &expstack[20])
error("Stack botch");
op = getw(ascbuf);
if ((op&0177400) != 0177000) {
error("Intermediate file error");
exit(1);
}
switch(op =& 0377) {
case EOF:
return;
case BDATA:
printf(".byte ");
seq(',');
break;
case WDATA:
seq(';');
break;
case PROG:
printf(".text\n");
break;
case DATA:
printf(".data\n");
break;
case BSS:
printf(".bss\n");
break;
case SYMDEF:
printf(".globl _%s\n", outname(s));
break;
case RETRN:
printf("jmp cret\n");
break;
case CSPACE:
t = outname(s);
printf(".comm _%s,%o\n", t, getw(ascbuf));
break;
case SSPACE:
printf(".=.+%o\n", getw(ascbuf));
break;
case EVEN:
printf(".even\n");
break;
case SAVE:
printf("jsr r5,csv\n");
t = getw(ascbuf)-6;
if (t==2)
printf("tst -(sp)\n");
else if (t > 2)
printf("sub $%o,sp\n", t);
break;
case PROFIL:
t = getw(ascbuf);
printf("mov $L%d,r0\njsr pc,mcount\n", t);
printf(".bss\nL%d:.=.+2\n.text\n", t);
break;
case SNAME:
t = outname(s);
printf("~%s=L%d\n", t, getw(ascbuf));
break;
case ANAME:
t = outname(s);
printf("~%s=%o\n", t, getw(ascbuf));
break;
case RNAME:
t = outname(s);
printf("~%s=r%d\n", t, getw(ascbuf));
break;
case SWIT:
t = getw(ascbuf);
line = getw(ascbuf);
swp = treespace;
while (swp->swlab = getw(ascbuf)) {
swp->swval = getw(ascbuf);
swp++;
}
pswitch(treespace, swp, t);
break;
case EXPR:
line = getw(ascbuf);
if (sp != &expstack[1]) {
error("Expression input botch\n");
exit(1);
}
nstack = 0;
rcexpr(optim(*--sp), efftab, 0);
spacep = treespace;
break;
case NAME:
t = getw(ascbuf);
if (t==EXTERN) {
t = getw(ascbuf);
*sp = block(6, NAME, t, 0, EXTERN, 0, 0,0,0,0);
outname(&(*sp)->nloc);
sp++;
break;
}
*sp = block(3, NAME, 0, 0, t, 0, 0);
(*sp)->type = getw(ascbuf);
(*sp)->nloc = getw(ascbuf);
sp++;
break;
case CON:
case SFCON:
case FCON:
t = getw(ascbuf);
*sp++ = block(1, op, t, 0, getw(ascbuf));
break;
case FSEL:
t = getw(ascbuf);
sp[-1] = block(2, op, t, 0, sp[-1], getw(ascbuf));
break;
case NULL:
*sp++ = block(0, 0, 0, 0);
break;
case CBRANCH:
t = getw(ascbuf);
sp[-1] = block(1, CBRANCH, sp[-1], t, getw(ascbuf));
break;
case LABEL:
label(getw(ascbuf));
break;
case NLABEL:
printf("_%s:\n", outname(s));
break;
case RLABEL:
t = outname(s);
printf("_%s:\n~~%s:\n", t, t);
break;
case BRANCH:
branch(getw(ascbuf), 0);
break;
case SETREG:
nreg = getw(ascbuf)-1;
break;
default:
if (opdope[op]&BINARY) {
if (sp < &expstack[1]) {
error("Binary expression botch");
exit(1);
}
t = *--sp;
*sp++ = block(2, op, getw(ascbuf), 0, *--sp, t);
} else {
sp[-1] = block(1, op, getw(ascbuf), 0, sp[-1]);
}
break;
}
}
}
outname(s)
{
register char *p, c;
register n;
p = s;
n = 0;
while (c = getc(ascbuf)) {
*p++ = c;
n++;
}
while (n++ < 8)
*p++ = 0;
return(s);
}
seq(c)
{
register o;
if (getw(ascbuf) == 0)
return;
for (;;) {
printf("%o", getw(ascbuf));
if ((o = getw(ascbuf)) != 1)
break;
printf("%c", c);
}
printf("\n");
}
source/c/c12.c
+621
View File
@@ -0,0 +1,621 @@
#
/*
* C compiler part 2 -- expression optimizer
*
*/
#include "c1h.c"
optim(atree)
struct tnode *atree;
{
register op, dope;
int d1, d2;
struct tnode *t;
register struct tnode *tree;
if ((tree=atree)==0)
return(0);
if ((op = tree->op)==0)
return(tree);
if (op==NAME && tree->class==AUTO) {
tree->class = OFFS;
tree->regno = 5;
tree->offset = tree->nloc;
}
dope = opdope[op];
if ((dope&LEAF) != 0)
return(tree);
if ((dope&BINARY) == 0)
return(unoptim(tree));
/* is known to be binary */
if (tree->type==CHAR)
tree->type = INT;
if ((dope&COMMUTE)!=0) {
acomm: d1 = tree->type;
tree = acommute(tree);
tree->type = d1;
/*
* PDP-11 special:
* replace a&b by a NAND ~ b.
* This will be undone when in
* truth-value context.
*/
if (tree->op!=AND)
return(tree);
tree->op = NAND;
tree->tr2 = block(1, COMPL, tree->tr2->type, 0, tree->tr2);
}
again:
tree->tr1 = optim(tree->tr1);
tree->tr2 = optim(tree->tr2);
if ((dope&RELAT) != 0) {
if ((d1=degree(tree->tr1)) < (d2=degree(tree->tr2))
|| d1==d2 && tree->tr1->op==NAME && tree->tr2->op!=NAME) {
t = tree->tr1;
tree->tr1 = tree->tr2;
tree->tr2 = t;
tree->op = maprel[op-EQUAL];
}
if (tree->tr1->type==CHAR && tree->tr2->op==CON
&& (dcalc(tree->tr1) <= 12 || tree->tr1->op==STAR)
&& tree->tr2->value <= 127 && tree->tr2->value >= 0)
tree->tr2->type = CHAR;
}
d1 = max(degree(tree->tr1), islong(tree->type));
d2 = max(degree(tree->tr2), 0);
if (tree->tr1->type==LONG && dope&RELAT)
d1 = 10;
switch (op) {
case LTIMES:
case LDIV:
case LMOD:
case LASTIMES:
case LASDIV:
case LASMOD:
tree->degree = 10;
break;
/*
* PDP-11 special:
* generate new =&~ operator out of =&
* by complementing the RHS.
*/
case ASSAND:
op = ASSNAND;
tree->op = op;
tree->tr2 = block(2, COMPL, tree->tr2->type, 0, tree->tr2);
goto again;
case NAND:
if (isconstant(tree->tr2) && tree->tr2->value==0)
return(tree->tr1);
goto def;
case CALL:
tree->degree = 10;
break;
case QUEST:
case COLON:
tree->degree = max(d1, d2);
break;
case MINUS:
if (t = isconstant(tree->tr2)) {
tree->op = PLUS;
if (t->type==DOUBLE)
/* PDP-11 FP representation */
t->value =^ 0100000;
else
t->value = -t->value;
goto acomm;
}
goto def;
case DIVIDE:
case ASDIV:
case ASTIMES:
if (tree->tr2->op==CON && tree->tr2->value==1)
return(tree->tr1);
if (ispow2(tree) == 0) {
case MOD:
case ASMOD:
d1 =+ 2;
d2 =+ 2;
}
if (tree->type==LONG)
return(hardlongs(tree));
goto constant;
case LSHIFT:
case RSHIFT:
case ASRSH:
case ASLSH:
if (tree->tr2->op==CON && tree->tr2->value==0)
return(tree->tr1);
/*
* PDP-11 special: turn right shifts into negative
* left shifts
*/
if (op==LSHIFT||op==ASLSH)
goto constant;
if (tree->tr2->op==CON && tree->tr2->value==1)
goto constant;
op =+ (LSHIFT-RSHIFT);
tree->op = op;
tree->tr2 = block(1, NEG, tree->type, 0, tree->tr2);
goto again;
constant:
if (tree->tr1->op==CON && tree->tr2->op==CON) {
const(op, &tree->tr1->value, tree->tr2->value);
return(tree->tr1);
}
def:
default:
tree->degree = d1==d2? d1+islong(tree->type): max(d1, d2);
break;
}
return(tree);
}
unoptim(atree)
struct tnode *atree;
{
register struct tnode *subtre, *tree;
register int *p;
double static fv;
struct { int integer; };
if ((tree=atree)==0)
return(0);
if (tree->op==CBRANCH) {
tree->btree = optim(tree->btree);
return(tree);
}
subtre = tree->tr1 = optim(tree->tr1);
switch (tree->op) {
case FSEL:
tree->tr1 = block(2, RSHIFT, INT, 0, subtre,
block(1, CON, INT, 0, tree->bitoffs));
tree->op = AND;
tree->type = INT;
tree->tr2 = block(1, CON, INT, 0, (1<<tree->flen)-1);
return(optim(tree));
case AMPER:
if (subtre->op==STAR)
return(subtre->tr1);
if (subtre->op==NAME && subtre->class == OFFS) {
p = block(2, PLUS, tree->type, 1, subtre, tree);
subtre->type = tree->type;
tree->op = CON;
tree->type = INT;
tree->degree = 0;
tree->value = subtre->offset;
subtre->class = REG;
subtre->nloc = subtre->regno;
subtre->offset = 0;
return(p);
}
break;
case STAR:
if (subtre->op==AMPER)
return(subtre->tr1);
if (subtre->op==NAME && subtre->class==REG) {
subtre->type = tree->type;
subtre->class = OFFS;
subtre->regno = subtre->nloc;
return(subtre);
}
p = subtre->tr1;
if ((subtre->op==INCAFT||subtre->op==DECBEF)&&tree->type!=LONG
&& p->op==NAME && p->class==REG && p->type==subtre->type) {
p->type = tree->type;
p->op = subtre->op==INCAFT? AUTOI: AUTOD;
return(p);
}
if (subtre->op==PLUS && p->op==NAME && p->class==REG) {
if (subtre->tr2->op==CON) {
p->offset =+ subtre->tr2->value;
p->class = OFFS;
p->type = tree->type;
p->regno = p->nloc;
return(p);
}
if (subtre->tr2->op==AMPER) {
subtre = subtre->tr2->tr1;
subtre->class =+ XOFFS-EXTERN;
subtre->regno = p->nloc;
subtre->type = tree->type;
return(subtre);
}
}
break;
case EXCLA:
if ((opdope[subtre->op]&RELAT)==0)
break;
tree = subtre;
tree->op = notrel[tree->op-EQUAL];
break;
case NEG:
case COMPL:
if (tree->type==CHAR)
tree->type = INT;
if (tree->op == subtre->op)
return(subtre->tr1);
if (subtre->op==ITOL) {
subtre->op = tree->op;
subtre->type = INT;
tree->op = ITOL;
}
}
if (subtre->op == CON) switch(tree->op) {
case NEG:
subtre->value = -subtre->value;
return(subtre);
case COMPL:
subtre->value = ~subtre->value;
return(subtre);
case ITOF:
fv = subtre->value;
p = &fv;
p++;
if (*p++==0 && *p++==0 && *p++==0) {
subtre->type = DOUBLE;
subtre->value = fv.integer;
subtre->op = SFCON;
return(subtre);
}
break;
}
tree->degree = max(islong(tree->type), degree(subtre));
return(tree);
}
struct acl {
int nextl;
int nextn;
struct tnode *nlist[20];
struct tnode *llist[21];
};
acommute(atree)
{
struct acl acl;
int d, i, op, flt;
register struct tnode *t1, **t2, *tree;
struct tnode *t;
acl.nextl = 0;
acl.nextn = 0;
tree = atree;
op = tree->op;
flt = isfloat(tree);
insert(op, tree, &acl);
acl.nextl--;
t2 = &acl.llist[acl.nextl];
if (!flt) {
/* put constants together */
for (i=acl.nextl;i>0&&t2[0]->op==CON&&t2[-1]->op==CON;i--) {
acl.nextl--;
t2--;
const(op, &t2[0]->value, t2[1]->value);
}
}
if (op==PLUS || op==OR) {
/* toss out "+0" */
if (acl.nextl>0 && (t1 = isconstant(*t2)) && t1->value==0) {
acl.nextl--;
t2--;
}
if (acl.nextl <= 0)
return(*t2);
/* subsume constant in "&x+c" */
if (op==PLUS && t2[0]->op==CON && t2[-1]->op==AMPER) {
t2--;
t2[0]->tr1->offset =+ t2[1]->value;
acl.nextl--;
}
} else if (op==TIMES || op==AND) {
t1 = acl.llist[acl.nextl];
if (t1->op==CON) {
if (t1->value==0)
return(t1);
if (op==TIMES && t1->value==1 && acl.nextl>0)
if (--acl.nextl <= 0)
return(acl.llist[0]);
}
}
if (op==PLUS && !flt)
distrib(&acl);
tree = *(t2 = &acl.llist[0]);
d = max(degree(tree), islong(tree->type));
if (op==TIMES && !flt)
d++;
for (i=0; i<acl.nextl; i++) {
t1 = acl.nlist[i];
t1->tr2 = t = *++t2;
t1->degree = d = d==degree(t)? d+islong(t1->type): max(d, degree(t));
t1->tr1 = tree;
tree = t1;
if (tree->type==LONG) {
if (tree->op==TIMES)
tree = hardlongs(tree);
else if (tree->op==PLUS && (t = isconstant(tree->tr1))
&& t->value < 0) {
tree->op = MINUS;
t->value = - t->value;
t = tree->tr1;
tree->tr1 = tree->tr2;
tree->tr2 = t;
}
}
}
if (tree->op==TIMES && ispow2(tree))
tree->degree = max(degree(tree->tr1), islong(tree->type));
return(tree);
}
distrib(list)
struct acl *list;
{
/*
* Find a list member of the form c1c2*x such
* that c1c2 divides no other such constant, is divided by
* at least one other (say in the form c1*y), and which has
* fewest divisors. Reduce this pair to c1*(y+c2*x)
* and iterate until no reductions occur.
*/
register struct tnode **p1, **p2;
struct tnode *t;
int ndmaj, ndmin;
struct tnode **dividend, **divisor;
struct tnode **maxnod, **mindiv;
loop:
maxnod = &list->llist[list->nextl];
ndmaj = 1000;
dividend = 0;
for (p1 = list->llist; p1 <= maxnod; p1++) {
if ((*p1)->op!=TIMES || (*p1)->tr2->op!=CON)
continue;
ndmin = 0;
for (p2 = list->llist; p2 <= maxnod; p2++) {
if (p1==p2 || (*p2)->op!=TIMES || (*p2)->tr2->op!=CON)
continue;
if ((*p1)->tr2->value == (*p2)->tr2->value) {
(*p2)->tr2 = (*p1)->tr1;
(*p2)->op = PLUS;
(*p1)->tr1 = (*p2);
*p1 = optim(*p1);
squash(p2, maxnod);
list->nextl--;
goto loop;
}
if (((*p2)->tr2->value % (*p1)->tr2->value) == 0)
goto contmaj;
if (((*p1)->tr2->value % (*p2)->tr2->value) == 0) {
ndmin++;
mindiv = p2;
}
}
if (ndmin > 0 && ndmin < ndmaj) {
ndmaj = ndmin;
dividend = p1;
divisor = mindiv;
}
contmaj:;
}
if (dividend==0)
return;
t = list->nlist[--list->nextn];
p1 = dividend;
p2 = divisor;
t->op = PLUS;
t->type = (*p1)->type;
t->tr1 = (*p1);
t->tr2 = (*p2)->tr1;
(*p1)->tr2->value =/ (*p2)->tr2->value;
(*p2)->tr1 = t;
t = optim(*p2);
if (p1 < p2) {
*p1 = t;
squash(p2, maxnod);
} else {
*p2 = t;
squash(p1, maxnod);
}
list->nextl--;
goto loop;
}
squash(p, maxp)
struct tnode **p, **maxp;
{
register struct tnode **np;
for (np = p; np < maxp; np++)
*np = *(np+1);
}
const(op, vp, av)
int *vp;
{
register int v;
v = av;
switch (op) {
case PLUS:
*vp =+ v;
return;
case TIMES:
*vp =* v;
return;
case AND:
*vp =& v;
return;
case OR:
*vp =| v;
return;
case EXOR:
*vp =^ v;
return;
case DIVIDE:
case MOD:
if (v==0)
error("Divide check");
else
if (op==DIVIDE)
*vp =/ v;
else
*vp =% v;
return;
case RSHIFT:
*vp =>> v;
return;
case LSHIFT:
*vp =<< v;
return;
case NAND:
*vp =& ~ v;
return;
}
error("C error: const");
}
insert(op, atree, alist)
struct acl *alist;
{
register d;
register struct acl *list;
register struct tnode *tree;
int d1, i;
struct tnode *t;
tree = atree;
list = alist;
if (tree->op == op) {
ins: list->nlist[list->nextn++] = tree;
insert(op, tree->tr1, list);
insert(op, tree->tr2, list);
return;
}
tree = optim(tree);
if (tree->op == op)
goto ins;
if (!isfloat(tree)) {
/* c1*(x+c2) -> c1*x+c1*c2 */
if ((tree->op==TIMES||tree->op==LSHIFT)
&& tree->tr2->op==CON && tree->tr2->value>0
&& tree->tr1->op==PLUS && tree->tr1->tr2->op==CON) {
d = tree->tr2->value;
if (tree->op==TIMES)
tree->tr2->value =* tree->tr1->tr2->value;
else
tree->tr2->value = tree->tr1->tr2->value << d;
tree->tr1->tr2->value = d;
tree->tr1->op = tree->op;
tree->op = PLUS;
if (op==PLUS)
goto ins;
}
}
d = degree(tree);
for (i=0; i<list->nextl; i++) {
if ((d1=degree(list->llist[i]))<d) {
t = list->llist[i];
list->llist[i] = tree;
tree = t;
d = d1;
}
}
list->llist[list->nextl++] = tree;
}
block(an, args)
{
register int *p;
int *oldp;
register *argp, n;
oldp = p = spacep;
n = an+3;
argp = &args;
do
*p++ = *argp++;
while (--n);
if (p >= &treespace[ossiz]) {
error("Exp. ov. pass 2");
exit(1);
}
spacep = p;
return(oldp);
}
islong(t)
{
if (t==LONG)
return(2);
return(1);
}
isconstant(at)
struct tnode *at;
{
register struct tnode *t;
t = at;
if (t->op==CON || t->op==SFCON)
return(t);
if (t->op==ITOL && t->tr1->op==CON)
return(t->tr1);
return(0);
}
hardlongs(at)
struct tnode *at;
{
register struct tnode *t;
t = at;
switch(t->op) {
case TIMES:
case DIVIDE:
case MOD:
t->op =+ LTIMES-TIMES;
break;
case ASTIMES:
case ASDIV:
case ASMOD:
t->op =+ LASTIMES-ASTIMES;
t->tr1 = block(1, AMPER, LONG+PTR, 0, t->tr1);
break;
default:
return(t);
}
return(optim(t));
}
source/c/c13.c
+227
View File
@@ -0,0 +1,227 @@
int opdope[] {
000000, /* EOF */
000000, /* ; */
000000, /* { */
000000, /* } */
036000, /* [ */
002000, /* ] */
036000, /* ( */
002000, /* ) */
014201, /* : */
007001, /* , */
000000, /* field selection */
000000, /* 11 */
000000, /* 12 */
000000, /* 13 */
000000, /* 14 */
000000, /* 15 */
000000, /* 16 */
000000, /* 17 */
000000, /* 18 */
000000, /* 19 */
000400, /* name */
000400, /* short constant */
000400, /* string */
000400, /* float */
000400, /* double */
000000, /* 25 */
000000, /* 26 */
000400, /* autoi, *r++ */
000400, /* autod, *--r */
000000, /* 29 */
034203, /* ++pre */
034203, /* --pre */
034203, /* ++post */
034203, /* --post */
034220, /* !un */
034202, /* &un */
034220, /* *un */
034200, /* -un */
034220, /* ~un */
036001, /* . (structure reference) */
030101, /* + */
030001, /* - */
032101, /* * */
032001, /* / */
032001, /* % */
026061, /* >> */
026061, /* << */
020161, /* & */
016161, /* | */
016161, /* ^ */
036001, /* -> */
001000, /* int -> double */
001000, /* double -> int */
000001, /* && */
000001, /* || */
030001, /* &~ */
001000, /* double -> long */
001000, /* long -> double */
001000, /* integer -> long */
001000, /* long -> integer */
022005, /* == */
022005, /* != */
024005, /* <= */
024005, /* < */
024005, /* >= */
024005, /* > */
024005, /* <p */
024005, /* <=p */
024005, /* >p */
024005, /* >=p */
012213, /* =+ */
012213, /* =- */
012213, /* =* */
012213, /* =/ */
012213, /* =% */
012253, /* =>> */
012253, /* =<< */
012253, /* =& */
012253, /* =| */
012253, /* =^ */
012213, /* = */
030001, /* & for tests */
032101, /* * (long) */
032001, /* / (long) */
032001, /* % (long) */
012253, /* =& ~ */
012213, /* =* (long) */
012213, /* / (long) */
012213, /* % (long) */
000000, /* 89 */
014201, /* ? */
026061, /* long << */
012253, /* long =<< */
000000, /* 93 */
000000, /* 94 */
000000, /* 95 */
000000, /* 96 */
000000, /* 97 */
000000, /* 98 */
000000, /* 99 */
036001, /* call */
036000, /* mcall */
000000, /* goto */
000000, /* jump cond */
000000, /* branch cond */
000400, /* set nregs */
000000, /* 106 */
000000, /* 107 */
000000, /* 108 */
000000, /* 109 */
000000 /* force r0 */
};
char *opntab[] {
0,
0,
0,
0,
0,
0,
0,
0,
":",
",",
"field select",
0,
0,
0,
0,
0,
0,
0,
0,
0,
"name",
"short constant",
"string",
"float",
"double",
0,
0,
"*r++",
"*--r",
0,
"++pre",
"--pre",
"++post",
"--post",
"!un",
"&",
"*",
"-",
"~",
".",
"+",
"-",
"*",
"/",
"%",
">>",
"<<",
"&",
"|",
"^",
"->",
"int->double",
"double->int",
"&&",
"||",
"&~",
"double->long",
"long->double",
"integer->long",
"long->integer",
"==",
"!=",
"<=",
"<",
">=",
">",
"<p",
"<=p",
">p",
">=p",
"=+",
"=-",
"=*",
"=/",
"=%",
"=>>",
"=<<",
"=&",
"=|",
"=^",
"=",
"& for tests",
"*",
"/",
"%",
"=& ~",
"=*",
"=/",
"=%",
0,
"?",
"<<",
"=<<",
0,
0,
0,
0,
0,
"call",
"call",
"call",
0,
"goto",
"jump cond",
"branch cond",
"set nregs",
"load value",
0,
0,
0,
"force register"
};
source/c/c1h.c
+272
View File
@@ -0,0 +1,272 @@
/*
* C pass 2 header
*/
#define swsiz 200
#define ossiz 500
struct tnode {
int op;
int type;
int degree;
struct tnode *tr1, *tr2;
};
struct bnode {
int bop;
struct tnode *btree;
int lbl;
int cond;
};
struct tname {
int nop;
int ntype;
int elsize;
char class;
char regno;
int offset;
int nloc;
};
/*
* for field selections
*/
struct tsel {
int op;
int type;
int degree;
struct tnode *tr1;
char flen;
char bitoffs;
};
struct tconst {
int cop;
int ctype;
int cdeg;
int value;
};
struct optab {
char tabdeg1;
char tabtyp1;
char tabdeg2;
char tabtyp2;
char *tabstring;
};
struct table {
int tabop;
struct optab *tabp;
};
struct instab {
int iop;
char *str1;
char *str2;
};
struct swtab {
int swlab;
int swval;
};
char maprel[];
char notrel[];
int nreg;
int isn;
int namsiz;
int line;
char ascbuf[518];
int nerror;
struct table cctab[];
struct table efftab[];
struct table regtab[];
struct table sptab[];
struct table lsptab[];
struct instab instab[];
struct instab branchtab[];
int opdope[];
char *opntab[];
int nstack;
int nfloat;
int *spacep;
int treespace[ossiz];
int eolflg;
struct tconst czero, cone, fczero;
/*
operators
*/
#define EOF 0
#define SEMI 1
#define LBRACE 2
#define RBRACE 3
#define LBRACK 4
#define RBRACK 5
#define LPARN 6
#define RPARN 7
#define COLON 8
#define COMMA 9
#define FSEL 10
#define KEYW 19
#define NAME 20
#define CON 21
#define STRING 22
#define FCON 23
#define SFCON 24
#define AUTOI 27
#define AUTOD 28
#define INCBEF 30
#define DECBEF 31
#define INCAFT 32
#define DECAFT 33
#define EXCLA 34
#define AMPER 35
#define STAR 36
#define NEG 37
#define COMPL 38
#define DOT 39
#define PLUS 40
#define MINUS 41
#define TIMES 42
#define DIVIDE 43
#define MOD 44
#define RSHIFT 45
#define LSHIFT 46
#define AND 47
#define NAND 55
#define OR 48
#define EXOR 49
#define ARROW 50
#define ITOF 51
#define FTOI 52
#define LOGAND 53
#define LOGOR 54
#define FTOL 56
#define LTOF 57
#define ITOL 58
#define LTOI 59
#define EQUAL 60
#define NEQUAL 61
#define LESSEQ 62
#define LESS 63
#define GREATEQ 64
#define GREAT 65
#define LESSEQP 66
#define LESSP 67
#define GREATQP 68
#define GREATP 69
#define ASPLUS 70
#define ASMINUS 71
#define ASTIMES 72
#define ASDIV 73
#define ASMOD 74
#define ASRSH 75
#define ASLSH 76
#define ASSAND 77
#define ASOR 78
#define ASXOR 79
#define ASSIGN 80
#define TAND 81
#define LTIMES 82
#define LDIV 83
#define LMOD 84
#define ASSNAND 85
#define LASTIMES 86
#define LASDIV 87
#define LASMOD 88
#define QUEST 90
#define LLSHIFT 91
#define ASLSHL 92
#define CALL1 98
#define CALL2 99
#define CALL 100
#define MCALL 101
#define JUMP 102
#define CBRANCH 103
#define INIT 104
#define SETREG 105
#define LOAD 106
#define RFORCE 110
/*
* Intermediate code operators
*/
#define BRANCH 111
#define LABEL 112
#define NLABEL 113
#define RLABEL 114
#define BDATA 200
#define WDATA 201
#define PROG 202
#define DATA 203
#define BSS 204
#define CSPACE 205
#define SSPACE 206
#define SYMDEF 207
#define SAVE 208
#define RETRN 209
#define EVEN 210
#define PROFIL 212
#define SWIT 213
#define EXPR 214
#define SNAME 215
#define RNAME 216
#define ANAME 217
#define NULL 218
/*
* types
*/
#define INT 0
#define CHAR 1
#define FLOAT 2
#define DOUBLE 3
#define STRUCT 4
#define RSTRUCT 5
#define LONG 6
#define TYLEN 2
#define TYPE 07
#define XTYPE (03<<3)
#define PTR 010
#define FUNC 020
#define ARRAY 030
/*
storage classes
*/
#define KEYWC 1
#define MOS 10
#define AUTO 11
#define EXTERN 12
#define STATIC 13
#define REG 14
#define STRTAG 15
#define ARG 16
#define OFFS 20
#define XOFFS 21
#define SOFFS 22
/*
Flag bits
*/
#define BINARY 01
#define LVALUE 02
#define RELAT 04
#define ASSGOP 010
#define LWORD 020
#define RWORD 040
#define COMMUTE 0100
#define RASSOC 0200
#define LEAF 0400
#define CNVRT 01000
source/c/c1t.s
+85
View File
@@ -0,0 +1,85 @@
/ C operator tables
.globl fltused; fltused=.
.globl _instab
.globl _branchtab
.data
_instab:
80.; 1f; 2f; .text; 1:<mov\0>; 2:<clr\0>; .data
60.; 1f; 2f; .text; 1: <cmp\0>; 2: <tst\0>; .data
106.; 1b; 2b
61.; 1b; 2b
62.; 1b; 2b
63.; 1b; 2b
64.; 1b; 2b
65.; 1b; 2b
66.; 1b; 2b
67.; 1b; 2b
68.; 1b; 2b
69.; 1b; 2b
40.; 1f; 3f; .text; 1:<add\0>; .data
70.; 1b; 3f
41.; 2f; 4f; .text; 2:<sub\0>; .data
71.; 2b; 4f
30.; 1b; 3f; .text; 3:<inc\0>; .data
31.; 2b; 4f; .text; 4:<dec\0>; .data
32.; 1b; 3b
33.; 2b; 4b
42.; 5f; 5f; .text; 5:<mul>; .data
72.; 5b; 5b
43.; 6f; 6f; .text; 6:<div\0>; .data
73.; 6b; 6b
44.; 5b; 6b
74.; 5b; 6b
45.; 5f; 6f; .text; 6:<asr\0>; .data
75.; 5f; 6b
46.; 5f; 6f; .text; 5:<ash\0>; 6:<asl\0>; .data
76.; 5b; 6b
47.; 5f; 5f; .text; 5:<bic\0>; 6:<bic $1,\0>; .data
55.; 5b; 6b
85.; 5b; 6b
81.; 5f; 6f; .text; 5:<bit\0>; 6:<bit $1,\0>; .data
48.; 5f; 6f; .text; 5:<bis\0>; 6:<bis $1,\0>; .data
78.; 5b; 6b
49.; 5f; 5f; .text; 5:<xor\0>; .data
79.; 5b; 5b
37.; 1f; 1f; .text; 1:<neg\0>; .data
38.; 1f; 1f; .text; 1:<com\0>; .data
98.; 1f; 1f; .text; 1:<*$\0>; .data
99.; 1b+2; 1b+2
91.; 1f; 1f; .text; 1: <ashc\0>; .data
92.; 1b; 1b
82.; 1f; 1f; .text; 1:<lmul\0>; .data
83.; 1f; 1f; .text; 1:<ldiv\0>; .data
84.; 1f; 1f; .text; 1:<lrem\0>; .data
86.; 1f; 1f; .text; 1:<almul\0>; .data
87.; 1f; 1f; .text; 1:<aldiv\0>; .data
88.; 1f; 1f; .text; 1:<alrem\0>; .data
0
.data
_branchtab:
60.; 0f; 1f; .text; 0:<jeq\0>; 1:<jne\0>; .data
61.; 1b; 0b
62.; 2f; 5f; .text; 2:<jle\0>; 5:<jgt\0>; .data
63.; 3f; 4f; .text; 3:<jlt\0>; 4:<jge\0>; .data
64.; 4b; 3b
65.; 5b; 2b
66.; 6f; 9f; .text; 6:<jlos\0>; 9:<jhi\0>; .data
67.; 7f; 8f; .text; 7:<jlo\0>; 8:<jhis\0>; .data
68.; 8b; 7b
69.; 9b; 6b
260.; 0b; 1b
261.; 1b; 0b
262.; 2b; 5b
263.; 3b; 4b
264.; 4b; 3b
265.; 5b; 2b
266.; 0b; 1b
267.; 7f; 8f; .text; 7:</nop\0>; 8:<jbr\0>; .data
268.; 8b; 7b
269.; 1b; 0b
0
source/c/c20.c
+673
View File
@@ -0,0 +1,673 @@
#
/*
* C object code improver
*/
#include "c2h.c"
struct optab optab[] {
"jbr", JBR,
"jeq", CBR | JEQ<<8,
"jne", CBR | JNE<<8,
"jle", CBR | JLE<<8,
"jge", CBR | JGE<<8,
"jlt", CBR | JLT<<8,
"jgt", CBR | JGT<<8,
"jlo", CBR | JLO<<8,
"jhi", CBR | JHI<<8,
"jlos", CBR | JLOS<<8,
"jhis", CBR | JHIS<<8,
"jmp", JMP,
".globl",EROU,
"mov", MOV,
"clr", CLR,
"com", COM,
"inc", INC,
"dec", DEC,
"neg", NEG,
"tst", TST,
"asr", ASR,
"asl", ASL,
"sxt", SXT,
"cmp", CMP,
"add", ADD,
"sub", SUB,
"bit", BIT,
"bic", BIC,
"bis", BIS,
"mul", MUL,
"ash", ASH,
"xor", XOR,
".text",TEXT,
".data",DATA,
".bss", BSS,
".even",EVEN,
"movf", MOVF,
"movof",MOVOF,
"movfo",MOVFO,
"addf", ADDF,
"subf", SUBF,
"divf", DIVF,
"mulf", MULF,
"clrf", CLRF,
"cmpf", CMPF,
"negf", NEGF,
"tstf", TSTF,
"cfcc", CFCC,
"sob", SOB,
"jsr", JSR,
".end", END,
0, 0};
char revbr[] { JNE, JEQ, JGT, JLT, JGE, JLE, JHIS, JLOS, JHI, JLO };
int isn 20000;
main(argc, argv)
char **argv;
{
register int niter, maxiter, isend;
extern end;
extern fin, fout;
int nflag;
if (argc>1 && argv[1][0]=='+') {
argc--;
argv++;
debug++;
}
if (argc>1 && argv[1][0]=='-') {
argc--;
argv++;
nflag++;
}
if (argc>1) {
if ((fin = open(argv[1], 0)) < 0) {
printf("C2: can't find %s\n", argv[1]);
exit(1);
}
} else
fin = dup(0);
if (argc>2) {
if ((fout = creat(argv[2], 0666)) < 0) {
fout = 1;
printf("C2: can't create %s\n", argv[2]);
exit(1);
}
} else
fout = dup(1);
lasta = firstr = lastr = sbrk(2);
maxiter = 0;
opsetup();
do {
isend = input();
movedat();
niter = 0;
do {
refcount();
do {
iterate();
clearreg();
niter++;
} while (nchange);
comjump();
rmove();
} while (nchange || jumpsw());
addsob();
output();
if (niter > maxiter)
maxiter = niter;
lasta = firstr;
} while (isend);
flush();
fout = 2;
if (nflag) {
printf("%d iterations\n", maxiter);
printf("%d jumps to jumps\n", nbrbr);
printf("%d inst. after jumps\n", iaftbr);
printf("%d jumps to .+2\n", njp1);
printf("%d redundant labels\n", nrlab);
printf("%d cross-jumps\n", nxjump);
printf("%d code motions\n", ncmot);
printf("%d branches reversed\n", nrevbr);
printf("%d redundant moves\n", redunm);
printf("%d simplified addresses\n", nsaddr);
printf("%d loops inverted\n", loopiv);
printf("%d redundant jumps\n", nredunj);
printf("%d common seqs before jmp's\n", ncomj);
printf("%d skips over jumps\n", nskip);
printf("%d sob's added\n", nsob);
printf("%d redundant tst's\n", nrtst);
printf("%d literals eliminated\n", nlit);
printf("%dK core\n", ((lastr+01777)>>10)&077);
flush();
}
exit(0);
}
input()
{
register struct node *p, *lastp;
register int op;
lastp = &first;
for (;;) {
op = getline();
switch (op.op) {
case LABEL:
p = alloc(sizeof first);
if (line[0] == 'L') {
p->combop = LABEL;
p->labno = getnum(line+1);
p->code = 0;
} else {
p->combop = DLABEL;
p->labno = 0;
p->code = copy(line);
}
break;
case JBR:
case CBR:
case JMP:
case JSW:
p = alloc(sizeof first);
p->combop = op;
if (*curlp=='L' && (p->labno = getnum(curlp+1)))
p->code = 0;
else {
p->labno = 0;
p->code = copy(curlp);
}
break;
default:
p = alloc(sizeof first);
p->combop = op;
p->labno = 0;
p->code = copy(curlp);
break;
}
p->forw = 0;
p->back = lastp;
lastp->forw = p;
lastp = p;
p->ref = 0;
if (op==EROU)
return(1);
if (op==END)
return(0);
}
}
getline()
{
register char *lp;
register c;
lp = line;
while (c = getchar()) {
if (c==':') {
*lp++ = 0;
return(LABEL);
}
if (c=='\n') {
*lp++ = 0;
return(oplook());
}
*lp++ = c;
}
*lp++ = 0;
return(END);
}
getnum(ap)
char *ap;
{
register char *p;
register n, c;
p = ap;
n = 0;
while ((c = *p++) >= '0' && c <= '9')
n = n*10 + c - '0';
if (*--p != 0)
return(0);
return(n);
}
output()
{
register struct node *t;
register struct optab *op;
register int byte;
t = &first;
while (t = t->forw) switch (t->op) {
case END:
return;
case LABEL:
printf("L%d:", t->labno);
continue;
case DLABEL:
printf("%s:", t->code);
continue;
default:
if ((byte = t->subop) == BYTE)
t->subop = 0;
for (op = optab; op->opstring!=0; op++)
if (op->opcode == t->combop) {
printf("%s", op->opstring);
if (byte==BYTE)
printf("b");
break;
}
if (t->code) {
reducelit(t);
printf("\t%s\n", t->code);
} else if (t->op==JBR || t->op==CBR)
printf("\tL%d\n", t->labno);
else
printf("\n");
continue;
case JSW:
printf("L%d\n", t->labno);
continue;
case SOB:
printf("sob %s,L%d\n", t->code, t->labno);
continue;
case 0:
if (t->code)
printf("%s", t->code);
printf("\n");
continue;
}
}
/*
* Notice addresses of the form
* $xx,xx(r)
* and replace them with (pc),xx(r)
* -- Thanx and a tip of the Hatlo hat to Bliss-11.
*/
reducelit(at)
struct node *at;
{
register char *c1, *c2;
char *c2s;
register struct node *t;
t = at;
if (*t->code != '$')
return;
c1 = t->code;
while (*c1 != ',')
if (*c1++ == '\0')
return;
c2s = c1;
c1++;
if (*c1=='*')
c1++;
c2 = t->code+1;
while (*c1++ == *c2++);
if (*--c1!='(' || *--c2!=',')
return;
t->code = copy("(pc)", c2s);
nlit++;
}
copy(ap)
char *ap;
{
register char *p, *np;
char *onp;
register n;
int na;
na = nargs();
p = ap;
n = 0;
if (*p==0)
return(0);
do
n++;
while (*p++);
if (na>1) {
p = (&ap)[1];
while (*p++)
n++;
}
onp = np = alloc(n);
p = ap;
while (*np++ = *p++);
if (na>1) {
p = (&ap)[1];
np--;
while (*np++ = *p++);
}
return(onp);
}
opsetup()
{
register struct optab *optp, **ophp;
register char *p;
for (optp = optab; p = optp->opstring; optp++) {
ophp = &ophash[(((p[0]<<3)+(p[1]<<1)+p[2])&077777) % OPHS];
while (*ophp++)
if (ophp > &ophash[OPHS])
ophp = ophash;
*--ophp = optp;
}
}
oplook()
{
register struct optab *optp;
register char *lp, *op;
static char tmpop[32];
struct optab **ophp;
op = tmpop;
for (lp = line; *lp && *lp!=' ' && *lp!='\t';)
*op++ = *lp++;
*op++ = 0;
while (*lp=='\t' || *lp==' ')
lp++;
curlp = lp;
ophp = &ophash[(((tmpop[0]<<3)+(tmpop[1]<<1)+tmpop[2])&077777) % OPHS];
while (optp = *ophp) {
op = optp->opstring;
lp = tmpop;
while (*lp == *op++)
if (*lp++ == 0)
return(optp->opcode);
if (*lp++=='b' && *lp++==0 && *--op==0)
return(optp->opcode + (BYTE<<8));
ophp++;
if (ophp >= &ophash[OPHS])
ophp = ophash;
}
if (line[0]=='L') {
lp = &line[1];
while (*lp)
if (*lp<'0' || *lp++>'9')
return(0);
curlp = line;
return(JSW);
}
curlp = line;
return(0);
}
refcount()
{
register struct node *p, *lp;
static struct node *labhash[LABHS];
register struct node **hp;
for (hp = labhash; hp < &labhash[LABHS];)
*hp++ = 0;
for (p = first.forw; p!=0; p = p->forw)
if (p->op==LABEL) {
labhash[p->labno % LABHS] = p;
p->refc = 0;
}
for (p = first.forw; p!=0; p = p->forw) {
if (p->op==JBR || p->op==CBR || p->op==JSW) {
p->ref = 0;
lp = labhash[p->labno % LABHS];
if (lp==0 || p->labno!=lp->labno)
for (lp = first.forw; lp!=0; lp = lp->forw) {
if (lp->op==LABEL && p->labno==lp->labno)
break;
}
if (lp) {
hp = nonlab(lp)->back;
if (hp!=lp) {
p->labno = hp->labno;
lp = hp;
}
p->ref = lp;
lp->refc++;
}
}
}
for (p = first.forw; p!=0; p = p->forw)
if (p->op==LABEL && p->refc==0
&& (lp = nonlab(p))->op && lp->op!=JSW)
decref(p);
}
iterate()
{
register struct node *p, *rp, *p1;
nchange = 0;
for (p = first.forw; p!=0; p = p->forw) {
if ((p->op==JBR||p->op==CBR||p->op==JSW) && p->ref) {
rp = nonlab(p->ref);
if (rp->op==JBR && rp->labno && p!=rp) {
nbrbr++;
p->labno = rp->labno;
decref(p->ref);
rp->ref->refc++;
p->ref = rp->ref;
nchange++;
}
}
if (p->op==CBR && (p1 = p->forw)->op==JBR) {
rp = p->ref;
do
rp = rp->back;
while (rp->op==LABEL);
if (rp==p1) {
decref(p->ref);
p->ref = p1->ref;
p->labno = p1->labno;
p1->forw->back = p;
p->forw = p1->forw;
p->subop = revbr[p->subop];
nchange++;
nskip++;
}
}
if (p->op==JBR || p->op==JMP) {
while (p->forw && p->forw->op!=LABEL
&& p->forw->op!=EROU && p->forw->op!=END) {
nchange++;
iaftbr++;
if (p->forw->ref)
decref(p->forw->ref);
p->forw = p->forw->forw;
p->forw->back = p;
}
rp = p->forw;
while (rp && rp->op==LABEL) {
if (p->ref == rp) {
p->back->forw = p->forw;
p->forw->back = p->back;
p = p->back;
decref(rp);
nchange++;
njp1++;
break;
}
rp = rp->forw;
}
xjump(p);
p = codemove(p);
}
}
}
xjump(ap)
{
register int *p1, *p2, *p3;
int nxj;
nxj = 0;
p1 = ap;
if ((p2 = p1->ref)==0)
return(0);
for (;;) {
while ((p1 = p1->back) && p1->op==LABEL);
while ((p2 = p2->back) && p2->op==LABEL);
if (!equop(p1, p2) || p1==p2)
return(nxj);
p3 = insertl(p2);
p1->combop = JBR;
p1->ref = p3;
p1->labno = p3->labno;
p1->code = 0;
nxj++;
nxjump++;
nchange++;
}
}
insertl(ap)
struct node *ap;
{
register struct node *lp, *op;
op = ap;
if (op->op == LABEL) {
op->refc++;
return(op);
}
if (op->back->op == LABEL) {
op = op->back;
op->refc++;
return(op);
}
lp = alloc(sizeof first);
lp->combop = LABEL;
lp->labno = isn++;
lp->ref = 0;
lp->code = 0;
lp->refc = 1;
lp->back = op->back;
lp->forw = op;
op->back->forw = lp;
op->back = lp;
return(lp);
}
codemove(ap)
struct node *ap;
{
register struct node *p1, *p2, *p3;
struct node *t, *tl;
int n;
p1 = ap;
if (p1->op!=JBR || (p2 = p1->ref)==0)
return(p1);
while (p2->op == LABEL)
if ((p2 = p2->back) == 0)
return(p1);
if (p2->op!=JBR && p2->op!=JMP)
goto ivloop;
p2 = p2->forw;
p3 = p1->ref;
while (p3) {
if (p3->op==JBR || p3->op==JMP) {
if (p1==p3)
return(p1);
ncmot++;
nchange++;
p1->back->forw = p2;
p1->forw->back = p3;
p2->back->forw = p3->forw;
p3->forw->back = p2->back;
p2->back = p1->back;
p3->forw = p1->forw;
decref(p1->ref);
return(p2);
} else
p3 = p3->forw;
}
return(p1);
ivloop:
if (p1->forw->op!=LABEL)
return(p1);
p3 = p2 = p2->forw;
n = 16;
do {
if ((p3 = p3->forw) == 0 || p3==p1 || --n==0)
return(p1);
} while (p3->op!=CBR || p3->labno!=p1->forw->labno);
do
if ((p1 = p1->back) == 0)
return(ap);
while (p1!=p3);
p1 = ap;
tl = insertl(p1);
p3->subop = revbr[p3->subop];
decref(p3->ref);
p2->back->forw = p1;
p3->forw->back = p1;
p1->back->forw = p2;
p1->forw->back = p3;
t = p1->back;
p1->back = p2->back;
p2->back = t;
t = p1->forw;
p1->forw = p3->forw;
p3->forw = t;
p2 = insertl(p1->forw);
p3->labno = p2->labno;
p3->ref = p2;
decref(tl);
if (tl->refc<=0)
nrlab--;
loopiv++;
nchange++;
return(p3);
}
comjump()
{
register struct node *p1, *p2, *p3;
for (p1 = first.forw; p1!=0; p1 = p1->forw)
if (p1->op==JBR && (p2 = p1->ref) && p2->refc > 1)
for (p3 = p1->forw; p3!=0; p3 = p3->forw)
if (p3->op==JBR && p3->ref == p2)
backjmp(p1, p3);
}
backjmp(ap1, ap2)
struct node *ap1, *ap2;
{
register struct node *p1, *p2, *p3;
p1 = ap1;
p2 = ap2;
for(;;) {
while ((p1 = p1->back) && p1->op==LABEL);
p2 = p2->back;
if (equop(p1, p2)) {
p3 = insertl(p1);
p2->back->forw = p2->forw;
p2->forw->back = p2->back;
p2 = p2->forw;
decref(p2->ref);
p2->labno = p3->labno;
p2->ref = p3;
nchange++;
ncomj++;
} else
return;
}
}
source/c/c21.c
+659
View File
@@ -0,0 +1,659 @@
#
/*
* C object code improver-- second part
*/
#include "c2h.c"
rmove()
{
register struct node *p;
register char *cp;
register int r;
int r1, flt;
for (p=first.forw; p!=0; p = p->forw) {
if (debug) {
for (r=0; r<2*NREG; r++)
if (regs[r][0])
printf("%d: %s\n", r, regs[r]);
printf("-\n");
}
flt = 0;
switch (p->op) {
case MOVF:
case MOVFO:
case MOVOF:
flt = NREG;
case MOV:
if (p->subop==BYTE)
goto badmov;
dualop(p);
if ((r = findrand(regs[RT1], flt)) >= 0) {
if (r == flt+isreg(regs[RT2]) && p->forw->op!=CBR) {
p->forw->back = p->back;
p->back->forw = p->forw;
redunm++;
continue;
}
}
repladdr(p, 0, flt);
r = isreg(regs[RT1]);
r1 = isreg(regs[RT2]);
dest(regs[RT2], flt);
if (r >= 0)
if (r1 >= 0)
savereg(r1+flt, regs[r+flt]);
else
savereg(r+flt, regs[RT2]);
else
if (r1 >= 0)
savereg(r1+flt, regs[RT1]);
else
setcon(regs[RT1], regs[RT2]);
source(regs[RT1]);
setcc(regs[RT2]);
continue;
case ADDF:
case SUBF:
case DIVF:
case MULF:
flt = NREG;
case ADD:
case SUB:
case BIC:
case BIS:
case MUL:
case DIV:
case ASH:
badmov:
dualop(p);
repladdr(p, 0, flt);
source(regs[RT1]);
dest(regs[RT2], flt);
if (p->op==DIV && (r = isreg(regs[RT2])>=0))
regs[r+1][0] = 0;
ccloc[0] = 0;
continue;
case CLRF:
case NEGF:
flt = NREG;
case CLR:
case COM:
case INC:
case DEC:
case NEG:
case ASR:
case ASL:
case SXT:
singop(p);
dest(regs[RT1], flt);
if (p->op==CLR && flt==0)
if ((r = isreg(regs[RT1])) >= 0)
savereg(r, "$0");
else
setcon("$0", regs[RT1]);
setcc(regs[RT1]);
continue;
case TSTF:
flt = NREG;
case TST:
singop(p);
repladdr(p, 0, flt);
source(regs[RT1]);
if (equstr(regs[RT1], ccloc)) {
p->back->forw = p->forw;
p->forw->back = p->back;
p = p->back;
nrtst++;
nchange++;
}
continue;
case CMPF:
flt = NREG;
case CMP:
case BIT:
dualop(p);
source(regs[RT1]);
source(regs[RT2]);
repladdr(p, 1, flt);
ccloc[0] = 0;
continue;
case CBR:
case CFCC:
ccloc[0] = 0;
continue;
case JBR:
redunbr(p);
default:
clearreg();
}
}
}
jumpsw()
{
register struct node *p, *p1;
register t;
int nj;
t = 0;
nj = 0;
for (p=first.forw; p!=0; p = p->forw)
p->refc = ++t;
for (p=first.forw; p!=0; p = p1) {
p1 = p->forw;
if (p->op == CBR && p1->op==JBR && p->ref && p1->ref
&& abs(p->refc - p->ref->refc) > abs(p1->refc - p1->ref->refc)) {
p->subop = revbr[p->subop];
t = p1->ref;
p1->ref = p->ref;
p->ref = t;
t = p1->labno;
p1->labno = p->labno;
p->labno = t;
nrevbr++;
nj++;
}
}
return(nj);
}
addsob()
{
register struct node *p, *p1;
for (p = &first; (p1 = p->forw)!=0; p = p1) {
if (p->op==DEC && isreg(p->code)>=0
&& p1->combop==(CBR|JNE<<8)) {
if (p->refc < p1->ref->refc)
continue;
if (p->refc - p1->ref->refc > 50)
continue;
p->labno = p1->labno;
p->combop = SOB;
p1->forw->back = p;
p->forw = p1->forw;
nsob++;
}
}
}
abs(x)
{
return(x<0? -x: x);
}
equop(ap1, p2)
struct node *ap1, *p2;
{
register char *cp1, *cp2;
register struct node *p1;
p1 = ap1;
if (p1->combop != p2->combop)
return(0);
if (p1->op>0 && p1->op<MOV)
return(0);
cp1 = p1->code;
cp2 = p2->code;
if (cp1==0 && cp2==0)
return(1);
if (cp1==0 || cp2==0)
return(0);
while (*cp1 == *cp2++)
if (*cp1++ == 0)
return(1);
return(0);
}
decref(ap)
{
register struct node *p;
p = ap;
if (--p->refc <= 0) {
nrlab++;
p->back->forw = p->forw;
p->forw->back = p->back;
}
}
nonlab(ap)
struct node *ap;
{
register struct node *p;
p = ap;
while (p && p->op==LABEL)
p = p->forw;
return(p);
}
alloc(an)
{
register int n;
register char *p;
n = an;
n++;
n =& ~01;
if (lasta+n >= lastr) {
if (sbrk(2000) == -1) {
write(2, "Optimizer: out of space\n", 14);
exit(1);
}
lastr =+ 2000;
}
p = lasta;
lasta =+ n;
return(p);
}
clearreg()
{
register int i;
for (i=0; i<2*NREG; i++)
regs[i][0] = '\0';
conloc[0] = 0;
ccloc[0] = 0;
}
savereg(ai, as)
char *as;
{
register char *p, *s, *sp;
sp = p = regs[ai];
s = as;
if (source(s))
return;
while (*p++ = *s) {
if (s[0]=='(' && s[1]=='r' && s[2]<'5') {
*sp = 0;
return;
}
if (*s++ == ',')
break;
}
*--p = '\0';
}
dest(as, flt)
char *as;
{
register char *s;
register int i;
s = as;
if ((i = isreg(s)) >= 0)
regs[i+flt][0] = 0;
while ((i = findrand(s, flt)) >= 0)
regs[i][0] = 0;
while (*s) {
if ((*s=='(' && (*(s+1)!='r' || *(s+2)!='5')) || *s++=='*') {
for (i=flt; i<flt+NREG; i++) {
if (regs[i][0] != '$')
regs[i][0] = 0;
conloc[0] = 0;
}
return;
}
}
}
singop(ap)
struct node *ap;
{
register char *p1, *p2;
p1 = ap->code;
p2 = regs[RT1];
while (*p2++ = *p1++);
regs[RT2][0] = 0;
}
dualop(ap)
struct node *ap;
{
register char *p1, *p2;
register struct node *p;
p = ap;
p1 = p->code;
p2 = regs[RT1];
while (*p1 && *p1!=',')
*p2++ = *p1++;
*p2++ = 0;
p2 = regs[RT2];
*p2 = 0;
if (*p1++ !=',')
return;
while (*p2++ = *p1++);
}
findrand(as, flt)
char *as;
{
register int i;
for (i = flt; i<NREG+flt; i++) {
if (equstr(regs[i], as))
return(i);
}
return(-1);
}
isreg(as)
char *as;
{
register char *s;
s = as;
if (s[0]=='r' && s[1]>='0' && s[1]<='4' && s[2]==0)
return(s[1]-'0');
return(-1);
}
check()
{
register struct node *p, *lp;
lp = &first;
for (p=first.forw; p!=0; p = p->forw) {
if (p->back != lp)
abort();
lp = p;
}
}
source(ap)
char *ap;
{
register char *p1, *p2;
p1 = ap;
p2 = p1;
if (*p1==0)
return(0);
while (*p2++);
if (*p1=='-' && *(p1+1)=='('
|| *p1=='*' && *(p1+1)=='-' && *(p1+2)=='('
|| *(p2-2)=='+') {
while (*p1 && *p1++!='r');
if (*p1>='0' && *p1<='4')
regs[*p1 - '0'][0] = 0;
return(1);
}
return(0);
}
repladdr(p, f, flt)
struct node *p;
{
register r;
int r1;
register char *p1, *p2;
static char rt1[50], rt2[50];
if (f)
r1 = findrand(regs[RT2], flt);
else
r1 = -1;
r = findrand(regs[RT1], flt);
if (r1 >= NREG)
r1 =- NREG;
if (r >= NREG)
r =- NREG;
if (r>=0 || r1>=0) {
p2 = regs[RT1];
for (p1 = rt1; *p1++ = *p2++;);
if (regs[RT2][0]) {
p1 = rt2;
*p1++ = ',';
for (p2 = regs[RT2]; *p1++ = *p2++;);
} else
rt2[0] = 0;
if (r>=0) {
rt1[0] = 'r';
rt1[1] = r + '0';
rt1[2] = 0;
nsaddr++;
}
if (r1>=0) {
rt2[1] = 'r';
rt2[2] = r1 + '0';
rt2[3] = 0;
nsaddr++;
}
p->code = copy(rt1, rt2);
}
}
movedat()
{
register struct node *p1, *p2;
struct node *p3;
register seg;
struct node data;
struct node *datp;
if (first.forw == 0)
return;
datp = &data;
for (p1 = first.forw; p1!=0; p1 = p1->forw) {
if (p1->op == DATA) {
p2 = p1->forw;
while (p2 && p2->op!=TEXT)
p2 = p2->forw;
if (p2==0)
break;
p3 = p1->back;
p1->back->forw = p2->forw;
p2->forw->back = p3;
p2->forw = 0;
datp->forw = p1;
p1->back = datp;
p1 = p3;
datp = p2;
}
}
if (data.forw) {
datp->forw = first.forw;
first.forw->back = datp;
data.forw->back = &first;
first.forw = data.forw;
}
seg = -1;
for (p1 = first.forw; p1!=0; p1 = p1->forw) {
if (p1->op==TEXT||p1->op==DATA||p1->op==BSS) {
if (p1->op == seg || p1->forw&&p1->forw->op==seg) {
p1->back->forw = p1->forw;
p1->forw->back = p1->back;
p1 = p1->back;
continue;
}
seg = p1->op;
}
}
}
redunbr(ap)
struct node *ap;
{
register struct node *p, *p1;
register char *ap1;
char *ap2;
if ((p1 = p->ref) == 0)
return;
p1 = nonlab(p1);
if (p1->op==TST) {
singop(p1);
savereg(RT2, "$0");
} else if (p1->op==CMP)
dualop(p1);
else
return;
if (p1->forw->op!=CBR)
return;
ap1 = findcon(RT1);
ap2 = findcon(RT2);
p1 = p1->forw;
if (compare(p1->subop, ap1, ap2)) {
nredunj++;
nchange++;
decref(p->ref);
p->ref = p1->ref;
p->labno = p1->labno;
p->ref->refc++;
}
}
findcon(i)
{
register char *p;
register r;
p = regs[i];
if (*p=='$')
return(p);
if ((r = isreg(p)) >= 0)
return(regs[r]);
if (equstr(p, conloc))
return(conval);
return(p);
}
compare(op, acp1, acp2)
char *acp1, *acp2;
{
register char *cp1, *cp2;
register n1;
int n2;
struct { int i;};
cp1 = acp1;
cp2 = acp2;
if (*cp1++ != '$' || *cp2++ != '$')
return(0);
n1 = 0;
while (*cp2 >= '0' && *cp2 <= '7') {
n1 =<< 3;
n1 =+ *cp2++ - '0';
}
n2 = n1;
n1 = 0;
while (*cp1 >= '0' && *cp1 <= '7') {
n1 =<< 3;
n1 =+ *cp1++ - '0';
}
if (*cp1=='+')
cp1++;
if (*cp2=='+')
cp2++;
do {
if (*cp1++ != *cp2)
return(0);
} while (*cp2++);
cp1 = n1;
cp2 = n2;
switch(op) {
case JEQ:
return(cp1 == cp2);
case JNE:
return(cp1 != cp2);
case JLE:
return(cp1.i <= cp2.i);
case JGE:
return(cp1.i >= cp2.i);
case JLT:
return(cp1.i < cp2.i);
case JGT:
return(cp1.i > cp2.i);
case JLO:
return(cp1 < cp2);
case JHI:
return(cp1 > cp2);
case JLOS:
return(cp1 <= cp2);
case JHIS:
return(cp1 >= cp2);
}
return(0);
}
setcon(ar1, ar2)
char *ar1, *ar2;
{
register char *cl, *cv, *p;
cl = ar2;
cv = ar1;
if (*cv != '$')
return;
if (!natural(cl))
return;
p = conloc;
while (*p++ = *cl++);
p = conval;
while (*p++ = *cv++);
}
equstr(ap1, ap2)
char *ap1, *ap2;
{
char *p1, *p2;
p1 = ap1;
p2 = ap2;
do {
if (*p1++ != *p2)
return(0);
} while (*p2++);
return(1);
}
setcc(ap)
char *ap;
{
register char *p, *p1;
p = ap;
if (!natural(p)) {
ccloc[0] = 0;
return;
}
p1 = ccloc;
while (*p1++ = *p++);
}
natural(ap)
char *ap;
{
register char *p;
p = ap;
if (*p=='*' || *p=='(' || *p=='-'&&*(p+1)=='(')
return(0);
while (*p++);
p--;
if (*--p == '+' || *p ==')' && *--p != '5')
return(0);
return(1);
}
source/c/c2h.c
+125
View File
@@ -0,0 +1,125 @@
/*
* Header for object code improver
*/
#define JBR 1
#define CBR 2
#define JMP 3
#define LABEL 4
#define DLABEL 5
#define EROU 7
#define JSW 9
#define MOV 10
#define CLR 11
#define COM 12
#define INC 13
#define DEC 14
#define NEG 15
#define TST 16
#define ASR 17
#define ASL 18
#define SXT 19
#define CMP 20
#define ADD 21
#define SUB 22
#define BIT 23
#define BIC 24
#define BIS 25
#define MUL 26
#define DIV 27
#define ASH 28
#define XOR 29
#define TEXT 30
#define DATA 31
#define BSS 32
#define EVEN 33
#define MOVF 34
#define MOVOF 35
#define MOVFO 36
#define ADDF 37
#define SUBF 38
#define DIVF 39
#define MULF 40
#define CLRF 41
#define CMPF 42
#define NEGF 43
#define TSTF 44
#define CFCC 45
#define SOB 46
#define JSR 47
#define END 48
#define JEQ 0
#define JNE 1
#define JLE 2
#define JGE 3
#define JLT 4
#define JGT 5
#define JLO 6
#define JHI 7
#define JLOS 8
#define JHIS 9
#define BYTE 100
struct node {
char op;
char subop;
struct node *forw;
struct node *back;
struct node *ref;
int labno;
char *code;
int refc;
};
struct {
int combop;
};
struct optab {
char *opstring;
int opcode;
} optab[];
char line[512];
struct node first;
char *curlp;
int nbrbr;
int nsaddr;
int redunm;
int iaftbr;
int njp1;
int nrlab;
int nxjump;
int ncmot;
int nrevbr;
int loopiv;
int nredunj;
int nskip;
int ncomj;
int nsob;
int nrtst;
int nlit;
int nchange;
int isn;
int debug;
char *lasta;
char *lastr;
char *firstr;
char revbr[];
char regs[12][20];
char conloc[20];
char conval[20];
char ccloc[20];
#define RT1 10
#define RT2 11
#define FREG 5
#define NREG 5
#define LABHS 127
#define OPHS 57
struct optab *ophash[OPHS];
struct { char lbyte; };
source/c/cvopt.c
+370
View File
@@ -0,0 +1,370 @@
int nofloat;
int peekc;
int obuf[259];
int tabflg;
int labno 1;
main(argc, argv)
char **argv;
{
/*
A1 -> A
A2 B
A O
B1 C
B2 D
BE L
BF P
C1 E
C2 F
F G
H H
R I
R1 J
S K
I M
M N
* +1
S +2
C +4
1 +8
z -> 4
c 10
a 14
e 20
n 63
* +0100
*/
auto c,snlflg,nlflg,t,smode,m,ssmode;
extern fin;
smode = nlflg = snlflg = ssmode = 0;
if (argc>1)
if ((fin = open(argv[1], 0)) < 0) {
putchar('?\n');
return;
}
obuf[0] = 1;
if (argc>2)
if ((obuf[0] = creat(argv[2], 0666)) < 0) {
putchar('?\n');
return;
}
loop:
c = getc();
if (c!='\n' && c!='\t') nlflg = 0;
if (ssmode!=0 && c!='%') {
ssmode = 0;
printf(".data\nL%d:<", labno++);
}
switch(c) {
case '\0':
printf(".text; 0\n");
fflush(obuf);
return;
case ':':
if (!smode)
printf("=.+2; 0"); else
putchar(':');
goto loop;
case 'A':
if ((c=getc())=='1' || c=='2') {
putchar(c+'A'-'1');
goto loop;
}
putchar('O');
peekc = c;
goto loop;
case 'B':
switch (getc()) {
case '1':
putchar('C');
goto loop;
case '2':
putchar('D');
goto loop;
case 'E':
putchar('L');
goto loop;
case 'F':
putchar('P');
goto loop;
}
putchar('?');
goto loop;
case 'C':
putchar(getc()+'E'-'1');
goto loop;
case 'F':
putchar('G');
goto subtre;
case 'R':
if ((c=getc()) == '1')
putchar('J'); else {
putchar('I');
peekc = c;
}
goto loop;
case 'H':
putchar('H');
goto subtre;
case 'I':
putchar('M');
goto loop;
case 'S':
putchar('K');
subtre:
snlflg = 1;
t = 'A';
l1:
switch (c=getc()) {
case '*':
t++;
goto l1;
case 'S':
t =+ 2;
goto l1;
case 'C':
t =+ 4;
goto l1;
case '1':
t =+ 8;
goto l1;
case '2':
t =+ 16;
goto l1;
}
peekc = c;
putchar(t);
goto loop;
case '#':
if(getc()=='1')
putchar('#'); else
putchar('"');
goto loop;
case '%':
if (smode)
printf(".text;");
if (ssmode==0) {
if ((peekc=getc())=='[') {
peekc = 0;
printf(".data;");
while((c=getc())!=']')
putchar(c);
getc();
printf(";.text;");
goto loop;
}
}
loop1:
switch (c=getc()) {
case ' ':
case '\t':
goto loop1;
case 'a':
m = 16;
t = flag();
goto pf;
case ',':
putchar(';');
goto loop1;
case 'i':
m = 12;
t = flag();
goto pf;
case 'z':
m = 4;
t = flag();
goto pf;
case 'r':
m = 9;
t = flag();
goto pf;
case '1':
m = 5;
t = flag();
goto pf;
case 'c':
t = 0;
m = 8;
goto pf;
case 'e':
t = flag();
m = 20;
goto pf;
case 'n':
t = flag();
m = 63;
pf:
if ((c=getc())=='*')
m =+ 0100; else
peekc = c;
printf(".byte %o,%o", m, t);
goto loop1;
case '[':
printf("L%d=", labno++);
while ((c=getc())!=']')
putchar(c);
ssmode = 0;
smode = 0;
goto loop;
case '\n':
printf("\nL%d\n", labno);
ssmode = 1;
nlflg = 1;
smode = 1;
goto loop;
}
putchar(c);
goto loop1;
case '\t':
if (nlflg) {
nlflg = 0;
goto loop;
}
if (smode) {
tabflg++;
goto loop;
}
putchar('\t');
goto loop;
case '\n':
if (!smode) {
putchar('\n');
goto loop;
}
if (nlflg) {
nlflg = 0;
printf("\\0>\n.text\n");
smode = 0;
goto loop;
}
if (!snlflg)
printf("\\n");
snlflg = 0;
printf(">\n<");
nlflg = 1;
goto loop;
case 'X':
case 'Y':
case 'T':
snlflg++;
}
putchar(c);
goto loop;
}
getc() {
auto t, ifcnt;
ifcnt = 0;
gc:
if (peekc) {
t = peekc;
peekc = 0;
} else
t = getchar();
if (t==0)
return(0);
if (t=='{') {
ifcnt++;
t = getchar();
}
if (t=='}') {
t = getc();
if (--ifcnt==0)
if (t=='\n')
t = getc();
}
if (ifcnt && nofloat)
goto gc;
return(t);
}
flag() {
register c, f;
f = 0;
l1:
switch(c=getc()) {
case 'w':
f = 1;
goto l1;
case 'i':
f = 2;
goto l1;
case 'b':
f = 3;
goto l1;
case 'f':
f = 4;
goto l1;
case 'd':
f = 5;
goto l1;
case 's':
f = 6;
goto l1;
case 'l':
f = 8;
goto l1;
case 'p':
f =+ 16;
goto l1;
}
peekc = c;
return(f);
}
putchar(c)
{
if (tabflg) {
tabflg = 0;
printf(">;.byte %o;<", c+0200);
} else
putc(c, obuf);
}
source/c/run
+39
View File
@@ -0,0 +1,39 @@
cc -c -O c0[012345].c
cc -c -O c1[0123].c
as c1t.s; mv a.out c1t.o
cc cvopt.c
a.out table.s table.i
as table.i; mv a.out table.o
cc -c -O c2[01].c
ed c0t.s
g/fpp =/s/1/0/
w
q
as c0t.s; mv a.out c0t.o
cc -s -n c0?.o
cmp a.out /lib/c0
cp a.out /lib/c0
ed c0t.s
g/fpp =/s/0/1/
w
q
as c0t.s; mv a.out c0t.o
cc -f -s -n c0?.o
cmp a.out /lib/fc0
cp a.out /lib/fc0
cc -s -n c1?.o table.o
cmp a.out /lib/c1
cp a.out /lib/c1
cc -f -s -n c1?.o table.o
cmp a.out /lib/fc1
cp a.out /lib/fc1
cc -s -n c2?.o
cmp a.out /lib/c2
cp a.out /lib/c2
rm *.o table.i a.out
source/c/table.s
+1255
View File
File diff suppressed because it is too large Load Diff
source/cref/ccmn.h
+83
View File
@@ -0,0 +1,83 @@
struct tempent {
char *beg;
int ct;
char term;
} temp[30];
char lbuf[5];
int cflag;
int t1;
int level;
int hlevel;
int dlevel;
int xtrn;
int tp[5];
struct {
int cl[NUMC];
} tab[NUMS];
int coll();
int save();
int out();
int asym();
int asw();
int csym();
int csw();
int incl();
int decl();
int sk2();
int sk();
int tabs();
int semi();
char line[132];
int l;
int lno;
char c;
int cursl;
char curs[9];
int curfl;
char curf[10];
int usw;
int xsw;
int only;
int cross;
int file;
int cs;
int (*flag[8])();
int fl;
char gch[8];
struct htab {
int hsiz;
int ssiz;
int nsym;
int curb;
int *hptr;
char *symt;
};
struct htab itab;
struct htab xtab;
int ipsp[PTRI];
char issp[CHARI];
int xpsp[PTRX];
char xssp[CHARX];
int ib1[259];
int ib2[259];
char *ibuf;
char *ibuf1;
char *ibuf2;
char mone;
int order;
int ssw;
int type;
char *utmp;
source/cref/index/ecmn.h
+76
View File
@@ -0,0 +1,76 @@
int count;
int page;
struct {
char *beg;
int ct;
char term;
} temp[30];
int pn;
int word;
int hsw;
int t1;
int level;
int hlevel;
int dlevel;
int xtrn;
int tp[2];
struct {
int cl[NUMC];
} tab[NUMS];
int coll();
int save();
int out();
int hyphen();
int hyp1();
int hyp2();
int pno();
int error();
char line[300];
int l;
int lno;
char c;
int cursl;
char curs[9];
int curfl;
char curf[10];
int usw;
int xsw;
int only;
int cross;
int file;
int cs;
int (*flag[8])();
int fl;
char gch[8];
struct htab {
int hsiz;
int ssiz;
int nsym;
int curb;
int *hptr;
char *symt;
};
struct htab itab;
int ipsp[PTRI];
char issp[CHARI];
int ib1[259];
char *ibuf;
char *ibuf1;
char mone;
int order;
int ssw;
int type;
char *utmp;
source/cref/index/econs.h
+22
View File
@@ -0,0 +1,22 @@
# define NUMA 14
# define NUMC 128
# define NUMS 3
# define SIZA 8
# define SIZC 2
# define SIZS 8
# define PTRI 509
# define CHARI 4000
# define PTRX 5147
# define CHARX 40000
# define CONT 0
# define COLL 1
# define SAVE 2
# define OUT 3
# define EGOBL 4
# define SHARP 5
# define PNO 6
# define SKIP 0
# define COLLECT 1
# define SKIP2 2
#define CREATC 0644
source/cref/index/ind0.c
+363
View File
@@ -0,0 +1,363 @@
#
# include "econs.h"
# include "ecmn.h"
/*int mbuf[1024]; /*INSTR*/
/*int tbuf[12]; /*INSTR*/
int (*acts[])() {0,
&coll,
&save,
&out,
&error,
&hyphen,
&pno
};
char *tmp[2] {"/tmp/crt0a",
"/tmp/crt1a"
};
char *ignonl "/usr/lib/eign";
char *gtab "/usr/lib/etab";
main(argc,argv)
char *argv[];
{
auto i,j,tm1,tm2,tm3;
char *fn,*av[8];
/* extern etext; /*INSTR*/
/* monitor(&main,&etext,&mbuf,1024); /*INSTR*/
if(*argv[1] == '-') {
j = flags(argv);
argv =+ j;
argc =- j;
}
init();
i = 0;
if(argc == 1) {
*ibuf1 = 0;
curfl = 2;
curf[0] = '_';
curf[1] = '\t';
goto pipe;
}
while(++i < argc) {
curs[4] = '\t';
if(fopen(argv[i],ibuf1) < 0) {
printf("Can't open %s\n",argv[i]);
dexit();
}
curfl = 0;
while((curf[curfl] = *argv[i]++) != 0 && curfl <=8)
if(curf[curfl++] == '/') curfl = 0;
curf[curfl++] = '\t';
if(curfl == 8) curf[8] = -1;
pipe:
ibuf = ibuf1;
lno = 1;
driver();
close(file);
}
flsh(0);
close(tp[0]);
/* monitor(0); /*INSTR*/
/* dexit(); /*INSTR*/
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[0]/6; /*INSTR*/
/* tm2 = tbuf[1]/6; /*INSTR*/
/* printf("Prep: %d %d\n", tm1, tm2); /*INSTR*/
/* exit(); /*DEBUG*/
fn = "/bin/sort";
av[0] = "sort";
av[1] = tmp[0];
av[2] = "-o";
av[3] = tmp[0];
av[4] = 0;
callsys(fn, av);
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[3]/6; /*INSTR*/
/* tm2 = tbuf[5]/6; /*INSTR*/
/* printf("Sort: %d %d\n", tm1, tm2); /*INSTR*/
if(usw) {
fn = "/usr/bin/upost";
av[0] = "upost";
i = 0;
} else if(count) {
fn = "count";
av[0] = "count";
i = 0;
} else {
fn = "/usr/bin/crpost";
av[0] = "crpost";
av[1] = "-E";
i = 1;
}
av[++i] = tmp[0];
av[++i] = 0;
callsys(fn,av);
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[3]/6 - tm1; /*INSTR*/
/* tm2 = tbuf[5]/6 - tm2; /*INSTR*/
/* printf("Post: %d %d\n", tm1, tm2); /*INSTR*/
dexit();
}
driver()
{
auto p;
top:
l = -1;
while((c = line[++l] = getc(ibuf)) != -1) {
/* printf("driver: c = %o l = %d\n",c,l); /*DEBUG*/
if(l >= 299) {
printf("Line too long: %d.\n",lno);
dexit();
}
if(c & 0200) {
printf("Illegal character: %o line %d\n",c,lno);
dexit();
}
if(fl) {
if((*flag[fl])())
continue;
}
/*printf("cs = %d cc = %c ca = %d\n",cs,c,tab[cs].cl[c]); /*DEBUG*/
if(p = tab[cs].cl[c])
(*acts[p])();
continue;
}
if(ibuf == ibuf1) return;
ibuf = ibuf1;
goto top;
}
init()
{
int b[3];
auto fi,i;
extern coll(),save(),out(),asym(),asw(),csym(),csw();
extern incl(),decl(),sk(),sk2();
extern dexit();
ibuf1 = &ib1;
if((fi = open(gtab,0)) < 0) {
printf("Cannot open grammar table; see lem\n");
dexit();
}
i = -1;
while(++i < NUMS)
if(read(fi,tab[i].cl,256) < 256) {
printf("Bad grammar table; see lem\n");
dexit();
}
close(fi);
if(signal(1,1) != 1) signal(1,&dexit);
if(signal(2,1) != 1) signal(2,&dexit);
if(signal(3,1) != 1) signal(3,&dexit);
while((tp[1] = creat(tmp[1],0)) < 0)
tmp[1][9]++;
close(tp[1]);
tmp[0][9] = tmp[1][9];
tp[0] = creat(tmp[0],CREATC);
if(count) return;
itab.hptr = &ipsp;
itab.symt = &issp;
itab.hsiz = PTRI;
itab.ssiz = CHARI;
itab.nsym = 0;
itab.curb = 1;
if((fi = open(ignonl,0)) < 0) {
printf("Cannot open ignore/only file.\n");
dexit();
}
if((read(fi,b,6) == 6) && (b[0] == 0100200)) {
if(read(fi,itab.hptr,b[1]) < b[1]) {
printf("Cannot read ignore/only file.\n");
dexit();
}
if(read(fi,itab.symt,b[2]) < b[2]) {
printf("Cannot read ignor/only file.\n");
dexit();
}
close(fi);
} else {
close(fi);
compile();
}
return;
}
error(a)
{
printf("Error %d\n",a);
dexit();
}
dexit()
{
extern nflush;
/* printf("nflush = %d\n",nflush); /*DEBUG*/
if(tp[0] > 0 && utmp == 0) {
unlink(tmp[0]);
unlink(tmp[1]);
}
exit();
}
callsys(f,v)
char f[],*v[];
{
int t,status,i;
if((t = fork()) == 0) {
for(i = 1; i <= 12; i++) signal(i,0);
execv(f,v);
printf("Can't find %s\n",f);
exit(1);
} else {
if(t == -1) {
printf("Try again\n");
return(1);
}
}
while(t != wait(&status));
/* printf("Status = %o, %s\n",status,f); /*DEBUG*/
if((t = (status & 0377)) != 0) {
if(t != 2) {
printf("Fatal error in %s\n",f);
printf("t = %d\n",t);
}
dexit();
}
return((status>>8) & 0377);
}
flags(argv)
char *argv[];
{
int j,xx;
char *ap;
j = 1;
ap = argv[1];
while(*++ap != '\0') {
switch(*ap) {
default:
printf("Unrecognized flag: %c\n",*ap);
dexit();
case 'c':
count = 1;
continue;
case 'i': /* Ignore file */
if(!xx) {
xx = 1;
only = 0;
ignonl = argv[++j];
}
continue;
case 'o': /*only file*/
if(!xx) {
xx = 1;
only = 1;
ignonl = argv[++j];
}
continue;
case 'p':
page = 1;
continue;
case 't':
utmp = argv[++j];
tmp[0] = argv[j];
continue;
case 'u': /* Unique symbols only */
usw = 1;
continue;
case 'w': /* Word list only */
word = 1;
continue;
}
}
return(j);
}
compile()
{
char buf[40],*b;
int i,v;
fopen(ignonl,ibuf1);
b = buf - 1;
while((*++b = getc(ibuf1)) != -1) {
if(*b == '\n') {
*b = '\0';
search(buf,b - buf,&itab,1);
b = buf - 1;
} else {
if(*b == '\t') {
v = 0;
while((i = getc(ibuf1)) != -1) {
if(i == '\n') break;
v = v*10 + (i - '0');
}
search(buf,b - buf,&itab,v);
b = buf - 1;
} else {
if((b - buf) > 39) {
printf("Ignore/only symbol too long.\n");
dexit();
}
}
}
}
close(ibuf1);
return;
}
source/cref/index/ind1.c
+259
View File
@@ -0,0 +1,259 @@
#
# include "econs.h"
# include "ecmn.h"
# define SKIP 0
# define COLLECT 1
# define SKIP2 2
char mone -1;
int tlno 1;
coll()
{
cs = COLLECT;
temp[t1].beg = &line[l];
return;
}
save()
{
extern only;
char *pt1,*pt2,cbuf[30];
int a,tt,val;
cs = SKIP;
line[l] = '\0';
temp[t1].ct = &line[l] - temp[t1].beg;
if(!count)
if(temp[t1].ct == 1) goto no;
pt1 = temp[t1].beg-1;
pt2 = cbuf-1;
while(*++pt2 = *++pt1)
if(*pt2 >= 'A' && *pt2 <= 'Z')
*pt2 =| 040;
if(count)
goto yes;
val = search(cbuf,temp[t1].ct,&itab,0);
if(!val == !only) goto yes;
no:
line[l] = c;
return(0);
yes:
if(count == 0) {
tt = t1;
while(tt)
if(comp(temp[t1].beg,temp[--tt].beg)) goto no;
}
temp[t1++].term = c;
return(1);
}
out()
{
auto i,ct,t2;
char *b,*e;
if(cs == COLLECT) save();
ct = t1;
while(ct--)
temp[ct].beg[temp[ct].ct] = temp[ct].term;
t2 = t1 - 1;
while(t1--) {
/*printf("t1 = %d beg = %o ct = %d\n",t1,temp[t1].beg,temp[t1].ct); /* DEBUG */
if((ct = temp[t1].ct) >= 15) {
ct = 15;
}
put(temp[t1].beg,ct);
if(count) {
put("\n", 1);
continue;
}
put("\t",1);
if(!page) {
put(curf,curfl);
conf(lno,4,curs);
put(curs,4);
} else {
conf(pn,4,curs);
put(curs,4);
}
if(word == 0) {
put("\t",1);
if(t1 >= 1)
b = temp[t1-1].beg;
else
b = line;
if(t2 > t1)
e = temp[t1+1].beg + temp[t1+1].ct;
else
e = &line[l];
/*printf("e = %o b = %o\n",e,b); /*DEBUG*/
put(b,e-b);
}
put("\n",1);
}
t1 = 0;
l = -1;
lno =+ tlno;
tlno = 1;
cs = SKIP;
return;
}
search(symbol,length,params,install)
char *symbol;
int length;
struct htab *params;
int install;
{
char *sp,*p;
static int *hptr,hsiz,nsym;
static char *ssiz;
static int curb;
static char *symt;
auto h,i,j,k;
if(hptr != params->hptr) {
hptr = params->hptr;
hsiz = params->hsiz;
symt = params->symt;
ssiz = params->ssiz;
curb = params->curb;
nsym = params->nsym;
}
symbol[length] = '\0';
/*printf("ssiz = %d; nsym = %d; %s\n", ssiz, nsym, symbol);/*DEBUG*/
sp = symbol;
i = length;
h = 1;
while(i--)
h =* *sp++;
if(h == 0100000) {
h = 1;
} else {
h = h<0?(-h)%hsiz:h%hsiz;
}
if(h == 0) h++;
/* printf("%s %d\n",symbol,h); /*DEBUG*/
while((p = &symt[hptr[h]]) > symt) {
j = length + 2;
sp = symbol;
while(--j) {
if(*p++ != *sp++) goto no;
}
return(*p);
no:
h = (h + h)%hsiz;
}
if(install) {
if(++nsym >= hsiz) {
printf("Too many symbols in ignore/only file.\n");
dexit();
}
hptr[h] = curb;
length++;
if((curb + length) >= ssiz) {
printf("i/o file too big; ssiz = %d\n", ssiz);
dexit();
}
while(length--)
symt[curb++] = *symbol++;
symt[curb++] = install;
params->curb = curb;
params->nsym = nsym;
}
return(0);
}
conf(n,width,buf)
char *buf;
{
auto i,a;
i = width;
while(i--) buf[i] = ' ';
buf[(a = n/10)?conf(a,--width,buf):--width] = n%10 + '0';
return(++width);
}
comp(a,b)
char *a;
char *b;
{
a--;
b--;
while(*++a == *++b)
if(*a == '\0') return(1);
return(0);
}
hyphen()
{
/* printf("hyphen\n"); /*DEBUG*/
if(gch[fl] == 0)
flag[++fl] = &hyp1;
return(1);
}
hyp1()
{
/* printf("hyp1 c = %o\n",c); /*DEBUG*/
if(c != '\n') {
fl--;
return(0);
} else {
l =- 2;
flag[fl] = &hyp2;
hsw = 1;
return(1);
}
}
hyp2()
{
/* printf("hyp2 c = %o l = %d\n",c,l); /*DEBUG*/
if(hsw && (tab[2].cl[c] == 0)) {
l--;
if(c == 3) pno();
if(c == '\n') tlno++;
return(1);
}
hsw = 0;
if(tab[cs].cl[c]) {
line[l] = '\n';
out();
fl--;
return(0);
}
return(1);
}
pno()
{
if(flag[fl] != &pno) {
flag[++fl] = &pno;
pn = 0;
return(1);
}
if(c == '\n') {
fl--;
out();
return(1);
}
pn = pn*10 + c - '0';
return(1);
}
source/cref/index/ind2.c
+49
View File
@@ -0,0 +1,49 @@
int optr;
char obuf[512];
int nflush;
put(string,n)
char *string;
{
extern utmp;
int i;
char *o;
/*printf("%d %c %d\n",fil,*string,n);/*DEBUG*/
string--;
if((i = optr + n - 512) >= 0) {
n =- i;
o = &obuf[optr] -1;
while(--n >= 0)
*++o = *++string;
optr = 512;
flsh(1);
n = i;
}
o = &obuf[optr] - 1;
optr =+ n;
while(--n >= 0) {
*++o = *++string;
}
return(0);
}
flsh(fil)
{
extern tp[],utmp;
if(optr <= 0) return(optr);
nflush++;
if(write(tp[0],obuf,optr) != optr)
return(-1);
optr = 0;
return(0);
}
source/cref/mcons.h
+30
View File
@@ -0,0 +1,30 @@
# define NUMA 14
# define NUMC 128
# define NUMS 3
# define SIZA 8
# define SIZC 2
# define SIZS 8
# define PTRI 509
# define CHARI 4000
# define PTRX 509
# define CHARX 4000
# define CONT 1
# define COLL 2
# define SAVE 3
# define OUT 4
# define ASYM 5
# define ASW 6
# define CSYM 7
# define CSW 8
# define INCL 9
# define DECL 10
# define SK2 11
# define SK 12
# define TABS 13
# define SEMI 14
# define SHARP 15
# define SKIP 0
# define COLLECT 1
# define SKIP2 2
#define CREATC 0644
source/cref/run
+30
View File
@@ -0,0 +1,30 @@
chdir tab
cc mtab.c
a.out atable atab
a.out ctable ctab
a.out etable etab
cmp atab /usr/lib/atab
cp atab /usr/lib/atab
cmp ctab /usr/lib/ctab
cp ctab /usr/lib/ctab
cmp etab /usr/lib/etab
cp etab /usr/lib/etab
rm a.out atab ctab etab
chdir ../src
cc -s -O upost.c
cmp a.out /usr/bin/upost
cp a.out /usr/bin/upost
cc -s -O crpost.c
cmp a.out /usr/bin/crpost
cp a.out /usr/bin/crpost
cc -s -O dr.c acts.c put.c
cmp a.out /usr/bin/cref
cp a.out /usr/bin/cref
rm a.out *.o
chdir ../index
cc -s -O ind?.c
cmp a.out /usr/bin/index
cp a.out /usr/bin/index
rm a.out *.o
source/cref/src/acts.c
+484
View File
@@ -0,0 +1,484 @@
#
# include "../mcons.h"
# include "../ccmn.h"
# define SKIP 0
# define COLLECT 1
# define SKIP2 2
int cross 1;
int order 1;
char mone -1;
coll()
{
cs = COLLECT;
temp[t1].beg = &line[l];
return;
}
save()
{
extern wspace();
line[l] = '\0';
temp[t1].ct = &line[l] - temp[t1].beg;
temp[t1].term = c;
if((c == ' ' || c == '\t') && cflag) {
gch[++fl] = mone;
flag[fl] = &wspace;
} else {
sav1();
}
return;
}
sav1()
{
extern only;
struct tempent *ptr;
int a,tt,val;
if(cflag && c == '(' && level == 0) csym();
cs = SKIP;
ptr = &temp[t1];
val = search(ptr->beg,ptr->ct,&itab,0);
if(xsw) {
switch(val) {
case 0:
if((!level&&!hlevel)||(c == '(')||xtrn
|| ssw) {
search(ptr->beg,ptr->ct,&xtab,1);
goto yes;
} else {
if(search(ptr->beg,ptr->ct,&xtab,0))
goto yes;
}
goto no;
case 1:
goto no;
case 2:
xtrn = 1;
goto no;
case 3:
if(hlevel) type = 1;
if(!level&&!hlevel) ssw = 1;
goto no;
case 4:
if(hlevel) type = 1;
goto no;
}
}
if(hlevel && (val == 4 || val == 3)) type = 1;
if(!val == !only) goto yes;
no:
*(ptr->beg + ptr->ct) = ptr->term;
return(0);
yes:
tt = t1;
while(tt)
if(comp(ptr->beg,temp[--tt].beg)) goto no;
t1++;
return(1);
}
out()
{
auto i,ct;
if(cs == COLLECT) save();
ct = t1;
while(ct--)
temp[ct].beg[temp[ct].ct] = temp[ct].term;
while(t1--) {
/*printf("t1 = %d beg = %d ct = %d\n",t1,temp[t1].beg,temp[t1].ct); /* DEBUG */
switch(order) {
case 1:
if(utmp)
i = 0;
else
i = dfile(temp[t1].beg);
if((ct = temp[t1].ct) >= 8) {
ct = 8;
*curf = -1;
} else {
*curf = '\t';
}
put(i,temp[t1].beg,ct);
put(i,curf,curfl);
if(cross) put(i,curs,cursl);
conf(lno,4,lbuf);
put(i,lbuf,5);
break;
case 2:
i = dfile(curf+1);
put(i,curf+1,curfl-1);
if(cross) put(i,curs,cursl);
else {
conf(lno,4,lbuf);
put(i,lbuf,5);
}
if((ct = temp[t1].ct) >= 8) {
put(i,temp[t1].beg,8);
put(i,&mone,1);
} else {
put(i,temp[t1].beg,ct);
put(i,"\t",1);
}
if(cross) {
conf(lno,4,lbuf);
put(i,lbuf,5);
}
break;
case 3:
i = dfile(curs);
put(i,curs,cursl);
if((ct = temp[t1].ct) >= 8) {
put(i,temp[t1].beg,8);
*curf = -1;
} else {
put(i,temp[t1].beg,ct);
*curf = '\t';
}
put(i,curf,curfl);
conf(lno,4,lbuf);
put(i,lbuf,5);
}
put(i,line,l + 1);
}
t1 = 0;
l = -1;
lno++;
cs = SKIP;
return;
}
asym()
{
int i;
char *p;
if(cs == COLLECT) {
if(cross) {
p = temp[t1].beg;
cursl = &line[l] - p;
cursl = cursl>8?8:cursl;
i = -1;
while(++i < cursl)
curs[i] = *p++;
if(cursl < 8)
curs[cursl++] = '\t';
else
curs[cursl++] = -1;
}
save();
}
cs = SKIP;
}
asw()
{
switch(gch[fl]) {
case 0:
if(cs == COLLECT) save();
cs = SKIP;
flag[++fl] = &asw;
gch[fl] = c;
return(1);
case '\'':
if(c == '\\') {
gch[fl] = c;
return(1);
}
break;
case '"':
gch[fl] = '\'';
if(c == '\\') {
flag[++fl] = &asw;
gch[fl] = c;
return(1);
}
return(1);
case '<':
if(c == '\n') out();
if(c == '\\') {
flag[++fl] = &asw;
gch[fl] = c;
return(1);
}
if(c != '>') return(1);
break;
case '/':
if(c != '\n') return(1);
case '\\':
if(c == '\n') out();
}
fl--;
return(1);
}
csw()
{
if(cs == COLLECT) save();
switch(gch[fl]) {
case 0:
if(c == '*')
if(line[l - 1] != '/')
return(1);
gch[++fl] = c;
flag[fl] = &csw;
return(1);
case '*':
if(c == '\n') out();
if(c == '/' && line[l - 1] == '*')
break;
return(1);
case '\'':
case '"':
if(c == gch[fl])
break;
if(c == '\\') {
gch[++fl] = c;
flag[fl] = &csw;
}
return(1);
case '\\':
break;
}
fl--;
return(1);
}
incl()
{
/* printf("incl: l = %d hl = %d dl = %d\n",level,hlevel,dlevel);/*DEBUG*/
if(cs == COLLECT) save();
if(hlevel) {
hlevel = 0;
level++;
} else {
dlevel++;
}
cs = SKIP;
}
decl()
{
/* printf("decl: l = %d hl = %d dl = %d\n",level,hlevel,dlevel);/*DEBUG*/
if(cs == COLLECT) save();
cs = SKIP;
if(dlevel) {
dlevel--;
return;
}
if(--level > 0) return;
curs[0] = '_';
curs[1] = '\t';
cursl = 2;
level = 0;
return;
}
csym()
{
int i;
char *p;
/* printf("csym: l = %d hl = %d dl = %d\n",level,hlevel,dlevel);/*DEBUG*/
p = temp[t1].beg;
if(cs == COLLECT && level == 0) {
if(cross) {
cursl = temp[t1].ct;
cursl = cursl>8?8:cursl;
i = -1;
while(++i < cursl)
curs[i] = *p++;
if(cursl < 8)
curs[cursl++] = '\t';
else
curs[cursl++] = -1;
}
hlevel = 1;
}
cs = SKIP;
}
dfile(a)
char *a;
{
if(*a < 'c') return(0);
if(*a < 'h') return(1);
if(*a < 'r') return(2);
return(3);
}
sk2()
{
cs = SKIP2;
}
sk()
{
cs = SKIP;
}
tabs()
{
if(l == 0) l = -1;
}
search(symbol,length,params,install)
char *symbol;
int length;
struct htab *params;
int install;
{
char *sp,*p;
static int curb,*hptr,hsiz,nsym,ssiz;
static char *symt;
auto h,i,j,k;
if(hptr != params->hptr) {
hptr = params->hptr;
hsiz = params->hsiz;
symt = params->symt;
ssiz = params->ssiz;
curb = params->curb;
nsym = params->nsym;
}
symbol[length] = '\0';
sp = symbol;
i = length;
h = 1;
while(i--)
h =* *sp++;
if(h == 0100000) {
h = 1;
} else {
h = h<0?(-h)%hsiz:h%hsiz;
}
if(h == 0) h++;
/* printf("%s %d\n",symbol,h); /*DEBUG*/
while((p = &symt[hptr[h]]) > symt) {
j = length + 2;
sp = symbol;
while(--j) {
if(*p++ != *sp++) goto no;
}
return(*p);
no:
h = (h + h)%hsiz;
}
if(install) {
if(++nsym >= hsiz) {
printf("Too many symbols.\n");
dexit();
}
hptr[h] = curb;
length++;
if((curb + length) >= ssiz) {
printf("Too many characters in symbols.\n");
dexit();
}
while(length--)
symt[curb++] = *symbol++;
symt[curb++] = install;
params->curb = curb;
params->nsym = nsym;
}
return(0);
}
conf(n,width,buf)
char *buf;
{
auto i,a;
i = width;
while(i--) buf[i] = ' ';
buf[(a = n/10)?conf(a,--width,buf):--width] = n%10 + '0';
return(++width);
}
comp(a,b)
char *a;
char *b;
{
a--;
b--;
while(*++a == *++b)
if(*a == '\0') return(1);
return(0);
}
semi()
{
if(cs == COLLECT) save();
if(only) return;
xtrn = 0;
if(!level) {
ssw = 0;
if(!type) {
hlevel = 0;
curs[0] = '_';
curs[1] = '\t';
cursl = 2;
}
type = 0;
}
cs = SKIP;
}
wspace()
{
if(c == ' ' || c == '\t')
return(1);
sav1();
fl--;
return(0);
}
source/cref/src/crpost.c
+265
View File
@@ -0,0 +1,265 @@
/*int mbuf[1024]; /*INSTR*/
int ig 100;
int esw;
int initf 1;
char ssp[270];
char *sym[9] {ssp,
ssp + 30,
ssp + 60,
ssp + 90,
ssp + 120,
ssp + 150,
ssp + 180,
ssp + 210,
ssp + 240,
ssp + 270
};
main(argc, argv)
char *argv[];
{
auto f,fct,file,i;
if(argc < 2) {
printf("Usage: crpost [-d] file1 file2 ...\n");
exit();
}
if(*argv[1] == '-') {
if(argv[1][1] == 'E') {
fct = 3;
esw = 1;
goto on;
}
fct = argv[1][1] - '0';
if((fct < 1) || (fct > 9)) {
printf("-d: 0 < d < 10\n");
exit();
}
if(argv[1][2] == 'x') {
ig = fct-1;
}
on:
argv++;
argc--;
} else {
fct = 3;
}
f = 0;
while(++f < argc) {
file = open(argv[f], 0);
edf(file, fct);
close(file);
}
flsh(0);
exit();
}
int lno 1;
edf(file, fct)
{
auto i,j,l;
extern lno,etext;
char brk,*buf,bufsp[150],line[150];
char extern *sym[];
/* monitor(&main,&etext,&mbuf,1024); /*INSTR*/
for(i = 0; i < fct; i++)
*sym[i] = 0200;
fields:
l = -1;
buf = &bufsp;
for(i = 0; i < fct; ++i) {
buf--;
swt:
switch(*++buf = get(file)) {
default:
if(esw && *buf >= 'A' && *buf <= 'Z'
&& i == 0)
*buf =| 040;
goto swt;
case -1:
*buf = ' ';
case '\t':
if(i == ig) continue;
brk = *buf;
*buf = '\0';
buf = &bufsp;
if(comp(buf, sym[i])) {
if(esw && i == 0) {
line[0] = line[1] = '\t';
l = 1;
goto rest;
}
line[++l] = '\t';
continue;
} else {
copy(buf, sym[i]);
l =+ copy(buf, &line[++l]);
line[--l] = brk;
if(l < 8 && esw && i == 0)
line[++l] = '\t';
j = i;
while(++j < fct)
*sym[j] = 0200;
continue;
}
case '\n':
lno++;
brk = *buf;
*buf = '\0';
buf = &bufsp;
if(comp(buf, sym[i])) {
goto fields;
} else {
copy(buf, sym[i]);
l =+ copy(buf, &line[++l]);
line[--l] = '\n';
j = i;
while(++j < fct)
*sym[j] = 0;
goto out;
}
case '\0':
goto fexit;
}
}
rest:
while((line[++l] = get(file)) != '\n')
if(line[l] == '\0') goto fexit;
lno++;
out:
if(*line != '\t') {
put(0,"\n",1);
lno++;
}
put(0,line,++l);
goto fields;
fexit:
/* monitor(0); /*INSTR*/
return(0);
}
copy(a, b)
char *a,*b;
{
char *c;
b--;
c = --a;
while(*++b = *++a);
return(a - c);
}
comp(a, b)
char *a, *b;
{
/* printf("comp: %s %s\n",a,b); /*DEBUG*/
a--;
b--;
while(*++a == *++b) {
if(*a == '\0') return(1);
}
return(0);
}
char buf[512];
int nread 1;
get(ifile) int ifile;
{
char static *ibuf;
if(--nread){
return(*ibuf++);
}
if(nread = read(ifile,buf,512)){
if(nread < 0)goto err;
ibuf = buf;
return(*ibuf++);
}
nread = 1;
return(0);
err:
nread = 1;
printf("read error\n");
return(0);
}
int tp[1] 1;
int optr[4];
char bsp[512];
char *obuf[1] bsp;
int nflush;
put(fil,string,n)
char *string;
{
int i;
char *o;
/*printf("%d %c %d\n",fil,*string,n);/*DEBUG*/
string--;
if((i = optr[fil] + n - 512) >= 0) {
n =- i;
o = &obuf[fil][optr[fil]] -1;
while(--n >= 0)
*++o = *++string;
optr[fil] = 512;
flsh(fil);
n = i;
}
o = &obuf[fil][optr[fil]] - 1;
optr[fil] =+ n;
while(--n >= 0) {
*++o = *++string;
}
return(0);
}
flsh(fil)
{
extern tp[];
if(optr[fil] <= 0) return(optr[fil]);
nflush++;
if(write(tp[fil],obuf[fil],optr[fil]) != optr[fil])
return(-1);
optr[fil] = 0;
return(0);
}
source/cref/src/dr.c
+441
View File
@@ -0,0 +1,441 @@
#
# include "../mcons.h"
# include "../ccmn.h"
/*int mbuf[1024]; /*INSTR*/
/*int tbuf[36]; /*INSTR*/
int (*acts[])() {0,
&coll,
&save,
&out,
&asym,
&asw,
&csym,
&csw,
&incl,
&decl,
&sk2,
&sk,
&tabs,
&semi
};
char *tmp[5] {"/tmp/crt0a",
"/tmp/crt1a",
"/tmp/crt2a",
"/tmp/crt3a",
"/tmp/crt4a"
};
char *ignonl "/usr/lib/aign";
char *gtab "/usr/lib/atab";
main(argc,argv)
char *argv[];
{
auto i,j,tm1,tm2,tm3;
char *fn,*av[8];
/* extern etext; /*INSTR*/
/* monitor(&main,&etext,&mbuf,1024); /*INSTR*/
if(argc < 2) {
printf("Usage: cref [-aceilosux] file1 ...\n");
exit();
}
lbuf[4] = '\t';
if(*argv[1] == '-') {
j = flags(argv);
argv =+ j;
argc =- j;
}
init();
i = 0;
while(++i < argc) {
curs[0] = '_';
curs[1] = '\t';
curs[4] = '\t';
cursl = 2;
if(fopen(argv[i],ibuf1) < 0) {
printf("Can't open %s\n",argv[i]);
dexit();
}
ibuf = ibuf1;
curf[0] = '\t';
curfl = 1;
while((curf[curfl] = *argv[i]++) != 0 && curfl <= 8)
if(curf[curfl++] == '/') curfl = 1;
curf[curfl++] = '\t';
if(curfl == 10) curf[9] = -1;
/* printf("%s %d\n",curf,curfl);/*DEBUG*/
lno = 1;
driver();
close(file);
}
for(j = 0; j < 4;) {
flsh(j,0);
close(tp[j++]);
}
/* monitor(0); /*INSTR*/
/* dexit(); /*INSTR*/
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[15]/6; /*INSTR*/
/* tm2 = tbuf[19]/6; /*INSTR*/
/* tm3 = tbuf[23]/6; /*INSTR*/
/* printf("Prep: %d %d %d\n",tm1,tm2,tm3); /*INSTR*/
if(utmp) exit();
fn = "/bin/sort";
av[0] = "sort";
av[1] = "-a";
av[3] = "-o";
av[5] = 0;
for(i = 0; i < 4; i++) {
av[4] = av[2] = tmp[i];
callsys(fn,av);
if(utmp) break;
}
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[27]/6; /*INSTR*/
/* tm2 = tbuf[31]/6; /*INSTR*/
/* tm3 = tbuf[35]/6; /*INSTR*/
/* printf("Sort: %d %d %d\n",tm1,tm2,tm3); /*INSTR*/
if(usw) {
fn = "/usr/bin/upost";
av[0] = "upost";
i = 0;
} else {
fn = "/usr/bin/crpost";
av[0] = "crpost";
av[1] = cross? "-4x": "-3";
i = 1;
}
j = -1;
while(++j < 4) {
av[++i] = tmp[j];
if(utmp) break;
}
av[++i] = 0;
callsys(fn,av);
/* times(tbuf); /*INSTR*/
/* tm1 = tbuf[27]/6 - tm1; /*INSTR*/
/* tm2 = tbuf[31]/6 - tm2; /*INSTR*/
/* tm3 = tbuf[35]/6 - tm3; /*INSTR*/
/* printf("Post: %d %d %d\n",tm1,tm2,tm3); /*INSTR*/
dexit();
}
driver()
{
auto p;
top:
l = -1;
while((c = line[++l] = getc(ibuf)) != -1) {
if(l >= 131) {
printf("Line too long: %d %s\n",lno,curf);
dexit();
}
if(c & 0200) {
printf("Illegal character: %o line %d\n",c,lno);
dexit();
}
if(fl) {
if((*flag[fl])())
continue;
}
/*printf("cs = %d cc = %c ca = %d\n",cs,c,tab[cs].cl[c]); /*DEBUG*/
if(p = tab[cs].cl[c])
(*acts[p])();
continue;
}
if(ibuf == ibuf1) return;
ibuf = ibuf1;
goto top;
}
init()
{
int b[3];
auto fi,i;
extern coll(),save(),out(),asym(),asw(),csym(),csw();
extern incl(),decl(),sk(),sk2();
extern dexit();
ibuf1 = &ib1;
ibuf2 = &ib2;
xtab.hptr = &xpsp;
xtab.symt = &xssp;
xtab.hsiz = PTRX;
xtab.ssiz = CHARX;
xtab.nsym = 0;
xtab.curb = 1;
itab.hptr = &ipsp;
itab.symt = &issp;
itab.hsiz = PTRI;
itab.ssiz = CHARI;
itab.nsym = 0;
itab.curb = 1;
if((fi = open(gtab,0)) < 0) {
printf("Cannot open grammar table; see lem\n");
dexit();
}
i = -1;
while(++i < NUMS)
if(read(fi,tab[i].cl,256) < 256) {
printf("Bad grammar table.\n");
dexit();
}
close(fi);
if((fi = open(ignonl,0)) < 0) {
printf("Cannot open ignore/only file: %s\n",ignonl);
dexit();
}
if((read(fi,b,6) == 6) && (b[0] == 0100200)) {
if(read(fi,itab.hptr,b[1]) < b[1]) {
printf("Cannot read ignore/only file: %s\n",ignonl);
dexit();
}
if(read(fi,itab.symt,b[2]) < b[2]) {
printf("Cannot read ignore/only file: %s\n",ignonl);
dexit();
}
close(fi);
} else {
close(fi);
compile();
}
if((signal(1,1) & 1) == 0) signal(1,&dexit);
if((signal(2,1) & 1) == 0) signal(2,&dexit);
if((signal(3,1) & 1) == 0) signal(3,&dexit);
/* signal(4,&dexit);
signal(5,&dexit);
signal(6,&dexit);
signal(7,&dexit);
signal(8,&dexit);
signal(10,&dexit);
signal(11,&dexit);
signal(12,&dexit);
*/
if(utmp == 0) {
while((tp[4] = creat(tmp[4],0)) < 0)
tmp[4][9]++;
close(tp[4]);
tmp[0][9] = tmp[4][9];
tmp[1][9] = tmp[4][9];
tmp[2][9] = tmp[4][9];
tmp[3][9] = tmp[4][9];
tp[0] = creat(tmp[0],CREATC);
tp[1] = creat(tmp[1],CREATC);
tp[2] = creat(tmp[2],CREATC);
tp[3] = creat(tmp[3],CREATC);
} else {
if((tp[0] = creat(utmp,CREATC)) < 0) {
printf("Can't create user's temp file.\n");
exit();
}
}
return;
}
error(a)
{
printf("Error %d\n",a);
dexit();
}
dexit()
{
extern nflush;
/* printf("nflush = %d\n",nflush); /*DEBUG*/
if(tp[0] > 0 && utmp == 0) {
unlink(tmp[0]);
unlink(tmp[1]);
unlink(tmp[2]);
unlink(tmp[3]);
unlink(tmp[4]);
}
exit();
}
callsys(f,v)
char f[],*v[];
{
int t,status,i;
if((t = fork()) == 0) {
execv(f,v);
printf("Can't find %s\n",f);
exit(1);
} else {
if(t == -1) {
printf("Try again\n");
return(1);
}
}
while(t != wait(&status));
/* printf("Status = %o, %s\n",status,f); /*DEBUG*/
if((t = (status & 0377)) != 0) {
if(t != 2) {
printf("Fatal error in %s\n",f);
printf("t = %d\n",t);
}
dexit();
}
return((status>>8) & 0377);
}
flags(argv)
char *argv[];
{
int j,xx;
char *ap;
j = 1;
ap = argv[1];
while(*++ap != '\0') {
switch(*ap) {
default:
printf("Unrecognized flag: %c\n",*ap);
dexit();
case '1': /* Symbol first */
order = 1;
continue;
case '2': /* Current file first */
order = 2;
continue;
case '3': /* Current symbol first */
order = 3;
continue;
case 'a': /* Assembler */
cflag = 0;
continue;
case 'c': /* C */
gtab = "/usr/lib/ctab";
if(!xx)
ignonl = "/usr/lib/cign";
cflag = 1;
continue;
case 'e': /* English */
gtab = "/usr/lib/etab";
if(!xx)
ignonl = "/usr/lib/eign";
continue;
case 'i': /* Ignore file */
if(!xx) {
xx = 1;
only = 0;
ignonl = argv[++j];
}
continue;
case 'l': /* Line numbers in col. 3 */
cross = 0;
continue;
case 'o': /* Only file */
if(!xx) {
xx = 1;
only = 1;
ignonl = argv[++j];
}
continue;
case 's': /* Symbols in col. 3 */
cross = 1;
continue;
case 't':
utmp = argv[++j];
tmp[0] = argv[j];
continue;
case 'u': /* Unique symbols only */
usw = 1;
continue;
case 'x': /* C externals */
xsw = 1;
gtab = "/usr/lib/ctab";
if(!xx)
ignonl = "/usr/lib/cign";
cflag = 1;
continue;
}
}
return(j);
}
compile()
{
char buf[40],*b;
int i,v;
fopen(ignonl,ibuf1);
b = buf - 1;
while((*++b = getc(ibuf1)) != -1) {
if(*b == '\n') {
*b = '\0';
search(buf,b - buf,&itab,1);
b = buf - 1;
} else {
if(*b == '\t') {
v = 0;
while((i = getc(ibuf1)) != -1) {
if(i == '\n') break;
v = v*10 + (i - '0');
}
search(buf,b - buf,&itab,v);
b = buf - 1;
} else {
if((b - buf) > 39) {
printf("Ignore/only symbol too long");
dexit();
}
}
}
}
close(ibuf1);
return;
}
source/cref/src/put.c
+59
View File
@@ -0,0 +1,59 @@
int bct[4];
int optr[4];
char bsp[2048];
char *obuf[4] {bsp,
bsp + 512,
bsp + 1024,
bsp + 1536
};
int nflush;
put(fil,string,n)
char *string;
{
extern utmp;
int i;
char *o;
/*printf("%d %c %d\n",fil,*string,n);/*DEBUG*/
string--;
if((i = optr[fil] + n - 512) >= 0) {
n =- i;
o = &obuf[fil][optr[fil]] -1;
while(--n >= 0)
*++o = *++string;
optr[fil] = 512;
flsh(fil);
n = i;
}
o = &obuf[fil][optr[fil]] - 1;
optr[fil] =+ n;
while(--n >= 0) {
*++o = *++string;
}
return(0);
}
flsh(fil)
{
extern tp[],utmp;
if(optr[fil] <= 0) return(optr[fil]);
if(bct[fil]++ >= 128 && utmp == 0) {
printf("Wraparound temp file %d\n",fil);
dexit();
}
nflush++;
if(write(tp[fil],obuf[fil],optr[fil]) != optr[fil])
return(-1);
optr[fil] = 0;
return(0);
}
source/cref/src/upost.c
+214
View File
@@ -0,0 +1,214 @@
/*int mbuf[1024]; /*INSTR*/
int psw 1;
int initf 1;
main(argc, argv)
char *argv[];
{
auto f,fct,file;
if(argc < 2) {
printf("Usage: cpost [-d] file1 file2 ...\n");
exit();
}
if(*argv[1] == '-') {
fct = argv[1][1] - '0';
if((fct < 1) || (fct > 9)) {
printf("-d: 0 < d < 10\n");
exit();
}
argv++;
argc--;
} else {
fct = 1;
}
f = 0;
while(++f < argc) {
file = open(argv[f], 0);
edl(file, fct);
close(file);
psw = 0;
}
flsh(0);
exit();
}
int lno 1;
edl(file)
{
auto t,l;
char static buf[20],fld[20],line[200];
char c;
field:
t = -1;
while(((buf[++t] = get(file)) != '\t') && (buf[t] != -1))
if(buf[t] == '\0') goto done;
if((c = buf[t]) == -1) c = ' ';
buf[t] = '\0';
if(comp(buf,fld)) {
lno++;
goto junk;
} else {
if(lno == 0) {
put(0,line,++l);
}
l = copy(buf,line);
copy(buf,fld);
line[--l] = c;
lno = 0;
goto fill;
}
fill:
while((line[++l] = get(file)) != '\n') {
if(line[l] == -1) line[l] = ' ';
if(line[l] == '\0') goto done;
}
goto field;
junk:
while((*line = get(file)) != '\n')
if(*line == '\0') goto done;
goto field;
done:
if(lno == 0)
put(0,line,++l);
lno = 1;
return(0);
}
gfld(file, buf)
char *buf;
{
char c;
buf--;
while(*++buf = get(file)) {
if((*buf == '\t') || (*buf == '\n')) {
c = *buf;
*buf = '\0';
return(c);
} else {
continue;
}
}
return('\0');
}
copy(a, b)
char *a,*b;
{
char *c;
b--;
c = --a;
while(*++b = *++a);
return(a - c);
}
comp(a, b)
char *a, *b;
{
/* printf("comp: %s %s\n",a,b); /*DEBUG*/
a--;
b--;
while(*++a == *++b) {
if(*a == '\0') return(1);
}
return(0);
}
char buf[512];
int nread 1;
get(ifile) int ifile;
{
char static *ibuf;
if(--nread){
return(*ibuf++);
}
if(nread = read(ifile,buf,512)){
if(nread < 0)goto err;
ibuf = buf;
return(*ibuf++);
}
nread = 1;
return(0);
err:
nread = 1;
printf("read error\n");
return(0);
}
int tp[1] 1;
int optr[4];
char bsp[512];
char *obuf[1] bsp;
int nflush;
put(fil,string,n)
char *string;
{
int i;
char *o;
/*printf("%d %c %d\n",fil,*string,n);/*DEBUG*/
string--;
if((i = optr[fil] + n - 512) >= 0) {
n =- i;
o = &obuf[fil][optr[fil]] -1;
while(--n >= 0)
*++o = *++string;
optr[fil] = 512;
flsh(fil);
n = i;
}
o = &obuf[fil][optr[fil]] - 1;
optr[fil] =+ n;
while(--n >= 0) {
*++o = *++string;
}
return(0);
}
flsh(fil)
{
extern tp[];
if(optr[fil] <= 0) return(optr[fil]);
nflush++;
if(write(tp[fil],obuf[fil],optr[fil]) != optr[fil])
return(-1);
optr[fil] = 0;
return(0);
}
source/cref/tab/atable
+214
View File
@@ -0,0 +1,214 @@
skip
collect save
skip2 sk
cont coll save out asym agobl csym cgobl incl decl sk2 sk
collect/'/agobl;
collect/"/agobl;
collect/</agobl;
collect/\//agobl;
collect/\\/agobl;
collect/:/asym;
collect/a/cont;
collect/b/cont;
collect/c/cont;
collect/d/cont;
collect/e/cont;
collect/f/cont;
collect/g/cont;
collect/h/cont;
collect/i/cont;
collect/j/cont;
collect/k/cont;
collect/l/cont;
collect/m/cont;
collect/n/cont;
collect/o/cont;
collect/p/cont;
collect/q/cont;
collect/r/cont;
collect/s/cont;
collect/t/cont;
collect/u/cont;
collect/v/cont;
collect/w/cont;
collect/x/cont;
collect/y/cont;
collect/z/cont;
collect/A/cont;
collect/B/cont;
collect/C/cont;
collect/D/cont;
collect/E/cont;
collect/F/cont;
collect/G/cont;
collect/H/cont;
collect/I/cont;
collect/J/cont;
collect/K/cont;
collect/L/cont;
collect/M/cont;
collect/N/cont;
collect/O/cont;
collect/P/cont;
collect/Q/cont;
collect/R/cont;
collect/S/cont;
collect/T/cont;
collect/U/cont;
collect/V/cont;
collect/W/cont;
collect/X/cont;
collect/Y/cont;
collect/Z/cont;
collect/1/cont;
collect/2/cont;
collect/3/cont;
collect/4/cont;
collect/5/cont;
collect/6/cont;
collect/7/cont;
collect/8/cont;
collect/9/cont;
collect/0/cont;
collect/./cont;
collect/_/cont;
collect/
/out;
skip/'/agobl;
skip/"/agobl;
skip/</agobl;
skip/\//agobl;
skip/\\/agobl;
skip/
/out;
skip/./coll;
skip/_/coll;
skip/a/coll;
skip/b/coll;
skip/c/coll;
skip/d/coll;
skip/e/coll;
skip/f/coll;
skip/g/coll;
skip/h/coll;
skip/i/coll;
skip/j/coll;
skip/k/coll;
skip/l/coll;
skip/m/coll;
skip/n/coll;
skip/o/coll;
skip/p/coll;
skip/q/coll;
skip/r/coll;
skip/s/coll;
skip/t/coll;
skip/u/coll;
skip/v/coll;
skip/w/coll;
skip/x/coll;
skip/y/coll;
skip/z/coll;
skip/A/coll;
skip/B/coll;
skip/C/coll;
skip/D/coll;
skip/E/coll;
skip/F/coll;
skip/G/coll;
skip/H/coll;
skip/I/coll;
skip/J/coll;
skip/K/coll;
skip/L/coll;
skip/M/coll;
skip/N/coll;
skip/O/coll;
skip/P/coll;
skip/Q/coll;
skip/R/coll;
skip/S/coll;
skip/T/coll;
skip/U/coll;
skip/V/coll;
skip/W/coll;
skip/X/coll;
skip/Y/coll;
skip/Z/coll;
skip/0/sk2;
skip/1/sk2;
skip/2/sk2;
skip/3/sk2;
skip/4/sk2;
skip/5/sk2;
skip/6/sk2;
skip/7/sk2;
skip/8/sk2;
skip/9/sk2;
skip2/a/cont;
skip2/b/cont;
skip2/c/cont;
skip2/d/cont;
skip2/e/cont;
skip2/f/cont;
skip2/g/cont;
skip2/h/cont;
skip2/i/cont;
skip2/j/cont;
skip2/k/cont;
skip2/l/cont;
skip2/m/cont;
skip2/n/cont;
skip2/o/cont;
skip2/p/cont;
skip2/q/cont;
skip2/r/cont;
skip2/s/cont;
skip2/t/cont;
skip2/u/cont;
skip2/v/cont;
skip2/w/cont;
skip2/x/cont;
skip2/y/cont;
skip2/z/cont;
skip2/A/cont;
skip2/B/cont;
skip2/C/cont;
skip2/D/cont;
skip2/E/cont;
skip2/F/cont;
skip2/G/cont;
skip2/H/cont;
skip2/I/cont;
skip2/J/cont;
skip2/K/cont;
skip2/L/cont;
skip2/M/cont;
skip2/N/cont;
skip2/O/cont;
skip2/P/cont;
skip2/Q/cont;
skip2/R/cont;
skip2/S/cont;
skip2/T/cont;
skip2/U/cont;
skip2/V/cont;
skip2/W/cont;
skip2/X/cont;
skip2/Y/cont;
skip2/Z/cont;
skip2/0/cont;
skip2/1/cont;
skip2/2/cont;
skip2/3/cont;
skip2/4/cont;
skip2/5/cont;
skip2/6/cont;
skip2/7/cont;
skip2/8/cont;
skip2/9/cont;
skip2/
/out;
skip2/\//agobl;
source/cref/tab/ctable
+217
View File
@@ -0,0 +1,217 @@
skip
collect save
skip2 sk
cont coll save out asym agobl csym cgobl incl decl sk2 sk tab semi
collect/\;/semi;
collect/_/cont;
collect/{/incl;
collect/}/decl;
collect/'/cgobl;
collect/\\/cgobl;
collect/"/cgobl;
collect/a/cont;
collect/b/cont;
collect/c/cont;
collect/d/cont;
collect/e/cont;
collect/f/cont;
collect/g/cont;
collect/h/cont;
collect/i/cont;
collect/j/cont;
collect/k/cont;
collect/l/cont;
collect/m/cont;
collect/n/cont;
collect/o/cont;
collect/p/cont;
collect/q/cont;
collect/r/cont;
collect/s/cont;
collect/t/cont;
collect/u/cont;
collect/v/cont;
collect/w/cont;
collect/x/cont;
collect/y/cont;
collect/z/cont;
collect/A/cont;
collect/B/cont;
collect/C/cont;
collect/D/cont;
collect/E/cont;
collect/F/cont;
collect/G/cont;
collect/H/cont;
collect/I/cont;
collect/J/cont;
collect/K/cont;
collect/L/cont;
collect/M/cont;
collect/N/cont;
collect/O/cont;
collect/P/cont;
collect/Q/cont;
collect/R/cont;
collect/S/cont;
collect/T/cont;
collect/U/cont;
collect/V/cont;
collect/W/cont;
collect/X/cont;
collect/Y/cont;
collect/Z/cont;
collect/1/cont;
collect/2/cont;
collect/3/cont;
collect/4/cont;
collect/5/cont;
collect/6/cont;
collect/7/cont;
collect/8/cont;
collect/9/cont;
collect/0/cont;
collect/
/out;
skip/\;/semi;
skip/_/coll;
skip/ /tab;
skip/{/incl;
skip/}/decl;
skip/*/cgobl;
skip/'/cgobl;
skip/"/cgobl;
skip/\\/cgobl;
skip/
/out;
skip/1/sk2;
skip/2/sk2;
skip/3/sk2;
skip/4/sk2;
skip/5/sk2;
skip/6/sk2;
skip/7/sk2;
skip/8/sk2;
skip/9/sk2;
skip/0/sk2;
skip/a/coll;
skip/b/coll;
skip/c/coll;
skip/d/coll;
skip/e/coll;
skip/f/coll;
skip/g/coll;
skip/h/coll;
skip/i/coll;
skip/j/coll;
skip/k/coll;
skip/l/coll;
skip/m/coll;
skip/n/coll;
skip/o/coll;
skip/p/coll;
skip/q/coll;
skip/r/coll;
skip/s/coll;
skip/t/coll;
skip/u/coll;
skip/v/coll;
skip/w/coll;
skip/x/coll;
skip/y/coll;
skip/z/coll;
skip/A/coll;
skip/B/coll;
skip/C/coll;
skip/D/coll;
skip/E/coll;
skip/F/coll;
skip/G/coll;
skip/H/coll;
skip/I/coll;
skip/J/coll;
skip/K/coll;
skip/L/coll;
skip/M/coll;
skip/N/coll;
skip/O/coll;
skip/P/coll;
skip/Q/coll;
skip/R/coll;
skip/S/coll;
skip/T/coll;
skip/U/coll;
skip/V/coll;
skip/W/coll;
skip/X/coll;
skip/Y/coll;
skip/Z/coll;
skip2/{/incl;
skip2/}/decl;
skip2/a/cont;
skip2/b/cont;
skip2/c/cont;
skip2/d/cont;
skip2/e/cont;
skip2/f/cont;
skip2/g/cont;
skip2/h/cont;
skip2/i/cont;
skip2/j/cont;
skip2/k/cont;
skip2/l/cont;
skip2/m/cont;
skip2/n/cont;
skip2/o/cont;
skip2/p/cont;
skip2/q/cont;
skip2/r/cont;
skip2/s/cont;
skip2/t/cont;
skip2/u/cont;
skip2/v/cont;
skip2/w/cont;
skip2/x/cont;
skip2/y/cont;
skip2/z/cont;
skip2/A/cont;
skip2/B/cont;
skip2/C/cont;
skip2/D/cont;
skip2/E/cont;
skip2/F/cont;
skip2/G/cont;
skip2/H/cont;
skip2/I/cont;
skip2/J/cont;
skip2/K/cont;
skip2/L/cont;
skip2/M/cont;
skip2/N/cont;
skip2/O/cont;
skip2/P/cont;
skip2/Q/cont;
skip2/R/cont;
skip2/S/cont;
skip2/T/cont;
skip2/U/cont;
skip2/V/cont;
skip2/W/cont;
skip2/X/cont;
skip2/Y/cont;
skip2/Z/cont;
skip2/1/cont;
skip2/2/cont;
skip2/3/cont;
skip2/4/cont;
skip2/5/cont;
skip2/6/cont;
skip2/7/cont;
skip2/8/cont;
skip2/9/cont;
skip2/0/cont;
skip2/./cont;
skip2/
/out;
source/cref/tab/etable
+169
View File
@@ -0,0 +1,169 @@
skip
collect save
skip2
cont coll save out egobl hyphen pno
skip//pno;
skip/
/out;
skip/a/coll;
skip/b/coll;
skip/c/coll;
skip/d/coll;
skip/e/coll;
skip/f/coll;
skip/g/coll;
skip/h/coll;
skip/i/coll;
skip/j/coll;
skip/k/coll;
skip/l/coll;
skip/m/coll;
skip/n/coll;
skip/o/coll;
skip/p/coll;
skip/q/coll;
skip/r/coll;
skip/s/coll;
skip/t/coll;
skip/u/coll;
skip/v/coll;
skip/w/coll;
skip/x/coll;
skip/y/coll;
skip/z/coll;
skip/A/coll;
skip/B/coll;
skip/C/coll;
skip/D/coll;
skip/E/coll;
skip/F/coll;
skip/G/coll;
skip/H/coll;
skip/I/coll;
skip/J/coll;
skip/K/coll;
skip/L/coll;
skip/M/coll;
skip/N/coll;
skip/O/coll;
skip/P/coll;
skip/Q/coll;
skip/R/coll;
skip/S/coll;
skip/T/coll;
skip/U/coll;
skip/V/coll;
skip/W/coll;
skip/X/coll;
skip/Y/coll;
skip/Z/coll;
collect/'/cont;
collect/-/hyphen;
collect/
/out;
collect/a/cont;
collect/b/cont;
collect/c/cont;
collect/d/cont;
collect/e/cont;
collect/f/cont;
collect/g/cont;
collect/h/cont;
collect/i/cont;
collect/j/cont;
collect/k/cont;
collect/l/cont;
collect/m/cont;
collect/n/cont;
collect/o/cont;
collect/p/cont;
collect/q/cont;
collect/r/cont;
collect/s/cont;
collect/t/cont;
collect/u/cont;
collect/v/cont;
collect/w/cont;
collect/x/cont;
collect/y/cont;
collect/z/cont;
collect/A/cont;
collect/B/cont;
collect/C/cont;
collect/D/cont;
collect/E/cont;
collect/F/cont;
collect/G/cont;
collect/H/cont;
collect/I/cont;
collect/J/cont;
collect/K/cont;
collect/L/cont;
collect/M/cont;
collect/N/cont;
collect/O/cont;
collect/P/cont;
collect/Q/cont;
collect/R/cont;
collect/S/cont;
collect/T/cont;
collect/U/cont;
collect/V/cont;
collect/W/cont;
collect/X/cont;
collect/Y/cont;
collect/Z/cont;
skip2/a/coll;
skip2/b/coll;
skip2/c/coll;
skip2/d/coll;
skip2/e/coll;
skip2/f/coll;
skip2/g/coll;
skip2/h/coll;
skip2/i/coll;
skip2/j/coll;
skip2/k/coll;
skip2/l/coll;
skip2/m/coll;
skip2/n/coll;
skip2/o/coll;
skip2/p/coll;
skip2/q/coll;
skip2/r/coll;
skip2/s/coll;
skip2/t/coll;
skip2/u/coll;
skip2/v/coll;
skip2/w/coll;
skip2/x/coll;
skip2/y/coll;
skip2/z/coll;
skip2/A/coll;
skip2/B/coll;
skip2/C/coll;
skip2/D/coll;
skip2/E/coll;
skip2/F/coll;
skip2/G/coll;
skip2/H/coll;
skip2/I/coll;
skip2/J/coll;
skip2/K/coll;
skip2/L/coll;
skip2/M/coll;
skip2/N/coll;
skip2/O/coll;
skip2/P/coll;
skip2/Q/coll;
skip2/R/coll;
skip2/S/coll;
skip2/T/coll;
skip2/U/coll;
skip2/V/coll;
skip2/W/coll;
skip2/X/coll;
skip2/Y/coll;
skip2/Z/coll;
source/cref/tab/mtab.c
+237
View File
@@ -0,0 +1,237 @@
# include "../mcons.h"
struct {
int cl[NUMC];
}tab[NUMS];
char state[NUMS][SIZS];
char class[NUMC][SIZC];
char act[NUMA][SIZA];
char def[NUMS][SIZA];
char temp[SIZA];
char *st[NUMS];
char *df[NUMS];
char *cl[NUMC];
char *ac[NUMA];
int t1;
int t2;
main(argc,argv) char **argv;
{
extern fin;
char fl,nlfl,c,bfl,fo,brk;
int cs,ca,cc,i,j,cd;
if(argc != 3) {
printf("Usage: mtab input output\n");
exit();
}
if((fo = creat(argv[2],0644)) < 0) {
printf("Output file.\n");
exit();
}
if((fin = open(argv[1],0)) < 0) {
printf("Input file.\n");
exit();
}
nlfl = 1;
i = -1;
while(brk = rword()) {
switch (brk) {
case '\n':
if(nlfl) {
move(temp,state[++i]);
st[i] = &state[i];
} else {
move(temp,def[i]);
df[i] = &def[i];
nlfl = 1;
}
continue;
case ' ':
if(nlfl) {
move(temp,state[++i]);
st[i] = &state[i];
nlfl = 0;
} else {
error(7);
}
continue;
}
}
i = 128;
while(--i) {
class[i][0] = i;
class[i][1] = '\0';
cl[i] = &class[i];
}
cl[0] = &class[0];
bfl = nlfl = 0;
t1 = 0;
t2 = -1;
while(c = getchar()) {
switch(c) {
default:
if(t1 >= NUMA) error(4);
bfl = nlfl = 0;
act[t1][++t2<8?t2:7] = c;
continue;
case '\n':
if(nlfl) break;
nlfl = 1;
case ' ':
if(bfl) continue;
bfl = 1;
act[t1][++t2<8?t2:7] = '\0';
ac[t1] = &act[t1];
t1++;
t2 = -1;
continue;
}
break;
}
if(c == '\0') exit();
i = -1;
while(++i < NUMS) {
if(df[i]) {
cd = find(ac,df[i],NUMA);
j = -1;
while(++j < NUMC)
tab[i].cl[j] = cd;
}
}
fl = 0;
i = -1;
while(c = getchar()) {
switch(c) {
case '\\':
temp[++i] = getchar();
continue;
case '\n':
if(fl != 1) continue;
default:
temp[++i] = c;
continue;
case '/':
temp[++i] = '\0';
i = -1;
switch(fl) {
case 0:
cs = find(st,temp,NUMS);
fl = 1;
continue;
case 1:
cc = find(cl,temp,NUMC);
fl = 2;
continue;
default:
error(1);
}
case ';':
if(fl != 2) error(2);
temp[++i] = '\0';
i = -1;
ca = find(ac,temp,NUMA);
/*printf("%o %o %o\n",cs,cc,ca); /*DEBUG*/
tab[cs].cl[cc] = ca;
fl = 0;
continue;
}
}
i = -1;
while(++i < NUMS)
write(fo,tab[i].cl,256);
}
error(a)
{
printf("Error %d\n",a);
exit();
}
find(a,b,c) char (*a[])[];
char b[];
int c;
{
int i,j;
/* printf("%s\n",b); /*DEBUG*/
i = -1;
while(++i < c) {
/* printf(" %s\n",a[i]); /*DEBUG*/
j = 0;
/* printf("b = %c\ta = %c\n",b[0],(*a[i])[0]); /*DEBUG*/
while(b[j] == (*a[i])[j]) {
if(b[j] == '\0') goto found;
j++;
}
}
found:
return(i);
}
rword() {
char c;
int ct;
ct = -1;
while(c = getchar()) {
switch(c) {
default:
temp[++ct] = c;
continue;
case '\n':
if(ct == -1) return('\0');
case ' ':
temp[++ct] = '\0';
return(c);
}
}
}
move(a,b) char *a;
char *b;
{
while((*b++ = *a++) != '\0');
return;
}
source/fort/f1/f11.s
+150
View File
@@ -0,0 +1,150 @@
/
/
/ f11 -- fortran command
/
.globl pass1
.globl fptrap
.globl getline
.globl flush
.globl perror
.globl lookup
.globl getype
.globl ssubr
.globl sfunc
.globl sbloc
.globl sextr
.globl sdime
.globl scomm
.globl sequi
.globl sdata
.globl sform
.globl simpl
.globl stype
.globl isagn
.globl ptemp
.globl funok
.globl signoff
.globl fopen
.globl fcreat
.globl lookid
.globl tfil1, tfil2
.globl tfildiag
pass1:
sys signal; 4; fptrap
cmp (sp)+,$2
bge 1f
2:
mov $1,r0
sys write; mes2; emes2-mes2
clr r0
sys seek; 0; 2
mov $-1,r0 / bad status
sys exit
1:
tst (sp)+
mov (sp)+,r0
jsr r5,fopen; ibuf
bcs 2b
mov $tfil1,r0
jsr r5,fcreat; obuf
bcs 2f
mov $tfil2,r0
jsr r5,fcreat; tbuf
bcc 1f
2:
jmp tfildiag
1:
/ data segment initialization
mov $2,nxtaloc
mov $errb,errp
mov $esymtab,esymp
mov $namebuf,namep
movb $'_,symbuf-1
jsr r5,lookid; blankc
bis $40,symtab(r3)
mov $imptab,r3
1:
mov $realcon,r0 / real*4
cmp r3,$imptab+[2*['i-'a]]
blo 2f
cmp r3,$imptab+[2*['n-'a]]
bhi 2f
mov $intcon,r0 / integer*4
2:
mov r0,[2*26.](r3) / lower case
mov r0,(r3)+ / upper case
cmp r3,$imptab+[2*26.]
blo 1b
/ call pass1
/ main scan loop for pass1
/ picks up non executable statements
/
scan1:
jsr r5,getline
mov $line,r1
jsr r5,isagn
br 2f
mov r1,r2
jsr r5,lookup; stmtab
br 1f
mov r2,r1
jsr r5,*sublst(r0)
mov pc,funok
jsr r5,perror
br scan1
1:
jsr r5,getype
br 2f
mov r2,r1
jsr r5,stype
jsr r5,perror
mov pc,funok
br scan1
2:
jsr r5,ptemp; 'l; efno; line
jsr r5,flush; tbuf
jsr r5,signoff; 1
sublst:
ssubr
sfunc
sbloc
sextr
sdime
scomm
sequi
sdata
sform
simpl
stmtab:
<subroutine\0>
<function\0>
<blockdata\0>
<external\0>
<dimension\0>
<common\0>
<equivalence\0>
<data\0>
<format\0>
<implicit\0>
<\0>
.even
mes2:
<Input file?\n>
emes2:
blankc:
<_\n\0>
.even
source/fort/f1/f12.s
+94
View File
@@ -0,0 +1,94 @@
/
/
/ f12 -- type statements and type getter subroutine
/
/
.globl stype
.globl getype
.globl typtab
.globl sfunc1
.globl lookup
.globl getsym
.globl error
.globl sdime1
stype:
mov r0,-(sp)
mov r1,r2
jsr r5,lookup; funtab
br 1f
mov r2,r1
mov (sp)+,r0
jmp sfunc1
1:
jsr r5,getsym
tst r0
bne 3f / junk error if not identifier
mov symtab(r3),r0
bic $![377\<8+7],r0 / size,type
beq 2f
cmp r0,(sp) / redefined, but same
beq 2f
jsr r5,error; 3.
2:
bic $377\<8+7,symtab(r3)
bis (sp),symtab(r3) / set in type and size
mov r3,-(sp)
jsr r5,getsym
cmp r0,$32. / ( for dimension
bne 2f
mov (sp),r3
jsr r5,sdime1
jsr r5,getsym
2:
tst (sp)+
cmp r0,$36. / , for another list element
beq 1b
cmp r0,$40. / eos
beq 1f
3:
jsr r5,error; 2. / junk
1:
tst (sp)+
rts r5
funtab:
<function\0>
<\0>
getype:
mov r1,r2
jsr r5,lookup; typtab
br 1f
mov tvaltab(r0),r0
tst (r5)+
1:
rts r5
tvaltab:
log1con
logcon
int1con
int2con
intcon
dcplxcon
dblcon
cplxcon
dblcon
realcon
typtab:
<logical*1\0>
<logical\0>
<integer*1\0>
<integer*2\0>
<integer\0>
<doublecomplex\0>
<doubleprecision\0>
<complex\0>
<real*8\0>
<real\0>
<\0>
source/fort/f1/f13.s
+101
View File
@@ -0,0 +1,101 @@
/
/
/ f13 -- dimension and array declarator
/
/ dimension
/
/
.globl sdime
.globl sdime1
.globl getsym
.globl error
.globl geti
.globl dimu
sdime:
jsr r5,getsym
tst r0
bne 3f / junk error
mov r3,-(sp)
jsr r5,getsym
mov (sp)+,r3
cmp r0,$32. / (
beq 2f
jsr r5,error; 4. / no ( in dimension
rts r5
2:
jsr r5,sdime1
jsr r5,getsym
cmp r0,$36. / ,
beq sdime
cmp r0,$40.
beq 1f
3:
jsr r5,error; 5.
1:
rts r5
/ get dimension info and store in
/ symbol table entry
/ r3 points at symbol table
/ r1 points just beyond (
sdime1:
bit $70,symtab(r3) / class
beq 1f
jsr r5,error; 6. / already classed
1:
mov r3,-(sp)
bic $70,symtab(r3)
bis $20,symtab(r3) / set as array
clr -(sp) / marker
1:
jsr r5,getsym
cmp r0,$2 / constant
bne 2f
cmp r3,$intcon / integer*4
bne 3f
jsr r5,geti
tst r0
ble 3f
mov r0,-(sp)
br 4f
2:
tst r0
bne 3f / identifer
tstb symtab(r3)
bge 3f / not parameter
neg r3
mov r3,-(sp)
mov sp,r0
2:
tst (r0)+
bne 2b
mov (r0),r0
tstb symtab(r0)
bge 3f / array not a param
4:
jsr r5,getsym
cmp r0,$36. / ,
beq 1b
cmp r0,$34. / )
beq 1f
3:
jsr r5,error; 7.
1:
mov esymp,r0
clr r2
mov dimu,-(r0)
inc dimu / unique number
1:
inc r2
mov (sp)+,-(r0)
bne 1b
dec r2
mov r2,(r0)
mov r0,esymp
mov (sp)+,r3
mov r0,symtab+2(r3)
rts r5
source/fort/f1/f14.s
+85
View File
@@ -0,0 +1,85 @@
/
/
/ f14 -- common statement
/
.globl scomm
.globl getsym
.globl sdime1
.globl error
.globl getid
.globl lookid
scomm:
mov r5,-(sp)
jsr r5,getsym
cmp r0,$6 / / for named common
beq ncom
3:
tst r0
bne 9f
mov r3,-(sp)
clr r5
br 2f
ncom:
cmpb (r1),$'/
bne 3f
inc r1
jsr r5,getsym
br 3b
3:
jsr r5,getid
br 9f / not identifier
jsr r5,lookid; symbuf-1
bis $40,symtab(r3) / set named common
mov r3,r5
jsr r5,getsym
cmp r0,$6 / /
bne 9f
1:
jsr r5,getsym
tst r0
bne 9f
mov r3,-(sp)
2:
jsr r5,getsym
cmp r0,$32. / (
bne 2f
mov (sp),r3
jsr r5,sdime1
jsr r5,getsym
2:
mov (sp)+,r3
bit $300,symtab(r3) / test param/common
beq 2f
jsr r5,error; 9. / not commonable or already commoned
br 3f
2:
mov r0,-(sp)
mov symtab+4(r5),r0
beq 2f
mov r3,symtab+4(r0) / next ptr of old last block
2:
mov (sp)+,r0
mov r3,symtab+4(r5) / new last ptr of head block
tst symtab+2(r5)
bne 3f
mov r3,symtab+2(r5) / first ptr if first block
3:
bis $100,symtab(r3)
cmp r0,$36. / ,
beq 1b
cmp r0,$6 / another /
beq ncom
cmp r0,$40. / =|
beq 8f
9:
jsr r5, error; 10. / common syntax error
8:
mov (sp)+,r5
rts r5
source/fort/f1/f15.s
+86
View File
@@ -0,0 +1,86 @@
/
/
/ f15 -- subroutine/function
.globl ssubr
.globl sfunc
.globl sbloc
.globl sfunc1
.globl funok
.globl getsym
.globl error
ssubr:
mov $2,progt
br 1f
sfunc:
mov $4,progt
1:
clr r0
br 2f
sfunc1:
mov $4,progt
2:
tst funok
beq 1f
jsr r5,error; 11.
1:
add $10,r0 / class=simple
mov r0,-(sp)
jsr r5,getsym
mov (sp)+,r2
tst r0
beq 1f
2:
jsr r5,error; 12.
rts r5
1:
mov r2,symtab(r3)
jsr r5,getsym
cmp r0,$32. / (
beq 1f
cmp r0,$40. / eos
bne 2b
rts r5
1:
clr -(sp)
1:
add $2,(sp)
jsr r5,getsym
tst r0
beq 3f
tst (sp)+
br 2b
3:
bis $200,symtab(r3) / param
mov (sp),symtab+6(r3) / param number
jsr r5,getsym
cmp r0,$36. / ,
beq 1b
tst (sp)+
cmp r0,$34. / )
bne 2b
jsr r5,getsym
cmp r0,$40.
bne 2b
rts r5
sbloc:
mov $6,progt
jsr r5,getsym
tst funok
beq 1f
jsr r5,error; 11.
1:
cmp r0,$40.
beq 1f
jsr r5,error; 13.
1:
rts r5
.data
funok: 0
source/fort/f1/f16.s
+37
View File
@@ -0,0 +1,37 @@
/
/
/ f16 -- extrn, equiv, data
.globl sextr
.globl sequi
.globl getsym
.globl putc
.globl error
.globl ptemp
sextr:
jsr r5,getsym
tst r0
bne 1f
bit $70,symtab(r3)
beq 2f
jsr r5,error; 14.
2:
bis $30,symtab(r3)
jsr r5,getsym
cmp r0,$36. / ,
beq sextr
cmp r0,$40. / eos
beq 2f
1:
jsr r5,error; 15.
2:
rts r5
sequi:
jsr r5,ptemp; 'e; efno; line
rts r5
source/fort/f1/f17.s
+70
View File
@@ -0,0 +1,70 @@
/
/
/ f17 -- implicit statement
.globl simpl
.globl getype
.globl chrtab
.globl error
simpl:
jsr r5,getype
br 9f
mov r2,r1
mov r0,-(sp)
movb (r1)+,r0
cmp r0,$'(
beq 1f
cmpb r0,$'/
bne 8f
1:
movb (r1)+,r0
cmpb chrtab(r0),$2
bne 8f
cmpb r0,$'a
blo 2f
sub $6,r0 / map 'a into 'Z+1
2:
movb (r1)+,r2
cmpb r2,$'-
bne 2f
movb (r1)+,r2
cmpb chrtab(r2),$2
bne 8f
cmp r2,$'a
blo 3f
sub $6,r2 / map 'a into 'Z+1
br 3f
2:
mov r0,r2
dec r1
3:
cmp r0,r2
bhi 8f
asl r0
asl r2
3:
mov (sp),imptab-[2*'A](r0)
add $2,r0
cmp r0,r2
blos 3b
movb (r1)+,r0
cmp r0,$',
beq 1b
tst (sp)+
cmp r0,$')
beq 1f
cmp r0,$'/
bne 9f
1:
tstb (r1)
bne simpl
rts r5
8:
tst (sp)+
9:
jsr r5,error; 16. / implicit syntax error
rts r5
source/fort/f2/f21.s
+24
View File
@@ -0,0 +1,24 @@
/
/
/ f21 -- storage allocation
/
.globl pass2
.globl signon
.globl signoff
.globl calloc
.globl salloc
.globl equiv
.globl entry
pass2:
jsr r5,signon; 2
mov $errb,errp
jsr r5,calloc
jsr r5,equiv
jsr r5,salloc
jsr r5,entry
jsr r5,signoff; 2
source/fort/f2/f22.s
+125
View File
@@ -0,0 +1,125 @@
/
/
/ f22 -- allocate common
.globl calloc
.globl entry
.globl declimpl
.globl size
.globl getc
.globl getw
.globl xbuf
.globl code
.globl typ
calloc:
clr r3
1:
cmp r3,symtp
bhis 1f
mov symtab(r3),r0
bic $!70,r0 / class
cmp r0,$40 / common block
bne 3f
mov r3,-(sp)
mov symtab+2(r3),r3
clr r2 / byte offset
2:
tst r3
beq 2f
jsr r5,declimpl
mov symtab+4(r3),-(sp)
mov 2(sp),symtab+4(r3)
mov r2,symtab+6(r3)
jsr r5,size
add r0,r2
mov (sp)+,r3
br 2b
2:
mov (sp)+,r3
clr symtab+2(r3)
mov r2,symtab+6(r3) / common block size
3:
add $8,r3
br 1b
1:
rts r5
entry:
mov progt,r0
jmp *1f(r0)
1:
main
subr
funct
blocd
main:
jsr r5,code
<main:\n\0>; .even
rts r5
subr:
funct:
jsr r5,code
<%n.: %n_\n\0>; .even
8
8
clr r3
1:
cmp r3,symtp
bhis 1f
mov symtab+2(r3),r0
beq 2f
mov (r0)+,r1 / num dims
asl r1
add r0,r1 / ptr to last dim
mov r3,-(sp)
mov (r1),-(sp) / dope id
clr r2 / dope offset
3:
add $2,r2
mov -(r1),r3
cmp r0,r1
bhi 3f
neg r3 / adjustable dimension
ble 3b
mov r0,-(sp)
jsr r5,declimpl
mov symtab(r3),r0
clrb r0
swab r0
jsr r5,code
< rval%dp; %n_\n\0>; .even
r0
r3
mov symtab(r3),r3
bic $![377\<8+7],r3
cmp r3,$2\<8+1 / is it i*2
beq 4f
bic $!7,r3
movb typ(r3),r3
jsr r5,code
< %c%di2\n\0>; .even
r3
r0
4:
mov 2(sp),r0
jsr r5,code
< stst; d%d+%d.\n\0>; .even
r0
r2
mov (sp)+,r0
br 3b
3:
tst (sp)+
mov (sp)+,r3
2:
add $8,r3
br 1b
1:
blocd:
rts r5
source/fort/f2/f23.s
+120
View File
@@ -0,0 +1,120 @@
/
/
/ f23 -- do equivalence statements
.globl equiv
.globl getsym
.globl consub
.globl eqvtab
.globl error
.globl declimpl
.globl perror
.globl setln
.globl getln
/ equivalence statements, part 1
/ destroys all registers
equiv:
jsr r5,setln
1:
jsr r5,getln
rts r5
cmp r0,$'e
bne 1b
mov $line+11.,r1
mov r5,-(sp)
2: / start equivalence group
cmpb (r1)+,$'( / check (
bne 9f / syntax error
jsr r5,getsym
tst r0
bne 9f / not identifier
mov r3,r5
jsr r5,equset
movb (r1)+,r2
clr r4 / offset
cmp r2,$',
beq 3f
cmp r2,$'( / subscripted vble
bne 9f / syntax error
jsr r5,consub / get subscript
mov r0,r4
cmpb (r1)+,$',
bne 9f
3: / rest of group
jsr r5,getsym / next ident
tst r0
bne 9f / syntax
jsr r5,equset
clr r0
mov r3,r2
cmpb (r1),$'( / subscript?
bne 4f
inc r1
jsr r5,consub
4:
mov eqvtab+2(r2),r2
cmp r2,r5
beq 5f / already in same group
cmp r2,r3
bne 4b / not yet in different group
sub r4,r0 / adjust offsets
sub eqvtab+4(r5),r0 / left vble's offset
add eqvtab+4(r3),r0 / new vble's offset
4:
sub r0,eqvtab+4(r2)
mov eqvtab+2(r2),r2
cmp r2,r3
bne 4b
mov eqvtab+2(r3),r0 / link up groups
mov eqvtab+2(r5),eqvtab+2(r3)
mov r0,eqvtab+2(r5) / link groups
br 6f
5: / here already in same group
cmp r0,r4 / offset must be same
beq 6f
jsr r5,error; 23. / inconsistency!
6:
movb (r1)+,r0
cmp r0,$',
beq 3b
cmp r0,$')
bne 9f
movb (r1)+,r0
bne 3f
jsr r5,perror
mov (sp)+,r5
br 1b
3:
cmp r0,$',
beq 2b
9:
jsr r5,error; 24. / equivalence syntax
jsr r5,perror
mov (sp)+,r5
br 1b
/ initialize member of equivalence group
equset:
jsr r5,declimpl / declare if necessary
mov symtab(r3),r0
bit $200,r0 / test parameter
bne 2f
bic $!70,r0
cmp r0,$10 / simple
beq 1f
cmp r0,$20 / array
beq 1f
2:
jsr r5,error; 31. / non-equivalencable variable
1:
tst eqvtab+2(r3) / see if mentioned yet
bne 1f
mov r3,eqvtab+2(r3) / points to itself
1:
rts r5
source/fort/f2/f24.s
+130
View File
@@ -0,0 +1,130 @@
/
/
/ f24 -- allocate storage for non-common variables
/ called after common and equivalence have been done
.globl salloc
.globl eqvtab
.globl error
.globl declimpl
.globl size
.globl perror
/ destroys all registers
salloc:
mov r5,-(sp)
clr r3 / loop over symbol table
br 2f
1:
add $8.,r3 / next variable
2:
cmp r3,symtp
blo 2f
mov (sp)+,r5
mov $line,r1
jsr r5,perror / flush errors
rts r5
2:
bit $70,symtab(r3)
beq 1b / unclassed
jsr r5,declimpl / just in case
tst eqvtab(r3) / test for already allocated
bne 1b / yes
mov symtab(r3),r0
bic $!70,r0
cmp r0,$10 / test class=simple
beq 2f
cmp r0,$20 / test array
bne 1b / no, not a variable
2:
bit $200,symtab(r3) / test parameter
bne 1b
tst eqvtab+2(r3) / test for equivalence
bne 2f / yes
bit $100,symtab(r3) / test common
bne 1b / yes, nothing to do
mov nxtaloc,symtab+6(r3) / offset
jsr r5,size / get byte count
add r0,nxtaloc
inc eqvtab(r3) / mark allocated
br 1b
2:
clr r4 / common variable of group
mov $77777,r1 / infinity to smallest offset
mov r3,r5
2:
cmp eqvtab+4(r3),r1
bgt 3f
mov eqvtab+4(r3),r1 / replace smallest offset
3:
bit $100,symtab(r3) / test common
beq 3f
mov r3,r4 / yes
3:
mov eqvtab+2(r3),r3 / next group member
cmp r3,r5
bne 2b
tst r4
bne 2f / *there was a common in group
/ equivalence group w/o common
sub nxtaloc,r1 / get -(group offset)
3:
inc eqvtab(r3) / mark allocated
mov eqvtab+4(r3),r2
sub r1,r2 / compute offset
mov r2,symtab+6(r3) / enter offset
jsr r5,size
add r0,r2 / highest loc of variable
cmp r2,r4
ble 4f
mov r2,r4 / extends storage
4:
mov eqvtab+2(r3),r3 / next of group
cmp r3,r5
bne 3b
mov r4,nxtaloc / account for space
br 1b / done!
2: / equivalence group w/ common
mov symtab+6(r4),r1 / actual common offset
sub eqvtab+4(r4),r1 / virtual common offset
2:
inc eqvtab(r3) / mark allocated
bit $100,symtab(r3) / is variable already in common
beq 3f / *no
cmp symtab+4(r4),symtab+4(r3)
beq 4f
jsr r5,error; 25. / different blocks equiv.
4:
mov r1,r0
add eqvtab+4(r3),r0
cmp r0,symtab+6(r3)
beq 4f / ok
jsr r5,error; 27. / same variable, different offsets
br 4f
3:
bis $100,symtab(r3) / mark common now
mov symtab+4(r4),symtab+4(r3)/ get right common block
mov r1,r0
add eqvtab+4(r3),r0
bge 3f
jsr r5,error; 26. / block extended leftward
clr r0
3:
mov r0,symtab+6(r3) / get proper offset
mov r0,-(sp)
jsr r5,size / see if size is extended
add (sp)+,r0
mov symtab+4(r3),r2 / common block
cmp symtab+6(r2),r0
bge 4f / ok
mov r0,symtab+6(r2) / extend size
4:
mov eqvtab+2(r3),r3
cmp r3,r5
bne 2b
jmp 1b
source/fort/f3/f31.s
+179
View File
@@ -0,0 +1,179 @@
/
/
/ f31 - pass3 dispatcher
/
/ main scan loop for pass3
/ picks up executable statements
/
.globl pass3
.globl ifstmt
.globl isagn
.globl signon
.globl signoff
.globl getline
.globl lookup
.globl sasgn
.globl error
.globl perror
.globl doend
.globl sform
.globl sdata
.globl sdo
.globl sassi
.globl scall
.globl scont
.globl sretu
.globl sgoto
.globl sif
.globl spaus
.globl sstop
.globl sread
.globl sprin
.globl swrit
.globl srewi
.globl sback
.globl sendf
.globl blocks
.globl blockp
.globl code
.globl ptemp
.globl dotabp
pass3:
jsr r5,signon; 3
br 2f
scan3:
jsr r5,getline
2:
mov $blocks,blockp
mov $line,r1
mov r1,r2
jsr r5,lookup; fmttab
br 2f
mov r0,-(sp)
jsr r5,isagn
br 1f
mov (sp)+,r0
jsr r5,*fmtlst(r0)
br scan3
1:
tst (sp)+
2:
mov efno,r0
beq 1f
jsr r5,ptemp; 's; efno; line
jsr r5,code
<.%d:\n\0>; .even
r0
1:
jsr r5,isagn
br 1f
mov r1,r2
jsr r5,lookup; stmtab
br 2f
mov r2,r1
jsr r5,*sublst(r0)
br 3f
1:
jsr r5,sasgn
br 3f
2:
jsr r5,error; 101.
3:
cmp progt,$6
bne 1f
jsr r5,error; 50. / execut in block data
1:
jsr r5,perror
mov efno,r0
beq scan3
jsr r5,doend
br scan3
ifstmt:
mov $blocks,blockp
jsr r5,isagn
br 1f
mov r1,r2
jsr r5,lookup; stmtab1
br 2f
mov r2,r1
cmp r0,$4 / don't allow end
beq 2f
jmp *sublst1(r0)
1:
jmp sasgn
2:
jsr r5,error; 101.
rts r5
send:
tst dotabp
beq 1f
clr r0
jsr r5,doend
br send
1:
tst progt
bne 1f
jsr r5,sstop
br 2f
1:
cmp progt,$6 / block data
beq 2f
jsr r5,sretu
2:
jsr r5,perror
jsr r5,signoff; 3
sublst:
sdo
sublst1:
sif
sendf
send
sassi
scall
scont
sretu
sgoto
spaus
sstop
sread
sprin
swrit
srewi
sback
fmtlst:
sform
sdata
stmtab:
<do\0>
stmtab1:
<if(\0>
<endfile\0>
<end\0> / keep in this spot!!!
<assign\0>
<call\0>
<continue\0>
<return\0>
<goto\0>
<pause\0>
<stop\0>
<read\0>
<print\0>
<write\0>
<rewind\0>
<backspace\0>
<\0>
fmttab:
<format\0>
<data\0>
<\0>
.even
source/fort/f3/f32.s
+227
View File
@@ -0,0 +1,227 @@
/
/
/ f32 -- expression to tree
.globl e1
.globl e2
.globl e11
.globl error
.globl getsym
.globl blockp
.globl blocks
.globl declimpl
.globl conu
.globl ptemp
.globl functn
.globl funimpl
/ e1: e2[,e1]
/ e2: e2[.or.e3]
/ e3: e3[.and.e4]
/ e4: [.not.]e5
/ e5: e6[.rel.e6]
/ e6: [+-]e7[+-e6]
/ e7: e7[*/e8]
/ e8: e9[**e9]
/ e9: constant
/ name[(e1)]
/ (e2)
e1:
jsr r5,e2
cmp r0,$36. / ,
bne 1f
jsr r5,block; e1
rts r5
e2:
jsr r5,e3
2:
cmp r0,$30. / or
bne 1f
jsr r5,block; e3
br 2b
e3:
jsr r5,e4
2:
cmp r0,$28. / and
bne 1f
jsr r5,block; e4
br 2b
e4:
jsr r5,getsym
cmp r0,$26. / not
bne e5
clr r2
jsr r5,block; e5a
rts r5
e5a:
jsr r5,getsym
e5:
jsr r5,e6
cmp r0,$14. / .lt.
blo 1f
cmp r0,$24. / .ge.
bhi 1f
jsr r5,block; e6a
rts r5
e6a:
jsr r5,getsym
e6:
cmp r0,$12. / +
beq e6a
cmp r0,$10. / -
bne 2f
clr r2
jsr r5,block; e7a
br 3f
2:
jsr r5,e7
3:
cmp r0,$10. / -
blo 1f
cmp r0,$12. / +
bhi 1f
jsr r5,block; e7a
br 3b
e7a:
jsr r5,getsym
e7:
jsr r5,e8
2:
cmp r0,$6. / /
blo 1f
cmp r0,$8. / *
bhi 1f
jsr r5,block; e8a
br 2b
e8a:
jsr r5,getsym
e8:
jsr r5,e9
cmp r0,$4 / **
bne 1f
jsr r5,block; e9a
1:
rts r5
e9a:
jsr r5,getsym
e9:
cmp r0,$2 / constant
beq 3f
/ (e2)
cmp r0,$32. / (
bne 1f
jsr r5,e2
br 2f
e10:
jsr r5,e1
2:
cmp r0,$34. / )
beq 2f
jsr r5,error; 29.
rts r5
2:
jsr r5,getsym
rts r5
1:
tst r0
beq e11
/ unknown
jsr r5,error; 30.
rts r5
/ name
e11:
mov r3,r2
jsr r5,getsym
cmp r0,$32. / (
bne 1f
jsr r5,appl
jsr r5,block; e10
rts r5
1:
mov r2,r3
mov r0,-(sp)
jsr r5,declimpl
mov symtab(r3),r0
bic $!70,r0
cmp r0,$30 / class =| funct
bne 1f
jsr r5,appl
mov $42.,r3 / just function name
br 2f
1:
clr r3
2:
mov (sp)+,r0
mov r2,-(sp)
mov blockp,r2
add $6,blockp
mov r3,(r2)
mov (sp)+,2(r2)
clr 4(r2)
rts r5
/ number
3:
mov blockp,r2
add $6,blockp
mov r0,(r2)
mov r3,2(r2)
cmpb 2(r2),$5 / const->int
bne 4f
movb $1,2(r2)
4:
mov r3,temp
mov conu,4(r2)
inc conu
jsr r5,ptemp; 'c; temp; symbuf
jsr r5,getsym
rts r5
appl:
clr functn
bit $70,symtab(r2) / class
bne 1f
bis $30,symtab(r2)
jsr r5,funimpl
1:
mov r2,r3
jsr r5,declimpl
mov symtab(r2),r0
bic $!70,r0 / class again
cmp r0,$20 / array
beq 1f
cmp r0,$30 / funct
beq 2f
jsr r5,error; 33.
bic $70,symtab(r2)
br appl
1:
mov $32.,r0
rts r5
2:
mov $34.,r0
rts r5
block:
mov blockp,r3
add $6,blockp
mov r0,(r3)+
mov r2,(r3)+
mov r3,-(sp)
jsr r5,*(r5)+
mov r2,*(sp)
mov (sp)+,r2
sub $4,r2
rts r5
source/fort/f3/f33.s
+143
View File
@@ -0,0 +1,143 @@
/
/
/ f33 -- do, etal
.globl sdo
.globl dobeg
.globl doend
.globl getlab
.globl e2
.globl error
.globl lvalue
.globl rvalue
.globl code
.globl convrt
.globl dou
.globl dotabp
.globl edotab
.globl dotab
sdo:
jsr r5,getlab
br 9f
jsr r5,dobeg
cmp r0,$40.
bne 9f
rts r5
7:
tst (sp)+
8:
tst (sp)+
9:
jsr r5,error; 42.
rts r5
dobeg:
mov dotabp,r2
cmp r2,$edotab
blo 1f
jsr r5,error; 44.
rts r5
1:
mov dou,dotab(r2)
inc dou
mov r0,dotab+2(r2)
add $4,dotabp
jsr r5,e2
cmp r0,$38. / =
bne 9b
mov r2,-(sp)
jsr r5,lvalue
mov r3,-(sp)
bic $!7,r3
cmp r3,$1 / integer
bne 7b
jsr r5,e2
cmp r0,$36. / ,
bne 7b
jsr r5,rvalue
mov (sp),r2
jsr r5,convrt
mov (sp),r3
clrb r3
swab r3
jsr r5,code
< gas%d\n goto; 2f\n\0>; .even
r3
mov dotabp,r2
mov dotab-4(r2),r0
jsr r5,code
<t%d:\n\0>; .even
r0
mov (sp)+,r3
mov (sp)+,r2
mov r0,-(sp)
mov r3,-(sp)
jsr r5,lvalue
jsr r5,e2
mov r0,-(sp)
jsr r5,rvalue
mov 2(sp),r2
jsr r5,convrt
cmp (sp)+,$36. / ,
bne 1f
jsr r5,e2
mov r0,-(sp)
jsr r5,rvalue
mov 2(sp),r2
jsr r5,convrt
mov (sp)+,r0
jsr r5,code
< do2\0>; .even
br 2f
1:
jsr r5,code
< do1\0>; .even
2:
mov (sp)+,r3
clrb r3
swab r3
mov (sp)+,r2
jsr r5,code
<%d; o%d\n2:\n\0>; .even
r3
r2
rts r5
doend:
tst r0
bne 1f
jsr pc,gen
rts r5
1:
clr r2
1:
cmp r2,dotabp
bhis 1f
add $4,r2
cmp r0,dotab-2(r2)
bne 1b
jsr pc,gen
br doend
1:
rts r5
gen:
mov r0,-(sp)
mov dotabp,r2
cmp r0,dotab-2(r2)
beq 1f
jsr r5,error; 43.
1:
mov dotab-4(r2),r0
sub $4,dotabp
jsr r5,code
< goto; t%d\no%d:\n\0>; .even
r0
r0
mov (sp)+,r0
rts pc
source/fort/f3/f34.s
+65
View File
@@ -0,0 +1,65 @@
/
/
/ f34 -- if statement
.globl sif
.globl e2
.globl error
.globl rvalue
.globl code
.globl ifstmt
.globl iserror
.globl getsym
.globl geti
.globl genop
.globl getlab
.globl newline
sif:
jsr r5,e2 / expression
jsr r5,iserror
br 9f
cmp r0,$34. / )
bne 9f
jsr r5,rvalue
mov $"if,r0
jsr r5,genop
bic $!7,r3
cmp r3,$3 / logical
bne 1f
jsr r5,code
<; 1f\n\0>; .even
jsr r5,ifstmt
jsr r5,code
<1:\n\0>; .even
rts r5
1:
mov $3,-(sp)
1:
jsr r5,getlab
br 8f
jsr r5,code
<; .%d\0>; .even
r0
dec (sp)
beq 1f
jsr r5,getsym
cmp r0,$36.
beq 1b
8:
tst (sp)+
br 9f
1:
tst (sp)+
jsr r5,newline
jsr r5,getsym
cmp r0,$40.
bne 9f
rts r5
9:
jsr r5,error; 40.
rts r5
source/fort/f3/f35.s
+87
View File
@@ -0,0 +1,87 @@
/
/
/ f35 -- assignment statement
.globl sasgn
.globl sassi
.globl error
.globl e2
.globl lvalue
.globl rvalue
.globl code
.globl convrt
.globl geti
.globl getsym
.globl getlab
.globl genop
.globl newline
.globl name
sasgn:
jsr r5,e2
cmp r0,$38. / =
bne 9f
mov r2,-(sp)
jsr r5,e2
cmp r0,$40. / =|
bne 8f
tst *(sp)
bne 1f / too hard for simple as
jsr r5,rvalue
mov (sp)+,r2
mov 2(r2),r2
mov r2,-(sp)
mov symtab(r2),r2
jsr r5,convrt
mov r2,r3
bis $7,r3
mov $"mv,r0
jsr r5,genop
mov (sp)+,r3
jsr r5,name
rts r5
1:
mov r2,r3
mov (sp)+,r2
mov r3,-(sp)
jsr r5,lvalue
mov (sp)+,r2
mov r3,-(sp)
jsr r5,rvalue
1:
mov (sp)+,r2
jsr r5,convrt
mov r2,r3
bis $7,r3 / type 'g'
mov $"as,r0
jsr r5,genop
jsr r5,newline
rts r5
sassi:
jsr r5,getlab
br 9f
mov r0,-(sp)
cmpb (r1)+,$'t
bne 8f
cmpb (r1)+,$'o
bne 8f
jsr r5,e2
cmp r0,$40. / =|
bne 8f
jsr r5,lvalue
mov (sp)+,r0
mov r3,-(sp)
jsr r5,code
< lval; .%d\n\0>; .even
r0
mov $int2con,r3
br 1b
8:
tst (sp)+
9:
jsr r5,error; 39.
rts r5
source/fort/f3/f36.s
+467
View File
@@ -0,0 +1,467 @@
/
/
/ f36 -- expression code generation
.globl lvalue
.globl rvalue
.globl convrt
.globl type
.globl funcappl
.globl name
.globl error
.globl lookup
.globl code
.globl iserror
.globl genop
.globl typ
.globl newline
.globl functn
.globl size
lvalue:
jsr r5,iserror
rts r5
tst (r2)
bne 1f
mov 2(r2),r3
jsr r5,code
< lval>; .even
br name
1:
mov r2,-(sp)
cmp (r2),$32. / array appl
bne 1f
jsr r5,aryappl
dec r0
bne 2f / dim =| 1
tstb symtab(r3)
blt 2f / p-bit, not simple
mov $"al,r0
br simpary
2:
jsr r5,code
< alval\0>; .even
arydope:
jsr r5,pbit
mov symtab+2(r3),r2
mov (r2)+,r0
asl r0
add r0,r2
mov (r2),r0
jsr r5,code
<; d%d\0>; .even
r0
br 2f
1:
jsr r5,error; 54.
mov (sp)+,r2
rts r5
simpary:
mov r3,-(sp)
mov symtab(r3),r3
bis $7,r3
jsr r5,genop
mov (sp)+,r3
jsr r5,size
jsr r5,code
<; %d.\0>; .even
r0
br 2f
name:
mov r2,-(sp)
jsr r5,pbit
2:
jsr r5,code
<; \0>; .even
bit $100,symtab(r3) / common
beq 1f
mov symtab+4(r3),r2
jsr r5,code
<%n+\0>; .even
r2
1:
movb symtab(r3),r2
bic $!70,r2
cmp r2,$30 / external
bne 1f
jsr r5,code
<%n.\n\0>; .even
r3
br 2f
1:
jsr r5,code
<%n_\n\0>; .even
r3
2:
mov symtab(r3),r3
mov (sp)+,r2
rts r5
rvalue:
jsr r5,iserror
rts r5
mov r2,-(sp)
tst (r2)
bne 1f
mov 2(r2),r3
movb symtab+1(r3),r2
jsr r5,code
< rval%d>; .even
r2
mov (sp)+,r2
br name
1:
cmp (r2),$32.
bne 1f
jsr r5,aryappl
dec r0
bne 3f
tstb symtab(r3)
blt 3f
mov $"ar,r0
br simpary
3:
jsr r5,code
< arval\0>; .even
br arydope
1:
cmp (r2),$34. / array appl
bne 1f
jsr r5,funcappl
mov (sp)+,r2
mov 2(r2),r3
movb symtab+1(r3),r0
jsr r5,code
<%d.\n\0>; .even
r0
mov symtab(r3),r3
rts r5
1:
cmp (r2),$2
bne 1f
movb 3(r2),r3
mov 4(r2),r2
jsr r5,code
< rval%d; c%d\n\0>; .even
r3
r2
mov (sp)+,r2
mov 2(r2),r3
rts r5
1:
cmp (r2),$24. / arith or relat
bhi 1f
mov 2(r2),r2
bne 3f
mov (sp),r2
sub $10.,(r2) / - bin -> - unary
mov 4(r2),r2
jsr r5,rvalue
br 2f
3:
jsr r5,rvalue
mov (sp),r2
mov r3,-(sp)
mov 4(r2),r2
jsr r5,type
cmp *2(sp),$4 / **
bne 3f
mov r3,r2
bic $!7,r2
cmp r2,$1 / ** integer
bne 3f
mov 2(sp),r2
sub $2,(r2) / pr -> pi
mov 4(r2),r2
jsr r5,rvalue
mov $intcon,r2
jsr r5,convrt
mov (sp)+,r3
br 2f
3:
mov (sp),r2
jsr pc,maxtyp
mov (sp)+,r3
mov r2,-(sp)
jsr r5,convrt
mov 2(sp),r2
mov 4(r2),r2
jsr r5,rvalue
mov (sp)+,r2
jsr r5,convrt
mov r2,r3
br 2f
1:
cmp (r2),$30. / and or not
bhi 1f
mov 2(r2),r2
beq 3f
jsr r5,rvalue
mov $logcon,r2
jsr r5,convrt
3:
mov (sp),r2
mov 4(r2),r2
jsr r5,rvalue
mov $logcon,r2
jsr r5,convrt
2:
mov (sp)+,r2
mov (r2),r0
cmp r0,$4
bhis 2f
add $10.,(r2) / back to binary
tst r0
beq 2f
sub $8,(r2) / back to pr
2:
mov optab(r0),r0
jsr r5,genop
jsr r5,newline
cmp (r2),$14. / relat
blo 2f
mov $logcon,r3
2:
rts r5
1:
jsr r5,error; 54.
mov (sp)+,r2
rts r5
pbit:
tstb symtab(r3)
bge 1f
jsr r5,code
<p\0>
1:
rts r5
funcappl:
mov r2,-(sp)
mov functn,r3
jsr r5,code
< stsp; ft+%d.\n\0>; .even
r3
mov r3,-(sp)
add $2,r3
mov r3,functn
clr -(sp) / nargs
1:
mov 4(r2),r2
beq 2f
inc (sp)
cmp (r2),$36. / ,
bne 1f
mov r2,-(sp)
mov 2(r2),r2
mov 6(sp),r3
jsr r5,fapp1
mov (sp)+,r2
br 1b
1:
mov 4(sp),r3
jsr r5,fapp1
2:
mov (sp)+,r0 / nargs
mov (sp)+,r2
mov (sp)+,r3
mov 2(r3),r3
jsr r5,code
< call\0>; .even
jsr r5,pbit
jsr r5,code
<; %n.; ft+%d.; %d.; \0>; .even
r3
r2
r0
cmp functn,functm
ble 1f
mov functn,functm
1:
mov r2,functn
rts r5
fapp1:
mov 2(r3),r3 / fetch out function name
mov symtab+2(r3),r3 / arg conversion
bne 2f
tst (r2)
beq 1f
cmp (r2),$32.
beq 4f
cmp (r2),$42. / lv if funct or name or arry app
beq 1f
cmp (r2),$2 / lv if const
bne 2f
mov 4(r2),r3
jsr r5,code
< lval; c%d\n\0>
r3
br 3f
2:
mov r3,-(sp)
jsr r5,rvalue
mov (sp)+,r2
beq 2f
jsr r5,convrt
2:
mov functn,r3
jsr r5,code
< stsp; ft+%d.\n\0>; .even
r3
add $2,functn
rts r5
1:
clr (r2) / turn func/array names into lvs
4:
jsr r5,lvalue
3:
mov functn,r3
jsr r5,code
< stst; ft+%d.\n\0>; .even
r3
add $2,functn
rts r5
aryappl:
mov r2,-(sp)
clr -(sp) / arg count
2:
inc (sp)
mov 4(r2),r2
cmp (r2),$36. / ,
bne 2f
mov r2,-(sp)
mov 2(r2),r2
jsr r5,rvalue
mov $intcon,r2
jsr r5,convrt
mov (sp)+,r2
br 2b
2:
jsr r5,rvalue
mov $intcon,r2
jsr r5,convrt
mov (sp)+,r0
mov (sp)+,r2
mov 2(r2),r3
cmp r0,*symtab+2(r3)
beq 1f
jsr r5,error; 53. / dimension mismatch
1:
rts r5
/ converts stack from type in r3 to type in r2
convrt:
mov r2,-(sp)
mov r3,-(sp)
bic $![377\<8+7],r2
bic $![377\<8+7],r3
cmp r2,r3
beq 1f
jsr r5,code
< \0>; .even
jsr pc,2f
mov r2,r3
jsr pc,2f
jsr r5,code
<\n\0>; .even
1:
mov (sp)+,r3
mov (sp)+,r2
rts r5
2:
mov r2,-(sp)
mov r3,r2
clrb r3
swab r3
bic $!7,r2
movb typ(r2),r2
jsr r5,code
<%c%d\0>; .even
r2
r3
mov (sp)+,r2
rts pc
type:
cmp (r2),$32.
beq 2f
cmp (r2),$34.
beq 2f
tst (r2)
bne 1f
2:
mov 2(r2),r3
mov symtab(r3),r3
rts r5
1:
cmp (r2),$2
bne 1f
mov 2(r2),r3
rts r5
1:
cmp (r2),$14.
blo 1f
mov $logcon,r3
rts r5
1:
mov r2,-(sp)
mov 2(r2),r2
bne 1f
mov (sp),r2
mov 4(r2),r2
jsr r5,type
br 2f
1:
jsr r5,type
mov (sp),r2
mov r3,-(sp)
mov 4(r2),r2
jsr r5,type
mov (sp)+,r2
jsr pc,maxtyp
mov r2,r3
2:
mov (sp)+,r2
rts r5
maxtyp:
mov r2,r0
cmp r2,r3
bhis 2f
mov r3,r2
2:
clrb r2
bic $!7,r0
bic $!7,r3
cmp r0,r3
bhis 2f
mov r3,r0
2:
bis r0,r2
rts pc
optab:
<ng>
<pi>
<pr>
<dv>
<mp>
<sb>
<ad>
<lt>
<le>
<eq>
<ne>
<gt>
<ge>
<nt>
<an>
<or>
source/fort/f3/f37.s
+96
View File
@@ -0,0 +1,96 @@
/
/
/ f37 -- goto statements of all kinds
.globl sgoto
.globl intexp
.globl e2
.globl code
.globl getsym
.globl error
.globl getlab
.globl rvalue
.globl convrt
.globl chrtab
sgoto:
movb (r1),r0
cmpb chrtab(r0),$4 / test digit
bne 1f / not constant
jsr r5,getlab
br 8f
jsr r5,code
< goto; .%d\n\0>; .even
r0
br 9f
1:
cmpb (r1),$'(
beq 1f
jsr r5,intexp
cmp r0,$36. / ,
beq 2f
jsr r5,code
< agoto\n\0>; .even
br 9f
2:
jsr r5,code
< cagoto\n\0>; .even
cmpb (r1)+,$'(
bne 8f / syntax
jsr pc,stmlist
br 9f
1:
mov r1,r4
1:
movb (r1)+,r0
beq 8f
cmp r0,$')
bne 1b
cmpb (r1)+,$',
bne 8f
jsr r5,intexp
mov r1,-(sp)
jsr r5,code
< cgoto\n\0>; .even
mov r4,r1
tstb (r1)+
jsr pc,stmlist
mov (sp)+,r1
9:
tstb (r1)
beq 1f
8:
jsr r5,error; 35.
1:
rts r5
stmlist:
jsr r5,getlab
br 9f
jsr r5,code
< .%d\n\0>; .even
r0
movb (r1)+,r0
cmp r0,$',
beq stmlist
cmp r0,$')
bne 8f
jsr r5,code
< 0\n\0>; .even
rts pc
8:
jsr r5,error; 35.
9:
rts pc
intexp:
jsr r5,e2
mov r0,-(sp)
jsr r5,rvalue
mov $intcon,r2
jsr r5,convrt
mov (sp)+,r0
rts r5
source/fort/f3/f38.s
+95
View File
@@ -0,0 +1,95 @@
/
/
/ f38 -- wierdo statements
.globl sstop
.globl scall
.globl spaus
.globl sretu
.globl scont
.globl iserror
.globl ptemp
.globl code
.globl geti
.globl getsym
.globl error
.globl declimpl
.globl e11
.globl funcappl
sstop:
clr r0
tstb (r1)
beq 1f
jsr r5,getsym
cmp r0,$2. / const
bne 7f
cmp r3,$intcon
bne 7f
jsr r5,geti
1:
jsr r5,code
< stop; %d\n\0>; .even
r0
br 8f
spaus:
jsr r5,getsym
cmp r0,$2
bne 7f
cmp r3,$intcon
bne 7f
jsr r5,geti
jsr r5,code
< paus; %d\n\0>; .even
r0
br 8f
sretu:
tst progt
bne 1f
jsr r5,error; 37. / return in main
br sstop
1:
jsr r5,code
< retrn\n\0>; .even
8:
scont:
tstb (r1)
bne 7f
rts r5
7:
jsr r5,error; 38.
rts r5
iserror:
cmp errp,$errb
bne 1f
tst (r5)+
1:
rts r5
scall:
jsr r5,getsym
tst r0
bne 7b
bit $70,symtab(r3)
bne 1f
bis $30,symtab(r3)
1:
jsr r5,declimpl
jsr r5,e11
cmp r0,$40.
bne 7b
cmp (r2),$34.
beq 1f
cmp (r2),$42.
bne 7b
1:
jsr r5,funcappl
jsr r5,code
<0\n\0>; .even
br 8b
source/fort/f3/f39.s
+258
View File
@@ -0,0 +1,258 @@
/
/
/ f39 -- i/o statements
.globl sread
.globl swrit
.globl sprin
.globl sback
.globl srewi
.globl sendf
.globl getsym
.globl error
.globl geticon
.globl e2
.globl lvalue
.globl rvalue
.globl iserror
.globl convrt
.globl code
.globl chrtab
.globl blocks
.globl blockp
.globl doend
.globl genop
.globl levzer
.globl dobeg
.globl intexp
.globl ptemp
.globl blocks
.globl blockp
.globl intexp
.globl newline
.globl nelem
sprin:
mov $8.,-(sp)
jsr r5,getfmt
br 9f
cmp r0,$36. / ,
beq 1f
cmp r0,$40. / =|
bne 8f
clrb (r1)
1:
mov $34.,r0 / simulate )
br 2f
sread:
mov $2,-(sp)
br 1f
swrit:
clr -(sp)
1:
cmpb (r1)+,$'(
bne 8f
jsr r5,intexp
mov $blocks,blockp
cmp r0,$34. / ), implies unformatted
beq 2f
cmp r0,$36. / ,
bne 8f
jsr r5,getfmt
br 9f
add $4,(sp)
cmp r0,$34. / )
bne 8f
2:
mov (sp),r0
mov iotype(r0),r0
jsr r5,code
< %s\n\0>; .even
r0
1:
tstb (r1)
beq 9f
1:
jsr r5,list
cmp r0,$40. / |=
beq 9f
8:
jsr r5,error; 41.
9:
jsr r5,code
< endio\n\0>; .even
tst (sp)+
rts r5
iotype:
1f
2f
3f
4f
5f
1:
<iowu\0>
2:
<ioru\0>
3:
<iowf\0>
4:
<iorf\0>
5:
<iowp\0>
.even
getfmt:
movb (r1),r0
cmpb chrtab(r0),$4 / digit
beq 1f
jsr r5,e2
jsr r5,iserror
rts r5
mov r0,-(sp)
jsr r5,lvalue
mov $blocks,blockp
br 8f
1:
jsr r5,geticon
br 8f
mov r0,temp
jsr r5,ptemp; 'i; temp; line / register use of format
jsr r5,code
< lval; .%d\n\0>; .even
r0
jsr r5,getsym
mov r0,-(sp)
8:
mov (sp)+,r0
tst (r5)+
rts r5
list:
jsr r5,lstitm
cmp r0,$36. / ,
beq list
rts r5
lstitm:
mov $blocks,blockp
cmpb (r1),$'( / test for sublist
beq 1f
jsr r5,e2
jsr r5,iserror
rts r5
mov r0,-(sp)
clr -(sp)
tst (r2)
bne 2f / test for name
mov 2(r2),r3
mov symtab(r3),r0
bic $!70,r0
cmp r0,$20 / test for short list
bne 2f
mov pc,(sp)
mov symtab+2(r3),r3
mov (r3)+,-(sp)
asl (sp)
add (sp)+,r3
mov (r3),r3
jsr r5,code
< slist1; d%d\n2:\0>; .even
r3
2:
jsr r5,lvalue
tst (sp)
beq 3f
jsr r5,code
< slist3\n\0>; .even
3:
mov $"io,r0
jsr r5,genop
tst (sp)+
beq 2f
jsr r5,code
<\n slist2; 2b\0>; .even
2:
jsr r5,newline
mov (sp)+,r0
rts r5
1:
inc r1
jsr r5,levzer; '=
br 1f / yes, implied do
jsr r5,list
jsr r5,chkel
jsr r5,getsym
rts r5
1:
cmp r1,r0
bhis 8f
cmpb -(r0),$', / look backwards
bne 1b
mov r0,-(sp)
mov r1,-(sp)
movb $'),(r0) / fake!!
mov r0,r1
inc r1
clr r0
jsr r5,dobeg / get do
jsr r5,chkel
mov (sp)+,r0
mov r1,-(sp)
mov r0,r1
jsr r5,list
jsr r5,chkel
clr r0
jsr r5,doend
mov (sp)+,r1
movb $',,*(sp)+ / unfake!!
jsr r5,getsym
rts r5
chkel:
cmp r0,$34. / )
beq 1f
8:
jsr r5,error; 41.
1:
rts r5
sback:
mov $bksp,r2
br 1f
srewi:
mov $rewi,r2
br 1f
sendf:
mov $enfl,r2
1:
mov r2,-(sp)
jsr r5,intexp
mov (sp),r2
jsr r5,code
< %s\n\0>; .even
r2
cmp r0,$40. / =|
beq 9f
8:
jsr r5,error; 41.
9:
tst (sp)+
rts r5
bksp:
<bksp\0>
rewi:
<rewi\0>
enfl:
<enfl\0>
source/fort/f4/f41.s
+40
View File
@@ -0,0 +1,40 @@
/
/
/ f41 -- everything else
.globl pass4
.globl signon
.globl flush
.globl dope
.globl formts
.globl globls
.globl constn
.globl fopen
.globl bsss
.globl tfil2
pass4:
setd
jsr r5,signon; 4
mov ibuf,r0
sys close
jsr r5,flush; obuf
jsr r5,flush; tbuf
jsr r5,dope
jsr r5,formts
jsr r5,constn
jsr r5,bsss
jsr r5,globls / uses r4 from bsss
jsr r5,flush; obuf
sys unlink; tfil2
clr r0
tst nerror
beq 1f
sys seek; 0; 2
mov $1,r0 / syntax errors
1:
sys exit
source/fort/f4/f42.s
+97
View File
@@ -0,0 +1,97 @@
/
/
/ 42 -- definition
.globl bsss
.globl code
.globl size
.globl declimpl
.globl cdata
.globl dodata
.globl dattab
bsss:
jsr r5,cdata
cmp progt,$6 / test block common
bne 1f
rts r5
1:
jsr r5,code
<.bss\n\0>; .even
mov functm,r3
beq 1f
jsr r5,code
<ft: .=.+%d.\n\0>; .even
r3
1:
cmp r4,$dattab / any data?
beq 1f
jsr r5,code
<.data\n\0>; .even
1:
jsr r5,code
<base:\n\0>; .even
clr r3
1:
cmp r3,symtp
bhis pass2
bit $70,symtab(r3) / test classed
bne 2f
jsr r5,declimpl
2:
mov symtab(r3),r0
mov symtab+6(r3),r2
bic $!70,r0 / class
cmp r0,$10 / simple
beq 1f
cmp r0,$20 / array
beq 1f
cmp r0,$30 / extrn
bne 2f
bit $200,symtab(r3) / param
beq 2f
jsr r5,code
<%n. = %d.\n\0>; .even
r3
r2
2:
cmp r0,$40 / common block
bne 2f
mov symtab+6(r3),r2 / size
beq 2f
jsr r5,code
<.comm %n,%d.\n\0>; .even
r3
r2
2:
add $8,r3
br 1b
1:
bit $300,symtab(r3)
beq 1f
jsr r5,code
<%n_ = %d.\n\0>; .even
r3
r2
br 2b
1:
tst r2
bne 1f
jsr r5,size
mov nxtaloc,r2
mov r2,symtab+6(r3)
add r0,nxtaloc
1:
jsr r5,code
<%n_ = base+%d.\n\0>; .even
r3
r2
br 2b
pass2:
jsr r5,dodata
rts r5
source/fort/f4/f43.s
+83
View File
@@ -0,0 +1,83 @@
/
/
/ f43 -- output globals and bdata bss's
.globl globls
.globl code
.globl dattab
.globl onedata
.globl error
.globl perror
globls:
mov progt,r0
jmp *1f(r0)
1:
1f
2f
3f
4f
1:
jsr r5,code
<.globl main\n\0>; .even
rts r5
2:
3:
jsr r5,code
<.globl %n.\n\0>; .even
8
rts r5
4:
1:
clr r3
1:
cmp r3,symtp
blo 2f
rts r5
2:
mov symtab(r3),r0
bic $!270,r0
cmp r0,$40 / common block
bne 2f
mov symtab+6(r3),r2
beq 2f
mov $dattab,r1
3:
cmp r1,r4
bhis 3f
cmp (r1),r3
beq 4f
add $8.,r1
br 3b
3:
jsr r5,code
<.bss\n.globl %n\n%n: .=.+%d.\n.text\n\0>; .even
r3
r3
r2
br 2f
4:
jsr r5,code
<.data\n.globl %n\n%n:\n\0>; .even
r3
r3
mov r2,-(sp)
mov r3,-(sp)
mov r1,r3
jsr r5,onedata
mov (sp)+,r3
mov (sp)+,r2
sub r1,r2
bge 9f
jsr r5,error; 22. / data overrun
jsr r5,perror
9:
jsr r5,code
<.=.+%d.\n.text\n\0>; .even
r2
2:
add $8,r3
br 1b
source/fort/f4/f44.s
+110
View File
@@ -0,0 +1,110 @@
/
/
/ f44 -- formats
.globl formts
.globl strout
.globl setln
.globl getln
.globl code
.globl error
.globl perror
.globl putc
.globl xbuf
formts:
jsr r5,setln
mov $2,r3
clr xbuf+518. / pick up zero efn formats
1:
jsr r5,getln
br 1f
cmp r0,$'s
beq 2f
cmp r0,$'f
bne 1b
mov efno,r0
jsr r5,code
<.%d: <\0>; .even
r0
mov $line+6,r1
jsr r5,strout
mov efno,r0
neg r0
br 3f
2:
mov efno,r0
3:
clr r2
2:
cmp r2,r3
bhis 2f
cmp r0,xbuf+518.(r2)
beq 3f
neg r0
cmp r0,xbuf+518.(r2)
beq 3f
add $2,r2
neg r0
br 2b
3:
jsr r5,error; 51.
jsr r5,perror
2:
mov r0,xbuf+518.(r3)
add $2,r3
br 1b
1:
jsr r5,code
< .even\n>; .even
jsr r5,setln
1:
jsr r5,getln
br 1f
cmp r0,$'r
beq 2f
cmp r0,$'i
bne 1b
mov efno,r0
neg r0
br 3f
2:
mov efno,r0
3:
mov $2,r2 / not zero
2:
cmp r2,r3
bhis 2f
cmp r0,xbuf+518.(r2)
beq 1b
add $2,r2
br 2b
2:
jsr r5,error; 52.
jsr r5,perror
br 1b
1:
rts r5
strout:
movb (r1)+,r0
beq 3f
cmp r0,$'>
beq 4f
cmp r0,$'\\
bne 5f
4:
mov r0,-(sp)
mov $'\\,r0
jsr r5,putc; obuf
mov (sp)+,r0
5:
jsr r5,putc; obuf
br strout
3:
jsr r5,code
<\\0\>\n\0>; .even
rts r5
source/fort/f4/f45.s
+144
View File
@@ -0,0 +1,144 @@
/
/
/ f45 -- constant pool
.globl constn
.globl evalcon
.globl error
.globl perror
.globl code
.globl getcon
.globl setln
.globl getln
.globl xbuf
.globl symbuf
.globl negflg
constn:
jsr r5,setln
mov $xbuf+518.,r3 / pool max pointer
mov $ibuf+518.,r4 / pool pointer pointer
1:
jsr r5,getln
br 1f
cmp r0,$'c
bne 1b
jsr r5,packcon
mov r2,-(r4) / put p ptr in p p ptr
cmp r3,r4
blo 1b
jsr r5,error; 99.
jsr r5,perror
1:
mov $xbuf+518.,r2
1:
cmp r2,r3
bhis 1f
mov $ibuf+518.,r1
2:
cmp r1,r4
blo 2f
cmp -(r1),r2
bne 2b
mov r1,r0
sub $ibuf+516.,r0
asr r0
neg r0
jsr r5,code
<c%d:\n\0>; .even
r0
br 2b
2:
mov (r2)+,r0
jsr r5,code
< %o\n\0>; .even
r0
br 1b
1:
rts r5
packcon:
mov $line,r1
jsr r5,evalcon
mov r1,-(sp)
mov r3,-(sp)
sub r2,(sp)
asr (sp)
mov r2,-(sp)
mov $xbuf+518.,r2
1:
mov (sp),r3
mov r2,r1
tst (r2)+
mov 2(sp),r0
2:
cmp (r1)+,(r3)+
bne 1b
dec r0
bgt 2b
tst -(r2)
mov (sp)+,r3
asl (sp)
add r2,(sp)
cmp (sp),r3
blos 1f
mov (sp),r3 / eureka
1:
tst (sp)+
mov (sp)+,r1
rts r5
evalcon:
cmpb efno,$5
bne 2f
movb efno+1,r0
mov r3,r2
br 1f
2:
jsr r5,getcon
tst negflg
beq 2f
negf fr0
negf fr1
2:
mov r3,r2
mov efno,r0
mov r0,r1
clrb r0
swab r0
bic $!7,r1
cmpb r1,$realcon
beq 3f
cmpb r1,$cplxcon
beq 2f
setl
movfi r0,symbuf+1
seti
mov $symbuf+5,r1
sub r0,r1
br 1f
2:
mov $symbuf+1,r1
movf fr1,symbuf+1
cmp r0,$8
beq 2f
movf fr0,symbuf+9.
br 1f
2:
movf fr0,symbuf+5
br 1f
3:
movf fr0,symbuf+1
mov $symbuf+1,r1
1:
movb (r1)+,(r3)+
dec r0
bgt 1b
bit $1,r3
beq 1f
clrb (r3)+
1:
rts r5
source/fort/f4/f46.s
+166
View File
@@ -0,0 +1,166 @@
/
/
/ f46 -- constant evaluation
.globl getcon
.globl dope
.globl code
getcon:
mov r0,-(sp)
mov r2,-(sp)
clr r2 / dec . counter
clrf fr0
movif $10.,fr1
clr -(sp) / - flag
cmpb (r1)+,$'+
beq 1f
cmpb -(r1),$'-
bne 1f
inc r1
inc (sp)
1:
movb (r1)+,r0
sub $'0,r0
cmp r0,$9
blos 2f
cmp r0,$'.-'0
bne 1f
dec r2
br 1b
2:
tst r2
beq 2f
dec r2
2:
mulf fr1,fr0
movif r0,fr2
addf fr2,fr0
br 1b
1:
tst r2
bne 1f
dec r2
1:
cmp r0,$'e-'0
beq 2f
cmp r0,$'d-'0
bne 1f
2:
mov r3,-(sp)
clr r3
clr -(sp)
cmpb (r1),$'-
bne 3f
inc r1
inc (sp)
br 2f
3:
cmpb (r1),$'+
bne 2f
inc r1
2:
movb (r1)+,r0
sub $'0,r0
cmp r0,$9
bhi 2f
mpy $10.,r3
add r0,r3
br 2b
2:
tst (sp)+
beq 2f
neg r3
2:
add r3,r2
mov (sp)+,r3
1:
movf fr1,fr2
add $1,r2
beq 1f
blt 2f
clr -(sp)
br 3f
2:
mov pc,-(sp)
neg r2
3:
sub $1,r2
ble 2f
mulf fr1,fr2
br 3b
2:
tst (sp)+
bne 2f
mulf fr2,fr0
br 1f
2:
divf fr2,fr0
1:
tst (sp)+
beq 1f
negf fr0
1:
cmpb -(r1),$',
bne 1f
movf fr0,-(sp)
inc r1
jsr r5,getcon
movf (sp)+,fr1 / a,b -> r1,r0
1:
mov (sp)+,r2
mov (sp)+,r0
rts r5
dope:
cmp progt,$6 / test "block data"
bne 1f
rts r5
1:
clr r3
1:
cmp r3,symtp
bhis 1f
mov symtab(r3),r0
bic $!70,r0
cmp r0,$20
bne 2f
mov symtab+2(r3),r0
beq 2f
mov (r0)+,r1
mov r1,r2
asl r2
add r0,r2
mov (r2),r0
jsr r5,code
<d%d: %d.\n \0>; .even
r0
r1
3:
dec r1
blt 3f
mov -(r2),r0
bge 4f
jsr r5,code
<..; \0>; .even
br 3b
4:
jsr r5,code
<%d.; \0>; .even
r0
br 3b
3:
mov symtab(r3),r2
clrb r2
swab r2
jsr r5,code
<%d.\n\0>; .even
r2
2:
add $8,r3
br 1b
1:
rts r5
source/fort/f4/f47.s
+298
View File
@@ -0,0 +1,298 @@
/
/
/ f47 -- analysis of data statements
.globl cdata
.globl dodata
.globl onedata
.globl compare
.globl code
.globl getcon
.globl error
.globl getsym
.globl consub
.globl size
.globl geti
.globl setln
.globl getln
.globl declimpl
.globl evalcon
.globl dattab
.globl contab
.globl efno
.globl perror
.globl qsort
.globl negflg
.globl repfact
.globl geti
.globl holround
cdata:
mov r5,-(sp)
jsr r5,setln
mov $dattab,r4
mov $contab,r5
dloop:
jsr r5,getln
br 2f
br 1f
2:
mov r4,-(sp)
mov $dattab,r1
mov r4,r2
mov $8.,r3
jsr pc,qsort
mov (sp)+,r4
mov (sp)+,r5
rts r5
1:
cmp r0,$'d
bne dloop
mov $line+4,r1
/ loop per specification-set
1:
clr repfact
mov r1,r2
2:
jsr r5,getsym
cmp r0,$40. / =|
bne 3f
8:
jmp 8f
9:
jmp 9f
3:
cmp r0,$6 / /
bne 2b
mov r1,-(sp)
mov r2,r1
mov (sp)+,r2
/ loop per specification
2:
cmp r4,r5
blo 3f
jmp 7f
3:
jsr r5,getsym
tst r0
bne 8b
bit $70,symtab(r3) / test classed
bne 3f
jsr r5,declimpl
3:
mov symtab(r3),r0
mov r0,holquo / temp storage
incb holquo+1 / round size
bicb $1,holquo+1
bit $200,r0 / test parameter
bne 9b
bic $!70,r0
cmp r0,$10 / simple
beq 3f
cmp r0,$20 / array
bne 9b
3:
bit $100,symtab(r3) / test common
beq 3f
cmp progt,$6 / test block data
bne 9b
mov symtab+4(r3),(r4)+ / common block
br 4f
3:
cmp progt,$6 / test block data
beq 9b
clr (r4)+
tst symtab+6(r3) / test allocated
bne 4f
mov nxtaloc,symtab+6(r3)
jsr r5,size
add r0,nxtaloc
4:
clr (r4) / offset slot
cmpb (r1),$'( / test subscript
bne 3f
inc r1
jsr r5,consub
bic $70,holquo
bis $10,holquo / array -> scalar
mov r0,(r4)
3:
movb symtab+1(r3),r0 / width of item
inc r0
bic $1,r0
mov r0,holround
add symtab+6(r3),(r4)+
tst repfact
beq 3f
dec repfact
movb efno+1,r3
mov r3,(r4)+
mov r5,(r4)+
br 4f
3:
mov r1,-(sp)
mov r2,r1
mov (sp)+,r2
5:
jsr r5,getsym
cmp r0,$2 / constant
beq 3f
cmp r0,$10. / -
bne 8f
inc negflg
jsr r5,getsym
cmp r0,$2 / constant
bne 8f
3:
cmpb (r1)+,$'*
bne 3f
cmp r3,$intcon
bne 8f
jsr r5,geti
dec r0
bmi 8f
mov r0,repfact
br 5b
3:
dec r1
mov r1,-(sp)
mov r2,-(sp)
mov r3,efno
clrb r3
swab r3
mov r3,(r4)+
sub r3,r5
mov r5,(r4)+ / ptr to const
mov r5,r3
mov $symbuf,r1
jsr r5,evalcon
clr negflg
mov (sp)+,r1
mov (sp)+,r2 / note r1 <=> r2
4:
cmpb efno+1,holquo+1 / compare sizes
blt 9f / constant too small
beq 3f
bicb $!77,holquo
cmp holquo,$int2con+10 / simple int*2?
bne 4f
sub $2,-4(r4) / reduce const length
cmpb efno,$5
beq 3f / hollerith, OK
add $2,-2(r4) / get least sig.
br 3f
4:
bit $20,holquo / test array
beq 9f
cmpb efno,$5 / test hollerith
bne 9f
3:
cmpb (r1),$'/
beq 3f
cmpb (r1)+,$',
bne 8f
tst repfact
bne 4f
cmpb (r2)+,$',
bne 8f
4:
jmp 2b
3:
cmpb (r2)+,$'/
bne 8f
tstb (r2)
beq 1f
cmpb (r2),$',
bne 3f
inc r2
3:
mov r2,r1
tst repfact
bne 8f
jmp 1b
7:
jsr r5,error; 28. / data table overflow
br 2f
8:
jsr r5,error; 21. / data syntax error
br 2f
9:
jsr r5,error; 22. / data semantic error
2:
mov $dattab,r4 / reset ptrs
mov $contab,r5
jsr r5,perror
1:
jmp dloop
dodata:
cmp progt,$6
beq 1f / block data
mov $dattab,r3
cmp r3,r4
bne 2f / is data
mov nxtaloc,r0
jsr r5,code
<.=.+%d.\n.text\n\0>; .even
r0
rts r5
2:
jsr r5,onedata
sub nxtaloc,r1
neg r1
blt 9b
jsr r5,code
<.=.+%d.\n.text\n\0>; .even
r1
1:
rts r5
onedata:
clr r1
2:
mov 2(r3),r0
sub r1,r0
bmi 9f
beq 3f
jsr r5,code
<.=.+%d.\n\0>; .even
r0
add r0,r1
3:
mov 4(r3),r0
add r0,r1
asr r0
mov r0,-(sp)
mov 6(r3),r2
3:
mov (r2)+,r0
jsr r5,code
<%o\n\0>; .even
r0
dec (sp)
bne 3b
tst (sp)+
add $8.,r3
cmp r3,r4
bhis 1f
cmp (r3),-8(r3) / any more in this block
beq 2b
1:
rts r5
9:
clr line
jsr r5,error; 32. / overlapping data init
jsr r5,perror
rts r5
/ comparison routine for qsort
compare:
cmp (r0),(r4)
bne 1f
cmp 2(r0),2(r4)
1:
rts pc
source/fort/fx/fhd.s
+53
View File
@@ -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
source/fort/fx/fx1.s
+40
View File
@@ -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
source/fort/fx/fx2.s
+134
View File
@@ -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
source/fort/fx/fx3.s
+49
View File
@@ -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
source/fort/fx/fx4.s
+364
View File
@@ -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>
source/fort/fx/fx5.s
+46
View File
@@ -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
source/fort/fx/fx6.s
+31
View File
@@ -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
source/fort/fx/fx7.s
+34
View File
@@ -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
source/fort/fx/fx8.s
+269
View File
@@ -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
source/fort/fx/fx9.s
+125
View File
@@ -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
source/fort/fx/fxa.s
+36
View File
@@ -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>
source/fort/fx/fxb.s
+32
View File
@@ -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
source/fort/fx/fxc.s
+36
View File
@@ -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
source/fort/fx/fxd.s
+50
View File
@@ -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
source/fort/fx/fxe.s
+24
View File
@@ -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>
source/fort/fx/fxf.s
+23
View File
@@ -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
source/fort/fx/fxg.s
+186
View File
@@ -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

Some files were not shown because too many files have changed in this diff Show More