perm filename XREF.SAI[NEW,AIL] blob sn#408333 filedate 1979-01-08 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" 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";