Initial import

1 files changed, 553 insertions, 0 deletions

diff --git a/system/multiuser/1.7.5/src/configuration manager b/system/multiuser/1.7.5/src/configuration manager
new file mode 100644
index 0000000..5eaea52
--- /dev/null
+++ b/system/multiuser/1.7.5/src/configuration manager
@@ -0,0 +1,553 @@
+(* ------------------- VERSION 11     02.06.86 ------------------- *)
+PACKET configuration manager DEFINES
+ 
+       configurate ,
+       exec configuration ,
+       setup ,
+       define collector ,
+       configuration manager :
+
+ 
+LET baudrates      = ""1"50"2"75"3"110"4"134.5"5"150"6"300"7"600
+"8"1200"9"1800"10"2400"11"3600"12"4800"13"7200
+"14"9600"15"19200"16"38400"17"",
+    parities       = ""0"no"1"odd"2"even"3"" ,
+    bits per char  = ""0"1"1"2"2"3"3"4"4"5"5"6"6"7"7"8"8"" ,
+    stopbits       = ""0"1"1"1.5"2"2"3"" ,
+    flow modes     = ""0"ohne Protokoll"1"XON/XOFF"2"RTS/CTS
+"3""4""5"XON/XOFF - ausgabeseitig"6"RTS/CTS - ausgabeseitig"7""8"
+"9"XON/XOFF - eingabeseitig"10"RTS/CTS - eingabeseitig"11"" ,
+
+    ok             = "j" ,
+    esc            = ""27"" ,
+    cr             = ""13"" ,
+    right          = ""2"" ,
+
+    psi            = "psi" ,
+    transparent    = "transparent" ,
+
+    std rate          = 14 ,
+    std bits          = 22 ,
+    std flow          = 0 ,
+    std inbuffer size = 16 ,
+
+    device table      = 32000 ,
+
+    max edit terminal      = 15 ,
+    configuration channel  = 32 ,
+
+    fetch code             = 11 ,
+    save  code             = 12 ,
+    erase code             = 14 ,
+    system start interrupt = 100 ,
+
+    CONF = STRUCT (TEXT dev type,
+                   INT baud, bits par stop, flow control, inbuffer size) ;
+ 
+ 
+BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ;
+
+BOUND ROW max edit terminal CONF VAR conf ;
+
+INT VAR channel no ;
+
+TEXT VAR prelude , last feature , answer , collector := "" ;
+
+
+ 
+BOOL PROC shard permits (INT CONST code, key) :
+
+  INT VAR reply ; 
+  IF key > -128
+    THEN control (code, channel no, key, reply)
+    ELSE control (code, channel no, -maxint-1, reply)
+  FI ;
+  reply = 0 . 
+
+ENDPROC shard permits ;
+
+PROC ask user (TEXT CONST feature, question) :
+
+  last feature := feature ;
+  put question ;
+  skip pretyped chars ;
+  get valid answer .
+
+put question :
+  clear line ;
+  out (prelude) ;
+  out (feature) ;
+  out (question) ;
+  out (" (j/n) ") .
+
+clear line :
+  out (cr) ;
+  79 TIMESOUT " " ;
+  out (cr) .
+
+skip pretyped chars :
+  REP UNTIL incharety = "" PER .
+
+get valid answer :
+  REP
+    inchar (answer)
+  UNTIL pos ("jJyYnN"27"", answer) > 0 PER ;
+  IF answer > ""31""
+    THEN out (answer)
+  FI ;
+  out (cr) ;
+  normalize answer .
+
+normalize answer :
+  IF pos ("jJyY", answer) > 0
+    THEN answer := ok
+  FI .
+
+ENDPROC ask user ;
+
+BOOL PROC yes (TEXT CONST question) :
+
+  ask user ("", question) ;
+  answer = ok
+
+ENDPROC yes ;
+
+PROC chose key (INT VAR old key, INT CONST max key, TEXT CONST key string,
+                key entity, BOOL PROC (INT CONST) shard permits):
+
+  IF shard permits at least one standard key
+    THEN try all keys
+  FI .
+
+shard permits at least one standard key :
+  INT VAR key ;
+  FOR key FROM 0 UPTO max key REP
+    IF shard permits (key)
+      THEN LEAVE shard permits at least one standard key WITH TRUE
+    FI
+  PER ;
+  FALSE .
+
+try all keys :
+  key := old key ;
+  REP
+    examine this key ;
+    next key
+  PER .
+
+examine this key :
+  IF shard permits (key) CAND key value <> ""
+    THEN ask user (key value, key entity) ;
+         IF answer = ok
+           THEN chose this key
+         ELIF answer = esc
+           THEN key := -129
+         FI
+  FI .
+
+key value : 
+  IF key >= 0
+    THEN subtext (key string, key pos + 1, next key pos - 1)
+    ELSE text (key)
+  FI .
+
+key pos       : pos (key string, code (key)) .
+next key pos  : pos (key string, code (key+1)) .
+
+chose this key :
+  remember calibration ;
+  old key := key ;
+  LEAVE chose key .
+
+next key :
+  IF key < max key
+    THEN key INCR 1
+    ELSE key := 0
+  FI .
+
+remember calibration :
+  prelude CAT last feature ;
+  prelude CAT ", " .
+
+ENDPROC chose key ;
+
+BOOL PROC rate ok (INT CONST key) :
+
+  shard permits (8, key)
+
+ENDPROC rate ok ;
+
+BOOL PROC bits ok (INT CONST key) :
+
+  IF key < 0
+    THEN shard permits (9, key)
+    ELSE some standard combination ok
+  FI .
+
+some standard combination ok :
+  INT VAR combined := key ;
+  REP
+    IF shard permits (9, combined)
+      THEN LEAVE bits ok WITH TRUE
+    FI ;
+    combined INCR 8
+  UNTIL combined > 127 PER ;
+  FALSE
+
+ENDPROC bits ok ;
+
+BOOL PROC parity ok (INT CONST key) :
+
+  INT VAR combined := 8 * key + data bits ;
+  key >= 0 AND (shard permits (9, combined)      OR
+                shard permits (9, combined + 32) OR
+                shard permits (9, combined + 64)    )
+
+ENDPROC parity ok ;
+
+BOOL PROC stopbits ok (INT CONST key) :
+
+  key >= 0 AND shard permits (9, 32 * key + 8 * parity + data bits)
+
+ENDPROC stopbits ok ;
+
+BOOL PROC flow mode ok (INT CONST key) :
+
+  shard permits (6, key)
+
+ENDPROC flow mode ok ;
+
+
+
+INT VAR data bits ,
+        parity ,
+        stop ;
+
+INT VAR old session := 0 ;
+
+
+TEXT VAR table name, dummy ;
+
+
+PROC configurate :
+
+  new configuration ;
+  access configuration table ;
+  show all device types ;
+  channel no := 1 ;
+  REP
+    IF channel hardware exists
+      THEN try this channel ;
+           setup this channel
+    FI ;
+    channel no INCR 1
+  UNTIL channel no > 15 PER ;
+  prelude := "" ;
+  IF yes ("Koennen unbenutzte Geraetetypen geloescht werden")
+    THEN forget unused device tables
+  FI .
+
+access configuration table :
+  IF exists ("configuration")
+    THEN conf := old ("configuration")
+    ELSE conf := new ("configuration") ;
+         initialize configuration
+  FI .
+
+initialize configuration :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    conf (channel no) :=
+    CONF:(transparent, std rate, std bits, std flow, std inbuffer size)
+  PER ;
+  conf (1).dev type := psi .
+
+show all device types :
+  show prelude ;
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF dataspace is device table
+      THEN show table name
+    FI ;
+    get list entry (table name, dummy)
+  PER ;
+  line (2) .
+
+show prelude :
+  line (30) ;
+  outtext (psi, 1, 20) ;
+  outtext (transparent, 1, 20) .
+
+dataspace is device table :
+  type (old (table name)) = device table .
+
+show table name :
+  outtext (table name, 1, 20) .
+ 
+try this channel :
+  prelude := "Kanal " ;
+  ask user ("", text (channel no)) ;
+  IF answer = ok
+    THEN prelude CAT text (channel no) + ": " ;
+         get configuration from user (conf (channel no)) ;
+         line
+  FI .
+
+channel hardware exists :
+  INT VAR
+  operators channel := channel ;
+  INT VAR channel type ;
+  disable stop ;
+  continue (channel no) ;
+  IF is error
+    THEN IF error message = "kein Kanal"
+           THEN channel type := 0
+           ELSE channel type := inout mask
+         FI
+    ELSE get channel type from shard
+  FI ;
+  clear error ;
+  disable stop ;
+  continue operators channel ; 
+  (channel type AND inout mask) <> 0 .
+
+get channel type from shard :
+  control (1, 0, 0, channel type) .
+
+inout mask : 3 .
+
+forget unused device tables :
+  begin list ;
+  get list entry (table name, dummy) ;
+  WHILE table name <> "" REP
+    IF type (old (table name)) = device table
+      THEN forget if unused
+    FI ;
+    get list entry (table name, dummy)
+  PER .
+
+forget if unused :
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    IF conf (channel no).dev type = table name
+      THEN LEAVE forget if unused
+    FI
+  PER ;
+  forget (table name, quiet) .
+
+setup this channel :
+  operators channel := channel ;
+  disable stop ;
+  continue (configuration channel) ;
+  set up channel (channel no, conf (channel no)) ;
+  continue operators channel . 
+
+continue operators channel :
+  continue (operators channel) ;
+  IF is error
+    THEN clear error ;
+         break (quiet) ;
+         LEAVE configurate
+  FI ;
+  enable stop .
+
+ENDPROC configurate ;
+
+PROC get configuration from user (CONF VAR conf) :
+
+  get device type ;
+  get baud rate ;
+  get bits and parity and stopbits ;
+  get protocol ;
+  get buffer size .
+
+
+get device type :
+  begin list ;
+  table name := conf.dev type ;
+  IF NOT is valid device type
+    THEN next device type
+  FI ;
+  REP
+    IF NOT (table name = transparent AND channel no = 1)
+      THEN ask user ("", table name) ;
+           IF answer = ok COR was esc followed by type table name
+             THEN IF is valid device type 
+                    THEN remember device type ;
+                         LEAVE get device type
+                    ELSE out (""7" unbekannter Typ"); pause (20) 
+                  FI
+           FI
+    FI ;
+    next device type
+  PER .
+
+was esc followed by type table name :
+  IF answer = esc
+    THEN 9 TIMESOUT right ;
+         put ("Typ:") ;
+         editget (table name) ;
+         TRUE
+    ELSE FALSE
+  FI .
+
+is valid device type :
+  table name = psi OR table name = transparent OR
+  (exists (table name) CAND type (old (table name)) = device table) .
+
+remember device type :
+  prelude CAT table name ;
+  conf.dev type := table name ;
+  prelude CAT ", " .
+
+next device type :
+  IF table name = psi
+    THEN table name := transparent
+    ELSE IF table name = transparent
+           THEN begin list
+         FI ;
+         search next device type space
+  FI .
+
+search next device type space :
+  REP
+    get list entry (table name, dummy)
+  UNTIL table name = "" COR type (old (table name)) = device table PER;
+  IF table name = ""
+    THEN table name := psi
+  FI .
+
+get baud rate :
+  chose key (conf.baud, 16, baudrates, " Baud", PROC rate ok) .
+
+get bits and parity and stopbits :
+  data bits := conf.bits par stop MOD 8 ;
+  parity := (conf.bits par stop DIV 8) MOD 4 ;
+  stop := (conf.bits par stop DIV 32) MOD 4 ;
+  chose key (data bits, 7, bits per char, " Bits", PROC bits ok) ;
+  IF data bits >= 0
+    THEN chose key (parity, 2, parities, " parity", PROC parity ok) ;
+         chose key (stop, 2, stopbits, " Stopbits", PROC stopbits ok);
+         conf.bits par stop := data bits + 8 * parity + 32 * stop
+    ELSE conf.bits par stop := data bits
+  FI .
+
+get protocol :
+  chose key (conf.flow control, 10, flow modes,
+             "", PROC flow mode ok) .
+
+get buffer size :
+  IF dev type is transparent
+    THEN chose buffer size
+    ELSE conf.inbuffer size := std inbuffer size
+  FI .
+
+dev type is transparent :
+  conf.dev type = "transparent" .
+
+chose buffer size :
+  REP
+    IF conf.inbuffer size = 16 CAND yes ("normaler Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 512 ;
+    IF yes ("grosser Puffer")
+      THEN LEAVE chose buffer size
+    FI ;
+    conf.inbuffer size := 16
+  PER .
+
+ENDPROC get configuration from user ;
+
+PROC exec configuration :
+
+  setup
+
+ENDPROC exec configuration ;
+
+PROC setup :
+
+  conf := old ("configuration") ;
+  continue (configuration channel) ;
+  FOR channel no FROM 1 UPTO max edit terminal REP
+    set up channel (channel no, conf (channel no))
+  PER ;
+  set up collector task ;
+  break but do not forget error message if any .
+
+set up collector task :
+  IF collector <> "" CAND collector <> "-" CAND exists task (collector)
+    THEN define collector (task (collector))
+  FI .
+
+break but do not forget error message if any :
+  IF is error
+    THEN dummy := error message ;
+         clear error ;
+         break (quiet) ;
+         errorstop (dummy)
+    ELSE break (quiet)
+  FI .
+
+ENDPROC set up ;
+
+PROC set up channel (INT CONST channel no, CONF CONST conf) :
+
+  link (channel no, conf.dev type) ;
+  baudrate (channel no, conf.baud) ;
+  bits (channel no, conf.bits par stop) ;
+  flow (channel no, conf.flow control) ;
+  input buffer size (channel no, conf.inbuffer size) .
+
+ENDPROC setup channel ;
+
+PROC configuration manager (DATASPACE VAR ds, INT CONST order, phase,
+                            TASK CONST order task) :
+
+  enable stop ;
+  IF order <> system start interrupt
+    THEN font manager
+  FI ;
+  IF session <> old session
+    THEN disable stop ;
+         set up ;
+         clear error ;
+         old session := session ;
+         set autonom
+  FI .
+
+  font manager :
+    IF (order <> save code AND order <> erase code ) OR order task < supervisor
+       THEN delete password if there is one;
+            free manager (ds, order, phase, order task)
+       ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """")
+    FI .
+ 
+  delete password if there is one :
+    IF order >= fetch code AND order <= erase code AND phase = 1
+       THEN msg := ds;
+            msg. write pass := "";
+            msg. read  pass := "";
+    FI .
+ 
+ENDPROC configuration manager ;
+
+PROC configuration manager :
+
+  configurate ;
+  break ;
+  global manager
+  (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST) configuration manager)
+
+ENDPROC configuration manager ;
+
+PROC define collector (TEXT CONST task table name) :
+
+  collector := task table name ;
+  IF exists task (collector)
+    THEN define collector (task (collector))
+  FI
+
+ENDPROC define collector ;
+
+ENDPACKET configuration manager ;
+