|
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: 8448 (0x2100)
Types: Rc489k_TapeFile, TextFile
└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
└─⟦this⟧
! *** tprologue ***
;
;
; program for loading directly executable programs
;
; when used at s-replacement the program protects the environment against
; eventual errors occurring in the program to be loaded
;
; PROLOGUE = PROtect,
; LOad and
; Go.
; Undefined on
; Error.
;
; when started the program tests whether it is running in unprotected mode
; (as s-replacement).
; if unprotected the program asks the operator to type the new name of the
; process:
;
; process name =
;
; the process name will be checked and put into the process description.
; the environments (monitor and eventual child processes running in the
; higher addresses in core) will be protected by setting the limit regis-
; ters of the process
;
; in any case the program will ask the operator to type the name of the program
; to be loaded:
;
; program name =
;
; this program will be loaded and activated according to the conventions for
; directly executable programs running under s or boss.
;
; in case the program loaded is not correct the process must be stopped and
; restarted - an error occurring after s-replacement creates an undefined si-
; tuation which must be solved by a new autoload.
;
!
prologue
begin
!fp.no;
label readparam,error,startload,endload;
record name (double name1,name2);
record answer (word status,bytes,chars);
record procdesc(word pkind;
text(11)pname;
byte stopcount,pstate;
word idbit;
ref nextmess,prevmess,nextproc,prevproc,firstcore,topcore;
byte bufclaim,areaclaim,intclaim,funcmask;
word priority;
byte protreg,protkey;
word intrmask;
ref intraddr,escaddr,wrk1,wrk2,wrk3,wrk4,wrk5,parent;
word tquantum;
double runtime,startrun,startwait;
ref wait;
double catbase,maxbase,stdbase;
word v0,v1,v2,v3,rex,ic,cause,sb,cpa,base;
ref lowlimit,highlimit);
record loadinf(byte operation,mode;
ref first,last;
word segment,dum1,dum2,dum3,dum4;
double pname1,pname2;
word nta,okresult;
ref absentry,primin,primout,ownproc,return);
record entrytail(word filesize;
text(11) document;
word clock,file,block;
byte contents,entrypoint;
word loadlength);
incode
ref corefst,coretop,jobproc,primary,loadcodeentry;
ref lastinternal:=80,currproc:=66;
array (1:10) tail of word;
array (1:4) buf of word;
byte inop:=3,inmode:=0;
ref infirst,inlast;
byte outop:=5,outmode:=0;
ref outfirst,outlast;
word loadcodesize;
text(14) maincons:="console1";
text(46) t0 :="process name illegal'10'",
t1 :="entry not found'10'",
t2 :="entry not bs'10'",
t3 :="program not directly executable'10'",
t4 :="entrypoint outside load code'10'",
t5 :="process too small'10'",
t6 :="result = xxx, input error'10'";
text(17) proc:="process name = ",
prog:="program name = ";
begin
goto endload;
startload:
(w1).return:=w2;
monitor(16); comment send message;
monitor(18); comment wait answer;
if w0 <> (w1).okresult then call w0 (w1).return;
monitor(64); comment remove area process;
w0:=(w1).primin;
w2:=(w1).primout;
w3:=(w1).ownproc;
call w0 (w1).absentry;
endload:
w3:=word(currproc);
jobproc:=w3;
w3:=address(maincons);
monitor(4); ! get process description of main console !
primary:=w0;
readparam:
w3:=jobproc;
if w0:=(w3).lowlimit < (w3).firstcore then
begin
outfirst:=w1:=address(proc);
w1+10;
outlast:=w1;
w1:=address(outop);
w3:=address(maincons);
monitor(16); ! send message !
tail(w1:=1);
monitor(18); ! wait answer !
for w0:=1 step 1 upto 4 do (buf(w1:=w0)).word:=w2:=0;
infirst:=buf(w1:=1);
inlast:=buf(w1:=4);
w3:=address(maincons);
w1:=address(inop);
monitor(16); ! send message !
tail(w1:=1);
monitor(18); ! wait answer !
buf(w2:=0)+(w1).bytes;
if w0:=(w2).word extract 8 = 10 then
(w2).word:=w0:=-1 lshift 8 and (w2).word else
if w0:=(w2).word lshift -8 extract 8 = 10 then
(w2).word:=w0:=-1 lshift 16 and (w2).word else
if w0:=(w2).word lshift -16 = 10 then
(w2).word:=w0:=0 else
;
name:=buf(w3:=1);
tail(w1:=1);
monitor(42); ! lookup entry !
if w0 <> 3 then begin w2:=0; goto error; end;
w2:=jobproc+2;
(w2).name1:=f1:=(w3).name1;
(w2).name2:=f1:=(w3).name2;
w3:=jobproc;
w0:=(w3).topcore;
w1:=word(lastinternal)-2;
while w2:=(w1).word <> w3 do
begin
if w3 = (w2).parent then
if w0 > (w2).firstcore then w0:=(w2).firstcore;
w1-2;
end;
(w3).topcore:=w0;
(w3).lowlimit:=w0:=(w3).firstcore;
(w3).highlimit:=w0:=(w3).topcore;
end;
outfirst:=w1:=address(prog);
w1+10;
outlast:=w1;
w1:=address(outop);
w3:=address(maincons);
monitor(16); ! send message !
tail(w1:=1);
monitor(18); ! wait answer !
for w0:=1 step 1 upto 4 do (buf(w1:=w0)).word:=w2:=0;
infirst:=buf(w1:=1);
inlast:=buf(w1:=4);
w1:=address(inop);
monitor(16); ! send message !
tail(w1:=1);
monitor(18); ! wait answer !
buf(w2:=0)+(w1).bytes;
if w0:=(w2).word extract 8 = 10 then
(w2).word:=w0:=-1 lshift 8 and (w2).word else
if w0:=(w2).word lshift -8 extract 8 = 10 then
(w2).word:=w0:=-1 lshift 16 and (w2).word else
if w0:=(w2).word lshift -16 = 10 then
(w2).word:=w0:=0 else
;
name:=buf(w3:=1);
entrytail:=tail(w1:=1);
monitor(42); comment lookup entry;
if w0 <> 0 then
begin w2:=1; goto error; end;
monitor(52); comment create area process;
if w0:=(w1).filesize < 0 then
begin w2:=2; goto error; end;
if w0:=(w1).contents <> 3 then
begin w2:=3; goto error; end;
if w0:=(w1).entrypoint >= (w1).loadlength then
begin w2:=4; goto error; end;
w3:=word(currproc);
corefst:=w1:=(w3).firstcore;
coretop:=w1:=(w3).topcore;
w1-!length(loadinf);
loadinf:=w1;
w2:=address(endload)-(w3:=address(startload));
loadcodesize:=w2;
if w0:=corefst+entrytail.loadlength+loadcodesize >= loadinf then
begin w2:=5; goto error; end;
loadinf.absentry:=w0:=corefst+entrytail.entrypoint;
loadinf.first:=w0:=corefst;
w0+entrytail.loadlength-2;
loadinf.last:=w0;
loadinf.segment:=w0:=0;
loadinf.mode:=w0;
loadinf.operation:=w0:=3;
loadinf.primin:=w0:=primary;
loadinf.primout:=w0;
loadinf.ownproc:=w0:=jobproc;
loadinf.pname1:=f1:=name.name1;
loadinf.pname2:=f1:=name.name2;
loadinf.okresult:=w0:=1;
w2:=address(startload);
w3:=loadinf-loadcodesize;
loadcodeentry:=w3;
while w3 < loadinf do
begin
(w3).word:=w0:=(w2).word;
w2+2;
w3+2;
end;
w1:=loadinf;
w3:=address((w1).pname1);
call w2 loadcodeentry;
w2:=address(t6)+6;
(w2).word:=w0+48;
w2:=6;
error:
outfirst:=w1:=address(t0)+(w2 lshift 5);
w1+30;
outlast:=w1;
w1:=address(outop);
w3:=address(maincons);
monitor(16); ! send message !
tail(w1:=1);
monitor(18); ! wait answer !
goto readparam;
end;
end.
▶EOF◀