From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/std.zusatz/1.7.3/src/spool manager | 377 ++++++++++++++++++++++++++++++ 1 file changed, 377 insertions(+) create mode 100644 system/std.zusatz/1.7.3/src/spool manager (limited to 'system/std.zusatz/1.7.3/src/spool manager') diff --git a/system/std.zusatz/1.7.3/src/spool manager b/system/std.zusatz/1.7.3/src/spool manager new file mode 100644 index 0000000..8f9ab9f --- /dev/null +++ b/system/std.zusatz/1.7.3/src/spool manager @@ -0,0 +1,377 @@ +PACKET spool manager DEFINES (* Autor: J. Liedtke *) + spool manager, server channel: (* 21.05.84 *) + + +LET que size = 100 , + + ack = 0 , + nak = 1 , + error nak = 2 , + second phase ack = 5 , + + fetch code = 11 , + save code = 12 , + erase code = 14 , + list code = 15 , + all code = 17 , + continue code = 100, + + empty = 0 , + used = 1 ; + +TASK VAR order task , waiting server , from task , server ; +INT VAR order code , reply , first , last , list index ; + +DATASPACE VAR ds ; + +TEXT VAR from title ; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; +BOUND TEXT VAR error msg ; +BOUND STRUCT (TEXT tname, tpass, TASK task) VAR sv msg ; + +FILE VAR list file ; +TEXT VAR entry name, entry task; + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; + +LET spool command list = +"break:1.0start:2.01stop:4.0first:5.0killer:6.0 " ; + + +LET ENTRY = STRUCT (TEXT title, TASK origin, DATASPACE space, INT status) ; + +ROW que size ENTRY VAR que ; + + +INT VAR server chan := 0; + +PROC server channel (INT CONST ch): + server chan := ch + +END PROC server channel; + +INT PROC server channel: + server chan + +END PROC server channel; + +PROC spool manager (PROC server start) : + INT VAR old heap size := heap size; + begin (PROC server start, server) ; + set autonom ; + break ; + disable stop ; + first := 1 ; + last := 1 ; + from task := niltask ; + waiting server := niltask ; + spool ; + clear error ; + forget all dataspaces. + +forget all dataspaces : + INT VAR i ; + FOR i FROM 1 UPTO que size REP + forget (que (i).space) + PER . + +spool: + REP + wait (ds, order code, order task) ; + IF order code = fetch code THEN out of que + ELIF order code = save code THEN prepare into que + ELIF order code = second phase ack THEN into que + ELIF order code = erase code THEN delete que entry + ELIF order code = list code THEN list spool + ELIF order code = all code THEN y all + ELIF order code >= continue code + AND order task = supervisor THEN spool command (PROC server start) + FI; + clear error + PER; + collect heap garbage if necessary. + +collect heap garbage if necessary: + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size + FI. + +ENDPROC spool manager ; + +PROC out of que : + + forget (ds) ; + IF NOT (order task < myself) + THEN error ("not parent") + ELIF que empty + THEN waiting server := order task + ELSE send (order task, ack, que (first).space) ; + inc first + FI . + +que empty : first = last . + +ENDPROC out of que ; + +PROC inc first : + + que (first).status := empty ; + REP + first := first MOD que size + 1 ; + UNTIL first = last OR que (first).status <> empty PER + +ENDPROC inc first ; + +PROC dec first : + + first DECR 1 ; + IF first = 0 + THEN first := que size + FI + +ENDPROC dec first ; + +PROC prepare into que : + + msg := ds ; + from task := order task ; + from title := CONCR (msg).name ; + send (order task, second phase ack, ds) . + +ENDPROC prepare into que ; + +PROC into que : + + IF order task = from task + THEN try entry into spool + ELSE send (order task, nak, ds) + FI . + +try entry into spool : + IF que full + THEN error ("spool overflow") + ELSE entry (que (last)) ; + last := next (last) ; + send (order task, ack, ds) ; + awake server if necessary + FI . + +awake server if necessary : + IF NOT is niltask (waiting server) + THEN send (waiting server, ack, que (first).space , reply) ; + IF reply = ack + THEN waiting server := niltask ; + inc first + FI + FI . + +que full : first = next (last) . + +ENDPROC into que ; + +PROC entry (ENTRY VAR que entry) : + + que entry.title := from title ; + que entry.origin := from task ; + que entry.space := ds ; + que entry.status := used ; + +ENDPROC entry ; + +INT PROC next (INT CONST index) : + + index MOD que size + 1 + +ENDPROC next ; + + +PROC delete que entry : + + msg := ds ; + INT VAR index := first ; + WHILE index <> last REP + IF entry found + THEN erase entry (index) ; + send (order task, ack, ds) ; + LEAVE delete que entry + FI ; + index := next (index) + PER ; + error ("your file does not exist") . + +entry found : + entry.status = used CAND entry.origin = order task + CAND entry.title = CONCR (msg).name . + +entry : que (index) . + +ENDPROC delete que entry ; + +PROC erase entry (INT CONST index) : + + entry.status := empty ; + forget (entry.space) ; + IF index = first + THEN inc first + FI . + +entry : que (index) . + +ENDPROC erase entry ; + +PROC list spool : + + forget (ds) ; + ds := nilspace ; + list file := sequential file (output, ds) ; + to first que entry ; + get next que entry (entry name, entry task) ; + WHILE entry name <> "" REP + putline (list file, text (entry task, 15) + " : " + entry name); + get next que entry (entry name, entry task) + PER; + send (order task, ack, ds) . + +ENDPROC list spool ; + +BOUND THESAURUS VAR all thesaurus; + +PROC y all: + forget (ds); + ds := nilspace; + all thesaurus := ds; + all thesaurus := empty thesaurus; + to first que entry; + get next que entry (entry name, entry task); (* hier erster Eintrag *) + WHILE entryname <> "" REP + IF entry task = name (order task) + AND NOT (all thesaurus CONTAINS entry name) + THEN insert (all thesaurus, entry name) + FI; + get next que entry (entry name, entry task) + PER; + send (order task, ack, ds) + +END PROC y all; + +PROC to first que entry : + + list index := first - 1 + +ENDPROC to first que entry ; + +PROC get next que entry (TEXT VAR entry name, origin task name): + + WHILE list index <> last REP + list index := next (list index) + UNTIL que (list index).status <> empty PER ; + IF que (list index).status = used + THEN origin task name := name (que (list index).origin) ; + entry name := que (list index).title + ELSE entry name := ""; + origin task name := "" + FI . + +ENDPROC get next que entry ; + +PROC error (TEXT CONST error text) : + + forget (ds) ; + ds := nilspace ; + error msg := ds ; + CONCR (error msg) := error text ; + send (order task, error nak, ds) + +ENDPROC error ; + +PROC spool command (PROC server start) : + + enable stop ; + continue (order code - continue code) ; + command dialogue (TRUE) ; + disable stop ; + REP + get command ("gib spoolkommando :", command line); + analyze command (spool command list, command line, 3, + command index, params, param1, param2); + execute command + PER . + +execute command : + SELECT command index OF + CASE 1 : break cmd + CASE 2 : start cmd + CASE 3 : start channel cmd + CASE 4 : stop cmd + CASE 5 : first cmd + CASE 6 : killer cmd + OTHERWISE do (command line) END SELECT . + +start channel cmd: + server channel (int (param1)); + start cmd; + break cmd. + +break cmd: + break; set autonom ; LEAVE spool command. + +start cmd : + IF is niltask (server) + THEN begin (PROC server start, server) + FI . + +stop cmd : + IF NOT is niltask (server) + THEN command dialogue (FALSE) ; + end (server) ; + server := niltask + FI . + +first cmd : + line ; + to first que entry ; + get next que entry (entry name, entry task); + IF entry name = "" + THEN LEAVE first cmd + FI ; + REP + get next que entry (entry name, entry task) ; + IF entry name = "" + THEN LEAVE first cmd + FI; + say (text (entry task, 15) + " : " + entry name) ; + IF yes (" als erstes") + THEN make to first entry ; + LEAVE first cmd + FI + PER . + +make to first entry : + IF first = next (last) + THEN errorstop ("spool overflow") + ELSE dec first ; + que (first) := que (list index) ; + erase entry (list index) + FI . + + +killer cmd : + line ; + to first que entry ; + REP + get next que entry (entry name, entry task) ; + IF entry name = "" + THEN LEAVE killer cmd + FI ; + say (text (entry task, 15) + " : " + entry name) ; + IF yes (" loeschen") + THEN erase entry (list index) + FI + PER . + +ENDPROC spool command ; + +ENDPACKET spool manager ; -- cgit v1.2.3