|
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: 59136 (0xe700)
Types: TextFile
Names: »ass32tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ass32tx «
\f
m. slang text 2
m.rc 1977.09.27
; input procedures
; procedure next delim;
; comment: scans the input up to the next delimiter and determines
; the operand situation. the meaning of the operand situation is:
; 0: no operand
; 1: unknown operand
; 2: real
; 3: textstring
; 4: integer
; 5: absolute identifier
; 6: relative identifier
; 7: load address
; call: exit:
; w0 opsit
; w1 delim value
; w2 delim type
; w3 return destroyed;
b.b3,a20
w.e7: rs.w3 b0. ; begin
ld w3 -65 ; save(w3);
ds.w3 g8. ; operand:= opsit:= 0;
al w3 10
rs.w3 g30. ; radix:= 10;
rl.w3 g18.
sn w3 6 ; if prog state=6 then
jl. a12. ; goto init real;
al w3 1
rs.w3 g11. ; delim state:= 1;
a0: ; cont scan:
; procedure next char;
; comment: reads the next compound character and determines the
; type. the meaning of the type values are:
; 0: letter a b .... ø a b .... ø
; 1: digit 0 1 2 3 4 5 6 7 8 9
; 2: point .
; 3: sign - +
; 4: special , / = : ( <33> <38> <42> <63>
; 5: less gr < >
; 6: end line ; nl
; 7: blank bl )
; 8: syllable aa .... øø a. .... ø. w0 .... x9 (: :)
; 9: digit point 0. 1. 2. 3. 4. 5. 6. 7. 8. 9.
; 10: text term <: :>
; 11: exponent <39>
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 char
; w3 char type
; symbol if compound then second char else undefined
; ahead if compound then 0 else second char;
b.b1,a4 ; begin
w.e6: al w0 0 ; char state:= 0;
rl.w3 g2. ; symbol:= ahead;
al w2 0 ; ahead:= 0;
rx.w2 g4. ; if symbol=0 then
sn w2 0 ; read:
a0: jl.w1 e5. ; next symbol;
a1: sn w0 0 ; save:
ds.w3 g0. ; if char state=0 then
; save(char,char type);
sn.w3 8 ; if chartype<>blind then
jl. a4. ; begin
al w1 x2 ; compute sum and doublesum:
wa.w1(g78.) ; sum := sum + char;
rs.w1(g78.) ;
wa.w1(g79.) ; doublesum := doublesum + sum;
rs.w1(g79.) ;
a4: ; end;
bz.w1 x3+d1. ; index:= entry(symbol type)
wa w1 0 ; +char state;
bl.w1 x1+d1. ; char action:= char matrix(index);
b1: jl. x1+0 ; goto case char action of (
f3=a0-b1 ; 0: digit again,
; 1: letter again,
; 2: again,
; 3: read,
; 4: colon read,
; 5: colon,
; 6: not compound,
; 7: register,
; 8: compound,
; 9: colon blank,
; 10: less gr,
; 11: left par,
; 12: comment,
; 13: substitute,
; 14: end medium,
; 15: colon less gr,
; 16: less colon,
; 17: digit point,
; 18: exit,
; 19: blank,
; 20: end line);
f0=-b1. ; digit again:
am 1 ; char state:= 2;
; goto again;
f1=-b1. ; letter again:
al w0 1 ; char state:= 1;
f2=-b1. ; again:
al.w1 a0.+2 ; if intext then
g44: jl. e5. ; goto exit;
; am 0
jl. e8. ; goto read;
j15: jl. e5-g44
f4=-b1. ; colon read:
al w0 5 ; char state:= 5;
jl. a0. ; goto read;
f5=-b1. ; colon:
al w1 4 ; char type:= special;
rs.w1 g0.
f6=-b1. ; not compound:
rs.w2 g4. ; ahead:= symbol;
rs.w3 g2. ; save(symbol type);
dl.w3 g0. ; goto exit;
jl. e8.
f7=-b1. ; register:
rl.w1 g1. ; if char<>w and char<>w
al w1 x1-87 ; and char<>x and char<>x then
sz w1 -34 ; goto not compound;
jl. f6+b1.
f8=-b1. ; compound:
ds.w3 g2. ; symbol type:= char type;
al w3 8 ; char type:= syllable;
jl. a2. ; goto exit;
f9=-b1. ; colon blank:
bl.w1 g44.+1 ; if intext then
sn w1 0 ; goto colon;
jl. f5+b1. ; if symbol=right par then
sn w2 41 ; goto compound;
jl. f8+b1. ; goto read;
jl. a0.
f10=-b1. ; less gr:
sn w2 62 ; if char=greater then
jl. e8. ; goto exit;
al w0 3 ; char state:= 3;
jl. f2+b1. ; goto again;
f11=-b1. ; left par:
al w3 4 ; char type:= special;
rs.w3 g0. ; char state:= 4;
al w0 4 ; goto again;
jl. f2+b1.
f12=-b1. ; comment:
j26: bl.w1 g44.+1 ; if intext then
sn w1 0 ; char type:= new line;
al w3 14
sl w3 12 ; while char type<12 do
jl. 6 ; next symbol;
al.w1 -4
jl. e5.
se w3 14 ; if char type=new line then
jl. 6 ; begin
f20=-b1. ; end line:
al w3 6 ; char type:= end line;
jl. e8. ; goto exit
; end;
sn w3 13 ; if char type=end medium then
jl. a3. ; goto end medium;
f13=-b1. ; illegal:
rs.w0 b0. ; save(w0);
; if list then
jl.w3 e20. ; writeaddrstar
; else writeaddr;
al.w0 c31.
jl.w3 e11. ; writetext(<:illegal:>);
jl.w3 e3. ; writechar(bl);
al w0 x2+0
jl.w3 e10. ; writeinteger(char);
jl.w3 e4. ; writechar(nl);
rl.w0 b0. ; restore(w0);
jl. a0. ; goto read;
b0: 0; saved w0
f14=-b1. ; end medium:
a3: rl.w2 c2.
al.w3 a0. ; if procedure source then
am. (g52.) ; unstack current chain
sn w2(+h20+h2+6); and goto read;
jl. e62. ;
al w3 0
sn.w3(g55.) ; if -,normal then
rs.w2(g34.) ; word(source):= 2<12+2;
jl.w3 e16. ; select next source(save);
jl. a1. ; goto read;
jl. a0.
f19=-b1. ; blank:
bl.w1 g44.+1 ; if intext then
sn w1 0 ; goto exit;
jl. e8. ; while symbol type=blank do
se w3 7 ; next symbol;
jl. a1. ; goto save;
al.w1 -4
jl. e5.
f15=-b1. ; colon less gr:
sn w2 60 ; if char=less then
jl. f5+b1. ; goto colon;
f16=-b1. ; less colon:
am 1 ; char type:= text term;
; goto exit;
f17=-b1. ; digit point:
al w3 9 ; char type:= digit point;
a2: rl.w2 g1.
f18=-b1. ; exit:
c.i0i.z. ; end next char;
e.e8:
a1: bz.w1 x3+d2. ; exam char:
wa.w1 g11. ; index:= delim matrix entry(char type)
bz.w0 x1+d2. ; +delim state;
al w1 63 ; element:= delim matrix(index);
la w1 0 ; delim state:= element(0:5);
ls w0 -6 ; delim action:= element(6:11);
rs.w0 g11.
bl.w1 x1+4
b3: jl. x1+0 ; goto case delim action of (
h. a0-b3 ; 0: cont scan,
f21 ; 1: init radix,
f22 ; 2: init dec,
f23 ; 3: conv radix,
f24 ; 4: init id,
f25 ; 5: rel id,
f26 ; 6: pair,
f27 ; 7: single,
f28 ; 8: after point,
f29 ; 9: before point,
f30 ; 10: set real,
f31 ; 11: sign,
f32 ; 12: exponent,
f33 ; 13: after exp,
f34 ; 14: init text,
f35 ; 15: init num,
f36 ; 16: end num,
f37 ; 17: text char,
f38 ; 18: end text,
f39 ; 19: unknown,
f40 ; 20: text unknown,
f41 ; 21: end line,
f42 ; 22: slang fault);
w.f21=-b3. ; init radix:
al w1 8 ; if opsit=8 then
rx.w1 g8. ; goto unknown;
sn w1 8 ; opsit:= 8;
jl. a17.
rl.w1 g7.
wm.w1 g30. ; radix:= radix*operand;
am x2-48
al w1 x1+0
rs.w1 g30. ; radix:= radix-48+char;
al w0 0
rs.w0 g45. ; after digit:= false;
rs.w0 g7. ; operand:= 0;;
jl. a0. ; goto cont scan;
f22=-b3. ; init dec:
al w0 4
rs.w0 g8. ; opsit:= 4;
f23=-b3. ; conv radix:
rl.w1 g7.
wm.w1 g30. ; operand:= radix*operand;
am x2-48
al w1 x1+0
rs.w1 g7. ; operand:= operand-48+char;
al w1 -1
rs.w1 g45. ; after digit:= true;
jl. a0. ; goto cont scan;
f24=-b3. ; init id:
la.w2 c12. ; id letter:= char mod 32;
rs.w2 g5.
sl w2 23 ; if id letter>=23 then
jl. a17. ; goto unknown;
se w2 11 ; if id letter=11 then
jl. a2. ; begin
al w0 3 ; delim state:= 3;
rs.w0 g11. ; opsit:= 7
am 2 ; end
a2: al w0 5 ; else
rs.w0 g8. ; opsit:= 5;
jl. a0. ; goto cont scan;
f25=-b3. ; rel id:
al w0 6
rs.w0 g8. ; opsit:= 6;
jl. f23+b3. ; goto conv radix;
f26=-b3. ; pair:
rl.w1 g3. ; symbol:= symbol
sl w1 96 ; -(if symbol>=96 then 64
am -32 ; else 32);
am x1-32 ; goto init search;
f27=-b3. ; single:
al w1 0 ; symbol:= 0;
; init search:
sl w2 96 ; char:= char
am -32 ; -(if char>=96 then 64
al w2 x2-32 ; else 32);
ls w2 6 ; syllable:= (char shift 6)+symbol;
wa w1 4
rs.w1 d4. ; syllable list(last):= syllable;
ls w2 -6
wa w2 2 ; index:= (syllable+char)
la.w2 c10. ; mod 16;
bz.w2 x2+d3. ; index:= syllable list entry(index);
a3: bz.w0 x2+1+d3. ; again:
sn w0 x1+0 ; if syllable list(index+1)=syllable then
jl. a4. ; goto found;
al w2 x2+2 ; index:= index+2;
jl. a3. ; goto again;
a4: se w2 d4-d3 ; found:
jl. a5. ; if index=last then
rl.w1 g0. ; begin
se w1 0 ; if char type<>letter then
jl. a16. ; goto not found;
rs.w1 g2. ; symbol type:= letter;
rs.w1 g11. ; delim state:= 0;
rl.w1 g3.
rs.w1 g4. ; ahead:= symbol;
ls w0 -6
se w0 43 ; if char=<k> then
jl. 8 ; begin
al w1 3 ; delim state:= 3;
rs.w1 g11. ; opsit:= 7;
am 6 ; goto cont scan
al w1 1 ; end;
rs.w1 g8. ; opsit:= 1;
jl. a0. ; goto cont scan
; end;
a5: bz.w1 x2+d3. ; syllable:= syllable list(index);
a6: al w2 63 ; unpack:
la w2 2 ; delim value:= syllable(0:5);
ls w1 -6 ; delim type:= syllable(6:11);
ds.w2 g13.
rl.w0 g8. ; test opsit:
sn w0 2 ; if opsit=2 then
jl. a20. ; goto conv real;
se w0 8 ; if opsit<>8 then
jl. (b0.) ; goto exit;
al w0 4 ; opsit:= 4;
rl.w3 g45.
sn w3 0 ; if -,after digit then
al w0 1 ; opsit:= 1;
rs.w0 g8.
jl. (b0.) ; goto exit;
a20: rl.w3 g45. ; conv real:
se w3 0 ; if -,after digit then
jl. a7. ; begin
al w0 1 ; opsit:= 1;
rs.w0 g8. ; goto exit
jl. (b0.) ; end;
a7: al w3 0
sn.w3(g60.) ; if real=0 then
se.w3(g50.) ; begin
jl. a8. ; real(24:47):= 2048;
rl.w3 c14. ; goto exit
rs.w3 g50. ; end;
jl. (b0.)
w.c1: c0 ; reference
g52: -1 ; fp base
a8: rl.w1 g47. ; if -,after exp then
sn.w3(g49.) ; frac sign:= sign;
rs.w1 g48.
wm.w1 g7. ; exponent:= sign*operand
ws.w1 g9. ; -point loc;
rs.w1 g47. ; save(exponent);
al w0 1
ci w0 0 ; factor:= 1.0;
a10: sn w1 0 ; while exponent<>0 do
jl. a11. ; begin
sh w1 0 ; if exponent<=0 then
am 2 ; exponent:= exponent+1
al w1 x1-1 ; else exponent:= exponent-1;
fm.w0 c11. ; factor:= factor*10
jl. a10. ; end;
a11: ds.w0 b2.
rl.w1 g60.
ci w1 24 ; real:=
bz.w3 g50. ; floating(real(0:23))
ci w3 12
fa w1 6 ; +floating(real(24:35))
bz.w3 g61.
ci w3 0 ; +floating(real(36:47));
fa w1 6
rl.w2 g47.
sl w2 0 ; if saved exponent<0 then
jl. 6 ; real:= real/factor
fd.w1 b2. ; else real:= real*factor;
jl. 4
fm.w1 b2.
rl.w3 g48.
ci w3 0
fm w1 6 ; real:= real*frac sign;
ds.w1 g50.
al w0 2 ; opsit:= 2;
dl.w2 g13.
jl. (b0.) ; goto exit;
a12: al w0 8 ; init real:
rs.w0 g11. ; delim state:= 8;
ld w1 -65 ; after digit:= false;
ds.w1 g49. ; after exp:= false;
rs.w0 g9. ; point loc:= 0;
ds.w1 g50. ; real:= 0;
al w1 1
rs.w1 g47. ; sign:= 1;
jl. a0. ; goto cont scan;
f28=-b3. ; after point:
al w0 1
wa.w0 g9.
rs.w0 g9. ; point loc:= point loc+1;
f29=-b3. ; before point:
al w0 -1
rs.w0 g45. ; after digit:= true;
al w2 x2-48
dl.w0 g50.
ad w0 2
aa.w0 g50.
ad w0 1
wa w0 4
sx 2.01
al w3 x3+1
ds.w0 g50. ; real:= real*10+char-48;
f31=-b3. ; sign:
al w1 -1
sn w2 45 ; if char=minus then
rs.w1 g47. ; sign:= -1;
f30=-b3. ; set real:
al w0 2
rs.w0 g8. ; opsit:= 2;
jl. a0. ; goto cont scan;
f32=-b3. ; exponent:
al w1 1
rx.w1 g47. ; frac sign:= sign;
rs.w1 g48. ; sign:= 1;
al w0 0
al w1 1
sn.w0(g45.) ; if -,after digit then real:= 1;
ds.w1 g50. ; after digit:= false;
ds.w1 g49. ; after exp:= true;
jl. f30+b3. ; goto set real;
f33=-b3. ; after exp:
al w0 -1
rs.w0 g45. ; after digit:= true;
jl. f23+b3. ; goto conv radix;
f34=-b3. ; init text:
rl.w0 g1.
sn w0 58 ; if char=colon then
jl. a17. ; goto unknown;
al w0 1
la.w0 g23.
wa.w0 g23.
rs.w0 g15. ; text addr:= prog top+prog top(23);
rl.w0 c9.
rs.w0 g44. ; intext:= true;
a13: al w0 0 ; clear text buffer:
rs.w0 g14. ; text buffer:= 0;
al w0 16
rs.w0 g29. ; text count:= 16;
jl. a0. ; goto cont scan;
f35=-b3. ; init num:
sn w2 62 ; if char=greater then
jl. a14. ; goto text char;
al w0 7
rs.w0 g11. ; delim state:= 7;
al w0 0
rs.w0 g7. ; operand:= 0;
jl. a0. ; goto cont scan;
f36=-b3. ; end num:
sn w2 60 ; if char=less then
jl. a18. ; goto text unknown;
al w2 255
la.w2 g7. ; char:= operand mod 256;
f37=-b3. ; text char:
a14: rl.w1 g29.
ls w2 x1+0 ; word:= char shift text count;
wa.w2 g14. ; word:= word+text buffer;
sh w1 0 ; if text count>0 then
jl. 10 ; begin
al w1 x1-8 ; text count:= text count-8;
rs.w1 g29. ; text buffer:= word;
rs.w2 g14. ; goto cont scan
jl. a0. ; end;
rs.w2(g15.) ; word(text addr):= text buffer;
al w1 2
wa.w1 g15.
rs.w1 g15. ; text addr:= text addr+2;
jl. a13. ; goto clear text buffer;
f38=-b3. ; end text:
al w0 3
rs.w0 g8. ; opsit:= 3;
rl.w0 j15.
rs.w0 g44. ; intext:= false;
rl.w1 g15.
rl.w0 g29.
sl w0 16 ; if text count<16 then
jl. a15. ; begin
rl.w0 g14. ; word(text addr):= text buffer;
rs w0 x1+0
al w1 x1+2 ; text addr:= text addr+2
; end;
a15: rs.w1 g7. ; operand:= text addr;
jl. a0. ; goto cont scan;
a16: rl.w0 j10. ; not found:
rx.w0 e8. ; next char;
rs.w0 j10.
jl. e6.
j10: jl. 2-e8.
rl.w0 j10.
rx.w0 e8.
rs.w0 j10.
f39=-b3. ; unknown:
a17: al w0 1
rs.w0 g8. ; opsit:= 1;
al w0 0
rs.w0 g11. ; delim state:= 0;
jl. a1. ; goto exam char;
f40=-b3. ; text unknown:
a18: al w0 1
rs.w0 g8. ; opsit:= 1;
rl.w0 j15.
rs.w0 g44. ; intext:= false;
al w0 0
rs.w0 g11. ; delim state:= 0;
jl. j26. ; goto comment in next char;
f41=-b3. ; end line:
al w1 17<6+0 ; syllable:= new line;
jl. a6. ; goto unpack;
f42=-b3. ; slang fault:
jl. e51. ; slang fault term;
b0: 0; saved w3 ; exit: end next delim;
b1: 0; working location
b2: 0; working location
c.i0i.z.
e.
c.i0i.z. ; end f names for next char and next delim
e.
; write procedures
b.b7
w.b0: 0 ; working locations
b1: 0 ; for write procedures
b2: 0
b3: 0
b4: 0
b5: 0
b6: 0
; procedure writechar(value);
; comment: prints the character on current output.
; call: exit: store:
; w0 value
; w1 b0
; w2 b1
; w3 return destroyed b2;
w.e19: am 42-10 ; writechar(*)-entry
e4: am 10-32 ; writechar(nl)-entry
e3: al w0 32 ; writechar(bl)-entry
e9: rs.w1 b0. ; begin
ds.w3 b2. ; save(w1);
rl w2 0 ; save(w2,w3);
rl.w3 g52.
c.-1 ; if wanted then the online facility may be retrieved...
se w2 0 ; if value=0
sn w2 10 ; or value=10 then
am h33-h26 ; outend(value)
z.
jl w3 x3+h26-2 ; else outchar(value);
dl.w2 b1. ; restore(w1,w2)
jl. (b2.) ; end writechar;
; procedure writeinteger1(value);
; comment: prints the value including sign on current output.
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 value
; w3 return destroyed;
w. al w0 x2+0
w.e17: al w3 x3+1 ; return:= return+1;
; procedure writeinteger(value);
; comment: prints the value without sign on current output.
; call: exit: store:
; w0 value b0
; w1 b1
; w2
; w3 return destroyed b2;
b.a0
w.e10: ds.w1 b1. ; begin
rs.w3 b2. ; save(w0,w1);
rl.w0 a0. ; save(w3);
ls w0 1
ld w0 -1
rs.w0 a0.
rl.w0 b0.
rl.w3 g52.
jl w3 x3+h32-2 ; outinteger(value);
a0: 1<23+32<12+1
dl.w1 b1. ; restore(w0,w1)
jl. (b2.) ; end writeinteger;
e.
; procedure writetext(text addr);
; comment: prints the text on current output.
; call: exit: store:
; w0 text addr after text addr
; w1 b1
; w2
; w3 return destroyed b0;
w.e11: rs.w1 b1. ; begin
rs.w3 b0. ; save(w1);
rl.w3 g52. ; save(w3);
jl w3 x3+h31-2 ; outtext(text addr);
rl.w1 b1. ; restore(w1)
jl. (b0.) ; end writetext;
; procedure writeaddr;
; comment: prints the load address on current output.
; call: exit: store:
; w0 b3
; w1 b4
; w2 b5
; w3 return destroyed b6;
w.e20: rs.w2 b4. ; if list then
rl.w2 j11. ; return:= odd;
sn.w2(c9.) ; writeaddr;
al w3 x3+1
rl.w2 b4.
jl. e13.
e18: rs.w3 b5. ; if list then
rl.w3 j11. ; writeaddr
se.w3(c9.) ; else
jl. (b5.) ; return;
rl.w3 b5.
e13: ds.w1 b4. ; begin
ds.w3 b6. ; save(w0,w1,w2,w3);
am -2048
rl.w3 j11.+2048 ; oldlist:=list;
rx.w3 c56. ; if list <> old list then
sn.w3(c56.) ; writechar(nl) else
sn.w3(c9.) ; if list then
jl.w3 e4. ; writechar(nl);
rl.w0 g68. ; if lines.yes then
am. (g52.) ;-2
;am 0
j30: jl w3 +h32-2 ; outinteger(<<ddddd>, lineno);
;am 0
0<23+32<12+5 ;+2
;am 0
jl.w3 e52. ; value:= get k;
al w0 x2+0
rl.w3 g52.
jl w3 x3+h32-2 ; outinteger(<<-ddddd>,value);
1<23+32<12+6
rl.w3 b6.
sz w3 2.1 ; if return odd then
am e19-e3 ; writechar(*)
jl.w3 e3. ; else writechar(bl);
jl.w3 e3. ; writechar(bl);
dl.w1 b4. ; restore(w0,w1);
rl.w2 b5. ; restore(w2)
jl. (b6.) ; end writeaddr;
; procedure writeid;
; comment: prints the current identifier on current output.
; call: exit: store:
; w0 b3
; w1 b4
; w2
; w3 return destroyed b5;
w.e12: rs.w3 b5. ; begin
ds.w1 b4. ; save(w3);
rl.w3 g5. ; save(w0,w1);
al w0 x3+96
jl.w3 e9. ; writechar(id letter+96);
rl.w0 g7. ; writeinteger(id index)
jl.w3 e10. ;
dl.w1 b4.
jl. (b5.) ; end writeid;
; procedure writetest(addr,value);
; comment: prints addr and value on current output.
; call: exit: store:
; w0 b4
; w1 addr b5
; w2 value
; w3 return destroyed b3;
w. rs.w3 b3.-2 ; begin
e14: jl x3+0 ; if -,testmode then goto exit;
ds.w1 b5. ; save(w0,w1,w3);
jl.w3 e4. ; writechar(nl);
al w0 x1+0
ws.w0 g31.
jl.w3 e17. ; writeinteger1(addr-first label);
jl.w3 e3. ; writechar(bl);
al w0 x2+0
jl.w3 e17. ; writeinteger1(value);
dl.w1 b5. ; exit:
jl. (b3.) ; end writetest;
; procedure writemessage(text addr);
; comment: prints the message on current output.
; call: exit: store:
; w0 text addr after text addr
; w1
; w2
; w3 return destroyed g69;
w.e15: rs.w3 g69. ; begin
sh.w0 c38. ; if warning.no
j19: am 0 ; and warn then
; jl x3+0 ; goto exit;
; if list then
jl.w3 e20. ; writeaddrstar
; else writeaddr;
al w3 0
rx.w3 g57. ; if id out then
se w3 0 ; writeid;
jl.w3 e12. ; id out:= false;
e63: jl.w3 e11. ; writetext(text addr);
rx w0 2
sl.w1 c35. ; if termination file then
jl.w3 e11. ; writetext(<file>);
sn.w1 c40. ; if connect procedure source then
jl.w3 e17.-2 ; writeinteger1(sourcenumber);
sn.w1 c34. ; if text=
jl. 6 ; halfword overflow
se. w1 c43. ; or
jl. 6 ; text=address overflow
rl. w0 g10. ; then
jl. w3 e17. ; writeinteger(byte value);
jl.w3 e4. ; writechar(nl);
dl.w1 b4.
sn.w0 c28. ; if <type> then
jl. (g69.) ; goto exit;
rl.w3 g76. ; increase(no of error messages);
al w3 x3+1 ;
rs.w3 g76. ;
sh.w0 c28. ; if warn then
am 1 ; warn := true else
al w3 1
lo.w3 g53. ;
rs.w3 g53. ; error:= true;
sh.w0 c39. ; if error return then
jl. (g69.) ; goto exit;
sl.w0 c30. ; if term then
jl. d6. ; goto end slang;
al w3 0
rs.w3 g18. ; prog state:= 0;
rl.w0 g8. ; restore(opsit);
dl.w2 g13. ; restore(delim value,delim type);
jl. d9. ; goto look up delim;
; exit:
; end writemessage;
c.i0i.z.
e.
; procedure output <begin>; (called from action ...begin...)
; comment extends the blockhead with 3 words, one of which
; gives the blocknumber of the surrounding block
; prepares an xref record with recordtype = <begin>.
; calls output xref record;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 stacktop destroyed
; w3 return
w.e54: rl.w0 c46. ; begin
rs w0 x2-4 ; word(stacktop-4) := 4095 shift 12;
al w0 0 ; word(stacktop-2) := 0;
rl.w1 g72. ; word(stacktop) := current blockno;
ds w1 x2 ;
al w2 x2-6 ; stacktop := stacktop - 6;
rs.w2 g26. ;
sh.w2(g23.) ; if stacktop <= prog top then
jl. e46. ; stack term;
al w0 1<2 ; blockno := current blockno
wa.w0 g66. ; := global blockno
sh w0 1<11-1-1; if blockno>max then blockno:=max;
rs.w0 g66. ; := global blockno + increment;
rs.w0 g72. ; recordtype := <begin>;
rl.w1 c49. ; output xref record and return(w0,w1);
jl. e60. ; end;
; procedure output <xref mode>; (called from action ...set xrefmode...)
; procedure output <k assignment>; (called from ...new label...)
; comment prepares an xref reord with recordtype = <xref mode>
; or <k assignment>.
; calls output xref record;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 return
w.e61: am -2 ; begin recordtype := if <xrefmode> then
e55: rl.w1 c47. ; <xrefmode> else <k assignment>;
al w0 0 ; if <kassignment> then
se.w1(c47.) ; blockno:=0 else
rl.w0 g72. ; blockno := current blockno;
jl. e60. ; output xref record and return(w0,w1);
; end;
; procedure output <end>; (called from action ...end...)
; comment prepares an xref record with recordtype = <end> and
; blockno = current blockno.
; updates current blockno according to the surrounding
; block.
; calls output xref record;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 stacktop destroyed
; w3 return
w.e56: rl.w1 c48. ; begin
rl w0 x2-6 ; recordtype := <end>;
rx.w0 g72. ; blockno := current blockno;
jl. e60. ; current blockno := word(stacktop-6);
; output xref record and return(w0,w1);
; end;
; procedure output <define>; (called from ...load id...)
; comment searches in the identifierstack for the id-letter
; and id-index associated to stackentry.
; prepares an xref record with recordtype =
; (<define>,<id-letter>,<id-index>) and blockno =
; local blockno.
; calls mark xref record;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 return
b.a1
w.e53: rl.w1 g26. ; begin idpointer := stacktop;
rl.w0 g72. ; blockno := current blockno;
a1: bz w2 x1+3 ; next id: idindex := byte(idpointer+3);
ls w2 2 ; idlength := idindex*4;
al w1 x1+6 ;
wa w1 4 ; idpointer := idpointer+6+idlength;
sl.w1(g27.) ; if idpointer >= stackentry then
jl. a0. ; goto found;
bl w2 x1+2 ; id letter := byte(idpointer+2);
sn w2 63 ; if idletter = 63 then
rl w0 x1 ; blockno:= word(idpointer);
jl. a1. ; goto next id;
; local blockno now contains the blockno corresponding
; to the identifier.
; idpointer is the stackentry of the last identifier with
; the same idletter.
a0: ws w1 4 ; found: id<0>address := idpointer-idlength;
rl.w2 g27. ; idindex := (stackentry-id<0>address)//4;
ws w2 2 ;
bz w1 x1-4 ; idletter := byte(id<0>address-4);
ls w2 10 ;
ld w2 13 ; packed ident := idletter shift 13 + idindex*2;
jl. e59. ; mark xref record and return(w0,w1);
e. ; end;
; procedure output <use>; (called from ...def operand...)
; comment prepares an xref record with recordtype =
; (<use>,<idletter>,<idindex>) and blockno = current blockno.
; continues as output declaration;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 return
w.e57: rl.w0 g7. ; w0 := idindex;
al w3 x3+1 ; return := odd return;
; procedure output <declaration>; (called from action ...declare2...)
; comment prepares an xref record with recordtype =
; (<declaration>,<idletter>,<idindex>) and
; blockno = current blockno.
; continues as mark xref record or calls output xref record;
; call: exit:
; w0 idindex destroyed
; w1 destroyed
; w2 destroyed
; w3 return
w.e58: rl.w1 g5. ; w1 := idletter;
ls w1 12 ; packed ident := recordtype :=
wa w1 0 ; idletter shift 12 + idindex * 2;
ls w1 1 ;
rl.w0 g72. ; blockno := current blockno;
so w3 1 ; if output decl then
jl. e60. ; output xref record and return(w0,w1);
rl.w0 g67. ; blockno := local blockno;
al w1 x1+1 ; packed ident := packed ident add usebit;
; procedure mark xref record;
; call:
; w0 blockno
; w1 packed ident
; w2
; w3 return
w.e59: lo.w1 c45. ; recordtype := packed ident add assign-or-use-bit;
; procedure output xref record;
; comment if xref is not specified return is made immediatly.
; else the record is completed with lineno and k-value.
; call: exit:
; w0 blockno destroyed
; w1 recordtype destroyed
; w2 destroyed
; w3 return
w.e60: ;jl x3+0 ; if not xref then return;
am -2048 ;
rl.w2 g70.+h3+0+2048; w2 := record base;
ls w0 -2 ; record(1:2) :=
ls w1 4 ; blockno shift 38
ld w1 14 ; +packed ident shift 18
wa.w1 g77. ; +current lineno;
ds w1 x2+4 ;
al w2 x2+4 ; increase(record base);
al w0 1 ; increase(no of xref records);
wa.w0 g73. ;
rs.w0 g73. ;
am -2048 ;
al.w1 g70.+2048 ;
rs w2 x1+h3+0 ;
sl w2(x1+h3+2) ; if no more space in xref buffer then
jl (x1-g70+g41); outblock(xref zone) and return;
jl x3+0 ; return;
\f
; constants
w.c2: 2<12+2
c51: 2<12+10 ; (<newline>,<name>)
c52: 4<12+10 ; (<space>,<name>)
c53=k+2
c54=k+6, <:slangxref<0>:> ; name of xref output program...
c3: jl x1+0
c4: jl x3+0
c5: 4096
c6: 1022<2
c7: am-2048 ; stepping stone: goto end program
jl. d6.+2048
c8: jl x1+0 ; list off
c55: jl x1+0 ;+2 saved list
; am 0
c9: am 0 ;+4 list on
c56: jl x1+0 ; old list (used at select t-input)
c10: 15
f.c11: 10
w.c12: 31
c13: 63<12
c14: 2048
c15: 1<23+8
; xref:
c46: 4095<12 ; identification of blocknumber-block
0 ;c47-2 recordtype of <xref mode>
c47: 1<19 ; recordtype of <k assign>
c48: 63<13 ; recordtype of <end>
c49: 1 ; recordtype of <begin>
c45= c47 ; mark for define or use
; texts
w.c22: <:<10>***slang <0>:>
c27: <:id list<10>b.<0>:>
c29: <:sorry<0>:>
<:<10>slang ok<0>:>
; warning texts
c31: <:illegal<0>:>
c32: <:relative<0>:>
c33: <:address overflow: <0>:>
c43: <:halfword overflow: <0>:>
c34: <:syntax<0>:>
c38: <:repetition<0>:>
; c38 must be the last warning text
; error return texts
c28: <:type <0>:>
; c28 must be the first error return text
c21: <:end source<0>:>
c37: <:undefined at end<0>:>
c39: <:program too big<0>:>
; c39 must be the last error return text
; error texts
c20: <:syntax<0>:>
c23: <: declaration<0>:>
c24: <: undeclared<0>:>
c25: <: definition<0>:>
c26: <: undefined<0>:>
; termination texts
c30: <:stack<0>:>
; c30 must be the first termination text
c36: <:jump<0>:>
c42: <:slang fault<0>:>
c41: <:source unknown <0>:>
c50: <:connect source <0>:>
; c40 must be the first text after c50
; termination file texts
c40: <:connect <0>:>
c35: <:no text <0>:>
; c35 must be the second termination file text
; variables 2
w. ; g0 and g1 used together
g1: 0 ; char
g0: 0 ; char type
; g2 and g3 used together
g3: 0 ; symbol
g2: 0 ; symbol type
g4: 0 ; ahead
g5: 0 ; id letter (1:22 except 11)
; g7 and g8 used together
g7: 0 ; operand and id index
g8: 0 ; opsit
g9: 0 ; point loc
g11: 0 ; delim state
; g12 and g13 used together
g12: 0 ; delim value
g13: 0 ; delim type
g14: 0 ; text buffer
g15: -1 ; text addr
h.g16: 0 ; op part
g22: 0 ; addr part
w.g17: 0 ; control word
; g18 and g19 used together
g18: 0 ; prog state
g19: 1 ; old prog state
g20: 0 ; operator
g21: 0 ; block level
; g24 and g25 used together
g24: -1 ; operand top
g25: -1 ; operator top
g27: -1 ; stack entry
g28: -1 ; block entry
g29: 0 ; text count
g30: 0 ; radix
g31: -1 ; first label
g32: -1 ; core top
g42: -1 ; seg addr
; g45 and g49 used together
g45: 0 ; after digit
g49: 0 ; after exp
g47: 0 ; sign
g48: 0 ; frac sign
g60: 0
h.g50: 0 ; real
g61: 0 ; exponent
w.g51: 0 ; outside segment
g53: 0 ; error
g54: 0 ; head
g55: -1 ; normal
g57: 0 ; id out
; g58 and g59 used together
g58: 0 ; working location
g59: 0 ; working location
g66: 1 ; global blocknumber (must be uneven)
g67: 0 ; local blocknumber ( of identifier )
g72: 0 ; current blocknumber
g68: 1 ; lineno (starting from 1)
g77: 0 ; current lineno
g10: 0
g69: 0 ; saved return from writemessage and test addr 1
; g70=xref zone
; g71=xref share
g73: 0 ; no of xref records
g74: 0 ; source name address
g75: 0 ; base of procedure names
g76: 0 ; no of error messages
g80: 0 ; link(from jump insert identifier)
g81: 0 ; value(from jump insert identifier)
; jump variables
; g23 and g26 used together
w.g23: -1 ; prog top
g26: -1 ; stack top
g33: -1 ; note addr
g62: -1 ; last k addr
g56: -1 ; result name addr
g82: jl. j43. ; goto jump insert identifier;
g78: 0 ; abs address of sum (i.e. s0)
g79: 0 ; abs address of doublesum (i.e. s1)
; program procedures
e41: rl.w0 g58. ; procedure declaration error;
rs.w0 g7. ; begin id index:= save index;
am c23-c24 ; id out:= true;
; write error(<: declaration:>)
; end;
e42: am c24-c25 ; procedure undeclared error;
; begin id out:= true;
; write error(<: undeclared:>)
; end;
e43: am c25-c26 ; procedure definition error;
; begin id out:= true;
; write error(<: definition:>)
; end;
e44: al.w0 c26. ; procedure undefined error;
al w2 -1 ; begin id out:= true;
rs.w2 g57. ; write error(<: undefined:>)
jl. e15. ; end;
e51: am c42-c37 ; procedure slang fault term;
; write term(<:slang fault:>);
e45: am c37-c30 ; procedure undefined at end error;
; write error(<:undefined at end:>);
e46: am c30-c32 ; procedure stack term;
; write term(<:stack:>);
e47: am c32-c33 ; procedure relative warn;
; write warn(<:relative:>);
e48: am c33-c43 ; procedure address overflow warn;
; write warn(<:address overflow:>);
e34: am c43-c38 ; procedure halfword overflow
; write warn(<:halfword overflow:>);
e49: am c38-c34 ; procedure repetition warn;
; write warn(<:repetition:>);
e50: am c34-c20 ; procedure syntax warn;
; write warn(<:syntax:>);
e40: al.w0 c20. ; procedure syntax error;
jl. e15. ; write error(<:syntax:>);
; procedure round addr;
; comment: the prog top is set to the nearest word address.
; call: exit:
; w0 destroyed
; w1 return
; w2 destroyed
; w3 destroyed;
w.e21: rl.w2 g23. ; begin
so w2 2.1 ; if prog top(23)=1 then
jl x1+0 ; load byte(0)
al w2 0 ; end round addr;
; procedure load byte(value);
; comment: loads the next byte in the object program.
; call: exit:
; w0 destroyed
; w1 return
; w2 value destroyed
; w3 destroyed;
b.a0
w.e22: rx.w1 g23. ; begin
hs w2 x1+0 ; byte(prog top):= value(12:23);
bl w2 5 ; value:= value(12:23);
jl.w3 e14. ; write test(prog top,value);
al w1 x1+1 ; prog top:= prog top+1;
jl. a0. ; goto test room
; end load byte;
; procedure load word(value);
; comment: loads the next word in the object program.
; call: exit:
; w0 destroyed
; w1 return
; w2 value destroyed
; w3 destroyed;
w.e23: rx.w1 g23. ; begin
rs w2 x1+0 ; word(prog top):= value;
jl.w3 e14. ; write test(prog top,value);
al w1 x1+2 ; prog top:= prog top+2;
a0: al w3 x1+0 ; test room:
rx.w1 g23.
sl.w3(g26.) ; if prog top>=stack top then
jl. e46. ; stack term
jl x1+0 ; end load word;
c.i0i.z.
e.
; procedure prep expr;
; comment: sets the operand top and the operator top.
; call: exit:
; w0
; w1 operand top
; w2 operator top
; w3 return;
w.e24: dl.w2 g26. ; begin
sz w1 2.1 ; operand top:=
al w1 x1+1 ; prog top+prog top(23);
ds.w2 g25. ; operator top:= stack top
jl x3+0 ; end prep expr;
; procedure get id(undeclared);
; comment: searches for the stack entry of the current identifier.
; call: exit:
; w0 destroyed
; w1 word(stack entry)
; w2 stack entry
; w3 return;
b.a3
w.e25: al w0 0 ; begin
rs.w0 g51. ; outside segment:= false;
rl.w0 g72. ; local blocknumber := current blocknumber;
rs.w0 g67. ;
rl.w2 g26.
al w2 x2+2 ; stack entry:= stack top+2;
a0: bl w1 x2+0 ; exam:
sn w1 0 ; if byte(stack entry)=0 then
jl x3+0 ; goto undeclared;
rl w0 x2+4
sn w1 -1 ; if byte(stack entry)=4095 then
rs.w0 g67. ; local blocknumber := word(stack entry+4);
sn w1 63
sn w0 0
jl. a3. ; if byte(stack entry)=63
al w0 -1 ; &word(stack entry+4)<>0 then
rs.w0 g51. ; outside segment:= true;
a3: bz w0 x2+1
se.w1(g5.) ; if id letter<>byte(stack entry) then
jl. a1. ; goto next;
rl.w1 g7.
sl w0 x1+0 ; if id index<=byte(stack entry+1) then
jl. a2. ; goto found;
a1: ls w0 2 ; next:
wa w2 0 ; stack entry:= stack entry
al w2 x2+6 ; +4*byte(stack entry+1)+6;
jl. a0. ; goto exam;
a2: ls w1 2 ; found:
wa w2 2
al w2 x2+4 ; stack entry:= stack entry
rs.w2 g27. ; +4*id index+4
rl w1 x2+0
jl x3+2 ; end get id;
c.i0i.z.
e.
; procedure def addr(address);
; comment: defines the load address (k) which corresponds to an
; absolute assembly address by searching for the last address
; label in the object program.
; call: exit:
; w0
; w1 assembly addr label pointer
; w2 load addr
; w3 return;
b.b0,a2
w.e26: rs.w1 b0. ; begin
rl.w1 g31. ; label pointer:= first label;
jl. a1. ; goto first;
a0: wa w2 2 ; again:
al w2 x2+4 ; next:= next+label pointer+4;
sl.w2(b0.)
jl. a2. ; if next>=address then goto found;
al w1 x2+0 ; label pointer:= next;
a1: rl w2 x1+0 ; first:
sl w2 0 ; next:= word(label pointer);
jl. a0. ; if next>=0 then goto again;
a2: ac w2 x1+4 ; found:
wa.w2 b0. ; def addr:= address-(label pointer+4)
wa w2 x1+2 ; +word(label pointer+2)
jl x3+0 ; end;
b0: 0; assembly address
c.i0i.z.
e.
; procedure test byte 1(value);
; comment: works as test byte except for the address output
; which is the prog link instead of the current load addr.
; call: exit:
; w0
; w1
; w2 value
; w3 return;
b.b4,a8
w.j44: al w3 x3+1 ; flag:=half
am c5-c14 ; upper:= 4096;
; goto test;
; procedure test addr 1(value);
; comment: works as test addr except for the address output
; which is the prog link instead of the current load addr.
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 value
; w3 return destroyed;
w.j0: sl.w2(c14.) ; upper:= 2048;
jl. 8 ;
sh w2 2047 ; if value<2048 or
j39: sh w2 2047 ; value>testup (note: may be changed)
jl. 4 ; then goto alarm;
jl. 6 ; test:
j40: sl w2 -2048 ; if value<upper
jl x3+0 ; and value>=testlow (initially -2048) then
ds.w3 g69. ; goto exit;
; if list then
jl.w3 e20. ; writeaddrstar
; else writeaddr;
rl.w1 b2.
jl.w3 e26.
al w0 x2+0
jl.w3 e10. ; writeinteger(def addr(prog link));
jl.w3 e3. ; writechar(bl);
jl.w3 e3. ; writechar(bl);
rl. w3 g69.
sz w3 2.1
am c43-c33
al.w0 c33.
jl.w3 e63. ; writemessage(<:addr or half overflow:>);
jl. (g69.) ; exit:
jl x3+0
j1: jl x3+0
; procedure load id(value);
; comment: follows the program link and distributes the value of an
; identifier. the procedure is modified when used to output the
; addresses in the program link.
; call: exit:
; w0 destroyed
; w1 id value destroyed
; w2 destroyed
; w3 return destroyed;
e27: rs.w1 b0. ; begin
rs.w3 b1.
bl.w3 j6. ; if not modified then
h. sn w3,rs w2 x1 ;
w.j31: jl.w3 e53. ; output <define>;
;am 0
rl.w1 b0. ; (reestablish register after output)
rl.w3 g27. ; prog link:= word(stack entry-2);
rx w1 x3-2 ; word(stack entry-2):= value;
rs.w1 b2.
rl w2 x3+0
sz w2 2.11 ; if word(stack entry)(22:23)<>0 then
jl. (b1.) ; goto exit;
jl. a1. ; goto test long;
a0: al w2 0 ; more long:
rl.w0(b2.) ; rel:= if word(prog link)(23)=1 then
sz w0 2.1 ; def addr(prog link) else 0;
jl.w3 e26.
ac w2 x2+0 ; id:= value-rel;
wa.w2 b0.
rl.w1 b2. ; old link:= prog link;
rl w3 x1+0
ls w3 -2 ; prog link:= word(old link) shift -2;
rs.w3 b2. ; if modified then
j6: rs w2 x1+0 ; writeinteger1(def addr(old link))
; jl.w3 e26. ; else
j7: jl.w3 e14. ; begin
; jl.w3 e17.-2 ; word(old link):= id;
rl.w1 b2. ; write test(old link,id)
; end;
a1: se w1 0 ; test long:
jl. a0. ; if prog link<>0 then
rl.w1(g27.) ; goto more long;
ls w1 -2 ; prog link:= word(stack entry) shift -2;
sn w1 0 ; if prog link=0 then
jl. (b1.) ; goto exit;
a2: bz w3 x1+0 ; more short:
rs.w1 b2. ; next link:= byte(prog link);
rs.w3 b3.
al w2 0 ; rel:= 0;
so w3 2.1
jl. a6.
jl.w3 e26. ; if next link(23)=1 then
rl.w3 b3. ; rel:= def addr(prog link)
sz w3 2.10 ; -next link(22);
am -1
a6: ac w2 x2+0
wa.w2 b0. ; id:= value-rel;
so w3 2.10 ; if next link(22)=0 then
am j44-j0 ; test byte 1(id)
jl.w3 j0. ; else test addr 1(id);
rl.w1 b2. ; if modified then
j8: hs w2 x1+0 ; writeinteger1(def addr(prog link))
; jl.w3 e26. ; else
j9: jl.w3 e14. ; begin
; jl.w3 e17.-2 ; byte(prog link):= id;
rl.w3 b3. ; write test(prog link,id)
; end;
ls w3 -2 ; next link:= next link shift -2;
sn w3 0 ; if next link=0 then
jl. (b1.) ; goto exit;
rl.w1 b2.
sn w3 1023 ; if next link=1023 then
jl. a3. ; goto extended;
ws w1 6 ; prog link:= prog link-next link;
jl. a2. ; goto more short;
a3: rl.w3 g32. ; extended: next link:= core top;
jl. a5. ; goto match;
a4: al w3 x3-4 ; search: next link:= next link-4;
a5: se w1(x3+0) ; match:
jl. a4. ; if word(next link)<>prog link then
rl w1 x3-2 ; goto search;
jl. a2. ; prog link:= word(next link-2);
b0: 0; value ; goto more short;
b1: 0; saved w3 ; exit:
b2: 0; prog link ; end load id;
b3: 0; next link
c.i0i.z.
e.
; procedure def operand(undefined);
; comment: defines the integer value of the current operand.
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 operand value
; w3 return destroyed;
b.b1,a0
w.e28: rl.w2 g7. ; begin
rl.w0 g8. ; operand value:= operand;
sn w0 4
jl x3+2 ; if opsit=4 then goto exit;
rs.w3 b0.
sn w0 7
jl. a0. ; if opsit=7 then goto def k;
al w2 0
sn w0 6 ; rel:= if opsit=6 then get k
jl.w3 e52. ; else 0;
rs.w2 b1.
jl.w3 e25. ; get id(undeclared error);
jl. e42.
j32: jl.w3 e57. ; output <use>;
;am 0
rl.w2 g27. ; (reestablish registers after output)
rl w1 x2+0 ;
sz w1 2.11 ; if word(stack entry)(22:23)=0 then
jl. 4
jl. (b0.) ; goto undefined;
rl w2 x2-2 ; operand value:=
ws.w2 b1. ; word(stack entry-2)-rel;
jl. 4 ; goto exit;
a0: jl.w3 e52. ; def k:
rl.w3 b0. ; operand value:= get k;
jl x3+2 ; exit:
b0: 0; saved w3 ; end def operand;
b1: 0; rel
c.i0i.z.
e.
; integer procedure get byte link;
; comment: creates a program link for an undefined byte. if the
; program link exceeds 12 bits it is replaced by the value 1023
; shift 2 and an extended link is placed below the stack.
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 byte link
; w3 return destroyed;
b.a0
w.e29: ; begin
rl.w2 g23.
ls w2 2 ; new link:= prog top shift 2;
al w1 x2+0 ; old link:= word(stack entry);
rx.w1(g27.) ; word(stack entry):= new link;
ws w2 2 ; link:= if old link=0 then 0 else
sn w1 0 ; new link-old link;
al w2 0
sh.w2(c6.) ; if link<=1022 shift 2 then
jl x3+0 ; goto exit;
ls w1 -2 ; link:= old link shift -2;
rl.w2 g26. ; move pointer:= stack top;
a0: al w2 x2+2 ; move stack:
rl w0 x2+0 ; move pointer:= move pointer+2;
rs w0 x2-4 ; word(move pointer-4):= word(move pointer);
se.w2(g32.) ; if move pointer<>core top then
jl. a0. ; goto move stack;
rs w1 x2-2 ; word(core top-2):= link;
rl.w1 g23.
rs w1 x2+0 ; word(core top):= prog top;
rl.w2 g26.
al w2 x2-4
rs.w2 g26. ; stack top:= stack top-4;
sh.w2(g23.) ; if stack top<=prog top then
jl. e46. ; stack term;
rl.w2 g28.
al w2 x2-4
rs.w2 g28. ; block entry:= block entry-4;
rl.w2 g78. ; change abs addresses of sum and
rs.w2 g79. ; doublesum...;
al w2 x2-4 ;
rs.w2 g78. ;
al w2 -4 ; link:= 1023 shift 2;
jl x3+0 ; exit: get byte link:= link
c.i0i.z. ; end get byte link;
e.
; procedure new label;
; comment: completes the last address label in the object
; program with size information and initialises a new label
; with size = -1.
; call: exit:
; w0 destroyed
; w1 return prog top
; w2 destroyed
; w3 destroyed;
b.b0
w.e30: rs.w1 b0. ; begin save(w1);
jl.w1 e21. ; round addr;
j33: jl.w3 e55. ; output <k assignment>;
;am 0
rl.w1 g23. ; def addr(prog top);
jl.w3 e26.
ws w2 x1+2 ; word(label pointer):=
rs w2 x1+0 ; load addr-word(label pointer+2);
jl.w3 e14. ; write test(label pointer
al w2 -1 ; ,word(label pointer));
jl.w1 e23. ; load word(-1);
rl.w1 g23.
rs.w1 g62. ; last k:= prog top
jl. (b0.) ; end new label;
b0: 0; saved w1
c.i0i.z.
e.
; procedure exam local(id action);
; comment: each stack entry which is local to the current block is
; looked up by this procedure and is examined by a piece of code
; supplied in the call.
; call: jump: exit:
; w0 destroyed
; w1 word(st entry) destroyed
; w2 stack entry block entry-2
; w3 return return destroyed;
b.b1,a1
w.e31: rl.w2 g26. ; begin
a0: al w2 x2+2 ; stack entry:= stack top;
bl w1 x2+0 ; next decl:
rs.w1 g5. ; stack entry:= stack entry+2;
sn w1 63 ; id letter:= byte(stack entry);
jl x3+0 ; if id letter=63 then goto exit;
bz w1 x2+1
rs.w1 b0. ; id limit:= byte(stack entry+1);
al w1 0 ; id index:= 0;
a1: rs.w1 g7. ; next id:
al w2 x2+4 ; stack entry:= stack entry+4;
rs.w2 g27.
rs.w3 b1.
rl w1 x2+0
jl w3 x3+2 ; id action;
rl.w1 g7.
rl.w2 g27.
rl.w3 b1.
sn.w1(b0.) ; if id index=id limit then
jl. a0. ; goto next decl;
al w1 x1+1 ; id index:= id index+1;
jl. a1. ; goto next id
b0: 0; id limit ; end exam local;
b1: 0; saved w3
c.i0i.z.
e.
; procedure test byte(value);
; comment:
; call: exit:
; w0
; w1
; w2 value
; w3 return;
w.e33: am c5-c14 ; upper:= 4096;
; goto test;
; procedure test addr(value);
; comment:
; w0
; w1
; w2 value
; w3 return;
w.e35: sl.w2(c14.) ; upper:= 2048;
jl. 8 ;
sh w2 2047 ; if value<2048 and
j41: sh w2 2047 ; value>testup (note: may be changed)
jl. 4 ; then goto alarm;
jl. 6 ; test:
j42: sl w2 -2048 ; if value<upper
jl x3+0 ; and value>=testlow (initially -2048) then
rs. w2 g10. ; save value
se w0 0 ;
am e34-e48 ; alarm(half)
jl. e48. ; goto exit;
; byte value warn;
; exit:
; end;
; procedure get k;
; comment: gets the load address of the program top.
; call: exit:
; w0
; w1 label pointer
; w2 load addr
; w3 return;
w.e52: rl.w1 g62. ; begin
al w1 x1-2 ; label pointer:= last k-2;
rl.w2 g23.
al w2 x2-2
ws.w2 g62. ; get k:= prog top-last k-2
wa.w2(g62.) ; +word(last k)
jl x3+0 ; end;
m. slang text 2 included
▶EOF◀