aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/tbyudf.x
blob: affe4a6d71044bb34b8f43c56b50fdc1e4f93a82 (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
include <tbset.h>
include "tbtables.h"
include "tblerr.h"

# tbyudf -- Y set to undefined
# "Delete" entries in a table by setting each entry to the INDEF value
# appropriate for its datatype.
# Note:  This routine assumes that EOS = 0 (or SZB_CHAR = 1) because the
# buffer for setting char values to indef is not packed.
# This version is for column-ordered SDAS tables.
#
# Phil Hodge,  9-Mar-1989  Allow data type to be -n for char.
# Phil Hodge,  1-Apr-1993  Include short datatype.
# Phil Hodge,  2-Jun-1997  Replace INDEFD with TBL_INDEFD.

procedure tbyudf (tp, colptr, numcols, rownum)

pointer tp			# i: pointer to table descriptor
pointer colptr[numcols]		# i: array of pointers to column descriptors
int	numcols			# i: number of columns
int	rownum			# i: row number
#--
pointer sp
pointer charbuf			# Scratch for character string column
long	offset			# Location (chars) for writing in table
int	j, k			# Loop indexes
int	datatype		# Data type of a column
int	dlen			# Number of char in an element of the table
short	sbuf			# buffer for short datatype
bool	boolbuf			# Buffer for writing Boolean values
long	tbyoff()

begin
	do k = 1, numcols {
	    datatype = COL_DTYPE(colptr[k])
	    dlen = COL_LEN(colptr[k])
	    offset = tbyoff (tp, colptr[k], rownum)
	    switch (datatype) {
	    case TY_REAL:
		call seek (TB_FILE(tp), offset)
		call write (TB_FILE(tp), INDEFR, dlen)
	    case TY_DOUBLE:
		call seek (TB_FILE(tp), offset)
		call write (TB_FILE(tp), TBL_INDEFD, dlen)
	    case TY_INT:
		call seek (TB_FILE(tp), offset)
		call write (TB_FILE(tp), INDEFI, dlen)
	    case TY_SHORT:
		sbuf = INDEFS
		call seek (TB_FILE(tp), offset)
		call write (TB_FILE(tp), sbuf, dlen)
	    case TY_BOOL:
		boolbuf = false
		call seek (TB_FILE(tp), offset)
		call write (TB_FILE(tp), boolbuf, dlen)
	    default:
		if (datatype < 0 || datatype == TY_CHAR) {
		    call smark (sp)
		    call salloc (charbuf, dlen, TY_CHAR)
		    do j = 1, dlen
			Memc[charbuf+j-1] = EOS		# this assumes EOS = 0
		    call seek (TB_FILE(tp), offset)
		    call write (TB_FILE(tp), Memc[charbuf], dlen)
		    call sfree (sp)
		} else {
		    call error (ER_TBCOLBADTYP,
			"tbyudf:  invalid datatype; table corrupted?")
		}
	    }
	}
end