gcc/m2/gm2-libs-iso/ProgramArgs.mod

   1 (* ProgramArgs.mod implement the ISO ProgramArgs specification.
   2
   3 Copyright (C) 2008-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 ProgramArgs ;
  28
  29 FROM RTgen IMPORT ChanDev, InitChanDev, DeviceType, doLook, doSkip, doSkipLook,
  30                   doReadText, doReadLocs ;
  31
  32 FROM SYSTEM IMPORT ADDRESS, ADR ;
  33 FROM UnixArgs IMPORT GetArgC, GetArgV ;
  34 FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
  35 FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData ;
  36 FROM IOLink IMPORT DeviceId, DeviceTablePtr, DeviceTablePtrValue, AllocateDeviceId, MakeChan, RAISEdevException ;
  37 FROM IOChan IMPORT ChanExceptions ;
  38 FROM IOConsts IMPORT ReadResults ;
  39 FROM ChanConsts IMPORT read, text ;
  40 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  41 FROM ASCII IMPORT nul, lf ;
  42
  43
  44 TYPE
  45    PtrToChar = POINTER TO CHAR ;
  46    ArgInfo   = POINTER TO RECORD
  47                            currentPtr: PtrToChar ;
  48                            currentPos: CARDINAL ;
  49                            currentArg: CARDINAL ;
  50                            argLength : CARDINAL ;
  51                            argc      : CARDINAL ;
  52                         END ;
  53
  54
  55 VAR
  56    mid      : ModuleId ;
  57    did      : DeviceId ;
  58    cid      : ChanId ;
  59    ArgData  : PtrToChar ;
  60    ArgLength: CARDINAL ;
  61    gen      : GenDevIF ;
  62    dev      : ChanDev ;
  63
  64
  65 PROCEDURE look (d: DeviceTablePtr;
  66                 VAR ch: CHAR; VAR r: ReadResults) ;
  67 BEGIN
  68    doLook(dev, d, ch, r)
  69 END look ;
  70
  71
  72 PROCEDURE skip (d: DeviceTablePtr) ;
  73 BEGIN
  74    doSkip(dev, d)
  75 END skip ;
  76
  77
  78 PROCEDURE skiplook (d: DeviceTablePtr;
  79                     VAR ch: CHAR; VAR r: ReadResults) ;
  80 BEGIN
  81    doSkipLook(dev, d, ch, r)
  82 END skiplook ;
  83
  84
  85 PROCEDURE textread (d: DeviceTablePtr;
  86                     to: ADDRESS;
  87                     maxChars: CARDINAL;
  88                     VAR charsRead: CARDINAL) ;
  89 BEGIN
  90    doReadText(dev, d, to, maxChars, charsRead)
  91 END textread ;
  92
  93
  94 PROCEDURE rawread (d: DeviceTablePtr;
  95                    to: ADDRESS;
  96                    maxLocs: CARDINAL;
  97                    VAR locsRead: CARDINAL) ;
  98 BEGIN
  99    doReadLocs(dev, d, to, maxLocs, locsRead)
 100 END rawread ;
 101
 102
 103 PROCEDURE getname (d: DeviceTablePtr;
 104                    VAR a: ARRAY OF CHAR) ;
 105 BEGIN
 106    d^.doGetName(d, a)
 107 END getname ;
 108
 109
 110 PROCEDURE flush (d: DeviceTablePtr) ;
 111 BEGIN
 112 END flush ;
 113
 114
 115 PROCEDURE handlefree (d: DeviceTablePtr) ;
 116 BEGIN
 117 END handlefree ;
 118
 119
 120 PROCEDURE reset (d: DeviceTablePtr) ;
 121 VAR
 122    a : ArgInfo ;
 123 BEGIN
 124    a := GetData(d, mid) ;
 125    WITH a^ DO
 126       currentPtr := ArgData ;
 127       currentPos := 0 ;
 128       currentArg := 0 ;
 129       argLength := strlen(currentPtr)+1 ;
 130       argc := GetArgC ()
 131    END
 132 END reset ;
 133
 134
 135 (*
 136    doreadchar - returns a CHAR from the file associated with, g.
 137 *)
 138
 139 PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
 140 VAR
 141    a : ArgInfo ;
 142    ch: CHAR ;
 143 BEGIN
 144    d := DeviceTablePtrValue(cid, did) ;
 145    a := GetData(d, mid) ;
 146    WITH a^ DO
 147       IF currentPos<argLength
 148       THEN
 149          ch := currentPtr^ ;
 150          INC(currentPtr) ;
 151          INC(currentPos) ;
 152          d^.result := allRight ;
 153          RETURN( ch )
 154       ELSE
 155          d^.result := endOfInput ;
 156          RETURN( nul )
 157       END
 158    END
 159 END doreadchar ;
 160
 161
 162 (*
 163    dounreadchar - pushes a CHAR back onto the file associated with, g.
 164 *)
 165
 166 PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
 167 VAR
 168    a: ArgInfo ;
 169 BEGIN
 170    d := DeviceTablePtrValue(cid, did) ;
 171    a := GetData(d, mid) ;
 172    WITH a^ DO
 173       IF currentPos>0
 174       THEN
 175          DEC(currentPtr) ;
 176          DEC(currentPos)
 177       END
 178    END ;
 179    RETURN( ch )
 180 END dounreadchar ;
 181
 182
 183 (*
 184    dogeterrno - returns the errno relating to the generic device.
 185 *)
 186
 187 PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
 188 BEGIN
 189    RETURN 0
 190 END dogeterrno ;
 191
 192
 193 (*
 194    dorbytes - reads upto, max, bytes setting, actual, and
 195               returning FALSE if an error (not due to eof)
 196               occurred.
 197 *)
 198
 199 PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
 200                     to: ADDRESS;
 201                     max: CARDINAL;
 202                     VAR actual: CARDINAL) : BOOLEAN ;
 203 VAR
 204    p: PtrToChar ;
 205    i: CARDINAL ;
 206 BEGIN
 207    WITH d^ DO
 208       p := to ;
 209       i := 0 ;
 210       WHILE (i<max) AND ((result=notKnown) OR (result=allRight) OR (result=endOfLine)) DO
 211          p^ := doreadchar(g, d) ;
 212          INC(i) ;
 213          INC(p)
 214       END ;
 215       RETURN( TRUE )
 216    END
 217 END dorbytes ;
 218
 219
 220 (*
 221    dowbytes -
 222 *)
 223
 224 PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
 225                     from: ADDRESS;
 226                     nBytes: CARDINAL;
 227                     VAR actual: CARDINAL) : BOOLEAN ;
 228 BEGIN
 229    RAISEdevException(cid, did, notAvailable,
 230                      'ProgramArgs.dowbytes:  not allowed to write to this channel') ;
 231    RETURN( FALSE )
 232 END dowbytes ;
 233
 234
 235 (*
 236    dowriteln - attempt to write an end of line marker to the
 237                file and returns TRUE if successful.
 238 *)
 239
 240 PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 241 BEGIN
 242    RAISEdevException(cid, did, notAvailable,
 243                      'ProgramArgs.dowbytes:  not allowed to write to this channel') ;
 244    RETURN( FALSE )
 245 END dowriteln ;
 246
 247
 248 (*
 249    iseof - returns TRUE if end of file is seen.
 250 *)
 251
 252 PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 253 VAR
 254    a: ArgInfo ;
 255 BEGIN
 256    d := DeviceTablePtrValue(cid, did) ;
 257    a := GetData(d, mid) ;
 258    WITH a^ DO
 259       RETURN( currentPos=ArgLength )
 260    END
 261 END iseof ;
 262
 263
 264 (*
 265    iseoln - returns TRUE if end of line is seen.
 266 *)
 267
 268 PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 269 VAR
 270    ch: CHAR ;
 271 BEGIN
 272    IF iseof(g, d)
 273    THEN
 274       RETURN( FALSE )
 275    ELSE
 276       ch := doreadchar(g, d) ;
 277       IF ch#dounreadchar(g, d, ch)
 278       THEN
 279          RAISEdevException(cid, did, hardDeviceError,
 280                            'ProgramArgs.iseoln:  internal inconsistancy error')
 281       END ;
 282       RETURN( ch=lf )
 283    END
 284 END iseoln ;
 285
 286
 287 (*
 288    iserror - returns TRUE if an error was seen on the device.
 289 *)
 290
 291 PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 292 BEGIN
 293    RETURN( FALSE )
 294 END iserror ;
 295
 296
 297 (*
 298    strlen - returns the number characters in string at this point.
 299 *)
 300
 301 PROCEDURE strlen (p: PtrToChar) : CARDINAL ;
 302 VAR
 303    n: CARDINAL ;
 304 BEGIN
 305    n := 0 ;
 306    WHILE p^#nul DO
 307       INC(n) ;
 308       INC(p)
 309    END ;
 310    RETURN( n )
 311 END strlen ;
 312
 313
 314 (*
 315    ArgChan - returns a value that identifies a channel for
 316              reading program arguments.
 317 *)
 318
 319 PROCEDURE ArgChan () : ChanId ;
 320 BEGIN
 321    RETURN( cid )
 322 END ArgChan ;
 323
 324
 325 (*
 326    IsArgPresent - tests if there is a current argument to
 327                   read from.  If not,
 328                   read <= IOChan.CurrentFlags() will be FALSE,
 329                   and attempting to read from the argument
 330                   channel will raise the exception
 331                   notAvailable.
 332 *)
 333
 334 PROCEDURE IsArgPresent () : BOOLEAN ;
 335 VAR
 336    d: DeviceTablePtr ;
 337    a: ArgInfo ;
 338 BEGIN
 339    d := DeviceTablePtrValue(cid, did) ;
 340    a := GetData(d, mid) ;
 341    WITH a^ DO
 342       RETURN( currentArg<argc )
 343    END
 344 END IsArgPresent ;
 345
 346
 347 (*
 348    NextArg - if there is another argument, causes subsequent
 349              input from the argument device to come from the
 350              start of the next argument.  Otherwise there is
 351              no argument to read from, and a call of
 352              IsArgPresent will return FALSE.
 353 *)
 354
 355 PROCEDURE NextArg ;
 356 VAR
 357    d: DeviceTablePtr ;
 358    a: ArgInfo ;
 359    p: PtrToChar ;
 360 BEGIN
 361    d := DeviceTablePtrValue(cid, did) ;
 362    a := GetData(d, mid) ;
 363    WITH a^ DO
 364       IF currentArg<argc
 365       THEN
 366          INC(currentArg) ;
 367          WHILE (currentPos<argLength) AND (currentPtr^#nul) DO
 368             INC(currentPos) ;
 369             INC(currentPtr)
 370          END ;
 371          INC(currentPtr) ;  (* move over nul onto first char of next arg *)
 372          argLength := strlen(currentPtr)+1 ;
 373          currentPos := 0
 374       END
 375    END
 376 END NextArg ;
 377
 378
 379 (*
 380    collectArgs -
 381 *)
 382
 383 PROCEDURE collectArgs ;
 384 VAR
 385    i   : INTEGER ;
 386    n   : CARDINAL ;
 387    pp  : POINTER TO PtrToChar ;
 388    p, q: PtrToChar ;
 389 BEGIN
 390    (* count the number of bytes necessary to remember all arg data *)
 391    n := 0 ;
 392    i := 0 ;
 393    pp := GetArgV () ;
 394    WHILE i < GetArgC () DO
 395       p := pp^ ;
 396       WHILE p^#nul DO
 397          INC(p) ;
 398          INC(n)
 399       END ;
 400       INC(n) ;
 401       INC(pp, SIZE(ADDRESS)) ;
 402       INC(i)
 403    END ;
 404    ArgLength := n ;
 405    (* now allocate correct amount of memory and copy the data *)
 406    ALLOCATE(ArgData, ArgLength) ;
 407    i := 0 ;
 408    pp := GetArgV () ;
 409    q := ArgData ;
 410    WHILE i < GetArgC () DO
 411       p := pp^ ;
 412       WHILE p^#nul DO
 413          q^ := p^ ;
 414          INC(q) ;
 415          INC(p)
 416       END ;
 417       q^ := p^ ;
 418       INC(q) ;
 419       INC(pp, SIZE(ADDRESS)) ;
 420       INC(i)
 421    END
 422 END collectArgs ;
 423
 424
 425 (*
 426    freeData - deallocates, a.
 427 *)
 428
 429 PROCEDURE freeData (a: ArgInfo) ;
 430 BEGIN
 431    DISPOSE(a)
 432 END freeData ;
 433
 434
 435 (*
 436    Init -
 437 *)
 438
 439 PROCEDURE Init ;
 440 VAR
 441    d: DeviceTablePtr ;
 442    a: ArgInfo ;
 443 BEGIN
 444    MakeModuleId(mid) ;
 445    AllocateDeviceId(did) ;
 446    MakeChan(did, cid) ;
 447    collectArgs ;
 448    NEW(a) ;
 449    WITH a^ DO
 450       currentPtr := ArgData ;
 451       currentPos := 0 ;
 452       currentArg := 0 ;
 453       argLength := strlen(currentPtr)+1 ;
 454       argc := GetArgC ()
 455    END ;
 456    d := DeviceTablePtrValue(cid, did) ;
 457    InitData(d, mid, a, freeData) ;
 458    gen := InitGenDevIF(did,
 459                        doreadchar, dounreadchar,
 460                        dogeterrno, dorbytes, dowbytes,
 461                        dowriteln,
 462                        iseof, iseoln, iserror) ;
 463    dev := InitChanDev(programargs, did, gen) ;
 464    WITH d^ DO
 465       flags := read + text ;
 466       errNum := 0 ;
 467       doLook := look ;
 468       doSkip := skip ;
 469       doSkipLook := skiplook ;
 470       doTextRead := textread ;
 471       doRawRead := rawread ;
 472       doGetName := getname ;
 473       doReset := reset ;
 474       doFlush := flush ;
 475       doFree := handlefree
 476    END
 477 END Init ;
 478
 479
 480 BEGIN
 481    Init
 482 END ProgramArgs.