summaryrefslogtreecommitdiff
path: root/devel/debug/1/src/RUN dez <-> hex
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
committerLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
commit04e68443040c7abad84d66477e98f93bed701760 (patch)
tree2b6202afae659e773bf6916157d23e83edfa44e3 /devel/debug/1/src/RUN dez <-> hex
downloadeumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz
eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2
eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip
Initial import
Diffstat (limited to 'devel/debug/1/src/RUN dez <-> hex')
-rw-r--r--devel/debug/1/src/RUN dez <-> hex49
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
+