/red-system/runtime/common.reds

http://github.com/dockimbel/Red · Redscript · 197 lines · 170 code · 27 blank · 0 comment · 7 complexity · d45eea5dd1df1b6685ef89a018b844d0 MD5 · raw file

  1. Red/System [
  2. Title: "Red/System OS-independent runtime"
  3. Author: "Nenad Rakocevic"
  4. File: %common.reds
  5. Rights: "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
  6. License: {
  7. Distributed under the Boost Software License, Version 1.0.
  8. See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
  9. }
  10. ]
  11. #define zero? [0 =]
  12. #define positive? [0 < ] ;-- space required after the lesser-than symbol
  13. #define negative? [0 > ]
  14. #define negate [0 -]
  15. #define null? [null =]
  16. #define forever [while [true]]
  17. #define does [func []]
  18. #define unless [if not]
  19. #define raise-error ***-on-quit
  20. #define as-byte [as byte!]
  21. #define as-logic [as logic!]
  22. #define as-integer [as integer!]
  23. #define as-c-string [as c-string!]
  24. #define null-byte #"^(00)"
  25. #define yes true
  26. #define no false
  27. #define on true
  28. #define off false
  29. #define byte-ptr! [pointer! [byte!]]
  30. #define int-ptr! [pointer! [integer!]]
  31. #define make-c-string [as c-string! allocate]
  32. #define type-logic! 1 ;-- type ID list for 'typeinfo attribut
  33. #define type-integer! 2
  34. #define type-byte! 3
  35. #define type-c-string! 4
  36. #define type-byte-ptr! 5
  37. #define type-int-ptr! 6
  38. #define type-function! 7
  39. #define type-struct! 1000
  40. #define any-struct? [1000 <=]
  41. #define alias? [1001 <=]
  42. ;-- Global variables definition --
  43. stdout: -1 ;-- uninitialized default value
  44. stdin: -1 ;-- uninitialized default value
  45. stderr: -1 ;-- uninitialized default value
  46. str-array!: alias struct! [
  47. item [c-string!]
  48. ]
  49. typed-value!: alias struct! [
  50. value [integer!]
  51. type [integer!]
  52. ]
  53. __stack!: alias struct! [
  54. top [int-ptr!]
  55. frame [int-ptr!]
  56. ]
  57. system: declare struct! [ ;-- store runtime accessible system values
  58. args-count [integer!] ;-- command-line arguments count (do not move member)
  59. args-list [str-array!] ;-- command-line arguments array pointer (do not move member)
  60. env-vars [str-array!] ;-- environment variables array pointer (always null for Windows)
  61. stack [__stack!] ;-- stack virtual access
  62. pc [byte-ptr!] ;-- CPU program counter value
  63. alias [integer!] ;-- aliases ID virtual access
  64. ]
  65. ;-------------------------------------------
  66. ;-- Convert a type ID to a c-string!
  67. ;-------------------------------------------
  68. form-type: func [
  69. type [integer!] ;-- type ID
  70. return: [c-string!] ;-- type representation as c-string
  71. ][
  72. switch type [
  73. type-integer! ["integer!"]
  74. type-c-string! ["c-string!"]
  75. type-logic! ["logic!"]
  76. type-byte! ["byte!"]
  77. type-byte-ptr! ["pointer! [byte!]"]
  78. type-int-ptr! ["pointer! [integer!]"]
  79. type-struct! ["struct!"]
  80. type-function! ["function!"]
  81. default [either alias? type ["alias"]["not valid type"]]
  82. ]
  83. ]
  84. #switch OS [
  85. Windows [#define LIBC-file "msvcrt.dll"]
  86. Syllable [#define LIBC-file "libc.so.2"]
  87. MacOSX [#define LIBC-file "libc.dylib"]
  88. #default [
  89. #either config-name = 'Android [ ;-- @@ see if declaring it as an OS wouldn't be too costly
  90. #define LIBC-file "libc.so"
  91. ][
  92. #define LIBC-file "libc.so.6" ;-- Linux
  93. ]
  94. ]
  95. ]
  96. #either use-natives? = no [ ;-- C bindings or native counterparts
  97. #include %lib-C.reds
  98. ][
  99. #include %lib-natives.reds
  100. ]
  101. #switch OS [ ;-- loading OS-specific bindings
  102. Windows [#include %win32.reds]
  103. Syllable [#include %syllable.reds]
  104. MacOSX [#include %darwin.reds]
  105. #default [#include %linux.reds]
  106. ]
  107. #include %utils.reds ;-- load additional utility functions
  108. #if debug? = yes [#include %debug.reds] ;-- loads optionally debug functions
  109. ;-- Run-time error handling --
  110. #define RED_ERR_VMEM_RELEASE_FAILED 96
  111. #define RED_ERR_VMEM_OUT_OF_MEMORY 97
  112. ***-on-quit: func [ ;-- global exit handler
  113. status [integer!]
  114. address [integer!]
  115. /local msg
  116. ][
  117. unless zero? status [
  118. print [lf "*** Runtime Error " status ": "]
  119. msg: switch status [
  120. 1 ["access violation"]
  121. 2 ["invalid alignment"]
  122. 3 ["breakpoint"]
  123. 4 ["single step"]
  124. 5 ["bounds exceeded"]
  125. 6 ["float denormal operan"]
  126. 7 ["float divide by zero"]
  127. 8 ["float inexact result"]
  128. 9 ["float invalid operation"]
  129. 10 ["float overflow"]
  130. 11 ["float stack check"]
  131. 12 ["float underflow"]
  132. 13 ["integer divide by zero"]
  133. 14 ["integer overflow"]
  134. 15 ["privileged instruction"]
  135. 16 ["invalid virtual address"]
  136. 17 ["illegal instruction"]
  137. 18 ["non-continuable exception"]
  138. 19 ["stack error or overflow"]
  139. 20 ["invalid disposition"]
  140. 21 ["guard page"]
  141. 22 ["invalid handle"]
  142. 23 ["illegal operand"]
  143. 24 ["illegal addressing mode"]
  144. 25 ["illegal trap"]
  145. 26 ["coprocessor error"]
  146. 27 ["non-existant physical address"]
  147. 28 ["object specific hardware error"]
  148. 29 ["hardware memory error consumed AR"]
  149. 30 ["hardware memory error consumed AO"]
  150. 31 ["privileged register"]
  151. 96 ["virtual memory release failed"]
  152. 97 ["out of memory"]
  153. 98 ["assertion failed"]
  154. 99 ["unknown error"]
  155. 100 ["no value matched in CASE"]
  156. 101 ["no value matched in SWITCH"]
  157. default ["unknown error code!"]
  158. ]
  159. print msg
  160. #either debug? = yes [
  161. __print-debug-line as byte-ptr! address
  162. ][
  163. print [lf "*** at: " as byte-ptr! address "h" lf]
  164. ]
  165. ]
  166. #if OS = 'Windows [ ;-- special exit handler for Windows
  167. ***-on-win32-quit
  168. ]
  169. quit status
  170. ]