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<procs.first.size THEN {
procs.first.inUse _ TRUE;
RETURN [procs.first.proc, BaseOfProc[procs.first.proc]];
};
ENDLOOP;
ERROR NoProcedureAvailable[];
};

FreeProcedureUnderLock: PROC [proc: ANYPROC] ~ {
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[];
}.
NExpressProcImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Created July 11, 1984 12:57:43 pm PDT
Last edited by Eric Nickell, July 19, 1984 3:47:23 pm PDT
Michael Plass, July 31, 1985 4:26:15 pm PDT

Public Procedures
Generate the code into a list
Tokens
Given an expression, tell how many bytes will be needed for the procedure which implements them
See how much space this takes
AddToken[$
Name, LIST[
PrincOps]];
REMEMBER:  When a BOOLEAN is on the stack in this interpreter, only the least significant bit matters!!!  Bit set is TRUE.
Converting Parse Trees to Code
Maybe change this later to handle if-then-else better
Procedure-twiddling
Procedure assumes the caller has already got a lock on the monitor
AppendFcn: UNSAFE PROC [procBase: ProcBase, oldCodePos: CARDINAL, token: Token] RETURNS [codePos: CARDINAL] ~ UNCHECKED {
code: LIST OF PrincOps.op _ GetTokenInfo[token].code;
codePos _ AppendOpsToProc[procBase, oldCodePos, code];
};

AppendPushConstant: UNSAFE PROC [procBase: ProcBase, oldCodePos: CARDINAL, constant: REAL] RETURNS [codePos: CARDINAL] ~ UNCHECKED {
opList: LIST OF PrincOps.op _ LIST[
zLIW,
HiB[LoW[constant]],
LoB[LoW[constant]],
zLIW,
HiB[HiW[constant]],
LoB[HiW[constant]]
];
codePos _ AppendOpsToProc[procBase, oldCodePos, opList];
};
AppendProcCall: UNSAFE PROC [procBase: ProcBase, oldCodePos: CARDINAL, proc: ANYPROC] RETURNS [codePos: CARDINAL] ~ UNCHECKED {
opList: LIST OF PrincOps.op _ 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
];
codePos _ AppendOpsToProc[procBase, oldCodePos, opList];
};
Go through the ops given, placing them in the code at the current location pointer
Recyclable Procedures
Some frame location definitions
Initialization
ส๔˜™Icodešœ
ฯm
œ1™<J™%J™9K™+J™—š
ฯk	˜	Jšœžœžœ˜*Jšœžœ"˜3Jšœ	žœค˜ฒJšœžœ<˜OJšžœ
žœ˜Jšžœ
žœA˜IJ˜—šœžœ
ž˜Jšžœž˜&Jšžœ˜—˜Jšžœ
žœ˜—J˜
subtitle™Jšœžœ
žœžœ
˜*Jšœžœ
žœžœ
˜"Jšžœžœžœ
˜$Jšœžœ˜ šœžœ˜ J˜—šฯnœžœ
žœ
ž˜Jšœžœžœ
˜$Jšžœžœžœ˜#J˜Jš
œ˜Jšœฯc$˜=Jšœžœ
˜Jšœžœ˜#Jš
œ˜Jšœ% ˜>Jšœ, !˜MJšœ) %˜NJ˜J™J˜3J˜ Jš
œ2˜2J˜J˜ J˜J˜J˜—š
Ÿ
œžœ
žœ
žœžœ˜4Jš
œ˜J˜J˜—J˜—•StartOfExpansion[]™Jšœžœžœ˜#šœžœžœ˜Jšœžœ
˜Jšœžœ
žœ
˜Jšœž˜J˜J˜—šŸ
œžœžœžœ
˜=J™_šœ	žœžœ˜%J˜
šžœžœ
ž˜Jš
œ˜Jš
œ˜J˜J˜J˜J˜Jšžœžœ
˜—J˜'J˜—Jšœžœ˜$Jš
œ˜J˜—šŸœžœžœ˜Dšžœ	žœ
žœ(žœžœ
ž˜NJšžœžœ
žœ˜8Jš
ž˜—Jšžœ˜J˜—š
Ÿœžœžœ
žœžœ˜GJšœžœ˜Jš
œ˜Jš
œ™šžœžœ
žœžœžœ
ž˜>J˜Jš
ž˜—Jšœžœ%˜4Jšœžœ˜/J˜J˜—šŸ
œžœ˜Jšœžœ™$Jšœžœ ˜?Jšœžœ˜(Jšœžœ˜(Jšœžœ˜&Jšœžœฯoœ˜"Jšœžœกœ˜"Jšœžœกœ˜"Jšœžœกœ˜"Jšœžœกœ˜"Jšœžœ ˜?Jšœžœ/ ˜YJšœžœกœ	กœ"กœกœ˜jJšœžœ ˜@Jšœžœกœ	กœ	กœ	กœ	กœ4กœ˜”
Jšœžœกœ	กœ	กœ	กœ	กœ4กœ˜”
J™zJšœžœ&˜8Jšœžœ ˜2Jšœžœ˜)Jšœžœ&˜8Jšœžœ,˜>Jšœžœ˜#Jšœžœ˜Jšœžœ˜Jšœžœ˜Jšœžœ˜J˜J˜—J˜—™Idefaultšœ	žœžœ
žœ
˜$šœžœžœ˜M˜M˜
M˜M˜—šŸœžœžœžœžœžœ˜eJ˜šžœ	žœ
ž˜Jšœžœžœ˜1Jšœžœžœ)˜Aš
œ˜J˜	J˜6Jšžœ7˜=Jš
œ˜—š
œ	˜	J˜
Jš
œ6˜6Jš
œ6˜6JšžœN˜TJš
œ˜—š
œ
˜
J™5J˜Jš
œ6˜6Jš
œ6˜6Jš
œ6˜6Jšžœ`˜fJš
œ˜—š
œ˜J˜	Jšœžœ
˜šžœžœ
žœžœžœ
ž˜@J˜7J˜J˜Jš
ž˜—Jšžœh˜nJš
œ˜—Jšžœžœ
˜—J˜J˜—šŸœžœžœžœ˜4šžœžœ
˜
J˜J˜J˜J˜J˜J˜Jš
œ˜—J˜—šŸœžœžœ˜2Jšžœ˜"J˜—š
Ÿœžœžœžœžœ˜Jšžœžœ
˜
Jšœ	  ˜)J˜
J˜
Jšœ	 3˜<Jšžœ˜Jšœ	 '˜0Jšœ	 ˜J˜	Jš
œ˜—J˜—šŸœžœžœžœ˜?šžœžœ
˜
J˜J˜	J˜—J˜—š
Ÿœžœžœžœžœ˜HJšœžœ
˜Jšœ
žœ
žœžœ˜1šžœžœ
žœ žœžœ
ž˜Dšžœ&žœžœ
ž˜9šžœž˜Jšžœ
žœžœ
˜%Jšžœžœžœ˜/—Jš
ž˜—Jš
ž˜—J˜——™šœ
žœžœ
žœ
˜J˜—Mšœ
žœžœ
˜!šœ
žœžœ˜Mšœžœ
˜Mšœžœžœ
˜Mšœž˜M˜—šœ
žœžœ
žœ
˜"M˜—šŸ
œžœ
žœ
žœžœžœž	œ˜gšžœ(žœžœ
ž˜=šžœžœžœ˜8Jšœžœ
˜Jšžœ2˜8J˜—Jš
ž˜—Jšžœ˜J˜J˜—šŸœžœžœ˜0J™BJšžœžœ
žœ
žœ
˜šžœ(žœžœ
ž˜=Jšžœžœžœžœ˜BJš
ž˜—J˜J˜—šŸœžœ
žœžœžœž	œ˜OKšžœžœ˜Kš
œ˜K˜—šŸ
œžœ
žœžœžœž	œ˜RJš
œQ˜QJš	œ
žœ
žœ
žœžœ˜UJš
œu˜uJšœžœ˜'J˜J˜—šŸœžœ
žœžœžœž	œ˜GJ˜2Jš
œQ˜QJšœ
žœ
žœ
žœ2˜KJšœžœ
žœ
žœo˜…
Jšœžœžœ˜5Jšžœ˜Jš
œ˜Jšžœ˜J˜J˜—šŸœžœ
žœžœžœž	œ˜`Jšœ-žœกœ	กœ	กœ	กœ	กœ &˜Ÿ
J˜J˜—šŸ	œžœ
žœ"žœžœžœž	œ™yJšœžœ
žœ(™5Jš
œ6™6J™J™—šŸœžœ
žœ"žœžœžœžœž	œ™„
šœžœ
žœžœ
™#J™J™J™J™J™J™J™—J™8J™—šŸœžœ
žœ"žœžœžœžœž	œ™šœžœ
žœžœ
™#Jšœ	  ™)J™
J™
Jšœ	 3™<Jš
œ™Jšœ '™/J™—J™8J™—š
Ÿœžœ
žœ"žœž	œ˜RJšœ+žœ˜7J˜J˜—šŸœžœ
žœ"žœ
žœ
žœžœžœž	œ˜Ž
Jšœžœ˜J˜J™Ršžœžœ
žœ žœžœ
ž˜@Jšœžœ
˜Jšœžœžœžœ˜:Jš	œžœ
žœ
žœžœ˜DJšœžœžœ˜4Jšžœ˜šžœž˜Jšœžœ˜-Jšœžœ˜+Jšžœ
˜—Jšžœ˜J˜Jš
ž˜—J˜J˜—šŸ	œžœžœžœ˜3Jšœžœ#žœ˜OJšœžœ˜$J˜J˜—šŸ	œžœ˜J˜qJ˜mJ˜mJ˜mJ˜mJ˜mJ˜mJ˜mJ˜hJ˜hJ˜J˜—š
Ÿœžœžœžœžœ˜-Jšœžœ
žœžœ˜"Jšœ
žœ˜1Jšžœ
žœ˜J˜—š
Ÿœžœžœžœžœ˜-Jšœžœ
žœžœ˜"Jšœ
žœ˜!Jšžœ
žœ˜Jš
œ˜—šŸœžœžœžœ˜4Jšœžœžœ˜Jšžœ
žœ˜*J˜—šŸœžœžœžœ˜4Jšœžœžœ˜Jšžœ
žœ
˜Jš
œ˜—J˜—™™Mš
ก˜Mš
ก˜Mš
ก˜Mš
ก˜Mš
ก˜Mš
ก˜Mš
ก˜Mš
ก˜M˜—š
Ÿœžœžœ
žœ
žœ˜#M˜ฎ
M˜—MšŸœžœžœ˜%MšŸœžœžœ"˜6MšŸœžœžœB˜VMšŸœžœžœ˜(MšŸœžœžœ˜1šŸœžœžœ/˜DM˜—MšŸœžœ
žœžœžœžœ
˜CMšŸœžœ
žœžœžœžœ
˜CMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ	˜AMšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@MšŸœžœ
žœžœžœžœ˜@—™Mšœžœ
žœ
žœ
˜'Mšœžœ
˜M˜M˜
M˜—J˜—…—<”Xึ