summaryrefslogtreecommitdiff
path: root/system/at/1.8.7/src/AT Utilities
blob: 760e72830175bcdfb91fdebd1f4f3fce61984e81 (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
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
(*************************************************************************)
(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und        ***)
(*** Booten in anderen Partitionen benötigt wird.                      ***)
(***                                                                   ***)
(*** Zusammengestellt und geändert : Werner Sauerwein, GMD             ***)
(***                         Stand : 31.10.86                          ***)
(*************************************************************************)

PACKET splitting DEFINES  low byte,     (* Copyright (C) 1985       *)
                          high byte,    (* Martin Schönbeck, Spenge *)
                          low word,     (* Stand: 13.09.85          *)
                          high word: 
 
INT PROC high byte (INT CONST value):
 
    TEXT VAR x := "  ";
    replace (x, 1, value);
    code (x SUB 2)

END PROC high byte;

INT PROC low byte (INT CONST value):
 
    TEXT VAR x := "  ";
    replace (x, 1, value);
    code (x SUB 1)

END PROC low byte; 
 
INT PROC high word (REAL CONST double precission int):

    int (double precission int / 65536.0)

END PROC high word;

INT PROC low word (REAL CONST double precission int): 
 
    string of low bytes ISUB 1.

string of low bytes:
    code (int (double precission int MOD 256.0)) +
    code (int ((double precission int MOD 65536.0) / 256.0)). 
 
END PROC low word; 

END PACKET splitting;


PACKET basic block io DEFINES
 
  read block,
  write block:

PROC read block (DATASPACE VAR ds,
                 INT CONST ds page no, 
                 INT CONST block no,
                 INT VAR return code):
  read block; 
  retry if read error.
 
read block: 
  block in (ds, ds page no, 0, block no, return code).
 
retry if read error: 
  INT VAR retry;
  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
    reset to block 0 if fifth try; 
    read block 
  PER. 
 
reset to block 0 if fifth try: 
  IF retry = 5 
    THEN block in (ds, ds page no, 0, 0, return code) 
  FI. 
 
END PROC read block;
 
PROC write block (DATASPACE CONST ds,
                 INT CONST ds page no, 
                 INT CONST block no,
                 INT VAR return code):
  write block; 
  retry if write error. 
 
write block: 
  block out (ds, ds page no, 0, block no, return code).
 
retry if write error: 
  INT VAR retry;
  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
    reset to block 0 if fifth try; 
    write block 
  PER. 
 
reset to block 0 if fifth try: 
  IF retry = 5 
    THEN disable stop;
         DATASPACE VAR dummy ds := nilspace;
         block in (dummy ds, 2, 0, 0, return code);
         forget (dummy ds);
         enable stop
  FI. 
 
END PROC write block; 

PROC read block (DATASPACE VAR ds, INT CONST ds page,
                 REAL CONST archive block):

   enable stop;
   read block (ds, ds page, archive block, error);
   INT VAR error;
   SELECT error OF
      CASE 0:
      CASE 1: error stop ("Platte kann nicht gelesen werden");
      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
      CASE 3: error stop ("Versorgungsfehler Archiv");
      OTHERWISE error stop ("unbekannter Fehler auf Platte");
   END SELECT;

END PROC read block;

PROC write block (DATASPACE CONST ds, INT CONST ds page,
                  REAL CONST archive block):

   enable stop;
   write block (ds, ds page, archive block, error);
   INT VAR error;
   SELECT error OF
      CASE 0:
      CASE 1: error stop ("Platte kann nicht geschrieben werden");
      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
      CASE 3: error stop ("Versorgungsfehler Archiv");
      OTHERWISE error stop ("unbekannter Fehler auf Platte");
   END SELECT;

END PROC write block;

PROC read block (DATASPACE VAR ds,
                 INT CONST ds page no, 
                 REAL CONST block no,
                 INT VAR return code):
  read block; 
  retry if read error.
 
read block: 
  block in (ds, ds page no, high word (block no),
                             low word (block no), return code).
 
retry if read error: 
  INT VAR retry;
  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
    reset to block 0 if fifth try; 
    read block 
  PER. 
 
reset to block 0 if fifth try: 
  IF retry = 5 
    THEN block in (ds, ds page no, 0, 0, return code) 
  FI. 
 
END PROC read block;
 
PROC write block (DATASPACE CONST ds,
                 INT CONST ds page no, 
                 REAL CONST block no,
                 INT VAR return code):
  write block; 
  retry if write error. 
 
write block: 
  block out (ds, ds page no, high word (block no),
                              low word (block no), return code).
 
retry if write error: 
  INT VAR retry;
  FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP 
    reset to block 0 if fifth try; 
    write block 
  PER. 
 
reset to block 0 if fifth try: 
  IF retry = 5 
    THEN disable stop;
         DATASPACE VAR dummy ds := nilspace;
         block in (dummy ds, 2, 0, 0, return code);
         forget (dummy ds);
         enable stop
  FI. 
 
END PROC write block; 

END PACKET basic block io;


PACKET utilities DEFINES getchoice, cleol, cleop, inverse, put center:
 
INT PROC get choice (INT CONST von, bis, TEXT VAR retchar):
  get choice (von, bis, von, retchar)
END PROC get choice;

INT PROC get choice (INT CONST von, bis, zusatz, TEXT VAR retchar):
   LET return  = ""13"",
       escape  = ""27"",
       left    = ""8"";
   TEXT VAR buffer; 
   INT VAR cx, cy;
   get cursor (cx, cy); out (" " + left);
   REP
      REP 
         cursor (cx, cy); buffer := incharety;
      UNTIL input ok OR buffer = escape PER; 
      IF buffer = escape THEN retchar := escape;
                              LEAVE get choice WITH 0
      FI;
      out (buffer); 
      leseschleife bis left or ret;
      IF retchar = left   THEN out (left + " ") FI;
      IF retchar = escape THEN LEAVE get choice WITH 0 FI
   UNTIL retchar = return OR retchar = escape PER;
   int (buffer). 
 
input ok : (buffer >= text (von) AND buffer <= text (bis)) OR buffer = text (zusatz).

leseschleife bis left or ret:
   REP 
     inchar (retchar) 
   UNTIL retchar = return OR retchar = left OR retchar = escape PER.

END PROC get choice;

PROC cl eol (INT CONST cx, cy): 
   cursor (cx, cy); 
   cl eol 
END PROC cl eol; 
 
PROC cl eop (INT CONST cx, cy): 
   cursor (cx, cy); 
   cl eop 
END PROC cl eop; 


PROC cl eol: 
  out (""5"") 
END PROC cl eol;

PROC cl eop: 
  out (""4"") 
END PROC cl eop; 

TEXT PROC inverse (TEXT CONST t):
  ""15"" + t + " " + ""14""
END PROC inverse; 
 
PROC put center (TEXT CONST t):
   put center (t, 80)
END PROC put center;

PROC put center (INT CONST zeile, TEXT CONST t):
   put center (zeile, t, 80)
END PROC put center;

PROC put center (TEXT CONST t, INT CONST gesamtbreite):
   INT VAR cy;
   get cursor (cy, cy);
   put center (cy, t, gesamtbreite)
END PROC put center;

PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite):
   cursor ((gesamtbreite - length (t)) DIV 2, zeile);
   put (t).
END PROC put center;

END PACKET utilities


PACKET part DEFINES activate, show actual partition table:
                                           (* Copyright (C) 1985       *)
                                           (* Martin Schönbeck, Spenge *)
                                           (* Stand      : 02.02.86    *)
                                           (* Changed by : W.Sauerwein *)
                                           (*              I.Ley       *)
                                           (* Stand      : 03.10.86    *) 
    LET fd channel           = 28;

ROW 256 INT VAR boot block;
INT VAR boot block session := session - 1;

PROC get boot block:
    IF boot block session <> session
       THEN hole aktuellen boot block
    FI.

hole aktuellen boot block:
    disable stop;
    DATASPACE VAR dummy ds := nilspace;
    BOUND STRUCT (ALIGN dummy, 
                  ROW 256 INT block) VAR partition table := dummy ds; 
    get external block (dummy ds, 2, 0, fd channel); 
    IF NOT is error
        THEN transfer data to boot block
    FI; 
    forget (dummy ds). 
 
transfer data to boot block:
    IF not valid boot block
        THEN try to get valid boot block from file
    FI;
    boot block := partition table. block;
    boot block session := session.

not valid boot block:
    partition table. block [256] <> boot indicator OR
    it is an old boot block of eumel.

boot indicator: -21931.

it is an old boot block of eumel:
    partition table. block [1] = 1514.

try to get valid boot block from file:
    forget (dummy ds);
    partition table := old ("bootblock");
    IF is error THEN LEAVE transfer data to boot block FI.
 
END PROC get boot block;

PROC put boot block:
    IF boot block ist uptodate
        THEN schreibe block auf platte
        ELSE errorstop ("boot block nicht uptodate")
    FI.

boot block ist uptodate:
    boot block session = session.

schreibe block auf platte:
    disable stop;
    DATASPACE VAR dummy ds := nilspace;
    BOUND STRUCT (ALIGN dummy, 
                  ROW 256 INT block) VAR partition table := dummy ds; 
    transfer data to dataspace;
    put external block (dummy ds, 2, 0, fd channel); 
    forget (dummy ds). 
 
transfer data to dataspace:
    partition table. block := boot block.

END PROC put boot block;

INT PROC partition type (INT CONST partition):
    low byte (boot block [entry (partition) + 2])
END PROC partition type;

REAL PROC partition start (INT CONST partition):
    unsigned low word + high word.

unsigned low word:
    real (low byte (boot block [entry (partition) + 4])) +
    real (high byte (boot block [entry (partition) + 4])) * 256.0.

high word:
    real (boot block [entry (partition) + 5]).

END PROC partition start;

INT PROC partition word 0 (INT CONST partition):
   boot block (entry (partition))
END PROC partition word 0;

INT PROC first track (INT CONST partition):
    high byte (boot block [entry (partition) + 1]) 
    + 4 * (low byte (boot block [entry (partition) + 1]) AND (128 + 64)) 
END PROC first track;

INT PROC last track (INT CONST partition):
    high byte (boot block [entry (partition) + 3]) 
    + 4 * (low byte (boot block [entry (partition) + 3]) AND (128 + 64)) 
END PROC last track;

BOOL PROC partition activ (INT CONST partition):
    low byte (boot block [entry (partition)]) = 128
END PROC partition activ;

REAL PROC partition size (INT CONST partition):
    unsigned low word + high word.

unsigned low word:
    real (low byte (boot block [entry (partition) + 6])) +
    real (high byte (boot block [entry (partition) + 6])) * 256.0.

high word:
    real (boot block [entry (partition) + 7]).

END PROC partition size;

INT PROC tracks: 
   get value (-10, fd channel) 
END PROC tracks; 

PROC activate (INT CONST part type):
    IF partition type exists AND is possible type
         THEN deactivate all partitions and
              activate desired partition
         ELSE errorstop ("Gewünschte Partitionart gibt es nicht")
    FI.

is possible type:
   part type > 0 AND
   part type < 256.

partition type exists:
    INT VAR partition;
    FOR partition FROM 1 UPTO 4 REP
         IF partition type (partition) = part type 
             THEN LEAVE partition type exists WITH TRUE
         FI;
    PER;
    FALSE.

deactivate all partitions and activate desired partition:
    FOR partition FROM 1 UPTO 4 REP
         deactivate this partition;
         IF partition type (partition) = part type
              THEN activate partition
         FI
    PER;
    put boot block.

deactivate this partition:
    set bit (boot block [entry (partition)], 7);
    (* first setting needed, because reset bit does xor *)
    reset bit (boot block [entry (partition)], 7).

activate partition:
    set bit (boot block [entry (partition)], 7)

END PROC activate;

INT PROC entry (INT CONST partition):
    get boot block;
    256 - 5 * 8 + (partition * 8)
END PROC entry;

INT PROC get value (INT CONST control code, channel for value): 
    enable stop; 
    INT VAR old channel := channel;
    continue (channel for value); 
    INT VAR value; 
    control (control code, 0, 0, value); 
    continue (old channel); 
    value 
END PROC get value; 
 
PROC get external block (DATASPACE VAR ds, INT CONST ds page,
                                             archive block, get channel):
   INT VAR old channel := channel; 
   continue (get channel);
   disable stop;
   read block (ds, ds page, archive block, error);
   INT VAR error;
   SELECT error OF
      CASE 0:
      CASE 1: error stop ("Platte kann nicht gelesen werden");
      CASE 2: error stop ("Lesefehler bei Block "+ text (archive block));
      CASE 3: error stop ("Versorgungsfehler Archiv");
      OTHERWISE error stop ("unbekannter Fehler auf Platte");
   END SELECT;
   continue (old channel).
END PROC get external block;

PROC put external block (DATASPACE CONST ds, INT CONST ds page,
                                             archive block, get channel):
   INT VAR old channel := channel; 
   continue (get channel);
   disable stop;
   write block (ds, ds page, archive block, error);
   INT VAR error;
   SELECT error OF
      CASE 0:
      CASE 1: error stop ("Platte kann nicht geschrieben werden");
      CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block));
      CASE 3: error stop ("Versorgungsfehler Archiv");
      OTHERWISE error stop ("unbekannter Fehler auf Platte");
   END SELECT;
   continue (old channel).
END PROC put external block;
 
(**************************************************************************)
 
   LET                           max partitions           =   4;
   ROW max partitions INT  VAR   part list;
   ROW max partitions INT  VAR   part type, part active,
                                 part first track, part last track;
   ROW max partitions REAL VAR   part start,
                                 part size;
                      INT  VAR   zylinder,
                                 startzeile tabelle      ::   1,
                                 active partition,
                                 partitions,
                                 partition, i, j, help;

                                 
PROC get actual partition data :
   get boot block;
   zylinder := tracks;
   FOR i FROM 1 UPTO max partitions REP
      part type        (i) := partition type (i);
      part first track (i) := first track (i);
      part last track  (i) := last track (i);
      part start       (i) := partition start (i);
      part size        (i) := partition size (i);
      part active      (i) := partition word 0 (i);
      IF partition activ (i) THEN active partition := i FI
   PER;
   get number of installed partitions;
   generate part list.

get number of installed partitions :
   partitions := 0;
   FOR i FROM 1 UPTO max partitions REP
     IF part type (i) <> 0 THEN partitions INCR 1 FI
   PER.

generate part list :
   FOR i FROM 1 UPTO max partitions REP
      IF part type (i) <> 0 THEN part list (i) := i
                            ELSE part list (i) := 0
      FI;
   PER;
   schiebe nullen nach hinten;
   sort part list.

schiebe nullen nach hinten :
   i := 1; INT VAR k := 0;
   REP k INCR 1;
       IF part list (i) = 0 THEN circle
                            ELSE i INCR 1
       FI
   UNTIL k = max partitions - 1 PER.

circle :
   FOR j FROM i UPTO max partitions - 1 REP
      part list (j) := part list (j + 1)
   PER;
   part list (max partitions) := 0.

sort part list :
   FOR i FROM 2 UPTO partitions REP
      FOR j FROM 1 UPTO i - 1 REP
          IF part first track (part list (i)) < part first track (part list (j))
             THEN tausche FI
      PER
   PER.

tausche :
   help := part list (i);
   part list (i) := part list (j);
   part list (j) := help.

END PROC get actual partition data;


PROC show partition table :
   headline;
   devide table;
   columns;
   underlines;
   rows;
   footlines.

head line :
   cl eop (1, startzeile tabelle);
   put center (inverse ("                       "
                      + "Aktuelle Partitions - Tabelle"
                      + "                       ")).

devide table :
   FOR i FROM 1 UPTO 8
   REP
      cursor (50, startzeile tabelle + i); out (inverse (""))
   PER.

columns :
   cursor ( 1, startzeile tabelle + 2);
   out (" Nr. System    Typ-Nr. Zustand Größe Start Ende");
   cursor (54, startzeile tabelle + 2);
   out ("Plattengröße / Zylinder ").

underlines :
   cursor ( 1, startzeile tabelle + 3);
   out ("-------------------------------------------------");
   cursor (52, startzeile tabelle + 3);
   out ("--------------------------").

rows :
   FOR i FROM 1 UPTO max partitions
   REP cursor (2, startzeile tabelle + 3 + i);
       put (text (i) + " :")
   PER.

footlines:
   cursor (1, startzeile tabelle + 9);
   put center (inverse (75 * " ")).

END PROC show partition table;

PROC update table :
   get actual partition data;
   FOR i FROM 1 UPTO partitions REP update partition PER;
   FOR i FROM partitions + 1 UPTO max partitions REP rubout partition PER;
   zeige plattengroesse.

update partition :
   partition := part list (i);
   show partition.

rubout partition :
   cursor (6, startzeile tabelle + 3 + i);
   out ("                                          ").

show partition :
   cursor (6, startzeile tabelle + 3 + i);
   put (name + type + zustand  + groesse + startspur + endspur).

name : subtext (subtext (part name, 1, 9)
              + "          ", 1, 10).

type : text (part type (partition), 5) + "   ".

zustand   : IF active partition = partition THEN (" aktiv ")
                                            ELSE ("       ")
            FI.

startspur : " " + text (part first track (partition), 5).
endspur   :       text (part last track   (partition), 6).
groesse   :       text (part groesse, 5).

zeige plattengroesse :
   put gesamt;
   put noch freie;
   put maximaler zwischenraum.

put maximaler zwischenraum :
   cursor (54, startzeile tabelle + 6);
   put ("max. zusammenh. : " + text (maximaler zwischenraum, 4)).

put gesamt :
   cursor (54, startzeile tabelle + 4);
   put ("insgesamt       : " + text (zylinder, 4)).

put noch freie :
   cursor (54, startzeile tabelle + 5);
   put ("davon noch frei : " + text (freie zylinder, 4)).

part groesse :
   partition groesse (partition).

part name :
   SELECT part type (partition) OF
     CASE              1 : "DOS"
     CASE 69, 70, 71, 72 : "EUMEL"
     OTHERWISE text (part type (partition))
   END SELECT.

freie zylinder :
   zylinder - belegte zylinder.

belegte zylinder :
   help := 0;
   FOR i FROM 1 UPTO partitions REP
      help INCR partition groesse (part list (i))
   PER;
   help.

END PROC update table;
 
INT PROC maximaler zwischenraum :
   IF partitions = 0 THEN zylinder
                     ELSE max (maximaler platz vor und zwischen den partitionen,
                               platz hinter letzter partition)
   FI.

maximaler platz vor und zwischen den partitionen :
   help := platz vor erster partition;
   FOR i FROM 1 UPTO partitions - 1
   REP
      help := max (help, begin of part i plus 1 - end of part i - 1)
   PER;
   help.

platz vor erster partition :
   part first track (part list (1)).

platz hinter letzter partition :
   zylinder - part last track (part list (partitions)) - 1.

begin of part i plus 1 :
   part first track (part list (i + 1)).

end of part i :
   part last track (part list (i)).

END PROC maximaler zwischenraum;

INT PROC partition groesse (INT CONST part) :
   part last track (part) - part first track (part) + 1
END PROC partition groesse;

PROC show actual partition table:
   show partition table;
   update table;
   line (4)
END PROC show actual partition table;

PROC show actual partition table (ROW max partitions INT VAR typnr):
   show actual partition table;
   FOR i FROM 1 UPTO max partitions REP
      typnr (i) := partition type (part list (i))
   PER;
END PROC show actual partition table;

END PACKET part;


PACKET hw clock DEFINES hw clock:        (* Copyright (C) 1985       *)
                                         (* Martin Schönbeck, Spenge *)
LET clock length  = 7,                   (* Stand: 06.11.85          *)
    clock command = 4;

BOUND STRUCT (ALIGN dummy,
              ROW clock length INT clock field) VAR clock data;

REAL PROC hw clock:
 
    disable stop;
    get clock;
    hw date + hw time.

get clock:
    DATASPACE VAR ds := nilspace;
    clock data := ds;
    INT VAR return code, actual channel := channel;
    go to shard channel;
    blockin (ds, 2, -clock command, 0, return code);
    IF actual channel = 0 THEN break (quiet)
                          ELSE continue (actual channel)
    FI;
    IF return code <> 0 
        THEN errorstop ("Keine Hardware Uhr vorhanden");
    FI;
    put clock into text;
    forget (ds).

put clock into text:
    TEXT VAR clock text := clock length * "  ";
    INT VAR i;
    FOR i FROM 1 UPTO clock length REP
         replace (clock text, i, clock data. clock field [i]);
    PER.

go to shard channel:
    INT VAR retry;
    FOR retry FROM 1 UPTO 20 REP
        continue (32);
        IF is error
            THEN clear error;
                 pause (30)
        FI;
    UNTIL channel = 32 PER.

hw date:
    date (day + "." + month + "." + year).

day:    subtext (clock text, 7, 8).

month:  subtext (clock text, 5, 6).

year:   subtext (clock text, 1, 4).

hw time:
    time (hour + ":" + minute + ":" + second).

hour:   subtext (clock text, 9, 10).

minute: subtext (clock text, 11, 12).

second: subtext (clock text, 13, 14).

END PROC hw clock;

END PACKET hw clock


PACKET old shutup DEFINES old shutup,       (* Copyright (C) 1985       *)
                          old save system:  (* Martin Schönbeck, Spenge *)
                                            (* Stand: 06.11.85          *)
PROC old shutup : shutup END PROC old shutup;

PROC old save system : save system END PROC old save system;

END PACKET old shutup;


PACKET new shutup DEFINES shutup,
                          shutup dialog,
                          save system,
                          generate shutup manager,
                          generate shutup dialog manager:

LET ack = 0;

PROC shutup:
 
    system down (PROC old shutup)

END PROC shutup;

PROC shutup (INT CONST new system):
 
    IF new system <> 0
         THEN prepare for new system
    FI;
    system down (PROC old shutup).

prepare for new system:
    activate (new system);
    prepare for rebooting.

prepare for rebooting:
    INT VAR old channel := channel;
    continue (32);
    INT VAR dummy;
    control (-5, 0, 0, dummy);
    break (quiet);
    continue (old channel).

END PROC shutup;

PROC save system:
 
    IF yes ("Leere Floppy eingelegt")
       THEN system down (PROC old save system)
    FI

END PROC save system;

PROC system down (PROC operation):

   BOOL VAR dialogue :: command dialogue;
   command dialogue (FALSE);
   operation;
   command dialogue (dialogue);
   IF command dialogue
      THEN wait for configurator;
           show date;
   FI.

show date:
   page;
   line (2); 
   put ("      Heute ist der"); putline (date);
   put ("      Es ist"); put (time of day); putline ("Uhr");
   line (2).

END PROC system down;

DATASPACE VAR ds := nilspace;

PROC wait for configurator:

   INT VAR i, receipt;
   FOR i FROM 1 UPTO 20 WHILE configurator exists REP
      pause (30);
      forget (ds);
      ds := nilspace;
      ping pong (configurator, ack, ds, receipt)
   UNTIL receipt >= 0 PER.

configurator exists:
   disable stop;
   TASK VAR configurator := task ("configurator");
   clear error;
   NOT is niltask (configurator).

END PROC wait for configurator;

PROC generate shutup manager:
 
     generate shutup manager ("shutup", 0);

END PROC generate shutup manager;

PROC generate shutup manager (TEXT CONST name, INT CONST new system):
 
     TASK VAR son;
     shutup question := name;
     new system for manager := new system;
     begin (name, PROC shutup manager, son)

END PROC generate shutup manager;

INT VAR new system for manager;
TEXT VAR shutup question;

PROC shutup manager:

     disable stop;
     command dialogue (TRUE);
     REP 
        break;
        line ;
        IF yes (shutup question)
            THEN clear error;
                 shutup (new system for manager);
                 pause (300);
        FI;
     PER

END PROC shutup manager;

PROC shutup dialog:
   init;
   show actual partition table (typnr);
   REP
      enter part number;
      get cursor (cx, cy);
      IF NOT escaped CAND yes (shutup question)
         THEN message;
              shutup (partition type);
              LEAVE shutup dialog
      FI;
   PER.

shutup question:
   IF partition null
      THEN "Shutup ausführen"
      ELSE "Shutup nach Partition mit Typnummer " + text (typnr (partition)) + " ausführen"
   FI.

message:
   cl eol (1, cy);
   put line ("Bitte auf ENDE - Meldung warten !").

partition type:
   IF partition = 0
      THEN 0
      ELSE typnr (partition)
   FI.

init:
   LET  startzeile menu  =  12, 
        escape           = ""27"",
        max partitions   =   4;

   ROW max partitions INT VAR typnr;
   INT VAR partition, cx, cy;
   TEXT VAR retchar.

partition null:
   partition = 0 COR typnr (partition) = 0.

enter part number :
   cl eop (1, startzeile menu);
   cursor (54, startzeile menu    ); put ("Abbruch mit <ESC>");
   cursor (54, startzeile menu + 1); put ("Shutup ohne Wechsel mit <0>");
   cursor ( 1, startzeile menu);
   put ("Zu welcher Partition wollen Sie wechseln :");
   get cursor (cx, cy);
   REP
      REP cursor (cx, cy);
          partition := get choice (0, 4, retchar);
          IF sure escaped THEN LEAVE shutup dialog FI;
      UNTIL NOT escaped PER;
      IF partition <> 0 CAND NOT partition exists
         THEN fehler;
              put ("Diese Partition gibt es nicht")
      FI;
   UNTIL partition = 0 OR partition exists PER;
   cl eol (54, startzeile menu);
   cl eol (54, startzeile menu + 1);
   cl eop (1, cy + 2).

partition exists:
   typnr (partition) <> 0.

escaped :
   retchar = escape.

sure escaped :
   IF escaped THEN cl eop (1, 20); cursor (1, 22);
                   IF yes ("Shutup-Dialog abbrechen") THEN TRUE
                                                      ELSE cl eop (1, 20);
                                                           FALSE
                   FI
              ELSE FALSE
   FI.

fehler :
   cl eop (1, 20);
   put (""7"" + inverse ("FEHLER :")); line (2).

END PROC shutup dialog;

PROC generate shutup dialog manager:
     TASK VAR son;
     begin ("shutup dialog", PROC shutup dialog manager, son)
END PROC generate shutup dialog manager;

PROC shutup dialog manager:
     disable stop;
     command dialogue (TRUE);
     REP 
        break; line;
        clear error;
        INT VAR sess := session;
        shutup dialog;
        IF sess <> session THEN pause (300) FI;
     PER;
END PROC shutup dialog manager;

END PACKET new shutup


PACKET config manager with time DEFINES configuration manager ,
                                        configuration manager with time :
                                      (* Copyright (C) 1985       *)
INT VAR old session := 0;             (* Martin Schönbeck, Spenge *)
                                      (* Stand: 06.11.85          *)
PROC configuration manager: 
 
   configurate;
   break;
   global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) 
                      configuration manager with time) 
 
END PROC configuration manager; 
 
PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, 
                                      phase, TASK CONST order task): 
 
    IF old session <> session
      THEN
        disable stop;
        set clock (hw clock); 
        set clock (hw clock); (* twice, to avoid all paging delay *) 
        IF is error THEN IF online THEN put error; clear error; pause (100)
                                   ELSE clear error
        FI FI;
        old session := session;
        set autonom;
    FI; 
    configuration manager (ds, order, phase, order task); 

END PROC configuration manager with time; 

END PACKET config manager with time;