
DIRECTORY
Rope USING [ROPE],
Scheme;

SchemePrivate: CEDAR DEFINITIONS ~
BEGIN OPEN Scheme;
PairSeq: TYPE ~ REF PairSeqRep;
PairSeqRep: TYPE ~ RECORD [pairs: SEQUENCE length: NAT OF Pair];

Readable: TYPE ~ REF ANY; -- A ROPE, REF TEXT, String or ATOM, to coerce into a symbol.

LookupCell: PROC [env: Environment, name: Any] RETURNS [Pair];

CloseProcedure: PROC [p: Any, env: Environment] RETURNS [TidbitProcedure];

ReadRopeVector: PROC [rope: Rope.ROPE] RETURNS [SimpleVector];

SV1: PROC [Any] RETURNS [SimpleVector];
SV2: PROC [Any, Any] RETURNS [SimpleVector];
SV3: PROC [Any, Any, Any] RETURNS [SimpleVector];
SV4: PROC [Any, Any, Any, Any] RETURNS [SimpleVector];
SV5: PROC [Any, Any, Any, Any, Any] RETURNS [SimpleVector];
SV6: PROC [Any, Any, Any, Any, Any, Any] RETURNS [SimpleVector];
SV7: PROC [Any, Any, Any, Any, Any, Any, Any] RETURNS [SimpleVector];

MakeTidbitCode: PROC [
identifiers: Rope.ROPE, -- name, followed by 2 lists in read form: local names, then global names
env: Environment, -- global environment
nArgs: INTEGER, -- number of arguments, including rest; negative if dotted.
proc: TidbitCodeProc, -- the implementation procedure
literals: Any, -- A SimpleVector or a LIST OF REF; use SV*, above
initialPC: INTEGER, -- the initial pc for this procedure
doc: Rope.ROPE, -- documentation
ext: REF ¬ NIL -- for extensions (such as debugging info)
] RETURNS [TidbitCode];

DefineProcedure: PROC [name: Rope.ROPE, nArgs: NAT, envNames: LIST OF REF, dotted: BOOL, proc: TidbitCodeProc, doc: Rope.ROPE, env: Environment, lexicalEnv: Environment ¬ NIL, initialPC: INTEGER ¬ 0, globalNames: LIST OF REF ¬ NIL, literals: SimpleVector ¬ NIL, optional: NAT ¬ 0];

TidbitProcedure: TYPE ~ REF TidbitProcedureRep;
TidbitProcedureRep: TYPE ~ RECORD [
code: TidbitCode,
env: Environment -- The procedure's enclosing environment
];

TidbitCode: TYPE ~ REF TidbitCodeRep;
TidbitCodeRep: TYPE ~ RECORD [
name: Any, -- for debugging purposes
envNames: SimpleVector, -- of Symbols
dotted: BOOL, -- if TRUE, allow extra args
minArgs: NAT, -- minimum number of args
maxArgs: NAT, -- max. number of args, not including rest
proc: TidbitCodeProc, -- the implementation procedure
globalBindings: PairSeq, -- The global bindings referred to by this procedure
literals: SimpleVector, -- The random constants referred to by this procedure
initialPC: INTEGER, -- the initial pc for this procedure
doc: Rope.ROPE, -- documentation
ext: REF -- for extensions (such as debugging info)
];

TidbitCodeProc: TYPE ~ PROC [a: Activation];

smallActivationSize: NAT ~ 20;

Stack: TYPE ~ REF StackRep;
StackRep: TYPE ~ ARRAY [0..smallActivationSize) OF Any;

Activation: TYPE ~ REF ActivationRep;
ActivationRep: TYPE ~ RECORD [
link: Activation, -- For linking these together
env: Environment, -- This procedure's local environment (not the one it is closed in)
fluidBindings: Any, -- The fluid variable environment
code: TidbitCode, -- self
shared: BOOL ¬ FALSE, -- if TRUE, copy-on-write
bottom: NAT, -- Index into s of proc & args
n: NAT, -- Number of things to Apply (including proc); zero => don't apply
pc: INTEGER, -- program counter used by SELECT in TidbitCodeProc; -1 => don't continue
s: Stack, -- stack for evaluated arguments
sEx: SimpleVector ¬ NIL -- stack extension for overflow from s
];


Opcode: TYPE ~ MACHINE DEPENDENT {
enterB, enterH,
call0, call1, call2, call3, callB, callH,
tailCall0, tailCall1, tailCall2, tailCall3, tailCallB, tailCallH,
jumpB, jumpH,
tJumpB, tJumpH,
fJumpB, fJumpH,
pushLiteral1, pushLiteral2, pushLiteral3, pushLiteral4, pushLiteralB, pushLiteralH,
pushGlobal0, pushGlobal1, pushGlobal2, pushGlobal3, pushGlobalB, pushGlobalH,
pushLocal0B, pushLocalBB, pushLocalBH,
pop,
popGlobalB, popGlobalH,
popLocalBB, popLocalBH,
closeB, closeH,
return
};

ByteCodes: TYPE ~ REF ByteCodesRep;
ByteCodesRep: TYPE ~ RECORD [PACKED SEQUENCE size: NAT OF BYTE];

ByteCodeTemplate: TYPE ~ REF ByteCodeTemplateRep;
ByteCodeTemplateRep: TYPE ~ RECORD [
name: Any, -- for debugging purposes
envNames: SimpleVector,	-- of symbols
dotted: BOOL, -- if TRUE, allow extra args
minArgs: NAT, -- minimum number of args
maxArgs: NAT, -- max. number of args, not including rest
globalNames: ProperList, 	-- list of symbols, the globals referenced in this procedure
literals: ProperList,	-- literals[0] should be a ByteCodes object, the code itself.  The other literals may include other ByteCodeTemplates representing nested procedures.
doc: Rope.ROPE, -- documentation
ext: Any -- for extensions (such as debugging info)
];

ProcedureFromByteCodeTemplate: PROC [template: ByteCodeTemplate, env: Environment] RETURNS [Procedure];

END.
  "  
SchemePrivate.mesa
Copyright Ó 1991 by Xerox Corporation.  All rights reserved.
Last changed by Pavel on March 20, 1989 3:59:26 pm PST
Support for Tidbit, the Scheme-to-Cedar Compiler
p should narrow to a TidbitCode
For defining a top-level procedure implemented with a TidbitProcedure.
On call (first time entry):
a.pc = a.code.initialPC, and a.env has been initialized with the incoming arguments
a.shared is FALSE (the compiled code is free to write this copy)
a.sEx is NIL
On subsequent re-entry:
everything in a is as it was at the last exit, except that a.s[a.bottom] is the value.
a.n and the stack above a.s[a.bottom] should be ignored.
On return:
If a.n > 0, then a.s[a.bottom] contains a procedure to be applied to the arguments in a.s[a.bottom+1] ... a.s[a.bottom+a.n-1]
If a.pc < 0 and a.n > 0, this is a tail call.
If a.pc < 0 and a.n = 0, the result is the item left in a.s[0]
N.B.  The references to a.s[i] above are really to a.sEx[i-smallActivationSize] whenever i>=smallActivationSize.
Support for the ByteCode Interpreter
Opcodes each occupy one byte.
codes ending with B take a one-byte parameter.
codes ending with H take a two-byte big-endian parameter.
codes ending with a digit specify their parameter with no extra bytes.
ENTER n
Declares the stack size at the start of a procedure's code
CALL n
fn arg1 ... argn  =>  result
Apply fn to the given arguments and leave the result on the top of the stack.
TAIL-CALL n
Equivalent to (CALL n; RETURN) except that the CALL is done tail-recursively.
JUMP pc
Unconditional jump.  The first opcode in a compiled-code object is at pc = 0.
TJUMP pc
val  =>
Conditional jump.  If val is true, then jump, else continue.
FJUMP pc
val  =>
Conditional jump.  If val is false, then jump, else continue.
PUSH-LITERAL index
=>  val
Push the index'th value from the literals table onto the stack
PUSH-GLOBAL index
=> val
Push the value of the index'th binding from the global-bindings table onto the stack
PUSH-LOCAL up over
=> val
Push the value found in the over'th slot of the up'th environment along the parent chain, starting with the current environment, onto the stack
POP
val =>
Discard the top of stack.
POP-GLOBAL index
val =>
Pop the stack, storing the old top into the value of the index'th binding from the global-bindings table
POP-LOCAL up over
val =>
Pop the stack, storing the old top into the over'th slot of the up'th environment along the parent chain, starting with the current environment
CLOSE index
=> fn
Close the compiled-code object at the index'th position in the literals table in the current environment and push the resulting procedure onto the stack
RETURN
Invoke the continuation of this procedure application with the current top of stack, which should be the entire contents of the stack.
These can be written by binary-write and read in again by read.
Ê	  •NewlineDelimiter
–(cedarcode) style™ šœ™Jšœ
Ïeœ1™<Icode™6—K˜ šÏk	˜	Kšœžœžœ˜Kšœ˜—K˜ KšÐlnœžœžœ˜"Kšžœžœ˜head™0Kšœ	žœžœ˜šœžœžœ	žœ	žœžœ˜@K˜ —Kšœ
žœžœžœÏc=˜WK˜ šÏn
œžœžœ˜>K˜ —š¡œžœžœ˜JKšœ™K˜ —š¡œžœžœžœ˜>K˜ —Kš¡œžœžœ˜'Kš¡œžœžœ˜,Kš¡œžœžœ˜1Kš¡œžœžœ˜6Kš¡œžœžœ˜;Kš¡œžœ žœ˜@Kš¡œžœ%žœ˜EK˜ š¡œžœ˜Kšœžœ I˜aKšœ ˜'Kšœžœ ;˜KKšœ ˜5Kšœ 2˜AKšœžœ $˜8Kšœ
žœ ˜ Kšœžœžœ *˜9Kšœžœ˜K˜ —š"¡œžœžœ	žœžœžœžœ
žœ"žœ.žœžœžœžœžœžœžœžœ˜™KšœF™FK˜ —Kšœžœžœ˜/šœžœžœ˜#Kšœ˜K•StartOfExpansionÙ -- [ROPE: TYPE _ ROPE, EXPR: TYPE _ EXPR: TYPE = REF MathExpr.MathExprRep; MathExpr.MathExprRep: TYPE = RECORD[SELECT type: {atom, compound, matrix} FROM atom => [class: MathExpr.AtomClass, value: ROPE], compound => [class: MathExpr.CompoundClass, subExprs: LIST OF MathExpr.TaggedMathExpr _ NIL], matrix => [class: MathExpr.MatrixClass, nRows: INT, nCols: INT, elements: LIST OF MathExpr.TaggedMathExpr _ NIL] ENDCASE], ResetEnvironment: PROC, InstallVariable: PROC [var: ATOM, value: EXPR], LookupVariable: PROC [var: ATOM] RETURNS [value: EXPR], RemoveVariable: PROC [var: ATOM], notFound: ERROR]šœ (˜9K˜K˜ —Kšœžœžœ˜%šœžœžœ˜Kšœ ˜$Kšœ ˜%Kšœžœ ˜*Kšœ	žœ ˜'Kšœ	žœ *˜8Kšœ ˜5Kšœ 4˜MKšœ 5˜MKšœžœ $˜8Kšœ
žœ ˜ Kšœžœ *˜3Kšœ˜K˜ —šœžœžœ˜,™KšœS™SKšœ@™@K™—™K™VK™8—™
Kšœ}™}Kšœ-™-Kšœ>™>—Kšœp™pK˜ —Kšœžœ˜K˜ Kšœžœžœ
˜Kšœ
žœžœžœ˜7K˜ Kšœžœžœ˜%šœžœžœ˜Kšœ ˜/Kšœ C˜UKšœ !˜5Kšœ ˜Kšœžœžœ ˜/Kšœžœ ˜+Kšœžœ B˜JKšœžœ I˜VKšœ
  ˜*Kšœžœ &˜>Kšœ˜K˜ —K˜ —™$K™K™.K™9K™Fšœžœžœž	œ˜"˜™K™:——šœ)˜)™šœÏdœ¢œ™KšœM™M———šœA˜A™K™M——šœ˜™K™M——šœ˜™™K™<———šœ˜™™K™=———šœS˜S™™K™>———šœM˜M™™K™T———šœ&˜&™™K™———˜™™K™———˜™™K™h———˜™™K™———˜™™K™˜———˜™K™†——K˜K˜ —Kšœžœžœ˜#Kšœžœžœžœžœžœžœžœ˜@K˜ šœžœžœ˜1KšœÐfrœ£œ™?—šœžœžœ˜$Kšœ ˜$Kšœ ˜%Kšœžœ ˜*Kšœ	žœ ˜'Kšœ	žœ *˜8Kšœ <˜VKšœ dÐcr !˜«Kšœ
žœ ˜ Kšœ	 *˜3K˜—K˜ Kš¡œžœ0žœ˜gK˜ —Kšžœ˜— …—    &  &K  