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