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;