diff options
Diffstat (limited to 'devel/debug/1/src/convert')
| -rw-r--r-- | devel/debug/1/src/convert | 154 |
1 files changed, 154 insertions, 0 deletions
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; + |