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/bignum.c,v 5.3 1986/12/17 18:26:45 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.20 1987/01/21 20:14:34 jinx Exp $
This file contains the procedures for handling BIGNUM Arithmetic. */
DEST = Bignum_Top(DEST);
SOURCE = Bignum_Bottom(SOURCE);
while (SCAN >= SOURCE)
- { digits = Mul_Radix(carry) + *SCAN--;
- *DEST = digits / how_much;
- carry = digits - (*DEST-- * how_much);
+ { fast unsigned bigdouble digits, temp; /* Bug fix by JMiller */
+ digits = Mul_Radix(carry) + *SCAN--;
+ temp = digits / how_much;
+ *DEST-- = temp;
+ temp = temp * how_much;
+ carry = digits - temp;
}
return carry; /* returns remainder */
}
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/bignum.h,v 5.3 1986/12/17 06:34:23 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.h,v 9.20 1987/01/21 20:14:50 jinx Exp $
Head file for bignums. This is shared by bignum.c and generic.c. */
\f
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/char.c,v 5.3 1987/01/13 19:33:40 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.20 1987/01/21 20:16:35 jinx Exp $ */
/* Character primitives. */
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 5.2 1986/12/17 06:34:57 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.20 1987/01/21 20:17:44 jinx Exp $
*
* This file contains the configuration information and the information
* given on the command line on Unix.
#ifndef Allow_Aux_Compilation
#define Allow_Aux_Compilation true
#endif
+
+/* This is how we support future numbering for external metering */
+#ifndef New_Future_Number
+#define New_Future_Number() NIL
+#else
+Pointer Get_New_Future_Number();
+#endif
Free += 2;
*Free++ = Combination;
*Free++ = return_to_interpreter;
- *Free++ = Make_Pointer(TC_LIST, Free-2);
+ *Free = Make_Pointer(TC_LIST, Free-2);
+ Free++; /* Some compilers are TOO clever about this and increment Free
+ before calculating Free-2! */
*Free++ = Ext_Prims;
/* Aligning here confuses some of the counts computed.
Align_Float(Free);
if (File_Load_Debug)
printf("\nMachine type %d, Version %d, Subversion %d\n",
Machine_Type, Version, Sub_Version);
-#ifdef butterfly
+#ifdef BYTE_INVERSION
if ((Sub_Version > FASL_SUBVERSION))
#else
if ((Sub_Version > FASL_SUBVERSION) ||
Align_Float(Free);
*/
Load_Data(Heap_Count, (char *) Free);
+#ifdef BYTE_INVERSION
+ Byte_Invert_Region((char *) Free, Heap_Count);
+#endif
Free += Heap_Count;
Load_Data(Const_Count, (char *) Free_Constant);
+#ifdef BYTE_INVERSION
+ Byte_Invert_Region((char *) Free_Constant, Const_Count);
+#endif
Free_Constant += Const_Count;
/* Same
Align_Float(Free);
Next_Pointer, (Stop_At-Next_Pointer)-1, Stop_At);
while (Next_Pointer < Stop_At)
{ fast Pointer Temp = *Next_Pointer;
+
Switch_by_GC_Type(Temp)
{ case TC_BROKEN_HEART:
case TC_MANIFEST_SPECIAL_NM_VECTOR:
Next_Pointer += Get_Integer(Temp)+1;
break;
+#ifdef BYTE_INVERSION
+ case TC_CHARACTER_STRING:
+ String_Inversion(Relocate(Datum(Temp)));
+ /* THEN FALL THROUGH */
+#endif
+
/* These work automagically */
case_compiled_entry_point:
default:
/* Relocate the new Data */
+#ifdef BYTE_INVERSION
+ Setup_For_String_Inversion();
+#endif
+
Found_Ext_Prims = false;
Relocate_Block(Orig_Heap, Free);
Relocate_Block(Orig_Constant, Free_Constant);
+#ifdef BYTE_INVERSION
+ Finish_String_Inversion();
+#endif
+
/* Fasload continues on the next page */
\f
/* Fasload, continued */
else Free = Orig_Free;
return Interned_Symbol;
}
+\f
+#ifdef BYTE_INVERSION
+
+#define MAGIC_OFFSET TC_FIXNUM+1
+
+Pointer String_Chain, Last_String;
+extern Boolean Byte_Invert_Fasl_Files;
+
+Setup_For_String_Inversion()
+{ if (!Byte_Invert_Fasl_Files) return;
+ String_Chain = NIL;
+ Last_String = NIL;
+}
+
+Finish_String_Inversion()
+{ while (String_Chain != NIL)
+ { long Count;
+ Pointer Next;
+
+ if (!Byte_Invert_Fasl_Files) return;
+
+ Count = Get_Integer(Fast_Vector_Ref(String_Chain, STRING_HEADER));
+ Count = 4*(Count-2)+Type_Code(String_Chain)-MAGIC_OFFSET;
+ if (Reloc_Debug)
+ printf("String at 0x%x: restoring length of %d.\n",
+ Address(String_Chain), Count);
+ Next = Fast_Vector_Ref(String_Chain, STRING_LENGTH);
+ Fast_Vector_Set(String_Chain, STRING_LENGTH, FIXNUM_0+Count);
+ String_Chain = Next;
+ }
+}
+\f
+String_Inversion(Orig_Pointer)
+Pointer *Orig_Pointer;
+{ Pointer *Pointer_Address;
+ char *To_Char;
+ long Code;
+
+ if (!Byte_Invert_Fasl_Files) return;
+
+ Code = Type_Code(Orig_Pointer[STRING_LENGTH]);
+ if (Code == TC_FIXNUM || Code == 0) /* Already reversed? */
+ { long Count, old_size, new_size, i;
+
+ old_size = Get_Integer(Orig_Pointer[STRING_HEADER]);
+ new_size =
+ 2+(Get_Integer(Orig_Pointer[STRING_LENGTH]))/4;
+
+ if (Reloc_Debug)
+ printf("\nString at 0x%x with %d characters",
+ Orig_Pointer,
+ Get_Integer(Orig_Pointer[STRING_LENGTH]));
+
+ if (old_size != new_size)
+ { printf("\nWord count changed from %d to %d: ",
+ old_size , new_size);
+ printf("\nWhich, of course, is impossible!!\n");
+ Microcode_Termination(TERM_EXIT);
+ }
+
+ Count = Get_Integer(Orig_Pointer[STRING_LENGTH])%4;
+ if (Count==0) Count = 4;
+ if (Last_String == NIL)
+ String_Chain = Make_Pointer(Count+MAGIC_OFFSET, Orig_Pointer);
+ else Fast_Vector_Set(Last_String, STRING_LENGTH,
+ Make_Pointer(Count+MAGIC_OFFSET, Orig_Pointer));
+ Last_String = Make_Pointer(TC_NULL, Orig_Pointer);
+ Orig_Pointer[STRING_LENGTH] = NIL;
+ Count = Get_Integer(Orig_Pointer[STRING_HEADER])-1;
+ if (Reloc_Debug)
+ printf("\nCell count=%d\n", Count);
+ Pointer_Address = &(Orig_Pointer[STRING_CHARS]);
+ To_Char = (char *) Pointer_Address;
+ for (i=0; i < Count; i++, Pointer_Address++)
+ { int C1, C2, C3, C4;
+ C4 = Type_Code(*Pointer_Address) & 0xFF;
+ C3 = (((long) *Pointer_Address)>>16) & 0xFF;
+ C2 = (((long) *Pointer_Address)>>8) & 0xFF;
+ C1 = ((long) *Pointer_Address) & 0xFF;
+ if (Reloc_Debug || (old_size != new_size))
+ { print_char(C1);
+ print_char(C2);
+ print_char(C3);
+ print_char(C4);
+ }
+ *To_Char++ = C1;
+ *To_Char++ = C2;
+ *To_Char++ = C3;
+ *To_Char++ = C4;
+ }
+ }
+ if (Reloc_Debug) printf("\n");
+}
+#endif
+
Pointer IO_Vector, IO_Cons, IO_Hunk3, Empty_Queue, IO_String;
Primitive_3_Args();
- Primitive_GC_If_Needed(20);
+ Primitive_GC_If_Needed(21);
Empty_Queue=Make_Pointer(TC_LIST,Free);
*Free++=NIL;
*Free++=IO_Hunk3;
The_Future=Make_Pointer(TC_FUTURE,Free);
- *Free++=Make_Non_Pointer(TC_MANIFEST_VECTOR,9);
+ *Free++=Make_Non_Pointer(TC_MANIFEST_VECTOR,10);
*Free++=NIL; /* No value yet. */
*Free++=NIL; /* Not locked. */
*Free++=Empty_Queue; /* Put the empty queue here. */
*Free++=Arg1; /* The process slot. */
- *Free++=TRUTH; /* Status slot - not used? */
- *Free++=Arg2; /* For debugging. */
+ *Free++=TRUTH; /* Status slot. */
+ *Free++=Arg2; /* Original code. */
*Free++=IO_Vector; /* Put the I/O system stuff here. */
*Free++=NIL; /* Waiting on list. */
- *Free++=NIL; /* User slot? */
+ *Free++=New_Future_Number(); /* Metering number. */
+ *Free++=NIL; /* User data slot */
return The_Future; }
fast Pointer scan_list, *scan_stack;
fast long number_of_args, i;
#ifdef butterfly
- Pointer saved_stack_pointer;
+ Pointer *saved_stack_pointer;
#endif
Primitive_2_Args();
Heap_Base, Const_Base, Dumped_Object,
Dumped_Heap_Top, Dumped_Constant_Top, Dumped_Stack_Top;
Pointer Ext_Prim_Vector;
-Boolean Found_Ext_Prims;
+Boolean Found_Ext_Prims, Byte_Invert_Fasl_Files;
Boolean Read_Header()
{ Pointer Buffer[FASL_HEADER_LENGTH];
Pointer Pointer_Heap_Base, Pointer_Const_Base;
Load_Data(FASL_OLD_LENGTH, (char *) Buffer);
if (Buffer[FASL_Offset_Marker] != FASL_FILE_MARKER) return false;
+#ifdef BYTE_INVERSION
+ Byte_Invert_Header(Buffer,sizeof(Buffer)/sizeof(Pointer),
+ Buffer[FASL_Offset_Heap_Base],Buffer[FASL_Offset_Heap_Count]);
+#endif
Heap_Count = Get_Integer(Buffer[FASL_Offset_Heap_Count]);
Pointer_Heap_Base = Buffer[FASL_Offset_Heap_Base];
Heap_Base = Datum(Pointer_Heap_Base);
if (Sub_Version >= FASL_LONG_HEADER)
{ Load_Data(FASL_HEADER_LENGTH-FASL_OLD_LENGTH,
(char *) &(Buffer[FASL_OLD_LENGTH]));
+#if BYTE_INVERSION
+ Byte_Invert_Region((char *) &(Buffer[FASL_OLD_LENGTH]),
+ FASL_HEADER_LENGTH-FASL_OLD_LENGTH);
+#endif
Ext_Prim_Vector =
Make_Non_Pointer(TC_CELL, Datum(Buffer[FASL_Offset_Ext_Loc]));
}
}
return true;
}
+
+#ifdef BYTE_INVERSION
+Byte_Invert_Header(Header, Headsize, Test1, Test2)
+long *Header, Headsize, Test1, Test2;
+{ Byte_Invert_Fasl_Files = false;
+
+ if ((Test1 & 0xff) == TC_BROKEN_HEART &&
+ (Test2 & 0xff) == TC_BROKEN_HEART &&
+ (Type_Code(Test1) != TC_BROKEN_HEART ||
+ Type_Code(Test2) != TC_BROKEN_HEART)) {
+ Byte_Invert_Fasl_Files = true;
+ Byte_Invert_Region(Header,Headsize); }
+}
+
+Byte_Invert_Region(Region, Size)
+long *Region, Size;
+{ register long word, size;
+
+ if (Byte_Invert_Fasl_Files)
+ for (size=Size; size>0; size--, Region++) {
+ word=(*Region);
+ *Region=((word>>24)&0xff) | ((word>>8)&0xff00) |
+ ((word<<8)&0xff0000) | ((word<<24)&0xff000000); } }
+#endif
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/object.h,v 5.3 1987/01/12 17:17:33 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.20 1987/01/21 20:24:48 jinx Exp $ */
/* This file contains definitions pertaining to the C view of
Scheme pointers: widths of fields, extraction macros, pre-computed
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/prims.h,v 5.2 1987/01/12 17:18:44 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.20 1987/01/21 20:25:11 jinx Exp $ */
/* This file contains some macros for defining primitives,
for argument type or value checking, and for accessing
signal_interrupt_from_primitive (); \
}
+#define Special_Primitive_Interrupt(Local_Mask) \
+{ \
+ special_interrupt_from_primitive (Local_Mask); \
+}
+
#define Primitive_GC(Amount) \
{ \
Request_GC (Amount); \
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/stack.h,v 5.2 1987/01/06 20:22:21 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/stack.h,v 9.20 1987/01/21 20:26:56 jinx Exp $ */
/* This file contains macros for manipulating stacks and stacklets. */
\f
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/storage.c,v 5.2 1986/12/20 01:25:14 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.20 1987/01/21 20:27:14 jinx Exp $
This file defines the storage for global variables for
the Scheme Interpreter. */
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/string.c,v 5.4 1987/01/13 19:33:08 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.20 1987/01/21 20:27:56 jinx Exp $ */
/* String primitives. */
;;;; Machine Dependent Type Tables
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 1.2 1987/01/13 18:56:14 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.20 1987/01/21 20:29:40 jinx Exp $
(declare (usual-integrations))
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/utils.c,v 5.2 1987/01/12 17:26:03 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.20 1987/01/21 20:29:54 jinx Exp $ */
/* This file contains utilities for interrupts, errors, etc. */
{
Back_Out_Of_Primitive ();
longjmp (*Back_To_Eval, PRIM_INTERRUPT);
+ /*NOTREACHED*/
+}
+
+void
+special_interrupt_from_primitive(local_mask)
+ int local_mask;
+{
+ Back_Out_Of_Primitive();
+ Save_Cont();
+ Store_Return(RC_RESTORE_INT_MASK);
+ Store_Expression(FIXNUM_0+IntEnb);
+ IntEnb = (local_mask);
+ longjmp(*Back_To_Eval, PRIM_INTERRUPT);
+ /*NOTREACHED*/
}
void
Get_Fixed_Obj_Slot(System_Error_Vector))) !=
TC_VECTOR))
{ printf("\nBogus Error Vector! I'm terribly confused!\n");
+ printf("\n**** Stack Trace ****\n\n");
+ Back_Trace();
Microcode_Termination(TERM_NO_ERROR_HANDLER, Err);
}
if (Err >= Vector_Length(Error_Vector))
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/version.h,v 5.10 1987/01/13 18:14:24 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.20 1987/01/21 20:30:25 jinx Exp $
This file contains version information for the microcode. */
\f
/* Scheme system release version */
#ifndef RELEASE
-#define RELEASE "5.0.19"
+#define RELEASE "5.0.20"
#endif
/* Microcode release version */
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 19
+#define SUBVERSION 20
#endif
#ifndef UCODE_TABLES_FILENAME
#define Zone_GCIdle 9
#define Zone_Lookup 10
-#define Max_Meters 11
+/* For finding out about lock contention - 1/19/87 - sas */
+
+#define Zone_Count_Locks 11
+#define Zone_Count_Lock_0 12
+#define Zone_Count_Lock_1 13
+#define Zone_Count_Lock_2 14
+#define Zone_Count_Lock_3 15
+#define Zone_Count_Lock_4 16
+#define Zone_Count_Lock_5 17
+#define Zone_Count_Lock_6 18
+#define Zone_Count_Lock_N 19
+
+#define Max_Meters 20
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/object.h,v 5.3 1987/01/12 17:17:33 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.20 1987/01/21 20:24:48 jinx Exp $ */
/* This file contains definitions pertaining to the C view of
Scheme pointers: widths of fields, extraction macros, pre-computed
;;;; Machine Dependent Type Tables
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 1.2 1987/01/13 18:56:14 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.20 1987/01/21 20:29:40 jinx Exp $
(declare (usual-integrations))
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/version.h,v 5.10 1987/01/13 18:14:24 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.20 1987/01/21 20:30:25 jinx Exp $
This file contains version information for the microcode. */
\f
/* Scheme system release version */
#ifndef RELEASE
-#define RELEASE "5.0.19"
+#define RELEASE "5.0.20"
#endif
/* Microcode release version */
#define VERSION 9
#endif
#ifndef SUBVERSION
-#define SUBVERSION 19
+#define SUBVERSION 20
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff