$ SET LINEINFO 00000100 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00001000 %% SRCE/MISC/B5500/BIC2EBCDIC %%00001100 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00001200 % CONVERTS 6-BIT BCL-CODED BINARY DATA FILES TO 8-BIT EBCDIC-CODED 00001300 % FILES, SPECIFICALLY B5500 CODE FILES GENERATED BY ESPOLXEM. 00001400 % BCL INPUT FILE IS "DISK" AND OUTPUT EBCDIC FILE IS "TEXT". 00001500 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00010000 % 2013-03-10 P.KIMPEL 00010010 % ORIGINAL VERSION, CLONED PARTLY FROM ESPOLXEM SOURCE. 00010020 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00099900 00100000 BEGIN 00100100 00110000 INTEGER 00110100 BICRECSIZE, 00110200 BICRECWORDS, 00110300 BICBLOCKFACTOR, 00110400 TEXTRECSIZE, 00110500 TEXTRECWORDS; 00110600 00130000 ARRAY 00130100 BIC[0:29], 00130200 EBC[0:39]; 00130300 00160000 FILE 00160100 DISK(KIND=DISK, DEPENDENTSPECS, FILEUSE=IN), 00160200 TEXT(KIND=DISK, MAXRECSIZE=240, BLOCKSIZE=3600, FRAMESIZE=8, 00160300 AREAS=10, AREASIZE=1008, FLEXIBLE, FILEKIND=DATA); 00160400 00180000 TRANSLATETABLE 00180100 BICTOEBCDIC ( % 00180200 EBCDIC TO "?", 00180300 48"00" TO "0", % DIGIT-ZERO 00180400 48"01" TO "1", 00180500 48"02" TO "2", 00180600 48"03" TO "3", 00180700 48"04" TO "4", 00180800 48"05" TO "5", 00180900 48"06" TO "6", 00181000 48"07" TO "7", 00181100 48"08" TO "8", 00181200 48"09" TO "9", 00181300 48"0A" TO "#", 00181400 48"0B" TO "@", 00181500 48"0C" TO "?", 00181600 48"0D" TO ":", 00181700 48"0E" TO ">", 00181800 48"0F" TO "}", % GEQ 00181900 48"10" TO "+", 00182000 48"11" TO "A", 00182100 48"12" TO "B", 00182200 48"13" TO "C", 00182300 48"14" TO "D", 00182400 48"15" TO "E", 00182500 48"16" TO "F", 00182600 48"17" TO "G", 00182700 48"18" TO "H", 00182800 48"19" TO "I", 00182900 48"1A" TO ".", 00183000 48"1B" TO "[", 00183100 48"1C" TO "&", 00183200 48"1D" TO "(", 00183300 48"1E" TO "<", 00183400 48"1F" TO "~", % LEFT-ARROW 00183500 48"20" TO "|", % TIMES 00183600 48"21" TO "J", 00183700 48"22" TO "K", 00183800 48"23" TO "L", 00183900 48"24" TO "M", 00184000 48"25" TO "N", 00184100 48"26" TO "O", % LETTER-O 00184200 48"27" TO "P", 00184300 48"28" TO "Q", 00184400 48"29" TO "R", 00184500 48"2A" TO "$", 00184600 48"2B" TO "*", 00184700 48"2C" TO "-", 00184800 48"2D" TO ")", 00184900 48"2E" TO ";", 00185000 48"2F" TO "{", % LEQ 00185100 48"30" TO " ", % BLANK 00185200 48"31" TO "/", 00185300 48"32" TO "S", 00185400 48"33" TO "T", 00185500 48"34" TO "U", 00185600 48"35" TO "V", 00185700 48"36" TO "W", 00185800 48"37" TO "X", 00185900 48"38" TO "Y", 00186000 48"39" TO "Z", 00186100 48"3A" TO ",", 00186200 48"3B" TO "%", 00186300 48"3C" TO "!", % NEQ 00186400 48"3D" TO "=", 00186500 48"3E" TO "]", 00186600 48"3F" TO """); % QUOTE 00186700 00300000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00300100 PROCEDURE UNPACKBICTOEBCDIC(S, SX, D, DX, N); 00300200 VALUE SX, DX, N; 00300300 ARRAY S, D[0]; 00300400 REAL SX, DX, N; 00300500 BEGIN COMMENT 00300600 UNPACKS 6-BIT BIC CHARACTERS TO 8-BIT EBCDIC CHARACTERS FROM 00300700 ARRAY S TO ARRAY D. SX IS THE 6-BIT CHARACTER OFFSET INTO S AND 00300800 DX IS THE 8-BIT CHARACTER OFFSET INTO D. N IS THE NUMBER OF 00300900 CHARACTERS TO UNPACK. UNPACKING PROCEEDS IN A REVERSE DIRECTION 00301000 SO THAT SOURCE AND DESTINATION CAN REFER TO THE SAME LOCATION. 00301100 ; 00301200 REAL 00301300 NC, % NR CHARS LEFT TO UNPACK 00301400 SA, % SOURCE ACCUMULATOR WORD, 00301500 SB, % SOURCE BIT NBR 00301600 SW, % SOURCE WORD INDEX 00301700 DA, % DESTINATION ACCUMULATOR WORD 00301800 DB, % DESTINATION BIT NBR 00301900 DW; % DESTINATION WORD INDEX 00302000 00302100 SW:= (SX+N-1) DIV 8; 00302200 SB:= 47-((SX+N-1) MOD 8)*6; 00302300 DW:= (DX+N-1) DIV 6; 00302400 DB:= 47-((DX+N-1) MOD 6)*8; 00302500 SA:= S[SW]; 00302600 DA:= D[DW]; 00302700 NC:= N; 00302800 WHILE NC > 0 DO 00302900 BEGIN 00303000 DA:= * & (SA.[SB:6])[DB:8]; 00303100 NC:= *-1; 00303200 IF NC > 0 THEN 00303300 BEGIN 00303400 IF SB < 47 THEN 00303500 SB:= *+6 00303600 ELSE 00303700 BEGIN 00303800 SB:= 5; 00303900 SA:= S[SW:= *-1]; 00304000 END; 00304100 00304200 IF DB < 47 THEN 00304300 DB:= *+8 00304400 ELSE 00304500 BEGIN 00304600 D[DW]:= DA; 00304700 DB:= 7; 00304800 DA:= D[DW:= *-1]; 00304900 END; 00305000 END; 00305100 END WHILE; 00305200 00305300 D[DW]:= DA; 00305400 REPLACE POINTER(D[DX DIV 6],8)+(DX MOD 6) BY 00305500 POINTER(D[DX DIV 6],8)+(DX MOD 6) FOR N WITH BICTOEBCDIC; 00305600 END UNPACKBICTOEBCDIC; 00305700 00900000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%00900100 %% OUTER BLOCK 00900200 00900300 OPEN(DISK); 00900400 BICRECSIZE:= DISK.MAXRECSIZE; 00900500 BICBLOCKFACTOR:= DISK.BLOCKSIZE DIV BICRECSIZE; 00900600 BICRECWORDS:= (DISK.FRAMESIZE*BICRECSIZE + 47) DIV 48; 00900700 IF SIZE(BIC) < BICRECWORDS THEN 00900800 RESIZE(BIC, BICRECWORDS); 00900900 00901000 TEXTRECSIZE:= BICRECWORDS*8; 00901100 TEXTRECWORDS:= (TEXTRECSIZE + 5) DIV 6; 00901200 TEXT.MAXRECSIZE:= TEXTRECSIZE; 00901300 TEXT.BLOCKSIZE:= TEXTRECSIZE*BICBLOCKFACTOR; 00901400 TEXT.AREASIZE:= (BICBLOCKFACTOR+999) DIV BICBLOCKFACTOR; 00901500 IF SIZE(EBC) < TEXTRECWORDS THEN 00901600 RESIZE(EBC, TEXTRECWORDS); 00901700 00901800 WHILE NOT READ(DISK, BICRECSIZE, BIC) DO 00901900 BEGIN 00902000 UNPACKBICTOEBCDIC(BIC, 0, EBC, 0, TEXTRECSIZE); 00902100 WRITE(TEXT, TEXTRECSIZE, EBC); 00902200 END READ SOURCE; 00908800 00908900 CLOSE(TEXT, CRUNCH); 00909000 CLOSE(DISK); 00909100 00999800 END. 00999900