system/at/1.8.7/src/AT Utilities

Raw file
Back to index

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