:Title[Lisp0];
*
* Edit History
* 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
* - - - Willie-Sue
: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];
LTEMP3← T, T← Link, Call[SAVEUCODESTATE];* First, save state;
LTEMP4← SubrArgArea;* Then, 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];
*--------------------------------------------------------------------
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← (220c);
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
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];
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;