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
|
include <tbset.h>
include "tunits.h"
#* HISTORY *
#* B.Simon 07-Jan-99 Original
# FIND_UNITS -- Find the conversion factor for a set of units
int procedure find_units (ut, units, punit)
pointer ut # i: units hash table descriptor
char units[ARB] # i: units string
pointer punit # o: conversion factor as units structure
#--
int get_unhash()
begin
return (get_unhash (ut, units, punit))
end
# FREE_UNITS -- Free the abbreviation hash table
procedure free_units (ut)
pointer ut # i: units hash table descriptor
#--
int index
pointer sp, units, punit
int each_unhash()
begin
call smark (sp)
call salloc (units, LEN_UNIT, TY_CHAR)
index = 0
while (each_unhash (ut, index, Memc[units],
punit, LEN_UNIT) != EOF) {
if (punit != NULL)
call free_unstr (punit)
}
call free_unhash (ut)
call sfree (sp)
end
# READ_UNITS -- Read units conversions from a table and load into a hash
pointer procedure read_units (ab, unittab)
pointer ab # i: abbreviation table descriptor
char unittab[ARB] # i: units conversion table name
#--
bool swap, verbose
double factor
int irow, nrow
pointer sp, temp, oldunits, newunits
pointer tp, c1, c2, c3, c4
pointer ut, punit1, punit2, punit3
data verbose / false /
string nocolumn "The units conversion table must have four columns"
string badfactor "Error in units table: factor must be greater than zero"
string nofinal "Error in units table: conversion from final units not allowed"
int tbpsta(), word_match()
pointer tbtopn(), tbcnum(), new_unhash()
pointer parse_units(), div_unstr()
begin
# Dynamic memory for strings
call smark (sp)
call salloc (temp, SZ_FNAME, TY_CHAR)
call salloc (oldunits, SZ_FNAME, TY_CHAR)
call salloc (newunits, SZ_FNAME, TY_CHAR)
# Refer to columns numerically because
# this is supposed to be a text file
tp = tbtopn (unittab, READ_ONLY, NULL)
c1 = tbcnum (tp, 1)
c2 = tbcnum (tp, 2)
c3 = tbcnum (tp, 3)
c4 = tbcnum (tp, 4)
if (c1 == NULL || c2 == NULL || c3 == NULL || c4 == NULL)
call tuniterr (nocolumn, unittab)
# Create hash
nrow = tbpsta (tp, TBL_NROWS)
ut = new_unhash (nrow, LEN_UNIT)
# Read each row into hash
do irow = 1, nrow {
# Read table columns
call tbegtd (tp, c1, irow, factor)
call tbegtt (tp, c2, irow, Memc[oldunits], SZ_FNAME)
call tbegtt (tp, c3, irow, Memc[newunits], SZ_FNAME)
call tbegtb (tp, c4, irow, swap)
# Check conversion factor
if (factor <= 0.0)
call tuniterr (badfactor, Memc[oldunits])
# Swap the units string and the conversion factor
if (swap) {
call strcpy (Memc[oldunits], Memc[temp], SZ_FNAME)
call strcpy (Memc[newunits], Memc[oldunits], SZ_FNAME)
call strcpy (Memc[temp], Memc[newunits], SZ_FNAME)
}
# Check to see that old units aren't one of the final forms
if (word_match (Memc[oldunits], FINALS) != 0)
call tuniterr (nofinal, Memc[oldunits])
# Parse the old and new units strings
call strlwr (Memc[newunits])
punit1 = parse_units (ab, Memc[newunits])
call strlwr (Memc[oldunits])
punit2 = parse_units (ab, Memc[oldunits])
# The conversion factor is ratio of the two sets of units
punit3 = div_unstr (punit1, punit2)
if (swap) {
TUN_FACTOR(punit3) = factor
} else {
TUN_FACTOR(punit3) = 1.0 / factor
}
if (verbose) {
call str_unstr (punit3, Memc[temp], SZ_FNAME)
call eprintf ("The conversion factor is %s\n\n")
call pargstr (Memc[temp])
}
# Add it to the hash
call abrev_unstr (ab, Memc[oldunits], Memc[temp], SZ_FNAME)
call add_unhash (ut, Memc[temp], punit3)
call free_unstr (punit1)
call free_unstr (punit2)
}
# Close table and free memory
call tbtclo (tp)
call sfree (sp)
return (ut)
end
|