perm filename SCISS.SAI[S,AIL]5 blob
sn#081254 filedate 1974-01-11 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES VERSION 3-3(11)
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,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 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",
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";