C2CNamesImpl.mesa
Copyright Ó 1988, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Christian Jacobi, February 23, 1988 10:03:41 am PST
Christian Jacobi, October 5, 1990 10:35:35 am PDT
Willie-s, September 24, 1991 6:08 pm PDT
DIRECTORY
Ascii,
CardTab,
C2CBasics,
C2CNames,
C2CTarget,
IntCodeDefs,
IntCodeUtils,
IO,
RefText,
Rope,
SymTab;
C2CNamesImpl:
CEDAR
PROGRAM
IMPORTS Ascii, CardTab, C2CBasics, C2CTarget, IntCodeUtils, IO, RefText, Rope, SymTab
EXPORTS C2CNames =
BEGIN
OPEN C2CBasics, IntCodeDefs;
ROPE: TYPE = Rope.ROPE;
caseForReservedWords: BOOL = FALSE;
caseForIdentifiers: BOOL = TRUE;
reservedWords: SymTab.Ref ¬ SymTab.Create[case: caseForReservedWords];
warningTheProgramNameWillBeWrong: SIGNAL = CODE;
prefixForNamedProc:
ROPE ¬ "P"; <<a name is in the names file>>
prefixForMentionedProc: ROPE ¬ "Q"; <<number is, but name is not in names file>>
prefixForUnNamedProc: ROPE ¬ "L"; <<neither name nor number in names file>>
prefixForNamedVar:
ROPE ¬ "v"; <<a name ...>>
prefixForMentionedVar: ROPE ¬ "w"; <<number ...>>
prefixForUnNamedVar: ROPE ¬ "c"; <<neither ...>>
Environment: TYPE = REF EnvRep;
EnvRep:
TYPE =
RECORD [
table: SymTab.Ref,
fiddleCnt: INT ¬ 0,
localCnt: INT ¬ 0,
externProcTab: IntCodeUtils.IdTab,
labIdToNameTable: IntCodeUtils.IdTab ¬ NIL,
varIdToNameTable: IntCodeUtils.IdTab ¬ NIL,
macroNames: SymTab.Ref ¬ NIL,
programName: ROPE ¬ NIL
];
environment: Environment;
AssociateNames:
PUBLIC
PROC [names, labels: CardTab.Ref, externProcs: SymTab.Ref] = {
env: Environment ¬ environment;
EachLabel: CardTab.EachPairAction = {
WITH val
SELECT
FROM
r:
ROPE => {
IF key=0 THEN NameThisProgram[r];
IF externProcs#
NIL
THEN {
name: ROPE ¬ NARROW[SymTab.Fetch[externProcs, r].val];
IF name#
NIL
THEN {
NameThisExternalProcedure[LOOPHOLE[key], name];
[] ¬ IntCodeUtils.Store[env.externProcTab, LOOPHOLE[key], name];
RETURN;
};
};
NameThisProcedure[env, LOOPHOLE[key], r];
};
ENDCASE => {};
};
EachName: CardTab.EachPairAction = {
WITH val
SELECT
FROM
r: ROPE => NameThisVariable[env, LOOPHOLE[key], r];
ENDCASE => {};
};
PreprocessMachineCodes:
PROC [machineCodeNode: MachineCodeNode] = {
IF Rope.Length[machineCodeNode.bytes]>0
AND Rope.Fetch[machineCodeNode.bytes, 0]='^
THEN {
IF Rope.Equal["^ExternalNames", Rope.Substr[machineCodeNode.bytes, 0, 14],
FALSE]
THEN {
line: REF TEXT ¬ RefText.ObtainScratch[200];
stream: IO.STREAM ¬ IO.RIS[machineCodeNode.bytes];
WhiteText:
PROC [t:
REF
TEXT]
RETURNS [
BOOL] = {
IF t=NIL THEN RETURN [TRUE];
RETURN [RefText.SkipOver[line, 0, " \l\r"]>=t.length];
};
ScanOneLine:
PROC [line:
REF
TEXT] = {
ENABLE {
IO.Error => GOTO syntaxError;
IO.EndOfStream => GOTO eof;
};
cedarName, cName: Rope.ROPE;
lineStream: IO.STREAM ¬ IO.TIS[line];
cedarName ¬ IO.GetID[lineStream];
[cName, ] ¬ IO.GetTokenRope[lineStream, BreakCName ! IO.EndOfStream => CONTINUE];
IF Rope.IsEmpty[cName] THEN cName ¬ cedarName;
[] ¬ SymTab.Insert[externProcs, cedarName, cName];
EXITS
syntaxError => C2CBasics.FatalError["^ExternalNames machine code"];
eof => NULL;
};
IF externProcs=NIL THEN externProcs ¬ SymTab.Create[];
IF handledMachineCodes=NIL THEN handledMachineCodes ¬ SymTab.Create[];
IF ~SymTab.Insert[handledMachineCodes, machineCodeNode.bytes, $x]
THEN {
C2CBasics.FatalError["^ExternalNames machine code used twice"];
};
[] ¬ IO.GetLine[stream, line];
DO
line ¬ IO.GetLine[stream, line ! IO.EndOfStream => {RefText.ReleaseScratch[line]; GOTO done}];
IF ~WhiteText[line] THEN ScanOneLine[line];
ENDLOOP;
EXITS done => {}
};
}
};
FindNamesMachineCodes: IntCodeUtils.Visitor = {
WITH node
SELECT
FROM
machineCodeNode: MachineCodeNode => {
PreprocessMachineCodes[machineCodeNode];
};
ENDCASE => {};
IntCodeUtils.MapNode[node, FindNamesMachineCodes];
RETURN [node];
};
handledMachineCodes: SymTab.Ref ¬ NIL;
[] ¬ FindNamesMachineCodes[C2CBasics.rootNode];
IF labels#NIL THEN [] ¬ CardTab.Pairs[labels, EachLabel];
IF names#NIL THEN [] ¬ CardTab.Pairs[names, EachName];
};
BreakCName:
IO.BreakProc = {
RETURN [
SELECT char
FROM
Ascii.SP, Ascii.TAB, ',, ':, '; => sepr,
ENDCASE => other]
};
ScanExterns:
PUBLIC
PROC [stream:
IO.
STREAM]
RETURNS [externs: SymTab.Ref] = {
error: BOOL ¬ FALSE;
initialized: BOOL ¬ FALSE;
line, buffer: REF TEXT;
lineNo: INT ¬ 0;
ScanLine:
PROC [line:
REF
TEXT] = {
ENABLE {
IO.Error => GOTO oops;
IO.EndOfStream => GOTO eof;
};
name1, name2: Rope.ROPE; token: REF TEXT ¬ NIL;
st: IO.STREAM ¬ IO.TIS[line];
--read id number
[] ¬ IO.SkipWhitespace[st];
SELECT
IO.PeekChar[st]
FROM
'- => RETURN; --comment line
IN ['a..'z], IN ['A..'Z] => name1 ¬ IO.GetID[st];
ENDCASE => {GOTO oops}; --error
[token, ] ¬ IO.GetToken[st, BreakCName, buffer ! IO.EndOfStream => CONTINUE];
name2 ¬ Rope.FromRefText[token];
IF Rope.IsEmpty[name2] THEN name2 ¬ name1;
IF initialized
THEN {
[] ¬ SymTab.Insert[externs, name1, name2];
}
ELSE {
IF Rope.Equal[name1, "extern",
FALSE]
AND Rope.Equal[name2, "procs",
FALSE]
THEN initialized ¬ TRUE
ELSE C2CBasics.FatalError["externProcs file missing header"]
};
EXITS
oops => C2CBasics.FatalError[IO.PutFR1["externProcs file error on line %g", IO.int[lineNo]]];
eof => NULL;
};
IF stream#
NIL
THEN {
line ¬ RefText.ObtainScratch[100];
buffer ¬ RefText.ObtainScratch[100];
externs ¬ SymTab.Create[5];
DO
lineNo ¬ lineNo+1;
line ¬
IO.GetLine[stream, line
!
IO.EndOfStream => {
RefText.ReleaseScratch[line]; RefText.ReleaseScratch[buffer];
GOTO done
}
];
ScanLine[line];
ENDLOOP;
};
EXITS done => NULL;
};
IsExtern:
PUBLIC PROC [id: LogicalId]
RETURNS [
BOOL] = {
IF IntCodeUtils.Fetch[environment.externProcTab, id]#NIL THEN RETURN [TRUE];
RETURN [FALSE];
};
Include:
PROC [proposal:
ROPE, env: Environment]
RETURNS [done:
BOOL] =
INLINE {
--Tries to register a name proposal for this environment
--Returns done: succeeded registering exactly this name.
IF SymTab.Fetch[reservedWords, proposal].found THEN RETURN [FALSE];
done ¬ SymTab.Insert[env.table, proposal, $included]
};
TryName:
PUBLIC
PROC [try:
ROPE]
RETURNS [
ROPE] = {
RETURN [FinishUpName[environment, try, FALSE]];
};
InternalName:
PUBLIC PROC [class:
ROPE]
RETURNS [
ROPE] = {
--class is made up by c2c; no checking necessary
env: Environment ¬ environment;
IF Rope.IsEmpty[class] THEN class ¬ "x";
DO
try: ROPE ¬ IO.PutFR["%g%g", IO.rope[class], IO.int[env.localCnt ¬ env.localCnt+1]];
try ¬ Rope.Flatten[try];
IF Include[try, env] THEN RETURN [try]
ENDLOOP;
};
FinishUpName:
PROC [env: Environment, base:
ROPE, fiddled:
BOOL]
RETURNS [
ROPE] = {
--Guarantees uniqueness of name. Declares and returns the name
--base is already short enough and a legal identifier.
--fiddled: base is already fiddled
--Fiddles more if necessary
base ¬ Rope.Flatten[base];
IF ~fiddled AND Include[base, env] THEN RETURN [base];
DO
try: ROPE ¬ IO.PutFR["%g�%g", IO.rope[base], IO.int[env.fiddleCnt ¬ env.fiddleCnt+1]];
try ¬ Rope.Flatten[try];
IF Include[try, env] THEN RETURN [try]
ENDLOOP;
};
Name:
PROC [number:
INT, prefix:
ROPE, base:
ROPE¬NIL]
RETURNS [name:
ROPE] = {
--concatenates a name from a number, a prefiz and a base
--no registration yet
name ¬
IF number<0
THEN IO.PutFR["%g0%g", IO.rope[prefix], IO.int[-number]]
ELSE IO.PutFR["%g%g", IO.rope[prefix], IO.int[number]];
IF base#NIL THEN name ¬ Rope.Cat[base, "←", name];
};
NameThisVariable:
PROC [env: Environment, id: VariableId, name:
ROPE] = {
fiddled: BOOL ¬ FALSE; prefix: ROPE;
IF id=nullVariableId THEN CantHappen;
WITH IntCodeUtils.Fetch[env.varIdToNameTable, id]
SELECT
FROM
r: ROPE => CantHappen;
ENDCASE => NULL;
IF Rope.IsEmpty[name]
THEN {
prefix ¬ prefixForMentionedVar;
name ¬ "noName";
}
ELSE {
prefix ¬ prefixForNamedVar;
[name, fiddled] ¬ Identifier[name];
};
name ¬ FinishUpName[env, Name[id, prefix, name], fiddled];
[] ¬ IntCodeUtils.Store[env.varIdToNameTable, id, name];
};
NameThisProcedure:
PROC [env: Environment, id: LogicalId, name:
ROPE] = {
fiddled: BOOL ¬ FALSE; prefix: ROPE;
IF id=nullLogicalId THEN CantHappen;
WITH IntCodeUtils.Fetch[env.labIdToNameTable, id]
SELECT
FROM
r: ROPE => CantHappen;
ENDCASE => NULL;
IF Rope.IsEmpty[name]
THEN {
prefix ¬ prefixForMentionedProc;
name ¬ "NoName";
}
ELSE {
prefix ¬ prefixForNamedProc;
[name, fiddled] ¬ Identifier[name];
};
name ¬ FinishUpName[env, Name[id, prefix, name], fiddled];
[] ¬ IntCodeUtils.Store[env.labIdToNameTable, id, name];
};
NameThisProgram:
PROC [proposal:
ROPE ¬ NIL] = {
The program name is not used unmodifyed as a c identifier. Since it is prepended with XR←Install← or similar prefix, it is not reserved or checked for uniqueness.
The procedure containing the program gets also a standard name like any other procedure.
env: Environment ¬ environment;
fiddled: BOOL;
IF env.programName#NIL THEN CantHappen;
IF proposal=NIL THEN proposal ¬ "module";
[env.programName, fiddled] ¬ Identifier[proposal];
IF fiddled
THEN {
SIGNAL warningTheProgramNameWillBeWrong
};
};
NameThisExternalProcedure:
PROC [id: LogicalId, name:
ROPE] = {
--no syntax checking on name...
same: ROPE;
env: Environment ¬ environment;
IF id=nullLogicalId THEN CantHappen;
WITH IntCodeUtils.Fetch[env.labIdToNameTable, id]
SELECT
FROM
r: ROPE => C2CBasics.FatalError[Rope.Concat["failed to name external proc ", name]];
ENDCASE => NULL;
IF Rope.IsEmpty[name] THEN C2CBasics.FatalError["external proc with empty name"];
same ¬ TryName[name];
IF
NOT Rope.Equal[name, same]
THEN
C2CBasics.FatalError[Rope.Cat["external proc ", name, " used for multiple procedures"]];
[] ¬ IntCodeUtils.Insert[env.labIdToNameTable, id, name];
};
VarName:
PUBLIC
PROC [id: VariableId, class:
ROPE]
RETURNS [
ROPE] = {
env: Environment ¬ environment;
IF id=nullVariableId THEN CantHappen;
WITH IntCodeUtils.Fetch[env.varIdToNameTable, id]
SELECT
FROM
r: ROPE => RETURN [r];
ENDCASE => NULL;
BEGIN
--it does NOT have a programmer defined name
name: ROPE;
IF Rope.IsEmpty[class] THEN class ¬ "noName";
name ¬ FinishUpName[env, Name[id, prefixForUnNamedVar, class], FALSE];
[] ¬ IntCodeUtils.Store[env.varIdToNameTable, id, name];
RETURN [name]
END;
};
LabName:
PUBLIC
PROC [id: LogicalId, class:
ROPE]
RETURNS [
ROPE] = {
env: Environment ¬ environment;
IF id=nullLogicalId THEN CantHappen;
WITH IntCodeUtils.Fetch[env.labIdToNameTable, id]
SELECT
FROM
r: ROPE => RETURN [r];
ENDCASE => NULL;
BEGIN
--it does NOT have a programmer defined name
name: ROPE;
IF Rope.IsEmpty[class] THEN class ¬ "NoName";
name ¬ FinishUpName[env, Name[id, prefixForUnNamedProc, class], FALSE];
[] ¬ IntCodeUtils.Store[env.labIdToNameTable, id, name];
RETURN [name];
END;
};
ProgramName:
PUBLIC
PROC []
RETURNS [name:
ROPE] = {
env: Environment ¬ environment;
IF env.programName#NIL THEN RETURN [env.programName];
env.programName ¬ name ¬ TryName["module"];
};
maxLeng: INT ¬ C2CTarget.idMaxLength-12; --Offset for UnderScore+number+UnderScore+number
Identifier:
PROC [r:
ROPE]
RETURNS [id:
ROPE, fiddled:
BOOL¬FALSE] = {
--No underscore. Removes funny characters, cut to maximum length.
--fiddled if r#id for whatever reason
first: BOOL ¬ TRUE;
Trans: Rope.TranslatorType = {
retVal: CHAR;
SELECT
TRUE
FROM
Ascii.Letter[old] => retVal ¬ old;
Ascii.Digit[old] AND ~first => retVal ¬ old;
old='← => retVal ¬ old;
ENDCASE => {retVal ¬ 'x; fiddled¬TRUE};
first ¬ FALSE;
RETURN[retVal];
};
IF Rope.Length[r]>maxLeng
THEN {
fiddled ¬ TRUE;
r ¬ Rope.Substr[base: r, len: maxLeng];
};
id ¬ Rope.Translate[base: r, translator: Trans];
IF Rope.IsEmpty[id] THEN id ¬ "x";
};
PreDeclare:
PUBLIC
PROC [id:
ROPE¬NIL] = {
env: Environment ¬ environment;
[] ¬ SymTab.Store[env.table, id, $x];
};
Reserve:
PUBLIC
PROC [r:
ROPE]
RETURNS [sameRope:
ROPE] = {
IF ~SymTab.Insert[reservedWords, r, r]
THEN {
SIGNAL C2CBasics.NotYetImpl; --keyword reserved repeatedly
};
sameRope ¬ r;
};
NewModule:
PROC = {
environment ¬
NEW[EnvRep ¬ [
table: SymTab.Create[case: caseForIdentifiers],
externProcTab: IntCodeUtils.NewIdTab[],
labIdToNameTable: IntCodeUtils.NewIdTab[],
varIdToNameTable: IntCodeUtils.NewIdTab[],
macroNames: SymTab.Create[]
]]
};
C2CBasics.CallbackWhenC2CIsCalled[NewModule];
END.