listpack
1 || LIST PROCESSING PACKAGE (FOR 2960/EMAS) DAT 23/11/79 2 || WARNING - MUCH OF THIS CODE IS MACHINE DEPENDENT 3 GET "LIBHDR" 4 GET "KRC_LISTHDR" 5 6 ||---------------------------------------------------------------------- 7 ||The KRC system is Copyright (c) D. A. Turner 1981 8 ||All rights reserved. It is distributed as free software under the 9 ||terms in the file "COPYING", which is included in the distribution. 10 ||---------------------------------------------------------------------- 11 12 STATIC $( SPACE=20000 ||SPACE IS THE NUMBER OF LIST CELLS IN EACH 13 ||SEMI-SPACE. ON 2960/EMAS MUST BE <=128K 14 $) 15 MANIFEST $( ATOMSPACE=8000 ||NUMBER OF WORDS AVAILABLE TO STORE ATOMS 16 ATOMSIZE=255 ||MAX NO OF CHARS IN AN ATOM 17 FULLWORD=NIL+1 ||THE TOP 2 BITS ARE NOT USED IN BCPL 18 GONETO=NIL+2 ||ADDRESSES ON THIS SYSTEM. THE VALUE OF NIL 19 ||IS THE 2ND LEFTMOST BIT ON ITS OWN - VALUES 20 ||FROM HERE UP AN SAFELY BE USED AS FLAGS ETC 21 BIGSPACE=100000 22 LINK=0;OFFSET=2 23 $) 24 25 STATIC $( CONSBASE=?; CONSLIMIT=?; CONSP=?; OTHERBASE=?; STACKBASE=? 26 BUFFER=?; BUFP=0; HASHV=?; ATOMBASE=?; ATOMP=?; ATOMLIMIT=? 27 NOGCS=0; RECLAIMS=0 28 $) 29 30 LET START() 31 BE $( IF HAVEPARAM('B') 32 DO $( SPACE:=BIGSPACE ||PARAMETER "B" FOR "BIG" 33 WRITEF("(%N cells)*N",SPACE) $) 34 APTOVEC(START1,2*SPACE-1) 35 $) 36 || TAKING ADVANTAGE OF THE FACT THAT WE HAVE VIRTUAL MEMORY, WE SET UP 37 || TWO COPIES OF LIST SPACE IN ORDER TO BE ABLE TO DO GARBAGE COLLECTION 38 || BY DOING A GRAPH COPY FROM ONE SPACE TO THE OTHER 39 40 AND START1(V,N) 41 BE $( CONSBASE,CONSP,CONSLIMIT:= V,V,V+N+1 42 APTOVEC(START2,2*SPACE-1) $) 43 44 AND START2(V,N) 45 BE $( LET V1=VEC ATOMSIZE 46 LET V2=VEC 127 || WE HAVE 128-WAY HASHING OF ATOMS 47 OTHERBASE,BUFFER,HASHV:= V,V1,V2 48 FOR I= 0 TO 127 DO HASHV!I:= 0 49 APTOVEC(START3,ATOMSPACE-1) $) 50 51 AND START3(V,N) 52 BE $( ATOMBASE,ATOMP,ATOMLIMIT:= V,V+1,V+N+1 53 STACKBASE:= 1+@N 54 ATGC:= FALSE 55 GO() $) ||"GO" IS THE USER'S START ROUTINE 56 57 AND HAVEPARAM(CH) = VALOF 58 $( FOR I = 1 TO GETBYTE(PARAM,0) 59 IF GETBYTE(PARAM,I)=CH RESULTIS TRUE 60 RESULTIS FALSE $) 61 62 AND CONS(X,Y)=VALOF 63 $( IF CONSP=CONSLIMIT 64 DO $( GC() 65 IF (CONSP-CONSBASE)/2 > (9*SPACE)/10 ||ABANDON JOB IF SPACE 66 DO SPACE.ERROR() ||UTILISATION EXCEEDS 90% 67 $) 68 HD!CONSP,TL!CONSP,CONSP:= X,Y,CONSP+2 69 RESULTIS CONSP-2 $) 70 71 AND GC() || GARBAGE COLLECTOR - DOES A GRAPH COPY INTO THE OTHER SEMI-SPACE 72 BE $( HOLD.INTERRUPTS() 73 NOGCS:= NOGCS+1 74 IF ATGC DO WRITES("<gc called>*N") 75 IF SPACE=BIGSPACE 76 DO $( EXTERNAL $( DSETIC $) 77 MANIFEST $( SECONDS=3600 $) 78 DSETIC(SECONDS*290) ||OVERRIDE EMAS TIME LIMIT 79 $) 80 CONSP:= OTHERBASE 81 BASES(COPY) || USER'S STATIC VARIABLES ETC. 82 FOR I= 0 TO 127 83 DO $( LET P = HASHV!I || VAL FIELDS OF ATOMS 84 UNTIL P=0 85 DO $( COPY(@P!VAL) 86 P:= P!LINK $) 87 $) 88 FOR P= STACKBASE TO @P 89 DO IF(!P-CONSBASE)REM 2 = 0 DO COPY(P) || THE BCPL STACK 90 ||(ONLY EVEN ADDRESSES IN LISTSPACE COUNT) 91 92 COPYHEADS() 93 || NOW SWAP SEMI-SPACES 94 $( LET HOLD=CONSBASE 95 CONSBASE,CONSLIMIT,OTHERBASE:= OTHERBASE,OTHERBASE+2*SPACE,HOLD 96 $) 97 RECLAIMS:= RECLAIMS + (CONSLIMIT-CONSP)/2 98 IF ATGC DO WRITEF("<%N cells in use>*N",(CONSP-CONSBASE)/2) 99 RELEASE.INTERRUPTS() 100 $) 101 102 AND COPY(P) || P IS THE ADDRESS OF A LIST FIELD 103 BE 104 || DO $( WRITES("COPYING ") 105 || PRINTOB(!P) 106 || NEWLINE() $) <> 107 WHILE CONSBASE<=!P<CONSLIMIT 108 DO $( IF HD!(!P)=GONETO 109 DO $( !P:= TL!(!P) 110 RETURN $) 111 $( LET X,Y,Z = HD!(!P),TL!(!P),CONSP 112 HD!(!P):= GONETO 113 TL!(!P):= Z 114 !P:=Z 115 HD!Z,TL!Z:= X,Y 116 CONSP:= CONSP+2 117 IF X=FULLWORD DO RETURN 118 P:= @TL!Z $) $) 119 120 AND COPYHEADS() 121 BE $( LET Z = OTHERBASE 122 UNTIL Z = CONSP 123 DO $( COPY(@HD!Z) 124 Z:= Z+2 $) 125 $) 126 127 AND ISCONS(X)= CONSBASE<=X<CONSLIMIT-> HD!X\=FULLWORD,FALSE 128 129 AND ISATOM(X) = ATOMBASE<=X<ATOMP 130 131 AND ISNUM(X) = CONSBASE<=X<CONSLIMIT -> HD!X=FULLWORD,FALSE 132 133 AND STONUM(N) = CONS(FULLWORD,N) 134 135 AND GETNUM(X) = TL!X 136 137 AND MKATOM(S) = VALOF 138 $( LET BUCKET = @ HASHV!HASH(S) 139 LET P = BUCKET 140 LET N = S!0 >> 26 141 UNTIL !P=0 || SEARCH THE APPROPRIATE BUCKET 142 DO $( LET S1 = !P + OFFSET 143 LET I = 0 144 UNTIL I>N | S!I\=S1!I DO I:= I+1 145 IF I>N RESULTIS !P 146 P:= @(!P)!LINK $) 147 ||CREATE NEW ATOM 148 IF ATOMP+OFFSET+N >= ATOMLIMIT 149 DO $( WRITES("<string space exhausted>*N") 150 FINISH $) 151 !P,ATOMP!LINK,ATOMP!VAL:= ATOMP,0,NIL 152 ATOMP:= ATOMP+OFFSET 153 FOR I=0 TO N DO ATOMP!I:= S!I 154 ATOMP:= ATOMP+N+1 155 RESULTIS !P 156 $) 157 158 AND HASH(S)= VALOF || TAKES A STRING AND RETURNS A VALUE IN 0..127 159 $( LET H=S!0 160 LET W=H>>8 161 H:=H+W 162 W:=W>>8 163 H:=H+W 164 W:=(W>>8)*37 165 RESULTIS (H+W) $) 166 167 AND PRINTNAME(X) = X+OFFSET 168 169 AND BUFCH(CH) 170 BE $( BUFP:= BUFP+1 171 IF BUFP>ATOMSIZE 172 DO $( WRITES("Atom too big*N(Atom = *"") 173 FOR I=1 TO BUFP-1 DO WRCH(BUFFER!I) 174 WRITES("...*")*N") 175 BUFP:=0 176 SPACE.ERROR() $) 177 BUFFER!BUFP:= CH $) 178 179 AND PACKBUFFER() = VALOF 180 $( LET V= VEC ATOMSIZE 181 BUFFER!0,BUFP:= BUFP,0 182 PACKSTRING(BUFFER,V) 183 RESULTIS MKATOM(V) $) 184 185 AND ALFA.LS(A,B) = VALOF || A,B ARE ATOMS 186 $( A,B:= A+OFFSET,B+OFFSET 187 $( LET MASK = #X20202020 ||MASKS OUT ALL THE CASE BITS 188 L: 189 $( LET A1,B1 = (A!0<<8)|MASK,(B!0<<8)|MASK 190 IF A1<B1 RESULTIS TRUE 191 IF A1>B1 RESULTIS FALSE 192 $( LET N1,N2 = A!0>>24,B!0>>24 193 LET N = N1<=N2 ->N1>>2, N2>>2 194 FOR I=1 TO N 195 DO $( IF (A!I|MASK)=(B!I|MASK) LOOP 196 RESULTIS (A!I|MASK) < (B!I|MASK) $) 197 IF N1=N2 & MASK DO $( MASK:=0 ; GOTO L $) 198 ||BILL MUDD WROTE THIS PIECE OF CODE - I HAD NOTHING TO DO WITH IT - DT 199 RESULTIS N1<N2 200 $) $) $) $) 201 202 AND GCSTATS() 203 BE WRITEF("Cells claimed = %N, no of gc's = %N", 204 RECLAIMS+(CONSP-CONSBASE)/2, NOGCS) 205 206 AND RESETGCSTATS() 207 BE NOGCS, RECLAIMS:= 0, -(CONSP-CONSBASE)/2 208 209 AND FORCE.GC() 210 BE $( RECLAIMS:=RECLAIMS-(CONSLIMIT-CONSP)/2 ||TO COMPENSATE FOR CALLING 211 ||TOO EARLY 212 IF ATGC DO WRITEF("Max cells available = %N*N",SPACE) 213 GC() 214 $) 215 216 AND LISTPM() 217 BE $( LET EMPTY = 0 218 WRITES("*N LIST POST MORTEM*N") 219 GCSTATS() 220 WRITEF(", current cells = %N*N",(CONSP-CONSBASE)/2) 221 IF BUFP>0 222 DO $( WRITES("Buffer: ") 223 FOR I= 1 TO BUFP DO WRCH(BUFFER!I) 224 NEWLINE() $) 225 WRITES("Atom buckets:*N") 226 FOR I = 0 TO 127 227 DO TEST HASHV!I \= 0 228 THEN $( LET P = HASHV!I 229 WRITEF("%N : ",I) 230 UNTIL P=0 231 DO $( WRITEF("%S ",P+OFFSET) 232 UNLESS P!VAL=NIL 233 DO $( WRITES(" = ") 234 PRINTOB(P!VAL) 235 WRITES("*N ") $) 236 P:= P!LINK $) 237 NEWLINE() $) 238 OR EMPTY:= EMPTY + 1 239 WRITEF("Empty buckets = %N*N",EMPTY) $) 240 241 AND LENGTH(X) = VALOF 242 $( LET N = 0 243 UNTIL X=NIL 244 DO X,N:= TL!X,N+1 245 RESULTIS N $) 246 247 AND MEMBER(X,A) = VALOF 248 $( UNTIL X=NIL | HD!X=A 249 DO X:= TL!X 250 RESULTIS X\=NIL $) 251 252 AND APPEND(X,Y) = SHUNT(SHUNT(X,NIL),Y) 253 254 AND REVERSE(X) = SHUNT(X,NIL) 255 256 AND SHUNT(X,Y) = VALOF 257 $( UNTIL X=NIL 258 DO $( Y:=CONS(HD!X,Y) 259 X:=TL!X $) 260 RESULTIS Y $) 261 262 AND SUB1(X,A) = ||DESTRUCTIVELY REMOVES A FROM X (IF PRESENT) 263 X=NIL -> NIL, 264 HD!X=A -> TL!X, VALOF 265 $( LET P = @TL!X 266 UNTIL !P=NIL | HD!(!P)=A DO P:= @TL!(!P) 267 UNLESS !P=NIL DO !P:= TL!(!P) 268 RESULTIS X $) 269 270 AND EQUAL(X,Y) = VALOF 271 $( IF X=Y RESULTIS TRUE 272 IF ISNUM(X) & ISNUM(Y) 273 RESULTIS GETNUM(X)=GETNUM(Y) 274 UNLESS ISCONS(X)&ISCONS(Y)&EQUAL(HD!X,HD!Y) 275 RESULTIS FALSE 276 X,Y := TL!X,TL!Y $) REPEAT 277 278 AND ELEM(X,N) = VALOF 279 $( UNTIL N=1 DO X,N:=TL!X,N-1 280 RESULTIS HD!X $) 281 282 AND PRINTOB(X) 283 BE TEST X=NIL THEN WRITES("NIL") OR 284 TEST ISATOM(X) THEN WRITEF("*"%S*"",PRINTNAME(X)) OR 285 TEST ISNUM(X) THEN WRITEN(GETNUM(X)) OR 286 TEST ISCONS(X) 287 THEN $( WRCH('(') 288 WHILE ISCONS(X) 289 DO $( PRINTOB(HD!X) 290 WRCH('.') 291 X:=TL!X $) 292 PRINTOB(X) 293 WRCH(')') $) 294 OR WRITEF("<%N>",X) 295