perm filename SCISS.SAI[S,AIL] blob sn#241601 filedate 1976-10-16 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00009 PAGES VERSION 3-3(11)
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	HISTORY
C00004 00003	BEGIN "SCISS"
C00007 00004	A GREAT HAIRY KLUGE
C00010 00005	   PROCEDURE LIBHED  COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL
C00014 00006	   PROCEDURE LIBMAK  (STRING F)
C00021 00007	MAIN EXECUTION STARTS HERE
C00031 00008	   IF RPGSW THEN ⊂ "SECOND PASS -- PROCESS LIBRARY"
C00036 00009	
C00041 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,SAIL,REASON
025  300300000013  ⊗;


COMMENT ⊗
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",FUNI="7",SYMO="8",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;
   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;
   INTEGER WANTNOHDR;
   LABEL ENDER,LAB;
   EXTERNAL INTEGER RPGSW;

   DEFINE MAXCOMP="70", 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;
DEFINE ⊂="BEGIN",⊃="END";
COMMENT A GREAT HAIRY KLUGE;
INTEGER HEADKLUGEDONE;
SIMPLE PROCEDURE KLGGZERO;HEADKLUGEDONE←0;
REQUIRE KLGGZERO INITIALIZATION;
PROCEDURE CPYFIL(STRING F1,F2,FIRSTLINE);
	⊂
	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);
	IF LENGTH(FIRSTLINE) THEN OUT(DSKO,FIRSTLINE);
	DO
		⊂
		S←INPUT(DSKI,KLUGETB);
		OUT(DSKO,S);
		⊃ UNTIL EOF;
	CLOSE(DSKO);
	CLOSE(DSKI);
	⊃;

PROCEDURE KLUGE(INTEGER COMNO);
	⊂
	IF ¬(BITS[COMNO] LAND KLUGEBIT) THEN RETURN;
	IF NOT HEADKLUGEDONE THEN
		⊂
		HEADKLUGEDONE←1;
		CPYFIL("HEAD","HEAD.FAI",NULL);
		⊃;
	IF EQU(ORDER[COMNO],"SAIHED") THEN
		⊂
		FILES[COMNO]←"SAIHED.FAI,HEAD.FAI";
		⊃
	ELSE IF EQU(ORDER[COMNO],"SAILEP") THEN
		⊂
		CPYFIL("LEPRUN","SAILEP.FAI","SEARCH HDRFIL"&CRLF);
		FILES[COMNO]←"SAILEP.FAI/R";
		⊃
	ELSE IF EQU(ORDER[COMNO],"SAIREM") THEN
		⊂
		CPYFIL("WRDGET","SAIREM.FAI","SEARCH HDRFIL"&CRLF);
		FILES[COMNO]←"SAIREM.FAI/R";
		⊃
	ELSE
		⊂
		OUTSTR("SURPRISE USE OF HAIRY KLUGE: "&ORDER[COMNO]&"
TYPE ANY KEY TO GO ON (SHOULD BE OK)");
		INCHRW;
		⊃;
	⊃;
   PROCEDURE LIBHED;  COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL;
   ⊂ "LIBHED"
      INTEGER COUNT,TYPEWD,BLKSIZ,BRK,EOF; DEFINE SRC="BINI",DST="BINO";
      INTEGER PERLINE;
      INTEGER ARRAY BLOCK[0:17];

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

      PROCEDURE PUTBLK(INTEGER TYP, VAL1, VAL2);
      ⊂ "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);
      ⊃ "PUTBLK";

      RECURSIVE STRING PROCEDURE R50TO7(INTEGER SYM); ⊂ "R50TO7"
	COMMENT CONVERT RADIX50 TO ASCII;
	IF SYM=0 THEN RETURN(NULL) ELSE ⊂
	INTEGER CHAR; CHAR←SYM MOD '50;
	CHAR←IF CHAR LEQ 10 THEN CHAR-1+"0"
	 ELSE IF CHAR LEQ 10+"Z"-'101 THEN CHAR-11+"A"
	 ELSE IF CHAR=37 THEN "."
	 ELSE IF CHAR=38 THEN "$"
	 ELSE IF CHAR=39 THEN "%"
	 ELSE 0;
	RETURN(R50TO7(SYM % '50)&CHAR) ⊃ ⊃ "R50TO7";

      IF ¬DOLIB THEN RETURN;

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

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

      PERLINE←COUNT←0;
      DO GETBLK UNTIL TYPEWD=2;
      OPEN(SYMO,"DSK",0,0,3,I,I,I); IF I THEN USERERR(0,0,"NO DSK TODAY");
      ENTER(SYMO,"GOGTAB.DEF",I); IF I THEN USERERR(0,0,"CANT ENTER GOGTAB.DEF");
      OUT(SYMO,"REQUIRE ""[][]"" DELIMITERS;"&CRLF&
	"COMMENT SYMBOLIC USER TABLE INDICES");
      DO ⊂
	 INTEGER B,C;
	 C←BLOCK[0];
	 IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN ⊂
	    PUTBLK(4,B←C LAND '37777777777,0);
	    PUTBLK(6,B,0);
	    PUTBLK(2,C,BLOCK[1]);
	    IF ¬(PERLINE LAND '37) THEN OUT(SYMO,";"&CRLF&CRLF&"DEFINE ")
	    ELSE OUT(SYMO,IF ¬(PERLINE LAND 3) THEN ","&CRLF ELSE ",");
	    OUT(SYMO,R50TO7(B)&"=['"&CVOS(BLOCK[1])&"]");
	    PERLINE←PERLINE+1;
	    PUTBLK(5,0,0);
	 ⊃;
	 GETBLK
      ⊃ UNTIL TYPEWD=5;
      OUT(SYMO,";"&CRLF&CRLF&"REQUIRE UNSTACK!DELIMITERS;"); RELEASE(SYMO);

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

      CLOSE(SRC);
      LOOKUP(SRC,"HEAD.FAI",COUNT);
      IF NOT(COUNT) THEN BEGIN
	RENAME(SRC,NULL,0,COUNT); COMMENT DELETE HEAD.FAI;
	OUTSTR((IF COUNT THEN "RENAME DIFFICULTY WITH HEAD.FAI" ELSE
		"HEAD.FAI DELETED")&CRLF) END;
      CLOSE(SRC);
   ⊃ "LIBHED";
   PROCEDURE LIBMAK  (STRING F);
   ⊂
      STRING FILN; INTEGER ETWAS;
      BEOF←0; ENTPNT←ETWAS←0;
      IF DELETING THEN ⊂ "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;
      ⊃ "DEL FAIL";
      FILN←F&".REL";
      IF EQU(F,"SAIHED")  THEN
       LIBHED
	ELSE IF DOLIB THEN ⊂ "COP FIL"
	   LOOKUP	(BINI,FILN,I);
	   IF ¬I THEN OUTSTR( "COPYING "&FILN);
	   ETWAS←TRUE;
	   SYMBLOK[1]←SYMCNT←0;
	   IF ¬I THEN WHILE ¬BEOF DO ⊂ "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 ⊂ "ENTRY BLOCK"
		 ARRBLT(ENTRS[ENTPNT],BUFR[2],CCOUT);
		 ENTPNT←ENTPNT+CCOUT;
	      ⊃ "ENTRY BLOCK" ELSE
	      ⊂ "NOT ENTRY"
		 IF ENTPNT THEN ⊂ "WRITE ENTRY"
		    WORDOUT(BINO,'4000000+ENTPNT);
		    FOR I←0 STEP 18 UNTIL ENTPNT-1 DO ⊂ "WR ECH"
		       WORDOUT(BINO,0);
		       ARRYOUT(BINO,ENTRS[I],18 MIN (ENTPNT-I));
		    ⊃ "WR ECH"
		 ⊃ "WRITE ENTRY";
		 ENTPNT←0;
		 IF TYPP = '5000000 AND SYMCNT THEN ⊂ "END BLOCK"
		 COMMENT THIS IS THE END BLOCK -- FORCE OUT SYMBOLS.;
		    SYMBLOK[0] ← '2000000 +SYMCNT ;
		    ARRYOUT (BINO,SYMBLOK[0],SYMCNT+2);
		 ⊃ "END BLOCK";
		 IF TYPP ≠'2000000  THEN ⊂ "NOT SYMBOLS"
		 COMMENT COPY THE BLOCK TO THE OUTPUT FILE;
		    ARRYOUT (BINO,BUFR[0],CCOUT+2);
		 ⊃ "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
		   ⊂ "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 ⊂
			 SYMBLOK[0] ← '2000022 ;
			 ARRYOUT (BINO,SYMBLOK[0],'24);
			 SYMCNT←SYMBLOK[1]←0;
		      ⊃;
		   ⊃ "SYMS";
		 IF TYPP ='5000000 THEN DONE
	      ⊃ "NOT ENTRY"
	   ⊃ "COP BLK"
	⊃ "COP FIL";
      IF DELETING THEN ⊂ "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"));
      ⊃ "DEL FIL";
      IF ETWAS THEN TYPE NULL EOM;
   ⊃;

   BOOLEAN PROCEDURE YESNO(STRING S);
   ⊂
      OUTSTR(S&"?");
      RETURN(IF (YV←INCHWL)="N" THEN FALSE ELSE YV)
   ⊃ "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);
   ⊂ "COMPRESS"
      IF DSCRING∨NOTINCOM∨M=";"∨¬LENGTH(M)
       ∨SUBEQU("COMPIL",M) THEN RETURN(NULL)
	ELSE RETURN(L&CRLF)
   ⊃ "COMPRESS";

   PROCEDURE GETLINE;
   ⊂ "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
	 ⊂
	    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
	 ⊃;
      OUT(DSKO,COMPRESS(LINE,LINE1));
      IF DSCRING∧(LINE1="⊗"∨LINE1=";") THEN DSCRING←FALSE;
   ⊃ "GETLINE";

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

   PROCEDURE MARKIT(INTEGER C);
   ⊂
      INTEGER I;
      FOR I←1 STEP 1 UNTIL MAXFIL DO
       IF EQU(FILES[C],FILLST[I]) THEN ⊂
	  DOTHIS[I]←TRUE; DONE
       ⊃;
      IF BITS[C] LAND EXTRACT THEN FILES[C]←ORDER[C]&"/R";
   ⊃ "MARKIT";
COMMENT -- BLOCK TYPE MISMATCH -- HAVE"MARKIT", NEED ;
COMMENT MAIN EXECUTION STARTS HERE;

   OPEN(DSKI,"DSK",1,5,0,400,BREAK,EOF);
   OPEN(DSKO,"DSK",1,0,5,00,W,W);
   OPEN(BINI,"DSK",'10,7,0,400,BREAK,BEOF);
   OPEN(BINO,"DSK",'10,0,7,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
	⊂
	STANSW←1;
	⊃
ELSE
	⊂
	STANSW←0;
	⊃;
IF EQU(SITEID,"CMU") THEN CMUSW←1 ELSE CMUSW←0;

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

   IF ¬YESNO("STANDARD") THEN ⊂ "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 ⊂
	 LABEL TOOBIG; INTEGER ANSCODE,I;
	 ANSCODE←INTSCAN(ANSWER,I); IF ¬ANSCODE THEN DONE;
	 IF ¬RPGSW THEN CASE ANSCODE MIN 9 OF ⊂
	    [1]	 ⊂
	       RPGSW←TRUE; FROMPASS1←TRUE
	    ⊃;
	    [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] 
	 ⊃ 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 ⊂
	     [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))
	  ⊃;
      ⊃;
   ⊃ "ASK";
   IF RENTLIB THEN DOLIB←TRUE;
   W←CALL (W,"PJOB");
   COMNAM←"0"&CVS( W % 10 )&CVS( W MOD 10)&"FAI.TMP";

   I←0;
COMMENT READ IN THE ORDER CODE;
   GOGDO←FALSE; COMMENT ON IF COMPIL SPEC WANTS GOGOL;
   LOOKUP	(DSKI,"ORDER",I);
   IF I THEN ⊂
      TYPE "CAN'T FIND ORDER" EOM; GO ENDER
   ⊃;
   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 ⊂ "GSPEC"
      STRING GGGG;  GGGG←FFFF[1 TO 3]; FFFF←FFFF[5 TO ∞];
      EXTR←0;
      IF EQU("NAM",GGGG) THEN ⊂ "LIBRARY NAME"
	 LIBNAM←"LIBSA"&(GGGG←SCAN(FFFF,2,I))&".REL";
	 HLBNAM←"HLBSA"&GGGG&".REL";
	 GASNAM←"GLBSA"&GGGG&".REL";
      ⊃ "LIBRARY NAME" ELSE
      IF EQU("ALL",GGGG) THEN
       WHILE LENGTH(FFFF) DO ⊂ "PREP HDRFIL"
	  GGGG←SCAN(FFFF,2,I); IF GGGG="!" THEN
	   GGGG←GOGFIL←GGGG[2 TO ∞];
	  FILLST[MAXFIL←MAXFIL+1]←GGGG;
	  DOTHIS[MAXFIL]←TRUE
       ⊃ "PREP HDRFIL" ELSE ⊂ "LIB LIST"
		LABEL DONEONELIBL;
	  IF EQU("HDR",GGGG) THEN ⊂ "STD LIB"
		IF FFFF[INF FOR 1]="*" THEN ⊂
			IF GASLIB THEN ⊂
				OUTSTR(READ&" NOT BEING DONE BECAUSE THIS IS GASSY"&CRLF);
				GO TO DONEONELIBL;
			⊃ ELSE FFFF←FFFF[1 TO INF-1];
		⊃;
	     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
	  ⊃ "STD LIB" ELSE IF EQU("HED",GGGG) THEN EXTR←HEADBIT+KLUGEBIT
				ELSE EXTR←KLUGEBIT;
	  LINE←(READ)[2 TO ∞];
	  WHILE LENGTH(LINE) DO ⊂ "ONE LIB"
	     ORDER[MAXTHS←MAXTHS+1]←"SAI"&SCAN(LINE,2,J);
	     BITS[MAXTHS]←EXTR;
	     FILES[MAXTHS]←FFFF
	  ⊃ "ONE LIB";

DONEONELIBL:
       ⊃ "LIB LIST"
   ⊃ "GSPEC";
   CLOSE(DSKI);

   IF ¬WILLTELL THEN ⊂ "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 ⊂
	 TS←ORDER[I];
	 IF ¬EACHASK∨(KK←YESNO(TS))="Y" THEN ⊂
	    IF (J←BITS[I]) LAND GOGBIT THEN GOGDO←TRUE;
	    BITS[I]←J LOR DOITBIT;
	    MARKIT(I)
	 ⊃ ELSE IF KK="D" THEN
	 IF (I←I-1)<0 ∨ K=0 THEN DONE ELSE EACHASK←FALSE;
	 K←KK
      ⊃
   ⊃ "GET ORDER" ELSE
   ⊂ "TAKE ORDER"
      TS←NULL;
      TYPE "TYPE LIBRARY TITLES, `DONE' WHEN DONE" EOM;
      NEEDNEXT WHILE ¬EQU("DONE",TS) DO ⊂
	 OUTSTR("*");
	 TS←INCHWL; NEXT;
	 IF SUBEQU("SAI",TS)∧LENGTH(TS)=6∧FIND(TS) THEN ⊂
	    IF (J←BITS[COMNO]) LAND GOGBIT THEN GOGDO←TRUE;
	    BITS[COMNO]←J LOR DOITBIT;
	    MARKIT(COMNO)
	 ⊃ ELSE
	 TYPE TS&" INVALID -- TRY AGAIN " EOM;
      ⊃;
   ⊃ "TAKE ORDER";
   IF RPGSW THEN ⊂ "SECOND PASS -- PROCESS LIBRARY"
      IF DELETING AND ¬WANTNOHDR THEN ⊂
	 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 ⊂
	    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)
	 ⊃
      ⊃;
      I←0;
      IF DOLIB THEN
       ENTER (BINO,IF GASLIB THEN GASNAM ELSE IF RENTLIB THEN HLBNAM ELSE LIBNAM,I);
      IF I THEN ⊂
	 TYPE "CAN'T ENTER "&LIBNAM&".REL" EOM; GO ENDER
      ⊃;
      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 ⊂
	 TYPE "TRY OUT YOUR NEW LIBRARY!" EOM
      ⊃
      ELSE ⊂
	 TYPE "READY FOR WHATEVER" EOM
      ⊃;

   ⊃ "SECOND PASS -- PROCESS LIBRARY" ELSE ⊂ "FIRST PASS"
      INTEGER PTYSW;

      ENTER (COMO,COMNAM,I);
      DOHEAD←DOEXTR←FALSE;
      IF I THEN TYPE "CANNOT ENTER COMMAND FILE" EOM;
      ⊂
	INTEGER FUNTIM,HEDTIM;
	INTEGER PROCEDURE FILTIM;⊂ INTEGER ARRAY X[0:6];
	    FILEINFO(X);
	    RETURN(	((X[1] LAND '700000) LSH 8) LOR
	    (((X[2] LAND '7777)) LSH 11) LOR ((X[2] LSH -12) LAND '3777)	)⊃;

	COMMENT Check creation date of HDRFIL.FUN to see if we need a new one;
	OPEN(FUNI,"DSK",0,0,0,I,I,I);
	LOOKUP(FUNI,"HDRFIL.FUN",I); IF I THEN WANTNOHDR←FALSE ELSE ⊂
	    FUNTIM←FILTIM; CLOSE(FUNI);
	    LOOKUP(FUNI,"HEAD",I); HEDTIM←FILTIM; CLOSE(FUNI);
	    LOOKUP(FUNI,"GOGOL",I); HEDTIM←FILTIM MAX HEDTIM; CLOSE(FUNI);
	    WANTNOHDR←IF FUNTIM>HEDTIM THEN TRUE ELSE FALSE;
	    RELEASE(FUNI); ⊃;
      ⊃;
      IF ¬WANTNOHDR THEN OUT(COMO,"HDRFIL/R←HDRFIL"&CRLF);
      FOR COMNO←1 STEP 1 UNTIL MAXTHS DO
       IF BITS[COMNO] LAND DOITBIT THEN ⊂
	  STRING SRCFIL;
	  IF BITS[COMNO] LAND EXTRACT THEN DOEXTR←TRUE;
	  IF BITS[COMNO] LAND HEADBIT THEN DOHEAD←TRUE;
	  KLUGE(COMNO);
	  OUT(COMO,ORDER[COMNO]&"/R←"&(IF RENTLIB THEN "SAIREN.FAI," ELSE NULL)&
		FILES[COMNO]&CRLF);
	  TYPE ORDER[COMNO]&" WILL BE ASSEMBLED" EOM
       ⊃;
      OUT(COMO,"DSK:SCISS!"&CRLF);
      CLOSE(COMO); CLOSE(DSKO);
      IF RENTLIB THEN ⊂
	 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)
      ⊃;
      IF DOHEAD∧INTFIL THEN ⊂
	 ENTER(DSKO,"SAIHED.FAI",I); IF I THEN
	  USERERR(0,0,"TROUBLE WITH SAIHED");
	 WRITE CRLF&"↓HEDSYM←←1" EOM;
	 CLOSE (DSKO);
      ⊃;

      IF INTFIL∧DOEXTR THEN ⊂ "CR INT FIL"
	 NOTINCOM←FALSE;
	    ENTER(DSKO,IF WANTNOHDR THEN "JUNK" ELSE "HDRFIL",I);
	    IF I THEN USERERR(0,0,"TROUBLE WITH HDRFIL");
	    WRITE "
UNIVERSAL HDRFIL
↓ALWAYS←←0" EOM;
	 CT←0; PTYSW←0; FILDEX←0;
	 WHILE TRUE DO ⊂ "DO FILE"
	    LABEL D;
	    PROCEDURE OPNFIL; ⊂ "OPNFIL"
	    IF SUBEQU("HEAD",FILLST[FILDEX+1]) AND WANTNOHDR THEN FILDEX←FILDEX+1;
	    WHILE (FILDEX←FILDEX+1)≤MAXFIL DO IF DOTHIS[FILDEX] THEN ⊂
	       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
	       ⊃;
	    ⊃ "OPNFIL";
COMMENT -- BLOCK TYPE MISMATCH -- HAVE"OPNFIL", NEED ;

	    OPNFIL; IF FILDEX>MAXFIL THEN DONE;
	    DO ⊂ "READ THE LINES"
	       GETLINE;
	       IF SUBEQU("COMPIL",LINE) THEN ⊂ "IS A COMPILE"
		  IF CT=MAXTHS+1∨¬PTYSW∧CT=MAXTHS THEN DONE;
		  IF EQU(FILE,GOGFIL)∧¬GOGDO THEN
		   ⊂
		      OUTSTR("ABANDONING "&FILE&" AFTER HDRFIL"&CRLF);
		      WRITE "END" EOM; COMMENT END OF UNIVERSAL FILE;
		      OPNFIL;IF FILDEX>MAXFIL THEN GO D
		   ⊃;
		  IF FIND(TS←"SAI"&LINE[8 FOR 3])∧
		   BITS[COMNO] LAND (DOITBIT+EXTRACT)=DOITBIT+EXTRACT THEN
		    ⊂ "WANT THIS ONE"
		       NOTINCOM←FALSE; WRITE "END" EOM; 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 "SEARCH HDRFIL" EOM;
		       WRITE LINE EOM
		    ⊃ "WANT THIS ONE"
		    ELSE NOTINCOM←TRUE
	       ⊃ "IS A COMPILE"
	       ELSE IF ¬ NOTINCOM ∧ SUBEQU("ENDCOM",LINE1)
		THEN ⊂ "THERE"
		   NOTINCOM←TRUE
		⊃ "THERE";
	    ⊃ "READ THE LINES" UNTIL EOF ∨((MAXTHS=CT)∧¬PTYSW) ∨ (CT=MAXTHS+1);
	    IF MAXTHS=CT∧¬PTYSW ∨ CT=MAXTHS+1 THEN DONE;
	    IF FALSE THEN D: DONE;
	 ⊃ "DO FILE";
      ⊃ "CR INT FIL";
      CLOSE(DSKO);

   COMMENT NOW CHAIN TO FAIL, ONE WAY OR ANOTHER. USE PRIVATE FAIL IF EXISTS;

      CLOSE(DSKI);
      LOOKUP(DSKI,IF STANSW THEN "FAIL.DMP" ELSE "FAIL.SAV",EOF);
      SPEC[1]←CVSIX(IF EOF THEN "SYS" ELSE "DSK");
      SPEC[2]←CVFIL(IF STANSW THEN "FAIL.DMP"
			ELSE IF EOF THEN "FAIL" 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"	   );
   ⊃ "FIRST PASS";

ENDER:

⊃ "SCISS";