UNIX 6th Ed. - /usr/source/fort/f2/f24.s

   1: /
   2: /
   3: 
   4: / f24 -- allocate storage for non-common variables
   5: / called after common and equivalence have been done
   6: 
   7: .globl  salloc
   8: 
   9: .globl  eqvtab
  10: .globl  error
  11: .globl  declimpl
  12: .globl  size
  13: .globl  perror
  14: 
  15: / destroys all registers
  16: 
  17: salloc:
  18:         mov     r5,-(sp)
  19:         clr     r3                      / loop over symbol table
  20:         br      2f
  21: 1:
  22:         add     $8.,r3                  / next variable
  23: 2:
  24: 
  25:         cmp     r3,symtp
  26:         blo     2f
  27:         mov     (sp)+,r5
  28:         mov     $line,r1
  29:         jsr     r5,perror               / flush errors
  30:         rts     r5
  31: 2:
  32:         bit     $70,symtab(r3)
  33:         beq     1b                      / unclassed
  34:         jsr     r5,declimpl             / just in case
  35:         tst     eqvtab(r3)              / test for already allocated
  36:         bne     1b                      / yes
  37:         mov     symtab(r3),r0
  38:         bic     $!70,r0
  39:         cmp     r0,$10                  / test class=simple
  40:         beq     2f
  41:         cmp     r0,$20                  / test array
  42:         bne     1b                      / no, not a variable
  43: 2:
  44:         bit     $200,symtab(r3)         / test parameter
  45:         bne     1b
  46:         tst     eqvtab+2(r3)            / test for equivalence
  47:         bne     2f                      / yes
  48:         bit     $100,symtab(r3)         / test common
  49:         bne     1b                      / yes, nothing to do
  50:         mov     nxtaloc,symtab+6(r3)    / offset
  51:         jsr     r5,size                 / get byte count
  52:         add     r0,nxtaloc
  53:         inc     eqvtab(r3)              / mark allocated
  54:         br      1b
  55: 2:
  56:         clr     r4                      / common variable of group
  57:         mov     $77777,r1               / infinity to smallest offset
  58:         mov     r3,r5
  59: 2:
  60:         cmp     eqvtab+4(r3),r1
  61:         bgt     3f
  62:         mov     eqvtab+4(r3),r1         / replace smallest offset
  63: 3:
  64:         bit     $100,symtab(r3)         / test common
  65:         beq     3f
  66:         mov     r3,r4                   / yes
  67: 3:
  68:         mov     eqvtab+2(r3),r3         / next group member
  69:         cmp     r3,r5
  70:         bne     2b
  71:         tst     r4
  72:         bne     2f                      / *there was a common in group
  73:                                 / equivalence group w/o common
  74:         sub     nxtaloc,r1              / get -(group offset)
  75: 3:
  76:         inc     eqvtab(r3)              / mark allocated
  77:         mov     eqvtab+4(r3),r2
  78:         sub     r1,r2                   / compute offset
  79:         mov     r2,symtab+6(r3)         / enter offset
  80:         jsr     r5,size
  81:         add     r0,r2                   / highest loc of variable
  82:         cmp     r2,r4
  83:         ble     4f
  84:         mov     r2,r4                   / extends storage
  85: 4:
  86:         mov     eqvtab+2(r3),r3         / next of group
  87:         cmp     r3,r5
  88:         bne     3b
  89:         mov     r4,nxtaloc              / account for space
  90:         br      1b                      / done!
  91: 2:                              / equivalence group w/ common
  92:         mov     symtab+6(r4),r1         / actual common offset
  93:         sub     eqvtab+4(r4),r1         / virtual common offset
  94: 2:
  95:         inc     eqvtab(r3)              / mark allocated
  96:         bit     $100,symtab(r3)         / is variable already in common
  97:         beq     3f                      / *no
  98:         cmp     symtab+4(r4),symtab+4(r3)
  99:         beq     4f
 100:         jsr     r5,error; 25.           / different blocks equiv.
 101: 4:
 102:         mov     r1,r0
 103:         add     eqvtab+4(r3),r0
 104:         cmp     r0,symtab+6(r3)
 105:         beq     4f                      / ok
 106:         jsr     r5,error; 27.           / same variable, different offsets
 107:         br      4f
 108: 3:
 109:         bis     $100,symtab(r3)         / mark common now
 110:         mov     symtab+4(r4),symtab+4(r3)/ get right common block
 111:         mov     r1,r0
 112:         add     eqvtab+4(r3),r0
 113:         bge     3f
 114:         jsr     r5,error; 26.           / block extended leftward
 115:         clr     r0
 116: 3:
 117:         mov     r0,symtab+6(r3)         / get proper offset
 118:         mov     r0,-(sp)
 119:         jsr     r5,size                 / see if size is extended
 120:         add     (sp)+,r0
 121:         mov     symtab+4(r3),r2         / common block
 122:         cmp     symtab+6(r2),r0
 123:         bge     4f                      / ok
 124:         mov     r0,symtab+6(r2)         / extend size
 125: 4:
 126:         mov     eqvtab+2(r3),r3
 127:         cmp     r3,r5
 128:         bne     2b
 129:         jmp     1b

Defined functions