! Mouses line printer spooler               1-FEB-80

%begin
   %conststring(3)  spooler name = "lp"
   %constinteger  lp demon = 111
   %constinteger max copies = 10
   %constinteger line length = 132, page size = 65
   %constinteger banner lines = 8
   %constinteger  buffmax = 1023;      ! MUST BE 2\\N-1
   %constinteger  max files = 42;      ! SYSTEM CONSTANT

   %recordformat parmfm(%shortinteger dsno,dact,ssno,sact, %c
                         %integer  p1,p2,p3,p4,p5,p6)
   %record(parmfm) p, p2
   %string(29)%name  s

   %ownstring(9) date, time, cdate
   %ownstring(29) file;  %integer  file index, current id
   %integer spooler;         ! PACKED FORM OF NAME

   %constinteger  vt=11, ff=12, cr = 13
   %owninteger  ownername,limit
   %integer  rubbish, error1, error2, copies, active, delete, paused
   %integer lines, pages, lines left
   %constinteger mask = b'0011111000000000'
   %byteintegerarray  discbuff(0:511);  %integer  inbuff
   %integer outbuff
   %integer  bufflim
   %owninteger  ibp,obp, end of line
   %shortinteger  sym, last sym, next state
   %integer  j

! States
   %constinteger  message=1
   %constinteger  command = 2
   %constinteger  accept = 3
   %constinteger  next file = 4
   %constinteger  header = 5
   %constinteger  data in = 6
   %constinteger  flush = 7
   %constinteger  trailer = 8
   %constinteger  close = 9

   %switch  state(message:close)

! Commands

   %constinteger  pause = 1
   %constinteger  continue = 2
   %constinteger  restart = 3
   %constinteger  cancel = 4
   %constinteger  stop = 5
   %constinteger  option = 6;      ! *** not supported ***

   %switch  com(pause:option)



%routine poff(%integer n, %record(parmfm)%name p)
   p_sact = n;  svc(16,p)
%end

%routine  report(%string(31) s)
   %record(parmfm) p
   string(addr(p_p1)) = s
   p_dsno = 0
   svc(120,p)
%end

%string(29)%fn  unpacked(%record(parmfm)%name  r)
   %record(parmfm)  p
   p_p1 = r_p1;  p_p2 = r_p2;  p_p3 = r_p3;  p_p4 = r_p4
   svc(18,p)
   %result = string(addr(p_sact))
%end

%integerfn  packed(%string(29)  s)
   %record(parmfm)  p
   string(addr(p_sact)) = s.":"
   svc(17,p)
   %result = p_p2
%end

%routine  attach spooler
   %record(parmfm)  p
   p_p1 = spooler;  p_p2 = accept
   p_dact = 2;  svc(22,p)
%end

%integerfn  system buffer address
   %record(parmfm)  p
   svc(110,p)
   %if p_p1 < 0 %start
      report("claim buffer failed")
      *=0
   %finish
   %result = p_p1<<16
%end

%routine  accept file
   %record(parmfm)  p
   %integer id
   p_dact = 4;  svc(22, p);         !CLAIM FILE
   id = p_p1;                        !FILE ID
   error1 = 1 %and %return %if p_p6 # 0
   p_p1 = id;  p_dact = 5;  svc(22,p);      ! TAKE
   error1 = p_P6
   report("accept:".string(addr(p_p1))) %if error1 # 0
%end

%routine  get next file
   %record(parmfm)  p
   active = 1
   p_dact = 8;  svc(22, p);      !Request a file
   error2 = p_p6
   active = 0 %and %return %if error2 = -108;    ! none left
   %if error2 >= 0 %start
      current id = p_p1
      p_dact = 6;  p_p1 = current id;  svc(22, p);   !Identify
      error2 = p_p6;  -> FAIL %if error2 < 0
      file = unpacked(p)
      p_dact = 7;  p_p1 = current id;  svc(22, p);   !Locate
      p_dact = 4;  svc(20,p);      ! OPEN SEQUENTIAL INPUT
      file index = p_p5
      error2 = p_p6
      %return %if error2 >= 0
   %finish
FAIL:
   report("Get: ".string(addr(p_p1)))
%end

%routine  close input
   %record(parmfm) p
   p_dact = 11
   p_p5 = file index
   svc(20,p)
   %if p_p6 # 0 %start
      report("close: ".string(addr(p_p1)))
   %finish
%end

%routine  reset input
   %record(parmfm)  p
   p_dact = 12
   p_p5 = file index
   svc(20,p)
   %if p_p6 # 0 %start
      report("reset: ".string(addr(p_p1)))
   %finish
%end

%routine delete file
   %record(parmfm) p
   p_dact = 9;  p_p1 = current id;  svc(22, p);   !Delete
%end

%routine   get block(%integer  next, alt)
   %record(parmfm)  p
   p_dact = 7;  p_p4 = inbuff;  p_p5 = file index;  svc(20,p)
   next state = next
   next state = alt %if p_p6 < 0 %or delete # 0;    ! eof
%end

%routine  put block(%integer then)
   %record(parmfm) p
   p_p2 = obp-outbuff
   p_p1 = outbuff
   p_sact = then
   svc(lp demon,p)
   obp = outbuff
%end

%routine  clear(%integer  n)
   %if obp + n > bufflim %start
      obp = bufflim-n+1
      byteinteger(obp-1) = nl
   %finish
%end

%routine psym(%integer sym)
   %if sym = ff %start
      sym = nl %if lines left = page size
      lines left = page size
   %finish
   %if obp = bufflim+1 %start
      report("Caption too big")
      %return
   %finish
   byteinteger(obp) = sym;  obp = obp+1
   %if sym = nl %start
      lines left = lines left-1
      psym(ff) %if lines left <= 0
   %finish
%end

%routine set dt
   %record(parmfm) p
   svc(7, p)
   date = string(addr(p_p1))
   time = string(addr(p_p4))
%end

%routine set(%integer size, %string(63) what)
   %integer j,l,s
   l = length(what)
   %for j = 1, 1, size %cycle
      %if j > l %then s = ' ' %else s = charno(what, j)
      psym(s)
   %repeat
%end

%routine set banner(%string(5) end)
   %integer j
   %const %string(32) %array mouse(0:7) = %c
      "~\                              ",
      "  \   /~~~~~~~~~\               ",
      "  /  /           ~\     /~\     ",
      " /  /  **MOUSES**  ~\   |  |    ",
      "(  /   ___           ~\_\  /_   ",
      "(  |      \                  \  ",
      " \_|       \____      |     o \ ",
      "   \____________\______\_______\"

   set dt
   j = banner lines
   j = lines left-1 %if lines left < banner lines-3
   %cycle
      set(34,mouse(8-j))
      set(7, end)
      set(28, file)
      set(9+1, date);  set(8+2, time)
      set(32,mouse(8-j))
      psym(nl)
      j = j-1;  %return %if j <= 0
   %repeat
%end

%routine  set trailer
   %conststring(7)%array  why(1:2) = "restart", "delet"
   %integer j
   j = lines left-banner lines-5
   j = 4 %if j > 4
   %cycle
      psym(nl)
      j = j-1
      %exit %if j < 0
   %repeat
   set(28, "output ".why(delete)."ed by operator") %if delete # 0
   psym(nl)
   set banner(" end ");  psym(ff)
%end

! =============start here=============

!
! initialisation
   out buff = system buffer address
reprime:
   spooler = packed(spooler name)
   attach spooler
   inbuff = addr(discbuff(0))
   bufflim = outbuff+buffmax
   active = 0;  rubbish = 0;  delete = 0;  paused = 0

   %cycle;        ! main loop
      poff(0,p)
      -> state(p_dact) %if message <= p_dact <= close
      report("bad dact")
      %continue


state(command):
      -> com(p_p2) %if pause <= p_p2 <= option
      ->reprime %if p_p2 = 7;    !potter is sick
      report("Faulty command");  %continue
   com(pause):
         paused = 1;  %continue
   com(restart):
         %if active # 0 %and paused = 0 %start
            copies = copies+1
            delete = 1
            %continue
         %finish
   com(continue):
         paused = 0;  -> more %if active # 0
         ->start next file;         !just in case
   com(cancel):
         copies = 0;  delete = 2;  %continue
   com(stop):
         paused = -1;  %continue
   com(option):            ! ignored meantime
         %continue

state(message):report("LP kicked")
state(accept):
      accept file
      %continue %if error1 # 0 %or active # 0 %or paused # 0

start next file:
state(next file):
      copies = 1
      get next file
      %continue %unless error2 = 0 %and active # 0


next copy:
state(header):
      delete = 0
      ibp = inbuff+512;  obp = outbuff
      lines = 0;  pages = 0;  last sym = 0
      lines left = page size
      set banner("start");                ! ** Maximum of 1023 characters **
      psym(nl) %for j = 1,1,3
      end of line = obp

more:
state(data in):
      %continue %if paused > 0
      %while obp # bufflim+1 %cycle
         %if ibp = inbuff+512 %start
            ibp = inbuff
            get block(data in,flush)
            -> state(next state)
         %finish
         sym = byte integer(ibp)&127;  ibp = ibp+1
         %if sym < 32 %start
            %continue %if sym = FF = last sym
            %if mask&(1<<sym) = 0 %start
               %continue %if sym = 0 %or sym = 4
               sym = '?'
               rubbish = rubbish+10
               rubbish = 0 %if rubbish < 0
               %if rubbish > 200 %start
                  clear(18)
                  psym(nl);  psym(nl)
                  set(16,"output abandoned")
                  delete = 2
                  copies = 0
               %finish
            %else
               %if sym = vt %start
                  %continue %if lines left > 8
                  sym = ff
               %finish
               end of line = ((obp-outbuff+line length)&buffmax)+outbuff
            %finish
            -> flush it %if delete # 0
         %else;         !printing char
            %if obp = end of line %start
               sym = nl;  ibp = ibp-1
            %finish
         %finish
         rubbish = rubbish-1
         last sym = sym
         psym(sym)
      %repeat
      put block(data in);  %continue

flush it:
state(flush):
      %if obp # outbuff %start
         put block(trailer);  %continue
      %finish

state(trailer):
      set trailer
      put block(close);  %continue

state(close):
      copies = copies - 1
      %if copies > 0 %start
         reset input;  -> next copy
      %finish
      close input;  delete file
      paused = |paused|
      -> start next file %if paused = 0

   %repeat

%endofprogram
