:Title[LOPS]; * Edit history: * Masinter, August 7, 1985 8:25 PM, add EQL, EQUAL * March 29, 1985 2:01 PM, make MISC1 also turn on ether * March 29, 1985 11:00 AM, Masinter, make CREATECELL ufn if free list NIL * March 22, 1985, 12:04, Masinter, change TYPEMASK, reformat * January 21, 1985 12:00 PM, Masinter, unglobal REPSMALLT * January 19, 1985 1:56 PM, Masinter, add TYPEMASK, assume TYPREV masks bits * March 5, 1984 7:30 PM, JonL, added opMISC1 (alpha 9) for opRWMufMan * (and retracted opRWMufMan as an opcode). GLOBALized REPSMALLT * February 18, 1984 2:47 PM, JonL, added opRWMufMan * February 18, 1984 12:53 PM, JonL, fix parity of branch condition for * opEVAL of litatom; tried BDispatch in opEVAL again * February 2, 1984 5:08 PM, JonL, opBIN checks bits[4:7] of BR for zero * January 26, 1984 7:40 PM, JonL, spawned LLISTP off from this file; * opEVAL uses BDispatch. * January 26, 1984 6:59 PM, JonL, opNOP and NEXTOP to LJUMP * January 7, 1984 5:38 PM, JonL, added commentary on TYPEP * January 6, 1984, 8:18 AM, JonL, fixed TL.CREATECELL to take an arg in * NARGS which is the number of words to "pull back" on TSP * December 29, 1983 6:59 PM, JonL, "bubbled" inst in CREATECELL * {memBase← StackM2BR, T← TSP} into previous inst, and replaced * a few "0c"'s with (atomHiVal)'s; changed (MaxConsCount) test in * CREATECELL to use carry'; TYPEP tails into REPSMT2; shortened BIN * by saving CCOFF in T over DOGETBYTE, and tailing into REPSMALLT * Put error checking into WRITEPRINTERPORT; CDR tails into * TL.PUSHNIL etc * December 27, 1983 6:30 PM, JonL, changed calls to GCLOOKT1 into calls * to GCADDREF or GCDELREF * December 26, 1983 6:53 PM, JonL, move in opEQ and opNOP from LOW, * let opEQ call ABFETCH and tail-out into TL.PUSHTRUE (or NIL) * December 26, 1983 6:40 PM, JonL, fixed callers of TYPREV to watch out * for non-zero TT.*** bits * December 21, 1983 5:15 AM, JonL, opRCLK from LOW, NEXTOP from from * LSTACK, moved opPOP to LSTACK, tailed opNTYPX into REPSMALLT * December 19, 1983 1:01 PM, JonL, TL.CREATECELL. Args in CELLHINUM and * CELLLONUM * December 15, 1983 3:42 PM, JonL, Put in labels REPSMALLT and TL.REPT * November 29, 1983 4:42 PM, Masinter, change carry to < on createcell KnowRBase[LTEMP0]; TOP LEVEL; InsSet[LispInsSet, 1]; *-------------------------------------------------------------------- SUBROUTINE; TYPREV: * Get type of datum from cell being fetched from T *-------------------------------------------------------------------- * Enter having done * T← (fetch← <someLoc>) + 1, call[TYPREV]; * Exit with Ahi in LTEMP0 * Alo in LTEMP1 * typenumber in T T← LTEMP0← Md, fetch← T; LTEMP1← Md, memBase← tybaseBR; T← RCY[T, LTEMP1, 11]; fetch← T, T← (rhmask); T← (T) and (Md), memBase← StackM2BR, return; TOP LEVEL; *-------------------------------------------------------------------- opEQ: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH]; T← Md, TSP← (fetch← T) - 1; T← Md, pd← T xor (LTEMP0); branch[.+2, alu=0], pd← (T) xor (LTEMP1); LEFT← (LEFT) + 1, branch[.neq]; branch[.neq, alu#0], LEFT← (LEFT) + 1; TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHTRUE]; .neq: TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL]; regOP1[360, StackM2BR, opEQ, noNData]; *-------------------------------------------------------------------- opEQL: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH]; T← Md, TSP← (fetch← T) - 1; pd← T xor (LTEMP0); branch[.+2, alu=0], pd← (Md) xor (LTEMP1); LEFT← (LEFT) + 1, branch[.neql]; branch[.+2, alu#0], LEFT← (LEFT) + 1; TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHTRUE]; .NEQL: PD ← LTEMP0; branch[.+2, alu#0], pd ← T; TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL]; branch[.+2, alu#0]; TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL]; TSP ← (TSP) + (4C); opEQUAL: CallUFN; regOP1[72, StackM2BR, opEQL, NoNData]; * EQL regOP1[364, StackM2BR, opEQL, NoNData]; * EQUAL *-------------------------------------------------------------------- opNTYPX: *-------------------------------------------------------------------- T← (fetch← TSP) + 1, call[TYPREV]; *-------------------------------------------------------------------- REPSMALLT: *-------------------------------------------------------------------- * Store a smallp into the Top-of-Stack slot; * Assumes TSP is correct and StackM2BR is memBase PAGEFAULTNOTOK; TSP← (store← TSP) + 1, dbuf← smallHi; REPSMT2: TSP← (store← TSP) - 1, dbuf← T, NextOpCode; regOP1[4, StackM2BR, opNTYPX, noNData]; *-------------------------------------------------------------------- opDTEST: * test if type name of tos = arg, ufn if not *-------------------------------------------------------------------- T← (fetch← TSP) + 1, call[TYPREV]; memBase← dtdBR; * fetch type name of DTD T← LSH[T, 4]; PAGEFAULTOK; FETCH← T, T ← LTEMP0, RisID; * This is like T← (Id); T← LSH[T, 10]; * Get the litatom index T← (Id) + T; * same ID pd← T - (MD); PAGEFAULTNOTOK; branch[.+2, alu=0]; CallUFN; * type disagree NextOpCode; regOP3[6, StackM2BR, opDTEST, noNData]; * this one is "coerce" regOP3[56, StackM2BR, opDTEST, noNData]; * this one is "typecheck" *-------------------------------------------------------------------- opTYPEP: * TYPEP, LISTP same code *-------------------------------------------------------------------- T← (fetch← TSP) + 1, call[TYPREV]; pd← (Id) xor T; .typepTAIL: branch[.+2, alu#0], T← AT.NIL; NextOpcode; * Continue if type same TSP← (store← TSP) + 1, dbuf← (atomHiVal), * Otherwise, return NIL branch[TL.REPNIL2]; regOP1[3, StackM2BR, opTYPEP, listType!]; regOP2[5, StackM2BR, opTYPEP, noNData]; *-------------------------------------------------------------------- opTYPEMASK: * used for NUMBERP, FIXP, etc. *-------------------------------------------------------------------- T← (fetch← TSP) + 1; T← Md, fetch← T; LTEMP1← Md, memBase← tybaseBR; T← RCY[T, LTEMP1, 11]; fetch← T; T← Md, memBase← StackM2BR; T← RSH[T,10]; pd← (Id) and T; branch[.+2, alu=0], T← AT.NIL; NextOpcode; * Continue if type same TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.REPNIL2]; regOP2[63, StackM2BR, opTYPEMASK, noNData]; *-------------------------------------------------------------------- opCREATECELL: *-------------------------------------------------------------------- T← (fetch← TSP) + 1; T← Md, CELLHINUM ← (fetch← T) - T; * TOS = typenumber pd← NARGS← T - (SmallHi); * NARGS← 0 if normal branch[.+2, alu=0], T← Md, memBase← dtdBR, CELLLONUM ← T - T; CallUFN; * non-small arg T← LSH[T, 4]; * 2↑4 wds per entry TL.CREATECELL: * Enter with T has the datatype number multiplied by the number of * words per DTD entry; * DEFHI has hiword value for first cell * DEFLO has loword value for first cell * NARGS has the number of words to "pull back" on TSP when done * memBase is dtdBR T← T + (DTD.FREE); * fetch free list LTEMP2← T← (fetch← T) + 1; * fetch head of free list LTEMP0← Md, T← (fetch← T) + (sub[DTD.SIZE!, add[DTD.FREE!, 1]]c); pd← LTEMP0; * LTEMP0, LTEMP1 ← freelist head branch[.+2, alu#0], LTEMP1← Md, fetch← T; CallUFN; * free list is empty LTEMP3← Cnt← Md; * LTEMP3, Cnt ← size in wds branch[.+2, Cnt#0&-1], memBase← ScratchLZBR; UCodeCheck[allocateZeroSizeCell]; BrHi← LTEMP0; PAGEFAULTOK; T← (FETCH← LTEMP1) + 1; * fetch contents of free branch[.+2, Cnt#0&-1], LTEMP4← MD, T← (fetch← T) - (2c); UCodeCheck[allocateOneSizeCell]; PAGEFAULTNOTOK; LTEMP3← Md, T← T + (LTEMP3); * loloc+size-1 .clearnew: PAGEFAULTOK; T← (STORE← T) - 1, dbuf← 0c, branch[., Cnt#0&-1]; PAGEFAULTNOTOK; .cleardone: * All but first word has been cleared. Store args into 1st and 2nd word T← (store← T) +1, dbuf← CELLHINUM; store← T, dbuf← CELLLONUM; T← LTEMP2, memBase← dtdBR; * store new free cell T← (store← T) - 1, dbuf← LTEMP3; store← T, pd← dbuf← LTEMP4; branch[.+2, alu#0], LTEMP2← (LTEMP2) + (sub[DTD.COUNTER!,add[1,DTD.FREE!]]c); PSTATE← (PSTATE) or (PS.HTCNTFULL); * freelist became empty ? fetch← LTEMP2; T← (Md) + 1; * Add 1 to conscounter store← LTEMP2, dbuf← T; pd← T - (MaxConsCount); T← NARGS, FreezeBC; branch[.+2, carry'], T← TSP← (TSP) - T, memBase← StackM2BR; * Exceeded MaxConsCount allocations of this type ? PSTATE← (PSTATE) or (PS.HTCNTFULL); * Result is address of newly allocated cell, which is smashed onto TOS T← (store← T) + 1, dbuf← LTEMP0; store← T, dbuf← LTEMP1; * DELREF on new cell, so implicit refcnt of 1 goes to 0 Case← 1c, Call[GCLOOKUP1]; LTEMP4← (4c), Branch[GCOPTAIL]; regOP1[37, StackM2BR, opCREATECELL, noNData]; *-------------------------------------------------------------------- opBIN: *-------------------------------------------------------------------- T← (fetch← TSP) + 1, call[TYPREV]; * returns with type in T PD← (Id) xor T, memBase← ScratchLZBR; * Set ScratchLZR to base of Branch[.+2, alu=0], BrHi← LTEMP0; * segment containg STREAMP CallUFN; * Arg not a STREAMP ? PAGEFAULTOK; T← (FETCH← LTEMP1) + 1; LTEMP0← MD, T← (fetch← T) + 1; * LTEMP0 ← CCOFF PAGEFAULTNOTOK; T← Md, LTEMP2← (fetch← T) + 1; * T ← NCCHARS LTEMP0← Md, pd← T - (Q← LTEMP0) - 1; * LTEMP0 ← HiBuf, Q ← CCOFF * also pd← NCCHARS-CCOFF-1 Branch[.+2, carry], LTEMP2← (fetch← LTEMP2) - (3c); CallUFN; * Punt -- end of bufload Branch[.+2, R<0], LTEMP0, memBase← ScratchBR; CallUFN; * Punt -- readable bit off T← Md, pd← (LTEMP0) and (7400c); Branch[.+2, alu=0], BrHi← LTEMP0; *setup BR to base of buffer uCodeCheck[ExtraBitsInBufferAddress]; BrLo← T, T← LTEMP1← Q, Call[.getByte]; * and actually fetch byte memBase← ScratchLZBR, T← T + 1; * Now increment CCOFF store← LTEMP2, dbuf← T; memBase← StackM2BR, T← LTEMP1, Branch[REPSMALLT]; regOP1[40, StackM2BR, opBIN, streamType!]; *-------------------------------------------------------------------- opMISC1: *-------------------------------------------------------------------- * One arg miscellaneous opcode T← ID; pd← (T) - (11c); Branch[opRWMufMan, alu=0], pd← (T) - (12c); Branch[Reset10MBEther, alu=0]; callUFN; regOP2[170, StackM2BR, opMISC1, noNData]; *-------------------------------------------------------------------- opRWMufMan: *-------------------------------------------------------------------- * One arg, a PosSMALLP, whose low-order 11 bits are a Muffler/Manifold * address. If the high-order bit (i.e., 2↑15) is off, then read the * the addressed muffler and return it's bit as the high-order bit of * a PosSMALLP; if it is on, then execute the corresponding Manifold * operation and return NIL. T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX1]; T← 13s; pd← LTEMP0, Cnt← T; Branch[.+2, alu=0],TSP← (TSP) + (2c); * Restore TSP CallUfn; flipMemBase; * Both exits expect memBase to be StackM2Br .rwmmlp: MidasStrobe← Q; * 11. iterations of strobe Q lsh 1; * and shift nop; Branch[.rwmmlp, Cnt#0&-1]; Branch[.+2, R>=0], LTEMP1; * Don't do flipMembase here, UseDMD, Branch[REPNIL]; * because that constrains T← ALUFMEM, Branch[REPSMALLT]; * too many locations *-------------------------------------------------------------------- opRCLK: *-------------------------------------------------------------------- T← (fetch← TSP) + 1; LTEMP0← Md, fetch← T, T← (30c); * LTEMP0 ← HiAddr to clobber LTEMP1← Md, memBase← MDS; * LTEMP1 ← LoAddr to clobber T← T + (400c); taskingOff; fetch← T; * fetch word 430 for hi part of clock LTEMP2← Md, rbase← rbase[RTClock]; * LTEMP2 ← hiword of clock T← RTClock; * T ← loword of clock taskingOn; rbase← rbase[LTEMP0]; memBase← ScratchLZBR; BrHi← LTEMP0; PAGEFAULTOK; LTEMP1← (store← LTEMP1) + 1, dbuf← Md; PAGEFAULTNOTOK; store← LTEMP1, dbuf← T, nextOpCode; regOP1[167, StackM2BR, opRCLK, noNData]; *-------------------------------------------------------------------- opREADPRINTERPORT: *-------------------------------------------------------------------- T← NOT(EventCntA'), branch[PUSHSMALLT]; regOP1[164, StackM2BR, opREADPRINTERPORT, noNData]; *-------------------------------------------------------------------- opWRITEPRINTERPORT: *-------------------------------------------------------------------- T← (fetch← TSP) - 1, flipMemBase; * Using .UNBOX1 here T← Md, fetch← T; * would only save 1 pd← T - (SmallHi), T← Md; * IM loc, but cost Branch[.+2, alu=0]; * an extra 3 cycles CallUfn; EventCntB← T, NextOpCode; regOP1[165, StackM2BR, opWRITEPRINTERPORT, noNData]; regOP1[54, StackM2BR, opEVAL, noNData]; *-------------------------------------------------------------------- opEVAL: *-------------------------------------------------------------------- T← (fetch← TSP) + 1, call[TYPREV]; pd← T and (370c); * Only the first 8 type codes Branch[.+2, alu=0], T← T and (7c); * are handled by ucode CallUFN; BDispatch← T; Branch[.evdispatch]; .evdispatch: DispTable[10], CallUfn; * Type 0 is randomness NextOpCode; * Smallp NextOpCode; * Fixp NextOpCode; * Floatp FVNAME← pd← (LTEMP1), Branch[.evatom]; * Litatom. "xor (AT.NIL)" NARGS← (1c), Branch[.evListp]; * Listp NextOpCode; * Arrayp NextOpCode; * Stringp % code use to read: pd← T - (atomType); branch[.evalatom, alu=0], pd← T; branch[.evalother, alu=0], pd← T - (add[FixpType!, 1]c); branch[.evalret, alu<0], pd← T - (ListType); branch[.evListp, alu=0], NARGS← 1c; CallUFN; * not atom, fixp, listp .evalother: CallUFN; * let UFN decide .evalret: NextOpCode; * return self .evalatom: FVNAME← pd← (LTEMP1); * "xor (AT.NIL)" % .evatom: Branch[.+2, alu#0], pd← (FVNAME) xor (AT.T); NextOpCode; * eval of NIL=NIL Branch[.+2, alu#0], T← (FX.PVAR); NextOpCode; * eval of T=T nop; * Call can be false target of conditional branch FVEP← (PVAR) - T, Call[DOLOOKUP]; memBase← ScratchLZBR; BrHi← FVHI; PAGEFAULTOK; T← (FETCH← FVLO) + 1; * Might fault, since it T← Md, fetch← T; * may be global cell PAGEFAULTNOTOK; pd← (FVHI) - (StackHi); Branch[.+2, alu#0], memBase← StackM2BR; Branch[REPTMD1]; * Stack-bound value is OK pd← (add[AT.NOBIND!]s) xor (Md); Branch[REPTMD1, alu#0]; * Global binding ok CallUFN; * Hmmm, NOBIND in topcell .evListp: DEFLO← AT.EVALFORM, Branch[DOCALLPUNT]; REPTMD: * Replace value on top of stack with value in T,,MD memBase← StackM2BR; REPTMD1: T← Md, TSP← (store← TSP) + 1, dbuf← T; TSP← (store← TSP) - 1, dbuf← T, NextOpcode;