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 --- system/base/1.7.5/src/integer | 265 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 265 insertions(+) create mode 100644 system/base/1.7.5/src/integer (limited to 'system/base/1.7.5/src/integer') diff --git a/system/base/1.7.5/src/integer b/system/base/1.7.5/src/integer new file mode 100644 index 0000000..aefb77f --- /dev/null +++ b/system/base/1.7.5/src/integer @@ -0,0 +1,265 @@ +(* ------------------- STAND : 23.10.85 --------------------*) +PACKET integer DEFINES text, int, MOD, + sign, SIGN, abs, ABS, **, min, max, minint, maxint, + random, initialize random , + last conversion ok, set conversion : + +INT PROC minint : -32767 - 1 ENDPROC minint ; + +INT PROC maxint : 32767 ENDPROC maxint ; + + +TEXT PROC text (INT CONST number) : + + IF number = minint THEN "-32768" + ELIF number < 0 THEN "-" + text(-number) + ELIF number <= 9 THEN code (number + 48) + ELSE text (number DIV 10) + digit + FI . + +digit : + code ( number MOD 10 + 48 ) . + +ENDPROC text ; + +TEXT PROC text (INT CONST number, length) : + + TEXT VAR result := text (number) ; + INT CONST number length := LENGTH result ; + IF number length < length + THEN (length - number length) * " " + result + ELIF number length > length + THEN length * "*" + ELSE result + FI + +ENDPROC text ; + +INT PROC int (TEXT CONST number) : + + skip blanks and sign ; + get value ; + result . + +skip blanks and sign : + BOOL VAR number is positive ; + INT VAR pos := 1 ; + skip blanks ; + IF (number SUB pos) = "-" + THEN number is positive := FALSE ; + pos INCR 1 + ELIF (number SUB pos) = "+" + THEN number is positive := TRUE ; + pos INCR 1 + ELSE number is positive := TRUE + FI . + +get value : + INT VAR value ; + get first digit ; + WHILE is digit REP + value := value * 10 + digit ; + pos INCR 1 + PER ; + set conversion ok result . + +get first digit : + IF is digit + THEN value := digit ; + pos INCR 1 + ELSE set conversion (FALSE) ; + LEAVE int WITH 0 + FI . + +is digit : 0 <= digit AND digit <= 9 . + +digit : code (number SUB pos) - 48 . + +result : + IF number is positive + THEN value + ELSE - value + FI . + +set conversion ok result : + skip blanks ; + conversion ok := (pos > LENGTH number) . + +skip blanks : + WHILE (number SUB pos) = " " REP + pos INCR 1 + PER . + +ENDPROC int ; + +INT OP MOD (INT CONST left, right) : + + EXTERNAL 43 + +ENDOP MOD ; + +INT PROC sign (INT CONST argument) : + + IF argument < 0 THEN -1 + ELIF argument > 0 THEN 1 + ELSE 0 + FI + +ENDPROC sign ; + +INT OP SIGN (INT CONST argument) : + sign (argument) +ENDOP SIGN ; + +INT PROC abs (INT CONST argument) : + + IF argument > 0 THEN argument + ELSE - argument + FI + +ENDPROC abs ; + +INT OP ABS (INT CONST argument) : + abs (argument) +ENDOP ABS ; + +INT OP ** (INT CONST arg, exp) : + + INT VAR x := arg , z := 1 , + counter := exp ; + + IF exp = 0 + THEN LEAVE ** WITH 1 + ELIF exp < 0 + THEN LEAVE ** WITH 1 DIV arg + FI ; + + WHILE counter >= 2 REP + calculate new x and z ; + counter := counter DIV 2 ; + ENDREP ; + z * x . + +calculate new x and z : + IF counter is not even + THEN z := z * x + FI ; + x := x * x . + +counter is not even : + counter MOD 2 = 1 . + +ENDOP ** ; + +INT PROC min (INT CONST first, second) : + + IF first < second THEN first ELSE second FI + +ENDPROC min ; + +INT PROC max (INT CONST first, second) : + + IF first > second THEN first ELSE second FI + +ENDPROC max ; + + + +BOOL VAR conversion ok := TRUE ; + +BOOL PROC last conversion ok : + conversion ok +ENDPROC last conversion ok ; + +PROC set conversion (BOOL CONST success) : + conversion ok := success +ENDPROC set conversion ; + + + +(*******************************************************************) +(* *) +(* Autor: A. Flammenkamp *) +(* RANDOM GENERATOR *) +(* *) +(* x := 4095 * x MOD (4095*4096+4093) *) +(* n+1 n *) +(* *) +(* Periode: 2**24-4 > 16.0e6 *) +(* *) +(* Beachte: x = 4096 * x1 + x0, 0 <= x0,x1 < 4096 *) +(* *) +(*******************************************************************) + + +INT VAR high := 1, low := 0 ; + +PROC initialize random (INT CONST start) : + + low := start MOD 4096 ; + IF start < 0 + THEN high := 256 + 16 + start DIV 4096 ; + IF low <> 0 THEN high DECR 1 FI + ELSE high := 256 + start DIV 4096 + FI + +ENDPROC initialize random ; + +INT PROC random (INT CONST lower bound, upper bound) : + + compute new random value ; + normalize high ; + normalize low ; + map into interval . + +compute new random value : + (* (high,low) := (low-high , 3*high-low) *) + high := low - high ; + low INCR low - 3 * high . + +normalize high : + IF high < 0 + THEN high INCR 4096 ; low DECR 3 + FI . + +normalize low : + (* high INCR low DIV 4096 ; + low := low MOD 4096 + *) + IF low >= 4096 THEN low overflow + ELIF low < 0 THEN low underflow + FI . + +low overflow : + IF low >= 8192 + THEN low DECR 8192 ; high INCR 2 + ELSE low DECR 4096 ; high INCR 1 ; post normalization + FI . + +post normalization : + (* IF (high,low) >= (4095,4093) + THEN (high,low) DECR (4095,4093) + FI + *) + IF high >= 4095 + THEN IF low >= 4093 THEN high DECR 4095 ; low DECR 4093 + ELIF high = 4096 THEN high := 0 ; low INCR 3 + FI + FI . + +low underflow : + low INCR 4096 ; high DECR 1 . + +map into interval : + INT VAR number := high MOD 16 - 8 ; + number INCR 4095 * number + low ; + IF lower bound <= upper bound + THEN lower bound + number MOD (upper bound - lower bound + 1) + ELSE upper bound + number MOD (lower bound - upper bound + 1) + FI . + +ENDPROC random ; + + +ENDPACKET integer ; + -- cgit v1.2.3