|
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: 143616 (0x23100)
Types: Rc489k_TapeFile, TextFile
└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
└─⟦this⟧
! *** tsos ***
;
;
; swopping online system for execution of a number of interactive processes
; in the same piece of core
;
; release 3.0 mar. 1982 knud christensen, edith rosenberg, flemming biggas
; release 3.1 aug. 1982 flemming biggas
; release 3.2 apr. 1983 flemming biggas
; release 3.3 aug. 1984 flemming biggas
; release 4.0 aug. 1985 flemming biggas (mp release).
; release 5.0 sep. 1986 flemming biggas
; release 6.0 may. 1987 flemming biggas (tas version)
; release 6.1 jul. 1988 flemming biggas (error correction)
; 1 - linie 840 - input message - forkert bufsize
; 2 - linie 844 - input message - mode og trail
; release 7.0 oct. 1988 flemming biggas (RC9000-10)
; release 7.1 jul. 1989 flemming biggas (error correction)
; release 7.2 nov. 1989 flemming biggas (error correction)
; 1 line 1422 - tem message - forkert operations check
; 2 line 1472 - tem message - manglende check messgot
; release 7.3 jan. 1990 flemming biggas (error correction)
; 1 line 1630 - reject control message when waiting for first input message
!
onlinesystem
begin
!fp.no;
!branch 1,2;
!sections 40;
procedure prepare(.w3.);
comment prepare process to be activated;
procedure waitevent(.w3.;w0;w1;w2);
comment call: w0 irrelevant
w1 irrelevant
w2 irrelevant
return: w0 event kind
w1 abs ref userentry
w2 abs ref eventbuffer
;
procedure unintelligible(.w3.;w1);
comment call: w1 abs ref userentry
return: all registers unchanged
;
procedure send_primo(.w3.;w1;w2);
comment call: w1 abs ref userentry
w2 abs ref message sent to pseudo process primo
return: w1 abs ref userentry
w2 abs ref message sent to primo (real process)
w3 old w2 (from call)
;
procedure primess(.w3.);
procedure send(.w3.;w0;w1;w2);
comment call: w0 kind of event to be send
w1 abs ref userentry
w2 first word of message or answer
return: -- all registers unchanged
;
procedure action (.w3.;w0;w1;w2);
comment call: w1 abs ref userentry
w2 abs ref event
return: -- all registers unchanged
;
procedure send_control (.w3.;w1;w2);
comment call: w1 abs ref userentry
w2 abs ref control message
return: -- all registers unchanged
;
procedure link(.w3.;w1;w2);
comment call: w1 abs ref userentry to be linked
w2 abs ref userentry after which to link w1
return: w1 unchanged
w2 unchanged
;
procedure swop(.w3.;w1);
comment call: w1 abs ref userentry of process to be swopped in
return: w1 unchanged
;
procedure copy(.w3.;w0;w1;w2);
comment call: w0 no of bytes to copy
w1 abs from
w2 abs to
return: -- all registers unchanged
;
procedure startstop(.w3.;w0;w1);
comment call: w0 boolean stop or start process
w1 abs ref userentry of process to start-stop
return: -- all registers unchanged
;
procedure transport(.w2.;w1;w3);
comment call: w1 abs ref message to be send
w3 abs ref area name
return: -- all registers unchanged
;
procedure continuemcl (.w3.;w0;w1);
comment call: w0 exit cause
w1 abs ref of userentry
return: -- all registers unchanged
;
procedure empty_answer (.w3.;w0;w1;w2);
comment call: link w3
result w0
user entry w1
status word w2;
procedure parentmess(.w3.;w1;w2);
comment call: w1 abs ref userentry of sending process
w2 abs ref message buffer
return: -- all registers unchanged
;
procedure syscommand(.w3.;w1);
comment call: w1 abs ref userentry of commanding user
return: -- all registers unchanged
;
procedure scancat(.w3.;w0;w1;w2);
comment call: w1 abs ref process name
w2 abs ref terminal name or zero
return: w0 result -3 = usercat reservation error
-2 = terminal unknown
-1 = process unknown
>=0 = ok (catalog segm.no)
w1 abs ref process description
w2 abs ref terminal description or zero
;
procedure break(.w3.;w1);
comment call: w1 abs ref userentry to break
return: -- all registers unchanged
;
procedure clean(.w3.;w1);
comment call: w1 abs ref userentry
return: -- all registers unchanged
;
procedure compare(.w3.;w0;w1;w2);
comment call: w0 no of bytes to compare
w1 abs 1.string
w2 abs 2.string
return: w0 = 0 the bytes are equal
;
procedure nextchar(.w3.;word stp;w0;w1;w2);
comment call: w0 irrelevant
w1 partial word
w2 abs ref next input word
w3 return
stp abs ref word next to last input word
return: w0 next character
w1 partial word
w2 abs ref next input word
;
procedure init(.w3.);
comment call: -- all registers irrelevant
return: -- all registers destroyed
;
procedure opmess(.w3.;w1;w2);
comment call: w1 abs ref message,
w2 abs ref sender process description
;
procedure logout(.w3.;w1);
comment call: w1 abs ref userentry
return: -- jumps directly to main program
;
procedure outtext(.w3.;w0;w1;w2);
comment call: w0 format pattern:
bits 21-23: type of message
0 = normal
1 = error
2 = warning
3 = pending
4 = normal
bit 20: time (yes or no)
bit 19: system name (yes or no)
bit 18: job name (yes or no)
w1 abs ref userentry
w2 text number
return: -- all registers unchanged
;
procedure outtime(.w3.;w2);
comment call: w2 abs ref buffer
return: -- all registers unchanged
;
procedure calldev(.w3.;w1);
comment call: w1 abs ref string1
return: w1 abs ref error message or zero
;
procedure testout(.w3.;w0;w1;w2);
comment call: w0 length of testrecord
w1 abs ref first word of record
w2 kind of testrecord
return: w0 destroyed
w1 unchanged
w2 unchanged
;
label continue, interrupt, initialize, action_l, activate, regrettimer, discfault;
record name (double name1,name2);
record answer (word status,bytes,characters);
record message (ref nextmess,lastmess,receiver,sender;
byte operation,mode;
ref mbfst,mblst;
word segmno;
ref mbilast);
record userentry (ref nextuser,prevuser,buffer,
messgot,messsend,procbuf1,peripheral,internal,primdevi;
word swopsegm,class,prio;
byte state,state2,buflength,bufchars,intervent,primio,bufrel;
word statusinf,currlocid,procsize;
text(14) pr_in,pr_out);
record termdescr
(text(11) extid;
word intid;
text(11) userkey;
byte tbufs,ttimers;
array(1:6) tfill of byte);
record procdescr
(byte procbuffers,procareas;
word procsb1,procsb2,
procub1,procub2,
procmb1,procmb2;
text(11) ppass;
word pminsize,pmaxsize;
array(1:10) pfill of byte;
text(59) procfp;
array(1:12) procdiscs of record procdisc
(text(11) procdiscname;
array(1:8) procdiscclaim of word
)
);
record prindex (text(11) prname;
word prsegmno);
incode
ref activqfst,activqlst,
batchqfst,batchqlst,
waitqfst,waitqlst,
coreuser:=0,timermess:=0,
firstuser,lastuser;
word maxbuf,minprio,maxtestsegm,syscond,passmode,batchclass:=-8000000;
word register0,register1,register2,register3,exception:=0,ic;
word ownproc, sosterm;
word basereg;
text(14) procname,timer:="clock";
text(2) att:="
>"; word timeunit:=0,interval;
word micunit:=2;
double micinterval:=600;
byte testop:=5,testmode:=0;
ref testbfst,testblst,testsegm:=0;
ref fstcore,topcore;
ref baseevent:=0,mainconsref,mictimer,psmess;
double starttime,startbase;
byte relintrpt,reldump,idsize,sysstate:=0;
byte childpr,childpk,timerloss,cyclegain,inputgain,freebufs;
text(11) operator:= "'255'";
text (14) tstarea,swname,fpcode,cleartemp,usercat,t_mdul,p_mdul,p_pseudo,t_pseudo;
byte fp_rel,cleart_rel;
byte faultop:=2,faultmode:=1;
text(20) faulttext:="***fault";
begin
\f
comment the following piece of code is after initialization used as
buffer for wait answer, and as interrupt routine
in case of internal interrupt or !test
;
ownproc:= w3; ! save own process description address !
interrupt:
w3:=address(interrupt)+2;
w0:=0;
monitor(0); comment set interrupt address;
mainconsref:=w2;
goto initialize;
w1+0;
w1+0;
w1+0;
testout(.w3.,w0:=16,w1:=address(interrupt)+2,w2:=7);
!get 2;
if w0 <> 1 then goto discfault;
opmess(.w3.,w1:=address(faultop),w2:=ownproc);
initialize:
!get 2;
if w0 <> 1 then goto discfault;
init(.w3.);
\f
comment the central logic of the onlineadministrator is this:
a) wait for an event from a terminal, from an internal process
or from the timer
b) take some action corresponding to the kind of the event arrived
- this action may include stopping the running process
c) if the running process is stopped then select new process for
activation (if anyone is ready) and swop
d) take some action corresponding to the state of the process
that is selected for activation (copy input from buffer into
the process etc)
e) start the process, send a message to timer and goto a.
;
continue:
waitevent(.w3.,w0,w1,w2);
action_l:
userentry:=w1;
message:=w2;
action (.w3.,w0,w1,w2);
regrettimer:
if w2:=timermess<>0 then
begin
monitor(82); comment regret message;
w2:=0;
timermess:=w2;
end;
\f
comment selection of the next process to be activated
the system deals with two different queues:
1) the active-queue processes ready for running (input has arrived etc)
2) the waiting-queue processes suspended or not used at all
at activation the first user in the activequeue (if any) is tested for
his priority - is it zero then the process is selected for activation
- otherwize the priority is increased, and the user is removed from the
activequeue and then put back on the queue again
;
activate:
userentry:=w1:=activqfst;
if w0:=address(activqfst) <> w1 then ! activequeue not empty !
begin
if w0:=(w1).state = 0 then
if w0:=(w1).class+timerloss < batchclass then ! job is batch !
begin
link(.w3.,w1,w2:=address(batchqfst));
goto activate;
end;
end else
begin ! activequeue empty !
userentry:=w1:=batchqfst;
if w0:=address(batchqfst) = w1 then goto continue; ! batchqueue also empty !
end;
if w0:=(w1).state<0 then
begin ! systemcommand !
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto discfault;
syscommand(.w3.,w1:=userentry);
end else
if w0:=(w1).prio<0 then
begin
if w0+cyclegain > 0 then w0:=0;
(w1).prio:=w0;
link(.w3.,w1,w2:=address(activqfst));
end else
begin
if w0:= (w1).class > b.batchclass then
(w1).prio:= w0:= (w1).class;
prepare(.w3.);
w1:= address(timeunit);
w3:= address(timer);
monitor(16);
timermess:= w2;
startstop(.w3.,w0:=1,w1:=coreuser);
goto continue;
end;
goto activate;
\f
comment in case of a disc fault disturbing the overlay transports, this piece
of code will be activated -
the octal status, result of the transport and the name of the program area
will be written on the main console and the "sos process" will die;
discfault:
register0:=w0;
register3:=w3;
w1:=firstuser;
(w1).peripheral:=w2:=mainconsref;
(w1).buflength:=w2:=44;
(w1).buffer:=w2:=address(faulttext);
(w2+14).word:=w0:=2111527; ! " 8'" !
for w1:=-21 step 3 upto 0 do
begin
w2+2;
(w2).word:=w0:=register0 lshift (w1) extract 3 + 48;
end;
(w2+2).word:=w0:=32;
copy(.w3.,w0:=8,w1:=register3,w2+2);
(w2+8).word:=w0:=10;
send(.w3.,w0:=0,w1:=firstuser,w2:=20480);
w3:=0;
monitor(0); ! set interrupt !
!halt 1; ! provoke running after error !
end;
\f
body of action
begin
label actioncase, emptyanswer, repeatmaybe, a_ready, stopcoreuser,
timeout, semibusy, messwait;
incode double savef1, savef3;
ref mess, user;
word mss0,mss2,mss4,mss6,mss8,mss10,mss12,mss14,help;
begin
comment actions corresponding to the kind of the event arrived:
1) input message from internal process -
the process is stopped and the input message is sent to the terminal
if it is ready, otherwize the input message is linked to the user-
description, waiting to be sent, when the terminal becomes ready
if the priority class is negative then it is increased
2) output message from internal process -
if the terminal is ready (there is room in the terminal buffer),
the output is copied from the process into the buffer, an answer
is sent to the process, and an output message is sent to the ter-
minal
if the terminal is not ready, the internal process is stopped and
it is given an answer, telling that no bytes are transferred, then
at restart, the process will repeat the outputmessage
3) parent message from internal process -
finis: the process is removed, and the userdescription cleared
break: the process is stopped, and prepared for loading with new abs program
*** any other parent message is rejected for the moment
4) attention from known terminal -
treated as an interrupt. the process is stopped and an inputmessage
is send to the terminal asking for a system command
5) answer from known terminal -
input answer: the process is prepared for restart
output answer: if the process is waiting then it is prepared for
restart otherwize nothing is to be done
6) attention from unknown terminal -
the terminal is linked to a free userdescription and an input is send
to the terminal asking for the users identification
7) answer from timer -
the process running in core has used its time-slice and therefore
it is stopped to make room for other users
the priority class of this process is decreased
8) message from a bastard
at s-replacement sos may take over some unknown children (bastards)
parent messages from these children are written on the main console
9) message to a pseudo process called tem
10) message to be send later
11) message to a pseudo process called primo
12) message to be send to primo later
13) control message to terminal
;
\f
savef1:= f1;
savef3:= f3;
user:= w1;
mess:= w2;
actioncase:
case w3:=w0 of
begin
! action 1 !
begin comment input message from internal process;
if w3:=b.syscond onemask 2'010 then
if w3:=(w1).intervent = -1 then goto timeout;
if w3:=(w1).state<0 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end else
if w3>0 then
begin
(w1).state:=w0:=5;
end else
begin
(w1).procbuf1:= w0:= (w2).mbfst;
(w1).state:= w0:= 1;
if w0:=(w1).state2=-1 then
begin ! fp command ready !
if w1=b.coreuser then
begin
if w2:=b.timermess<>0 then
begin
monitor(82); ! regret !
w2:= 0;
b.timermess:= w2;
end;
end;
(w1).state2:= w0:= 0;
if w0:= (w1).intervent=0 then goto repeatmaybe else
(w1).intervent:= w0:= 0; ! no fp command in buffer at restart after break !
end;
w0:= (w2).mbfst;
w3:= (w2).mblst;
w3-w0+2;
if w3>b.maxbuf then w3:= b.maxbuf;
(w1).buflength:= w3;
w2:= address ((w2).operation);
send (.w3.,w0:=0,w1,w2:=(w2).word);
end;
link(.w3.,w1,w2:=address(b.waitqfst));
startstop(.w3.,w0:=0,w1);
end;
\f
! action 2 !
begin comment output message from internal process;
if w0:=(w1).state<0 then
begin
empty_answer(.w3.,w0:=1,w1,w2);
goto b.continue;
end else
if w0=0 then
begin
if w1 = b.coreuser then
begin
w3:=(w1).internal+11;
w3:=(w3).byte;
if w3 and 2'10100000=2'10100000 then ! stopped !
begin
(w1).state:=w0:=6;
startstop(.w3.,w0:=1,w1);
end;
b.idsize:=w0:=(w1).primio;
w0:=(w2).mblst-(w2).mbfst+2;
if w0>=b.maxbuf then w0:=b.maxbuf-b.idsize;
(w1).buflength:=w0+b.idsize;
w3:=w0-b.idsize-2;
w1:=(w1).buffer+b.idsize;
w3+w1;
monitor(70); ! copy !
if w0<>0 then ! unintelligible !
unintelligible(.w3.,w1:=user)
else
begin
w0:=w1;
w1:=user;
w2:=(w1).buffer;
if w3:=b.idsize > 0 then
(w2).word:=w3:=(w1).currlocid;
(w1).buflength := w0 := (w1).buflength - b.idsize;
(w1).bufchars := w0 + (w3:=w0 ashift -1);
testout (.w3.,w0:= (w1).buflength, w1:=w2, w2:=0);
send (.w3.,w0:=0,w1:=user,w2:=20480+mess.mode);
send (.w3.,w0:=1,w1,w2:=0);
if w0:=6=(w3:=(w1).state) then startstop(.w3.,w0:=0,w1);
(w1).state:=w0:=2;
end; ! message ok !
if w0:=6=(w3:=(w1).state) then ! stop it again !
begin
(w1).state:=w0:=0;
startstop(.w3.,w0:=0,w1)
end
end else
begin
emptyanswer:
(w1).state:=w0:=0;
empty_answer(.w3.,w0:=1,w1,w2:=0);
goto a_ready;
end;
if w0:=b.timermess <> 0 then goto b.continue;
end else goto emptyanswer;
end;
\f
! action 3 !
begin comment parent message from internal process;
if w0:=(w1).state<0 then
begin
send(.w3.,w0:=2,w1,w2:=0);
goto b.continue;
end;
if w1:=b.coreuser > 0 then startstop(.w3.,w0:=0,w1);
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto b.discfault;
parentmess(.w3.,w1:=user,w2:=mess);
end;
! action 4 !
begin comment attention from known terminal;
send(.w3.,w0:=1,w1,w2:=0);
if w0:=(w1).state2>0 then goto b.continue;
if w0:=(w1).state < 0 then goto b.continue;
(w1).state:=w0:=-1;
startstop(.w3.,w0:=0,w1);
link(.w3.,w1,w2:=address(b.waitqfst));
w2:=(w1).buffer;
(w1).buflength:=w0:=2;
copy(.w3.,w0,w1:=address(b.att),w2);
testout(.w3.,w0,w1,w2:=0);
send(.w3.,w0:=0,w1:=user,w2:=20480);
(w1).buflength:=w0:=b.maxbuf;
send(.w3.,w0:=0,w1,w2:=12288);
if w1 = b.coreuser then goto b.regrettimer else goto b.continue;
end;
\f
! action 5 !
begin comment answer from known terminal;
w2:=address(b.interrupt);
case w3:=(w1).state+4 of
begin
! -3 ! begin comment invisible password;
w3:= (w1).messsend; ! result !
if w3 or (w2).status or (w2).bytes = 1 then
begin ! repeat invisible input, if normal answer and
bytes transferred = 0 !
(w1).buflength:= w0:= b.maxbuf - (w1).bufrel;
w0:= (w1).bufrel;
-(w0);
send (.w3., w0, w1, w2:=12288+b.passmode);
goto b.continue;
end;
end;
! -2 ! begin comment login information;
goto repeatmaybe;
end;
! -1 ! begin comment system command;
goto repeatmaybe;
end;
! 0 ! begin comment communication via pseudo process;
w0:=(w1).messsend;
w2:=(w1).messgot;
if w2 > 10 then
if w3:=(w2).operation extract 2 <> 3 then
begin
(w1).messgot:=w0;
w1:=address(b.interrupt);
monitor(22); ! send answer !
testout(.w3.,w0:=16,w1,w2:=61);
end;
end;
! 1 ! begin comment waiting for input answer;
(w1).currlocid:= w0:= (w3:=(w1).buffer).word;
repeatmaybe:
w3:=(w1).messsend; comment w3 := result;
if w3 or (w2).status or (w2).bytes = 1 then
begin comment repeat input if normal answer, bytes trans-
ferred = 0;
(w1).buflength:=w0:=b.maxbuf;
send(.w3.,w0:=0,w1,w2:=12288);
goto b.continue;
end;
end;
! 2 ! begin comment waiting for output answer;
(w1).state:=w0:=0;
goto b.continue;
end;
! 3 ! begin comment waiting for load with new abs program - state not possible here;
end;
! 4 ! begin comment suspended because of output buffer full;
(w1).state:=w0:=0;
end;
! 5 ! begin comment message waiting to be send;
link(.w3.,w1,w2:=address(b.activqfst));
mess:=w2:=(w1).messgot;
(w1).state:=w0:=0;
if w3:=(w2).receiver+b.ownproc = 0 then w0:=3 else
if w3:=(w2).receiver+b.sosterm = 0 then
begin
if w3:=(w2).operation onemask 3 then w0:=1 else
if w3 onemask 5 then w0:=2 else w0:= 13;
end else w0:= 9;
goto actioncase;
end;
! 6 ! begin ! waiting answer from primo !
end;
! 7 ! begin ! message waiting to be send to primo !
link(.w3.,w1,w2:=address(b.activqfst));
mess:=w2:=(w1).messgot;
(w1).state:=w0:=0;
w0:=11;
goto actioncase;
end;
! 8 ! begin ! waiting for control answer !
(w1).state:= w0:= 0;
w0:= (w1).messsend; ! w0:= result !
w2:= (w1).messgot;
if w2 > 10 then
begin
(w1).messgot:= w0;
w1:= address(b.interrupt);
monitor (22); ! send answer !
testout (.w3., w0:= 16, w1, w2:= 61);
end;
end;
end;
link(.w3.,w1:=user,w2:=address(b.activqfst));
a_ready:
if w0:=b.timermess<>0 then
begin
w1:= b.coreuser;
if w0:= (w1).class + b.timerloss < b.minprio
then goto stopcoreuser
else goto b.continue;
end;
end;
\f
! action 6 !
begin comment attention from unknown terminal;
send(.w3.,w0:=1,w1,w2:=0);
(w1).state:=w0:=-2;
(w1).buflength:=w0:=2;
w2:=(w1).buffer;
copy(.w3.,w0,w1:=address(b.att),w2);
testout(.w3.,w0,w1,w2:=0);
send(.w3.,w0:=0,w1:=user,w2:=20480);
(w1).buflength:=w0:=b.maxbuf;
send(.w3.,w0:=0,w1,w2:=12288);
goto b.continue;
end;
! action 7 !
begin comment answer from timer;
stopcoreuser:
user:=w1:=b.coreuser;
startstop(.w3.,w0:=0,w1);
if w0:=(w1).class+b.timerloss < b.batchclass then (w1).prio:=w0:=0 ! batch !
else
begin ! go/run-jobs !
link(.w3.,w1,w2:=address(b.activqfst));
(w1).class:=w0:=(w1).class-b.timerloss;
(w1).prio:=w0;
if w3:=b.syscond onemask 2'001 then
if w0 < b.minprio then
begin comment break process;
timeout:
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto b.discfault;
break(.w3.,w1:=user);
(w1).intervent:=w0:=5;
end;
end;
end;
! action 8 !
begin comment parent message from a bastard;
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto b.discfault;
opmess(.w3.,w1:=address((w2).operation),w2:=(w2).sender);
end;
\f
! action 9 !
begin comment message to a pseudo process;
if w1:=(w2).receiver < 0 then -(w1);
copy(.w3.,w0:=8,w1+2,w2:=address(b.procname));
copy(.w3.,w0:=16,w1:=mess+8,w2:=b.lastuser);
w2:=mess;
if w0:=(w2).operation onemask 1 then
begin ! io - use sos buffer !
w1:=user;
if w1 <> b.coreuser then goto emptyanswer;
w3:=b.lastuser-8;
(w3).mode:=w0:=(w2).mode extract 6;
(w3).mbfst:=w0:=(w1).buffer;
w0:=(w2).mblst-(w2).mbfst+2;
if w0 > b.maxbuf then w0:=b.maxbuf;
(w1).buflength:=w0;
user.bufchars:= w0 + (w1:=w0 ashift -1);
w1:= user;
w0 := (w1).buflength;
(w3).mblst:=w0+(w3).mbfst-2;
(w1).procbuf1:=w0:=(w2).mbfst;
(w3).segmno:= w0:= (w2).segmno;
if w0:=(w2).operation zeromask 2 then
begin ! some kind of output assumed !
if w0:=(w2).mode onemask 8'100 then
begin
(w3).mblst:=w2:=(w3).mblst+2;
(w2:=(w1).buffer).word:=w3:=(w1).currlocid;
w2+2;
end else w2:=(w1).buffer;
copy(.w3.,w0:=(w1).buflength,w1:=(w1).procbuf1,w2);
testout(.w3.,w0,w1,w2:=0);
send(.w3.,w0:=1,w1:=user,w2:=0);
end;
end;
begin ! message to tem !
copy(.w3.,w0:=6,w1:=user.internal+2,w2:=address(b.procname)+2);
w3:=address(b.procname);
b.mictimer:=w3;
if w0:=mess.operation >= 90 then
if w0 < 100 then
begin ! message concerning a pool !
w0:=0;
b.mictimer:=w0;
b.baseevent:=w0;
copy(.w3.,w0:=8,w1:=address(b.procname),w2:=b.lastuser+8);
w3:=address(b.t_mdul);
end;
end;
w1:=b.lastuser;
monitor(16); ! send message !
user.messsend:=w2;
b.psmess:=w2;
if w0:=b.mictimer > 0 then
begin
w3:=address(b.timer);
w1:=address(b.micunit);
monitor(16); ! send timer message !
b.mictimer:=w2;
end;
w2:=b.baseevent;
semibusy:
monitor(24); ! wait next event !
if w2 = b.psmess then
begin
w1:=b.lastuser;
monitor(18); ! wait answer !
w3:=user;
(w3).messsend:=w0;
(w3).statusinf:=w0:=(w1).word;
if w2:=(w3).messgot > 10 then
begin
if w0:=(w2).operation extract 2 = 3 then
begin
copy(.w3.,w0:=(w1).bytes,w1:=user.buffer,w2:=user.procbuf1);
testout (.w3.,w0,w1,w2:=0);
w3 := user;
(w3).currlocid := w0 := (w1).word;
w2 := (w3).messgot;
w1 := b.lastuser;
end;
end;
w0 := (w3).messsend;
if w2 > 10 then
begin
if w3:=(w3).statusinf or w0 or 8'10200001 <> 8'10200001 then
if w3:=(w2).operation onemask 1 then
begin
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto b.discfault;
logout(.w3.,w1:=user);
end;
user.messgot:=w0;
monitor(22); ! send answer !
testout(.w3.,w0:=16,w1,w2:=61);
end;
if w2:=b.mictimer > 0 then monitor(82); ! regret timer message !
if w0:=b.timermess <> 0 then goto b.continue;
end else
if w2 = b.mictimer then
begin
startstop(.w3.,w0:=0,w1:=user);
link(.w3.,w1,w2:=address(b.waitqfst));
end else goto semibusy;
end;
\f
! action 10 !
begin comment wait for previous message to be answered;
w2:=5;
messwait:
if w0:=(w1).state < 0 then
begin
(w1).buflength:=w0:=0;
send(.w3.,w0:=1,w1,w2:=8'200000);
end else
begin
startstop(.w3.,w0:=0,w1);
(w1).state:=w2;
link(.w3.,w1,w2:=address(b.waitqfst));
end;
if w1 <> b.coreuser then goto b.continue;
end;
! action 11 !
primess(.w3.); ! messsage to primo !
! action 12 !
begin ! message to be send later to primo !
w2:=7; goto messwait;
end;
! action 13 !
begin ! control message to terminal !
if w0:= (w1).state < 0 then
begin
empty_answer (.w3., w0:= 1, w1,w2:=0);
goto b.continue;
end else
if w0 = 0 then
begin
if w0 := (w1).state2 = -1 then
begin comment state waiting for first input, reject message;
w2 := (w1).messgot;
w0:= 2;(w1).messgot := w0;
w1 := address(mss0);
monitor (22); ! send answer !
testout (.w3.,w0:=2, w1:= address((w1:=user).messgot), w2:= 61);
goto b.continue;
end;
send_control (.w3.,w1, w2);
(w1).state:= w0:= 8; ! waiting for control answer !
goto b.continue;
end else
begin
(w1).state:= w0:= 5;
end;
end;
end;
f1:= savef1;
f3:= savef3;
end;
end; ! action !
\f
comment preparation of process waiting to be activated
first of all the process image in core is possibly written back into the
swoparea and the image of the new process is loaded
then one of the following actions are taken corresponding to the state of
the selected process
0) the process is ready for running -
no actions
1) input has arrived from the terminal -
the input is copied from the terminal buffer into the process and
an answer is sent to the process
2) terminal has become ready after output (term buffer has been full)
no actions
3) the process is to be started with new abs program
the process description is modified according to the conventions for
start of an abs program
;
body of prepare
begin
label inputready;
incode
word return;
word c_funct:=2'01101;
ref c_first,
c_last;
word c_rel:=0;
begin
return:=w3;
swop(.w3.,w1);
case w3:=(w1).state+1 of
begin
begin comment 0: no io or communication via pseudo process;
if w3:=(w1).messgot > 10 then goto inputready;
end;
begin comment 1: input ready;
inputready:
w0:=(w1).messsend;
w3:=(w1).messgot;
if w3:=(w3).operation onemask 1 then
if w0 or (w1).statusinf or 8'10200001 <> 8'10200001 then
begin
swop(.w3.,w1:=0);
!get 2;
if w0 <> 1 then goto b.discfault;
logout(.w3.,w1:=b.userentry);
end;
if w0:=(w1).procbuf1<w3:=b.fstcore then unintelligible(.w3.,w1)
else if w0+(w1).buflength>(w3+(w1).procsize) then unintelligible(.w3.,w1)
else
begin
w2:=b.coreuser;
copy(.w3.,w0:=(w1).buflength,w1:=(w1).buffer,w2:=(w2).procbuf1);
testout(.w3.,w0,w1,w2:=0);
(w3:=b.userentry).currlocid:=w0:=(w1).word;
w1:= b.userentry;
send(.w3.,w0:=(w1).messsend,w1,w2:=(w1).statusinf);
end;
(w1).state:=w0:=0;
if w0:=(w1).class+b.timerloss > b.batchclass then
begin
if w0:=(w1).class+b.inputgain > 0 then w0:=0;
(w1).class:=w0;
(w1).prio:=w0;
end;
end;
begin comment 2: waiting for output answer;
end;
begin comment 3: waiting for loading with new abs program;
w3:=address(b.procname);
w0:=address((w1).pr_out);
w0+b.basereg;
b.register2:=w0;
w0:=address((w1).pr_in);
b.register0:=w0+b.basereg;
w2:=(w1).internal;
b.register3:=w2;
if w0:=(w1).state2<1
then w0:=b.fstcore+b.fp_rel
else
begin
(w1).class:=w0:=0;
w0:=b.fstcore+b.cleart_rel;
end;
b.ic:= w0;
w2+2;
(w3).name1:=f1:=(w2).name1;
(w3).name2:=f1:=(w2).name2;
w1:=address(b.register0);
monitor(62); comment modify internal process;
w1:=b.coreuser;
(w1).state:=w0:=0;
(w1).prio:=w0;
end;
begin ! 4: suspended because of output buffer full !
end;
begin ! 5: message waiting to be send !
end;
begin ! 6: waiting for answer from primo !
startstop(.w3.,w0:=1,w1);
c_first:=w0:=(w1).buffer;
w3:=(w1).buflength-2+w0;
c_last:=w3;
w2:=(w1).messgot;
w1:=address(c_funct);
if w3>=w0 then
monitor(84) ! general copy !
else
w0:=0;
w1:=b.userentry;
if w0<>0 then (w1).messsend:=w0;
send(.w3.,w0:=(w1).messsend,w1,w2:=(w1).statusinf);
startstop(.w3.,w0:=0,w1);
(w1).state:=w0:=0;
end;
begin ! 7: message waiting to be send to primo !
end;
begin ! 8: waiting for terminal control answer !
end;
end;
w3:=return
end
end; ! prepare !
\f
comment waitevent
this procedure awaits the first event queued up to the onlineadministrator
according to the kind of this event it proceeds as follows:
answer: an answer is expected to come from the timer or from a terminal
logged in, so the userentries are scanned to find the one matching this
message buffer (the buffer addresses of messages sent to terminals are
saved in the userentries), if no entry is found, and it is not an answer
from the timer, then the answer is neglected and the procedure awaits the
next event.
message: a message is expected to be an i-o message or a parent message
from an internal process or an attention message from a terminal. the
userentries are scanned to find the sender of the message. if no entry
does match the sender (neither internal nor peripheral process belonging
to any user) then the message may be:
1) an attention message from an unknown terminal, the sender is then saved
in a free userentry (if any)
2) a message from an unknown process, the message is rejected
thus at exit the procedure always delivers:
an event (w2)
a userentry (w1)
an event kind (w0) these kinds are: 1 = input message from internal
2 = output message from internal
3 = parent message from internal
4 = attention from known terminal
5 = answer from known terminal
6 = attention from unknown terminal
7 = answer from timer
8 = message from a bastard
9 = message to a pseudo process (tem)
10 = message to be send later
11 = message to a pseudo process (primo)
12 = message to be send later to primo
13 = control message to terminal
;
\f
body of waitevent
begin
label wait,exit,reject;
incode
word save0,savew1,zero:=0;
ref return,currmess,entryref;
begin
return:=w3;
wait:
w2:=b.baseevent;;
monitor(24); comment wait first event;
currmess:=w2;
w1:=b.lastuser;
if w0 = 1 then comment answer;
begin
(w1).messsend:=w2;
w1:=address(b.interrupt);
monitor(18); comment wait answer;
if w2 = b.timermess then
begin
w0:=0;
b.timermess:=w0;
w0:=7;
goto exit;
end;
w1:=b.firstuser;
while w2 <> (w1).messsend do w1+!length(userentry);
if w1 = b.lastuser then ! answer from unknown is neglected !
begin
testout(.w3.,w0:=24,w1:=currmess,w2:=6);
goto wait;
end;
(w1).messsend:=w0;
if w0=1 then
begin
w3:= address(b.interrupt);
w0:= (w3).bytes;(w1).buflength:= w0;
w0:= (w3).characters;(w1).bufchars:= w0;
end else
begin
w0:= 4;
(w1).buflength:= w0;
w0:= 6;
(w1).bufchars:= w0;
end;
(w1).statusinf:=w0:=(w3).status;
w0:=5;
goto exit;
end else
begin comment message;
if w0:=(w2).operation<0 then
begin ! skip if dummy message from term.module !
w3:= address(b.t_mdul);
monitor(4); ! process description !
if w0=(w2).sender then
begin
b.baseevent:= w2;
testout(.w3.,w0:=24,w1:=currmess,w2:=6);
goto wait;
end;
end;
monitor(26); comment get event;
w3:=(w2).sender;
(w1).internal:=w3;
(w1).peripheral:=w3;
w1:=b.firstuser;
while w3<>(w1).internal do w1+!length(userentry);
if w1=b.lastuser then comment sender is not child;
begin
if w0:=(w2).operation<>0 then
begin
w3+50;
if w0:=(w3).word = b.ownproc then
begin
w0:=8;
goto exit;
end else goto reject;
end;
w1:=b.firstuser;
while w3<>(w1).peripheral do w1+!length(userentry);
if w1<b.lastuser then comment the terminal is known;
begin
if w3:=(w1).messgot>10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
w0:=4;
end
else comment attention from unknown terminal;
begin
w0:=0;
(w1).peripheral:=w0;
w1:=b.firstuser;
while w0<>(w1).peripheral do w1+!length(userentry);
if w3<0 then w1:=b.lastuser;
if w1=b.lastuser then
begin
reject:
(w1).messgot:=w2;
empty_answer(.w3.,w0:=2,w1,w2:=0);
goto wait;
end;
(w1).internal:=w3;
(w1).peripheral:=w3; comment link terminal to entry;
w0:=6;
end;
(w1).messgot:=w2:=currmess;
goto exit;
end
else comment sender=internal;
begin
if w3:=(w1).messgot>10 then
begin
w0:=2;
monitor(22); ! send answer - reject !
goto wait;
end;
savew1:=w1;
w1:=(w1).internal+76;
f1:=(w1).double;
w3:=address(zero);
monitor(72); ! set catalog base to that of child !
w3:=address(b.p_mdul);
monitor(4); ! process description of primo pseudo process !
w1:=savew1;
(w1).messgot:=w2;
if w3:=(w1).messsend > 10 then
begin
if w3:=(w2).receiver+w0=0 then w0:=12
else w0:=10
end
else
if w3:=(w2).receiver+w0=0 then
begin
if w0:=7 <> w3:=(w2).operation then ! reject !
begin
w0:=2;
(w1).messgot:=w0;
monitor(22); ! send answer !
goto wait;
end else w0:=11
end else
if w3:= (w2).receiver+b.ownproc = 0 then w0:= 3 else
if w3:= (w2).receiver+b.sosterm = 0 then
begin
if w3:= (w2).operation onemask 3 then w0:= 1 else
if w3 onemask 5 then w0:= 2 else w0:= 13;
end else w0:= 9;
end;
end;
exit:
entryref:=w1;
b.userentry:=w1;
save0:=w0;
comment * testout (.w3., w0:=!length(userentry), w1:=entryref, w2:=68);
comment *; testout (.w3., w0:=12, w1:=address(save0), w2:=26);
testout(.w3.,w0:=24,w1:=currmess,w2:=6);
f1:=b.startbase;
w3:=address(zero);
monitor(72); ! reset catalog base !
w0:=save0; w1:=entryref; w2:=currmess; w3:=return;
end;
end; ! waitevent !
\f
comment send_control (userentry, message)
this procedure sends a control message to the user terminal
(get specifications, set specifications) and sets localid in the
message in case the terminal is run by tem;
body of send_control
begin
incode word mess0, mess2, mess4, mess6, mess8, mess10, mess12, mess14;
double savef1, savef3;
begin
savef1:= f1;
savef3:= f3;
copy (.w3.,w0:= 16, w1:= w2+8, w2:= address(mess0));
f1:= savef1;
w2:= (w1).peripheral;
if w2 < 0 then -(w2);
w2+2;
w3:= address(b.procname);
(w3).name1:= f1:= (w2).name1;
(w3).name2:= f1:= (w2).name2;
mess10:= w0:= 0; ! set local id (0) for tem !
w1:= address(mess0);
monitor (16); ! send message !
f1:= savef1;
(w1).messsend:= w2;
testout (.w3., w0:= 16, w1:= address(mess0), w2:= 2);
f1:= savef1;
f3:= savef3;
end;
end; ! send control !
\f
comment link (userentry)
this procedure links off the userentry pointed out by w1 from wherever it
it is chained up, and then links it up immediately after the userentry pointed
out by w2. the heads of the queues (active- and waiting-queue) are of the
same format as the chainelements in the userentries so that the chainheads
may be used just like other elements in the chains.
;
body of link
begin
incode
double w01, w23;
begin
w01:=f1;
w23:=f3;
comment link off userentry;
w3:=(w1).prevuser;
(w3).nextuser:=w0:=(w1).nextuser;
w3:=(w1).nextuser;
(w3).prevuser:=w0:=(w1).prevuser;
comment link userentry(w1) after userentry(w2);
(w1).prevuser:=w3:=(w2).prevuser;
(w1).nextuser:=w0:=(w3).nextuser;
(w2).prevuser:=w1;
(w3).nextuser:=w1;
comment * testout (.w3., w0:=20, w1:=address(b.activqfst), w2:=9);
f1:=w01;
f3:=w23;
end;
end; ! link !
\f
comment copy
this procedure just moves w0 bytes from the address of w1 (and onwards) to
the address of w2 (and onwards)
;
body of copy
begin
incode
double w01,w23;
begin
w01:=f1; w23:=f3;
w3:=w1+w0;
while w1<w3 do
begin
(w2).word:=w0:=(w1).word;
w1+2; w2+2;
end;
f1:=w01; f3:=w23;
end;
end;
\f
comment swop
this procedure makes sure, that the core image of the userentry pointed
out by w1 is brought into core (if it was not there already). if the state
is waiting for start with new abs program, swop loads a process image containing a
new abs program. if the process was in core already and there is not asked for a
new abs program - then nothing is done.
;
body of swop
begin
label exitswop;
incode
double w01,w23;
word opmode;
ref corefst,coretop;
word segmsw;
begin
w01:=f1; w23:=f3;
corefst:=w0:=b.fstcore;
if w2:=b.coreuser=w1 then
if w3:=(w1).state<>3 then goto exitswop;
if w2>0 then comment core not free;
begin
startstop(.w3.,w0:=0,w1:=w2); ! stop coreuser !
opmode:=w0:=5 ashift 12;
coretop:=w0:=corefst+(w2).procsize;
segmsw:=w0:=(w2).swopsegm;
w1:=address(opmode);
w3:=address(b.swname);
transport(.w2.,w1,w3);
end;
f1:=w01;
if w1<>0 then
begin
coretop:=w0:=corefst+(w1).procsize;
opmode:=w0:=3 ashift 12;
if w0:=(w1).state=3 then
begin
segmsw:=w0:=0;
if w0:=(w1).state2<1
then w3:=address(b.fpcode)
else w3:=address(b.cleartemp);
end
else begin
segmsw:=w0:=(w1).swopsegm;
w3:=address(b.swname);
end;
w1:=address(opmode);
transport(.w2.,w1,w3);
end;
f1:=w01;
b.coreuser:=w1;
testout(.w3.,w0:=!length(userentry),w1,w2:=3);
exitswop:
f1:=w01;
f3:=w23;
end;
end; ! swop !
\f
body of unintelligible
begin
incode
double w01,w23;
word op,fst,lst;
begin
w01:=f1; w23:=f3;
!test 99;
op:=w0:=0;
fst:=w0:=2;
lst:=w0:=3;
w2:=(w1).messgot;
w0:=3;
(w1).messgot:=w0;
w1:=address(op);
monitor(22); ! send answer !
testout(.w3.,w0:=6,w1:=address(op),w2:=60);
f1:=w01; f3:=w23
end
end; ! unintelligible !
\f
comment send message to primo
w1 = userentry
w2 = messbuf address of buffer sent to primo (pseudo process)
at return w2 = messbuf address of message sent to primo (real process)
w3 = old w2
;
body of send_primo
begin
incode
word savew2;
double savef1;
ref return;
word op;
ref ofirst,
olast,
ifirst,
ilast;
begin
savef1:=f1;
return:=w3;
savew2:=w2;
op:=w0:=28672; ! 7<12 !
ofirst:=w0:=(w1).buffer;
ifirst:=w0;
olast:=w3:=(w2).mblst-(w2).mbfst+w0;
ilast:=w3:=(w2).mbilast-(w2).segmno+w0;
w1:=address(op);
w3:=address(b.p_pseudo);
monitor(16); ! send message to pseudo process created by primo !
f1:=savef1;
(w1).messsend:=w2;
(w1).state:=w0:=6;
testout(.w3.,w0:=10,w1:=address(op),w2:=2);
f1:=savef1;
w2:=(w1).messsend;
w3:=savew2;
call w0 return
end
end; ! send_primo !
\f
body of primess
begin
label stopped;
incode
ref return;
word savew0;
word zero:=0;
word c_funct:=2'00100;
ref c_first,
c_last;
word c_rel:=0;
begin
return:=w3;
if w0:=(w1).state<0 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=256); ! stopped !
goto b.continue;
end else
begin
if w0=0 then
begin
if w1=b.coreuser then
begin
w3:=(w1).internal+11;
if w3:=(w3).byte and 2'10100000=2'10100000 then ! stopped !
begin
(w1).state:=w0:=6;
startstop(.w3.,w0:=1,w1);
end;
c_first:=w0:=(w1).buffer;
c_last:=w3:=(w2).mblst-(w2).mbfst+w0;
w1:=address(c_funct);
if w3>=w0 then
monitor(84) ! general copy !
else
w0:=0;
savew0:=w0;
w1:=b.userentry;
if w0:=6=(w3:=(w1).state) then startstop(.w3.,w0:=0,w1);
if w0:=savew0<>0 then
unintelligble(.w3.,w1)
else
begin
w3:=(w1).buffer;
w0:=(w3).word;
w3+2; w3:=(w3).word;
if w0=4'2000000 then
begin
if w3=4'1010010 then
begin ! define transport !
w1:=(w1).internal+76;
f1:=(w1).double;
w3:=address(zero);
monitor(72); ! set catalog base to that of child !
send_primo(.w3.,w1:=b.userentry,w2);
w1:=address(b.interrupt);
monitor(18); ! wait answer !
w3:=w1;
w1:=b.userentry;
(w1).messsend:=w0; ! result !
(w1).buflength:=w0:=(w3).bytes;
(w1).statusinf:=w0:=(w3).status;
f1:=b.startbase;
w3:=address(zero);
monitor(72); ! reset catalog base !
w1:=b.userentry;
w0:=5; ! answer, w1=userentry, w2=messbufaddr !
if w2:=b.timermess<>0 then
begin
monitor(82); ! regret message !
w2:=0;
b.timermess:=w2
end;
goto b.action_l;
end
else
unintelligible(.w3.,w1)
end ! define transport !
else
begin
send_primo(.w3.,w1,w2);
if w2:=b.timermess<>0 then
begin
monitor(82); ! regret message !
w2:=0; b.timermess:=w2
end;
link(.w3.,w1,w2:=address(b.waitqfst));
startstop(.w3.,w0:=0,w1);
end
end ! message ok !
end
else
goto stopped
end ! state=0 and in core !
else
begin ! state>0 or not coreuser !
stopped: (w1).buflength:=w0:=0;
(w1).state:=w0;
empty_answer(.w3.,w0:=1,w1,w2:=256); ! stopped !
end; ! state>0 or not coreuser !
if w0:=b.timermess<>0 then goto b.continue;
end; ! state>=0 !
w3:=return
end
end; ! primess !
\f
comment send (message or answer)
according to the content of w0 this procedure sends a message or an answer
to the peripheral or the internal process referenced by the userentry(w1).
w0 > 0 answer is sent to internal process (w2 = status, w0 = result)
w0 <= 0 message is sent to peripheral process (w2 = operation < 12 + mode)
at i-o messages to the terminal, the terminal buffer is used for this ope-
ration. at communication with internal processes, data is copied to-from some in-
ternal buffer from-to the terminal buffer. this copying must be done before
calling this procedure.
when w0 < 0 only a part of the terminal buffer is used for the operation,
-w0 giving the relative start address in the buffer.
;
body of send
begin
incode
double w01,w23;
word op,fst,lst;
begin
w01:=f1; w23:=f3;
op:=w2;
if w0>0 then comment send answer;
begin
w2:=(w1).buflength; ! op=status, fst=no.of hw.s, lst=no of chars !
fst:=w2;
w2:= (w1).bufchars;
lst:= w2;
w2:=(w1).messgot;
(w1).messgot:=w0;
w1:=address(op);
monitor(22); comment send answer;
end
else comment send message;
begin
w2:=(w1).peripheral;
if w2 < 0 then -(w2);
w2+2;
w3:=address(b.procname);
(w3).name1:=f1:=(w2).name1;
(w3).name2:=f1:=(w2).name2;
f1:=w01;
if w0<0 then -(w0);
w0 + (w1).buffer;
fst:=w0;
lst:=w0+(w1).buflength-2;
w1:=address(op);
monitor(16); comment send message;
f1:=w01;
(w1).messsend:=w2;
end;
testout(.w3.,w0:=14,w1:=address(w01),w2:=2);
f1:=w01; f3:=w23;
end;
end; ! send !
\f
comment startstop (internal process)
this procedure just starts or stops the internal process referenced by the
userentry (w1).
w0 = 0 stop process
1 start process
;
body of startstop
begin
incode
double w01,w23;
begin
w01:=f1; w23:=f3;
w3:=address(b.procname);
w2:=(w1).internal+2;
(w3).name1:=f1:=(w2).name1;
(w3).name2:=f1:=(w2).name2;
f1:=w01;
if w0=0 then
begin
w1:=b.lastuser;
monitor(60); comment stop internal process;
monitor(18); comment wait answer;
if w0<>1 then key(w01):=w0;
end else
begin
monitor(58); comment start internal process;
if w0<>0 then key(w01):=w0;
end;
f1:=w01;
w2:=w0+4;
testout(.w3.,w0:=!length(userentry),w1,w2);
f1:=w01; f3:=w23;
end;
end; ! startstop !
\f
comment - send an emty answer to "messgot" and set's
"buflength" and "bufchars" to zero -
call: w0 = monitor result
w1 = user entry
w2 = status;
body of empty_answer
begin
incode
double w23;
ref user, buf;
word result;
word status, halves, bytes;
begin
result := w0;
user := w1;
w23 := f3;
status := w2;
w2:= 0;
halves := w2;
bytes := w2;
user.buflength := w2;
user.bufchars := w2;
buf := w2 := user.messgot;
user.messgot := w0;
w1:= address (status);
monitor (22); ! send answer !
testout (.w3., w0:= 10, w1:= address (buf), w2:= 61);
w0 := result;
w1 := user;
f3 := w23;
end;
end;
\f
body of testout
begin
record testhead(byte length,kind;
word time,user,tailfst);
record dump (
word reg0,reg1,reg2,reg3,exreg,instr,cause,sbreg);
incode
ref return;
word bufrel:=0;
double w01,w23;
begin
w01:=f1; w23:=f3;
if w3:=b.testbfst<b.testblst then
begin
if w0+bufrel+8>510 then comment change buffer segment;
begin
if w0 > 1024 then w0:=-2 else w0:=-1;
(w3:=b.testbfst+bufrel).word:=w0;
w1:=address(b.testop);
w3:=address(b.tstarea);
transport(.w2.,w1,w3);
if w1:=b.testsegm+1=b.maxtestsegm then w1:=1;
b.testsegm:=w1;
bufrel:=w0:=0;
f1:= w01;
if w0 > 500 then if w0 < 1024 then w0:= 500;
w01:= f1;
end;
f1:=w01; f3:=w23;
w3:=b.testbfst+bufrel;
(w3).length:=w0+6;
bufrel:=w1:=bufrel+w0;
w1:=108; comment abs ref current time;
f1:=(w1).double-b.starttime lshift -7;
(w3).time:=w1;
(w3).kind:=w2;
f1:=w01;
w1:=b.userentry;
w2:=(w1).internal;
(w3).user:=w2;
f1:=w01;
copy(.w3.,w0,w1,w2:=(w3+6));
end;
f3:=w23;
if w2=7 then comment fault;
begin
w3:= (w1).instr-2;
if w0:=(w3).word lshift -12=(51*64) ! key store ! then
begin ! reestablish registers and continue !
w3+1;
(w1).cause:= w0:= (w3).byte;
w0:= (w1).instr;
return:= w0;
w0:= (w1).reg0;
w2:= (w1).reg2;
w3:= (w1).reg3;
w1:= (w1).reg1;
call w0 return;
end
else
begin
f1:=w01;
f3:=w23;
end;
end;
end;
end; ! testout !
\f
comment transport
;
body of transport
begin
incode
byte optr:=2,modetr:=8'1001;
text (6) stars:="status";
word trstatus, trbytes, chars, a4, a5, a6, a7, a8;
word savew0, savew1;
double savef1,savef3;
begin
savew0:=w0; savew1:=w1;
savef3:=f3;
w0:=0;
while w0=0 do
begin
monitor(16);
w1:=address(trstatus);
monitor(18);
w2:=1 ashift w0;
if w0=1 then w2+trstatus;
trbytes :=w0;
if w2<>2 then
begin
trstatus:= w2;
copy(.w3.,w0:=8,w1:=w3,w2:=address(trbytes));
!get 2;
if w0 <> 1 then goto b.discfault;
opmess(.w3.,w1:=address(optr),w2:=b.ownproc);
end;
w0:=trbytes;
w1:=savew1;
f3:=savef3;
end;
w0:=savew0;
end;
end; ! transport !
\f
!branch 1,2;
comment init
this procedure initializes the userentries (being all free) reserves area
for terminal buffer, testbuffer, computes absolute addresses (creating
the chains of the queues, references to buffers and process-area etc),
creates swop- and test-area-processes - and after execution it is over-
written (used as buffer area for execution of child process)
;
body of init
begin
incode
word childstart,swopno:=0;
byte vop:=16,vmode:=8'140;
text(14) verstxt:=
! *** sos *** ! "release: 7.3";
word sosversion := 900111,
comment ===trimstart;
comment date of option version; optionid := 0,
comment rc4000/rc8000 (rc4000=4000,rc8000=8000); rc := 8000,
comment minimum no of active childs at the same time;minusers := 1,
comment terminals performing os-commands; comndusers:= 2,
comment min. no of bufs reserved for childs; minbufs := 4,
comment min. no of areas reserved for childs; minareas := 7,
comment min. core size for childs; minsize := 12800,
comment size of testoutput area; testsegmnt:= 168,
comment size of i-o buffer for a terminal (bytes); bufl := 104,
comment length of a timeslice (seconds); timeslice := 3,
comment max no of timeslices used in cpu (no input); cpulimit := 100,
comment loss of priority class when timed out; classloss := 1,
comment priority class gain at input (if class<0); classgain := 1,
comment priority gain when first in activequeue; priogain := 1,
comment reaction on time exceeded/break; conditions := 2'000011,
comment 2'000001 = abort job at time exceeded;
comment 2'000010 = abort job after break command;
trimtexts; text(11)
comment operator key; oprkey := "opr",
comment document for swoparea; swopdoc := "",
comment document for testarea; testdoc := "",
comment ===trimfinis;
keytext :="key",
inttext :="internal",
buftext :="buf",
areatext:="area",
sizetext:="size";
ref return,currentry,prevchain:=0;
word zero:=0;
array (1:10) tail of word := 0 0 0 0 0 0 0 0 0 0;
byte op1:=16, mode1:=8'40;
word alarm;
text(11) resource;
word filler:=0;
word stdvalue;
text(21) functext:="***function 1,2,3,4,5",
bufltext:="***buflength >= 94";
word stop;
byte op2:= 16, mode2:= 0;
text (20) childres:="child resources";
byte opstop:= 2, modestop:= 1;
text (20) inittr:= "***init troubles";
byte op3:=16, mode3:=0;
text (20) started:="started";
word childareas, users, swopsize;
text(11) swoparea:="swp",termarea:="psd",testarea:="tst",
fparea:="fp",cleararea:="cleartemp",soscat:="soscat",
t_module:="tem",p_module:="primo",
p_msys:="primosys",console1:="console1";
begin
return:=w3;
w3:=108;
b.starttime:=f1:=(w3).double;
if w2:=rc = 4000 then
begin
b.relintrpt:=w0:=36;
b.reldump:=w0:=38;
end else
begin
b.relintrpt:=w0:=36;
b.reldump:=w0:=80;
end;
copy(.w3.,w0:=8,w1:=address(oprkey),w2:=address(b.operator));
b.maxbuf:=w0:=bufl;
bufl:=w0:=bufl+2;
b.minprio:=-(w1:=cpulimit);
b.interval:=w1:=timeslice;
b.timerloss:=w1:=classloss;
b.cyclegain:=w1:=priogain;
b.inputgain:=w1:=classgain;
b.syscond:=w1:=conditions;
w3:= b.ownproc+32;
w0:= (w3).word;
f1 lshift -12; w1 lshift -12;
if w2:=rc <> 4000 then
begin
b.childpr:= w0;
b.childpk:= w1;
end
else
begin
-(w1);
b.childpr:= w2:= 128 lshift w1 + w0;
if w2 extract 8=127 then ! no key available for child !
begin
stdvalue:= w0:= 2;
copy(.w3.,w0:=8,w1:=address(keytext),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
w2:=b.childpr extract 8;
w1:= 1;
while w2 lshift 1 onemask 128 do w1+1;
b.childpk:= w1;
end;
opmess(.w3.,w1:=address(vop),w2:=b.ownproc);
w3:=b.ownproc+29; ! test function mask !
if w0:=(w3).byte onemask 8'3700 then else
begin
copy(.w3.,w0:=14,w1:=address(functext),w2:=address(started));
stop:=w0:=1;
opmess(.w3.,w1:=address(op3),w2:=b.ownproc);
end;
if w0:=bufl < 94 then ! buffer size too small for sos' private use !
begin
copy(.w3.,w0:=14,w1:=address(bufltext),w2:=address(started));
stop:=w0:=1;
opmess(.w3.,w1:=address(op3),w2:=b.ownproc);
end;
w3:= b.ownproc+28;
w0:= (w3).byte;
if w0<minusers then ! too few internals available !
begin
stdvalue:= w0:= minusers;
copy(.w3.,w0:=8,w1:=address(inttext),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
w0:= minusers;
end;
users:= w0+comndusers;
w0*2; ! compute free bufs !
w0+4;
w3:= b.ownproc+26;
-(w0-(w3).byte);
b.freebufs:= w0;
if w0<minbufs then ! too few buffers !
begin
-(w0-minbufs-(w3).byte);
stdvalue:= w0;
copy(.w3.,w0:=8,w1:=address(buftext),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
w3:= b.ownproc+27;
! "fp", swoparea, "soscat", "cleartemp", pseudo process, (testarea) !
if w0:=testsegmnts=0 then w0:=5 else w0:= 6;
w0+users+users-comndusers; ! pseudo tem + pseudo primo !
w2:= (w3).byte;
childarea:= w3:= w2-w0;
w0+minareas;
if w2<w0 then ! too few areas !
begin
stdvalue:= w0+1;
copy(.w3.,w0:=8,w1:=address(areatext),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
w3:= b.ownproc+22;
w0:= (w3).word; b.fstcore:= w0;
w3+2;
w0:= (w3).word; b.topcore:= w0;
w0:= bufl+!length(userentry)*users;
w0+!length(userentry);
if w3:=testsegmnts<>0 then w0+512;
w3:= address(childstart) + 2047;
w3 := w3 lshift -11 lshift 11; ! force address to 2K border !
- (w3);
w3+b.topcore; w3-w0;
if w3<minsize then ! size too small !
begin
-(w3-minsize);
w3+b.topcore-b.fstcore; stdvalue:= w3;
copy(.w3.,w0:=8,w1:=address(sizetext),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
swopsize:= w3 ashift -9;
w3 ashift 9;
w1:= address(childstart) + 2047;
w1 := w1 lshift -11 lshift 11; ! force address to 2K border !
b.fstcore := w1;
w1+w3; b.topcore:= w1;
b.testbfst:= w1;
w2:= testsegmnts;
if w2>0 then ! prepare testoutput !
begin
w1+510; b.testblst:= w1;
copy(.w3.,w0:=6,w1:=b.ownproc+2,w2:=address(testarea)+2);
tail(w2:=2);
copy(.w3.,w0:=8,w1:=address(testdoc),w2);
if w0:=(w2).word = 0 then (w2).word:=w0:=1;
w3:= address(testarea);
monitor(48); ! remove entry !
(tail(w1:=1)).word:= w2:=testsegmnts;
b.maxtestsegm:= w2;
monitor(40); ! create testoutput area !
monitor(52); ! create area process !
monitor(8); ! reserve area process !
if w0<>0 then
begin
stdvalue:= w2;
copy(.w3.,w0:=8,w1:=address(testarea),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
w1:= 3;
monitor(50); ! permanent entry !
copy(.w3.,w0:=8,w1:=address(testarea),w2:=address(b.tstarea));
end
else
b.testblst:= w1;
! prepare swoparea !
copy(.w3.,w0:=6,w1:=b.ownproc+2,w2:=address(swoparea)+2); ! name = "swp<sos>" !
tail(w2:=2);
copy(.w3.,w0:=8,w1:=address(swopdoc),w2);
if w0:=(w2).word = 0 then (w2).word:=w0:=1;
w3:= address(swoparea);
monitor(48); ! remove entry !
w2:= users*swopsize;
(tail(w1:=1)).word:= w2;
monitor(40); ! create swop area !
monitor(52); ! create area process !
monitor( 8); ! reserve area process !
if w0<>0 then
begin
stdvalue:= w2;
copy(.w3.,w0:=8,w1:=address(swoparea),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:= address(op1),w2:=b.ownproc);
end;
copy(.w3.,w0:=8,w1:=address(swoparea),w2:=address(b.swname));
w3:= address(fparea); ! "fp" !
tail(w1:=1);
monitor(42); ! lookup entry !
w1+17;
b.fp_rel:= w0:= (w1).byte;
monitor(52); ! create area process !
if w0<>0 then
begin
stdvalue:= w0;
copy(.w3.,w0:=8,w1:=address(fparea),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
copy(.w3.,w0:=8,w1:=address(fparea),w2:=address(b.fpcode));
w3:= address(cleararea); ! "cleartemp" !
tail(w1:=1);
monitor(42); ! lookup entry !
w1+17;
b.cleart_rel:= w0:= (w1).byte;
monitor(52); ! create area process !
if w0<>0 then
begin
stdvalue:= w0;
copy(.w3.,w0:=8,w1:=address(cleararea),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
copy(.w3.,w0:=8,w1:=address(cleararea),w2:=address(b.cleartemp));
! prepare pseudo process for terminal i/o : "psd<sos-name>" !
copy(.w3.,w0:=6,w1:=b.ownproc+2,w2:=address(termarea)+2);
w3:= address(termarea);
monitor (80); ! create pseudo process !
if w0 <> 0 then
begin
stdvalue:= w0;
copy (.w3.,w0:=8,w1:=address(termarea),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end else
begin
monitor (4); ! process description !
b.sosterm:= w0;
end;
w3:=b.ownproc+68;
b.startbase:=f1:=(w3).double;
w3:=address(zero);
w0:=w1;
monitor(72); ! set sos own cat base !
w3:= address(soscat); ! "soscat" !
tail(w1:=1);
monitor(52); ! create area process !
if w0<>0 then
begin
stdvalue:= w0;
copy(.w3.,w0:=8,w1:=address(soscat),w2:=address(resource));
alarm:= w0:= 2763306;
stop:= w0;
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
end;
copy(.w3.,w0:=8,w1:=address(soscat),w2:=address(b.usercat)); ! "soscat" !
copy(.w3.,w0:=8,w1:=address(t_module),w2:=address(b.t_mdul)); ! "tem" !
copy(.w3.,w0:=8,w1:=address(p_module),w2:=address(b.p_mdul)); ! "primo" !
copy(.w3.,w0:=8,w1:=address(p_msys),w2:=address(b.p_pseudo)); ! "primosys" !
if w0:=stop<>0 then
begin ! resources not available for start up !
opmess(.w3.,w1:= address(opstop),w2:=b.ownproc);
end;
opmess(.w3.,w1:=address(op2),w2:=b.ownproc);
alarm:= w0:= 2105376; ! " " !
stdvalue:= w0:= users-comndusers;
copy(.w3.,w0:=8,w1:=address(inttext),w2:=address(resource));
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
stdvalue:= w0:= b.freebufs;
copy(.w3.,w0:=8,w1:=address(buftext),w2:=address(resource));
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
stdvalue:= w0:= childareas;
copy(.w3.,w0:=8,w1:=address(areatext),w2:=address(resource));
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
w0:= b.topcore-b.fstcore; stdvalue:= w0;
copy(.w3.,w0:=8,w1:=address(sizetext),w2:=address(resource));
opmess(.w3.,w1:=address(op1),w2:=b.ownproc);
opmess(.w3.,w1:=address(op3),w2:=b.ownproc);
comment reserve space for i/o-buffers for terminals;
w1:= b.testblst+2;
w0:=bufl*users;
w2:=w0+w1;
currentry:=w2;
b.firstuser:=w2;
swopno:=w3:=swopno-swopsize;
w3:=0;
while w3+1<=users do ! initialize all user entries as empty !
begin
(w2).prevuser:=w0:=prevchain;
prevchain:=w2;
swopno:=w0:=swopno+swopsize;
(w2).swopsegm:=w0:=swopno;
w0:=0;
(w2).internal:=w0;
(w2).peripheral:=w0;
(w2).messsend:=w0;
(w2).messgot:=w0;
(w2).bufrel:=w0;
(w2).buffer:=w1;
w1+bufl;
w0:=w2+!length(userentry);
(w2).nextuser:=w0;
w2:=w0;
end;
b.lastuser:=w2;
w2:=(w0-!length(userentry));
w0-!length(userentry);
(w2).prevuser:=w0;
(w2).nextuser:=w0:=address(b.waitqfst);
b.waitqlst:=w2;
w2:=b.firstuser;
(w2).prevuser:=w0:=address(b.waitqfst);
b.activqfst:=w0:=address(b.activqfst);
b.activqlst:=w0;
b.batchqfst:=w0:=address(b.batchqfst);
b.batchqlst:=w0;
b.waitqfst:=w2;
testout(.w3.,w0:=60,w1:=address(sosversion),w2:=69);
w3:=address(zero);
f1:=b.startbase;
monitor(72); ! set own cat base !
w0:=b.fstcore;
b.register1:=w0;
w0:=b.fstcore+2;
testout(.w3.,w0:=150,w1:=b.ownproc-4,w2:=8);
comment *; testout (.w3., w0:=20, w1:=address(b.activqfst), w2:=9);
w3:=b.ownproc+98;
b.basereg:=w3:=(w3).word;
w3:=return;
end;
end; ! init !
\f
body of opmess
begin
procedure outinteger(.w3.;w1;w2);
incode
text(11) pause:=" pause ",mess:=" message ";
text(14) maincons;
word clock1,clock2;
text(11) sysname;
text(11) messtype;
text(14) procname:=" ";
array(1:70) linebuffer of word;
word nl:=10;
byte op:=5,mode:=0;
ref first,last;
double savef1,savef3;
begin
savef1:=f1;
savef3:=f3;
outtime(.w3.,w2:=address(clock1));
w3:=address(sysname);
w2:=b.ownproc+2;
(w3).name1:=f1:=(w2).name1;
f1:=(w2).name2;
w1+58;
(w3).name2:=f1;
f3:=savef3;
copy(.w3.,w0:=8,w1:=w2+2,w2:=address(procname));
f1:=savef1;
if w0:=(w1).word extract 1 = 1 then w1:=address(pause)
else w1:=address(mess);
copy(.w3.,w0:=8,w1,w2:=address(messtype));
f1:=savef1;
w0:=-1 lshift 12 or (w1).word lshift -5;
w1+14;
linebuffer(w2:=70);
while w0 onemask 8'10000 do
begin
if w0 onemask 1 then
outinteger(.w3.,w1,w2) else
(w2).word:=w3:=(w1).word;
w2-2;
w1-2;
w0 lshift -1;
end;
w0:=0;
linebuffer(w1:=1);
while w1 <= w2 do
begin
(w1).word:=w0;
w1+2;
end;
first:=w1:=address(clock1);
last:=w1:=address(nl);
copy(.w3.,w0:=8,w1:=b.mainconsref+2,w2:=address(maincons));
w1:=address(op);
w3:=address(maincons);
monitor(16); ! send message !
linebuffer(w1:=1);
monitor(18); ! wait answer !
f1:=savef1;
f3:=savef3;
if w2 = b.ownproc then
if w0:=(w1).word onemask 1 then
begin ! pause message from sos itself !
w0:=0;
w3:=0;
monitor(0); ! set interrupt !
testout(.w3.,w0:=1024,w1:=-2,w2);
end else f1:=savef1;
end;
body of outinteger
begin
incode
double savef1;
word savew3;
begin
savef1:=f1;
savew3:=w3;
(w2).word:=w0:=32;
w2-2;
w0:=(w1).word;
if w0 = 0 then
begin
(w2).word:=w3:=48;
w2-2;
end;
while w0 <> 0 do
begin
w3:=0;
f0 // 10;
(w2).word:=w3+48;
w2-2;
end;
(w2).word:=w0:=32;
f1:=savef1;
w3:=savew3;
end;
end; ! outinteger !
end; ! opmess !
\f
body of logout
begin
incode
double savef1,savef3;
byte op1,mode1:=0;
ref fst,lst;
byte op2:=102,mode2:=0;
word locid;
text(14) simtext:="'2''2' hard error'10'";
text(14) poolname;
begin
savef1:=f1;
savef3:=f3;
startstop(.w3.,w0:=0,w1);
(w1).buflength:=w0:=0;
if w0:=(w1).messgot > 10 then empty_answer(.w3.,w0:=1,w1,w2:=0);
locid:=w0:=(w3:=(w1).buffer).word;
copy(.w3.,w0:=6,w1:=(w1).internal+2,w2:=address(poolname)+2);
copy(.w3.,w0:=2,w1:=address(b.t_mdul),w2:=address(poolname));
w3:=address(poolname);
op1:=w0:=9; ! simulate input !
fst:=w0:=address(locid);
lst:=w0:=address(simtext)+8;
w1:=address(op1);
monitor(16); ! send message !
w1:=b.lastuser;
monitor(18); ! wait answer !
if w0 or (w1).word = 1 then
begin ! terminal on transparent pool !
w1:=address(op2);
monitor(16); ! send message (remove link soft) !
w1:=b.lastuser;
monitor(18); ! wait answer !
end else
begin ! other kind of hard error - kill job !
f1:=savef1;
clean(.w3.,w1);
(w1).intervent:=w0:=6;
end;
f1:=savef1;
w0:=1;
(w1).messsend:=w0;
goto b.activate;
end;
end; ! logout !
\f
body of outtext
begin
incode
text(29)
t0 :="command unknown'10'",
t1 :="ready'10'",
t2 :="syntax'10'",
t3 :="identification illegal'10'",
t4 :="no room in primary store'10'",
t5 :="bs claims exceeded'10'",
t6 :="process creation not ok'10'",
t7 :="forbidden'10'",
t8 :="terminal busy'10'",
t9 :="terminal connection not ok'10'",
t10:="jobfile does not exist'10'",
t11:="terminal connected'10'",
t12:="terminal disconnected'10'",
t13:="bad password'10'",
t14:="terminal not connected'10'",
t15:="process unknown'10'",
t16:="disconnection not ok'10'",
t17:="call not ok'10'",
t18:="include not ok'10'",
t19:="enrolled'10'",
t20:="removed after break'10'",
t21:="removed after finis'10'",
t22:="removed after user kill'10'",
t23:="removed after operator kill'10'",
t24:="removed after time exceeded'10'",
t25:="removed after terminal error'10'",
t26:="removed after user break'10'",
t27:="removed after operator break'10'",
t28:="user conflict'10'",
t29:="forbidden - system locked'10'",
t30:="user catalog reserved'10'",
t99:="***";
double savef3;
word savew0,savew1;
ref bufpointer;
begin
savef3:=f3;
savew0:=w0;
savew1:=w1;
bufpointer:=w3:=(w1).buffer;
(w3).word:=w2:=0;
w3+2;
bufpointer:=w3;
if w0 onemask 8'10 then
begin ! write time !
outtime(.w3.,w2:=bufpointer);
bufpointer:=w2:=bufpointer+4;
end;
w3:=bufpointer;
case w2:=savew0 extract 3 + 1 of
begin
(w3).word:=w0:=0;
(w3).word:=w0:=2763306; comment "***" ;
(w3).word:=w0:=2171169; comment "!!!" ;
(w3).word:=w0:=2960685; comment "---" ;
(w3).word:=w0:=2105376; comment " " ;
(w3).word:=w0:=0;
(w3).word:=w0:=0;
(w3).word:=w0:=0;
end;
bufpointer:=w0:=bufpointer+2;
if w0:=savew0 onemask 8'20 then
begin ! write system name !
w3:=bufpointer;
w2:=b.ownproc+2;
(w3).name1:=f1:=(w2).name1;
f1:=(w2).name2;
w1+14880; ! ": " !
(w3).name2:=f1;
bufpointer:=w0:=bufpointer+8;
end;
if w0:=savew0 onemask 8'40 then
begin ! write process name !
w3:=bufpointer;
w1:=savew1;
w1:=savew1;
w2:=(w1).internal+2;
(w3).name1:=f1:=(w2).name1;
f1:=(w2).name2;
w1+32;
(w3).name2:=f1;
bufpointer:=w0:=bufpointer+8;
end;
f3:=savef3;
w2*20;
copy(.w3.,w0:=20,w1:=address(t0)+w2,w2:=bufpointer);
w1:=savew1;
w0:=(w1).buffer;
w2+20-w0;
(w1).buflength:=w2;
testout(.w3.,w0:=w2,w1:=(w1).buffer,w2:=0);
w1:=savew1;
send(.w3.,w0:=0,w1,w2:=20480);
f3:= savef3;
continuemcl (.w3.,w0:=w2,w1:=savew1);
w0:=savew0;
w1:=savew1;
f3:=savef3;
end;
end; ! outtext !
\f
body of outtime
begin
record timetext(word hourtxt,minutetxt);
incode
ref systime:=108;
word daysize:=1687500,hoursize:=70313,minutesize:=1172;
ref return,bufref;
double savef1;
begin
savef1:=f1;
bufref:=w2;
return:=w3;
f3:=systime.name1 lshift -9 // daysize; ! w3:=dayno !
f1 lshift -100;
f2 // hoursize; ! w2:=hour !
f1 // minutesize; ! w1:=minute !
w0:=0;
f1 // 10;
bufref.minutetxt:=w1 + 48 lshift 8 + w0 + 48 lshift 8 + 32;
w1:=0;
f2 // 10;
bufref.hourtxt:=w2 + 48 lshift 8 + w1 + 48 lshift 8 + 46;
f1:=savef1;
w2:=bufref;
w3:=return;
end;
end; ! outtime !
\f
comment syscommand
this procedure checks the user identification typed at login. if it is
ok, a process is created with standard bs claims and with catalog bases
corresponding to the user identification.
the user is answered with a message telling, wheather or not the attemp
to login was succesfull.
;
body of syscommand
begin
procedure login(.w3.;w0;w1);
comment call: w0 kind of start command
w1 abs ref string1
return: w1 abs ref error message or zero
;
procedure out(.w3.;w1);
comment call: w1 abs ref string1
return: w1 abs ref error message or zero
;
procedure control(.w3.;w0;w1);
comment call: w0 control operation (1,2,3,4 = kill,break,stop,start)
w1 abs ref string1
return: w1 abs ref error message or zero
;
procedure empty(.w3.;w1);
comment call: w1 abs ref userentry
return: w1 abs ref error message or zero
;
procedure include(.w3.;w1);
comment call: w1 abs ref string1
return: w1 abs ref error message or zero
;
label newstring,aftername,commfound,error,accept;
incode
double savef1,savef3;
word logstop,radix,offset,char,savew1,savew2,savew3,count,comm,proc_no;
ref namepointer,next;
text(11) emptytext:="";
text(11) string1, string2, string3,
string4, string5, string6,
string7,string8,string9;
text(11)oscomm1 :="in",
oscomm2 :="out",
oscomm3 :="kill",
oscomm4 :="",
oscomm5 :="run",
oscomm6 :="go",
oscomm7 :="batch",
oscomm8 :="break",
oscomm9 :="stop",
oscomm10:="start",
oscomm11:="call",
oscomm12:="include",
oscomm13:="lock",
oscomm14:="open",
oscomm15:="halt";
begin
savef1:=f1; savef3:=f3;
testout(.w3.,w0:=!length(userentry),w1,w2:=68);
testout(.w3.,w0:= (w1).bufrel + (w1).buflength,w1:=(w1).buffer,w2:=0);
! read strings !
w0:=0;
w1:=address(emptytext);
w2:=address(string1);
w3:=0;
while w3+1<=9 do ! zeroset string1 - string9 !
begin
savew3:=w3;
copy(.w3., w0:=8, w1, w2);
w3:=savew3;
w2+8;
end;
comment transfer commands from terminal buffer to the text
variables string1 - string 8
;
count:=w0:=1;
namepointer:=w0:=address(string1);
next:=w0:=namepointer+8;
w3:=b.userentry;
w2:=(w3).buffer;
comm:= w0:= (w3).state;
w1:=0;
logstop:=w0:= (w3).bufrel + (w3).buflength+w2;
(w3).bufrel:= w1;
newstring:
w0:=32;
while w0=32 do nextchar(.w3.,w3:=logstop,w0,w1,w2);
if w0 = 10 then goto aftername;
if w0 = 62 then ! '>' is start of password line !
begin
comm:= w0:= 0;
goto newstring;
end;
if w0 < 97 then
begin ! integer param !
offset:=w3:=48;
radix:=w3:=10;
word(namepointer):=w3:=-1;
namepointer:=w3:=namepointer+2;
end else
begin ! name param !
offset:=w3:=0;
radix:=w3:=256;
end;
while w0<>32 do
begin
if w3:=next=namepointer
then goto aftername;
if w0=10 then goto aftername;
char:=w0;
if w0:=offset = 0 then
begin
if w0:=char >= 97 then
if w0 < 126 then goto accept;
end;
if w0:=char >= 48 then
if w0 < 58 then goto accept;
!test 1;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
accept:
w0:=word(namepointer)*radix; ! pack text or number !
word(namepointer):=w0+char-offset;
if w0>65535 then namepointer:=w3:=namepointer+2;
nextchar(.w3.,w3:=logstop,w0,w1,w2);
end;
aftername:
! more than 11 chars or w0=32 or w0=10 !
if w3:=next=namepointer then
begin
!test 2;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
if w0=32 then
begin
count:=w3:=count+1;
if w3>8 then ! max 8 params in command line !
begin
while w0=32 do nextchar(.w3.,w3:=logstop,w0,w1,w2);
if w0<>10 then
begin
!test 3;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
end;
end;
if w3:=offset = 0 then ! fill textparam with null-chars !
if w3:=next>namepointer then
begin
w3:=word(namepointer);
if w3<>0 then
while w3<65535 do w3 lshift 8;
word(namepointer):=w3;
end;
namepointer:=w3:=next;
next:=w3:=next+8;
if w0=32 then goto newstring;
if w0:= comm = -3 then goto newstring;
! first newline blind, when reading invisible password !
comment now all parameters have been read;
w1:=address(oscomm1);
w2:=address(string1);
comm:=w3:=1;
while w3:=comm<16 do
begin
compare(.w3.,w0:=4,w1,w2);
if w0=0 then goto commfound;
w1+8;
comm:=w3:=comm+1;
end;
!test 4;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=0); ! what !
goto error;
commfound:
w1:=address(string1);
case w3:=comm of
begin
login(.w3.,w0:=3,w1); ! in (connection to pool) !
out(.w3.,w1); ! out (disconnect) !
control(.w3.,w0:=1,w1); ! kill !
empty(.w3.,w1:=b.userentry);
login(.w3.,w0:=2,w1); ! run (connection via tem)!
login(.w3.,w0:=0,w1); ! go !
login(.w3.,w0:=1,w1); ! batch !
control(.w3.,w0:=2,w1); ! break !
control(.w3.,w0:=3,w1); ! stop !
control(.w3.,w0:=4,w1); ! start !
calldev(.w3.,w1); ! call (name device) !
include(.w3.,w1); ! include users(device) !
control(.w3.,w0:=-1,w1); ! lock (block logins) !
control(.w3.,w0:=-2,w1); ! open (accept login) !
control(.w3.,w0:=-3,w1); ! halt !
end;
if w1 <> 0 then
begin
error:
if w1 = -1 then
begin
!test 5;
if w0:= (w1:=b.userentry).messsend < 10 then
outtext(.w3.,w0:=8'30,w1,w2:=1); ! ready !
if w0:=(w1).state = -1 then (w1).state:=w0:=0;
end;
w1:=b.userentry;
(w1).bufrel:= w0:= 0;
if w0:=(w1).state = -1 then
begin
link(.w3.,w1,w2:=address(b.waitqfst));
(w1).state:=w0:=0;
end else
if w0 < -1 then
begin
w0:=0;
(w1).messsend:=w0;
(w1).peripheral:=w0;
(w1).internal:=w0;
link(.w3.,w1,w2:=address(b.waitqfst));
end else ;
end;
w0:=1;
w1:=b.userentry;
(w1).messsend:=w0;
w3:=address(emptytext);
f1:=b.startbase;
monitor(72); ! set sos own catalog base !
f1:=savef1;
f3:=savef3;
end; ! syscommand !
\f
body of login
begin
procedure checkprot(.w3.;w1;w2);
comment call: w1 abs ref "pass"-parameter
w2 abs ref password from catalog
return: w1 abs ref error message or zero
w2 boolean rewrite catalog segment
;
procedure checkdevice(.w3.;w0;w1);
comment call: w1 abs ref userentry
return: w0 mode for reading of password:
0: console (deviceno=2)
2: other terminal (dev<>2)
other registers unchanged
;
label error,error1,error2,error2_1,error3,error4,freefound,
release;
incode
! process description for create internal process !
double corelimits;
byte buffers,areas,
internals:=0,fncmask:=1792, ! .111........ !
protreg,protkey;
double maxbase,stdbase;
double claim0,claim1,claim2,claim3;
byte logop:=5,logmode:=0;
ref first,last;
word segm,zero:=0,rewrite;
word savew0,savew1,savew2,savew3;
ref jobfile:=0,procentry;
double savef3;
text(11) emptytext:="",jobf:="jobfile";
ref string1,string2,string3,string4,string5,string6,
string7,string8;
array(1:10) tail of word;
array(1:8)answ of word;
byte simop,simmode:=0;
ref simfirst,simlast;
word simlocid;
text(9) simtext:="'1''1' att ";
text(11)trmname;
word nl:=10;
byte temop,temmode:=0;
word localid;
ref termpda;
byte bufs,timers;
text(14) poolname;
word help;
comment format of login command is:
s1 s2 s3 s4
( go )
( run ) <procname> ( jobfile <filename> )(.)
( batch )
s3/5 s4/6 s5/7 s6/8
( pass <passname> (newpass <passname>)(.) )(.)
( >password <passname> )
or:
s1 s2 s3 s4 s5 s6 s7
in <procname> <termname> ( pass <passname> (newpass <passname>)(.) )(.)
( >password <passname> )
;
begin
savew0:=w0; ! login-kind: 0=go, 1=batch, 2=run, 3=in !
savef3:=f3;
w3:=b.userentry;
if w0:=b.sysstate <> 0 then if w0:=b.mainconsref<>(w3).peripheral then
begin
!test 6;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=29); ! forbidden - system locked !
goto error;
end;
string1:=w1; w1+8;
string2:=w1; w1+8;
string3:=w1; w1+8;
string4:=w1; w1+8;
string5:=w1; w1+8;
string6:=w1; w1+8;
string7:=w1; w1+8;
string8:=w1;
compare(.w3.,w0:=8,w1:=string3,w2:=address(jobf));
if w0 = 0 then jobfile:=w3:=string4;
w1:=b.userentry;
if w3:=(w1).state = -1 then ! known terminal creating new job !
begin
if w0:=jobfile = 0 then ! at most one job without jobfile !
begin
!test 7;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=7); ! forbidden !
link (.w3., w1:= b.userentry, w2:= address(b.activqfst));
w1:= -1;
goto error;
end;
w1:=b.lastuser;
while w1-!length(userentry) >= b.firstuser do
begin
if w0:=(w1).internal = 0 then goto freefound;
end;
!test 8;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=6); ! process creation !
link (.w3., w1:= b.userentry, w2:= address(b.activqfst));
w1:= -1;
goto error;
freefound:
procentry:=w2:=b.userentry; ! old entry !
b.userentry:=w1; ! new entry !
(w2).state:=w0:=0;
(w1).peripheral:=w0:=(w2).peripheral;
(w1).internal:=w0;
(w1).state:=w0:=-2;
(w1).buflength:=w0:=(w2).buflength;
copy (.w3., w0, w1:=(w2).buffer, w2:=(w2:=b.userentry).buffer);
link(.w3.,w1:=procentry,w2:=address(b.activqfst));
end;
procentry:=w1:=b.userentry; ! new entry !
(w1).primdevi:=w0:=(w1).peripheral;
w0:=savew0;
if w0 = 3 then w2:=string3 else w2:=0;
scancat(.w3.,w0,w1:=string2,w2);
if w0 < 0 then
begin
if w0 = -3 then w2:=30 ! user catalog reserved !
else w2:=3; ! identification illegal !
!test 9;
outtext(.w3.,w0:=8'31,w1:=procentry,w2);
goto error1;
end else segm:=w0;
b.procdescr:=w1;
b.termdescr:=w2;
if w0:=savew0 < 3 then ! go, run or batch !
begin
if w1:=jobfile = 0 then w1:=string3
else w1:=string5;
checkprot(.w3.,w1,w2:=b.procdescr+!position(ppass));
if w1 <> 0 then goto error1;
rewrite:=w2;
if w1:=jobfile > 0 then
begin
w1:=procentry;
w2:=(w1).peripheral;
-(w2);
(w1).peripheral:=w2; ! jobfile is marked by negative peripheral !
w2:=address((w1).pr_in);
(w2).word:=w0:=4;
copy(.w3.,w0:=8,w1:=jobfile,w2+2); ! insert jobfile name in i/o-buffer !
end else
begin
w1:=procentry;
w2:=address((w1).pr_in);
(w2).word:=w0:=8;
copy(.w3.,w0:=8,w1:=b.sosterm+2,w2+2); ! pseudo-sos-name in i/o-buffer !
end;
w2:=address((w1:=procentry).pr_out);
(w2).word:=w0:=8;
copy(.w3.,w0:=8,w1:=b.sosterm+2,w2+2);
w3:=b.procdescr;
buffers:=w0:=(w3).procbuffers;
areas:=w0:=(w3).procareas;
w0:=(w3).procsb1;
w1:=(w3).procsb2;
stdbase:=f1;
w0:=(w3).procmb1;
w1:=(w3).procmb2;
maxbase:=f1;
w0:=b.fstcore;
if w1:=b.topcore-b.fstcore > (w3).pmaxsize
then w1:=(w3).pmaxsize+511 lshift -9 lshift 9;
if w1 < (w3).pminsize then
begin
!test 10;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=4); ! no room in primary store !
goto error1;
end;
w1 lshift -11 lshift 11; ! make size a 2K multiplum !
procentry.procsize:=w1;
w1+w0;
corelimits:=f1;
protreg:=w1:=b.childpr;
protkey:=w1:=b.childpk;
w3:=address(zero);
f1:=stdbase;
monitor(72);! set sos own cat base !
!test 445;
if w3:=jobfile > 0 then
begin
tail(w1:=1);
w3:=jobfile;
monitor(42); ! lookup jobfile !
if w0 <> 0 then
begin
!test 11;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=10); ! no jobfile !
goto error1;
end;
end;
w3:=address(b.t_mdul);
monitor(80); ! create pseudo process "tem" !
if w0 <> 0 then
begin
!test 12;
if w0 = 3 then outtext(.w3.,w0:=8'31,w1:=procentry,w2:=28) ! user conflict !
else outtext(.w3.,w0:=8'31,w1:=procentry,w2:=6); ! process creation !
goto error1;
end;
w3:=address(b.p_mdul);
monitor(80); ! create pseudo process "primo" !
if w0<>0 then
begin
!test 14;
if w0 = 3 then outtext(.w3.,w0:=8'31,w1:=procentry,w2:=28)
else outtext(.w3.,w0:=8'31,w1:=procentry,w2:=6);
goto error2_1;
end;
f1:=b.startbase;
w3:=address(zero);
monitor(72); ! reset sos own cat base !
!test 447;
if w0:=b.freebufs-buffers<0 then
begin
!test 16;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=6); ! process creation !
goto error2;
end
else b.freebufs:=w0;
w1:=address(corelimits);
w3:=string2;
monitor(56); ! create internal process !
if w0<>0 then
begin
!test 17;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=6); ! process creation !
goto error3;
end;
w3:=b.procdescr;
w0:=(w3).procub1;
w1:=(w3).procub2;
w3:= string2;
monitor(72); ! set catalog base = user base !
if w0<>0 then
begin
!test 18;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=6); ! process creation !
goto error4;
end;
monitor(4); ! get process description address in w0 !
w1:=procentry;
(w1).internal:=w0;
w3:=b.procdescr;
w2:=w3+!position(procdiscs);
w1:=0;
while w1+1<13 do
begin
w2+!length(procdisc);
savew1:=w1;
testout(.w3.,w0:=!length(procdisc),w1:=w2,w2:=68);
w2:=w1; w1:=savew1;
if w3:=(w2).word=0 then w1:=13
else
begin
savew1:=w1;
savew2:=w2;
w1:=w2+8;
w2:=address(claim0);
copy(.w3.,w0:=16,w1,w2);
w1:=w2;
w2:=savew2;
w3:=string2;
monitor(78); ! set bs claims !
if w0<>0 then
begin
!test 19;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=5); ! claims exceeded !
goto error4;
end;
w1:=savew1;
w2:=savew2;
end;
end;
if w0:=savew0 = 2 then ! run - connect terminal via tem !
begin
! generate poolname: char 1-3 of sos-name, char 4-11 of procname !
copy(.w3.,w0:=2,w1:=b.ownproc+2,w2:=address(poolname));
copy(.w3.,w0:=6,w1:=procentry.internal+2,w2+2);
temop:=w0:=90; ! create pool !
w1:=address(temop);
w3:=address(b.t_mdul);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
if w0 or (w1).word <> 1 then
begin
!test 20;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=9); ! terminal connection error !
goto error4;
end;
w3:=address(poolname);
monitor(4); ! get process description !
if w2:=jobfile > 0 then -(w0);
procentry.peripheral:=w0;
termpda:=w0:=procentry.primdevi;
localid:=w0:=0;
bufs:=w0:=1;
timers:=w0:=5;
temop:=w0:=100; ! create link !
temmode:=w0:=2; ! transparent link !
w3:=address(poolname);
w1:=address(temop);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
if w0 or (w1).word <> 1 then
begin
temmode:=w0:=0;
temop:=w0:=92;
w1:=address(temop);
w3:=address(b.t_mdul);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
procentry.peripheral:=w0:=procentry.primdevi;
!test 21;
outtext(.w3.,w0:=8'31,w1:=procentry,w2:=9); ! terminal connection error !
goto error4;
end;
procentry.primio:=w0:=0;
procentry.currlocid:=w0:=0;
end
else procentry.primio:=w0:=0; ! go/batch login !
w1:=procentry;
link(.w3.,w1,w2:=address(b.activqfst));
comment the new job is linked into the activequeue independent
of the job type. a batchjob is later on moved to the
batchqueue (at "activate:" in the main program) because
of the priority class
;
w0:=1;
(w1).messsend:=w0;
(w1).statusinf:=w0:=0;
w2:=(w1).buffer;
w1:=b.procdescr+!position(procfp);
copy(.w3.,w0:=40,w1,w2);
w1:=procentry;
if w0:=savew0 = 1
then ! batch ! (w1).class:=w0:=b.batchclass-b.timerloss-1
else (w1).class:=w0:=0;
(w1).state:=w0:=3;
(w1).state2:=w0:=-1;
(w1).prio:=w0:=0;
(w1).intervent:=w0;
w1:=procentry;
(w1).buffer:=w0:=(w1).buffer+50;
!test 22;
outtext(.w3.,w0:=8'70,w1,w2:=19); ! enrolled !
(w1).buffer:=w0:=(w1).buffer-50;
(w1).buflength:=w0:=40;
w0:=1;
(w1).messsend:=w0;
w1:=0;
end ! go/run/batch !
else
if w0 = 3 then ! in - connect terminal to pool !
begin
checkprot(.w3.,w1:=string4,w2:=b.termdescr+!position(userkey));
if w1 <> 0 then goto error1;
rewrite:=w2;
! generate poolname: "tem<termname>" !
copy(.w3.,w0:=2,w1:=address(b.t_mdul),w2:=address(poolname));
copy(.w3.,w0:=6,w1:=string2,w2+2);
termpda:=w0:=(w1:=b.userentry).peripheral;
localid:=w0:=(w3:=b.termdescr).intid;
simlocid:=w0;
bufs:=w0:=(w3).tbufs;
timers:=w0:=(w3).ttimers;
temop:=w0:=100; ! create link !
w1:=address(temop);
w3:=address(poolname);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
if w0 or (w1).word <> 1 then
begin
if w1:=w0 and 8'1020 <> 0 then w2:=8 ! busy !
else w2:=9; ! terminal connection error !
!test 23;
outtext(.w3.,w0:=8'31,w1:=procentry,w2);
goto error1;
end;
copy(.w3.,w0:=8,w1:=termpda+2,w2:=address(trmname));
simfirst:=w1:=address(simlocid);
simlast:=w1:=address(nl);
simop:= w0:= 9;
w1:=address(simop);
w3:=address(poolname);
monitor(16); ! send message (simulate input) !
answ(w1:=1);
monitor(18); ! wait answer !
!test 24;
outtext(.w3.,w0:=8'30,w1:=procentry,w2:=11); ! terminal connected !
end else;
if w2:=rewrite <> 0 then
begin
help:=w1;
first:=w0:=b.topcore-512;
last:=w0:=b.topcore-2;
transport(.w2.,w1:=address(logop),w3:=address(b.usercat));
w1:=help;
end;
goto release;
error4:
w3:=string2;
monitor(64); ! remove child process !
error3:
b.freebufs:=w0:=b.freebufs+buffers;
error2:
help:=w1;
f1:=stdbase;
w3:=address(zero);
monitor(72); ! set own catalog base !
w3:=address(b.p_mdul);
monitor(64); ! remove process !
w1:=help;
error2_1:
help:=w1;
f1:=stdbase;
w3:=address(zero);
monitor(72); ! set sos catalog base !
w3:=address(b.t_mdul);
monitor(64); ! remove pseudo process !
w1:=help;
release:
error1:
w3:=address(b.usercat);
monitor(10); ! release usercat !
error:
w0:=savew0;
f3:=savef3;
end; ! login !
\f
body of scancat
begin
label procfound,newsegm,termfound,exit;
incode
ref procname,termname,return;
array(1:!length(procdescr)) process of byte;
byte logop,logmode:=0;
ref first,last;
word segm,proc_no,savew1,logstop,zero:=0;
begin
procname:=w1;
termname:=w2;
return:=w3;
w3:=address(zero);
f1:=b.startbase;
w0:=w1;
monitor(72); ! set own cat base !
w3:=address(b.usercat);
monitor(8); ! reserve process, i.e. open(z,4,<:soscat:>,0) !
if w0 <> 0 then
begin
w0:=-3;
goto exit;
end;
first:=w0:=b.topcore-512;
last:=w0:=b.topcore-2;
logop:=w0:=3;
segm:=w0:=0;
w1:=address(logop);
transport(.w2.,w1,w3);
w3:=b.topcore-2;
proc_no:=w3:=(w3-4).word;
w1:=0;
w2:=b.topcore-512-!length(prindex);
while w1+1<=proc_no do
begin
w3:=0;
w0:=w1;
if f0 mod 50=1 then
if w1<>1 then
begin
segm:=w0;
savew1:=w1;
w1:=address(logop);
w3:=address(b.usercat);
transport(.w2.,w1,w3);
w1:=savew1;
w2:=b.topcore-512-!length(prindex);
end;
w2+!length(prindex);
savew1:=w1;
compare(.w3.,w0:=8,w1:=procname,w2);
if w0 = 0 then goto procfound;
w1:=savew1;
end;
w0:=-1;
goto exit;
procfound:
segm:=w1:=(w2).prsegmno;
w1:=address(logop);
w3:=address(b.usercat);
transport(.w2.,w1,w3);
w1:=b.topcore-512;
process(w2:=1);
copy(.w3.,w0:=!length(procdescr),w1,w2);
testout(.w3.,w0,w1,w2:=68);
! find terminal in soscat !
if w2:=termname = 0 then
begin
w0:=segm;
goto exit;
end;
w2:=b.topcore-512;
w2+!length(procdescr);
w2-!length(termdescr);
w3:=b.topcore-!length(termdescr);
logstop:=w3;
newsegm:
!test 540;
while w2+!length(termdescr)<logstop do
begin
if w1:=(w2).word=-1 then w2:=logstop
else begin
compare(.w3.,w0:=8,w1:=termname,w2);
if w0=0 then goto termfound;
end;
end;
w2:=b.topcore-2;
if w0:=(w2).word<>-1 then
begin
segm:=w0;
w1:=address(logop);
w3:=address(b.usercat);
transport(.w2.,w1,w3);
w2:=b.topcore-512;
w2-!length(termdescr);
goto newsegm;
end;
w0:=-2;
goto exit;
termfound:
b.termdescr:=w2;
testout(.w3.,w0:=!length(termdescr),w1:=w2,w2:=68);
process(w1:=1);
w2:=b.termdescr;
w0:=segm;
exit:
w3:=return;
end;
end; ! scancat !
\f
body of checkprot
begin
label bad_passw, exit, found;
incode
text(11) pass:="pass",newpass:="newpass",emptytext:="",
pass2:="password", passtxt:=">password ";
ref password,return;
begin
return:=w3;
password:=w2; ! addr of correct password !
compare(.w3.,w0:=8,w1,w2:=address(pass));
if w0 <> 0 then
begin
compare (.w3., w0:=8, w1, w2:=address(pass2));
if w0=0 then goto found;
compare(.w3.,w0:=8,w1,w2:=address(emptytext));
if w0 <> 0 then
begin
!test 25;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto exit;
end;
w2:=w1; ! addr of read passw:= addr of empty param !
end else
begin
found:
w2:= w1+8; ! addr of password param !
end;
w1:=password;
compare(.w3.,w0:=8,w1,w2);
if w0 <> 0 then
begin
compare (.w3., w0:=8, w1:=address(emptytext), w2);
w1:= b.userentry;
if w0<>0 then ! password param <> empty !
begin
bad_passw:
!test 26;
outtext(.w3.,w0:=8'31,w1,w2:=13); ! bad password !
goto exit;
end else
if w0:=(w1).state = -3 then goto bad_passw
else
begin ! password must be typed invisible !
(w1).state:= w0:= -3; ! awaiting password !
(w1).bufrel:= w0:= (w1).buflength;
w2:= (w1).buffer + w0; ! start addr !
(w1).buflength:= w0:= 8;
copy (.w3., w0, w1:=address(passtxt), w2);
testout (.w3., w0, w1, w2:=0);
checkdevice (.w3., w0, w1:=b.userentry);
b.passmode:= w0; ! 0 = console (deviceno=2)
2 = other terminal !
w0:= (w1).bufrel;
-(w0);
send (.w3., w0, w1, w2:=20480);
(w1).bufrel:= w0:= (w1).bufrel + 8;
-(w0);
(w1).buflength:= w3:= b.maxbuf - (w1).bufrel;
send (.w3., w0, w1, w2:=12288+b.passmode);
! read password without echo, mode=2 !
link(.w3.,w1,w2:=address(b.waitqfst));
w3:= address(b.usercat);
monitor(10); ! release usercat !
goto b.continue;
end;
end;
compare(.w3.,w0:=8,w1:=address(newpass),w2+8);
if w0 <> 0 then
begin
compare(.w3.,w0:=8,w1:=address(emptytext),w2);
if w0 <> 0 then
begin
!test 27;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto exit;
end;
w2:=0; ! rewrite:= false !
end else
begin
w1:=w2+8;
if w0:=(w1).word < 0 then
begin
!test 28;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto exit;
end;
copy(.w3.,w0:=8,w1:=w2+8,w2:=password);
w2:=1; ! rewrite:= true !
end;
w1:=0;
exit:
w3:=return;
end;
end; ! checkprot !
\f
body of checkdevice
begin
incode
double w12;
word return;
begin
w12:= f2;
return:= w3;
w3:=74; ! ref to name table !
w3:=(w3).word+4; ! ref to proc.descr. of device 2 !
w2:=(w3).word+2; ! - - - name - - !
w1:=(w1).peripheral;
if w1<0 then -(w1); ! ref to proc.descr. of terminal !
w1+2; ! - - - name - - !
compare(.w3., w0:=8, w1, w2);
if w0<>0 then w0:=8;
f2:=w12;
w3:=return;
end;
end; ! checkdevice !
end; ! login !
\f
body of out
begin
label return;
record cont_ans ( word stat,l_id,perif,buftimer,pool);
incode
word savew0;
double savef3;
byte temop,temmode:=0;
ref first,last;
word simlocid;
text(28) simtxt:="'2''2' out '10'";
array(1:8) answ of word;
text(14) emptytext:="",namebuf:="";
byte op1:=106,mode1:=0; ! lookup term !
word locid,peri;
begin
savew0:= w0;
savef3:= f3;
compare(.w3.,w0:=8,w1+8,w2:=address(emptytext));
if w0<>0 then
begin
!test 29;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto return;
end;
w0:= (w1:=b.userentry).peripheral;
peri:=w0;
w1:= address(op1);
w3:= address(b.t_mdul);
monitor(16); ! send message !
w1:= b.lastuser;
monitor(18); ! wait answer !
if w0 or (w1).stat<>1 then
begin ! terminal not known !
!test 30;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=14); ! not connected !
goto return;
end;
locid:= w0:= (w1).l_id;
simlocid:=w0;
copy(.w3.,w0:=8,w1:=(w1).pool+2,w2:=address(namebuf));
temop:=w0:=9; ! simulate input !
first:=w0:=address(simlocid);
w0+8;
last:=w0;
w1:=address(temop);
w3:=address(namebuf);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
!test 901;
op1:=w0:=102; ! remove link (soft) !
w1:=address(op1);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
!test 31;
if w0 or (w1).word = 1
then outtext(.w3.,w0:=8'30,w1:=b.userentry,w2:=12) ! terminal disconnected !
else outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=16); ! disconnection not ok !
return:
w0:= savew0;
f3:= savef3;
end;
end; ! out !
\f
body of control
begin
label error,found;
incode
ref string1,string2,string3,string4;
word savew0,savew1;
double savef3;
text(11) emptytext:="",all:="all";
byte temop,temmode;
word localid;
ref termpda;
byte bufs,timers;
ref poolpda;
word recfull,bytesfree,dummy,allcommand:=0;
byte stopop:=16,stopmode:=1;
text(20) stoptxt:="system closed";
byte empop:=16,empmode:=0;
text(20) emptxt:="system empty";
begin
savew0:=w0; ! control operation: 1=kill -1=lock
2=break -2=open
3=stop -3=halt
4=start !
savef3:=f3;
string1:=w1; w1+8;
string2:=w1; w1+8;
string3:=w1; w1+8;
string4:=w1;
!test 700;
w1:=address(b.operator);
w2:=string2;
compare(.w3.,w0:=8,w1,w2);
if w0<>0 then
begin
w1:=address(emptytext);
compare(.w3.,w0:=8,w1,w2);
if w0<>0 then
begin
compare(.w3.,w0:=8,w1,w2:=string3);
if w0 <> 0 then
begin
!test 33;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
w3:=string2;
monitor(4); ! get process description !
!test 995;
if w0 = 0 then
begin
!test 34;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=15); ! process unknown !
goto error;
end;
w1:=b.lastuser;
w3:=b.userentry;
while w1-!length(userentry) >= b.firstuser do
begin
if w0 = (w1).internal then
if w2:=(w1).primdevi = (w3).peripheral then goto found;
end;
!test 35;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=15); ! process unknown !
goto error;
end;
! controlled by own terminal !
w1:=b.userentry;
if w0:=(w1).state = -1 then
begin
found:
if w3:=savew0 <= 0 then
begin
!test 36;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=7); ! forbidden !
link(.w3.,w1,w2:=address(b.activqfst));
w1:= -1;
goto error;
end;
case w3:=savew0 of
begin
begin ! user kill !
(w1).intervent:=w0:=3;
clean(.w3.,w1);
end;
begin ! user break !
break(.w3.,w1);
if w3:= b.syscond zeromask 2'010 then
begin
if w3:= (w1).peripheral>0 then w0:= -1
else w0:= 7;
end else w0:= 7;
(w1).intervent:=w0;
end;
begin ! stop !
link(.w3.,w1,w2:=address(b.waitqfst));
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
(w1).messsend:=w0;
(w1).state:=w0:=0;
end;
begin ! start !
link(.w3.,w1,w2:=address(b.activqfst));
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
(w1).messsend:=w0;
(w1).state:=w0:=0;
end;
end;
w1:=-1;
goto error;
end;
temop:=w0:=106; ! lookup terminal !
temmode:=w0:=0;
termpda:=w0:=(w1:=b.userentry).peripheral;
w1:=address(temop);
w3:=address(b.t_mdul);
monitor(16); ! send message !
monitor(18); ! wait answer !
if w0 or (w1).word <> 1 then
begin
!test 37;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=14); ! not connected !
goto error;
end;
w0:=poolpda;
w1:=b.firstuser-!length(userentry);
while w1+!length(userentry) < b.lastuser do
begin
if w0 = (w1).peripheral then goto found;
end;
!test 38;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=15); ! process unknown !
goto error;
end
else begin
! controlled by operator !
if w0:=(w1:=b.userentry).peripheral <> b.mainconsref then
begin
!test 39;
outtext(.w3.,w0:=8'31,w1,w2:=7); ! forbidden !
goto error;
end;
w1:=address(emptytext);
compare(.w3.,w0:=8,w1,w2:=string4);
if w0 <> 0 then
begin
!test 40;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
if w0:=savew0 <= 0 then
begin
compare(.w3.,w0:=8,w1:=address(emptytext),w2:=string3);
if w0 <> 0 then
begin
!test 41;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
if w0:=savew0 = -1 then ! lock !
begin
b.sysstate:=w0:=1;
w1:=b.lastuser;
w0:=0;
while w1-!length(userentry) >= b.firstuser do
begin
if w3:=(w1).internal > 0 then
if w3:=(w3).word = 0 then w0+1;
end;
if w0 = 0 then opmess(.w3.,w1:=address(empop),w2:=b.ownproc);
end else
if w0 = -2 then ! open !
begin
b.sysstate:=w0:=0;
end else
if w0 = -3 then ! halt !
begin
opmess(.w3.,w1:=address(stopop),w2:=b.ownproc);
end else
;
w1:=-1;
goto error;
end;
compare(.w3.,w0:=8,w1,w2:=string3);
if w0 = 0 then
begin
!test 42;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto error;
end;
w1:=b.firstuser-!length(userentry);
while w1+!length(userentry)<b.lastuser do
begin
!test 710;
savew1 :=w1;
w1:=(w1).internal+2;
compare(.w3.,w0:=8,w1,w2:=string3);
if w0 <> 0 then
begin
compare(.w3.,w0:=8,w1:=address(all),w2);
if w0 = 0 then allcommand:=w3:=1;
end;
w1:=savew1;
if w0=0 then
begin
if w3:=(w1).internal > 0 then
if w0:=(w3).word = 0 then
case w3:=savew0 of
begin
begin ! operator kill !
(w1).intervent:=w0:=4;
clean(.w3.,w1);
end;
begin ! operator break !
break(.w3.,w1);
if w3:= b.syscond zeromask 2'010 then
begin
if w3:= (w1).peripheral>0 then w0:= -1
else w0:= 8;
end else w0:= 8;
(w1).intervent:=w0;
end;
begin ! stop !
link(.w3.,w1,w2:=address(b.waitqfst));
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
(w1).messsend:=w0;
(w1).state:=w0:=0;
end;
begin ! start !
if w0:=(w1).class+b.timerloss < b.batchclass then
begin ! link to front of batch queue !
if w1 <> b.batchqfst then link(.w3.,w1,w2:=address(b.batchqfst));
end else link(.w3.,w1,w2:=address(b.activqfst));
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
(w1).messsend:=w0;
(w1).state:=w0:=0;
end;
end;
w1:=-1;
if w0:=allcommand <> 1 then goto error;
w1:=savew1;
end;
end;
!test 43;
if w0:=allcommand <> 1
then outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=15) ! process unknown !
else w1:=-1;
goto error;
end;
w1:=-1;
error:
w0:=savew0;
f3:=savef3;
end;
end; ! control !
\f
body of empty
begin
incode
word savew0;
double savef3;
begin
savew0:=w0;
savef3:=f3;
w1:=-1;
w0:=savew0;
f3:=savef3;
end;
end; ! empty !
\f
body of calldev
begin
label syntaxerror,exit;
record callparam (word pkind,pvalue);
incode
word savew0,work;
double savef3;
ref string1,string2,string3,string4,string5,string6;
text(11) emptytext:="",start:="start",proc;
begin
savew0:=w0;
savef3:=f3;
string1:=w1; w1+8;
string2:=w1; w1+8;
string3:=w1; w1+8;
string4:=w1; w1+8;
string5:=w1; w1+8;
string6:=w1;
if w0:=string2.pkind <> -1 then goto syntaxerror;
compare(.w3.,w0:=8,w1:=string3,w2:=address(emptytext));
if w0 = 0 then goto syntaxerror;
w1:=string2.pvalue;
w3:=string3;
monitor(54); ! create peripheral process !
!test 111;
if w0 <> 0 then
if w0 <> 3 then
begin
!test 44;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=17); ! call not accepted !
goto exit;
end;
copy(.w3.,w0:=8,w1:=address(emptytext),w2:=string3);
include(.w3.,w1:=string1);
if w1 <> -1 then goto exit;
compare(.w3.,w0:=8,w1:=string4,w2:=address(emptytext));
if w0 = 0 then
begin
w1:=-1;
goto exit;
end;
compare(.w3.,w0:=8,w1,w2:=address(start));
if w0 = 0 then
begin
copy(.w3.,w0:=8,w1:=string4,w2:=string1);
copy(.w3.,w0,w1:=string5,w2:=string2);
copy(.w3.,w0,w1:=string6,w2:=string3);
copy(.w3.,w0,w1:=address(emptytext),w2:=string4);
control(.w3.,w0:=4,w1:=string1);
goto exit;
end;
syntaxerror:
!test 45;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
exit:
w0:=savew0;
f3:=savef3;
end;
end; ! calldev !
\f
body of include
begin
label exit;
record param(word pkind,pvalue);
incode
text(11) proc,emptytext:="";
double savef3;
ref string1,string2,string3;
word work,savew0;
begin
savew0:=w0;
savef3:=f3;
string1:=w1; w1+8;
string2:=w1; w1+8;
string3:=w1;
compare(.w3.,w0:=8,w1,w2:=address(emptytext));
if w0 <> 0 then
begin
!test 46;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto exit;
end;
w1:=string2;
if w0:=(w1).pkind <> -1 then
begin
!test 47;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=2); ! syntax !
goto exit;
end;
w3:=b.lastuser;
w2:=address(proc);
while w3-!length(userentry) >= b.firstuser do
begin
if w1:=(w3).internal > 0 then
begin
work:=w3;
if w0:=(w1).word = 0 then
begin
copy(.w3.,w0:=8,w1+2,w2);
w3:=w2;
w1:=string2.pvalue;
monitor(12); ! include user !
if w0 <> 0 then
begin
!test 48;
outtext(.w3.,w0:=8'31,w1:=b.userentry,w2:=18); ! include not accepted !
goto exit;
end;
end;
w3:=work;
end;
end;
w1:=-1;
exit:
w0:=savew0;
f3:=savef3;
end;
end; ! include !
end; ! syscommand !
\f
comment break
when a process is too cpu bound or when the terminal operator asks for
it, the system will provoke a break of the process (break 8 = parent break)
this is done by modifying the process using the dumped registers in the
process description and then restart the process in its break routine
;
body of break
begin
label exit;
record dumparea(word r0,r1,r2,r3,exep,instr,cause);
incode
double savef1,savef3;
word bufferrel,savedic;
text(14) childname,terminal;
byte ioop,iomode:=0;
word first,last,segmnt;
begin
savef1:=f1;
savef3:=f3;
if w0:=(w1).intervent = 0 then
begin
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
if w0:=b.syscond zeromask 2'010 then
if w0:=(w1).peripheral > 0 then
begin
(w1).state:= w0:= 3;
(w1).state2:= w0:= -1;
startstop (.w3., w0:=0, w1); ! stop !
w1:= (w1).internal+2; ! ref process name !
scancat (.w3., w0, w1, w2:=0);
if w0 < 0 then
begin
if w0 = -3 then w2:=30 ! usercat reserv !
else w2:=3; ! ident illegal !
!test 50;
outtext (.w3., w0:=8'31, w1:=b.userentry, w2);
(w1).state2:= w0:= 1; ! waiting for remove process !
goto exit;
end;
b.procdescr:= w1;
w3:= address(childname);
f1:= savef1;
w2:= (w1).internal + 2; ! ref process name !
(w3).name1:= f1:= (w2).name1;
(w3).name2:= f1:= (w2).name2;
w2:= b.procdescr;
w0:= (w2).procub1; ! user base from soscat !
w1:= (w2).procub2;
monitor(72); ! reset catalog base = user base !
link (.w3., w1:=b.userentry, w2:=address(b.activqfst));
goto exit;
end;
(w1).intervent:=w0:=-1;
w2:=(w1).internal+b.relintrpt;
if w0:=(w2).word >= b.fstcore then
begin comment interrupt address is set;
savedic:=w0+16;
w0:=(w2).word;
w0-b.fstcore;
bufferrel:=w3:=w0 extract 9;
segmnt:=w0 lshift -9 + (w1).swopsegm;
ioop:=w0:=3;
w1:=address(ioop);
w3:=address(b.swname);
w0:=b.topcore;
last:=w0;
w0-1022;
first:=w0;
monitor(16); comment send message;
w1:=b.lastuser;
monitor(18); comment wait answer;
key (0):= w0; ! test 0 !
f1:=savef1;
w3:=address(childname);
w2:=(w1).internal+2;
(w3).name1:=f1:=(w2).name1;
(w3).name2:=f1:=(w2).name2;
f1:=savef1;
w1:=(w1).internal+b.reldump;
w2:=first+bufferrel;
copy(.w3.,w0:=16,w1,w2);
(w2).cause:=w0:=8;
(w2).exep:=w0:=0;
w0:=savedic;
savedic:=w1:=(w2).instr;
(w2).instr:=w0;
testout(.w3.,w0:=16,w1:=w2,w2:=1);
w3:=address(childname);
monitor(62); comment modify process;
(w1).instr:=w0:=savedic;
ioop:=w0:=5;
w1:=address(ioop);
w3:=address(b.swname);
monitor(16); comment send message;
w1:=b.lastuser;
monitor(18); comment wait answer;
f1:=savef1;
(w1).state:=w0:=0;
link(.w3.,w1,w2:=address(b.activqfst));
goto exit;
end;
end;
comment kill because of no reaction after break;
startstop(.w3.,w0:=0,w1);
clean(.w3.,w1);
exit:
w3:= address(b.usercat);
monitor(10); ! release usercat !
f1:=savef1;
f3:=savef3;
end;
end; ! break !
\f
comment continue mcl
An appropiate text is send mcl indicating the reason of exit from the
sos operating system;
body of continuemcl
begin
incode
double savef1, savef3;
text (14) cmt00 := "command unkn. ",
cmt01 := "ready ",
cmt02 := "syntax ",
cmt03 := "ident illegal ",
cmt04 := "no room ",
cmt05 := "claims exeeded",
cmt06 := "creation error",
cmt07 := "forbidden ",
cmt08 := "terminal busy ",
cmt09 := "terminal conn.",
cmt10 := "no jobfile ",
cmt11 := "connected ",
cmt12 := "terminal disc.",
cmt13 := "bad password ",
cmt14 := "not connected ",
cmt15 := "process unkn. ",
cmt16 := "no disconnect ",
cmt17 := "call not ok ",
cmt18 := "include not ok",
cmt19 := " ", ! enrolled !
cmt20 := "break ",
cmt21 := "finis ",
cmt22 := "user kill ",
cmt23 := "operator kill ",
cmt24 := "time exeeded ",
cmt25 := "terminal error",
cmt26 := "user break ",
cmt27 := "operator break",
cmt28 := "user conflict ",
cmt29 := "system locked ",
cmt30 := "usercat resrvd";
word mcl_mess0 := 524288 , ! continue mcl !
mcl_mess2, ! local id !
mcl_mess4 := 49167,! length of op, text !
mcl_mess6, ! reason text !
m8,m10,m12,m14; ! reason text continued !
begin
savef1:= f1;
savef3:= f3;
w0*10; ! offset to text depending on reson (w0) !
w1:= address (cmt00); w1+w0;
copy (.w3., w0:= 10, w1, w2:= address (mcl_mess6));
if w0:= mcl_mess6 <> 2105376 then
begin
f1:= savef1;
w2:= (w1).peripheral;
if w2 < 0 then -(w2); w2 + 2;
w3:= address (b.procname);
(w3).name1:= f1:= (w2).name1;
(w3).name2:= f1:= (w2).name2;
w1:= address (mcl_mess0);
monitor (16);
f1:= savef1;
(w1).messsend:= w2;
testout (.w3., w0:= 6, w1:= address (mcl_mess0), w2:= 2);
testout (.w3., w0:=10, w1+6, w2:= 0);
end;
f1:= savef1;
f3:= savef3;
end;
end; ! continue mcl !
\f
comment parentmess
the use of devices (not accessible directly from the user-processes)
and the control of the processes themselves is partially based on parent
messages. this procedure takes the actions corresponding to the possible kinds
of parent messages - these possible kinds are:
break
finis terminates the current processing and removes the process
mount
;
body of parentmessage
begin
label unknown,mounted,mountmess;
record cont_ans ( word stat,l_id,perif);
incode
double w01,w23;
text(11) string1;
ref firstdev:=74,lastdev:=76;
byte temop,temmode;
word locid,dum1,dum2;
text(14) poolname;
array (1:8) answ of word;
word zero:=0;
byte emptyop:=16,emptymode:=0;
text(20) emptytxt:="system empty";
begin
w01:=f1; w23:=f3;
w0:=0;
b.timermess:=w0;
startstop(.w3.,w0:=0,w1);
if w0:=(w2).operation=2 then comment finismessage;
begin
send(.w3.,w0:=1,w1,w2:=0);
if w0:=(w1).state2<=0 then
begin
(w1).intervent:=w0:=2;
clean(.w3.,w1);
end
else begin
!test 49;
outtext(.w3.,w0:=8'70,w1,w2:=(w1).intervent+19);
! removed after break / finis / user kill / opt.kill /
time exc. / term.error / user break / opt.break !
copy(.w3.,w0:=8,w1:=(w1).internal+2,w2:=address(b.procname));
w1:=(w1:=b.userentry).internal+76;
f1:=(w1).double;
w3:=address(zero);
monitor(72); ! set sos catalog base to stdbase of child !
!test 440;
w3:=address(b.t_mdul);
monitor(64); ! remove pseudo process !
w3:=address(b.p_mdul);
monitor(64); ! remove pseudo process !
!test 441;
w3:=address(zero);
f1:=b.startbase;
monitor(72); ! reset sos own cat base !
w1:=b.ownproc+26;
b.freebufs:=w0:=b.freebufs-(w1).byte;
w3:=address(b.procname);
monitor(64); comment remove internal process;
!test 110;
b.freebufs:=w0:=b.freebufs+(w1).byte;
copy(.w3.,w0:=6,w1:=address(b.procname),w2:=address(poolname)+2);
w0:= 0;
b.baseevent:= w0;
copy(.w3.,w0:=2,w1:=b.ownproc+2,w2:=address(poolname));
temop:=w0:=102; ! remove link (soft) !
locid:=w1:=0;
w3:=address(poolname);
w1:=address(temop);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
temop:=w0:=92; ! remove pool !
w3:=address(b.t_mdul);
w1:=address(temop);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
copy(.w3.,w0:=2,w1:=address(b.t_mdul),w2:=address(poolname));
w1:=address(temop);
w3:=address(b.t_mdul);
monitor(16); ! send message !
answ(w1:=1);
monitor(18); ! wait answer !
w1:=b.userentry;
link(.w3.,w1,w2:=address(b.waitqfst));
w0:=0;
(w1).peripheral:=w0;
(w1).internal:=w0;
(w1).messsend:=w0;
(w1).messgot:=w0;
(w1).intervent:=w0;
if w0:=b.sysstate = 1 then
begin
w1:=b.lastuser;
w0:=0;
while w1-!length(userentry) >= b.firstuser do
begin
if w3:=(w1).internal > 0 then
if w3:=(w3).word = 0 then w0+1;
end;
if w0 = 0 then opmess(.w3.,w1:=address(emptyop),w2:=b.ownproc);
end;
end;
end else
if w0=4 then comment break message;
begin
send(.w3.,w0:=1,w1,w2:=0);
if w0:=(w1).intervent = -1 then (w1).intervent:=w0:=1;
if w0 = 0 then (w1).intervent:=w0:=1;
clean(.w3.,w1);
end else
if w0 = 14 then comment mount message;
begin
mountmess:
copy(.w3.,w0:=8,w1:=w2+16,w2:=address(string1));
w3:=address(string1);
monitor(4); ! get process description !
if w0 <> 0 then
begin
w1:=word(firstdev);
while w1+2 <= word(lastdev) do
begin
if w0 = (w1).word then
begin
w3:=address(b.procname);
w1-word(firstdev) lshift -1;
monitor(12); ! include user !
if w0 = 0 then
begin
f1:=w01;
(w1).state:=w0:=0;
link(.w3.,w1,w2:=address(b.activqfst));
send(.w3.,w0:=1,w1,w2:=0);
goto mounted;
end;
end;
end;
end;
f1:=w01;
f3:=w23;
goto unknown;
mounted:
end else
if w0 = 32 then goto mountmess
else
begin comment parent message unknown;
unknown:
(w1).state:=w0:=0;
w2:=(w1).internal;
opmess(.w3.,w1:=b.message+8,w2);
if w0:=(w1).word onemask 1 then w2:=address(b.waitqfst)
else w2:=address(b.activqfst);
f1:=w01;
link(.w3.,w1,w2);
send(.w3.,w0:=1,w1,w2:=0);
end;
w3:=address(zero);
f1:=b.startbase;
monitor(72); ! rset sos own catalog base !
f1:=w01; f3:=w23;
end;
end; ! parentmessage !
\f
comment clean
;
body of clean
begin
incode
double savef1, savef3;
double corelimits;
byte buffers, areas;
byte internals:=0, fncmask:=1792;
byte protreg, protkey;
double maxbase, stdbase;
begin
savef1:=f1; savef3:=f3;
if w0:=(w1).messgot > 10 then
begin
empty_answer(.w3.,w0:=1,w1,w2:=0);
end;
copy(.w3.,w0:=8,w1:=(w1).internal+2,w2:=address(b.procname));
w2 := b.fstcore;
w3 := b.topcore - b.fstcore;
w3 lshift -11 lshift 11; ! make size a 2K multiplum !
w3 + b.fstcore;
corelimits:=f3;
protreg:=w3:=b.childpr;
protkey:=w3:=b.childpk;
w2:= b.ownproc;
buffers:= -(w3:=(w1:=w2+26).byte);
areas:= -(w3:=(w1:=w2+27).byte);
f1:= savef1;
w0:= (w1).internal;
maxbase:=f3:=(w1:=w0+72).double;
stdbase:=f3:=(w1:=w0+76).double;
w3:=address(b.procname);
monitor(64); comment remove internal;
!test 100;
w2:= b.ownproc;
buffers:= w0:= buffers+(w1:=w2+26).byte;
areas:= w0:= areas+(w1:=w2+27).byte;
w1:=address(corelimits);
monitor(56); comment create internal;
!test 102;
f1:=savef1;
monitor(4); comment lookup process;
(w1).internal:=w0;
(w1).state:=w0:=3;
(w1).state2:=w0:=1;
(w1).prio:=w0:=0;
(w1).class:=w0;
(w1).messsend:=w0;
(w1).messgot:=w0;
link(.w3.,w1,w2:=address(b.activqfst));
f1:=savef1;
f3:=savef3;
end;
end; ! clean !
\f
comment compare
;
body of compare
begin
incode
word savew1;
double savef3;
begin
savew1:=w1; savef3:=f3;
w3:=w1+w0;
w0:=0;
while w1<w3 do
begin
w0:=(w1).word;
w0-(w2).word;
w1+2;
w2+2;
if w0<>0 then w1:=w3;
end;
w1:=savew1;
f3:=savef3;
end;
end; ! compare !
\f
comment nextchar
;
body of nextchar
begin
label dummy1;
begin
if w1=0 then
if w2=(w3).stp then w1:=10 ashift 16 ! simulate 'nl' at end of buffer !
else begin
w1:=(w2).word;
w2+2;
end;
w0:=0;
f1 lshift 8;
if w0=13 then w0:= 10; ! convert <cr> to <nl> to avoid !
! syntax error reading in mode 2 !
end;
end;
end.
▶EOF◀