/*************************************************************************
*  PDSS (PIMOS Development Support System)  Version 2.52		 *
*  (C) Copyright 1988,1989,1990,1992.					 *
*  Institute for New Generation Computer Technology (ICOT), Japan.	 *
*  Read "../COPYRIGHT" for detailed information.			 *
*************************************************************************/

#include "pdss.h"
#include "memory.h"
#include "io.h"
#include "gc.h"


/*************************************************************************
*   GC CELL - KL1 Data.							 *
*************************************************************************/

gc_cell(old, new)
    register CELL *old, *new;
{
    register CELL *work, *next;
    CELL wcell;
    int	 leng, len2;

    for(;;){
	switch(Typeof(old)){
	  case ATOM:
	    SetAll(new, ATOM, Valueof(old), MRBOFF);
	    return;
	  case INT:
	    SetAll(new, INT, Valueof(old), MRBOFF);
	    return;
	  case FLOAT:
	    SetAll(new, FLOAT, Valueof(old), MRBOFF);
	    return;
	  case REF:
	    work = Objectof(old);
	    switch(Typeof(work)){
	      case UNDEF:
		/** REF->UNDEF No.1 **/
		/** OLD-UNDEF := Pointer to NEW-REF, MRB=OFF **/
		SetOldNewPointer1(work, new);
		GcAlloc1Word(next);
		SetAll(new, REF, next, MRBOFF);
		SetAll(next, UNDEF, NULL, MRBOFF);
		return;
	      case HOOK:
	      case MHOOK:
		/** REF->HOOK/MHOOK No.1 **/
		/** OLD-HOOK/MHOOK := Pointer to NEW-REF, MRB=OFF **/
		wcell = *work;
		SetOldNewPointer1(work, new);
		GcAlloc1Word(next);
		SetAll(new, REF, next, MRBOFF);
		gc_suspension_queue(&wcell, next);
		return;
	      case MGHOK:
		/** REF->MGHOK No.1 **/
		/** OLD-MGHOK := Pointer to NEW-REF, MRB=OFF **/
		wcell = *work;
		SetOldNewPointer1(work, new);
		GcAlloc1Word(next);
		SetAll(new, REF, next, MRBOFF);
		gc_stream_merger(&wcell, next);
		return;
	      case COPIED:
		next = Objectof(work); /* REF No.1 in new heap */
		switch(Typeof(Objectof(next))){
		  case UNDEF:
		  case MHOOK:
		    if(Mrbof(work) == MRBOFF){
			/** REF->UNDEF/MHOOK No.2 **/
			/** OLD-UNDEF := Pointer to NEW-REF, MRB=ON **/
			MarkOldNewPointer(work);
			next = Objectof(next);
			SetAll(new, REF, next, MRBOFF);
			SetMrbof(next, MRBON);
			return;
		    }else{
			/** REF->UNDEF No.3 **/
			SetMrbof(next, MRBON); /** Mark REF No.1 **/
			next = Objectof(next);
			SetAll(new, REF, next, MRBON);
			return;
		    }
		  case HOOK:
		    if(Mrbof(work) == MRBOFF){
			/** REF->HOOK No.2 **/
			/** OLD-HOOK := Pointer to NEW-REF, MRB=ON **/
			MarkOldNewPointer(work);
			next = Objectof(next);
			SetAll(new, REF, next, MRBOFF);
			return;
		    }else{
			/** REF->HOOK No.3 **/
			SetMrbof(next, MRBON); /** Mark REF No.1 **/
			next = Objectof(next);
			SetAll(new, REF, next, MRBON);
			SetMrbof(next, MRBON);
			return;
		    }
		  case MGHOK:
		    if(Mrbof(work) == MRBOFF){
			/** REF->MGHOK No.2 **/
			/** OLD-MGHOK := Pointer to NEW-REF, MRB=ON **/
			MarkOldNewPointer(work);
			SetMrbof(next, MRBON);  /** Mark REF No.1 **/
			next = Objectof(next);
			SetAll(new, REF, next, MRBON);
			SetMrbof(next, MRBON);
			return;
		    }else{
			/** REF->MGOOK No.3 **/
			next = Objectof(next);
			SetAll(new, REF, next, MRBON);
			return;
		    }
		}
	      DEFAULT:
		old = work;  /** Dereference **/
		continue;    /** TRO: gc_cell(old, new) **/
	    }
	  case LIST:
	    work = Objectof(old);
	    if(IsConstInCode(work)){
		if(IsConstInNativeCode(work)){
		    /** Structure Constant in Native Code **/
		    SetAll(new, LIST, work, MRBON);
		}else{
		    /** Structure Constant in Code Area **/
		    SetAll(new, LIST, GcConstInCode(work), MRBON);
		}
		return;
	    }
	    if(IsNotCopied(work)){
		/** LIST No.1 **/
		/** OLD-CAR := Pointer to NEW-REF, MRB=OFF **/
		wcell = work[0];  /** CAR **/
		SetOldNewPointer1(work, new);
		GcAlloc2Words(next);
		SetAll(new, LIST, next, MRBOFF);
		gc_cell(&wcell, &next[0]);  /** GC CAR **/
		old = &work[1];		    /** GC CDR **/
		new = &next[1];		    /** TRO: gc_cell(old, new) **/
		continue;
	    }
	    if(Mrbof(work) == MRBOFF){
		/** LIST No.2 **/
		/** OLD-CAR := Pointer to NEW-CONS, MRB=ON **/
		next = Objectof(work);
		SetMrbof(next, MRBON);	/** Mark LIST No.1 **/
		next = Objectof(next);
		SetOldNewPointer2(work,next);
		SetAll(new, LIST, next, MRBON);
		return;
	    }else{
		/** LIST No.3 **/
		next = Objectof(work);
		SetAll(new, LIST, next, MRBON);
		return;
	    }
	  case VECTOR:
	    work = Objectof(old);
	    if(IsConstInCode(work)){
		if(IsConstInNativeCode(work)){
		    /** Structure Constant in Native Code **/
		    SetAll(new, VECTOR, work, MRBON);
		}else{
		    /** Structure Constant in Code Area **/
		    SetAll(new, VECTOR, GcConstInCode(work), MRBON);
		}
		return;
	    }
	    if(IsNotCopied(work)){
		/** VECTOR No.1 **/
		/** OLD-DESC := Pointer to NEW-REF, MRB=OFF **/
		leng = Valueof(work)&0xFFFFFF;
		SetOldNewPointer1(work, new);
		GcAllocNWords(next, leng+1);
		SetAll(new, VECTOR, next, MRBOFF);
		SetAll(next, DESC, leng, MRBOFF);
		while(leng--){
		    work++; next++;
		    gc_cell(work, next);
		}
		return;
	    }
	    if(Mrbof(work) == MRBOFF){
		/** VECTOR No.2 **/
		/** OLD-DESC := Pointer to NEW-VECTOR-BODY, MRB=ON **/
		next = Objectof(work);
		SetMrbof(next, MRBON);	/** Mark VECTOR No.1 **/
		next = Objectof(next);
		SetOldNewPointer2(work, next);
		SetAll(new, VECTOR, next, MRBON);
		return;
	    }else{
		/** VECTOR No.3 **/
		next = Objectof(work);
		SetAll(new, VECTOR, next, MRBON);
		return;
	    }
	  case STRING:
	    work = Objectof(old);
	    if(IsConstInCode(work)){
		if(IsConstInNativeCode(work)){
		    /** Structure Constant in Native Code **/
		    SetAll(new, STRING, work, MRBON);
		}else{
		    /** Structure Constant in Code Area **/
		    SetAll(new, STRING, GcConstInCode(work), MRBON);
		}
		return;
	    }
	    if(IsNotCopied(work)){
		/** STRING No.1 **/
		/** OLD-DESC := Pointer to NEW-REF, MRB=OFF **/
		leng = Valueof(work);
		SetOldNewPointer1(work, new);
		GcAllocNWords(next, (leng&0xFFFFFF)+1);
		SetAll(new, STRING, next, MRBOFF);
		SetAll(next, DESC, leng, MRBOFF);
		leng &= 0xFFFFFF;
		while(leng--){
		    next++; work++;
		    *next = *work;
		}
		return;
	    }
	    if(Mrbof(work) == MRBOFF){
		/** STRING No.2 **/
		/** OLD-DESC := Pointer to NEW-STRING-BODY, MRB=ON **/
		next = Objectof(work);
		SetMrbof(next, MRBON);	/** Mark STRING No.1 **/
		next = Objectof(next);
		SetOldNewPointer2(work, next);
		SetAll(new, STRING, next, MRBON);
		return;
	    }else{
		/** STRING No.3 **/
		next = Objectof(work);
		SetAll(new, STRING, next, MRBON);
		return;
	    }
	  case NUE:
	    work = Objectof(old);
	    if(IsNotCopied(work)){
		/** NUE No.1 **/
		leng = Valueof(work)&0xFFFFFF;
		len2 = (Valueof(work)>>24)&0xFF;
		SetOldNewPointer1(work, new);
		GcAllocNWords(next, leng+1);
		SetAll(new, NUE, next, MRBOFF);
		SetAll(next, DESC, (len2<<24)|leng, MRBOFF);
		leng -= len2;
		while(len2--){
		    work++; next++;
		    gc_cell(work, next);
		}
		while(leng--){
		    next++; work++;
		    *next = *work;
		}
		return;
	    }
	    if(Mrbof(work) == MRBOFF){
		/** NUE No.2 **/
		next = Objectof(work);
		SetMrbof(next, MRBON);	/** Mark NUE No.1 **/
		next = Objectof(next);
		SetOldNewPointer2(work, next);
		SetAll(new, NUE, next, MRBON);
		return;
	    }else{
		/** NUE No.3 **/
		next = Objectof(work);
		SetAll(new, NUE, next, MRBON);
		return;
	    }
	  case SHOEN:
	    if(IsNotPrecCopied(Shoenof(old))){
		/** 1st access to SHOEN **/
		PARENT_RECORD *parent;
		GcGetParentRecord(parent);
		SetAll(new, SHOEN, parent, MRBOFF);
		gc_parent_record(Shoenof(old), Shoenof(new));
		return;
	    }else{
		/** SHOEN is Already Copied **/
		SetAll(new, SHOEN, GetCopiedPrec(Shoenof(old)), MRBOFF);
		return;
	    }
	  DEFAULT:
	    Error2F("Unknown Data Type (%02x  AD:%08x)\n", Typeof(old), old);
	    new = old;
	    return;
	}
    }
}


/*************************************************************************
*   GC Stream Merger.							 *
*************************************************************************/

static gc_stream_merger(old, new)
    CELL *old, *new;
{
    register MERGER_RECORD *oldmg, *newmg;
    CELL wcell;
    oldmg = Mergerof(old);
    if(IsParentAborted(oldmg->parent)){
	GcAlloc1Word(new);
	SetAll(new, UNDEF, NULL, MRBOFF);
    }else{
	if(IsNotCopied(&(oldmg->output))){
	    wcell = oldmg->output;
	    AllocMerger(newmg);
	    SetOldNewPointer1(&(oldmg->output), newmg);
	    SetAll(new, MGHOK, newmg, MRBON);
	    newmg->count    = oldmg->count;
	    newmg->priority = logical_priority;
	    if(IsNotPrecCopied(oldmg->parent)){
		/** 1st Access to Parent Record => Copy Record **/
		GcGetParentRecord(newmg->parent);
		gc_parent_record(oldmg->parent, newmg->parent);
	    }else{
		/** Parent Record is Already Copied **/
		newmg->parent = GetCopiedPrec(oldmg->parent);
	    }
	    newmg->parent->number_of_children2++;
	    newmg->pcode = GcProcedure(oldmg->pcode);
	    gc_cell(&wcell, &(newmg->output));
	}else{
	    newmg = Mergerof(&(oldmg->output));
	    SetAll(new, MGHOK, newmg, MRBON);
	}
    }
}
