Research V6 development

Work on file usr/source/fort/f2/f21.s
Work on file usr/source/fort/f2/f22.s
Work on file usr/source/fort/f2/f23.s
Work on file usr/source/fort/f2/f24.s

Co-Authored-By: Ken Thompson <ken@research.uucp>
Synthesized-from: v6

diff --git a/usr/source/fort/f2/f21.s b/usr/source/fort/f2/f21.s
new file mode 100644 (file)
index 0000000..95b4977
--- /dev/null
+++ b/usr/source/fort/f2/f21.s
@@ -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
+

diff --git a/usr/source/fort/f2/f22.s b/usr/source/fort/f2/f22.s
new file mode 100644 (file)
index 0000000..65c99f9
--- /dev/null
+++ b/usr/source/fort/f2/f22.s
@@ -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
+

diff --git a/usr/source/fort/f2/f23.s b/usr/source/fort/f2/f23.s
new file mode 100644 (file)
index 0000000..dae8b4e
--- /dev/null
+++ b/usr/source/fort/f2/f23.s
@@ -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
+

diff --git a/usr/source/fort/f2/f24.s b/usr/source/fort/f2/f24.s
new file mode 100644 (file)
index 0000000..da133f8
--- /dev/null
+++ b/usr/source/fort/f2/f24.s
@@ -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
+