summaryrefslogtreecommitdiff
path: root/devel/debug-ds4
diff options
context:
space:
mode:
Diffstat (limited to 'devel/debug-ds4')
-rw-r--r--devel/debug-ds4/1989/source-disk1
-rw-r--r--devel/debug-ds4/1989/src/RUN load ds4246
-rw-r--r--devel/debug-ds4/1989/src/RUN save ds4223
3 files changed, 470 insertions, 0 deletions
diff --git a/devel/debug-ds4/1989/source-disk b/devel/debug-ds4/1989/source-disk
new file mode 100644
index 0000000..a1795f1
--- /dev/null
+++ b/devel/debug-ds4/1989/source-disk
@@ -0,0 +1 @@
+debug/debug-copy-std-ds.img
diff --git a/devel/debug-ds4/1989/src/RUN load ds4 b/devel/debug-ds4/1989/src/RUN load ds4
new file mode 100644
index 0000000..51d9a1f
--- /dev/null
+++ b/devel/debug-ds4/1989/src/RUN load ds4
@@ -0,0 +1,246 @@
+(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *)
+
+(*
+EUMEL0:
+modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1
+3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0
+3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710
+32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32666
+1 16 17 18 32592 17 19 32666 1 22 18 0 32667 2 22 19 0 3090 3091 3092 11284
+21 28750 32587 32583 1 32512 endc pbase: -256 0 0 0 0 1792 -256 1 0 0 3 256
+0 5 0 -32768 9999 7 25 0 0 0 4 1 endp
+*)
+PACKET ds accesses DEFINES
+ do,
+ ds nr,
+ forget all but not,
+ set modul start ic,
+ read ds,
+ write ds,
+:
+INT CONST stdds := 4 + index(myself) * 256;
+INT PROC read ds (INT CONST drid, add hi, add lo):
+ EXTERNAL 154
+END PROC read ds;
+INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo):
+ EXTERNAL 154
+END PROC read ds;
+PROC write ds (INT CONST drid, add hi, add lo, data):
+ EXTERNAL 155
+END PROC write ds;
+PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data):
+ EXTERNAL 155
+END PROC write ds;
+PROC forget (INT CONST ds):
+ EXTERNAL 71
+END PROC forget;
+OP := (INT VAR left, DATASPACE CONST right):
+ EXTERNAL 260
+END OP :=;
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
+ INT VAR modul nr, BOOL CONST ins, lst, rt check, ser):
+ EXTERNAL 256
+END PROC elan;
+PROC do (INT CONST modul nr):
+ INT VAR modul no:= modul nr;
+ DATASPACE VAR source;
+ elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE);
+END PROC do;
+INT PROC ds nr (TEXT CONST name):
+ INT VAR nr := old (name); nr
+END PROC ds nr;
+PROC forget all but not (INT CONST ds):
+ INT VAR i, a;
+ FOR i FROM 5 UPTO 255 REP
+ a := i + 256 * index (myself);
+ IF i <> ds MOD 256 THEN
+ cout (i); forget (a);
+ FI;
+ PER
+END PROC forget all but not;
+PROC set modul start ic (INT CONST modul nr, ic hi, ic lo):
+ IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI;
+ IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN
+ write ds (stdds, 0, modul nr + 512, ic lo);
+ ELSE
+ error stop ("Falsche Modulnummer: " + text (modul nr));
+ FI;
+END PROC set modul start ic;
+END PACKET ds accesses;
+PACKET lader DEFINES
+ lade,
+:
+INT CONST stdds := 4 + index (myself) * 256;
+PROC check task index (TEXT CONST name):
+ IF index (myself) = index copytask (old(name)) THEN
+ putline ("Leider haben sie den gleichen Taskindex wie bei der Quelltask erwischt!");
+ errorstop("Bitte versuchen sie es mit einer neuen Task!");
+ FI;
+END PROC check task index;
+INT PROC index copytask (DATASPACE CONST ds):
+ read ds (ds, 7, 9)
+END PROC index copytask;
+PROC get ic (FILE VAR f, INT VAR ic hi, ic lo):
+ find text (f,"start:");
+ get int (f,ic hi); get int (f,ic lo);
+ IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI;
+END PROC get ic;
+PROC get pbase (FILE VAR f, INT VAR ps):
+ find text (f, "pbase:");
+ get int (f, ps);
+ IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI;
+END PROC get pbase;
+PROC get modul (FILE VAR f, INT VAR modul nr):
+ find text (f, "modul:");
+ get int (f, modul nr);
+END PROC get modul;
+PROC load code (FILE VAR f):
+ INT VAR add hi, add lo, code wert;
+ TEXT VAR code ende;
+ check end code (f);
+ get code add (f, add hi, add lo);
+ REP
+ get code (f, code wert, code ende);
+ IF code ende = "end" THEN LEAVE load code FI;
+ write ds (stdds, add hi, add lo, code wert);
+ add lo INCR 1;
+ PER
+END PROC load code;
+PROC load pbase (FILE VAR f):
+ INT VAR pbase add, pbase wert;
+ TEXT VAR pbase ende;
+ check end pbase (f);
+ get pbase (f, pbase add);
+ REP
+ get pbase (f, pbase wert, pbase ende);
+ IF pbase ende = "end" THEN LEAVE load pbase FI;
+ write ds (stdds, 0, pbase add, pbase wert);
+ pbase add INCR 1;
+ PER
+END PROC load pbase;
+INT PROC read pbase var (FILE VAR f, INT CONST index):
+ INT VAR pbase add;
+ get pbase (f, pbase add);
+ read ds (stdds, 0, pbase add+index)
+END PROC read pbase var;
+PROC write pbase var (FILE VAR f, INT CONST index, var):
+ INT VAR pbase add;
+ get pbase (f, pbase add);
+ write ds (stdds, 0, pbase add+index, var);
+END PROC write pbase var;
+PROC get code add (FILE VAR f, INT VAR add hi, add lo):
+ find text (f, "code:");
+ get int (f, add hi); get int (f, add lo);
+ IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI;
+END PROC get code add;
+PROC get int (FILE VAR f, INT VAR value):
+ IF eof (f) THEN error stop ("Daten fehlen") FI;
+ TEXT VAR daten;
+ get (f, daten);
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+END PROC get int;
+PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ):
+ IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI;
+ TEXT VAR daten ;
+ get (f, daten);
+ IF daten = "endc" THEN
+ ende := "end"
+ ELSE
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+ ende := "no end"
+ FI;
+END PROC get code;
+PROC check end code (FILE VAR f):
+ find text (f, "endc");
+END PROC check end code;
+PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende):
+ IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI;
+ TEXT VAR daten ;
+ get (f, daten);
+ IF daten = "endp" THEN
+ ende := "end"
+ ELSE
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+ ende := "no end"
+ FI;
+END PROC get pbase;
+PROC check end pbase (FILE VAR f):
+ find text (f, "endp");
+END PROC check end pbase;
+PROC find text (FILE VAR f, TEXT CONST suchtext):
+ TEXT VAR t;
+ go start (f);
+ WHILE NOT eof (f) REP
+ get (f, t);
+ IF t = suchtext THEN LEAVE find text FI;
+ PER;
+ error stop (suchtext + " fehlt")
+END PROC find text;
+PROC go start (FILE VAR f):
+ TEXT VAR t;
+ reset (f);
+ WHILE NOT eof (f) REP
+ get (f, t);
+ IF t = "EUMEL0:" THEN LEAVE go start FI
+ PER;
+ error stop ("EUMEL0-Code nicht gefunden");
+END PROC go start;
+PROC run code (INT VAR ic hi, ic lo, modul nr):
+ set modul start ic (modul nr, ic hi, ic lo);
+ do push (modul nr);
+END PROC run code;
+PROC do push (INT CONST modul nr):
+ IF lbase < 30000 THEN
+ do push (modul nr);
+ ELSE
+ do (modul nr); LEAVE do push;
+ FI;
+END PROC do push;
+INT PROC lbase:
+ pcb (25)
+END PROC lbase;
+PROC lade (TEXT CONST datei name):
+ INT VAR ic hi, ic lo, modul nr;
+ line;
+ putline ("Achtung: ALLE bis jetzt insertierten Packete der Task gehen verloren!");
+ IF NOT yes ("Wollen sie den Standarddatenraum ersetzen") THEN LEAVE lade FI;
+ check task index (datei name);
+ FILE VAR f := sequentialfile (input, dateiname);
+ get ic (f, ic hi, ic lo);
+ get modul (f, modul nr);
+ load code (f);
+ load pbase (f);
+ load pbase var (f);
+ run code (ic hi, ic lo, modul nr);
+END PROC lade;
+PROC load pbase var (FILE VAR f):
+ INT VAR dss, dst; TEXT VAR name := "STD DS4";
+ line;
+ put ("Wie hei├čt der Quelldatenraum:");
+ editget (name);
+ line;
+ IF NOT exists (name) THEN errorstop("Datei " + name + " gibt es nicht."); FI;
+ dst := 4 + 256 * index (myself);
+ dss := ds nr (name);
+ write pbase var (f, 1, dss);
+ write pbase var (f, 2, dst);
+ forget all but not (dss);
+END PROC load pbase var;
+PROC lade:
+ lade ("RUN load ds4");
+END PROC lade;
+END PACKET lader;
+lade;
+
diff --git a/devel/debug-ds4/1989/src/RUN save ds4 b/devel/debug-ds4/1989/src/RUN save ds4
new file mode 100644
index 0000000..1fd542b
--- /dev/null
+++ b/devel/debug-ds4/1989/src/RUN save ds4
@@ -0,0 +1,223 @@
+(* COPYRIGHT: digitron GmbH, Bielefeld 1989 *)
+
+(*
+EUMEL0:
+modul: 2047 start: 3 0 code: 3 0 1 -257 32604 32588 32573 3 32666 1
+3 4 0 32667 2 3 4 0 3076 11268 5 28678 32573 6 32666 1 6 7 0 32667 2 6 7 0
+3079 11271 8 28694 32573 9 32666 1 9 10 0 32667 2 9 10 0 3082 11274 11 28710
+32573 12 32666 1 12 13 0 32667 2 12 13 0 3085 11277 14 28726 32573 15 32592
+15 0 32667 2 17 15 0 3087 11279 16 28740 32587 32512 endc pbase: -256 0 0 0
+0 1792 -256 1 0 0 3 256 0 5 0 -32768 0 32 7 endp
+*)
+PACKET ds accesses DEFINES
+ do,
+ ds nr,
+ forget all but not,
+ set modul start ic,
+ read ds,
+ write ds,
+:
+INT CONST stdds := 4 + index(myself) * 256;
+INT PROC read ds (INT CONST drid, add hi, add lo):
+ EXTERNAL 154
+END PROC read ds;
+INT PROC read ds (DATASPACE CONST drid, INT CONST add hi, add lo):
+ EXTERNAL 154
+END PROC read ds;
+PROC write ds (INT CONST drid, add hi, add lo, data):
+ EXTERNAL 155
+END PROC write ds;
+PROC write ds (DATASPACE CONST drid, INT CONST add hi, add lo, data):
+ EXTERNAL 155
+END PROC write ds;
+PROC forget (INT CONST ds):
+ EXTERNAL 71
+END PROC forget;
+OP := (INT VAR left, DATASPACE CONST right):
+ EXTERNAL 260
+END OP :=;
+PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
+ INT VAR modul nr, BOOL CONST ins, lst, rt check, ser):
+ EXTERNAL 256
+END PROC elan;
+PROC do (INT CONST modul nr):
+ INT VAR modul no:= modul nr;
+ DATASPACE VAR source;
+ elan (4, source, "", modul no, FALSE, FALSE, FALSE, FALSE);
+END PROC do;
+INT PROC ds nr (TEXT CONST name):
+ INT VAR nr := old (name); nr
+END PROC ds nr;
+PROC forget all but not (INT CONST ds):
+ INT VAR i, a;
+ FOR i FROM 5 UPTO 255 REP
+ a := i + 256 * index (myself);
+ IF i <> ds MOD 256 THEN
+ cout (i); forget (a);
+ FI;
+ PER
+END PROC forget all but not;
+PROC set modul start ic (INT CONST modul nr, ic hi, ic lo):
+ IF ic hi < 2 OR ic hi > 3 THEN error stop ("Falscher Instruction Counter") FI;
+ IF (modul nr >= 1280 AND ic hi = 3) OR (modul nr <= 1280 AND ic hi = 2) THEN
+ write ds (stdds, 0, modul nr + 512, ic lo);
+ ELSE
+ error stop ("Falsche Modulnummer: " + text (modul nr));
+ FI;
+END PROC set modul start ic;
+END PACKET ds accesses;
+PACKET lader DEFINES
+ lade,
+:
+INT CONST stdds := 4 + index (myself) * 256;
+PROC get ic (FILE VAR f, INT VAR ic hi, ic lo):
+ find text (f,"start:");
+ get int (f,ic hi); get int (f,ic lo);
+ IF ic hi <> 3 THEN error stop ("Falscher Start IC") FI;
+END PROC get ic;
+PROC get pbase (FILE VAR f, INT VAR ps):
+ find text (f, "pbase:");
+ get int (f, ps);
+ IF ps MOD 256 <> 0 THEN error stop ("Falsche Packet Basis") FI;
+END PROC get pbase;
+PROC get modul (FILE VAR f, INT VAR modul nr):
+ find text (f, "modul:");
+ get int (f, modul nr);
+END PROC get modul;
+PROC load code (FILE VAR f):
+ INT VAR add hi, add lo, code wert;
+ TEXT VAR code ende;
+ check end code (f);
+ get code add (f, add hi, add lo);
+ REP
+ get code (f, code wert, code ende);
+ IF code ende = "end" THEN LEAVE load code FI;
+ write ds (stdds, add hi, add lo, code wert);
+ add lo INCR 1;
+ PER
+END PROC load code;
+PROC load pbase (FILE VAR f):
+ INT VAR pbase add, pbase wert;
+ TEXT VAR pbase ende;
+ check end pbase (f);
+ get pbase (f, pbase add);
+ REP
+ get pbase (f, pbase wert, pbase ende);
+ IF pbase ende = "end" THEN LEAVE load pbase FI;
+ write ds (stdds, 0, pbase add, pbase wert);
+ pbase add INCR 1;
+ PER
+END PROC load pbase;
+INT PROC read pbase var (FILE VAR f, INT CONST index):
+ INT VAR pbase add;
+ get pbase (f, pbase add);
+ read ds (stdds, 0, pbase add+index)
+END PROC read pbase var;
+PROC write pbase var (FILE VAR f, INT CONST index, var):
+ INT VAR pbase add;
+ get pbase (f, pbase add);
+ write ds (stdds, 0, pbase add+index, var);
+END PROC write pbase var;
+PROC get code add (FILE VAR f, INT VAR add hi, add lo):
+ find text (f, "code:");
+ get int (f, add hi); get int (f, add lo);
+ IF add hi <> 3 THEN error stop ("Falsche Code-Adresse") FI;
+END PROC get code add;
+PROC get int (FILE VAR f, INT VAR value):
+ IF eof (f) THEN error stop ("Daten fehlen") FI;
+ TEXT VAR daten;
+ get (f, daten);
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+END PROC get int;
+PROC get code (FILE VAR f, INT VAR value, TEXT VAR ende ):
+ IF eof(f) THEN error stop ("'End Code'-Kennung fehlt") FI;
+ TEXT VAR daten ;
+ get (f, daten);
+ IF daten = "endc" THEN
+ ende := "end"
+ ELSE
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+ ende := "no end"
+ FI;
+END PROC get code;
+PROC check end code (FILE VAR f):
+ find text (f, "endc");
+END PROC check end code;
+PROC get pbase (FILE VAR f,INT VAR value, TEXT VAR ende):
+ IF eof (f) THEN error stop ("'End Pbase'-Kennung fehlt") FI;
+ TEXT VAR daten ;
+ get (f, daten);
+ IF daten = "endp" THEN
+ ende := "end"
+ ELSE
+ IF daten = "-32768" THEN
+ value := -maxint-1;
+ ELSE
+ value := int (daten);
+ ENDIF;
+ ende := "no end"
+ FI;
+END PROC get pbase;
+PROC check end pbase (FILE VAR f):
+ find text (f, "endp");
+END PROC check end pbase;
+PROC find text (FILE VAR f, TEXT CONST suchtext):
+ TEXT VAR t;
+ go start (f);
+ WHILE NOT eof (f) REP
+ get (f, t);
+ IF t = suchtext THEN LEAVE find text FI;
+ PER;
+ error stop (suchtext + " fehlt")
+END PROC find text;
+PROC go start (FILE VAR f):
+ TEXT VAR t;
+ reset (f);
+ WHILE NOT eof (f) REP
+ get (f, t);
+ IF t = "EUMEL0:" THEN LEAVE go start FI
+ PER;
+ error stop ("EUMEL0-Code nicht gefunden");
+END PROC go start;
+PROC run code (INT VAR ic hi, ic lo, modul nr):
+ set modul start ic (modul nr, ic hi, ic lo);
+ do (modul nr);
+END PROC run code;
+PROC lade (TEXT CONST datei name):
+ INT VAR ic hi, ic lo, modul nr;
+ line;
+ IF NOT yes ("Wollen sie den Standarddatenraum kopieren") THEN LEAVE lade FI;
+ FILE VAR f := sequentialfile (input, dateiname);
+ get ic (f, ic hi, ic lo);
+ get modul (f, modul nr);
+ load code (f);
+ load pbase (f);
+ load pbase var (f);
+ run code (ic hi, ic lo, modul nr);
+END PROC lade;
+PROC load pbase var (FILE VAR f):
+ INT VAR dss, dst; TEXT VAR name := "STD DS4";
+ line;
+ put ("Wohin soll der Standarddatenraum kopiert werden:");
+ editget (name);
+ line;
+ IF NOT exists (name) THEN create (name); FI;
+ dss := 4 + 256 * index (myself);
+ dst := ds nr (name);
+ write pbase var (f, 1, dss);
+ write pbase var (f, 2, dst);
+END PROC load pbase var;
+PROC lade:
+ lade ("RUN save ds4");
+END PROC lade;
+END PACKET lader;
+lade;
+