
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;

Duplicate: SIGNAL;
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];
};

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];
};
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.

   X  
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
processes the node for the module, returning a model for the module
Signalled when a duplicate variable or lable is found
Logical register declarations
Variable flag goodies
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.

 Э╩ю  ХNewlineDelimiter
Ц(cedarcode) styleЩ codeЪЬЩKЪЬ
╧eЬCЩNKЩ0KЩ KЩ(ЧKШ Ъ╧k	Ш	KЪЬЮЬШKЪЬ	ЮЬЮЬЮЬШKЪЬЮЬkШ|KЪЬЮЬШ)ЧheadЪЬЮЬЮШKЪЮЬШKЪЬЮЬЮЬШ'KШ ЧЪ╧nЬЮЬ$ЮЬШFKЪЬ
ЮЬЮЬЮЬЮЬ	ЮЬЮЬШ3KЪЬCЩCKШ ЧЪЬЮЬШKЪЬ5Щ5Чhead2ЪЬЩЪЬЮЬЮЬШ KЪЬШKЪЬЮШKШЦ2.0 in tabStopsЪЬЮЬЮЬЮ	ЬШ/KЦ2.0 in tabStopsЪЬ╧c,Ш7KЦ2.0 in tabStopsЪЬаШ KЦ2.0 in tabStopsЪЬаШ$KЦ2.0 in tabStopsЪЬа!Ш.ЧKШ ЧЪЯЬЮЬЮЬЮЬШGKШ"KЪЬШKЪЬЮЬШKЪЬЮЬШ,KЪЬШKЪЮЬШKШKШ ЧЪЯЬЮЬЮЬЮЬШHKЪЬ*Ш*KЪЮЬЮЬЮЬЮЬШ<KЪЬЮЬШKЪЮЬ
ШKШKШ ЧЧЩЪЯ
ЬЮЬ$ЮЬШ<KЪ	ЬЮЬ
ЮЬЮЬЮЬ
ШKKШKШ ЧЪЯЬЮЬ!ЮЬЮЬШPKЪ
ЮЬЮЬ
ЮЬЮЬ
ЮЬШFKШKШ ЧЪЯЬЮЬ>ЮЬЮЬШlKЪЬЮЬШKЪЮЬШKШЧЧЪЬЩKЪЬ"ЮЬЮЬЩ7KЩ KЩyKЩ KЪЬЮЬЮЬШ#Ц2.9 in tabStopsЪЬЮЬЮЬШKЦ2.9 in tabStopsЪЬЮЬа"Ш6KЦ2.9 in tabStopsЪЬЮЬаШ2KЦ2.9 in tabStopsЪЬЮЬа Ш4KЦ2.9 in tabStopsЪЬЮЬаШ-KЦ2.9 in tabStopsЪЬЮЬаШ/KЦ2.9 in tabStopsЪЬЮЬаШ,KЦ2.9 in tabStopsШKЦ2.9 in tabStopsШ ЧKЪЬЮЬЮЬШ'Ц2.9 in tabStopsЪЬЮЬЮЬШKЦ2.9 in tabStopsЪЬЮЬа!Ш:KЦ2.9 in tabStopsЪЬЮЬа&Ш:KЦ2.9 in tabStopsЪЬЮЬа Ш6KЦ2.9 in tabStopsЪЬЮЬа$ШDKЦ2.9 in tabStopsЪЬЮЬаШ9KЦ2.9 in tabStopsЪЬЮЬаШ6KЦ2.9 in tabStopsЪЬЮЬа!Ш4KЦ2.9 in tabStopsЪЬЮЬаШ2KЦ2.9 in tabStopsЪЬЮЬаШ5KЦ2.9 in tabStopsЪЬЮЬаШ4KЦ2.9 in tabStopsЪЬЮЬа,ШGKЦ2.9 in tabStopsЪЬЮЬа4ШKKЦ2.9 in tabStopsЪЬЮЬа,ШCKЦ2.9 in tabStopsЪЬЮЬа,ШCKЦ2.9 in tabStopsЪЬЮЬа6ШRKЦ2.9 in tabStopsЪЬ	ЮЬаШ/KЦ2.9 in tabStopsЪЬЮЬа'Ш;KЦ2.9 in tabStopsЪЬ
ЮЬа$Ш7KЦ2.9 in tabStopsЪЬЮЬа*Ш;KЦ2.9 in tabStopsЪЬЮЬЮЬа!Ш:KЦ2.9 in tabStopsЪЬ	ЮЬЮЬа╨ckа+ШJKЦ2.9 in tabStopsШ ЧЦ2.8 in tabStopsЪЬЮЬЮЬШ"KЦ2.8 in tabStopsШ ЧЪ
Я
ЬЮЬЮЬЮЬЮЬШ;KЪЮЬШKШKШ ЧЪ
Я	ЬЮЬЮЬЮЬЮЬШ:KЪЮЬШKШKШ ЧЪ
Я
ЬЮЬЮЬЮЬЮЬШ;KЪЮЬШKШKШ ЧЪЯЬЮЬ"ЮЬЮЬШMKЪЮЬЮЬ'Ш5KШKШ ЧЪЯ
ЬЮЬ"ЮЬ	ЮЬШJKЪЮЬЮЬ&Ш4KШKШ ЧЪЯЬЮЬ"ЮЬЮЬШSKЪЮЬЮЬ'Ш5KШKШ ЧЪЯЬЮЬ2ЮЬШKKЪЮЬ.ЮЬЮЬЮЬШJKШKШ ЧЪЯ
ЬЮЬ.ЮЬШFKЪЮЬ+ЮЬЮЬЮЬШGKШKШ ЧЪЯЬЮЬ8ЮЬШQKЪЮЬ.ЮЬЮЬЮЬШJKШKШ ЧKШ ЧKШ KЪЮЬШKШ Ч ЕЧ       F  