|
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: 96000 (0x17700)
Types: TextFile
Names: »algpass13tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass13tx «
; rc 1975.01.15 algol 6, pass 1, page 1
;contents:
; page 1 : description of logic and tables
; page 3 : start pass 1.
; page 4 : input table and class table;
; page 5 : action table.
; page 6 : central action.
; page 7 : modifications of central action, variables and constants.
; page 8 ff : actions
; page 21 : table of reserved words.
; page 22 : table of pointers to reserved words,
; compound table and table of pointers to compounds.
; page 23 : initialise pass 1.
;
;
;description of logic and tables:
;
; the central action inputs a character from the current input medium
; and defines by tablelookup in the input table and the class table re-
; spectively its value and its class. for algolsymbols that are genera-
; ted by pass 1 or that has to be repeated the central action is ente-
; red with the value and class allready defined.
; the algolsymbols and input characters are divided into classes as follows:
; class contains
; 0 blinds and intext
; 1 illegals and graphics
; 2 letters in reserved i.e. small letters except j k q æ ø aa
; 3 letters not reserved i.e. capitals plus j k q æ ø aa
; 4 digits
; 5 simples i.e. & ; ! ' ( + . , // ** := -, >= <= == => <> :(
; 6 state altering simples i.e. <: <* << )
; 7 first of compounds i.e. : / * - < > =
; 8 nl ff
; 9 sp
; 10 em
; 11 state altering reserved i.e. algol comment message
; 12 simple reserved i.e. all reserved except the state altering
; and begin external end
; 13 begin external
; 14 end
;
; the class together with the current state defines the action by table-
; lookup in the action table.
;
; the possible states together with auxillary states and modifications
; of actions are shown in a table on next page.
; the change of state, auxillary states and modifications takes place in
; the actions.
\f
;rc 1975.01.15 algol 6, pass 1, page 2
; state auxstate further nl no match res mode of centr act
; in copy - (5) - mode2
; in comment - - - resp mode3 or 2
; in string (1) pack nl - mode3
; in layout (2) layout error - mode1
; after ) (3) - forget saveds mode3
; in end comment (3) set auxstate forget saveds mode3
; in prelude (3) set auxstate forget saveds mode2
; in compound (4) (5) - -
; in reserved - (5) - -
; in neutral (3) set auxstate output saveds mode1
;
; further nl is the nl action besides the counting of typographical lines;
; no match res is the action taken on letters, that has been matched with
; a reserved word, when total match is not achieved.
;
; (1): 3 possibilities: normal, after <, after :.
; (2): see description page 13.
; (3): 2 possibilities: expecting reserved, after letters.
; (4): 2 possibilities: normal, fatcomp i.e. colon comp after ).
; (5): in these states nl has different special actions all of
; which changes the state. it is repeated in the new state.
;
; reserved words are recognised by means of the tables table of res-
; erved words and table of pointers to reserved words. the first is or-
; ganised as a treestucture and the latter holds pointers to the main
; branches corresponding to the possible first letters. each point in
; the tree is represented by two words in table of reserved words, the
; first holding the value of the letter required for going on along
; the branch,the second holding either a pointer to next possibility
; or a value telling that this was the last possibility. the end branch
; point holds in first word an end branch value and in second the class
; and value of the reserved word.
;
; the logic of recognition of compounds is similar to the logic for re-
; served words, but the compound table is constructed in a different way,
; having three words pr compound. first holding required symbol, second
; further possibilities or not and third the class and value of compound.
;
; there are three possibilities for modifications of the central action:
; get class : no modification.
; test line : test typographical line and save inputcharacter.
; listing : as above plus listing of sourcetext with linenumbers.
; the modes mode1,2 and 3 are assigned according to the translatormode
; as followes:
;
; translatormode mode1 mode2 mode3
; no spec. get class test line test line
; message get class listing test line
; list listing listing listing
;
\f
; jz.fgs.1981.03.02 algol 8, pass 1, page ...3...
;start pass 1
k=e0
s. a104,b55,c66,d75,f66,g54,h19,i109,j7
i82=k
h0=114, h1=59, h2=70, h3=134, h4=139, h5=140, h6=141,
h7 = 8,h8 = 9,h9 = 10,h10= 11,h11= 12,h12=20
h17 = 39 , h18 = 25 , h19 = 32 ; iso values of ' , em and space
w. i83 ; no. of bytes in pass 1;
h13=140 ; context
h14=141 ; exit(in context)
h15=142 ; continue(in context)
h16=143 ; repeat(in context)
h. 4 , 1<1+0 ; relative entry and pass no. plus pass mode;
w. jl. a89. ; goto prepare init pass1;
\f
\f
; jz 1979.01.23 algol 8, pass 1, page 3a
; layout (1)
;layout: description of logic and table:
;
; the layout actions make use of two state variables: auxstate and sec-
; state,plus a set of variables,which can be added to the layout double
; word.
; the layout char action searches for the value of the input character
; in the layout table,which has two words per possible layout character.
; the first of these contains the value of the layout character and the
; table is ordered in descending order after this.the second word con-
; tains in the first bits the relative address of the action correspon-
; ding to the layout character.the rest of the bits are used to determi-
; ne which values of auxstate the layout character is allowed for.if the
; input character is not found or the character is not allowed,the error
; in layout action is called.this action is entered directly for input
; characters belonging to classes which do not contain layout characters.
; the normal actions are independent of the auxstate and consists of ad-
; ding variables to the layout double word,testing limits,changing vari-
; ables and setting auxstate and secstate.secstate is only used for set-
; ting auxstate.
; possible states:
; 1 start
; 2 after + or -
; 3 expecting blank or >
; 4 after b,z,f or d before .
; 5 after blank in state 4
; 6 after 0 before .
; 7 after blank in state 6
; 8 after .
; 9 after + or - followed by .
; 10 after . followed by b,z,f or d
; 11 after blank in state 10
; 12 after .0
; 13 after blank in state 12
; 14 after '
; 15 after ' followed by + or -
; 16 after z,f or d in state 15
; 17 after + or -, expecting blank or >
\f
; jz 1979.01.23 algol 8, pass 1, page 3b
; layout (2)
d28: rl. w3 f35. ; layout start:
rs. w3 j3. ; futher nl action:=error in layout;
al w3 h3+3 ;
rs. w3 f24. ; directionbyte:=string first;
rl. w3 b3. ;
al w0 0 ;
ds. w0 f22. ; init string;
rl. w3 b4. ;
al w0 64 ;
ds. w0 f26. ; init blankadd and minusadd;
al w3 256 ;
rl. w0 b5. ;
ds. w0 f28. ; init fadd and badd;
rl. w3 b6. ;
rl. w0 b7. ;
ds. w0 f30. ; init hdadd and hdmask;
al w1 -1 ;
hs. w1 b55. ; init maxcount in layout;
al w1 1 ; auxstate:=1;
al w2 1 ; secstate:=1;
rs. w2 f31. ; limit exeded:=false;
jl. c0. ; goto next char;
b3: 1<23 ; initial layout variables
b4: 1<22 ;
b5: 1<18 ;
b6: 1<14 ;
b7: 15<14 ;
c9: sn w0 h5 ; blind in layout: if blind then
jl. c0. ; goto next char;
b55 = k + 1; maxcount ;
c10: al w3 -1 ; layoutchar:
al w3 x3+1 ; maxcount :=
hs. w3 b55. ; maxcount + 1;
sl w3 32 ; if maxcount >= 32
jl. c11. ; then goto error in layout;
d66: al. w3 i85 ; i := -1;
a33: al w3 x3+4 ; for i:=i+1 while
sl w0 (x3) ; layout table(i,1)>char do;
jl. 4 ;
jl. a33. ;
se w0 (x3) ; if char<>layout table(i,1) then
jl. c11. ; goto error in layout;
rl w3 x3+2 ; get layout table(i,2);
so w3 x1 ; if char not allowed then
jl. c11. ; goto error in layout;
ls w3 -16 ; get layout action;
al w0 0 ; layout incr:=0;
d7: jl. x3 ; goto layoutaction;
\f
;jz 1979.03.06 algol 8, pass 1, page 3c
; layout (3)
d8: sz. w1 (f49.) ; blank in layout:
jl. a87. ; if ending blank then
al w1 1<2 ; auxstate := 3;
a87: sn w1 1<2 ; if auxstate = 3 then
jl. c0. ; goto next char;
rl. w0 f25. ;
se w0 0 ; if blankadd = 0
sz w0 2.111111 ; or blankadd extract 6 <> 0 then
rs. w0 f31. ; limit exceeded := true;
lo. w0 f21. ; stringword1 :=
rs. w0 f21. ; stringword1 or blankadd;
se w1 1<0 ; if auxstate <> 1 then
jl. a35. ; goto blank in number;
rl. w0 f25. ; leading blank :
ls w0 -1 ; blankadd :=
rs. w0 f25. ; blankadd shift (-1);
jl. c0. ; goto next char;
a35: ls w1 1 ; blank in number:
jl. c0. ; auxstate := auxstate + 1;
; goto next char;
d9: wa. w0 f26. ; plus in layout: layoutincr:=layoutincr+minusadd;
d10: wa. w0 f26. ; minus in layout:layoutincr:=layoutincr+minusadd;
sz. w1 (f52.) ; if front sign then
jl. a88. ; goto leading sign;
sz w0 3 ; if layoutincr extract 2 <> 0 then
ls w0 6 ; layoutincr := layoutincr shift 6;
rl. w1 f22. ; if sign of numberpart already set
sz w1 3<6 ; then
jl. c11. ; goto error in layout;
al w1 1<5 ;
lo. w1 f21. ; stringword1 :=
rs. w1 f21. ; stringword1 or endsign;
rl. w1 f51. ; auxstate := 17;
jl. a36. ; goto add layoutincr;
a88: ls w1 1 ; leading sign:
jl. a36. ; auxstate := auxstate + 1;
; goto add layoutincr;
\f
; jz 1979.01.23 algol 8, pass 1, page 3d
; layout (4)
d19: wa. w0 f27. ; b in layout: layout incr:=layout incr+fadd;
d11: wa. w0 f27. ; z in layout: layout incr:=layout incr+fadd;
d12: wa. w0 f27. ; f in layout: layout incr:=layout incr+fadd;
d13: wa. w0 f28. ; d in layout: layout incr:=layout incr+badd;
am -2 ;
d14: al w3 5 ; zero in layout:
al w1 x2 ;
ls w1 x3 ; auxstate:=secstate+(if zero then 5 else 3);
rl. w3 f25. ;
ls w3 -1 ;
rs. w3 f25. ; blankadd:=blankadd shift -1;
wa. w0 f29. ; layout incr:=layout incr+hdadd;
rl. w3 f22. ;
so. w3 (f30.) ; if more digits allowed then
jl. a36. ; goto add layout incr;
al w3 0 ;
rs. w3 f31. ; limit exeded:=true;
a36: wa. w0 f22. ; add layout incr:
rs. w0 f22. ; stringword2:=stringword2+layout incr;
jl. c0. ; goto next char;
d15: ls w1 7 ; point in layout: auxstate:=auxstate+7;
al w2 64 ; secstate:=7;
dl. w0 f30. ;
ld w0 -4 ; hdadd shift -4;
ds. w0 f30. ; hdmask:=hdmask shift -4;
jl. c0. ; goto next char;
\f
;jz 1979.03.06 algol 8, pass 1, page 3e
; layout (5)
b1: 1<13
b2: 1<12
d16: rl. w1 b1. ; exponent in layout: auxstate:=14;
rl. w2 b2. ; secstate:=13;
rs. w0 f28. ; badd:=0;
al w0 1 ;
rs. w0 f26. ; set minusadd;
al w0 4 ;
rs. w0 f27. ; set fadd;
al w3 16 ;
al w0 48 ;
ds. w0 f30. ; set hdadd and hdmask;
jl. c0. ; goto next char;
d17: rl. w0 f31. ; end layout:
se w0 1 ; if limit exceeded then
jl. c11. ; goto error in layout;
rl. w3 f21. ;
sz. w3 (f25.) ; if last blank add = 1 then
lx. w3 f25. ; remove last blankadd;
ba. w3 b55. ;
sz. w1 (f50.) ; if state = (3 or 5 or 7 or 11 or 13 ) then
rs. w3 f21. ; stringword1 := stringword1 + maxcount;
jl. w3 d6. ; outstring;
jl. a37. ; goto restore after layout;
c11: al w0 h3+1 ; error in layout:
jl. w3 e3. ;
al w0 h10 ;
jl. w3 e3. ; layout error;
a37: rl. w0 f20. ; restore after layout:
rs. w0 j3. ; futher nl action:=normal nl action
al w1 0 ; auxstate:=expecting reserved;
al w0 g50 ; state:=neutral;
jl. d0. ; goto set state;
;layout table
; value rel act allowed in auxstate if one
; 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
g42: h3+5 ,(:d8 -d7:)<16+2. 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1; blank
h0+10,(:d17-d7:)<16+2. 1 1 0 0 1 1 1 1 0 0 1 1 1 1 1 0 0; >
h2+2 ,(:d10-d7:)<16+2. 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1; -
h2+1 ,(:d9 -d7:)<16+2. 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 0 1; +
h2 ,(:d15-d7:)<16+2. 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1; .
h1+10,(:d16-d7:)<16+2. 0 0 0 0 0 1 0 1 0 0 0 1 0 1 0 0 0; '
h1 ,(:d14-d7:)<16+2. 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0; zero
26 ,(:d11-d7:)<16+2. 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1; z
6 ,(:d12-d7:)<16+2. 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1; f
4 ,(:d13-d7:)<16+2. 0 1 1 1 0 0 1 1 1 1 0 0 1 1 0 1 1; d
2 ,(:d19-d7:)<16+2. 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1; b
-1 ; other
i85=g42-d66-4 ; base of layout table
f49: 2.00110101110101111 ; mask
f50: 2.00001010001010100 ;
f52: 1<13 + 1<0 ;
f51: 1<16 ; state=17
\f
; jz 1979.11.05 iso mnemonics algol 8, pass 1, page 3.1
; constants, variables and tables
f53: 0 ; current mnemonic
f64: h. 32,102,97,108,115,101,32,97,100,100,32 ; <sp>false add<sp>
f54: h. 0,r.6 w. ; characters
f55: rl. w0 g54 ; normal contents of c0
f56: sh w3 -1 ; normal contents of j6
0 ; f57-2 ; saved w1
f57: 0 ; saved w2
f58: jl. g51 ; instruction to be stored in c0
f59: jl. g52 ; instruction to be stored in j6
f61: 10 ; constant for divide
f65: 2047 ; mask for extract 11
f66: 0 ; internal char pointer;
; iso mnemonic table:
f60: <:nul:>,<:soh:>,<:stx:>,<:etx:>,<:eot:>,<:enq:>,<:ack:>,<:bel:>
<:bs:> ,<:ht:>, <:nl:> ,<:vt:> ,<:ff:> ,<:cr:> ,<:so:> ,<:si:>
<:dle:>,<:dc1:>,<:dc2:>,<:dc3:>,<:dc4:>,<:nak:>,<:syn:>,<:etb:>
<:can:>,<:em:> ,<:sub:>,<:esc:>,<:fs:> ,<:gs:> ,<:rs:> ,<:us:>
<:sp:> ,<:del:>
; action table for '<mnemonic>' :
; char: other '
f62: h. d70 , d70 ; state 0: after '
d70 , d71 ; state 2: after ' <1 character>
d70 , d72 ; state 4: after ' <2 characters>
d74 , d73 ; state 6: after ' <3 characters>
; action table for "<mnemonic>" :
; char: other "
d70 , d70 ; state 8: after "
d70 , d71 ; state 10: after " <1 character>
d70 , d72 ; state 12: after " <2 characters>
d74 , d73 ; state 14: after " <3 characters>
w. ;
\f
; jz 1979.11.05 iso mnemonics algol 8, pass 1, page 3.2
d68: rl. w3 f4. ; init mnemonics:
bl. w0 j1. ;
se w0 i108 ; if instring then
jl. a95. ; begin
sn w1 60 ; if auxstate<>60 or char<>' then
se w3 h17 ; goto first char 1;
jl. a96. ; end;
a95: hs. w3 f54. ; characters(0) := ' or ";
ds. w2 f57. ; save(w1,w2);
al. w1 f54. ; charpointer := 0;
al w2 0 ; state := 0;
rs. w2 f53. ; current mnemonic := 0;
se w3 h17 ; if char <> ' then
al w2 8 ; state := 8;
rl. w0 f59. ;
rs. w0 j6. ; change j6 to a jump to "next mnemonic";
jl. c0. ; goto next char;
d69: se w0 h5 ; next mnemonic:
jl. a104. ; if value(char) = blind
sn w3 0 ; and class = 0 then
jl. c0. ; goto next char;
a104:rl. w0 f4. ; w0 := saved iso char;
al w1 x1+1 ; charpointer := charpointer + 1;
hs w0 x1 ; characters(charpointer) := saved iso char;
sn w3 8 ; if char= 'nl' or char = 'ff' then
jl. a92. ; goto not found;
sl w3 0 ; if char = ' or char = "
sn w0 h18 ; or char = em then
al w2 x2+1 ; state := state + 1;
bz. w3 x2+f62. ;
j7: jl. x3 ; goto actiontable(state);
d70 = k - j7
rl. w3 f53. ; pack mnemonic:
ls w3 8 ; current mnemonic :=
lo w3 0 ;
rs. w3 f53. ; current mnemonic shift 8 add char;
sz w2 1 ; state :=
am -1 ; if state is odd then
al w2 x2+2 ; state + 1 else state + 2;
jl. c0. ; goto next char;
\f
; jz 1979.02.19 iso mnemonics algol 8, pass 1, page 3.3
d71 = k - j7
rl. w0 f53. ; one char in mnemonic:
jl. a94. ; value:=current mnemonic; goto convert to digits;
d72 = k - j7
rl. w0 f53. ; two chars in mnemonic:
ls w0 8 ; current mnemonic :=
rs. w0 f53. ; current mnemonic shift 8;
d73 = k - j7
rl. w0 f53. ; three characters in mnemonic:
al w3 -2 ; index := -2;
a90: al w3 x3+2 ; search mnemonic table:
sl w3 68 ; index := index + 2;
jl. a92. ; if index >= 68 then goto unknown;
se. w0 (x3+f60.) ; if current mnemonic <> mnemonic table(index)
jl. a90. ; then goto search mnemonic table;
ld w0 -25 ; found:
sn w0 33 ; index := index//2; value := index;
al w0 127 ; if index=33 then value := 127; (del)
a94: al w3 0 ; convert to digits:
wd. w0 f61. ; digit1:= value//10; digit2:= value mod 10;
sh w0 9 ; if digit1 <= 9 then
jl. a91. ; goto store last digits;
al w1 49 ; three digits:
hs. w1 f54. ; characters(0) := iso(1);
ws. w0 f61. ; digit1 := digit1 - 10;
am 1 ; charpointer := 2 else
a91: al. w1 f54.+1 ; store last digits: charpointer := 1;
al w3 x3+48 ; characters(charpointer) :=
hs w3 x1 ; digit2 + 48;
rl w3 0 ; characters(charpointer-1) :=
al w3 x3+48 ; digit1 + 48;
hs w3 x1-1 ;
\f
; jz 1979.11.05 iso mnemonics algol 8, pass 1, page 3.4
bl. w0 j1. ;
sn w0 i108 ; if instring then
jl. a92. ; goto finis;
al w1 x1+1 ; charpointer :=
al w0 h19 ; charpointer + 1;
hs w0 x1 ; characters(charpointer) := space;
sl w2 8 ; if state = after "... then
am f64-f54+1 ; pointer := -> <sp> false <sp> add
am -1 ; else pointer := -> <sp> <digits> else
d74 = k - j7 ; not found:
a92: al. w3 f54. ; finis:
rs. w3 f66. ; pointer := -> <digits>;
al w3 -1 ;
hs w3 x1+1 ; characters(charpointer+1) := -1; (stop)
rl. w0 f56. ;
rs. w0 j6. ; restore contents of instruction in j6;
rl. w0 f58. ;
rs. w0 c0. ; change c0 to a jump to "internal char";
dl. w2 f57. ; restore(w1,w2);
bz. w3 (f66.) ; first char:
rs. w3 f4. ; saved char := char;
a96: bl. w0 x3+g0. ; first char 1: get value(char);
bl. w3 x3+g1. ; get class(char);
la. w3 f65. ; class := class extract 11;
jl. d37. ; goto after in;
d67: rl. w3 f66. ; internal char:
al w3 x3+1 ; charpointer :=
rx. w3 f66. ; charpointer + 1;
se. w3 f64.+6 ; if charpointer - 1 = <char no 6 in false.> then
jl. a97. ; begin
al w0 h3+1 ; decrease operand counter:
jl. w3 e3. ; outbyte(error);
al w0 -1 ; outbyte(-1);
jl. w3 e3. ; end;
a97: bl. w3 (f66.) ; char := character(charpointer-1);
se w3 -1 ; if char = -1 then
jl. a93. ; begin
rl. w0 f55. ; restore contents of c0;
rs. w0 c0. ; goto next char;
jl. c0. ; end;
a93: rs. w3 f4. ; end mnemonic: saved char := char;
bl. w0 x3+g0. ; get value(char);
bl. w3 x3+g1. ; get class(char);
jl. j6. ; goto after in1;
\f
; jz 1979.02.19 algol 8, pass 1, page 4
a89: al. w2 c20. ; prepare init pass1:
am 1000 ;
jl x2+i84 ; goto init pass1;
c63: jl. e12. ; stepping stone;
c64: jl. e13. ; stepping stone
c65: jl. e14. ; stepping stone;
;input table
h.
g0: h5 ,h5 ,h5 ,h5 ; nul,soh,stx,ext
h5 ,h5 ,h5 ,h5 ; eot,enq,ack,bel
h5 ,h5 ,h3+2 ,h5 ; bs ,ht ,nl ,vt
h3+2 ,h5 ,h5 ,h5 ; ff ,cr ,so ,si
h5 ,h5 ,h5 ,h5 ; dle,dc1,dc2,dc3
h5 ,h5 ,h5 ,h5 ; dc4,nak,syn,etb
h5 ,h3+2 ,h5 ,h5 ; can,em ,sub,esc
h5 ,h5 ,h5 ,h5 ; fs ,gs ,rs ,us
h3+5 ,h0+13,h3+5 ,h3+5 ; sp ,! , ,
h3+5 ,h3+5 ,h0+12,h1+10; , ,& ,'
h2+25,i71 ,h0+2 ,h2+1 ; ( ,) ,* ,+
h2+30,h2+2 ,h2 ,h0+3 ; , ,- ,. ,/
h1 ,h1+1 ,h1+2 ,h1+3 ; 0 ,1 ,2 ,3
h1+4 ,h1+5 ,h1+6 ,h1+7 ; 4 ,5 ,6 ,7
h1+8 ,h1+9 ,h2+3 ,h2+22; 8 ,9 ,: ,;
h0+6 ,h0+8 ,h0+10,h3+5 ; < ,= ,> ,
h3+5 ,30 ,31 ,32 ; ,a ,b ,c
33 ,34 ,35 ,36 ; d ,e ,f ,g
37 ,38 ,39 ,40 ; h ,i ,j ,k
41 ,42 ,43 ,44 ; l ,m ,n ,o
45 ,46 ,47 ,48 ; p ,q ,r ,s
49 ,50 ,51 ,52 ; t ,u ,v ,w
53 ,54 ,55 ,56 ; x ,y ,z ,æ
57 ,58 ,h3+5 ,h3+5 ; ø ,aa , ,
h3+5 ,1 ,2 ,3 ; ,a ,b ,c
4 ,5 ,6 ,7 ; d ,e ,f ,g
8 ,9 ,10 ,11 ; h ,i ,j ,k
12 ,13 ,14 ,15 ; l ,m ,n ,o
16 ,17 ,18 ,19 ; p ,q ,r ,s
20 ,21 ,22 ,23 ; t ,u ,v ,w
24 ,25 ,26 ,27 ; x ,y ,z ,æ
28 ,29 ,h3+5 ,h5 ; ø ,aa , ,del
;class table
g1: 0 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ; nul,soh,stx,ext,eot,enq,ack,bel
1 ,1 ,8 ,1 ,8 ,0 ,1 ,1 ; bs ,ht ,nl ,vt ,ff ,cr ,so ,si
1 ,1 ,1 ,1 ,1 ,1 ,1 ,1 ; dle,dc1,dc2,dc3,dc4,nak,syn,etb
1 ,10,1 ,1 ,1 ,1 ,1 ,1 ; can,em ,sub,esc,fs ,gs ,rs ,us
9 ,5 ,1<11+1 ,1 ,1 ,1 ,5 ,1<11+5; sp ,! , , , , ,& ,'
5 ,6 ,7 ,5 ,5 ,7 ,5 ,7 ; ( ,) ,* ,+ ,, ,- ,. ,/
4 ,4 ,4 ,4 ,4 ,4 ,4 ,4 ; 0 ,1 ,2 ,3 ,4 ,5 ,6 ,7
4 ,4 ,7 ,5 ,7 ,7 ,7 ,1 ; 8 ,9 ,: ,; ,< ,= ,> ,
1 ,3 ,3 ,3 ,3 ,3 ,3 ,3 ; ,a ,b ,c ,d ,e ,f ,g
3 ,3 ,3 ,3 ,3 ,3 ,3 ,3 ; h ,i ,j ,k ,l ,m ,n ,o
3 ,3 ,3 ,3 ,3 ,3 ,3 ,3 ; p ,q ,r ,s ,t ,u ,v ,w
3 ,3 ,3 ,3 ,3 ,3 ,1 ,0 ; x ,y ,z ,æ ,ø ,aa , ,_
1 ,2 ,2 ,2 ,2 ,2 ,2 ,2 ; ,a ,b ,c ,d ,e ,f ,g
2 ,2 ,3 ,3 ,2 ,2 ,2 ,2 ; h ,i ,j ,k ,l ,m ,m ,o
2 ,3 ,2 ,2 ,2 ,2 ,2 ,2 ; p ,q ,r ,s ,t ,u ,v ,w
2 ,2 ,2 ,3 ,3 ,3 ,1 ,0 ; x ,y ,z ,æ ,ø ,aa, ,del
\f
; jz 1979.08.17 algol 8, pass 1, page 5
;action table
;
h.
;class
; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 state
g33:i0 ,i0 ,i0 ,i0 ,i0 ,i6 ,i0 ,i0 ,i5 ,i0 ,i45 ; in comment
g34:i3 ,i1 ,i4 ,i4 ,i7 ,i4 ,i4 ,i8 ,i5 ,i4 ,i45 ; in string
g35:i9 ,i2 ,i10,i11,i10,i10,i11,i10,i5 ,i10,i45 ; in layout
g36:i0 ,i2 ,i12,i13,i14,i14,i15,i17,i5 ,i0 ,i45,i16,i16,i16,i16; after )
g37:i0 ,i0 ,i22,i13,i0 ,i26,i37,i18,i5 ,i27,i45,i25,i24,i25,i43; in endcom
g38:i0 ,i2 ,i28,i13,i0 ,i27,i27,i27,i46,i27,i45,i25,i25,i40,i25; in prelud
g39:i0 ,i2 ,i21,i21,i21,i19,i21,i20,i21,i21,i45 ; in compou
g40:i0 ,i2 ,i29,i30,i30,i31,i31,i31,i31,i31,i45 ; in reserv
g41:i0 ,i2 ,i23,i32,i33,i35,i37,i18,i5 ,i34,i45,i38,i36,i41,i42; in neutral
g43:i0 ,i2 ,i48,i48,i47,i49,i37,i98,i50,i50,i45 ; in algol
g44:i0 ,i0 ,i56,i56,i56,i56,i56,i44,i5 ,i56,i45 ; in commentstring
g45:i0 ,i0 ,i99,i99,i99,i99,i99,i99,i99,i99,i45 ; comm in algol
; the i-names are intermediate action addresses.they are to be replaced
; by c-names with same numbers.the action addresses (c-names) are placed
; in the pass in nummerical order except for c23,that is placed between
; c31 and c32,and c46 that is placed between c5 and c6.
;
; the algolsymbols and input characters are divided into classes as follows:
; class contains
; 0 blinds and intext
; 1 illegals and graphics
; 2 letters in reserved i.e. small letters except j k q æ ø aa
; 3 letters not reserved i.e. capitals plus j k q æ ø aa
; 4 digits
; 5 simples i.e. & ; ! ' ( + . , // ** := -, >= <= == => <> :(
; 6 state altering simples i.e. <: <* << )
; 7 first of compounds i.e. : / * - < > =
; 8 nl ff
; 9 sp
; 10 em
; 11 state altering reserved i.e. algol comment message
; 12 simple reserved i.e. all reserved except the state altering
; and begin external end
; 13 begin external
; 14 end
\f
; jz 1979.02.16 algol 8, pass 1, page 6
;central action
w.
d0: hs. w0 j1. ; set state: state:=new state;
c0: rl. w0 f1. ; next char: ;this may be exchanged with a subroutine
;c0: jl. d67. ; in mnemonic: goto internal char;
g51 = d67 - c0
al w3 0 ; if current word empty then
ld w0 8 ; goto new word;
sn w0 0 ;
jl. a0. ;
a1: rs. w0 f1. ; retword: inchar;
rs. w3 f4. ; save char
bl. w0 x3+g0. ; get value(char);
j0: bl. w3 x3+g1. ; mode1: get class (char);
;j0: jl. d2. ; mode2: goto listing (message liston)
;j0: jl. d3. ; mode3: goto test (string comment after end)
; after in1:
j6: sh w3 -1 ; if char = ' or char = " then
jl. d68. ; goto init mnemonic;
;j6: jl. d69. ; in mnemonic: goto next mnemonic;
g52 = d69 - j6
d37: rs. w3 f18. ; after in: save class;
j1=k+1 ; state
d1: bl. w3 x3+0 ;
jl. x3 ; goto action(class,state);
g50 = g41 - d1 ;
i108 = g34 - d1;
a0: rl. w3 f2. ; next word:
sl. w3 (f3.) ; if current word addr>=last word addr then
jl. a2. ; goto next block;
al w3 x3+2 ;
rs. w3 f2. ; current word addr:=current word addr+2;
rl w0 x3 ;
sz. w0 (b21.) ; if word contains characters>127 then
jl. d56. ; goto giveup(not text);;
al w3 0 ; current word:=buffer(current word addr);
ld w0 8 ;
ba. w0 1 ; set word end indication;
jl. a1. ; goto retword;
b21: 1<23+1<15+1<7 ; character value mask;
a2: rs. w1 f5. ; next block:
jl. w3 (f40.) ; input block;
dl w0 x1+e51+2 ; current word addr:=record base;
ds. w0 f3. ; last word addr:=last byte;
rl. w1 f5. ;
j4: jl. a0. ; goto next word;
;if the input medium is typewriter the return jump is overwritten by
; rl w0 (0) ;
lx. w0 b19. ; if buffer(last word addr) contains
sz w0 1<8-1 ; cansel character then
ls w0 -8 ; goto next block
sz w0 1<8-1 ; else
ls w0 -8 ; goto next word;
sz w0 1<8-1 ;
jl. a0. ;
jl. a2. ;
b19: 24<16+24<8+24
\f
; jz 1979.11.05 algol 8, pass 1, page ...7...
d2: sn w0 h5 ; listing: if char=blind or char=illegal then
jl. a26. ; goto no listing;
ds. w0 f5. ; saved input:=char;work:=value(char);
sn w3 25 ; if char=end medium then
al w3 10 ; char:=new line;
sh w0 h3 ; if value(char)<>value(sp)&value(char)
rs. w0 f6. ; <>value(nl) then last output:=value(char);
al w0 x3 ; list:
jl. w3 e12. ; writechar;
dl. w0 f5. ; char:=saved input;value(char):=work;
a26: bl. w3 x3+g1. ; no listing: w3:=class;
jl. j6. ; goto after in1;
d3: sn w0 h5 ; test line: if char=blind or char=illegal then
jl. a26. ; goto no listing;
rs. w3 f4. ; saved input:=char;
sh w0 h3 ; if value(char)<>value(sp)&value(char)
rs. w0 f6. ; <>value(nl) then last output:=value(char);
jl. a26. ; goto no listing;
;variables and constants
f0 : 0 ; abs addr of current descr
f1 : 0 ; current word
g54 = f1 - c0
f2 : 0 ; current word addr
f3 : 0 ; last word addr
f4 : 0 ,f5 : 0 ; saved input , work
f6 : 0 ,f7 : bl. w3 x3+g1-j0 ; last output , get class
f8 : jl. d2-j0 ,f9 : jl. d3-j0 ; listing , test line
f10: 0 ,f11: 0 ; mode1 , mode2
f12: 0 ; mode3
f13: 0 ; last byte
f14: 0 ; old state
f15: rl. w0 f1-c0 ; normal next char
f16: 0 ,f17: 0 ; return1 , return2
f18: 0 , 0 ; stored dig or double work
f19: 0 ,f20: al w1 0 ; nummerical , set auxstate
f21: 0 ; stringword1 or saved class
f22: 0 ; stringword2 or saved value
f23: 0 ; return3
f24: 0 ; directionbyte
f25: 0 ,f26: 0 ; blankadd , minusadd
f27: 0 ,f28: 0 ; fadd , badd
f29: 0 ,f30: 0 ; hdadd , hdmask
f31: 0 ,f32: 0 ; limit exeded, no match res
f33: jl. i79 ; further nl after rigth par
f34: jl. i80 ; further nl in string
f35: jl. i81 ; further nl in layout
f36:e85: 0 ; begin count
f38: jl. i87 ; next source jump
f39: jl. i88 ; generate term jump
f40: 0 ; input block entry
f41: jl. a0-j4 ; normal end next block
f42: rl w0 (0) ; typewr end next block
f43: 0 ; fp base
f44: 0 ; sourcepointer
f45: 0 ; missing end counter
f46: 0 ; writetext entry
f47: 0 ; saved giveup action
f48: jl. i39 ; unstack jump
;
; the variables f24-28 are also used for storing of matching letters
; in the reserved word actions.
\f
; jz 1979.10.04 algol 8, pass 1, page ...8...
d75: jl. d28. ; stepping stone to layout start;
c1: sn w0 h3+5 ; illegal in string: if graphic then
jl. c4. ; goto stringchar;
c2: al w0 h3+1 ; other illegal:
jl. w3 e3. ;
al w0 h7 ; character;
jl. w3 e3. ;
jl. c0. ; goto next char;
c3: sn w0 h5 ; blind in string: if blind then
jl. c0. ; goto next char;
al w0 32 ;
rs. w0 f4. ; saved input:=space;
c4: se w1 0 ; stringchar: if auxstate<>normal then
jl. w3 d4. ; change auxstate to normal;
rl. w0 f4. ; get saved input;
jl. w3 d5. ; pack char(saved input);
jl. c0. ; goto next char;
c5: al w3 h6 ; new line:
sn. w3 (f6.) ; if last out =new line then
jl. c46. ; goto linetest;
rs. w3 f6. ; last out:=new line;
jl. w3 e3. ; outbyte(new line);
jl. w3 e1. ; count line;
c46: rl. w3 f4. ; linetest:
se w3 12 ; if char=ff then
jl. a3. ; begin
al w3 0 ;
rl. w0 e64. ; bossline:=
wd. w0 b11. ; //1000*1000
wm. w0 b11. ; +1000;
wa. w0 b11. ;
rs. w0 f5. ; save bossline;
jl. d29. ;
a3: rl. w3 e64. ;
al w3 x3+10 ; bossline:=bossline+10;
rs. w3 e64. ;
d29: rl. w3 j0. ;
se. w3 (f8.) ; if -, listing then
jl. d30. ; goto further nl action;
rl. w0 c0. ; if after em then
sn. w0 (f48.); goto further nlaction;
jl. d30. ;
jl. w3 e27. ; print linecount;
al w0 32 ;
jl. w3 e12. ; writechar(out,space);
d30: rl. w3 f4. ;
se w3 12 ; if char=ff then
jl. j3. ;
rl. w0 f5. ; set bossline
rs. w0 e64. ; after ff
j3: ; further nl action:
al w1 0 ; normal: further nlactions:=expec. reserved
;j3: jl. c0. ; after right par: next char;
;j3: jl. c4. ; instring: nl:=string char;
;j3: jl. c11. ; layout: nl:=error;
jl. c0. ; goto next char;
b11: 1000 ;
\f
; rc 1975.01.15 algol 6, pass 1, page 8a
c6: se w0 h2+22 ; simple in comment: if char<>semikolon then
jl. c0. ; goto next char;
rs. w0 f13. ; last byte:=semicolon
d38: rl. w0 f10. ; return to neutral:
rs. w0 j0. ; mode:=mode1;
al w1 0 ; auxstate:=expecting reserved;
al w0 g41-d1 ; state:=neutral;
jl. d0. ; goto set state;
c7: sn w1 60 ; digit in string: if auxstate<>in nummerical
sl. w2 f25.+2 ; or digits>=3 then
jl. c4. ; goto stringchar;
al w2 x2+1 ; digits:=digits+1;
al w0 10 ;
wm. w0 f19. ; nummerical:=nummerical*10;
rl. w3 f4. ;
hs w3 x2 ; stored dig(digits):=saved input;
al w3 x3-48 ;
wa w3 0 ;
rs. w3 f19. ; nummerical:=mummerical+digit;
jl. c0. ; goto next char;
\f
;jz.fgs.1981.02.25 algol 6, pass 1, page 9
c8: sn w0 h2+3 ; first of comp in string:
jl. a27. ; if char=colon then goto testlesscolon;
sn w0 h0+6 ; if char=less then
jl. a28. ; goto new auxstate;
se w1 0 ; if auxstate=normal
se w0 h0+10 ; or char<>greater than then
jl. c4. ; goto stringchar;
sn w1 58 ; if auxstate=expecting end string then
jl. a29. ; goto endstring;
sh. w2 f25.-1 ; if digits<0 then
jl. c4. ; goto stringchar;
al w0 127 ;
la. w0 f19. ; char:=nummerical mod 128;
jl. w3 d5. ; pack character(char);
al w1 0 ; auxstate:=normal;
rl. w0 f19. ;
sl w0 1 ; if numerical<1 or
sl w0 128 ; numerical>127 then
sz w0 0 ;
jl. c0. ;
al w0 h3+1 ;
jl. w3 e3. ; errorout(text);
al w0 h12 ;
jl. w3 e3. ;
jl. c0. ; goto next char;
a27: sn w1 60 ; testlesscolon:
sl. w2 f25. ; if -,(auxstate=less and digits<0) then
jl. a28. ; goto new auxstate;
al w0 h3+1 ; auxstate=less and digits<0:
jl. w3 e3. ; errorout(text);
al w0 h12 ;
jl. w3 e3. ;
a28: se w1 0 ; new auxstate: if auxstate<>normal then
jl. w3 d4. ; change auxstate to normal;
rs. w1 f19. ; nummerical:=0;
al. w2 f25.-1 ; digits:=-1;
rl. w1 f4. ; set auxstate;
jl. c0. ; goto next char;
a29: dl. w0 f22. ; end string:
sl w3 0 ; if string full then
jl. a30. ; goto full;
nd. w0 f22. ;
ld w0 1 ; fill string with zeroes;
ds. w0 f22. ;
a30: jl. w3 d6. ; outstring;
rl. w0 f20. ;
rs. w0 j3. ; futher nl action:=normal nl action;
jl. d38. ; goto return to neutral;
d4: rs. w3 f16. ; change auxstate to normal: save return1;
al w0 x1 ; get saved special;
jl. w3 d5. ; pack character(saved special);
al. w1 f25.-1 ; for i:=0 step 1 until digits do
a31: sl w1 x2 ;
jl. a32. ;
al w1 x1+1 ;
bl w0 x1 ;
al. w3 a31. ;
jl. d5. ; pack character(stored dig(i));
a32: al w1 0 ; auxstate:=normal;
jl. (f16.) ; goto return1;
\f
;rc 3.12.1970 algol 6, pass 1, page 10
d5: rs. w3 f17. ; pack character: save return2;
rl. w3 f21. ;
wa. w0 f22. ;
rs. w0 f22. ; string:=string+char;
sl w3 0 ; if string full then
jl. w3 d6. ; outstring;
ld w0 8 ;
ds. w0 f22. ; string:=string shift 8;
jl. (f17.) ; goto return2;
d6: rs. w3 f23. ; outstring: save return3;
rl. w0 f24. ;
jl. w3 e3. ; out direction byte;
bz. w0 f21. ;
jl. w3 e3. ;
bz. w0 f21.+1 ;
jl. w3 e3. ; out string bytes;
bz. w0 f22. ;
jl. w3 e3. ;
bz. w0 f22.+1 ;
jl. w3 e3. ;
al w0 h3+4 ;
rs. w0 f24. ; direction byte:=string next;
al w0 -1 ; string:=empty string;
al w3 -1 ;
jl. (f23.) ; goto return3;
\f
; jz 1979.08.22 algol 6, pass 1, page 14
c12: se w1 0 ; resletter after rigth par: if auxstate<>
jl. c0. ; expecting reserved then goto next char;
al. w3 d18. ;
rs. w3 f32. ; no match res:=no match res after rigth par;
jl. d36. ; goto first of reserved ;
c13: al w1 1 ; other letter after rigth par: auxstate:=aft let;
jl. c0. ; goto next char;
c14: jl. w2 d20. ; simple or digit after rigth par: outpar;
jl. w2 d21. ; restore after rigth par;
jl. c33. ; goto digit;
c15: jl. w2 d20. ; rigth par after rigth par: outpar;
jl. c0. ; goto next char;
c16: rs. w0 f18.+2 ; reserved word after rigth par: save value,class;
al w0 h2+42 ;
rs. w0 f13. ; last byte:=value(right par);
jl. w3 e3. ; outbyte(rigthpar);
al. w0 d26. ;
rs. w0 f32. ; no match res:=normal no match res;
jl. w2 d21. ; restore after rigth par;
dl. w0 f18.+2 ; restore value,class;
jl. d37. ; goto after in;
d20: rs. w0 f18.+2 ; outpar: save value and class;
sn w1 0 ; if auxstate<>aft let then
jl. a38. ; goto no error;
al w0 h3+1 ;
jl. w3 e3. ;
al w0 h11 ;
jl. w3 e3. ; rigth par improper;
al w1 0 ; auxstate:=expecting reserved;
a38: al w0 h2+42 ; no error:
jl. w3 e3. ; outbyte(rigth par);
dl. w0 f18.+2 ; restore value and class
jl x2 ; return;
d21: al w3 g41-d1 ; restore after right par:
hs. w3 j1. ; state:=neutral;
d39: rl. w3 f10. ; comment entry from first of comp;
rs. w3 j0. ; mode:=mode1;
rl. w3 f20. ;
rs. w3 j3. ; further nl:=normal nl;
jl x2 ; return;
d18: al. w0 d26. ; no match res after rigth par:
rs. w0 f32. ; no match res:=normal no match res;
jl. d25. ; goto return from no match res;
\f
; jz 1979.08.22 algol 8, pass 1, page ...15...
c17: jl. w2 d39. ; first of comp after rigth par:
al w2 g41-d1 ; oldstate :=
rs. w2 f14. ; neutral;
al. w2 a100. ; set return from outpar to first of comp after );
se w1 0 ; if auxstate<>aft let
se w0 h2+3 ; or char<>colon then
jl. d20. ; outpar;
al w3 9 ;
rs. w3 f18. ; saved class:=9;
al w1 i86 ; auxstate := fatcomp;
jl. a103. ; goto first of comp after);
c18: bl. w3 j1. ; first of comp:
rs. w3 f14. ; oldstate := state;
a100:al w1 0 ; first of comp after ): auxstate:=expecting reserved;
a103:rl. w3 f18. ; get saved class;
rs. w0 f22. ; saved value:=value;
rl w2 0 ;
sh w0 h0 ;
am x3+h0-h2-5; comment char = colon;
al. w2 x2+g48. ; comment x2+g48.=x2+g31.-1000
bl w2 x2+1000 ;
al. w2 x2+g15. ; set comp tree point;
al w2 x2+g46 ; this because of distance to g23
al w0 g39-d1 ; state:=compound;
jl. d0. ; goto set state;
c19: se w0 h2+30 ; simple in comp: if char=comma
sn w0 h2+25 ; or char=left par then
jl. c20. ; goto test comp;
jl. c21. ; goto no match comp;
a39: al w2 x2+6 ; next branch: comp tree point:=next branch;
c20: sn w0 (x2) ; test comp: if char=compchar(comp tree point) then
jl. x1+d23. ; goto if auxstate=fatcomp then fatcomp else compmatch;
sl w0 (x2+2) ; if -,last branch then
jl. a39. ; goto next branch;
c21: se w1 0 ; no match comp: if auxstate=fatcomp then
jl. w2 d20. ; outpar;
rx. w0 f22. ; w:=saved value;saved value:=value;value:=w;
rl. w3 f18. ; get saved class;
rs. w3 f21. ; saved class:=class;
rl. w3 f14. ;
hs. w3 j1. ; state := old state;
sn w3 g37-d1 ; if old state <> end comm then
jl. a102. ; begin
jl. w3 e3. ; outbyte(value);
rs. w0 f6. ; last output:=value;
; end;
a102:rs. w0 f13. ; last byte:=value;
dl. w0 f22. ; value:=saved value;class:=saved class;
jl. d37. ; goto after in;
d22: se w0 h0+8 ; fatcomp:if char<>equal then
jl. d23. ; goto compmatch;
rs. w2 f5. ; save comp tree point;
jl. w2 d20. ; outpar;
rl. w2 f5. ; restore comp tree point;
d23: rl. w0 f14. ; compmatch:
hs. w0 j1. ; state:=oldstate;
bz w3 x2+4 ; class:=class(comp tree point);
bl w0 x2+5 ; value:=value(comp tree point);
jl. d37. ; goto after in;
i86=d22-d23 ; modification of action addr for matching compound
\f
; jz 1979.08.22 algol 8, pass 1, page ...16...
c22: se w1 0 ; resletter after end: if auxstate let then
jl. c0. ; goto next char;
d36: bl. w3 j1. ; first of reserved:
rs. w3 f14. ; old state := state;
al. w1 f25. ;
hs. w0 f25. ; letters := 0;
rl w2 0 ; stored letters(0) := char;
am 2000 ;
bl. w2 x2+g53. ; get res tree point;
al w0 g40-d1 ; state:=in res;
jl. d0. ; goto set state;
c24: se w0 h2+24 ; simpel res after end:
sn w0 h2+28 ; if char=else or char=until then
jl. d24. ; goto finish end comment;
c25: dl. w0 f22. ; res after end: get saved wordterminator;
jl. d37. ; goto after in;
c26: sn w0 h2+22 ; simple after end: if char=semicolon then
jl. d24. ; goto finish end comment;
c27: al w1 0 ; word terminator: auxstate:=expecting reserved;
jl. c0. ; goto next char;
d24: rs. w0 f18.+2 ; finish end comment: save value class;
rl. w0 f10. ;
rs. w0 j0. ; mode:=mode1;
al. w0 d26. ;
rs. w0 f32. ; no match res:=normal no match res;
al w0 g41-d1 ;
hs. w0 j1. ; state:=neutral
dl. w0 f18.+2 ; restore value,class;
jl. d37. ; goto after in;
c28: se w1 0 ; resletter in prelude: if auxstate=aft let then
jl. c0. ; goto next char;
jl. d36. ; goto first of res;
a40: rl. w2 x2+i77. ; next branch res: tree point:=next branch;
c29: sn. w0 (x2+g21.) ; resletter: if char=letter(res tree point) then
jl. a41. ; goto resmatch;
sl. w0 (x2+i77.) ; if -,last branch then
jl. a40. ; goto next branch res;
c30: rl. w3 f18. ; no match res: get saved class;
ds. w0 f22. ; save value,class;
jl. (f32.) ; no match res action;
d25: al w1 1 ; return from no match res: auxstate:=aft let;
rl. w0 f14. ;
hs. w0 j1. ; state:=old state;
dl. w0 f22. ; restore value,class;
jl. d37. ; goto after in;
a41: al w1 x1+1 ; resmatch: letters:=letters+1;
hs w0 x1 ; stored let(letters):=char;
al w2 x2+4 ; res tree point:=next letter;
jl. c0. ; goto next char;
\f
; jz 1979.08.15 algol 8, pass 1, pagre ...17...
c31: rl. w3 f18. ; wordterminator in res: get saved class;
ds. w0 f22. ; save value,class;
al w0 h5 ;
se. w0 (x2+g21.) ; if reserved not finished then
jl. (f32.) ; no match res action;
rl. w0 f14. ;
hs. w0 j1. ; state:=old state;
al w1 0 ; auxstate:=expecting reserved;
bz. w3 x2+i77. ; class:=class(res tree point);
bl. w0 x2+i78. ; value:=value(res tree point);
jl. d37. ; goto after in;
d26: al. w2 f25. ; normal no match res:
a42: bl w0 x2 ; for i:=0 step 1 until letters do
am -2047 ;
jl. w3 e3.+2047 ;
al w2 x2+1 ; outbyte(stored let(i));
sh w2 x1 ;
jl. a42. ;
rs. w0 f6. ; last output:=stored let(letters);
rs. w0 f13. ; last byte:=stored let(letters);
jl. d25. ; goto return from no match res;
c23: se w1 1 ; resletter: if auxstate=expecting reserved then
jl. d36. ; goto first of res;
c32: al w1 1 ; other letter: auxstate:=aft let;
c33: am -2047 ;
jl. w3 e3.+2047 ; digit: outbyte(char);
rs. w0 f6. ; last output:=char;
rs. w0 f13. ; last byte:=char;
jl. c0. ; goto next char;
c34: se w1 1 ; space: if auxstate=expecting reserved then
jl. c0. ; goto next char;
c35: al w1 0 ; simple: auxstate:=excepting reserved;
jl. c33. ; goto digit;
c36: am -2047 ;
jl. w3 e3.+2047 ; simple reserved: outbyte(value);
rs. w0 f6. ; last output:=value;
rs. w0 f13. ; last byte:=value;
al. w3 e9.+6+2047;
sn w0 h13 ; if byte=context then
rs w0 x3-2047 ; contextmode:=true;
dl. w0 f22. ; get saved wordterminator;
jl. d37. ; goto after in;
\f
; jz 1979.08.09 algol 8, pass 1, page ...18...
c37: rl. w3 f4. ; state altering simple:
se w3 41 ; if saved char = )
jl. a101. ; then
bl. w3 j1. ; oldstate :=
rs. w3 f14. ; state;
a101:rl. w3 f14. ; check end com:
se w3 g37-d1 ; if oldstate <> endcom then
jl. a99. ; goto state altering;
sn w0 g44-d1 ; if state = comment string then
jl. d0. ; goto set state;
al w0 x3 ; state := old state;
al w1 0 ; auxstate := 0;
jl. d0. ; goto set state;
a99: hs. w0 j1. ; state altering: state:=state(value);
rs. w0 f6. ; last output:=value;
rl. w1 b12. ;
sn w0 i73 ; if value=layout start then
jl. d75. ; goto layout start;
rl. w3 f12. ;
se w1 i75 ; if -, in algol then
rs. w3 j0. ; mode:=mode3;
al w1 0 ; auxstate:=normal;
sn w0 i72 ; if value=string start then
jl. d27. ; goto string start;
rl. w3 f33. ; after right par,commstring:
rs. w3 j3. ; futher nl action:=next char;
rl. w3 b12. ; if state<>in algol
se w3 i75 ; then goto nextchar;
jl. c0. ;
al. w2 g47. ; g47.=c51-1000
al w2 x2+1000 ;
bz w1 x2+i93 ; if saved auxstate
sn w1 0 ; =neutral then goto
jl. c0. ; nextchar else if state
sh w1 2 ; =intext or innumber then
jl x2+i101 ; goto termination
jl x2+i94 ; else goto paramalarm;
d27: rl. w3 f34. ; string start:
rs. w3 j3. ; futher nl action:=string char;
al w3 h3+3 ; directionbyte:=string first;
rs. w3 f24. ;
al w0 -256 ;
al w3 -1 ;
ds. w0 f22. ; string:=empty string;
jl. c0. ; goto next char;
\f
; jz 1979.02.15 algol 8, pass 1, page 19
b8: <:message :>
b9: <:algol <0>:>
b12: 0 ; saved type
c38: rs. w0 f6. ; state altering res: last output:=value;
rs. w0 b12. ; save type
rl. w2 f12. ; get mode3;
se w0 i74 ; if value=comment
sn. w2 (f11.) ; or mode3=mode2 then
jl. a46. ; goto after heading;
al. w1 b8. ;
sn w0 i75 ; if value=algol
al. w1 b9. ; then message(<:algol:>);
am -2000 ;
jl. w3 e4.+2000 ; message(<:message:>);
rl. w2 f11. ; get mode2;
a46: rs. w2 j0. ; after heading: set mode;
rl. w0 f13. ; w:=last byte;
se w0 h2+5 ; if w=begin
sn w0 h2+22 ; or w=semicolon then
jl. a43. ; goto comment ok;
al w0 h3+1 ;
am -2000 ;
jl. w3 e3.+2000 ; comment error;
al w0 h9 ;
am -2000 ;
jl. w3 e3.+2000 ;
a43: al w0 g33-d1 ; comment ok:
rl. w3 b12. ; if state=in algol then
se w3 i75 ; begin
jl. a62. ;
al. w3 c51. ;
al w3 x3+i95 ;
al w0 0 ;
al w1 0 ; auxstate:=neutral;
ds w1 x3+2 ; zeroset work variables;
ds w1 x3+6 ;
rs w1 x3+8 ;
rs w1 x3+i102 ;
hs w1 x3+i100 ;
rl. w2 f0. ;
rl w2 x2+e51+12 ; move modebits from
hs w2 x3+i96 ; zone descr to work;
al w0 g43-d1 ; state:=algol;
; end else
a62: hs. w0 j1. ; state:=in comment;
dl. w0 f22. ; get saved wordterminator;
jl. d37. ; goto after in;
\f
; jz 1979.08.09 algol 8, pass 1, page 20
c40: rl. w3 f10. ; first begin:
rs. w3 j0. ; mode:=mode1;
al w3 g41-d1 ;
hs. w3 j1. ; state:=neutral;
al w3 h4 ;
rs. w3 j2. ; delete external from restable;
c41: al w3 h2+5 ; begin:
rs. w3 f6. ; last output:=begin;
rs. w3 f13. ; last byte:=begin;
am -2000 ;
jl. w3 e3.+2000 ; outbyte(value);
al w3 1 ;
wa. w3 f36. ;
rs. w3 f36. ; begin count:=begin count+1;
al. w0 d26. ;
rs. w0 f32. ; no match res:=normal no match res;
dl. w0 f22. ; get saved wordterminator;
jl. d37. ; goto after in;
c42: rl. w3 f12. ; end:
rs. w3 j0. ; mode:=mode3;
al. w3 d25. ;
rs. w3 f32. ; no match res:=return from no match res;
al w3 g37-d1 ;
hs. w3 j1. ; state:=in end comment;
c43: am -2000 ;
jl. w3 e3.+2000 ; end after end: outbyte(end);
rs. w3 f6. ; last output:=end;
al w3 -1 ;
wa. w3 f36. ;
rs. w3 f36. ; begin count:=begin count-1;
sn w3 0 ; if begin count=0 then
jl. d32. ; goto end pass1;
dl. w0 f22. ; get saved wordterminator;
jl. d37. ; goto after in;
c44: sn w0 h0+2 ; first of comp in commentstring:
jl. a49. ; if char=star then goto testlessstar;
sn w0 h0+6 ; if char=less then
jl. a50. ; goto newauxstate;
sn w0 h0+10 ; if -, *>
se w1 42 ; then
jl. c56. ; goto char in commentstring;
rl. w0 f20. ; further nl action:=
rs. w0 j3. ; normal nl action;
al w1 0 ; auxstate := 0;
rl. w0 f14. ;
rl. w3 b12. ; if inalgol then
sn w3 i75 ; state := inalgol
al w0 g43-d1 ; else state := old state;
jl. d0. ; goto set state;
a49: se w1 60 ; testlessstar: if -, <*
jl. a50. ; then goto newauxstate;
al w0 h3+1 ; trouble:
am -2000 ;
jl. w3 e3.+2000 ; outerror(text);
al w0 h12 ;
am -2000 ;
jl. w3 e3.+2000 ;
a50: rl. w1 f4. ; newauxstate:
jl. c0. ; goto nextchar;
c56: al w1 0 ; char in commentstring: auxstate:=normal;
jl. c0. ; goto nextchar;
\f
; jz 1979.10.16 algol 8, pass 1, page 21
b24: <: unknown:> ;
b25: <: not textfile:> ;
b26: <: not mag.tape:> ;
b27: <: illegal kind:> ;
b28: <: connect error:>;
b29: <: not text<0>:> ;
b30: <: hard error:>
b31: <:error at source: :>;
b32: 0 ; status
b33: 0 ; cause, count
d61: am b24-b25 ; giveup(unknown)
d60: am b25-b26 ; giveup(not textfile)
d59: am b26-b27 ; giveup(not mag.tape);
d58: am b27-b28 ; giveup(illegal kind)
d57: am b28-b29 ; giveup(connect error);
d56: am b29-b30 ; giveup(not text);
d55: al. w0 b30. ; giveup(hard error);
ds. w0 b33. ; save cause, status;
al. w1 b31. ;
am -2000 ;
jl. w3 e4.+2000; message(<:error at source:>);
al. w1 c51. ;
rl w1 x1+i103 ;
am -2000 ;
rs. w1 e82.+2000; save name addr
jl. w3 d31. ; printname;
rl. w1 b33. ;
am -2047 ;
jl. w3 e13.+2047 ; writetext(error cause);
rl. w0 b32. ; if harderror then
se. w1 b30. ; fpanswer:=statusbits;
a52: al w0 1 ; terminate translation:
am -2000 ;
rs. w0 e40.+2000 ; unsuccesfull execution:=other reason;
jl. w1 d54. ; reestablish cur.input;
am -2000 ;
jl. e26.+2000 ; goto fp end program;
\f
; jz.fgs 1986.03.03 algol 8, pass 1, page ...22...
d32: al w0 h3 ; end pass:
am -2000 ;
jl. w3 e3. +2000 ; outbyte (end pass);
rl. w0 f45. ;
sn w0 0 ; if missing end counter <>0 then
jl. a53. ; begin
am -2000 ;
jl. w3 e14.+2000 ;
32<12 +5 ; writeinteger(<<ddddd>,missing end counter);
al. w1 b17. ;
rl. w3 b18. ; writetext(if missing end counter=1 then
sn w0 1 ; <: end missing:> else <: ends missing:>);
rs w3 x1+2 ;
am -1000 ;
jl. w3 e13.+1000 ; end
jl. a81. ; else
a53: rl. w3 j0. ; if mode<>listing then
sn. w3 (f8.) ; begin
jl. a81. ;
al w0 10 ;
am -1000 ;
jl. w3 e12.+1000 ; outnl;
am -1000 ;
jl. w3 e27.+1000 ; outlinenumber;
al. w1 b20. ;
am -1000 ;
jl. w3 e13.+1000 ; outtext (<:end:>);
rl. w0 f4. ;
am -1000 ;
jl. w3 e12.+1000 ; outchar (terminator);
; end;
b35 = k + 1 ; one source listed:
a81: sn w3 x3 ; if one source listed then
jl. a82. ; begin
al w0 12 ; outff;
am -1000 ;
jl. w3 e12.+1000 ; end;
a82: rl. w3 f44. ;
am -1000 ;
se. w3 (e46.+1000); if sourcepointer <> sourcelist start then
jl. a61. ; goto end pass;
jl. w1 d54. ; reestablish current input;
rl. w0 f47. ; restore give up;
rs w0 x3+e50+2 ; restore give up;
a61: am -1000 ; goto end pass:
jl. e7. +1000 ; goto end pass;
b17: <: ends missing:>
b18: <:d<32> :>
b20: <: end:>
d54: rs. w1 b32. ; save return;
rl. w3 f0. ; reestablish current input:
rl. w0 f1. ; partial word:=
rs w0 x3+e50+4 ; current word;
am -1000 ;
rl. w0 e64.+1000; save bossline;
rs w0 x3+e50+6 ;
rl. w1 f2. ; recordbase:=
al w1 x1-2 ; cur word addr-2;
rl. w2 f3. ; last byte:=last word addr;
ds w2 x3+e51+2 ;
jl. (b32.) ; end pass;
\f
;jz.fgs.1981.03.02 algol 6, pass 1, page ...23...
c45: al w3 10 ; em: saved input:=nl;
rs. w3 f4. ;
rl. w1 f8. ; if mode3<>listing
se. w1 (f12.) ; and mode2=
se. w1 (f11.) ; message.yes
jl. a47. ; then
al. w1 b10. ; write(out,<:end medium:>);
am -1000 ;
jl. w3 e4.+1000 ;
a47: ;
rl. w3 f38. ; next char action:=(goto next source);
am. g49. ; g49.=b44.-1000
bz w1 1000 ;
se w1 0 ; then nextaction:=
rl. w3 f48. ; goto unstack;
rs. w3 c0. ; value:=value(nl);
al w3 8 ; class:=class(nl);
jl. d37. ; goto after in;
b10: <:end medium:>
c39: jl. c55. ; stepping stone to unstack;
c47: jl. c51. ; stepping stone to digit
c48: jl. c52. ; stepping stone to letter
c49: jl. c53. ; stepping stone to simple
c50: jl. c54. ; stepping stone to nl ff sp
c58: jl. c60. ; stepping stone to comp
c59: jl. c61. ; stepping stone to lessstar:
c66: am -2047 ; stepping stone to outbyte
jl. e3.+2047 ;
d43: rl. w3 f44. ; next source:
rl w0 x3 ;
sn w0 0 ; if sourcelist empty then
jl. d47. ; goto terminate program;
ds. w2 f17. ; save registers;
rl. w1 f0. ;
am. (f43.) ;
jl w3 e67 ; terminate zone;
d44: rl. w3 f44. ; connect source:
al w2 x3+10 ;
rs. w2 f44. ;
a48: rs. w3 b40. ; save cur name addr;
am. (f43.) ;
al w1 e55 ; w1:=fp lookup area
jd 1<11+42; lookup tail
sn w0 3 ; if not found then
jl. d61. ; goto giveup(unknown);
bl w0 x1+16 ;
se w0 0 ; if contents<>0 then
jl. d60. ; goto giveup(not textfile)
rl w2 x1 ; modekind
bz w0 x3+8 ;
sn w0 0 ; if fileno<>0 then
jl. a54. ; begin
wa w0 x1+12 ; filecount:=filecount
rs w0 x1+12 ; + fileno;
bz w0 x1+1 ; w0:=kind;
sh w2 0 ; if modekind>0 or
se w0 18 ; kind<>18 then
jl. d59. ; giveup(not mag.tape);
a54: sl w2 0 ; end;
al w1 x3 ; if bsarea then connect name
\f
; jz 1979.08.09 algol 8, pass 1, page ...23a...
al w2 x1 ; w2:=tail addr
am. (f43.) ;
jl w3 e31-2 ; connect current input;
sn w0 4 ; if result=4 then
jl. d58. ; giveup(kind);
se w0 0 ; if result<>0 then
jl. d57. ; giveup(connect);
rl. w3 b40. ;
al w2 x1 ;
dl w1 x3+2 ;
ds w1 x2+e51+6 ; move name
dl w1 x3+6 ; to zonedescr.
ds w1 x2+e51+10 ;
rl w0 x3+8 ;
rs w0 x2+e51+12 ; w0:=modebits;
al w1 10 ; bossline:=0;
am 1 ;
d42: al w2 0 ; medium connected:
hs. w2 j5. ;
am -1000 ;
rs. w1 e64.+1000; set bossline;
jl. w1 d45. ; set modes;
al w1 x3 ;
dl w0 x1+e51+2 ;
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;
rl. w3 f11. ; if message.no then
sn. w3 (f9.) ; then skip
jl. a11. ; nameprint;
jl. w3 d46. ; outnl;
jl. w3 d31. ; outname;
j5=k+1
se w1 x1+0 ; if new source then
jl. w3 d34. ; print date and clock
a11: rl. w3 f8. ; if mode=listing then
se. w3 (j0.) ; print linecount;
jl. a34. ;
jl. w3 d46. ; outnl;
am -1000 ;
jl. w3 e27.+1000; writeinteger(line);
jl. w3 d50. ; writechar(out,space);
a34: rl. w3 f15. ;
rs. w3 c0. ; next char action:=normal;
rl. w3 f41. ; end next block action:=normal;
rl. w1 b34. ; restore w1
bl w0 x1+e49+1 ; if kind=typewriter then
sn w0 8 ; end next block action:=
rl. w3 f42. ; test line cancel;
rs. w3 j4. ;
al. w3 d55. ;
rs w3 x1+e50+2 ; set giveup action;
dl. w2 f17. ; restore registers;
jl. c0. ; goto next char;
\f
; jz.fgs 1982.08.18 algol 6, pass 1, page ...23b...
d45: al. w2 c20. ; set modes:
sz w0 1 ; if listing mode then
jl. a44. ; goto all list;
rl w3 x2+f7 -c20;
rs w3 x2+f10-c20; mode1:=get class;
rl w3 x2+f9 -c20; w:=
rs w3 x2+f12-c20; mode3:=test line;
sz w0 2 ; if message mode then
rl w3 x2+f8 -c20; w:=listing;
rs w3 x2+f11-c20; mode2:=w;
jl. a45. ; goto further init;
a44: rl w3 x2+f8 -c20; all list:
rs w3 x2+f10-c20; mode1:=
rs w3 x2+f11-c20; mode2:=
rs w3 x2+f12-c20; mode3:=listing;
al w3 1 ; one source listed :=
hs. w3 b35. ; true;
a45: bl. w3 j1. ; further init:
sn w3 g38-d1 ; if state=prelude then
jl. a59. ; mode:=mode2 else
se w3 g34-d1 ; if state=instring or state=
sn w3 g36-d1 ; after rightpar then mode:=mode3
jl. a60. ; else
se w3 g44-d1 ; if state=in commentstring or
sn w3 g37-d1 ; state=after end then mode:=
jl. a60. ; mode3 else
sn w3 g33-d1 ; if state<>comment and state<>
se w3 g43-d1 ; algol then mode:=mode1 else
jl. a58. ; if state=comment then
rl. w3 b12. ; mode:=mode3 else
se w3 i74 ; if state=message or
jl. a59. ; state=algol then
jl. a60. ; mode:=mode2;
a58: am f10-f11;
a59: am f11-f12;
a60: rl. w3 f12. ;
rs. w3 j0. ;
am (x2+e23-c20;
al w3 e22
rs. w3 b34. ; save cur in descr.
hs w0 x3+e51+13 ; save modebits
jl x1 ; return
\f
;rc 1977.11.02 algol 6, pass 1, page ...24...
d47: rl. w0 f39. ; terminate program:
rs. w0 c0. ; next char action:=(goto generate terminator);
al w0 x1 ;
al. w1 b13. ;
am. c20. ;
jl w3 e4-c20 ; message(<:source exhausted:>);
rl w1 0 ;
d48: bl. w0 j1. ; generate terminator:
se w0 g43-d1 ; if state=in algol or
sn w0 g33-d1 ; if state=in comment then
jl. d51. ; goto terminate comment;
sn w0 g34-d1 ; if state=instring then
jl. d52. ; goto terminate string;
sn w0 g44-d1 ; if state=commentstring then
jl. d62. ; goto terminate commentstring;
se w0 g38-d1 ; if state <> in prelude then
jl. d53. ; goto generate end;
al. w1 b14. ;
jl. w3 (f46.) ; writetext(<:no program:>);
jl. a52. ; goto terminate translation;
b13: <:source exhausted:>
b14: <: no program:>
d51: al w0 x1 ; terminate comment:
al. w1 b15. ;
jl. w3 (f46.) ; writetext(<: in comment:>);
rl w1 0 ;
al w3 5 ; class:=class(semicolon);
al w0 h2+22 ; value:=value(semicolon);
jl. d37. ; goto after in;
b15: <: in comment:>
d52: al w3 7 ; terminate string:
al w0 h0+10 ; if auxstate=expecting end string then
sn w1 58 ; begin class:=class(>);value:=value(>);goto after in
jl. d37. ; end;
al. w1 b16. ;
jl. w3 (f46.) ; writetext(<: in string:>);
al w1 58 ;
rs. w1 f4. ; saved input:=colon;
al w1 0 ; auxstate:=normal;
al w3 7 ; class:=class(colon);
al w0 h2+3 ; value:=value(colon);
jl. a51. ; goto after in;
b16: <: in string:>
d53: al w0 1 ; generate end:
wa. w0 f45. ;
rs. w0 f45. ; missing end counter:=missing end counter+1;
al w0 h3+5 ;
al w3 9 ;
ds. w0 f22. ; saved wordterminator:=space;
al w0 h2+23 ; value:=value(end);
al w3 14 ; class:=class(end);
a51: am -1000 ;
jl. d37.+1000 ; goto after in;
\f
; rc 1974.11.18 algol 6, pass 1, page 24a
d62: al w3 7 ; terminate commentstring:
al w0 h0+10 ; if auxstate=expecting end string then
sn w1 42 ; begin class:=class(>); value:=value(>)
jl. a51. ; (d37.) goto after in end;
al. w1 b23. ;
jl. w3 (f46.) ; writetext(<: in commentstring:>);
al w1 42 ;
rs. w1 f4. ; saved input:=star;
al w1 0 ; auxstate:=normal;
al w3 7 ; class:=class(star);
al w0 h0+2 ; value:=star;
jl. a51. ; (d37.) goto after in;
b23: <: in commentstring:>
\f
; jz.fgs 1982.11.08 algol 8, pass 1, page ...25...
;table of reserved words
w.
g2 :2 ,i51,19,h4 ,h5,12<12+h2+35 ; abs
a6 :4 ,i92,4 ,h4 ,h5,12<12+h0+19 ; add
a5 :12,i52,7 ,h4 ,15,h4 ,12,h4 ,h5,11<12+3 ; algol
a7 :18,i53,18,h4 ,1 ,h4 ,25,h4 ,h5,12<12+h2+17 ; array
a8 :14,h4 ,4 ,h4 ,h5,12<12+h0+12 ; and
g3 :5 ,i54,7 ,h4 ,9 ,h4 ,14,h4 ,h5,13<12+h2+5 ; begin
a9 :15,h4 ,15,h4 ,12,h4 ,5 ,h4 ,1 ,h4 ,14,h4 ,h5,12<12+h2+13; boolean
g4 :1 ,i55,19,h4 ,5 ,h4 ,h5,12<12+h2+36 ; case
a10:15,h4 ,13,i104,13,h4 ,5 ,h4 ,14,h4 ,20,h4 ,h5,11<12+1 ; comment
a86: 14,h4,20,h4,5,i106,24,h4,20,h4,h5,12<12+h13 ; context
a84: 9,h4,14,h4,21,h4,5,h4,h5,12<12+h15 ; continue
g5 :15,i109 ,h5,12<12+h2+34 ; do
a98: 9, h4 ,19,h4,1,h4,2,h4,12,h4,5,h4,h5,12<12+h2+43 ; disable
g6 :12,i57,19,h4 ,5 ,h4 ,h5,12<12+h2+24 ; else
a12:14,i58,4 ,i59,h5,14<12+h2+23 ; end
a13:20,h4 ,9 ,h4 ,5 ,h4 ,18,h4 ,h5,12<12+h2+39 ; entier
a14:24,h4 ,20,i105,18,i89,1 ,h4,3 ,h4,20,h4,h5,12<12+h0+18 ; extract
a83: 9,h4,20,h4,h5,12<12+h14 ; exit
a55:5 ,h4 ,14,j2:i60,4 ,h4,h5 ,12<12+h2+40 ; extend
;in prelude the chain goes on,else it ends here
a15:18,h4 ,14,h4 ,1 ,h4 ,12,h4 ,h5,13<12+h2+6 ; external
g7 :1 ,i90,12 ,h4 ,19,h4 ,5 ,h4 ,h5,12<12+h0+1 ; false
a56:9 ,i61,5 ,h4 ,12,h4 ,4 ,h4 ,h5,12<12+h2+15 ; field
a16:15,h4 ,18,h4 ,h5,12<12+h2+7 ; for
g8 :15,h4 ,20,h4 ,15,h4 ,h5,12<12+h2+4 ; goto
g9 :29,h4 ; haa,paa,xaa,yaa
g10:6 ,i62,h5,12<12+h2+8 ; if
a17:14,h4 ,20,h4 ,5 ,h4 ,7 ,h4 ,5 ,h4 ,18,h4 ,h5,12<12+h2+10; integer
g11:1 ,i91,2 ,h4 ,5 ,h4 ,12,h4 ,h5,12<12+h2+20 ; label
a57:15,h4 ,14,h4,7 ,h4 ,h5 ,12<12+h2+11 ; long
g12:5 ,i63,19,h4 ,19,h4 ,1 ,h4 ,7 ,h4 ,5 ,h4 ,h5,11<12+2 ; message
a18:15,h4 ,4 ,h4 ,h5,12<12+h0+16 ; mod
g32:15,h4,20,h4,h5,12<12+h2+26 ; not
g13:6 ,i64,h5,12<12+h2+37 ; of
a19:23,i65,14,h4 ,h5,12<12+h2+9 ; own
a20:18,h4 ,h5,12<12+h0+13 ; or
g14:18,h4 ,15,h4 ,3 ,h4 ,5 ,h4 ,4 ,h4 ,21,h4 ,18,h4 ,5 ,h4 ,h5,12<12+h2+16
; procedure
g15:5 ,i66,1 ,i107,12,h4 ,h5,12<12+h2+12 ; real
a85: 16,h4,5,h4,1,h4,20,h4,h5,12<12+h16 ; repeat
a21:15,h4 ,21,h4 ,14,h4 ,4 ,h4 ,h5,12<12+h2+38 ; round
g16:8 ,i67,9 ,h4 ,6 ,h4 ,20,h4 ,h5,12<12+h0+17 ; shift
a22:20,i68,5 ,i69,16,h4 ,h5,12<12+h2+27 ; step
a23:18,h4 ,9 ,h4 ,14,h4 ,7 ,h4 ,h5,12<12+h2+19 ; string
a24:23,h4 ,9 ,h4 ,20,h4 ,3 ,h4 ,8 ,h4 ,h5,12<12+h2+18 ; switch
g17:8 ,i70,5 ,h4 ,14,h4 ,h5,12<12+h2+32 ; then
a25:18,h4 ,21,h4 ,5 ,h4 ,h5,12<12+h0 ; true
g18:14,h4 ,20,h4 ,9 ,h4 ,12,h4 ,h5,12<12+h2+28 ; until
g19:1 ,h4 ,12,h4 ,21,h4 ,5 ,h4 ,h5,12<12+h2+21 ; value
g20:8 ,h4 ,9 ,h4 ,12,h4 ,5 ,h4 ,h5,12<12+h2+29 ; while
g21:15,h4 ,14,h4 ,5 ,h4 ,h5,12<12+h2+14 ; zone
; relative addresses:
i51=a6 -g21,i52=a7 -g21,i53=a8 -g21,i54=a9 -g21,i55=a10-g21 ; rel addr
i57=a12-g21,i58=a14-g21,i59=a13-g21,i60=a15-g21 ;
i61=a16-g21,i62=a17-g21,i63=a18-g21,i64=a19-g21,i65=a20-g21 ;
i66=a21-g21,i67=a22-g21,i68=a24-g21,i69=a23-g21,i70=a25-g21 ;
i89=a55-g21,i90=a56-g21,i91=a57-g21,i92=a5 -g21 ;
i104=a86-g21,i105=a83-g21,i106=a84-g21,i107=a85-g21 ;
i109=a98-g21 ;
\f
; jz.fgs 1982.11.05 algol 6, pass 1, page ...26...
;table of pointers to reserved words
h. ; letters
g22=k-1, g53 = g22 - 2000 ; (g53 used page 16)
g2 -g21,g3 -g21,g4 -g21,g5 -g21,g6 -g21,g7 -g21; a,b,c,d,e,f
g8 -g21,g9 -g21,g10-g21,0 ,0 ,g11-g21; g,h,i,j,k,l
g12-g21,g32-g21,g13-g21,g14-g21,0 ,g15-g21; m,n,o,p,q,r
g16-g21,g17-g21,g18-g21,g19-g21,g20-g21,g9 -g21; s,t,u,v,w,x
g9 -g21,g21-g21 ; y,z
;compound table
w. ; first compounds
g23:h0+2 ,h4,5<12+h0+4 ; * **
g46=g23-g15
g24:h0+3 ,h4,5<12+h0+5 ; / //
g25:h2+30,h4,5<12+h2+26 ; - -,
g26:h2+25,-1,5<12+h2+41 ; :infat :(
g27:h0+8 ,h4,5<12+h2+31 ; : :=
g28:h2+3 ,-1,h.6,g34-d1,w.h0+6,-1,h.6,g35-d1; < <: ,<<
w. h0+2 ,-1,h.6,g44-d1 ; <*
w. h0+10,-1,5<12+h0+11,h0+8 ,h4,5<12+h0+7 ; <> ,<=
g29:h0+8 ,-1,5<12+h0+14,h0+10,h4,5<12+h0+15 ; = == ,=>
g30:h0+8 ,h4,5<12+h0+9 ; > >=
;table of pointers to compounds
h.
g31=k-h0-2 ; firsts
g23-g23,g24-g23,g25-g23,g27-g23,g28-g23 ; * , / , - , : ,<
g26-g23,g29-g23,0 ,g30-g23 ; (:, = , no, >
g48=g31-1000
\f
;fgs 1986.03.10 algol 6, pass 1, page ...27...
w.
d33: al w0 x2+d25-c20; init pass1:
rs w0 x2+f32-c20; no match res:=return from no match res;
al w0 g38-d1 ;
hs w0 x2+j1 -c20; state:=in prelude;
am (x2+e23-c20;
al w0 e28-2 ; get abs addr input block current input;
rs w0 x2+f40-c20;
rl w0 x2+e23-c20; get abs addr fp base;
rs w0 x2+f43-c20;
al w0 x2+e13-c20;
rs w0 x2+f46-c20; get abs addr writetext;
am (x2+e23-c20;
al w1 e22 ;
rs w1 x2+f0 -c20; get abs addr current input descr;
dl w0 x1+e49+4 ; save name from
ds w0 x1+e51+6 ; curr in process descr
dl w0 x1+e49+8 ; in
ds w0 x1+e51+10 ; curr in record descr;
rl w0 x1+e50+2 ;
rs w0 x2+f47-c20; save giveup action;
rl w3 x2+e46-c20;
rs w3 x2+f44-c20; sourcepointer:=start source list;
rl w3 x3 ;
al w0 x1+e51+4 ; save addr of
rs. w0 b40. ; name;
bz w0 x2+e17-c20+1; fileno, modebits :=
rs w0 x1+e51+12 ; 0, modebits (12.23);
al w1 10 ; bossline
sn w3 0 ; if source list empty then
jl x2+d42-c20; goto medium connected;
am (x2+e23-c20;
jl w3 e44-4 ; stack current input;
jl. d44. ; goto connect source;
;assignment of intermediate action addresses:
i0 =c0 -d1-2, i1 =c1 -d1-2, i2 =c2 -d1-2, i3 =c3 -d1-2, i4 =c4 -d1-2
i5 =c5 -d1-2, i6 =c6 -d1-2, i7 =c7 -d1-2, i8 =c8 -d1-2, i9 =c9 -d1-2
i10=c10-d1-2, i11=c11-d1-2, i12=c12-d1-2, i13=c13-d1-2, i14=c14-d1-2
i15=c15-d1-2, i16=c16-d1-2, i17=c17-d1-2, i18=c18-d1-2, i19=c19-d1-2
i20=c20-d1-2, i21=c21-d1-2, i22=c22-d1-2, i23=c23-d1-2, i24=c24-d1-2
i25=c25-d1-2, i26=c26-d1-2, i27=c27-d1-2, i28=c28-d1-2, i29=c29-d1-2
i30=c30-d1-2, i31=c31-d1-2, i32=c32-d1-2, i33=c33-d1-2, i34=c34-d1-2
i35=c35-d1-2, i36=c36-d1-2, i37=c37-d1-2, i38=c38-d1-2
i40=c40-d1-2, i41=c41-d1-2, i42=c42-d1-2, i43=c43-d1-2, i44=c44-d1-2
i45=c45-d1-2, i46=c46-d1-2, i47=c47-d1-2, i48=c48-d1-2, i49=c49-d1-2,
i50=c50-d1-2, i56=c56-d1-2, i98=c58-d1-2, i99=c59-d1-2
;assignment of other intermediates:
i71=g36-d1, i72=g34-d1, i73=g35-d1; values of state altering simples
i74=1 , i75=3, i76=2 ; values of state altering reserveds
i77=g21+2 , i78=g21+3 ; bases for class and value of reserveds
i79=c0 -j3, i80=c4 -j3, i81=c11-j3; rel addr of futher nl actions
i84=d33-c20-1000,i87=d43-c0,i88=d48-c0,i39=c39-c0 ; rel addr of initialise pass 1
\f
; jz 1979.08.09 algol 8, pass 1, page ...28...
d31: rs. w3 b22. ; printname:
rl. w1 b40. ;
jl. w3 d41. ;
rl. w1 b40. ;
bz w1 x1+8 ; w1:=fileno
sn w1 0 ; if fileno<>0 then
jl. (b22.) ;
jl. w3 d49. ; writechar(point);
al w0 x1 ;
jl. w3 d40. ; writeinteger(fileno)
1 ;
jl. (b22.) ;
b22: 0 ;
b34: 0
d40: am -2047 ; outinteger
jl. c65.+2047;
d41: am -2047 ; outtext
jl. c64.+2047;
d65: am 58-10 ; outcolon;
d46: am 10-46 ; outnl
d49: am 46-32 ; outpoint
d50: al w0 32 ; outsp
am -2047 ;
jl. c63.+2047;
d34: am -2047 ;
am. (f43.+2047;
al w1 e55 ; print date and clock
rs. w3 b22. ;
rl. w3 b40. ;
jd 1<11+42 ; lookup tail
jl. w3 d50. ; outsp;
rl w0 x1+10 ; w0:=shortclock;
sn w0 0 ;
jl. (b22.) ; if 0 then return;
jl. w3 d64. ; convclock;
jl. w2 d63. ; print convclock;
jl. (b22.) ; return;
\f
; rc 1977.10.02 algol6, pass 1, page ...29...
; parameters after the delimeter algol
; auxstate:
; 0=neutral, 1=inerror, 2=afterpoint, 3=intext, 4=innumber
c51: ; digit:
g47=c51-1000
sn w1 0 ; if auxstate=neutral then
jl. c57. ; goto paramerror;
sn w1 1 ; if auxstate=inerror then
jl. a70. ; goto nextchar;
sn w1 3 ; if auxstate=intext then
jl. a63. ; goto packtext;
rl. w2 b45. ;
sn w1 2 ; if auxstate=afterpoint
sl. w2 b47. ; and option<copy then
se w1 x1 ; goto
jl. c57. ; paramerror;
al w1 4 ; auxstate:=innumber;
bz. w3 b43. ;
wm. w3 b39. ; integer:=integer*10
wa w3 0 ; + value;
al w3 x3-h1 ;
hs. w3 b43. ;
jl. a70. ; goto next char;
c52: ; letter:
sn w1 4 ; if auxstate=innumber
jl. c57. ; then goto paramerror;
sn w1 1 ; if auxstate=inerror
jl. a70. ; then goto nextchar;
rl. w2 b45. ;
sn w1 2 ; if auxstate=afterpoint then
al w1 0 ; auxstate:=neutral;
sn w1 0 ; if auxstate=neutral
sh. w2 b47. ; and option>copy then
se w1 x1 ; goto paramerror;
jl. c57. ;
al. w3 b41. ; if auxstate<>intext then
se w1 3 ; init text addr;
rs. w3 b40. ;
al w1 3 ; auxstate:=intext;
a63: ; packtext:
rl. w3 (b40.) ; string:= string
ls w3 8 ; shift 8
am -2000 ;
wa. w3 f4.+2000; add char;
rs. w3 (b40.) ;
sh. w3 b48. ; if not full then
jl. a70. ; goto next char;
rl. w3 b40. ;
al w3 x3+2 ; increase textaddr.
rs. w3 b40. ;
se. w3 b43. ; if not toolong then
jl. a70. ; goto next char
jl. c57. ; else goto paramerror;
\f
; jz.fgs 1982.08.18 algol 8, pass 1, page ...30...
c53: ; simple:
se w0 h2+22 ; if -,semicolon then
jl. a68. ; goto maybe point;
sl w1 3 ; if auxstate=intext or
jl. a71. ; innumber then goto termination;
se w1 0 ; if auxstate<>neutral then
jl. a76. ; goto paramalarm;
a64: ; finis:
al w0 h2+22 ; w0:=value char;
al w1 -2000 ;
rs. w0 x1+f13.+2000; lastbyte:=semicolon;
rl. w0 x1+f10.+2000;
rs. w0 x1+j0.+2000; mode:=mode1;
al w0 0 ;
am -2000
rs. w0 b12.+2000; inalgol:=false;
al w0 g41-d1 ; state:=neutral;
hs. w0 x1+j1.+2000;
rl. w1 b41. ; if no name then
sn w1 0 ; goto
jl. a66. ; maybe number;
al. w3 b41. ; copynameaddr
a65: rs. w3 b40. ; copysource: save name addr.
jl. w1 d54. ; reestablish current input;
am -2000
al. w2 c40.+2000;
am -2000 ;
am (x2+e23-c40+2000);
jl w3 e44-4 ; stack cur in;
bz. w1 b44. ;
al w1 x1+1 ; stackniveau:=
hs. w1 b44. ; stackniveau+1;
rl. w3 b40. ; restore name addr;
jl. a48. ; goto connect;
a66: bz. w3 b43. ; maybe number:
sn w3 0 ; if not number then
jl. a67. ; goto mode;
al w3 x3-1 ;
am -2000 ;
al. w1 c0.+2000 ; if number>maxparam then
am -2000
rl w1 x1+e83-c0+2000 ;
sl w3 x1 ; goto sourcealarm;
jl. a78. ;
wm. w3 b39. ; w3:=addr of name
am -2000 ; in call;
al. w2 c0.+2000 ;
am -2047 ;
wa w3 x2+e47-c0+2047;
jl. a65. ; goto copysource;
a67: bz. w0 b42. ; mode: w0:=mode;
jl. w1 d45. ; set modes;
al w1 0 ; auxstate:=0;
jl. a70. ; goto next char;
\f
;rc 1975.01.15 algol 6, pass 1, page 31
a68: sn w0 h2 ; maybe point: if not point
sh w1 2 ; or auxstate<>intext or innumber
jl. c57. ; then goto paramerror;
rl. w2 b45. ;
se w2 0 ;
sn. w2 b47. ; if option=mode then
se w2 x2 ; goto paramerror;
jl. c57. ;
sn w1 3 ; if not number then
jl. w3 a75. ; shift string+
sn. w2 b47. ; if option=copy then
al w2 x2+1 ; option:=option+1;
rs. w2 b45. ;
se w2 0 ; if option<>0 then
jl. a80. ; goto next char;
al. w2 b41. ; w2:=addr input text
al. w1 b46. ; w1:=addr option
a69: sl. w1 b47. ; if not found then
jl. c57. ; goto paramerror;
al w1 x1+10 ; count
dl w0 x1+2 ; w3w0:=option
se w3 (x2) ; if not
jl. a69. ; found
se w0 (x2+2) ; then
jl. a69. ; goto
dl w0 x1+6 ; next option;
se w3 (x2+4) ;
jl. a69. ;
se w0 (x2+6) ;
jl. a69. ;
rs. w1 b45. ; save option;
al w0 0 ;
al w1 0 ;
ds w1 x2+2 ; clear text
ds w1 x2+6 ;
a80: al w1 2 ; auxstate:=after point;
a70: hs. w1 b51. ; next char:
am -2000 ; save auxstate;
jl. c0.+2000 ; goto next char;
c54: se w1 0 ; nl ff sp: if auxstate=0 then
jl. a71. ; begin
sn w0 h3+5 ; if char=sp then goto
jl. a70. ; next char else
am -2000 ;
jl. c5.+2000; goto next nlaction;
\f
; jz 1979.09.04 algol 8, pass 1, page 32
a71: ; termination:
sn w1 3 ; if auxstate=instring then
jl. w3 a75. ; shift string;
al w3 -2000 ;
bz. w3 x3+j1.+2000; w3:=state;
rl. w2 b45. ;
sn w2 0 ; if option=0 and
sn w3 g44-d1 ; state<>incommentstring
se w2 x2 ; then
jl. a76. ; paramalarm;
sh. w2 b54. ; if option>=copy then
jl. a72. ; begin
bz. w3 b43. ;
sn w1 4 ; if auxstate=innumber
se w3 0 ; and number=0 then
se w1 x1 ; goto paramalarm;
jl. a76. ;
al w2 x2+1 ; option:=option+1;
rs. w2 b45. ; goto testreturn;
jl. a79. ; end;
a72: al. w2 b41. ;
rl w3 x2+2 ; if secondword<>0
se w3 0 ; goto paramalarm;
jl. a76. ;
rl w3 x2 ;
se. w3 (b49.) ; if param<>on
sn. w3 (b50.) ; and param<>off
se w3 x3 ; then
jl. a76. ; goto paramalarm;
am -2047 ;
al. w1 c40.+2047 ;
am -2047 ;
rl w0 x1+e56-c40+2047;
al w1 0 ; text := 0;
rs. w1 b41. ; w1 := option;
rx. w1 b45. ; option := 0;
so w0 (x1+8) ; if modechange not allowed
jl. a79. ; then goto testreturn;
sn. w3 (b49.) ; if param=on
jl. a74. ; then goto on;
ac w0 (x1+8) ; modebits:=modebits
bs. w0 1 ; and -,optionbit;
la. w0 b42. ;
a73: hs. w0 b42. ;
a79: al w1 0 ; auxstate:=neutral;
a77: am -2000 ; testreturn:
rl. w0 f4.+2000 ; w0:=char;
se w0 59 ; if char=semicolon then
jl. a70. ; goto finis else
jl. a64. ; goto next char;
a74: bz. w0 b42. ; on:
lo w0 x1+8 ; modebits:=modebits or
jl. a73. ; optionbit;
a75: ; shift string:
rl. w1 (b40.) ;
ls w1 8 ;
sh. w1 (b48.) ;
ls w1 8 ;
rs. w1 (b40.) ;
jl x3 ; return;
\f
; rc jz.fgs.1981.03.02 algol 6, pass 1, page ...33...
c55: al w1 -2000 ; unstack:
rl. w2 x1+f43.+2000;
rl. w1 x1+f0.+2000;
jl w3 x2+e67 ; terminate zone;
jl w3 x2+e45-4 ; unstack cur in;
bz. w3 b44. ;
al w3 x3-1 ; stackniveau:=
hs. w3 b44. ; stackniveau-1;
bz w0 x1+e51+13 ; w0:=modebits;
al w3 x1+e51+4 ; name addr
rs. w3 b40. ;
rl w1 x1+e50+6 ; w1:=bossline;
jl. d42. ; goto medium connected;
a78: ; source alarm:
a76: al w0 h3+1 ;
jl. w3 c66. ; outbyte (error);
al w0 25 ;
jl. w3 c66. ; outbyte (25); <*directive syntax*>
am -1 ; auxstate:=0;
c57: al w1 1 ; auxstate:=1;
al. w2 b41. ; paramerror:
al w0 0 ;
al w3 0 ;
ds w0 x2+2 ; clear text;
ds w0 x2+6 ;
hs. w0 b43. ; clear integer;
rs. w0 b45. ; clear option;
jl. a77. ; goto testreturn;
c60: se w0 h0+6 ; first of comp:
jl. c57. ; if not less then paramerror;
al w0 g45-d1 ; state:=comm inalgol
am -2000 ;
jl. d0.+2000; goto set state;
c61: se w0 h0+2 ; lessstar:
jl. c62. ; if not star then commerror;
al w0 g44-d1 ; state:=in commentstring
am -2000 ;
jl. c37.+2000; goto state altering res.
c62: al w0 g43-d1 ; commerror:
am -2000 ;
hs. w0 j1.+2000; state:=inalgol;
jl. c57. ; goto paramerror;
\f
; rc 1977.11.02 algol 6, pass 1, page ...34...
b39: 10 ;
b40: 0 ; current source addr (cur.text addr)
b41: 0, r.4 ; copy name (cur.text)
b42=k+1
b43: 0 ; copy integer, modebit
b51=k+1
b44: 0 ; stack niveau, auxstate
g49=b44-1000
b45: 0 ; option
b46=k-10
; <:message:> ,0, 1<1
; <:index:> ,0,0, 1<3
; <:spill:> ,0,0, 1<6
; <:details:> ,0, 1<2
<:list:> ,0,0, 1<0
b47: <:copy:> ,0,0, 0
b48: 1<16
b49: <:on:> ;
b50: <:off:> ;
b52: <:***param<10><0>:>;
b53: <:***greater than in call<10><0>:>
b54=b47-1
i93=b51-c51, i94=a71-c51, i95=b41-c51, i96=b42-b41
i97=b53-b52, i101=a76-c51, i102=b45-b41, i100=b51-b41
i103=b40-c51
d63:
; print convclock
b. a3, w.
rs. w2 a0. ; save return
rs. w0 a1. ; save date
rs. w3 a2. ; save clock
al w0 100 ;
jl. w3 d50.+2 ; outchar d
jl. w3 d49. ; outchar .
rl. w0 a1. ;
jl. w3 d40. ; outinteger(date)
48<12+6 ;
jl. w3 d49. ; outchar .
rl. w0 a2. ;
jl. w3 d40. ; outinteger(clock)
48<12+4 ;
jl. (a0.) ; return
a0: 0 ; saved return
a1: 0 ; saved date
a2: 0 ; saved clock
e.
\f
; rc 1978.08.21 algol 7, pass 1, page ...35...
d64:
; procedure convert clock (short clock)
;
; this procedure is an inversion of the following algorithm
; for computing day-number from a date (year,month,date)
; extended with a conversion of the time of the day:
;
; if month<3 then
; begin
; month:=month+12;
; year:=year-1;
; end;
; dayno:=(1461*year)//4 + (153*month+3)//5 + day;
;
; call: return:
;
; w0 short clock year*10000+month*100+date
; w1 irrelevant destroyed
; w2 irrelevant destroyed
; w3 return hour*100+minute
;
;
b. a13, b0 w.
ld w2 -100 ; clear w1,w2
rs. w3 a8. ; save return address
al w3 0 ; clear w3
ld w0 10 ; w3,w0:=short clock<10 (=truncated clock>9)
wd. w0 a2. ; w0:=dayno
al w3 x3+a13 ; add minute rounding
wd. w3 a1. ; w3:=hour
wd. w2 a0. ; w2:=minute
ds. w3 a10. ; save minute,hour
al w3 0 ; clear w3
ld w2 -100 ; clear w1,w2
ls w0 2 ; w0:=dayno*4
wa. w0 a5. ; add offset
wd. w0 a4. ; w0:=year
ls w3 -2 ; w3 is converted
wm. w3 a6. ; to fifthdays
al w3 x3+a11 ; w3:=w3+three months offset
wd. w3 a3. ; w3:=month
sh w3 12 ; if month>12 then
jl. b0. ; begin
ba. w0 1 ; increase year
al w3 x3-12 ; decrease month
b0: al w2 x2+a12 ; end
wd. w2 a6. ; w2:=date
rs w3 2 ; save month (in w1)
wm. w0 a7. ; w0:=year*100
wa w0 2 ; + month
wm. w0 a7. ; * 100
wa w0 4 ; + date
rl. w3 a10. ; w3:=hour
wm. w3 a7. ; * 100
wa. w3 a9. ; + minute
jl. (a8.) ; return
\f
; rc 1978.08.21 algol 7, pass 1, page ...36...
a0: 1172 ; units per minute
a1: 70313 ; units per hour
a2: 1687500 ; units per day
a3: 153 ; days in the five months (march-july)
a4: 1461 ; days in four years
a5: 99111 ; offset for computing year
a6: 5 ;
a7: 100 ; constant for packing date and time
a8: 0 ; saved return address
a9: 0 ; saved minute
a10: 0 ; saved hour
a11=461 ; three months offset
a12=5 ; one days offset
a13=586 ; half a minute
e.
i83=k-i82 ; size of pass 1
e30=e30+i83
i. ; idlist
e.
m. jz 1986.03.14 algol 8, pass 1
\f
e.; pass0
▶EOF◀