anchor.diff:  ;;;;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.
  
positive.code: ;; (test/parse-file #P"~/src/pjb/lse-cl/SYNTERR.LSE")
  ;; (test/parse-file #P"~/src/pjb/lse/BOURG/BOUR.LSE")
  ;; (test/parse-string "18*")
  
  
  ;; (compile-lse-file #P "~/src/pjb/lse/BOURG/BOUR.LSE")
  ;; (compile-lse-file #P "~/src/pjb/lse-cl/TESTCOMP.LSE")
  
  ;; (test/compile-lse-file #P "~/src/pjb/lse-cl/TESTCOMP.LSE")
  
  
  
  
negative.code:                :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*
  