diff options
| author | Lars-Dominik Braun <lars@6xq.net> | 2019-02-11 11:49:19 +0100 |
|---|---|---|
| committer | Lars-Dominik Braun <lars@6xq.net> | 2019-02-11 11:49:39 +0100 |
| commit | 98cab31fc3659e33aef260efca55bf9f1753164c (patch) | |
| tree | f1affa84049ef9b268e6c4f521f000478b0f3a8e /system/base/unknown/src/integer | |
| parent | 71e2b36ccd05ea678e62e32ee6245df2b8d6ac17 (diff) | |
| download | eumel-src-98cab31fc3659e33aef260efca55bf9f1753164c.tar.gz eumel-src-98cab31fc3659e33aef260efca55bf9f1753164c.tar.bz2 eumel-src-98cab31fc3659e33aef260efca55bf9f1753164c.zip | |
Add source files from Michael
Diffstat (limited to 'system/base/unknown/src/integer')
| -rw-r--r-- | system/base/unknown/src/integer | 134 |
1 files changed, 134 insertions, 0 deletions
diff --git a/system/base/unknown/src/integer b/system/base/unknown/src/integer new file mode 100644 index 0000000..0e1d19d --- /dev/null +++ b/system/base/unknown/src/integer @@ -0,0 +1,134 @@ +
+PACKET integer DEFINES
+ sign, SIGN, abs, ABS, **, min, max, maxint,
+ get, random, initialize random :
+
+INT PROC maxint : 32767 ENDPROC maxint ;
+
+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 errorstop ("INT OP ** : negative exponent") FI ;
+ IF arg = 0 AND exp = 0
+ THEN errorstop (" 0 ** 0 is not defined")
+ FI ;
+ IF exp = 0 THEN x := 1 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 ;
+
+
+PROC get (INT VAR number) :
+
+ get (word) ;
+ number := int (word)
+
+ENDPROC get ;
+
+TEXT VAR word := "" ;
+
+
+
+(************************************************)
+(*** ***)
+(*** generator 32 650 ***)
+(*** ***)
+(************************************************)
+
+(* INT-Zufallsgenerator mit Periode 32650 *) (*Autor: Bake *)
+ (*Gymnasium Aspe *)
+
+INT VAR z1 :: 14, (* fuer den generator mit periode 25 *)
+ z2 :: 345; (* fuer den generator mit periode 1306 *)
+
+
+ INT PROCEDURE random (INT CONST ugrenze, ogrenze) :
+ (*******************************************************)
+
+generator 25;
+generator 1306;
+(zufallszahl MOD intervallgroesse) + ugrenze.
+
+(* Durch MOD wird bei grosser 'intervallgroesse' der vordere
+ Bereich doppelt ueberdeckt, also keine Gleichverteilung. heinrichs
+ 24.04.81 *)
+
+
+ generator 25 :
+z1 := (11 * z1 + 18) MOD 25
+(* erster generator. liefert alle zahlen zwischen 0 und 24. *).
+
+ generator 1306 :
+z2 := (24 * z2 + 23) MOD 1307
+(* zweiter generator. liefert alle zahlen zwischen 0 und 1305. *).
+
+ zufallszahl :
+z1 + z2 * 25 (* diese zahl liegt zwischen 0 und 32 649 *).
+
+ intervallgroesse : ogrenze - ugrenze + 1
+
+END PROC random ;
+
+
+ PROCEDURE initialize random (INT CONST wert) :
+(**************************************************)
+
+z1 := wert MOD 25;
+z2 := wert MOD 1306
+
+END PROC initialize random ;
+
+ENDPACKET integer ;
|