COMMENT ⊗   VALID 00005 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	
 00007 00003	    EXTERNAL INTEGER RPGSW
 00010 00004	       LABEL NXTIME
 00013 00005	       ELSE IF CMDBRK =	"←" OR CMDBRK =	"," THEN
 00016 ENDMK
⊗;

REQUIRE "" DELIMITERS; COMMENT TEMPORARILY OVERRIDE ANY FANCIES;
    DEFINE DSCR="COMMENT ";
    DEFINE #=" "; #
DSCR SCNCMD.SAI -- a package for scanning CUSP-like commands.

DES This package provides a function COMMAND_SCAN, and a set
 of variables and defined values with the following proerties:
PAR The following values must be DEFINEd:
  SRCMODE, LSTMODE, RELMODE the data modes for the approp. files
   (define them all, even if you don't use them)
  SRCEXT, LSTEXT, RELEXT default extension names (they should
   expand to string constants) for the appropriate files.  Blank
   will also be checked as a possible extension for source files.
  PROCESSOR should expand to a string constant.  QQprocessor.RPG
   will be the RPG file looked up (at Stanford).
 The following variables must be set:
  ON_ETIME should be made 0 once only, to force opening of
   the command file.
  NX_TFIL should be made 0 to force COMMAND_SCAN to expect
   a new FILE←FILE command next, instead of more source files.
  WANTBIN should be made true if a `.REL' file is to be
   opened if a file is specified for it.
  WANTLST should be made true if a `.LST' file is to be
   opened if a file is specified for it.
  SOURCECOUNT, after the call on COMMAND_SCAN, may be changed,
   either permanently or temporarily, to control input.
RES on returning from COMMAND_SCAN, the following are available:
 WANTBIN, WANTLST -- true if a file was opened in the approp.
  position, false if false coming in, or no file specified.
 BINFIL, SRCFIL -- the file, extension, and PPN for the approp.
  files (strings).
 SRC, BIN, LST, CMD, DELCHNL (1-5) are channels reserved for
  the obvious functions.  You should use these names.
 CMDTBL, LINTBL, RBRK (15-17) are break tables used by
  COMMAND_SCAN.  Use them if you wish, but don't expect
  them to be there when you get back.
 CRLF,DSCR, and BLANKS are the obvious macros.  Redefine any but DSCR
  if you wish.
SID Channels 1-5, Break Tables 15-17 are reserved by
 COMMAND_SCAN.  Do GETCHANs to obtain channels, or
 be careful.
CAL call COMMAND_SCAN with no parameters.  The first time, and
 any time subsequently that it is called with NX_TFIL=0, it
 will expect optional LST and REL specs, separated by comma,
 followed by a left arrow in the command file, then one or
 more source file names separated by commas, terminated by
 a CRLF.  Only one source file is read the first time.  Subse-
 quent calls on COMMAND_SCAN (without touching NX_TFIL) will
 cause subsequent source files to be looked up--if no more exist
 an error message will be printed.  Set this to FALSE when you
 want a brand new command.  Set ON_ETIME once for every time
 the entire program is restarted.
;
    EXTERNAL INTEGER RPGSW;
    INTEGER WANTBIN,WANTLST,SRCBRK,SRCEOF,CMDBRK,ON_ETIME,NX_TFIL;
    INTEGER SOURCECOUNT,SWTP;
    STRING BINFIL,SRCFIL,SWTSTR;
    INTEGER ARRAY SWTVAL[1:SWTSIZ];
    DEFINE CRLF="('15&'12)", BLANKS="(""                       "")";
    DEFINE SRC="1",BIN="2",LST="3",CMND="4",DELCHNL="5";
    DEFINE LINTBL="17",	CMDTBL="16", RBRK="15";

    PROCEDURE COMMAND_SCAN;
    BEGIN "COMMAND SCAN"
       INTEGER EOF,FG,TIA,TIB,TIC,TID,SPCFIL,TIE,TIF;
       STRING CMNDFIL,LSTFIL,LINE,TSA,TSB,TSC,BKSTRNG,TSD;

       PROCEDURE FILENAME(REFERENCE STRING DEVICE,FILE);
       BEGIN "FILENAME"
	  PROCEDURE SWTGET;
	  BEGIN	"SWTGET"
	     SETBREAK(RBRK,"0123456789",NULL,"XA");
	     TSC←SCAN(LINE,RBRK,CMDBRK);
	     SWTVAL[SWTP←SWTP+1]←CVD(TSC[1 TO ∞-1]);
	     TID←TSC[∞ FOR 1];
	     TSD←GOODSWT;
	     FOR TIE←1 STEP 1 WHILE (TIF←LOP(TSD))∧TID≠TIF DO;
	     SWTSTR←SWTSTR&TIE;
	     IF	(CMDBRK←LINE)="/" ∨ CMDBRK=")" THEN CMDBRK←LOP(LINE)
	  END "SWTGET";
	  SPCFIL←FALSE;
	  FILE←SCAN(LINE,CMDTBL,CMDBRK)	;COMMENT GET A DEVICE OR FILENAME;
	  IF CMDBRK="["	THEN BEGIN
	     SETBREAK(RBRK,"]",NULL,"IA");
	     FILE←FILE&"["&SCAN(LINE,RBRK,CMDBRK);
	     FILE←FILE&SCAN(LINE,CMDTBL,CMDBRK)
	  END;
	  IF CMDBRK = ":" THEN BEGIN
	     DEVICE←FILE; SPCFIL←TRUE; COMMENT FILE SPECIFIED, NOT INVENTED;
	     FILE←SCAN(LINE,CMDTBL,CMDBRK)
	  END ELSE
	  IF EQU(FILE,"LPT") ∨ EQU(FILE,"LPT.")	THEN DEVICE←"LPT" ELSE
	   DEVICE←"DSK";
	  WHILE	CMDBRK="/" DO SWTGET;
	  IF CMDBRK="("	THEN BEGIN
	     DO	SWTGET UNTIL CMDBRK=")";
	     CMDBRK←LOP(LINE)
	  END;
       END "FILENAME";
       LABEL NXTIME;
       SWTP←0; SWTSTR←NULL;
       IF NX_TFIL THEN GO TO NXTIME;
       SETBREAK(CMDTBL,"←:,(!/["&'12,'15&" "&'11,"I");
       SETBREAK(LINTBL,'12,'15,"INA"); SETBREAK(RBRK,"]",NULL,"IA");
       RELEASE(BIN); RELEASE(LST);

    COMMENT FIRST GET COMMAND DEVICE;

       IF ¬RPGSW THEN OUTSTR(CRLF&"*");
       TSA← IF RPGSW THEN "DSK"	ELSE "TTY";

       IF ¬ON_ETIME THEN BEGIN
	  EOF←-1;
	  OPEN(CMND,TSA,0,1,1,100,CMDBRK,EOF);
	  IF EOF THEN USERERR(0,0,"COMMAND DEVICE NOT AVAILABLE");
	  LOOKUP(CMND,TSB←"QQ"&PROCESSOR&".RPG",FG);
	  IF FG	THEN USERERR(0,0,"COMMAND FILE NOT FOUND");

	  IF RPGSW THEN	BEGIN "DELETE COMMAND FILE"
	     OPEN(DELCHNL,"DSK",0,2,0,100,TIA,TIA);
	     LOOKUP(DELCHNL,TSB,FG);
	     RENAME(DELCHNL,NULL,0,FG);
	     RELEASE(DELCHNL)
	  END "DELETE COMMAND FILE";

	  CMNDFIL←TSA&":"&(IF RPGSW THEN TSB ELSE NULL);
	  ON_ETIME←TRUE;
       END;
       LINE←NULL;
       WHILE ¬EOF∧(LENGTH(LINE)≤1 ∨ LENGTH(LINE)<5∧
	EQU (LINE,BLANKS[1 FOR LENGTH(LINE)-1]&'12)) DO
	 LINE←INPUT(CMND,LINTBL); COMMENT GET RID OF BLANK LINES;
       IF EOF THEN TIA←CALL(0,"EXIT");

       FILENAME(TSA,TSB);

       IF CMDBRK = "!" THEN BEGIN "NEW_PROGRAM"
	  INTEGER ARRAY	SWPTBL[1:5];
	  SWPTBL[1]←CVSIX(TSA);
	  SWPTBL[2]←CVFIL(TSB,SWPTBL[3],SWPTBL[5]);
	  IF ¬SPCFIL THEN SWPTBL[5]←CVSIX("  1  3");
	  IF RPGSW THEN	SWPTBL[4]←1;
	  START_CODE
	     MOVE '14,SWPTBL; MOVEM '14,TIA;
	  END;
	  CALL(TIA,"SWAP");
       END "NEW_PROGRAM"
       ELSE IF CMDBRK =	"←" OR CMDBRK =	"," THEN
	IF SPCFIL ∨ LENGTH(TSB)	THEN BEGIN "BINARY"
	   TIA←CVFIL(TSB,TIB,TIC);
	   IF TIB=0 THEN TSB←TSB&"."&RELEXT;
	   TID←-1;
	   IF WANTBIN THEN BEGIN "OPNBIN"
	      OPEN(BIN,TSA,RELMODE,0,2,0,TIC,TID);
	      IF TID THEN USERERR(0,0,RELEXT&" DEVICE NOT AVAILABLE");
	      ENTER(BIN,TSB,FG);
	      IF FG THEN USERERR(0,0,"CANT ENTER "&RELEXT&" FILE");
	   END "OPNBIN";
	   BINFIL←TSA&":"&TSB;
	END "BINARY" ELSE WANTBIN←0  ELSE USERERR(0,0,PROCESSOR&
	 " COMMAND ERROR");

       IF CMDBRK = "," THEN BEGIN "LISTING"
	  FILENAME(TSA,TSB);
	  TIA←CVFIL(TSB,TIB,TIC);
	  IF TIB = 0 THEN TSB←TSB&"."&LSTEXT;

	  IF WANTLST THEN BEGIN
	     OPEN(LST,TSA,LSTMODE,0,2,0,TIC,TIC);
	     ENTER(LST,TSB,FG);
	     IF	FG THEN	USERERR(0,0,"CAN'T ENTER "&LSTEXT&" FILE");
	  END;
	  LSTFIL←TSA&":"&TSB;
	  IF CMDBRK ≠ "←" THEN USERERR(0,0,PROCESSOR & " COMMAND ERROR");
       END "LISTING" ELSE WANTLST←0;
       FILENAME(TSA,TSB);
       OPEN(SRC,TSA,SRCMODE,2,0,SOURCECOUNT←200,SRCBRK,SRCEOF);

       WHILE TRUE DO BEGIN "SOURCE FILE LOOP"
	  IF CMDBRK≠'12	AND CMDBRK≠"," THEN USERERR(0,0,PROCESSOR&
	   " COMMAND ERROR");
	  CLOSE(SRC);
	  TID←CVFIL(TSB,TIC,TIE);
	  TSC←CVXSTR(TID)&"."&SRCEXT&
	   (IF TIE THEN "["&(TSC←CVXSTR(TIE))[1 FOR 3]&","&TSC[4 FOR 3]&"]"
	    ELSE NULL);
	  FG←-1;
	  IF TIC=0 THEN	LOOKUP(SRC,TSC,FG);
	  IF FG	THEN LOOKUP(SRC,TSB,FG);
	  IF FG	THEN USERERR(0,0,TSB &" FILE NOT FOUND");
	  SRCFIL←TSA&":"&TSB;
	  IF RPGSW THEN
	   OUTSTR(PROCESSOR&":	"&(IF EQU(TSA,"DSK") THEN NULL ELSE TSA)&TSB&
	    '15&'12);
	  NX_TFIL←TRUE;	  RETURN;

	  NXTIME:

	   IF CMDBRK='12  THEN USERERR(0,0,"END OF FILE ON SOURCE FILE");
	  FILENAME(TSA,TSB);
       END "SOURCE FILE LOOP";
    END	"COMMAND SCAN";

REQUIRE UNSTACK_DELIMITERS; COMMENT REVERT;