From 37241a1fc3d4a64dac0fe14cb98a3df4a8c42442 Mon Sep 17 00:00:00 2001 From: John Lorentzson Date: Thu, 8 May 2025 17:11:57 +0200 Subject: [PATCH] Replace the text assembly in high-level with instruction objects --- wip-duuqnd/user-side-compiler/high-level.lisp | 72 +++++++++++------- .../user-side-compiler/instruction-list.txt | Bin 7057 -> 4076 bytes .../user-side-compiler/instruction.lisp | 63 +++++++++++---- 3 files changed, 95 insertions(+), 40 deletions(-) diff --git a/wip-duuqnd/user-side-compiler/high-level.lisp b/wip-duuqnd/user-side-compiler/high-level.lisp index 15bc2c8..7fdd12a 100644 --- a/wip-duuqnd/user-side-compiler/high-level.lisp +++ b/wip-duuqnd/user-side-compiler/high-level.lisp @@ -1,10 +1,22 @@ (in-package #:user-side-compiler) (defvar *label-counter* 0) +(defvar *instruction-source* nil) +(defvar *compile-result*) + +(defun produce-instruction (instruction-class &optional operand) + (push (make-instance instruction-class :operand operand :source *instruction-source*) + *compile-result*)) (defun genlabel (&optional (prefix "L")) (format nil "~A~D" prefix (incf *label-counter*))) +(defun produce-label (&optional label) + (when (null label) + (setf label (genlabel))) + (push label *compile-result*) + label) + (defmacro format-inst (destination control-string &rest format-arguments) `(format ,destination "~C~A~%" #\Tab (format nil ,control-string ,@format-arguments))) @@ -23,7 +35,7 @@ (format stream "~D" (ref-value object)))) (defmethod dereference ((ref reference-constant)) - (format-inst t "LDA #~D" (ref-value ref))) + (produce-instruction 'inst-lda-immediate (ref-value ref))) (defclass reference-variable (reference) ((%index :accessor ref-index :initarg :index))) @@ -33,8 +45,8 @@ (format stream "@~D" (ref-index object)))) (defmethod dereference ((ref reference-variable)) - (format-inst t "LDY #~D" (ref-index ref)) - (format-inst t "LDA VARVEC,Y")) + (produce-instruction 'inst-ldy-immediate (ref-index ref)) + (produce-instruction 'inst-lda-absolute-y "VARVEC")) (defclass node () ((%next :accessor next :accessor normal-next :initform nil))) @@ -45,6 +57,11 @@ (defmethod generate-code :after ((node node)) (terpri)) +(defmethod compile-node ((node node)) + (generate-code node) + (unless (null (next node)) + (compile-node (next node)))) + (defclass node-call (node) ((%callee :accessor callee :initarg :callee) (%arguments :accessor arguments :initarg :arguments))) @@ -54,23 +71,25 @@ (format stream "~A~A" (callee object) (arguments object)))) (defmethod generate-code ((node node-call)) - (loop :for ref :in (arguments node) - :for index :from 0 - :do (dereference ref) - :do (format-inst t "STA ARGVEC+~D" index)) - (format-inst t "JSR ~A" (callee node))) + (let ((*instruction-source* node)) + (loop :for ref :in (arguments node) + :for index :from 0 + :do (dereference ref) + :do (produce-instruction 'inst-sta-absolute (format nil "ARGVEC+~D" index))) + (produce-instruction 'inst-jsr-absolute (callee node)))) (defclass node-branch (node) ((%branch-next :accessor branch-next :initarg :branch-next))) (defmethod generate-code ((node node-branch)) - (let ((else-label (genlabel "ELSE"))) - (format-inst t "LDA RESULT") - (format-inst t "BNE ~A" else-label) + (let ((*instruction-source* node) + (else-label (genlabel "ELSE"))) + (produce-instruction 'inst-lda-absolute "RESULT") + (produce-instruction 'inst-bne-zero-page else-label) ;; The THEN branch - (generate-code (branch-next node)) + (compile-node (branch-next node)) ;; The ELSE branch - (format t "~%~A:~%" else-label))) + (produce-label else-label))) (defclass node-dotimes (node) ((%stop-ref :accessor stop-ref :initarg :stop-ref @@ -78,24 +97,25 @@ (%loopee-node :accessor loopee-node :initarg :loopee-node))) (defmethod generate-code ((node node-dotimes)) - (format-inst t "TXA") - (format-inst t "PHA") + (let ((*instruction-source* node) + (loop-label (genlabel "LOOPBACK"))) + (produce-instruction 'inst-txa-implied) + (produce-instruction 'inst-pha-implied) - (let ((loop-label (genlabel "LOOPBACK"))) (dereference (stop-ref node)) - (format-inst t "TAX") - (format t "~%~A:~%" loop-label) - (generate-code (loopee-node node)) - (format-inst t "DEX") - (format-inst t "BNE ~A" loop-label)) + (produce-instruction 'inst-tax-implied) + (produce-label loop-label) + (compile-node (loopee-node node)) + (produce-instruction 'inst-dex-implied) + (produce-instruction 'inst-bne-zero-page loop-label) - (format-inst t "PLA") - (format-inst t "TAX")) + (produce-instruction 'inst-pla-implied) + (produce-instruction 'inst-tax-implied))) (defmethod compile-starting-at ((node node)) - (generate-code node) - (unless (null (next node)) - (compile-starting-at (next node)))) + (let ((*compile-result* '())) + (compile-node node) + (nreverse *compile-result*))) (defun make-call (callee args) (let ((arguments diff --git a/wip-duuqnd/user-side-compiler/instruction-list.txt b/wip-duuqnd/user-side-compiler/instruction-list.txt index 0ff29c85085f91d4182dd92b5495d049781cb791..d132354add457bf028ec275c660ad598f35c93d7 100644 GIT binary patch literal 4076 zcma)5zfM!Wl(MOJE@6b``g`m6LPk&>_PHc9( zx=Q=7<3BTl=QlIvj^#XfJiNcxZ--r56FQj@5)t?pJpQPg^TWsP4{1$0>)5hB{7dLm z+vDJI_xt61yebztA!Bf18I{(UKM&%E@8AO>DmmB>r?*2>?^~&#jJlW;%Pi&EoO}*~ zJGRc9>?1V$$dmmT%RVw`T3JFiV`IL_e(cFU!m}Sc*_TTQvfp3dug6_`ZU_w-A)vUq z{czIVL~?WcBW;Hp8g4%n-E~?_^xTb8y8YClM=^EC($mXBm>D>*n!sPmWaQvyQBVEGzW?J zYD>h|;aGlmIuGS-Z+?@EejE?=8-f4G6a7cSu&cMM3SSit%N%8ydsxmfmbrm;07SBo z8}kjzxrb$rvz*&3^J42{FW{T~JVyjZnixofTPR)~KOFVLF+WgsJ$K+Xa{+VBnqb`1 zLpjz%9Pgpr>LKyGaq^7OYQ>&vC0Mm$Qx>;ci80?)EAdn-#;cXs)%qU|&6m(bdq4RCXmmU5;z<55wwF`mJ>Ky=FCBmp$IY$f*FP&Gpr3U<-o{{`3AwvgCN5Z z%mxIBOy8Xt493OJ6NBk{c3vLv49K+IdSnpF^hH}n`NGJISw0z-xjSGOI$+o^VEQ4V zZbI9w2oSa(Jbk5<)|gdTRY!Z*$LOw)J-j6tZ!ykWV)3?qR$HapK2-EEgS+RAi%*E+ z6MFC&VfciG6BnP6G2h@b^57HV_>2a8e(@xckCBRP$$bTnk;}KbA&j(VvQ-0vG8R-@ zW*u(jA?prP7UTjxnTvf>zt^W$e@c!J%2}{j!{K6$9EucTzFKZo%vT)~4qxqOx1g3yW9UoK3aI*Lzm5fq9~|JyMKE{-^Vmlvf>H4s<>XB z2pa~g>NypZ&^U!M1;tXymPem#0^Hk`8u{BzHq&-zrKFnq7<#;{U}M>iJiBRz?WWW$p&G<1ebEzn(vO^Viqr>&vcf)U&KC{GUV= zX;36n-w)w^=>6K9j{a)*dxsgy7fGzKaff}9V@Yd(srSAwCWu8|_S^Y*xZs$C1%Vn> zB&F|<;cbU$186M>)JHKP?B1CBw3QY*PJR><@Ijfo_vUY3Urx=w?d;vD>3x)3GSW^Y z9cIi)?4zw>4UBO^=) zc}&<3K{lKU@|X=Wa8{5*F35;skjF!UobC6Q*UMqo9#1k0>V==dzxpKtcn?N@%w)i< zAP0$Fi@2Z38lxbO5KBz-^e}Qzutq@+paNy;br@zIVLHeo#3nanlv|Jad~JIXLjB5& z8uzA$7)>uMsL&vjm(}Cbat{A<^#zLI<*S8%m!EcT`#=2So4;CI&a!amB}RdlKhACB zasK8oVhqTa!bXl?n$x$#@o&F4G`rJBU&IoruOfBRs!E*zQaDzM-RblXnScq2sYDzr z8bK2h$pKkb_CU*H>sNnWb_aAzlz>#9ZKV3#J(iA(S#ZOm&0oJCUYf7+i}1>yf6;H$ zUm;gTX6P+h;EH$gxUzMnV01-dR>~KQt{_G!UoyIa80Az!f?-lm8!(to`I4}{u5_Hz zm6FpH$yvHmFuFn*>Pk68S9(ESZR{Xduxi)Dy8z4za>Z06VidiqtH`0vrC4q4`4#N^ zw)XrAc76(@`9alTYrY}tU8yR;M=LM|Be;l}>|+EMF*83#a1DmpH$ZUREU2EI?I=e~ zsY%RoHeyN*F>*F$N)0h`HliBpm72k{voT@)QtLQXYB5)8lCw%JVoHrLEVbAvwg2xf z#R3$)SU?l-l~miU1yoUtQm=;8xvQ)8Dgekh^@;^FAZ=y-);6cp<-6(`D6}G$RsfM! zt^r_WBCUKOE7YIt>4;n+u&>brmCgR;)iez~k|^asfXIQa0kUy2AOS$5-wppkl;HdJ&MWoFAk#>j!hEIG&+IY5k-EobBaFbxfh2Gh%y6V{i5 zj#F}wb8;X#OAazd4hTaz$U8akhez3Iy&3e~Ypr)tI;}UuthW!R(nG}bnGv>wh;^q< zoqULyC}Y-lm^NTAeM-y;8-7Y$lujehm_{x!JEu$|H*Hs~J7OlM5bN9^Z=HUhnSM_N zqz#}oI*R9n-Qul#Tw6d%TF14BIj%{}@-||G4>9sKW`qwhTHA;bK7%QHBDRF@y}IY_ z{FhHF9d7kkRL0q%mGSiK=ug1tkHoC#1&sb6M$sEF`hyrnFCby*>5sv5^hSjB^{3;M z{){;Nk({MJ0i!>Jq5h0I{ed8J+Yx!pmDglSER&Abw>)$Yn_e`;Qvw-&!8msk{;H($cT`SQxcDupq(mRU9C7RQ8#TYJo{HRd#h zG2xrtnEG34%ru2D;bAwX^{}{Q@8MSJ^OJM25}M>Sf}^rpVpgt⩔`5xi)4h6*0=S zkf~II>0BERsMNl*jw~gtvyLn!tg{LuXD6()3L|F|)>*`~vy%bNy0Y}Vo~xzPe?$Zw z2dV~cuWpeg`-bCrUE2neK?d#X=^8qXbv<1%IwvtJ_bNu`5ToUoF*=7BEeGuC@eJ(t zM1$$&m=V_3xsFphH{*0pa+c0jjLs2;IyZB4?w!8@xRqP4oi34b(bE`3Z^}haV-&rV z!qV#!I4JEXrijHICZpwdm=47)O%3)REdmo-{)8fbK3Q+z zmeFkpb-UaD>3?tGHWQ?O3X&0e>)LKAhA_=Vmj?wj)&F2>L8uBAI!5ui1Nfi(sTm9_VaKtG+F?Rbi!*WZrU uYlYEve2Q3qgNm3*CltNt294@Z&)Gkx%>KDvE6ij&vwud+Opi9kp7$?2l=(aW diff --git a/wip-duuqnd/user-side-compiler/instruction.lisp b/wip-duuqnd/user-side-compiler/instruction.lisp index 900e103..af444d9 100644 --- a/wip-duuqnd/user-side-compiler/instruction.lisp +++ b/wip-duuqnd/user-side-compiler/instruction.lisp @@ -5,18 +5,28 @@ (defclass instruction () ((%mnemonic :allocation :class :reader mnemonic :initarg :mnemonic) (%operand :accessor operand :initarg :operand) - (%next :accessor next :accessor normal-next :initarg :next))) + (%next :accessor next :accessor normal-next :initarg :next) + (%source :accessor source :initarg :source :initform nil))) + +(defmethod print-object ((object instruction) stream) + (format stream "#<~A~A>" (mnemonic object) + (if (or (typep object 'implied-mixin) + (typep object 'accumulator-mixin)) + "" + (format nil " ~S" (operand object))))) (defclass complete-mixin () ((%opcode :allocation :class :reader opcode :initarg :opcode))) (defclass immediate-mixin () ()) (defclass implied-mixin () ()) +(defclass accumulator-mixin () ()) (defclass zero-page-mixin () ()) (defmethod shared-initialize :after ((instance zero-page-mixin) slot-names &rest initargs &key &allow-other-keys) (declare (ignore slot-names initargs)) - (assert (< (operand instance) #x100))) + (when (numberp (operand instance)) + (assert (< (operand instance) #x100)))) (defclass zero-page-x-mixin (zero-page-mixin) ()) (defclass absolute-mixin () ()) @@ -25,18 +35,20 @@ (defclass indirect-x-mixin (zero-page-mixin) ()) (defclass indirect-y-mixin (zero-page-mixin) ()) -(defun addressing-mode-to-class-name (mode-keyword) - (cadr (assoc mode-keyword - '((:implied implied-mixin) - (:immediate immediate-mixin) - (:zero-page zero-page-mixin) - (:zero-page-x zero-page-x-mixin) - (:zero-page-y zero-page-y-mixin) - (:absolute absolute-mixin) - (:absolute-x absolute-x-mixin) - (:absolute-y absolute-y-mixin) - (:indirect-x indirect-x-mixin) - (:indirect-y indirect-y-mixin))))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun addressing-mode-to-class-name (mode-keyword) + (cadr (assoc mode-keyword + '((:implied implied-mixin) + (:immediate immediate-mixin) + (:accumulator accumulator-mixin) + (:zero-page zero-page-mixin) + (:zero-page-x zero-page-x-mixin) + (:zero-page-y zero-page-y-mixin) + (:absolute absolute-mixin) + (:absolute-x absolute-x-mixin) + (:absolute-y absolute-y-mixin) + (:indirect-x indirect-x-mixin) + (:indirect-y indirect-y-mixin)))))) (defclass branching-mixin () ((%branch-next :accessor branch-next :initarg :branch-next))) @@ -57,3 +69,26 @@ (when branching-p '(branching-mixin))) ((%opcode :allocation :class :initform ,code))))))) + +;;; Testing + +(define-instruction "TXA" nil (:implied 0)) +(define-instruction "PHA" nil (:implied 0)) +(define-instruction "PLA" nil (:implied 0)) +(define-instruction "TAX" nil (:implied 0)) +(define-instruction "DEX" nil (:implied 0)) +(define-instruction "BNE" t (:zero-page 0)) +(define-instruction "LDA" nil + (:absolute 0) + (:zero-page 0) + (:immediate 0) + (:absolute-y 0)) +(define-instruction "LDY" nil + (:absolute 0) + (:immediate 0)) +(define-instruction "STA" nil + (:absolute 0) + (:immediate 0) + (:absolute-y 0)) +(define-instruction "JSR" nil + (:absolute 0))