First checkin.

parents
This diff is collapsed.
Catalogue:
- Les liens symboliques dans le répertoire LSE ne sont pas admis.
(Common-Lisp DIRECTORY returns TRUENAME, which unix CL implementations
generally understand as the target path).
COMMON-LISP Implementation
==========================
We'll minimize the CL implementation specific dependencies.
Each task will be implemented in its own UNIX process.
A server process will listen to the socket,
and will fork a new console process of each incoming session.
A pipe between the server process and the console process will be
establised to allow for the transfer of state (PRENDRE ETAT CONSOLE)
between the consoles.
Terminal I/O
------------
Since we don't have serveral threads, we must do polling I/O.
clisp provide extension functions for raw keyboard input.
ESC --> stop current processing and revert to top-level repl
(note: execution of a running program could be continued with
the CONTINUE or ALLER A commands).
Ctrl-A --> the signal should be recoded asynchronously for the
ATT() function.
The only way to implement BOTH these features portably on unix
without threads seems to be with the use of an embedded virtual
machine where we could implement virtual threads or at least:
(loop
(process-input (read-char-no-hang))
(execute-one-instruction))
If ESC is mapped to SIGINT, this is caught by clisp as a "User
Break", ie. system::simple-interrupt-condition, which can be
handled programmatically with handler-bind or handler-case.
(catch :exit
(let ((*status* :out) (counter 1)) (declare (special *status*))
(handler-bind
((system::simple-interrupt-condition
(lambda (condition)
(print (list :interupted *status* counter))
(decf counter)
(when (zerop counter) (throw :exit nil))
nil)))
(let ((*status* :in)) (declare (special *status*)) (loop)))))
--> (:INTERUPTED :IN 1)
(catch :exit
(let ((*status* :out) (counter 1)) (declare (special *status*))
(handler-case (let ((*status* :in)) (declare (special *status*)) (loop))
(system::interrupt-condition
(condition)
(print (list :interupted *status* counter))
(decf counter)
(when (zerop counter) (throw :exit nil))))))
--> (:INTERUPTED :OUT 1)
Conclusion: Implement ESC with stty -intr ESC
and don't implement Ctrl-A/ATT().
(defun make-xterm-io-stream ()
(let* ((pipe (with-open-stream (s (make-pipe-input-stream
"mktemp /tmp/clisp-x-io-XXXXXX"))
(read-line s)))
(title "CLISP I/O")
tty-name xio
(clos::*warn-if-gf-already-called* nil))
(shell (format nil "rm -f ~a; mknod ~a p; ~
xterm -n ~s -T ~s -e 'tty >> ~a; cat ~a' &"
pipe pipe title title pipe pipe))
(setq tty-name
(with-open-file (s pipe :direction :input) (read-line s))
xio (make-two-way-stream
(open tty-name :direction :input)
(open tty-name :direction :output)))
(defmethod close :after ((x (eql xio)) &rest junk)
(declare (ignore x junk))
(with-open-file (s pipe :direction :output)
(write-line (TEXT "Bye.") s))
(delete-file pipe)
(close (two-way-stream-input-stream xio))
(close (two-way-stream-output-stream xio))
(let ((clos::*warn-if-gf-already-called* nil))
(remove-method #'close (find-method #'close '(:after) `((eql ,xio))))))
xio))
LSE SYSTEM
==========
emulse [configuration-file]
commands:
(connections max-number N)
(connections enable)
(connections disable)
(filter insert allow IP [BITS])
(filter insert deny IP [BITS])
(filter append allow IP [BITS])
(filter append deny IP [BITS])
(filter delete allow IP [BITS])
(filter delete deny IP [BITS])
(filter insert allow all)
(filter insert deny all)
(filter append allow all)
(filter append deny all)
(filter delete allow all)
(filter delete deny all)
(filter flush)
(filter list)
(filter list all)
(filter list deny)
(filter list allow)
(console kill all)
(console kill xterm)
(console kill socket)
(console kill N)
(console list)
(console list all)
(console list xterm)
(console list socket)
(console create xterm)
(console create xterm display D)
(configuration save)
(configuration load)
;;;; IMPLEMENTATION -- -- ;;;;
TODO
Design the LSE interpreter (or compiler).
Reimplement the command interpreter.
- Appel de PROCEDURE
- initialisation/terminaison des variables, EX, PAUSE, TERMINER, CO, RE, PO,
gestion (scope) des piles...
--> Générer un code intermédiaire ?!
- PRendre etat console
Mitra-15: copie le programme, les variables, et les fichiers
temporaires.
TRANSFERT FICHIERS TEMPORAIRES IMPOSSIBLE
!! Avec des threads, il faut bloquer les threads de la console source !!
- CHARGER/GARER mettre un sémaphore par fichier ; revoir les
autres resources.
- Programmmes à execution seule ? (Il faut l'ID du pgm pour le lister).
MODIFICATIONS
2005-08-24 <PJB> Implemented the LSE scanner.
2005-08-22 <PJB> Completed the LSE parser.
FILES
loader.lisp Men working.
server.lisp Men working.
simple-server.lisp
parser-lse.zb Complete.
scanner-lse.lisp Complete.
error.lisp Complete.
catalog.lisp Conversion from C begun.
command.lisp Conversion from C begun.
io.lisp Conversion from C begun.
task.lisp Conversion from C begun.
configuration.lisp
pmatch.lisp Should use com.informatimago.common-lisp.pmatch
FILES AND DIRECTORIES IN ../lse/
AFAIRE
BOURG
EXEMP
INSTALL
Makefile
Makefile.depend
README
VERSION
Version.h
bison.lisp
console
doc
emulse.sh
gdb
lse_version.h inutile
pjb_objet.h inutile -- on a GC & CLOS
pjb_tableau.h inutile -- on a des tableaux en CL
lse_type.h inutile -- Défini des valeurs étiquettées,
comme en lisp: nombre, vecteur,
tableau, chaine, symbole, booléen.
Note: la VM LSE a des variables typées.
lse_cons.h inutile -- on a des cons & listes en CL.
lse_pile.h inutile -- pile.
lse_environnement.h Environnement d'exécution (thread):
programme, globales, locales, piles,
ligne courante, ligne reprise, pas-a-pas.
lse_cmd.h Interpréteur des commandes, commandes.
lse_travail.h Une Session: console, compte, E/S, terminal,
commandes, etc.
lse_compte.h Gestion des comptes utilisateurs, droits d'accès.
Convertir en premier!
lse_catalogue.h Gestion des catalogues LSE.
Convertir en premier!
lse_fichier.h Gestion des fichiers LSE.
Convertir en premier!
lse_fonction.h Les fonctions en bibliothèque.
Convertir en premier!
lse_programme.h Un programme: instructions, procedures.
lse_cadre.h stack-frame: next-frame, variables.
lse_parametre.h Paramètre d'une procédure: identificateur, sorte.
lse_variable.h Variable (binding): identificateur, valeur,
propriétaire(passage par référence), locale
lse_primproc.h inutile -- Superclasse primitives & procedures.
lse_primitive.h inutile -- Table des primitives (meta-fonction):
identificateur, parametres, implémentation.
lse_procedure.h Objet procedure: identificateur, parametres,
variables locales, ligne, instructions.
lse_es.h Entrées/Sorties
Essentiel -- architecture du système.
lse_scanner.h -- scanner
lse_parser.out.h -- parser
lse_langage.h Commandes de l'interpréteur, interpéteur.
lse_langage_debug.h Lispeur.
lse_erreur.h Messages d'erreur.
lse_configuration.h
lse_main.h
lex-to-lisp
lse-mode.el
lse-scanner-tables.lisp
lse_bison_simple.c
lse_cadre.c
lse_catalogue.c
lse_cmd.c
lse_compte.c
lse_cons.c
lse_environnement.c
lse_erreur.c
lse_es.c
lse_fichier.c
lse_fonction.c
lse_langage.c
lse_langage_debug.c
lse_langage_fonctions.awk
lse_langage_instructions.awk
lse_langage_opcons.awk
lse_main.c
lse_operators
lse_parametre.c
lse_parser.bison
lse_parser.sed
lse_pile.c
lse_primitive.c
lse_primproc.c
lse_procedure.c
lse_programme.c
lse_scanner.in
lse_scanner.sed
lse_travail.c
lse_type.c
lse_variable.c
lse_version.c
pjb_objet.c
pjb_tableau.c
prototype.el
scanner.lisp
test
trace
yacc-to-lalr.lisp
URLS
LSE83
Jacques Arsac
Bulletin de l'EPI n° 38
http://archive-edutice.ccsd.cnrs.fr/docs/00/03/06/74/PDF/b38p116.pdf
------------------------------------------------------------------------
LEXER,PARSER
> maybe i don't understand the problem but there is a nice (and fast
> ;-) lexer in Michael Parkers CLAWK package. It is very portable (i
> tested it on CMUCL, CLisp, LWW & Corman) and produce (as Michael
> said) output that is compatible to parsers from LispWorks parser
> generator tool.
Indeed, they work nicely together. A simple example:
(defpackage "CALC"
(:use "COMMON-LISP" "LEXER" "PARSERGEN")
(:export "CALC"))
(in-package "CALC")
(deflexer lex
("[:digit:]+" (return (values 'number (num %0))))
("\\+" (return 'plus))
("-" (return 'minus))
("\\*" (return 'times))
("/" (return 'div))
("\\(" (return 'lparen))
("\\)" (return 'rparen))
("[:space:]+"))
(defparser parse
((expr sum) $1)
((sum sum plus mult) `(+ ,$1 ,$3))
((sum sum minus mult) `(- ,$1 ,$3))
((sum mult) $1)
((mult mult times atom) `(* ,$1 ,$3))
((mult mult div atom) `(/ ,$1 ,$3))
((mult atom) $1)
((atom minus atom) `(- ,$2))
((atom plus atom) `(+ ,$2))
((atom number) $1)
((atom lparen sum rparen) $2))
(defun calc ()
(eval (parse (lex (read-line)))))
CL-USER 29 > (calc:calc)
-(2 + 3 * -5) * 4 / 13
4
IMHO lexing is one of the (maybe exceptional) cases where regular
expressions are simply the Right Thing.
------------------------------------------------------------------------
------------------------------------------------------------------------
It is advised to put the darcs repository inside a project specific
directory, for the dependencies will be installed as brother directories:
project_X/
project_X/project_X_darcs_repo/
project_X/project_X_darcs_repo/_darcs
project_X/project_X_darcs_repo/Makefile
project_X/project_X_darcs_repo/src/...
project_X/dependency_1/
project_X/dependency_2/
project_X/...
These dependencies may be unfreezed from tarballs, or checked-out from
any revision control system by the Makefile inside the project darcs
repository.
------------------------------------------------------------------------
1*BOURGUIGNON PASCAL 4*6 25-05-78
2*CEFAK
3*TRANSFORMATION DE DEGRES C EN DEGRES F ET K ET INVERSEMENT
4*
5*TOURNE
6 AFFICHER[25/]
8 CHAINE UNIT,
10 AFFICHER[/20X,'TRANSFORMATION DES DEGRES C EN DEGRES F ET K ET INVERSEMENT' ]
12 AFFICHER['NT',,/,'LORSQUE VOUS VERREZ APPARAITRE LE SIGNE ":",TAPEZ']
14 AFFICHER[' LE NOMBRE',/,'DE DEGRES,UN BLANC,L''UNITE (C,F OU K) ET '234]
16 AFFICHER['SUR LES TOUCHES (CTRL X-OFF)',/,'EXEMPLE : 65.3 F(CTRL X-OFF)',/]
18 AFFICHER[/,'QUAND VOUS N''AUREZ PUS DE VALEURS A DONNER,TAPEZ "FIN" A LA']
20 AFFICHER['PLACE DE L''UNITE',/,'COMPRIS?'];LIRE UNIT
22 SI UNIT='NON' SINON ALLER EN 6
24 AFFICHER[/,10X,34'#',/,10X,'#',4X,'C*',4X,'#',4X,'F*',4X,'#',4X,'K*']
26 AFFICHER[/,4X,'#']
28 AFFICHER[/,10X,34'#',/]
30 AFFICHER[C,79X,C,10X,'#',10X,'#',10X,'#',10X,'#']
32 AFFICHER[X,':'];LIRE TEM;LIRE UNIT
34 SI UNIT#='C' ALORS &CFK(TEM)
36 SI UNIT=>'F' ALORS &FCK(TEM)
38 SI UNIT=<'K' ALORS &KCF(TEM)
40 SI UNIT='FIN' ALORS ALLER EN 44 ALORS ALLER EN 22
42 ALLER EN 30
44 AFFICHER[C,79X,C];TERMINER
50 PROCEDURE &CFK(C)
52 F_1.8*C+32;K_C+273.16
54 &AFF(C,F,K);RETOUR EN 28
58 PROCEDURE &FCK(F)
60 C_(F-32)/1.8;K_(F-32)/1.8+273.16
62 &AFF(C,F,K);RETOUR EN 28
66 PROCEDURE &KCF(F)
68 C_K-273.16;F_(K-273.16)*1.8+32
70 &AFF(C,F,K);RETOUR EN 28
74 PROCEDURE &AFF(C,F,K)
76 AFFICHER[C,79X,C,10X,'#',F5.2,2X,'#',F5.2,2X,'#',F5.2,2X,'#']C,F,K
78 RETOUR
{NUMERO}{COMMENTAIRE}
{NUMERO}{COMMENTAIRE}
{NUMERO}{COMMENTAIRE}
{NUMERO}{COMMENTAIRE}
{NUMERO}{COMMENTAIRE}
{NUMERO} AFFICHER[{NUMERO}/]
{NUMERO} CHAINE {IDENTIFICATEUR}
{NUMERO} AFFICHER[/,{NUMERO}X,{CHAINE} ]
{NUMERO} AFFICHER[{CHAINE},/,{CHAINE}]
{NUMERO} AFFICHER[{CHAINE},/,{CHAINE}]
{NUMERO} AFFICHER[{CHAINE},/,{CHAINE},/]
{NUMERO} AFFICHER[/,{CHAINE}]
{NUMERO} AFFICHER[{CHAINE},/,{CHAINE}];LIRE {IDENTIFICATEUR}
{NUMERO} SI {IDENTIFICATEUR}={CHAINE} ALORS ALLER EN {NUMERO}
{NUMERO} AFFICHER[/,{NUMERO}X,{NUMERO}{CHAINE},/,{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE}]
{NUMERO} AFFICHER[/,{NUMERO}X,{CHAINE}]
{NUMERO} AFFICHER[/,{NUMERO}X,{NUMERO}{CHAINE},/]
{NUMERO} AFFICHER[C,{NUMERO}X,C,{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE},{NUMERO}X,{CHAINE}]
{NUMERO} AFFICHER[X,{CHAINE}];LIRE {IDENTIFICATEUR};LIRE {IDENTIFICATEUR}
{NUMERO} SI {IDENTIFICATEUR}={CHAINE} ALORS {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} SI {IDENTIFICATEUR}={CHAINE} ALORS {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} SI {IDENTIFICATEUR}={CHAINE} ALORS {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} SI {IDENTIFICATEUR}={CHAINE} ALORS ALLER EN {NUMERO}
{NUMERO} ALLER EN {NUMERO}
{NUMERO} AFFICHER[C,{NUMERO}X,C];TERMINER
{NUMERO} PROCEDURE {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} {IDENTIFICATEUR}_{NOMBRE}*{IDENTIFICATEUR}+{NUMERO};{IDENTIFICATEUR}_{IDENTIFICATEUR}+{NOMBRE}
{NUMERO} {IDENTIFICATEUR}({IDENTIFICATEUR},{IDENTIFICATEUR},{IDENTIFICATEUR});RETOUR EN {NUMERO}
{NUMERO} PROCEDURE {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} {IDENTIFICATEUR}_({IDENTIFICATEUR}-{NUMERO})/{NOMBRE};{IDENTIFICATEUR}_({IDENTIFICATEUR}-{NUMERO})/{NOMBRE}+{NOMBRE}
{NUMERO} {IDENTIFICATEUR}({IDENTIFICATEUR},{IDENTIFICATEUR},{IDENTIFICATEUR});RETOUR EN {NUMERO}
{NUMERO} PROCEDURE {IDENTIFICATEUR}({IDENTIFICATEUR})
{NUMERO} {IDENTIFICATEUR}_{IDENTIFICATEUR}-{NOMBRE};{IDENTIFICATEUR}_({IDENTIFICATEUR}-{NOMBRE})*{NOMBRE}+{NUMERO}
{NUMERO} {IDENTIFICATEUR}({IDENTIFICATEUR},{IDENTIFICATEUR},{IDENTIFICATEUR});RETOUR EN {NUMERO}
{NUMERO} PROCEDURE {IDENTIFICATEUR}({IDENTIFICATEUR},{IDENTIFICATEUR},{IDENTIFICATEUR})
{NUMERO} AFFICHER[C,{NUMERO}X,C,{NUMERO}X,{CHAINE},F{NUMERO}.{NUMERO},{NUMERO}X,{CHAINE},F{NUMERO}.{NUMERO},{NUMERO}X,{CHAINE},F{NUMERO}.{NUMERO},{NUMERO}X,{CHAINE}]{IDENTIFICATEUR},{IDENTIFICATEUR},{IDENTIFICATEUR}
{NUMERO} RETOUR
110*TEST BOUBLE SUR LIGNE INEXISTANTE
111 FAIRE 113 POUR I_1 JUSQUA 5
112 AFFICHER I
114 AFFICHER 'TERMINE';TERMINER
120*TEST FORMATS AVEC REPETITION VARIABLE
121 AFFICHER[3U]1,2,3
122 AFFICHER[*U]3,1,2,3
123 FAIRE 123 POUR N_0 JUSQUA 9;AFFICHER[*U,'!']N,1,2,3,4,5,6,7,8,9
124 FAIRE 124 POUR N_0 JUSQUA 9;AFFICHER[*U,'!',*F4.2]N,9,8,7,6,5,4,3,2,1,0
10 A_1
11 A_'A'
12 A[1]_3
13 A[1,2]_3
;; ;;You display the coroutine with the pair. The car to continue, the
;; ;;cdr condition
;;
;; (Define coroutine ' (#t. #t))
;;
;; ;;Reopening the continuation
;;
;; (define (resume)
;; (begin
;; (set-cdr! Coroutine #t)
;; ((car coroutine) 'dummy)
;; (newline)))
;;
;; ;; With condition as a #f, global escaping
;;
;; (define (suspend escape)
;; (set-car! Coroutine (begin
;; (set-cdr! Coroutine #f)
;; (call/cc (lambda (X) X))))
;; (if (cdr coroutine)
;; #f
;; (escape #f)))
;;
;;
;; (define (F dummy)
;; (call/cc
;; (lambda (escape)
;; (letrec ((iter (lambda (I)
;; (begin
;; (display I)
;; (suspend escape)
;; (iter (+ I 1))))))
;; (iter 0)))))
;;
;; (set-car! Coroutine F)
;;
;; (resume) (resume) (resume)
;;
;; ;; ... the resume please try executing many degrees
;;You display the coroutine with the pair. The car to continue, the
;;cdr condition
;;----------------------------------------------------------------------
#||
||#
;; (defun f ()
;; (let ((x 1))
;; (loop
;; (print `(f ,x))
;; (if (= 10 x)
;; (return-from f)
;; (suspend))
;; (incf x))))
;;
;; (defun g (n)
;; (let ((y 0))
;; (loop
;; (print `(g ,y))
;; (setf y (mod (1+ y) n))
;; (suspend)
;; (suspend))))
;;
;; (coroutines (f) (g 5) (g 7))
(asdf:operate 'asdf:load-op :com.informatimago.common-lisp)
(load "coroutine.lisp")
(use-package "COM.INFORMATIMAGO.COROUTINE")
(defun f ()
(let ((x 1))
(loop
(print `(f ,x))
(if (= 10 x)
(return-from f)
(suspend))
(incf x))))
(defun g (n)
(let ((y 0))
(loop
(print `(g ,y))
(setf y (mod (1+ y) n))
(suspend)
(suspend))))
(process-run-function "f" (function f))
(process-run-function "g" (function g) 5)
(start-scheduler)
(Define coroutine ' (#t. #t))
;;Reopening the continuation
(define (resume)
(begin
(set-cdr! Coroutine #t)
((car coroutine) 'dummy)
(newline)))
;; With condition as a #f, global escaping
(define (suspend escape)
(set-car! Coroutine (begin
(set-cdr! Coroutine #f)
(call/cc (lambda (X) X))))
(if (cdr coroutine)
#f
(escape #f)))
(define (F dummy)
(call/cc
(lambda (escape)
(letrec ((iter (lambda (I)
(begin
(display I)
(suspend escape)
(iter (+ I 1))))))
(iter 0)))))
(set-car! Coroutine F)
(resume) (resume) (resume)
;; ... the resume please try executing many degrees
(use-package :it.bese.arnesi)
(defstruct coroutine
routine
active)
(defparameter *coroutine* (make-coroutine))
(defun/cc resume ()
(setf (coroutine-active *Coroutine*) t)
(call/cc (coroutine-routine *coroutine*)))
(defun/cc suspend ()
(setf (coroutine-routine *Coroutine*)
(progn (setf (coroutine-active *Coroutine*) nil)
(call/cc (function identity))))
;; here, we pass first with active=nil, and then with active=t
(print `(active = ,(coroutine-active *coroutine*)))
(unless (coroutine-active *coroutine*)
(it.bese.arnesi::toplevel-k nil)))
(defun routine ()
(let ((i 0))
(loop
(print (incf i))
(suspend))))
(defun f (dummy)
(declare(ignore dummy))
(routine))
(setf *coroutine* (make-coroutine :routine (function f)
:active t))
;; Patch lse-domain.lisp, compile it and load it.
#+(or)
(let ((*package* *package*))
(rename-file "lse-domain.lisp" "lse-domain.src")
(with-open-file (out "lse-domain.lisp"
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(with-open-file (inp "lse-domain.src")
(loop
for sexp = (read inp nil inp)
until (eq sexp inp)
do (progn (when (and (listp sexp) (eq 'in-package (car sexp)))
(eval sexp))
;; skip tok-litchaine from the LSE-DOMAIN
(unless (and (listp sexp)
(eq 'defun (first sexp))
(eq 'tok-litchaine (second sexp)))
(print sexp out)))))))
;; provide correct tok-litchaine:
#+(or)
(DEFUN TOK-LITCHAINE (STRING &OPTIONAL (START 0) (END (LENGTH STRING)))
"\\('[^']*'\\)+"
(SETF zebu::*REGEX-GROUPINGS* 1)
(when (eql (char string start) #\')
(incf start)
(loop
(cond ((<= end start) ; String reaches eoln
;;(print `(:eoln ,end ,start --> nil))
(return-from tok-litchaine nil))
((eql (char string start) #\')
;;(print `(:quote ,(char string start) ,start --> increment))
(incf start)
(cond ((<= end start)
;;(print `(:ens ,start --> return ,start))
(SETF (CADR (SVREF zebu::*REGEX-GROUPS* 0)) start)
(return-from tok-litchaine start))
((eql (char string start) #\') ; go on
;;(print `(:quote , (char string start) ,start --> increm))
(incf start))
(t ; eos
;;(print `(:eos ,start --> return ,start))
(SETF (CADR (SVREF zebu::*REGEX-GROUPS* 0)) start)
(return-from tok-litchaine start))))
(t
;;(print `(:increment ,start --> ,(1+ start)))
(incf start))))))
This diff is collapsed.
doc/350.jpg

92.5 KB

This diff is collapsed.
start ::= ligne_programme | instruction | '?' expression .
numero ::= chiffre {chiffre} .
nombre ::= chiffre {chiffre} [ . {chiffre} ]
[ 'E' ['+'|'-'] chiffre {chiffre} ] .
chaine ::= "'" { caractere_sauf_quote | "''" } "'" .