Digital-Research-Source-Code/MPM OPERATING SYSTEMS/MPM I/MPM I SOURCE/07/prlcm.plm

$title ('MP/M 1.1  PRL to COM File')
prlcom:
do;

$include (copyrt.lit)
/*
  Revised:
    19 Jan 80  by Thomas Rolander
*/

  declare true literally '0FFFFH';
  declare false literally '0';
  declare forever literally 'while true';
  declare boolean literally 'byte';

  declare start label;
  declare jmp$to$start structure (
    jmp$instr byte,
    jmp$location address  ) data (
      0C3H,.start-3);

  mon1:
    procedure (func,info) external;
      declare func byte;
      declare info address;
    end mon1;

  mon2:
    procedure (func,info) byte external;
      declare func byte;
      declare info address;
    end mon2;

  declare fcb (1) byte external;
  declare fcb16 (1) byte external;
  declare tbuff (1) byte external;

  /**************************************
   *                                    *
   *       B D O S   Externals          *
   *                                    *
   **************************************/

  system$reset:
    procedure;
      declare dummy address;
      dummy = 0;
      stackptr = .dummy;
    end system$reset;

  read$console:
    procedure byte;
      return mon2 (1,0);
    end read$console;

  print$buffer:
    procedure (buffer$address);
      declare buffer$address address;
      call mon1 (9,buffer$address);
    end print$buffer;

  open$file:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (15,fcb$address);
    end open$file;

  close$file:
    procedure (fcb$address);
      declare fcb$address address;
      call mon1 (16,fcb$address);
    end close$file;

  delete$file:
    procedure (fcb$address);
      declare fcb$address address;
      call mon1 (19,fcb$address);
    end delete$file;

  read$record:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (20,fcb$address);
    end read$record;

  write$record:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (21,fcb$address);
    end write$record;

  make$file:
    procedure (fcb$address);
      declare fcb$address address;
      call mon1 (22,fcb$address);
    end make$file;

  set$DMA$address:
    procedure (DMA$address);
      declare DMA$address address;
      call mon1 (26,DMA$address);
    end set$DMA$address;
  

  declare base address;
  declare (nrec,ret) byte;
  declare errmsg address;
  declare i address;

  declare fcbout (33) byte initial (
    1,'        ','   ',0,0,0,0,0,0,0,0,
    0,0,0,0,0,0,0,0,0,0,0,0,0);

  declare header (256) byte;
  declare code$size address at (.header(1));


  declare buffer (1) byte at (2000H);
  declare sector$size literally '128';

  copy$PRL$to$COM:
    procedure;

      call set$DMA$address (.header);
      if (ret := read$record (.fcb)) <> 0 then
      do;
        errmsg = .('Unable to read header record.','$');
        go to error;
      end;
      call set$DMA$address (.header(128));
      if (ret := read$record (.fcb) <> 0) then
      do;
        errmsg = .('Unable to read header record.','$');
        go to error;
      end;
      nrec = shr(code$size+7FH,7);
      base = .buffer;
      /* read PRL file into memory */
      do i = 1 to nrec;
        call set$DMA$address (base);
        base = base + sector$size;
        if (ret := read$record (.fcb)) <> 0 then
        do;
          errmsg = .('Bad data record in PRL file.','$');
          go to error;
        end;
      end;

      /* write COM file from memory */
      base = .buffer;
      do i = 1 to nrec;
        call set$DMA$address (base);
        base = base + sector$size;
        if (ret := write$record (.fcbout)) <> 0 then
        do;
          errmsg = .('Error during writing COM output file.','$');
          go to error;
        end;
      end;

      call close$file (.fcbout);

    end copy$PRL$to$COM;

  setup:
    procedure;

      if fcb(1) = ' ' then
      do;
        errmsg = .('Input file must be specified.','$');
        go to error;
      end;
      if fcb(9) = ' '
        then call move (3,.('PRL'),.fcb(9));
      if fcb16(1) = ' ' then
      do;
        call move (9,.fcb,.fcb16);
      end;
      if fcb16(9) = ' '
        then call move (3,.('COM'),.fcb16(9));
      call move (16,.fcb16,.fcbout);
      if open$file (.fcb) = 0ffh then
      do;
        errmsg = .('Input file does not exist.','$');
        go to error;
      end;
      fcb(32) = 0;
      if open$file (.fcbout) <> 0ffh then
      do;
        call print$buffer (.(0ah,0dh,
          'Destination file exists, delete (Y/N)?','$'));
        ret = read$console;
        if (ret = 'y') or
           (ret = 'Y') then
        do;
          call delete$file (.fcbout);
        end;
        else
        do;
          call system$reset;
        end;
      end;
      call make$file (.fcbout);
      fcbout(32) = 0;
    end setup;

  /*
    Main Program
  */

  start:

    call setup;
    call copy$PRL$to$COM;
    call system$reset;

  error:
    call print$buffer (.(0dh,0ah,'$'));
    call print$buffer (errmsg);
    call system$reset;

end prlcom;