{
QLispBin.mc
Last edit:  by don 23-Mar-84 11:33:57 
Last edit:  by don 16-Feb-84 10:41:14 fixed for big mem
Created:  29-Nov-83 10:17:04 by don
modified for DLion/Dove compatability 22-Oct-85 15:31:37
}

SetTask[0];


{- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 40      BIN         0        0                  \BIN

If TOS is not of type STREAM (13q), PUNT
Fetch quadword pointed to by TOS.  Format is:

	word 0: CCOFF	; a byte offset from BUFFER
	word 1: NCCHARS	; size of buffer in bytes
	word 2, 3: flags [byte] = READABLE(bit 0), WRITABLE(bit 1),
					 EXTENDABLE(bit 2)
		BUFFER [24-bits]

If CCOFF >= NCCHARS, PUNT  [buffer overflow]
If READABLE is off, PUNT
Fetch and remember the byte at BUFFER + CCOFF[byte offset]
	Note that this address is guaranteed to be valid at this point,
	but it could pagefault.

Update the CCOFF word:  CCOFF _ CCOFF + 1, and store back in the stream
Return the remembered byte as a small positive number.

[not required; in Dorado, D0]
- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 41      BOUT        0        -1                 \BOUT

If TOS-1 is not of type STREAM (13q), PUNT.
If TOS is not a small positive number (< 400Q), PUNT.
Fetch quadword pointed to by TOS.  (see format under BIN)
if WRITABLE is off, PUNT
if CCOFF >= NCCHARS then:
	if EXTENDABLE is off, PUNT
	if NCCHARS >= 512, PUNT
	increment & remember NCCHARS

deposit byte from TOS at BUFFER + CCOFF[byte offset]

Update the stream:
	store CCOFF _ CCOFF + 1
	store NCCHARS if incremented

return the smallposp one (1)

[not required; not implemented yet]


- - - - - - - - - - - - - - - - - - - - - - - - - -}

@BIN:		opcode[40'b],
	rhTT _ TOSH LRot0,	c1;
	,	c2;
	Rx _ TOS, rhRx _ crhTypeTable,	c3;

	MAR _ Q _ [TOS, TOSH + 0],	c1; {not mem req }
	TT _ TOS, L1 _ L1.NoFixes, 	c2;
	,	c3;

	Rx _ Q,	c1;
	Rx _ Rx LRot8, 	c2;
	Rx _ Rx RShift1, getTypemsBit,	c3;

	{get type table entry}
	MAR _ [rhRx, Rx + 0],	c1;
	Q _ 0FF,	c2;
	Rx{entry} _ MD and Q{0FF},	c3;

	{test if type stream}
	,	c1;
	Ybus _ Rx xor STREAMTYPE, ZeroBr,	c2;
	BRANCH[TTEnotStream, $],	c3;

	{map the address}
	Map _ [rhTT, TT], L0 _ L0.RedoBin,	c1;
	,	c2;
	Rx _ rhRx _ MD, XwdDisp{XDirtyDisp},	c3;

	{get 4 word contents of address}
	MAR _ Q _ [rhRx, TT + 0], DISP2[BinRemap],	c1,at[L0.RedoBin,10,WMapFixCaller];
	Rx _ uSavAddr _ Q,	c2, at[PgDirty, 4, BinRemap];
	Q{CCOFF} _ MD,	c3;

	MAR _ [rhRx, Rx + 1],	c1;
	CANCELBR[$, 2],	c2;
	TT{NCCHARS} _ MD,	c3;

	MAR _ [rhRx, Rx + 3],	c1;
	Ybus _ Q - TT, CarryBr, BRANCH[$, lbCant, 1],	c2;
	TT{Buff.Lo} _ MD, BRANCH[$, BinFull],	c3;

	MAR _ [rhRx, Rx + 2],	c1;
	uGcLlo _ TT, CANCELBR[$, 2],	c2;
	rhTT _ TT{Buff.Hi} _ MD,	c3;

	Rx _ Q + 1,	c1;
	uGcLTem _ Rx,	c2;
	Ybus _ TT, NegBr,	c3;

	Q _ rhRx, BRANCH[BinNoRead, $],	c1;
	Ybus _ Rx and 1, YDisp,	c2;
	TT _ uGcLlo, L2 _ 0, BRANCH[BinO, BinE],	c3;{L2 _ Odd/Even}

BinO:
	Rx _ RShift1 (Rx - 1), SE _ 0, GOTO[BinEO],	c1;
BinE:
	Rx _ RShift1 (Rx - 1), SE _ 0, GOTO[BinEO],	c1;
BinEO:
	TT _ TT + Rx, CarryBr,	c2;
	urhRx _ Q, BRANCH[BinNoC,$],	c3;

	Q _ rhTT,	c1;
	Q _ Q + 1,	c2;
	rhTT _ Q LRot0,	c3;

BinNoC:
	Map _ [rhTT, TT], L0 _ L0.RedoBinA,	c1;
	,	c2;
	Rx _ rhRx _ MD, ReadXRefBr, GOTO[BinGet],	c3;

BinGet:
	{get contents of address}
	MAR _ Q _ [rhRx, TT + 0], ReadBRANCH[BinRemapA, $],	c1,at[L0.RedoBinA,10,RMapFixCaller];
	L2Disp,	c2;
	TT{BinWord} _ MD, BRANCH[BinOdd, BinEven],	c3;

BinOdd:
	TT _ TT, GOTO[BinMask],	c1;
BinEven:
	TT _ TT LRot8, GOTO[BinMask],	c1;
BinMask:
	TOS _ TT and 0FF,	c2;
	TOSH _ smallpl,	c3;

	rhRx  _ urhRx,	c1;
	Rx _ uSavAddr,	c2;
	,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ uGcLTem, L2 _ L2.0, IBDisp, GOTO[DNI.pc1],	c2;

	CALL[WLMapFix],	c2, at[PgClean, 4, BinRemap];

	CALL[WLMapFix],	c2, at[PgProt, 4, BinRemap];

	CALL[WLMapFix],	c2, at[PgVacant, 4, BinRemap];

BinRemapA:
	CALL[RLMapFix],	c2;

TTEnotStream:
	GOTO[ufnX2],	c1;

BinFull:
	GOTO[ufnX2],	c1;

BinNoRead:
	GOTO[ufnX3],	c2;

lbCant:
	CANCELBR[ufnX1],	c3;


	{ E N D }