{File name:  LispCC.mc
 Last edited by cal  9-Feb-84 17:15:04  fixed for big mem 
 Descrition: CREATECELL code for Lisp 
 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, at[CCEntry];
	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[1, 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[1, 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 _ Rx _ [rhRx, Rx + 0],	c1  ;
	MDR _ uNewValHi{clear or data},	c2;
	TOSH{NewFree.Hi} _ MD,	c3;

	MAR _ Rx _ [rhRx, Rx + 1],	c1;
	MDR _ uNewValLo{clear or data}, CANCELBR[$, CB2], LOOPHOLE[wok],	c2;
	TOS{NewFree.Lo} _ MD, 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[0, 4, CCMapDTD];
	CANCELBR[WLMapFix, 3],	c2, at[2, 4, CCMapDTD];
	CANCELBR[WLMapFix, 3],	c2, at[3, 4, CCMapDTD];

	CANCELBR[WLMapFix, 3],	c2, at[0, 4, DtdMapNC];
	CANCELBR[WLMapFix, 3],	c2, at[2, 4, DtdMapNC];
	CANCELBR[WLMapFix, 3],	c2, at[3, 4, DtdMapNC];

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

Dtd.freeNIL: {set uGCPUNT non-zero }
	uGCPUNT _ PV xor ~PV,	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 }