1 files changed, 49 insertions, 0 deletions
diff --git a/devel/debug/1/src/RUN dez <-> hex b/devel/debug/1/src/RUN dez <-> hex
new file mode 100644
index 0000000..041fcf1
--- /dev/null
+++ b/devel/debug/1/src/RUN dez <-> hex
@@ -0,0 +1,49 @@
+LET hexziffern = "123456789ABCDEF";
+ROW 4 INT CONST faktoren :: ROW 4 INT : (1, 16, 256, 4096);
+
+INT PROC dez (TEXT CONST hex):
+  INT VAR stellen := LENGTH hex;
+  IF stellen > 4
+     OR stellen > 3 AND (hex SUB 1) > "7"
+     THEN errorstop ("Zahl zu groß")
+  FI;
+  INT VAR i :: 0, stelle, ziffpos;
+  TEXT VAR ziffer;
+  FOR stelle FROM 1 UPTO stellen REP
+    ziffer := hex SUB (stellen - stelle + 1);
+    ziffpos := pos (hexziffern, ziffer);
+    IF ziffpos <> 0
+       THEN i INCR ziffpos * faktoren [stelle]
+    ELIF ziffer <> "0"
+       THEN errorstop ("Hexadezimalzahl fehlerhaft")
+    FI
+  PER;
+  i
+END PROC dez;
+{194 + 76 ; kann nicht durch `replace' zu Beginn verkleinert werden }
+TEXT PROC hex (TEXT CONST t dez):
+  IF t dez = "" THEN LEAVE hex WITH "" FI;
+  INT VAR stelle, hex ziffer, dez := int (t dez);
+  TEXT VAR hexzahl := "";
+  FOR stelle FROM 4 DOWNTO 1 REP
+    hexziffer := dez DIV faktoren [stelle];
+    IF hexziffer <> 0
+       THEN hexzahl CAT (hexziffern SUB hexziffer);
+            dez DECR hexziffer * faktoren [stelle]
+       ELSE hexzahl CAT "0"
+    FI
+  PER;
+  hexzahl
+END PROC hex;
+
+putline (""1""4"Dezimalzahlen schlicht, Hexadezimalzahlen mit schließendem ""h"" eingeben");
+line;
+TEXT VAR z;
+REP put ("Zahl:");
+  get (z);
+  IF (z SUB LENGTH z) = "h"
+     THEN put (dez (subtext (z, 1, LENGTH z - 1)))
+     ELSE put (hex (z))
+  FI
+UNTIL z = "" PER
+