Add original unix v6
This commit is contained in:
memnoth
@@ -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
|
||||
|
||||
@@ -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>
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user