Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0002/scncmd.sai
There is 1 other file named scncmd.sai in the archive. Click here to see a list.
00100	COMMENT    VALID 00005 PAGES
00200	C REC  PAGE   DESCRIPTION
00300	C00001 00001
00400	C00002 00002
00500	C00008 00003	    EXTERNAL INTEGER RPGSW
00600	C00014 00004	       LABEL NXTIME
00700	C00018 00005	       ELSE IF CMDBRK =	"_" OR CMDBRK =	"," THEN
00800	C00021 ENDMK
00900	C;
     
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 COMMANDSCAN, 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.  The first three
01600	   characters will be the name of the TMPCOR command file if started
01700	   in RPG mode.  nnnprocessor.TMP is the alternate if TMPCOR fails.
01800	  SWTSIZ is the maximum number of switches recognized by the PROCESSOR.
01900	  GOODSWT is a string which contains the characters which are valid
02000	   switches.
02100	
02200	 The following variables must be set:
02300	  ONETIME should be made 0 once only, to force opening of
02400	   the command file.
02500	  NXTFIL should be made 0 to force COMMANDSCAN to expect
02600	   a new FILE_FILE command next, instead of more source files.
02700	  WANTBIN should be made true if a `.REL' file is to be
02800	   opened if a file is specified for it.
02900	  WANTLST should be made true if a `.LST' file is to be
03000	   opened if a file is specified for it.
03100	  SOURCECOUNT, after the call on COMMANDSCAN, may be changed,
03200	   either permanently or temporarily, to control input.
03300	RES on returning from COMMANDSCAN, the following are available:
03400	 WANTBIN, WANTLST -- true if a file was opened in the approp.
03500	  position, false if false coming in, or no file specified.
03600	 BINFIL, SRCFIL -- the file, extension, and PPN for the approp.
03700	  files (strings).
03800	 SRC, BIN, LST, CMND, DELCHNL (1-5) are channels reserved for
03900	  the obvious functions.  You should use these names.
04000	 CMDTBL, LINTBL, RBRK (15-17) are break tables used by
04100	  COMMANDSCAN.  Use them if you wish, but don't expect
04200	  them to be there when you get back.
04300	 CRLF,DSCR, and BLANKS are the obvious macros.  Redefine any but DSCR
04400	  if you wish.
04500	SID Channels 1-5, Break Tables 15-17 are reserved by
04600	 COMMANDSCAN.  Do GETCHANs to obtain channels, or
04700	 be careful.
04800	CAL call COMMANDSCAN with no parameters.  The first time, and
04900	 any time subsequently that it is called with NXTFIL=0, it
05000	 will expect optional LST and REL specs, separated by comma,
05100	 followed by a left arrow in the command file, then one or
05200	 more source file names separated by commas, terminated by
05300	 a CRLF.  Only one source file is read the first time.  Subse-
05400	 quent calls on COMMANDSCAN (without touching NXTFIL) will
05500	 cause subsequent source files to be looked up--if no more exist
05600	 an error message will be printed.  Set this to FALSE when you
05700	 want a brand new command.  Set ONETIME once for every time
05800	 the entire program is restarted.
05900	;
06000	REQUIRE "<><>" DELIMITERS;
06100	IFC EQU(COMPILER!BANNER[LENGTH(SCANC(COMPILER!BANNER,"-",NULL,
06200		"IA"))+1 FOR 8],"TYMSHARE") THENC
06300	   DEFINE TYMSWSC=<TRUE>; ELSEC DEFINE TYMSWSC=<FALSE>; ENDC;
06400	REQUIRE UNSTACK!DELIMITERS;
06500	
     
00100	    EXTERNAL INTEGER RPGSW;
00200	    INTEGER WANTBIN,WANTLST,SRCBRK,SRCEOF,CMDBRK,ONETIME,NXTFIL;
00300	    INTEGER SOURCECOUNT,SWTP;
00400	    STRING BINFIL,SRCFIL,SWTSTR;
00500	    INTEGER ARRAY SWTVAL[1:SWTSIZ];
00600		INTEGER ARRAY BUF[0:'377];
00700	    DEFINE CRLF="('15&'12)", BLANKS="(""                       "")";
00800	    DEFINE SRC="1",BIN="2",LST="3",CMND="4",DELCHNL="5";
00900	    DEFINE LINTBL="17",	CMDTBL="16", RBRK="15";
01000	
01100	    PROCEDURE COMMANDSCAN;
01200	    BEGIN "COMMAND SCAN"
01300	       INTEGER EOF,FG,TIA,TIB,TIC,TID,SPCFIL,TIE,TIF;
01400	       STRING CMNDFIL,LSTFIL,LINE,TSA,TSB,TSC,BKSTRNG,TSD,CMNDSTR;
01500	
01600		SIMPLE INTEGER PROCEDURE TMPCORSTR
01700		    (INTEGER CODE; STRING FIL; REFERENCE STRING TEXT);
01800		BEGIN COMMENT Performs TMPCOR function CODE on FIL, transfering TEXT.
01900			Only functions 1 (read), 2 (read and delete), 3 (write) are legal.
02000			Value returned is that returned in AC by the UUO, !SKIP! is
02100			zero if no error, else !SKIP! is -1;
02200		EXTERNAL INTEGER !SKIP!;
02300		START!CODE LABEL FOOEY,WRLUP,WRBOT,WRCLR,NOTWRITE;
02400		DEFINE P="'17",SP="'16",!="COMMENT";
02500			MOVE	1,CODE;		! CHECK VALID CODES;
02600			CAIL	1,1;
02700			CAILE	1,3;
02800			 JRST	FOOEY;		! YOU LOSE;
02900			MOVE	2,BUF;		! FWA;
03000			MOVEI	2,-1(2);	! FWA-1 FOR IOWD;
03100			HRLI	2,-'400;	! COMPLETE THE IOWD;
03200			PUSHJ	P,CVSIX;	! CONVERT FIL TO SIXBIT IN AC1;
03300			TRZ	1,-1;		! PUT ZEROES IN RIGHT HALF;
03400					! FILE NAME AND IOWD NOW IN 1 AND 2;
03500			MOVSI	5,'440700;
03600			HRRI	5,1(2);		! BP TO BUF;
03700			MOVE	3,CODE;
03800			MOVE	4,-1(P);! PTR TO WD2;
03900			CAIE	3,3;
04000			 MOVEM	5,(4);		! SET RESULT BP IF SOME SORT OF READ;
04100			CAIE	3,3;
04200			 JRST	NOTWRITE;
04300			HRRZ	3,-1(4);	! LENGTH(TEXT);
04400			CAILE	3,'400*5;	! CHECK MAX LENGTH;
04500			 JRST	FOOEY;
04600			MOVE	4,(4);		! COUNT IN 3, BP IN 4;
04700			JRST	WRBOT;
04800		WRLUP:	ILDB	6,4;
04900			IDPB	6,5;
05000		WRBOT:	SOJGE	3,WRLUP;
05100			TDZA	6,6;	! CLEAR REMAINDER OF LAST WORD;
05200		WRCLR:	IDPB	6,5;
05300			TLNE	5,'760000;
05400			 JRST	WRCLR;
05500		NOTWRITE:MOVS	3,CODE;
05600			HRRI	3,1;	! PARAM AC FOR TMPCOR;
05700			SETZM	!SKIP!;
05800	JFCL;  COMMENT really CALLI 3, '44 on TOPS10;
05900		FOOEY:	 SETOB	3,!SKIP!;
06000			SKIPGE 1,3;
06100			MOVEI 3,0;!	SET TO 0 IF NEGATIVE;
06200			IMULI	3,5;	! CONVERT TO CHAR COUNT;
06300			MOVE	2,CODE;
06400			MOVE	4,-1(P);! PTR TO WD 2;
06500			CAIE	2,3;
06600			 MOVEM	3,-1(4);! STORE CHAR COUNT IF SOME SORT OF READ;
06700			SUB	P,['3000003];
06800			JRST	@3(P);
06900		END; END;
07000	
07100	       PROCEDURE FILENAME(REFERENCE STRING DEVICE,FILE);
07200	       BEGIN "FILENAME"
07300		  PROCEDURE SWTGET;
07400		  BEGIN	"SWTGET"
07500		     SETBREAK(RBRK,"0123456789",NULL,"XAK");
07600		     TSC_SCAN(LINE,RBRK,CMDBRK);
07700		     SWTVAL[SWTP_SWTP+1]_CVD(TSC[1 TO -1]);
07800		     TID_TSC[ FOR 1];
07900		     TSD_GOODSWT;
08000		     FOR TIE_1 STEP 1 WHILE (TIF_LOP(TSD))TIDTIF DO;
08100		     SWTSTR_SWTSTR&TIE;
08200		     IF	(CMDBRK_LINE)="/"  CMDBRK=")" THEN CMDBRK_LOP(LINE)
08300		  END "SWTGET";
08400		  SPCFIL_FALSE;
08500		  FILE_SCAN(LINE,CMDTBL,CMDBRK)	;COMMENT GET A DEVICE OR FILENAME;
08600		  IF CMDBRK = ":" THEN BEGIN
08700		     DEVICE_FILE; SPCFIL_TRUE; COMMENT FILE SPECIFIED, NOT INVENTED;
08800		     FILE_SCAN(LINE,CMDTBL,CMDBRK)
08900		  END ELSE
09000		  IF EQU(FILE,"LPT")  EQU(FILE,"LPT.")	THEN DEVICE_"LPT" ELSE
09100		   DEVICE_"DSK";
09200		  IF CMDBRK="["	THEN BEGIN
09300		     SETBREAK(RBRK,"]",NULL,"IA");
09400		     FILE_FILE&"["&SCAN(LINE,RBRK,CMDBRK);
09500		     FILE_FILE&SCAN(LINE,CMDTBL,CMDBRK)
09600		  END;
09700		  WHILE	CMDBRK="/" DO SWTGET;
09800		  IF CMDBRK="("	THEN BEGIN
09900		     DO	SWTGET UNTIL CMDBRK=")";
10000		     CMDBRK_LOP(LINE)
10100		  END;
10200	END "FILENAME";
10300	
     
00100	       LABEL NXTIME;
00200	       SWTP_0; SWTSTR_NULL;
00300	       IF NXTFIL 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 "DSK"	ELSE "TTY";
01200	
01300	       IF ONETIME THEN BEGIN
01400		  EOF_0;
01500		  COMMENT TRY TMPCOR FIRST BEFORE FILE, USE LENGTH OF CMNDSTR
01600			AS FLAG THAT COMMAND IS IN CMNDSTR RATHER THAN FILE;
01700		  CMNDSTR_NULL;
01800		  IF RPGSW THEN TMPCORSTR(2,PROCESSOR,CMNDSTR);
01900		  IF NOT(LENGTH(CMNDSTR)) THEN BEGIN
02000		    OPEN(CMND,TSA,0,1,1,100,CMDBRK,EOF_-1);
02100		    IF EOF THEN USERERR(0,0,"COMMAND DEVICE NOT AVAILABLE");
02200		    TSB_("000"&CVS(CALL(0,"PJOB")))[INF-2 FOR 3]&PROCESSOR&".TMP";
02300		    LOOKUP(CMND,TSB,FG);
02400		    IF FG	THEN USERERR(0,0,"COMMAND FILE NOT FOUND");
02500		  END;
02600	
02700		  IF RPGSW AND NOT LENGTH(CMNDSTR) THEN	BEGIN "DELETE COMMAND FILE"
02800		     OPEN(DELCHNL,"DSK",0,2,0,100,TIA,TIA);
02900		     LOOKUP(DELCHNL,TSB,FG);
03000		     RENAME(DELCHNL,NULL,0,FG);
03100		     RELEASE(DELCHNL)
03200		  END "DELETE COMMAND FILE";
03300	
03400		  CMNDFIL_TSA&":"&(IF RPGSW THEN TSB ELSE NULL);
03500		  ONETIME_TRUE;
03600	       END;
03700	       LINE_NULL;
03800	       WHILE EOF(LENGTH(LINE)1  LENGTH(LINE)<5
03900		EQU (LINE,BLANKS[1 FOR LENGTH(LINE)-1]&'12)) DO
04000		 BEGIN COMMENT HANDLE TMPCOR VS. FILE;
04100		  IF LENGTH(CMNDSTR) THEN BEGIN
04200		    LINE_SCAN(CMNDSTR,LINTBL,CMDBRK);
04300		    EOF_NOT(LENGTH(CMNDSTR)) END
04400		  ELSE
04500		  LINE_INPUT(CMND,LINTBL); COMMENT GET RID OF BLANK LINES;
04600		 END;
04700	       IF EOF THEN TIA_CALL(0,"EXIT");
04800	
04900	       FILENAME(TSA,TSB);
05000	
05100	       IF CMDBRK = "!" THEN BEGIN "NEWPROGRAM"
05200	IFCR TYMSWSC THENC  INTEGER ARRAY	SWPTBL[1:6];
05300		  SWPTBL[1]_CVSIX(TSA);
05400		  SWPTBL[2]_CVFIL(TSB,SWPTBL[3],SWPTBL[5]);
05500		  IF SPCFIL THEN SWPTBL[1]_CVSIX("SYS");
05600		SWPTBL[4]_SWPTBL[6]_0; ELSEC
05700		  INTEGER ARRAY	SWPTBL[1:5];
05800		  SWPTBL[1]_CVSIX(TSA);
05900		  SWPTBL[2]_CVFIL(TSB,SWPTBL[3],SWPTBL[5]);
06000		  IF SPCFIL THEN SWPTBL[5]_CVSIX("  1  3");
06100		  IF RPGSW THEN	SWPTBL[4]_1; ENDC;
06200		  STARTCODE
06300		     MOVE '14,SWPTBL; MOVEM '14,TIA;
06400		  END;
06500	IFCR TYMSWSC THENC IF RPGSW THEN TIA_TIA+'1000000;
06600		  CALL(TIA,"RUN"); ELSEC CALL (TIA,"SWAP"); ENDC;
06700	       END "NEWPROGRAM"
06800	
     
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_CV6STR(TIA)&"."&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_CV6STR(TIA)&"."&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,"DSK") THEN NULL ELSE TSA)&TSB&
04700		    '15&'12);
04800		  NXTFIL_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 UNSTACKDELIMITERS; COMMENT REVERT;