github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-01-13 15:17:03 +00:00
Code Issues Releases Wiki Activity
retro-software.B5500-software/Unisys-Emode-Tools/BICTOEBCDIC.alg_m

185 lines
16 KiB
Plaintext
Raw Blame History

$ 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
Reference in New Issue View Git Blame Copy Permalink