perm filename EXTRAC.SAI[S,AIL] blob sn#000858 filedate 1971-12-02 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00004 PAGES VERSION 3-3(1)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00003 00003	
 00008 00004
 00009 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,SAIL,REASON
025  300300000001  ⊗;
REQUIRE '300300000001 VERSION;

COMMENT ⊗
VERSION 3-3(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
BEGIN "EXTRACT"
 DEFINE MAXBLK="15";

 INTEGER I,BRK,EOF,FLAG,DATA,LASTLINE,LASTCREF,J,K,PDP;


 STRING LINE,TEM1,TEM2,FILE,CREF,FIL,PAG,WHICH,BLK;
 STRING ARRAY BLOCKS[0:MAXBLK];


 DEFINE DSKIN="1", DSKOUT="2", CRLF="('15&'12)";
 DEFINE CONTINUE="GO TO CONTLAB",SETCONT="LABEL CONTLAB;",
  PLCONT="CONTLAB:",TAB="'11";

PROCEDURE FATAL; USERERR(0,0,"FATAL");

PROCEDURE LINOUT(STRING L);
 OUT(DSKOUT,L&CRLF);

PROCEDURE PUSH(STRING S);BLOCKS[PDP←PDP+1]←S;
STRING PROCEDURE POP; RETURN(BLOCKS[(PDP←PDP-1)+1]);

PROCEDURE D(STRING U; REFERENCE INTEGER X);
BEGIN "D" 
 IF X THEN RETURN;
  OUTSTR("LINE IS "&CRLF&LINE&CRLF&"STRING IS "&U&CRLF);
  IF INCHRW≠" " THEN X←TRUE
END "D";

STRING PROCEDURE GETWRD(REFERENCE STRING L);
BEGIN "GETWRD"
  STRING M;
  
  M←SCAN(L,9,FLAG);
  IF FLAG≠0 THEN M←SCAN(L,7,FLAG);
  RETURN(IF FLAG≠0 THEN M ELSE NULL);
END "GETWRD";

PROCEDURE CHECKLC;
BEGIN "CHECKLC"
 IF CVD(CREF)<LASTCREF THEN USERERR(0,0,"BAD CREF SEQ");
 LASTCREF←CVD(CREF);
END "CHECKLC";

BOOLEAN PROCEDURE SUBEQU(STRING S1,S2);
BEGIN "SUBEQU"
 IF LENGTH(S2)<LENGTH(S1) THEN RETURN (FALSE);
 RETURN(EQU(S1,S2[1 FOR LENGTH(S1)]))
END "SUBEQU";

STRING PROCEDURE GETLINE;
WHILE TRUE DO BEGIN "GETLINE"
 SETCONT
 STRING L,TEMP,M;
 L←INPUT(DSKIN,1);
 IF EOF THEN RETURN(NULL);
 IF ¬LENGTH(L) THEN CONTINUE;
 IF L=TAB THEN IF
  ¬(EQU(BLK,"RESTAB")∨L[2 FOR 1]="M") THEN
  BEGIN "TAB1" IF L[2 FOR 1] = '14 THEN BEGIN "TAB2"
  IF "0"≤L[∞ FOR 1]≤"9" THEN BEGIN "TAB3"
   I←LENGTH(L)-1;
   WHILE "0"≤L[I FOR 1]≤"9" DO I←I-1;
   IF L[I FOR 1]≠"-" ∨ CVD(L[I+1 TO ∞])≠1 THEN CONTINUE;
   I←I-1;
   J←I;
   WHILE "0"≤L[J FOR 1]≤"9" DO J←J-1;
   PAG←L[J+1 TO I];
   DO BEGIN J←J-1; K←L[J FOR 1] END UNTIL K≠" "∧K≠TAB;
   I←J;
   DO BEGIN I←I-1; K←L[I FOR 1] END UNTIL K=" "∨K=TAB;
   FIL←L[I+1 TO J];
   LINOUT("#"&FIL&" "&PAG)
 END "TAB3"
END "TAB2";
CONTINUE
END "TAB1";

 CREF←GETWRD(L); 
 IF ¬("0"≤CREF≤"9") THEN BEGIN
   OUTSTR("EXTRA GARBAGE -- "&L&13&10); CREF←GETWRD(L) END;
 D("CREFNO="&CREF,0);
 DO BEGIN TEMP←GETWRD(L);D("TEMP="&TEMP,0); IF L="'" THEN I←LOP(L) END 
	UNTIL LENGTH(TEMP)=0 OR LENGTH(TEMP)=5;
 D("LINENO="&TEMP,0);
 IF LENGTH(TEMP)=0 THEN CONTINUE;
I←LOP(L);
 IF SUBEQU("BEGIN",L) THEN BEGIN
	PUSH(BLK);
	TEM1←L[6 TO ∞];
	TEM2←SCAN(TEM1,3,FLAG);
	OUTSTR("ENTERING "&TEM1&" FROM "&BLK&13&10);
	BLK←TEM1;
	LINOUT("!B"&BLK&" "&CREF);
 END;
 IF SUBEQU("BEND",L) THEN BEGIN
	TEM1←POP;
	LINOUT("!R"&BLK&" "&CREF);
	OUTSTR("LEAVING "&BLK&" TO "&TEM1&" WHERE LINE IS "&L&'15&'12);
	BLK←TEM1
 END;
 FOR TEM1←"DATA","ZERODATA","TABLEDATA","BITDATA",
  "BIT2DATA","BITDDATA","BITD2DATA","ACDATA","AC2DATA",
   "TABCONDATA","DSCR" DO IF SUBEQU(TEM1,L) THEN
	BEGIN DATA←TRUE;WHICH←TEM1; DONE END;
 IF DATA∧(SUBEQU("ENDDATA",L)∨(L="⊗"∧EQU(WHICH,"DSCR"))) THEN
	DATA←FALSE;
 RETURN(CREF&" "&TEMP&'11&L);
 PLCONT
END "GETLINE";

OPEN(DSKIN,"DSK",0,8,0,200,BRK,EOF);
OPEN(DSKOUT,"DSK",0,0,2,0,I,I);
ENTER(DSKOUT,"EXTRAC",FLAG); IF FLAG THEN FATAL;
STDBRK(14);
BREAKSET(15,NULL,"D");
LASTCREF←0;
PDP←-1; BLK←"MAIN.";

FOR FILE←
 "SAIL.CRF"
DO BEGIN "MAIN"

 OUTSTR(FILE&CRLF);

CLOSE(DSKIN); LOOKUP(DSKIN,FILE,FLAG); IF FLAG THEN FATAL;

DO BEGIN "READ1"
   LINE←GETLINE; IF DATA THEN LINOUT(LINE);
   IF DATA THEN DO BEGIN "READ2"
       LINOUT(GETLINE) 
   END "READ2" UNTIL ¬DATA
END "READ1" UNTIL EOF;

END "MAIN";

RELEASE(DSKIN); RELEASE(DSKOUT);

END "EXTRACT";