|
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: 9216 (0x2400)
Types: TextFile
Names: »clean3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »clean3tx «
\f
;rc 25.05.73 fp utility, system 3, clean ...1...
; the program is translated like
; (clean=slang text entry.no
; clean)
b. g1, f6 w. ;for insertproc
d.
p.<:fpnames:>
l.
; the program removes all catalog entries with catalog base with-
; in the specified limits. it is called as follows
;
; clean <s> <lower limit> <s> <upper limit>
;
s. a100,b30,c10,d10 w.
k=h55
a11,0 ; program length,not used
jl. b1. ; goto start;
c1: <:***clean call<10><0>:>
c2: <:***clean param<10><0>:>
c3: <:***clean low>upp<10><0>:>
c4: <:***clean limits off stand base<10><0>:>
c5: <:***clean area procs missing<10><0>:>
c6: <:***clean process too small<10><0>:>
d6: am c6-c5 ; error6;
d5: am c5-c4 ; error5;
d4: am c4-c3 ; error4;
d3: am c3-c2 ; error3;
d2: am c2-c1 ; error2;
d1: al. w0 c1. ; error1;
jl. w3 h31.-2 ; outtext(error text);
al w2 1 ;
jl. h7. ; goto end program;
;procedure next entry
;
;forwards the entry address in w2 to the next entry in the
;buffer. if end buffer is met the return is to link + 2
;else to link.
;
;w0 unchanged
;w1 unchanged
;w2 entry address new entry address
;w3 link unchanged
b21: al w2 x2+34 ; entry.adr:=entry.adr+entry.length;
sh. w2 (a73.) ; if entry <= last.seg
jl x3 ; then return;
al w2 x2+511 ; step segment: skip last word;
rs. w2 a73. ; last on segment :=
al w2 x2-509 ; entry address + 509 ;
sl. w2 (a72.) ; if buf exhausted
jl x3+2 ; then goto link+2
jl x3 ; else goto link;
\f
;rc 25.05.73 fp utility, system 3,clean ...2...
;procedure input catalog segments
;
;inputs the next segments of the catalog to the buffer
;if any segments are left. if some segments are read
;the return is to link - if no segments are read the
;return is to link+2.
;
b. j3 w.
b20: rl. w2 a71. ; if segments left
sh w2 0 ; is <= 0
jl x3+2 ; then goto link+2;
rs. w3 j1. ; save link;
al. w3 a74. ; start transport:
j2: al. w1 a75. ;
jd 1<11+16 ; send message
al. w1 a79. ; check transport:
jd 1<11+18 ; wait answer;
sn w0 2 ; if reserved
jl. j2. ; then repeat;
bz w3 x1 ;
sn w0 1 ; if result <> norm.answ.
se w3 0 ; or any status bit <> 0
jl. j3. ; then goto catalog error;
rl. w2 a71. ;
rl w3 x1+2 ;
ls w3 -9 ; seg.trans := bytes // 512 ;
rl. w0 a78. ; segment no :=
wa w0 6 ; segment no
sl. w0 (a70.) ; + seg.transf
ws. w0 a70. ; modulo length of
rs. w0 a78. ; catalog;
ws w2 6 ; seg.left :=
rs. w2 a71. ; seg.left - seg.trans ;
sh w2 -1 ; if seg.left < 0
wa w3 4 ; seg.trans:=seg.trans+seg.left ;
ls w3 9 ; buf.length:=seg.trans*512 ;
rl. w2 a76. ; entry.adr:=first.buf;
al w0 x2+509 ; last.in.seg:=first.buf+509;
wa w3 4 ; last.in.buf:=first.in.buf
ds. w0 a73. ; + buf.length;
jl. (j1.) ; return;
j1: 0 ; link
;catalog error:
j3: al w2 1 ;
ls w2 (0) ;
lo w2 x1 ; w2:=log.status;
al. w1 a74. ; w1:=addr of <:catalog:> ;
jl. h7. ; goto end program;
e.
\f
;rc 25.05.73 fp utility, system 3, clean ...3...
;working locations:
a1: 4<12+4 ; fp item space,integer
a2: 0 ; limit low
a3: 0 ; limit upp
a4: 0 ; catalog base at entry
a5: 0 ; --
a7: 0 ; name of entry
a8: 0,0 ; --
a9: 0 ; --
a10: 0 ; zero;
;the next are used in catalog scan:
a70: 0 ; catalog length
a71: 0 ; segments left
a72: 0 ; last in buffer
a73: 0 ; last on segment
a74: <:catalog:>,0,0
a75: 3<12 ; message : op = input
a76: 0 ; first
a77: 0 ; last
a78: 0 ; segment
a79: 0,r.8 ; answer
\f
;fgs 1985.03.14 fp utility, system 3, clean ...4...
b1: bl w0 x3 ; start:
sn w0 6 ; if left hand side in call
jl. d1. ; then goto error1;
ba w3 x3+1 ; lower limit: step poinyet;
rl w0 x3 ;
se. w0 (a1.) ; if item <> sp,integer
jl. d2. ; then goto error2;
rl w0 x3+2 ; save lower limit;
rs. w0 a2. ;
ba w3 x3+1 ; upperlimit: step pointer;
rl w0 x3 ; if item <> sp,int
se. w0 (a1.) ; then
jl. d2. ; goto error2;
rl w0 x3+2 ; save upper limit;
rs. w0 a3. ; test limits:
sl. w0 (a2.) ; if upper < lower
jl. b2. ; then goto
jl. d3. ; error3;
b2: am. (h16.) ; save current catalog base;
dl w1 70 ;
ds. w1 a5. ;
am. (h16.) ;
dl w1 78 ;
al w1 x1+1 ;
sh. w0 (a2.) ; if limit.low < stand.low
sh. w1 (a3.) ; or limit.upp > stand.upp
jl. d4. ; then goto error4;
al. w0 a0. ; prepare catalog scan:
al w1 x2-2 ; set first,last of free core;
ds. w1 a77. ;
ws w1 0 ; if buffer < 512 bytes
sh w1 508 ; then goto
jl. d6. ; error6;
al. w3 a74. ; create area process on
jd 1<11+52 ; the catalog;
se w0 0 ; if not created
jl. d5. ; then goto error5;
jd 1<11+4 ; process description(catalog);
am (0) ; save length of catalog;
rl w2 18 ;
rs. w2 a70. ;
rs. w2 a71. ; segments left := length of
al w2 0 ; catalog;
rs. w2 a78. ; segment := 0;
\f
;rc 25.05.73 fp utility, system 3, clean ...5...
b3: jl. w3 b20. ; next segments: input segment;
jl. b4. ; more left: goto test entry;
dl. w1 a5. ; through:
al. w3 a10. ; reestablish cat base;
jd 1<11+72 ;
al w2 0 ;
jl. h7. ; return (ok);
b4: rl w1 x2 ; test entry: if unused place
sn w1 -1 ; in catalog
jl. b5. ; then goto step entry;
dl w1 x2+4 ;
al w1 x1-1 ;
sl. w0 (a2.) ; if low.entry < low.limit
sl. w1 (a3.) ; or up.entry > up.limit
jl. b5. ; then goto step entry;
dl w1 x2+8 ; remove entry:
ds. w1 a8. ; move name to own core;
dl w1 x2+12 ;
ds. w1 a9. ;
dl w1 x2+4 ;
al. w3 a10. ; set catalog base to
jd 1<11+72 ; base of entry;
al. w3 a7. ;
jd 1<11+48 ; remove entry;
b5: jl. w3 b21. ; step entry: next entry;
jl. b4. ; more entries: goto test entry;
jl. b3. ; buf empty: goto next segment;
a0=k ; start buffer for catalog scan
a11=a0-h55 ; length of program
m.rc 1985.03.14 fp utility, system 3, clean
f1=a11 ; length
f2=4 ; entry
g0:g1: (:f1+511:)>9 ; segm
0, r.4
s2 ; date
0,0 ; file, block
2<12+f2 ; contents entry
f1 ; length
d.
p.<:insertproc:>
l.
e.
\f
▶EOF◀