|
|
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: 4608 (0x1200)
Types: Rc489k_TapeFile, TextFile
Names: »tcleartemp «
└─⟦0d4f5e769⟧ Bits:30008171 MIPS/TS RELEASE 7.1
└─⟦this⟧
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦39138f30b⟧
└─⟦this⟧ »tcleartemp «
└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
└─⟦this⟧
! *** tcleartemp ***
;
;
; catalog cleaning program - used when a user process is removed from sos
!
cleartemp
begin
!sections 4;
!fp.no;
procedure next_entry (.w3.;w1);
comment return w1 buf adr of next entry or 0 (after end doc.)
;
procedure remove_entry (.w3.;w1);
comment call w1 buf adr of entry
;
procedure transport (.w3.;w1);
comment return w1 bytes transferred
;
label interrupt, initialize, finis;
record entry ( byte fslice,catkeys;
double catbase;
text(11) name
);
incode
word mee;
word nul:= 0;
word maxtempkey:= 2;
byte m_op:= 3, m_mode:= 0;
ref buffirst, buflast;
word m_segm:= 0;
text(14) catalog:= "catalog";
word lmaxbase, umaxbase, lstdbase, ustdbase, lcatbase, ucatbase;
byte finis_op:= 2, finis_mode:= 1; text(20) finis_t:= "finis";
double pname1, pname2;
begin
mee:= w3;
interrupt:
w3:= address(interrupt);
w0:= 0;
monitor(0); comment set interrupt;
goto initialize;
w1+0; w1+0; w1+0; w1+0;
goto finis;
initialize:
w3:= mee+24;
w2:= (w3).word; comment topcore;
buffirst:= w1;
w0:= w2-w1 lshift -9 lshift 9 + w1 - 2;
buflast:= w0;
w3:= w3+44;
f1:= (w3).double;
lcatbase:= w0; ucatbase:= w1;
w3+4;
f1:= (w3).double;
lmaxbase:= w0; umaxbase:= w1;
w3+4;
f1:= (w3).double;
lstdbase:= w0; ustdbase:= w1;
comment main program;
next_entry(.w3.,w1:=0);
while w1<>0 do
begin
w0:= (w1).catkeys extract 3;
if w0<=maxtempkey then
begin
f3:= (w1).catbase;
if w2>=lstdbase then
if w3<=ustdbase then
remove_entry(.w3.,w1);
end;
next_entry(.w3.,w1);
end;
w3:= address(catalog);
monitor(64); comment remove;
w0:= lcatbase; w1:= ucatbase;
w3:= address(nul); comment myself;
monitor(72); comment set catbase;
finis:
w3:= mee+50;
w3:= (w3).word+2;
pname1:= f1:= (w3).double;
w3+4;
pname2:= f1:= (w3).double;
w1:= address(finis_op); w3:= address(pname1);
monitor(16);
monitor(18);
end;
body of next_entry
begin
incode
word savew0; ref return;
ref lastentry:= 0, nextsegm:= 0, lastsegm:= 0;
comment pointers in catalog buffer,
nextsegm is start of next catalog segment,
lastsegm is end of last segment transferred;
begin
return:= w3; savew0:= w0; w1:= lastentry;
if w1+(34+33)<nextsegm then w1-33
else
begin
if w1>lastsegm then
begin comment start catalog scan or change databuf;
transport(.w3.,w1); comment return: bytes transferred;
if w1<>0 then
begin
w0:= b.buffirst;
w0+w1-1;
lastsegm:= w0;
w1:= b.buffirst;
w0:= w1+512;
nextsegm:= w0;
end;
end
else
begin
w1:= nextsegm;
w0:= w1+512;
nextsegm:= w0;
end;
end;
w0:= savew0; w3:= return; lastentry:= w1;
end;
end;
body of remove_entry
begin
incode
word savew0,savew1; ref return;
word help;
begin
return:= w3;savew1:= w1; savew0:= w0;
w3:= address(b.nul);
f1:= (w1).catbase; ! set catalog base !
monitor (72); ! to that of entry !
w1:= savew1;
w3:= w1 + 6;
monitor(48);
w0:= savew0; w3:= return;
end;
end;
body of transport
begin
label rep;
incode
word status, bytes, chars, w4, w5,w6, w7,w8;
word savew0; double savef3;
begin
savew0:= w0; savef3:= f3;
rep:
w1:= address(b.m_op);
w3:= address(b.catalog);
monitor(16);
w1:= address(status);
monitor(18);
w2:= 1 lshift w0 or status; comment compute status;
if w0=2 then w0:= 5;
if w0=5 then
begin comment create area process;
monitor(52);
if w0=0 then goto rep;
end;
if w1:=bytes<>0 then b.m_segm:= w0:= w1 lshift -9 + b.m_segm;
if w2=2 then
begin
if w1=0 then goto rep; comment stopped;
end
else
begin
if w2<>262146 comment end-doc; then
begin
comment hard error;
key(b.pname1):= w1;
end;
end;
w0:= savew0; f3:= savef3;
end;
end;
end.
▶EOF◀