home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol270 / chg.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-05-22  |  12.2 KB  |  306 lines
  1. { CHG.PAS of JUGPDS Vol.11 by M. Miyao (No.78) }
  2.  
  3. program disk_parameter_change(input, output );
  4.  
  5. const
  6.      TARGETDRV = 1;    { 0:A 1:B 2:C 3:D 4:E 5:F }
  7.      DPBADR    = $40;  { $40 ~ $51 : work area }
  8.      RSFLAG    = $4F;
  9.      SAVEADRL  = $50;
  10.      SAVEADRH  = $51;
  11.      CHANGE    =   1;
  12.      UNCHANGE  =  14; { these pattern may not in initial memory data }
  13.      SORCEDISK =   3; { Turbo Pascal source drive number }
  14.  
  15. type
  16.      dsktype  = ( reset, pcsingle, pcdouble, pc88, pc98,
  17.                   if8, fm8, fm7, mz, pasopia, qc10,
  18.                   yours{ Change this to your system
  19.                   type if there is not, or add new target system type,
  20.                   procedures printtable and initdpb also must be rewritten,
  21.                   if add more than 2 then rewrite nans range });
  22.      dpbmem   = ( sectl,   secth,  blkshf, blkmsk, extmsk,
  23.                   dksm1l,  dksm1h, dirm1l, dirm1h, dirblkh,
  24.                   dirblkl, cksd4l, cksd4h, ofsl,   ofsh );
  25.      dpb      = array [sectl..ofsh] of byte;
  26.  
  27. var
  28.      alvcsvover         : boolean; { ALV,CSV area overflow OK? }
  29.      ans                  : char;
  30.      dskno                : integer;
  31.      dpbtable             : array[dsktype] of dpb;
  32.      mydsktype, targetdsk : dsktype;
  33.      nans                 : 0..11; { change range when
  34.                                      you add more than 2 types }
  35.  
  36. function peek( adr : integer ) : byte;
  37.     begin peek := mem[adr]; end;
  38.  
  39. procedure poke( adr : integer; data : byte );
  40.     begin mem[adr] := data; end;
  41.  
  42. function getdphadr( dsk : integer ) : integer;
  43.  
  44.   begin
  45.      getdphadr := bioshl( 8 {seldisk}, dsk );
  46.   end;
  47.  
  48. function getdpbadr( dsk : integer ) : integer;
  49.  
  50.   var dphadr  : integer;
  51.  
  52.   begin
  53.      dphadr    := getdphadr( dsk );
  54.      getdpbadr := peek(dphadr+10)+256*peek(dphadr+11);
  55.   end;
  56.  
  57. procedure printtable;
  58.  
  59.   begin
  60.     writeln('* CHG: Change Disk Format *');
  61.     writeln('Specify target disk type.');
  62.     writeln('   Reset to org. disk:    0  or');
  63.     writeln('   PC-8001(single side):  1');
  64.     writeln('   PC-8001(double side):  2');
  65.     writeln('   PC-8801, FP-1100:      3');
  66.     writeln('   PC-9801:               4');
  67.     writeln('   if800:                 5');
  68.     writeln('   FM-8:                  6');
  69.     writeln('   FM-7:                  7');
  70.     writeln('   Sharp MZ:              8');
  71.     writeln('   TOSHIBA Pasopia:       9');
  72.     writeln('   QC-10:                10');
  73.  {  writeln('                       : 11');   add here new disk }
  74.     write  ('   Which disk? Select one:    ');
  75.   end;
  76.  
  77. procedure setmydsktype;
  78.  
  79. { Define here your working system type,
  80.   then you must change this procedure for your system }
  81.  
  82.     begin
  83.        alvcsvover:= true;       { if ALV, CSV area overflow OK then true }
  84.        mydsktype := qc10;       { Change your own system type  }
  85.        dskno     := TARGETDRV;  { A:0, B:1, C:2, D:3, E:4, F:5 }
  86.     end;
  87.  
  88.  
  89. procedure initdpb( dtype : dsktype );
  90.  {
  91.  
  92.   Set up data is following
  93.  
  94. ----------------------------------------------------------------------------
  95.  System type |   PC-8001   | PC8801 |        |      |       |       |
  96. -------------|-------------|  FM-7  | PC9801 |  MZ  | if800 |Pasopia| QC-10
  97.  Parameter   |  1D  |  2D  |  FM-8  |        |      |       |       |
  98. -------------|--------------------------------------------------------------
  99.   Sectors(l) |  20  |  40  |   40   |   40   |  40  |   40  |  40   |   40
  100.          (h) |  00  |  00  |   00   |   00   |  00  |   00  |  00   |   00
  101. -------------|------|------|--------|--------|------|-------|-------|-------
  102.   blkshft    |  03  |  04  |   04   |   04   |  04  |   04  |  04   |   04
  103. -------------|------|------|--------|--------|------|-------|-------|-------
  104.   blkmask    |  07  |  0F  |   0F   |   0F   |  0F  |   0F  |  0F   |   0F
  105. -------------|------|------|--------|--------|------|-------|-------|-------
  106.   extmask    |  00  |  01  |   01   |   01   |  01  |   01  |  01   |   01
  107. -------------|------|------|--------|--------|------|-------|-------|-------
  108.  dsksize-1(l)|  83  |  97  |   97   |   9B   |  7F  |   7F  |  93   |   8B
  109.           (h)|  00  |  00  |   00   |   00   |  00  |   00  |  00   |
  110. -------------|------|------|--------|--------|------|-------|-------|-------
  111.  dirnum.-1(l)|  3F  | 7F/3F| 7F/3F  | 7F/3F  |  3F  | 7F/3F |  3F   |   3F
  112.           (h)|  00  |  00  |   00   |   00   |  00  |   00  |  00   |   00
  113. -------------|------|------|--------|--------|------|-------|-------|-------
  114.  dirblok(h)  |  C0  | C0/80| C0/80  | C0/80  |  80  | C0/80 |  80   |   80
  115. -------------|------|------|--------|--------|------|-------|-------|-------
  116.  dirblok(l)  |  00  |  00  |   00   |   00   |  00  |   00  |  00   |   00
  117. -------------|------|------|--------|--------|------|-------|-------|-------
  118.  check/4(l)  |  10  | 20/10| 20/10  | 20/10  |  10  | 20/10 |  10   |   10
  119.  check/4(h)  |  00  |  00  |   00   |   00   |  00  |   00  |  00   |   00
  120. -------------|------|------|--------|--------|------|-------|-------|-------
  121.  offset(l)   |  02  |  02  |   02   |   01   |  02  |   03  |  03   |   04
  122.        (h)   |  00  |  00  |   00   |   00   |  00  |   00  |  00   |   00
  123.  
  124.         dirnum.-1,dirblok(h),check/4 : 128dir/64dir
  125. }
  126.  
  127.  var     p : dsktype;
  128.  
  129.  begin
  130.      for p := pcsingle to qc10 { here add your system } do begin
  131.                                                { set standard (pc88) data }
  132.          dpbtable[ p, sectl  ] := $40; { sectors }
  133.          dpbtable[ p, secth  ] := $00;
  134.          dpbtable[ p, blkshf ] := $04; { blkshft }
  135.          dpbtable[ p, blkmsk ] := $0F; { blkmask }
  136.          dpbtable[ p, extmsk ] := $01; { extmask }
  137.          dpbtable[ p, dksm1l ] := $97; { dsk - 1 }
  138.          dpbtable[ p, dksm1h ] := $00;
  139.  
  140.          { If your system has only 64 directory entries, the area of CSV and
  141.          ALV will overflow when reading the disk sytem with 128 directory
  142.          entries, then you must set DPB as 64 and you cannot write files more 
  143.          than 64. }
  144.  
  145.          dpbtable[ p, dirm1l  ] := $7F; { dir - 1 };
  146.          dpbtable[ p, dirblkh ] := $C0; { dirblk(h) }
  147.          dpbtable[ p, cksd4l  ] := $20; { cks/4   }
  148.          dpbtable[ p, dirm1h  ] := $00;
  149.          dpbtable[ p, dirblkl ] := $00; { dirblk(l) }
  150.          dpbtable[ p, cksd4h  ] := $00;
  151.          dpbtable[ p, ofsl    ] := $02; { ofset   }
  152.          dpbtable[ p, ofsh    ] := $00;
  153.  
  154.          { Set different byte for suitable to the system }
  155.  
  156.          case p of
  157.            pcsingle : begin
  158.                         dpbtable[ p, sectl  ] := $20; { sectors }
  159.                         dpbtable[ p, blkshf ] := $03; { blkshft }
  160.                         dpbtable[ p, blkmsk ] := $07; { blkmask }
  161.                         dpbtable[ p, extmsk ] := $00; { extmask }
  162.                         dpbtable[ p, dksm1l ] := $83; { dsk - 1 }
  163.                         dpbtable[ p, dirm1l ] := $3F; { dir - 1 };
  164.                         dpbtable[ p, dirblkh] := $C0; { dirblk(h) }
  165.                         dpbtable[ p, cksd4l ] := $10; { cks/4   }
  166.                       end;
  167.  
  168.            pcdouble, pc88, fm8, fm7 : {do nothing};
  169.  
  170.            pc98     : begin
  171.                         dpbtable[ p, dksm1l ] := $9B; { dsk - 1 }
  172.                         dpbtable[ p, ofsl   ] := $01; { ofset }
  173.                       end;
  174.  
  175.            if8      : begin
  176.                         dpbtable[ p, dksm1l ] := $7F; { dsk - 1 }
  177.                         dpbtable[ p, ofsl   ] := $03; { ofset }
  178.                       end;
  179.  
  180.            mz       : begin
  181.                         dpbtable[ p, dksm1l ] := $7F; { dsk - 1 }
  182.                         dpbtable[ p, dirm1l ] := $3F; { dir - 1 };
  183.                         dpbtable[ p, dirblkh] := $80; { dirblk(h) }
  184.                         dpbtable[ p, cksd4l ] := $10; { cks/4   }
  185.                       end;
  186.  
  187.            pasopia  : begin
  188.                         dpbtable[ p, dksm1l ] := $93; { dsk - 1 }
  189.                         dpbtable[ p, ofsl   ] := $03; { ofset }
  190.                         dpbtable[ p, dirm1l ] := $3F; { dir - 1 };
  191.                         dpbtable[ p, dirblkh] := $80; { dirblk(h) }
  192.                         dpbtable[ p, cksd4l ] := $10; { cks/4   }
  193.                       end;
  194.  
  195.            qc10     : begin
  196.                         dpbtable[ p, dksm1l ] := $8B; { dsk - 1 }
  197.                         dpbtable[ p, ofsl   ] := $04; { ofset }
  198.                         dpbtable[ p, dirm1l ] := $3F; { dir - 1 };
  199.                         dpbtable[ p, dirblkh] := $80; { dirblk(h) }
  200.                         dpbtable[ p, cksd4l ] := $10; { cks/4   }
  201.                      end;
  202.  
  203.            { here adds your new system data which differ from
  204.              standard data }
  205.  
  206.          end;
  207.  
  208.      end;
  209.      if not alvcsvover then
  210.          for p := pcsingle to qc10 { here add your system } do begin
  211.              if dpbtable[ mydsktype, dksm1l ] < dpbtable[ p, dksm1l  ] then
  212.                 dpbtable[ p, dksm1l ] := dpbtable[ mydsktype, dksm1l ];
  213.              if dpbtable[ mydsktype, dirm1l ] < dpbtable[ p, dirm1l  ] then
  214.                 dpbtable[ p, dirm1l  ]:= dpbtable[ mydsktype, dirm1l ];
  215.              if dpbtable[ mydsktype, dirblkh] < dpbtable[ p, dirblkh ] then
  216.                 dpbtable[ p, dirblkh ]:= dpbtable[ mydsktype, dirblkh];
  217.              if dpbtable[ mydsktype, cksd4l ] < dpbtable[ p, cksd4l  ] then
  218.                 dpbtable[ p, cksd4l  ]:= dpbtable[ mydsktype, cksd4l ];
  219.                 { limit the maximum target disk size to your system }
  220.      end;
  221.   end;
  222.  
  223. procedure savedpbadr;
  224.  
  225.   var address : integer;
  226.  
  227.   begin
  228.      address := getdpbadr( dskno );
  229.      poke( SAVEADRL, lo(address));
  230.      poke( SAVEADRH, hi(address));
  231.   end;
  232.  
  233.  
  234. {     ------------                             --------   getdphadr(disk#)
  235.      | sector(l)  |   40   DPBADR  -----.     | XLTTBL |
  236.       ------------                      |      --------
  237.      | sector(h)  |   41                |     |  0000  |
  238.       ------------                      |      --------
  239.            :                            |     |  0000  |
  240.            :                            |      --------
  241.       ------------                      |     |  0000  |
  242.      | offset(h)  |   4E                |      --------
  243.       ------------                      |     | DIRBUF |
  244.      | set/res flg|   4F   RSFLAG       |      --------
  245.       ------------                      '-->  | DPBADR | -.
  246.      | save old   |   50   SAVEADRL            --------   |
  247.       ------------                  <--       |  CSV n |  |
  248.      | DPB addr.  |   51   SAVEADRH    |       --------   |
  249.       ------------                     |      |  ALV n |  |
  250.                                        |       --------   |
  251.          usage       address           |                  |
  252.                                         ------------------
  253.  }
  254. procedure setdpb( dtype : dsktype );
  255.  
  256.  var i : 0..14;
  257.  
  258.   begin
  259.      if peek( RSFLAG ) <> CHANGE then savedpbadr;
  260.      for i:= 0 to 14 do    poke( DPBADR + i, dpbtable[ dtype, dpbmem(i)]);
  261.      poke( getdphadr( dskno ) +10 {lo byte of DPB address}, DPBADR );
  262.      poke( getdphadr( dskno ) +11 {hi byte of DPB address}, $00    );
  263.      poke( RSFLAG, CHANGE );
  264.   end;
  265.  
  266.  
  267. procedure resetdsk;
  268.  
  269.   { Set Disk Parameter Block address at the Disk Parameter Header
  270.     to the original address which are saved into SAVEADRH/L
  271.     and change RSFLAG to UNCHANGE }
  272.  
  273.   begin
  274.      poke( getdphadr( dskno ) +10 {lo byte of DPB address}, peek(SAVEADRL));
  275.      poke( getdphadr( dskno ) +11 {hi byte of DPB address}, peek(SAVEADRH));
  276.      poke ( RSFLAG, UNCHANGE );
  277.   end;
  278.  
  279. begin { MAIN program }
  280.      setmydsktype;                    { set up working disk/machine type  }
  281.      initdpb( mydsktype );            { set up all target disk type table }
  282.      printtable;                      { select target disk type           }
  283.      repeat
  284.          readln( nans ) ;
  285.      until (nans>=0) and (nans<11{change if add new type});
  286.      case nans of                     { define target disk type           }
  287.           0 : targetdsk := reset;
  288.           1 : targetdsk := pcsingle;
  289.           2 : targetdsk := pcdouble;
  290.           3 : targetdsk := pc88;
  291.           4 : targetdsk := pc98;
  292.           5 : targetdsk := if8;
  293.           6 : targetdsk := fm8;
  294.           7 : targetdsk := fm7;
  295.           8 : targetdsk := mz;
  296.           9 : targetdsk := pasopia;
  297.           10: targetdsk := qc10;
  298. {         11: targetdsk := added new disk type   }
  299.      end;
  300.      if targetdsk = reset then begin
  301.         if peek( RSFLAG ) = CHANGE then  resetdsk
  302.      end
  303.      else setdpb( targetdsk );
  304.      dskno := getdphadr(SORCEDISK);       { reset bdos state to A drive }
  305. end.
  306.