perm filename XREF.SAI[S,AIL] blob
sn#029644 filedate 1973-03-19 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 BEGIN "XREF"
00005 00003 Comment Generalized sort routine.
00007 00004 SIMPLE BOOLEAN PROCEDURE STRINGLESS(STRING A,B)
00008 00005 FIRST COMPUTE OPTIMAL NUMBER OF PASSES
00009 00006 FOR NUM←1 STEP 1 UNTIL NUMS DO
00010 00007 FOR NUMS←1 STEP 1 UNTIL PASSES DO
00013 00008 SIMPLE INTEGER PROCEDURE LOOKUP(STRING ABOOLEAN INSERT)
00016 00009 DEFINE PGMRK= "'201004020101",WUN="'1000000",EXECBIT="'400000000000",
00022 ENDMK
⊗;
BEGIN "XREF"
DEFINE GOODSWT = "NULL";
DEFINE SWTSIZ = "1";
DEFINE PROCESSOR = """XREF""";
DEFINE SRCEXT = "NULL";
DEFINE RELEXT = """XRF""";
DEFINE LSTEXT = """LST""";
DEFINE RELMODE = "0";
DEFINE SRCMODE = "0";
DEFINE LSTMODE = "0";
REQUIRE "SCNCMD[1,DCS]" SOURCE_FILE;
REQUIRE 4500 STRING_SPACE;
DEFINE ⊂ = " BEGIN ", ⊃ = " END ",! = " COMMENT ";
DEFINE OTPT="2",SLOUGH="1",IDSCAN="2",CMNT="3",EXSCAN= "4",
CHKEOF= "IF SRCEOF THEN GO TO PASS2",LBLBIT= "'400000",
L_HALF(X)= "((X LSH (-18))LAND '377777)", R_HALF(X)= "(X LAND '377777)";
DEFINE TAB="'11",FORM="'14",BITS2="'400000400000";
INTEGER WASTHERE,CURLIN,L_PTR,K,NN,KK,L,SYMBOL,I,CURPAGE,EXECHK,III,
NP,KP,L_SIZE;
STRING FOO,NEWNAM,LETS,DIGS;
! FOLLOWING ASKED USER HOW MUCH LIST SPACE, NOW WE WILL ASSUME 10000;
! OUTSTR("HOW MUCH LIST SPACE?");
! FOO← INCHWL;
! L_SIZE← INTSCAN(FOO,NN);
DEFINE TABLSIZE="4096"; ! SHOULD BE POWER OF 2 FOR SORT;
DEFINE PRIME = "4091"; ! LARGEST PRIME < TABLSIZE, USED IN HASH;
SAFE INTEGER ARRAY NEXT[0:TABLSIZE-1];
SAFE STRING ARRAY SYM[0:TABLSIZE-1];
SAFE INTEGER ARRAY LTAB[0:TABLSIZE-1];
L_SIZE ← 10000;
BEGIN INTEGER ARRAY L_SPACE[2:L_SIZE+1];
LABEL L1,PASS2,L2,L3;
SIMPLE INTEGER PROCEDURE NODE(INTEGER A,B);
⊂ L_PTR← L_PTR+2;
IF L_PTR > L_SIZE THEN USERERR(0,0,"L_SPACE FULL");
L_SPACE[L_PTR]← A LOR CURPAGE;
L_SPACE[L_PTR+1]← B;
RETURN(L_PTR)
END;
Comment Generalized sort routine.
The input and output arrays must be (the same)
power of two in length, starting at 0 or 0,0. For
efficiency you may remove the arrays from the
calling sequence and replace references to INS
and OUTS by your own global variable names;
PROCEDURE SORT( STRING ARRAY INS; INTEGER ARRAY INDATA;
INTEGER SIZE);
BEGIN "SORT"
INTEGER BASE,GROUP,NUMS,NUM,I,J,K,L,PASSES;
STRING ARRAY OUTS[0:SIZE-1];
INTEGER ARRAY OUTDATA[0:SIZE-1];
STRING S1,S2;
Comment the first phase sorts groups of SIZE/(2↑PASSES)
strings into alphameric order. Subsequent phases will then
merge these groups, forming larger groups. An odd number
of passes will result in the input array containing the final
result;
SIMPLE BOOLEAN PROCEDURE STRINGLESS(STRING A,B);
BEGIN
INTEGER CHA,CHB,I;
IF LENGTH(B)=0 THEN RETURN(TRUE);
IF LENGTH(A)=0 THEN RETURN(FALSE);
FOR I←1 STEP 1 UNTIL (LENGTH(A) MIN LENGTH(B)) DO
BEGIN
CHA←A[I FOR 1]; CHB←B[I FOR 1];
IF CHA<CHB THEN RETURN(TRUE);
IF CHA>CHB THEN RETURN(FALSE);
END;
RETURN(IF LENGTH(A)≤LENGTH(B) THEN TRUE ELSE FALSE)
END;
COMMENT FIRST COMPUTE OPTIMAL NUMBER OF PASSES;
J←SIZE;
FOR PASSES←-2 STEP 1 UNTIL 1000 DO
BEGIN
J←J LSH -1;
IF J=0 THEN DONE
END;
IF PASSES<1 THEN PASSES←1;
NUMS←2↑PASSES ; COMMENT NUMBER OF GROUPS;
GROUP←SIZE%NUMS ; COMMENT SIZE OF EACH GROUP;
BASE←0;
FOR NUM←1 STEP 1 UNTIL NUMS DO
BEGIN "SORT PHASE"
INTEGER FLAG,I,J,K; LABEL BACK; STRING A;
I←BASE+GROUP-1;
K←0;
BACK:
FLAG←FALSE;
K←K+1;
FOR J←BASE STEP 1 UNTIL I-K DO
IF ¬STRINGLESS(S1←INS[J],S2←INS[J+1]) THEN
BEGIN
INS[J]←S2;
INS[J+1]←S1;
INDATA[J] ↔ INDATA[J+1];
FLAG←TRUE
END;
IF FLAG THEN GO TO BACK;
BASE←I+1
END "SORT PHASE";
FOR NUMS←1 STEP 1 UNTIL PASSES DO
BEGIN "MERGE PHASE"
INTEGER LIM;
LIM←SIZE%(2*GROUP);
FOR NUM←1 STEP 1 UNTIL LIM DO
BEGIN
I←2*(NUM-1)*GROUP;
J←(2*NUM-1)*GROUP;
K←2*NUM*GROUP;
L←J;
IF NUMS MOD 2 = 1 THEN
FOR BASE←I STEP 1 UNTIL K-1 DO
BEGIN
IF I<L THEN S1←INS[I] ELSE S1←NULL;
IF J<K THEN S2←INS[J] ELSE S2←NULL;
IF J=K ∨ I≠L ∧ STRINGLESS(S1,S2) THEN
BEGIN
OUTS[BASE]←S1;
OUTDATA[BASE]←INDATA[I];
I←I+1
END ELSE
BEGIN
OUTS[BASE]←S2;
OUTDATA[BASE]←INDATA[J];
J←J+1
END
END
ELSE
FOR BASE←I STEP 1 UNTIL K-1 DO
BEGIN
IF I<L THEN S1←OUTS[I] ELSE S1←NULL;
IF J<K THEN S2←OUTS[J] ELSE S2←NULL;
IF J=K ∨ I≠L ∧ STRINGLESS(S1,S2) THEN
BEGIN
INS[BASE]←S1;
INDATA[BASE]←OUTDATA[I];
I←I+1
END ELSE
BEGIN
INS[BASE]←S2;
INDATA[BASE]←OUTDATA[J];
J←J+1
END
END;
IF J≠K OR I≠L THEN BEGIN INTEGER X; X←CALL(0,"EXIT")END;
END;
GROUP←GROUP*2
END "MERGE PHASE";
IF PASSES MOD 2 = 1 THEN
FOR I←0 STEP 1 UNTIL SIZE-1 DO
BEGIN
INDATA[I]←OUTDATA[I];
INS[I]←OUTS[I]
END
END "SORT";
SIMPLE INTEGER PROCEDURE LOOKUP(STRING A;BOOLEAN INSERT);
BEGIN "LOOKUP"
INTEGER Q,R; INTEGER MAX;
SYMBOL← R←((CVASC(A) LSH -12 ) MOD PRIME);
IF (Q←NEXT[SYMBOL])< 0 THEN
⊂ "SOMETHING HAS HASHED HERE"
WHILE TRUE DO
BEGIN "OUTER"
WHILE ¬EQU(SYM[SYMBOL],A) DO
⊂ SYMBOL ← (ABS NEXT[SYMBOL])-1;
IF SYMBOL=R THEN DONE "OUTER";
⊃;
RETURN(-1);
END "OUTER";
IF ¬INSERT THEN RETURN(0);
WHILE MAX < TABLSIZE DO
IF LENGTH(SYM[MAX])= 0 THEN
⊂ SYMBOL ← MAX; NEXT[SYMBOL]← -NEXT[R];
SYM[SYMBOL]←A;
NEXT [R] ← -(SYMBOL+1); RETURN (0) ⊃
ELSE MAX ← MAX +1;
USERERR(0,0,"TABLE FULL"); ⊃;
IF ¬INSERT THEN RETURN(0);
IF Q > 0 THEN
⊂ "SOME CONFLICT CHAIN IS USING THIS SPOT"
"FIND AN EMPTY SLOT FOR THAT ELEMENT"
WHILE MAX < TABLSIZE DO
IF LENGTH(SYM[MAX]) THEN MAX←MAX+1 ELSE DONE;
IF MAX = TABLSIZE THEN USERERR(0,0,"TABLE FULL");
SYM[MAX]←SYM[SYMBOL];
NEXT[MAX]← NEXT[SYMBOL];
LTAB[MAX]←LTAB[SYMBOL];
LTAB[SYMBOL]←0;
WHILE (Q←(ABS NEXT[R]) - 1) ≠ SYMBOL DO
R ← Q;
NEXT [R] ← IF NEXT[R]>0 THEN MAX+1 ELSE -MAX-1;
⊃;
NEXT [SYMBOL] ← -SYMBOL-1;
SYM[SYMBOL]←A;
RETURN(0);
END "LOOKUP";
DEFINE PGMRK= "'201004020101",WUN="'1000000",EXECBIT="'400000000000",
CHKPAG= "IF CURLIN=PGMRK THEN CURPAGE← CURPAGE+WUN",
CHKLIN= "IF SRCBRK<0 THEN ⊂ EXECHK← 0; CURLIN← -SRCBRK;
CHKPAG; GO TO L1 ⊃";
L_PTR← 0;
CURPAGE← WUN;
WANTBIN← 1;
LETS← "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" &
"abcdefghijklmnopqrstuvwxyz";
DIGS← "0123456789";
SETBREAK(SLOUGH,LETS&"@",NULL,"IRE");
SETBREAK(IDSCAN,LETS&DIGS&"@",NULL,"XSN");
SETBREAK(CMNT,";",NULL,"ISE");
SETBREAK(EXSCAN,LETS&DIGS&"@¬#↑",NULL,"IRE");
COMMAND_SCAN;
! SPECIAL SCAN IF LOOKING FOR EXECS;
L1: IF EXECHK=0 THEN GO TO L3;
L2: FOO← INPUT(SRC,EXSCAN); CHKEOF;
CHKLIN;
IF SRCBRK= "@" THEN ⊂ FOO← INPUT(SRC,IDSCAN); GO TO L2 ⊃;
IF (SRCBRK= "¬")∨(SRCBRK="#")∨(SRCBRK="↑")
THEN ⊂ EXECHK← 0; GO TO L3 ⊃;
! SKIP TO NEXT ID;
L3: FOO← INPUT(SRC,SLOUGH);CHKEOF;
CHKLIN;
! PICK UP ID;
NEWNAM← INPUT(SRC,IDSCAN);CHKEOF;
! CHECK FOR RESERVED WORD;
IF EQU(NEWNAM,"EXEC") THEN ⊂ EXECHK← EXECBIT; GO TO L1 ⊃;
IF EQU(NEWNAM,"SCAN") THEN ⊂ EXECHK← 0; GO TO L1 ⊃;
IF EQU(NEWNAM,"SG")
∨(LENGTH(NEWNAM)=3 ∧ EQU(NEWNAM[1 FOR 2],"SG") ∧
"0"≤ NEWNAM[3 FOR 1] ≤ "9")
THEN GO TO L1;
IF EQU(NEWNAM,"MUMBLE") THEN ⊂ LABEL LL; LL: FOO←INPUT(SRC,CMNT);
CHKEOF; IF SRCBRK<0 THEN ⊂ CURLIN← -SRCBRK; EXECHK← 0; CHKPAG;GO TO LL ⊃ ELSE
GO TO L1 ⊃ ;
! LOOK UP ID;
WASTHERE← LOOKUP(NEWNAM,TRUE);
IF WASTHERE=0 THEN ⊂ LTAB[SYMBOL]←0 ⊃;
! PUT IN LIST OF OCCURANCES;
IF LTAB[SYMBOL]=0 THEN ⊂ NN← NODE(0,CURLIN);
LTAB[SYMBOL]← NN LOR (NN LSH 18) LOR (IF
SRCBRK=":" THEN LBLBIT ELSE 0) LOR EXECHK;
GO TO L1 ⊃ ;
! SEE IF THIS IS THE DEFINING INSTANCE OF A LABEL;
IF SRCBRK=":" THEN
⊂ ! PUT AT HEAD OF THE LIST;
NN← NODE(L_HALF("LTAB[SYMBOL]"),CURLIN);
LTAB[SYMBOL]← R_HALF("LTAB[SYMBOL]") LOR (NN LSH 18) LOR LBLBIT ;
GO TO L1 ⊃ ;
! PUT AT THE END OF THE LIST;
KK← R_HALF("LTAB[SYMBOL]");
! SEE IF IT IS ALREADY THERE;
IF (L_SPACE[KK+1]=CURLIN) ∧ ((L_SPACE[KK] LAND '377777000000)=
CURPAGE) THEN GO TO L1;
NN← NODE(0,CURLIN);
L_SPACE[KK]← L_SPACE[KK] LOR NN;
LTAB[SYMBOL]← (LTAB[SYMBOL] LAND '777777400000) LOR NN LOR EXECHK;
GO TO L1;
PASS2:
! NOW SORT THE SYMBOL TABLE;
SORT(SYM,LTAB,TABLSIZE);
! PRODUCE THE LISTING;
FOR III←0,1,2 DO ⊂
OUT(OTPT,FORM);
K←0;
WHILE ¬EQU(SYM[K],NULL) DO
⊂ LABEL NOTNOW;
CASE III OF
⊂ IF LTAB[K] LAND BITS2 THEN GO TO NOTNOW;
IF (LTAB[K] LAND LBLBIT)=0 THEN GO TO NOTNOW;
IF (LTAB[K] LAND EXECBIT)=0 THEN GO TO NOTNOW ⊃;
OUT(OTPT,CRLF&SYM[K]&(IF LENGTH(SYM[K])<8
THEN TAB ELSE NULL));
L← L_HALF("LTAB[K]");
NP←1;
NN←0;
WHILE L≠0 DO
⊂ IF NN>10 THEN ⊂ OUT(OTPT,CRLF&TAB&TAB); NN←0 ⊃;
KP← L_HALF("L_SPACE[L]");
IF KP≠NP THEN ⊂ OUT(OTPT,TAB&"/"&CVS(KP));
NP← KP; NN← NN+1 ⊃;
IF NN>10 THEN ⊂ OUT(OTPT,CRLF&TAB&TAB); NN←0 ⊃;
OUT(OTPT,TAB&CVSTR(L_SPACE[L+1]));
L← R_HALF("L_SPACE[L]"); NN← NN+1 ⊃;
NOTNOW: K← K+1 ⊃ ⊃;
RELEASE(OTPT);
END
END "XREF";