path: root/system/multiuser/1.7.5/src/configuration manager

(* ------------------- 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 ;