From 220b78a7bbd5cde206bc7261b02502275cf46670 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 3 Feb 1987 16:10:17 +0000 Subject: [PATCH] Some primitives have changed homes. --- v7/src/microcode/memmag.c | 350 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 350 insertions(+) create mode 100644 v7/src/microcode/memmag.c diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c new file mode 100644 index 000000000..230e89a37 --- /dev/null +++ b/v7/src/microcode/memmag.c @@ -0,0 +1,350 @@ +/* -*-C-*- + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +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.23 1987/02/03 16:10:17 jinx Exp $ */ + +/* Memory management top level. + + The memory management code is spread over 3 files: + - memmag.c: initialization. + - gcloop.c: main garbage collector loop. + - purify.c: constant/pure space hacking. + There is also a relevant header file, gccode.h. + + The object dumper, fasdump, shares properties and code with the + memory management utilities. + */ + +#include "scheme.h" +#include "primitive.h" +#include "gccode.h" + +extern void Clear_Memory(), Setup_Memory(); + +/* Memory Allocation, sequential processor: + + ------------------------------------------ + | Control Stack || | + | \/ | + ------------------------------------------ + | Constant + Pure Space /\ | + | || | + ------------------------------------------ + | | + | Heap Space | + ------------------------------------------ + + Each area has a pointer to its starting address and a pointer to the + next free cell. In addition, there is a pointer to the top of the + useable area of the heap (the heap is subdivided into two areas for + the purposes of GC, and this pointer indicates the top of the half + currently in use). + +*/ + +/* Initialize free pointers within areas. Stack_Pointer is + special: it always points to a cell which is in use. */ + +void +Clear_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size) +int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size; +{ Heap_Top = Heap_Bottom + Our_Heap_Size; + Local_Heap_Base = Heap_Bottom; + Unused_Heap_Top = Heap_Bottom + 2*Our_Heap_Size; + Set_Mem_Top(Heap_Top - GC_Reserve); + Free = Heap_Bottom; + Free_Constant = Constant_Space; + Set_Pure_Top(); + Initialize_Stack(); + return; +} + +/* This procedure allocates and divides the total memory. */ + +void +Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size) +int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size; +{ +/* First, assign values for the start of the areas */ + + if (Our_Heap_Size == 0) + { printf("Configuration won't hold initial data.\n"); + exit(1); + } + Highest_Allocated_Address = + Allocate_Heap_Space(Stack_Allocation_Size(Our_Stack_Size) + + 2*Our_Heap_Size + Our_Constant_Size); + if (Heap == NULL) + { fprintf(stderr, "Not enough memory for this configuration.\n"); + exit(1); + } + Align_Float(Heap); + Unused_Heap = Heap+Our_Heap_Size; + Align_Float(Unused_Heap); + Constant_Space = Heap + 2*Our_Heap_Size; + Align_Float(Constant_Space); + /* The extra word is needed by the garbage collector */ + if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0) + { fprintf(stderr, + "Largest address does not fit in datum field of Pointer.\n"); + fprintf(stderr, + "Allocate less space or re-compile without Heap_In_Low_Memory.\n"); + exit(1); + } + + Heap_Bottom = Heap; + Clear_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size); + return; +} + +/* Utilities for the garbage collector top level. + The main garbage collector loop is in gcloop.c +*/ + +/* Flip into unused heap */ + +void GCFlip() +{ Pointer *Temp; + Temp = Unused_Heap; + Unused_Heap = Heap_Bottom; + Heap_Bottom = Temp; + Temp = Unused_Heap_Top; + Unused_Heap_Top = Heap_Top; + Heap_Top = Temp; + Free = Heap_Bottom; + Set_Mem_Top(Heap_Top - GC_Reserve); + Weak_Chain = NIL; + return; +} + +/* Here is the code which "prunes" objects from weak cons cells. See + 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. + + This code could be implemented as a GC daemon, just like + REHASH-GC-DAEMON, but there is no "good" way of getting Weak_Chain + to it. Note that Weak_Chain points to Old Space unless no weak + conses were found. + + This code should be reimplemented so it does not need to look at both + old and new space at the same time. Only the "real" garbage collector + should be allowed to do that. +*/ + +void Fix_Weak_Chain() +{ fast Pointer *Old_Weak_Cell, *Scan, Old_Car, Temp, *Old, *Low_Constant; + Low_Constant = Constant_Space; + while (Weak_Chain != NIL) + { 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); + Weak_Chain = Make_New_Pointer(TC_NULL, Weak_Chain); + + switch(GC_Type(Temp)) + { case GC_Non_Pointer: + *Scan = Temp; + continue; + + /* 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. + Eliminating this assignment would keep old data (pl. of datum). + */ + + case GC_Cell: + case GC_Pair: + case GC_Triple: + case GC_Quadruple: + case GC_Vector: + Old = Get_Pointer(Old_Car); + if (Old >= Low_Constant) + { *Scan = Temp; + continue; + } + Normal_BH(false, continue); + *Scan = NIL; + continue; + + case GC_Compiled: + Old = Get_Pointer(Old_Car); + if (Old >= Low_Constant) + { *Scan = Temp; + continue; + } + Compiled_BH(false, continue); + *Scan = NIL; + continue; + + case GC_Special: + case GC_Undefined: + default: /* Non Marked Headers and Broken Hearts */ + fprintf(stderr, + "\nFix_Weak_Chain: Bad Object: Type = 0x%02x; Datum = %x\n", + Type_Code(Temp), Datum(Temp)); + Microcode_Termination(TERM_INVALID_TYPE_CODE); + } + } + return; +} + +/* Here is the set up for the full garbage collection: + + - First it makes the constant space and stack into one large area + by "hiding" the gap between them with a non-marked header. + + - Then it saves away all the relevant microcode registers into new + space, making this the root for garbage collection. + + - Then it does the actual garbage collection in 4 steps: + 1) Trace constant space. + 2) Trace objects pointed out by the root and constant space. + 3) Trace the precious objects, remembering where consing started. + 4) Update all weak pointers. + + - Finally it restores the microcode registers from the copies in + new space. +*/ + +void GC() +{ Pointer *Root, *Result, *Check_Value, + The_Precious_Objects, *Root2; + + /* Save the microcode registers so that they can be relocated */ + Terminate_Old_Stacklet(); + Terminate_Constant_Space(Check_Value); + + 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); + + *Free++ = Fixed_Objects; + *Free++ = Make_Pointer(TC_HUNK3, History); + *Free++ = Undefined_Externals; + *Free++ = Get_Current_Stacklet(); + *Free++ = ((Previous_Restore_History_Stacklet == NULL) ? + NIL : + Make_Pointer(TC_CONTROL_POINT, Previous_Restore_History_Stacklet)); + *Free++ = Current_State_Point; + *Free++ = Fluid_Bindings; + + /* The 4 step GC */ + Result = GCLoop(Constant_Space, &Free); + if (Result != Check_Value) + { fprintf(stderr, "\nGC: Constant Scan ended too early.\n"); + Microcode_Termination(TERM_BROKEN_HEART); + } + Result = GCLoop(Root, &Free); + if (Free != Result) + { fprintf(stderr, "\nGC-1: Heap Scan ended too early.\n"); + Microcode_Termination(TERM_BROKEN_HEART); + } + Root2 = Free; + *Free++ = The_Precious_Objects; + Result = GCLoop(Root2, &Free); + if (Free != Result) + { fprintf(stderr, "\nGC-2: Heap Scan ended too early.\n"); + Microcode_Termination(TERM_BROKEN_HEART); + } + Fix_Weak_Chain(); + + /* Make the microcode registers point to the copies in new-space. */ + Fixed_Objects = *Root++; + Set_Fixed_Obj_Slot(Precious_Objects, *Root2); + Set_Fixed_Obj_Slot(Lost_Objects_Base, Make_Pointer(TC_ADDRESS, Root2)); + + History = Get_Pointer(*Root++); + Undefined_Externals = *Root++; + Set_Current_Stacklet(*Root); + Root += 1; /* Set_Current_Stacklet is sometimes a No-Op! */ + if (*Root == NIL) + { Previous_Restore_History_Stacklet = NULL; + Root += 1; + } + else Previous_Restore_History_Stacklet = Get_Pointer(*Root++); + Current_State_Point = *Root++; + Fluid_Bindings = *Root++; + Free_Stacklets = NULL; + return; +} + +/* (GARBAGE_COLLECT SLACK) + [Primitive number 0x3A] + Requests a garbage collection leaving the specified amount of slack + for the top of heap check on the next GC. The primitive ends by invoking + the GC daemon if there is one. +*/ + +Built_In_Primitive(Prim_Garbage_Collect, 1, "GARBAGE-COLLECT") +{ Pointer GC_Daemon_Proc; + Primitive_1_Arg(); + + Arg_1_Type(TC_FIXNUM); + if (Free > Heap_Top) + { fprintf(stderr, "\nGC has been delayed too long, and you are truly out of room!\n"); + fprintf(stderr, "Free=0x%x, MemTop=0x%x, Heap_Top=0x%x\n", Free, MemTop, Heap_Top); + Microcode_Termination(TERM_EXIT); + } + GC_Reserve = Get_Integer(Arg1); + GCFlip(); + Weak_Chain = NULL; + GC(); + IntCode &= ~INT_GC; + if (GC_Check(GC_Space_Needed)) + { fprintf(stderr, + "\nGC just ended. The free pointer is at 0x%x, the top of this heap\n", + Free); + fprintf(stderr, + "is at 0x%x, and we are trying to cons 0x%x objects. Dead!\n", + MemTop, GC_Space_Needed); + Microcode_Termination(TERM_EXIT); + } + GC_Daemon_Proc = Get_Fixed_Obj_Slot(GC_Daemon); + if (GC_Daemon_Proc == NIL) + return FIXNUM_0 + (MemTop - Free); + Pop_Primitive_Frame(1); + Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS+1)); + Store_Return(RC_NORMAL_GC_DONE); + Store_Expression(FIXNUM_0 + (MemTop - Free)); + Save_Cont(); + Push(GC_Daemon_Proc); + Push(STACK_FRAME_HEADER); + Pushed(); + longjmp(*Back_To_Eval, PRIM_APPLY); + /* The following comment is by courtesy of LINT, your friendly sponsor. */ + /*NOTREACHED*/ +} -- 2.25.1