From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/at/unknown/src/AT Generator | 134 +++++++++ system/at/unknown/src/AT Utilities | 601 +++++++++++++++++++++++++++++++++++++ system/at/unknown/src/AT install | 92 ++++++ 3 files changed, 827 insertions(+) create mode 100644 system/at/unknown/src/AT Generator create mode 100644 system/at/unknown/src/AT Utilities create mode 100644 system/at/unknown/src/AT install (limited to 'system/at') diff --git a/system/at/unknown/src/AT Generator b/system/at/unknown/src/AT Generator new file mode 100644 index 0000000..c78bdb9 --- /dev/null +++ b/system/at/unknown/src/AT Generator @@ -0,0 +1,134 @@ +(*************************************************************************) +(*** 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/unknown/src/AT Utilities b/system/at/unknown/src/AT Utilities new file mode 100644 index 0000000..d1c87d5 --- /dev/null +++ b/system/at/unknown/src/AT Utilities @@ -0,0 +1,601 @@ +(*************************************************************************) +(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und ***) +(*** Booten in anderen Partitionen ben”tigt wird. ***) +(*** ***) +(*** Zusammengestellt und ge„ndert : Werner Sauerwein, GMD ***) +(*** Stand : 17.07.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 part DEFINES activate : (* Copyright (C) 1985 *) + (* Martin Sch”nbeck, Spenge *) + (* Stand : 02.02.86 *) + (* Changed by : W.Sauerwein *) + (* Stand : 04.07.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; + +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; + +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; +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, + ms dos, + save system, + generate ms dos manager, + generate shutup 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 ms dos: + + shutup (1) + +END PROC ms dos; + +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 ms dos manager: + + generate shutup manager ("ms dos", 1); + +END PROC generate ms dos 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; +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 errorstop (error message) + 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/unknown/src/AT install b/system/at/unknown/src/AT install new file mode 100644 index 0000000..1fedf70 --- /dev/null +++ b/system/at/unknown/src/AT install @@ -0,0 +1,92 @@ +(*************************************************************************) +(*** 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