{  29/8/86  12:02   Despooler}

!  This program sends files to the laser printer. It will deal with
!  included files in the form $z.include file.
!  If a file name is given as the parameter of the call, the despooler
!  will stop after sending the file.
!  The default directory is that of the current caller.
!  If a file name is not given, the prompt "File: " will be given. Giving
!  file-names here, separated by commas, will lead to the files being sent
!  and a repetition of the prompt. Responding with <CR> will lead to the
!  program running interminably, despooling the directory LP2:
!  Any files whose names start with LP2: are destroyed after they are sent
!  to the printer, unless the sending fails.
!  The program tests for the printer being live before it sends each
!  document. If it is not, or is busy computing, the message
!  Printer not ready is displayed at the console. After five successive
!  failures the program pauses and waits for yes to be typed at the console.
!  The program sends $E* whenever it starts printing a new set of files.
!  It encloses each file in $S*.XYZ and $E*.XYZ

%include "sm:utils.inc"
%include "sm:consts.inc"
%include "inc:util.imp"

%ownstring(31) default directory
%recordformat itemf(%record(itemf)%name next,prev,%string(255) file)
%recordformat itemlistf(%record(itemf)%name head,tail)
%ownrecord(itemlistf) stack,temp

%record(itemf)%map newitem
%record(itemf) pattern
%record(itemf)%name p
  p==new(pattern)
  p_file=""
  p_next==nil; p_prev==nil
  %result==p
%end

%routine push(%string(255) b,%record(itemlistf)%name stack)
%record(itemf)%name p
  p==newitem
  p_file=b
  prefix cell(p,stack)
%end

%routine pop(%string(*)%name a,%record(itemlistf)%name stack)
%record(itemf)%name p
  a=""
  %signal %event 9,2 %if stack_head==nil
  p==stack_head
  excise cell(p,stack)
  a=p_file
  dispose(p)
%end

! SMLASER: Send to laser printer with new controller.

%string(255)%fn smlaser(%string(255) in)

%constinteger RT=13,XON=17, XOFF=19, ESC=27
%integer count, oldtime, XOFFED=0, CURIN=0
%string(255) x

! Signetics Duart:-
%recordformat DUARTF (-
%byte pad0,   %byte MR12A {mode register             A  W&R},
(%byte pad2,  %byte SRA   {status register           A  R}-
%or%byte pd2, %byte CSRA) {clock select register     A  W},
%byte pad4,   %byte CRA   {command register          A  W},
(%byte pad6,  %byte RHRA  {RX holding register       A  R}-
%or%byte pd6, %byte THRA) {TX holding register       A  W},
(%byte pad8,  %byte IPCR  {input port change register   R}-
%or%byte pd8, %byte ACR)  {auxiliary control register   W},
(%byte padA,  %byte ISR   {interrupt status register    R}-
%or%byte pdA, %byte IMR)  {interrupt mask register      W},
(%byte padC,  %byte CTU   {counter/timer upper          R}-
%or%byte pdC, %byte CTUR) {counter/timer upper register W},
(%byte padE,  %byte CTL   {counter/timer lower          R}-
%or%byte pdE, %byte CTLR) {counter/timer lower register W},
%byte pad10,  %byte MR12B {                          B  W&R},
(%byte pad12, %byte SRB   {                          B  R}-
%or%byte pd12,%byte CSRB) {                          B  W},
%byte pad14,  %byte CRB   {                          B  W},
(%byte pad16, %byte RHRB  {                          B  R}-
%or%byte pd16,%byte THRB) {                          B  W},
%byte pad18,pad19,
(%byte pad1A, %byte INP   {input port                   R}-
%or%byte pd1A,%byte OPCR) {output port config reg       W},
(%byte pad1C, %byte STRCC {start counter command        R}-
%or%byte pd1C,%byte SOPBC){set output port bits command W},
(%byte pad1E, %byte STPCC {stop counter command         R}-
%or%byte pd1E,%byte ROPBC){reset output port bits command W})

@16_0007F440 %record(duartf) DUART

%constinteger RXRDY=1, TXRDY=4

%integerfn LASTPOS(%string(*)%name s,%integer k)
%integer i
  i=length(s)
  i=i-1 %while i>0 %and charno(s,i)#k
  %result=i
%end

%routine OPEN(%string(255) name)
  %on %event 3,9 %start
    printstring(event_message);  newline
    select input(curin)
    %return
  %finish
  printstring("Opening ".name);  newline
  open input(curin+1,name)
  curin=curin+1;  select input(curin)
%end

%routine HANDLE INPUT
%integer insym
%cycle
  insym=duart_rhra&127
  %if insym=xon %start
    xoffed=0
    printstring("XON");  newline
  %else %if insym=xoff
    xoffed=1
    printstring("XOFF");  newline
  %else
    printsymbol(insym) %if insym>=' ' %and insym#nl
  %finish
  %exit %if xoffed=0
  %cycle; %repeat %until duart_sra&rxrdy#0
%repeat
%end

%routine SEND SYM(%integer sym)
  handle input %while duart_sra&rxrdy#0;  !incoming char
  %cycle; %repeat %until duart_sra&txrdy#0
  duart_thra=sym
%end

%routine SEND STRING(%string(255) s)
%integer sym,insym,i=0
  %while i<length(s) %cycle
    i=i+1
    handle input %while duart_sra&rxrdy#0;  !incoming char
    %cycle; %repeat %until duart_sra&txrdy#0
    duart_thra=charno(s,i)
  %repeat
%end

%routine SEND FILE
%integer first=yes,hold,sym,insym,j,last
%string(63) s,t,document

  %on %event 9 %start
    close input
    curin=curin-1
    select input(curin)
    send string("$E*.".snl) %and %return %if curin=0
  %finish

  select input(0); select output(0)
  %if first=yes %thenstart
    count=0
    %cycle
      send string("$Z.RSVP '@'".snl)
      oldtime=cputime
!  Wait for 20 seconds.
      %cycle
        %exit %if duart_sra&rxrdy#0
      %repeat %until cputime-oldtime>20000
      %if duart_sra&rxrdy#0 %thenstart
        %exit %if duart_rhra&127='@'
      %finish
      print string("Printer not ready.".snl)
      count=count+1
!  Ask for <y> after five failures.
      %if count=5 %thenstart
        count=0
        prompt("Printer reset? ")
        %cycle
          skip symbol %if next symbol=nl
          get line(x)
          lower(x)
          %exit %if charno(x,1)='y'
          %stop %if x=".end"
        %repeat
      %finish  ;!  Count=5.
    %repeat
    send string("$E*".snl)
    s=time
    s->s.(".").t
    document="lp2".s.t
    send string("$S*.".document.snl)
  %finish
  select input(curin)
  hold=0;  last=nl
  first=no
  %cycle
    handle input %while duart_sra&rxrdy#0
    %if hold#0 %then sym=hold %and hold=0 %else read symbol(sym)
    %if last=nl %and sym='$' %start
      handle input %while duart_sra&rxrdy#0
!  Inclusions are of the form $Z.INCLUDE file
      %if nextsymbol='z' %or next symbol='Z' %start
        prompt("$Z found: ")
        skip symbol
        %if nextsymbol='.' %start
          skip symbol
          prompt("$Z. found. ")
          s="$z."
          %while next symbol>' ' %cycle
            read symbol(j)
            s=s.tostring(j)
          %repeat
          lower(s)
          %if s->("$z.incl").t %thenstart
            prompt("Filename: ")
            skip symbol %while next symbol=sp
            s=""
            %while next symbol>' '%cycle
              read symbol(sym)
              s=s.tostring(sym)
            %repeat
            read symbol(sym) %while next symbol#nl
            open(s)
            %continue  ;!  This takes control to %cycle above to include file.
          %finishelse send string(s)
        %finishelse hold='g'
      %finish
    %finish
    handle input %while duart_sra&rxrdy#0;  !incoming char
    %cycle; %repeat %until duart_sra&txrdy#0
    duart_thra=sym
    last=sym
  %repeat
%end

{Main sequence.}

  %on %event 3,9,10 %start
    select output(0)
    print string("Trap in Smlaser(.".in.")". %c
    itod(event_event)." ".itod(event_sub)."  ".event_message.snl)
    newline
    %if event_event=9 %then %result="" %else %result="fault"
{  ->next}
  %finish

{reset MR pointer to address MR1}
  DUART_cra=16_10       
  DUART_MR12a=16_13     {no-parity, 8-bits}

{second access is to MR2}
  DUART_MR12a=16_07     {1.0 stop bits

  duart_acr=16_80       {clock}
  duart_csra=16_BB      {9600 baud RX & TX
  duart_cra=16_20;          !reset receiver
  duart_cra=16_40;          !reset error status
  duart_cra=16_05;          !enable TX & RX

next:
  curin=0
  open(in)
  %if curin>0 %start
    send sym(1)
    send file
  %finish
  send sym(esc);  send sym('e')
  send sym('*');  send sym(nl)
  %result=""
%end

%string (7) %fn Current Directory
@16_01110 %integerFN  fcommr(%integer c,%string(255)p,
                      %bytename b,%integer max) ;!Added by JHB
%string (255) Me
%integer I=1

  %on %event 3,9 %start
    %result=""
  %finish

  Length (Me)=Fcommr ('F'<<8, "", Charno (Me, 1), 255)
  I=I + 1 %while Charno (Me, I) # ' '
  Length (Me)=I - 1
  %result=Me
%end

%routine read word(%string(*)%name a)
%integer j
  read symbol(j) %until sp#j#nl
  a=""
  %cycle
    a=a.tostring(j)
    read symbol(j)
  %repeat %until j=sp %or j=nl
%end

%routine use stack
%string(255) b,c
  %while stack_head##nil %cycle
    pop(b,stack)
    %continue %if charno(b,length(b))='!'
    lower(b)
    message("Stopped by '.end'","stop") %if b=end
    c=default directory %unless b->c.(":").b
    lower(c)
    b=c.":".b
!  Testing the value returned by smlaser sends the
    delete(b) %and  print string("Deleting ".b.snl) %c
    %if smlaser(b)="" %and c="lp2"
  %repeat
%end

%externalroutine despool1
%string(255) x

  %on %event 9 %start
    %signal %event 9,event_sub %if 1#event_sub#2
    use stack
    %return
  %finish

  stack_head==nil; stack_tail==nil
  open input(1,"LP2:directory")
  %cycle
    select input(1)
    read word(x)
    push(x,stack)
  %repeat
%end

{Main Program}

%begin
%string(255) x,y
%integer i

  %on %event 3,9,10 %start
    delete list(stack)
    close input %unless instream=0
    x=""
    ->dspl1 %if event_event=3
    ->readfiles
  %finish

  x=cliparam
  x=x.",.end" %unless x=""
readfiles:
  stack_head==nil; stack_tail==nil
  temp_head==nil; temp_tail==nil
  default directory=current directory
  set terminal mode(nopage)
  open input(0,":t")
  %cycle
    select input(0); select output(0)
    %if x="" %thenstart
      prompt("File: ")
      get line(x)
    %finish
    %exit %if x=""
    %stop %if x=end
    stack_head==nil; stack_tail==nil
    %cycle
      y=x %and x="" %unless x->y.(",").x
      push(y,temp)
    %repeat %until x=""
    pop(x,temp) %and push(x,stack) %while temp_head##nil
    x=""
    use stack
  %repeat
dspl1:
  default directory="LP2"
  %cycle
    despool1
!  Wait 4 seconds and try again.
    %for i=1,1,300000 %cycle; %repeat
  %repeat

%endofprogram