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
|
include "reloperr.h"
# SELECT -- Select table rows according to expression
#
# This procedure evaluates a boolean expession for selected rows in a table.
# If the expression is true and does not involve null elements, the index
# of that row is kept in the index array.
#
# B.Simon 7-Oct-87 First Code
# B.Simon 16-Dec-87 Changed to handle table subsets
# B.Simon 06-Jan-93 Changed to use ftnexpr
procedure select (tp, expr, nindex, index)
pointer tp # i: Table descriptor
char expr[ARB] # i: Algebraic expression used in selection
int nindex # io: Number of rows selected
int index[ARB] # io: Indices of selected rows
#--
char ch
pointer sp, oldexp, newexp, ic, aryptr, nulptr
int fd, sd, jc, dtype, nary, iary
int open(), stropen(), stridx()
errchk open, stropen, tbl_eval
string badtype "Expression is not boolean"
begin
# Allocate dynamic memory for strings
call smark (sp)
call salloc (oldexp, SZ_COMMAND, TY_CHAR)
call salloc (newexp, SZ_COMMAND, TY_CHAR)
# Check to see if the expression is a file name
if (expr[1] == '@') {
# Copy the file into a string
fd = open (expr[2], READ_ONLY, TEXT_FILE)
sd = stropen (Memc[oldexp], SZ_COMMAND, WRITE_ONLY)
call fcopyo (fd, sd)
call close (fd)
call strclose (sd)
# Replace the newlines with blanks
ic = oldexp
ch = '\n'
repeat {
jc = stridx (ch, Memc[ic])
if (jc == 0)
break
ic = ic + jc
Memc[ic-1] = ' '
}
# Convert Fortran relational operators to SPP
call ftnexpr (Memc[oldexp], Memc[newexp], SZ_COMMAND)
} else {
# Convert Fortran relational operators to SPP
call ftnexpr (expr, Memc[newexp], SZ_COMMAND)
}
# Evaluate the expression
dtype = TY_BOOL
call tbl_eval (tp, nindex, index, Memc[newexp], dtype, aryptr, nulptr)
# Check to see if result is boolean
if (dtype != TY_BOOL) {
call mfree (aryptr, dtype)
call mfree (nulptr, TY_BOOL)
call error (SYNTAX, badtype)
}
# Put indices of true, non-null rows in index array
nary = nindex
nindex = 0
do iary = 1, nary
if (Memb[aryptr+iary-1] && ! Memb[nulptr+iary-1]) {
nindex = nindex + 1
index[nindex] = index[iary]
}
call mfree (aryptr, dtype)
call mfree (nulptr, TY_BOOL)
call sfree (sp)
end
|
