From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 devel/debug/1/src/convert | 154 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 154 insertions(+)
 create mode 100644 devel/debug/1/src/convert

(limited to 'devel/debug/1/src/convert')

diff --git a/devel/debug/1/src/convert b/devel/debug/1/src/convert
new file mode 100644
index 0000000..426a5e5
--- /dev/null
+++ b/devel/debug/1/src/convert
@@ -0,0 +1,154 @@
+PACKET convert DEFINES dec, hex, dsget2b, exhilo,    (* Stand: 87-01-13  *)
+                       addc, subc, addl, subl, incl, (* Autor: G. Szalay *)
+                       txt, CT, gethex, integ:
+
+LET dectab = "0123456789", hextab="0123456789abcdef", mask16=15;
+INT VAR number, digit, i;
+TEXT VAR buffer, char;
+INT CONST min 1     := dec ("ffff"),
+          min 2     := dec ("fffe"),
+          minint    := dec ("8000"),
+          maxint    := dec ("7fff"),
+       maxint min 1 := dec ("7ffe");
+
+INT PROC integ (TEXT CONST text): (*only digits allowed*)
+  number := 0;
+  FOR i FROM 1 UPTO LENGTH text REP
+    digit := pos (dectab, text SUB i);
+    IF digit > 0
+    THEN number := number * 10 + digit - 1
+    FI
+  UNTIL digit = 0 PER;
+  number
+END PROC integ;
+
+TEXT PROC hex (INT CONST n):
+  buffer := ""; number := n;
+  FOR i FROM 1 UPTO 4 REP
+    rotate (number,4);
+    digit := number AND mask16;
+    buffer CAT (hextab SUB (digit + 1))
+  PER;
+  buffer
+END PROC hex;
+
+INT PROC dec (TEXT CONST t):
+  IF LENGTH t > 4 THEN leave with message FI;
+  number := 0;
+  FOR i FROM 1 UPTO LENGTH t
+  REP char := t SUB i;
+      digit := pos (hextab, char) - 1;
+      IF digit<0 THEN leave with message FI;
+      rotate (number, 4);
+      number INCR digit
+  PER;
+  number.
+
+  leave with message:
+    error stop ("wrong param for dec");
+    LEAVE dec WITH 0.
+
+END PROC dec;
+
+INT PROC exhilo (INT CONST val):
+  INT VAR ex := val; rotate (ex, 8);
+  ex
+END PROC exhilo;
+
+INT PROC dsget2b (INT CONST drid, off hi, off lo):
+  INT VAR val := dsgetw (drid, off hi, off lo);
+  IF drid <> 1 THEN rotate (val, 8) FI;
+  val
+END PROC dsget2b;
+
+PROC addc (INT CONST a, b, INT VAR sum, BOOL VAR carry):
+  INT VAR s;
+  disable stop;
+  s := a + b;
+  IF a >= 0 AND b >= 0 THEN carry := FALSE
+  ELIF a < 0 AND b < 0 THEN carry := TRUE
+  ELSE carry := s >= 0
+  FI;
+  sum := s;
+  clear error
+END PROC addc;
+
+PROC subc (INT CONST a, b, INT VAR diff, BOOL VAR carry):
+  INT VAR d;
+  disable stop;
+  d := a - b;
+  IF a >= 0 AND b < 0 THEN carry := TRUE
+  ELIF a < 0 AND b >= 0 THEN carry := FALSE
+  ELSE carry := d < 0
+  FI;
+  diff := d;
+  clear error
+END PROC subc;
+
+PROC incl (INT VAR ah, al, INT CONST ainc):
+  BOOL VAR ov;
+  IF ainc = 1
+  THEN IF al = min1 THEN al := 0; ah INCR 1
+       ELIF al = maxint THEN al := minint
+       ELSE al INCR 1
+       FI
+  ELIF ainc = 2
+  THEN IF al = min2 THEN al := 0; ah INCR 1
+       ELIF al = maxint min1 THEN al := minint
+       ELSE al INCR 2
+       FI
+  ELSE addc (al, ainc, al, ov);
+       IF ov THEN addc (ah, 1, ah, ov) FI
+  FI
+END PROC incl;
+
+PROC addl (INT CONST ah, al, bh, bl, INT VAR sumh, suml, BOOL VAR carry):
+  BOOL VAR low carry, high carry;
+  addc (al, bl, suml, low carry);
+  addc (ah, bh, sumh, high carry);
+  IF low carry THEN addc (sumh, 1, sumh, low carry) FI;
+  carry := low carry OR high carry
+END PROC addl;
+
+PROC subl (INT CONST ah, al, bh, bl, INT VAR diffh, diffl, BOOL VAR carry):
+  BOOL VAR low carry, high carry;
+  subc (al, bl, diffl, low carry);
+  subc (ah, bh, diffh, high carry);
+  IF low carry THEN subc (diffh, 1, diffh, low carry) FI;
+  carry := low carry OR high carry
+END PROC subl;
+
+TEXT PROC txt (INT CONST num):
+  IF   num = minint  THEN "-32768"
+  ELIF num < 0       THEN "-" CT txt (-num)
+  ELIF num <= 9      THEN code (num + 48)
+  ELSE                    txt (num DIV 10) CT code (num MOD 10 + 48)
+  FI
+END PROC txt;
+
+TEXT OP CT (TEXT CONST left, right):
+  buffer := left; buffer CAT right; buffer
+END OP CT;
+
+PROC gethex (TEXT VAR hexline):
+  buffer := "";
+  REP inchar (char);
+      SELECT pos (""13""12"0123456789abcdef", char) OF
+        CASE 0: out(""7"")
+        CASE 1: hexline := buffer; out (""13""10""); LEAVE gethex
+        CASE 2: delete last char
+        OTHERWISE buffer CAT char; out (char)
+      ENDSELECT
+  PER.
+
+delete last char:
+  IF buffer = ""
+  THEN out (""7"")
+  ELSE buffer := subtext (buffer, 1, LENGTH buffer - 1);
+       out (""8" "8"")
+  FI.
+
+ENDPROC gethex;
+
+END PACKET convert;
+
-- 
cgit v1.2.3