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/bchmmg.c,v 9.44 1989/05/31 01:49:41 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.45 1989/06/08 00:23:58 jinx Rel $ */
\f
/* Memory management top level. Garbage collection to disk.
continue;
}
/* Otherwise, it is a pointer. Fall through */
-
+\f
/* Normal pointer types, the broken heart is in the first word.
Note that most special types are treated normally here.
The BH code updates *Scan if the object has been relocated.
continue;
case GC_Undefined:
+ fprintf(stderr,
+ "\nFix_Weak_Chain: Clearing bad object 0x%08lx.\n",
+ Temp);
+ *Scan = SHARP_F;
+ continue;
+
default: /* Non Marked Headers and Broken Hearts */
fail:
fprintf(stderr,
- "\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n",
- OBJECT_TYPE(Temp), OBJECT_DATUM(Temp));
+ "\nFix_Weak_Chain: Bad Object: 0x%08lx.\n",
+ Temp);
Microcode_Termination(TERM_INVALID_TYPE_CODE);
/*NOTREACHED*/
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.43 1989/05/31 01:49:47 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchpur.c,v 9.44 1989/06/08 00:24:47 jinx Rel $
Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
and if so we need a new bufferfull. */
Scan += Get_Integer(Temp);
if (Scan < scan_buffer_top)
+ {
break;
+ }
else
{
unsigned long overflow;
(overflow % GC_DISK_BUFFER_SIZE)) - 1);
break;
}
-
- case_Non_Pointer:
- break;
\f
case_compiled_entry_point:
if (purify_mode == PURE_COPY)
continue;
default:
- sprintf(gc_death_message_buffer,
- "gcloop: bad type code (0x%02x)",
- OBJECT_TYPE(Temp));
- gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
- Scan, To);
- /*NOTREACHED*/
+ GC_BAD_TYPE("purifyloop");
+ /* Fall Through */
+
+ case_Non_Pointer:
+ break;
+
}
}
end_purifyloop:
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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/fasdump.c,v 9.41 1988/10/04 14:48:41 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.42 1989/06/08 00:25:01 jinx Rel $
This file contains code for fasdump and dump-band.
*/
Scan += Get_Integer(Temp);
break;
- case TC_STACK_ENVIRONMENT:
- case_Fasload_Non_Pointer:
- break;
-
/* Compiled code relocation. */
case_compiled_entry_point:
break;
default:
- sprintf(gc_death_message_buffer,
- "dumploop: bad type code (0x%02x)",
- OBJECT_TYPE(Temp));
- gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
- Scan, To);
- /*NOTREACHED*/
+ GC_BAD_TYPE("dumploop");
+ /* Fall Through */
+
+ case TC_STACK_ENVIRONMENT:
+ case_Fasload_Non_Pointer:
+ break;
}
}
result = PRIM_DONE;
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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/gc.h,v 9.26 1988/08/15 20:47:59 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gc.h,v 9.27 1989/06/08 00:23:04 jinx Exp $
*
* Garbage collection related macros of sufficient utility to be
* included in all compilations.
\f
/* GC Types. */
-#define GC_Non_Pointer 0
-#define GC_Cell 1
-#define GC_Pair 2
-#define GC_Triple 3
-#define GC_Hunk3 3
-#define GC_Quadruple 4
-#define GC_Hunk4 4
-#define GC_Undefined -1 /* Undefined types */
-#define GC_Special -2 /* Internal GC types */
-#define GC_Vector -3
-#define GC_Compiled -4
-
-#define GC_Type_Code(TC) \
- ((GC_Type_Map[TC] != GC_Undefined) ? \
- GC_Type_Map[TC] : \
- (fprintf(stderr, "Bad Type code = 0x%02x\n", TC), \
- Invalid_Type_Code(), GC_Undefined))
+#ifdef CMPGCFILE
+#ifndef BAD_TYPES_LETHAL
+#ifndef BAD_TYPES_INNOCUOUS
+#define BAD_TYPES_INNOCUOUS
+#endif /* BAD_TYPES_INNOCUOUS */
+#endif /* BAD_TYPES_LETHAL */
+#endif /* CMPGCFILE */
+
+#ifdef BAD_TYPES_INNOCUOUS
+#ifdef BAD_TYPES_LETHAL
+#error "gc.h: BAD_TYPES both lethal and innocuous"
+#endif /* BAD_TYPES_LETHAL */
+#else /* not BAD_TYPES_INNOCUOUS */
+#ifndef BAD_TYPES_LETHAL
+#define BAD_TYPES_LETHAL
+#endif /* BAD_TYPES_LETHAL */
+#endif /* BAD_TYPES_INNOCUOUS */
+
+#define GC_Non_Pointer 0
+#define GC_Cell 1
+#define GC_Pair 2
+#define GC_Triple 3
+#define GC_Hunk3 3
+#define GC_Quadruple 4
+#define GC_Hunk4 4
+#define GC_Undefined -1 /* Undefined types */
+#define GC_Special -2 /* Internal GC types */
+#define GC_Vector -3
+#define GC_Compiled -4
+\f
+#ifdef BAD_TYPES_INNOCUOUS
+#define INVALID_TYPE_CODE(TC) GC_Undefined
+
+#else /* not BAD_TYPES_INNOCUOUS */
+
+/* Some C compilers complain if the expression below does not yield
+ a value, and Microcode_Termination yields void.
+ */
+
+#define INVALID_TYPE_CODE(TC) \
+ (fprintf(stderr, "\nGC_Type_Code: Bad Type code = 0x%02x\n", TC), \
+ Microcode_Termination(TERM_INVALID_TYPE_CODE), \
+ GC_Undefined)
+
+#endif /* BAD_TYPES_INNOCUOUS */
+
+#define GC_Type_Code(TC) \
+ ((GC_Type_Map[TC] != GC_Undefined) ? \
+ GC_Type_Map[TC] : \
+ (INVALID_TYPE_CODE(TC)))
#define GC_Type(Object) GC_Type_Code(OBJECT_TYPE(Object))
#define GC_Type_Special(Object) (GC_Type(Object) == GC_Special)
#define GC_Type_Vector(Object) (GC_Type(Object) == GC_Vector)
#define GC_Type_Compiled(Object) (GC_Type(Object) == GC_Compiled)
-
-#define Invalid_Type_Code() \
- Microcode_Termination(TERM_INVALID_TYPE_CODE)
\f
/* Overflow detection, various cases */
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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/gccode.h,v 9.39 1988/08/15 20:48:07 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.40 1989/06/08 00:24:34 jinx Rel $
*
* This file contains the macros for use in code which does GC-like
* loops over memory. It is only included in a few files, unlike
*
*/
\f
-extern void gc_death();
-extern char gc_death_message_buffer[];
-
/* A SWITCH on GC types, duplicates information in GC_Type_Map[], but exists
for efficiency reasons. Macros must be used by convention: first
Switch_by_GC_Type, then each of the case_ macros (in any order). The
TC_BIG_FLONUM
*/
\f
+extern void gc_death();
+extern char gc_death_message_buffer[];
+
+/* Assumption: A call to GC_BAD_TYPE is followed by the non-pointer code. */
+
+#ifndef BAD_TYPES_INNOCUOUS
+
+#define GC_BAD_TYPE(name) \
+do \
+{ \
+ sprintf(gc_death_message_buffer, \
+ "%s: bad type code (0x%02x)", \
+ (name), (OBJECT_TYPE(Temp))); \
+ gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer, \
+ Scan, To); \
+ /*NOTREACHED*/ \
+} while (0)
+
+#else /* BAD_TYPES_INNOCUOUS */
+
+#define GC_BAD_TYPE(name) \
+do \
+{ \
+ fprintf(stderr, \
+ "\n%s: bad type code (0x%02x) 0x%lx", \
+ (name), (OBJECT_TYPE(Temp)), Temp); \
+ fprintf(stderr, \
+ " -- Treating as non-pointer.\n"); \
+ /* Fall through */ \
+} while (0)
+
+#endif /* BAD_TYPES_INNOCUOUS */
+\f
/* Macros for the garbage collector and related programs. */
/* Pointer setup for the GC Type handlers. */
/* -*-C-*-
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
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/gcloop.c,v 9.29 1988/08/15 20:48:17 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gcloop.c,v 9.30 1989/06/08 00:22:49 jinx Rel $
*
* This file contains the code for the most primitive part
* of garbage collection.
case TC_MANIFEST_SPECIAL_NM_VECTOR:
Scan += OBJECT_DATUM(Temp);
break;
-
- case_Non_Pointer:
- break;
\f
/* Compiled code relocation. */
Transport_Compiled(),
Compiled_BH(true, continue)));
break;
-\f
+
case_Cell:
Setup_Pointer_for_GC(Transport_Cell());
break;
case_Pair:
Setup_Pointer_for_GC(Transport_Pair());
break;
-
+\f
case TC_VARIABLE:
case_Triple:
Setup_Pointer_for_GC(Transport_Triple());
break;
default:
- sprintf(gc_death_message_buffer,
- "gcloop: bad type code (0x%02x)",
- OBJECT_TYPE(Temp));
- gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
- Scan, To);
- /*NOTREACHED*/
+ GC_BAD_TYPE("gcloop");
+ /* Fall Through */
+
+ case_Non_Pointer:
+ break;
+
} /* Switch_by_GC_Type */
} /* For loop */
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/interp.c,v 9.50 1989/05/31 01:50:31 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.c,v 9.51 1989/06/08 00:23:42 jinx Rel $
*
* This file contains the heart of the Scheme Scode
* interpreter
Eval_Ucode_Hook();
switch (OBJECT_TYPE(Fetch_Expression()))
{
+ default:
+#if false
+ Eval_Error(ERR_UNDEFINED_USER_TYPE);
+#else
+ /* fall through to self evaluating. */
+#endif
+
case TC_BIG_FIXNUM: /* The self evaluating items */
case TC_BIG_FLONUM:
case TC_CHARACTER_STRING:
}
SITE_EXPRESSION_DISPATCH_HOOK()
-
- default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
};
/* Interpret() continues on the next page */
Pop_Return_Error(Which_Way);
}
- default: Microcode_Termination( TERM_COMPILER_DEATH);
+ default:
+ Microcode_Termination( TERM_COMPILER_DEATH);
}
}
case RC_MOVE_TO_ADJACENT_POINT:
/* Expression contains the space in which we are moving */
- { long From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
+ {
+ long From_Count;
Pointer Thunk, New_Location;
+
+ From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
if (From_Count != 0)
{ Pointer Current = Stack_Ref(TRANSLATE_FROM_POINT);
Stack_Ref(TRANSLATE_FROM_DISTANCE) = Make_Unsigned_Fixnum((From_Count - 1));
else Save_Cont();
}
else
- { long To_Count = Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-1;
- fast Pointer To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+ {
+ long To_Count;
+ fast Pointer To_Location;
fast long i;
- for (i=0; i < To_Count; i++)
+
+ To_Count = (Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))- 1);
+ To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+ for (i = 0; i < To_Count; i++)
+ {
To_Location = Fast_Vector_Ref(To_Location, STATE_POINT_NEARER_POINT);
+ }
Thunk = Fast_Vector_Ref(To_Location, STATE_POINT_BEFORE_THUNK);
New_Location = To_Location;
Stack_Ref(TRANSLATE_TO_DISTANCE) = Make_Unsigned_Fixnum(To_Count);
- if (To_Count==0)
+ if (To_Count == 0)
+ {
Stack_Pointer = Simulate_Popping(4);
- else Save_Cont();
+ }
+ else
+ {
+ Save_Cont();
+ }
}
if (Fetch_Expression() != NIL)
+ {
Vector_Set(Fetch_Expression(), STATE_SPACE_NEAREST_POINT, New_Location);
- else Current_State_Point = New_Location;
+ }
+ else
+ {
+ Current_State_Point = New_Location;
+ }
Will_Push(2);
Push(Thunk);
Push(STACK_FRAME_HEADER);
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/memmag.c,v 9.37 1989/05/31 01:50:46 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.38 1989/06/08 00:24:10 jinx Rel $ */
/* Memory management top level.
Heap_Top = Temp;
Free = Heap_Bottom;
SET_MEMTOP(Heap_Top - GC_Reserve);
- Weak_Chain = NIL;
+ Weak_Chain = EMPTY_LIST;
return;
}
\f
the picture in gccode.h for a description of the structure built by
the GC. This code follows the chain of weak cells (in old space) and
either updates the new copy's CAR with the relocated version of the
- object, or replaces it with NIL.
+ object, or replaces it with SHARP_F.
Note that this is the only code in the system, besides the inner garbage
collector, which looks at both old and new space.
fast Pointer *Old_Weak_Cell, *Scan, Old_Car, Temp, *Old, *Low_Constant;
Low_Constant = Constant_Space;
- while (Weak_Chain != NIL)
+ while (Weak_Chain != EMPTY_LIST)
{
Old_Weak_Cell = Get_Pointer(Weak_Chain);
Scan = Get_Pointer(*Old_Weak_Cell++);
Weak_Chain = *Old_Weak_Cell;
Old_Car = *Scan;
- Temp = Make_New_Pointer(Type_Code(Weak_Chain), Old_Car);
+ Temp = Make_New_Pointer(OBJECT_TYPE(Weak_Chain), Old_Car);
Weak_Chain = Make_New_Pointer(TC_NULL, Weak_Chain);
switch(GC_Type(Temp))
continue;
case GC_Special:
- if (Type_Code(Temp) != TC_REFERENCE_TRAP)
+ if (OBJECT_TYPE(Temp) != TC_REFERENCE_TRAP)
{
/* No other special type makes sense here. */
goto fail;
}
- if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
+ if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE)
{
*Scan = Temp;
continue;
}
/* Otherwise, it is a pointer. Fall through */
-
+\f
/* Normal pointer types, the broken heart is in the first word.
Note that most special types are treated normally here.
The BH code updates *Scan if the object has been relocated.
- Otherwise it falls through and we replace it with a full NIL.
+ Otherwise it falls through and we replace it with a full SHARP_F.
Eliminating this assignment would keep old data (pl. of datum).
*/
case GC_Cell:
continue;
}
Normal_BH(false, continue);
- *Scan = NIL;
+ *Scan = SHARP_F;
continue;
case GC_Compiled:
continue;
}
Compiled_BH(false, continue);
- *Scan = NIL;
+ *Scan = SHARP_F;
continue;
case GC_Undefined:
+ fprintf(stderr,
+ "\nFix_Weak_Chain: Clearing bad object 0x%08lx.\n",
+ Temp);
+ *Scan = SHARP_F;
+ continue;
+
default: /* Non Marked Headers and Broken Hearts */
fail:
fprintf(stderr,
- "\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n",
- Type_Code(Temp), Datum(Temp));
+ "\nFix_Weak_Chain: Bad Object: 0x%08lx.\n",
+ Temp);
Microcode_Termination(TERM_INVALID_TYPE_CODE);
+ /*NOTREACHED*/
}
}
return;
Root = Free;
The_Precious_Objects = Get_Fixed_Obj_Slot(Precious_Objects);
- Set_Fixed_Obj_Slot(Precious_Objects, NIL);
- Set_Fixed_Obj_Slot(Lost_Objects_Base, NIL);
+ Set_Fixed_Obj_Slot(Precious_Objects, SHARP_F);
+ Set_Fixed_Obj_Slot(Lost_Objects_Base, SHARP_F);
*Free++ = Fixed_Objects;
*Free++ = Make_Pointer(UNMARKED_HISTORY_TYPE, History);
*Free++ = Undefined_Primitives_Arity;
*Free++ = Get_Current_Stacklet();
*Free++ = ((Prev_Restore_History_Stacklet == NULL) ?
- NIL :
+ SHARP_F :
Make_Pointer(TC_CONTROL_POINT, Prev_Restore_History_Stacklet));
*Free++ = Current_State_Point;
*Free++ = Fluid_Bindings;
/* Set_Current_Stacklet is sometimes a No-Op! */
Set_Current_Stacklet(*Root);
Root += 1;
- if (*Root == NIL)
+ if (*Root == SHARP_F)
{
Prev_Restore_History_Stacklet = NULL;
Root += 1;
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/purify.c,v 9.38 1989/05/31 01:50:57 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purify.c,v 9.39 1989/06/08 00:25:19 jinx Rel $
*
* This file contains the code that copies objects into pure
* and constant space.
case TC_MANIFEST_SPECIAL_NM_VECTOR:
Scan += Get_Integer(Temp);
break;
-
- case_Non_Pointer:
- break;
\f
/* Compiled code relocation. */
Compiled_BH(false, continue)));
}
break;
-\f
+
case_Cell:
Setup_Pointer_for_Purify(Transport_Cell());
break;
+ case TC_WEAK_CONS:
+ Setup_Pointer_for_Purify(Transport_Weak_Cons());
+ break;
+\f
/*
Symbols, variables, and reference traps cannot be put into
pure space. The strings contained in the first two can, on the
Setup_Pointer_for_Purify(Transport_Pair());
break;
- case TC_WEAK_CONS:
- Setup_Pointer_for_Purify(Transport_Weak_Cons());
- break;
-
case TC_VARIABLE:
case_Triple:
Setup_Pointer_for_Purify(Transport_Triple());
break;
-/* PurifyLoop continues on the next page */
-\f
-/* PurifyLoop, continued */
-
case_Quadruple:
Setup_Pointer_for_Purify(Transport_Quadruple());
break;
+ case TC_BIG_FLONUM:
+ Setup_Pointer_for_Purify({
+ Transport_Flonum();
+ break;
+ });
+\f
/* No need to handle futures specially here, since PurifyLoop
is always invoked after running GCLoop, which will have
spliced all spliceable futures unless the GC itself of the
Setup_Pointer_for_Purify(Transport_Vector());
break;
- case TC_BIG_FLONUM:
- Setup_Pointer_for_Purify({
- Transport_Flonum();
- break;
- });
-
default:
- sprintf(gc_death_message_buffer,
- "purifyloop: bad type code (0x%02x)",
- OBJECT_TYPE(Temp));
- gc_death(TERM_INVALID_TYPE_CODE, gc_death_message_buffer,
- Scan, To);
- /*NOTREACHED*/
+ GC_BAD_TYPE("purifyloop");
+ /* Fall Through */
+
+ case_Non_Pointer:
+ break;
+
} /* Switch_by_GC_Type */
} /* For loop */
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/purutl.c,v 9.35 1989/03/27 23:15:52 jinx Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/purutl.c,v 9.36 1989/06/08 00:25:32 jinx Rel $ */
/* Pure/Constant space utilities. */
return;
}
\f
-Pointer
-Make_Impure(Object)
- Pointer Object;
+long
+Make_Impure(Object, New_Object)
+ Pointer Object, *New_Object;
{
Pointer *New_Address, *End_Of_Area;
fast Pointer *Obj_Address, *Constant_Address;
case TC_MANIFEST_NM_VECTOR:
case TC_MANIFEST_SPECIAL_NM_VECTOR:
case_Non_Pointer:
+#if false
fprintf(stderr, "\nImpurify Non-Pointer (0x%lx)\n", Object);
Microcode_Termination(TERM_NON_POINTER_RELOCATION);
+#endif
+ return (ERR_ARG_1_WRONG_TYPE);
case TC_BIG_FLONUM:
case TC_FUTURE:
default:
fprintf(stderr, "\nImpurify: Bad type code = 0x%02x.\n",
OBJECT_TYPE(Object));
- Invalid_Type_Code();
+#ifdef BAD_TYPES_LETHAL
+ Microcode_Termination(TERM_INVALID_TYPE_CODE);
+ /*NOTREACHED*/
+#else /* not BAD_TYPES_LETHAL */
+ return (ERR_ARG_1_WRONG_TYPE);
+#endif /* BAD_TYPES_LETHAL */
}
/* Add a copy of the object to the last constant block in memory.
Obj_Address = Get_Pointer(Object);
if (!Test_Pure_Space_Top(Constant_Address + Length))
{
- return (NIL);
+ return (ERR_IMPURIFY_OUT_OF_SPACE);
}
Block_Length = Get_Integer(*(Constant_Address-1));
Constant_Address -= 2;
EXIT_CRITICAL_SECTION ({});
- return (Make_Pointer(OBJECT_TYPE(Object), New_Address));
+ *New_Object = (Make_Pointer(OBJECT_TYPE(Object), New_Address));
+ return (PRIM_DONE);
}
\f
/* (PRIMITIVE-IMPURIFY OBJECT)
*/
DEFINE_PRIMITIVE ("PRIMITIVE-IMPURIFY", Prim_impurify, 1, 1, 0)
{
- Pointer Result;
+ long result;
+ Pointer New_Object;
Primitive_1_Arg();
Touch_In_Primitive(Arg1, Arg1);
- Result = Make_Impure(Arg1);
- if (Result != NIL)
+ result = Make_Impure(Arg1, &New_Object);
+ if (result == PRIM_DONE)
{
- return (Result);
+ PRIMITIVE_RETURN(New_Object);
}
- Primitive_Error(ERR_IMPURIFY_OUT_OF_SPACE);
+ else
+ Primitive_Error(result);
/*NOTREACHED*/
}
\f
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.81 1989/06/07 01:10:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.82 1989/06/08 00:26:10 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 81
+#define SUBVERSION 82
#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/interp.c,v 9.50 1989/05/31 01:50:31 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/interp.c,v 9.51 1989/06/08 00:23:42 jinx Rel $
*
* This file contains the heart of the Scheme Scode
* interpreter
Eval_Ucode_Hook();
switch (OBJECT_TYPE(Fetch_Expression()))
{
+ default:
+#if false
+ Eval_Error(ERR_UNDEFINED_USER_TYPE);
+#else
+ /* fall through to self evaluating. */
+#endif
+
case TC_BIG_FIXNUM: /* The self evaluating items */
case TC_BIG_FLONUM:
case TC_CHARACTER_STRING:
}
SITE_EXPRESSION_DISPATCH_HOOK()
-
- default: Eval_Error(ERR_UNDEFINED_USER_TYPE);
};
/* Interpret() continues on the next page */
Pop_Return_Error(Which_Way);
}
- default: Microcode_Termination( TERM_COMPILER_DEATH);
+ default:
+ Microcode_Termination( TERM_COMPILER_DEATH);
}
}
case RC_MOVE_TO_ADJACENT_POINT:
/* Expression contains the space in which we are moving */
- { long From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
+ {
+ long From_Count;
Pointer Thunk, New_Location;
+
+ From_Count = Get_Integer(Stack_Ref(TRANSLATE_FROM_DISTANCE));
if (From_Count != 0)
{ Pointer Current = Stack_Ref(TRANSLATE_FROM_POINT);
Stack_Ref(TRANSLATE_FROM_DISTANCE) = Make_Unsigned_Fixnum((From_Count - 1));
else Save_Cont();
}
else
- { long To_Count = Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))-1;
- fast Pointer To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+ {
+ long To_Count;
+ fast Pointer To_Location;
fast long i;
- for (i=0; i < To_Count; i++)
+
+ To_Count = (Get_Integer(Stack_Ref(TRANSLATE_TO_DISTANCE))- 1);
+ To_Location = Stack_Ref(TRANSLATE_TO_POINT);
+ for (i = 0; i < To_Count; i++)
+ {
To_Location = Fast_Vector_Ref(To_Location, STATE_POINT_NEARER_POINT);
+ }
Thunk = Fast_Vector_Ref(To_Location, STATE_POINT_BEFORE_THUNK);
New_Location = To_Location;
Stack_Ref(TRANSLATE_TO_DISTANCE) = Make_Unsigned_Fixnum(To_Count);
- if (To_Count==0)
+ if (To_Count == 0)
+ {
Stack_Pointer = Simulate_Popping(4);
- else Save_Cont();
+ }
+ else
+ {
+ Save_Cont();
+ }
}
if (Fetch_Expression() != NIL)
+ {
Vector_Set(Fetch_Expression(), STATE_SPACE_NEAREST_POINT, New_Location);
- else Current_State_Point = New_Location;
+ }
+ else
+ {
+ Current_State_Point = New_Location;
+ }
Will_Push(2);
Push(Thunk);
Push(STACK_FRAME_HEADER);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.81 1989/06/07 01:10:13 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.82 1989/06/08 00:26:10 jinx Exp $
Copyright (c) 1988, 1989 Massachusetts Institute of Technology
#define VERSION 10
#endif
#ifndef SUBVERSION
-#define SUBVERSION 81
+#define SUBVERSION 82
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff