CcCommandsImpl.Mesa
Copyright Ó 1988, 1991 by Xerox Corporation. All rights reserved.
Eduardo Pelegri-Llopart, February 7, 1990 9:34:12 am PST
Carl Hauser, May 23, 1988 2:42:05 pm PDT
Bill Jackson (bj) July 5, 1988 8:36:20 pm PDT
The module should be reorganized to be more rational.
Spreitze, March 13, 1990 1:17 pm PST
DIRECTORY
Args USING [ Arg, ArgRope, Error, GetRope, NArgs ],
Ascii,
BasicTime USING [ GMT ],
Commander USING [ CommandProc, Register ],
CommandTool USING [ CurrentWorkingDirectory ],
Convert,
ExtendADotOut USING [ ActionID, ActionIDFromAction, DependencyInfo, DependencyInfoRep, ObjectClassFromFileName, ObjectIDFromFile, ObjectID, PutDependencyInfo, StampFromIDs, VersionStamp ],
FS USING [ ComponentPositions, Delete, Error, ExpandName, Rename, StreamOpen ],
IO USING [ card, Close, Flush, GetRope, int, PutF, PutFR, PutRope, rope, STREAM ],
PBasics USING [LowHalf, LowByte, HighByte, BITAND, endianBitsInBytes],
PFS, PFSNames, PFSPrefixMap,
Process USING [ CheckForAbort, EnableAborts, InitializeCondition, SecondsToTicks ],
Rope USING [ Cat, Concat, Equal, Fetch, FindBackward, Flatten, Length, ROPE, Substr, Translate],
SymTab,
SystemVersion USING [machineType, MachineType],
ThisMachine USING [ ProcessorID ],
UnixErrno,
UnixStat,
UnixSysCalls USING [ GetPID, SymLink, Unlink ],
UnixSysCallExtensions USING [Spawn],
UnixTypes USING [CHARPtr, SysCallResult],
UserProfile USING [Token],
UXStrings;
CcCommandsImpl:
CEDAR
MONITOR
IMPORTS Args, Ascii, Commander, CommandTool, Convert, ExtendADotOut, FS, IO, PBasics, PFS, PFSNames, PFSPrefixMap, Process, Rope, SymTab, SystemVersion, ThisMachine, UnixErrno, UnixSysCalls, UnixSysCallExtensions, UserProfile, UXStrings ~ {
ROPE: TYPE ~ Rope.ROPE;
LOR: TYPE ~ LIST OF ROPE;
ShouldNotHappen: ERROR [message: ROPE] ~ CODE;
ForkTrouble: ERROR ~ CODE;
NYI: ERROR ~ CODE;
DeleteFiles: BOOL ~ TRUE;
Temporarily until I change SystemVersion.MachineType;
mot88000: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[14]];
amd29000: SystemVersion.MachineType ~ LOOPHOLE[20, SystemVersion.MachineType];
r2000: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[30]];
r3000: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[31]];
i386: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[40]];
i486: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[41]];
i860: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[42]];
i960: SystemVersion.MachineType ~ LOOPHOLE[SystemVersion.MachineType[43]];
Unique names for temporary (unix-host) files
uid: CARD32 ¬ 0;
processID: INT ~ UnixSysCalls.GetPID[];
processorID: ROPE ~ ThisMachine.ProcessorID[$Octal];
CshCommandString: UXStrings.UnixString ~ UXStrings.Create[from: "/bin/csh -s"];
MACHINECLASS: ROPE ~ "ComplexCc.MachineClass";
NewName:
ENTRY
PROC [suffix:
ROPE ¬ ".o", wDir:
ROPE]
RETURNS [ fName:
ROPE ] ~ {
ENABLE { UNWIND => NULL };
fName ¬ IO.PutFR["cedarCc%gFrom%g%g", IO.card[uid], IO.int[processID], IO.rope[processorID], IO.rope[suffix]];
IF
NOT Rope.Equal[wDir,
NIL]
THEN {
IF wDir.Fetch[wDir.Length[]-1] # '/ THEN wDir ¬ wDir.Cat["/"];
fName ¬ wDir.Cat[fName];
};
uid ¬ uid.SUCC;
};
Making filenames acceptable to UNIX
ViewFix:
PROC [cedar, insert:
ROPE, isDir, simpleExt, create:
BOOL, otherUnlink:
LOR]
RETURNS [unix:
ROPE ¬
NIL, unlink:
LOR ¬
NIL] ~ {
ENABLE PFS.Error => ERROR ShouldNotHappen[IO.PutFR["Got PFS.Error[%g, %g] while UXifying %g", [atom[error.code]], [rope[error.explanation]], [rope[cedar]] ]];
given: PFS.PATH ~ PFS.PathFromRope[cedar];
translated: PFS.PATH ~ PFSPrefixMap.Translate[ PFS.AbsoluteName[given]];
cedarPath: PFS.PATH ~ IF isDir THEN PFSNames.EnsureDirectory[translated] ELSE translated; --EnsureDirectory only required because Translate bogusly drops that bit (MJS March 13, 1990)
rawRope: ROPE ~ PFS.RopeFromPath[cedarPath].Flatten[]; --for debugging
viewComp: PFSNames.Component ~ cedarPath.Fetch[0];
view: ROPE ~ viewComp.ComponentRope[];
IF isDir # given.IsADirectory[] THEN ERROR ShouldNotHappen[IO.PutFR[IF isDir THEN "%g not a directory" ELSE "%g is a directory", [rope[cedar]] ]];
IF isDir AND (insert#NIL OR create OR simpleExt) THEN ERROR--not implemented because not needed--;
SELECT
TRUE
FROM
view.Equal["-ux",
FALSE] => {
viewless: PFS.PATH ~ cedarPath.ReplaceComponent[0, emptyComponent];
parent: PFS.PATH ~ viewless.Parent[];
parentRope: ROPE ~ PFS.RopeFromPath[parent];
last: PFSNames.Component ~ viewless.ShortName[];
lastRope: ROPE ~ last.ComponentRope[--PFS doesn't put in version info--];
original: ROPE ~ parentRope.Concat[lastRope];
IF insert#
NIL
THEN {
new: ROPE ~ parentRope.Cat[insert, lastRope];
GetLink[original, new];
RETURN [new, CONS[new, otherUnlink]]};
RETURN [original, otherUnlink]};
view.Equal["-vux",
FALSE] => {
full, parent: PFS.PATH;
fullLast: PFSNames.Component;
fullRope, parentRope, verfulLast, verlessLast, vuxrepRope, uxishRope: ROPE;
IF create
THEN {
out: IO.STREAM ~ PFS.StreamOpen[fileName: cedarPath, accessOptions: create];
file: PFS.OpenFile ~ PFS.OpenFileFromStream[out];
modeProp: ROPE;
dm: UnixStat.Mode;
full ¬ PFS.GetInfo[file].fullFName;
modeProp ¬ PFS.GetClientProperty[file, "UnixMode"];
dm ¬ LOOPHOLE[Convert.CardFromRope[modeProp]];
dm.owner.write ¬ true;
PFS.SetClientProperty[file, "UnixMode", Convert.RopeFromCard[LOOPHOLE[dm, CARD16], 8]];
out.Close[]}
ELSE
IF isDir
THEN {
full ¬ cedarPath.ReplaceComponent[0, emptyComponent];
unix ¬ PFS.RopeFromPath[full].Translate[translator: Lower];
RETURN [unix, otherUnlink]}
ELSE full ¬ PFS.FileInfo[cedarPath].fullFName;
fullRope ¬ PFS.RopeFromPath[full].Flatten[]; --for debugging
fullLast ¬ full.ShortName[];
parent ¬ full.Parent[].ReplaceComponent[0, emptyComponent];
parentRope ¬ PFS.RopeFromPath[parent].Translate[translator: Lower];
IF NOT parent.IsADirectory[] THEN ERROR ShouldNotHappen["PFS shouldn't be crocky!"];
IF fullLast.version.versionKind # numeric
THEN
ERROR ShouldNotHappen[
IO.PutFR["Didn't expect to find %g in file system (note version!)",
[rope[PFS.RopeFromPath[full]]] ]];
verlessLast ¬ fullLast.ComponentRope[--PFS doesn't put in version info--];
verfulLast ¬ IO.PutFR["%g.~%g~", [rope[verlessLast.Translate[translator: Lower]]], [integer[fullLast.version.version]]];
vuxrepRope ¬ parentRope.Cat[verfulLast];
IF simpleExt
OR insert#
NIL
THEN {
uxishRope ¬ parentRope.Cat[insert, verlessLast];
GetLink[vuxrepRope, uxishRope];
RETURN [uxishRope, CONS[uxishRope, otherUnlink]]}
ELSE RETURN [vuxrepRope, otherUnlink];
};
ENDCASE =>
ERROR ShouldNotHappen[
IO.PutFR["Can't apply UNIX tools to %g because of its view",
IO.rope[PFS.RopeFromPath[cedarPath]] ]];
};
emptyComponent: PFSNames.Component ~ [];
Lower:
PROC [old:
CHAR]
RETURNS [
CHAR] ~ {
RETURN Ascii.Lower[old]};
LinkData: TYPE ~ REF LinkDataRec;
LinkDataRec:
TYPE ~
RECORD [
from: ROPE,
count: NAT,
toCP: UnixTypes.CHARPtr ¬ [],
change: CONDITION];
GetLink:
ENTRY
PROC [from, to:
ROPE] ~ {
ENABLE UNWIND => NULL;
ld: LinkData ¬ NARROW[linkTab.Fetch[to].val];
IF ld=
NIL
THEN {
ld ¬ NEW [LinkDataRec ¬ [NIL, 0]];
TRUSTED {
Process.InitializeCondition[@ld.change, Process.SecondsToTicks[10]];
Process.EnableAborts[@ld.change]};
IF NOT linkTab.Insert[to, ld] THEN ERROR};
DO
SELECT
TRUE
FROM
ld.count=0 => {
fromCP: UnixTypes.CHARPtr ~ UXStrings.Create[from];
toCP: UnixTypes.CHARPtr ¬ ld.toCP ¬ UXStrings.Create[to];
res: UnixTypes.SysCallResult ¬ UnixSysCalls.SymLink[fromCP, toCP];
IF res=failure
THEN
RETURN
WITH
ERROR ShouldNotHappen[
IO.PutFR["Link from %g to %g failed; errno is %g",
IO.rope[from],
IO.rope[to],
IO.card[LOOPHOLE[UnixErrno.GetErrno[], CARD]]]];
ld.count ¬ ld.count.SUCC;
ld.from ¬ ld.from;
RETURN};
ld.from.Equal[from] => {ld.count ¬ ld.count.SUCC; RETURN};
ENDCASE => WAIT ld.change ENDLOOP;
};
linkTab: SymTab.Ref ~ SymTab.Create[case: TRUE];
DropLink:
ENTRY
PROC [to:
ROPE] ~ {
ENABLE UNWIND => NULL;
ld: LinkData ¬ NARROW[linkTab.Fetch[to].val];
IF ld=NIL OR ld.count=0 THEN RETURN WITH ERROR ShouldNotHappen[IO.PutFR["Excess dropping of link to %g", [rope[to]] ]];
ld.count ¬ ld.count.PRED;
BROADCAST ld.change;
IF ld.count=0
THEN {
res: UnixTypes.SysCallResult ~ UnixSysCalls.Unlink[ld.toCP];
IF NOT linkTab.Delete[to] THEN ERROR;
IF res = failure
THEN
RETURN
WITH
ERROR ShouldNotHappen[
IO.PutFR["Unlink failed for %g; errno is %g",
IO.rope[to],
IO.card[LOOPHOLE[UnixErrno.GetErrno[], CARD]]]];
};
RETURN};
UnlinkList:
PROC [list:
LOR] ~ {
FOR list ¬ list, list.rest
WHILE list#
NIL
DO
DropLink[list.first];
ENDLOOP;
RETURN};
ConsComponent:
PROC [name:
ROPE, version: PFSNames.Version]
RETURNS [PFSNames.Component] ~ {
RETURN [[name: [base: name, start: 0, len: name.Length[]], version: version]]};
Auxiliary Execution Procs.
MachineTypeFromMachineClass:
PROC [ machineClass:
ROPE ]
RETURNS [ machineType: SystemVersion.MachineType ] ~ {
SELECT
TRUE
FROM
Rope.Equal[machineClass, "sparc", FALSE] => machineType ¬ sun4;
Rope.Equal[machineClass, "mc68020", FALSE] => machineType ¬ sun3;
Rope.Equal[machineClass, "sun4", FALSE] => machineType ¬ sun4;
Rope.Equal[machineClass, "sun3", FALSE] => machineType ¬ sun3;
Rope.Equal[machineClass, "amd29000", FALSE] => machineType ¬ amd29000;
ENDCASE => ERROR;
};
MachineClassFromMachineType:
PROC [ machineType: SystemVersion.MachineType ]
RETURNS [ machineClass:
ROPE ] ~ {
SELECT machineType
FROM
sun4 => machineClass ¬ "sun4";
sun3 => machineClass ¬ "sun3";
amd29000 => machineClass ¬ "amd29000";
ENDCASE => machineClass ¬ "I don't know";
};
GetCommandNames:
PROC [host, target: SystemVersion.MachineType]
RETURNS [compiler, loader, move, csh:
ROPE ¬
NIL] ~ {
CompilerDefault: ROPE ~ "/usr/local/bin/ccc";
MoveDefault: ROPE ~ "/bin/mv";
LoadDefault: ROPE ~ "/bin/ld";
CshDefault: ROPE ~ "/bin/csh -s";
targetName: ROPE ~ MachineClassFromMachineType[ target ];
IF host # sun4 THEN ERROR ShouldNotHappen ["host is not a sun4"];
compiler ¬ UserProfile.Token["ComplexCc.cc", CompilerDefault];
loader ¬ UserProfile.Token["ComplexCc.ld", LoadDefault];
move ¬ UserProfile.Token["ComplexCc.mv", MoveDefault];
csh ¬ UserProfile.Token["ComplexCc.csh", CshDefault];
compiler ¬ UserProfile.Token[Rope.Cat["ComplexCc.", targetName, ".cc"], compiler];
loader ¬ UserProfile.Token[Rope.Cat["ComplexCc.", targetName, ".ld"], loader];
move ¬ UserProfile.Token[Rope.Cat["ComplexCc.", targetName, ".mv"], move];
csh ¬ UserProfile.Token[Rope.Cat["ComplexCc.", targetName, ".csh"], csh];
};
UnixNil: UnixTypes.CHARPtr ~ LOOPHOLE[NIL];
MsgFromExitError:
PROC [status:
INT, command:
ROPE]
RETURNS [msg:
ROPE] ~ {
lowHalf: CARD16 ~ PBasics.LowHalf[LOOPHOLE[status, CARD32]];
lowByte: BYTE ~ PBasics.LowByte[lowHalf];
nextLowByte: BYTE ~ PBasics.HighByte[lowHalf];
low7: BYTE;
IF lowByte = 177B
THEN {
msg ¬ IO.PutFR["execution of %g stopped by signal %g\n", IO.rope[command], IO.int[nextLowByte]];
RETURN [msg];
};
IF lowByte = 0
THEN {
msg ¬ IO.PutFR["execution of %g exited with %g\n", IO.rope[command], IO.int[nextLowByte]];
RETURN [msg];
};
SELECT PBasics.endianBitsInBytes
FROM
big => low7 ¬ PBasics.BITAND[lowByte, 077B];
little => low7 ¬ PBasics.BITAND[lowByte, 176B];
ENDCASE => ERROR;
msg ¬ IO.PutFR["execution of %g terminated due to signal %g\n", IO.rope[command], IO.int[low7]];
};
MsgFromFile:
PROC [fileName:
ROPE, delete:
BOOL ¬
TRUE]
RETURNS [msg:
ROPE] ~ {
stream: IO.STREAM;
stream ¬ FS.StreamOpen[fileName: fileName !FS.Error => { stream ¬ NIL; CONTINUE }];
IF stream #
NIL
THEN {
msg ¬ stream.GetRope[];
stream.Close[];
IF delete THEN FS.Delete[name: fileName !FS.Error => CONTINUE];
};
};
<<
HideNamesThroughLink:
PROC [dir:
ROPE, files:
LIST
OF
ROPE] ~ {
Strictly speaking this operation should be monitored against other concurrent operations; in practice, the problem should never arise
FOR list:
LIST
OF
ROPE ¬ files, list.rest
WHILE list #
NIL
DO
file: ROPE ~ list.first;
sourceRope: ROPE ~ Rope.Cat[dir, file];
destinationRope: ROPE ~ Rope.Cat[dir, "FILE-", file];
source: UnixTypes.CHARPtr ~ UXStrings.Create[sourceRope];
destination: UnixTypes.CHARPtr ~ UXStrings.Create[destinationRope];
res: UnixTypes.SysCallResult ~ UnixSysCalls.SymLink[source, destination];
IF res = failure
THEN
ERROR ShouldNotHappen[
IO.PutFR["Link from %g to %g failed; errno is %g",
IO.rope[destinationRope],
IO.rope[sourceRope],
IO.card[LOOPHOLE[UnixErrno.GetErrno[], CARD]]]];
ENDLOOP;
};
UnlinkNames:
PROC [dir:
ROPE, files:
LIST
OF
ROPE] ~ {
FOR list:
LIST
OF
ROPE ¬ files, list.rest
WHILE list #
NIL
DO
file: ROPE ~ list.first;
sourceRope: ROPE ~ Rope.Cat[dir, "FILE-", file];
source: UnixTypes.CHARPtr ~ UXStrings.Create[sourceRope];
res: UnixTypes.SysCallResult ~ UnixSysCalls.Unlink[source];
IF res = failure
THEN
ERROR ShouldNotHappen[
IO.PutFR["Unlink failed for %g; errno is %g",
IO.rope[sourceRope],
IO.card[LOOPHOLE[UnixErrno.GetErrno[], CARD]]]];
ENDLOOP;
};>>
Execute:
PROC [command:
ROPE, wDir:
ROPE ¬
NIL]
RETURNS [status:
INT, msg:
ROPE ¬
NIL] ~ {
newCommand: ROPE ~ IF wDir.Equal[NIL] THEN command ELSE Rope.Cat["cd ", wDir, " ; ", command];
string: UXStrings.UnixString ~ UXStrings.Create[from: newCommand];
ropeStdErr: ROPE ~ NewName[".stderr", wDir];
stringStdErr: UXStrings.UnixString ~ UXStrings.Create[from: ropeStdErr];
ropeStdOut: ROPE ~ NewName[".stdout",wDir];
stringStdOut: UXStrings.UnixString ~ UXStrings.Create[from: ropeStdOut];
status ¬ UnixSysCallExtensions.Spawn[string, UnixNil, stringStdOut, stringStdErr];
IF status # 0 THEN msg ¬ MsgFromExitError[status: status, command: command];
msg ¬ Rope.Cat[msg, MsgFromFile[fileName: ropeStdErr, delete: DeleteFiles]];
msg ¬ Rope.Cat[msg, MsgFromFile[fileName: ropeStdOut, delete: DeleteFiles]];
ExecuteCsh:
PROC [hostType, targetType: SystemVersion.MachineType, commandLines:
ROPE, wDir:
ROPE ¬
NIL]
RETURNS [status:
INT, msg:
ROPE ¬
NIL] ~ {
cshCommandRope: ROPE ~ GetCommandNames[ host: hostType, target: targetType].csh;
cshCommandString: UnixTypes.CHARPtr ~ UXStrings.Create[cshCommandRope].string;
IF cshCommandRope =
NIL
THEN ERROR ShouldNotHappen[IO.PutFR[
"Cshell execution on target of class %g cannot be done from host of class %g", IO.rope[MachineClassFromMachineType[targetType]],
IO.rope[MachineClassFromMachineType[hostType]],
]];
{
ropeStdIn: ROPE ~ NewName[".stdin", wDir];
stringStdIn: UXStrings.UnixString ~ UXStrings.Create[from: ropeStdIn];
ropeStdErr: ROPE ~ NewName[".stderr", wDir];
stringStdErr: UXStrings.UnixString ~ UXStrings.Create[from: ropeStdErr];
ropeStdOut: ROPE ~ NewName[".stdout", wDir];
stringStdOut: UXStrings.UnixString ~ UXStrings.Create[from: ropeStdOut];
streamIn: IO.STREAM ~ FS.StreamOpen[fileName: ropeStdIn, accessOptions: $create];
IF
NOT wDir.Equal[
NIL]
THEN streamIn.PutF["cd %g\n", IO.rope[wDir]];
streamIn.PutF["%g\n", IO.rope[commandLines]];
streamIn.Close[];
status ¬ UnixSysCallExtensions.Spawn[cshCommandString, stringStdIn, stringStdOut, stringStdErr];
IF status # 0 THEN msg ¬ MsgFromExitError[status: status, command: cshCommandRope];
msg ¬ Rope.Cat[msg, MsgFromFile[fileName: ropeStdErr, delete: DeleteFiles]];
msg ¬ Rope.Cat[msg, MsgFromFile[fileName: ropeStdOut, delete: DeleteFiles]];
FS.Delete[name: ropeStdIn !FS.Error => CONTINUE];
}
OutFilename:
PROC [ template:
ROPE ]
RETURNS [ name:
ROPE ] ~ {
fullName: ROPE; cp: FS.ComponentPositions;
[fullFName: fullName, cp: cp] ¬ FS.ExpandName[template];
{
shortName: ROPE ~ fullName.Substr[cp.base.start, cp.base.length];
name ¬ shortName.Cat[".o"];
};
};
FixPath:
PROC [ origName:
ROPE ]
RETURNS [ newName:
ROPE ¬
NIL ] ~ {
IF Rope.Equal[origName, NIL] THEN RETURN;
newName ¬ origName.Translate[translator: BrackToSlash];
};
BrackToSlash:
PROC [old:
CHAR]
RETURNS [new:
CHAR] ~ {
new ¬ IF ( old = '> ) THEN '/ ELSE old};
FixDirectory:
PROC [ origName:
ROPE ]
RETURNS [ newName:
ROPE ¬
NIL ] ~ {
length: INT ~ Rope.Length[origName];
IF length = 0 THEN RETURN;
newName ¬ FixPath[origName];
IF newName.Fetch[length-1] # '/ THEN newName ¬ newName.Cat["/"];
RETURN [newName];
};
GetDirAndFixPath:
PROC [ origDir, origName:
ROPE ]
RETURNS [ dir, basename:
ROPE ¬
NIL ] ~ {
basename is filename portion
dir is the directory portion using "/" notation
dir ¬ origDir;
IF Rope.Equal[origName, NIL] THEN RETURN;
basename ¬ FixPath[origName];
{
pos: INT32 ~ basename.FindBackward["/"].SUCC;
IF ( pos # 0 )
THEN {
dir ¬ origDir.Concat[basename.Substr[0, pos]];
basename ¬ basename.Substr[pos];
RETURN};
};
};
Commander Procs.
CommandSyntaxError: ERROR ~ CODE;
ComplexCCProc: Commander.CommandProc ~ {
ENABLE {
Args.Error => { msg ¬ ComplexCCUsage; GOTO Failed };
ShouldNotHappen => { msg ¬ message; GOTO Failed };
CommandSyntaxError => { msg ¬ ComplexCCUsage; GOTO Failed };
FS.Error => { msg ¬ error.explanation; GOTO Failed };
};
binDir: ROPE ¬ NIL;
srcDir: ROPE ¬ NIL;
ccSwitches: ROPE;
ldSwitches: ROPE;
libSwitches: ROPE;
doALoad: BOOL ¬ FALSE;
xFlag: BOOL ¬ FALSE;
inFilename: ROPE;
intFileList: LIST OF ROPE; -- list of file names for intermediate files
loadFileList: LIST OF ROPE; -- list of file names for loading
outFilename: ROPE;
currentDir: ROPE ~ ViewFix[CommandTool.CurrentWorkingDirectory[], NIL, TRUE, FALSE, FALSE, NIL].unix; --a UXIO name
InnerDoIt:
PROC [hostType, targetType: SystemVersion.MachineType] ~ {
Side Effects msg and result in the enclosing procedure. Host is currently unused.
ENABLE {
FS.Error => {
msg ¬ error.explanation;
GOTO Failed;
};
ABORTED => {
msg ¬ "-- Aborted!";
GOTO Failed;
}
};
compilerName: ROPE;
loaderName: ROPE;
moveName: ROPE;
links: LOR ¬ NIL;
ccSrc, ccOut, intFudge, ldOut, ldOutUX: ROPE;
ldCommand: ROPE ¬ NIL;
[compiler: compilerName, loader: loaderName] ¬ GetCommandNames[host: hostType, target: targetType];
IF compilerName.Equal[
NIL]
OR loaderName.Equal[
NIL]
THEN {
msg ¬ IO.PutFR["Compilation from host type %g to target type %g is not valid", IO.rope[MachineClassFromMachineType[hostType]],
IO.rope[MachineClassFromMachineType[targetType]],
];
GOTO Failed;
};
Step One: tame the file view problems
{
ENABLE
UNWIND => UnlinkList[links];
[ccSrc, links] ¬ ViewFix[srcDir.Concat[inFilename], NIL, FALSE, TRUE, FALSE, links];
[ccOut, links] ¬ ViewFix[binDir.Cat[outFilename], NIL, FALSE, TRUE, TRUE, links];
IF doALoad
THEN {
inputDir: ROPE ~ currentDir.Cat[binDir];
ldOut ¬ binDir.Concat[NewName[".o", NIL]];
[ldOutUX, links] ¬ ViewFix[ldOut, NIL, FALSE, FALSE, TRUE, links];
FOR tail:
LIST
OF
ROPE ¬ loadFileList, tail.rest
WHILE ( tail #
NIL )
DO
renamed: ROPE;
[renamed, links] ¬ ViewFix[binDir.Concat[tail.first], "FILE-", FALSE, FALSE, FALSE, links];
ldCommand ¬ ldCommand.Cat[" ", renamed];
ENDLOOP;
ldCommand ¬ ldCommand.Cat[" ", libSwitches];
};
Step Two: do a Cc
{
status: INT;
localMsg, command: ROPE ¬ NIL;
command ¬ IO.PutFR["%g %g -o %g %g -I./%g", IO.rope[compilerName], IO.rope[ccSwitches], IO.rope[ccOut], IO.rope[ccSrc], IO.rope[srcDir]];
[status: status, msg: localMsg] ¬ Execute[command: command, wDir: currentDir];
IF (
NOT localMsg.Equal[
NIL] )
THEN {
IF ( status # 0 )
THEN {
msg ¬ IO.PutFR["Compilation failed; error: %g, msg: %g", IO.int[status], IO.rope[localMsg]];
UnlinkList[links];
GOTO Failed;
};
msg ¬ IO.PutFR[".\nCompilation warnings: %g\n", IO.rope[localMsg]];
}
cmd.err.PutRope[msg];
cmd.err.Flush[];
};
Process.CheckForAbort[];
Step Three: do an Ld (renaming if necessary, after removing links)
IF ( doALoad )
THEN {
status: INT;
localMsg: ROPE;
[intFudge, links] ¬ ViewFix[binDir.Cat[outFilename], "FILE-", FALSE, TRUE, FALSE, links];
ldCommand ¬ IO.PutFR["%g %g -o %g %g %g", IO.rope[loaderName], IO.rope[ldSwitches], IO.rope[ldOutUX], IO.rope[intFudge], IO.rope[ldCommand] ];
[status: status, msg: localMsg] ¬ Execute[command: ldCommand, wDir: currentDir];
IF (
NOT localMsg.Equal[
NIL] )
THEN {
IF ( status # 0 )
THEN {
msg ¬ IO.PutFR["Load failed; error: %g, msg: %g", IO.int[status], IO.rope[localMsg]];
UnlinkList[links];
GOTO Failed;
};
msg ¬ IO.PutFR[".\nLoad warnings: %g\n", IO.rope[localMsg]];
}
cmd.err.PutRope[msg];
cmd.err.Flush[];
Process.CheckForAbort[];
};
}; UnlinkList[links];
IF ( doALoad )
THEN {
FS.Rename[from: ldOut, to: binDir.Concat[outFilename] !
FS.Error => {
msg ¬ IO.PutFR["FS.Error[%g, %g] while trying to rename %g to %g", [atom[error.code]], [rope[error.explanation]], [rope[ldOut]], [rope[binDir.Concat[outFilename]]]];
GOTO Failed}];
};
Process.CheckForAbort[];
Step Four: process the file adding extra symbols and dependecy info.
IF ( xFlag )
THEN {
self: ExtendADotOut.ObjectID;
action: ExtendADotOut.ActionID ~ ExtendADotOut.ActionIDFromAction["CC"];
dependList: LIST OF ExtendADotOut.ObjectID ¬ NIL;
deps: ExtendADotOut.DependencyInfo;
depFileList: LIST OF ROPE ¬ NIL;
depFileList ¬ CONS[Rope.Cat[srcDir, inFilename], depFileList];
FOR list:
LIST
OF
ROPE ¬ intFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
depFileList ¬ CONS[Rope.Cat[srcDir, fileName], depFileList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ loadFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
depFileList ¬ CONS[Rope.Cat[binDir, fileName], depFileList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ depFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
dependList ¬ CONS[ExtendADotOut.ObjectIDFromFile[fileName], dependList];
ENDLOOP;
self.class ¬ ExtendADotOut.ObjectClassFromFileName[outFilename];
self.name ¬ Rope.Cat[binDir, outFilename];
self.stamp ¬ ExtendADotOut.StampFromIDs[action, dependList];
deps ¬
NEW [ExtendADotOut.DependencyInfoRep ¬ [
self: self,
action: action,
dependList: dependList
]];
ExtendADotOut.PutDependencyInfo[Rope.Cat[binDir, outFilename], deps];
};
msg ¬ " no errors.";
EXITS
Failed => { result ¬ $Failure };
};
targetClass: ROPE ¬ UserProfile.Token[key: MACHINECLASS, default: "sun4"];
hostClass: ROPE ¬ MachineClassFromMachineType[ SystemVersion.machineType ];
userHost: ROPE ← NIL; -- unused
ProcessCommandLine:
PROC ~ {
nArgs: INT32 ~ Args.NArgs[cmd];
i: NAT;
FOR i ¬ 0, i.
SUCC
WHILE ( i < nArgs )
DO
NextRope:
PROC
RETURNS [ r:
ROPE ] ~
INLINE {
ropeArg: Args.Arg ~ Args.ArgRope[cmd, i.SUCC];
r ¬ ropeArg.rope;
i ¬ i.SUCC;
};
NextList:
PROC
RETURNS [ l:
LIST
OF
ROPE ¬
NIL ] ~
INLINE {
FOR j:
INT32 ¬ i.
SUCC, j.
SUCC
WHILE ( j < nArgs )
DO
anArg: ROPE ~ Args.GetRope[cmd, j];
IF ( anArg.Fetch[0] = '- ) THEN { i ¬ j.PRED; EXIT} ;
l ¬ CONS[anArg, l];
REPEAT
FINISHED => { i ¬ nArgs }
ENDLOOP;
};
anArg: ROPE ~ Args.GetRope[cmd, i];
SELECT
TRUE
FROM
anArg.Equal[s2: "-in", case: FALSE] => { inFilename ¬ NextRope[] };
anArg.Equal[s2: "-out", case: FALSE] => { outFilename ¬ NextRope[] };
anArg.Equal[s2: "-binDir", case: FALSE] => { binDir ¬ NextRope[] };
anArg.Equal[s2: "-srcDir", case: FALSE] => { srcDir ¬ NextRope[] };
anArg.Equal[s2: "-lSwitch", case: FALSE] => { ldSwitches ¬ NextRope[] };
anArg.Equal[s2: "-cSwitch", case: FALSE] => { ccSwitches ¬ NextRope[] };
anArg.Equal[s2: "-host", case: FALSE] => { userHost ← NextRope[] };
anArg.Equal[s2: "-class", case: FALSE] => { targetClass ¬ NextRope[] };
anArg.Equal[s2: "-lib", case: FALSE] => { libSwitches ¬ NextRope[] };
anArg.Equal[s2: "-int", case: FALSE] => { intFileList ¬ NextList[] };
anArg.Equal[s2: "-X", case: FALSE] => { xFlag ¬ TRUE };
anArg.Equal[s2: "-load", case: FALSE] =>
{ doALoad ¬ TRUE; loadFileList ¬ NextList[] };
ENDCASE => ERROR CommandSyntaxError;
ENDLOOP;
};
ProcessCommandLine[];
binDir ¬ FixDirectory[binDir];
srcDir ¬ FixDirectory[srcDir];
inFilename ¬ FixPath[inFilename];
IF ( outFilename = NIL ) THEN outFilename ¬ OutFilename[inFilename];
[binDir, outFilename] ¬ GetDirAndFixPath[binDir, outFilename];
cmd.err.PutF[" [localhost] "];
cmd.err.PutRope["C compiling "];
cmd.err.Flush[];
InnerDoIt[
hostType: MachineTypeFromMachineClass[hostClass],
targetType: MachineTypeFromMachineClass[targetClass]];
That's all!
EXITS
Failed => { result ¬ $Failure };
};
ComplexRshProc: Commander.CommandProc ~ {
ENABLE {
Args.Error => { msg ¬ ComplexRshUsage; GOTO Failed };
ShouldNotHappen => { msg ¬ message; GOTO Failed };
CommandSyntaxError => { msg ¬ ComplexRshUsage; GOTO Failed };
FS.Error => { msg ¬ error.explanation; GOTO Failed };
};
xFlag: BOOL ¬ FALSE;
xClassName: ROPE ¬ NIL; -- The name of the class for this action
srcDir: ROPE;
binDir: ROPE ¬ NIL;
srcInFileList: LIST OF ROPE; -- Source files that will be transfered FROM Cedar
binInFileList: LIST OF ROPE; -- Binary files that will be transfered FROM Cedar
srcOutFileList: LIST OF ROPE; -- Source files that will be copied TO Cedar back
binOutFileList: LIST OF ROPE; -- Binary files that will be copied TO Cedar back
unlinkList: LOR ¬ NIL; --files to unlink later
rshCmd: ROPE;
currentDir: ROPE ~ CommandTool.CurrentWorkingDirectory[];
InnerDoIt:
PROC [hostType, targetType: SystemVersion.MachineType] ~ {
Side Effects msg and result in the enclosing procedure.
ENABLE {
FS.Error => {
msg ¬ error.explanation;
GOTO Failed;
};
ABORTED => {
msg ¬ "-- Aborted!";
GOTO Failed;
}
};
Step One: tame the file view mess
What if the command does something (like mv) that would break links?
{ENABLE UNWIND => UnlinkList[unlinkList];
FOR list:
LIST
OF
ROPE ¬ srcInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
[, unlinkList] ¬ ViewFix[srcDir.Cat[fileName], NIL, FALSE, TRUE, FALSE, unlinkList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ binInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
[, unlinkList] ¬ ViewFix[binDir.Cat[fileName], NIL, FALSE, TRUE, FALSE, unlinkList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ srcInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
[, unlinkList] ¬ ViewFix[srcDir.Cat[fileName], NIL, FALSE, TRUE, TRUE, unlinkList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ binInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
[, unlinkList] ¬ ViewFix[binDir.Cat[fileName], NIL, FALSE, TRUE, TRUE, unlinkList];
ENDLOOP;
Step Two: do the Rsh on host
{
status: INT;
localMsg: ROPE ¬ NIL;
realDir: ROPE ¬ currentDir;
IF
NOT srcDir.Equal[
NIL]
THEN
IF srcDir.Fetch[0] = '/
THEN realDir ¬ srcDir
ELSE realDir ¬ currentDir.Cat["/", srcDir]
ELSE
realDir ¬ currentDir;
[status: status, msg: localMsg] ¬ ExecuteCsh[hostType: hostType, targetType: targetType, commandLines: rshCmd, wDir: realDir];
IF (
NOT localMsg.Equal[
NIL] )
THEN {
IF ( status # 0 )
THEN {
msg ¬ IO.PutFR["Command failed; error: %g, msg: %g", IO.int[status], IO.rope[localMsg]];
GOTO Failed;
};
msg ¬ IO.PutFR[".\nCommand warnings: %g", IO.rope[localMsg]];
}
cmd.err.PutRope[msg];
cmd.err.Flush[];
};
Step Three: remove the links.
}; UnlinkList[unlinkList];
Step Four: process the file adding extra symbols and dependecy info.
IF ( xFlag )
THEN {
self: ExtendADotOut.ObjectID;
action: ExtendADotOut.ActionID ~ ExtendADotOut.ActionIDFromAction[xClassName];
dependList: LIST OF ExtendADotOut.ObjectID ¬ NIL;
deps: ExtendADotOut.DependencyInfo;
depFileList: LIST OF ROPE ¬ NIL;
stamp: ExtendADotOut.VersionStamp;
FOR list:
LIST
OF
ROPE ¬ srcInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
depFileList ¬ CONS[Rope.Cat[srcDir, fileName], depFileList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ binInFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
depFileList ¬ CONS[Rope.Cat[binDir, fileName], depFileList];
ENDLOOP;
FOR list:
LIST
OF
ROPE ¬ depFileList, list.rest
WHILE list #
NIL
DO
fileName: ROPE ~ list.first;
dependList ¬ CONS[ExtendADotOut.ObjectIDFromFile[fileName], dependList];
ENDLOOP;
stamp ¬ ExtendADotOut.StampFromIDs[action, dependList];
FOR list:
LIST
OF
ROPE ¬ binOutFileList, list.rest
WHILE list #
NIL
DO
outFilename: ROPE ~ list.first;
self.class ¬ ExtendADotOut.ObjectClassFromFileName[outFilename];
self.stamp ¬ stamp;
self.name ¬ Rope.Cat[binDir, outFilename];
deps ¬
NEW [ExtendADotOut.DependencyInfoRep ¬ [
self: self,
action: action,
dependList: dependList
]];
ExtendADotOut.PutDependencyInfo[Rope.Cat[binDir, outFilename], deps];
ENDLOOP;
};
msg ¬ " no errors.";
EXITS
Failed => { result ¬ $Failure };
};
targetClass: ROPE ¬ UserProfile.Token[key: MACHINECLASS, default: "sun4"];
hostClass: ROPE ¬ MachineClassFromMachineType[ SystemVersion.machineType ];
userHost: ROPE ← NIL;
ProcessCommandLine:
PROC ~ {
nArgs: INT32 ~ Args.NArgs[cmd];
i: NAT;
FOR i ¬ 0, i.
SUCC
WHILE ( i < nArgs )
DO
NextRope:
PROC
RETURNS [ r:
ROPE ] ~
INLINE {
ropeArg: Args.Arg ~ Args.ArgRope[cmd, i.SUCC];
r ¬ ropeArg.rope;
i ¬ i.SUCC;
};
FixNextList:
PROC
RETURNS [ l:
LIST
OF
ROPE ¬
NIL ] ~
INLINE {
Warning, Warning!!! create list in reverse order!
FOR j:
INT32 ¬ i.
SUCC, j.
SUCC
WHILE ( j < nArgs )
DO
anArg: ROPE ~ Args.GetRope[cmd, j];
IF ( anArg.Fetch[0] = '- ) THEN { i ¬ j.PRED; EXIT} ;
l ¬ CONS[FixPath[anArg], l];
REPEAT
FINISHED => { i ¬ nArgs }
ENDLOOP;
};
anArg: ROPE ~ Args.GetRope[cmd, i];
SELECT
TRUE
FROM
anArg.Equal[s2: "-binIn", case: FALSE] => { binInFileList ¬ FixNextList[] };
anArg.Equal[s2: "-srcIn", case: FALSE] => { srcInFileList ¬ FixNextList[] };
anArg.Equal[s2: "-binOut", case: FALSE] => { binOutFileList ¬ FixNextList[] };
anArg.Equal[s2: "-srcOut", case: FALSE] => { srcOutFileList ¬ FixNextList[] };
anArg.Equal[s2: "-srcDir", case: FALSE] => { srcDir ¬ NextRope[] };
anArg.Equal[s2: "-binDir", case: FALSE] => { binDir ¬ NextRope[] };
anArg.Equal[s2: "-host", case: FALSE] => { userHost ← NextRope[] };
anArg.Equal[s2: "-class", case: FALSE] => { targetClass ¬ NextRope[] };
anArg.Equal[s2: "-cmd", case: FALSE] => { rshCmd ¬ NextRope[] };
anArg.Equal[s2: "-XClass", case: FALSE] => { xFlag ¬ TRUE; xClassName ¬ NextRope[] };
ENDCASE => ERROR CommandSyntaxError;
ENDLOOP;
IF binDir.Equal[NIL] THEN binDir ¬ srcDir;
};
ProcessCommandLine[];
srcDir ¬ FixDirectory[srcDir];
binDir ¬ FixDirectory[binDir];
cmd.err.PutRope["Starting Rsh"];
cmd.err.Flush[];
InnerDoIt[
hostType: MachineTypeFromMachineClass[hostClass],
targetType: MachineTypeFromMachineClass[targetClass]];
That's all!
EXITS
Failed => { result ¬ $Failure };
};
Documentation
ComplexCC: ROPE ~ "ComplexCC";
ComplexCCDoc:
ROPE ~ " - cc with all the frills. Switches are:
-in <file>
-out <file>
-class <as in SystemVersion.MachineTypes>
-host <host>
-cSwitch <cc switches>
-load <file list> => load compiled file together with <file list>
-X => eXtend the resulting binary file with fast symbol and dependecy info
-lSwitch <ld switches>
-Lib libstring => string with the libraries to load
-int <file list> => files to copy to the host before compiling
-srcDir <dir> => remote source directory
-binDir <dir> => remote object file directory
(overridden by directory part specified in -out)
";
ComplexCCUsage: ROPE ~ Rope.Concat["Usage: ComplexCC ", ComplexCCDoc];
ComplexRsh: ROPE ~ "ComplexRsh";
ComplexRshDoc:
ROPE ~ " - Rsh with all the frills. Switches are:
-class <as in SystemVersion.MachineTypes>
-host <host>
-srcIn <file list> => source files to copy to the host before doing Rsh
-binIn <file list> => binary files to copy to the host before doing Rsh
-srcOut <file list> => source files to copy from the host after doing Rsh
-binOut <file list> => binary files to copy from the host after doing Rsh
-srcDir <dir> => remote source directory (command will execute in srcDir)
-binDir <dir> => remote binary directory (equal to -srcDir by default)
-XClass <className> => eXtend the resulting binary files with fast symbol and dependency information; use <className> to identify the action performed.
-cmd <command> => command to execute remotely
";
ComplexRshUsage: ROPE ~ Rope.Concat["Usage: ComplexRsh ", ComplexRshDoc];
ComplexRshUsageHostMissing: ROPE ~ Rope.Concat["No host has been specified\nUsage: ComplexRsh ", ComplexRshDoc];
ComplexErrorProc: Commander.CommandProc ~ {ERROR};
Init:
PROC ~ {
Commander.Register[ComplexCC, ComplexCCProc, ComplexCCDoc];
Commander.Register[ComplexRsh, ComplexRshProc, ComplexRshDoc];
Commander.Register["ComplexError", ComplexErrorProc, "raises ERROR, for debugging"];
};
Init[];
}.