summaryrefslogtreecommitdiff
path: root/system/net/1.8.7/src/port server
diff options
context:
space:
mode:
Diffstat (limited to 'system/net/1.8.7/src/port server')
-rw-r--r--system/net/1.8.7/src/port server164
1 files changed, 0 insertions, 164 deletions
diff --git a/system/net/1.8.7/src/port server b/system/net/1.8.7/src/port server
deleted file mode 100644
index 46c647f..0000000
--- a/system/net/1.8.7/src/port server
+++ /dev/null
@@ -1,164 +0,0 @@
-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;
-