IMPLEMENTATION MODULE SYSTEM;

IMPORT Exceptions;
IMPORT Terminate;
IMPORT String;

INLINE
  %#include <stdlib.h>
  %int system_argc;
  %char ** system_argv;
  %extern unsigned get_max_alloc_mem YPARAMS0;
  %extern int yafl_exit_code;
  %#ifdef YAFL_ANSI
  %extern void set_max_alloc_mem (unsigned long);
  %#else
  %extern void set_max_alloc_mem ();
  %#endif
  %extern unsigned allocation_count YPARAMS0;
  %
  %int yafl_debug_mode = YAFL_DEBUG_RUN;
  %int yafl_step_mode = 0;
  %#ifdef LCC
  %#include <windows.h>
  %
  %int _system(const char *cmd)
  %{
  %  BOOL                bResult;
  %  STARTUPINFO         si;
  %  PROCESS_INFORMATION pi;
  %  DWORD               exitcode;
  %
  %  memset(&si,0,sizeof(STARTUPINFO));
  %  si.cb = sizeof(STARTUPINFO);
  %
  %  bResult = CreateProcess(NULL,
  %			  cmd,
  %			  NULL,NULL, /* No security */
  %			  TRUE,	     /* Inherits handles */
  %			  0,	     /* Runs normally  */
  %			  NULL,NULL, /* Inherits env & cwd */
  %			  &si,&pi);
  %
  %  if (bResult == FALSE) 
  %    return system(cmd);
  %  /* Modification proposed by Sune Falck, Sune.Falck@swipnet.se */
  %  WaitForSingleObject(pi.hProcess,INFINITE);
  %  if (GetExitCodeProcess(pi.hProcess,&exitcode)==FALSE) {
  %      fprintf(stderr,"Impossible to get the exit status for %s\n",cmd);
  %      return -1;
  %   }
  %
  %  return (int)exitcode;
  %}
  %#endif
  % 
  %
  %char* y_full_cmd_line = NULL;
  %
  END;

  ONCE CLASS SYSTEM;
  
    VAR
      TheArgs: ARRAY OF ARRAY OF CHAR;
      
    METHOD UseCommandLine (CmdLine: ARRAY OF CHAR);
      BEGIN
      TheArgs := String.BreakInWords (CmdLine, " ", VOID);
      END UseCommandLine;
      
    METHOD CheckArgs;
      VAR
        a: ARRAY OF CHAR;
      BEGIN
      IF TheArgs = VOID THEN
        INLINE
          % if (y_full_cmd_line != NULL)
          %  Y_a = new_string(y_full_cmd_line);
          END;
        IF a <> VOID THEN
          UseCommandLine (a);
          END;
        END;
      END CheckArgs;
      
    METHOD HALT;
      BEGIN
      INLINE
        %{
        % yafl_terminate();
        % exit(yafl_exit_code);
        %}
        END;
      END HALT;
      
    METHOD ArgCount: INTEGER;
      BEGIN
      CheckArgs;
      IF TheArgs <> VOID THEN
        RESULT := TheArgs.SIZE;
       ELSE
        INLINE
          % Y_RESULT = system_argc - 1;
          END;
        END;
      END ArgCount;

    METHOD Argument(Nr: INTEGER): ARRAY OF CHAR;
      BEGIN
      CheckArgs;
      ASSERT (Nr >= 0);
      IF Nr < ArgCount THEN
        IF TheArgs <> VOID THEN
          RESULT := TheArgs [Nr];
         ELSE
          INLINE
            % Y_RESULT = new_string(*(system_argv + Y_Nr + 1));
            END;
          END;
        END;
      END Argument;

   METHOD Args: ARRAY OF ARRAY OF CHAR;
     BEGIN
     IF ArgCount > 0 THEN
       RESULT.CREATE (ArgCount);
       FOR i := 0 TO ArgCount - 1 DO
         RESULT[i] := Argument (i);
         END;
       END;
     END Args;
     
   METHOD GetEnvironment (Label: ARRAY OF CHAR): ARRAY OF CHAR;
     BEGIN
     INLINE
       % {
       %  char *p;
       %  p = getenv(Y_Label);
       %  if (p)
       %    Y_RESULT = new_string(p);
       % }
       END;
     END GetEnvironment;

    METHOD OperatingSystem: INTEGER;
      BEGIN
      RESULT := Dos;
      INLINE
        %#ifdef UNIX
        % Y_RESULT = 299;
        %#endif
        %#ifdef QNX
        % Y_RESULT = 399;
        %#endif
        %#ifdef COHERENT
        % Y_RESULT = 499;
        %#endif
        %#ifdef OS2
        % Y_RESULT = 599;
        %#endif
        %#ifdef MAC
        % Y_RESULT = 699;
        %#endif
        %#ifdef MVS
        % Y_RESULT = 799;
        %#endif
        %#ifdef LCC
        % Y_RESULT = 199;
        %#endif
        %#ifdef _WIN32
        % Y_RESULT = 899;
        %#endif
        END;
      END OperatingSystem;

    METHOD DirSepChar: CHAR;
      BEGIN                  
      CASE OperatingSystem OF
        Dos, OS2, Windows:
          RESULT := '\';
          END;
        Mac:
          RESULT := ':';
          END;
        Mvs:
          RESULT := '.';
          END;
       ELSE
        RESULT := '/';
        END;
      END DirSepChar;

    METHOD DirSeparator: ARRAY OF CHAR;
      BEGIN
      RESULT.CREATE(1);
      RESULT [0] := DirSepChar;
      END DirSeparator;

    METHOD ORD(Ch: CHAR): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = Y_Ch;
        END;
      END ORD;

    METHOD CHR(Code: INTEGER): CHAR;
      BEGIN
      INLINE
        % Y_RESULT = Y_Code;
        END;
      END CHR;

    METHOD LCASE(Ch: CHAR): CHAR;
      BEGIN
      INLINE
        % Y_RESULT = tolower(Y_Ch);
        END;
      END LCASE;

    METHOD UCASE(Ch: CHAR): CHAR;
      BEGIN
      INLINE
        % Y_RESULT = toupper(Y_Ch);
        END;
      END UCASE;

    METHOD IsLetter(Ch: CHAR): BOOLEAN;
      BEGIN
      INLINE
        % Y_RESULT = isalpha(Y_Ch);
        END;
      END IsLetter;

    METHOD IsSpace(Ch: CHAR): BOOLEAN;
      BEGIN
      INLINE
        % Y_RESULT = isspace(Y_Ch);
        END;
      END IsSpace;

    METHOD IsDigit(Ch: CHAR): BOOLEAN;
      BEGIN
      INLINE
        % Y_RESULT = isdigit(Y_Ch);
        END;
      END IsDigit;

    METHOD FLOAT(i: INTEGER): REAL;
      BEGIN
      INLINE
        % Y_RESULT = (double) Y_i;
        END;
      END FLOAT;

    METHOD TRUNC(r: REAL): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = (int) Y_r;
        END;
      END TRUNC;

    METHOD MIN (i, j : INTEGER) : INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_i < Y_j) ? Y_i : Y_j );
        END;
      END MIN;
      
    METHOD MAX (i, j : INTEGER) : INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_i > Y_j) ? Y_i : Y_j );
        END;
      END MAX;
      
    METHOD ABS (i: INTEGER) : INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_i > 0) ? Y_i : -Y_i );
        END;
      END ABS;
      
    METHOD RMIN (r, s : REAL) : REAL;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_r < Y_s) ? Y_r : Y_s );
        END;
      END RMIN;
      
    METHOD RMAX (r, s : REAL) : REAL;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_r > Y_s) ? Y_r : Y_s );
        END;
      END RMAX;
      
    METHOD RABS (r: REAL) : REAL;
      BEGIN
      INLINE
        % Y_RESULT = ( (Y_r > 0.0) ? Y_r : -Y_r );
        END;
      END RABS;
      
    METHOD STRC(Ch: CHAR): ARRAY OF CHAR;
      BEGIN
      RESULT.CREATE (1);
      RESULT[0] := Ch;
      END STRC;
      
    METHOD STRI(Code: INTEGER): ARRAY OF CHAR;
      BEGIN
      RESULT.CREATE (1);
      RESULT[0] := SYSTEM.CHR(Code);
      END STRI;
      
    METHOD GarbageCollector;
      BEGIN
      INLINE
        % garbage_collect();
        END;
      END GarbageCollector;

    METHOD SetExitCode (Code: INTEGER);
      BEGIN
      INLINE
        % {
        % extern int yafl_exit_code;
        % yafl_exit_code = (int) Y_Code;
        % }
        END;
      END SetExitCode;

    METHOD BitOr(One, Two: INTEGER): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = Y_One | Y_Two ;
        END;
      END BitOr;

    METHOD BitAnd(One, Two: INTEGER): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = Y_One & Y_Two ;
        END;
      END BitAnd;

    METHOD BitXor(One, Two: INTEGER): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = (Y_One & ~Y_Two) | (~Y_One & Y_Two);
        END;
      END BitXor;

    METHOD BitNegate(One: INTEGER): INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = ~Y_One;
        END;
      END BitNegate;

    METHOD TestBit(Value, BitNr: INTEGER): BOOLEAN;
      BEGIN
      ASSERT (BitNr >= 0) AND (BitNr < BitsPerInt);
      INLINE
        % Y_RESULT = Y_Value & (1 << Y_BitNr) ? TRUE : FALSE;
        END;
      END TestBit;

    METHOD SetBit (Value, BitNr: INTEGER): INTEGER;
      BEGIN
      ASSERT (BitNr >= 0) AND (BitNr < BitsPerInt);
      INLINE
        % Y_RESULT = Y_Value | (1 << Y_BitNr);
        END;
      END SetBit;

    METHOD UnSetBit (Value, BitNr: INTEGER): INTEGER;
      BEGIN
      ASSERT (BitNr >= 0) AND (BitNr < BitsPerInt);
      INLINE
        % Y_RESULT = Y_Value & ~(1 << Y_BitNr);
        END;
      END UnSetBit;

    METHOD SetMaxMem (Bytes: INTEGER);
      BEGIN
      INLINE
        % set_max_alloc_mem ((unsigned long) Y_Bytes);
        END;
      END SetMaxMem;

    METHOD GetMaxMem: INTEGER;
      BEGIN
      INLINE
        % {
        %  Y_RESULT = (yint) get_max_alloc_mem ();
        % }
        END;
      END GetMaxMem;

    METHOD Allocated: INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = get_total_alloc_mem();
        END;
      END Allocated;
      
    METHOD Allocations: INTEGER;
      BEGIN
      INLINE
        % {
        %  Y_RESULT = (yint) allocation_count();
        % }
        END;
      END Allocations;

    METHOD InitialAlloc (Bytes: INTEGER);
      BEGIN
      INLINE
        %{
        % char *p;
        % p = malloc(Y_Bytes);
        % if (p)
        %   free(p);
        %}
        END;
      END InitialAlloc;                              
      
    METHOD Execute (Command: ARRAY OF CHAR): INTEGER;
      VAR
        c: ARRAY OF CHAR;
      BEGIN              
      c := Command;
      INLINE
        %#ifdef LCC
        % Y_RESULT = _system (Y_c);
        %#else
        % Y_RESULT = system(Y_c);
        %#endif
        END;
      END Execute;
      
    METHOD TraceMode;
      BEGIN         
      INLINE
        % yafl_step_mode = 1;
        % yafl_debug_mode = YAFL_DEBUG_TRACE;
        END;
      END TraceMode;

    END SYSTEM;

END SYSTEM;
