summaryrefslogtreecommitdiff
path: root/system/multiuser/1.7.5/src/configuration manager
blob: 5eaea5250464ef6b5554b2c21303719bba078950 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
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 ;