/* - REFORMAT SASEIS EDR TAPE - 00000010 75-4-14 00000020 00000030 00000040 EDRFMT READS A SASEIS EDR TAPE WRITTEN ON A UNIVAC 1108 00000050 AND CONVERTS THE DATA TO A IBM 370 DATASET (FIXED BLOCK, 00000060 LOGICAL RECORD LENGTH = 80). 00000070 00000080 THE UNIVAC 1108 TAPE IS FIXED BLOCK WITH BLKSIZE=1344, 00000090 TRTCH = ET. EACH LOGICAL RECORD IS OF VARIABLE LENGTH AND 00000100 IS PRECEEDED BY A 6 BYTE WORD THAT CONTAINS THE LENGTH OF THE 00000110 LOGICAL RECORD AND GIVES ITS TYPE (SEE FUNCTION LNGTH). 00000120 TO READ THIS DATA EASILY ON AN IBM 370 SYSTEM THE DATA 00000130 MUST BE REFORMATED SINCE IBM EXPECTS A 4 BYTE WORD GIVING THE 00000140 LOGICAL RECORD LENGTH. 00000150 00000160 DD CARD FOR EDRIN IS: 00000170 //G.EDRIN DD UNIT=TAPE7,VOL=SER=000678,DISP=OLD, 00000180 LABEL=(1,NL),DCB=(RECFM=U,BLKSIZE=1344,DEN=2,TRTCH=ET) 00000190 00000200 AUTHOR: KEN ANDERSON, M. I. T. 00000210 */ 00000220 EDRFMT: PROC OPTIONS (MAIN); 00000230 00000240 DCL BLOCK CHAR(1344) VAR; 00000250 DCL BLOCK_NUM FIXED BIN INIT(0); 00000260 DCL FILE_OPEN BIT(1) INIT('1'B); 00000270 00000280 ON TRANSMIT (EDRIN) BEGIN; 00000290 PUT SKIP(2) LIST ('EDRFMT: TRANSMIT CONTITION RAISED') 00000300 FILE (SYSPRINT); 00000310 CALL DUMP (BLOCK,BLOCK_NUM); 00000320 END; 00000330 00000340 ON ENDFILE (EDRIN) BEGIN; 00000350 PUT SKIP FILE(SYSPRINT) EDIT 00000360 ('END OF FILE',BLOCK_NUM,' BLOCKS READ IN') (A,F(5),A); 00000370 STOP; 00000380 END; 00000390 00000400 ON CONDITION (GRONK) BEGIN; 00000410 CALL DUMP(BLOCK,BLOCK_NUM); 00000420 STOP; 00000430 END; 00000440 00000450 DO WHILE (FILE_OPEN); 00000460 /* GET NEXT BLOCK AND BREAK IT UP INTO 80 CHAR. RECORDS */ 00000470 BLOCK_NUM = BLOCK_NUM + 1; 00000480 READ FILE(EDRIN) INTO (BLOCK); 00000490 /* CALL DUMP (BLOCK,BLOCK_NUM); */ 00000500 00000510 CALL BREAK (BLOCK,BLOCK_NUM,FILE_OPEN); 00000520 END; 00000530 00000540 00000550 DUMP: PROC (BLOCK,BLOCK_NUM); 00000560 /* 00000570 00000580 DUMP PRINTS A COPY OF A BLOCK ON SYSPRINT IN A FORMAT 00000590 SIMILAR TO THAT OF XTAPEDMP. 00000600 00000610 */ 00000620 DCL BLOCK CHAR(1344) VAR, BLOCK_NUM FIXED BIN; 00000630 DCL (REST, PTR, LINE_LENGTH) FIXED BIN; 00000640 00000650 PTR = 1; 00000660 REST = LENGTH(BLOCK); 00000670 PUT SKIP EDIT ('BLOCK ',BLOCK_NUM,' LENGTH ',REST) 00000680 (A,F(5),A,F(5)) FILE(SYSPRINT); 00000690 00000700 DO WHILE (PTR < REST); 00000710 LINE_LENGTH = MIN(32,REST-PTR+1); 00000720 PUT SKIP FILE (SYSPRINT) EDIT 00000730 (PTR,'*',SUBSTR(BLOCK,PTR,LINE_LENGTH),'*') 00000740 (F(5),A(1),A,A(1)); 00000750 PTR = PTR + LINE_LENGTH; 00000760 END; 00000770 END DUMP; 00000780 00000790 00000800 BREAK: PROC(BLOCK,BLOCK_NUM,FILE_OPEN); 00000810 /* 75-5-16 00000820 00000830 BREAK TAKES A BLOCK (PHYSICAL RECORD) FROM A UNIVAC 1108 00000840 TAPE AND BREAKS IT UP INTO LOGICAL RECORDS WHICH ARE PUT OUT 00000850 IN FIXED BLOCK LRECL=80 FORMAT. 00000860 EACH LOGICAL RECORD CONSISTS OF A 6 CHARACTER HEADER 00000870 FOLLOWED BY THE ACTUAL DATA RECORD. ONLY THE 00000880 FIRST CHARACTERS OF THE HEADER ARE USED, THEY INDICATE: 00000890 00000900 TYPE - THE TYPE OF RECORD (TAPE LABEL, END OF FILE OR 00000910 DATA) 00000920 LRECL - THE LOGICAL RECORD LENGTH (IN 6 BYTE WORDS) 00000930 LAST_LRECL - THE LOGICAL RECORD LENGTH OF THE PREVIOUS 00000940 RECORD 00000950 C - THE CHARACTER 'C' 00000960 00000970 */ 00000980 00000990 DCL BLOCK CHAR(1344) VAR; 00001000 DCL CARD CHAR(80) VAR STATIC ; 00001010 DCL BLOCK_NUM FIXED BIN; 00001020 DCL HEADER CHAR(4), TYPE CHAR(1) DEF HEADER POS(1), 00001030 LRECL CHAR(1) DEF HEADER POS(2), 00001040 LAST_LRECL CHAR(1) DEF HEADER POS(3), 00001050 C CHAR(1) DEF HEADER POS(4); 00001060 DCL FILE_OPEN BIT(1); 00001070 DCL CONTINUE INIT('0'B) BIT(1) STATIC; 00001080 DCL (OLD_LRECL INIT('(') STATIC, DATA INIT('"'), TAPE_LABEL 00001090 INIT('*')) CHAR(1); 00001100 DCL (PTR,BLOCK_LENGTH) FIXED BIN; 00001110 DCL (CARD_LENGTH, RECORD_LENGTH INIT(0)) FIXED BIN STATIC; 00001120 DCL IAND FIXED BIN; 00001130 DCL (LABEL_LENGTH INIT(12), HEADER_LENGTH INIT(6)) FIXED BIN; 00001140 00001150 BLOCK_LENGTH = LENGTH(BLOCK); 00001160 PTR = 1; 00001170 00001180 /* IF THIS CARD IS CONTINUED FROM LAST BLOCK CONCATENATE 00001190 AND OUTPUT IT */ 00001200 IF CONTINUE 00001210 THEN DO; 00001220 CARD = CARD || SUBSTR(BLOCK,PTR,CARD_LENGTH); 00001230 IF RECORD_LENGTH = 66 THEN DO; 00001240 /* TRY TO CONVERT '&' TO '+' */ 00001250 IAND = INDEX(CARD,'&'); 00001260 IF IAND > 0 THEN SUBSTR (CARD,IAND,1) = '+'; 00001270 END; 00001280 00001290 PUT FILE (EDROUT) EDIT (CARD) (A(80)); 00001300 PUT SKIP FILE(SYSPRINT) EDIT (CARD) (A(80)); 00001310 CONTINUE = '0'B; 00001320 PTR = PTR + CARD_LENGTH; 00001330 END; 00001340 00001350 /* LOOP OVER THE REST OF THE BLOCK */ 00001360 DO WHILE ( PTR < BLOCK_LENGTH); 00001370 HEADER = SUBSTR(BLOCK,PTR,4); 00001380 00001390 /* TAKE APPROPRIATE ACTION FOR TYPE OF RECORD */ 00001400 IF TYPE = DATA 00001410 THEN DO; 00001420 00001430 /* CHECK THAT HEADER IS IN RIGHT FORMAT */ 00001440 IF OLD_LRECL ^= LAST_LRECL | C ^= 'C' THEN DO; 00001450 PUT SKIP FILE(SYSPRINT) EDIT 00001460 ('BREAK: BUG - INVALID HEADER FORMAT AT', PTR) (A,F(5)); 00001470 SIGNAL CONDITION (GRONK); 00001480 END; 00001490 00001500 OLD_LRECL = LRECL; 00001510 PTR = PTR + HEADER_LENGTH; 00001520 RECORD_LENGTH = LNGTH(LRECL); 00001530 CARD_LENGTH = MIN(RECORD_LENGTH, 00001540 BLOCK_LENGTH-PTR+1); 00001550 00001560 CARD = SUBSTR(BLOCK,PTR,CARD_LENGTH); 00001570 00001580 IF RECORD_LENGTH = 66 THEN DO; 00001590 /* TRY TO CONVERT '&' TO '+' */ 00001600 IAND = INDEX(CARD,'&'); 00001610 IF IAND > 0 THEN SUBSTR(CARD,IAND,1) = '+';00001620 END; 00001630 00001640 IF CARD_LENGTH = RECORD_LENGTH THEN DO; 00001650 PUT FILE (EDROUT) EDIT (CARD) (A(80)); 00001660 PUT SKIP FILE(SYSPRINT) EDIT (CARD) 00001670 (A(80)); 00001680 PTR = PTR + CARD_LENGTH; 00001690 END; 00001700 00001710 ELSE DO; 00001720 /* CARD CONTINUED ON NEXT BLOCK */ 00001730 CONTINUE = '1'B; 00001740 CARD_LENGTH = RECORD_LENGTH - 00001750 CARD_LENGTH; 00001760 RETURN; 00001770 END; 00001780 END; 00001790 00001800 /* IF THIS IS TAPE LABEL, SKIP OVER IT */ 00001810 ELSE IF TYPE = TAPE_LABEL THEN PTR = PTR + LABEL_LENGTH; 00001820 00001830 /* IF END OF FILE, STOP */ 00001840 ELSE IF UNSPEC(TYPE) = '11100000'B THEN DO; 00001850 SIGNAL ENDFILE (EDRIN); 00001860 END; 00001870 00001880 ELSE DO; 00001890 PUT SKIP(2) FILE (SYSPRINT) EDIT 00001900 ('BREAK: BUG - INVALID LOGICAL RECORD TYPE = ', 00001910 TYPE,' = ',UNSPEC(TYPE),' AT', PTR) 00001920 (A,A(1),A,B(8),A,F(5)); 00001930 SIGNAL CONDITION (GRONK); 00001940 END; 00001950 END; 00001960 RETURN; 00001970 00001980 00001990 LNGTH: PROC (LRECL) RETURNS (FIXED BIN); 00002000 /* 75-4-8 00002010 00002020 LNGTH RETURNS THE LENGTH (IN BYTES) OF THE DATA RECORD 00002030 WITH LRECL AS ITS RECORD LENGTH CHARACTER. 00002040 */ 00002050 00002060 DCL LRECL CHAR(1); 00002070 DCL CODE(9) INIT('G','F','H','D','A','|','E','B','^') CHAR(1); 00002080 DCL VALUE(9) INIT(72,66,78,54,36,18,60,42,24) FIXED BIN; 00002090 00002100 DO I = 1 TO 9; 00002110 IF LRECL = CODE(I) THEN RETURN (VALUE(I)); 00002120 END; 00002130 00002140 PUT SKIP(2) FILE(SYSPRINT) EDIT 00002150 ('LNGTH: BUG - STRANGE CHARACTER CODE = ', 00002160 LRECL,' = ',UNSPEC(LRECL),' AT ',PTR) (A,A(1),A,B(8),A,F(5));00002170 SIGNAL CONDITION (GRONK); 00002180 END LNGTH; 00002190 END BREAK; 00002200 END EDRFMT; 00002210