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