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