diff options
author | Lars-Dominik Braun <lars@6xq.net> | 2019-02-04 13:09:03 +0100 |
---|---|---|
committer | Lars-Dominik Braun <lars@6xq.net> | 2019-02-04 13:09:03 +0100 |
commit | 04e68443040c7abad84d66477e98f93bed701760 (patch) | |
tree | 2b6202afae659e773bf6916157d23e83edfa44e3 /devel/debug/1/src/RUN dez <-> hex | |
download | eumel-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 <-> hex | 49 |
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 + |