! Printer/plotter/etc despooler for new filestore.

! Process runs autonomously in the filestore machine.  It is wakened
! by the scheduler every so often.  It has a look round the designated
! spool directory, takes each of the files there, prints them and
! deletes them when done...

%option "-nocheck-nostack-noline"

%include "Config.Inc"

%include "System:Common"
%include "System:Utility.Inc"
%include "System:SCHEDULE.Inc"
%include "System:Errors.Inc"

%constinteger TAB =  9
%constinteger LF  = 10
%constinteger FF  = 12
%constinteger CR  = 13
%constinteger ESC = 27

%ownrecord(common fm)%name common
%externalrecord(common fm)%mapspec common area

%externalintegerspec ether context

%externalintegerspec lpzap

%externalintegerfnspec FS logon(%string(255) ownername,
                                %string(255) password, %integername Uno)
%externalintegerfnspec FS logoff(%integer Uno)
%externalintegerfnspec FS openr(%integer Uno, %string(255) filename,
                                %integername Xno, block count, pad count)
%externalintegerfnspec FS readsq(%integer Xno, %integername bytes,
                                 %record(buffer fm)%name buffer)
%externalintegerfnspec FS close(%integer Xno)
%externalintegerfnspec FS delete(%integer Uno, %string(255) filename)

%externalroutinespec despooler ready(%integer mask)

%conststring(23)%array error text(1 : last error) =
      "bad context",             {-1}
      "not implemented",         {-2}
      "illegal Xno",             {-3}
      "param error",             {-4}
      "no Xno",                  {-5}
      "protocol error",          {-6}
      "illegal Uno",             {-7}
      "not logged on",           {-8}
      "directory corrupt",       {-9}
      "file in use",             {-10}
      "file not found",          {-11}
      "owner not found",         {-12}
      "no authority",            {-13}
      "no quota",                {-14}
      "no slot",                 {-15}
      "no extent",               {-16}
      "disc full",               {-17}
      "system down",             {-18}
      "file exists",             {-19}
      "partition corrupt",       {-20}
      "disc error",              {-21}
      "illegal operation",       {-22}
      "no buffer",               {-23}
      "user exists",             {-24}
      "no Uno",                  {-25}
      "refcount negative",       {-26}
      "size error",              {-27}
      "data address error",      {-28}
      "directory address error", {-29}
      "logins disabled",         {-30}
      "not writeable",           {-31}
      "directory in use",        {-32}
      "directory not empty",     {-33}
      "no process",              {-34}
      "conflicting access"       {-35}

%routine show error(%integer status)
   status = -(status ! 16_FFFF0000)
   %if 0 < status <= last error %then printstring(error text(status)) %c
                                %else write(-status, 0)
%end

%externalroutine despooler main entry
   %owninteger despooler ID = 0
   %string(15)%array files(1 : 128)
   %string(15) our directory, our password
   %integer Uno, status, our qsart, flags
   %integer file limit, bytes, next, i, j
   %integer us, our context, our wait flag, buff, txbuff
   %record(buffer fm)%name b, txb

   %integer column = 0;  ! Must be global, non-%own

   %routine put symbol(%integer sym)
      %if sym >= 0 %start
         %if txbuff = 0 %start
            txbuff = claim buffer
            txb == common_buffer(txbuff)
            txb_bytes = 0
         %finish
         txb_b(txb_bytes) = sym
         txb_bytes = txb_bytes + 1
      %finish
      %if tx buff # 0 %and (sym < 0 %or txb_bytes = 256 + 1) %start
         {D}%if common_diags & despool diags # 0 %start
         {D}  printstring("Putting block "); write(txb_bytes,0); newline
         {D}%finish
         txb_text = ""
         txb_sync = our wait flag
         txb_context = our qsart
         send qsart buffer(txbuff)
         {D}%if common_diags & despool diags # 0 %start
         {D}  printstring("Have put"); newline
         {D}%finish
         txbuff = 0
         wait for(our wait flag)
         {D}%if common_diags & despool diags # 0 %start
         {D}  printstring("Sunk "); write(our wait flag,0); newline
         {D}%finish
      %finish
   %end

   %integerfn get symbol(%integer Xno)
      %integer status, ch
         %if lpzap = us %start
            ! Must kill this one
            pdate
            printstring("*** Despooler ");  write(us, 0)
            printstring(" aborted");  newline
            lpzap = -1
            %result = -1
         %finish
         %if next >= b_bytes %start
            ether context = our context
         {D}%if common_diags & despool diags # 0 %start
         {D}  printstring("Getting block"); newline
         {D}%finish
            status = FS readSQ(Xno, bytes, b)
         {D}%if common_diags & despool diags # 0 %start
         {D}  printstring("Got "); write(b_bytes,0); write(bytes,1); write(status,1); newline
         {D}%finish
            %if status # success %start
               pdate
               printstring(our directory)
               printstring(" failed to read Xno ");  write(Xno, 0)
               printstring(" -- ");  show error(status)
               newline
               %result = -1
            %finish
            next = 0
         %finish
         %result = -1 %if b_bytes = 0
         ch = b_b(next)
         next = next + 1
         %result = ch
   %end

   %routine get files
      %integer i, status, Xno, bc, pc, ch
      %string(15) n
         file limit = 0
         ether context = our context
         status = FS openR(Uno, "DIRECTORY", Xno, bc, pc)
         %if status # success %start
            pdate
            printstring("*** Failed to open ")
            printstring(our directory)
            printstring(":DIRECTORY -- ");  show error(status)
            newline
            %return
         %finish
         n = ""
         %cycle
            ch = get symbol(Xno)
            %exit %if ch < 0
            %if ch = nl %start
               file limit = file limit + 1
               files(file limit) = n
               n = ""
            %else
               n = n . to string(ch)
            %finish
         %repeat
         ether context = our context
         status = FS Close(Xno)
         %if status # success %start
            pdate
            printstring("*** Failed to close ")
            printstring(our directory)
            printstring(":DIRECTORY -- ");  show error(status)
            newline
         %finish
   %end

   %routine print one(%integer which)
      %integer Xno, bc, pc, ch, status, sym, last
         %return %if files(which) = "$$$........." %or %c
                     charno(files(which), length(files(which))) = '!'
         ether context = our context
         status = FS openR(Uno, files(which), Xno, bc, pc)
         %if status # success %start
            pdate
            printstring("Failed to open ")
            printstring(our directory);  print symbol(':')
            printstring(files(which))
            printstring(" -- ");  show error(status)
            newline
            %return
         %finish
         %if flags & despool report # 0 %or common_diags & despool diags # 0 %start
            pdate
            printstring("Print ")
            printstring(our directory);  print symbol(':')
            printstring(files(which))
            printstring("  (");  write(bc, 0)
            printstring(" block");  print symbol('s') %if bc # 1
            print symbol(')');  newline
         %finish
         next = 999
         txbuff = 0
         last = -1
         %cycle
            sym = get symbol(Xno)
            %if flags & despool transparent = 0 %start
               %if sym < 0 %start
                  %unless last = FF %start
                     put symbol(CR) %and put symbol(LF) %unless last = LF
                     put symbol(FF)
                  %finish
                  put symbol(-1)
                  column = 0
                  %exit
               %else %if sym = LF
                  put symbol(CR) %unless last = CR
                  put symbol(LF)
                  column = 0
               %else %if sym = CR
                  put symbol(CR) %unless last = CR
                  column = 0
               %else %if sym = FF
                  %unless last = FF %start
                     put symbol(CR) %and put symbol(LF) %unless last = LF
                     put symbol(FF)
                  %finish
                  column = 0
               %else %if sym = ESC %and flags & despool escape # 0
                  put symbol(ESC)
               %else %if sym = TAB %and flags & despool tabexpand # 0
                  put symbol(' ');  column = column + 1
                  put symbol(' ') %and column = column + 1 %while column & 7 # 0
               %else
                  put symbol(sym) %if ' ' <= sym <= '~'
                  column = column + 1
               %finish
            %else
               put symbol(-1) %and %exit %if sym < 0;  !!!
               put symbol(sym)
            %finish
            last = sym
         %repeat
         ether context = our context
         status = FS close(Xno)
         %if status # success %start
            pdate
            printstring("Failed to close ")
            printstring(our directory);  print symbol(':')
            printstring(files(which))
            printstring(" -- ");  show error(status)
            newline
            %return
         %finish
         ether context = our context
         status = FS delete(Uno, files(which))
         %if status # success %start
            pdate
            printstring("Failed to delete ")
            printstring(our directory);  print symbol(':')
            printstring(files(which))
            printstring(" -- ");  show error(status)
            newline
            %return
         %finish
   %end
      
      common == common area
   !!!common_diags = common_diags ! despool diags{! 64
      despooler ID = despooler ID + 1
      us = despooler ID
      our context = -100 - us
      our wait flag = despooler base + us
      our qsart = despool qsarts(us)
      our directory = despool directories(us)
      our password = despool passes(us)
      flags = despool flags(us)
      buff = claim buffer
      b == common_buffer(buff)
      pdate
      printstring(our directory)
      printstring(" starting")
      newline
      %cycle
         despooler ready(our wait flag)
         wait for(our wait flag)
         ether context = our context
         status = FS logon(our directory, our password, Uno)
         %if status # success %start
            pdate
            printstring(our directory)
            printstring(" failed to log on -- ")
            show error(status)
            newline
         %else
            next = 999
            get files
            print one(i) %for i = file limit, -1, 1
            ether context = our context
            status = FS logoff(Uno)
            %if status # success %start
               pdate
               printstring(our directory)
               printstring(" failed to log off -- ");  show error(status)
               newline
            %finish
         %finish
      %repeat
%end

%end %of %file