; .EnTete "Le-Lisp (c) version 15.2" " " "Loadfile de l'Enfer"
; .EnPied "loadfile.ll" "%" " "
; .SuperTitre "Loadfile de l'Enfer"
;
; .Auteur "Vindieux Matheu"
;
; .Centre "*****************************************************************"
; .Centre " (c) Le-Lisp est une marque de'pose'e de l'INRIA "
; .Centre "*****************************************************************"
;
; .Centre "$Header: loadfile.ll,v 4.1 88/01/13 12:35:20 kuczynsk Rel $"
(unless (>= (version) 15.2)
(error 'load 'erricf 'loadfile))
(setq #:sys-package:colon 'system)
(unless (boundp 'ERRLOADFILEREADING)
(defvar :current-line)
(defvar :curread)
(defvar :read-line)
(defvar ERRLOADFILEINFILE
#+ #:system:foreign-language "error in file"
#- #:system:foreign-language "erreur dans le fichier")
(defvar ERRLOADFILEATLINE
#+ #:system:foreign-language "at line"
#- #:system:foreign-language "a la ligne")
(defvar ERRLOADFILEREADING
#+ #:system:foreign-language "while reading"
#- #:system:foreign-language "durant la lecture de")
(defvar :loaded-from-file)
)
(de loadfile (file redef?)
(ifn (probefile file)
(error 'loadfile errfile file)
(let ((:current-line 0)
:read-line
:curread
(#:sys-package:itsoft
(ifn (memq ':loadfile #:sys-package:itsoft)
(cons ':loadfile #:sys-package:itsoft)
#:sys-package:itsoft))
:loaded-from-file
(:redef-flag redef?)
(#:sys-package:colon #:sys-package:colon)
(:in-read-flag ()))
(with ((inchan (openi file)))
(protect
(untilexit eof
(setq :read-line (add1 :current-line))
(setq :loaded-from-file (cons file :read-line))
(eval (read)))
(when (inchan) (close (inchan)))))
file)))
(de :loadfile:bol ()
(incr :current-line)
(super-itsoft ':loadfile 'bol ()))
(de :loadfile:eof (n)
(setq :curread (with ((inchan n)) (curread)))
(super-itsoft ':loadfile 'eof (list n)))
(de :loadfile:syserror (:f :m :b)
(prin "** " ERRLOADFILEINFILE (car :loaded-from-file)
" : " ERRLOADFILEATLINE " : ")
(if (and (eq :m 'errsxt)
(memq :b '(2 3 5 11))
(<> :read-line :current-line))
(print :read-line "-" :current-line)
(print :current-line))
(unless :curread (setq :curread (curread)))
(when :curread
(with ((printline 1))
(print "**" ERRLOADFILEREADING " : " (cdr :curread))))
(super-itsoft ':loadfile 'syserror (list :f :m :b)))