view code/ghc.lm @ 42:f1453e8970ca

Added simulator for ghc microcontroller
author Michael Pavone <pavone@retrodev.com>
date Sat, 26 Jul 2014 19:43:27 -0700
parents
children
line wrap: on
line source

#{
	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: )
	}
}