|
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: 89856 (0x15f00)
Types: TextFile
Names: »ftnpass23tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ftnpass23tx «
\f
; fortran, pass 2, page 1
; jørgen lindballe
; contents:
; 1 introduction
; 2 input records
; 3 output records
; 4 process
; 4. 1 core store utilization
; 4. 2 identifiers
; 4. 3 logical constants
; 4. 4 real constants
; 4. 5 double precision constants
; 4. 6 complex constants
; 4. 7 trouble records
; 5 testprogram
; 6 the program
\f
; fortran, pass 2, page 2
; chapter 1: introduction
; the purpose of pass 2 is to:
; pack and recognize identifiers and to determine an implicit
; type.
; recognize reserved identifiers.
; transform logical constants
; real constants and
; double precision constants.
; recognize and transform complex constants and
; copy all other input records.
\f
; fortran, pass 2, page 3
; chapter 2: input records
; input no. of no.of
; class elements basevalue bytevalue elements bytes
; 1 39 1 cl1base+ 0 ab... 1
; +28 1
; +29 01... 1
; +38 9 1
; 2 1 40 cl2base+ 0 .true. 1
; 3 1 41 cl3base+ 0 .false. 1
; 4 1 42 cl4base+ 0 <end unit> 1
; 5 2 43 cl5base+ 0 <end pass> 1
; + 1 reserved -
; 6 1 45 cl6base+ 0 <int. const.> 3
; 7 1 46 cl7base+ 0 <long const.> 5
; 8 1 47 cl8base+0 <real const.> 7
; 9 2 48 cl9base+0 <double cnst.> 9
; +1 reserved -
; 10 1 50 cl10base+0 ( 1
; 11 1 51 cl11base+0 ) 1
; 12 2 52 cl12base+0 + 1
; +1 - 1
; 13 1 54 cl13base+0 , 1
\f
; fortran, pass 2, page 4
; 14 47 55 cl14base+0 * 1
; 1 / 1
; 2 = 1
; 3 . 1
; 4 <begin unit> 1
; 5 ** 1
; 6 .lt. 1
; 7 .le. 1
; 8 .eq. 1
; 9 .ge. 1
; 10 .gt. 1
; 11 .ne. 1
; 12 .and. 1
; 13 .or. 1
; 14 .not. 1
; 15 .shift. 1
; 16 (.string.) 1
; 17 <end statement> 1
; 18 <end label> 1
; 19 to 1
; 20 goto 1
; 21 if 1
; 22 do 1
; 23 assign 1
; 24 call 1
; 25 continue 1
; 26 return 1
; 27 stop 1
; 28 read 1
; 29 write 1
; 30 program 1
; 31 subroutine 1
; 32 function 1
; 33 entry 1
; 34 logical 1
; 35 integer 1
; 36 long 1
; 37 real 1
; 38 double prec. 1
; 39 complex 1
; 40 dimension 1
; 41 common 1
; 42 data 1
; 43 equivalence 1
; 44 external 1
; 45 zone 1
; 46 <end line> 1
; 15 4 102 cl15base +0 <beg.clos.form> 3
; +1 <beg.open form> 3
; +2 <end format> 3
; +3 <cont. format> 3
; 16 1 106 cl16base +0 <trouble> 4
\f
; fortran, pass 2, page 5
; chapter 3: output records
; no. of no.of
; elements basevalue bytevalue elements bytes
; 41 1 base + 0 not used -
; + 40 not used -
; 1 42 base + 0 <end unit> 1
; 1 43 base + 0 <end pass> 1
; 1 44 base + 0 <logical const> 2
; 1 45 base + 0 <integer const> 3
; 1 46 base + 0 <long constant> 5
; 1 47 base + 0 <real constant> 5
; 2 48 base + 0 <double const.> 9
; + 1 <complex const> 9
; 1 50 base + 0 ( 1
; 1 51 base + 0 ) 1
; 2 52 base + 0 + 1
; + 1 - 1
; 1 54 base + 0 , 1
; 47 55 base + 0 * 1
; 1 / 1
; 2 = 1
; 3 . 1
; 4 <begin unit> 1
; 5 ** 1
; 6 .lt. 1
; 7 .le. 1
; 8 .eg. 1
; 9 .ge. 1
; 10 .gt. 1
; 11 .ne. 1
; 12 .and. 1
; 13 .or. 1
; 14 .not. 1
\f
; fortran, pass 2, page 6
; 15 .shift. 1
; 16 (.string.) 1
; 17 <end statement>1
; 18 <end label> 1
; 19 to 1
; 20 goto 1
; 21 if 1
; 22 do 1
; 23 assign 1
; 24 call 1
; 25 continue 1
; 26 return 1
; 27 stop 1
; 28 read 1
; 29 write 1
; 30 program 1
; 31 subroutine 1
; 32 function 1
; 33 entry 1
; 34 logical 1
; 35 integer 1
; 36 long 1
; 37 real 1
; 38 double prec. 1
; 39 complex 1
; 40 dimension 1
; 41 common 1
; 42 data 1
; 43 equivalence 1
; 44 external 1
; 45 zone 1
; 46 <end line> 1
; 4 102 base +0 <beg.clos.form>3
; +1 <beg.open form>3
; +2 <end format> 3
; +3 <cont. format> 3
; 1 106 base +0 <trouble> 4
; 3 107 base +0 <ext. ident.> 1
; +1 <impl.int.> 3+byte3
; +2 <impl.real> 3+byte3
; 402 110 base +0 not used -
; +401 not used -
\f
; fortran, pass 2, page 7
; reserved identifiers
; 29 512 basevalue + 0 iabs 1
; + 1 abs 1
; + 2 int 1
; + 3 float 1
; + 4 ifix 1
; + 5 sngl 1
; + 6 dble 1
; + 7 cmplx 1
; + 8 dabs 1
; + 9 conjg 1
; +10 dmax1 1
; +11 dmin1 1
; +12 dsign 1
; +13 dexp 1
; +14 cexp 1
; +15 dlog 1
; +16 clog 1
; +17 dlog10 1
; +18 dsin 1
; +19 csin 1
; +20 dcos 1
; +21 ccos 1
; +22 dsqrt 1
; +23 csqrt 1
; +24 datan 1
; +25 datan2 1
; +26 dmod 1
; +27 res. for pass 3 -
; +28 res. for pass 3 -
; <no.> 541 base + 0 <0th identifier>1
; + 1 <1st identifier>1
; + 2 <2nd identifier>1
; etc.
\f
; fortran, pass 2, page 8
; identifiers
; the first time an identifier is met by pass 2 the following
; bytes are output:
; <ident no.>
; <implicit type>
; <ext. ident.>
; <no. of bytes>
; <packed
; identifier,
; 3 iso-characters
; per word>
; where
; <ident no.> ::= 541 + <identifier no.>
; <implicit type> ::= <impl.integer> or <impl. real>
; <ext. ident.> ::= 107
; if the number of characters in the identifier is not a mul-
; tiple of 3, the last character(s) of the record is (are) 0.
; the following times the identifier is met only
; <ident no.>
; is output.
; it is noticed that the identifier numbers 512-538 are
; used for reserved identifiers. the identifier numbers
; 539 and 540 are reserved for pass 3.
\f
; fortran, pass 2, page 9
; chapter 4: process
; 4. 1 core store utilization
; in a process of standardsize: 5000 words, the core store is
; used in this way:
; fileprocessor : 768 words
; general pass : 561 words
; pass 2, program : 897 words
; working area : 1221 words
; general pass buffers : 512 words
; fileprocessor buffers: 1041 words
\f
; fortran, pass 2, page 10
; 4. 2 identifiers
; the address-table and the identifier-table.
; the working area and the last part of the program form two
; tables: an address-table and an identifier-table.
; each time a new identifier is recognized it is stored in the
; identifier-table from the first free byte. the identifiers
; are linked together in chains by supplying each identifier
; with the relative address of the next identifier of the chain.
; the relative address of the first identifier of a chain is
; stored in the address-table; this table consists of 32 bytes,
; i.e. a byte for each of 32 chains.
; an identifier is stored in the identifier table as shown:
; <rel. addr. of the next ident. of the chain>
; <identifier no.>, <no. of halfwords>
; <1st char <6 + 2nd char>, <3rd char <6 + 4th char>
; <5th char <6 + 6th char>, <7th char <6 + 8th char>
; etc.
; it is noticed that 2 characters are packed in each byte. if
; the number of characters is not dividible by 4, the last
; character(s) are packed identifier is(are) equal to 0.
; in the last identifier - record of a chain the first two
; byte(s) are equal to 0.
; each time an identifier is met by pass 2, it is packed and
; stored from the first free byte of the identifier-table,and
; its length and a preliminary identifier no. is added. then
; the chainnumber is calculated (the bytesum modulu 32), and
; the contents of addresstable(chainno.) is found. this is the
; relative address of the first identifier of the chain. the
; two identifiers are compared, and if they are equal the ident.
; no. is output. contrary the next record of the chain is found
; by means of its relative address placed in the first byte of
; the first record. the new record and the second record of
; the chain are compared and so on.
; as mentioned above the first byte of the last record is
; equal to zero. especially if the chain is empty the byte of
; the address-table is zero.
\f
; fortran, pass 2, page 11
; if the identifier is not recognized in the chain, the implicit
; type is found and output together with the record. however.
; the identifier itself is converted and repacked with 3 iso-
; characters per word before it is output. the record is final-
; ly added to the identifier-table by placing its relative
; startaddress in the first byte of the foregoing record of the
; chain, especially in the address-table if it is the first
; record of the chain.
; by the loading the ident. tab is partly filled with the iden-
; tifier records of reserved identifiers, and the addresstable
; is filled with the appropriate relative startaddresses.
; if the identifier-table (except for the area occupied by the
; reserved identifiers) consists of i bytes, and the average
; length of packed identifiers is called <length>, then the
; max. number of identifiers is determined by:
; i = max*(3 + <length>)
; when i=2300 bytes and <length>= 6/2 bytes corresponding
; to 6 characters, then the max. number of identifiers is ap-
; proximately 380.
; implicit type.
; an identifier may be the name of a:
; program
; subroutine
; function
; statement function
; entry
; simple variable
; array
; label variable
; zone
; zone array
; common
; whatever it is pass 2 provides the identifier output-record
; with an implicit typespecification, so that identifiers be-
; ginning with one of the letters
; i j k l m n
; are specified as integers, and all other as reals.
\f
; fortran, pass 2, page 12
; 4. 3 logical constants
; the two logical constants are transformed as follows:
; logical constant input output
; .true. <cl2base>+0 <cl5base>+1 00..01
; .false. <cl3base>+0 <cl5base>+1 00..00
\f
; fortran, pass 2, page 13
; 4. 4 real constants
; a real constant is output from pass 1 as:
; 1: 4 bytes containing the mantissa as a non - negative
; integer:
; 0 <= m <= 99 999 999 999
; 2. 2 bytes containing the adjusted exponent as an integer:
; -1000 <= e <= 1000
; so the value of the constant satisfies:
; 0 <= m*(10**e) <= (10**11 - 1)*(10**1000)
; or
; 0 <= value <= 2**3359
; let e(j) mean bit no. j of the exponent.
; if e>= 0 then
; e = e(14)*2**9 + ... + e(23)*2**0
; if e<0 then
; e = -2**(n+2) + e(23-n)*2**n + ... + e(23)*2**0
; where 2**(n+2) means the smallest 2 - power which is greater
; than or equal to abs(e).
; the real value is:
; real = c(m) (/10**(2**(n+2))) *
; (10**(e(23-n)*2**n))*...*
; (10**(e(23)*2**0))
; where c(m) means the mantissa converted to real format, and
; where the floating division (/10**(2**(n+2))) is executed if
; e<0 only.
; if e<-512 this equality is used:
; 10**(2**10) = (10**(2**9)) * (10**(2**9))
; i.e. the mantissa is instead divided two times by 10**512.
\f
; fortran, pass 2, page 14
; as a positive real must satisfy:
; 0.5*2**(-2048) <= real < 1*2**(2047)
; (or lower limit <= real <= upper limit
; where
; 1.547173* 10**(-617)<lower limit<=1.547174*10**(-617)
; 1.615850* 10**(+616)<=upper limit<1.615851*10**(+616) )
; it is not always possible to convert the constant. in these
; cases overflow occurs during the floating multiplication:
; *(10**(e(23-j)*2**(j)))
; or underflows occurs during the last floating division:
; /(10**(2**9))
; and instead of the real a troublerecord no. e75+0:
; real or complex constant outside allowed range
; is output from pass 2.
\f
; fortran, pass 2, page 15
; 4. 5 double precision constants
; a double precision constant is output from pass 1 as:
; 1. 6 bytes containing the mantissa as a non - negative
; integer:
; 0<= m<= (10**19) -1
; 2. 2 bytes containing the adjusted exponent as an integer:
; -1000 <= e <= 1000
; so the value of the constant satisfies:
; 0<= m*(10**e) <= (10**19 - 1)*(10**1000)
; or
; 0 <= value <= 2**3385
; let e(j) mean bit no. j of the exponent.
; if e>= 0 then
; e = e(14)*2**9 + ... + e (23)*2**0
; if e<0 then
; e = -2**(n+2) + e(23-n)*2**n+ ... + e(23)*2**0
; where 2**(n+2) means the smallest 2 - power which is greater
; then or equal to abs(e).
; the double precision value is:
; double = c(m) (/10**(2**(n+2)))*
; (10**(e(23-n)*2**n)) * ... *
; (10**(e(23)* 2**0))
; where c(m) means the mantissa converted to double precision
; format and where the double precision division:
; (/10**(2**(n+2))) is executed if e<0 only.
; if e< -512 this equality is used:
; 10**(2**10) = (10**(2**9)) * (10**(2**9))
; i.e. the mantissa is instead divided two times by 10**512.
\f
; fortran, pass 2, page 16
; as a positive double precision constant must satisfy:
; 0.5*2**(-2048) <= double <= 1*2**(+2047)
; (or lower limit <= double <= upper limit
; where
; 1.547173*10**(-617) <lower limit<=1.547174*10**(-617)
; 1.615850*10**(+616)<=upper limit<1.615851*10**(+616))
; it is not always possible to convert the constant. in these
; cases overflow occurs during the double precision multiplica-
; tion:
; *(10**(e(23-j)*2**(j)))
; or underflow occurs during the last double precision division:
; /(10**(2**9))
; and instead of the double precision constant a troublerecord
; no. e75+1:
; double precision constant outside allowed range
; is output from pass 2.
\f
; fortran, pass 2, page 17
; 4.6 complex constants
; a complex constant is defined in this way:
; <complex constant> ::=
; (<possible sign><real>,<possible sign><real>)
; it may occur as an operand in arithmetical expressions,as
; a parameter in the call of procedures and in data- statement.
; without being a complex constant the construction:
; (<possible sign><real>,<possible sign><real>)
; may appear in a subscribted variable or in the call of a pro-
; cedure:
; name(<possible sign><real>,<possible sign><real>)
; consequently a complex constant is output when pass 2 recog-
; nizes the mentioned construction not following an identifier.
\f
; fortran, pass 2, page 18
; 4.7 trouble records
; if a programunit contains too many or too long identifiers
; pass 2 writes:
; process too small
; and the translation is terminated.
; if underflow or overflow occurs when converting a real con-
; stant (i.e.
; 1.547174*10**(-617) <= real <= 1.615850*10**(+616)
; is not satisfied) a troublerecord:
; <class16base>+0 e75+0 0 0
; (real or complex constant outside allowed range) is output
; instead of the real or complex constant.
; if underflow or overflouw occurs when convertering a double
; precision constant (i.e.
; 1.547174*10**(-617)<=
; double precision constant <=
; 1.615850*10**(+616)
; is not satisfied) a troublerecord:
; <class 16base>+0 e75+1 0 0
; (double precision constant outside allowed range) is output
; instead of the double precision constant.
\f
; fortran, pass 2, page 19
; chapter 5: testprogram
; the testprogram fullfills the following demands:
; the testinput contains the first record of each inputclass.
; in this way each basevalue is tested, and furthermore the
; first row of the action - state table is tested.
; the number of characters of the identifiers is 1, 2, 3 or 4,
; i.e. both odd and even characternumbers occur, and the number
; of words of the packed identifier is 1 as well as 2.
; the identifiers are so chosen that the chains contain 0, 1
; or more identifiers.
; some identifiers occur two times, and is tested that these
; identifiers are found in the table the second time.
; identifiers of implicit real as well as implicit integer type
; occur, and it is tested that the right type is output.
; the testinput contains an identifier followed by a construc-
; tion like a complex constant. it is tested that this con-
; struction is not taken for a complex constant, as it follows
; an identifier.
; it contains the reserved identifiers 2 times, so it is
; tested that these identifiers are recognized.
; the testprogram consists of more than one programunit, each
; of which contains identifiers. it is tested that the identi-
; fiertable is reset between two units.
; it is tested that underflow and overflow during real- con-
; verting are treated correctly. (a real constant, a real con-
; stant in a non-complex construction and the real as well as
; the imaginary part of a complex constant).
; the sign of the real and imaginary part of a complex constant
; is 1) empty, 2) +, 3) - .
; the testinput contains a left parenthesis and a real constant
; which do not form a complex constant. these elements must be
; output correctly.
\f
; fortran, pass 2, page 20
; program a
;c testprogram for pass 2
; a1 = .true.
; i1 = .false.
; a12 = +12
; i1 = 9000000
; a12 = (-1.0)*3
; h2 = 123456789012e-11 +
; 1 (0.0,+1.547174e-617)/(-0.99999999995,2.0)
; 1.547173e-617
; 1.615850e616
; 1.615851e616
; (1.0,1.547173e-617,1.0)
; (1.615851e616,1.0)
; (1.0,1.547173e-617)
; end
; function i(1025.0,10000.0)
; n1 = o1
; format(x)
; <illegal character>
; end
\f
; fortran, pass 2, page 21
; chapter 6: the program
s. c12, d20, f26, g8, i103, j8 ; begin pass 2
k = e0
w. i20: i21 ; no.of bytes in pass 2
h. i22 ; entry point rel. to 1st word
2<1 + 0 ; pass no.<1 + direction change
; definition of the identifiers in the identifier table:
i99=541 ; first free ident no
i100=0 ; word: relative address of the next identifier in this chain
i101=2 ; halfword: identifier no
i102=3 ; halfword: no of bytes
i103=4 ; halfword: first of text
; action-state table
; class 1 2 3 4 5 6 7 8
; 9 10 11 12 13 14 15 16
; state
h.
g1: i2,j2, i5,j1, i6,j1, i11,j1, i12,j1, i1,j1, i1,j1, i7,j1,
i8,j1, i2,j3, i1,j1, i1,j1, i1,j1, i1,j1, i1,j1, i1,j1,
g2: i2,j2, i3,j1, i3,j1, i3,j1, i3,j1, i3,j1, i3,j1, i3,j1,
i3,j1, i4,j1, i3,j1, i3,j1, i3,j1, i3,j1, i3,j1, i3,j1,
g3: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i2,j5,
i10,j1, i10,j1, i10,j1, i2,j4, i10,j1, i10,j1, i10,j1, i10,j1,
g4: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i2,j5,
i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1,
g5: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1,
i10,j1, i10,j1, i10,j1, i10,j1, i2,j6, i10,j1, i10,j1, i10,j1,
g6: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i2,j8,
i10,j1, i10,j1, i10,j1, i2,j7, i10,j1, i10,j1, i10,j1, i10,j1,
g7: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i2,j8,
i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1,
g8: i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1,
i10,j1, i10,j1, i9,j1, i10,j1, i10,j1, i10,j1, i10,j1, i10,j1,
j0 = k
\f
; fortran, pass 2, page 22
b. ; head program
; the head program first initializes pass 2 and then for
; every input record it goes through an action(state,class)
; into a new state(state,class) until pass 2 is finished
; after having read and written the end pass record.
; it is noticed that all procedures (but not the actions)
; store and reload the w - registers.
w. i22 = k - i20
d0: jl. w3 d13. ; entry pass 2
d1: rl. w3 f10. ; class :=
am. (f9.) ; class(next record)
rl w2 x3 0 ;
ad w3 -12 ; action :=
as w3 -12 ; table(state,class)
al. w3 x3 j0. ; state :=
rs. w3 f9. ; table(state,class)
jl. x2 j0. ; goto action
e.
w. ; global constants
f1: 0 ; fba of free identifier table
f2: 541 ; identifier number
f3: 0 ; ffb of identifier table
f4: 0 ; lwa of buffer
f6: 0 ; upper buffer pointer
f7: 0 ; lower buffer pointer
f8: 0 ; length of last record
f9: 0 ; state
f10: 0 ; 2x(class - 1)
h.f11: 0, 1 ; .true.
f12: 0, 0 ; .false.
f13: 0, e83 + 0 ; trouble-
0, 0 ; record no. e83 + 0
f14: 0, e83 + 1 ; trouble-
0, 0 ; record no. e83 + 1
0 ; recout(-1)
f19: 0, r. 9 ; recout(0:8)
w.f20: 32 ; 2x(no.of classes)
h. 0 ; record(-1)
f21: 0, r. 9 ; record(0:8)
w.f22: 0 ; no. of classes - 1
h.f23: 39,1,1,1,2, 1,1,1, ; no.of elements
2,1,1,2,1,47,4,1 ; (class 1-16)
f24: 1, 0, r.15 ; class base (class 1-16)
f25: 1,1,1,1,1, 3,5,7, ; no. of bytes(class 1-16)
9,1,1,1,1, 1,3,4
w.f26: 0 ; flow
\f
; fortran, pass 2, page 23
b. ; action 1
; action 1 writes a record and reads the next record.
w.
c1: rl. w0 f8. ; begin
al. w1 f21. ;
bl w2 x1 +0 ; write(length,record)
jl. w3 d4. ;
sn w2 101 ; if record = end line
jl. w3 e1. ; then carret.
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. a1 ; action 2
; action 2 stores an input record in the buffer and reads
; the next record.
w.
c2: al w1 0 ; begin
a1: hl. w0 x1 f21. ; for i := 0 step 1
jl. w3 d5. ; until (no - 1) do
al w1 x1 1 ; bufin(record(i))
se. w1 (f8.) ;
jl. a1. ;
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. ; action 3
; action 3 calls packmatch.
w. ; begin
c3: jl. w3 d11. ; packmatch
jl. d1. ; end
e.
\f
; fortran, pass 2, page 24
b. ; action 4
; action 4 calls packmatch, it outputs the left parenthesis
; and reads the next record.
w.
c4: jl. w3 d11. ; begin
al w0 1 ; packmatch
al. w1 f21. ; write(1,record)
jl. w3 d4. ;
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. b1 ; action 5
; action 5 writes a .true. - record and reads the next
; record.
w.
c5: al w0 2 ; begin
al. w1 f11. ;
jl. w3 d4. ; write(2,true)
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. b1 ; action 6
; action 6 writes a .false. - record and reads the next
; record.
w.
c6: al w0 2 ; begin
al. w1 f12. ;
jl. w3 d4. ; write(2,false)
jl. w3 d3. ; read record
jl. d1. ; end
e.
\f
; fortran, pass 2, page 25
b. a1 ; action 7
; action 7 converts and writes a real constant and reads the
; next record.
; if under- or overflow occurs, a troublerecord is output
; instead of the real constant.
w.
c7: al. w1 1 + f21. ; begin
jl. w3 d8. ; convert real(record(1))
al w0 5 ;
al. w1 f21. ;
am. (f26.) ; if flow = true
sn w1 x1 0 ; then
jl. a1. ; write(4,troublerec)
al w0 4 ;
al. w1 f13. ; else
a1: jl. w3 d4. ; write(5,record)
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. a1 ; action 8
; action 8 converts and writes a double precision constant
; and it reads the next record.
; if under- or overflow occurs, a troublerecord is output
; instead of the double precision constant.
w.
c8: al. w1 1 + f21. ; begin
jl. w3 d7. ; convert double
al w0 9 ; (record(1))
al. w1 f21. ;
am. (f26.) ; if flow = true
sn w1 x1 0 ; then
jl. a1. ; write(4,troublerec)
al w0 4 ;
al. w1 f14. ; else
a1: jl. w3 d4. ; write(9,record)
jl. w3 d3. ; read record
jl. d1. ; end
e.
\f
; fortran, pass 2, page 26
b. a2 ; action 9
; in action 9 the contents of the buffer is converted to a
; complex constant, the complex constant record is written
; and the next record is read.
; if under- or overflow occurs when converting the real or
; the imaginary part, a troublerecord is output instead of
; the complex constant.
; it is noticed that the right parenthesis of the input
; constant is not stored in the buffer.
w. ; begin
c9: jl. w3 d9. ; convert complex
am. (f26.) ;
sn w1 x1 0 ; if flow = true then
jl. a1. ; begin
al w0 4 ; write(4,troublerec)
al. w1 f13. ; goto read
jl. w3 d4. ; end
jl. a2. ;
a1: hl. w0 8 + f24. ;
ba. w0 1 ; record(0) :=
hs. w0 f21. ; cl9base + 1
al w0 9 ;
al. w1 f21. ;
jl. w3 d4. ; write(9,record)
a2: jl. w3 d3. ; read record
jl. d1. ; end
e.
\f
; fortran, pass 2, page 27
b. a5, b1 ; action 10
; the buffer now contains one or more records which do not
; form a complex constant.
; action 10 empties the buffer to records, and if real con-
; stants occur, they are converted to correct real constants;
; the records are output.
w. b0: 0 ; length of record
b1: 0 ; 2*(class - 1)
c10: ; begin
a1: jl. w3 d6. ;
hs. w0 f19. ; bufout(recout(0))
jl. w3 d12. ; find(recout,class,no)
rs. w0 b0. ;
rs. w1 b1. ;
al w2 1 ; for i := 1 step 1
a2: sl. w2 (b0.) ; until no-1 do
jl. a3. ;
jl. w3 d6. ;
hs. w0 x2 f19. ; bufout(recout(i))
al w2 x2 1 ;
jl. a2. ;
a3: rl. w0 b0. ;
am. (b1.) ;
se w1 x1 -2*(:8-1:) ; if class = 8 then
jl. a4. ; begin
al. w1 1 + f19. ; convert real
jl. w3 d8. ; (recout(1))
al w0 5 ; no := 5
am. (f26.) ; if flow = true then
sn w1 x1 0 ; begin
jl. a4. ; recout :=
al w0 4 ; troublerecord
al. w1 f13. ; no := 4
jl. a5. ; end
a4: al. w1 f19. ; end
a5: jl. w3 d4. ; write(no,recout)
rl. w0 f6. ; if upperpointer
sl. w0 (f7.) ; .ge. lowerpointer
jl. d1. ; then goto end
jl. a1. ; else goto a1
; end
e.
\f
; fortran, pass 2, page 28
b. a3 ; action 11
; action 11 clears the free part of id-tab. by resetting the
; address table, the address of the first free byte of the
; identifier table and the identifier number, it
; writes the end-unit record and it reads the next record.
w.
; begin
c11: jl. w3 d20. ; initialize identifiers
rl. w0 f8. ;
al. w1 f21. ;
jl. w3 d4. ; write(length,end unit)
jl. w3 d3. ; read record
jl. d1. ; end
e.
b. ; action 12
; action 12 writes the end - pass record and finis pass 2.
w.
c12: rl. w0 f8. ; begin
al. w1 f21. ; write(length,end pass)
jl. w3 d4. ; goto finis
jl. d14. ; end
e.
\f
; fortran, pass 2, page 29
; assignments to the elements of the action - state table
i1 = c1 - j0 , j1 = g1 - j0,
i2 = c2 - j0 , j2 = g2 - j0,
i3 = c3 - j0 , j3 = g3 - j0,
i4 = c4 - j0 , j4 = g4 - j0,
i5 = c5 - j0 , j5 = g5 - j0,
i6 = c6 - j0 , j6 = g6 - j0,
i7 = c7 - j0 , j7 = g7 - j0,
i8 = c8 - j0 , j8 = g8 - j0,
i9 = c9 - j0 ,
i10 = c10 - j0 ,
i11 = c11 - j0 ,
i12 = c12 - j0
b. a1, b2 ; proc initiate
; the procedure initiate calculates the fba of the identi-
; fier table and the lwa of the buffer, and initializes the
; identifiers
; furthermore the pointer of the identifier table and the
; upper as well as the lower pointer of the buffer are reset.
; the interrupt mask and the startaddress of the interrupt-
; sequence are set, so that under- and overflow are responced
; when a real or double is converted. the exception register
; is set for high precision.
; finally the initial state is set to 1, the input class
; table is filled, and the first record is read.
; the procedure is called from the headprogram in this way:
; jl. w3 d13.
\f
; fortran, pass 2, page 30
w. b1: 0 ; return address
b2: 8.30000000 ; interrupt mask
d13: rs. w3 b1. ; begin
al. w3 i25. ;
rs. w3 f1. ; fba of ident. table
jl. w3 d20. ; initialize identifiers
rl. w3 4 + e9. ;
rs. w3 f4. ; lwa of buffer
rs. w3 f6. ; upperpointer :=
rs. w3 f7. ; lowerpointer := lwa
rl. w0 b2. ; set interrupt
al. w3 d15. ; (interrupt addr.,
jd 1<11 + 0 ; interrupt mask )
xl. 0 ; precision := high
al. w3 g1. ;
rs. w3 f9. ; state := 1
rl. w3 f20. ;
al w3 x3 -2 ;
ls w3 -1 ;
rs. w3 f22. ; no.of classes - 1
al w2 0 ;
bz. w3 f24. ; for class := 1
a1: ba. w3 x2 f23. ; step 1 until
hs. w3 x2 1 + f24. ; (no.of classes-1) do
al w2 x2 1 ; base(class+1):=
se. w2 (f22.) ; base(class)+no(class)
jl. a1. ;
bz. w0 4 + f24. ;
ba. w0 1 ; true(0) :=
hs. w0 f11. ; false(0) :=
hs. w0 f12. ; cl5base + 1
bz. w0 15 + f24. ; troublerecord(0) :=
hs. w0 f13. ; cl16base
hs. w0 f14. ;
jl. w3 d3. ; read record
jl. (b1.) ; end
e.
\f
; fortran, pass 2, page 31
b. ; proc finis
; the procedure finis performs a jump return to the general
; pass. it is called from action 12 in this way:
; jl. d14. ; goto finis
w. ; begin
d14: jl. e7. ; goto general pass
; end
e.
b. a2, b3 ; proc read record
; the procedure read record reads the next record and stores
; it in the array record(0:8), and it finds the class and
; the length of the record; it is called from initiate and
; from most actions in this way:
; jl. w3 d3. ; read record
w. b0: 0 ; w0 - store
b1: 0 ; w1 - store
b2: 0 ; w2 - store
b3: 0 ; w3 - store
d3: ds. w1 b1. ; begin
ds. w3 b3. ;
jl. w3 e2. ;
hs. w2 f21. ; record(0) := inbyte
bz w0 5 ;
jl. w3 d12. ; find
rs. w1 f10. ; (record(0),class,no)
rs. w0 f8. ;
al w1 0 ;
a1: al w1 x1 1 ;
sl. w1 (f8.) ; for i := 1 step 1
jl. a2. ; until n - 1 do
jl. w3 e2. ;
hs. w2 x1 f21. ; record(i) := inbyte
jl. a1. ;
a2: dl. w1 b1. ;
dl. w3 b3. ;
jl x3 0 ; end
e.
\f
; fortran, pass 2, page 32
b. a2, b3 ; proc write record
; (no., startaddress)
; the procedure write record, which is called from most
; actions and from packmatch writes a record. it is called
; in this way:
; al w0 <no. of bytes>
; al. w1 <startaddress>.
; jl. w3 d4.
w. b1: 0 ; no. of bytes
b2: 0 ; w2 - store
b3: 0 ; return - address
d4: rs. w0 b1. ; begin
ds. w3 b3. ;
al w2 0 ; i := 0
a1: sl. w2 (b1.) ; if i<no then
jl. a2. ; begin
am x2 0 ;
hl w0 x1 0 ;
jl. w3 e3. ; outbyte(startaddr.+i)
al w2 x2 1 ; i := i + 1
jl. a1. ; goto a1
a2: rl. w2 b2. ; end
jl. (b3.) ; end
e.
\f
; fortran, pass 2, page 33
b. a1, b2 ; proc bufin(byte)
; the procedure bufin which is called from action 2 and
; from packmatch places the byte in the buffer, and the upper
; buffer pointer (pointing at the first free byte) is de-
; creased by one.
; before this it is checked that the buffer does not reach
; the ident table; if this occurs the translation is termi-
; nated after the message:
; process too small.
; the byte may be a letter or a digit of an identifier or it
; may be ( + - , or a part of a real constant in an expected
; complex constant.
; the number of bytes in the buffer is equal to:
; lower buffer pointer - upper buffer pointer
; it may be called in this way:
; hl. w0 <byteaddr.>.
; jl. w3 d5.
w. b1: 0 ; return address
b2: <:<10>process too small<0>:>
d5: rs. w3 b1. ; begin
rl. w3 f6. ; if upper pointer <
sl. w3 (f3.) ; ffw of ident table
jl. a1. ; then
al. w1 b2. ; alarm(process too small)
jl. e5. ; else
a1: hs w0 x3 0 ; begin
al w3 x3 -1 ; buffer(u.p.) :=byte
rs. w3 f6. ; u.p. := u.p. - 1
jl. (b1.) ; end
; end
e.
\f
; fortran, pass 2, page 34
b. a1, b1 ; proc bufout(byte)
; the procedure bufout, which is called from packmatch,
; convert complex and from action 10, takes the next byte
; from the buffer, and the lower buffer pointer (which
; points at this byte) is decreased by one.
; if the buffer is now empty, the lower as well as the upper
; buffer pointer are reset.
; if the buffer is empty, the outputbyte is equal to zero.
; the byte may be a letter or a digit in an identifier or it
; may be ( + - , or a part of a real constant.
; the number of bytes in the buffer is equal to:
; lower buffer pointer - upper buffer pointer
; it must be called in this way:
; ; if lower > upper then
; jl. w3 d6. ; bufout(byte)
; ; (w0) = byte
w. b1: 0 ; return address
d6: rs. w3 b1. ; begin
rl. w3 f7. ;
bz w0 x3 0 ; byte := buffer(l.p.)
al w3 x3 -1 ; l.p. := l.p. - 1
rs. w3 f7. ;
sh. w3 (f6.) ; if l.p. <= u.p.
jl. a1. ;
a0: jl. (b1.) ; then
a1: rl. w3 f4. ; begin
rs. w3 f6. ; lowerpointer :=
rs. w3 f7. ; upperpointer := lwa
rs w0 x3 0 ; buffer(0) := 0
jl. a0. ; end
; end
e.
\f
; fortran, pass 2, page 35
b. a6, b13 ; proc convert double
; (io-addr.)
; the procedure convert double converts an 8-byte double
; precision constant to a correct 8-byte output double pre-
; cision constant. the constant is positive as a + or - is
; already output.
; if under- or overflow occurs the boolean flow is set
; to true.
; when a double has been read this procedure is called from
; action 8 in this way:
; al. w1 <in-out startaddr.>.
; jl. w3 d7.
w. b0: 0 ; w0 - store
b1: 0 ; w1 - store
b2: 0 ; w2 - store
b3: 0 ; w3 - store
h. 0, 4, 320, 0 ; 10**(2**0)
0, 0, 0, 0 ;
0, 7, 400, 0 ; 10**(2**1)
0, 0, 0, 0 ;
0, 14, 312, 2048 ; 10**(2**2)
0, 0, 0, 0 ;
0, 27, 381, 1924 ; 10**(2**3)
0, 0, 0, 0 ;
0, 54, 284, 889 ; 10**(2**4)
111, 3088, 0, 0 ;
0, 107, 315, 2229 ; 10**(2**5)
362, 173, 389, 2767 ;
0, 213, 388, 3843 ; 10**(2**6)
466, 2047, 125, 875 ;
0, 426, 295, 1864 ; 10**(2**7)
498, 1539, 332, 1648 ;
0, 851, 340, 4061 ; 10**(2**8)
254, 3703, 462, 3911 ;
b5: 0, 1701, 454, 820 ; 10**(2**9)
43, 2712, 116, 2275 ;
w. b7: 0 ; exp < -512
\f
; fortran, pass 2, page 36
b8: 23 ;
b9: 46 ;
w. 0 ; exp0
0 ;
0 ;
b10: 0 ; op0
0 ; exp1
0 ;
0 ;
b11: 0 ; op1
b12: 0 ;
b13: 0 ;
d7: ds. w1 b1. ; begin
ds. w3 b3. ;
rs. w3 b7. ;
al w0 0 ; flow := false
rs. w0 f26. ;
rl. w1 b1. ; double :=
al. w2 b11. ; convert(m1)
jl. w3 d16. ;
rl. w0 -6 + b11. ; double :=
wa. w0 b9. ; double * (2**46)
rs. w0 -6 + b11. ;
am. (b1.) ;
al w1 +2 ; double0 :=
al. w2 b10. ; convert(m2)
jl. w3 d16. ;
rl. w0 -6 + b10. ; double0 :=
wa. w0 b8. ; double0 * (2**23)
rs. w0 -6 + b10. ;
al. w0 b10. ;
al. w1 b11. ; double :=
al. w2 b11. ; double + double0
jl. w3 d18. ;
am. (b1.) ;
al w1 +4 ; double0 :=
al. w2 b10. ; convert(m3)
jl. w3 d16. ;
al. w0 b10. ;
al. w1 b11. ; double :=
al. w2 b11. ; double + double0
jl. w3 d18. ;
\f
; fortran, pass 2, page 36a
am. (b1.) ;
rl w3 +6 ;
ns w3 5 ;
bl w2 5 ;
al w2 x2 14 ; l := 14
ls w2 3 ; if e<0 then
sl w3 0 ; begin
jl. a3. ; l := 23 - n
ls w3 1 ; double :=
al w2 x2 -8 ; double:
rs. w2 b7. ; 10**(2**(n+2))
rs. w3 b13. ; end
al. w0 b11. ;
sn w2 0 ;
am -8 ;
al. w1 x2 14 + b5. ;
al. w2 b11. ;
jl. w3 d19. ;
rl. w2 b7. ;
rl. w3 b13. ;
a3: ls w3 1 ; for j := l
al w2 x2 -8 ; step 1 until 23 do
sn w3 0 ; if e(j) = 1 then
jl. a5. ; double := double*
sl w3 0 ; 10**(2**(23-j))
jl. a3. ;
ds. w3 b13. ;
al. w0 b11. ;
al. w1 x2 6 + b5. ;
al. w2 b11. ;
jl. w3 d17. ;
dl. w3 b13. ;
jl. a3. ;
a5: am. (b7.) ; if exp < -512 then
se w1 x1 0 ; double := double :
jl. a6. ; 10**(2**9)
al. w0 b11. ;
al. w1 6 + b5. ;
al. w2 b11. ;
jl. w3 d19. ;
a6: dl. w1 -4 + b11. ;
dl. w3 b11. ;
am. (b1.) ;
ds w1 +2 ;
am. (b1.) ;
ds w3 +6 ;
dl. w1 b1. ;
dl. w3 b3. ;
jl x3 +0 ; end
e.
\f
; fortran, pass 2, page 37
b. a6, b7 ; proc convert real
; (io-addr.)
; the procedure convert real converts a 6-byte real constant
; to a correct 4-byte output real constant. the constant is
; positive as a + or - is already output.
; the procedure is called from action 7 when a real constant
; is read, from action 10 when a real (in a non-complex con-
; stant) is taken from the buffer and from convert complex
; when a complex constant in the buffer is converted.
; if underflow or overflow occurs the boolean flow is set
; to true.
; it is called in this way:
; al. w1 <in-out startaddr.>.
; jl. w3 d8.
w. b0: 0 ; w0 - store
b1: 0 ; w1 - store
b2: 0 ; w2 - store
b3: 0 ; w3 - store
h. 1280, 0, 0, 4 ; 10**(2**0)
1600, 0, 0, 7 ; 10**(2**1)
1250, 0, 0, 14 ; 10**(2**2)
1525, 3600, 0, 27 ; 10**(2**3)
1136, 3556, 3576, 54 ; 10**(2**4)
1262, 726, 3393, 107 ; 10**(2**5)
1555, 3087, 2640, 213 ; 10**(2**6)
1181, 3363, 3660, 426 ; 10**(2**7)
1363, 3957, 4061, 851 ; 10**(2**8)
b5: 1816, 3280, 1397, 1701 ; 10**(2**9)
w. b7: 0 ; exp < -512
\f
; fortran, pass 2, page 38
d8: ds. w1 b1. ; begin
ds. w3 b3. ;
rs. w3 b7. ;
al w0 0 ; flow := false
rs. w0 f26. ;
rl. w1 (b1.) ; real :=
ci w1 23 ; convert(m)
am. (b1.) ;
rl w3 +2 ;
ci w3 0 ;
fa w1 6 ;
am. (b1.) ;
rl w3 +4 ;
ns w3 5 ;
bl w2 5 ;
al w2 x2 14 ; l := 14
ls w2 2 ;
sl w3 0 ; if e<0 then
jl. a3. ; l := 23 - n
ls w3 1 ; real :=
al w2 x2 -4 ; real:
sn w2 0 ; 10**(2**(n+2))
am -4 ;
a1: fd. w1 x2 6 + b5. ;
a2: rs. w2 b7. ;
a3: ls w3 1 ; for j := l
al w2 x2 -4 ; step 1 until 23 do
sn w3 0 ; if e(j) = 1 then
jl. a5. ; real := real*
sh w3 0 ; 10**(2**(23-j))
fm. w1 x2 2 + b5. ;
jl. a3. ;
a5: am. (b7.) ; if exp < -512 then
sn w1 x1 0 ; real := real:
fd. w1 2 + b5. ; 10**(2**9)
a6: am. (b1.) ;
ds w1 +2 ;
dl. w1 b1. ;
dl. w3 b3. ;
jl x3 +0 ; end
e.
\f
; fortran, pass 2, page 39
b. a9, b7 ; proc convert complex
; the procedure convert complex converts a complex constant
; to a correct 8-byte output complex constant.
; it is called from action 9 when a complex constant (except
; for )) is stored in the buffer. the output constant is
; stored in the array record.
; the procedure is called in this way:
; jl. w3 d9. ; convert complex
w. b0: 0 ; w0 - store
b1: 0 ; w1 - store
b2: 0 ; w2 - store
b3: 0 ; w3 - store
b4: 0 ; sign
h. b5: 0, r. 6 ; real(0:5)
w. b6: 0 ; temp. address
8.40000000 ;
b7: 8.00000000 ; -1.0
\f
; fortran, pass 2, page 40
a1: rs. w3 b6. ; begin
jl. w3 d6. ; begin sign
al w0 +1 ; bufout(( or ,)
rs. w0 b4. ; sign := +1
a2: jl. w3 d6. ;
bz. w1 7 + f24. ; temp := bufout
sn w0 x1 0 ; if temp=real ident
jl. a3. ; then goto end sign
al w2 -1 ; else
bz. w1 11 + f24. ; if temp = -
sn w0 x1 1 ; then sign := -1
rs. w2 b4. ; goto a2
jl. a2. ;
a3: jl. (b6.) ; end sign
a4: rs. w3 b6. ; begin real
al w1 0 ; for i := 0 step 1
a5: jl. w3 d6. ; until 5 do
hs. w0 x1 b5. ; real(i) := bufout
al w1 x1 1 ;
sh w1 5 ;
jl. a5. ;
al. w1 b5. ; convert real
jl. w3 d8. ; (real(0))
dl. w3 2 + b5. ;
am. (b4.) ;
se w1 x1 +1 ;
jl. a6. ; if sign = -1
fm. w3 b7. ; then real:=real*(-1.0)
a6: jl. (b6.) ; end real
d9: ds. w1 b1. ; comment: entry
ds. w3 b3. ;
jl. w3 a1. ; 1st sign
jl. w3 a4. ; 1st real
am. (f26.) ; if flow = true
sn w1 x1 0 ; then
jl. a8. ; begin
a7: rl. w0 f7. ; for i := 1 step 1
sh. w0 (f6.) ; while lower>upper do
jl. a9. ; bufout
jl. w3 d6. ; goto end
jl. a7. ; end
a8: ds. w3 3 + f21. ; record(1) := sign*real
jl. w3 a1. ;
jl. w3 a4. ; 2nd sign
ds. w3 7 + f21. ; 2nd real
a9: dl. w1 b1. ; record(5) := sign*real
dl. w3 b3. ;
jl x3 0 ; end
e.
\f
; fortran, pass 2, page 41
b. a4, b14 ; proc idpack
; the procedure idpack packs and outputs a new identifier.
; 3 iso - characters are packed in each word, and empty posi-
; tions in the last word are filled with zeroes.
; it is called from packmatch in this way:
; al w0 <no. of char.>
; al. w1 <startaddr. of ident.>.
; jl. w3 d10.
w. b0: 0 ; charno.
b1: 0 ; start-addr.
b2: 0 ; w2-store
b3: 0 ; return-addr.
b4: 0 ; bytno., next
b5: 2 ;
b6: 3 ;
b10: 0 ; word
b11: 0 ; char.
b12: 0 ; byte
b13: 0 ; i
\f
; fortran, pass 2, page 42
d10: ds. w1 b1. ; begin
ds. w3 b3. ;
wa. w0 b5. ;
al w3 0 ; bytno :=
wd. w0 b6. ; ((charno+2)/3)*2
ls w0 1 ;
rs. w0 b4. ;
al w0 1 ; write(1,bytno)
al. w1 1 + b4. ;
jl. w3 d4. ;
al w3 3 ; next := 3
rs. w3 b4. ;
al w3 0 ; for i := 0 step 1
a0: se. w3 (b4.) ; until (charno - 1) do
jl. a1. ; begin
ds. w1 b11. ; if i=next then
ds. w3 b13. ;
al w0 2 ; begin
al. w1 b10. ; write(2,word)
jl. w3 d4. ;
rl. w1 b4. ; next := next + 3
al w1 x1 3 ;
rs. w1 b4. ;
dl. w1 b11. ; end
dl. w3 b13. ;
a1: sz w3 1 ;
jl. a2. ; if i=even then
bz. w2 (b1.) ; begin
rl. w1 b1. ; byte := start(i/2)
al w1 x1 1 ;
rs. w1 b1. ; byte := byte<12
ls w2 12 ; end
a2: al w1 0 ;
ld w2 6 ;
sh w1 29 ; char := byte<6
al w1 x1 78 ; if char<30 then
al w1 x1 18 ; char := char + 96 else
ls w1 16 ; char := char + 18
ld w1 8 ;
al w3 x3 1 ; word := word<8 + char
se. w3 (b0.) ;
jl. a0. ; end
a3: sl. w3 (b4.) ;
jl. a4. ; for i := i + 1
ld w1 8 ; while i<next do
al w3 x3 1 ; word := word<8 + 0
jl. a3. ;
a4: rs. w0 b10. ; write(2,word)
al w0 2 ;
al. w1 b10. ;
jl. w3 d4. ;
rl. w2 b2. ;
jl. (b3.) ; end
e.
\f
; fortran, pass 2, page 43
b. a11, b7 ; proc packmatch
; the procedure packmatch is called from action 3 and 4 in
; this way:
; jl. w3 d11.
; the new identifier is taken from the buffer and packed
; (2 characters per byte) in the identifiertable from the
; first free byte; at the same time its chainnumber is cal-
; culated.
; then a search trough its chain is performed; if the iden-
; tifier is found and identno.>0 its identifier number is output.
; if the identno. is < 0 the sign is reversed, the implicit
; type is determined, and the identifier record is output.
; contrary the new identifier is linked to the chain, and
; the identifier number and the address of the first free
; byte are updated. then the implicit type is determined and
; the identifier record is output.
w. b1: 0 ; returnaddress
b2: 0 ; bytno
b4: 0 ; l(oldident)
h. b5: 0, 107 ; impltype, extident
w. b6: 2.011111
b7: 0 ; no. of char.
\f
; fortran, pass 2, page 44
d11: rs. w3 b1. ; begin packmatch
al w2 0 ; begin pack
rs. w2 b2. ; bytno := sum := 0
a1: jl. w3 d6. ; comment : next pack
ls w0 6 ;
rl w1 0 ; tempack :=
jl. w3 d6. ; bufout<6 + bufout
wa w0 2 ;
wa w2 0 ; sum := sum + tempack
rl. w1 b2. ;
al w1 x1 1 ; bytno := bytno + 1
rs. w1 b2. ;
am. (f3.) ; newident(2+bytno) :=
hs w0 x1 i103-1 ; tempack
rl. w3 f6. ; if upperpointer <
se. w3 (f7.) ; lowerpointer
jl. a1. ; then goto nextpack
al w3 0 ;
am. (f3.) ;
hs w3 x1 i103 ; store a zero halfword
al w3 -1 ; charno :=
sz w0 63 ; if last char = 0
al w3 0 ; then -1
rs. w3 b7. ; else 0
rl. w3 f3. ;
rl. w0 b2. ; newident(2) := bytno
hs w0 x3 i102 ;
ls w0 1 ; charno :=
wa. w0 b7. ; charno +
rs. w0 b7. ; bytno*2
rl. w0 f2. ; newident(1) := idno
hs w0 x3 i101 ;
al w0 0 ; newident(0) := 0
rs w0 x3 0 ; chainno := sum mod 32
la. w2 b6. ; end pack
ls w2 1 ;
al. w2 x2 i23. ; begin search
rs. w2 b4. ; l(oldid):=l(at(chain))
a3: rl. w2 (b4.) ; comment : next ident
sn w2 0 ; reladdr := oldident
jl. a9. ; if reladdr = 0
wa. w2 b4. ; then goto notfound
rs. w2 b4. ; l(oldident) :=
al w1 0 ; l(oldident)+reladdr
a5: am. (b4.) ; j := 0
bz w0 x1 i102 ; comment: next byte
am. (f3.) ; if oldident(2+j) .ne.
bz w3 x1 i102 ; newident(2+j)
se w0 x3 0 ; then goto next id
jl. a3. ; else if j<oldid(2)
a7: al w1 x1 1 ;
am. (b4.) ; then goto next byte
bz w3 i102 ; else goto found
sh w1 x3 0
jl. a5. ; end search
\f
; fortran, pass 2, page 45
rl. w2 b4. ; begin found
bl w0 x2 i101 ; if identno. < 0 then
sl w0 0 ; begin
jl. a8. ; identno. :=
ac w0 (0) ; -identno.
hs w0 x2 i101 ; goto a10
jl. a10. ; end
a8: al w0 1 ;
rl. w1 b4. ;
al w1 x1 i101 ; write(1,oldident(1))
jl. w3 d4. ; goto end packmatch
jl. a11. ; end found
a9: rl. w2 f3. ; begin notfound
al w1 x2 +0 ;
ws. w1 b4. ; oldident(0) :=
rs. w1 (b4.) ; l(newid)-l(oldid)
al w1 x2 i103+1 ;
wa. w1 b2. ; l(newident) :=
ls w1 -1 ;
ls w1 1 ;
rs. w1 f3. ; l(newident)+3+bytno
rl. w1 f2. ;
al w1 x1 +1 ; idno :=
rs. w1 f2. ; idno + 1
a10: bz w1 x2 i103 ;
ls w1 -6 ; impltype :=
al w3 108 ; if i .le. firstchar
sl w1 9 ; .and.
sl w1 15 ; firstchar .le. n
al w3 x3 +1 ; then integer
hs. w3 b5. ; else real
al w0 1 ;
al w1 x2 i101 ;
jl. w3 d4. ; write(1, idno)
al w0 2 ;
al. w1 b5. ; write(2,
jl. w3 d4. ; impltype + extident)
rl. w0 b7. ; write(charno.,
al w1 x2 i103 ; newident(2))
jl. w3 d10. ; end not found
a11: jl. (b1.) ; end packmatch
e.
\f
b. a5, b3 ; proc initialize identifiers
w. ;
; w3=return
b1: 31 ;
b2: -2 ;
b3: 0 ; return address
d20: rs. w3 b3. ; save return
al w0 0 ;
al w1 0 ;
a2: rs. w0 x1 i23. ; clear address table
al w1 x1 +2 ;
sh w1 62 ;
jl. a2. ;
al w1 i99 ; idno:=first free ident no
rs. w1 f2. ;
al. w3 i24. ; address of the first identifier
a3: bl w1 x3 i101 ;next identifier:
ac w1 x1 ;
sh w1 0 ;
hs w1 x3 i101 ; if identno>0 then identno:=-identno
al w1 0 ;
rs w1 x3 i100 ; chain:=0
al w2 x3 i103-1 ;
ba w2 x3 i102 ; last byte of the text
a4: ba w1 x2 ; calculate sum
al w2 x2 -1 ;
sl w2 x3 i103 ;
jl. a4. ;
la. w1 b1. ; chain no:= sum mod 32
ls w1 1 ;
al. w1 x1 i23. ;
al w0 0 ;
a5: wa w1 x1 i100 ; find the last identifier of the chain
se w0 (x1 i100) ;
jl. a5. ;
ac w0 x1 ;
wa w0 6 ;
rs w0 x1 i100 ; chain the identifier
ba w3 x3 i102 ; compute the address of the next identifier
al w3 x3 i103+1 ;
la. w3 b2. ;
se. w3 i25. ;
jl. a3. ; goto next identifier
rl. w0 f1. ;
rs. w0 f3. ; ffb:=fba
jl. (b3.) ; return
e. ;
\f
; fortran, pass 2, page 46
b. a2, b1 ; proc find
; (ident,class,no)
; the procedure find, which is called from action 10 and
; from read record, fetches from the inputclass-table the
; class and the length for the actual record identification.
; it is called in this way:
; bz. w0 <identbyte>.
; jl. w3 d12.
; ; (w0) = no. of bytes
; ; (w1) = 2*(class - 1)
w.
b1: 0 ; returnaddress
d12: rs. w3 b1. ; begin
rl. w1 f22. ; class := no. of classes
a1: bz. w3 x1 f24. ;
se w1 0 ; if class > 0 and
sl w0 x3 0 ; ident < base(class)
jl. a2. ; then
al w1 x1 -1 ; begin
jl. a1. ; class := class - 1
a2: bz. w0 x1 f25. ; goto a1
ls w1 1 ; end
jl. (b1.) ; no := numb(class)
; end
e.
b. ; proc int. seq.
; floating (integer) under- or overflow has occurred when a real
; (double) is converted, and the boolean flow is set to true.
w.
d15: 0 ; w0
0 ; w1
0 ; w2
0 ; w3
0 ; exc. reg.
0 ; instruction counter
0 ; interrupt cause
jl. 2,r.(:d15.+e100+2:)>1 ; if rc8000 then extend dump area
al. w2 d15. ; begin
am. (12 + d15.) ; if not integer
sn w2 x2 -2 ; under- or overflow
jl. +8 ; and
am. (12 + d15.) ; not floating point
se w2 x2 -4 ; under- or overflow
jl. e36. ; then goto e36
al w2 1 ; else
rs. w2 f26. ; flow := true
rl. w2 4 + d15. ;
jl. (10 + d15.) ; end
e.
\f
; fortran, pass 2, page 46a
b. b20, c14 w.
b. w.
; convert integer to double-real.
; w0 = irrelevant
; w1 = addr. of integer
; w2 = - - result (7th byte)
; w3 = return
d16:ds.w1 b1. ; icd
ds.w3 b3. ;save w23
rl.w1 (b1.) ;
ci w1 0 ;convert integer
bl w3 3 ;load exp
al w2 0 ;load zero frac3
hl w1 5 ;load zero frac2 right
ad w1 -2 ;shiftretur frac12
ls w1 -3 ;shiftretur frac2
ds.w2 (b2.) ;
am. (b2.) ;
ds w0 -4 ;
rl.w0 b0. ;
jl. (b3.) ;return
e.
; multiplication of double-precision reals: g*h
; w0 = addr. of h (7th byte)
; w1 = - - g ( - - )
; w2 = - - result ( - - )
; w3 = return
b.a2 w.
d17: ds.w1 b1. ; dmd
ds.w3 b3. ;
al w1 x1-2 ;
rs.w1 b4. ;
al w1 x1-2 ;
rs.w1 b5. ;
rl.w2 b0. ; w2=address of op2 (h)
dl w0 x2 ;
ds.w0 b18. ; (b17,b18):=(w3w0):=(h2,h3);
dl w2 x2-4 ;
ds.w2 b16. ; (b15,b16):=(w1w2):=(exph,h1);
wm.w2 (b1.) ; (w1w2):= h1*g3;
wm.w0 (b5.) ; (w3w0):= h3*g1
aa w0 4 ; + h1*g3;
\f
; fortran, pass2, page 46b
rl.w2 (b4.) ;
wm.w2 b17. ; (w1w2):= g2*h2;
aa w0 4 ; (w3w0):=(w3w0+g2*h2)*2**(-21);
ad w0 -21 ;
rl.w2 (b4.) ;
wm.w2 b16. ; (w1w2):= g2*h1;
aa w0 4 ;
dl.w2 (b5.) ; (w1w2):=(expg,g1);
wa.w1 b15. ;
rs.w1 b15. ; b15:=w1:= expg+exph;
wm.w2 b17. ; (w1w2):= g1*h2;
aa w0 4 ;
ad w0 3 ; (w3w0):=(fv2,fv3);
rs.w0 b14. ; save fv3: b14:= fv3*2**3;
bl w2 6 ;
bl w2 4 ; w2:= sign(fv2);
rl.w1 (b5.) ;
wm.w1 b16. ; (w0w1):= g1*h1;
sn w0 0 ; if h1*g1=0 then
jl. a2. ; goto a2
aa w3 2 ; (w2w3):=(fv1,fv2);
rs.w3 b6. ; dr3:= fv2*2**3;
nd w3 3 ; (w2w3):= normalized(fv1,fv2);
bl w1 3 ; w1:=n:= norm.exp.
ad w3 -2 ;
ls w3 -3 ; w3:= f2;
rs.w2 b4. ; w2:=dr1:= f1;
rx.w3 b14. ; w3:= fv3*2**3;
rl.w2 b6. ; b14:= f2;
am. (b15.) ; w2:= fv2*2**3;
al w0 x1+5 ; w0:= n+5+expg+exph;
ac w1 x1 ; n:= -n;
ld w3 x1-5 ; (w2w3) := (fv2,fv3)shift(-n-5)
lo.w2 b14. ; w2:= f2;
la.w2 b9. ; (g5=mask)
ls w3 -3 ;
rl.w1 b4. ;
a1: ds.w3 (b2.) ; store (f2,f3)
as w0 12 ; test
bl w0 0 ; for overflow
am. (b2.) ;
ds w1 -4 ; store (expf,f1)
jl. (b3.) ; return
a2: al w1 0 ;
dl w3 2 ;
al w0 -2048 ;
jl. a1. ;
e.
\f
; fortran, pass 2, page 46c
b0: 0 ; w0
b1: 0 ; w1
b2: 0 ; w2
b3: 0 ; w3
b4: 0 ;
b5: 0 ; exp1
0 ;
0 ;
b6: 0 ; op1
0 ; exp2
0 ;
0 ;
b7: 0 ; op2
0 ; exp3
0 ;
0 ;
b8: 0 ; op3
b9: 1<21-1 ;
b10: 0 ; double-
b11: 4 ; constant
b14: 0 ;
b15: 0 ; exp4
b16: 0 ;
b17: 0 ;
b18: 0 ; op4
b19: -1<21 ;
b20: 1 ;
; addition of double-reals.
; w0 = addr. of a1 (7th byte)
; w1 = - - a2 ( - - )
; w2 = - - result ( - - )
; w3 = return
\f
; fortran, pass 2, page 46d
b. a5 w.
d18:ds.w1 b1. ; dad
ds.w3 b3. ;
dl.w2 b1. ;
rl w3 x1-6 ;load op-exp
sh w3(x2-6) ;if opexpdrexp
rx w1 5 ;then exchange addresses
rs.w1 b4. ;store max-address
rl w3 x2-6 ;load min-exp
rl w0 x1-6 ;load max-exp
ws w3 1 ;compute shifts
rs.w0 b5. ;store max-exp
dl w1 x2-2 ;load min-op
rl w2 x2 ;
sl w3 -21 ;if shifts-21
jl. a3. ;then goto shift1
sl w3 -64 ;if shifts-64
jl. a2. ;then goto add2
rl.w3 b4. ;load max-addr
dl w2 x3 ;load max-op frac3
dl w0 x3-4 ;load max-op frac12
jl. c11. ;goto exit
a2: dl w2 3 ;add2:shift frac12 -21
ls w2 3 ;shift frac3
al w0 0 ;load zero
rs.w0 b14. ;store at keep frac2
sh w1 -1 ;if op<0
al w0 -1 ;then load -1
al w3 x3+21 ;change shifts
jl. a4. ;goto shift2
a3: sn w3 0 ;shift1:if shifts=0
jl. a5. ;then goto add3
rs.w1 b14. ;store frac2
ld w2 3 ;shift frac23
ad w1 x3 ;shift frac12 shifts
ls w1 -3 ;shiftretur frac2
rx.w1 b14. ;exchange frac2
a4: ad w2 x3 ;shift2:shift frac23 shifts
lo.w1 b14. ;compute frac2
aa.w2 b11. ;round
ls w2 -3 ;shiftretur frac3
a5: rl.w3 b4. ;fradd:load addresses
lo.w2 b19. ;prepare doubleadd
aa w2 x3 ;doubleadd frac23
la.w2 b9. ;remove signbits
sz.w1 (b19.);if overflow
wa.w0 b20. ;then add 1
la.w1 b9. ;remove signbits
wa w0 x3-4 ;add frac1
jl. c10. ;continue
e.
\f
; fortran, pass 2, page 46e
c10:rs.w1 b14. ;exit:normalize
ld w2 3 ;shift frac23
nd w1 7 ;normalize frac12
bl w3 7 ;load-shifts
ad w1 -2 ;shiftretur frac12
sh w3 -21 ;if shifts21
jl. c13. ;then goto highdiff
ls w1 -3 ;shift retur frac2
rx.w1 b14. ;exchange frac2
ac w3 x3+2 ;shifts=2-shifts
ld w2 x3 ;shift frac23 shifts
la.w1 b9.
ls w2 -3 ;shiftretur frac3
lo.w1 b14. ;compute frac2
ac w3 x3 ;load-shifts
jl. c14. ;goto normend
c13:la.w0 b19. ;highdiff:keep sign
lo.w0 b14. ;frac1=frac2
rl w1 5 ;frac2=frac3
al w2 0 ;frac3=0
nd w1 7 ;normalize frac12
bl w3 7 ;load-shifts
sn w3 -2048 ;if shifts=-2048
jl. c11. ;goto exit1
ad w1 -2 ;shiftretur frac12
ls w1 -3 ;shift retur frac2
al w3 x3-21 ;compute -shifts
c14:wa.w3 b5. ;normend:add exp
as w3 12 ;test exp
bl w3 6 ;load exp
c11:ds.w2 (b2.) ;exit1:store op
am. (b2.) ;
ds w0 -4 ;
c12:jl. (b3.) ;exit2: return
\f
; fortran, pass 2, page 46f
b.a4
w.
;division of double-reals g/h
; w0 = addr. of g (7th byte)
; w1 = - - h ( - - )
; w2 = - - result ( - - )
; w3 = return
d19: ds.w1 b1. ; ddd
ds.w3 b3. ;
rl.w2 b1. ; w2=address of op2
dl w0 x2 ; (w3w0):=(h2h3);
ds.w0 b7. ; b7: op2
dl w2 x2-4 ; (w1w2):=(exph,h1)
ds.w2 b7.-4 ;
am. (b0.) ;
dl w1 -4 ; (w0w1):=(expg,g1);
sn w1 0 ; if op1=0
jl. a4. ; then goto a4
ds.w1 b6.-4 ; g1: op1
ls w3 3 ;
nd w3 7 ; (w2w3):=
ds.w3 b18. ; dr1:= fl.(h1h2);
dl.w3 (b0.) ; (w1w2w3):=(g1g2g3);
ds.w3 b6. ;
ls w2 3 ;
nd w2 5 ; (w1w2):= fl.(g1g2);
fd.w2 b18. ; (w1w2):=kv1:= fl.(g1g2)/fl.(h1h2);
ds.w2 b8. ; g3:= kv1;
bl w3 5 ; w3:= exp(kv1);
hl.w2 b10. ; byte(5):= fl.exp:= 0;
ad w2 x3-2 ; convert to double-format
ds.w2 b8.-4 ; (w1w2)=(u1,u2)
ad w2 -23 ;
\f
; fortran, pass 2, page 46g
;calculate remainder
wm.w2 b7. ; (w1w2):= h3*(u1+u2*2**(-21))
rl.w0 b8.-4 ; w0:= u2;
ls w0 -2 ;
wm.w0 b7.-2 ; (w3w0):=h2*u2;
aa w0 4 ; (w3w0):= h2*u2 + h3*u1;
ad w0 -22 ;
rl.w2 b8.-6 ; w2:= u1;
wm.w2 b7.-2 ; (w1w2):= u1*h2;
aa w0 4 ;
rl.w2 b8.-4 ;
ls w2 -3 ;
wm.w2 b7.-4 ;
aa w0 4 ; (w3w0):=(w3w0) +h1*u2;
rl.w2 b9. ; w2:= mask
la w2 0 ; w2:=fv3:= w0!mask
ws.w2 b6. ; w2:= rest3:= fv3-g3
ci w2 -65 ; (w1w2):= fl.(rest3);
ds.w2 b7. ;
ad w0 -21 ;
rl.w2 b8.-6 ;
wm.w2 b7.-4 ; (w1w2):= h1*u1;
aa w0 4 ;
dl.w2 b6.-2 ; (w1w2):= (g1g2);
ls w2 3 ;
ad w2 -3 ;
ss w2 0 ; rest12:=(w1w2):=(g1g2-(w3w0))
ci w2 -44 ; (w1w2):= fl.(rest12);
fs.w2 b7. ; comment w1:=sign(w2)
fd.w2 b18. ; kv2:=(w1w2):=rest12+rest3)/fl.(h1h2);
bl w3 5 ; w3:= exp(kv2) -
bs.w3 b8.+1 ; exp(kv1);
ad w2 x3+19 ; (w1w2):=(w1w2)*2**(exp(kv2)-exp(kv1));
bl.w3 b8.+1 ;
wa.w3 b6.-6 ; w3:= b5:= exp(kv1)+expg
ws.w3 b7.-6 ; - exph;
ds.w3 b5. ;
bl w0 2 ;
bl w0 0 ; w0:= sign(kv2);
dl.w3 b8. ;
hl.w3 b10. ; exp(kv1):= 0;
ad w3 -5 ; (w2w3):= kv1 shift -5;
aa w1 6 ; (w0w1):= (fv1fv2):= kv1+kv2;
ld w1 3 ;
rl.w2 b5.-2 ; w2:= fv3;
ld w2 -3 ;
jl. c10. ; goto normalize
a4: ld w0 24 ;
al w2 0 ;
jl. c11. ;
e.
e.
\f
; fortran, pass 2, page 47
w. i23: 0, r.32 ; address table
; identifier table
i24: ; reserved identifiers
w. 0, h. -512,2, 577, 147, ; iabs
w. 0, h. -513,2, 66,1216, ; abs
w. 0, h. -514,2, 590,1280, ; int
w. 0, h. -515,3, 396, 961,1280, ; float
w. 0, h. -516,2, 582, 600, ; ifix
w. 0, h. -517,2,1230, 460, ; sngl
w. 0, h. -518,2, 258, 773, ; dble
w. 0, h. -519,3, 205,1036,1536, ; cmplx
w. 0, h. -520,2, 257, 147, ; dabs
w. 0, h. -521,3, 207, 906, 448, ; conjg
w. 0, h. -522,3, 269, 88,1984, ; dmax1
w. 0, h. -523,3, 269, 590,1984, ; dmin1
w. 0, h. -524,3, 275, 583, 896, ; dsign
w. 0, h. -525,2, 261,1552, ; dexp
w. 0, h. -526,2, 197,1552, ; cexp
w. 0, h. -527,2, 268, 967, ; dlog
w. 0, h. -528,2, 204, 967, ; clog
w. 0, h. -529,3, 268, 967,2014, ; dlog10
w. 0, h. -530,2, 275, 590, ; dsin
w. 0, h. -531,2, 211, 590, ; csin
w. 0, h. -532,2, 259, 979, ; dcos
w. 0, h. -533,2, 195, 979, ; ccos
w. 0, h. -534,3, 275,1106,1280, ; dsqrt
w. 0, h. -535,3, 211,1106,1280, ; csqrt
w. 0, h. -536,3, 257,1281, 896, ; datan
w. 0, h. -537,3, 257,1281, 928, ; datan2
w. 0, h. -538,2, 269, 964, ; dmod
w. 0, h. -539,3,2128, 83,1216, ; 3pass (reserved)
w. 0, h. -540,3,2128, 83,1216, ; 3pass (reserved)
w.h. i25: 0, r. 2 ; first free byte of ident-tab.
i21 = k - i20
e30 = e30 + i21 ; length := length + length pass 2;
i.
e. ; end pass 2
m. rc 83.08.29 fortran, pass 2
▶EOF◀