IMPLEMENTATION MODULE StoreInfo ;

FROM SYSTEM IMPORT WORD;

FROM Store IMPORT Information, HeapInformation;

FROM String IMPORT LengthC;

FROM Convert IMPORT CardinalToString;

FROM Program IMPORT Verbosity , HelpRequired , IdentifyRequired ;

IMPORT Debug ;
IMPORT Store ;

FROM DecodeArg IMPORT DecodedInformation , DecodeInit , DecodeEnd ,
                      GetNumberOfValues , GetStringArg , GetStateArg ;


FROM IO IMPORT WriteByte , FindOutput , SelectOutput , CloseStream ;


VAR
   Result                     : INTEGER ;

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

PROCEDURE Wrch( Ch : CHAR ) ;
VAR
   Junk                    : INTEGER ;
BEGIN
   Junk := WriteByte( INTEGER( Ch ) ) ;
   IF Junk < 0 THEN
      Debug.WriteS( "*NWriteByte failed : Result = " ) ;
      Debug.WriteH( Junk ) ;
      Debug.WriteS( "*N" ) ;
      IF Result = 0 THEN
         Result := Junk ;
      END (* if *) ;
   END (* if *) ;
END Wrch ;

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

PROCEDURE WriteS( Text : ARRAY OF CHAR ) ;
VAR
   Length                  : CARDINAL ;
   Index                   : CARDINAL ;
   Ch                      : CHAR ;

BEGIN
   Index := 0 ;
   Length := LengthC( Text ) ;
   WHILE Index < Length DO
      Ch := Text[ Index ] ;
      IF Ch = '*' THEN
         INC( Index ) ;
         Ch := Text[ Index ] ;
         IF Ch = 'N' THEN
            Ch := 012C ;
         ELSE
            Wrch( '*' ) ;
         END (* if *) ;
      END (* if *) ;
      Wrch( Ch ) ;
      INC( Index ) ;
   END (* while *) ;
END WriteS ;

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

PROCEDURE Program( ArgumentString : ARRAY OF CHAR ) : INTEGER ;
VAR
   Commands                   : BOOLEAN ;


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

   PROCEDURE Check( This : INTEGER ) : BOOLEAN ;
   BEGIN
      IF This < 0 THEN
         IF Result = 0 THEN
            Result := This ;
         END (* if *) ;
         RETURN FALSE ;
      ELSE
         RETURN TRUE ;
      END (* if *) ;
   END Check ;




   PROCEDURE GiveHelp() ;
   BEGIN
      WriteS( Version ) ;
      WriteS( "Prints Information on Store Usage*N" ) ;
      WriteS( "Keywords :*N" ) ;
      WriteS( "  Chains   : Prints Store Allocator chains*N" ) ;
      WriteS( "  To       : Optional destination of Output*N" ) ;
      WriteS( "  Identify : Prints name and version number*N" ) ;
      WriteS( "  Help     : Prints this information*N" ) ;

   END GiveHelp ;

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

   PROCEDURE PrintField (name : ARRAY OF CHAR; Value : WORD);

   VAR number : ARRAY [0..20] OF CHAR;
       length : CARDINAL;
       junk   : INTEGER;

   BEGIN


      WriteS (name);
      WriteS (" = ");
      junk := CardinalToString (number, length, CARDINAL (Value), 16);
      WriteS (number);
      WriteS (" (");
      junk := CardinalToString (number, length, CARDINAL (Value), 10);
      WriteS (number);
      WriteS (")*N");

   END PrintField;



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

VAR
   Handle                     : DecodedInformation ;
   Junk                       : BOOLEAN ;
   KeyString                  : ARRAY [ 0..80 ] OF CHAR ;
   Version                    : ARRAY [ 0..30 ] OF CHAR ;
   Chains                     : BOOLEAN ;
   Output                     : INTEGER ;
   OutputName                 : ARRAY [ 0..255 ] OF CHAR ;
   OutputLength               : CARDINAL ;
   Info                       : HeapInformation ;

BEGIN
   Result := 0 ;
   KeyString := "Chains/S To/K[ Output: ] Identify/S Help/S" ;
   Version := "StoreInfo Version 0.01/06*N" ;
   IF Check( DecodeInit( Handle , KeyString , ArgumentString ) ) THEN
   END (* if *) ;   
   IF HelpRequired( Handle , Result ) THEN
      GiveHelp() ;
      RETURN 0 ;
   ELSE
      IF IdentifyRequired( Handle , Result ) THEN
         WriteS( Version ) ;
         IF Result < 0 THEN
            RETURN 0 ;
         END (* if *) ;
      END (* if *) ;
   END (* if *) ;

   IF Check( GetStringArg( OutputName , OutputLength ,
                           "To" , 1 , Handle ) ) THEN
      OutputName[ OutputLength ] := 0C ;
      Output := FindOutput( OutputName ) ;
      IF Check( Output ) AND Check( SelectOutput( Output ) ) THEN
      END (* if *) ;
   END (* if *) ;
   Junk := Check( GetStateArg( Chains , "Chains" , Handle ) ) ;
   Junk := Check( DecodeEnd( Handle ) ) ;
   IF Result = 0 THEN
      IF Check (Information (Info)) THEN
         WITH Info DO
            PrintField ("Base of Managed area     ", Base);
            PrintField ("Size of Managed ares     ", Size);
            PrintField ("Free space               ", Free);
            PrintField ("Largest free block       ", SizeOfLargest);
            PrintField ("Free Module spece        ", FreeModuleSpace);
            PrintField ("Largest free Module block", LargestModuleSpace)
         END
      ELSE
         WriteS ("Unable to get information*N")
      END;
      IF Chains THEN
         WriteS( "Used store control block chain is :*N" ) ;
         Debug.UseWrch( Debug.PROCWORD( Wrch )) ;
         Store.DescribeUsedChain ;
         Debug.UseWrch( Debug.RawWrch ) ;
      END (* if *) ;
      Junk := Check( CloseStream( Output ) ) ;
   END (* if *) ;
   RETURN Result ;
END Program ;

END StoreInfo.