{ PLIB:SPOOL.PAS }

{ PBS spooling routine - 2/87 - EFM }

{ Contents:    spool(fileandoptionstring,queuenamestring,error)            }
{                                                                          }
{   Sends the specified file to the specified printer                      }
{   Only a single filename may be specified, but it may include wildcards  }
{   Values for queuenamestring:                                            }
{      LP0:            to print on the system line printer in the inner    }
{                          system room                                     }
{      LP1: or LA120:  to print on the main student printer in the         } 
{                          outer terminal room (also accepts a string of   }
{                          three or more blanks)                           }
{      LN03:           to print on the laser printer in the terminal room  }
{      DIABLO:         to print on the letter quality printer in the       }
{                          system room                                     }
{   The following options may appear on the end of the filename:           }
{      Option            Default                                           }
{      /[no]delete       /nodelete                                         }
{      /copies=n         /copies=1                                         }
{      /[no]flag_pages   /noflag_pages (opposite of PRINT)                 }
{      /[no]truncate     /notruncate                                       }
{      /[no]feed         /nofeed (opposite of PRINT?)                      }
{      /[no]convert      /noconvert                                        }
{                                                                          }
{   The options may be abbreviated to four characters, not counting '/NO'. }
{   These options have the same effect here as they do on the DCL PRINT    }
{   command.  See HELP PRINT for more information.                         }
{                                                                          }
{   Possible error codes returned include (in decimal):                    }
{      0 - no error occurred                                               }
{      4 - PBS has too many messages pending - try again later             }
{     32 - not enough buffer space available - try again later             }
{                                                                          }
{   Note that the error code returned indicates any errors which occurred  }
{   in sending the message to PBS.  It does NOT indicate whether or not    }
{   PBS detected an error in the message, whether or not PBS accepted it,  }
{   or whether or not PBS was able to process it successfully.  If you are }
{   an advanced programmer you can have your program declare itself to be  }
{   a receiver, and include the option /RECEIVER='xxxxxxyy' (where xxxxxx  }
{   is your receiver name and yy is the optional confirmation context      }
{   value) after the filename to have PBS send a confirmation or error     }
{   message back to your program.  Specifying different context values for }
{   each of multiple requests allows your program to tell to which request }
{   the confirmation/error message applies.                                }
{   When a confirmation message is received (via the receive message       }
{   system call, the following information will be in your FIRQB:          }
{   (the numbers are in octal)                                             }
{          Byte    Value    Meaning                                        }
{            4      -13                                                    }
{            5              PBS's job number times 2                       }
{           6-7             PBS's PPN (6=programmer, 7=project)            }
{           10       -1                                                    }
{           12        0                                                    }
{          36-37            the confirmation context value you sent        }
{          40-41            the error number (see below)                   }
{          42-43            if no error, this is entry number for request  }
{                             if error, this identifies the field in the   }
{                             request in which the error occurred          }
{       Possible (octal) error codes in the confirmation msg include:      }
{         0 - no error occurred - the request was accepted by PBS          }
{         2 - illegal filename or queuename                                }
{         4 - the specified queue is closed                                }
{         5 - the specified queue does not exist                           }
{        12 - the specified queue requires privilege                       }
{        40 - not enough buffer space available - try again later          }
{        73 - no filename specified                                        }


{$nodebug}
procedure spool(instr : packed array [lowi..highi:integer] of char; 
                  queuename : packed array [lowq..highq:integer] of char; 
                  var error : integer);
{ Sends an appropriate message to PBS }
  const
    pbsmsgmax = 512;
  type
    word = 0..65535;
  var
    delete, copies, feed, flagpages, convert, truncate,
        lenpos, instrlen, filenamelen, qstrlen, next, ptr, i : integer;
    firqbsignedbyte origin 402B : packed array [0..37B] of -128..127;
    firqbunsignedbyte origin 402B : packed array [0..37B] of 0..255;
    xrbinteger origin 442B : packed array [0..7B] of integer;
    pbsmsg : packed array [1..pbsmsgmax] of char;
    qstr : packed array [1..9] of char;
    confirmationreceivername : packed array [1..8] of char;
    negate : boolean;
    null : char;

  begin
    null := chr(0);

    { set up default values for /options }
    copies := 1;        { /copies=1 }
    feed := 0;          { 0 = /nofeed, 1 = /feed }
    flagpages := 0;     { 0 = /noflag_pages, 1 = /flag_pages }
    delete := 0;        { 0 = /nodelete, 1 = /delete }
    convert := 0;       { 0 = /noconvert, 1 = /convert }
    truncate := 0;      { 0 = /notruncate, 1 = /truncate }
    for i := 1 to 8 do  { /receiver='<8 nulls>' (= no confirm. msg/context val.) }
      confirmationreceivername[i] := null;

    next := 1;  { next available position in pbsmsg }
    case queuename[3] of
          '0' : case queuename[2] of  { LP0 or LN03 }
                  'P','p' : begin  { LP0 }
                              qstr := 'LP0      ';
                              qstrlen := 3
                            end;
                  'N','n' : begin  { LN03 }
                              qstr := 'LN03     ';
                              qstrlen := 4
                            end
                  end;  { case queuename[2] }
      '1',' ','S','s' : 
                begin  { LP1/LA120/   /SYS$PRINT }
                  qstr := 'SYS$PRINT';
                  qstrlen := 9
                end;
      'A','a' : begin  { Diablo }
                  qstr := 'DIABLO   ';
                  qstrlen := 6
                end;
        otherwise writeln('?Illegal queue name in spool.')
      end;  { case queuename[3] }
    pbsmsg[next] := chr(2);       { code for start of queuename field }
    next := next + 1;
    pbsmsg[next] := chr(qstrlen); { length of the queuename }
    next := next + 1;
    for i := 1 to qstrlen do
      pbsmsg[i+next-1] := qstr[i];
    next := next + qstrlen;
    if not odd(next) then  { pad so next item starts at an odd byte }
      begin
        pbsmsg[next] := null;
        next := next + 1
      end;

    if lowi = 0
      then instrlen := ord(instr[0])
      else instrlen := highi;
    pbsmsg[next] := chr(128);  { code for filename field }
    next := next + 1;
    lenpos := next;  { save this location so can put filename length in }
    next := next + 1;

    ptr := 0;
    next := next - 1;
    repeat
      next := next + 1;
      ptr := ptr + 1;
      pbsmsg[next] := instr[ptr]  { copy in the filename }
    until (ptr >= instrlen) or (instr[ptr] = '/') or (instr[ptr] = ' ')
            or (instr[ptr] = null);
    if (instr[ptr] = '/') or (instr[ptr] = ' ') or (instr[ptr] = null) 
      then     { last character was no good, so decrement pointers }
        begin
          ptr := ptr - 1;
          next := next - 1
        end;
    next := next + 1;

    pbsmsg[lenpos] := chr(ptr);  { now can go back and fill in filename len }
    if not odd(next) then  { pad so next item starts at an odd byte }
      begin
        pbsmsg[next] := null;
        next := next + 1
      end;

    { check for /options }
    while (ptr < instrlen) and (instr[ptr] <> '/') do
      ptr := ptr + 1;  { skip to an /option }
    while ptr < instrlen do
      begin
        ptr := ptr + 1;  { skip over the '/' }
        negate := (instr[ptr] in ['N','n']);  { is it a '/NO...' ? }
        if negate then  { skip over the 'NO' }
          ptr := ptr + 2;
        case instr[ptr] of    { which option is it? }
            'C','c' : case instr[ptr+2] of
                        'P','p' : begin  { /copies=n }
                                    while (ptr<instrlen) and (instr[ptr]<>'=') do
                                      ptr := ptr + 1;  { find the '=' }
                                    ptr := ptr + 1;    { skip over the '=' }
                                    copies := ord(instr[ptr]) - 48;
                                    while (ptr<instrlen) and 
                                          (instr[ptr+1] in ['0'..'9']) do
                                      begin
                                        copies := copies * 10;  { shift }
                                        ptr := ptr + 1;  { get next digit }
                                        copies := copies + (ord(instr[ptr])-48)
                                      end
                                  end;
                        'N','n' : begin  { /convert }
                                    if negate
                                      then convert := 0
                                      else convert := 1
                                  end;
                        otherwise writeln('?Illegal /option in spool')
                      end;  { case instr[ptr+2] }
            'F','f' : case instr[ptr+1] of
                        'L','l' : begin  { /flag_pages }
                                    if negate
                                      then flagpages := 0
                                      else flagpages := 1
                                  end;
                        'E','e' : begin  { /feed }
                                    if negate
                                      then feed := 0
                                      else feed := 1
                                  end;
                        otherwise writeln('?Illegal /option in spool')
                      end;  { case instr[ptr+2] }
            'D','d' : begin  { /delete }
                        if negate
                          then delete := 0
                          else delete := 1
                      end;
            'T','t' : begin  { /truncate }
                        if negate
                          then truncate := 0
                          else truncate := 1
                      end;
            'R','r' : begin  { /receive=confirmationreceivername }
                        while (ptr<instrlen) and (instr[ptr]<>'=') do
                          ptr := ptr + 1;  { find the '=' }
                        ptr := ptr + 1;    { skip over the '=' }
                        if (instr[ptr]='"') or (instr[ptr]=chr(39)) then
                          ptr := ptr + 1;  { skip over " or ' quote, if any }
                        i := 1;
                        while (i <= 6) and (ptr <= instrlen) and 
                              (instr[ptr] <> '/') and (instr[ptr] <> ' ')
                              and (instr[ptr] <> '"') and (instr[ptr] <> chr(39))
                              and (instr[ptr] <> null) do
                          begin
                            confirmationreceivername[i] := instr[ptr];
                            i := i + 1;
                            ptr := ptr + 1
                          end
                    end;
            otherwise writeln('?Illegal /option in spool')
          end;  { case instr[ptr] }
        while (ptr <= instrlen) and (instr[ptr] <> '/') do
          ptr := ptr + 1    { advance to the next qualifier }
      end;  { while ptr < instrlen }

    pbsmsg[next] := chr(130);  { code for /convert flag field }
    next := next + 1;
    pbsmsg[next] := chr(convert);  { 0 = /noconvert, 1 = /convert }
    next := next + 1;
    pbsmsg[next] := chr(131);  { code for number of copies field }
    next := next + 1;
    pbsmsg[next] := chr(copies);
    next := next + 1;
    pbsmsg[next] := chr(132);  { code for /delete flag field }
    next := next + 1;
    pbsmsg[next] := chr(delete);  { 0 = /nodelete, 1 = /delete }
    next := next + 1;
    pbsmsg[next] := chr(133);  { code for /feed flag field }
    next := next + 1;
    pbsmsg[next] := chr(feed);  { 0 = /nofeed, 1 = /feed }
    next := next + 1;
    pbsmsg[next] := chr(134);  { code for /flag_pages flag field }
    next := next + 1;
    pbsmsg[next] := chr(flagpages);  { 0 = /noflag, 1 = /flag }
    next := next + 1;
    pbsmsg[next] := chr(135);  { code for /truncate flag field }
    next := next + 1;
    pbsmsg[next] := chr(truncate);  { 0 = /notruncate, 1 = /truncate }
    next := next + 1;

    for i := 1 to 37b do
      firqbsignedbyte[i] := 0;  { zero the firqb }
    for i := 1 to 7b do
      xrbinteger[i] := 0;       { zero the xrb }

    firqbsignedbyte[4b] := -13b;      { 'send with privilege mask' subfunction }
    firqbunsignedbyte[5b] := 200b+5b; { destination - loc obj type 5 - PBS URP }
    firqbsignedbyte[24b] := 1b;   { 1 = PRINT request, 2 = BATCH request }
    for i := 26b to 35b do  { copy in the confirm. receiver name/context value }
      firqbunsignedbyte[i] := ord(confirmationreceivername[i-25b]);
    xrbinteger[0b] := next - 1;   { buffer length }
    xrbinteger[1b] := next - 1;   { number of characters to send }
    xrbinteger[2b] := loophole(word,ref(pbsmsg));  { address of buffer }

    emt(255);
    emt(60b);  { .MESAG }
    error := firqbsignedbyte[0];
  end;  { spool }
{$debug}