perm filename SCNCMD.SAI[X,AIL]1 blob
sn#000885 filedate 1972-10-15 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00005 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00002 00002
00500 00007 00003 EXTERNAL INTEGER RPGSW
00600 00010 00004 LABEL NXTIME
00700 00013 00005 ELSE IF CMDBRK = "←" OR CMDBRK = "," THEN
00800 00016 ENDMK
00900 ⊗;
00100
00200 REQUIRE "" DELIMITERS; COMMENT TEMPORARILY OVERRIDE ANY FANCIES;
00300 DEFINE DSCR="COMMENT ";
00400 DEFINE #=" "; #
00500 DSCR SCNCMD.SAI -- a package for scanning CUSP-like commands.
00600
00700 DES This package provides a function COMMAND_SCAN, and a set
00800 of variables and defined values with the following proerties:
00900 PAR The following values must be DEFINEd:
01000 SRCMODE, LSTMODE, RELMODE the data modes for the approp. files
01100 (define them all, even if you don't use them)
01200 SRCEXT, LSTEXT, RELEXT default extension names (they should
01300 expand to string constants) for the appropriate files. Blank
01400 will also be checked as a possible extension for source files.
01500 PROCESSOR should expand to a string constant. QQprocessor.RPG
01600 will be the RPG file looked up (at Stanford).
01700 The following variables must be set:
01800 ON_ETIME should be made 0 once only, to force opening of
01900 the command file.
02000 NX_TFIL should be made 0 to force COMMAND_SCAN to expect
02100 a new FILE←FILE command next, instead of more source files.
02200 WANTBIN should be made true if a `.REL' file is to be
02300 opened if a file is specified for it.
02400 WANTLST should be made true if a `.LST' file is to be
02500 opened if a file is specified for it.
02600 SOURCECOUNT, after the call on COMMAND_SCAN, may be changed,
02700 either permanently or temporarily, to control input.
02800 RES on returning from COMMAND_SCAN, the following are available:
02900 WANTBIN, WANTLST -- true if a file was opened in the approp.
03000 position, false if false coming in, or no file specified.
03100 BINFIL, SRCFIL -- the file, extension, and PPN for the approp.
03200 files (strings).
03300 SRC, BIN, LST, CMD, DELCHNL (1-5) are channels reserved for
03400 the obvious functions. You should use these names.
03500 CMDTBL, LINTBL, RBRK (15-17) are break tables used by
03600 COMMAND_SCAN. Use them if you wish, but don't expect
03700 them to be there when you get back.
03800 CRLF,DSCR, and BLANKS are the obvious macros. Redefine any but DSCR
03900 if you wish.
04000 SID Channels 1-5, Break Tables 15-17 are reserved by
04100 COMMAND_SCAN. Do GETCHANs to obtain channels, or
04200 be careful.
04300 CAL call COMMAND_SCAN with no parameters. The first time, and
04400 any time subsequently that it is called with NX_TFIL=0, it
04500 will expect optional LST and REL specs, separated by comma,
04600 followed by a left arrow in the command file, then one or
04700 more source file names separated by commas, terminated by
04800 a CRLF. Only one source file is read the first time. Subse-
04900 quent calls on COMMAND_SCAN (without touching NX_TFIL) will
05000 cause subsequent source files to be looked up--if no more exist
05100 an error message will be printed. Set this to FALSE when you
05200 want a brand new command. Set ON_ETIME once for every time
05300 the entire program is restarted.
05400 ;
00100 EXTERNAL INTEGER RPGSW;
00200 INTEGER WANTBIN,WANTLST,SRCBRK,SRCEOF,CMDBRK,ON_ETIME,NX_TFIL;
00300 INTEGER SOURCECOUNT,SWTP;
00400 STRING BINFIL,SRCFIL,SWTSTR;
00500 INTEGER ARRAY SWTVAL[1:SWTSIZ];
00600 DEFINE CRLF="('15&'12)", BLANKS="("" "")";
00700 DEFINE SRC="1",BIN="2",LST="3",CMND="4",DELCHNL="5";
00800 DEFINE LINTBL="17", CMDTBL="16", RBRK="15";
00900
01000 PROCEDURE COMMAND_SCAN;
01100 BEGIN "COMMAND SCAN"
01200 INTEGER EOF,FG,TIA,TIB,TIC,TID,SPCFIL,TIE,TIF;
01300 STRING CMNDFIL,LSTFIL,LINE,TSA,TSB,TSC,BKSTRNG,TSD;
01400
01500 PROCEDURE FILENAME(REFERENCE STRING DEVICE,FILE);
01600 BEGIN "FILENAME"
01700 PROCEDURE SWTGET;
01800 BEGIN "SWTGET"
01900 SETBREAK(RBRK,"0123456789",NULL,"XA");
02000 TSC←SCAN(LINE,RBRK,CMDBRK);
02100 SWTVAL[SWTP←SWTP+1]←CVD(TSC[1 TO ∞-1]);
02200 TID←TSC[∞ FOR 1];
02300 TSD←GOODSWT;
02400 FOR TIE←1 STEP 1 WHILE (TIF←LOP(TSD))∧TID≠TIF DO;
02500 SWTSTR←SWTSTR&TIE;
02600 IF (CMDBRK←LINE)="/" ∨ CMDBRK=")" THEN CMDBRK←LOP(LINE)
02700 END "SWTGET";
02800 SPCFIL←FALSE;
02900 FILE←SCAN(LINE,CMDTBL,CMDBRK) ;COMMENT GET A DEVICE OR FILENAME;
03000 IF CMDBRK="[" THEN BEGIN
03100 SETBREAK(RBRK,"]",NULL,"IA");
03200 FILE←FILE&"["&SCAN(LINE,RBRK,CMDBRK);
03300 FILE←FILE&SCAN(LINE,CMDTBL,CMDBRK)
03400 END;
03500 IF CMDBRK = ":" THEN BEGIN
03600 DEVICE←FILE; SPCFIL←TRUE; COMMENT FILE SPECIFIED, NOT INVENTED;
03700 FILE←SCAN(LINE,CMDTBL,CMDBRK)
03800 END ELSE
03900 IF EQU(FILE,"LPT") ∨ EQU(FILE,"LPT.") THEN DEVICE←"LPT" ELSE
04000 DEVICE←"DSKC";
04100 WHILE CMDBRK="/" DO SWTGET;
04200 IF CMDBRK="(" THEN BEGIN
04300 DO SWTGET UNTIL CMDBRK=")";
04400 CMDBRK←LOP(LINE)
04500 END;
04600 END "FILENAME";
00100 LABEL NXTIME;
00200 SWTP←0; SWTSTR←NULL;
00300 IF NX_TFIL THEN GO TO NXTIME;
00400 SETBREAK(CMDTBL,"←:,(!/["&'12,'15&" "&'11,"I");
00500 SETBREAK(LINTBL,'12,'15,"INA"); SETBREAK(RBRK,"]",NULL,"IA");
00600 RELEASE(BIN); RELEASE(LST);
00700
00800 COMMENT FIRST GET COMMAND DEVICE;
00900
01000 IF ¬RPGSW THEN OUTSTR(CRLF&"*");
01100 TSA← IF RPGSW THEN "DSKC" ELSE "TTY";
01200
01300 IF ¬ON_ETIME THEN BEGIN
01400 EOF←-1;
01500 OPEN(CMND,TSA,0,1,1,100,CMDBRK,EOF);
01600 IF EOF THEN USERERR(0,0,"COMMAND DEVICE NOT AVAILABLE");
01700 LOOKUP(CMND,TSB←"QQ"&PROCESSOR&".RPG",FG);
01800 IF FG THEN USERERR(0,0,"COMMAND FILE NOT FOUND");
01900
02000 IF RPGSW THEN BEGIN "DELETE COMMAND FILE"
02100 OPEN(DELCHNL,"DSKC",0,2,0,100,TIA,TIA);
02200 LOOKUP(DELCHNL,TSB,FG);
02300 RENAME(DELCHNL,NULL,0,FG);
02400 RELEASE(DELCHNL)
02500 END "DELETE COMMAND FILE";
02600
02700 CMNDFIL←TSA&":"&(IF RPGSW THEN TSB ELSE NULL);
02800 ON_ETIME←TRUE;
02900 END;
03000 LINE←NULL;
03100 WHILE ¬EOF∧(LENGTH(LINE)≤1 ∨ LENGTH(LINE)<5∧
03200 EQU (LINE,BLANKS[1 FOR LENGTH(LINE)-1]&'12)) DO
03300 LINE←INPUT(CMND,LINTBL); COMMENT GET RID OF BLANK LINES;
03400 IF EOF THEN TIA←CALL(0,"EXIT");
03500
03600 FILENAME(TSA,TSB);
03700
03800 IF CMDBRK = "!" THEN BEGIN "NEW_PROGRAM"
03900 INTEGER ARRAY SWPTBL[1:5];
04000 SWPTBL[1]←CVSIX(TSA);
04100 SWPTBL[2]←CVFIL(TSB,SWPTBL[3],SWPTBL[5]);
04200 IF ¬SPCFIL THEN SWPTBL[5]←CVSIX(" 1 3");
04300 IF RPGSW THEN SWPTBL[4]←1;
04400 START_CODE
04500 MOVE '14,SWPTBL; MOVEM '14,TIA;
04600 END;
04700 CALL(TIA,"SWAP");
04800 END "NEW_PROGRAM"
00100 ELSE IF CMDBRK = "←" OR CMDBRK = "," THEN
00200 IF SPCFIL ∨ LENGTH(TSB) THEN BEGIN "BINARY"
00300 TIA←CVFIL(TSB,TIB,TIC);
00400 IF TIB=0 THEN TSB←TSB&"."&RELEXT;
00500 TID←-1;
00600 IF WANTBIN THEN BEGIN "OPNBIN"
00700 OPEN(BIN,TSA,RELMODE,0,2,0,TIC,TID);
00800 IF TID THEN USERERR(0,0,RELEXT&" DEVICE NOT AVAILABLE");
00900 ENTER(BIN,TSB,FG);
01000 IF FG THEN USERERR(0,0,"CANT ENTER "&RELEXT&" FILE");
01100 END "OPNBIN";
01200 BINFIL←TSA&":"&TSB;
01300 END "BINARY" ELSE WANTBIN←0 ELSE USERERR(0,0,PROCESSOR&
01400 " COMMAND ERROR");
01500
01600 IF CMDBRK = "," THEN BEGIN "LISTING"
01700 FILENAME(TSA,TSB);
01800 TIA←CVFIL(TSB,TIB,TIC);
01900 IF TIB = 0 THEN TSB←TSB&"."&LSTEXT;
02000
02100 IF WANTLST THEN BEGIN
02200 OPEN(LST,TSA,LSTMODE,0,2,0,TIC,TIC);
02300 ENTER(LST,TSB,FG);
02400 IF FG THEN USERERR(0,0,"CAN'T ENTER "&LSTEXT&" FILE");
02500 END;
02600 LSTFIL←TSA&":"&TSB;
02700 IF CMDBRK ≠ "←" THEN USERERR(0,0,PROCESSOR & " COMMAND ERROR");
02800 END "LISTING" ELSE WANTLST←0;
02900 FILENAME(TSA,TSB);
03000 OPEN(SRC,TSA,SRCMODE,2,0,SOURCECOUNT←200,SRCBRK,SRCEOF);
03100
03200 WHILE TRUE DO BEGIN "SOURCE FILE LOOP"
03300 IF CMDBRK≠'12 AND CMDBRK≠"," THEN USERERR(0,0,PROCESSOR&
03400 " COMMAND ERROR");
03500 CLOSE(SRC);
03600 TID←CVFIL(TSB,TIC,TIE);
03700 TSC←CVXSTR(TID)&"."&SRCEXT&
03800 (IF TIE THEN "["&(TSC←CVXSTR(TIE))[1 FOR 3]&","&TSC[4 FOR 3]&"]"
03900 ELSE NULL);
04000 FG←-1;
04100 IF TIC=0 THEN LOOKUP(SRC,TSC,FG);
04200 IF FG THEN LOOKUP(SRC,TSB,FG);
04300 IF FG THEN USERERR(0,0,TSB &" FILE NOT FOUND");
04400 SRCFIL←TSA&":"&TSB;
04500 IF RPGSW THEN
04600 OUTSTR(PROCESSOR&": "&(IF EQU(TSA,"DSKC")THEN NULL ELSE TSA)&TSB&
04700 '15&'12);
04800 NX_TFIL←TRUE; RETURN;
04900
05000 NXTIME:
05100
05200 IF CMDBRK='12 THEN USERERR(0,0,"END OF FILE ON SOURCE FILE");
05300 FILENAME(TSA,TSB);
05400 END "SOURCE FILE LOOP";
05500 END "COMMAND SCAN";
05600
05700 REQUIRE UNSTACK_DELIMITERS; COMMENT REVERT;