|
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: 134400 (0x20d00)
Types: TextFile
Names: »ftnpass63tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ftnpass63tx «
; start pass 6 fortran pass 6 23.2.70
; jes linderoth
; corrections 1985.10.02 by fgs
k= e0
s. c80,d42,f44,g19,h32,i25,j2
; outbyte values, type independent part
h0 = 1 ; begin base 1
h1 = h0+3 ; list base 4
h2 = h1+5 ; declare base 9
h3 = h2+7 ; adj. array base 16
h4 = h3+5 ; data base 21
h5 = h4+4 ; operand base 25
h7 = h5+12 ; end statem base 37
h8 = h7+10 ; format base 44
h9 = h8+2 ; paramzone base 46
h10 = h9+3 ; zonecomma base 49
h11 = h10+2 ; parcount 52
h12 = h11+1 ; start range 53
h13 = h12+1 ; entry base 54
h14 = h13+3 ; jump base 57
h15 = h14+5 ; rel and logpoint base 62
h16 = h15+2 ; do base 64
h17 = h16+9 ; inout base 71
h18 = h17+4 ; implied base 75
h19 = h18+2 ; trouble 80
h20 = h19+2 ; convert base 81
h29 = h20+21 ; exp base 102
h30 = h29+7 ; area inf base 109
h32 = h30+2
; outbyte values, type dependent part
h21 =(:(:h32-1:)>3+1:)<3 ; datainit
h22 = h21+8 ; arith oprt base
h23 = h22+40 ; mask oprt base
h24 = h23+32 ; assign base
h25 = h24+16 ; indic base
h26 = h25+16 ; call
h27 = h26+8 ; param base
h28 = h27+32 ; if
h6 = h28+8 ; const base
h31 = h6 +8 ; formal array decl
w. j0: j2 ; no. bytes in pass 6
h. j1 , 6<1+1 ; rel entry, passno.+pass mode
; pass 6 init
j1=k-j0
w. rl. w0 e9.+4 ; pass 6 init:
rs. w0 f4. ; opnd stack point:=
rs. w0 f14. ; opnd bottom:= last work for pass;
rl. w2 f12. ; set bottom
rs. w2 (f4.) ; operand undefined
al. w2 j0.-2 ; oprt stack point:=
wa. w2 j0. ; start pass6-2+no.bytes in pass6;
rs. w2 f3. ;
rs. w2 f19. ; global base:=oprt stack point;
al. w2 f39. ; word(general spec param):=
rs. w2 f38. ; address of general specs;
jl. c80. ; go to new inbyte;
\f
; stacking actions are specified with c-names,declared in the
; outmost block
; local labels(a-names) and local variables(b-names)
; are declared in local blocks,if needed.
b. a3 ; global entries: comment a table with
; name and paramspecifications for
; each entrypoint in all programunits
; with formats as in a catalog-entry
; ,is read via call of inbyte;
; beforehand,an entry corresponding
; to an unknown procedure is
; established.
w. c1: bl. w0 f2. ;
jl. w3 e3. ; outbyte(control word part4);
jl. w3 e2. ; no.bytes:=inbyte;
al w0 x2 ;
jl. w3 e3. ; outbyte(no.bytes);
wa. w2 f19. ;
rs. w2 f20. ; endglobal:=global base+no.bytes;
sl. w2 (f4.) ; if endglobal>= opnd stack point
jl. d0. ; then goto stack owerflow;
rl. w1 f19. ;
al w2 x2 -10 ; head address:=
rs. w2 f17. ; end global-10;
a0: jl. w3 e2. ; for w1:=global base step 1
hs w2 x1 +2 ; byte(w1+2):=inbyte;
al w1 x1 +1 ;
se. w1 (f20.) ;
jl. a0. ;
al w1 x1 +2 ;
a1: al w1 x1 -12 ; output global entry list:
sh. w1 (f19.) ;
jl. a3. ; for entry:=endglobals-10
al w2 0 ; step -12 until global base
; do
a2: am x1 ;
bl w0 x2 ; for i:=0 step 1 until 11
jl. w3 e3. ; do outbyte(byte(entry+i));
al w2 x2 +1 ;
sh w2 11 ;
jl. a2. ;
jl. a1. ;
a3: rl. w1 f20. ; w1:=end globals
d30: al w1 x1 +6 ; adjust oprt point:
rs. w1 f3. ; oprt stack point:=w1+6;
al w0 -11<7 ; oprtstack(oprt stack point):=
hs w0 x1 -4 ; bottom priority;
jl. c80. ; goto new inbyte;
e.
b. a14, b5
; external list:
;
; <record> ::=<directing byte>
; <no.bytes>
; no.externals
; (<ext item>)
; no.externals
; <no.externals>
;
; input:<ext item>::=<extno><8 bytes external represent.>
;output:<ext item>::= <8 bytes external represent.>
; <4 bytes kind and specs>
;
;
;
; the external list is read, taking one item at a time.
;
; at the same time,table glob.references is established,holding
; for each external a word with a pointer to the kind and specs to
; be used for that external during parameter-checking in the exe-
; cutable part of the unit.
;
; the kind and specs is searched for in table global entries
; using <external represent.>,that is stored immediately after
; global entries, as a key, and if not found a new entry in
; global entries is created with ext.represent. already defined
; and with kind and specs taken from
; a)the catalog by means of look up entry or
; b)unknown entry, if not found in the catalog.
;
; when all input items have been processed,the external list is
; output, taking for each external,and inthe order of increasing
; values of <extno>, the corressponding entry in table
; global entries ,i.e. 12 bytes for each external.
; kind and specifications:
; format as in notes on code procedures in algol 5.
; special: proctype=15 for unknown entry
w. b0: 0 ; ext count
b1: 0 ; twice extno
b2: 12 ; twelve
b3: 9 ; nine
b4: <:*version:>, 0, e103, 0 ; pseudo external entry (version):
b5: ; end pseudo:
c2: bl. w0 f2. ; external list:
jl. w3 e3. ; outbyte(control word part4);
jl. w3 e2. ; no.inbytes:=w2:=inbyte;
al w1 0 ; extcount:=0;
rs. w1 b0. ;
wd. w2 b3. ; no.externals:=
rs. w2 f37. ; w2//9;
al w0 x2 +1 ;
wm. w0 b2. ; no.outbytes:=
ba. w0 1 ; (no.inbytes//9+1)*12+1; <*12 for pseudo entry added*>
jl. w3 e3. ; outbyte(no.outbytes);
ls w2 1 ;
ac w2 x2 +2 ; glob.reference base:=
wa. w2 f4. ; opnd stack point -
rs. w2 f21. ; 2*no.externals-2;
al w2 x2 -2 ; opnd stack point:=
rl. w3 f4. ; save operand stack pointer
rs. w2 f4. ; opnd bottom:=
rs. w2 f14. ; glob.reference base-2;
sh. w2 (f3.) ; if opnd bottom<=oprtstackpoint
jl. d0. ; then goto stack owerflow;
rl. w1 f19. ; glob.references(0):=
rs w1 x2 +2 ; global base;comment points at
; unknown entry,and ext params
; are treated as external 0;
al w0 0 ; put zeroes
al w2 x2 +4 ; in table for
a11: sl w2 x3 ; global references
jl. a0. ;
rs w0 x2 ;
al w2 x2 +2 ;
jl. a11. ;
a0: rl. w1 b0. ; next external:
sn. w1 (f37.) ; if extcount=no.externals
jl. a7. ; then goto out external list;
al w1 x1 +1 ; extcount:=
rs. w1 b0. ; extcount+1;
jl. w3 e2. ; w2:=inbyte;comment extno;
ls w2 1 ; twice external:=w2 shift 1;
rs. w2 b1. ;
al w1 0 ; w1:=0;
a1: jl. w3 e2. ; for w1:=end globals+2 step 1
am. (f20.) ; until end globals+9 do
hs w2 x1 +2 ; byte(w1):=inbyte;
al w1 x1 +1 ;
se w1 8 ;
jl. a1. ;
sl. w1 (f4.) ; if w1>=opnd stack pointer
jl. d0. ; then goto stack owerflow;
rl. w1 f19. ; w1:= global base;
a2: al w1 x1 +12 ; next global entry:w1:=w1+12;
am. (f20.) ; if w1>end global then
sl w1 2 ;
jl. a4. ; goto search in catalog;
al w2 0 ; w2:=0;
; comment start comparing;
a3: am. (f20.) ; for w2:=0 step 2 until 6 do
rl w0 x2 +2 ; if word(end global+2+w2)
am x2 ;
se w0 x1 (-10) ; <>word(w1-10+w2) then
jl. a2. ; goto next global entry;
al w2 x2 +2 ;
se w2 8 ;
jl. a3. ;
jl. a6. ; goto store reference;
a4: rs. w1 f20. ; search in catalog:
am. (f4.) ; end globals:=w1;
sl w1 -18 ; if w1+18>=opndstackpoint
jl. d0. ; then goto stack owerflow;
; comment tail part fills 10
; words at return from
; look up entry;
al w3 x1 -10 ;
jd 1<11+42 ; look up entry(w1-10,w1,w0);
se w0 2 ; if result=2 then
jl. a5. ; alarm(<:catalog:>);
jl. w1 e5. ; comment input-output error;
<:catalog:>
a5: rl. w1 f20. ; kind and specs in last global
dl w3 x1 14 ; entry:= if entry looked up
bl w1 x1 16 ; and content=procedure
se w0 0 ; if result<>0
jl. 8 ; then kind and specs. unknown
sl w1 32 ; if shared entry
jl. a13. ; goto a13
se w1 4 ; if content=procedure then
dl. w3 (f19.) ; optional word 6 and 7 from tail ad
a13:rl. w1 f20. ;
ds w3 x1 ;
; fjernes efter test
;
se w0 6 ; if result = 6
jl. a6. ; then
jl. w1 e5. ; alarm;
<:name form of look up entry<0>:>
a6: ; store reference:
rl. w2 b1. ; glob references(
am. (f21.) ; twice extno):=w1;
rs w1 x2 ;
jl. a0. ; goto next external;
a7: al w2 0 ; out external list:extno:=0;
jl. a10. ; goto test for end list;
a8: al w2 x2 +1 ; next item out:
rs. w2 b0. ; extno:=extno+1;
ls w2 1 ;
am. (f21.) ; w2:=glob references(extno);
rl w2 x2 ;
sn w2 0 ; if no external
jl. a12. ; test for end list
al w1 x2 -10 ;
a9: bl w0 x1 ; for w1:=w2-10 step 1 until
jl. w3 e3. ; w2+1 do
al w1 x1 +1 ; outbyte(byte(w1));
se w1 x2 +2 ;
jl. a9. ;
a12: rl. w2 b0. ;
a10: se. w2 (f37.) ; test for end list:
jl. a8. ; if extno<>no.externals then goto next item out;
al. w2 b4. ; out pseudo external entry:
a14: zl w0 x2 ; the pseudo external entry
jl. w3 e3. ; contains the compiler version
al w2 x2 +1 ; number used only by pass9;
se. w2 b5. ;
jl. a14. ;
jl. w3 e2. ; inbyte;
al w0 x2 +1 ; outbyte(inbyte+1);comment
jl. w3 e3. ; no.externals+pseudo external entry;
rl. w1 f12. ; set bottom
rs. w1 (f4.) ; operand undefined
rl. w1 f20. ; w1:= end globals;
jl. d30. ; goto adjust oprt point;
e.
b. a1,b0 ; error labels:comment a table holding
; multiple- or not declared labels,
; if any, is established;
w. b0: 0 ; addr of end labels
c3: al. w3 f23. ; error labels:w3:=
; addr of enderr labels;
rs. w3 b0. ; label list:addr of endlabels
rl w1 x3 ; :=w3;w1:=end labels;
se w1 0 ; if w1<>0 then
jl. a0. ; goto table size;
am. (f3.) ;
al w1 -5 ; w1:=label base:=
rs w1 x3 -2 ; oprt stack point-5;
a0: jl. w3 e2. ; table size:
wa w2 2 ; w2:=end labels:= w1+inbyte;
rs. w2 (b0.) ;
sl. w2 (f4.) ; if w2>=opnd stack point then
jl. d0. ; goto stack owerflow;
a1: al w1 x1 +1 ; for w1:=w1+1 step 1 until
jl. w3 e2. ; end labels do
hs w2 x1 ; byte(w1):=inbyte;
am. (b0.) ;
se w1 (0) ;
jl. a1. ;
sz w1 1 ; w1:=end labels//2*2;
al w1 x1 -1 ;
jl. d30. ; goto adjust oprt point;
e.
b. a4,b1 ; decl array param
; parameterranges has to be moved to the stack
; during run time, and to do this, pass6 treats
; each parameterrange as an assignment statement.
; for adjustable arrays, code to calculate lower
; and upper value, has to be generated,and this is
; done by evaluating arrayindex in the usual way
; for first and last array element.
w. b0: 0 ; adjustable
b1: 1 ; one
; decl array param:
c4: jl. w3 e2. ; inbyte;comment no.bytes,skipped;
jl. w3 e2. ; control word part4:=
ba. w2 f2. ; control word part4+inbyte;comment
hs. w2 f2. ; type of array;
jl. w3 d4. ; stack and output opnd;
jl. w3 e2. ;
rs. w2 f6. ; no.dimensions:= inbyte;
rl. w1 f3. ;
ls w2 1 ; w2:=oprtstack point+
wa w2 2 ; 2* no.dimensions;
sl. w2 (f4.) ; if w2>= opnd stack point then
jl. d0. ; goto stack owerflow;
rs. w2 f29. ; endranges in decl:=w2;
; comment ranges are picked up and
; stored in oprt stack;
a0: sn. w1 (f29.) ; for w1:=oprtstackpoint+2 step 2
jl. a1. ; until endranges in decl do
al w1 x1 +2 ; begin
jl. w3 e2. ; byte(w1):=inbyte;
hs w2 x1 ;
jl. w3 e2. ; byte(w1+1):=inbyte;
hs w2 x1 +1 ;
jl. w3 e2. ; inbyte;
jl. w3 e2. ; w2:=inbyte;
sn w2 0 ; if w2<>0 then
jl. a0. ; begin comment parameterrange;
;
rs. w2 b0. ; adjustable:= true;
al w0 h5+0 ;
jl. w3 e3. ; outbyte(simpel local);
bz w0 x1 +1 ;
jl. w3 e3. ; outbyte(byte(w1+1));comment
al w0 h5+2 ; stack relativ address to range;
jl. w3 e3. ; outbyte(simpel param);
al w0 x2 ;
jl. w3 e3. ; outbyte(w2);comment stack
al w0 h24+2 ; relativ with paramno;
jl. w3 e3. ; outbyte(assign integer);
jl. a0. ; end
; end;
; comment calculate lower and upper
a1: al w2 0 ; for adjustable arrays;
sn. w2 (b0.) ; if -,adjustable then
jl. a4. ; goto end array decl;
rs. w2 b0. ; adjustable:=false;
rl. w2 f6. ;
al. w1 b1. ; rangeaddress:=one;
; comment new lower;
a2: jl. w3 d6. ; for w2:=no.dimensions step -1
al w2 x2 -1 ; until 1 do
se w2 0 ; out range value(rangeaddress);
jl. a2. ;
jl. w2 d7. ; adjust upplow;
al w0 h3+0 ;
jl. w3 e3. ; outbyte(adj lower);
rl. w1 f3. ; comment new upper;
a3: al w1 x1 +2 ; for r address:=oprt stackpoint+2
jl. w3 d6. ; step 2 until end ranges indecl do
se. w1 (f29.) ; out range value(r address);
jl. a3. ;
jl. w2 d7. ; adjust upplow ;
al w0 h3+1 ;
jl. w3 e3. ; outbyte(adj upper);
a4: al w0 h3+2 ; end array decl:
jl. w3 e3. ; outbyte(init array);
al w0 h3+3 ; if adjustable
se w2 0 ; then outbyte(adj array)
al w0 h3+4 ; else outbyte(fix array);
jl. w3 e3. ;
jl. d31. ; goto remove opnd;
e.
c5: jl. w3 e2. ; local entry list:
jl. w3 e11. ; w2:=inbyte;repeat inputbyte;
rs. w2 f31. ; no.entries:=w2;
jl. w3 d5. ; copy opnd descr;
al w0 0 ; no.operands:=0;comment
rs. w0 f8. ; executable part starts immediate-
; ly after local entry list;
jl. c80. ; goto new inbyte;
c6: jl. w3 d5. ; declare and lists: copy opnd descr;
jl. c80. ; goto new inbyte;
c7: al. w3 f36. ; nulls:w3:=addr of endnulls;
jl. c3.+2 ; goto label list;
c8: jl. w3 d4. ; copy fixed lenght:
; stack and output opnd;
d31: rl. w1 f4. ; remove opnd:
al w1 x1 +2 ; opnd stackpoint:=
rs. w1 f4. ; opnd stackpoint+2;
jl. c80. ; goto new inbyte;
c9: jl. w3 d4. ; operand: stack and output opnd;
jl. c80. ; goto new inbyte;
b. a1 ; array descr:
; the fixed part is output at once while range-descriptions
; are stored in operator-stack as shown(1 word pr range),with
; an end range operator on the top of them,see label a1:
;
; - - - - - - -
; ! range 1 ! the ranges are later on to be
; - - - - - - - used in action c69,index uns,
; ! range 2 ! to output a reverse polish
; - - - - - - - expression for calculating a
; ! ! one-dimensional index,or
; ! ! to be output if the array
; - - - - - - - ident is a parameter.
; ! range n-1 !
; - - - - - - -
; ! no. ranges !
; - - - - - - -
; ! end range ! part3 of end range operator holds a
; ! operator ! pointer to the ranges,and it is
; ! ! initialised during stacking of
; - - - - - - - array(.
w. c10: jl. w3 e2. ;
jl. w3 d4. ; stack and output opnd;
jl. w3 e2. ;
rs. w2 f6. ; no.dimensions:=inbyte;
al w0 x2 ;
rl. w1 f3. ; w1:=oldpointer:=
rs. w1 f10. ; oprt stack pointer;
ls w0 1 ;
wa w0 2 ; limit:=w1+no.dimensions*2;
sl. w0 (f4.) ; if limit>= opnd stack point then
jl. d0. ; goto stack owerflow;
rs. w0 f3. ; oprtstack point:= limit;
rs w2 (0) ; oprtstack(oprtstack point):=
al w1 x1 +2 ; no.dimensions;
a0: sn w0 x1 ; for w1:=oldpoint+2 step 1
jl. a1. ; until limit-1 do
jl. w3 e2. ; byte(w1):=inbyte;
hs w2 x1 ;
al w1 x1 +1 ;
jl. a0. ;
a1: al w2 14<7+1<1 ; comment end range is put
hs. w2 f0. ; in control word;
al w2 84 ; control word(6 bytes):=
ls w2 12 ; 14<7+1<1,0,0,0,pointer to
rs. w2 f2. ; end range in oprt table,0;
jl. d3. ; goto test control word;
e.
b. b0 ;
w. b0: 2. 10000000000000100 ; zarray opnd
c11: jl. w3 d4. ; zone: stack and output opnd;comment
rl. w1 b0. ; w0 contains no.zones;
se w0 0 ; if no.zones<>0 then
rs. w1 (f4.) ; opndstack(top):=zarray opnd;
jl. c80. ; goto new inbyte;
e.
c12: jl. w3 d4. ; external: stack and output opnd;
jl. w3 d16. ; comment w0 and w2 contain extno;
rl. w0 (f4.) ; get params(extno,receive kind);
jl. w3 d10. ; w0:=top operand; check opnd;
se. w1 (f12.) ; if operand<>undefined then
rs. w1 (f4.) ; opndstack(top):=operand;
al w2 i1 ; w2:=end paramdescription;
jl. d1. ; goto fetch control entry;
; comment an endparam-operator will
; be stacked on top of the param-
; descriptions;
c13: jl. w3 d4. ; ext param: stack and output opnd;
al w2 0 ;
jl. w3 d16. ; get params(unknown,receive kind);
al w2 i1 ; w2:=end paramdescription;
jl. d1. ; goto fetch control entry;
c14: al w0 177 ; label:controlword part4:=label no.;
rx. w0 f18. ; type of last opnd:=177;comment see
hs. w0 f2. ; comment for constant;
jl. w3 d4. ; stack and output opnd;
rs. w0 f18. ; last opnd:=labelno.;comment w0
; contains label no. at return;
rl. w3 f7. ; no.labels :=no.labels+1;
al w3 x3 +1 ;
rs. w3 f7. ;
jl. w3 d15. ; label check;
jl. c80. ; goto new inbyte;
c15: al w0 177 ; constant:type of last operand:=7;
rs. w0 f18. ; comment no change of operand-descr
jl. c9. ; during call of stack and output
; opnd; goto operand;
c16: rl. w1 f8. ; vanished opnd:
al w1 x1 +1 ; no.operands:=
rs. w1 f8. ; no.operands+1;
jl. c80. ; goto new inbyte;
c17: jl. w1 d9. ; dyadic input: check top operand;
jl. c80. ; goto new inbyte;
c18: jl. w1 d9. ; logic dyadic: check top operand;
so w1 1<5 ; if resulttype<>logical then
jl. d32. ; goto not relation if;comment
; logic express is given a special
; treatment,cf. description;
am 1 ;
bl. w0 f0. ; outbyte(control word part2);
jl. w3 e3. ; comment logicand or logicor;
rl. w1 f3. ; priority of top oprt:=
bl w2 x1 -4 ; priority of top oprt-2;comment to
al w2 x2 -2<7 ; prevent that and unstacks and,f.ex.;
hs w2 x1 -4 ;
al w2 h15 ; oprtstack(top part4):=logpoint-1;
hs w2 x1 ;
;
d32: al w0 0 ; not relation if:
rs. w0 f9. ; maybe relation if:= false;
jl. c80. ;
b. a0 ;
w. c19: am. (f4.) ; mult assign:
rl w1 2 ; w1:=nexttop operand
la. w1 f25. ; and all type mask +
lo. w1 f1. ; variable kinds;
jl. a0. ; goto check assign;
c20: rl. w1 f1. ; assign input:w1:=control word part3;
a0: rl. w0 (f4.) ; check assign: w0:=top operand;
jl. w3 d10. ; check opnd;
rs. w1 (f4.) ; opndstack(top):=result operand;
jl. c80. ; goto new inbyte;
e.
c21: jl. w3 d4. ; decl label: stack and output opnd;
rs. w0 f18. ; last operand:=label no.;
jl. w3 d15. ; label check;
jl. d31. ; goto remove opnd;
c22: al w0 0 ; comp goto:
rs. w0 f7. ; no.labels:=0;
jl. c80. ; goto new inbyte;
c23: al w0 1<10 ; if input: maybe relif:=true;comment
rs. w0 f9. ; 1<10 added to a relation-bytevalue
al w0 0 ; says ifrelart in stead of relart;
rs. w0 f28. ; no ifoutput:=false;
jl. c80. ; goto new inbyte;
c24: jl. w1 d9. ; end if input: check top operand;
rl. w1 f4. ;
al w1 x1 +2 ; opndstack point:=
rs. w1 f4. ; opndstack point+2;
jl. d32. ; goto not relation if;
c25: jl. w1 d9. ; doinit: check top operand;
am. f0. ;
bl w0 1 ; special do:=control word part2;
rs. w0 f13. ; comment general or special do;
bz. w0 f2. ; w0:=control word part4;
jl. w3 e3. ; outbyte(w0);
jl. d31. ; goto remove opnd;
c27: jl. w3 d14. ; do oprt out: integer conv;
bz. w0 f2. ;
wa. w0 f13. ; outbyte(basevalue+specialdo);
jl. w3 e3. ; comment doinitgen or doinitspec;
jl. c80. ; goto new inbyte;
c28: jl. w3 d14. ; imp until step: integer conv;
bz. w0 f2. ;
jl. w3 e3. ; outbyte(controlword part4);
am. f0. ;
bl w0 1 ; byte := control word part 2;
se w0 0 ; if byte <> 0 then
jl. w3 e3. ; outbyte(byte);
jl. c80. ; goto new inbyte;
b. b0 ; action stack entry:
;
w. b0: 2.11111 ; proctype mask;
;
; table proctype kind holds 1 byte with an operand-mask
; for each possible proctype,found in paramdescriptions.
; it is used to check an entry-name against the unit-name.
; mask proctype
h. g0: 2. 101000000 ; 0: program
2. 101000000 ; 1: subroutine
2. 100100000 ; 2: logical function
2. 100000001 ; 3: integer function
2. 100000100 ; 4: real function
2. 100000010 ; 5: long function
2. 100001000 ; 6: double function
2. 100010000 ; 7: complex function
w. c29: am. (f17.) ; stack entry:
bz w1 +8 ; w1:=word with proctype of this
ls w1 -6 ; program unit;
la. w1 b0. ; w1:=proctype;
bz. w1 x1 g0. ; w1:=proctypekind(proctype);
am. (f3.) ; oprtstack(top part2):= w1;
rs w1 -2 ; comment operand-mask;
jl. c80. ; goto new inbyte;
e.
; table list left input:
; the inbyte listleft is given another name by means of the
; top-operand kind and the table listleft input that holds
; a pointer to inputentries for each possible kind. this new
; entry is used further on.
h. g1: i6 ; simple : pointer to begin proc list
0 ; subscripted : not used
i6 ; label variable: pointer to begin proc list
0 ; label : not used
0 ; zone indic : not used
i2 ; array : pointer to begin array list
i3 ; array eq zone : - - begin arr eq zone list
i4 ; zone : - - begin zone list
i5 ; zone array : - - begin zarray list
i6 ; subroutine : - - begin proc list
i6 ; function : begin proc list
i19 ; undefined : - - trouble left(
w. c30: jl. w3 e2. ; listleft input:
rs. w2 f5. ; no.list elements:=inbyte;
rl. w3 (f4.) ;
ns w3 5 ; w2:=15-bitno for leftmost bit
bl w2 5 ;
al w2 x2 +14 ; in topoperand;
bl. w2 x2 g1. ; inputbyte:=listleftinput(w2);
jl. d1. ; goto fetch control entry;
b. a2,b1 ; block for begin array list,
; begin zone list and
; begin zarray list;
w. b0: 1<12 ; zoneindic kind
c31: al w3 x1 -12 ; begin array list: word(rangepointer)
rs w3 x1 -8 ; :=address of rangestart in stack;
al. w1 d20. ; erroraddress:=subscript error;
rl. w0 f6. ;
a0: ; get kind:
se. w0 (f5.) ; if no.dimensions<>no.list elements
jl w2 x1 ; then error(erroraddress);
al w2 1<9 ; resultkind:=subscriptkind;
a1: rl. w1 (f4.) ; opnd result:
la. w1 f25. ; opndstack(top):=opndstack(top)
lo w1 4 ; and alltypemask +resultkind;
rs. w1 (f4.) ;
jl. c80. ; goto new inbyte;
c32: al w0 1 ; begin zone list: no.dimensions:=1;
a2: al. w1 d21. ; z subscript:erroraddress:=zoneerror;
jl. a0. ; goto get kind;
c33: al w0 2 ; begin zarray list: no.dimensions:=2;
sh. w0 (f5.) ; if no.dimensions<=no.elements
jl. a2. ; then goto z subscripts;
rl. w2 b0. ; resultkind:=zoneindic kind;
al w1 h10+0 ; outvalue of top operator:=
hs. w1 (f3.) ; zonecomma;
jl. a1. ; goto opnd result;
e.
b. a1 ;
w. c34: jl. w1 d9. ; begin proc list: check top operand;
rl. w3 f3. ; w3:=oprtstack point;
se. w1 (f12.) ; if result operand<>undefined
jl. a1. ; then goto check no.elements;
al w1 4 ; top operator becomes trouble(
hs w1 x3 -3 ; with output of a <call> byte
; during unstacking;
jl. c80. ; goto new inbyte;
a1: ; check no.elements:
bl w1 x3 -18 ; no.formals:=byte(w3-18);
sn. w1 (f5.) ; if no.formals= no.list elements
jl. c80. ; then goto new inbyte;
bl w0 x3 -17 ; w0:=param n;comment last paramdesc;
sl. w1 (f5.) ; if no.formals> no.list elements
jl. a0. ; then goto param error;
al w1 40 ;
hs w1 x3 -17 ; param n:=general;
sl w0 39 ; if w0<> general then
sl w0 41 ;
a0: jl. w2 d22. ; param error: call error;
jl. c80. ; goto new inbyte;
e.
c35: dl. w0 f1. ; begin io:comment read or write
ds. w0 f41. ; is input;
; iocall:=control word part2;
; ioparammask:=control word part3;
jl. w3 e2. ; comment readcall or writecall;
se w2 0 ; no.elements:=inbyte;
sl w2 3 ; if no.elements=0 or >2 then
jl. w3 d22. ; call error;
jl. c80. ; goto new inbyte;
; table commainput:
; the inbyte listcomma is given another name during call of
; define name(commatype) and table commainput, that holds a
; pointer to inputentries for each commaname.
h. g2: i7 ; pointer to indexcomma
i8 ; - - zonecomma
i9 ; - - paramcomma
i10 ; - - rw comma
i20 ; - - troub comma
w. c36: jl. w3 d13. ; list comma: define name(w2);
bl. w2 x2 g2. ; inputbyte:=commatype(w2);
jl. d1. ; goto fetch control entry;
c37: jl. w3 d14. ; index comma: integer conv;
jl. c80. ; goto new inbyte;
c38: jl. w3 d14. ; zone comma: integer conv;
al w0 h10+0 ;
jl. w3 e3. ; outbyte(zone comma);
jl. c80. ; goto new inbyte;
c39: jl. w3 d11. ; paramcomma: actual vers formal;
jl. c80. ; goto new inbyte;
b. a0 ;
w. c40: rl. w2 f4. ; stack iocomma:
se. w2 (f14.) ; if opndstack is empty then
jl. a0. ; begin
rl. w2 f3. ; oprtstackpoint:=
al w2 x2 -6 ; oprtstackpoint-6;
rs. w2 f3. ; goto new inbyte;
jl. c80. ; end;
a0: rl. w1 f15. ; count io:
al w1 x1 +1 ; iocount:= iocount+1;
rs. w1 f15. ;
rl. w0 f41. ; controlword part3:=ioparammask;
rs. w0 f1. ;
e.
c41: rl. w0 f1. ; rw comma: w0:=controlword part3;
jl. w3 d12. ; check param;
jl. c80. ; goto new inbyte;
; table endlist input:
; the inbyte listright is given another name during call
; of define name(endlist type) and table endlist input, that
; holds a pointer to inputentries for each endlist-name
h. g3: i11 ; end index list: pointer to end index
i11 ; end zone list: - - end index
i12 ; end proc list: - - end proc list
i13 ; end rw list: - - end rw list
i21 ; end troub list: - - end troub list
w. c42: jl. w3 e2. ; end list input:
rs. w2 f5. ; no.list elements:=inbyte;
jl. w3 d13. ; define name(w2);
bl. w2 x2 g3. ; inputbyte:=endlistinput(w2);
jl. d1. ; goto fetch control entry;
c43: jl. w3 d11. ; end proc list: actual vers formal;
d33: am 1 ; parcount out:
bl. w0 f0. ;
jl. w3 e3. ; outbyte(control word part2);
rl. w0 f5. ;
sl. w0 (f11.) ; if no.list elements>= paramarea
rs. w0 f11. ; then paramarea:=no.list elements;
jl. w3 e3. ; outbyte(no.list elements);
jl. c80. ; goto new inbyte;
b. b0
w. b0: 2. 00001001001110000101 ; rwcomma mask
c44: al w3 1 ; end rw list:
rl. w0 f1. ; w0:= if no.listelements<>1
sn. w3 (f5.) ; then control word part3
rl. w0 b0. ; else rwcomma mask;
jl. w3 d12. ; check param;
jl. d33. ; goto parcount out;
e.
b. a0 ;
w. c45: rl. w2 f4. ; end iolist:
sn. w2 (f14.) ; if opndstack is empty then
jl. a0. ; goto start implied;
al w0 i24 ; control word part1:=
hs. w0 f0. ; commaunstack priority; comment some
al w0 h11+0 ; iocommas has to be unstacked;
jl. w3 e3. ; outbyte(parcount);
rl. w0 f15. ; if iocount>=paramarea then
sl. w0 (f11.) ; paramarea:=iocount;
rs. w0 f11. ;
jl. w3 e3. ; outbyte(iocount);
jl. d2. ; goto priority check;
a0: rl. w0 f40. ; start implied:
al w1 0 ;
se. w1 (f15.) ; if iocount<>0 then
jl. w3 e3. ; outbyte(iocall);comment readcall
rs. w1 f15. ; or writecall;
bl. w0 f2. ; iocount:=0; w0:=controlword part4;
se w0 0 ; if w0<>0 then
jl. w3 e3. ; outbyte(w0);comment implbegin
se w0 h11+0 ; or parcount in which case
jl. c80. ; endio was input;
; if w0=parcount then
al w0 0 ; begin
jl. w3 e3. ; outbyte(0);
rl. w0 f40. ; outbyte(iocall);
jl. w3 e3. ; end;
jl. c80. ; goto new inbyte;
e.
c46: jl. w3 d4. ; declare ext zone:
jl. w3 d16. ; stack and output opnd;
al w3 x3 -8 ; get params(extno,receivekind);
rs. w3 f3. ; outbyte(inbyte);
jl. w3 e2. ; comment decl ext zone
al w0 x2 ; consists of 3 bytes.only
jl. w3 e3. ; 2 is output in
; stack and output opnd;
; oprtstackpoint:=oprtstackp
rl. w0 (f4.) ; -8;comment pamdescriptions are
se w0 x1 ; removed from the stack;
jl. w2 d27. ; if receivekind<>zone then
jl. d31. ; standard zone error;
; goto remove opnd;
c47: jl. w3 d4. ; area arr zone param:
rl. w0 f11. ; stack and output opnd;
jl. w3 e3. ; outbyte(paramarea);
rl. w1 f42. ;
bl w0 2 ;
jl. w3 e3. ; outbyte(no.labels in unit);
bl w0 3 ;
jl. w3 e3. ; outbyte(no.globals in unit);
rl. w0 f37. ;
jl. w3 e3. ; outbyte(no.externals);
jl. d31. ; goto remove opnd;
c48: al w0 1 ; data star:
rs. w0 f30. ; mult data:=1;
jl. d31. ; goto remove opnd;
c49: al w0 3 ; array data:
am. (f4.) ;
dl w2 2 ;
jl. w3 d18. ; conv oprt2(top,nexttop,3);comment
al w0 0 ; treated as unstacking of assign;
rx. w0 f30. ; w0:=mult data; mult data:=0;
ba. w0 f2. ; w0:=w0+ control word part4;
jl. w3 e3. ; outbyte(w0);
jl. d31. ; goto remove opnd;
c50: rl. w2 f14. ; end statement:
rs. w2 f4. ; opnd stackpoint:= opnd bottom;
jl. c80. ; goto new inbyte;
c51: jl. w3 e1. ; end line: count line;
al w3 0 ;
rs. w3 f8. ; no.operands in line:= 0;
jl. c80. ; goto new inbyte;
c52: rl. w2 e9.+4 ; begin unit:
rs. w2 f4. ; opndstackpoint:=opnd bottom:=
rs. w2 f14. ; last work for pass;
rl. w2 f12. ; set bottom
rs. w2 (f4.) ; operand undefined
al w2 0 ;
rs. w2 f43. ; zoneornot:=0;
rs. w2 f8. ; no.operands in line:=0;
rs. w2 f34. ; page:=0;
rs. w2 f11. ; paramarea := 0;
rs. w2 f23. ; end error labels:=
rs. w2 f36. ; end nulls := 0;
al w3 -12 ; head address:=
wm. w3 f31. ; head address-12*no.entries;
wa. w3 f17. ; comment no.entries in
rs. w3 f17. ; previous unit;
jl. w3 d42. ; get proctype;
al w3 2 ; comment w1:=proctype;
sn w1 0 ; if proctype=program then
rs. w3 f44. ; proginf:=2;
rl. w1 f20. ; w1:=end global;
al w2 1000 ; line no.:=infinite;
rs. w2 f32. ;
jl. d30. ; goto adjust oprt point;
c53: jl. w3 e2. ; call: no.list elements:=
rs. w2 f5. ; inbyte;
al w1 1<6 ; top operand:=top operand
lo. w1 (f4.) ; +notype;
rs. w1 (f4.) ;
jl. c34. ; goto begin proc list;
c54: rl. w0 f44. ; end pass:
jl. w3 e3. ; outbyte(progin);
jl. e7. ; call next pass;
b. b0 ; table relationart holds for each
; relation a byte with art<3;
h.b0: 1<3,3<3,2<3,6<3,4<3,5<3 ; lt,le,eq,ge,gt,ne
w. c55: ac w1 i16 ; relation:
wa. w1 f18. ; w1:=last operand-.lt.bytevalue;
bl. w1 x1 b0. ; oprtstack(top part4):=
hs. w1 (f3.) ; relationart(w1);
jl. c17. ; goto dyadic input;
e.
c56: al w2 i17 ; data init:inputbyte:=data array;
jl. d1. ; goto fetch control entry;
c57: jl. w2 d24. ; errors: error record;
jl. c80. ; goto new inbyte;
b. b0 ; unknown record:
w. b0: <: unknown record to pass6<0>:>
c58: al. w1 b0. ; message(<:unknown record to pass6);
jl. w3 e4. ;
rl. w0 f18. ; writeinteger(last operand);
jl. w3 e14. ;
32<12+5 ;
al w1 -2000 ;
al w3 2 ; set
rs. w3 x1 +e87.+2000 ; warning.yes
jl. c80. ; goto new inbyte;
e.
c59: jl.w3 e2. ; globals and labels:
hs w2 2 ; no.labels in unit:=inbyte;
jl. w3 e2. ;
hs w2 3 ; no.globals in unit:=inbyte;
rs. w1 f42. ;
jl. c80. ; goto new inbyte;
; unstacking actions specified with c-names starting with c60.
; a-and b-names used as in stacking actions
; algol names are marked uns
c60: la. w1 f25. ; monadic oprt uns: operand:=w1 and
lo. w1 f26. ; all typemask +expresskind;
jl. d35. ; goto store operand;
c61: am 1 ; assign uns: oprtclass:=3;
; goto conv call;
c62: am 1 ; arith oprt uns: oprtclass:=2;
; goto conv call;
c63: am 1 ; logical dyadic uns: oprtclass:=1;
; goto conv call;
c64: al w0 0 ; exponent uns: oprtclass:=0;
jl. w3 d17. ; conv call: conv oprt1(top,nexttop,
jl. d35. ; oprtclass);
; goto store operand;
c65: rl. w1 (f4.) ; shift uns: w1:=opndstack(opndstack
jl. c79. ; print);goto bit actions;comment
; w1 is left operand of shift;
; relation unstacking:
; output consists of 2 bytes,
; 1) rel , output in this action
; 2) ifrelart or relart ,output in bit actions with
;
; ifrelart::= 1<10 +art<3 +type ;if statement with one relation
; relart ::= 0<10 +art<3 +type ;usual relation in expressions
;
; art<3 is specified as outvalue in the oprtstack item
; the choice between relart and ifrelart is made as:
;
; maybe relif : y y n n
; endlogif in control word: y n y n
; ----------------------------------------------------------
; output : ifrelart relart relart relart
;
; the boolean mayberelif becomes true when logif is stacked and
; false when a logical oprt or endlogif is stacked;
c66: al w0 2 ; relation uns:
jl. w3 d17. ; conv oprt1(top,nexttop,2);
al w0 h15+0 ;
jl. w3 e3. ; outbyte(rel);
sn. w1 (f12.) ; if operand=undefined then
jl. d35. ; goto store operand;
al w3 1<7+1<5 ; opndstack(top):=
rs. w3 (f4.) ; logical expression;
am 1 ;
bl. w2 f0. ; w2:=control word part2; comment
al w0 1<10 ; w2=-1 if endlogif in control word;
sn. w0 (f9.) ; if -,(mayberelif and w2=-1)
se w2 -1 ; then
jl. c79. ; goto bit actions;
; comment second byte is ifrelart;
rs. w0 f28. ; noifoutput:=true;comment when if
ba. w0 (f3.) ; is unstacked no byte is output;
hs. w0 (f3.) ; oprtstack(top part4):=
jl. c79. ; oprtstack(top part4)+1<10;
; goto bit actions;
c67: al w0 0 ; if uns:
sn. w0 (f28.) ; if -, noifoutput then
jl. c79. ; goto bit actions;comment usual act;
am. (f3.) ; oprtstack(top part1):=0;comment
hs w0 -4 ; the purpose is to set output-and
jl. c79. ; modify bit to zero;
; goto bit actions;
c68: rl. w1 f4. ; end arith if uns:
al w1 x1 +6 ; opndstack point:=opndstackpoint+6;
rs. w1 f4. ; comment removes 3 labelno.s;
jl. c79. ; goto bit actions;
c69: rl. w1 (f27.) ; index uns:
al w1 x1 -2 ; w1:=word(rangepointer):=
rs. w1 (f27.) ; word(rangepointer)-2;comment
jl. w3 d6. ; w1 holds the address of next range;
al w0 h22+26 ; out rangevalue(w1);
jl. w3 e3. ; outbyte(multiply integer);
jl. c79. ; goto bit actions;
; array left uns:
; rangedescriptions ending with an endrange oprt is stacked just below
; the array-left oprt, and they must be removed as we want no dopevector
; output for subscripted variables
c70: rl. w3 f3. ; array left uns:w3:=oprtstackpoint;
rl w2 x3 -12 ;
ls w2 1 ; w2:=oprtstackpoint- (no.ranges*2+6);
ac w2 x2 +6 ; comment new oprtstackpoint-value;
wa w2 6 ;
dl w1 x3 ;
ds w1 x2 ; oprtstack(w2):=
rl w1 x3 -4 ; oprtstack(w3);
rs w1 x2 -4 ;
rs. w2 f3. ; oprtstackpoint:=w2;
rl. w1 (f4.) ; w1:=top operand;
jl. c79. ; goto bit actions;
b. a1 ;
;
w. c71: al w0 h12+0 ; range uns:comment output of dope-
jl. w3 e3. ; vector;
rl. w0 f6. ; outbyte(start range);
jl. w3 e3. ; outbyte(no.dimensions);
rl. w2 f10. ; w2:=oldpointer;comment value of
al w1 x2 +2 ; oprtstackpoint before ranges was
; stacked;
a0: am. (f3.) ; for w1:=w2+2 step 1 until
sn w1 -6 ; oprtstackpoint-6 do
jl. a1. ;
bl w0 x1 ; outbyte(byte(w1));
jl. w3 e3. ;
al w1 x1 +1 ;
jl. a0. ;
a1: rs. w2 f3. ; oprtstackpoint:=oldpointer;
jl. d2. ; goto priority check;
e.
c72: rl. w1 f18. ; param descr uns:
sn w1 44 ; if last opnd=call then
jl. d3. ; goto test control word;
rl. w1 f3. ;
al w1 x1 -14 ; oprtstackpoint:=
rs. w1 f3. ; oprtstackpoint-14;
jl. d2. ; goto priority check;
c73: jl. w3 d26. ; comp goto uns: integer conv2;
al w0 h14+4 ;
jl. w3 e3. ; outbyte(gotoc);
rl. w0 f7. ;
jl. w3 e3. ; outbyte(no.labels);
jl. c79. ; goto bit actions;
; stacking actions for troub comma and end troub list:
c74: al. w1 f38. ; troub comma: parampointer:=
rs. w1 f27. ; general spec pointer;
jl. c39. ; goto param comma;
c75: al. w1 f38. ; end troub list:parampointer:=
rs. w1 f27. ; general spec pointer;
jl. c43. ; goto end proc list;
c76: jl. w3 e2. ; do:
rs. w2 f18. ; last operand:=do label;
rl. w2 f8. ;
al w2 x2 +1 ; no.operands:=no.operands+1;
rs. w2 f8. ;
jl. w3 d15. ; label check;
jl. c80. ; goto new inbyte;
b. b0 ; return
; table unitkind holds for each possible proctype-value of current
; unit some returninformation used in pass 8;
; proctype
h. b0: 0 ; 0: program
0 ; 1: subroutine
1 ; 2: logical function
1 ; 3: integer function
1 ; 4: real function
1 ; 5: long function
2 ; 6: double function
2 ; 7: complex function
w. c77: jl. w3 d42. ; return:get proctype;
; comment w1=proctype;
bl. w0 x1 b0. ; w0:=unitkind(proctype);
wa. w0 f43. ; w0:=w0+zoneornot;
jl. w3 e3. ; outbyte(w0);
jl. c80. ; goto new inbyte;
e.
c78: al w0 1<2 ; local zone decl:
rs. w0 f43. ; zoneornot:=1shift 2;
jl. c8. ; goto copy fixed lenght;
; bit actions: part1 of top operator is decoded and actions according
; to the bits are executed; finally the operator is
; removed.
; table modify: holds for each type a number to be added to the outbyte-
; value if modify-bit =1;
h.g4: 2, 4, 3, 5 ; integer, long,real,double
6, 1, 0, 7 ; complex, logical,notype,undefined
b. a2 ;
w. d35: rs. w1 (f4.) ; store operand:opndstack(top):=w1;
c79: am. (f3.) ; bit actions:comment w1 holds operand;
bz w2 -4 ; w2:=oprtstack(top part1);
so w2 1 ; if modify output bit=0 then
jl. a0. ; goto ask for result;
al w0 1<6-1 ;
la w1 0 ; w1:=type bit numb(operand and
bl. w1 x1 g5. ; all type mask); comment type
; represented as a number<8;
bl. w0 x1 g4. ; w0:=modify(w1);
ba. w0 (f3.) ;
jl. w3 e3. ; outbyte(w0+oprtstack(top part4));
a0: so w2 1<4 ; ask for result: if noresult bit=1
jl. a1. ; then
rl. w1 f4. ; opndstackpoint:=
al w1 x1 +2 ; opndstackpoint+2;
rs. w1 f4. ;
a1: so w2 1<3 ; if output self bit=1 then
jl. a2. ;
bz. w0 (f3.) ; outbyte(oprtstack(top part4));
jl. w3 e3. ;
a2: rl. w1 f3. ; oprtstackpoint:=
al w1 x1 -6 ; oprtstackpoint-6;
rs. w1 f3. ;
so w2 1<2 ; goto(if terminate unstack.bit=0
jl. d2. ; then priority check
jl. d3. ; else test control word);
e.
; global variables
w. f0: 0 ; control word part1<12 +part2
f1: 0 ; control word part3
f2: 0 ; control word part4<12 +part5
f3: 0 ; oprt stack pointer
f4: 0 ; opnd stack pointer
f5: 0 ; no. list elements
f6: 0 ; no. dimensions
f7: 0 ; no. labels
f8: 0 ; no. operands
f9: 0 ; maybe relation-if
f10: 0 ; oldpointer
f11: 0 ; paramarea
f12: 1<20-1 ; undefined
f13: 0 ; special do
f14: 0 ; opnd bottom
f15: 0 ; iocount
f17: 0 ; head address
f18: 0 ; last operand
f19: 0 ; global base
f20: 0 ; end global
f21: 0 ; glob ref base
f22: 0 ; err label base
f23: 0 ; end err labels
f24: 0 ; error mess;
f25: 1<7-1 ; all type mask
f26: 1<7 ; expresskind;
f27: 0 ; rangepointer, parampointer
f28: 0 ; no ifoutput
f29: 0 ; end ranges in decl.
f30: 0 ; mult data
f31: 0 ; no.entries
f32: 0 ; line no.
f33: 50 ; lines pr page
f34: 0 ; page
f35: 0 ; null base
f36: 0 ; end nulls
f37: 0 ; no.externals
f38: 0 ; general spec pointer
f39: 40<12 ; general spec
f40: 0 ; iocall
f41: 0 ; ioparammask
f42: 0 ; globals and labels
f43: 0 ; zoneornot
f44: 1 ; proginf
; table type bit numb:
; it is used to convert the usual typerepresentation for operands
; ,i.e. one of the bits 17-23 equal to 1, to an integer
; =23-bit no.for type.
; an undefined gives the result 8.
; only 6 bits are used,i.e. no.type is represented with 000000
h. g5: 6, 0, 1, 0, 2, 0, 0, 0; no.type,integer,long,0,real,0,0,0
3, 0,r.7, 4, 0,r.15, 5, 0; double, 7*0,complex,16*0,logical
r.30,7 ; 30*0,undefined
w. d36: jl. e2. ; stepping stone for inbyte;
d37: jl. e3. ; stepping stone for outbyte;
d38: jl. e4. ; stepping stone for message;
d39: jl. e14. ; stepping stone for writeinteger;
d40: jl. e13. ; stepping stone for writetext;
d41: jl. e5. ; stepping stone for alarm;
d0: al. w1 e10. ; stack owerflow:w1:=<:stack:> addr;
jl. w3 e5. ; alarm;
; central logic
; an inputbyte causes an entry from inputtable to be stored in
; control word.
; the control word-priority is tested against the top-operand
; and as a result the top operand can be unstacked,starting with
; action unstacking and continuing with the action name stored
; in part4.
; if control word priority is the highest one, actions according
; to bits in part1 and action-name in part4 takes place.
b. a4 ;
w. c80: jl. w3 e2. ; new inbyte:
rs. w2 f18. ; last operand:=w2:=inbyte;
sh w2 177 ; if w2<=type independent value then
jl. d1. ; goto fetch control entry;
al w2 x2 -170 ; comment w2 is an operand or label;
ls w2 -3 ; w2:=kind of operand;comment 0<w2<16;
sl w2 42 ; if w2>=42 then w2:=labelentry;
al w2 i15 ; comment labelno.s start with
; bytevalue 512;
d1: bl. w2 x2 g17. ; fetch control word:
am. g17. ; stepping stone
dl w1 x2 i23 ; pointer:=inputentries(w2);
; i23=g19-g17
ds. w1 f2. ;
am. g17. ; control word:=inputtable(pointer);
rl w2 x2 i25 ; comment control word consists of
rs. w2 f0. ; 3 words;
d2: am. (f3.) ; priority check:
rl w0 -4 ; w0:=part1 part2 of top operator;
rl. w2 f0. ; w2:=part1 part2 of control word;
sl w0 x2 ; comment priority in part1;
jl. a2. ; if w0>=w2 then goto unstacking;
d3: bz. w0 f0. ; test control word:
so w0 1<1 ; w0:=control word part1;
jl. a0. ; if stack bit=1 then
rl. w1 f3. ; begin comment an operator is to
al w1 x1 +6 ; be stacked in oprtstack;
sl. w1 (f4.) ; oprtstackpoint:=oprtstackpoint+6;
jl. d0. ; if oprtstackpoint>=opndstackpoint
rs. w1 f3. ; then goto stack owerflow;
bz. w2 f2. ; w2:=control word part4;
dl. w0 x2 g18. ;
ds w0 x1 ;
am -4 ; oprtstack(top):=
rl. w0 x2 g18. ; operatortable(w2);
rs w0 x1 -4 ;
bz. w0 f0. ; end;
a0: so w0 1 ; if output self bit=1 then
jl. a1. ;
bz. w0 f2. ; outbyte(control word part4);
jl. w3 e3. ;
a1: bl. w2 f2.+1 ; goto stacking action(
jl. x2 c80. ; control word part5);
; comment w1 contains oprtstackpoint;
a2: am. (f3.) ; unstacking:
bz w0 -4 ; w0:=part1 of top operator;
rl. w2 f4. ; if nexttop result bit=1 then
so w0 1<5 ; begin
jl. a3. ; opndstackpoint:=opndstackpoint+2;
al w2 x2 +2 ; w1:=opndstack(opndstackpoint-2);
rs. w2 f4. ; end
am -2 ; else
a3: rl w1 x2 ; w1:=opndstack(opndstackpoint);
so w0 1<6 ; if typecheck bit=1 then
jl. a4. ; begin
am. (f3.) ; w0:=part3 of top operator;
rl w0 -2 ; comment operand mask;
jl. w3 d10. ; check opnd;
sn. w1 (f12.) ; if result operand=undefined then
jl. d35. ; goto store operand;
; end;
a4: am. (f3.) ;
bl w2 1 ; goto unstacking action(part5 of
jl. x2 c80. ; top operator);
; comment w1 contains result operand;
e.
b. a0,b1 ;procedure stack and output opnd;
; the procedure has 2 entries, stack and output opnd
; and copy opnd descr, called as:
; jl. w3 d4. and
; jl. w3 d5.
; in both cases the byte value in control word,part4 is output ,
; followed by a number of bytes, copied from input.
; the number of bytes is in the first case found in control word,
; part2 and for entry copy opnd descr as the next inputbyte.
; when entry stack and output opnd is used,an operand-description,
; taken from control word,part3 and a type-dependent part from table
; opnd types is stacked in operand stack;
; registeruse:
; entry exit
; w3: returnaddress all registers undefined
; globals used:
; f0,f1,f2,f8,f18
; local variables
w. b0: 0 ; return address
b1: 7 ; opnd type mask
; table opnd types:
; it contains for each poss.type of operands a byte, holding a
; pattern that added to part3 of an inputtable-entry form the total
; operand-description to be stored in operand stack
h. g6: 2.1000000 ; notype
2.0100000 ; logical
2.0000001 ; integer
2.0000100 ; real
2.0000010 ; long
2.0001000 ; double
2.0010000 ; complex
2.0 ; no change of inputtable-entry
;entry:
w.d4: rs. w3 b0. ; save return address;
rl. w1 f4. ; opnd stack point:=
al w1 x1 -2 ; opnd stack point-2;
sh. w1 (f3.) ; if opnd stack point <=oprt stack
jl. d0. ; point then goto stack owerflow;
rs. w1 f4. ;
rl. w2 f18. ;
al w2 x2 -170 ; opnd stack(opnd stack point):=
la. w2 b1. ; control word part3 +
bz. w2 x2 g6. ; opnd types(type part of inputbyte);
lo. w2 f1. ;
rs w2 x1 ;
rl. w1 f8. ; no.operands in line:=
al w1 x1 +1 ; no.operands in line +1;
rs. w1 f8. ;
bz. w0 f2. ;
jl. w3 d37. ; outbyte (control word part4);
bz. w1 f0.+1 ; w1:=control word part2;
jl. a0. ; goto next opnd byte;
d5: rs. w3 b0. ; copy opnd descr: save returnaddress;
bz. w0 f2. ;
jl. w3 d37. ; outbyte (control word part4);
jl. w3 d36. ;
al w1 x2 ; w1:=w0:=inbyte;
al w0 x2 ;
jl. w3 d37. ; outbyte (w0);
a0: sn w1 0 ; next opnd byte:
jl. (b0.) ; if w1<>0 then
jl. w3 d36. ; begin
al w0 x2 ; outbyte(inbyte);
jl. w3 d37. ; w1:=w1 -1;
al w1 x1 -1 ; go to next opnd byte
jl. a0. ; end;
; return;
e.
b. ; procedure get proctype;
; the procedure is called as
; jl. w3 d42.
; it gets the value of proctype for this unit by means of
; head address,that is supposed to point at the relevant entry
; in global entry table.head address is set in <begin unit>.
; registeruse: entry: w3=return address
; exit : w1=proctype
; globals: f17,f44
w. d42: am. (f17.) ; get proctype;
bz w1 8 ; proctype:=byte(head
ls w1 -6 ; address+8)shift-6;
al w1 x1 -32 ;
jl x3 ; return;
e.
b. a0,b0 ; procedure out range value(r address);
; the procedure is called when a range description is
; to be output as one operand,f.ex. in evaluating index-expressions
; for subscripted variables, and the call is
; jl. w3 d6.
; at entry-time w1 holds r address, i.e. the abs. address of the word
; holding the range-description.
; depending on the content the range will be output as an integer
; constant or a simple local of integer type
; registeruse:
; entry exit
; w1: r address w1,w2 unchanged
; w3: return address w0,w3 undefined
; local variables
w. b0: 0 ; return address
; entry
d6: rs. w3 b0. ; save returnadress;
rl w3 x1 ; range:= word(r address);
al w0 h5+0 ; w0:=simple local;
sh w3 -1 ; if range<0 then
jl. a0. ; go to range bytes;
al w0 h6+2 ;
jl. w3 d37. ; outbyte(int constant);
bl w0 x1 ; w0:= range(0:11);
a0: jl. w3 d37. ; outbyte(w0);
bl w0 x1 +1 ;
jl. w3 d37. ; outbyte(range(12:23));
jl. (b0.) ; return;
e.
b. a0 ; procedure adjust upplow
; it is called from action decl array param,when new upper and
; lower is calculated for adjustable arrays, and it finishes
; the reverse polish form for calculation by outputting
; range(n-1) to range(1) with each range followed by * and +.
; globals : f28
; registeruse:
; entry: w2=return address; exit w2 unchanged
w. d7: rl. w1 f29. ; for rangeaddress:=
; end ranges in decl-2 step -2
a0: al w1 x1 -2 ; until oprt stack point+2 do
sn. w1 (f3.) ; begin
jl x2 ; out range value(range address);
jl. w3 d6. ;
al w0 h22+26 ; outbyte (multiply integer);
jl. w3 d37. ;
al w0 h22+18 ; outbyte (dya plus integer);
jl. w3 d37. ; end;
jl. a0. ; return
e.
b. b0 ; procedure check top operand
; it checks the top operand description against the mask
; in control word part3 by calling check opnd, and changes
; the kind to express-kind . the call is:
; jl. w1 d9. ;
; registeruse:
; entry: w1=returnaddress ; exit: w1=result operand
; globals used: f1,f4,f12,f25,f26
; local variable:
w. b0: 0 ; returnaddress
d9: rs. w1 b0. ; save return address;
rl. w1 (f4.) ; w1:=opnd stack(opnd stack point);
rl. w0 f1. ; w0:=control word part3;
jl. w3 d10. ; check opnd; comment w1 contains
se. w1 (f12.) ; masking result;
la. w1 f25. ; if w1<>undefined then w1:=
lo. w1 f26. ; w1 and alltypemask+expresskind;
rs. w1 (f4.) ; opnd stack(opnd stack point):=w1;
jl. (b0.) ; return;
e.
b. a1,b0 ; procedure check opnd;
; it performs a check of the operand in w1 against the
; operand mask in w0, and calls type error if type or
; kind error.
; check opnd is called as:
; jl. w3 d10.
; registeruse:
; entry exit
; w0 operand mask undefined
; w1 w0 and w1(or global undefined if error)
; w2 undefined
; w3 return address undefined
; globals: f12
; local variable:
w. b0: 0 ; return address
d10: rs. w3 b0. ; save return address
sn. w1 (f12.) ; if operand=undefined then
jl. (b0.) ; return;
la w1 0 ; w1:= operand and operand mask;
sz w1 127 ; if type correct then
jl. a1. ; goto kind check;
a0: jl. w2 d19. ; operand error: type error;
rl. w1 f12. ; w1:=undefined;
jl. (b0.) ; return;
a1: sh w1 127 ; kind check: if kind incorrect then
jl. a0. ; goto operand error;
jl. (b0.) ; return;
e.
; table parammask contains for every formal param-specification,
; with values as in notes on code procedures in algol 5 ,
; an operand mask to be used during param-checking
; the first two bits hold the columnindex to table paramkind
; param-mask paramspecification
g7=k-4 ;
w. 2.100000000000001110100000 ; 2: boolean name
2.100000000000001110000001 ; 3: integer name
2.100000000000001110000100 ; 4: real name
2.100000000000001110000010 ; 5: long name
2.100000000000001110001000 ; 6: double name
2.100000000000001110010000 ; 7: complex name
2.010000001001000000000100 ; 8: zone
2. 1110000010 ; 9: string
2. 0 ; 10: label
2. 0 ; 11
2.100000000000001110100000 ; 12: boolean value
2.100000000000001110000101 ; 13: integer value
2.100000000000001110000101 ; 14: real value
2.100000000000001110000010 ; 15: long value
2.100000000000001110001000 ; 16: double value
2.100000000000001110010000 ; 17: complex value
2.100000000000001110100000 ; 18: boolean address
2.100000000000001110000001 ; 19: integer address
2.100000000000001110000100 ; 20: real address
2.100000000000001110000010 ; 21: long address
2.100000000000001110001000 ; 22: double address
2.100000000000001110010000 ; 23: complex address
; param-mask paramspecification
2.010000001111001000100000 ; 24: boolean array
2.010000001111001000000001 ; 25: integer array
2.010000001111001000000100 ; 26: real array
2.010000001111001000000010 ; 27: long array
2.010000001111001000001000 ; 28: double array
2.010000001111001000010000 ; 29: complex array
2.100000010000000000000100 ; 30: zone array
2.010000100000000001000000 ; 31: no type procedure
2.010001000000000000100000 ; 32: boolean procedure
2.010001000000000000000001 ; 33: integer procedure
2.010001000000000000000100 ; 34: real procedure
2.010001000000000000000010 ; 35: long procedure
2.010001000000000000001000 ; 36: double procedure
2.010001000000000000010000 ; 37: complex procedure
2. 0 ; 38
2. 11111111001111111111 ; 39: general
2. 11111111001111111111 ; 40: general address
2. 11111111001111111111 ; 41: undefined
b. ; procedure actual versus formal
; the procedure is called as:
; jl. w3 d11.
; it picks up an operand-mask from table parammask according to the
; formal paramdescription in byte(parampointer) and checks it against
; the top operand,i.e. actual param, during a call of check param.
; registeruse:
; entry: w3=return address ; exit: all undefined
; globals: f27
w. d11: rl. w1 (f27.) ; paramdescr:=byte(word(parampoint));
bl w2 x1 ;
sl w2 39 ; if paramdescr<>general then
sl w2 41 ;
al w1 x1 -1 ; word(parampoint):=
rs. w1 (f27.) ; word(parampoint)-1;
ls w2 1 ;
rl. w0 x2 g7. ; w0:=parammask(paramdescr);
jl. d12. ; check param; return;
e.
b. a1,b4 ; procedure check param
; the procedure is called as
; jl. w3 d12.
; it checks the top operand,i.e. an actual param, against a mask
; found in w0 at entry time and stores in part4 of top operator
; the resulting parameterkind, found by table lookup in table
; paramkind with an indexvalue obtained from table actual paramkind
; by means of the param-masking result,and the columnindex
; contained in bit(0:1) in w0 at entry.
; registeruse:
; entry: w3=return address exit: all undefined
; w0=operand mask
; globals used: f3,f4
; local variables:
w. b0: 0 ; return address
b1: 0 ; mask
b2: 9 ; nine
b3: 2. 1000000000100000000; function+simple
b4: 2.111110011111111111111111; remove function+subroutine
; table actual paramkind holds for each operandkind an index to
; first part of table paramkind
;
h.g8: 0 , 0 ; expression , simple
1 , 0 ; subscripted, labelname
7 , 4 ; label , zoneindic
2 , 2 ; array , array eq zone
3 , 5 ; zone , zone array
6 , 6 ; subroutine , function
8 ; undefined
; table paramkind holds for each actual-formal combination the resul-
; ting paramkind-bytevalue
;
; actual formal bytename
h.g9: h27+0 ; expressions , general , paramsim
h27+0 ; subscripted , - - - - , paramsim
h27+16 ; array , - - - - , paramarr
h9+0-3 ; zone , - - - - , paramzone
h9+0-3 ; zoneindic , - - - - , paramzone
h9+0-3 ; zonearray , - - - - , paramzone
h27+24 ; procedure , - - - - , paramproc
h27+0 ; label , - - - - , paramsim
h27+0 ; undefined , - - - - , paramsim
; actual formal bytename
0 ; expressions , proc-zone-array , -
h27+8 ; subscripted , - - - , paramsub
h27+16 ; array , - - - , paramarr
h9+0-3 ; zone , - - - , paramzone
h9+0-3 ; zoneindic , - - - , paramzone
0 ; zonearray , - - - , -
h27+24 ; procedure , - - - , paramproc
0 ; label , - - - , -
h27+0 ; undefined , - - - , paramsim
; actual formal bytename
h27+0 ; expressions , simple-zonearray , paramsim
h27+0 ; subscripted , - - , paramsim
0 ; array , - - , -
0 ; zone , - - , -
h9+2-3 ; zoneindic , - - , paramzinzar
h9+1-3 ; zonearray , - - , paramzarr
0 ; procedure , - - ,
0 ; label , - - ,
h27+0 ; undefined , - - , paramsim
; entry
w.d12: rs. w3 b0. ; save returnaddress;
rs. w0 b1. ; mask:=w0;
rl. w1 (f4.) ; w1:=top operand;
jl. w3 d10. ; check opnd;
se. w1 (f12.) ; if result=undefined then
jl. a0. ; begin
rs. w1 b1. ; mask:=undefined;
rl. w1 (f4.) ; result:=top operand;
; end;
a0: so w1 1<6 ; if not notype
so. w1 (b3.) ; and function+simple then
jl. a1. ;
la. w1 b4. ; remove function+subroutine bits;
a1: ns w1 5 ; kindentry:=actparam(bit no.
bl w2 5 ; for leftmost opndresult-bit);
al w2 x2 +15 ;
bl. w2 x2 g8. ;
rl. w1 b1. ;
al w0 0 ; kindentry:=kindentry+
ld w1 2 ; 9*columnindex;
wm. w0 b2. ;
wa w2 0 ;
bl. w0 x2 g9. ; operator stack(top part4):=
hs. w0 (f3.) ; paramkind(kindentry);
jl. (b0.) ; return
e.
b. a0 ; procedure define name
; the procedure is called as:
; jl. w3 d13.
; it searchs through operator stack to find an operator with
; namegiving bit=1 and holds at exit time namekind in w2,picked
; up from part2 of this operator.
; at the same time rangepointer (same as parampointer) is initi-
; ated to point at part2 of the operator just below the searched one
; registeruse:
; entry: w3=returnaddress ;exit:w2=namekind ,w3 is unchanged
; w1=rangepointer
; globals: f3,f27
w. d13: rl. w1 f3. ; w1:=oprt stack point-2;comment
al w1 x1 -2 ; points to part3 of top operator;
a0: al w1 x1 -6 ; next operator: w1:=w1-6;
bl w0 x1 +4 ; w0:=part1 of operator;
bl w2 x1 +5 ; w2:=part2 of operator;
so w0 1<1 ; if namegiving bit=0 then
jl. a0. ; goto next operator;
rs. w1 f27. ; rangepointer:=w1;
jl x3 ; return;
e.
b. a0,b0 ; integer conv
; the call is: jl. w3 d14. or
; jl. w3 d26.
; it checks the top operand against a mask, found in
; 1)control word part3 for entry d14 ,or
; 2)top operator part3 for entry d26
; if operand-type <> integer, a conversion byte is output as if
; the top operand were on the right side of an integer assignment
; statement, and finally the top operand is removed.
; registeruse:
; entry:w3=return address . exit:w1=opnd stack point
; globals: f1,f4,f12
; local variables:
w. b0: 0 ; return address
d14: rl. w0 f1. ; integer conv:w0:=control word
jl. a0. ; part3;goto get top operand;
d26: am. (f3.) ; integer conv2:
rl w0 -2 ; w0:=top operator part3;
a0: rs. w3 b0. ; get top operand:save returnaddress;
rl. w1 (f4.) ; w1:= opnd stack(top);
jl. w3 d10. ; check opnd;
al w2 1<0 ; if result operand <>undefined
al w0 3 ; then
se. w1 (f12.) ;
jl. w3 d18. ; conv oprt2(w1,integer type,3);
rl. w1 f4. ; comment top opnd is converted to
al w1 x1 +2 ; integer type;
rs. w1 f4. ; opnd stackpoint:=opndstackpoint+2;
jl. (b0.) ; return;
e.
b. a0,b2 ; procedure label check;
; the procedure is called as:
; jl. w3 d15.
; it searchs through an errorlable-table,if any, with last
; operand,that contains a labelno, as key.
; if found,an error message is output during call of label error;
; registeruse: entry:w3=return address; exit:all undefined
; globals: f18, f22,f23
; local variable:
w. b0: 0 ; return address
b1: 0 ; local return address
b2: 0 ; error address
d15: rs. w3 b0. ; save return address;
dl. w2 f23. ; w1:=error label base;
al. w0 d23. ; w2:=end error labels;
jl. w3 a0. ; erroraddr:=label error;
; search;
dl. w2 f36. ; w1:=null base;w2:=endnull;
al. w0 d25. ; erroraddr:=null label;
jl. w3 a0. ; search;
jl. (b0.) ; return;
a0: ds. w0 b2. ; search:save erroraddr;
sl w1 x2 ; comment local proc;
jl x3 ; for w1:=w1+1 step 1 until
al w1 x1 +1 ; w2 do if byte(w1)=last opnd
bl w0 x1 ; then goto found;
se. w0 (f18.) ; return search;
jl. a0.+2 ;
jl. w2 (b2.) ; found: errormess(erroraddr);
jl. (b1.) ; return;
e.
b. a0,b1 ; procedure get params(ext no,rec kind)
; the procedure is called as:
; jl. w3 d16.
; it unpacks the paramdescriptions from an entry in table
; global entries and stores them in the next 8 bytes in
; operator stack with param(n-6) in the highest address.
; in stead of proctype, no.paramdescriptions is placed in
; the lowest address.
; the entry is found via table greferences, that holds a
; pointer to global entries for each ext no.
; at exit time, oprt stack pointer points at the top word
; and w1 contains an operand description according to proctype.
; if the entry corresponds to a standard variable,i.e. 7<proctype<14
; , the top operand kind is changed from external to simple.
; formats of paramdescription-words in global entries are described
; in notes on code procedures in algol 5 ,page 6
; registeruse:
; entry: w2=extno exit: w1=rec kind
; w3=return address w3=oprt stack point
; globals: f3, f19,f21
; local variables:
w. b0: 0 ; return address
b1: 0 ; second param word
; table extkinds holds for each proctype an operand-description
; specifying type and kind in the usual way
; description proctype
g10: 2. 100000000001000000 ; 0: program
2. 100000000001000000 ; 1: subroutine
2. 1000000000000100000 ; 2: boolean function
2. 1000000000000000001 ; 3: integer function
2. 1000000000000000100 ; 4: real function
2. 1000000000000000010 ; 5: long function
2. 1000000000000001000 ; 6: double function
2. 1000000000000010000 ; 7: complex function
2. 100100000 ; 8: boolean variable
2. 100000001 ; 9: integer variable
2. 100000100 ; 10: real variable
2. 100000010 ; 11: long variable
2. 100001000 ; 12: double variable
2. 100010000 ; 13: complex variable
2. 1000000000000100 ; 14: zone variable
2. 1100000000001111111 ; 15: unknown
; entry:
d16: rs. w3 b0. ; save returnaddress;
ls w2 1 ;
am. (f21.) ;
rl w2 x2 ; w2:=glob reftable(ext no);
dl w2 x2 ; paramdescr:=globalentries(w2);
rs. w2 b1. ; secnd paramword:=paramdescr(24:47)
al w2 -1 ; no.params:=1;
al w0 0 ; w0:=0;
al w3 0 ; w3:=0
a0: ld w1 6 ; next paramdescr:
am. (f3.) ; w0w1:= wow1 shift 6;
hs w0 x3 2 ; byte(oprt stackpoint+w3+2):=w0;
se w0 0 ; if w0<>0 then
al w2 x2 +1 ; no.params:= no.params+1;
al w0 0 ; w0:=0;
al w3 x3 +1 ; w3:=w3+1;
sn w3 4 ; if w3=4 then
rl. w1 b1. ; w1:=second paramword;
sh w3 7 ; if w3<=7 then
jl. a0. ; goto next param descr;
wa. w3 f3. ; oprt stackpoint:=
rs. w3 f3. ; oprt stackpoint+8;
am x2 ;
al w0 x3 -6 ; oprttable(endpamdesc part3)
am i0 ; :=address of first param-
rs. w0 g18. ; description;
bl w1 x3 -6 ; proctype:=byte(oprtstackpoint-6)
al w0 1<5-1 ; and language mask;
la w1 0 ;
sn w1 i22 ; if proctype=unknown then
al w2 0 ; no.params:=0;
hs w2 x3 -6 ; byte(oprtstackpoint-6):=
ls w1 1 ; no.params;
rl. w1 x1 g10. ; reckind:=extkinds(proctype);
so w1 1<8 ; if receivekind=simple variable
jl. (b0.) ; then
rl. w2 (f4.) ; change kind of top operand
la. w2 f25. ; to simple
al w2 x2 1<8 ; else return;
rs. w2 (f4.) ;
jl. (b0.) ; return;
e.
b. a4,b2,c3 ; procedure conv oprt(top,nexttop,oprt);
; the procedure is called as:
; jl. w3 d17. ; nexttop opnd is taken from the stack;
; or jl. w3 d18. ; nexttop opnd is in w2 at entry time;
; top and nexttop are operand-descriptions and conv oprt outputs,
; if necessary and depending on parameter oprt, a byte specifying
; conversion from the loosing type to the winning type of top and
; nexttop.
; the conversion-byte is found in table conv table(win,loose) and
; at return time w1 holds an expresskind-operand with winning type.
; conv table holds a zero when typecombinations are not allowed or
; the types are equal.
; if top is the winner,the byte next is output before the
; conversion-byte.
; oprt winner
; 0:exponent ; if nexttop<top then top else no conversion
; 1:logical oprt ; lowest typevalue , no output
; 2:arit or relation ; highest typevalue
; 3:assign ; nexttop
;
; typevalue = 23- typebit no in operand-description
; registeruse:
; entry exit
; w0: oprt undefined
; w1: top resultoperand
; w2: nexttop or undef undefined
; w3: return address undefined
; globals: f3,f4,f12,f25,f26 , g5
; local variables:
w. b0: 0 ; return address
b1: 0 ; oprt
b2: 6 ; no.rows in conv table
; local tables:
; table expbytes holds for each possible top-type in exponentiations
; the relevant bytevalue,that later on is to be modified according to
; winner-type in the usual way
h. g11: h29-2 ; **integer
0 ; **long
h29+1 ; **real
h29+0 ; **double
; conv table:
; a 2-dimensional table that for every combination of
; winning type and loosing type holds a byte that specifies
; conversion from looser to winner.
; winner: int long real doubl compl logic looser
h.g12: 0 , h20+0 , h20+1 , h20+2 , h20+3 , 0 ; integer
h20+4 , 0 , h20+5 , h20+6 , h20+7 , 0 ; long
h20+8 , h20+9 , 0 , h20+10, h20+11, 0 ; real
h20+12, h20+13, h20+14, 0 , h20+15, 0 ; double
h20+16, h20+17, h20+18, h20+19, 0 , 0 ; complex
0 , 0 , 0 , 0 , 0 , 0 ; logical
; type numb to bit:
; this table holds for each type represented as an integer
; between 0 and 5 , the corresponding bit-type representation
h.g13: 2.000001 ; integer
2.000010 ; long
2.000100 ; real
2.001000 ; double
2.010000 ; complex
2.100000 ; logical
; entry
w.d17: rl. w2 (f4.) ; conv oprt1:w2:=opndstack(opnd point);
; comment nexttop in stack;
d18: rs. w3 b0. ; conv oprt2: save return address;
sn. w2 (f12.) ; if nexttop=undefined then
jl. a4. ; goto result undef;
rs. w0 b1. ; save oprt;
la. w1 f25. ; w1:=type part of top;
la. w2 f25. ; w2:=type part of nexttop;
bl. w1 x1 g5. ; w1:=type bit numb(w1);
bl. w2 x2 g5. ; w2:=type bit numb(w2);
; comment types are now numbers between
; 0 and 5;
sn w0 0 ; if oprtclass=exponent then
jl. c0. ; goto exp;
sn w1 x2 ; if w1=w2 then
jl. a2. ; goto result express;
am (0) ;
bl. w3 g14. ;
jl. x3 d18. ; goto action(oprt);
c0: bl. w0 x1 g11. ; exp: oprt stack(top part4):=
hs. w0 (f3.) ; expbytes(w1);
sh w1 x2 ; if top type<nexttop type then
jl. a2. ; goto result express else
jl. a0. ; goto out next;
c1: sl w1 x2 ; logical:
jl. c3. ; goto if toptype>nexttoptype then
jl. a1. ; winner in w2 else exchange;
c2: sh w1 x2 ; arith: if toptype<nexttoptype then
jl. c3. ; goto winner in w2;
a0: al w0 h20+20 ; out next: outbyte(next);
jl. w3 d37. ;
a1: rx w1 4 ; exchange: i:=w1; w1:=w2; w2:=i;
c3: wm. w1 b2. ; winner in w2:
wa w1 4 ;
bl. w0 x1 g12. ; w0:=conv table(w1,w2);
sn w0 0 ; if w0=0 then
jl. a3. ; goto conv error;
rl. w3 b1. ;
se w3 1 ; if oprt<>logical oprt then
jl. w3 d37. ; outbyte(w0);
a2: bl. w1 x2 g13. ; result express:
lo. w1 f26. ; w1:=type numb to bit(w2)+
jl. (b0.) ; expresskind; return;
a3: jl. w2 d19. ; conv error: type error;
a4: rl. w1 f12. ; result undef: w1:=undefined;
jl. (b0.) ; return;
; action-table:
; it holds for each value of oprt a byte with an action address
h. g14: c0-d18, c1-d18, c2-d18, c3-d18;
e.
b. a5,b8 ; procedure errormessage
; one of the entries is called whenever an error message is to be
; output, and there is an entry for each different error detected
; in pass6, and one entry,error record, for errors detected in
; previous passes, in which case the next 3 inputbytes holds:
;
; a)errorclass, used to index table errortextaddr to get
; a pointer to the wanted message
;
; b)2 bytes with aux.information to be output as integers if
; different from 0.
; the message is output on current output as:
; line <line no>. <no.operands in line> <error text>
; if the message is not just a warning,see table errortextaddr, a
; trouble byte is output.
; the procedure is called as:
; jl. w2 d19. ; type error
; or jl. w2 d20. ; subscript error
; or jl. w2 d21. ; zone error
; or jl. w2 d22. ; call error
; or jl. w2 d23. ; label error
; or jl. w2 d24. ; error record
; or jl. w2 d25. ; label not referred
; globals: f8
; local variables:
w. b0: 0 ; return address
b1: <:.:> ; pointtext
b2: <: :> ; spacetext
b3: 0 ; errorident
b4: 0 ; aux inf
b5: <: <12><10> programunit <0>:>
b6: <: page <0>:>
b7: <:<10> error messages<10><0>:>
b8: <:label not referred<0>:>
; entry:
d19: jl. w1 a0. ; type error: w1:=type text;
<:type:> ; goto trouble;
d20: jl. w1 a0. ; subscript error:w1:=subscript text;
<:subscripts:> ; goto trouble;
d21: jl. w1 a0. ; zone error: w1:= zone text;
<:zone:> ; goto trouble;
d22: jl. w1 a0. ; call error: w1:= call text;
<:call:> ; goto trouble;
d23: jl. w1 a0. ; label error: w1:= label text;
<:label:> ; goto trouble;
d25: al. w1 b8.+1 ; label not referred:w1:=b8 text;
jl. a0. ; goto trouble;
d27: jl. w1 a0. ; standard zone error:goto trouble;
<:external zone not in catalog<0>:>
d24: rs. w2 b0. ; error record:
jl. w3 d36. ;
bl. w1 x2 g16. ; w1:=errortextaddr(inbyte);
sl w1 0 ; if w1>=0 then
jl. a4. ; goto get aux inf;
al w2 2047 ;
la w1 4 ; w1:=w1 and signmask;
al. w1 x1 +g15. ;
jl. d41. ; alarm(errorbase(w1));
a4: ; get aux inf:
al. w1 x1 +g15. ; w1:=errorbase(w1);
jl. w3 d36. ;
hs. w2 b4. ; aux inf:=inbyte<12+inbyte;
jl. w3 d36. ;
hs. w2 b4.+1 ;
rl. w2 b0. ; w2:=return address;
a0: rs. w2 b0. ; trouble: save return addr;
sz w1 1 ; if bit(23)of text addr=1
jl. a5. ; then goto out error mess;
al w0 h19 ; comment just a warning;
jl. w3 d37. ; outbyte(trouble);
al w0 2 ;
am -2000 ; set warning.yes
rs. w3 e87.+2000 ;
a1: rs. w1 b3. ; out error mess: errorident:=w1;
rl. w1 f32. ; line no.:=line no.+1;
al w1 x1 +1 ;
sh. w1 (f33.) ; if lineno.>=lines pr page
jl. a2. ; then begin
al. w1 b5. ; writetext(b5);
jl. w3 d40. ;
rl. w1 f17. ; writetext(head address);
jl. w3 d40. ; comment name of unit;
al. w1 b6. ;
jl. w3 d40. ; writetext(b6);
rl. w0 f34. ;
ba. w0 1 ; page:=page+1;
rs. w0 f34. ;
jl. w3 d39. ; writeinteger(<:ddd:>,page);
32<12+3 ;
al. w1 b7. ;
jl. w3 d40. ; writetext(b7);
al w1 1 ; line no.:=1;
; end
a2: rs. w1 f32. ;
al. w1 b1. ;
jl. w3 d38. ; message(<:.:>);
rl. w0 f8. ;
jl. w3 d39. ; writeinteger(no.operands);
32<12+3 ;
al. w1 b2. ;
jl. w3 d40. ; writetext(<: :>);
rl. w1 b3. ;
jl. w3 d40. ; writetext(errorident);
rl. w1 b4. ;
a3: al w0 0 ; for i:=1,2do
rs. w0 b4. ;
ld w1 12 ; if byte(i) of auxinf=0
sn w0 0 ; then return
jl. (b0.) ; else writeinteger(byte(i));
jl. w3 d39. ;
32<12+5 ; return;
jl. a3. ;
a5: ; test warning modebits:
am -2000 ;
rl. w3 e29.+2000 ;
sz w3 1<1 ; if warning.yes then
jl. a1. ; goto out error message;
jl. (b0.) ; return;
e.
b. b37 ; block for errortexts
; errorbase gives the start of errormessages for errors detected
; in previous passes
w.g15:
b0: <:illegal<0>:>
b1: <:graphic<0>:>
b2: <:short text<0>:>
b3: <:bitpattern<0>:>
b4: <:too many significant digits<0>:>
b5: <:exponent too big<0>:>
b6: <:format error before comma no.<0>:>
b7: <:label syntax<0>:>
b8: <:continuation mark on a labeled line<0>:>
b9: <:missing end<0>:>
b10: <:constant outside allowed range<0>:>
b11: <:statement sequence<0>:>
b12: <:syntax error<0>:>
b13: <:statement structure<0>:>
b14: <:missing )<0>:>
b15: <:do construction<0>:>
b16: <:list structure<0>:>
b17: <:labelling error<0>:>
b18: <:do after if<0>:>
b19: <:illegal number of main programs<0>:>
b20: <:+declaration<0>:>
b21: <:no. of subscripts illegal<0>:>
b22: <:no. of zones illegal<0>:>
b23: <:zone dimension<0>:>
b24: <:adjustable dimension<0>:>
b25: <:adjustable bound<0>:>
b26: <:common error<0>:>
b27: <:entry name<0>:>
b28: <:formal in common<0>:>
b29: <:equivalence impossible<0>:>
b30: <:equivalence index trouble<0>:>
b31: <:equivalence subscripts<0>:>
b32: <:dimension equivalenced zone<0>:>
b33: <:dimension equivalenced common variable<0>:>
b37: <:zone specification<0>:>
b34: <:erroneous terminated do range<0>:>
b35: <:unassigned elements, rightmost group no.<0>:>
b36: <:non-common element, rightmost group no.<0>:>
; errortextaddresses holds a pointer to the errortexts for each error-
; type detected in previous passes; an odd pointer causes no trouble
; byte to be output.
; a negative pointer terminates the translation with a message
; found in table errorbase by setting the signbit to 0.
h.g16=k-1
b0-g15 ;
b1-g15 ;
b2-g15 ;
b3-g15 ;
b4-g15 ;
b5-g15 ;
b6-g15 ;
b7-g15 ;
b8-g15 ;
b9-g15 ;
b10-g15 ;
b10-g15 ;
b11-g15 ;
b12-g15 ;
b13-g15 ;
b14-g15 ;
b15-g15 ;
b16-g15 ;
b17-g15 ;
b18-g15 ;
1<11+b19-g15 ;
b20-g15 ;
b21-g15 ;
b22-g15 ;
b23-g15 ;
b24-g15 ;
b25-g15 ;
b26-g15 ;
b37-g15 ;
b27-g15 ;
b28-g15 ;
b29-g15 ;
b30-g15 ;
b31-g15 ;
b32-g15 ;
b33-g15 ;
b34-g15 ;
b35-g15 ;
b36-g15 ;
e.
; table inputentries holds for each inputbyte-and some local defined
; bytes- a pointer to an entry in inputtable
h. g17=k-1
528 , 534 , 540 , 564 ; 1 simple loc , simple com, simple pam, array
576 , 582 , 588 , 558 ; 5 zone , external , ext param , entry name
0 , 0 , 546 , 552 ; 9 stm f.call , stm descr , sim eq arr, sim eq zon
570 , 594 , 600 , 684 ; 13 arr eq zon , comm name , label name, troub opnd
0 , 0 , 606 , 690 ; 17 n.u. , n.u. , label no. , troub left
108 , 114 , 120 , 126 ; 21 arr left , a eq zleft, zoneleft , zarr left
132 , 162 , 168 , 174 ; 25 proc left , idx comma , zone comma, pam comma
180 , 696 , 192 , 198 ; 29 rw comma , troubcomma, end index , end procl
204 , 264 , 720 , 270 ; 33 end rwlist , entry , end trblst, return
414 , 420 , 408 , 402 ; 37 end unit , end pass , begin un , endline
396 , 102 , 186 , 150 ; 41 end stm , begin lst , end list , call
642 , 612 , 624 , 618 ; 45 log const , int const , real con , long con
630 , 636 , 0 , 0 ; 49 doub const , comp const, n.u. , n.u.
258 , 660 , 666 , 0 ; 53 lab decl , end format, con format, n.u.
654 , 708 , 726 , 12 ; 57 trouble , enddeclare, endformdec, dya plus
0 , 6 , -6 , 18 ; 61 n.u. , dya minus , mon minus , multiply
24 , 30 , 60 , 156 ; 65 divide , exponent , shift , list com
324 , 90 , 96 , 372 ; 69 iocom , end range , endpamdesc, data array
0 , 0 , 0 , 0 ; 73 n.u. , n.u. , n.u. , n.u.
0 , 0 , 0 , 0 ; 77 n.u. , n.u. , n.u. , n.u.
0 , 0 , 0 , 0 ; 81 n.u. , n.u. , n.u. , n.u.
0 , 0 , 0 , 378 ; 85 n.u. , n.u. , n.u. , data star
0 , 72 , 0 , 0 ; 89 n.u. , mult ass , n.u. , n.u.
66 , 36 , 36 , 36 ; 93 arit ass , .lt. , .le. , .eq.
36 , 36 , 36 , 42 ; 97 .ge. , .gt. , .ne. , .and.
48 , 54 , 672 , 678 ;101 .or. , .not. , beg cform , beg oform
0 , 0 , 216 , 282 ;105 n.u. , n.u. , if , do
234 , 276 , 138 , 144 ;109 assign lab , stop , read , write
318 , 0 , 78 , 210 ;113 doterm , n.u. , arit left , end call
390 , 84 , 0 , 360 ;117 spark , arit rght , n.u. , imp rght
0 , 648 , 240 , 252 ;121 n.u. , vanish opn, goto simp , comp goto
246 , 228 , 222 , 0 ;125 goto ass , endaritif , endlogif , n.u.
312 , 342 , 0 , 0 ;129 doend , end io , n.u. , n.u.
0 , 0 , 0 , 0 ;133 n.u. , n.u. , n.u. , n.u.
384 , 366 , 330 , 336 ;137 arr data , datainit , imp left , imp do
288 , 738 , 348 , 354 ;141 impinitsp , impinitgen, imp until , imp step
288 , 294 , 300 , 306 ;145 do initsp , do initgen, do until , do step
714 , 462 , 468 , 0 ;149 data , gencomlist, zo comlist, n.u.
432 , 438 , 474 , 516 ;153 locentlist , ext list , labvarlist, area simp
522 , 504 , 498 , 510 ;157 area ar zo , loc arrdec, com arrdev, formarrdec
492 , 486 , 480 , 444 ;161 loczodecl , com zodecl, formzodecl, notdeclab
450 , 456 , 426 , 702 ;165 multdeclab , nulls , glob list , glob and lab
732 ;169 decextzone
; operator table
; part1: 1 byte with priority(5bits)<7+ typecheck(1bit)<6+
; nexttop(1bit)<5 + noresult(1bit)<4 +
; output (1bit)<3 + term.unstack(1bit)<2 +
; name giving(1bit)<1 + modify output(1bit)<0
; part2: 1 byte with name inf if namegivingbit=1 or empty
; part3: 2 bytes with operand mask or empty
; part4: 1 byte with output-value or empty
; part5: 1 byte with action address base
w. 0
h.
g18=k+4
; 0 mon minus:
9<7+ 2.1000001, 0 , 0 ,2. 1110011111, h22+0 , c60-c80
; 6 dya minus:
9<7+ 2.1100001, 0 , 0 ,2. 1110011111, h22+8 , c62-c80
; 12 dya plus:
9<7+ 2.1100001, 0 , 0 ,2. 1110011111, h22+16 , c62-c80
; 18 multiply:
11<7+ 2.1100001, 0 , 0 ,2. 1110011111, h22+24 , c62-c80
; 24 divide:
11<7+ 2.1100001, 0 , 0 ,2. 1110011111, h22+32 , c62-c80
; 30 exponent:
13<7+ 2.1100001, 0 , 0 ,2. 1110001101, h29-7 , c64-c80
; 36 relation
7<7+ 2.1100001, 0 , 0 ,2. 1110001111, 0 , c66-c80
; 42 not
5<7+ 2.1000001, 0 , 0 ,2. 1110100111, h23+0 , c60-c80
; 48 and
3<7+ 2.1100001, 0 , 0 ,2. 1110100111, h23+8 , c63-c80
; 54 or
1<7+ 2.1100001, 0 , 0 ,2. 1110100111, h23+16 , c63-c80
; 60 shift
13<7+ 2.1100001, 0 , 0 ,2. 1110000001, h23+24 , c65-c80
; 66 assign
-3<7+ 2.1110001, 0 , 0 ,2. 1110111111, h24+0 , c61-c80
; 72 mult assign
-3<7+ 2.1100001, 0 , 0 ,2. 1110111111, h24+8 , c61-c80
; 78 arit left
-1<7+ 2.0000100, 0 , 0 , 0, 0 , c79-c80
; 84 end range
13<7+ 2. 0, 0 , 0 , 0, 0 , c71-c80
; 90 end paramdescr
13<7+ 2. 0, 0 , 0 , 0, 0 , c72-c80
; 96 array left
-3<7+ 2.0000111, 0 , 0 , 0, h25+0 , c70-c80
;102 array eq zone left
-3<7+ 2.0000111, 0 , 0 , 0, h25+8 , c70-c80
;108 zone left
-3<7+ 2.0001110, 1 , 0 , 0 , h10+1 , c79-c80
;114 proc left
-3<7+ 2.0000111, 2 , 0 , 0 , h26+0 , c79-c80
;120 indexcomma
-3<7+ 2.0001000, 0 , 0 , 0 , h22+18 , c69-c80
;126 paramcomma
-3<7+ 2.0010001, 0 , 0 , 0 , 0 , c79-c80
;132 rw comma
-3<7+ 2.0010001, 0 , 0 , 0 , 0 , c79-c80
;138 if
-5<7+ 2.1000001, 0 , 0 ,2. 1110111111, h28+0 , c67-c80
;144 end logical if
-9<7+ 2.0001000, 0 , 0 , 0, h7+3 , c79-c80
;150 end arith if
-7<7+ 2.0001000, 0 , 0 , 0, h7+4 , c68-c80
;156 read init
-3<7+ 2.0001110, 3 , 0 , 0, h17+0 , c79-c80
;162 write init
-3<7+ 2.0001110, 3 , 0 , 0, h17+1 , c79-c80
;168 assign label
-7<7+ 2.1111000, 0 , 0 ,2. 10000000001, h14+0 , c79-c80
;174 goto simple
-7<7+ 2.1011000, 0 , 0 ,2.100001000000, h14+2 , c79-c80
;180 goto assign
-7<7+ 2.1011000, 0 , 0 ,2. 10000000001, h14+3 , c79-c80
;186 goto computed
-7<7+ 2.1010000, 0 , 0 ,2. 1110011111, 0 , c73-c80
;192 entry
-7<7+ 2.1011000, 0 , 0 , 0, h13+0 , c79-c80
;198 stop
-7<7+ 2.0011000, 0 , 0 , 0, h13+2 , c79-c80
;204 datainit
-7<7+ 2.1000001, 0 ,2. 110 ,2. 111111, h21+0 , c79-c80
;210 data array
-7<7+ 2.0011000, 0 , 0 , 0, h4+3 , c79-c80
;216 trouble left(:
-3<7+ 2.0000110, 4 , 0 , 0 , 0 , c79-c80
; input table ,operators:
; part1: 1 byte with priority(5bits)<7 +stack(1bit)<1 + output(1bit)
; part2: 1 byte with special information or empty
; part3: 2 bytes with operand mask
; part4: 1 byte with pointer to oprt table or output-value or empty
; part5: 1 byte with action address base
h. g19=k+10
; -6 mon minus:
8<7+1<1+0, 0 ,2. 0 ,2. 0, 0 , c80-c80
; 0 unknown record:
14<7+0 , 0 , 0 , 0 , 0 , c58-c80
; 6 dya minus:
8<7+1<1+0, 0 ,2. 0 ,2. 1110011111, 6 , c17-c80
; 12 dya plus:
8<7+1<1+0, 0 ,2. 0 ,2. 1110011111, 12 , c17-c80
; 18 multiply:
10<7+1<1+0, 0 ,2. 0 ,2. 1110011111, 18 , c17-c80
; 24 divide:
10<7+1<1+0, 0 ,2. 0 ,2. 1110011111, 24 , c17-c80
; 30 exponent:
12<7+1<1+0, 0 ,2. 0 ,2. 1110001111, 30 , c17-c80
; 36 relations:
6<7+1<1+0, 0 ,2. 0 ,2. 1110001111, 36 , c55-c80
; 42 and: part2 contains bytevalue logical and
2<7+1<1+0,h23+9 ,2. 0 ,2. 1110100111, 48 , c18-c80
; 48 or : part2 contains bytevalue logical or
0<7+1<1+0,h23+17,2. 0 ,2. 1110100111, 54 , c18-c80
; 54 not:
4<7+1<1+0, 0 ,2. 0 ,2. 0, 42 , c80-c80
; 60 shift:
12<7+1<1+0, 0 ,2. 0 ,2. 1110000111, 60 , c17-c80
; 66 assign:
-2<7+1<1+0, 0 ,2. 0 ,2. 1100111111, 66 , c20-c80
; 72 mult assign:
-2<7+1<1+0, 0 ,2. 0 ,2. 1100000000, 72 , c19-c80
; 78 arith left( :
14<7+1<1+0, 0 ,2. 0 ,2. 0, 78 , c80-c80
; 84 arith right):
-2<7+0 , 0 ,2. 0 ,2. 0, 0 , c80-c80
; 90 end range:
14<7+1<1+0, 0 ,2. 0 ,2. 0, 84 , c80-c80
; 96 end pamdescription:
14<7+1<1+0, 0 ,2. 0 ,2. 0, 90 , c80-c80
;102 listleft ( :
14<7+0 , 0 ,2. 0 ,2. 0, 0 , c30-c80
;108 array left (:
14<7+1<1+0, 0 ,2. 0 ,2. 0, 96 , c31-c80
;114 arr eq zone left( :
14<7+1<1+0, 0 ,2. 0 ,2. 0, 102 , c31-c80
;120 zone left( :
14<7+1<1+0, 0 ,2. 0 ,2. 0, 108 , c32-c80
;126 z array left(:
14<7+1<1+0, 0 ,2. 0 ,2. 0, 108 , c33-c80
;132 proc left ( :
14<7+1<1+0, 0 ,2. 1000000 ,2. 111111, 114 , c34-c80
;138 read:
14<7+1<1+0,h17+2 ,2. 11111 ,2.001100111111, 156 , c35-c80
;144 write:
14<7+1<1+0,h17+3 ,2. 11111 ,2.001110111111, 162 , c35-c80
;150 call :
12<7+1<1+0, 0 ,2. 1100000 ,2. 1000000, 114 , c53-c80
;156 list comma:
-2<7+0 , 0 ,2. 0 ,2. 0, 0 , c36-c80
;162 index comma:
-2<7+1<1+0, 0 ,2. 0 ,2. 1110011111, 120 , c37-c80
;168 zone comma:
-2<7+0 , 0 ,2. 0 ,2. 1110011111, 0 , c38-c80
;174 param comma:
-2<7+1<1+0, 0 ,2. 0 ,2. 0, 126 , c39-c80
;180 rw comma:
-2<7+1<1+0, 0 ,2. 1001 ,2. 1110000101, 132 , c41-c80
;186 end list:
-2<7+0 , 0 ,2. 0 ,2. 0, 0 , c42-c80
;192 end index:
-2<7+0 , 0 ,2. 0 ,2. 1110011111, 0 , c37-c80
;198 end paramlist:
-2<7+1<1+0,h11+0 ,2. 0 ,2. 0, 126 , c43-c80
;204 end rw list:
-2<7+1<1+0,h11+0 ,2. 110 ,2.101001000010, 132 , c44-c80
;210 end call: treated as a list with no.bytes=0;first byte=parcount
14<7+0 , 0 , 0 , 0 , h11+0 , c6-c80
;216 if:
-4<7+1<1+0, 0 ,2. 0 ,2. 0, 138 , c23-c80
;222 end logif:
-8<7+1<1+0, -1 ,2. 0 ,2. 1110100000, 144 , c24-c80
;228 end arith if:
-6<7+1<1+0, 0 ,2. 0 ,2. 1110001111, 150 , c24-c80
;234 assign label:
-8<7+1<1+0, 0 ,2. 0 ,2.100001000000, 168 , c17-c80
;240 goto s :
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 174 , c80-c80
;246 goto ass:
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 180 , c80-c80
;252 goto comp:
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 186 , c22-c80
;258 decl label: comment treated as an operand
14<7+0 , 1 ,2. 0 ,2. 0, h14+1 , c21-c80
;264 entry:
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 192 , c29-c80
;270 return:
-8<7+0<1+1, 0 ,2. 0 ,2. 0, h13+1 , c77-c80
;276 stop:
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 198 , c80-c80
;282 do :
14<7+0<1+1, 0 ,2. 0 ,2. 0, h16+0 , c76-c80
;288 do init spec:
-8<7+0 , 1-1 ,2. 0 ,2. 100000001, h16+2 , c25-c80
;294 do init gen:
-8<7+0 , 0 ,2. 0 ,2. 100000001, h16+2 , c25-c80
;300 do until:
-8<7+0 , 0 ,2. 0 ,2. 1110011111, h16+4 , c27-c80
;306 do step:
-8<7+0 , 0 ,2. 0 ,2. 1110011111, h16+6 , c28-c80
;312 do end:
-8<7+0 , 0 ,2. 0 ,2. 1110011111, h16+7 , c28-c80
;318 do term:
-8<7+0<1+1, 0 ,2. 0 ,2. 0, h16+8 , c80-c80
;324 io comma:
-2<7+1<1+0, 0 ,2. 0 ,2. 0, 126 , c40-c80
;330 imp left:
-2<7+0 , 0 ,2. 0 ,2. 0, h18+0 , c45-c80
;336 imp do :
-2<7+0 , 0 ,2. 0 ,2. 0, h18+1 , c45-c80
;342 end io :
-2<7+0 , 0 ,2. 0 ,2. 0, h11+0 , c45-c80
;348 imp until:
-8<7+0 , 0 ,2. 0 ,2. 1110011111, h16+4 , c27-c80
;354 imp step:
-8<7+0 , 0 ,2. 0 ,2. 1110011111, h16+6 , c28-c80
;360 imp right:
-8<7+0 , h16+8 ,2. 0 ,2. 1110011111, h16+7 , c28-c80
;366 data init:
-6<7+1<1+0, 0 ,2. 0 ,2. 0, 204 , c56-c80
;372 data array: created by pass6 to unstack data init-type dependent;
-8<7+1<1+0, 0 ,2. 0 ,2. 0, 210 , c80-c80
;378 data star :
-4<7+0<1+1, 0 ,2. 0 ,2. 0, h4+0 , c48-c80
;384 array data:
-4<7+0 , 0 ,2. 0 ,2. 0, h4+1 , c49-c80
;390 spark:
-10<7+0 , 0 ,2. 0 ,2. 0, 0 , c80-c80
;396 end statement:
-10<7+0<1+1, 0 ,2. 0 ,2. 0, h7+0 , c50-c80
;402 end line:
14<7+0<1+1, 0 ,2. 0 ,2. 0, h7+1 , c51-c80
;408 begin unit:
14<7+0<1+1, 0 ,2. 0 ,2. 0, h0+0 , c52-c80
;414 end unit:
-10<7+0 , 0 ,2. 0 ,2. 0, h0+1 , c8 -c80
;420 end pass:
14<7+0<1+1, 0 ,2. 0 ,2. 0, h0+2 , c54-c80
; inputtable ,operands
; part1: 1 byte with priority(5bits)<7
; part2: 1 byte with number of bytes in record -1 or empty
; part3: 2 bytes with operand description
; part4: 1 byte with outbyte-value or empty
; part5: 1 byte with action address base
;426 global entry list:
14<7+0 , 0 ,2. 0 ,2. 0 , h1+0 , c1-c80
;432 local entry list :
14<7+0 , 0 ,2. 0 ,2. 0 , h1+4 , c5-c80
;438 external list:
14<7+0 , 0 ,2. 0 ,2. 0 , h1+3 , c2-c80
;444 not decl labels:
14<7+0 , 0 ,2. 0 ,2. 0 , 0 , c3-c80
;450 multiple decl labels:
14<7+0 , 0 ,2. 0 ,2. 0 , 0 , c3-c80
;456 declared but not referred labels:
14<7+0 , 0 ,2. 0 ,2. 0 , 0 , c7-c80
;462 general common list:
14<7+0 , 0 ,2. 0 ,2. 0 , h1+1 , c6-c80
;468 zone common list:
14<7+0 , 0 ,2. 0 ,2. 0 , h1+2 , c6-c80
;474 label variable list:
14<7+0 , 0 ,2. 0 ,2. 0 , h1+5 , c6-c80
;480 formal zone decl:
14<7+0 , 4 ,2. 0 ,2. 0 , h2+1 , c8-c80
;486 common zone decl:
14<7+0 , 3 ,2. 0 ,2. 0 , h2+5 , c8-c80
;492 local zone decl:
14<7+0 , 8 ,2. 0 ,2. 0 , h2+3 , c78-c80
;498 common array decl:
14<7+0 , 3 ,2. 0 ,2. 0 , h2+4 , c8-c80
;504 local array decl:
14<7+0 , 3 ,2. 0 ,2. 0 , h2+2 , c8-c80
;510 formal array decl:
14<7+0 , 6 ,2. 0 ,2. 0 , h31 , c4-c80
;516 area simple loc:
14<7+0 , 2 , 0 , 0 , h30+0 , c8-c80
;522 area array-zone-param:
14<7+0 , 2 , 0 , 0 , h30+1 , c47-c80
;528 simple local:
14<7+0 , 1 , 0 ,2. 100000000, h5+0 , c9-c80
;534 simple common:
14<7+0 , 2 , 0 ,2. 100000000, h5+1 , c9-c80
;540 simple param:
14<7+0 , 1 , 0 ,2. 100000000, h5+2 , c9-c80
;546 simple eq array:
14<7+0 , 3 , 0 ,2. 100000000, h5+3 , c9-c80
;552 simple eq zone:
14<7+0 , 4 , 0 ,2. 100000000, h5+4 , c9-c80
;558 entry name:
14<7+0 , 1 ,2. 1100000 ,2. 100000000, h5+6 , c13-c80
; notice: the action for <entry name> was earlier c9, but c13 is
; a little bit better, but still not correct, because the
; parameters for a call will not be checked
;564 array ident:
14<7+0 , 5 ,2. 10 ,2. 0, h5+7 , c10-c80
;570 array eq zone:
14<7+0 , 8 ,2. 100 ,2. 0, h5+8 , c10-c80
;576 zone ident:
14<7+0 , 2 ,2. 1000 ,2. 100, h5+9 , c11-c80
;582 external ident:
14<7+0 , 1 ,2. 1100000 ,2. 1000000, h5+10 , c12-c80
;588 external param:
14<7+0 , 1 ,2. 1100000 ,2. 0, h5+11 , c13-c80
;594 common name:
14<7+0 , 0 , 0 , 0, h19+0 , c9-c80
;600 label variab:
14<7+0 , 1 , 0 ,2. 10000000000, h5+5 , c9-c80
;606 label no.:
14<7+0 , 0 , 0 ,2.100001000000, 0 , c14-c80
;612 constant integer:
14<7+0 , 2 , 0 ,2. 10000001, h6+2 , c15-c80
;618 constant long:
14<7+0 , 4 , 0 ,2. 10000010, h6+4 , c15-c80
;624 constant real:
14<7+0 , 4 , 0 ,2. 10000100, h6+3 , c15-c80
;630 constant double:
14<7+0 , 8 , 0 ,2. 10001000, h6+5 , c15-c80
;636 constant complex:
14<7+0 , 8 , 0 ,2. 10010000, h6+6 , c15-c80
;642 constant logical:
14<7+0 , 1 , 0 ,2. 10100000, h6+1 , c15-c80
;648 vanished operand:
14<7+0 , 0 , 0 , 0, 0 , c16-c80
;654 trouble:
14<7+0 , 0 , 0 , 0, 0 , c57-c80
;660 end format:
14<7+0 , 2 , 0 , 0, h8+0 , c8-c80
;666 continue format:
14<7+0 , 2 , 0 , 0, h8+1 , c8-c80
;672 begin closed format:
14<7+0 , 2 , 0 , 0, h7+6 , c8-c80
;678 begin open format:
14<7+0 , 2 , 0 , 0 , h7+5 , c8-c80
;684 trouble operand: treated as external param
14<7+0 , 0 ,2.11111111 ,2.111110000000, h19+1 , c13-c80
;690 trouble left(:
14<7+1<1+0, 0, 0 , 0, 216 , c80-c80
;696 troub comma:
-2<7+1<1+0, 0 ,2. 0 ,2. 0, 126 , c74-c80
;702 globals and labels in unit:
14<7+0 , 0 , 0 , 0 , 0 ,c59-c80
;708 end declarations:
14<7+0 , 0 , 0 , 0 , h7+7 , c8-c80
;714 data
14<7+0 , 0 , 0 , 0 , h7+8 , c8-c80
;720 end trouble list:
-2<7+1<1+0,h11+0 ,2. 0 ,2. 0, 126 , c75-c80
;726 end formal declaration:
14<7+0 , 0 ,2. 0 ,2. 0, h7+9 , c8-c80
;732 declare external zone:
14<7+0 , 1 ,2. 1000 ,2. 100, h2+6 , c46-c80
;738 imp init gen:
-8<7+0 , 0 ,2. 0 ,2. 100000001, h16+2 , c25-c80
; operator stack bottom
w. -11<19
; global base
1<23+15<18+40<12+0 ; first paramword
0 ; second paramword
j2=k-j0
; assignment of intermediates
i0 = 88 ; address of endpamdescript,part3 in oprt table
i1 = 71 ; end pamdescript entry
i2 = 21 ; begin array list entry
i3 = 22 ; begin array eq zone list entry
i4 = 23 ; begin zone list entry
i5 = 24 ; begin zarray list entry
i6 = 25 ; begin proc list entry
i7 = 26 ; index comma entry
i8 = 27 ; zone comma entry
i9 = 28 ; paramcomma entry
i10 = 29 ; rw comma entry
i11 = 31 ; end index list entry
i12 = 32 ; end proc list entry
i13 = 33 ; end rw list entry
i14 = -10<7 ; spark priority
i15 = 19 ; label no. entry
i16 = 94 ; .lt. inputbyte value
i17 = 72 ; data array entry
i18 = 70 ; end range entry, not used
i19 = 20 ; trouble left( entry
i20 = 30 ; troub comma entry
i21 = 35 ; end troub list
i22 = 15 ; unknown proctype
i23 = g19-g17 ; stepping stone
i24 = -5<7 ; commaunstack priority
i25 = i23-4 ; stepping stone
e30 = e30 + j2 ; length := length + length pass 6;
i.
e.
m. rc 85.10.02 fortran, pass 6
\f
▶EOF◀