$title ('Copy Console #1 to Console #2')
copy1to2:
do;

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

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

  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 (fcb.lit)
$include (proces.lit)
$include (queue.lit)

  /*
      Template for all BDOS and XDOS calls
  */


  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;
  declare fcb16 (1) byte external;
  declare tbuff (1) byte external;

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

  system$reset:
    procedure;
      call mon1 (0,0);
    end system$reset;

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

  write$console:
    procedure (char);
      declare char byte;
      call mon1 (2,char);
    end write$console;

  write$list:
    procedure (char);
      declare char byte;
      call mon1 (5,char);
    end write$list;

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

  direct$console$out:
    procedure (char);
      declare char byte;
      call mon1 (6,char);
    end direct$console$out;

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

  read$console$buffer:
    procedure (buffer$address);
      declare buffer$address address;
      call mon1 (10,buffer$address);
    end read$console$buffer;

  check$console$status:
    procedure byte;
      return mon2 (11,0);
    end check$console$status;

  reset$disk$system:
    procedure;
      call mon1 (13,0);
    end reset$disk$system;

  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;

  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;

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

  rename$file:
    procedure (fcb$address);
      declare fcb$address address;
      call mon1 (23,fcb$address);
    end rename$file;

  set$DMA$address:
    procedure (DMA$address);
      declare DMA$address address;
      call mon1 (26,DMA$address);
    end set$DMA$address;
  
  set$user$code:
    procedure (user);
    declare user byte;
      call mon1 (32,user);
    end set$user$code;

  get$user$code:
    procedure byte;
      return mon2 (32,0);
    end get$user$code;

  read$random:
    procedure (fcbadr);
      declare fcbadr address;
      call mon1 (33,fcbadr);
    end read$random;

  write$random:
    procedure (fcbadr);
      declare fcbadr address;
      call mon1 (34,fcbadr);
    end write$random;

  set$random$record:
    procedure (fcbadr);
      declare fcbadr address;
      call mon1 (36,fcbadr);
    end set$random$record;

  /**************************************
   *                                    *
   *       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;

  cond$read$queue:
    procedure (qcb$address) byte;
      declare qcb$address address;
      return mon2 (138,qcb$address);
    end cond$read$queue;

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

  cond$write$queue:
    procedure (qcb$address) byte;
      declare qcb$address address;
      return mon2 (140,qcb$address);
    end cond$write$queue;

  delay:
    procedure (ticks);
      declare ticks address;
      call mon1 (141,ticks);
    end delay;

  dispatch:
    procedure;
      call mon1 (142,0);
    end dispatch;

  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$priority:
    procedure (priority);
      declare priority byte;
      call mon1 (145,priority);
    end set$priority;

  attach:
    procedure (console);
      declare console byte;
      call mon1 (146,console);
    end attach;

  detach:
    procedure (console);
      declare console byte;
      call mon1 (147,console);
    end detach;

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

  assign$console:
    procedure (pname$adr);
      declare pname$adr address;
      call mon1 (149,pname$adr);
    end assign$console;

  send$cli$command:
    procedure (command$line);
      declare command$line address;
      call mon1 (150,command$line);
    end send$cli$command;

  call$res$sys$process:
    procedure (pname$adr) address;
      declare pname$adr address;
      return mon2a (151,pname$adr);
    end call$res$sys$process;

  parse$filename:
    procedure (pcb$address) address;
      declare pcb$address address;
      return mon2a (152,pcb$address);
    end parse$filename;

  get$console$number:
    procedure byte;
      return mon2 (153,0);
    end get$console$number;

  system$data$adr:
    procedure address;
      return mon2a (154,0);
    end system$data$adr;

  get$tod:
    procedure (buffer$adr);
      declare buffer$adr address;
      call mon1 (155,buffer$adr);
    end get$tod;

  /**************************************
   *                                    *
   *      Misc. BDOS & XDOS procs       *
   *                                    *
   **************************************/

  crlf:
    procedure;
      call write$console (0dh);
      call write$console (0ah);
    end crlf;

  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 disk$wr$cque structure (cqueue,buf(16) byte)
    initial (0,'DiskWrQ ',1,16);

  declare char$in byte;

  declare Out$uqcb userqcbhead
    initial (.disk$wr$cque,.char$in);

  declare char$out byte;

  declare In$uqcb userqcbhead
    initial (.disk$wr$cque,.char$out);

  declare ret byte;

  /*
    Disk Write Process
  */

  Disk$Wr:
    procedure;

      do forever;
        char$in = direct$console$in;
        call write$queue (.Out$uqcb);
        if char$in = 1ah then
        do;
          call mon1 (143,0ffffh);
        end;
      end;
    end Disk$wr;

  /*
    Main Program
  */

start:
  do;
    call make$queue (.Disk$Wr$CQue);
    call create (.Disk$Wr$Pd);
    do forever;
      call read$queue (.In$uqcb);
      if char$out = 1ah then
      do;
        ret = delete$queue (.Disk$Wr$CQue);
        call terminate;
      end;
      call write$console (char$out);
    end;
  end;

end copy1to2;