Changeset 22523

Show
Ignore:
Timestamp:
10/07/08 09:51:39 (6 weeks ago)
Author:
pmurias
Message:

[smop] converted s1p_lexicalscope to RI, and extended the RI language to make it work

Location:
v6/smop
Files:
2 added
7 modified

Legend:

Unmodified
Added
Removed

  • v6/smop/CMakeLists.txt

    r22512 r22523  
    5555        COMMAND perl ARGS ${smop_SOURCE_DIR}/tools/dsl ri ${smop_SOURCE_DIR}/ ${CMAKE_CURRENT_BINARY_DIR}/m0ld_exe ${smop_SOURCE_DIR}/${dsl_file} ${CMAKE_CURRENT_BINARY_DIR}/${c_file} 
    5656        DEPENDS ${smop_SOURCE_DIR}/${dsl_file} 
     57        DEPENDS ${smop_SOURCE_DIR}/tools/ri 
    5758    ) 
    5859endmacro(compile_ri) 
    … …  
    8889foreach (sm0p_file 
    8990    src/lowlevel.sm0p 
    90     src/s1p_lexicalscope.sm0p 
    9191    src/s1p_defaultblocksignature.sm0p 
    9292    src/s1p_bindcapturesignature.sm0p 
    … …  
    104104foreach (ri_file 
    105105    src/s1p_io.ri 
     106    src/s1p_lexicalscope.ri 
     107    src/proto.ri 
    106108) 
    107109compile_ri (${ri_file}) 
    … …  
    147149    src/slime_node.c 
    148150    src/ri.c 
     151    src/proto.c 
    149152#    src_s1p_itemcontext.c 
    150153#    src_s1p_itemrwcontext.c 

  • v6/smop/include/smop_lowlevel.h

    r22230 r22523  
    5656  char *id 
    5757);  
     58SMOP__Object* SMOP__Proto__create(SMOP__Object*,SMOP__Object*); 
    5859 
    5960/* This functions decrements the reference count of a value, it should 

  • v6/smop/src/internal.h

    r22512 r22523  
    3434     smop_native_bool_destr();           \ 
    3535     smop_native_capture_destr();        \ 
     36     smop_ri_destr();                    \ 
     37     smop_proto_destr();                 \ 
    3638     smop_interpreter_destr();           \ 
    3739     smop_lowlevel_destr();              \ 
    38      smop_ri_destr();                    \ 
    39      smop_idconst_destr(); 
     40     smop_idconst_destr();               
    4041 
    4142/* 
    … …  
    5859     smop_s1p_io_init();                    \ 
    5960     smop_s1p_attribute_init();             \ 
    60      smop_s1p_lexicalscope_init();          \ 
    6161     smop_s1p_capturize_init();             \ 
    6262     smop_s1p_defaultblocksignature_init(); \ 
    … …  
    7878     smop_s1p_defaultblocksignature_destr();\ 
    7979     smop_s1p_capturize_destr();            \ 
    80      smop_s1p_lexicalscope_destr();         \ 
    8180     smop_s1p_attribute_destr();            \ 
    8281     smop_s1p_io_destr();                   \ 
    … …  
    9392 
    9493#define SMOP_BOOTSTRAP_INIT_SEQUENCE        \ 
     94     smop_proto_init();                  \ 
    9595     smop_s1p_root_namespace_init();        \ 
    96      smop_s1p_lexicalscope_mold_init();     \ 
     96     smop_s1p_lexicalscope_init();     \ 
    9797     smop_s1p_defaultblocksignature_mold_init(); \ 
    9898     smop_s1p_bindcapturesignature_mold_init();  \ 
    … …  
    111111     smop_s1p_bindcapturesignature_mold_destr(); \ 
    112112     smop_s1p_defaultblocksignature_mold_destr();\ 
    113      smop_s1p_lexicalscope_mold_destr();    \ 
     113     smop_s1p_lexicalscope_destr();    \ 
    114114     smop_s1p_root_namespace_destr();       \ 
    115115 
    … …  
    148148void smop_s1p_lexicalscope_init(); 
    149149void smop_s1p_lexicalscope_destr(); 
    150 void smop_s1p_lexicalscope_mold_init(); 
    151 void smop_s1p_lexicalscope_mold_destr(); 
    152150void smop_s1p_defaultblocksignature_init(); 
    153151void smop_s1p_defaultblocksignature_destr(); 

  • v6/smop/src/ri.c

    r22512 r22523  
    5454 
    5555void smop_ri_init() { 
    56   SMOP__RI = calloc(1,sizeof(SMOP__ResponderInterface)); 
     56  SMOP__RI = malloc(sizeof(SMOP__ResponderInterface)); 
    5757  ((SMOP__ResponderInterface*)SMOP__RI)->MESSAGE = message; 
    5858  ((SMOP__ResponderInterface*)SMOP__RI)->REFERENCE = ri_reference;//smop_lowlevel_generic_reference; 
    … …  
    6363 
    6464void smop_ri_destr() { 
    65   free(SMOP__RI); 
     65  //free(SMOP__RI); 
    6666} 
    6767 
    … …  
    8888    return ret; 
    8989} 
    90  

  • v6/smop/src/s1p_io.ri

    r22512 r22523  
    1 %prototype IO 
     1//%prototype IO 
    22%RI.id lowlevel io 
    33%prefix smop_s1p_io 
    44 
    55%{ 
    6 typedef struct smop_s1p_io_struct { 
    7   SMOP__Object__BASE 
    8 } smop_s1p_io_struct; 
    9  
    106SMOP__Object* SMOP__S1P__IO_create(SMOP__Object* interpreter) { 
    117    SMOP_REFERENCE(interpreter,RI); 

  • v6/smop/tools/dsl

    r22263 r22523  
    1212    system("perl $elfX -C m0ld -s $in > $out"); 
    1313} elsif ($dsl eq 'ri') { 
    14     system("perl $base/tools/ri $in > $out"); 
     14    system("perl -I$base/../../src/perl6 $base/tools/ri $base $m0ld $in > $out"); 
    1515} elsif ($dsl eq 'p6-pugs') { 
    1616    system("$base/../../pugs -Cm0ld $in > $out"); 

  • v6/smop/tools/ri

    r22303 r22523  
    11#!/usr/bin/perl 
     2package SMOP::RI; 
    23use warnings; 
    34use strict; 
    4  
     5use IO::Select; 
     6use IO::Handle; 
     7use IPC::Open3; 
     8use Symbol; 
     9require 'mangle.pl'; 
     10 
     11 
     12my ($base,$m0ld) = (shift @ARGV,shift @ARGV); 
     13sub preprocess_m0ld { 
     14    my $code = shift; 
     15    #warn "got m0ld code <$code>\n"; 
     16    return preprocess($code,"$m0ld"); 
     17} 
     18sub preprocess { 
     19    my $code = shift; 
     20    my ($writer, $reader, $error) = map { gensym } 1..3; 
     21    my $pid = open3($writer, $reader, $error,@_) || die "$@"; 
     22    print {$writer} $code; 
     23    close $writer; 
     24 
     25    my ($errbuf, $retbuf) = ('',''); 
     26 
     27    $reader->blocking(0); 
     28    $error->blocking(0); 
     29 
     30    my $select = IO::Select->new(); 
     31    $select->add($reader); 
     32    $select->add($error); 
     33 
     34    while ($select->can_read(10000) && (!eof($reader) || !eof($error))) { 
     35 
     36        my $buf = ''; 
     37        my $returncode = read $reader, $buf, 1024; 
     38        $retbuf .= $buf; 
     39 
     40        $buf = ''; 
     41        my $returncode2 = read $error, $buf, 1024; 
     42        $errbuf .= $buf; 
     43 
     44    } 
     45 
     46    print $errbuf; 
     47    close $reader; 
     48    close $error; 
     49    waitpid($pid,0); 
     50    die join(' ',@_).' returned failure '.$? if ($? || !$retbuf || $retbuf eq "\n") ; 
     51    return $retbuf; 
     52} 
    553sub mangle { 
    654    my $id = shift; 
    7     return 'ID__'.$id; 
     55    return 'ID__'.::mangle($id); 
    856} 
    957 
    … …  
    1462my $method; 
    1563 
    16 my $raw = ''; 
     64my %mold; 
     65my $mold; 
     66 
     67my %attrs; 
     68my @getters; 
     69 
     70my %raw; 
    1771 
    1872sub debug { 
    1973} 
    2074while (my $line = <>) { 
    21     if ($line =~ /^\%\{\s*/) { 
    22          debug "raw start\n"; 
     75    if ($line =~ /^\%\s*(\w*)\s*\{\s*$/) { 
     76         debug "raw.$1 start\n"; 
     77         $raw{$1} = ''; 
    2378         until((my $raw_line = <>) =~ /^\%}\s*$/) { 
    2479             debug "raw $raw_line"; 
    25              $raw .= $raw_line; 
     80             $raw{$1} .= $raw_line; 
    2681         } 
    27          debug "raw stop\n"; 
     82         debug "raw.R1 stop\n"; 
    2883    } elsif ($method) { 
    2984        if ($line =~ /^%/) { 
    … …  
    3590            next; 
    3691        } 
     92    } elsif ($mold) { 
     93        if ($line =~ /^%/) { 
     94            undef $mold; 
     95            redo; 
     96        } else { 
     97            debug "in mold $line"; 
     98            $mold{$mold} .= $line; 
     99            next; 
     100        } 
    37101    } elsif ($line =~ /^%method\s*(.*)$/) { 
    38102        $method = $1; 
    39103        debug "method start:$method\n"; 
     104    } elsif ($line =~ /^%mold\s*(.*)$/) { 
     105        $mold = $1; 
     106        debug "mold start:$mold\n"; 
     107    } elsif ($line =~ /^%attr\s*(.*?)\s*(\S+)$/) { 
     108        $attrs{$2} = $1; 
     109    } elsif ($line =~ /^%getter\s*(\S+)$/) { 
     110        push(@getters,$1); 
    40111    } elsif ($line =~ / ^\s*$ | ^\# | ^\/\/ /x) { 
    41112        debug "ws/comment:$line"; 
    … …  
    53124} 
    54125 
     126die "a %prefix is required\n" unless $properties{prefix}; 
    55127 
    56128print qq[/* generated by tools/ri - do not edit*/ 
    … …  
    60132#include <stdlib.h> 
    61133#include <stdio.h> 
     134#include <smop_mold.h> 
    62135]; 
    63136for (split (/,/,$properties{include} || '')) { 
    … …  
    67140my $id = defined $properties{"RI.id"} ? $properties{"RI.id"} : "unknown RI"; 
    68141 
     142if ($properties{prototype}) { 
     143    print "SMOP__Object* $properties{prototype};\n"; 
     144} 
    69145if ($properties{RI}) { 
    70146    print "SMOP__Object* $properties{RI};\n"; 
    … …  
    76152    print 'static SMOP__Object* ',mangle($_),";\n"; 
    77153} 
    78  
    79 print $raw; 
    80  
     154for (keys %mold) { 
     155    print 'static SMOP__Object* ',$_,";\n"; 
     156} 
     157print qq[ 
     158typedef struct $properties{prefix}_struct { 
     159  SMOP__Object__BASE 
     160]; 
     161while (my ($name,$type) = each %attrs) { 
     162    print "  $type $name;\n"; 
     163} 
     164print "} $properties{prefix}_struct;\n"; 
     165 
     166print $raw{''} || ''; 
     167 
     168 
     169for my $getter (@getters) { 
     170    $methods{$getter} = qq[    smop_lowlevel_rdlock(invocant); 
     171    ret = (($properties{prefix}_struct*)invocant)->$getter; 
     172    smop_lowlevel_unlock(invocant); 
     173    SMOP_REFERENCE(interpreter, ret); 
     174]; 
     175} 
    81176print q[ 
    82177static SMOP__Object* message(SMOP__Object* interpreter, 
    … …  
    84179                                     SMOP__Object* identifier, 
    85180                                     SMOP__Object* capture) { 
     181]; 
     182 
     183print '  '; 
     184if ($raw{message}) { 
     185    print $raw{message}; 
     186} else { 
     187print q[ 
    86188  ___NATIVE_CAPTURE_ONLY___; 
    87189  ___CONST_IDENTIFIER_ONLY___; 
    88   ___INVOCANT_RI_SHOULD_MATCH___; 
     190  SMOP__Object* invocant = (SMOP__Object*) SMOP__NATIVE__capture_invocant(interpreter, capture); 
    89191  SMOP__Object* ret = SMOP__NATIVE__bool_false; 
    90  
    91 ]; 
    92 print '  '; 
    93 while (my ($method,$body) = each %methods) { 
    94     print "if (",mangle($method)," == identifier) {\n$body  } else "; 
    95 } 
    96 print qq[{ 
     192]; 
     193    while (my ($method,$body) = each %methods) { 
     194        print "if (",mangle($method)," == identifier) {\n$body  } else "; 
     195    } 
     196    print qq[{ 
    97197    ___UNKNOWN_METHOD___; 
    98198  } 
    … …  
    101201  SMOP_RELEASE(interpreter,capture); 
    102202  return ret; 
     203    ]; 
     204} 
     205print q[ 
    103206} 
    104207]; 
    … …  
    112215      "$id"); 
    113216]; 
     217print "  SMOP__Object* interpreter = SMOP__GlobalInterpreter;\n"; 
    114218for (keys %methods) { 
    115219    print "  ",mangle($_)," = ","SMOP__NATIVE__idconst_create(\"$_\");\n"; 
    116220} 
     221while (my ($name,$mold) = each %mold) { 
     222    print "  $name = ",preprocess_m0ld($mold),";\n"; 
     223} 
     224 
     225if ($properties{prototype}) { 
     226    print qq[ 
     227  $properties{prototype} = SMOP__Proto__create(interpreter,SMOP_REFERENCE(interpreter,$RI)); 
     228]; 
     229} 
    117230print qq[  
    118231} 
    119232 
    120233void $properties{prefix}_destr() { 
     234]; 
     235#printf("$properties{prefix}_destr()\\n"); 
     236if ($properties{prototype}) { 
     237    print qq[ 
     238 SMOP_RELEASE(SMOP__GlobalInterpreter,$properties{prototype}); 
     239    ]; 
     240} 
     241while (my ($name,$mold) = each %mold) { 
     242    print "SMOP_RELEASE(SMOP__GlobalInterpreter,$name);\n"; 
     243} 
     244print qq[ 
    121245  SMOP_RELEASE(SMOP__GlobalInterpreter,$RI); 
    122246} 
    123 ] 
     247]; 
     248print $raw{'bottom'} || '';