← Back to branch summary

~ubuntu-branches/debian/jessie/eso-midas/jessie

« back to all changes in this revision

Viewing changes to libsrc/tbl/tca.c

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
Import upstream version 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
libsrc/tbl/tca.c
 
1
/*===========================================================================
 
2
  Copyright (C) 1995-2013 European Southern Observatory (ESO)
 
3
 
 
4
  This program is free software; you can redistribute it and/or 
 
5
  modify it under the terms of the GNU General Public License as 
 
6
  published by the Free Software Foundation; either version 2 of 
 
7
  the License, or (at your option) any later version.
 
8
 
 
9
  This program is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
  GNU General Public License for more details.
 
13
 
 
14
  You should have received a copy of the GNU General Public 
 
15
  License along with this program; if not, write to the Free 
 
16
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
        Internet e-mail: midas@eso.org
 
21
        Postal address: European Southern Observatory
 
22
                        Data Management Division 
 
23
                        Karl-Schwarzschild-Strasse 2
 
24
                        D 85748 Garching bei Muenchen 
 
25
                        GERMANY
 
26
===========================================================================*/
 
27
 
 
28
/*++++++++++++++
 
29
..IDENTIFICATION tca.c
 
30
..LANGUAGE       C
 
31
..AUTHOR         ESO-IPG, Garching
 
32
..ENVIRONMENT    Midas
 
33
..KEYWORDS       Table (3-D) Interfaces
 
34
..COMMENTS       
 
35
\begin{TeX}
 
36
 
 
37
This module contains the routines to handle the access to table
 
38
elements, which { \em can be arrays }.
 
39
Access to elements is done by column, row and index numbers; 
 
40
an array of elements is specified by column, row, index and length.
 
41
The length is taken as the maximum possible when this argument is zero.
 
42
element arrays in the table can be integer (I*1, i*2 or I*4), float, 
 
43
double precision or character string data types, 
 
44
as defined during the creation of the columns. 
 
45
Implicit conversion of the element value is done automatically if the
 
46
input/output is done with a routine not corresponding to the data type.
 
47
 
 
48
The functions provided by this module are:
 
49
 
 
50
\begin{itemize}
 
51
\item Delete an array element (TCADEL),
 
52
\item read an extract of an array element from the table (TCARD$x$),
 
53
\item map an array element of the table (TCAMAP),
 
54
\item write an extract of an array element into the table (TCAWR$x$),
 
55
%\item search for an element value (TCASR$x$).
 
56
\item unmap an element of the table (TCAUNM),
 
57
\end{itemize}
 
58
 
 
59
Main arguments used by the routines are:
 
60
\begin{description}
 
61
\item[col] sequential column number. It is an integer number provided
 
62
           by the system when a new column is created, or it is defined by 
 
63
           the user for already existing columns.
 
64
\item[index] starting position in the element array. The first element
 
65
        is numbered 1.
 
66
\item[items] How many elements of the array are concerned. The value
 
67
        0 stands for {\em all}
 
68
\item[null] null flag. This value is 1 if the element is undefined,
 
69
           0 otherwise.
 
70
\item[row] sequential row number. It is an integer defining 
 
71
           the row number in the table or the symbols LAST, FIRST, NEXT 
 
72
           and PREVIOUS defined in the system file 'midas\_def.h' in the
 
73
           directory 'MID\_INCLUDE'. 
 
74
           The sequence number is the physical sequence number (by default)
 
75
           or the sequence corresponding to the index of the reference 
 
76
           column.
 
77
\item[tid] table identifier. It is an integer number provided by the
 
78
           system when the table is created or opened.
 
79
\item[value] element value. The type depends on the routine name.
 
80
           Implicit conversion is done if this type does not correspond
 
81
           to the column data type.
 
82
\end{description}
 
83
 
 
84
\end{TeX}
 
85
 
 
86
..VERSION  1.0   14-Dec-1990: Creation (Francois Ochsenbein)
 
87
 
 
88
 130702         last modif
 
89
---------------*/
 
90
 
 
91
#include <midas_def.h>          /* General MIDAS Symbols        */
 
92
#include <tblsys.h>             /* Table System parameters      */
 
93
#include <tbldef.h>             /* Symbols used for Tables      */
 
94
#include <tblerr.h>             /* List of Table Errors         */
 
95
 
 
96
#include <atype.h>              /* Character classification     */
 
97
#include <macrogen.h>           /* Classical macros             */
 
98
 
 
99
#include <math.h>               /* System Library               */
 
100
 
 
101
#include <stdlib.h>
 
102
 
 
103
 
 
104
 
 
105
char  *TBL_RDF();
 
106
 
 
107
        /* Variables shared by the programs: */
 
108
 
 
109
static int map_arg = TBL__MAPPED;
 
110
 
 
111
static int esize;               /* size of table element */
 
112
static int eoffs;               /* offset into table */
 
113
static int bytes;               /* no. of bytes to work on */
 
114
 
 
115
 
 
116
        /* Mnemonics for some operations */
 
117
        
 
118
 
 
119
#define CheckRowPositive(row)   (row < 1 ? ERR_TBLROW : ERR_NORMAL)
 
120
 
 
121
#define CheckOverflow(tp,row)   (row <= tp->arows ? ERR_NORMAL :        \
 
122
                                 TBL_ALLOROW(tid, row + row/5))
 
123
 
 
124
/*
 
125
 
 
126
*/
 
127
 
 
128
/*=======================================================================
 
129
 *              Internal Routines
 
130
 *=======================================================================*/
 
131
 
 
132
#ifdef __STDC__
 
133
static int chk_items( int dtype, int items)
 
134
#else
 
135
static int chk_items( dtype, items)
 
136
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
137
..PURPOSE Compute the relevant number of items
 
138
..RETURNS Corrected number of items -- 0 of none !
 
139
-------------------------------------------------------------*/
 
140
        int     dtype;  /* IN: Table datatype   */
 
141
        int     items;  /* IN : how many        */
 
142
#endif
 
143
{
 
144
register int    emax;
 
145
 
 
146
 
 
147
 
 
148
emax  = TBL_Items(dtype);       /* How many exist in Column */
 
149
if (items > emax) items = emax;
 
150
 
 
151
esize = TBL_ElementSize(dtype);
 
152
bytes = esize * items;          /* Bytes to read */
 
153
 
 
154
return(items);
 
155
}
 
156
 
 
157
 
 
158
#ifdef __STDC__
 
159
static int check_items( int dtype, int start, int items)
 
160
#else
 
161
static int check_items( dtype, start, items)
 
162
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
163
..PURPOSE Compute the relevant number of items
 
164
..RETURNS Corrected number of items -- 0 of none !
 
165
-------------------------------------------------------------*/
 
166
        int     dtype;  /* IN: Table datatype   */
 
167
        int     start;  /* IN: Starting element */
 
168
        int     items;  /* IN : how many        */
 
169
#endif
 
170
{
 
171
register int    emax;
 
172
 
 
173
 
 
174
if (items == 0) items = TBL_D_MASK;     /* Maximal element #    */
 
175
 
 
176
esize = TBL_ElementSize(dtype);
 
177
emax  = TBL_Items(dtype);       /* How many exist in Column */
 
178
 
 
179
start --;
 
180
if (start < 0)  
 
181
   eoffs = 0;
 
182
else
 
183
   {
 
184
   emax -= start;               /* Maximum accessible   */
 
185
   eoffs = esize * start;
 
186
   }
 
187
 
 
188
if (items > emax) items = emax;
 
189
 
 
190
if (items < 0)  
 
191
   {
 
192
   bytes = eoffs = 0;
 
193
   return 0;
 
194
   }
 
195
 
 
196
bytes = esize * items;          /* Bytes to read */
 
197
return(items);
 
198
}
 
199
 
 
200
/*
 
201
 
 
202
*/
 
203
 
 
204
#ifdef __STDC__
 
205
static int bin_read(int tid, int row, int col, int index, int items, 
 
206
                    char *value, int otype)
 
207
#else
 
208
static int bin_read(tid, row, col, index, items, value, otype)
 
209
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
210
..PURPOSE Read table array element with binary-to-binary conversion
 
211
        (no character string involved)
 
212
..RETURNS status 
 
213
-------------------------------------------------------------*/
 
214
        int     tid;    /* IN : table id        */
 
215
        int     row;    /* IN : row number      */
 
216
        int     col;    /* IN : column number   */
 
217
        int     index;  /* IN : index number    */
 
218
        int     items;  /* IN : how many        */
 
219
        char    *value; /* OUT: actual values   */
 
220
        int     otype;  /* IN: Datatype of value*/
 
221
#endif
 
222
{
 
223
        TABLE   *tp;
 
224
        int     dtype, ic;
 
225
        int     n, status;
 
226
        char    *x;
 
227
 
 
228
                                                /* checks arguments     */
 
229
  tp = TBL_ptr(tid);
 
230
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
231
  if ((status = CheckTrueColumn(tp, col)))
 
232
                                        return(TBL_errs(tid, status, col));
 
233
  if ((status = CheckRow(tp, row)))     return(TBL_errs(tid, status, row));
 
234
 
 
235
  dtype   = tp->dtypes[col-1];
 
236
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
237
        return(status);
 
238
 
 
239
  ic      = TBL_offset (tp, row, col) + (eoffs);
 
240
  if_not((x = TBL_RD (tp, ic, bytes)))  return(TBL_RDst());
 
241
 
 
242
  otype = ((otype & (~TBL_D_MASK))| n);
 
243
  dtype = ((dtype & (~TBL_D_MASK))| n);
 
244
 
 
245
        /* When no conversion required, straight copy   */
 
246
  if (dtype == otype)
 
247
        oscopy (value, x, bytes);
 
248
  else {                /* Conversion performed by TBL_cv2 (takes care
 
249
                                of conversions of NULL values)          */
 
250
        status = TBL_cv2(x, dtype, value, otype);
 
251
        if (status)
 
252
                TBL_errf(-1, "%d numeric overflows from table %s[@%d #%d]", 
 
253
                status, tp->phname, row, col);
 
254
        status = ERR_NORMAL;
 
255
  }
 
256
 
 
257
                /* Fill the rest (unread) with NULLs */
 
258
  if (items > n) {
 
259
        bytes = n*TBL_ElementSize(otype); /* How many bytes were written */
 
260
        TBL_toNULL( (otype & (~TBL_D_MASK))|(items-n), value+bytes);
 
261
  }
 
262
 
 
263
 
 
264
  return(status);
 
265
}
 
266
 
 
267
 
 
268
#ifdef __STDC__
 
269
static int bin_write(int tid, int row, int col, int index, int items, 
 
270
                     char *value, int otype)
 
271
#else
 
272
static int bin_write(tid, row, col, index, items, value, otype)
 
273
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
274
..PURPOSE Write table array element with binary-to-binary conversion
 
275
        (no character string involved)
 
276
..RETURNS status 
 
277
-------------------------------------------------------------*/
 
278
        int     tid;    /* MOD: table id        */
 
279
        int     row;    /* IN : row number      */
 
280
        int     col;    /* IN : column number   */
 
281
        int     index;  /* IN : index number    */
 
282
        int     items;  /* IN : how many        */
 
283
        char    *value; /* IN : actual values   */
 
284
        int     otype;  /* IN: Datatype of value*/
 
285
#endif
 
286
{
 
287
        TABLE   *tp;
 
288
        int     dtype, ic;
 
289
        int     n, status;
 
290
        char    *x;
 
291
 
 
292
                                                /* checks arguments     */
 
293
  tp = TBL_ptr(tid);
 
294
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
295
  if ((status = CheckTrueColumn(tp, col)))
 
296
                                        return(TBL_errs(tid, status, col));
 
297
  if ((status = CheckRow(tp, row)))     return(TBL_errs(tid, status, row));
 
298
  if ((row > tp->rows))         tp->selected = row, tp->rows = row;
 
299
 
 
300
 
 
301
  dtype = tp->dtypes[col-1];
 
302
  if_not(n = check_items(dtype, index, items))  /* No item left... */
 
303
        return(ERR_TBLFMT);
 
304
 
 
305
  ic = TBL_offset (tp, row, col) + eoffs;
 
306
  if_not((x= TBL_RDF (tp, ic, bytes, 1)))       return(TBL_RDst());
 
307
 
 
308
  otype = ((otype & (~TBL_D_MASK))| n);
 
309
  dtype = ((dtype & (~TBL_D_MASK))| n);
 
310
        /* When no conversion required, straight copy   */
 
311
  if (dtype == otype)
 
312
        oscopy (x, value, bytes);
 
313
  else {                /* Conversion performed by TBL_cv2 (takes care
 
314
                                of conversions of NULL values)          */
 
315
        status = TBL_cv2(value, otype, x, dtype);
 
316
        if (status)
 
317
                TBL_errf(-1, "%d numeric overflows to table %s[@%d #%d]", 
 
318
                status, tp->phname, row, col);
 
319
        status = ERR_NORMAL;
 
320
  }
 
321
 
 
322
  return(status);
 
323
}
 
324
/*
 
325
 
 
326
*/
 
327
 
 
328
/*=======================================================================
 
329
 *              Public Routines
 
330
 *=======================================================================*/
 
331
 
 
332
int TCAMAP(tid, row, col, addr)
 
333
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
334
..PURPOSE Return the address of the COMPLETE element array
 
335
..RETURNS status
 
336
------------------------------------------------------------------*/
 
337
        int     tid;    /* IN : table id        */
 
338
        int     row;    /* IN : row number      */
 
339
        int     col;    /* IN : column number   */
 
340
        char    **addr; /* OUT: element adress  */
 
341
{
 
342
        TABLE   *tp;
 
343
        int     ic, dtype;
 
344
        char    *x;
 
345
        int     n, status;
 
346
 
 
347
  tp = TBL_ptr(tid);
 
348
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
349
  if ((status = CheckTrueColumn(tp, col)))
 
350
                                        return(TBL_errs(tid, status, col));
 
351
  if ((status = CheckRow(tp, row)))     return(TBL_errs(tid, status, row));
 
352
 
 
353
  dtype   = tp->dtypes[col-1];
 
354
  ic      = TBL_offset (tp, row, col);
 
355
  n = check_items(dtype, 1, TBL_D_MASK);        /* Set the bytes static */
 
356
 
 
357
                /* The variable map_arg is normally TBL__MAPPED;
 
358
                   However, it's zero when called from TCARDC !         */
 
359
if_not((x =  TBL_RDF (tp, ic, bytes, map_arg)))   return(TBL_RDst());
 
360
  *addr = x; 
 
361
                                        /* Update used rows     */
 
362
  if ((map_arg && (row > tp->rows)))    tp->rows = row, tp->selected = row;
 
363
 
 
364
  return (status);
 
365
}
 
366
 
 
367
int TCAUNM(tid, address)
 
368
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
369
..PURPOSE Unmap a part of the file that was mapped.
 
370
..RETURNS status (-1 if not mapped)
 
371
-------------------------------------------------------------*/
 
372
        int     tid;            /* IN : table id        */
 
373
        char    *address;       /* IN: column address   */
 
374
{
 
375
        TABLE   *tp;
 
376
        int     status;
 
377
        
 
378
  tp = TBL_ptr(tid);
 
379
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
380
 
 
381
  return (TBL_UMAP(tp, address));
 
382
}
 
383
/*================================================================
 
384
 *              Conversion Routines
 
385
 *================================================================*/
 
386
 
 
387
int TCAEDC(tid, abin, col, index, items, buffer)
 
388
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
389
..PURPOSE Edit the element array "abin". The function is similar to
 
390
         TCARDC, but has the value in memory instead of in table
 
391
         (typically the result of TCAMAP).
 
392
..RETURNS status
 
393
..REMARKS No null flag here (null values have buffer[0] = 0).
 
394
        Output buffer assumed to be large enough (size is returned
 
395
        by TBFGET)
 
396
-------------------------------------------------------------*/
 
397
        int     tid;    /* IN : table id        */
 
398
        char    *abin;  /* IN : values to edit  */
 
399
        int     col;    /* IN : column number   */
 
400
        int     index;  /* IN : index number    */
 
401
        int     items;  /* IN : how many        */
 
402
        char    *buffer;        /* OUT: edited value    */
 
403
{
 
404
        TABLE   *tp;
 
405
        int     n, status;
 
406
        int     dtype, dummy;
 
407
        char    form[TBL_FORLEN+1];
 
408
 
 
409
  tp = TBL_ptr(tid);
 
410
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
411
  if ((status = CheckTrueColumn(tp, col)))
 
412
                                        return(TBL_errs(tid, status, col));
 
413
 
 
414
  dtype   = tp->dtypes[col-1];
 
415
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
416
        return(status);
 
417
 
 
418
  if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
 
419
  TBL_ed (buffer, form, ((dtype&(~TBL_D_MASK))|n), abin + eoffs);
 
420
 
 
421
 
 
422
  return (status);
 
423
}
 
424
 
 
425
int TCATRC(tid, abin, col, index, items, buffer)
 
426
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
427
..PURPOSE Interpret (TRanslate) the character value in buffer.
 
428
         This function is similar to TCAWRC, but converts the
 
429
         value to memory (no table access)
 
430
..RETURNS status
 
431
..REMARKS No null flag here (null values have buffer[0] = 0).
 
432
-------------------------------------------------------------*/
 
433
        int     tid;    /* IN : table id        */
 
434
        char    *abin;  /* OUT: value to edit   */
 
435
        int     col;    /* IN : column number   */
 
436
        int     index;  /* IN : index number    */
 
437
        int     items;  /* IN : how many        */
 
438
        char    *buffer;/* IN : edited value    */
 
439
{
 
440
        TABLE   *tp;
 
441
        int     n, status;
 
442
        int     dtype, dummy;
 
443
        char    form[TBL_FORLEN+1];
 
444
 
 
445
  tp = TBL_ptr(tid);
 
446
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
447
  if ((status = CheckTrueColumn(tp, col)))
 
448
                                        return(TBL_errs(tid, status, col));
 
449
 
 
450
  dtype   = tp->dtypes[col-1];
 
451
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
452
        return(status);
 
453
 
 
454
  if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
 
455
  status = TBL_cv (buffer, form, (dtype&(~TBL_D_MASK))|n, abin + eoffs);
 
456
  
 
457
  return (status);
 
458
}
 
459
 
 
460
/*================================================================
 
461
 *              Reading Routines
 
462
 *================================================================*/
 
463
 
 
464
int TCARDC(tid, row, col, index, items, value)
 
465
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
466
..PURPOSE Reads table element as a character string.
 
467
         Arrays are edited with a comma between elements.
 
468
..RETURNS        status (error and non-selected)
 
469
..METHOD  Map first the element, then use TCAEDC to convert to char.
 
470
-------------------------------------------------------------*/
 
471
        int     tid;    /* IN : table id        */
 
472
        int     row;    /* IN : row number      */
 
473
        int     col;    /* IN : column number   */
 
474
        int     index;  /* IN : index number    */
 
475
        int     items;  /* IN : how many        */
 
476
        char    *value; /* OUT: actual value    */
 
477
{
 
478
        char    *addr;
 
479
        int     status, old_map;
 
480
 
 
481
  old_map = map_arg;    map_arg = 0;    /* No Modification */
 
482
  status  = TCAMAP(tid, row, col, &addr);
 
483
  map_arg = old_map;
 
484
  if (status)           return(status);
 
485
 
 
486
                /* Use TCAEDC for Edition */
 
487
  return(TCAEDC(tid, addr, col, index, items, value));
 
488
}
 
489
 
 
490
int TCARDD(tid, row, col, index, items, value)
 
491
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
492
..PURPOSE Reads table element as a double precision variable.
 
493
..RETURNS status 
 
494
-------------------------------------------------------------*/
 
495
        int     tid;    /* IN : table id        */
 
496
        int     row;    /* IN : row number      */
 
497
        int     col;    /* IN : column number   */
 
498
        int     index;  /* IN : index number    */
 
499
        int     items;  /* IN : how many        */
 
500
        double  *value; /* OUT: actual values   */
 
501
{
 
502
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_R8<<TBL_D_BITS));
 
503
}
 
504
 
 
505
int TCARDI(tid, row, col, index, items, value)
 
506
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
507
..PURPOSE Reads table element as integer value.
 
508
..RETURNS status 
 
509
-------------------------------------------------------------*/
 
510
        int     tid;    /* IN : table id        */
 
511
        int     row;    /* IN : row number      */
 
512
        int     col;    /* IN : column number   */
 
513
        int     index;  /* IN : index number    */
 
514
        int     items;  /* IN : how many        */
 
515
        int     *value; /* OUT: actual value    */
 
516
{
 
517
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_I4<<TBL_D_BITS));
 
518
}
 
519
 
 
520
int TCARDR(tid, row, col, index, items, value)
 
521
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
522
..PURPOSE Reads table element as float.
 
523
..RETURNS status
 
524
-------------------------------------------------------------*/
 
525
        int     tid;    /* IN : table id        */
 
526
        int     row;    /* IN : row number      */
 
527
        int     col;    /* IN : column number   */
 
528
        int     index;  /* IN : index number    */
 
529
        int     items;  /* IN : how many        */
 
530
        float   *value; /* OUT: actual value    */
 
531
{
 
532
  return (bin_read(tid, row, col, index, items, (char *)value, TBL_D_R4<<TBL_D_BITS));
 
533
}
 
534
 
 
535
int TCARDS(tid, row, col, index, value)
 
536
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
537
..PURPOSE Reads table element as string.
 
538
..RETURNS status
 
539
-------------------------------------------------------------*/
 
540
        int     tid;    /* IN : table id        */
 
541
        int     row;    /* IN : row number      */
 
542
        int     col;    /* IN : column number   */
 
543
        int     index;  /* IN : index number    */
 
544
        char   *value; /* OUT: actual value    */
 
545
{
 
546
        TABLE  *tp;
 
547
        char    *addr,ws1[4];
 
548
        int     status, old_map;
 
549
        int    items, bytes, dtype;
 
550
 
 
551
  bytes = 0;
 
552
  old_map = map_arg;    map_arg = 1;    /* To Write */
 
553
  status  = TCAMAP(tid, row, col, &addr);
 
554
  map_arg = old_map;
 
555
  if (status)           return(status);
 
556
  tp = TBL_ptr(tid);            /* Might be changed by overflow */
 
557
  if (row > tp->rows)         tp->selected = row, tp->rows = row;
 
558
 
 
559
  dtype = tp->dtypes[col-1];
 
560
  if ((dtype & (~TBL_D_MASK)) == 0) {
 
561
        GetLabel(tp,col,39,3,ws1);      /* ws1 needs 3 + 1 length! */
 
562
        items = atoi(ws1);
 
563
        if (items == 0) items = 1;
 
564
        bytes = TBL_Items(dtype);
 
565
        bytes = bytes/items;
 
566
        index = (index-1) * bytes +1;
 
567
        }
 
568
  return(TCAEDC(tid,addr,col,index,bytes,value));
 
569
}
 
570
int TCADEL(tid, row, col, index, items)
 
571
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
572
..PURPOSE Deletes  table elements.
 
573
..METHOD         Writes a NULL value in the table.
 
574
..RETURNS status
 
575
-------------------------------------------------------------*/
 
576
        int     tid;    /* IN : table id        */
 
577
        int     row;    /* IN : row number      */
 
578
        int     col;    /* IN : column number   */
 
579
        int     index;  /* IN : index number    */
 
580
        int     items;  /* IN : how many        */
 
581
{
 
582
        TABLE   *tp;
 
583
        int     dtype;
 
584
        char    *x;
 
585
        int     status, ic, n;
 
586
 
 
587
  tp = TBL_ptr(tid);
 
588
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
589
  if ((status = CheckTrueColumn(tp, col)))
 
590
                                        return(TBL_errs(tid, status, col));
 
591
  if ((status = CheckRow(tp, row)))     return(TBL_errs(tid, status, row));
 
592
 
 
593
  dtype   = tp->dtypes[col-1];
 
594
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
595
        return(status);
 
596
 
 
597
  ic = TBL_offset (tp, row, col) + (eoffs);
 
598
 
 
599
                                /* Write the NULL value         */
 
600
  if_not((x = TBL_RDF (tp, ic, bytes, 1)))
 
601
        return(TBL_RDst());
 
602
  TBL_toNULL ((dtype & (~TBL_D_MASK))|n, x);
 
603
 
 
604
                                        /* Update used rows     */
 
605
  if (row > tp->rows)   tp->rows = row;
 
606
 
 
607
  return (status);
 
608
}
 
609
/*
 
610
 
 
611
*/
 
612
 
 
613
void *TCTTST(tid)
 
614
 
 
615
int     tid;    /* IN : table id        */
 
616
 
 
617
{
 
618
int  status;
 
619
 
 
620
TABLE  *tp;
 
621
 
 
622
tp = TBL_ptr(tid);
 
623
if ((status = CheckTable(tp))) 
 
624
   return((void *) 0);
 
625
else
 
626
   return ((void *) tp);
 
627
}
 
628
 
 
629
 
 
630
int xTCAWRC(tp, tid, row, col, items, value)
 
631
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
632
..PURPOSE Writes table element, character string format. 
 
633
..RETURNS status
 
634
-------------------------------------------------------------*/
 
635
TABLE   *tp;    /* IN : table pointer   */
 
636
int     tid;    /* IN : table id        */
 
637
int     row;    /* IN : row number      */
 
638
int     col;    /* IN : column number   */
 
639
int     items;  /* IN : how many        */
 
640
char    *value; /* IN : actual value    */
 
641
{
 
642
char    *addr, *f;
 
643
 
 
644
int     colm1, ic, no, dtype, j;
 
645
 
 
646
 
 
647
 
 
648
 
 
649
colm1 = col - 1;
 
650
dtype = tp->dtypes[colm1];
 
651
 
 
652
/* get offset within table */
 
653
 
 
654
if (tp->swise == F_RECORD )
 
655
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
 
656
else
 
657
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];
 
658
 
 
659
 
 
660
/* set static stuff and check, if no item left... */
 
661
 
 
662
if_not(no = chk_items(dtype,items)) return(ERR_TBLFMT);
 
663
if_not(addr = TBL_RDF(tp,ic,bytes,1))  return(TBL_RDst());
 
664
 
 
665
 
 
666
/* Update used rows     */
 
667
 
 
668
if (row > tp->rows) tp->selected = row, tp->rows = row;
 
669
 
 
670
/* Is already loaded ?  */
 
671
 
 
672
f = tp->format + (1+TBL_FORLEN)*colm1;
 
673
if (*f == '\0')                 /* read format of that column */
 
674
   (void) SCDGETC(tp->imno,TBL_Dlab(col),33,9,&j,f);
 
675
 
 
676
return (TBL_cv(value,f,(dtype&(~TBL_D_MASK))|no,addr));
 
677
}
 
678
 
 
679
 
 
680
int TCAWRC(tid, row, col, index, items, value)
 
681
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
682
..PURPOSE Writes table element, character string format. 
 
683
..RETURNS status
 
684
-------------------------------------------------------------*/
 
685
int     tid;    /* IN : table id        */
 
686
int     row;    /* IN : row number      */
 
687
int     col;    /* IN : column number   */
 
688
int     index;  /* IN : index number    */
 
689
int     items;  /* IN : how many        */
 
690
char    *value; /* IN : actual value    */
 
691
{
 
692
TABLE  *tp;
 
693
char    *addr;
 
694
char    form[TBL_FORLEN+1];
 
695
 
 
696
int     status, dummy;
 
697
int     ic, no, dtype;
 
698
 
 
699
 
 
700
tp = TBL_ptr(tid);
 
701
if ((status = CheckTable(tp))) 
 
702
   return(TBL_errs(tid, status,0));
 
703
 
 
704
if ((status = CheckTrueColumn(tp, col)))
 
705
   return(TBL_errs(tid, status, col));
 
706
 
 
707
if ((status = CheckRow(tp, row))) 
 
708
   return(TBL_errs(tid, status, row));
 
709
 
 
710
dtype = tp->dtypes[col-1];
 
711
ic = TBL_offset (tp, row, col);
 
712
 
 
713
 /* set static stuff and check, if no item left... */
 
714
if_not(no = check_items(dtype, index, items)) return(status);
 
715
 
 
716
if_not((addr = TBL_RDF (tp, ic, bytes, 1)))  return(TBL_RDst());
 
717
 
 
718
/* Update used rows     */
 
719
if (row > tp->rows)         tp->selected = row, tp->rows = row;
 
720
 
 
721
if ((status = TCFGET(tid, col, form, &dummy, &dummy))) return(status);
 
722
status = TBL_cv (value, form, (dtype&(~TBL_D_MASK))|no, addr + eoffs);
 
723
 
 
724
return (status);
 
725
}
 
726
 
 
727
 
 
728
int TCAWRD(tid, row, col, index, items, value)
 
729
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
730
..PURPOSE Writes table element, double precision argument.
 
731
..RETURNS status
 
732
-------------------------------------------------------------*/
 
733
        int     tid;    /* IN : table id        */
 
734
        int     row;    /* IN : row number      */
 
735
        int     col;    /* IN : column number   */
 
736
        int     index;  /* IN : index number    */
 
737
        int     items;  /* IN : how many        */
 
738
        double  *value; /* IN : actual value    */
 
739
{
 
740
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_R8<<TBL_D_BITS));
 
741
}
 
742
 
 
743
int TCAWRI(tid, row, col, index, items, value)
 
744
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
745
..PURPOSE Writes table element, integer variable as argument.
 
746
..RETURNS status
 
747
-------------------------------------------------------------*/
 
748
        int     tid;    /* IN : table id        */
 
749
        int     row;    /* IN : row number      */
 
750
        int     col;    /* IN : column number   */
 
751
        int     index;  /* IN : index number    */
 
752
        int     items;  /* IN : how many        */
 
753
        int     *value; /* IN : actual value    */
 
754
{
 
755
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_I4<<TBL_D_BITS));
 
756
}
 
757
 
 
758
 
 
759
int TCAWRR(tid, row, col, index, items, value)
 
760
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
761
..PURPOSE Writes table element, float as input argument.
 
762
..RETURNS status
 
763
-------------------------------------------------------------*/
 
764
        int     tid;    /* IN : table id        */
 
765
        int     row;    /* IN : row number      */
 
766
        int     col;    /* IN : column number   */
 
767
        int     index;  /* IN : index number    */
 
768
        int     items;  /* IN : how many        */
 
769
        float   *value; /* IN : actual value    */
 
770
{
 
771
  return(bin_write(tid, row, col, index, items, (char *)value, TBL_D_R4<<TBL_D_BITS));
 
772
}
 
773
 
 
774
 
 
775
 
 
776
int xTCAWRD(tp,tid, row, col, items, value)
 
777
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
778
..PURPOSE Writes table element, double precision argument.
 
779
..RETURNS status
 
780
-------------------------------------------------------------*/
 
781
TABLE   *tp;    /* IN : table pointer   */
 
782
int     tid;    /* IN : table id        */
 
783
int     row;    /* IN : row number      */
 
784
int     col;    /* IN : column number   */
 
785
int     items;  /* IN : how many        */
 
786
double  *value; /* IN : actual value    */
 
787
 
 
788
{
 
789
int   ic, n, dtype, colm1;
 
790
 
 
791
char  *x;
 
792
 
 
793
 
 
794
 
 
795
if (row > tp->rows) tp->selected = row, tp->rows = row;
 
796
 
 
797
colm1 = col - 1;
 
798
dtype = tp->dtypes[colm1];
 
799
if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);
 
800
 
 
801
/* get offset within table */
 
802
 
 
803
if (tp->swise == F_RECORD )
 
804
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
 
805
else
 
806
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];
 
807
 
 
808
if_not(x =  TBL_RDF (tp, ic, bytes, 1))   return(TBL_RDst());
 
809
memcpy (x, (char *)value,(size_t) bytes);
 
810
 
 
811
return(0);
 
812
}
 
813
 
 
814
 
 
815
int xTCAWRI(tp,tid, row, col, items, value)
 
816
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
817
..PURPOSE Writes table element, integer variable as argument.
 
818
..RETURNS status
 
819
-------------------------------------------------------------*/
 
820
TABLE   *tp;    /* IN : table pointer   */
 
821
int     tid;    /* IN : table id        */
 
822
int     row;    /* IN : row number      */
 
823
int     col;    /* IN : column number   */
 
824
int     items;  /* IN : how many        */
 
825
int     *value; /* IN : actual value    */
 
826
 
 
827
{
 
828
char  *x;
 
829
 
 
830
int   colm1, ic, n, dtype;
 
831
 
 
832
 
 
833
 
 
834
if (row > tp->rows) tp->selected = row, tp->rows = row;
 
835
 
 
836
colm1 = col - 1;
 
837
dtype = tp->dtypes[colm1];
 
838
 
 
839
if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);
 
840
 
 
841
/* get offset within table */
 
842
 
 
843
if (tp->swise == F_RECORD )
 
844
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
 
845
else
 
846
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];
 
847
 
 
848
if_not(x = TBL_RDF (tp, ic, bytes, 1)) return(TBL_RDst());
 
849
memcpy (x, (char *)value,(size_t) bytes);
 
850
 
 
851
return(0);
 
852
}
 
853
 
 
854
int xTCAWRR(tp, tid, row, col, items, value)
 
855
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
856
..PURPOSE Writes table element, float as input argument.
 
857
..RETURNS status
 
858
-------------------------------------------------------------*/
 
859
TABLE   *tp;    /* IN : table pointer   */
 
860
int     tid;    /* IN : table id        */
 
861
int     row;    /* IN : row number      */
 
862
int     col;    /* IN : column number   */
 
863
int     items;  /* IN : how many        */
 
864
float   *value; /* IN : actual value    */
 
865
 
 
866
{
 
867
char  *x;
 
868
 
 
869
int   colm1, ic, n, dtype;
 
870
 
 
871
 
 
872
 
 
873
 
 
874
if (row > tp->rows) tp->selected = row, tp->rows = row;
 
875
 
 
876
colm1 = col - 1;
 
877
dtype = tp->dtypes[colm1];
 
878
if_not(n = chk_items(dtype,items)) return(ERR_TBLFMT);
 
879
 
 
880
/* get offset within table */
 
881
 
 
882
if (tp->swise == F_RECORD )
 
883
   ic = tp->offset[colm1] + (row-1)*tp->reclen;
 
884
else
 
885
   ic = tp->offset[colm1]*tp->arows + (row-1)*tp->bytes[colm1];
 
886
 
 
887
if_not(x = TBL_RDF (tp, ic, bytes, 1)) return(TBL_RDst());
 
888
memcpy (x, (char *)value,(size_t) bytes);
 
889
 
 
890
return(0);
 
891
}
 
892
 
 
893
 
 
894
int TCAWRS(tid, row, col, index, value)
 
895
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
896
..PURPOSE Writes table element, character string format. 
 
897
..RETURNS status
 
898
-------------------------------------------------------------*/
 
899
        int     tid;    /* IN : table id        */
 
900
        int     row;    /* IN : row number      */
 
901
        int     col;    /* IN : column number   */
 
902
        int     index;  /* IN : index number    */
 
903
        char    *value; /* IN : actual value    */
 
904
{
 
905
        TABLE  *tp;
 
906
        char    *addr,ws1[4];
 
907
        int     status, old_map;
 
908
        int    items, bytes, dtype;
 
909
 
 
910
  bytes = 0;
 
911
  old_map = map_arg;    map_arg = 1;    /* To Write */
 
912
  status  = TCAMAP(tid, row, col, &addr);
 
913
  map_arg = old_map;
 
914
  if (status)           return(status);
 
915
  tp = TBL_ptr(tid);            /* Might be changed by overflow */
 
916
  if (row > tp->rows)         tp->selected = row, tp->rows = row;
 
917
 
 
918
  dtype = tp->dtypes[col-1];
 
919
  if ((dtype & (~TBL_D_MASK)) == 0) {
 
920
        GetLabel(tp,col,39,3,ws1);      /* ws1 needs 3 + 1 length! */
 
921
        items = atoi(ws1);
 
922
        if (items == 0) items = 1;
 
923
        bytes = TBL_Items(dtype);
 
924
        bytes = bytes/items;
 
925
        index = (index-1) * bytes +1;
 
926
        }
 
927
 
 
928
                /* Use TCATRC for Edition */
 
929
  return(TCATRC(tid, addr, col, index, bytes, value));
 
930
}
 
931
/*================================================================
 
932
 *              Searching Routines
 
933
 *================================================================*/
 
934
 
 
935
int TCASRC(tid, row, col, index, items, value, next)
 
936
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
937
..PURPOSE  Search the first row that matches a set of values provided in
 
938
                character form.
 
939
..PURPOSE Search element in character string format.
 
940
\begin{TeX}
 
941
        Search is performed on the table {\em tid},
 
942
        examining rows from {\em row} on.
 
943
        It compares {\em items} elements of the column {\em col}
 
944
        from {\em index} with the array {\em value}, 
 
945
        and stops when a match occurs.
 
946
        The result {\em next} is $-1$ if nothing appropriate was found.
 
947
\end{TeX}
 
948
..RETURNS status
 
949
-------------------------------------------------------------*/
 
950
        int     tid;    /* IN : table id                */
 
951
        int     row;    /* IN : starting row number     */
 
952
        int     col;    /* IN : column number           */
 
953
        int     index;  /* IN : index number            */
 
954
        int     items;  /* IN : how many items to compare*/
 
955
        char    *value; /* IN : Comparison vector       */
 
956
        int     *next;  /* OUT: found row number        */
 
957
{
 
958
        TABLE   *tp;
 
959
        int     n, status;
 
960
        int     dtype;
 
961
 
 
962
  tp = TBL_ptr(tid);
 
963
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
964
  if ((status = CheckTrueColumn(tp, col)))
 
965
                                        return(TBL_errs(tid, status, col));
 
966
  if ((status = CheckTrueRow(tp, row))) return(TBL_errs(tid, status, row));
 
967
 
 
968
  dtype   = tp->dtypes[col-1];
 
969
  *next = -1;
 
970
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
971
        return(status);
 
972
 
 
973
  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
 
974
  status = ERR_TBLIMP;
 
975
 
 
976
  return(status);
 
977
}
 
978
 
 
979
int TCASRD(tid, row, col, index, items, value, next)
 
980
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
981
..PURPOSE  Search the first row that matches a set of values provided in
 
982
                double precision.
 
983
..RETURNS status
 
984
-------------------------------------------------------------*/
 
985
        int     tid;    /* IN : table id                */
 
986
        int     row;    /* IN : starting row number     */
 
987
        int     col;    /* IN : column number           */
 
988
        int     index;  /* IN : index number in col     */
 
989
        int     items;  /* IN : How many to compare     */
 
990
        double  *value; /* IN : Comparison vector       */
 
991
        int     *next;  /* OUT: found row number        */
 
992
{
 
993
        TABLE   *tp;
 
994
        int     n, status;
 
995
        int     dtype;
 
996
 
 
997
  tp = TBL_ptr(tid);
 
998
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
999
  if ((status = CheckTrueColumn(tp, col)))
 
1000
                                        return(TBL_errs(tid, status, col));
 
1001
  if ((status = CheckTrueRow(tp, row))) return(TBL_errs(tid, status, row));
 
1002
 
 
1003
  dtype   = tp->dtypes[col-1];
 
1004
  *next = -1;
 
1005
  if_not(n = check_items(dtype, index, items))  /* No item left... */
 
1006
        return(status);
 
1007
 
 
1008
  SCTPUT(" ++++ TCASRD Not Yet Implemented ++++");
 
1009
  status = ERR_TBLIMP;
 
1010
 
 
1011
  return(status);
 
1012
}
 
1013
 
 
1014
int TCASRI(tid, row, col, index, items, value, next)
 
1015
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
1016
..PURPOSE  Search the first row that matches a set of values provided in
 
1017
                integer.
 
1018
..RETURNS status
 
1019
-------------------------------------------------------------*/
 
1020
        int     tid;    /* IN : table id                */
 
1021
        int     row;    /* IN : starting row number     */
 
1022
        int     col;    /* IN : column number           */
 
1023
        int     index;  /* IN : index number in col     */
 
1024
        int     items;  /* IN : How many to compare     */
 
1025
        int     *value; /* IN : Comparison vector       */
 
1026
        int     *next;  /* OUT: found row number        */
 
1027
{
 
1028
        TABLE   *tp;
 
1029
        int     n, status;
 
1030
        int     dtype;
 
1031
 
 
1032
  tp = TBL_ptr(tid);
 
1033
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
1034
  if ((status = CheckTrueColumn(tp, col)))
 
1035
                                        return(TBL_errs(tid, status, col));
 
1036
  if ((status = CheckTrueRow(tp, row))) return(TBL_errs(tid, status, row));
 
1037
 
 
1038
  dtype   = tp->dtypes[col-1];
 
1039
  *next = -1;
 
1040
  if_not((n = check_items(dtype, index, items)))        /* No item left... */
 
1041
        return(status);
 
1042
 
 
1043
  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
 
1044
  status = ERR_TBLIMP;
 
1045
 
 
1046
  return(status);
 
1047
}
 
1048
 
 
1049
int TCASRR(tid, row, col, index, items, value, next)
 
1050
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
1051
..PURPOSE  Search the first row that matches a set of values provided in
 
1052
                double precision.
 
1053
..RETURNS status
 
1054
-------------------------------------------------------------*/
 
1055
        int     tid;    /* IN : table id                */
 
1056
        int     row;    /* IN : starting row number     */
 
1057
        int     col;    /* IN : column number           */
 
1058
        int     index;  /* IN : index number in col     */
 
1059
        int     items;  /* IN : How many to compare     */
 
1060
        float   *value; /* IN : Comparison vector       */
 
1061
        int     *next;  /* OUT: found row number        */
 
1062
{
 
1063
        TABLE   *tp;
 
1064
        int     n, status;
 
1065
        int     dtype;
 
1066
 
 
1067
  tp = TBL_ptr(tid);
 
1068
  if ((status = CheckTable(tp)))        return(TBL_errs(tid, status,0));
 
1069
  if ((status = CheckTrueColumn(tp, col)))
 
1070
                                        return(TBL_errs(tid, status, col));
 
1071
  if ((status = CheckTrueRow(tp, row))) return(TBL_errs(tid, status, row));
 
1072
 
 
1073
  dtype   = tp->dtypes[col-1];
 
1074
  *next = -1;
 
1075
  if_not(n = check_items(dtype, index, items))  /* No item left... */
 
1076
        return(status);
 
1077
 
 
1078
  SCTPUT(" ++++ TCASRC Not Yet Implemented ++++");
 
1079
  status = ERR_TBLIMP;
 
1080
 
 
1081
  return(status);
 
1082
}
 
1083