|
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 - download
Length: 4608 (0x1200) Types: Rc489k_TapeFile, TextFile
└─⟦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◀