home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V6 / usr / source / fort / f2 / f23.s < prev    next >
Encoding:
Text File  |  1975-07-17  |  1.9 KB  |  121 lines
  1. /
  2. /
  3.  
  4. / f23 -- do equivalence statements
  5.  
  6. .globl    equiv
  7.  
  8. .globl    getsym
  9. .globl    consub
  10. .globl    eqvtab
  11. .globl    error
  12. .globl    declimpl
  13. .globl    perror
  14. .globl    setln
  15. .globl    getln
  16.  
  17. / equivalence statements, part 1
  18. / destroys all registers
  19.  
  20. equiv:
  21.     jsr    r5,setln
  22. 1:
  23.     jsr    r5,getln
  24.         rts r5
  25.     cmp    r0,$'e
  26.     bne    1b
  27.     mov    $line+11.,r1
  28.     mov    r5,-(sp)
  29. 2:                / start equivalence group
  30.     cmpb    (r1)+,$'(        / check (
  31.     bne    9f            / syntax error
  32.     jsr    r5,getsym
  33.     tst    r0
  34.     bne    9f            / not identifier
  35.     mov    r3,r5
  36.     jsr    r5,equset
  37.     movb    (r1)+,r2
  38.     clr    r4            / offset
  39.     cmp    r2,$',
  40.     beq    3f
  41.     cmp    r2,$'(            / subscripted vble
  42.     bne    9f            / syntax error
  43.     jsr    r5,consub        / get subscript
  44.     mov    r0,r4
  45.     cmpb    (r1)+,$',
  46.     bne    9f
  47. 3:                    / rest of group
  48.     jsr    r5,getsym        / next ident
  49.     tst    r0
  50.     bne    9f            / syntax
  51.     jsr    r5,equset
  52.     clr    r0
  53.     mov    r3,r2
  54.     cmpb    (r1),$'(        / subscript?
  55.     bne    4f
  56.     inc    r1
  57.     jsr    r5,consub
  58. 4:
  59.     mov    eqvtab+2(r2),r2
  60.     cmp    r2,r5
  61.     beq    5f            / already in same group
  62.     cmp    r2,r3
  63.     bne    4b            / not yet in different group
  64.     sub    r4,r0            / adjust offsets
  65.     sub    eqvtab+4(r5),r0        / left vble's offset
  66.     add    eqvtab+4(r3),r0        / new vble's offset
  67. 4:
  68.     sub    r0,eqvtab+4(r2)
  69.     mov    eqvtab+2(r2),r2
  70.     cmp    r2,r3
  71.     bne    4b
  72.     mov    eqvtab+2(r3),r0        / link up groups
  73.     mov    eqvtab+2(r5),eqvtab+2(r3)
  74.     mov    r0,eqvtab+2(r5)        / link groups
  75.     br    6f
  76. 5:                    / here already in same group
  77.     cmp    r0,r4            / offset must be same
  78.     beq    6f
  79.     jsr    r5,error; 23.        / inconsistency!
  80. 6:
  81.     movb    (r1)+,r0
  82.     cmp    r0,$',
  83.     beq    3b
  84.     cmp    r0,$')
  85.     bne    9f
  86.     movb    (r1)+,r0
  87.     bne    3f
  88.     jsr    r5,perror
  89.     mov    (sp)+,r5
  90.     br    1b
  91. 3:
  92.     cmp    r0,$',
  93.     beq    2b
  94. 9:
  95.     jsr    r5,error; 24.        / equivalence syntax
  96.     jsr    r5,perror
  97.     mov    (sp)+,r5
  98.     br    1b
  99.  
  100. / initialize member of equivalence group
  101.  
  102. equset:
  103.     jsr    r5,declimpl        / declare if necessary
  104.     mov    symtab(r3),r0
  105.     bit    $200,r0            / test parameter
  106.     bne    2f
  107.     bic    $!70,r0
  108.     cmp    r0,$10            / simple
  109.     beq    1f
  110.     cmp    r0,$20            / array
  111.     beq    1f
  112. 2:
  113.     jsr    r5,error;  31.        / non-equivalencable variable
  114. 1:
  115.     tst    eqvtab+2(r3)        / see if mentioned yet
  116.     bne    1f
  117.     mov    r3,eqvtab+2(r3)        / points to itself
  118. 1:
  119.     rts    r5
  120.  
  121.