diff --git a/src/compiler/OPM.Mod b/src/compiler/OPM.Mod index a314cdc3..4145a1fc 100644 --- a/src/compiler/OPM.Mod +++ b/src/compiler/OPM.Mod @@ -233,6 +233,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *) PROCEDURE OpenPar*(): BOOLEAN; (* prepare for a sequence of translations *) VAR s: ARRAY 256 OF CHAR; BEGIN + Out.String("Testing. Binary directory is: '"); Out.String(Modules.BinaryDir); Out.String("'."); Out.Ln; IF Modules.ArgCount = 1 THEN LogWLn; LogWStr("Oberon-2 compiler v"); LogWStr(Configuration.versionLong); LogW("."); LogWLn; diff --git a/src/runtime/Modules.Mod b/src/runtime/Modules.Mod index 8e9c1851..15896d21 100644 --- a/src/runtime/Modules.Mod +++ b/src/runtime/Modules.Mod @@ -31,13 +31,15 @@ MODULE Modules; (* jt 6.1.96 *) END ; VAR - res*: INTEGER; - resMsg*: ARRAY 256 OF CHAR; - imported*, importing*: ModuleName; + res*: INTEGER; + resMsg*: ARRAY 256 OF CHAR; + imported*: ModuleName; + importing*: ModuleName; MainStackFrame-: SYSTEM.ADDRESS; ArgCount-: INTEGER; ArgVector-: SYSTEM.ADDRESS; + BinaryDir-: ARRAY 1024 OF CHAR; (* Program startup *) @@ -50,28 +52,23 @@ MODULE Modules; (* jt 6.1.96 *) PROCEDURE Init*(argc: SYSTEM.INT32; argvadr: SYSTEM.ADDRESS); (* This start code is called by the __INIT macro generated by the compiler as the C main program. *) - TYPE ArgVecPtr = POINTER TO ARRAY 1 OF SYSTEM.ADDRESS; - VAR av: ArgVecPtr; BEGIN MainStackFrame := argvadr; - ArgCount := SYSTEM.VAL(INTEGER, argc); - av := SYSTEM.VAL(ArgVecPtr, argvadr); - ArgVector := av[0]; + ArgCount := SYSTEM.VAL(INTEGER, argc); + SYSTEM.GET(argvadr, ArgVector); - InitHeap; (* Initailse heap varaibles neded for compiler generated *__inits *) - ModulesInit(); (* Our own __init code will run the Platform and Heap __init code. *) + InitHeap; (* Initialse heap variables needed for compiler generated *__inits *) + ModulesInit(); (* Our own __init code will run Platform__init and Heap__init. *) END Init; PROCEDURE GetArg*(n: INTEGER; VAR val: ARRAY OF CHAR); - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - VAR av: ArgVec; + TYPE argptr = POINTER TO ARRAY 1024 OF CHAR; + VAR arg: argptr; BEGIN IF n < ArgCount THEN - av := SYSTEM.VAL(ArgVec, ArgVector); - COPY(av[n]^, val) + SYSTEM.GET(ArgVector + n*SIZE(SYSTEM.ADDRESS), arg); (* Address of nth argument. *) + COPY(arg^, val); END END GetArg; @@ -94,16 +91,140 @@ MODULE Modules; (* jt 6.1.96 *) RETURN i END ArgPos; +(* Determine directory from which this executable was loaded *) - - PROCEDURE Append(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR); - VAR i, j: INTEGER; + PROCEDURE CharCount(s: ARRAY OF CHAR): INTEGER; + VAR i: INTEGER; BEGIN - i := 0; WHILE a[i] # 0X DO INC(i) END; - j := 0; WHILE b[j] # 0X DO a[i] := b[j]; INC(i); INC(j) END; - a[i] := 0X + i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END; + RETURN i; + END CharCount; + + PROCEDURE Append(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR); + VAR i,j: INTEGER; + BEGIN + i := 0; j := CharCount(d); + WHILE s[i] # 0X DO d[j] := s[i]; INC(i); INC(j) END; + d[j] := 0X; END Append; + PROCEDURE AppendPart(c: CHAR; s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR); + VAR i,j: INTEGER; + BEGIN + i := 0; j := CharCount(d); + IF (j > 0) & (d[j-1] # c) THEN d[j] := c; INC(j) END; + WHILE s[i] # 0X DO d[j] := s[i]; INC(i); INC(j) END; + d[j] := 0X; + END AppendPart; + + PROCEDURE IsOneOf(c: CHAR; s: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; + BEGIN + IF c = 0X THEN RETURN FALSE END; + i := 0; WHILE (s[i] # c) & (s[i] # 0X) DO INC(i) END; + RETURN s[i] = c + END IsOneOf; + + PROCEDURE IsAbsolute(d: ARRAY OF CHAR): BOOLEAN; + BEGIN + IF d = '' THEN RETURN FALSE END; + IF IsOneOf(d[0], '/\') THEN RETURN TRUE END; + IF d[1] = ':' THEN RETURN TRUE END; + RETURN FALSE; + END IsAbsolute; + + PROCEDURE Canonify(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR); + BEGIN + IF IsAbsolute(s) THEN + COPY(s, d) + ELSE + COPY(Platform.CWD, d); AppendPart('/', s, d); + END; + END Canonify; + + PROCEDURE IsFilePresent(s: ARRAY OF CHAR): BOOLEAN; + VAR identity: Platform.FileIdentity; + BEGIN RETURN Platform.IdentifyByName(s, identity) = 0 + END IsFilePresent; + + PROCEDURE ExtractPart(s: ARRAY OF CHAR; VAR i: INTEGER; p: ARRAY OF CHAR; VAR d: ARRAY OF CHAR); + (* Extracts from s starting at i up to any character in p. + Result string in d. + Returns i skipped passed found string and any number of delimiters from p. + *) + VAR j: INTEGER; + BEGIN + j := 0; + WHILE (s[i] # 0X) & ~IsOneOf(s[i], p) DO + d[j] := s[i]; INC(i); INC(j) + END; + d[j] := 0X; + WHILE IsOneOf(s[i], p) DO INC(i) END + END ExtractPart; + + PROCEDURE Trim(s: ARRAY OF CHAR; VAR d: ARRAY OF CHAR); + (* Remove redundant '.'s and '/'s. + Note, does not remove 'x/..'. This cannot safely be removed because if + x is a link then 'x/..' means the parent of what x links to rather than + the directory containing link x. + *) + VAR i,j: INTEGER; part: ARRAY 1024 OF CHAR; + BEGIN + i := 0; j := 0; + (* Retain any leading single or pair of '/' (filesystem root or network root). *) + WHILE (i<2) & IsOneOf(s[i], "/\") DO INC(i); d[j] := '/'; INC(j) END; + d[j] := 0X; + (* Append path parts omitting empty or '.' parts. *) + WHILE s[i] # 0X DO + ExtractPart(s, i, "/\", part); + IF (part # '') & (part # '.') THEN AppendPart('/', part, d) END + END; + END Trim; + + PROCEDURE FindBinaryDir(VAR d: ARRAY OF CHAR); + TYPE pathstring = ARRAY 4096 OF CHAR; + VAR + executable: pathstring; + dir: pathstring; + testpath: pathstring; + pathlist: pathstring; + i, j, k: INTEGER; + present: BOOLEAN; + BEGIN + IF ArgCount < 1 THEN + (* Shells and GUIs always pass the command as ARGV[0]. *) + d[0] := 0X; + RETURN; + END; + + (* First try ARGV[0] without looking at the PATH environment variable. *) + GetArg(0, testpath); Trim(testpath, executable); + Canonify(executable, d); present := IsFilePresent(d); + + IF (~present) & (~IsAbsolute(testpath)) THEN + (* ARGV[0] alone didn't work, try non-absolute ARGV[0] with every entry in path. *) + Platform.GetEnv("PATH", pathlist); + i := 0; + WHILE (~present) & (pathlist[i] # 0X) DO + ExtractPart(pathlist, i, ":;", dir); Trim(dir, testpath); + AppendPart('/', executable, testpath); + Canonify(testpath, d); present := IsFilePresent(d) + END + END; + + IF present THEN + (* Remove trailing executable file name *) + k := CharCount(d); + WHILE (k > 0) & ~IsOneOf(d[k-1], '/\') DO DEC(k) END; + (* Chop off executable file name *) + IF k = 0 THEN d[k] := 0X ELSE d[k-1] := 0X END; + ELSE + d[0] := 0X (* Couldn't determine binary directory. *) + END + END FindBinaryDir; + + +(* Module and command lookup by name *) PROCEDURE -modules(): Module "(Modules_Module)Heap_modules"; PROCEDURE -setmodules(m: Module) "Heap_modules = m"; @@ -114,7 +235,7 @@ MODULE Modules; (* jt 6.1.96 *) WHILE (m # NIL) & (m.name # name) DO m := m.next END ; IF m # NIL THEN res := 0; resMsg := "" ELSE res := 1; COPY(name, importing); - resMsg := ' module "'; Append(resMsg, name); Append(resMsg, '" not found'); + resMsg := ' module "'; Append(name, resMsg); Append('" not found', resMsg); END ; RETURN m END ThisMod; @@ -125,7 +246,7 @@ MODULE Modules; (* jt 6.1.96 *) WHILE (c # NIL) & (c.name # name) DO c := c.next END ; IF c # NIL THEN res := 0; resMsg := ""; RETURN c.cmd ELSE res := 2; resMsg := ' command "'; COPY(name, importing); - Append(resMsg, mod.name); Append(resMsg, "."); Append(resMsg, name); Append(resMsg, '" not found'); + Append(mod.name, resMsg); Append(".", resMsg); Append(name, resMsg); Append('" not found', resMsg); RETURN NIL END END ThisCommand; @@ -212,4 +333,6 @@ MODULE Modules; (* jt 6.1.96 *) IF code > 0 THEN Platform.Exit(code) ELSE Platform.Exit(-1) END; END AssertFail; +BEGIN + FindBinaryDir(BinaryDir); END Modules. diff --git a/src/test/confidence/intsyntax/test.sh b/src/test/confidence/intsyntax/test.sh index 3929cc8c..932ea13d 100644 --- a/src/test/confidence/intsyntax/test.sh +++ b/src/test/confidence/intsyntax/test.sh @@ -1,5 +1,5 @@ #!/bin/sh . ../testenv.sh # Generate mixed source and assembly code listing -$OBECOMP IntSyntax.mod -fm >result +$OBECOMP IntSyntax.mod -fm | fgrep -v "Testing. Binary directory is: '" >result . ../testresult.sh