home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / naxos / source / dumpdic.pas next >
Encoding:
Pascal/Delphi Source File  |  1992-02-09  |  3.1 KB  |  116 lines
  1. {$A+,B-,D-,E-,F-,G-,I+,L-,N-,O-,R-,S+,V+,X-}
  2. {$M 16384,0,655360}
  3.  
  4. (*--------------------------------------------------------*)
  5. (*                      DUMPDIC.PAS                       *)
  6. (*         Dictionary-Dump für Naxos Version 1.01         *)
  7. (*          (C) 1992 DMV-Verlag & A. Zissis               *)
  8. (*             Compiler: Turbo Pascal 6.0                 *)
  9. (*--------------------------------------------------------*)
  10.  
  11. PROGRAM DumpDic;
  12. USES
  13.   Dos;
  14. TYPE
  15.   SymTab       = RECORD
  16.                    Name   : STRING[12];
  17.                    Typ    : BYTE;
  18.                    Qfa    : WORD;
  19.                    Par0,
  20.                    Par1,
  21.                    Par2,
  22.                    Par3   : WORD;
  23.                    QFALen : WORD;
  24.                  END;
  25.  
  26. VAR
  27.   Buf    : SymTab;
  28.   f, tf  : FILE ;
  29.   li, pc : WORD;
  30.   ZPtr   : WORD;
  31.   ch     : CHAR;
  32.  
  33. FUNCTION TypStr (nx: BYTE): STRING;
  34. VAR
  35.   n : STRING;
  36. BEGIN
  37.   Str(nx:3, n);
  38.   CASE nx OF
  39.     1 : n := 'VARIABLE';
  40.     2 : n := 'ARRAY';
  41.     3 : n := 'RECORD';
  42.     4 : n := 'FIELD';
  43.     5 : n := 'STRING';
  44.    10 : n := 'KONSTANTE';
  45.    11 : n := 'ADRESS-KONSTANTE';
  46.    12 : n := 'KOLON-DEFINITION';
  47.    13 : n := 'PROZEDUR';
  48.    14 : n := 'VEKTOR';
  49.    15 : n := 'DOUBLE-KONSTANTE';
  50.    16 : n := 'FLOAT-KONSTANTE';
  51.    ELSE IF nx > 127 THEN n := 'SYSTEM #' + n;
  52.   END;
  53.   TypStr := n;
  54. END;
  55.  
  56. BEGIN
  57.   WriteLn(^J'NAXOS Dictionary Dump V1.00');
  58.   WriteLn('(C) 1992 DMV-Verlag & A.Zissis');
  59.   IF Paramcount < 1 THEN BEGIN
  60.     WriteLn('Fehler: Name des Dictionaries muß '+
  61.             'angegeben werden!');
  62.   END ELSE BEGIN
  63.     WriteLn(ParamStr(1) + '.DIC');
  64.     WriteLn(^J);
  65.     Assign(f,  ParamStr(1) + '.DIC');
  66.     Assign(tf, ParamStr(1) + '.FTH');
  67.     IF ParamCount > 1 THEN
  68.       Assign(Output, ParamStr(1) + '.DMP');
  69.     ReWrite(Output);
  70.     Reset(f,  1);
  71.     Reset(tf, 1);
  72.     BlockRead(f,pc,2);
  73.     IF pc = 0 THEN
  74.       WriteLn('NAXOS V3.x Dictionary')
  75.     ELSE
  76.       WriteLn('NAXOS V2.x Dictionary, PC=', pc);
  77.     WriteLn;
  78.     IF ParamCount = 1 THEN BEGIN
  79.       WriteLn('Weiter mit Return');
  80.       ReadLn;
  81.     END;
  82.     li := 1;
  83.     REPEAT
  84.       BlockRead(f, Buf, SizeOf(Buf));
  85.       IF Buf.Name[0] > #127 THEN BEGIN
  86.         Buf.Name[0] := Chr($7F AND BYTE(Buf.Name[0]));
  87.         Write('SEALED ');
  88.       END;
  89.       WriteLn(Buf.Name,' : Typ=', TypStr(Buf.Typ));
  90.       WriteLn('PAR0=', Buf.Par0:5, '  PAR1=', Buf.Par1:5);
  91.       WriteLn('PAR2=', Buf.Par2:5, '  PAR3=', Buf.Par3:5);
  92.       WriteLn('QFA =', Buf.Qfa: 5, '  QFALEN=', Buf.QFALen);
  93.       WriteLn;
  94.       Seek(tf, Buf.Qfa);
  95.       IF Buf.Typ < 128 THEN
  96.       FOR ZPtr := 0 TO Buf.QFALen-1 DO BEGIN
  97.         BlockRead(tf, ch, 1);
  98.         Write(ch);
  99.       END;
  100.       WriteLn;
  101.       Inc(li);
  102.   (*  IF (li MOD 4 = 0) AND (Paramcount = 1) THEN BEGIN
  103.         WriteLn('Weiter mit Return');
  104.         ReadLn;
  105.       END;
  106.   *)
  107.     UNTIL EoF(f);
  108.     Close(f);
  109.     Close(tf);
  110.     Close(Output);
  111.     END;
  112. END.
  113.  
  114. (*--------------------------------------------------------*)
  115. (*                  Ende von DUMPDIC.PAS                  *)
  116.