C constant definitions C############################################################################### C C C *** stdef.rat *** C C C############################################################################### C C------------------------------------------------------------------------------- C INTEGER FUNCTION LENGTH ( STRNG ) C C############################################################################### C C LENGTH returns the number of characters passed in the input vector C STRNG, excluding the terminating null byte. C C############################################################################### BYTE STRNG ( 1 ) I = 0 20000 IF (.NOT.( STRNG ( I + 1 ) .NE. 0)) GOTO 20002 20001 I = I + 1 GOTO 20000 20002 CONTINUE length = ( I ) RETURN END C INTEGER FUNCTION GETL ( STRNG, MAX, LUNIN ) C C############################################################################### C C GETL is an integer function that reads a random length character string C from the logical unit number specified in LUNIN. The string is stored in C the vector STRNG, and must be at most MAX-1 characters in length, as the C string is always terminated by a null byte (octal 0). The value of the C function return is the number of bytes (excluding the eos) that were read. C If, however, an end of file was read, (or a ^Z), then the functon returns C a value of -1. C C############################################################################### BYTE STRNG ( MAX ) INTEGER N, MAX, LUNIN READ ( LUNIN, 10, END = 100 ) N, STRNG 10 FORMAT ( Q, 255a1 ) IF (.NOT.( N .GE. MAX )) GOTO 20003 N = MAX - 1 20003 CONTINUE STRNG ( N + 1 ) = 0 getl = ( N ) RETURN 100 STRNG ( 1 ) = 0 getl = ( - 1 ) RETURN END C INTEGER FUNCTION GETTY ( PROMPT, RESULT ) C C############################################################################## C C e.g. len=getty(,result) C or C len=getty("RAT>",result) C C The integer function GETTY is like GETL except that the input device C is assumed to be the terminal, and it is also possible to issue a prompt C for a given command. PROMPT is a random length string that should be C terminated with a null byte. The routine will append octal 200 to C the prompt string to inhibit a carriage return, line feed at C the end of the PROMPT. C A random length character string is returned C in STRNG and the string is terminated with a null byte. An optional prompt C may also be included. C NOTE: This function uses the RT-11 system subroutine GTLIN as described C on page 2-52 and 3-10 of the RT-11 V4.0 Programmer's Reference Manual. C C****************************************************************************** C C GETTY vs. GETL C C Please note there is a large difference in the two routines GETL and C GETTY. When input is with respect to the terminal, GETL will not read C from a command file, but GETTY will read from a command file. If calls C to GETL and GETTY are intermixed, and a command file is currently open, C GETL wil ignore the command file and allow input from the terminal, whereas C GETTY will always read the next line from the command file. When a command C file is not currently open, both GETL and GETTY function identically. C A further source of confusion, in GETL the input string can be of any C length and its maximum is specified in the call to the subroutine. C In GETTY, the input string MUST be 81 characters in length, (of course it C may be dimensioned as anything larger than 81 as well). C C############################################################################## BYTE PROMPT ( 1 ), RESULT ( 1 ) IF (.NOT.( IADDR ( PROMPT ) .EQ. - 1 )) GOTO 20005 CALL GTLIN ( RESULT ) GOTO 20006 20005 CONTINUE LPMT = LENGTH ( PROMPT ) + 1 PROMPT ( LPMT ) = 128 CALL GTLIN ( RESULT, PROMPT ) PROMPT ( LPMT ) = 0 20006 CONTINUE getty = ( LENGTH ( RESULT ) ) RETURN END C SUBROUTINE PUTL ( STRNG, LUNOUT ) C C############################################################################## C C PUTL subroutine writes a random length string of ascii text passed in C STRNG (and terminated with a null byte) to the ouput logical unit number C passed in LUNOUT. If the first byte of the string is a null byte, (STRNG C is empty), then a null record is written to LUNOUT. C C############################################################################## BYTE STRNG ( 1 ) INTEGER L, LENGTH, I, LUNOUT L = LENGTH ( STRNG ) IF (.NOT.( L .GT. 0 )) GOTO 20007 WRITE ( LUNOUT, 10 ) ( STRNG ( I ), I = 1, L ) 10 FORMAT ( 255a1 ) RETURN 20007 CONTINUE WRITE ( LUNOUT, 10 ) 20008 CONTINUE RETURN END C SUBROUTINE LCUC ( STRNG ) C C############################################################################## C C This subroutine accepts a standard character string that is terminated C by an eos, and converts all lower case letters to upper case letters. C C############################################################################## BYTE STRNG ( 1 ) I = 1 20009 IF (.NOT.( STRNG ( I ) .NE. 0)) GOTO 20011 IF (.NOT.( STRNG ( I ) .GE. 'a' .AND. STRNG ( I ) .LE. 'z' )) $GOTO 20012 STRNG ( I ) = STRNG ( I ) - 32 20012 CONTINUE 20010 I = I + 1 GOTO 20009 20011 CONTINUE RETURN END C BYTE FUNCTION EQUAL ( S1, S2 ) C C############################################################################### C C Returns true if string S1 is exactly equal to S2, else returns false. C C############################################################################### BYTE S1 ( 1 ), S2 ( 1 ) I = 1 20014 IF (.NOT.( S1 ( I ) .EQ. S2 ( I ))) GOTO 20016 IF (.NOT.( S1 ( I ) .EQ. 0 )) GOTO 20017 equal = ( . TRUE . ) RETURN 20017 CONTINUE 20015 I = I + 1 GOTO 20014 20016 CONTINUE equal = ( . FALSE . ) RETURN END C BYTE FUNCTION COMPAR ( S1, S2, NBYTES ) C C############################################################################### C C This routine compares the first NBYTES bytes of strings S1 and S2 C and returns true if they are identical, else it returns false. C C############################################################################### BYTE S1 ( 1 ), S2 ( 1 ) I = 1 20019 IF (.NOT.( S1 ( I ) .EQ. S2 ( I ))) GOTO 20021 IF (.NOT.( I .EQ. NBYTES )) GOTO 20022 compar = ( . TRUE . ) RETURN 20022 CONTINUE 20020 I = I + 1 GOTO 20019 20021 CONTINUE compar = ( . FALSE . ) RETURN END C INTEGER FUNCTION INDEX ( STRNG, C ) C C############################################################################### C C Finds the first occurence of the character C in the string STRNG and C returns its index, else if the character is not found before the EOS, C the function returns -1. C C############################################################################### BYTE C, STRNG ( 1 ) I = 1 20024 IF (.NOT.( STRNG ( I ) .NE. 0)) GOTO 20026 IF (.NOT.( STRNG ( I ) .EQ. C )) GOTO 20027 index = ( I ) RETURN 20027 CONTINUE 20025 I = I + 1 GOTO 20024 20026 CONTINUE index = ( - 1 ) RETURN END C SUBROUTINE COPY ( FROM, TO, MAX ) C C############################################################################### C C COPY copies up to max characters from string FROM to string TO. C C############################################################################### BYTE FROM ( 1 ), TO ( 1 ) I = 1 20029 IF (.NOT.( FROM ( I ) .NE. 0 .AND. I .LT. MAX)) GOTO 20031 TO ( I ) = FROM ( I ) 20030 I = I + 1 GOTO 20029 20031 CONTINUE TO ( I ) = 0 RETURN END C INTEGER FUNCTION SHIFT ( STRNG, START, N ) C C############################################################################## C C This routine accepts a random length STRNG that is terminated by an C EOS, and starting at byte START, shifts the remainder of the string N C spaces to the RIGHT when the value of N is positive. When N is negative, C the string is shifted to the LEFT, HOWEVER, the definition of START is C somewhat different. When N is negative, START specifies the position C where the first byte will moved TO. The first byte will actually move C from START+ABS(N) to START. NOTE N specifies the number of bytes that C are deleted. When N is positive START specifies the position C of the first byte to be moved, and it is moved from START to START+N, C (note if it were really done this way, the string would be destroyed, C as bytes would be overwritten, but the idea is the point). Thus, C positive values of N will create a hole in a string, and negative values C of N will remove bytes. The function will return the length of C the string as the value of the function. If there is an error, C the function returns -1. C C############################################################################### BYTE STRNG ( 1 ) INTEGER START IF (.NOT.( N .LT. 0 )) GOTO 20032 IF (.NOT.( START .LT. 1 .OR. N .LT. START - LENGTH ( STRNG ) - 1 $)) GOTO 20034 shift = ( - 1 ) RETURN 20034 CONTINUE CALL COPY ( STRNG ( START - N ), STRNG ( START ), 32000 ) 20035 CONTINUE GOTO 20033 20032 CONTINUE IF (.NOT.( N .GT. 0 )) GOTO 20036 IF (.NOT.( START .LE. 0 )) GOTO 20038 shift = ( - 1 ) RETURN 20038 CONTINUE CONTINUE I = LENGTH ( STRNG ) + 1 20040 IF (.NOT.( I .GE. START)) GOTO 20042 STRNG ( I + N ) = STRNG ( I ) IF (.NOT.( STRNG ( I ) .EQ. 0 )) GOTO 20043 STRNG ( I ) = ' ' 20043 CONTINUE 20041 I = I - 1 GOTO 20040 20042 CONTINUE 20036 CONTINUE 20033 CONTINUE shift = ( LENGTH ( STRNG ) ) RETURN END C INTEGER FUNCTION ANY ( S1, S2 ) C C############################################################################## C C ANY will return the first occurence in S1 of any of the characters C listed in the input string S2. If none of the characters listed in S2 C can be found in S1, then the function returns -1. C C############################################################################## BYTE S1 ( 1 ), S2 ( 1 ) I = 1 20045 IF (.NOT.( S1 ( I ) .NE. 0)) GOTO 20047 IF (.NOT.( INDEX ( S2, S1 ( I ) ) .GT. 0 )) GOTO 20048 any = ( I ) RETURN 20048 CONTINUE 20046 I = I + 1 GOTO 20045 20047 CONTINUE any = ( - 1 ) RETURN END C INTEGER FUNCTION NOTANY ( S1, S2 ) C C############################################################################## C C NOTANY will return the first position in S1 that contains none C of the characters listed in the string S2. The function returns -1 C of all characters in S1 match with any character in S2. C C############################################################################## BYTE S1 ( 1 ), S2 ( 1 ) I = 1 20050 IF (.NOT.( S1 ( I ) .NE. 0)) GOTO 20052 IF (.NOT.( INDEX ( S2, S1 ( I ) ) .LT. 1 )) GOTO 20053 notany = ( I ) RETURN 20053 CONTINUE 20051 I = I + 1 GOTO 20050 20052 CONTINUE notany = ( - 1 ) RETURN END C INTEGER FUNCTION REMOVE ( S1, S2 ) C C############################################################################## C C REMOVE will remove all occurences of characters listed in the string C S2 from the string S1 and return the remaining length of s1 as C the value of the function. Both S1 and S2 must be terminated with a null C byte. REMOVE must be declared as an integer in the calling routine. C C############################################################################## INTEGER SHRTEN, ANY BYTE S1 ( 1 ), S2 ( 1 ) 20055 CONTINUE INDX = ANY ( S1, S2 ) IF (.NOT.( INDX .LT. 1 )) GOTO 20058 GOTO 20057 20058 CONTINUE LEN = SHRTEN ( S1 ( INDX ), S2 ) 20059 CONTINUE 20056 GOTO 20055 20057 CONTINUE LEN = LENGTH ( S1 ) remove = ( LEN ) RETURN END C INTEGER FUNCTION SHRTEN ( S1, S2 ) C C############################################################################## C C This routine will remove all occurences of only characters specified C in the string S2 from the front of the char string S1. If there C are no characters in S2 that precede S1 then no action is taken. C S2 may be a literal or an array of characters. On a return from C the routine, SHRTEN will return the length of the string S1. C C############################################################################## BYTE S1 ( 1 ), S2 ( 1 ) INTEGER SHIFT, NOTANY NSKIP = NOTANY ( S1, S2 ) - 1 IF (.NOT.( NSKIP .EQ. 0 )) GOTO 20060 shrten = ( LENGTH ( S1 ) ) RETURN 20060 CONTINUE IF (.NOT.( NSKIP .LT. 0 )) GOTO 20062 S1 ( 1 ) = 0 shrten = ( 0 ) RETURN 20062 CONTINUE L = SHIFT ( S1, 1, - NSKIP ) 20063 CONTINUE 20061 CONTINUE shrten = ( LENGTH ( S1 ) ) RETURN END C BYTE FUNCTION ASCINT ( ASCIN, INTOUT ) C C############################################################################## C C This function converts a single string of ascii representing C a integer number to its integer equivalent. The function returns C true if the conversion was accomplished successfully, else it returns C false. If a null string is passed as an argument, the function C assigns an integer value of 0. C C############################################################################## BYTE ASCIN ( 1 ) INTEGER LENGTH L = LENGTH ( ASCIN ) IF (.NOT.( L .EQ. 0 )) GOTO 20064 INTOUT = 0 GOTO 20065 20064 CONTINUE IF (.NOT.( L .GT. 7 )) GOTO 20066 GOTO 110 GOTO 20067 20066 CONTINUE DECODE ( L, 100, ASCIN, ERR = 110 ) INTOUT 100 FORMAT ( I7 ) 20067 CONTINUE 20065 CONTINUE ascint = ( . TRUE . ) RETURN 110 ascint = ( . FALSE . ) RETURN END C INTEGER FUNCTION INTGET ( MINVAL, MAXVAL ) C C############################################################################## C C This function returns an integer number that is obtained from the terminal C or from a command file that has been opened previously by the monitor. C The parameters MINVAL and MAXVAL specify the minimum and maximum integer C values respectively and both must be specified. It is not possible C to specify only an upper or a lower limit. If an error occurs, either C an illegal number or a range error, the terminal is prompted and a new value C is obtained. The function will only return after a legal number C has been read successfully. C C############################################################################## BYTE ASCIN ( 82 ) BYTE ASCINT INTEGER GETL, GETTY INTEGER REMOVE L = GETTY (, ASCIN ) 20068 CONTINUE L = REMOVE ( ASCIN, ' ' ) IF (.NOT.( LENGTH ( ASCIN ) .EQ. 0 )) GOTO 20071 ASCIN ( 1 ) = '0' ASCIN ( 2 ) = 0 20071 CONTINUE IF (.NOT.( .NOT. ASCINT ( ASCIN, INTOUT ) )) GOTO 20073 WRITE ( 5, 10 ) 10 FORMAT ( '$ ** re-enter integer number: ' ) GOTO 20074 20073 CONTINUE IF (.NOT.( INTOUT .LT. MINVAL .OR. INTOUT .GT. MAXVAL )) GOTO $20075 99 WRITE ( 5, 11 ) MINVAL, MAXVAL 11 FORMAT ( ' ** value out of range: [', I6, ',', I6, ']' ) WRITE ( 5, 10 ) GOTO 20076 20075 CONTINUE GOTO 20070 20076 CONTINUE 20074 CONTINUE IF (.NOT.( GETL ( ASCIN, 8, 5 ) .EQ. - 1 )) GOTO 20077 CALL EXIT 20077 CONTINUE 20069 GOTO 20068 20070 CONTINUE intget = ( INTOUT ) RETURN END