COMMENT ⊗   VALID 00008 PAGES VERSION 3-3(10)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00004 00003	BEGIN "SCISS"
 00006 00004	PROCEDURE LIBHED  COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL
 00009 00005	PROCEDURE LIBMAK  (STRING F)
 00016 00006	MAIN EXECUTION STARTS HERE
 00024 00007	IF RPGSW THEN BEGIN "SECOND PASS -- PROCESS LIBRARY"
 00027 00008	
 00031 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,SAIL,REASON
025  300300000012  ⊗;


COMMENT ⊗
VERSION 3-3(10) 12-4-73 BY RHT ADD LIBHED KLUGE TO SCISS
VERSION 3-3(9) 12-4-73 
VERSION 3-3(8) 7-13-73 BY JRL AVOID "RENAME DIFFICULTY" FOR SAIREM
VERSION 3-3(7) 7-4-72 BY DCS FIX "D" BUG WHEN SELECTING FROM PROMPT
VERSION 3-3(6) 6-25-72 BY DCS ADD NAM COMMAND TO ORDER, LIBNAM FEATURE TO SCISS
VERSION 3-3(5) 5-23-72 BY DCS AVOID HDRFIL IF NOT NEEDED
VERSION 3-3(4) 2-24-72 BY DCS ADD RENSW CONTROL, CHANGE  PARAMETER INPUT
VERSION 3-3(3) 2-10-72 BY DCS ADD OVERRIDE CAPABILITY FOR INTERMEDIATE FILE CREATION
VERSION 3-3(2) 2-10-72 BY DCS UPGRADE ORDER BUSINESS
VERSION 3-3(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
BEGIN "SCISS"
  DEFINE VERSION_NUMBER = "'300300000012";
DEFINE
	BINI="4",BINO="5",COMO="6",CRLF="('15&'12)",
	WILLDO="'1",HAVDON="'2",ERROR="'4",
	TTY="1",DSKI="2",DSKO="3",
	BIT (X,Y)="Y LAND X",PUTBIT (X,Y)="X←X LOR Y",
	REMBIT(X,Y)="X←X XOR Y",
	TYPE="OUTSTR(",EOM="&('15&'12))",
	WRITE="OUT(DSKO,",READ="INPUT(DSKI,1)",
	CONTROLC="'3",STANSW="TRUE",
	TOCRLF="8", OVERDEL="9", COMDEL="11"
;

REQUIRE VERSION_NUMBER VERSION;
STRING STR,LINE,LINE1,COMNAM,TS,FILE,FFFF,GOGFIL,RLSTR;
STRING LIBNAM, HLBNAM;
INTEGER I,J,TTYCHAR,FILCNT,SWITCH,W,BREAK,EOF,LOW,HIGH,BEOF,ENTSEEN;
INTEGER SYMBOL,SYMBOLS,RELOC,CCOUT,SYMCNT,TYPP,COMNO,SEEN;
INTEGER DELETING, COMMNT, DSCRING, WILLTELL, EACHASK, MAXTHS;
INTEGER NOTINCOM,DELIM,TEMPP,DOLIB,DOFAIL,CT,YV,DOEXTR;
INTEGER ENTPNT,DOHEAD,FILDEX,MAXFIL,GOGDO,EXTR,INTFIL,RENTLIB;
LABEL ENDER,LAB;
EXTERNAL INTEGER RPGSW;

DEFINE MAXCOMP="60", EXTRACT="1", DOITBIT="4", HEADBIT="2";
DEFINE GOGBIT="8";
STRING ARRAY ORDER,FILES[1:MAXCOMP]; INTEGER ARRAY BITS[1:MAXCOMP];
INTEGER ARRAY SPEC[1:0],BUFR,SYMBLOK[0:'23];
STRING ARRAY FILLST[1:20];
INTEGER ARRAY ENTRS[0:299];
INTEGER ARRAY DOTHIS[1:20];
PROCEDURE LIBHED;  COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL;
BEGIN "LIBHED"
INTEGER COUNT,TYPEWD,BLKSIZ,BRK,EOF; DEFINE SRC="BINI",DST="BINO";
INTEGER ARRAY BLOCK[0:17];

PROCEDURE GETBLK;
BEGIN "GETBLK"
    IF COUNT=0 THEN BEGIN
	TYPEWD ← WORDIN(SRC);
	COUNT ← TYPEWD LAND '777777;
	TYPEWD ← TYPEWD LSH -18
    END;
    WORDIN(SRC);
    ARRYIN(SRC,BLOCK[0],BLKSIZ ← COUNT MIN 18);
    COUNT ← COUNT - BLKSIZ
END "GETBLK";

PROCEDURE PUTBLK(INTEGER TYP, VAL1, VAL2);
BEGIN "PUTBLK"
    INTEGER CT;
    WORDOUT(DST,TYP LSH 18 + (CT←CASE TYP OF (0,0,2,0,1,1,2)));
    WORDOUT(DST,IF TYP=5 THEN '2 LSH 33 ELSE 0);
    WORDOUT(DST,VAL1);
    IF CT=2 THEN WORDOUT(DST,VAL2);
END "PUTBLK";

IF ¬DOLIB THEN RETURN;

OUTSTR("COPYING (SPECIALLY) SAIHED.REL
");

LOOKUP(SRC,"SAIHED.REL",COUNT);

COUNT←0;
DO GETBLK UNTIL TYPEWD=2;
DO BEGIN
    INTEGER B,C;
    C←BLOCK[0];
    IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN BEGIN
	PUTBLK(4,B←C LAND '37777777777,0);
	PUTBLK(6,B,0);
	PUTBLK(2,C,BLOCK[1]);
	PUTBLK(5,0,0);
    END;
    GETBLK
END UNTIL TYPEWD=5;

COMMENT AS FUDGE2 DOES NOT COPY THE LAST ELEMENT WE MUST PROVIDE A DUMMY;
PUTBLK(0,0,0);

CLOSE(SRC);
END "LIBHED";
PROCEDURE LIBMAK  (STRING F);
BEGIN  STRING FILN; INTEGER ETWAS;
    BEOF←0; ENTPNT←ETWAS←0;
    IF DELETING ∧¬EQU(F,"SAILEP")∧¬EQU(F,"SAIREM") THEN BEGIN "DEL FAIL"
	LOOKUP(BINI,F&".FAI",I);
	RENAME (BINI,"",0,I);
	OUTSTR((IF I THEN "RENAME DIFFICULTY WITH " ELSE NULL)&
	   F&(IF I THEN ".FAI  " ELSE ".FAI DELETED  "));
	CLOSE (BINI);
	ETWAS←TRUE;
    END "DEL FAIL";
    FILN←F&".REL";
    IF EQU(F,"SAIHED")  THEN
	LIBHED
    ELSE IF DOLIB THEN BEGIN "COP FIL"
	LOOKUP	(BINI,FILN,I);
	IF ¬I THEN OUTSTR( "COPYING "&FILN);
	ETWAS←TRUE;
	SYMBLOK[1]←SYMCNT←0;
	IF ¬I THEN WHILE ¬BEOF DO BEGIN "COP BLK"
	    DEFINE WORD="BUFR[0]";
	    DO WORD ← WORDIN(BINI) UNTIL BEOF∨WORD≠0;
	    TYPP←WORD LAND '77000000;
	    CCOUT ← WORD LAND '777 ;
	    ARRYIN (BINI,BUFR[1],CCOUT+1);
	IF TYPP='4000000 THEN BEGIN "ENTRY BLOCK"
		ARRBLT(ENTRS[ENTPNT],BUFR[2],CCOUT);
		ENTPNT←ENTPNT+CCOUT;
	END "ENTRY BLOCK" ELSE
	BEGIN "NOT ENTRY"
	IF ENTPNT THEN BEGIN "WRITE ENTRY"
		WORDOUT(BINO,'4000000+ENTPNT);
		FOR I←0 STEP 18 UNTIL ENTPNT-1 DO BEGIN "WR ECH"
			WORDOUT(BINO,0);
			ARRYOUT(BINO,ENTRS[I],18 MIN (ENTPNT-I));
		END "WR ECH"
	END "WRITE ENTRY";
	ENTPNT←0;
	IF TYPP = '5000000 AND SYMCNT THEN BEGIN "END BLOCK"
		COMMENT THIS IS THE END BLOCK -- FORCE OUT SYMBOLS.;
		SYMBLOK[0] ← '2000000 +SYMCNT ;
		ARRYOUT (BINO,SYMBLOK[0],SYMCNT+2);
	END "END BLOCK";
	IF TYPP ≠'2000000  THEN BEGIN "NOT SYMBOLS"
		COMMENT COPY THE BLOCK TO THE OUTPUT FILE;
		ARRYOUT (BINO,BUFR[0],CCOUT+2);
	END "NOT SYMBOLS" ELSE
		COMMENT THESE ARE SYMBOLS. COPY THEM IF SYMBOLS
			ARE REQUESTED.  OTHERWISE,
			IGNORE UNLESS INTERNAL OR EXTERNAL.;
	FOR I←2 STEP 2 UNTIL CCOUT+1 DO
	 IF LDB(POINT(1,BUFR[I],2))≠1 THEN
	 BEGIN "SYMS"
		SYMCNT ← SYMCNT +2;
		SYMBLOK[SYMCNT]←BUFR[I];
		SYMBLOK[SYMCNT+1]←BUFR[I+1];
		SYMBLOK[1]←SYMBLOK[1] LOR (((BUFR[1] 
			 ROT (2*I)) LAND '17 ) ROT (-2*SYMCNT));
		COMMENT LAST LINE WAS UPDATING RELOCATION BITS.;
		IF SYMCNT ='22 THEN BEGIN
			SYMBLOK[0] ← '2000022 ;
			ARRYOUT (BINO,SYMBLOK[0],'24);
			SYMCNT←SYMBLOK[1]←0;
		END;
	END "SYMS";
	IF TYPP ='5000000 THEN DONE
END "NOT ENTRY" END "COP BLK" END "COP FIL";
   IF DELETING THEN BEGIN "DEL FIL"
	CLOSE (BINI);
	LOOKUP (BINI,FILN,I);
	RENAME (BINI,"",0,I);  ETWAS←TRUE;
	OUTSTR((IF I THEN "  RENAME FAILURE FOR " ELSE "  ")&
		FILN & (IF I THEN NULL ELSE " DELETED"));
   END "DEL FIL";
   IF ETWAS THEN TYPE NULL EOM;
END;

BOOLEAN PROCEDURE YESNO(STRING S);
BEGIN 
 OUTSTR(S&"?");
 RETURN(IF (YV←INCHWL)="N" THEN FALSE ELSE YV)
END "YESNO";

BOOLEAN PROCEDURE SUBEQU(STRING S1,S2);
 RETURN(EQU(S1,S2[1 FOR LENGTH(S1)]));

STRING PROCEDURE COMPRESS(STRING L,M);
BEGIN "COMPRESS"
 IF DSCRING∨NOTINCOM∨M=";"∨¬LENGTH(M)
   ∨SUBEQU("COMPIL",M) THEN RETURN(NULL)
 ELSE RETURN(L&CRLF)
END "COMPRESS";

PROCEDURE GETLINE;
BEGIN "GETLINE"
 LINE1←LINE←INPUT(DSKI,TOCRLF);
 TS←SCAN(LINE1,OVERDEL,I);
IF ¬DSCRING∧SUBEQU("DSCR",LINE1) THEN DSCRING←TRUE;
 IF SUBEQU("COMMENT",LINE1)∨
		SUBEQU("Comment",LINE1)∨
		SUBEQU("comment",LINE1) THEN
	BEGIN
		TS←SCAN(LINE1←LINE1[8 TO ∞],OVERDEL,I);
		DELIM←I; SETBREAK(COMDEL,DELIM,NULL,"IN");
		I←LOP(LINE1);
		I←0; TS←SCAN(LINE1,COMDEL,BREAK); IF BREAK≠DELIM THEN
		  DO LINE1←INPUT(DSKI,COMDEL) UNTIL BREAK=DELIM;
		LINE1←NULL
	END;
 OUT(DSKO,COMPRESS(LINE,LINE1));
 IF DSCRING∧(LINE1="⊗"∨LINE1=";") THEN DSCRING←FALSE;
END "GETLINE";

BOOLEAN PROCEDURE FIND(STRING S);
BEGIN "FIND"
 FOR COMNO←1 STEP 1 UNTIL MAXTHS DO
  IF EQU(S,ORDER[COMNO]) THEN RETURN(TRUE);
 RETURN(FALSE)
END "FIND";

PROCEDURE MARKIT(INTEGER C);
BEGIN INTEGER I;
	FOR I←1 STEP 1 UNTIL MAXFIL DO
	IF EQU(FILES[C],FILLST[I]) THEN BEGIN
	  DOTHIS[I]←TRUE; DONE
	END;
	IF BITS[C] LAND EXTRACT THEN FILES[C]←
	  "HDRFIL(R),"&ORDER[C]
END "MARKIT";
COMMENT MAIN EXECUTION STARTS HERE;

	OPEN(DSKI,"DSK",1,2,0,400,BREAK,EOF);
	OPEN(DSKO,"DSK",1,0,2,00,W,W);
	OPEN(BINI,"DSK",'10,4,0,400,BREAK,BEOF);
	OPEN(BINO,"DSK",'10,0,4,00,W,W);
	OPEN(COMO,"DSK",1,0,2,00,W,W);

	BREAKSET(1,"⊗"&'15,"I");
	BREAKSET(1,'12,"O");
	BREAKSET(1,NULL,"N");
	BREAKSET(2,"→,"&'15,"I");
	SETBREAK(TOCRLF,'12,'15&'14,"IN");
	SETBREAK(OVERDEL," 	",NULL,"XNR");

EACHASK←WILLTELL←GOGDO←RENTLIB←FALSE;
DELETING←DOLIB←DOHEAD←DOEXTR←DOFAIL←INTFIL←TRUE;

IF ¬YESNO("STANDARD") THEN BEGIN "ASK"
  STRING ANSWER; INTEGER FROMPASS1;

  OUTSTR("
TYPE THE NUMBERS OF THOSE PARAMETERS YOU WISH TO AFFECT:
 INDEX	DESCRIPTION
");
  OUTSTR(IF ¬RPGSW THEN "
   1	PASS 2 NOW
   2	DON'T CHAIN TO FAIL
   3	DON'T CREATE INTERMEDIATE FILES
   4	MAKE RE-ENTRANT LIBRARY
   5	SELECT ENTRIES FROM PROMPT-LIST
   6	SPECIFY ENTRIES EXPLICITLY
   7	DON'T DELETE INTERMEDIATE FILES (PASS 2)
   8	DON'T MAKE A LIBRARY (PASS 2)
" ELSE "
   1	DON'T DELETE INTERMEDIATE FILES
   2	DON'T MAKE A LIBRARY
   3	MAKE A RE-ENTRANT LIBRARY
   4	SELECT ENTRIES FROM PROMPT-LIST
   5	SPECIFY ENTRIES EXPLICITLY
");

   OUTSTR("*");
   ANSWER←INCHWL;
   FROMPASS1←FALSE;
   WHILE LENGTH(ANSWER) DO BEGIN
	LABEL TOOBIG; INTEGER ANSCODE,I;
	ANSCODE←INTSCAN(ANSWER,I); IF ¬ANSCODE THEN DONE;
	IF ¬RPGSW THEN CASE ANSCODE MIN 7 OF BEGIN
	[1]  BEGIN RPGSW←TRUE; FROMPASS1←TRUE END;
	[2]  DOFAIL←FALSE;
	[3]  INTFIL←FALSE;
	[4]  RENTLIB←TRUE;
	[5]  EACHASK←TRUE;
	[6]  WILLTELL←TRUE;
	[7]  GO TO TOOBIG
	END ELSE
	CASE (IF ¬FROMPASS1 THEN ANSCODE MIN 6 ELSE
	  (CASE ANSCODE MIN 8 OF (0,0,0,0,3,4,5,1,2))) OF BEGIN
	[1]  DELETING←FALSE;
	[2]  DOLIB←FALSE;
	[3]  RENTLIB←TRUE;
	[4]  EACHASK←TRUE;
	[5]  WILLTELL←TRUE;
	[6]
	TOOBIG:OUTSTR(CVS(ANSCODE)&" TOO BIG -- IGNORED"&('15&'12))
	END;
   END;
  END "ASK";
	RLSTR←NULL;
	IF RENTLIB THEN BEGIN DOLIB←TRUE; RLSTR←"SAIREN.FAI," END;
	W←CALL (W,"PJOB");
	COMNAM←IF ¬STANSW THEN "0"&CVS( W % 10 )&CVS( W MOD 10)&"FAI.TMP" 
	 ELSE "QQFAIL.RPG";

   I←0;
COMMENT READ IN THE ORDER CODE;
	GOGDO←FALSE;	COMMENT ON IF COMPIL SPEC WANTS GOGOL;
	LOOKUP	(DSKI,"ORDER",I);
	IF I THEN BEGIN TYPE "CAN'T FIND ORDER" EOM; GO ENDER END;
	LINE←READ; COMMENT GET COMMENT LINE;
	LINE←READ; COMMENT GET REST OF COMMENT LINE;
	MAXTHS←MAXFIL←0;
	DOTHIS[1]←FALSE; ARRBLT(DOTHIS[2],DOTHIS[1],19);
	WHILE ¬SUBEQU("END",FFFF←READ) DO BEGIN "GSPEC"
	  STRING GGGG;  GGGG←FFFF[1 TO 3]; FFFF←FFFF[5 TO ∞];
	  EXTR←0;
	  IF EQU("NAM",GGGG) THEN BEGIN "LIBRARY NAME"
		LIBNAM←"LIBSA"&(GGGG←SCAN(FFFF,2,I))&".REL";
		HLBNAM←"HLBSA"&GGGG&".REL"
	  END "LIBRARY NAME" ELSE
	  IF EQU("ALL",GGGG) THEN
	  WHILE LENGTH(FFFF) DO BEGIN "PREP HDRFIL"
		GGGG←SCAN(FFFF,2,I); IF GGGG="!" THEN
		  GGGG←GOGFIL←GGGG[2 TO ∞];
		FILLST[MAXFIL←MAXFIL+1]←GGGG;
		DOTHIS[MAXFIL]←TRUE
	  END "PREP HDRFIL" ELSE BEGIN "LIB LIST"
	    IF EQU("HDR",GGGG) THEN BEGIN "STD LIB"
		  EXTR←IF EQU(FFFF,GOGFIL) THEN EXTRACT+GOGBIT ELSE EXTRACT;
		  FOR I←1 STEP 1 UNTIL MAXFIL DO IF EQU(FFFF,FILLST[I]) THEN DONE;
		  IF I>MAXFIL THEN FILLST[MAXFIL←MAXFIL+1]←FFFF
	    END "STD LIB" ELSE IF EQU("HED",GGGG) THEN EXTR←HEADBIT;
	    LINE←(READ)[2 TO ∞];
	    WHILE LENGTH(LINE) DO BEGIN "ONE LIB"
		  ORDER[MAXTHS←MAXTHS+1]←"SAI"&SCAN(LINE,2,J);
		  BITS[MAXTHS]←EXTR;
		  FILES[MAXTHS]←FFFF
	    END "ONE LIB"
	  END "LIB LIST"
	END "GSPEC";
	CLOSE(DSKI);

   IF ¬WILLTELL THEN BEGIN "GET ORDER"
	INTEGER K,KK,J; K←0;
	IF EACHASK THEN TYPE "TYPE `Y', `N', OR `DONE'" EOM;
	FOR I←1 STEP 1 UNTIL MAXTHS DO BEGIN
	   TS←ORDER[I];
	   IF ¬EACHASK∨(KK←YESNO(TS))="Y" THEN BEGIN
	       IF (J←BITS[I]) LAND GOGBIT THEN GOGDO←TRUE;
	       BITS[I]←J LOR DOITBIT;
	       MARKIT(I)
	   END ELSE IF KK="D" THEN
		IF (I←I-1)<0 ∨ K=0 THEN DONE ELSE EACHASK←FALSE;
	   K←KK
	END
   END "GET ORDER" ELSE
   BEGIN "TAKE ORDER"
	TS←NULL;
	TYPE "TYPE LIBRARY TITLES, `DONE' WHEN DONE" EOM;
	NEEDNEXT WHILE ¬EQU("DONE",TS) DO BEGIN
	  OUTSTR("*");
	  TS←INCHWL; NEXT;
	  IF SUBEQU("SAI",TS)∧LENGTH(TS)=6∧FIND(TS) THEN BEGIN
		IF (J←BITS[COMNO]) LAND GOGBIT THEN GOGDO←TRUE;
		BITS[COMNO]←J LOR DOITBIT;
		MARKIT(COMNO)
	  END ELSE
	     TYPE TS&" INVALID -- TRY AGAIN " EOM;
	END;
   END "TAKE ORDER";
IF RPGSW THEN BEGIN "SECOND PASS -- PROCESS LIBRARY"
	IF DELETING THEN BEGIN
		LOOKUP(BINI,"HDRFIL",I);
		RENAME (BINI,"",0,I);
		IF I THEN TYPE "RENAME DIFFICULTY WITH HDRFIL" EOM
		  ELSE TYPE "HDRFIL DELETED" EOM;
		CLOSE (BINI);
		IF RENTLIB THEN BEGIN
		  LOOKUP(BINI,"SAIREN.FAI",I);
		  RENAME(BINI,"",0,I);
		  IF I THEN TYPE "RENAME DIFFICULTY WITH SAIREN" EOM
		   ELSE TYPE "SAIREN.FAI DELETED" EOM;
		  CLOSE (BINI)
		END
	END;
	I←0;
	IF DOLIB THEN
	  ENTER (BINO,IF RENTLIB THEN HLBNAM ELSE LIBNAM,I);
	IF I THEN BEGIN TYPE "CAN'T ENTER "&LIBNAM&".REL" EOM; GO ENDER END;
	FOR COMNO←1 STEP 1 UNTIL MAXTHS DO IF BITS[COMNO] LAND DOITBIT THEN
		LIBMAK (ORDER[COMNO]);
	CLOSE (BINO);	COMMENT THIS IS THE LIBRARY;

	IF DOLIB THEN BEGIN TYPE "TRY OUT YOUR NEW LIBRARY!" EOM END
		ELSE BEGIN TYPE "READY FOR WHATEVER" EOM END;

END ELSE BEGIN "FIRST PASS"
	INTEGER PTYSW;

	ENTER (COMO,COMNAM,I);
	DOHEAD←DOEXTR←FALSE;
	IF I THEN TYPE "CANNOT ENTER COMMAND FILE" EOM;
	FOR COMNO←1 STEP 1 UNTIL MAXTHS DO
	IF BITS[COMNO] LAND DOITBIT THEN BEGIN
	     STRING SRCFIL;
	     IF BITS[COMNO] LAND EXTRACT THEN DOEXTR←TRUE;
	     IF BITS[COMNO] LAND HEADBIT THEN DOHEAD←TRUE;
	     OUT(COMO,ORDER[COMNO]&"←"&RLSTR&FILES[COMNO]&CRLF);
	 TYPE ORDER[COMNO]&" WILL BE ASSEMBLED" EOM
        END;
	OUT(COMO,"DSK:SCISS!"&CRLF);
	CLOSE(COMO); CLOSE(DSKO);
	IF RENTLIB THEN BEGIN
		ENTER(DSKO,"SAIREN.FAI",I); IF I THEN
		 USERERR(0,0,"TROUBLE WITH SAIREN");
		OUT(DSKO,"↓RENSW←←1"&CRLF&CRLF);
		CLOSE(DSKO)
	END;
       IF DOHEAD∧INTFIL THEN BEGIN
	ENTER(DSKO,"SAIHED.FAI",I); IF I THEN
		USERERR(0,0,"TROUBLE WITH SAIHED");
	WRITE CRLF&"↓HEDSYM←←1" EOM;
	CLOSE (DSKO);
     END;

     IF INTFIL∧DOEXTR THEN BEGIN "CR INT FIL"
	NOTINCOM←FALSE; ENTER(DSKO,"HDRFIL",I);
            IF I THEN USERERR(0,0,"TROUBLE WITH HDRFIL");
	WRITE "↓ALWAYS←←0" EOM;
	CT←0; PTYSW←0; FILDEX←0;
	WHILE TRUE DO BEGIN "DO FILE"
	  LABEL D;
	  PROCEDURE OPNFIL;
	  WHILE (FILDEX←FILDEX+1)≤MAXFIL DO IF DOTHIS[FILDEX] THEN BEGIN
	    FILE←FILLST[FILDEX];
	    CLOSE(DSKI);
	    DSCRING←FALSE;
	    OUTSTR("LOOKING AT "&FILE&CRLF);
	    LOOKUP(DSKI,FILE,I); IF I THEN USERERR(0,0,"CAN'T FIND "&FILE);
	    EOF←FALSE;
	    DONE
	  END "OPNFIL";

	   OPNFIL; IF FILDEX>MAXFIL THEN DONE;
	    DO BEGIN "READ THE LINES"
	     GETLINE;
	     IF SUBEQU("COMPIL",LINE) THEN BEGIN "IS A COMPILE"
		 IF CT=MAXTHS+1∨¬PTYSW∧CT=MAXTHS THEN DONE;
		 IF EQU(FILE,GOGFIL)∧¬GOGDO THEN
		 BEGIN
		   OUTSTR("ABANDONING "&FILE&" AFTER HDRFIL"&CRLF);
		   OPNFIL;IF FILDEX>MAXFIL THEN GO D
		 END;
		 IF FIND(TS←"SAI"&LINE[8 FOR 3])∧
		   BITS[COMNO] LAND (DOITBIT+EXTRACT)=DOITBIT+EXTRACT THEN
		 BEGIN "WANT THIS ONE"
			NOTINCOM←FALSE; CLOSE(DSKO);
			CT←CT+1;
			ENTER(DSKO,TS&".FAI",I);
			 IF I THEN USERERR(0,0,"TROUBLE WITH SAI"&TS);
			TYPE TS&" FOUND" EOM;
			IF EQU(TS,"PTY") THEN PTYSW←TRUE;
			COMMNT←DSCRING←FALSE;
			WRITE LINE EOM
		END "WANT THIS ONE"
		ELSE NOTINCOM←TRUE
	      END "IS A COMPILE"
	     ELSE IF ¬ NOTINCOM ∧ SUBEQU("ENDCOM",LINE1)
		THEN BEGIN "THERE" NOTINCOM←TRUE END "THERE";
	   END "READ THE LINES" UNTIL EOF;
	   IF MAXTHS=CT∧¬PTYSW ∨ CT=MAXTHS+1 THEN DONE;
	   IF FALSE THEN D: DONE;
	END "DO FILE";
     END "CR INT FIL";
	CLOSE(DSKO);

COMMENT NOW CHAIN TO FAIL, ONE WAY OR ANOTHER;

	SPEC[1]←CVSIX("SYS");
	SPEC[2]←CVFIL(IF STANSW THEN "FAIL.DMP" ELSE "FAIL.SAV",SPEC[3],SPEC[5]);
	SPEC[4]←IF STANSW THEN 1 ELSE 0;
	SPEC[6]←0;
	IF DOFAIL THEN CALL(
		(IF STANSW THEN 0 ELSE '1000000)+POINT(0,SPEC[1],35),
		IF STANSW THEN "SWAP" ELSE "RUN"    );
END "FIRST PASS";

ENDER:

END "SCISS";