anchor.diff:                 :format-control "PAS DE PROGRAMME NOMME '~A' ACCESSIBLE"
                  :format-arguments (list name)))))
   
  +
  +
  +(defun decompile-lse-line (lino code)
  +  (declare (ignore lino))
  +  ;; For now, we cheat, we don't decompile anything, we just return
  +  ;; the unparsed source kept along with the code vector.
  +  (third code))
  +
  +
  +(defun decompile-lse-line-2 (lino byte-code)
  +  (with-output-to-string (source)
  +    (princ lino source) (princ " " source)
  +    (flet ((nbop (cop) (cdr (gethash cop *cop-info* '(0 . 0))))
  +           (disa (cop) (car (gethash cop *cop-info* (cons cop 0)))))
  +      (let ((pc 0)
  +            (listing '())
  +            (labels '()))
  +        (loop :while (< pc (length byte-code)) :do
  +          (let ((cop (list (disa (aref byte-code pc))))
  +                (noa       (nbop (aref byte-code pc))))
  +            (incf pc)
  +            (dotimes (n noa)
  +              (setf cop (nconc cop (list (aref byte-code pc))))
  +              (incf pc))
  +            (push cop listing)
  +            (when (member (first cop) bc::*branches*)
  +              (push (+ pc (second cop)) labels))))
  +        (setf listing (nreverse listing))
  +        (princ listing source)
  +        #-(and)
  +        (loop
  +          :initially (format t "~&")
  +          :with pc = 0
  +          :for line :in listing
  +          :do (progn (if (member pc labels)
  +                         (format t "@~6:A " pc)
  +                         (format t "        "))
  +                     (format t "~32:A"
  +                             (with-output-to-string (out)
  +                               (princ "(" out)
  +                               (let ((first t))
  +                                 (dolist (item line)
  +                                   (if first
  +                                       (setf first nil)
  +                                       (princ " " out))
  +                                   (if (symbolp item)
  +                                       (princ item out)
  +                                       (prin1 item out))))
  +                               (princ ")" out)))
  +                     (if (member (first line) bc::*branches*)
  +                         (format t " ; @~A~%"  (+ pc (length line) (second line)))
  +                         (format t "~%"))
  +                     (incf pc (length line))))))
  +    #-(and)
  +    (loop
  +
  +      (case
  +
  +          
  +          (cl:defparameter *branches* '(
  +                                        BALWAYS ;       BALWAYS offset
  +                                        BTRUE   ; test  BTRUE   offset
  +                                        BFALSE  ; test  BFALSE  offset
  +                                        BNEVER  ;       BNEVER  offset
  +                                        ))
  +        
  +        (cl:defparameter *0* '(
  +                               DUP ; arg DUP
  +
  +                               NON ; arg NON 
  +                               OU  ; arg1 arg2 OU
  +                               ET  ; arg1 arg2 ET
  +
  +                               EG  ; arg1 arg2 EG
  +                               NE  ; arg1 arg2 NE
  +                               LE  ; arg1 arg2 LE
  +                               LT  ; arg1 arg2 LT
  +                               GE  ; arg1 arg2 GE
  +                               GT  ; arg1 arg2 GT
  +
  +                               CONCAT ; arg1 arg2 CONCAT
  +
  +                               NEG ; arg NEG
  +                               ADD ; arg1 arg2 ADD
  +                               SUB ; arg1 arg2 SUB
  +                               MUL ; arg1 arg2 MUL
  +                               DIV ; arg1 arg2 DIV
  +                               POW ; arg1 arg2 POW
  +
  +
  +                               AFFICHER-E        ; rep e f AFFICHER-E
  +                               AFFICHER-F        ; rep e f AFFICHER-F
  +                               AFFICHER-CR       ; rep AFFICHER-CR
  +                               AFFICHER-CHAINE   ; rep chaine AFFICHER-CHAINE
  +                               AFFICHER-NEWLINE  ; rep AFFICHER-NEWLINE
  +                               AFFICHER-NL       ; rep AFFICHER-NL
  +                               AFFICHER-SPACE    ; rep AFFICHER-SPACE
  +                               AFFICHER-U        ; nexpr AFFICHER-U
  +
  +                               NEXT-LINE  ; NEXT-LINE
  +                               RETOUR     ; RETOUR
  +                               RETOUR-EN  ; line RETOUR-EN
  +                               RESULT     ; arg RESULT
  +                               GOTO       ; line GOTO
  +
  +                               TANT-QUE                 ; test TANT-QUE
  +                               CHARGER                  ; enr fic CHARGER
  +                               SUPPRIMER-ENREGISTREMENT ; enr fic SUPPRIMER-ENREGISTREMENT
  +                               SUPPRIMER-FICHIER        ;     fic SUPPRIMER-FICHIER
  +                               EXECUTER  ; fic lin EXECUTED
  +                               PAUSE     ; PAUSE
  +                               TERMINER  ; TERMINER
  +
  +                               PROCEDURE
  +                               comment ; COMMENT comment
  +                               ))
  +
  +        (cl:defparameter *1* '(
  +                               AREF1&PUSH-REF ; idx AREF1&PUSH-REF identifier
  +                               AREF1&PUSH-VAL ; idx AREF1&PUSH-VAL identifier
  +                               AREF2&PUSH-REF ; idx1 idx2 AREF2&PUSH-REF identifier
  +                               AREF2&PUSH-VAL ; idx1 idx2 AREF2&PUSH-VAL identifier
  +
  +                               POP&ASTORE1    ; val idx POP&ASTORE1 identifier
  +                               POP&ASTORE2    ; val idx1 idx2 POP&ASTORE2 identifier
  +                               POP&STORE      ; val POP&STORE identifier
  +
  +                               PUSH-REF       ; PUSH-REF identifier
  +                               PUSH-VAL       ; PUSH-REF identifier
  +                               PUSHI          ; PUSHI immediate-value
  +
  +                               LIRE&STORE        ; LIRE&STORE ident
  +                               LIRE&ASTORE1      ; index LIRE&ASTORE1 ident
  +                               LIRE&ASTORE2      ; idx1 idx2 LIRE&ASTORE1 ident
  +
  +                               CHAINE         ; CHAINE identifier
  +                               TABLEAU1       ; dim TABLEAU1 identifier
  +                               TABLEAU2       ; dim1 dim2 TABLEAU2 identifier
  +                               LIBERER        ; LIBERER identifier
  +
  +                               BALWAYS    ;      BALWAYS offset
  +                               BTRUE      ; test BTRUE   offset
  +                               BFALSE     ; test BFALSE  offset
  +                               BNEVER     ;      BNEVER  offset
  +
  +                               FAIRE-JUSQU-A   ; lino init pas jusqua FAIRE-JUSQU-A ident
  +                               FAIRE-TANT-QUE  ; lino init pas FAIRE-TANT-QUE ident
  +                                        ; test TANT-QUE
  +                               GARER           ; enr fic GARER identificateur
  +                               ))
  +
  +        (cl:defparameter *2* '(CALL            ; CALL identificateur-procedure nombre-d-argument
  +                               ))))))
  +
  +
  +
  +
  +;;;---------------------------------------------------------------------
  +;;; 3- Disassembler
  +;;;---------------------------------------------------------------------
   
   
   (defparameter *cop-info*
  
positive.code:   (cond
      ((null parse-tree) (list 0 #()))           ; nothing to do
      ((atom parse-tree)
       (format *error-output* "~&ERREUR: JE TROUVE UN ATOME: ~S~%" parse-tree))
      ((eq (car parse-tree) :liste-instructions)
       (list 0 (compile-slist (cdr parse-tree) BC::TERMINER)))
      ((eq (car parse-tree) :ligne-programme)
       (list (numero-valeur (cadr parse-tree)) (compile-slist (cddr parse-tree) BC::NEXT-LINE)))
      (t
       (format *error-output* "~&ERREUR: JE TROUVE UNE LISTE INVALIDE: ~S~%" parse-tree))))
  
  
  
  ;; lire --> vref
  ;; si --> vval/aval
  ;; adecl --> vref/aref
  
  
  ;; zebu:
  
negative.code: ;;;;AUTHORS
  ;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
  ;;;;MODIFICATIONS
  ;;;;    2012-02-19 <PJB> Implemented the expression unparser.
  ;;;;    2005-08-25 <PJB> Created.
  ;;;;BUGS
  ;;;;    LIRE must take into account the type of the variable.
  