(* ------------------- VERSION 9 vom 09.06.86 ------------------- *)
PACKET tasks DEFINES (* Autor: J.Liedtke *)
TASK ,
PROCA ,
:= ,
= ,
< ,
/ ,
niltask ,
is niltask ,
exists ,
exists task ,
supervisor ,
myself ,
public ,
proca ,
collector ,
access ,
name ,
task ,
canal ,
dataspaces ,
index ,
station ,
update ,
father ,
son ,
brother ,
next active ,
access catalogue ,
family password ,
task in catalogue ,
entry ,
delete ,
define station ,
pcb ,
status ,
channel ,
clock ,
storage ,
callee ,
send ,
wait ,
call ,
pingpong ,
collected destination ,
begin ,
end ,
break ,
continue ,
rename myself ,
task password ,
set autonom ,
reset autonom ,
set automatic startup ,
reset automatic startup ,
sys cat :
LET nil = 0 ,
max version = 30000 ,
max task = 125 ,
max station no = 127 ,
sv no = 1 ,
hex ff = 255 ,
hex 7f00 = 32512 ,
collected dest field 1 = 2 ,
collected dest field 2 = 3 ,
channel field = 4 ,
myself no field = 9 ,
myself version field = 10 ,
callee no field = 11 ,
callee version field = 12 ,
highest terminal channel = 16 ,
number of channels = 32 ,
wait state = 2 ,
ack = 0 ,
nak = 1 ,
error nak = 2 ,
system catalogue code = 3 ,
begin code = 4 ,
end code = 5 ,
break code = 6 ,
rename code = 7 ,
password code = 9 ,
family password code = 40 ,
set autonom code = 41 ,
reset autonom code = 42 ,
task of channel code = 45 ,
canal of channel code = 46 ,
set automatic startup code = 47 ,
reset automatic startup code = 48 ,
continue code = 100,
define station code = 32000,
lowest ds number = 4 ,
highest ds number = 255 ;
TYPE TASK = STRUCT (INT no, version) ,
PROCA = STRUCT (INT a, b) ;
OP := (PROCA VAR right, PROCA CONST left) :
CONCR (right) := CONCR (left)
ENDOP := ;
PROCA PROC proca (PROC p) :
push (0, PROC p) ;
pop
ENDPROC proca ;
PROC push (INT CONST dummy, PROC p) : ENDPROC push ;
PROCA PROC pop :
PROCA VAR res;
res
ENDPROC pop ;
TASK CONST niltask := TASK: (0,0) ,
collector := TASK: (-1,0) ;
TASK PROC supervisor :
TASK: (my station id + sv no, 0) .
my station id : pcb (myself no field) AND hex 7f00 .
ENDPROC supervisor ;
TASK VAR father task ;
INITFLAG VAR catalogue known := FALSE , father known := FALSE ;
LET TASKVECTOR = STRUCT (INT version, father, son, brother) ;
DATASPACE VAR catalogue space , sv space ;
BOUND STRUCT (THESAURUS dir,
ROW max task TASKVECTOR link) VAR system catalogue ;
initialize catalogue ;
BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg ;
PROC initialize catalogue :
catalogue space := nilspace ;
system catalogue := catalogue space ;
system catalogue.dir := empty thesaurus ;
insert (system catalogue.dir, "SUPERVISOR") ;
insert (system catalogue.dir, "UR") ;
system catalogue.link (1) := TASKVECTOR:(0,0,0,2) ;
system catalogue.link (2) := TASKVECTOR:(0,0,0,0) .
ENDPROC initialize catalogue ;
DATASPACE PROC sys cat :
catalogue space
ENDPROC sys cat ;
TASK PROC myself :
TASK: (pcb (myself no field), pcb (myself version field))
ENDPROC myself ;
OP := (TASK VAR dest, TASK CONST source):
CONCR (dest) := CONCR (source)
ENDOP := ;
BOOL OP = (TASK CONST left, right) :
left.no = right.no AND left.version = right.version
ENDOP = ;
BOOL PROC is niltask (TASK CONST t) :
t.no = 0
ENDPROC is niltask ;
BOOL OP < (TASK CONST left, right) :
IF both of my station
THEN access (left) ;
access (right) ;
( index (left) > 0 CAND index (left) <= max task )
CAND
( father (left) = right COR father (left) < right )
ELSE FALSE
FI .
both of my station :
station (left) = station (right) AND station (right) = station (myself) .
ENDOP < ;
BOOL PROC exists (TASK CONST task) :
EXTERNAL 123
ENDPROC exists ;
BOOL PROC exists task (TEXT CONST name) :
task id (name).no <> 0
ENDPROC exists task ;
TEXT PROC name (TASK CONST task) :
IF is task of other station
THEN external name (task)
ELSE
access (task) ;
INT CONST task no := index (task) ;
IF task in catalogue (task ,task no)
THEN name (system catalogue.dir, task no)
ELSE ""
FI
FI.
is task of other station :
(task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
ENDPROC name ;
BOOL PROC task in catalogue (TASK CONST task, INT CONST task no) :
access catalogue ;
task no >= 1 CAND task no <= max task CAND
task.version = system catalogue.link (task no).version .
ENDPROC task in catalogue ;
PROC access (TASK CONST task) :
INT CONST task no := task.no AND hex ff ;
IF task no < 1 OR task no > max task
THEN
ELIF is task of other station
THEN errorstop ("TASK anderer Station")
ELIF actual task id not in catalogue COR NOT exists (task)
THEN access catalogue
FI .
actual task id not in catalogue :
NOT initialized (catalogue known) COR
( task no > 0 CAND catalogue version <> task.version ) .
catalogue version : system catalogue.link (task no).version .
is task of other station :
(task.no AND hex 7f00) <> (pcb (myself no field) AND hex 7f00) .
ENDPROC access ;
TASK PROC task (TEXT CONST task name) :
TASK CONST id := task id (task name) ;
IF id.no = 0
THEN errorstop (""""+task name+""" gibt es nicht")
FI ;
id
ENDPROC task ;
TASK PROC task id (TEXT CONST task name) :
IF task name = "-" OR task name = ""
THEN errorstop ("Taskname unzulaessig")
FI ;
IF NOT initialized (catalogue known)
THEN access catalogue
FI ;
TASK VAR
id := task id (link (system catalogue.dir, task name)) ;
IF NOT exists (id)
THEN access catalogue ;
id := task id (link (system catalogue.dir, task name)) ;
FI ;
id .
ENDPROC task id ;
TASK OP / (TEXT CONST task name) :
task (task name)
ENDOP / ;
INT PROC index (TASK CONST task) :
IF NOT initialized (catalogue known)
THEN access catalogue
FI ;
task.no AND hex ff
ENDPROC index ;
INT PROC station (TASK CONST task) :
task.no DIV 256
ENDPROC station ;
PROC update (TASK VAR task) :
IF task.no <> nil
THEN task.no := (task.no AND hex ff) + new station number
FI .
new station number : (pcb (myself no field) AND hex 7f00) .
ENDPROC update ;
TASK PROC public :
task ("PUBLIC")
ENDPROC public ;
TASK PROC father :
IF NOT initialized (father known) COR station or rename changed father id
THEN access catalogue ;
father task := father (myself)
FI ;
father task .
station or rename changed father id :
NOT exists (father task) .
ENDPROC father ;
INT VAR task no ;
TASK PROC father (TASK CONST task) :
task no := index (task) ;
task id (system catalogue.link (task no).father) .
ENDPROC father ;
TASK PROC son (TASK CONST task) :
task no := index (task) ;
IF task no = nil
THEN supervisor
ELSE task id (system catalogue.link (task no).son)
FI .
ENDPROC son ;
TASK PROC brother (TASK CONST task) :
task no := index (task) ;
task id (system catalogue.link (task no).brother) .
ENDPROC brother ;
PROC next active (TASK VAR task) :
next active task index (task.no) ;
IF task.no > 0
THEN task.version := pcb (task, myself version field)
ELSE task.version := 0
FI
ENDPROC next active ;
PROC next active task index (INT CONST no) :
EXTERNAL 118
ENDPROC next active task index ;
TASK PROC task id (INT CONST task nr) :
INT VAR task index := task nr AND hex ff ;
TASK VAR result ;
result.no := task index ;
IF task index = nil
THEN result.version := 0
ELSE result.version := system catalogue.link (task index).version ;
result.no INCR my station id
FI ;
result .
my station id : pcb (myself no field) AND hex 7f00 .
ENDPROC task id ;
PROC access catalogue :
IF this is not supervisor
THEN get catalogue from supervisor
FI .
this is not supervisor :
(pcb (myself no field) AND hex ff) <> sv no .
get catalogue from supervisor :
INT VAR dummy reply ;
forget (catalogue space) ;
catalogue space := nilspace ;
call (supervisor, system catalogue code, catalogue space, dummy reply) ;
system catalogue := catalogue space .
ENDPROC access catalogue ;
PROC entry (TASK CONST father task, TEXT CONST task name,
TASK VAR son task) :
IF task name <> "-" CAND (system catalogue.dir CONTAINS task name)
THEN errorstop (""""+task name+""" existiert bereits")
ELIF is niltask (father task)
THEN errorstop ("Vatertask existiert nicht")
ELSE entry task
FI .
entry task :
INT VAR son task nr ;
INT CONST father task nr := index (father task) ;
insert (system catalogue.dir, task name, son task nr) ;
IF son task nr = nil OR son task nr > max task
THEN delete (system catalogue.dir, son task nr) ;
son task := niltask ;
errorstop ("zu viele Tasks")
ELSE insert task (father task, father vec, son task, son vec, son tasknr)
FI .
father vec : system catalogue.link (father task nr) .
son vec : system catalogue.link (son task nr) .
ENDPROC entry ;
PROC insert task (TASK CONST father task, TASKVECTOR VAR father vec,
TASK VAR son task, TASKVECTOR VAR son vec, INT CONST nr) :
initialize version number if son vec is first time used ;
increment version (son vec) ;
son task.no := my station id + nr ;
son task.version := son vec.version ;
link into task tree .
initialize version number if son vec is first time used :
IF son vec.version < 0
THEN son vec.version := 0
FI .
link into task tree :
son vec.son := nil ;
son vec.brother := father vec.son ;
son vec.father := index (father task) ;
father vec.son := son task.no .
my station id : pcb (myself no field) AND hex 7f00 .
END PROC insert task ;
PROC delete (TASK CONST superfluous) :
INT CONST superfluous nr := index (superfluous) ;
delete (system catalogue.dir, superfluous nr) ;
delete superfluous task ;
increment version (superfluous vec) .
delete superfluous task :
INT CONST successor of superfluous := superfluous vec.brother ;
TASK VAR
last := father (superfluous) ,
actual := son (last) ;
IF actual = superfluous
THEN delete first son of last
ELSE search previous brother of superfluous ;
delete from brother chain
FI .
delete first son of last :
last vec.son := successor of superfluous .
search previous brother of superfluous :
REP
last := actual ;
actual := brother (actual)
UNTIL actual = superfluous PER .
delete from brother chain :
last vec.brother := successor of superfluous .
last vec : system catalogue.link (index (last)) .
superfluous vec : system catalogue.link (superfluous nr) .
ENDPROC delete ;
PROC name (TASK VAR task, TEXT CONST new name) :
INT CONST task no := index (task) ;
IF (system catalogue.dir CONTAINS new name) AND (new name <> "-")
AND (name (task) <> new name)
THEN errorstop (""""+new name+""" existiert bereits")
ELSE rename (system catalogue.dir, task no, new name) ;
increment version (system catalogue.link (task no)) ;
IF this is supervisor
THEN update task version in pcb and task variable
FI
FI .
this is supervisor : (pcb (myself no field) AND hex ff) = sv no .
update task version in pcb and task variable :
INT CONST new version := system catalogue.link (task no).version ;
write pcb (task, myself version field, new version) ;
task.version := new version .
ENDPROC name ;
PROC increment version (TASKVECTOR VAR task vec) :
task vec.version := task vec.version MOD max version + 1
ENDPROC increment version ;
INT PROC pcb (TASK CONST id, INT CONST field) :
EXTERNAL 104
ENDPROC pcb ;
INT PROC status (TASK CONST id) :
EXTERNAL 107
ENDPROC status ;
INT PROC channel (TASK CONST id) :
pcb (id, channel field)
ENDPROC channel ;
REAL PROC clock (TASK CONST id) :
EXTERNAL 106
ENDPROC clock ;
INT PROC storage (TASK CONST id) :
INT VAR ds number, storage sum := 0, ds size;
FOR ds number FROM lowest ds number UPTO highest ds number REP
ds size := pages (ds number, id) ;
IF ds size > 0
THEN storage sum INCR ((ds size + 1) DIV 2)
FI
PER ;
storage sum
ENDPROC storage ;
INT PROC pages (INT CONST ds number, TASK CONST id) :
EXTERNAL 88
ENDPROC pages ;
TASK PROC callee (TASK CONST from) :
IF status (from) = wait state
THEN TASK:(pcb (from, callee no field), pcb (from, callee version field))
ELSE niltask
FI
ENDPROC callee ;
PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds,
INT VAR quit) :
EXTERNAL 113
ENDPROC send ;
PROC send (TASK CONST dest, INT CONST send code, DATASPACE VAR ds) :
INT VAR dummy quit ;
send (dest, send code, ds, dummy quit) ;
forget (ds)
ENDPROC send ;
PROC wait (DATASPACE VAR ds, INT VAR receive code, TASK VAR source) :
EXTERNAL 114
ENDPROC wait ;
PROC call (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
INT VAR reply code) :
EXTERNAL 115
ENDPROC call ;
PROC pingpong (TASK CONST dest, INT CONST order code, DATASPACE VAR ds,
INT VAR reply code) :
EXTERNAL 122
ENDPROC pingpong ;
TASK PROC collected destination :
TASK: (pcb (collected dest field 1), pcb (collected dest field 2))
ENDPROC collected destination ;
PROC begin (PROC start, TASK VAR new task) :
begin ("-", PROC start, new task)
ENDPROC begin ;
PROC begin (TEXT CONST son name, PROC start, TASK VAR new task) :
enable stop ;
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
CONCR (sv msg).tname := son name ;
CONCR (sv msg).start proc := proca (PROC start) ;
supervisor call (begin code) ;
sv msg := sv space ;
new task := CONCR (sv msg).task .
ENDPROC begin ;
PROC begin (DATASPACE VAR ds, PROC start, INT VAR reply) :
sv msg := ds ;
sv msg.start proc := proca (PROC start) ;
call (supervisor, begin code, ds, reply)
ENDPROC begin ;
PROC end :
command dialogue (TRUE) ;
say ("task """) ;
say (name (myself)) ;
IF yes (""" loeschen")
THEN eumel must advertise ;
end (myself)
FI
ENDPROC end ;
PROC end (TASK CONST id) :
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
CONCR (sv msg).task := id ;
supervisor call (end code)
ENDPROC end ;
PROC break (QUIET CONST quiet) :
simple supervisor call (break code)
ENDPROC break ;
PROC break :
eumel must advertise ;
simple supervisor call (break code)
ENDPROC break ;
PROC continue (INT CONST channel nr) :
simple supervisor call (continue code + channel nr)
ENDPROC continue ;
PROC rename myself (TEXT CONST new name) :
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
CONCR (sv msg).tname := new name ;
supervisor call (rename code) .
ENDPROC rename myself ;
PROC simple supervisor call (INT CONST code) :
forget (sv space) ;
sv space := nilspace ;
supervisor call (code)
ENDPROC simple supervisor call ;
PROC supervisor call (INT CONST code) :
INT VAR answer ;
call (supervisor, code, sv space, answer) ;
WHILE answer = nak REP
pause (20) ;
call (supervisor, code, sv space, answer)
PER ;
IF answer = error nak
THEN BOUND TEXT VAR error message := sv space ;
errorstop (CONCR (error message))
FI
ENDPROC supervisor call ;
PROC task password (TEXT CONST password) :
IF online
THEN say (""3""5""10"")
FI ;
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
CONCR (sv msg).tpass := password ;
supervisor call (password code) ;
cover tracks .
ENDPROC task password ;
PROC set autonom :
simple supervisor call (set autonom code)
ENDPROC set autonom ;
PROC reset autonom :
simple supervisor call (reset autonom code)
ENDPROC reset autonom ;
PROC set automatic startup :
simple supervisor call (set automatic startup code)
ENDPROC set automatic startup ;
PROC reset automatic startup :
simple supervisor call (reset automatic startup code)
ENDPROC reset automatic startup ;
PROC define station (INT CONST station number) :
IF this is supervisor
THEN update all tasks
ELIF i am privileged
THEN IF station number is valid
THEN send define station message
ELSE errorstop ("ungueltige Stationsnummer (0 - 127)")
FI
ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
FI .
update all tasks :
start at supervisor ;
REP
get next task ;
IF no more task found
THEN update station number of supervisor ;
LEAVE update all tasks
FI ;
update station number of actual task
PER .
i am privileged :
myself < supervisor .
station number is valid :
station number >= 0 AND station number <= max station no .
start at supervisor :
TEXT VAR name ;
INT VAR index := sv no .
get next task :
get (system catalogue.dir, name, index) .
no more task found : index = 0 .
update station number of actual task :
write pcb (task id (index), myself no field, station number * 256 + index).
update station number of supervisor :
write pcb (supervisor, myself no field, station number * 256 + sv no) .
send define station message :
forget (sv space) ;
sv space := nilspace ;
INT VAR receipt ;
REP
send (supervisor, define station code+station number, sv space, receipt)
UNTIL receipt = ack PER .
this is supervisor :
(pcb (myself no field) AND hex ff) = sv no .
ENDPROC define station ;
TASK OP / (INT CONST station number, TEXT CONST task name) :
IF station number = station (myself)
THEN task (task name)
ELSE get task id from other station
FI .
get task id from other station :
enable stop ;
forget (sv space) ;
sv space := nilspace ;
BOUND TEXT VAR name message := sv space ;
name message := task name ;
INT VAR reply ;
call (collector, station number, sv space, reply) ;
IF reply = ack
THEN BOUND TASK VAR result := sv space ;
CONCR (result)
ELIF reply = error nak
THEN name message := sv space;
disable stop;
errorstop (name message) ;
forget (sv space) ;
niltask
ELSE forget (sv space);
errorstop ("Collector-Task fehlt") ;
niltask
FI
ENDOP / ;
TASK OP / (INT CONST station number, TASK CONST tsk):
station number / name (tsk)
END OP / ;
TEXT PROC external name (TASK CONST tsk):
IF tsk = nil task
THEN
""
ELIF tsk = collector
THEN
"** collector **"
ELSE
name via net
FI.
name via net:
enable stop ;
forget (sv space);
sv space := nil space;
BOUND TASK VAR task message := sv space;
task message := tsk;
INT VAR reply;
call (collector, 256, sv space, reply);
BOUND TEXT VAR result := sv space;
CONCR (result).
END PROC external name;
PROC write pcb (TASK CONST task, INT CONST field, value) :
EXTERNAL 105
ENDPROC write pcb ;
TASK PROC task (INT CONST channel number) :
IF channel number < 1 OR channel number > 32
THEN errorstop ("ungueltige Kanalnummer")
FI ;
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
sv msg.tname := text (channel number) ;
supervisor call (task of channel code) ;
sv msg := sv space ;
sv msg.task
END PROC task;
TASK PROC canal (INT CONST channel number) :
IF channel number < 1 OR channel number > highest terminal channel
THEN errorstop ("ungueltige Kanalnummer")
FI ;
forget (sv space);
sv space := nilspace ;
sv msg := sv space ;
sv msg.tname := text (channel number) ;
supervisor call (canal of channel code) ;
sv msg := sv space ;
sv msg.task
END PROC canal ;
PROC family password (TEXT CONST password) :
IF online
THEN say (""3""5""10"")
FI ;
forget (sv space) ;
sv space := nilspace ;
sv msg := sv space ;
sv msg.tpass := password ;
supervisor call (family password code) ;
cover tracks .
ENDPROC family password ;
INT PROC dataspaces (TASK CONST task) :
INT VAR ds number, spaces := 0 ;
FOR ds number FROM lowest ds number UPTO highest ds number REP
IF pages (ds number, index (task)) >= 0
THEN spaces INCR 1
FI
PER ;
spaces
ENDPROC dataspaces ;
INT PROC dataspaces :
dataspaces (myself)
ENDPROC dataspaces ;
INT PROC pages (INT CONST ds number, INT CONST task no) :
EXTERNAL 88
ENDPROC pages ;
ENDPACKET tasks ;