IMPLEMENTATION MODULE Program ;
(*
        Title:          PANOS Program Control.
        Author:         Keith Rautenbach.
        History:
          09 Aug 84     Initial version.
          13 Aug 84     Remove explicit open of Input, Output, Error
          14 Aug 84     Change on Identity wanted, FALSE if strange Error.
                        Also, name should be "Identify" not "Identity".
          05 Sep 84     Addition of Stop, Arguments
          06 Sep 84     PushEnvironment for : Store, IO.
          12 Sep 84     Addition of Name()
          24 Sep 84     New Error routine.
          25 Sep 84     Remove Noddy. (and Bigears?)
          01 Sep 84     Loader push/pop environment added
          10 Oct 84     CLI$path added
          19 Oct 84     Fix Bugs In escape handling;
*)

FROM DecodeArg IMPORT DecodedInformation , GetStateArg ;
FROM Error IMPORT Panic , ErrorCode , Facility ,
                   ArgumentFacilityErrors,
                   ControlFacilityErrors; 
FROM GlobalString IMPORT GetGlobalString ;

FROM Convert IMPORT StringToCardinal ;

FROM Handler IMPORT Signal , Lock , Unlock , Abandon ;
IMPORT IO ;
IMPORT Store ;
IMPORT Loader ;
IMPORT Command ;
IMPORT Handler , DirtyHandler ;
IMPORT Utils;
IMPORT Debug ;

FROM SYSTEM IMPORT MAXINT , SIZE , ADR ;

FROM String IMPORT STRING , CopyLC , CopySC , CopyCS , LengthC ,CopyCC,
                   EqualCC, AppendCC, EndStringCh ;
IMPORT String ;

(* ========================================================================= *)

PROCEDURE Version( VAR String : ARRAY OF CHAR ) ;
BEGIN
   CopyLC( "Program         0.02/17  27 Nov 84 19:46:40", String ) ;
END Version ;


TYPE
   ActionProc                         = PROCEDURE( ARRAY OF CHAR ,
                                                   ARRAY OF CHAR ) : INTEGER ;
   EnvironmentP                       = POINTER TO EnvironmentR ;
   EnvironmentR                       = RECORD
      PushedEnvironment                  : EnvironmentP ;
      ProgramName                        : STRING ;
      ArgumentString                     : STRING ;
                                        END ;
VAR
   OutermostEnvironment               : EnvironmentR ;
   Environment                        : EnvironmentP ;
   RelocatableMagic                   : ARRAY [ 0..3 ]   OF CHAR ;
   AnyCurrentCommands                 : BOOLEAN;
   CurrentCommands                    : ARRAY [ 0..255 ] OF CHAR ;

(* ========================================================================= *)

PROCEDURE PushEnvironment( ProgName , ArgString : ARRAY OF CHAR ) : INTEGER ;
VAR
   Result                             : INTEGER ;
   NewEnvironment                     : EnvironmentP ;
   OldStoreTag                        : Store.HeapTag ;
BEGIN

   Result := Store.AllocateWithTag( NewEnvironment ,
                                    SIZE( NewEnvironment^ ) ,
                                    0 ) ;
   IF Result >= 0 THEN
      OldStoreTag := Store.SetStoreTag( 0 )  ;
      Lock() ;
      WITH NewEnvironment^ DO
         PushedEnvironment := Environment ;
         ProgramName := CopyCS( ProgName ) ;
         ArgumentString := CopyCS( ArgString ) ;
      END (* with *) ;
      Environment := NewEnvironment ;
      Unlock() ;
      OldStoreTag := Store.SetStoreTag( OldStoreTag ) ;
   END (* if *) ;
   RETURN Result ;
END PushEnvironment ;

(* ========================================================================= *)

PROCEDURE PopEnvironment() : INTEGER ;
VAR
   OldEnvironment                  : EnvironmentP ;
BEGIN
   Lock() ;
   IF Environment = NIL THEN
      Unlock() ;
      Panic( "Program.Popped" ) ;
   ELSE
      OldEnvironment := Environment^.PushedEnvironment ;
      String.Dispose( Environment^.ProgramName ) ;
      String.Dispose( Environment^.ArgumentString ) ;
      IF Store.Deallocate( Environment ) < 0 THEN
         (* Panic() *)
      END (* if *) ;
      Environment := OldEnvironment ;
      Unlock() ;
   END (* if *) ;
   RETURN 0 ;
END PopEnvironment ;


(* ========================================================================= *)


PROCEDURE Perform( Action : ActionProc ;
                   ProgramName : ARRAY OF CHAR ;
                   ArgumentString : ARRAY OF CHAR ) : INTEGER ;

VAR
   Result                           : INTEGER ;

   PROCEDURE CheckOk( ThisErrorCode : INTEGER ) : BOOLEAN;
   BEGIN
      IF ( ThisErrorCode < 0 ) AND ( Result = 0 ) THEN
         Result := ThisErrorCode ;
      END (* if *) ;
      RETURN Result = 0 ;
   END CheckOk ;


   PROCEDURE Check( ThisErrorCode : INTEGER ) ;
   BEGIN
      IF CheckOk( ThisErrorCode ) THEN
      END (* if *) ;
   END Check ;

VAR
   Closure                         : Handler.UsersEnvironment ;
BEGIN
   Result := 0 ;
   IF CheckOk( Store.PushEnvironment() ) THEN
      IF CheckOk( IO.PushEnvironment() ) THEN
         IF CheckOk( Loader.PushEnvironment() ) THEN
            IF CheckOk( PushEnvironment( ProgramName , ArgumentString ) ) THEN
               IF DirtyHandler.MakeClosure( Closure ) THEN
                  (*instal handler for escape events and enable them*)
                        IF CheckOk( Handler.PushEnvironment( Closure ) ) THEN
                            IF CheckOk( Escapes() ) THEN
                              Check( Action( ProgramName , ArgumentString ) ) ;
                              Check( Handler.PopEnvironment() ) ;
                            END (* if *) ;
                        END (* if *) ;
               ELSE
                  (* Have just done a LongJump, Closure.R0 is Result *)
                  Check( INTEGER( Closure.Register[ 0 ] ) ) ;
               END (* if *) ;
               Check( PopEnvironment() ) ;
            END (* if *) ;
            Check( Loader.PopEnvironment() ) ;
         END (* if *) ;
         Check( IO.PopEnvironment() ) ;
      END (* if *) ;
      Check( Store.PopEnvironment() ) ;
   END (* if *) ;
   RETURN Result ;
END Perform ;

(* ========================================================================= *)
PROCEDURE Escapes ( ) : INTEGER ;

VAR   Res    :INTEGER ;
CONST EscapeEvent = 6 ;

BEGIN
   Res := Handler.DeclareEventHandler(ProgramEscapeHandler,
                                      EscapeEvent,
                                      1(* action= Call this firts*),
                                      0 (* handle = 0 *));
   IF Res < 0  THEN RETURN Res END; 
   Res :=  Handler.SetEventStatus( EscapeEvent , TRUE (*enable*));
   IF Res < 0  THEN RETURN Res END;

   RETURN 0;

END Escapes ;


(* ========================================================================= *)
PROCEDURE ProgramEscapeHandler ( Code  : INTEGER;
                                data1  : INTEGER ;
                                data2  : INTEGER ;
                                handle : INTEGER ;
                                VAR E  : Handler.UsersEnvironment) ;
BEGIN

  Stop( ErrorCode (ControlFacility, CARDINAL(Escape), "") );

END ProgramEscapeHandler ;


(* ----------------------------------------------------------------------------
      Call(STRING:FileName,
           STRING:ProcedureName,
           STRING:ArgumentString); INTEGER:Result
*)
PROCEDURE Call( FileName : ARRAY OF CHAR ;
                ProcedureName : ARRAY OF CHAR ;
                ArgumentString : ARRAY OF CHAR ) : INTEGER ;
BEGIN
   RETURN ErrorCode (ControlFacility, CARDINAL(NotFound), "") ;
END Call ;


(* ----------------------------------------------------------------------------
      XCall(STRING:FileName,
            STRING:ProcedureName,
            STRING:ArgumentString);CARDINAL:Result
*)
PROCEDURE XCall( FileName : ARRAY OF CHAR ;
                 ProcedureName : ARRAY OF CHAR ;
                 ArgumentString : ARRAY OF CHAR ) : CARDINAL ;
BEGIN
END XCall ;


(* ----------------------------------------------------------------------------
      Run(STRING:ProgramName,
          STRING:ArgumentString); INTEGER:Result
*)
PROCEDURE Run( ProgramName : ARRAY OF CHAR ;
               ArgumentString : ARRAY OF CHAR ) : INTEGER ;

BEGIN
   RETURN Perform( ActionProc( Loader.Run ) , ProgramName , ArgumentString ) ;
END Run ;


(* ----------------------------------------------------------------------------
      XRun(STRING:ProgramName,
           STRING:ArgumentString);CARDINAL:Result
*)
PROCEDURE XRun( ProgramName : ARRAY OF CHAR ;
                ArgumentString : ARRAY OF CHAR ) : CARDINAL ;
VAR
   Result                  : INTEGER ;
BEGIN
   Result := Run( ProgramName , ArgumentString ) ;
   IF Result < 0 THEN
      Signal( Result , NIL ) ;
   END (* if *) ;
END XRun ;


(* ----------------------------------------------------------------------------
      Obey(STRING:CommandFileName,
           STRING:ArgumentString); INTEGER:Result
*)
PROCEDURE Obey( CommandFileName : ARRAY OF CHAR ;
                ArgumentString : ARRAY OF CHAR ) : INTEGER ;
BEGIN
   RETURN Perform( ActionProc( Command.ObeyFile ) ,
                   CommandFileName , ArgumentString ) ;
END Obey ;


(* ----------------------------------------------------------------------------
      XObey(STRING:CommandFileName,
            STRING:ArgumentString);CARDINAL:Result
*)
PROCEDURE XObey( CommandFileName : ARRAY OF CHAR ;
                 ArgumentString : ARRAY OF CHAR ) : CARDINAL ;
BEGIN
   Signal( -1 , NIL ) ;
END XObey ;

(* ----------------------------------------------------------------------------
      Invoke(STRING:Name,
             STRING:ArgumentString); INTEGER:Result
*)
PROCEDURE Invoke( Name : ARRAY OF CHAR ;
                  ArgumentString : ARRAY OF CHAR ) : INTEGER ;
VAR
   Junk                     : INTEGER ;
   Result                   : INTEGER ;
   File                     : INTEGER ;
   Buffer                   : ARRAY [ 0..3 ] OF CHAR ;
   BytesRead                : CARDINAL ;
   FullName                 : ARRAY [ 0..255 ] OF CHAR ;
   Index                    : CARDINAL ;

BEGIN       
   Index := 0;

   IF NOT AnyCurrentCommands  THEN
      RETURN ErrorCode (ControlFacility, CARDINAL (NoCurrentCommands), "") ;
   END;      
   WHILE (Utils.ExtractElement(CurrentCommands,
                               Index, (*out*)FullName)) DO
      IF ( FullName[ 0 ] = '.' ) AND ( FullName[ 1 ] = EndStringCh ) THEN
         CopyCC( Name , FullName ) ;
      ELSE
         AppendCC( Name , FullName ) ;
      END (* if *) ;
      File := IO.FindInput( FullName ) ;
      IF File >= 0 THEN
         Result := IO.SBlockRead( BytesRead , File , 4 , ADR( Buffer ) ) ;
         Junk := IO.CloseStream( File ) ;
         IF Result >= 0 THEN
            IF EqualCC( Buffer , RelocatableMagic ) THEN
               RETURN Perform( Loader.Run , FullName , ArgumentString );
            ELSIF Buffer[ 0 ] = '$' THEN
               RETURN Perform( Command.ObeyFile,FullName,ArgumentString ) ;
            END (* if *) ;
         END (* if *) ;
      END (* if *) ;
   END (* while *) ;
   RETURN ErrorCode (ControlFacility, CARDINAL (NotFound), Name) ;
END Invoke ;

(* ----------------------------------------------------------------------------
      XInvoke(STRING:Name,
              STRING:ArgumentString);CARDINAL:Result
*)
PROCEDURE XInvoke( Name : ARRAY OF CHAR ;
                   ArgumentString : ARRAY OF CHAR ) : CARDINAL ;
BEGIN
   Signal( -1 , NIL ) ;
END XInvoke ;

(* ----------------------------------------------------------------------------
      Stop(INTEGER: Result) ;
      (* n.b. NEVER returns *)
*)
PROCEDURE Stop( Result : INTEGER ) ;
BEGIN
   Abandon( Result ) ;
   Panic( "Program.Stop..." ) ;
END Stop ;

(* ----------------------------------------------------------------------------
      Arguments();STRING:ArgumentString
*)
PROCEDURE Arguments( VAR ArgumentString : ARRAY OF CHAR ) : CARDINAL ;
BEGIN
   Lock() ;
   CopySC( Environment^.ArgumentString , ArgumentString ) ;
   Unlock() ;
   RETURN LengthC( ArgumentString ) ;
END Arguments ;

(* ----------------------------------------------------------------------------
      Name();STRING:ProgramName
*)
PROCEDURE Name( VAR ProgramName : ARRAY OF CHAR ) : CARDINAL ;
BEGIN
   Lock() ;
   CopySC( Environment^.ProgramName , ProgramName ) ;
   Unlock() ;
   RETURN LengthC( ProgramName ) ;
END Name ;

(* ----------------------------------------------------------------------------
      SetKnownCommandsPath(STRING: Path); INTEGER:Result
*)
PROCEDURE SetKnownCommandsPath( Path : ARRAY OF CHAR ) : INTEGER ;
BEGIN
   CopyCC (  Path , CurrentCommands ) ;
   AnyCurrentCommands := TRUE;
   RETURN 0 ;
END SetKnownCommandsPath ;


(* ----------------------------------------------------------------------------
      XSetKnownCommandsPath(STRING:DirectoryName); INTEGER:Result
*)
PROCEDURE XSetKnownCommandsPath( DirectoryName : ARRAY OF CHAR ) ;
BEGIN
   Signal( -1 , NIL ) ;
END XSetKnownCommandsPath ;


(* ----------------------------------------------------------------------------
      Verbosity(); INTEGER:Result
*)
PROCEDURE Verbosity() : INTEGER ;
VAR
   Number                  : CARDINAL ;
   Buffer                  : ARRAY [ 0..10 ] OF CHAR ;
   Length                  : CARDINAL ;
BEGIN
   IF ( GetGlobalString( Buffer , Length , "PROGRAM$Verbose" ) >= 0 ) THEN
      Buffer[ Length ] := 0C ;
      IF ( StringToCardinal( Number , Buffer ) >= 0 ) THEN
         RETURN INTEGER( Number ) ;
      END (* if *) ;
   END (* if *) ;
   RETURN MAXINT ;
END Verbosity ;


(* ----------------------------------------------------------------------------
      XVerbosity(); INTEGER:Result
*)
PROCEDURE XVerbosity() : INTEGER ;
BEGIN
   RETURN Verbosity() ;
END XVerbosity ;


(* ------------------------------------------------------------------------- *)

PROCEDURE KeywordPresent( Keyword : ARRAY OF CHAR ;
                          Handle : DecodedInformation ) : BOOLEAN ;
VAR
   Present                     : BOOLEAN ;
BEGIN
   RETURN ( GetStateArg( Present , Keyword , Handle ) >=0 ) AND Present ;
END KeywordPresent ;


(* ----------------------------------------------------------------------------
      HelpRequired(DecodedInformation:Handle,
                   INTEGER:Error ); BOOLEAN:Result
*)
PROCEDURE HelpRequired( Handle : DecodedInformation ;
                        Error : INTEGER ) : BOOLEAN ;
BEGIN
   RETURN KeywordPresent( "Help" , Handle ) OR
          ( Error = ErrorCode( ArgumentUserFacility ,
                               CARDINAL( HelpWantedButBadArguments ),
                               "" ) ) ;
END HelpRequired ;


(* ----------------------------------------------------------------------------
      IdentifyRequired(DecodedInformation:Handle,
                       INTEGER:Error ); BOOLEAN:Result
*)
PROCEDURE IdentifyRequired( Handle : DecodedInformation ;
                            Error : INTEGER ) : BOOLEAN ;
BEGIN
   IF Error < 0 THEN
      RETURN Error = ErrorCode( ArgumentUserFacility ,
                                CARDINAL( IdentifyWantedButBadArguments ),
                                "" ) ;
   ELSE
      RETURN KeywordPresent( "Identify" , Handle ) OR ( Verbosity() > 0 ) ;
   END (* if *) ;
END IdentifyRequired ;

(* ========================================================================= *)

BEGIN
   Environment := ADR( OutermostEnvironment ) ;
   WITH Environment^ DO
      PushedEnvironment := NIL ;
      ArgumentString := NIL ;
   END (* with *) ;
   RelocatableMagic[ 0 ] := CHAR( 80H ) ;
   RelocatableMagic[ 1 ] := CHAR( 14H ) ;
   RelocatableMagic[ 2 ] := CHAR( 33H ) ;
   RelocatableMagic[ 3 ] := CHAR( 22H ) ;
   CurrentCommands [ 0 ] := EndStringCh ;
   AnyCurrentCommands := FALSE;
END Program.