include # for EA_ERROR include # this defines SZ_TIME include # defines F_REDIR include # defines IS_WHITE include define SZ_LONG_LINE (1024+SZ_LINE) # allows input line up to 1024 char define SZ_FMT 17 # size of string containing print format define SZ_DTYPE 29 # size of string for data type define CPSPACE 21 # size of increment in space for col descr ptrs define T_MAXDIM 7 # maximum dimension for an array in a table # tcreate -- Program to create a table from data in an ASCII file. # # Phil Hodge, 22-Jul-1987 Task created # Phil Hodge, 11-Aug-1987 Modify mk_new_cols for datatype=-n for char string. # Phil Hodge, 8-Sep-1987 Change name from tcreat. # Phil Hodge, 15-Oct-1987 Use tbcigi instead of COL_DTYPE. # Phil Hodge, 20-Sep-1988 Print warning if file does not exist. # Phil Hodge, 9-Mar-1989 Change data type in call to tbhanp from char to int. # Phil Hodge, 17-May-1989 Add history record to table giving creation date. # Phil Hodge, 22-May-1992 Allow input lines up to 1024 char; print warning # if entire line of data file is not read; # print prompt if input is STDIN and not redirected. # Phil Hodge, 11-Jan-1993 In mk_new_cols, move "ncols = ncols + 1" to just # before the call to tbcdef. # Phil Hodge, 10-May-1993 In row_copy, include TY_SHORT. # Phil Hodge, 11-Aug-1993 Add tcr_ctoi, which calls ctoi after skipping over # leading whitespace and/or a "+" sign; call in row_copy. # Phil Hodge, 18-Nov-1994 Add option of creating columns of arrays. # Phil Hodge, 19-Jul-1995 Add tp to calling sequence of tbcisa. # Phil Hodge, 20-Jul-1998 In cp_upar_tbl, call tbfres for a FITS table. # Phil Hodge, 18-Jun-1999 Add option to create a text table with explicit # column definitions. # Phil Hodge, 29-Jul-1999 In tcr_ctoi, check that the value in the data file # has no fractional part. linenum was added to the calling # sequence of tcr_ctoi for a possible error message. procedure tcreate() pointer sp pointer tname # scratch for name of table to be created pointer cdname # scratch for name of file of column definitions pointer dname # scratch for name of file for table data pointer pname # scratch for name of file of header parameters pointer ttype # scratch for table type (e.g. "row") pointer tp # pointer to descriptor for output table pointer cptr # pointer to array of column pointers int uparfd # fd for input file of header parameters int nskip # number of lines to skip at beg of data file int nlines # number of lines in file per row in table int npar # number of header parameters int nrows, ncols # number of rows and columns in table int extracol # number of extra columns to allocate int extrapar # extra space to allocate for header parameters bool histflag # add a history record with creation date? pointer tbtopn() int clgeti() bool clgetb() begin call smark (sp) call salloc (tname, SZ_FNAME, TY_CHAR) call salloc (cdname, SZ_FNAME, TY_CHAR) call salloc (dname, SZ_FNAME, TY_CHAR) call salloc (pname, SZ_FNAME, TY_CHAR) call salloc (ttype, SZ_FNAME, TY_CHAR) call clgstr ("table", Memc[tname], SZ_FNAME) call clgstr ("cdfile", Memc[cdname], SZ_FNAME) call clgstr ("datafile", Memc[dname], SZ_FNAME) call clgstr ("uparfile", Memc[pname], SZ_FNAME) nskip = clgeti ("nskip") nlines = clgeti ("nlines") nrows = clgeti ("nrows") histflag = clgetb ("hist") extrapar = clgeti ("extrapar") call clgstr ("tbltype", Memc[ttype], SZ_FNAME) tp = tbtopn (Memc[tname], NEW_FILE, 0) if (Memc[ttype] == 'r') { # row-ordered stsdas format call tbpset (tp, TBL_WHTYPE, TBL_TYPE_S_ROW) extracol = clgeti ("extracol") } else if (Memc[ttype] == 'c') { # column-ordered stsdas format if (nrows <= 0) call error (1, "must specify nrows>0 for column-ordered table") call tbpset (tp, TBL_WHTYPE, TBL_TYPE_S_COL) call tbpset (tp, TBL_ALLROWS, nrows) extracol = 0 } else if (Memc[ttype] == 't') { # text table # not a simple text table, one with explicit column definitions call tbpset (tp, TBL_WHTYPE, TBL_TYPE_TEXT) call tbpset (tp, TBL_SUBTYPE, TBL_SUBTYPE_EXPLICIT) } else { # default type extracol = clgeti ("extracol") } # Read column descriptions, and create columns; ncols = 0 is OK. call mk_new_cols (Memc[cdname], tp, cptr, ncols) # Increase allocation of space for columns. if (extracol > 0) call tbpset (tp, TBL_INCR_ROWLEN, extracol) # Open the (optional) file containing header parameters, and count how # many there are. If npar = 0 the input file will not be left open. if (Memc[pname] != EOS) { call c_user_par (Memc[pname], uparfd, npar) } else { npar = 0 # there is no upar file uparfd = NULL } if (histflag) npar = npar + 1 # Specify how much space to allocate for header parameters. call tbpset (tp, TBL_MAXPAR, npar+extrapar) # Open (create) the table. call tbtcre (tp) # Copy header parameters to table, and close the uparfile. call cp_upar_tbl (tp, uparfd, histflag) # Read from data file and write to table. if (ncols > 0) call cp_dat_tbl (Memc[dname], tp, Memi[cptr], nskip, nlines, nrows) if (cptr != NULL) call mfree (cptr, TY_INT) call tbtclo (tp) call sfree (sp) end # mk_new_cols -- make new columns # This routine reads column descriptions from an input ASCII file # and defines those columns in the table. procedure mk_new_cols (cdname, tp, cptr, ncols) char cdname[ARB] # i: name of column-definitions file pointer tp # i: pointer to table descriptor pointer cptr # o: pointer to array of column descriptors int ncols # o: number of columns created (may be zero) #-- pointer sp pointer lbuf # buffer for reading lines from col descr file char colname[SZ_COLNAME] # column name char colunits[SZ_COLUNITS] # column units char colfmt[SZ_COLFMT] # print format for column char chdtype[SZ_DTYPE] # column data type expressed as a char string int fd # for input ASCII file int linenum # line number counter (ignored) int datatype # column data type expressed as an int int nelem # array length int ndim # dimension of array int axlen[T_MAXDIM] # length of each axis of array int maxcols # current size of scratch for column pointers int ip # index in line of text from input file int access(), open(), g_next_l(), ctowrd(), fstati() bool streq() begin ncols = 0 # initial values cptr = NULL if (cdname[1] == EOS) { call eprintf ("No cdfile; an empty table will be created.\n") return } else if (access (cdname, 0, 0) == NO) { call eprintf ("WARNING: can't read file %s;\n") call pargstr (cdname) call eprintf (" ... an empty table will be created.\n") return } else if (streq (cdname, "STDIN")) { # Print a prompt if the input is not redirected. if (fstati (STDIN, F_REDIR) == NO) { call printf ( "Give column definitions (name, datatype, print format, units)\n") call printf (" ... then newline & EOF to finish.\n") call flush (STDOUT) } } fd = open (cdname, READ_ONLY, TEXT_FILE) call smark (sp) call salloc (lbuf, SZ_LONG_LINE, TY_CHAR) maxcols = CPSPACE call calloc (cptr, maxcols, TY_INT) # While get next non-comment line ... linenum = 0 while (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) != EOF) { ip = 1 if (ctowrd (Memc[lbuf], ip, colname, SZ_COLNAME) < 1) call error (1, "could not read column name") if (ncols+1 > maxcols) { maxcols = maxcols + CPSPACE call realloc (cptr, maxcols, TY_INT) } if (ctowrd (Memc[lbuf], ip, chdtype, SZ_DTYPE) < 1) { call strcpy ("r", chdtype, SZ_DTYPE) # default is real colfmt[1] = EOS colunits[1] = EOS } else if (ctowrd (Memc[lbuf], ip, colfmt, SZ_COLFMT) < 1) { colfmt[1] = EOS colunits[1] = EOS } else if (ctowrd (Memc[lbuf], ip, colunits, SZ_COLUNITS) < 1) { colunits[1] = EOS } # Convert the format from Fortran style to SPP style. call tbbftp (colfmt, colfmt) iferr { # Convert data type to an integer. call tcr_nelem (chdtype, ndim, axlen, T_MAXDIM, nelem, datatype) } then { call erract (EA_WARN) call eprintf ("column `%s' ignored\n") call pargstr (colname) } else { # Create the column. ncols = ncols + 1 # bug fix 1/11/93 call tbcdef (tp, Memi[cptr+ncols-1], colname, colunits, colfmt, datatype, nelem, 1) call tbcisa (tp, Memi[cptr+ncols-1], ndim, axlen) } } call close (fd) # done with column descriptions file call sfree (sp) end # c_user_par -- count header parameters # This routine opens an input ASCII file containing header parameters # and counts the number of such parameters. If the input file exists # and does contain parameters, the file will be left open; otherwise, # the input file will be closed, and both npar and uparfd will be set # to zero. # Blank and comment lines are ignored. procedure c_user_par (pname, uparfd, npar) char pname[ARB] # i: name of file of header parameters int uparfd # o: fd for input file of header parameters int npar # o: number of header parameters in file #-- pointer sp pointer lbuf # scratch for input line buffer int linenum # line number counter (ignored) int access(), open(), g_next_l() begin uparfd = NULL # initial values npar = 0 if (pname[1] == EOS) { return } else if (access (pname, 0, 0) == NO) { call eprintf ("WARNING: can't read file %s.\n") call pargstr (pname) return } uparfd = open (pname, READ_ONLY, TEXT_FILE) call smark (sp) call salloc (lbuf, SZ_LONG_LINE, TY_CHAR) linenum = 0 while (g_next_l (uparfd, Memc[lbuf], SZ_LONG_LINE, linenum) != EOF) npar = npar + 1 call sfree (sp) if (npar <= 0) { call close (uparfd) uparfd = NULL } end # cp_upar_tbl -- copy header parameters to table # This routine reads header parameters (keyword, type, value) from an # ASCII file and writes them to the table. The input file is then closed. # If uparfd is zero then it is assumed that the file does not exist. procedure cp_upar_tbl (tp, uparfd, histflag) pointer tp # i: pointer to table descriptor int uparfd # io: fd for file of header parameters bool histflag # i: add a history record with current date? #-- pointer sp pointer lbuf # scratch for input line buffer pointer datetime # scratch for date and time pointer history # scratch for history record char keyword[SZ_KEYWORD] # keyword for parameter char chdtype[SZ_DTYPE] # column data type expressed as a char string long old_time, new_time # zero; current clock time int datatype # data type: TY_CHAR, etc int linenum # line number counter (ignored) int ip # counter for indexing in line buffer int parnum # parameter number (ignored) int tbltype # table type, to check for fits type int g_next_l(), ctowrd() int tbpsta(), tbfres() long clktime() begin call smark (sp) call salloc (lbuf, SZ_LONG_LINE, TY_CHAR) tbltype = tbpsta (tp, TBL_WHTYPE) # If there is a file of header parameters, read them and add to the # table header. if (uparfd != NULL) { call seek (uparfd, BOF) # rewind to beginning of file linenum = 0 while (g_next_l (uparfd, Memc[lbuf], SZ_LONG_LINE, linenum) != EOF) { ip = 1 # Read: keyword datatype value comment if (ctowrd (Memc[lbuf], ip, keyword, SZ_KEYWORD) <= 0) { call eprintf ("line is `%s'\n") call pargstr (Memc[lbuf]) call error (1, "bad line in 'uparfile'") } if (tbltype == TBL_TYPE_FITS && tbfres (keyword) == YES) next # skip reserved keywords if FITS table if (ctowrd (Memc[lbuf], ip, chdtype, SZ_DTYPE) <= 0) { call eprintf ("line is `%s'\n") call pargstr (Memc[lbuf]) call error (1, "bad line in 'uparfile'") } call strlwr (chdtype) datatype = chdtype[1] switch (datatype) { case 'r': datatype = TY_REAL case 'i': datatype = TY_INT case 'd': datatype = TY_DOUBLE case 'b': datatype = TY_BOOL default: datatype = TY_CHAR } while (IS_WHITE(Memc[lbuf+ip-1])) ip = ip + 1 call tbhanp (tp, keyword, datatype, Memc[lbuf+ip-1], parnum) } # Close the input ASCII file containing header parameters. call close (uparfd) } if (histflag) { call salloc (datetime, SZ_TIME, TY_CHAR) call salloc (history, SZ_LINE, TY_CHAR) old_time = 0 new_time = clktime (old_time) call cnvtime (new_time, Memc[datetime], SZ_TIME) call strcpy ("Created ", Memc[history], SZ_LINE) call strcat (Memc[datetime], Memc[history], SZ_LINE) call tbhadt (tp, "history", Memc[history]) } call sfree (sp) end # cp_dat_tbl -- copy data to table # This routine reads from an ASCII data file and writes the values to # the table. A subroutine is called to do the actual copying for each row. procedure cp_dat_tbl (dname, tp, cptr, nskip, nlines, nrows) char dname[ARB] # i: name of file containing table data pointer tp # i: pointer to table descriptor pointer cptr[ARB] # i: array of pointers to column descriptors int nskip # i: number of lines to skip at beginning int nlines # i: number of lines per data file record int nrows # i: upper limit on number of rows (if > 0) #-- pointer sp pointer linebuf # scratch for skipping header lines int fd # file descriptor for ASCII data file int rownum # row number int linenum # line number counter int k # loop index int stat bool done int access(), open(), getlline(), fstati() bool streq() begin if (dname[1] == EOS) { return } else if (access (dname, 0, 0) == NO) { call eprintf ("WARNING: file `%s' does not exist;\n") call pargstr (dname) call eprintf (" ... an empty table will be created.\n") return } else if (streq (dname, "STDIN")) { # Print a prompt if the input is not redirected. if (fstati (STDIN, F_REDIR) == NO) { call printf ( "Give table data ... then newline & EOF to finish.\n") call flush (STDOUT) } } fd = open (dname, READ_ONLY, TEXT_FILE) # Skip "header" lines. if (nskip > 0) { call smark (sp) call salloc (linebuf, SZ_LONG_LINE, TY_CHAR) do k = 1, nskip stat = getlline (fd, Memc[linebuf], SZ_LONG_LINE) call sfree (sp) # done with scratch space } # Read each record (which may be more than one line) from the # data file, and write the values to the output row in the table. rownum = 1 linenum = nskip # number of lines read so far done = false while ( !done ) { call row_copy (tp, fd, cptr, rownum, nlines, linenum, done) rownum = rownum + 1 if (nrows > 0 && rownum > nrows) done = true } call close (fd) end # row_copy -- copy to a row of the table # This routine reads one or more records from data file and writes # a single row to the table. procedure row_copy (tp, fd, cptr, rownum, nlines, linenum, done) pointer tp # i: pointer to table descriptor pointer cptr[ARB] # i: array of pointers to column descriptors int fd # i: file descriptor for input data file int rownum # i: row number in table int nlines # i: number of lines per data file record int linenum # io: line number counter bool done # io: set to true when finished #-- pointer sp pointer lbuf # buffer for reading from data file int ncols # number of columns in table int col # loop index (column number) int k # loop index for skipping lines int dtype # data type of a column (-n for char) int nelem # number of elements in array int i # loop index for element number int n # counter for number of lines per table row int ip # index in line buffer lbuf int nchar # number of char in text string int stat pointer str # buffer for value to be put in table double dval # " int ival # " bool bval int tbpsta(), tbcigi(), g_next_l(), tcr_ctoi(), ctod(), ctowrd() begin call smark (sp) call salloc (str, SZ_LINE, TY_CHAR) call salloc (lbuf, SZ_LONG_LINE, TY_CHAR) ncols = tbpsta (tp, TBL_NCOLS) n = 1 if (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) == EOF) { done = true return } ip = 1 for (col=1; col<=ncols; col=col+1) { dtype = tbcigi (cptr[col], TBL_COL_DATATYPE) nelem = tbcigi (cptr[col], TBL_COL_LENDATA) switch (dtype) { case TY_REAL,TY_DOUBLE: do i = 1, nelem { if (ctod (Memc[lbuf], ip, dval) < 1) { if (nlines > 0 && n >= nlines) return # ignore any remaining columns # Print warning if we're not really at the end of line. call tcr_check_eol (Memc[lbuf+ip-1], linenum) if (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) == EOF) { done = true return } n = n + 1 ip = 1 if (ctod (Memc[lbuf], ip, dval) < 1) { call sprintf (Memc[str], SZ_LINE, "badly out of synch in line %d in data file\n") call pargi (linenum) call error (1, Memc[str]) } } call tbaptd (tp, cptr[col], rownum, dval, i, 1) } case TY_INT,TY_SHORT: do i = 1, nelem { if (tcr_ctoi (Memc[lbuf], ip, ival, linenum) < 1) { if (nlines > 0 && n >= nlines) return # ignore any remaining columns call tcr_check_eol (Memc[lbuf+ip-1], linenum) if (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) == EOF) { done = true return } n = n + 1 ip = 1 if (tcr_ctoi (Memc[lbuf], ip, ival, linenum) < 1) { call sprintf (Memc[str], SZ_LINE, "badly out of synch in line %d in data file\n") call pargi (linenum) call error (1, Memc[str]) } } call tbapti (tp, cptr[col], rownum, ival, i, 1) } case TY_BOOL: do i = 1, nelem { if (ctowrd (Memc[lbuf], ip, Memc[str], SZ_LINE) < 1) { if (nlines > 0 && n >= nlines) return # ignore any remaining columns call tcr_check_eol (Memc[lbuf+ip-1], linenum) if (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) == EOF) { done = true return } n = n + 1 ip = 1 if (ctowrd (Memc[lbuf], ip, Memc[str], SZ_LINE) < 1) { call sprintf (Memc[str], SZ_LINE, "badly out of synch in line %d in data file\n") call pargi (linenum) call error (1, Memc[str]) } } call strlwr (Memc[str]) if (Memc[str] == 'y' || Memc[str] == 't') # yes or true bval = true else if (Memc[str] == 'n' || Memc[str] == 'f') # no or false bval = false else { call strcat (" is not a valid Boolean value", Memc[str], SZ_LINE) call error (1, Memc[str]) } call tbaptb (tp, cptr[col], rownum, bval, i, 1) } default: if (dtype >= 0) call error (1, "invalid data type got past tbbtyp") do i = 1, nelem { # Be careful to distinguish between a value of "" at the # end of a line and actually reaching the end of the line; # ctowrd returns 0 in both cases. First skip whitespace. while (IS_WHITE(Memc[lbuf+ip-1])) ip = ip + 1 if (Memc[lbuf+ip-1] == '\n' || Memc[lbuf+ip-1] == EOS) { if (nlines > 0 && n >= nlines) return # ignore any remaining columns if (g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum) == EOF) { done = true return } n = n + 1 ip = 1 } nchar = ctowrd (Memc[lbuf], ip, Memc[str], SZ_LINE) if (nchar > 0) call tbaptt (tp, cptr[col], rownum, Memc[str], nchar, i, 1) } } } # Skip extra lines if all columns gotten in fewer than nlines lines. do k = n+1, nlines { iferr (stat = g_next_l (fd, Memc[lbuf], SZ_LONG_LINE, linenum)) break } call sfree (sp) end # tcr_check_eol -- check for end of data # This routine checks whether the remainder of the line contains anything # other than whitespace and comments. If it does, a warning is printed. procedure tcr_check_eol (lbuf, linenum) char lbuf[ARB] # i: input line int linenum # i: line number for warning message #-- int ip # loop index into lbuf bool line_empty # true if the line is empty bool done # loop termination flag begin line_empty = false ip = 1 done = false while (!done) { if (lbuf[ip] == ' ' || lbuf[ip] == '\t') { # skip whitespace ip = ip + 1 } else if (lbuf[ip] == '\n' || lbuf[ip] == EOS) { line_empty = true done = true } else if (lbuf[ip] == '#') { line_empty = true done = true } else { line_empty = false done = true } } if (!line_empty) { call eprintf ("out of synch or extra data in line %d\n") call pargi (linenum) } end # tcr_nelem -- separate array length from data type # This routine takes a character string as input and returns the data # type, total array length, dimension of array, and length of each axis. # The syntax for axis lengths is numbers separated by commas, enclosed in # brackets or parentheses, following the data type. For example, a 3-D # array of 8-byte character strings with axis lengths of 30, 70, and 5 # would be specified as ch*8[30,70,5]. The first axis is the most rapidly # varying (i.e. Fortran notation). # # The output data type is the usual integer code, e.g. TY_REAL, except # that for a character string of length N the code is -N. This is the # data type that would be given as input to tbcdef. The default data # type is real (TY_REAL). procedure tcr_nelem (chdtype, ndim, axlen, maxdim, nelem, dtype) char chdtype[ARB] # i: data type and dimensions int ndim # o: dimension of array int axlen[maxdim] # o: length of each axis of array int maxdim # i: size of array axlen int nelem # o: total number of elements in array int dtype # o: data type of column for input to tbcdef #-- char temp[SZ_DTYPE] # scratch for copy of chdtype char lbracket # '[' char lparen # '(' char endchar # ']' or ')', as appropriate int indexb, indexp # locations of '[' and '(' in chdtype int ip, ctoi() int i, length # current dimension and axis length bool done # to stop loop over dimensions int stridx() string errmessage "data type `%s':\n" begin lparen = '(' lbracket = '[' ndim = 1 # initial values nelem = 1 do i = 1, maxdim axlen[i] = 1 if (chdtype[1] == EOS) { dtype = TY_REAL # default return } call strcpy (chdtype, temp, SZ_DTYPE) indexb = stridx (lbracket, chdtype) # "[" found? indexp = stridx (lparen, chdtype) # "(" found? done = false if (indexb > 0 && indexp > 0) { call eprintf (errmessage) call pargstr (chdtype) call error (1, "can't include both '[' and '('") } else if (indexb > 0) { endchar = ']' ip = indexb temp[ip] = EOS # now temp is just the data type } else if (indexp > 0) { endchar = ')' ip = indexp temp[ip] = EOS } else { done = true # don't try to extract array size } # Convert the string to integer code (e.g. "r" --> TY_REAL). iferr { call tbbtyp (temp, dtype) } then { call eprintf (errmessage) call pargstr (chdtype) call erract (EA_ERROR) } # Read axis lengths from brackets, if given. i = 0 ip = ip + 1 # skip over '[' while (!done) { if (ctoi (chdtype, ip, length) < 1) { call eprintf (errmessage) call pargstr (chdtype) call error (1, "syntax error") } i = i + 1 # increment dimension if (i > maxdim) { call eprintf (errmessage) call pargstr (chdtype) call error (1, "dimension is too high") } if (length <= 0) { call eprintf (errmessage) call pargstr (chdtype) call error (1, "axis lengths must be positive") } ndim = i axlen[ndim] = length nelem = nelem * length if (chdtype[ip] == ',') { # separator between dimensions ip = ip + 1 } else if (chdtype[ip] == endchar) { # ']' or ')' done = true } else if (chdtype[ip] == EOS) { call eprintf (errmessage) call pargstr (chdtype) call eprintf ("info: missing `%c' assumed\n") call pargc (endchar) done = true } } end # tcr_ctoi -- ctoi, ignoring "+" sign # This calls ctoi after skipping over any whitespace and/or a plus sign. # Note that we allow whitespace after the sign as well as before. This # is reasonable because we know (from the cdfile) that we're getting an # integer rather than an arbitrary character string. # # After reading an integer value, if the next character in the input # string is not whitespace and not the end of the line, the word will be # reread from the input string as a double. If the value is actually # an integer, even though the string may contain a decimal point or an # exponent (e.g. "5." or "1.e2"), the integer will be returned as the # value of n. If the value has a fractional part, that's an error. int procedure tcr_ctoi (input, ip, n, linenum) char input[ARB] # i: input string int ip # io: starting/ending index in INPUT int n # o: value read from string int linenum # i: line number for possible error message #-- pointer sp, word # in case value is floating point int i # local copy of integer value from string int nvals # value returned by ctoi bool positive # true if value is positive int ctoi(), ctod(), ctowrd() int ip_save # so we can call ctod() or ctowrd() double x begin positive = true # initial value while (IS_WHITE(input[ip])) # skip leading whitespace ip = ip + 1 if (input[ip] == '+') # ignore "+" sign ip = ip + 1 if (input[ip] == '-') { # make note of "-" sign ip = ip + 1 positive = false } ip_save = ip nvals = ctoi (input, ip, i) # Allow for the possibility that the buffer contains a floating # point value. if (!IS_WHITE(input[ip]) && input[ip] != EOS) { # Conversion to int was terminated before the end of the word. ip = ip_save nvals = ctod (input, ip, x) if (nvals > 0) { i = int (x) if (x != double(i)) { # There is a fractional part; this is an error. call smark (sp) call salloc (word, SZ_FNAME, TY_CHAR) ip = ip_save nvals = ctowrd (input, ip, Memc[word], SZ_FNAME) call eprintf ("`%s' in line %d is not an integer\n") call pargstr (Memc[word]) call pargi (linenum) call error (1, "data type conflict with cdfile") } } } if (nvals < 1) n = INDEFI else if (positive) n = i else n = -i return (nvals) end