home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / comp / os / cpm / 949 < prev    next >
Encoding:
Internet Message Format  |  1992-07-23  |  2.9 KB
  1. Path: sparky!uunet!caen!hellgate.utah.edu!cc.usu.edu!ivie
  2. From: ivie@cc.usu.edu (CP/M lives!)
  3. Newsgroups: comp.os.cpm
  4. Subject: PX-8 ROM generator 2/3: PXROM.PAS
  5. Message-ID: <1992Jul23.115839.57467@cc.usu.edu>
  6. Date: 23 Jul 92 11:58:39 MDT
  7. Organization: Utah State University
  8. Lines: 172
  9.  
  10. {$U+}
  11. Program Argh( Input, Output, InFile, ROMFile );
  12. Label 1, 2, 3, 4, 5, 999;
  13.  
  14. Var
  15.   Buffer : Array [ 0..127 ] of Byte;
  16.   InFile, ROMFile : File;
  17.  
  18. Procedure Read_ROM( Block_Number : Integer; Var Buffer );
  19. Begin
  20.   Seek( ROMFile, Block_Number );
  21.   BlockRead( ROMFile, Buffer, 1 );
  22. End;
  23.  
  24. Procedure Write_ROM( Block_Number : Integer; Var Buffer );
  25. Begin
  26.   Seek( ROMFile, Block_Number );
  27.   BlockWrite( ROMFile, Buffer, 1 );
  28. End;
  29.  
  30. {$I PXFS.PAS}
  31.  
  32. Procedure Init_ROM( Blocks : Integer );
  33. Begin
  34.   FillChar( Buffer, 128, $FF );
  35.   Seek( ROMFile, 0 );
  36.   While( Blocks > 0 ) Do
  37.   Begin
  38.     BlockWrite( ROMFile, Buffer, 1 );
  39.     Blocks := Blocks - 1;
  40.   End;
  41. End;
  42.  
  43. Type
  44.   File_Name = String[ 14 ];
  45.  
  46. Var
  47.   ROM_FCB : Memory_FCB;
  48.   Blocks : Integer;
  49.   X : Char;
  50.   Name : File_Name;
  51.  
  52. Procedure Build_FCB( Name : File_Name; Var FCB : Memory_FCB );
  53. Label 1, 2, 3, 4, 5, 6, 7, 8, 999;
  54. Var
  55.   NIX, FIX : Integer;
  56.  
  57. Begin
  58.  
  59. 1:
  60.   NIX := 1;
  61.   Goto 2;
  62.  
  63. 2:
  64.   FCB.DRV := 0;
  65.   FCB.EX := 0;
  66.   For FIX := 0 to 10 do
  67.     FCB.NAME[ FIX ] := ' ';
  68.   FIX := 0;
  69.  
  70. 3:
  71.   If( NIX > Ord( Name[ 0 ] ) ) Then Goto 999;
  72.   Goto 4;
  73.  
  74. 4:
  75.   If( Name[ NIX ] = ':' ) Then goto 5;
  76.   If( Name[ NIX ] = '.' ) Then Goto 6;
  77.   Goto 7;
  78.  
  79. 5:
  80.   NIX := NIX + 1;
  81.   Goto 2;
  82.  
  83. 6:
  84.   NIX := NIX + 1;
  85.   For FIX := 8 to 10 do
  86.     FCB.NAME[ FIX ] := ' ';
  87.   FIX := 8;
  88.   Goto 3;
  89.  
  90. 7:
  91.   If( FIX > 10 ) Then Goto 999;
  92.   Goto 8;
  93.  
  94. 8:
  95.   FCB.NAME[ FIX ] := Name[ NIX ];
  96.   FIX := FIX + 1;
  97.   NIX := NIX + 1;
  98.   Goto 3;
  99.  
  100. 999:
  101. End;
  102.  
  103. Procedure Copy_File( Name : File_Name );
  104. Label 1, 2, 3, 4, 5, 6, 999;
  105. Var
  106.   Recs_Read : Integer;
  107.  
  108. Begin
  109.  
  110. 1:
  111.   Assign( InFile, Name );
  112.   Reset( InFile );
  113.   Assign( ROMFile, 'ROM.DAT' );
  114.   Reset( ROMFile );
  115.   Goto 2;
  116.  
  117. 2:
  118.   Build_FCB( Name, ROM_FCB );
  119.   If( Make_File( ROM_FCB ) ) Then Goto 3;
  120.   Goto 6;
  121.  
  122. 3:
  123.   BlockRead( InFile, Buffer, 1, Recs_Read );
  124.   If( Recs_Read = 0 ) Then Goto 5;
  125.   Goto 4;
  126.  
  127. 4:
  128.   If( Write_Sequential( ROM_FCB, Buffer ) ) Then Goto 3;
  129.   Goto 5;
  130.  
  131. 5:
  132.   Close_File( ROM_FCB );
  133.   Goto 6;
  134.  
  135. 6:
  136.   Close( ROMFile );
  137.   Close( InFile );
  138.   Goto 999;
  139.  
  140. 999:
  141. End;
  142.  
  143. Begin
  144.  
  145.   Writeln( 'EPSON Geneva EPROM generator' );
  146. 1:
  147.   Write('PXRom> ');
  148.   Read( KBD, X );
  149.   If( ( X = 'I' ) or ( X = 'i' ) ) Then Goto 2;
  150.   If( X = Chr( 26 ) ) Then Goto 3;
  151.   IF( ( X = 'C' ) or ( X = 'c' ) ) Then Goto 4;
  152.   Goto 5;
  153.  
  154. 2:
  155.   Write('Init. Kbytes? ');
  156.   Readln( Blocks );
  157.   Assign( ROMFile, 'ROM.DAT' );
  158.   Rewrite( ROMFile );
  159.   Write( 'Initializing...' );
  160.   Init_ROM( Blocks * 8 );
  161.   Write( 'Zeroing...');
  162.   Zero_Directory( Blocks * 8, 32 );
  163.   Writeln;
  164.   Goto 1;
  165.  
  166. 3:
  167.   Writeln( '*EXIT*' );
  168.   Goto 999;
  169.  
  170. 4:
  171.   Write('Copy file ');
  172.   Readln( Name );
  173.   Copy_File( Name );
  174.   Goto 1;
  175.  
  176. 5:
  177.   Writeln( '?' );
  178.   Goto 1;
  179.  
  180. 999:
  181. End.
  182.