promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.33 1988/08/15 20:35:29 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.c,v 9.34 1989/02/19 17:51:20 jinx Exp $ */
/* ARRAY =
sequence of REAL(float or double numbers) with a tag on the front */
*Now_Free++ = Make_Non_Pointer(TC_MANIFEST_VECTOR, Length);
for (i=0; i<Length; i++) {
- My_Store_Reduced_Flonum_Result( Array[i], *Now_Free);
+ Store_Reduced_Flonum_Result( Array[i], *Now_Free);
Now_Free++;
}
return Result;
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.h,v 9.28 1988/08/15 20:35:46 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/array.h,v 9.29 1989/02/19 17:51:28 jinx Exp $ */
\f
#define REAL float
extern void Find_Offset_Scale_For_Linear_Map();
/* REAL Min,Max, New_Min,New_Max, *Offset,*Scale;
*/
-
-/* other macros
- */
-#define My_Store_Flonum_Result(Ans, Value_Cell) \
- (Value_Cell) = (Allocate_Float( ((double) Ans)));
-
-#define My_Store_Reduced_Flonum_Result(Ans, Value_Cell) \
-{ double Number = ((double) Ans); \
- double floor(); \
- Pointer result; \
- if (floor(Number) != Number) \
- { My_Store_Flonum_Result(Number, Value_Cell); \
- } \
- else if (Number == 0) \
- (Value_Cell) = Make_Unsigned_Fixnum(0); \
- if ((floor(Number) == Number) && (Number != 0)) \
- { int exponent; \
- double frexp(); \
- frexp(Number, &exponent); \
- if (exponent <= FIXNUM_LENGTH) \
- { double_into_fixnum(Number, result); \
- (Value_Cell) = result; \
- } \
- /* Since the float has no fraction, we will not gain \
- precision if its mantissa has enough bits to support \
- the exponent. */ \
- else if (exponent <= FLONUM_MANTISSA_BITS) \
- { result = Float_To_Big(Number); \
- (Value_Cell) = result; \
- } \
- else if (Number != 0) \
- { My_Store_Flonum_Result( (Ans), (Value_Cell)); \
- } \
- } \
-}
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.40 1989/02/15 19:23:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.41 1989/02/19 17:51:33 jinx Exp $
*
* This file contains the configuration information and the information
* given on the command line on Unix.
#define ULONG_SIZE 32
#define BELL '\007'
-#ifdef sun4
-#define FASL_INTERNAL_FORMAT FASL_SUN4
-#define FLOATING_ALIGNMENT 0x7 /* Low 3 MBZ for float storage */
#define FLONUM_EXPT_SIZE 10
#define FLONUM_MANTISSA_BITS 53
#define MAX_FLONUM_EXPONENT 1023
+
+#ifdef sun4
+#define FASL_INTERNAL_FORMAT FASL_SUN4
+#define FLOATING_ALIGNMENT 0x7 /* Low 3 MBZ for float storage */
#endif
#ifdef sun3
#define FASL_INTERNAL_FORMAT FASL_68020
-#define FLONUM_EXPT_SIZE 10
-#define FLONUM_MANTISSA_BITS 53
-#define MAX_FLONUM_EXPONENT 1023
#endif
#ifndef FASL_INTERNAL_FORMAT
#define FASL_INTERNAL_FORMAT FASL_68000
-#define FLONUM_EXPT_SIZE 7
-#define FLONUM_MANTISSA_BITS 56
-#define MAX_FLONUM_EXPONENT 127
#endif
#define HAS_FLOOR
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.26 1988/08/15 20:46:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fixnum.c,v 9.27 1989/02/19 17:51:38 jinx Rel $
Copyright (c) 1987, 1988 Massachusetts Institute of Technology
FIXNUM_RESULT (result);
}
\f
+/* Fixnum multiplication routine with overflow detection. */
+
+#include "mul.c"
+
DEFINE_PRIMITIVE ("MULTIPLY-FIXNUM", Prim_multiply_fixnum, 2, 2, 0)
{
- /* Mul, which does the multiplication with overflow handling, is
- customized for some machines. Therefore, it is in os.c */
- extern Pointer Mul();
fast long result;
Primitive_2_Args ();
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/mul.c,v 9.25 1989/02/17 15:05:19 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/mul.c,v 9.26 1989/02/19 17:51:47 jinx Rel $
*
- * This file contains the portable fixnum multiplication procedure.
+ * This file contains the fixnum multiplication procedure.
* Returns NIL if the result does not fit in a fixnum.
- * Note: This has only been tried on machines with long = 32 bits.
- * This file is included in the appropriate os file if needed.
+ * Note: The portable version has only been tried on machines with
+ * long = 32 bits. This file is included in the appropriate os file.
*/
\f
+extern Pointer Mul();
+
+#if defined(vax) && defined(bsd)
+
+#define MUL_HANDLED
+
+/* Note that "register" is used here (not "fast") since the
+ assembly code requires knowledge of the location of
+ the variables and they therefore must be in registers.
+ This is a kludge. It depends on what register variables
+ get assigned to what registers. It should be entirely
+ coded in assembly language. -- JINX
+*/
+
+Pointer
+Mul(Arg1, Arg2)
+ Pointer Arg1, Arg2;
+{
+ register long A, B, C;
+
+ Sign_Extend(Arg1, A);
+ Sign_Extend(Arg2, B);
+ asm(" emul r11,r10,$0,r10"); /* A is in 11, B in 10 */
+ C = A;
+ A = B; /* What is all this shuffling? -- JINX */
+ B = C;
+ /* B should have high order result, A low order */
+ if (((B == 0) && (A & (-1 << 23)) == 0) ||
+ ((B == -1) && (A & (-1 << 23)) == (-1 << 23)))
+ {
+ return (MAKE_SIGNED_FIXNUM(A));
+ }
+ else
+ {
+ return (NIL);
+ }
+}
+
+#endif
+\f
+/* 68k family code. Uses hp9000s200 conventions for the new compiler. */
+
+#if defined(hp9000s200) && !defined(old_cc) && !defined(__GNUC__)
+#define MUL_HANDLED
+
+/* The following constants are hard coded in the assembly language
+ * code below. The code assumes that d0 and d1 are scratch registers
+ * for the compiler.
+ */
+
+#if (NIL != 0) || (TC_FIXNUM != 0x1A)
+#include "Error: types changed. Change assembly language appropriately"
+#endif
+
+#if defined(MC68020)
+
+static long Fixnum_Range[2] = {SMALLEST_FIXNUM , BIGGEST_FIXNUM};
+
+ asm(" text");
+ asm(" global _Mul");
+ asm("_Mul:");
+ asm(" bfexts 4(%sp){&8:&24},%d0");
+ asm(" bfexts 8(%sp){&8:&24},%d1");
+ asm(" muls.l %d1,%d0");
+ asm(" bvs.b result_is_nil");
+ asm(" cmp2.l %d0,_Fixnum_Range");
+ asm(" bcs.b result_is_nil");
+ asm(" moveq &0x1A,%d1");
+ asm(" bfins %d1,%d0{&0:&8}");
+ asm(" rts");
+ asm("result_is_nil:");
+ asm(" clr.l %d0");
+ asm(" rts");
+ asm(" data");
+
+#else /* not MC68020, but 68k family */
+
+ /* 20(sp) = arg0; 24(sp) = arg1 because of movem */
+
+ asm(" text");
+ asm(" global _Mul");
+ asm("_Mul:");
+ asm(" movem.l %d2-%d5,-(%sp)");
+ asm(" clr.b %d5");
+ asm(" tst.b 21(%sp)");
+ asm(" slt 20(%sp)");
+ asm(" bge.b coerce_1");
+ asm(" moveq &1,%d5");
+ asm(" neg.l 20(%sp)");
+\f
+ asm("coerce_1:");
+ asm(" tst.b 25(%sp)");
+ asm(" slt 24(%sp)");
+ asm(" bge.b after_coerce");
+ asm(" eori.b &1,%d5");
+ asm(" neg.l 24(%sp)");
+ asm("after_coerce:");
+ asm(" move.l 20(%sp),%d0");
+ asm(" move.l 24(%sp),%d1");
+ asm(" move.w %d0,%d2");
+ asm(" mulu %d1,%d2");
+ asm(" move.w %d1,%d4");
+ asm(" swap %d1");
+ asm(" move.w %d1,%d3");
+ asm(" mulu %d0,%d3");
+ asm(" swap %d0");
+ asm(" mulu %d0,%d4");
+ asm(" add.l %d4,%d3");
+ asm(" bcs.b result_is_nil");
+ asm(" mulu %d0,%d1");
+ asm(" bne.b result_is_nil");
+ asm(" swap %d2");
+ asm(" add.w %d3,%d2");
+ asm(" bcs.b result_is_nil");
+ asm(" swap %d3");
+ asm(" tst.w %d3");
+ asm(" bne.b result_is_nil");
+ asm(" cmpi.w %d2,&0x7F");
+ asm(" bgt.b result_is_nil");
+ asm(" swap %d2");
+ asm(" tst.b %d5");
+ asm(" beq.b sign_is_right");
+ asm(" neg.l %d2");
+ asm("sign_is_right:");
+ asm(" move.l %d2,-(%sp)");
+ asm(" move.b &0x1A,(%sp)");
+ asm(" move.l (%sp)+,%d0");
+ asm(" movem.l (%sp)+,%d2-%d5");
+ asm(" rts");
+ asm("result_is_nil:");
+ asm(" clr.l %d0");
+ asm(" movem.l (%sp)+,%d2-%d5");
+ asm(" rts");
+ asm(" data");
+
+#endif /* not MC68020 */
+#endif /* hp9000s200 */
+\f
+#ifndef MUL_HANDLED
+
#define HALF_WORD_SIZE ((sizeof(long)*CHAR_SIZE)/2)
#define HALF_WORD_MASK (1<<HALF_WORD_SIZE)-1
#define MAX_MIDDLE (1<<((ADDRESS_LENGTH-1)-HALF_WORD_SIZE))
}
return (NIL);
}
+
+#endif /* not MUL_HANDLED */
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/sgraph_a.c,v 1.5 1988/08/15 20:33:45 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/sgraph_a.c,v 1.6 1989/02/19 17:51:11 jinx Rel $ */
#include "scheme.h"
#include "prims.h"
Answer = Make_Pointer(TC_LIST, Free);
Orig_Free = Free;
Free += 4;
- My_Store_Reduced_Flonum_Result(Offset, *Orig_Free);
+ Store_Reduced_Flonum_Result(Offset, *Orig_Free);
Orig_Free++;
*Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1);
Orig_Free++;
- My_Store_Reduced_Flonum_Result(Scale, *Orig_Free);
+ Store_Reduced_Flonum_Result(Scale, *Orig_Free);
Orig_Free++;
*Orig_Free = EMPTY_LIST;
PRIMITIVE_RETURN(Answer);
Answer = Make_Pointer(TC_LIST, Free);
Orig_Free = Free;
Free += 4;
- My_Store_Reduced_Flonum_Result(Offset, *Orig_Free);
+ Store_Reduced_Flonum_Result(Offset, *Orig_Free);
Orig_Free++;
*Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1);
Orig_Free++;
- My_Store_Reduced_Flonum_Result(Scale, *Orig_Free);
+ Store_Reduced_Flonum_Result(Scale, *Orig_Free);
Orig_Free++;
*Orig_Free = EMPTY_LIST;
PRIMITIVE_RETURN(Answer);
Answer = Make_Pointer(TC_LIST, Free);
Orig_Free = Free;
Free += 6;
- My_Store_Reduced_Flonum_Result(red, *Orig_Free);
+ Store_Reduced_Flonum_Result(red, *Orig_Free);
Orig_Free++;
*Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1);
Orig_Free++;
- My_Store_Reduced_Flonum_Result(green, *Orig_Free);
+ Store_Reduced_Flonum_Result(green, *Orig_Free);
Orig_Free++;
*Orig_Free = Make_Pointer(TC_LIST, Orig_Free+1);
Orig_Free++;
- My_Store_Reduced_Flonum_Result(blue, *Orig_Free);
+ Store_Reduced_Flonum_Result(blue, *Orig_Free);
Orig_Free++;
*Orig_Free = EMPTY_LIST;
PRIMITIVE_RETURN(Answer);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.67 1989/01/05 19:02:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.68 1989/02/19 17:52:08 jinx Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 67
+#define SUBVERSION 68
#endif
#ifndef UCODE_TABLES_FILENAME
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/mul.c,v 9.25 1989/02/17 15:05:19 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/mul.c,v 9.26 1989/02/19 17:51:47 jinx Rel $
*
- * This file contains the portable fixnum multiplication procedure.
+ * This file contains the fixnum multiplication procedure.
* Returns NIL if the result does not fit in a fixnum.
- * Note: This has only been tried on machines with long = 32 bits.
- * This file is included in the appropriate os file if needed.
+ * Note: The portable version has only been tried on machines with
+ * long = 32 bits. This file is included in the appropriate os file.
*/
\f
+extern Pointer Mul();
+
+#if defined(vax) && defined(bsd)
+
+#define MUL_HANDLED
+
+/* Note that "register" is used here (not "fast") since the
+ assembly code requires knowledge of the location of
+ the variables and they therefore must be in registers.
+ This is a kludge. It depends on what register variables
+ get assigned to what registers. It should be entirely
+ coded in assembly language. -- JINX
+*/
+
+Pointer
+Mul(Arg1, Arg2)
+ Pointer Arg1, Arg2;
+{
+ register long A, B, C;
+
+ Sign_Extend(Arg1, A);
+ Sign_Extend(Arg2, B);
+ asm(" emul r11,r10,$0,r10"); /* A is in 11, B in 10 */
+ C = A;
+ A = B; /* What is all this shuffling? -- JINX */
+ B = C;
+ /* B should have high order result, A low order */
+ if (((B == 0) && (A & (-1 << 23)) == 0) ||
+ ((B == -1) && (A & (-1 << 23)) == (-1 << 23)))
+ {
+ return (MAKE_SIGNED_FIXNUM(A));
+ }
+ else
+ {
+ return (NIL);
+ }
+}
+
+#endif
+\f
+/* 68k family code. Uses hp9000s200 conventions for the new compiler. */
+
+#if defined(hp9000s200) && !defined(old_cc) && !defined(__GNUC__)
+#define MUL_HANDLED
+
+/* The following constants are hard coded in the assembly language
+ * code below. The code assumes that d0 and d1 are scratch registers
+ * for the compiler.
+ */
+
+#if (NIL != 0) || (TC_FIXNUM != 0x1A)
+#include "Error: types changed. Change assembly language appropriately"
+#endif
+
+#if defined(MC68020)
+
+static long Fixnum_Range[2] = {SMALLEST_FIXNUM , BIGGEST_FIXNUM};
+
+ asm(" text");
+ asm(" global _Mul");
+ asm("_Mul:");
+ asm(" bfexts 4(%sp){&8:&24},%d0");
+ asm(" bfexts 8(%sp){&8:&24},%d1");
+ asm(" muls.l %d1,%d0");
+ asm(" bvs.b result_is_nil");
+ asm(" cmp2.l %d0,_Fixnum_Range");
+ asm(" bcs.b result_is_nil");
+ asm(" moveq &0x1A,%d1");
+ asm(" bfins %d1,%d0{&0:&8}");
+ asm(" rts");
+ asm("result_is_nil:");
+ asm(" clr.l %d0");
+ asm(" rts");
+ asm(" data");
+
+#else /* not MC68020, but 68k family */
+
+ /* 20(sp) = arg0; 24(sp) = arg1 because of movem */
+
+ asm(" text");
+ asm(" global _Mul");
+ asm("_Mul:");
+ asm(" movem.l %d2-%d5,-(%sp)");
+ asm(" clr.b %d5");
+ asm(" tst.b 21(%sp)");
+ asm(" slt 20(%sp)");
+ asm(" bge.b coerce_1");
+ asm(" moveq &1,%d5");
+ asm(" neg.l 20(%sp)");
+\f
+ asm("coerce_1:");
+ asm(" tst.b 25(%sp)");
+ asm(" slt 24(%sp)");
+ asm(" bge.b after_coerce");
+ asm(" eori.b &1,%d5");
+ asm(" neg.l 24(%sp)");
+ asm("after_coerce:");
+ asm(" move.l 20(%sp),%d0");
+ asm(" move.l 24(%sp),%d1");
+ asm(" move.w %d0,%d2");
+ asm(" mulu %d1,%d2");
+ asm(" move.w %d1,%d4");
+ asm(" swap %d1");
+ asm(" move.w %d1,%d3");
+ asm(" mulu %d0,%d3");
+ asm(" swap %d0");
+ asm(" mulu %d0,%d4");
+ asm(" add.l %d4,%d3");
+ asm(" bcs.b result_is_nil");
+ asm(" mulu %d0,%d1");
+ asm(" bne.b result_is_nil");
+ asm(" swap %d2");
+ asm(" add.w %d3,%d2");
+ asm(" bcs.b result_is_nil");
+ asm(" swap %d3");
+ asm(" tst.w %d3");
+ asm(" bne.b result_is_nil");
+ asm(" cmpi.w %d2,&0x7F");
+ asm(" bgt.b result_is_nil");
+ asm(" swap %d2");
+ asm(" tst.b %d5");
+ asm(" beq.b sign_is_right");
+ asm(" neg.l %d2");
+ asm("sign_is_right:");
+ asm(" move.l %d2,-(%sp)");
+ asm(" move.b &0x1A,(%sp)");
+ asm(" move.l (%sp)+,%d0");
+ asm(" movem.l (%sp)+,%d2-%d5");
+ asm(" rts");
+ asm("result_is_nil:");
+ asm(" clr.l %d0");
+ asm(" movem.l (%sp)+,%d2-%d5");
+ asm(" rts");
+ asm(" data");
+
+#endif /* not MC68020 */
+#endif /* hp9000s200 */
+\f
+#ifndef MUL_HANDLED
+
#define HALF_WORD_SIZE ((sizeof(long)*CHAR_SIZE)/2)
#define HALF_WORD_MASK (1<<HALF_WORD_SIZE)-1
#define MAX_MIDDLE (1<<((ADDRESS_LENGTH-1)-HALF_WORD_SIZE))
}
return (NIL);
}
+
+#endif /* not MUL_HANDLED */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.67 1989/01/05 19:02:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.68 1989/02/19 17:52:08 jinx Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 67
+#define SUBVERSION 68
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff