Skip to content

Instantly share code, notes, and snippets.

@Skrylar
Last active September 30, 2016 19:35
Show Gist options
  • Save Skrylar/07bc34904ea74a4b32f6 to your computer and use it in GitHub Desktop.
Save Skrylar/07bc34904ea74a4b32f6 to your computer and use it in GitHub Desktop.
Red []
forth: context [
prog: [1 2 3 4 5 6 7 8 '+ '+ '* 150 '+ '* '+ '* '*]
registers: ['eax 'ebx 'ecx 'edx]
register-taint: [] ; registers we've touched in this set
register-goop: [] ; registers we need to pop to use
register-sets: 0
next-register: head registers
value-positions: []
top-value: 0
alloc-reg: func [][
; add a new value, find a new register
top-value: top-value + 1
ret: first next-register
; start a new register set if we are losers
unless ret [
print "; new register set"
next-register: head registers
ret: first registers
register-sets: register-sets + 1
clear register-taint
clear register-goop
]
next-register: next next-register
; check for register taint
if none? find register-taint ret [
append register-taint ret
print ['push ret]
]
append value-positions ret
;print ["; values: " value-positions]
; return the lucky winner
return ret
]
degoop: func[register][
idx: find register-goop register
if not none? idx [
print ['pop register]
idx/1: none
]
]
reg-top: func[][
; TODO ensure this is actually a register?
first back tail value-positions
]
drop-top-reg: func[][
; perform the removal
top-value: top-value - 1
remove back tail value-positions
; check if we just flipped to a previous register set
either head? next-register [
print "; previous register set"
register-sets: register-sets - 1
next-register: back tail registers
; all registers have been tainted (by the previous set)
clear register-taint
append register-taint registers
; all registers have been gooped (by the set we just left)
clear register-goop
append register-goop registers
][
next-register: back next-register
]
]
print [";" prog]
literal-op: [set literal integer! (
lhs: alloc-reg
print ['mov lhs literal "; value #" top-value]
;print ["; value positions:" value-positions]
)]
add-op: ['+ (
; grab operands
rhs: reg-top
degoop rhs
drop-top-reg
lhs: reg-top
degoop lhs
; emit code, replace top value
print ['add lhs rhs "; value #" top-value]
;print ["; values: " value-positions]
)]
mul-op: ['* (
; grab operands
rhs: reg-top
degoop rhs
drop-top-reg
lhs: reg-top
degoop lhs
; emit code, replace top value
print ['mul lhs rhs "; value #" top-value]
)]
op: [literal-op | mul-op | add-op]
machine: [some op]
parse prog machine
]
@SteeveGit
Copy link

The stack is not aligned (more push than pop), is it intended ?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment