PROGRAM CMPRES C C********************************************************************** C C Object files created by the FORTRAN-IV compiler will have a C lot of unused space between formatted binary blocks. As a C result, they are much larger than necessary. 'CMPRES' will C make the FORTRAN-IV object modules significantly smaller by C removing the unused space. C C Written by Robert Walraven C Version 1.0 22-Apr-82 C C********************************************************************** C CALL SETUP C 10 CALL GET REC CALL PUT REC GO TO 10 END C********************************************************************* SUBROUTINE SETUP C C Set up file i/o and get other useful info from user. C IMPLICIT INTEGER (A-Z) COMMON /INPUT/ BLOCK,COUNT,INPUT(512) BYTE INPUT COMMON /OUTPUT/ BLK OUT, CNT OUT, OUTPUT(512) BYTE OUTPUT BYTE TEXT(20) COMMON /SYSTEM/ SYSTEM,RT,RSX COMMON /MACRO/ MACRO LOGICAL MACRO COMMON /LUN/ LUN IN, LUN OUT, LUN TT DATA RT,RSX /1,2/ DATA LUN IN, LUN OUT, LUN TT /2,1,5/ C C.......Get input file name and open it C 10 WRITE (LUN TT,20) 20 FORMAT(' Input filename: ',$) READ (LUN TT,30) LEN,TEXT 30 FORMAT(Q,20A1) TEXT(LEN+1) = 0 OPEN (UNIT=LUNIN,NAME=TEXT,TYPE='OLD',ACCESS='DIRECT', 1 RECORDSIZE=128,READONLY,ERR=1000) C C.......Get output file name and open it C 40 WRITE (LUN TT,50) 50 FORMAT(' Output filename: ',$) READ (LUN TT,30) LEN,TEXT TEXT(LEN+1) = 0 OPEN (UNIT=LUNOUT,NAME=TEXT,TYPE='NEW',ACCESS='DIRECT', 1 RECORDSIZE=128,ERR=2000) C C.......Initialize pointers C 200 READ (LUNIN'1) INPUT IN = INPUT(5) IF (IN .EQ. 7) GO TO 3000 BLOCK = 1 COUNT = 1 BLK OUT = 1 CNT OUT = 1 DO 300 I=1,512 OUTPUT(I) = 0 300 CONTINUE RETURN C C-------------------->> ERROR HANDLING <<-------------------- C 1000 WRITE (LUN TT,1100) 1100 FORMAT(' ?CMPRES-W-Can not find input file. Try again.') GO TO 10 2000 WRITE (LUN TT,2100) 2100 FORMAT(' ?CMPRES-W-Can not open output file. Try again.') GO TO 10 3000 WRITE (LUN TT,3100) 3100 FORMAT(' ?CMPRES-F-Input file is a library.'/) CALL EXIT END C********************************************************************* SUBROUTINE RD NEXT (VALUE) C C Gets the next byte from the input buffer C IMPLICIT INTEGER (A-Z) COMMON /INPUT/ BLOCK,COUNT,INPUT(512) BYTE INPUT COMMON /OUTPUT/ BLK OUT, CNT OUT, OUTPUT(512) BYTE OUTPUT INTEGER INT OUT(256) EQUIVALENCE (INT OUT(1),OUTPUT(1)) COMMON /LUN/ LUN IN, LUN OUT, LUN TT C C.......If a new block is needed, read it C IF (COUNT.LE.512) GO TO 10 BLOCK = BLOCK + 1 READ (LUNIN'BLOCK,END=100) INPUT COUNT = 1 10 CONTINUE C C.......Get the byte value C VALUE = INPUT (COUNT) COUNT = COUNT + 1 RETURN C C-------------------->> End of input file <<-------------------- C 100 WRITE (LUNOUT'BLKOUT) INT OUT CLOSE (UNIT=LUNIN) CLOSE (UNIT=LUNOUT) CALL EXIT RETURN END C********************************************************************* SUBROUTINE PUT REC C C Puts a record in the output file C IMPLICIT INTEGER (A-Z) COMMON /RECORD/ LEN, NXT CHR, RECORD(256) BYTE RECORD COMMON /OUTPUT/ BLK OUT, CNT OUT, OUTPUT(512) BYTE OUTPUT INTEGER INT OUT (256) EQUIVALENCE (INT OUT(1), OUTPUT(1)) COMMON /LUN/ LUN IN, LUN OUT, LUN TT C DO 1000 I = 1,LEN IF (CNT OUT .LE. 512) GO TO 100 WRITE (LUNOUT'BLKOUT) INT OUT CNT OUT = 1 BLK OUT = BLK OUT + 1 DO 10 J=1,256 INT OUT(I) = 0 10 CONTINUE 100 CONTINUE OUTPUT(CNT OUT) = RECORD(I) CNT OUT = CNT OUT + 1 1000 CONTINUE C RETURN END C********************************************************************* SUBROUTINE GET REC IMPLICIT INTEGER (A-Z) COMMON /RECORD/ LEN, NXT CHR, RECORD (256) BYTE RECORD COMMON /LUN/ LUN IN, LUN OUT, LUN TT BYTE INB(2) EQUIVALENCE (INB(1),IN) C C.......If CODE is zero, skip over it C 10 CALL RD NEXT (CODE) IF (CODE.EQ.0) GO TO 10 C C.......Else, if CODE is 1, too bad C IF (CODE.EQ.1) GO TO 16 WRITE (LUNTT,14) 14 FORMAT(' ?CMPRES-F-I can not do it.') CALL EXIT 16 CONTINUE C C.......Else, process data C RECORD(1) = CODE CALL RD NEXT (CODE) RECORD(2) = CODE CALL RD NEXT (N) RECORD(3) = N INB(1) = N CALL RD NEXT (N) RECORD(4) = N INB(2) = N LEN = IN + 1 DO 30 I=5,LEN CALL RD NEXT (CODE) RECORD(I) = CODE 30 CONTINUE RETURN END