:Title[Lisp0];
*
* Edit History
* March 29, 1985  2:20 PM, Masinter, formatting
* March 20, 1985, Masinter, move UPCTRACE to 374
* March 15, 1985  10:59 AM, Masinter,  bum out unused cases
*      (e.g., Alto display)
* March 12, 1985  6:52 PM, Masinter, SAVEUCODESTATE was smashing color CSB
*   got rid of it
* February 2, 1985  10:34 PM, Masinter, Def2BR was set wrong!
* January 22, 1985  12:24 AM, Masinter, remove Altomode instructions no
*     longer used
* January 5, 1985  11:39 PM, JonL, Flush ZeroBR; setup Val2BR and Def2BR
*     for 64K Litatoms scheme
* February 18, 1984  4:54 PM, JonL, SAVEUCODESTATE uses SubrArgArea
*		instead of statsBuffer
* January 31, 1984  7:31 PM, JonL, embellish SAVEUCODESTATE
* January 31, 1984  5:05 PM, Masinter, add SAVEUCODESTATE as subroutine
* January 23, 1984  6:51 PM, JonL, debugging previous change
* January 20, 1984  6:26 AM, JonL, added check for BLT in pageFault
* 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;										* Beta byte is # args
	T← T + T;
	T← TSP← (TSP) - (Cnt← T);			* Move args from stack
	LTEMP1← SubrArgArea, Branch[.subr1];

.subr0:
	T← (fetch← T) + 1;		* Tight loop to move args 
	memBase← MDS;		*  from stackframe to the
	LTEMP1← (store← LTEMP1)+ 1, dbuf← Md;	*  BCPL subr arg area
.subr1:	memBase← StackBR, branch[.subr0, Cnt#0&-1];
	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,  
*--------------------------------------------------------------------

* call: SaveLink← Link, Branch[uCodeCheckPunt];
	LTEMP4← SubrArgArea;				* set up ucode
	LTEMP4← (store← LTEMP4) + 1, dbuf← SmallHi;	*  address of punter
	LTEMP4← (store← LTEMP4) + 1, dbuf← T;		*  as arg to BCPL subr
   LTEMP2← 1c;
   LTEMP0← UCODE.CHECK, branch[BCPLEXIT];

% got rid of SAVEUCODESTATE -- it smashes the color Core Status Buffer
*--------------------------------------------------------------------
SUBROUTINE;	SAVEUCODESTATE: GLOBAL,
*--------------------------------------------------------------------
* Clobbers LTEMP4 and BR
* Called by
*		rbase← rbase[LTEMP0];
*	KnowRBase[LTEMP0];
*		LTEMP3← T, T← Link, Call[SAVEUCODESTATE];	
	memBase← MDS;												* Save some volatile
	Q← LTEMP4;				*  ucode regs in stats
	LTEMP4← (XXXX); 
	LTEMP4← (store← LTEMP4) + 1, dbuf← (125377c);* 0  PassWord
	LTEMP4← (store← LTEMP4) + 1, dbuf← T;	* 1  Link at call here
	T← Link;
	T← (store← LTEMP4) + 1, dbuf← T;	* 2  ucode.addr + 1 of
	RBase←rbase[FLTEMUPC];			*   of call to here
	T←(store← T) + 1, dbuf← FLTEMUPC;	* 3  PC at fault
	RBase←rbase[LTEMP0];
	T← (store← T) + 1, dbuf← SaveLink;	* 4  maybe saved link
	T← (store← T) + 1, dbuf← LTEMP3;	* 5  T register
	T← (store← T) + 1, dbuf← LTEMP0;	* 6  LTEMP0
	T← (store← T) + 1, dbuf← LTEMP1;	* 7  LTEMP1
	T← (store← T) + 1, dbuf← PVAR;		* 10 PVAR
	T← (store← T) + 1, dbuf← TSP;		* 11 TSP
	T← (store← T) + 1, dbuf← PSTATE;	* 12 PSTATE
	T← (store← T) + 1, dbuf← DEFLO;	* 13 DEFLO
	T← (store← T) + 1, dbuf← NARGS;	* 14 NARGS
	T← (store← T) + 1, dbuf← Q;		* 15 LTEMP4
	LTEMP0← TIOA&StkP;
	T← (Store← T) + 1, dbuf← LTEMP0;	* 16 stackp
	LTEMP0← 1c;
	StkP← LTEMP0;
	T← (Store← T) + 1, dbuf← Stack&+1;
	T← (Store← T) + 1, dbuf← Stack&+1;
	T← (Store← T) + 1, dbuf← Stack&+1;
	T← (Store← T) + 1, dbuf← Stack&+1;
	T← (Store← T) + 1, dbuf← Stack&+1;
	T← LTEMP3, Return;
%
TOP LEVEL;

*--------------------------------------------------------------------
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 first for pagefault while "in function call" (which is OK).

:if[Debugging];
	Branch[.+2, R>=0], pd← (PSTATE) and (PS.PFOK);
	 Branch[.pfp1];	* OK to fault in fn call. No constraint on .pfp1
	Branch[.+2, alu#0], pd← (PSTATE) and (add[PS.INBITBLT!, PS.INBLT!]c);
		uCodeCheck[PageFaultWhenNotOK];
:else;
	pd← (PSTATE) and (add[PS.INBITBLT!, PS.INBLT!]c), * PSTATE is -1
	Branch[.+2, R>=0];		*  in fn call
		Branch[.pfp1];	* OK to fault in fn call. No constraint on .pfp1
:endif;

* Check also for fault in BLT or BITBLT (which need stack patchup).
	Branch[.pfp1, alu=0], PSTATE, pd← (PSTATE) and (PS.INBLT);
		Branch[.+2, alu=0], memBase← StackBR, T← (TSP) - 1; 
			stack← (stack) + 1;
		PSTATE← A0, store← T, dbuf← Stack, Branch[.pfp1]; 

.pfp1:		** check for page fault in page fault context
	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[NWW?];
:endif;

.pfp2:
   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;		* Following Call constrains addresses
	DEFLO← Q, Call[.subrstat];
	memBase← MDS;
	T← StatsBufferPtr;
	store← T, dbuf← FnStatsPtr, Branch[.bcplxend];
: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];
   branch[.+2, alu<0], ETEMP4← T + 1;
   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 
*--------------------------------------------------------------------
* vanMelle claims 0,1,2,4,5,6,10,11 are used

LTrapDispatch:
   branch[MBIX], dispTable[20];	*   00
   branch[ReadFlags];		*   01
   branch[SetFlags];			*   02
   branch[NPTrap];			*   03	was XferPage
   branch[BGetBase];			*   04
   branch[BPutBase];			*   05
   branch[BGetBase32];		*   06
   branch[NPTrap];			*   07  was BGetBasePtr
   branch[BPutBase32];		*   10
   branch[InitLispRegs];		*   11


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;	*--------------------------------------------------------------
BGetBase: 
   call[BFetch];
   Stack← Md, branch[EmuSkip];

MBXI;	*--------------------------------------------------------------
BGetBase32:
   call[BFetch];
   Stack&+1← 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← stackHI;
   LTEMP0 ← A0, memBase← StackBR, call[setBR];
   LTEMP0← (LTEMP0) - (2c);
   T← T - 1, memBase← StackM2BR, call[setBR];
   T← VALspace;
   LTEMP0← A0, memBase← ValSpaceBR, call[setBR];
   T← T + 1, memBase← Val2BR, call[setBR];
   T← LTEMP0← A0, memBase← ScratchLZBR, call[setBR];
   T← DEFspace;
   LTEMP0← A0, memBase← DefBR, call[setBR];   
   T← T + 1, memBase← Def2Br, call[setBR];
   T← HTMAINspace;
   LTEMP0← HTMAINbase;
   memBase← htMainBR, call[setBR];
   LTEMP0← HTOVERFLOWbase;
   memBase← HTOfloBR, call[setBR];

* Note that it is required that
*  DTDspace = MDSTYPEspace = UFNspace = INTERFACEspace

   T← INTERFACEspace;
   LTEMP0← INTERFACEbase;
   memBase← interfaceBR, call[setBR];

   LTEMP0← DTDbase;
   memBase← dtdBR, call[setBR];

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

   LTEMP0 ← MDSTYPEbase;
   memBase← tybaseBR, call[setBR];

   LTEMP0 ← UFNTablebase;
   memBase← ufnBR, 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 display width

   rbase← rbase[DisplayConfig];
   DisplayConfig← (DisplayConfig) OR (2C);
   T← Or[177400, MaxWidthWordsLF!]C;
   MaxWidthWords← T;
   Stack← (store← Stack) + 1, dbuf← MaxWidthWordsLF;

   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;


*--------------------------------------------------------------
   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[374, StackM2BR, opUPCTRACE, noNData]; * op 374 reserved on Dolphin


*--------------------------------------------------------------
* 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;