PACKET port server: (* Autor : R. Ruland *)
(* Stand : 21.03.86 *)
INT VAR port station;
TEXT VAR port := "PRINTER";
put ("gib Name des Zielspools : "); editget (port); line;
put ("gib Stationsnummer des Zielspools : "); get (port station);
server channel (15);
spool duty ("Verwalter fuer Task """ + port +
""" auf Station " + text (port station));
LET max counter = 10 ,
time slice = 300 ,
ack = 0 ,
fetch code = 11 ,
param fetch code = 21 ,
file save code = 22 ,
file type = 1003 ,
begin char = ""0"",
end char = ""1"";
INT VAR reply, old heap size;
TEXT VAR file name, write pass, read pass, sendername, buffer;
FILE VAR file;
DATASPACE VAR ds, file ds, send ds;
BOUND STRUCT (TEXT file name, write pass, read pass, sendername, INT station) VAR msg;
BOUND TEXT VAR error msg ;
spool manager (PROC save file);
PROC save file :
disable stop ;
command dialogue (FALSE);
ds := nilspace; file ds := nilspace; send ds := nil space;
old heap size := heap size;
REP
execute save file;
IF is error THEN save error (error message) FI;
IF heap size > old heap size + 4
THEN collect heap garbage ;
old heap size := heap size
FI;
PER
ENDPROC save file;
PROC execute save file :
enable stop;
forget (file ds) ; file ds := nilspace;
call (father, fetch code, file ds, reply);
IF reply <> ack
THEN error msg := ds; errorstop (error msg);
ELSE save file ds
FI;
. save file ds :
IF type (file ds) = file type
THEN get file params;
insert file params;
call station (port station, port, file save code, file ds);
ELSE errorstop ("Datenraum hat falschen Typ")
FI;
. get file params :
forget (ds); ds := nilspace;
call (father, param fetch code, ds, reply);
IF reply <> ack
THEN error msg := ds; errorstop (error msg);
ELSE msg := ds;
file name := msg. file name;
write pass := msg. write pass;
read pass := msg. read pass;
sendername := msg. sender name;
FI;
. insert file params :
buffer := "";
in headline (filename);
in headline (write pass);
in headline (read pass);
in headline (sendername);
file := sequential file (input, file ds) ;
headline (file, buffer);
END PROC execute save file;
PROC call station (INT CONST order task station, TEXT CONST order task name,
INT CONST order code, DATASPACE VAR order ds) :
INT VAR counter := 0;
TASK VAR order task;
disable stop;
REP order task := order task station // order task name;
IF is error CAND pos (error message, "antwortet nicht") > 0
THEN clear error;
counter := min (max counter, counter + 1);
pause (counter * time slice);
ELSE enable stop;
forget (send ds); send ds := order ds;
call (order task, order code, send ds, reply);
disable stop;
IF reply = ack
THEN forget (order ds); order ds := send ds;
forget (send ds);
LEAVE call station
ELSE error msg := send ds;
errorstop (error msg);
FI;
FI;
PER;
END PROC call station;
TASK OP // (INT CONST station, TEXT CONST name) :
enable stop;
station / name
END OP //;
PROC in headline (TEXT CONST information) :
IF pos (information, begin char) <> 0
OR pos (information, end char) <> 0
THEN errorstop ("Name darf nicht Code 0 oder Code 1 enthalten") FI;
buffer CAT begin char;
buffer CAT information;
buffer CAT end char;
END PROC in headline;
PROC save error (TEXT CONST message) :
clear error;
file name CAT ".";
file name CAT sender name;
file name CAT ".ERROR";
file := sequential file (output, file name);
putline (file, " ");
putline (file, "Uebertragung nicht korrekt beendet ");
putline (file, " ");
put (file, "ERROR :"); put (file, message);
save (file name, public);
clear error;
forget(file name, quiet);
END PROC save error;
ENDPACKET port server;