IMPLEMENTATION MODULE GlobalString;

(*
        Title:          Environment Variable Management.
        Author:         D.R.Lamkin.
        History:
           20 Jun 84   Initial Version
           09 Aug 84   String made case insensitive.
           10 Aug 84   TYPE Errors moved to Error Module.
           11 Aug 84   Get errorcode etc from Errors.
           14 Aug 84   Declare our procedures.
           24 Aug 84   X Variants added.
           30 Aug 84   Declare Procedure etc removed.
           30 Aug 84   InstallPANOSHandler added.
           31 Aug 84   Remove reference to Strings.
           03 Sep 84   Magic Variables to hold time and date.
           05 Sep 84   Correction of XGetGlobalString Result.
           18 Sep 84   Disallow setting of SYS$.. variables.
                       Put in SYS$Version.
           24 Sep 84   SYS$Time,SYS$Date return <unset> if time not setup
                       Change call to error routine.
           08 Oct 84   SystemSignal used by X procs.
*)


(* This module maintains the list of environment variables and their values.
   In the first implementation I take a very simple scheme:

   Data held in an array of bytes..

       -----------------------------------------------------------------
      |<var1-name><var1-value><var2-name><var2-value>....etc            |
       -----------------------------------------------------------------   

   The name,value elements are held as:
         <length byte> <data>, where length is length not including itself.
   The area for the variables is allocated statically.

*)

IMPORT Debug;

IMPORT Panos;

FROM Error IMPORT EnvFacilityErrors ;

FROM String IMPORT CopyLC, LengthC, EqualLC ;

FROM Error IMPORT ErrorCode, Facility, SetErrorInformation;

FROM Handler IMPORT  InstallPANOSHandler, SystemSignal;

FROM Utils IMPORT Capitalize;

FROM TimeAndDate IMPORT Time, Date;

CONST AreaSize = 1024;


TYPE BYTE = CHAR;



VAR  StringArea  : ARRAY [0..AreaSize-1] OF BYTE;
     FreePoint   : CARDINAL;




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

PROCEDURE Version( VAR String : ARRAY OF CHAR ) ;
BEGIN
   CopyLC( "GlobalString    0.02/12  30 Oct 84 18:03:18" , String ) ;
END Version ;

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

PROCEDURE Error (number : EnvFacilityErrors) : INTEGER;

BEGIN

RETURN ErrorCode (EnvFacility , ORD (number), "")

END Error;




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

PROCEDURE IsReservedName (Name : ARRAY OF CHAR) : BOOLEAN;

(* Return TRUE if the name is a system reserved string name.
   These all begin with SYS$
*)

CONST bugfix = 1 ; (* Mick Jordan gets const copy wrong *)

VAR reservedbit : ARRAY [0..3+bugfix] OF CHAR;
    i           : CARDINAL;

BEGIN

reservedbit := "SYS$";
Capitalize (Name);
IF LengthC (Name) < 3 THEN
   RETURN FALSE
END;

FOR i := 0 TO 3 DO
   IF Name [i] # reservedbit [i] THEN
      RETURN FALSE
   END
END;

RETURN TRUE

END IsReservedName;



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

PROCEDURE FindEntry (VAR Name : ARRAY OF CHAR; VAR Index : CARDINAL) : BOOLEAN;

(* Look down the environment storage and return the index of the
   start of the entry for the given name in Index.
   Result is TRUE or FALSE, depending on whether entry found.
*)

VAR i, j, Rover : CARDINAL;
    Found       : BOOLEAN;


PROCEDURE Capital (ch : CHAR) : CHAR;

   BEGIN

   CASE ch OF
      "A".."Z",
      "a".."z" : ch := CAP (ch)
   ELSE
   END;

   RETURN ch;

END Capital;




BEGIN

Rover := 0;         (* Moving index *)
Index := Rover;     (* The entry we are currently examining *)
Found := FALSE;

WHILE (Rover < FreePoint) AND NOT Found DO
   Found := TRUE;                     (* Look on the bright side *)
   Index := Rover;                    (* Remember start of current name *)
   j := CARDINAL (StringArea [Rover]);(* Length of this name *)
   INC (Rover);                       (* Step on to start of name *)
   IF LengthC (Name) = j THEN (* Same length so check for equality *)
      FOR i := 0 TO j-1 DO
         IF Capital (StringArea [Rover]) # Capital (Name [i]) THEN
            (* Not the same *)
            Found := FALSE                     (* So flag difference *)
         END;
         INC (Rover)                  (* Step onto next character *)
      END
   ELSE (* Just step on past the name *)
      Rover := Rover + j;
      Found := FALSE
   END;
   Rover := Rover + CARDINAL (StringArea [Rover]) + 1 (* Step on past data *)
END;

RETURN Found

END FindEntry;




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

PROCEDURE DeleteEntry (Index : CARDINAL);

(* Delete the entry at the given index from the store
   Close up the gap by shuffleing store down
*)

VAR temp, Length, i, count : CARDINAL;

BEGIN

(* Work out the length of the entry to be removed *)

Length := CARDINAL (StringArea [Index])+1;     (* Length of name+length byte *)
temp   := CARDINAL (StringArea [Index+Length]);  (* Get round compiler bug!! *)
Length := Length + temp + 1;
                                               (* Length of Data+length byte *)
(* Work out how many bytes to be moved *)

count := FreePoint - Index - Length;

(* Close up the gap *)

FOR i := 0 TO count DO
   StringArea [Index+i] := StringArea [Index+Length+i]
END;

(* Adjust the high water mark *)
FreePoint := FreePoint - Length;

END DeleteEntry;



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

PROCEDURE AddEntry (VAR Name, Value : ARRAY OF CHAR) : BOOLEAN;

(* Add an entry for the given name. Return FALSE if not enough room *)

VAR i, lname, lvalue, length : CARDINAL;

BEGIN

lname := LengthC (Name);
lvalue := LengthC (Value);
length := lname+lvalue+2;   (* Total number of bytes required *)

(* For this implementation - string lengths must fit in a byte *)

IF (lvalue > 255) OR (lname > 255) THEN
   RETURN FALSE
END;

(* Is there room to fit in the new entry? *)
IF AreaSize-FreePoint < length THEN
   RETURN FALSE
END;

(* We have room so lets move it in *)

StringArea[FreePoint] := BYTE (lname);
INC (FreePoint);
FOR i := 0 TO lname-1 DO
   StringArea [FreePoint] := Name [i];
   INC (FreePoint)
END;

StringArea[FreePoint] := BYTE (lvalue);
INC (FreePoint);
FOR i := 0 TO lvalue-1 DO
   StringArea [FreePoint] := Value [i];
   INC (FreePoint)
END;

RETURN TRUE

END AddEntry;




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

PROCEDURE CopyBytes (VAR Buffer : ARRAY OF CHAR;
                     VAR CopyLength : CARDINAL;
                         index  : CARDINAL) : BOOLEAN;
(* Copy Bytes from the entry at 'index' in the store (which
   will be the index of a length byte) into the buffer.
   Return number of bytes copied in CopyLength.
   Return FALSE if buffer not big enough
*)

VAR i : CARDINAL;

BEGIN

(* Is The Result array big enough *)

CopyLength := CARDINAL (StringArea [index]);
IF CopyLength+1 > HIGH (Buffer) THEN
   RETURN FALSE
ELSE
   INC (index);
   FOR i := 0 TO CopyLength-1 DO
      Buffer[i] := StringArea[ index ];
      INC (index)
   END;
   Buffer[CopyLength] := BYTE (0)
END;

RETURN TRUE

END CopyBytes;



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

PROCEDURE GetGlobalString (VAR EnvValue : ARRAY OF CHAR;
                           VAR EnvValueLength : CARDINAL;
                           EnvName  : ARRAY OF CHAR) : INTEGER;

(* Return the value of the named environment variable *)

VAR res    : INTEGER;
    Index,
    Length : CARDINAL;

    PROCEDURE GetSpecialVars (Name : ARRAY OF CHAR;
                              VAR Value : ARRAY OF CHAR;
                              VAR Length : CARDINAL) : BOOLEAN;

    VAR res : INTEGER;

    BEGIN
    Capitalize (Name);
    IF EqualLC ("SYS$TIME", Name) THEN
       IF Time (Value, Length) < 0 THEN
          CopyLC ("<unset>", Value);
          Length := 7
       END;
       RETURN TRUE
    ELSIF EqualLC ("SYS$DATE", Name) THEN
       IF Date (Value, Length) < 0 THEN
          CopyLC ("<unset>", Value);
          Length := 7
       END;
       RETURN TRUE
    ELSIF EqualLC ("SYS$VERSION", Name) THEN
       Panos.Version (Value);
       Length := LengthC (Value);
       RETURN TRUE
    ELSE
       RETURN FALSE
    END;

    END GetSpecialVars;


BEGIN

(*
   IF the variable is one of the magic ones then substitute for it.
   Otherwise go look up in our data structures
*)

IF GetSpecialVars (EnvName, EnvValue, EnvValueLength) THEN
   RETURN 0
ELSIF FindEntry (EnvName, Index) THEN (* Found The Entry *)
   (* Set index to that of the value *)
   Index := Index + CARDINAL (StringArea [Index]) + 1;
   IF CopyBytes (EnvValue, EnvValueLength, Index) THEN
      res := 0
   ELSE
      res := Error (BufferTooSmall)
   END
ELSE
   res := SetErrorInformation(Error(EnvVarNotFound), EnvName);
END;

RETURN res

END GetGlobalString;



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

PROCEDURE SetGlobalString (EnvName, EnvValue : ARRAY OF CHAR) : INTEGER;

(* Set the value of the named variable
   Return =0, Done
          <0  Error.
   If the value of the variable is the null string then the variable
   is not added to the environment & deleted if it is present.
*)
VAR Index : CARDINAL;

BEGIN

IF IsReservedName (EnvName) THEN
   RETURN SetErrorInformation(Error(CantSetReservedString),EnvName);
END;

IF FindEntry (EnvName, Index) THEN (* Its Already there - so delete it *)
   DeleteEntry (Index)
END;

IF LengthC (EnvValue) = 0 THEN
   RETURN 0       (* set to null string -> delete *)
ELSIF AddEntry (EnvName, EnvValue) THEN
   RETURN 0
ELSE
   RETURN Error (NoRoom)
END;


END SetGlobalString;




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

PROCEDURE GetGlobalStringName (VAR Name : ARRAY OF CHAR;
                               VAR NameLength : CARDINAL;
                               index: CARDINAL) : INTEGER;

(* Return the name of the index'th environment variable or
   error if index outside the range 0..numberentries-1.
   The ordering of the names is arbitrary and subject to change
   after calls of SetGlobalString.
*)

VAR res : INTEGER;
    Rover : CARDINAL;

    PROCEDURE ReturnSpecialName(i: CARDINAL;
                                VAR Name : ARRAY OF CHAR;
                                VAR Length : CARDINAL) : INTEGER;
    VAR buffer : ARRAY [0..9] OF CHAR;
        blength: CARDINAL;

    BEGIN

    CASE i OF
      0:
          CopyLC ("SYS$Time", Name);
          Length := 8;
          RETURN 0
    | 1:
          CopyLC ("SYS$Date", Name);
          Length := 8;
          RETURN 0
    | 2:
          CopyLC ("SYS$Version", Name);
          Length := 11;
          RETURN 0
    ELSE
       RETURN SetErrorInformation(Error(EnvVarNotFound),"");
    END;

    END ReturnSpecialName;

BEGIN

Rover := 0;

WHILE (index > 0) AND (Rover < FreePoint) DO
   Rover := Rover + CARDINAL (StringArea[Rover])+1; (* Step past name *)
   Rover := Rover + CARDINAL (StringArea[Rover])+1; (* Step past data *)
   index := index -1
END;


IF Rover >= FreePoint THEN
   res := ReturnSpecialName (index, Name, NameLength)
ELSE
   IF CopyBytes (Name, NameLength, Rover) THEN
      res := 0
   ELSE
      res := Error (BufferTooSmall)
   END
END;

RETURN res

END GetGlobalStringName;




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

PROCEDURE XGetGlobalString (VAR EnvValue : ARRAY OF CHAR;
                            EnvName  : ARRAY OF CHAR) : CARDINAL ;
VAR res : INTEGER;
    EnvValueLength : CARDINAL;

BEGIN

res := GetGlobalString (EnvValue, EnvValueLength, EnvName);
IF res < 0 THEN
   SystemSignal(res, 4)
END;
RETURN EnvValueLength

END XGetGlobalString;




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

PROCEDURE XSetGlobalString (EnvName, EnvValue : ARRAY OF CHAR);
VAR res : INTEGER;

BEGIN

res := SetGlobalString (EnvName, EnvValue);
IF res < 0 THEN
   SystemSignal(res, 4)
END

END XSetGlobalString;




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

PROCEDURE XGetGlobalStringName (VAR Name : ARRAY OF CHAR;
                                VAR NameLength : CARDINAL;
                                   index: CARDINAL);
VAR res : INTEGER;

BEGIN

res := GetGlobalStringName (Name, NameLength, index);
IF res < 0 THEN
   SystemSignal(res, 4)
END

END XGetGlobalStringName;







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

BEGIN

InstallPANOSHandler();

FreePoint := 0;


END GlobalString.