#!/bin/sh
VERSION="$1"
SUBVERSION='.1'
shift
LODIR="$1"
shift
VERSION_NAME="$1"
shift
LISP="$1"
CORENAME="$2"
LEMLDIR="$3"
DATE='Fri Sep 11 1992'
echo "CORENAME= $CORENAME , LEMLDIR= $LEMLDIR , LODIR= $LODIR"
echo "DATE= $DATE , LISP = $LISP"
time $LISP << END

(setq CAML_debug t)
(setq CAML_lisp_debug ())

(load "$LODIR/F-patch.lo")

(when CAML_debug (progn (print (valfn 'openi)) (print (valfn '#:new:openi))))

(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")))
(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 a new "
                 (if lazy (if parallel "Parallel " "Lazy ")) "CAML"))

(when CAML_debug (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-hash")

(load-obj "F-nats")

(load-obj "F-nary")

(load-obj "F-glob")

(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))

; dummy definition of compiled file corectness checking while loading glob.lo
(de check_version (version name) ())
(de file_loaded (name) ())
(de loading_file (name) ())

(synonymq run ml_run)

(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 '"Incompatible code file" a1)
    (jmp raise)
101
    (mov nil a1)
    (return)
    (end)
))

(loader '((fentry loading_file subr1)
   (push a1)
    (mov '"loading_file" a1)
    (jcall get_global_sysvalue)
    (mov (car a1) a2)
    (pop a1)
    (jmp ml_appl)
    (end)
))

(loader '((fentry file_loaded subr1)
   (push a1)
    (mov '"file_loaded" a1)
    (jcall get_global_sysvalue)
    (mov (car a1) a2)
    (pop a1)
    (jmp ml_appl)
    (end)
))

(defvar store_global_type (ml_get_global_value "store_global_type"))
(defvar load_global_types (ml_get_global_value "load_global_types"))
(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_global_label (ml_get_global_value "load_global_label"))

(defvar get_global_overloaded_value
 (ml_get_global_value "get_global_overloaded_value"))
(de mloval (arg)
  (let ((val (CAML_apply get_global_overloaded_value arg)))
             (if val (cons 'quote val)
                     (new_error "OVERLOAD" arg))))
(defvar load_global_ovtype
 (ml_get_global_value "load_global_ovtype"))
 
(load-obj "F-save")

(load-obj "F-streams")

(when CAML_debug (gc t))


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

(ml_store_global_value
  '"current_system" (string (system))
  '((Value 1 Ordinary_value . Unknown_value) 2))

(defvar banner (catenate (if lazy
                            (if parallel "   Parallel CAML "
                                          "   Lazy CAML ")
                             "   CAML ")
                         "(" (string (system)) ") "
                         "(" "$VERSION" "$SUBVERSION" ") by INRIA "  %date))

(ml_store_global_value
  '"caml_directory" "$LODIR/.."
  '((Value 1 Ordinary_value. Unknown_value) 2))
(ml_store_global_value
  '"caml_version" '"$VERSION" '((Value 1 Ordinary_value . Unknown_value) 2))
(ml_store_global_value
  '"caml_name" '"$VERSION_NAME" '((Value 1 Ordinary_value . Unknown_value) 2))
(ml_store_global_value
  '"system_directory" '"$LEMLDIR" '((Value 1 Ordinary_value . Unknown_value) 2))
(ml_store_global_value
  '"banner" banner '((Value 1 Ordinary_value . Unknown_value) 2))

(load-obj "init_prelude")

(load-obj "ints")
(load-obj "nats")
(load-obj "big_ints")
(load-obj "ratios")
(load-obj "nums")
(load-obj "F-nums")

(load-obj "prelude")

(load-obj "sys")

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

(load-obj "channels")

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

(when CAML_debug (gc t))

(load-obj "unify")

(load-obj "ML")

(when CAML_debug (gc t))

(load-obj "cam")

(when CAML_debug (gc t))

(load-obj "type_env")

(when CAML_debug (gc t))

(load-obj "print_prog")

(when CAML_debug (gc t))

(load-obj "print_syntax")

(load-obj "init_glob")

(when CAML_debug (gc t))

(load-obj "sys_env")

(load-obj "value")

(load-obj "ml")

(load-obj "abbrev")

(when CAML_debug (gc t))

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

(load-obj "grammar")

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

(when CAML_debug (gc t))

(load-obj "init_tran")
(load-obj "tran")
(when CAML_debug (gc t))

(load-obj "reducing")
(load-obj "lapping")
(when CAML_debug (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 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")
(load-obj "dml_nats")
(load-obj "dml_big_ints")
(load-obj "dml_ratios")
(load-obj "dml_nums")

(load-obj "standard")

(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 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")

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

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

(load-obj "equal")

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

(load-obj "pragmas")

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

(progn
   (load-obj "../lib/X/time")
   (load-obj "../lib/X/makef")
   (load-obj "../lib/X/makeg")
   (load-obj "../lib/X/makep")
)

(unless (memq (system) '(apollo macaux))
 (progn
   (load-obj "../lib/X/Xlib_stubs")
   (load-obj "../lib/X/Xlib_runtime")
   (load-obj "../lib/X/X.h")
   (load-obj "../lib/X/ddr_ext")
 ))

(gc t)
#-compatible (setq #:system:line-mode-flag t)

(when CAML_lisp_debug (save-core "dcaml.core"))

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

