⟦baa8deee5⟧

TextFile

(******************************************************************************)
(*                                                                            *)
(*    DUMP UTIILITY                                                           *)
(*                                                                            *)
(*    AUTHOR: LARS G JAKOBSEN                                                 *)
(*    DATE WRITTEN: 1985.01.21                                                *)
(*    DATE MODIFIED: 1985.02.01 Now allows dump to be output to either        *)
(*                              CON: or LST:.
(*                                                                            *)
(*    This utility will dump any CP/M file in hexadecal and ascii format.     *)
(*    In the ascii dump the following codes are used to indicate the 3 MSB:   *)
(*                                                                            *)
(*          ^ 000                                                             *)
(*            001                                                             *)
(*            010                                                             *)
(*          " 011                                                             *)
(*          < 100                                                             *)
(*          $ 101                                                             *)
(*          $ 110                                                             *)
(*          > 111                                                             *)
(*                                                                            *)
(******************************************************************************)

 PROGRAM dump;

   TYPE
      string_1 = string(.1.);
      string_2 = string(.2.);

   PROCEDURE do_dump(VAR oper_in: text
                    ;VAR oper_out: text
                    ;VAR print: text
                    );

      CONST
         hex_symbol: ARRAY(.0..15.) OF char = '0123456789ABCDEF';

      FUNCTION hex(i: byte
                  ): string_1;

        BEGIN
         hex := hex_symbol(. i mod 16 .)
        END;

      FUNCTION hex_2(i: byte
                    ): string_2;

        BEGIN
         hex_2 := hex_symbol(. i div 16 .) + hex_symbol(. i mod 16 .)
        END;

      FUNCTION ascii(i: byte
                    ): string_2;

         CONST
            prefix: ARRAY(.0..7.) OF char = '^  "<$$>';

        BEGIN
         CASE i div 32 OF
            0,3,4,7: ascii := prefix(. i div 32 .) + chr( 64 + (i mod 32) );
            1,2,5,6: ascii := prefix(. i div 32 .) + chr( i mod 128 );
         END
        END;


   TYPE
      wr_mode_base_type = (ascii_mode, hex_mode);

   VAR
      i_file_name: string(.14.);
      i_file: file;
      i_buffer: ARRAY(.0..255.) OF byte;
      rd_count: integer;
      wr_count: integer;
      wr_min,
      wr_max: integer;
      i,j,i_16,k: byte;
      wr_mode: SET OF wr_mode_base_type;
      wr_mode_string: string(.2.);

     BEGIN (* do_dump *)
      writeln(oper_out);
      write(oper_out, 'Enter file name (^C to exit): ');
      readln(oper_in, i_file_name);
      assign(i_file, i_file_name);
      reset(i_file);
      write(oper_out, 'Enter dump mode (A,H): ');
      wr_mode_string := '  ';
      readln(oper_in, wr_mode_string);
      wr_mode := (..);
      FOR i := 1 TO 2 DO
        BEGIN
         IF wr_mode_string(.i.) in (.'a','A'.) THEN
            wr_mode := wr_mode + (.ascii_mode.);
         IF wr_mode_string(.i.) in (.'h','H'.) THEN
            wr_mode := wr_mode + (.hex_mode.);
        END;
      wr_min := 0;
      wr_max := 32767;
      write(oper_out, 'Enter first block number: ');
      readln(oper_in, wr_min);
      write(oper_out, 'Enter last  block number: ');
      readln(oper_in, wr_max);
      writeln(oper_out);
      rd_count := -1;
      wr_count := -1;
      WHILE not eof(i_file) DO
        BEGIN
         blockread(i_file,i_buffer,1);
         IF not eof(i_file) THEN
            blockread(i_file,i_buffer(.128.),1)
         ELSE
            FOR k := 128 TO 255 DO
               i_buffer(.k.) := 0;
         rd_count := rd_count + 1;
         IF (wr_min <= rd_count) and (rd_count <= wr_max) THEN
           BEGIN
            wr_count := wr_count + 1;
            IF (wr_count mod 3 = 0) and (wr_count > 0) THEN
               write(print, ^L);
            IF (wr_count mod 3 = 0) THEN
               writeln(print, 'DUMPING FILE ', i_file_name:14 );
            writeln(print);
            writeln(print);
            writeln(print, 'BLOCK NO: ', rd_count:5, '  @ 256 BYTES.');
            writeln(print);
            FOR i := 0 TO 15 DO
              BEGIN
               write(print, hex(i), '  ' );
               i_16 := i * 16;
               IF hex_mode in wr_mode THEN
                 BEGIN
                  FOR j := 0 TO 15 DO
                     write(print, hex_2(i_buffer(.i_16 + j.)), ' ' );
                  write(print, '   ');
                 END;
               IF ascii_mode in wr_mode THEN
                  FOR j := 0 TO 15 DO
                     write(print, ascii( i_buffer(.i_16 + j.) ), ' ' );
               writeln(print);
              END;
           END;
        END;
      write(print, ^L);
      close(i_file);
     END; (*do_dump *)

   PROCEDURE dump_it(VAR oper_in, oper_out: text);

      VAR
         dev: string(.4.);
         print: text;

     BEGIN (* DUMP_IT *)
      writeln(oper_out, 'DUMP version 2.0 Copenhagen 1985.02.01.');
      write(oper_out, 'Enter output device: ');
      readln(oper_in, dev);
      assign(print, dev);
      rewrite(print);
      REPEAT
         do_dump(oper_in, oper_out, print);
      UNTIL false;
      close(print);
     END;  (* DUMP_IT *)

  BEGIN (* dump *)
   dump_it( input, output)
  END.  (* dump *)«eof»
DataMuseum.dk

Bogika Butler

⟦baa8deee5⟧ TextFile

Derivation

TextFile
