|
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: 19968 (0x4e00)
Types: TextFile
Names: »claim3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »claim3tx «
; fgs 1985.03.13 claim ...1...
; the program is translated like
; (claim=slang text
; claim)
b. g6 w. ; for insertproc
d.
p.<:fpnames:>
l.
s. a26, b38 , c4 , d2 , i1
w.
k = h55
; comment the program searches the monitor tables
; and the chaintables and the processdescription
; and computes the claims of the process.
; the program uses the following absolute addresses
; in the monitor table:
; 92 = address of first drum chain table
d0. ; length of program
0 ; (not used)
jl. a0. ; program entry: goto start;
; variables:
b0: 0 ; addr of claim-output-zone
b1: 0 ; keymask
b2: 0, r.4; devicename
b3 = b2 + 2
b4 = b3 + 2
b5 = b4 + 2
b8: 0 ; saved fp start
0 ; saved (item head)
b9: 0 ; saved (item address)
b10: 0 ; addr of chain list element
b11: 0, r.4; devicename (from chaintable)
b12=b11 + 2
b13=b12 + 2
b14=b13 + 2
b16: 0 ; number of slices
b17: 0 ; number of segments
b18: 0 ; number of entries
b20: <:***claim connect <0>:> ; errortext
b21: <: entr<0>:> ;
b22: <: segm<0>:>
b15: <: slice <0>:>
b23: <: slices<0>:>
b24: <:***claim <0>:>
b25: <: unknown<0>:>
b26: <:<10> key <0>:>
b27: 0,r.10; tail for change entry
b28: <:<10>area <0>:>
b29: <: buf <0>:>
b30: <: size <0>:>
b31: <:<10> temp <0>:>
b32: <:<10> login <0>:>
b33: <:<10> perm <0>:>
b34: <: no resources<0>:>
b35: <:: :>
b36: <: segm/slice<0>:>
b37: <:<10><10>:>
b38: <: first core <0>:>
\f
; fgs 1985.03.13 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 fp start;
al. w1 h19. ;
jl. w3 h79. ; terminate prog zone
al w3 (0) ;
am. (h16.) ;
bz w1 27 ; save area
rs. w1 b17. ; before connect
rl w0 x3 ; start: w0 := item head of program name;
bz 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<1+1 ; comment: connect 1 segm. on disk;
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 b0. ;
al. w0 b28. ;
jl. w3 h31. ; writetext(<:area:>);
rl. w0 b17. ;
jl. w3 h32. ; writeinteger(area);
32<12+1 ;
al. w0 b29. ;
jl. w3 h31. ; writetext(<:buf.>);
am. (h16.) ;
bz w0 26 ;
jl. w3 h32. ; writeinteger(buf);
32<12+1 ;
al. w0 b30. ;
jl. w3 h31. ; writetext(<:size:>);
rl. w3 h16. ;
rl w0 x3+24 ;
ws w0 x3+22 ;
jl. w3 h32. ; writeinteger(size);
32<12+1 ;
al. w0 b38. ;
jl. w3 h31. ; writetext(<:first core:>);
am. (h16.) ;
rl w0 22 ;
jl. w3 h32. ; writeinteger(first core);
32<12+1 ;
jl. w3 d1. ; next param;
am ; comment: skip <end param> action;
\f
; fgs 1982.11.24 claim ...3...
; comment: at this point the register contents are:
; w0 == item head
; w1 == item address
; w2 == irrellevant
; w3 == irrellevant
a2: ds. w1 b9. ; save w0w1
rl. w1 b0. ;
al w2 10 ; separate output
jl. w3 h26. ; between parameters
dl. w1 b9. ; restore w0w1
al w2 13 ; next parameter:
rs. w2 b1. ; keymask := all scopes;
al w2 -1 ;
rs. w2 b2. ; devicename := all devices;
bl w2 0 ; if separator = <end param> then
sh w2 3 ; goto no parameters;
jl. a6. ;
a3: bz w2 1 ; if item kind <> <name> then
se w2 10 ; goto paramerror
jl. a5. ;
rl. w3 b1. ;
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. 6 ; goto move docname;
rs. w3 b1. ; keymask := w3;
jl. a4. ; goto next param;
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;
bz w2 0 ; if separator <> <point> then
se w2 8 ; goto start search;
jl. a8. ;
jl. a3. ; goto moreparam;
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;
\f
; fgs 1982.11.24 claim ...3a...
; register contents:
; w0 == item head
; w1 == item address
; w2 == irrellevant
; w3 == irrellevant
a6: al w3 0 ; no parameters:
b6 = a6 + 1 ; comment: first time = 0: true, <>0: false;
sn w3 0 ; if first time then
jl. a8. ; goto start search;
rl. w1 b0. ; terminate program:
se. w1 h20. ; if outputzone <> current in then
jl. a14. ; goto exit;
bz w3 x1+h1+1 ; terminate output:
se w3 4 ; char := if kind = bs
sn w3 18 ; or mag tape
am 25 ; then em
al w2 0 ; else null;
jl. w3 h34. ; close up (outputzone, char);
jl. w3 h79. ; terminate zone;
al w3 x1+h1+2 ; w3 := outfile document name;
al. w1 b27. ; w1 := tail address;
jd 1<11+42; lookup entry;
rl w0 x3+14 ; tail(0) := segment count of sec. zone;
rs w0 x1 ;
bz w0 x3-1 ; if kind = <bs> then
sn w0 4 ;
jd 1<11+44; change entry;
rl. w3 h8. ; w3 := outfile name;
al w3 x3+2 ;
jd 1<11+42; lookup entry;
al w0 0 ; content := text;
rs w0 x1+16 ;
jd 1<11+44; change entry;
jl. w3 h30.-4 ; unstack zone (current in);
b7 = k+1 ; succes = 0: true, 1: false;
a14: al w2 0 ; exit: w2 := succes;
jl. h7. ; goto fp end program;
a7: al. w0 b20. ; connect trouble: outtext (<:connect :>);
jl. w3 h31.-2 ;
rl. w3 h8. ; outtext(outfile name);
al w0 x3+2 ;
jl. w3 h31.-2 ;
al w2 10 ; outchar (nl);
jl. w3 h26.-2 ;
al w2 1 ; w2 := 1;
jl. a1. ; goto next parameter;
\f
; fgs 1982.11.24 claim ...4...
; w0 == item head
; w1 == item address
a8: ds. w1 b9. ; start search: save(item);
al w1 1 ; w1 := false;
hs. w1 b6. ; first time := false;
rl w1 92 ; w1 := start of nametablelist;
al w1 x1-2 ; w1 := w1-2;
rs. w1 b10. ;
; irrellevant register contents:
a9: rl. w1 b10. ; next device:
al w1 x1+2 ; w1 := w1+2;
rs. w1 b10. ; comment: w1 is a pointer in nametable;
rl w3 x1 ; w3 := addr of chaintable;
sn w3 0 ; if addr of chaintable = 0 then
jl. a13. ; goto end of devices;
dl. w1 b3. ; w0w1 := 1.part of paramname;
sn w0 -1 ; if empty paramname then
jl. a10. ; goto device found;
sn w0 (x3+16-34); device to find:
se w1 (x3+18-34); if paramname = device name then
jl. a9. ; goto device found;
dl. w1 b5. ;
sn w0 (x3+20-34);
se w1 (x3+22-34);
jl. a9. ;
; w3 == record chain table address
a10: dl w1 x3+18-34 ; device found:
sn w0 0 ; if devicename=0 then
jl. a9. ; goto next device;
ds. w1 b12. ;
dl w1 x3+22-34 ;
ds. w1 b14. ; move devicename
rl w0 x3-8 ;
rs. w0 b17. ; move slicelength
rl. w1 b0. ;
al. w0 b37. ;
jl. w3 h31. ; writetext(nl,nl)
al. w0 b11. ;
jl. w3 h31. ; writetext(devicename);
al. w0 b35. ;
jl. w3 h31. ; writetext(<:: :>);
rl. w0 b17. ;
jl. w3 h32. ; writeinteger(slicelength);
32<12+1 ;
al. w0 b36. ;
jl. w3 h31. ; writetext(<:segm/slice:>);
rl. w3 (b10.) ; restore w3
\f
; fgs 1985.03.15 claim ...4a...
rl. w1 b1. ; if keymask = all scopes
se w1 13 ; then
jl. a17. ; begin
al w1 -1 ;
hs. w1 b19. ; key:=-1;
al w1 0 ;
rs. w1 b18. ; sum:=0;
a15: bl. w1 b19. ; loop:
al w1 x1+1 ; key:=key+1;
hs. w1 b19. ;
sl w1 4 ; if key <= maxkey then
jl. a16. ; begin
zl w2 64 ; w2 := monitor release;
sl w2 9 ; w1 := (if mon rel > 8 then
am 1 ; key * 4 else
ls w1 1 ; key * 2 ) +
wa w1 x3-36 ; proc rel of claims +
am. (b8.) ; proc descr addr ;
wa w1 h16 ;
sh w2 8 ; if mon rel > 8 then
jl. a23. ; begin
rl w0 x1 ;
wa. w0 b18. ; w0 := sum + entries;
rl w1 x1+2 ; w1 := slices ;
jl. a24. ; end else
a23: bz w0 x1 ; begin
wa. w0 b18. ; w0 := sum + entries;
zl w1 x1+1 ; w1 := slices ;
a24: wa w1 0 ; end;
rs. w1 b18. ; sum := sum + slices ;
jl. a15. ; goto loop;
; end;
a16: rl. w1 b18. ;
se w1 0 ; if sum=0 then
jl. a17. ; begin
rl. w1 b0.
al. w0 b34. ;
jl. w3 h31. ; write(out,<:no resources:>);
jl. a12. ; goto device done
; end sum=0;
; end all keys;
a17: al w1 -1 ;
hs. w1 b19. ; key := -1;
a11: bl. w1 b19. ; next key out:
al w1 x1+1 ; key := key + 1;
hs. w1 b19. ;
sl w1 4 ; if key > maxkey then
jl. a12. ; goto device done;
\f
; fgs 1985.03.13 claim ...5...
al w1 1 ; compare for selected key:
b19 = k+1 ;key
ls w1 0 ; if keymask (bit: key) = 0 then
la. w1 b1. ;
sn w1 0 ;
jl. a11. ; goto next key out;
zl w2 64 ; w2 := mon release;
zl. w1 b19. ; w1 :=
sl w2 9 ; (if mon rel > 8 then
am 1 ; key * 4 else
ls w1 1 ; key * 2 ) +
wa w1 x3-36 ; proc rel of claim +
am. (b8.) ; proc descr addr ;
wa w1 h16 ;
sh w2 8 ; if mon rel > 8 then
jl. a25. ; begin
rl w0 x1 ; w0 := entries;
rs. w0 b18. ;
rl w1 x1+2 ; w1 := slices ;
jl. a26. ; end else
a25: zl w0 x1 ; begin
rs. w0 b18. ; w0 := entries;
zl w1 x1+1 ; w1 := slices ;
a26: rs. w1 b16. ; end;
wm w1 x3-8 ;
rs. w1 b17. ; segments := slices * slicelength;
al w2 x3 ; save(w3);
rl. w1 b0. ; zone := output zone;
rl. w3 b1. ; if keymask=<:key:>
se w3 -1 ; then
jl. a19. ; begin
al. w0 b26. ; outtext(<: key :>);
jl. w3 h31. ;
bl. w0 b19. ; outinteger(key);
jl. w3 h32. ;
32<12 + 1
jl. a20. ;
a19: bl. w3 b19. ; writetext(case key of
al. w0 b31. ; <:temp:>
sn w3 2 ;
al. w0 b32. ; <:login:>
sn w3 3 ;
al. w0 b33. ; <:perm:>);
jl. w3 h31. ;
a20: rl. w0 b17. ; outinteger (segments);
jl. w3 h32. ;
32<12 + 8 ;
al. w0 b22. ; outtext(<: segm:>);
jl. w3 h31. ;
rl. w0 b16. ;
jl. w3 h32. ; outinteger (out, slices);
32 < 12 + 8 ;
sn w0 1 ;
am b15-b23 ;
al. w0 b23. ;
jl. w3 h31. ; outtext (z, <: slice(s):>;
bl. w3 b19. ;
sl w3 2 ; if temp
jl. a21. ; and
rl. w3 (b10.) ; actual kit <>
se w3 (98) ; mainkit then
jl. a22. ; skip entry output
a21: rl. w0 b18. ; outinteger(entries);
jl. w3 h32. ;
32<12 + 8 ;
al. w0 b21. ; outtext(<: entr:>);
jl. w3 h31. ;
a22: al w3 x2 ; restore(w3);
jl. a11. ; goto next key out;
\f
; rc 19.06.1971 claim ...6...
a12: rl. w1 b2. ; device done:
sn w1 -1 ; if empty paramname then
jl. a9. ; goto next device;
dl. w1 b9. ; restore (item);
jl. a2. ; goto next parameter;
a13: dl. w1 b9. ; end of devices: restore (item);
rl. w2 b2. ;
sn w2 -1 ; if empty paramname then
jl. a2. ; goto next parameter;
al w2 1 ; device not found:
hs. w2 b7. ; succes := false;
al. w0 b24. ; outtext(<:***claim :>);
jl. w3 h31.-2 ;
al. w0 b2. ; outtext(paramname);
jl. w3 h31.-2 ;
al. w0 b25. ; outtext(<: unknown<10>:>);
jl. w3 h31.-2 ;
dl. w1 b9. ; restore(item);
jl. a2. ; goto next parameter;
d1 = k ; entry to procedure nextparam;
d2 = k+2 ; entry to procedure out error param;
\f
; rc 19.06.1971 claim ...7...
; the following pages contain the code for fetching the
; parameters from the fp-command stack.
; at entry the contents of w0, w1 and w2 are irrellevant.
b. a9 , b7
w.
; procedure nextparam;
; if in error-mode, all parameters up to the first <s> delimiter
; are written on current output and skipped.
; the next parameter is fetched, and the registers are set to
; w0 == item head
; w1 == address of item head
; w2 == unchanged
; w3 == unchanged
; if the item is <end param> , return is made to w3 else to w3+2
; (the uses the fp-variable h8 to find the current fp-command)
jl. a0. ; entry nextparam: goto read param;
; procedure out error param;
; the text <:***<prog name> param:> is written on the current output.
; next, the current parameter is written, and the error-mode
; is set (which causes the nextparam-procedure to print all the
; skipped parameters).
; w0 and w1 are destroyed, w2 and w3 are unchanged.
; return is made to w3.
jl. a9. ; entry out error param: goto first error;
a0: rs. w3 b6. ; read param: save (return);
a1: rl. w1 b2. ; w1 := current item pointer;
se w1 0 ; if pointer = 0 then
jl. a3. ;
am -1000
rl. w1 h8.+1000; initialize pointer from fp and
a2: rs. w1 b3. ; initialize program name address;
a3: ba w1 x1+1 ; step pointer forwards;
bl w0 x1 ; w0 := separator;
b0 = k+1 ; errormode: 0==false , <>0 == true
sn w1 x1+0 ; if errormode then
jl. a7. ; begin
se w0 8 ; if separator <> <point> then
jl. a6. ; goto after error;
rs. w1 b2. ; current item pointer := w1;
al. w3 a1. ; set return to read param;
a4: rs. w3 b6. ; next error: save (return from next error);
se w0 8 ;
am 32-46 ; outchar
al w0 46 ; (if separator = point then
hs. w0 b0. ; point else space);
rx w2 0 ; errormode := true;
jl. w3 h26.-2 ;
rx w2 0 ;
\f
; rc 19.06.1971 claim ...8...
rl. w1 b2. ; w1 := current itempointer;
bz w0 x1+1 ; w0 := param length;
se w0 10 ;
jl. a5. ;
al w0 x1+2 ; if param = <name> then
jl. w3 h31.-2 ; outtext(name) and
rl. w3 b6. ;
jl x3 ; return;
a5: rl w0 x1+2 ; w0 := integer;
jl. w3 h32.-2 ; outinteger(integer);
32<12 ;
rl. w3 b6. ;
jl x3 ; return;
a6: ; after error:
al w3 0 ; errormode := false;
hs. w3 b0. ;
rl. w3 b1. ; restore (return);
jl x3 ; return to calling program;
; end errormode;
a7: rs. w1 b2. ; current item pointer := w1;
se w0 8 ; if separator <> point then
rs. w1 b7. ; first item := current item;
sh w0 3 ; if separator = <end param> then
jl. a8. ; goto end param return;
sn w0 6 ; if separator = <equal> then
jl. a2. ; goto initialize from fp; comment progname;
rl w0 x1 ; w0 := item head;
jl x3+2 ; normal return to calling program;
a8: rl w0 x1 ; end param return: w0 := item head;
jl x3 ; return to calling program;
a9: rs. w3 b1. ; first error: save (return);
al. w0 b4. ; outtext(<:***:>);
jl. w3 h31.-2 ;
rl. w3 b3. ; w0 := program name addr;
al w0 x3+2 ;
jl. w3 h31.-2 ; outtext(program name);
al. w0 b5. ;
jl. w3 h31.-2 ; outtext(<: param :>);
rl. w1 b7. ; current item := first item;
rs. w1 b2. ;
bl. w0 (b2.) ; w0 := separator(current item);
rl. w3 b1. ; restore (return);
jl. a4. ; goto next error;
b1: 0 ; saved return to calling program
b2: 0 ; current item pointer
b3: 0 ; address of program name (in command stack)
b4: <:***<0>:>
b5: <: param <0>:>
b6: 0 ; saved return from next error
b7: 0 ; first item
e. ;end of parameter procedures
d0 = k ; length of program
i. e. ; end of claim
m. rc 1985.03.13 claim
g2=k-h55 ; length
g3=4 ; entry
g0:g1: (:g2+511:)>9 ; segm
0,r.4
s2 ; date
0,0 ; file, block
2<12+g3 ; contents, entry
g2 ; length
d.
p.<:insertproc:>
l.
e. ; end of fpnames
\f
▶EOF◀