{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;
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 ← 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 }