1 (* ProgramArgs.mod implement the ISO ProgramArgs specification.
3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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.
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/>. *)
27 IMPLEMENTATION MODULE ProgramArgs
;
29 FROM RTgen
IMPORT ChanDev
, InitChanDev
, DeviceType
, doLook
, doSkip
, doSkipLook
,
30 doReadText
, doReadLocs
;
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
;
45 PtrToChar
= POINTER TO CHAR ;
46 ArgInfo
= POINTER TO RECORD
47 currentPtr
: PtrToChar
;
48 currentPos
: CARDINAL ;
49 currentArg
: CARDINAL ;
50 argLength
: CARDINAL ;
65 PROCEDURE look (d
: DeviceTablePtr
;
66 VAR ch
: CHAR; VAR r
: ReadResults
) ;
72 PROCEDURE skip (d
: DeviceTablePtr
) ;
78 PROCEDURE skiplook (d
: DeviceTablePtr
;
79 VAR ch
: CHAR; VAR r
: ReadResults
) ;
81 doSkipLook(dev
, d
, ch
, r
)
85 PROCEDURE textread (d
: DeviceTablePtr
;
88 VAR charsRead
: CARDINAL) ;
90 doReadText(dev
, d
, to
, maxChars
, charsRead
)
94 PROCEDURE rawread (d
: DeviceTablePtr
;
97 VAR locsRead
: CARDINAL) ;
99 doReadLocs(dev
, d
, to
, maxLocs
, locsRead
)
103 PROCEDURE getname (d
: DeviceTablePtr
;
104 VAR a
: ARRAY OF CHAR) ;
110 PROCEDURE flush (d
: DeviceTablePtr
) ;
115 PROCEDURE handlefree (d
: DeviceTablePtr
) ;
120 PROCEDURE reset (d
: DeviceTablePtr
) ;
124 a
:= GetData(d
, mid
) ;
126 currentPtr
:= ArgData
;
129 argLength
:= strlen(currentPtr
)+1 ;
136 doreadchar - returns a CHAR from the file associated with, g.
139 PROCEDURE doreadchar (g
: GenDevIF
; d
: DeviceTablePtr
) : CHAR ;
144 d
:= DeviceTablePtrValue(cid
, did
) ;
145 a
:= GetData(d
, mid
) ;
147 IF currentPos
<argLength
152 d^.result
:= allRight
;
155 d^.result
:= endOfInput
;
163 dounreadchar - pushes a CHAR back onto the file associated with, g.
166 PROCEDURE dounreadchar (g
: GenDevIF
; d
: DeviceTablePtr
; ch
: CHAR) : CHAR ;
170 d
:= DeviceTablePtrValue(cid
, did
) ;
171 a
:= GetData(d
, mid
) ;
184 dogeterrno - returns the errno relating to the generic device.
187 PROCEDURE dogeterrno (g
: GenDevIF
; d
: DeviceTablePtr
) : INTEGER ;
194 dorbytes - reads upto, max, bytes setting, actual, and
195 returning FALSE if an error (not due to eof)
199 PROCEDURE dorbytes (g
: GenDevIF
; d
: DeviceTablePtr
;
202 VAR actual
: CARDINAL) : BOOLEAN ;
210 WHILE (i
<max
) AND ((result
=notKnown
) OR (result
=allRight
) OR (result
=endOfLine
)) DO
211 p^
:= doreadchar(g
, d
) ;
224 PROCEDURE dowbytes (g
: GenDevIF
; d
: DeviceTablePtr
;
227 VAR actual
: CARDINAL) : BOOLEAN ;
229 RAISEdevException(cid
, did
, notAvailable
,
230 'ProgramArgs.dowbytes: not allowed to write to this channel') ;
236 dowriteln - attempt to write an end of line marker to the
237 file and returns TRUE if successful.
240 PROCEDURE dowriteln (g
: GenDevIF
; d
: DeviceTablePtr
) : BOOLEAN ;
242 RAISEdevException(cid
, did
, notAvailable
,
243 'ProgramArgs.dowbytes: not allowed to write to this channel') ;
249 iseof - returns TRUE if end of file is seen.
252 PROCEDURE iseof (g
: GenDevIF
; d
: DeviceTablePtr
) : BOOLEAN ;
256 d
:= DeviceTablePtrValue(cid
, did
) ;
257 a
:= GetData(d
, mid
) ;
259 RETURN( currentPos
=ArgLength
)
265 iseoln - returns TRUE if end of line is seen.
268 PROCEDURE iseoln (g
: GenDevIF
; d
: DeviceTablePtr
) : BOOLEAN ;
276 ch
:= doreadchar(g
, d
) ;
277 IF ch#
dounreadchar(g
, d
, ch
)
279 RAISEdevException(cid
, did
, hardDeviceError
,
280 'ProgramArgs.iseoln: internal inconsistancy error')
288 iserror - returns TRUE if an error was seen on the device.
291 PROCEDURE iserror (g
: GenDevIF
; d
: DeviceTablePtr
) : BOOLEAN ;
298 strlen - returns the number characters in string at this point.
301 PROCEDURE strlen (p
: PtrToChar
) : CARDINAL ;
315 ArgChan - returns a value that identifies a channel for
316 reading program arguments.
319 PROCEDURE ArgChan () : ChanId
;
326 IsArgPresent - tests if there is a current argument to
328 read <= IOChan.CurrentFlags() will be FALSE,
329 and attempting to read from the argument
330 channel will raise the exception
334 PROCEDURE IsArgPresent () : BOOLEAN ;
339 d
:= DeviceTablePtrValue(cid
, did
) ;
340 a
:= GetData(d
, mid
) ;
342 RETURN( currentArg
<argc
)
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.
361 d
:= DeviceTablePtrValue(cid
, did
) ;
362 a
:= GetData(d
, mid
) ;
367 WHILE (currentPos
<argLength
) AND (currentPtr^#nul
) DO
371 INC(currentPtr
) ; (* move over nul onto first char of next arg *)
372 argLength
:= strlen(currentPtr
)+1 ;
383 PROCEDURE collectArgs
;
387 pp
: POINTER TO PtrToChar
;
390 (* count the number of bytes necessary to remember all arg data *)
394 WHILE i
< GetArgC () DO
401 INC(pp
, SIZE(ADDRESS
)) ;
405 (* now allocate correct amount of memory and copy the data *)
406 ALLOCATE(ArgData
, ArgLength
) ;
410 WHILE i
< GetArgC () DO
419 INC(pp
, SIZE(ADDRESS
)) ;
426 freeData - deallocates, a.
429 PROCEDURE freeData (a
: ArgInfo
) ;
445 AllocateDeviceId(did
) ;
450 currentPtr
:= ArgData
;
453 argLength
:= strlen(currentPtr
)+1 ;
456 d
:= DeviceTablePtrValue(cid
, did
) ;
457 InitData(d
, mid
, a
, freeData
) ;
458 gen
:= InitGenDevIF(did
,
459 doreadchar
, dounreadchar
,
460 dogeterrno
, dorbytes
, dowbytes
,
462 iseof
, iseoln
, iserror
) ;
463 dev
:= InitChanDev(programargs
, did
, gen
) ;
465 flags
:= read
+ text
;
469 doSkipLook
:= skiplook
;
470 doTextRead
:= textread
;
471 doRawRead
:= rawread
;
472 doGetName
:= getname
;