|
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: 16896 (0x4200)
Types: TextFile
Names: »retclaim3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retclaim3tx «
mode list.yes
claim4tx=edit claim3tx
; connect output : segm < 2 + key
; claim <proc> ...
;
l./claim ...1/, r/85.03.13/89.01.10/
l./s. a26/, r/a26, b38/a99, b99/, r/d2/d9/
l./; variables/, i/
\f
; fgs 1989.01.10 claim ...1a...
/
l./b0:/, i/
b40: 0 ; process description address
b41: 0, r.4; process name
b49: 0 ; saved item adress
b50: 0 ;
b51: 0 ; save item head, address of head after <:all:>
/, l1, p-2
l./b21:/, r/entr/entr./
l./b22:/, r/segm/segm./
l./b24:/, r/***/<10>***/, r/<0>/param <0>/
l./b28:/, r/<10>/ /, r/area/area :/
l./b29:/, r/ buf/ buf :/
l./b30:/, r/ size/ size :/
l./b35:/, r/<:: :>/<: : <0>:>/
l./b38:/, r/ first core/ first :/, l1, i/
b39: <:<10>name : <0>:>
b42: <:area<0>:>
b43: <:buf<0>:>
b44: <:size<0>:>
b45: <:first<0>:>
b46: <:<32><32><32>:>
b47: <:<32><32><0>:>
b48: <:all:>
b52: 4<12 + 10
/, p-1
l./claim ...2/, d./a5:/, d./jl. a2./, i#
\f
; fgs 1989.01.10 claim ...2...
; program start:
; if a leftside is specified in the program call,
; the current input zone is stacked and used for
; secondary output.
a0: al w0 x3 ; save w3;
rs. w1 b8. ; save fpstart;
al. w1 h19. ;
jl. w3 h79. ; terminate prog zone
al w3 (0) ;
am. (h16.) ;
zl w1 27 ; save own process.area
rs. w1 b17. ; before connect
rl w0 x3 ; start: w0 := item head of program name;
el w2 0 ; w2 := separator;
se w2 6 ; if separator = equal then
jl. a1. ; begin
jl. w3 h29.-4 ; stack current input;
rl. w2 h8. ; w2 := outfile name;
al w2 x2+2 ;
al w0 1<2+0 ; comment: connect 1 segm. temporary
jl. w3 h28. ; connect output(w0, w1, w2);
se w0 0 ; if connect trouble then
jl. a7. ; error (<:connect output:>);
am h20-h21; outputzone := current input;
a1: al. w2 h21. ; end
rs. w2 b0. ; else outputzone := current output;
rl. w1 h16. ; process descr addr :=
rs. w1 b40. ; own process description addr;
dl w0 x1+4 ; move
lo. w3 b46. ; name of process
lo. w0 b46. ; or
ds w0. b41.+2 ; spaces
dl w0 x1+8 ; to
lo. w3 b46. ;
lo. w0 b47. ;
ds. w0 b41.+6 ; process name;
jl. w3 d1. ; next param;
am ; comment: skip <end param> action;
rs. w1 b49. ; saved item address := item address;
\f
; fgs 1989.01.10 claim ...3...
; comment: at this point the register contents are:
; w0 == item head
; w1 == item address
; w2 == irrellevant
; w3 == irrellevant
a2: ds. w1 b9. ; next parameter: save w0w1;
al w2 13 ;
rs. w2 b1. ; keymask := all scopes;
al w2 -1 ;
rs. w2 b2. ; devicename := all devices;
el w2 0 ;
sh w2 3 ; if separator = <end param> then
jl. a27. ; goto not internal proc;
zl w2 1 ;
se w2 10 ; if item kind <> <name> then
jl. a5. ; goto paramerror
el w2 0 ;
se w2 4 ; if separator = 'sp' then
jl. a27. ; begin <*maybe internal process*>
ea w1 x1+1 ; get next separator;
el w2 x1 ;
dl. w1 b9. ; restore w0w1;
sl w2 5 ; if next separator <> 'sp' and <> end param then
jl. a27. ; goto not internal process;
jl. w3 d4. ; get next internal process;
jl. a50. ; if no success then goto check item name;
rs. w1 b49. ; saved item address := item address;
rs. w3 b40. ; process descr addr := w0;
dl w1 x3+4 ; move
lo. w0 b46. ; process name
lo. w1 b46. ; or
ds. w1 b41.+2 ; spaces
dl w1 x3+8 ; to
lo. w0 b46. ;
lo. w1 b47. ;
ds. w1 b41.+6 ; process name;
jl. w3 d1. ; next param;
am 0 ; ignore end param list;
ds. w1 b9. ; save new w0w1;
al w3 1 ; new process :=
hs. w3 b6. ; true;
jl. a27. ; end <*maybe internal process*>;
; goto internal process;
a50: rl. w1 b49. ; check if item = <:all:>:
rl w0 x1+2 ;
se. w0 (b48.) ; if item.firat word = <:all:> then
jl. a27. ; begin
dl. w1 b51. ; get saved item head. address of head after <:all:>;
jl. a2. ; goto next parameter;
\f
; fgs 1989.01.10 claim ...3a...
a27: al w3 1 ; not internal process:
b6=k+1; new process
se w3 1 ; if not new process then
jl. a3. ; goto on with param;
rl. w1 b0. ;
al. w0 b39. ;
jl. w3 h31. ; writetext (<:<10>process name : :>);
al. w0 b41. ;
jl. w3 h31. ; writetext (process name);
al. w0 b28. ;
jl. w3 h31. ; writetext(<:area:>);
rl. w2 b40. ; area := if own process then
zl w0 x2+27 ; own process.area
sn. w2 (h16.) ; else
rl. w0 b17. ; process.area;
jl. w3 h32. ; writeinteger(area);
32<12+4 ;
al. w0 b29. ;
jl. w3 h31. ; writetext(<:buf.>);
am. (b40.) ;
zl w0 26 ;
jl. w3 h32. ; writeinteger(buf);
32<12+4 ;
al. w0 b30. ;
jl. w3 h31. ; writetext(<:size:>);
rl. w3 b40. ;
rl w0 x3+24 ;
ws w0 x3+22 ;
jl. w3 h32. ; writeinteger(size);
32<12+8 ;
al. w0 b38. ;
jl. w3 h31. ; writetext(<:first address:>);
am. (b40.) ;
rl w0 22 ;
jl. w3 h32. ; writeinteger(first address);
32<12+8 ;
al w2 0 ; new process :=
hs. w2 b6. ; false;
dl. w1 b9. ; restore w0w1;
el w2 0 ;
sh w2 3 ; if separator = <end param> then
jl. a8. ; goto search;
\f
; fgs 1989.01.10 claim ...3b...
a3: dl. w1 b9. ; on with param: restore w0w1;
a33: el w2 0 ; more param:
sh w2 3 ; if separator = <end param> then
jl. a6. ; goto terminate program;
zl w2 1 ;
se w2 10 ; if item kind <> <name> then
jl. a5. ; goto paramerror
ea w1 x1+1 ; get next item;
el w2 x1 ;
dl. w1 b9. ; restore (item);
sn w2 8 ; if next separator = '.' then
jl. a34. ; goto treat param;
el w2 0 ;
se w2 4 ; if separator <> 'sp' then
jl. a34. ; goto treat param;
jl. w3 d4. ; check internal process;
jl. a34. ; if no success then goto treat param;
jl. a8. ; if success then goto start search;
a34: rl. w3 b1. ; treat param:
rl w2 x1+2 ; w3:=
sn. w2 (b26.+2); if param=<:key:>
al w3 -1 ; then -1 else
sn. w2 (b31.+2); if param=<:temp:>
al w3 1 ; then 1 else
sn. w2 (b32.+2); if param=<:login:>
al w3 4 ; then 4 else
sn. w2 (b33.+2); if param=<:perm:>
al w3 8 ; then 8 else keymask;
sn. w3 (b1.) ; if w3 = keymask then
jl. a18. ; goto move docname;
rs. w3 b1. ; keymask := w3;
jl. a4. ; goto next param;
a18: dl w3 x1+4 ; move parametername to devicename;
ds. w3 b3. ;
dl w3 x1+8 ;
ds. w3 b5. ;
a4: jl. w3 d1. ; next param:
jl. a8. ; if param = <end param> then goto start search;
el w2 0 ; if separator <> <point> then
se w2 8 ; goto start search;
jl. a8. ;
ds. w1 b9. ; store (item);
jl. a33. ; goto more param;
a5: jl. w3 d2. ; paramerror: out error param;
jl. w3 d1. ; next param;
am ; comment: skip end param action;
al w2 1 ; succes := false;
hs. w2 b7. ;
jl. a2. ; goto next parameter;
#
l./...3a/, r/3a/3c/
l./a6:/, d3
r/ rl./a6: rl./
l./se. w1 h20./, i/
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
/, p-2
l./rl. w3 h8./, g/./ /, i/
am. (b8.) ;
/, p1
l./jd 1<11+42/, l1, i/
al w2 x1 ; save w1;
dl w1 110 ;
ld w1 5 ; w0 := shortclock;
al w1 x2 ; restore w1;
rs w0 x1+10 ; tail.shortclock := w0;
/, p-5
l./jl. h7./, g/./ /, i/
am. (b8.) ;
/, p1
l./rl. w3 h8./, g/./ /, i/
am. (b8.) ;
/, p1
l./...4/, r/82.11.24/89.01.10/
l./al w1 1/, d1
l./...4a/, r/85.03.15/89.01.10/
l./h16/, l-1, d1, i/
wa. w1 b40. ; proc descr addr ;
/, p-1
l./...5/, r/85.03.13/89.01.10/
l./h16/, l-1, d1, i/
wa. w1 b40. ; proc descr addr ;
/, p-1
l./...6/, r/rc 19.06.1971 /fgs 1989.01.10/
l./a12:/, i/
/
l./dl. w1 b9./, d, i/
rl. w1 b0. ;
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a36. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a36: dl. w1 b9. ; restore (item);
/, p-4
l./a13:/, d3, i/
a13: rl. w2 b2. ; end of devices:
se w2 -1 ; if empty paramname then
jl. a35. ; begin
rl. w1 b0. ; w1 := outputzone;
al w2 10 ;
jl. w3 h26. ; outchar ('nl');
rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a37. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a37: dl. w1 b9. ; restore (item);
jl. a2. ; goto next param;
a35: ; end;
/, p-4
l./al w2 1/, d, i/
dl. w1 b2.+2 ; device not found:
sn. w0 (b42.) ;
se. w1 (b42.+2); if name is <:area:> then
jl. a28. ;
jl. a32. ; goto ok;
a28: sn. w0 (b43.) ;
se. w1 (b43.+2); if name is <:buf:> then
jl. a29. ;
jl. a32. ; goto ok;
a29: sn. w0 (b44.) ;
se. w1 (b44.+2); if name is <:size:> then
jl. a30. ;
jl. a32. ; goto ok;
a30: sn. w0 (b45.) ;
se. w1 (b45.+2); if name is <:first:> then
jl. a31. ;
jl. a32. ; goto ok;
a31: al w2 1 ; failure:
/, p-2
l./dl. w1 b9./, d, i/
a32: rl. w1 b49. ;
rl w0 x1+2 ;
se. w0 (b48.) ; if saved item.word1 = <:all:> then
jl. a38. ; begin <*reset item address to point to <:all:>*>
jl. w3 d3. ; reset item address;
ds. w1 b51. ; save latest parameter address;
rl. w0 b52. ; w0 := 4 < 12 + 10;
rl. w1 b49. ; w1 := save item address;
ds. w1 b9. ; save (item);
; end;
a38: dl. w1 b9. ; restore (item);
/
l./d2 = k+2/, l1, i/
d3 = k+4 ; entry to procedure reset param pointer
/, p-2
l./...7/, r/rc 19.06.1971 /fgs 1989.01.10/
l./a9 , b7/, r/a9 /a10/
l./a0:/, i/
; procedure reset param pointer;
; the procedure resets the param pointer in b2 by the value of
; w1 at call and returns the old value of item head and address in w0, w1.
;
; w0 == old value of item head
; w1 == old value of item address
; w2 == unchanged
; w3 == unchanged
;
; return is made to w3.
a10: rx. w1 b2. ; swop address of item head;
rl w0 x1 ;
jl x3 ; return;
/, p-3
l./...8/, r/rc 19.06.1971 /fgs 1989.01.10/
l./b4:/, r/***/<10>***/
l./d0 = k ; length of program/, i#
\f
; fgs 1989.01.10 claim ...9...
; the following pages contain the code for fetching the
; next internal process description address which matches the name
; pointed to by x1+2
; if the name pointed to by x1+2 is <:all:>, the procedure gets the
; next used internal procedure description address and leaves the
; variable 'next internal in nametable' to point at the next procedure
; description.
;
; at entry and return the contents of w0, w1, w2 and w3 are :
;
; w0 : - unchanged
; w1 : name address -2 unchanged
; w2 : - unchanged
; w3 : link proc descr address
;
; return to :
; no success : link
; success : link +2
b. a9 , b9 ; begin block get next internal
w.
d4: ds. w1 b1. ; save registers
ds. w3 b3. ;
rl w2 x1+2 ;
sn. w2 (b48.) ; if name.param.word1 = <:all:> then
al w1 0 ; single process := false;
hs. w1 b6. ; else
hs. w1 b7. ; single process := true;
hs. w1 b8. ;
se w1 0 ; if not single process then
jl. a0. ; begin <*set the next index*>
rl. w2 b4. ; index :=
sn w2 0 ; if next in nametable = 0 then
a0: rl w2 78 ; first in nametable else
; else
; next in nametable;
; end else
; index := first in nametable;
a1: rl w3 x2 ; next process:
dl w0 x3+4 ;
sl. w3 (b5.) ; if name.index.first word.first char <> 0 and
b6=k+1;
se w3 x3+0 ; name.param.first word = <:all:> then
jl. a2. ;
jl. a3. ; goto success;
a2: sn w3 (x1+2) ; if name.index.first word <>
se w0 (x1+4) ; name.param.first word then
jl. a4. ; goto miss;
rl w3 x2 ;
dl w0 x3+8 ;
sn w3 (x1+6) ; if name.index.secnd word <>
se w0 (x1+8) ; name.param.secnd word then
jl. a4. ; goto miss;
a3: dl. w1 b1. ; success:
rl w3 x2 ; proc descr addr := nametable.index;
al w2 x2+2 ;
b7=k+1;
sn w3 x3+0 ; if name.param.first word = <:all:> then
rs. w2 b4. ; next in nametable := index + 2;
rl. w2 b2. ; restore registers;
am. (b3.) ; return to
jl +2 ; link + 2;
a4: ; miss:
al w2 x2+2 ; index := index + 2;
se w2 (80) ; if index <> last in nametable then
jl. a1. ; goto next proc;
al w2 0 ; no success:
b8=k+1;
sn w3 x3+0 ; if not single process then
rs. w2 b4. ; next in nametable := 0;
dl. w1 b1. ;
dl. w3 b3. ; restore registers;
jl x3 ; goto link;
b0: 0 ; saved w0
b1: 0 ; - w1
b2: 0 ; - w2
b3: 0 ; - w3
b4: 0 ; next in nametable
b5: 1<16 ;
d.
e. ; end block get next internal
l.
\f
; fgs 1989.01.10 claim ...10...
#
l./m. rc/, r/85.03.13/89.01.10/
f
end
▶EOF◀