perm filename SCISS.SAI[X,AIL]3 blob sn#083829 filedate 1974-01-25 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00009 PAGES VERSION 3-3(12)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00004 00003	BEGIN "SCISS"
 00007 00004	A GREAT HAIRY KLUGE
 00009 00005	   PROCEDURE LIBHED  COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL
 00012 00006	   PROCEDURE LIBMAK  (STRING F)
 00019 00007	MAIN EXECUTION STARTS HERE
 00029 00008	   IF RPGSW THEN BEGIN "SECOND PASS -- PROCESS LIBRARY"
 00033 00009	
 00037 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  300300000014  ⊗;


COMMENT ⊗
VERSION 3-3(12) 1-25-74 BY RHT  FLUSH VERSION DEMANDING
VERSION 3-3(11) 1-11-74 BY JRL USE CMU VERSION
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 = "'300300000013";
   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",
    TOCRLF="8", OVERDEL="9", COMDEL="11",
     KLUGETB="13"
     ;

   REQUIRE VERSION_NUMBER VERSION;
   STRING STR,LINE,LINE1,COMNAM,TS,FILE,FFFF,GOGFIL,RLSTR;
   STRING LIBNAM, HLBNAM,GASNAM;
   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,GASLIB;
   LABEL ENDER,LAB;
   EXTERNAL INTEGER RPGSW;

   DEFINE MAXCOMP="60", EXTRACT="1", DOITBIT="4", HEADBIT="2",KLUGEBIT="'4000";
   DEFINE GOGBIT="8";
   STRING ARRAY ORDER,FILES[1:MAXCOMP]; INTEGER ARRAY BITS[1:MAXCOMP];
   INTEGER ARRAY SPEC[1:10],BUFR,SYMBLOK[0:'23];
   STRING ARRAY FILLST[1:20];
   INTEGER ARRAY ENTRS[0:299];
   INTEGER ARRAY DOTHIS[1:20];
INTEGER CMUSW,STANSW;
STRING SITEID;
COMMENT A GREAT HAIRY KLUGE;
INTEGER HEADKLUGEDONE;
SIMPLE PROCEDURE KLGGZERO;HEADKLUGEDONE←0;
REQUIRE KLGGZERO INITIALIZATION;
PROCEDURE CPYFIL(STRING F1,F2);
	BEGIN
	INTEGER I,J;
	STRING S;
	LOOKUP(DSKI,F1,I);
	IF I THEN USERERR(1,1,"TROUBLE LOOKING UP:"&F1);
	ENTER(DSKO,F2,J);
	IF J THEN USERERR(0,0,"TROUBLE WITH ENTER ON:"&F2);
	DO
		BEGIN
		S←INPUT(DSKI,KLUGETB);
		OUT(DSKO,S);
		END UNTIL EOF;
	CLOSE(DSKO);
	CLOSE(DSKI);
	END;

PROCEDURE KLUGE(INTEGER COMNO);
	BEGIN
	IF ¬(BITS[COMNO] LAND KLUGEBIT) THEN RETURN;
	IF NOT HEADKLUGEDONE THEN
		BEGIN
		HEADKLUGEDONE←1;
		CPYFIL("HEAD","HEAD.FAI");
		END;
	IF EQU(ORDER[COMNO],"SAIHED") THEN
		BEGIN
		FILES[COMNO]←"SAIHED.FAI,HEAD.FAI";
		END
	ELSE IF EQU(ORDER[COMNO],"SAILEP") THEN
		BEGIN
		CPYFIL("LEPRUN","SAILEP.FAI");
		FILES[COMNO]←"HEAD.FAI,SAILEP.FAI";
		END
	ELSE IF EQU(ORDER[COMNO],"SAIREM") THEN
		BEGIN
		CPYFIL("WRDGET","SAIREM.FAI");
		FILES[COMNO]←"HEAD.FAI,SAIREM.FAI";
		END
	ELSE
		BEGIN
		OUTSTR("SURPRISE USE OF HAIRY KLUGE: "&ORDER[COMNO]&"
TYPE ANY KEY TO GO ON (SHOULD BE OK)");
		INCHRW;
		END;
	END;
   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 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";
COMMENT -- BLOCK TYPE MISMATCH -- HAVE"YESNO", NEED ;

   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 -- BLOCK TYPE MISMATCH -- HAVE"MARKIT", NEED ;
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");
   SETBREAK(KLUGETB,'12,NULL,"INA");

OUTSTR("SITE ID (<CR> OK FOR SU-AI) = ");
SITEID←INCHWL;
IF EQU(SITEID,"SU-AI") OR LENGTH(SITEID)=0 THEN
	BEGIN
	STANSW←1;
	END
ELSE
	BEGIN
	STANSW←0;
	END;
IF EQU(SITEID,"CMU") THEN CMUSW←1 ELSE CMUSW←0;

GASLIB←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
");
IF NOT CMUSW THEN
      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
");
IF CMUSW THEN
  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)
   9	MAKE GAS LIBRARY (IMPLIES REENTRANT)
" 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
   6	MAKE GAS LIBRARY (IMPLIES REENTRANT)
");

      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 9 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;
	    [8] GO TO TOOBIG;
	     [9] IF NOT CMUSW THEN  GO TO TOOBIG ELSE 
			RENTLIB←GASLIB←TRUE;
	    [10]
	 END ELSE
	 CASE (IF ¬FROMPASS1 THEN ANSCODE MIN 6 ELSE
	  (CASE ANSCODE MIN 8 OF (0,0,0,0,3,4,5,1,2,6))) OF BEGIN
	     [1]  DELETING←FALSE;
	     [2]  DOLIB←FALSE;
	     [3]  RENTLIB←TRUE;
	     [4]  EACHASK←TRUE;
	     [5]  WILLTELL←TRUE;
	     [6] IF NOT CMUSW THEN GO TO TOOBIG ELSE RENTLIB←GASLIB←TRUE;
	     [7]
	      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";
	 GASNAM←"GLBSA"&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"
		LABEL DONEONELIBL;
	  IF EQU("HDR",GGGG) THEN BEGIN "STD LIB"
		IF FFFF[INF FOR 1]="*" THEN BEGIN
			IF GASLIB THEN BEGIN
				OUTSTR(READ&" NOT BEING DONE BECAUSE THIS IS GASSY"&CRLF);
				GO TO DONEONELIBL;
			END ELSE FFFF←FFFF[1 TO INF-1];
		END;
	     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+KLUGEBIT
				ELSE EXTR←KLUGEBIT;
	  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";

DONEONELIBL:
       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 GASLIB THEN GASNAM ELSE 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 "SECOND PASS -- PROCESS LIBRARY" 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;
	  KLUGE(COMNO);
	  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);
	IF GASLIB THEN OUT(DSKO,"?GASSW←←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";
COMMENT -- BLOCK TYPE MISMATCH -- HAVE"OPNFIL", NEED ;

	    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";