<> <> <> <> <> <<>> DIRECTORY ExpressProc USING [ANYPROC, Token, XTree], ExpressTree USING [EnumDescendants, EnumerateProc], PrincOps USING [aFADD, aFCOMP, aFDIV, aFMUL, aFSUB, BytePC, ControlLink, CSegPrefix, EntryInfo, FrameSizeIndex, GlobalFrame, GlobalFrameHandle, InstWord, op, zAND, zINC, zJ3, zJEQ4, zJGEB, zJLEB, zKFCB, zLI0, zLI1, zLIN1, zLINI, zLIW, zLLDB, zMISC, zNEG, zNOOP, zOR, zPOP, zRET, zSFC, zSHIFT, zSLDB, zXOR], PrincOpsUtils USING [Codebase, GlobalFrame, GlobalFrameAndEntryPoint, MakeFsi], RTSD USING [sProcCheck], VM USING [MakeReadOnly, MakeReadWrite, PageNumberForAddress, PageNumber]; ExpressProcImpl: CEDAR MONITOR IMPORTS ExpressTree, PrincOpsUtils, VM EXPORTS ExpressProc ~ { OPEN ET: ExpressTree, PrincOps; <> NoProcedureAvailable: PUBLIC ERROR ~ CODE; IllegalToken: PUBLIC ERROR ~ CODE; ANYPROC: TYPE ~ ExpressProc.ANYPROC; Token: TYPE ~ ExpressProc.Token; XTree: TYPE ~ ExpressProc.XTree; GetProc: PUBLIC ENTRY PROC [fcn: XTree, oldProc: ANYPROC _ NIL] RETURNS [proc: ANYPROC] ~ TRUSTED { code: Code; ops: OpsList; --List of opcodes to do work of proc codePos, frameSize: CARDINAL; length: CARDINAL _ SizeNeeded[fcn]; procBase: ProcBase; FreeProcedureUnderLock[oldProc]; --Free procedure if given [proc, procBase] _ FindProcedure[length]; --Can raise !NoProcedureAvailable codePos _ PullArgsOffStack[procBase]; --Set ups code to take args off stack <> [code, frameSize] _ ParseTreeToCode[fcn, procTemp]; ops _ Cat[code.init, code.exec]; codePos _ AppendOpsToProc[procBase, codePos, ops]; AppendReturn[procBase, codePos]; SetFrameSize[proc, frameSize]; }; FreeProcedure: PUBLIC ENTRY PROC [proc: ANYPROC] ~ { FreeProcedureUnderLock[proc]; }; <> TokenInfo: TYPE ~ REF TokenInfoRec; TokenInfoRec: TYPE ~ RECORD [ type: ATOM, code: LIST OF PrincOps.op, size: CARDINAL ]; SizeNeeded: PROC [x: XTree] RETURNS [size: CARDINAL _ 11] ~ { <> AddSize: ET.EnumerateProc ~ TRUSTED { token: Token; WITH narrowX: x SELECT FROM constant => token _ $Constant; fcn => token _ $Proc; id => token _ narrowX.op; unX => token _ narrowX.op; binX => token _ narrowX.op; trinX => token _ narrowX.op; ENDCASE => ERROR; size _ size + GetTokenInfo[token].size; }; [] _ ET.EnumDescendants[x, AddSize]; }; GetTokenInfo: PROC [token: Token] RETURNS [tokenInfo: TokenInfo] ~ { FOR tokens: LIST OF TokenInfo _ definedTokens, tokens.rest WHILE tokens#NIL DO IF tokens.first.type = token THEN RETURN [tokens.first]; ENDLOOP; ERROR IllegalToken[]; }; AddToken: PROC [token: Token, code: LIST OF PrincOps.op] RETURNS [] ~ { size: CARDINAL _ 0; tokenInfo: TokenInfo; <> FOR ops: LIST OF PrincOps.op _ code, ops.rest WHILE ops#NIL DO size _ size+1; ENDLOOP; tokenInfo _ NEW[TokenInfoRec _ [token, code, size]]; definedTokens _ CONS[tokenInfo, definedTokens]; }; InitTokens: PROC ~ { <> AddToken[$Add, LIST[zMISC, aFADD]]; --Floating Arithmetic AddToken[$Subtract, LIST[zMISC, aFSUB]]; AddToken[$Multiply, LIST[zMISC, aFMUL]]; AddToken[$Divide, LIST[zMISC, aFDIV]]; AddToken[$Id1, LIST[zLLDB, arg1]]; AddToken[$Id2, LIST[zLLDB, arg2]]; AddToken[$Id3, LIST[zLLDB, arg3]]; AddToken[$Id4, LIST[zLLDB, arg4]]; AddToken[$Id5, LIST[zLLDB, arg5]]; AddToken[$Negate, LIST[zLINI, zXOR]]; --Flip the sign bit AddToken[$Constant, LIST[zLIW, 0, 0, zLIW, 0, 0, zSLDB, 0, zLLDB, 0]]; --Handled manually AddToken[$If, LIST[zSLDB, temp1, zSLDB, temp2, zLI1, zAND, zLI1, zJEQ4, zLLDB, temp1, zJ3, zLLDB, temp2]]; AddToken[$Proc, LIST[zLIW, 0, 0, zSFC]]; --Handled manually AddToken[$max, LIST[zSLDB, temp1, zSLDB, temp2, zLLDB, temp2, zLLDB, temp2, zLLDB, temp1, zMISC, aFCOMP, zLI0, zJGEB, 6, zPOP, zPOP, zLLDB, temp1]]; AddToken[$min, LIST[zSLDB, temp1, zSLDB, temp2, zLLDB, temp2, zLLDB, temp2, zLLDB, temp1, zMISC, aFCOMP, zLI0, zJLEB, 6, zPOP, zPOP, zLLDB, temp1]]; <> AddToken[$GT, LIST[zMISC, aFCOMP, zINC, zLIN1, zSHIFT]]; AddToken[$LT, LIST[zMISC, aFCOMP, zLIN1, zSHIFT]]; AddToken[$EQ, LIST[zMISC, aFCOMP, zINC]]; AddToken[$GE, LIST[zMISC, aFCOMP, zLIN1, zSHIFT, zINC]]; AddToken[$LE, LIST[zMISC, aFCOMP, zNEG, zLIN1, zSHIFT, zINC]]; AddToken[$NE, LIST[zMISC, aFCOMP]]; AddToken[$not, LIST[zINC]]; AddToken[$or, LIST[zOR]]; AddToken[$and, LIST[zAND]]; AddToken[$xor, LIST[zXOR]]; }; <> OpsList: TYPE ~ LIST OF PrincOps.op; Code: TYPE ~ RECORD [ init: OpsList, exec: OpsList ]; ParseTreeToCode: PROC [x: XTree, temp: CARDINAL] RETURNS [code: Code, nextTemp: CARDINAL] ~ TRUSTED { nextTemp _ temp; WITH narX: x SELECT FROM id => RETURN [[NIL, GetCode[narX.op]], nextTemp]; constant => RETURN [[NIL, GetCodeForReal[narX.value]], nextTemp]; unX => { c1: Code; [c1, nextTemp] _ ParseTreeToCode[narX.exp1, nextTemp]; RETURN [[c1.init, Cat[c1.exec, GetCode[narX.op]]], nextTemp]; }; binX => { c1, c2: Code; [c1, nextTemp] _ ParseTreeToCode[narX.exp1, nextTemp]; [c2, nextTemp] _ ParseTreeToCode[narX.exp2, nextTemp]; RETURN [[Cat[c1.init, c2.init], Cat[c1.exec, c2.exec, GetCode[narX.op]]], nextTemp]; }; trinX => { <> c1, c2, c3: Code; [c1, nextTemp] _ ParseTreeToCode[narX.exp1, nextTemp]; [c2, nextTemp] _ ParseTreeToCode[narX.exp2, nextTemp]; [c3, nextTemp] _ ParseTreeToCode[narX.exp3, nextTemp]; RETURN [[Cat[c1.init, c2.init, c3.init], Cat[c1.exec, c2.exec, c3.exec, GetCode[narX.op]]], nextTemp]; }; fcn => { c1: Code; cInit, cExec: OpsList _ NIL; FOR args: LIST OF XTree _ narX.args, args.rest UNTIL args=NIL DO [c1, nextTemp] _ ParseTreeToCode[args.first, nextTemp]; cInit _ Cat[cInit, c1.init]; cExec _ Cat[cExec, c1.exec]; ENDLOOP; RETURN [ [Cat[cInit, cExec, GetCodeForCall[narX.proc, nextTemp]], GetCodeForRetrieve[nextTemp] ], nextTemp+2]; }; ENDCASE => ERROR; }; GetCodeForReal: PROC [r: REAL] RETURNS [OpsList] ~ { RETURN [LIST[ zLIW, HiB[LoW[r]], LoB[LoW[r]], zLIW, HiB[HiW[r]], LoB[HiW[r]] ]]; }; GetCode: PROC [token: Token] RETURNS [OpsList] ~ { RETURN [GetTokenInfo[token].code]; }; GetCodeForCall: PROC [proc: ANYPROC, temp: CARDINAL] RETURNS [OpsList] ~ { RETURN [LIST[ zLIW, --Push the link to the procedure HiB[proc], LoB[proc], zKFCB, --check for assignment of nested procs out of scope RTSD.sProcCheck, zSFC, --If we still exist, call the procedure zSLDB, --Save the result LoB[temp] ]]; }; GetCodeForRetrieve: PROC [temp: CARDINAL] RETURNS [OpsList] ~ { RETURN [LIST[ zLLDB, LoB[temp] ]]; }; Cat: PROC [c1, c2, c3, c4: OpsList _ NIL] RETURNS [c: OpsList _ NIL] ~ { cTail: OpsList _ NIL; listList: LIST OF OpsList _ LIST[c1, c2, c3, c4]; FOR lists: LIST OF OpsList _ listList, lists.rest UNTIL lists=NIL DO FOR ops: OpsList _ lists.first, ops.rest UNTIL ops=NIL DO IF c=NIL THEN cTail _ c _ CONS[ops.first, NIL] ELSE cTail _ cTail.rest _ CONS[ops.first, NIL]; ENDLOOP; ENDLOOP; }; <> ProcBase: TYPE ~ LONG POINTER; ProcInfo: TYPE ~ REF ProcInfoRec; ProcInfoRec: TYPE ~ RECORD [ proc: ANYPROC, inUse: BOOLEAN _ FALSE, size: CARDINAL ]; ProcList: TYPE ~ LIST OF ProcInfo; FindProcedure: UNSAFE PROC [length: CARDINAL] RETURNS [proc: ANYPROC, procBase: ProcBase] ~ UNCHECKED { FOR procs: ProcList _ procList, procs.rest WHILE procs#NIL DO IF ~procs.first.inUse AND length> IF proc=NIL THEN RETURN; FOR procs: ProcList _ procList, procs.rest WHILE procs#NIL DO IF procs.first.proc=proc THEN {procs.first.inUse _ FALSE; RETURN}; ENDLOOP; }; GetControlLink: UNSAFE PROC [proc: ANYPROC] RETURNS [ControlLink] ~ UNCHECKED { RETURN [LOOPHOLE[proc]] }; BaseOfProc: UNSAFE PROC [proc: ANYPROC] RETURNS [procBase: ProcBase] ~ UNCHECKED { gf: PrincOps.GlobalFrameHandle _ PrincOpsUtils.GlobalFrame[GetControlLink[proc]]; codeBase: LONG POINTER TO PrincOps.CSegPrefix _ LOOPHOLE[PrincOpsUtils.Codebase[gf]]; offset: PrincOps.BytePC _ codeBase^.entry[PrincOpsUtils.GlobalFrameAndEntryPoint[GetControlLink[proc]].ep].initialpc; procBase _ LOOPHOLE[codeBase + offset]; }; SetFrameSize: UNSAFE PROC [proc: ANYPROC, size: CARDINAL] ~ UNCHECKED { fsi: FrameSizeIndex _ PrincOpsUtils.MakeFsi[size]; gf: PrincOps.GlobalFrameHandle _ PrincOpsUtils.GlobalFrame[GetControlLink[proc]]; codeBase: LONG POINTER TO PrincOps.CSegPrefix _ PrincOpsUtils.Codebase[gf]; where: LONG POINTER TO PrincOps.EntryInfo _ @(codeBase^.entry[PrincOpsUtils.GlobalFrameAndEntryPoint[GetControlLink[proc]].ep].info); page: VM.PageNumber _ VM.PageNumberForAddress[where]; VM.MakeReadWrite[[page, 1]]; where^.framesize _ fsi; VM.MakeReadOnly[[page, 1]]; }; PullArgsOffStack: UNSAFE PROC [procBase: ProcBase] RETURNS [codePos: CARDINAL _ 0] ~ UNCHECKED { codePos _ AppendOpsToProc[procBase, codePos, LIST[zSLDB, arg5, zSLDB, arg4, zSLDB, arg3, zSLDB, arg2, zSLDB, arg1]]; --Kluge for now pull 5 REALs off stack }; <> <> <> <<};>> <<>> <> <> <> <> <> <> <> <> <<];>> <> <<};>> <> <> <> <> <> <> <> <> <<];>> <> <<};>> AppendReturn: UNSAFE PROC [procBase: ProcBase, oldCodePos: CARDINAL] ~ UNCHECKED { [] _ AppendOpsToProc[procBase, oldCodePos, LIST[zRET]]; }; AppendOpsToProc: UNSAFE PROC [procBase: ProcBase, oldCodePos: CARDINAL, opList: LIST OF PrincOps.op] RETURNS [codePos: CARDINAL] ~ UNCHECKED { WhichByte: TYPE ~ {even, odd}; codePos _ oldCodePos; <> FOR ops: LIST OF PrincOps.op _ opList, ops.rest WHILE ops#NIL DO offset: CARDINAL _ codePos/2; which: WhichByte _ IF offset*2=codePos THEN even ELSE odd; code: LONG POINTER TO PrincOps.InstWord _ LOOPHOLE[procBase+offset]; page: VM.PageNumber _ VM.PageNumberForAddress[code]; VM.MakeReadWrite[[page, 1]]; SELECT which FROM even => code^.evenbyte _ LOOPHOLE[ops.first]; odd => code^.oddbyte _ LOOPHOLE[ops.first]; ENDCASE; VM.MakeReadOnly[[page, 1]]; codePos _ codePos + 1; ENDLOOP; }; RegisterP: PROC [proc: ANYPROC, size: CARDINAL] ~ { procInfo: ProcInfo _ NEW[ProcInfoRec _ [proc: proc, inUse: FALSE, size: size]]; procList _ CONS[procInfo, procList]; }; InitProcs: PROC ~ { RegisterP[P1000, 1000]; RegisterP[P1001, 1000]; RegisterP[P602, 600]; RegisterP[P603, 600]; RegisterP[P604, 600]; RegisterP[P605, 600]; RegisterP[P606, 600]; RegisterP[P607, 600]; RegisterP[P608, 600]; RegisterP[P609, 600]; RegisterP[P410, 400]; RegisterP[P411, 400]; RegisterP[P412, 400]; RegisterP[P413, 400]; RegisterP[P414, 400]; RegisterP[P415, 400]; RegisterP[P416, 400]; RegisterP[P417, 400]; RegisterP[P418, 400]; RegisterP[P419, 400]; RegisterP[P220, 200]; RegisterP[P221, 200]; RegisterP[P222, 200]; RegisterP[P223, 200]; RegisterP[P224, 200]; RegisterP[P225, 200]; RegisterP[P226, 200]; RegisterP[P227, 200]; RegisterP[P228, 200]; RegisterP[P229, 200]; RegisterP[P130, 100]; RegisterP[P131, 100]; RegisterP[P132, 100]; RegisterP[P133, 100]; RegisterP[P134, 100]; RegisterP[P135, 100]; RegisterP[P136, 100]; RegisterP[P137, 100]; RegisterP[P138, 100]; RegisterP[P139, 100]; RegisterP[Pf40, 50]; RegisterP[Pf41, 50]; RegisterP[Pf42, 50]; RegisterP[Pf43, 50]; RegisterP[Pf44, 50]; RegisterP[Pf45, 50]; RegisterP[Pf46, 50]; RegisterP[Pf47, 50]; RegisterP[Pf48, 50]; RegisterP[Pf49, 50]; }; LoW: PROC [r: REAL] RETURNS [UNSPECIFIED] ~ { card: LONG CARDINAL _ LOOPHOLE[r]; cardinal: CARDINAL _ card - 10000H*(card/10000H); RETURN[LOOPHOLE[cardinal]]; }; HiW: PROC [r: REAL] RETURNS [UNSPECIFIED] ~ { card: LONG CARDINAL _ LOOPHOLE[r]; cardinal: CARDINAL _ card/10000H; RETURN[LOOPHOLE[cardinal]]; }; LoB: PROC [u: UNSPECIFIED] RETURNS [PrincOps.op] ~ { card: CARDINAL _ LOOPHOLE[u]; RETURN[LOOPHOLE[card - 100H*(card/100H)]]; }; HiB: PROC [u: UNSPECIFIED] RETURNS [PrincOps.op] ~ { card: CARDINAL _ LOOPHOLE[u]; RETURN[LOOPHOLE[card/100H]]; }; <> <> arg1: PrincOps.op = 4; arg2: PrincOps.op = 6; arg3: PrincOps.op = 8; arg4: PrincOps.op = 10; arg5: PrincOps.op = 12; temp1: PrincOps.op = 14; temp2: PrincOps.op = 16; procTemp: PrincOps.op = 18; MC25: PROC ~ TRUSTED MACHINE CODE { zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; zNOOP; }; MC50: PROC ~ INLINE {MC25[]; MC25[]}; MC100: PROC ~ INLINE {MC25[]; MC25[]; MC25[]; MC25[]}; MC200: PROC ~ INLINE {MC25[]; MC25[]; MC25[]; MC25[]; MC25[]; MC25[]; MC25[]; MC25[]}; MC400: PROC ~ INLINE {MC200[]; MC200[]}; MC600: PROC ~ INLINE {MC200[]; MC200[]; MC200[]}; MC1000: PROC ~ INLINE {MC200[]; MC200[]; MC200[]; MC200[]; MC200[]}; P1000: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC1000}; P1001: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC1000}; P602: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P603: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P604: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P605: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P606: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P607: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P608: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P609: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC600}; P410: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P411: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P412: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P413: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P414: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P415: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P416: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P417: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P418: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P419: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC400}; P220: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P221: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P222: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P223: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P224: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P225: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P226: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P227: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P228: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P229: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC200}; P130: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P131: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P132: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P133: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P134: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P135: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P136: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P137: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P138: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; P139: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC100}; Pf40: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf41: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf42: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf43: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf44: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf45: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf46: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf47: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf48: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; Pf49: PROC [a,b,c,d,e: REAL] RETURNS [z: REAL] ~ TRUSTED {MC50}; <> definedTokens: LIST OF TokenInfo _ NIL; procList: ProcList _ NIL; InitTokens[]; InitProcs[]; }.