#!/bin/sh
VERSION_NAME="$1"
shift
LISP=$1
CORENAME=$2
LEMLDIR=$3
DIRNAME=`echo $3 | sed -e 's|/$||'`
#LODIR=`dirname $DIRNAME`
LODIR=/usr/local/caml/V2-6.1/lo
#FINDVERSION="cd `dirname $0`; echo "'`basename $cwd`'
#VERSION=`echo $FINDVERSION | csh -f`
VERSION=V2-6.1
ERSION=`echo $VERSION | sed -e '1s/.\(.*\)/\1/'`
DATE=`/bin/date`
#DATE='Fri Nov 24 1989'
CWD=`pwd`; export CWD
echo "CORENAME= $CORENAME , LEMLDIR= $LEMLDIR , LODIR= $LODIR"
echo "DATE= $DATE , CWD= $CWD , LISP = $LISP"
time $LISP << END

(setq CAML_debug ())

(load "$LODIR/F-patch.lo")
(valfn 'openi)
(valfn '#:new:openi)

;(if (typefn 'security-on)
;    (security-on)
;    (load "$LODIR/../camlisp/MACHINE/security.ll")
;    (security-on))

(setq #:system:read-case-flag t)
(setq #:system:print-msgs 0)
(setq #:user:redef-flag t)
(setq #:user:loaded-from-file "CAML")

(unless (boundp 'lazy) (setq lazy (getenv "LAZY")))
;(unless (boundp 'compatible) (setq compatible (getenv "COMPATIBLE")))
(setq compatible t)
(unless (boundp 'parallel) (setq parallel (getenv "PARALLEL")))

(defun load-obj (s)
    (if CAML_debug
        (print (tag CAML_exception
                    (caml_loadfile (catenate '$LODIR/ s (if lazy ".llo" ".lo"))
                        t)))
        (caml_loadfile (catenate '$LODIR/ s (if lazy ".llo" ".lo")) t)
))

(print (catenate "You are making Le new "
                 (if lazy (if parallel "Parallel " "Lazy ")) "CAML"))

(gc t)

(defvar bp ())
(defvar tp ())
(ifn (boundp '#:llcp:bp) (defvar #:llcp:bp (loc 'bp)))
(ifn (boundp '#:llcp:tp) (defvar #:llcp:tp (loc 'tp)))
(ifn (typefn 'ml_iappl) (load "$LODIR/F-exc.lo"))
(ifn (typefn 'c12a7r) (load-obj "F-cadr"))
(if lazy (ifn (typefn 'lml_force) (load-obj "F-force")))

(load-obj "F-lelisp")


(load-obj "F-load")

(ml_loader '(101 (mov nil a2) (mov nil a3) (jmp ml_loader_dir) (eval (mlentry))
    (mov (eval (mlquote 102 '(()))) a1) (mov (@ 101) (cdr a1))
    (mov (eval (mlquote 102 '(()))) a1) (return) (end)) ())
(defvar ml_loader_dir (ml_run))

(ml_loader '(101 (jmp ml_run_dir) (eval (mlentry))
    (mov (eval (mlquote 102 '(()))) a1) (mov (@ 101) (cdr a1))
    (mov (eval (mlquote 102 '(()))) a1) (return) (end)) ())
(defvar ml_run_dir (ml_run))

(de test_caml_version () (raise '(7 . "Incompatible code file")))
(de check_version (version name) ())

(load-obj "F-hash")
;(de gcalarm () (print (gcinfo)))
(synonymq run ml_run)
(print "get_global_exc failure -->" (get_global_exc "failure"))
(load-obj "F-glob")
(print "get_global_exc failure -->" (get_global_exc "failure"))
(load-obj "glob")

(loader'((fentry check_version subr2)
    (push a2)
    (push a1)
    (mov '"caml_version" a1)
    (jcall get_global_sysvalue)
    (pop a2)
    (mov (car a1) a1)
    (jcall eqstring)
    (btnil a1 103)
    (mov '"caml_name" a1)
    (jcall get_global_sysvalue)
    (pop a2)
    (mov (car a1) a1)
    (jcall eqstring)
    (bfnil a1 101)
103
    (mov '(7 . "Incompatible code file") a1)
    (jmp raise)
101
    (mov nil a1)
    (return)
    (end)
))


(defvar store_global_type (ml_get_global_value "store_global_type"))
(defvar load_global_types (ml_get_global_value "load_global_types"))
(defvar store_global_exception (ml_get_global_value "store_global_exception"))
(defvar load_global_exception (ml_get_global_value "load_global_exception"))
(defvar get_global_exception_num
        (ml_get_global_value "get_global_exception_num"))
(defvar get_global_sysexception_num
        (ml_get_global_value "get_sys_exception_num"))
(defvar get_global_type (ml_get_global_value "get_global_type_num"))
(defvar get_global_systype (ml_get_global_value "get_sys_type_num"))
;(defvar load_abbrev_type (ml_get_global_value "load_abbrev_type"))
(defvar load_global_label (ml_get_global_value "load_global_label"))
(synonymq get_global_exc get_exctype_numb)
(synonymq get_global_sysexc get_sysexctype_numb)
(print "get_global_exc failure -->" (get_global_exc "failure"))


(load-obj "F-save")

(gc t)

(load-obj "F-streams")
(gc t)


;(defvar %date (substring "$DATE" 0 10))
(defvar %date "$DATE")

(ml_store_global_value
  '"current_system" (string (system)) '((Value . (User . Ordinary_value)) 2))
(defvar banner (catenate (if lazy
                             (if parallel "   Parallel CAML "
                                          "   Lazy CAML ")
                             "   CAML ")
                         "(" (string (system)) ") "
                         "(V" (if lazy (if parallel "P" "L") " ")
                         "$ERSION" ") by INRIA "  %date))
(defvar #:system:core-directory "$LEMLDIR")

(ml_store_global_value
  '"caml_directory" "/usr/local/caml/" '((Value . (User . Ordinary_value)) 2))
(ml_store_global_value
  '"caml_version" '"$VERSION" '((Value . (User . Ordinary_value)) 2))
(ml_store_global_value
  '"caml_name" '"$VERSION_NAME" '((Value . (User . Ordinary_value)) 2))
(ml_store_global_value
  '"system_directory" '"$LEMLDIR" '((Value . (User . Ordinary_value)) 2))
(ml_store_global_value
  '"banner" banner '((Value . (User . Ordinary_value)) 2))

(load-obj "prelude")
(print "get_global_exc system -->" (get_global_exc "system"))
(print "get_global_exc break -->" (get_global_exc "break"))
(load-obj "sys")

(defvar add_path (ml_get_global_value "add_path"))
(defvar dir_of (ml_get_global_value "dir_of"))

(load-obj "channels")

(defvar ml_io_failure (car (get_exctype_numb "io_failure")))

(load-obj "format")
(load-obj "para_print")
(load-obj "print")

(gc t)

(load-obj "unify")

(load-obj "ML")

(load-obj "cam")

(load-obj "type_env")

(gc t)

(load-obj "print_prog")

(load-obj "print_syntax")

(load-obj "init_glob")

(gc t)

(load-obj "sys_env")

(load-obj "value")

(load-obj "ml")

(load-obj "abbrev")

;(defvar add_abbrev_rule (ml_get_global_value "add_abbrev_rule"))
;(defvar load_abbrev_rule (ml_get_global_value "load_abbrev_rule"))

(gc t)

(load-obj "lex")
(load-obj "parser")

(load-obj "grammar")
;(load-obj "caml_mly")
;(load-obj "syntax")


(load-obj "typing_error")
(load-obj "init_typing")
(load-obj "init_overload")
(load-obj "overload")
(load-obj "typing_type")
(load-obj "typing")

(gc t)

(load-obj "strictness")
(load-obj "init_tran")
(load-obj "tran")
(gc t)

(load-obj "reducing")
(load-obj "lapping")
(gc t)

(load-obj "env")

(load-obj "toplevel")
(defvar do_switching_dir_env (ml_get_global_value "do_switching_dir_env"))
(defvar protected_do_switching_dir_env
        (ml_get_global_value "protected_do_switching_dir_env"))
(defvar do_switching_prag_env (ml_get_global_value "do_switching_prag_env"))
(defvar protected_do_switching_prag_env
        (ml_get_global_value "protected_do_switching_prag_env"))
(defvar run (ml_get_global_value "Silent_Run"))
(defvar run_dir (ml_get_global_value "Silent_Run_dir"))
; To make sure that run and run_dir will deal with in_system flag
(loader '((fentry run subr0)
          (mov (cvalq run) a1)
          (jmp ml_iappl) (end) ()))

(load-obj "load")

(CAML_apply (ml_get_global_value "ps_loadc") (catenate "$LODIR/" "glob"))

(rplacd (ml_get_global_value "loadc_flag") t); For autoload to be SILENT
(load-obj "autoload")
(load-obj "lib_types")
(load-obj "autoloaded")

(defvar set_working_dir_ref (ml_get_global_value "set_working_dir_ref"))
(defvar set_home_dir_ref (ml_get_global_value "set_home_dir_ref"))
(defvar apply_user_init_fun (ml_get_global_value "apply_user_init_fun"))

(progn (defvar system-exception (car (get_exctype_numb "system")))
       (defvar toplevel-exception (car (get_exctype_numb "toplevel")))
       (defvar break-exception (car (get_exctype_numb "break")))
       (defvar bottom-exception (car (get_exctype_numb "bottom")))
       (defvar compilation (car (get_exctype_numb "compilation")))
       (defvar tml (ml_get_global_value "caml_loop"))
       (defvar set_stamp (ml_get_global_value "set_stamp"))
       (defvar set_local_stamp (ml_get_global_value "set_local_stamp"))
       (defvar startup (ml_get_global_value "startup"))
        ())

(load-obj "dml")

(synonymq ap ml_iappl)

(load-obj "export")

(load-obj "modules")

(defvar load_implementations (ml_get_global_value "load_implementations"))
(defvar match_signature (ml_get_global_value "match_signature"))
;(defvar create_module_env (ml_get_global_value "create_module_env"))
(defvar load_import_signature (ml_get_global_value "load_import_signature"))
(defvar end_module (ml_get_global_value "end_module"))

(synonym 'tml-loop 'tml)

(load-obj "system_sig")

(load-obj "restriction")

(print "==>" (length (cdr (ml_get_global_value "ml_global_env"))))
(load-obj "caml_gram")
(print "==>" (length (cdr (ml_get_global_value "ml_global_env"))))
(load-obj "top_gram")
(print "==>" (length (cdr (ml_get_global_value "ml_global_env"))))
(load-obj "gram")
(print "==>" (length (cdr (ml_get_global_value "ml_global_env"))))

(if (and lazy (getenv "LAZY_PRELUDE")) (load-obj "lazy_prel"))

(rplacd (ml_get_global_value "loadc_flag") ())
(rplacd (ml_get_global_value "default_ol_grammar") '("Caml" . "Expr"))
(print "==>" (length (cdr (ml_get_global_value "ml_global_env"))))

(print (tag CAML_exception
(CAML_app (ml_get_global_value "close_system") ())))

(load-obj "pragmas")

(ml_store_global_value '"(*it*)" "Bonjour" '((Value . (User . Ordinary_value)) 2))
(ml_iappl load_global_valtype '("(*it*)" (Value . (User . Ordinary_value)) "string"))

;(security-end)

(gc t)
#-compatible (setq #:system:line-mode-flag t)
;(ml_iappl (ml_get_global_value "trace") "parse_caml_syntax")

(save-ml "$CORENAME")
quit();;
END
