|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 150528 (0x24c00)
Types: TextFile
Names: »ftnpass43tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ftnpass43tx «
; rc 3.1.70 fortran, pass 4, page 1
k=e0
s. a500
w. endp4 ; number of bytes in pass 4
h. beginp4, 4<1+0 ; entry to pass 4, same direction as pass 3
\f
; fgs 1983.06.20 fortran, pass 4, page 3
; definition of outputbyte values.
aritleft=111 ; aritmetic left parenthesis
aritrigt=114 ; aritmetic right parenthesis
almcom =150 ; normal commonlist
zoncom =151 ; zonecommonlist
datalist=152 ; data list
entrylst=153 ; entry point list
extlist =154 ; external list
labellst=155 ; labelvariable list
localpl =156 ; place for local simple
arraypl =157 ; place for local arrays and commons
dlocarr =158 ; declare local array
dcomarr =159 ; declare common array
dformarr=160 ; declare formal array
dloczone=161 ; declare local zone
dzoncom =162 ; declare common zone
dformzon=163 ; declare formal zone
dextzone=169 ; declare external zone
vanoper =122 ; vanished operand
endpass4= 38 ; end pass, is the first byte to output in pass4
endunit4= 37 ; end unit, is the first byte to output in each unit
extrepr = 56 ; external representation
troubl = 57 ; trouble
enddecnw= 58 ; new value of end declaration
endforma =59 ; end formal declarations
impint = 16 ; implied integer
impreal = 17 ; implied real
implab = 18 ; implied label
endlin = 40 ; end line
call = 44 ; call
listleft= 42 ; list left parenthesis
listrigt =43 ; liste rigth paranters
integcon =46 ; integer constant.
noerror =e85 ; error number = e85
; working variables.
xx1 = 59 ; upperlimit for bytes of pass 4 interrest
xx2 = 512 ; first identifiernumber
sharel = e53 ; length of sharedescription
descripl= e52 ; length of zonedescription
availzar= e61 ; length of available area in front of zbuffer
recbasel= -e48 ; place for recordbase rel to start of
; the zonedescription
\f
; rc 3.1.70 fortran, pass 4, page 5
w.
;identifier action: is used in the declaration part of the program to
; check the occurrence of the identifier and find the action which is
; depending on the kind of the identifier and its actual occurrence
; (in type, dimension, common statement).
lookup: rl. w2 lastid. ; w2:=identifier address
bl w1 x2+1 ; w1:=kind(identifier)
rl. w1 x1+tilsttab. ; w1:=tabelword corresponding to kind
bl. w3 (occur.) ; w3:=no of left shifts
ls w1 x3 ;
am. (occur.) ;
bl w3 +1 ; w3:=no of right shifts to use
ls w1 x3 ; for isolating the action number
sn w1 0 ; if actionnumber=0
jl. doubdecl. ; then goto erroraction
ls w1 1 ;
am. (occur.) ; else goto action(kind,occur)
jl x1 ; with x2=lastid, x1=kind
; statetable: index is the old kind, and the word is holding some bits
; per occurrence of the variable. the value of these bits is used as
; index in the following address table to find the actual action.
; * procedurename
; ** formal parameter
; ** type declaration
; *** dimension left parenthesis
; *** zone declaration with specification
; *** zone declaration without specification
; ** commonname
; *** identifier in common list
; *** external declaration
;
; kind meaning
tilsttab: 2.1010100100100101001001 ; 0 not referenced
2.0001000100100000001001 ; 2 simple local
2.0001001001000000000000 ; 4 simple common
2.0001001100001000100010 ; 6 simple formal
2.0001000001100000010000 ; 8 dimension local
2.0001000010000000000000 ; 10 dimension common
2.0001000000001100100000 ; 12 dimension formal
2.0000010000000000011000 ; 14 zone local
2.0000010000000000000000 ; 16 zone common
2.0000010100000000100000 ; 18 zone formal
2.0001000000010000000100 ; 20 external
2.0001000000000000100100 ; 22 external formal
2.0001000000000000000000 ; 24 entry point name
2.0000000000000010000000 ; 26 common name
2.0000000000000000000011 ; 28 external zone
2.0101111010110111101100 ; 30 trouble
\f
; rc 3.1.70 fortran, pass 4, page 6
procdecl:
h. 2, -23 ;
w. jl. procname. ;
formpar:
h. 3, -22 ;
w. jl. param. ;
jl. nextbyte. ;
typedecl: ;
h. 5, -22 ;
w. jl. typek1. ;
jl. type. ;
jl. nextbyte. ;
indimens: ;
h. 7, -21 ;
w. jl. dimk4. ;
jl. dimk5. ;
jl. dimk6. ;
jl. zonedim. ;
jl. fzonedim. ;
jl. dimtroub. ;
inzone: ;
h. 10, -21
w. jl. zonek7. ;
jl. zonek8. ;
jl. dimzonk7. ;
jl. dimzonk8. ;
jl. dimtroub. ;
nospec:
h. 13, -21 ;
w. jl. newzone. ;
jl. parszone. ;
jl. pardzone. ;
jl. zoneext. ;
jl. nextbyte. ;
common: ;
h. 16, -22 ;
w. jl. firstcom. ;
jl. nextcom. ;
jl. firstc30. ;
comlist: ;
h. 18, -21 ;
w. jl. commonk2. ;
jl. commonk5. ;
jl. commonk8. ;
jl. comparam. ;
jl. common30. ;
inext: ;
h. 21, -21 ;
w. jl. external.
jl. extform. ;
jl. extzone. ;
jl. nextbyte. ;
\f
; rc 3.1.70 fortran, pass 4, page 7
; procedure declaration, x2=byte value
progtype: hs. w2 typespec. ; programtype:=bytevalue
al. w0 lookup. ; identifier action:=look in
rs. w0 identact. ; state table
al. w0 procdecl. ; occurrence:=procedure declaration
rs. w0 occur. ;
jl. nextbyte. ; goto read next input byte
; identifier is procedure name,
; x2=lastid, x1=old kind (=0)
procname: rs. w2 subrname. ; save identno for chaining
rs. w2 lasticom. ; of parameters
rs. w2 entrycha. ; set procedure inentry chain
bl. w0 typespec. ; w0:=w1:=type of procedure
bl. w1 typespec. ;
al w1 x1+1<9+1<6 ; explicit refereret:=1explicit typedecl=1
sl w0 7 ; if type>=7 then
la. w1 cleartyp. ; type:=0
sn w0 7 ;if program then
al w1 x1+1<4 ; set program bit
sn w0 9 ; if function with implicit
al w1 6+1<9 ; type then type=6(complex)
hs w1 x2 ;
al w1 24 ; kind:=entry point (=24)
hs w1 x2+1 ;
jl. w3 locx2. ;
al. w0 formpar. ; occurrence:=formal param
rs. w0 occur. ;
al w0 8 ; parameter number:=1
hs. w0 parno. ;
jl. nextbyte. ; goto read next input byte
; identifier is parameter,
; x2=lastid, x1=old kind (=0)
param: rl. w1 formp. ; formal param:=explicit used:=1
hs w1 x2 ;
al w1 6 ; kind:=simpel formal (=6)
hs w1 x2+1 ;
bl. w1 parno. ; x2-rel:=paramno*4 + 6
hs w1 x2+2 ;
al w1 x1+4 ; paramno:=paramno+1
hs. w1 parno. ;
rl. w0 lastid.
ws. w0 lasticom. ; set chain (relative) in last
am. (lasticom.); parameter
hs w0 +4 ; set new last parameter
rs. w2 lasticom. ;
jl. nextbyte. ; goto read next inputbyte
\f
; rc 3.1.70 fortran, pass 4, page 8
; typestatement, x2=byte value
vartype: al w0 x2-9 ;
hs. w0 typespec. ; identifier type:=byte value-8
al. w0 lookup. ; identifier action:=look in
rs. w0 identact. ; state table
al. w0 typedecl. ; occurrence:=typedeclaration
rs. w0 occur. ;
jl. nextbyte. ; goto red next inputbyte
; identifier is in type declaration,
; x2=lastid, x1=old kind
typek1: al w1 2 ; kind:=simpel local (=2)
hs w1 x2+1 ;
type: bl w1 x2 ; w1:=divbit,type
sz. w1 (expltyp.) ; if explicit decl = 1
jl. doubdecl. ; then goto trouble
la. w1 cleartyp. ; clear bits 0-5
ba. w1 typespec. ; bit 0-5:=type
al w1 x1+1<6 ; explicit decl:=1
hs w1 x2 ; set divbit and type in identdescr
jl. nextbyte. ; goto read next inputbyte
; implicit type declaration of last
; identifier
implreal: am 1 ; type:=3
implint: al w0 2 ; type:=2
bl. w2 (lastid.) ; w2:=divbit(lastid)
sz. w2 (expltyp.) ; if declared explicitly then
jl. nextbyte. ; goto read next byte
la. w2 cleartyp. ;
ba w2 1 ; type:=real or integer
hs. w2 (lastid.) ;
jl. nextbyte. ; goto read next byte
; implied label, variable in program
; part and explicitly used before.
implabel: jl. nextbyte. ; do not output the byte
\f
; rc 3.1.70 fortran, pass 4, page 9
; common statement
comdecl: al. w0 lookup. ; identifier action:=look in
rs. w0 identact. ; state table
al. w0 common. ; occurrence:=common name
rs. w0 occur. ;
jl. nextbyte. ; goto read next input byte
; identifier is a common name not used
; before, x2=identifiernumber
firstc30: am 4 ; kind:= trouble(30)
firstcom: al w0 26 ; kind:=common name(=26)
hs w0 x2+1 ;
bl w0 x2 ;
la. w0 cleartyp. ; clear type
lo. w0 explref. ; explicit ref:=1
lo. w0 expltyp. ; explicit typedeclared:=1
hs w0 x2 ;
setoccur: rs. w2 lasticom. ; save ident no for linking the common list
al. w0 comlist. ;
rs. w0 occur. ; occurrence:=common list
jl. nextbyte. ; goto read next input byte
; identifier is a common name used
; previously, x2=identifier number
nextcom: rl w1 x2+5 ; search for the end of the common
sn w1 0 ; chain, if w1=0
jl. setoccur. ; then last in chain
rl w2 3 ; else w2:=w1
jl. nextcom. ; goto check next in list
; identifier is in common list, x2=lastid
common30: am 14 ; kind:=trouble =30
commonk8: am 6 ; kind:=16 (zone common)
commonk5: am 6 ; kind:=10 (dimension common)
commonk2: al w0 4 ; kind:=4 (simpel common)
am. (lasticom.); if kind(lasticom)=trouble(30)
bl w1 +1 ; then kind(lastident):=trouble
sn w1 30 ;
al w0 30 ;
hs w0 x2+1 ;
sn w0 30 ;
jl. noref. ;
bl w0 x2 ; explicit ref:=1
lo. w0 explref. ;
hs w0 x2 ;
am. (lasticom.); set chain in last in common list
rs w2 +5 ;
noref: rs. w2 lasticom. ; set the new last in common list
jl. nextbyte. ; goto read next input byte
; identifier is a formal in common list
comparam: al w0 30 ; kind= trouble=30
hs w0 x2+1 ;
jl. w3 err410. ; outbyte trouble 410
jl. nextbyte. ; go to read next input byte
\f
; rc 3.1.70 fortran, pass 4, page 10
; dimension statement
dimdecl: al. w0 nextbyte. ; identifieraction:=no action
rs. w0 identact. ; the action is taken on ( , which
jl. nextbyte. ; gives the same as ( in type decl.
; bound left parenthesis in a dimension,
; type, or common declaration
dimensin: rl. w0 occur. ; save actual occurrence
rs. w0 retab0. ;
rl. w0 identact. ; identifier action
rs. w0 retabid. ;
rl. w0 lastid. ; and identifier number
rs. w0 identdim. ;
al. w0 indimens. ; occurrence:=dimension left par
rs. w0 occur. ;
al w0 1 ; varstate:=undefined41
hs. w0 varstate. ;
jl. lookup. ; goto look in state table
; identifier was local simple or common
; simple. is set to local dimension or
; common dimension, x2=ident no.
dimk5: am 2 ; kind:=dimension common=10
dimk4: al w0 8 ; kind:=dimension local=8
hs w0 x2+1 ;
al. w0 adjerr. ; identifier action:=identifier not
rs. w0 identact. ; allowed
al w1 2 ; correct:=2
restdim: rs. w1 correct. ;
bl w0 x2 ; explict ref := 1
lo. w0 explref. ;
hs w0 x2 ;
al w0 indx ; integer action:=normal constant
hs. w0 intconst. ; index
rl. w1 lastfrie. ; chain to rest descr:=w1:=last frie
rs w1 x2+2 ;
jl. w3 nextloc. ; w2:=next stack relative
hs w2 x1 ; x2-rel for baseword:=w2
al w0 6 ; no.of dimensions:=1
hs w0 x1-1 ;
al w0 edim ; action on ) := enddim
hs. w0 boundr. ;
jl. nextbyte. ; goto read next input byte
\f
; rc 78.04.13 fortran, pass 4, page 11
; identifiet was formal simpel. is set
; to formal dimension,w2= ident no.
dimk6: al w0 12 ; kind=formal dimension (12)
hs w0 x2+1 ;
al. w0 adjdim. ; identifier action =
rs. w0 identact. ; adjustable bound
bl w0 x2+2 ; move x2-rel for paramno to byte 6
hs w0 x2+5 ; in ident description
al w1 4 ; correct = 4
jl. restdim. ; goto set chain, baseword, and no.of
; dimensions
; identifier is an actual zone, x2=identno
zonedim: al. w0 adjerr. ; identifier action:=identifier not
rs. w0 identact. ; allowed
testzone: al w0 nummzone ; integer action:= no.of zones
hs. w0 intconst. ;
rl w1 x2+2 ; w1:=rest descr
bl w0 x1-1 ; w0:=no. of zones
se w0 0 ; if w0<>0 then double declaration
jl. doubdecl. ;
al w0 ezdim ; action on ) := endzdim
hs. w0 boundr. ;
jl. nextbyte. ; goto read next input byte
; identifier is a formal zone, x2=ident
fzonedim: al. w0 adjzone. ; identifier action:=
rs. w0 identact. ; adjustable zone
rl w1 x2+2 ; w1:=rest descr
rl. w2 lastid. ; retab x2
jl. testzone. ; goto test if double declaration
; constant is array index, w1=address
; for this index, w2=bytevalue
index: al w0 vanoper ; outbyte vanished operand
jl. w3 (outbyte.) ;
rl. w1 lastfrie. ; address for this index:=
bs w1 x1-1 ; lastfrie-no.of indices
jl. w3 (inbyte.) ; w2:= first byte of constant
hs w2 x1-1 ;
jl. w3 (inbyte.) ; w2:= second byte of constant
hs w2 x1 ;
al w2 0 ; adj bound:=0 in case of formal dim
corrix: rs w2 x1-2 ;
rl. w2 lastfrie. ; no.of indices:=no.of indices
bl w1 x2-1 ; +correct (=-4 for formal arrays
wa. w1 correct. ; =-2 for other arrays)
hs w1 x2-1 ;
sl w1 70 ; if no.of indices > 64
jl. ixoverfl. ; then error
jl. nextbyte. ; goto read next input byte
indx=index-e0
\f
; rc 87.04.13 fortran, pass4, page 12
; constant is zone index
numzone: al. w0 adjerr. ; identifier action:=
rs. w0 identact. ; identifier not allowed
al w0 morecon ; constant action:=
hs. w0 intconst. ; constant not allowed
al w0 vanoper ; outbyte vanished operand
jl. w3 (outbyte.) ;
am. (identdim.); w1:=start addr for rest descr
rl w1 +3 ; of the zone
jl. w3 (inbyte.) ; read constant giving no.of zones
al w0 x2 ;
jl. w3 (inbyte.) ; w2:=second part of constant
hs w2 x1-1 ; set in -no.of zones- in description
bz w2 5 ; (w2 := positive number)
sh w2 40 ;
se w0 0 ; if no of zones > 40
jl. zonerr. ; then error
jl. nextbyte. ; goto read next input byte
nummzone=numzone-e0
morecons: jl. w3 (repinp.) ; repeat input byte
jl. moreix. ; go to make error action
morecon=morecons-e0
; variable is an adjustable array
; dimension, w1=address for this index
adjdim: rl. w1 lastfrie. ; address of this index:=
bs w1 x1-1 ; last frie-no.of indices
jl. w3 nextloc. ; w2:=next stack relative
rs w2 x1 ; set x2-rel for transmitting the
rl. w2 lastid. ; parameter and identno
c.-1 ; btj 78.01.09
bl w0 x2
lo. w0 explref.
hs w0 x2
z. ; btj 78.03.09
jl. corrix. ; for the parameter
\f
; rc 78.03.09 fortran, pass 4, page 13
; variable is an adjustable zone array
; dimension
adjzone: am. (identdim.); w1:=address of the rest descr
rl w1 +2 ; for the zone
rl. w2 lastid. ; identno for variable with no.of zones
rs w2 x1-3 ; is set in the description
c.-1 ; btj 78.03.09
bl w0 x2 ;
lo. w0 explref. ; explicit ref:=1
hs w0 x2 ;
z. ; btj 78.03.09
jl. w3 nextloc. ; w2:=next stack rel
hs w2 x1-1 ; set x2-rel for transmitting the
jl. nextbyte. ; parameter
; right parenthesis after an array
; dimensioning
enddim: rl. w1 lastfrie. ; correct last frie:
al w2 x1 ; last frie:=last frie
bs w1 x1-1 ; -no.of indices
rs. w1 lastfrie. ;
bl w1 x2-1 ; no.of indices:=
al w1 x1-6 ; (no.of indices-6)/2
ls w1 -1 ;
rl. w0 correct. ; if correct=4
se w0 2 ;
ls w1 -1 ; then no.of indices:=no.of indices/2
hs w1 x2-1 ;
rl. w1 lastfrie. ; if lastfrie < firstfrie
sh. w1 (firstfri.);
jl. stackfl. ; then too many identifiers
edim=enddim-e0
; right parenthesis after an zone
; dimensioning
endzdim: al w0 copytwo ; reset integer constant action
hs. w0 intconst. ;
rl. w0 retabid. ; identifier action
rs. w0 identact. ;
rl. w0 retab0. ; occurrence
rs. w0 occur. ;
al w0 0 ; variable state:= defined=0
hs. w0 varstate. ;
al w0 edim ; reset ) action for dimension
hs. w0 boundr. ;
al w0 edzone ; reset ) action for zones
hs. w0 boundrz. ;
jl. nextbyte. ; goto read next byte
ezdim=endzdim-e0
\f
; rc 3.1.70 fortran, pass 4, page 14
; zone declaration
zonedecl: al. w0 zontype. ; identifier action:=set zone type
rs. w0 identact. ; to real
jl. nextbyte. ; goto read next input byte
; identifier is in a zone statement
zontype: al w0 3 ; type:=real
hs. w0 typespec. ;
al w0 1 ; variable state:= undefined=1
hs. w0 varstate. ;
bl w0 x2 ; explicit referenced:=1
lo. w0 explref. ;
hs w0 x2 ;
jl. type. ; goto check and set type
; left parenthesis in a zone
; declaration
zone: al. w0 inzone. ; occurrence:=zone left par
rs. w0 occur. ;
rl. w2 lastid. ;
rs. w2 identdim. ; save identno for the zone identifier
jl. lookup. ;
; identifier was a simple variable,
; local, or common
zonek8: am 2 ; kind:=16 (=zone common)
zonek7: al w0 14 ; kind:=14 (=zone local)
hs w0 x2+1 ;
rl. w1 lastfrie. ; chain to rest descr:=w1:=
rs w1 x2+2 ; lastfrie
jl. w3 nextloc. ; w2:=next stack relative
hs w2 x1 ; x2-rel for baseword:=w2
al w0 0 ; no.of dimensions:=0
hs w0 x1-1 ;
restzone: al. w0 blocproc. ; identifier action:=
rs. w0 identact. ; block procedure
al w0 buffleng ; integer constant action:=
hs. w0 intconst. ; buflength
jl. nextbyte. ; goto read next input byte
\f
; rc 78.04.13 fortran, pass 4, page 15
; identifier was a dimension, local
; or common
dimzonk8: am 2 ; kind:=zone common (=16)
dimzonk7: al w0 14 ; kind:=zone local (=14)
hs w0 x2+1 ;
rl w3 x2+3 ; w3:=chain to rest descr
bl w0 x3-1 ; move description to new place
se w0 1 ; w0:=no.of dimensions in array
jl. moreix. ; if antal <> 1 then error
rl w0 x3-7 ; no.of zones:=
hs w0 x3-1 ; length of first index
jl. restzone. ; goto set action on ident and const.
; zone without specification
nospecif: al. w0 nospec. ; occurrence:=zone parameter
rs. w0 occur. ;
jl. lookup. ; goto check occurrence
; zone without specification
; kind = 28
newzone: al w0 28 ; kind = 28 = external zone
hs w0 x2+1 ;
jl. zonerest. ;
; identifier was a simpel formal
; x2=identifier number
parszone: bl w0 x2+2 ; move x2-rel for paramno to byte 6
hs w0 x2+5 ;
al w0 18 ; kind = 18
hs w0 x2+1 ;
zonerest: rl. w1 lastfrie. ; chain to rest descr:=w1:=lastfrie
rs w1 x2+3 ;
al w0 0 ; no.of dimensions:=0
hs w0 x1-1 ;
bl w0 x2 ; explicit referenced:=1
lo. w0 explref. ;
hs w0 x2 ;
jl. w3 restdes4. ; make rest description
jl. w3 nextloc. ; get next x2-rel for the baseword
hs w2 x1 ; to w2
setstate: al w0 0 ; variable state:= defined=0
hs. w0 varstate. ;
jl. nextbyte. ; goto read next input byte
; identifier was dimension formal
pardzone: jl. moreix. ; w1:=chain to rest descr
al w0 18
hs w0 x2+ 1
bl w0 x1-1 ;
se w0 1 ; if no.of dimensions <> 1
jl. moreix. ; then goto error
rl w0 x1-7 ; no.of zones:= 1.index
hs w0 x1-1 ;
rl w0 x1-9 ; move identno for adj. bound
rs w0 x1-3 ;
jl. setstate. ; go to set variable state
; identifier was external
zoneext: bl w1 x2 ;
la. w1 cleartyp. ; type = external zone = 7
al w1 x1+7 ;
hs w1 x2 ;
bl w1 x2+2 ; save external number
hs w1 x2+4 ;
jl. newzone. ; go to new zone action
\f
; rc 3.1.70 fortran, pass 4, page 16
; constant is buflength in a zone decl.
bufleng: al w0 noshare ; integer constant action:=
hs. w0 intconst. ; no.of shares
am. (lastid.) ; w1:=place for buflength=chain-3
rl w1 +3 ;
al w1 x1-2 ;
setconst: jl. w3 (inbyte.) ; w2:= first byte of integer
hs w2 x1-1 ; set in descr.
jl. w3 (inbyte.) ; w2:= second byte of integer
hs w2 x1 ; set in descr
al w0 vanoper ; outbyte vanished operand
jl. w3 (outbyte.) ;
jl. nextbyte. ; goto read next input byte
buffleng=bufleng-e0
; constant is no.of shares in a
; zone decl
nooshare: am. (lastid.) ; w1:=place for no.of shares=chain-5
rl w1 +3 ;
al w1 x1-4 ;
jl. setconst. ; goto set in descr
noshare=nooshare-e0
; identifier is the block procedure
; in a zone declaration
blocproc: am. (identdim.); w1:=place for identno for
rl w1 +3 ; block procedure
rl. w2 lastid. ; set identno for blockprocedure in
rs w2 x1-7 ; the zone descr
al. w0 inext. ; declare the identifier as external
rs. w0 occur. ;
jl. lookup. ; goto look in state table
; right parenthesis in a zone decl.
endzone: rl. w1 lastfrie. ; correct lastfrie:
al w0 x1-8 ; lastfrie:=lastfrie-8
jl. w3 stackpl. ; test for stack place
al. w0 zontype. ; identifier action:=
rs. w0 identact. ; set zonetype to real
al w0 copytwo ; constant action:=
hs. w0 intconst. ; normal action
al w0 0 ; variable state:= defined=0
hs. w0 varstate. ;
jl. nextbyte. ; goto read next input byte
edzone=endzone - e0
; identifier was in trouble mode
dimtroub: al. w0 nextbyte. ; identifieraction:=nothing
rs. w0 identact. ;
al w0 deleteix ; integer action:= nothing
hs. w0 intconst. ;
al w0 ezdim ; action on ) :=reset
hs. w0 boundr. ; identifier- and constant
hs. w0 boundrz. ;
jl. nextbyte. ; action
ixdelete: al w0 vanoper ; outbyte vanished operand
jl. w3 (outbyte.) ;
jl. w3 (inbyte.) ; eat integer constant
jl. w3 (inbyte.)
jl. nextbyte. ; goto read next input byte
deleteix=ixdelete-e0
\f
; rc 3.1.70 fortran, pass 4, page 17
; external statement
extern: al. w0 lookup. ; identifier action:=
rs. w0 identact. ; look in state table
al. w0 inext. ; occurrence:=
rs. w0 occur. ; external declaration
jl. nextbyte. ; goto read next input byte
; identifier is an actual external
external: bl. w1 usedext. ; externalno:=externalno + 1
al w1 x1+1 ;
hs. w1 usedext. ;
hs w1 x2+2 ; extno(last ident):=externalno
al w1 20 ; kind:=20 (external)
hs w1 x2+1 ;
bl w1 x2 ; if explicit ref then
lo. w1 explref. ; explicit ref:=1
hs w1 x2 ;
jl. nextbyte. ; goto read next input byte
; identifier is a formal external
extform: al w1 22 ; kind:=22 (formal external)
hs w1 x2+1 ;
bl w0 x2 ; explicit referenced:=1
lo. w0 explref. ;
hs w0 x2 ;
jl. nextbyte. ; goto read next input byte
; identifier was zone without spe.
extzone: al w1 7+1<9+1<6 ; type = external zone(7)
hs w1 x2 ; and explicit ref explicit type = 1
bl. w1 usedext. ; uesd externals= usedexter + 1
al w1 x1+1 ;
hs. w1 usedext. ;
hs w1 x2+4 ; set external number
jl. nextbyte. ; go to take next byte
; data statement
data: al. w0 indata. ; identifieraction:=in data list
rs. w0 identact. ; goto output the byte daa
jl. output. ;
; variable is in datalis
indata: al w1 2 ; if variable is not used before
rl w0 x2 ; (kind=type=0)
sn w0 0 ;
hs w1 x2+1 ; then kind:=simple vaaiable(29
bl w0 x2 ;
lo. w0 datastm. ; databit = 1
hs w0 x2 ;
jl. w3 getidno. ; outbyte identifiernumber(x2)
jl. nextbyte. ; go to next input byte
; double declaration in declaration part
doubdecl: jl. w3 err401. ; outbyte trouble 401
bl w1 x2 ;
bl w0 x2+1 ; if kind=26 then
sn w0 26 ;
al w1 x1+1<5 ; set common trouble bit
hs w1 x2 ; in type
al w0 30 ; kind(identifier):=trouble = 30
am. (lastid.) ;
hs w0 +1 ;
jl. lookup. ; goto lookup once more
\f
\f
; rc 78.03.09 fortran, pass 4, page 18
dummy:
possleft:
posright:
notstmf:
; end statement after entry point
endundef: rs. w2 savew2.
rl. w2 lastid. ; output description of identifier
bl w1 x2+1 ; in lastis
bl. w1 x1+progkind. ;
jl. w3 x1+e0. ;
; end statement , normal action
rl. w2 savew2.
al w0 endstm0 ;
hs. w0 endstat. ; set normal end statemet action
endstm: al. w0 program.
rs. w0 identact. ; identitieraction:= in program part
al w0 copytwo ; reset integer action
hs. w0 intconst. ; to copytwo
al w0 0 ; variable state := normal =0
hs. w0 varstate. ;
jl. output. ; goto output byte
endstm0=endstm - e0 ;
endudef=endundef-e0 ;
; entry statement, x2=identnumber
entry: al. w0 entrynam. ; identifieraction:= entrypoint name
rs. w0 identact. ; goto output the byte
jl. output.
; variable is entrypoint name
entrynam: bl w0 x2+1 ; if kind <> local simple (1)
sn w0 1 ; and kind >< unused (0)
jl. entrok. ; then double declaration (error 409)
se w0 0 ;
jl. doubentr. ;
bl. w0 (subrname.) ;
la. w0 cleardiv. ; type of entry point=type of subroutine
sn w0 0 ; if type=0 then
lo. w0 expltyp. ; explicit type =1
hs w0 x2 ;
entrok: rl. w1 entrycha. ; w1=last ident. in entry list
rs w1 x2+5 ; set chain to last entry
rs. w2 entrycha. ; w2=new ident in entry chain
al w0 8 ; kind:=entrypoint=8
hs w0 x2+1 ;
bl w0 x2 ; if entrypointname is not expl ref
sz. w0 (explref.) ;
jl. aftx2. ;
lo. w0 explref. ; then explicit ref
hs w0 x2 ;
jl. w3 locx2rel. ; and get x2-rel for entry
aftx2: al w0 0 ; variable state:=not defined=0
hs. w0 varstate. ;
al w0 endudef ; action on end statement
hs. w0 endstat. ; :=output description
jl. nextbyte. ; goto read next inputbyte
\f
; rc 3.1.70 fortran, pass 4, page 19
; end unit output the bytes
; 1. entry point list
; 2. external list
; 3. label list
; 4. place for local arrays and zones
; 5. place for simple local
; 6. begin unit
; outbyte entry point list
endunit: rl. w2 entrycha. ; get first in entry chain
al w1 1 ; w1= no of entry points
nextentr: sn. w2 (subrname.); if entry point is subroutine
jl. subrout. ; go to subroutine action
jl. w3 outhead. ; outbyte identon and x2-rel
al w1 x1+1 ; no entry points=no entry points+1
rl w2 x2+5 ; get chain to next entry point
jl. nextentr. ;
subrout: rs. w1 noelem. ; save on of entry points
jl. w3 outhead. ; outbyte(identno and x2-rel)
bl w1 x2
sz. w1 (progbit.) ; if subruoname=program
al w1 7 ; hen type=7
la. w1 cleardiv. ;
al w1 x1+1
sn w1 8 ; proceduretype:=if type=7
al w1 0 ; then 0 else type+1
al w1 x1+1<5 ; language:=1 (fortran)
ls w1 18 ; save for later setting
rs. w1 typespec. ;
al w0 0 ; paramdescription:=0
al w1 0 ;
ds. w1 pardes. ;
nextpar: bl w1 x2+4 ; if chain to next parameter=0
sn w1 0 ; then goto output entry list
jl. entryout. ;
ls w0 18 ;
se w0 0 ; if no of parameters>7
jl. morepara. ; then go to moreparam
ba w2 x2+4 ; w2:=address of next parameter
bl w1 x2+1 ; w1:=kind of parameter i
al w3 17 ; if kind=simple parameter (3)
sn w1 3 ; then paramdescr:=type+17
jl. simple. ;
al w3 23 ; if kind=array parameter(4)
sn w1 4 ; then parameterdescr:=type+23
jl. simple. ;
sn w1 7 ;
jl. ext. ; then parameterdescr is complicated
sn w1 16 ; if kind is trouble (30)
jl. anytype. ; then paramdescr:=40
al w1 8 ; parameter was zone
rl w3 x2+3 ; if number of zones =0
bl w3 x3-1 ; then paramdescr:=8
se w3 0 ; else paramdescr:=30
al w1 30 ;
jl. setpdes. ;
\f
; rc 3.1.70 fortran, pass 4, page 20
ext: al w1 31 ; parameter was external
bl w0 x2 ; if not used as function
so. w0 (funcuse.) ; then paramdescr:=31
jl. setpdes. ;
al w3 31 ; else paramdescr:=31+type
jl. simple. ;
anytype: al w1 40 ; parameter was trouble
jl. setpdes. ; parameterdesc:=40
simple: bl w1 x2 ; parameterdescription:=type
la. w1 cleardiv. ; +base in w3
wa w1 7 ;
setpdes: dl. w0 pardes. ; parameterdescr:=
ls w1 18 ; parameterdescr>6 + new description
wa w3 3 ;
ld w0 -6 ;
ds. w0 pardes. ;
jl. nextpar. ;
; more than 7 parameters
morepara: dl. w0 pardes. ;
la. w3 clearpar. ; et parameter description
lo. w3 lastpara. ; of parameter no 7 to 40
ds. w0 pardes. ;
entryout: rl. w0 pardesm2. ; outbyte parameterdescription
wa. w0 typespec. ;
jl. w3 outword. ;
rl. w0 pardes. ;
jl. w3 outword. ;
rl. w1 noelem. ;
ls w1 1 ; outbyte no of bytes=
al w0 x1+4 ; no of entry points *2 + 4
jl. w3 (outbyte.) ; outbyte entry list
al w0 entrylst
jl. w3 (outbyte.) ;
\f
; rc 3.1.70 fortran, pass 4, page 21
; outbyte external list
al w0 0 ;
hs. w0 usedext. ; no of externals:=0
rl. w2 idbase. ; for i:=1 step 1 until no of ident
contin12: bl w1 x2+1 ; do
sn w1 6 ; if kind(i)<>external
jl. extout. ; then take next variable
bl w0 x2 ;
la. w0 cleardiv. ; if type = external zone(7)
se w0 7 ; then take next variable
jl. nextv12. ;
bl w0 x2+4 ; set external number
hs w0 x2+2 ;
extout: bl w0 x2+2 ; outbyte externalnumber
jl. w3 (outbyte.)
jl. w3 getidno. ; outbyte identnumber
bl. w1 usedext. ; no of externals:=no of exrernals+1
al w1 x1+1 ;
hs. w1 usedext. ;
nextv12: al w2 x2+6 ; check limit
se. w2 (firstfri.);
jl. contin12. ;
bl. w0 usedext. ; outbyte no of externals
jl. w3 (outbyte.) ;
bl. w1 usedext. ; outbyte no of bytes =
ls w1 1 ; no of externals*2+1
al w0 x1+1
jl. w3 (outbyte.) ;
al w0 extlist ; outbyte direction byte
jl. w3 (outbyte.) ;
\f
; rc 3.1.70 fortran, pass 4, page 22
; outbyte label variable list
al w0 0 ; no of labels:=0
hs. w0 parno. ;
rl. w2 idbase. ; for i:=1 step 1 until no of
contin13: bl w1 x2+1 ; identifiers do
se w1 15 ; if kind(i) <> labelariable
jl. nextv13. ; then take next varialbe
bl w0 x2+2 ; outbyte x2-rel for label
jl. w3 (outbyte.) ;
bl. w1 parno. ; no of variables:=no of variables
al w1 x1+1 ; +1
hs. w1 parno. ;
nextv13: al w2 x2+6 ; check limit
se. w2 (firstfri.);
jl. contin13. ;
bl. w0 parno. ; outbyte no of labelvariables
jl. w3 (outbyte.) ;
al labellst ; outbyte directing byte
jl. w3 (outbyte.) ;
rl. w2 stackrel. ; outbyte place for local variables
al w0 x2-2 ; stackrel= first frie
jl. w3 (outbyte.) ;
al w0 localpl ;
jl. w3 (outbyte.) ;
rl. w0 arrbase. ; outbyte place for arrays and zones
jl. w3 outword. ;
al w0 arraypl ; outbyte directing byte
jl. w3 (outbyte.) ;
al w0 endunit4 ; outbyte end unit
jl. w3 (outbyte.) ;
jl. nextbyte. ; go to next input byte
\f
; rc 3.1.70 fortran, pass 4, page 23
; identifieraction in program part
; x2=identifiernumber
program: rs. w2 lastid. ;
bl w0 x2 ;
sz. w0 (explref.) ; if variable explicit referenced
jl. oldoper. ; then goto output description
bl w0 x2+1 ; if kind <> unknown(30)
se w0 16 ; then goto new operand
jl. newoper. ;
oldoper: bl w1 x2+1 ; output decription of identifier
bz. w1 x1+progkind. ;
jl. w3 x1+e0. ;
jl. nextbyte. ;
; make a new declaration
newoper: bl w0 x2 ; explicit referenced:=1
lo. w0 explref. ;
hs w0 x2 ;
hs. w0 typespec. ; save type
repeat: jl. w3 (inbyte.) ; read next inputbyte into w2
al. w1 progbyte. ; search in table for action
bl w0x1 ; w0:=testalue
se w0x2 ; if inputbyte<>tableword
jl. getnext. ; then fet next tableword
bl w1 x1+1 ; else goto action(tableword)
rl. w2 lastid.
jl. x1+e0. ;
getnext: al w1 x1+2 ; get next word in table
se. w1 lastprgb. ; if w1=< no of words in table
jl. repeat.+4 ; then goto repeat
; else
rl. w2 lastid.
bl w0 x2 ; variable is simple local
al w1 3 ; if variable is parameter
so. w0 (formp.) ; then kind:=simpel formal(3)
al w1 1 ; else kind:=simpel local
hs w1 x2+1 ;
jl. w3 e11. ; repeat input character
so. w0 (formp.) ; if simpel local then
jl. w3 locx2rel. ; set x2-rel for simpel local
jl. oldoper. ; goto output description
; variable is label name
declabel: bl w0 x2+1 ;
bl w1 x2
la. w1 cleardiv. ;
sn w0 0 ; if kind<>0 and
jl. label. ;
se w1 2 ; type<>2 then
jl. oldoper. ; go to output description
label: al w0 15 ; kind:=labelname=15
hs w0 x2+1 ;
bl w1 x2 ; type:=integer=2
la. w1 cleartyp. ;
al w1 x1+2 ;
hs w1 x2 ;
jl. w3 locx2rel. ; set x2-rel
jl. oldoper. ; goto output description
\f
; rc 3.1.70 fortran, pass 4, page 24
; implied integer or real
realimpl: am 1 ; type:=real=3
intimpl: al w0 2 ; type:=integer=2
bl w1 x2 ;
hs. w1 typespec. ; save type for
la. w1 cleartyp. ; intrinsic functions
ba w1 1 ;
hs w1 x2 ;
jl. repeat. ; goto read nest programbyte
; external representation
repext: al w2 extrepr ; same as normal
hs. w2 reverse. ; (see copyx)
jl. w3 (inbyte.) ;
hs. w2 reversp1. ;
al w1 x2 ;
jl. w3 copysav. ;
jl. repeat. ; goto repeat process
; trouble byte
troub: al w0 16 ; kind:=trouble:=16
hs w0 x2+1 ;
jl. w3 e11. ; repeat inputbyte.
jl. oldoper. ; goto output description
newline: jl. w3 (linecnt.) ; outbyte new line number
jl. w3 (outbyte.) ; outbyte new line
jl. repeat. ; go to repeat process
; list left parenthesis or call
extleft: bl. w1 typespec. ; if variable is an intrinsic
se. w1 (explref.) ; function then
hs w1 x2 ; type = saved type
al w1 7 ; if variable is parameter
bl w0 x2 ; then kind:=formal external=7
sz. w0 (formp. ) ; else kind:=external(6)
jl. putkind.
bl. w1 usedext. ; no of externals=no of externals +1
al w1 x1+1
hs. w1 usedext.
hs w1 x2+2
al w1 6 ;
putkind: hs w1 x2+1 ;
jl. w3 e11. ; repeat input byte
jl. oldoper. ; goto output description
\f
\f
; rc 3.1.70 fortran, pass 4, page 25
; output description of
; simpel local, simpel parameter
; external' external parameter
; labelvariable
simplocd: rs. w3 savew3a. ;
bl w0 x2+2 ; outbyte x2-relative
jl. w3 (outbyte.) ;
jl. w3 direct. ; outbyte directing byte
jl. (savew3a.) ;
; output description of a simpel common
simpcomd: rs. w3 savew3a. ;
rl w0 x2+3 ; outbyte commonnumber
jl. w3 outword. ; outbyte commonrelative
jl. w3 direct. ; outbyte directing byte
jl. (savew3a.) ;
; output description of an array
arraydes: rs. w3 savew3a. ;
rl w1 x2+3 ; w1:=address of restdescription
bl w0 x1 ; outbyte x2-rel for baseword
jl. w3 (outbyte.) ;
arrzonde: bl w3 x1-1 ; w3:=no of bytes to transmit to
ls w3 1 ; pass 5=
al w3 x3+4 ; (no of indices-1)*2 + 6
rs. w3 bytes. ;
ac w3 x3-1 ; w3:=address of last byte of
wa w3 2 ; index n-1
rs. w3 test. ; x1-((no of indices-1)*2+5)
rl w0 x1-2 ;
jl. w3 outword. ; output upperix
rl w0 x1-4 ;
jl. w3 outword. ; output lowerix
bl w0 x1-1 ;
jl. w3 (outbyte.) ; outbyte number of indices
al w1 x1-6 ; w1:=address of first byte of words
; to output=w1-6
nextword: sh. w1 (test.) ;
jl. stopword. ;
rl w0 x1 ; outword w0
jl. w3 outword. ;
al w1 x1-2
jl. nextword. ;
stopword: rl. w3 bytes. ; outbyte number of bytes
bl w1 x2+1 ;
sn w1 13 ; if kind=array eq zone then
al w3 x3+3 ; no bytes=no bytes+3
al w0 x3 ;
jl. w3 (outbyte.) ;
jl. w3 direct. ; outbyte directing byte
jl. (savew3a.) ; return with bytes = no of bytes in descr.
\f
; rc 3.1.70 fortran, pass 4, page 26
; output description of a zone
zoned: rs. w3 savew3a. ;
rl w1 x2+3 ; w2:=address of descr
bl w0 x1 ; outbyte x2-rel
jl. w3 (outbyte.) ;
bl w0 x1-1 ; outbyte descr of no.of zones
jl. w3 (outbyte.) ;
jl. w3 direct. ; outbyte directing byte
jl. (savew3a.) ;
; output description of simple equiv. to
; array
simpeqar: rs. w3 savew3a. ;
bl w0 x2+4 ; outbyte x2-rel for basis
descrest: jl. w3 (outbyte.) ;
rl w0 x2+3 ; outbyte displacement
jl. w3 outword. ;
jl. w3 direct. ; outbyte directing byte
jl. (savew3a.) ;
; output description of simpel
; equiv: to zone
simpeqzo: rs. w3 savew3a. ;
rl w1 x2+5 ;
bl w0 x1-2 ; outbyte(zonedescriptor-
jl. w3 (outbyte.) ; displacement)
bl w0 x1 ;
jl. descrest. ; goto outbyte rest of description
; output description of array
; equiv. to zone
arreqzo: rs. w3 savew3a. ;
rl w1 x2+5 ;
bl w0 x1-4 ; outbyte(zonedescriptor
jl. w3 (outbyte.) ; displacement)
bl w0 x1 ; outbyte(x2-rel for
jl. w3 (outbyte.) ; zonedescriptor base)
rl w0 x1-3 ; outbyte(no of bytes from
jl. w3 outword. ; array(0.0..0) to rec(0))
rl w1 x2+3 ; w1 = rest description
jl. arrzonde. ; goto output array descrip
\f
; rc 3.1.70 fortran, pass 4, page 27
h. ; kind meaning
progkind: simplocd-e0 ; 0
simplocd-e0 ; 1 simpel local
simpcomd-e0 ; 2 simpel common
simplocd-e0 ; 3 simpel formal
arraydes-e0 ; 4 array
zoned -e0 ; 5 zone
simplocd-e0 ; 6 external
simplocd-e0 ; 7 external formal
simplocd-e0 ; 8 entry point
simpeqar-e0 ; unused
simpeqar-e0 ; unused
simpeqar-e0 ; 11 simpel equivalenced to array
simpeqzo-e0 ; 12 simpel equivalenced to zone
arreqzo -e0 ; 13 array equivalenced to zone
direc ; 14 common name
simplocd-e0 ; 15 label variable
direc ; 16 trouble
w.
h.
progbyte: implab , declabel - e0
impint , intimpl - e0
impreal , realimpl - e0
extrepr , repext - e0
call , extleft - e0
troubl , troub - e0
endlin , newline -e0
listleft , extleft - e0
lastprgb:
w.
\f
; rc 78.03.09 fortran, pass 4, page 28
; entry to pass 4
beginp4 = k - e0
; initialise
al. w0 e5. ; set the address of alarm
rs. w0 stackstp. ; after stack owerflow
al. w0 e7.
rs. w0 endofp.
al. w0 e11.
rs. w0 repinp.
al. w0 program.
rs. w0 prstep.
al. w0 e3. ; set the address of the byte output
rs. w0 outbyte. ; routine
al. w0 e2. ; set the address of the byte input
rs. w0 inbyte. ; routine
al. w0 e1. ; set the address of the line counting
rs. w0 linecnt. ; routine
al w0 endpass4 ; outbyte(end pass)
jl. w3 (outbyte.) ;
; central code: read next inputbyte and classifies the byte. there are
; 3 possibilities:
; 1. value < xx1 , goto action(inputtable(bytevalue))
; 2. xx1 <= value <= xx2, copy byte
; 3. value > xx2 , this is an identifier. the action address is
; in the word identact.
nextbyte: jl. w3 (inbyte.) ; w2:=next input byte
bz. w1 x2+intable. ; w1:= action address(byte value)
sh w2 xx1 ; if bytevalue < xx1
jl. x1+e0. ; then goto action(bytevalue)
sl w2 xx2 ; if bytevalue > xx2
jl. identif. ; then goto identifier
output: al w0 x2 ; else copy byte
jl. w3 (outbyte.) ;
jl. nextbyte. ; goto read next inputbyte
; inputbyte was an identifier
identif: al w0 vanoper ; if identifieraction=introuble
rl. w1 identact. ; ! (state=in declaration part
sn. w1 introubl. ; & identifieraction=in data
jl. outvan. ; then outbyte vanished operand
sn. w1 indata. ;
jl. notvan. ;
bl. w1 state. ;
se w1 1 ;
outvan: jl. w3 (outbyte.) ;
notvan: al w2 x2-xx2 ; lastident:=address in identifiertable
wm. w2 const6. ; table for 1. byte of the descrop-
wa. w2 idbase. ; tion.
rs. w2 lastid. ; = (bytevalue-xx2)*6 + idbase
am. (firstfri.);
sh w2 -1 ; if identifieraddress<firstfrie
jl. (identact.) ; then goto identifieraction
al w1 x2+6 ; else check if place for ident
rs. w1 firstfri. ;
al w3 0 ;
rs w3 x2+0 ; (clear new entry)
rs w3 x2+2 ;
rs w3 x2+4 ;
sh. w1 (lastfrie.);
jl. (identact.) ; then goto identifieraction.
jl. stackfl. ;
\f
; rc 3.1.70 fortran, pass 4, page 29
;constants
locx2: rs. w3 savew3a. ;
jl. w3 locx2rel. ;
jl. (savew3a.) ;
w.
cleardiv: 2.000000001111 ; to get the type from identifiertable
cleartyp: 2.111111110000 ; to get the divbit from identifiertable
cleardat: 2.111011111111 ; to clear the data bit
progbit: 2.000000010000 ; to get the bit program
commontr: 2.000000100000 ; to get the bit common trouble
expltyp: 2.000001000000 ; to get the bit explicitly typedecl
formp: 2.000010000000 ; to get the bit formal parameter
funcuse: 2.000100000000 ; to get the bit used as function
datastm: 2.000100000000 ; to get the bit in data list
explref: 2.001000000000 ; to get the bit explicitly referenced
recbase: recbasel ; place for recordbace
const1: 1 ; constants mosttly used in divisions
const3: 3 ;
const5: 5 ; and multiplications
const6: 6 ;
const8: 8 ;
catalog: 2.101011110101101010111000 ; type of std. func.double(1),compl(0)
clearpar: 2.000000000000111111111111 ; clear last parameter description
lastpara: 2.000000101000000000000000 ; sed for parameterdesc=40
clear1: 2.000000001111111111111111 ; used for checking adjustable
check1: 2.000000000010000000000110 ; type and kind
clear: 2.111111111111100000000000 ; used to make //2**11*2**11
; working locations
w.
endofp:e7 ; abs address of the pass termination in p0
stackstp:0 ; abs address of the alarm routine in p0
lastinco:0 ; abs address of tword with last word in core
prstep: program ; stepping stone
idbase:0 ; abs address of the first variabledescription
firstfri:0 ; abs address of the first available byte in free core
lastfrie:0 ; abs address of the last available byte in free core
lastid:0 ; abs address of the first byte for the descr of last variable
lasticom:0 ; abs address of the first byte for the last in com.list
entrycha:0 ; abs address of first byte for last in entry list
identdim:0 ; abs address of the first byte for the last dimensioning
identact:0 ; abs address of the actual identifieraction
occur:0 ; abs address of the actual occurrence of the identifier
savew1:0 ; working locations for saving things
savew2:0 ;
savew3: 0 ;
savew3a:0 ;
savew3b:0 ;
savew3c:0 ;
retab0: 0 ;
retabid:0 ;
reverse:0 ;
adjwork: 0
\f
; rc 3.1.70 fortran, pass 4, page 30
nextbyt: jl. nextbyte. ; stepping stones
correct:0 ; =2 for arrays, 4 for zones
limit:0 ; abs address for the last index in an arraylist
lowerix:0 ; for computing lowerindex
upperix:0 ; for computing upper index
length:0 ; for computing length (in bytes) of a winner
arrbase:0 ; - the number of bytes used for local arrays and zones
stackrel:0 ; - the number of bytes used for local simples
test:0 ;
subrname: 0 ; identnumber for procedure ame
0 ; doubleword for setting up the
pardes: 0 ; the parameter description
comno:0 ; for various counts
noelem:0 ;
nobytes:0 ;
nozones:0 ;
bytes:0 ;
zonno: 0 ;
h.
usedext:0 ; no of external used
parno:0 ; no of parameters
typespec:0 ; the type in the last typespecification
lastkind:0 ; the kind of the last identifier in common
state:0 ; =0 in declaration part, 1 in program part
varstate: 0 ; state of variable, 0 undefined, 1 defined
w.
indtr: jl. indtroub. ; stepping stones
indtrou= indtr - e0
arindx: jl. arrayidx. ;
arrindx= arindx - e0
arright: jl. arrayrig. ;
arigh = arright - e0
cop1: jl. copy1. ;
cop2: jl. copy2. ;
listl: jl. listlef. ;
reversp1= reverse+ 1
pardesm2 = pardes-2
\f
; rc 78.03.09 fortran, pass4, page 32
endpass: jl. (endofp.) ; go to terminte pass 4
begunit: rl. w1 e9.+4 ; lastfrie:=information from p0
al w1 x1+1 ;
rs. w1 lastfrie. ;
am idstart ;
al. w1 idst. ; idbase:= start of identifier table
rs. w1 idbase. ;
al w3 x1+24*6 ;
al w0 0 ; clear first 24 entries in identifier table
hs. w0 state. ; state:=in declaration part
nextzero: hs w0 x1 ;
al w1 x1+1 ;
sh. w1 (lastfrie.);
jl. nextzero. ;
rl. w1 idbase. ;
al w1 x1+36 ; w1 = tabel place for 1.int. func.
rl. w3 catalog. ; set type of standard variables
nextstdv: al w0 5 ; 1 = double(5) 0 = complex(6)
sl w3 0 ;
al w0 6 ;
hs w0 x1 ;
al w1 x1+6 ; w1 = address of next variable
ls w3 1 ;
se w3 0 ; if not last complex then
jl. nextstdv. ; go to take next variable
rs. w1 firstfri. ; firstfri = addr of frist variable in the program
al w0 -5 ; first stackrelative:=-7
rs. w0 stackrel. ;
al w0 0 ; no of externals
hs. w0 usedext. ; is set to 0
al w0 0 ; first common number
rs. w0 comno. ; is set to 0
al. w0 lastfrie. ; set address of lsatfrie
rs. w0 lastfri. ; in lastfri
al. w0 lastid. ; set address of lastid
rs. w0 lastiden. ; in lastiden
jl. output. ; goto take next byte
endline: jl. w3 (linecnt.) ;
jl. output. ; goto output byte again.
listlef: bl. w1 (lastid.) ; if identifier is array
lo. w1 funcuse. ; or external .set the bit
hs. w1 (lastid.) ; funcused only used for exter
jl. output. ; go to output byte
listlft=listl-e0
copyx: hs. w2 reverse. ; save the inputbyte
jl. w3 (inbyte.) ; get the nest inputbyte
hs. w2 reverse.+1; no of bytes in the present byte
al w1 x2 ; w1:= no to copy
jl. copy. ; goto copy bytes
format: jl. w3 (inbyte.) ; read format directing byte
jl. copy2. ; go to copy2 next bytes
; copy x bytes to output
copy8: am 4
copy4: am 1
copy3: am 1
copy2: am 1
copy1: al w1 1 ;
hs. w2 reverse. ; save the inputbyte
copy: al. w3 nextbyte. ; set retturnaddress
copysav: rs. w3 savew3. ;
copyy: jl. w3 (inbyte.) ; w2:=nextbyte
al w0 x2 ; w0:=byte
jl. w3 (outbyte.) ; outbyte(w0)
al w1 x1-1 ; w1:=w1-1
se w1 0 ; if wi <> 0 then
jl. copyy. ; then goto copy next byte
; all bytes is copied
\f
; rc 3.1.70 fortran, pass 4, page 33
bl. w0 reverse. ;
se w0 extrepr ; if directing byte <> extern repr
jl. outdir. ; then goto output directing byte
rl. w2 lastid. ; outbyte identno
jl. w3 getidno. ;
bl. w1 reverse.+1 ; outbyte no of bytes for the external
al w0 x1+1
jl. w3 (outbyte.) ; representation
outdir: bl. w0 reverse. ; outbyte directing byte
jl. w3 (outbyte.) ;
jl. (savew3.) ; goto get next byte
; trouble byte in input
trouble: al. w0 introubl. ; identifier action:=introuble
rs. w0 identact. ; (outbyte vanished operand)
bl. w0 varstate. ; if variable state = defined=0
se w0 1 ; then goto copy the
jl. copy3. ; troublebyte to output
al w0 30 ; else kind(lastident):=30
am. (identdim.);
hs w0 +1 ;
jl. copy3. ; goto copy the trouble byte
; identifier after trouble
introubl: jl. nextbyte. ; goto read next input byte
\f
; rc 3.1.70 fortran, pass 4, page 34
; no.of indices > 32 in dimension
ixoverfl: jl. w3 err402. ; outbyte trouble 402
jl. seterr. ; goto set ident action and constant
; action to nothing
stackfl: al. w1 stacktxt. ; pass 4 stack overflow.terminate
jl. w3 (stackstp.); with the message
; stack pass 4
stacktxt: <: process too small<0>:> ;
; constant giving no.of zones > 2**11
zonerr: jl. w3 err403. ; outbyte trouble 403
jl. seterr. ; goto read next input byte
; no.of indices in zone dimens > 1
moreix: jl. w3 err404. ; outbyte trouble 404
seterr: al w0 30 ; kind(ident):=trouble (=30)
am. (identdim.);
hs w0 +1 ;
jl. dimtroub. ; goto set actions to nothing
; adjustable bound on actual dimension
adjerr: jl. w3 err405. ; outbyte trouble 405
jl. seterr. ; goto set actions to nothing
; adjustable bound is not formal simple
; integer, x2=identno.
type1: al w0 30 ; kind(ident):=trouble (=30)
rl. w2 lastid. ;
hs w0 x2+1 ; outbyte trouble 406
jl. w3 err406. ;
jl. nextvar. ; goto take next var. in table
; mixing of zones and other thing in comm
type2: al w0 30 ; kind(commonname):=30
am. (lastid.) ;
hs w0 +1 ;
hs w0 x2+1 ; kind(common variable:=30)
jl. w3 err407. ; make erroractiom
jl. nextcha. ;
;zone without specification
specerr: al w0 30 ; kind(zone)= 30 = trouble
hs w0 x2+1 ;
jl. w3 err408. ; outbyte error code
jl. nextvar. ; go to next variable
; entry name is not local simple
doubentr: al w0 vanoper ; outbyte vanished operand
jl. w3 (outbyte.) ;
al w0 16 ; kind:=trouble=16
hs w0 x2+1 ;
jl. w3 err409. ;
al w0 endstm0 ; action on end statement:=
hs. w0 endstat. ; normal action
jl. nextbyt. ; goto read next input bute
err415: am 1 ;
err414: am 1 ;
err413: am 1 ;
err412: am 1 ;
err411: am 1 ;
err410: am 1 ;
err409: am 1 ;
err408: am 1 ;
err407: am 1 ;
err406: am 1 ;
err405: am 1 ;
err404: am 1 ;
err403: am 1 ;
err402: am 1 ;
err401: al w0 noerror ; outbyte error code
rs. w3 savew3b. ;
jl. w3 (outbyte.) ;
al w0 0 ;
jl. w3 (outbyte.) ; outbyte(0)
rl. w2 lastid. ;
jl. w3 getidno. ; outbyte(identno)
al w0 troubl ; outbyte trouble
jl. w3 (outbyte.) ;
jl. (savew3b.) ; return
\f
; rc 3.1.70 fortran, pass 4, page 35
; inputtable: tabel holding action addresses for bytes pass 4 had to
; make special actions on. is used when 0<input byte value<xx1.
; index is byte value. 1 byte pr byte value.
h.
intable: progtype - e0 ; dummy word
progtype - e0 ; logical function
progtype - e0 ; integer function
progtype - e0 ; real function
progtype - e0 ; long function
progtype - e0 ; double function
progtype - e0 ; complex function
progtype - e0 ; program
progtype - e0 ; subroutine
progtype - e0 ; function with implicit type
vartype - e0 ; logical
vartype - e0 ; integer
vartype - e0 ; real
vartype - e0 ; long
vartype - e0 ; double
vartype - e0 ; complex
implint - e0 ; implied integer
implreal - e0 ; implied real
implabel - e0 ; implied label
equival ; equivalence
comdecl - e0 ; common
dimdecl - e0 ; dimension
extern - e0 ; external
zonedecl - e0 ; zone
dimensin - e0 ; boundleft
boundr: dummy - e0 ; boundright, is set by dimensin
zone - e0 ; zoneleft
boundrz: endzone - e0 ; zoneright
nospecif - e0 ; no specification
possleft - e0 ; possible statementfunction left
posright - e0 ; possible statement function right
notstmf - e0 ; give up statementfunction
enddecl ; end declaration
endequiv ; end equivalence
entry - e0 ; entry
databyte: data - e0 ; data
output - e0 ; return
endunit - e0 ; end unit
endpass - e0 ; end pass
begunit - e0 ; begin unit
endline - e0 ; end line
endstat: output - e0 ; end statement set by endundef and end equiv
listelft: output - e0 ; liste left is set by endequiv
listrigh: copy1 -e0 ; liste right
output - e0 ; call
\f
;rc 3.1.70 fortran, pass 4, page 36
copy1 - e0 ; logical constant, 1 byte
intconst: copy2 - e0 ; integer constant, 2 bytes
copy4 - e0 ; real constant , 4 bytes
copy4 - e0 ; long constant, 4 bytes
copy8 - e0 ; double constant, 8 bytes
copy8 - e0 ; complex constant, 8 bytes
copy2 - e0 ; statement label, 2 bytes
copy2 - e0 ; format label 2 bytes
copy2 - e0 ; declare label, 2 bytes
format - e0 ; formats
output - e0 ; not used
copyx - e0 ; external identification, x bytes
trouble - e0 ; trouble, 3 bytes
copyone= cop1-e0
copytwo=cop2-e0
w.
; p0 routines
inbyte:0 ; abs address of the input-byte routine in p0
outbyte:0 ; abs address of the output-byte routine in p0
repinp:0 ; abs address of repeat-input-byte routine
linecnt:0 ; abs address of the carret routine in p0
; compute and set x2-rel for simpel
; local; x2=identnumber
locx2rel: rs. w3 savew3. ;
bl w0 x2 ; if type=0 then return
la. w0 cleardiv. ;
sn w0 0
jl. (savew3.) ;
al w1 x2 ; save identno
jl. w3 nextloc. ; w2:=next stackrel
hs w2 x1+2 ; set x2-rel in variable description
sh w0 2 ; if type < 3
jl. locx2ret. ; then return
jl. w3 nextloc. ; adjust x2-rel for long and real
sh w0 4 ; if type<5
jl. locx2ret. ; then return
jl. w3 nextloc. ; adjust x2-rel for double and complex
jl. w3 nextloc. ;
locx2ret: al w2 x1 ; w2= lastid
jl. (savew3.) ; return
nextloc: rl. w2 stackrel. ;
al w2 x2-2 ; w2 = stackrelative - 2
sh w2 -2048 ; if 2048 bytes occupied then
jl. stackfl. ; go to stack overflow
rs. w2 stackrel. ; stackrelative= w2
jl x3 ; return
\f
; rc 3.1.70 fortran, pass 4, page 37
; compute upper and lower index
; x2= identno
; w0-w1:=computing registers
; w2:=indexstep
; limit:=grænse
complim: bl w1 x2 ; typespec:=
la. w1 cleardiv. ; type(identifier)
hs. w1 typespec. ; limit:=
rl w2 x2+3 ; chain-5
al w1 x2-5
rs. w1 limit. ;
bl w1 x2-1 ; last index is in chain - 4
al w1 x1- 1
wm. w1 correct. ; - no of indices*correct
al w1 x1+6
ws w2 3 ;
al w0 x2-2 ;
rs. w0 adjwork. ; save for output of declaretion bytes
al w0 1 ; lowerix:=1
rs. w0 lowerix. ;
rl w1 x2 ; upperix:=length of last index
rs. w1 upperix. ;
; for i:=no of ix - 1 step -1 until 1 do
check: sh w1 0 ; if index(i+1) is adjustable bound
jl. adjbound. ; then goto set x2 rel
nextix: wa. w2 correct. ; correction of step limit
sl. w2 (limit.) ; check on steplimit
jl. endstep. ;
rl. w1 upperix. ; upperindex:=
wm w1 x2 ; upperindex*index(i)
wa w1 x2 ; + index(i)
rs. w1 upperix. ;
rl. w1 lowerix. ; lowerindex:=
wm w1 x2 ; lowerindex*index(i)
al w1 x1+1 ; + 1
rs. w1 lowerix. ;
rl w1 x2 ; w1:=index(i)
jl. check. ;
endstep: rl. w0 upperix. ; upperindex:=
bl. w1 typespec. ; upperindex*type
bl. w1 x1+typshift. ;
ls w0 x1 ;
rs. w0 upperix. ;
rl. w0 lowerix. ; lowerindex:=
ws. w0 const1. ; (lowerindex-1)*tyep)
ls w0 x1 ;
rs. w0 lowerix. ;
\f
; rc 3.1.70 fortran, pass 4, page 38
setlim: rl. w2 lastid. ; w2:=address of rest description
rl w2 x2+3 ;
rl. w1 upperix. ; set upperindex
rs w1 x2-3 ;
rl. w1 lowerix. ; set lowerindex in the description
rs w1 x2-5 ;
jl x3 ; goto the return address
adjbound: rs. w2 savew2. ;
rs. w3 savew3. ;
jl. w3 nextloc. ; w2:=next x2-relative
rs. w2 upperix. ; upperix:=x2-rel
jl. w3 nextloc. ; lowerix:=w2:=next x2-relative
rs. w2 lowerix. ;
rl. w2 savew2. ;
rl. w3 savew3. ;
lateradj: rl w1 x2-2 ; if type(adj bound) <> integer
rl w0 x1+1 ; if kind <> formal simple
la. w0 clear1. ; & type <> integer
se. w0 (check1.) ; then type error(406)
jl. type1. ;
bl w0 x1+2 ; index(i+1):=formalnumber for the adjustable
rs w0 x2-2 ; bound
aftadj: wa. w2 correct. ; get next index
sl. w2 (limit.) ; -check on step limit
jl. setlim. ; go to set limit
rl w1 x2 ; if index(i) is adjustable
sh w1 0 ;
jl. lateradj. ; go to later adjustable
jl. aftadj. ; go to after adjustable
; compute commonnumber and relative for
; the address given in w0
comadr: sh w0 -1 ; if commonnumber is < 0 then
jl. comneg. ; compute negative commonnumber
rl w1 1 ;
la. w1 clear. ; w1:=displacement//2**11*2**11
ws w0 3 ; w0:=rel=displacement-w1
ls w1 -11 ; w1:=commonno=w1//2**11
jl x3 ; goto returnaddress
comneg: ac w1 (1) ; displacement:=-displacement
al w0 x1-1 ; -1
rs. w3 savew3. ;
jl. w3 comadr. ; get commonnumber and relative
ac w3 (1) ; w3:=-relative
al w0 x3+1<11-1 ; w0:=2**11-1-relative
ac w1 x1+1 ; w1:=-commonnumber
jl. (savew3.) ; go to return
\f
; rc 3.1.70 fortran, pass 4, page 39
; compute real commonno and output identno
; length of common, commonno for first in
; fictive part and first in real part
transcom: rs. w3 savew3a. ; save return address
jl. w3 getidno. ; outbyte identifiernumber(w2)
rl w2 x2+3 ; w2:=address of equiv descr
rl w0 x2 ;
jl. w3 outword. ; outbyte(length of common)
rl. w0 comno. ; outbyte(comno for first in fict. part)
jl. w3 (outbyte.) ;
bl w0 x2-3 ; comno:=comno + no.of fictive parts
wa. w0 comno. ;
rl. w1 comno. ;
hs w1 x2-3 ; set comno for first in fictive part
rs. w0 comno. ;
jl. w3 (outbyte.) ; outbyte(comno for first in real part)
bl w0 x2-2 ; comno:=comno+no.of real parts
wa. w0 comno. ;
rl. w1 comno. ; set comno for first in real part
hs w1 x2-2 ;
rs. w0 comno. ;
rl. w1 noelem. ; no.of elements:=
al w1 x1+1 ; no.of elements + 1
rs. w1 noelem. ;
jl. (savew3a.) ; return
\f
; rc 3.1.70 fortran, pass 4, page 40
; outbyte(descrip.of zone), x2=address of
; rest descr of the zone
outzone: rs. w3 savew3a. ;
bl w0 x2-1 ; outbyte(no.of zones)
jl. w3 (outbyte.) ;
rl w0 x2-2 ; outbyte(bufferlength)
ls w0 -2 ;
jl. w3 outword. ;
rl w0 x2-4 ; no.of shares:=
ws. w0 descr. ; (descr length - zone descr)/
al w3 0 ; share length
wd. w0 share. ;
jl. w3 (outbyte.) ; outbyte(no.of shares)
rl w0 x2-6 ; outbyte(externalno)
jl. w3 (outbyte.) ;
jl. (savew3a.) ;
; outbyte(commonno), outbyte(real comno)
; for declare array and declare zone
; w2 = identifier
outcomno: rs. w3 savew3a. ;
rl w1 x2+5 ; w1:=address of com descr
rl w3 x1-1 ; w3:=address of common name
rl w3 x3+2 ; w3:=address of equiv descr in
bl w0 x3-2 ; common name
ba w0 x1-3 ; w0:=real commonno for elem
jl. w3 (outbyte.) ; outbyte(commonno)
bl w0 x1-2 ; outbyte(rel of start of arr(0))
jl. w3 (outbyte.) ;
jl. (savew3a.) ;
; output directing byte =
; kind<3 + type + 170, x2 = identno
direct: rs. w3 savew3b. ;
bl w0 x2+1 ; w0:=kind shift 3
ls w0 3 ;
bl w3 x2 ;
la. w3 cleardiv. ; w3:=type + 170
al w3 x3+170 ;
wa w0 6 ; w0:=kind<3 + type + 170
jl. w3 (outbyte.) ; outbyte(directing byte)
jl. (savew3b.) ;
direc=direct-e0
; outputs the word in w0 as two bytes
; the first is pos 0-11, the second is
; pos 12-23. w1 used for working.
outword: rs. w3 savew3. ;
rs.w0 savew1.
bl. w0 savew1.
jl. w3 (outbyte.)
bl. w0 savew1.+1
jl. w3 (outbyte.) ;
jl. (savew3.) ; return
\f
; rc 3.1.70 fortran, pass 4, page 40a
; transform address for identifier to
; the corresponding identifiernumber
; output the value. address in w2
getidno: rs. w3 savew3c. ;
rs. w1 savew1. ;
rl. w1 idbase. ;
ac w1 x1 ;
wa w1 5 ;
al w0 0 ; identno:=(x2-idbase) 6+xx2
wd. w1 const6. ;
al w0 x1+xx2 ;
jl. w3 (outbyte.) ;
rl. w1 savew1. ;
jl. (savew3c.) ;
outhead: rs. w3 savew3. ; save return address
jl. w3 getidno. ; outbyte identifiernumber
bl w0 x2+2 ; outbyte x2-rel
jl. w3 (outbyte.) ;
jl. (savew3.) ; return
; compute length in bytes
; of a variable
; w2 = identifier
typeleng: bl w1 x2 ;
la. w1 cleardiv. ;
bl. w1 x1+typshift. ;
bl. w1 x1+bytshift. ; w1 = no of bytes
jl x3 ; go to return
h.
typshift: 0,0,1,2 ; number os shifts of the variable
2,3,3 ; corresponding to the type
bytshift: 1,2,4,8 ; number of bytes corresponding
w.
; to shifts of the variable (typshift)
; test for place in stack
restdes4: al w0 x1-4 ; rest description = 4 bytes
stackpl: rs. w0 lastfrie. ;
sh. w0 (firstfri.);
jl. stackfl. ;
jl x3 ; go to return
\f
; rc 3.1.70 fortran, pass 4, page 41
; end declaration
; 1. compute upper and lower index in
; arrays, transform the description
; and generate the bytes declare for-
; mal array and formal zone.
base: ; 2. take care of common lists.
enddecl=k-e0 ;
al w0 enddecnw ;
jl. w3 (outbyte.) ; outbyte(end declaration)
rl. w2 idbase. ; for i:=1 step 1 until no of variables do
contin1: rs. w2 lastid. ; goto action(kind)
bl w1 x2+1 ;
ls w1 -1 ; action(2-6) = no action
bl. w1 x1+kindact1. ; action(8-10) = normal array
jl. x1+base. ; action(12) = formal array
nextvar: rl. w2 lastid. ;
al w2 x2+6 ; action(14-16)=normal zone
se. w2 (firstfri.) ; action(18) = formal zone
jl. contin1. ; action(20-26)= no action
al w0 endforma ; action(28)= external zone
jl. w3 (outbyte.) ; outbyte(end formal decl)
; look for common name
rl. w2 idbase. ; for i:=1 step 1 until no of variables do
contina: rs. w2 lastid. ;
bl w1 x2+1 ;
bl w0 x2 ;
sz. w0 (commontr.) ; if common troubel then
jl. comname. ; goto comname
so. w0 (datastm.) ; if databit on then
jl. notdata. ;
se w1 4 ; if kind<>4
sn w1 10 ; or kind<>10 then
jl. notdata. ;
la. w0 cleardat. ; clear data bit
hs w0 x2 ;
notdata: sn w1 26 ; if kind(i) = common name
jl. comname. ; then make the equivalence
nextvara: rl. w2 lastid. ; else take next variable
al w2 x2+6 ;
se. w2 (firstfri.) ;
jl. contina. ;
jl. nextbyt. ; goto get next inputbyte
\f
; rc 3.1.70 fortran, pass 4, page 42
; normal array. compute upper and lower index
normarr: al w1 2 ; correct:=2
rs. w1 correct. ;
jl. w3 complim. ; goto compute and set upper and
jl. nextvar. ; goto take next variable
; formal array. compute upper and lower index
formarr: al w1 4 ; correct:=4
rs. w1 correct. ;
jl. w3 complim. ; goto compute and set upper and
; lower index.
; output declare formal array
; w0:=outputbyte
; w1:=index in restdescription
; w2:=identno
rl. w2 lastid. ;
bl w0 x2 ; outbyte type of array
la. w0 cleardiv. ;
jl. w3 (outbyte.) ;
rl w1 x2+3 ;
bl w0 x1 ; outbyte x2-rel for base word
jl. w3 (outbyte.) ;
bl w0 x2+5 ; outbyte x2-rel for parameter
jl. w3 (outbyte.) ;
rl. w0 upperix. ; outbyte uppenindex
jl. w3 outword. ;
rl. w0 lowerix. ; outbyte lowerindex
jl. w3 outword. ;
bl w0 x1-1 ; outbyte no of indices
jl. w3 (outbyte.) ;
al w1 x1-6 ; for i:=1 step 1 until no of dimensions do
al w2 x1-1 ;
checkix: rl w0 x1 ; outbyte index(i)
jl. w3 outword. ;
rs w0 x2 ; clear parameter no
al w2 x2-1 ; in description
al w1 x1-2 ; get next word in the index description
sl. w1 (adjwork.) ;
jl. checkix. ;
rl. w2 lastid. ;
rl w1 x2+3 ;
bl w0 x1-1 ;
ls w0 2 ; compute no of bytes used for declare
wa. w0 const8. ; = no of indices*4+8
jl. w3 (outbyte.) ; outbyte number of bytes
al w0 dformarr ; outbyte declare formal array
jl. w3 (outbyte.) ;
jl. nextvar. ; goto take next variable.
\f
; fgs 1983.06.20 fortran, pass 4, page 43
; identifier is a not formal zone
normzone: rl w2 x2+3 ; x2:=address of restdescription
rl w1 x2-7 ; x1:=identno for errorprocedure
bl w0 x1+2 ; move externalno to restdescription
rs w0 x2-7 ; compute length of description
rl w1 x2-4 ; sharelength is in h6
wm. w1 share. ; descriptionlength is in h5
wa. w1 descr. ;
wa. w1 avail. ; length of available area is in h53
rs w1 x2-5 ; move length to description
rl w1 x2-2 ; buffer length in bytes=
ls w1 2 ; buffer length*4
rs w1 x2-2 ;
jl. nextvar. ; goto take next variable
; identifier is a formal zone
formzone: rl w3 x2+3 ; w3:= address of restdescription
rl w0 x3-1 ; w0:=no of zones
sl w0 0 ; if no of zones is a constant
jl. notadj. ; then goto declare formal zone
rl w1 x3-3 ; check adjustable bound. w1:=identno
rl w0 x1+1 ; if kind <> formal simple
la. w0 clear1. ; & type <> integer
se. w0 (check1.) ; then type error (406)
jl. type1. ;
bl w0 x1+2 ; set formalno in the restdescription
rs w0 x3-3 ;
; output declare formal zone
; w0:=outputbyte
; w1:=index in restdescription
; w2:=identifiernumber
notadj: rl. w2 lastid. ;
rl w1 x2+3 ;
bl w0 x1 ; outbyte x2-rel for base
jl. w3 (outbyte.) ;
bl w0 x2+5 ; outbyte x2-eel for param
jl. w3 (outbyte.) ;
bl w0 x1-1 ; outbytte no of zones
jl. w3 (outbyte.) ;
bl w0 x1-2 ; outbyte x2-rel for no of zones
jl. w3 (outbyte.) ;
al w0 dformzon ; outbyte declare formal zone
jl. w3 (outbyte.) ;
jl. nextvar. ; go to take next variable
;identifier is external zone
exterzon: bl w0 x2 ;
la. w0 cleardiv. ; if type<>external zone(7)
se w0 7 ;
jl. specerr. ; then error
bl w0 x2+4 ; outbyte(external number)
jl. w3 (outbyte.) ;
bl w0 (x2+3) ; outbyte(x2-rel for basis addr)
jl. w3 (outbyte.) ;
al w0 dextzone ; outbyte declare external zone
jl. w3 (outbyte.) ;
jl. nextvar. ; go to take next variable
\f
; rc 3.1.70 fortran, pass 4, page 44
; identifier is a commonname
comname: rs. w2 lastid. ; save identno
al w0 0 ; commonlength:=0
rs. w0 length. ;
rl w2 x2+5 ; w2:=identno for first in commonlist
bl w0 x2+1 ; w0:=kind for first in common list
hs. w0 lastkind. ;
nextname: rl w0 x2+5 ; save chain to next
rs. w0 lasticom. ; in common list
bl. w1 lastkind. ; if kind=30 then
sn w1 30 ;
jl. type2. ; go to error
bl w0 x2+1 ; w1:=kind of list element
sn w0 4 ; if kind = simple
jl. comsimp. ; then goto comsimp
sn w0 10 ; if kind = array
jl. comdim. ; then goto comm9ndimension
; variable is zone
se w1 16 ; if lastkind<>zoncommon
jl. type2. ; then type error
rl. w1 lastfrie. ; get area for description of the
rl. w0 lastid. ; equivalence, 3 word
rs w0 x1 ; set chain to common name
rs w1 x2+5 ; set address for the equivalence description
jl. w3 restdes4. ; make rest description
rl w1 x2+3 ; correct commonlength:
bl w0 x1-1 ; w0:=no of zones
sn w0 0 ; if no of zones = 0
al w0 1 ; length:=length+
rl w3 x1-4 ; no of zones*(length of descript
wa w3 x1-2 ; +bufferlength)
wm w0 6
rs. w0 length. ;
al w0 30 ;
hs. w0 lastkind. ; lastkind = 30
jl. nextcha. ; goto get next commonelement in list
\f
; rc 3.1.70 fortran, pass 4, page 45
; variable is common simpel
comsimp: rl. w0 lastkind. ;
rl. w0 lastid. ; set chain to commonname
rs w0 x2+5 ;
rl. w0 length. ; bytenumber in the common is set
rs w0 x2+3 ;
jl. w3 typeleng. ; commonlength = commonlength
sn w1 1 ; if logical then
al w1 x1+1 ; save place for a wod
wa w0 3 ; + length of the simpel variable
rs. w0 length. ;
jl. nextcha. ; goto get next common element in list
; variable is common array
comdim: rl. w0 lastkind. ;
rl. w1 lastfrie. ; get area for description of the
rs w1 x2+5 ; equivalence, 2 words
rl. w0 lastid. ;
rs w0 x1 ; set chain to the common name
rl. w0 length. ; set bytenumber in the common for
rs w0 x1-2 ; array(1,1,1)
rl w3 x2+3 ; commonlength:= commonlength+upperindex
wa w0 x3-2 ;
ws w0 x3-4 ; - lowerindex
rl w3 1 ; if commonlength is odd
sz w3 1 ; then commonlength =
al w3 x3+1 ; commonlength + 1
rs. w3 length. ;
jl. w3 restdes4. ; make rest description
; get next element in the common list
nextcha: bl w0 x2 ; equivalenced:=1
lo. loos. ;
hs w0 x2 ;
rl. w2 lasticom. ; w2:=address of the next identifier
se w2 0 ; if chain <> 0
jl. nextname. ; then goto next in common list
; end of a common
rl. w2 lastid. ; set vinderbit to 1
bl w0 x2 ;
lo. winn. ;
hs w0 x2 ;
rl. w1 lastfrie. ; get address for chain to equiv.
rs w1 x2+3 ; description, 2 words(w1)
rl. w3 length. ; set length of common
rs w3 x1 ;
jl. w3 restdes4. ; make rest description
jl. nextvara. ; goto take next variable
\f
; rc 3.1.70 fortran, pass 4, page 46
; end equivalence
; 1. compute x2-rel for local
; simpel winner, declare local
; array not looser, compute
; real parts for commons
; find kind of loosers
; 2. compute relative commonno and commenrel for
; for common variables.
;, declare local array for looser and local
; zone for not looser.
; 3. compute real commonno for normal com-
; monlist and generate the byte normal
; commonlist.
; 4. compute real commonno for zone common
; list and generate the byte zone common
; list
; 5. transform kind and declare common array
; and common zone.
; 6. generate the byte datalist.
endequiv = k-e0 ;
al w0 0 ; w2:= index in identifiertable
rs. w0 arrbase. ;
rl. w2 idbase. ; for i:= 1 step 1 until no of variables do
contin0: rs. w2 lastid. ;;
bl w1 x2+1 ;
sn w1 2 ; if kind = simpel local (2) than
jl. simploc. ; action for simpel local not looser
sn w1 8 ; if kind = array local (8) then
jl. arrloc. ; action for array local not looser
sn w1 26 ; if kind= common (26) then
jl. comm. ; compute real part of commen
sn w1 32 ; if kind = simp eq array then
jl. simeqdim. ; find kind of simpel
nextvar0: rl. w2 lastid. ;
al w2 x2+6 ;
se. w2 (firstfri.);
jl. contin0. ;
rl. w2 idbase. ; for i:=1 step 1 until no of variables do
contin2: rs. w2 lastid. ;
bl w1 x2+1 ; goto action(kind)
ls w1 -1 ;
rs. w2 lastid. ; save identno
bl. w1 x1+kindact2. ;
jl. x1+base. ;
nextvar1: rl. w2 lastid. ; reset identno
al w2 x2+6 ; identno:=identno+1
se. w2 (firstfri.) ; if identno < no of identifiers
jl. contin2. ; then goto continue.
; compute real commonno for normal commonlist
al w0 0 ;
rs. w0 noelem. ; no of elements in common:=0
rl. w2 idbase. ;
contin3: rs. w2 lastid. ; save identno
bl w1 x2+1 ;
sn w1 4 ; if kind=4 or
jl. comtest. ;
se w1 10 ; kind=10 or
sn w1 16 ; kind=16 then
jl. comtest. ; goto commontest
se w1 26 ; if kind<>commonname(26)
jl. nextvar3. ; then take next variable
rl w1 x2+5 ; if kind(first in commonlist)=
bl w1 x1+1 ; zonecommon(16)
se w1 16 ; then goto take next variable
jl. w3 transcom. ; compute real commonnumber
\f
; rc 4.6.70 fortran, pass 4, page 47
nextvar3: rl. w2 lastid. ; reset identno
al w2 x2+6 ; identno:=identno+1
se. w2 (firstfri.) ; if identno < no of identifiers
jl. contin3. ; then goto continue
rl. w0 noelem. ; outbyte number of commons
jl. w3 (outbyte.) ;
rl. w1 noelem. ; outbyte number of bytes in the byte
wm. w1 const5. ; = no of commons*5 + 1
al w0 x1+1 ;
jl. w3 (outbyte.) ;
al w0 almcom ; outbyte alm common list
jl. w3 (outbyte.) ;
\f
; rc 3.1.70 fortran, pass 4, page 48
; for i:=1 step 1 until no.of variables
; compute real comno for zone common name
; output(zone common list)
al w0 0 ;
rs. w0 noelem. ; no.of elements:=
rs. w0 nobytes. ; no.of bytes:=0
rl. w2 idbase. ; w2:=index in identifier table
contin4: rs. w2 lastid. ;
bl w1 x2+1 ; for i:=1 step 1 until no.of variables
se w1 26 ; do if kind <> common name (26)
jl. nextvar4. ; then take next variable
rl w1 x2+5 ; if kind(first in common list) <>
bl w1 x1+1 ; zone common (16) then take next
se w1 16 ; variable
jl. nextvar4. ;
jl. w3 transcom. ; compute real comno and output
rl. w2 lastid.
rl w2 x2+5 ; w2:=first in comlist
rl w2 x2+3 ; w2:=address of zone description
jl. w3 outzone. ; outbyte description of zone
al w1 10 ;no of bytes = no of bytes + 10
wa. w1 nobytes. ;
rs. w1 nobytes. ;
nextvar4: rl. w2 lastid. ; identno:=identno + 1
al w2 x2+6 ; if not last identifier
se. w2 (firstfri.); then continue
jl. contin4. ;
\f
; rc 3.1.70 fortran, pass 4, page 49
rl. w0 noelem. ; outbyte(no.of zone commons)
jl. w3 (outbyte.) ;
rl. w1 nobytes. ; outbyte(no.of bytes)
al w0 x1+1 ;
jl. w3 (outbyte.) ;
al w0 zoncom ; outbyte(zone common list)
jl. w3 (outbyte.) ;
; for i:=1 step 1 until no.of variables do
; transform kind
; set correct commonno
; declare common array and zone
rl. w2 idbase. ; w2:=index in identifier table
contin5: rs. w2 lastid. ;
bl w1 x2+1 ; make actions on kind
sn w1 4 ; 4
jl. simplcom. ;
se w1 10 ; 10
sn w1 16 ; 16
jl. arzoncom. ;
nextvar5: rl. w2 lastid. ; newkind:=trankind(old kind)
bl w1 x2+1 ;
ls w1 -1 ;
bl. w1 x1+newkind. ;
hs w1 x2+1 ;
al w2 x2+6 ; identno:=identno + 1
se. w2 (firstfri.); if identno < no.of identifiers
jl. contin5. ; then goto take next variable
; for i:=1 step 1 until no.of variables
; do
al w0 0 ; if in data then outbyte
rs. w0 nobytes. ; no.of bytes:=0
rs. w0 noelem. ; no.of elements:=0
rl. w2 idbase. ;
contin6: rs. w2 lastid. ; w2:=index in identifier table
bl w1 x2 ; if varialbe not in data
so. w1 (datastm.) ; then goto next varialbe
jl. nextvar6. ;
bl w1 x2+1 ; if kind = trouble (16)
sn w1 16 ;
jl. nextvar6. ; then goto next variable
jl. w3 getidno. ; outbyte identnummer(w2)
rl. w3 noelem. ; no.of elements:=
al w3 x3+1 ; no.of elements + 1
rs. w3 noelem. ;
se w1 2 ; if kind <> simpel (2) then goto array
jl. array. ;
jl. w3 simpcomd. ; outbyte(descr of simp common)
rl. w3 nobytes. ; no.of bytes:=
al w3 x3+4 ; no.of bytes + 4
rs. w3 nobytes.
jl. nextvar6. ; goto next variable
array: rl w1 x2+3 ; w1=restdescription
rl w0 x1-3 ; compute length of array
ws w0 x1-5 ; =(upperix-lowerix)/type
bl w1 x2 ;
la. w1 cleardiv. ;
bl. w1 x1+typshift. ;
ac w1 x1 ;
ls w0 x1 ;
jl. w3 outword. ; outbyte (length of array)
jl. w3 arraydes. ; outbyte(descr of array)
rl. w1 bytes. ;
al w1 x1+5 ;
wa. w1 nobytes. ; no.of bytes:=
rs. w1 nobytes. ; no.of bytes + w1
nextvar6: rl. w2 lastid. ;
al w2 x2+6 ; identno:=identno + 1
se. w2 (firstfri.); if identno < no.of identifiers
jl. contin6. ; then take next variable
\f
; rc 24.2.72 fortran, pass 4, page 50
rl. w0 noelem. ; outbyte(no.of identifiers in
jl. w3 (outbyte.) ; datalist)
rl. w1 nobytes. ; outbyte(no.of bytes in the descr)
al w0 x1+1 ;
jl. w3 (outbyte.) ;
al w0 datalist ; outbyte(data list)
jl. w3 (outbyte.) ;
rl. w1 prstep. ; identifier action:=
rs. w1 identact. ; in program part
al w0 endstm0 ; set end statement action
hs. w0 endstat. ; in program part
al w0 listlft ; -set liste left action
hs. w0 listelft. ; in program part
al w0 copyone ; reset liste right
hs. w0 listrigh. ; action
al w0 copytwo ; reset integer
hs. w0 intconst. ; constant action
al w0 1 ; state := in program part (=1)
hs. w0 state. ;
jl. nextbyt. ; goto read next input byte
; variable(i) is simpel local, not equi-
; valenced. compute x2-relative for the
; variable.
simploc: al w0 0 ; displace = 0
rs. w0 displace. ;
bl w0 x2 ;
sz. w0 (loos.) ; if variable is looser
jl. w3 simwin. ; then find new kind
so. w0 (winn.) ; if identifier not equiv.
jl. nextvar0. ; then go to next identifier
jl. w3 locx2rel. ; get x2-rel for simpel
jl. nextvar0. ; goto next variable
; variable(i) is simple common, compute
; comno and comrel
simpcom: jl. w3 typeleng. ; w1 = no of bytes for the identifier
se w1 1 ; if logical place a word
al w1 x1-1
wa w1 x2+3 ; w1:=displacement + type
al w0 x1 ;
jl. w3 comadr. ; w0:=rel; w1:=comno
hs w1 x2+2 ;
hs w0 x2+3 ;
jl. nextvar1. ; goto next variable
\f
; rc 3.1.70 fortran, pass 4, page 51
; variable(i) is array local, not equi-
; valenced. generate declare local array
arrloc: bl w0 x2 ; if equivalenced then goto next variable
sz. w0 (loos.) ;
jl. alooser. ;
rl w2 x2+3 ; w2:=address of rest descr
bl w0 x2 ; outbyte(x2-rel for baseword)
jl. w3 (outbyte.) ;
rl. w0 arrbase. ; outbyte(address of array(0,0,...)
ws w0 x2-5 ; rel to array base =
jl. w3 outword. ; array base + lowerix)
al w0 dlocarr ; outbyte(declare local array)
jl. w3 (outbyte.) ;
rl. w1 lastid. ; if array is winner
bl w0 x1 ; then goto vinder
sz. w0 (winn.) ;
jl. winner. ;
rl. w3 arrbase. ; array base:=
wa w3 x2-2 ; array base - upperix + lowerix
ws w3 x2-4 ;
sz w3 1 ; if arrbase is odd then
al w3 x3+1 ; arrbase = arrbase + 1
rs. w3 arrbase. ;
jl. nextvar0. ; goto next variable
winner: rl. w2 arrbase. ; array is a winner:
rl. w0 arrbase. ; array base:= array base +
wa w0 x1+5 ; length of area
rs. w0 arrbase. ;
rs w2 x1+5 ; save arrbase for winner
jl. nextvar0. ; goto next variable
; variable is make evt new
; description of variable
alooser: al w0 0 ; displace = 0
rs. w0 displace. ;
jl. w3 getarrwi. ;
jl. nextvar0. ;
comm: rl w1 x2+3 ; w1 = rest description
rl w3 x1 ;
al w3 x3-1 ;
ls w3 -11 ; compute no of common parts
al w3 x3+1 ; = (length-1)/2**11+1
hs w3 x1-2 ;
jl. nextvar0. ;
; variable is simpel equivalenced
; to dimension
simeqdim: rl w0 x2+3 ;
rs. w0 displace. ;
rl w2 x2+5 ;
jl. w3 simparra. ; get new kind and displace
jl. nextvar0. ;
\f
; rc 4.6.70 fortran, pass 4, page 52
; variable is simpel local
simloclo: bl w1 x2 ;
so. w1 (loos.) ; if variable not looser
jl. nextvar1. ; then go to next variable
jl. w3 typeleng. ; w1 = length of looser
rl w3 x2+5 ; w3 = winner
ws w1 x3+5 ;
bl w3 x3+2 ; x2-rel for looser =
wa w3 3 ; x2-rel for winner -(length
hs w3 x2+2 ; of winner-length of looser)
jl. nextvar1. ; go to next variable
\f
; rc.4.6.70 fortran,pass 4,page 53
; variable is array local
arrloclo: bl w1 x2 ;
so. w1 (loos.) ; if variable not looser
jl. nextvar1. ; then go to next variable
rl w1 x2+3 ; w1 = rest description
bl w0 x1 ;
jl. w3 (outbyte.) ; outbyte(x2-rel for baseword)
rl w2 x2+5 ; w2 = equivalence rest
rl w0 x2-2 ; outbyte(addressof array(0,0..0)
ws w0 x1-5 ; rel to arrbase =
rl w2 x2 ; arraybase of winner +
wa w0 x2+5 ; displacement - lowerix)
jl. w3 outword. ;
al w0 dlocarr ;
jl. w3 (outbyte.) ; outbyte(declare local array)
jl. nextvar1. ; go to next variable
; variable (i) is a common array name.
; compute comno and comrelfor arr(0,0 ...)
arrcom: rl w1 x2+5 ; w0:=displacement for arr(0)
rl w0 x1-2 ; =displacement arr(1)-lowerix-1
rl w1 x2+3
rl w1 x1-4
al w1 x1+1
ws w0 3
rl w2 x2+ 5
jl. w3 comadr. ; w0:=rel, w1:=comno
checkno: hs w0 x2-2 ;
hs w1 x2-3 ;
rl w3 x2 ; w3 =common name
sl w1 0 ; if comno > 0
jl. nextvar1. ; then goto next variable
ac w1 x1 ; w1:=abs(comno)
rl w3 x3+3 ; w3:=addr of descr of length
bl w0 x3-3 ; w0:=no.of fictive parts
sh w0 x1 ; if no.of fictive parts < comno
hs w1 x3-3 ; then no.of fictive parts:=comno
jl. nextvar1. ; goto next variable
\f
; rc 28.03.73 fortran, pass 4, page 54
; varialbe(i) is local zone. generate
; declare local zone
zonloc: rl w2 x2+3 ; w2:=address of rest descr
bl w0 x2 ;
jl. w3 (outbyte.) ; outbyte(x2-rel for baseword)
rl. w1 arrbase. ;
al w0 x1+recbasel+1; w0:=record base
bl w1 x2-1 ;
rs. w1 zonno. ;
se w1 0 ; if no.of zones > 0 then
ws. w0 descr. ;
jl. w3 outword. ; outbyte(record base)
jl. w3 outzone. ; outbyte description of zone
al w0 dloczone ;
jl. w3 (outbyte.) ; outbyte(declare local zone)
rl w1 x2-4 ; zone length:=
wa w1 x2-2 ; (buffer length +
rl. w0 zonno. ; length of descr)
se w0 0 ; *(if no.of zones > 0 then
wm. w1 zonno. ; no.of zones else 1)
wa. w1 arrbase. ; array base:=array base + zone length
rs. w1 arrbase. ;
jl. nextvar1. ; goto next variable
; variable(i) is zonecommon. compute
; commonno and relative for record base
zoncommn: rl w1 x2+5 ; w1:=address of equiv descr
rl w2 x2+3 ; w2:=address of rest descr
rl w0 x1-2 ; w0:=displ of descr(1)
wa. w0 recbase. ; w0:=displacement of record base
bl w3 x2-1 ; if no.of zones > 0
se w3 0 ; then w0:=w0-length of full descr
ws. w0 descr. ;
rs. w1 savew1. ; w0:=rel in common
jl. w3 comadr. ; w1:=commonno
rl. w2 savew1. ;
jl. checkno. ; go to set and check comno
; simpel equivalenced to array
dimeqsim: rl w0 x2+3 ;
jl. w3 typeleng. ;
wa w0 3 ;
rl w1 x2+5 ; index =
rl w1 x1+3 ; displacement + lowerix + type length
wa w0 x1-5 ;
rs w0 x2+3 ;
bl w0 x1 ;
hs w0 x2+4 ; get x2-rel for base
jl. nextvar1. ; go to next variable
; simpel equiv. to zone
zoneqsim: rl w0 x2+3 ;
jl. w3 typeleng. ; zone record =
wa w0 3 ; displacement + typelength
rs w0 x2+3 ;
rl w2 x2+5 ; w2 = equivalence rest
jl. setx2rel. ;
; array equivalenced to zone
zoneqarr: rl w3 x2+3 ; w3 = rest description
rl w2 x2+5 ; displace = record(0) -
rl w1 x2-3 ;
ws w1 x3-5 ; array(0,0,..,0) =
rs w1 x2-3 ; displacement - lowerrix
setx2rel: bl w0 x2-1 ; if simpel equiv. to zone
sn w0 0 ; and x2-rel set before
jl. nextvar1. ; then go to next variable
rl w1 x2 ;
rl w1 x1+3 ; get x2-rel for zone base
bz w0 x1 ;
rs w0 x2 ;
jl. nextvar1. ;
\f
; rc 3.1.70 fortran, pass 4, page 55
; simpel common, set correct commonno.
simplcom: rl w1 x2+5 ; comno:=
rl w1 x1+3 ; comno for first in real part
bl w1 x1-2 ; +comno
ba w1 x2+2 ;
hs w1 x2+2 ;
jl. nextvar5. ; goto take next variable
; array common, output declare common arr
; zone common, declare common zone
arzoncom: bl w0 (x2+2) ; outbyte(x2-rel for baseword)
jl. w3 (outbyte.) ;
jl. w3 outcomno. ; outbyte(comno, comrel)
bl w1 x2+1 ; if kind = 10 then
al w0 dcomarr ; outbyte(declare common array)
sn w1 16 ; if kind = 16 then
al w0 dzoncom ; outbyte(declare common zone)
jl. w3 (outbyte.) ;
jl. nextvar5. ; goto take next variable
comtest: rl w3 x2+5 ;
se w1 4 ; get common address
rl w3 x3 ;
bl w3 x3+1 ;
al w0 30 ;
sn w3 30 ; if kind of common=30 then
hs w0 x2+1 ; kind fo common variable=30
jl. nextvar3. ; go to next variable
\f
; fgs 1983.06.20 fortran,pass 4, page 57
; work variables for equivalence
lasteq:0 ; address of last equivalenced variable
lastdisp:0 ; displacement for last equivalenced variable
displace:0 ; displacement for actual equivalenced variable
zonedisp:0 ; zonedescriptor displacement
multrang:0 ; product of ranges
range:0 ; range of index
indexnum:0 ; number of indices in equivalence statements
winn: 2.010000000000 ; to get the bit winner in equivalence
loos: 2.100000000000 ; to get the bit looser inequivalence
clearwin: 2.101111111111 ; to clear the bit winner
cleardi: 2.000000001111 ; to get the type from the identifier
constan4: 4 ; the constant 4
constan6: 6 ; the constant 6
share: sharel ; length of sharedescriptors
descr: descripl ; length of zonedescriptors
avail: availzar ; length of available area in front of zbuffer
lim:0 ; array lim
upper:0 ; place for upperixfor array
lower:0 ; place for lowerix for array
lastiden:0 ; address of place for lastident
lastfri:0 ; address of place for lastfire byte
savew3eq:0 ; work
savew3q:0 ; work
idst: ; stepping stones
lastbyt: ;
arrayidx: jl. arrindex. ;
arrayrig: jl. aright. ;
nextb: jl. nextbyt. ; stepping stone
equival=k-e0
; equivalence
al w0 0 ;
rs. w0 lasteq. ; lastequivalenced=0
al w0 indtrou ; set error action in
hs. w0 listelft. ; liste left
al. w0 equivar. ; identifier action=
rs. w0 identact. ; equivalenced variable
jl. nextb. ;
equivar: bl w1 x2+1 ;
ls w1 -1 ;
bl. w1 x1+eqaction. ; go to action on kind
jl. x1+base. ; for equivalenced variable
; errors in equivalence
equiverr: jl. w3 err411. ; equivalence is impossible
jl. errorac. ; go to error action
indtroub: jl. w3 err412. ; index missing for array or zone
jl. w3 (repinp.) ; repeat input byte
jl. errorac. ; or it exists for simpel
indexerr: jl. w3 err413. ; index error for array
jl. errorac. ; go to error action
arzonerr: jl. w3 err414. ; array can not be equiv to zone
jl. errorac. ; go to error action
arcomerr: jl. w3 err415. ; array can not be equiv to comm
errorac: al. w0 nextb. ;
am. intable. ; identifier action = no action
rs w0 identact-intable ;
al w0 deleteix ;
hs. w0 intconst. ; integer action = nothing
al w0 nextby ;
hs. w0 listelft. ; liste left and liste right
hs. w0 listrigh. ; action = nothing
jl. nextb. ; go to read next byte
nextby = nextbyt-e0
\f
; rc 4.6.70 fortran, pass 4, page 58
;equivalenced variable
; is not referenced
notrefeq: jl. w3 (inbyte.) ; read implicit type
al w1 x2-14 ; type=implicit type -14
rl. w2 (lastiden.) ;
al w0 2 ;
hs w0 x2+1 ; set kind to simpel local
jl. simpwinn. ; make simpel winner
; equivalenced variable
; is simpel
simpeleq: al w0 0 ;
rs. w0 displace. ; displacement=0
bl w1 x2 ;
sz. w1 (winn. ) ; if variable is winner
jl. equiv. ; then make the equivalence
so. w1 (loos.) ; if variable not equivalenced
jl. simpwinn. ; before make it winner
jl. w3 simwin. ; if looser then get winner
jl. equiv. ; go to make equivalence
; equivalenced variable is
; simpel common
simcomeq: rl w0 x2+3 ; displace =
rs. w0 displace. ; displacement in common
rl w2 x2+5 ; w2 = common
jl. equiv. ; go to make equivalence
; equivalenced variable is
; dimension local
arrayeq: al w0 arigh ; set liste right action
hs. w0 listrigh. ;
al w0 arrindx ; set integer constant action
hs. w0 intconst. ; to array index action
al w1 listleft ;
jl. w3 readbyte. ; read byte liste left
rl. w2 (lastiden.) ;
rl w2 x2+3 ; w2= rest description
bl w1 x2-1 ;
al w1 x1-1 ; test lim=
ls w1 1 ; (no of index-1)*2+6
wa. w1 constan6. ;
al w3 x2 ;
ws w3 3 ;
rs. w3 lim. ;
al w1 0 ;
rs. w1 indexnum. ; number of indices := 0
al w1 1 ;
rs. w1 multrang. ; multiple range=1
rl w1 x2-3 ;
rs. w1 upper. ; get upperix
rl w1 x2-5 ;
rs. w1 lower. ; get lowerix
al w1 x2-4 ;
rs. w1 range. ; range = addr of first index - 2
jl. nextb. ; go to next input byte
\f
; rc 4.6.70 fortran, pass 4,page 59
; array index
arrindex: jl. w3 readindx. ; read array index(i)=w0
rl. w1 indexnum. ;
al w1 x1+1 ;
rs. w1 indexnum. ; increase number of indices
simindex: rl. w1 multrang. ;
sn w1 1 ; if first index then jump
jl. firstind. ;
wm w0 3 ;
rl. w1 displace. ; displacement=displace
wa w0 3 ; +index(i)*multrang
firstind: rs. w0 displace. ;
rl. w1 range. ;
al w1 x1-2 ; range=rangeof index(i)
rs. w1 range. ;
rl. w0 multrang. ;
rl. w2 (range.) ; multrange= multrange
wm w0 5 ; * range of index(i-1)
rs. w0 multrang. ;
jl. nextb. ;
; right list after array index
aright: rl. w0 range. ;
se. w0 (lim.) ; if not right no of indices
jl. checkdim. ; go to check dimension
rl. w0 displace. ;
rl. w2 (lastiden.) ; w2= identifier
bl w1 x2 ;
la. w1 cleardi. ;
bl. w1 x1+typshift. ; displacement
ls w0 x1 ; displacement*type
sh. w0 (upper. ) ; if displacement> upperix
sh. w0 (lower. ) ; or displacement<lowerix
jl. indexerr. ; go to index error
ws. w0 lower. ; displace = index in bytes
bl. w1 x1+bytshift. ;
ws w0 3 ;
rs. w0 displace. ; from array(1,1,....,1)
rs. w0 range. ; save index displacement
bl w1 x2 ;
sz. w1 (winn. ) ; if array is winner
jl. equiv. ; then make the equivalence
so. w1 (loos.) ; if not equivalenced before
jl. arrwinn. ; make array winner
jl. w3 getarrwi. ; if looser then get winner
rl w0 x1-2 ; displacement of array(1.1..)
ws. w0 range. ; = displace - index displace
rs w0 x1-2 ;
jl. equiv. ; make the equivalence
checkdim: rl. w0 indexnum. ;
se w0 1 ; if number of indices <> 1 then
jl. indexerr. ; goto index error
jl. w3 (repinp.) ;
jl. simindex. ; w0=1; goto simulate index
\f
; rc 4.6.70 fortran, pass 4, page 60
; equivalenced variable was zone
zoneeq: al w1 listleft ;
jl. w3 readbyte. ; read byte liste left
al w1 integcon ;
jl. w3 readbyte. ; read byte integer constant
al w0 0 ;
rs. w0 zonedisp. ; zonedisplacement=0
rl. w2 (lastiden.) ;
rl w3 x2+3 ;
bl w0 x3-1 ; if no of zones = 0 tjen
sn w0 0 ;
jl. onedim. ; go to one dimension zone
rs. w0 savew3q. ;
jl. w3 readindx. ; wo=read zone index
sh. w0 (savew3q.) ; if zone index> no of zones
sh w0 0 ; orzone index < 0 then
jl. indexerr. ; go to index error
wm. w0 descr. ; zonedescriptor displacement=
rs. w0 zonedisp. ; zoneindex*length of descriptors
jl. w3 readbyte. ; read byte integer constant
onedim: jl. w3 readindx. ; w0= read record index
ls w0 2 ;=
al w1 listrigt ;
jl. w3 readbyte. ; read byte liste right
rl. w2 (lastiden.) ;
rl w1 x2+3 ; if record index>
sh w0 (x1-3) ; buffer length then
sh w0 0 ;
jl. indexerr. ; index error
ws. w0 constan4. ; displacement=(displacement-1)
rs. w0 displace. ; * type
bl w1 x2 ; if identifier is not
so. w1 (loos.) ; looser then
lo. w1 winn. ; make it winner
hs w1 x2 ;
jl. equiv. ; make the equivalence
; equivalenced variable is
; simpel equival to array
simarreq: rl w0 x2+3 ;
rs. w0 displace. ;
rl w2 x2+5 ; w2= address of array
jl. w3 simparra. ; get winner for array
jl. equiv. ; make the equivalence
; equivalenced variable is
; simpel equival to zone
simzoneq: rl w0 x2+3 ;
rs. w0 displace. ;
rl w2 x2+5 ; w2=equivalence rest
rl w0 x2-2 ; get zonedescriptor displace
rs. w0 zonedisp. ;
rl w2 x2 ; w2 = address of zone
jl. equiv. ; make the equivalence
\f
; rc 4.6.70 fortran, pass 4, page 60a
; read byte in equivalence mode
; for array or zone
readbyte: rs. w3 savew3eq. ; w1 = wanted byte
repread: jl. w3 (inbyte.) ; if input byte = wanted byte
sn w2 x1 ; then return
jl. (savew3eq.);
se w2 endlin ; if input byte <> end line
jl. indtroub. ; then trouble
jl. w3 (linecnt.) ; outbyte(new line)
al w0 x2 ;
jl. w3 (outbyte.) ;
jl. repread. ; go to read next byte
\f
; rc 4.6.70 fortran, pass 4, page 61
; make a simpel local winner
simpwinn: lo. w1 winn. ; w2 = identifier, w1= type
al w1 x1+1<9 ; explicit referenced = 1
hs w1 x2 ; set winner bit
jl. w3 typeleng. ;
sn w1 1 ; if variable is logical
jl. equiverr. ; then error
rs w1 x2+5 ; set length of variable in bytes
jl. equiv. ; go to make the equivalence
; make dim local winner
; w2 = identifier, w1 = type
arrwinn: lo. w1 winn. ;
hs w1 x2 ; set winner bit
rl. w1 upper. ;
ws. w1 lower. ; length of array in bytes
rs w1 x2+5 ; = upperix- lowerix
jl. w3 typeleng. ;
sn w1 1 ; if type = logical then
jl. equiverr. ; equivalence error
jl. equiv. ; goto make the equivalence
; read index in equivalence statement
readindx: rs. w3 savew3eq. ; save return address
al w0 vanoper ;
jl. w3 (outbyte.) ; outbyte vanished operand
jl. w3 (inbyte.) ; read integer constant
hs w2 0 ; w0 = index
jl. w3 (inbyte.) ;
hs w2 1 ;
jl. (savew3eq.) ; go to return
; make simpel local looser
simploos: bl w0 x2 ; w2 = simpel, w1 = winner
la. w0 clearwin. ; clear winner bit
lo. w0 loos. ; set looser bit
hs w0 x2 ;
rs w1 x2+5 ; set reference to winner
rl. w0 lastdisp. ;
rs w0 x2+3 ; set displacement in simpel
rs. w1 lasteq. ; set lastequiv to winner
jl x3 ; go to return
; make local array looser
arrloos: rs. w3 savew3eq. ; w2 = array, w1 = winner
bl w0 x2 ;
la. w0 clearwin. ; clear winner bit
lo. w0 loos. ; set looser bit
hs w0 x2 ;
rl. w3 (lastfri.) ;
rs w3 x2+5 ; set chain to equival rest
al w0 x3-6
rs. w3 savew3q. ; lastfrie = lastfrie - 6
jl. w3 stackpl. ; test for place instack
rl. w3 savew3q. ;
rs w1 x3 ; set chain to winner
rl. w0 displace. ; set displacement
rs w0 x3-2 ;
rs. w1 lasteq. ; set winner in last equival
jl. (savew3eq.) ; go to return
\f
; rc 4.6.70 fortran, pass 4, page 62
; a variable in an equivalence
; statement is read
equiv: rl. w1 lasteq. ;
se w1 0 ;if second in an equivalence
jl. makeeq. ; then make the equivalence
rs. w2 lasteq. ; last equivalenced=variable
rl. w1 displace. ; last displacement=
rs. w1 lastdisp. ; displacement
jl. nextb. ; go to next input byte
; w1=lasteq, w2=lastid
makeeq: rs. w2 (lastiden.); set winner in lastidentifier
sn. w2 (lasteq.) ; iflasteq=lastid then
jl. equiverr. ; go to equivalence error
bl w0 x2+1 ; if kind of 2. variable>
bl w3 x1+1 ;
sh w0 (7) ; kind of 1. variable then
jl. nochange. ;
bl w0 x1+1 ;
rl. w1 displace. ; set displace= lastdisplace
rl. w2 lastdisp. ; last displace = displace
rs. w1 lastdisp. ;
rs. w2 displace. ;
rl. w1 (lastiden.) ; w1 = winner
rl. w2 lasteq. ; w2 = looser
nochange: sl w0 14 ; if kind of looser>= kind of
jl. equiverr. ; zone then equivalence error
bl w3 x1+1 ; w3= kind of winner w0 = kind of looser
sl w0 8 ; if looser is an array then
al w3 x3+1 ;kind of winner= kind of winner+1
bl. w3 x3+eqtable. ;
jl. x3+base. ; go to equivalence action
; simpel local equivalenced to
; simpel local
; w1= 1. variable, w2= 2. variable
simeqsim: rl w0 x1+5 ;
sl w0 (x2+5) ; if length of 1. var< length
jl. makeloos. ; of 2. var then change w1 and w2
rl. w1 (lastiden.) ; 1.var = w1= winner
rl. w2 lasteq. ; 2. var = w2 = looser
makeloos: jl. w3 simploos. ; set simpel local to looser
jl. nextb. ; go to read next input byte
; simpel local equivalenced to
; dimension local
; w1=dim local (winner)
; w2= simpel local (looser)
simeqarr: rl w0 x2+5 ;
wa. w0 lastdisp. ; if length of array <
sl w0 (x1+5) ; index+length of simpel
rs w0 x1+5 ; then length of array=new length
al w0 32 ; set kind of simpel to
hs w0 x2+1 ; simpel equival to array (32)
jl. w3 simploos. ; make simpel looser
jl. nextb. ; go to next input byte
\f
; rc 4.6 70 fortran, pass 4, page 63
; simpel local equivalenced to
; local or common zone
; w1 = zone (winner)
; w2 = simpel local (looser)
simeqzon: jl. w3 simploos. ; set simpel to looser
al w0 34 ; set kind of simpel to
hs w0 x2+1 ; simpel equivalenced to zone
rl. w3 (lastfri.) ; make equivalence rest
rs w3 x2+5 ; for looser two words
rs w1 x3 ; set chain to winner
rl. w0 zonedisp. ;
rs w0 x3-3 ; set zonedescriptor displace
al w1 x3 ;
jl. w3 restdes4. ; make restdescription
jl. nextb. ; go to read next byte
; simpel equivalenced to common
; w1 = common (winner)
; w2 = simpel local (looser)
simeqcom: rl w0 x2+5 ;
wa. w0 lastdisp. ;
rl w3 x1+3 ; if length of common < length
sl w0 (x3) ; of simpel + displacement
rs w0 x3 ; then new length of common
al w0 4 ; set kind of simpel local
hs w0 x2+1 ; to simpel common (4)
jl. w3 simploos. ; make simpel looser
jl. nextb. ; go to read next input byte
; dim local equivalenced to
; dimension local
; w1 = 1. dim, w2= 2. dim
arreqarr: rl. w3 lastdisp. ;displace=displace from
ws. w3 displace. ; 1. array(1,..,1) to 2. array(1..1)
sl w3 0 ;if displace < 0 then
jl. setloos. ;
ac w3 x3 ; displace = -displace
rl. w0 displace. ;set displacement of winner
rs. w0 lastdisp. ; in last displacement
rl. w1 (lastiden.) ; w1 = winner
rl. w2 lasteq. ; w2 = looser
setloos: rs. w3 displace. ;
wa w3 x2+5 ; if length of looser + displ
sl w3 (x1+5) ; > length of winner then
rs w3 x1+5 ; new length of winner
jl. w3 arrloos. ; make looser array
jl. nextb. ; go to read next intput byte
\f
; rc 4.6.70 fortran, pass 4, page 64
; dimension local equivalenced to
; local or dcommon zone
; w1 = zone (winner)
; w2 = dim local (looser)
arreqzon: rl. w0 lastdisp. ; displace of array(1,1...,1)
ws. w0 displace. ; = record index - array index
sh w0 -1 ; if displacement < 0 then
jl. arzonerr. ; error
rs. w0 displace. ;
al w0 36 ; set kind of array to
hs w0 x2+1 ; array equivalenced to zone (36)
jl. w3 arrloos. ; make array looser
rl. w0 zonedisp. ;
rl w3 x2+5 ; set zone descriptor displacement
rs w0 x3-5 ;
jl. nextb. ; read next input byte
; dimension local equivalenced to
; common w1 = common (winner)
; w2 = dim local (looser)
arreqcom: rl. w0 lastdisp. ; disp of array(1,1..,1)in common
ws. w0 displace. ; = common displ - array index
sh w0 -1 ; if displacement < 0 then
jl. arcomerr. ; go to error
rs. w0 displace. ;
wa w0 x2+5 ; if displacement + length
rl w3 x1+3 ; of array > length of common
sl w0 (x3) ; then
rs w0 x3 ; new length of common
al w0 10 ; set kind of array =
hs w0 x2+1 ; common array (10)
jl. w3 arrloos. ; make array looser
jl. nextb. ; read next input byte
\f
; rc 4.6.70 fortran,pass 4,page 65
; get winner for simpel local
; w2 = identifier
nextsimp: rl w2 x2+5 ; get next in chain
bl w0 x2 ;
sz. w0 (winn. ) ; if winner then
jl. setdisp. ; go to set displaceand winner
simwin: rl w1 x2+3 ;
wa. w1 displace. ; displacement = displace
rs. w1 displace. ; + displacement for next
bl w1 x2+1 ;
sh w1 2 ; if kind = simpel local (2)
jl. nextsimp. ; then go to next in chain
; kind of w2 = simpel common(4),
; simpel eq array(32)or
; simpel eq zone(34), w1 = kind
; w2 = last before winner
rl w2 x2+5 ; w2 = winner
setdisp: rs. w3 savew3eq. ; save return address
rl. w3 (lastiden.) ; w3 = looser
rs w2 x3+5 ; set chain to winner
rl. w0 displace. ;
rs w0 x3+3 ; set displacement
hs w1 x3+1 ; set kind
sn w1 34 ; if kind = 34 then
rl w2 x2 ; get chain to winner
se w1 32 ; if not simpel eq array
jl. (savew3eq.) ; then return
rl. w3 savew3eq. ;
simparra: rs. w3 savew3eq.; save return address
bl w1 x2 ;
sz. w1 (winn. ) ; if array is winner then
jl. (savew3eq.) ; go to return
jl. w3 arrwin. ; w2 = winner of array
rl. w3 (lastiden.);
bl w1 x2+1 ; w1 = kind of winner
al w0 4 ;
sn w1 26 ; if winner is common (26)
hs w0 x3+1 ; then set kind to simpel common
rl. w0 displace. ;
rs w0 x3+3 ; set displacement
rs w2 x3+5 ; set chain to winner
se w1 36 ;
jl. (savew3eq.) ;if winner is array eq to zone
al w0 34 ; then kind = simpel eq zone
hs w0 x3+1 ;
rl. w1 (lastfri.) ; make equivalence reat
rs w1 x3+5 ;
rl w2 x2+5 ; w2 = rest description of array
jl. w3 restdes4. ; make rest description
rl w0 x2-4 ;
rs w0 x1-2 ; set zone descriptor displ
rl w2 x2 ;
rs w2 x1 ; set chain to zone
jl. (savew3eq.) ; go to return
\f
; rc 4.6.70 fortran, pass 4,page 66
; get winner for array local
; in equivalence chain
nextarr: rl w2 x1 ; w2=next in chain
bl w1 x2 ;
sz. w1 (winn. ) ; if winner then
jl x3 ; go to return
arrwin: rl w1 x2+5 ; w1 = equivalence rest
rl w0 x1-2 ;
wa. w0 displace. ; displace = displace
rs. w0 displace. ; + new displacement
bl w0 x2+1 ;
sn w0 36 ; if kind = array eq zone (36)
jl x3 ; go to return
jl. nextarr. ; else go to next in chain
; get winner for local array
getarrwi: rs. w3 savew3eq. ; save return address
jl. w3 arrwin. ; get winner for array
bl w1 x2+1 ; w1 = kind of winner
rl. w3 (lastiden.) ; w3 = identifier
sn w1 26 ; if kind = common (26)
al w1 10 ; then kind of identifier
hs w1 x3+1 ; = 10(array in common)
se w1 36 ;
jl. notzone. ; if kind<> zone then jump
rl w2 x2+5 ; w2=equivalence rest
rl w1 x3+5 ;w3 = equivalence rest
rl w0 x2-4 ;
rs w0 x1-4 ; set zonedescriptor displ
rl w2 x2 ; w2 = addres of zone
notzone: rl w1 x3+5 ;
rl. w0 displace. ; set displacement
rs w0 x1-2 ;
rs w2 x1 ; set chain to winner
jl. (savew3eq.) ; go to return
\f
; rc 3.1.70 fortran, pass 4, page 67
; tables used by end declaration and ene equivalence
h.
kindact1: nextvar - base ; is used of the byte end declaration to
nextvar - base ; the kind in the identifiertable
nextvar - base ;
nextvar - base ;
normarr - base ;
normarr - base ;
formarr - base ;
normzone- base ;
normzone- base ;
formzone- base ;
nextvar - base ;
nextvar - base ;
nextvar - base ;
nextvar - base
exterzon- base ;
nextvar - base ;
kindact2: nextvar1- base ; is used of the byte end equivalence to give the
simloclo- base ; action address depending on the
simpcom - base ; the kind in the identifiertable
nextvar1- base ;
arrloclo- base ;
arrcom - base ;
nextvar1- base ;
zonloc - base ;
zoncommn- base ;
nextvar1- base ;
nextvar1- base ;
nextvar1- base ;
nextvar1- base ;
nextvar1- base ;
nextvar1- base ;
nextvar1- base ;
dimeqsim- base ;
zoneqsim- base ;
zoneqarr- base ;
newkind: 0,1,2,3 ; transform the kind at end-
4,4,4,5,5,5 ; equivalence to the kind used
6,7,8,14, 5,16 ; in the prograa part
11,12,13
w.
; rc 4.6.70 fortran, pass 4, page 68
;tables used by equivalence
h. ; kind
eqaction: notrefeq-base ; 0 notreferenced
simpeleq-base ; 2 simpel local
simcomeq-base ; 4 simpel common
equiverr-base ; 6 simpel formal
arrayeq -base ; 8 dimen 4cal
arrayeq -base ; 10 dimension common
equiverr-base ; 12 dimension formal
zoneeq -base ; 14 zone local
zoneeq -base ; 16 zone common
equiverr-base ; 18 zone formal
equiverr-base ; 20 external
equiverr-base ; 22 external formal
equiverr-base ; 24 entry name
equiverr-base ; 26 common name
equiverr-base ; 28 unused
equiverr-base ; 30 trouble
simarreq-base ; 32 simpel equival to array
simzoneq-base ; 34 simpel equival to zone
arrayeq -base ; 36 array equival to zone
; equivalence action table
h. ; kind simpel array
eqtable: nextbyt -base, nextbyt -base ; 0
simeqsim-base, simeqarr-base ; 2
nextbyt -base, nextbyt -base ; 4
nextbyt -base, nextbyt -base ; 6
simeqarr-base, arreqarr-base ; 8
nextbyt -base, nextbyt -base ; 10
nextbyt -base, nextbyt -base ; 12
simeqzon-base, arreqzon-base ; 14
simeqzon-base, arreqzon-base ; 16
nextbyt -base, nextbyt -base ; 18
nextbyt -base, nextbyt -base ; 20
nextbyt -base, nextbyt -base ; 22
nextbyt -base, nextbyt -base ; 24
simeqcom-base, arreqcom-base ; 26
nextbyt-base,nextbyt-base ; 28 preliminary correction
nextbyt-base,nextbyt-base ; 30 priliminary correction
w.
\f
; rc 6.6.70 fortran,pass 4 ,page 69
idstart=k-idst
psidst=-idstart
lastbyte=k-lastbyt
endp4=k-e0
e30 = e30 + endp4 ; length = length + length pass 4;
i.
e.
m. rc 83.08.29 fortran, pass 4
▶EOF◀