From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import
---
system/multiuser/1.7.5/src/supervisor | 774 ++++++++++++++++++++++++++++++++++
1 file changed, 774 insertions(+)
create mode 100644 system/multiuser/1.7.5/src/supervisor
(limited to 'system/multiuser/1.7.5/src/supervisor')
diff --git a/system/multiuser/1.7.5/src/supervisor b/system/multiuser/1.7.5/src/supervisor
new file mode 100644
index 0000000..00874b2
--- /dev/null
+++ b/system/multiuser/1.7.5/src/supervisor
@@ -0,0 +1,774 @@
+(* ------------------- VERSION 19 03.06.86 ------------------- *)
+PACKET supervisor : (* Autor: J.Liedtke *)
+
+
+
+
+LET ack = 0 ,
+ nak = 1 ,
+ error nak = 2 ,
+
+ system catalogue code = 3 ,
+ begin code = 4 ,
+ end code = 5 ,
+ break code = 6 ,
+ rename code = 7 ,
+ halt code = 8 ,
+ password code = 9 ,
+ family password code = 40 ,
+ set autonom code = 41 ,
+ reset autonom code = 42 ,
+ define canal code = 43 ,
+ go back to old canal code = 44 ,
+ task of channel code = 45 ,
+ canal of channel code = 46 ,
+ set automatic startup code = 47 ,
+ reset automatic startup code = 48 ,
+
+ continue code low = 100 ,
+ continue code high = 132 ,
+
+ system start code = 100 ,
+ define station code = 32000 ,
+ max station no = 127 ,
+
+ nil = 0 ,
+
+ number of tasks = 125 ,
+
+ number of channels = 32 ,
+ highest terminal channel = 16 ,
+ highest user channel = 24 ,
+ highest system channel = 32 ,
+ configurator channel = 32 ,
+
+ shutup and save code = 12 ,
+
+ channel field = 4 ,
+ fromid field = 11 ,
+ nilchannel = 0 ;
+
+
+
+TASK VAR order task ;
+INT VAR order code ,
+ channel nr ,
+ channel index ;
+
+DATASPACE VAR ds ;
+
+BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR msg ;
+BOUND TEXT VAR error msg ;
+
+REAL VAR last rename time := 0.0 ;
+
+
+TEXT VAR actual password, supply password ;
+
+
+ROW highest terminal channel TASK VAR canal ;
+
+ROW number of channels TASK VAR connected task ;
+
+FOR channel index FROM 1 UPTO highest terminal channel REP
+ canal (channel index) := niltask ;
+PER ;
+FOR channel index FROM 1 UPTO number of channels REP
+ connected task (channel index) := niltask
+PER ;
+
+
+ROW number of tasks BOOL VAR autonom flag ;
+ROW number of tasks BOOL VAR automatic startup flag ;
+ROW number of tasks TEXT VAR task password ;
+
+task password (1) := "-" ;
+task password (2) := "-" ;
+
+set clock (date ("09.06.86")) ;
+
+TASK VAR dummy task ;
+command dialogue (TRUE) ;
+
+ke ; (* maintenance ke *)
+
+create son (myself, "SYSUR", dummy task, proca (PROC sysur)) ;
+
+PROC sysur :
+
+ disable stop ;
+ begin ("ARCHIVE", PROC archive manager, dummy task) ;
+ begin ("OPERATOR", PROC monitor, dummy task) ;
+ begin ("conf", PROC configurator, dummy task) ;
+ system manager
+
+ENDPROC sysur ;
+
+PROC configurator :
+
+ page ;
+ REP UNTIL yes("Archiv 'dev' eingelegt") PER;
+ archive ("dev") ;
+ fetch all (archive) ;
+ release (archive) ;
+ REP UNTIL yes ("save system") PER ;
+ command dialogue (FALSE) ;
+ save system ;
+ command dialogue (TRUE) ;
+ rename myself ("configurator") ;
+ disable stop ;
+ REP
+ configuration manager ;
+ clear error
+ PER
+
+ENDPROC configurator ;
+
+
+erase last bootstrap source dataspace ;
+channel (myself, 1) ;
+command dialogue (TRUE) ;
+IF yes("Leere Floppy eingelegt")
+ THEN channel (myself, nilchannel) ;
+ command dialogue (FALSE) ;
+ sys op (shutup and save code)
+ ELSE channel (myself, nilchannel) ;
+ command dialogue (FALSE)
+FI ;
+supervisor ;
+
+
+PROC supervisor :
+
+ disable stop ;
+ INT VAR old session := session ;
+ REP
+ wait (ds, order code, order task) ;
+ IF is niltask (order task)
+ THEN interrupt
+ ELIF station (order task) = station (myself)
+ THEN order from task
+ FI
+ PER .
+
+interrupt :
+ IF order code = 0
+ THEN IF old session <> session
+ THEN disconnect all terminal tasks ;
+ old session := session
+ FI ;
+ system start interrupt
+ ELSE supervisor interrupt (canal (order code), order code,
+ connected task (order code))
+ FI .
+
+disconnect all terminal tasks :
+ INT VAR i ;
+ FOR i FROM 1 UPTO highest terminal channel REP
+ TASK VAR id := connected task (i) ;
+ IF NOT (is niltask (id) COR automatic startup flag (index (id))
+ COR is niltask (canal (i)))
+ THEN break task
+ FI
+ PER .
+
+break task :
+ IF task direct connected to channel
+ THEN channel (id, nilchannel) ;
+ connected task (i) := niltask
+ ELSE disconnect if at terminal but overloaded by canal
+ FI .
+
+task direct connected to channel :
+ pcb (id, channel field) <> nilchannel .
+
+disconnect if at terminal but overloaded by canal :
+ connected task (i) := niltask .
+
+order from task :
+ channel index := channel (order task) ;
+ IF is command analyzer task
+ THEN order from command analyzer (connected task (channel index))
+ ELSE order from user task
+ FI ;
+ IF is error
+ THEN send back error message
+ FI .
+
+is command analyzer task :
+ channel index <> nilchannel
+ CAND channel index <= highest terminal channel
+ CAND order task = canal (channel index) .
+
+send back error message :
+ forget (ds) ;
+ ds := nilspace ;
+ error msg := ds ;
+ CONCR (error msg) := error message ;
+ clear error ;
+ send (order task, error nak, ds) .
+
+ENDPROC supervisor ;
+
+PROC supervisor interrupt (TASK VAR command analyzer, INT CONST channel nr,
+ TASK VAR terminal task) :
+
+ IF NOT is niltask (terminal task)
+ THEN channel (terminal task, nilchannel)
+ FI ;
+ create command analyzer if necessary ;
+ IF already at terminal
+ THEN halt process (command analyzer)
+ ELSE send acknowledge
+ FI ;
+ channel (command analyzer, channel nr) ;
+ activate (command analyzer) .
+
+create command analyzer if necessary :
+ IF is niltask (command analyzer)
+ THEN create son (myself, "-", command analyzer, proca (PROC analyze supervisor command))
+ FI .
+
+send acknowledge :
+ forget (ds) ;
+ ds := nilspace ;
+ send (command analyzer, ack, ds) .
+
+already at terminal : channel (command analyzer) = channel nr .
+
+ENDPROC supervisor interrupt ;
+
+PROC order from command analyzer (TASK VAR terminal task) :
+
+enable stop ;
+IF is continue THEN sv cmd continue
+ELIF order code = system catalogue code THEN task info cmd
+ELIF order code = task of channel code THEN sv cmd task of channel
+ELSE SELECT order code OF CASE ack :
+ CASE end code : sv cmd end
+ CASE break code : sv cmd break
+ CASE halt code : sv cmd halt
+ OTHERWISE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+ END SELECT ;
+ channel (command analyzer, nilchannel)
+FI ;
+
+forget (ds) ;
+IF NOT is niltask (terminal task) AND order code <> system catalogue code
+ THEN channel (order task, nilchannel) ;
+ channel (terminal task, channel index) ;
+ activate (terminal task)
+FI .
+
+sv cmd task of channel :
+ msg := ds ;
+ msg.task := terminal task ;
+ send (order task,ack, ds) ;
+ LEAVE order from command analyzer .
+
+sv cmd end :
+ IF NOT is niltask (terminal task)
+ THEN delete task (terminal task) ;
+ terminal task := niltask
+ FI .
+
+sv cmd break :
+ terminal task := niltask .
+
+sv cmd continue :
+ sv cmd break ;
+ continue cmd by canal .
+
+sv cmd halt :
+ IF is niltask (terminal task)
+ THEN errorstop ("keine Task angekoppelt")
+ ELSE halt process (terminal task)
+ FI .
+
+is continue :
+ order code > continue code low AND order code <= continue code high .
+
+command analyzer : canal (channel index) .
+
+ENDPROC order from command analyzer ;
+
+PROC order from user task :
+
+ enable stop ;
+ SELECT order code OF
+ CASE nak, error nak :
+ CASE system catalogue code : task info cmd
+ CASE begin code : user begin cmd
+ CASE end code : user end cmd
+ CASE break code : user break cmd
+ CASE rename code : user rename cmd
+ CASE password code : password cmd
+ CASE family password code : family password cmd
+ CASE set autonom code : set autonom cmd
+ CASE reset autonom code : reset autonom cmd
+ CASE define canal code : define new canal
+ CASE go back to old canal code : go back to old canal
+ CASE task of channel code : task of channel
+ CASE canal of channel code : canal of channel
+ CASE set automatic startup code : set automatic startup cmd
+ CASE reset automatic startup code : reset automatic startup cmd
+ OTHERWISE IF is continue
+ THEN user continue cmd
+ ELIF is define station
+ THEN define new station
+ ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+ FI
+ ENDSELECT .
+
+user begin cmd :
+ msg := ds ;
+ create son (order task, new task name, new task, new start proc) ;
+ send (order task, ack, ds) .
+
+user end cmd :
+ msg := ds ;
+ TASK VAR to be erased := CONCR (msg).task ;
+ IF task end permitted
+ THEN delete task (to be erased)
+ ELSE errorstop ("'end' unzulaessig")
+ FI ;
+ IF exists (order task)
+ THEN send (order task, ack, ds)
+ ELSE forget (ds)
+ FI .
+
+task end permitted :
+ ( (task is dead AND system catalogue contains entry) OR exists (to be erased))
+ CAND ( to be erased = order task
+ COR to be erased < order task
+ COR (order task < myself AND NOT (order task < to be erased)) ) .
+
+task is dead :
+ status (to be erased) > 6 .
+
+system catalogue contains entry :
+ task in catalogue (to be erased, index (to be erased)) .
+
+user rename cmd :
+ IF last rename was long ago
+ THEN msg := ds ;
+ name (order task, CONCR (msg).tname) ;
+ update entry in connected task array ;
+ send (order task, ack, ds) ;
+ remember rename time
+ ELSE send (order task, nak, ds)
+ FI .
+
+update entry in connected task array :
+ IF channel (order task) <> nilchannel
+ THEN connected task (channel (order task)) := order task
+ FI .
+
+remember rename time :
+ last rename time := clock (1) .
+
+last rename was long ago : abs (clock (1) - last rename time) > 20.0 .
+
+user break cmd :
+ break order task ;
+ send (order task, ack, ds) .
+
+break order task :
+ IF task direct connected to channel
+ THEN channel (order task, nilchannel) ;
+ terminal task := niltask
+ ELSE disconnect if at terminal but overloaded by canal
+ FI .
+
+task direct connected to channel : channel index <> nilchannel .
+
+terminal task : connected task (channel index) .
+
+disconnect if at terminal but overloaded by canal :
+ INT VAR i ;
+ FOR i FROM 1 UPTO highest terminal channel REP
+ IF connected task (i) = order task
+ THEN connected task (i) := niltask ;
+ LEAVE disconnect if at terminal but overloaded by canal
+ FI
+ PER .
+
+user continue cmd :
+ INT CONST dest channel := order code - continue code low ;
+ IF dest channel <= highest user channel OR order task < myself
+ THEN IF NOT channel really existing
+ THEN errorstop ("kein Kanal")
+ ELIF dest channel is free OR task is already at dest channel
+ THEN break order task ;
+ continue (order task, dest channel) ;
+ autonom flag (index (order task)) := FALSE ;
+ send (order task, ack, ds)
+ ELSE errorstop ("Kanal belegt")
+ FI
+ ELSE errorstop ("ungueltiger Kanal")
+ FI .
+
+channel really existing :
+ channel type (dest channel) <> 0 OR dest channel = configurator channel .
+
+dest channel is free :
+ (is niltask (connected task (dest channel)) OR channel (connected task (dest channel)) = nilchannel)
+ AND no canal active .
+
+no canal active :
+ dest channel > highest terminal channel COR
+ is niltask (canal (dest channel)) COR
+ channel (canal (dest channel)) = nilchannel .
+
+task is already at dest channel :
+ channel index = dest channel .
+
+
+password cmd :
+ msg := ds ;
+ task password (index (order task)) := new task password ;
+ forget (ds) ;
+ ds := nilspace ;
+ send (order task, ack, ds) .
+
+family password cmd :
+ msg := ds ;
+ actual password := new task password ;
+ supply password := task password (index (order task)) ;
+ change pw of all sons where necessary (son (order task)) ;
+ task password (index (order task)) := actual password ;
+ forget (ds) ;
+ ds := nilspace ;
+ send (order task, ack, ds) .
+
+set autonom cmd :
+ autonom flag (index (order task)) := TRUE ;
+ send (order task, ack, ds) .
+
+reset autonom cmd :
+ autonom flag (index (order task)) := FALSE ;
+ send (order task, ack, ds) .
+
+define new canal :
+ IF order task < myself AND
+ channel index > 0 AND channel index <= highest terminal channel CAND
+ is niltask (canal (channel index))
+ THEN canal (channel index) := order task ;
+ connected task (channel index) := niltask ;
+ send (order task, ack, ds)
+ ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+ FI .
+
+go back to old canal :
+ IF order task < myself AND
+ channel index > 0 AND channel index <= highest terminal channel
+ THEN IF NOT is niltask (canal (channel index))
+ THEN delete task (canal (channel index))
+ FI ;
+ send (order task, ack, ds)
+ ELSE errorstop ("falscher Auftrag fuer Task ""SUPERVISOR""")
+ FI .
+
+task of channel :
+ msg := ds ;
+ channel nr := int (msg.tname) ;
+ msg.task := channel task ;
+ send (order task, ack, ds).
+
+channel task :
+ IF channel nr <= highest terminal channel
+ THEN IF no command analyzer active
+ THEN connected task (channel nr)
+ ELSE canal (channel nr)
+ FI
+ ELSE connected task (channel nr)
+ FI .
+
+no command analyzer active :
+ channel (canal (channel nr)) = nilchannel .
+
+canal of channel :
+ msg := ds ;
+ channel nr := int (msg.tname) ;
+ msg.task := canal (channel nr) ;
+ send (order task, ack, ds).
+
+set automatic startup cmd :
+ automatic startup flag (index (order task)) := TRUE ;
+ send (order task, ack, ds) .
+
+reset automatic startup cmd :
+ automatic startup flag (index (order task)) := FALSE ;
+ send (order task, ack, ds) .
+
+is continue :
+ order code > continue code low AND order code <= continue code high .
+
+new task name : CONCR (msg).tname .
+
+new task : CONCR (msg).task .
+
+new task password : subtext (CONCR (msg).tpass, 1, 100) .
+
+new start proc : CONCR (msg).start proc .
+
+is define station :
+ order code >= define station code AND order task < myself AND
+ order code <= define station code + max station no .
+
+ENDPROC order from user task ;
+
+PROC continue cmd by canal :
+
+ access task name and password ;
+ check password if necessary ;
+ continue or send continue request ;
+ channel (order task, nilchannel) .
+
+access task name and password :
+ msg := ds ;
+ TASK CONST user task := task (CONCR (msg).tname) ;
+ INT CONST task index := index (user task) ;
+ actual password := task password (task index) ;
+ supply password := CONCR (msg).tpass .
+
+check password if necessary :
+ IF actual password <> ""
+ THEN IF supply password = ""
+ THEN ask for password ;
+ LEAVE continue cmd by canal
+ ELIF actual password <> supply password OR actual password = "-"
+ THEN errorstop ("Passwort falsch")
+ FI
+ FI .
+ask for password :
+ send (order task, password code, ds) .
+
+continue or send continue request :
+ IF autonom flag (task index)
+ THEN send continue request to user task
+ ELSE continue (user task, order code - continue code low)
+ FI .
+
+send continue request to user task :
+ INT VAR request count , quit ;
+ FOR request count FROM 1 UPTO 10 REP
+ send (user task, order code, ds, quit) ;
+ IF quit = ack
+ THEN LEAVE send continue request to user task
+ FI ;
+ pause (3)
+ PER ;
+ errorstop ("Task antwortet nicht") .
+
+ENDPROC continue cmd by canal ;
+
+PROC continue (TASK CONST id, INT CONST channel nr) :
+
+ IF NOT is niltask (id) CAND channel (id) <> channel nr
+ THEN check whether not linked to another channel ;
+ channel (id, channel nr) ;
+ connected task (channel nr) := id ;
+ prio (id, 0) ;
+ activate (id)
+ FI .
+
+check whether not linked to another channel :
+ INT VAR i ;
+ FOR i FROM 1 UPTO number of channels REP
+ IF connected task (i) = id
+ THEN errorstop ("bereits an Kanal " + text (i) ) ;
+ LEAVE continue
+ FI
+ PER .
+
+ENDPROC continue ;
+
+PROC task info cmd :
+
+ forget (ds) ;
+ ds := sys cat ;
+ send (order task, ack, ds) .
+
+ENDPROC task info cmd ;
+
+PROC delete task (TASK CONST superfluous) :
+
+ delete all sons of superfluous ;
+ delete superfluous itself .
+
+delete superfluous itself :
+ update cpu time of father ;
+ erase process (superfluous) ;
+ delete (superfluous) ;
+ erase terminal connection remark .
+
+update cpu time of father :
+ TASK CONST father task := father (superfluous) ;
+ IF NOT is niltask (father task)
+ THEN disable stop ;
+ REAL CONST father time := clock (father task) + clock (superfluous);
+ IF is error
+ THEN clear error
+ ELSE set clock (father task, father time)
+ FI ;
+ enable stop
+ FI .
+
+erase terminal connection remark :
+ INT VAR i ;
+ FOR i FROM 1 UPTO number of channels REP
+ IF connected task (i) = superfluous
+ THEN connected task (i) := niltask ;
+ LEAVE erase terminal connection remark
+ FI
+ PER ;
+ FOR i FROM 1 UPTO highest terminal channel REP
+ IF canal (i) = superfluous
+ THEN canal (i) := niltask ;
+ LEAVE erase terminal connection remark
+ FI
+ PER .
+
+delete all sons of superfluous :
+ TASK VAR son task ;
+ REP
+ son task := son (superfluous) ;
+ IF is niltask (son task)
+ THEN LEAVE delete all sons of superfluous
+ FI ;
+ delete task (son task)
+ PER .
+
+ENDPROC delete task ;
+
+PROC create son (TASK CONST father, TEXT CONST task name, TASK VAR new task, PROCA CONST start) :
+
+ entry (father, task name, new task) ;
+ autonom flag (index (new task)) := FALSE ;
+ automatic startup flag (index (new task)) := TRUE ;
+ task password (index (new task)) := "" ;
+ create (father, new task, privilege, start) .
+
+privilege :
+ IF new task < myself
+ THEN 1
+ ELSE 0
+ FI .
+
+ENDPROC create son ;
+
+
+PROC system start interrupt :
+
+ IF exists task ("configurator")
+ THEN send system start message
+ FI .
+
+send system start message :
+ ds := nilspace ;
+ INT VAR request count, quit ;
+ FOR request count FROM 1 UPTO 10 REP
+ send (task ("configurator"), system start code, ds, quit) ;
+ IF quit = ack
+ THEN LEAVE send system start message
+ FI ;
+ pause (3)
+ PER ;
+ forget (ds) .
+
+ENDPROC system start interrupt ;
+
+PROC define new station :
+
+ INT CONST station := order code - define station code ;
+ INT VAR i ;
+ FOR i FROM 1 UPTO highest terminal channel REP
+ IF NOT is niltask (canal (i))
+ THEN delete task (canal (i))
+ FI
+ PER ;
+ define station (station) ;
+ FOR i FROM 1 UPTO number of channels REP
+ update (connected task (i))
+ PER ;
+ forget (ds) .
+
+ENDPROC define new station ;
+
+PROC change pw of all sons where necessary (TASK CONST first son) :
+
+ TASK VAR actual task := first son ;
+ WHILE NOT is niltask (actual task) REP
+ change pw ;
+ change pw of all sons where necessary (son (actual task));
+ actual task := brother (actual task)
+ PER.
+
+ change pw :
+ IF task password (index (actual task)) = supply password
+ OR
+ task password (index (actual task)) = ""
+ THEN task password (index (actual task)) := actual password
+ FI.
+
+END PROC change pw of all sons where necessary ;
+
+(******************* basic supervisor operations **********************)
+
+
+PROC channel (TASK CONST id, INT CONST channel nr) :
+ pcb (id, channel field, channel nr)
+ENDPROC channel ;
+
+INT PROC channel type (INT CONST channel nr) :
+ disable stop ;
+ channel (myself, channel nr) ;
+ INT VAR type ;
+ control (1, 0, 0, type) ;
+ channel (myself, nilchannel) ;
+ type
+ENDPROC channel type ;
+
+PROC erase last bootstrap source dataspace :
+
+ disable stop ;
+ errorstop ("") ;
+ clear error
+
+ENDPROC erase last bootstrap source dataspace ;
+
+PROC set clock (TASK CONST id, REAL CONST clock value) :
+ EXTERNAL 82
+ENDPROC set clock ;
+
+PROC sys op (INT CONST code) :
+ EXTERNAL 90
+END PROC sys op ;
+
+PROC create (TASK CONST father, son, INT CONST priv, PROCA CONST start) :
+ EXTERNAL 95
+ENDPROC create ;
+
+PROC pcb (TASK CONST id, INT CONST field, value) :
+ EXTERNAL 105
+ENDPROC pcb ;
+
+PROC activate (TASK CONST id) :
+ EXTERNAL 108
+ENDPROC activate ;
+
+PROC deactivate (TASK CONST id) :
+ EXTERNAL 109
+ENDPROC deactivate ;
+
+PROC halt process (TASK CONST id) :
+ EXTERNAL 110
+ENDPROC halt process ;
+
+PROC erase process (TASK CONST id) :
+ EXTERNAL 112
+ENDPROC erase process ;
+
+ENDPACKET supervisor ;
+
--
cgit v1.2.3