PageRenderTime 58ms CodeModel.GetById 22ms app.highlight 26ms RepoModel.GetById 1ms app.codeStats 1ms

/red-system/targets/IA-32.r

http://github.com/dockimbel/Red
R | 1088 lines | 979 code | 70 blank | 39 comment | 115 complexity | 97a58f28911fdd60bcc22eff8cb0015f MD5 | raw file
   1REBOL [
   2	Title:   "Red/System IA-32 code emitter"
   3	Author:  "Nenad Rakocevic"
   4	File: 	 %IA-32.r
   5	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
   6	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
   7]
   8
   9make target-class [
  10	target: 'IA-32
  11	little-endian?: yes
  12	struct-align-size: 	4
  13	ptr-size: 			4
  14	default-align:		4
  15	stack-width:		4
  16	args-offset:		8							;-- stack frame offset to arguments (esp + ebp)
  17	branch-offset-size:	4							;-- size of JMP offset
  18	
  19	conditions: make hash! [
  20	;-- name ----------- signed --- unsigned --
  21		overflow?		 #{00}		-
  22		not-overflow?	 #{01}		-	
  23		=				 #{04}		-
  24		<>				 #{05}		-
  25		signed?			 #{08}		-
  26		unsigned?		 #{09}
  27		even?			 #{0A}		-
  28		odd?			 #{0B}		-
  29		<				 #{0C}		#{02}
  30		>=				 #{0D}		#{03}
  31		<=				 #{0E}		#{06}
  32		>				 #{0F}		#{07}
  33	]
  34	
  35	add-condition: func [op [word!] data [binary!]][
  36		op: either '- = third op: find conditions op [op/2][
  37			pick op pick [2 3] signed?
  38		]
  39		data/(length? data): (to char! last data) or (to char! first op) ;-- REBOL2's awful binary! handling
  40		data
  41	]
  42		
  43	emit-poly: func [spec [block!] /local to-bin][	;-- polymorphic code generation
  44		spec: reduce spec
  45		emit switch width [
  46			1 [spec/1]								;-- 8-bit
  47			2 [emit #{66} spec/2]					;-- 16-bit
  48			4 [spec/2]								;-- 32-bit
  49			;8 not yet supported
  50		]
  51		to-bin: get select [1 to-bin8 2 to-bin16 4 to-bin32] width
  52		case/all [
  53			2 < length? spec [emit to-bin to integer! compiler/unbox spec/3] ;-- emit displacement or immediate
  54			3 < length? spec [emit to-bin to integer! compiler/unbox spec/4] ;-- emit displacement or immediate
  55		]	
  56	]
  57	
  58	emit-variable-poly: func [							;-- polymorphic variable access generation
  59		name [word! object!]
  60		    g8 [binary!] 		g32 [binary!]			;-- opcodes for global variables
  61			l8 [binary! block!] l32 [binary! block!]	;-- opcodes for local variables
  62	][
  63		with-width-of name [
  64			switch width [
  65				1 [emit-variable name g8 l8]				;-- 8-bit
  66				2 [emit #{66} emit-variable name g32 l32]	;-- 16-bit
  67				4 [emit-variable name g32 l32]				;-- 32-bit
  68			]
  69		]
  70	]
  71	
  72	emit-save-last: does [
  73		last-saved?: yes
  74		emit #{50}									;-- PUSH eax
  75	]
  76	
  77	emit-restore-last: does [
  78		emit #{5A}					   				;-- POP edx
  79	]
  80	
  81	emit-casting: func [value [object!] alt? [logic!] /local old][
  82		type: compiler/get-type value/data	
  83		case [
  84			value/type/1 = 'logic! [
  85				if verbose >= 3 [print [">>>converting from" mold/flat type/1 "to logic!"]]
  86				old: width
  87				set-width/type type/1
  88				emit #{31DB}						;--		   XOR ebx, ebx
  89				either alt? [
  90					emit-poly [#{80FA00} #{83FA00}]	;-- 	   CMP rD, 0
  91					emit #{7401}					;--        JZ _exit
  92					emit #{43}						;-- 	   INC ebx
  93					emit #{89DA}					;-- _exit: MOV edx, ebx
  94				][
  95					emit-poly [#{3C00} #{83F800}]	;-- 	   CMP rA, 0
  96					emit #{7401}					;--        JZ _exit
  97					emit #{43}						;-- 	   INC ebx
  98					emit #{89D8}					;-- _exit: MOV eax, ebx
  99				]
 100				width: old
 101			]
 102			all [value/type/1 = 'integer! type/1 = 'byte!][
 103				if verbose >= 3 [print ">>>converting from byte! to integer! "]
 104				emit pick [#{81E2} #{25}] alt?    	;-- AND edx|eax, 000000FFh 
 105				emit to-bin32 255
 106			]
 107		]
 108	]
 109
 110	emit-load-literal: func [type [block! none!] value /local spec][	
 111		unless type [type: compiler/get-type value]
 112		spec: emitter/store-value none value type
 113		emit #{B8}									;-- MOV eax, value
 114		emit-reloc-addr spec/2						;-- one-based index
 115	]
 116	
 117	emit-get-pc: does [
 118		emit #{E800000000}							;-- CALL next		; call the next instruction
 119		emit-pop									;-- get eip in eax
 120	]
 121	
 122	emit-set-stack: func [value /frame][
 123		if verbose >= 3 [print [">>>emitting SET-STACK" mold value]]
 124		emit-load value
 125		either frame [
 126			emit #{89C5}							;-- MOV ebp, eax		
 127		][
 128			emit #{89C4}							;-- MOV esp, eax
 129		]
 130	]
 131	
 132	emit-get-stack: func [/frame][
 133		if verbose >= 3 [print ">>>emitting GET-STACK"]
 134		either frame [
 135			emit #{89E8}							;-- MOV eax, ebp			
 136		][
 137			emit #{89E0}							;-- MOV eax, esp
 138		]
 139	]
 140	
 141	emit-pop: does [
 142		if verbose >= 3 [print ">>>emitting POP"]
 143		emit #{58}									;-- POP eax
 144	]
 145		
 146	emit-not: func [value [word! char! tag! integer! logic! path! string! object!] /local opcodes type boxed][
 147		if verbose >= 3 [print [">>>emitting NOT" mold value]]
 148		
 149		if object? value [boxed: value]
 150		value: compiler/unbox value
 151		if block? value [value: <last>]
 152
 153		opcodes: [
 154			logic!	 [emit #{3401}]					;-- XOR al, 1			; invert 0<=>1
 155			byte!	 [emit #{F6D0}]					;-- NOT al				; @@ missing 16-bit support									
 156			integer! [emit #{F7D0}]					;-- NOT eax
 157		]
 158		switch type?/word value [
 159			logic! [
 160				emit-load not value
 161			]
 162			char! [
 163				emit-load value
 164				do opcodes/byte!
 165			]
 166			integer! [
 167				emit-load value
 168				do opcodes/integer!
 169			]
 170			word! [
 171				emit-load value
 172				if boxed [emit-casting boxed no]
 173				type: first compiler/resolve-aliased compiler/get-variable-spec value
 174				if find [pointer! c-string! struct!] type [ ;-- type casting trap
 175					type: 'logic!
 176				]
 177				switch type opcodes
 178			]
 179			tag! [
 180				if boxed [emit-casting boxed no]
 181				switch compiler/last-type/1 opcodes
 182			]
 183			string! [								;-- type casting trap
 184				emit-load value
 185				if boxed [emit-casting boxed no]
 186				do opcodes/logic!
 187			]
 188			path! [
 189				emitter/access-path value none
 190				either boxed [
 191					emit-casting boxed no
 192					switch boxed/type/1 opcodes 
 193				][
 194					do opcodes/integer!
 195				]
 196			]
 197		]
 198	]
 199	
 200	emit-boolean-switch: does [
 201		emit #{31C0}								;-- 	  XOR eax, eax	; eax = 0 (FALSE)
 202		emit #{EB03}								;-- 	  JMP _exit
 203		emit #{31C0}								;--		  XOR eax, eax
 204		emit #{40}									;--		  INC eax		; eax = 1 (TRUE)
 205													;-- _exit:
 206		reduce [3 7]								;-- [offset-TRUE offset-FALSE]
 207	]
 208	
 209	emit-load: func [
 210		value [char! logic! integer! word! string! path! paren! get-word! object!]
 211		/alt
 212	][
 213		if verbose >= 3 [print [">>>loading" mold value]]
 214		
 215		switch type?/word value [
 216			char! [
 217				emit #{B0}							;-- MOV al, value
 218				emit value
 219			]
 220			logic! [
 221				emit #{31C0}						;-- XOR eax, eax		; eax = 0 (FALSE)	
 222				if value [
 223					emit #{40}						;-- INC eax				; eax = 1 (TRUE)
 224				]
 225			]
 226			integer! [
 227				emit #{B8}							;-- MOV eax, value
 228				emit to-bin32 value
 229			]
 230			word! [
 231				with-width-of value [
 232					either alt [
 233						emit-variable-poly value
 234							#{8A15} #{8B15}			;-- MOV rD, [value]		; global
 235							#{8A55} #{8B55}			;-- MOV rD, [ebp+n]		; local
 236					][
 237						emit-variable-poly value
 238							#{A0}   #{A1}			;-- MOV rA, [value]		; global
 239							#{8A45} #{8B45}			;-- MOV rA, [ebp+n]		; local	
 240					]
 241				]
 242			]
 243			get-word! [
 244				emit #{B8}							;-- MOV eax, &name
 245				emit-reloc-addr emitter/get-func-ref to word! value	;-- symbol address
 246			]
 247			string! [
 248				emit-load-literal [c-string!] value
 249			]
 250			path! [
 251				emitter/access-path value none
 252			]
 253			paren! [
 254				emit-load-literal none value
 255			]
 256			object! [
 257				unless any [block? value/data value/data = <last>][
 258					either alt [emit-load/alt value/data][emit-load value/data]
 259				]
 260			]
 261		]
 262	]
 263	
 264	emit-store: func [
 265		name [word!] value [char! logic! integer! word! string! paren! tag! get-word!] spec [block! none!]
 266		/local store-dword
 267	][
 268		if verbose >= 3 [print [">>>storing" mold name mold value]]
 269		if value = <last> [value: 'last]			;-- force word! code path in switch block
 270		if logic? value [value: to integer! value]	;-- TRUE -> 1, FALSE -> 0
 271		
 272		store-dword: [
 273			emit-variable name
 274				#{C705}								;-- MOV dword [name], value		; global
 275				#{C745}								;-- MOV dword [ebp+n], value	; local
 276		]
 277		
 278		switch type?/word value [
 279			char! [
 280				emit-variable name
 281					#{C605}							;-- MOV byte [name], value
 282					#{C645}							;-- MOV byte [ebp+n], value
 283				emit value
 284			]
 285			integer! [
 286				do store-dword
 287				emit to-bin32 value
 288			]
 289			word! [
 290				set-width name				
 291				emit-variable-poly name
 292					#{A2} 	#{A3}					;-- MOV [name], rA		; global variable
 293					#{8845} #{8945}					;-- MOV [ebp+n], rA		; local variable
 294			]
 295			get-word! [
 296				do store-dword
 297				emit-reloc-addr emitter/get-func-ref to word! value	;-- symbol address
 298			]
 299			string! [
 300				do store-dword
 301				emit-reloc-addr spec/2
 302			]
 303			paren! [
 304				do store-dword
 305				emit-reloc-addr spec/2
 306			]
 307		]
 308	]
 309	
 310	emit-init-path: func [name [word!]][
 311		emit-variable name
 312			#{A1}									;-- MOV eax, [name]			; global
 313			#{8B45}									;-- MOV eax, [ebp+n]		; local
 314	]
 315	
 316	emit-access-path: func [
 317		path [path! set-path!] spec [block! none!] /short /local offset type saved
 318	][
 319		if verbose >= 3 [print [">>>accessing path:" mold path]]
 320
 321		unless spec [
 322			spec: second compiler/resolve-type path/1
 323			emit-init-path path/1
 324		]
 325		if short [return spec]
 326		
 327		saved: width
 328		type: first compiler/resolve-type/with path/2 spec
 329		set-width/type type							;-- adjust operations width to member value size
 330
 331		either zero? offset: emitter/member-offset? spec path/2 [
 332			emit-poly [#{8A00} #{8B00}]				;-- MOV rA, [eax]
 333		][
 334			emit-poly [#{8A80} #{8B80}]				;-- MOV rA, [eax+offset]
 335			emit to-bin32 offset
 336		]
 337		width: saved
 338	]
 339		
 340	emit-load-index: func [idx [word!]][
 341		emit-variable idx
 342			#{8B1D}									;-- MOV ebx, [idx]		; global
 343			#{8B5D}									;-- MOV ebx, [ebp+n]	; local
 344		emit #{4B}									;-- DEC ebx				; one-based index
 345	]
 346	
 347	emit-c-string-path: func [path [path! set-path!] parent [block! none!] /local opcodes idx][
 348		either parent [
 349			emit #{89C6} 							;-- MOV esi, eax		; nested access
 350		][
 351			emit-variable path/1
 352				#{8B35}								;-- MOV esi, [value1]	; global
 353				[
 354					#{8D45}							;-- LEA eax, [ebp+n]	; local
 355					offset							;-- n
 356					#{8B30}							;-- MOV esi, [eax]
 357				]
 358		]
 359		opcodes: pick [[							;-- store path opcodes --
 360				#{8816}								;-- MOV [esi], dl			; first	
 361				#{8896}								;-- MOV [esi + idx], dl 	; n-th
 362				#{88141E}							;-- MOV [esi + ebx], dl 	; variable index
 363			][										;-- load path opcodes --
 364				#{8A06}								;-- MOV al, [esi]			; first
 365				#{8A86}								;-- MOV al, [esi + idx]		; n-th
 366				#{8A041E}							;-- MOV al, [esi + ebx]		; variable index
 367		]] set-path? path
 368		
 369		either integer? idx: path/2 [
 370			either zero? idx: idx - 1 [				;-- indexes are one-based
 371				emit opcodes/1
 372			][
 373				emit opcodes/2
 374				emit to-bin32 idx
 375			]
 376		][
 377			emit-load-index idx
 378			emit opcodes/3
 379		]
 380	]
 381	
 382	emit-pointer-path: func [
 383		path [path! set-path!] parent [block! none!] /local opcodes idx type
 384	][
 385		opcodes: pick [[							;-- store path opcodes --
 386				[#{8810} #{8910}]					;-- MOV [eax], rD
 387				[#{8890} #{8990}]					;-- MOV [eax + idx * sizeof(p/value)], rD
 388				[#{881418} #{891498}]				;-- MOV [eax + ebx * sizeof(p/value)], rD
 389			][										;-- load path opcodes --
 390				[#{8A00} #{8B00}]					;-- MOV rA, [eax]
 391				[#{8A80} #{8B80}]					;-- MOV rA, [eax + idx * sizeof(p/value)]
 392				[#{8A0418} #{8B0498}]				;-- MOV rA, [eax + ebx * sizeof(p/value)]
 393		]] set-path? path
 394		
 395		type: either parent [
 396			compiler/resolve-type/with path/1 parent
 397		][
 398			emit-init-path path/1
 399			compiler/resolve-type path/1
 400		]
 401		set-width/type type/2/1						;-- adjust operations width to pointed value size
 402		idx: either path/2 = 'value [1][path/2]
 403
 404		either integer? idx [
 405			either zero? idx: idx - 1 [				;-- indexes are one-based
 406				emit-poly opcodes/1
 407			][
 408				emit-poly opcodes/2
 409				emit to-bin32 idx * emitter/size-of? type/2/1
 410			]
 411		][
 412			emit-load-index idx
 413			emit-poly opcodes/3
 414		]
 415	]
 416	
 417	emit-load-path: func [path [path!] type [word!] parent [block! none!] /local idx][
 418		if verbose >= 3 [print [">>>loading path:" mold path]]
 419
 420		switch type [
 421			c-string! [emit-c-string-path path parent]
 422			pointer!  [emit-pointer-path  path parent]
 423			struct!   [emit-access-path   path parent]
 424		]
 425	]
 426
 427	emit-store-path: func [path [set-path!] type [word!] value parent [block! none!] /local idx offset][
 428		if verbose >= 3 [print [">>>storing path:" mold path mold value]]
 429
 430		if parent [emit #{89C2}]					;-- MOV edx, eax			; save value/address
 431		unless value = <last> [emit-load value]
 432		emit #{92}									;-- XCHG eax, edx			; save value/restore address
 433
 434		switch type [
 435			c-string! [emit-c-string-path path parent]
 436			pointer!  [emit-pointer-path  path parent]
 437			struct!   [
 438				unless parent [parent: emit-access-path/short path parent]
 439				type: first compiler/resolve-type/with path/2 parent
 440				set-width/type type					;-- adjust operations width to member value size
 441				
 442				either zero? offset: emitter/member-offset? parent path/2 [
 443					emit-poly [#{8810} #{8910}] 	;-- MOV [eax], rD
 444				][
 445					emit-poly [#{8890} #{8990}]		;-- MOV [eax+offset], rD
 446					emit to-bin32 offset
 447				]
 448			]
 449		]
 450	]
 451	
 452	patch-exit-call: func [code-buf [binary!] ptr [integer!] exit-point [integer!]][
 453		change at code-buf ptr to-bin32 exit-point - ptr - branch-offset-size
 454	]
 455	
 456	emit-exit: does [
 457		emit #{E9}									;-- JMP imm32
 458		emit-reloc-addr compose/only [- - (emitter/exits)]
 459	]
 460
 461	emit-branch: func [
 462		code [binary!]
 463		op [word! block! logic! none!]
 464		offset [integer! none!]
 465		/back?
 466		/local size imm8? opcode jmp
 467	][
 468		if verbose >= 3 [print [">>>inserting branch" either op [join "cc: " mold op][""]]]
 469		
 470		size: (length? code) - any [offset 0]				;-- offset from the code's head
 471		imm8?: size <= either back? [126][127]				;-- account 2 bytes for JMP imm8
 472		opcode: either not none? op [						;-- explicitly test for none
 473			op: case [
 474				block? op [									;-- [cc] => keep
 475					op: op/1
 476					either logic? op [pick [= <>] op][op]	;-- [logic!] or [cc]
 477				]
 478				logic? op [pick [= <>] op]					;-- test for TRUE/FALSE
 479				'else 	  [opposite? op]					;-- 'cc => invert condition
 480			]
 481			add-condition op copy pick [#{70} #{0F80}] imm8?		;-- Jcc offset 	; 8/32-bit displacement
 482		][
 483			pick [#{EB} #{E9}] imm8?						;-- JMP offset 	; 8/32-bit displacement
 484		]
 485		if back? [size: negate (size + (length? opcode) + pick [1 4] imm8?)]
 486		jmp: rejoin [opcode either imm8? [to-bin8 size][to-bin32 size]]
 487		insert any [all [back? tail code] code] jmp
 488		length? jmp
 489	]
 490	
 491	emit-push: func [
 492		value [char! logic! integer! word! block! string! tag! path! get-word! object!]
 493		/with cast [object!]
 494		/local spec type
 495	][
 496		if verbose >= 3 [print [">>>pushing" mold value]]
 497		if block? value [value: <last>]
 498		
 499		switch type?/word value [
 500			tag! [									;-- == <last>
 501				emit #{50}							;-- PUSH eax
 502			]
 503			logic! [
 504				emit #{31C0}						;--	XOR eax, eax		; eax = 0 (FALSE)	
 505				if value [
 506					emit #{40}						;--	INC eax				; eax = 1 (TRUE)
 507				]
 508				emit #{50}							;-- PUSH eax
 509			]
 510			char! [
 511				emit #{6A}							;-- PUSH value
 512				emit value
 513			]
 514			integer! [
 515				either all [-128 <= value value <= 127][
 516					emit #{6A}						;-- PUSH imm8
 517					emit to-bin8 value
 518				][
 519					emit #{68}						;-- PUSH imm32		
 520					emit to-bin32 value	
 521				]
 522			]
 523			word! [
 524				type: first compiler/get-variable-spec value
 525				emit-variable value
 526					#{FF35}						;-- PUSH [value]		; global
 527					#{FF75}						;-- PUSH [ebp+n]		; local
 528			]
 529			get-word! [
 530				emit #{68}							;-- PUSH &value
 531				emit-reloc-addr emitter/get-func-ref to word! value	;-- value memory address
 532			]
 533			string! [
 534				spec: emitter/store-value none value [c-string!]
 535				emit #{68}							;-- PUSH value
 536				emit-reloc-addr spec/2				;-- one-based index
 537			]
 538			path! [
 539				emitter/access-path value none
 540				if cast [emit-casting cast no]
 541				emit-push <last>
 542			]
 543			object! [
 544				either path? value/data [
 545					emit-push/with value/data value
 546				][
 547					emit-push value/data
 548				]
 549			]
 550		]
 551	]
 552	
 553	emit-sign-extension: does [
 554		emit switch width [
 555			1 [#{6698}]								;-- CBW			; extend AL to AX
 556			2 [#{6699}]								;-- CWD			; extend AX to DX:AX
 557			4 [#{99}]								;-- CDQ			; extend EAX to EDX:EAX
 558		]
 559	]
 560	
 561	emit-bitshift-op: func [name [word!] a [word!] b [word!] args [block!] /local c value][
 562		switch b [
 563			ref [
 564				emit-variable args/2
 565					#{8A0D}							;-- MOV cl, byte [value]	; global
 566					#{8A4D}							;-- MOV cl, byte [ebp+n]	; local
 567			]
 568			reg [emit #{88D1}]						;-- MOV cl, dl
 569		]
 570		switch name [
 571			<<  [
 572				emit-poly pick [
 573					[#{C0E0} #{C1E0}]				;-- SAL|SHL rA, value
 574					[#{D2E0} #{D3E0}]				;-- SAL|SHL rA, cl
 575				] b = 'imm
 576			]
 577			>>  [
 578				emit-poly pick [
 579					[#{C0F8} #{C1F8}]				;-- SAR rA, value
 580					[#{D2F8} #{D3F8}]				;-- SAR rA, cl
 581				] b = 'imm
 582			]
 583			-** [
 584				emit-poly pick [
 585					[#{C0E8} #{C1E8}]				;-- SHR rA, value
 586					[#{D2E8} #{D3E8}]				;-- SHR rA, cl
 587				] b = 'imm
 588			]
 589		]
 590		if b = 'imm [
 591			c: select [1 7 2 15 4 31] width
 592			value: compiler/unbox args/2		
 593			unless all [0 <= value value <= c][		
 594				compiler/backtrack name
 595				compiler/throw-error rejoin [
 596					"a value in 0-" c " range is required for this shift operation"
 597				]
 598			]
 599			emit to-bin8 value
 600		]
 601	]
 602	
 603	emit-bitwise-op: func [name [word!] a [word!] b [word!] args [block!] /local code][		
 604		code: select [
 605			and [
 606				#{25}								;-- AND eax, value
 607				#{21D0}								;-- AND eax, edx		; commutable op
 608			]
 609			or [
 610				#{0D}								;-- OR eax, value
 611				#{09D0}								;-- OR eax, edx			; commutable op
 612			]
 613			xor [
 614				#{35}								;-- XOR eax, value
 615				#{31D0}								;-- XOR eax, edx		; commutable op
 616			]
 617		] name
 618		
 619		switch b [
 620			imm [
 621				emit code/1							;-- <OP> eax, value
 622				emit to-bin32 compiler/unbox args/2
 623			]
 624			ref [
 625				emit-load/alt args/2
 626				if object? args/2 [emit-casting args/2 yes]
 627				emit code/2
 628			]
 629			reg [emit code/2]						;-- <OP> eax, edx		; commutable op
 630		]
 631	]
 632	
 633	emit-comparison-op: func [name [word!] a [word!] b [word!] args [block!] /local op-poly][
 634		op-poly: [emit-poly [#{38D0} #{39D0}]]		;-- CMP rA, rD			; not commutable op
 635		
 636		switch b [
 637			imm [
 638				emit-poly [#{3C} #{3D} args/2]		;-- CMP rA, value
 639			]
 640			ref [
 641				emit-load/alt args/2
 642				if object? args/2 [emit-casting args/2 yes]
 643				do op-poly
 644			]
 645			reg [
 646				do op-poly
 647			]
 648		]
 649	]
 650	
 651	emit-math-op: func [
 652		name [word!] a [word!] b [word!] args [block!]
 653		/local mod? scale c type arg2 op-poly
 654	][
 655		;-- eax = a, edx = b
 656		if find [// ///] name [						;-- work around unaccepted '// and '///
 657			mod?: select [// mod /// rem] name		;-- convert operators to words (easier to handle)
 658			name: first [/]							;-- work around unaccepted '/ 
 659		]
 660		arg2: compiler/unbox args/2
 661		
 662		if all [
 663			find [+ -] name							;-- pointer arithmetic only allowed for + & -
 664			type: compiler/resolve-expr-type args/1
 665			not compiler/any-pointer? compiler/resolve-expr-type args/2	;-- no scaling if both operands are pointers		
 666			scale: switch type/1 [
 667				pointer! [emitter/size-of? type/2/1]		  ;-- scale factor: size of pointed value
 668				struct!  [emitter/member-offset? type/2 none] ;-- scale factor: total size of the struct
 669			]
 670			scale > 1
 671		][
 672			either compiler/literal? arg2 [
 673				arg2: arg2 * scale					;-- 'b is a literal, so scale it directly
 674			][
 675				either b = 'reg [
 676					emit #{92}						;-- XCHG eax, edx		; put operands in right order
 677				][									;-- 'b will now be stored in reg, so save 'a			
 678					emit-poly [#{88C2} #{89C2}]		;-- MOV rD, rA
 679					emit-load args/2
 680				]
 681				emit-math-op '* 'reg 'imm reduce [arg2 scale]
 682				if name = '- [emit #{92}]			;-- XCHG eax, edx		; put operands in right order
 683				b: 'reg
 684			]
 685		]
 686		;-- eax = a, edx = b
 687		switch name [
 688			+ [
 689				op-poly: [
 690					emit-poly [#{00D0} #{01D0}]		;-- ADD rA, rD			; commutable op
 691				]
 692				switch b [
 693					imm [
 694						emit-poly either arg2 = 1 [	;-- trivial optimization
 695							[#{FEC0} #{40}]			;-- INC rA
 696						][
 697							[#{04} #{05} arg2] 		;-- ADD rA, value
 698						]
 699					]
 700					ref [
 701						emit-load/alt args/2
 702						do op-poly
 703					]
 704					reg [do op-poly]
 705				]
 706			]
 707			- [
 708				op-poly: [
 709					emit-poly [#{28D0} #{29D0}] 	;-- SUB rA, rD			; not commutable op
 710				]
 711				switch b [
 712					imm [
 713						emit-poly either arg2 = 1 [ ;-- trivial optimization
 714							[#{FEC8} #{48}]			;-- DEC rA
 715						][
 716							[#{2C} #{2D} arg2] 		;-- SUB rA, value
 717						]
 718					]
 719					ref [
 720						emit-load/alt args/2
 721						do op-poly
 722					]
 723					reg [do op-poly]
 724				]
 725			]
 726			* [
 727				op-poly: [
 728					emit-poly [#{F6EA} #{F7EA}] ;-- IMUL rD 			; commutable op
 729				]
 730				switch b [
 731					imm [
 732						either all [
 733							not zero? arg2
 734							c: power-of-2? arg2		;-- trivial optimization for b=2^n
 735						][
 736							either width = 1 [
 737								emit #{C0E0}		;-- SHL al, log2(b)	; 8-bit unsigned
 738							][
 739								emit-poly [#{C0ED} #{C1E0}]	;-- SAL rA, log2(b) ; signed
 740							]
 741							emit to-bin8 c
 742						][
 743							unless width = 1 [emit #{52}]  ;-- PUSH edx	; save edx from corruption for 16/32-bit ops
 744							with-width-of/alt args/2 [							
 745								emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value
 746							]
 747							emit #{89D3}				   ;-- MOV ebx, edx
 748							emit-poly [#{F6EB} #{F7EB}]	   ;-- IMUL rB		; result in ax|eax|edx:eax
 749							unless width = 1 [emit #{5A}]  ;-- POP edx
 750						]
 751					]
 752					ref [
 753						emit #{52}					;-- PUSH edx	; save edx from corruption
 754						emit-load/alt args/2
 755						do op-poly
 756						emit #{5A}					;-- POP edx
 757					]
 758					reg [do op-poly]
 759				]
 760			]
 761			/ [
 762				op-poly: [
 763					either width = 1 [				;-- 8-bit unsigned
 764						emit #{B400}				;-- MOV ah, 0			; clean-up garbage in ah
 765						emit #{F6F3}				;-- DIV bl
 766					][
 767						emit-sign-extension			;-- 16/32-bit signed
 768						emit-poly [#{F6FB} #{F7FB}]	;-- IDIV rB ; rA / rB
 769					]
 770				]
 771				switch b [
 772					imm [							;-- SAR usage http://www.arl.wustl.edu/~lockwood/class/cs306/books/artofasm/Chapter_6/CH06-3.html#HEADING3-120
 773						emit #{52}					;-- PUSH edx	; save edx from corruption
 774						with-width-of/alt args/2 [							
 775							emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value
 776						]
 777						emit #{89D3}				;-- MOV ebx, edx
 778						do op-poly
 779					]
 780					ref [
 781						emit #{52}					;-- PUSH edx	; save edx from corruption
 782						emit-load/alt args/2
 783						emit #{89D3}				;-- MOV ebx, edx
 784						do op-poly
 785					]
 786					reg [
 787						emit #{89D3}				;-- MOV ebx, edx		; ebx = b
 788						do op-poly
 789					]
 790				]
 791				if mod? [
 792					emit-poly [#{88E0} #{89D0}]		;-- MOV rA, remainder	; remainder from ah|dx|edx
 793					if all [mod? <> 'rem width > 1][;-- modulo, not remainder
 794					;-- Adjust modulo result to be mathematically correct:
 795					;-- 	if modulo < 0 [
 796					;--			if divisor < 0  [divisor: negate divisor]
 797					;--			modulo: modulo + divisor
 798					;--		]
 799						c: to-bin8 select [1 7 2 15 4 31] width		;-- support for possible int8 type
 800						emit #{0FBAE0}				;--   	  BT rA, 7|15|31 ; @@ better way ?
 801						emit c
 802						emit #{730A}				;-- 	  JNC exit		 ; (won't work with ax)
 803						emit #{0FBAE3}				;-- 	  BT rB, 7|15|31 ; @@ better way ?
 804						emit c
 805						emit #{7302}				;-- 	  JNC add		 ; (won't work with ax)
 806						emit-poly [#{F6DB} #{F7DB}]	;--		  NEG rB
 807						emit-poly [#{00D8} #{01D8}]	;-- add:  ADD rA, rB
 808					]								;-- exit:
 809				]
 810				if any [							;-- in case edx was saved on stack
 811					all [b = 'imm any [mod? not c]]
 812					b = 'ref
 813				][
 814					emit #{5A}						;-- POP edx
 815				]
 816			]
 817		]
 818		;TBD: test overflow and raise exception ? (or store overflow flag in a variable??)
 819		; JNO? (Jump if No Overflow)
 820	]
 821	
 822	emit-operation: func [name [word!] args [block!] /local a b c sorted? arg left right][
 823		if verbose >= 3 [print [">>>inlining op:" mold name mold args]]
 824
 825		set-width args/1							;-- set reg/mem access width
 826		c: 1
 827		foreach op [a b][
 828			arg: either object? args/:c [compiler/cast args/:c][args/:c]		
 829			set op either arg = <last> [
 830				 'reg								;-- value in eax
 831			][
 832				switch type?/word arg [
 833					char! 	 ['imm]		 			;-- add or mov to al
 834					integer! ['imm] 				;-- add or mov to eax
 835					word! 	 ['ref] 				;-- fetch value
 836					block!   ['reg] 				;-- value in eax (or in edx)
 837					path!    ['reg] 				;-- value in eax (or in edx)
 838				]
 839			]
 840			c: c + 1
 841		]
 842		if verbose >= 3 [?? a ?? b]					;-- a and b hold addressing modes for operands
 843
 844		;-- First operand processing
 845		left:  compiler/unbox args/1
 846		right: compiler/unbox args/2
 847		
 848		switch to path! reduce [a b] [
 849			imm/imm	[emit-poly [#{B0} #{B8} args/1]];-- MOV rA, a
 850			imm/ref [emit-load args/1]				;-- eax = a
 851			imm/reg [								;-- eax = b
 852				if path? right [
 853					emit-load args/2				;-- late path loading
 854				]
 855				emit-poly [#{88C2} #{89C2}]			;-- MOV rD, rA
 856				emit-poly [#{B0} #{B8} args/1]		;-- MOV rA, a		; eax = a, edx = b
 857			]
 858			ref/imm [emit-load args/1]
 859			ref/ref [emit-load args/1]
 860			ref/reg [								;-- eax = b
 861				if path? right [
 862					emit-load args/2				;-- late path loading
 863				]
 864				emit-poly [#{88C2} #{89C2}]			;-- MOV rD, rA	
 865				emit-load args/1					;-- eax = a, edx = b
 866			]
 867			reg/imm [								;-- eax = a (or edx = a if last-saved)
 868				if path? left [
 869					emit-load args/1				;-- late path loading
 870				]
 871				if last-saved? [emit #{92}]			;-- XCHG eax, edx	; eax = a
 872			]
 873			reg/ref [								;-- eax = a (or edx = a if last-saved)
 874				if path? left [
 875					emit-load args/1				;-- late path loading
 876				]
 877				if last-saved? [emit #{92}]			;-- XCHG eax, edx	; eax = a
 878			]
 879			reg/reg [								;-- eax = b, edx = a
 880				if path? left [
 881					if block? args/2 [				;-- edx = b
 882						emit #{92}					;-- XCHG eax, edx
 883						sorted?: yes				;-- eax = a, edx = b
 884					]
 885					emit-load args/1				;-- late path loading
 886				]
 887				if path? right [
 888					emit #{92}						;-- XCHG eax, edx	; eax = b, edx = a
 889					emit-load args/2
 890				]
 891				unless sorted? [emit #{92}]			;-- XCHG eax, edx	; eax = a, edx = b
 892			]
 893		]
 894		last-saved?: no								;-- reset flag
 895		if object? args/1 [emit-casting args/1 no]	;-- do runtime conversion on eax if required
 896
 897		;-- Operator and second operand processing
 898		either all [object? args/2 find [imm reg] b][
 899			emit-casting args/2 yes					;-- do runtime conversion on edx if required
 900		][
 901			implicit-cast right
 902		]
 903		case [
 904			find comparison-op name [emit-comparison-op name a b args]
 905			find math-op	   name	[emit-math-op		name a b args]
 906			find bitwise-op	   name	[emit-bitwise-op	name a b args]
 907			find bitshift-op   name [emit-bitshift-op   name a b args]
 908		]
 909	]
 910	
 911	emit-cdecl-pop: func [spec [block!] args [block!] /local size][
 912		size: emitter/arguments-size? spec/4
 913		if all [
 914			spec/2 = 'syscall
 915			compiler/job/syscall = 'BSD
 916		][
 917			size: size + stack-width				;-- account for extra space
 918		]
 919		if issue? args/1 [							;-- test for variadic call
 920			size: length? args/2
 921			if spec/2 = 'native [
 922				size: size + pick [3 2] args/1 = #typed 	;-- account for extra arguments @@ [3 2] ??
 923			]
 924			size: size * stack-width
 925		]
 926		emit #{83C4}								;-- ADD esp, n		; @@ 8-bit offset only?
 927		emit to-bin8 size
 928	]
 929	
 930	patch-call: func [code-buf rel-ptr dst-ptr][
 931		change										;-- CALL NEAR disp size
 932			at code-buf rel-ptr
 933			to-bin32 dst-ptr - rel-ptr - ptr-size
 934	]
 935	
 936	emit-argument: func [arg func-type [word!]][
 937		either all [
 938			object? arg
 939			any [arg/type = 'logic! 'byte! = first compiler/get-type arg/data]
 940			not path? arg/data
 941		][
 942			unless block? arg [emit-load arg]		;-- block! means last value is already in eax (func call)
 943			emit-casting arg no
 944			emit-push <last>
 945			compiler/last-type: arg/type			;-- for inline unary functions
 946		][
 947			emit-push either block? arg [<last>][arg]
 948		]
 949	]
 950		
 951	emit-call-syscall: func [args [block!] fspec [block!]][
 952		switch compiler/job/syscall [
 953			BSD [									; http://www.freebsd.org/doc/en/books/developers-handbook/book.html#X86-SYSTEM-CALLS
 954				emit #{83EC04}						;-- SUB esp, 4		; extra entry (BSD convention)			
 955			]
 956			Linux [
 957				if fspec/1 >= 6 [
 958					emit #{89E8}					;-- MOV eax, ebp	; save frame pointer
 959				]
 960				repeat c fspec/1 [
 961					emit pick [
 962						#{5B}						;-- POP ebx			; get 1st arg in reg
 963						#{59}						;-- POP ecx			; get 2nd arg in reg
 964						#{5A}						;-- POP edx			; get 3rd arg in reg
 965						#{5E}						;-- POP esi			; get 4th arg in reg
 966						#{5F}						;-- POP edi			; get 5th arg in reg
 967						#{5D}						;-- POP ebp			; get 6th arg in reg
 968					] 1 + fspec/1 - c
 969				]
 970				if fspec/1 >= 6 [
 971					emit #{50}						;-- PUSH eax		; save frame pointer on stack
 972				]
 973			]
 974		]
 975		emit #{B8}									;-- MOV eax, code
 976		emit to-bin32 last fspec
 977		emit #{CD80}								;-- INT 0x80		; syscall
 978		switch compiler/job/syscall [
 979			BSD [emit-cdecl-pop fspec args]			;-- BSD syscall cconv (~ cdecl)
 980			Linux [
 981				if fspec/1 >= 6 [emit #{5D}]		;-- POP ebp			; restore frame pointer
 982			]
 983		]
 984	]
 985	
 986	emit-call-import: func [args [block!] fspec [block!] spec [block!]][
 987		either compiler/job/OS = 'MacOSX [
 988			emit #{B8}								;-- MOV eax, addr
 989			emit-reloc-addr spec
 990			emit #{FFD0} 							;-- CALL eax		; direct call
 991		][	
 992			emit #{FF15}							;-- CALL FAR [addr]	; indirect call
 993			emit-reloc-addr spec
 994		]
 995		if fspec/3 = 'cdecl [						;-- add calling cleanup when required
 996			emit-cdecl-pop fspec args
 997		]		
 998	]
 999
1000	emit-call-native: func [args [block!] fspec [block!] spec [block!] /local total][
1001		if issue? args/1 [							;-- variadic call
1002			emit-push 4 * length? args/2			;-- push arguments total size in bytes 
1003													;-- (required to clear stack on stdcall return)
1004			emit #{8D742404}						;-- LEA esi, [esp+4]	; skip last pushed value
1005			emit #{56}								;-- PUSH esi			; push arguments list pointer
1006			total: length? args/2
1007			if args/1 = #typed [total: total / 2]
1008			emit-push total							;-- push arguments count
1009		]
1010		emit #{E8}									;-- CALL NEAR disp
1011		emit-reloc-addr spec						;-- 32-bit relative displacement place-holder
1012		if fspec/3 = 'cdecl [						;-- in case of non-default calling convention
1013			emit-cdecl-pop fspec args
1014		]
1015	]
1016	
1017	emit-stack-align-prolog: func [args-nb [integer!] /local offset][
1018		if compiler/job/stack-align-16? [
1019			emit #{89E7}							;-- MOV edi, esp
1020			emit #{83E4F0}							;-- AND esp, -16
1021			offset: 1 + args-nb 					;-- account for saved edi
1022			unless zero? offset: offset // 4 [
1023				emit #{83EC}						;-- SUB esp, offset		; ensure call will be 16-bytes aligned
1024				emit to-bin8 (4 - offset) * 4
1025			]
1026			emit #{57}								;-- PUSH edi
1027		]
1028	]
1029	
1030	emit-stack-align-epilog: func [args-nb [integer!]][
1031		if compiler/job/stack-align-16? [
1032			emit #{5C}								;-- POP esp
1033		]
1034	]
1035
1036	emit-prolog: func [name [word!] locals [block!] locals-size [integer!] /local fspec][
1037		if verbose >= 3 [print [">>>building:" uppercase mold to-word name "prolog"]]
1038
1039		emit #{55}									;-- PUSH ebp
1040		emit #{89E5}								;-- MOV ebp, esp
1041		unless zero? locals-size [
1042			emit #{83EC}							;-- SUB esp, locals-size
1043			emit to-char round/to/ceiling locals-size 4		;-- limits total local variables size to 255 bytes
1044		]
1045		fspec: select compiler/functions name
1046		if all [block? fspec/4/1 fspec/5 = 'callback][
1047			emit #{53}								;-- PUSH ebx
1048			emit #{56}								;-- PUSH esi
1049			emit #{57}								;-- PUSH edi
1050		]
1051	]
1052
1053	emit-epilog: func [
1054		name [word!] locals [block!] args-size [integer!] locals-size [integer!]
1055		/local fspec
1056	][
1057		if verbose >= 3 [print [">>>building:" uppercase mold to-word name "epilog"]]
1058
1059		fspec: select compiler/functions name
1060		if all [block? fspec/4/1 fspec/5 = 'callback][
1061			emit #{5F}								;-- POP edi
1062			emit #{5E}								;-- POP esi
1063			emit #{5B}								;-- POP ebx
1064		]
1065		emit #{C9}									;-- LEAVE
1066		either any [
1067			zero? args-size
1068			fspec/3 = 'cdecl
1069		][
1070			;; cdecl: Leave original arguments on stack, popped by caller.
1071			emit #{C3}								;-- RET
1072		][
1073			;; stdcall/reds: Consume original arguments from stack.
1074			either compiler/check-variable-arity? locals [
1075				emit #{5E}							;-- POP esi			; retrieve the return address
1076				emit #{5B}							;-- POP ebx			; skip arguments count
1077				emit #{5B}							;-- POP ebx			; skip arguments pointer
1078				emit #{5B}							;-- POP ebx			; get stack offset
1079				emit #{01DC}						;-- ADD esp, ebx	; skip arguments list (clears stack)
1080				emit #{56}							;-- PUSH esi		; push return address
1081				emit #{C3}							;-- RET
1082			][
1083				emit #{C2}							;-- RET args-size
1084				emit to-bin16 round/to/ceiling args-size 4
1085			]
1086		]
1087	]
1088]