From aa147d2f6fd3151c416a70793e00b36b63a19215 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Thu, 7 Feb 2019 09:16:14 +0100
Subject: Move AT utilities into own package
---
system/at/1.8.7/source-disk | 1 +
system/at/1.8.7/src/AT Generator | 135 ++++
system/at/1.8.7/src/AT Utilities | 1057 ++++++++++++++++++++++++++++++
system/at/1.8.7/src/AT install | 93 +++
system/std.zusatz/1.8.7/src/AT Generator | 135 ----
system/std.zusatz/1.8.7/src/AT Utilities | 1057 ------------------------------
system/std.zusatz/1.8.7/src/AT install | 93 ---
7 files changed, 1286 insertions(+), 1285 deletions(-)
create mode 100644 system/at/1.8.7/source-disk
create mode 100644 system/at/1.8.7/src/AT Generator
create mode 100644 system/at/1.8.7/src/AT Utilities
create mode 100644 system/at/1.8.7/src/AT install
delete mode 100644 system/std.zusatz/1.8.7/src/AT Generator
delete mode 100644 system/std.zusatz/1.8.7/src/AT Utilities
delete mode 100644 system/std.zusatz/1.8.7/src/AT install
(limited to 'system')
diff --git a/system/at/1.8.7/source-disk b/system/at/1.8.7/source-disk
new file mode 100644
index 0000000..085c0a7
--- /dev/null
+++ b/system/at/1.8.7/source-disk
@@ -0,0 +1 @@
+grundpaket/04_std.zusatz.img
diff --git a/system/at/1.8.7/src/AT Generator b/system/at/1.8.7/src/AT Generator
new file mode 100644
index 0000000..d3bfd6d
--- /dev/null
+++ b/system/at/1.8.7/src/AT Generator
@@ -0,0 +1,135 @@
+(*************************************************************************)
+(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig. ***)
+(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***)
+(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***)
+(*** ***)
+(*** Autor : W. Sauerwein Stand : 15.07.86 ***)
+(*************************************************************************)
+
+LET ack = 0,
+ nak = 1;
+
+cl eop (1, 4);
+erzeuge collector;
+erzeuge archive manager;
+erzeuge operator;
+erzeuge configurator;
+loesche collector;
+forget ("AT Generator", quiet);
+break.
+
+loesche collector :
+ end (/"colly");
+ put ("Collector gelöscht.");
+ line (2).
+
+erzeuge collector :
+ put line ("Generating 'Collector'...");
+ begin ("colly", PROC generate collector, t);
+ warte auf meldung;
+ IF answer = nak THEN end (/"colly");
+ errorstop (meldung)
+ FI.
+ TASK VAR t.
+
+erzeuge archive manager :
+ put line ("Generating 'ARCHIVE'...");
+ end (/"ARCHIVE");
+ begin ("ARCHIVE", PROC archive manager, t).
+
+erzeuge operator :
+ put line ("Generating 'OPERATOR'...");
+ end (/"OPERATOR");
+ begin ("OPERATOR", PROC monitor, t).
+
+erzeuge configurator :
+ put line ("Generating 'configurator'...");
+ end (/"configurator");
+ begin ("configurator", PROC generate configurator, t);
+ warte auf meldung;
+ IF answer = nak THEN errorstop (meldung) FI.
+
+warte auf meldung :
+ DATASPACE VAR ds; INT VAR answer;
+ wait (ds, answer, t);
+ BOUND TEXT VAR m := ds;
+ TEXT VAR meldung := m;
+ forget (ds).
+
+PROC generate collector :
+
+ disable stop;
+ fetch all (/"configurator");
+ DATASPACE VAR ds := nilspace;
+ BOUND TEXT VAR m := ds; m := "";
+ send (father, mess, ds);
+ forget (ds);
+ free global manager.
+
+mess : IF is error THEN m := error message;
+ nak
+ ELSE ack FI.
+
+END PROC generate collector;
+
+PROC generate configurator :
+
+ disable stop;
+ fetch all (/"colly");
+ DATASPACE VAR ds := nilspace;
+ BOUND TEXT VAR m := ds; m := "";
+ send (father, mess, ds);
+ forget (ds);
+ enable stop;
+ new configuration;
+ setup;
+ global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
+ configuration manager with time).
+
+mess : IF is error THEN m := error message;
+ nak
+ ELSE ack FI.
+
+END PROC generate configurator;
+
+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;
+
+PROC cl eol:
+ out (""5"")
+END PROC cl eol;
+
+PROC cl eop:
+ out (""4"")
+END PROC cl eop;
+
+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;
+
diff --git a/system/at/1.8.7/src/AT Utilities b/system/at/1.8.7/src/AT Utilities
new file mode 100644
index 0000000..760e728
--- /dev/null
+++ b/system/at/1.8.7/src/AT Utilities
@@ -0,0 +1,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;
+
diff --git a/system/at/1.8.7/src/AT install b/system/at/1.8.7/src/AT install
new file mode 100644
index 0000000..11f9b55
--- /dev/null
+++ b/system/at/1.8.7/src/AT install
@@ -0,0 +1,93 @@
+(*************************************************************************)
+(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***)
+(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen ***)
+(*** kann. Startet den "AT Generator". ***)
+(*** ***)
+(*** Autor : W. Sauerwein Stand : 15.07.86 ***)
+(*************************************************************************)
+
+erste bildschirmmeldung;
+IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !")
+ ELSE hole dateien vom archiv;
+ insertiere alle pakete;
+ put line ("Running ""AT Generator""...");
+ run ("AT Generator")
+FI;
+forget ("AT install", quiet).
+
+ich bin single : (pcb (9) AND 255) <= 1.
+
+insertiere alle pakete :
+ insert and say ("AT Utilities").
+
+erste bildschirmmeldung :
+ page;
+ put center (" Generator für AT-spezifische Software gestartet."); line;
+ put center ("--------------------------------------------------");
+ line (2).
+
+hole dateien vom archiv :
+ TEXT VAR datei;
+ datei := "AT Utilities"; hole wenn noetig;
+ datei := "AT Generator"; hole wenn noetig;
+ release (archive);
+ line.
+
+hole wenn noetig :
+ IF NOT exists (datei) THEN
+ put line ("Loading """ + datei + """...");
+ fetch (datei, archive)
+ FI.
+
+PROC insert and say (TEXT CONST datei) :
+
+ INT VAR cx, cy;
+ put line ("Inserting """ + datei + """...");
+ get cursor (cx, cy);
+ insert (datei);
+ cl eop (cx, cy); line;
+ forget (datei, quiet).
+
+END PROC insert and say;
+
+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;
+
+PROC cl eol:
+ out (""5"")
+END PROC cl eol;
+
+PROC cl eop:
+ out (""4"")
+END PROC cl eop;
+
+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;
+
diff --git a/system/std.zusatz/1.8.7/src/AT Generator b/system/std.zusatz/1.8.7/src/AT Generator
deleted file mode 100644
index d3bfd6d..0000000
--- a/system/std.zusatz/1.8.7/src/AT Generator
+++ /dev/null
@@ -1,135 +0,0 @@
-(*************************************************************************)
-(*** Generiert Für IBM-AT einen neuen SYSUR-Zweig. ***)
-(*** Danach wird die eingebaute Hardwareuhr für die Systemzeit benutzt ***)
-(*** und andere Partitionen können mit neuem 'shutup' gebootet werden. ***)
-(*** ***)
-(*** Autor : W. Sauerwein Stand : 15.07.86 ***)
-(*************************************************************************)
-
-LET ack = 0,
- nak = 1;
-
-cl eop (1, 4);
-erzeuge collector;
-erzeuge archive manager;
-erzeuge operator;
-erzeuge configurator;
-loesche collector;
-forget ("AT Generator", quiet);
-break.
-
-loesche collector :
- end (/"colly");
- put ("Collector gelöscht.");
- line (2).
-
-erzeuge collector :
- put line ("Generating 'Collector'...");
- begin ("colly", PROC generate collector, t);
- warte auf meldung;
- IF answer = nak THEN end (/"colly");
- errorstop (meldung)
- FI.
- TASK VAR t.
-
-erzeuge archive manager :
- put line ("Generating 'ARCHIVE'...");
- end (/"ARCHIVE");
- begin ("ARCHIVE", PROC archive manager, t).
-
-erzeuge operator :
- put line ("Generating 'OPERATOR'...");
- end (/"OPERATOR");
- begin ("OPERATOR", PROC monitor, t).
-
-erzeuge configurator :
- put line ("Generating 'configurator'...");
- end (/"configurator");
- begin ("configurator", PROC generate configurator, t);
- warte auf meldung;
- IF answer = nak THEN errorstop (meldung) FI.
-
-warte auf meldung :
- DATASPACE VAR ds; INT VAR answer;
- wait (ds, answer, t);
- BOUND TEXT VAR m := ds;
- TEXT VAR meldung := m;
- forget (ds).
-
-PROC generate collector :
-
- disable stop;
- fetch all (/"configurator");
- DATASPACE VAR ds := nilspace;
- BOUND TEXT VAR m := ds; m := "";
- send (father, mess, ds);
- forget (ds);
- free global manager.
-
-mess : IF is error THEN m := error message;
- nak
- ELSE ack FI.
-
-END PROC generate collector;
-
-PROC generate configurator :
-
- disable stop;
- fetch all (/"colly");
- DATASPACE VAR ds := nilspace;
- BOUND TEXT VAR m := ds; m := "";
- send (father, mess, ds);
- forget (ds);
- enable stop;
- new configuration;
- setup;
- global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST)
- configuration manager with time).
-
-mess : IF is error THEN m := error message;
- nak
- ELSE ack FI.
-
-END PROC generate configurator;
-
-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;
-
-PROC cl eol:
- out (""5"")
-END PROC cl eol;
-
-PROC cl eop:
- out (""4"")
-END PROC cl eop;
-
-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;
-
diff --git a/system/std.zusatz/1.8.7/src/AT Utilities b/system/std.zusatz/1.8.7/src/AT Utilities
deleted file mode 100644
index 760e728..0000000
--- a/system/std.zusatz/1.8.7/src/AT Utilities
+++ /dev/null
@@ -1,1057 +0,0 @@
-(*************************************************************************)
-(*** 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;
-
diff --git a/system/std.zusatz/1.8.7/src/AT install b/system/std.zusatz/1.8.7/src/AT install
deleted file mode 100644
index 11f9b55..0000000
--- a/system/std.zusatz/1.8.7/src/AT install
+++ /dev/null
@@ -1,93 +0,0 @@
-(*************************************************************************)
-(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***)
-(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen ***)
-(*** kann. Startet den "AT Generator". ***)
-(*** ***)
-(*** Autor : W. Sauerwein Stand : 15.07.86 ***)
-(*************************************************************************)
-
-erste bildschirmmeldung;
-IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !")
- ELSE hole dateien vom archiv;
- insertiere alle pakete;
- put line ("Running ""AT Generator""...");
- run ("AT Generator")
-FI;
-forget ("AT install", quiet).
-
-ich bin single : (pcb (9) AND 255) <= 1.
-
-insertiere alle pakete :
- insert and say ("AT Utilities").
-
-erste bildschirmmeldung :
- page;
- put center (" Generator für AT-spezifische Software gestartet."); line;
- put center ("--------------------------------------------------");
- line (2).
-
-hole dateien vom archiv :
- TEXT VAR datei;
- datei := "AT Utilities"; hole wenn noetig;
- datei := "AT Generator"; hole wenn noetig;
- release (archive);
- line.
-
-hole wenn noetig :
- IF NOT exists (datei) THEN
- put line ("Loading """ + datei + """...");
- fetch (datei, archive)
- FI.
-
-PROC insert and say (TEXT CONST datei) :
-
- INT VAR cx, cy;
- put line ("Inserting """ + datei + """...");
- get cursor (cx, cy);
- insert (datei);
- cl eop (cx, cy); line;
- forget (datei, quiet).
-
-END PROC insert and say;
-
-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;
-
-PROC cl eol:
- out (""5"")
-END PROC cl eol;
-
-PROC cl eop:
- out (""4"")
-END PROC cl eop;
-
-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;
-
--
cgit v1.2.3