File r37/lisp/csl/jlisp/Fns3.java artifact 93441d9435 part of check-in 3c4d7b69af


//
// This file is part of the Jlisp implementation of Standard Lisp
// Copyright \u00a9 (C) Codemist Ltd, 1998-2000.
//


// Fns3.java

// Each built-in function is created wrapped in a class
// that is derived from BuiltinFunction.

import java.io.*;
import java.util.*;
import java.util.zip.*;
import java.text.*;
import java.math.*;

class Fns3
{
    Object [][] builtins = 
    {
        {"liter",                       new LiterFn()},
        {"load-module",                 new Load_moduleFn()},
        {"lposn",                       new LposnFn()},
        {"macro-function",              new Macro_functionFn()},
        {"macroexpand",                 new MacroexpandFn()},
        {"macroexpand-1",               new Macroexpand_1Fn()},
        {"make-bps",                    new Make_bpsFn()},
        {"make-function-stream",        new Make_function_streamFn()},
        {"make-global",                 new Make_globalFn()},
        {"make-native",                 new Make_nativeFn()},
        {"make-random-state",           new Make_random_stateFn()},
        {"make-simple-string",          new Make_simple_stringFn()},
        {"make-special",                new Make_specialFn()},
        {"map",                         new MapFn()},
        {"mapc",                        new MapcFn()},
        {"mapcan",                      new MapcanFn()},
        {"mapcar",                      new MapcarFn()},
        {"mapcon",                      new MapconFn()},
        {"maphash",                     new MaphashFn()},
        {"maplist",                     new MaplistFn()},
        {"mapstore",                    new MapstoreFn()},
        {"md5",                         new Md5Fn()},
	      {"md60",                        new Md60Fn()},
        {"member",                      new MemberFn()},
        {"member**",                    new MemberStarStarFn()},
        {"memq",                        new MemqFn()},
        {"mkevect",                     new MkevectFn()},
        {"mkfvect32",                   new Mkfvect32Fn()},
        {"mkfvect64",                   new Mkfvect64Fn()},
        {"mkhash",                      new MkhashFn()},
        {"mkquote",                     new MkquoteFn()},
        {"mkvect",                      new MkvectFn()},
        {"mkvect16",                    new Mkvect16Fn()},
        {"mkvect32",                    new Mkvect32Fn()},
        {"mkvect8",                     new Mkvect8Fn()},
        {"mkxvect",                     new MkxvectFn()},
        {"modulep",                     new ModulepFn()},
        {"native-address",              new Native_addressFn()},
        {"native-getv",                 new Native_getvFn()},
        {"native-putv",                 new Native_putvFn()},
        {"native-type",                 new Native_typeFn()},
        {"nconc",                       new NconcFn()},
        {"ncons",                       new NconsFn()},
        {"neq",                         new NeqFn()},
        {"noisy-setq",                  new Noisy_setqFn()},
        {"not",                         new NotFn()},
        {"null",                        new NullFn()},
        {"oblist",                      new OblistFn()},
        {"oem-supervisor",              new Oem_supervisorFn()},
        {"open",                        new OpenFn()},
        {"~open",                       new InternalOpenFn()},
        {"open-library",                new Open_libraryFn()},
        {"open-url",                    new Open_urlFn()},
        {"orderp",                      new OrderpFn()},
        {"ordp",                        new OrderpFn()}, // synonym
        {"output-library",              new Output_libraryFn()},
        {"pagelength",                  new PagelengthFn()},
        {"pair",                        new PairFn()},
        {"pairp",                       new PairpFn()},
        {"peekch",                      new PeekchFn()},
        {"pipe-open",                   new Pipe_openFn()},
        {"plist",                       new PlistFn()},
        {"posn",                        new PosnFn()},
        {"preserve",                    new PreserveFn()},
	      {"restart-csl",                 new RestartFn()},
	      {"saveobject",                  new SaveObjectFn()},
	      {"restoreobject",               new RestoreObjectFn()},
        {"prin",                        new PrinFn()},
        {"prin1",                       new Prin1Fn()},
        {"prin2",                       new Prin2Fn()},
        {"prin2a",                      new Prin2aFn()},
        {"prinbinary",                  new PrinbinaryFn()},
        {"princ",                       new PrincFn()},
        {"princ-downcase",              new Princ_downcaseFn()},
        {"princ-upcase",                new Princ_upcaseFn()},
        {"prinhex",                     new PrinhexFn()},
        {"prinoctal",                   new PrinoctalFn()},
        {"print",                       new PrintFn()},
        {"printc",                      new PrintcFn()},
        {"printprompt",                 new PrintpromptFn()},
        {"prog1",                       new Prog1Fn()},
        {"prog2",                       new Prog2Fn()},
        {"progn",                       new PrognFn()},
        {"put",                         new PutFn()},
        {"puthash",                     new PuthashFn()},
        {"putv",                        new PutvFn()},
        {"putv-char",                   new Putv_charFn()},
        {"putv16",                      new Putv16Fn()},
        {"putv32",                      new Putv32Fn()},
        {"putv8",                       new Putv8Fn()},
        {"qcaar",                       new QcaarFn()},
        {"qcadr",                       new QcadrFn()},
        {"qcar",                        new QcarFn()},
        {"qcdar",                       new QcdarFn()},
        {"qcddr",                       new QcddrFn()},
        {"qcdr",                        new QcdrFn()},
        {"qgetv",                       new QgetvFn()},
        {"qputv",                       new QputvFn()},
        {"rassoc",                      new RassocFn()},
        {"rdf",                         new RdfFn()},
        {"rds",                         new RdsFn()},
        {"read",                        new ReadFn()},
        {"readch",                      new ReadchFn()},
        {"readline",                    new ReadlineFn()},
        {"reclaim",                     new ReclaimFn()},
        {"remd",                        new RemdFn()},
        {"remflag",                     new RemflagFn()},
        {"remhash",                     new RemhashFn()},
        {"remob",                       new RemobFn()},
        {"remprop",                     new RempropFn()},
        {"rename-file",                 new Rename_fileFn()},
        {"representation",              new RepresentationFn()},
        {"return",                      new ReturnFn()},
        {"reverse",                     new ReverseFn()},
        {"reversip",                    new ReversipFn()},
        {"rplaca",                      new RplacaFn()},
        {"rplacd",                      new RplacdFn()},
        {"rplacw",                      new RplacwFn()},
        {"rseek",                       new RseekFn()},
        {"rtell",                       new RtellFn()},
        {"sample",                      new SampleFn()},
        {"sassoc",                      new SassocFn()},
        {"schar",                       new ScharFn()},
        {"seprp",                       new SeprpFn()},
        {"set",                         new SetFn()},
        {"set-autoload",                new Set_autoloadFn()},
        {"set-help-file",               new Set_help_fileFn()},
        {"set-print-precision",         new Set_print_precisionFn()},
        {"setpchar",                    new SetpcharFn()},
        {"simple-string-p",             new Simple_string_pFn()},
        {"simple-vector-p",             new Simple_vector_pFn()},
        {"smemq",                       new SmemqFn()},
        {"spaces",                      new SpacesFn()},
        {"special-char",                new Special_charFn()},
        {"special-form-p",              new Special_form_pFn()},
        {"spool",                       new SpoolFn()},
        {"start-module",                new Start_moduleFn()},
        {"stop",                        new StopFn()},
        {"streamp",                     new StreampFn()},
        {"stringp",                     new StringpFn()},
	      {"stub1",                       new Stub1Fn()},
	      {"stub2",                       new Stub2Fn()},
        {"subla",                       new SublaFn()},
        {"sublis",                      new SublisFn()},
        {"subst",                       new SubstFn()},
        {"sxhash",                      new SxhashFn()},
        {"symbol-argcount",             new Symbol_argcountFn()},
        {"symbol-env",                  new Symbol_envFn()},
        {"symbol-fastgets",             new Symbol_fastgetsFn()},
        {"symbol-fn-cell",              new Symbol_fn_cellFn()},
        {"symbol-function",             new Symbol_functionFn()},
        {"symbol-make-fastget",         new Symbol_make_fastgetFn()},
        {"symbol-name",                 new Symbol_nameFn()},
        {"symbol-protect",              new Symbol_protectFn()},
        {"symbol-set-definition",       new Symbol_set_definitionFn()},
        {"symbol-set-env",              new Symbol_set_envFn()},
        {"symbol-set-native",           new Symbol_set_nativeFn()},
        {"symbol-value",                new Symbol_valueFn()},
        {"symbolp",                     new SymbolpFn()},
        {"symerr",                      new SymerrFn()},
        {"system",                      new SystemFn()},
        {"tagbody",                     new TagbodyFn()},
        {"terpri",                      new TerpriFn()},
        {"threevectorp",                new ThreevectorpFn()},
        {"throw",                       new ThrowFn()},
        {"time",                        new TimeFn()},
        {"tmpnam",                      new TmpnamFn()},
        {"trace",                       new TraceFn()},
        {"traceset",                    new TracesetFn()},
        {"traceset1",                   new Traceset1Fn()},
        {"ttab",                        new TtabFn()},
        {"tyo",                         new TyoFn()},
        {"undouble-execute",            new Undouble_executeFn()},
        {"unfluid",                     new UnfluidFn()},
        {"unglobal",                    new UnglobalFn()},
        {"union",                       new UnionFn()},
        {"unmake-global",               new Unmake_globalFn()},
        {"unmake-special",              new Unmake_specialFn()},
        {"unreadch",                    new UnreadchFn()},
        {"untrace",                     new UntraceFn()},
        {"untraceset",                  new UntracesetFn()},
        {"untraceset1",                 new Untraceset1Fn()},
        {"unwind-protect",              new Unwind_protectFn()},
        {"upbv",                        new UpbvFn()},
        {"user-homedir-pathname",       new User_homedir_pathnameFn()},
        {"vectorp",                     new VectorpFn()},
        {"verbos",                      new VerbosFn()},
        {"where-was-that",              new Where_was_thatFn()},
        {"window-heading",              new Window_headingFn()},
        {"startup-banner",              new Startup_bannerFn()},
        {"writable-libraryp",           new Writable_librarypFn()},
        {"write-help-module",           new Write_help_moduleFn()},
        {"write-module",                new Write_moduleFn()},
        {"wrs",                         new WrsFn()},
        {"xassoc",                      new XassocFn()},
        {"xcons",                       new XconsFn()},
        {"xdifference",                 new XdifferenceFn()},
        {"xtab",                        new XtabFn()},
        {"~tyi",                        new TyiFn()}
    };



class LiterFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (!(arg1 instanceof Symbol)) return Jlisp.nil;
        Symbol s = (Symbol)arg1;
        char ch = s.pname.charAt(0);
        if (Character.isLetter(ch)) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }
}


class Load_moduleFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return Fasl.loadModule(arg1);
    }
}

class LposnFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Macro_functionFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (!(arg1 instanceof Symbol)) return Jlisp.nil;
        LispFunction fn = ((Symbol)arg1).fn;
        if (fn instanceof Macro)
	{   return ((Macro)fn).body;
        }
        else return Jlisp.nil;
    }
}

class MacroexpandFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return op2(arg1, null);
    }
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        for (;;)
        {   if (arg1.atom) return arg1;
            if (!(arg1.car instanceof Symbol)) return arg1;
            Symbol f = (Symbol)arg1.car;
            LispFunction fn = f.fn;
            if (!(fn instanceof Macro)) return arg1;
// At last - here I have a macro that I can expand
            arg1 = fn.op1(arg1);
        }
    }
}

class Macroexpand_1Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return op2(arg1, null);
    }
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (arg1.atom) return arg1;
        if (!(arg1.car instanceof Symbol)) return arg1;
        Symbol f = (Symbol)arg1.car;
        LispFunction fn = f.fn;
        if (!(fn instanceof Macro)) return arg1;
// At last - here I have a macro that I can expand
        return fn.op1(arg1);
    }
}

class Make_bpsFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        int n = ((LispSmallInteger)arg1).value;
        return new Bytecode(n);
    }
}

class Make_function_streamFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Make_globalFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        Symbol s = (Symbol)arg1;
        Fns.put(s, Jlisp.lit[Lit.global], Jlisp.lispTrue);
        if (s.car/*value*/ == Jlisp.lit[Lit.undefined]) s.car/*value*/ = Jlisp.nil;
        return Jlisp.nil; 
    }
}

class Make_nativeFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Make_random_stateFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Make_simple_stringFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        int n = ((LispSmallInteger)arg1).value;
        char [] c = new char[n];
	for (int i=0; i<n; i++) c[i] = (char)0;
	return new LispString(new String(c));
    }
}

class Make_specialFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        Symbol s = (Symbol)arg1;
        Fns.put(s, Jlisp.lit[Lit.special], Jlisp.lispTrue);
        if (s.car/*value*/ == Jlisp.lit[Lit.undefined]) s.car/*value*/ = Jlisp.nil;
        return Jlisp.nil; 
    }
}

class MapFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MapcFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MapcanFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MapcarFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MapconFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MaphashFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MaplistFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MapstoreFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Jlisp.println();
        Jlisp.println("*** MAPSTORE ***");
        return Jlisp.nil;
    }
}

class Md5Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        LispStream f = new LispDigester();
        LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
        try
	{   Jlisp.lit[Lit.std_output].car/*value*/ = f;
            arg1.print(LispObject.noLineBreak+LispObject.printEscape);
        }
        finally
	{   Jlisp.lit[Lit.std_output].car/*value*/ = save;
        }
	byte [] res = f.md.digest();
        return LispInteger.valueOf(new BigInteger(res));
    }
}

class Md60Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        LispStream f = new LispDigester();
        LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
        try
	{   Jlisp.lit[Lit.std_output].car/*value*/ = f;
            arg1.print(LispObject.noLineBreak+LispObject.printEscape);
        }
        finally
	{   Jlisp.lit[Lit.std_output].car/*value*/ = save;
        }
	byte [] res = f.md.digest();
        return LispInteger.valueOf(new BigInteger(res).shiftRight(68));
    }
}


class MemberFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        while (!arg2.atom)
	{   if (arg1.lispequals(arg2.car)) return arg2;
            arg2 = arg2.cdr;
        }
        return Jlisp.nil;
    }
}

class MemberStarStarFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        while (!arg2.atom)
	{   if (arg1.lispequals(arg2.car)) return arg2;
            arg2 = arg2.cdr;
        }
        return Jlisp.nil;
    }
}

class MemqFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        while (!arg2.atom)
	{   if (arg1 instanceof LispNumber)                 // @@@
            {   if (arg1.lispequals(arg2.car)) return arg2; // @@@
            }                                               // @@@
            else if (arg1 == arg2.car) return arg2;
            arg2 = arg2.cdr;
        }
        return Jlisp.nil;
    }
}

class MkevectFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Mkfvect32Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Mkfvect64Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MkhashFn extends BuiltinFunction
{
  // (MKHASH size flavour growth-ratio)
  //    size is initial table size
  //    flavour: 0  EQ
  //             1  EQL
  //             2  EQUAL
  //             3  EQUALS
  //             4  EQUALP
  //    ratio:   amount to expand by as table gets full
  //
  // In this Java version I will ignore the first and third args,
  // and only support EQ and EQUAL tables!  Note that an EQ table
  // will generally re-hash itself if serialized...

    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("mkhash called with " + args.length +
                "args when 3 expected");
        int n = ((LispSmallInteger)args[1]).value;
        HashMap h;
        if (n == 0) h = new HashMap();
        else h = new LispEqualHash();
        return new LispHash(h, n);
    }
}

class MkquoteFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return new Cons(Jlisp.lit[Lit.quote],
	    new Cons(arg1, Jlisp.nil));
    }
}

class MkvectFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        int n = ((LispSmallInteger)arg1).value;
        return new LispVector(n+1); // Hah - index values from 0 to n
    }
}

class Mkvect16Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Mkvect32Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Mkvect8Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class MkxvectFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class ModulepFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        String s;
        if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
        else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
        else return error("illegal arg to modulep", arg1);
        s = s + ".fasl";
        for (int i=0; i<Jlisp.imageCount; i++)
        {   arg1 = Jlisp.images[i].modulep(s);
            if (arg1 != Jlisp.nil) return arg1;
        }
        return Jlisp.nil;
    }
}

class Native_addressFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Native_getvFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Native_putvFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Native_typeFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class NconcFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (arg1.atom) return arg2;
        LispObject r = arg1;
        LispObject prev = null;
        while (!arg1.atom)
	{   prev = arg1;
            arg1 = prev.cdr;
        }
        prev.cdr = arg2;
        return r;
    }
}

class NconsFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return new Cons(arg1, Jlisp.nil);
    }
}

class NeqFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        if (arg1 == arg2) return Jlisp.nil;
        return arg1.lispequals(arg2) ? Jlisp.nil :
            Jlisp.lispTrue;
    }
}

class Noisy_setqFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class NotFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return arg1 == Jlisp.nil ?
               Jlisp.lispTrue :
               Jlisp.nil;
    }
}

class NullFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return arg1 == Jlisp.nil ?
               Jlisp.lispTrue :
               Jlisp.nil;
    }
}

class OblistFn extends BuiltinFunction
{
    public LispObject op0()
    {
// Note that this implementation pushes out the object list with
// items in a randomish order. CSL sorted it which was nice - to do that
// here I would have to implement a sorting function, and as present that
// does not seem my highest priority.
        LispObject r = Jlisp.nil;
        for (int i=0; i<Jlisp.oblistSize; i++)
	{   Symbol w = Jlisp.oblist[i];
            if (w != null)
	    {   if (w.car/*value*/ != Jlisp.lit[Lit.undefined] ||
                    w.cdr/*plist*/ != Jlisp.nil ||
                    w.special != null ||
                    !(w.fn instanceof Undefined))
                    r = new Cons(w, r);
            }
        }
        return r;
    }
}

class Oem_supervisorFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class OpenFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (!(arg1 instanceof LispString)) 
            return error("argument 1 to open must be a string");
        String name = ((LispString)arg1).string;
        if (arg2 == Jlisp.lit[Lit.input])
        {   LispObject r = Jlisp.nil;
            try
            {   r = new LispStream(
                    name,
                    new BufferedReader(
                        new FileReader(LispStream.nameConvert(name))),
                    false, true);
            }
            catch (FileNotFoundException e)
            {   return error("File " + name + " not found");
            }
            return r;
        }
        else if (arg2 == Jlisp.lit[Lit.output]) 
        {   LispObject r = Jlisp.nil;
            try
            {   r = new LispOutputStream(name);
            }
            catch (IOException e)
	    {   return error("File " + name + " can not be opened for output");
            }
            return r;
        }
        else if (arg2 == Jlisp.lit[Lit.append]) 
        {   LispObject r = Jlisp.nil;
            try
            {   r = new LispOutputStream(name, true);
            }
            catch (IOException e)
	    {   return error("File " + name + " can not be opened for output");
            }
            return r;
        }
        else return error(
            "argument 2 to open should be input, output or append");
    }
}


// The system-coded primitive function ~OPEN opens a file, and takes a second
// argument that shows what options are wanted. See extracts from the CSL
// file "print.c" (included just below this comment) for an explanation 
// of the bits.
//
// This stuff is here so I can be almost ridiculously compatible with CSL
// since that makes it easier to share files with that world...
//
//(de open (a b)
//   (cond
//     ((eq b 'input) (!~open a (plus 1 64)))     % if-does-not-exist error
//     ((eq b 'output) (!~open a (plus 2 20 32))) % if-does-not-exist create,
//                                                % if-exists new-version
//     ((eq b 'append) (!~open a (plus 2 8 32)))  % if-exists append
//     (t (error "bad direction ~A in open" b))))
//
//(de binopen (a b)
//   (cond
//     ((eq b 'input) (!~open a (plus 1 64 128)))
//     ((eq b 'output) (!~open a (plus 2 20 32 128)))
//     ((eq b 'append) (!~open a (plus 2 8 32 128)))
//     (t (error "bad direction ~A in binopen" b))))
//
//(de pipe!-open (c d)
//   (cond
//     ((eq d 'input) (!~open c (plus 1 256)))
//     ((eq d 'output) (!~open c (plus 2 256)))
//     (t (error "bad direction ~A in pipe-open" d))))
//


//
///*
// * The Common Lisp keywords for OPEN are a horrid mess. I arrange to decode
// * the syntax of the keywords in a Lisp-coded wrapper function, and in that
// * code I will also fill in default values for any that needs same. I then
// * pack all the information into a single integer, which has several
// * sub-fields
// *
// * x x xx xxx 00   direction PROBE
// * x x xx xxx 01             INPUT
// * x x xx xxx 10             OUTPUT
// * x x xx xxx 11             IO
// *
// * x x xx 000 xx   if-exists NIL
// * x x xx 001 xx             overwrite
// * x x xx 010 xx             append
// * x x xx 011 xx             rename
// * x x xx 100 xx             error
// * x x xx 101 xx             (new-version)
// * x x xx 110 xx             (supersede)
// * x x xx 111 xx             (rename-and-delete)
// *
// * x x 00 xxx xx   if-does-not-exist NIL
// * x x 01 xxx xx                     create
// * x x 10 xxx xx                     error
// *
// * x 0 xx xxx xx   regular text file
// * x 1 xx xxx xx   open for binary access
// *
// * 0 x xx xxx xx   regular file
// * 1 x xx xxx xx   open as a pipe
// */
//
//#define DIRECTION_MASK               0x3
//#define DIRECTION_PROBE              0x0
//#define DIRECTION_INPUT              0x1
//#define DIRECTION_OUTPUT             0x2
//#define DIRECTION_IO                 0x3
//#define IF_EXISTS_MASK               0x1c
//#define IF_EXISTS_NIL                0x00
//#define IF_EXISTS_OVERWRITE          0x04
//#define IF_EXISTS_APPEND             0x08
//#define IF_EXISTS_RENAME             0x0c
//#define IF_EXISTS_ERROR              0x10
//#define IF_EXISTS_NEW_VERSION        0x14
//#define IF_EXISTS_SUPERSEDE          0x18
//#define IF_EXISTS_RENAME_AND_DELETE  0x1c
//#define IF_MISSING_MASK              0x60
//#define IF_MISSING_NIL               0x00
//#define IF_MISSING_CREATE            0x20
//#define IF_MISSING_ERROR             0x40
//#define OPEN_BINARY                  0x80
//#define OPEN_PIPE                    0x100

class InternalOpenFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (!(arg1 instanceof LispString)) 
            return error("argument 1 to ~open must be a string");
        String name = ((LispString)arg1).string;
        int bits = ((LispSmallInteger)arg2).value;
        if ((bits & 0x100) != 0) return openPipe(name, bits);
        String localName = LispStream.nameConvert(name);
        File f = new File(localName);
        boolean x = f.exists();
        LispObject r;
        switch (bits & 3)
        {
    case 0: // probe
            if (x) return Jlisp.lispTrue;
            else return Jlisp.nil;
    case 1: // read
            if (!x)
            {   switch (bits & 0x60)
                {
            case 0x00: return Jlisp.nil;
            case 0x40: return Jlisp.error("File does not exist: " + name);
            default:   return Jlisp.error("File open mode unknown " +
                              Integer.toHexString(bits));
                }
            }
            r = Jlisp.nil;
            try
            {   r = new LispStream(
                    name,
                    new BufferedReader(
                        new FileReader(f)),
                    false, true);
            }
            catch (FileNotFoundException e) // should not happen!
            {   return error("File " + name + " not found");
            }
            return r;
    case 2: // write
            r = Jlisp.nil;
            try
            {   if (x)
                {   switch (bits & 0x1c)
                    {
                case 0x00: return Jlisp.nil;
                case 0x14: // new version: treat as overwrite...
                case 0x04: return new LispOutputStream(f);
// the "append" option seems to have to be opened based on a String not a File
                case 0x08: return new LispOutputStream(localName, true);
                case 0x10: return error("File already exists: " + name);
                default:   return error("Unsupported file open mode: " +
                                        Integer.toHexString(bits));
                    }
                }
                else r = new LispOutputStream(f);
            }
            catch (IOException e)
            {   return Jlisp.nil;
            }
            return r;
    case 3: // input and output
            return error("simultaneous input+output mode files not supported");
        }
        return Jlisp.nil;
    }

    public LispObject openPipe(String name, int bits) throws Exception
    {
        return error("pipes not supported by Java, it seems?");
    }

}

class Open_libraryFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Open_urlFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class OrderpFn extends BuiltinFunction
{
//  symbolic procedure ordp(u,v);
//     if null u then null v
//      else if null v then t
//      else if vectorp u then if vectorp v then ordpv(u,v) else atom v
//      else if atom u
//       then if atom v
//              then if numberp u then numberp v and not u<v
//                    else if idp v then orderp(u,v)
//                    else numberp v
//             else nil
//      else if atom v then t
//      else if car u=car v then ordp(cdr u,cdr v)
//      else if flagp(car u,'noncom)
//       then if flagp(car v,'noncom) then ordp(car u,car v) else t
//      else if flagp(car v,'noncom) then nil
//      else ordp(car u,car v);
//

    public LispObject op2(LispObject u, LispObject v) throws Exception
    {   if (ordp(u,v)) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }

    boolean ordp(LispObject u, LispObject v) throws Exception
    {
        if (u == Jlisp.nil) return (v == Jlisp.nil);
        else if (v == Jlisp.nil) return true;
        else if (u instanceof LispVector)
	{  if (v instanceof LispVector) 
               return ordv((LispVector)u, (LispVector)v);
           else return v.atom;
        }
        else if (u.atom)
	{   if (v.atom)
	    {   if (u instanceof LispNumber)
	        {   if (!(v instanceof LispNumber)) return false;
                    return (Fns.lessp(u, v) == Jlisp.nil);
                }
                else if (v instanceof Symbol)
		{   if (!(u instanceof Symbol)) return false;
                    return ((Symbol)u).pname.compareTo(
                        ((Symbol)v).pname) <= 0;
	        }
                else return (v instanceof LispNumber);
            }
            else return false;
        }
        else if (v.atom) return true;
        LispObject cu = u, cv = v;
	LispObject caru = cu.car, carv = cv.car;
        if (caru.lispequals(carv))
	    return ordp(cu.cdr, cv.cdr);
        else if (Fns.get(caru, Jlisp.lit[Lit.noncom]) !=
	         Jlisp.nil)
	{   if (Fns.get(carv, Jlisp.lit[Lit.noncom]) !=
	        Jlisp.nil)
                return ordp(caru, carv);
            else return true;
        }
        else if (Fns.get(carv, Jlisp.lit[Lit.noncom]) !=
	         Jlisp.nil)
            return false;
        else return ordp(caru, carv);
    }

    boolean ordv(LispVector u, LispVector v)
    {
        return false;
    }
}

class Output_libraryFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class PagelengthFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class PairFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (!arg1.atom)
        {   if (!arg2.atom)
	    {    return new Cons(
                     new Cons(arg1.car, arg2.car),
                     op2(arg1.cdr, arg2.cdr));
	    }
            else return error("arg2 to pair is too short");
        }
        else if (!arg2.atom)
            return error("arg2 to pair is too long");
        else return Jlisp.nil;
    }
}

class PairpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {   return arg1.atom ? Jlisp.nil :
               Jlisp.lispTrue;
    }
}

class PeekchFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Pipe_openFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class PlistFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return ((Symbol)arg1).cdr/*plist*/;
    }
}

class PosnFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        int n = ((LispStream)
            Jlisp.lit[Lit.std_output].car/*value*/).column;
        return LispInteger.valueOf(n);
    }
}

class RestartFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Jlisp.backtrace = false;
        throw new ProgEvent(ProgEvent.RESTART, arg1, "restart");
    }
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        Jlisp.backtrace = false;
        throw new ProgEvent(ProgEvent.RESTART, arg1, arg2, "restart");
    }
}

// (preserve [restartfn [initmsg]])
//                 dumps all state to a file specifed
//                 as "-o xxx.img" on the initial command-line.

class PreserveFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    { 
        return op2(Jlisp.nil, Jlisp.nil); 
    }

    public LispObject op1(LispObject arg1) throws Exception
    {
        return op2(arg1, Jlisp.nil);
    }

    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
// Following the tradition from CSL when the user calls PRESERVE the
// system stops. This makes more sense than one might have thought since
// in the process of unwinding (via the ProgEvent you see here) all fluid
// variables are put back to their top level values. If I checkpointed
// the system more directly various local bindings might be captured, and
// I think that would be undesirable.
        if (Jlisp.outputImagePos < 0)
	    return Jlisp.error("No output image available");
        Jlisp.backtrace = false;
        throw new ProgEvent(ProgEvent.PRESERVE,
	    new Cons(arg1, arg2),
	    "preserve");
    }
}

class SaveObjectFn extends BuiltinFunction
{

    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
	String name = ((LispString)arg1).string;
	GZIPOutputStream dump = null;
        try
        {   dump = new GZIPOutputStream(
	               new BufferedOutputStream(
	                   new FileOutputStream(name),
		           32768));
	    Jlisp.dumpTree(arg2, dump);
        }
        catch (IOException e)
        {   Jlisp.errprintln("IO error on dump file: " + e.getMessage());
        }
        finally
	{   if (dump != null) dump.close();
        }
        return Jlisp.nil;
    }
}

class RestoreObjectFn extends BuiltinFunction
{

    public LispObject op1(LispObject arg1) throws Exception
    {
        return op2(arg1, LispInteger.valueOf(1));
    }
    
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
	String name = ((LispString)arg1).string;
// read item number n from the file concerned. Used to debug!
	int n = ((LispSmallInteger)arg2).value;
	LispObject r = Jlisp.nil;
	Jlisp.idump = null;
        try
        {   GZIPInputStream dump = 
	        new GZIPInputStream(
		    new BufferedInputStream(
	                new FileInputStream(name),
		        32768));
	    Jlisp.idump = dump;
	    Jlisp.preRestore();
	    Jlisp.descendSymbols = false;
	    for (int i=0; i<n; i++)
	        r = Jlisp.readObject();
        }
        catch (IOException e)
        {   Jlisp.errprintln("IO error on dump file: " + e.getMessage());
        }
        finally
	{   if (Jlisp.idump != null) Jlisp.idump.close();
	    Jlisp.postRestore();
        }
	if (r == null) return new LispString("<null>");
        else return r;
    }
}

class PrinFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printEscape);
        return arg1;
    }
}

class Prin1Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printEscape);
        return arg1;
    }
}

class Prin2Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(0);
        return arg1;
    }
}

class Prin2aFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.noLineBreak);
        return arg1;
    }
}

class PrinbinaryFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printBinary);
        return arg1;
    }
}

class PrincFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print();
        return arg1;
    }
}

class Princ_downcaseFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printLower);
        return arg1;
    }
}

class Princ_upcaseFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printUpper);
        return arg1;
    }
}

class PrinhexFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printHex);
        return arg1;
    }
}

class PrinoctalFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printOctal);
        return arg1;
    }
}

class PrintFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print(LispObject.printEscape);
        Jlisp.println();
        return arg1;
    }
}

class PrintcFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        arg1.print();
        Jlisp.println();
        return arg1;
    }
}

class PrintpromptFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Prog1Fn extends BuiltinFunction
{
    public LispObject op0()
    {
        return Jlisp.nil;
    }
    public LispObject op1(LispObject arg1)
    {
        return arg1;
    }
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        return arg1;
    }
    public LispObject opn(LispObject [] args)
    {
        return args[0];
    }
}

class Prog2Fn extends BuiltinFunction
{
    public LispObject op0()
    {
         return Jlisp.nil;
    }
    public LispObject op1(LispObject arg1)
    {
         return Jlisp.nil;
    }
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        return arg2;
    }
    public LispObject opn(LispObject [] args)
    {
        return args[1];
    }
}

class PrognFn extends BuiltinFunction
{
    public LispObject op0()
    {
         return Jlisp.nil;
    }

    public LispObject op1(LispObject arg1)
    {
        return arg1;
    }
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        return arg2;
    }
    public LispObject opn(LispObject [] args)
    {
        return args[args.length-1];
    }

}

class PutFn extends BuiltinFunction
{
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("put called with " + args.length +
                "args when 3 expected");
        return Fns.put((Symbol)args[0], args[1], args[2]);
    }
}

class PuthashFn extends BuiltinFunction
{
    public LispObject op2(LispObject key, LispObject value)
    {
        ((LispHash)Jlisp.lit[Lit.hashtab]).hash.put(key, value);
        return value;
    }
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("puthash called with " + args.length +
                "args when 2 or 3 expected");
        LispObject key = args[0];
        LispHash h = (LispHash)args[1];
        LispObject value = args[2];
        h.hash.put(key, value);
        return value;
    }
}

class PutvFn extends BuiltinFunction
{
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("putv called with " + args.length +
                "args when 3 expected");
        LispVector v = (LispVector)args[0];
        LispSmallInteger n = (LispSmallInteger)args[1];
        int i = n.value;
        v.vec[i] = args[2];
        return args[2];
    }

}

class Putv_charFn extends BuiltinFunction
{
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("putv-char called with " + args.length +
                "args when 3 expected");
        String v = ((LispString)args[0]).string;
        LispSmallInteger n = (LispSmallInteger)args[1];
        int i = n.value;
	char [] v1 = v.toCharArray();
	v1[i] = (char)(((LispSmallInteger)args[2]).value);
        ((LispString)args[0]).string = new String(v1);
        return args[2];
    }
}

class Putv16Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Putv32Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Putv8Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class QcaarFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return arg1.car.car;
    }
}

class QcadrFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return arg1.cdr.car;
    }
}

class QcarFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return arg1.car;
    }
}

class QcdarFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return arg1.car.cdr;
    }
}

class QcddrFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return arg1.cdr.cdr;
    }
}

class QcdrFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return arg1.cdr;
    }
}

class QgetvFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        LispVector v = (LispVector)arg1;
        return v.vec[((LispSmallInteger)arg2).value];
    }
}

class QputvFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class RassocFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class RdfFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (!(arg1 instanceof LispString))
            return error("argument for rdf should be a string");
        String name = ((LispString)arg1).string;
        LispObject save = Jlisp.lit[Lit.std_input].car/*value*/;
        try
	{   Jlisp.lit[Lit.std_input].car/*value*/ =
                new LispStream(
                    name,
                    new BufferedReader(
                        new FileReader(LispStream.nameConvert(name))),
                    false, true);
            try
            {   Jlisp.println();
	        // here I really want the simple READ-EVAL-PRINT
		// without any messing with any restart function.
                Jlisp.restarting = false; // just to be ultra-careful!
                Jlisp.readEvalPrintLoop(true);
            }
            finally
	    {   ((LispStream)Jlisp.lit[Lit.std_input].car/*value*/).close();
            }
        }
        catch (FileNotFoundException e)
	{   return error("Unable to read from \"" +
                         name + "\"");
        }
        finally
	{   Jlisp.lit[Lit.std_input].car/*value*/ = save;
            Jlisp.println("+++ end of reading " + name);
        }
        return Jlisp.nil;
    }
}

class RdsFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
// The issue of what to select if the user says (rds nil) is a bit horrid
// here in terms of how it should react with the user also re-setting
// or re-binding !*std-input!* and the other related variables. Here I
// do something that probably works well enough for REDUCE...
        if (arg1 == Jlisp.nil) arg1 = Jlisp.lit[Lit.terminal_io].car/*value*/;
        LispObject prev = Jlisp.lit[Lit.std_input].car/*value*/;
        Jlisp.lit[Lit.std_input].car/*value*/ = (LispStream)arg1;
        return prev;
    }
}

class ReadFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        LispObject w = Jlisp.lit[Lit.eof];
	try
	{   w = Jlisp.read();
	}
        catch (EOFException e)
        {   return Jlisp.lit[Lit.eof];
        }
	catch (IOException e)
	{   Jlisp.errprintln("Reader error: " + e.getMessage());
	}
	return w;
    }
}

class ReadchFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        try
	{   int ch;
            do
            {   ch = ((LispStream)Jlisp.lit[Lit.std_input].car/*value*/
                     ).readChar();
            } while (ch == '\r');          // wary of Windows (& DOS)
            if (ch < 0) return Jlisp.lit[Lit.eof];
            else if (ch < 128) return Jlisp.chars[ch];
            else return Symbol.intern(String.valueOf((char)ch));
        }
        catch (IOException e)
        {   return error("IO error detected in readch");
        }
    }
}

class ReadlineFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        StringBuffer s = new StringBuffer();
        LispObject sr = Jlisp.lit[Lit.raise].car/*value*/;
        LispObject sl = Jlisp.lit[Lit.lower].car/*value*/;
        Jlisp.lit[Lit.raise].car/*value*/ = Jlisp.nil;
        Jlisp.lit[Lit.lower].car/*value*/ = Jlisp.nil;
	try
	{   int c;
            boolean any = false;
            LispStream r = (LispStream)Jlisp.lit[Lit.std_input].car/*value*/;
	    while ((c = r.readChar()) != '\n' &&
	           c != -1)
	    {   if (c != '\r') 
                {   s.append((char)c);
                    any = true;
                }
	    }
            if (c == -1 && !any) return Jlisp.lit[Lit.eof];
	    else return new LispString(new String(s));
	}
	catch (IOException e)
        {   return error("IO error detected in readline");
	}
        finally
        {   Jlisp.lit[Lit.raise].car/*value*/ = sr;
            Jlisp.lit[Lit.lower].car/*value*/ = sl;
        }
    }
    public LispObject op1(LispObject a1) throws Exception
    {
        StringBuffer s = new StringBuffer();
        LispObject sr = Jlisp.lit[Lit.raise].car/*value*/;
        LispObject sl = Jlisp.lit[Lit.lower].car/*value*/;
        Jlisp.lit[Lit.raise].car/*value*/ = Jlisp.nil;
        Jlisp.lit[Lit.lower].car/*value*/ = Jlisp.nil;
	try
	{   int c;
            boolean any = false;
            LispStream r = (LispStream)a1;
	    while ((c = r.readChar()) != '\n' &&
	           c != -1)
	    {   if (c != '\r')
                {   s.append((char)c);
                    any = true;
                }
	    }
	    if (c == -1 && !any) return Jlisp.lit[Lit.eof];
	    else return new LispString(new String(s));
	}
	catch (IOException e)
        {   return error("IO error detected in readline");
	}
        finally
        {   Jlisp.lit[Lit.raise].car/*value*/ = sr;
            Jlisp.lit[Lit.lower].car/*value*/ = sl;
        }
    }
}

class ReclaimFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class RemdFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Symbol a = (Symbol)arg1;
	a.fn = new Undefined(a.pname);
	return a;
    }
}

class RemflagFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        while (!arg1.atom)
	{   LispObject p = arg1;
            Symbol s = (Symbol)p.car;
            arg1 = p.cdr;
            Fns.remprop(s, arg2);
        }
        return Jlisp.nil;
    }
}

class RemhashFn extends BuiltinFunction
{
    public LispObject op1(LispObject key)
    {
        LispObject r = (LispObject)
	    ((LispHash)Jlisp.lit[Lit.hashtab]).hash.remove(key);
        if (r == null) r = Jlisp.nil;
        return r;
    }
    public LispObject op2(LispObject key, LispObject table)
    {
        LispHash h = (LispHash)table;
        LispObject r = (LispObject)h.hash.remove(key);
        if (r == null) r = Jlisp.nil;
        return r;
    }
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("remhash called with " + args.length +
                "args when 1 to 3 expected");
        LispObject key = args[0];
        LispHash h = (LispHash)args[1];
        LispObject defaultValue = args[2];
        LispObject r = (LispObject)h.hash.remove(key);
        if (r == null) r = defaultValue;
        return r;
    }
}

class RemobFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class RempropFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (!(arg1 instanceof Symbol)) return Jlisp.nil;
        else return Fns.remprop((Symbol)arg1, arg2);
    }
}

class Rename_fileFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        String s;
        if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
        else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
        else return Jlisp.nil;
        String s1;
        if (arg2 instanceof Symbol) s1 = ((Symbol)arg2).pname;
        else if (arg2 instanceof LispString) s1 = ((LispString)arg2).string;
        else return Jlisp.nil;
        return LispStream.fileRename(s, s1);
    }
}

class RepresentationFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class ReturnFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws ProgEvent
    {
        Specfn.progEvent = Specfn.RETURN;
        Specfn.progData = arg1;
        return arg1;
    }
}

class ReverseFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        LispObject r = Jlisp.nil;
        while (!arg1.atom)
	{   LispObject a = arg1;
            r = new Cons(a.car, r);
            arg1 = a.cdr;
        }
        return r;
    }
}

class ReversipFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        LispObject r = Jlisp.nil;
        while (!arg1.atom)
	{   LispObject a = arg1;
            arg1 = a.cdr;
            a.cdr = r;
            r = a;
        }
        return r;
    }
}

class RplacaFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (arg1.atom) return error("bad arg to rplaca");
        arg1.car = arg2;
        return arg1;
    }
}

class RplacdFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (arg1.atom) return error("bad arg to rplacd");
        arg1.cdr = arg2;
        return arg1;
    }
}

class RplacwFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (arg1.atom || arg2.atom) return error("bad arg to rplacw");
        arg1.car = arg2.car;
        arg1.cdr = arg2.cdr;
        return arg1;
    }
}

class RseekFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class RtellFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class SampleFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class SassocFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class ScharFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        int n = ((LispSmallInteger)arg2).value;
        String s = ((LispString)arg1).string;
        char ch = s.charAt(n);
        if (ch < 128) return Jlisp.chars[ch];
        else return Symbol.intern(String.valueOf((char)ch));
    }
}

class SeprpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        // blank end-of-line tab form-fee carriage-return
        if (arg1 == Jlisp.lit[Lit.space] ||
	    arg1 == Jlisp.lit[Lit.newline] ||
	    arg1 == Jlisp.lit[Lit.tab] ||
	    arg1 == Jlisp.lit[Lit.formFeed] ||
	    arg1 == Jlisp.lit[Lit.cr])
	    return Jlisp.lispTrue;
	else return Jlisp.nil;
    }
}

class SetFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        ((Symbol)arg1).car/*value*/ = arg2;
        return arg2;
    }
}

class Set_autoloadFn extends BuiltinFunction
{
    public LispObject op2(LispObject name, LispObject data) throws Exception
    {
	Symbol f = (Symbol)name;
	if (data.atom)
	    data = new Cons(data, Jlisp.nil);
	f.fn = new AutoLoad(f, data);
	return name;
    }
}

class Set_help_fileFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Set_print_precisionFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        int n = Jlisp.printprec;
        Jlisp.printprec = ((LispSmallInteger)arg1).value;
        return LispInteger.valueOf(n);
    }
}

class SetpcharFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        String old = Fns.prompt;
        if (old == null) old = "";     // just in case!
        if (arg1 instanceof LispString)
            Fns.prompt = ((LispString)arg1).string;
        else if (arg1 instanceof Symbol)
            Fns.prompt = ((Symbol)arg1).pname;
        else Fns.prompt = null;  // use system default
        return new LispString(old);
    }
}

class Simple_string_pFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        if (arg1 instanceof LispString) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }
}

class Simple_vector_pFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        if (arg1 instanceof LispVector) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }
}

class SmemqFn extends BuiltinFunction
{

    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        while (!arg2.atom)
	{   LispObject a = arg2;
            if (a.car == Jlisp.lit[Lit.quote]) return Jlisp.nil;
            else if (op2(arg1, a.car) != Jlisp.nil)
                return Jlisp.lispTrue;
            else arg2 = a.cdr;
        }
        if (arg1 == arg2) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }
}

class SpacesFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        int n = ((LispSmallInteger)arg1).value;
        for (int i=0; i<n; i++)
            Jlisp.print(" ");
        return Jlisp.nil;
    }
}

class Special_charFn extends BuiltinFunction
{

    public LispObject op1(LispObject arg1) throws Exception
    {
        LispSmallInteger a = (LispSmallInteger)arg1;
        int n = a.value;
	LispObject [] t = Jlisp.lit;
	switch (n)
	{
    case 0:  return t[Lit.space];
    case 1:  return t[Lit.newline];
    case 2:  return t[Lit.backspace];
    case 3:  return t[Lit.tab];
    // case 4: vertical tab
    case 5:  return t[Lit.formFeed];
    case 6:  return t[Lit.cr];
    case 7:  return t[Lit.rubout];
    case 8:  return t[Lit.eof];
    // case 9: attention (^G ??)
    case 10: return t[Lit.escape];
    default: return Jlisp.nil;
	}
    }
}

class Special_form_pFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {   return (arg1 instanceof Symbol &&
                ((Symbol)arg1).special != null) ? 
               Jlisp.lispTrue :
               Jlisp.nil;
    }
}

class SpoolFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Start_moduleFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return Fasl.startModule(arg1);
    }
}

// (stop) exist from this Lisp.

class StopFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Jlisp.println();
        Jlisp.backtrace = false;
        throw new ProgEvent(ProgEvent.STOP, arg1, "STOP function called");
    }
}

class StreampFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return arg1 instanceof LispStream ?
               Jlisp.lispTrue : 
               Jlisp.nil;
    }
}

class StringpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return arg1 instanceof LispString ? Jlisp.lispTrue :
               Jlisp.nil;
    }
}

class Stub1Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return Jlisp.nil;
    }
}

class Stub2Fn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
	return Jlisp.nil;
    }
}

class SublaFn extends BuiltinFunction
{
    public LispObject op2(LispObject u, LispObject v) throws Exception
    {
        if (u == Jlisp.nil ||
            v == Jlisp.nil) return v;
        else if (v.atom)
	{   while (!u.atom)
	    {   LispObject cu = u;
                u = cu.cdr;
                if (cu.car.atom) continue;
                LispObject ccu = cu.car;
                if (v instanceof LispNumber)                   // @@@
                {   if (v.lispequals(ccu.car)) return ccu.car; // @@@
                }                                              // @@@
                else if (ccu.car == v) return ccu.cdr;
            }
            return v;
        }
        LispObject cv = v;
        LispObject y = new Cons(
            op2(u, cv.car),
            op2(u, cv.cdr));
        if (y.lispequals(v)) return v;
        else return y; 
    }
}

class SublisFn extends BuiltinFunction
{
    public LispObject op2(LispObject al, LispObject x) throws Exception
    {
        LispObject a = al;
        while (!a.atom)
	{   LispObject c = a;
            a = c.cdr;
            if (c.car.atom) continue;
            LispObject cc = c.car;
            if (cc.car.lispequals(x)) return cc.cdr;
        }
        if (x.atom) return x;
        LispObject cx = x;
        LispObject aa = op2(al, cx.car);
        LispObject bb = op2(al, cx.cdr);
        if (aa == cx.car && bb == cx.cdr) return x;
        else return new Cons(aa, bb);
    }
}

class SubstFn extends BuiltinFunction
{
    public LispObject opn(LispObject [] args) throws Exception
    {
        if (args.length != 3)
            return error("subst called with " + args.length +
                "args when 1 to 3 expected");
        return subst(args[0], args[1], args[2]);
    }

    LispObject subst(LispObject a, LispObject b, LispObject c)
    {
        if (b.lispequals(c)) return a;
        if (c.atom) return c;
        LispObject cc = c;
        LispObject aa = subst(a, b, cc.car);
        LispObject bb = subst(a, b, cc.cdr);
        if (aa == cc.car && bb == cc.cdr) return c;
        else return new Cons(aa, bb);
    }
}

class SxhashFn extends BuiltinFunction
{ // use md60 here...
    public LispObject op1(LispObject arg1) throws Exception
    {
        LispStream f = new LispDigester();
        LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
        try
        {   Jlisp.lit[Lit.std_output].car/*value*/ = f;
            arg1.print(LispObject.noLineBreak+LispObject.printEscape);
        }
        finally
        {   Jlisp.lit[Lit.std_output].car/*value*/ = save;
        }
        byte [] res = f.md.digest();
        return LispInteger.valueOf(new BigInteger(res).shiftRight(68));
    }
}

class Symbol_argcountFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Symbol_envFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        if (!(arg1 instanceof Symbol)) return Jlisp.nil;
        LispFunction f = ((Symbol)arg1).fn;
        if (f instanceof FnWithEnv)
            return new LispVector(((FnWithEnv)f).env);
        else return Jlisp.nil;
    }
}

class Symbol_fastgetsFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Symbol_fn_cellFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        LispFunction f = ((Symbol)arg1).fn;
        if (f instanceof Undefined) return Jlisp.nil;
        else return f;
    }
}

class Symbol_functionFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return ((Symbol)arg1).fn;
    }
}

class Symbol_make_fastgetFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return Jlisp.nil;
    }
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        return Jlisp.nil;
    }
}

class Symbol_nameFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return new LispString(((Symbol)arg1).pname);
    }
}

class Symbol_protectFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Symbol_set_definitionFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        Symbol a1 = (Symbol)arg1;
        if (!arg2.atom)
	{   LispObject a2 = arg2;
	    if (a2.car == Jlisp.lit[Lit.lambda])
	    {   a1.fn = new Interpreted(a2.cdr);
		return arg1;
	    }
	    else if (a2.car instanceof LispInteger)
	    {   int nargs = a2.car.intValue();
                int nopts = nargs >> 8;
                int flagbits = nopts >> 8;
                int ntail = flagbits >> 2;
                nargs &= 0xff;
                nopts &= 0xff;
                flagbits &= 0x03;
// The next few cases are where a function is defined as a direct call
// to another, possibly discarding a few final args. Eg
//                          (de f (a b) (g a))
                if (ntail != 0)
                {   a1.fn = new CallAs(nargs, a2.cdr.cdr, ntail-1);
                    return arg1;
                }
                a2 = a2.cdr;
                if (a2.atom) return Jlisp.nil;
                Bytecode b = (Bytecode)a2.car;
                LispVector v = (LispVector)a2.cdr;
                if (flagbits != 0 || nopts != 0)
                {
// What is happening here is a MESS inherited from CSL.
//   nopts = number of optional args wanted
//   flagbits & 1   "hard case": pass Spid.noarg not nil for missing opts
//   flagbits & 2    &rest arg present
                    b = new ByteOpt(b.bytecodes, v.vec, 
                                    nargs, nopts, flagbits);
                }
                else 
                {   b.env = v.vec;
                    b.nargs = nargs;
                }
                a1.fn = b;
		return arg1;
	    }
	    // Otherwise drop through and moan
	}
	else if (arg2 instanceof Symbol)
	{   Symbol a2 = (Symbol)arg2;
	    a1.fn = a2.fn;
	    return arg1;
	}
	else if (arg2 instanceof LispFunction)
	{   a1.fn = (LispFunction)arg2;
	    return arg1;
	}
	// Unrecognised cases follow - just print a message
        Jlisp.println();
        arg1.print(LispObject.printEscape);
        Jlisp.print(" => ");
        arg2.print();
        Jlisp.println();
        return Jlisp.nil;
    }
}

class Symbol_set_envFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
        if (!(arg1 instanceof Symbol)) return Jlisp.nil;
        LispFunction f = ((Symbol)arg1).fn;
        if (f instanceof FnWithEnv) 
            ((FnWithEnv)f).env = ((LispVector)arg2).vec;
        else return Jlisp.nil; // quiet in case it fails?
        return arg2;
    }
}

class Symbol_set_nativeFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Symbol_valueFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        return ((Symbol)arg1).car/*value*/;
    }
}

class SymbolpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {   return arg1 instanceof Symbol ? Jlisp.lispTrue :
               Jlisp.nil;
    }
}

class SymerrFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class SystemFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        try
        {   Runtime r = Runtime.getRuntime();
	    r.exec(((LispString)arg1).string);
        }
        catch (IOException e)
        {   return Jlisp.nil;
        }
        catch (SecurityException e)
        {   return Jlisp.nil;
        }
	return Jlisp.lispTrue;
    }
}

class TagbodyFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class TerpriFn extends BuiltinFunction
{
    public LispObject op0()
    {
        Jlisp.println();
        return Jlisp.nil;
    }
}

class ThreevectorpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (arg1 instanceof LispVector &&
	    ((LispVector)arg1).vec.length == 3) return Jlisp.lispTrue;
	else return Jlisp.nil;
    }
}

class ThrowFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class TimeFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        return LispInteger.valueOf(System.currentTimeMillis());
    }
}

class TmpnamFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class TraceFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        while (!arg1.atom)
	{   Symbol n = (Symbol)arg1.car;
	    if (!(n.fn instanceof TracedFunction))
	        n.fn = new TracedFunction(n, n.fn);
	    arg1 = arg1.cdr;
	}
        return Jlisp.nil;
    }
}

class TracesetFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Traceset1Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class TtabFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        int n = ((LispSmallInteger)arg1).value;
        LispStream f = (LispStream)Jlisp.lit[Lit.std_output].car/*value*/;
        while (f.column < n) f.print(" ");
        return Jlisp.nil;
    }
}

class TyoFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Undouble_executeFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class UnfluidFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class UnglobalFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class UnionFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
    {
	while (!arg1.atom)
	{   LispObject a2 = arg2;
	    while (!a2.atom)
	    {   if (a2.car.lispequals(arg1.car)) break;
	        a2 = a2.cdr;
	    }
	    if (a2.atom)
	        arg2 = new Cons(arg1.car, arg2);
	    arg1 = arg1.cdr;
	}
	return arg2; 
    }
}

class Unmake_globalFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Fns.remprop((Symbol)arg1, Jlisp.lit[Lit.global]);
        return Jlisp.nil;
    }
}

class Unmake_specialFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        Fns.remprop((Symbol)arg1, Jlisp.lit[Lit.special]);
        return Jlisp.nil;
    }
}

class UnreadchFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class UntraceFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        while (!arg1.atom)
	{   Symbol n = (Symbol)arg1.car;
	    if (n.fn instanceof TracedFunction)
	        n.fn = ((TracedFunction)n.fn).fn;
	    arg1 = arg1.cdr;
	}
        return Jlisp.nil;
    }
}

class UntracesetFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Untraceset1Fn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Unwind_protectFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class UpbvFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        int n;
        if (arg1 instanceof LispString)
	    n = ((LispString)arg1).string.length();
        else if (arg1 instanceof LispVector)
            n = ((LispVector)arg1).vec.length;
        else return Jlisp.nil;
        return LispInteger.valueOf(n-1);
    }
}

class User_homedir_pathnameFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class VectorpFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (arg1 instanceof LispVector) return Jlisp.lispTrue;
        else return Jlisp.nil;
    }
}

class VerbosFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        int old = Jlisp.verbosFlag;
        if (arg1 instanceof LispInteger)
            Jlisp.verbosFlag = arg1.intValue();
        else if (arg1 == Jlisp.nil) Jlisp.verbosFlag = 0;
        else Jlisp.verbosFlag = 3;
        return LispInteger.valueOf(old);
    }
}

class Where_was_thatFn extends BuiltinFunction
{
    public LispObject op0() throws Exception
    {
        return new Cons(
	    new LispString("Unknown file"),
	    new Cons(LispInteger.valueOf(-1), Jlisp.nil));
    }
}

class Window_headingFn extends BuiltinFunction
{
    public LispObject op1(LispObject a) throws Exception
    {
        String s;
        if (a instanceof Symbol) s = ((Symbol)a).pname;
        else if (a instanceof LispString) s = ((LispString)a).string;
        else return Jlisp.nil;
// Note that I just dump this to output with no regard for Lisp output
// streams, buffering etc!
        if (Jlisp.standAlone) System.out.println(s);
        else
        {
            // in CWin case put string arg on window title-bar @@@@
        }
        return Jlisp.nil;
    }
}

class Startup_bannerFn extends BuiltinFunction
{
    public LispObject op1(LispObject a) throws Exception
    {
        // reset message displayed when Jlisp starts up @@@@
        // compressed heap images make this harder. I need to worry!
        return Jlisp.nil;
    }
}

class Writable_librarypFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Write_help_moduleFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class Write_moduleFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        if (Fasl.writer == null)
	    return error("no FASL file active in write-module");
	Fasl.faslWrite(arg1);
	return Jlisp.nil;
    }
}

class WrsFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
// see comments for Rds.
        if (arg1 == Jlisp.nil) arg1 = Jlisp.lit[Lit.terminal_io].car/*value*/;
        LispObject prev = Jlisp.lit[Lit.std_output].car/*value*/;
        Jlisp.lit[Lit.std_output].car/*value*/ = (LispStream)arg1;
        return prev;
    }
}

class XassocFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class XconsFn extends BuiltinFunction
{
    public LispObject op2(LispObject arg1, LispObject arg2)
    {
        return new Cons(arg2, arg1);
    }
}

class XdifferenceFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}

class XtabFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1)
    {
        int n = ((LispSmallInteger)arg1).value;
        LispStream f = (LispStream)Jlisp.lit[Lit.std_output].car/*value*/;
        for (int i=0; i<n; i++) f.print(" ");
        return Jlisp.nil;
    }
}

class TyiFn extends BuiltinFunction
{
    public LispObject op1(LispObject arg1) throws Exception
    {
        return error(name + " not yet implemented");
    }
}


}

// end of Fns3.java



REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]