(*  Custom version of PRINT, called SYSPRNT.  It includes the  *)
(*  system name (HPSYSNAME) in the heading, when the PAGEHEAD  *)
(*  option is used.                                            *)
(*                                                             *)
(*  R. Horner 07/21/2000                                       *)
(*                                                             *)
VAR RF: TFILECOMBINED;
VAR INFILE: STRING[256];
VAR OUTFILE: STRING[128];
VAR STARTREC: INTEGER;
VAR STARTRECFIXED: INTEGER;
VAR ENDREC: INTEGER;
VAR BUF: BOOLEAN;
VAR SEARCHSTR: STRING[256];
VAR SEARCHC: SHORTINT;
VAR PREVSTR: STRING[256];
VAR PREVC: SHORTINT;
VAR CAFTERSTR: STRING[256];
VAR CAFTERC: SHORTINT;
VAR CBEFORESTR: STRING[256];
VAR CBEFOREC: SHORTINT;
VAR FORMATSTR: STRING[256];
VAR FORMATCODE: SHORTINT;
VAR TADDR: SHORTINT;
VAR T: POINTER TPRINTINFO;
VAR TYPE: STRING[1];
VAR PAGESIZE: INTEGER;
VAR PPAGEHEAD: BOOLEAN;
VAR NUM: BOOLEAN;
VAR REC: STRING[1024];
VAR PREVREC: STRING[1024];
VAR PREVNUM: STRING[10];
VAR RECLEN: INTEGER;
VAR MATCHEDPREV: BOOLEAN;
VAR CHECKINGCAFTER: BOOLEAN;
VAR SEARCHRESULT: BOOLEAN;
VAR PREVRESULT: BOOLEAN;
VAR LASTNONPRINTEDRECNUM: INTEGER;
VAR LASTPRINTEDRECNUM: INTEGER;
VAR INTERACT: BOOLEAN;
VAR SAVECONTROLY: INTEGER;
VAR SVEOUTFNUM: INTEGER;
VAR NOPAGE: BOOLEAN;
VAR COPYACCESS: BOOLEAN;
VAR NONUMRECOGNIZE: BOOLEAN;
VAR ALLFILENAMES: BOOLEAN;
VAR DOMAIN: SHORTINT;
VAR DOMAINSTR: STRING[8];
VAR VARNONDELIMS: STRING[256];
VAR KEEPAMDATES: BOOLEAN;
VAR F: STRING[VE_SIZE_FILENAME];
VAR CCTL: BOOLEAN;
VAR OUTSIZE: INTEGER;
VAR FILESETCMD: BOOLEAN;
VAR NOBANNERYET: BOOLEAN;
VAR NOEJECTYET: BOOLEAN;
VAR ABORTOPERATION: BOOLEAN;
VAR DONTASK: BOOLEAN;
VAR NUMFILES: INTEGER;
VAR HILIGHT: SHORTINT;
VAR WAIT: SHORTINT;
VAR LONGWAIT: BOOLEAN;
VAR SKIP: SHORTINT;
VAR IV: STRING[4];
VAR LINECOUNT: INTEGER;
VAR LINESFOUND: INTEGER;       (* obsolete *)
VAR MAXLINES: INTEGER;         (* obsolete *)
VAR MAXFOUND: INTEGER;         (* MAX search matches in current file *)
VAR MAXSHOWN: INTEGER;         (* MAX lines displayed in current file *)
VAR NUMFOUND: INTEGER;            (* search matches in current file *)
VAR SHOWN: INTEGER;            (* lines displayed in current file *)
VAR GLOBNUMFOUND: INTEGER;        (* MPEXPRINTLINESFOUND counter *)
VAR DONE: BOOLEAN;             (* deferred 'file done' flag *)
VAR ISBYTE: BOOLEAN;
VAR INITIALEOF: INTEGER;
VAR DEBUG: BOOLEAN;
VAR SPF: BOOLEAN;              (* experimental *)
VAR STARTPAGE: INTEGER;        (* undocumented *)
VAR ENDPAGE: INTEGER;          (* undocumented *)
VAR MUSTSAVE: BOOLEAN;

SUBROUTINE DOCALL (CODE: VALUE INTEGER);
BEGIN
ISBOOLEAN (CALLVAR (CODE, ISDOUBLE(T)))
END;

SUBROUTINE MYTEXTPOINT (ADDR: SHORTINT; RNUM: VALUE INTEGER);
BEGIN
TRY TEXTPOINT (ADDR, RNUM) RECOVER;
END;

SUBROUTINE PRINTREADDIR (NUM: VALUE INTEGER);
BEGIN
MYTEXTPOINT (TADDR, NUM);
PRINTREAD (T, REC, RECLEN)
END;

(* default value in FTRUE'EOF is near MAXINT, but not so near *)
(* that adding small numbers to it will cause an overflow.    *)
SUBROUTINE TRUEEOF;
BEGIN
TRY CALL FTRUE'EOF (TEXTFNUM(TADDR), 32767, 0) RECOVER 0
END;

SUBROUTINE VESOFTPAGESIZE; IVAR ('VESOFTPAGESIZE', 60);

WITH T DO
BEGIN

SUBROUTINE SLOWTRUEEOF;
VAR RETNUM: INTEGER;
SEG (BEGIN
MYTEXTPOINT (TADDR, 2000000000);      (* returns actual EOF, the slow way *)
RETNUM:=RECNUM;
MYTEXTPOINT (TADDR, 0);
RETNUM+0
END);

SUBROUTINE SUBFMTLINENUMBER; FMTLINENUMBER;

SUBROUTINE DOSELECT;
VAR CAFTERMATCHED: BOOLEAN;
BEGIN
CAFTERMATCHED:=CHECKINGCAFTER AND (CAFTERC=0 OR DOCALL (CAFTERC));
(* Handle CONTEXT=,1 type searches *)
IF CAFTERMATCHED AND NUMFOUND>=MAXFOUND THEN
  DONE:=TRUE;
IF (SEARCHRESULT:=SEARCHC=0 OR DOCALL (SEARCHC)) THEN
  BEGIN
  ++NUMFOUND;
  (* handle CONTEXT=1 type searches *)
  IF NUMFOUND>=MAXFOUND AND (CAFTERC=0 OR CAFTERMATCHED) THEN
    DONE:=TRUE;
  IF CAFTERC<>0 THEN
    CHECKINGCAFTER:=TRUE;
  RECNUMSEARCH:=RECNUM;
  END;
IF (PREVRESULT:=PREVC<>0 AND DOCALL(PREVC)) THEN
  BEGIN
  MATCHEDPREV:=TRUE;
  PREVREC:=REC;
  PREVNUM:=SUBFMTLINENUMBER;
  END;
IF CAFTERMATCHED AND NOT SEARCHRESULT THEN
  BEGIN
  CHECKINGCAFTER:=FALSE;
  TRUE
  END
ELSE IF CHECKINGCAFTER OR SEARCHRESULT THEN
  TRUE
ELSE
  BEGIN
  LASTNONPRINTEDRECNUM:=RECNUM;
  FALSE
  END
END;

SUBROUTINE ASKCONTINUE;
VAR SEL: STRING[10];
VAR NEWREC: INTEGER;
BEGIN
SEG (
  BEGIN
  LINECOUNT:=0;
  SEL:=READSTRING (
    (IF NOBANNERYET THEN
       ''
     ELSE IF ISBYTE THEN
       STRWRITE ('(', RECNUM, '/'+
                (IF STARTREC<0 OR ENDREC<0 THEN
                   STRWRITE(INITIALEOF) ELSE '?')+
                 ') (', BYTENUM, '/', TRUEEOF,') ')
     ELSE
       STRWRITE ('(', RECNUM, '/', TRUEEOF, ') '))+
    'Continue (Yes/No/Quit/Dontask)?');
  IF HPTERMINAL() THEN
    WRITEPROMPT (%33C, 'A', %33C, 'K');
  END);
SEG (
  BEGIN
  IF UPS(SEL)[0:2]='NU' THEN    (* force NUMBER flag on *)
    BEGIN
    NUM:=TRUE;
    TRUE
    END
  ELSE IF UPS(SEL)[0:2]='UN' THEN    (* force NUMBER flag off *)
    BEGIN
    NUM:=FALSE;
    TRUE
    END
  ELSE IF UPS(SEL)[0:1]='N' THEN
    BEGIN
    ABORTMPE (VE_E_FLUSHED);
    FALSE
    END
  ELSE IF UPS(SEL)='Q' OR UPS(SEL)='QUIT' THEN
    BEGIN
    ABORTOPERATION:=TRUE;
    ABORTMPE (VE_E_FLUSHED);
    FALSE
    END
  ELSE IF UPS(SEL)='D' OR UPS(SEL)='DONTASK' THEN
    BEGIN
    DONTASK:=TRUE;
    TRUE
    END
  ELSE IF SEL<>'' AND VALIDINTEGER (SEL) AND TADDR<>0 THEN
    BEGIN
    IF SEL[0:1]='-' OR SEL[0:1]='+' THEN
      NEWREC:=RECNUM+INTEGERPARSE (SEL)-1
    ELSE
      NEWREC:=INTEGERPARSE (SEL)-1;
    (* exit silently if start>eof *)
    NEWREC:=MIN(NEWREC, TRUEEOF);
    MYTEXTPOINT (TADDR, MAX(0,NEWREC));
    FALSE  (* don't print the line we were about to print *)
    END
  ELSE
    TRUE  (* OK to print the line we were about to print *)
  END)
END;

SUBROUTINE PRINTBANNER (F: VALUE STRING);
SEG (
  BEGIN
  IF INTERACT AND OUTFILE='$STDLIST' THEN
    BEGIN
    IF INTERACT AND (LINECOUNT0 AND HPTERMINAL() THEN
        WRITEPROMPT (%33C, '&dJ');
      WRITELN ('-----Printing ', F);
      ++LINECOUNT;
      END;
    END
  ELSE
    (* don't WRITELN, it would send the line to the ;OUT= file. *)
    MPE ('ECHO -----Printing '+F);
  NOBANNERYET:=FALSE;
  END);

SUBROUTINE PRINTPAGEHEAD (F: VALUE STRING);
SEG (
  BEGIN
  WRITELN ('SYSTEM: ', HPSYSNAME);    (* Here is the change *)
  WRITELN ('MPEX %PRINT ', FREMLOCKWORD(F),
           STRWRITE (HPDATEF, ', ', HPTIMEF, '  (PAGE ', VEPAGENUMBER, ')')
             :(80-13-LEN(FREMLOCKWORD(F))):'RIGHTJUST');
  WRITELN;
  END);

SUBROUTINE PAGEEJECT;
SEG (
  BEGIN
  IF NOT NOPAGE AND NOT INTERACT AND NUMFILES>1 THEN
    WRITEPAGE ();
  NOEJECTYET:=FALSE;
  END);

SUBROUTINE MAYWRITECCTL (CCTL: VALUE BOOLEAN; S: VALUE STRING);
BEGIN
IF NOT INTERACT OR LINECOUNT0 AND NOT VE_G_LOGIC_STATE AND LEN(RR)>0 THEN
    IF CCTL THEN
      RR[0:1]+IV+RR[1:512]
    ELSE
      IV+RR
  ELSE
    RR
ELSE
  BEGIN
  SAVER:=RADDRLEN;
  RADDRLEN:=ISDOUBLE(RR);
  SCOPY1 (CALLVARSTR (FORMATCODE, ISDOUBLE(T)), RADDRLEN:=SAVER)
  END
END;

SUBROUTINE OUTLINE;
BEGIN
IF MATCHEDPREV THEN
  OUT1 (IF NUM THEN STRWRITE(PREVNUM:9)+'-'+FORMAT(PREVREC)
               ELSE FORMAT(PREVREC));
IF NOT MATCHEDPREV OR PREVNUM<>SUBFMTLINENUMBER THEN
  BEGIN
  IF NUM THEN
    OUT1 (STRWRITE(SUBFMTLINENUMBER:9)+
          (IF SEARCHRESULT AND (CAFTERC<>0 OR CBEFOREC<>0) THEN '*' ELSE ' ')+
          FORMAT(REC))
  ELSE
    OUT1 (FORMAT(REC));
  IF ++LINESFOUND>=MAXLINES THEN       (* obsolete *)
    ABORTMPE (VE_E_FLUSHED);
  IF ++SHOWN>=MAXSHOWN THEN
    (* MAX used without SEARCH;CONTEXT *)
    ABORTMPE (VE_E_FLUSHED);
  END;
MATCHEDPREV:=FALSE;
END;

SUBROUTINE DORECWITHCBEFORE;
VAR SAVERECNUM: INTEGER;
BEGIN
IF SEARCHRESULT AND CBEFOREC<>0 THEN
  SEG (
    BEGIN
    SEARCHRESULT:=FALSE;
    SAVERECNUM:=RECNUM;
    WHILE RECNUM>STARTRECFIXED AND
          RECNUM>LASTPRINTEDRECNUM+1 AND
          PRINTREADDIR (RECNUM-2) AND
          NOT DOCALL(CBEFOREC) DO
      ;
    IF RECNUM<=LASTNONPRINTEDRECNUM THEN
      BEGIN
      LASTNONPRINTEDRECNUM:=RECNUM-1;
      WHILE RECNUM'' THEN
      +FLAB.FULLNAMELOCK
    (* If lockword was specified, work it back in -- if the user
       doesn't have AM/SM capability, lockword was stripped from
       FLAB *)
    ELSE IF LDLOCKWORD(LD)<>'' THEN
      FLAB.FILE+'/'+LDLOCKWORD(LD)+'.'+FLAB.GROUP+'.'+FLAB.ACCOUNT
    ELSE
      VEFDOMAININFO (F,DOMAIN).FULLNAMELINK
    END
RECOVER
  F
END);

SUBROUTINE DOOPENINIT (ENDRECFIXED: INTEGER; ISWAIT: VALUE BOOLEAN);
SEG (BEGIN
CHECKINGCAFTER:=FALSE;
LASTNONPRINTEDRECNUM:=-1;
LASTPRINTEDRECNUM:=-1;
IF TRUEEOF=0 AND ENDREC=-1 THEN
  (* probably an empty message file, read until EOF *)
  ENDRECFIXED:=$7FFFFFFF
ELSE IF ENDREC<0 THEN
  ENDRECFIXED:=ENDREC+1+INITIALEOF
ELSE
  ENDRECFIXED:=ENDREC;
STARTRECFIXED:=IF STARTREC<0 THEN STARTREC+INITIALEOF+1 ELSE STARTREC;
(* exit silently if start>eof *)
IF NOT ISWAIT THEN
  STARTRECFIXED:=MIN(STARTRECFIXED, INITIALEOF+1);
IF STARTRECFIXED<>1 THEN
  MYTEXTPOINT (TADDR, MAX(0,STARTRECFIXED-1));
MATCHEDPREV:=FALSE;
IF NOT INTERACT THEN
  VEPAGESIZE:=MIN(PAGESIZE,32767);
PRINTDELIMFLAG:=0;
PRINTCASELESSFLAG:=FALSE;
END);

SUBROUTINE DOOPENFILE (F: VALUE STRING);
VAR ENDRECFIXED: INTEGER;
VAR I: INTEGER;
BEGIN
DOOPENINIT (ENDRECFIXED, FALSE);
FOR I IN RANGE(1,1)
  PAGEHEAD
    IF NOT INTERACT AND PPAGEHEAD THEN
      PRINTPAGEHEAD (F)
  DO
    WHILE PRINTREAD (T, REC, RECLEN) AND RECNUM<=ENDRECFIXED DO
      IF DOSELECT THEN
        DORECWITHCBEFORE;
END;

SUBROUTINE DOOPENFILEWAIT (F: VALUE STRING; FULLNAME: VALUE STRING);
VAR ENDRECFIXED: INTEGER;
VAR I: INTEGER;
VAR WRITEX: BOOLEAN;
VAR LOOP1: BOOLEAN;
VAR LASTRECNUM: INTEGER;
VAR ANYWRITER: BOOLEAN;
VAR DIRTY: BOOLEAN;
BEGIN
ANYWRITER:=FALSE;
DIRTY:=FALSE;
DOOPENINIT (ENDRECFIXED, TRUE);
TRY
(* wait, looping on eof of file while open for writing *)
LOOP1:=TRUE;           (* 1st time through loop *)
FOR I IN RANGE(1,1)
  PAGEHEAD
    IF NOT INTERACT AND PPAGEHEAD THEN
      PRINTPAGEHEAD (F)
  DO
    BEGIN
    WHILE (NOT VE_G_CONY_HIT) AND
          ( (WRITEX:=TRY VEFLDOMAININFO(FULLNAME,DOMAIN).WRITING
                     RECOVER FALSE) OR
            LONGWAIT OR LOOP1 OR
            ENDREC>(IF ISBYTE THEN BYTENUM ELSE RECNUM)) DO
      BEGIN
      ANYWRITER:=ANYWRITER OR WRITEX;
      LOOP1:=FALSE;
      IF (ENDREC:=TRUEEOF)>(IF ISBYTE THEN BYTENUM ELSE RECNUM) THEN
        SEG (BEGIN
        (* ensure TEXT routines access updated EOF *)
        TEXTEOF:=ENDREC;
        MYTEXTPOINT (TADDR, MAX(0,RECNUM));
        (* clear previous message, beep if wait +ve *)
        IF DIRTY THEN
          WRITEPROMPT ('':25, CHR(13),
                       IF WAIT>0 AND ANYWRITER THEN CHR(7) ELSE '');
        LASTRECNUM:=RECNUM;
        WHILE PRINTREAD (T,REC, RECLEN) AND RECNUM<=ENDREC DO
          IF DOSELECT THEN
            DORECWITHCBEFORE;
        (* Partially-flushed var files on MPE/V may prevent any data *)
        (* being displayed until a block is completely flushed.  In  *)
        (* this case, execution continues with LASTRECNUM=RECNUM.    *)
        IF (WRITEX:=TRY VEFLDOMAININFO(FULLNAME,DOMAIN).WRITING
                    RECOVER FALSE) THEN
          BEGIN
          WRITEPROMPT ( '(Pausing at EOF)':30,CHR(13) );
          DIRTY:=TRUE;
          END
        ELSE IF LONGWAIT THEN
          BEGIN
          WRITEPROMPT ( '(Pausing at EOF, no writers) '+CHR(13) );
          DIRTY:=TRUE;
          END;
        END);
      IF (LONGWAIT OR WRITEX) AND NOT VE_G_CONY_HIT THEN
        PAUSE (ABS(WAIT));
      ENDREC:=TRUEEOF;
      END;
    IF NOT VE_G_CONY_HIT AND ANYWRITER THEN
      WRITELN ('(Stopped at EOF)':30,IF WAIT>0 THEN CHR(7) ELSE '');
    END;
CLEANUP
  IF VE_G_CONY_HIT THEN
    SEG (BEGIN
    WRITELN ('':30,CHR(13));
    ABORTMPE (VE_E_CONTROL_Y);
    END);
END;

SUBROUTINE DOFILE (F: VALUE STRING);
VAR LEVEL: SHORTINT;
VAR DFNUM: INTEGER;
VAR FLAB: TFILE;
BEGIN
GETSTACKLEVEL (LEVEL);
SEG (
  BEGIN
  TRY
    (FLAB*^(2*VE_SIZE_FLAB)):=VEFINFO0(F,DOMAIN)
  RECOVER
    FILL (FLAB, VE_SIZE_FLAB, 0);
  NUMFOUND:=0;     (* searches NUMFOUND in current file *)
  SHOWN:=0;     (* lines shown from current file  *)
  DONE:=FALSE;  (* deferred exit *)
  TADDR:=0;
  (* use VEFLxxxINFO to recover info on Link target *)
  ISBYTE:=POSIX() AND (TRY FLAB.RECTYPE RECOVER -1)=9;
  IF INTERACT AND
     VE_CODE_ENCRYPT=(IF FILESETCMD THEN RF.INTCODE
                      ELSE FLAB.INTCODE) THEN
    SEG (BEGIN
    IF NOT ALLFILENAMES AND NOBANNERYET THEN
      PRINTBANNER (F);
    DFNUM:=CALL MPE'COPY
      (SPRINTF ('%s,$UNIQUED.PUB.$OWNACCT;MAKETEMP%q(;KEEPAMDATES)'+
                ';CODE=%d;KEEPOPEN;KEEPATTR;DECRYPT;CRYPTKEY=%s',
                F, KEEPAMDATES, VEFUNC CRYPTFCODE (F),
                VEFUNC CRYPTKEYREAD ('decryption key'))+CHR(13),
       @RF, IF FILESETCMD THEN 3 ELSE 2);
    TEXTOPENFNUM (TADDR, DFNUM, ';DEL');
    END)
  ELSE IF VE_CODE_STRMJOB=(IF FILESETCMD THEN RF.INTCODE
                           ELSE FLAB.INTCODE) AND
          CAPABILITY('SM') AND FORMATSTR="STRWRITE(SPRINTF('%Ls',R))" THEN
    SEG (BEGIN
    IF NOT ALLFILENAMES AND NOBANNERYET THEN
      PRINTBANNER (F);
    DFNUM:=CALL MPE'COPY
      (SPRINTF ('%s,$UNIQUED.PUB.$OWNACCT;MAKETEMP%q(;KEEPAMDATES)'+
                ';CODE=0;KEEPOPEN;KEEPATTR', F, KEEPAMDATES)+CHR(13),
      @RF, IF FILESETCMD THEN 3 ELSE 2);
    TEXTOPENFNUM (TADDR, DFNUM, ';DEL');
    END)
  ELSE IF FILESETCMD THEN
    SEG (TEXTOPEN (TADDR, F+','+DOMAINSTR+';SHR;NOFILEEQ;TEXT'+
                    (IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')+
                    (IF COPYACCESS THEN ';COPY' ELSE '')+
                    (IF BUF OR RF.BLOCKSIZE>4096 OR RF.ISXLSPOOLFILE
                        OR ((RF.ISMSG OR RF.ISRIO) AND NOT COPYACCESS)
                       THEN '' ELSE ';NOBUF')))
  ELSE IF LFT(F)='(' AND RHT(F)=')' THEN
    SEG (TEXTOPEN (TADDR, STRLDROP(STRRDROP(F))+
                     (IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')))
  ELSE IF LFT(F)='*' THEN
    SEG (TEXTOPEN (TADDR, MERGEFEQWITHDOMAIN(F,'OLDANY')+
                     (IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')))
  ELSE
    SEG (TEXTOPEN (TADDR, TRUEFILENAME(F,DOMAIN,FLAB)+','+DOMAINSTR+
                     ';SHR;NOFILEEQ;TEXT'+
                     (IF KEEPAMDATES THEN ';KEEPAMDATES' ELSE '')+
                     (IF COPYACCESS THEN ';COPY' ELSE '')+
                     (IF WAIT<>0 THEN ';GMULTI' ELSE '')+
                     (IF BUF OR
                         (FLAB.BLOCKSIZE>4096 OR
                          FLAB.ISXLSPOOLFILE AND
                            FLAB.OPENED OR
                          (FLAB.ISMSG OR
                             FLAB.ISRIO) AND
                             NOT COPYACCESS)
                         THEN '' ELSE ';NOBUF')));
  END);
SEG (
  BEGIN
  TRY
    BEGIN
    @@T:=DBUILD (TADDR, 128);
    IF (TRY VEFINFO(TEXTFNUM(TADDR)).INTCODE RECOVER 0)=111 AND
       QEDITRECLEN>0 THEN
      RECLEN:=QEDITRECLEN
    ELSE
      RECLEN:=512;
    IF NONUMRECOGNIZE THEN
      SETNONUMRECOGNIZE;
    ISDOUBLEPTR(T[*24]):=DBUILD(@VARNONDELIMS,LEN(VARNONDELIMS));
    CCTL:=IFNUMINFO(VEOUTFNUM,2)[7:1]=1 AND
            IFNUMINFO(TEXTFNUM(TADDR),2)[7:1]=1 AND NOT NUM;
    INITIALEOF:=IF ISBYTE AND (STARTREC<0 OR ENDREC<0) THEN SLOWTRUEEOF
                                                       ELSE TRUEEOF;
    IF WAIT=0 THEN
      DOOPENFILE (FNUMFNAME(TEXTFNUM(TADDR)))
    ELSE
      DOOPENFILEWAIT (FNUMFNAME(TEXTFNUM(TADDR)),F);
    END
  CLEANUP
    BEGIN
    IF TADDR<>0 THEN
      TEXTCLOSE (TADDR);
    TADDR:=0;
    GLOBNUMFOUND:=GLOBNUMFOUND+IF SEARCHC=0 THEN SHOWN ELSE NUMFOUND;
    END;
  END);
SETSTACKLEVEL (LEVEL);
END;

SUBROUTINE MERGEDOUTFILE (FILEEQ: VALUE STRING);
VAR LOCEQ: STRING[256];
VAR RECSPEC: STRING[80];
VAR PRECSIZE: SHORTINT;
VAR PBLKFACT: SHORTINT;
VAR PFORMAT: SHORTINT;
VAR PASCII: SHORTINT;
VAR PMASK: INTEGER;
SEG (BEGIN
(* extract and decompose REC= specification, merge with ASCII default *)
LOCEQ:=STRCHANGE(UPS(FILEEQ), ' ', '');
MUSTSAVE:=POS(';SAVE',LOCEQ)>0;
IF POS (';REC=',LOCEQ)=0 THEN
  LOCEQ:=';REC='
ELSE
  LOCEQ:=TOKEN(LOCEQ[POS(';REC=',LOCEQ):256],';');
KEYWORDPARSE (LOCEQ, ';REC=s80:def//', RECSPEC);
PMASK:=KEYWORDPARSE (RECSPEC,
                     'a=271i,b=272i,c=273aF|V|U|B,d=274aBINARY|ASCII',
                     PRECSIZE, PBLKFACT, PFORMAT, PASCII);
IF PMASK[-13:1]=0 THEN
  PASCII:=1;   (* defaults to ;REC=,,,ASCII *)
TOKEN(FILEEQ,';')+';NOFILEEQ;ACC=OUT'+
  (IF OUTFILE='$STDLIST' OR PAGESIZE<>-1 THEN ';CCTL' ELSE '')+
(FILEEQ-TOKEN(FILEEQ,';'))+
  SPRINTF (';REC=%q(%d),%q(%d),%q(%c),%q(BINARY)%q(ASCII)',
           PMASK[-16:1]=1, PRECSIZE, PMASK[-15:1]=1, PBLKFACT,
           PMASK[-14:1]=1, 'FVUB'[PFORMAT:1], PASCII=0, PASCII<>0)
END);

SUBROUTINE OPENOUT;
SEG (BEGIN
VEOUTFNUM:=0;
MUSTSAVE:=FALSE;
IF OUTFILE<>'$STDLIST' OR
   (* don't reopen output file if we already have a redirected stdlist *)
   NOT BVAR('HPINTERACTIVE') AND NOT ISREDIRECTED() THEN
  VEOUTFNUM:=FOPEN (IF LFT(OUTFILE)='(' AND RHT(OUTFILE)=')' THEN
                      MERGEDOUTFILE(STRLDROP(STRRDROP(OUTFILE)))
                    ELSE
                      OUTFILE+';REC=,,,ASCII;NOFILEEQ;ACC=OUT'+
                              (IF OUTFILE='$STDLIST' OR PAGESIZE<>-1
                               THEN ';CCTL' ELSE ''))
ELSE
  VEOUTFNUM:=SVEOUTFNUM;
OUTSIZE:=OUTRECSIZE();
IF OUTSIZE=0 (*$NULL*) THEN
  OUTSIZE:=32767;
END);

SUBROUTINE CLOSEOUT;
SEG (BEGIN
IF VEOUTFNUM<>0 AND VEOUTFNUM<>SVEOUTFNUM THEN
  FCLOSE (VEOUTFNUM, IF IFNUMINFO(VEOUTFNUM,2)[14:2]=1 THEN 0
                     ELSE IF MUSTSAVE THEN 1 ELSE 2, 0);
VEOUTFNUM:=SVEOUTFNUM;
END);

SUBROUTINE TRUEPAGESIZE (PAGESIZE: VALUE INTEGER;
                         INTERACT: VALUE BOOLEAN;
                         PPAGEHEAD: VALUE BOOLEAN);
BEGIN
IF PAGESIZE=-1 THEN
  IF INTERACT THEN 23
  ELSE IF PPAGEHEAD AND VESOFTPAGESIZE<>0 THEN VESOFTPAGESIZE
  ELSE 2000000000
ELSE IF PAGESIZE=0 THEN 2000000000
ELSE PAGESIZE
END;

SUBROUTINE DOPARSING;
VAR CONTEXT: STRING[256];
VAR KEYDESC: STRING[485];
VAR NOWAIT: BOOLEAN;
BEGIN
SEG (
  BEGIN
  KEYDESC:=
    "FILE=s:def/$STDINX/,OUT=s128:def/$STDLIST/,START=d:def/1/,"+
    "END=d:def/-1/,PAGE=d:def/-1/;UNN|NUM;NOPAGEHEAD|PAGEHEAD;BUF;"+
    "SEARCH=s:def/TRUE/:incquotes;CONTEXT=s:incquotes;"+
    "PREV=s:def/FALSE/:incquotes;FORMAT=s:def/R/:incquotes;"+
    "OLDMAX=d:def/$7FFFFFFF/;NOFILEPAGEBREAK;KEEPAMDATES;"+
    "COPY+ACCESS;NONUM+RECOGNIZE;ALLFILENAMES;NEW|OLD|OLDTEMP|OLDANY|TEMP;"+
    "NOIV|IV|HI+LIGHT|HILITE|HIGHLIGHT;LONGWAIT;DEBUG;SPF;"+
    "STARTPAGE=d:def/1/;ENDPAGE=d:def/-1/;"+
    "ALL|IFLO+WLIGHT|IFLOL+ITE;MAX=d:def/$7FFFFFFF/";    (* 475 *)
  WAIT:=0;
  TRY
    (* VECIERR:=0; *)
    (* first form: WAIT=delay *)
    KEYWORDPARSEDV (VEPARMS, "PRINT", KEYDESC+";WAIT=i;NOWAIT",
                    INFILE, OUTFILE, STARTREC, ENDREC, PAGESIZE, NUM,
                    PPAGEHEAD, BUF, SEARCHSTR, CONTEXT, PREVSTR, FORMATSTR,
                    MAXLINES, NOPAGE, KEEPAMDATES, COPYACCESS,
                    NONUMRECOGNIZE, ALLFILENAMES, DOMAIN, HILIGHT, LONGWAIT,
                    DEBUG, SPF, STARTPAGE, ENDPAGE, SKIP, MAXFOUND,
                    WAIT, NOWAIT);
    IF NOWAIT THEN                               (* override WAIT *)
      WAIT:=0;
  RECOVER
    IF VECIERR=612 THEN  (* did not find '=' *)
      BEGIN
      (* second form: WAIT is boolean *)
      KEYWORDPARSEDV (VEPARMS, "PRINT", KEYDESC+";NOWAIT|WAIT",
                      INFILE, OUTFILE, STARTREC, ENDREC, PAGESIZE, NUM,
                      PPAGEHEAD, BUF, SEARCHSTR, CONTEXT, PREVSTR,
                      FORMATSTR, MAXLINES, NOPAGE, KEEPAMDATES, COPYACCESS,
                      NONUMRECOGNIZE, ALLFILENAMES, DOMAIN, HILIGHT,
                      LONGWAIT, DEBUG, SPF, STARTPAGE, ENDPAGE,
                      SKIP, MAXFOUND, WAIT);
      IF WAIT=1 THEN
        WAIT:=-5;
      END
      ELSE
        ABORTMPE(VECIERR);
  IF DOMAIN=4 THEN                     (* TEMP same as OLDTEMP *)
    DOMAIN:=2;
  IF LONGWAIT AND WAIT=0 THEN
    WAIT:=-5;                          (* LONGWAIT implies WAIT *)
  IF INFILE="$STDINX" THEN             (* inhibit WAIT logic *)
    BEGIN
    WAIT:=0;
    LONGWAIT:=FALSE;
    END;
  IF WAIT<>0 AND PAGESIZE=-1 THEN
    PAGESIZE:=0;                       (* default is PAGE=0 when WAITing *)
  IF WAIT<>0 AND ENDREC<>-1 THEN
    ABORT ("Can't specify ;WAIT and ;END together");

  (* assume :SPOOL suffix if spoolfile selection criteria used *)

(*
  IF POS('SPOOL.',UPS(REMTOKEN(INFILE,'(')))>0 AND
     UPS(INFILE[LEN(INFILE)-6:6])<>":SPOOL" THEN
    INFILE:=INFILE+":SPOOL";
*)

  IF UPS(INFILE[LEN(INFILE)-6:6])=':SPOOL' AND ISPOSIXFILE(INFILE) THEN
    ABORT ("Can't use :SPOOL with POSIX-syntax filenames");
  IF LFT(OUTFILE)<>'(' AND LFT(OUTFILE)<>'*' AND ISFILESET(OUTFILE) THEN
    ABORTMPE (944);  (* Wildcards not allowed in file name *)
  IF MAXFOUND<>$7FFFFFFF AND CONTEXT='' THEN
    (* MAX without CONTEXT= instead means 'lines shown' *)
    MAXSHOWN:=MAXFOUND
  ELSE
    (* Impose no limit on lines displayed: limit search matches NUMFOUND *)
    MAXSHOWN:=$7FFFFFFF;
  END);
SEG (
  BEGIN
  KEYWORDPARSE (CONTEXT,
                "a=s:def/TRUE/:incquotes,b=s:def/TRUE/:incquotes",
                CBEFORESTR, CAFTERSTR);
  IF VALIDINTEGER(CBEFORESTR) THEN
    CBEFORESTR:="RECNUMSEARCH-RECNUM="+
                      STRWRITE(ABS(INTEGERPARSE(CBEFORESTR)));
  IF VALIDINTEGER(CAFTERSTR) THEN
    CAFTERSTR:="RECNUM-RECNUMSEARCH="+
                     STRWRITE(INTEGERPARSE(CAFTERSTR));
  IF IVAR("MPEXPRINTKEEPAMDATES",0)<>0 THEN
    KEEPAMDATES:=TRUE;
  IF SKIP>0 THEN
    IV:=%33C+"&d"+UPS(SVAR("VESOFTENHANCEFALSE","H")[0:1]);
  END);
END;

SEG (
  BEGIN
  ABORTOPERATION:=FALSE;
  DONTASK:=FALSE;
  LINESFOUND:=0;       (* obsolete *)
  GLOBNUMFOUND:=0;        (* global MAX tracking *)
  VE_G_LOGIC_STATE:=TRUE;      (* initial IFTRUE | IFFALSE state *)
  IV:="";
  SAVECONTROLY:=CONTROLYSET();
  VARNONDELIMS:=SVAR ("MPEXPRINTNONDELIMS", "");
  SVEOUTFNUM:=VEOUTFNUM;
  DOPARSING;
  FILESETCMD:=XEQCALL AND LFT(INFILE)<>'(' AND ISFILESET(INFILE);
  IF DOMAIN=0 THEN
    DOMAIN:=IF FILESETCMD THEN 1 ELSE 3;
  DOMAINSTR:=STRRTRIM('NEW     OLD     OLDTEMP OLDANY  '[8*DOMAIN:8]);
  (* ensure banner handled correctly when ;ALLFILENAMES specified *)
  FILESETCMD:=FILESETCMD OR ALLFILENAMES;
  IF FILESETCMD THEN
    MPEXINITJCWS ();
  IF NOT ISPOSIXFILE(OUTFILE) THEN
    OUTFILE:=UPS(OUTFILE);
  END);
IF SEARCHSTR='TRUE' THEN
  SEARCHC:=0
ELSE
  SEG (COMPILEBOOL (SEARCHC,
                    "[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
                     SEARCHSTR+")"+CHR(13)));
IF CAFTERSTR='TRUE' THEN
  CAFTERC:=0
ELSE
  SEG (COMPILEBOOL (CAFTERC,
                    "[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
                     CAFTERSTR+")"+CHR(13)));
IF CBEFORESTR='TRUE' THEN
  CBEFOREC:=0
ELSE
  SEG (COMPILEBOOL (CBEFOREC,
                    "[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
                     CBEFORESTR+")"+CHR(13)));
IF FORMATSTR='R' THEN
  FORMATCODE:=0
ELSE
  SEG (COMPILE (FORMATCODE, TYPE,
                "[[[VARPARM P:TPRINTINFO; WITH P DO SCOPY(FORMATS]]]("+
                 FORMATSTR+")[[[)]]]"+CHR(13)));
IF PREVSTR='FALSE' THEN
  PREVC:=0
ELSE
  SEG (COMPILEBOOL (PREVC,
                    "[[[VARPARM P:TPRINTINFO; WITH P DO BOOLIFY]]]("+
                     PREVSTR+")"+CHR(13)));
BIND (VE_G_FS_CIERR, 9080);
TRY
  BEGIN
  SEG (BEGIN
  OPENOUT;
  LINECOUNT:=0;
  NUMFILES:=0;
  INTERACT:=ISBOOLEAN (CALL IO'INTERACTIVE(VE_G_IN_FNUM,VEOUTFNUM))
              AND INFILE<>"$STDINX";
  PAGESIZE:=TRUEPAGESIZE (PAGESIZE, INTERACT, PPAGEHEAD);
  END);
  IF NOT FILESETCMD THEN
    SEG (
      BEGIN
      NOBANNERYET:=FALSE;  (* because none will be printed anyway *)
      NOEJECTYET:=FALSE;   (* ditto *)
      TRY
        DOFILE (INFILE)
      RECOVER
        IF VECIERR<>VE_E_FLUSHED THEN
          ABORTNOPARM();
      END)
  ELSE
    FOR RF IN DIRFILESMPEX (INFILE+IF DOMAIN=2 THEN ' :TEMP' ELSE '',
                            9080,52,9080,51,9080,50)
           (* Don't use TOTAL since it doesn't work from SEGs *)
           FIRST NUMFILES:=0
           DOBEFORE ++NUMFILES
           WHILE NOT ABORTOPERATION DO
      BEGIN
      SEG (
        BEGIN
        NOBANNERYET:=TRUE;
        NOEJECTYET:=TRUE;
        IF RF.SPOOL.SPOOLFILENUM<>0 THEN
          F:=RF.SPOOL.YESNOSPOOL
        ELSE
          F:=RF.FULLNAME;
        END);
      TRY
        SEG (
          BEGIN
          IF ALLFILENAMES THEN
            PRINTBANNER (F);
          DOFILE (IF RF.SPOOL.SPOOLFILENUM<>0 THEN
                    TOKEN(F-'#',' ')+
                      (IF F[1:1]='O' THEN '.OUT.HPSPOOL'
                                     ELSE '.IN.HPSPOOL')
                  ELSE
                    RF.FULLNAMELOCK);
          MPEXSUCCEEDED (MPCOMMON);
          END)
      RECOVER
        SEG (IF VECIERR<>VE_E_FLUSHED THEN
               MPEXFAILED (MPCOMMON, F) );
      END;
  END
CLEANUP
  SEG (
    TRY
      CLOSEOUT
    CLEANUP
      BEGIN
      IVARSET ("MPEXPRINTLINESFOUND",
                 IF MAXLINES=$7FFFFFFF THEN GLOBNUMFOUND ELSE LINESFOUND);
      CONTROLYRESET (SAVECONTROLY);
      END);
UNBIND (VE_G_FS_CIERR);

END;