aboutsummaryrefslogtreecommitdiff
path: root/sys/imfort/clargs.x
blob: c383b570ac0755dd90b33ad403bf02efc84d241c (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.

include	"imfort.h"

.help clargs
.nf --------------------------------------------------------------------------
CLARGS.X -- Command Line Argument access package for IMFORT.

The CLARGS package provides access to the foreign task command line, if any,
passed to the IMFORT program when it was run.  The raw command line may be
obtained as a string, the individual arguments may be extracted as strings,
or arguments may be decoded as integer or floating point values.

	clnarg (nargs)			# get number of command line arguments
	clargc (argno, sval, ier)	# get argument argno as a string
	clargi (argno, ival, ier)	# get argument argno as an integer
	clargr (argno, rval, ier)	# get argument argno as a real
	clargd (argno, dval, ier)	# get argument argno as a double
	clrawc (cmdstr, ier)		# get entire raw command line

Command line arguments are delimited by whitespace.  String arguments do not
have to be quoted; string arguments containing whitespace must be quoted.
FMTIO is used to decode numeric arguments, hence the IRAF notations are
recognized for radix specification (octal, hex) and for sexagesimal input.

Note that a Fortran program using IMFORT may be interfaced to the IRAF CL
as a foreign task, using the CLARGS interface to pass foreign task command
line arguments to the Fortran program, allowing user written Fortran programs
to be called from within CL scripts as well as interactively.
.endhelp ---------------------------------------------------------------------


# CLARGC -- Return the indicated whitespace delimited command line argument
# as a string.

procedure clargc (argno, outstr, ier)

int	argno				# desired argument
%	character*(*) outstr
int	ier

int	u_nargs
int	u_argp[MAX_ARGS]
char	u_sbuf[SZ_CMDLINE]
common	/argcom/ u_nargs, u_argp, u_sbuf

begin
	call cl_initargs (ier)
	if (ier > 0)
	    return

	if (argno < 1 || argno > u_nargs)
	    ier = IE_NEXARG
	else {
	    call f77pak (u_sbuf[u_argp[argno]], outstr, len(outstr))
	    ier = OK
	}
end


# CLARGI -- Return the indicated whitespace delimited command line argument
# as an integer.

procedure clargi (argno, ival, ier)

int	argno			# desired argument
int	ival			# integer value of argument
int	ier

double	dval

begin
	call clargd (argno, dval, ier)
	if (ier == OK)
	    ival = dval		# (integer overflow if large exponent)
end


# CLARGR -- Return the indicated whitespace delimited command line argument
# as a real.

procedure clargr (argno, rval, ier)

int	argno			# desired argument
real	rval			# integer value of argument
int	ier

double	dval

begin
	call clargd (argno, dval, ier)
	if (ier == OK)
	    rval = dval
end


# CLARGD -- Return the indicated whitespace delimited command line argument
# as a double.

procedure clargd (argno, dval, ier)

int	argno			# desired argument
double	dval			# double floating value of argument
int	ier

int	ip, gctod()

int	u_nargs
int	u_argp[MAX_ARGS]
char	u_sbuf[SZ_CMDLINE]
common	/argcom/ u_nargs, u_argp, u_sbuf

begin
	call cl_initargs (ier)
	if (ier > 0)
	    return

	if (argno < 1 || argno > u_nargs)
	    ier = IE_NEXARG
	else {
	    ip = u_argp[argno]
	    if (gctod (u_sbuf, ip, dval) <= 0) {
		ier = IE_NONNUMARG
		call im_seterrop (ier, u_sbuf[ip])
	    } else
		ier = OK
	}
end


# CLNARG -- Return the number of command line arguments.

procedure clnarg (nargs)

int	nargs
int	ier

int	u_nargs
int	u_argp[MAX_ARGS]
char	u_sbuf[SZ_CMDLINE]
common	/argcom/ u_nargs, u_argp, u_sbuf

begin
	call cl_initargs (ier)
	if (ier != OK)
	    nargs = 0
	else
	    nargs = u_nargs
end


# CL_INITARGS -- The first time we are called, read the raw command line
# and parse it into the individual argument strings in the ARGCOM common.
# After the first call the common is set and we are a no-op.

procedure cl_initargs (ier)

int	ier

int	status, op
bool	first_time
pointer	sp, cmd, token, ip
data	first_time /true/
int	ctowrd(), gstrcpy()

int	u_nargs
int	u_argp[MAX_ARGS]
char	u_sbuf[SZ_CMDLINE]
common	/argcom/ u_nargs, u_argp, u_sbuf

begin
	if (!first_time) {
	    ier = OK
	    return
	}

	call smark (sp)
	call salloc (cmd, SZ_CMDLINE, TY_CHAR)
	call salloc (token, SZ_CMDLINE, TY_CHAR)

	call zgcmdl (Memc[cmd], SZ_CMDLINE, status)
	if (status <= 0) {
	    ier = IE_GCMDLN
	    call sfree (sp)
	    return
	}
	
	call strupk (Memc[cmd], Memc[cmd], SZ_CMDLINE)
	u_nargs = 0
	ip = cmd
	op = 1

	while (ctowrd (Memc, ip, Memc[token], SZ_CMDLINE) > 0) {
	    u_nargs = u_nargs + 1
	    u_argp[u_nargs] = op
	    op = op + gstrcpy (Memc[token], u_sbuf[op], SZ_CMDLINE-op+1) + 1
	}

	ier = OK
	first_time = false
	call sfree (sp)
end


# CLRAWC -- Get the raw command line passed by the host system when the calling
# program was run.  This should be the command line entered in the CL when the
# program was called, assuming that the program is implemented as a foreign task
# in the CL.

procedure clrawc (outstr, ier)

%	character*(*) outstr
int	ier

int	status
pointer	sp, cmd

begin
	call smark (sp)
	call salloc (cmd, SZ_CMDLINE, TY_CHAR)

	call zgcmdl (Memc[cmd], SZ_CMDLINE, status)
	if (status <= 0)
	    ier = IE_GCMDLN
	else {
	    call strupk (Memc[cmd], Memc[cmd], SZ_CMDLINE)
	    call f77pak (Memc[cmd], outstr, len(outstr))
	    ier = OK
	}

	call sfree (sp)
end