/red-system/runtime/common.reds

  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]