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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <syserr.h>
include "qpoe.h"
# QP_READ -- Read a range of elements from a parameter. Works for any
# parameter, including scalar parameters and both static and variable
# length array valued parameters. Automatic datatype conversion is
# performed for the primitive types.
int procedure qp_read (qp, param, buf, maxelem, first, datatype)
pointer qp #I QPOE descriptor
char param[ARB] #I parameter name
char buf[ARB] #O user data buffer to receive data
int maxelem #I max number of data elements to read
int first #I first data element to read
char datatype[ARB] #I datatype to be returned
pointer sp, fm, sym, tbuf, isym, osym
int fd, sz_itype, sz_otype, nelem, itype, otype
pointer qp_gpsym()
int fm_getfd(), qp_sizeof(), read(), qp_dtype()
errchk qp_bind, qp_gpsym, fm_getfd, seek, read, syserrs
begin
if (QP_ACTIVE(qp) == NO)
call qp_bind (qp)
fm = QP_FM(qp)
otype = qp_dtype (qp, datatype, osym)
# Lookup the symbol in the symbol table.
sym = qp_gpsym (qp, param)
if (sym == NULL)
call syserrs (SYS_QPUKNPAR, param)
else {
itype = S_DTYPE(sym)
isym = sym
}
# Determine the number of inbounds elements.
nelem = max(0, min(maxelem, S_NELEM(sym) - first + 1))
if (first <= 0)
call syserrs (SYS_QPINDXOOR, param)
# Verify that any type conversion is legal.
if (otype != itype)
if (min(otype,itype) < TY_CHAR || max(otype,itype) > TY_DOUBLE)
call syserrs (SYS_QPBADCONV, param)
# Open the lfile and read the data segment.
fd = fm_getfd (fm, S_LFILE(sym), READ_ONLY, 0)
if (nelem > 0) {
sz_itype = qp_sizeof (qp, itype, isym, IMMEDIATE)
sz_otype = qp_sizeof (qp, otype, osym, INSTANCEOF)
# Read and output the data.
call seek (fd, S_OFFSET(sym) + (first - 1) * sz_itype)
if (sz_itype <= sz_otype) {
# Read the data directly into the user's buffer.
nelem = read (fd, buf, nelem * sz_itype) / sz_itype
if (nelem > 0 && otype != itype)
call acht (buf, buf, nelem, itype, otype)
} else {
# Read the data into a temporary buffer.
call smark (sp)
call salloc (tbuf, nelem * sz_itype, TY_CHAR)
nelem = read (fd, Memc[tbuf], nelem * sz_itype) / sz_itype
if (nelem > 0)
call acht (Memc[tbuf], buf, nelem, itype, otype)
call sfree (sp)
}
}
call fm_retfd (fm, S_LFILE(sym))
return (nelem)
end
|
