Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0002/sciss.sai
There is 1 other file named sciss.sai in the archive. Click here to see a list.
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 VERSIONNUMBER = "'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 VERSIONNUMBER 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 BEOFWORD0;
	      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 DSCRINGNOTINCOMM=";"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 DSCRINGSUBEQU("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 BREAKDELIM 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)=6FIND(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 DOHEADINTFIL THEN 
	 ENTER(DSKO,"SAIHED.FAI",I); IF I THEN
	  USERERR(0,0,"TROUBLE WITH SAIHED");
	 WRITE CRLF&"HEDSYM__1" EOM;
	 CLOSE (DSKO);
      ;

      IF INTFILDOEXTR 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+1PTYSWCT=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=CTPTYSW  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";