Re: Fixes for GNU Sather 1.2.2
Sather User <[email protected]> Sat, 20 Jun 2009 20:43:32 +0930 (CST)
| Newsgroups | gmane.comp.lang.sather.announce |
|---|---|
| Message-ID | <[email protected]> |
If you are compiling GNU Sather on 64-bit hardware, please ignore my last message and apply the following diffs directly to GNU sather-1.2.2. This is a better approach. It creates m4 prototypes of int.sa and int_test.sa below the directory M4. From these, a version of Sather correct for the word size is created. On 32 bits it is identical to GNU Sather-1.2.2. On 64 bits, Library/Base/int.sa and Library/Base/int_test.sa are changed. There are also bug fixes in Library/Base/int.config and System/Common/runtime.h. There were (unsigned) and (signed) casts, but the integers concerned were longs. It was apparently overlooked that such casts would coerce longs to ints. The bugs escaped notice on 32-bit hardware where a long is the same size as an int. Here the casts have been made (unsigned long) and (signed long). To patch sather-1.2.2 with these diffs, save this message, or the portion below the row of =====, as an ordinary text file. (I've called it maildiff.) Place it in a directory by itself (optional), and copy sather-1.2.2.tar.bz2 into the same directory. Unpack it, rename the resulting tree gnu_sather32+64-1.2.2, and apply the patches. As follows. $ ls maildiff sather-1.2.2.tar.bz2 $ tar xjf s* $ ls maildiff sather-1.2.2 sather-1.2.2.tar.bz2 $ mv sather-1.2.2 gnu_sather32+64-1.2.2 $ ls gnu_sather32+64-1.2.2 maildiff sather-1.2.2.tar.bz2 $ patch -up0 <maildiff patching file gnu_sather32+64-1.2.2/Library/Base/int.config patching file gnu_sather32+64-1.2.2/M4/Library/Base/int.sa patching file gnu_sather32+64-1.2.2/M4/Library/Base/int_test.sa patching file gnu_sather32+64-1.2.2/Makefile patching file gnu_sather32+64-1.2.2/System/Common/runtime.h $ $ cd gnu_sather32+64-1.2.2 $ make clean (output) $ cd .. $ tar cjf gnu_sather32+64-1.2.2.tar.bz2 gnu_sather32+64-1.2.2 $ Regards, Mike ============================================================================ diff -NaurBbw sather-1.2.2/Library/Base/int.config gnu_sather32+64-1.2.2/Library/Base/int.config --- sather-1.2.2/Library/Base/int.config 1999-07-26 00:06:27.000000000 +0930 +++ gnu_sather32+64-1.2.2/Library/Base/int.config 2009-06-19 21:32:05.000000000 +0930 @@ -49,7 +49,7 @@ INT_FLTX: PP,VSTD,exec "$$=(FLT)$0;" "$$"; INT_FLTDX: PP,VSTD,exec "$$=(FLT)$0;" "$$"; INT_CHAR: PP,VSTD,exec "$$=(CHAR)$0;" "$$"; -INT_C_UNSIGNED_INT: PP,VSTD,exec "$$=(unsigned int)$0;" "$$"; +INT_C_UNSIGNED_INT: PP,VSTD,exec "$$=(long unsigned int)$0;" "$$"; INT_INT: PP,exec "$0"; INT_ABS: PP,VSTD,exec "$$=($0<0)?-$0:$0;" "$$"; INT_SQUARE: APP,VSTD,exec "$$=INTTIMES($0,$0);" "$$"; @@ -63,19 +63,19 @@ INT_UTIMES: APP,VSTD,exec "$$=INTUTIMES($0,$1);" "$$"; INT_UDIV: FPP,VSTD,exec "$$=INTUDIV($0,$1);" "$$"; INT_UMOD: FPP,VSTD,exec "$$=INTUMOD($0,$1);" "$$"; -INT_MPLUS: PP,VSTD,exec "$$=((unsigned)$0+(unsigned)$1);" "$$"; -INT_MMINUS: PP,VSTD,exec "$$=((unsigned)$0-(unsigned)$1);" "$$"; -INT_MNEGATE: PP,VSTD,exec "$$=(-(unsigned)$0);" "$$"; -INT_MTIMES: PP,VSTD,exec "$$=((unsigned)$0*(unsigned)$1);" "$$"; -INT_MDIV: FPP,VSTD,exec "$$=((unsigned)$0/(unsigned)$1);" "$$"; -INT_MMOD: FPP,VSTD,exec "$$=((unsigned)$0%%(unsigned)$1);" "$$"; +INT_MPLUS: PP,VSTD,exec "$$=((long unsigned int)$0+(long unsigned int)$1);" "$$"; +INT_MMINUS: PP,VSTD,exec "$$=((long unsigned int)$0-(long unsigned int)$1);" "$$"; +INT_MNEGATE: PP,VSTD,exec "$$=(-(long unsigned int)$0);" "$$"; +INT_MTIMES: PP,VSTD,exec "$$=((long unsigned int)$0*(long unsigned int)$1);" "$$"; +INT_MDIV: FPP,VSTD,exec "$$=((long unsigned int)$0/(long unsigned int)$1);" "$$"; +INT_MMOD: FPP,VSTD,exec "$$=((long unsigned int)$0%%(long unsigned int)$1);" "$$"; INT_BNOT: PP,VSTD,exec "$$=~$0;" "$$"; INT_BAND: PP,VSTD,exec "$$=$0&$1;" "$$"; INT_BOR: PP,VSTD,exec "$$=$0|$1;" "$$"; INT_BXOR: PP,VSTD,exec "$$=$0\\^$1;" "$$"; -INT_LSHIFT: PP,VSTD,exec "$$=((unsigned)$0)<<((unsigned)$1);" "$$"; +INT_LSHIFT: PP,VSTD,exec "$$=((long unsigned int)$0)<<((long unsigned int)$1);" "$$"; INT_RSHIFT: PP,VSTD,exec "$$=INTRSHIFT($0,$1);" "$$"; -INT_URSHIFT: PP,VSTD,exec "$$=((unsigned)$0)>>((unsigned)$1);" "$$"; +INT_URSHIFT: PP,VSTD,exec "$$=((long unsigned int)$0)>>((long unsigned int)$1);" "$$"; INT_CREATE_STR: FPP,VSTD,exec "$$=atoi(((STR)$1)->arr_part);" "$$"; INT_AGET: PP,VSTD,exec "$$=((CHAR)(($0&(1<<$1))!=0));" "$$"; INT_ASET: PP,VSTD,exec "$$=((($0)&(~(1<<($1))))|(($2)<<($1)));" "$$"; diff -NaurBbw sather-1.2.2/M4/Library/Base/int.sa gnu_sather32+64-1.2.2/M4/Library/Base/int.sa --- sather-1.2.2/M4/Library/Base/int.sa 1970-01-01 09:30:00.000000000 +0930 +++ gnu_sather32+64-1.2.2/M4/Library/Base/int.sa 2009-06-20 19:12:23.000000000 +0930 @@ -0,0 +1,906 @@ +changecom(`--')dnl +-------------------------> GNU Sather - sourcefile <------------------------- +-- Copyright (C) 1994 by International Computer Science Institute -- +-- This file is part of the GNU Sather library. It is free software; you may -- +-- redistribute and/or modify it under the terms of the GNU Library General -- +-- Public License (LGPL) as published by the Free Software Foundation; -- +-- either version 2 of the license, or (at your option) any later version. -- +-- This library is distributed in the hope that it will be useful, but -- +-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. -- +-- The license text is also available from: Free Software Foundation, Inc., -- +-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- +--------------> Please email comments to <[email protected]> <-------------- + +-- int.sa: Built-in integers. +------------------------------------------------------------------- +immutable class INT < $NUMBER{INT}, $HASH, $FMT is + -- The most fundamental integer class. Signed, unsigned, and modular + -- versions of arithmetic operations are provided. The names of + -- unsigned operations begin with the letter "u". The names of + -- modular operations begin with the letter "m". Negative numbers + -- are represented using 2's complement. INT objects inherit from + -- AVAL{BOOL}. The number of bits in the representation is `asize' + -- and is implementation dependent. It must be at least 32, however + -- (to ensure portability of INT literals up to this size). Many of + -- the operations are specified to raise exceptions on overflow. They + -- are guaranteed to do this if checking is enabled, but this may + -- affect performance. Certain machines (with appropriate hardware) + -- may perform these checks even when checking is not enabled. The + -- modular operations are performed modulo 2^asize. + -- + -- References: + -- Keith O. Geddes, Stephen R. Czapor, and George Labahn, "Algorithms + -- for Computer Algebra", Kluwer Academic Publishers, Boston, 1992. + + -- AVAL does not work yet. For the moment leave out. + -- include AVAL{BOOL} asize->; + + + -- MTW Jun 2009: Change '32' to actual word size + const asize:INT:=__WORDSIZE; + -- Size in bits. + + -- Signed operations: + + plus(i:SAME):SAME is builtin INT_PLUS; end; + -- The signed sum of self and `i'. Raises an exception on + -- overflow, when enabled. Built-in. + + minus(i:SAME):SAME is builtin INT_MINUS; end; + -- The signed difference between self and `i'. Raises an exception + -- on overflow, when enabled. Built-in. + + negate:SAME is builtin INT_NEGATE; end; + -- The signed negation of self. Same as zero minus self. + -- Only raises an exception on the most negative value (which + -- doesn't have a corresponding positive value in 2's complement.) + -- Built-in. + + times(i:SAME):SAME is builtin INT_TIMES; end; + -- The signed product of self and `i'. Raises an exception if the + -- product can't be held in the result, when enabled. Built-in. + + div(i:SAME):SAME is builtin INT_DIV; end; + -- The signed quotient of self and `i'. This and `mod' have the + -- property that for non-zero `y', `x=x.div(y)*x + x.mod(y)'. Raises + -- an exception when `i' is 0, when enabled. Built-in. + + mod(i:SAME):SAME is builtin INT_MOD; end; + -- Signed remainder of self divided by `i'. This and `mod' have the + -- property that for non-zero `y', `x=x.div(y)*x + x.mod(y)'. It's + -- also true that `0 <= x.mod(y) < y.abs'. Raises an exception when + -- `i' is 0, when enabled. Built-in. + + is_eq(i:SAME):BOOL is builtin INT_IS_EQ; end; + -- True if self and `i' represent the same value. + -- return self=i + + is_eq(arg: $OB): BOOL is + -- Overloaded version of the is_eq routine that works with an argument + -- of any type. If the type of the 'arg' is not the same as they + -- type of 'self' then return false. Otherwise, deletegate to + -- the 'real' is_eq(SAME):BOOL routine + typecase arg when SAME then return is_eq(arg) else return false end; + end; + + is_lt(i:SAME):BOOL is builtin INT_IS_LT; end; + -- True if self is less than `i' as signed integers. Built-in. + + max(i:SAME):SAME is builtin INT_MAX; end; + -- The larger of self and `i' as signed integers. Built-in. + + min(i:SAME):SAME is builtin INT_MIN; end; + -- The smaller of self and `i' as signed integers. Built-in. + + at_least(x:SAME):SAME is + -- Same as `max(x)'. + return max(x) + end; + + at_most(x:SAME):SAME is + -- Same as `min(x)'. + return min(x) + end; + + within(x,y:SAME):SAME is + -- Same as `max(x).min(y)'. + return max(x).min(y) + end; + + -- Conversion from other types: + + create(x:INT):SAME is return x end; + create(x:INTI):SAME is return x.int end; + create(f:FLT):SAME is return f.int end; + create(f:FLTD):SAME is return f.int end; + + create(s:STR): SAME is builtin INT_CREATE_STR; end; + + int:INT is builtin INT_INT; end; + -- An integer version of self. + + from_int(i:INT):SAME is + -- Returns `i'. + return i + end; + + inti:INTI is + -- An infinite precision version of self. + return #INTI(self) + end; + + flt:FLT is builtin INT_FLT; end; + -- A floating point version of self. It is an error if the + -- value cannot be held in a FLT. Built-in. + + fltd:FLTD is builtin INT_FLTD; end; + -- A double floating point version of self. It is an error + -- if the value cannot be held in a FLTD. Built-in. + + + bool:BOOL is builtin INT_BOOL; end; + -- A boolean from self. Built-in. + + char:CHAR is builtin INT_CHAR; end; + -- A character corresponding to the value of self. Built-in. + + c_unsigned_int:C_UNSIGNED_INT is builtin INT_C_UNSIGNED_INT; end; + -- Convert to external C unsigned integer. Built-in. + + -- Other computation: + + abs:SAME is builtin INT_ABS; end; + -- The absolute value of self. Built-in. + + square:SAME is builtin INT_SQUARE; end; + -- The square of self. Built-in. + + cube:SAME is + -- The cube of self. + return self*self*self + end; + + pow(i:INT):SAME + -- Self raised to the power `i'. + pre i>=0 is + r:SAME; + case i + when 0 then return 1 + when 1 then return self + when 2 then return self*self + when 3 then return self*self*self + when 4 then r:=self*self; return r*r + when 5 then r:=self*self; return self*r*r + when 6 then r:=self*self; return r*r*r + when 7 then r:=self*self; return self*r*r*r + when 8 then r:=self*self; r:=r*r; return r*r + when 9 then r:=self*self; r:=r*r; return self*r*r + when 10 then r:=self*self; r:=self*r*r; return r*r + else + x ::= self; r := 1; + loop + -- r * x^i = self ^ i0 + if i.is_odd then r := r*x end; + i := i.rshift(1); + while!(i>0); + x := x.square; + end; + return r; + end; + end; + + sqrt:SAME + -- The largest integer whose square is smaller than or equal to self. + pre self>=0 + is + x::=fltd; + r:SAME; + if self=x.floor.int then return x.sqrt.floor.int + else q::=1; r:=self; + loop while!(q<=r); q:=4*q end; + loop while!(q/=1); q:=q/4; h::=r+q; r:=r/2; + if h<=r then r:=r-h; r:=r+q end end end; + return r + end; + + exp2:SAME pre self>=0 is return 0.set_bit(self) end; + + ten_pow:SAME pre self>=0 is return exp10 end; + + exp10:SAME + -- Ten to the self power. Small values use lookup table for speed. + pre self>=0 + is + case self + when 0 then return 1 + when 1 then return 10 + when 2 then return 100 + when 3 then return 1000 + when 4 then return 10000 + when 5 then return 100000 + when 6 then return 1000000 + when 7 then return 10000000 + when 8 then return 100000000 + when 9 then return 1000000000 + else return 10.pow(self) end + end; + + num_digits:INT + -- The number of decimal digits in non-negative self. + -- Use binary search so that small values take only 3 compares. + pre self>=0 is + if self<10000 then + if self<100 then + if self<10 then return 1 else return 2 end + else if self<1000 then return 3 else return 4 end end; + else + if self<1000000 then + if self<100000 then return 5 else return 6 end + else + return (self/10000).num_digits+4; + --r::=7; tst::=10000000; + --loop + -- if self<tst then return r end; + -- r:=r+1; tst:=tst*10 end; + --raise "INT::num_digits error." + end + end + end; + + hash:INT is + r::=self; + + -- We should try to get numbers away from each other, even if + -- they don't collide. For example, if SYS::id returns + -- objects in consecutive aligned positions, we don't want to + -- end up returning successive integers. Unfortunately, it's + -- not good enough to just multiply/add by some magic numbers, + -- because that doesn't affect the randomness once passed + -- through a mod function (for instance FSET etc. just use the + -- rightmost bits, equivalent to mod by a power of two.) Here + -- a few steps of a shift generator are done. + r:=r.bxor(r.lshift(17)); + r:=r.bxor(r.urshift(15)); + r:=r.bxor(r.lshift(17)); + r:=r.bxor(r.urshift(15)); + r:=r.bxor(r.lshift(17)); + r:=r.bxor(r.urshift(15)); + return r; + end; + + -- Conversion into printable forms: + + str_in (s: FSTR, n, b: INT, f: CHAR): FSTR pre b.is_bet(2, 16) is + -- Append a string representation of self to s using at least n digits + -- to the base b and return s. If less then n digits are used for the + -- representation of self (including its sign), the remaining left_most + -- positions are filled with character f. + -- + if is_nil then + -- The nil value (most negative number) cannot be negated - + -- due to the inherent assymetry of the representation. + -- There is no corresponding positive number + x ::= self; + divid: INT := x/b; + rem1: INT := (x - divid*(b-1)); + rem: INT := rem1-divid; + if rem > 0 then rem := rem-b; divid := divid + 1; end; + -- If divid was rounded up instead of down,manually divid to divid-1 + first_char: CHAR := rem.abs.digit_char; + x := divid.abs; + i ::= s.length; + s := s+first_char; + n := n - 1; + loop s := s + (x%b).digit_char; x := x/b; n := n-1; until!(x = 0) end; + s := s + '-'; n := n-1; + loop while!(n > 0); s := s + f; n := n-1 end; + j ::= s.length-1; + loop while!(i < j); + ch ::= s[i]; s[i] := s[j]; s[j] := ch; i := i+1; j := j-1 + end; + return s; + -- return #INTI(nil).str_in(s, n, b, f) + --#FSTR("nil"); + else + x ::= self.abs; i ::= s.length; + loop s := s + (x%b).digit_char; x := x/b; n := n-1; until!(x = 0) end; + if self < 0 then s := s + '-'; n := n-1 end; + loop while!(n > 0); s := s + f; n := n-1 end; + j ::= s.length-1; + loop while!(i < j); + ch ::= s[i]; s[i] := s[j]; s[j] := ch; i := i+1; j := j-1 + end; + return s + end + end; + + + str_in(s:FSTR):FSTR is + -- Append a decimal string version of self to `s' and return it. + return str_in(s, 0, 10, ' ') + end; + + -- the shared buffer is actually faster, but not thread safe. + -- private shared buf:FSTR; -- Buffer for string output. + + str:STR is + buf:FSTR; + -- A decimal string version of self. + buf.clear; buf:=str_in(buf); return buf.str + end; + + fmt( f: STR ): STR + is + return BASE_FORMAT::fmt_int(self,f) + end; + + digit_char:CHAR + -- A character representing self. If self is between 0 and 9, it + -- returns a digit. If between 10 and 15, returns 'A' thru 'F'. + pre self.is_bet(0,15) is + return "0123456789ABCDEF"[self] + end; + + -- Integer properties: + + is_even:BOOL is builtin INT_IS_EVEN; end; + + is_odd:BOOL is builtin INT_IS_ODD; end; + + is_pos:BOOL is + -- True if self is greater than zero. + return self>0 + end; + + is_neg:BOOL is + -- True if self is less than zero. + return self<0 + end; + + is_zero:BOOL is + -- True if self is zero. + return self=0 + end; + + is_non_zero:BOOL is + -- True if self is non-zero. + return self/=0 + end; + + is_non_neg:BOOL is + -- True if self is non-negative. + return self>=0 + end; + + is_non_pos:BOOL is + -- True if self is non-positive. + return self<=0 + end; + + sign:SAME is + -- -1,0,1 depending on the sign of self. + -- Steele, 304 + if self<0 then return -1 + elsif self>0 then return 1 + else return 0 end + end; + + is_bet(l,u:SAME):BOOL is builtin INT_IS_BETWEEN; end; + -- True if self between l and u. Built-in. + + is_between(l,u:SAME):BOOL is builtin INT_IS_BETWEEN; end; + -- True if self between l and u. Built-in. + + is_within(tolerance,val:SAME):BOOL is + return (self-val).abs<=tolerance; + end; + + is_eq(i1,i2:SAME):BOOL is + -- True if self equals `i1' and `i2'. + return self=i1 and self=i2 end; + + is_eq(i1,i2,i3:SAME):BOOL is + -- True if self equals `i1', `i2', and `i3'. + return self=i1 and self=i2 and self=i3 end; + + nil:SAME is + -- The value to be used to represent no element in sets. + -- The most negative value. + return 1.lshift(asize-1) + end; + + is_nil:BOOL is return self=1.lshift(asize-1); end; + + -- Unsigned operations: + + uplus(i:SAME):SAME is builtin INT_UPLUS; end; + -- The unsigned sum of self and `i'. Raises an exception on + -- overflow, when enabled. Built-in. + + uminus(i:SAME):SAME is builtin INT_UMINUS; end; + -- The unsigned difference between self and `i'. Raises an + -- exception on overflow or if the result would be negative, + -- when enabled. Built-in. + + utimes(i:SAME):SAME is builtin INT_UTIMES; end; + -- The unsigned product of self and `i'. Raises an exception if the + -- product can't be held in the result, when enabled. Built-in. + + udiv(i:SAME):SAME is builtin INT_UDIV; end; + -- The unsigned quotient of self and `i'. Raises an exception when + -- `i' is 0, when enabled. Built-in. + + umod(i:SAME):SAME is builtin INT_UMOD; end; + -- Unsigned remainder of self divided by `i'. Raises an exception + -- when `i' is 0, when enabled. Built-in. + + is_ult(lhs:SAME):BOOL is + if self>=0 and lhs<0 then return true end; + if self<0 and lhs>=0 then return false end; + -- both (self and lhs) have the same sign + return self<lhs; + end; + + is_uleq(i:SAME):BOOL is + -- True if self is less than or equal to `i' as unsigned integers. + return is_ult(i) or self=i + end; + + is_ugt(i:SAME):BOOL is + -- True if self is greater than `i' as unsigned integers. + return i.is_ult(self) + end; + + is_ugeq(i:SAME):BOOL is + -- True if self is greater than or equal to `i' as unsigned + -- integers. + return i.is_ult(self) or self=i + end; + + umax(i:SAME):SAME is + -- The larger of self and `i' as unsigned integers. + if self.is_ugt(i) then return self else return i end + end; + + umin(i:SAME):SAME is + -- The smaller of self and `i' as unsigned integers. + if self.is_ult(i) then return self else return i end + end; + + evenly_divides(i:SAME):BOOL is + -- True if self evenly divides `i'. + return i%self=0 + end; + + next_multiple_of(i:SAME):SAME + -- The smallest value greater than or equal to self which is a + -- multiple of `i'. + pre i>0 is + return ((self+i-1)/i)*i + end; + + gcd(i:SAME):SAME is + -- The greatest common divisor of self and `i'. + -- The result is non-negative and `x.gcd(0)=x.abs'. + -- Uses Euclidean algorithm. Geddes, et. al. p. 34. + c::=abs; d::=i.abs; + loop until!(d=0); r::=c.mod(d); c:=d; d:=r end; + return c + end; + + extended_gcd(i:SAME, out self_factor,out i_factor: SAME): SAME is + -- The three parts of the return value `g', `g1', and `g2' are such + -- that `g' is the greatest common divisor of self and `i' and + -- `g1*self+g2*i=g'. + -- Uses the extended Euclidean algorithm. Geddes, et. al. p. 36. + c::=abs; d::=i.abs; c1::=1; d1::=0; c2::=0; d2::=1; + loop until!(d=0); + q::=c/d; r::=c-q*d; r1::=c1-q*d1; r2::=c2-q*d2; + c:=d; c1:=d1; c2:=d2; d:=r; d1:=r1; d2:=r2 + end; + self_factor := c1/(abs*c.abs); + i_factor := c2/(abs*c.abs); + return c.abs; + end; + + lcm(i:SAME):SAME is + -- The least common multiple of self and `i'. + -- Geddes, et. al. p. 28. + return (self*i).abs/gcd(i) + end; + + is_prime:BOOL is + -- True if self is a prime number. + -- Replace by a faster algorithm. + if 2.evenly_divides(self) then return false end; + loop + d::=3.step!((self.sqrt+2)/2, 2); + if d.evenly_divides(self) then return false end + end; + return true + end; + + is_relatively_prime_to(i:SAME):BOOL is + -- True if self is relatively prime to `i'. + return gcd(i)=1 + end; + + factorial:SAME is + -- The factorial of self. + -- Replace by faster algorithm. + p::=1; + loop p:=p*2.upto!(self) end; + return p + end; + + -- Operations modulo 2^asize: + + mplus(i:SAME):SAME is builtin INT_MPLUS; end; + -- The sum of self and `i' modulo 2^asize. Never raises + -- an exception. Built-in. + + mminus(i:SAME):SAME is builtin INT_MMINUS; end; + -- The difference between self and `i' modulo 2^asize. Never + -- raises an exception. Built-in. + + mnegate:SAME is builtin INT_MNEGATE; end; + -- The additive inverse of self modulo 2^asize. Never raises an + -- exception. + + mtimes(i:SAME):SAME is builtin INT_MTIMES; end; + -- The product of self and `i' modulo 2^asize. Never raises + -- an exception. Built-in. + + mdiv(i:SAME):SAME is builtin INT_MDIV; end; + -- The unsigned quotient of self and `i'. Raises an exception when + -- `i' is 0, when enabled. Built-in. + + mmod(i:SAME):SAME is builtin INT_MMOD; end; + -- Unsigned remainder of self divided by `i'. Raises an exception + -- when `i' is 0, when enabled. + + -- Bitwise operations: + + bnot:SAME is builtin INT_BNOT; end; + -- The bitwise complement of self. + + band(i:SAME):SAME is builtin INT_BAND; end; + -- The bitwise and of self and `i'. + + bor(i:SAME):SAME is builtin INT_BOR; end; + -- The bitwise inclusive or of self and `i'. + + bxor(i:SAME):SAME is builtin INT_BXOR; end; + -- The bitwise exclusive or of self and `i'. + + bnand(i:SAME):SAME is + -- The bitwise nand of self and `i'. + return band(i).bnot end; + + bnor(i:SAME):SAME is + -- The bitwise nor of self and `i'. + return bor(i).bnot end; + + beqv(i:SAME):SAME is + -- The bits of res are 1 in positions where self and `i' have the + -- same bit values. + return bxor(i).bnot end; + + boole(i:SAME, rule:INT):SAME + -- The bits of res are combinations of the corresponding bits of + -- self and `i' combined according to a rule specified by `rule'. + -- This must be a value between 0 and 15. The low order bit says + -- what to map a 0 in self and a 0 in `i' to, the second bit of + -- `rule' says what to map 0,1 to, the third bit defines 1,0 and + -- the fourth 1,1. + pre rule.is_bet(0,15) is + case rule when 0 then return 0 + when 1 then return bor(i).bnot + when 2 then return bnot.band(i) + when 3 then return bnot + when 4 then return band(i.bnot) + when 5 then return i.bnot + when 6 then return bxor(i) + when 7 then return band(i).bnot + when 8 then return band(i) + when 9 then return bxor(i).bnot + when 10 then return i + when 11 then return bnot.bor(i) + when 12 then return self + when 13 then return bor(i.bnot) + when 14 then return bor(i) + when 15 then return -1 + else raise "INT::boole(SAME,INT):SAME err." + end + end; + + bcount:INT is + -- The number of bits in self which are set to 1. + r:SAME; + if asize=32 then + -- 32 bit version: + r:=self.band(0b01010101010101010101010101010101) + .uplus(self.urshift(1) + .band(0b01010101010101010101010101010101)); + r:=r.band(0b00110011001100110011001100110011) + .uplus(r.urshift(2).band(0b00110011001100110011001100110011)); + r:=r.band(0b00001111000011110000111100001111) + .uplus(r.urshift(4).band(0b00001111000011110000111100001111)); + r:=r+r.rshift(8); + r:=(r+r.rshift(16)).band(0b111111); + -- No need to mask the last two steps since the bits can't + -- interfere. + else + -- General size. + -- Semi-clever version (fast when sparse but slow for dense): + x::=self; + loop until!(x=0); x:=x.band(x.uminus(1)); r:=r+1 end; + end; + return r + end; + + lshift(i:INT):SAME is builtin INT_LSHIFT; end; + -- The bits of self shifted left by `i' places with + -- zeroes shifted in on the right. + + rshift(i:INT):SAME is builtin INT_RSHIFT; end; + -- The bits of self shifted right by `i' places with + -- bits equal to the first bit of self shifted in on the left. + + urshift(i:INT):SAME is builtin INT_URSHIFT; end; + -- The bits of self shifted right by `i' places with + -- zeroes shifted in on the left. + + lrotate(i:INT):SAME + -- Left rotate the bits of self by `i' places. + pre i.is_bet(0,asize) + is + return lshift(i).bor(urshift(asize-i)) + end; + + rrotate(i:INT):SAME + -- Right rotate the bits of self by `i' places. + pre i.is_bet(0,asize) + is + return urshift(i).bor(lshift(asize-i)) + end; + + bit(i:INT):BOOL is + -- True if bit `i' of self is 1. + return band(1.lshift(i))/=0 + end; + + set_bit(i:INT,b:BOOL):SAME is + -- Self with bit `i' set to b. + if b then return set_bit(i) else return unset_bit(i) end + end; + + set_bit(i:INT):SAME is + -- Self with bit `i' set to 1. + return bor(1.lshift(i)) + end; + + unset_bit(i:INT):SAME is + -- Self with bit `i' set to 0. + return band((1.lshift(i)).bnot) + end; + + octal_str:STR is + -- The octal representation of self of the form "0o15". + -- Self is interpreted as an unsigned integer. + buf:FSTR; + buf.clear; i::=self; + loop + buf:=buf + i.band(7).digit_char; + i:=i.urshift(3); + until!(i=0) + end; + buf:=buf + "o0"; + buf.to_reverse; + return buf.str + end; + + binary_str:STR is + -- The binary representation of self of the form "0b100100". + -- Self is interpreted as an unsigned integer. + buf:FSTR; + buf.clear; i::=self; + loop + buf := buf + i.band(1).digit_char; + i:=i.urshift(1); + until!(i=0) + end; + buf:=buf + "b0"; + buf.to_reverse; + return buf.str + end; + + hex_str:STR is + -- The hexadecimal representation of self of the form "0x5A". + -- Self is interpreted as an unsigned integer. + buf:FSTR; + buf.clear; i::=self; + loop + buf:=buf + i.band(15).digit_char; + i:=i.urshift(4); + until!(i=0) + end; + buf:=buf + "x0"; + buf.to_reverse; + return buf.str + end; + + lowest_bit:INT is + -- The position of the lowest non-zero bit of self. -1 if none. + if self=0 then return -1 end; + if asize=32 then + -- 32 bit version: + x::=self; r::=31; + z::=x.lshift(16); if z/=0 then x:=z; r:=r-16 end; + z:=x.lshift(8); if z/=0 then x:=z; r:=r-8 end; + z:=x.lshift(4); if z/=0 then x:=z; r:=r-4 end; + z:=x.lshift(2); if z/=0 then x:=z; r:=r-2 end; + z:=x.lshift(1); if z/=0 then x:=z; r:=r-1 end; + return r + -- + -- This implementation assumes that asize is a power of 2. + -- if self=0 then return -1 end; + -- x::=self; y::=asize/2; r:=asize-1; + -- loop until(y=0); z::=x.lshift(y); + -- if z/=0 then x:=z; r:=r-y end; y:=y.rshift(1) end; return r end; + -- + else + -- Straightforward way: + loop i::=(asize-1).downto!(0); + if lshift(i)/=0 then r::=asize-i-1; return r end + end; + return -1; + end; + end; + + highest_bit:INT is + -- The position of the highest non-zero bit of self. -1 if none. + if self=0 then return -1 end; + if asize=32 then + -- 32 bit version: + x::=self; z::=x.urshift(16); r:INT; + if z/=0 then x:=z; r:=r+16 end; + z:=x.urshift(8); if z/=0 then x:=z; r:=r+8 end; + z:=x.urshift(4); if z/=0 then x:=z; r:=r+4 end; + z:=x.urshift(2); if z/=0 then x:=z; r:=r+2 end; + z:=x.urshift(1); if z/=0 then x:=z; r:=r+1 end; + return r; + else + -- + -- This implementation assumes that asize is a power of 2. + -- if self=0 then return -1 end; + -- x::=self; y::=asize/2; + -- loop until(y=0); z::=x.urshift(y); + -- if z/=0 then x:=z; r:=r+y end; y:=y.rshift(1) end; + -- return r end; + -- + -- Straightforward way: + loop i::=1.upto!(asize-1); + if rshift(i)=0 then return i-1 end + end; + return asize-1; + end; + end; + + log2:INT pre self>0 is return self.highest_bit end; + + is_pow_of_2:BOOL is return is_exp2 end; + + is_exp2:BOOL is + -- returns true iff self is positive and a power of two + + res:BOOL:=false; + if self > 0 then + res := self.lowest_bit = self.highest_bit + end; + return res; + end; + + next_pow_of_2:INT is return next_exp2 end; + + next_exp2:INT is + -- for self positive it returns the p so that the following holds: + -- p.is_pow_of_2 and p>=self>(p/2) + + res:INT:=0; + bit:INT:=self.highest_bit; + if ~self.is_pow_of_2 then + bit := bit + 1; + end; + + return res.set_bit(bit); + end; + + low_bits(i:INT):INT + -- The low `i' bits of self with 0 in the higher positions. + pre i.is_bet(0,asize) + is + return band(1.lshift(i).uminus(1)) + end; + + high_bits(i:INT):INT is + -- The high `i' bits of self with 0 in the lower positions. + return band((1.lshift(asize-i).uminus(1)).bnot) + end; + + aget(i:INT):BOOL is builtin INT_AGET; end; + aset(i:INT,j:BOOL):INT is builtin INT_ASET; end; + aelt!:BOOL is loop yield [asize.times!]; end; end; + + maxint:INT is builtin INT_MAXINT; end; + minint:INT is builtin INT_MININT; end; + + const zero:SAME := 0; -- See $NUMBER. + const one: SAME := 1; + maxval:SAME is return maxint; end; -- See $NUMBER. + minval:SAME is return minint; end; -- See $NUMBER. + + -- Iters: + + times! pre self>=0 is builtin INT_TIMESB; end; + -- Yields self times without returning anything. + + times!:SAME pre self>=0 is builtin INT_TIMESB_INT; end; + -- Yield successive integers from 0 up to self-1. + + for!(once i:SAME):SAME + -- Yields `i' successive integers starting with self. + pre i>=0 is builtin INT_FORB; + end; + + up!:SAME is builtin INT_UPB; end; + -- Yield successive integers from self up. + + upto!(once i:SAME):SAME is builtin INT_UPTOB; end; + -- Yield successive integers from self to `i' inclusive. + + downto!(once i:SAME):SAME is builtin INT_DOWNTOB; end; + -- Yield successive integers from self down to `i' inclusive. + + step!(once num,once step:SAME):SAME + -- Yield `num' integers starting with self and stepping by `step'. + pre num>=0 + is + r::=self; last::=self+(num-1)*step; + if step>0 then + loop until!(r>last); yield r; r:=r+step end + elsif step<0 then + loop until!(r<last); yield r; r:=r+step end + else + loop num.times!; yield r end + end + end; + + stepto!(once to,once by:SAME): SAME + -- Yield succeeding integers from self to `to' by step `by'. + -- Might quit immediately if self is aleady `beyond'. + pre by /= 0 + is + r ::= self; + if by>0 then + loop until!(r>to); yield r; r := r + by end + else + loop until!(r<to); yield r; r := r + by end + end + end; + + sum!(i:SAME):SAME is + -- Yields the sum of all previous values of `i'. + r:SAME; + loop r:=r+i; yield r end + end; + + product!(i:SAME):SAME is + -- Yields the product of all previous values of `i'. + r::=1; + loop r:=r*i; yield r end + end; + +end; -- class INT +------------------------------------------------------------------- diff -NaurBbw sather-1.2.2/M4/Library/Base/int_test.sa gnu_sather32+64-1.2.2/M4/Library/Base/int_test.sa --- sather-1.2.2/M4/Library/Base/int_test.sa 1970-01-01 09:30:00.000000000 +0930 +++ gnu_sather32+64-1.2.2/M4/Library/Base/int_test.sa 2009-06-20 19:30:17.000000000 +0930 @@ -0,0 +1,106 @@ +changecom(`--')dnl +-------------------------> GNU Sather - sourcefile <------------------------- +-- Copyright (C) 1995 by International Computer Science Institute -- +-- This file is part of the GNU Sather library. It is free software; you may -- +-- redistribute and/or modify it under the terms of the GNU Library General -- +-- Public License (LGPL) as published by the Free Software Foundation; -- +-- either version 2 of the license, or (at your option) any later version. -- +-- This library is distributed in the hope that it will be useful, but -- +-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. -- +-- The license text is also available from: Free Software Foundation, Inc., -- +-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- +--------------> Please email comments to <[email protected]> <-------------- + +-- Author: Benedict A. Gomes <[email protected]> + +changequote(`$',`?')dnl +class INT_TEST is + include TEST; + + main is + class_name("INT"); + a ::= 5; + b ::= 7; + tp: FSTR := #; + restp ::= 1101.str_in(tp,10,8,'#'); + test("1101.str_in oct",restp,"######2115"); + tp2: FSTR := #; + restp2 ::= 1101.str_in(tp2,10,16,'#'); + test("1101.str_in hex",restp2,"#######44D"); +ifelse(__WORDSIZE,32, +$ tp3: FSTR := #; + restp3 ::= INT::nil.str_in(tp3,12,10,'#'); + test("nil.str_in dec",restp3,"#-2147483648"); + + tp4: FSTR := #; + restp4 ::= INT::nil.str_in(tp4,12,16,'#'); + test("nil.str_in hex",restp4,"###-80000000"); + tp5: FSTR := #; + restp5 ::= INT::nil.str_in(tp5,16,8,'#'); + test("nil.str_in oct",restp5,"####-20000000000"); +?,__WORDSIZE,64, +$ tp := #; + restp3 ::= INT::nil.str_in(tp,21,10,'#'); + test("nil.str_in dec",restp3,"#-9223372036854775808"); + + tp := #; + restp4 ::= INT::nil.str_in(tp,21,16,'#'); + test("nil.str_in hex",restp4,"####-8000000000000000"); + tp := #; + restp5 ::= INT::nil.str_in(tp,27,8,'#'); + test("nil.str_in oct",restp5,"####-1000000000000000000000"); +?)dnl + + val ::= a.plus(b); + test("plus",val.str,"12"); + test("plus",(a+b).str,"12"); + test("minus",(a-b).str,"-2"); + test("negate",(-a).str,"-5"); + test("times",(a*b).str,"35"); + test("div",(b/a).str,"1"); + test("mod",(b.mod(a)).str,"2"); + test("is_eq",(b=a).str,"false"); + test("is_eq",(a=a).str,"true"); + -- neq --- missing routines... + -- ... + -- Iter routines + i::=0; loop 9.times!; i:= i+1; end; + test("times!",i.str,"9"); + res::=""; loop res := res+5.times!+" "; end; + test("times!:SAME",res,"0 1 2 3 4 "); + res:=""; loop res := res+5.for!(4)+" "; end; + test("for!",res,"5 6 7 8 "); + res:=""; loop res := res+5.upto!(10)+" "; end; + test("upto!",res,"5 6 7 8 9 10 "); + res:=""; loop res := res+5.downto!(1)+" "; end; + test("downto",res,"5 4 3 2 1 "); + res:=""; loop res := res+5.step!(3,4)+" "; end; + test("step",res,"5 9 13 "); + i:=0; loop i := 0.sum!(5.step!(3,4)); end; + test("sum!",i.str,"27"); + i:=0; loop i := 0.product!(5.step!(3,4)); end; + test("product!",i.str,"585"); + res:=""; loop res := res+1.stepto!(10,2)+" "; end; + test("stepto!",res.str,"1 3 5 7 9 "); + res:=""; loop res := res+0.stepto!(10,2)+" "; end; + test("stepto!",res.str,"0 2 4 6 8 10 "); + res:=""; loop res := res+10.stepto!(0,-2)+" "; end; + test("step(down)to!",res.str,"10 8 6 4 2 0 "); + + test("pow 2^8",2.pow(8).str,256.str); + cur ::= 0; + cur_pow ::= 1; + loop + 30.times!; + test("pow 2^"+cur,2.pow(cur).str,cur_pow.str); + cur := cur + 1; + cur_pow := cur_pow*2; + end; + + finish; + end; + +end; + +------------------------------------------------------------------- diff -NaurBbw sather-1.2.2/Makefile gnu_sather32+64-1.2.2/Makefile --- sather-1.2.2/Makefile 2005-05-21 07:05:54.000000000 +0930 +++ gnu_sather32+64-1.2.2/Makefile 2009-06-19 21:32:05.000000000 +0930 @@ -31,6 +31,7 @@ CP=cp CPP=/lib/cpp -C -P +CPPP=/lib/cpp -P CC=gcc EXEC_SUFFIX= # CC is only used for bootstrapping, check System/Common/CONFIG.proto if @@ -46,6 +47,7 @@ #EXEC_SUFFIX=.exe # The name of the produced binaries +CS = sacomp SACOMP =Bin/sacomp$(EXEC_SUFFIX) SACOMP-BOOT =Boot/sacomp$(EXEC_SUFFIX) # This has to be changed lateron SABROWSE =Bin/sabrowse$(EXEC_SUFFIX) @@ -54,6 +56,7 @@ CS_OPT_DEBUG =-verbose -chk -C_flag -O -debug -debug_deterministic -debug_no_backtrace CS_OPT_PROFILE=-verbose -only_reachable -optimize -C_flag -pg +LB = Library/Base # The list of platforms to install, in addition to "BOOT". # "BOOT" intended to be the least common denominator required @@ -125,12 +128,21 @@ # This runs the C compiles after the Sather compiler instead of at # the same time, to ease installation for those with small VM. -compiler: system bootcompiler +compiler: wordsize system bootcompiler @echo; echo "Creating C for installation compiler..." ; echo $(SACOMP-BOOT) $(CS_OPT) Compiler/sacomp.module -o $(SACOMP) -only_C @echo; echo "Compiling C for installation compiler..." ; echo $(MAKE) -C $(SACOMP).code +.PHONY: wordsize +wordsize: + m4 -D __WORDSIZE=$$(echo $$(echo __WORDSIZE \ + | $(CPPP) -include bits/wordsize.h)) \ + M4/$(LB)/int.sa > $(LB)/int.sa + m4 -D __WORDSIZE=$$(echo $$(echo __WORDSIZE \ + | $(CPPP) -include bits/wordsize.h)) \ + M4/$(LB)/int_test.sa > $(LB)/int_test.sa + optional: bootcompiler @echo "*************************************************************" @echo " Trying to compile the optional Browser and Gui" @@ -177,11 +189,11 @@ $(SACOMP-BOOT) $(CS_OPT_DEBUG) Compiler/sacomp.module -o $(SACOMP) -only_C $(MAKE) -C $(SACOMP).code -profile: +profile: wordsize $(SACOMP-BOOT) $(CS_OPT_PROFILE) Compiler/sacomp.module -o $(SACOMP) -only_C $(MAKE) -C cd $(SACOMP).code -bootcompiler: system +bootcompiler: wordsize system @echo; echo "Making boot compiler..." ; echo $(MAKE) -C System/Platforms/$(BOOT_PLATFORM) boot CC='$(CC)' @@ -233,7 +245,7 @@ # 2. Compile using result. testfull: - $(MAKE) -C Test testfull + $(MAKE) -C Test test-full ################################### CLEANING ################################## @@ -263,5 +275,6 @@ $(RM) Library/Containers/nr_a_stack.sa $(RM) pLibrary/Containers/nr_stack.sa $(RM) pLibrary/Containers/nr_a_stack.sa - + $(RM) Boot/$(CS).code/*.o + $(RM) $(LB)/int.sa $(LB)/int_test.sa debian/rules clean-safe diff -NaurBbw sather-1.2.2/System/Common/runtime.h gnu_sather32+64-1.2.2/System/Common/runtime.h --- sather-1.2.2/System/Common/runtime.h 1999-11-04 05:18:17.000000000 +1030 +++ gnu_sather32+64-1.2.2/System/Common/runtime.h 2009-06-19 21:32:05.000000000 +0930 @@ -252,11 +252,11 @@ * # define INTDIV(x,y) (x>=0||x%y?x/y:y>0?x/y-1:x/y+1) * # define INTMOD(x,y) (x%y>=0?x%y:y<0?x%y-y:x%y+y) */ -# define INTUPLUS(x,y) ((unsigned)x)+((unsigned)y) -# define INTUMINUS(x,y) ((unsigned)x)-((unsigned)y) -# define INTUTIMES(x,y) ((unsigned)x)*((unsigned)y) -# define INTUDIV(x,y) ((unsigned)x)/((unsigned)y) -# define INTUMOD(x,y) ((unsigned)x)%((unsigned)y) +# define INTUPLUS(x,y) ((unsigned long)x)+((unsigned long)y) +# define INTUMINUS(x,y) ((unsigned long)x)-((unsigned long)y) +# define INTUTIMES(x,y) ((unsigned long)x)*((unsigned long)y) +# define INTUDIV(x,y) ((unsigned long)x)/((unsigned long)y) +# define INTUMOD(x,y) ((unsigned long)x)%((unsigned long)y) # define INTFLT(x) (FLT)x # define INTFLTD(x) (FLTD)x # define INTRSHIFT(x,s) (x<0)?x>>s:(~((~x)>>s)) @@ -271,8 +271,8 @@ * then please contribute a special case for your platform! */ -#define INTPLUS(x,y) CHKOK(((y>=0&&x<=(SINT_MAX-y))||(y<0&&x>=((signed)(((unsigned)SINT_MIN)-y)))),"Integer overflow on plus",x+y) -#define INTMINUS(x,y) CHKOK(((y>=0&&x>=(SINT_MIN+y))||(y<0&&x<=((signed)(((unsigned)SINT_MAX)+y)))),"Integer overflow on minus",x-y) +#define INTPLUS(x,y) CHKOK(((y>=0&&x<=(SINT_MAX-y))||(y<0&&x>=((long)(((unsigned long)SINT_MIN)-y)))),"Integer overflow on plus",x+y) +#define INTMINUS(x,y) CHKOK(((y>=0&&x>=(SINT_MIN+y))||(y<0&&x<=((long)(((unsigned long)SINT_MAX)+y)))),"Integer overflow on minus",x-y) #define INTTIMES(x,y) CHKOK(((x==0)||(y==0)||(x>0&&y>0&&y<=SINT_MAX/x)||(x>0&&y<0&&y>=SINT_MIN/x)||(x<0&&y>0&&x>=SINT_MIN/y)||(x<0&&y<0&&x!=SINT_MIN&&y!=SINT_MIN&&-x<=SINT_MAX/(-y))),"Integer overflow on times",x*y) #define INTDIV(x,y) CHKOK(y!=0,"Division by zero",((x<0&&x!=(x/y)*y)?(x/y)-1:(x/y))) #define INTMOD(x,y) CHKOK(y!=0,"Mod by zero",((x%y)<0)?(x%y)+y:(x%y)) @@ -280,11 +280,11 @@ * #define INTDIV(x,y) CHKOK(y!=0,"Division by zero",(x>=0||x%y?x/y:y>0?x/y-1:x/y+1)) * #define INTMOD(x,y) CHKOK(y!=0,"Mod by zero",(x%y>=0?x%y:y<0?x%y-y:x%y+y)) */ -#define INTUPLUS(x,y) CHKOK(x<=(SUINT_MAX-y),"Integer overflow on unsigned plus",((unsigned)x)+((unsigned)y)) -#define INTUMINUS(x,y) CHKOK(y<=x,"Integer overflow on unsigned minus",((unsigned)x)-((unsigned)y)) -#define INTUTIMES(x,y) CHKOK((x==0)||(y<=SUINT_MAX/x),"Integer overflow on unsigned times",((unsigned)x)*((unsigned)y)) -#define INTUDIV(x,y) CHKOK(y!=0,"Integer unsigned division by zero",((unsigned)x)/((unsigned)y)) -#define INTUMOD(x,y) CHKOK(y!=0,"Integer unsigned mod by zero",((unsigned)x)%((unsigned)y)) +#define INTUPLUS(x,y) CHKOK(x<=(SUINT_MAX-y),"Integer overflow on unsigned plus",((unsigned long)x)+((unsigned long)y)) +#define INTUMINUS(x,y) CHKOK(y<=x,"Integer overflow on unsigned minus",((unsigned long)x)-((unsigned long)y)) +#define INTUTIMES(x,y) CHKOK((x==0)||(y<=SUINT_MAX/x),"Integer overflow on unsigned times",((unsigned long)x)*((unsigned long)y)) +#define INTUDIV(x,y) CHKOK(y!=0,"Integer unsigned division by zero",((unsigned long)x)/((unsigned long)y)) +#define INTUMOD(x,y) CHKOK(y!=0,"Integer unsigned mod by zero",((unsigned long)x)%((unsigned long)y)) #define INTFLT(x) CHKOK(((INT)((FLT)x))==x,"Integer would overflow conversion to FLT",(FLT)x) #define INTFLTD(x) CHKOK(((INT)((FLTD)x))==x,"Integer would overflow conversion to FLTD",(FLTD)x) #define INTRSHIFT(x,s) (x<0)?x>>s:(~((~x)>>s))