include include "../../lib/ptkeysdef.h" # PT_SORTNUM -- Decode the column used for the sort, compute the file # record structure map, sort on the extracted column, reorder the # input file and write the output file. int procedure pt_sortnum (tp_in, tp_out, column, ascend) pointer tp_in # input Table descriptor pointer tp_out # output Table descriptor char column[ARB] # column name for sort int ascend # forward sort int coltype, colwidth, nrecs pointer key, colptr, colindex, recmap int pt_colmap() begin # Initialize. call pt_kyinit (key) colptr = NULL colindex = NULL recmap = NULL # Decode the sort column and map the record structure. nrecs = pt_colmap (key, tp_in, tp_out, column, colptr, colindex, coltype, colwidth, recmap) # Sort the column and write the output file. if (nrecs > 0) { call pt_colsort (colptr, Memi[colindex], nrecs, coltype) if (ascend == NO) call pt_flipi (Memi[colindex], nrecs) call pt_reorder (tp_in, tp_out, Memi[recmap], Memi[colindex], nrecs) } # Free space. if (colptr != NULL) call mfree (colptr, coltype) if (colindex != NULL) call mfree (colindex, TY_INT) if (recmap != NULL) call mfree (recmap, TY_INT) call pt_kyfree (key) return (nrecs) end define BUFSIZE 1000 # PT_COLMAP -- Decode the column to be sorted and compute the record # structure of the file. int procedure pt_colmap (key, tp_in, tp_out, column, colptr, colindex, coltype, bufwidth, recmap) pointer key # pointer to the database structure int tp_in # the input text file descriptor int tp_out # the output text file descriptor char column[ARB] # column to be sorted pointer colptr # pointer to extracted column array pointer colindex # pointer to index array for extracted column int coltype # data type of the column to be sorted int bufwidth # column width if chars pointer recmap # pointer to the record structure map int first_rec, nunique, uunique, funique, record int ncontinue, recptr, nchars, szbuf, colwidth, field, element long loffset, roffset pointer sp, line, name, value int getline(), strncmp(), pt_kstati() long note() begin call smark (sp) call salloc (line, SZ_LINE, TY_CHAR) call salloc (name, SZ_FNAME, TY_CHAR) call salloc (value, SZ_FNAME, TY_CHAR) # Initialize the file read. first_rec = YES nunique = 0 uunique = 0 funique = 0 record = 0 szbuf = 0 # Initilize the record read. ncontinue = 0 recptr = 1 # Loop over the text file records. repeat { # Read in a line of the text file. loffset = note (tp_in) nchars = getline (tp_in, Memc[line]) if (nchars == EOF) break # Determine the type of record. if (Memc[line] == KY_CHAR_POUND) { if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) { call pt_kyadd (key, Memc[line], nchars) if (first_rec == YES) call putline (tp_out, Memc[line]) } else if (strncmp (Memc[line], KY_CHAR_NAME, KY_LEN_STR) == 0) { nunique = nunique + 1 call pt_kname (key, Memc[line], nchars, nunique) call putline (tp_out, Memc[line]) } else if (strncmp (Memc[line], KY_CHAR_UNITS, KY_LEN_STR) == 0) { uunique = uunique + 1 call pt_knunits (key, Memc[line], nchars, uunique) call putline (tp_out, Memc[line]) } else if (strncmp (Memc[line], KY_CHAR_FORMAT, KY_LEN_STR) == 0) { funique = funique + 1 call pt_knformats (key, Memc[line], nchars, funique) call putline (tp_out, Memc[line]) } else { # skip lines beginning with # sign call putline (tp_out, Memc[line]) } } else if (Memc[line] == KY_CHAR_NEWLINE) { # skip blank lines call putline (tp_out, Memc[line]) } else { # Get the variable index. if (first_rec == YES) { call pt_kid (column, Memc[name], element) field = pt_kstati (key, Memc[name], KY_INDEX) if (field <= 0) break } # Save the offset of the beginning of the current record. if (recptr == 1) roffset = loffset # Construct the data record. call pt_kgfield (key, field, element, Memc[line], nchars, Memc[value], first_rec, recptr, ncontinue) # Decode the selected fields. if (Memc[line+nchars-2] != KY_CHAR_CONT) { # Select the appropriate column, get its datatype and # allocate the appropriate space. if (first_rec == YES) { element = pt_kstati (key, column, KY_ELEMENT) if (IS_INDEFI(element)) break coltype = pt_kstati (key, column, KY_DATATYPE) if (IS_INDEFI(coltype)) break colwidth = pt_kstati (key, column, KY_LENGTH) if (coltype == TY_CHAR) bufwidth = colwidth + 1 else bufwidth = 1 } # Reallocate buffer space if necessary. if (record >= szbuf) { szbuf = szbuf + BUFSIZE if (coltype == TY_CHAR) call realloc (colptr, szbuf * bufwidth, TY_CHAR) else call realloc (colptr, szbuf, coltype) call realloc (colindex, szbuf, TY_INT) call realloc (recmap, szbuf, TY_INT) } # Decode the selected column. record = record + 1 Memi[colindex+record-1] = 1 + (record - 1) * bufwidth Memi[recmap+record-1] = roffset call pt_gsrt (Memc[value], colptr, coltype, bufwidth, record) first_rec = NO # Reinitialize the record read. ncontinue = 0 recptr = 1 } } } # Cleanup. call sfree (sp) return (record) end # PT_KGFIELD -- Fetch a single fields from the input file. procedure pt_kgfield (key, field, element, line, nchars, value, first_rec, recptr, ncontinue) pointer key # pointer to record structure int field # field to be fetched int element # field array element char line[ARB] # input line int nchars # length of line array char value[ARB] # the field value int first_rec # first record int recptr # line per record index int ncontinue # number of unique lines per record int len, i, cip, nper_line, nokeys, nckeys, nkeys begin # Fetch the value if it is a #K parameter as this will already # be sorted in the key structure. if ((recptr == 1) && (field <= KY_NPKEYS(key))) { len = Memi[KY_KINDICES(key)+field-1] call amovc (Memc[Memi[KY_PTRS(key)+field-1]], value, len) value[len+1] = EOS } # The number of header columns defined by #K at the beginning of # the file is nokeys. if (recptr == 1) nokeys = KY_NPKEYS(key) # Increment the continuation statement counter or reset to 0. if (line[nchars-2] == '*') ncontinue = ncontinue + 1 else ncontinue = 0 # Fill in the record. cip = 1 if (ncontinue < 1) { nper_line = Memi[KY_NPLINE(key)+recptr-1] nkeys = nokeys + nper_line call amovki (int(1), Memi[KY_NELEMS(key)+nokeys], nper_line) do i = nokeys + 1, nkeys { len = Memi[KY_KINDICES(key)+i-1] if (i == field) { call amovc (line[cip], value, len) value[len+1] = EOS } cip = cip + len } recptr = recptr + 1 nokeys = nkeys } else if (ncontinue == 1) { nckeys = nokeys + 1 nkeys = nokeys + Memi[KY_NPLINE(key)+recptr-1] if (first_rec == YES) { Memi[KY_NCONTINUE(key)+recptr-1] = KY_NLINES do i = nckeys, nkeys call malloc (Memi[KY_PTRS(key)+i-1], KY_NLINES * Memi[KY_KINDICES(key)+i-1], TY_CHAR) } do i = nckeys, nkeys { len = Memi[KY_KINDICES(key)+i-1] if ((i == field) && (element == 1)) { call amovc (line[cip], value, len) value[len+1] = EOS } cip = cip + len } nokeys = nkeys recptr = recptr + 1 } else { if (ncontinue > Memi[KY_NCONTINUE(key)+recptr-2]) { Memi[KY_NCONTINUE(key)+recptr-2] = Memi[KY_NCONTINUE(key)+recptr-2] + KY_NLINES do i = nckeys, nokeys call realloc (Memi[KY_PTRS(key)+i-1], Memi[KY_NCONTINUE(key)+recptr-2] * Memi[KY_KINDICES(key)+i-1], TY_CHAR) } do i = nckeys, nkeys { len = Memi[KY_KINDICES(key)+i-1] if ((i == field) && (element == ncontinue)) { call amovc (line[cip], value, len) value[len+1] = EOS } Memi[KY_NELEMS(key)+i-1] = ncontinue cip = cip + len } } end # PT_COLSORT -- Sort the column. procedure pt_colsort (colptr, colindex, nrecs, coltype) pointer colptr # array of column pointers int colindex[ARB] # column indices int nrecs # number of records int coltype # column type begin # Sort the column. switch (coltype) { case TY_INT: call pt_qsorti (Memi[colptr], colindex, colindex, nrecs) case TY_REAL: call pt_qsortr (Memr[colptr], colindex, colindex, nrecs) case TY_CHAR: call strsrt (colindex, Memc[colptr], nrecs) case TY_BOOL: call pt_qsortb (Memb[colptr], colindex, colindex, nrecs) } end # PT_REORDER -- Reorder the input file and write it to the output file. procedure pt_reorder (tp_in, tp_out, recmap, colindex, nrecs) int tp_in # input table file descriptor int tp_out # output file descriptor int recmap[ARB] # record strucuture map int colindex[ARB] # column index int nrecs # number of records int i long lptr pointer sp, line begin call smark (sp) call salloc (line, SZ_LINE, TY_CHAR) do i = 1, nrecs { lptr = recmap[colindex[i]] call seek (tp_in, lptr) call pt_rwrecord (tp_in, tp_out, Memc[line]) } call sfree (sp) end # PT_GSRT -- Decode the column to be sorted. procedure pt_gsrt (value, colptr, coltype, colwidth, record) char value[ARB] # value to be decoded pointer colptr # pointer to the decode column int coltype # the data type of the sort column int colwidth # width of the column int record # the current record number int ip int ctoi(), ctor(), ctowrd() begin # Decode the output value. ip = 1 switch (coltype) { case TY_INT: if (ctoi (value, ip, Memi[colptr+record-1]) <= 0) Memi[colptr+record-1] = INDEFI case TY_REAL: if (ctor (value, ip, Memr[colptr+record-1]) <= 0) Memr[colptr+record-1] = INDEFR case TY_BOOL: while (IS_WHITE(value[ip])) ip = ip + 1 switch (value[ip]) { case 'Y', 'y': Memb[colptr+record-1] = true case 'N', 'n': Memb[colptr+record-1] = false default: Memb[colptr+record-1] = false } case TY_CHAR: if (ctowrd (value, ip, Memc[colptr+(record-1)*colwidth], colwidth) <= 0) Memc[colptr+(record-1)*colwidth] = EOS default: ; } end # PT_FLIPI -- Filp an integer array in place. procedure pt_flipi (a, npix) int a[ARB] # array to be flipped int npix # number of pixels int i, nhalf, ntotal, itemp begin nhalf = npix / 2 ntotal = npix + 1 do i = 1, nhalf { itemp = a[i] a[i] = a[ntotal-i] a[ntotal-i] = itemp } end # PT_RWRECORD -- Read a text record and write it out to the output file. procedure pt_rwrecord (tp_in, tp_out, line) int tp_in # input file descriptor int tp_out # output file descriptor char line[ARB] # line buffer int nchars int getline() begin nchars = getline (tp_in, line) while (nchars != EOF) { call putline (tp_out, line) if (line[nchars-1] != KY_CHAR_CONT) break nchars = getline (tp_in, line) } end