|
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: 67584 (0x10800)
Types: TextFile
Names: »ass33tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »ass33tx «
\f
m. slang text 3
m.rc 1977.09.27
;stepping stones:
jl. e23., e23=k-2
; program scan
b.f46,b3,a51
w.a0: rl.w2 g13. ; exam delim:
sl w2 2
jl. a1.
rl.w3 g68. ; current lineno :=
rs.w3 g77. ; lineno;
rl.w3 g12.
bl.w3 x3+4 ; if delim type<2 then
b0: jl. x3+0 ; goto case delim value of(
h. f0 ; 0: segment,
f1 ; 1: block,
f2 ; 2: conditional,
f3 ; 3: end,
f4 ; 4: halfword,
f5 ; 5: word,
f6 ; 6: real,
f7 ; 7: typewriter,
f8 ; 8: normal,
f9 ; 9: set xref mode,
f10 ; 10: next delim,
f11 ; 11: clear testmode,
f12 ; 12: set testmode,
j17: f13 ; 13: display id,
f14 ; 14: message,
f15 ; 15: jump,
f16 ; 16: next delim,
j18: f17 ; 17: next delim
f43 ;p. 18: prepare procedure source
f44 ;u. 19: unstack procedure source
f45 ;l. 20: set list on
f46 ;d. 21: set list off);
w.f9=-b0.
j34: jl.w3 e61. ; set xref mode: output <xref mode>;
;am 0
f10=-b0.
f16=-b0.
f17=-b0.
a1: am -2048 ;
jl.w3 e7.+2048 ; next delim: next delim;
d9: am -2048
bz.w2 x2+d5.+2048; look up delim:
wa.w2 g18. ; index:= prog entry(delim type)
am -2048
bz.w2 x2+d5.+2048; +prog state;
al w3 63 ; element:= prog matrix(index);
la w3 4 ; old prog state:= prog state;
ls w2 -6 ; prog state:= element(0:5);
rx.w2 g18. ; prog action:= element(6:11);
rs.w2 g19.
bl.w3 x3+4
b1: jl. x3+0 ; goto case prog action of(
h. f20 ; 0: declare 1,
f21 ; 1: declare 2,
f22 ; 2: label,
f23 ; 3: op code,
f24 ; 4: op mod,
f25 ; 5: real 1,
f26 ; 6: real 2,
f27 ; 7: byte 1,
f28 ; 8: byte 2,
f29 ; 9: byte instr,
f30 ; 10: word 1,
f31 ; 11: word 2,
f32 ; 12: word instr,
f33 ; 13: data sign,
f34 ; 14: data expr,
f35 ; 15: assign expr 1,
f36 ; 16: assign expr 2,
f37 ; 17: terminator 1,
f38 ; 18: terminator 2,
f39 ; 19: operator 1,
f40 ; 20: expr sign,
f41 ; 21: operator 2,
f42 ; 22: restore,
e40-b1 ; 23: syntax error,
a1-b1 ; 24: next delim);
w.f0=-b0. ; segment:
d10: al w1 0
rs.w1 g5.
rs.w1 g7. ; id letter:= id index:= 0;
jl.w3 e25. ; get id(go on);
am 0 ; go on:
rl.w1 g51.
se w1 0 ; if outside segment then
jl. d11. ; goto block;
am. (g23.) ; seg addr:= prog top;
; goto begin;
f1=-b0. ; block:
d11: al w1 0 ; seg addr:= 0;
rl.w2 g26. ; begin:
rs w1 x2+0 ; word(stack top):= seg addr;
al w1 1
rs w1 x2-2 ; word(stack top-2):= prog state:= 1;
rs.w1 g18.
rl.w1 c13.
rs w1 x2-4 ; word(stack top-4):= 63 shift 12;
al w2 x2-2
rs.w2 g28. ; block entry:= stack top-2;
al w2 x2-4
rs.w2 g26. ; stack top:= block entry-4;
sh.w2(g23.) ; if stack top<=prog top then
jl. e46. ; stack term;
j35: jl.w3 e54. ; output <begin block>;
;am 0
jl. a1. ; goto next delim;
f2=-b0.
al w3 6 ; conditional:
rs.w3 g20. ; operator:= eval cond;
a2: al w3 7 ; prepare:
rs.w3 g18. ; prog state:= 7;
jl.w3 e24. ; prep expr;
rl.w3 g20.
rs w3 x2+0 ; word(operator top):= operator;
al w2 x2-2
rs.w2 g25. ; operator top:= operator top-2;
jl. a1. ; goto next delim;
b. a4 w.
f3=-b0. ; end:
al w3 1 ;
rs.w3 g42. ; seg addr := 1;
rs.w3 g51. ; outside segment := false;
rs.w3 g54. ; head := true;
rl.w2 g26. ;
a1: jl.w3 e31.+2 ; exam local(
jl. a3. ; begin
rl.w0 g5. ; if idletter = 0 then
sn w0 0 ; goto end segment;
jl. a4. ; (i.e. end of name stack)
sz w1 2.11 ; if word(stack entry)(22:23) = 0 (i.e. undef)
jl x3 ;
ls w1 -2 ; and
sl.w1(g42.) ; word(stack entry)(0:21) >= seg addr
jl. a2. ; or
rl w1 x2-2 ; word(stack entry - 2) >= seg addr then
sl.w1(g42.) ; begin
jl. a2. ;
jl x3 ; comment: undef chains within block (or segment);
a2: rs.w3 g58. ; if head then
rx.w3 g54. ; begin
sn w3 1 ; head := false;
jl.w3 e45. ; undefined at end error return
; end;
jl.w3 e12. ; write id;
b.a1 ; begin
w. jl. a1. ; procedure modify load id;
a0: dl.w1 j3. ; comment: modifies load id to
rx.w0 j6. ; output the addresses in
rx.w1 j7. ; the program link instead
ds.w1 j3. ; of loading the value.
dl.w1 j5. ; the next call causes the
rx.w0 j8. ; opposite modification;;
rx.w1 j9.
ds.w1 j5.
dl.w1 j0.
rx.w0 j1.-2
rx.w1 j1.
ds.w1 j0.
jl x3+0
j2: jl.w3 e26-j6
j3: jl.w3 e17-2-j7
j4: jl.w3 e26-j8
j5: jl.w3 e17-2-j9
a1: jl.w3 e3. ; writechar(bl);
jl.w3 a0. ; modify load id;
jl.w3 e27. ; load id(nonsense);
ld w1 -100 ; make identifier undefined, without
ds.w1(g27.) ; any references;
jl.w3 a0. ; modify load id
c.i0i.z. ; end;
e.
jl.w3 e4. ; writechar(nl)
jl. (g58.) ; end
; end);
a3: al w2 x2+4
rx.w3 g51. ; if outside segment then
se w3 1 ; goto examine local;
jl. a1. ; outside segment := true;
rs.w2 g26. ; stack top:= stack entry+4;
j36: jl.w3 e56. ; output <end>;
;am 0
jl.w1 e21. ; round addr;
rl.w1(g26.)
rs.w1 g42. ; seg addr:= word(stack top);
sn w1 0 ; if seg addr=0 then
jl. a8. ; goto end block;
jl. a1.-2 ; goto examine local; i.e. search all blocks
a4: ; for undef chains within segment;
e.
jl.w3 e52. ; end segment:
rs.w2 g58. ; save addr:= get k;
a4: sl.w1(g42.) ; move: if label pointer<seg addr then
jl. 4 ; goto segment out;
jl. a7.
al w2 x1+4 ; move pointer:= label pointer+4;
a5: sn.w2(g23.) ; move more: if move pointer=prog top then
jl. a6. ; goto end move;
rl w0 x2+0 ; word(move pointer-4):=
rs w0 x2-4 ; word(move pointer);
al w2 x2+2 ; move pointer:= move pointer+2;
jl. a5. ; goto move more;
w.c0: c1 ; reference
a6: al w2 x2-4 ; end move:
rs.w2 g23. ; prog top:= move pointer-4;
jl.w3 e26. ; def addr(label pointer);
jl. a4. ; goto move;
a7: rl.w1 g42. ; segment out:
rl.w3 c0.
al w3 x3-500
rl.w2 g23.
se w1 x2+0 ; if seg addr<>prog top then
jl w3 x3-c1+e0+500; outsegment;
rl.w1 g42.
rs.w1 g23. ; prog top:= seg addr;
jl.w1 e30. ; new label;
rl.w2 g58.
jl.w1 e23. ; load word(save addr);
a8: al w2 0 ; end block:
rs.w2 g7. ; id index:= 0;
al w2 63 ; id letter := 63; i.e. 'begin'
rs.w2 g5. ;
jl.w3 e25. ; get id(end slang);
jl. c7.
al w2 x2-2
rs.w2 g28. ; block entry:= stack entry-2;
rl w1 x2+0
rs.w1 g18. ; prog state:= word(block entry);
jl. a1. ; goto next delim;
f4=-b0. ; halfword:
al w1 2 ; prog state:= 2;
jl. a9. ; goto save state;
f5=-b0. ; word:
jl.w1 e21. ; round addr;
al w1 4 ; prog state:= 4;
jl. a9. ; goto save state;
f6=-b0. ; real:
jl.w1 e21. ; round addr;
al w1 6 ; prog state:= 6;
a9: rs.w1 g18. ; save state:
rs.w1(g28.) ; word(block entry):= prog state;
jl. a1. ; goto next delim;
f7=-b0. ; typewriter:
rl.w3 c0.
jl w3 x3-c1+e2 ; select t input;
jl. a1. ; goto next delim;
f8=-b0. ; normal:
rl.w3 c0.
jl w3 x3-c1+e1 ; select n input;
jl. a1. ; goto next delim;
f45=-b0. ; set list on:
am 2 ; list := saved list;
f46=-b0. ; set list off:
rl.w0 c8. ; list := false;
rl.w1 e14. ; testmode := testmode;
jl. 6 ; goto next delim;
f11=-b0. ; clear testmode:
rl.w0 c8.
rl.w1 c4. ; list:= false;
jl. 6 ; testmode:= false;
; goto next delim;
f12=-b0. ; set testmode:
rl.w0 c9.
rl.w1 e14.-2
rl.w3 c0.
rs w0 x3-c1+j11 ; list:= true;
rs.w1 e14. ; testmode:= true;
jl. a1. ; goto next delim;
f13=-b0. ; display id:
rl.w1 c0.
rl w2 x1-c1+j11 ; save(list);
jl.w3 e4. ; writechar(nl);
rl.w0 c3.
rs w0 x1-c1+j11 ; list:= false;
rs.w0 c56. ; oldlist:=list
al w0 59
jl.w3 e9. ; writechar(;);
jl.w3 e13. ; writeaddr;
rs w2 x1-c1+j11 ; list:= saved list;
rs. w2 c56. ;
al.w0 c27.
jl.w3 e11. ; writetext(<:id list<10>b.:>);
b.a3
w. al w2 2
wa.w2 g26. ; pointer:= stack top+2;
bz w1 x2+0
sh w1 62 ; if byte(pointer)<63 then
jl. a1. ; goto id;
jl. a2. ; goto exam;
a0: al w0 44 ; again:
jl.w3 e9. ; writechar(,);
a1: al w0 x1+96 ; id:
jl.w3 e9. ; writechar(byte(pointer)+96);
bz w0 x2+1 ; index:= byte(pointer+1);
jl.w3 e10. ; writeinteger(index);
ls w0 2
wa w2 0 ; pointer:= pointer
al w2 x2+6 ; +4*index+6;
bz w1 x2+0
sh w1 62 ; if byte(pointer)<63 then
jl. a0. ; goto again;
a2: ; exam:
jl.w3 e4. ; writechar(nl);
jl.w3 e31. ; exam local (
jl. a3.
rl.w2 g5. ; w2 := id letter;
sz w1 2.11 ; if word(stack entry)(22:23)<>0
sn w2 -1 ; and id letter <> <xref begin block> then
jl x3+0 ; begin
rs.w3 g58.
jl.w3 e12. ; write id;
al w0 61
jl.w3 e9. ; writechar(=);
rl.w2 g27.
rl w0 x2-2
sh w0 -1 ; value:= word(stack entry-2);
am e17-e10 ; if value<=-1 then writeinteger1(value)
jl.w3 e10. ; else writeinteger(value));
jl.w3 e4. ; writechar(nl)
jl. (g58.) ; end);
a3: jl.w3 e18. ; if list then
; writeaddr;
c.i0i.z. ; goto next delim;
e. jl. a1.
f14=-b0. ; message:
jl.w3 e13. ; writeaddr;
rl.w0 c9.
rl.w3 c0. ; if message.yes then
j16: rs w0 x3-c1+j11 ; list:= true;
jl w1 x3-c1+j29 ; empty line:= false;
am. c1.+500 ; more message:
jl w3 e7-c1-500 ; next delim;
sn w1 17 ; if delim value<>17
se w2 0 ; or delim type<>control then
jl. -8 ; goto more message;
rl.w0 c56. ;
rl.w3 c0.
rs w0 x3-c1+j11 ; list:= oldlist;
jl.w3 e4. ; writechar(10);
jl. a1. ; goto next delim;
a11: se w0 0 ; repetition:
jl. e40. ; if opsit<>no operand then
rl.w1 g19. ; syntax error;
jl. x1+0 ; operator:= case old prog state of(
am -1 ; 2: repeat byte,
am -1 ; 4: repeat word,
al w2 20 ; 6: repeat real);
rs.w2 g20.
jl. a2. ; goto prepare;
f15=-b0. ; jump:
dl.w2 g19.
sn w2 0 ; if old prog state=after error then
jl. a1. ; goto next delim;
se w1 4 ; if prog state<>after word then
jl. e40. ; syntax error;
am -2048
rl.w1 g52.+2048 ; w1:= fp base;
al.w2 g23. ; w2:= addr of prog top;
rl w0 x2+0
bs. w0 1
al. w3 a51. ; return from jump
jl (0)
d12: am 0 ; the instr. jl. a1. will be placed here
rl. w1 d12. ; return if entry.no
rl. w3 c0.
rs w1 x3-c1+j22
a51: ; normal return
sn w0 0 ; if text addr<>0 then
jl. a10. ; begin
rl w1 0 ; if list then
jl.w3 e18. ; writeaddr;
al w0 x1+0 ; writetext(text addr);
jl.w3 e11. ; writechar(nl)
jl.w3 e4. ; end;
a10: al.w0 c36. ; if termination then
se w2 0 ; write term(<:jump:>);
jl. e15.
jl. a1. ; goto next delim;
; comment: jump procedure insert identifier.
; the procedure is called with jl w3 slangbase+10, and
; returns to link if error, else to link+2.
; call: return:
; w0 value destroyed
; w1 id letter<12+id index destroyed
; w2 destroyed
; w3 link destroyed
j43: ld w2 -12 ; jump insert identifier:
ls w2 -12 ; save id letter;
la.w1 c12. ; id letter:=id letter mod 32;
ds.w2 g7. ;
se w1 0 ; if id letter=0 or
sl w1 23 ; id letter>=23 then
jl x3 ; return(error);
ds.w0 g81. ; save link,value;
jl.w3 e25. ; get id;
jl. (g80.) ; error: return(error);
rl.w1 g81. ; load value;
jl.w3 e27. ; load id(value);
al w1 2.01 ;
rs.w1(g27.) ;
rl.w3 g80. ; load link;
jl x3+2 ; exit:return(ok);
f20=-b1. ; declare 1:
sn w0 0 ; if opsit=no operand then
jl. a0. ; goto exam delim;
f21=-b1. ; declare 2:
se w0 5 ; if opsit<>absolute identifier then
jl. e40. ; syntax error;
al w1 0
rx.w1 g7. ; save index:= id index;
rs.w1 g58. ; id index:= 0;
jl.w3 e25. ; get id(reserve);
jl. a12.
sh.w2(g28.) ; if stack entry<=block entry then
jl. e41. ; declaration error;
a12: rl.w1 g58. ; reserve:
sl.w1(c5.) ; if index>=4096 then
jl. e41. ; declaration error;
ls w1 2
ac w1 x1+6 ; entry:= stack top;
wa.w1 g26. ; stack top:= stack top
sh.w1(g23.) ; -(4*save index+6);
jl. e46. ; if stack top<=prog top then
rx.w1 g26. ; stack term;
al w0 0
a13: sn.w1(g26.) ; clear:
jl. a14. ; if entry=stack top then goto stack id;
rs w0 x1+0 ; word(entry):= 0;
al w1 x1-2 ; entry:= entry-2;
jl. a13. ; goto clear;
a14: rl.w0 g5. ; stack id:
hs w0 x1+2 ; byte(stack top+2):= id letter;
rl.w0 g58.
hs w0 x1+3 ; byte(stack entry+3):= save index;
j37: jl.w3 e58. ; output <declaration>;
;am 0
jl. a0. ; goto exam delim;
f22=-b1. ; label:
se w0 5 ; if opsit<>absolute identifier then
jl. e40. ; syntax error;
jl.w3 e25. ; get id(undeclared error);
jl. e42.
sz w1 2.11 ; if word(stack entry)(22:23)<>0 then
jl. e43. ; definition error;
jl.w3 e52.
al w1 x2+0 ; label addr:= get k;
rl.w2 g18. ; if prog state=after real then
sn w2 6 ; label addr:= label addr+2;
al w1 x1+2
jl.w3 e27. ; load id(label addr);
al w0 2.10
rs.w0(g27.) ; word(stack entry):= 2.10;
jl. a1. ; goto next delim;
f23=-b1. ; op code:
se w0 0 ; if opsit<>no operand then
jl. e40. ; syntax error;
rs.w0 g17. ; control word:= 0;
hs.w0 g22. ; addr part:= 0;
ls w1 6
hs.w1 g16. ; op part:= delim value shift 6;
jl. a1. ; goto next delim;
f24=-b1. ; op mod:
se w0 0 ; if opsit<>no operand then
jl. e40. ; syntax error;
al w2 15 ; mod part:= delim value(18:19);
la w2 2 ; control bit:= delim value(20:23);
ls w1 -4
rl.w3 g17.
sz w2 x3+0 ; if control bit and control word<>0 then
jl. e40. ; syntax error;
lo w3 4 ; control word:=
rs.w3 g17. ; control word or control bit;
ls w2 -1 ; position:= control bit shift -1;
ls w1 x2+0 ; mod part:= mod part shift position;
ba.w1 g16.
hs.w1 g16. ; op part:= op part+mod part;
jl. a1. ; goto next delim;
f25=-b1. ; real 1:
sn w0 0 ; if opsit=no operand then
jl. a0. ; goto exam delim;
f26=-b1. ; real 2:
se w0 2 ; if opsit<>real then
jl. e40. ; syntax error;
rl.w2 g60.
jl.w1 e23. ; load word(real(0:23));
rl.w2 g50.
jl.w1 e23. ; load word(real(24:47));
jl. a0. ; goto exam delim;
f27=-b1. ; byte 1:
sn w0 0 ; if opsit=no operand then
jl. a0. ; goto exam delim;
f28=-b1. ; byte 2:
sh w0 3 ; if opsit<=3 then
jl. e40. ; syntax error;
jl.w3 e28. ; def operand(symb byte);
jl. a15. ; byte value:= operand value;
al w0 1 ; halfword overflow
jl.w3 e33. ; test byte;
jl. a16. ; goto load byte;
a15: jl.w3 e29. ; symb byte:
rl.w0 g8. ; byte value:= get byte link;
sn w0 6 ; if opsit=relative identifier then
al w2 x2+1 ; byte value:= byte value+1;
jl. a16. ; goto load byte;
f29=-b1. ; byte instr:
se w0 0 ; if opsit<>no operand then
jl. e40. ; syntax error;
bl.w2 g16. ; byte value:= op part;
a16: jl.w1 e22. ; load byte: load byte(byte value);
jl. a0. ; goto exam delim;
f30=-b1. ; word 1:
sn w0 0 ; if opsit=no operand then
jl. a0. ; goto exam delim;
f31=-b1. ; word 2:
sh w0 3 ; if opsit<=3 then
jl. a23. ; goto text;
jl.w3 e28. ; def operand(symb word);
jl. 4 ; word value:= operand value;
jl. a17. ; goto load word;
; symb word:
rl.w1 g23. ; word link:= word(stack entry-2);
rx w1 x2-2 ; word(stack entry-2):= prog top;
ls w1 2
rl.w0 g8. ; word value:= word link shift 2;
sn w0 6 ; if opsit=6 then
am 1 ; word value:= word value+1;
al w2 x1+0
a17: jl.w1 e23. ; load word: load word(word value);
jl. a0. ; goto exam delim;
f32=-b1. ; word instr:
sn w0 0 ; if opsit=no operand then
jl. a18. ; goto load instr;
sh w0 3 ; if opsit<=3 then
jl. e40. ; syntax error;
bl.w1 g16.
rl.w2 g8.
so w1 2.1000 ; if op part(20:20)=0
se w2 6 ; and opsit=6 then
jl. 4 ; relative warn;
jl.w3 e47.
jl.w3 e28. ; def operand(symb addr);
jl. a21.
hs.w2 g22. ; addr part:= operand value;
a18: bl.w3 g16. ; load instr:
ls w3 -6 ; if opcode=jd then
al w0 0 ; address overflow
sn w3 14 ; test byte(addr part)
am e33-e35 ; else
jl.w3 e35. ; test addr(addr part);
bl.w2 g16.
jl.w1 e22. ; load byte(op part);
bl.w2 g22.
jl. a22. ; goto load addr;
a21: bl.w2 g16. ; symb addr:
jl.w1 e22. ; load byte(op part);
jl.w3 e29.
al w2 x2+2.10 ; addr part:= get byte link+2.10;
rl.w0 g8.
sn w0 6 ; if opsit=6 then
al w2 x2+2.01 ; addr part:= addr part+2.01;
a22: jl.w1 e22. ; load addr: load byte(addr part);
jl. a0. ; goto exam delim;
a23: rl.w2 g18. ; text:
se w0 3 ; if opsit<>text string then
jl. e40. ; syntax error;
a24: rl.w2 g23. ; more text:
sl.w2(g7.) ; if prog top>=operand then
jl. a0. ; goto exam delim;
rl.w2(g23.)
jl.w1 e23. ; load word(word(prog top));
jl. a24. ; goto more text;
f33=-b1. ; data sign:
sn w0 0
se w1 9 ; if opsit=0
jl. 4 ; and delim value=<+> then
jl. a1. ; goto next delim;
al w1 7 ; prog state:= 7;
rs.w1 g18.
f34=-b1. ; data expr:
jl.w3 e24. ; prep expr;
rl.w3 g19.
rs w3 x2+0 ; word(operator top):= old prog state;
al w2 x2-2
rs.w2 g25. ; operator top:= operator top-2;
rl.w2 g13.
jl. d9. ; goto look up delim;
f35=-b1. ; assign expr 1:
sn w1 0 ; if delim value=<r.> then
jl. e40. ; syntax error;
jl. a25. ; goto assign expr;
f36=-b1. ; assign expr 2:
sn w1 0 ; if delim value=<r.> then
jl. a11. ; goto repetition;
a25: jl.w3 e24. ; assign expr: prep expr;
sn w0 5 ; if opsit=absolute identifier then
jl. a26. ; goto assign id;
rl.w2 g19. ; if old prog state=after halfword
se w2 2 ; or opsit<>load addr then
se w0 7 ; syntax error;
jl. e40.
al w2 3
rs.w2 g20. ; operator:= define load addr;
jl. a33. ; goto stack operator;
a26: jl.w3 e25. ; assign id:
jl. e42. ; get id(undeclared error);
al w3 1 ; operand value:= stack entry;
rs.w3 g20. ; operator:= define id;
jl. a30. ; goto stack operand;
f37=-b1. ; terminator 1:
al w1 0
rs.w1 g20. ; operator:= terminator;
jl. a27. ; goto no operand;
f38=-b1. ; terminator 2:
al w1 0
rs.w1 g20. ; operator:= terminator;
jl. a29. ; goto exam operand;
f39=-b1. ; operator 1:
rl.w1 g12. ; operator:= delim value;
rs.w1 g20.
a27: se w0 0 ; no operand:
jl. e40. ; if opsit<>no operand then syntax error;
jl. a31. ; goto exam operator;
f40=-b1. ; expr sign:
sn w0 0 ; if opsit=no operand then
jl. a28. ; goto posneg;
f41=-b1. ; operator 2:
rl.w1 g12. ; operator:= delim value;
rs.w1 g20. ; goto exam operand;
jl. a29.
a28: rl.w1 g12. ; posneg:
sn w1 9 ; if delim value=<+> then
jl. a1. ; goto next delim;
al w1 7
rs.w1 g20. ; operator:= negative;
jl. a31. ; goto exam operator;
f43=-b0. ; prepare procedure source:
al w3 1 ; source name address :=
la.w3 g23. ; prog top + prog top(23);
wa.w3 g23. ;
rs.w3 g74. ;
rl.w1 c0.
jl w3 x1-c1+e7 ; next delim;
se w1 17 ; if delim value <> 17 (i.e. carret)
sn w2 1 ; or delim type <> 1 (i.e. comma) then
jl. 4 ;
jl. e40. ; syntax error;
rl.w1 c0.
rl.w2 g7. ;
sn w0 4 ; if opsit=4 then
jl. a50. ; goto compute sourcename;
se w0 3 ; if opsit <> 3 then
jl. e40. ; syntax error;
al w0 0 ; string name:
a47: rs w0 x2 ; extend name with null-chars
al w2 x2+2 ; until name is
am. (g74.) ; at least 4 words;
sh w2 +6 ;
jl. a47. ;
sl.w2(g26.) ; if operand >= stacktop then
jl. e46. ; stack term;
a49: ; connect procedure source:
jl w3 x1-c1+e38 ; stack in(current chain);
rl.w2 g74. ;
rl.w1 c0. ;
jl w3 x1-c1+e36 ; connect in(procedure source);
am -2048 ;
rl.w0 c2.+2048 ;
rs w0 x1+h2+6 ; procedure source := true;
jl. a42. ; goto restore;
a50: al.w0 c50. ; compute sourcename:
sl w2 1 ; set textaddr = <:connect procedure source:>...
j38=k+1; upper index of procnames...
sl w2 0-0-0-0-0 ; if sourcenumber outside interval then
jl x1-c1+e15 ; connect error(sourcenumber);
ls w2 3 ; source := procnames(sourcenumber);
wa.w2 g75. ;
rs.w2 g74. ;
jl. a49. ; goto connect procedure source;
f44=-b0. ; unstack procedure source:
rl.w3 c0. ;
rl w1 x3-c1+g52 ;
rl w0 x1+h20+h2+6;
am -1000 ;
sn.w0(c2.+1000) ; if procedure source then
jl w3 x3+e62-c1 ; unstack current chain;
jl. a1. ; goto next delim;
b.f20 ; begin f names for expression
h. ; operator: priority:
b2: 0 ; 0: terminator 0
1 ; 1: define id 1
1 ; 2: define byte 1
1 ; 3: define load addr 1
1 ; 4: define word 1
1 ; 5: define addr 1
1 ; 6: eval condition 1
6 ; 7: negative 6
5 ; 8: - 5
5 ; 9: + 5
6 ; 10: * 6
6 ; 11: / 6
4 ; 12: a. 4
3 ; 13: o. 3
7 ; 14: < 7
7 ; 15: > 7
1 ; 16: (: 1
2 ; 17: :) 2
1 ; 18: repeat byte 1
1 ; 19: repeat word 1
1 ; 20: repeat real 1
w.a29: sh w0 3 ; exam operand:
jl. e40. ; if opsit<=3 then syntax error;
jl.w3 e28. ; def operand(undefined error);
jl. e44.
a30: rl.w3 g24. ; stack operand:
rs w2 x3+0 ; word(operand top):= operand value;
al w3 x3+2
rs.w3 g24. ; operand top:= operand top+2;
sl.w3(g25.) ; if operand top>=operator top then
jl. e46. ; stack term;
a31: am. (g20.) ; exam operator:
bl.w0 b2.
sn w0 1 ; if priority(operator)=1 then
jl. a33. ; goto stack operator;
a32: rl.w3 g25. ; unstack operator:
rl w2 x3+2 ; removed:= word(operator top+2);
bl.w0 x2+b2.
am. (g20.)
bs.w0 b2. ; if priority(operator)
sh w0 -1 ; >priority(removed) then
jl. a33. ; goto stack operator;
al w3 x3+2
rs.w3 g25. ; operator top:= operator top+2;
rl.w3 g24.
rl w1 x3-4 ; left hand:= word(operand top-4);
bl.w2 x2+3
b3: jl. x2+0 ; goto case removed of(
h. f1 ; 1: def id,
f2 ; 2: def byte,
f3 ; 3: def load addr,
f4 ; 4: def word,
f5 ; 5: def addr,
f6 ; 6: eval cond,
f7 ; 7: negative,
f8 ; 8: subtract,
f9 ; 9: add,
f10 ; 10: multiply,
f11 ; 11: divide,
f12 ; 12: and,
f13 ; 13: or,
f14 ; 14: left shift,
f15 ; 15: right shift,
e40-b3 ; 16: syntax error,
e51-b3 ; 17: slang fault term,
f18 ; 18: repeat byte,
f19 ; 19: repeat word,
f20 ; 20: repeat real);
w.a33: rl.w1 g20. ; stack operator:
rl.w3 g25.
sn w1 17 ; if operator=<:)> then
jl. a41. ; goto unstack par;
rs w1 x3+0 ; word(operator top):= operator;
al w3 x3-2
rs.w3 g25. ; operator top:= operator top-2;
sh.w3(g24.) ; if operator top<=operand top then
jl. e46. ; stack term;
jl. a0. ; goto exam delim;
f1=-b3. ; def id:
rs.w1 g27. ; stack entry:= left hand;
rl w1 x3-2
jl.w3 e27. ; load id(word(operand top-2));
al w1 2.01
rs.w1(g27.) ; word(stack entry):= 2.01;
jl. a42. ; goto restore;
f5=-b3. ; def addr:
rl w2 x3-2 ; byte value:= word(operand top-2);
rs.w2 g58.
bl.w2 g16.
jl.w1 e22. ; load byte(op part);
rl.w2 g58.
bl.w1 g16.
ls w1 -6 ; if opcode<>jd then
al w0 0 ; address overflow
sn w1 14 ; begin
jl. a34. ; test addr(byte value);
jl. a35. ; goto load
; end;
f2=-b3. ; def byte:
rl w2 x3-2 ; byte value:= word(operand top-2);
al w0 1 ; halfword overflow
a34: am e33-e35 ; test byte(byte value);
a35: jl.w3 e35. ; load:
jl.w1 e22. ; load byte(byte value);
jl. a42. ; goto restore;
f3=-b3. ; def load addr:
rl w2 x3-2
rs.w2 g58.
jl.w1 e30. ; new label;
rl.w2 g58. ; load word(word(operand top-2)
sz w2 2.1 ; +word(operand top-2)(23:23));
al w2 x2+1 ; goto restore;
jl. 4
f4=-b3. ; def word:
rl w2 x3-2
jl.w1 e23. ; load word(word(operand top-2));
jl. a42. ; goto restore;
f6=-b3. ; eval cond:
rl w1 x3-2
sl w1 0 ; if word(operand top-2)>=0 then
jl. a42. ; goto restore;
rl.w3 c0.
al w2 8 ; exponent type:= blind;
hs w2 x3-c1+j28
al w3 0 ; level:= 0;
rs.w3 g58.
jl. a39. ; goto exam skip;
a36: al w3 x3+2 ; enter skip: level:= level+2;
a37: al w3 x3-1 ; exit skip: level:= level-1;
a38: am -2000
rs.w3 g58.+2000 ; skip:
a19: rl.w3 g68. ; current lineno :=
rs.w3 g77. ; lineno;
rl.w3 c0.
jl w3 x3-c1+e7 ; next delim;
sn w0 1 ; if opsit=1 and warning.yes then
jl.w3 e50. ; syntax warn;
sh w0 4 ; if xref and opsit>0 then
jl. a39. ; begin
al w1 0 ; local blockno := 0
am -2000
rs.w1 g67.+2000 ;
sn w0 7 ; output(if opsit=7 then
am e55-e57 ; <kassignment> else <use>);
am. e57.+2000 ;
jl w3 -2000 ;
a39: am -2048 ; exam skip:
dl.w2 g13.+2048 ;
am -2000
rl.w3 g58.+2000
se w2 0 ;:
jl. a38. ; if delim type<>0 then goto skip;
sn w1 2 ; if delim value=2 then
jl. a36. ; goto enter skip;
sn w1 14 ; if delim value=14 then
jl. a20. ; goto skip message;
se w1 16 ; if delim value<>16 then
jl. a38. ; goto skip;
se w3 0 ; if level<>0 then
jl. a37. ; goto exit skip;
rl.w3 c0.
al w2 11 ; exponent type:= exponent;
hs w2 x3-c1+j28
jl. a42. ; goto restore;
a20: rl.w3 c0. ; skip message:
jl w3 x3-c1+e7 ; next delim;
sn w2 0 ; if delim type<>0
se w1 17 ; or delim value<>17 then
jl. a20. ; goto skip message;
jl. a19. ; goto skip;
f7=-b3. ; negative:
ac w1(x3-2) ; word(operand top-2):=
rs w1 x3-2 ; -word(operand top-2);
jl. a32. ; goto unstack operator;
f8=-b3. ; subtract:
ws w1 x3-2 ; left hand:=
; left hand-word(operand top-2);
jl. a40. ; goto unstack operand;
f9=-b3. ; add:
wa w1 x3-2 ; left hand:=
; left hand+word(operand top-2);
jl. a40. ; goto unstack operand;
f10=-b3. ; multiply:
wm w1 x3-2 ; left hand:=
; left hand*word(operand top-2);
jl. a40. ; goto unstack operand;
f11=-b3. ; divide:
al w0 x1+0
ad w1 -24
wd w1 x3-2 ; left hand:=
; left hand/word(operand top-2);
jl. a40. ; goto unstack operand;
f12=-b3. ; and:
la w1 x3-2 ; left hand:=
; left hand and word(operand top-2);
jl. a40. ; goto unstack operand;
f13=-b3. ; or:
lo w1 x3-2 ; left hand:=
; left hand or word(operand top-2);
jl. a40. ; goto unstack operand;
f14=-b3. ; left shift:
rl w2 x3-2 ; position:= word(operand top-2);
jl. 4 ; goto shift;
f15=-b3. ; right shift:
ac w2(x3-2) ; position:= -word(operand top-2);
ls w1 x2+0 ; shift:
; left hand:= left hand shift position;
a40: al w3 x3-2 ; unstack operand:
am -2048
rs.w3 g24.+2048 ; operand top:= operand top-2;
rs w1 x3-2 ; word(operand top-2):= left hand;
jl. a32. ; goto unstack operator;
a41: am -2048
rl.w1 g25.+2048 ; unstack par:
rl w2 x1+2
sn w2 16 ; if word(operator top+2)<><(:> then
jl. 6 ;
am -2048 ;
jl. e40.+2048 ; syntax error;
al w1 x1+2
am -2048
rs.w1 g25.+2048 ; operator top:= operator top+2;
jl. a1. ; goto next delim;
f42=-b1.
a42: rl.w2 c0.
rl w3(x2-c1+g28); restore:
rs w3 x2-c1+g18 ; prog state:= word(block entry);
jl. a0. ; goto exam delim;
f18=-b3. ; repeat byte:
rl w3 x3-2 ; operand:= word(operand top-2);
sh w3 0 ; if operand<1 then
jl. a45. ; repetition warn;
am -2048 ;
rl.w1 g23.+2048
bl w2 x1-1 ; value:= byte(prog top-1);
a43: sh w3 1 ; next byte:
jl. a42. ; if operand<=1 then goto restore;
al w3 x3-1 ; operand:= operand-1;
am -2048
ds.w3 g59.+2048
am -2048 ;
jl.w1 e22.+2048 ; load byte(value);
am -2048
dl.w3 g59.+2048
jl. a43. ; goto next byte;
f19=-b3. ; repeat word:
rl w3 x3-2 ; operand:= word(operand top-2);
sh w3 0 ; if operand<1 then
jl. a45. ; repetition warn;
am -2048
rl.w1 g23.+2048
rl w2 x1-2 ; value:= word(prog top-2);
a44: sh w3 1 ; next word:
jl. a42. ; if operand<=1 then goto restore;
al w3 x3-1 ; operand:= operand-1;
am -2048
ds.w3 g59.+2048
jl.w1 e23. ; load word(value);
am -2048
dl.w3 g59.+2048
jl. a44. ; goto next word;
f20=-b3. ; repeat real:
rl w3 x3-2 ; operand:= word(operand top-2);
sh w3 0 ; if operand<1 then
jl. a45. ; repetition warn;
am -2048
rl.w1 g23.+2048
al w2 x1-2 ; value addr:= prog top-2;
a46: sh w3 1 ; next real:
jl. a42. ; if operand<=1 then
al w3 x3-1 ; goto restore;
am -2048
ds.w3 g59.+2048 ; operand:= operand-1;
rl w2 x2-2 ; load word(value addr-2);
jl.w1 e23.
am -2048
rl.w2(g58.+2048); load word(value addr);
jl.w1 e23.
am -2048
dl.w3 g59.+2048
jl. a46. ; goto next real;
a45: al.w3 a42. ; repetition warn:
am -2048 ;
jl x3-a42+e49+2048; goto restore;
c.i0i.z. ; end f names for expression
e.
i.e. ; end program scan
d8:
; init slang
; intext:= outside segment:= error:= testmode:=
; list:= id out:= false;
; ahead:= symbol type:= length:= segments:= 0;
; old prog state:= 1
b.b31,a46
w.b18: am -2048
w. jl. e51.+2048 ; slang fault term
b19: jl w3 x2+h79 ; connected=true
b4: <:kind <0>:>
b6: <:no program<0>:>
b7: <:param <0>:>
b8: <:object area <0>:>
b9: -1 ; fp base
b10: -1 ; old
b11: 4<12+10 ; <sp><name>
b12: 8<12+10 ; .<name>
b30: 8<12+4 ; .<integer>
b5: 1<23+4 ; <bs>
b13: 1<23+18 ; <mto>
b29: 19<12+4 ; declare s4 (used as sum and doublesum and clock)
b20: <:off:>
b21: <:on:>
b14: <:no:>
b15: <:yes:>
b31: <:byte:> ; ***special action btj gris
b16: <:list:>,0 ,<:no:> ; false
<:type:>,0 ,<:no:> ; false
<:names:>,0 ,<:no:> ; false
<:message:> ,<:yes:> ; true
<:warning:> ,<:yes:> ; true
<:entry:>,0 ,<:yes:> ; true
<:remove:>,0 ,<:yes:> ; true
<:lines:>,0 ,<:yes:> ; true
<:xref:>,0 ,<:no:> ; false
b24: <:proc:>,0 ,<:***:> ; ***** special action
; b17 must be the first word after the names
b17: 0 ; source
b0: 32 ; <bl>
b1: 0 ; saved w2 (<=> is not used)
46 ; <.>
b2: 2<12+2
b22: 1<15+1<7 ; mask for list.on in sourcename
b23: 0 ; list-on-or-off
b25: (:-1:)>1 ; top of procnames
b26: (:-1:)>1 ; base of procnames
b27: 0 ; new top of procnames
b28: c1 ; stepping stone (=c1)
; procedure inchar;
; comment: calls next symbol, makes actions on end medium
; characters and skips all other characters except
; letters, digits, and points.
; call: exit:
; w0 destroyed
; w1 return destroyed
; w2 symbol
; w3 symbol type;
w.a1: rs.w1 b10. ; begin
rl.w1 c0. ; save(return);
jl w1 x1-c1+e5 ; again: next symbol;
se w3 14 ; if symbol type=14 then
jl. 10 ; begin
al w0 1 ; lineno := 1;
am. (c0.) ; goto exit;
rs w0 g68-c1 ; end;
jl. (b10.) ;
sh w3 6 ; if symbol type<=6 then
jl. (b10.) ; goto exit;
se w3 13 ; if symbol type<>end medium then
jl. a1.+2 ; goto again;
rl.w1 c0. ; select next source(
jl w3 x1-c1+e16 ; no program term);
jl. a0. ; goto again;
jl. a1.+2 ; exit:
; end;
w.a0: rl.w2 c0. ; no program term:
al w0 x2-c1+c22
jl w3 x2-c1+e11 ; writetext(<:<10>***slang :>);
al.w0 b6.
jl w3 x2-c1+e11 ; writetext(<:no program:>);
al w0 1
rs w0 x2-c1+e5 ; end source list:= false;
rs w0 x2-c1+g53 ; error:= true;
jl x2-c1+d6 ; goto end slang;
a2: am c40-c0 ; area connect error:
am c0-b4
a3: al.w1 b4. ; text:= <:connect :>;
rl.w2 c0. ; if false then
al w0 x2-c1+c22 ; area kind error:
jl w3 x2-c1+e11 ; text:= <:kind :>;
al.w0 b8. ; writetext(<:<10>***slang :>);
jl w3 x2-c1+e11 ; writetext(<:object area :>);
al w0 x1+0
jl w3 x2-c1+e11 ; writetext(text);
am -2048
al w0 x2-c1+g43+2048
jl w3 x2-c1+e11 ; writetext(result name addr);
jl w3 x2-c1+e4 ; writechar(nl);
rl w0 x2-c1+c4
am -2048
rs w0 x2-c1+e0+2048; kill out segment;
al w0 1
rs w0 x2-c1+g53 ; error:= true;
jl. a9. ; goto end parameters;
d7: rs.w3 b10. ; init:
rl.w0 b15. ; if mode listing
rl w2 x1+h51 ; then
sz w2 1<8 ; list.yes;
rs. w0 b16.+6 ;
al.w2 c0. ; save(call pointer);
am -2000
rs w2 x2-c0+c1+2000
am -2000
al w2 x2-c0+c1+2000
rs.w2 c0. ; calculate references;
rs.w2 b28.
rs.w1 b9.
rs w1 x2-c1+g52 ; save(fp base);
al w0 x1+h22-2
al w2 x2-500
rs w0 x2-c1+g40+500; set inblock addr;
al w0 x1+h23
rs w0 x2-c1+g41+500; set outblock addr;
bl w0 x3+0
sn w0 6 ; if byte(call pointer)<>6 then
jl. a4. ; begin
rl w0 x2-c1+c4+500; kill outsegment;
rs w0 x2-c1+e0+500; goto param list
jl. a11. ; end;
a4: al w0 x2-c1+g43+500
rs w0 x2-c1+g56+500; save(result name addr);
c. h57 < 2 ; if system 2 then include the note-scan:
rl w0 x3-8
al w3 x1+h52+22 ; current note:= first fp note;
a5: sn w0(x3+0) ; test note:
jl. a6. ; if result name=current note name then
al w3 x3+22 ; goto fp note;
sl w3 x1+h53 ; current note:= current note+1;
; if current note<last fp note then
jl. a11. ; goto test note;
jl. a5. ; goto param list;
a6: rs w3 x2-c1+g33+500; fp note:
rl w1 x3+4 ; if document name<>0 then
se w1 0 ; goto param list;
jl. a11.
al w0 i1
rs w0 x3+2 ; size:= standard work area size;
ld w1 -65 ; fpnote(12:14):= 0;
ds w1 x3+16
al w1 x3+2 ; tail addr:= fp note addr+2;
al w3 x1+2 ; document name addr:= tail addr+2;
rs w3 x2-c1+g56+500; result name addr:= document name addr;
jd 1<11+40 ; create entry;
al w0 -1
rs w0 x2-c1+g36+500; slang generated name:= true;
z. ; end note-scan;
a11: rl.w1 c0. ; param list:
al w1 x1-500
al w3 x1-c1+g39+500
jd 1<11+68 ; generate name(source chain);
rl.w2 b10.
dl w0 x2-6 ; save(result name);
ds w0 x1-c1+g43+2+500
dl w0 x2-2
ds w0 x1-c1+g43+6+500
bl w0 x2+0 ; delim:= byte(call pointer);
se w0 6 ; if delim<>6 then
rs w0 x1-c1+g43+500; word(result name addr):= no name;
al w1 x2+0 ; next:= call pointer;
ba w1 x1+1 ; again:
bl w0 x1+0 ; next:= next+byte(next+1);
sl w0 4 ; if byte(next)>=4 then
jl. -6 ; goto again;
al w3 x1-8 ; base of procnames := next-8;
rs.w3 b26. ;
ws w1 4 ; byte(call pointer+1):=
hs w1 x2+1 ; next-call pointer;
al w2 x2+10 ; i:= call pointer+10;
rs.w2 b17. ; source:= i;
rs.w2 b10. ; old:= i;
a12: rl.w1 b25. ; next param: if i > top of procnames then
sl w1 x2 ; begin
jl. a41. ; j := top of procnames;
al w2 x2-2 ; i := i-2;
rs.w2 b1. ; save(i);
a39: dl w0 x1-2 ; move again:
ds w0 x2-2 ; words(i-8:i-2) :=
dl w0 x1-6 ; words(j-8:j-2);
ds w0 x2-6 ;
al w1 x1-8 ; j := j-8;
al w2 x2-8 ; i := i-8;
se.w1(b26.) ; if j > base of procnames then
jl. a39. ; goto move again;
; comment now all procnames are moved, so that they are close
; to the next item head in the program stack...
a40: am -2048
rs.w2 g75.+2048 ; set base and top:
rs.w2 b26. ; base of procnames := i;
rl.w0 b2. ; word(i+6) := 2<2 + 2;
rs w0 x2+6 ;
rl.w1 b1. ; restore(i);
rs.w1 b25. ; top of procnames := i;
al w2 x1+2 ; i := i+2;
ws.w1 b26. ; upper index of procnames :=
ls w1 -3 ; (top of procnames
hs.w1 j38. ; - base of procnames) shift (-3);
; end;
a41: bl w0 x2+0 ;
sh w0 2 ; if byte(i)<=2 then
jl. a21. ; goto end list;
rl w0 x2+0
sn.w0(b11.) ; if word(i)=4<12+10 then
jl. a15. ; goto test name;
a13: rl.w1 c0. ; list param:
al w0 x1-c1+c22
jl w3 x1-c1+e11 ; writetext(<:<10>***slang :>);
al.w0 b7.
jl w3 x1-c1+e11 ; writetext(<:param :>);
a14: bl w3 x2+0 ; list more:
rl.w0 x3+b0.-4
jl w3 x1-c1+e9 ; writechar(delim(byte(i)));
rl w0 x2+2
bl w3 x2+1
se w3 10 ; if kind=integer then
jl. 6 ; writeinteger(param)
al w0 x2+2 ; else writetext(param);
am e11-e10
jl w3 x1-c1+e10
ba w2 x2+1 ; i:= i+param length;
rl w0 x2+0
sn.w0(b11.) ; if word(i)<>4<12+10
jl. 8 ; and byte(i)>=4 then
bl w0 x2+0 ; goto list more;
sl w0 4
jl. a14.
jl w3 x1-c1+e4 ; writechar(nl);
jl. a12. ; goto next param;
a15: rl w0 x2+10 ; test name:
sh.w0(b11.) ; if word(i+10)<=4<12+10 then
jl. a20. ; goto source item;
sn.w0(b30.) ; if word(i+10)=8<12+4 then
jl. a46. ; goto test byte;
se.w0(b12.) ; if word(i+10)<>8<12+10 then
jl. a13. ; goto list param;
rs.w2 b1. ; save(i);
al.w3 b16. ; base:= first name;
dl w1 x2+4
a16: rl w2 x2+6 ; again:
; notice... only the first 3 letters are significant
sn w0(x3) ; if word(base)=param(0) then
jl. a18. ; goto second name;
a17: rl.w2 b1. ; restore(i);
al w3 x3+8 ; base:= base+8;
sl.w3 b17. ; if base<=last name then
jl. a13. ; goto again;
jl. a16. ; goto list param;
a18: rl.w2 b1. ; second name: restore(i);
sn.w3 b24. ; if option = <:proc:> then
jl. a42. ; goto procname list;
dl w1 x2+14 ;
se w1 0 ; if word(i+14) is used then
jl. a13. ; goto list param;
se.w0(b14.) ; if word(i+12) = <:no:>
sn.w0(b15.) ; or word(i+12) = <:yes:> then
jl. a19. ; goto set modification;
se.w0(b20.) ; if word(i+12) <> <:off:> and
sn.w0(b21.) ; word(i+12) <> <:on:>
se.w3 b16. ; or base <> base(<:list:>) then
jl. a13. ; goto list param;
al w1 1<7 ; list-on-or-off :=
se.w0(b20.) ; if <:off:> then <list off>
rl.w1 b22. ; else <list on>;
rs.w1 b23. ;
jl. 4 ; goto next param;
a19: rs w0 x3+6 ; set modification:
al w2 x2+20 ; word(base+6):= word(i+12);
rl w0 x2 ; i:= i+20;
sn.w0(b12.) ; if word(i) <> 8<12+10
se.w3 b16.+64 ; or base <> base(<:xref:>) then
jl. a12. ; goto next param;
; xref sort area name:
rl.w1 b28. ; move name of xref sort area to
al w1 x1-1000 ; to xref zone.....
dl w0 x2+4 ;
ds w0 x1-c1+g70+h1+4+1000
dl w0 x2+8 ;
ds w0 x1-c1+g70+h1+8+1000
al w2 x2+10 ; i := i+10;
jl. a12. ; goto next param;
a20: rl.w3 b17. ; source item:
dl w1 x2+4 ; words(source:source+6):=
lo.w0 b23. ; insert list-on-or-off mask in name;
ds w1 x3 ; words(i+2:i+8);
dl w1 x2+8
ds w1 x3+4 ; source:= source+10;
rl. w0 b3. ;
rs w0 x3+6 ; move file
al w0 0 ;
rs. w0 b3. ; reset b3 to zero
rl w0 x2+10 ;
sn. w0 (b30.) ; count if fileno
al w2 x2+4 ;
al w3 x3+10
rs.w3 b17. ; i:= i+10;
al w2 x2+10
jl. a12. ; goto next param;
b3: 0 ; file
a42: rl.w0 b12. ; procname list:
al w1 x2-2 ; j := i-2;
ba w1 x1+3 ; for j := j+10 while
sn w0(x1+2) ; word(j) = (<point>,<name>) do ;
jl. -4 ;
bl w0 x1+2 ; if separator(j) = <point> then
sn w0 8 ; goto list param;
jl. a13. ;
rs.w1 b27. ; new top of procnames := j;
al w2 x1 ; i := j;
a43: al w1 x1-10 ; compress procnames: j := j-10;
al w2 x2-8 ; i := i-8;
sh.w1(b1.) ; if j > saved i then
jl. a44. ; begin
dl w0 x1+6 ; words(i+0:i+6) :=
ds w0 x2+2 ; words(j+4:j+10);
dl w0 x1+10 ;
ds w0 x2+6 ; goto compress procnames;
jl. a43. ; end;
a44: rl.w0 b27. ; saved i := new top of procnames;
rs.w0 b1. ;
sh.w1(b26.) ; if j <= base of procnames then
jl. a40. ; goto set base and top;
al w2 x2+8 ; i := i+8;
jl. a39. ; goto move again;
a46: rl w0 x2+2 ; test byte: (<name>.<integer> met)
rl w3 x2+12 ;
sn. w0 (b31.)
jl. 6
rs. w3 b3.
jl. a20.
rl w0 x2+4
se. w0 (b31.+2)
jl. -8
sh w3 2047 ; if integer>2047
jl. 4
jl. a13. ; goto list param;
rl.w1 c0. ;
hs w3 x1-c1+j39+1; testup:=integer;
hs w3 x1-c1+j41+1;
ac w3 x3+1 ;
hs w3 x1-c1+j40+1; testlow:=-integer-1;
hs w3 x1-c1+j42+1;
al w2 x2+14 ; i:=i+4;
jl. a12. ; goto next param
a21: al w2 x2-2 ; end list:
rl.w0 b2. ; i:= i-2;
rs w0 x2+0 ; word(i):= 2<12+2;
am. (b9.)
rs w2 h8 ; current command:= i;
rl.w2 b26. ; i := base of procnames + 6;
al w2 x2+6 ;
rl.w3 b17.
al w3 x3-2
a22: sh.w3(b10.) ; while source<>old do
jl. a23. ; begin
dl w1 x3-2 ; words(i-4:i-2):=
ds w1 x2-2 ; words(source-4:source-2);
dl w1 x3-6
ds w1 x2-6
rl w1 x3-10
rs w1 x2-10
al w3 x3-10 ; source:= source-10;
al w2 x2-10 ; i:= i-10
jl. a22. ; end;
a23: am -2000
rl.w1 c0.+2000
al w1 x1-500
rs w2 x1-c1+g34+500; source:= i;
al.w2 d8.+512
rs w2 x1-c1+g31+500
al w2 x2+4 ; first label:= init slang addr+512;
rs w2 x1-c1+g23+500; prog top:= first label+4;
al w0 -1
c.d8./2+255
r.d8./2+257 ; makes room for one output segment
z.
rs w0 x2-4 ; word(prog top-4):= -1;
al w2 x2-2
rs w2 x1-c1+g62+500; last k:= prog top-2;
al w0 0
rs w0 x2+0 ; word(last k):= 0;
am -2048
rl.w2 c0.+2048
rl.w0 b14. ; list action:
sn.w0(b16.+6) ; if list=<:no:> then
jl. a25. ; goto type action;
rl w3 x2-c1+c9
rs w3 x2-c1+c8+2; list:= saved list:= true;
rs w3 x2-c1+j11
a25: se.w0(b16.+8+6) ; type action:
jl. a26. ; if type=<:yes:> then
rl w3 x2-c1+c4 ; goto names action;
rs w3 x2-c1+e1 ; kill select n input;
rs w3 x2-c1+e2 ; kill select t input;
a26: se.w0(b16.+16+6); names action:
jl. a27. ; if names=<:yes:> then
bl w3 x2-c1+j18 ; goto message action;
hs w3 x2-c1+j17 ; kill display id;
a27: se.w0(b16.+24+6); message action:
jl. a28. ; if message=<:yes:> then
rl w3 x2-c1+c9 ; goto warning action;
rs.w3 j16. ; kill message;
a28: se.w0(b16.+32+6); warning action:
jl. a29. ; if warning=<:yes:> then
rl w3 x2-c1+c4 ; goto entry action;
rs w3 x2-c1+j19 ; kill warning;
a29: rl w3 x2-c1+j22 ; save possibility for later
rs. w3 d12. ; entry.no
sn.w0(b16.+40+6); entry action:
jl. a10. ; if entry=<:no:> then
rl w3 x2-c1+c9 ; goto remove action;
rs w3 x2-c1+j22 ; standard entry:= true;
a10: se.w0(b16.+48+6); remove action:
jl. a30. ; if remove=<:yes:> then
rl w3 x2-c1+c9 ; goto lines action;
rs w3 x2-c1+j23 ; remove:= false;
a30: se.w0(b16.+56+6); lines action:
jl. a37. ; if lines = <:yes:> then
rl w3 x2-c1+c9 ; goto xref action;
rs w3 x2-c1+j30-2;
rs w3 x2-c1+j30 ; kill write lineno in procedure
rs w3 x2-c1+j30+2; writeaddr.......
a37: se.w0(b16.+64+6); xref action:
jl. a38. ; if xref=<:yes:> then
rl w3 x2-c1+c4 ; goto test source;
rs w3 x2-c1+e60 ; xref := false;
rl w3 x2-c1+c9 ; kill calls of xref output...
rs w3 x2-c1+j31 ;
rs w3 x2-c1+j32 ;
rs w3 x2-c1+j33 ;
rs w3 x2-c1+j34 ;
rs w3 x2-c1+j35 ;
rs w3 x2-c1+j36 ;
am 500
rs w3 x2-c1+j37-500;
a38: rl.w3 b17. ; test source;
se.w3(b10.) ; if source=old then
jl. a8. ; begin
rl w3 x2-c1+c4 ; kill select n input;
rs w3 x2-c1+e1 ; kill select t input;
rs w3 x2-c1+e2 ; source list:= false;
rl w3 x2-c1+c9
rs w3 x2-c1+j24 ; goto connect
jl. a31. ; end;
a8: am. (b9.)
jl w3 h29-4 ; stack in(current chain);
rl.w1 b28.
jl w3 x1-c1+e16 ; select next source(
jl. b18. ; slang fault term);
a31: rl.w2 b28. ; connect:
al w2 x2-500
al w1 x2-c1+g35+500; set zone descriptor;
al w3 x1+6
al w0 x1+6 ; first share:= share addr;
ds w0 x1+h0+8 ; last share:= share addr;
al w3 x1+g71-g35;
al w0 x3
ds w0 x1+g70-g35+h0+8; **** initialize xref zone too...
al.w3 d8.
rs w3 x1+6+2 ; first shared:= first buffer word;
rs w3 x1+h2+6 ; free parameter := first buffer word;
rs w3 x1+g71-g35+2; *** initialize xref zone too...
rl w3 x2-c1+e0+500; if outsegment killed then
sn w3(x2-c1+c4+500); goto end parameters;
jl. a9.
al w3 x2-c1+g43+500; name:= result name;
al.w1 b16.
jd 1<11+42 ; lookup entry;
rl w3 x2-c1+g33+500
bl.w0 b16.+16 ; content:= tail(16);
bl.w1 b16.+1 ; kind:= tail(0:1);
sn w3 -1 ; if fp note then
jl. 8 ; begin
bl w0 x3+18 ; content:= fp note(18);
bl w1 x3+3 ; kind:= fp note(2:3)
hs.w0 b16.+16 ; end;
sn w0 4
se w1 18 ; if content=4
jl. 4 ; and kind=mto then
jl. a2. ; goto area connect error;
al w0 i1 ; connect standard area, if area not exist;
al w1 x2-c1+g35+500
al w2 x2-c1+g43+500
am. (b9.)
jl w3 h28 ; connect output;
se w0 0 ; if result<>0 then
jl. a2. ; goto area connect error;
rl.w0 b19.
rl.w2 b28. ; output connected:= true;
rs w0 x2-c1+j25
al w3 0
bl.w0 b16.+16 ; if content=4 then
sn w0 4 ; segment count:= 0;
rs w3 x1+h1+16
rl w0 x1+h1+0
sl w0 0 ; if size>=0 then
jl. a35. ; goto save size;
sn.w0(b13.) ; if kind=mto then
jl. a36. ; goto mto;
se.w0(b5.) ; if kind<>bs then
jl. a3. ; goto area kind error;
al w3 x1+h1+2 ; name:= document name;
al.w1 b16.
jd 1<11+42 ; lookup entry;
rl.w0 b16. ; save size:
a35: am -2048
rs w0 x2-c1+g46+2048; save(size);
jl. a9. ; goto end parameters;
a36: rl w0 x2-c1+j21 ; mto:
am -2048
rs w0 x2-c1+e0+4+2048; tape version:= true;
a9: rl.w3 b16.+64+6 ; end parameters:
sn.w3(b14.) ; if xref <> <:no:> then
jl. a45. ; begin
am. (b28.) ;
am -1000 ;
al w1 g70+h1-c1+1000
c. h57<2 ; if system 2 then include:
al w3 x1+2 ; create entry (sort area);
jd 1<11+40 ;
z.
al w0 i1 ;
al w1 x1-h1 ;
al w2 x1+h1+2 ;
am. (b9.) ; connect output (xref zone);
jl w3 +h28 ;
rs w0 x1+h1+16 ; segment count(xref zone) := 0;
rl.w1 b28. ;
rl w3 x1-c1+c4 ;
se w0 0 ; if connect not ok then
rs w3 x1-c1+e60 ; xref := false;
; end;
a45: rl.w1 b28. ;
am -2048
rl w2 x1-c1+g34+2048
al w2 x2-2
rs w2 x1-c1+g32 ; core top:= source-2;
al w0 0
rs w0 x2+0 ; word(core top):= 0;
al w2 x2-20 ; w2 := core top-20 (=address of s0);
al w3 x2+4 ; w3 := core top-16 (=address of s1);
ds w3 x1-c1+g79 ;
al w2 x2-4 ;
rs w2 x1-c1+g26 ; stack top:= core top-12;
al w1 2.10 ; define s0=0 and s1=0 (i.e. sum and
ds w1 x2+6 ; doublesum = 0);
ds w1 x2+10 ;
ds w1 x2+14 ; define s2, shortclock
ds w1 x2+18 ; define s3, decimal date
ds w1 x2+22 ; define s4, decimal clock
dl w1 110 ;
ld w1 5 ;
rs w0 x2+12 ; calculate shortclock
jl. w3 a24. ;
rs w0 x2+16 ; decimal date
rs w1 x2+20 ; decimal clock
rl.w1 b29. ; declare s4...;
rs w1 x2+2 ;
am. (b9.)
al w1 h20
rl.w3 b28.
jl w3 x3-c1+e37 ; init in;
jl. a33. ; goto comment;
a32: rl.w3 b28. ; normal:
jl w3 x3-c1+e1 ; select n input;
a33: jl.w1 a1. ; comment: next symbol;
a34: se w2 59 ; comment 1:
jl. 8 ; if symbol=<;> then
jl.w1 a1. ; while symbol type<>nl do
se w3 14 ; next symbol;
jl. -4
se w3 0 ; if symbol type<>letter then
jl. a33. ; goto comment;
rl.w3 b28.
rs w2 x3-c1+g5 ; id letter:= symbol;
jl.w1 a1. ; next symbol;
se w3 2 ; if symbol type<>point then
jl. a34. ; goto comment 1;
al w1 31
rl.w3 b28.
la w1 x3-c1+g5
rs w1 x3-c1+g5 ; id letter:= id letter mod 32;
sn w1 2 ; if id letter=<b> then
jl x3-c1+d11 ; goto block;
sn w1 19 ; if id letter=<s>then
jl x3-c1+d10 ; goto segment;
sn w1 14 ; if id letter=<n> then
jl. a32. ; goto normal;
sn w1 20 ; if id letter=<t> then
jl w3 x3-c1+e2 ; select t input;
jl. a33. ; goto comment;
a24:
; calculate decimal date and clock
b. c11 w.
ds. w3 c11. ; save w2, w3
jd 1<11+36 ; w0w1:=get clock
nd w1 3 ; float
fd. w1 c8. ; div by 10000
bl w3 3 ;
ad w1 x3-47 ; normalize
wd. w1 c6. ; day:=sec//86400;
al w3 0 ; w0w3:=secs:=secs mod 86400;
wd. w0 c0. ; w0w3:=minutes:=secs//60;
ld w3 24 ; w2:=seconds:=secs mod 60;
wd. w0 c0. ; w0:=hour:=minutes//60;
rs. w3 c9. ; c9:=minutes:=minutes mod 60;
wm. w0 c2. ;
wa. w0 c9. ;
wm. w0 c2. ;
wa w0 4 ; c9:=clock:=(hour*100+minutes)
rs. w0 c9. ; *100+seconds;
ld w1 26 ; year:=(day*4
wa. w0 c7. ; +99111
al w3 0 ; //1461;
wd. w0 c4. ;
as w3 -2 ; day:=day*4+99111 mod 1461//4;
wm. w3 c1. ; month:=day*5
al w3 x3+461 ; +461
wd. w3 c3. ; //153;
al w1 x2+5 ; day:=(day*5+461) mod 153 + 5;
sl w3 13 ; if month>13 then
al w3 x3+88 ; month:=month-twelvemonth+oneyear;
wm. w3 c2. ; month:=month*100;
rx w2 0 ;
wd. w1 c1. ; day:=day//5;
wa w3 2 ; date:=day+month;
wm. w2 c5. ; year:=year*10000;
wa w3 4 ; date:=date+year;
al w0 x3 ; w0:=date;
dl. w2 c10. ; w1:=clock; restore w2;
jl. w3 (c11.) ; return
c0: 60 ;
c1: 5 ;
c2: 100 ;
c3: 153 ; days in the 5 month march-july
c4: 1461 ; days in 4 years
c5: 10000 ;
c6: 86400 ; seconds in 24 hours
c7: 99111 ; to adjust for 1.1.68 being date 0
10000<9 ;
c8: 4096+14-47 ; 10000*2**(-47) as float. number
c9: 0 ; work for clock
c10: 0 ; saved w2
c11: 0 ; saved w3
e.
c.i0i.z.
e.
i11=k-10000 ; bytes
i12=(:i11+511:)/512 ; segments
i4=2-e13+i7
i5=e13-i7
i6=g53-c1
i8=g11-c1
i9=g26-c1
i10=c40-c1
i13=e46-c1
i14=c4-c1
i15=g55-c1
i16=d8-c0
i17=c21-c1
i18=c15-c1
i19=g33-c1
i20=c28-c1
i21=e15-c1
i22=c39-c1
i23=c35-c1
i24=c2-c1
i25=g74-c1
i30=c41-c1
i26=c8-2047
i27=c55-2047
i28=e52-2047
i29=g68-2047
i31=g76-2047
i32=g73-2047
i33=g53-2047
i34=g74-2047
i35=c22-2047
i36=c29-2047
i37=e18-2047
i.e. ; end slang segment
m. slang text 3 included
g2=k-10000
g0:g1: (:g2+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file block
2<12+4 ; contents entry
g2 ; length
m.slang rc 1985.03.28
d.
p.<:insertproc:>
l.
e.
e.
▶EOF◀