001: /*
002: * Jatha - a Common LISP-compatible LISP library in Java.
003: * Copyright (C) 1997-2005 Micheal Scott Hewett
004: *
005: * This library is free software; you can redistribute it and/or
006: * modify it under the terms of the GNU Lesser General Public
007: * License as published by the Free Software Foundation; either
008: * version 2.1 of the License, or (at your option) any later version.
009: *
010: * This library is distributed in the hope that it will be useful,
011: * but WITHOUT ANY WARRANTY; without even the implied warranty of
012: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
013: * Lesser General Public License for more details.
014: *
015: * You should have received a copy of the GNU Lesser General Public
016: * License along with this library; if not, write to the Free Software
017: * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
018: *
019: *
020: * For further information, please contact Micheal Hewett at
021: * hewett@cs.stanford.edu
022: *
023: */
024: /**
025: * $Id: GoPrimitive.java,v 1.2 2005/06/30 00:24:23 olagus Exp $
026: */package org.jatha.compile;
027:
028: import org.jatha.Jatha;
029: import org.jatha.dynatype.*;
030: import org.jatha.machine.*;
031:
032: /**
033: * <p>Implements the GO primitive</p>
034: *
035: * @author <a href="mailto:Ola.Bini@itc.ki.se">Ola Bini</a>
036: * @version $Revision: 1.2 $
037: */
038: public class GoPrimitive extends LispPrimitive {
039: private long counter = 0L;
040:
041: public GoPrimitive(final Jatha lisp) {
042: super (lisp, "GO", 1);
043: }
044:
045: public void Execute(final SECDMachine machine) {
046: /* System.err.println("our registers (before):");
047: System.err.println("S: " + machine.S.value());
048: System.err.println("E: " + machine.E.value());
049: System.err.println("C: " + machine.C.value());
050: System.err.println("D: " + machine.D.value());
051: System.err.println("X: " + machine.X.value());
052:
053: System.err.println("x1");*/
054: final LispValue tag = machine.S.pop().car();
055: // System.err.println("x2");
056: machine.S.assign(f_lisp.NIL);
057: // System.err.println("x3");
058: final LispValue code = machine.B.gethash(tag).car();
059: // System.err.println("x4 - " + machine.X.value().first().first());
060:
061: machine.E.assign(machine.X.value().first().first());
062: // System.err.println("x5 - " + machine.X.value().first().second());
063: machine.D.assign(machine.X.value().first().second());
064: /* System.err.println("x6 - " + machine.X);
065: System.err.println("x6 - " + machine.X.value());
066: System.err.println("x6 - " + machine.X.value().first());
067: System.err.println("x6 - " + machine.X.value().first().third());*/
068: ((StandardLispHashTable) machine.B)
069: .assign((StandardLispHashTable) machine.X.value()
070: .first().third());
071: // System.err.println("x7");
072:
073: machine.C.assign(code);
074: /*
075: LispValue full = machine.D.value();
076: full = removeUntilTagbody(machine,full);
077: machine.D.assign(full);
078: machine.C.assign(code);
079: if(machine.E.value().car() == f_lisp.NIL) {
080: machine.E.assign(machine.E.value().cdr()); // black magic.
081: }
082: */
083: /*
084: System.err.println("our registers (after):");
085: System.err.println("S: " + machine.S.value());
086: System.err.println("E: " + machine.E.value());
087: System.err.println("C: " + machine.C.value());
088: System.err.println("D: " + machine.D.value());
089: System.err.println("X: " + machine.X.value());*/
090: }
091:
092: public LispValue removeUntilTagbody(final SECDMachine machine,
093: final LispValue input) {
094: LispValue walker = input;
095: LispValue inner = input.car();
096: final java.util.List unbinds = new java.util.ArrayList();
097: while (!(inner.car() instanceof TagbodyPrimitive)
098: && walker != f_lisp.NIL) {
099: if (inner.car() == machine.SP_UNBIND) {
100: unbinds.add(inner.first());
101: unbinds.add(inner.second());
102: }
103: inner = inner.cdr();
104: while (inner.car() == f_lisp.NIL && walker != f_lisp.NIL) {
105: walker = walker.cdr();
106: inner = walker.car();
107: }
108: }
109: return (walker == f_lisp.NIL) ? f_lisp.makeList(f_lisp
110: .makeList(unbinds)) : f_lisp.makeCons(f_lisp.makeList(
111: unbinds).append(inner), walker.cdr());
112: }
113:
114: public LispValue CompileArgs(final LispCompiler compiler,
115: final SECDMachine machine, final LispValue args,
116: final LispValue valueList, final LispValue code)
117: throws CompilerException {
118: final LispValue tag = args.car();
119: if (!compiler.isLegalTag(tag)) {
120: throw new IllegalArgumentException("Tag " + tag
121: + " is not legal in this lexical context");
122: }
123: long nextVal = 0L;
124: synchronized (this ) {
125: nextVal = counter++;
126: }
127: compiler.getRegisteredDos().put(new Long(nextVal), tag);
128: return compiler.compileArgsLeftToRight(f_lisp.makeList(f_lisp
129: .makeList(f_lisp.QUOTE, f_lisp.makeList(f_lisp
130: .getEval().intern("#:T" + nextVal)))),
131: valueList, code);
132: }
133: }// GoPrimitive
|