(**************************************************************************)
(* *)
(* MPG - Graphik - System *)
(* *)
(* Version 2.2 vom 23.09.1987 *)
(* *)
(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *)
(* unter Verwendung der Standard-Graphik *)
(* "Graphik-Plotmanager" geschrieben von C.Weinholz *)
(* *)
(**************************************************************************)
(* *)
(* Dieses Paket stellt den Multispool-Ausgabemanager *)
(* zur Verfuegung. *)
(* Er wird in der Regel durch Aufruf von *)
(* 'generate plot manager' in GRAPHIK in einer neuerzeugten *)
(* Sohntask 'PLOT' installiert. *)
(* *)
(**************************************************************************)
(* Urversion : 10.09.87 *)
(* Aenderungen: 23.09.87, Carsten Weinholz *)
(* Kommando 'spool control ("TEXT")' im Plot-Monitor *)
(* Anzeige von 'order tasks' anderer Stationen *)
(* 11.1.88, Thomas Clermont *)
(* Fehler 'Zu viele DATASPACEs' und *)
(* Spooling von zwei gleichnamigen JOBs behoben. *)
(* Fehler : Keine bekannt. *)
(**************************************************************************)
PACKET plot manager DEFINES plot manager ,
plot server :
LET max spools = 14, (* Hinweis: max spools + dataspaces + *)
max entries = 14, (* max spools * max entries < 250 *)
ack = 0,
second phase ack = 5,
false code = 6,
fetch code = 11,
save code = 12,
existscode = 13,
erase code = 14,
list code = 15,
all code = 17,
first code = 25,
start code = 26,
stop code = 27,
halt code = 28,
wait for halt code = 29,
continue code = 100,
picfiletype = 1102,
trenn = "/",
MSG = STRUCT (TEXT ds name, dev name, passwd, INT dev no),
JOB = STRUCT (DATASPACE ds, TEXT ds name, TASK order task),
ENTRY = STRUCT (JOB job, INT link),
CHAIN = STRUCT (ROW max entries ENTRY entry, INT first, last, empty),
SERVER = STRUCT (TASK task, wait for halt, REAL time,
JOB current job, BOOL stopped, INT link);
ROW max spools STRUCT (SERVER server, CHAIN chain) VAR device;
MSG VAR msg;
INT VAR entry to erase, last created server, reply, current plotter;
FILE VAR chain info;
THESAURUS VAR managed plotter;
BOUND THESAURUS VAR thesaurus msg;
DATASPACE VAR reply ds;
TASK VAR control task;
(********************************* SPOOL ***********************************)
PROC plot manager :
INT VAR act dev;
managed plotter := plotters LIKE (text (station (myself)) + any);
FOR act dev FROM 1 UPTO max devices REP
init device (act dev)
PER;
control task := niltask;
end global manager (FALSE);
global manager (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST)plot manager)
END PROC plot manager;
PROC plot manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task):
enable stop;
INT VAR act dev;
SELECT order OF
CASE fetch code : y fetch
CASE save code : y save
CASE exists code: y exists
CASE erase code : y erase
CASE list code : y list
CASE all code : y all
OTHERWISE IF order >= continue code AND order task = supervisor
THEN forget (ds);
continue (order - continue code);
spool monitor
ELIF priv control op
THEN SELECT order OF
CASE first code : y first
CASE start code : y start
CASE stop code : y stop
CASE halt code : y halt
CASE wait for halt code : y halt
OTHERWISE order error
ENDSELECT
ELSE order error
FI;
END SELECT;
BOOL VAR test;
FOR act dev FROM 1 UPTO max devices REP
test := server is active (act dev)
PER;
forget (ds).
priv control op:
(order task = father) OR (order task < supervisor) OR
spool control task.
spool control task:
NOT (order task = niltask) CAND
((order task = control task) OR (order task < control task)).
y fetch:
FOR act dev FROM 1 UPTO max devices REP
UNTIL act server.task = order task PER;
IF act dev > max devices
THEN order error
ELIF chain is empty (act dev) OR act server.stopped
THEN end server (act dev);
IF exists (act server.wait for halt)
THEN send (act server.wait for halt, ack);
act server.wait for halt := niltask
FI
ELSE transfer next job (act dev);
send current job (act dev)
FI.
y save:
IF phase = 1
THEN y save pre
ELSE y save post
FI.
y save pre:
link dev;
IF act dev = 0
THEN device error
ELIF chain is full (act dev)
THEN errorstop ("SPOOL ist voll")
ELSE send (order task, second phase ack)
FI.
y save post:
act dev := msg.dev no;
IF type (ds) <> picfile type
THEN errorstop ("Datenraum hat falschen Typ")
ELSE entry into chain (act dev, new job);
forget (ds);
IF NOT (server is active (act dev) OR act server.stopped)
THEN create server (act dev)
FI;
send ack
FI.
new job:
JOB : (ds, msg.ds name, order task).
y exists:
link dev;
IF find entry (msg.ds name,act dev,order task, priv control op) = 0
THEN send (order task, false code, ds)
ELSE send ack
FI.
y erase:
IF phase = 1
THEN link dev;
IF act dev > 0
THEN y erase pre
ELSE device error
FI
ELSE erase entry (act dev, entry to erase);
send ack
FI.
y erase pre:
entry to erase := find entry (msg.ds name,act dev, order task, priv control op);
IF order not from job order task AND NOT priv control op
THEN errorstop ("Kein Zugriffsrecht auf Auftrag """ + msg.ds name + """")
ELIF entry to erase = 0
THEN manager message ("""" + msg.ds name + """ existiert nicht")
ELSE manager question (erase msg)
FI.
erase msg:
TASK VAR owner ::act chain.entry [entry to erase].job.order task;
owner id (owner) + "/ """ + msg.ds name +
""" in Spool """ + name (managed plotter, act dev) +
""" loeschen".
order not from job order task:
NOT (act chain.entry [entry to erase].job.order task = order task).
y list:
link dev;
create chain list (act dev);
send (order task, ack, reply ds).
y all:
link dev;
forget (reply ds);
reply ds := nilspace;
thesaurus msg := reply ds;
thesaurus msg := chain thesaurus (act dev, owner or priv task, FALSE);
send (order task, ack, reply ds).
owner or priv task:
IF priv control op
THEN niltask
ELSE order task
FI.
y start:
link dev;
IF act dev = 0
THEN FOR act dev FROM 1 UPTO max devices REP
start (act dev)
PER
ELSE start (act dev)
FI;
send ack.
y stop:
IF phase = 1
THEN y stop pre
ELSE y stop post
FI.
y stop pre:
link dev;
IF act dev > 0
THEN stop (act dev);
IF NOT is no job (act server.current job)
THEN manager question ("""" + act server.current job.ds name
+ """ neu eintragen")
ELSE send ack
FI
ELSE FOR act dev FROM 1 UPTO max devices REP
stop (act dev)
PER;
send ack
FI.
y stop post:
act dev := msg.dev no;
entry into chain (act dev, act server.current job);
IF act chain.last > 1
THEN make new first (act dev, act chain.last)
FI;
send ack.
y halt:
link dev;
IF act dev = 0
THEN IF order <> halt code
THEN device error
ELSE FOR act dev FROM 1 UPTO max devices REP
halt (act dev)
PER;
send ack
FI
ELSE halt (act dev);
IF order = halt code
THEN send ack;
act server.wait for halt := niltask
ELSE act server.wait for halt := order task
FI
FI.
y first:
link dev;
IF act dev = 0
THEN device error
ELSE INT VAR new first entry :: find entry (msg.ds name,act dev,order task,TRUE);
IF new first entry = 0
THEN manager message ("""" + msg.ds name + """ existiert nicht")
ELSE make new first (act dev,new first entry);
send ack
FI
FI.
act server:
device [act dev].server.
act chain:
device [act dev].chain.
send ack:
send (order task, ack).
link dev:
msg := ds;
act dev := msg.dev no.
order error:
errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """").
device error:
disable stop;
IF plotter (msg.dev name) = no plotter
THEN clear error; (* 'plotter(TEXT)' liefert evtl. bereits error *)
errorstop ("Kein Endgeraet eingestellt")
ELSE clear error;
errorstop ("Unbekanntes Endgeraet: """ + msg.dev name + """")
FI;
enable stop.
END PROC plot manager;
(****************************** Spool Monitor ******************************)
INT VAR command index , params ;
TEXT VAR command line, param 1, param 2 ;
BOOL VAR is break;
LET spool command list =
"break:1.0start:2.0stop:3.0halt:4.0first:5.0killer:6.0listspool:7.0
clearspool:8.0selectplotter:9.0spoolcontrol:10.1";
PROC spool monitor:
disable stop ;
current plotter := 0;
is break := FALSE;
select plotter ("");
REP command dialogue (TRUE) ;
get command (gib kommando, command line);
analyze command (spool command list, command line, 3, command index,
params, param1, param2);
execute command;
UNTIL is break PER;
command dialogue (FALSE);
eumel must advertise;
break (quiet);
set autonom.
gib kommando:
IF actual plotter > 0
THEN plotter info (name(plotters,actual plotter),50)
ELSE "ALL-Plotter: "
FI
END PROC spool monitor;
PROC execute command:
enable stop;
SELECT command index OF
CASE 1 : is break := TRUE
CASE 2 : start cmd
CASE 3 : stop cmd
CASE 4 : halt cmd
CASE 5 : first cmd
CASE 6 : killer cmd
CASE 7 : show spool list
CASE 8 : clear spool
CASE 9 : select plotter cmd
CASE 10 : set spool control
OTHERWISE do (command line);
set current plotter
END SELECT.
set current plotter:
current plotter := link(managed plotter, name (plotters,actual plotter));
IF actual plotter > 0 AND current plotter = 0
THEN select plotter ("");
current plotter := 0;
errorstop ("Auf dieser Station unbekannt: """+name(plotter)+"""")
FI.
start cmd:
FOR act dev FROM curr dev UPTO top dev REP
start (act dev)
PER.
stop cmd:
FOR act dev FROM curr dev UPTO top dev REP
IF device [act dev].server.current job.ds name <> "" CAND
yes ("""" + device [act dev].server.current job.ds name +
""" neu eintragen")
THEN entry into chain (act dev, device [act dev].server.current job);
IF device [act dev].chain.last > 1
THEN make new first (act dev, device [act dev].chain.last)
FI
FI;
stop (act dev)
PER.
halt cmd:
FOR act dev FROM curr dev UPTO top dev REP
halt (act dev)
PER.
first cmd:
IF current plotter = 0
THEN device error
FI;
TEXT VAR make to first :: one (chain thesaurus (current plotter,niltask,TRUE)
-first chain entry)
IF make to first <> ""
THEN INT VAR new first entry :: find entry (make to first,
current plotter, niltask, FALSE);
IF new first entry > 1
THEN make new first (current plotter, new first entry)
FI
FI.
first chain entry:
INT VAR first entry id :: device [current plotter].chain.first;
IF first entry id > 0
THEN device [current plotter].chain.entry[first entry id].job.ds name
ELSE ""
FI.
killer cmd:
IF current plotter = 0
THEN device error
FI;
THESAURUS VAR to erase :: chain thesaurus (current plotter,niltask,FALSE);
INT VAR index, act dev;
TEXT VAR name to erase;
FOR act dev FROM curr dev UPTO top dev REP
index := 0;
get (to erase, name to erase, index);
WHILE index > 0 REP
INT VAR entry to erase := find entry (name to erase, current plotter, niltask, TRUE);
IF (entry to erase > 0) CAND
yes ("""" + name to erase + """ loeschen")
THEN erase entry (current plotter, entry to erase)
FI;
get (to erase, name to erase, index)
PER
PER.
show spool list :
create chain list (current plotter);
show (chain info);
forget (reply ds).
clear spool:
FOR act dev FROM curr dev UPTO top dev REP
IF yes ("Spool """ + name (managed plotter, act dev) + """ initialisieren")
THEN BOOL VAR stopped :: device [act dev].server.stopped;
stop (act dev);
init device (act dev);
IF stopped
THEN device [act dev].server.stopped := TRUE
ELSE start (act dev)
FI
FI
PER.
set spool control:
control task := task (param 1).
select plotter cmd:
THESAURUS VAR plotter list :: empty thesaurus;
TEXT VAR plotter name;
get (managed plotter, plotter name, index);
WHILE index > 0 REP
insert (plotter list, plotter info (plotter name, 60));
get (managed plotter, plotter name, index)
PER;
select plotter (name (managed plotter,
link (plotter list,one (plotter list))));
set current plotter.
curr dev:
IF current plotter = 0
THEN 1
ELSE current plotter
FI.
top dev:
IF current plotter = 0
THEN max devices
ELSE current plotter
FI.
device error:
errorstop ("Kein Endgeraet eingestellt")
ENDPROC execute command ;
(************************** SPOOL - Verwaltung *****************************)
PROC entry into chain (INT CONST dev no, JOB CONST new job):
INT VAR act entry := act chain.empty;
act chain.empty := act chain.entry [act entry].link;
IF act chain.last > 0
THEN act chain.entry [act chain.last].link := act entry
FI;
act chain.last := act entry;
IF act chain.first = 0
THEN act chain.first := act entry
FI;
init job (act chain.entry [act entry].job);
act chain.entry [act entry] := ENTRY : (new job,0);
forget (new job.ds).
act chain :
device [dev no].chain
END PROC entry into chain;
PROC erase entry (INT CONST dev no, to erase):
INT VAR act entry;
to forward entry;
IF act entry > 0
THEN act chain.entry [act entry].link := act chain.entry [to erase].link
FI;
IF act chain.last = to erase
THEN act chain.last := act entry
FI;
IF act chain.first = to erase
THEN act chain.first := act chain.entry [to erase].link
FI;
init job (act chain.entry [to erase].job);
act chain.entry [to erase].link := act chain.empty;
act chain.empty := to erase.
to forward entry:
FOR act entry FROM 1 UPTO max entries REP
UNTIL act chain.entry [act entry].link = to erase PER;
IF act entry > max entries
THEN act entry := 0
FI.
act chain:
device [dev no].chain
END PROC erase entry;
INT PROC find entry (TEXT CONST ds name, INT CONST dev, TASK CONST order task,BOOL CONST priviledged):
INT VAR act dev :: dev,act entry,last found :: 0;
IF act dev = 0
THEN FOR act dev FROM 1 UPTO max devices REP
find entry of order task
UNTIL act entry > 0 PER
ELSE find entry of order task
FI;
IF act entry = 0
THEN last found
ELSE act entry
FI.
find entry of order task:
BOOL VAR entry found;
act entry := act chain.first;
WHILE act entry > 0 REP
entry found := (act chain.entry [act entry].job.ds name = ds name);
IF entry found
THEN last found := act entry;
entry found := (index (act chain.entry [act entry].job.order task) =
index (order task)) OR priviledged
FI;
IF NOT entry found
THEN act entry := act chain.entry [act entry].link
FI
UNTIL entry found PER.
act chain:
device [act dev].chain
END PROC find entry;
PROC make new first (INT CONST dev no, new first):
JOB VAR new first job :: act chain.entry [new first].job;
erase entry (dev no, new first);
INT VAR act entry := act chain.empty;
act chain.empty := act chain.entry [act entry].link;
act chain.entry [act entry] := ENTRY : (new first job, act chain.first);
init job (new first job);
act chain.first := act entry;
IF act chain.last = 0
THEN act chain.last := act entry
FI.
act chain:
device [dev no].chain
END PROC make new first;
THESAURUS PROC chain thesaurus (INT CONST dev no, TASK CONST order task,
BOOL CONST double):
THESAURUS VAR list :: empty thesaurus;
INT VAR act dev := dev no,act entry;
IF act dev = 0
THEN FOR act dev FROM 1 UPTO max devices REP
list chain
PER
ELSE list chain
FI;
list.
list chain:
act entry := act chain.first;
WHILE act entry > 0 REP
IF (order task = niltask) OR
(act chain.entry [act entry].job.order task = order task)
THEN insert job name
FI;
act entry := act chain.entry [act entry].link
PER.
insert job name:
TEXT VAR this job :: act chain.entry [act entry].job.ds name
IF double OR (NOT (list CONTAINS this job))
THEN insert (list, this job)
FI.
act chain:
device [act dev].chain
END PROC chain thesaurus;
PROC create chain list (INT CONST dev no):
INT VAR act dev :: dev no, act entry;
init chain info;
IF act dev = 0
THEN FOR act dev FROM 1 UPTO max devices REP
list chain
PER
ELSE list chain
FI.
init chain info:
forget (reply ds);
reply ds := nilspace;
chain info := sequential file (output, reply ds);
headline (chain info,"GRAPHIK - Ausgabe um "+ time of day (clock (1)) + " Uhr :").
list chain:
server head;
IF NOT server is active (act dev) OR is no job (act server.current job)
THEN put (chain info, "- Kein Auftrag in Bearbeitung") ;
IF act server.stopped
THEN put (chain info, " ( SERVER deaktiviert )")
FI;
line (chain info)
ELSE put (chain info, "- In Bearbeitung seit "+time of day (act server.time)+" Uhr :");
IF act server.stopped
THEN put (chain info, " ( SERVER wird deaktiviert !)")
FI;
line (chain info, 2);
putline (chain info, job note (act server.current job))
FI;
line (chain info);
IF act chain.last = 0
THEN putline (chain info, "- Keine Auftraege im SPOOL")
ELSE putline (chain info, "- Weitere Auftraege im SPOOL :");
line (chain info);
act entry := act chain.first;
WHILE act entry > 0 REP
putline (chain info, job note (act chain.entry [act entry].job));
act entry := act chain.entry [act entry].link
PER
FI;
line (chain info, 2).
server head:
TEXT VAR plotter name :: name (managed plotter,act dev);
INT VAR station :: int (plottername),
tp :: pos (plottername,trenn)+1,
channel :: int (subtext (plottername,tp));
plotter name := subtext (plotter name, pos (plotter name, trenn, tp)+1);
putline (chain info, 77 * "-");
putline (chain info,
center (plotter name + (30-length(plotter name))*"." +
"Kanal " + text (channel) +
"/Station " + text (station)));
putline (chain info, 77 * "-");
line (chain info).
act chain:
device [act dev].chain.
act server:
device [act dev].server
END PROC create chain list;
BOOL PROC chain is empty (INT CONST dev no):
device [dev no].chain.first = 0 OR device [dev no].chain.last = 0
END PROC chain is empty;
BOOL PROC chain is full (INT CONST dev no):
device [dev no].chain.empty = 0
END PROC chain is full;
PROC transfer next job (INT CONST dev no):
INT VAR next chain entry := device [dev no].chain.first;
next server job (dev no, device [dev no].chain.entry [next chain entry].job);
erase entry (dev no,next chain entry)
END PROC transfer next job;
(*************************** SERVER - Verwaltung ***************************)
PROC next server job (INT CONST dev no,JOB CONST next job):
act server.time := clock (1);
init job (act server.current job);
act server.current job := next job.
act server:
device [dev no].server
END PROC next server job;
BOOL PROC server is active (INT CONST dev no):
exists (act server.task) CAND server alive or restarted.
server alive or restarted:
SELECT status (act server.task) OF
CASE 0 (* busy *) ,
4 (* busy-blocked *),
2 (* wait *),
6 (* wait-blocked *) : TRUE
CASE 1 (* i/o *),
5 (* i/o -blocked *): IF channel (act server.task) = 0
THEN restart
ELSE TRUE
FI
OTHERWISE restart
END SELECT.
restart:
end server (dev no);
IF NOT act server.stopped AND NOT chain is empty (dev no)
THEN create server (dev no)
FI;
NOT is niltask (act server.task).
act server:
device [dev no].server
END PROC server is active;
PROC create server (INT CONST dev no):
init job (act server.current job);
act server.wait for halt := niltask;
act server.time := 0.0;
act server.stopped := FALSE;
last created server := dev no;
begin (PROC plot server, act server.task).
act server:
device [dev no].server
END PROC create server;
PROC end server (INT CONST dev no):
end (act server.task);
init job (act server.current job);
act server.task := niltask.
act server:
device [dev no].server
END PROC end server;
PROC start (INT CONST dev no):
IF server is active (dev no)
THEN end server (dev no)
FI;
IF NOT chain is empty (dev no)
THEN create server (dev no)
FI;
device [dev no].server.stopped := FALSE
END PROC start;
PROC stop (INT CONST dev no):
device [dev no].server.stopped := TRUE;
IF exists (device [dev no].server.wait for halt)
THEN send (device [dev no].server.wait for halt,ack)
FI;
device [dev no].server.wait for halt := niltask;
IF server is active (dev no)
THEN end server (dev no)
FI
END PROC stop;
PROC halt (INT CONST dev no):
device [dev no].server.stopped := TRUE
END PROC halt;
PROC send current job (INT CONST dev no):
forget (reply ds);
reply ds := device [dev no].server.current job.ds;
send (device [dev no].server.task, ack,reply ds);
END PROC send current job;
(****************************** Hilfsprozeduren ****************************)
PROC init device (INT CONST dev no):
INT VAR act entry;
act server.task := niltask;
act server.time := 0.0;
init job (act server.current job);
act server.stopped := FALSE;
act chain.first := 0;
act chain.last := 0;
act chain.empty := 1;
FOR act entry FROM 1 UPTO max entries-1 REP
init job (act chain.entry [act entry].job);
act chain.entry [act entry].link := act entry + 1
PER;
init job (act chain.entry [act entry].job);
act chain.entry [act entry].link := 0.
act server :
device [dev no].server.
act chain :
device [dev no].chain
END PROC init device;
INT PROC max devices:
highest entry (managed plotter)
END PROC max devices;
OP := (MSG VAR dest, DATASPACE VAR source):
TEXT VAR ds name :: "", dev name :: "";
BOUND STRUCT (TEXT ds name, dev name, passwd) VAR msg in := source;
divide names;
dest := MSG : (ds name, dev name, msg in .passwd,
link (managed plotter,dev name));
forget (source).
divide names:
INT VAR pps :: pos (msg in.ds name, ""0"");
WHILE pos (msg in.ds name, ""0"", pps+1) > 0 REP
pps := pos (msg in.ds name,""0"", pps+1)
PER;
IF pps > 0
THEN ds name := subtext (msg in.ds name, 1, pps-1);
FI;
dev name := subtext (msg in.ds name, pps+1).
END OP :=;
TEXT PROC job note (JOB CONST job):
" - " + owner id (job.order task) + " : " + qrline (job.ds name, 30) +
" (" + text (storage (job.ds)) + " K)".
END PROC job note;
TEXT PROC owner id (TASK CONST owner):
TEXT VAR test :: name (owner);
IF test <> ""
THEN text (station (owner)) + "/" + qrline (test,15)
ELSE "?????"
FI
END PROC owner id;
PROC init job (JOB VAR to initialize):
forget (to initialize.ds);
to initialize.ds name := "";
to initialize.order task := niltask
END PROC init job;
TEXT PROC qrline (TEXT CONST t,INT CONST len):
IF length (t) > len-2
THEN """" + text (t, len-5) + "..."""
ELSE text ("""" + t + """", len)
FI
END PROC qrline;
TEXT PROC center (TEXT CONST chars,INT CONST len):
len DIV 2 * " " + chars
END PROC center;
BOOL PROC is no job (JOB CONST job):
job.ds name = ""
END PROC is no job;
PROC send (TASK CONST task, INT CONST code):
DATASPACE VAR ds :: nilspace;
send (task, code, ds);
forget (ds)
END PROC send;
(**************************** Plot - Server ********************************)
PROC plot server:
disable stop;
select plotter (name (managed plotter,last created server));
REP
error handling;
TEXT VAR dummy;
catinput (dummy, dummy); (* evtl. Zeichen im Tastaturpuffer *)
PICFILE VAR pic :: next server job;
prepare;
plot (pic);
PER.
next server job:
forget (reply ds);
reply ds := nilspace;
REP
error handling;
call (father, fetch code, reply ds, reply)
UNTIL reply = ack PER;
reply ds.
error handling:
IF is error
THEN rename myself (error message);
clear error;
pause
FI.
END PROC plot server;
END PACKET plot manager