gcc/m2/gm2-libs/OptLib.mod

   1 (* OptLib.mod allows users to manipulate Argv/Argc.
   2
   3 Copyright (C) 2019-2023 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 FROM DynamicStrings IMPORT String ;
  32
  33 IMPORT DynamicStrings ;
  34
  35
  36 TYPE
  37    Option = POINTER TO RECORD
  38                           argc: INTEGER ;
  39                           argv: ADDRESS ;
  40                           next: Option ;
  41                        END ;
  42
  43 VAR
  44    freeList: Option ;
  45
  46
  47 (*
  48    InitOption - constructor for Option.
  49 *)
  50
  51 PROCEDURE InitOption (argc: INTEGER; argv: ADDRESS) : Option ;
  52 VAR
  53    o: Option ;
  54 BEGIN
  55    o := newOption () ;
  56    o^.argc := argc ;
  57    o^.argv := argv ;
  58    o^.next := NIL ;
  59    RETURN o
  60 END InitOption ;
  61
  62
  63 (*
  64    newOption - returns an option
  65 *)
  66
  67 PROCEDURE newOption () : Option ;
  68 VAR
  69    o: Option ;
  70 BEGIN
  71    IF freeList = NIL
  72    THEN
  73       NEW (o)
  74    ELSE
  75       o := freeList ;
  76       freeList := freeList^.next
  77    END ;
  78    RETURN o
  79 END newOption ;
  80
  81
  82 (*
  83    KillOption - deconstructor for Option.
  84 *)
  85
  86 PROCEDURE KillOption (o: Option) : Option ;
  87 BEGIN
  88    o^.next := freeList ;
  89    freeList := o ;
  90    RETURN NIL
  91 END KillOption ;
  92
  93
  94 (*
  95    Min - returns the lowest value of a and b.
  96 *)
  97
  98 PROCEDURE Min (a, b: INTEGER) : INTEGER ;
  99 BEGIN
 100    IF a < b
 101    THEN
 102       RETURN a
 103    ELSE
 104       RETURN b
 105    END
 106 END Min ;
 107
 108
 109 (*
 110    dupArgv - return an array which is a duplicate as defined
 111              by argc and argv.
 112 *)
 113
 114 PROCEDURE dupArgv (argc: INTEGER; argv: ADDRESS) : ADDRESS ;
 115 VAR
 116    nargv: ADDRESS ;
 117 BEGIN
 118    ALLOCATE (nargv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
 119    nargv := memcpy (nargv, argv, VAL (CARDINAL, argc) * SIZE (ADDRESS)) ;
 120    RETURN nargv
 121 END dupArgv ;
 122
 123
 124 (*
 125    Dup - duplicate the option array inside, o.
 126          Notice that this does not duplicate all the contents
 127          (strings) of argv.
 128          Shallow copy of the top level indices.
 129 *)
 130
 131 PROCEDURE Dup (o: Option) : Option ;
 132 VAR
 133    n: Option ;
 134 BEGIN
 135    n := newOption () ;
 136    n^.argc := o^.argc ;
 137    n^.argv := dupArgv (o^.argc, o^.argv) ;
 138    n^.next := NIL ;
 139    RETURN n
 140 END Dup ;
 141
 142
 143 (*
 144    Slice - return a new option which has elements [low:high] from the
 145            options, o.
 146 *)
 147
 148 PROCEDURE Slice (o: Option; low, high: INTEGER) : Option ;
 149 VAR
 150    n: Option ;
 151    p: POINTER TO CHAR ;
 152    a: ADDRESS ;
 153 BEGIN
 154    n := newOption () ;
 155    IF low < 0
 156    THEN
 157       low := o^.argc + low
 158    END ;
 159    IF high <= 0
 160    THEN
 161       high := o^.argc + high
 162    ELSE
 163       high := Min (o^.argc, high)
 164    END ;
 165    n^.argc := high-low+1 ;
 166    p := o^.argv ;
 167    INC (p, VAL (INTEGER, SIZE (ADDRESS)) * low) ;
 168    ALLOCATE (a, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
 169    n^.argv := memcpy (a, p, VAL (INTEGER, SIZE (ADDRESS)) * n^.argc) ;
 170    n^.next := NIL ;
 171    RETURN n
 172 END Slice ;
 173
 174
 175 (*
 176    IndexStrCmp - returns the index in the argv array which matches
 177                  string, s.  -1 is returned if the string is not found.
 178 *)
 179
 180 PROCEDURE IndexStrCmp (o: Option; s: String) : INTEGER ;
 181 VAR
 182    i        : INTEGER ;
 183    p        : POINTER TO POINTER TO CHAR ;
 184    optString: String ;
 185 BEGIN
 186    i := 0 ;
 187    p := o^.argv ;
 188    WHILE i < o^.argc DO
 189       optString := DynamicStrings.InitStringCharStar (p^) ;
 190       IF DynamicStrings.Equal (s, optString)
 191       THEN
 192          optString := DynamicStrings.KillString (optString) ;
 193          RETURN i
 194       END ;
 195       optString := DynamicStrings.KillString (optString) ;
 196       INC (p, SIZE (ADDRESS)) ;
 197       INC (i)
 198    END ;
 199    RETURN -1
 200 END IndexStrCmp ;
 201
 202
 203 (*
 204    IndexStrNCmp - returns the index in the argv array where the first
 205                   characters are matched by string, s.
 206                   -1 is returned if the string is not found.
 207 *)
 208
 209 PROCEDURE IndexStrNCmp (o: Option; s: String) : INTEGER ;
 210 VAR
 211    len      : CARDINAL ;
 212    i        : INTEGER ;
 213    p        : POINTER TO POINTER TO CHAR ;
 214    optString: String ;
 215 BEGIN
 216    i := 0 ;
 217    p := o^.argv ;
 218    len := DynamicStrings.Length (s) ;
 219    WHILE i < o^.argc DO
 220       optString := DynamicStrings.InitStringCharStar (p^) ;
 221       IF DynamicStrings.Length (optString) >= len
 222       THEN
 223          optString := DynamicStrings.Slice (DynamicStrings.Mark (optString), 0, len) ;
 224          IF DynamicStrings.Equal (s, optString)
 225          THEN
 226             optString := DynamicStrings.KillString (optString) ;
 227             RETURN i
 228          END
 229       END ;
 230       optString := DynamicStrings.KillString (optString) ;
 231       INC (p, SIZE (ADDRESS)) ;
 232       INC (i)
 233    END ;
 234    RETURN -1
 235 END IndexStrNCmp ;
 236
 237
 238 (*
 239    ConCat - returns the concatenation of a and b.
 240 *)
 241
 242 PROCEDURE ConCat (a, b: Option) : Option ;
 243 VAR
 244    result: Option ;
 245 BEGIN
 246    result := newOption () ;
 247    result^.argc := a^.argc + b^.argc ;
 248    ALLOCATE (result^.argv, result^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 249    result^.argv := memcpy (result^.argv, a^.argv, a^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 250    result^.argv := memcpy (result^.argv + VAL (ADDRESS, a^.argc * VAL (INTEGER, SIZE (ADDRESS))),
 251                            b^.argv, b^.argc * VAL (INTEGER, SIZE (ADDRESS))) ;
 252    result^.next := NIL ;
 253    RETURN result
 254 END ConCat ;
 255
 256
 257 (*
 258    GetArgv - return the argv component of option.
 259 *)
 260
 261 PROCEDURE GetArgv (o: Option) : ADDRESS ;
 262 BEGIN
 263    RETURN o^.argv
 264 END GetArgv ;
 265
 266
 267 (*
 268    GetArgc - return the argc component of option.
 269 *)
 270
 271 PROCEDURE GetArgc (o: Option) : INTEGER ;
 272 BEGIN
 273    RETURN o^.argc
 274 END GetArgc ;
 275
 276
 277 BEGIN
 278    freeList := NIL
 279 END OptLib.