gcc/m2/gm2-libs/OptLib.mod

   1 (* OptLib.mod allows users to manipulate Argv/Argc.
   2
   3 Copyright (C) 2019-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE OptLib ;
  28
  29 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  30 FROM libc IMPORT memcpy ;
  31
  32 IMPORT DynamicStrings ;
  33
  34
  35 TYPE
  36    Option = POINTER TO RECORD
  37                           argc: INTEGER ;
  38                           argv: ADDRESS ;
  39                           next: Option ;
  40                        END ;
  41
  42 VAR
  43    freeList: Option ;
  44
  45
  46 (*
  47    InitOption - constructor for Option.
  48 *)
  49
  50 PROCEDURE InitOption (argc: INTEGER; argv: ADDRESS) : Option ;
  51 VAR
  52    o: Option ;
  53 BEGIN
  54    o := newOption () ;
  55    o^.argc := argc ;
  56    o^.argv := argv ;
  57    o^.next := NIL ;
  58    RETURN o
  59 END InitOption ;
  60
  61
  62 (*
  63    newOption - returns an option
  64 *)
  65
  66 PROCEDURE newOption () : Option ;
  67 VAR
  68    o: Option ;
  69 BEGIN
  70    IF freeList = NIL
  71    THEN
  72       NEW (o)
  73    ELSE
  74       o := freeList ;
  75       freeList := freeList^.next
  76    END ;
  77    RETURN o
  78 END newOption ;
  79
  80
  81 (*
  82    KillOption - deconstructor for Option.
  83 *)
  84
  85 PROCEDURE KillOption (o: Option) : Option ;
  86 BEGIN
  87    o^.next := freeList ;
  88    freeList := o ;
  89    RETURN NIL
  90 END KillOption ;
  91
  92
  93 (*
  94    Min - returns the lowest value of a and b.
  95 *)
  96
  97 PROCEDURE Min (a, b: INTEGER) : INTEGER ;
  98 BEGIN
  99    IF a < b
 100    THEN
 101       RETURN a
 102    ELSE
 103       RETURN b
 104    END
 105 END Min ;
 106
 107
 108 (*
 109    dupArgv - return an array which is a duplicate as defined
 110              by argc and argv.
 111 *)
 112
 113 PROCEDURE dupArgv (argc: INTEGER; argv: ADDRESS) : ADDRESS ;
 114 VAR
 115    nargv: ADDRESS ;
 116 BEGIN
 117    ALLOCATE (nargv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
 118    nargv := memcpy (nargv, argv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
 119    RETURN nargv
 120 END dupArgv ;
 121
 122
 123 (*
 124    Dup - duplicate the option array inside, o.
 125          Notice that this does not duplicate all the contents
 126          (strings) of argv.
 127          Shallow copy of the top level indices.
 128 *)
 129
 130 PROCEDURE Dup (o: Option) : Option ;
 131 VAR
 132    n: Option ;
 133 BEGIN
 134    n := newOption () ;
 135    n^.argc := o^.argc ;
 136    n^.argv := dupArgv (o^.argc, o^.argv) ;
 137    n^.next := NIL ;
 138    RETURN n
 139 END Dup ;
 140
 141
 142 (*
 143    Slice - return a new option which has elements [low:high] from the
 144            options, o.
 145 *)
 146
 147 PROCEDURE Slice (o: Option; low, high: INTEGER) : Option ;
 148 VAR
 149    n: Option ;
 150    p: POINTER TO CHAR ;
 151    a: ADDRESS ;
 152 BEGIN
 153    n := newOption () ;
 154    IF low < 0
 155    THEN
 156       low := o^.argc + low
 157    END ;
 158    IF high <= 0
 159    THEN
 160       high := o^.argc + high
 161    ELSE
 162       high := Min (o^.argc, high)
 163    END ;
 164    n^.argc := high-low+1 ;
 165    p := o^.argv ;
 166    INC (p, VAL (INTEGER, SIZE (ADDRESS)) * low) ;
 167    ALLOCATE (a, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
 168    n^.argv := memcpy (a, p, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
 169    n^.next := NIL ;
 170    RETURN n
 171 END Slice ;
 172
 173
 174 (*
 175    IndexStrCmp - returns the index in the argv array which matches
 176                  string, s.  -1 is returned if the string is not found.
 177 *)
 178
 179 PROCEDURE IndexStrCmp (o: Option; s: String) : INTEGER ;
 180 VAR
 181    i        : INTEGER ;
 182    p        : POINTER TO POINTER TO CHAR ;
 183    optString: String ;
 184 BEGIN
 185    i := 0 ;
 186    p := o^.argv ;
 187    WHILE i < o^.argc DO
 188       optString := DynamicStrings.InitStringCharStar (p^) ;
 189       IF DynamicStrings.Equal (s, optString)
 190       THEN
 191          optString := DynamicStrings.KillString (optString) ;
 192          RETURN i
 193       END ;
 194       optString := DynamicStrings.KillString (optString) ;
 195       INC (p, SIZE (ADDRESS)) ;
 196       INC (i)
 197    END ;
 198    RETURN -1
 199 END IndexStrCmp ;
 200
 201
 202 (*
 203    IndexStrNCmp - returns the index in the argv array where the first
 204                   characters are matched by string, s.
 205                   -1 is returned if the string is not found.
 206 *)
 207
 208 PROCEDURE IndexStrNCmp (o: Option; s: String) : INTEGER ;
 209 VAR
 210    len      : CARDINAL ;
 211    i        : INTEGER ;
 212    p        : POINTER TO POINTER TO CHAR ;
 213    optString: String ;
 214 BEGIN
 215    i := 0 ;
 216    p := o^.argv ;
 217    len := DynamicStrings.Length (s) ;
 218    WHILE i < o^.argc DO
 219       optString := DynamicStrings.InitStringCharStar (p^) ;
 220       IF DynamicStrings.Length (optString) >= len
 221       THEN
 222          optString := DynamicStrings.Slice (DynamicStrings.Mark (optString), 0, len) ;
 223          IF DynamicStrings.Equal (s, optString)
 224          THEN
 225             optString := DynamicStrings.KillString (optString) ;
 226             RETURN i
 227          END
 228       END ;
 229       optString := DynamicStrings.KillString (optString) ;
 230       INC (p, SIZE (ADDRESS)) ;
 231       INC (i)
 232    END ;
 233    RETURN -1
 234 END IndexStrNCmp ;
 235
 236
 237 (*
 238    ConCat - returns the concatenation of a and b.
 239 *)
 240
 241 PROCEDURE ConCat (a, b: Option) : Option ;
 242 VAR
 243    result: Option ;
 244 BEGIN
 245    result := newOption () ;
 246    result^.argc := a^.argc + b^.argc ;
 247    ALLOCATE (result^.argv, result^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 248    result^.argv := memcpy (result^.argv, a^.argv, a^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 249    result^.argv := memcpy (result^.argv + VAL (ADDRESS, a^.argc * VAL (INTEGER, SIZE (ADDRESS))),
 250                            b^.argv, b^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 251    result^.next := NIL ;
 252    RETURN result
 253 END ConCat ;
 254
 255
 256 (*
 257    GetArgv - return the argv component of option.
 258 *)
 259
 260 PROCEDURE GetArgv (o: Option) : ADDRESS ;
 261 BEGIN
 262    RETURN o^.argv
 263 END GetArgv ;
 264
 265
 266 (*
 267    GetArgc - return the argc component of option.
 268 *)
 269
 270 PROCEDURE GetArgc (o: Option) : INTEGER ;
 271 BEGIN
 272    RETURN o^.argc
 273 END GetArgc ;
 274
 275
 276 BEGIN
 277    freeList := NIL
 278 END OptLib.