Program ViewPak;
// Ce logiciel est un logiciel libre, distribue sous licence GNU
//   Copyright (C) H. LESOURD, 1994

Uses
    Crt,Errorify,Lexify,Writify,Assemblify;

Procedure WriteHeader(Var H : Header);
Var
   SP : ^String;
Begin
  Writeln('C0=',H.C0);
  Writeln('#CS=',H.SizCode);
  Writeln('Ofs(Start)=',H.OfsStart);
  Writeln('#DS=',H.SizData);
  Writeln('#Imports=',H.SizImports);
  Writeln('CS=',H.CS);
  Writeln('DS=',H.DS);
  SP:=@H;SP:=@SP^[SizeOf(H)];
  Writeln('Name=',SP^);
End;

Procedure WriteTagType(TagType : Word);
Begin
  Case TagType Of
    PredBoolean: Write('BOOL');
    PredChar: Write('CHAR');
    PredByte: Write('BYTE');
    PredShortInt: Write('SINT');
    PredWord: Write('WORD');
    PredInt: Write('INT');
    PredLongWord: Write('LWRD');
    PredLongInt: Write('LINT');
    PredPointer: Write('PTR');
    PredReference: Write('REF');
    ValTVRef: Write('REF');
    ValTVPtr: Write('PTR');
    ValTVArray: Write('ARR');
    ValTVRecord: Write('REC');
    ValTVSub: Write('SUB');
    ValTVDef: Write('DEF');
    ValTVType: Write('TYPE');
    ValTVConst: Write('CONST');
  End;
End;

Type
    WString=Array[0..$7FFE] Of Word;
    StringPtr=^String;

Procedure WriteType(B : StringPtr);
Var
   WPtr : ^WString;
   Fini : Boolean;
   TheEndPtr : StringPtr;
   LenType,N : Byte;
Begin
  Fini:=False;
  LenType:=Ord(B^[0]);
  B:=@B^[1];
  While Not Fini Do
  Begin
    Write('(');
    WriteTagType(Ord(B^[0]));
    If (Ord(B^[0])=ValTVSub) Or (Ord(B^[0])=ValTVDef) Then
      Begin
        Write(')');
        TheEndPtr:=@B^[LenType];
        B:=@B^[1];
        While B<>TheEndPtr Do
        Begin
          WriteType(B);
          B:=@B^[Ord(B^[0])+1];
        End;
        Fini:=True;
      End
    Else
      Begin
        Write(' ');
        WPtr:=@B^[1];
        WriteInt(WPtr^[0],16);
        Case Ord(B^[0]) Of
          ValTVRecord:
            Begin
              Write(' ');
              N:=WPtr^[1];
              WriteInt(WPtr^[1],16);
              Write(')');
              TheEndPtr:=@B^[LenType];
              B:=@WPtr^[2];
              While N<>0 Do
              Begin
              { Affichage nom du champ }
                Write('[',B^,',');
                B:=@B^[Ord(B^[0])+1];
              { Affichage type }
                WriteType(B);
                B:=@B^[Ord(B^[0])+1];
                Write(']');
                Dec(N);
              End;
              Fini:=True;
            End;
          ValTVArray:
            Begin
              Write(' ');
              WriteInt(WPtr^[1],16);
              Write(' ');
              WriteInt(WPtr^[2],16);
              B:=@WPtr^[3];
            End;
          ValTVPtr,ValTVRef:
            Begin
              B:=@WPtr^[1];
            End;
          Else
            Fini:=True;
        End;
        Write(')');
      End;
  End;
End;

Function WriteSigma(B : StringPtr) : Pointer;
Var
   LenT : Word;
   WP : ^Word;
Begin
  Write(B^,',');
  LenT:=Ord(B^[Ord(B^[0])+1]);
  WriteType(@B^[Ord(B^[0])+1]);
  WP:=@B^[Ord(B^[0])+2+LenT];
  Write(',');
  WriteInt(WP^,16);
  B:=Pointer(WP);
  WriteSigma:=@B^[SizeOf(WP^)];
End;

Type
    WordPtr=^Word;

Procedure WritePak(S : String);
Type
    Segment=Array[0..$FFFE] Of Byte;
Var
   SP : StringPtr;
   F : File;
   H : HeaderPtr;
   Buf : Array[0..1023] Of Byte;
   TheEndPtr,TEP2 : Pointer;
   CS : ^Segment;
   Ptr,Padder : Word;
   PadBuf : Array[0..$F] Of Byte;
Begin
  S:=Concat(S,'.Pak');
{ Open }
  Assign(F,S);
  Reset(F,1);
{ C0,Header }
  H:=@Buf;
  BlockRead(F,H^.C0,SizeOf(H^.C0));
  SP:=@Buf[SizeOf(H^.C0)];
  Padder:=H^.C0+2;
  If Padder Mod 16<>0 Then Padder:=16-(Padder Mod 16) Else Padder:=0;
  BlockRead(F,SP^,H^.C0+Padder);
  WriteHeader(H^);
{ Exports }
  TheEndPtr:=@Buf[H^.C0+2];
  SP:=@Buf[SizeOf(H^)];
  SP:=@SP^[Ord(SP^[0])+1];
  While SP<>TheEndPtr Do
  Begin
    SP:=WriteSigma(SP);
    Writeln;
  End;
{ Code }
  Ptr:=0;
  CS:=TheEndPtr;
  BlockRead(F,SP^,H^.SizCode);
  While Ptr<>H^.SizCode Do
  Begin
    WriteInt(CS^[Ptr],16);
    Write(' ');
    Inc(Ptr);
    If Ptr Mod $10=0 Then Writeln;
  End;
  If Ptr Mod $10<>0 Then Writeln;
{ Imports }
{$R-}
  SP:=@SP^[H^.SizCode];
{$R+}
  BlockRead(F,SP^,H^.SizImports);
  TheEndPtr:=@SP^[H^.SizImports];
  While SP<>TheEndPtr Do
  Begin
  { Nom du module }
    Write(SP^,' ');
    SP:=@SP^[Ord(SP^[0])+1];
  { #Sigmas }
    WriteInt(WordPtr(SP)^,16);
    Writeln;
    TEP2:=@SP^[WordPtr(SP)^+2];
    SP:=@SP^[2];
    While SP<>TEP2 Do
    Begin
      Write('  ');
      SP:=WriteSigma(SP);
      Write(' ');
      WriteInt(WordPtr(SP)^,16);
      Writeln;
      SP:=@SP^[2];
    End;
  End;
{ Close }
  Close(F);
End;

Begin
  ClrScr;
  WritePak('QSORT');
  WaitingForAKey;
End.
