⟦f10610415⟧

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1984                    *
*               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.          *
*                                                               *
****************************************************************/

/* File: GCLOOP.C
 *
 * This file contains the code for the most primitive part
 * of garbage collection.
 */
\f


#include "scheme.h"
#include "primitive.h"
#include "gccode.h"

#define Setup_Pointer_for_GC(Extra_Code)			\
Old = Get_Pointer(Temp);					\
Setup_Pointer(true, Extra_Code)

Pointer *GCLoop(Scan, To_Pointer)
fast Pointer *Scan;
Pointer **To_Pointer;
{ fast Pointer *To, *Old, Temp, *Low_Constant, New_Address;

  To = *To_Pointer;
  Low_Constant = Constant_Space;
  if (GC_Debug)
  { printf("Starting scan at %x\n", Scan);
    if (Low_Watch == ((Pointer *) NULL))
    { printf("Enter low watch range and high watch range: ");
      scanf("%x %x", &Low_Watch, &High_Watch);
    }
  }

  for ( ; Scan != To; Scan++)
  { Temp = *Scan;

    if (GC_Debug)
    { In_Range = (((Scan >= Low_Watch) && (Scan <= High_Watch)) ||
		  ((Free >= Low_Watch) && (Free <= High_Watch)));
      if (In_Range)
	printf( "0x%x: %x|%x ... ",
	       Scan, Type_Code(Temp), Get_Integer(Temp));
    }

/* GCLoop continues on the next page */
\f


/* GCLoop, continued */

    Switch_by_GC_Type(Temp)
    { case TC_BROKEN_HEART:
        if (Scan == (Get_Pointer(Temp)))
	{ *To_Pointer = To;
	  return Scan;
	}
        printf("GC: Broken heart in scan.\n");
	Microcode_Termination(TERM_BROKEN_HEART);

      case TC_MANIFEST_NM_VECTOR:
      case TC_MANIFEST_SPECIAL_NM_VECTOR:
	Scan += Get_Integer(Temp);
	if (GC_Debug && In_Range)
	  printf( "skipping %d cells.", Get_Integer(Temp));
	break;

      case_Non_Pointer:
	if (GC_Debug && In_Range) printf("not a pointer.");
	break;

      case_Cell:
	Setup_Pointer_for_GC(Transport_Cell());

      case_Pair:
	Setup_Pointer_for_GC(Transport_Pair());

      case_Triple:
	Setup_Pointer_for_GC(Transport_Triple());

#ifdef QUADRUPLE
      case_Quadruple:
	Setup_Pointer_for_GC(Transport_Quadruple());
#endif

      case_Vector:
	Setup_Pointer_for_GC(Transport_Vector());

      case TC_FUTURE:
	Setup_Pointer_for_GC(Transport_Future());

      default:
	fprintf(stderr,
		"GCLoop: Bad type code = 0x%02x\n",
		Type_Code(Temp));
	Invalid_Type_Code();

      }	/* Switch_by_GC_Type */
    if (GC_Debug && In_Range) printf("\n");
  } /* For loop */
  *To_Pointer = To;
  return To;
} /* GCLoop */
\f


/* 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);
}
\f


/* 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 runs the GCLoop
   over this area copying any non-constant objects into the new heap.
   Then it puts a pointer to the fixed objects vector and history
   register onto the new heap and continues the GCLoop copying
   everything in the new heap.
*/

void GC()
{ Pointer *F_Obj, *Start_Point, *Result;

  *Free_Constant =
    Make_Non_Pointer(TC_MANIFEST_NM_VECTOR,
                 (Stack_Pointer-Free_Constant)-1);
	/* Make the gap between the constant area and the stack
	   become 'invisible' to the GC loop
        */
  *Stack_Top = Make_Pointer(TC_BROKEN_HEART, Stack_Top);
  Start_Point = Free;
  Result = GCLoop(Constant_Space, &Free);
  if (Result != Stack_Top)
  { fprintf(stderr, "\nGC: Constant Scan ended too early.\n");
    Microcode_Termination(TERM_BROKEN_HEART);
  }
  F_Obj = Free;
  *Free++ = Fixed_Objects;
  *Free++ = Make_Pointer(TC_HUNK3, History);
  *Free++ = Undefined_Externals;
  Result = GCLoop(Start_Point, &Free);
  if (Free != Result)
  { fprintf(stderr, "\nGC: Heap Scan ended too early.\n");
    Microcode_Termination(TERM_BROKEN_HEART);
  }
  Fixed_Objects = *F_Obj++;
  History = Get_Pointer(*F_Obj++);
  Undefined_Externals = *F_Obj++;
}
\f


/* (GET_NEXT_CONSTANT)
      [Primitive number 0xE4]
      Returns the next free address in constant space.
*/
Built_In_Primitive(Prim_Get_Next_Constant, 0, "GET-NEXT-CONSTANT")
{ Pointer *Next_Address = &Free_Constant[4];
  Primitive_0_Args();
  return Make_Pointer(TC_ADDRESS, (Pointer) Next_Address);
}

/* (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 process if there is one. Otherwise it returns the number
      of objects in the new heap.
*/
Built_In_Primitive(Prim_Garbage_Collect, 1, "GARBAGE-COLLECT")
{ Pointer GC_Daemon_Proc;
  Primitive_1_Arg();

  Arg_1_Type(TC_FIXNUM);
  GC_Reserve = Get_Integer(Arg1);
  GCFlip();
  GC();
  IntCode &= ~INT_GC;
  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);
}
\f


/* (GC_TYPE OBJECT)
      [Primitive number 0xBC]
      Returns a fixnum indicating the GC type of the object.  The object
      is NOT touched first.
*/

#define GC_TYPE_NON_POINTER		0
#define GC_TYPE_SPECIAL_NM_VECTOR	1
#define GC_TYPE_PAIR			2
#define GC_TYPE_TRIPLE			3
#define GC_TYPE_QUADRUPLE		4 	/* no longer used */
#define GC_TYPE_CELL			5
#define GC_TYPE_VECTOR			-1
#define GC_TYPE_NM_VECTOR		-2

Built_In_Primitive(Prim_Gc_Type, 1, "GC-TYPE")
{ Primitive_1_Arg(); 
  Switch_by_GC_Type(Arg1)
  { case TC_BROKEN_HEART:
    case TC_MANIFEST_NM_VECTOR:
    case TC_MANIFEST_SPECIAL_NM_VECTOR:
    case_Non_Pointer:
      return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_NON_POINTER);
    case_Pair:
      return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_PAIR);
    case_Quadruple:
      return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_QUADRUPLE);
    case_Triple:
      return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_TRIPLE);


    /*** This is wrong!  It should touch. ***/
    case TC_FUTURE:
    case_Vector:
      if (Safe_Type_Code(Vector_Ref(Arg1, 0)) ==
	  TC_MANIFEST_NM_VECTOR)
	return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_NM_VECTOR);
	else return Make_Non_Pointer(TC_FIXNUM, GC_TYPE_VECTOR);
    default:
      fprintf(stderr,
	      "Prim_GC_Type: Bad type code = 0x%02x\n",
	      Type_Code(Arg1));
      Invalid_Type_Code();
  }
}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦f10610415⟧ TextFile

Derivation

TextFile
