perm filename SCNCMD.SAI[X,AIL] blob
sn#002440 filedate 1973-08-19 generic text, type T, neo UTF8
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;