begin comment The enclosing begin/end block and this initial section of variables and procedures have been added by me (GT) to allow the source to compile. Clearly there is code missing from the listing in the pdf file at https://ir.cwi.nl/pub/9085/9085D.pdf ; integer t6, t8, t12, t16, t18, accent symbol, colon symbol, open symbol, smaller symbol, nlcr symbol, semicolon symbol, close symbol, greater symbol, comma symbol, pr tape symbol, space symbol, point symbol, apostrophe symbol, tab symbol; integer block number, line number, line counter, symbol; boolean first scan, second scan; integer procedure stringsymbol(k, text); value k; integer k; string text; begin stringsymbol ≔ 0; end; procedure stow into buffer(char); value char; integer char; begin end; integer procedure RESYM1; begin RESYM1 ≔ 0; end; procedure runout; begin end; procedure NS; begin end; procedure prsym(s); value s; integer s; begin end; procedure ERROR(cond, errnum); value cond, errnum; boolean cond; integer errnum; begin end; procedure initialize symbols etc; begin comment These will be system-dependent from the character set used by the X8; accent symbol ≔ 1; colon symbol ≔ 2; open symbol ≔ 3; smaller symbol ≔ 4; nlcr symbol ≔ 5; semicolon symbol ≔ 6; close symbol ≔ 7; greater symbol ≔ 8; comma symbol ≔ 9; pr tape symbol ≔ 11; space symbol ≔ 12; point symbol ≔ 13; apostrophe symbol ≔ 14; tab symbol ≔ 15; symbol ≔ 0; line number ≔ 1; block number ≔ 1; line counter ≔ 0; first scan ≔ true; second scan ≔ true; comment Powers of 2 perhaps? Probably X8 perms since algol 60 doesn't have bit shifts. ; t6 ≔ 64; t8 ≔ 256; t12 ≔ 4096; t16 ≔ 65536; t18 ≔ 262144; end; comment watch out for variable 'l' (lower case L) and digit '1' (ONE) being confused. ; comment From here onwards is the original code, except for two statements where the original code had '=' instead of ':=' (which I've marked with comments containing 'GT:') ; integer max of namestack, max of defstack, max of actualstack, max of pointerstack, max of savestack, stackptr, freeptr, pointerptr, saveptr, spacecntr, lcntr, bcntr, llcntr, bbcntr, SPACEcntr, LLcntr, BBcntr, t8j, t8J, word, Word, nextacc, endmarker, place of name, tt, asterisk, ksiretsa; boolean in def mode, in actual mode, only mac, from macro, from actualstack, accent read; integer array namestack[-2:255],definitionstack[0:4095], actualstack [0:2047], pointerstack[1:128], savestack[-1:120]; procedure initialize macro variables; begin in def mode ≔ in actual mode ≔ only mac ≔ from macro ≔ from actualstack ≔ accent read ≔ false; max of namestack ≔ 255; max of defstack ≔ 4095; max of actualstack ≔ 2047; max of pointerstack ≔ 128; max of savestack ≔ 120; asterisk ≔ 254; ksiretsa ≔ 255; stackptr ≔ namestack[0] ≔ pointerstack[1] ≔ 0; endmarker ≔ spacecntr ≔ SPACEcntr ≔ 150; namestack[-1] ≔ saveptr ≔ -5; tt ≔ 1 + t6 + t12 + t18; freeptr ≔ 1 end initialize macro variables; procedure define macro; begin integer i,savel,max of formallist; boolean empty; integer array formallist[0:127]; procedure read name; begin integer save; ERROR(stackptr > max of namestack,3000); lcntr ≔ savel ≔ namestack[stackptr]; ERROR(lcntr = -1,3027); bcntr ≔ 2; save ≔ stackptr ≔ stackptr + 1; store letgits(namestack,stackptr,max of namestack,reaffer); ERROR(stackptr + 1 > max of namestack,3000); namestack[stackptr] ≔ stackptr - save; namestack[stackptr + 1] ≔ blocknumber; stackptr ≔ stackptr + 2 end read name; procedure read formals; begin integer i,ptr,aux,par; boolean in comma mode; integer procedure reaffer1; if symbol= accent symbol then begin ERROR(true,3023); goto outaccent end else reaffer1 ≔ reaffer; procedure reaffer1 while(condition); boolean condition; begin integer i; for i ≔ i while condition do reaffer1 end reaffer1 while; ptr ≔ 1; par ≔ 0; if symbol ≠ colon symbol ∧ symbol ≠ open symbol ∧ symbol ≠ smaller symbol then begin ERROR(true,3026); reaffer1 while(symbol ≠ colon symbol ∧ symbol ≠ open symbol ∧ symbol ≠ smaller symbol) end; if symbol ≠ colon symbol then begin i ≔ aux ≔ 0; in comma mode ≔ symbol = open symbol; for i ≔ i + 1 while symbol ≠ colon symbol do begin par ≔ i; reaffer1; comment GT: Original was par=i ; if in comma mode ∧ i > 1 then reaffer1 while (symbol= nlcr symbol ∨ symbol = semicolon symbol); if 10 < symbol ∧ symbol ⩽ 62 then begin if i = 23 then begin ERROR(true,3002); reaffer1 while (symbol ≠ colon symbol) end else begin store letgits(formallist,ptr,max of formallist, reaffer); if ptr - aux> 22 then begin ERROR(true,3011); ptr ≔ aux+ 22 end; formallist[aux] ≔ ptr - aux - 1; aux ≔ ptr; ptr ≔ ptr + 1; if symbol = accent symbol then begin ERROR(true,3023); goto outaccent end; if in comma mode then begin if symbol = close symbol then begin if reaffer1 ≠ colon symbol then begin ERROR(true,3004); reaffer1 while (symbol ≠ colon symbol) end end else if symbol ≠ comma symbol then begin ERROR(true,3005); reaffer1 while(symbol ≠ comma symbol ∧ symbol ≠ colon symbol) end end else begin if symbol ≠ greater symbol then begin ERROR(true,3006); reaffer1 while(symbol ≠ smaller symbol ∧ symbol ≠ colon symbol) end else begin if reaffer1 ≠ colon symbol then begin reaffer1 while(symbol = nlcr symbol ∨ symbol = semicolon symbol); ERROR(symbol = colon symbol,3007) end; if symbol ≠ smaller symbol ∧ symbol ≠ colon symbol then begin ERROR(true,3007); reaffer1 while(symbol ≠ smaller symbol ∧ symbol ≠ colon symbol) end end end end end else begin ERROR(true,3008); reaffer1 while(symbol ≠ comma symbol ∧ symbol ≠ smaller symbol ∧ symbol ≠ colon symbol) end end end if symbol; if ptr - 1 < max of formallist then formallist[ptr - 1] ≔ 0 else ERROR(true, 3009); reaffer; ERROR(symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol,3024); read while(symbol = nlcr symbol ∨ symbol = semicolon symbol); outaccent: definitionstack[lcntr] ≔ -par - 1 end read formals; procedure read block; begin integer i, begcntr; boolean declarations,within accents; procedure compare parameters; begin integer i, j, l, ptr, length; boolean found; integer array parameter[0:20]; ptr ≔ l ≔ 0; j ≔ 127; found ≔ false; reaffer; store letgits(parameter,1,20,reaffer); if l ≠ 22 ∧ symbol = greater symbol then for length ≔ formallist[ptr] while length ≠ 0 ∧ ¬ found do begin j ≔ j + 1; if length = l then begin i ≔ 0; for i ≔ i + 1 while parameter[i - 1] = formallist[ptr + i] ∧ ¬ found do if i = 1 then begin for l ≔ 1, l while l ≠ smaller symbol do delete symbol(l); i ≔ i - 1; stow into stack(definitionstack, max of defstack,j); found ≔ true end end; ptr ≔ ptr + length+ 1 end end compare parameters; procedure delete symbol(s); integer s; begin integer word; if bcntr = 0 then begin s ≔ definitionstack[lcntr]; lcntr ≔ lcntr - 1; bcntr ≔ 2 end else begin word ≔ definitionstack[lcntr]; if word < 0 then empty ≔ true else begin definitionstack[lcntr] ≔ word ÷ t8; s ≔ word - definitionstack[lcntr] × t8; bcntr ≔ bcntr - 1 end end end delete symbol; in def mode ≔ true; stow into stack(definitionstack,max of defstack,symbol); if ¬ compare(“begin”) then begin ERROR(true,3010); skip until(“begin”) end; begcntr ≔ 1; declarations ≔ symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol; if ¬ declarations then begin lcntr ≔ savel; bcntr ≔ 2; in def mode ≔ false; reaffer; stow into stack(definitionstack,max of defstack, symbol); in def mode ≔ true end; within accents ≔ false; for i ≔ i while begcntr > 0 do begin read while(symbol ≠ accent symbol ∧ symbol ≠ smaller symbol); if symbol = smaller symbol then compare parameters; if symbol = accent symbol then begin within accents ≔ ¬ within accents; reaffer; if within accents then begin if compare(“end”) then begin if symbol = accent symbol then begin begcntr ≔ begcntr - 1; if begcntr = 0 ∧ ¬ declarations then begin delete symbol(i); for i ≔ 1 while i ≠ nlcr symbol ∧ i ≠ semicolon symbol ∧ ¬ empty do delete symbol(i); empty ≔ false end end end else if compare(“begin”) then begin if symbol = accent symbol then begcntr ≔ begcntr + 1 end end end end; in def mode ≔ false; reaffer; stow into stack(definitionstack,max of defstack,endmarker); if stackptr < max of namestack then namestack[stackptr] ≔ if lcntr + 1 > max of defstack then -1 else lcntr + 1 end read block; max of formallist ≔ 127; empty ≔ false; for i ≔ i while ¬ empty do begin read name; read formals; read block; read while(0 ⩽ symbol ∧ symbol ⩽ 62); if symbol = comma symbol then begin reaffer; read while(symbol = nlcr symbol ∨ symbol = semicolon symbol); ERROR(symbol < 10 ∨ symbol > 62,3030) end else empty ≔ true end; pr tape symbol ≔ space symbol end define macro; procedure expand macro; begin integer p,par; procedure read actuals; begin integer i,opcntr,quotcntr,savel,auxptr; procedure complete actual parameter; begin if bcntr = 0 then begin lcntr ≔ lcntr - 1; bcntr ≔ 2 end else begin actualstack[lcntr] ≔ actualstack[lcntr] ÷ t8; bcntr ≔ bcntr - 1 end; stow into stack(actualstack,max of actualstack, endmarker); freeptr ≔ freeptr + 1; if freeptr < max of pointerstack then begin savel ≔ lcntr; pointerstack[freeptr] ≔ lcntr + 1 end end complete actual parameter; auxptr ≔ freeptr; if symbol = open symbol then begin in actual mode ≔ true; opcntr ≔ 1; for i ≔ i while opcntr > 0 do begin ERROR(freeptr > max of pointerstack,3013); if freeptr = auxptr then begin savel ≔ lcntr ≔ pointerstack[freeptr] - 1; bcntr ≔ 2 end; reaffer; if symbol = open symbol then opcntr ≔ opcntr + 1 else if symbol = close symbol then opcntr ≔ opcntr - 1; read while(symbol = nlcr symbol ∨ symbol = semicolon symbol); lcntr ≔ savel; bcntr ≔ 2; stow into stack(actualstack,max of actualstack, symbol); for i ≔ i while (symbol ≠ comma symbol ∨ opcntr ≠ 1) ∧ opcntr ≠ 0 do begin reaffer; if symbol = open symbol then opcntr ≔ opcntr + 1 else if symbol = close symbol then opcntr ≔ opcntr - 1 end; complete actual parameter end; reaffer; in actual mode ≔ false end else if symbol = smaller symbol then begin in actual mode ≔ true; for i ≔ i while symbol = smaller symbol do begin ERROR(freeptr > max of pointerstack,3013); quotcntr ≔ 1; if freeptr = auxptr then lcntr ≔ pointerstack[freeptr] - 1 else lcntr ≔ savel; bcntr ≔ 2; for i ≔ i while quotcntr > 0 do begin reaffer; if symbol = smaller symbol then quotcntr ≔ quotcntr + 1 else if symbol = greater symbol then quotcntr ≔ quotcntr - 1 end; complete actual parameter; reaffer; if symbol ≠ point symbol then begin read while(symbol = nlcr symbol ∨ symbol = semicolon symbol); ERROR(symbol = point symbol,3025) end end; if symbol = point symbol then reaffer else ERROR(true,3025); in actual mode ≔ false end; pointerptr ≔ auxptr; if freeptr - auxptr ≠ par then begin ERROR(true,3016); auxptr ≔ auxptr + par - 1; for i ≔ freeptr step 1 until auxptr do pointerstack[i] ≔ -1; freeptr ≔ auxptr + 1 end; if symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol then begin ERROR(true,3001); read while(symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol) end end read actuals; procedure store expansion; begin savestack[saveptr] ≔ bbcntr; savestack[saveptr + 1] ≔ llcntr; if from actualstack then begin savestack[saveptr + 2] ≔ BBcntr; savestack[saveptr + 3] ≔ LLcntr; from actualstack ≔ false end else savestack[saveptr + 2] ≔ -1 end store expansion; ERROR(saveptr + 5 > max of actualstack,3017); p ≔ namestack[place of name - namestack[place of name] - 1]; par ≔ -definitionstack[p] - 1; read actuals; namestack[place of name+ 1] ≔ -namestack[place of name + 1]; savestack[saveptr + 4] ≔ place of name; savestack[saveptr + 5] ≔ symbol; if from macro then store expansion else begin from macro ≔ true; stow into buffer(asterisk) end; saveptr ≔ saveptr + 6; bbcntr ≔ 1; llcntr ≔ p; pr tape symbol ≔ space symbol; symbol ≔ macro sym; stow into buffer(symbol) end expand macro; integer procedure macro sym; begin integer i,s; procedure restore expansion; begin bbcntr ≔ savestack[saveptr]; llcntr ≔ savestack[saveptr + 1]; if bbcntr = 2 then begin t8j ≔ 1; word ≔ definitionstack[llcntr]; word ≔ word - word ÷ t8 × t8 end else if bbcntr = 3 then begin t8j ≔ t8; word ≔ definitionstack[llcntr]; word ≔ word - word ÷ t16 × t16 end; if savestack[saveptr + 2] ≠ -1 then begin BBcntr ≔ savestack[saveptr + 2]; LLcntr ≔ savestack[saveptr + 3]; if BBcntr = 2 then begin t8J ≔ 1; Word ≔ actualstack[LLcntr]; Word ≔ Word - Word ÷ t8 × t8 end else if BBcntr = 3 then begin t8J ≔ t8; Word ≔ actualstack[LLcntr]; Word ≔ Word - Word ÷ t16 × t16 end; from actualstack ≔ true end; place of name ≔ savestack[saveptr - 2]; pointerptr ≔ pointerptr + definitionstack[namestack [place of name - namestack[place of name] - 1]] + 1 end restore expansion; if spacecntr > 150 then begin spacecntr ≔ spacecntr - 1; s ≔ space symbol end else begin if from actualstack then begin BBcntr ≔ BBcntr - 1; if BBcntr = 0 then begin LLcntr ≔ LLcntr + 1; BBcntr ≔ 3; t8J ≔ t16; Word ≔ actualstack[LLcntr] end; if BBcntr ≠ 1 then begin s ≔ Word ÷ t8J; Word ≔ Word - s × t8J; t8J ≔ t8J / t8 end else s ≔ Word; if s = endmarker then begin from actualstack ≔ false; s ≔ macro sym end end else begin bbcntr ≔ bbcntr - 1; if bbcntr = 0 then begin llcntr ≔ llcntr + 1; bbcntr ≔ 3; t8J ≔ t16; word ≔ definitionstack[llcntr] end; if bbcntr ≠ 1 then begin s ≔ word ÷ t8j; word ≔ word - s × t8j; t8j ≔ t8j / t8 end else s ≔ word; if s ⩾ 128 ∧ s ⩽ 149 then begin from actualstack ≔ true; BBcntr ≔ 1; LLcntr ≔ pointerstack[pointerptr + s - 128] - 1; if LLcntr = -2 then from actualstack ≔ false; s ≔ macro sym end else if s = endmarker then begin saveptr ≔ saveptr - 6; freeptr ≔ pointerptr; namestack[place of name + 1] ≔ -namestack[place of name + 1]; if saveptr = -5 then begin from macro ≔ false; stow into buffer(ksiretsa) end else restore expansion; s ≔ savestack[saveptr + 5]; comment GT: Original was s= ; end end; if s > endmarker then begin spacecntr ≔ s - 1; s ≔ space symbol end end; macro sym ≔ s end macro sym; integer procedure reaffer; begin integer i; integer procedure read and buffer; begin integer s; s ≔ RESYM1; if in actual mode then begin stow into stack(actualstack,max of actualstack,s); prsym(s); if s = nlcr symbol then space(7) end else begin stow into buffer(s); if s= nlcr symbol then line number ≔ line number + 1 end; read and buffer ≔ s end read and buffer; for i ≔ i,i while symbol = space symbol ∨ symbol = tab symbol do begin if accent read then begin symbol ≔ nextacc; accent read ≔ false end else symbol ≔ read and buffer; if symbol = accent symbol then begin nextacc ≔ read and buffer; if nextacc = accent symbol then symbol ≔ apostrophe symbol else accent read ≔ true end; if symbol = apostrophe symbol then for i ≔ i while symbol ≠ semicolon symbol ∧ symbol ≠ nlcr symbol do symbol ≔ read and buffer; if in def mode then stow into stack(definitionstack,max of defstack,symbol) end; reaffer ≔ symbol end reaffer; boolean procedure compare(text); string text; begin integer s,k; k ≔ 0; compare ≔ true; for s ≔ stringsymbol(k, text) while s ≠ 255 do if s ≠ (if 37 ⩽ symbol ∧ symbol ⩽ 62 then symbol - 27 else symbol) then begin compare ≔ false; k ≔ -1 end else begin k ≔ k + 1; if first scan then reaffer else NS end end compare; procedure read while(condition); boolean condition; begin integer i; for i ≔ i while condition do if first scan then reaffer else NS end read while; procedure skip until(text); string text; begin integer i, first symbol; first symbol ≔ stringsymbol(0,text); read while(first symbol ≠ (if 37 ⩽ symbol ∧ symbol ⩽ 62 then symbol - 27 else symbol)); for i ≔ i while ¬ compare(text) do read while(first symbol ≠ (if 37 ⩽ symbol ∧ symbol ⩽ 62 then symbol - 27 else symbol)) end skip until; procedure stow into stack(stack,max,char); value max,char; integer max,char; integer array stack; begin integer i; if char = space symbol ∧ spacecntr < 255 then SPACEcntr ≔ SPACEcntr + 1 else begin bcntr ≔ bcntr + 1; if bcntr = 3 then begin lcntr ≔ lcntr + 1; bcntr ≔ 0; if lcntr > max then ERROR(true,3018) else stack[lcntr] ≔ 0 end; if SPACEcntr > 150 then begin stack[lcntr] ≔ stack[lcntr] × t8 + SPACEcntr; if char= space symbol then SPACEcntr ≔ 151 else begin SPACEcntr ≔ 150; stow into stack(stack,max,char) end end else stack[lcntr] ≔ stack[lcntr] × t8 + char; if char= endmarker then for i ≔ bcntr step 1 until 1 do stow into stack(stack,max,0) end end stow into stack; procedure store letgits(list,pointer,max,letgit); value max; integer pointer,max,letgit; integer array list; begin integer i,j,word; boolean full; word ≔ j ≔ 0; full ≔ false; for i ≔ i while symbol ⩽ 62 ∧ ¬ full do begin if symbol ⩾ 37 then symbol ≔ symbol - 27; j ≔ j + 1; if j = 4 then begin if pointer > max then full ≔ true else list[pointer] ≔ word × t6 + symbol; word ≔ j ≔ 0; pointer ≔ pointer+ 1 end else word ≔ word × t6 + symbol; symbol ≔ letgit end; if j ≠ 0 then begin for j ≔ j + 1 while j < 4 do word ≔ word × t6 + 63; if pointer > max then full ≔ true else list[pointer] ≔ word; pointer ≔ pointer + 1 end; ERROR(full ∧ ¬ in def mode,3019) end store letgits; procedure unstack macros; begin integer i; for i ≔ i while abs(namestack[stackptr - 1]) = blocknumber ∧ stackptr > 0 do stackptr ≔ stackptr - namestack[stackptr - 2] - 3 end unstack macros; procedure skip macro declarations; if second scan then begin integer i, begcntr; for i ≔ i,i while symbol = comma symbol do begin skip until(“begin”); begcntr ≔ 1; for i ≔ i while begcntr > 0 do begin read while(symbol ≠ accent symbol ∧ symbol ≠ apostrophe symbol); if symbol = accent symbol then begin NS; if symbol = accent symbol then symbol ≔ apostrophe symbol else if compare(“end”) then begcntr ≔ begcntr - 1 else if compare(“begin”) then begcntr ≔ begcntr + 1 else begin read while(symbol ≠ accent symbol); NS end end; if symbol = apostrophe symbol then read while(symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol) end; read while(0 ⩽ symbol ∧ symbol ⩽ 62) end end skip macro declarations; procedure print elantext; begin integer i, begcntr; pr tape symbol ≔ space symbol; linecounter ≔ 0; skip until (“begin”); begcntr ≔ 1; for i ≔ i while begcntr > 0 do begin read while(symbol ≠ accent symbol ∧ symbol ≠ apostrophe symbol); if symbol = accent symbol then begin NS; if symbol = accent symbol then symbol ≔ apostrophe symbol else if compare(“end”) then begcntr ≔ begcntr - 1 else if compare(“begin”) then begcntr ≔ begcntr + 1 else begin read while(symbol ≠ accent symbol); NS end end; if symbol = apostrophe symbol then read while(symbol ≠ nlcr symbol ∧ symbol ≠ semicolon symbol) end; runout; runout end print elantext; end.