:Title[Lisp0.mc, January 4, 1983  2:48 PM, Masinter];
:insert[DisplayDefs.mc];
	mc[max.pvar.for.fault, 3000];
* Code for Interface with BCPL

   KnowRBase[LTEMP0];
   TOP LEVEL;
   InsSet[LispInsSet, 1];

   mc[UCODE.CHECK, 0];
   mc[STKOV.PUNT, sub[0,SubovFXP!]]; * says context switch to Subov
   mc[NWW.INTERRUPT, 2];
   mc[PAGE.FAULT, sub[0,FAULTFXP!]];
   mc[STATS.PUNT, 4];

*--------------------------------------------------------------------
opSUBR:   
*--------------------------------------------------------------------
   LTEMP0_ Id; 
   T_ LTEMP2_ Id;
   T_ T + T;
   T_ TSP_ (TSP) - (Cnt_ T);
   LTEMP1_ SubrArgArea;


.subr1:
   memBase_ StackBR, branch[.subr2, Cnt=0&-1];
   T_ (fetch_ T) + 1;
   memBase_ MDS;
   LTEMP1_ (store_ LTEMP1)+ 1, dbuf_ Md, branch[.subr1];

.subr2:
   LTEMP1_ (Id) - (PCX') - 1, branch[.storepuntpc];

IFUpause[175, 3, StackBR, 0, opSUBR, noNData, 0, 0];	*SUBRCALL

*--------------------------------------------------------------------
opCNTXTSWITCH:
*--------------------------------------------------------------------
   T_ (TSP) - 1;
   TSP_ (fetch_ T) - 1;		* fetch arg
   rbase_ rbase[NWW];
   T_ Md, NWW_ (NWW) and not (100000c);	* turn on interrupts
   pd_ NWW, rbase_ rbase[LTEMP0];
   branch[.+2, alu=0], LTEMP0_ (0s) - T; * LTEMP0_ - (context#)
   pd_ LTEMP0, RescheduleNow;		* reschedule if int pending...
   LTEMP1_ (Id) - (PCX') - 1, branch[.storepuntpc];

IFUpause[176, 1, StackBR, 0, opCNTXTSWITCH, noNData, 0, 0];	*CNTXTSWITCH

*--------------------------------------------------------------------
UCODECHECKPUNT: GLOBAL, DontKnowRBase, 
*--------------------------------------------------------------------

* call: gcall[uCodePunt];

   T_ Link;
   rbase_ rbase[LTEMP0];
   memBase_ MDS;
   LTEMP0_ SubrArgArea;
   LTEMP0_ (store_ LTEMP0) + 1, dbuf_ SmallHi;
   T_ (store_ LTEMP0) + 1, dbuf_ T;

	rbase_rbase[FLTEMUPC];

   T_(store_ T) + 1, dbuf_ FLTEMUPC;

	rbase_rbase[PVAR];

   T_ (store_ T) + 1, dbuf_ PVAR;
   T_ (store_ T) + 1, dbuf_ LTEMP1;
   T_ (store_ T) + 1, dbuf_ TSP;
   T_ (store_ T) + 1, dbuf_ PSTATE;
   LTEMP2_ 1c;
   LTEMP0_ UCODE.CHECK, branch[BCPLEXIT];
*--------------------------------------------------------------------
RAIDPUNT:
*--------------------------------------------------------------------

* like UCODEPUNT, but registers are OK;

   rbase_ rbase[LTEMP0];
   memBase_ MDS;
   LTEMP0_ SubrArgArea;
   LTEMP0_ (store_ LTEMP0) + 1, dbuf_ SmallHi;
   store_ LTEMP0, dbuf_ 0c;
   LTEMP2_ 1c;
   LTEMP0_ UCODE.CHECK, branch[PUNT];
*--------------------------------------------------------------------
STKOVPUNT:
*--------------------------------------------------------------------
   LTEMP0_ STKOV.PUNT, branch[.puntz];

*--------------------------------------------------------------------
STATSPUNT:
*--------------------------------------------------------------------
   LTEMP0_ STATS.PUNT, branch[.puntz];

*--------------------------------------------------------------------
NWWPUNT:* old NWW: exit to BCPL w/reschedule still set
*--------------------------------------------------------------------
   rbase_ rbase[LTEMP0];
   LTEMP0_ NWW.INTERRUPT, branch[.puntz]; 

*--------------------------------------------------------------------
KEYPUNT: KnowRBase[NWW]; * new NWW: context switch to KBD context
*--------------------------------------------------------------------
   NWW_ (100000c); * turn off interrupts
   rbase_ rbase[LTEMP0];
   LTEMP0_ sub[0, KbdFXP!]c, branch[.puntz];

.puntz:
   LTEMP2_ A0, branch[PUNT];

*--------------------------------------------------------------------
PAGEFAULTPUNT:
*--------------------------------------------------------------------
   rbase_ rbase[FltPipe0];
   memBase_ InterfaceBR;
   T_ IFPFAULTHI;
   T_ (store_ T) + 1, dbuf_ FltPipe0;
   store_ T, dbuf_ FltPipe1;
   rbase_ rbase[LTEMP0];

* check for pagefault in BITBLT, save Stack if so

   pd_ (PSTATE) xor (PS.INBITBLT);
   branch[.+2, alu#0], memBase_ StackBR, T_ (TSP) - 1;
	PSTATE_ A0, store_ T, dbuf_ Stack, branch[.PFOK];

:if[Debugging];
   branch[.PFOK, R<0], PSTATE, pd_ (PSTATE) xor (PS.PFOK);
   branch[.+2, alu=0];
	uCodeCheck[IllegalFault];
   nop;
:endif;

** check for page fault in page fault context

.PFOK:
   pd_ (PVAR) - (max.pvar.for.fault);
   branch[.+2, carry], LTEMP0_ PAGE.FAULT;
	uCodeCheck[PAGEFAULTRECURSION];

:if[Debugging];
	rbase_ rbase[NWW];
	branch[.+2, R>=0], NWW, rbase_ rbase[LTEMP0];
		uCodeCheck[];
:endif;

   LTEMP2 _ A0, branch[PUNT];
*--------------------------------------------------------------------
* common punt code
*--------------------------------------------------------------------
PUNT:
   T_ (PVAR) - (FXBACK[FLAGS]);
   memBase_ StackBR, PSTATE, branch[.normalpunt, R>=0];

* punt in call

   fetch_ T, LTEMP1_ FXInCall;
   LTEMP1_ (LTEMP1) or Md;
   store_ T, dbuf_ LTEMP1;
   T_ (store_ TSP) + 1, dbuf_ SmallHi;
   T_ (store_ T) + 1, dbuf_ NARGS;
   T_ (store_ T) + 1, dbuf_ 0c;	* can't fault if DEFHI nonzero
   TSP_ (store_ T) + 1, dbuf_ DEFLO, branch[.puntfixstack];

.normalpunt:
   fetch_ T, LTEMP1_ FXNoPushReturn;
   LTEMP1_ (LTEMP1) or Md;
   store_ T, dbuf_ LTEMP1;
   LTEMP1_ not (PCX');

.storepuntpc: 			* from SUBR and context switch, too
   T_ (PVAR) - (FXBACK[PC]);
   store_ T, dbuf_ LTEMP1;

   
.puntfixstack:
   T_ (PVAR) - (FXBACK[NEXT]);
   store_ T, T_ dbuf_ TSP;			* store NEXT
   T_ (ESP) - T;
   branch[.+2, carry], TSP_ (store_ TSP) + 1, dbuf_ FreeStackBlock;
	uCodeCheck[NoStackAtPunt];
   store_ TSP, dbuf_ T;

* LTEMP0 = punt or subr#, or else (- context#)
* LTEMP2  = number of args
* PVAR ok

BCPLEXIT:
   memBase_ interfaceBR;
   PVAR_ (PVAR) - (FX.PVAR);
   branch[.ctxswitch, R<0], Q_ LTEMP0;

:if[Debugging];
   PSTATE_ (PS.INBCPL);
:endif;

   store_ add[CurrentFXP!]s, dbuf_ PVAR;

:if[FNStats];
   branch[.+2, R>=0], FnStatsPtr;
	branch[.bcplxend];
   nop;
   DEFLO_ Q, call[.subrstat];
   memBase_ MDS;
   T_ StatsBufferPtr;
   store_ T, dbuf_ FnStatsPtr;
:endif; * FNStats


.bcplxend:
   T_ LTEMP2, rbase_ rbase[spAC0];
   StkP_ spAC2;
   Stack&+1_ Q;			* value for AC2 Punt or subr #
   Stack&-1_ T;			* # of args
   T_ AemuRestartLoc, branch[start];


   KNOWRBASE[LTEMP0];

.ctxswitch:
   T_ (0s) - (LTEMP0);	* context#
   fetch_ T;

:if[Debugging];
   PSTATE_ (PS.PCXBAD);
:else;
   PSTATE_ A0;
:endif;

   PVAR_ Md, store_ T, dbuf_ PVAR;
   PVAR_ (PVAR) + (FX.PVAR), branch[RTN2];


:if[FNStats];

	SUBROUTINE;

*--------------------------------------------------------------------
* Stats writing
*--------------------------------------------------------------------

.subrstat:
   DEFHI_ A0;
   T_ LSH[LTEMP2, 10];
   T_ T or (CALL.EVENT), branch[.storestat];

FNSTAT: * fn in LTEMP0, 1, NARGS set.
   T_ LTEMP0, memBase_ MDS;
   T_ LCY[T, NARGS, 10];
   T_ T or (CALL.EVENT);
   T_ (store_ FnStatsPtr) + 1, dbuf_ T;
   T_ (store_ T) + 1, dbuf_ LTEMP1, branch[.stattail];

.storeretstat:
   T_ (RETURN.EVENT), branch[.storestat];

.storestat:
   T_ T or (DEFHI), memBase_ MDS;
   T_ (store_ FnStatsPtr) + 1, dbuf_ T;
   T_ (store_ T) + 1, dbuf_ DEFLO;
.stattail:
   FnStatsPtr_ T;
   T_ 30c;
   T_ T + (400c);
   taskingoff;
   fetch_ T;
   T_ (store_ FnStatsPtr) + 1, dbuf_ Md;
   rbase_ rbase[RTClock];
   T_ (store_ T) + 1, dbuf_ RTClock;
	TASKINGON;
   rbase_ rbase[FnStatsPtr];
   FnStatsPtr_ T;
   pd_ T - (StatsBufferBoundary);
   branch[.+2, alu<=0];
	ReSchedule;
   return;


	TOP LEVEL;

:endif; * FNStats


*--------------------------------------------------------------------

   KnowRBase[AEmRegs];
   m[MBXI, KnowRBase[AEmRegs]
	   Top level];

LTrap:
   ETEMP2_ Id, call[GetPC];
   pd_ (ETEMP2) - (20c);
   branch[.+2, alu<0], ETEMP4_ T + 1;
	branch[NPTrap]; 
   BigBdispatch_ ETEMP2;
   branch[LTrapDispatch], StkP_ spAC0;


EmuNext:
   rbase_ rbase[AEmRegs], global;
   T_ ETEMP4, branch[start];

EmuSkip:
   rbase_ rbase[AEmRegs];
   T_ (ETEMP4) + 1, branch[start];

*--------------------------------------------------------------------
* arrive at the Lisp dispatch locations with StkP_ spAC0 
*--------------------------------------------------------------------

LTrapDispatch:
   branch[MBIX], dispTable[20];		*   00
   branch[ReadFlags];			*   01
   branch[SetFlags];			*   02
   branch[XferPage];			*   03
   branch[BGetBase];			*   04
   branch[BPutBase];			*   05
   branch[BGetBase32];			*   06
   branch[BGetBasePtr];			*   07
   branch[BPutBase32];			*   10
   branch[InitLispRegs];		*   11
	Stack_ A0, branch[EmuNext];	*   12   GetRamVersion
   branch[NPTrap];			*   13   was GetFXP
   branch[NPTrap];			*   14   was SetFXP
   branch[uPCTrace];			*   15
   branch[XBitBlt];			*   16
   branch[NPTrap];			*   17 was CallFN


MBXI;	*--------------------------------------------------------------
MBIX:   rbase_ rbase[LTEMP1];
   LTEMP0_ Stack&+1;			* AC0: hi part of return value
   LTEMP1_ Stack;			* AC1: lo part of return value

:if[Debugging];
   PSTATE_ (PS.PCXBAD);
:else;
   PSTATE_ A0;
:endif;

:if[FNStats];
   rbase_ rbase[PVAR];
   T_ StatsBufferPtr;
   memBase_ MDS;
   fetch_ T;
   FnStatsPtr_ Md;
   pd_ FnStatsPtr;
   branch[.+2, alu#0];
	FnStatsPtr_ -1c;

:else;
   FnStatsPtr_ T-T-1;
   memBase_ MDS;
:endif;

* memBase=MDS
   rbase_ rbase[NWW];
   T_ (R400) + (52C);	* WW (= 452B)
   fetch_ T, T_ (100000C);
   T_ (Md) and not (T);
   NWW _ (NWW) or T;
   branch[.+2, alu=0], rbase_ rbase[LTEMP0];
	Reschedule;

   T_ add[100000, LShift[LispInsSet, 10]]c;	* set InsSet
   InsSetOrEvent_ T;

   MemBX_ 0s;					* SET MemBX

   T_ StackEmpty;				* set StkP
   StkP_ T;

   memBase_ interfaceBR;
   fetch_ add[CurrentFXP!]s;
   PVAR_ Md;
   PVAR_ (PVAR) + (FX.PVAR), branch[RTN2];	

MBXI;	*--------------------------------------------------------------
ReadFlags:
   call[flushVp], T_ Stack;
   RMap_ ETEMP3, call[waitforMapBuf];	* uses T only
   Stack&+1_ not (Map');
   T_ not (Pipe4');
   Stack&-1_ T and (m1pipe4.wpdref),	* wp, d, & ref from pipe4
   branch[EmuNext];


   KnowRBase[LTEMP0];

*--------------------------------------------------------------
opREADFLAGS:
   T_ (TSP) - 1;
   fetch_ T;
   call[flushVp], T_ Md, rbase_rbase[ETEMP3]; 
   RMap_ ETEMP3, call[waitforMapBuf];

   pd_ Id, rbase_ rbase[TSP];
   branch[.+2, alu=0], LTEMP0_ not (Pipe4');
	LTEMP0_ not (Map'), branch[.readtail];
   LTEMP0_ (LTEMP0) and (m1pipe4.wpdref), branch[.readtail];

.readtail:

   T_ (Id) - (PCX') - 1;
   PCF_ T;				* restart IFU
   T_ (TSP) - 1, memBase_ StackBR;
   store_ T, dbuf_ LTEMP0, NextOpCode;

regOP1[161, StackBR, opREADFLAGS, 0];	* readflags
regOP1[162, StackBR, opREADFLAGS, 1];	* readrp

MBXI;	*--------------------------------------------------------------
SetFlags:
   StkP_ spAC2; 
   T_ (Stack&-2) + (3c);
   fetch_ T;					* fetch flags
   ETEMP2_ Md, T_ Stack&+1, call[flushVP];	*flush cache
   T_ lsh [ETEMP2, 2];				* position the wp&dirty bits
   T_ T and (TIOAvacantMapEntry);		* mask out any extra bits
   T_ Stack&-1, TIOA_ T;
   B_ T, TASKINGOFF;				* get bmux stable for Map_
   Map_ ETEMP3, B_ T;				* write the map
   TASKINGON;
   call[waitforMapBuf], TIOA_ ETEMP3;		* clear TIOA

* flushVp did one IFUReset, must do a second

   branch[.+2, R>=0], ETEMP2, IFUReset;		* check for ref bit
	fetch_ ETEMP3;				* reference it
   branch[EmuNext];

*--------------------------------------------------------------------
SUBROUTINE;	
FlushVP:	* vp is in T, uses ETEMP3, sets memBase
   memBase_ LScratchBR, B_ Md;			* finish any stores
   IFUreset;					* stop IFU from making refs
   ETEMP3_ lsh[T, 10];
   T_ rsh[T, 10];
   BrHi_ T;
   BrLo_ ETEMP3;
   T_ 360C;

 FlushVPLoop:   flush_ T;
   T_ T - (20C);
   branch[FlushVPLoop, alu>=0];
   B_ Md, ETEMP3_ A0, return;

TOP LEVEL;

MBXI;	*--------------------------------------------------------------
XferPage: 
   call[setXferBR], memBase_ BBDSTBR, T_ Stack&+1;
   call[setXferBR], memBase_ BBSRCBR, T_ Stack&-1;
   T_ rhmask;
   Cnt_ T;
   fetch_ T, flipMemBase;
   T_ (store_ T) - 1, dbuf_ Md, flipMemBase, branch[.-1, Cnt#0&-1];
   branch[EmuSkip];

SUBROUTINE;

setXferBR:
   ETEMP3_ RSH[T, 10];
   BrHi_ ETEMP3;
   ETEMP3_ LSH [T, 10];
   BrLo_ ETEMP3, return;
TOP LEVEL;

MBXI;	*--------------------------------------------------------------
BGetBase: 
   call[BFetch];
   Stack_ Md, branch[EmuSkip];

MBXI;	*--------------------------------------------------------------
BGetBase32:
   call[BFetch];
   Stack&+1_ Md;
   fetch_ 1s;
   Stack_ Md, branch[EmuSkip];


MBXI;	*--------------------------------------------------------------
BGetBasePtr: T_ rhmask;
   call[BFetch];
   Stack&+1_ T and (Md);
   fetch_ 1s;
   Stack_ Md, branch[EmuSkip];

SUBROUTINE;
BFetch:
   memBase_ LScratchBR;
   BrHi_ Stack&+1;
   BrLo_ Stack&-1;
   fetch_ 0s, return;
TOP LEVEL;


MBXI;	*--------------------------------------------------------------
BPutBase: 
   StkP_ spAC2;
   T_ (Stack&-2) + (3c);
   fetch_ T;
   T_ Md, call[BStore], memBase_ LScratchBR;
   B_ Md, branch[EmuSkip];

MBXI;	*--------------------------------------------------------------
BPutBase32: 
   StkP_ spAC2;
   T_ (Stack&-2) + (3c);
   fetch_ T;   
   T_ Md;
   T_ (fetch_ T) + 1;
   T_ Md, fetch_ T;
   call[BStore], ETEMP2_ Md, memBase_ LScratchBR;
   T_ ETEMP2;
   store_ 1s, dbuf_ T, branch[EmuSkip];

*--------------------------------------------------------------------
SUBROUTINE;
BStore:
   BrHi_ Stack&+1;
   BrLo_ Stack&-1;		* restore to AC0
   store_ 0s, dbuf_ T, return;
TOP LEVEL;

MBXI;	*--------------------------------------------------------------
InitLispRegs:

   rbase_ rbase[RMForIFU];

   MemBX_ 0s;					* SET MemBX

   AllOnes_ T-T-1;

:if[Debugging];
   PSTATE_ (PS.INBCPL);
:endif;

   T_ DTDspace;
   LTEMP0_ DTDbase;
   memBase_ dtdBR, call[setBR];

   LTEMP0_ (LTEMP0) + (lshift[ListType!, 4]c);
   memBase_ ListpDTDBR, call[setBR];

   T_ STATSspace;
   LTEMP0 _ MDSTYPEbase;
   memBase_ tybaseBR, call[setBR];

   LTEMP0 _ UFNTablebase;
   memBase_ ufnBR, call[setBR];

   T_ stackHI;
   LTEMP0 _ A0,
   memBase_ StackBR, call[setBR];

   T_ T - 1;
   LTEMP0_ (LTEMP0) - (2c);
   memBase_ StackM2BR, call[setBR];

   T_ VALspace;
   LTEMP0_ A0,
   memBase_ ValSpaceBR, call[setBR];

   T_ A0;
   LTEMP0_ A0,
   memBase_ ZeroBR, call[setBR];

   LTEMP0_ A0,
   memBase_ ScratchLZBR, call[setBR];

   T_ DEFspace;
   LTEMP0_ A0,
   memBase_ DefBR, call[setBR];   

   T_ HTMAINspace;
   LTEMP0_ HTMAINbase;
   memBase_ htMainBR, call[setBR];

   LTEMP0_ HTOVERFLOWbase;
   memBase_ HTOfloBR, call[setBR];

   T_ INTERFACEspace;
   LTEMP0_ INTERFACEbase;
   memBase_ interfaceBR, call[setBR];

   memBase_ MDS;
   T_ and[RamVersion, 177400]c;
   T_ T + (and[RamVersion, 377]c);
   Stack_ (store_ Stack) + 1, dbuf_ T;

   T_ and[RamMinBcplVersion, 177400]c;
   T_ T + (and[RamMinBcplVersion, 377]c);
   Stack_ (store_ Stack) + 1, dbuf_ T;

   T_ and[RamMinLispVersion, 177400]c;
   T_ T + (and[RamMinLispVersion, 377]c);
   Stack_ (store_ Stack) + 1, dbuf_ T;

* now initialize/find out display width

   rbase_ rbase[DisplayConfig];
   T_ OR[177400, MaxWidthWordsAlto!]C, DisplayConfig,
	Branch[ILRDisp, R even];	* Branch if Alto monitor

* Switch to using the entire width of the LF monitor:

   DisplayConfig_ (DisplayConfig) OR (2C);
   T_ Or[177400, MaxWidthWordsLF!]C;

* T has the new words/scanline
* 377 in the LH to signal DHT to reinitialize.

   MaxWidthWords_ T;

ILRDisp:
   T_ T AND (377C);
   Stack_ (store_ Stack) + 1, dbuf_ T;

   rbase_ rbase[RealPages];
   T_ RealPages;
   Stack_ (store_ Stack) + 1, dbuf_ T;	* # pages
   T_ 2000c;				* "dummy" #pages/module 
   Stack_ (store_ Stack) + 1, dbuf_ T,	* (doesn't matter)
   branch[EmuNext];

SUBROUTINE;

   KnowRBase[LTEMP0];
setBR:
   BrHi_ T;
   BrLo_ LTEMP0, return;
TOP LEVEL;

MBXI;	*--------------------------------------------------------------
uPCTrace:		* ignore
   branch[EmuNext];

MBXI;	*--------------------------------------------------------------
XBitBlt:
   T_ (fetch_ Stack&+2) + 1;		* get pointer from Ac0
   T_ Md, fetch_ T;
   Stack&+1_ A0, memBase_ LScratchBR;	* TOS == AC3, BBTable (AC2) = 0
   BrHi_ T, T_ Md;
   BrLo_ T;
   ETEMP4_ (ETEMP4) + 1, SCall[BitBltSub];	* increment PC
   ETEMP4_ (ETEMP4) - 1, branch[EmuNext];	* interrupt, return .+1
   ETEMP4_ (ETEMP4) + 1, branch[EmuNext];	* normal exit, return .+3


*--------------------------------------------------------------
   TOP LEVEL;
   knowrbase[LTEMP0];
   InsSet[LispInsSet, 1];

opUPCTRACE:
	T_ (fetch_ TSP) + 1;
	T_ Md, fetch_ T; rbase_ rbase[Events];
	Q_ Md, call[SetPCHistAddr];
	NextOpCode;

regOP1[377, StackM2BR, opUPCTRACE, noNData];


*--------------------------------------------------------------
* Memory system initialization stubs for lisp



InitMapWarm:
	Branch[ResumeEmulator]; * i.e., don't do anything

*-----------------------------------------------------------
WaitForMapBuf:	* Wait for map operation to complete
* Clobbers nothing
*-----------------------------------------------------------
Subroutine;
	PD_ T-T-1;
	PD_ PRef, Branch[., ALU<0];	* MapBufBusy is sign bit
	Return;
(1792)\16495f8 3f0