/* TurboText ARexx Macro for M2Sprint Modula-2 Compiler */
/* Version 1.0, 04 April 95 by J. E. Gilpin */
/*
$VER: TTX_M2S_Compile 1.0 (04.04.95)
*/

/*************************************************************************/
/* Tell ARexx to request a results string from external commands.        */
/*-----------------------------------------------------------------------*/
OPTIONS RESULTS

/*************************************************************************/
/* Set up a prompt for the ARexx console window. Requesting user input   */
/* at the end of this ARexx macro allows the compiler output to be       */
/* examined before closing the console window.                           */
/*-----------------------------------------------------------------------*/
OPTIONS PROMPT "Press <CTRL \> or <RETURN> to exit:>"

/*************************************************************************/
/* Define BOOLEAN constants & control characters for program readability.*/
/*-----------------------------------------------------------------------*/
TRUE = 1; FALSE = 0; LF = '0A'x; CR = '0D'x; Space = '20'x; Tab = '09'x

/*************************************************************************/
/* Use the TurboText Command "GetFileInfo" to get length, status and     */
/* filename of the program currently loaded in the editor.               */
/*-----------------------------------------------------------------------*/
GetFileInfo

/*************************************************************************/
/* Parse the result string to assign the status to a variable. Since     */
/* "GetFileInfo" returns three values, periods are used as placeholders  */
/* for the unused values. The program only uses the second value.        */
/* The variable "Modified" will be assigned a Boolean result (YES or NO) */
/* NOTE: The filename returned by "GetFileInfo" is enclosed in double    */
/* quotes. To assign the filename (without quotes) to a variable,        */
/* substitute the term '"'Name'"' for the last period.                   */
/*-----------------------------------------------------------------------*/
PARSE VAR RESULT . Modified .

/*************************************************************************/
/* If the program (document) has been changed since the last time it was */
/* saved, save the program now. This is necessary, since the compiler    */
/* operates on the program file; NOT the program in memory.              */
/* If you want control over saves, add a requester here.                 */
/*-----------------------------------------------------------------------*/
IF Modified=YES THEN DO
  SaveFile NOICON
END

/*************************************************************************/
/* Use the TurboText Command "GetFilePath" to get the complete file path */
/* and name of the program currently loaded in the editor.               */
/*-----------------------------------------------------------------------*/
GetFilePath
Name=RESULT

/*************************************************************************/
/* Extract the path portion of the filename to use as the destination    */
/* directory for the Compiler.                                           */
/*-----------------------------------------------------------------------*/
dir=LASTPOS('/',Name)        /* Check for a directory delimiter.         */
device=LASTPOS(':',Name)     /* Check for a device or volume delimiter.  */
IF dir>0 THEN Path=LEFT(Name,dir-1)             /* Path is a directory.  */
ELSE IF device>0 THEN Path=LEFT(Name,device)    /* Path is device or vol.*/
ELSE DO
  SAY "Can't get File Path"  /* No path found, so this macro won't work. */
  SIGNAL Depart              /* Exit the macro. */
END

/*************************************************************************/
/* Switch to TurboText's second view before executing any commands which */
/* might move the cursor to another location in the program. Executing   */
/* TurboText Command "SwitchView" at the end of this macro will switch  */
/* back to the original view and cursor position. This step isn't        */
/* necessary, but it eliminates confusion caused by unexpected cursor    */
/* movement. If you are using TurboText's second view for another        */
/* purpose, you can eliminate this step.                                 */
/*-----------------------------------------------------------------------*/
SwitchView

/*************************************************************************/
/* Call the M2Sprint Compiler "M2S" to compile the program. This         */
/* invocation of the Compiler overrides the Input and Output settings in */
/* the compiler configuration file. The output file (link file) will     */
/* appear in the same directory as the program file so that the linker   */
/* 'ARexx Macro' can find it. The output file name will be the same as   */
/* the Program "MODULE" Name with the extension ".lnk" added.            */
/* The M2Sprint Compiler requires at least 16000 bytes of stack to run.  */
/* Increase the stack size, then Compile the program!                    */
/*-----------------------------------------------------------------------*/
ADDRESS COMMAND stack 32000||'0A'x||'M2Sprint:M2C '||'"'||Name||'"'||' TO '||'"'||Path||'"'

/*************************************************************************/
/* Check for the presence of the file "M2.errorlog" in the T: directory. */
/* The existence of this file indicates that the compiler found errors   */
/* in the program. If the error log is not present, skip to the depart   */
/* procedure and complete this ARexx compile macro.                      */
/*-----------------------------------------------------------------------*/
IF ~EXISTS("T:M2.errorlog") THEN DO
  SAY "Error Log Not Present"
  SIGNAL Depart
END

/*************************************************************************/
/* Attempt to open the error log. If unsuccessful, inform the user and   */
/* skip to the depart procedure. IF successful, read the filename at the */
/* beginning of the log and compare it to the program filename. If the   */
/* names match, it is a valid error log for the current program. Write   */
/* zero (0) at the beginning of the file as a flag for the error macro.  */
/*-----------------------------------------------------------------------*/
IF ~OPEN("ErrorLog","T:M2.errorlog","APPEND") THEN DO /* Open error log  */
  SAY "Can't open Error Log"    /* Write error message and exit if error */
  SIGNAL Depart                 /* can't be found or opened.             */
END

Position=1        /* Start position of source filename in the error log. */
FileName=''       /* Initialize filename variable to null string.        */
DO WHILE ~EOF("ErrorLog")      /* Repeat until end of file if necessary. */
  CALL SEEK("ErrorLog",Position,"B")       /* Move to next byte in file. */
  Character=READCH("ErrorLog",1)           /* Get next char in filename. */
  IF C2D(Character)=0 THEN LEAVE           /* Exit if string terminator. */
  FileName=FileName||Character             /* Append char to filename.   */
  Position=Position+1                      /* Increment pos. & repeat.   */
END
IF ~(Name=FileName) THEN DO                /* Compare names.             */
  SAY "Invalid Error Log"                  /* Write error message.       */
  CALL CLOSE("ErrorLog")                   /* Close file before exiting. */
  SIGNAL Depart                            /* Exit if names don't match. */
END
IF ~(SEEK("ErrorLog",0,"B")=0) THEN DO     /* Move to beginning of file. */
  SAY "FileSystem Error"                   /* Write error message.       */
  CALL CLOSE("ErrorLog")                   /* Close file before exiting. */
  SIGNAL Depart                            /* Exit if move unsuccessful. */
END
IF ~(WRITECH("ErrorLog",D2C(0))=1) THEN DO /* Set flag for errlist macro */
  SAY "FileSystem Error"                   /* Write error message.       */
  CALL CLOSE("ErrorLog")                   /* Close file before exiting. */
  SIGNAL Depart                            /* Exit if write unsuccessful.*/
END
CALL CLOSE("ErrorLog")                     /* Close file before exiting. */
SAY "Error Log Valid"                      /* Continue Macro.            */
CALL DeleteOld                             /* Delete Old Compiler output.*/

Depart:
SAY ""
PARSE PULL CmdString      /* Wait for user input before closing console. */
SwitchView                /* Return editor to original cursor position.  */
EXIT


DeleteOld:
/*************************************************************************/
/* Check for the existence of an output file (link file) produced by a   */
/* previous invocation of the compiler and erase it if found.            */
/* When the compiler finds errors it does not produce an output (link)   */
/* file. However, an old link file compiled from an earlier or different */
/* version of the program may exist in the output directory. Erasing the */
/* earlier version reduces confusion. This procedure is not essential to */
/* the overall operation of the macro and can be eliminated.             */
/*-----------------------------------------------------------------------*/
DefMod=FALSE
GetPrefs FreeForm                   /* Get line wrap setting.            */
Form=RESULT                         /* Save as variable "Form".          */
SetPrefs FreeForm OFF               /* Enables word wrap at EOL.         */
MoveSOF                             /* Move cursor to start of program.  */
DO WHILE RC=0                       /* Exit loop if past end of text.    */
  IF ~FindWord() THEN LEAVE         /* "FindWord" skips M2 comments etc. */
  GetWord; Word=RESULT              /* Get word & assign to variable.    */
  SELECT
   WHEN Word = "MODULE" THEN        /* If the word is MODULE exit loop.  */
    DO
     MoveRight 6                    /* Move cursor past word MODULE      */
     IF ~FindWord() THEN LEAVE      /* "FindWord" skips M2 comments etc. */
     CALL DeleteFile                /* Delete the file.                  */
     SetPrefs FreeForm Form         /* Restore original FreeForm setting.*/
     RETURN                         /* Deleted File, return to main prog.*/
    END
   WHEN Word = "DEFINITION" THEN    /* IF word is DEFINITION skip it.    */
    DO
     DefMod=TRUE                    /* Set file extension flag.          */
     MoveRight 10                   /* Move cursor past word & continue. */
    END
   WHEN Word="IMPLEMENTATION" THEN  /* If word is IMPLEMENTATION skip it.*/
    DO
     MoveRight 14                   /* Move cursor past word & continue. */
    END
   OTHERWISE LEAVE                  /* Word MODULE not found. Exit loop  */
  END
END
SetPrefs FreeForm Form              /* Restore original FreeForm setting.*/
SAY "MODULE Name not found"         /* Write error message.              */
RETURN                              /* Can't find name, exit procedure.  */


DeleteFile:
/*************************************************************************/
/* Add the appropriate filename extension to the module name. If a Link  */
/* file with that name exists, delete it. If the "DeleteOld" procedure   */
/* is removed from this Macro, remove this procedure also.               */
/*-----------------------------------------------------------------------*/

GetWord                             /* Get word following "MODULE".      */
ModuleName=RESULT                   /* Assign module name to a variable. */
IF DefMod THEN Extension=".sym"     /* IF definition module use ".sym"   */
ELSE Extension=".lnk"               /* extension, otherwise use ".lnk".  */
IF RIGHT(Path,1)=":" THEN PathName=Path  /* IF Path is not a device or   */
ELSE PathName=Path||"/"                  /* volume add a "/".            */
LinkName=PathName||ModuleName||Extension /* Add extension to module name.*/
IF EXISTS(LinkName) THEN DO         /* Check for presence of link file.  */
  LinkName='"'||LinkName||'"'       /* Add quotes for delete command.    */
  ADDRESS COMMAND Delete LinkName   /* Erase link file if found.         */
END
RETURN


FindWord:
/*************************************************************************/
/* M2Sprint (like most Modula-2 compilers) allows comments to precede    */
/* the module name. The Modula-2 keyword "MODULE" could be present       */
/* within a comment and result in a filename misidentification if a word */
/* search is performed. Therefore, a character search is performed       */
/* instead. This procedure can be removed if the "DeleteOld" procedure   */
/* is removed. This procedure returns a BOOLEAN value "TRUE" when the    */
/* first uncommented word is found; otherwise it returns "FALSE".        */
/*-----------------------------------------------------------------------*/

DO WHILE RC=0                       /* Repeat until end of text.         */
  Skip=TRUE                         /* Initialize BOOLEAN flag for loop. */
  DO WHILE Skip                     /* Start text analysis loop.         */
    GetChar; Char=RESULT            /* Get a character to check.         */
    SELECT                          /* Skip spaces, line feeds etc.      */
      WHEN Char=CR    THEN Skip=TRUE
      WHEN Char=LF    THEN Skip=TRUE
      WHEN Char=Tab   THEN Skip=TRUE
      WHEN Char=Space THEN Skip=TRUE
      OTHERWISE Skip=FALSE          /* Text, so set flag to exit loop.   */
    END
    IF Skip THEN MoveRight          /* Move cursor to next character.    */
    IF RC~=0 THEN RETURN FALSE      /* If error indicates EOF, return F. */
  END
  IF Char="(" THEN DO               /* Check for start of M2 comment.    */
    MoveRight;GetChar;Char=RESULT   /* Get next character.               */
    IF Char~="*" THEN RETURN FALSE  /* If not comment, return FALSE.     */
    DO UNTIL Char=")"               /* Loop until end comment found.     */
      DO UNTIL Char="*"             /* Loop until asterisk found.        */
        MoveRight                   /* Move cursor to next character.    */
        IF RC~=0 THEN RETURN FALSE  /* If error indicates EOF, return F. */
        GetChar; Char=RESULT        /* Get a character to check.         */
      END
      MoveRight                     /* Move cursor to next character.    */
      IF RC~=0 THEN RETURN FALSE    /* If error indicates EOF, return F. */
      GetChar; Char=RESULT          /* Get a character to check.         */
    END
    MoveRight                       /* Must have found end of comment to */
    ITERATE                         /* get here, so move cursor and skip */
  END                               /* to next iteration of outer loop.  */
  RETURN TRUE                       /* Skipped legal comments & chars so */
END                                 /* return TRUE.                      */
RETURN FALSE                        /* No legal M2 word found, return F. */

/*-----------------------------------------------------------------------*/