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

$title ('Copy Serial Data to Disk')
copy$srl$to$disk:
do;

$include (copyrt.lit)
$nolist
/*
    Common Literals
*/

  declare true literally '1';
  declare forever literally 'while true';

  declare restarts literally
    '0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H,0C7C7H,
     0C7C7H,0C7C7H,0C7C7H';

$list
$include (proces.lit)
$include (queue.lit)

  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;

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

  declare fcb (1) byte external;

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

  direct$console$in:
    procedure byte;
      return mon2 (6,0ffh);
    end direct$console$in;

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

  close$file:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (16,fcb$address);
    end close$file;

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

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

  create$file:
    procedure (fcb$address) byte;
      declare fcb$address address;
      return mon2 (22,fcb$address);
    end create$file;

  set$DMA$address:
    procedure (DMA$address);
      declare DMA$address address;
      call mon1 (26,DMA$address);
    end set$DMA$address;
  
  /**************************************
   *                                    *
   *       X D O S   Externals          *
   *                                    *
   **************************************/

  flag$wait:
    procedure (flag) byte;
      declare flag byte;
      return mon2 (132,flag);
    end flag$wait;

  flag$set:
    procedure (flag) byte;
      declare flag byte;
      return mon2 (133,flag);
    end flag$set;

  make$queue:
    procedure (qcb$address);
      declare qcb$address address;
      call mon1 (134,qcb$address);
    end make$queue;

  open$queue:
    procedure (qcb$address) byte;
      declare qcb$address address;
      return mon2 (135,qcb$address);
    end open$queue;

  delete$queue:
    procedure (qcb$address) byte;
      declare qcb$address address;
      return mon2 (136,qcb$address);
    end delete$queue;

  read$queue:
    procedure (qcb$address);
      declare qcb$address address;
      call mon1 (137,qcb$address);
    end read$queue;

  write$queue:
    procedure (qcb$address);
      declare qcb$address address;
      call mon1 (139,qcb$address);
    end write$queue;

  terminate:
    procedure;
      call mon1 (143,0);
    end terminate;

  create:
    procedure (process$descriptor$adr);
      declare process$descriptor$adr address;
      call mon1 (144,process$descriptor$adr);
    end create;

  set$console:
    procedure (console);
      declare console byte;
      call mon1 (148,console);
    end set$console;

  declare buffer (8192) byte;

  declare disk$wr$pd process$descriptor
    initial (0,0,199,.disk$wr$stk+46,
             'DiskWr  ',1,0ffh,0,0,.buffer,0);

  declare disk$wr$stk (24) address
    initial (restarts,.disk$wr);

  declare empty$cque structure (cqueue,buf(64) address)
    initial (0,'EmptyQ  ',2,64);

  declare full$cque structure (cqueue,buf(64) address)
    initial (0,'FullQ   ',2,64);

  declare pro$buf$adr address;
  declare pro$buf based pro$buf$adr (1) byte;

  declare pro$empty$uqcb userqcbhead
    initial (.empty$cque,.pro$buf$adr);

  declare pro$full$uqcb userqcbhead
    initial (.full$cque,.pro$buf$adr);

  declare con$buf$adr address;

  declare con$empty$uqcb userqcbhead
    initial (.empty$cque,.con$buf$adr);

  declare con$full$uqcb userqcbhead
    initial (.full$cque,.con$buf$adr);

  declare (ret,i) byte;

  /*
    Disk Write Process
  */

  Disk$Wr:
    procedure;

      do forever;
        call read$queue (.con$full$uqcb);
        if con$buf$adr = 0 then
        do;
          ret = flag$set (10);
          call mon1 (143,0ffffh);
        end;
        call set$DMA$address (con$buf$adr);
        ret = write$record (.fcb);
        call write$queue (.con$empty$uqcb);
      end;
    end Disk$wr;

  /*
    Main Program
  */

start:
  do;
    call delete$file (.fcb);
    ret = create$file (.fcb);
    ret = open$file (.fcb);
    fcb(32) = 0;
    call make$queue (.empty$cque);
    call make$queue (.full$cque);
    call create (.Disk$Wr$Pd);
    pro$buf$adr = .buffer;
    do i = 0 to 63;
      call write$queue (.pro$empty$uqcb);
      pro$buf$adr = pro$buf$adr + 128;
    end;
    call set$console (1);
    do forever;
      call read$queue (.pro$empty$uqcb);
      do i = 0 to 127;
        if (pro$buf(i) := direct$console$in) = 1ah then
        do;
          call write$queue (.pro$full$uqcb);
          pro$buf$adr = 0;
          call write$queue (.pro$full$uqcb);
          ret = flag$wait (10);
          ret = delete$queue (.empty$cque);
          ret = delete$queue (.full$cque);
          ret = close$file (.fcb);
          call terminate;
        end;
      end;
      call write$queue (.pro$full$uqcb);
    end;
  end;

end copy$srl$to$disk;