CLOS make-instance è molto lento e causa l'esaurimento dell'heap in SBCL

Question

Sto scrivendo un assemblatore/disassemblatore multiarchitecture in Common Lisp (SBCL 1.1.5 in Debian GNU/Linux a 64 bit), attualmente l'assemblatore produce codice corretto per un sottoinsieme di x86-64. Per assemblare codice assembly x86-64 utilizzo una tabella hash in cui mnemonica istruzioni di assemblaggio (stringhe) come "jc-rel8" e "stosb" sono chiavi che restituiscono un elenco di 1 o più funzioni di codifica, come quelli indicati

 
(defparameter *emit-function-hash-table-x64* (make-hash-table :test 'equalp)) 
(setf (gethash "jc-rel8" *emit-function-hash-table-x64*) (list #'jc-rel8-x86)) 
(setf (gethash "stosb" *emit-function-hash-table-x64*) (list #'stosb-x86)) 

le funzioni di codifica sono come questi (alcuni sono più complicate, però):

 
(defun jc-rel8-x86 (arg1 &rest args) 
    (jcc-x64 #x72 arg1)) 

(defun stosb-x86 (&rest args) 
    (list #xaa)) 

Ora sto cercando di incorporare le istruzioni complete x86-64 impostato utilizzando NASM's (NASM 2.11.06) codifica dei dati di istruzioni (file insns.dat) convertito in Common Lisp CLOS sintassi. Ciò significherebbe sostituire le normali funzioni utilizzate per l'emissione di codice binario (come le funzioni precedenti) con istanze di una classe personalizzata x86-asm-instruction (una classe molto semplice finora, circa 20 slot con :initarg, :reader, :initform ecc.), In cui un metodo emit con argomenti verrebbe usato per emettere il codice binario per le istruzioni date (mnemonico) e gli argomenti. I dati di istruzioni convertiti hanno questo aspetto (ma sono più di 40.000 linee e esattamente 7193 make-instance e 7193 setf).

 

;; first mnemonic + operand combination instances (:is-variant t). 
;; there are 4928 such instances for x86-64 generated from NASM's insns.dat. 

(eval-when (:compile-toplevel :load-toplevel :execute) 

(setf Jcc-imm-near (make-instance 'x86-asm-instruction 
:name "Jcc" 
:operands "imm|near" 
:code-string "[i: odf 0f 80+c rel]" 
:arch-flags (list "386" "BND") 
:is-variant t)) 

(setf STOSB-void (make-instance 'x86-asm-instruction 
:name "STOSB" 
:operands "void" 
:code-string "[ aa]" 
:arch-flags (list "8086") 
:is-variant t)) 

;; then, container instances which contain (or could be refer to instead) 
;; the possible variants of each instruction. 
;; there are 2265 such instances for x86-64 generated from NASM's insns.dat. 

(setf Jcc (make-instance 'x86-asm-instruction 
         :name "Jcc" 
         :is-container t 
         :variants (list Jcc-imm-near 
             Jcc-imm64-near 
             Jcc-imm-short 
             Jcc-imm 
             Jcc-imm 
             Jcc-imm 
             Jcc-imm))) 

(setf STOSB (make-instance 'x86-asm-instruction 
          :name "STOSB" 
          :is-container t 
          :variants (list STOSB-void))) 

;; thousands of objects more here... 

) ; this bracket closes (eval-when (:compile-toplevel :load-toplevel :execute) 

Ho convertito insns.dat al Common Lisp sintassi di NASM (come sopra) utilizzando uno script Perl banale (più avanti, ma non c'è niente di interesse nello script stesso) e, in linea di principio funziona. Quindi funziona, ma la compilazione di quei 7193 oggetti è davvero molto lenta e causa spesso esaurimento dell'heap. Sul mio portatile Linux core i7-2760QM con 16G della memoria la redazione di un blocco di codice con (eval-when (:compile-toplevel :load-toplevel :execute) 7193 oggetti come quelli di cui sopra prende più di 7 minuti e, a volte provoca mucchio esaurimento, come questo:

 
;; Swank started at port: 4005. 
* Heap exhausted during garbage collection: 0 bytes available, 32 requested. 
Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age 
    0:  0  0  0  0  0  0  0  0  0  0  0 41943040 0 0 0.0000 
    1:  0  0  0  0  0  0  0  0  0  0  0 41943040 0 0 0.0000 
    2:  0  0  0  0  0  0  0  0  0  0  0 41943040 0 0 0.0000 
    3: 38805 38652  0  0 49474 15433 389 416  0 2144219760 9031056 1442579856 0 1 1.5255 
    4: 127998 127996  0  0 45870 14828 106 143 199 1971682720 25428576 2000000 0 0 0.0000 
    5:  0  0  0  0  0  0  0  0  0  0  0 2000000 0 0 0.0000 
    6:  0  0  0  0 1178 163  0  0  0 43941888  0 2000000 985 0 0.0000 
    Total bytes allocated = 4159844368 
    Dynamic-space-size bytes = 4194304000 
GC control variables: 
    *GC-INHIBIT* = true 
    *GC-PENDING* = in progress 
    *STOP-FOR-GC-PENDING* = false 
fatal error encountered in SBCL pid 9994(tid 46912556431104): 
Heap exhausted, game over. 

Welcome to LDB, a low-level debugger for the Lisp runtime environment. 
ldb> 

ho avuto aggiungere il parametro --dynamic-space-size 4000 per SBCL per farlo compilare del tutto, ma a volte dopo l'allocazione di 4 gigabyte di heap dello spazio dinamico a volte si esaurisce. Anche se l'esaurimento dell'heap dovesse essere risolto, più di 7 minuti per la compilazione di 7193 istanze dopo l'aggiunta di uno slot nella classe (classe 'x86-asm-instruction utilizzata per queste istanze) è troppo per lo sviluppo interattivo in REPL (io uso slimv, se questo è importante).

Ecco (time (compile-file uscita:

 
; caught 18636 WARNING conditions 


; insns.fasl written 
; compilation finished in 0:07:11.329 
Evaluation took: 
    431.329 seconds of real time 
    238.317000 seconds of total run time (234.972000 user, 3.345000 system) 
    [ Run times consist of 6.073 seconds GC time, and 232.244 seconds non-GC time. ] 
    55.25% CPU 
    50,367 forms interpreted 
    784,044 lambdas converted 
    1,031,842,900,608 processor cycles 
    19,402,921,376 bytes consed 

Uso OOP (CLOS) consentirebbe incorporante la mnemonico istruzione (ad esempio jc o stosb sopra, :name), accettati operandi dell'istruzione (:operands), codifica binaria di istruzione (come #xaa per stosb, :code-string) e possibili limitazioni di architettura (:arch-flags) dell'istruzione in un oggetto. Ma sembra che almeno il mio computer di 3 anni non sia abbastanza efficiente da compilare rapidamente circa 7000 istanze di oggetti CLOS.

La mia domanda è: c'è un modo per rendere SBLC make-instance più veloce o dovrei continuare a generare codice di assemblaggio in funzioni regolari come gli esempi sopra? Sarei anche molto felice di conoscere altre possibili soluzioni.

Ecco lo script Perl, nel caso in cui:

#!/usr/bin/env perl 
use strict; 
use warnings; 

# this program converts NASM's `insns.dat` to Common Lisp Object System (CLOS) syntax. 

my $firstchar; 
my $line_length; 
my $are_there_square_brackets; 
my $mnemonic_and_operands; 
my $mnemonic; 
my $operands; 
my $code_string; 
my $flags; 
my $mnemonic_of_current_mnemonic_array; 

my $clos_object_name; 
my $clos_mnemonic; 
my $clos_operands; 
my $clos_code_string; 
my $clos_flags; 

my @object_name_array =(); 
my @mnemonic_array =(); 
my @operands_array =(); 
my @code_string_array =(); 
my @flags_array =(); 

my @each_mnemonic_only_once_array =(); 

my @instruction_variants_array =(); 
my @instruction_variants_for_current_instruction_array =(); 

open(FILE, 'insns.dat'); 

$mnemonic_of_current_mnemonic_array = ""; 

# read one line at once. 
while (<FILE>) 
{ 
    $firstchar = substr($_, 0, 1); 
    $line_length = length($_); 
    $are_there_square_brackets = ($_ =~ /\[.*\]/); 
    chomp; 
    if (($line_length > 1) && ($firstchar =~ /[^\t ;]/)) 
    { 
     if ($are_there_square_brackets) 
     { 
      ($mnemonic_and_operands, $code_string, $flags) = split /[\[\]]+/, $_; 
      $code_string = "[" . $code_string . "]"; 
      ($mnemonic, $operands) = split /[\t ]+/, $mnemonic_and_operands; 
     } 
     else 
     { 
      ($mnemonic, $operands, $code_string, $flags) = split /[\t ]+/, $_; 
     } 
     $mnemonic =~ s/[\t ]+/ /g; 
     $operands =~ s/[\t ]+/ /g; 
     $code_string =~ s/[\t ]+/ /g; 
     $flags =~ s/[\t ]+//g; 

     # we don't want non-x86-64 instructions here. 
     unless ($flags =~ "NOLONG") 
     { 
      # ok, the content of each field is now filtered, 
      # let's convert them to a suitable Common Lisp format. 
      $clos_object_name = $mnemonic . "-" . $operands; 

      # in Common Lisp object names `|`, `,`, and `:` must be escaped with a backslash `\`, 
      # but that would get too complicated. 
      # so we'll simply replace them: 
      # `|` -> `-`. 
      # `,` -> `.`. 
      # `:` -> `.`. 
      $clos_object_name =~ s/\|/-/g;    
      $clos_object_name =~ s/,/./g;    
      $clos_object_name =~ s/:/./g;    

      $clos_mnemonic = "\"" . $mnemonic . "\""; 
      $clos_operands = "\"" . $operands . "\""; 
      $clos_code_string = "\"" . $code_string . "\""; 

      $clos_flags = "\"" . $flags . "\"";  # add first and last double quotes. 
      $clos_flags =~ s/,/" "/g;     # make each flag its own Common Lisp string. 
      $clos_flags = "(list " . $clos_flags. ")"; # convert to `list` syntax. 

      push @object_name_array, $clos_object_name; 
      push @mnemonic_array, $clos_mnemonic; 
      push @operands_array, $clos_operands; 
      push @code_string_array, $clos_code_string; 
      push @flags_array, $clos_flags; 

      if ($mnemonic eq $mnemonic_of_current_mnemonic_array) 
      { 
       # ok, same mnemonic as the previous one, 
       # so the current object name goes to the list. 
       push @instruction_variants_for_current_instruction_array, $clos_object_name; 
      } 
      else 
      { 
       # ok, this is a new mnemonic. 
       # so we'll mark this as current mnemonic. 
       $mnemonic_of_current_mnemonic_array = $mnemonic; 
       push @each_mnemonic_only_once_array, $mnemonic; 

       # we first push the old array (unless it's empty), then clear it, 
       # and then push the current object name to the cleared array. 

       if (@instruction_variants_for_current_instruction_array) 
       { 
        # push the variants array, unless it's empty. 
        push @instruction_variants_array, [ @instruction_variants_for_current_instruction_array ]; 
       } 
       @instruction_variants_for_current_instruction_array =(); 
       push @instruction_variants_for_current_instruction_array, $clos_object_name; 
      } 
     } 
    } 
} 

# the last instruction's instruction variants must be pushed too. 
if (@instruction_variants_for_current_instruction_array) 
{ 
    # push the variants array, unless it's empty. 
    push @instruction_variants_array, [ @instruction_variants_for_current_instruction_array ]; 
} 

close(FILE); 

# these objects need be created already during compilation. 
printf("(eval-when (:compile-toplevel :load-toplevel :execute)\n"); 

# print the code to create each instruction + operands combination object. 

for (my $i=0; $i <= $#mnemonic_array; $i++) 
{ 
    $clos_object_name = $object_name_array[$i]; 
    $mnemonic   = $mnemonic_array[$i]; 
    $operands   = $operands_array[$i]; 
    $code_string  = $code_string_array[$i]; 
    $flags   = $flags_array[$i]; 

    # print the code to create a variant object. 
    # each object here is a variant of a single instruction (or a single mnemonic). 
    # actually printed as 6 lines to make it easier to read (for us humans, I mean), with an empty line in the end. 
    printf("(setf %s (make-instance 'x86-asm-instruction\n:name %s\n:operands %s\n:code-string %s\n:arch-flags %s\n:is-variant t))", 
     $clos_object_name, 
     $mnemonic, 
     $operands, 
     $code_string, 
     $flags); 
    printf("\n\n"); 
} 

# print the code to create each instruction + operands combination object. 

# for (my $i=0; $i <= $#each_mnemonic_only_once_array; $i++) 
for my $i (0 .. $#instruction_variants_array) 
{ 
    $mnemonic = $each_mnemonic_only_once_array[$i]; 

    # print the code to create a container object. 
    printf("(setf %s (make-instance 'x86-asm-instruction :name \"%s\" :is-container t :variants (list \n", $mnemonic, $mnemonic); 
    @instruction_variants_for_current_instruction_array = $instruction_variants_array[$i]; 

    # for (my $j=0; $j <= $#instruction_variants_for_current_instruction_array; $j++) 
    for my $j (0 .. $#{$instruction_variants_array[$i]}) 
    { 
     printf("%s", $instruction_variants_array[$i][$j]); 

     # print 3 closing brackets if this is the last variant. 
     if ($j == $#{$instruction_variants_array[$i]}) 
     { 
      printf(")))"); 
     } 
     else 
     { 
      printf(" "); 
     } 
    } 

    # if this is not the last instruction, print two newlines. 
    if ($i < $#instruction_variants_array) 
    { 
     printf("\n\n"); 
    } 
} 

# print the closing bracket to close `eval-when`. 
print(")"); 

exit; 

Answer 1

18636 avvertimenti sembra davvero male, iniziare a sbarazzarsi di tutti gli avvertimenti.

Vorrei iniziare sbarazzandomi del EVAL-WHEN. Non ha molto senso per me. Carica il file direttamente oppure compila e carica il file.

Si noti inoltre che a SBCL non piace (setf STOSB-void ...) quando la variabile non è definita. Nuove variabili di primo livello vengono introdotte con DEFVAR o DEFPARAMETER. SETF li imposta, ma non li definisce. Questo dovrebbe aiutare a sbarazzarsi degli avvertimenti.

Anche :is-container t e :is-variant t odori come queste proprietà devono essere convertiti in classi da ereditare da (ad esempio come mixin). Un contenitore ha varianti. Una variante non ha varianti.