languages/WMLScript/src/wmlsstdlibs.pir

   1 # Copyright (C) 2006-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 src/wmlsstdlibs.pir - WMLScript standard libraries
   7
   8 =head1 DESCRIPTION
   9
  10 See "WMLScript Standard Libraries Specification".
  11
  12 =over 4
  13
  14 =item * Lang : F<languages/WMLScript/runtime/wmlslang.pir>
  15
  16 =item * Float : F<languages/WMLScript/runtime/wmlsfloat.pir>
  17
  18 =item * String : F<languages/WMLScript/runtime/wmlsstring.pir>
  19
  20 =item * Console : F<languages/WMLScript/runtime/wmlsconsole.pir>
  21
  22 =back
  23
  24 =cut
  25
  26 .loadlib 'wmls_ops'
  27 .HLL 'WMLScript', 'wmls_group'
  28
  29 .sub '__onload' :load :anon
  30 #    print "__onload (wmlsstdlibs.pir)\n"
  31     load_bytecode 'languages/WMLScript/runtime/wmlslang.pbc'
  32     load_bytecode 'languages/WMLScript/runtime/wmlsfloat.pbc'
  33     load_bytecode 'languages/WMLScript/runtime/wmlsstring.pbc'
  34     load_bytecode 'languages/WMLScript/runtime/wmlsconsole.pbc'
  35
  36     new $P0, 'Hash'
  37     $P1 = getLang()
  38     $P0[0] = $P1
  39     $P1 = getFloat()
  40     $P0[1] = $P1
  41     $P1 = getString()
  42     $P0[2] = $P1
  43     $P1 = getConsole()
  44     $P0[99] = $P1
  45
  46     set_hll_global '@stdlibs', $P0
  47 .end
  48
  49 .sub 'not_implemented'
  50     die "not implemented"
  51 .end
  52
  53 =head2 Helpers
  54
  55 =over 4
  56
  57 =item C<find_lib(int lindex, int findex)>
  58
  59 helper for CALL_LIB* opcodes.
  60
  61 =cut
  62
  63 .sub 'find_lib'
  64     .param int lindex
  65     .param int findex
  66     $P0 = get_hll_global '@stdlibs'
  67     push_eh _handler
  68     $P1 = $P0[lindex]
  69     $P2 = $P1[findex]
  70     .return ($P2)
  71   _handler:
  72     .const .Sub not_implemented = 'not_implemented'
  73     .return (not_implemented)
  74 .end
  75
  76 =item C<find_lib_url(string url, string function)>
  77
  78 helper for CALL_URL* opcodes.
  79
  80 =cut
  81
  82 .sub 'find_lib_url'
  83     .param string url
  84     .param string function
  85     .local string content
  86     content = load_script(url)
  87     unless content goto L1
  88     .local pmc loader
  89     .local pmc script
  90     new loader, 'WmlsBytecode'
  91     push_eh _handler_1
  92     script = loader.'load'(content)
  93     script['filename'] = url
  94     .local string gen_pir
  95     gen_pir = script.'translate'()
  96     .local pmc pir_comp
  97     .local pmc pbc_out
  98     pir_comp = compreg 'PIR'
  99     pbc_out = pir_comp(gen_pir)
 100     $P0 = pbc_out[0]
 101     $P0()
 102     pop_eh
 103 #    push_eh _handler_2
 104     .local pmc entry
 105     $S0 = url
 106     $S0 .= ':'
 107     $S0 .= function
 108     entry = get_hll_global $S0
 109     if_null entry, _handler_2
 110     .return (entry)
 111   _handler_1:
 112     .local pmc e
 113     .local string msg
 114     .get_results (e, msg)
 115     print msg
 116     print "\n"
 117     $S0 = "verification failed (can't translate '"
 118     $S0 .= url
 119     $S0 .= "')"
 120     die $S0
 121   _handler_2:
 122     $S0 = "external function '"
 123     $S0 .= function
 124     $S0 .= "' not found in '"
 125     $S0 .= url
 126     $S0 .= "'"
 127     die $S0
 128   L1:
 129     die "unable to load compilation unit"
 130 .end
 131
 132 .sub 'load_script'
 133     .param string filename
 134     .local pmc pio
 135     .local string content
 136     pio = new 'ParrotIO'
 137     push_eh _handler
 138     content = pio.'slurp'(filename)
 139     if content goto L1
 140     $S0 = err
 141     print "Can't slurp '"
 142     print filename
 143     print "' ("
 144     print $S0
 145     print ")\n"
 146   L1:
 147   _handler:
 148     .return (content)
 149 .end
 150
 151 .sub 'save_pbc'
 152     .param string pbc_out
 153     .param string filename
 154     .local string output
 155     .local pmc fh
 156     output = concat filename, '.pbc'
 157     fh = open output, '>'
 158     if fh goto L1
 159     $S0 = err
 160     print "Can't open '"
 161     print output
 162     print "' ("
 163     print $S0
 164     print ")\n"
 165     goto L2
 166   L1:
 167     print fh, pbc_out
 168     close fh
 169   L2:
 170     .return (output)
 171 .end
 172
 173 .sub 'save_pir'
 174     .param string gen_pir
 175     .param string filename
 176     .local string output
 177     .local pmc fh
 178     output = concat filename, '.pir'
 179     fh = open output, '>'
 180     if fh goto L1
 181     $S0 = err
 182     print "Can't open '"
 183     print output
 184     print "' ("
 185     print $S0
 186     print ")\n"
 187     goto L2
 188   L1:
 189     print fh, gen_pir
 190     close fh
 191   L2:
 192 .end
 193
 194 =back
 195
 196 =head1 AUTHORS
 197
 198 Francois Perrad.
 199
 200 =cut
 201
 202
 203 # Local Variables:
 204 #   mode: pir
 205 #   fill-column: 100
 206 # End:
 207 # vim: expandtab shiftwidth=4 ft=pir: