Merge branch 'main' of github.com:kekcleader/FreeOberon into main

Data/bin/compile.bat

@@ -15,12 +15,20 @@ SET DIR=%~dp0
 
 SET FNAME=%1
 
-IF "%FNAME:~0,1%"=="\" GOTO ENDIF1
-  SET FNAME=..\%FNAME%
+REM If "C:Dir\Dir2"-style relative path given
+IF NOT "%FNAME:~1,1%"==":" GOTO ENDIF1
+IF "%FNAME:~2,1%"=="\" GOTO ENDIF1
+  SET FNAME=%FNAME:~0,2%..\%FNAME:~2%
+  GOTO ENDIF2
 :ENDIF1
+REM Else if not "\" or "C:\"-style absolute path
+IF "%FNAME:~0,1%"=="\" GOTO ENDIF2
+IF "%FNAME:~1,2%"==":\" GOTO ENDIF2
+  SET FNAME=..\%FNAME%
+:ENDIF2
 
 IF NOT EXIST _Build MD _Build
-CD _Build
+CD _Build || EXIT /b 407
 
 SET OFRDIR=%DIR%OfrontPlus\Target\Win32
 SET PATH=%OFRDIR%;%PATH%
@@ -31,5 +39,5 @@ ECHO ON
 @%OFR% %2 %FNAME%
 @SET RETCODE=%ERRORLEVEL%
 @ECHO OFF
-@CD ..
+CD ..
 EXIT /b %RETCODE%

Data/bin/compile.sh

@@ -1,10 +1,10 @@
 #!/bin/bash
-#   This script is automatically run by Free Oberon on Linux
-#   for each compiled module. The initial current directory of
-#   the script is where FreeOberon executable is located.
-#   You are free to edit this file to adjust the process.
+### This script is automatically run by Free Oberon on Linux
+### for each compiled module. The initial current directory of
+### the script is where FreeOberon executable is located.
+### You are free to edit this file to adjust the process.
 
-#   Set DIR = directory of this script
+### Set DIR = directory of this script
 SOURCE=${BASH_SOURCE[0]}
 while [ -h "$SOURCE" ]; do
   DIR=$( cd -P "$( dirname "$SOURCE" )" >/dev/null 2>&1 && pwd )
@@ -15,6 +15,14 @@ DIR=$( cd -P "$( dirname "$SOURCE" )" >/dev/null 2>&1 && pwd )
 
 FNAME=$1
 
+
+
+
+
+
+
+
+
 if [[ "${FNAME:0:1}" != "/" ]]; then
   FNAME=../$FNAME
 fi
@@ -27,7 +35,9 @@ PATH="$OFRDIR:$PATH"
 export OBERON=".:$DIR/../../src:$OFRDIR/Lib/Sym"
 OFR="ofront+ -s -88 -7w"
 
+
 $OFR $2 $FNAME
 retcode=$?
+
 cd ..
 exit $retcode

Data/bin/link_console.sh

@@ -1,8 +1,8 @@
 #!/bin/bash
-#   This script is run by Free Oberon on Linux
-#   to link a console program.
-#   When it is being run, the current directory
-#   must be the root directory of Free Oberon.
+### This script is run by Free Oberon on Linux
+### to link a console program.
+### When it is being run, the current directory
+### must be the root directory of Free Oberon.
 
 # Set DIR = directory of this script
 SOURCE=${BASH_SOURCE[0]}

Data/bin/link_graph.sh

@@ -1,8 +1,8 @@
 #!/bin/bash
-#   This script is run by Free Oberon on Linux
-#   to link a graphics program.
-#   When it is being run, the current directory
-#   must be the root directory of Free Oberon.
+### This script is run by Free Oberon on Linux
+### to link a graphics program.
+### When it is being run, the current directory
+### must be the root directory of Free Oberon.
 
 # Set DIR = directory of this script
 SOURCE=${BASH_SOURCE[0]}

src/Builder.Mod

@@ -221,6 +221,11 @@ BEGIN ok := TRUE;
       END
     END;
     Utf8.Encode(cmd, q);
+
+    IF Config.debug THEN
+      Out.String('Term.RunProcess "'); Out.String(cmd); Out.Char('"'); Out.Ln
+    END;
+
     success := (Term.RunProcess(q, buf, bufLen, len, err) # 0) & (err = 0);
     IF ~success & (onError # NIL) THEN
       z := ''; line := 0; col := 0;

src/Config.Mod

@@ -6,4 +6,14 @@ CONST
 
   version* = '1.1.0-alpha.6';
   year* = 2022;
+
+VAR
+  debug*: BOOLEAN;
+
+PROCEDURE SetDebug*(deb: BOOLEAN);
+BEGIN debug := deb
+END SetDebug;
+
+BEGIN
+  debug := FALSE
 END Config.

src/Fob.Mod

@@ -60,6 +60,7 @@ BEGIN i := 1; lang := 'en';
   WHILE i <= Args.Count DO
     Args.Get(i, s);
     IF s = '--lang' THEN Args.Get(i + 1, lang); INC(i)
+    ELSIF s = '--debug' THEN Config.SetDebug(TRUE)
     ELSE Strings.Copy(s, mainFname)
     END;
     INC(i)

src/FreeOberon.Mod

@@ -928,6 +928,7 @@ BEGIN fs := TRUE; sw := FALSE; i := 1; nofnames := 0; w := defW; h := defH;
   WHILE i <= Args.Count DO Args.Get(i, s);
     IF s = '--window' THEN fs := FALSE
     ELSIF s = '--software' THEN sw := TRUE
+    ELSIF s = '--debug' THEN Config.SetDebug(TRUE)
     ELSIF s = '--size' THEN
       IF i # Args.Count THEN
         INC(i); Args.Get(i, s); ParseSize(s, w, h)

src/term/term_win32.c

@@ -113,23 +113,31 @@ int StartProcessIn(char *process, char *dir) {
   saAttr.lpSecurityDescriptor = NULL;
 
   // Create a pipe for the child process's STDOUT.
-  if (!MyCreatePipeEx(&g_hChildStd_OUT_Rd, &g_hChildStd_OUT_Wr, &saAttr, 0, FILE_FLAG_OVERLAPPED, 0) )
+  if (!MyCreatePipeEx(&g_hChildStd_OUT_Rd, &g_hChildStd_OUT_Wr, &saAttr, 0, FILE_FLAG_OVERLAPPED, 0)) {
     ErrorExit(TEXT("StdoutRd CreatePipe"));
+    return 0;
+  }
 
   // Ensure the read handle to the pipe for STDOUT is not inherited.
-  if (!SetHandleInformation(g_hChildStd_OUT_Rd, HANDLE_FLAG_INHERIT, 0) )
+  if (!SetHandleInformation(g_hChildStd_OUT_Rd, HANDLE_FLAG_INHERIT, 0)) {
     ErrorExit(TEXT("Stdout SetHandleInformation"));
+    return 0;
+  }
 
   // Create a pipe for the child process's STDIN.
-  if (!MyCreatePipeEx(&g_hChildStd_IN_Rd, &g_hChildStd_IN_Wr, &saAttr, 0, FILE_FLAG_OVERLAPPED, 0))
+  if (!MyCreatePipeEx(&g_hChildStd_IN_Rd, &g_hChildStd_IN_Wr, &saAttr, 0, FILE_FLAG_OVERLAPPED, 0)) {
     ErrorExit(TEXT("Stdin CreatePipe"));
+    return 0;
+  }
 
   // Ensure the write handle to the pipe for STDIN is not inherited.
-  if (!SetHandleInformation(g_hChildStd_IN_Wr, HANDLE_FLAG_INHERIT, 0) )
+  if (!SetHandleInformation(g_hChildStd_IN_Wr, HANDLE_FLAG_INHERIT, 0)) {
     ErrorExit(TEXT("Stdin SetHandleInformation"));
+    return 0;
+  }
 
   ZeroMemory(&oOverlap, sizeof(oOverlap));
- 
+
   // ACTUAL START PROCESS
 
   //TCHAR szCmdline[]=TEXT(process);
@@ -150,11 +158,11 @@ int StartProcessIn(char *process, char *dir) {
   siStartInfo.wShowWindow = SW_HIDE;
 
   /* Environment variables */
-  
+
   LPTSTR pszOldVal, childEnvPath;
   BOOL envPathExists = TRUE;
   DWORD pathSize, dwRet, dwErr;
-  
+
   // Save original value of the PATH environment variable
   pszOldVal = (LPTSTR)malloc(BUFSIZE * sizeof(TCHAR));
   pathSize = GetEnvironmentVariable(TEXT("PATH"), pszOldVal, BUFSIZE);
@@ -167,31 +175,42 @@ int StartProcessIn(char *process, char *dir) {
     pszOldVal = (LPTSTR)realloc(pszOldVal, pathSize * sizeof(TCHAR));
     if (pszOldVal == NULL) {
       ErrorExit(TEXT("realloc out memory"));
+      return 0;
     }
     dwRet = GetEnvironmentVariable(TEXT("PATH"), pszOldVal, pathSize);
     if (!dwRet) {
+      free(pszOldVal);
       ErrorExit(TEXT("GetEnvironmentVariable failed"));
+      return 0;
     }
   }
-  
+
   // Determine the value of environment variable PATH for the child process
-  childEnvPath = (LPTSTR)malloc((pathSize + 3) * sizeof(TCHAR));
+  childEnvPath = (LPTSTR)malloc((pathSize + 4) * sizeof(TCHAR));
   if (childEnvPath == NULL) {
+    free(pszOldVal);
     ErrorExit(TEXT("malloc out memory"));
+    return 0;
   }
   childEnvPath[0] = '.';
   childEnvPath[1] = '.';
   childEnvPath[2] = ';';
-  memcpy(childEnvPath + 3, pszOldVal, pathSize + 1);
-  
+  memcpy(childEnvPath + 3, pszOldVal, (pathSize + 1) * sizeof(TCHAR));
+
   // Set value of PATH for child process to inherit
   if (!SetEnvironmentVariable(TEXT("PATH"), childEnvPath)) {
+    free(childEnvPath);
+    free(pszOldVal);
     ErrorExit(TEXT("SetEnvironmentVariable 1 failed"));
+    return 0;
   }
 
+  free(childEnvPath);
+  free(pszOldVal);
+
   // Create the child process.
   bSuccess = CreateProcess(NULL,
-    process, //szCmdline,    // command line
+    process, // command line
     NULL,    // process security attributes
     NULL,    // primary thread security attributes
     TRUE,    // handles are inherited
@@ -200,14 +219,15 @@ int StartProcessIn(char *process, char *dir) {
     dir,          // current directory of the process
     &siStartInfo, // STARTUPINFO pointer
     &piProcInfo); // receives PROCESS_INFORMATION
-  
-  // If an error occurs, exit the application.
+
+  // Show error but do not exit this procedure
   if (!bSuccess) ErrorExit(TEXT("CreateProcess"));
-  
+
   // Restore original value of PATH
   if (envPathExists) {
     if (!SetEnvironmentVariable(TEXT("PATH"), pszOldVal)) {
       ErrorExit(TEXT("SetEnvironmentVariable 2 failed"));
+      return 0;
     }
   } else {
     SetEnvironmentVariable(TEXT("PATH"), NULL);
@@ -332,7 +352,7 @@ void ErrorExit(PTSTR lpszFunction) {
     0, NULL);
 
   lpDisplayBuf = (LPVOID)LocalAlloc(LMEM_ZEROINIT,
-    (lstrlen((LPCTSTR)lpMsgBuf)+lstrlen((LPCTSTR)lpszFunction)+40)*sizeof(TCHAR));
+    (lstrlen((LPCTSTR)lpMsgBuf) + lstrlen((LPCTSTR)lpszFunction) + 40) * sizeof(TCHAR));
 
   snprintf((LPTSTR)lpDisplayBuf,
     LocalSize(lpDisplayBuf) / sizeof(TCHAR),
@@ -343,7 +363,7 @@ void ErrorExit(PTSTR lpszFunction) {
 
   LocalFree(lpMsgBuf);
   LocalFree(lpDisplayBuf);
-  ExitProcess(1);
+  //ExitProcess(1);
 }
 
 int RunProcessIn(char *cmd, char *dir, char *buf, int limit, int *len, int *err) {