|
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: 37632 (0x9300)
Types: TextFile
Names: »do31tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »do31tx «
\f
; dotext part 1 (of 2)
c.h57<3
b. g5, i2 w. ; for insertproc
d.
p.<:fpnames:>
l.
z.
c.h57<2
b. g5, i2 w. ; for insertproc
z.
m. dotext begin version for system 2 and 3
; do, an rc 4000 fp utility program
; torkild glaven
; rc 14.11.70
; changes: jens ramsbøl
; rc 27.06.75
b.g99w.
s.g0,q1,k=h55w.
b.j0w. ; helping block
w.g1: g0 ; length, saved return
g2: <:***:> ; three stars
g36: 0 ; g2+2 ; empty text
g3: 0 ; ok bit
g5: 2<12+2 ; the parameter: <nl>
; g7: jl x3+0 ; return instruction
g8=h57 ; fp version
; variables
; g10: 0 ; param addr
; g11: 0 ; prog name addr
; g12: 0 ; item
; g13: 0 ; out name addr
; g14: 0 ; saved register
; g15: 0 ; saved register
; g16: 0 ; param
; procedure outchar(44);
; procedure outchar(47);
; procedure outend(10);
; procedure outchar(32);
; procedure outchar(61);
; procedure outchar(46);
; call: exit:
; w0 unchanged
; w1 destroyed
; w2 destroyed
; w3 link unchanged;
g20: am 44-47 ; char:= 44
g21: am 47-10 ; or 47
g22: am 10-32 ; or 10
g23: am 32-61 ; or 32
g24: am 61-46 ; or 61
g25: al w2 46 ; or 46;
rl.w1 q1. ; q1=g61
jl. h26. ; outchar(char);
; procedure end program(sorry);
w.g28: am j0 ; ok bit:= false;
; procedure end program(ok bit);
w.g26: rl.w2 g3.
se w2 -1 ; if ok bit<>-1 then
jl.w3 h7. ; end program(ok bit)
jl. h10.+h76 ; else goto fp interrupt service addr;
; procedure outinteger(<<d>,value);
; call: exit:
; w0 value destroyed
; w1 destroyed
; w2 link unchanged
; w3 destroyed;
w.g27: rl.w1 q1. ; q1=g61
jl.w3 h32.
1
jl x2+0
j0=g27+4-g3
; procedure init program;
; comment: saves param address, program name address, and output
; name address, and generates names for eventually stack chains.
; may only be called once before any variable is assigned.
; call: exit:
; w0 delim
; w1 link unchanged
; w2 out name addr
; w3 call pointer destroyed;
w.g30: ; begin
g10: rs.w3 g10. ; param addr:= call pointer;
g11: al w2 x3+2 ; prog name addr:= call pointer+2;
g12: ds.w3 g12. ; item:= call pointer;
g13: bl w0 x3+0 ; out name addr:=
g14: sn w0 6 ; if byte(call pointer)=6 then
g15: am x3-8 ; call pointer-8
g16: al w2 0 ; else 0;
rs.w2 g13.
jl x1+0 ; end;
; error texts
w.g31: <:connect <0>:>
g32: <:param <0>:>
g33: <:call<10><0>:>
g34: <:syntax<0>:>
g35: <:end medium<10><0>:>
; g36: <:<0>:> (g36=g2+2)
; procedure error(text addr);
; call: exit:
; w0 unchanged
; w1 destroyed
; w2 text addr destroyed
; w3 link destroyed;
w.g46: am g36-g35 ; empty error entry: text:= <::>
g45: am g35-g34 ; end medium error entry: or <:end medium<10>:>
g44: am g34-g33 ; syntax error entry: or <:syntax:>
g43: am g33-g32 ; call error entry: or <:call<10>:>
g42: am g32-g31 ; param error entry: or <:param :>
g41: al.w2 g31. ; connect error entry: or <:connect :>;
g40: ds.w0 g15. ; error entry:
al.w0 g2.
jl.w3 h31.-2 ; outtext(<:***:>);
rl.w0 g11.
jl.w3 h31.-2 ; outtext(prog name addr);
al w0 x2+0
jl.w3 g23. ; outchar(32);
jl.w3 h31.-2 ; outtext(text addr)
rl.w0 g15.
jl. (g14.) ; end;
; procedure get param(end list);
; comment: delivers the next parameter as the value of an integer
; or the address of a name.
; call: exit:
; w0 length
; w1 delim
; w2 param
; w3 link next delim;
w.g50: ; begin
rl.w2 g10. ; addr:= param addr;
ba w2 x2+1 ; addr:= addr+byte(addr+1);
rs.w2 g10. ; param addr:= addr;
bl w1 x2+0 ; delim:= byte(addr);
bl w0 x2+1 ; length:= byte(addr+1);
sh w1 2 ; if delim<=2 then
g7: jl x3+0 ; goto end list;
al w3 x3+2
rs.w3 g14.
am (0) ; next delim:= byte(addr+length);
bl w3 x2+0
al w2 x2+2 ; param:= addr+2;
sn w0 4 ; if length=4 then
rl w2 x2+0 ; param:= word(param)
rs.w2 g16.
jl. (g14.) ; end;
; procedure just list param(end list);
; comment: executes the procedure list param except for the call of
; param error and the terminating new line.
; procedure list param(end list);
; comment: lists the current parameter as a parameter error and the
; following parameters up to the first space. the procedure continues
; with get param.
; call: exit:
; w0 length
; w1 delim
; w2 param
; w3 link next delim;
b.a6w. ; begin
w.g51: am a0 ; just list param entry:
g52: al w2 a5 ; destroy outend(10) at exit;
rs.w3 g1. ; goto start;
hs.w2 a4. ; list param entry:
se w2 2 ; param error;
jl.w3 g42. ; start:
a6: rl.w1 g10. ; addr:= param addr;
bl w0 x1+1 ; length:= byte(addr+1);
bl w1 x1+0 ; delim:= byte(addr);
jl.w3 x1+g22.-2 ; outchar(character(delim));
rl.w3 g10.
se w0 4 ; if length=4 then
jl. a1.
rl w0 x3+2
jl.w2 g27. ; outinteger(<<d>,param)
jl. a2.
a1: al w0 x3+2
rl.w1 q1. ; q1=g61
jl.w3 h31. ; else outtext(param);
a2: jl.w3 g50. ; get param(exit);
jl. a3.
se w1 4 ; if delim<>4 then
jl. a6. ; goto start;
a4=k+1
a3: jl.w3 g22. ; exit:
a5=g22-a3,a0=2-a5 ; if not destroyed then
rl.w2 g10. ; outend(10);
rl.w3 g1. ; param addr:= param addr-length;
jl. g50.+4 ; get param(end list)
i.e. ; end;
; g60 and g61 are used for determinig the output zone;
g60: 0 ;
g61: 0 ;
q1=g61
i.e. ; end helping block
b.a42,b80,c16,d23,e39,f99,i1
; assembly variables
f0=4<12+10 ; space,name
f1=17 ; x words
f2=28 ; first compound
f3=3 ; format niveaus
f4=6 ; names per line
f5=30 ; repeat niveaus
w.f10: jl. a3. ; goto after interrupt
; procedure increase addr;
; call: exit:
; w0 unchanged
; w1 next addr
; w2 unchanged
; w3 link unchanged;
w.b1: rl.w1 e15. ; begin
sh w1 7 ; if next addr<=7 then
jl. a28. ; goto core addr error;
rs.w1 e13. ; write addr:= next addr;
sl.w1(e14.) ; if next addr>=write top then
jl. (e32.) ; goto return(write item);
al w1 x1+2 ; next addr:= next addr+2;
rs.w1 e15. ; exit:
jl x3+0 ; end;
; procedure write word;
; procedure write bytes;
; procedure write text;
; procedure write octets;
; procedure write sixtets;
; procedure write octal;
; procedure write binary;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 unchanged
; w3 link destroyed;
b.j5 ; begin
b4=k-10
w.b5: am 24<6-12<6+ 8- 5; word: bits:= 24; digits:= 8;
b6: am 12<6- 8<6+ 5-16; bytes: or bits:= 12; digits:= 5;
b7: am 8<6- 8<6+16- 4; text: or bits:= 8; digits:= 16;
b8: am 8<6- 6<6+ 4- 3; octets: or bits:= 8; digits:= 4;
b9: am 6<6- 3<6+ 3-12; sixtets: or bits:= 6; digits:= 3;
b10:am 3<6- 1<6+12-10; octal: or bits:= 3; digits:= 12;
b11:al 1<6 +10 ; binary: or bits:= 1; digits:= 10;
ld w1 -6
hs.w0 j1.
ls w1 -18
hs.w1 j2.
rs.w2 j5. ;
rs.w3 e30.
sl w1 10 ; if digits>=10 then
jl.w3 g23. ; outchar(32);
jl.w3 g23. ; outchar(32);
al w2 0 ; bit:= 0;
j0: rl.w1 e16. ; next:
ls w1 x2+0 ; word:= value shift bit;
al w0 0
j1=k+1
ld w1;bits ; byte:= word(0:bits-1);
bl.w1 j2.
sl w1 10 ; if digits>=10 then
jl. j3. ; goto characters;
rl.w1 g61. ;
jl.w3 h32. ; outinteger(<digits>,byte);
j2=k+1
1<23+32<12;+digits
jl. j4. ; goto exit;
j3: ; characters:
rx w2 0 ; if digits=10 and byte<>0
jl. x1-8 ; or digits=12 then
se w2 0 ; byte:= byte+2;
am 2 ; if digits<16 then
al w2 x2+46 ; byte:= byte+46;
sh w2 126 ; if byte>126
sh w2 31 ; or byte<=31 then
al w2 32 ; byte:=32;
rl.w1 g61. ;
jl.w3 h26. ; outchar(byte);
rl w2 0 ; exit:
j4: ba.w2 j1. ; bit:= bit+bits;
sh w2 23 ; if bit<=23 then
jl. j0. ; goto next
rl.w2 j5. ;
jl. (e30.) ; end;
j5: 0
i.e.
; procedure new line;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
w.b12: rl.w0 e15. ; begin
rs.w0 e13. ; write addr:= next addr;
jl. g22. ; outend(10)
; end;
; procedure write empty;
; call: exit:
; w0 write addr
; w1 unchanged
; w2 unchanged
; w3 unchanged;
w.b13: rl.w0 e14. ; begin
rs.w0 e13. ; write addr:= write top;
jl. (e32.) ; goto return(write item)
; end;
; procedure write index;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j1 ; begin
w.b14: ; if w or z=-2 then
rl.w0 e27. ; goto return(write item);
sn w0 -2 ; if w or z<>0 then
jl. (e32.) ; begin
sn w0 0 ; w or z:= -2;
jl. j1. ; goto exit
al w0 -2 ; end;
rs.w0 e27.
jl x3+0
j1: rs.w3 e30.
jl.w3 b1. ; increase addr;
rl.w0 e13.
ws.w0 e12. ; index:= write addr-write base;
sh w0 -1 ; sign:=
am 2 ; if index<=-1 then 45
al w2 43 ; else 43;
hs.w2 j0.
sh w0 -1 ; if index<=-1 then
ac w0(0) ; index:= -index;
sh w0 9 ; if index<=9 then
jl.w3 g23. ; outchar(32);
sh w0 99 ; if index<=99 then
jl.w3 g23. ; outchar(32);
j0=k+1
al w2;sign ; if index<=999 then
rl.w1 g61. ;
sh w0 999 ; outchar(sign);
jl.w3 h26. ; outinteger(<<d>,index);
jl.w2 g27. ; exit:
jl. (e30.) ; end;
i.e.
; procedure write double;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j3 ; begin
w.j0: al w1 0 ; procedure first group(value);
hs.w1 j1. ; begin
al w1 32 ; test:= 0;
hs.w1 j2. ; char:= 32;
j1=k+1 ; group(value)
; end;
se w0 0 ; test ; procedure group(value);
jl. j2. ; if value=test then
al.w0 c4. ; outtext(<: :>)
rl.w1 g61. ;
jl. h31. ; else last group(value);
j2=k+1 ; procedure last group(value);
al w1 32; char ; begin
hs.w1 j3. ; fill:= char;
al w1 48 ; char:= 48;
hs.w1 j2.
al w1 -1 ; test:= -1;
hs.w1 j1.
rs.w3 e35. ; outinteger(value)
rl.w1 g61. ;
jl.w3 h32. ; end;
j3: 32<12+6 ; fill
jl. (e35.)
b15: rs.w3 e35.
jl.w3 b1. ; increase addr;
jl.w3 b14. ; write index;
rl.w3 e35.
rs.w3 e30. ; a:= word(write addr-2);
dl.w0(e13.) ; b:= word(write addr);
ld w2 -65 ; a1:= a/1000000;
wd.w3 c2. ; a2:= a mod 1000000;
wd.w2 c15. ; d1:= a2/500000;
ls w2 23 ; d1:= d1 shift 23;
rx w2 2 ; d2:= a2 mod 500000;
rx w3 4 ; b1:= (d2*2**24+b)/1000000;
wd.w0 c2. ; b2:= (d2*2**24+b) mod 1000000;
wa w0 2 ; b1:= b1+d1;
rx w3 4 ; c1:= (a1*2**24+b1)/1000000;
wd.w0 c2. ; c2:= (a1*2**24+b1) mod 1000000;
rs.w3 e31. ; comment: the double value is now
jl.w3 j0. ; c1*10**12+c2*10**6+b2;
rl.w0 e31. ; first group(c1);
jl.w3 j1. ; group(c2);
al w0 x2+0
jl.w3 j2. ; last group(b2)
jl. (e30.)
i.e. ; end;
; procedure write name;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
w.b16: rs.w3 e30. ; begin
jl.w3 g23. ; outchar(32);
jl.w3 g23. ; outchar(32);
rl.w0 e13. ; addr:= write addr;
jl.w3 b1. ; increase addr;
jl.w3 b1. ; increase addr;
jl.w3 b1. ; increase addr;
b3: rl w1 116 ; write name without spaces:
sl w0 8 ; if addr>=8
sl w0 x1-6 ; and addr<core top-6 then
jl. (e30.) ; outtext(addr)
rl.w1 g61. ;
jl.w3 h31.
jl. (e30.) ; end;
; procedure write procname;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
w.b17: rs.w3 e31. ; begin
jl.w3 b5. ; write word;
jl.w3 g25. ; outchar(46);
rl.w1 e16. ; addr:= value;
sh w1 -1 ; if addr<=-1 then
ac w1 x1+0 ; addr:= -addr;
al w0 x1+2 ; addr:= addr+2;
rl.w3 e31.
b2: rs.w3 e30. ; goto write name without spaces
jl. b3. ; end;
; procedure write procnames;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j5 ; begin
w.b18: rs.w3 e31.
jl.w3 b11. ; write binary;
rl w1 78 ; pointer:= first internal;
al w2 0 ; names:= 0;
j0: ds.w1 j3. ; next:
rs.w2 j4.
rl w3 x1+0 ; addr:= word(pointer);
rl.w0 e16. ; if value and word(addr+12)
so w0(x3+12) ; =word(addr+12) then
jl. j2. ; begin
al w0 x3+2 ; addr:= addr+2;
sh w2 f4-1 ; if names>=names per line then
jl. j1. ; begin
rs.w0 j5.
al.w0 c10. ; outtext(<:<10> :>);
rl.w1 g61. ;
jl.w3 h31. ; names:= -1
al w2 -1 ; end;
rl.w0 j5.
j1: al w2 x2+1 ; names:= names+1;
rs.w2 j4.
jl.w3 g23. ; outchar(32);
jl.w3 g23. ; outchar(32);
jl.w3 b2. ; write name without spaces
rl.w2 j4.
j2: dl.w1 j3. ; end;
al w1 x1+2 ; pointer:= pointer+2;
se w1(80) ; if pointer<>name table end then
jl. j0. ; goto next
jl. (e31.) ; end;
0
j3: 0
j4: 0
j5: 0
i.e.
; procedure write code;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j4 ; begin
w.b19: rs.w3 e30.
rl.w0 e16. ; instruction:= value;
al w3 0
ld w0 7
rl.w2 x3+c0. ; load mnemonic code;
la.w3 2.1
ld w0 2
sz w3 2.1
al w2 x2+14 ; add relative bit;
am 1000
rl.w3 x3+f94. ; load register part;
so w2 2.1 ; if w0 irrelevant then
jl. j0. ; begin
am 1000
sn.w3(f94.) ; if w0 then remove register part;
rl.w3 c12. ; remove irrelevant mark
al w2 x2+32-39 ; end;
j0: sh w0 -1 ; if indirect mark then
am 40-32 ; add left par
al w3 x3+32 ; else add space;
ds.w3 e35.
ld w0 2.11 ; displ:= instruction(12:23);
la.w3 c13.
am x3+1000
rl.w2 x3+f95. ; load index part;
sn w3 0 ; if index=0 then
al w2 0 ; remove index part;
sl w0 0 ; if displ>=0
al w2 x2+43 ; and index<>0 then
rs.w2 e36. ; add plus;
bl w2 0
al.w0 e34.
rl.w1 g61. ;
jl.w3 h31. ; outtext(instruction addr);
al w0 x2+0
la.w2 c16.
al w2 x2+1
rs.w2 j4.
rl.w1 g61. ;
jl.w3 h32. ; outinteger(<<d>,displ);
j4: 1<23+1
bl.w1 e16.
sz w1 2.100 ; if indirect instruction then
am 41-32 ; outchar(41)
al w2 32 ; else outchar(32);
rl.w1 g61. ;
jl.w3 h26.
bl.w0 e39.
bl.w1 e16.
sl w0 0 ; if displ>=0
sz w1 2.11 ; and index=0 then
jl. j1. ; outchar(32);
jl.w3 g23.
j1: sh w0 -1 ; if displ<=-1 then
ac w0(0) ; displ:= -displ;
sh w0 9 ; if displ<=9 then
jl.w3 g23. ; outchar(32);
sh w0 99 ; if displ<=99 then
jl.w3 g23. ; outchar(32);
sh w0 999 ; if displ<=999 then
jl.w3 g23. ; outchar(32);
bl.w1 e16.
sz w1 2.11 ; if index<>0 then
jl. j2. ; outtext(<: :>)
so w1 2.1000 ; else if -,relative instruction then
jl. j3. ; outtext(<: :>)
bl.w0 e39. ; else
wa.w0 e13. ; begin
rl.w1 g61. ;
jl.w3 h32. ; rel:= instruction(12:23)
32<12+6 ; +write addr;
jl. (e30.) ; outinteger(<<dddddd>,rel)
j2: jl.w3 g23. ; end
am +2
j3: al.w0 c4.
rl.w1 g61. ;
jl.w3 h31.
jl. (e30.)
i.e. ; end;
; procedure write words5;
; procedure write bytes10;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j1
w.j0: 0
j1: rs.w3 j0. ; store link;
rl.w1 e15. ;
sl.w1(e14.) ; if next addr>=top then
jl. (e31.) ; return to link;
jl.w3 b1. ; increase addr;
rl.w3(e13.) ;
rs.w3 e16. ; value:=word(write addr);
jl.w3 x2+b5. ; write word or bytes;
jl. (j0.) ;
b21: am 2 ; write bytes10:
b20: al w2 0 ; write words5:
rs.w3 e31. ; store link;
jl.w3 x2+b5. ; write word or bytes;
jl.w3 j1. ;
jl.w3 j1. ;
jl.w3 j1. ;
jl.w3 j1. ;
jl. (e31.) ;
i.e.
; constants
; ' means w0 is irrelevant in write code
w.c0: <:aw'do el hl la lo lx wa ws am'wm al ri'jl'jd'je':>
<:xl'es ea zl rl sp're'rs wd rx hs xs'gg di ms'is':>
<:ci ac ns nd as ad ls ld sh sl se sn so sz sx'gp :>
<:fa fs fm ks fd cf dl ds aa ss 58'59'60'61'62'63':>
<:aw'io bl hl la lo lx wa ws am'wm al ml'jl'jd'je':>
<:xl'bs ba bz rl sp'kl rs wd rx hs xs'pl'ps'ms'is':>
<:ci ac ns nd as ad ls ld sh sl se sn so sz sx'ic':>
<:fa fs fm ks fd cf dl ds aa ss 58'59'60'61'62'63':>
c2: 1000000
c3: <: =<0>:>
c4: <: :> ; 6 spaces (terminated by null)
c5: 63 ; last 6 bits
c6: <:niveau<0>:>
c7: <:no core<0>:>
c8: <:core addr<0>:>
c9: <:format<0>:>
c10: <:<10> :>
; c11 used
c12: <: <0>:>
c13: 3 ; last 2 bits
c14: <:clock:>,0,0,0
c15: 500000
c16: 1<23
; references
; f8 used
; f9 used
f11: jl. g22. ; outend(10);
f12: jl. g27. ; outinteger;
f13: rl.w1 g61. ;
jl. h31. ; outtext;
f14: rl.w1 g61. ;
jl. h33. ; outend;
f15: jl. g25. ; outchar(46);
; f96 used
; f97 used
; f98 used
; f99 used
; variables ; w3 copy
w.e0=k+2 ; w0 addr
e1=e0+2 ; w1 addr
e2=e0+4 ; w2 addr
e3=e0+6 ; w3 addr
; z3 copy
; z0 addr
; z1 addr
; z2 addr
; z3 addr
e4=e0+8+10 ; x0 addr
e5=e4+2*f1 ; x1 addr
e6=e4+4*f1 ; x2 addr
e7=e4+6*f1 ; x3 addr
b.j0
w.g70: rs.w1 e23. ; init do;
rs.w2 e11. ; cur com:= current command;
jl.w1 g30. ; init program;
al.w1 e9. ;
wa.w1 e9. ;
se w2 0 ; if left side in call then
al w1 x1+512 ; save addr:=first free addr+share
rs.w1 e9. ; else save addr:=first free addr;
al w1 x1+18+8*f1;
rs.w1 e10. ; buf addr:=save addr+variable length;
rl.w2 e11. ;
sl w1 x2+2 ; if buf addr>=cur com+2 then
jl. a27. ; goto no core error;
al.w1 d0. ; set address of fpnames;
rx.w1 e29.
am h10+h76-h55
rx.w1 h55. ; save(fp interrupt instruction);
rs.w1 e37. ; insert(goto after interrupt);
al.w1 f8.
al w1 x1+2 ; set table references;
al w0 x1+0
wa w0 x1+0
rs w0 x1+0
sh.w1 f9.
jl. -10
al.w1 e38. ;
wa.w1 e38. ; set param addr reference;
rs.w1 e38.
am -2000 ;
al.w1 h21.+2000 ;
rs.w1 g60. ; g60:=h21;
rs.w1 g61. ; g61:=h21;
rl.w2 g13. ; if word(g13)=0 <=>
sn w2 0 ; no left side in call of do
jl. j0. ; then goto restore;
am -2000 ;
al.w1 h19.+2000 ;
rs.w1 g60. ; g60:=h19
jl.w3 h79. ; terminate cur prog zone;
rl.w3 e9. ;
al w3 x3-512 ;
am -2000 ;
rs.w3 h80.+2+2000; insert share addr in sh descr;
al w0 1<1+1 ;
jl.w3 h28. ; connect output;
sn w0 0 ; if no error then
jl. j0. ; goto restore;
; error:
jl.w3 g41. ; error text;
al w2 48 ; w2:=
wa w2 0 ; error cause+48;
jl.w3 h26.-2 ; outchar current;
jl.w3 g23. ; outchar(<sp>);
rl.w0 g13. ; outtext
jl.w3 h31.-2 ; call-name;
jl.w3 g22. ; outchar <nl>;
jl. g28. ; end program(sorry);
j0: al.w3 a34. ; restore variables;
jl. d19. ; goto do;
i.e.
h.r.e4.+8*f1+1
w.e9: e8. ; save addr
e10: 0 ; buf addr
e11: 0 ; cur com
e23: 0 ; fp base
e29: jl. f10-h10-h76; fpnames , goto after interrupt
e12: 0 ; operator , write base , slang addr
e13: 0 ; word , write addr , instruction
e14: 0 ; base , write top , slang mode
e15: 0 ; xy index , next addr
e16: 0 ; step , value , begin name
e39=e16+1
e17: 0 ; value index , text addr , end name
e18: 0 ; old operator , niveau , skip level
e19: 0,r.f5 ; repeat(niveau)
e20: 0 ; written
0 ; addr(niveau)
e21: 0 ; shift(niveau)
e22: 0,r.f3*3-2 ; index(niveau)
d5. ; last action table addr
e24: d4. ; last output table addr
d3. ; last format table addr
d2. ; last word table addr
f8=e24-4
f9=e24+2
e25: 0 ; next delim
e26: 0,r.f5 ; procedure(number)
e27: 0 ; w or z
e28: 0 ; write index
e30: 0 ; saved link
e31: 0 ; saved link
e32: 0 ; saved link
e34: <: <127>:>
<:al.:>
e35: <:w2(:>
e36: <:x1+:>
e33: -2 ; repeat niveau
e37: 0 ; saved fp interrupt instruction
e38: g10. ; param addr reference
; procedure lookup word(index,wz,xy,operator,special,other name);
; call: exit:
; w0 exit
; w1 index
; w2 unchanged
; w3 link unchanged;
b.j1 ; begin
w.d10: rl.w0(g16.) ; word:= word(param);
rs.w0 d2. ; word table(last):= word;
al w1 -2 ; index:= -2;
j0: ; next word:
al w1 x1+2 ; index:= index+2;
se.w0(x1+d1.) ; if word<>word table(index) then
jl. j0. ; goto next word;
rs.w1 e17.
al.w1 x1+d1. ; text addr:= index+word table start;
rx.w1 e17.
sl w1 32 ; if index>=32 then
jl. j1. ; goto not variable;
sl w1 16 ; return:= if index>=16 then
al w3 x3+2 ; xy else wz;
sl w1 16 ; if index>=16 then
al w1 x1-16 ; index:= index-16;
sl w1 8 ; if index>=8 then
al w1 x1+2 ; index:= index+2;
jl x3+0 ; goto return;
j1: ; not variable:
al w1 x1-32 ; index:= index-32;
sh w1 30 ; if index<=30 then
jl x3+4 ; goto operator;
al w1 x1-32 ; index:= index-32;
sh w1 6 ; if index<=6 then
jl x3+6 ; goto special;
jl x3+8 ; goto other name
i.e. ; end;
; procedure lookup format(index,sorry);
; procedure lookup output(index,sorry);
; procedure lookup action(index,sorry);
; call: exit:
; w0 -1
; w1 index
; w2 pointer
; w3 link destroyed;
b.j3 ; begin
w.d11: am 2 ; last:= last addr(format, output,
d12: am 2 ; or action table);
d13: dl.w1 e24. ; entry:= first addr(format, output,
ds.w0 e31. ; or action table);
al w3 x1+0 ; next entry:
j0: al w3 x3+2 ; entry:= entry+2;
rl.w2 g16. ; pointer:= param;
al w1 x3+0 ; index:= entry
wa w1 x1+0 ; +word(entry);
rs.w1 e17. ; text addr:= index;
j1: rl w0 x1+0 ; test word:
se w0(x2+0) ; if word(index)<>word(pointer) then
jl. j2. ; goto not equal;
al w2 x2+2 ; pointer:= pointer+2;
al w1 x1+2 ; index:= index+2;
jl. j1. ; goto test word;
j2: ; not equal:
se w0 -1 ; if word(index)<>-1 then
jl. j0. ; goto next entry;
sl.w1(e31.) ; if index>=last then
jl. (e30.) ; goto sorry;
rl.w3 g10.
j3: rs.w3 g10. ; while pointer>=param addr+2 do
ba w3 x3+1 ; param addr:= param addr
sl w2 x3+2 ; +byte(param addr+1);
jl. j3.
rl.w3 e30.
jl x3+2 ; end;
i.e.
; procedure stack pointer;
; call: exit:
; w0 unchanged
; w1 destroyed
; w2 unchanged
; w3 link unchanged;
w.d14: rl.w1 e33. ; begin
al w1 x1+2 ; niveau:= repeat niveau+2;
sl w1 2*f5 ; if niveau>=2*repeat niveaus then
jl. a1. ; goto list;
rs.w1 e33. ; repeat niveau:= niveau;
rs.w3 x1+e19. ;
rl.w3 g10. ; repeat(niveau):= param addr
rx.w3 x1+e19. ;
jl x3+0 ; end;
; procedure next param(end list,space integer,
; space name,point name,point integer);
; procedure list and next param(end list,space integer,
; space name,point name,point integer);
; call: exit:
; w0 length
; w1 destroyed
; w2 param
; w3 link next delim;
b.j2 ; begin
w.d15: rs.w3 e30. ; next param entry:
jl. j1. ; get param
d16: rs.w3 e30. ; or
j0: am g52-g50 ; list and next param entry:
j1: jl.w3 g50. ; list param
jl. (e30.) ; (end list);
rs.w3 e25. ; save(next delim);
sn w1 8 ; if delim=8 then
jl. j2. ; goto point;
rl.w1 e30. ; if length=4 then
sn w0 4 ; goto space integer;
jl x1+2
jl x1+4 ; goto space name;
j2: rl.w1 e30. ; point:
se w0 4 ; if length<>4 then
jl x1+6 ; goto point name;
jl x1+8 ; goto point integer
i.e. ; end;
; procedure write item;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed;
b.j6 ; begin
w.d17: rs.w3 e32.
dl.w2 e14.
al w2 x2-1
sl w1 0 ; if write addr<0
sl w2(116) ; or write top-1>=core top then
jl. a28. ; goto core addr error;
al w3 0 ; niveau:= 0;
jl. 4 ; if false then
j0: jl. a29. ; goto format error;
rl.w1 e22. ; index:= format index;
; j0+4: ; new niveau:
rs.w1 x3+e22. ; index(niveau):= index;
; j0+6: ; repeat compound:
rl.w1 x3+e22. ; index:= index(niveau);
al w1 x1+2 ; addr(niveau):= index+2;
; j0+10: ; repeat compound word:
al w2 -18 ; shift(niveau):= -18;
jl. j2. ; goto next format;
; j0+14: ; old niveau:
al w3 x3-6 ; niveau:= niveau-6;
sh w3 -6 ; if niveau<=-6 then
jl. (e32.) ; goto exit;
j1: dl.w2 x3+e21. ; next format:
j2: rl w0 x1+0 ; word:= word(addr(niveau));
ls w0 x2+0 ; word:= word shift shift(niveau);
la.w0 c5. ; format:= word(18:23);
sh w0 4 ; if format<=4 then
jl. j3. ; goto test format;
al w2 x2+6 ; shift(niveau):= shift(niveau)+6;
sh w2 0 ; if shift(niveau)<=0 then
jl. j3. ; goto test format;
al w1 x1+2 ; addr(niveau):= addr(niveau)+2;
al w2 -18 ; shift(niveau):= -18
j3: ds.w2 x3+e21. ; test format:
rs.w3 e18.
sl w0 f2 ; if format>=first compound then
jl. j6. ; goto compound;
rl w2 0 ; value:= word(write addr);
rl.w0(e13.) ;
rs.w0 e16. ;
sl w2 5 ; if format>=5 then
al.w3 j5. ; w3:=link j5
bl.w2 x2+4 ; case format of
b0: jl. x2 ; begin
h. j0+0-b0 ; 0: goto format error;
j0+4-b0 ; 1: goto new niveau;
j0+6-b0 ; 2: goto repeat compound;
j0+10-b0 ; 3: goto repeat compound word;
j0+14-b0 ; 4: goto old niveau;
b5-b0 ; 5: write word;
b6-b0 ; 6: write bytes;
b7-b0 ; 7: write text;
b8-b0 ; 8: write octets;
b9-b0 ; 9: write sixtets;
b10-b0 ; 10: write octal;
b11-b0 ; 11: write binary;
b12-b0 ; 12: write new line;
b13-b0 ; 13: write empty;
b14-b0 ; 14: write index;
b15-b0 ; 15: write double;
b16-b0 ; 16: write name;
b17-b0 ; 17: write procname;
b18-b0 ; 18: write procnames;
b19-b0 ; 19: write code;
b20-b0 ; 20: write words5;
b21-b0 ; 21: write bytes10;
w.j5: rl.w3 e18. ; end;
jl. j1. ; goto next format;
j6: am (0) ; compound:
al w1 -64
ls w1 1 ; index:= format index table(format);
al.w1 x1+d0.
wa w1 x1+0 ; niveau:= niveau+6;
al w3 x3+6
sl w3 f3*6 ; if niveau>=format niveaus*6 then
jl. a26. ; goto niveau error;
jl. j0.+4 ; goto new niveau;
; exit:
i.e. ; end;
; procedure save variables;
; procedure restore variables;
; call: exit:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link unchanged;
b.j0 ; begin
w.d18: al.w1 e0. ; save variables entry:
rl.w2 e9. ; from:= w0 addr;
jl. j0. ; to:= save addr;
d19: rl.w1 e9. ; goto move;
al.w2 e0. ; restore variables entry:
j0: rl w0 x1+0 ; from:= save addr;
rs w0 x2+0 ; to:= w0 addr;
al w1 x1+2 ; move:
al w2 x2+2 ; word(to):= word(from);
se.w1(e10.) ; from:= from+2;
sn.w2(e10.) ; to:= to+2;
jl x3+0 ; if to<>buf addr and from<>buf addr then
jl. j0. ; goto move
i.e. ; end;
; procedure skip block(begin name,end name);
; call: exit:
; w0 begin name destroyed
; w1 end name destroyed
; w2 destroyed
; w3 link destroyed;
b.j3 ; begin
w.d20: rs.w3 e31. ;
ds.w1 e17. ;
al w0 1 ; skip level:= 1;
rs.w0 e18. ; skip:
j0: jl.w3 d15. ; next param(
jl. a4. ; terminate,
jl. j0. ; skip,
jl. j1. ; space name,
jl. j0. ; skip,
jl. j0. ; skip);
j1: rl w0 x2+0 ; space name:
sn.w0(j3.) ; if name=<:go:> then
jl. j0. ; goto skip;
sn.w0(e16.) ; if name=begin name then
jl. j2. ; goto increase level;
se.w0(e17.) ; if name<>end name then
jl. j0. ; goto skip;
am -2 ; skip level:= skip level-2;
j2: al w1 1 ; increase level:
wa.w1 e18. ; skip level:= skip level+1;
rs.w1 e18. ;
sl w1 1 ; if skip level>=1 then
jl. j0. ; goto skip
jl. (e31.) ;
j3: <:go:> ;
i.e. ; end;
▶EOF◀