|
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: 143616 (0x23100)
Types: TextFile
Names: »ftnpass13tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ftnpass13tx «
; rc 3.10.69 fortran, pass 1, page 1
; jes linderoth
; content: page
; general description xx
; mainclasses for fortran-symbols xx
; use of slang-names xx
; test data xx
; start pass1 xx
; sequence initpass 1 xx
; procedure end pass 1 xx
; procedure copytodel xx
; procedure read char xx
; procedure format xx
; procedure byte newline xx
; procedure outputc xx
; procedure out4bytes xx
; procedure next char xx
; global variables xx
; sequence main sequence xx
; procedure field descriptor xx
; procedure longtext xx
; procedure set pointer xx
; procedure skip to statement xx
; procedure constant xx
; procedure number syntax xx
; procedure bitpattern xx
; procedure text xx
; procedure compound xx
; general description:
; a) structure:
; the entire slang-program is structured almost like an algol-
; program with a main-sequence and a number of procedures, each
; arranged in a slang-block.
; b)method:
; characters are read from the source(s) in the low-level procedure
; read char and transformed to an internal representation consisting
; of mainclass and internal value through table-look-up in table
; internal.
; this representation is also used for two composite characters
; called nlstatchar and nlcontchar ,which consists of a labelfield
; that from the point of view of the char-processing procedures is
; of type end-statement or continuation.
; the only procedure that calls read char is next char which is
; called whenever a new internal character is wanted. next char
; administers a buffer and characters can be stored in the buffer
; in search mode, f.ex. during test for compound, and later on
; the buffer can be emptied in normal mode, f.ex. from the proce-
; dure copytodel, that copies letters and digits up to the next
; delimiter
; on a high level, main sequence administers the processing of the
; fortran-text-fields of different types and length.
; the first character in a field consisting of more than one character
; gives rise to a call of one of the procedures constant,compound or
; text, which processes or tries to process the relevant field.
; at return time from compound, format or copytodel could be called
; , or main sequence could continue the processing.
; fields spread over more than one line will result in byte-values
; as though the entire field was on the first line, followed by a
; number of empty continuation lines.
; c)error reaction:
; a syntactical error in a field causes trouble-bytes to be output
; in stead of the field-bytes, and as a rule the rest of the state-
; ment will be skipped. an exception is a labelfield with one or
; more erroneous characters , where only the labelfield will be
; skipped.
; in the case of error in a format-statement, some correct bytes
; could be output before the trouble-bytes.
; mainclasses for fortran-symbols:
; class containing
; 0 digits
; 1 a i l a i l
; 2 b b
; 3 h h
; 4 e d e d
; 5 f g f g
; 6 x x
; 7 p p
; 8 other letters
; 9 .
; 10 *
; 11 +
; 12 -
; 13 '
; 14 ,
; 15 /
; 16 (
; 17 )
; 18 ; (stat term)
; 19 other delimiters
; 20 in text
; 21 graphic
; 22 nlstat (composite char)
; 23 nlcont ( - - - - - - )
; 24 em
; 25 nl,ff
; 26 illegal
; 27 blind
; use of slang-names:
; a byte values and internal values
; b local variables
; c local labels, inclusive action labels
; d global labels, inclusive entry-points in procedures
; e pass 0 entries
; f global variables
; g table bases
; h not used, fp-names
; i local initialisations
; j global mainclass-values
; test data
;
;
;test of compounds
; assign ;call ; continue -continue;common common/
; complex -data data(-dimension doubleprecision
; double precision do entry equivalence equivalence(
; external function goto go to goto( go to(
; if if( integer -logical long program read read(real return
; return;stop;stop subroutine to write write( zone
;
; .and.;.eq.5..eq.-.false..ge..gt..le..lt..ne.
; .not..or..shift..string..true.**
;c not found
; . eq. assign( con tinue
; end end end
; end;
;c end test
;c copy test
; abcd
; *efghijklmnopqrstu
; *vwxyzæ 1
; *234567890
; end
;
;c constant test state-table-test
; 01 2
; *3+4a..5 6
; *7h+ 1.c+1.2+ 8e+a +8e
; *+1
; *2.+9. 0d1+1e-1e* 1e2h+2e3+2b12+
;c correct numbers
; 838 860 8* 838 860 7+00
; 140 737 488 355 327
; 1.e1000 + 0.0012345678912
; 0.00123456789120e20+
; *0d0 +1d1-
; *1234567890123456789.d1
;c errors
;
; 140 737 488 355 328
; 12345678901234567891d0+
; 0e1001
;c number syntax
; . +1.+ 1.a +1.* 1e1 + 1e e + 1da+ 1d<
; 1e+ d + 1d++
;
;
;c bitpattern test correct values
; 1b1 +1b000011110000111100001111
; 1b111000111000111000111000111000111000111000
; *111000
; 2b0+2b3-2b012301230123
; 2b0123012301230
; 2b321032103210321032103210
; 3b0-3b1-3b01234567+3b012345670
; 3b0123456701234567
; 4b0+4bf+4b012345+4b6789abcdef01
;
;c errors
; 0b123; 5bcdefghi;
; 1b0000111100001111000011110000111100001111000011110
; 2b0000111100001111000011110
; 3b00001111000011110
; 4b0000111100001
; 3b+
; 1b2 ; 2b4 ; 3b8; 4bfg
;
;c text test
;c hollerith-constants and string-quotes
;c correct values
; 1h0;6h1a- &;;
; '0';'1a- &;';5ha
; *bc
; *d
; *e;
;c errors
; 0h12; ''; 7h1234567; '1234567'
; 5h123
; end test of constants
;
;
;c format test - state-table test
;c correct format
; format (12f12.6,5(( e255.255) ,x)/2i32/l2//x/
; *(/,/)/-2p2 1d1.1, 8p g1.1,
; *2x,b 5 . 4 ,2b4.1,((((((((((((((5a 1 00))))))))))))))
; *,2
; *i
; *2)
; *;
; format((a1);format(/;
; format(
; format(
; *)
;c action errors
; format(256a1,x)
; format( 0a1,x)
; format(-52a1,x)
; format(a1,x,0p1f2.2)
; format(0x,a1)
; format(a1,((((((((((((((((((a1,2i2))))))))))))))),a2))))
; format((a1;,
; *12;
; format(2i256,a1)
; format(2i0,a1)
; format(a1,f10.0,f0.0)
; format(a1,f10.11)
; format(x, 2b10.5)
; format(x,2b10.0)
;
;c state-table errors
; format ;iabcd
; format( i2.2)
; format(i2))
;
;c correct text
; format(3ha/b,(4hbc a)/5h<>
; *1+,'a', '123abc<>hf
; */'/)
;c error text
; format(0habc,a1)
; format(i2,'',a1)
; format(i2, 7habc
; end;
;
;
;c list test
;
;
;
;12
;list
; end
;c this is listed
; not listed
;list
; end
;c not listed
;list
;list
; end
;list
; abcd
;12
; end
;
;
;comment 1+
;a test no
;12 program test 12+
;
; a+
;
; __
; 07
;
; -
;comment inside unit
;
;1 8 1a +
;1
; *continue
;1 *
; end
;
;
;c test of test lines
;
;a12 a
;b a
;c a
;d a
;e a
;f *a
;g a
;h b
;i b
;j b
;k b
; end
;
; start pass1
k=e0
s. a16,d36,f42,j27,i2
i0=k
;internal values and bytevalues:
a0=1 ; letterbase abs value: 1
a1= a0+29 ; digitbase 30
a2= a1+10 ; logical base 40
a3= a2+ 2 ; end base 42
a4= a3+ 5 ; real base 47
a5= a4+ 3 ; delimiter base 50
a6= a5+ 8 ; point base 58
a7= a6+ 1 ; start base 59
a8= a7+ 1 ; operator base 60
a9= a8+12 ; termbase 72
a10= a9+ 2 ; compound base 74
a11=a10+11 ; declare base 85
a12=a11+16 ; go on 101
a14=a12+ 5 ; error base 106
a15=e82 ; trouble type
a16=a14+1 ; intext value 107
;mainclasses
j0=0, j1=1 , j2=2 , j3=3, j4=4, j5=5, j6=6, j7=7, j8=8, j9=9, j10=10
j11=11,j12=12,j13=13,j14=14,j15=15,j16=16,j17=17,j18=18,j19=19
j20=20,j21=21,j22=22,j23=23,j24=24,j25=25,j26=26,j27=27
w. i1 ; no.of words in pass1;
h. i2 , 1<1+0 ; relative entry, pass no. plus mode.
b. b0,c1 ; sequence initpass1;
; initpass 1 can be thought of as a sequence in main sequence, though it
; is arranged in its own slang-block like other procedures.
; initpass1 is entered from pass 0, it initialises some variables and
; jumps to main sequence
w. b0: 1<11 ; mask
w.d0: rl. w0 e17. ; initpass1;
rl. w1 f23. ;
sz w0 1 ; if listing wanted then
jl. c0. ; go to set list mode;
al w1 0 ;
sz w0 1<10 ; if conditional listing then
rs. w1 f12. ; dont touch listing:=false;
al w1 1 ;
sz w0 1<1 ; if bit for message is set then
rs. w1 f36. ; message mode:= true;
jl. c1. ; go to not list mode;
c0: rs. w1 d22. ; set list mode:listmode:=true;
c1: al w1 72 ; not list mode:
la. w0 b0. ;
se w0 0 ; if card mode then
rs. w1 f13. ; endstatemfield:=72;
al. w1 e6. ;
rs. w1 f35. ; get linecount address;
jl. d12. ; go to main sequence;
e.
b. b0, c0 ; procedure end pass1;
; end pass 1 can be thought of as a sequence in main sequence and it is
; called from there as:
; jl. d1.
; end pass1 outputs an endpass byte and reestablishes the current
; input buffer situation.
; local variables:
w. b0: 1<16 ; endmarkword
; entry point:
w.d1: al w0 a3+1 ; end pass1:
jl. w3 e3. ; outbyte(end pass);
rl. w3 f5. ;
sn. w3 (e46.) ; if sourcepointer=sourcelist start
jl. c0. ; then go to reestablish current
rl. w2 e23. ; input;
rl. w1 f0. ;
jl w3 x2 e67 ; terminate zone;
jl w3 x2 e45-4 ; unstack current input;
jl. e7. ; end pass;
c0: rl. w1 f2. ; reestablish current input:
rl w3 x1 ;
rl. w0 b0. ; if current word contains
rl. w2 f1. ; 2 characters then
so w2 1 ; begin
ld w0 -8 ; partial word:=1<16;
sn w0 x2 ; record base:= current word addr-4;
ld w0 -8 ; end else
sz w2 1 ; begin
al w1 x1 -2 ; partial word:=preceding character
al w1 x1 -2 ; shift 16 + current word shift(-8);
rl. w3 f0. ; record base:=current word addr-2;
rs w0 x3 e50+4 ; end;
rl. w2 f3. ;
ds w2 x3 e51+2 ; last byte:=last word addr;
rl. w0 f4. ;
rs w0 x3 e50+2 ; restore give up action;
jl. e7. ; end pass;
e.
b. b0, g0 , c6 , i4 ; procedure copytodel
; the procedure is called from main sequence after a call of compound
; when it is found that the char-sequence was not a compound. the call
; is: jl. w3 d2.
; copytodel inputs chars from next char and the first char will be
; <*>,<.> or <letter>. when * or . the relevant byte is output and
; the procedure ends. when it is a letter, all letters and digits are
; copyed and their byte values are output. the copying goes on until a
; terminator for an identifier is read.
; register use:
; call exit
; w0 undefined
; w1 unchanged
; w2 undefined
; w3 return address undefined
; possible output bytes: (during call of outbyte);
; <*>
; <.>
; <letter>
; <digit>
; globals used:
; f25
; local variables:
w. b0: 0 ; return address;
; action table
; mainclass
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
h. g0: i1 , i2, i2, i2, i2, i2, i2, i2, i2, i4, i4, i4, i4, i4, i4,
; class: 15 16 17 18 19 20 21 22 23
i4, i4, i4, i4, i4, i0, i4, i4, i3
; the i-names are intermediate and are to be replaced by c-names as;
; i0:c0 i1 :c2 i2:c3 i3:c4 i4:c5
; entry point
w.d2: rs. w3 b0. ; begin
rl. w2 (f7.); w2:=buffer(charpointer);
bl w0 5 ; internal value:=w2(12:23);
jl. w3 e3. ; outbyte(internal value);
se w0 a6 ; if internal value=pointvalue or
sn w0 a5+5 ; internal value=starvalue then
jl. c6. ; go to copyout;
c0: jl. w3 d11. ; new char: w2:= next char;
bl w3 4 ; mainclass:= w2(0:11);
bl. w3 x3 g0. ; c action:=actiontable(mainclass);
c1: jl. x3 ; go to copyaction(c action);
c2: al w2 x2 a1 ; digit: internal value:=
; internal value+digitbase;
c3: bl w0 5 ; letter:
jl. w3 e3. ; outbyte(internal value);
jl. c0. ; go to new char;
c4: ba. w2 f25. ; nl cont:
hs. w2 f25. ; nlbyte:=nlbyte+1
jl. c0. ; go to new char;
c5: jl. w3 d33. ; finis copy: set pointer;
c6: jl. (b0.); copyout:
; end copytodel;
; assignment of intermediates:
i0=c0-c1, i1=c2-c1, i2=c3-c1, i3=c4-c1, i4=c5-c1
e.
b. b16, c62, g8, i26 ;procedure read char
; the procedure read char is called from procedure next char as
; jl. w3 d3. ,and it defines the next relevant
; internal character by its mainclass and internal value.
; in general read char defines the internal character by reading
; a character from the relevant external medium followed by a table
; lookup in table internal, i.e. 1 internal character pr external
; character.
; exceptions are:
; a) characters in a labelfield on a statement line, i.e. an initial
; -or a continution line, where the field is considered as one
; character defined as follows:
; mainclass: internal labelfield and
; value: continuation mark:
;
; nlstat 1 correct label, no continuation mark
; nlstat 2 wrong label, no continuation mark
; nlstat 3 label and continuation mark
; nlstat 4 no label ,no continuation mark
; nlcont 1 no label ,continuation mark
;
; b) em-character, where the character itself is blind and gives a
; switch to next source. em from last source produces an inter-
; nal character with:
; mainclass: internal value:
; nlstat 5
; c) characters on a comment-or a list-line, which are skipped
; up to next nl or ff-character and a nlcont -character
; is defined,see a).
; eventually the listing-facility is switched on.
;
; d) blind and illegals, which are skipped with no internal charac-
; ter as result. for each illegal in a program unit, an error-
; byte is output.
;
; listing
;
; if the listing facility is switched on,each external character
; except blind,em and illegal's is listed on current output during
; call of the pass0 entry writechar.furthermore the linecounter
; is printed at the beginning of a line during call of print line-
; counter.illegals are substituted by in the list
;
; to decide whether printing has to be done or not,several booleans
; are introduced.printing is done when listmode is true,with
; listmode defined in pseudo algol as:
;
; listmode :=(list.yes) or condlisting or message listing
;
; condlisting :=-,dont touch list and after listline
; and(before end or change list not allowed)
;
; message listing:=(message.yes) and on message line
;
; dont touch list:=(cond.no) or (list.yes)
;
; change list not allowed:=after listline and before compoundsearch
;
;
; alreadylist: in some cases,f.ex. when you read nl on a statement
; line,a character is repeated in the central logic
; and to prevent this caharacter from being printed
; twice,the boolean 'alreadylist' is referred.
;
; linecount is listed:
; in listmode,the linecounter is printed before
; the characters whenever charcount=1.
; illegals do not count on a line,and to prevent a
; double printing of linecounter when an illegal is
; first on a line, 'linecount is listed' is introduced.
;
; register use:
; call exit
; w0 unchanged
; w1 unchanged
; w2 internal character
; w3 return address undefined
;
; possible outputbytes:
; <start program unit>
; <illegal error>
; local variables:
w. b0: 0 ; return address
f41: b1: 0 ; charcount
b2: 0 ; savew0
w. b3: <: hard error <0>:> ; hard error text
w. b4: 1<23+1<15+1<7 ; char value mask
b5: 24<16+24<8+24 ; cansel mask
b6: 0 ; saved char
b7: jl. i23 ; normal block end
b8: rl w3 x3 ; test line cansel
0,b9: 0 ; save registers
w. b10: <: not text :> ; alarm text
w. b11: 8 ; eight
b12: <: : :> ; colontext
w. b13: 0 ; stop
b14: j22<12+4 ; nlstatchar
b15: j23<12+1 ; nlcontchar
b16: <: error at source no :> ; messagetext
; tables:
h. g0:f42: ; internal(1: 128) ;comment contains
; mainclass,internal value.
j27,0 , j26,0 ; nul, soh
j26,0 , j26,0 ; stx,ext
j26,0 , j26,0 ; eot,enq
j26,0 , j26,0 ; ack,bel
j26,0 , j24,0 ; bs ,ht
j25,0 , j26,0 ; nl ,vt
j25,0 , j27,0 ; ff ,cr
j26,0 , j26,0 ; so ,si
j26,0 , j26,0 ; dle,dc1
j26,0 , j26,0 ; dc2,dc3
j26,0 , j26,0 ; dc4,nak
j26,0 , j26,0 ; syn,etb
j26,0 , j24,0 ; can,em
j26,0 , j26,0 ; sub,esc
j26,0 , j26,0 ; fs ,gs
j26,0 , j26,0 ; rs ,us
;
j20,a16 , j21,0 ; sp ,!
j21,0 , j21,0 ; ,
j18,a9+0 , j21,0 ; ,
j21,0 , j13,0 ; & ,'
j16,a5+0 , j17,a5+1 ; ( ,)
j10,a5+5 , j11,a5+2 ; * ,+
j14,a5+4 , j12,a5+3 ; , ,-
j9 ,a6 , j15,a5+6 ; . ,/
j0 ,0 , j0 ,1 ; 0 ,1
j0 ,2 , j0 ,3 ; 2 ,3
j0 ,4 , j0 ,5 ; 4 ,5
j0 ,6 , j0 ,7 ; 6 ,7
j0 ,8 , j0 ,9 ; 8 ,9
j21,0 , j18,a9+0 ; : ,;
j21,0 , j19,a5+7 ; < ,=
j21,0 , j21,0 ; > ,?
j21,0 , j1 ,a0+0 ; ,a
j2 ,a0+1 , j8 ,a0+2 ; b ,c
j4 ,a0+3 , j4 ,a0+4 ; d ,e
j5 ,a0+5 , j5 ,a0+6 ; f ,g
j3 ,a0+7 , j1 ,a0+8 ; h ,i
j8 ,a0+9 , j8 ,a0+10 ; j ,k
j1 ,a0+11 , j8 ,a0+12 ; l ,m
j8 ,a0+13 , j8 ,a0+14 ; n ,o
j7 ,a0+15 , j8 ,a0+16 ; p ,q
j8 ,a0+17 , j8 ,a0+18 ; r ,s
j8 ,a0+19 , j8 ,a0+20 ; t ,u
j8 ,a0+21 , j8 ,a0+22 ; v ,w
j6 ,a0+23 , j8 ,a0+24 ; x ,y
j8 ,a0+25 , j8 ,a0+26 ; z ,æ
j8 ,a0+27 , j8 ,a0+28 ; ø ,
j21,0 , j20,a16 ; & ,-
;
j21,0 , j1 ,a0+0 ; / ,a
j2 ,a0+1 , j8 ,a0+2 ; b ,c
j4 ,a0+3 , j4 ,a0+4 ; d ,e
j5 ,a0+5 , j5 ,a0+6 ; f ,g
j3 ,a0+7 , j1 ,a0+8 ; h ,i
j8 ,a0+9 , j8 ,a0+10 ; j ,k
j1 ,a0+11 , j8 ,a0+12 ; l ,m
j8 ,a0+13 , j8 ,a0+14 ; n ,o
j7 ,a0+15 , j8 ,a0+16 ; p ,q
j8 ,a0+17 , j8 ,a0+18 ; r ,s
j8 ,a0+19 , j8 ,a0+20 ; t ,u
j8 ,a0+21 , j8 ,a0+22 ; v ,w
j6 ,a0+23 , j8 ,a0+24 ; x ,y
j8 ,a0+25 , j8 ,a0+26 ; z ,æ
j8 ,a0+27 , j8 ,a0+28 ; ø ,
j21,0 , j27,0 ; ,del
; classtable
; by table look up in rcclasstable, mainclass is used as index
d31:g1: 1 , 0 , 0 , 0 , 0 , 0 ; rcclasstable (1:28) contains the
0 , 0 , 0 , 7 , 7 , 7 ; local classvalues.
7 , 7 , 7 , 7 , 7 , 7 ;
7 , 7 , 6 , 7 , 7 , 7 ;
3 , 2 , 5 , 4 , ;
g8: i1 ,i1 ,i24,i20,i1 ,i1 ,i1 ,i1 ,i1 ; in / line
; action table
;
h.
; local class
; 0 1 2 3 4 5 6 7 8 state
g2: i2, i3, i4, i19, i8, i5, i18, i12, i20 ; first character
g3: i1, i1, i10,i19, i8, i6, i1 , i1 , i10 ; comment line
g4: i12,i12,i4 ,i19, i8, i5, i18, i12, i20 ; space line
g5: i15,i13,i11,i19, i8, i9, i14, i15, i11 ; labelfield, not empty
g6: i16,i16,i17,i19, i8, i7, i16, i16, i21 ; statement field
g7: i1 ,i1 ,i17,i19, i8, i7, i1 , i1 , i21 ; comment field
; the i-names are intermediate action addresses. they are to be
; replaced by c-names in the manner shown below:
; i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11
; c1 c23 c25 c26 c28 c29 c29 c31 c29 c33 c34
;
; i12 i13 i14 i15 i16 i17 i18 i19 i20 i21 i24
; c36 c37 c38 c41 c42 c43 c46 c47 c49 c50 c60
;
; an explanation of the local classes is as follows:
; class contains
; 0 letters
; 1 digits
; 2 nland ff
; 3 em
; 4 blind
; 5 illegal
; 6 in text
; 7 other mainclasses
; 8 stop character , i.e. em from last source
; entry point
w.
d3: rs. w3 b0. ; begin
rs. w0 b2. ; save w0:=w0;
rx. w1 b1. ; charcount:= oldcharcount;
c52: jl. c15. ; go to first time;comment
; after the first call the instruction is:
; jl. c1. ; if repeat char then
; or jl. c48. ; go to fetch saved char else
; go to rc next char;
;
c0: hs. w3 i0 ; set rcstate: state:=new state;
c1: rl. w3 f1. ; rc next char:
al w2 0 ;
ld w3 8 ;
sn w3 0 ; if current word empty then
jl. c11. ; go to next word;
c2: rs. w3 f1. ; retword:
hs. w2 f30. ; ,extchar:= in char;
wa w2 4 ;
al w1 x1 + 1 ; charcount:= charcount+1;
rl. w2 x2 g0. ; read char:= w2:= internal(extchar);
c3: bl w3 4 ; after in: mainclass:= w2(0:11);
d22:c4:bl. w3 x3 g1. ; rcclass : lclass:=rcclasstable(mainclass);
;can be jl. c7. ; if listmode then go to listing;
c5: bl. w3 x3 ; rcaction:
c6: jl. x3 ; go to action( lclass,state);
c48: al w3 c1-c52 ; fetch saved char:
hs. w3 c52.+1 ; repeat char:=false;
rl. w2 b6. ; w2:= saved char;
jl. c2. +2 ; go to ret word;
d23:c7: rs. w0 b9. ; listing: saveregisters:=w0;
al w0 0 ;
se w3 j27 ; if mainclass=blind or
sn w3 j24 ; mainclass=em then
jl. c10. ; go to nolist;
c8: sn w0 ; if -, alreadylist then
jl. c57.; go to list linecount;
hs. w0 c8.+1 ; alreadylist:= false;
jl. c10. ; go to no list;
c57: sn w1 1 ; list linecount: if charcount<>1
c58: sn w1 ; or linecount is listed then
jl. c9. ; go to list;
jl. w3 e27. ; list linecount;
al w0 32 ;
jl. w3 e12. ; writechar(sp);
bl w3 4 ;
c9: bl. w0 f30. ; list: char:= extchar;
sn w3 j26 ; if mainclass=illegalclass then
al w0 63 ; char:= 63; comment ? ;
jl. w3 e12. ; writechar;
c10: rl. w0 b9. ; nolist: w0:= saveregisters;
bl w3 4 ; mainclass:= w2(0:11);
bl. w3 x3 g1. ; lclass:= rcclasstable(mainclass);
jl. c5. ; go to rcaction;
c11: rl. w3 f2. ; next word: if current word addr
sl. w3 (f3.); >= last word addr then
jl. c12. ; go to next block;
al w3 x3 2 ; current word addr:=
rs. w3 f2. ; current word addr + 2;
rl w3 x3 ;
sz. w3 (b4.); if word contains chars>127 then
jl. c14. ; go to text format error;
al w2 0 ; current word:=
ld w3 8 ; buffer(current word addr);
al w3 x3 + 1 ; set word end indication;
jl. c2. ; go to retword;
c12:rs. w1 b9. ; next block:
jl. w3 (f9.); input block;
dl w3 x1 + e51+2 ; current word addr:= record base;
ds. w3 f3. ; last word addr := last byte;
rl. w1 b9. ; if endblock action= normal then
c13:jl. c11. ; go to next word;comment in test
; line cansel action the return jump is overwritten by
; rl w3 x3
lx. w3 b5. ; if buffer(last word addr) contains
sz w3 1<8-1 ; cansel character
ls w3 -8 ; then go to next block
sz w3 1<8-1 ; else go to next word;
ls w3 -8 ;
sz w3 1<8-1 ;
jl. c11.;
jl. c12.;
c14: al w2 b10.-2 ; text format error: prepare alarm;
jl. c19. ; go to error in connect;
c15: am. (e23.); first time:
al w0 e28-2 ; get addr input block current input;
rs. w0 f9. ;
am. (e23.);
al w1 e22 ; get abs addr current descriptor;
rs. w1 f0. ;
rl w0 x1 e50+2 ;
rs. w0 f4. ; save give up action;
rl. w3 e46. ;
rs. w3 f5. ; sourcepointer:=start source list;
rl w0 x3 ;
al w3 c1-c52 ; repeat char:=false;
hs. w3 c52.+1 ;
al w3 g2-c5 ; state:= first char;
hs. w3 c5.+1 ;
sn w0 0 ; if source list empty then
jl. c17. ; go to medium connected;
am. (e23.);
jl w3 e44-4 ; stack current input;
c16: rl. w2 f5. ; connect source:
al w3 x2 8 ;
rs. w3 f5. ;
am. (e23.);
jl w3 e31-2 ; connect current input to source;
bl w3 x2 16 ; sourcepointer:=sourcepointer+1;
sn w3 0 ; if content<> normal text or
se w0 0 ; hard error then
jl. c19. ; go to error in connect;
c17: dl w0 x1 e51+2 ; medium connected:
al w3 x3 2 ; current word addr:= record base+2;
ds. w0 f3. ; last word addr:=last byte;
rl w0 x1 e50+4 ;
rs. w0 f1. ; current word:= partial word;
bl w0 x1 e49+1 ;
rl. w3 b7. ; end next block action:=
sn w0 8 ; normal block end;
rl. w3 b8. ; if kind= type writer then
rs. w3 c13.; end next block action:=
al. w3 c18.; test line cansel;
rs w3 x1 e50+2 ; set give up action;
dl. w1 b9. ; restore registers;
jl. c1. ; go to rcnextchar;
c18: al. w2 b3.-2 ; give up action: prepare alarm;
c19: al. w1 b16. ; error in connect:
jl. w3 e4. ; message(<:error at source no:>);
rl. w0 f5. ;
ws. w0 e46. ;
al w3 0 ;
wd. w0 b11. ;
jl. w3 e14. ; writeinteger(<<d>,source no>);
1 ;
al. w1 b12. ; writetxt(<: : :>);
jl. w3 e13. ;
al w1 x2 2 ;
jl. w3 e13. ; writetext(<: source name:>);
d24:c20: al w0 1 ; terminate: unsuccesfull execution
rs. w0 e40. ; := other reason;
jl. e26. ; go to fp end program;
c21: rl. w2 (f5.) ; next source:
sn w2 0 ; if sourcelist empty then
jl. c22. ; go to finischar;
ds. w1 b9. ; save registers;
rl. w1 f0. ;
am. (e23.);
jl w3 e67 ; terminate zone;
jl. c16. ; go to connect source;
c22: rs. w3 b13. ; finischar: stop:=lclass;
bl. w2 f30. ; char:= extchar;comment em;
jl. c5. ; go to rcaction;
;
; the read char-actions start here
;
c23: bl w3 5 ; letter as first char:
al w3 x3 -a0 ; letter value:= internal value-
sh w3 10 ; letterbase;if lettervalue<=10 then
jl. c24. ; go to test line;
sn w3 11 ; if lettervalue=11 then
jl. c53. ; go to list line;
se w3 12 ; if lettervalue<>12 then
jl. c36. ; go to graphical char on spaceline;
c62: ;commentline:
sn. w1 (f36.); if not message mode or
sn. w1 (f38.); cond list then
jl. c55. ; go to comment line;
rs. w1 f37. ; message: message list:=true;
jl. c54. ; go to print linestart;
c53: ; list line:
hs. w1 f27. ; change list not allowed:=true;
se. w1 (f12.); if dont touch listing or
sn. w1 (f38.); cond list then
jl. c55. ; go to comment line;
rs. w1 f38. ; cond list:=true;
c54: rl. w2 f23. ; print linestart:
rs. w2 c4. ; listmode:=true;
jl. w3 e27. ; print linecount;
al w0 32 ;
jl. w3 e12. ; writechar(sp);
bl. w0 f30. ; writechar(extchar);
jl. w3 e12. ;
c55: al w0 0 ; comment line:label:=0;
i25=k+1 ; the state is modified in case of a / line
al w3 g3-c5 ; state:= comment line;
jl. c0. ; go to set rcstate;
c24: al w2 1 ; testline: w2:=1 shift lettervalue+13;
ls w2 x3 13 ; if bit(w2) in translatormode bits
la. w2 e29. ; then
se w2 0 ; goto intext on spaceline
jl. c46. ; else
al w3 g3-c5 ; state := commentline;
jl. c0. ; go to set rcstate;
c25: al w3 g5-c5 ; digit as first char:
bl w0 5 ; state:= labelfield not empty;
hs. w1 b14.+1 ; label:= internal value;
jl. c0. ; internal nlstatvalue:=1;
; go to set rcstate;
c26: al w2 0 ; nlon spaceline:
c27: sn w2 ; if -, countmark then
jl. c45. ; go to prepare next line;
hs. w2 c27.+1 ; countmark:=false;
al w3 g2-c5 ; state:= first character;
rl. w2 b15. ; read char:= nlcontchar;comment
; continuation line;
jl. c35. ; go to prepare repetition;
c28: hs. w1 c27.+1 ; illegal on spaceline:
hs. w1 c58.+1 ; countmark:=linecount is listed:=true;;
c29: ds. w1 b9. ;illegal:
al w2 0 ;
sn. w2 (f39.); if out begin unit then
jl. c30. ; begin
rs. w2 f39. ; out begin unit := false
al w0 a7 ; outbyte(start unit byte)
jl. w3 e3. ; end
c30: rl. w3 e6. ;
al w0 a15+0 ;
bl. w1 f30. ; out4byte ( trouble,
hs w0 2 ; illegal error, extchar,
jl. w2 d7. ; linecount);
dl. w1 b9. ; reestablish registers;
c31: al w1 x1 -1 ; blind: charcount:= charcount-1;
jl. c1. ; go to rc next char;
c33: rl. w2 b15. ; nl on comment line: read char:=
jl. c35. ; nlcontchar; go to prepare repetition;
c34: rl. w2 b14. ; nl in labelfield:
; read char:= nlstatchar;
c35: hs. w1 c8.+1 ; prepare repetition:
rs. w0 f10. ; alreadylist:=true; label:= w0;
al w3 g6-c5 ; state:= statementfield;
hs. w3 c5.+1 ; set state;
bl. w3 f30. ;
rs. w3 b6. ; saved char:=extchar;
al w1 x1 -1 ; charcount:=charcount-1;
al w3 c48-c52 ; repeat char:=true;
hs. w3 c52.+1 ;
jl. c51. ; go to rcout;
c36: sn w1 6 ; graphical charon spaceline:
jl. c40. ; if charcount=6 then goto continue;
sl w1 6 ; if charcount > 6 then
jl. c34. ; go to nl in labelfield; comment
se w1 1 ;
jl. c59. ;
bl w3 4 ;
sn w3 j10 ; if class = * and char count = 1
jl. c55. ; then goto comment line
se w3 j15 ; if class = / and char count = 1
jl. c59. ;
al w3 g8-c5 ;
hs. w3 i25. ; force state to: in / line
jl. c62. ; goto commentline
c59: ;
; the character is read again at the next call and this time an
; nlstatchar is output
hs. w1 c8.+1 ; alreadylist:= true;
al w3 g5-c5 ; state:=labelfield not empty;
hs. w3 c5.+1 ; set state;
jl. c3. ; go to after in;
c60: rl. w3 c61. ;nl or ff on / line:
rs. w3 c3. ;
jl. c1. ; read the first char on the next line and
c61: jl. i26 ; return to: stopcharacter on spaceline
c37: sn w1 6 ; digit in label: if charcount=6 then
jl. c40. ; go to continue;
wm. w0 f20. ; label:= label * 10
ba w0 5 ; + internal value;
al w3 1 ;
bl. w2 b14.+1 ; if internal nlstatvalue<>2 then
se w2 2 ; internal nlstatvalue:=1;
hs. w3 b14.+1 ;
jl. c1. ; go to rc next char;
c38: se w1 6 ; intext inlabel:if charcount<>6 then
jl. c1. ; go to rc next char;
rs. w0 f10. ; label:=w0;
al w0 48 ; w0:=cchar:=48;
jl. c39. ; goto set continue state;
c40: rs. w0 f10. ; continue: label:=w0;
bl. w0 f30. ; w0:=cchar:=extchar;
c39: al w3 g6-c5 ; set continue state:
hs. w3 c5.+1 ; state:=statementfield;set state;
rl. w2 b14. ; read char:=nlstatchar;
sn w0 48 ; if cchar=48 then
jl. c51. ; go to rcout;
al w3 0 ;
hs. w3 b14.+1 ;
se. w3 (f11.); if outside unit then
jl. c56. ; go to label and continue;
bl w3 5 ;
rl. w2 b15. ; read char:= nlcontchar;
sn w3 4 ; if internal nlstatvalue=4 then
jl. c51. ; go to rc out;
c56: ; label and continue:
al w2 3 ; internal nlstatvalue:=3; comment
lo. w2 b14. ; error in label field;
bl. w3 f30. ;
hs. w3 f31. ; save error:= extchar;
jl. c51. ; go to rcout;
c41: sn w1 6 ; wrong char in label: if charcount=6
jl. c40. ; then go to continue;
bl. w3 b14.+1 ;
sn w3 2 ; if internal nlstatvalue=2 then
jl. c1. ; go to rc next char;
al w2 2 ;
hs. w2 b14.+1 ; internal nlstatvalue:=2;
bl. w2 f30. ;
hs. w2 f31. ; save error := extchar;
jl. c1. ; go to rc next char;
c42: sh. w1 (f13.); char in statement field:
jl. c51. ; if charcount<=endstatemfield
; then go to rcout;
al w3 g7-c5 ; state:= comment field;
jl. c0. ; go to set rcstate;
c43: al w0 0 ; nl on statementline:
jl. w3 e1. ; count line;
sn. w0 (f37.); if -, message list then
jl. c45. ; go to prepare next line;
rs. w0 f37.; message list:= false;
rl. w3 f33. ;
rs. w3 c4. ; list mode:= false;
c45: al w0 0 ; prepare next line:
hs. w0 c8.+1 ; alreadylist:=false;
hs. w0 c58.+1 ; linecount is listed:=false;
al w1 0 ; label:= charcount:=0;
al w2 4 ; internal nlstatvalue:= 4; comment
hs. w2 b14.+1 ; for empty labelfield;
al w3 g2-c5 ; state:= first character;
jl. c0.; go to set rcstate;
c46: al w3 g4-c5 ; intext on spaceline:
bl. w2 f30.; state:= space line;
se w2 32 ; if extchar<> sp then
hs. w1 c27.+1 ; countmark:=true;
jl. c0.; go to set rcstate;
c47: al w3 8 ; em: lclass:=8; comment stop class;
al w1 x1 -1 ; charcount:=charcount-1;
se. w3 (b13.); if stop<>lclass then
jl. c21. ; go to next source;
jl. c5. ; go to rcaction;
c49: rl. w1 e6. ; stop character on spaceline:
al w1 x1 -1 ; if -, outside then
am. (f11.); linecount :=
sn w1 x1 0 ; linecount-1;
rs. w1 e6. ;
c50: bl. w1 b14. ; stop character on statementline:
al w2 5 ; read char:= nlstateclass*2**12+5;
hs w1 4 ;
c51: rl. w0 b2. ; rcout: reestablish w0;
rx. w1 b1. ; oldcharcount:=charcount;
jl. (b0.) ; end read char;
; assignment of intermediates:
i0 = c5-c0+1
i1 = c1-c6 , i2 = c23-c6, i3 = c25-c6, i4 = c26-c6, i5= c28-c6
i6 = c29-c6, i7 = c29-c6, i8 = c31-c6, i9 = c29-c6, i10= c33-c6
i11= c34-c6, i12= c36-c6, i13= c37-c6, i14= c38-c6, i15= c41-c6
i16= c42-c6, i17= c43-c6, i18= c46-c6, i19= c47-c6, i20= c49-c6
i21= c50-c6, i22= b1- c52, i23= c11-c13, i24= c60-c6, i26=c49-c3
e.
b. b9, c37, g8 , i45 ; procedure format;
; the procedure is called from main sequence after a call of compound
; when a <start format>-byte is output, and the call is:
; jl. w3 d4.
; as a result a format-statement is converted and packed, partly
; by call of longtext and field descriptor, into elements of 2 bytes.
; format-elements are output,separated by formatc-bytes and terminated
; by an end-format record.
; register use:
; call exit
; w0 undefined
; w1 undefined
; w2 undefined
; w3 return address undefined
; possible outputbytes: (during call of out3bytes and out4bytes)
; <formatc> <2 bytes with a format-element>
; <end format><size of format><maxcount of parentheses>
; <trouble><format error><comma no.><0>
; globals used:
; f7, f14, f15, f20, f25, f32
; local variables:
w. b0: 0 ; return address
b1: 0 ; minus
h. b2: 0 ; error
b3: 0 ; comma
b4: 0 ; parentheses
b5: 0 ; repcount
w. b6: 0 ; max parenth
b7: 0 ; size of format
; b8: i10<20+1<4+1 ; empty format element: 1x)
; defined just before entry;
b9: 1<12 ; maxsize of format
; tables
h. g0: ; desctable(1:12);comment
i13 , i14 , 0 , i15 ; a , b, c, d
i16 , i17 , i18 , 0 ; e , f, g, h
i19 , 0 , 0 , i20 ; i , j, k, l;
h. g1: 0 , 1 , 1 , 3 , 1 , 1 ; classtable(1:24); contains the
2 , 5 , 14, 14, 14, 14 ; local classes;
6 , 4 , 7 , 8 , 9 , 10 ;
13, 14, 11, 14, 13, 12 ;
; the local classes are:
; class containing
; 0 digits
; 1 b f e d g i l a
; 2 x
; 3 h
; 4 apostrophe
; 5 p
; 6 -
; 7 ,
; 8 /
; 9 (
; 10 )
; 11 in text
; 12 nl cont
; 13 stat term and nl stat
; 14 others
; action table:
; local class:
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 state
h.g2:i22,i22,i22,i22,i22,i22,i22,i22,i22,i23,i22,i21,i43,i22,i22 ;
; skip to parenth;
g3:i24,i30,i31,i22,i33,i22,i44,i22,i34,i26,i42,i21,i43,i22,i22 ;
; after first par;
g4:i24,i30,i31,i22,i33,i22,i44,i22,i34,i26,i22,i21,i43,i22,i22 ;
; new group
g5:i25,i28,i32,i33,i22,i29,i22,i22,i22,i27,i22,i21,i43,i22,i22 ;
; repeat factor
g6:i22,i22,i22,i22,i22,i22,i22,i37,i38,i22,i36,i21,i43,i22,i22 ;
; repeat end count.
g7:i38,i38,i38,i22,i38,i22,i38,i37,i38,i38,i35,i21,i43,i22,i22 ;
; after slash
g8:i40,i40,i40,i40,i40,i40,i40,i40,i40,i40,i40,i21,i43,i45,i40 ;
; term format
; the i-names are intermediate action adresses which are to be
; replaced by c-names as:
; i21 i22 i23 i24 i25 i26 i27 i28 i29 i30 i31 i32
; c1 c5 c6 c7 c8 c9 c10 c15 c16 c17 c19 c20
;
; i33 i34 i35 i36 i37 i38 i40 i42 i43 i44
; c21 c22 c23 c24 c25 c26 c31 c29 c34 c35
; i45
; c36
; packing of format elements:
; <format element>::=<byte1> <byte2>
;
; <byte1> ::=<type><8+ ( <d-spec>)
; ( <b-spec>)
; ( <s-spec>)
; ( 0 )
;
; <byte2> ::=(<w-spec>)<4+ <repeat end count>
; ( 0 )
; or <r-spec>
; or <signed scale-spec>
; format-types
i14=1 ; 1: bw.d
i17=2 ; 2: fw.d
i16=3 ; 3: ew.d
i18=4 ; 4: gw.s
i15=5 ; 5: dw.d
i19=6 ; 6: iw.d
i20=7 ; 7: lw
i13=8 ; 8: aw
i10=9 ; 9: rx ,packed as xw
i9 =10 ; 10: rp
i11=11 ; 11: /
i12=12 ; 12: r( explicit
i8 =13 ; 13: r( implicit
; 15: end format,packed by another pass
w. b8: i10<20+1<4+1 ; empty format element: 1x)
; entry point
w.d4: rs. w3 b0. ; begin
al w0 1 ;
rs. w0 b2. ; comma:= 1
al w0 0 ; error:=
rs. w0 b4. ; parentheses:=repcount:=
rs. w0 b1. ; minus:=0;
rs. w0 b6. ; max parenth:= 0;
al w0 2 ;
rs. w0 b7. ; size:= 2;
al w0 a12+4 ;
hs. w0 f32. ; last of out4bytes:=formatc;
al w3 i1 ; state:= skip to parenth;
c0: hs. w3 i0 ; set format state:
c1: jl. w3 d11. ; new char: w2:= next char;
c2: bl w3 4 ; after in: mainclass:= w2(0:11);
bl. w3 x3 g1. ; local class:=classtable(mainclass);
c3: bl. w3 x3 ; format action:
c4: jl. x3 ; go to action(local class,state);
; comment action 0: go to new char;
c5: al w3 1 ; error action:
hs. w3 b2. ; error:=true;
jl. c28. ; goto end format;
c6: al w3 1 ; first left par:
hs. w3 b4. ; parentheses:=1;
rs. w3 b6. ; maxparenth:=1;
al w3 i2 ; state:=after first par;
jl. c0. ; go to set format state;
c7: bl w1 5 ; first digit in group:
al w3 i4 ; repfactor:=internal value;
jl. c0. ; state:= repeat factor;
; go to set format state;
c8: wm. w1 f20. ; digit in repeat factor:
ba w1 5 ; repeat factor:=repeat factor*10
sl w1 256 ; + internal value;
jl. c5. ; if repeat factor >=256 then
; go to error action;
jl. c1. ; go to new char;
c9: al w1 1 ; implied factor of one:
c10: bl. w3 b4. ; explecit repeat begin:
al w3 x3 1 ; parentheses:=parentheses+1;
hs. w3 b4. ;
sl. w3 (b6.); if parentheses>=maxparenth
rs. w3 b6. ; then maxparenth:=parentheses;
jl. w3 d11. ; w2:=next char;
al w0 i12<7 ; elementtype:=explecit repeat begin;
ls w0 1 ;
c11: rl. w2 b1. ; rep out:
se w1 0 ; if repfactor=0 or
se w2 0 ; minus then
jl. c5. ; go to error action;
hs w0 2 ; w1(0:11):=elementtype;comment
; w1(12:23)=repeat factor;
c12: jl. w2 c30. ; out element:
; out3bytes(w1(0:1)w1(12:23),
; last of out4bytes);
c13: al w3 i3 ; after out element:
; state:=new group;
c14: hs. w3 c3.+1 ; set f state: set state;
rl. w2 (f7.); w2:= buffer(charpointer);
jl. c2. ; go to after in;
c15: al w0 1 ; implied repeat begin:
hs. w0 b5. ; repcount:=1;
al w0 i8<7 ; elementtype:=implied repeat begin;
ls w0 1 ;
jl. c11.; go to rep out;
c16: al w2 0 ; scale factor:
se. w2 (b1.); if minus then
ac w1 x1 ; repfactor:= -repfactor;
rs. w2 b1. ; minus:=false;
al w0 i9<7 ; elementtype:=scale factor;
ls w0 1 ;
hs w0 2 ; w1(0:11):=elementtype;
jl. w2 c30.; out3bytes(w1(0:11),w1(12:23),
; last of out4bytes);
al w2 0 ; fdstate:=1;
jl. w3 d13. ; field descriptor(fdstate);
se w2 0 ; if error then
jl. c5. ; go to error action;
se w0 1 ; if no waitbytes then
jl. c13. ; go to after out element;
jl. c15. ; go to implied repeat
c17: bl w3 5 ; letter descriptor:
al w2 1 ; fdstate:=2; waitbytes(0:11):=
bz. w3 x3 g0.-a0 ; descript type := desctable(
ls w3 8 ;
hs. w3 f15. ; internal value-letterbase);
sl w3 6<8 ; if descript type>=6 then
al w2 2 ; fdstate:=3;
jl. w3 d13. ; field descriptor(fdstate);
se w2 0 ; if error then
jl. c5. ; go to error action;
c18: al w3 i5 ; prepare field end:
bl. w1 b5. ; state:=repeat end count;
bl. w0 b4. ; w1:=repcount; w0:=parentheses;
jl. c14. ; go to set f state;
c19: al w1 1 ; one space implied: repfactor:=1;
c20: al w0 i10<7 ; space descriptor: descripttype:=9;
ls w0 1 ;
sn w1 0 ; comment x-type; if repfactor=0
jl. c5. ; then go to error action;
ls w1 4 ;
hs w0 2 ; waitbytes:=(descripttype shift 20)
rs. w1 f15. ; +(repfactor shift 4);
jl. w3 d11. ; next char;
jl. c18. ; go to prepare field end;
c21: rs. w1 f14. ; start longtext: repfactor:= w1;
al w1 0 ; out3byte( 0, 0,last of
jl. w2 c30.; out4bytes);
rs. w1 f15. ; waitbytes:=0;
rl. w2 (f7.) ; w2:=buffer(charpointer);
jl. w3 d14. ; longtext;
se w1 0 ; if error then
jl. c5. ; go to error action;
jl. w3 d11. ; next char;
jl. c18. ; go to prepare field end;
c22: al w0 i11<7 ; slash field:
ls w0 13 ; waitbytes:=slashtype shift 20;
rs. w0 f15. ;
bl. w0 b4. ; w0:=parentheses;
al w1 0 ; repcount:=0;
al w3 i6 ; state:= after slash;
jl. c0. ; go to set format state;
c23: al w3 i5 ; right par after slash:
hs. w3 c3.+1 ; state:= repeat end count;
c24: al w1 x1 +1 ; repeat end counting:
sl w1 16 ; repcount:=repcount+1;
jl. c5. ; if repcount>=16 then
bs. w0 1 ; goto error action;
sn w0 0 ; parentheses:=parentheses-1;
jl. c28. ; goto if parentheses=0 then
jl. c1. ; end format else new char;
c25: bl. w2 b3. ; comma group end:
al w2 x2 1 ; comma:= comma+1;
hs. w2 b3. ;
jl. w3 d11. ; w2:= next char;
c26: hs. w0 b4. ; group end: parentheses:=w0;
al w0 0 ;
hs. w0 b5. ; repcount:=0;
lo. w1 f15. ; w1:=waitbytes add w1;comment w1
; contains the old repcount value;
jl. c12. ; go to out element;
c28: lo. w1 f15. ; end format:comment w1 contains
al w3 a12+3 ; repcount;last of out4bytes
hs. w3 f32. ; := end format;
jl. w2 c30. ; w1:=w1+waitbytes;
rl. w0 b7. ; out3bytes(w1(0:11),w1(12:23),
jl. w3 e3. ; last of out4bytes);
rl. w0 b6. ; outbyte(size);
ba. w0 1 ;
ls w0 1 ;
jl. w3 e3. ; outbyte((maxparenth+1)*2);comment
; one implicit ( can be stacked
bl. w2 b2. ; in the io-procedures;
se w2 0 ; if error then
jl. c31. ; goto out errorbytes;
al w3 i7 ; state:= terminate format;
jl. c0. ; goto set format state;
c29: rl. w1 b8. ; empty format:
; w1:=end format element;
jl. c28.+2 ; goto end format;
d35:c30: rl. w3 b7. ; stepping stone for out3bytes:
al w3 x3 +2 ; called as jl. w2 d8.;
rs. w3 b7. ; size:=size+2;
sl. w3 (b9.); if size >=maxsize of format
jl. d5. ; then goto error action;
jl. d8. ; out3bytes;
c31: al w3 0 ; out errorbytes:
bl. w1 b3. ;
al w0 a15+6 ; out4bytes(trouble,format error,
hs w0 2 ; comma,0);
jl. w2 d7. ;
jl. w3 d15. ; set pointer;
c32: jl. w3 d11. ; skip chars: w2:=next char;
bl w3 4 ; mainclass:= w2(0:11);
sn w3 j22 ; if mainclass= nlstatclass then
jl. c36. ; go to format out;
se w3 j23 ; if mainclass<>nlcontclass then
jl. c32. ; go to skip chars;
ba. w2 f25. ; nlbyte:=nlbyte+1;
hs. w2 f25. ;
jl. c32. ; go to skip chars;
c34: ba. w2 f25. ; nlcont:
hs. w2 f25. ; nlbyte:= nlbyte+1;
jl. c1. ; go to new char;
c35: rs. w2 b1. ; minus in new group: minus:=true;
al w3 i3 ; state:=new group;
jl. c0. ; go to set format state;
c36: jl. w3 d15. ; format out: set pointer;
jl. (b0.); end format;
; assignment of intermediates:
i0 =c3-c0+1
i1 =g2-c3, i2 =g3-c3, i3 =g4-c3, i4 =g5-c3, i5 =g6-c3
i6 =g7-c3, i7 =g8-c3
i21=c1 -c4, i22=c5 -c4, i23=c6 -c4, i24=c7 -c4, i25=c8 -c4
i26=c9 -c4, i27=c10-c4, i28=c15-c4, i29=c16-c4, i30=c17-c4
i31=c19-c4, i32=c20-c4, i33=c21-c4, i34=c22-c4, i35=c23-c4
i36=c24-c4, i37=c25-c4, i38=c26-c4, i40=c31-c4
i42=c29-c4, i43=c34-c4, i44=c35-c4, i45=c36-c4
e.
b. c1 ; procedure byte newline
; it is called from main sequence and constant when a field has
; been processed and we want to output a number of <end line>-
; bytes corresponding to the number of nlcont-chars picked up
; during processing. the global nlbyte holds this number.
; the call is:
; jl. w2 d5.
; register use:
; call exit
; w0 <end line>
; w1 0
; w2 return address unchanged
; w3 undefined
; globals used: f25
w.d5: al w0 a12 ; begin
bl. w1 f25. ;
jl. c1. ; for i :=1 step 1 until nlbyte do
c0: jl. w3 e3. ;
al w1 x1 -1 ; outbyte(<end line>);
c1: se w1 0 ;
jl. c0. ; nlbyte :=0;
hs. w1 f25. ;
jl x2 ; end byte newline;
e.
b. b0,c0 ; procedure outputc(leading byte,
; start address,last address);
; outputc is called from constant,main sequence,text and bitpattern
; and it outputs a number of bytes, i.e. leading byte followed by
; the bytes from byte(start address+1) to byte(last address).
; the call is:
; jl. w3 d6.
; register use:
; call exit
; w0 leading byte undefined
; w1 start address last address+1
; w2 last address unchanged
; w3 return address undefined
; local variables:
w. b0: 0 ; return address
w.d6: rs. w3 b0. ; begin w0:=leading byte;w1:=startaddr;
c0: jl. w3 e3. ; next out: outbyte(w0);
al w1 x1 1 ; w1:=w1+1;
bl w0 x1 ; w0:=byte(w1);
sh w1 x2 ; if w1<= last address then
jl. c0. ; go to next out;
jl. (b0.) ; end outputc;
e.
b. ; procedure out4bytes(b1,b2,b3,b4);
;
; the procedure has 4 entries called out4bytes,out3bytes,out2bytes
; and out1byte, and from 4 to 1 bytes , specified in the parame-
; ters, are output.
; out4bytes is called when trouble-bytes are to be output and b1
; always equals <trouble>. b2 and b3 are specified in register w1
; and b4 in w3 at the entry but it is stored in the global
; last of out4bytes . when other entries are called this global
; must be set before. the call is
; jl. w2 d7. ; out4bytes
; jl. w2 d8. ; out3bytes
; jl. w2 d9. ; out2bytes
; jl. w2 d10. ; out1byte
; register use:
; call exit
; w0 undefined
; w1 b2,b3 unchanged
; w2 return address unchanged
; w3 b4 undefined
; globals used: f32
; entries:
w.d7: hs. w3 f32. ; begin last of out4bytes:=b4;
al w0 a14 ;
jl. w3 e3. ; outbyte(trouble);
d8: bl w0 2 ; out3bytes:
jl. w3 e3. ; outbyte(b2);
d9: bl w0 3 ; out2bytes:
jl. w3 e3. ; outbyte(b3);
d10: bl. w0 f32. ; out1byte:
jl. w3 e3. ; outbyte(last of out4bytes);
jl x2 ; end out4bytes;
e.
w.
d29: jl. e3. ; stepping stone for outbyte;
d30: jl. e13. ; stepping stone for writetext;
d32: jl. d1. ; stepping stone for endpass1;
d33: jl. d15. ; stepping stone for set pointer;
d34: jl. e12. ; stepping stone for writechar
b. b2, g0, c8, i0 ; procedure next char;
; the procedure next char is called from different procedures
; whenever a new character is wanted and it is called as:
; jl. w3 d11.
; next char administers a buffer and uses the global variables
; charpointer and bufpointer to point at last used character and
; last buffercharacter.
; the characters are input from read char and the last used character
; is always stored in the buffer. in search mode more characters can
; be stored, and it happens when charpointer = bufpointer.
; the buffer is emptied in normal mode when charpointer < bufpointer.
; a special thing is:
; in search mode nlcontchars from read char are not stored in the
; buffer but used to update the variable nlcontcount.
; registeruse:
; call exit
; w0 unchanged
; w1 unchanged
; w2 internal character
; w3 returnaddress undefined
; local variables:
w. b0: 0 ; return address
b2: 0 ; saved char count
b1: jl. i0 ; empty mode
; table ;
w.
d25:g0: 0 , r.20 ; buffer(1:20);
; entry point
w.d11: rs. w3 b0. ; begin
rx. w1 f7.; save register w1;
d26:c0:al w1 x1 2 ; empty or not: if emptybuffer then
; go to new char;
; charpointer:= charpointer+1;
rl w2 x1 ; next char:= buffer(charpointer);
sh. w1 (f8.); if charpointer<=bufpointer then
jl. c6.; go to ncout;
d27:c1:al. w1 g0.; normal: bufpointer:=charpointer:=
rs. w1 f8.; bufbase;comment can be
rl. w2 b1.; go to search mode;
rs. w2 c0. ; emptybuffer:=true;
jl. c4. ; go to new char;
d28:c2:rs. w1 f8. ; search mode: bufpointer:=charpointer;
c3: rl. w3 f41. ;get char:
rs. w3 b2. ; save char count
jl. w3 d3. ; nextchar:=readchar
c8: bl w3 4 ;examine char:
se w3 j20 ;
jl. c7. ; if char = intext
sn w2 x1 (-2) ; and char = last char then
jl. c3. ; goto getchar
c7: se w3 j23 ; if main class <> nl cont class then
jl. c5. ; goto store char
ba. w2 f26. ;
hs. w2 f26. ; nlcount:=nlcount+1
rl. w3 b2. ;
sl. w3 (f13.); if saved char count >= endstatem field then
jl. c3. ; goto get char
rl. w2 f42.+64 ; nextchar:=intext
jl. c8. ; goto examine char
c4: jl. w3 d3. ; new char: next char:= read char;
c5: rs w2 x1 ; store char:
; buffer(charpointer):=next char;
c6: rx. w1 f7. ; ncout: reestablish w1;
jl. (b0.); end next char;
; assignment of intermediate:
i0= c4- c0
e.
b. b2, c13 ;procedure set search mode
w.
0 ; saved w0
b1: 0 ; saved w1
b2: 0 ; return address
d36: ;entry point:
rs. w3 b2. ; save return
rl. w3 f7. ;
sn. w3 d25. ; if charpointer = buffer base then
jl. c13. ; goto after copying
ds. w1 b1. ; save w0, w1
al. w1 d25. ;
rs. w1 f7. ; char pointer := buffer base
jl. c12. ; goto copy
c11: al w3 x3 2 ;copy next:
al w1 x1 2 ; advance pointers
c12: rl w0 x3 ;copy:
rs w0 x1 ;
se. w3 (f8.); if -,finished then
jl. c11. ; goto copy next
rs. w1 f8. ; adjust bufpointer
dl. w1 b1. ; restore w0, w1
c13: rl. w3 f22. ;after copying:
rs. w3 d26. ; empty buffer:=false
rl. w3 f21. ; mode in next char := search mode
rs. w3 d27. ;
jl. (b2.); exit
e. ;
; global variables:
w. f0: 0 ; abs addr current desc
f1: 0 ; current word
f2: 0 ; current word addr
f3: 0 ; last word addr
f4: 0 ; saved give up
f5: 0 ; sourcepointer
f6: 0 ; testline pattern
f7: 0 ; charpointer
f8: 0 ; bufpointer
f9: 0 ; input block entry
f10: 0 ; label
f11: 1 ; outside unit
f12: 1 ; dont touch listing
f13: 1000 ; endstatem field
f14: 0 ; repfactor
f15: 0 ; waitbytes :used to pick up
; formatbytes.
f16: 0 ; numb1 : used
f17: 0 ; numb2 : to pick up
f18: 0 ; numb3 : constants
f19: 0 ; exponent :
f20: 10 ; ten
f21: jl. d28-d27 ; smode: instruction used in label
; : searchmode in next char.
f22: al w1 x1 2 ; notempty :used in empty or not
; :in next char
f23: jl. d23-d22 ; listmode :used in label rcclass
; :in read char
f24: al. w1 d25-d27 ; normalm :used in label normal
; :in next char
h. f25: 0 ; nlbyte :used for counting the
; :number of continuation-
; :lines in a field. initia-
; :lised in bytenewline.
f26: 0 ; nlcontcount: the number of conti-
; :nuation lines pickedup
; :in search mode
f27: 0 ; change list not allowed
f30: 0 ; extchar : last iso-character
f31: 0 ; save error : error char in label.
f32: 0 ; last of out4bytes
w. f33: bl. w3 x3 d31-d22 ; nolist :used in label rcclass
; :in read char
f34: 0 ; some constant
f35: 0 ; linecount address
f36: 0 ; message mode
f37: 0 ; message list
f38: 0 ; cond list
f39: 1 ; out begin unit
f40: 0 ; 1 if do
b. b1, c27, g1, i11 ; main sequence
; main sequence is entered once from init pass1 by
; jl. d12.
; in the central action it inputs characters during call of next char
; and defines by table look up in an action-table the relevant action
; to be done in this initial situation, where the character just read is
; the start of a field of some kind.
; main sequence administers the field-processing, for fields of more
; than one character during call of the procedures constant, compound,
; text,format and copytodel, for one-character-fields by jumps to actions
; in main sequence itself. a number of endline bytes, corres ponding to
; the number of continuation-lines counted during field-processing,is
; output here(except for constant) during call of byte newline;
; when conditional listing is used the turn off of the listing is done
; here
; possible outputbytes: (during call of outbyte,byte newline,out4bytes,
; out2bytes)
; <start unit>
; <1 byte with linecount>, appearing after <end unit>
; <all delimiters>
; <integer><2 bytes with label-value>
; <endline>
; <end statement>
; <end label>
; <trouble><graphic error><char value><0>
; <trouble><missing end><0><0><end unit><linecount>
; <trouble><error in label><trouble char><0>
; <trouble><label and continue><last char><0>
; globals used:
; f10,f11,f23,f25,f27,f28,f31,f32,f33,f35
; local variables:
w. b0: <:<10> no program<0> :> ; alarm text;
b1: 1 ; no program
; action table:
; mainclass
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
h. g0: i1, i0, i0, i0, i0, i0, i0, i0, i0, i1, i0, i4, i4, i2, i4
; class: 15 16 17 18 19 20 21 22 23
i4, i4, i4, i4, i4, i7, i3, i5, i6
; label action:
g1: i8, i9, i10, i11 ; used,when processing nlstat-chars.
; the i-names are intermediate action-adresses,which are to be replaced
; by c-names in the following manner:
; i0 i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11
; c5 c10 c11 c12 c13 c14 c23 c2 c19 c21 c22 c20
; entry point:
w.d12: ; begin
;
c2: jl. w3 d11. ; central action: w2:= next char;
bl w1 4 ; mainclass:= w2(0:11);
c3: bl. w3 x1 g0. ; class: m action:= actiontable(
c4: jl. x3 ; mainclass); go to action(m action);
c5: jl. w3 d21. ; first of compound:
se w1 1 ; if -, compound then
jl. c24. ; go to copy;
sn w0 a3 ; if bytevalue= end unit then
jl. c6. ; go to end;
sn w0 a10+3 ;
rs. w1 f40. ; remember do
jl. w3 d29.; outbyte(byte value);
jl. c9. ; go to maybe format;
c24: jl. w3 d2. ; copy: copytodel;
jl. c25. ; go to nl bytes;
c6: rs. w1 f11. ; end: outside unit:=true;
rs. w1 f39. ; out begin unit:=true;
jl. w2 d5. ; byte newline;comment w1=0;
al w0 a3 ;
jl. w3 d29.; outbyte(end unit);
al w0 a12 ;
jl. w3 d29. ; outbyte(end line);
bl. w2 f27. ;
sn. w1 (f12.); if dont touch listing or
se w2 0 ; change list not allowed then
jl. c7. ; go to skip rest of line;
rl. w2 f33. ; list mode:= false;
rs. w2 d22. ;
al w0 10 ;
se. w1 (f38.); if cond list then
jl. w3 d34. ; writechar(nl);
rs. w1 f38. ; cond list:= false;
c7: jl. w3 d11. ; skip rest of line: w2:= next char;
bl w1 4 ; mainclass:=w2(0:11);
se w1 j23 ; if mainclass=nlcont or
sn w1 j22 ; mainclass=nlstat then
jl. c3. ; goto class else
jl. c7. ; goto skip rest of line;
c9: se w0 a12+1 ; maybe format: if bytevalue=
sn w0 a12+2 ; <begin closed f> or
jl. w3 d4. ; <begin open f> then format;
jl. c25. ; go to nl bytes;
c10: jl. w3 d17. ; digit or point:
se w1 0 ; if constant then
jl. c2. ; go to central action;
jl. w3 d11. ; next char;
jl. c5. ; go to first of compound;
c11: jl. w3 d20. ; apostrophe: text;
jl. c25. ; go to nl bytes;
c12: al w0 a15+1 ; graphic:
bl. w1 f30. ; out4bytes(trouble,graphic error,
hs w0 2 ; extchar,0);
al w3 0 ;
jl. w2 d7. ;
jl. c2. ; go to central action;
c13: bl w0 5 ; delimiters:
jl. w3 d29. ; outbyte(internal value);
jl. c2. ; go to central action;
c14: bl w2 5 ; char of class nlstat:
al w1 0 ;
sn w2 5 ; if internal value=5 then
jl. c26. ; go to terminate program;comment
; em from last source;
sn. w1 (f11.); if -, outside unit then
jl. c16. ; go to inside unit;
rs. w1 f11. ; outside unit:=false
rs. w1 b1. ; no program:=false
sn. w1 (f39.); if -, out begin unit then
jl. c17. ; goto rest bytes
rs. w1 f39. ; out begin unit := false
al w0 a7 ;
jl. w3 d29. ; outbyte(start unit);
jl. c17. ; go to rest bytes;
c16: al w0 a9 ; inside unit:
jl. w3 d29. ; outbyte(end statement);
al w0 0 ; reset do-flag
rs. w0 f40. ;
al w0 a12 ;
jl. w3 d29. ; outbyte(end line);
c17: bl. w2 x2 g1.-1 ; rest bytes:
al w3 0 ; laction:= label action(internal
bl. w1 f31.; value);
c18: jl. x2 ; go to label action(laction);
c19: al w0 a3+3 ; correct label:
jl. w3 d29. ; outbyte(<integer>);
bl. w0 f10. ;
jl. w3 d29. ; outbyte(label(0:11));
bl. w0 f10.+1 ;
jl. w3 d29. ; outbyte(label((12:23));
c20: al w0 a9+1 ; end label out:
jl. w3 d29. ; outbyte(end label);
jl. c2. ; go to central action;
c21: al w0 a15+7 ; wrong label:
hs w0 2 ; out4bytes(trouble,wrong label,
jl. w2 d7. ; save error char,0);
jl. c20. ; go to end label out;
c22: al w0 a15+8 ; label and continue:
hs w0 2 ; out4bytes(trouble,label and cont,
jl. w2 d7. ; save error char,0);
jl. w3 d11. ; w2:=next char;
jl. w3 d16. ; skip to statement(w2);
jl. w3 d15. ; set pointer;
jl. c25. ; go to nl bytes;
c23: al w0 a12 ; nl cont:
jl. w3 d29. ; outbyte(end line);
jl. c2. ; go to central action;
c25: jl. w2 d5. ; nl bytes: byte newline;
jl. c2. ; go to central action;
c26: sn. w1 (b1.) ; terminate program: if-, no program
jl. c27. ; then go to some program;
al. w1 b0. ; writetext(<:no program:>);
jl. w3 d30. ;
jl. d24. ; go to terminate;comment label in
; read char;
c27: se. w1 (f39.); some program: if out begin unit then
jl. d32.; go to endpass1;
al w0 a15+9 ;
hs w0 2 ; out4bytes(trouble,missing end,
al w3 0 ; 0,0);
jl. w2 d7. ;
al w0 a9 ; outbyte(end statement);
jl. w3 d29. ;
al w2 a12 ;
hs. w2 f32. ;
al w1 a3 ; out2bytes(end unit, end line);
jl. w2 d9. ;
jl. d32.; go to end pass 1;
; assignment of intermediates:
i0 =c5 -c4 ,i1 =c10-c4 ,i2= c11-c4 ,i3 =c12-c4 ,i4 =c13-c4
i5 =c14-c4 ,i6 =c23-c4 ,i7 =c2 -c4 ,
i8 =c19-c18,i9 =c21-c18,i10=c22-c18,i11=c20-c18
e.
b. b0, c18, g9, i20 ; procedure field descriptor(fdstate);
; the procedure is called from procedure format,when a field descriptor
; of type a,b,d,e,f,g,i,l,p is read, and the call is:
; jl. w3 d13.
; the corresponding field is converted and one format-element is packed
; in the global,waitbytes. counting of right parentheses eventually
; terminating the field and thereby updating the format-element in
; waitbytes is done in format after exit from field descriptor.
; the conversion is directed by means of an action table that can be
; devided into 3 independent parts,concerning 1) p-fields,
; 2) b-d-e-f-g- fields, 3) a-i-l fields.
; the parameter fdstate decides which part is to be used.
; register use
; call: exit
; w0 repfac after scale , 1 for true,0 for false
; w1 repeat factor if fdstate=1
; w2 fdstate error , 1 for true , 0 for false
; w3 return address undefined
; globals used:
; f15, f20, f25
; local variables:
w. b0: 0 ; return address
; tables:
h. g0: i2, i4, i7 ; fdinitstate;
h. g1: 0 , 5 , 5 , 5 , 1 , 1 ; classtable(1:24);
5 , 5 , 5 , 2 , 5 , 5 ;
5 , 5 , 5 , 5 , 5 , 5 ;
5 , 5 , 3 , 5 , 5 , 4 ;
; the local classes are:
; class containing
; 0 digits
; 1 d e f g
; 2 .
; 3 in text
; 4 nl cont
; 5 other characters
; action table:
; local calss
; 0 1 2 3 4 5 state
h. g2: i9 , i12, i14, i8 , i13, i14 ; after p
g3: i10, i11, i14, i8 , i13, i14 ; p digit
g4: i9 , i14, i14, i8 , i13, i14 ; after b d e f g
g5: i10, i14, i15, i8 , i13, i14 ; field width
g6: i16, i14, i14, i8 , i13, i14 ; after point
g7: i17, i14, i14, i8 , i13, i19 ; significance;
g8: i9 , i14, i14, i8 , i13, i14 ; after i l a i14, i8 , i13, i18 ; i l a width
g9: i10, i14, i20, i8 , i13, i18 ; i l a width;
; the i-names are intermediat action addresses. they are to be
; replaced by c-names as:
; i8 i9 i10 i11 i12 i13 i14 i15 i16 i17 i18 i19 i20
; c1 c4 c5 c6 c7 c8 c9 c10 c11 c12 c13 c14 c18
; entry point
w.d13: rs. w3 b0. ; begin
al w1 0 ; w:=0
bl. w3 x2 g0. ; state:=fdinitstate(fdstate);
c0: hs. w3 i0 ; set fdstate:
c1: jl. w3 d11. ; new char: w2:= next char;
bl w3 4 ; mainclass:= w2(0:11);
bl. w3 x3 g1. ; local calss:=classtable(mainclass);
c2: bl. w3 x3 ; fdaction:
c3: jl. x3 ; go to action(local class,state);
; jl. c1. ; in text: go to new char
c4: bl. w3 c2.+1 ; first digit:
al w3 x3 g3-g2 ; state:=state+1;
hs. w3 c2.+1 ;
c5: wm. w1 f20.; digits in field width:
ba w1 5 ; w:=w*10+internal value;
sl w1 256 ; if w>= 256 then
jl. c9.; go to error;
jl. c1.; go to new char;
c6: al w0 1 ; defg after p digit:
jl. c16. ; repfac after scale:=true;
; go to fd ok out;
c7: al w0 0 ; defg after p:
jl. c16. ; repfac after scale:=false;
; go to fd ok out;
c8: ba. w2 f25. ; nlcont:
hs. w2 f25. ; nlbyte:= nlbyte+1;
jl. c1. ; go to new char;
c9: al w2 1 ; error: error:=true;
jl. c17. ; go to fdout;
c10: sn w1 0 ; point after field width:
jl. c9. ; if w=0 then go to error;
al w0 0 ; d:=0;
al w3 i5 ; state:= after point;
jl. c0. ; go to set fdstate;
c11: al w3 i6 ; first digit in significance:
hs. w3 c2.+1 ; state:=significance;
c12: wm. w0 f20. ; digits in significance:
ba w0 5 ; d:=d*10+internal value;
sh w0 x1 0 ; if d<= w then
jl. c1. ; go to new char;
jl. c9. ; go to error;
c13: sn w1 0 ; terminate ila field:
jl. c9. ; if w=0 then go to error;
al w0 0 ; d:=0;
c14: bz. w2 f15. ; terminate bdefg field:
se w2 i1 ; if descriptortype <> b then
jl. c15. ; go to pack waitbytes;
sh w0 4 ; if d>4 or
sh w0 0 ; d=0 then
jl. c9. ; go to error;
c15: ls w1 4 ; pack waitbytes:
rs. w1 f15. ; waitbytes:=(descriptortype shift 8
wa w2 0 ; +d)shift 12+(w shift 4);
hs. w2 f15. ;
c16: al w2 0 ; fd ok out: error:=false;
c17: jl. (b0.) ; fd out: end field descriptor;
c18: bz. w3 f15. ; point after ila:
se w3 6<8 ; if descriptortype<> i
jl. c9. ; goto error else
jl. c10. ; goto point after field width;
; assignment of intermediates:
i0 = c2-c0+1, i1= 1<8
i2 =g2 -c2, i3 =g3 -c2, i4 =g4 -c2, i5 =g6 -c2, i6 =g7 -c2
i7 =g8 -c2, i8 =c1 -c3, i9 =c4 -c3, i10=c5 -c3, i11=c6 -c3
i12=c7 -c3, i13=c8 -c3, i14=c9 -c3, i15=c10-c3, i16=c11-c3
i17=c12-c3, i18=c13-c3, i19=c14-c3, i20=c18-c3
e.
b. b2, c7 ; procedure longtext;
; the procedure is called from procedure format, when
; <integer>h or an apostrophe is read, and the call is:
; jl. w3 d14.
; before the call,format has output a text-start-element and
; longtext packs the characters belonging to the defined text
; and outputs them with 3 characters per format-element. the
; elements are separated by formatc-bytes as usual for format-
; elements.
; the text-end-element with the value of repeat end count is
; output from format after return
; register use:
; call exit
; w0 undefined
; w1 longtext, 0 for true, 1 for false
; w2 <entry char> undefined
; w3 return address undefined
; possible outputbytes: (during call of out3bytes).
; <formatc><2 bytes with a text-element>
; globals used:
; f14,f15,f30
; local variables:
w. b0: 0 ; return address
b1: 0 ; explicit end
b2: 0 ; count
; entry point
w.d14: rs. w3 b0. ; begin
al w1 -1 ;
rs. w1 b1. ; explicit end:= -1;
al w0 1 ; set endmark in word;
al w1 0 ; count:=0;
bl w3 4 ; w3:= mainclass;
se w3 j13 ; if mainclass<> apostrophe class
jl. c0. ; then go to new char;
rs. w3 b1. ; explicit end:= apostrophe class;
rs. w2 f14. ; repfactor:= infinite;
c0: jl. w3 d11. ; new char: w2:= next char;
bl w3 4 ;
se w3 j23 ; if mainclass<> nlcontclass then
jl. c1. ; go to maybe nlstat;
ba. w2 f25. ;
hs. w2 f25. ; nlbyte:=nlbyte+1;
jl. c0. ; go to new char;
c1: sn w3 j22 ; maybe nlstat: if mainclass= nlstat
jl. c7. ; then go to error;
sn. w3 (b1.); if mainclass=explecit end then
jl. c4. ; go to text terminate;
c2: ld w0 8 ; pack:
ba. w0 f30. ; word:=word shift 8 +extchar;
so w3 1 ; if word<2**16 then
jl. c3. ; go to count char;
rx w0 2 ; count:=w1; w1:=word;
rs. w0 b2. ; out3bytes(w1(0:11),w1(12:23),
jl. w2 d35.; last of out4bytes);
al w0 1 ; set endmark in word;
rl. w1 b2. ; w1:= count;
c3: al w1 x1 1 ; count char:
rl. w3 f14. ; count:=count+1;
sh w1 x3 -1 ; if count<repfactor then
jl. c0. ; go to new char;
rl w1 6 ; count:= repfactor;
c4: sn w1 0 ; text terminate: if count=0 then
jl. c7. ; go to error;
sn w0 1 ; if word is empty then
jl. c6. ; go to ok longtext;
c5: ld w0 8 ; move left: word:=word shift 8;
so w3 1 ; if word(0:7)=0 then
jl. c5. ; go to move left;
rs w0 2 ; w1:= word;
jl. w2 d35.; out3bytes(w1(0:11),w1(12:23),
; last of out4bytes);
c6: al w1 0 ; ok longtext:
jl. (b0.); longtext:=true; go to out;
c7: al w1 1 ; error: longtext:=false;
jl. (b0.); out:
; end longtext;
e.
b. ; procedure set pointer;
; set pointer adjusts the global charpointer so that the last read
; char is read again at the next call of next char. the call is:
; jl. w3 d15.
; register use:
; call exit
; w2 undefined
; w3 return address unchanged
; globals: f7,f22
; entry point
w.d15: rl. w2 f7. ; begin
al w2 x2 -2 ; charpointer :=
rs. w2 f7. ; charpointer - 1;
rl. w2 f22. ;
rs. w2 d26. ; emptybuffer :=false;comment label
; in next char;
jl x3 ; end set pointer;
e.
b. b0,c2 ; procedure skip to statement(entry);
; the procedure is called when an error occurs and the actual statement
; has to be skipped, and the call is:
; jl. w3 d16.
; the characters up to a character which means end statement are skipped
; and the first character to be checked is in w2 at entry time.
; the global nlbyte is adjusted in the usual way.
; register use:
; call exit
; w2 entry char exit char
; w3 return address undefined
; globals used: f25.
; local variables:
w. b0: 0 ; return address
w.d16: rs. w3 b0. ; begin
jl. c1. ; go to class;
c0: jl. w3 d11. ; new char: w2:= next char;
c1:bl w3 4 ; class: mainclass:= w2(0:11);
se w3 j18 ; if mainclass = statterm or
sn w3 j22 ; mainclass = nlstat then
jl. c2. ; go to out;
se w3 j23 ; if mainclass<> nlcont then
jl. c0. ; go to new char;
ba. w2 f25. ; nlbyte :=nlbyte+1;
hs. w2 f25. ;
jl. c0. ; go to new char;
c2: jl. (b0.); out:
; end skip to statement
e.
b. b7, c32, g6, i19 ; procedure constant;
; procedure constant is called from main sequence when<.> or <digit>
; is read, and the call is
; jl. w3 d17.
; as a result, integer-, long-, real- and double constants are converted
; ,the last tw0 types in a preliminary manner where the decimalpoint is
; moved to the right of the fixed point part during adjustment of the
; exponent.
; during conversion the globals numb1,numb2,numb3 are used for conver-
; ting the fix-point part and exponent for the eventually exponent.
; when <.> or the exponent letters e and d are read, the syntax of the
; following char-sequence is checked by a call of number syntax, and
; as a reaction, conversion is continued or stopped,
; the initial digit can be start of a bitpattern or a hollerith-constant
; in which case one of the procedures bitpattern and text is called.
; at last the global nlbyte are updated and bytenewline is called
; to output <nlbyte> end-line bytes
; register use:
; call exit
; w0 undefined
; w1 <constant> ,1 for true,0 for false
; w2 <entry char> undefined
; w3 return address undefined
; possible outputbytes: (during call of outputc and out4bytes)
; <integer> <2>
; <long > <4>
; <real > <6>
; <double > <8>
; <trouble> <fix too long><2>
; <trouble> <exp too big ><2>
; globals used:
; f16,f17,f18,f19,f25,f26,f29
; local variables:
w. b0: 0 ; return address
b1: 0 ; digcount
0,b2: 0 ; rest
w. b3: 0 ; sign
h. b4: 0 ; fractiondigits
b5: 0 ; constanttype:= 0 for integer, long
; := 1 for double
; := 2 for real
b7: 0 ; auxtype
w. 0,b6: 0 ; constantpart
; tables
h. g0: 0 , 7 , 6 , 6 , 5 , 7 ; classtable(1:24)
7 , 7 , 7 , 1 , 7 , 4 ;
4 , 7 , 7 , 7 , 7 , 7 ;
7 , 7 , 2 , 7 , 7 , 3 ;
; the local classes are:
; class containing
; 0 digits
; 1 .
; 2 in text
; 3 nl contclass :continuation lines
; 4 + -
; 5 e d
; 6 h b
; 7 other characters
; action table:
; local class
; 0 1 2 3 4 5 6 7 state
h. g1: i8 , i10 ; initial
g2: i9 , i10, i19 , i15, i17, i11, i16, i17 ; integer
g3: i12, i17, i7 , i15, i17, i11, i17, i17 ; fraction
g4: i13, 0, i7 , i15, i14, 0, 0, 0 ; eksponent
g5: i13, i17, i7 , i15, i17, i17, i17, i17 ; dig in exponent
g6: i9, i10, i7 , i15, i17, i17, i17, i17 ; intext
; the i-names are intermediate action adresses. they are to be
; replaced by c-names in the following manner:
; i7 i8 i9 i10 i11 i12 i13 i14 i15 i16 i17
; c2 c6 c7 c12 c13 c15 c16 c17 c19 c20 c22
; entry point
w.d17: rs. w3 b0. ; begin
al w0 0 ;
rs. w0 b1. ; digcount:=
rs. w0 b4. ; constanttype:=fractiondigit:=
hs. w0 f26. ; nlcontcount:=
rs. w0 b3. ; sign:=0;
rs. w0 f34. ; some constant:= false;
al w1 0 ;
ds. w1 f17. ; numb1:= numb2:=
ds. w1 f19. ; numb3:= exponent:=
ds. w1 b2. ; rest:=0;
al w3 i0 ; state:= initial;
c0: hs. w3 i5 ; set state;
jl. c3. ; go to cclass;
c1: hs. w3 i6 ; set cstate:
c2: jl. w3 d11. ; new char: w2:=next char;
c3: bl w3 4 ; cclass: mainclass:=w2(0:11);
bl. w3 x3 g0. ; local class:= clastable(mainclass);
c4: bl. w3 x3 ; c action:
al w1 1 ;
c5: jl. x3 ; go to action(local class,state);
c6: rs. w1 f34. ; first digit:
al w3 i1 ; some constant:=true;
hs. w3 c4.+1 ; state:=integer; set state;
c7: bl w3 5 ; digits in integer:
se w3 0 ; if internal value<> 0 then
jl. c8. ; go to signif digit;
sn. w3 (b1.) ; if digcount=0 then
jl. c2. ; go to new char;
c8: wa. w1 b1. ; signif digit:
rs. w1 b1. ; digcount:=digcount+1;
sh w1 19 ; if digcount<=19 then
jl. c10. ; go to pack;
c9: al w0 a15+4 ; fix too long:
rl. w1 b1. ; errortype:=fix too long;
; aux inf:= digcount;
jl. c29. ; go to error;
c10: rs. w3 b2. ; pack: rest:= internal value;comment
al w3 6 ; digitvalue; limit:=6;
al w2 0 ; i:=0;
; comment numb1, numb2,numb3 is thought
; of as array numb3(-2:0);
c11: rl. w1 x2 f18. ; bigger:
rs. w1 b6. ; constantpart:=numb3(i);
al w0 0 ;
ld w1 3 ;
aa. w1 b6. ;
aa. w1 b6. ; w0w1:=constantpart*10
aa. w1 b2. ; + rest;
rs. w1 x2 f18. ; numb3(i):=w0w1(24:47);
rs. w0 b2. ; rest :=w0w1(0:23);
sl. w3 (b1.) ; if digcount<=limit then
jl. c2. ; go to new char;
al w3 x3 8 ; limit:=limit+8;
al w2 x2 -2 ; i:=i-1;
jl. c11. ; go to bigger;
c12: al w3 i2 ; point: state:= fraction;
al w0 0 ; nsstate:=1;
al w2 2 ; auxtype:=2; comment real;
jl. c14. ; go to jump to syntax;
c13: al w2 x2 -a0-2 ; exponent letters:
al w3 i3 ; auxtype:=if e then 2 else 1;
al w0 1 ; state:=eksponent; nsstate:=2;
c14: hs. w3 c4.+1 ; jump to syntax:
hs. w2 b7. ; set state;
jl. w3 d18. ;
rl w3 2 ;
al w1 1 ;
se w3 1 ; if -, number syntax(nsstate) then
jl. c22. ; go to constant termination;
rs. w1 f34. ; some constant :=true;
ba. w2 f25. ; nlbyte:= nlbyte +nlcontcount;
hs. w2 f25. ;
bl. w2 b7. ;
hs. w2 b5. ; constanttype:=auxtype;
al w2 0 ;
hs. w2 f26. ; nlcontcount := 0;
jl. c2. ; go to new char;
c15: bl. w0 b4. ; fraction digit:
ba. w0 1 ; fractiondigits:=
hs. w0 b4. ; fractiondigits+1;
jl. c7. ; go to digits in integer ;
c16: rl. w0 f19. ; digits in exponent:
wm. w0 f20. ; exponent:=exponent*10
ba w0 5 ; + internal value;
rs. w0 f19. ;
sh w0 1000 ; if exponent<= 1000 then
jl. c18. ; go to set state to 5:
c31: ; exp error:
al w0 a15+5 ; errortype:= exp too big;
rl. w1 f19. ; aux inf:= exponent;
jl. c29. ; go to error;
c17: al w2 x2 -a5-2 ; exponent sign:
hs. w2 b3.+1 ; sign:=if plus then 0 else 1;
c18: al w3 i4 ; set state to 5:
jl. c1. ; state:=dig in exponent;
; go to set cstate;
c19: ba. w2 f25. ; nl continuation:
hs. w2 f25. ; nlbyte:=nlbyte+1;
jl. c2. ; go to new char;
c20: bl w0 5 ; hollerith or bitpattern:
se w0 a0+7 ; if internal value<> h value then
jl. c21. ; go to bitp call;
jl. w3 d20. ; text;
jl. w3 d11. ; next char;
jl. c30. ; go to ctout;
c21: jl. w3 d19. ; bitpcall: bitpattern;
jl. c30. ; go to ctout;
c22: se. w1 (f34.); constant termination:
jl. c30. ; if -, some constant then goto ctout;
bl. w3 b5. ;
se w3 0 ; if constanttype<> 0 then
jl. c25. ; go to real double;
sh. w3 (f17.); if numb2<0 or
se. w3 (f16.); numb1 <>0 then
jl. c9. ; go to fix too long;
c23: al w0 a3+3 ; integer: leading byte:= <integer>;
al. w1 f18.-1 ; start address:=numb3;
al. w2 f18.+1 ; last address:=numb3;
sh. w3 (f18.); if numb3<0 or
se. w3 (f17.); numb2<> 0 then
jl. c24. ; go to long;
jl. c28. ; go to sendbyte;
c24: al w0 a3+4 ; long: leading byte:= <long>;
al. w1 f17.-1 ; start address:= numb2;
jl. c28. ; go to sendbyte;
c25: rl. w0 f19. ; realdouble:
sn. w1 (b3.) ; if sign=minus then
ac w0 (0) ; exponent:= -exponent;
bs. w0 b4. ; exponent:= exponent-fractiondigit;
sh w0 -1000 ; if exponent<=-1000 then
jl. c31. ; goto exp error;
rs. w0 f19. ;
dl. w1 f17. ; the value picked up
ld w1 2 ; must be:
ls w1 -2 ; numb1*2**46+numb2*2**23
rs. w0 f16. ; +numb3;
rl. w2 f18. ;
ld w2 1 ;
ls w2 -1 ;
ds. w2 f18. ;
al. w2 f19.+1; last address:= exponent;
rl. w0 b1. ;
sh w0 11 ; if digcount >11 or
sn w3 1 ; constanttype=1 then
jl. c27. ; go to double;
c26: al w0 a4+0 ; real: leading byte:= <real>;
al. w1 f17.-1; start address:= numb2;
jl. c28. ; go to sendbyte;
c27: al w0 a4+1 ; double: leading byte:= <double>;
al. w1 f16.-1; start address:= numb1;
c28: jl. w3 d6. ; sendbyte: outputc(leading byte,
jl. c30. ; start address,lastaddress);
c32: al w3 i18 ; intext in integer
rl. w2 f40. ; if do-stm.
sn w2 1 ; then
hs. w3 c4.+1 ; change state
jl. c2. ;
; go to ctout;
c29: hs w0 2 ; error:
al w3 0 ; out4bytes( trouble, errortype,
jl. w2 d7. ; auxinf,0);
rl. w2 (f7.); w2:=buffer(charpointer);
jl. w3 d16. ; skip to statement(w2);
c30: jl. w2 d5. ; ctout: bytnewline;
bl. w3 f26. ;
hs. w3 f25. ; nlbyte:=nlcontcount;
jl. w3 d15. ; set pointer;
rl. w1 f34. ; constant:= some constant;
jl. (b0.) ; end constant;
; assignment of intermediates:
i0= g1-c4 , i1 =g2 -c4 , i2 =g3 -c4 , i3 =g4 -c4 , i4 =g5 -c4
i18=g6-c4
i5=c4-c0+1 , i6=c4-c1+1
i7=c2-c5 , i8=c6-c5 , i9 =c7 -c5 , i10=c12-c5 , i11=c13-c5
i12=c15-c5 , i13=c16-c5, i14=c17-c5 , i15=c19-c5 , i16=c20-c5
i17=c22-c5 , i19=c32-c5
e.
b. b3, c11,g3 ,i9 ; procedure number syntax(nsstate);
; the procedure is called from constant when<.> or one of the exponent-
; letters e and d is read, and the call is
; jl. w3 d18.
; the purpose is to check the following character-sequence to see if it
; is part of a constant, and the result is put in register w1.
; the chars are read from next char in search mode and to be sure that
; no overflow in the char-buffer occurs, the bufpointer is stepped back
; one step when an intext-char, that logically is to be skipped, is read,
; the first intext char still has to be placed in the char-buffer.
; the parameter nsstate chooses the initial state to be 1 or 2;
; register use:
; call exit
; w0 nsstate undefined
; w1 <number syntax> , 1 for true, 0 for false
; w2 nlcontcount
; w3 return address undefined
; globals used:
; f7,f8, f21,f22, f24, f26, f34
; local variables:
w. b0: 0 ; return address
h. b2: i0 , i1 ; initstate
w. b3: 0 ; intextskip
; tables:
h. g0: 0 , 4 , 4 , 4 , 1 , 4 ; classtable(1:24)
4 , 4 , 4 , 5 , 5 , 3 ;
3 , 5 , 5 , 5 , 5 , 5 ;
5 , 5 , 2 , 5 , 5 , 5 ;
; the local classes are:
; class containing:
; 0 digits
; 1 e d
; 2 in text
; 3 + -
; 4 letters except e and d
; 5 other characters
; action table
; local class
; 0 1 2 3 4 5 state
h. g1: i4 , i5 , i8 , i9 , i7 , i9 ; after point
g2: i4 , i7 , i8 , i6 , i7 , i7 ; after e or d
g3: i4 , i7 , i8 , i7 , i7 , i7 ; after exponent sign
; the i-names are intermediate action adresses. they are to be replaced
; by c-names in the following manner:
; i4 i5 i6 i7 i8 i9
; c5 c6 c7 c11 c8 c10
; entry point
w.d18: rs. w3 b0. ; begin
jl. w3 d36. ; set search mode
al w1 0 ; number syntax:= false;
c0: rs. w1 b3. ; intextskip:=false;
am (0) ;
bl. w0 b2. ; state:=initial(nsstate);
c1: hs. w0 i3 ; set nsstate: set state;
c2: jl. w3 d11. ; new char: w2:= next char;
bl w3 4 ; mainclass:=w2(0:11);
bl. w3 x3 g0. ; local class:=classtable(mainclass);
c3: bl. w3 x3 ; caction:
c4: jl. x3 ; go to action(local class,state);
c5: al w1 1 ; digit: number syntax:= true;
jl. c11.; go to nsout;
c6: rl. w2 f34. ; e or d after point:
se w2 1 ; if -, some constant then
jl. c10. ; go to terminator after point;
al w0 i1 ; state:=after e or d;
jl. c1. ; go to set nsstate;
c7: al w0 i2 ; exponent sign: state:=
jl. c1. ; after exponent sign;
; go to set nsstate;
c8: sn. w1 (b3.); in text: if -, intextskip then
jl. c9. ; go to set skip true;
rl. w3 f7. ;
al w3 x3 -2 ; charpointer:=
rs. w3 f7. ; bufpointer:=
rs. w3 f8. ; charpointer -1;
c9: rs. w2 b3. ; set skip true: intextskip:= true;
jl. c2. ; go to new char;
c10: rl. w1 f34. ; terminator after point:
; number syntax:=some constant;
c11: al. w3 d25. ; nsout:
rs. w3 f7. ; charpointer:=oldcharpointer;
rl. w3 f24. ;
rs. w3 d27. ; mode in next char:=normal;
bl. w2 f26. ; w2:= nlcontcount
jl. (b0.) ; end number syntax;
; assignment of intermediates:
i0= g1-c3 , i1 = g2-c3 , i2 = g3-c3 , i3 =c3-c1+1
i4= c5-c4 , i5 = c6-c4 , i6 = c7-c4 , i7 =c11-c4
i8= c8-c4 , i9 = c10-c4
e.
b. b1, c12, g1, i4 ; procedure bitpattern;
; the procedure is called from constant, when <integer>b is read
; and the call is:
; jl. w3 d19.
; the global numb3 contains <integer> which is the defining number for
; the b-constant.
; bitpattern packs the b-constant consisting of the bitpatterndigits
; corresponding to the defining number in one or two words right justi-
; fied with zero-filling, using the globals numb1 and numb2.
; method: during conversion, digits and letters are considered as possible
; bitpatterndigits with letters starting at value 10, and before
; packing, it is checked that the value corresponds to the
; defining number.
; key variables : valuelimit , free places,numb1,numb2,numb3.
; if any error situation arise, errorbytes will be output and the rest of
; the actual statement will be skipped during call of skip to statement;
; register use:
; call exit
; w0 undefined
; w1 undefined
; w2 undefined
; w3 return address undefined
; possible outputbytes: (during call of outputc and out4bytes);
; <integer> <2 bytes with b-constant>
; <long> <4 bytes with b-constant>
; <trouble> <bitperror><local type> <aux inf>
; with local type aux inf
; 1 <defining number>
; 2 <owerflow digit>
; 3 <error digit>
; local variables:
w. b0: 0 ; return address:
b1: 0 ; valuelimit
; no of free places (kept in w1);
; tables:
; action table
; mainclass:
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
h. g0: i0, i1, i1, i1, i1, i1, i1, i1, i1, i4, i4, i4, i4, i4, i4
;class: 15 16 17 18 19 20 21 22 23
i4, i4, i4, i4, i4, i3, i4, i4, i2
; the i-names are intermediate action-addresses which are to be replaced
; with c-names as:
; i0:c2 i1:c3 i2:c4 i3:c0 i4:c5
h. g1: 48 , 24 , 16 , 12 ; init free(1:4)
; entry point:
w.d19: rs. w3 b0. ; begin
al w1 1 ; local type :=1;
rl. w3 f18. ;
se w3 0 ; if numb3 =0 or
sl w3 5 ; numb3 >=5 then
jl. c11. ; go to error type 1;
ls w1 (6) ; valuelimit:= 1shift numb3;
rs. w1 b1. ;
bl. w1 x3 g1.-1 ; free places:= init free (numb3);
c0: jl. w3 d11. ; new char: w2:= next char;
bl w3 4 ; mainclass:= w2(0:11);
bl. w3 x3 g0. ; bpaction :=actiontable(mainclass);
bl w2 5 ; internal value:=w2(12:23);
c1: jl. x3 ; go to action(bpaction);
c2: sn w1 0 ; digit:if free places =0 then
jl. c8. ; go to error type2;
sl. w2 (b1.); if internal value >= valuelimit
jl. c9. ; then go to error type3;
al w1 x1 -1 ; free places:= free places-1;
dl. w0 f17. ; numb1 numb2:=
ld. w0 (f18.); numb1 numb2 shift numb3
lo w0 4 ; add internal value;
ds. w0 f17. ;
jl. c0. ; go to new char;
c3: al w2 x2 -a0+10 ; letter: internal value:=
jl. c2. ; internal value-letterbase +10;
; go to digit;
c4: ba. w2 f25. ; nl continue: nlbyte:=
hs. w2 f25. ; nlbyte+ internal value;
jl. c0. ; go to new char;
; in text: go to new char;
c5: wm. w1 f18. ; other : free bits:=free places*numb3;
sn w1 48 ; if free bits=48 then
jl. c8. ; go to error type2;
al. w2 f17.+1 ; last address:=numb2;
sh w1 23 ; if free bits<=23 then
jl. c6. ; go to long pattern;
al w0 a3+3 ; short: leading byte:= <integer>;
al. w1 f17.-1 ; start address:= numb2;
jl. c7. ; go to send byte;
c6: al w0 a3+4 ; long pattern: leading byte:= <long>;
al. w1 f16.-1 ; start address:=numb1;
c7: jl. w3 d6. ; send byte: outputc(leading byte,
jl. c12. ; start address,last address);
; go to out;
c8: al w1 2 ; error type2: local type:=2;
jl. c10. ; go to error char;
c9: al w1 3 ; error type3: local type:=3;
c10: bl. w3 f30. ; error char: aux inf:= extchar;
c11: al w0 a15+3 ; error type1: error:= bitperror;
hs w0 2 ; out4bytes(trouble,error,local type,
jl. w2 d7.; aux inf);
rl. w2 (f7.); w2:=buffer(charpointer);
jl. w3 d16.; skip to statement(w2);
c12: jl. (b0.); out:
; end bitpattern;
; assignment of intermediates:
i0= c2-c1 , i1= c3-c1 , i2= c4-c1 , i3= c0-c1 , i4= c5-c1
e.
b. b5 ,c12 ; procedure text;
; procedure text is called in two cases,
; a)from main sequence,when apostrophe is read , and
; b)from constant ,when <integer>h is read,in which case the
; global numb3 holds <integer>.
; the call is: jl. w3. d20.
; in both cases a short text consisting of
; a) the characters up to the next apostrophe
; or b) the next <integer> characters
; is packed left justified with spacefilling in the double word
; consisting of the globals numb1 and numb2. the character values
; are get from the global extchar.
; max. 6 characters can be packed and more characters will cause trouble-
; bytes to be output,and the rest of the actual statement will be skipped.
; correct output is of type <long>.
; register use:
; call exit
; w0 undefined
; w1 undefined
; w2 <entry char> undefined
; w3 return address undefined
; possible outputbytes: (during call of outputc and out4bytes)
; <long><4bytes with short text>
; <trouble><error in short text><erroneus number of chars ><0>
; globals used:
; f16, f17, f18, f19, f25, f30
; local variables :
w. b0: 0 ; return address
b1: 0 ; stopcount
b2: 6 ; six
b3: 0 ; count
b4: 255<16 ; mask
w. d20: rs. w3 b0. ; begin
al w1 -1 ; explecitterminate:=-1;
rs. w1 f19. ;
al w1 32 ; fill:=sp;
hs. w1 b5. ;
ld w1 -65 ;
rs. w1 b1. ; stopcount:=
ds. w1 f17. ; numb1:=numb2:=0;
bl w3 4 ; if mainclass of entry char<>
se w3 j13 ; apostropheclass then
jl. c0. ; goto next text const;
; comment string quote;
hs. w1 b5. ; fill:=null;
al w2 1000 ; numb3:=infinite;
ds. w3 f19. ; explecitterm:=apostrophe;
c0: rl. w3 b1. ; next text const:
sl. w3 (f18.) ; if stopcount>=numb3 then
jl. c8. ; goto end text field;
al w3 x3 +6 ; stopcount:=if stopcount+6
sl. w3 (f18.) ; < numb3 then stopcount+6
rl. w3 f18. ; else numb3;
rs. w3 b1. ;
c1: jl. w3 d11. ; new char: w2:=next char;
bl w3 4 ; mainclass:=w2(0:11);
se w3 j23 ; if mainclass<>nlcont then
jl. c2. ; goto maybe nlstat;
ba. w2 f25. ;
hs. w2 f25. ; nlbyte:=nlbyte+1;
jl. c1. ; goto new char;
c2: sn w3 j22 ; maybe nlstat:if maincl=nlstat
jl. c11. ; then goto trouble out;
sn. w3 (f19.) ; if mainclass=explecitt then
jl. c7. ; goto end string quote;
c3: dl. w0 f17. ; pack:
ld w0 8 ; numb1numb2:=
ba. w0 f30. ; numb1numb2*2**8+extchar;
ds. w0 f17. ;
al w1 x1 +1 ; count:=count+1;
se. w1 (b1.) ; if count<>stopcount then
jl. c1. ; goto new char;
c4: al w0 a5+4 ; out text const:
sl w1 7 ; if count>=7 then
jl. w3 d29. ; outbyte(comma);
al w0 a3+4 ; leading byte:=long;
dl. w3 f17. ; w2w3:=numb1numb2;
c5: sz. w2 (b4.) ; for w2w3:=w2w3 while w2w3(0:7)
jl. c6. ; =0 do w2w3:=w2w3 shift 8
ld w3 8 ; +fill;
b5=k+1
al w3 x3 0 ;
jl. c5. ;
c6: rs. w1 b3. ; save count;
ds. w3 f17. ; start address:=numb1;
al. w1 f16.-1 ; last address:=numb2;
al. w2 f17.+1 ; outputc(leading byte,start
jl. w3 d6. ; address,last address);
ld w3 -65 ; numb1=numb2=0;
ds. w3 f17. ;
rl. w1 b3. ;
jl. c0. ; goto next text const;
c7: al w0 0 ; end string quote:
rs. w1 f18. ; numb3:=count;
wd. w1 b2. ;
rl. w1 f18. ; if count mod 6<>0 then
se w0 0 ;
jl. c4. ; goto out text const;
c8: se w1 0 ; end text field:if count<>0
jl. c12. ; then goto return;
c9: jl. w3 d11. ; get terminator:w2:=next char;
c10: jl. w3 d16. ; skip:skip to statement(w2);
c11: al w3 0 ; trouble out:
al w0 a15+2 ; out4bytes(trouble,
hs w0 2 ; error in text,count,0);
jl. w2 d7. ;
jl. w3 d15. ; set pointer;
c12: jl. (b0.) ; return: end text;
e.
b. b6, c9, g53, i73 ; procedure compound;
; procedure compound is called from main sequence when <*> or <letter>
; is read and when<.> is read and a call of constant has told that it
; was not start of a constant. compound is called as:
; jl. w3 d21.
;
; at return time w1 tells if a compound was found or not.
; the compounds are gathered in table reschain(1:216) in a tree-
; structure and table entrypoint(1:29) holds pointers to the main
; branches corresponding to the possible first letters. all compounds
; starting with<.> have the same entry-value.
; the possible endsymbols are arranged in table endchain(-7:-1) in a
; way like in reschain
; each point in the tree in reschain is represented by 2 bytes:
; the last byte keeps the internal value of the character required for
; going on in the tree with one step or, at the end of a compound, minus
; the relevant byte-value.
; the first byte contains.
; a) a pointer to next possibilyty : value > 0
; b) a pointer to table endchain with value<0 in
; which case an endsymbol is expected and last byte
; contains the negative bytevalue
; each character is read by calling next char in search mode, which
; means that the char-sequence can be read again if it is not a compound.
; at the end of the procedure the global nlbyte is adjusted with
; nlcontcount that is used in search mode to count continuation-lines
; and initialised in compound.
; register use:
; call exit
; w0 <bytevalue> for w1=1
; w1 <compound> ,1for true 0 for false.
; w2 <entry char> undefined
; w3 return address undefined
; globals used:
; f7 , f21 , f22 , f25 , f26 , f27 , f24
; local variables: ;
w. b0: 0 ; return address
b2: 0 ; in endchain
b3: 0 ; tablebases
b4: 0 ; bytevalue
h. b5: 0 ; charp change
w. b6: 0 ; charvalue
; tables : reschain and endchain are placed after the code
; entrypoint(1:29)
h. g0: 2, 0, i58, i59 ; a, b , c , d
i60, i61, i62, 0 ; e, f , g , h
i63, 0, 0, i64 ; i, j , k , l
0, 0, 0, i65 ; m, n , o , p
0, i66, i67, i68 ; q, r , s , t
0, 0, i69, 0 ; u, v , w , x
0, i70, 0, 0 ; y, z , æ , ø
0, ; å
; entry point ;
w.d21: rs. w3 b0. ; begin
jl. w3 d36. ; set search mode
al. w3 g1. ;
rs. w3 b3. ; tablebases:= reschainbase;
al w1 0 ; link:=0; comment link is kept in w1;
rs. w1 b2. ; in endchain:=
hs. w1 b5. ; charp change:=0;
hs. w1 f27. ; change list not allowed:=false;
hs. w1 f26. ; nlcontcount:=0;
c0: bl w3 5 ; find entry:
sn w3 a6 ; if enternal value=pointvalue then
al w1 i0 ; link:=pointentry;
sn w3 a5+5 ; if internal value=starvalue then
al w1 i1 ; link:= starentry;
se w1 0 ; if link<> 0 then
jl. c1. ; go to next actual char;
bl. w1 x3 g0.-a0 ; link:=entry point(internal value
; -letterbase);
sn w1 0 ; if link =0 then
jl. c8. ; go to not compound;
al w3 -2 ;
hs. w3 b5. ; charp change:=-1;
al w0 1 ;
c1: jl. w3 d11. ; next actual char:
bl w3 4 ; w2:=next char;
sn w3 j0 ; if mainclass=digits then
al w2 x2 a1 ; internal value:=internal value
hs. w2 b6.+1 ; +digit base;charvalue:=w2;
c3: am. (b3.); next table word:
bl w3 x1 1 ; tablevalue:=table(link+
; tablebases+1);comment table is
; reschain or endchain;
se. w3 (b6.); if tablevalue<>charvalue then
jl. c5. ; go to next branch;
sn. w0 (b2.); if in endchain<>0 then
jl. c6. ; go to ok compound;
al w1 x1 2 ; link:=link+1;
jl. c1. ; go to next actual char;
c5: am. (b3.); next branch:
bl w1 x1 0 ; link:=table(link+tablebases+0);
sn w1 0 ; if link=0 then
jl. c8. ; go to not compound;
sh w1 0 ; if link>0 or
sn. w0 (b2.); in endchain<>0 then
jl. c3. ; go to next table word;
rs. w0 b2. ; in endchain :=1;
rs. w3 b4. ; bytevalue:=tablevalue;
al. w3 g2. ; tablebases:=endchainbase;
rs. w3 b3. ;
bl w3 4 ;
se w3 j22 ; if mainclass<>nlstatclass then
jl. c3. ; go to next table word;
al w3 a9+0 ;
rs. w3 b6. ; charvalue:=endstatement value;
jl. c3. ; go to next table word;
c6: ac. w0 (b4.); ok compound: w0:=- bytevalue;
se w0 a11+7 ; if compound <> real then
jl. c7. ; goto end ok
jl. w3 d11. ; next char
bl w3 4 ;
sn w3 j16 ; if class = ( then
jl. c8. ; goto not compound
al w3 -4 ;
hs. w3 b5. ; charp change:=-2
c7: bl. w3 b5. ; end ok: charpointer:=
wa. w3 f7. ; charpointer+charpchange;
al w1 1 ; compound:=true;
jl. c9. ; go to out;
c8: al. w3 d25. ; not compound:
al w1 0 ; charpointer:=oldcharpointer;
; compound:=false;
c9: rs. w3 f7. ; out:
rl. w3 f24. ; mode in next char:= normal mode;
rs. w3 d27. ;
bl. w3 f26. ;
hs. w3 f25. ; nlbyte:=nlcontcount;
jl. (b0.) ; end compound;
; table reschain
w. g1: 0
h. 0,i20, 0,i20, 0,i10, 0,i8 , 0,i15, - 6,-a10- 4 ; assign
g3: i28,i2 , 0,i13, 0,i13, - 6,-a10- 5 ; call
g4: 0,i16,i29,i15, 0,i21, 0,i10, 0,i15
0,i22, 0,i6 , -12,-a10- 6 ; continue
g5: 0,i14,i30,i14, 0,i16, 0,i15, - 8,-a11-11 ; common
g6: 0,i17, 0,i13, 0,i6 , 0,i25, - 6,-a11- 9 ; complex
g7: i31,i2 , 0,i21, 0,i2 , -10,-a11-12 ; data
g8: i32,i10, 0,i14, 0,i6 , 0,i15, 0,i20
0,i10, 0,i16, 0,i15, - 6,-a11-10 ; dimension
g9: 0,i16,i33,i22, 0,i3 , 0,i13, 0,i6 ; double_
i34,a16, 0,i17, 0,i19, 0,i6 , 0,i4 ; precision
0,i10, 0,i20, 0,i10, 0,i16, 0,i15, - 6,-a11- 8 ;
g10: - 6,-a10- 3 ; do
g11: i35,i15,i36,i5 , -12,-a3- 0 ; end
g12: 0,i21, 0,i19, 0,i26, - 6,-a11- 3 ; entry
g13: i37,i18, 0,i22, 0,i10, 0,i23, 0,i2
0,i13, 0,i6 , 0,i15, 0,i4 , 0,i6 , -10,-a11-13 ; equivalence
g14: 0,i25, 0,i21, 0,i6 , 0,i19, 0,i15
0,i2 , 0,i13, - 6,-a11-14 ; external
g15: i38,i16, 0,i19, 0,i14, 0,i2 , 0,i21 ;
i71,i16, -10,-a12- 2 ; formato
g51: -10,-a12- 1 ; format
g16: 0,i22, 0,i15, 0,i4 , 0,i21, 0,i10 ;
0,i16, 0,i15, - 6,-a11- 2 ; function
g17: 0,i16,i39,a16, 0,i21, 0,i16, -10,-a10- 1 ; go to
g18: i40,i7 , -10,-a10- 2 ; if
g19: 0,i15, 0,i21, 0,i6 , 0,i8 , 0,i6 ;
0,i19, - 6,-a11- 5 ; integer
g20: 0,i16,i41,i8 , 0,i10, 0,i4 , 0,i2 ;
0,i13, - 6,-a11- 4 ; logical
g21: 0,i15, 0,i8 , - 6,-a11- 6 ; long
g22: 0,i19, 0,i16, 0,i8 , 0,i19, 0,i2
0,i14, - 6,-a11- 0 ; program
g23: 0,i6 ,i42,i2 ,i43,i5 , -10,-a10- 9 ; read
g24: 0,i13, - 6,-a11- 7 ; real
g25: 0,i21, 0,i22, 0,i19, 0,i15, -12,-a10- 7 ; return
g26: i44,i21, 0,i16, 0,i17, -12,-a10- 8 ; stop
g27: 0,i22, 0,i3 , 0,i19, 0,i16, 0,i22 ;
0,i21, 0,i10, 0,i15, 0,i6 , - 6,-a11- 1 ; subroutine
g28: 0,i16, - 6,-a10- 0 ; to
g29: 0,i19, 0,i10, 0,i21, 0,i6 , -10,-a10-10 ; write
g30: 0,i16, 0,i15, 0,i6 , - 6,-a11-15 ; zone
g31: i45,i2 , 0,i15, 0,i5 , - 2,-a8 -7 ; .and
g32: i46,i6 , 0,i18, - 2,-a8 -3 ; .eq
g33: i47,i7 , 0,i2 , 0,i13, 0,i20, 0,i6 , - 2,-a2 -1 ; .false
g34: i48,i8 ,i49,i6 , - 2,-a8 -4 ; .ge
g35: 0,i21, - 2,-a8 -5 ; .gt
g36: i50,i13,i51,i6 , - 2,-a8 -2 ; .le
g37: 0,i21, - 2,-a8 -1 ; .lt
g38: i52,i15,i53,i6 , - 2,-a8 -6 ; .ne
g39: 0,i16, 0,i21, - 2,-a8 -9 ; .not
g40: i54,i16, 0,i19, - 2,-a8 -8 ; .or
g41: i55,i20,i56,i9 , 0,i10, 0,i7 , 0,i21, - 2,-a8-10 ; .shift
g42: 0,i21, 0,i19, 0,i10, 0,i15, 0,i8 , - 2,-a8-11 ; .string
g43: 0,i21, 0,i19, 0,i22, 0,i6 , - 2,-a2 -0 ; .true
g44: - 4,-a8 -0 ; *
; table end chain contains the possible endsymbols in a chain
h. g45: i57,a9+0 ; ; nl
g46: i57,a5+0 ; (
g47: i57,a5+6 ; /
g48: 0,a16 ; in text
g49: 0,a5+5 ; *
g50: 0,a6 ; .
w. g2: 0 ; endchainbase;
; assignment of intermediates:
i0 =g31-g1, i1 =g44-g1
i2 =a0+0, i3=a0+1 ,i4 =a0+2 ,i5 =a0+3 ,i6 =a0+4 ,i7 =a0+5
i8 =a0+6, i9=a0+7 ,i10=a0+8 ,i11=a0+9 ,i12 =a0+10,i13=a0+11
i14=a0+12,i15=a0+13,i16=a0+14,i17=a0+15,i18=a0+16,i19=a0+17
i20=a0+18,i21=a0+19,i22=a0+20,i23=a0+21,i24=a0+22,i25=a0+23
i26=a0+24,i27=a0+25
; i2 to i27 specifies the internal values for the letters a to z.
i28=g4 -g1, i29=g5 -g1, i30=g6 -g1, i31=g8 -g1, i32=g9 -g1
i33=g10-g1, i34=g9 -g1+12
i35=g13-g1, i36=g12-g1, i37=g14-g1, i38=g16-g1, i39=g17-g1+4
i40=g19-g1, i41=g21-g1, i42=g25-g1, i43=g24-g1, i44=g27-g1
i45=g32-g1, i46=g33-g1, i47=g34-g1, i48=g36-g1, i49=g35-g1
i50=g38-g1, i51=g37-g1, i52=g40-g1, i53=g39-g1, i54=g41-g1
i55=g43-g1, i56=g42-g1, i57=g48-g2
; i28 to i 57 are used as possible link-values.
i58=g3 -g1, i59=g7 -g1, i60=g11-g1, i61=g15-g1, i62=g17-g1
i63=g18-g1, i64=g20-g1, i65=g22-g1, i66=g23-g1,i67 =g26-g1
i68=g28-g1, i69=g29-g1, i70=g30-g1, i71=g51-g1
e.
i2= d0-i0
i1 = k - i0,i.
e30 = e30 + i1 ; length := length + length pass 1;
e.
m. rc 85.09.26 fortran, pass 1
▶EOF◀