C PROGRAM BIN2BOO C C****** GISBERT W.SELKE (RECK@DBNUAMA1.BITNET), 05/11/87 C WISSENSCHAFTLICHES INSTITUT DER ORTSKRANKENKASSEN, C KORTRIJKER STRASSE 1, D-5300 BONN 2, WEST GERMANY C RECK@DBNUAMA1.BITNET C C BOOING PROGRAM IN FORTRAN IV C C THIS IS A UTILITY PROGRAMME TO CONVERT BINARY DATA INTO C STANDARD ASCII TEXT IN ORDER TO FACILITATE DATA TRANSFER C C IT IS NOT MEANT TO BE A TRANSFER PROTOCOL REPLACEMENT; IT C JUST MAKES TRANSFER POSSIBLE ACROSS LINES (E.G., DATA NETWORKS) C WHEN NO KERMIT ARE AVAILABLE OR ONE OF THEM CAN'T COPE WITH C BINARY STUFF. C C BEWARE OF GREMLINS, THOUGH; ESPECIALLY EBCDIC <-> ASCII C TRANSLATION MAY BE A PROBLEM FOR SOME OF THE CHARACTERS ... C C BASICALLY, 3 BYTES = 24 BITS ARE ENCODED INTO 4 CHARACTERS C BY DIVIDING THEM INTO 6-BIT-PIECES AND THEN ADDING ASCII-ZERO C TO MAKE THESE PIECES PRINTABLE. THE RESULT LIES IN THE RANGE C ASCII-ZERO TO ASCII-SMALL-O. - IN ADDITION, NULL COMPRESSION C TAKES PLACE; CONSECUTIVE NULL BYTES (WHICH OCCUR FREQUENTLY C IN EXECUTABLE FILES, E.G.) ARE ENCODED WITH A TILDE LEAD-IN C FOLLOWED BY THE NUMBER OF NULLS (UP TO 78), AGAIN RENDERED C PRINTABLE BY ADDING ASCII-ZERO. THE RESULTING CHARACTER IS IN C THE RANGE ASCII-ZERO (WELL, ASCII-TWO OR -THREE, REALLY) TO C TILDE (ASCII CODE 126). - CHUNKS OF FOUR CHARACTERS BELONGING C TOGETHER (RSP. TILDE AND NULL REPEAT COUNT) SHOULD NOT BE C DIVIDED ACROSS LINES. A LINE HAS A MAXIMUM LENGTH OF 76 C CHARACTERS. - IN ADDITION, THE FIRST LINE OF THE FILE CONTAINS C THE NAME OF THE ORIGINAL FILE (IF KNOWN - OTHERWISE A DUMMY NAME) C AND NOTHING ELSE. C C SIBLING PROGRAMMES TO DECODE BOO FORMAT EXIST IN A VARIETY OF C LANGUAGES, MOST NOTABLY C, PASCAL, BASIC, AND FORTRAN, OF COURSE. C C THE BOO-FORMAT WAS DEVELOPPED FOR SAFE (WELL, NOT *REALLY* SAFE...) C BOOTSTRAPPING PURPOSES DURING KERMIT EVOLUTION BY BILL CATCHINGS C AND FRANK DA CRUZ OF COLUMBIA UNIVERSITY, OR SO I THINK. C C THANKS TO FRANK, BILL, DAPHNE AND MANY OTHER PEOPLE FOR ALL C THEY'VE DONE TO MAKE LIFE EASIER! C C CERTAIN SYSTEM SPECIFIC FEATURES CANNOT BE AVOIDED; HENCE, C YOU SHOULD CHECK THE CODE BELOW CAREFULLY. I HAVE TRIED TO C INDICATE THE PLACES WHERE PROBLEMS ARE LIKELY TO OCCUR; C THESE INCLUDE WORD-SIZE DEPENDANCIES AND THE WAY BINARY C I/O (I.E., UNHAMPERED BY ANY CONTROL CHARACTERS) IS C ACCOMPLISHED. ALSO, THE INPUT RECORD SIZE WILL NEED CHECKING. C C AS FAR AS POSSIBLE, PARAMETERS ARE SET IN DATA STATEMENTS IN C THE SUBROUTINES TO WHICH THEY PERTAIN; I/O CHANNEL NUMBERS C ARE ASSIGNED IN A DATA STATEMENT IN THE MAIN PROGRAMME (BELOW). C C IMPROVEMENTS ARE WELCOME AND SHOULD BE SENT EITHER DIRECTLY C TO THE AUTHOR OR TO THE KERMIT MAINTAINERS AT COLUMBIA UNIVERSITY, C NEW YORK, USA. C C PARAMETERS ARE SET AS FOLLOWS: C INPUT : I/O UNIT 5; ASSUMED TO BE 256 BYTE RECORDS C OUTPUT : I/O UNIT 7; PADDED WITH BLANKS TO YIELD 80 CHARACTERS ALWAYS C CONTROL OUTPUT: I/O UNIT 6 (NOT REALLY NECESSARY) C C NO REWIND WILL BE PERFORMED ON EITHER INPUT OR OUTPUT BEFORE OR C AFTER PROCESSING. OUTPUT FILE WILL HAVE A SINGLE FILE MARK AT END. C C ALL VARIABLES ARE ASSUMED TO BE 32-BIT-QUANTITIES C IMPLICIT INTEGER*4 (A-Z) LOGICAL*4 ZFOUND,ZNULL REAL*4 RATE DIMENSION CHUNK(4),BYTES(3) C INITIALIZATION OF SOME PSEUDO-CHARACTER CONSTANTS, EACH RIGHT- C JUSTIFIED IN AN INTEGER VARIABLE: C R6BITS HAS THE 6 RIGHT-MOST BITS SET; CZERO IS ASCII-0, AND C CREP IS ASCII-TILDE: DATA R6BITS/63/, CZERO/48/, CREP/126/ DATA LMAX/78/, NULL/0/, TWO/2/, FOUR/4/ C --- I/O UNITS: DATA INPUT/5/, OUTPUT/7/, CONTRL/6/ C C --- INITIALISATION: INCT = 0 INBYTE = 0 INPT = 0 NULLCT = 0 ZFOUND = .TRUE. WRITE (CONTRL,10000) 10000 FORMAT (//' Conversion from binary to boo format starts.'/) CALL WRINI(OUTPUT,OUTCT,OUTCHR,OUTPT) 10 CONTINUE C --- MAIN INPUT LOOP: C --- ASSEMBLE 3 BYTES: CALL GETBYT(BYTES(1),INPUT,INCT,INBYTE,INPT,CONTRL,ZFOUND) IF (.NOT.ZFOUND) GOTO 200 12 ZNULL = BYTES(1).EQ.NULL CALL GETBYT(BYTES(2),INPUT,INCT,INBYTE,INPT,CONTRL,ZFOUND) ZNULL = ZNULL .AND. BYTES(2).EQ.NULL CALL GETBYT(BYTES(3),INPUT,INCT,INBYTE,INPT,CONTRL,ZFOUND) ZNULL = ZNULL .AND. BYTES(3).EQ.NULL 15 CONTINUE IF (.NOT.ZNULL) GOTO 30 C --- START NULL COMPRESSION: I = 3 20 CONTINUE I = I + 1 CALL GETBYT(BYTES(1),INPUT,INCT,INBYTE,INPT,CONTRL,ZFOUND) IF ((BYTES(1).EQ.NULL) .AND. ZFOUND .AND. (I.LE.LMAX)) GOTO 20 C --- END OF NULL SEQUENCE: I = I - 1 NULLCT = NULLCT + I CHUNK(1) = CREP CHUNK(2) = I + CZERO CALL WRCHAR(CHUNK,OUTPUT,OUTCT,OUTCHR,OUTPT,TWO) IF (ZFOUND) GOTO 12 GOTO 200 30 CONTINUE C --- NON-NULL BYTES; SHIFT BITS TO FORM CHUNK: CHUNK(1) = ISHFT(BYTES(1),-2) + CZERO CHUNK(2) = IAND(IOR(ISHFT(BYTES(1),4),ISHFT(BYTES(2),-4)), * R6BITS) + CZERO CHUNK(3) = IAND(IOR(ISHFT(BYTES(2),2),ISHFT(BYTES(3),-6)), * R6BITS) + CZERO CHUNK(4) = IAND(BYTES(3),R6BITS) + CZERO CALL WRCHAR(CHUNK,OUTPUT,OUTCT,OUTCHR,OUTPT,FOUR) IF (ZFOUND) GOTO 10 200 CONTINUE C --- END OF FILE; FLUSH OUTPUT BUFFER BY PADDING WITH BLANKS: CALL FLSHSO(OUTPUT,OUTCT,OUTPT) RATE = 0.0 IF (OUTCHR.GT.0) RATE = (100.0*INBYTE) / OUTCHR WRITE (CONTRL,19000) INCT,INBYTE,OUTCT,OUTCHR,NULLCT,RATE 19000 FORMAT (//' Number of input sectors:',I9, * '; number of input bytes:',I9 * /' Number of output lines :',I9, * '; number of output chars:',I9 * /' Number of nulls :',I9, * '; efficiency :',F8.1,'%'/) STOP END C C SUBROUTINE WRCHAR(CHUNK,OUTPUT,OUTCT,OUTCHR,OUTPT,NBR) C C OUTPUT NBR CHARACTERS (CHUNK) TO OUTPUT; C UPDATE LINES WRITTEN (OUTCT), CHARS WRITTEN (OUTCHR), C POINTER TO OUTPUT LINE (OUTPT) C C CALL WRINI FIRST FOR INITIALISATION. C CALL FLSHSO FOR FINISHING OFF. C IMPLICIT INTEGER*4 (A-Z) DIMENSION CHUNK(1),OUTLIN(20),DUMNAM(3) C MAXLGT IS MAXIMUM NUMBER OF CHARACTERS ALLOWED; LINLEN IS C NUMBER OF 32-BIT-WORDS ACTUALLY WRITTEN (DIMENSION OF OUTLIN): DATA MAXLGT/76/, LINLEN/20/ C CBLANK IS ASCII-BLANK, RIGHT-JUSTIFIED, BLANK4 IS 4 BYTES BLANK: DATA CBLANK/32/, BLANK4/' '/ C --- SOME FORTRANS HAVE NO WAY OF KNOWING EXTERNAL FILES NAMES, C HENCE SUPPLY DUMMY NAME: DATA DUMNAM/'BINA','RY.D','AT '/ C C --- IS BUFFER FULL? IF (OUTPT+NBR.LE.MAXLGT) GOTO 10 C --- BUFFER IS INDEED FULL; PAD TO BUFFER LENGTH AND PUT IT OUT: K = 4*LINLEN - 1 DO 5 I=OUTPT,K 5 CALL INSRCH(CBLANK,OUTLIN,I+1) WRITE (OUTPUT,40000) OUTLIN C --- ADAPT IF NECESSARY: 40000 FORMAT (20A4) OUTCT = OUTCT + 1 OUTPT = 0 10 CONTINUE C --- PUT IN CHARACTERS: DO 20 I=1,NBR OUTPT = OUTPT + 1 OUTCHR = OUTCHR + 1 CALL INSRCH(CHUNK(I),OUTLIN,OUTPT) 20 CONTINUE GOTO 90 C C ENTRY WRINI: C ENTRY WRINI(OUTPUT,OUTCT,OUTCHR,OUTPT) C C --- ALL INITIALIZATIONS NEEDED FOR THE OUTPUT FILE GO HERE: C --- WRITE DUMMY FILE NAME TO OUTPUT FILE, SINCE WE DON'T KNOW BETTER: DO 30 I=1,3 30 OUTLIN(I) = DUMNAM(I) K = 4*LINLEN DO 35 I=13,K 35 CALL INSRCH(CBLANK,OUTLIN,I) WRITE (OUTPUT,40000) OUTLIN OUTCT = 0 OUTCHR = 0 OUTPT = 0 GOTO 90 C C --- ENTRY FLSHSO: C ENTRY FLSHSO(OUTPUT,OUTCT,OUTPT) C C --- ANYTHING TO CLOSE THE OUTPUT FILE GOES HERE: K = 4*LINLEN - 1 DO 50 I=OUTPT,K 50 CALL INSRCH(CBLANK,OUTLIN,I+1) C --- WRITE THE REST: WRITE (OUTPUT,40000) OUTLIN OUTCT = OUTCT + 1 C --- ANYTHING TO CLOSE THE OUTPUT FILE: ENDFILE OUTPUT 90 CONTINUE RETURN END C C SUBROUTINE GETBYT(BYTE,INPUT,INCT,INBYTE,INPT,CONTRL,ZFOUND) C C GET ONE BYTE FROM INPUT; UPDATE COUNT OF SECTORS (INCT), C COUNT OF INPUT BYTES(INBYTE) (EVEN IF THAT'S NEARLY REDUNDANT...) C AND POINTER INTO INPUT BUFFER (INPT). C ZFOUND IS TRUE IFF BYTE WAS FOUND. C REPORT PROGRESS ON UNIT CONTRL. C IMPLICIT INTEGER*4 (A-Z) LOGICAL*4 ZFOUND C --- UFT IS NEEDED FOR MODCOMP BINARY READ: DIMENSION SECTOR(64),UFT(5) C THESE VARIABLES ARE FOR MODCOMP USE ONLY: DATA OPTION/36864/, EOFBIT/2097152/ C --- SECLEN IS NUMBER OF BYTES IN A TYPICAL, FIXED-LENGTH BINARY RECORD: DATA SECLEN/256/ C BYTE = 0 IF (.NOT.ZFOUND) GOTO 95 C --- CHECK IF FIRST CALL: IF (INCT.NE.0) GOTO 10 C --- YES; ANYTHING TO INITIALIZE INPUT FILE FOR READING GOES HERE; C READING MUST BE UNDISTURBED BY ANY CONTROL CHARACTERS: C --- INITIALIZE UFT FOR READING (MODCOMP; REPLACE WITH WHATEVER YOU C NEED): C CALL BLDUFT(UFT,0,ICAN4(INPUT),OPTION) C GOTO 12 10 CONTINUE C --- IS SOMETHING LEFT IN THE BUFFER? IF (INPT.LT.SECLEN) GOTO 20 C --- NO; GET NEXT SECTOR: 12 INCT = INCT + 1 C --- DO A BINARY READ OF SECLEN BYTES = ONE RECORD: C (AGAIN, REPLACE WITH WHATEVER YOU NEED, MAYBE A PLAIN READ WITH C FORMAT (64A4) WILL DO FOR YOU. REMEMBER TO CHECK FOR END OF FILE.) C CALL READ4(UFT,SECTOR,SECLEN) C C --- END OF FILE?? IF (IAND(UFT(1),EOFBIT).NE.0) GOTO 90 C --- NO; NEXT SECTOR FOUND: C --- REPORT PROGRESS ON CONTROL UNIT FROM TIME TO TIME: IF (MOD(INCT,64).EQ.0) WRITE (CONTRL,17000) INCT 17000 FORMAT ('+Record',I9) INPT = 0 20 CONTINUE C --- GET NEXT BYTE FROM BUFFER: INPT = INPT + 1 INBYTE = INBYTE + 1 CALL EXTRCH(BYTE,SECTOR,INPT) GOTO 95 90 CONTINUE ZFOUND = .FALSE. 95 CONTINUE RETURN END C C SUBROUTINE EXTRCH(C,BUFFER,POS) C C GET POS-TH BYTE FROM BUFFER, RETURN IT RIGHT-JUSTIFIED WITHIN C: C BUFFER IS REGARDED AS TIGHTLY PACKED 32-BIT-QUANTITIES-ARRAY C IMPLICIT INTEGER*4 (A-Z) DIMENSION BUFFER(1) C THESE ARE THE RIGHT-MOST 8 BITS: DATA RBYTE/255/ C I = (POS+3) / 4 K = POS - 4*(I-1) C = BUFFER(I) C --- NOW SHIFT; BUT FOR THE BENEFIT OF SOME FAULTY COMPILERS, C DONT'T IF SHIFT COUNT IS 0: IF (K.NE.4) C = ISHFT(C,8*K-32) C = IAND(C,RBYTE) RETURN END C C SUBROUTINE INSRCH(C,BUFFER,POS) C C INSERT RIGHT-MOST BYTE OF C INTO POS-TH BYTE OF BUFFER. C ASSUME C IS 0 IN 3 FIRST BYTES AND THERE ARE NO SIGNIFICANT BYTES C AFTER POS IN BUFFER C BUFFER IS REGARDED AS TIGHTLY PACKED 32-BIT-QUANTITIES-ARRAY C IMPLICIT INTEGER*4 (A-Z) DIMENSION BUFFER(1) C THIS IS A VARIABLE WITH EACH AND EVERY BIT SET; IF YOUR MACHINE C DOESN'T USE TWO'S COMPLEMENT, YOU GOT TO FIGURE OUT HOW TO DO IT: DATA FULLBT/-1/ C I = (POS+3)/4 K = POS - 4*(I-1) CA = C C --- NOW SHIFT; BUT FOR THE BENEFIT OF SOME FORTRAN COMPILERS, C DON'T IF SHIFT COUNT IS ZERO: IF (K.NE.4) CA = ISHFT(CA,32-8*K) MASK = ISHFT(FULLBT,40-8*K) BUFFER(I) = IOR(IAND(BUFFER(I),MASK),CA) RETURN END