From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- system/multiuser/1.7.5/src/configuration manager | 553 +++++++++++++++++++++++ 1 file changed, 553 insertions(+) create mode 100644 system/multiuser/1.7.5/src/configuration manager (limited to 'system/multiuser/1.7.5/src/configuration manager') 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 ; + -- cgit v1.2.3