<<>> <> <> <> <> <> 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]; }; <> <<(to convert to non-Cedar, replace NARROW with LOOPHOLE)>> <<>> <> <<>> 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.