MiniUnix/usr/source/fort/f1/f13.s
/
/
/ 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