# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1406429007 25200
# Node ID f1453e8970ca83d4a5ecfdba1aad790c17f05888
# Parent  e1047192610c8ade587468423754a11033b47e2d
Added simulator for ghc microcontroller

diff -r e1047192610c -r f1453e8970ca code/ghc.lm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/code/ghc.lm	Sat Jul 26 19:43:27 2014 -0700
@@ -0,0 +1,508 @@
+#{
+	import: [
+		length
+		reverse
+		split:at
+		map
+		fold:with
+		filter
+		flatten
+	] from: (module: "ll.lm")
+	
+	import: [
+		makeTree:size
+		makeTree
+		filledTree
+		_filledTree
+		get:fromTree:size
+		get:fromTree
+		treeMap:size
+		treeMap
+		tree:size:update:with
+		tree:update:with
+		tree:set:to
+	] from: (module: "tree.lm")
+	
+	add8 <- :a b {
+		a <- a + b
+		if: a >= 256 {
+			a <- a - 256
+		} else: {}
+		a
+	}
+	
+	sub8 <- :a b {
+		a <- a - b
+		if: a < 0 {
+			a <- a + 256
+		} else: {}
+		a
+	}
+	
+	mul8 <- :a b {
+		a <- a * b
+		while: { a > 256 } do: {
+			a <- a - 256
+		}
+		a
+	}
+	
+	and8 <- :a b {
+		bit <- 128
+		out <- 0
+		while: { bit > 0 } do: {
+			if: a >= bit {
+				a <- a - bit
+				if: b >= bit {
+					b <- b - bit
+					out <- out + bit
+				} else: {}
+			} else: {
+				if: b >= bit {
+					b <- b - bit
+				} else: {}
+			}
+			bit <- bit / 2
+		}
+		out
+	}
+	
+	or8 <- :a b {
+		bit <- 128
+		out <- 0
+		while: { bit > 0 } do: {
+			if: a >= bit {
+				a <- a - bit
+				out <- out + bit
+				if: b >= bit {
+					b <- b - bit
+				} else: {}
+			} else: {
+				if: b >= bit {
+					b <- b - bit
+					out <- out + bit
+				} else: {}
+			}
+			bit <- bit / 2
+		}
+		out
+	}
+	
+	xor8 <- :a b {
+		bit <- 128
+		out <- 0
+		while: { bit > 0 } do: {
+			if: a >= bit {
+				a <- a - bit
+				if: b >= bit {
+					b <- b - bit
+				} else: {
+					out <- out + bit
+				}
+			} else: {
+				if: b >= bit {
+					b <- b - bit
+					out <- out + bit
+				} else: {}
+			}
+			bit <- bit / 2
+		}
+		out
+	}
+	
+	makeCPU <- :code intHandler {
+		a <- 0
+		b <- 0
+		c <- 0
+		d <- 0
+		e <- 0
+		f <- 0
+		g <- 0
+		h <- 0
+		
+		dataMem <- filledTree: 0 256
+		
+		getRegVal <- :regnum pc {
+			if: regnum >= 4 {
+				if: regnum >= 6 {
+					if: regnum = 6 {
+						regnum <- g
+					} else: {
+						if: regnum = 7 {
+							regnum <- h
+						} else: {
+							regnum <- pc
+						}
+					}
+				} else: {
+					if: regnum = 4 {
+						regnum <- e
+					} else: {
+						regnum <- f
+					}
+				}
+			} else: {
+				if: regnum >= 2 {
+					if: regnum = 2 {
+						regnum <- c
+					} else: {
+						regnum <- d
+					}
+				} else: {
+					if: regnum {
+						regnum <- b
+					} else: {
+						regnum <- a
+					}
+				}
+			}
+			regnum
+		}
+		
+		getArg <- :arg pc {
+			type <- arg value
+			param <- arg tail
+			if: type >= 2 {
+				if: type = 3 {
+					param <- get: param fromTree: dataMem
+				} else: {}
+			} else: {
+				param <- getRegVal: param pc
+				if: type {
+					param <- get: param fromTree: dataMem
+				} else: {}
+			}
+			param
+		}
+		
+		setReg <- :regnum pc val {
+			if: regnum >= 4 {
+				if: regnum >= 6 {
+					if: regnum = 6 {
+						g <- val
+					} else: {
+						if: regnum = 7 {
+							h <- val
+						} else: {
+							pc <- val
+						}
+					}
+				} else: {
+					if: regnum = 4 {
+						e <- val
+					} else: {
+						f <- val
+					}
+				}
+			} else: {
+				if: regnum >= 2 {
+					if: regnum = 2 {
+						c <- val
+					} else: {
+						d <- val
+					}
+				} else: {
+					if: regnum {
+						b <- val
+					} else: {
+						a <- val
+					}
+				}
+			}
+			pc
+		}
+		
+		saveDest <- :arg pc val {
+			type <- arg value
+			param <- arg tail
+			if: type >= 2 {
+				if: type = 3 {
+					dataMem <- tree: dataMem set: param to: val
+				} else: {}
+			} else: {
+				if: type {
+					param <- getRegVal: param pc
+					dataMem <- tree: dataMem set: param to: val
+				} else: {
+					pc <- setReg: param pc val
+				}
+			}
+			pc
+		}
+		
+		mov <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (getArg: src pc))]
+			}
+		}
+		
+		inc <- :args {
+			dst <- args value
+			:pc {
+				#[1 (saveDest: dst pc (add8: (getArg: dst pc) 1))]
+			}
+		}
+		
+		dec <- :args {
+			dst <- args value
+			:pc {
+				#[1 (saveDest: dst pc (sub8: (getArg: dst pc) 1))]
+			}
+		}
+		
+		add <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (add8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		sub <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (sub8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		mul <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (mul8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		div <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				srcv <- getArg: src pc
+				if:	srcv = 0 {
+					pc <- #[0 pc]
+				} else: {
+					pc <- #[1 (saveDest: dst pc (getArg: dst pc) / srcv)]
+				}
+				pc
+			}
+		}
+		
+		and <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (and8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		or <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (or8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		xor <- :args {
+			dst <- args value
+			src <- (args tail) value
+			:pc {
+				#[1 (saveDest: dst pc (xor8: (getArg: dst pc) (getArg: src pc)))]
+			}
+		}
+		
+		jlt <- :args {
+			target <- args value
+			x <- (args tail) value
+			y <- ((args tail) tail) value
+			:pc {
+				if: x >= y {
+				} else: {
+					pc <- target
+				}
+				pc
+			}
+		}
+		
+		jeq <- :args {
+			target <- args value
+			x <- (args tail) value
+			y <- ((args tail) tail) value
+			:pc {
+				if: x = y {
+					pc <- target
+				} else: {
+				}
+				pc
+			}
+		}
+		
+		jgt <- :args {
+			target <- args value
+			x <- (args tail) value
+			y <- ((args tail) tail) value
+			:pc {
+				if: x > y {
+					pc <- target
+				} else: {
+				}
+				pc
+			}
+		}
+		
+		int <- :args {
+			num <- args value
+			:pc {
+				iargs <- a
+				if: num = 8 {
+					iargs <- #[a b c d e f g h]
+				} else: {
+					if: num = 7 {
+						iargs <- #[a b]
+					} else: {}
+				}
+				intHandler: num iargs setReg pc
+			}
+		}
+		
+		
+		hlt <- :pc {
+			#[0 pc]
+		}
+		
+		codeMem <- (fold: code #[(filledTree: hlt 256) 0] with: :acc inst {
+			cmem <- acc value
+			pc <- acc tail
+			
+			inum <- inst value
+			args <- inst tail
+			
+			if: inum >= 7 {
+				if: inum >= 11 {
+					if: inum >= 13 {
+						if: inum = 14 {
+							inst <- hlt
+						} else: {
+							inst <- int: args
+						}
+					} else: {
+						if: inum = 12 {
+							inst <- jgt: args
+						} else: {
+							inst <- jeq: args
+						}
+					}
+				} else: {
+					if: inum >= 9 {
+						if: inum = 10 {
+							inst <- jlt: args
+						} else: {
+							inst <- xor: args
+						}
+					} else: {
+						if: inum = 8 {
+							inst <- or: args
+						} else: {
+							inst <- and: args
+						}
+					}
+				}
+			} else: {
+				if: inum >= 3 {
+					if: inum >= 5 {
+						if: inum = 5 {
+							inst <- mul: args
+						} else: {
+							inst <- div: args
+						}
+					} else: {
+						if: inum = 3 {
+							inst <- add: args
+						} else: {
+							inst <- sub: args
+						}
+					}
+				} else: {
+					if: inum = 2 {
+						inst <- dec: args
+					} else: {
+						if: inum {
+							inst <- inc: args
+						} else: {
+							inst <- mov: args
+						}
+					}
+				}
+			}
+			#[(tree: cmem set: pc to: inst) pc + 1]
+		}) value
+		
+		{
+			cycle <- 0
+			pc <- 0
+			ret <- 0
+			run <- 1
+			
+			while: { run } do: {
+				ret <- get: pc fromTree: codeMem
+				ret <- ret: pc
+				run <- ret value
+				
+				if: (ret tail) = pc {
+					pc <- pc + 1
+				} else: {
+					pc <- ret tail
+				}
+				cycle <- cycle + 1
+				if: cycle >= 1024 {
+					run <- 0
+				} else: {}
+			}
+			cycle
+		}
+	}
+	
+	main <- {
+		cpu <- makeCPU: [
+			#[0 [#[0 0] #[2 31]]] //0 a <- 31
+			#[0 [#[0 1] #[2 45]]] //1 b <- 45
+			#[0 [#[0 2] #[2 57]]] //2 c <- 57
+			#[0 [#[0 3] #[2 127]]] //3 d <- 127
+			#[0 [#[0 4] #[2 128]]] //4 e <- 128
+			#[0 [#[0 5] #[2 254]]] //5 f <- 254
+			#[0 [#[0 6] #[2 255]]] //6 g <- 255
+			#[0 [#[0 7] #[2 3]]] //7 h <- 3
+			#[0 [#[3 0] #[2 45]]] //8 [0] <- 45
+			#[1 [#[0 0]]] //9 a <- a + 1 : 32
+			#[2 [#[0 1]]] //10 b <- b - 1 : 44
+			#[3 [#[0 2] #[0 3]]] //11 c <- c + d : 184
+			#[4 [#[0 4] #[0 5]]] //12 e <- e - f : 130
+			#[5 [#[0 6] #[0 7]]] //13 g <- g * h : 253
+			#[6 [#[3 0] #[0 0]]] //14 [0] <- [0] * a : 160
+			#[13 [8]] //15
+			#[14 []] //16
+		] :num iargs setReg pc {
+			print: #[num pc iargs]
+			#[1 pc]
+		}
+		print: (add8: 2 3)
+		print: (add8: 255 1)
+		print: (add8: 129 128)
+		print: (sub8: 4 2)
+		print: (sub8: 2 4)
+		print: (sub8: 0 255)
+		print: (mul8: 255 255)
+		print: (mul8: 255 2)
+		print: (mul8: 3 5)
+		print: (and8: 127 254)
+		print: (and8: 3 5)
+		print: (or8: 127 254)
+		print: (or8: 3 5)
+		print: (xor8: 127 254)
+		print: (xor8: 3 5)
+		print: (cpu: )
+	}
+}
\ No newline at end of file