IntCodeTwig.mesa
Copyright Ó 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) July 18, 1989 4:27:30 pm PDT
JKF July 27, 1988 8:17:53 am PDT
Willie-s, September 23, 1991 6:00 pm PDT
DIRECTORY
Basics USING [LongNumber],
Basics16 USING [BITOR, BITXOR],
IntCodeDefs USING [Label, LogicalId, Node, NodeList, NodeRep, nullVariableFlags, Var, VariableFlag, VariableFlags, VarList],
IntCodeUtils USING [Fetch, IdTab, Store];
IntCodeTwig: CEDAR DEFINITIONS
IMPORTS Basics16, IntCodeUtils
= BEGIN OPEN IntCodeDefs, IntCodeUtils;
DoModule: PROC [module: Node, switches: Switches] RETURNS [BaseModel];
Switches: TYPE = PACKED ARRAY CHAR['a..'z] OF BOOL;
processes the node for the module, returning a model for the module
Duplicate: SIGNAL;
Signalled when a duplicate variable or lable is found
Logical register declarations
LogicalRegister: TYPE = RECORD [
kind: LogicalRegisterKind,
offset: INT
];
LogicalRegisterKind: TYPE = MACHINE DEPENDENT {
local (0), -- a local register used for local variables
global (1), -- a global register
constant (2), -- a constant register
last (255)}; -- just in case we need this many
IdToRegister: PROC [id: LogicalId] RETURNS [LogicalRegister] = INLINE {
ln: Basics.LongNumber ¬ [int[id]];
reg: LogicalRegister;
reg.kind ¬ VAL[ln.hh];
ln.hi ¬ Basics16.BITXOR[ln.hl, 100B] - 100B;
reg.offset ¬ ln.int;
RETURN [reg];
};
RegisterToId: PROC [reg: LogicalRegister] RETURNS [LogicalId] = INLINE {
ln: Basics.LongNumber ¬ [int[reg.offset]];
IF (Basics16.BITXOR[ln.hl, 100B] - 100B) # ln.hi THEN ERROR;
ln.hh ¬ ORD[reg.kind];
RETURN [ln.int];
};
Variable flag goodies
OrVarFlags: PROC [var: Var, flags: VariableFlags] = INLINE {
var.flags ¬ LOOPHOLE[Basics16.BITOR[LOOPHOLE[var.flags], LOOPHOLE[flags]]];
};
OrFlags: PROC [flags1, flags2: VariableFlags] RETURNS [VariableFlags] = INLINE {
RETURN [LOOPHOLE[Basics16.BITOR[LOOPHOLE[flags1], LOOPHOLE[flags2]]]];
};
OrFlag: PROC [flag: VariableFlag, old: VariableFlags ¬ nullVariableFlags]
RETURNS [VariableFlags] = INLINE {
old[flag] ¬ TRUE;
RETURN [old];
};
Model declarations
(to convert to non-Cedar, replace NARROW with LOOPHOLE)
The important trick here is to not allow the "user" to access any parts of the base without going through these routines.
BaseModel: TYPE = REF BaseModelRep;
BaseModelRep: TYPE = RECORD [
module: Node ¬ NIL, -- module that produced this model
labels: IdTab ¬ NIL, -- table of label definitions
decls: IdTab ¬ NIL, -- table of variable definitions
models: IdTab ¬ NIL, -- table of stack models
first: LambdaModel ¬ NIL, -- first lambda model
tail: LambdaModel ¬ NIL -- last lambda model
];
LambdaModel: TYPE = REF LambdaModelRep;
LambdaModelRep: TYPE = RECORD [
next: LambdaModel ¬ NIL, -- next model in visitation order
label: Label ¬ NIL, -- lambda label that starts this model
lambda: Lambda ¬ NIL, -- lambda that starts this model
parentModel: LambdaModel ¬ NIL, -- model for the enclosing procedure
parentLabel: Label ¬ NIL, -- label (if any) of the parent
argumentBits: INT ¬ 0, -- bits for the argument record
argVar: Var ¬ NIL, -- argument record ptr (if large)
returnBits: INT ¬ 0, -- bits for the return record
returnVar: Var ¬ NIL, -- return record ptr (if large)
memTemps: VarList ¬ NIL, -- current temps for memory
frameExtension: Var ¬ NIL, -- variable (if any) for the frame extension
memoryLink: Var ¬ NIL, -- variable (if any) pointing to the frame extension
globalLink: Var ¬ NIL, -- variable (if any) holding the global link
staticLink: Var ¬ NIL, -- variable (if any) holding the static link
entryPoint: NodeList ¬ NIL, -- first node after the frame extension has been setup
nesting: INT ¬ 0, -- nesting level for the proc
lockVar: Var ¬ NIL, -- lock variable for an ENTRY procedure
memDepth: INT ¬ 0, -- current # of memory locals in use
memMax: INT ¬ 0, -- max # of memory locals in the procedure
forceLong: BOOL ¬ FALSE, -- TRUE => force long args & rets
isCatch: BOOL ¬ FALSE]; -- TRUE iff the label is for a catch phrase lambda
Lambda: TYPE = REF lambda NodeRep;
LabelsSize: PROC [base: BaseModel] RETURNS [INT] = INLINE {
RETURN [base.labels.entries];
};
DeclsSize: PROC [base: BaseModel] RETURNS [INT] = INLINE {
RETURN [base.decls.entries];
};
ModelsSize: PROC [base: BaseModel] RETURNS [INT] = INLINE {
RETURN [base.models.entries];
};
LabelsFetch: PROC [base: BaseModel, id: LogicalId] RETURNS [Label] = INLINE {
RETURN [NARROW[IntCodeUtils.Fetch[base.labels, id]]];
};
DeclsFetch: PROC [base: BaseModel, id: LogicalId] RETURNS [Var] = INLINE {
RETURN [NARROW[IntCodeUtils.Fetch[base.decls, id]]];
};
ModelsFetch: PROC [base: BaseModel, id: LogicalId] RETURNS [LambdaModel] = INLINE {
RETURN [NARROW[IntCodeUtils.Fetch[base.models, id]]];
};
LabelsStore: PROC [base: BaseModel, id: LogicalId, label: Label] = INLINE {
IF IntCodeUtils.Store[base.labels, id, label] # NIL THEN SIGNAL Duplicate;
};
DeclsStore: PROC [base: BaseModel, id: LogicalId, var: Var] = INLINE {
IF IntCodeUtils.Store[base.decls, id, var] # NIL THEN SIGNAL Duplicate;
};
ModelsStore: PROC [base: BaseModel, id: LogicalId, model: LambdaModel] = INLINE {
IF IntCodeUtils.Store[base.models, id, model] # NIL THEN SIGNAL Duplicate;
};
END.