(**************************************************************************)
(*                                                                        *)
(*  PMOS library                                                          *)
(*  Copyright (C) 2025   Peter Moylan                                     *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 3 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(*  You should have received a copy of the GNU General Public License     *)
(*  along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
(*                                                                        *)
(*  To contact author:   http://www.pmoylan.org   peter@pmoylan.org       *)
(*                                                                        *)
(**************************************************************************)

IMPLEMENTATION MODULE VarStrings;

        (********************************************************)
        (*                                                      *)
        (*                Variable-length strings               *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Last edited:        1 March 2025                    *)
        (*  Status:             Working                         *)
        (*                                                      *)
        (********************************************************)


FROM SYSTEM IMPORT ADDRESS, ADR, CARD8, LOC, CAST;

IMPORT Strings;

FROM BigNum IMPORT
    (* type *)  BN,
    (* proc *)  Nbytes, BNtoBytes;

FROM Inet2Misc IMPORT
    (* proc *)  Swap4;

FROM LowLevel IMPORT
    (* proc *)  Copy, EVAL;

FROM Storage IMPORT
    (* proc *)  ALLOCATE, DEALLOCATE;

FROM STextIO IMPORT
    (* proc *)  WriteChar, WriteLn;

(************************************************************************)

CONST
    Nul = CHR(0);  LF = CHR(10);  CR = CHR(13);

(************************************************************************)
(*                    WRITE TO STANDARD OUTPUT                          *)
(************************************************************************)

PROCEDURE WriteVarString (VAR (*IN*) str: ARRAY OF CHAR;  N: CARDINAL);

    (* Write character string of length N to standard output.   *)
    (* Convention: we treat LF as the newline character, and    *)
    (* ignore any CR encountered.                               *)

    VAR j: CARDINAL;
        ch: CHAR;

    BEGIN
        j := 0;
        WHILE j < N DO
            ch := str[j];  INC(j);
            IF ch = Nul THEN
                (* Premature termination *)
                j := N;
            ELSIF ch = CR THEN
                (* do nothing *);
            ELSIF ch = LF THEN
                WriteLn;
            ELSE
                WriteChar (ch);
            END (*IF*);
        END (*WHILE*);
    END WriteVarString;

(************************************************************************)
(*           CREATING AND DESTROYING ByteStr AND CharStr DATA           *)
(************************************************************************)

PROCEDURE CopyOfBS (src: ByteStr): ByteStr;

    (* Creates and returns a copy of src.  *)

    VAR result: ByteStr;

    BEGIN
        result := src;
        ALLOCATE (result.data, result.allocated);
        Copy (src.data, result.data, src.size);
        RETURN result;
    END CopyOfBS;

(************************************************************************)

PROCEDURE CopyOfCS (src: CharStr): CharStr;

    (* Creates and returns a copy of src.  *)

    VAR result: CharStr;

    BEGIN
        result := src;
        ALLOCATE (result.data, result.allocated);
        Copy (src.data, result.data, src.size+1);
        RETURN result;
    END CopyOfCS;

(************************************************************************)

PROCEDURE MakeBS (VAR (*INOUT*) A: ByteStr;  N: CARDINAL);

    (* Allocates enough space to hold N bytes.  *)

    BEGIN
        A.allocated := N;
        A.size := N;
        IF N > 0 THEN
            ALLOCATE (A.data, N);
        END (*IF*);
    END MakeBS;

(************************************************************************)

PROCEDURE MakeCS (VAR (*INOUT*) A: CharStr;  N: CARDINAL);

    (* Allocates enough space to hold N characters plus a trailing Nul. *)

    BEGIN
        A.allocated := N+1;
        A.size := N;
        ALLOCATE (A.data, N+1);
        A.data^[N] := Nul;
    END MakeCS;

(************************************************************************)

PROCEDURE DiscardBS (VAR (*INOUT*) A: ByteStr);

    (* Discards the data in the string.  *)

    BEGIN
        IF A.allocated > 0 THEN
            DEALLOCATE (A.data, A.allocated);
        END (*IF*);
        A.allocated := 0;
        A.size := 0;
    END DiscardBS;

(************************************************************************)

PROCEDURE DiscardCS (VAR (*INOUT*) A: CharStr);

    (* Discards the data in the string.  *)

    BEGIN
        IF A.allocated > 0 THEN
            DEALLOCATE (A.data, A.allocated);
        END (*IF*);
        A.allocated := 0;
        A.size := 0;
    END DiscardCS;

(************************************************************************)
(*                           TYPE CONVERSIONS                           *)
(************************************************************************)

PROCEDURE GenStrToByteStr (p: ADDRESS;  N: CARDINAL): ByteStr;

    (* Creates a ByteStr from N bytes at address p.   *)

    VAR result: ByteStr;

    BEGIN
        WITH result DO
            size := N;
            allocated := N;
            ALLOCATE (data, N);
            Copy (p, data, N);
        END (*WITH*);
        RETURN result;
    END GenStrToByteStr;

(********************************************************************************)

PROCEDURE StrToCharStr (str: ARRAY OF CHAR): CharStr;

    (* Creates a CharStr from a character string.   The result includes *)
    (* a Nul terminator, which is not counted in the size field.        *)

    VAR L: CARDINAL;  result: CharStr;

    BEGIN
        L := LENGTH(str);
        WITH result DO
            size := L;
            allocated := L+1;
            ALLOCATE (data, L+1);
            Strings.Assign (str, data^);
        END (*WITH*);
        result.data^[L] := Nul;
        RETURN result;
    END StrToCharStr;

(********************************************************************************)

PROCEDURE StrToByteStr (str: ARRAY OF CHAR): ByteStr;

    (* Like StrToCharStr, except for the type of the result.    *)

    VAR L: CARDINAL;  result: ByteStr;

    BEGIN
        L := LENGTH(str);
        WITH result DO
            size := L;
            allocated := L+1;
            ALLOCATE (data, L+1);
            Copy (ADR(str), data, L);
        END (*WITH*);
        result.data^[L] := 0;
        RETURN result;
    END StrToByteStr;

(********************************************************************************)

PROCEDURE ByteStrToStr (VAR (*INOUT*) src: ByteStr;  VAR (*OUT*) result: ARRAY OF CHAR);

    (* Converts ByteStr to ordinary character string, deallocates the source.   *)

    CONST Nul = CHR(0);

    BEGIN
        IF src.size > 0 THEN
            Copy (src.data, ADR(result), src.size);
        END (*IF*);
        result[src.size] := Nul;
        DiscardBS (src);
    END ByteStrToStr;

(********************************************************************************)

PROCEDURE BNtoByteStr(A: BN): ByteStr;

    (* Converts a Bignum to a ByteStr, using twos complement for negative   *)
    (* numbers, with a leading 00 or FF inserted if needed to ensure that   *)
    (* the high-order bit agrees with the sign.  Does not deallocate the source.*)

    VAR N: CARDINAL;
        result: ByteStr;

    BEGIN
        N := Nbytes (A);
        result.size := N;
        result.allocated := N;
        ALLOCATE (result.data, N);
        EVAL (BNtoBytes (A, result.data^));
        RETURN result;
    END BNtoByteStr;

(********************************************************************************)

PROCEDURE TrimBS (VAR (*INOUT*) A: ByteStr);

    (* Deallocates the unused part of allocaed space.  *)

    VAR q: ByteStringPtr;

    BEGIN
        IF A.allocated > A.size THEN
            IF A.size = 0 THEN
                q := NIL;
            ELSE
                ALLOCATE (q, A.size);
                Copy (A.data, q, A.size);
            END (*IF*);
            DEALLOCATE (A.data, A.allocated);
            A.data := q;
            A.allocated := A.size;
        END(*IF*);
    END TrimBS;

(********************************************************************************)
(*                           SUBSTRING DELETION                                 *)
(********************************************************************************)

PROCEDURE BSDelete (VAR (*INOUT*) bs: ByteStr;  from, N: CARDINAL);

    (* Deletes a substring of length N, starting at bs.data^[from]. *)

    VAR newsize: CARDINAL;
        p: ByteStringPtr;

    BEGIN
        IF N > 0 THEN
            newsize := bs.size - N;
            IF newsize = 0 THEN
                p := NIL;
            ELSE
                ALLOCATE (p, newsize);
            END (*IF*);
            IF from > 0 THEN
                Copy (bs.data, p, from);
            END (*IF*);
            IF newsize > from THEN
                Copy (ADR(bs.data^[from+N]), ADR(p^[from]), newsize - from);
            END (*IF*);
            IF bs.allocated > 0 THEN
                DEALLOCATE (bs.data, bs.allocated);
            END (*IF*);
            bs.size := newsize;
            bs.allocated := newsize;
            bs.data := p;
        END (*IF*);
    END BSDelete;

(************************************************************************)

PROCEDURE CSDelete (VAR (*INOUT*) cs: CharStr;  from, N: CARDINAL);

    (* Deletes a substring of length N, starting at cs.data^[from]. *)

    VAR newsize: CARDINAL;
        p: CharStringPtr;

    BEGIN
        IF N > 0 THEN
            newsize := cs.size - N;
            IF newsize = 0 THEN
                p := NIL;
            ELSE
                ALLOCATE (p, newsize);
            END (*IF*);
            IF from > 0 THEN
                Copy (cs.data, p, from);
            END (*IF*);
            IF newsize > from THEN
                Copy (ADR(cs.data^[from+N]), ADR(p^[from]), newsize - from);
            END (*IF*);
            p^[newsize] := Nul;
            IF cs.allocated > 0 THEN
                DEALLOCATE (cs.data, cs.allocated);
            END (*IF*);
            cs.size := newsize;
            cs.allocated := newsize+1;
            cs.data := p;
        END (*IF*);
    END CSDelete;

(************************************************************************)
(*                         SUBSTRING EXTRACTION                         *)
(************************************************************************)

PROCEDURE CSExtract (source: CharStr;  start, N: CARDINAL;
                        VAR (*OUT*) destination: ARRAY OF CHAR);

    (* Copies at most N characters from source to destination,      *)
    (* starting at position startIndex in source.                   *)

    BEGIN
        IF start > source.size THEN
            N := 0;
        ELSIF start + N > source.size THEN
            N := source.size - start;
        END (*IF*);
        IF N > 0 THEN
            Copy (ADR(source.data^[start]), ADR(destination), N);
            destination[N] := Nul;
        END (*IF*);
    END CSExtract;

(************************************************************************)
(*                        CHANGING THE DATA SIZE                        *)
(************************************************************************)

PROCEDURE BSExpand (VAR (*INOUT*) bs: ByteStr;  N: CARDINAL);

    (* Ensures, by a new allocation if necessary, that bs can hold  *)
    (* N extra bytes.  We don't yet update bs.size.                 *)

    CONST expandchunk = 256;

    VAR newsize: CARDINAL;  p: ByteStringPtr;

    BEGIN
        IF N < expandchunk THEN

            (* Be generous, in the expectation of possible further  *)
            (* expansion requests.                                  *)

            N := expandchunk;

        END (*IF*);
        newsize := bs.size + N;
        IF newsize > bs.allocated THEN
            ALLOCATE (p, newsize);
            IF bs.size > 0 THEN
                Copy (bs.data, p, bs.size);
            END (*IF*);
            IF bs.size < newsize THEN
                p^[bs.size] := 0;
            END (*IF*);
            IF bs.allocated > 0 THEN
                DEALLOCATE (bs.data, bs.allocated);
            END (*IF*);
            bs.allocated := newsize;
            bs.data := p;
        END (*IF*);
    END BSExpand;

(************************************************************************)

PROCEDURE CSExpand (VAR (*INOUT*) cs: CharStr;  N: CARDINAL);

    (* Ensures, by a new allocation if necessary, that cs can hold  *)
    (* N extra bytes.  We don't yet update bs.size.                 *)

    CONST expandchunk = 128;

    VAR newsize: CARDINAL;  p: CharStringPtr;

    BEGIN
        IF cs.size + N > cs.allocated THEN
            IF N < expandchunk THEN

                (* Be generous, in the expectation of possible further  *)
                (* expansion requests.                                  *)

                N := expandchunk;

            END (*IF*);
            newsize := cs.size + N;
            IF newsize > cs.allocated THEN
                ALLOCATE (p, newsize);
                IF cs.size > 0 THEN
                    Copy (cs.data, p, cs.size);
                END (*IF*);
                IF cs.size < newsize THEN
                    p^[cs.size] := Nul;
                END (*IF*);
                IF cs.allocated > 0 THEN
                    DEALLOCATE (cs.data, cs.allocated);
                END (*IF*);
                cs.allocated := newsize;
                cs.data := p;
            END (*IF*);
        END (*IF*);
    END CSExpand;

(************************************************************************)

PROCEDURE BSAppend (VAR (*INOUT*) bs: ByteStr;
                        N: CARDINAL;  VAR (*IN*) bytes: ARRAY OF LOC);

    (* Appends N bytes to the original string. *)

    VAR p: VarStringPtr;

    BEGIN
        BSExpand (bs, N);
        p := CAST(VarStringPtr, bs.data);
        Copy (ADR(bytes), ADR(p^[bs.size]), N);
        INC (bs.size, N);
    END BSAppend;

(************************************************************************)

PROCEDURE BSAppendStr (VAR (*INOUT*) bs: ByteStr;  str: ARRAY OF CHAR);

    (* Appends new text str to the original string. *)

    VAR N: CARDINAL;
        p: VarStringPtr;

    BEGIN
        N := Strings.Length(str);
        BSExpand (bs, N);
        p := CAST(VarStringPtr, bs.data);
        Strings.Append (str, p^);
        INC (bs.size, N);
    END BSAppendStr;

(************************************************************************)

PROCEDURE CSAppendStr (VAR (*INOUT*) bs: CharStr;  str: ARRAY OF CHAR);

    (* Appends new text str to the original string. *)

    VAR N: CARDINAL;

    BEGIN
        N := Strings.Length(str);
        CSExpand (bs, N);
        Strings.Append (str, bs.data^);
        INC (bs.size, N);
    END CSAppendStr;

(************************************************************************)

PROCEDURE CSAppendStrV (VAR (*INOUT*) bs: CharStr;
                                    VAR (*IN*) str: ARRAY OF CHAR);

    (* Appends new text str to the original string. *)

    VAR N, j, k: CARDINAL;

    BEGIN
        N := Strings.Length(str);
        CSExpand (bs, N);
        k := bs.size;
        FOR j := 0 TO N-1 DO
            bs.data^[k] := str[j];
            INC (k);
        END (*FOR*);
        bs.data^[k] := Nul;
        INC (bs.size, N);
    END CSAppendStrV;

(************************************************************************)
(*                     COPYING A FIELD FROM A PACKET                    *)
(************************************************************************)

PROCEDURE GetCard (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL): CARDINAL;

    (* Returns 4-byte number at position pos, updates pos.   *)

    VAR N: CARDINAL;

    BEGIN
        N := 0;
        Copy (ADR(pkt.data^[pos]), ADR(N), 4);
        INC (pos, 4);
        RETURN Swap4(N);
    END GetCard;

(************************************************************************)

PROCEDURE GetByteChunk (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                              VAR (*OUT*) str: ARRAY OF LOC;  N: CARDINAL);

    (* Extracts a string of N bytes without preceding count, updates pos. *)

    BEGIN
        Copy (ADR(pkt.data^[pos]), ADR(str), N);
        INC (pos, N);
    END GetByteChunk;

(************************************************************************)

PROCEDURE GetByteString (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                              VAR (*OUT*) str: ARRAY OF CARD8): CARDINAL;

    (* Extracts string at position pos, updates pos.    *)
    (* Returns the string length.                       *)

    VAR N: CARDINAL;

    BEGIN
        N := 0;
        Copy (ADR(pkt.data^[pos]), ADR(N), 4);
        N := Swap4(N);
        INC (pos, 4);
        Copy (ADR(pkt.data^[pos]), ADR(str), N);
        INC (pos, N);
        RETURN N;
    END GetByteString;

(************************************************************************)

PROCEDURE GetCharString (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                                        VAR (*OUT*) str: ARRAY OF CHAR);

    (* Extracts string at position pos, updates pos.    *)
    (* Returns the string length.                       *)

    VAR N: CARDINAL;

    BEGIN
        N := 0;
        Copy (ADR(pkt.data^[pos]), ADR(N), 4);
        N := Swap4(N);
        INC (pos, 4);
        Copy (ADR(pkt.data^[pos]), ADR(str), N);
        INC (pos, N);
        IF N <= HIGH(str) THEN
            str[N] := CHR(0);
        END (*IF*);
    END GetCharString;

(************************************************************************)
(*                   PUTTING A FIELD INTO A PACKET                      *)
(*    We assume that the packet already has enough space allocated      *)
(************************************************************************)

PROCEDURE AddByte (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;  value: CARD8);

    (* Stores 1-byte number (uint32) at position pos, updates pos.  *)

    BEGIN
        pkt.data^[pos] := value;
        INC (pos);
    END AddByte;

(************************************************************************)

PROCEDURE AddCard (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;  value: CARDINAL);

    (* Stores 4-byte number (uint32) at position pos, updates pos.  *)

    VAR M: CARDINAL;

    BEGIN
        M := Swap4(value);
        Copy (ADR(M), ADR(pkt.data^[pos]), 4);
        INC (pos, 4);
    END AddCard;

(************************************************************************)

PROCEDURE AddByteChunk (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                              VAR (*IN*) str: ARRAY OF LOC;  N: CARDINAL);

    (* Stores N bytes of data at position pos, updates pos.  The        *)
    (* difference between this and AddByteString, below, is that no     *)
    (* length field is put ahead of the chunk.                          *)

    BEGIN
        IF N > 0 THEN
            Copy (ADR(str), ADR(pkt.data^[pos]), N);
            INC (pos, N);
        END (*IF*);
    END AddByteChunk;

(************************************************************************)

PROCEDURE AddByteString (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                              VAR (*IN*) str: ARRAY OF LOC;  N: CARDINAL);

    (* Stores N-byte string at position pos, updates pos.  *)

    VAR M: CARDINAL;

    BEGIN
        M := Swap4(N);
        Copy (ADR(M), ADR(pkt.data^[pos]), 4);
        INC (pos, 4);
        IF N > 0 THEN
            Copy (ADR(str), ADR(pkt.data^[pos]), N);
            INC (pos, N);
        END (*IF*);
    END AddByteString;

(********************************************************************************)

PROCEDURE AddCharString (pkt: ByteStr;  VAR (*INOUT*) pos: CARDINAL;
                                                    str: ARRAY OF CHAR);

    (* Stores character string at position pos, updates pos.  *)

    BEGIN
        AddByteString (pkt, pos, str, LENGTH(str));
    END AddCharString;

(********************************************************************************)

END VarStrings.

