/pliant/math/functions.pli
 
 1  module "/pliant/language/os.pli" 
 2  module "/pliant/language/compiler.pli" 
 3  module "/pliant/language/generator.pli" 
 4   
 5  if os_api="win32" 
 6    constant math_library "msvcrt.dll" 
 7  else 
 8    constant math_library (replace os_libc_filename "libc" "libm") 
 9   
 10   
 11  public 
 12    constant pi 3.141592653589793238462 
 13   
 14   
 15  function i386_fstp f 
 16    arg_w Float f 
 17  function generate_i386_fstp64 i f 
 18    arg_rw Instruction i ; arg_rw Function f 
 19    i386_regmem 11011101b 1 011b i:0 
 20  (the_function i386_fstp Float) set_generate_binary (the_function generate_i386_fstp64 Instruction Function) 
 21   
 22   
 23  function assemble_math1 i gc 
 24    arg_rw Instruction i ; arg_rw GeneratorContext gc 
 25    var Pointer:Instruction cur :> i 
 26    if i:0:where=argument_indirect 
 27      var Link:Argument :> argument indirect Int i:0:pointer i:0:offset+4 
 28    eif i:0:where=argument_constant 
 29      :> argument indirect Int (argument constant Address (i:0:constant translate Int 1)) 0 
 30    else 
 31      error error_id_unexpected "Argument location for function "+i:function:name+" is unexpected ("+(string i:0:where)+")" 
 32    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) a) 
 33    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) i:0) 
 34    var Link:Instruction ii :> new Instruction 
 35    ii function :> function 
 36    cur :> gc insert_after_instruction cur ii 
 37    cur :> gc insert_after_instruction cur (instruction (the_function i386_add Int Int) (argument constant Int 8) (gc register i386_esp)) 
 38    cur :> gc insert_after_instruction cur (instruction (the_function i386_fstp Float) i:1) 
 39    gc remove i 
 40   
 41  named_expression math1_expr 
 42    function name f -> r 
 43      arg Float f r 
 44      external math_library string_name 
 45      has_no_side_effect 
 46    gvar Int temp := (the_function name Float -> Float) modify_registers 
 47    (the_function name Float -> Float) set_generate_assembly (the_function assemble_math1 Instruction GeneratorContext) 
 48    (the_function name Float -> Float) modify_registers := temp 
 49    export name 
 50   
 51  meta math1 e 
 52    if e:size<>or e:0:ident="" 
 53      return 
 54    var Str name := e:0:ident 
 55    compile_as (expression duplicate math1_expr substitute name (expression ident name near e:0) substitute string_name (expression constant name near e:0) substitute temp (expression ident "temp_"+name near e:0)) 
 56   
 57   
 58  function assemble_math2 i gc 
 59    arg_rw Instruction i ; arg_rw GeneratorContext gc 
 60    var Pointer:Instruction cur :> i 
 61    if i:0:where=argument_indirect 
 62      var Link:Argument :> argument indirect Int i:0:pointer i:0:offset+4 
 63    eif i:0:where=argument_constant 
 64      :> argument indirect Int (argument constant Address (i:0:constant translate Int 1)) 0 
 65    else 
 66      error error_id_unexpected "Argument location for function "+i:function:name+" is unexpected ("+(string i:0:where)+")" 
 67    if i:1:where=argument_indirect 
 68      var Link:Argument :> argument indirect Int i:1:pointer i:1:offset+4 
 69    eif i:1:where=argument_constant 
 70      :> argument indirect Int (argument constant Address (i:1:constant translate Int 1)) 0 
 71    else 
 72      error error_id_unexpected "Argument location for function "+i:function:name+" is unexpected ("+(string i:1:where)+")" 
 73    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) b) 
 74    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) i:1) 
 75    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) a) 
 76    cur :> gc insert_after_instruction cur (instruction (the_function i386_push Int) i:0) 
 77    var Link:Instruction ii :> new Instruction 
 78    ii function :> function 
 79    cur :> gc insert_after_instruction cur ii 
 80    cur :> gc insert_after_instruction cur (instruction (the_function i386_add Int Int) (argument constant Int 16) (gc register i386_esp)) 
 81    cur :> gc insert_after_instruction cur (instruction (the_function i386_fstp Float) i:2) 
 82    gc remove i 
 83   
 84  named_expression math2_expr 
 85    function name a b -> r 
 86      arg Float a b r 
 87      external math_library string_name 
 88      has_no_side_effect 
 89    gvar Int temp := (the_function name Float Float -> Float) modify_registers 
 90    (the_function name Float Float -> Float) set_generate_assembly (the_function assemble_math2 Instruction GeneratorContext) 
 91    (the_function name Float Float -> Float) modify_registers := temp 
 92    export name 
 93   
 94  meta math2 e 
 95    if e:size<>or e:0:ident="" 
 96      return 
 97    var Str name := e:ident 
 98    compile_as (expression duplicate math2_expr substitute name (expression ident name near e:0) substitute string_name (expression constant name near e:0) substitute temp (expression ident "temp_"+name near e:0)) 
 99   
 100   
 101  math1 sin 
 102  math1 cos 
 103  math1 tan 
 104  math1 asin 
 105  math1 acos 
 106  math1 atan 
 107  math1 exp 
 108  math1 log 
 109  math2 pow