ARTDEF- GLOBAL SYMBOL DEFINITIONS FOR ARITHMETIC SUBROUTINES ARTDEF- GLOBAL SYMBOL DEFINITIONS FOR ARITHMETIC SUBROUTINES ROUTINE NAME: ARTDEF WILL NEED THIS MODULE FOR OVERLAY DESIGN OF LARGE PROGRAMS. CALLABLE: not "callable" AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: ARTDEF LIBRARY: DP:[60,60]CETUS MAINTENANCE: see Mike Higgins EVALAE - SUBROUTINE TO EVALUATE AN RPN TABLE PAGE 2 EVALAE EVALAE - SUBROUTINE TO EVALUATE AN RPN TABLE ROUTINE NAME: EVALAE PURPOSE: To perform the functions stored in the reverse polish table parsed by PARSAE. EVALAE is a real function and must be declared real if you use im- plicit integer. CALLABLE: from FORTRAN. CALL EVALAE (RPNTAB,VALUE) or VALUE = EVALAE (RPNTAB) PARAMETERS: RPNTAB---A reverse polish table. This table must be dimen- sioned to 2 times the maximum number of anticipat- ed operations, +1 (in words). VALUE----The result of the arithmetic statement. ROUTINES USED: The routines used by EVALAE are defined in the module ARTDEF and are stored in the file MATH- LIB.FTN. EXAMPLE: VALUE=EVALAE(RPNTAB) AUTHOR: Mike Higgins WRITTEN: August 1977 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: EVALAE LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: January 78 MAINTENANCE: see Mike Higgins or Jack Martinelli GETVAL-RETRIEVING THE VALUE OF A SYMBOL PAGE 3 GETVAL GETVAL-RETRIEVING THE VALUE OF A SYMBOL ROUTINE NAME: GETVAL PURPOSE: To retrieve a value from the symbol table defined by PARSAE and manipulated by EVALAE. CALLABLE: from FORTRAN CALL GETVAL(SYMTAB,SYM,VAL[,ERR]) or ERR=GETVAL(SYMAB,SYM,VAL [,ERR]) PARAMETERS: SYMTAB---An INTEGER array for the symbol table--see PARSAE. SYM------An 8 byte ASCII string. GETVAL searches SYMTAB for SYM and returns the value of SYM in VAL. This symbol must be left justified and space filled to 8 bytes. VAL------A floating point (REAL*4) number to recieve the current value of SYM. ERR------ERR= -1 if successful. ERR= 0 if no such symbol. ROUTINES USED: none EXAMPLE: CALL GETVAL(SYMTAB,'TITER...',TITER) FEATURES: none AUTHOR:Mike Higgins WRITTEN: August 1978 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: GETVAL LIBRARY: DP:[60,60]CETUS.OLB LAST MODIFICATION: long ago MAINTENANCE: see Linda Mundy or Mike Higgins MATHER- MATHER PAGE 4 MATHER MATHER- MATHER ROUTINE NAME: MATHER PURPOSE: A named common to control the error printing op- tion in the Arithmetic package. The flags in this common determine what is done with division by zero, log of non positive number, or the square root of a negative number. CALLABLE: from FORTRAN-- declare the named common to gain access to these values and flags. PARAMETERS: MATHER---The named common block containing 4 INTEGER*2 var- iables. WORD 0---This word if equal to one, turns off the joblog error messages. If equal to 0 then error messages are printed. (see BATDEF for description of JOB- LOG) WORD 1---An accumulator number of divide by zero errors. WORD 2---Accumulator for number of log of non-positive numbers. WORD 3---Accumulator for number of square root by negative numbers. ROUTINES USED: Uses JOBLOG LUN defined in BATDEF p EXAMPLE: COMMON/MATHER/PRIN,DIVID,NLOG,NSQRT AUTHOR: Mike Higgins WRITTEN: August 1978 SOURCE LANGUAGE: FORTRAN LIBRARY: DP:[60,60]CETUS.OLB LAST MODIFICATION: none MAINTENANCE: see Linda Mundy or Mike Higgins PARSAE- ARITHMETIC EXPRESSION PARSER PAGE 5 PARSAE PARSAE- ARITHMETIC EXPRESSION PARSER ROUTINE NAME: PARSAE PURPOSE: To parse a generalized arithmetic expression into a reverse polish table that can be evaluated by the EVALAE subroutine. It also produces a symbol table that can be accessed by the SETVAL and GET- VAL subroutines. NOTE: EVALAE is a real function only, and you must declare it specifically real if your programs use implicit integer. All values in an equation are treated as real also. CALLABLE: from FORTRAN CALL PARSAE (STRING,LEN,RPNTAB,SYMTAB)[,ERR]) OR ERR=PARSAE(STRING,LEN,RPNTAB,SYMTAB) PARAMETERS: STRING---The arithmetic expression containing symbols and constants combined with the following legal opera- tions: BINARY FUNCTIONS * multiplication / division - subtraction + addition ** exponentiation RELATIONAL FUNCTIONS | vertical bar - "OR" & logical "AND" \ "or" (equivalent to |) >= greater than or equal to <> not equal to <= less than or equal to > greater than < less than == is equal to = arithmatic replacement UNARY FUNCTIONS SQRT(x) square root of x LN(x) natural log of x EXP(x) e to the x NOT(x) the complement of x ABS(x) the magnitude of x CONF05(n) 95% confidence interval CONF0l(n) 99% confidence interval Fully parenthesized expressions are supported BUILT IN CONSTANTS PARSAE- ARITHMETIC EXPRESSION PARSER PAGE 6 PIE------3.1415927 E ---------2.7182818 TRUE ----1.0 FALSE-----0.0 (also see CALC documentation) STRING must be dimensioned to the expected length plus one. LEN-------The length in bytes of STRING default is 32. Set SETMAX to change default. RPNTAB----Reverse polish table. An array for storing an ex- pression. This should be dimensional 2 words across and n words down where n is the number of expected operands per expression. SYMTAB----SYMBOL table array. This should be dimensioned to (12*M)+1 words, where M is the expected number of symbols. All symbol names are stored as left jus- tified, space filled 8 byte fields, and all values are real*4. Symbol names in an expression must start with an alpha (which includes $ and %) but can have alpha and numeric characters in the rema- ining 7 positions. ERR------ERR=0 PARSAE failed ERR.NE.0 PARSAE was successful. PA RSAE- ARITHMETIC EXPRESSION PARSER PAGE 7 ROUTINES USED: ARTDEF FINP EXAMPLE: CALL PARSAE('X=LN(20)*TITER/2**5',19,RPNTAB,SYMTAB) AUTHOR: Mike Higgins WRITTEN: August 1978 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: PARSAE LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: A While Ago MAINTENANCE: see Mike Higgins SETVAL - SETVAL PAGE 8 SETVAL SETVAL - SETVAL ROUTINE NAME: SETVAL PURPOSE: To insert a value into the symbol table for the given ASCII symbol. NOTE: your symbol table and symbol array must begin on an even address, other- wise you will get odd address traps. CALLABLE: from FORTRAN: CALL SETVAL(SYMTAB,SYMB,VAL[,ERR]) or ERR=SETVAL(SYMTAB,SYM,VAL) PARAMETERS: SYMTAB---This (an integer array) is where your symbol table should be -- see PARSAE. The symbol table must be initialized beforehand by at least one call to PARSAE. SYM------An ASCII string that should be defined in SYMTAB. SETVAL searches SYMTAB for SYM and puts VAL into the symbol table at SYM (i.e., SYM takes on VAL) VAL------A floating point (real*4) number to replace the previous value of SYM. ERR------ERR = -1 if successful. ERR = 0 if not success- ful. ROUTINES USED: none AUTHOR: Mike Higgins WRITTEN: August 1978 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: SETVAL LIBRARY: DP:[60,60]CETUS.OLB LAST MODIFICATION: long ago MAINTENANCE: see Linda Mundy or Mike Higgins DATABASE SUBROUTINE CALLING CONVENTIONS PAGE 9 BIO-DATA BASE SUBROUTINES BLDHDR (root,nlv,levtab[,datype]) Initializes the root block for a new file. OPENBF err=openbf(root,name,lun,access[,err]) Opens a data base file. WRTKEY err=wrtkey(root[,key][,val][,mode][,err]) Writes a unique key. WRTELE err=wrtele(root[,key][,val][,nul][,err]) Writes an element (no check for duplicates.) FNDKEY err=fndkey(root[,patt][,key][,val][,err]) Finds the next key that matches your pattern. MATCHK err=matchk(root[,patt][,key][,val][,err]) Finds the next key that matches your pattern. GETKEY err=getkey(root[,nul][,key][,val][,err]) Returns the currently active key. MODKEY err=modkey(root[,nul][,key][,val][,err]) Modifies a database key. DELKEY err=delkey(root[,err]) Deletes current key and all its offspring. FILEID (root,nlv[,levtab][,datype][,verson]) Inverse of bldhdr, returns info from root block. LEVELD (root[,levno][,scansz][,datasz][,datype]) Returns info about current level. KEYAGE err=(root,age[,err]) Returns age of currently active key. RESETB (root) Resets search to first sibling in active branch of tree. PUSHLV err=pushlv(root[,err]) Pushes down to next level of tree. BACKUP err=backup(root[,err]) Backs up to the previous level of the tree. SYNCBF (root) Forces the disk file to match the core image. CLOSBF (root) Syncs and closes the database file. DATABASE SUBROUTINE CALLING CONVENTIONS PAGE 10 PARAMETER SUMMARY ROOT A scratch area for the routines to store all core resident file blocks. NRLEVS The number of levels in the tree structure. LEVTAB A table describing the levels in the tree. DATYPE A word describing the type of file. NAME The name of the file. LUN Logical unit number to open database file under. ACCESS The mode that the file will be opened under. 0=shared. 1=read only. 2=read write. 3=read, write, and create. 4=force new file. ERR The return status of many database routines. In general, positive means success, zero or negative means failure. KEY The "scan" section of a node in the tree. VALS The "data" section of a node in the tree. MODE The mode that is to be used when writing a key. 0=error if key is a duplicate. 1=delete old data under a duplicate key. 2=open a duplicate key for appending more data. 3=modify key if it is not unique and try it again. NUL A null parameter present only for compatability with similar database routines. PATT A search pattern for finding keys. DATABASE SUBROUTINE CALLING CONVENTIONS PAGE 11 VERSON The structure version number of the file. (Only of intrest if the internal structure of a database file is ever changed). LEVNO The currently active level of the tree. SCANSZ The size of the "scan" area of a key at the current level. DATASZ The size (in bytes) of the "data" section of a key at the current level. AGE The age of the currently active key. BLDHDR - INITIALIZING A NEW DATABASE FILE ROOT BLOCK PAGE 12 BLDHDR BLDHDR - INITIALIZING A NEW DATABASE FILE ROOT BLOCK ROUTINE NAME: BLDHDR PURPOSE: BLDHDR is called before OPENBF to initialize a new root block when the file being opened may be a new one. BLDHDR must be called before using MODE=4 to OPENBF, and probably should be called before using MODE=3 to OPENBF. CALLABLE: From FORTRAN only: CALL BLDHDR(ROOT,NRLEVS,LEVTAB[,DATYPE]) PARAMETERS: ROOT = The in core database buffer for the file. NRLEVS = The number of levels in the database file structure LEVTAB = A table describing every level of the new files tree structure. LEVTAB must be dimentioned to 3 by NRLEVS words. The meanings of the three words for each level are: LEVTAB(1,I) = The total number of bytes in a key at level I. The total size must take into account the number of bytes in the scan area of a key, in the data section, plus four bytes in all levels except the bottom level. LEVTAB(2,I) = The number of bytes in the scan section of a key at level I. LEVTAB(3,I) = The type of data stored in the data section, where 1 means integers, 2 means reals, 4 means ASCII. The data types can be ORed together for combinations. DATYPE = A one word data type for identifying the type of struc- ture. ROUTINES USED: None. EXAMPLE: CALL BLDHDR(ROOT,3,LEVTAB,'TR') AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: BLDHDR LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins OPENBF- OPEN A DATABASE FILE PAGE 13 OPENB OPENBF- OPEN A DATABASE FILE ROUTINE NAME: OPENBF PURPOSE: To open an existing database file, or to create a new file initalized by BLDHDR. CALLABLE: By FORTRAN only: CALL OPENBF(ROOT,NAME,LUN,MODE[,ERR]) or ERR=OPENBF(ROOT,NAME,LUN,MODE[,ERR]) PARAMETERS: ROOT The core buffer for storing the root block and all I/O buffers for each level. ROOT must be dimensioned to 512*NRLEVS+512 bytes, where NRLEVS is the number of levels in the files structure. NAME A string containing the file speci fier for the database file you wish to open. Name must be terminated with a NUL. The default device is BD:, the default file type is '.BDB'., and the default UIC is the uic that the program is running under. LUN The FORTRAN Logical Unit Number that you wish to open the file under MODE The mode that the file is to be opened under: MODE=0 Means shared LUN. The same file can be opened under more than one in core ROOT buffer with the same lun. This allows you to do two sets of file manipulations on the same database file. In other words, keep two (or more) pointers into the file at the expense of two or more core ROOT buffers. MODE=1 Means read only. MODE=2 Read and write. MODE=3 Read, write and create (must have called BLDHDR) MODE=4 Forces creation of new file (must have called BLDHDR). ERR Error return value. Returns -100 for missing BLDHDR call or corrupted database file, 0 means success, all other negative error returns are FCS error codes. See the RSX11M Pocket Reference for a complete list of FCS I/O error codes. ROUTINES USED: $FCHNL, OPEN$ macro EXAMPLE: CALL OPENBF(ROOT,'DP:[60,200]DICT',8,1) INTEGER OPENBF IF (OPENBF(DBUF,STRING,DLUN,8,2) AUTHOR: Pete Linhard, with mods by Mike Higgins OPENBF- OPEN A DATABASE FILE PAGE 14 SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: OPENBF LIBRARY: [60,100]DATABASE MAINTENANCE: See mike Higgins WRTKEY - WRITES A UNIQUE DATABASE KEY PAGE 15 WRTKEY WRTKEY - WRITES A UNIQUE DATABASE KEY ROUTINE NAME: WRTKEY PURPOSE: This procedure writes a unique key in a database file at the currently active level. Several actions can be selected for a non-unique key (see the MODE parameter). CALLABLE: From FORTRAN CALL WRTKEY(ROOT,KEY[,DATA][,MODE][,ERR]) or ERR=WRTKEY(ROOT,KEY[,DATA][,MODE][,ERR]) PARAMETERS: ROOT The database root block and I/O buffers KEY A string to use for the scan section of the new key. This new key can have wild card characters (\) in it, but the re- sult depend on the MODE of the write. If you attempt to write backslashes into a new key, they will be turned into blanks. The key is assumed to be the same length as the scan size for keys at this level, if the key is terminated prematurely by a NUL, it is assummed to be padded with back- slashes. VALS The data section of the new key. If the VALS section of a new key is omitted, the key will be created with unpredict- able data in the data section. MODE The action to take when the key is not unique. The differ- ent modes supported are: MODE=0 Error return if key is not unique. MODE=1 Delete old data under existing key and return suc- cess. MODE=2 "FNDKEY" mode. The already existing key is activated as if it was found by FNDKEY. MODE=3 Modify key parameter if it is not unique. The key is modified by doing a successor fuction on the first few bytes of the key. ERR Error return parameter. Possible errors are: ERR=-100 Bad ROOT block. ERR= -99 You do not have write access. ERR= 0 Key was not unique (MODE=0). ERR= +n Successfull return. ROUTINES USED: B$ACTIVATE B$ALOCATE B$DELETEDATA B$GETNEXT B$IOERROR, READVB and WRITEVB macros. EXAMPLE: CALL WRTKEY(ROOT,'NEW KEY',,0,ERR) CALL WRTKEY(ROOT,KEY,DATA,,2) IF (WRTKEY(ROOT,KEY,DATA) .LE. 0) GOTO 999 AUTHOR: Mike Higgins WRTKEY - WRITES A UNIQUE DATABASE KEY PAGE 16 SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: WRTKEY LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins WRTELE- WRITES A NON-UNIQUE KEY PAGE 17 WRTELE WRTELE- WRITES A NON-UNIQUE KEY ROUTINE NAME: WRTELE PURPOSE: Writes a key in a database file without checking to assure that the key is unique. CALLABLE: From FORTAN only: CALL WRTELE(ROOT[,KEY][,VAL][,NUL][,ERR]) or ERR=WRTELE(ROOT[,KEY][,VAL]) PARAMETERS: ROOT The database root block and I/O buffers. KEY The scan section of the key to be written. VAL The data section of the key. NUL An ignored parameter that makes WRTELE calls compatible with WRTKEY calls. ERR The error return parameter. Possible errors are: ERR=-100 Bad root block. ERR= -99 Write permission denied. ERR= 0 Could not write at this level. ERR= +n Successfull return. ROUTINES USED: B$ACTIVATE B$ALOCATE B$GETNEXT EXAMPLE: CALL WRTELE(ROOT,'TI') ERR=WRTELE(ROOT,,VAL) IF (WRTELE(ROOT,KEY,,,ERR) .LE. 0) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: WRTELE LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins MODKEY - MODIFIES THE CURRENTLY ACTIVE KEY PAGE 18 MODKEY MODKEY - MODIFIES THE CURRENTLY ACTIVE KEY ROUTINE NAME: MODKEY PURPOSE: MODKEY allows you to modify the currently active key in place without having to delete it and rewrite it. CALLABLE: From FORTRAN only: CALL MODKEY(ROOT[,KEY][,VAL][,NUL][ERR]) or ERR=MODKEY(ROOT[,KEY][,VAL]) PARAMETERS: ROOT The database root block and I/O buffers KEY The pattern for replacing the scan section of the current key. If this pattern is prematurely terminated with a NUL, then the rest of the current key is left unchanged. If this pattern contains backslashes (\), then just the characters corresponding to the backslashes in the current key are left unchanged, and all other characters are replaced. VAL The new data section of the key. If this parameter is pre- sent, all of the bytes are assumed to be present and are re- placed in the key. If this parameter is missing or null, the data section for the current key is left unchanged. NUL An ignored parameter included to make MODKEY calls compat- able with WRTELE and WRTKEY calls. ERR Error return parameter. Possible error values are: ERR=-100 Bad root block. ERR= -99 Write permission denied. ERR= 0 You don't have a key active. ERR= +n Successfull return. ROUTINES USED: None. EXAMPLE: CALL MODKEY(ROOT,'\\\\\2\\',,,ERR) ERR=MODKEY(ROOT,,NEWDAT) IF(MODKEY(ROOT,PATT,NEWDAT) .LE. 0) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: MODKEY LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins DELKEY - DELETES A DATABASE KEY AND ALL ITS OFFSPRING PAGE 19 DELKEY DELKEY - DELETES A DATABASE KEY AND ALL ITS OFFSPRING PURPOSE: To delete the currently active database key and all of it's offspring. CALLABLE: From FORTRAN only. CALL DELKEY(ROOT[,ERR]) or ERR=DELKEY(ROOT) PARAMETERS: ROOT The database root block and I/O buffers. ERR The error status return. Possible error returns are: ERR=-100 Means bad root block. ERR= 0 Means cannot perform delete. ERR= -1 Successfull return. ROUTINES USED: B$DELETEDAT EXAMPLE: CALL DELETE(ROOT) IF (DELETE(ROOT) .NE. -1) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: DELKEY LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins FNDKEY - DATABASE SEARCH ROUTINE PAGE 20 FNDKEY FNDKEY - DATABASE SEARCH ROUTINE ROUTINE NAME: FNDKEY PURPOSE: FNDKEY finds the next database key that matches your pattern and opens it for reading, writing, or modifying. CALLABLE: From FORTRAN or MACRO PARAMETERS: From FORTRAN: CALL FNDKEY(ROOT[,PATT][,KEY][,VAL][,ERR]) or ERR=FNDKEY(ROOT[,PATT][,KEY][,VAL][,ERR]) ROOT The data buffer initialized by BLDHDR or OPENBF that is used by all database routines to store temporary variables and I/O buffers in. PATT A simple pattern to search for in the database. This "pat- tern" is a string of characters with backslash (\) char- acters as "wild card" characters. The pattern is assumed to be the same length as the scan section of the keys being searched for, but if it is prematurely terminated by a NUL, the remaining characters of the pattern are assumed to be backslashes. KEY A buffer for FNDKEY to return the actual string that your pattern matched. This buffer MUST be large enough for the whole scan section of a key to fit into, or you will get very strange results from your fortran programs. VAL A buffer for storing the data section of a key in. Again, this buffer MUST be large enough to hold the complete data section of a key. ERR A word that the status of the search is returned in. Possible error values are: ERR= +n means successfull return. ERR= 0 means there were no keys that matched. ERR= -1 means there are no more keys that match. ERR= -100 means you called FNDKEY with a bad ROOT parameter. PARAMETERS: From a MACRO program: R5 Points to a FORTRAN like parameter list, essentially the same as FORTRAN would have produced. R4 Points to the ROOT buffer. The FORTRAN parameter list must have all the parameters, including a slot for the root buffer, but it need not also have the ROOT pointer. R0 The error return is also returned here. B$READKEY Is the entrypoint for the MACRO section of FNDKEY. You can call via the FNDKEY entrypoint, and the routine will in- itialize R4 for you. This is rarely done because code for checking the root block is also executed in this entrypoint. ROUTINES USED: B$ACTIVATE B$GETNEXT B$GETKEY $CMPS FNDKEY - DATABASE SEARCH ROUTINE PAGE 21 EXAMPLE: CALL FNDKEY(ROOT,'TI',,,ERR) IF (FNDKEY(ROOT,PATTRN) .LE. 0) GOTO 999 CALL FNDKEY(ROOT,,KEY,,ERR) from MACRO: .PSECT DATA PLIST: .WORD 4 ;4 ARGUMENTS .WORD ROOT ;POINTER TO ROOT BLOCK .WORD -1 ;NUL PATT PARAMETER .WORD KEY ;BUFFER FOR KEY .WORD VAL ;BUFFER FOR DATA KEY: .BLKB 56 VAL: .BLKB 14 .PSECT MOV PLIST,R5 ;INITIALIZE THE ARG LIST I MOV ROOT,R4 ;INITIALIZE THE ROOT POINTER JSR PC,B$READKEY ;CALL FNDKEY TST R0 ;CHECK ERR RETURN BLE ERROR ;ERR WAS = 0 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: FNDKEY LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins MATCHK- DATABASE FILE SEARCH ROUTINE PAGE 22 MATCHK MATCHK- DATABASE FILE SEARCH ROUTINE ROUTINE NAME: MATCHK PURPOSE: MATCHK searches database structures exactly the same way that FNDKEY does accept a more complex "string pattern re- cognition" is done to find the key that matches. Not only can the pattern contain wildcards in the form of backslashes (\), but the following constructs are also recognized: * The asterisk matches any sub-string, including the null sub- string. -c (Where c represents any character) Matches any character that is not equal to c. [set] (Where set represents any set of characters) Matches any one of the characters in the set. -[set] Matches any character not in the set. Example: -[aeiouy] will match any consonant. CALLABLE: From FORTRAN only: CALL MATCHK(ROOT,PATT[,KEY][,VAL][,ERR]) or ERR=MATCHK(ROOT,PATT[,KEY][,VAL]) PARAMETERS: ROOT Database root block and I/O buffers. PATT The pattern to search for. This pattern MUST be terminated with a NUL byte or your program will blow up. KEY A buffer to store the actual string matched to. VAL A buffer to contain the data section of the key found ERR The error return parameter, where the possible errors are: ERR= +n means successful return. ERR= 0 means no keys matched your pattern. ERR= -1 means no more keys match your pattern. ERR= -100 means you sent me a bad root block. ROUTINES USED: B$ACTIVATE B$GETKEY B$GETNEXT $MATCH EXAMPLE: CALL MATCHK(ROOT,'*MUTAGENISIS*',KEY,ERR) IF (MATCHK(ROOT,PATTRN,KEY) .LE. 0) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: MATCHK LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins GETKEY- RETURNS THE SCAN AND DATA SECTIONS OF A KEY PAGE 23 GETKEY GETKEY- RETURNS THE SCAN AND DATA SECTIONS OF A KEY ROUTINE NAME: GETKEY PURPOSE: GETKEY returns the scan and/or the data section of the currently active key. CALLABLE: From FORTRAN or MACRO PARAMETERS: From FORTRAN: CALL GETKEY(ROOT[,NULL][,KEY][,VAL][,ERR]) or ERR=GETKEY(ROOT[,NULL][,KEY][,VAL]) ROOT The database root block and buffers. NULL A null parameter necessary to make GETKEY calls compatable with FNDKEY. KEY A buffer to return the scan section of the key in. VAL A buffer to return the data section of the key. ERR The error return parameter. Possible error values are: ERR= +n means successfull return. ERR= 0 means you have no key open to get. ERR= -100 means you sent me a bad ROOT buffer. To call from MACRO, use the entrypoint BGETKEY and follow the example given for the FNDKEY MACRO call. ROUTINES USED: NONE EXAMPLE: CALL GETKEY(ROOT,,KEY,VALS) IF (GETKEY(ROOT,,KEY,VALS) .LE. 0) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: GETKEY LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins PUSHLV- PUSHES TO NEXT LEVEL OF TREE STRUCTURE PAGE 24 PUSHLV PUSHLV- PUSHES TO NEXT LEVEL OF TREE STRUCTURE ROUTINE NAME: PUSHLV PURPOSE: To push down to the next level of the tree structure in a database file. CALLABLE: From FORTRAN only: CALL PUSHLV(ROOT[,ERR]) or ERR=PUSHLV(ROOT) PARAMETERS: ROOT The buffer containing the root block and the I/O buffers. You must have a key active at the current level to push down to the next. ERR The error return parameter, where: ERR= -1 (FORTRAN .TRUE.) means success. ERR= 0 (.FALSE.) you can't push from here. ERR= -100 Means bad root block. ROUTINES USED: None. EXAMPLE: CALL PUSHLV(ROOT) IF (.NOT. PUSHLV(ROOT)) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: PUSHLV LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins BACKUP- BACKS UP TO PREVIOUS LEVEL OF STRUCTURE PAGE 25 BACKUP BACKUP- BACKS UP TO PREVIOUS LEVEL OF STRUCTURE ROUTINE NAME: BACKUP PURPOSE: To back up to the previous level of the tree structure of a database file. CALLABLE: From FORTRAN only: CALL BACKUP(ROOT[,ERR]) or ERR=BACKUP(ROOT) PARAMETERS: ROOT The database root block and I/O buffers. ERR The error return status, where: ERR= 0 means you can't backup that far. ERR= -1 means successful return. ERR=-100 means bad root block. ROUTINES USED: None. EXAMPLE: CALL BACKUP(ROOT) IF (BACKUP(ROOT) .EQ. 0) GOTO 999 AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO 11 with SUPERMAC OBJECT MODULE NAME: BACKUP LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins RESETB- RESET DATABASE SEARCHES PAGE 26 RESETB RESETB- RESET DATABASE SEARCHES ROUTINE NAME: RESETB PURPOSE: RESETB forces the next search to reset to the first sibling in the current level before starting the search. CALLABLE: From FORTRAN only: CALL RESETB(ROOT) PARAMETERS: ROOT The database root block and I/O buffers. ROUTINES USED: None. EXAMPLE: CALL RESETB(ROOT) FEATURES: No I/O is done until the next search (FNDKEY, MATCHK) is requested, and even then, no I/O is done if the first block of siblings is already in core. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: RESETB LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins FILEID - RETURNS INFORMATION ABOUT DATABASE FILE STRUCTURES PAGE 27 FILEID FILEID - RETURNS INFORMATION ABOUT DATABASE FILE STRUCTURES ROUTINE NAME: FILEID PURPOSE: To return all the information about a database file that was initalized by BLDHDR. CALLABLE: From FORTRAN only: CALL FILEID(ROOT,NLV[,LEVTAB][,DATYPE][,VERSION]) PARAMETERS: ROOT The database root block and I/O buffers. NLV The number of levels in the structure. LEVTAB A table which describes each level of the structure. LEVTAB must be dimensioned to (3,NLV) or greater. (If you do not know how big NLV is beforehand, you had better make extra room). The values returned for each level are: LEVTAB(1,N) The total size in bytes of a key at the Nth level of the structure. LEVTAB(2,N) The size of the scan section of a key at the Nth level of the structure. LEVTAB(3,N) The type of data stored in the data section in the Nth level, where 0=NONE, 1=INTEGER, 2=REAL, and 3=ASCII. These data types may be ORed in any combination. DATYPE The data type word for this file. The data type is any 16-bit bit pattern which is used to identify the type of the file. Some programs, like FILEDIT will perform differently for different data types. Many programs will only work when they recognize the correct value in this word. VERSION The database routines version number. This number currently returns an integer value of 3. if changes are primatives store data, this word will change to indicate a "new" type of database file. ROUTINES USED: None. EXAMPLE: CALL FILEID(ROOT,N) CALL FILEID(ROOT,N,,TYPE) AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: FILEID FILEID - RETURNS INFORMATION ABOUT DATABASE FILE STRUCTURES PAGE 28 LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins LEVELD - RETURNS INFORMATION ABOUT THE CURRENTLY ACTIVE LEVEL PAGE 29 LEVELD LEVELD - RETURNS INFORMATION ABOUT THE CURRENTLY ACTIVE LEVEL ROUTINE NAME: LEVELD PURPOSE: To return all information about keys in the currently active level of a database file. This information is initially set by BLDHDR. CALLABLE: From FORTRAN only: CALL LEVELD(ROOT[,LEVNO][,SCANSZ][,DATASZ][,DATAYP]) PARAMETERS: ROOT The database root block and I/O buffers. LEVNO The depth of the currently active level, where the first level is 1, and every PUSHLV call increments the depth by one. SCANSZ The size in bytes of the scan section of a key at this level. DATASZ The size in bytes of the data section of keys at this level. DATAYP The type of data stored in this level, where DATAYP=0 means no data, 1=INTEGER, 2=REAL, 3=ASCII, and these types can be ORed together in any combination. ROUTINES USED: None. EXAMPLE: CALL LEVELD(ROOT,LVN,,,TYPE) CALL LEVELD(ROOT,,SCANSZ,DS) AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: LEVELD LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins KEYAGE - RETURNS THE AGE OF A KEY PAGE 30 KEYAGE KEYAGE - RETURNS THE AGE OF A KEY ROUTINE NAME: KEYAGE PURPOSE: This routine calculates and returns the age of the currently active key. CALLABLE: From FORTRAN only: CALL KEYAGE(ROOT,AGE[,ERR]) PARAMETERS: ROOT The database root block and I/O buffers. AGE Return parameter for the age of the key. ERR Error return parameter, where: ERR=0 Means failure (bad root block or no key currently ac- tive). ERR=-1 Means successful return ROUTINES USED: None. EXAMPLE: CALL KEYAGE(ROOT,AGE,ERR) ERR=KEYAGE(ROOT,KEY) AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: KEYAGE LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins SYNCBF - UPDATES THE DISK IMAGE OF A DATABASE FILE PAGE 31 SYNCBF SYNCBF - UPDATES THE DISK IMMAGE OF A DATABASE FILE ROUTINE NAME: SYNCBF PURPOSE: To write out all modified blocks in the in-core buffers of a database file. This assures that the disk version is updated to be the same as the core version. CALLABLE: From FORTRAN only: CALL SYNCBF(ROOT) PARAMETERS: ROOT The database in-core root block and I/O buffers. ERR The error return parameter, where: ERR=-100 Means corruppted root block. ERR= +1 Means successfull return. ROUTINES USED: B$IOERROR, READVB and WRITEVB macros. EXAMPLE: CALL SYNCBF(ROOT) AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: SYNCBF LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins CLOSBF - CLOSES A DATABASE FILE PAGE 32 CLOSBF CLOSBF - CLOSES A DATABASE FILE ROUTINE NAME: CLOSBF PURPOSE: To update the disk image of a database file, close it, and return the LUN to a state that allows reusing it from FORTRAN. CALLABLE: From FORTRAN only: CALL CLOSBF(ROOT[,ERR]) PARAMETERS: ROOT The database root block and I/O buffers. ERR The error return parameter, where: ERR=-100 Means corrupt root block. ERR= +1 Signifies successfull return. ROUTINES USED: B$IOERROR, WRITEVB macro. EXAMPLE: CALL CLOSBF(ROOT) AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: CLOSBF LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$DELETEDATA - INTERNAL ROUTINE TO DELETE OFFSPRING PAGE 33 B$DELETEDATA B$DELETEDATA - INTERNAL ROUTINE TO DELETE OFFSPRING ROUTINE NAME: B$DELETEDATA PURPOSE: To delete all the offspring of the currently active key. CALLABLE: From MACRO only PARAMETERS: R5 Must point to a zero word. R4 Pointer to database root block and I/O buffers. R3 Scratch used as buffer address. R2 Stack pointer to level table. R1 Used as scratch R0 Used as scratch. ROUTINES USED: B$ACTIVATE B$DEALOCATE B$READKEY AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO1 with SUPERMAC OBJECT MODULE NAME: B$DELE LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$ACTIVATE INTERNAL ROUTINE TO ACTIVATE A LEVEL PAGE 34 B$ACTIVATE B$ACTIVATE INTERNAL ROUTINE TO ACTIVATE A LEVEL ROUTINE NAME: B$ACTIVATE PURPOSE: To read in the first block of siblings and initialize the stack entry for the current level of a database file. CALLABLE: From MACRO programs only. PARAMETERS: R0 Is used as a scratch variable. R2 Level stack pointer. R3 Is returned as current I/O buffer address. R4 Pointer to root block. ROUTINES USED: B$IOERROR, WRITEVB and READVB macros EXAMPLE: MOV @RT(R5),R4 MOV R4,R2 ADD #RT.1ST+LV.SIZE,R2 JSR PC,B$ACTIVATE FEATURES: Writes out the I/O buffer if it contains a modified data block. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$ACTI LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$GETNEXT - INTERNAL ROUTINE TO READ NEXT BLOCK OF SIBLINGS PAGE 35 B$GETNEXT B$GETNEXT - READS NEXT BLOCK OF SIBLINGS ROUTINE NAME: B$GETNEXT PURPOSE: To read in the next block of siblings in a database file. CALLABLE: From MACRO only. PARAMETERS: R2 The level stack pointer. R3 The pointer to the I/O block for this level. R4 The pointer to the root block. Returns carry bit set on error. ROUTINES USED: B$IOERROR, READVB and WRITEVB macros EXAMPLE: MOV 2(R5),R4 MOV RT.BUF(R4),R3 MOV RT.PCL(R4),R2 JSR PC,B$GETNEXT BCS ERROR FEATURES: Writes out the I/O buffer if it contains a modified block. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$GETN LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$ALOCATE - INTERNAL DATABASE ROUTINE FOR ALLOCATING BLOCKS PAGE 36 B$ALOCATE B$ALOCATE -INTERNAL DATABASE ROUTINE FOR ALLOCATING BLOCKS ROUTINE NAME: B$ALOCATE PURPOSE: Allocates blocks off of the free list or the end of a file for new keys in a database file. CALLABLE: From MACRO only PARAMETERS: R4 Pointer to root block and I/O buffers. R3 Returns pointing at the buffer. R2 Pointer to the level table stack. R1 Scratch used for storing block numbers. R0 Scratch used to store last legal address of block. ROUTINES USED: B$IOERROR, READVB and WRITEVB macros EXAMPLE: SCALL B$ALOCATE ON.ERROR THEN GOTO EROUTINE FEATURES:B$ALOCATE will conserve I/O operations when the block allo- cated was just deallocated recently. The deallocated block will still be in core, and allocate will grab it without ever writing it into the disk version of the free list. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$ALOC LIBRARY: [60,100]MIKESLIB MAINTENANCE: See Mike Higgins B$DEALOCATE - INTERNAL ROUTINE TO DEALLOCATE BLOCKS PAGE 37 B$DEALOCATE B$DEALOCATE - INTERNAL ROUTINE TO DEALLOCATE BLOCKS ROUTINE NAME: B$DEALOCATE PURPOSE: Deallocates blocks in a database file and adds them to the free list. CALLABLE: From MACRO only. PARAMETERS: R4 Pointer to root block and I/O buffers. R3 Scratch register used to hold the address of the block to be deallocated. R2 The level table stack pointer. R1 Scratch register to contain the block number. R0 Another scratch block number. ROUTINES USED: B$IOERROR, READVB and WRITEVB macros. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$DEAL LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$OPENFOR - INTERNAL ROUTINE TO OPEN A FORTRAN FILE PAGE 38 B$OPENFOR B$OPENFOR - INTERNAL ROUTINE TO OPEN A FORTRAN FILE ROUTINE NAME: B$OPENFOR PURPOSE: To open a file in such a manner that FORTRAN will think he opened it himself. CALLABLE: From MACRO only. PARAMETERS: R0 Fdb address. R1 Address of an error routine (usually B$IOERROR). R3 Address of the FORTRAN object time system variables area (@ $otsv). ROUTINES USED: Run time FDB initializing macros, plus the OPEN$W macro. EXAMPLE: This routine is used by the SUPERMAC PUTLINE macro, you should never need to use it otherwise. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$OPEN LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins B$IOERROR - PRINTS AN I/O ERROR ON JOBLOG AND EXITS PAGE 39 B$IOERROR B$IOERROR - PRINTS AN I/O ERROR ON JOBLOG AND EXITS ROUTINE NAME: B$IOERROR PURPOSE: Writes an fcs error message on the joblog and exits from a FORTRAN program. CALLABLE: From MACRO routines within FORTRAN programs only. PARAMETER:R0 must contain the FDB address of the file in which an error has occured. ROUTINES USED: CONV, PUTLINE and PRINT macros. EXAMPLE: LET R0 := RT.FDB(ROOT) SCALL B$IOERROR FEATURES:Because B$IOERROR uses the FORTRAN EXIT routine, all Fortran files will be closed automaticly before your FORTRAN main program terminates. AUTHOR: Mike Higgins SOURCE LANGUAGE: MACRO11 with SUPERMAC OBJECT MODULE NAME: B$IOER LIBRARY: [60,100]DATABASE MAINTENANCE: See Mike Higgins ATTACH/DETACH IO DEVICE TO/FROM A FORTRAN PROGRAM PAGE 40 ATTACH/DETACH ATTACH/DETACH IO DEVICE TO/FROM A FORTRAN PROGRAM ROUTINE NAME: ATTACH/DETACH PURPOSE: When a program attaches to device no other program can ac- cess that device until the attached program issues a call to DETACH from FORTRAN. If a device is attached already when the ca ll to ATTACH is made by your program , ATTACH will wait for a detach of the owning program to exit. At that time your call to ATTACH will complete its execution and re- turn. This routine is particulary useful for text editing type ap- plications. A list command for example may take an appreci- able amount of time to execute when only a subset of the listed content was desired. The typical FORTRAN write statement to a terminal can be suppressed by typing a con- trol 'o'. However this is only on a line by line basses if the terminal is not attached to the editing terminal. If a call to ATTACH is made before a write loop is executed the user sitting at the terminal may type a control 'o' and all output that would have been typed out on the terminal is suppressed until a call to DETACH is made or the user types a control "O" a second time (note: ATTACH should only be used on terminals or printers). CALLABLE: FROM FORTRAN -- CALL DETACH(LUN) CALL ATTACH(LUN) PARAMETERS: lun = logical unit number ROUTINES USED: QIO$S EXAMPLE: CALL ATTACH(LPR) DO 234 I=1,NOFLIN 234 WRITE(LPR,101)(TEXT(J),J=1,80) CALL DETACH(LPR) AUTHOR: MIKE HIGGINS WRITTEN: APRIL 1978 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: ATTACH AND DETACH LIBRARY: DP:[60,60]MIKES LAST MODIFICATION: no modifications since writing. ATTACH/DETACH IO DEVICE TO/FROM A FORTRAN PROGRAM PAGE 41 MAINTENANCE: NO FORMAL MAINTAINCE. DELETE- DELETING A FILE FROM FORTRAN PAGE 42 DELETE DELETE- DELETING A FILE FROM FORTRAN ROUTINE NAME: DELETE PURPOSE: This routine will delete the file associated with the logi- cal unit number given the one and only argument. DELETE can be used a a function to get the FCS error status of the de- lete operation. But it must be declared integer for this to work properly. It is quite useful to delete a scratch file during run time. (note: the file must be open, or DESIGN must be used to fill in the entire file name, including the specific version number in the fdb). Invalid LUN will re- sult in a FORTRAN error trapped by the FORTRAN RTS. CALLABLE: from FORTRAN - CALL DELETE(lun) OR ERR=DELETE (LUN) PARAMETERS: LUN = logical unit number ERR=FCS erron status ROUTINES USED: DELET$, $FCHNL, $OTSV EXAMPLE: program to exchange three integer fields. CALL ASSIGN (1,'DATA.DAT') CALL ASSIGN (2,'SCRATCH') DO 100 I=1,NLINES READ(1,END=99)IVAL1,IVAL2,IVAL3 100 WRITE(2) IVAL3,IVAL1,IVAL2 CALL DELETE (1) !********** delete the old file. 99 CALL RENAME (2,'DATA.DAT') !create a new one. CALL EXIT END FEATURES: callable from FORTRAN as a funtion or a subroutine. AUTHOR: MIKE HIGGINS WRITTEN: some time a go SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: DELETE LIBRARY: DP:[60,60]CETUS.OLB LAST MODIFICATION: unknown MAINTENANCE: not formally maintained. DUMPBF DUMP ROOT BLOCK PARAMETERS PAGE 43 DUMPBF DUMPBF DUMP ROOT BLOCK PARAMETERS ROUTINE NAME: DUMPBF PURPOSE: Used as a debugging aid in conjunction with the CETUS DATA- BASE routines. DUMPBF will print on the LUN specified in the common block named CONSOL. The default defined by BAT- DEF is 5. CALLABLE: from FORTRAN -- CALL DUMPBF(ROOT) PARAMETERS: ROOT-----The root block array (see OPENBF and BLDHDR) ROUTINES USED: none EXAMPLE: open FEATURES: none AUTHOR: Jack Martinelli of CETUS Corp. WRITTEN: March 1978 SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: DUMPBF LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins GETVER - GETTING THE VERSION NUMBER OF A FILE PAGE 44 GETVER GETVER - GETTING THE VERSION NUMBER OF A FILE ROUTINE NAME: GETVER PURPOSE: In most cases of file name specification, version numbers of files are rarely specified explicitly. The default FCS uses is version 0 ie. the most recent version of a file. One useful application of GETVER was for a compile link and go routine where a scratch file was kept for various user program attributes. One of these parameters was the user's source file version number. When the user made modifica- tions to the source and typed 'GO' a version number check was made to determine if it was necessary to compile again. If the version number did not change the source was not re- compiled. CALLABLE: from FORTRAN - VERNO=GETVER(lun) PARAMETERS: LUN = logical unit number ROUTINE USED: The FORTRAN RTS routines $FCHNL EXAMPLE: C Check his version number to see if we should C recompile. C READ(SCRLUN'VERPNT)OLDVER NEWVER=GETVER(SOURCE) IF(NEWVER .EQ. OLDVER) GO TO 890 C C The old version is different so compile the new version C and update the parameter file. C write(scrlun'verpnt)newver call compile . . . GETVER - GETTING THE VERSION NUMBER OF A FILE PAGE 45 AUTHOR: JACK MARTINELLI WRITTEN: SEPTEMBER 1977 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: GETVER LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: Still unmodified. MAINTENANCE: Not formally maintained. TURN OFF FORTRAN CARRIAGE CONTROL. PAGE 46 NOTFTN TURN OFF FORTRAN CARRIAGE CONTROL. ROUTINE NAME: NOTFTN PURPOSE: This subroutine will turn off FORTRAN carriage control on the file attached to the logical unit number. The file must be open for this routine to work. It is suggested that you call this routine after your first read or write, or just before you close your LUN. An invalid logical unit mumber will result in a FORTRAN error trapped by the FORTRAN RTS (error 32). CALLABLE: by FORTRAN --CALL NOTFTN(LUN) PARAMETERS: lun = logical unit number. ROUTINES USED: the FORTRAN RTS routine $FCHNL. EXAMPLE: CALL ASSIGN(SRT,NAME) !link the file to a LUN. 420 IF(GETSRT(SRTBUF,BUF) .LT. 0) GO TO 430 C C GET A LINE FROM SORTED FILE/BUFFER IF THERE ARE ANY MORE. C IF NO MORE LINES THEN TURN OFF FORTRAN C.C AND CLOSE THE FILE. C N=LEN(BUF,BREC) !get length of this line. WRITE(SRT,4000,ERR=480)(BUF(I),I=1,N) 4000 FORMAT(140A1) GO TO 420 430 CALL NOTFTN(SRT) !turn off cc bit in fdb. CALL CLOSE(SRT) !and close this lun. AUTHOR: MIKE HIGGINS WRITTEN: SEPTEMBER 1977 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: NOTFTN LIBRARY: DP:[60,60]CETUS RENAME- CHANGING A FILE NAME FROM FORTRAN PAGE 47 RENAME RENAME- CHANGING A FILE NAME FROM FORTRAN ROUTINE NAME: RENAME PURPOSE: RENAME is a routine used to change a file name by its LUN and close it. The new file name given is specified by the second argument - a byte array containing the new file name. This array must be terminated by a null. The file that is being renam ed must be open before a call to RENAME. RENAME can be called as a subroutine or used as a function if it is declared integer. The value of the function is the FCS error status. CALLABLE: from FORTRAN - CALL RENAME(LUN,NEWFIL) or FCS=RENAME(LUN,NEWFIL) PARAMETERS: LUN------Logical unit number NEWFIL---The new file name - a byte array terminated by a null. FCS-----The fcs error status. ROUTINES USED: $FCHNL EXAMPLE: C C PROGRAM TO EXCHANG THREE INTEGER FIELDS. C CALL ASSIGN(1,'DATA.DAT') CALL ASSIGN(2,'SCRATCH') DO 100 I=1,NLINES READ(1,END=99)IVAL1,IVAL2,IVAL3 100 WRITE(2)IVAL3,IVAL1,IVAL2 CALL CLOSE(1) 99 FCS=RENAME(2,'DATA.DAT') !CREATE NEW VERSION. CALL EXIT END AUTHOR: MIKE HIGGINS WRITTEN: JANUARY 1977 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: RENAME LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Mike Higgins or Linda Mundy BATDEF - BATDEF PAGE 48 BATDEF BATDEF - BATDEF ROUTINE NAME: BATDEF PURPOSE: This module is a block data subroutine containing 3 common blocks each defining a logical unit number for BATCH input, output and joblog. Many of the Cetus library routines use these commons to write scratch data on, or to write error codes. You can change the LUN values in your fortran main- ran main program by declaring the named common s and re-assigning the vales at run time (a data statement will not do). CALLABLE: from FORTRAN - Is linked at task build time as an object module explicitly, i.e., CETUS/LB=BATDEF or by declaring BATDEF EXTERNAL in your FORTRAN source. If one of the MACRO subroutines in Cetus library is used, BADEF is built into your task image automatically, and it is not necessary to specifically ask for BATDEF in your taskbuild command file. PARAMETERS: /SCRAT1/-The named common block containing the 1st scratch LUN used by the Sort Package. Default is 1, changes to 2. /SCRAT2/-The common containing the 2nd scratch LUN used by the Sort Package.Default is 2 (changes to 1). The sort package al- ways uses SCRAT 1 for an open merge file and SCRAT 2 is gu- aranteed to be free inbetween sort routine operations. Several Cetus library routines depend on this and use SCRAT 2 as a scratch LUN. If you are using LUNS 1 and 2, and you are using one of those routines, you must declare SCRAT 1 in your main program and reassign it to an unused LUN at run time. (A data statement will not do). If you are using the Sort Package and you wish to use SCRAT 2 between calls to sort routines, you can, but you must always use the symbolic name. The LUN that is actually free alternates between the two, but the value of the free one is always stored in scrat 2. JOBLOG---The named common block containing the Integer variable for the JOBLOG LUN. Default is 7. BATIN----The common block containing the LUN for BATCH input i.e., you read from this LUN) BATOUT---The named common block containing the LUN for BATCH output (i.e., you write your output here.) ROUTINES USED: none EXAMPLE: COMMON/JOBLOG/JL COMMON/BATIN/CARDS COMMON/BATOUT/PRNTER AUTHOR: Mike Higgins BATDEF - BATDEF PAGE 49 WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: BATDEF LIBRARY: DP:[60,60]CETUS.OLB LAST MODIFICATION: none MAINTENANCE: see John James or Mike Higgins CURSE -SUBROUTINE TO POSITION THE CRT CURSOR PAGE 50 CURSE CURSE - SUBROUTINE TO POSITION THE CRT CURSOR ROUTINE NAME: CURSE PURPOSE: To position the cursor of a VT52 or Teleray to column X and row Y of the screen and optionally print a string. 1<=Y<=24. If string is missing the cursor is positioned but nothing is printed. If LEN is missing, MAXLEN or the first nul (whichever comes first) are assumed. COORDINATES OF THE SCREEN (1,1)----- UPPER LEFT HAND CORNER. (80,1)---- UPPER RIGHT HAND CORNER. (80,24)--- LOWER RIGHT HAND CORNER. (1,24)---- LOWER LEFT HAND CORNER. CALLABLE: from FORTRAN CALL CURSE (X,Y[,STRING[,LEN]]) PARAMETERS: X--------the X coordinate on the screen 1-80. Y--------The Y coordinate on the screen 1-24. STRING---The string of characters to print at X,Y. LEN------The length of the string if not terminated by a null. If len is omitted MAXLEN characters are printed (see SETMAX). ROUTINES USED: QIO - write all bits AUTHOR: Mike Higgins WRITTEN: July 1978 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: CURSE LIBRARY: DP:[60,60]MIKES LAST MODIFICATION: none MAINTENANCE: see Mike Higgins FREZLP - DISSABLING LINE PRINTER DEMON PAGE 51 FREZLP FREZLP - DISSABLING LINE PRINTER DEMON ROUTINE NAME: FREZLP PURPOSE: By calling FREZLP, a global event flag is set which LPDEMON recognizes as a command to suspend itself at the end of the current printout, and not print the next job in the output queue. This event flag is checked by LPDEMON before each job is printed. CALLABLE: from FORTRAN call FREZLP() PARAMETERS: none ROUTINES USED: the Executive Routine SETEF EXAMPLE: open FEATURES: none AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: FREEZLP LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Mike Higgins or Jack Martinelli RULES - TO DISPLAY FILE CONTENTS 23 LINES/SCREEN. PAGE 52 RULES RULES - TO DISPLAY FILE CONTENTS 23 LINES/SCREEN. ROUTINE NAME: RULES PURPOSE: Prompts the terminal with the question: DO YOU NEED IN- STRUCTIONS?. Any answer that does not start with the letter 'y' causes RULES to return immediately, otherwise RULES fills the screen with the next 23 records of a card image file followed by the prompt.: HIT RETURN FOR MORE RULES A control-Z at this time will cause rules to close the rules file and return without printing more rules. There is some syntax that can control the output to the screen. A hat (^) in col 1 of the display file will cause rules to quit before 23 lines and prompt again. A semicolon in col 1 causes that line to be ignored. CALLABLE: from FORTRAN--CALL RULES(FILENAME) PARAMETERS: FILENAME-The filename specifier--Standard Files-11 format may be an array or a quoted string. FEATURES: Uses named common /CONSOLE/ as the TI: - terminal LUN. Uses the labeled common SCRAT2 to open the rules file. See BATDEF for a description of all the special LUNS in named commons. AUTHOR: Mike Higgins WRITTEN: July 1978 SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: RULES LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Mike Higgins or Jack Martinelli SWAPB - (WORD) PAGE 53 SWAPB SWAPB - (WORD) ROUTINE NAME: SWAPB PURPOSE: This subroutine is an integer function to return WORD with the bytes reversed . WORD itself is not modified unless you call thusly: WORD=SWAPB(WORD). SWAPB also clears the pari- ty bits (bit 7) in each byte. CALLABLE:from FORTRAN - CALL SWAPB(WORD) PARAMETERS: WORD --- Word contains the two bytes that will be swapped ROUTINES USED: none EXAMPLE: WORD=SWAPB(AWORD) AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: SWAPB LIBRARY: DP:[60,60]MIKES LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins UPRINT- UNFORMATED TERMINAL PRINTING ROUTINE PAGE 54 UPRINT UPRINT- UNFORMATED TERMINAL PRINTING ROUTINE ROUTINE NAME: UPRINT PURPOSE: UPRINT is a one argument subroutine which accepts an array of bytes and simply prints the array on the LUN specified by the COMMON/CONSOL/TTY in ASCII format. CALLABLE: from FORTRAN -- CALL UPRINT(BUF) PARAMETERS: BUF------an array of bytes to be printed on the user's terminal. This array cannot exceed 80 bytes and must be terminated by a null or filled with trailing blanks. ROUTINES USED: LEN and BADEF LUN definitions. FEATURES:The COMMON/CONSOL/TTY can be changed to any LUN if 5 (the de- fault) is in use AUTHOR: Jack Martinelli CETUS CORPORATION WRITTEN: JUNE 1978 SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: UPRINT LIBRARY: DP:[60,60]CETUS MAINTENANCE: See Jack Martinelli or Linda Mundy WAL - WAL (STRING,LEN) PAGE 55 WAL WAL - WAL (STRING,LEN) ROUTINE NAME: WAL PURPOSE: WRT performs a QI0 with function IO.WAL (write all bits) from FORTRAN. Characters written in this manner can be tabs, formfeeds, etc., and will not be checked or deleted by the TELETYPE driver. Also these characters are not counted towards the automatic carriage return at the end of a line. The LEN arg is mandatory. Output goes to the LUN specified by the named common Consol, (see BATDEF). CALLABLE: from FORTRAN. CALL WRT(STRING,LEN) PARAMETERS: STRING--A string of any ASCII characters. LEN------Number of bytes in string. ROUTINES USED: BATDEF AUTHOR: Mike Higgins WRITTEN: July 1978 GETSRT. SOURCE LANGUAGE: MACRO-11 EXAMPLE: OBJECT MODULE NAME: WAL (STRING,LEN) LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Mike Higgins DSKSRT - FORCING A DISK IMAGE OF SORT BUFFER/SCRATCH-FILE PAGE 56 DSKSRT DSKSRT - FORCING A DISK IMAGE OF SORT BUFFER/SCRATCH-FILE ROUTINE NAME: DSKSRT PURPOSE: The disk sort routine will take all of the previously sorted records (see SETSRT,PUTSRT) and put them into a file. This file can be read from the LUN returned by DSKSRT. It is your responsibility to close, rename or delete this LUN when you are done, so that the sort package can reuse it on any following sort operations. If you must keep the LUN open, and you need to do another sort, you can change the /SCRAT 1/ /SCRAT 2/ values or use different LUNS in the SETSQT call. CALLABLE: from FORTRAN CALL DSKSRT(SRTBUF,LUN,ERR) OR ERR=DSKSRT(SRTBUF,LUN,ERR) PARAMETERS: SRTBUF---A sort buffer and scratch area for internal parameters used by the sort package. LUN------AN integer variable in which the logical unit number of the sorted file is returned. This file is an unformated binary file, with record size equal to the RECSIZ argument to SETSRT. ERR------A zero if successful, -1 if failure. ROUTINES USED: SMERGE, KSORT EXAMPLE: CALL DSKSRT (BUF,L) 10 READ (2,END=20) REC WRITE (CONSOL,200) REC GO TO 10 20 (ALL) DELETE (L) FEATURES: none AUTHOR: Mike Higgins WRITTEN: August 1977 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: DSKSRT LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: May 1978 MAINTENANCE: see Mike Higgins DSKSRT - FORCING A DISK IMAGE OF SORT BUFFER/SCRATCH-FILE PAGE 57 KSORT - KEY SORTING ROUTINE ROUTINE NAME: KSORT PURPOSE: KSORT is designed to move the minimum amount of information in a sort exchange. That is rather than moving 80 BYTE re- cords around in memory only pointers to those records are moved. To set up for a call to KSORT the KEY array needs to be ini- tialized. Normally the elements in the KEY array ascend 1,2,3...n where each integer represents a pointer to a re- cord and n is the total number of records and KEY elements. The following is an example of initializing the KEY array: DO 10 I=1,50 10 KEY(I)=I If you are sorting fixed length records and you cannot fit all records in memory, you should use SETSRT, PUTSRT and GETSRT instead of this routine. Even for small sorts, those routines are easier to use than KSORT and they eventually will call KSORT for you. CALLABLE: From FORTRAN CALL KSORT(INP,NI,ISIZE,KEY,ICMP) PARAMETERS: INP------A non-vectored array to contain the records to be sorted. NI-------The number of elements in the KEY array and the number of records to be sorted. ISIZE----The record length in WORDS KEY------The pointer array (INTEGER*2) ICMP-----The address of the user defined compare routine. The com- pare routine must be an integer function - for example: C C COMPARE ROUTINE FOR DESCENDING SORT C INTEGER FUNCTION COMPAR(REC1,REC2) BYTE REC1(1),REC2(1) COMMON /LENGTH/ NBYTES DO 10 I=1,NBYTES IF (REC1(I)-REC2(I)) 20,10,30 10 CONTINUE COMPAR=0 RETURN 20 COMPAR=1 RETURN 30 COMPAR=-1 RETURN END KSORT - KEY SORTING ROUTINE PAGE 58 Note that this function must be declared EXTERNAL by the routine calling KSORT ROUTINES USED: ICMP-- the user defined record compare routine. EXAMPLE: PROGRAM EXAMPLE C---------------SORT A BUNCH OF RECORDS EXTERNAL COMPAR BYTE RECORD(80,50) INTEGER*2 KEY(50) COMMON /LENGTH/ NBYTES NBYTES=80 CALL ASSIGN(1,'INFILE') !FOR READ ONLY READ(1,10)((FECORD(I,J),I=1,80),J=1,50) 10 FORMAT(80A1) D0 15 I=1,50 15 KEY(I)=I CALL KSORT(RECORD,50,40,KEY,COMPAR) !ISIZE IN WORDS. CALL CLOSE(1) CALL ASSIGN(1,'INFILE') !FOR WRITING. WRITE(1,10)((RECORD(I,KEY(J)),I=1,80),J=1,50) CALL EXIT END FEATURES: Can be used to sort variable length records by initializing the key array in a stratigic method and writing the compare routine so it can extract from a record the length. AUTHOR: originally writen by KNUTH WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: KSORT LIBRARY: DP:[60,60]MIKES MAINTENANCE: see Jack Martinelli or Mike Higgins PUTSRT- PUTSRT PAGE 59 PUTSRT PUTSRT- PUTSRT ROUTINE NAME: PUTSRT PURPOSE: To add to the sort buffer a new record. To retrieve the re- cords in sorted order -- see GETSRT. CALLABLE: from FORTRAN--CALL PUTSRT(SRTBUF,RECORD[,ERR]) or ERR=PUTSRT(SRTBUF,RECORD) PARAMETERS: SRTBUF---A buffer to contain elements to be sorted. This buffer must be initalized by SETSRT before the 1st call to PUTSORT or an error will occur. RECORD-- The buffer which contains the information to be sorted. This can be of any variable type so long as the compare rou- tine (see SETSRT) knows what to expect. The size of RECORD is determined by the RECSIZ argument to SETSRT. ERR------The completion status of the operation 0 - operation suc- cessful -1 - operation failed. ROUTINES USED: SMERGE, KSORT EXAMPLE: C C Read a record from names file for sorting C 10 READ(NAMES,15)L,LSTNAM 15 FORMAT(Q,4A1) CALL PUTSRT(SRTBUF,LSTNAM) AUTHOR: Mike Higgins WRITTEN: august 77 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: PUTSRT LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: see Mike Higgins MAINTENANCE: see Mike Higgins SETSRT- SETSRT PAGE 60 SETSRT SETSRT- SETSRT ROUTINE NAME: SETSRT PURPOSE: To initialize the parameters of the sort package. CALLABLE: from FORTRAN CALL SETSRT(SRTBUF,SIZBUF,RECSIZ,COMPL1,L2) PARAMETERS: SRTBUF--A buffer to contain elements to be sorted. SIZBUF-- The size of the sort buffer in WORDS. This array should be at least 1K words, we usually start with 4K. Since some parts of the array are allocated for pointers and counters, the absolute minimum size is no words. RECSIZ-- The maximum record size expected. COMP---- The name of a compare function. This function must be writ- ten with two arguments which will be compared. The returned value of the function must return a positive, 0 or negative result depending on whether an ascending or descending sort is preferred (see KSORT example). LUN1---- A logical unit number to be used as scratch file LUN for sort-merge operation. Default is /SCRAT 1/ LUN2-----A 2nd scratch LUN. These two LUN'S are shuffled back and forth during the sort-merge. Default is /SCRAT 2/. AUTHOR: Mike Higgins WRITTEN: August 1978 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: SETSRT LIBRARY: DP:[60,60]MIKES LAST MODIFICATION: long ago MAINTENANCE: see Mike Higgins SMERGE- SORT-MERGE PACKAGE PAGE 61 SMERGE SMERGE- SORT-MERGE PROGRAM ROUTINE NAME: SMERGE PURPOSE: SMERGE is an old routine that is harder to use than SETSRT, PUTSRT and GETSRT. You should use those routines because they eventually set up the correct parameters and call SMERGE for you anyway. Also, the new routines will use KSORT and bypass the disk I/O if the entire sort will fit in memory. SMERGE will take an un-sorted array - sort it and write it out to a file. If this file already contains previously sorted records, then this file will be read from and merge with the in core array into a second file. SMERGE can only sort data with elements of 132 bytes or smaller. SMERGE uses symbolic LUN'S SCRAT1 and SCRAT2 for all sort- ing. If this is not acceptable, you can define the follow- ing commons in your main program and set them to other va- lues. Note that SMERGE always keeps one of the LUNS open, and juggles the values in common so that the unused one is always in SCRAT2. You may use this LUN between SMERGE calls only if you use it by its symbolic name and make sure it is closed before the next call to SMERGE. NOTE If you get an illegal LUN error in SMERGE, it may be necessary to CALL BATDEF() in your calling program. BATDEF is a 'BLOCK DATA SUPROGRAM' of sorts and the call to it is only to assure that it is taskbuilt into your program so that it can define the values of your LUN'S. If you call a DATABASE routine, for example, BATDEF will automatically be included with- out special calls. CALLABLE: From FORTRAN - CALL SMERGE(NFILES,INP,NI,ISIZE,ICMP) PARAMETERS: NFILES---You must set this variable to zero the first time that you call SMERGE so it can set up for successive merges. The LUN of the last written output file is always returned in this parameter. The file is returned rewound and open ready to be read. To keep your disk clean, and to free up the LUN for the next smerge, you should call DELETE with this LUN as soon as you are done reading the sorted file. INP------The name of the array that contains the next core resident block of elements to be sorted. SMERGE- SORT-MERGE PACKAGE PAGE 62 NI-------The size of a single element in the INP array in words! ISIZE----The number of elements in the INP array. These two parame- ters are effectively the dimensions of the inp array, thusly: inp(ni,isize). KEY------The name of an integer array for SMERGE to store the sort keys in. On returning from SMERGE, this array will contain no information useful to you. Make sure that key is dimen- sioned to at least ISIZE words. ICMP-----The name of an integer function (declared external in your calling program) that does the comparing (see KSORT). ROUTINES USED: Your compare routine and KSORT AUTHOR: Mike Higgins WRITTEN: Long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: SMERGE LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: August 78 MAINTENANCE: see Mike Higgins or Linda Mundy CHANGE- SUBROUTINE TO MODIFY A STRING PAGE 63 CHANGE CHANGE- SUBROUTINE TO MODIFY A STRING ROUTINE NAME: CHANGE PURPOSE: CHANGE searches a string up to MAXLEN characters long (see SETMAX subroutine) for a substring. If the substring is found it is replaced with the given replacement string. Change will also return a pointer to the first character of the new substring and the new length of the whole string. All string arguments must be terminated by a null. CALLABLE: from FORTRAN -- CALL CHANGE(STRING,FROMST,TOST,LENGTH,PNTR) or PNTR=CHANGE(STRING,FROMST,TOST,LENGTH,X) (5th argument must be in- cluded.) PARAMETERS: STRING --The string containing characters to be changed. Must be terminated by a null. LENGTH --The new length of STRING after call to CHANGE. An integer variable. FROMST --The string of characters to search for in STRING. Must be terminated by a null. TOST --- The string to replace FROMST in STRING. Must be terminated by a null. PNTR ----The pointer to the first character of the replacement string within the new modified string. If FROMST was not found PNTR is returned as zero. ROUTINES USED: POS,CONCAT,SETMAX AUTHOR: Jack Martinelli WRITTEN: June 1978 SOURCE LANGUAGE: FLECS OBJECT MODULE NAME: CHANGE LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli CMPS - COMPARE STRING FUNCTION PAGE 64 CMPS CMPS - COMPARE STRING FUNCTION ROUTINE NAME: CMPS PURPOSE: CMPS compares two byte strings and returns a verdict of gre- ater, equals of, less than zero. The strings are scanned from left to right until a pair is found which are not equal. If the ASCII values of the two bytes is less, then the result of the function is less, etc. If none of the characters differ, the result is equal. The special character '\' (backslash - not the division op- erator) is a "wild card" match character. If this character occurs in either of the strings, it always matches any char- acter in the other string. The two strings are terminated by: 1) A null byte. 2) The LEN'TH byte if the len argument is present and a null is not encountered first. 3) The MAXLEN'TH byte if the len argument is missing. (see the setmax subroutine for the default value of maxlen and how to change it). 4) Trailing spaces. This is only significant if one of the strings is terminated by a null. If the other string was equal up to that point, and all the rest of its characters are spaces, the strings are consi- dered to be equal. CMPS - COMPARE STRING FUNCTION PAGE 65 CALLABLE: from FORTRAN- verdict=CMPS(STRNG1,STRNG2[,LEN]) PARAMETERS: STRING 1-- the first string STRING 2-- the second string LEN------THE MAXIMUM LENGTH TO SCAN THE TWO STRINGS. MACRO-11 convention R0 must point to the first character of the first string. R1 must point to the second string. R2 must contain the maximum length to scan the two strings. CALL WITH JSR PC,$CMPS R0 returns the verdict. R1 points somewhere in the second string or past it. R2 contains some number less than or equal the value before the call. All other registers are unchanged. EXAMPLE: C GET THE LENGTH OF THIS STRING AND TAG ON A NULL C LSUB0=LEN(INPBUF) !IGNORE THE TRAILING SPACES INPBUF(LSUB0)=0 !TAG ON A NULL. IF(CMPS(INBUF,BUF,80)) 100,120,180 . . . AUTHOR: MIKE HIGGINS SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: CMPS LIBRARY: DP0:[60,60]CETUS LAST MODIFICATION: 21-MAR-78 MAINTENANCE: not formally maintained. COMMA - TO INSERT COMMAS INTO REAL NUMBER PAGE 66 COMMA COMMA - TO INSERT COMMAS INTO REAL NUMBER ROUTINE NAME: COMMA PURPOSE: COMMA takes a single or double precision floating point number and returns an ASCII string (right justified with leading blanks) representation of the F.P. number with a comma every 3rd digit. The number is rounded and returned as a whole number. CALLABLE:from FORTRAN--CALL COMMA (FLOTR,STR,LEN) PARAMETERS: FLOATR---The real number to encode into ASCII. STR------The BYTE array that will accept the ASCII string. Should be dimensioned to at least LEN BYTES. LEN------The length of the array recieving the string of numerals. LEN should be somewhat genereous to take into account the insertion of commas into STR. ROUTINES USED: INPL EXAMPLE: open FEATURES: none AUTHOR: Jack Martinelli WRITTEN: September 1978 SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: COMMA LIBRARY: DP:[60.60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli or Mike Higgins CONCAT - CONCAT PAGE 67 CONCAT CONCAT - CONCAT ROUTINE NAME: CONCAT PURPOSE: To concatenate a series of byte strings into a single array. Each of the smaller strings must be terminated by a null. CALLABLE:from FORTRAN -- call CONCAT(BIG,STR1,STR2...STRN) or LEN=CONCAT(BIG,STR1,STR2...STRN) PARAMETERS: BIG -----The array to recieve the concatenated strings. STR1-----ONE of the series of strings to be concatenated into BIG. Must be terminated by NULL. STR2-----SAME as STR1. Any number of strings may be concatenated per call. STRN-----THE last string to be tacked on to BIG. ROUTINES USED: none EXAMPLE: BYTE STR1(4),STR2(4), BIG(10) DATA STR1/'A', 'B', 'C', 0/!NOTE THE NULLS DATA STR2/'D', 'E', 'F', 0/ L=CONCAT(BIG,STR1,STR2) Write (5,10)(big(i),i=1,l) 10 FORMAT (1x,80A1) CALL EXIT End the result: ABCDEF FEATURES: none AUTHOR: Jack Martinelli WRITTEN: June 1978 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: CONCAT LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli CONV CONV - (NUMBER,STRING,LENGTH[,RADIX][,FILL][,ERR]) PAGE 68 CONV - (NUMBER,STRING,LENGTH[,RADIX][,FILL][,ERR]) ROUTINE NAME: CONV - (NUMBER,STRING,LENGTH[,RADIX][,FILL][,ERR]) PURPOSE: Encodes a positive binary integer or magnatude into a string using any radix 2 through 10. CONV will left-fill with any character you send in the FIL argument (default is space). Default radix is base 10. Returns 0 for failure if the number would not fit in LENGTH bytes. CALLABLE: from FORTRAN - CALL(NUMBER,STRING,LENGTH[,RADIX][,FILL][,ERR]) PARAMETERS: NUMBER - A number to be encoded STRING - The address of a place to put the resulting string LENGTH - The length of the string in bytes RADIX ---The radix to use on conversion. Range is 2-10, default is 10 FILL-----The fill character to use on the string. Default is space ERR----- Returns .true. (-1) for success, .false. (0) for failure. An error will only happen if the number does not fit in 'LENGTH' Characters. On an error return, CONV returns only the lower 'LENGTH' characters of the result. CONV can be called as a Function, and will return 'ERR' as its value. ROUTINES USED: none CONV - (NUMBER,STRING,LENGTH[,RADIX][,FILL][,ERR]) PAGE 69 AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: CONV LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins FINP - ASCII TO REAL NUMBER CONVERSION ROUTINE PAGE 70 FINP FINP - ASCII TO REAL NUMBER CONVERSION ROUTINE ROUTINE NAME: FINP PURPOSE: To convert a string of ASCII characters into a floating point real number. CALLABLE: From FORTRAN - REAL=FINP(ARRAY,INDEX,MAXL) PARAMETERS: ARRAY----Logical*1 array that contains the string to be converted. Numbers can be in almost any form, from "12 " (converts to 12.0, note left justification, can be right also) to "-12.34E-3" (converts to 0.01234) or just about anywhere in between. Decimals are only necessary where they make sense. INDEX----An integer index into ARRAY. This should point to the first character that is expected to be converted. Upon return, INDEX will be updated to point to the last character pro- cessed. If the number in the logical*1 array was left jus- tified, INDEX will point to the first space after the number. If the number was right justified in the array, INDEX will point to a character after the last one, even if this might cause INDEX to go out of bounds in your main pro- gram. If the number in the LOGICAL*1 array was terminated by a comma, INDEX will be returned, pointing to that comma. If there was an illegal character (and Cetus has a lot of strange characters, you must admit) in the string, INDEX will be returned pointing to the offending character. MAXL-----This integer variable of value tells FINP the maximum number of characters to scan when converting a number. This param- eter is absolutely necessary. When you are reading right justified or fixed format data with FINP, but when you are reading numbers that are terminated by spaces or a comma, you can just stick any number large enough in MAXL to guar- antee that the delimiting character is found. EXAMPLE: L1=LEN(STR2,32) !SEE THE WRITE-UP FOR THE LEN ROUTINE. L2=LEN(STR1,32) X=1 Y=1 RESULT=FINP(STR1,X,L1)-FINP(STR2,Y,L2) AUTHOR: Mike Higgins WRITTEN: long long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: FINP FINP - ASCII TO REAL NUMBER CONVERSION ROUTINE PAGE 71 LIBRARY: DP:[60,60]CETUS FULDAT - DAY OF WEEK AND DATE PAGE 72 FULDAT FULDAT - DAY OF WEEK AND DATE ROUTINE NAME: FULDAT PURPOSE: FULDAT is an INTEGER function which will return as its func- tion value the numerical equivalent of the day of the week, i.e., a value of 1 for Sunday - a value of 7 for Saturday. FULDAT also returns the day of the week with the current date as an ASCII array. e.g. SAT 02-DEC-78 CALLABLE: from FORTRAN CALL FULDAT(DAY) or ITODAY=FULDAT(DAY) PARAMETERS: ARRAY----A BYTE array dimensioned to at least 13 BYTES. Will contain the date after the call to FULDAT. ITODAY---The integer equivalent of the day of the week. 1-7 for SUN-SAT. ROUTINES USED: The FORTRAN LIBRARY subroutines - IDATE, IABS, MOD, DATE EXAMPLE: PROGRAM PURGE C C IF TODAY IS FRIDAY AND IT IS C AFTER 11:00 PM PURGE THE C ENTIRE DISK C INTEGER FULDAT BYTE DAY (14) DATA MCR/1/ X = SECONDS (0.0) IF (FULDAT(DAY).NE.6) CALL EXIT IF (X.LT.39600.) CALL EXIT CALL ASNLUN (1,'MC',0) WRITE (MCR,10) 10 FORMAT('PIP DP:[*,*]*.*/PU') CALL EXIT END FEATURES: none AUTHOR: Jack Martinelli of CETUS Corp. WRITTEN: July 1978 SOURCE LANGUAGE: open OBJECT MODULE NAME: FULDAT LIBRARY: DP:[60,60]CETUS FULDAT - DAY OF WEEK AND DATE PAGE 73 LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli INPH INPH - HEXADECIMAL TO BINARY CONVERSION ROUTINE ROUTINE NAME: INPH PURPOSE: INPH accepts a string of ASCII hexadecimal numerals(0-8 and A-F) and converts them to an integer or binary magnitude. CALLABLE: From FORTRAN - RESULT=INPH(BUF,MAX) PARAMETERS: BUF------The byte array containing the hex string. Leading blanks are ignored. A trailing blank, comma or period mark the end of the string. MAX------The maximum expected length of the string. INPH will quit when it finds the MAX'th+1 byte or an illegal hex digit. ROUTINES USED: The FORTRAN library function ISHFT AUTHOR: Mike Higgins, CETUS CORPORATION WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: INPH LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli or Mike Higgins INPI - INPI(STRING[,ERR][,LEN][,I]) PAGE 74 INPI INPI - INPI(STRING[,ERR][,LEN][,I]) ROUTINE NAME: INPI PURPOSE: Decodes a signed integer from the string. CALLABLE: from FORTRAN - call (STRING[,ERR][,LEN][,I]) PARAMETERS: STRING---The string that is to be converted from decimal numbers to binary. LEN------The max length of the string. If this parameter is missing the string is assumed to be terminated by a zero byte. ERR------A 0 (.false.) is returned in this parameter if there is a conversion error in the string. I--------Alternate return for the result if INPI is called as a su- broutine instead of a function. ROUTINES USED: none EXAMPLE: open FEATURES: none AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: MACRO 11 OBJECT MODULE NAME: INPI LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins INPL - LEFT JUSTIFICATION OF A STRING PAGE 75 INPL INPL - LEFT JUSTIFICATION OF A STRING ROUTINE NAME: INPL PURPOSE: This integer function is used to chop successive tokens out of an input command line. Characters are transferred from BYTE array argument and left justified into an output array (discarding the last character - the terminator) INPL returns as its function value the FORTRAN integer index that points to the terminating character in the input array. CALLABLE: From FORTRAN only PARAMETERS: INBUF----An array of contiguous bytes to be left justified. LEN------The maximum length to justify (default is 80) OUTBUF---The output array. Must be at least LEN bytes long. TERM-----String of termination character bytes. Last element must be a null. Justification terminates upon the oc- curance of one of these characters in the input string. Default is a null byte. AND------A 0 or a 1. A flag to indicate that inclusion of the string in term is to be used for termination of justif- ication and include the termination string. AND=0 to to include termination string. Default is AND=1. EXAMPLE: C C SAMPLE PROGRAM TO CHOP A C SENTENCE UP INTO WORDS BYTE BUF(80), TEXT(8), TERM(4) DATA TERM/'',',',"10,0/ 10 READ(5,100)BUF 100 FORMAT(D80A1) 20 N=1 N=N+INPL(BUF, 8, TEXT,TERM) IF (TEXT(1).EX.TERM(1)) GO TO 10 WRITE (5,100) TEXT GO TO 20 END AUTHOR: JACK MARTINELLI WRITTEN: JUNE 1978 SOURCE LANGUAGE: MACRO-11 INPL - LEFT JUSTIFICATION OF A STRING PAGE 76 OBJECT MODULE NAME: INPL LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: MAY 1978 MAINTENANCE: see JACK MARTINELLI INPH - OCTAL TO BINARY CONVERSION ROUTINE PAGE 77 INPH INPH - OCTAL TO BINARY CONVERSION ROUTINE ROUTINE NAME: INPH PURPOSE: INPH accepts a string of ASCII octal numerals (ASCII values ranging from '0'-'8') and converts them to an integer value. CALLABLE: From FORTRAN - RESULT=INPH(BUF,MAX) PARAMETERS: BUF------The byte array containing the octal string. Leading blanks are ignored. A trailing blank, comma or period mark the end of the string. MAX------The maximum expected length of the string. INPH will quit when it finds the MAX'th+1 byte or an illegal octal digit. ROUTINES USED: The FORTRAN library function ISHFT AUTHOR: Mike Higgins, CETUS CORPORATION WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: INPH LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli or Mike Higgins LEN - FINDING THE LENGTH OF A STRING. PAGE 78 LEN LEN - FINDING THE LENGTH OF A ST RING. ROUTINE NAME: LEN PURPOSE: The routine LEN finds the length of a string. The length is defined as the number of characters before the first null, the first trailing space, or the MAX'TH character. LEN searches the first MAX characters looking for the end, but if the MAX prameter is missing, LEN searches the first MAX- LEN characters. MAXLEN defaults to 32, and can be changed by the SETMAX subroutine. LEN can be called as a function, or a subroutine if you include the L argument. CALLABLE: from FORTRAN - CALL LEN(STRING [,MAX] [,L] ) or L=LEN(STRING [MAX]) PARAMETERS: STRING= The string of bytes to be counted. MAX= The maximum number of bytes to scan in this string. This ar- gument defaults to MAXLEN if it is present. Maxlen de- faults to 32(base 10) bytes but this can be changed by calling the SETMAX routine. L= the returned length of the string. EXAMPLE: C find the length of the file name for the call to ASSIGN C LENGTH=LEN(NEWFIL) !FIND 1ST TRAILING BLANK NEWFIL(LENGTH +1)=0 !TAG ON A NULL FOR ASSIGN CALL ASSIGN(HISLUN,NEWFIL) !ATTACH A LUN. AUTHOR: MIKE HIGGINS WRITTEN: some time ago SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: LEN LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: FEBUARY 1978 MAINTENANCE: see Mike Higgins MATCH - MATCH PAGE 79 MATCH MATCH - MATCH ROUTINE NAME: MATCH PURPOSE: MATCH is a pattern recognition subroutine which will return a 1 if the given string matches the pattern, a "0" if the match fails. CALLABLE: from FORTRAN call MATCH (PATTERN,STRING[,LENGTH][,ERR]) PARAMETERS: PATTERN--Is the string that contains the pattern to be compared aga- inst. This string must be terminated by a null or space filled. Another restriction on this parameter is its length. The length must be less than or equal to the LENGTH parameter in BYTES, or less than or equal to MAXLEN (see SETMAX). PATTERN ELEMENTS-- The back slash substitutes for one character. The character matched may be anything but a null. *--------An asterick substitutes for an entire string or sub-string. e.g., "*cat" will match "THE BLACK CAT". as will "THE*". [AEIOU]--This pattern will allow only a vowel at a specified string position, i.e., any one of the characters enclosed in brack- ets is acceptable at a given string position, e.g., "TH[AEIOU]*" will match "THE BLACK CAT". -........The minus sign preceeding a character means NOT this char- acter, i.e., anything but this character at this position, e.g.: -A* means to match any string that does not start with "A". STRING---Is the string that contains the characters to be matched to. This string must be terminated similar to the PATTERN param- eter. NOTE Both of the above strings are modified to contain a null terminator. If they did not have one already. You must make sure that they dimensioned to enough bytes to contain that extra null. LENGTH---The maximum length of STRING or PATTERN. This parameter defaults to MAXLEN (see SETMAX) if omit- ed. ERR------The error return value: ERR=0 if pattern did not match ERR=1 if pattern did match string. ROUTINES USED: $MATCH, LEN MATCH - MATCH PAGE 80 AUTHOR: Mike Higgins WRITTEN: March 1978 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: MATCH LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Mike Higgins NXTKEY - KEY SEQUENCE RETRIEVAL ROUTINE PAGE 81 NXTKEY NXTKEY - KEY SEQUENCE RETRIEVAL ROUTINE ROUTINE NAME: NXTKEY PURPOSE: NXTKEY is used after defining the necessary parameters in the TABLE argument to retrieve an element of a key sequence. A key might look like: SEPT-78 BOILER BLDG-A. which would be an element of the KEY SEQUENCE: SEPT-78 BOILER BLDG-A>BLDG-M Each call to NXTKEY will retrieve the logical successor of the previous KEY. CALLABLE: From FORTRAN -- CALL NXTKEY(SCRATCH,KEY [,ERR]) or ERR=NXTKEY(SCRATCH,KEY [,ERR]) PARAMETERS: SCRATCH--Buffer space initialized by SETKEY (see SETKEY) KEY------String to receive the next key. ERR------The number of sequences that started over this call. When ERR=NFLDS (see SETKEY) the key sequence is done. ROUTINES USED: NXTSEQ EXAMPLE: C C GET THE NEXT SEQUENCE CHECK THE C DATABASE FOR EXISTENCE. C IF (NXTKEY(SCRAT,KEY).EQ.NFLDS) GO TO 99 IF (FNDKEY(ROOT,KEY,ERR).EQ.0) GO TO 200 IF (ERR.EQ.-1) GO TO 300 C C---- FOUND IT! C AUTHOR: Mike Higgins CETUS Corp. WRITTEN: June 1977 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: NXTKEY LIBRARY: DP:[60,60]CETUS NXTKEY - KEY SEQUENCE RETRIEVAL ROUTINE PAGE 82 LAST MODIFICATION: none MAINTENANCE: see Mike Higgins or Jack Martinelli NXTSEQ - SEQUENCE RETRIEVAL ROUTINE PAGE 83 NXTSEQ NXTSEQ - SEQUENCE RETRIEVAL ROUTINE ROUTINE NAME: NXTSEQ PURPOSE: NXTSEQ will return the Token String that is the logical successor of the last Token retrieved. The first call to NXTSEQ will return the beginning Token. The last call returns the terminating sequence. (See the SETSEQ documentation) CALLABLE: from FORTRAN--- CALL NXTSEQ(TABLE,STRING,ERR) PARAMETERS: . TABLE----The same table initialized by SETSEQ. STRING---A byte array in which the next logical token from the sequence will be stored. STRING must be WIDTH bytes long. See SETSEQ parameters. ERR------ERR=1 sequence has finished ERR=0 error in sequence ERR=-1 successful return. AUTHOR: Mike Higgins of CETUS Corp. WRITTEN: June 1977 SOURCE LANGUAGE:SUPERMAC OBJECT MODULE NAME: NXTSEQ LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli or Mike Higgins POS - POS PAGE 84 POS POS - POS ROUTINE NAME: POS PURPOSE: To find a substring within a string of bytes. The STRING parameter is searched up to MAXLEN bytes. CALLABLE: from FORTRAN (see SETMAX) PARAMETERS: STRING---The string to be searched for SUBSTR. STRING must be termi- nated by a null. SUBSTR---The substring to hunt for in STRING. SUBSTR must be termi- nated by a null. POINTR---The FORTRAN index to the first byte of occurance of SUBSTR in STRING. If SUBSTR is not found after MAXLEN bytes a zero is returned for POINTR. ROUTINES USED: none EXAMPLE: Its obvious. FEATURES: none AUTHOR: Jack Martinelli WRITTEN: June 1978 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: POS LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: see Jack Martinelli PRED - THE INVERSE OF THE SUCCESSOR FUNCTION. PAGE 85 PRED PRED - THE INVERSE OF THE SUCCESSOR FUNCTION0. ROUTINE NAME: PRED PURPOSE: The inverse of the successor function. CALLABLE: from FORTRAN PARAMETERS: STRING -- Byte array modified in place to logical prede- cessor ROUTINES USED: none AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: PRED LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins RTJUST- RIGHT JUSTIFING A STRING PAGE 86 RTJUST RTJUST- RIGHT JUSTIFING A STRING ROUTINE NAME: RTJUST PURPOSE: Right justifies a string in place. CALLABLE: From FORTRAN --CALL RTJUST(BUF,LEN) PARAMETERS: BUF --- string to right justified LEN --- string length ROUTINES USED: none EXAMPLE: CALL RTJUST(BUFER,10) AUTHOR: Roy Merrill WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME:RTJUST LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins SETDEF - SETTING DEFAULT KEY SEQUENCES PAGE 87 SETDEF SETDEF - SETTING DEFAULT KEY SEQUENCES ROUTINE NAME: SETDEF PURPOSE: For any key the defualt for a field is '\\\\\\\'. This can be changed by specifying the field number (must be less than or equal to 10) and the new sequence. CALLABLE: from FORTRAN--CALL SETDEF(MAX,NO,STR) PARAMETERS: MAX------The maximum number of sequences to look at must be less than or equal to 10. NO-------The number of the field you wish to change. STR------Pointer to the string to be the default sequence. This string must be terminated by a null, and cannot be modified unless you change the default or stop using SETSEQ. If there is no STR parameter the NO'th sequence is reset to '\\\\\\\'. If there is not a NO parameter all of the MAX'th sequences are reset to '\\\\\\\' ROUTINES USED: SETSEQ EXAMPLE: C C CHANGE THE 8TH FIELD'S DEFAULT TO 1>99999 C CALL SETDEF(8,8,'1>99999') FEATURES: none AUTHOR: Mike Higgins WRITTEN: July 1977 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: SETDEF LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: See Mike Higgins or Jack Martinelli SETKEY - FIELD SEQUENCE DEFINITION ROUTINE PAGE 88 SETKEY SETKEY - FIELD SEQUENCE DEFINITION ROUTINE ROUTINE NAME: SETKEY PURPOSE: SETKEY is equivalent to running a series of sequence defini- tions all in parallel. In a key definition (a string sent to SETKEY) the different sequence definitions are separated by tabs or spaces. This means that the sequences in a key definition may not contain spaces of tabs themselves. Another restriction is the width of all sequences in a key are always 8 bytes. CALLABLE: from FORTRAN-- Call SETKEY(SCRATCH,KEY,MAX,ERR) PARAMETERS: SCRATCH--A buffer that the key sequence routines use to store their individual tables in. This buffer must be dimensioned to at least NFLDS*64+2 BYTES. KEY------A STRING containing the key sequence as per e.g., SETSEQ. A key sequence is defined as being a group of up to NFLDS or- dinary sequences separated by spaces or tabs. Multiple tabs will skip sequences and 8 spaces are equivalent to a tab. Since both spaces and tabs are separators you should never put a space next to a tab or extra sequences sill be skipped. At NXTKEY time sequences that were skipped will return all backslashes: \\\\\\\\. NFLDS----The number of independent sequences in the KEY. ERR------0 = failure; -1 = success ROUTINES USED: SETSEQ EXAMPLE: C CREATE AN 8 FIELD KEY SEQUENCE C DEFINITION C CALL SETKEY(SCRAT,'KEY01>KEY99 1 EXPDA01>EXP-99 TECH-A TECH-B 2 NO-NH4 WTIH-NH4 3 2*(ODD EVEN) SEPT-78' 4 ,8, ERR) AUTHOR: Mike Higgins CETUS CORP. WRITTEN: June 1977 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: SETKEY LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none SETKEY - FIELD SEQUENCE DEFINITION ROUTINE PAGE 89 MAINTENANCE: see Jack Martinelli or Mike Higgins SETMAX - SETTING DEFAULT STRING LENGTH PAGE 90 SETMAX SETMAX - SETTING DEFAULT STRING LENGTH ROUTINE NAME: SETMAX PURPOSE: In using the string manipulation routines in this library you may wish to ignore the maximum length parameter, i.e., use the default. The default is 32. However by calling SETMAX you can change this default by specifying a new de- fault argument to SETMAX. CALLABLE: From FORTRAN - CALL SETMAX(maxlen) PARAMETERS: MAXLEN = the new default maximum string length. ROUTINES USED: none EXAMPLE: CALL SETMAX(64) AUTHOR: MIKE HIGGINS SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: MAXLEN LIBRARY: DP:[60,60]MIKES SETSEQ - SEQUENCE DEFINITION ROUTINE PAGE 91 SETSEQ SETSEQ - SEQUENCE DEFINITION ROUTINE ROUTINE NAME: SETSEQ PURPOSE: SETSEQ is part of a group of routines for parsing a special kind of input data, called sequence definitons. Sequence difinitions allow a data entry operator to avoid repetitive typing of sequential data when the data is going to be parsed by these sequence routines. Setseq is the routine that initializes processing of a string. To get successive tokens from the sequence, see the NXTSEQ routine. CALLABLE: from FORTRAN-- CALL SETSEQ(TABLE,MAX,STRING,LEN,WIDTH,ERR) PARAMETERS: TABLE----The buffer space to store the parameters of the sequence de- fined by STRING. TABLE should be dimensioned to at least twice the size in bytes of the longest string you plan to process. MAX------The size of TABLE in Bytes. STRING---The sequence definition array. The syntax for a sequence is as follows: [N*]() Where N is the number of times to repeat the se- quence of tokens in . e.g., 3*(A>1A) will generate the sequence A,B,C...Z,1A THREE TIMES. [N@]() Where N is the number of times to repeat each token in . e.g., 3@(A>1A) will generate the sequen ce A,A,A,B,B,B,C,C,C...Z,Z,Z,1A,1A,1A. Note that the parens are mandatory even in simple cases like 3*(A) or 4@(B). TOKEN>TOKEN2. The '>' is the 'through' command. It returns TOKEN1 the 1st call to NXTSEQ then the sucessor of each pre- vious TOKEN until it has returned token 2. note that no checking is done to assure that TOKEN is greater than token 2. Where separator is space, comma, or tab. an example of a more complex sequence is: 5*((0A1>OB9), 3@(AB,GG), 3*(QUALITY-CONT)) #BLANK TOKEN--- Since spaces are treated as seperators this con- vention was necessary to return a BLANK token from NXTSEQ. LEN------Length of string in bytes. WIDTH----The of bytes in an element within the string. Default is 8 bytes, note that this parameter determines the size of the strings returned by NXTSEQ, an d thereby determines the maxi- mum size of any token. tokens wider than width have their left most bytes discarded until they fit. SETSEQ - SEQUENCE DEFINITION ROUTINE PAGE 92 ERR------.TRUE. Returned for an error condition..FALSE. When no error. AUTHOR: Mike Higgins CETUS Corp. WRITTEN: June 1977 SOURCE LANGUAGE: SUPERMAC OBJECT MODULE NAME: SETSEQ LIBRARY: DP:[60,60]CETUS LAST MODIFICATION: none MAINTENANCE: See Mike Higgins or Jack Martinelli SUCC - SUCCESSOR FUNCTION PAGE 93 SUCC SUCC - SUCCESSOR FUNCTION ROUTINE NAME: SUCC PURPOSE: Modifies the STRING in place to produce the next string in a sequence. CALLABLE: from FORTRAN CALL SUCC (STRING{,LEN}) PARAMETERS: String is a byte array which is modified in place. LEN is the length of the byte array. If omitted, MAXLEN, or the first NUL byte determines the length used. ROUTINES USED: LEN EXAMPLE: open FEATURES: none AUTHOR: Mike Higgins WRITTEN: long ago SOURCE LANGUAGE: FORTRAN OBJECT MODULE NAME: SUCC LIBRARY: DP:[60,60]MIKES LAST MODIFICATION: long ago MAINTENANCE: see Jack Martinelli or Mike Higgins XFRC - CHARACTER TRANSFER SUBROUTINE PAGE 94 XFRC XFRC - CHARACTER TRANSFER SUBROUTINE ROUTINE NAME: XFRC PURPOSE: Transfers LEN characters from INBUF to OUTBUF. LEN defaults to MAXLEN from the SETMAX routine. CALLABLE: From FORTRAN -- CALL XFRC(STR1,[LEN],STR2) PARAMETERS: STR1 --- string from which characters are to be transferred from. LEN ---- optional length parameter. STR2 --- string which will recieve the transferred characters. ROUTINES USED: none EXAMPLE: open AUTHOR: JACK MARTINELLI WRITTEN: JUNE 1977 SOURCE LANGUAGE: MACRO-11 OBJECT MODULE NAME: XFRC LIBRARY: DP:[60,60]MIKES MAINTENANCE: see Jack Martinelli