;; -*- Mode: lisp; Syntax: ansi-common-lisp; Package: XLE; Base: 10; Readtable: augmented-readtable -*-

;; The contents of this file are subject to a License (LFG Parsebanker License;
;; see the file "license.txt" in this directory);
;; you may not use this file except in compliance with the License.
;; Software distributed under the License is distributed on an "AS IS"
;; basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied.
;; See the License for the specific language governing rights and limitations under the License.
;; This Source Code was developed by the University of Bergen and Unifob AS.
;; Portions created by University of Bergen and Unifob AS are Copyright (C)
;; of the University of Bergen and Unifob AS. All Rights Reserved.

;; paul.meurer@aksis.uib.no
;; Aksis, Unifob, University of Bergen.
;; http://www.aksis.uib.no/

(in-package :XLE)

;;#-(or xle-web logon trepil kartuli sbcl)
#+ignore
(progn
  (excl:gc :tenure) (excl:gc) (excl:gc t) (excl:gc)
  (setf (sys:gsgc-parameter :auto-step) nil)
;;;
;;; furthermore, reduce growth rates for new- and oldspaces
;;;
  (setf (sys:gsgc-parameter :expansion-free-percent-new) 5)
  (setf (sys:gsgc-parameter :free-percent-new) 2)
  (setf (sys:gsgc-parameter :expansion-free-percent-old) 5)
  (setf (sys:gsgc-switch :print) t))

#+ignore ;;#-(or xle-web logon kartuli trepil sbcl)
(eval-when (:load-toplevel :execute)
  ;;
  ;; use gc() hook to toggle [incr tsdb()] podium cursor for global gc()s;
  ;; unfortunately, there is no (pre-5.0 and all-lisp) way to get gc() cursors
  ;; for scavenges too.
  ;;
  (let* ((default-gc-after-hook excl:*gc-after-hook*)
         ;;(user (current-user))
         ;;(pid (current-pid))
         (stream (if (output-stream-p excl:*initial-terminal-io*)
                   excl:*initial-terminal-io*
                   t #+ignore(ignore-errors
                    (let ((file (format nil "/tmp/xle.debug.~a.~a" user pid)))
                      (when (probe-file file)
                        (delete-file file))
                      (open file :direction :output
                            :if-exists :supersede 
                            :if-does-not-exist :create)))))
        global-gc-p)
    (setf excl:*gc-after-hook*
      (lambda (global new old efficiency pending)
	(format
	 stream
	 "~&[~a] gc-after-hook(): ~:[local~;global~]~@[ (r)~*~]; ~
              new: ~a; old: ~a~@[; efficiency: ~d~].~%" 
	 (lkb::current-time :long :short)
	 global global-gc-p new old
	 (and (integerp efficiency) efficiency))
	
	(when (null global-gc-p)
	  ;;
	  ;; unfortunately, this breaks because of yet another bug in the
	  ;; Allegro memory management: when newspace is expanded during a
	  ;; scavenge, the `copy new' value reported by the gc() statistics
	  ;; is much bigger than would be appropriate.  this causes our .new.
	  ;; parameter to overflow the fixnum range.  email to `bugs@franz'
	  ;; sent today.                                   (22-jan-00  -  oe)
	  ;;
	  #+:null
	  (when (and (integerp *tsdb-scavenge-limit*)
		     (>= new *tsdb-scavenge-limit*))
	    (let ((*print-readably* nil)
		  (*print-miser-width* 40)
		  (*print-pretty* t)
		  (tpl:*zoom-print-circle* t)
		  (tpl:*zoom-print-level* nil)
		  (tpl:*zoom-print-length* nil)
		  (*terminal-io* stream)
		  (*standard-output* stream))
	      (tpl::zoom-command
	       :from-read-eval-print-loop nil :all t :brief t))
	    (error "gc-after-hook(): scavenge limit exceeded [~d]" new)))
	(when default-gc-after-hook
	  (funcall default-gc-after-hook 
		   global new old efficiency pending)))))
  (setf excl:*global-gc-behavior* nil)
  ;;
  ;; increase buffer size used with stream io; reduce write(2) system calls.
  ;;
  (setf excl::stream-buffer-size 8192)
  )


#-xle-web
(setf *pargram-path*
  (let (#-(or :pargram :xle-web)(logon #-paul(getenv "LOGONROOT") #+paul "")
	(xle (getenv "XLE"))
	(pargram (getenv "PARGRAM")))
    #-debug(print (list :logon #-(or :pargram :xle-web) logon :xle xle :pargram pargram #+paul "#+paul"))
    (namestring
     (parse-namestring 
      (cond #-:paul
	    (pargram
	     (concatenate 'string pargram "/"))
	    #-(or :pargram :xle-web)
	    ((and logon (string/= logon ""))
	     (format nil "~a/parc/pargram/" logon))
	    #-:paul
	    (xle
	     (concatenate 'string xle "/pargram/"))
	    (t
	     "/usr/local/xledir/pargram/"))))))


#-xle-web
(let ((grammar-def-file *grammar-def-file*))
  (clrhash *grammars*)
  #-debug(print (list #-logon "#-logon" #+logon "#+logon" grammar-def-file))
  (if #+trepil nil #-trepil (probe-file grammar-def-file)
      (load-grammars grammar-def-file)
      #-sbcl
      (setf *grammar* (make-instance
		       'grammar 
		       :grammar-path ;;  "/home/helge/logon/parc/pargram/norwegian/bokmal/bokmal-mrs.lfg"
		       ;;#+paul(print "/home/paul/logon/parc/pargram/norwegian/bokmal/bokmal-mrs.lfg")
		       #-trepil (print (concat *pargram-path* "/norwegian/bokmal/bokmal-mrs.lfg"))
		       #+trepil "/usr/local/xledir/pargram/norwegian/bokmal/bokmal-mrs.lfg"
		       :max-parsers 1
		       :morphology-type :plugin-morphology
		       :name "bokmal-mrs")
	    (gethash "bokmal-mrs" *grammars*) *grammar*)))

;;#-xle-web
;;#+disabled
#-:logon
(eval-when (:compile-toplevel :load-toplevel :execute)
  (init-xle 0 0))

;;#-xle-web(execute-xle-command "set ignoreProjections (s::);")

;;(execute-xle-command "set ignoreProjections (m::);")

;; those are read in from environment variables
;; XLE_WEB_EMAIL_SFX
#-xle-web
(setf *email-suffixes*
  (let ((es (getenv "XLE_WEB_EMAIL_SFX")))
    (if es
	(split es #\:)
	'("oxford.ac.uk" "ox.ac.uk" "uib.no"))))

;; XLE_WEB_POSTMASTER
#-xle-web
(setf *postmaster* (or (getenv "XLE_WEB_POSTMASTER")
		       "paul.meurer@aksis.uib.no"))

;; XLE_WEB_SMTP
#-xle-web
(setf *smtp-server* (or (getenv "XLE_WEB_SMTP")
			"smtp.uib.no"))

;; XLE_WEB_AUTHORIZATIONS
#-xle-web
(setf *authorizations-file*
  (or ;;(getenv "XLE_WEB_AUTHORIZATIONS")
      "projects:xle;authorizations.cfg"))

;; XLE_WEB_SUPER_USERS ;; those that have access to all grammars
#-xle-web
(setf *super-users*
  (let ((su (getenv "XLE_WEB_SUPER_USERS")))
    (if su
	(split su #\:)
	#-xle-web
	'("paul" "helge"))))

#-xle-web
(eval-when (load)
  (when (fboundp 'load-authorizations-file)
    (load-authorizations-file *authorizations-file*)))

#+xle-web
(defun load-configuration-file (&optional path)
  (let ((path (or path #-paul "configuration.lisp" #+paul "projects:xle;xle-web;configuration.lisp"))
	(*grammars* nil))
    (print (list :loading path))
    (load path)
    (when *grammars*
      (setf *pargram-path* (namestring (translate-logical-pathname *grammars*))))))

(defparameter *xle-web-port* nil)

#+xle-web
(defun cl-user::start-server-processes ()
  (#+allegro
   mp::process-run-function
   #-allegro acl-compat.mp::process-run-function
   "xle-web"
   (lambda ()
     #+allegro(excl.osi:unsetenv "LOGONROOT")
     #+allegro
     (print-environment (list
			 "PATH"
			 "XLE"
			 "XLEPATH"
			 "LD_LIBRARY_PATH"
			 "DYLD_LIBRARY_PATH"
			 "XLE_WEB_CONFIGURATION_FILE"
			 "PARGRAM"
			 ))
     (load-configuration-file (print (getenv "XLE_WEB_CONFIGURATION_FILE")))
     (if *authorizations-file*
	 (load-authorizations-file *authorizations-file*))

     ;;(init-xle 0 0)
     ;;(execute-xle-command "set ignoreProjections (s::);")
     (load-grammars *grammar-def-file*)
     (if *xle-web-port*
	 (progn (net.aserve::start :port *xle-web-port*)
		(format t "~%XLE-Web server started at port ~d.~%" *xle-web-port*))
	 (format t "~%You have to set *xle-web-port* in 'configuration.lisp' to a valid port number.~%")))))

:eof