Exemple #1
0
    bool AttemptDirtyAdd( VALUE v ) {
        if (RefCount > 1 || !_rest.IsNil()) {
            return false;        
        }
        LIST c;
        c.SetListPointer( (uintptr_t)Cons::Create( v, LIST() ) );
//        c.MaterializeAsCons( v, NIL() );
        SetRest(c);
        return true;
    }
Exemple #2
0
FObject ReverseListModify(FObject list)
{
    FObject rlist = EmptyListObject;

    while (list != EmptyListObject)
    {
        FAssert(PairP(list));

        FObject obj = list;
        list = Rest(list);
//        AsPair(obj)->Rest = rlist;
        SetRest(obj, rlist);
        rlist = obj;
    }

    return(rlist);
}
Exemple #3
0
int main(int argc, char * argv[])
#endif // FOMENT_UNIX
{
    int_t pdx = 0;
    int adx = 1;
    while (adx < argc)
    {
        if (StringCompareS(argv[adx], "-A") == 0)
            adx += 2;
        else if (StringCompareS(argv[adx], "-I") == 0)
            adx += 2;
        else if (StringCompareS(argv[adx], "-X") == 0)
            adx += 2;
        else if (argv[adx][0] != '-')
        {
            pdx = adx;
            break;
        }
        else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0)
        {
            InlineProcedures = 0;
            adx += 1;
        }
        else if (StringCompareS(argv[adx], "-no-inline-imports") == 0)
        {
            InlineImports = 0;
            adx += 1;
        }
        else if (StringCompareS(argv[adx], "--validate-heap") == 0)
        {
            ValidateHeap = 1;
            adx += 1;
        }
#ifdef FOMENT_WINDOWS
        else if (StringCompareS(argv[adx], "--section-table") == 0)
        {
            adx += 1;

            if (adx < argc)
            {
#ifdef FOMENT_32BIT
                SectionTableBase = (void *) wcstol(argv[adx], 0, 16);
#endif // FOMENT_32BIT
#ifdef FOMENT_64BIT
                SectionTableBase = (void *) _wcstoui64(argv[adx], 0, 16);
#endif // FOMENT_64BIT

                adx += 1;
            }
        }
#endif // FOMENT_WINDOWS
        else if (StringCompareS(argv[adx], "--random-seed") == 0)
        {
            adx += 1;

            if (adx < argc)
            {
                RandomSeed = StringToInt(argv[adx]);
                adx += 1;
            }
        }
        else
            break;
    }

    FThreadState ts;

    try
    {
        SetupFoment(&ts);

        if (pdx > 0)
        {
            AddToLibraryPath(argv[pdx]);
        }
    }
    catch (FObject obj)
    {
        printf("Unexpected exception: SetupFoment: %p\n", obj);
        WriteSimple(R.StandardOutput, obj, 0);

        if (ValidateHeap)
        {
            FailedGC();
            FailedExecute();
        }
        return(1);
    }

    FAssert(argc >= 1);

    try
    {
        int adx = 1;
        while (adx < argc)
        {
            if (StringCompareS(argv[adx], "-A") == 0)
            {
                adx += 1;

                if (adx == argc)
                    return(MissingArgument(argv[adx - 1]));

                FObject lp = R.LibraryPath;

                for (;;)
                {
                    FAssert(PairP(lp));

                    if (Rest(lp) == EmptyListObject)
                        break;
                    lp = Rest(lp);
                }

//                AsPair(lp)->Rest = MakePair(MakeStringS(argv[adx]), EmptyListObject);
                SetRest(lp, MakePair(MakeStringS(argv[adx]), EmptyListObject));

                adx += 1;
            }
            else if (StringCompareS(argv[adx], "-I") == 0)
            {
                adx += 1;

                if (adx == argc)
                    return(MissingArgument(argv[adx - 1]));

                R.LibraryPath = MakePair(MakeStringS(argv[adx]), R.LibraryPath);

                adx += 1;
            }
            else if (StringCompareS(argv[adx], "-X") == 0)
            {
                adx += 1;

                if (adx == argc)
                    return(MissingArgument(argv[adx - 1]));

                R.LibraryExtensions = MakePair(MakeStringS(argv[adx]), R.LibraryExtensions);

                adx += 1;
            }
            else if (StringCompareS(argv[adx], "-no-inline-procedures") == 0
                     || StringCompareS(argv[adx], "-no-inline-imports") == 0
                     || StringCompareS(argv[adx], "--validate-heap") == 0)
                adx += 1;
#ifdef FOMENT_WINDOWS
            else if (StringCompareS(argv[adx], "--section-table") == 0)
                adx += 2;
#endif // FOMENT_WINDOWS
            else if (StringCompareS(argv[adx], "--random-seed") == 0)
                adx += 2;
            else if (argv[adx][0] != '-')
                return(ProgramMode(adx, argc, argv));
            else
                break;
        }

        R.LibraryPath = ReverseListModify(MakePair(MakeStringC("."), R.LibraryPath));
        R.CommandLine = MakePair(MakeInvocation(adx, argv),
                                 MakeCommandLine(argc - adx, argv + adx));

        ExecuteThunk(R.InteractiveThunk);
        ExitFoment();
        return(0);
//        return(RunRepl(GetInteractionEnv()));
    }
    catch (FObject obj)
    {
        if (ExceptionP(obj) == 0)
            WriteStringC(R.StandardOutput, "exception: ");
        WriteSimple(R.StandardOutput, obj, 0);
        WriteCh(R.StandardOutput, '\n');

        if (ValidateHeap)
        {
            FailedGC();
            FailedExecute();
        }
        return(-1);
    }
}
Exemple #4
0
 Cons( VALUE first, VALUE rest ) : List() {
     SetFirst( first );
     SetRest( rest );
 }