<commit_before>;;; This function will parse a whole score file to lists to be processed  
;;; We might want to track line/similar things for better error reporting later

(defun read-score-file (filename)
	(with-open-file (stream filename)
		(let ((end (gensym "end")))
			(loop for i = (read stream nil end)
				while (not (eq i end)) collect i)))) 

;;; Very rought testing right now

(defun test-ee-parse ()
	(let ((forms (read-score-file "../tests/ps2/test0.score")))
		;; forms has the lists of the 
		(when forms
			(let ((inner (car forms)))
				; first entry here should be a def-ee-fun
				; notice will be proper parsing here, this is just for test
				(when (eql (car inner) 'def-ee-fun)
					(loop for i in (nthcdr 3 inner) do	; skip the function name and assume no in-parameters
						; here we can start pushing out the instructions but just printing now
						(print i)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Implementing the mips (r5900 assembler here)
;;;
;;; Loots of testing / hacking around currently
;;;

(defmacro make-ee-registers-hash ()
  (let ((hash (make-hash-table :test #'eq)))
		(loop for i from 0 to 31 collecting (setf (gethash (intern (format nil "R~d" i)) hash) i)) hash))

(defparameter *ee-registers* (make-ee-registers-hash)) 
; (defparameter *fpu-registers* (make-ee-registers-hash "FP")) 

(defun print-hash-entry (key value)
    (format t "The value associated with the key ~S is ~S~%" key value))

;;; write value to the stream

(defun write-value (stream value byte-count)
	(format t "Writing value #x~x" value)
  (loop for i from 0 to (1- byte-count)
	  do (write-byte (ldb (byte 8 (* 8 i)) value) stream)))

; info about how to encode the function

(defstruct encoding inst (spec 0) rd rs rt imm (fixed 0) func)

;; binds and valdiats rt and rs

(defun validate-rt-rs (arguments)
	(let ((rt (gethash (nth 1 arguments) *ee-registers*)) 
			  (rs (gethash (nth 2 arguments) *ee-registers*)))
		(when (not rt)
			(error (format nil "Invalid register name for rt ~s" (nth 1 arguments))))
		(when (not rs)
			(error (format nil "Invalid register name for rs ~s" (nth 2 arguments))))
		(values rt rs)))

;; binds and valdiats rd, rs and rt 

(defun validate-rd-rt-rs (arguments)
	(let ((rd (gethash (nth 1 arguments) *ee-registers*)) 
			  (rs (gethash (nth 2 arguments) *ee-registers*))
			  (rt (gethash (nth 3 arguments) *ee-registers*)))
		(when (not rd)
			(error (format nil "Invalid register name for rd ~s" (nth 1 arguments))))
		(when (not rs)
			(error (format nil "Invalid register name for rs ~s" (nth 2 arguments))))
		(when (not rt)
			(error (format nil "Invalid register name for rt ~s" (nth 3 arguments))))
		(values rd rs rt)))


;;; instruction type 0
;;;
;;; <operand> <register>, <register>, <immediate>
;;;

(defun inst-type0 (stream instruction arguments enc)
	(when (not (equal (length arguments) 4))
		(error (format nil "Expected 4 arguments si-type <operand> rt, rs/base, <immediate> was given ~{~a~^, ~}" arguments)))
	(multiple-value-bind (rt rs) (validate-rt-rs arguments)
		(when (not (numberp (nth 3 arguments)))
			(error (format nil "Invalid immediate ~s" (nth 3 arguments))))
		(write-value stream (logior (ash instruction (encoding-inst enc)) 
																(ash rs (encoding-rs enc))
																(ash rt (encoding-rt enc))
																(ash (logand (nth 3 arguments) #xffff) (encoding-imm enc))) 4)))

;;; instruction type 1
;;; 
;;; <operand> <register>, <register>, <register> 
;;;

(defun inst-type1 (stream instruction arguments enc) 
	(when (not (equal (length arguments) 4))
		(error (format nil "Expected 4 arguments si-type <operand> rd, rs, rt, was given ~{~a~^, ~}" arguments)))
	(multiple-value-bind (rd rs rt) (validate-rd-rt-rs arguments)
		(write-value stream (logior (ash (encoding-spec enc) 26) 
																(ash (encoding-fixed enc) 0)
																(ash rs (encoding-rs enc))
																(ash rt (encoding-rt enc))
																(ash rd (encoding-rd enc))
																(ash instruction (encoding-inst enc))) 4)))

;;; instruction type 2
;;; 
;;; <operand> <register>, <immediate> 
;;;

(defun inst-type2 (stream instruction arguments enc)
	(when (not (equal (length arguments) 3))
		(error (format nil "Expected 3 arguments si-type <operand> rt, rs/base, <immediate> was given ~{~a~^, ~}" arguments)))
	(let ((rs (gethash (first arguments) *ee-registers*)))
		(when (not rs)
			(error (format nil "Invalid register name for rt ~s" (first arguments))))
		(when (not (numberp (nth 2 arguments)))
			(error (format nil "Invalid immediate ~s" (nth 2 arguments))))
		(write-value stream (logior (ash instruction (encoding-inst enc)) 
																(ash rs (encoding-rs enc))
																(ash (nth 2 arguments) (encoding-imm enc))) 4)))

;;; instruction type 3
;;; 
;;; <operand> <immediate> 
;;;

(defun inst-type3 (stream instruction arguments enc)
	(when (not (equal (length arguments) 2))
		(error (format nil "Expected 2 arguments <operand> <immediate> was given ~{~a~^, ~}" arguments)))
	(when (not (numberp (nth 1 arguments)))
		(error (format nil "Invalid immediate ~s" (nth 1 arguments))))
	(write-value stream (logior (ash instruction (encoding-inst enc)) 
															(ash (nth 1 arguments) (encoding-imm enc))) 4))

;;; instruction type 4
;;;
;;; <operand> <register>, <register>
;;;

(defun inst-type4 (stream instruction arguments enc)
	(when (not (equal (length arguments) 3))
		(error (format nil "Expected 3 arguments si-type <operand> rt, rs/base, <immediate> was given ~{~a~^, ~}" arguments)))
	(multiple-value-bind (rt rs) (validate-rt-rs arguments)
		(write-value stream (logior (ash instruction (encoding-inst enc)) 
																(ash rs (encoding-rs enc))
																(ash rt (encoding-rt enc))) 4)))

;;; instruction type 5
;;; 
;;; <operand> <register>
;;;

(defun inst-type5 (stream instruction arguments enc)
	(when (not (equal (length arguments) 2))
		(error (format nil "Expected 2 arguments si-type <operand> rt, rs/base, <immediate> was given ~{~a~^, ~}" arguments)))
	(let ((rt (gethash (first arguments) *ee-registers*)))
		(when (not rt)
			(error (format nil "Invalid register name for rt ~s" (first arguments))))
		(write-value stream (logior (ash instruction (encoding-inst enc)) 
																(ash rt (encoding-rt enc))) 4)))
;;; instruction type 6
;;; 
;;; <operand> 
;;;

(defun inst-type6 (stream instruction arguments enc)
	(when (not (equal (length arguments) 1))
		(error (format nil "Expected 1 arguments si-type <operand> rt, rs/base, <immediate> was given ~{~a~^, ~}" arguments)))
	(write-value stream (ash instruction (encoding-inst enc)) 4))
<commit_msg>Added macro to generate all instruction types and removed lots of duplicated code<commit_after>;;; This function will parse a whole score file to lists to be processed  
;;; We might want to track line/similar things for better error reporting later

(defun read-score-file (filename)
	(with-open-file (stream filename)
		(let ((end (gensym "end")))
			(loop for i = (read stream nil end)
				while (not (eq i end)) collect i)))) 

;;; Very rought testing right now

(defun test-ee-parse ()
	(let ((forms (read-score-file "../tests/ps2/test0.score")))
		;; forms has the lists of the 
		(when forms
			(let ((inner (car forms)))
				; first entry here should be a def-ee-fun
				; notice will be proper parsing here, this is just for test
				(when (eql (car inner) 'def-ee-fun)
					(loop for i in (nthcdr 3 inner) do	; skip the function name and assume no in-parameters
						; here we can start pushing out the instructions but just printing now
						(print i)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Implementing the mips (r5900 assembler here)
;;;
;;; Loots of testing / hacking around currently
;;;

(defmacro make-ee-registers-hash ()
  (let ((hash (make-hash-table :test #'eq)))
		(loop for i from 0 to 31 collecting (setf (gethash (intern (format nil "R~d" i)) hash) i)) hash))

(defparameter *ee-registers* (make-ee-registers-hash)) 
; (defparameter *fpu-registers* (make-ee-registers-hash "FP")) 

(defun print-hash-entry (key value)
    (format t "The value associated with the key ~S is ~S~%" key value))

;;; write value to the stream

(defun write-value (stream value byte-count)
	(format t "Writing value #x~x" value)
  (loop for i from 0 to (1- byte-count)
	  do (write-byte (ldb (byte 8 (* 8 i)) value) stream)))

; info about how to encode the function

(defstruct encoding inst (spec 0) rd rs rt imm (fixed 0) func)

;;
;; builds the diffrent instruction types based on the inst-layout data
;;

(defmacro def-inst-type (name inst-layout)
 `(progn
		(defun ,name (stream instruction arguments enc)
			(let ((code 0))
				,(when (first inst-layout)
					;; Generate the let for all the registers
					`(let ,(loop for i in (first inst-layout) for c from 1 collecting 
						`(,i (gethash (nth ,c arguments) *ee-registers*)))
						;; error checking for all the registers
					,@(loop for i in (first inst-layout) for c from 1 collect
						`(when (not ,i) 
							(error (format nil "Invalid register name ~s" (nth ,c arguments)))))
				;; encode the registers
				(setf code (logior ,@(loop for i in (first inst-layout) collecting 
					`(ash ,i ,(read-from-string (format nil "(ENCODING-~A ENC)" i))))))))
			;; if we have a length of 2 in the list then we have imm value also and it needs to be a number 
			,(when (eql (length inst-layout) 2)
				(let ((imm-arg (+ (length (first inst-layout)) 1)))
					;`(when (not (numberp (nth ,imm-arg arguments)))
					;	(error (format nil "Invalid immediate ~s" (nth ,imm-arg arguments))))
						;; encode the immediate value
					`(setf code (logior code (ash (logand (nth ,imm-arg arguments) ,(second inst-layout))  (encoding-imm enc))))))
			(write-value stream (logior code 
																	(ash instruction (encoding-inst enc)) 
																	(ash (encoding-spec enc) 26) 
																	(ash (encoding-fixed enc) 0)) 4)))))

;;
;; diffrent type of ee instructions
;;

(def-inst-type inst-type0 ((rd rt) #x0000ffff)) 
(def-inst-type inst-type1 ((rd rt rs))) 
(def-inst-type inst-type2 ((rs) #x0000ffff)) 
(def-inst-type inst-type3 (() #x0000ffff)) 
(def-inst-type inst-type4 ((rt rs))) 
(def-inst-type inst-type5 ((rt))) 
(def-inst-type inst-type6 (())) 

{'fraction_non_alphanumeric': 0.1678314983245572, 'fraction_numerical': 0.011297271421732886, 'mean_word_length': 3.607851786501985, 'pattern_counts': {'":': 0, '<': 35, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5473054', 'n_tokens_mistral': 4005, 'n_tokens_neox': 3401, 'n_words': 1286}