$title('MP/M 1.1 Spool Process')
spool:
do;

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

$include (proces.lit)
$include (queue.lit)
$include (xdos.lit)
$include (fcb.lit)

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

  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;

  open:
    procedure (fcb$adr) byte public;
      declare fcb$adr address;
      declare fcb based fcb$adr fcb$descriptor;
      return mon2 (15,fcb$adr);
    end open;
  
  readbf:
    procedure (fcb$adr) byte public;
      declare fcb$adr address;
      return mon2 (20,fcb$adr);
    end readbf;
  
  set$dma:
    procedure (dma$adr) public;
      declare dma$adr address;
      call mon1 (26,dma$adr);
    end set$dma;

  free$drives:
    procedure;
      call mon1 (39,0ffffh);
    end free$drives;

  lo:
    procedure (char) public;
      declare char byte;
      call mon1 (5,char);
    end lo;

  declare xdos literally 'mon2';
  declare xdosa literally 'mon2a';

  declare list$mx userqcb
    initial (0,0,'MXList  ');

  declare control$z literally '1AH';

  declare reserved$for$disk (3) byte;
  declare buffer (128) byte;

/*
  Spool Process Data Segment
*/
  declare os address public
    /* The OS address will be filled in here by the
       MPM Loader, this address is used by Mon1 & Mon2 */
    data (0);

  declare spool$pd process$descriptor public
    /* This is 'data' because it must precede
       the PRL file code segment            */
    data (0,rtr$status,20,.spool$stk+38,
             'Spool   ',0,0ffh,0,0,.buffer,0);
  declare spool$stk (20) address
    initial (restarts,.spool);

  declare spool$lqcb
    structure (lqueue,
               buf (110) byte)
    initial (0,'SPOOL   ',53,2);
  declare spool$uqcb userqcbhead
    initial (.spool$lqcb,.field);
  declare field (53) byte;
  declare disk$select byte at (.field(0));
  declare console byte at (.field(1));

  declare dsk$slct$adr address
    initial (.spool$pd.disk$slct);
  declare dsk$slct based dsk$slct$adr byte;

  declare pcb structure (
    field$adr address,
    fcb$adr address)
    initial (0,.fcb);

  declare fcb fcb$descriptor;

  declare stpspl$cqcb circularqueue
    initial (0,'STOPSPLR',0,1);
  declare stpspl$uqcb address
    initial (.stpspl$cqcb);

  declare ret byte;

  declare (char,column,itab,jtab,eod,i) byte;

  declare nxt$chr$adr address;

  declare last$dseg$byte byte
    initial (0);


/*
  spool:
*/

  spool:
    procedure;
  
      ret = xdos (make$queue,.spool$lqcb);
      ret = xdos (make$queue,.stpspl$cqcb);
      ret = xdos (open$queue,.list$mx);
      ret = xdos (set$priority,200);
  
      do forever;
        ret = xdos (read$queue,.spool$uqcb);
        dsk$slct = disk$select;
        nxt$chr$adr = .field(1);
        do while (nxt$chr$adr <> 0) and
                 (nxt$chr$adr <> 0FFFFH);
          pcb.field$adr = nxt$chr$adr + 1;
          nxt$chr$adr = xdosa (parse$fname,.pcb);
          if nxt$chr$adr <> 0FFFFH then
          do;
            if open (.fcb) <> 0FFH then
            do;
              ret = xdos (read$queue,.list$mx);
              call set$dma (.buffer);
              fcb.nr = 0;
              eod = 0;
              do while (not eod) and (readbf (.fcb) = 0);
                if xdos (cond$read$queue,.stpspl$uqcb) = 0 then
                do;
                  eod = true;
                  nxt$chr$adr = 0;
                  do while xdos (cond$read$queue,.spool$uqcb) = 0;
                    ;
                  end;
                end;
                else
                do i = 0 to last(buffer);
                  if (char := buffer(i)) = control$z
                    then eod = true;
                  if not eod then
                  do;
                    itab = (char = 09H) and (7 - (column and 7));
                    if char = 09H
                      then char = ' ';
                    do jtab = 0 to itab;
                      if char >= ' '
                        then column = column + 1;
                      if char = 0AH then column = 0;
                      call lo(char);
                    end;
                  end;
                end;
              end;
              call free$drives;
              ret = xdos (write$queue,.list$mx);
            end;
          end;
        end; /* of while */
      end;
    end spool;
  /*
    Dummy Main Program
  */
  do;
    ;
  end;
end spool;