From aa147d2f6fd3151c416a70793e00b36b63a19215 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Thu, 7 Feb 2019 09:16:14 +0100 Subject: Move AT utilities into own package --- 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 --- 3 files changed, 1285 deletions(-) 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/std.zusatz') 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 "); - 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