{$T-}
program OBJECT_BREAKER;
const HT=CHR(9); NL=CHR(10); CR=CHR(13); FF=CHR(12);
type BYTE=CHAR;
     RECORD=(NONE,GSD,EGSD,TXT,RLD,ISD,EOM);
     EXTENSION=array [0..4] of CHAR;
     SYMBOL=array [0..5] of CHAR;
var IDENT:INTEGER;
    BYTECOUNT:INTEGER;
    OBJ,LST:TEXT;
const OBJEXT=EXTENSION('.','O','B','J',' '); 
      LSTEXT=EXTENSION('.','L','S','T',' ');
  
  
function GETWORD: INTEGER;
var TEMP:INTEGER;
begin
  TEMP:=ORD(OBJ@); GET(OBJ);
  GETWORD:=ORD(OBJ@)*256+TEMP; GET(OBJ)
end; {GETWORD}
  
  
function GETBYTE: BYTE;
begin
  GETBYTE:=OBJ@; GET(OBJ)
end; {GETBYTE}
  
  
procedure OPEN_FILES;
var FILENAME: array [0..10] of CHAR;
    IDX,COUNT,INDEX:INTEGER;
    OBJTXT,LSTTXT:EXTENSION;
begin
  OBJTXT:=OBJEXT; LSTTXT:=LSTEXT;
  COUNT:=0; while COUNT<11 do begin
            FILENAME[COUNT]:=CHR(32); COUNT:=SUCC(COUNT) end;
  WRITE(OUT,NL,CR,'Enter up to six character object file name:');
  BREAK(OUT);
  COUNT:=0;
  GET(INP);
  while (COUNT<6) & (INP@#NL) do begin
    FILENAME[COUNT]:=INP@; GET(INP); COUNT:=SUCC(COUNT) end;
  INDEX:=0;
  while (INDEX<5) do begin
    IDX:=COUNT+INDEX;
    FILENAME[IDX]:=OBJTXT[INDEX]; INDEX:=SUCC(INDEX) end;
  RESET(OBJ,FILENAME);
  INDEX:=0;
  while (INDEX<5) do begin
    IDX:=COUNT+INDEX;
    FILENAME[IDX]:=LSTTXT[INDEX]; INDEX:=SUCC(INDEX) end;
  REWRITE(LST,FILENAME);
  WRITE(OUT,NL,CR,FILENAME,' being processed.',NL,CR);
  WRITE(LST,NL,CR,'Output for file ',FILENAME,NL,CR);
  BREAK(OUT)
end; {OPEN_FILES}
  
  
procedure WRITEOCTAL(I:INTEGER);
begin
  WRITE(LST,ORD(I<0):1,I/4096 mod 8:1,I/512 mod 8:1,
            I/64 mod 8:1, I/8 mod 8:1, I mod 8:1)
end; {WRITEOCTAL}

procedure INPUT_RAD50_NAME( var NAME:SYMBOL);
var HOLD,TEMP,GROUP,INDEX:INTEGER;
    CH:CHAR;
  
  
function ASCII(I:INTEGER): CHAR;
var TEMP:INTEGER;
begin
  TEMP:=I;
  if TEMP>29 then ASCII:=CHR(TEMP+18)
  else if TEMP=29 then ASCII:=CHR(32)
  else if TEMP=28 then ASCII:=CHR(46)
  else if TEMP=27 then ASCII:=CHR(36)
  else if TEMP>0 then ASCII:=CHR(TEMP+64)
  else ASCII:=CHR(32)
end; {ASCII}
  
  
function MOD(I,J:INTEGER):INTEGER;
var TEMP:INTEGER;
begin
  TEMP:=I div J;
  TEMP:=TEMP*J;
  MOD:=I-TEMP
end; {MOD}
  
  
begin {INPUT_RAD50_NAME starts here}
  INDEX:=0; GROUP:=0;
  while GROUP<2 do begin
    TEMP:=GETWORD;  {Get RAD50 word to break up}
    HOLD:=(TEMP/64) mod 1024;
    HOLD:=HOLD div 25;
    HOLD:=MOD(HOLD,40);
    CH:=ASCII(HOLD);
    NAME[INDEX]:=CH;
    INDEX:=SUCC(INDEX);
    HOLD:=HOLD*25;  HOLD:=HOLD*64;
    TEMP:=TEMP-HOLD;
    HOLD:=TEMP div 40;  HOLD:=MOD(HOLD,40);
    CH:=ASCII(HOLD);
    NAME[INDEX]:=CH;
    INDEX:=SUCC(INDEX);
    HOLD:=MOD(TEMP,40);
    CH:=ASCII(HOLD);
    NAME[INDEX]:=CH;
    INDEX:=SUCC(INDEX);
    GROUP:=SUCC(GROUP)
  end
end; {INPUT_RAD50_NAME}

procedure PROCESS_GSD;
type GSDTYPE=(MODULE,CONTROL,INTERNAL,TRANSFER,GLOBAL,SECTION,VERSION);
var RECTYPE:INTEGER;
    NAME:SYMBOL;
    FLAGS:BYTE;
    VALUE:INTEGER;
begin
  INPUT_RAD50_NAME(NAME);
  FLAGS:=GETBYTE;
  RECTYPE:=ORD(GETBYTE);
  VALUE:=GETWORD;
  
  case RECTYPE of
   0: WRITE(LST,NL,CR,'Module name ',NAME);
   1: begin WRITE(LST,NL,CR,'Control Section ',NAME,' is ');
                  WRITEOCTAL(VALUE); WRITE(LST,' bytes long.') end;
   2: WRITE(LST,NL,CR,'Internal Symbol ',NAME);
   3: begin WRITE(LST,NL,CR,'Transfer Address in Psect ',NAME);
                   WRITE(LST,' with offset of '); WRITEOCTAL(VALUE) end;
   4: begin WRITE(LST,NL,CR,'Global Symbol ',NAME);
                 if (ORD(FLAGS) mod 8 div 4)=1 then
                   WRITE(LST,' definition') else WRITE(LST,' reference');
                 if (ORD(FLAGS) mod 32 div 16)=1 then
                   WRITE(LST,' relative') else WRITE(LST,' absolute');
                 WRITE(LST,' offset by '); WRITEOCTAL(VALUE) end;
   5: begin WRITE(LST,NL,CR,'Psect ',NAME,' of length ');
                  WRITEOCTAL(VALUE); WRITE(LST,' with flags=');
                  WRITEOCTAL(ORD(FLAGS)) end;
   6: WRITE(LST,NL,CR,'Program Version ',NAME)
  end;
  BYTECOUNT:=BYTECOUNT-8
end; {PROCESS_GSD}
  
  
procedure PROCESS_TXT;
var CODE:INTEGER;
    COUNT:INTEGER;
begin
  CODE:=GETWORD;
  WRITE(LST,NL,CR,'Text information at ');
  WRITEOCTAL(CODE);
  BYTECOUNT:=BYTECOUNT-2;
  while BYTECOUNT>0 do begin
    COUNT:=0; WRITE(LST,NL,CR,HT);
    while (COUNT<8) & (BYTECOUNT>0) do begin
      CODE:=GETWORD; BYTECOUNT:=BYTECOUNT-2;
      WRITEOCTAL(CODE); WRITE(LST,'  ');
      COUNT:=SUCC(COUNT)
    end
  end;
  WRITE(LST,NL,CR)
end; {PROCESS_TXT}

procedure PROCESS_RLD;
type RELOCATION=(NONER,INTREL,GLOBREL,INTDISREL,GLOBDISREL,GLOBADDREL,
                 GLOBADDDISREL,LOCDEF,LOCMOD,LIMITS,PSECTREL,NOTUSED,
                 PSECTDISREL,PSECTADDREL,PSECTADDDISREL,COMPLEX);
var RECTYPE,DISP,TEMP,CONSTANT:INTEGER;
    NAME:SYMBOL;
    B:BOOLEAN;
begin
  TEMP:=GETWORD;  BYTECOUNT:=BYTECOUNT-2;
  RECTYPE:=TEMP mod 256;
  B:=(TEMP div 128 mod 2 = 1);
  DISP:=TEMP div 256;
  if (RECTYPE<ORD(INTREL)) ! (RECTYPE>ORD(COMPLEX)) then begin
    WRITE(OUT,NL,CR,'Relocation Directory Error. RECTYPE=');
    WRITE(OUT,RECTYPE) end
  else case RECTYPE of
    1,3,8: begin case RECTYPE of
      1:  WRITE(LST,NL,CR,'Internal Relocation of ');
      2:  WRITE(LST,NL,CR,'Internal Displaced Relocation of ');
      8:  WRITE(LST,NL,CR,'Location Counter Modification of ')
    end;
             WRITEOCTAL(DISP); WRITE(LST,' constant=');
             WRITEOCTAL(GETWORD); BYTECOUNT:=BYTECOUNT-2;
             if B then WRITE(LST,' byte value.') end;
    2,4,10,12: begin case RECTYPE of
      2: WRITE(LST,NL,CR,'Global Relocation of ');
      4: WRITE(LST,NL,CR,'Global Displaced Relocation of ');
     10: WRITE(LST,NL,CR,'P-Section Relocation of ');
     12: WRITE(LST,NL,CR,'P-Section Displaced Relocation of ')
    end;
             INPUT_RAD50_NAME(NAME); WRITE(LST,NAME,' by ');
             WRITEOCTAL(DISP); if B then WRITE(LST,' byte value.');
             BYTECOUNT:=BYTECOUNT-4 end;
    5,6,7,13,14: begin case RECTYPE of
      5: WRITE(LST,NL,CR,'Global Additive Relocation of ');
      6: WRITE(LST,NL,CR,'Global Additive Displaced Relocation of ');
      7: WRITE(LST,NL,CR,'Location Counter Definition of ');
     13: WRITE(LST,NL,CR,'P-Section Additive Relocation of ');
     14: WRITE(LST,NL,CR,'P-Section Additive Displaced Relocation of ')
    end;
             INPUT_RAD50_NAME(NAME); WRITE(LST,NAME,' by ');
             WRITEOCTAL(DISP); WRITE(LST,' constant=');
             WRITEOCTAL(GETWORD); if B then WRITE(LST,' byte value.');
             BYTECOUNT:=BYTECOUNT-6 end;
    9: begin WRITE(LST,NL,CR,'Program Limits at ');
             WRITEOCTAL(DISP) end;
   15: WRITE(LST,NL,CR,'I did not expect this...')
  end
end; {PROCESS_RLD}

begin {OBJECT_BREAKER starts here}
  OPEN_FILES; {Opens file.OBJ and file.LST}
  while ~EOF(OBJ) do begin
    BYTECOUNT:=GETWORD; {Using a special PASLIB to get this}
    IDENT:=GETWORD;     {Record type identification}
    WRITE(OUT,NL,CR,'Bytecount of ',BYTECOUNT,' Ident of ',IDENT);
    BREAK(OUT);
    if (IDENT<1) ! (IDENT>6) ! (BYTECOUNT<2) then begin
      WRITE(OUT,NL,CR,'Error at record level. IDENT=',IDENT);
      WRITE(OUT,' BYTECOUNT=',BYTECOUNT); BREAK(OUT) end
    else begin
      BYTECOUNT:=BYTECOUNT-2;
      case IDENT of
        1: while BYTECOUNT>0 do PROCESS_GSD;
        2: WRITE(LST,NL,CR,'End of Global Symbol Directory');
        3: PROCESS_TXT;
        4: while BYTECOUNT>0 do PROCESS_RLD;
        5: begin WRITE(LST,NL,CR,'Internal Symbol Directory Not Supported');
                   while BYTECOUNT>0 do begin
                     GET(OBJ); BYTECOUNT:=BYTECOUNT-1 end end;
        6: WRITE(LST,NL,CR,'End of Module')
      end end end;
  WRITE(OUT,NL,CR,'Processing is complete.',NL,CR); BREAK(OUT)
end.