#******************************************************** #* * #* PROGRAM: RID.RAT * #* PROGRAMMER: Inge Rittner * #* DATE: September 1979 * #* LAST REVISION: AUGUST 6,1980 * #* FUNCTION: * #* This program was designed to save space by * #* trimming excess characters from files * #* transferred to the PDP-11 from IBM or CDC. * #* * #******************************************************** LOGICAL*1 BUFFER(255) COMMON N,BUFFER LOGICAL*1 SAVE CALL WTQIO("1400,5,1) #_ _ _ _ _ Attach the terminal DEFINE BLANK ' ' #_ _ _ _ _ _ _ _ _ _ Definition table DEFINE TAB ' ' DEFINE ALLTAB 111 DEFINE TYP 222 DEFINE RATS 333 DEFINE OUTPT 444 DEFINE OUT 555 DEFINE EOF 666 DEFINE OPTIONS 777 DEFINE SLIPUP 888 DEFINE OOPS 999 DEFINE DARNIT 101 DEFINE SEQ 202 DEFINE TRUNC 303 DEFINE COMPRSS 404 DEFINE EXPAND 505 DEFINE BEGIN [ DEFINE ENDBEGIN ] OPTIONS TYPE *,' ' TYPE *,'MENU: ENTER NUMBER OF DESIRED OPTION' TYPE *,' ' TYPE *,'(1) PROGRAM INFORMATION' TYPE *,'(2) RID FILE OF TRAILING BLANKS AND TABS' TYPE *,'(3) RID FILE OF SEQUENCE NUMBERS AND TRAILING BLANKS' TYPE *,' AND TABS' TYPE *,'(4) TRANSFORM IMBEDDED BLANKS TO TABS' TYPE *,'(5) TRANSFORM IMBEDDED TABS TO BLANKS' TYPE *,'(6) CHANGE FILE HEADER TO CARRIAGECONTROL="LIST"' TYPE *,'(7) LIST FILE' TYPE *,'(8) EXIT PROGRAM' TYPE *,' ' REPEAT #_ _ _ _ _ _ _ _ _ _ Repeat until user response is acceptable BEGIN WRITE (5,5) #_ _ _ _ _ _ _ _ _ _ Prompt with ? READ (5,3,ERR=OOPS) MENU IF (MENU.GE.1 & MENU.LE.8) BREAK OOPS TYPE *,'*** INVALID RESPONSE--TRY AGAIN ***' TYPE *,' ' ENDBEGIN IF (MENU.EQ.1) BEGIN CALL HELP GOTO OPTIONS ENDBEGIN IF (MENU.EQ.8) GOTO OUT #_ _ _ _ _ _ _ _ _ _ Exit program TYPE *,' ' IF (MENU.EQ.7) TYPE *,'ENTER NAME OF FILE TO BE LISTED' ELSE TYPE *,'ENTER NAME OF FILE TO BE PROCESSED' REPEAT #_ _ _ Repeat until user responds with a correctly qualified existing file BEGIN WRITE (5,5) #_ _ _ _ _ _ _ _ _ _ Prompt with a ? READ (5,1) N,(BUFFER(I),I=1,N) BUFFER(N+1)=0 OPEN (UNIT=1,NAME=BUFFER,TYPE='OLD',ERR=DARNIT) BREAK DARNIT TYPE *,' ' TYPE *,'*** ERROR IN OPENING INPUT FILE--REENTER FILESPEC ***' TYPE *,' ' ENDBEGIN IF (MENU.NE.7) #_ _ _ _ _ _ _ _ The following block of code is skipped when listing a file BEGIN TYPE *,' ' TYPE *,'ENTER OUTPUT FILESPEC OR TO REUSE INPUT NAME' TYPE *,'CAUTION: If a version number was given in the input file' TYPE *,' specification and this input name is reused,' TYPE *,' the original file will be overwritten.' REPEAT #_ _ _ _ _ _ _ _ _ _ Repeat until output file is successfully opened. BEGIN WRITE (5,5) SAVE=BUFFER(1) #_ _ _ _ Save first character of input file name; a will overwrite it. READ (5,1) N,(BUFFER(I),I=1,N) IF (N.EQ.0) BUFFER(1)=SAVE #_ _ _ _ _ _ _ _ _ _ Restore first character of input file name. ELSE BUFFER(N+1)=0 #_ _ _ _ _ _ _ _ _ _ The processed file has been renamed. OPEN (UNIT=2,NAME=BUFFER,TYPE='NEW',CARRIAGECONTROL='LIST', ERR=SLIPUP) BREAK SLIPUP TYPE *,' ' TYPE *,'*** ERROR IN OPENING OUTPUT FILE--REENTER FILESPEC ***' TYPE *,' ' ENDBEGIN IF (MENU.EQ.3) #_ _ _ _ _ _ _ _ _ _ Do this if wish to rid file of sequence numbers BEGIN TYPE *,' ' TYPE *,'ENTER STARTING & ENDING COLUMNS OF SEQUENCE NUMBERS' TYPE *,' (USUALLY: 73,80)' REPEAT #_ _ _ _ _ _ _ _ _ _ Repeat until user response is acceptable BEGIN WRITE (5,5) READ (5,*,ERR=RATS) NSEQ1,NSEQ2 BREAK RATS TYPE *,' ' TYPE *,'*** INVALID RESPONSE--TRY AGAIN ***' TYPE *,' ' ENDBEGIN ENDBEGIN ENDBEGIN TYPE *,' ' REPEAT #_ _ _ _ _ _ Repeat until EOF condition occurs during reading of input file BEGIN READ (1,1,END=EOF) N,(BUFFER(I),I=1,N) #_ _ _ _ _ _ _ _ _ _ Input line from file for processing. IF (N.EQ.0) #_ _ _ _ _ _ _ _ _ _ Null lines skip processing. IF (MENU.EQ.7) GOTO TYP ELSE GOTO OUTPT GOTO (TRUNC,SEQ,COMPRSS,EXPAND,OUTPT,TYP) MENU-1 #_ _ _ _ _ _ Here diverge to perform specific functions. SEQ CALL DETAB #_ _ _ _ _ _ _ _ _ _ Confirm equivalence between column number and character # position in record--Replace all tabs with blanks. IF (N.LT.NSEQ2) FOR (I=NSEQ1;I.LE.N;I=I+1) BUFFER(I)=BLANK ELSE FOR (I=NSEQ1;I.LE.NSEQ2;I=I+1) BUFFER(I)=BLANK TRUNC FOR (I=N; I.GE.1; I=I-1) #_ _ _ _ _ _ _ _ _ _ Truncate trailing blanks and tabs. IF (BUFFER(I).NE.BLANK & BUFFER(I).NE.TAB & BUFFER(I).NE.0) BREAK N=I IF (MENU.EQ.3) CALL ENTAB GOTO OUTPT COMPRSS CALL ENTAB GOTO OUTPT EXPAND CALL DETAB OUTPT WRITE (2,2) (BUFFER(I),I=1,N) #_ _ _ _ _ _ _ _ _ _ Send processed line to output file. NEXT TYP WRITE (5,6) (BUFFER(I),I=1,N) #_ _ _ _ _ _ _ _ _ _ List line on screen. ENDBEGIN EOF CLOSE (UNIT=1) CLOSE (UNIT=2) TYPE *,' ' TYPE *,'** OPERATION COMPLETED **' TYPE *,' ' TYPE *,' ' GOTO OPTIONS #_ _ _ _ _ _ _ _ _ _ Return to menu options. OUT CALL EXIT 1 FORMAT (Q,255A1) 2 FORMAT (255A1) 3 FORMAT (1I2) 4 FORMAT (1A1) 5 FORMAT ('$? ') 6 FORMAT (1H ,255A1) 7 FORMAT (1H ,'*',A1,'*') END # Subroutine that transforms all possible blanks into tabs SUBROUTINE ENTAB LOGICAL*1 BUFFER(255) COMMON N,BUFFER OLD=1 #_ _ _ _ _ _ _ _ _ OLD represents character position in input file record NEW=1 #_ _ _ _ _ _ _ _ _ NEW represents character position in new compressed line WHILE (OLD.LE.N) BEGIN FOR (N1=NEW; NEW.LT.N1+8; NEW=NEW+1) #_ _ _ Search increments of line between tab stops(every 8 columns) for tabs BEGIN BUFFER(NEW)=BUFFER(OLD) IF (BUFFER(OLD).EQ.TAB) BEGIN OLD=OLD+1 NEW=NEW+1 IF (NEW.EQ.N1+1) GOTO ALLTAB #_ _ _ Skip optimization when tab is first char in increment group : # MOD(column #,8)=1 ELSE BREAK #_ _ _ _ _ _ _ _ Break loop when tab is found; search new increment of line ENDBEGIN OLD=OLD+1 IF (OLD.GT.N) #_ _ _ _ _ _ _ _ _ _ Break loop if reached end of line. BEGIN NEW=NEW+1 BREAK ENDBEGIN ENDBEGIN IF ((BUFFER(NEW-1).EQ.BLANK ! BUFFER(NEW-1).EQ.TAB) & BUFFER(NEW-2).EQ.BLANK) #_ _ _ _ _ _ Optimize space by deleting unnecessary blanks preceding tabs. BEGIN FOR (J=NEW-2; J.GE.N1; J=J-1) IF (BUFFER(J).NE.BLANK) BREAK J=J+1 BUFFER(J)=TAB NEW=J+1 ENDBEGIN ALLTAB CONTINUE ENDBEGIN N=NEW-1 #_ _ _ _ _ _ _ _ _ _ Set N to number of characters in new compressed line. RETURN END # Subroutine that transforms all tabs into the appropriate number of blanks SUBROUTINE DETAB LOGICAL*1 BUFFER(255),BUF(255) INTEGER OLD COMMON N,BUFFER FOR (ITAB=1; BUFFER(ITAB).NE.TAB; ITAB=ITAB+1) #_ _ _ _ _ _ _ _ _ _ Are there any tabs in line? IF (ITAB.EQ.N) RETURN #_ _ _ _ _ _ _ _ _ _ If not, skip rest of subroutine. OLD=ITAB/8 * 8 + 1 #_ Start processing at last position where MOD(char pos,8)=MOD(column #,8)=1 # or last such position before first tab in line. IF (ITAB.LT.OLD) BUF(ITAB)=BLANK #_ _ _ _ Change tab to a single blank. NEW=OLD #_ _ _ _ _ _ NEW represents column number = character position in new line. WHILE (OLD.LE.N) FOR (N1=NEW; NEW.LT.N1+8; NEW=NEW+1) #_ _ _ _ _ _ _ _ _ _ Search line in tab stop increments for tabs. BEGIN IF (BUFFER(OLD).EQ.TAB) BEGIN FOR (; NEW.LT.N1+8; NEW=NEW+1) #_ _ _ _ _ _ _ _ _ _ Expand tabs into blanks. BUF(NEW)=BLANK OLD=OLD+1 BREAK ENDBEGIN BUF(NEW)=BUFFER(OLD) #_ _ _ _ _ _ _ _ _ _ BUF receives expanded portion of input line. OLD=OLD+1 IF (OLD.GT.N) #_ _ _ _ _ _ _ _ _ _ Break loop if end of record. BEGIN NEW=NEW+1 BREAK ENDBEGIN ENDBEGIN FOR (I=ITAB; I.LT.NEW; I=I+1) #_ _ _ _ _ _ _ _ _ _ Copy expanded portion of line back to BUFFER. BUFFER(I)=BUF(I) N=NEW-1 #_ _ _ _ _ _ _ _ _ _ Set N to length of new expanded line. RETURN END # Subroutine that lists information about program RID SUBROUTINE HELP TYPE *,' ' TYPE *,' PROGRAM RID' TYPE *,' ' TYPE *,' ' type *,'This program''s main function is to save space by trimming excess' type *,'characters from files transferred to the PDP-11 from IBM or CDC. For' type *,'example, programs transferred from IBM have a fixed record length of' type *,'80 characters, sequence numbers in columns 73 to 80, and no tab' type *,'characters. Since space is a limiting factor on the PDP, it is' type *,'advisable to blank out the sequence numbers, and to then get rid of' type *,'any trailing blanks and tabs, and to perform all possible blank to tab' type *,'transformations, saving up to 7 characters per transformation (1 tab' type *,'can replace 8 blanks). The first two operations alone can reduce' type *,'program size by 70%.' type *,' ' type *,' ' type *,'The other functions performed by this program are: expanding all tabs' type *,'in a file to blanks so that character position matches column number,' type *,'and changing a file attribute to CARRIAGECONTROL=''LIST'' in order to' type *,'get a normal PIP listing. A file created by a Fortran OPEN statement' type *,'will default to CARRIAGECONTROL=''FORTRAN'' if the LIST option is not' type *,'specified, which presupposes that all output to a file includes a' type *,'carriage control character. Otherwise, the first character of every' type *,'line is interpreted for carriage control and is not printed. However,' type *,'carriage control characters should not be used in source files since' type *,'they offset the code and cause errors in compilation.' type *,' ' WRITE (5,10) READ (5,20) type *,' ' type *,' ' type *,'This program gets rid of sequence numbers by first invoking the' type *,'subroutine DETAB which ensures equivalence of character position and' type *,'column number, and then replacing the characters in the columns' type *,'indicated with blanks. This routine does not distinguish between' type *,'sequence numbers and comments, for instance, so it is best to process' type *,'files soon after transferring them over to the PDP, before editing' type *,'changes any columnar relationships. If the record length of any one' type *,'line is shorter than the last column position given for sequence' type *,'numbers, the line will remain as is, and the user is responsible for' type *,'editing out any stray sequence numbers.' type *,' ' type *,' ' type *,'Remember to purge your files after running this program, but not' type *,'until results have been checked, especially when the operation' type *,'performed was ridding a file of sequence numbers. Generally,' type *,'original files will remain intact and new versions will be created' type *,'(unless the version number was specified in the input file name and no' type *,'new output file name was given).' type *,' ' type *,' ' type *,'If you become stuck in an input loop and cannot remember the name of' type *,'the file to be processed, enter a CTRL Z for a clean exit.' type *,' ' type *,' ' WRITE (5,10) READ (5,20) RETURN 10 FORMAT('$ENTER WHEN READY TO CONTINUE') 20 FORMAT(80A1) END