(loader '((title |toplevel.lo|)))
(if (not (>= (version) 15.2)) (progn (error 'load 'erricf 'toplevel)))
(defvar #:sys-package:itsoft ())
(defvar #:system:debug ())
(defvar #:trace:trace ())
(defvar #:system:print-msgs 1)
(defvar #:system:error-flag ())
(loader'((fentry catcherror fsubr)
(entry catcherror fsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(push a4)
(push (cvalq #:system:error-flag))
(mov a1 (cvalq #:system:error-flag))
(push '1)
(push '(#:system:error-flag))
(push (@ catcherror))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 101))
(push a1)
(mov '1 a4)
(jmp eval)
101
(eval ())
(push (cvalq #:system:error-flag))
(mov a1 (cvalq #:system:error-flag))
(push '1)
(push '(#:system:error-flag))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(btnil a1 102)
(mov (cvalq #:system:print-msgs) a4)
(bra 103)
102
(mov '0 a4)
103
(btnil a1 104)
(mov (cvalq #:system:debug) a3)
(bra 105)
104
(mov nil a3)
105
(push (cvalq #:system:debug))
(mov a3 (cvalq #:system:debug))
(push (cvalq #:system:print-msgs))
(mov a4 (cvalq #:system:print-msgs))
(push '2)
(push '(#:system:debug #:system:print-msgs))
(push 'lambda)
(push llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 106))
(push '#:system:error-tag)
(push dlink)
(push tag)
(stack dlink)
(mov (& 26) a1)
(jcall eprogn)
(jcall ncons)
(mov (& 1) dlink)
(adjstk '4)
106
(eval ())
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:print-msgs))
(mov (& 7) (cvalq #:system:debug))
(adjstk '8)
(mov (& 1) dlink)
(mov (& 6) (cvalq #:system:error-flag))
(adjstk '7)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq #:system:error-flag))
(adjstk '8)
(return)
))
(loader'((fentry errset dmsubr)
(entry errset dmsubr)
(mov (cdr a1) a4)
(mov (car a1) a1)
(mov (car a4) a4)
(push (@ 101))
(push 'catcherror)
(push a4)
(push a1)
(mov '3 a4)
(jmp list)
101
(eval ())
(return)
))
(loader'((fentry err dmsubr)
(entry err dmsubr)
(push (@ 101))
(push 'exit)
(push '#:system:error-tag)
(push a1)
(mov '3 a4)
(jmp mcons)
101
(eval ())
(return)
))
(loader'((fentry break subr0)
(entry break subr0)
(mov nil a1)
(mov '#:system:error-tag a2)
(jmp #:llcp:exit)
))
(defvar #:system:f ())
(defvar #:system:m ())
(defvar #:system:b ())
(loader'((fentry syserror subr3)
(entry syserror subr3)
(push (cvalq #:system:b))
(mov a3 (cvalq #:system:b))
(push (cvalq #:system:m))
(mov a2 (cvalq #:system:m))
(push (cvalq #:system:f))
(mov a1 (cvalq #:system:f))
(push '3)
(push '(#:system:b #:system:m #:system:f))
(push (@ syserror))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(jcall teread)
(jcall tyflush)
(btnil (cvalq #:system:error-flag) 102)
(bfnil (cvalq #:system:debug) 102)
(push (@ 103))
(mov '0 a4)
(jmp outchan)
103
(eval ())
(push a1)
(push (@ 104))
(push nil)
(mov '1 a4)
(jmp outchan)
104
(eval ())
(push (@ 105))
(push dlink)
(push prot)
(stack dlink)
(mov (cvalq #:system:b) a3)
(mov (cvalq #:system:m) a2)
(mov (cvalq #:system:f) a1)
(jcall printerror)
(mov (& 1) dlink)
(adjstk '3)
(push a1)
(mov (@ 106) a3)
105
(push a3)
(push a2)
(push (@ 107))
(push (& 4))
(mov '1 a4)
(jmp outchan)
107
(eval ())
(pop a2)
(pop a3)
(pop a1)
(bri a3)
106
(eval ())
(adjstk '1)
102
(jcall break)
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq #:system:f))
(mov (& 7) (cvalq #:system:m))
(mov (& 8) (cvalq #:system:b))
(adjstk '9)
(return)
))
(defvar #:toplevel:status t)
(defvar #:toplevel:read ())
(defvar #:toplevel:cread ())
(defvar #:toplevel:print ())
(defvar #:toplevel:eval ())
(loader'((fentry toplevel subr0)
(entry toplevel subr0)
(push (@ 101))
(push '#:system:toplevel-tag)
(push dlink)
(push tag)
(stack dlink)
(mov 't (cvalq #:system:error-flag))
(mov (cvalq #:toplevel:cread) (cvalq #:toplevel:read))
(push (@ 102))
(push '#:system:error-tag)
(push dlink)
(push tag)
(stack dlink)
(push (@ 103))
(push dlink)
(push prot)
(stack dlink)
(jcall read)
(mov (& 1) dlink)
(adjstk '3)
(push a1)
(mov nil a2)
103
(mov a2 a1)
(pop a2)
(bfnil a1 105)
(mov a2 a1)
(jcall ncons)
(bra 106)
105
(cabne a1 '#:system:error-tag 107)
(mov nil a1)
(bra 106)
107
(cabne a1 '#:system:toplevel-tag 109)
(mov nil a1)
(mov '#:system:toplevel-tag a2)
(jmp #:llcp:exit)
109
(mov a1 a3)
(mov 'errudt a2)
(mov 'toplevel a1)
(jcall error)
106
(mov (& 1) dlink)
(adjstk '4)
102
(eval ())
(mov a1 (cvalq #:toplevel:cread))
(bfcons a1 111)
(mov (car a1) a4)
(bra 112)
111
(mov nil a4)
112
(mov a4 (cvalq #:toplevel:cread))
(push (@ 113))
(push '#:system:error-tag)
(push dlink)
(push tag)
(stack dlink)
(push (@ 114))
(push dlink)
(push prot)
(stack dlink)
(push (@ 116))
(push a4)
(mov '1 a4)
(jmp eval)
116
(eval ())
(mov (& 1) dlink)
(adjstk '3)
(push a1)
(mov nil a2)
114
(mov a2 a1)
(pop a2)
(bfnil a1 117)
(mov a2 a1)
(jcall ncons)
(bra 118)
117
(cabne a1 '#:system:error-tag 119)
(mov nil a1)
(bra 118)
119
(cabne a1 '#:system:toplevel-tag 121)
(mov nil a1)
(mov '#:system:toplevel-tag a2)
(jmp #:llcp:exit)
121
(mov a1 a3)
(mov 'errudt a2)
(mov 'toplevel a1)
(jcall error)
118
(mov (& 1) dlink)
(adjstk '4)
113
(eval ())
(mov a1 (cvalq #:toplevel:eval))
(bfcons a1 124)
(btnil (cvalq #:toplevel:status) 124)
(jcall tyflush)
(push (@ 125))
(push '61)
(mov '1 a4)
(jmp princn)
125
(eval ())
(push (@ 126))
(push '32)
(mov '1 a4)
(jmp princn)
126
(eval ())
(push (@ 127))
(push '#:system:error-tag)
(push dlink)
(push tag)
(stack dlink)
(push (@ 128))
(push dlink)
(push prot)
(stack dlink)
(push (@ 130))
(mov (cvalq #:toplevel:eval) a4)
(push (car a4))
(mov '1 a4)
(jmp print)
130
(eval ())
(mov (& 1) dlink)
(adjstk '3)
(push a1)
(mov nil a2)
128
(mov a2 a1)
(pop a2)
(bfnil a1 131)
(mov a2 a1)
(jcall ncons)
(bra 132)
131
(cabne a1 '#:system:error-tag 133)
(mov nil a1)
(bra 132)
133
(cabne a1 '#:system:toplevel-tag 135)
(mov nil a1)
(mov '#:system:toplevel-tag a2)
(jmp #:llcp:exit)
135
(mov a1 a3)
(mov 'errudt a2)
(mov 'toplevel a1)
(jcall error)
132
(mov (& 1) dlink)
(adjstk '4)
127
(eval ())
124
(mov (cvalq #:toplevel:eval) a4)
(mov (car a4) (cvalq #:toplevel:eval))
(mov (car a4) a1)
(mov (& 1) dlink)
(adjstk '4)
101
(eval ())
(return)
))
(printline 5000)
(defvar errfstk "***** Erreur fatale : pile pleine.")
(defvar errfsgc "***** Erreur fatale : pile pleine durant un GC.")
(defvar errfpgc "***** Erreur fatale : pile pleine durant un PRINT.")
(defvar errfsud "***** Erreur fatale : pile vide.")
(defvar errfstr "***** Erreur fatale : zone des chaines pleine.")
(defvar errfvec "***** Erreur fatale : zone des vecteurs pleine.")
(defvar errfsym "***** Erreur fatale : zone des symboles pleine.")
(defvar errfcns "***** Erreur fatale : zone des listes pleine.")
(defvar errfflt "***** Erreur fatale : zone des flottants pleine.")
(defvar errffix "***** Erreur fatale : zone des entiers pleine.")
(defvar errfhep "***** Erreur fatale : zone du tas pleine.")
(defvar errfcod "***** Erreur fatale : zone du code pleine.")
(defvar errmac "erreur de la machine")
(defvar errudv "variable indefinie")
(defvar errudf "fonction indefinie")
(defvar errudm "methode indefinie")
(defvar errudt "echappement indefini")
(defvar errbdf "mauvaise definition")
(defvar errwna "mauvais nombre d'arguments")
(defvar errbpa "mauvais parametre")
(defvar errilb "liaison illegale")
(defvar errbal "mauvaise liste d'arguments")
(defvar errnab "pas de portee lexicale")
(defvar errxia "bloc lexical perime")
(defvar errsxt "erreur de syntaxe")
(defvar errios "erreur d'entree/sortie")
(defvar err0dv "division par 0")
(defvar errnna "l'argument n'est pas un nombre")
(defvar errnia "l'argument n'est pas un entier")
(defvar errnfa "l'argument n'est pas un flottant")
(defvar errnsa "l'argument n'est pas une chaine")
(defvar errnaa "l'argument n'est pas un atome")
(defvar errnla "l'argument n'est pas une liste")
(defvar errnva "l'argument n'est pas une variable")
(defvar errvec "l'argument n'est pas un vecteur")
(defvar errsym "l'argument n'est pas un symbole")
(defvar errnda "l'argument n'est pas une adresse")
(defvar errstc "l'argument n'est pas une structure")
(defvar erroob "argument hors limite")
(defvar errstl "chaine trop longue")
(defvar errgen "ne sait pas calculer")
(defvar errvirtty "terminal inconnu")
(defvar errfile "fichier inconnu")
(defvar erricf "fichier incompatible")
(defvar errtnb "Je ne sais pas tracer une fonction &NOBIND")
(defvar errcnt "Je ne peux pas tracer")
(defvar errknt "Je ne sais pas tracer une fonction de ce type")
(defvar errntf "cette fonction n'etait pas tracee")
(defvar errunk "je ne connais pas")
(loader'((fentry printerror subr3)
(entry printerror subr3)
(push (cvalq #:system:b))
(mov a3 (cvalq #:system:b))
(push (cvalq #:system:m))
(mov a2 (cvalq #:system:m))
(push (cvalq #:system:f))
(mov a1 (cvalq #:system:f))
(push '3)
(push '(#:system:b #:system:m #:system:f))
(push (@ printerror))
(push llink)
(mov nil llink)
(push dlink)
(push cbindn)
(stack dlink)
(push (@ 101))
(push '"** ")
(push a1)
(push '" : ")
(bfsymb a2 102)
(mov a2 a1)
(jcall boundp)
(btnil a1 102)
(mov (cvalq #:system:m) a4)
(mov (cval a4) a4)
(bra 103)
102
(mov (cvalq #:system:m) a4)
103
(push a4)
(push '" : ")
(cabne (cvalq #:system:m) 'errsxt 104)
(mov (cvalq #:system:b) a1)
(jcall numberp)
(btnil a1 104)
(push (@ 106))
(push (cvalq #:system:b))
(push '0)
(mov '2 a4)
(jmp >)
106
(eval ())
(btnil a1 104)
(push (@ 107))
(push (cvalq #:system:b))
(push '13)
(mov '2 a4)
(jmp <)
107
(eval ())
(btnil a1 104)
(mov (cvalq #:system:b) a1)
(cabne a1 '1 109)
(mov '"liste trop courte" a4)
(bra 105)
109
(cabne a1 '2 110)
(mov '"chaine trop longue" a4)
(bra 105)
110
(cabne a1 '3 111)
(mov '"symbole trop long" a4)
(bra 105)
111
(cabne a1 '4 112)
(mov '"mauvais debut d'expression" a4)
(bra 105)
112
(cabne a1 '5 113)
(mov '"symbole special trop long" a4)
(bra 105)
113
(cabne a1 '6 114)
(mov '"mauvais package" a4)
(bra 105)
114
(cabne a1 '7 115)
(mov '"mauvaise construction pointee" a4)
(bra 105)
115
(cabne a1 '9 116)
(mov '"mauvaise liste arguments" a4)
(bra 105)
116
(cabne a1 '10 117)
(mov '"mauvaise valeur de splice-macro" a4)
(bra 105)
117
(cabne a1 '11 118)
(mov '"EOF durant un READ" a4)
(bra 105)
118
(cabne a1 '12 119)
(mov '"mauvaise utilisation du BACKQUOTE" a4)
(bra 105)
119
(mov a1 a4)
(bra 105)
104
(btnil (cvalq #:system:unixp) 121)
(cabne (cvalq #:system:m) 'errmac 121)
(mov (cvalq #:system:b) a1)
(jcall numberp)
(btnil a1 121)
(mov (cvalq #:system:b) a1)
(cabne a1 '4 124)
(mov '"instruction illegale" a4)
(bra 105)
124
(cabne a1 '8 125)
(mov '"exception flottante" a4)
(bra 105)
125
(cabne a1 '10 126)
(mov '"erreur de bus" a4)
(bra 105)
126
(cabne a1 '11 127)
(mov '"violation de segment" a4)
(bra 105)
127
(mov a1 a4)
(bra 105)
121
(mov (cvalq #:system:b) a4)
105
(push a4)
(mov '6 a4)
(jmp print)
101
(eval ())
(mov (& 1) dlink)
(mov (& 2) llink)
(mov (& 6) (cvalq #:system:f))
(mov (& 7) (cvalq #:system:m))
(mov (& 8) (cvalq #:system:b))
(adjstk '9)
(return)
))
(loader '((end)))