|
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: 126720 (0x1ef00)
Types: TextFile
Names: »algpass83tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »algpass83tx «
; jz.fgs 1987.05.27 algol 8, pass 8, page ...1...
k=e0
s. a100,b50,c120,f72,g110,h10,j10;
w. h10 ; no. of bytes in pass
h. c99 , 8<1 + 1 ; entry to pass 8, change direction
h8=(:e15 a. 1<8:)-1<8 ; h8=test mode
; usage of names:
; a-names: local references within actions
; b-names: local variables in actions
; c-names: global action entries. used in tables and other actions.
; f-names: global constants and variables. all defined on page 15
; g-names: g0, g1, g2, g60 are bases for tables. other g-names are
; entries to main and continue table. most of them are
; relative to g0.
; h-names: h8 defines test mode versions. h10 is pass length.
; j-names: global variables hidden in actions
\f
; rc 12.2.1971 algol 6, pass 8, page ...2...
; operand table. each entry corresponds to one kind of operand:
; * opand app actions, normal opand and addr. opand
; * * opand store actions, normal opand and addr.opand
; * * * address modifier added to opand rel.
h.
b1: a4. , a22., a8. , a30., aw x3 , 0 ; local zone, global var
b2: a23., a23., c24., a28., aw x2 , 0 ; local var
b7: a23., a23., c24., a28., aw x1 , 0 ; x1 addressing
b4: a6. , a2. , c29., a33., aw.( ), 0 ; external or uv
b5: a3. , a23., a8. , a23., aw x3 , 0 ; global formal zone
b6: a23., a22., c24., a33., aw(x2), 0 ; local indirect
b3: a7. , a25., a9. , a35., aw x3 , 0 ; own var
b8: a1. , a26., a11., a28., aw. , 0 ; literal, b8+4 used as a constant
b15: a37., a23., a9. , a23., aw x3 , 0 ; external zone
w.
c3: bl w0 5 ; read operand: w0:=block:=byte read;
sz w0 1 ; if block even then
jl. a13. ; begin
al w1 b1-b1 ; w1:=global var entry;
sn. w0 (f9.) ; if block=current block then
al w1 b2-b1 ; w1:=local var entry;
sn w0 -4 ; if block=own block then
al w1 b3-b1 ; w1:=own var entry;
jl. a14. ; end else
a13: al w0 x2-1 ; begin block:=block-1; w1:=ext var entry
al w1 b4-b1 ; end;
c30: ; local indirect: w1=x1 addressing entry;
a14: hs. w0 f56. ; read relative: opand block:=opand block,block;
jl. w3 e2. ; w2:=inbyte;
a15: al. w3 x1+b1. ; common opand: w1=var entry, w2=relative.
ba. w3 x1+b1. ; opand appetite action:=
al. w0 x1+1+b1. ; opand table(var entry) abs;
ba. w0 x1+1+b1. ; address opand appetite action:=
ds. w0 f53. ; opand table(var entry+1)abs;
al. w3 x1+2+b1. ;
ba. w3 x1+2+b1. ; opand store action:=
al. w0 x1+3+b1. ; opand table(var entry+2)abs;
ba. w0 x1+3+b1. ; address opand store action:=
ds. w0 f55. ; opand table(var entry+3)abs;
wa. w2 x1+4+b1. ; opand rel
rs. w2 f4. ; :=opand rel+opand table(var entry+4);
jl. c0. ; goto next in;
; x1-addressing: w1=x1 addressing;
c31: al w2 0 ; w2:=relative:=0;
jl. a15. ; goto common opand;
\f
; fgs 1987.05.13 algol 6, pass 8, page ...3...
c32: al w2 12 ; uv: w1=external or uv entry;
wa. w2 f10. ; w2:=relative:=rs entry 12+no.of exts;
jl. a15. ; goto common opand;
; zone addressing: w1=global formal zone entry;
c33: rl. w0 f11. ; w0:=block:=zone block;
sz w0 1 ; if zone block odd then
al w1 b15-b1 ; w1:=external zone entry;
se. w0 (f9.) ; if zone block<>current block then
jl. a14. ; goto read relative;
bz. w0 f52. ; w0:=block:=zone rel;
al w1 b1-b1 ; w1:=global var entry;
jl. a14. ; goto read relative;
c37: ac w2 x1-4 ; literal: w2:=modifier:=literal length;
sn w2 1 ; if literal length=1 then
al w2 2 ; w2:=literal length:=2;
al w1 b8-b1 ; w1:=literal entry;
jl. a15. ; goto common opand;
c38: al w2 4 ; string next: return saved; app:=4;
a21: al w0 4 ; store string first: w2=app;
rs. w0 f4. ; opand rel:=4;
rl. w0 f14. ;
ws. w0 f15. ; w0:=point:=last constant-segm base
wa. w0 f16. ; +1<23+1<12;
jl. w3 c19. ; if test and change(app) then
jl. a18. ; goto string on next segment;
a19: jl. w3 c112. ; store string;
jl. (f2.) ; return;
a18: rl. w2 f14. ; string on next segm:
al w2 x2+2 ; last const:=last const+2;
rs. w2 f14. ;
rs w0 x2 ; segm(last const):=negative;
jl. w3 c114. ; point appetite;
jl. w3 c115. ; point store;
jl. a19. ; store string and return;
c39: al w2 8 ; string first: app:=4+point+rl;
al. w3 a17. ; return:=continue;
rs. w3 f2. ;
jl. a21. ; call store string first;
a17: rl. w0 f14. ;
; the point may not resemble a point pointing to code
ws. w0 f23. ; w0:=point:=last const-point base
ba. w0 1 ; +1;
ws. w0 f15. ; -segment base;
al w1 -2048 ; w0:=point:=
hs w1 0 ; 1<11, point;
jl. w3 c114. ; point appetite;
jl. w3 c115. ; point store;
ws. w1 f7. ; instr:=
hs. w1 f51. ; instr, rel point addr-top instr;
wa. w1 f7. ;
jl. w3 c103. ; set point modifier(rel point addr);
jl. c2. ; goto interprete next;
\f
; rc 12.2.1971 algol 6, pass 8, page ...4...
c40: bz. w0 f52. ; zone base:
ls w0 12 ; w0:=zone rel, zone block;
hl. w0 f61. ;
se. w0 (f58.) ; if zone rel, zone block<>2 bytes read then
jl. w3 c41. ; clear w3;
bl. w0 f59. ;
rs. w0 f11. ; zone block:=first byte read;
bl. w0 f58. ;
hs. w0 f52. ; zone rel:=second byte read;
jl. c0. ; goto next in;
c45: al w2 0 ; beg block: point define:=0. dummy definition,
jl. a66. ; may be program entry. skip.
c46: jl. w3 e2. ; beg proc: point define:=inbyte*2;
ls w2 1 ;
a66: wa. w2 f33. ;
rs. w2 f34. ; point define:=work0:=point define+global base;
jl. w3 c48. ;
hs. w0 f42. ; work2:=block app:=unstack;
ac w2 (0) ;
hs. w2 f43. ; work3:=abs block app:=-block app;
al w2 x2-2 ; copy to:=abs block app-2;
al w1 -2 ; copy from:=-2;
ds. w2 f47. ;
hs. w2 f49. ; work9:=abs block app-2;
rl. w1 f9. ;
hs. w1 f48. ; work8:=current block;
al w1 x1+2 ; current block:=current block+2;
rs. w1 f9. ;
ac w0 x1+6 ;
hs. w0 f44. ; times:=-current block-6;
ba. w1 f43. ;
hs. w1 f46. ; work6:=new displ elem:=
al w2 g3 ; current block+abs block appetite;
sn w0 -2 ; continue:=if times=-2 then
al w2 g4 ; enter block-6 else
jl. c1. ; enter inner block; goto interprete;
c54: jl. w3 e2. ; define label:
ls w2 1 ;
wa. w2 f33. ; point define:=inbyte*2+global base;
rs. w2 f34. ;
c52: rl. w1 f7. ; define global:
al w1 x1+2 ;
ws. w1 f15. ; global(point define):=top instr+2-segment base
wa. w1 f24. ; +current segm;
rs. w1 (f34.) ;
jl. (f2.) ; return;
c48: rl. w1 f35. ; unstack: w3=return.
al w1 x1-2 ; stack top:=stack top-2;
rs. w1 f35. ;
rl w0 x1 ; w0:=unstack:=stack(stack top);
jl x3 ; return;
\f
; rc 1977.11.24 algol 6, pass 8, page ...5...
c49: rl. w2 f0. ; begin copy: w3:=table pointer;
jl. a67. ; skip;
c50: rl. w2 f0. ; end copy:
al w2 x2+8 ; w2:=table pointer+8, ready for dl, ds.
a67: bl. w1 f44. ; w1:=times; called from c75.
sh w1 0 ; table pointer:=w2:=
al w2 x2-4 ; if times<=0 then w2-4-8, end rl, rs else
sh w1 2 ; if times<=2 then
al w2 x2-8 ; w2-8, ready for rl, rs else w2;
al w1 x1-4 ;
hs. w1 f44. ; times:=work4:=times-4;
rs. w2 f0. ;
dl. w2 f46. ;
al w2 x2-4 ; work7:=
al w1 x1-4 ; copy to:=copy to-4;
hs. w2 f47. ; work5:=
hs. w1 f45. ; copy from:=copy from-4;
jl. c2. ; goto interprete next;
c113:bl. w1 f43. ; adjust copy to:
ba. w1 f48. ; work7 := copy to :=
hs. w1 f47. ; abs block + current block;
jl. c2. ; goto interprete next;
c56: bl. w0 f59. ; end block: w0:=block appetite:=byte read;
jl. w3 c57. ; stack(block appetite);
rl. w1 f9. ;
al w1 x1-2 ; current block:=current block-2;
rs. w1 f9. ;
jl. (f2.) ; return;
c70: al w0 x1 ; stack(modif): w0:=modif;
c57: rl. w1 f35. ; stack:
rs w0 x1 ; stack(stack top):=w0;
al w1 x1+2 ;
rs. w1 f35. ; stack top:=stack top+2;
sh. w1 (f36.) ; if stack top<=greatest top then
jl x3 ; return;
rs. w1 f36. ; greatest top:=stack top;
sh. w1 (f33.) ; if stack top<=global base then
jl x3 ; return;
al. w1 e10. ;
jl. e5. ; alarm(<:stack:>);
c58: rl. w1 f9. ; proc value:
al w1 x1-2-e101 ;
hs. w1 f51. ; instr:=instr, current block-2-no of anonym. bytes for blocks;
jl. (f2.) ; return;
c69: jl. w3 c57. ; stack point: stack(dummy);
al w1 x1-2 ; w1:=define:=work0:=old top;
c84: rs. w1 f34. ; store point: define:=w1;
jl. c52. ; goto define global;
c71: rl. w1 f35. ; unstack 3:
al w1 x1-6 ; stack top:=stack top-6;
rs. w1 f35. ;
jl x3 ; return;
\f
; rc 12.2.1971 algol 6, pass 8, page ...6...
h. ; condition table:
b32: 6 , g18 ; 0: app=6, cont g18: skip, am, al
4 , g19 ; 2: app=4, cont g19: skip, jl top-2
4 , g20 ; 4: app=4, cont g20: skip, jl top-6
w.
c62: rl. w0 x1+b32. ; set condition(modifier):
rs. w0 f34. ; work0:=cond app, cond cont:=cond table(modif);
jl. (f2.) ; return;
c64: bl. w2 f34. ; 34: skip direct(instr,modifier):
jl. a72. ; w2:=cond app; skip;
c63: bl. w2 f34. ; 28: skip opand(addr opand+instr):
jl. w3 (f53.) ; w2:=cond app+addr opand app;
a72: ld w2 30 ; w1:=appetite shift 6;
bl. w2 f41. ; w2:=condition continue;
am. (f40.) ;
wa w1 x2+2 ; continuation table(condition continue):=
am. (f40.) ; continuation table(condition continue+2)
rs w1 x2+0 ; +appetite shift 6; adjusts appetite in table.
al w1 6-28+1 ;
rl. w3 f40. ;
am. (f0.) ; continuation table(skip instr):=
wa w1 x3+0 ; table(table pointer)+6-28+1; the skip instruc
rs w1 x3+g21 ; tion will be stored according to the main table.
jl. c1. ; goto interprete;
c66: jl. w3 c48. ; take forlab: unstack; w1:=new stack top;
bl w2 x1-4 ; w0:=forlabel;
bs. w2 f24. ; if segment(repeat jump)<>current segment then
sn w2 0 ;
jl. a76. ; begin
bs w0 x1+1 ; work0:=segment,0:=forlab segment;
rs. w0 f34. ;
rl. w0 f30. ;
hl w0 x1+1 ; work 8:=jl x3+forlab rel;
rs. w0 f48. ;
al w2 g22 ; w2:=cont forlab;
jl. c1. ; goto interprete
a76: bl w0 x1+1 ; end;
bs w0 x1-3 ; w0:=forlab rel-repeat jump rel;
bl w1 x1-3 ;
wa. w1 f15. ; segm(repeat jump rel +segm base)
hs w0 x1+1 ; :=jl. forlab rel-repeat jump rel;
h. al w0 , jl. ;
w. hs w0 x1 ;
jl. c0. ; goto next in;
; stack snapshot when for is processed:
; top-6 enddo label
; top-4 0 for enddo, address of repeat jump for end single do
; top-2 do label
; top forlabel, released by take forlab
; top+2 step label, put in this position and released by step
; stack snapshot when if is processed:
; top-6 2 for int expr, 4 for long expr, 6 for real expr
; top-4 end else label
; top-2 else label, stacked by end else, changed by else
\f
; rc 10.3.1971 algol 6, pass 8, page ...7...
c72: jl. w3 c48. ; step: unstack forlabel;
rx w0 x1-2 ; w0:=step label; stack(stack top-2):=forlabel;
rs w0 x1 ; stack(stack top):=step label;
al w2 g26 ; w2:=cont constant step;
bl. w0 f37. ;
sn w0 0 ; if var step=0 then
jl. c1. ; goto interprete;
hs. w0 f34. ; work0:=var step;
al w0 0 ; var step:=0;
hs. w0 f37. ;
al w2 g27 ; w2:=cont variabel step;
jl. c1. ; goto interprete;
c73: bl. w0 f54. ; test first:
hs. w0 f37. ; var step:=opand rel
al w2 g28 ; w2:=cont test first
jl. c1. ; goto interprete;
c74: wa. w1 f35. ; test top+modifier: used in else and case comma.
bl w1 x1 ; total type := stack(stack top + modifier);
jl. w3 e2. ; type := inbyte;
sl w2 x1 ; if type >= total type
jl. c0. ; then goto next in;
am x1 ; continue := case type+total type-2 of
rl. w2 x2+b42. ; (g51, g52, g53);
jl. c1. ; goto interprete;
b42=k-6, g51,g52,g53 ;
c75: jl. w3 e2. ; take array: w2:=no.of subscr;
ls w2 1 ; work4:=times:=(no.of subscr)*2+2;
al w2 x2+2 ;
hs. w2 f44. ;
hs. w2 f45. ; work5:=copy from:=times;
jl. w3 e2. ; w2:=dope rel;
al w1 x2-4 ;
hs. w1 f46. ; work6:=base word rel:=dope rel-4;
ba. w2 f44. ;
hs. w2 f47. ; work7:=copy to:=dope rel+times;
al w2 g39 ; w2:=table pointer:=copy dope;
jl. a67. ; goto begin copy, w2 loaded
c78: hs. w1 f57. ; stop: stop:=0, true;
al w2 g46 ; w2:=cont stop;
jl. c1. ; goto interprete;
\f
; fgs 1986.02.27 algol 6, pass 8, page ...8...
c79: rl. w1 e9.+4 ; end pass: w1:=last work for pass;
rl. w0 (f34.) ; entry point:=entry point, latest point defined;
hs w0 x1-7 ;
jl. w3 e2. ; core length:=no of owns:=in byte;
rx w2 x1 ; w2:=no.of points, no.of catalog exts;
bl. w3 f24. ;
ac w3 x3 ; w3:=no of code segments:=-current segment;
hs w3 x1 ;
rs. w3 f34. ; work0:=no.of code segments;
rl. w3 f24. ; work 4:=first code segm:=current segm;
rs. w3 f44. ; double global(global base):=current segm,
wa. w2 f24. ; no.of points+current segm, no.of cat. exts;
ds. w3 (f33.) ; current segm subtracted later.
rl. w3 f15. ;
rl w2 x3+e39-2 ; last on segment:=last on segment + begin mark;
al w2 x2+4 ;
rs w2 x3+e39-2 ;
al w1 x1-8 ; ext list addr:=last work for pass-8;
a78: al w1 x1-2 ; rep:
rs. w1 f42. ; ext list addr:=ext list addr-2;
rl w0 x1 ; instr:=
sh. w1 (f62.) ; if ext list addr <= last global then
ws. w0 f44. ; global(ext list addr)-first code segm
rs. w0 f1. ; else global(ext list addr);
jl. w3 c25. ; store instr;
al w0 0 ; w3 claim:=0;
hs. w0 j0. ; change segment may have occured.
rl. w1 f42. ;
sl. w1 (f33.) ; if ext list addr>=global base then
jl. a78. ; goto rep;
rl. w1 f7. ;
al w1 x1+2 ;
ws. w1 f15. ; start of ext list:=top instr+2-segment base;
am. (e9.+4) ;
hs w1 -1 ;
al w1 c104 ; out segm action:=return to end pass;
hs. w1 j6. ;
jl. w3 c22. ; change segment;
c105: ; arrange initial external catalog for pass9:
b. h9 ; begin block
w.
h0 = 2, h1 = 6, h2 = 8, h3 = 16, h4 = 18 ; ext cat record fields
h5 = 22, h6 = 24, h7 = 28, h8 = 0, h9 = 26 ; copied from pass9
rl. w2 e9.+4 ; entry :=
al w3 x2-h7-2 ; last work for pass - h7 - 2;
ld w1 50 ;
rs w1 x3+h8 ; entry.chain field := 0;
ds w1 x3+h0+2 ; entry.final value :=
rl. w1 e9.-4 ; entry.base part := 0;
al w1 x1+1 ;
rs w1 x3+h1 ; entry.length := gpa.used segments + 1;
rl. w2 e21. ;
dl w1 x2+2 ; entry.name part := gpa.input descr.name part;
ds w1 x3+h2+2 ;
dl w1 x2+6 ;
ds w1 x3+h2+6 ;
rl. w2 e9.+4 ;
rl w1 x2-8 ;
ls w1 1 ;
ls w1 -1 ;
rs w1 x3+h3 ; entry.entry point := (last work - 8) extract 23;
dl w1 x2-4 ; entry.kindword1 := (last work - 6);
ds w1 x3+h4+2 ; entry.kindword2 := (last work - 4);
dl w1 x2 ; entry.st ext list := (last work - 2);
ds w1 x3+h6 ; entry.code.core := (last work );
rs w1 x3+h9 ; entry.dataentrypo := (last work );
rs w3 x3+h7 ;
rl w1 x3+h4 ; first entry := entry;
se w1 0 ; prog or proc :=
al w1 1 ; if entry.kindword1 <> 0 then 1
rs w1 x3+h7+2 ; else 0;
al w0 8 ; if program then
se w1 1 ; 4, start external list :=
hs w0 x3+h5 ; 8, start external list ;
e. ; end block arrange initial external catalog;
al. w2 e9. ; w2:=pass inf 1 addr;
ac. w1 (f35.) ;
wa. w1 f36. ; w1:=-stack top+greatest top;
jl. w3 a79. ; call set pass inf;
al. w2 e9.+2 ; w2:=pass inf 2 addr;
bl. w1 j2. ; w1:=max line change;
jl. w3 a79. ; call set pass inf;
jl. e7. ; goto end pass;
a79: wm. w1 f38. ; set pass inf:
rx w1 x2 ; w1:=pass inf; pass inf:=w1*1000;
wd. w1 f34. ;
wa w1 x2 ; pass inf:=pass inf+w1//no of code segments;
rs w1 x2 ;
jl x3 ; return;
\f
; rc 10.3.1971 algol 6, pass 8, page ...9...
b48=k+2, 0 , 1<10 ; round constant
b46=k-6, b43,b44,b45 ; convert action table
c81: jl. w3 e2. ; case elem lit:
rl. w3 f35. ; w2 := elem type := inbyte;
bl w3 x3-1 ; w3 := total type := stack(top-1);
sl w2 x3 ; if elem type >= total type
jl. a97. ; then goto store length of constant;
am x3 ; convert action :=
rl. w2 x2+b46. ; case elemtype+total type -6 of
dl. w1 f58. ; (lit int to long, lit int to real, lit long to real);
jl. x2+c81. ; (w0,w1) := constant; switch to action;
b43=k-c81 ; lit int to long:
bl w0 2 ; extend sign of
bl w0 0 ; integer to w0;
jl. a96. ; goto store constant;
b44=k-c81 ; lit int to real:
ci w1 0 ; (w0,w1) := float(w0,w1);
jl. a96. ; goto store constant;
b45=k-c81 ; lit long to real:
nd w1 5 ; normalize double(exp1,w0,w1);
ad w1 -1 ;
aa. w1 b48. ; add round constant;
nd. w1 b47. ; normalize double(exp2,w0,w1);
b47=k+1 ;
al w2 x2 ;
al w2 x2+48 ; exp(w0,w1) := exp1 + exp2 + 47;
sn w0 0 ; if mantissa(w0,w1) = 0 then
al w2 -2048 ; exp(w0,w1) := -2048;
hs w2 3 ;
a96: ds. w1 f58. ; store constant: constant := (w0,w1);
a97: al w1 x3 ; store length of constant: w1 := total type;
sl w3 4 ; if total type >= 4 then
al w3 4 ; total type := 4;
hs. w3 f54. ; opand rel := total type;
jl. c83. ; goto stack3(w0:=opand type);
c82: jl. w3 e2. ; stack inbyte:
al w0 x2 ; w0 := inbyte;
jl. w3 c57. ; stack(w0);
jl. (f2.) ; return;
\f
; rc 12.2.1971 algol 6, pass 8, page ...10...
c80: rl. w1 f35. ; begin case elem: w1:=stack top;
dl w0 x1-8 ;
wa. w0 f18. ; case elements:=case elements+1;
rx w3 x1-4 ;
rx w0 x1-2 ; swop double stack(stack top-8),
ds w0 x1-8 ; double stack(stack top-2);
rl w0 x1-6 ;
al w1 x1-8 ; w1:=define:=stack top-8;
se w0 0 ; if elem type<>variabel then
jl. (f2.) ; return;
jl. c84. ; goto store point(define);
; at this point the stack contains:
; top-10 literal of case elem or dummy
; top-8 literal of case elem or point of case element
; top-6 element type: 0=var, 2=int lit, 4=long lit, 6=real lit
; top-4 end case label
; top-2 no.of case elements, total type (2 ,4 or 6)
; next, the case comma stacks on top of this:
; element type
; literal or dummy
; literal or dummy
c83: al w0 x1 ; stack3: w0:=modifier;
jl. w3 c57. ; stack(w0);
rl. w0 f13. ;
jl. w3 c57. ; stack(first of constant)
rl. w0 f58. ;
jl. w3 c57. ; stack(last of constant);
jl. (f2.) ; return;
c85: rl. w2 f0. ; first case look-up:
rs. w2 f34. ; work0:=table pointer;
rl. w3 f40. ;
rl w1 x3+g57 ; continuation table(below segment limit):=
rs w1 x3+g58 ; jl. w3 (case alarm);
rl. w2 f35. ; w2:=
al w2 x2-4 ; stack top:=last scanned:=
rs. w2 f35. ; stack top-4;
rs. w2 b35. ; end case label is now in top.
bl w1 x2+2 ;
hs. w1 b36. ; elements:=stack(stack top+2);
al w1 x1+1 ;
rs. w1 f44. ; work4:=elements+1;
\f
; rc 12.2.1971 algol 6, pass 8, page ...11...
al w1 0 ; w1:=
hs. w1 f46. ; next segm limit:=0;
jl. a80. ; goto prepare next look-up;
c86: bl. w1 f46. ; end case look-up: w1:=next segm limit;
rl. w0 (f35.) ; w0:=end case label:=stack(stack top);
rl. w3 b35. ;
rs. w3 f35. ; stack top:=last scanned;
rs w0 x3 ; stack(last scanned):=end case label;
rl. w2 f34. ; table pointer:=saved table pointer:=work 0;
rs. w2 f0. ;
bl. w3 b36. ;
sl w1 x3 ; if next segm limit>=elements then
jl. c2. ; goto interprete next;
rl. w2 b37. ;
am. (f40.) ; continuation table(below segment limit):=
rs w2 g58 ; jl. end of segment;
jl. w3 c22. ; change segment;
jl. w3 c41. ; clear w3
; w1=next segm limit ; prepare next look-up:
a80: hs. w1 f43. ; segm limit:=next segm limit;
al w2 14+3 ; w2:=appetite:=7 look up instructions+abs word
rl. w0 (f35.) ;
jl. w3 c18. ; for alarm+1 byte+jump app(end case label);
jl. a81. ;
jl. a82. ; if direct jump then goto next case look-up;
a81: jl. w3 c11. ; abs store;
al w2 16+3 ; w2:=appetite:=8 look up instructions+3;
a82: bl. w1 f46. ; next case look-up: w1:=next segm limit;
a83: rs. w2 b38. ; rep: look up appetite:=w2;
b36=k+1; elements ;
sl w1 0 ; if next segm limit>=elements then
jl. a84. ; goto output case table;
rl. w3 b35. ; w3:=last scanned;
dl w1 x3-2 ; w1:=element type:=stack(last scanned-2);
se w1 0 ; if element type=var then
jl. a85. ; begin w0=point.
jl. w3 c18. ; w2:=look up appetite+jump app;
jl. a86. ; if direct jump then
jl. w3 c20. ; begin if test then
jl. a84. ; goto output case table;
bl. w1 f51. ; w1:=point rel
jl. a87. ; end else
a86: al w2 x2+2 ; begin w2:=appetite:=w2+jl;
jl. w3 c20. ; if test then
jl. a84. ; goto output case table;
jl. w3 c7. ; set w3 abs;
h. al w1 , jl x3 ;
w. hs. w1 f1. ; instr:=jl x3, instr
jl. w3 c25. ; call store instr;
jl. w3 c41. ; clear w3;
rl. w1 f7. ;
al w1 x1+2 ; w1:=top instr+2-segment base;
ws. w1 f15. ;
jl. a87. ; end end else
\f
; rc 12.2.1971 algol 6, pass 8, page ...12...
a85: hs. w1 f54. ; begin element type=constant.
dl w1 x3-4 ; opand rel:=element type;
ds. w1 f58. ; constant:=stack(last scanned-4);
jl. w3 c12. ; w2:=look up appetite+const app;
jl. w3 c20. ; if test then
jl. a84. ; goto output case table;
jl. w3 c13. ; const store; w1:=const addr-segm base;
ws. w1 f15. ; end;
a87: dl. w3 b35. ;
rs w1 x3-4 ; stack(last scanned-4):=const or instr address;
al w2 x2+1 ; w2:=look up appetite+1;
al w3 x3-6 ; w3:=last scanned:=last scanned-6;
rs. w3 b35. ;
bl. w1 f46. ;
al w1 x1+1 ; w1:=next segm limit:=next segm limit+1;
hs. w1 f46. ;
jl. a83. ; goto rep;
a84: ac. w2 (b38.) ; output case table:
sz w2 1 ; w2:=(if look up appetite odd then
al w2 x2+1 ; (-look up appetite+1)else(-look up appetite))
ac w1 x2+7 ;
wa. w2 f7. ; +top instr-segment base; w1 used later;
ws. w2 f15. ; w2 is now the relative address of the first
al w0 x2+12 ; look up word-4.
rs. w0 f48. ; address base:=work8:=w2+12; future jl x1.
ac w0 x2+18-e39 ;
hs. w0 f42. ; end of segm:=work 2:=512-w2-18;
bs. w1 f46. ; look up base:=work7:=even(look up app)-7
hs. w1 f47. ; -next segment base; future bl. w1 x1.
rl. w1 b35. ; current elem:=last scanned;
a88: rs. w1 b39. ; rep:
dl w0 x1+10 ; w0:=elem type(current elem+10);
rl. w1 f7. ; w1:=top instr-1; prepare set modifier.
al w1 x1-1 ;
ws. w3 f48. ; w3:=const or instr address-address base;
hs. w3 f1. ; instr:=w3, instr;
se w0 0 ; if element type<>var then
jl. w3 c87. ; set byte modifier;
rl. w1 b39. ;
dl w0 x1+4 ; w0:=element type(current elem+4);
ws. w3 f48. ; instr:=instr,
hs. w3 f51. ; const or instr address-address base;
se w0 0 ; if element type<>var then
jl. w3 c27. ; set modifier;
jl. w3 c25. ; call store instr;
rl. w1 b39. ;
al w1 x1+12 ; current elem:=current elem+12;
al w2 g59 ; w2:=pointer to look-up suite;
sl. w1 (f35.) ; if current elem>=stack top then
jl. c1. ; goto interprete;
jl. a88. ; goto rep;
\f
; rc 12.2.1971 algol 6, pass 8, page ...13...
b39: 0 ; current elem, used in output case table
b37: jl. 2<6 + 10 ; jl. end of segm =work2, used in end case look up
b38: 0 ;-2: look-up appetite
b35: 0 ; last scanned
; during case look-up generation the working the stack looks like this:
; locations are used in this way: old stack top ->
; work 0 saved table pointer
; work 2 end of segm rel, segm limit last scanned ->
; work 4 elements+1 current elem ->
; work 6 next segm limit, look up base
; work 8 address base stack top -> end case lab
c88: rl. w2 e9.+4 ; end external: w2:=last work for pass;
dl. w1 f58. ;
ds w1 x2-4 ; kind and spec:=4 bytes read;
al w1 1 ;
hs. w1 j3. ; segment type:=external procedure;
am. (f15.) ; last on segment:= segment type;
rs w1 +e39-2 ;
jl. (f2.) ; return;
c89: bl. w1 f57. ; end call:
hs. w1 f13. ; last of constant=formal count, literal count
bl. w1 f59. ; first of const:=stop, -lit app-1
ac w1 x1+1 ;
hs. w1 f60. ;
al w1 1 ;
hs. w1 f57. ; stop:=1;
rl. w0 f3. ;
al w2 g63 ;
se. w0 a6. ; if opand app action<>external then
rs. w2 f0. ; table pointer:=call formal proc;
jl. c83. ; goto stack 3;
; during procedure calls the stack looks like this:
; top-10 return point
; top-8 beg param action, kind+type
; top-6 old stop, call appetite
; top-4 formal count, literal count
; top-2 bypass to transfer next param
c90: rl. w1 f35. ; begin param: w1:=stack top;
rl w0 x1-8 ;
hs. w0 f42. ; work2:=kind+type;
rl. w2 f33. ;
rs. w2 f34. ; define:=global base;
al w2 g64 ; w2:=if begin param action<0 then
sl w0 0 ; thunk parameter else
al w2 g65 ; define bypass;
jl. c1. ; goto interprete;
\f
; rc 15.06.72 algol 6, pass 8, page ...14...
c91: rl. w1 f35. ; begin call: w1:=stack top;
bl w2 x1-6 ;
bl. w0 f57. ; w0:=stop;
hs. w2 f57. ; stop:=stacked stop;
al w1 x1-10 ;
rs. w1 f35. ; stack top:=stack top-10;
al w2 g46 ; w2:=pointer to jl.w3 (stop)
sn w0 0 ; if old stop=0 then
jl. c1. ; goto interprete;
bl w2 x1+5 ;
hs. w2 f45. ; work 5:=call app;
rl w0 x1 ; w0:=return point;
hs. w0 f49. ; work 9:=return rel;
bs. w0 f49. ;
rs. w0 f34. ; work 0:=return segment, 0;
ac w2 x2+6 ;
hs. w2 f48. ; work 8:=-call app-6;
jl. c2. ; goto interprete next;
c94: al w2 -4 ; store formal: w2:=stack top-4;
jl. a89. ; points to formal count, skip.
c95: al w2 -3 ; store literal: w2:=stack top-3;
a89: wa. w2 f35. ; points to literal count. w1=appetite.
bl w3 x2 ;
hs. w3 f51. ; instr:=instr, formal or lit count;
al w3 x3-4 ; formal or lit count:=
hs w3 x2 ; formal or lit count-4;
h. al w0 , ds w0 x1 ;
w. hs. w0 f1. ; instr:=ds w0 x1+formal or lit count;
al w2 x1 ;
jl. w3 c21. ; test and change(modifier);
jl. 2 ;
jl. w3 c41. ; clear w3;
jl. c24. ; goto store instr, return saved;
c109:jl. w3 e2. ; end array field param:
jl. w3 e11. ; type:=inbyte; repeat inbyte;
ls w2 1 ;
rl. w3 x2+b50. ; set constants to round
rs. w3 f68. ; lower bound to a
ac w3 x3 ; multiple of
hs. w3 f67. ; typelength(type);
al w2 4 ; w2:=4;
al w0 g87 ; (dope rel in runtime stack);
al w1 16 ; w0:=continue(store bounds);
jl. a90. ; w1:=kind(array); goto end param+4;
b50=k-2 ; table for rounding lower bound
; typel.-1, log2(typel.);
0 < 12 + 0 ; boolean
1 < 12 + 1 ; integer
3 < 12 + 2 ; real
3 < 12 + 2 ; long
\f
;rc 03.03.1972 algol6 pass 8, page ...15...
c92: jl. w3 e2. ; end array param: w2:=dope rel to base;
al w0 g69 ; w0:=continue array param;
al w1 16 ; w1:=kind:=16;
jl. a90. ; skip
c96: bl. w0 f1. ; 44: end param: w1=kind; w0:=continue;
al w2 6 ; w2:=record dope;
a90: rs. w0 f0. ; table pointer:=continue;
hs. w2 f48. ;
jl. w3 e2. ; work 8:=dope rel to base;
wa w2 2 ; work 9:=inbyte(type)+kind;
hs. w2 f49. ; w2=type+kind;
rl. w1 f35. ; w1:=stack top;
sl w0 g80 ; if continue>=thunks then
wa. w2 f17. ; w2:=1 shift 23+type+kind;
rs w2 x1-8 ; top-8:=beg param action, kind+type;
\f
; fgs 1987.05.13 algol 6, pass 8, page ...16...
bl w3 x1-3 ; work 2:=literal count;
hs. w3 f42. ;
sl w0 g80 ; if continue>=thunks then
jl. w3 c41. ; clear w3;
jl. c2. ; goto interprete next;
c98: ; change out segment:
b. a5 w. ;
rl. w3 e17. ;
so w3 1<5 ; if details.8 on and
jl. a0. ;
ls w3 -16 ;
sz w3 1 ; code off then
jl. a0. ; begin
rl. w3 e42. ; printcount:=printcount+1;
al w3 x3+1 ;
sh w3 9 ; if printcount>9 then
jl. a1. ; begin
jl. w3 e19.+2; print line head;
al w3 0 ; print count:=0;
a1: rs. w3 e42. ; end;
jl. w3 e27. ; print line count;
a0: ; end;
e.
c.510-e39 ; if short segment mode then
w. rl. w3 f15. ; begin
al w3 x3+e39 ; w3:=segment base:=segment base+length;
sh. w3 (e20.-4) ; if segment base<=last on segment
jl. c97. ; then goto after change;
z. ; end;
c104=c105-k ; define return to end pass;
j6=k+1; out segm action ;
jl. w3 e8. ; call gpa out segm or return to end pass;
c101:rl. w3 e20.-2 ; w3:=segment base;
jl. c97. ; goto after change;
c19: jl. c21. ; stepping stone to test and change:
c107:rl. w2 f13. ; restore opand rel:
rs. w2 f4. ; opand rel:=first of const; return;
jl. (f2.) ; see simple zone param, g69.
c112:jl. c36. ; stepping stone to store string;
c103:jl. c28. ; stepping stone to set point modifier:
\f
; jz 1979.06.07 algol 8, pass 8, page ...17...
; global constants and working locations.
f0: g83 ; table pointer: index in main or continue table.
f51=k+1, f1: 0 ; instr: instruction assembled here.
f2: 0 ; return: return address from central actions.
f3: 0 ; opand app action
f53: 0 ; +2 addr opand app action
f54=k+1, f4: 0 ; opand rel: index mark+modif part, rel
; in case of const opand, rel signals length of
; constant.
f5: 0 ; opand store action
f55: 0 ; + 2 addr opand store action
f56=k+1, f6: rl w3 x2 ; opand block: rl w3 x2, block
f7: 0 ; top instr:abs address of next instr on segment
f8: 0 ; load w3: instr to load current value of w3
f10: 0 ; no.of exts: no.of global points+no.of std.iden-
; tifiers.
f61=k+1, f11: 0 ; zone block: block of latest zone base.
f52=k+1, f12: rl w3 x3 ; zone rel: rl w3 x3, rel of latest zone base.
; used together with f8, if w3 claim=4.
f14: 0 ; last const: abs address of last const on segment.
f15: 0 ; segment base: abs address of byte 0 on segment.
f16: 1<23+1<12 ; used in change segment.
f17: 1<23 ;
f18: 1<12 ;
f19: aw (0) ; used in addr opand store and opand store.
f20: 0 ; alternate return: assists f2 sometimes.
f21:h. am (x2),am ( ) ;
f22:w. rl. w3 ( ) ; used in w3 abs app
f23: 0 ; point base: abs address of first const on segment
f26: 0 ; +2 top point: abs address of next point on segm.
f24: 0 <12 ; current segment, 0
f25: 0 ; last abs: abs address of last absword on segment
f27: 0 ; line block: next instr where line inf is packed.
f28: 0 ; prev line: line count of previous line block.
f29: 0 ; line alarm addr: addr where line inf. is packed.
f50=k+1, f30: jl x3 ; jl x3 rel address
f31: 1<22-1 ; mask
f32: 23 ; used in set modifier etc
f33: 0 ; global base: base addr for global points.
f35: 0 ; stack top: addr of first free stack word.
f36: 0 ; greatest top: greatest stack top yet used.
f57=k+1, f37: 0 ; var step, stop: boolean addr for step until,
; byte cleared when stop byte is input.
f38: 1000 ; used in end pass
f40: 0 ; abs value of g0 (outside range for some actions).
f62: 0 ; abs address of last global
f41=k+1,f42=k+2,f43=k+3 ; work cells for special actions: define point,
f44=k+4,f45=k+5,f46=k+6 ; conditions, take forlab, test first, of, etc.,
f47=k+7,f48=k+8,f49=k+9 ; copy(begin block, take array), proc call.
f34: 0, 0, 0, 0, 0 ; central action 10 stores instruction+byte
; found in work (modifier).
f9: -4 ; +10 current block: initially
f60=k+1,f58=k+2,f59=k+3 ; fictive std proc block.
f13: 0, 0 ; +12, +14 constant: latest constant input.
h. f63=k-f34, -65 ; used in : store instr+(-65);
f71=k-f34, f72: 0 ; used in : action 50 and 52
f64=k-f34, f67: 0 ; - - : c109, store bounds
w.h. f65=k-f34, f68: 0 ; - - : - - -
; (addressed as word and byte)
f66=k-f34, 0 w. ; used in : c109, store bounds;
\f
; jz.fgs 1987.05.13 algol 8, pass 8, page ...18...
; interpreter: unpacks a table word given either by main table (inbyte),
; continue table (table pointer), or continue table (table pointer:=
; table pointer -2). the table word is split into instr (bits 0-11),
; w1=signed modifier (bits 12-17), and central action number (bits 18-23,
; positive). the return address is set to nextin or interprete next
; depending on bit 23=1 or 0.
; finally the designated central action is entered.
c0: jl. w3 e2. ; next in: w0 unchanged; w2:=inbyte;
sl w2 500 ; if w2>control byte then
jl. c3. ; goto read operand;
c1: al. w3 c0. ; interprete: w2=table pointer; prepare return
rs. w2 f0. ; to next in; save table pointer;
bl. w1 x2+g0. ;
hs. w1 f1. ; instruction:=control table (table pointer);
bl. w1 x2+g1. ;
ad w2 -6 ; w1:=modifier:=bits 12-17 (table pointer+1);
ls w2 -18 ; w2:=central action:=bits18-23(table pointer+1);
so w2 1 ; if not last in sequence then
al. w3 c2. ; w3:=return to interprete next;
rs. w3 f2. ; save return;
jl. x2+b0. ; switch to central action(w2);
c2: rl. w2 f0. ; interprete next:
al w2 x2-2 ; w2:=table pointer:=table pointer-2;
jl. c1. ; goto interprete;
; switch to central actions:
b0: jl. c4. ; 0: store opand+instr+modif.
jl. c34. ; 2: call instr(modifier)
jl. c35. ; 4: input modif bytes, call instr(modifier)
jl. c42. ; 6: store addr opand+instr
jl. c110. ; 8: store instr+rs entry (modifier)
jl. c47. ; 10: store instr+work(modifier)
jl. c23. ; 12: store instr+modifier
jl. c24. ; 14: store instr, return saved
jl. c51. ; 16: cont(instr), test(modifier)
jl. c53. ; 18: clear w3, call instr
jl. c55. ; 20: clear w3, cont(instr), test(modifier)
jl. c59. ; 22: may be short lit(modifier)
jl. c60. ; 24: store instr+ext chain
jl. c111. ; 26: store instr+rs segm(modifier)
jl. c63. ; 28: skip opand(addr opand+instr)
jl. c65. ; 30: test (modif), jump(top+instr)
jl. c67. ; 32: store instr+const
jl. c64. ; 34: skip direct(instr,modif)
jl. c68. ; 36: store instr+segment abs
jl. c76. ; 38: store instr+ext point(modif)
jl. c77. ; 40: store instr+sref
jl. c93. ; 42: store instr+latest point
jl. c96. ; 44: end param, cont instr, kind=modif
jl. c102. ; 46: clear w3 + rs entry(modif)
jl. c108. ; 48: cont(instr), test(modif), clear
jl. c116. ; 50: define param
jl. c117. ; 52: store instr + rs entry(param)
c110:la. w1 b49. ;
jl. c26. ;
c111:la. w1 b49. ;
jl. c61. ;
b49: 2.111111 ;
\f
; rc 12.2.1971 algol 6, pass 8, page ...19...
c4: wa. w1 f4. ; 0: store opand+instr+modif:
rs. w1 f4. ; opand rel:=opand rel+modif;
a36: al w2 2 ; store opand+instr: rep: w2:=appetite:=2
jl. w3 (f3.) ; +opand appetite;
jl. w3 c21. ; if test and change then
jl. a36. ; goto rep;
c5: rl. w0 f1. ; opand+instr store: w0=instr.
a29: hl. w0 f4.+1 ; instr:= (instr,opand rel) or opand rel;
lo. w0 f4. ;
rs. w0 f1. ;
jl. (f5.) ; switch to opand store action;
; opand appetite actions; literal: switches to constant appetite via a1
;a23: local var: local indirect: x1: return;
a3: al w1 4 ; global formal zone: new w3 app:=4;
jl. a5. ; skip;
a4: al w1 2 ; local zone: global var: new w3 app:=2;
a5: rl. w0 f6. ; w2:=appetite:=w2
jl. c8. ; +w3 appetite(opand block); return;
a6: bl. w0 f4.+1 ; external or uv:
ls w0 12 ; w2:=appetite:=w2
jl. c10. ; +abs appetite(opand rel shift 12); return;
a7: al w0 0 ; own: w2:=appetite:=w2
jl. a10. ; +w3 abs appetite(0, odd return); return;
a37: bl. w0 f12.+1 ; external zone:
ls w0 12 ; w2:=appetite:=w2
a10: al w3 x3+1 ; +w3 abs appetite(zonerel shift 12, odd return);
jl. c6. ; return;
; opand store actions ; local var: indirect: x1: switches to store instr.
a8: jl. w3 c9. ; local zone: global var: global formal zone:
jl. c24. ; set w3; goto store instr, return saved.
; external or uv: switches to instr+rs entry store.
a9: jl. w3 c7. ; own: external zone: set w3 abs;
jl. c24. ; goto store instr, return saved.
a11: jl. w3 c13. ; literal: w1:=rel const addr:=const store;
a12: ws. w1 f7. ; called from c76.
hs. w1 f1.+1 ; instr:=instr, w1-top instr;
jl. w3 c27. ; set modifier;
jl. c24. ; goto store instr, return saved.
\f
; rc 12.2.1971 algol 6, pass 8, page ...20...
c35: ac w1 x1-4 ; 4: input modif bytes, call instr(4-modif):
hs. w1 b10. ; w1:=4-modif;
al w1 4 ; for w1:=3 step -1 until 4-modif do
a16: jl. w3 e2. ;
al w1 x1-1 ; constant(w1):=inbyte;
hs. w2 x1+f13. ;
b10=k+1; 4-modif ;
se w1 0 ;
jl. a16. ; w1=4-modif
c34: bz. w2 f1. ; 2: call instr(modif): w1=modifier;
ws. w2 f18. ;
wa. w2 f0. ; w2:=table pointer+instr-4096;
jl. x2+g0. ; goto table pointer+instr+table base;
c42: al w2 2 ; 6: store addr opand+instr:
jl. w3 (f3.+2) ; rep: w2:=appetite:=2+addr opand appetite;
jl. w3 c21. ; if test and change then
jl. c42. ; goto rep;
bl. w0 f1. ;
ls w0 12 ; w0:=instr,0;
jl. (f5.+2) ; switch to addr opand store action.
; addr opand appetite actions. also called from 22,may be short lit.
a22: al w2 x2+2 ; global var: local indirect: w2:=app:=app+2;
a23: jl x3 ; local var: x1 addressing: return;
a2: bl. w0 f4.+1 ; external or uv:
ls w0 12 ; w0:=abs word:=opand rel shift 12;
jl. a24. ; skip.
a25: al w0 0 ; own var: w0:=abs word:=0;
a24: al w2 x2+2 ; w2:=appetite:=appetite:=appetite+2
jl. c10. ; +abs appetite(abs word);
a26: rl. w0 f13.+2 ; literal:
sh w0 2047 ; if constant > 2047
sh w0 -2048 ; ! constant < -2047 then
a1: jl. c12. ; opand app lit: goto constant appetite;
al. w0 a27. ;
rs. w0 f5.+2 ; store addr opand:=byte lit; tested in c59.
jl x3 ; return;
\f
; jz.fgs 1987.05.27 algol 8, pass 8, page ...21...
; addr opand store actions; literal switches to a11, previous page.
a27: rl. w0 f13.+3 ; byte lit:
hs. w0 f1.+1 ; instr:=instr, last byte of lit;
jl. c24. ; goto store instr, return saved.
a28: lo. w0 f19. ; literal: local var: x1 addressing: w0:=instr( );
jl. a29. ; goto opand+instr store;
a30: al. w1 a31. ; global var: w1:=am action:=global var am;
jl. a32. ; goto x3ref;
a33: al. w1 a36. ; local indirect: external or uv: w1:=am action
jl. a34. ; :=store opand+instr; goto indirect ref;
a35: al. w1 c29. ; own: w1:=am action:=instr+abs word store;
a32: hl. w0 f4.+1 ; x3ref: w0:=instr, opand rel;
a34: lo. w0 f19. ; indirect ref:
rs. w0 f1. ; instr:=instr( );
rs. w1 b11. ; save am action;
rl. w0 f2. ;
rs. w0 f20. ; alternate return:=return;
jl. w3 c25. ; call store instr;
bl. w0 f21.+1 ;
hs. w0 f1. ; instr:=am(0);
rl. w3 f20. ; w3:=return:=alternate return;
rs. w3 f2. ;
jl. (b11.) ; switch to am action;
b11: 0 ; saved am action.
a31: rl. w0 f21. ; global var am:
hl. w0 f6.+1 ; instr:=am(x2+opand block);
rs. w0 f1. ;
jl. c24. ; goto store instr; return saved
b22=k+1; saved modif ;
a58: al w1 0 ; rep: w1:=saved modif;
c102:jl. w3 c41. ; 46: clear w3 + rs entry(modif): clear w3;
c26: hs. w1 b22. ; 8: store instr + rs entry(modif):
wa. w1 f10. ; save modif;
ld w1 36 ; w0:=abs word:=(modifier+no of exts) shift 12;
al w2 2 ;
jl. w3 c10. ; w2:=appetite:=2+abs app(abs word);
jl. w3 c21. ; if test and change then
jl. a58. ; goto rep;
c29: jl. w3 c11. ; instr+abs word store: abs store;
ws. w1 f7. ;
hs. w1 f1.+1 ; instr:=instr, abs word addr-top instr;
rl. w0 f1. ;
lo. w0 b8.+4 ; instr:=instr.;
rs. w0 f1. ;
jl. c24. ; goto store instr, w3 saved;
c116:bz. w1 f1. ; 50: define param::
hs. w1 f72. ; param := bits(0,11,controlword);
jl. (f2.) ; return;
c117:bz. w1 f72. ; 52: store instr+rs entry(param):
jl. c26. ; modif:=param; goto store instr+rs entry(modif);
c118:hs. w1 f1.+1 ; store instr (datapart of ix instr):
rl. w1 f13.+2 ; displacement := modifier; <*typeshift*>
hs. w1 f1. ; instr part := literal ; <*doperel *>
jl. c24. ; goto store instr, return saved;
\f
; jz.fgs 1987.06.18 algol 8, pass 8, page ...22...
c47: bl. w1 x1+f34. ; 10: store instr+work(modif): modif:=work(modif);
c23: hs. w1 f1.+1 ; 12: store instr+modifier: instr:=instr, modifier;
c25: rs. w3 f2. ; 14: store instr: called from a34,c79.
; save return;
c24: rl. w2 f7. ; store instr, return saved: w2:=top instr;
al w1 x2-2 ; w1:=top instr-2;
am. (f14.) ;
j0=k+1; w3 claim ; if top instr<=last const+w3 claim then
sh w2 +0 ;
jl. a54. ; change or half up; saves w1 only.
a56: sh. w1 (f27.) ; if top instr-2 <=line block then
jl. w3 c44. ; store line inf;
rs. w1 f7. ; top instr:=top instr-2;
rl. w0 f1. ;
rs w0 x1+2 ; segment(top instr+2):=instr;
j7=k ; if code.yes then jl. w3 c43. <*print instr*>
jl. (f2.) ; else return;
jl. (f2.) ; return;
a54: al w2 2 ; change or half up:
jl. w3 c21. ; if test and change(2) then
jl. c24. ; goto store instr, return saved
jl. w3 a52. ; half up;
jl. a56. ; return to store instr;
c44: al w0 x3 ; store line inf: w1 saved; w0:=return;
rl. w3 e6. ;
rx. w3 f28. ; w3:=line change:=prev line-line count;
ws. w3 f28. ; prev line:=line count;
sl w3 32 ; if line change>=32 then
al w3 31 ; line change:=31;
j2=k+1; max line change ;
sl w3 0 ; if line change>=max line change then
hs. w3 j2. ; max line change:=line change; pass inf.
al w2 0 ;
j1=k+1; line inf shifts ; w2-w3:=segment(line alarm addr)
ld w3 3 ; :=line change shift line inf shifts
aa. w3 (f29.) ; +segment(line alarm addr);
ds. w3 (f29.) ;
rl. w3 f27. ; line block:=line block-34;
al w3 x3-34 ;
rs. w3 f27. ;
bl. w3 j1. ; line inf shifts:=line inf shifts+5;
al w3 x3+5 ;
hs. w3 j1. ;
sh w3 43 ; if line inf shifts<=43 then
jl (0) ; return;
al w3 0 ;
hs. w3 j1. ; line inf shifts:=0;
rl. w3 f29. ;
al w3 x3-4 ; line alarm addr:=line alarm addr-4;
rs. w3 f29. ;
jl (0) ; return;
\f
; rc 12.2.1971 algol 6, pass 8, page ...23...
c55: jl. w3 c41. ; 20: clear w3, cont, test: clear w3;
c108:al. w0 c41. ; 48: cont,test,clear:
jl. a95. ; w0:=change action:=clear w3; skip;
c51: al. w0 c2. ; 16: cont(instr), test(modif):
a95: bl. w2 f1. ; w0:=change action:= interprete;
rs. w2 f0. ; table pointer:=instr;
al w2 x1 ; appetite:=modifier;
jl. w3 c21. ; if test and change then
jl w3 (0) ; clear w3 or interprete;
jl. c2. ; goto interprete;
c53: jl. w3 c41. ; 18: clear w3, call instr: clear w3;
jl. c34. ; goto call instr;
c59: hs. w1 b30. ; 22: may be short lit: save modifier;
jl. w3 (f3.+2) ; addr opand appetite;
rl. w0 f5.+2 ; w0:=addr opand store action;
al w1 0 ; modifier:=0. prepare jump to store opand+modif.
se. w0 a27. ; if addr opand store action<>byte lit then
jl. c4. ; goto store opand+instr+modifier;
b30=k+1; saved modif ;
al w2 0 ; w2:=saved modifier;
se w2 0 ; if modifier>0
j5=k+1; int overflow ; and integer overflow wanted then goto
jl. 2;or c4. ; store opand+instr+modifier; note: wa, ws.
bl. w0 x2+b31. ;
hs. w0 f1. ; instr:=short operations(modifier);
rl. w1 f13.+2 ;
sn w2 2 ; w1:=modifier:=if modifier<>2 then constant
ac. w1 (f13.+2) ; else -constant; note: ws.
hs. w1 f1.+1 ; instr:=instr,modif;
jl. c24. ; goto store instr, return saved;
h.
b31: al w1 , al w1 x1 ; short operations: rl, wa
al w1 x1 , 0 ; ws, not used
w.
c60: bl. w1 f4.+1 ; 24: store instr+ext chain: w1:=extno:=opand rel;
jl. a70. ; skip;
c61: wa. w1 f10. ; 26: store instr+rs segm(modif): w1:=ext no:=
a70: hs. w1 b34. ; modifier+no.of exts;
a71: al w2 2 ; rep: w2:=appetite:=2
jl. w3 c16. ; +chain app+(w3 chain app);
jl. w3 c21. ; if test and change then
jl. a71. ; goto rep;
jl. w3 c7. ; set w3 abs; w1:=abs word addr;
bl w0 x1+1 ; instr:=instr, chain of abs word;
hs. w0 f1.+1 ;
rl. w2 f7. ;
al w2 x2+1 ; chain of abs word:=top instr+1-segment base;
ws. w2 f15. ;
hs w2 x1+1 ;
jl. c24. ; goto store instr, w3 saved
\f
; rc 12.2.1971 algol 6, pass 8, page ...24...
; central action 28, skip opand, see special actions, c62, c63, c64.
c65: hs. w1 b33. ; 30: test(modif), jump(top+instr):
b33=k+1; saved appetite ; save appetite:=modif;
a73: al w2 0 ; rep: w2:=saved appetite;
rl. w1 f35. ;
ba. w1 f1. ; w1:=stack top+instr;
rl w0 x1 ;
sz w1 1 ; if instr odd then
hs. w0 j4. ; uncondit jump:=true;
jl. w3 c18. ; w2:=app:=w2+jump app(stack(w1));
jl. a74. ; if direct jump then
jl. w3 c21. ; begin if test and change then
jl. a73. ; goto rep;
bl. w1 f1.+1 ;
ws. w1 f7. ; instr:=instr, point rel-top instr
wa. w1 f15. ; +segment base;
hs. w1 f1.+1 ;
h. al w1, jl. ; w1:=jl.
w. jl. a75. ; end else
a74: jl. w3 c21. ; begin if test and change then
jl. a73. ; goto rep;
jl. w3 c7. ; set w3 abs;
h. al w1, jl x3 ; w1:=jl x3
w. ; end;
a75: hs. w1 f1. ; instr:=w1, instr;
al w0 0 ;
hs. w0 j4. ; uncondit jump:=false;
jl. c24. ; goto store instr, return saved;
c67: rl. w2 f4. ; 32: store instr+const:
rs. w2 f13. ; first of const:=opand rel;
al w2 2 ; saved for c107, restore opand rel.
hs. w2 f4.+1 ; opand rel:=const length:=2;
rl. w0 f48. ;
rs. w0 f58. ; last of const:=work 8;
jl. w3 c12. ; w2:=2+const app;
jl. w3 c21. ; if test and change then
jl. c67. ; goto store instr+const;
jl. a11. ; goto literal, opand store actions;
; central action 34, skip direct, see special actions, c62, c63, c64.
c68: rl. w0 f34. ; 36: store instr+segment abs:
ws. w0 f24. ; w0:=work0-current segment+1<23;
wa. w0 f17. ;
al w2 2 ;
jl. w3 c10. ; w2:=app:=2+abs app(w0);
jl. w3 c21. ; if test and change then
jl. c68. ; goto store instr+segment abs;
jl. c29. ; goto instr+abs word store;
\f
; fgs 1987.05.13 algol 6, pass 8, page ...25...
c76: se w1 0 ; 38: store instr+ext point:
wa. w1 f10. ; if modifier<>0 then ext:=modifier+no.of exts;
sn w1 0 ; if modifier=0 then
bl. w1 f4.+1 ; ext:=opand rel;
ld w1 36 ; w0:=point:=ext shift 12;
a77: al w2 2 ; rep:
jl. w3 c14. ; w2:=appetite:=2+point app;
jl. w3 c21. ; if test and change then
jl. a77. ; goto rep;
jl. w3 c15. ; w1:=rel point addr:=point store;
jl. a12. ; goto literal, store opand+instr;
c77: bl. w1 f6.+1 ; 40: store instr+sref: w1:=modifier:=opand block
se. w1 (f9.) ; if opand block<>current block then
jl. c23. ; goto store instr+modifier;
bl. w1 f1. ;
al w1 x1+11<6-20<6; w1:=instr:=instr+al-rl, 0;
ls w1 12 ;
rs. w1 f1. ;
jl. c24. ; goto store instr;
c93: rl. w0 (f34.) ; 42: store instr+latest point: w0:=point(define)
wa. w0 f17. ; +1<23 - current segm;
ws. w0 f24. ;
jl. a77. ; goto rep in store instr+ext point;
; central action 44, end param, see special actions c92, c96.
; central action 46, clear w3+rs entry, see page 19.
c114: ; stepping stone to c14:
jl. c14. ; goto c14;
c115: ; stepping stone to c15:
jl. c15. ; goto c15;
c99=k-e0 ; stepping stone to entry pass 8:
jl. c100. ; goto entry pass 8;
\f
; fgs 1986.06.18 algol 6, pass 8, page ...26...
c41: bl. w0 j0. ; clear w3: w3=return, w2, w1 saved
sn w0 0 ; if w3 claim=0 then
jl x3 ; return; swop w1,top instr;
ds. w3 b9. ; save w2, w3;
rx. w1 f7. ; there is always room for load w3 instructions
sh w0 2 ; between instructions and constants.
jl. a20. ; if w3 app>2 then
rl. w0 f12. ; begin
rs w0 x1 ; segment(top instr):=zone rel;
al w1 x1-2 ; top instr:=top instr-2
j8=k ; if code.yes then jl. w3 c43. <*print instr*>
jl. 2 ; else skip;
a20: rl. w0 f8. ; end;
am -2000 ;
sz. w0 (b8.+4+2000); if load w3 relative marked then
ws w0 2 ; load w3 address:=load w3 address-top instr;
hs. w0 f8.+1 ;
rl. w0 f8. ; segment(top instr):=w0:=
rs w0 x1 ; load w3, load w3 address;
al w1 x1-2 ; top instr:= top instr-2;
j9=k ; if code.yes then jl. w3 c47. <*print instr*>
jl. 2 ; else skip;
rx. w1 f7. ; get saved w1;
al w0 0 ;
hs. w0 j0. ; w3 claim:=load w3:=0;
rs. w0 f8. ;
dl. w3 b9. ; restore w2, w3;
jl x3 ; return;
0 ;
b9: 0 ; saved v2, w3;
c18: hs. w0 f1.+1 ; jump app: w0=point, w3=return, w2=appetite;
bs. w0 f1.+1 ; instr:=instr, point rel;
sn. w0 (f24.) ; if point-point rel=current segment then
jl x3+2 ; return direct jump;
ws. w0 f24. ; w0:=abs word:=point-point rel-current segm
wa. w0 f17. ; +1<23;
c6: rs. w3 b12. ; w3 abs app: w0=abs word, w3=return;
; w3odd signals no (); save return;
jl. w3 c10. ; w2:=appetite:=w2+abs app;
c17: hs. w1 f22.+1; w3 chain app: called from chain app;
rl. w0 f22. ; w0:=next load w3:=rl. w3 abs word addr;
al w1 2 ; next w3 claim:=2;
rl. w3 b12. ; get return;
sz w3 1 ; if odd return then
ws. w0 f19. ; remove ();
c8: rs. w0 b13. ; w3 app: wo=next load w3, w1=next w3 claim, w2=app;
hs. w1 b14. ; save next load w3, next w3 claim;
wa w2 2 ; w2:=appetite:=w2+next w3 claim;
bs. w1 j0. ;
sn w1 0 ; if w3 claim<>next w3 clai m
se. w0 (f8.) ; or load w3<>next load w3 then
jl. c41. ; goto clear w3;
bs. w2 b14. ; w2:=appetite:=w2-next w3 claim;
jl x3 ; return;
b12: 0 ; saved return
b13: 0 ; next load w3
c7: rs. w3 b12. ; set w3 abs: save return;
jl. w3 c11. ; abs store; w1 used in c60, c61.
rl. w3 b12. ; get return;
c9: rl. w0 b13. ; set w3:
rs. w0 f8. ; load w3:=next load w3;
b14=k+1; next w3 claim;
al w0 0 ; w3 claim:=next w3 claim;
hs. w0 j0. ;
jl x3 ; return;
\f
; rc 13.06.72 algol 6, pass 8, page ...27...
; point app: w0=point, w2=app, w3=return.
c14: rl. w1 f23. ; w1:=point base;
a43: al w1 x1-2 ; rep: w1:=point addr:=w1-2;
se. w1 (f26.) ; if point addr<>top point
sn w0 (x1) ; and point<>segment(point addr)
jl. a44. ; then
jl. a43. ; goto rep;
a44: sn. w1 (f26.) ; if point addr=top point then
al w2 x2+2 ; w2:=appetite:=w2+2;
ds. w1 b16. ; save point, point addr;
jl x3 ; return;
c15: dl. w1 b16. ; point store: w3=return; w1:=point addr;
al w2 x1-2 ; w2:=possible new top point:=point addr-2;
ws. w1 f23. ; w1:=rel point addr:=point addr-point base;
sl. w2 (f26.) ; if point addr-2>=top point then
jl x3 ; return;
rs. w2 f26. ; top point:=new top point;
rx w0 x2+2 ; swop point, segment(point addr);
sl. w2 (f25.) ; if new top>=last abs then
jl x3 ; return;
jl. a40. ; goto half down;
c12: rs. w3 b18. ; const app: w2=return, opand rel=const length
rl. w1 f23. ; save return; w1:=const addr:=point base;
bl. w3 f4.+1 ; w3:=opand rel;
al w0 a45 ; first no match:=exit;
sh w3 2 ; if long lit then
jl. a46. ; begin
al w1 x1+2 ; w1:=const addr:=point base+2;
al w0 a47 ; first no match:=rep;
a46: hs. w0 b19. ; end; set first no match;
dl. w0 f13.+2; w3-0:=constant;
a48: sh. w1 (f14.) ; rep: if const addr>last const then
jl. a49. ; begin
ba. w2 f4.+1 ; w2:=appetite:=w2+const length;
rl. w1 f14. ; w1:=const.addr:=last const+const length;
ba. w1 f4.+1 ;
a50: rs. w1 b20. ; exit: save const addr;
jl. (b18.) ; return;
a49: al w1 x1+2 ; end; w1:=const addr:=w1+2;
se w0 (x1-2) ; if last of lit<>segm(const addr-2) then
jl. a48. ; goto rep;
se w3 (x1-4) ; if first of lit<>segm(const addr-4) then
b19=k+1; first no match;
jl. 0 ; goto rep or continue;
a45= k-b19+1 ;
al w1 x1-2 ; const addr:=w1-2;
a47=a48-b19+1 ;
jl. a50. ; goto exit
b18: 0 ; saved return
b20: 0 ; const addr, claimed (half up).
\f
; rc 13.06.72 algol 6, pass 8, page ...28...
; abs app: w0=abs word, w2=app, w3=return.
c10: rl. w1 f15. ; w1:=abs word addr:=segment base;
a38: sh. w1 (f25.) ; rep: if abs word addr<=last abs
sn w0 (x1) ; and abs word<>segment(abs word addr)
jl. a39. ; then begin
al w1 x1+2 ; w1:=abs word addr:=w1+2;
jl. a38. ; goto rep end;
a39: sh. w1 (f25.) ; if abs word addr>last abs then
am -2 ;
al w2 x2+2 ; w2:=appetite:=w2+2;
ds. w1 b16. ; save abs word, abs word addr;
jl x3 ; return; w1 used in w3 abs app. w0 used in c26.
0 ; saved abs word, point.
b16: 0 ; saved abs word addr, point addr.
c11: dl. w1 b16. ; abs store: w3=return; w1:=abs word addr;
sh. w1 (f25.) ; if abs word addr<=last abs then
jl x3 ; return;
rs. w1 f25. ; last abs:=abs word addr;
rx w0 x1 ; swop abs word, segment(abs word addr);
sh. w1 (f26.) ; if abs word addr<=top point then
jl x3 ; return;
rx w0 x1 ; swop abs word, segment(abs word addr);
a40: ds. w1 b41. ; half down: w1=result of abs or point store,
rl. w1 f7. ; w0=segment(last abs), save.
ws. w1 f14. ; w1:=left on segment:=top instr-last const
bs. w1 j0. ; -w3 claim;
ls w1 -2 ;
ls w1 1 ; displacement:=left on segment//4*2;
hs. w1 b17. ; at least 2 words are free (instr+abs word).
rl. w2 f14. ; w2:=last const;
a41: sh. w2 (f26.) ; rep: if w2>top point then
jl. a42. ; begin
dl w1 x2 ; double segm(w2+displacement):=
b17=k+1; displacement; double segm(w2);
ds w1 x2+0 ;
al w2 x2-4 ; w2:=w2-4; goto rep
jl. a41. ; end;
a42: dl. w1 f26. ; adjust moveable part:
ba. w0 b17. ; w0:=point base:=point base+displacement;
ba. w1 b17. ; w1:=top point:=top point+displacement;
ds. w1 f26. ;
rl. w1 f14. ;
ba. w1 b17. ; w1:=last const:=last const+displacement;
rs. w1 f14. ;
dl. w1 b41. ; w1:=saved w1;
rs. w0 (f25.) ; segment(last abs):=saved abs word;
al. w2 c0. ; w2:=stepping stone;
rl w0 x2+e9+2-c0;
ba. w0 1 ; total moves:=pass inf 2:=total moves+1;
rs w0 x2+e9+2-c0;
jl x3 ; return;
0 ;
b41: 0 ; work for half up, half down, save w0-1
\f
; rc 12.2.1971 algol 6, pass 8, page ...29...
c36: rl. w2 f14. ; store string:
al w2 x2+4 ; w2:=const addr:=last const+4;
jl. a51. ; skip.
c13: rl. w2 b20. ; const store: w2:=const addr;
a51: al w1 x2 ;
ws. w1 f23. ; w1:=rel const addr:=const addr-point base;
sh. w2 (f14.) ; if const addr<=last const then
jl x3 ; return;
rs. w3 b18. ; save return;
rs. w2 f14. ; last const:=const addr;
ba. w2 j0. ;
am. (f7.) ;
sl w2 +2 ; if last const+w3 claim>top instr then
jl. w3 a52. ; half up;
dl. w0 f13.+2; w3-0:=constant;
rx. w1 f14. ; swop rel const addr, last const;
rs w0 x1 ; segm(last const):=last of lit;
bl. w2 f4.+1 ;
sl w2 4 ; if opand rel=long lit then
rs w3 x1-2 ; segm(last const-2):=first of lit;
rx. w1 f14. ; swop last const, rel const addr;
jl. (b18.) ; return;
a52: rl. w0 (f25.) ; half up: w1 saved, w3=return; w0:=segm(last abs);
ds. w1 b41. ; save w0-1. prepare adjust moveable part.
rl. w1 f14. ;
ws. w1 f7. ; w1:=claimed:=last const-top instr
ba. w1 j0. ; +w3 claim;
rs. w1 b20. ;
wa. w1 f25. ; w1:=-left on segment:=claimed+last abs
ws. w1 f26. ; -top point;
ls w1 -2 ;
ls w1 1 ; w1:=displacement:=(-left on segment)//4*2
ws. w1 b20. ; -claimed;
hs. w1 b17. ; set displacement;
hs. w1 b21. ;
rl. w2 f26. ; w2:=top point;
a53: sl. w2 (f14.) ; rep: if w2>=last const then
jl. a42. ; goto adjust moveable part;
al w2 x2+2 ; w2:=w2+2;
rl w1 x2 ;
b21=k+1; displacement; segm(w2+displacement):=
rs w1 x2-0 ; segm(w2);
jl. a53. ; goto rep;
\f
; rc 12.2.1971 algol 6, pass 8, page ...30...
c16: rs. w3 b12. ; chain app: w2=appetite, w3=return;
b34=k+1 ;
al w0 0 ; save return, common with w3 chain app.
rl. w1 f15. ; w0:=ext no.; w1:=segment base;
a69: al w1 x1+2 ; rep: w1:=abs word addr:=w1+2;
bl w3 x1 ; w3:=left part of abs word;
sh. w1 (f25.) ; if abs word addr<=last abs
sn w0 x3 ; and ext no<>left part of abs word
jl. a68. ; then
jl. a69. ; goto rep;
a68: sh. w1 (f25.) ; if abs word addr>last abs then
am -2 ;
al w2 x2+2 ; w2:=appetite:=w2+2;
ls w0 12 ; w0:=new abs word:=ext no shift 12;
ds. w1 b16. ; save abs word, abs word addr;
jl. c17. ; goto w3 chain app;
c20: ba. w2 j0. ; test: w2=appetite, w3=return;
wa. w2 f14. ; if appetite+w3 claim+last const
ws. w2 f26. ;
wa. w2 f25. ; -(top point-last abs)
sh. w2 (f7.) ; >top instr then return segment exceeded;
jl x3+2 ; return appetite accepted;
jl x3 ;
c21: rs. w3 b24. ; test and change: w2=appetite, w3=return;
jl. w3 c20. ; save return; if test then
jl. a59. ; goto change;
rl. w3 b24. ;
jl x3+2 ; return appetite accepted;
b24: 0 ; saved return
c22: rs. w3 b24. ; change segment: save return
a59: ds. w1 b25. ; change: save w0-1;
jl. w3 c41. ; clear w3;
rl. w0 f17. ; fill unused points. w0:=dummy point. 1<23.
rl. w1 f25. ; w1:=fill addr:=last abs;
a61: sl. w1 (f26.) ; rep: if fill address<top point then
jl. a60. ; begin
al w1 x1+2 ; fill addr:=fill addr+2;
rs w0 x1 ; segment(fill addr):=dummy point;
jl. a61. ; goto rep
a60: rl. w1 f23. ; end;
ws. w1 f15. ; ( used in load boolean)
hs. w1 b27. ; rel point base:=point base-segment base;
al w1 x1-2 ; segment byte(0):=point base-2-segment base;
hs. w1 (f15.) ;
rl. w1 f23. ; modify references from point to constants.
al w1 x1-23 ; w1:=point base-23. w1 is the byte address
al w2 0 ; corresponding to bit 22 of modifier table(0).
h. al w0 , bs w1 x3 ;
w. jl. w3 a62. ; w2:=base of modifier table; w0:=add distance;
2<12 +0 ; modify, modifier table increment=2;
\f
; jz 1979.09.13 algol 8, pass 8, page ...31...
; modify references from instructions to moveable part
rl. w1 f15. ;
al w1 x1+503 ; w1:=segment base+503. w1 is the byte address
al w2 44 ; corresponding to bit 22 of modifier table(44).
h. al w0 , ba w1 x3 ;
w. jl. w3 a62. ; w2:=last of modifier table; w0:=subtr dist;
-2<12 +0 ; modify, modifier table increment=-2;
; first part of modifier table was cleared in previous call (this is utili-
; sed for easy scan now). rest is cleared in this call.
jl. w3 c44. ; store line inf;
rl. w2 f15. ; w2:=segment base;
rl. w1 f25. ; segment byte(1):=last abs-segment base;
ws. w1 f15. ;
hs w1 x2+1 ;
rl. w1 f14. ;
ws. w1 f15. ; pass inf1:=pass inf1+last const-segment base;
al. w3 c0. ; w3:=stepping stone to gpa;
wa w1 x3+e9-c0 ;
rs w1 x3+e9-c0 ;
ac w1 x2-2 ;
wa. w1 f7. ; jump:=jump, top instr+2-segment base;
hs. w1 f30.+1 ;
jl. c98. ; change out segment;
c97: rs. w3 f15. ; after change: segment base:=w3;
rl. w1 f28. ;
ld w1 30 ; double segment(506):=prev line shift(24+6);
ds w1 x3+e39-6 ;
j3=k+1; segment type, initially main program.
al w2 2 ; double segment(510):=segment type;
ds w2 x3+e39-2 ;
al w0 3 ; line inf shifts:=3;
hs. w0 j1. ; w0=3, used in test uncondit jump, below.
al w1 x3+e39-2 ; line alarm addr:=last on segment;
rs. w1 f29. ;
al w1 x3+e39-36 ; line block:=last on segment-17 words;
rs. w1 f27. ;
b27=k+1; rel point base, initially 1/4 segment ;
al w1 x3+e39>2 ; w1:=point base:=segment base+rel point base;
al w2 x1-2 ; w2:=top point
ds. w2 f26. ; :=last const:=point base-2;
rs. w2 f14. ;
rs. w3 f25. ; last abs:=segment base;
bl. w1 f24. ;
al w1 x1-1 ; current segment:=current segment-1;
hs. w1 f24. ;
al w1 x3+e39-10 ; w1:=top instr:=last on segment-4 words;
rs. w1 f7. ;
j4=k+1; uncondit jump, initially true;
sh w0 3 ; if 3>uncondit jump then
jl. a55. ; begin
rl. w0 f30. ;
rs w0 x1 ; segment(top instr):=jump;
al w1 x1-2 ; top instr:=top instr-2;
rs. w1 f7. ;
rl. w0 f16. ;
jl. w3 c6. ; w3 abs appetite (1<23+1<12);
jl. w3 c7. ; set w3 abs;
\f
; rc 12.2.1971 algol 6, pass 8, page ...32...
a55: dl. w1 b25. ; end; reestablish w0-1;
rl. w2 f17. ; segment(0):=1 shift 23;
rs. w2 (f15.) ;
hs. w2 j4. ; uncondit jump:=false;
jl. (b24.) ; return;
0 ;
b25: 0 ; saved w0-1.
a62: hs. w0 b29. ; modify: bs ba:=w0; w2=modifier ind
a64: rs. w1 b28. ; next pattern: segment addr:=w1;
a57: rl. w0 x2+g2. ; normalize: w0:=modifier pattern:=
sn w0 0 ; modifier table(modifier index);
jl. a63. ; if mod pattern<>0 then
ns w0 x3+1 ; begin call1:=distance to next;
la. w0 f31. ; modifier table(modifier index):=
rs. w0 x2+g2. ; normalized pattern-bit 22;
b29: bs w1 x3+1; or ba; w1:=w1+-distance to next;
bl w0 x1 ;
wa. w0 f23. ; segment byte(w1):=segment byte(w1)
lo. w0 1 ; + point base + 1 (if even);
hs w0 x1 ;
jl. a57. ; goto normalize
a63: rl. w1 b28. ; end; w1:=segm addr;
sh. w1 (f26.) ; if segm addr<=top point then
jl x3+2 ; return;
al w1 x1-23 ; w1:=segm addr:=segm addr-23;
ba w2 x3 ; w2:=modifier index:=modifier index+call 0;
jl. a64. ; goto next pattern;
b28: 0 ; segm addr
c28: ac w1 x1+2 ; set point modifier: w1=rel point addr.
jl. a65. ; w1:=-(2+rel point addr); goto set;
c27: rl. w1 f7. ; set modifier: w1:=top instr;
c87: ws. w1 f15. ; set byte modifier: w1=top instr-1.
al w1 x1+26 ; w1:=w1-segment base+26;
a65: al w0 0 ; set: w0=bit position:=w1 mod 23;
wd. w1 f32. ; w1:=modifier index:=w1//23*2;
ls w1 1 ;
al w2 1 ;
ls w2 (0) ; modifier table(modifier index)
wa. w2 x1+g2. ; :=modifier table(modifier index)
rs. w2 x1+g2. ; +1 shift bit position;
jl x3 ; return;
; modifier table contains one bit for each byte on a segment, stored with
; 23 bits a word. the first part of the table corresponds to point bytes
; referencing constants, the second part to instructions referencing points
; and constants. bit=1 designates a byte to be modified with the final
; value of point base+1. the bits are allocated like this:
; bit 22 bit 0
; g2: point base-23 point base-1
; g2+2:point base-46 point base-24
; g2+42: 480 458
; g2+44: 503 481
\f
; fgs 1987.06.18 algol 6, pass 8, page ...33...
b. a2, b13 ;
w.
; print instr:
c43: ds. w1 b12. ; call: w0 : instr, w1 : addr-2, w3 : link,
ds. w3 b13. ; save registers;
al w1 x1+2 ;
ws. w1 f15. ; w0:=rel address:=top instr+2-segment base;
rx w1 0 ; w1:=instr;
al. w2 c0. ; w2:=stepping stone to gpa;
al w3 10 ;
rs w3 x2+e42-c0 ; print count:=10;
jl w3 x2+e16-c0 ; print byte(rel address);
el. w0 f24. ;
jl w3 x2+e14-c0 ; write integer(current segm,
1<23+32<12+6 ; blanks, max 6 positions);
al w3 0 ;
al w0 x1 ; w0:=instr;
ld w0 6 ; w3:=basic oparation part
ls w3 1 ; *2;
rl. w1 x3+b0. ;
rs. w1 b1. ; text1:=mnemonics(basic oparation part);
al w3 0 ;
ld w0 3 ; w3:=w part and relative mark
ls w3 1 ; *2;
rl. w1 x3+b6. ;
rs. w1 b2. ; text 2:=w table(w3);
rl. w1 b8. ;
sh w0 -1 ;
rl. w1 b9. ; end text:=if relative mark then
rs. w1 b5. ; <:)nl:> else <:nl:>;
al w3 0 ;
ld w0 3 ; w3:=indirect and xpart
ls w3 1 ; *2;
rl. w1 x3+b7. ;
rs. w1 b3. ; text3:=xtable(w3);
rl. w1 b10. ; w1:=sign:=<:+:>;
sl w0 0 ; if displacement<0 then
jl. a0. ; begin
rl. w1 b11. ; w1:=sign:=<:-:>;
ac w0 (0) ; displacement:=-displacement
a0: ls w0 -12 ; end;
rs. w1 b4. ; text4:=sign;
al. w1 b1. ;
jl w3 x2+e13-c0 ; writetext(text1 to 4);
jl w3 x2+e14-c0 ; writeinteger(displacement,nuls,max 4 pos.);
0<12 +4 ;
al. w1 b5. ;
jl w3 x2+e13-c0 ; writetext(end text);
dl. w1 b12. ;
dl. w3 b13. ; restore registers;
jl x3 ; return;
b1:0,b2:0,b3:0,b4:0,b5:0 ; text 1,...text 4, end text
b6:<: w0.w0 w1.w1 w2.w2 w3.w3:>; w table
b7:<: x1 x2 x3( (x1(x2(x3:>; x table
b8:<: :>, b9: <:):> ; end texts
b10:<:+:> , b11:<:-:> ; sign of displacement
0 ;
b12: 0 ; saved w0, w1;
0 ;
b13: 0 ; saved w2, w3;
b0: <: 0 do el hl la lo lx wa ws am wm al xi jl jd je:> ; mnemonics
<: xl es ea zl rl sp re rs wd rx hs xs gg di ap ul:> ;
<: ci ac ns nd as ad ls ld sh sl se sn so sz sx gp:> ;
<: fa fs fm ks fd cf dl ds aa ss dp mh lk ix 62 63:> ;
e. ; end test mode
\f
; jz 1982.06.22 algol 8, pass 8, page ...34...
; main control table 1.
; each entry consists of: 12 bits called instr and usually used as the
; first part of a generated instruction, 6 bits called modifier, and
; 6 bits designating a central action. central actions with an even
; number will interprete the preceeding table word afterwards, while
; odd central actions will return to next in. the comment to the entry
; describes the actual meaning of these 3 parts.
; content of entry: meaning of:
; instr modif central action instr (modifier)
g1 = k + 1, h.
g0:
c33.+4096,b5<6-b1<6+3;0 ,zone addressing: call zone addr(global zone entry)
c30.+4096,b6<6-b1<6+3;2 ,local indirect: call local ind(local ind,entry)
c31.+4096,b7<6-b1<6+3;4 ,x1 addressing: call x1 addr(x1 addr entry)
c32.+4096,b4<6-b1<6+3;6 ,uv: call uv(ext or uv entry)
g84 ,0<6 +16; 8, string first: cont g84, test(0)
c38.+4096,4<6 +5; 10, string next: input(4 bytes), call string next
c37.+4096,4<6 +5; 12, long literal: input(4 bytes), call literal(0)
c37.+4096,2<6 +5; 14, med literal: input(2 bytes), call literal(2)
c37.+4096,1<6 +5; 16, short literal: input(1 byte), call literal(3)
c40.+4096,2<6 +5; 18, zone base: input(2 bytes), call zone base
c45.+4096, 18; 20, beg block: clear w3, call beg block
; cont g3 or g4
c46.+4096, 18; 22, beg proc: clear w3, call beg proc.
; cont g3 or g4
g6 ,18<6 +20; 24, end block: clear w3, cont g6, test(18)
g7 ,18<6 +20; 26, end zone block: clear w3, cont g7, test(18)
g100 ,18<6 +20; 28, exit block clear w3, cont g100, test(18)
jl. () ,8<6 +9; 30, exit proc no type:store instr+rsentry(endaddrexpr)
g8 ,24<6 +16; 32, exit type proc: cont g8, test(24)
c54.+4096, 19; 34, label colon: clear w3, call define label
bz w1 , 1; 36, bz w1 opand store opand+instr+0
rl w1 ,0<6 +23; 38, rl(al) w1 opand may be short lit(0)
dl w1 , 1; 40, dl w1 opand store opand+instr+0
g43 ,2<6 +16; 42, load point cont g43, test(dummy)
ba w1 , 1; 44, ba w1 opand store instr+opand+0
wa w1 ,1<6 +23; 46, wa w1(al w1 x1)+opand store instr+opand
aa w1 , 1; 48, aa w1 opand store opand+instr+0
fa w1 , 1; 50, fa w1 opand store opand+instr+0
ws w1 ,2<6 +23; 52, ws w1(al w1 x1-)+opand store opand+instr
ss w1 , 1; 54, ss w1 opand store instr+opand+0
fs w1 , 1; 56, fs w1 opand store opand+instr+0
wm w1 , 1; 58, wm w1 opand store opand+instr+0
fm w1 , 1; 60, fm w1 opand store opand+instr+0
wd w1 , 1; 62, wd w1 opand store opand+instr+0
fd w1 , 1; 64, fd w1 opand store opand+instr+0
g9 ,22<6 +20; 66, long div clear w3, cont g9, test(call)
rl w1 ,0<6 +13; 68, mod store instr+0
g32 ,22<6 +20; 70, long mod clear w3, cont g32, test(call)
g31 ,22<6 +20; 72, long mult clear w3, cont g31, test(call)
hs w1 , 1; 74, hs w1 opand store opand+instr+0
rs w1 , 1; 76, rs w1 opand store opand+instr+0
ds w1 , 1; 78, ds w1 opand store opand+instr+0
g11 ,4<6 +16; 80, abs int cont g11, test(sh, ac w1)
g10 ,10<6 +16; 82, abs long cont g10, test(sl,jl.,ld,ss)
g12 ,8<6 +16; 84, abs real cont g12, test(sl,fm,-1.0)
\f
; rc 12.06.1975 algol 6, pass 8, page ...35...
; main control table 2
ac w1 x1 , 0<6 +13; 86, ac w1 x1 store instr+0
ac w1 , 7; 88, ac w1 addropand store addr opand+instr+0
al w0 , 0<6 +13; 90, al w0 0 store instr+0
la w1 , 0<6 +13; 92, la w1 0 store instr+0
la w1 , 1; 94, la w1 opand store opand+instr+0
lo w1 , 1; 96, lo w1 opand store opand+instr+0
g91 , 6<6 +20; 98, lx w1 opand clear w3, cont g91, test(se,lx)
cf w1 , 0<6 +13; 100, cf w1 0 store instr+0
ci w1 , 0<6 +13; 102, ci w1 0 store instr+0
g76 ,22<6 +20; 104, float long clear w3, cont g76, test(call)
g88 ,22<6 +20; 106, long round clear w3, cont g88, test(call)
g13 , 2<6 +16; 108, shift short cont g13, test(dummy)
ls w1 , 7; 110, ls w1 addropand store addr opand + instr + 0
ld w1 , 7; 112, ld w1 addropand store addr opand + instr + 0
g14 , 2<6 +16; 114, create mask cont g14, test(dummy)
lo w0 , 2<6 +13; 116, lo w0 2 store instr+2
al w0 , 1; 118, prep uv op store opand+instr+0
g15 ,22<6 +20; 120, **integer clear w3, cont g15, test(call)
g16 ,22<6 +20; 122, **real clear w3, cont g16, test(call)
sh w1 , 28; 124, sh w1 opand skip opand(sh w1), cont g18-g21
sl w1 , 28; 126, sl w1 opand skip opand(sl w1), cont g18-g21
se w1 , 28; 128, se w1 opand skip opand(se w1), cont g18-g21
sn w1 , 28; 130, sn w1 opand skip opand(sn w1), cont g18-g21
sl w1 , 1<6 +34; 132, sl w1 1 skip direct(sl w1),cont g18-g21
sh w1 ,-1<6 +34; 134, sh w1 -1 skip direct(sh w1),cont g18-g21
sz w1 , 1<6 +34; 136, sz w1 1 skip direct(sz w1),cont g18-g21
so w1 , 1<6 +34; 138, so w1 1 skip direct(so w1),cont g18-g21
sn w0 , 0<6 +34; 140, sn w0 0 skip direct(sn w0),cont g18-g21
se w0 , 0<6 +34; 142, se w0 0 skip direct(se w0),cont g18-g21
sl w0 , 1<6 +34; 144, sl w0 1 skip direct(sl w0),cont g18-g21
sl w0 , 0<6 +34; 146, sl w0 0 skip direct(sl w0),cont g18-g21
sh w0 ,-1<6 +34; 148, sh w0 -1 skip direct(sh w0),cont g18-g21
sh w0 , 0<6 +34; 150, sh w0 0 skip direct(sh w0),cont g18-g21
sl w1 , 0<6 +34; 152, sl w1 0 skip direct(sl w1),cont g18-g21
bl w0 , 2<6 +13; 154, bl w0 2 store instr+2
bl w0 , 0<6 +13; 156, bl w0 0 store instr+0
ld w1 ,f63<6+11; 158, shift long -65 store instr+work(=-65)
g92 , 6<6 +20; 160, lx w0 opand clear w3, cont g92, test(se,lx)
c62.+4096, 0<6 + 3; 162, boolean call set condition(0)
c62.+4096, 2<6 + 3; 164, cond jump call set condition(2)
c62.+4096, 4<6 + 3; 166, cond bypass call set condition(4)
-6+1 , 2<6 +31; 168, bypass abs test(2), jump(top-6), uncond. jump
-4+1 , 2<6 +31; 170, do abs test(2), jump(top-2), uncond. jump
c66.+4096, 2; 172, take forlab call take forlab, may continue g22
c69.+4096, 19; 174, bypass label clear w3, call stack point
g23 , 2<6 +16; 176, goto bypass cont g23, test(dummy)
g24 , 0<6 +20; 178, end do clear w3, cont g24, test(0)
g25 , 0<6 +20; 180, end single do clear w3, cont g25, test(0)
c71.+4096, 3; 182, for,if call unstack 3
c72.+4096, 2; 184, step call step, cont g26 or g27
c73.+4096, 2; 186, test first call test first, cont g28
g29 , 0<6 +20; 188, else clear w3, cont g29, test(0)
g30 , 0<6 +20; 190, end else clear w3, cont g30, test(0)
jl x3 , 25; 192, goto local store instr + ext chain
g33 , 6<6 +16; 194, goto computed cont g33, test(sl,jl,abs)
\f
; rc 13.07.71 algol 6, pass 8, page ...36...
; main control table 3
g34 , 6<6 +20; 196, take formal clear w3, cont g34,test(so,jl,abs)
g35 , 6<6 +20; 198, take int value clear w3, cont g35,test(rl,sz,cf)
g36 , 6<6 +20; 200, take real value clear w3, cont g36,test(rl,so,ci)
g38 , 2<6 +16; 202, take zone array cont g38, test(dummy)
c75.+4096, 18; 204, take array clear w3, call take array,cont g39
g40 ,10<6 +48; 206, test index cont g40, test(ls,sh,sh,jl,abs)
; clear
as w1 , 0<6 +13; 208, shift 0 store instr+modifier
as w1 , 1<6 +13; 210, shift 1 store instr+modifier
as w1 , 2<6 +13; 212, shift 2 store instr+modifier
g41 , 8<6 +48; 214, test zone index cont g41, test(sh,sh,jl,abs)
; clear
g42 , 2<6 +20; 216, init zones clear w3, cont g42, test(dummy)
sh w1 () , 4<6 + 1; 218, record check store opand+instr+4
sh w1 , 0<6 +13; 220, record check 0 store instr+0
sh w1 , 1<6 +13; 222, record check 1 store instr+0
sh w1 , 3<6 +13; 224, record check 3 store instr+3
g54 ,10<6 +48; 226, index alarm cont g54, test(10), clear w3
g61 , 2<6 +16; 228, field check cont g61, test(dummy)
sl w0 x1 , 0<6 +13; 230, field check 0 store instr+0
sl w0 x1 ,-1<6 +13; 232, field check 1 store instr-1
sl w0 x1 ,-3<6 +13; 234, field check 3 store instr-3
g62 ,12<6 +48; 236, field alarm cont g62, test(12), clear w3
g44 , 2<6 +16; 238, load zone segm cont g44, test(dummy)
g45 , 2<6 +20; 240, reserve array clear w3, cont g45, test(dummy)
c78.+4096, 18; 242, stop clear w3, call stop, cont g46
e1. +4096, 3; 244, new line call pass 0 carret
c79.+4096, 19; 246, end pass clear w3, call end pass
c88.+4096, 4<6 + 5; 248, end external input 4 bytes, call end external
g47 , 0<6 +20; 250, end case lit clear w3, cont g47, test(0)
g48 , 0<6 +20; 252, end case var clear w3, cont g48, test(0)
g49 , 0<6 +20; 254, case lit clear w3, cont g49, test(0)
g50 , 0<6 +20; 256, case var clear w3, cont g50, test(0)
g55 ,26<6 +20; 258, of clear w3, cont g55, test(lookup)
g56 ,26<6 +20; 260, switch clear w3, cont g56, test(lookup)
g66 , 0<6 +20; 262, end call clear w3, cont g66, test(0)
c90.+4096, 18; 264, begin param clear w3, call beg param
; cont g64, g65
g67 , 6<6 +20; 266, begin call clear w3, cont g67, test(rl abs, ds)
g68 ,10<6 +16; 268, test mult test(sh,am,se,jl abs), cont g68
c41.+4096, 3; 270, load w3 call clear w3
g85 , 2<6 +16; 272, store base cont g85, test(dummy)
g86 , 2<6 +16; 274, get dope rel cont g86, test(dummy)
se w1 , 0<6 +13; 276, se w1 0 store instr+modifier
se w0 , 0<6 +13; 278, se w0 0 store instr+modifier
lo w1 , 0<6 +13; 280, lo w1 0 store instr+modifier
\f
; jz.fgs 1987.06.18 algol 8, pass 8, page ...37...
g69 ,20<6 +44; 282+ 0, end zone param end param(20+type), cont g69
g70 , 44; + 2, end formal param : end param(dummy), cont g70
g71 ,13<6 +44; + 4, end zone array - : end param(13+type), cont g71
g72 , 0<6 +44; + 6, end proc - : end param(0+type) , cont g72
g72 , 8<6 +44; + 8, end proc nopar - : end param(8+type) , cont g72
g73 ,24<6 +44; +10, end simple - ; end param(24+type), cont g73
g74 ,24<6 +44; +12, end literal - : end param(24+type), cont g74
g75 ,24<6 +44; +14, end label - : end param(24+type), cont g75
c92.+4096, 2; +16, end array - : call end array param,cont g69
g77 ,20<6 +44; +18, end zone expr - : end param(20+type), cont g77
g78 ,24<6 +44; +20, end addr expr - : end param(24+type), cont g78
g79 ,24<6 +44; +22, end value expr - : end param(24+type), cont g79
c109.+4096, 2; +24, end array field- : call end array field param,contg87
g80 , 8<6 +44; +26, end subscr. expr-: end param(8+type) , cont g80
g81 , 8<6 +44; +28, end register exp-: end param(8+type) , cont g81
g82 , 8<6 +44; +30, end uv expr - : end param(8+type) , cont g82
g93 ,10<6 +20; 314 , disable activity, clear w3, test(se,jl,abs), cont g93
g94 ,10<6 +20; 316 , enable activity , clear w3, test(se,jl,abs), cont g94
g96 ,10<6 +20; 318 , long compare , test(10),clearw3,cont g96
g98 , 6<6 +20; 320 , take long value , test(6), clear w3, cont g98
g37 , 0<6 +20; 322 , take formal block proc, test(0), cont g37
ix w1 , 0<6 +23; 324 , ix w1 opand , store opand+instr+0
g101 , 6<6 +20; 330-4 , doperellong____field, cont g101, test (ix, dope)
g102 , 6<6 +20; 330-2 , doperelint_____field, - g102, -
g103 , 6<6 +20; 330+0 , doperelboo__ix/field, - g103, -
g104 , 6<6 +20; 330+2 , doperelint__ix , - g104, -
g105 , 6<6 +20; 330+4 , doperellong_ix , - g105, -
\f
; jz 1982.06.22 algol 8, pass 8, page ...38...
; continuation table 1. format as main control table. the name of a section
; of words is placed at the end of the section (interpretation proceeds
; upwards)
c52.+4096, +19; define proc entry: clear w3,call define global
al w1 ,2<6 +10; al w1+block app: store instr+work(block app)
jl.w3( ) ,3<6 +46; jl.w3(reserve): clear w3+rs entry(reserve)
al w0 ,8<6 +10; al w0 block no.: store instr+work(block no.)
ds w1 x1 ,9<6 +10; ds w1 x1-bl.app-2: store instr+work(abs bl.app-2)
al w0 ,0<6 +12; al w0 0 store instr+0
rl.w3 () ,0<6 +52; rl.w3 (trapchain) store instr + rsentry(param)
91 ,0<6 +50; define param param := 91
ds w0 x1 ,7<6 +10; ds w0 x1+traplabel store instr+work(copy to)
k-g0 ,8<6 +20; test for al,rl.,ds clear w3,continue next,test(8)
c113.+4096, +2; call adjust copy to
rl w0 x2 ,5<6 +10; copy single word: store instr+work(copy from)
rs w0 x1 ,7<6 +10; copy single word: store instr+work(copy to)
c50.+4096, +2; call end copy
dl w0 x2 ,5<6 +10; copy double word: store instr+work(copy from)
ds w0 x1 ,7<6 +10; copy double word: store instr+work(copy to)
k-g0 ,4<6 +20; test for dl. ds : clear w3, continue(next), test(4)
c49.+4096, +2; call begin copy
g5=k-g0 ; copy display
rs w2 x1 ,6<6 +10; store old sref: store instr+work(new displ elem)
al w2 x1 ,3<6 +10; load new sref: store instr+work(abs bl.app)
g3=k-2-g0 ; enter inner block
g5 ,2<6 +16; cont(copy display),test(dummy)
al w2 x1 ,3<6 +10; load new sref: store instr+work(abs bl.app)
g4=k-2-g0 ; enter block-6
c56.+4096,1<6 +5; stack block app: input(1 byte),call end block
rs.w2 ( ),13<6 +8; rs.w2 (last used): store instr+rs entry(last used)
jl.w3 ( ),10<6 +46; jl.w3(rel zones): store instr+rs entry(rel zones)
am (x2) ,-4<6 +12; am (x2-4) store instr+modifier
rl w1 x2 ,-2<6 +12; rl w1 x2-2 store instr+modifier
rs.w1 () ,0<6 +52; rs.w1 (trapchain) store instr+rs entry(param)
91 ,0<6 +50; define param param := 91
g7=k-g0 ; end zone block
g6=k-g0 ; end block
rl w2 x2 ,11<6 +11; rl w2 x2+blockno store instr+work(current block)
g100=k-g0 ; exit block
dl w1 x2 , 15; dl w1 x2+proc value: store instr
c58.+4096, 2; call proc value
jl. ( ) ,6<6 +8; jl.(end regexpr): store instr+rs entry(end reg expr)
g8=k-g0 ; exit type proc
sl w0 ,0<6 +13; sl w0 0 store instr+0
jl. ,6<6 +12; jl. 6 store instr+6
ld w1 ,f63<6+10; ld w1 -65 store instr-65 (work(f63))
ss w1 ,0<6 +0; ss w1 opand store instr+opand+0
g10=k-g0 ; abs long
sh w1 ,-1<6 +13; sh w1 -1: store instr-1
ac w1 x1 ,0<6 +12; ac w1 x1: store instr+0
g11=k-g0 ; abs int
sh w0 ,-1<6 +13; sh w0 -1: store instr-1
fm w1 , 0; fm w1 opand: store opand+instr+0, opand=-1.0
g12=k-g0 ; abs real
bz w1 ,3<6 +13; bz w1 3: store instr+3
ls w1 , 6; ls w1 addr op: store addr opand+instr
g13=k-g0 ; shift short
al w0 ,0<6 +13; al w0 0: store instr+0
al w1 ,-1<6 +12; al w1 -1: store instr-0
ld w1 , 6; ld w1 addr op: store addr opand+instr
g14=k-g0 ; create mask
\f
; 3.3.1971 algol 6, pass 8, page ...39...
; continuation table 2.
al w1 , 1; al w1 exponent: store opand+instr+0
ds.w1( ) ,12<6 +8; ds w1 (uv): store instr+rs entry(uv)
g17=k-g0 ; continue from ** real,longdiv,longmod and longmult
jl w3 x3 ,2<6 +26; jl w3 x3+**integ: store instr+rs segm(**integ)
g15=k-g0 ; **integ
g17 ,2<6 +16; continue g17, test(dummy)
jl w3 x3 ,1<6 +26; jl w3 x3+**real: store instr+rs segm(**real)
g16=k-g0 ; **real
g21=k-g0 ; skip instr:
0 , 0 ; sh w1 addr opand, se w0 0, etc, inserted here
0 , 0 ; test(modif),jump(top-6) inserted here.
g20=k-2-g0 ; cond bypass
-6 ,0<6 +30; total app added test(total app),jump(top-6)
g21+2 ,2<6 +16; cont g21, test(dummy)
0 , 0 ; test(modif),jump(top-2) inserted here
g19=k-2-g0 ; cond jump
-2 ,0<6 +30; total app added test(total app), jump(top-2)
g21+2 ,2<6 +16; cont g21,test(dummy)
am ,1<6 +12; am 1 store instr+modifier
al w1 ,-1<6 +12; al w1 -1 store instr+modifier
0 , 0 ; cont next, test(modif) inserted here
g18=k-2-g0 ; boolean
g18 ,0<6 +16; total app added, cont next, test(total app)
rl.w0 , 37; rl.w0 forlab segm: store instr+segment abs
rl.w1 , 32; rl.w1<jl x3+forlab rel>: store instr+const
ds w1 , 0; ds w1 forlab work: store opand+instr+0
g22=k-2-g0 ; forlab
c48.+4096, 3; unstack point
-2+1 ,2<6 +30; test(2), jump(top-2), unconditional jump
g23=k-g0 ; goto bypass
c70.+4096,0<6 +3; stack 0 call stack modif(0)
rl w3 ( ),-2<6 +0; rl w3 (x2+forlab work): store opand+instr-2
jl ,0<6 +0; jl x2+forlab work: store opand+instr+0
k-g0 ,4<6 +20; clear w3,cont next, test(rl.jl)
c69.+4096, 2; call stack point
g24=k-g0 ; end do
c69.+4096, 3; stack point
rl w3( ) ,-2<6 +0; rl w3 (x2+forlab work):store opand+instr-2
jl ,0<6 +0; jl x2+forlab work:store opand+instr+0
k-g0 ,4<6 +20; clear w3,cont next, test(rl,jl)
c69.+4096, 2; call stack point
g25=k-g0 ; end single do
0 ,2<6 +31; test(2),jump(top+0)
g26=k-2-g0 ; constant step:
al w1 ,1<6 +13; store instr+modifier
rs w1 x2 ,0<6 +10; store instr+work(0)
g27=k-2-g0 ; variabel step
\f
; jz.fgs 1985.06.12 algol 8, pass 8, page ...40...
; continuation table 3
al w1 ,0<6 +13; al w1 0 store instr+modifier
rx w1 ,0<6 +0; rx w1 x2+var step store opand+instr+0
g28=k-2-g0 ; test first
bl w0 ,2<6 +13; bl w0 2 store instr+2
bl w0 ,0<6 +12; bl w0 0 store instr+0
g51=k-2-g0 ; convert int to long continue from else, case comma
ci w1 ,0<6 +13; ci w1 0 store instr+0
g52=k-2-g0 ; convert int to real continue from else, case comma
jl w3 x3 ,46<6 +27; jl w3 x3+floatlong store instr+rssegm(floatlong)
k-g0 ,8<6 +20; clear w3, test(8), cont next
g53=k-2-g0 ; convert long to real continue from else, case comma
c74.+4096,-5<6 +2; test top-5, may continue with g53,g52,g51 or terminate
-4 ,2<6 +30; test(2), jump(top-4)
c69.+4096, 2; stack new else call stack point
c48.+4096, 2; unstack else label call unstack
g29=k-g0 ; else
c74.+4096,-5<6 +3; test top-5, may continue with g53,g52,g51 or terminate
c69.+4096, 2; stack else label call stack point
c69.+4096, 2; stack end else label call stack point
c82.+4096, 2; stack(total type) call stack inbyte
g30=k-g0 ; end else
sl w0 ,1<6 +13; sl w0 1 store instr+modifier
jl.w3 () ,11<6 +8; jl. (goto computed) store instr+rs entry(goto comp)
g33=k-g0 ; goto computed
dl w1 ,0<6 +1; dl w1 formals store opand+instr+0
so w0 ,16<6 +12; so w0 16 store instr+modifier
jl.w3 ( ),4<6 +8; jl. w3 (take expr): store instr+rs entry(take expr)
g34=k-g0 ; take formal
al w0 ,3<6 +13; al w0 3 store instr+modifier
la w0 ,-2<6 +0; la w0 formal-2 store instr+opand
jl.w3 () ,0<6 +52; jl. w3 (param) store instr+rs entry(param)
g99=k-g0 ;continue take value
96 ,0<6 +50; define param param := 96
g98=k-g0 ;take value long
g99 ,2<6 +16; cont (continue take value)
94 ,0<6 +50; define param param := 94
g35=k-g0 ;take value integer
g99 ,2<6 +16; cont (continue take value)
95 ,0<6 +50; define param param := 95
g36=k-g0 ;take value real
dl w1 ,0<6 + 1; dl w1 opand store opand+instr+0
ls w0 ,-4<6 +12; ls w0 -4 store instr+(-4)
g37=k-g0 ;take formal block proc
bl w1 ,-1<6 +1; bl w1 opand-1 store opand+instr-1
rs w1 ,-2<6 +0; rs w1 opand-2 store opand+instr-2
g38=k-g0 ; take zone array
rl w3 x1 ,0<6 +13; rl w3 x1 store instr+modifier
rs w3 x2 ,6<6 +10; rs w3 x2+dope rel-4: store instr+work6
k-g0 ,4<6 +20; clear w3, cont next, test(rl,rs)
ba w1 ,0<6 +12; ba w1 0 store instr+modifier
rl w0 x1 ,5<6 +10; copy single word store instr+work(copy from)
rs w0 x2 ,7<6 +10; copy single word store instr+work(copy to)
c50.+4096, 2; call end copy
dl w0 x1 ,5<6 +10; copy double word store instr+work(copy from)
ds w0 x2 ,7<6 +10; copy double word store work(copy to)
k-g0 ,4<6 +20; clear w3, cont next, test(dl,ds)
g39=k-g0 ; copy dope vector
\f
; rc 3.3.1971 algol 6, pass 8, page ...41...
; continuation table 4
sh w1 ( ),-2<6 +1; sh w1 (opand-2): store opand+instr-2
sh w1 ( ),0<6 +0; sh w1 (opand): store opand+instr+0
jl.w3 ( ),17<6 +8; jl.w3 (index): store instr+rs entry(index)
g40=k-g0 ; test index
sh w1 ( ),-2<6 +1; sh w1 (opand-2) store opand+instr-2
sh w1 ,0<6 +12; sh w1 0 store instr+modifier
jl.w3 ( ),18<6 +8; jl.w3 (zone): store instr+rs entry(zone)
g41=k-g0 ; test zone index
ds w1 ( ),12<6 +9; ds w1(uv) store instr+rs entry(uv)
rl.w1 ,9<6 +38; rl.w1 init zones store instr+ext point(initzones)
jl.w3 ( ),4<6 +8; jl.w3(take expr) store instr+rs entry(take expr)
g42=k-g0 ; init zones
rl w0 x2 , 41; rl w0 x2+block or al w0 x2: store instr+sref
rl.w1 ,0<6 +38; rl.w1 point of opand: store instr+ext point(0)
g43=k-g0 ; load point
al w0 ,15<6 +11; al w0 no of zones store instr+work(last of const)
c2.+4096 ,1<6 +4; input(no of zones), call dummy
al w1 ,0<6 +0; al w1 base of zones: store opand+instr+0
g44=k-g0 ; load zone segm
jl.w3 ( ),28<6 +47; jl.w3 (res array): clear w3+rs entry(res array)
rs w1 x2 ,-2<6 +12; rs w1 x2-2 store instr+modifier
g45=k-g0 ; reserve array
jl.w3 ( ),20<6 +9; jl.w3 (stop) store instr+rs entry(stop)
g46=k-2-g0 ; stop
c81.+4096, 3; stack, convert lit call case elem lit
c82.+4096, 2; stack(total type) call stack inbyte
c69.+4096, 2; stack end case call stack point
g47=k-g0 ; end case lit
c74.+4096,-7<6 +2; test top-7, may continue with g51,g52,g53 or term.
c83.+4096,0<6 +2; stack(0,dummy,dummy) call stack 3
c82.+4096, 2; stack(total type) call stack inbyte
c69.+4096, 2; stack end case call stack point
g48=k-g0 ; end case var
c81.+4096, 3; stack, convert lit call case elem lit
c80.+4096, 2; call begin case elem
g49=k-g0 ; case comma lit
c74.+4096,-7<6 +2; test top-7, may continue with g51,g52,g53 or term.
c83.+4096,0<6 +2; stack(0,dummy,dummy) call stack 3
-4+1 ,2<6 +30; test(2), jump(top-4) unconditional jump
c80.+4096, 2; call begin case elem
g50=k-g0 ; case comma var
\f
; jz 1979.06.08 algol 8, pass 8, page ...42...
; continue table 5.
sl w1 ,5<6 +11; sl w1 no.of elements+1:store instr+work(5)
g57=k-g0 ; constant for begin case list
jl.w3 ( ),19<6 +8; jl.w3 (case): store instr+rs entry(19)
k-g0 ,6<6 +16; cont next,test(sl,jl abs)
c85.+4096, 2; call first case look-up, cont g59
c80.+4096, 2; call begin case element
g55=k-g0 ; of
al w0 ,0<6 +13; al w0 0: store instr+modifier
sl w1 ,1<6 +12; sl w1 1: store instr+modifier
sl w1 ,5<6 +10; sl w1 no.of elements+1:store instr+work(5)
0 ,6<6 +30; jl end case: test(sl,sl,jl), jump(top+0)
c85.+4096, 2; call first case look-up, cont g59
c80.+4096, 2; call begin case element
g56=k-g0 ; of switch
c86.+4096, 2; call end case look-up, may cont g59
sh w1 ,3<6 +10; sh w1 index limit for segment: store instr+work(3)
g58=k-g0 ;
0 , 0; jl. end of segm or jl. w3(case) inserted here
bl.w1 x1 ,7<6 +10; bl.w1 x1+list base: store instr+work(7)
sl w1 ,0<6 +12; sl w1 0: store instr+modifier
jl. x1 ,0<6 +12; jl. x1: store instr+modifier
dl.w1 x1 ,-2<6 +12; dl.w1 x1-2: store instr+modifier
k-g0 ,0<6 +20; clear w3, cont next, test(dummy)
0 ,2<6 +30; jl end case: test(dummy),jump(top+0)
g59=k-2-g0 ; look-up suite
c69.+4096, 19; stack bypass: clear w3,call stack point
dl w1 , 0; dl w1 formal: store opand+instr
jl. ( ),5<6 +8; jl.(goto point): store instr+rs entry(5)
g63=k-g0 ; call formal proc
c69.+4096, 19; stack bypass: clear w3,call stack point
rl w2 x2 , 40; rl w2 x2+block: store instr+sref
jl x3 , 24; jump to proc: store instr+ext chain
c89.+4096,2<6 +4; input 2 bytes, call end call
c69.+4096, 2; stack return point: call stack point
g66=k-g0 ; end call
al w0 ,0<6 +13; al w0 0 store instr + modif
rl. w1 (),0<6 +52; rl. w1 (rsentry param) store instr+rs entry(param)
se w1 ,0<6 +12; se w1 0 store instr + modif
jl. w3 (),4<6 +8; jl. w3 (take expr) store instr+rs entry(modif)
g95=k-g0 ; disable/enable
90 ,0<6 +50; define param param := 90
g94=k-g0 ; enable
g95 ,2<6 +16; continue next,test(dummy)
89 ,0<6 +50; define param param := 89
g93=k-g0 ; disable
\f
; rc 3.3.1971 algol 6, pass 8, page ...43...
; continue table 6.
c69.+4096, 19; define bypass clear w3,call stack point
c48.+4096, 2; call unstack
g65=k-2-g0 ; define bypass
rl.w0 , 42; rl.w0 thunk point: store instr+latest point
k-g0 ,4<6 +16; cont next,test(point+instr)
al w3 x2 ,0<6 +12; al w3 x2 store instr+0
ls w3 ,4<6 +12; ls w3 4 store instr+4
al w3 x3 ,2<6 +10; al w3 x3+kind+type: store instr+work 2
c94.+4096,8<6 +2; ds w0 x1+formal: call store formal(app=8)
-2+1 ,2<6 +30; jl bypass : test(dummy), jump(top-2),uncondit
c52.+4096, 2; define thunk : call define global
g64=k-2-g0 ; thunk parameter
al w1 ,5<6 +11; al w1 call app: store instr+work5
jl.w3 ( ),3<6 +46; jl.w3 (reserve): clear w3+rs entry 3
rs w2 x1 ,0<6 +12; rs w2 x1: store instr+0
rl.w0 , 32; rl.w0 <-app-6,rel>: store instr+constant
rl.w3 , 36; rl.w3 return segm: store instr+segment abs
ds w0 x1 ,5<6 +12; ds w0 x1+5: store instr+5
c91.+4096, 2; call begin call
g67= k-g0 ; begin call
sh w1 ,-1<6 +13; sh w1 -1: store instr-1
am ,-1<6 +12; am -1: store instr-1
se w0 ,0<6 +12; se w0 0: store instr+0
jl.w3 ( ),25<6 +8; jl.w3 (mult alarm): store instr+rs entry 25
g68=k-g0 ; test mult
al w0 ,0<6 +1; al w0 opand: store opand+instr+0
c107.+4096,0<6 +2; call restore opand rel
rl.w3 , 32; rl.w3 <dope,kind>: store instr+constant
c94.+4096,6<6 +2; ds w0 x1+formal: call storeformal(app=4+constant)
g69=k-g0 ; simple zone param, array param
dl w0 ,0<6 +1; dl w0 opand: store opand+instr+0
c94.+4096,6<6 +2; ds w0 x1+formal: call storeformal(app=4+w3 claim)
g70=k-g0 ; formal param
dl w0 ,0<6 +1; dl w0 opand: store opand+instr+0
ls w3 ,12<6 +12; ls w3 12: store instr+12
al w3 x3 , 9<6 +10; al w3 x3+kind: store instr+work 9
c94.+4096,10<6 +2; ds w0 x1+formal: call storeformal(app=8+w3 claim)
g71=k-g0 ; zone array param
rl.w0 ,0<6 +39; rl.w0 ext point: store instr+ext point(opand)
rl w3 x2 , 40; rl w3 x2+block: store instr+sref
ls w3 ,4<6 +12; ls w3 4: store instr+4
al w3 x3 , 9<6 +10; al w3 x3+kind: store instr+work 9
c94.+4096,8<6 +2; ds w0 x1+formal: call store formal (app=8)
g72=k-g0 ; procedure param
al w0 ,0<6 +1; al w0 opand: store opand+instr
al w3 , 9<6 +10; al w3 kind: store instr+work 9
c94.+4096,4<6 +2; ds w0 x1+formal: call store formal (app=4)
g73=k-g0 ; simple param
dl w0 ,0<6 +1; dl w0 opand: store opand+instr
c95.+4096,8<6 +2; ds w0 x1+literal: call store lit(app=4+constant)
al w0 x1 ,2<6 +10; al w0 x1+literal: store instr+work2
al w3 , 9<6 +10; al w3 kind: store instr+work 9
c94.+4096,4<6 +2; ds w0 x1+formal: call store formal (app=4)
g74=k-g0 ; literal param
\f
; jz 1979.09.14 algol 8, pass 8, page ...44...
; continuation table 7
rl.w0 ,0<6 +39; rl.w0 ext point: store instr+ext point(opand)
rl w3 x2 , 40; rl w3 x2+block: store instr+sref
c95.+4096,4<6 +2; ds w0+literal: call store literal (app=4)
al w0 x1 ,2<6 +10; al w0 x1+literal: store instr+work 2
al w3 , 9<6 +10; al w3 kind: store instr+work 9
c94.+4096,4<6 +2; ds w0 x1+formal: call store formal(app=4)
g75=k-g0 ; label param
al w0 x1 ,0<6 +13; al w0 x1 : store instr+0
rl.w1 ( ),13<6 +8; rl.w1 (last used): store instr+rs entry13
rl.w3 , 32; rl.w3 <6,kind>: store instr+constant
c94.+4096,6<6 +2; ds w0 x1+formal: call storeformal(app=4+constant)
g77=k-g0 ; zone expr param
al w0 x1 ,0<6 +13; al w0 x1: store instr+0
rl.w1 ( ),13<6 +8; rl.w1 (last used): store instr+rs entry 13
al w3 , 9<6 +10; al w3 kind : store instr+work 9
c94.+4096,4<6 +2; ds w0 x1+formal: call store formal (app=4)
g78=k-g0 ; addr expr param
rl w3 ,0<6 +13; rl w3 0: store instr+0
al w0 x1 ,0<6 +12; al w0 x1: store instr+0
rl.w1 ( ),13<6 +8; rl.w1 (last used): store instr+rs entry 13
c95.+4096,10<6 +2; ds w0 x1+literal: call store literal (app=8+abs)
al w0 x1 ,2<6 +10; al w0 x1+literal: store instr+work2
al w3 , 9<6 +10; al w3 kind: store instr+work 9
c94.+4096,4<6 +2; ds w0 x1+formal: call store formal (app=4)
g79=k-g0 ; value expr param
al w1 ,-1<6 +13; al w1 -1 : store instr-1
rl.w0 , 14; rl.w0 string point: store instr
c27.+4096, 2; call set modifier
c39.+4096,4<6 +4; input(4 bytes), call string first
g84=k-g0 ; string first
al w0 ,-10<6+13; al w0 cause: store instr-10
jl.w3 ( ),21<6 +8; jl.w3 (alarm): store instr+rs entry 21
g83=k-g0 ; end run
lx w1 , 0<6 +1; lx w1 opand: store opand+instr
g91=k-g0 ; xorw1, may be preceded by se w1
lx w0 , 0<6 +1; lx w0 opand: store opand+instr
g92=k-g0 ; xorw0, may be preceded by se w0 or w1
al w3 , 0<6 +1; al w3 opand store instr+opand
lx w0 x3 ,-2<6 +12; lx w0 x3-2 store instr-2
lx w1 x3 , 0<6 +12; lx w1 x3 store instr
g96=k-g0 ; long compare
\f
; jz.fgs 1987.06.10 algol 8, pass 8, page ...45...
; continue table 8.
jl w3 x3 ,46<6 +27; jl. w3 (floatlong) store instr+rssegm(floatlong)
g76=k-g0 ; float long
jl w3 x3 ,43<6 +27; jl. w3 (longround) store instr+rssegm(longround)
g88=k-g0 ; long round
g17 ,2<6 +16; continue g17, test(dummy)
jl w3 x3 ,55<6 +26; jl w3 x3+longmult store instr+rssegm(longmult)
g31=k-g0 ; long mult
g17 ,2<6 +16; continue g17, test(dummy)
jl w3 x3 ,44<6 +26; jl w3 x3+longmod store instr+rssegm(longmod)
g32=k-g0 ; long mod
g17 ,2<6 +16; continue g17, test(dummy)
jl w3 x3 ,56<6 +26; jl w3 x3+longdiv store instr+rssegm(longdiv)
g9=k-g0 ; long div
jl.w3 ( ) ,17<6 +9; jl. w3 (indexalarm) store instr+rsentry 17
g54=k-g0 ; index alarm
jl.w3 ( ) ,54<6 +9; jl. w3 (fieldalarm) store instr+rsentry 54
g62=k-g0 ; field alarm
rl w0 ,2<6 +1; rl w0 opand store opand+instr+2
sh w1 ( ) ,-2<6 +0; sh w1 (opand-2) store opand+instr-2
g61=k-g0 ; field check
rl w0 ,0<6 +1; rl w0 arraybase store opand+instr+0
wa w0 ,2<6 +12; wa w0 2 store instr+2
rl.w1 ( ) ,13<6 +8; rl. w1 (last used) store instr+rsentry 13
c95.+4096 ,2<6 +2; ds w0 x1+literal call store literal (app=2)
g85=k-g0 ; store base
al w3 x1 ,2<6 +11; al w3 x1+literal store instr+work(2)
al w0 x3 ,-4<6 +12; al w0 x3-4 store instr - 4
rl.w3 , 32; rl. w3 <2,kind> store instr+constant
c94.+4096 ,10<6 +2; ds w0 x1+formal call store formal (app=8+cons)
k-g0 , 20; clear w3, cont next, test(0)
dl w0 ,0<6 +0; dl w0 dope store opand+instr+0
g86=k-g0 ; get dope rel
ws w3 ,0<6 +1; ws w3 field store opand+instr+0
ws w0 ,0<6 +0; ws w0 field store opand+instr+0
rx w3 ,0<6 +12; rx w3 0 store instr+modif
al w3 x3 ,f65<6+10; al w3 x3+<typel.-1> store instr+work f65
as w3 ,f64<6+10; as w3 <-log2(typel.)> store instr+work f64
as w3 ,f66<6+10; as w3 <log2(typel.)> store instr+work f66
rx w3 ,0<6 +12; rx w3 0 store instr+modif
c95.+4096 ,22<6 +2; ds w0 x1+literal call store literal (app=22)
g87=k-g0 ; store bounds
jl. ( ),8<6 +9; jl. (end addr expr): store instr+rsentry 8
g80=k-g0 ; subscr expr
jl. ( ),6<6 +9; jl. (end reg expr): store instr+rsentry 6
g81=k-g0 ; reg expr
jl. ( ),7<6 +9; jl. (end uv expr): store instr+rsentry 7
g82=k-g0 ; uv expr
c118.+4096,-2<6 + 3; call instr (datapart of ix)
g101=k-g0 ; datapart of ix instruction, long/real field
c118.+4096,-1<6 + 3; call instr (datapart of ix)
g102=k-g0 ; datapart of ix instruction, integer field
c118.+4096, 0<6 + 3; call store instr (datapart of ix)
g103=k-g0 ; datapart of ix instruction, boolean index/field
c118.+4096, 1<6 + 3; call store instr (data part of ix)
g104=k-g0 ; datapart of ix instruction, integer index
c118.+4096, 2<6 + 3; call store instr (data part of ix)
g105=k-g0 ; data part of ix instruction, long/real index
g2=k ; modifier table, g2 to g2+44
g60=g2+46 ; first element of stack
\f
; fgs 1987.05.13 algol 6, pass 8, page ...46...
; initialisation of pass 8.
w. a0=k-2047 ; define stepping stone
c100:al. w1 a0. ; entry pass 8: via stepping stone c99.
am -2047;
jl w3 x1+e2-a0+2047; w1:=stepping stone;
rs w2 x1+f10-a0 ; no.of exts:=inbyte(no of std procs);
rl w3 x1+e9+4-a0 ; w3:=last work for pass;
rs w2 x3 ; no. of catalog exts:=no of std procs;
rl w0 x1+f17-a0 ;
rs w0 x3-8 ; entry point:=1 shift 23; segment 0.
ls w0 -9 ;
rs w0 x3-2 ; item kind:=4,0;
al w0 0 ; kind and spec:=0; normal program.
rs w0 x3-6 ;
wm. w2 b40. ; w2:=first std proc:=
al w1 x3-12 ; no of std procs*(-12)+last work-12;
wa w2 2 ; w1:=last work-12;
rs. w2 b40. ;
sh. w2 b40. ; if first std proc<=last of pass 8 then
jl. a91. ; goto stack alarm;
b. f10, b2 w. ; compute date and clock
rs. w1 b1. ; save w1;
jd 1<11+36 ; w0-1:=get clock;
nd w1 3 ; w0-1:=secs:=
fd. w1 f8. ; fix(float(clock)/10 000);
bl w2 3 ;
ad w1 x2-47 ;
wd. w1 f6. ; w1:=day:=secs//(60*60*24);
al w3 0 ; w3-0:=secs:=secs mod (60*60*24);
wd. w0 f1. ; w3-0:=minutes:=secs//60;
ld w3 24 ; w2:=second:=secs mod 60;
wd. w0 f1. ; w0:=hour:=minutes//60;
rs. w3 b0. ; work0:=minute:=minutes mod 60;
wm. w0 f2. ;
wa. w0 b0. ;
wm. w0 f2. ;
wa w0 4 ; w0:=clock:=(hour*100+minute)*100+second;
am. (b1.) ;
rs w0 +2 ; core(last work-10):=clock;
\f
; rc 1976.06.29 algol 6, pass 8, page ...47...
ld w1 26 ;
wa. w0 f7. ;
al w3 0 ; w0:=year:=(days*4+99111)//1461;
wd. w0 f4. ; w3:=days:=((days*4+99111)mod 1461)//4;
as w3 -2 ;
wm. w3 f0. ;
al w3 x3+461 ;
wd. w3 f3. ; w3:=month:=(days*5 + 461)//153;
al w1 x2+5 ; w1:=day:=(days*5 + 461)mod 153 + 5;
sl w3 13 ; if month>13 then
al w3 x3+88 ; month:=month-twelvemonth+oneyear;
wm. w3 f2. ; month:=month*100;
rx w2 0 ;
wd. w1 f0. ; day:=day//5;
wa w3 2 ; date:=day+month;
wm. w2 f5. ; year:=year*10000;
wa w3 4 ; date:=date+year;
rl. w1 b1. ;
rs w3 x1 ; reestablish w1; core(last work-12):=date;
jl. a92. ; continue
f0: 5 ;
f1: 60 ;
f2: 100 ;
f3: 153 ;
f4: 1461 ;
f5: 10000 ;
f6: 86400 ; 60*60*24
f7: 99111 ; to adjust for 1.1.68 being start date
10000<9 ;
f8: 4096+14-47 ; 10000*2**(-47) as floating point number
b0: 0 ; work0, saved minute
b1: 0 ; saved w1
e. ; end date and clock
\f
; fgs 1987.06.18 algol 6, pass 8, page ...48...
a92: am -2047 ; rep:
am -2047 ;
am. a0.+2047 ;
jl w3 e2-a0+2047; inbyte;
sh. w1 (b40.) ; if w1>first std proc then
jl. a93. ; begin
al w1 x1-1 ; w1:=w1-1;
hs w2 x1 ; std proc suite:=byte read;
jl. a92. ; goto rep;
a93: am -2047 ; end;
al. w1 a0.+2047 ; w1 := stepping stone;
am (x1+e9+4-a0) ;
hs w2 +0 ; no.of points:=byte read;
al w0 -2 ;
wa. w0 b40. ; last global:=first std proc-2;
rs w0 x1+f62-a0 ;
ac w3 x2+1 ;
ls w3 1 ; global base:=-(no of points+1)*2
wa. w3 b40. ; + first std proc;
rs w3 x1+f33-a0 ;
wa w2 x1+f10-a0 ; no.of exts:=no.of exts+no.of points;
rs w2 x1+f10-a0 ;
al. w0 g0. ; main table base:=abs address;
rs w0 x1+f40-a0 ;
al. w0 g60. ; stack top:=abs address;
rs w0 x1+f35-a0 ;
rl w0 x1+e6-a0 ; prev line:=line count;
rs w0 x1+f28-a0 ;
rl w0 x1+e17-a0 ; w0:=mode bits;
al w2 c4-j5+1 ;
sz w0 1<6 ; if integer overflow then
hs w2 x1+j5-a0 ; int overflow:=store opand;
ls w0 -16 ;
so w0 1 ; if code.yes then
jl. a98. ; begin
rl. w2 b23. ; store jl. w3 c43.
el w3 5 ;
al w3 x3+g0.-j7. ; with modif in
hs w3 5 ;
rs w2 x1+j7 -a0 ; j7 and
al w3 x3+j7.-j8. ; with modif in
hs w3 5 ;
rs w2 x1+j8 -a0 ; j8 and
al w3 x3+j8.-j9. ; with modif in
hs w3 5 ;
rs w2 x1+j9 -a0 ; j9;
a98: ; end;
al w0 0 ;
al. w2 g2. ;
a94: rs w0 x2 ; clear modifier table;
al w2 x2+2 ;
sh. w2 g2.+44 ;
jl. a94. ;
al w2 x1+c2-a0 ;
rs. w2 b24. ; return from change segment:=interprete next;
jl x1+c101-a0 ; goto in change out segment;
a91: am -2047 ; stack alarm:
al. w2 a0.+2047 ;
al w1 x2+e10-a0 ; w1:=addr of <:stack:>;
am -2047 ;
jl x2+e5-a0+2047 ; goto alarm;
b23: jl. w3 c43.-g0. ; constant
b40: -12 ; -
h10=k-e0 ; h10=no of bytes in pass
e30=e30+h10
i. ; id list
e. ; end pass 8
m. jz.fgs 1987.06.19 algol 8, pass 8
\f
▶EOF◀