C PROGRAM BOO2BIN 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 UNBOOING PROGRAM IN FORTRAN IV C C THIS IS A UTILITY PROGRAMME TO CONVERT THE OUTPUT OF A C BOOING PROGRAMME STANDARD ASCII TEXT) BACK INTO BINARY DATA C (E.G., THE OUTPUT OF BIN2BOO.FOR) 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 KERMITS 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 BOO2BIN REVERSES THE FOLLOWING PROCESS: 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. THIS LINE IS EFFECTIVELY IGNORED BY THIS C PROGRAMME SINCE FORTRAN IV HAS NO WAY OF CREATING FILES; RATHER, C AN OUTPUT FILE MUST HAVE BEEN CREATED BEFORE AND MADE AVAILABLE C AS I/O UNIT 7. THE ORIGINAL NAME IS OUTPUT TO THE CONTROL CHANNEL C FOR DOCUMENTATION PURPOSES ONLY. C C SIBLING PROGRAMMES TO ENCODE BINARY DATA 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; TEXT FILE WITH UP TO 80 CHARACTERS PER LINE C OUTPUT : I/O UNIT 7; 256 BYTE RECORDS. MUST HAVE BEEN CREATED EXTERNALLY. 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 C IMPLICIT INTEGER*4 (A-Z) LOGICAL ZEND DIMENSION NAME(12),CHUNK(4),BYTES(3) C NOW INITIALIZE SOME PSEUDO-CHARACTER CONSTANTS, RIGHT-JUSTIFIED C WITHIN EACH VARIABLE: DATA CREP/126/, CZERO/48/, CTILDE/126/, RBYTE/255/, CO/111/ DATA NULL/0/ C THE FOLLWOING CONTAINS HEX-07 = BELL AS ITS FIRST BYTE; CHANGE C THIS TO 1824, IF YOU'RE WORKING WITH INTEGER*2 VARIABLES: DATA BELL/119545888/ C --- I/O UNITS: DATA INPUT/5/, OUTPUT/7/, CONTRL/6/ C C --- INITIALISATION: OUTCT = 0 OUTBYT = 0 OUTPT = 0 NULLCT = 0 ERRCT = 0 ZEND = .FALSE. WRITE (CONTRL,10000) 10000 FORMAT (//' Conversion from boo to binary format starts.'/) C --- READ ORIGINAL FILE NAME: CALL RDINI(NAME,INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) IF (ZEND) GOTO 210 WRITE (CONTRL,11000) NAME 11000 FORMAT (' Original file name was ',12A1/) 10 CONTINUE C --- MAIN INPUT LOOP: CALL RDCHAR(C,INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) IF (ZEND) GOTO 200 C --- GOT CHAR; IS IT NULL REPEAT CHAR? IF (C.NE.CREP) GOTO 30 C --- YES; GET REPEAT COUNT: CALL RDCHAR(C,INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) IF (ZEND) GOTO 100 C --- IS IT IN THE PROPER RANGE? IF (C.LT.CZERO .OR. C.GT.CTILDE) GOTO 25 C --- YES, OUTPUT PROPER NUMBER OF NULLS: IMAX = C - CZERO IF (IMAX.EQ.0) GOTO 90 DO 15 I=1,IMAX CALL PUTBYT(NULL,OUTPUT,OUTCT,OUTBYT,OUTPT,CONTRL,ZEND) IF (ZEND) GOTO 140 15 CONTINUE NULLCT = NULLCT + IMAX GOTO 90 25 CONTINUE C --- IMPROPER REPEAT COUNT: WRITE (CONTRL,17000) INCT,INPT,C 17000 FORMAT ('+IMPROPER NULL COUNT AT INPUT LINE',I6,', COLUMN', * I4,': HEX VALUE',Z3/ * ' REPEAT COUNT WILL BE IGNORED.'/) ERRCT = ERRCT + 1 GOTO 90 30 CONTINUE C --- ORDINARY CHUNK: I = 1 CHUNK(I) = C C --- ASSEMBLE CHUNK: 35 CONTINUE IF (CHUNK(I).GE.CZERO .AND. CHUNK(I).LE.CO) GOTO 40 C --- IMPROPER CHARACTER: WRITE (CONTRL,17100) INCT,INPT,CHUNK(I) 17100 FORMAT ('+IMPROPER CHARACTER AT INPUT LINE',I6,', COLUMN', * I4,': HEX VALUE',Z3/ * ' CHARACTER WILL BE IGNORED.'/) ERRCT = ERRCT + 1 GOTO 45 40 CONTINUE CHUNK(I) = CHUNK(I) - CZERO I = I + 1 45 CONTINUE C --- GET NEXT CHARACTER, IF NECESSARY: IF (I.GT.4) GOTO 50 CALL RDCHAR(CHUNK(I),INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) IF (ZEND) GOTO 120 GOTO 35 50 CONTINUE C --- CHUNK COMPLETE; COMBINE BITS: BYTES(1) = IOR(ISHFT(CHUNK(1),2),ISHFT(CHUNK(2),-4)) BYTES(2) = IAND(IOR(ISHFT(CHUNK(2),4),ISHFT(CHUNK(3),-2)),RBYTE) BYTES(3) = IAND(IOR(ISHFT(CHUNK(3),6),CHUNK(4)),RBYTE) C --- OUTPUT 3 BYTES: DO 55 I=1,3 CALL PUTBYT(BYTES(I),OUTPUT,OUTCT,OUTBYT,OUTPT,CONTRL,ZEND) IF (ZEND) GOTO 140 55 CONTINUE 90 CONTINUE C --- LOOP FOR NEXT CHAR: GOTO 10 100 CONTINUE C --- END OF FILE WITHIN REPEAT SPEC: WRITE (CONTRL,17200) 17200 FORMAT (' INPUT FILE TERMINATED WITHIN NULL REPEAT.', * ' SPECIFICATION.'/) ERRCT = ERRCT + 1 GOTO 200 120 CONTINUE C --- END OF FILE WITHIN CHUNK: WRITE (CONTRL,17300) 17300 FORMAT (' INPUT FILE TERMINATED WITHIN CHUNK.'/) ERRCT = ERRCT + 1 GOTO 200 140 CONTINUE C --- ERROR ON WRITING TO OUTPUT FILE: WRITE (CONTRL,17400) 17400 FORMAT (/' ERROR ON WRITING TO OUTPUT FILE.'/) ERRCT = ERRCT + 1 200 CONTINUE C --- END OF FILE; FLUSH OUTPUT BUFFER BY PADDING WITH NULLS: CALL FLSHBO(OUTPUT,OUTCT,OUTPT,CONTRL,ZEND) WRITE (CONTRL,19000) NAME,INCT,INCHAR,OUTCT,OUTBYT,BLKCT,NULLCT, * ERRCT 19000 FORMAT (///' Name of originating file was: ',12A1 * /' Number of input lines :',I9, * '; number of input chars:',I9 * /' Number of output sectors:',I9, * '; number of output bytes:',I9 * /' Number of blanks read :',I9, * '; number of nulls :',I9 * /' Number of errors :',I9/) IF (ERRCT.GT.0) WRITE (CONTRL,19100) BELL 19100 FORMAT (' OUTPUT FILE MAY BE INCORRECT.',A1/) 210 CONTINUE STOP END C C SUBROUTINE RDCHAR(C,INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) C C GET A NON-BLANK CHARACTER FROM INPUT; RETURN AS C(1). C IF END OF FILE, RETURN ZEND = .TRUE. C UPDATE LINES READ (INCT), CHARS READ (INCHAR), POINTER TO INPUT LINE C (INPT), NUMBER OF BLANKS READ (BLKCT). C C CALL RDINI FIRST FOR INITIALISATION. C C WILL RETURN ORIGINAL FILE NAME IN C(1)..C(12) C IMPLICIT INTEGER*4 (A-Z) LOGICAL ZEND DIMENSION C(1),INBUFF(19) C PSEUDO-CHARACTER BLANK: DATA CBLANK/32/ C C --- MAKE SURE WE'RE NOT CALLED AFTER END OF FILE: C(1) = 0 C IF (ZFOUND) GOTO 90 10 CONTINUE IF (INPT.GE.BUFLG) GOTO 30 C --- SIMPLY GET FROM BUFFER: INPT = INPT + 1 CALL EXTRCH(C(1),INBUFF,INPT) C --- IS C BLANK? IF (C(1).NE.CBLANK) GOTO 90 C --- YES, TRY AGAIN: BLKCT = BLKCT + 1 GOTO 10 30 CONTINUE C --- BUFFER EMPTY; READ NEXT LINE: INPT = 0 INCT = INCT + 1 C --- REPORT PROGRESS ON CONTRL FROM TIME TO TIME: IF (MOD(INCT,64).EQ.0) WRITE (CONTRL,13000) INCT 13000 FORMAT ('+line',I9) C --- ADAPT IF NECESSARY; SET BUFLG TO ACTUAL NUMBER OF CHARS READ, IF KNOWN: READ (INPUT,20000,END=15) INBUFF 20000 FORMAT (19A4) BUFLG = 76 GOTO 10 15 CONTINUE C --- END OF FILE; SORRY, NO MORE CHARS: C(1) = 0 ZEND = .TRUE. GOTO 90 C C --- ENTRY RDINI: C ENTRY RDINI(C,INPUT,INCT,INCHAR,INPT,BLKCT,CONTRL,ZEND) C INCT = 0 INCHAR = -1 INPT = 0 BLKCT = 0 DO 55 I=1,12 55 C(I) = CBLANK C --- ALL INITIALIZATIONS FOR READING THE INPUT FILE GO HERE: C .................. C --- READ FIRST LINE, WHICH WILL CONTAIN ORIGINAL FILE NAME: C --- ADAPT IF NECESSARY; SET BUFLG TO NUMBER OF CHARS ACTUALLY READ: READ (INPUT,20000,END=70) INBUFF BUFLG = 76 IF (BUFLG.GT.12) BUFLG = 12 C --- WRITE NAME LEFT-JUSTIFIED INTO ARRAY C, ONE CHAR PER ELEMENT: DO 60 I=1,BUFLG CALL EXTRCH(C(I),INBUFF,I) C(I) = ISHFT(C(I),24) 60 CONTINUE C --- ADAPT IF NECESSARY; SET BUFLG TO NUMBER OF CHARS ACTUALLY READ: READ (INPUT,20000,END=65) INBUFF BUFLG = 76 GOTO 90 65 CONTINUE ZEND = .TRUE. GOTO 90 70 CONTINUE C --- EMPTY INPUT FILE: ZEND = .TRUE. WRITE (CONTRL,17500) 17500 FORMAT (/' EMPTY INPUT FILE.'/) 90 CONTINUE INCHAR = INCHAR + 1 RETURN END C C SUBROUTINE PUTBYT(BYTE,OUTPUT,OUTCT,OUTBYT,OUTPT,CONTRL,ZEND) C C OUTPUTS ONE BYTE, UPDATES COUNT OF SECTORS (OUTCT), COUNT OF OUTPUT C BYTES (OUTBYT) (EVEN IF THAT'S NEARLY REDUNDANT...); AND POINTER C INTO OUTPUT BUFFER (OUTPT). C ENTRY FLSHBO MUST BE CALLED TO FINISH OFF. C IMPLICIT INTEGER*4 (A-Z) LOGICAL ZEND DIMENSION SECTOR(64),UFT(5) C LBIT IS GOING TO BE A VARIABLE WITH ONLY THE LEFT-MOST BIT SET; C UNFORTUNATELY, ON MANY COMPILERS SUCH A VALUE CANNOT BE SPECIFIED C WITHOUT SUBTERFUGE. HENCE, WE INITIALIZE RBIT TO 1 AND LATER SET C LBIT TO RBIT, SHIFTED LEFT BY 31 POSITIONS. (IF YOU USE INTEGER*2 C VARIABLES, YOU WILL WANT TO CHANGE THAT TO 15 POSITIONS.) C IF YOUR MACHINE DOESN'T USE TWO'S COMPLEMENT, YOU HAVE TO START C THINKING YOURSELF: DATA RBIT/1/ DATA NULL/0/ C --- SECLEN IS NUMBER OF BYTES IN A TYPICAL, FIXED-LENGTH BINARY RECORD: C IT CORRESPONDS TO LENGTH OF ARRAY SECTOR MEASURED IN BYTES; C OPTION IS NEEDED FOR MODCOMP ONLY: DATA SECLEN/256/, OPTION/36864/ C C --- NOW SET LBIT TO WHAT IT ALWAYS SHOULD HAVE BEEN: LBIT = ISHFT(RBIT,31) IF (OUTPT.LT.SECLEN) GOTO 20 C --- OUTPUT BUFFER IS FULL; WRITE A BINARY RECORD: IF (OUTCT.NE.0) GOTO 10 C --- ON FIRST CALL, INITIALIZE OUTPUT FILE FOR WRITING BINARY RECORDS; C WRITING MUST BE UNDISTURBED BY ANY CONTROL CHARACTERS. C --- ON MODCOMP, THAT MEANS INITIALIZING A UFT; REPLACE WITH WHATEVER C YOU NEED: CALL BLDUFT(UFT,0,ICAN4(OUTPUT),OPTION) 10 CONTINUE C --- DO A BINARY WRITE OF SECLEN BYTES = ONE RECORD: C AGAIN, REPLACE WITH WHATEVER YOU NEED. MAYBE A PLAIN WRITE WITH C FORMAT (64A4) WILL DO FOR YOU. CALL WRITE4(UFT,SECTOR,SECLEN) C --- CHECK FOR ERROR CONDITION; ADAPT OR OMIT: IF (IAND(UFT(1),LBIT).NE.0) GOTO 80 OUTCT = OUTCT + 1 OUTPT = 0 20 CONTINUE C --- MOVE BYTE TO OUTPUT BUFFER: OUTBYT = OUTBYT + 1 OUTPT = OUTPT + 1 CALL INSRCH(BYTE,SECTOR,OUTPT) GOTO 90 C C --- ENTRY FLSHBO: C ENTRY FLSHBO(OUTPUT,OUTCT,OUTPT,CONTRL,ZEND) C IF (OUTCT.NE.0) GOTO 25 C --- JUST TO MAKE SURE, IF THE FILE WAS VERY SHORT: C --- ANOTHER COPY OF THE INITIALIZATION STATEMENTS; CF. ABOVE: CALL BLDUFT(UFT,0,ICAN4(OUTPUT),OPTION) 25 CONTINUE IF (OUTPT.EQ.SECLEN) GOTO 40 C --- PAD WITH NULLS: IMAX = SECLEN - OUTPT DO 30 I=1,IMAX CALL INSRCH(NULL,SECTOR,OUTPT+I) 30 CONTINUE OUTPT = SECLEN 40 CONTINUE C --- BINARY WRITE OF SECLEN BYTES = ONE RECORD; ADAPT IF NECESSARY C (CF. ABOVE). CALL WRITE4(UFT,SECTOR,SECLEN) C --- CHECK FOR ERROR CONDITION; ADAPT OR OMIT: IF (IAND(UFT(1),LBIT).NE.0) GOTO 80 OUTCT = OUTCT + 1 OUTPT = 0 C --- CLOSE OUTPUT FILE IN AN ORDERLY FASHION: ENDFILE OUTPUT GOTO 90 80 CONTINUE WRITE (CONTRL,13700) 13700 FORMAT (/' ERROR ON WRITING TO OUTPUT FILE.'/) ZEND = .TRUE. 90 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 IMPLICIT INTEGER*4 (A-Z) DIMENSION BUFFER(1) C THE LAST 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 IMPLICIT INTEGER*4 (A-Z) DIMENSION BUFFER(1) C A VARIABLE WITH EACH AND EVERY BIT SET; IF YOUR MACHINE DOESN'T USE C TWO'S COMPLEMENT, YOU GOT TO DO SOME MORE THINKING: 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