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