home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d5xx / d512 / m2pascal.lha / M2Pascal / src / m2pascal.mod < prev    next >
Text File  |  1991-07-20  |  9KB  |  354 lines
  1. MODULE m2pascal;
  2.  
  3. (*   
  4.                   MODULE-2  TRANSLATOR   ( m2 => pascal )        
  5.                   by:     Greg Mumm
  6.                   status: Public Domain. No version or derivative is to 
  7.                           sold for ANY profit w/o my express written permission.
  8.                           Please leave my name intact somewhere if you plan
  9.                           to upgrade it.
  10. *)
  11.  
  12. FROM SYSTEM       IMPORT ADR;
  13.  
  14. FROM process      IMPORT ProcessSymbol;
  15.  
  16. FROM options      IMPORT OptionsRec;
  17.  
  18. FROM System       IMPORT argc,            argv ;
  19.  
  20. FROM scan         IMPORT ReadSymbol,       ReadAheadSymbol, STRING,
  21.                          ReadLine,         ReadAheadLine,   TooFar,
  22.                          OpenInFile,       eof,             eoln,
  23.                          CloseAllFiles,    OpenOutFile,
  24.                          IndentArray,      DebugPrintLine,  SymbolType,
  25.                          SPACE,            TAB,             NameString,
  26.                  DebugOutputToggle,PrintLineNumber;
  27.  
  28. FROM errors       IMPORT CleanUp,         FatalError,      ErrorType;
  29.  
  30. FROM InOut        IMPORT WriteString,     WriteCard;
  31.  
  32. FROM Strings      IMPORT StringLength,    ConcatString,     DeleteSubString, 
  33.                          LocateSubString, CompareStringCAP, Relation,
  34.                          CopyString ;
  35. FROM heap         IMPORT ALLOCATE;
  36.  
  37. FROM Tasks        IMPORT SetSignal, SignalSet;   (* all for BreadC procedure *)
  38.  
  39.  
  40. CONST
  41.          DEBUG   = FALSE;
  42.          VERSION = "1.0";
  43.  
  44. VAR
  45.         InName, OutName : NameString;
  46.         indent          : IndentArray;
  47.         BreakCSet       : BOOLEAN;
  48.  
  49.  
  50. PROCEDURE  init;
  51. BEGIN
  52.    BreakCSet    :=   FALSE;
  53. END init;
  54.  
  55.  
  56.  (* Detect Control-C *)
  57. PROCEDURE BreakC(): BOOLEAN;
  58. CONST
  59.   BreakCode = 12;
  60. VAR ReturnCode : BOOLEAN;
  61. BEGIN
  62.   ReturnCode := BreakCode IN SetSignal(SignalSet{}, SignalSet{BreakCode});
  63.   IF ReturnCode THEN
  64.        BreakCSet := TRUE;
  65.   END;
  66.   RETURN ReturnCode;
  67. END BreakC;
  68.  
  69.  
  70.  
  71. (*
  72.    -----------------------------------------------------------------------
  73.                    Process the CLI parameters.
  74.      \/                        \/                                \/
  75. *)
  76.  
  77.  
  78.  
  79.  
  80. PROCEDURE same ( s1, s2  : NameString ) : BOOLEAN;
  81. BEGIN
  82.     RETURN   (  CompareStringCAP ( s1, s2 ) = equal );
  83. END same;
  84.  
  85.  
  86.  
  87.  
  88. PROCEDURE SetParameters ( VAR p1, p2, p3 : NameString );
  89.  VAR  np1, np2, np3 :  POINTER TO NameString;   
  90. BEGIN
  91.      p1 := "\0";   p2 := "\0";   p3 := "\0";
  92.  
  93.     IF argc >= 2 THEN
  94.          np1  :=  ADR ( argv^[1]^ ) ;
  95.          CopyString ( p1, np1^ );
  96.     END;
  97.  
  98.     IF argc >=3 THEN
  99.          np2 := ADR ( argv^[2]^ );
  100.          CopyString ( p2  , np2^ );
  101.     END;
  102.  
  103.     IF argc >=4 THEN
  104.          np3 := ADR ( argv^[3]^ );
  105.          CopyString ( p3  , np3^ );
  106.     END;
  107. END SetParameters;
  108.  
  109.  
  110.  
  111. PROCEDURE OpenIn () : BOOLEAN;
  112.  VAR good : BOOLEAN;
  113. BEGIN
  114.    OpenInFile ( InName, FALSE, good );
  115.    RETURN good;
  116. END OpenIn;
  117.  
  118.  
  119.  
  120. PROCEDURE OpenOut () : BOOLEAN;
  121.  VAR good : BOOLEAN;
  122. BEGIN
  123.        OpenOutFile ( OutName, TRUE, good ); 
  124.        RETURN good;    
  125. END OpenOut;
  126.  
  127.  
  128. PROCEDURE OpenUpFiles ( p1, p2 : NameString );
  129.  VAR good : BOOLEAN;
  130. BEGIN
  131.    CopyString ( InName,  p1 ) ;
  132.    CopyString ( OutName, p2 ) ;
  133.  
  134.    IF OpenIn () THEN
  135.        IF NOT OpenOut () THEN
  136.            FatalError ( CliHelp );          
  137.        END;
  138.    ELSE
  139.        ConcatString ( InName, ".mod");
  140.        IF OpenIn () THEN
  141.             IF NOT OpenOut ()THEN
  142.                 FatalError ( CliHelp );
  143.             END;
  144.        ELSE
  145.             FatalError ( CliHelp );
  146.        END;
  147.    END;
  148. END OpenUpFiles;
  149.  
  150.  (* user is specifically requesting help or information.
  151.  *)
  152. PROCEDURE HelpRequested ();
  153. BEGIN
  154.      WriteString ("\nexample session:\n");
  155.      WriteString ("         1> cp df1:prog.mod ram:\n");
  156.      WriteString ("         1> m2pascal prog.mod\n");
  157.      WriteString ("         1> more prog.p\n");
  158.      WriteString ("              option \"-bd\" (begin down) puts 'begin' \n");
  159.      WriteString ("              on following line. The default is to put\n");
  160.      WriteString ("              it on the same line as the command\n\n");
  161. END HelpRequested ;
  162.  
  163.  
  164. PROCEDURE help( p1 : NameString ) : BOOLEAN;
  165. BEGIN
  166.     RETURN ( same( p1 , "-?")   OR 
  167.              same( p1 , "-h")  ) ;
  168.  
  169. END help;
  170.  
  171.  
  172. PROCEDURE InFileEnding () : BOOLEAN;
  173.  VAR l : CARDINAL;
  174. BEGIN
  175.     l := StringLength ( InName );
  176.     RETURN ( LocateSubString ( InName, ".mod", l-4, l-1  ) <> -1 );
  177. END InFileEnding ;
  178.  
  179.  
  180. PROCEDURE BeginNewLine ( p1 : NameString ) : BOOLEAN;
  181. BEGIN
  182.        RETURN  (  same( p1 , "-bn" )   OR
  183.                   same( p1 , "-bd" )  )
  184. END BeginNewLine;
  185.  
  186.  
  187. PROCEDURE ProcessCommands ( p1, p2, p3 : NameString ) : BOOLEAN;
  188. BEGIN
  189.      IF  BeginNewLine ( p1 ) THEN
  190.            
  191.            CopyString ( InName,  p2 ) ;
  192.            CopyString ( OutName, p3 ) ;
  193.            OptionsRec.BeginNewLine := TRUE;
  194.            RETURN TRUE;
  195.      ELSE
  196.            RETURN FALSE;
  197.      END;
  198. END ProcessCommands ;
  199.  
  200.  
  201. PROCEDURE ProcessArgc2 ( VAR p1, p2, p3 : NameString );
  202.  VAR l : CARDINAL;
  203. BEGIN
  204.         IF help ( p1 ) THEN
  205.             HelpRequested ();
  206.             CleanUp();
  207.         ELSE
  208.             CopyString ( InName, p1 );
  209.         END;
  210.  
  211.         CopyString ( OutName, InName ) ;
  212.         IF InFileEnding () THEN
  213.             l         := StringLength ( OutName );
  214.             DeleteSubString( OutName, l - 4, l );        
  215.         END;
  216.  
  217.         ConcatString ( OutName, ".p");
  218.         IF OpenIn () THEN
  219.             IF NOT OpenOut () THEN
  220.                  FatalError ( CliHelp );
  221.             END;
  222.         ELSE
  223.             ConcatString ( InName, ".mod" );
  224.             IF OpenIn () THEN
  225.                 IF NOT OpenOut () THEN
  226.                      FatalError ( CliHelp );
  227.                  END;
  228.             ELSE
  229.                  FatalError ( CliHelp );
  230.             END;
  231.         END;
  232. END ProcessArgc2;
  233.  
  234.  
  235. (*  IN:   CLI parameters.
  236.     OUT:  InFile, OutFile ( properly opened )   OR    
  237.           Errors/help information.
  238. *)
  239. PROCEDURE ProcessCli ();
  240.  VAR   p1, p2, p3 : NameString;       l : CARDINAL;
  241. BEGIN
  242.   SetParameters ( p1, p2, p3 );
  243.   IF DEBUG THEN
  244.        WriteString("ProcessCli() enter [ after SetParameters ]\n");
  245.        WriteString("CLI p1 = |");WriteString(p1);WriteString("|\n");
  246.        WriteString("CLI p2 = |");WriteString(p2);WriteString("|\n");
  247.        WriteString("CLI p3 = |");WriteString(p3);WriteString("|\n");
  248.   END;
  249.   IF    argc = 4 THEN
  250.         IF ProcessCommands ( p1, p2, p3 ) THEN
  251.             OpenUpFiles ( p2, p3 );
  252.         ELSE
  253.             FatalError ( CliHelp );
  254.         END;
  255.   ELSIF ( argc = 3 ) OR ( argc = 2 ) THEN
  256.         IF ( argc = 3 ) THEN
  257.              IF ( NOT BeginNewLine ( p1 ) ) THEN
  258.                   OpenUpFiles ( p1, p2 );
  259.              ELSE
  260.                   argc := 2;
  261.                   OptionsRec.BeginNewLine := TRUE;
  262.                   p1 := "\0";
  263.                   ConcatString ( p1, p2 );
  264.              END;
  265.         END;
  266.         IF ( argc = 2 ) THEN
  267.              ProcessArgc2 ( p1, p2, p3 );
  268.         END;
  269.   ELSIF argc = 1 THEN
  270.         FatalError ( CliHelp );
  271.   ELSIF argc = 0 THEN
  272.         FatalError ( WorkBench );
  273.   ELSE
  274.         FatalError ( CliHelp );
  275.   END;
  276. END ProcessCli;
  277.  
  278.  
  279. (*
  280.      ^                          ^                                ^
  281.                    Process the CLI parameters.
  282.    -----------------------------------------------------------------------
  283. *)
  284.  
  285.  
  286.  
  287. PROCEDURE AuthorVersion ();
  288. BEGIN
  289.    WriteString ("    M2PASCAL  by: Greg Mumm  ( VER ");
  290.    WriteString (VERSION);
  291.    WriteString (" BETA )\n");
  292.    WriteString ("                  "); WriteString(InName);
  293.    WriteString ("  ==>  "); WriteString(OutName); WriteString("\n");
  294.  
  295. END AuthorVersion;
  296.  
  297.  
  298.  
  299. PROCEDURE DebugPrintSymbol ( symbol : STRING;  SymbolClass : SymbolType );
  300. BEGIN
  301.    WriteString("-");
  302.    IF ( ( symbol [ 0 ] = SPACE )  OR ( symbol [ 0 ] = TAB ) ) THEN
  303.         WriteString("<blanks>");
  304.    ELSE         
  305.         WriteString( symbol );
  306.    END;
  307.    WriteString("       ");
  308.    IF SymbolClass = number THEN
  309.         WriteString("number\n");
  310.    ELSIF SymbolClass = identifier THEN
  311.         WriteString("identifier\n");
  312.    ELSIF SymbolClass = end THEN
  313.         WriteString("end\n");
  314.    ELSIF SymbolClass = literal THEN
  315.         WriteString("literal\n");
  316.    ELSIF SymbolClass  = blanks  THEN
  317.         WriteString("blanks or tabs\n");
  318.    ELSIF SymbolClass = other   THEN
  319.         WriteString("other\n");
  320.    END;
  321. END DebugPrintSymbol;
  322.  
  323.  
  324.  
  325.  
  326. PROCEDURE DoMain ();
  327.  VAR good : BOOLEAN;  symbol : STRING;   SymbolClass : SymbolType;
  328. BEGIN
  329.  
  330.         good := ReadLine ( indent );
  331.  
  332.         WHILE ( NOT eof ()   AND ( good )  AND ( NOT BreakC()  ) ) DO
  333.           PrintLineNumber();
  334.           WHILE NOT eoln ()  DO
  335.                 ReadSymbol ( symbol, SymbolClass );
  336.                 ProcessSymbol ( indent, symbol, SymbolClass );
  337.           END;
  338.           good := ReadLine ( indent );
  339.         END;
  340.  
  341.         IF NOT good  THEN FatalError ( FileError ); END;
  342.         IF BreakCSet THEN FatalError ( UserHalt  ); END;
  343. END DoMain;
  344.  
  345.  
  346.  
  347. BEGIN (* main *)
  348.         ProcessCli ();
  349.         AuthorVersion ();
  350.         DoMain ();
  351.         CleanUp;
  352.         WriteString("\n");
  353. END m2pascal.
  354.