1 /* 2 * To change this template, choose Tools | Templates 3 * and open the template in the editor. 4 */ 5 package org.mathpiper.mpreduce; 6 7 import com.google.gwt.core.client.Scheduler.RepeatingCommand; 8 import java.io.IOException; 9 import org.mathpiper.mpreduce.io.streams.InputStream; 10 import java.math.BigInteger; 11 import java.util.EmptyStackException; 12 import java.util.HashMap; 13 import java.util.HashSet; 14 import java.util.Stack; 15 import org.mathpiper.mpreduce.datatypes.Cons; 16 import org.mathpiper.mpreduce.datatypes.LispEqualHash; 17 import org.mathpiper.mpreduce.datatypes.LispHash; 18 import org.mathpiper.mpreduce.datatypes.LispString; 19 import org.mathpiper.mpreduce.datatypes.LispVector; 20 import org.mathpiper.mpreduce.exceptions.EOFException; 21 import org.mathpiper.mpreduce.exceptions.ResourceException; 22 import org.mathpiper.mpreduce.functions.builtin.Fns; 23 import org.mathpiper.mpreduce.functions.functionwithenvironment.ByteOpt; 24 import org.mathpiper.mpreduce.functions.functionwithenvironment.Bytecode; 25 import org.mathpiper.mpreduce.functions.functionwithenvironment.FnWithEnv; 26 import org.mathpiper.mpreduce.functions.lisp.AutoLoad; 27 import org.mathpiper.mpreduce.functions.lisp.CallAs; 28 import org.mathpiper.mpreduce.functions.lisp.Interpreted; 29 import org.mathpiper.mpreduce.functions.lisp.LispFunction; 30 import org.mathpiper.mpreduce.functions.lisp.Macro; 31 import org.mathpiper.mpreduce.functions.lisp.Undefined; 32 import org.mathpiper.mpreduce.io.Fasl; 33 import org.mathpiper.mpreduce.io.streams.LispStream; 34 import org.mathpiper.mpreduce.numbers.LispFloat; 35 import org.mathpiper.mpreduce.numbers.LispInteger; 36 import org.mathpiper.mpreduce.special.SpecialFunction; 37 import org.mathpiper.mpreduce.symbols.Gensym; 38 import org.mathpiper.mpreduce.symbols.Symbol; 39 40 public class LispReader implements RepeatingCommand { 41 42 private static LispReader lispReader = null; 43 static int istacklimit; 44 static int[] istack; 45 public static int sharedIndex; 46 public static Stack stack; 47 static int sharedSize; 48 static LispObject[] shared; 49 // I choose my initial oblist size so that REDUCE can run without need 50 // for re-hashing at all often. The size must also be a prime, and 15013 51 // seems to fit the bill. 52 public static int oblistSize = 15013; 53 public static int oblistCount = 0; 54 public static Symbol[] oblist = new Symbol[oblistSize]; 55 public static LispVector obvector = new LispVector((LispObject[]) oblist); 56 public static Symbol[] chars = new Symbol[128]; // to speed up READCH 57 public static LispObject[] spine = new LispObject[17]; // for PRESERVE 58 static int inputType; 59 public static HashSet objects; 60 public static HashMap repeatedObjects; 61 static final int S_VECTOR = 0; // + number of items to come 62 static final int S_START = -1; 63 static final int S_CDR = -2; 64 static final int S_HASHKEY = -3; 65 static final int S_HASHVAL = -4; 66 static final int S_SYMVAL = -5; 67 static final int S_SYMPLIST = -6; 68 static final int S_SYMFN = -7; 69 static final int S_SYMSPECIAL = -8; 70 static final int S_AUTONAME = -9; 71 static final int S_AUTODATA = -10; 72 static final int S_INTERP_BODY = -11; 73 static final int S_MACRO_BODY = -12; 74 static final int S_CALLAS_BODY = -13; 75 static final int S_CADR = -100; // +0 to +15 offsets from this used 76 LispReader()77 private LispReader() { 78 super(); 79 } 80 getInstance()81 public static LispReader getInstance() { 82 if (lispReader == null) { 83 lispReader = new LispReader(); 84 } 85 86 return lispReader; 87 } 88 private int state = S_START; 89 private int sp = 0; 90 private LispObject w = null; 91 private boolean setLabel = false; 92 private int index; 93 readObjectReset()94 public void readObjectReset() { 95 state = S_START; 96 sp = 0; 97 w = null; 98 setLabel = false; 99 100 } 101 readObject()102 public LispObject readObject() throws IOException, ResourceException { 103 readObjectReset(); 104 105 while (readObjectIncrement() == true) { 106 } 107 return w; 108 } 109 readObjectIncrement()110 public boolean readObjectIncrement() throws IOException, ResourceException { 111 // Reloading an image uses an explicit stack to manage the recusion that 112 // it needs. It controls this stack using a finite-state control. The states 113 // are identified here as constants S_xxx. 114 115 116 117 for (;;) { 118 if (sp >= istacklimit - 2) // grow integer stack if needbe. 119 { 120 int[] newistack = new int[2 * istacklimit]; 121 for (index = 0; index < istacklimit; index++) { 122 newistack[index] = istack[index]; 123 } 124 istack = newistack; 125 istacklimit = 2 * istacklimit; 126 } 127 // At the start of the loop here I will read another object. I "continue" 128 // if the object can not be completed all at once, having adjusted my 129 // state and the stack suitably. 130 int opcode = Jlisp.idump.read(); 131 if (opcode == -1) { 132 throw new IOException("End of file"); 133 } 134 int operand = 0; 135 if (opcode < LispObject.X_BREAK1) { 136 operand = opcode & 0x3f; 137 opcode &= ~0x3f; 138 } else if (opcode < LispObject.X_BREAK2) { 139 operand = opcode & 0x0f; 140 opcode &= ~0x0f; 141 } else if (opcode < LispObject.X_BREAK3) { 142 // The first class of opcodes have a selector in their bottom two bits, 143 // and that indicates whether they are followed by 1, 2, 3 or 4 bytes 144 // of operand. 145 switch (opcode & 3) { 146 case 0: 147 operand = Jlisp.idump.read(); 148 break; 149 case 1: 150 operand = Jlisp.idump.read(); 151 operand = (operand << 8) | Jlisp.idump.read(); 152 break; 153 case 2: 154 operand = Jlisp.idump.read(); 155 operand = (operand << 8) | Jlisp.idump.read(); 156 operand = (operand << 8) | Jlisp.idump.read(); 157 break; 158 case 3: 159 operand = Jlisp.idump.read(); 160 operand = (operand << 8) | Jlisp.idump.read(); 161 operand = (operand << 8) | Jlisp.idump.read(); 162 operand = (operand << 8) | Jlisp.idump.read(); 163 break; 164 } 165 opcode &= ~3; 166 } 167 // Other cases do not have an (explicit) operand. 168 switch (opcode) { 169 case LispObject.X_REFn: 170 if (operand >= 48) { 171 operand = sharedIndex - (operand + 1 - 48); 172 } 173 case LispObject.X_REF: // refer to an item that has already been read 174 w = shared[operand]; 175 break; 176 case LispObject.X_REFBACK: 177 w = shared[sharedIndex - operand]; 178 break; 179 case LispObject.X_RECENT: 180 Fasl.recentn++; 181 w = Fasl.recent[Jlisp.idump.read()]; 182 if (setLabel) { 183 shared[sharedIndex++] = w; 184 setLabel = false; 185 } 186 break; 187 case LispObject.X_RECENT1: 188 Fasl.recentn++; 189 w = Fasl.recent[Jlisp.idump.read() + 256]; 190 if (setLabel) { 191 shared[sharedIndex++] = w; 192 setLabel = false; 193 } 194 break; 195 case LispObject.X_OBLIST: 196 w = obvector; 197 break; 198 case LispObject.X_INT: // a LispInteger 199 case LispObject.X_INTn: { 200 byte[] data = new byte[operand]; 201 for (index = 0; index < operand; index++) { 202 data[index] = (byte) Jlisp.idump.read(); 203 } 204 w = LispInteger.valueOf(new BigInteger(data)); 205 } 206 break; 207 case LispObject.X_FIXNUM: 208 // Slighly curious encoding of signed numbers so that the variable-length 209 // packing in the image file works well. 210 if ((operand & 1) == 0) { 211 operand = (operand >>> 1); 212 } else if (operand == 1) { 213 operand = 0x80000000; 214 } else { 215 operand = -(operand >>> 1); 216 } 217 w = LispInteger.valueOf(operand); 218 break; 219 case LispObject.X_STR: 220 case LispObject.X_STRn: { 221 byte[] data = new byte[operand]; 222 for (index = 0; index < operand; index++) { 223 data[index] = (byte) Jlisp.idump.read(); 224 } 225 w = new LispString(new String(data)); 226 LispString.stringCount++; 227 } 228 break; 229 case LispObject.X_GENSYM: 230 case LispObject.X_GENSYMn: { 231 byte[] data = new byte[operand]; 232 for (index = 0; index < operand; index++) { 233 data[index] = (byte) Jlisp.idump.read(); 234 } 235 int sequence = Jlisp.idump.read(); 236 sequence = sequence | (Jlisp.idump.read() << 8); 237 sequence = sequence | (Jlisp.idump.read() << 16); 238 sequence = sequence | (Jlisp.idump.read() << 24); 239 Gensym ws = new Gensym(new String(data)); 240 ws.myNumber = sequence; 241 if (sequence != -1) { 242 ws.pname = ws.nameBase + sequence; 243 } 244 Symbol.symbolCount++; 245 if (setLabel) { 246 shared[sharedIndex++] = ws; 247 setLabel = false; 248 } 249 if (!Jlisp.descendSymbols) { 250 ws.car/*value*/ = Jlisp.lit[Lit.undefined]; 251 ws.cdr/*plist*/ = Environment.nil; 252 if (ws.pname != null) { 253 ws.fn = new Undefined(ws.pname); 254 } else { 255 ws.fn = new Undefined(ws.nameBase); 256 } 257 ws.special = null; 258 w = ws; 259 break; 260 } 261 stack.push(ws); 262 istack[sp++] = state; 263 state = S_SYMFN; 264 continue; 265 } 266 case LispObject.X_SYM: 267 opcode = LispObject.X_SYMn; // drop through 268 case LispObject.X_SYMn: 269 case LispObject.X_UNDEF: 270 case LispObject.X_UNDEFn: { 271 byte[] data = new byte[operand]; 272 for (index = 0; index < operand; index++) { 273 data[index] = (byte) Jlisp.idump.read(); 274 } 275 if (Jlisp.descendSymbols) { 276 Symbol ws = new Symbol(); 277 Symbol.symbolCount++; 278 ws.pname = new String(data); 279 stack.push(ws); 280 istack[sp++] = state; 281 if (opcode == LispObject.X_SYMn) { 282 state = S_SYMFN; 283 } else { 284 ws.fn = new Undefined(ws.pname); 285 state = S_SYMSPECIAL; 286 } 287 if (setLabel) { 288 shared[sharedIndex++] = ws; 289 setLabel = false; 290 } 291 continue; 292 } else { 293 w = Symbol.intern(new String(data)); 294 Fasl.recent[Fasl.recentp++ & 0x1ff] = w; 295 break; 296 } 297 } 298 case LispObject.X_VEC: 299 w = new LispVector(operand); 300 if (setLabel) { 301 shared[sharedIndex++] = w; 302 setLabel = false; 303 } 304 if (operand == 0) { 305 break; // vector with 0 elements 306 } 307 stack.push(w); 308 istack[sp++] = state; 309 state = S_VECTOR + operand; 310 continue; 311 case LispObject.X_HASH: 312 w = new LispHash(new HashMap(), 0); 313 stack.push(w); 314 istack[sp++] = state; 315 state = S_HASHKEY; 316 if (setLabel) { 317 shared[sharedIndex++] = w; 318 setLabel = false; 319 } 320 continue; 321 case LispObject.X_HASH2: 322 w = new LispHash(new LispEqualHash(), 2); 323 stack.push(w); 324 istack[sp++] = state; 325 state = S_HASHKEY; 326 if (setLabel) { 327 shared[sharedIndex++] = w; 328 setLabel = false; 329 } 330 continue; 331 case LispObject.X_ENDHASH: 332 w = null; // marker for end of hash table entries 333 break; 334 case LispObject.X_UNDEF1: { 335 byte[] data = new byte[operand]; 336 for (index = 0; index < operand; index++) { 337 data[index] = (byte) Jlisp.idump.read(); 338 } 339 w = new Undefined(new String(data)); 340 } 341 break; 342 case LispObject.X_MACRO: { 343 Macro wm = new Macro(); 344 if (setLabel) { 345 shared[sharedIndex++] = wm; 346 setLabel = false; 347 } 348 stack.push(wm); 349 istack[sp++] = state; 350 state = S_MACRO_BODY; 351 } 352 continue; 353 case LispObject.X_AUTOLOAD: { 354 AutoLoad wa = new AutoLoad(null, null); 355 if (setLabel) { 356 shared[sharedIndex++] = wa; 357 setLabel = false; 358 } 359 stack.push(wa); 360 istack[sp++] = state; 361 state = S_AUTONAME; 362 continue; 363 } 364 case LispObject.X_INTERP: { 365 Interpreted wi = new Interpreted(); 366 if (setLabel) { 367 shared[sharedIndex++] = wi; 368 setLabel = false; 369 } 370 stack.push(wi); 371 istack[sp++] = state; 372 state = S_INTERP_BODY; 373 continue; 374 } 375 case LispObject.X_CALLAS: { 376 CallAs wi = new CallAs(Jlisp.idump.read()); 377 if (setLabel) { 378 shared[sharedIndex++] = wi; 379 setLabel = false; 380 } 381 stack.push(wi); 382 istack[sp++] = state; 383 state = S_CALLAS_BODY; 384 continue; 385 } 386 case LispObject.X_BPS: { 387 byte[] data; 388 int nargs = 0; 389 int n1 = Jlisp.idump.read(), n2 = 0, n3 = 0; 390 if ((n1 & 0x80) != 0) { 391 n1 &= 0x7f; 392 n2 = Jlisp.idump.read(); 393 if ((n2 & 0x80) != 0) { 394 n2 &= 0x7f; 395 n3 = Jlisp.idump.read(); 396 } 397 } 398 nargs = n1 + (n2 << 7) + (n3 << 14); 399 if (operand == 0) { 400 data = null; 401 } else { 402 data = new byte[operand]; 403 for (index = 0; index < operand; index++) { 404 data[index] = (byte) Jlisp.idump.read(); 405 } 406 } 407 FnWithEnv ws; 408 if (nargs > 0xff) { 409 ws = new ByteOpt(nargs); 410 } else { 411 ws = new Bytecode(); 412 ws.nargs = nargs; 413 } 414 ws.bytecodes = data; 415 // the X_BPS format is curious in that it should ALWAYS be followed 416 // by an X_VEC. So I look for that here. I think I should also note that 417 // I have a fragment of design here that is not fully worked through. 418 // My Bytecoded is a sub-class of FnWithEnv - a general class for functions 419 // that want a vector of LispObjects kept with them. But at present 420 // Bytecode is the only sub-class that exists and the only one that this 421 // rea-loading code can ever re-create. So I expect to have to do more 422 // work when or if I add more, for instance for code that has been reduced 423 // to real Jaba bytecodes rather than my Jlisp-specific ones. 424 opcode = Jlisp.idump.read(); 425 if (opcode < LispObject.X_VEC || opcode > LispObject.X_VEC + 3) { 426 throw new IOException("Corrupted image file"); 427 } 428 switch (opcode & 3) { 429 case 0: 430 operand = Jlisp.idump.read(); 431 break; 432 case 1: 433 operand = Jlisp.idump.read(); 434 operand = (operand << 8) | Jlisp.idump.read(); 435 break; 436 case 2: 437 operand = Jlisp.idump.read(); 438 operand = (operand << 8) | Jlisp.idump.read(); 439 operand = (operand << 8) | Jlisp.idump.read(); 440 break; 441 case 3: 442 operand = Jlisp.idump.read(); 443 operand = (operand << 8) | Jlisp.idump.read(); 444 operand = (operand << 8) | Jlisp.idump.read(); 445 operand = (operand << 8) | Jlisp.idump.read(); 446 break; 447 } 448 ws.env = new LispObject[operand]; 449 if (operand == 0) { 450 w = ws; 451 break; 452 } 453 stack.push(ws); 454 istack[sp++] = state; 455 state = S_VECTOR + operand; 456 continue; 457 } 458 case LispObject.X_LIST: 459 w = Environment.nil; 460 if (operand == 0) { 461 break; 462 } 463 for (index = 0; index < operand; index++) { 464 w = new Cons(Environment.nil, w); 465 } 466 //Cons.consCount += operand; 467 if (setLabel) { 468 shared[sharedIndex++] = w; 469 setLabel = false; 470 } 471 stack.push(w); 472 istack[sp++] = state; 473 state = S_CADR + operand; 474 continue; 475 case LispObject.X_LISTX: 476 w = new Cons(Environment.nil, Environment.nil); { 477 LispObject w1 = w; 478 for (index = 0; index < operand; index++) { 479 w = new Cons(Environment.nil, w); 480 } 481 //Cons.consCount += operand+1; 482 if (setLabel) { 483 shared[sharedIndex++] = w; 484 setLabel = false; 485 } 486 stack.push(w); 487 istack[sp++] = state; 488 state = S_CADR + operand + 1; 489 stack.push(w1); 490 // I will fill in the very tail and then drop back to 491 // the case used with X_LIST 492 istack[sp++] = state; 493 state = S_CDR; 494 continue; 495 } 496 case LispObject.X_NULL: 497 w = null; 498 break; 499 case LispObject.X_DOUBLE: { 500 long v = Jlisp.idump.read(); 501 for (index = 0; index < 7; index++) { 502 v = (v << 8) | Jlisp.idump.read(); 503 } 504 w = new LispFloat(Fns.longBitsToDouble(v)); 505 } 506 break; 507 case LispObject.X_SPID: 508 w = new Spid(Jlisp.idump.read()); 509 break; 510 case LispObject.X_DEFINMOD: // This case is ONLY expected to be present in FASL modules, and it is a 511 // prefix indicating what to do with some subsequent stuff. 512 { 513 int n0 = Jlisp.idump.read(), n1 = 0, n2 = 0; 514 if ((n0 & 0x80) != 0) { 515 n0 &= 0x7f; 516 n1 = Jlisp.idump.read(); 517 if ((n1 & 0x80) != 0) { 518 n1 &= 0x7f; 519 n2 = Jlisp.idump.read(); 520 } 521 } 522 n0 = n0 + (n1 << 7) + (n2 << 14); 523 // That has read in a 22-bit number. Actually only 18 bits are really needed 524 // in the CSL byte-compiler model so I have some spare capacity. I offset 525 // values by 1 so I can represent "-1" too. 526 w = new Spid(Spid.DEFINMOD, n0 - 1); 527 } 528 break; 529 case LispObject.X_STREAM: 530 w = Environment.nil; // new LispStream(); 531 break; 532 case LispObject.X_FNAME: 533 operand = Jlisp.idump.read(); { 534 byte[] data = new byte[operand]; 535 for (index = 0; index < operand; index++) { 536 data[index] = (byte) Jlisp.idump.read(); 537 } 538 String s = new String(data); 539 w = (LispObject) Jlisp.builtinFunctions.get(s); 540 if (w == null) { 541 Jlisp.lispErr.println(s + " not found"); 542 } 543 } 544 break; 545 case LispObject.X_SPECFN: 546 operand = Jlisp.idump.read(); { 547 byte[] data = new byte[operand]; 548 for (index = 0; index < operand; index++) { 549 data[index] = (byte) Jlisp.idump.read(); 550 } 551 String s = new String(data); 552 w = (LispObject) Jlisp.builtinSpecials.get(s); 553 if (w == null) { 554 Jlisp.lispErr.println(s + " not found"); 555 } 556 } 557 break; 558 case LispObject.X_STORE: 559 setLabel = true; 560 continue; 561 default: 562 throw new IOException("Bad byte in image file"); 563 } 564 // For objects that were read all in one gulp I arrive here and must 565 // impose sharing. 566 if (setLabel) { 567 shared[sharedIndex++] = w; 568 setLabel = false; 569 } 570 // Now I have read in an object (it is in w) so I need to consider what to 571 // do with it! It may be that processing this object will complete another 572 // whose actions had been stacked, so I have a loop here which unwinds 573 // the stack. If I "break" that will take me back to where the next item 574 // gets read. 575 for (;;) { 576 LispObject y = (LispObject) stack.peek(); 577 if (state > S_VECTOR) { 578 if (y instanceof LispVector) { 579 ((LispVector) y).vec[--state - S_VECTOR] = w; 580 } else if (y instanceof FnWithEnv) { 581 ((FnWithEnv) y).env[--state - S_VECTOR] = w; 582 } else { 583 throw new IOException("Corrupt image file"); 584 } 585 if (state == S_VECTOR) // now completed? 586 { 587 if (y instanceof LispVector) { 588 stack.pop(); 589 w = y; 590 state = istack[--sp]; 591 continue; 592 } else if (y instanceof FnWithEnv) { 593 stack.pop(); 594 w = y; 595 state = istack[--sp]; 596 continue; 597 } 598 } else { 599 break; 600 } 601 } else { 602 switch (state) { 603 case S_START: 604 return false; 605 case S_CADR + 16: 606 y = y.cdr; 607 case S_CADR + 15: 608 y = y.cdr; 609 case S_CADR + 14: 610 y = y.cdr; 611 case S_CADR + 13: 612 y = y.cdr; 613 case S_CADR + 12: 614 y = y.cdr; 615 case S_CADR + 11: 616 y = y.cdr; 617 case S_CADR + 10: 618 y = y.cdr; 619 case S_CADR + 9: 620 y = y.cdr; 621 case S_CADR + 8: 622 y = y.cdr; 623 case S_CADR + 7: 624 y = y.cdr; 625 case S_CADR + 6: 626 y = y.cdr; 627 case S_CADR + 5: 628 y = y.cdr; 629 case S_CADR + 4: 630 y = y.cdr; 631 case S_CADR + 3: 632 y = y.cdr; 633 case S_CADR + 2: 634 y = y.cdr; 635 y.car = w; 636 state--; 637 break; 638 case S_CADR + 1: 639 y.car = w; 640 w = (LispObject) stack.pop(); 641 state = istack[--sp]; 642 continue; 643 case S_CDR: { 644 Cons wc = (Cons) stack.pop(); 645 wc.cdr = w; 646 state = istack[--sp]; // will be S_CADR+nn 647 } 648 break; 649 case S_HASHKEY: 650 if (w == null) // hash table now complete 651 { 652 w = (LispObject) stack.pop(); 653 state = istack[--sp]; 654 continue; 655 } 656 stack.push(w); 657 state = S_HASHVAL; 658 break; 659 case S_HASHVAL: { 660 LispObject k = (LispObject) stack.pop(); 661 LispHash h = (LispHash) stack.peek(); 662 h.hash.put(k, w); 663 } 664 state = S_HASHKEY; 665 break; 666 case S_SYMFN: { 667 Symbol ws = (Symbol) stack.peek(); 668 ws.fn = (LispFunction) w; 669 state = S_SYMSPECIAL; 670 break; 671 } 672 case S_SYMSPECIAL: { 673 Symbol ws = (Symbol) stack.peek(); 674 ws.special = (SpecialFunction) w; 675 state = S_SYMPLIST; 676 break; 677 } 678 case S_SYMPLIST: { 679 Symbol ws = (Symbol) stack.peek(); 680 ws.cdr/*plist*/ = (LispObject) w; 681 state = S_SYMVAL; 682 break; 683 } 684 case S_SYMVAL: { 685 Symbol ws = (Symbol) stack.pop(); 686 ws.car/*value*/ = (LispObject) w; 687 w = ws; 688 state = istack[--sp]; 689 continue; 690 } 691 case S_AUTONAME: { 692 AutoLoad wa = (AutoLoad) stack.peek(); 693 wa.name = (Symbol) w; 694 state = S_AUTODATA; 695 break; 696 } 697 case S_AUTODATA: { 698 AutoLoad wa = (AutoLoad) stack.pop(); 699 wa.data = w; 700 w = wa; 701 state = istack[--sp]; 702 continue; 703 } 704 case S_INTERP_BODY: { 705 Interpreted wa = (Interpreted) stack.pop(); 706 wa.body = w; 707 w = wa; 708 state = istack[--sp]; 709 continue; 710 } 711 case S_MACRO_BODY: { 712 Macro wa = (Macro) stack.pop(); 713 wa.body = w; 714 w = wa; 715 state = istack[--sp]; 716 continue; 717 } 718 case S_CALLAS_BODY: { 719 CallAs wa = (CallAs) stack.pop(); 720 wa.body = w; 721 w = wa; 722 state = istack[--sp]; 723 continue; 724 } 725 default: 726 Jlisp.lispIO.println("Unknown state"); 727 throw new IOException("Malformed image file (bad state)"); 728 } 729 } 730 break; // so "break" in the switch corresponds to 731 // requesting a SHIFT, while "continue" is a REDUCE. 732 }//end for. 733 734 break; 735 }//end for. 736 737 return true; 738 }//end method. 739 //=================================================================================================================================== 740 // read a single parenthesised expression. 741 // Supports 'xx as a short-hand for (quote xx) 742 // which is what most Lisps do. 743 // Formal syntax: 744 // read => SYMBOL | NUMBER | STRING 745 // => ' read 746 // => ` read 747 // => , read 748 // => ,@ read 749 // => ( tail 750 // tail => ) 751 // => . read ) 752 // => read readtail 753 static LispStream readIn; 754 read()755 public LispObject read() throws Exception { 756 LispObject r; 757 r = Jlisp.lit[Lit.std_input].car/*value*/; 758 if (r instanceof LispStream) { 759 readIn = (LispStream) r; 760 } else { 761 throw new EOFException(); 762 } 763 if (!readIn.inputValid) { 764 inputType = readIn.nextToken(); 765 readIn.inputValid = true; 766 } 767 switch (inputType) { 768 case LispStream.TT_EOF: 769 throw new EOFException(); 770 case LispStream.TT_WORD: 771 readIn.inputValid = false; 772 return readIn.value; 773 //case LispStream.TT_NUMBER: 774 //readIn.inputValid = false; 775 //return readIn.value; 776 //case '\"': // String 777 //r = new LispString(readIn.sval); 778 //readIn.inputValid = false; 779 //return r; 780 case '\'': 781 readIn.inputValid = false; 782 r = read(); 783 return new Cons(Jlisp.lit[Lit.quote], new Cons(r, Environment.nil)); 784 case '`': 785 readIn.inputValid = false; 786 r = read(); 787 return expandBackquote(r); 788 case ',': 789 readIn.inputValid = false; 790 r = read(); 791 return new Cons(Jlisp.lit[Lit.comma], new Cons(r, Environment.nil)); 792 case 0x10000: // ",@" 793 readIn.inputValid = false; 794 r = read(); 795 return new Cons(Jlisp.lit[Lit.commaAt], new Cons(r, Environment.nil)); 796 case '(': 797 readIn.inputValid = false; 798 return readTail(); 799 case ')': 800 case '.': 801 readIn.inputValid = false; 802 return Environment.nil; 803 default: 804 if (inputType < 128) { 805 r = chars[inputType]; 806 } else { 807 r = Symbol.intern(String.valueOf((char) inputType)); 808 } 809 readIn.inputValid = false; 810 return r; 811 } 812 } 813 readTail()814 LispObject readTail() throws Exception { 815 LispObject r; 816 if (!readIn.inputValid) { 817 inputType = readIn.nextToken(); 818 readIn.inputValid = true; 819 } 820 switch (inputType) { 821 case '.': 822 readIn.inputValid = false; 823 r = read(); 824 if (!readIn.inputValid) { 825 inputType = readIn.nextToken(); 826 readIn.inputValid = true; 827 } 828 if (inputType == ')') { 829 readIn.inputValid = false; 830 } 831 return r; 832 case LispStream.TT_EOF: 833 throw new EOFException(); 834 case ')': 835 readIn.inputValid = false; 836 return Environment.nil; 837 default: 838 r = read(); 839 return new Cons(r, readTail()); 840 } 841 } 842 expandBackquote(LispObject a)843 LispObject expandBackquote(LispObject a) throws ResourceException { 844 if (a == Environment.nil) { 845 return a; 846 } else if (a.atom) { 847 return new Cons(Jlisp.lit[Lit.quote], new Cons(a, Environment.nil)); 848 } 849 LispObject aa = a; 850 if (aa.car == Jlisp.lit[Lit.comma]) { 851 return aa.cdr.car; 852 } 853 if (!aa.car.atom) { 854 LispObject aaa = aa.car; 855 if (aaa.car == Jlisp.lit[Lit.commaAt]) { 856 LispObject v = aaa.cdr.car; 857 LispObject t = expandBackquote(aa.cdr); 858 return new Cons(Jlisp.lit[Lit.append], 859 new Cons(v, new Cons(t, Environment.nil))); 860 } 861 } 862 return new Cons(Jlisp.lit[Lit.cons], 863 new Cons(expandBackquote(aa.car), 864 new Cons(expandBackquote(aa.cdr), Environment.nil))); 865 } 866 preRestore()867 public void preRestore() throws IOException { 868 sharedIndex = 0; 869 sharedSize = Jlisp.idump.read(); 870 sharedSize = (sharedSize << 8) + Jlisp.idump.read(); 871 sharedSize = (sharedSize << 8) + Jlisp.idump.read(); 872 shared = new LispObject[sharedSize]; 873 istacklimit = 500; 874 istack = new int[istacklimit]; 875 stack = new Stack(); 876 stack.push(new Cons()); // to make "peek()" valid even when empty 877 } 878 postRestore()879 public void postRestore() { 880 istack = null; 881 stack = null; 882 shared = null; 883 } 884 private int loopIndex = 1; 885 private int i = 0; 886 incrementalRestore()887 boolean incrementalRestore() throws IOException, ResourceException { 888 889 boolean returnValue = true; 890 891 switch (loopIndex) { 892 case 1: 893 Jlisp.descendSymbols = true; 894 // First I will read and display the banner... 895 // I would like to be able to update JUST this banner in a heap image. To 896 // support that I will (sometime!) change my heap format to put the 897 // banner as an initial chunk of bytes in the PDS outside the compressed 898 // data that represents the main heap image. One natural place to put it 899 // will be as part of the directory entry for the initial image, and another 900 // would be at the very start of the whole image file. 901 int n; 902 903 n = Jlisp.idump.read(); 904 n = (n << 8) + Jlisp.idump.read(); 905 n = (n << 8) + Jlisp.idump.read(); 906 if (n != 0) { 907 byte[] b = new byte[n]; 908 for (i = 0; i < n; i++) { 909 b[i] = (byte) Jlisp.idump.read(); 910 } 911 Jlisp.lispIO.println(new String(b)); 912 Jlisp.lispIO.flush(); 913 } 914 915 Environment.nil = (Symbol) readObject(); 916 917 Jlisp.lispTrue = (Symbol) readObject(); 918 919 loopIndex++; 920 921 break; 922 923 case 2: 924 readObjectReset(); 925 loopIndex++; 926 break; 927 case 3: 928 if (i < Lit.names.length) { 929 if (readObjectIncrement() == true) { 930 break; 931 } else { 932 Jlisp.lit[i] = w; 933 934 /* 935 System.out.println("literal " + i + " restored"); 936 if (Jlisp.lit[i] instanceof Symbol) { 937 System.out.println("= " + ((Symbol) Jlisp.lit[i]).pname); 938 } 939 */ 940 941 i++; 942 } 943 } else { 944 loopIndex++; 945 } 946 947 break; 948 949 case 4: 950 951 for (i = 0; i < oblistSize; i++) { 952 oblist[i] = null; 953 } 954 oblistCount = 0; 955 956 957 958 // When restoring a heap image my oblist handling can be fairly 959 // simple: I should NEVER get any attempt to insert an item that is already 960 // there and I start with an empty table so there are no deleted 961 // items to worry about. 962 963 //System.out.println("termination of oblist found : " + oblistCount); 964 965 loopIndex++; 966 967 break; 968 969 default: 970 returnValue = false; 971 break; 972 }//end switch; 973 974 return returnValue; 975 976 }//end method 977 afterIncrementalRestore()978 public void afterIncrementalRestore() throws Exception { 979 LispObject w; 980 981 if (Jlisp.idump.read() == 0) { 982 Fns.prompt = null; 983 } else { 984 w = readObject(); 985 Fns.prompt = ((LispString) w).string; 986 } 987 988 w = readObject(); 989 try { 990 Gensym.gensymCounter = w.intValue(); 991 } catch (Exception ee) { 992 Gensym.gensymCounter = 0; 993 } 994 995 w = readObject(); 996 try { 997 Environment.modulus = w.intValue(); 998 } catch (Exception ee) { 999 Environment.modulus = 1; 1000 } 1001 Environment.bigModulus = BigInteger.valueOf(Environment.modulus); 1002 1003 w = readObject(); 1004 try { 1005 Environment.printprec = w.intValue(); 1006 } catch (Exception ee) { 1007 Environment.printprec = 14; 1008 } 1009 1010 1011 postRestore(); 1012 }//end method. 1013 readObjects()1014 private boolean readObjects() throws Exception { 1015 Symbol s; 1016 if ((s = (Symbol) readObject()) != null) { 1017 s.completeName(); 1018 String name = s.pname; 1019 1020 //Uncomment the following line of code to print the contents of the heap. 1021 //if (name.length() > 1) { System.out.println("restore symbol <" + name + "> length " + name.length()); } 1022 1023 int inc = name.hashCode(); 1024 //System.out.println("raw hash = " + Integer.toHexString(inc)); 1025 // I want my hash addresses and the increment to be positive... 1026 // and Java tells me what the hash algorithm for strings is. What I do here 1027 // ensures that strings that differ only in their final character get placed 1028 // some multiple of 169 apart (is not quite adjacant). 1029 int hash = ((169 * inc) & 0x7fffffff) % oblistSize; 1030 inc = 1 + ((inc & 0x7fffffff) % (oblistSize - 1)); // never zero 1031 //System.out.println("first probe = " + hash + " " + inc); 1032 while (oblist[hash] != null) { 1033 if (oblist[hash].pname.equals(name)) { 1034 System.out.println("Two symbols called <" + name + "> " + Integer.toHexString((int) name.charAt(0))); 1035 } 1036 hash += inc; 1037 if (hash >= oblistSize) { 1038 hash -= oblistSize; 1039 } 1040 //System.out.println("next probe = " + hash); 1041 } 1042 //System.out.println("Put <" + name + "> at " + hash + " " + inc); 1043 oblist[hash] = s; 1044 oblistCount++; 1045 // I will permit the hash table loading to reach 0.75, but then I take action 1046 if (4 * oblistCount > 3 * oblistSize) { 1047 reHashOblist(); 1048 } 1049 1050 return true; 1051 }//end if. 1052 else { 1053 afterIncrementalRestore(); 1054 1055 return false; 1056 } 1057 }//end method. 1058 execute()1059 public boolean execute() { 1060 boolean continueFlag = false; 1061 1062 try { 1063 continueFlag = readObjects(); 1064 } catch (Exception e) { 1065 e.printStackTrace(); 1066 } finally { 1067 return continueFlag; 1068 } 1069 } 1070 isPrime(int n)1071 static boolean isPrime(int n) { 1072 // the input must be odd and fairly large here... so the case of even 1073 // numbers is not important, as is the status of the number 1. 1074 for (int f = 3; f * f <= n; f += 2) { 1075 if (n % f == 0) { 1076 return false; 1077 } 1078 } 1079 return true; 1080 } 1081 reHashOblist()1082 public static void reHashOblist() { 1083 int n = ((3 * oblistSize) / 2) | 1; 1084 while (!isPrime(n)) { 1085 n += 2; 1086 } 1087 Symbol[] v = new Symbol[n]; 1088 for (int i = 0; i < n; i++) { 1089 v[i] = null; 1090 } 1091 for (int i = 0; i < oblistSize; i++) { 1092 Symbol s = oblist[i]; 1093 if (s == null) { 1094 continue; 1095 } 1096 int inc = s.pname.hashCode(); 1097 int hash = ((169 * inc) & 0x7fffffff) % n; 1098 inc = 1 + ((inc & 0x7fffffff) % (n - 1)); // never zero 1099 while (v[hash] != null) { 1100 if (v[hash].pname.equals(s.pname)) { 1101 System.out.println("Two symbols called <" + s.pname + "> " 1102 + Integer.toHexString((int) s.pname.charAt(0))); 1103 } 1104 hash += inc; 1105 if (hash >= n) { 1106 hash -= n; 1107 } 1108 } 1109 //System.out.println("Relocate <" + s.pname + "> at " + hash + " " + inc); 1110 v[hash] = s; 1111 } 1112 oblist = v; 1113 oblistSize = n; 1114 obvector.vec = v; 1115 } 1116 scanObject(LispObject a)1117 public void scanObject(LispObject a) { 1118 if (a == null) { 1119 return; 1120 } 1121 stack.push(a); 1122 try // keep going until the stack empties. 1123 { 1124 for (;;) { 1125 LispObject w = (LispObject) stack.pop(); 1126 w.scan(); 1127 } 1128 } catch (EmptyStackException e) { 1129 } 1130 } 1131 }//End class. 1132 1133