SchemePrivate.mesa
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Last changed by Pavel on March 20, 1989 3:59:26 pm PST
DIRECTORY
Rope USING [ROPE],
Scheme;
SchemePrivate: CEDAR DEFINITIONS ~
BEGIN OPEN Scheme;
Support for Tidbit, the Scheme-to-Cedar Compiler
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];
p should narrow to a TidbitCode
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];
For defining a top-level procedure implemented with a TidbitProcedure.
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];
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.
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
];
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.
Opcode: TYPE ~ MACHINE DEPENDENT {
enterB, enterH,
ENTER n
Declares the stack size at the start of a procedure's code
call0, call1, call2, call3, callB, callH,
CALL n
fn arg1 ... argn => result
Apply fn to the given arguments and leave the result on the top of the stack.
tailCall0, tailCall1, tailCall2, tailCall3, tailCallB, tailCallH,
TAIL-CALL n
Equivalent to (CALL n; RETURN) except that the CALL is done tail-recursively.
jumpB, jumpH,
JUMP pc
Unconditional jump. The first opcode in a compiled-code object is at pc = 0.
tJumpB, tJumpH,
TJUMP pc
val =>
Conditional jump. If val is true, then jump, else continue.
fJumpB, fJumpH,
FJUMP pc
val =>
Conditional jump. If val is false, then jump, else continue.
pushLiteral1, pushLiteral2, pushLiteral3, pushLiteral4, pushLiteralB, pushLiteralH,
PUSH-LITERAL index
=> val
Push the index'th value from the literals table onto the stack
pushGlobal0, pushGlobal1, pushGlobal2, pushGlobal3, pushGlobalB, pushGlobalH,
PUSH-GLOBAL index
=> val
Push the value of the index'th binding from the global-bindings table onto the stack
pushLocal0B, pushLocalBB, pushLocalBH,
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,
POP
val =>
Discard the top of stack.
popGlobalB, popGlobalH,
POP-GLOBAL index
val =>
Pop the stack, storing the old top into the value of the index'th binding from the global-bindings table
popLocalBB, popLocalBH,
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
closeB, closeH,
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
RETURN
Invoke the continuation of this procedure application with the current top of stack, which should be the entire contents of the stack.
};
ByteCodes: TYPE ~ REF ByteCodesRep;
ByteCodesRep: TYPE ~ RECORD [PACKED SEQUENCE size: NAT OF BYTE];
ByteCodeTemplate: TYPE ~ REF ByteCodeTemplateRep;
These can be written by binary-write and read in again by read.
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.