perm filename DATUM.SAI[PUB,TES]2 blob sn#150105 filedate 1975-03-11 generic text, type T, neo UTF8
BEGOF("DATUM")

IFC PASSONE THENC

COMMENT

DAN SWINEHART'S EXPANDABLE ARRAY PACKAGE

Declares
IDA ← [S]CREATE(LOWBND, HIGHBND) to create a (string or) integer array
MAKEBE(IDA,ALIAS) to give its descriptor to array ALIAS
IDA ← [S]WHATIS(ALIAS) to take it back
GOAWAY(IDA) to destroctulate it
IDA ← [S]BIGGER(IDA,XTRA) to add XTRA words to its length.

PLUS some of our own functions to PUSH records onto stacks and to PUT
records onto heaps (herein called TBLs).

;

ENDC

EXTERNAL INTEGER GOGTAB ;

PROCEDURES
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE DATUM! ;$"#
BEGIN "DATUM!"
WISTK←WHATIS(ISTK) ; WITBL←WHATIS(ITBL) ; WINEST←WHATIS(INEST) ;
WSSTK←SWHATIS(SSTK) ; WSTBL←SWHATIS(STBL) ; WSNEST←SWHATIS(SNEST) ;
WSYM←SWHATIS(SYM) ; WNUMBER←WHATIS(NUMBER) ; WOLDPAGE←WHATIS(OLDPAGE) ;
WNEWPAGE←WHATIS(NEWPAGE) ; WTHISFRAME←WHATIS(THISFRAME);
WMOLES←WHATIS(MOLES) ; WOWLS←WHATIS(OWLS) ; WNMOLES←WHATIS(NMOLES) ;
WNOWLS←WHATIS(NOWLS) ; WTHISAREA←WHATIS(THISAREA) ; WWAITBOX←WHATIS(WAITBOX) ;
WAVAILREC←WHATIS(AVAILREC) ; WAA←WHATIS(AA) ; WNAA←WHATIS(NAA) ;
WSHORT←WHATIS(SHORT) ; WNSHORT←WHATIS(NSHORT) ;
WMLEAD←WHATIS(MLEAD) ; WNMLEAD←WHATIS(NMLEAD) ; TES 11/2/74 ;
ITBLIDA ← RH(CREATE(0, ITSIZE)) ; ISTKIDA ← RH(CREATE(0, ISIZE)) ; INESTIDA ← RH(CREATE(0, SIZE)) ;
STBLIDA ← RH(SCREATE(0, STSIZE)) ; SSTKIDA ← RH(SCREATE(0, SSIZE)) ; SNESTIDA ← RH(SCREATE(0, SIZE)) ;
SYMIDA ← RH(SCREATE(-1, SYMNO)) ; NUMBIDA ← RH(CREATE(-1, SYMNO)) ;
MAKEBE(ITBLIDA, ITBL) ; MAKEBE(ISTKIDA, ISTK) ; MAKEBE(INESTIDA, INEST) ;
SMAKEBE(STBLIDA, STBL) ; SMAKEBE(SSTKIDA, SSTK) ; SMAKEBE(SNESTIDA, SNEST) ;
SMAKEBE(SYMIDA, SYM) ; MAKEBE(NUMBIDA, NUMBER) ;
LAST ← IHED ← SHED ← IHIGH ← SHIGH ← 0 ; comment Tops of Stacks;
OLDPGIDA←NEWPGIDA←FRAMEIDA←
	MOLESIDA←MLEADIDA←SHORTIDA←OWLSIDA←
	AREAIDA←WBOXIDA←STATUS←AREAIXM←0 ;
END "DATUM!" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE FINIDATUM ;$"#
BEGIN "FINIDATUM"
FOR J ← ITBLIDA, ISTKIDA, INESTIDA, NUMBIDA DO GOAWAY(J) ;
FOR J ← STBLIDA, SSTKIDA, SNESTIDA, SYMIDA DO GOAWAY(-1 LSH 18 + J) ;
FOR J ← 1 THRU 35 DO IF FNTFIL[J] NEQ 0 THEN GOAWAY(FNTFIL[J]) ;

MAKEBE(WCW,CW);
MAKEBE(WISTK, ISTK) ; MAKEBE(WITBL, ITBL) ; MAKEBE(WINEST, INEST) ;
SMAKEBE(WSSTK, SSTK) ; SMAKEBE(WSTBL, STBL) ; SMAKEBE(WSNEST, SNEST) ;
SMAKEBE(WSYM, SYM) ; MAKEBE(WNUMBER, NUMBER) ; MAKEBE(WOLDPAGE, OLDPAGE) ;
MAKEBE(WNEWPAGE, NEWPAGE) ; MAKEBE(WTHISFRAME,THISFRAME);
MAKEBE(WMOLES, MOLES) ; MAKEBE(WOWLS, OWLS) ; MAKEBE(WNMOLES, NMOLES) ;
MAKEBE(WSHORT, SHORT) ; MAKEBE(WNSHORT, NSHORT) ;
MAKEBE(WMLEAD, MLEAD) ; MAKEBE(WNMLEAD, NMLEAD) ; TES 11/2/74 ;
MAKEBE(WNOWLS, NOWLS) ; MAKEBE(WTHISAREA, THISAREA) ; MAKEBE(WWAITBOX, WAITBOX) ;
MAKEBE(WAVAILREC, AVAILREC) ; MAKEBE(WAA, AA) ; MAKEBE(WNAA, NAA) ;
END "FINIDATUM" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGER(INTEGER PTR,HM) ;$"#
BEGIN "BIGGER"
    INTEGER PT,L,U,OLDXIDA,NEWXIDA;
    INTEGER ARRAY OLDX,NEWX[0:ONE];
    OLDXIDA←WHATIS(OLDX);
    NEWXIDA←WHATIS(NEWX);
    MAKEBE(PTR,OLDX);
    L←ARRINFO(OLDX,1);
    U←ARRINFO(OLDX,2);
    PT←LRMAK(L,U+HM,1);
    MAKEBE(PT,NEWX);
    ARRTRAN(NEWX,OLDX);
    MAKEBE(OLDXIDA,OLDX);
    MAKEBE(NEWXIDA,NEWX);
    GOAWAY(PTR);
    RETURN(PT);
END "BIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE BIGGR2(INTEGER PTR,HM) ;$"#
BEGIN "BIGGR2"
    INTEGER PT,L,U,OLDXIDA,NEWXIDA;
    INTEGER ARRAY OLDX,NEWX[1:ONE,0:ONE];
    OLDXIDA←WHATIS(OLDX);
    NEWXIDA←WHATIS(NEWX);
    MAKEBE(PTR,OLDX);
    L←ARRINFO(OLDX,1);
    U←ARRINFO(OLDX,2);
    PT ← CREATE2(L,U, ARRINFO(OLDX,3), HM+ARRINFO(OLDX,4)) ;
    MAKEBE(PT,NEWX);
    ARRTRAN(NEWX,OLDX);
    MAKEBE(OLDXIDA,OLDX);
    MAKEBE(NEWXIDA,NEWX);
    GOAWAY(PTR);
    RETURN(PT);
END "BIGGR2";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE CREATE2(INTEGER LB1, UB1, LB2, UB2) ;$"#
	BEGIN "CREATE2"
	SIMPLE EXTERNAL INTEGER PROCEDURE LRMAK(INTEGER LB1,UB1,LB2,UB2,D) ;
	START!CODE MOVE '15, GOGTAB END ; COMMENT LRCOP BUG ;
	RETURN(LRMAK(LB1, UB1, LB2, UB2, 2)) ;
	END "CREATE2" ;
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC SIMPLE PROCEDURE GOAWAY(INTEGER I) ;$"#
BEGIN COMMENT Be SURE Left Half is -1 for String Arrays! ;
START!CODE MOVE '15, GOGTAB END ;
IF LH(I) THEN
START!CODE "SARID"
HRRZ 1, I ; MOVE 1, 0(1) ; COMMENT [PREV,,NEXT] ;
HLRZ 2, 1 ; HRRM 1, 0(2) ; COMMENT PREV ← [...,,NEXT] ;
HRRZ 2, 1 ; SKIPE 2 ; HLLM 1, 0(2) ; COMMENT NEXT←[PREV,,...] ;
END "SARID" ;
ARYEL(I) ;
END "GOAWAY" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE GROW(REFERENCE INTEGER ARRAY ARR; REFERENCE INTEGER IDA,WDS;
	INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "GROW"
IDA ← RH(BIGGER(WHATIS(ARR),EXTRA));  WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries.  Utterly unmanageable.  Goodbye!") ;
END "GROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHI(INTEGER WDS, TYP) ;$"#
	BEGIN "PUSHI"
	INTEGER QI ;
	IF (IHED ← IHED + WDS+1) > ISIZE THEN
		BEGIN
		GROW(ISTK, ISTKIDA, ISIZE, 1000, NULL) ;
		MAKEBE(ISTKIDA,ISTK)
		END ;
	ISTK[IHED] ← TYP ROT -9 LOR (IHED-WDS-1) ;
	ZEROWORDS(WDS, ISTK[IHED-WDS]) ; RETURN(IHED) ;
	END "PUSHI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUSHS(INTEGER WDS; STRING FIRST) ;$"#
	BEGIN"PUSHS"
	INTEGER QI ;
	IF (SHED ← SHED + WDS) > SSIZE THEN
		BEGIN
		SGROW(SSTK, SSTKIDA, SSIZE, 200, NULL) ;
		SMAKEBE(SSTKIDA,SSTK) ; ZEROSTRINGS(200, SSTK[SSIZE-199]) ;
		END ;
	SSTK[SHED] ← FIRST ;
	FOR QI←WDS-1 DOWN 1 DO SSTK[SHED-QI]←NULL ; RETURN(SHED) ;
	END "PUSHS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTI(INTEGER WDS, FIRST) ;$"#
	BEGIN"PUTI"
	INTEGER QI ;
	IF (IHIGH ← IHIGH + WDS) > ITSIZE THEN
		BEGIN
		GROW(ITBL, ITBLIDA, ITSIZE, 300, NULL) ;
		MAKEBE(ITBLIDA,ITBL) ;
		END ;
	ITBL[IHIGH] ← FIRST ;
	ZEROWORDS(WDS-1, ITBL[IHIGH-WDS+1]) ; RETURN(IHIGH) ;
	END "PUTI" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE PUTS(STRING VAL) ;$"#
	BEGIN"PUTS"
	INTEGER QI ;
	IF (SHIGH ← SHIGH + 1) > STSIZE THEN
		BEGIN
		SGROW(STBL, STBLIDA, STSIZE, 200, NULL) ;
		SMAKEBE(STBLIDA,STBL) ; ZEROSTRINGS(200, STBL[STSIZE-199]) ;
		END ;
	 STBL[SHIGH] ← VAL ;
	RETURN(SHIGH) ;
	END "PUTS" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER PROCEDURE SBIGGER(INTEGER PTR,HM) ;$"#
BEGIN "SBIGGER"
    EXTERNAL INTEGER PROCEDURE ARRINFO(STRING ARRAY S; INTEGER I);
    EXTERNAL PROCEDURE ARRTRAN(STRING ARRAY S1,S2);
    INTEGER PT,L,U,SOLDIDA,SNEWIDA;
    STRING ARRAY SOLD,SNEW[0:ONE];
    SOLDIDA←SWHATIS(SOLD);
    SNEWIDA←SWHATIS(SNEW);
    SMAKEBE(PTR,SOLD);
    L←ARRINFO(SOLD,1);
    U←ARRINFO(SOLD,2);
    PT←LRMAK(L,U+HM,-1 LSH 18 + 1);
    SMAKEBE(PT,SNEW);
    ARRTRAN(SNEW,SOLD);
    MAKEBE(SOLDIDA,SOLD);
    MAKEBE(SNEWIDA,SNEW);
    GOAWAY(PTR);
    RETURN(PT);
END "SBIGGER";
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SCREATE(INTEGER LB1, UB1) ;$"#
BEGIN "SCREATE"
INTEGER IDA ;
START!CODE MOVE '15, GOGTAB END ;
IDA ← LRMAK(LB1, UB1, -1 LSH 18 + 1) ;
RETURN(IDA) ;
END "SCREATE" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE SGROW(REFERENCE STRING ARRAY ARR; REFERENCE INTEGER IDA,WDS ;
	INTEGER EXTRA; STRING WHY) ;$"#
BEGIN "SGROW"
IDA ← RH(SBIGGER(SWHATIS(ARR),EXTRA));  WDS ← WDS + EXTRA ;
IF WDS GEQ TWO(14) THEN WARN(NULL,"Table grown to 2↑14 entries.  Utterly unmanageable.  Goodbye!") ;
END "SGROW" ;
ENDC
IFK PASSONE THENK
PUBLIC INTEGER SIMPLE PROCEDURE SWHATIS(STRING ARRAY A) ;$"#
START!CODE "SWHATIS"
 MOVE 1,A;
END "SWHATIS";
ENDC
IFK PASSONE OR PASSTWO THENK
PUBLIC INTEGER SIMPLE PROCEDURE WHATIS(INTEGER ARRAY A) ;$"#
START!CODE "WHATIS"
 MOVE 1,A;
END "WHATIS";
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROSTRINGS(INTEGER STRS; REFERENCE STRING LOCN) ;$"#
BEGIN
START!CODE "ZOS"
LABEL DUN ;
SKIPG 1, STRS ;
JRST DUN ; COMMENT NO STRS TO ZERO -- QUIT ;
ADD 1, 1 ; COMMENT TWO WORDS PER STRING ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SUBI 2, 1 ; COMMENT POINT TO COUNT WORD FIRST ;
SETZM 0(2) ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROSTRINGS" ;
ENDC
IFK PASSONE THENK
PUBLIC SIMPLE PROCEDURE ZEROWORDS(INTEGER WDS; REFERENCE INTEGER LOCN) ;$"#
BEGIN "ZEROWORDS"
START!CODE "ZOT"
LABEL DUN ;
SKIPG 1, WDS ;
JRST DUN ; COMMENT NO WDS TO ZERO -- QUIT ;
HRRZ 2, -1('17) ; COMMENT LOCN ;
SETZM 0(2) ;
CAIN 1, 1 ;
JRST DUN ; COMMENT ONLY 1 -- DON'T BLT ! ;
ADDI 1, -1(2) ;
HRL 2, 2 ;
ADDI 2, 1 ;
BLT 2, (1) ;
DUN:
END ;
END "ZEROWORDS" ;
ENDC
IFK PASSONE THENK

FINISHED

ENDOF("DATUM")

ENDC