PACKET multi user printer : (* Autor : Rudolf Ruland *)
(* Stand : 24.03.86 *)
INT VAR c;
put ("gib Druckerkanal : "); get (c);
server channel (c);
station only (FALSE) ;
spool duty ("Ausgabe mit dem Drucker");
spool control task (myself);
LET ack = 0 ,
fetch code = 11 ,
param fetch code = 21 ,
file type = 1003 ;
INT VAR reply, old heap size, sender station;
TEXT VAR file name, userid, password, sendername;
FILE VAR file ;
DATASPACE VAR ds, file ds;
BOUND STRUCT (TEXT file name, userid, password, sendername, INT station) VAR msg;
BOUND TEXT VAR error msg ;
spool manager (PROC printer);
PROC printer :
disable stop ;
command dialogue (FALSE);
ds := nilspace; file ds := nilspace;
continue (server channel) ;
check error ("Kanal belegt");
old heap size := heap size ;
REP
execute print ;
IF is error
THEN put error;
clear error;
FI ;
IF heap size > old heap size + 4
THEN collect heap garbage ;
old heap size := heap size
FI
PER
ENDPROC printer ;
PROC execute print :
enable stop ;
forget (file ds) ; file ds := nilspace ;
call (father, fetch code, file ds, reply) ;
IF reply = ack CAND type (file ds) = file type
THEN get file params;
print file
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;
userid := msg. userid;
password := msg. password;
sendername := msg. sender name;
sender station := msg. station;
FI;
. print file :
file := sequential file (input, file ds);
print (file,
PROC (INT CONST, INT VAR, INT VAR) open,
PROC (INT CONST, INT CONST) close,
PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);
ENDPROC execute print ;
PROC check error (TEXT CONST message) :
IF is error
THEN clear error;
rename myself (message);
IF is error THEN clear error; end (myself) FI;
pause (18000);
end (myself);
FI;
END PROC check error;
ENDPACKET multi user printer ;