c-arith.scm 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Richard Kelsey, Mike Sperber, Marcus Crestani
  3. (define-local-syntax (define-c-arith-binop-generator id c-op)
  4. `(define-c-generator ,id #t
  5. (lambda (call port indent)
  6. (simple-c-primop ,c-op call port))))
  7. (define-c-arith-binop-generator + "+")
  8. (define-c-arith-binop-generator - "-")
  9. (define-c-arith-binop-generator * "*")
  10. (define-c-arith-binop-generator quotient "/")
  11. (define-c-arith-binop-generator un+ "+")
  12. (define-c-arith-binop-generator un- "-")
  13. (define-c-arith-binop-generator un* "*")
  14. (define-c-arith-binop-generator unquotient "/")
  15. (define-c-arith-binop-generator fl+ "+")
  16. (define-c-arith-binop-generator fl- "-")
  17. (define-c-arith-binop-generator fl* "*")
  18. (define-c-arith-binop-generator fl/ "/")
  19. (define-c-generator small* #t
  20. (lambda (call port indent)
  21. (format port "PS_SMALL_MULTIPLY(")
  22. (c-value (call-arg call 0) port)
  23. (format port ", ")
  24. (c-value (call-arg call 1) port)
  25. (format port ")")))
  26. (define-c-arith-binop-generator remainder "%")
  27. (define-c-arith-binop-generator unremainder "%")
  28. (define-c-arith-binop-generator bitwise-and "&")
  29. (define-c-arith-binop-generator bitwise-ior "|")
  30. (define-c-arith-binop-generator bitwise-xor "^")
  31. (define-c-generator ashl #t
  32. (lambda (call port indent)
  33. (generate-shift call port indent "LEFT" #f)))
  34. (define-c-generator ashr #t
  35. (lambda (call port indent)
  36. (generate-shift call port indent "RIGHT" #f)))
  37. (define-c-generator lshr #t
  38. (lambda (call port indent)
  39. (generate-shift call port indent "RIGHT_LOGICAL" #t)))
  40. (define (generate-shift call port indent macro logical?)
  41. (cond ((= 1 (call-exits call))
  42. ; PS_SHIFT_??? is a C macro that handles overshifting even if C doesn't
  43. (indent-to port indent)
  44. (format port "PS_SHIFT_~A(" macro)
  45. (c-value (call-arg call 1) port)
  46. (format port ", ")
  47. (c-value (call-arg call 2) port)
  48. (format port ", ")
  49. (c-variable (car (lambda-variables (call-arg call 0))) port)
  50. (format port ")"))
  51. ((and (literal-node? (call-arg call 1))
  52. (>= (literal-value (call-arg call 1)) pre-scheme-integer-size))
  53. (format port "0L"))
  54. (else
  55. (format port "PS_SHIFT_~A_INLINE(" macro)
  56. (c-value (call-arg call 0) port)
  57. (format port ", ")
  58. (c-value (call-arg call 1) port)
  59. (format port ")"))))
  60. (define-c-generator bitwise-not #t
  61. (lambda (call port indent)
  62. (simple-c-primop "~" call port)))
  63. (define-local-syntax (define-c-comp-binop-generator id c-op)
  64. `(define-c-generator ,id #t
  65. (lambda (call port indent)
  66. (simple-c-primop ,c-op call port))))
  67. (define-c-comp-binop-generator = "==")
  68. (define-c-comp-binop-generator < "<" )
  69. (define-c-comp-binop-generator fl= "==")
  70. (define-c-comp-binop-generator fl< "<" )
  71. (define-c-comp-binop-generator un= "==")
  72. (define-c-comp-binop-generator un< "<" )
  73. (define-c-comp-binop-generator char=? "==")
  74. (define-c-comp-binop-generator char<? "<" )
  75. (define-c-generator ascii->char #t
  76. (lambda (call port indent)
  77. (display "((char) " port)
  78. (c-value (call-arg call 0) port)
  79. (display ")" port)))
  80. (define-c-generator char->ascii #t
  81. (lambda (call port indent)
  82. (display "((unsigned char) " port)
  83. (c-value (call-arg call 0) port)
  84. (display ")" port)))
  85. (define-c-generator unsigned->integer #t
  86. (lambda (call port indent)
  87. (display "((long) " port)
  88. (c-value (call-arg call 0) port)
  89. (display ")" port)))
  90. (define-c-generator integer->unsigned #t
  91. (lambda (call port indent)
  92. (display "((unsigned long) " port)
  93. (c-value (call-arg call 0) port)
  94. (display ")" port)))
  95. ;(define-c-generator sign-extend #t
  96. ; (lambda (call port indent)
  97. ; (display "((long) " port)
  98. ; (c-value (call-arg call 0) port)
  99. ; (display ")" port)))
  100. ;
  101. ;(define-c-generator zero-extend #t
  102. ; (lambda (call port indent)
  103. ; (display "((unsigned long) " port)
  104. ; (c-value (call-arg call 0) port)
  105. ; (display ")" port)))