{File name:  dbLispCC.mc
 Last edited by cal  9-Feb-84 17:15:04  fixed for big mem 
 Descrition: CREATECELL code for Lisp 
 Last edited by cal 29-Jul-85 23:24:46  daybreakified  fixed MAR← MDR← ←MD in same click
 created by cal  30-Sep-83 12:10:54 
}


{---------------------------
	CREATECELL
		tos is smallpos containing Type
			if tos not smallpos, goto ufn
	    CCSubr entry here:
		DTD ← DTDSpace + (Type LShift 4)
		NewCell ← DTD:FREE
			if NewCell is NIL, goto ufn
		map NewCell
			pagefault if NewCell not resident
		put zeros to contents of NewCell for  last DTD:SIZE - 2 words
		DTD:FREE ← contents of (NewCell)
			if new DTD:FREE is NIL, signal punt[377]
		increment DTD:COUNTER
			if DTD:COUNTER goes neg, signal punt[377]
		DelRef to NewCell {make RefCnt = 0 }
			if gctable overflow entries, signal punt[371]
		tos ← NewCell
			goto punt[377] if appropriate
			goto punt[371] if appropriate
		next opcode
---------------------------}

{	This can be used as an opcode or as a subroutine } 

@CREATECELL:	opcode[37'b],
	Ybus ← TOSH xor smallpl, ZeroBr, L1 ← L1.NoFixes,	c1;
	TT ← TOS{Type} LRot4, BRANCH[CrCellBadArg, $],	c2;
	Q ← TT,	c3;

	uTOS ← TOS,	c1;
	,	c2;
	,	c3;
	
	uTOSH ← TOSH, L3 ← 0{opcode},	c1;
	uNewValLo ← 0,	c2;
	uNewValHi ← 0,	c3;
		
{	CREATECELL SUBROUTINE  --  used at end of floating point opcodes
    the following must be setup initially:
	initial TOS, TOSH saved in uTOS and uTOSH
	uNewValLo and uNewValHi must be loaded with result
	Q ← (LShift4   Type)
	L1 ← appropriate map fault fix value {probably L1.fixFV  --  to restore TOS , TOSH}
	L3 ← 4{fpt} used both here during abnormal exits, and after L1.fixFV
	L0 trashed  {set for WLMapFix return}
	L2 trashed  {set for GCLookup return}
	Subr will page fault if new cell page not resident
	TOSH , TOS contain address of new cell at exit
	ufn if FreeCell = NIL
	uGCPUNT non-zero if CREATECELL has new next cell = NIL or if DTD:COUNTER negative
	uGcLov non-zero if GCTableOverflow entries added
}



CCSubr:

{	Q has Type LShift 4 }
	rhTT ← DTDspace,	c1;
	TT ← DTDbasePage, L0 ← L0.RedoMapDTD,	c2;
	TT ← TT LRot8,	c3; {note: Type may be bigger than 0F }

{	Map DTD Page }
	Map ← TT ← [rhTT, TT + Q],	c1;
	,	c2;
	rhRx ← Rx ← MD, XwdDisp{XDirtyDisp},	c3;

{	fetch DTD:SIZE  FREEhi  FREElo  COUNTER}

{	fetch DTD:SIZE}
	MAR ← [rhRx, Q + DTD.SIZE], DISP2[CCMapDTD],	c1, at[L0.RedoMapDTD,10,WMapFixCaller];
	uDtd.RAddr ← Rx, CANCELBR[$, CB2],	c2, at[PgDirty, 4, CCMapDTD];
	TT{DTD.SIZE} ← MD,	c3;

{	fetch DTD:COUNTER}
	MAR ← [rhRx, Q + DTD.COUNTER],	c1,;
	uDtd.size ← TT, CANCELBR[$, CB2],	c2;
	TT{DTD.COUNTER} ← MD,	c3;

{	fetch DTD:FREEhi}
	MAR ← [rhRx, Q + DTD.FREEhi],	c1,;
	uDtd.counter ← TT, CANCELBR[$, CB2],	c2;
	TT{DTD.FREEhi} ← MD,	c3;

{	fetch DTD:FREElo}
	MAR ← [rhRx, Q + DTD.FREElo],	c1,;
	uDtd.NewCell.Hi ← TT, CANCELBR[$, CB2],	c2;
	TT{DTD.FREElo} ← MD,	c3;

{	BEWARE  --  NewCell may cross a page! {but not 64K} }
{	map NewCell }
	uDtd.NewCell.Lo ← TT,	c1;
	UQSave ← Q,	c2;
	Rx ← rhRx,	c3;

	urhRx ← Rx,	c1;
	,	c2;
	,	c3;

CCMapAgain:
	TT ← uDtd.NewCell.Lo,	c1;
	rhTT ← uDtd.NewCell.Hi,	c2;
	Ybus ← TT or rhTT, ZeroBr,	c3;

	Q ← uDtd.size, BRANCH[$, CCNewNIL],	c1;
	TT ← TT + Q,	c2;
	TT ← TT - 1,	c3; {point TT at last cell word }

	Map ← [rhTT, TT],	c1;{map cell page}
	uGCPUNT ← 0, L0 ← L0.RedoMapNC,	c2;
	Rx ← rhRx ← MD, XwdDisp{XDirtyDisp},	c3;

{	clear words of cell, starting from highest in case of pgfault during pgcross}
	DISP2[DtdMapNC],	c1,at[L0.RedoMapNC,10,WMapFixCaller];

	Q ← Q - 2,	c2, at[PgDirty, 4, DtdMapNC];
	Q ← Q - 1, NegBr,	c3;

	MAR ← Rx ← [rhRx, TT + 0], BRANCH[CCZloop, CCZdone],	c1  ;

NewCellZ:
	MAR ← Rx ← [rhRx, Rx - 1], BRANCH[CCZloop, CCZdone]	c1;
CCZloop:
	MDR ← 0, BRANCH[$, CCZpc, 1], LOOPHOLE[wok],	c2;
	Q ← Q - 1, NegBr, GOTO[NewCellZ],	c3;

CCZpc:
	Q ← Q + 3,	c3;
	,	c1;
	GOTO[CCL2pc],	c2;

CCL2pc:

	uDtd.size ← Q, GOTO[CCMapAgain],	c3;

CCZdone:
{	time to do first two words }
	Q ← 2, BRANCH[$, CCL2pc, 1],	c2;
	Rx ← Rx - 1,	c3;

{	read and write first two words of cell}
{	TOS and TOSH have been unchanged till now }
	MAR ← [rhRx, Rx + 0],	c1  ;
	,	c2;
	TOSH{NewFree.Hi} ← MD,	c3;

	MAR ← Rx ← [rhRx, Rx + 0],	c1  ;
	MDR ← uNewValHi{clear or data},	c2;
	,	c3;



	MAR ← [rhRx, Rx + 1],	c1;
	CANCELBR[$, CB2],	c2;
	TOS{NewFree.Lo} ← MD,	c3;

	MAR ← Rx ← [rhRx, Rx + 1],	c1;
	MDR ← uNewValLo{clear or data}, CANCELBR[$, CB2], LOOPHOLE[wok],	c2;
	GOTO[NewCellInitd],	c3;

	

NewCellInitd:
{	put old contents of NewCell into DTD:FREE }
	Q ← UQSave,	c1;
	rhRx ← urhRx,	c2;
	Rx ← uDtd.RAddr,	c3;

	MAR ← [rhRx, Q + DTD.FREEhi],	c1;
	MDR ← TOSH, CANCELBR[$, CB2], LOOPHOLE[wok],	c2;
	uGcLov ← 0,	c3;

	MAR ← [rhRx, Q + DTD.FREElo],	c1,;
	MDR ← TOS, CANCELBR[$, CB2], LOOPHOLE[wok],	c2;
	TT ← uDtd.counter,	c3;

{	increment DTD.COUNTER }

	MAR ← [rhRx, Q + DTD.COUNTER],	c1,;
	MDR ← TT + 1, NegBr, CANCELBR[$, CB2], LOOPHOLE[wok],	c2;
	Ybus ← TOS or TOSH, ZeroBr, BRANCH[$, Dtd.CounterNeg]	c3;

{	prepare for DelRef }
Dtd.gcl:
	TT ← uDtd.NewCell.Lo, BRANCH[$, Dtd.freeNIL],	c1;

	{setup for GcLookup:
	  Rx ← addrHi & 0FF
	  TT ← addrLo
	  uGcLov ← 0 {before first call only}
	  L2 ← subr #
	  Q ← 0 if addref, 1 if delref, 2 if stkref
	  Trashes rhTT and rhRx
	  }

	Rx ← uDtd.NewCell.Hi,	c2;
	Rx ← Rx and 0FF, L2 ← L2.CrCell,	c3;

	Q ← Q.DelRef, CALL[GcLookup],	c1;

	{GcLookup Subroutine here}

	TOS ← uDtd.NewCell.Lo,	c2,at[L2.CrCell,10,GcLookRet];
	TOSH ← uDtd.NewCell.Hi,	c3;

{	test uGCPUNT and uGcLov here for punts,  uGCPUNT first }

	Ybus ← uGCPUNT, ZeroBr,	c1;
	Ybus ← uGcLov, ZeroBr, BRANCH[CrCellGCPunt, $],	c2;
	L3Disp, BRANCH[CrCellOvPunt, $],	c3;

	PC ← PC + PC16, DISP3[ccxit],	c1;

CCend:
	IBDisp, L2 ← L2.0, GOTO[DNI.nop],	c2, at[0, 8, ccxit];

FptEnd:
	IBDisp, S ← S - 2, L2 ← L2.0, GOTO[DNI.nop],	c2, at[L3.FptArg1, 8, ccxit];
	IBDisp, S ← S - 2, L2 ← L2.0, GOTO[DNI.nop],	c2, at[L3.FptArg2, 8, ccxit];
	IBDisp, L2 ← L2.0, GOTO[DNI.nop],	c2, at[L3.Sh, 8, ccxit];{ArithSh}

	Xbus ← ib,	c2, at[L3.utob, 8, ccxit];{unboxed to boxed}
	PC ← PC + PC16,	c3;

	GOTO[IB.nop],	c1;

{	EXCEPTIONS }

CrCellBadArg: {only occurs from CREATECELL opcode }
	GOTO[ufnX1],	c3;

	CANCELBR[WLMapFix, 3],	c2, at[PgClean, 4, CCMapDTD];
	CANCELBR[WLMapFix, 3],	c2, at[PgProt, 4, CCMapDTD];
	CANCELBR[WLMapFix, 3],	c2, at[PgVacant, 4, CCMapDTD];

	CANCELBR[WLMapFix, 3],	c2, at[PgClean, 4, DtdMapNC];
	CANCELBR[WLMapFix, 3],	c2, at[PgProt, 4, DtdMapNC];
	CANCELBR[WLMapFix, 3],	c2, at[PgVacant, 4, DtdMapNC];

Dtd.CounterNeg: {set uGCPUNT non-zero }
	CANCELBR[$],	c1;

Dtd.freeNIL: {set uGCPUNT non-zero }
	uGCPUNT ← S xor ~S,	c2;
	GOTO[Dtd.gcl],	c3;

CrCellOvPunt:
	Rx ← AtomGCSCAN {371'b}, L3Disp, CANCELBR[CrCellPunts, 7],	c1;

CrCellGCPunt:
	CANCELBR[$],	c3;

	Rx ← AtomGCPUNT {377'b}, L3Disp, GOTO[CrCellPunts],	c1;

CrCellPunts:
	IB ← Rx LRot0, DISP3[CCPuntCases],	c2;

CCPuntCC:
	L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[0, 8, CCPuntCases];
	L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[1, 8, CCPuntCases];
	L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[2, 8, CCPuntCases];
	L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[3, 8, CCPuntCases];

CCPuntFpt:
	S ← S - 2, L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[L3.FptArg1, 8, CCPuntCases];
	S ← S - 2, L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[L3.FptArg2, 8, CCPuntCases];
	L3 ← 0{# ib's}, GOTO[CCPuntEnd],	c3, at[L3.Sh, 8, CCPuntCases];

	L3 ← 1{# ib's}, GOTO[CCPuntEnd1],	c3, at[L3.utob, 8, CCPuntCases];

CCPuntEnd:
	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;

CCPuntEnd1:
	MAR ← Q ← [rhS, S + 1], IBPtr ← 0, GOTO[FN1Ext],	c1;

CCNewNIL:
	L3Disp,	c2;
	BRANCH[CCnnoc, CCnnfpt, 3],	c3;

CCnnoc:
	GOTO[ufnX2],	c1;

CCnnfpt:	{here only from CCSubr calls  --  not opcode}
	GOTO[ufnZ2],	c1;

{	before page fault TOS, TOSH restored before here }
	GOTO[FptPgFlt],	c3, at[L3.FptArg1,10,fvfixup];
	GOTO[FptPgFlt],	c3, at[L3.FptArg2,10,fvfixup];
	GOTO[FptPgFlt],	c3, at[L3.Sh,10,fvfixup];
	GOTO[FptPgFlt],	c3, at[L3.utob,10,fvfixup];


FptPgFlt:
	GOTO[NoMoreFix],	c1;


	{ E N D }