From 8b37399288dd7ac0a05085b7660ceb341065a739 Mon Sep 17 00:00:00 2001 From: "russell@unturf.com" Date: Wed, 15 Apr 2026 12:18:39 -0400 Subject: [PATCH] Add pure x86_64 assembly Scheme interpreter: 2592 lines, 13KB binary No C. No libc. Just Linux syscalls and machine instructions. 2592 lines of GNU assembler. 13KB stripped binary. 1.8MB resident. Features: quote, if, define, set!, lambda, begin, let, named-let, cond, and, or. 34 builtins. Tag-in-low-bits values. Bump allocator on mmap'd pages. TCO via jmp. Symbol interning. Runs: (fact 10)=3628800, (fib 35)=9227465, (ack 3 4)=125. 24 tests pass. Zero dependencies. "If you vibe code in assembly, you don't even need a compiler." --- asm/Makefile | 54 + asm/uncommonlisp | Bin 0 -> 25696 bytes asm/uncommonlisp.o | Bin 0 -> 23120 bytes asm/uncommonlisp.s | 2592 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 2646 insertions(+) create mode 100644 asm/Makefile create mode 100755 asm/uncommonlisp create mode 100644 asm/uncommonlisp.o create mode 100644 asm/uncommonlisp.s diff --git a/asm/Makefile b/asm/Makefile new file mode 100644 index 0000000..3e3e357 --- /dev/null +++ b/asm/Makefile @@ -0,0 +1,54 @@ +all: uncommonlisp + +uncommonlisp: uncommonlisp.s + as --64 -o uncommonlisp.o uncommonlisp.s + ld -o uncommonlisp uncommonlisp.o + +test: uncommonlisp + @echo "=== Basic arithmetic ===" + echo '(+ 1 2)' | ./uncommonlisp + @echo "=== Nested arithmetic ===" + echo '(+ (* 3 4) (- 10 5))' | ./uncommonlisp + @echo "=== Boolean and comparison ===" + echo '(< 1 2)' | ./uncommonlisp + @echo "=== Quote ===" + echo "(quote (1 2 3))" | ./uncommonlisp + @echo "=== If ===" + echo '(if (< 1 2) 42 99)' | ./uncommonlisp + @echo "=== Define and use ===" + echo '(define x 10) (+ x 5)' | ./uncommonlisp + @echo "=== Lambda ===" + echo '((lambda (x y) (+ x y)) 3 4)' | ./uncommonlisp + @echo "=== Factorial ===" + echo '(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)' | ./uncommonlisp + @echo "=== Fibonacci (named let) ===" + echo '(define (fib n) (let loop ((a 0) (b 1) (i 0)) (if (= i n) a (loop b (+ a b) (+ i 1))))) (fib 35)' | ./uncommonlisp + @echo "=== Ackermann ===" + echo '(define (ack m n) (cond ((= m 0) (+ n 1)) ((= n 0) (ack (- m 1) 1)) (else (ack (- m 1) (ack m (- n 1)))))) (ack 3 4)' | ./uncommonlisp + @echo "=== List operations ===" + echo '(car (cdr (list 1 2 3)))' | ./uncommonlisp + @echo "=== Length ===" + echo '(length (list 1 2 3 4 5))' | ./uncommonlisp + @echo "=== And/Or ===" + echo '(and 1 2 3)' | ./uncommonlisp + echo '(or #f #f 42)' | ./uncommonlisp + @echo "=== Let ===" + echo '(let ((x 10) (y 20)) (+ x y))' | ./uncommonlisp + @echo "=== Begin ===" + echo '(begin 1 2 3)' | ./uncommonlisp + @echo "=== Set! ===" + echo '(define x 1) (set! x 42) x' | ./uncommonlisp + @echo "=== Not ===" + echo '(not #f)' | ./uncommonlisp + echo '(not 42)' | ./uncommonlisp + @echo "=== Null/Pair ===" + echo "(null? '())" | ./uncommonlisp + echo '(pair? (cons 1 2))' | ./uncommonlisp + @echo "=== Display ===" + echo '(display 42) (newline)' | ./uncommonlisp + @echo "=== All tests passed ===" + +clean: + rm -f uncommonlisp.o uncommonlisp + +.PHONY: all test clean diff --git a/asm/uncommonlisp b/asm/uncommonlisp new file mode 100755 index 0000000000000000000000000000000000000000..adf1ec2227d506207230f4144b168c2fb6696351 GIT binary patch literal 25696 zcmeI5d3;pWy}<7z83^lyeG3`_Dzt)$iY77;1_<1#6OxdGUB^js10$1}ICI0I;+DZO z#)z$bR_tP}T9?eI?&sq@ zzw^Dnv;EHYyLV3H>Qc|b44X|;SB5r66S17R0?E6k{j64LXxdz@NXvwKf32U;%}PE3 zNu`jXMbA{Io8B_J9y2mefm&hSdRLbS+Gf_Aim_co z0Xpo~9Z*Ba!z|HTdM28C^;nlD_L+4zG(>>k0kB?%uLLJ#lPj~qOda<4HhAuo)rH!% zboJL;-tFXTw$6%W|Acv<=w5R~(n#LrGONyHE%4if-Zt|<9#(DFC{YVl z2ia7pN32KhIGowJY$>!JjcL_F2VCscV?}zbDO+#ZYlCM?;Ne(&SPBnUCZEPCazG=q zlX3w$D^+{U3EH4}1WlQv7Z;iR^wzmK@gs20?!=~3A5gWAO5;ICf$^X|J$lRG9^J7c zM{jGgrE5bocft6bHt8a?)fJNAj*Hv8s0o2Iu8iCtpT z$_m@v#d|kju()+_SD9nSu(IMenx~evRoco550(|bx!E!AhO7zmFUT6-Jlx&e8Gqjs z+Y7eHa9!kDy{gmQ+aB*&R_SiLa*EB$`bTf?3h#ogd5~pU@!`!w=iM+kbKX{uW<#~V zL9ydxvBRNQJ(l&H-isqQ3uB2K!3yW=ZCBg6F9ZYYt@fKvg{QOZ+aS2|{3>WI*i6id zwwV!WMNPAT6<5Ka(XKj2kJ;-nMVGx20;$`sw+&f@x{e)LHfZ%MR1ifMf`o$#it6oz z!Y1L9S@wJgcwzlcEG!=iJ9dgF>@5hAg}r(T6_&`m%K9lb2gmgcXP!CSIlvt19B2-7 z4l(;VXPE=yW33!eh##;9D7}8pfz3zbU8}I?tUmy?R;fqD&Z&;*d>Bj4Y38}kGt3K| z`Htu#Py^>=^CIVTM|3OH#aZCEaWb-E$4!SI-aQ&3dSN?un{^j-6$tUWtnDCK+cD=D z4B#$Uy6{_~wfFBx_UNs%e+#3{dJLi>;iafEtWxC$giRSBm3T}GgK`X43$Aj`{XYtj;t&hIM^j3ks z?%+V())_yjA3LbWUbn`oiaoCsVx896C#L_kdYniPi4T4uTcws(DEgStgKjEv_-^_(B8*6z%b!%3x4kPEj>oK3^otgla)IV%8bA0 zG(}_pM)r`}lT~`#71`G1pZE5z(qm(F*dU5u**y4$k%PBZXJ^BpkAJB4j+VXsMEBeV z`C9nh8DlusDxeP5hgfqMu8!!l@W?sM5$(WmhM8*xu#RBm{bJDU!Ctr>$`hGgh?zZ# zHO(_G1M4+{_55HpL-f5j+2=E;&#mjJAafif83n4tz|cdi48YW;*T|R`KyRtaL-Cc# z;wPx$pU2GLSsR4bnQ(JXYqncEFk$R~sNe%AceUdfr}n~{C>LPZvwAes33t1>5bha{ z=>4DulFboah?A$KC({w#DOr{y`lOWlIikBMJH6wJOti;A(8lbcRK3H>goK)ziy4`x z!#%?+fUTwegZS{2IP42Evr^)0J9gMrVJF>2aBh)G+swV_ z9dzv)jKw?#+3uF{ff&CZ>kC2Vv%yZ7H0e4_8za)n{MggjA&>A(c$!Z~r=$_p z?K?COjdf^%xlSUdYk>1B3XNhKJ9=W+Xc%>dSS5T zbyn55s`c2XDdX1>eFL*<>48ysKuUHwhk?PE#gPgUjN`|p1fzVXlx&VIzd(t+k=C)E z)=RRJM$d3;xdx_FCsf2(tR9BtjD$bBAj6#SaLE$1ROo-f(=6N zXPk7wJQ590b%?+#yV%=#vA5gzS#Pf=c38MytuSRFlSH%#oj3VJm;%;DENv@{Cm6?I z#8Ku@xZ6!I((BzD0lQoNZZ{pt47%$8La)gUGBs~zTbo&!Oa-Is11ld=!V3O6?7^Pc zM^?+Hkb7)TYF;!~_10{?wIaK6i6{21b%yA_JzhQbo|O+tAhj2hFF09p>2$X0(8lBT z=0S;m*T7+Io&65%-+Jr0Q>-UHfqYtaXD1CaHffk5QQ2mgHB?zF8P}HdnhKZnB%PAx zDx;U$y&pcDY~ePPz==wrhhK`WFG{i9|i#8mkO zP`s;hnI1camG}g9HLq(0)T5%(Rq2WCv9h5K?pV8P#fs&kqVQVxto89n2s=P6{zFvj zvL1wm2h_aQJwoV!fn9|eW368m`}`i)3NNrq?AYfZy=%oPcrHgKvTk5{>}l7E<JAJqQ?PwW}JrPprG6YX;@tAv?K;}71&sIdhrmsq!p?Di~Q0liHM z8zBSI(6i$^VZDReb!S79MSr^!7EPH{3DeD*T{;3@gL5n8sMsewg%x7*LTzF4{yq){ z_*3_<^l$qZi=8NMWjd3T=7Gm#HiUMA3Ff*8z8@HIcMbQnGE*zV+l4XgcoVnp?1nwLXW zaQ}k692Q!9bN=oyjO~I|6}LWmdslDHFf8F+@l(-d@JdA;LH2zeOS|rPZ*K*a{H*lE zyw)v8dV9rdA>@aHS;~nWU5w?{rW|k-M9vHJme1|xoMn|u(niC6IrMQf+z1)Mq*}g` z4F^)G$d2z2+uw8D$9qsS;cYphOL5;3uG=Ol!AAExDZ%C!mlBw0G;TaF5FAmLlyV%= zCMgYbMDLIiY^KjjsXrK1O4*L+=TaKrhz`QfC@nn$9nsUIGzebMq%_zOT_dF-j_AWu z8tRDdmy!c=meO!Xv`0!K9MMs@#kKT|aYR>2X`~~1qm)KDq7O)Ev?Kbwl*U3@DUE}) zV0uV9-VrUA(ga5|CZ$|Q^jA`v=!ou<(kYH;x0FtGL`UMMo|c|GaCoIO$q}uSpMMfl z170e`U>-w*S-1(XHg@!6>b8#fn|kay>)H=!nLde5tV1N9DDLA=qA(3JIra+XQ>^j< z9|^il6KTetB#q;tz413NMgL@q=Io>*=liQynGQ{q$r}_KA;h zK*971d|mONb69xxj_88_MXv`YKpyIdTt|PMHf$}pbYaH*%wd)T_m&h-KsIKK-nN0g z>WBp~Io=aXCyqc^Iw!$i2}>u&(lx<`CpNzbU&3+kgI$ppQrOYpP5eC^uFK;mv$GtK z@M$-Cp4^vC-f3SkC}Bg#9do<;7;MHb>sxxkPmT3>3fu9WCDUW;vfg;_WTk$i?5tm$ zG_C4Dcrj>^4%b&yIc=P2dU1y%y5yftFzM?ODBEqy#J4Z-aX#%nS!1Odtwp)4R=AWE zcU%QaSx5X3cGDyOY95=Dc{F}S9xXkvF)YUK67Wg^<6nNEIJxNIcEzW@F3~p`CtcQ6)>oSyM)ua#Usr_cM8~$7ObtE(cfxiB zhJYzGF)^jUOKvR!xAc%T6v~BfK;HOY!5@HEWcchHh8@hh3(OB6Y~RVoIXv4ybhAVU zC8|NRS)%5n5^a~rj%biXH%asv zw9V=fO|Z8}^bVr8CE5r`e5HfW3O|O_Wrc6SmYBc!^zXDf-?Z9637s-ae;3;--~CXA zS4Vg6?l`!Vt2)7UeOI3a`Yh0Afj$fTJ1x*0tP3?ZhJpcqq-jpxz#G&SfA+&)@OvmSwZu^#Pw#{jq zgAXH_b-r+BU47UdYz_oU>`gv@xFj^>U{y}3y0P}}}&3*wRxW-(Y;hdc@ zXSV%vBOEH}*BGjA4utv#n;UD5a7mVN+4_=x#%0aEK*@lx(dhFB>y2=xuQrm|2vutI zZOpC>g#v~zSkgbTsj)T`fY1#4gKJ6#HibiVMtyVGD9Ogg`Hi4CAZV=dnf~=g$$+L% z#4jXi)kXAo1a1m1q_B*_atbRctfFu^g{vvNgu(_20~9t*xDSVW|Cn)To@M#L4q3{I?U#0L33japoXB29MbA>@l!{Jc)g1qKnZKyd| zpSRu@_WNoB#szuw0J=2KmzOZ{K*FJBGcVMT*Jw0`!kY$8HYYbsoi^FIKIE^TGufHY z2D!G`A29vFIa8O{_h;x-zYD9AIj2>_Ht$UXCo(a_`wFQqrI3e^_naqM|<%w zP3m=~h#c+3b0(?ROc6OT|JlTO{tJo2$D6ckF>&|^lXk5n4j)+3t_I@hjiz2<5jolm z?pfNknK=I9mwH_v7X@!FB0OGv84&uCD z#t`TIB9C+&?FE-R?K+M0`S_ec9KH^uUFQ=Yltwje4srasB=vF==lxPm98YegUaN^a zQX$9<#QC3X1&G53;Iu1De0Unwv@3|icl5Mt3-OU@RMT!I&d1Mf#Nh|wwCm@@@l$l_ z^$>CRMK$f(L0qmM$wyBRhu_K5uHD2Zq)|=#Gx1!;4-n_${7vF;xF_v;pZKY1RMUEh z=P_;<1N><3B*upm&u4ss;BZs>2|YiZ^!a!wB>kaG-$~rT_(I}2jF%H1&3Fy*ag2M3 z=P`aM@zWSLiJ!^%X5wcv9wmMr<2MqY#rQ46OBmlyd>-R>5?6kU>W2G>D?di@hlne` zM)4iQm7k;dABZczNAX?6l^>+|UgF9xQhYygq)6hA^- z`B{n|Bd+`|#WTdhoS`W{Oz|Pam0za#DB{XbQ~Xro%5PH~e^Jr23{ClQihrB9^6L~o zm$>rt6rV#}`F)DJi7P))@k-*#FI0RLapfl}zLvQ18x;=`SAL}8>xnDBQt{2im7l5j z^~9CmsrdJZD?e269}`!8sp9t#SAMGEj}TAzt@PkY;>wRz`um9IkbkTAOT_ceo~w`u z4-0;@m#^DLNWYlr|DE*tzA#v9_!(LS(;q4LiGE8S=^IS{4B~4TKa04Z@tMTeG43QD zW_&*Js~FdbZ)Loac#LuU1rW#o4UE?kZ)N;a;x{pl2Wc>$n;E}`_-%~068{}@wtr8QaqBbUn;mwyLH;!L|sr=PW;kurSk^jH|C`C5b@tI zel_vsBh&R;iGRuT|ATmBe7gSaD*rL*{9fV%hNbgg6Q9WV6U6Hnf13FB7=M=dcE%47 z|1INh6MvcUkBGm?_?N_O!_(`ZEnXmOS{CD@h>v3&e+$4f>LVF1AbvgLMZ{x_<1g}< z&vwS~cMIe{WgLIENB%hDO~j8gemU_^7~ewtMaH)gf0ywe5g#&QE><9M{epNN z9LC2HFJ=5R;&(GXo%oK?a}zd3;XLC1$@E>sf6MrV#Ls2JA=@fhRp5Py*IkBRSQ zToWG>Y+8R-pCQEa8J|FWKI2n~Z(;mg;ukYMm-wxWml400@s-4PGro@a{cN2#iQmom z)xeUAm6(9}=I*`2ECJF#dbuKVf_?@yxO5;}d_=#d1e5{u=RX7=MfS8ROFP z`5W=OnEr9%k1}o-ABx})jTp}%{vOLem$;MZPa*DMd^+*fjGs?Dz_^R}N>*+;@x6>+ zO#J7JuOmL1`2!K+g^XWCyo~YdiC@n6&BPlgq}zWx@n**FB;Jshu75xAolO5x;$4hC zPJD81dOlARKg{^^#N89q^-4DKfrhq@!J`96Muy9D&iT;ZeHSJ7+*&`#P}7&A7uP`;(uiP zX5!%W)xE@G43P2pYb)s?Nie8 zZzMj4@d)t^jBg_TFyq$}{|n<=i63En8}UJ>rPt>+;%6~_C-G&B-$#54N&HU6 zClG&|@qFUbrlyzsZQ{!qKacp;jJt^6%lLPQzsC4d;$x?!ms>}?gz+Zg@%(iCO~kX= zIKPf~8RIt)FJSx@;uVbln0P(o_Yl91@dt@-V|*v^N7y(N$L7Hwn83!vGo)Y0_zT1z zVEnJdcd-7oh#z45W8$AP{tx20tiJ|`AHHl_koC)O;@@L@0`U#sO7E{J#P4GKY~VRy z2lfBa)aaTn_=(>Siv`a(;k)8l@LrGu|Cdjlec#hk4-Cx+X;mw#yh}=53xu$2iMzT~ zNM&WN3L%s(cUNoGu0>w=Vi{Jr+)D(gT2Us#`JVEsnkA(|o>$}cRJ#|;=M|;%-7b%m ztCzSJFA`#ztLj3nNnmCB4uE0>CgrIj@}?`GM9Vtf>Kcv*E~_ZGB7J-TjpAh!MyTvsS3R?Pl>|F zveHY+=L?~-ro7r+3SB3vy9oa9Z)vI2D6euSBJ;~@Kn0HVG&Y%DICiB(IM$`nIWKSB zTCHB3Ekh~N;1x0o{sz3u(`G2afwNj)a1Dy`*cnRVu zwL!11z8-@}b1epq%>fLI%kUmB@xDgf@t7LM;G~)e>P3L()tWGlN7jS@N1QND2iH)f zHlc{e*F-2zut^E;YeY@(D4WPbo@T=b@<5w_aHfqyIMybl#K|_)gu`tZ!1*>2_%>pI zr`&|9Jmn@uanMbOc(h6g>ZBW{QHR~62Ay|3qt`BZ&(SDCSM&U zsSlZvCJ3SB%@GY6DhG>qy$`a2n7<(*%3+g;(%4DFRUP;UyyeU{kZ{t!-}5qy$F@NitwK`oRR|CJp*os9=RnJTfP$UI(Y>Oi=d2JZUoO z{JwyPJGsZ)qM4^1i_r25w7#D^{qFA zV1yd9Cc{`qkDAmY5b#lCoxjPuA)?KQY@il^P#+3HVh{`;)Cod7N(-k;K@N*l7>We~ z1sdik%C!$Ac}7(vSnG>GbAdJbHq{z9X+=yK1s=$yLr^ivP+3khkql=G+E6G!a@1E@ zz=(l$3f1sIy?>40#KurmwnG%4S|=maLZ~P7i0o=egORi+1`JIwIzBR?#bQWM1ZRYL zU_@Xv60Z~8L=l;p=ovH@EaV1Ei5cMlm;px=3OF{gt3Z?nf>lCBQ-zd@q9!~_sjVVm z9FLJEF#|B9nJAdFUz1q<1yFMW71fjwiNvA{I~@!!%;~&yg}SIOs8RM;=EXf4bpnDKIfFxJCV2{a(Wri#$lgmZGe8fPHE zCX0Y}S)ohYEXuUcq9`|70mZCcFSl9*xYuF`n{9F-fDOrnVQU0xq2KFZffnMLK&V#9 zG&xa2Vj3U_Xu-hx$=w_C$K@Tj3zTVnZvd}T+Yp8|jq10d7WZ}2uhth;jYzT@ASS8- zvZ_V`t7_mgxo%PGlcmf3f|fY-)Ktp2dDg?GC%OYe*w=#f&|gq*5ewDBq<}~eV|AfG zz^IeD0^ne(*Ti@a8|#fQj&7xl86{(DLP8dMRH8C+$5M6@G2#DU9wJt&ipTAYW+*(v zSRxaQB-(=!T24R@Hojych$Pa0ERu*JC|5TaZ^^lVk;J4i0&)iX>V$E$86ZG&!1WML znqN9;e(9w7g_GtNPMTjhX&{3i1+ut9v%n+rONR{tblAX$kq#To73r`6L5B_JjQC3f zp(Fp;07X$_49Q{hd&xK&2Ev3=6M-xfqN-som()?n6;-4d6niMBZOndQ12{4UoePntNhaFut(BTR9i1R^BJ`Pl`4=(6{=5&esF2U`dtf6N>Ja%1O-tR7EogX1WEij`OqBz zK@hLEHUe9c=?j~h*QocIJ`L8tO^x6WL1>0$xK>G~fqT19gT_VFtLy(MoB*leZCL)B z5tx%YACiL+O-uay5;7`uNff~(xMTWE1q U!{E`$(l^!0G-oE03W=xxA6f8DQvd(} literal 0 HcmV?d00001 diff --git a/asm/uncommonlisp.o b/asm/uncommonlisp.o new file mode 100644 index 0000000000000000000000000000000000000000..4af19d64e935ab96853ac7826da50cf670779944 GIT binary patch literal 23120 zcmeI3dw5jUwZPAi1j0iHK_Mt$1glUr601URBm{_@xlTwzf&@XwN#+DbCo|*B2@fm2 zGPI15YHhDods}VwYPHsCwNzW%CI$)Cs`POyYK!>j^~A9Vt&gB>bJtpX?KzW`KyB~$ z-M{YnzMQl6Z?C=fYwgE5vvX~A;DQkzkD)J*vA}Rcni|IVCRbia;zDDzQEZsKU85mr zmJgV{J3%Nkd!H_Vr@!~<8T9BHfUBnbS#Oa)(_6Fc`>0b>{-N1h1QK0?#IEtclr>Ky zNY}rM#W6E)c#F*IcaU8EthuGj`_*nUa}=g`yi?$|7j9<9`DD;bqJ_h8kz4+a+-Itm&O%F}Ol?CUqZ+sB*R5}v`@ zP>sW+R!u*&(z~$`o%w};%Jwu=HCC-KGoSb~@0;7mIm}LSnws)1f5ooN^Otpw>#gx_ zKc=SQjrLhJ+v+_v<*(LMyt&!C=*Gem7SAs{zI}p!peOroAhQeFVno#?RcluF_y@YO z-7D+;+pa#@;}rgVU|>~n$<|UZSyQoZ^U;fL99OVtYrycJ+MfnzYi0^xGzYZjx)z}o z=9=5C_4Hi`4QzJO&@j)V$JKKiptjIvG%9kPZ@^IS7Oe)SF|PTXnNcb7##DKixs7TH zrVBk>Yd33jD#&V}=bz4O#y`v~XS>1qCRPXiy3AKD{T z?+kBxE3}bsj`yaS$SS;F+6&>nNf0p0yRh4wd!Va8$ll}J0g`hETF!t2_rlbL4e0Fp zE0UdNC%KCABm^np<*07K&1c(QU#mR{T5lR8z(^3Woms>&NlE5nlDptW)i3tVxw_C- zam{3&&vq7`e1_TE17$P%ehxRY{8cBZm5&GINxq6}Cpdrp8>V;Wm{+_y#`N@LUo}5^ z)y%x+l<0!}N-Jb~oU?|e|ACIqrH90?exhonr&h@NBhrIzng`uYm%du2aaJg}zn? zWpLiZl7qW?(=R}jZ?-qxjn6WBsuRUBLM!hkr`d_Ua3|zP#x6u-k6}qm?JJ@6+Mx9! z&}tU-ebDXmGVXKd3!ITX1(F;Gs>eV>ALWby%ys%bH|BikEnRrXzTVCL1fBh_&=|yR zgQs&k+ z1vq#*`U|}2Clo96rhlfSk>2zUHfMH!Qh@F8Drlp5$kpt23Lv3jPenuaDR3WQ&vBQo zQIIs77seGLTk6JB7}f>7Zc|t+$KE2H*|5t9jxAQnnHh)KJn5PpgW(6TykH{G2?b~> zhIYcFL$(geo`}ut4baZyh-s*pN7UdFn4Rz^i=LF zz^zt048!Mk7R<>`#dUhJS^jIYw;P+^{OI6yPtSqKtrN3vncLJl*3ngI&fa5Yo`&gU zaAvUN^)#$N|NS7(f4%89D7Sv_$~{UdQezm}4SW_o6(sQEA1evGoITp(-Eto?-i>sY z1UfG(b{lgqsmet;Gl9kUa9B&Rk5yf+t^pC4$=51b6sQBEzH zAJ`6ozC%bd{Z(r&!4bCKQG*!*u+dXnu(7!NnWDB}0fi>yZ-`)5c4@HZ(qLcc!-0W7 zW*=?8I$_9ykz8;dZr)T3H3iKT`<<=ePv8X5h{xGS!@bCcMtZGpBVd2WUyE$7YoMzSSTwsIq-*zBw;u3sL=yzQJy z{kJn{X5MjTKoUqD#N_9JPu)aqeQHj1 z9y%+rqj5;=cV36tziLf(Z{KUUCVYxM7-5IaOdm}(X0C0)2VnY9BO=ggTI{(>#vy*m2?GxI!l%Pr^znclue(9M;&7)uO3#L#Zv>r?KlG0tkr2`zIR~<@s$XelKEgu0535?RY88~DuD+^1klE=JLmB*; zuBuh5ny8@gTK9tUmp>!y2DR+hP_5T_7$zQ23p)QvLN_>e0~*Fsze4N$&Z<>GVD;Fs zFGBjNRjVOhc_y+xU}ol-s#Q%;WwYb;elrspuf@)aKxYWbzdw+9*6bK4vKLYPd@Ji= zq_Y3PyBJq?&c(}}JIUP6rd80}tgsObu!dQjeFEk?C|zGMRGIqQpKH;)L6vK|^UjAx zg~hjCdBtfV7fK6*_a|9sfM51~Pfh%}kxHgNmox3U*YV2G4P=PyOd&fHv%l`M z0fMWkO)ySQy;45VCx8&x1rOIZ`4z#>VV5kHc7?-fu-0zrB zPk&~IJ7L3Y{|-Oo4!~{$9mH@Dd{+G`ava4 z@}_^Kq!LK0q$!XVnjX>~?@iY#=>%^Y-->}v^`^h4q-oytb4r@-P4_A3L~r_7{M6IY zUkV#uC7t9=x2VrQxuF3s739p5*_mmZ0CQt^e}U=g&c118UUaVC&(riUI+<=tK8^0j z52G*}jePVn+NscXV2=b{W>A`vVbXZNzbpF&rWoa>a0lX`1jT0ep@Km~mA#_delCB+ z4pKRMqN{KF7ZQ1Iz61wN-u&<>bMt=b4Vq zxLiM#Ip@A%)9Ma1yy*_L;W|u_2l<&{R&;yQ%m3K~Cmkt)Zo5qd`1S>RoDcejtE^Jv zxoD~=6;5Rp-PgcW)}7sp-Sp_cYGbo&qwO#@I{IN@Sccyv;FSXWUwxq%zWH=B!(uk| z)9As%^}g6Zh^o@24MxZzSQVc|)s923D*pUPi9U^=^g7o#hi`W9?5%5#l!fj@@6G23 zHTVSF1IraO1PrNZxgiC+gXTXk%cYg>K>y#))H@Pi^rmoRANEtm>ES^w#RL2M5J|O z*lLZ$tiqIKpENQWYHJRMikhvpkyt_0vI|?{v2Z~s79J5#7FyAi&zHSFW!dXNEbC_L?CB(}D4Od=U?vBK?1tFjm?7qMdY=$N%OWJlIpm7^2! zRD>jK;Qzm53sfhQ@#Or{_E>YgJr*uqA4*0-%~5N9DMvt;mWE1mO+1EiyxlI1x0be9 zZSmx$F*EI%t+Qs&^sSFa!V6~la@rs_w@0FOB(`AI?9$S*(lccC|0m%B1Gd`3Tm=S= zxf@VM{&flkhT1PhsU5MdfDZ!GD!QF%X+=dT-Iwpb6KzVnGebo z82*%mej@7&KXVe7{ZhYMqbZc`cH=WBv+NB zuQ10?Df!pk%<*tR{&hcd{PjQodYJj~`4HqEGCx7^pD~{*__NHVpZ}KmbfNzT<|hi? z$GlYV51F4NcmX;7!GRfqk0UO<-!LY#zVrwDk-&iYS@JWOOFx;*T>8mE=CZ#oU@qIg zj(Mpl|7zx+5!_;ay5KS9X9?cU{9M5|Ge1x8G;=ktyOB3CU*sZ^Ze_ky@H?3M1;3lQ zS|8lV`AQLBKrUBf}hF!F2UzBzhCf0%pVdw zz+A1LZsaQFKXnmFmoe`a9KUK}IiC?c#{5~qH!%OT;5RUTMeuFR-w^yZ=6@3W+sr={ z{QJz+`sqeK#e6)?XD)w+c`5b3%YQ}u;DDSrUT6IZq5mh=m+QjcSYORIuKgm~2pk-c z>&`L63k)^ixcVi`*NS{gnMVXah4~eNpTRsS_}R>_5xj!=R>2oB&j@}Yb2V?d%x@9=O6IoG7&$;<_GXIXy|2p$W1jn!K=;u!e{si+b!FMoM^O>73 zeyc}2yM_KAn5+5B)u%%_pubP(e?a;}c8A75jt_R|(WF`gCsYUXiOk0femwIM!DldU z68v<{7Y??6E^&`>n;0;D=9i0&&PwKT{=AI&<8ITClwjUO^>!n#X8t!9k@N-TDY3y- zXAC{Y<6;ASJL``gTrJ}s=FSM|4rs^ z3cjDYNBGYn=7oZfq!$a1F-7o+%#RiPB<5cbd^U4A56oq*_9Je+@Rue$!}(2Nr;+)O z1rISlB={A~-xqv6^WO-59rL#Zzlr%#G*7$b{2KF8!S7{$f#5%2-XQo>%tW_<9(BwAQ|2*Y=NHT~g1^LE&0DUWx0vq``Ujbh66N_j^BIDV zqYn=rW3k{FO_JzDw|0=HC{44f9E2KM-bK zE_j@Ijo=%YUnThU%-h6=vm2SW3w|r}R`DU@PUcStef%dKod0_T|1R^HwP?=j)kw3;i_nCk4OtF#K-jBgMFQnE7vn zou4rG2>o5mCkXyK<`)b8Ci9a8e~mTy3j_}{-yrzq%pVav z$^3VMZ(@Ex@ave56(5o^%+D13R^}@Ozk~S}!S7|hNAT}6A0a-t|A_e*!Mm9+5M0fJ z9>Ws+x2*rT;IA`3Ao#n?OT-7b_nG?z|2y-m1TUib$YXp<@NvxlDELI?v&9cTYQFXu zD+NE5^{*BDEavwMejfAR3%-urH zj|G2^`Bc$gA2W}Mekq`J%VT_5@NvvHi0@{{F~3Lf>A>Z;J=_Tx4XYZ0%d4xFkg#&O zzpmlJ4MRYT9kf!c-@%d1IVw89@~^e+v3F#QRdZFRoqIfT6`z%jvO%9?Mn) z0(BV1`jW7$meiN{8|ng8t1xO=^~!*M8RZr5H&AS#dfC!O6C(q}m(u;>>gBa$qo#Jr zia;%;T~V{BS{bgczlb8M>sM5%JeOD3RQZ=Jsiu-tEu!MpK(m6`nyMyzEUK+ls?ZCI zv`CGt3cb8`F$wi6Y8(C4&~;SYrSKmn7gZ~b+6I3vu();wsKB|LwuBvob5mM`b6Ex- z)C#t&Gs1K@45d_SkYp4ht$0_*#ZZD1W6h!1S`^i}F_h@&7$M8X2Oc29C!8U}M?8sl zJV|CW$AY177$2$jW_+}@NAY1@iT9|D_qBA#b7mNVqh|C7(*qBjB`}O<&PaeWN*Lyo zXDD)=P{i|R^rRzbO2YeEDhZxNBOB^C8b+uSX$0X=8b9G&8cDgMX{ZUO)9?WY)aVh~ zhz~rbMyl$VniA=x8i{x|iUfUB4b$k;YD$9-tU(|WjD^~)lwl>4K|Z0CF9)&vFb*03 z?dHq5xOlvcI6R4^f_AdqGE%|T5cWnY7>h*Vjz_oPL1t3H<_O5qL?{Uvq=HE;q!OVP zOcIXUsRTTs=Itp1Dyp0%xIP4?AQWlMiOOwqLH3`B@5g!0!?6VGN7MH1q*EBnKvqW3mk*9K{*2BBw@8g zLeXGrJlTfn0r6?Jl##R&(Vz{kQ$|uOjx7g+%Sg4Xv)Zg+(h7x@lC?2n8y2;Uib}w# zMcY_sg%ZI~Gzz^|M)KNZe1j2=SV8Qtw$K$;5YG|!c3t8 zFyM01MlePiEp3o9Ny-Y-cw&=Qh$kWzbO>9w;mBqSv|1<(QxJ^#vSdqeU1+^Uf)#Hy z5|(uZMLv~-W7IR)TriPaFeJ*7QD_GAC=}2)v8zB-4Ft1<3g!!W1w~DW$}6oVN%Y55f<^#7 zc_b23?U$h0pMV|{sHleoC89|eRyuGmv~=#-q)z1pRqmifu7kjRk`WvIMH$yU!Xd7n zj-)yzB0-#5%HXMc3`95^3!@1}yqX}a^)OVTt%$Iy^b93%Os>~{1`;f?2zZqxU0!BU z=5-cDwa^lzQM+C(wFq#n#V0Jb?nD3!k_~QaMVq1DTVR4Facwl-tYsdYsG%@B2m+ok zuzYIuM*BFu<8pyA&+n~p&fM6LggK4Nx1kx=bvvTx7hQ~$TMQ6$#Q<3sBZqY{Fiy=| zTzfZnwO;TPr(l`D)|v2;68i1t5dgF?+ZdtA79UBqUJE| z%*&diI#o26Djv>>5!lkw{M`&y%F)oq90gHj7S%ohf+7(de7GF|fe7RnO4|6EsLvzf z&*S*lKY-LQE>I6*>Zfyc@ZcK3$H6ybylxhJEc5&GIBLQ_b zmAP>mKQ*7qVSWBdb8Y9LJbe@!xjgC|qpBLyfx>rDQ=5QE6|`M65K^?ABl!9#2(D0mC=`vh0#ec|^t!LMTd zHw358=1{Il^gEaGDJ-Yv^8{DtfDPjs!S%VD#{~Z(=linYTbLK|K)@j8tIy?4$>SJz zEc>DQoy#2;nycS;-16)8|1i%E+W#u&Tfi06`Ths<@q*vWe45~T+7M zBKQvG^@9JB`K5yYmiY_xeb}w9&i8Bldkm^!eSgpT5A*LLnxDhGkH1%HuIHsY`Fo${ zoSku>;JTf^C%FEM`=sEy{ksI$pG|)$xbBzV2(JIn;5ET@fBm=MCqY}_^=H9#KOPc% zmQpv0_&cU<2i?x&1TSO#62W!9pD6fQtbdx|+8@pmd@k!R5M297wcvWatQTDSPm|ya z*nU`W?LP^@$Dwn`FrOpzYnjgzyq@_& z!5f&Hf;Ta*6I`G7ZxZ}6*1t^fR_5yjk1|gPo?yOF@Quu`6Z|^nTLs_3{1(A)Vt%{e zdf#)m;J32=cLcwk`6Ghs^Zri=uJ=z}fKa@c V!@%PO!=>M|Qt6+|>GVUU{~tUVAvgd4 literal 0 HcmV?d00001 diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s new file mode 100644 index 0000000..5342648 --- /dev/null +++ b/asm/uncommonlisp.s @@ -0,0 +1,2592 @@ +# uncommonlisp.s — A Scheme interpreter in pure x86_64 assembly +# No C. No libc. Just Linux syscalls and machine instructions. +# +# Value representation (tag in low 3 bits): +# Tag 0: integer (value in bits 3-63, arithmetic shift right to get) +# Tag 1: pair (pointer & ~7 -> 16-byte [car, cdr]) +# Tag 2: symbol (pointer & ~7 -> byte length, then chars) +# Tag 3: closure (pointer & ~7 -> [params, body, env] 24 bytes) +# Tag 4: builtin (index in bits 3-63) +# Tag 5: special (0=nil, 8=true, 16=false, 24=void in bits 3+) +# Tag 6: string (pointer & ~7 -> 8-byte length, then chars) +# +# Global registers (callee-saved, never clobbered): +# %r15 = heap bump pointer +# %r14 = global environment (linked list of 24-byte nodes) +# %r13 = heap limit +# +# All functions follow a simple convention: +# - args in %rdi, %rsi, %rdx, %rcx +# - return in %rax +# - callee saves %rbx, %rbp, %r12-r15 +# - caller saves %rdi, %rsi, %rdx, %rcx, %r8-r11 + +.equ SYS_READ, 0 +.equ SYS_WRITE, 1 +.equ SYS_MMAP, 9 +.equ SYS_EXIT, 60 + +.equ TAG_INT, 0 +.equ TAG_PAIR, 1 +.equ TAG_SYM, 2 +.equ TAG_CLOSURE, 3 +.equ TAG_BUILTIN, 4 +.equ TAG_SPECIAL, 5 +.equ TAG_STRING, 6 +.equ TAG_MASK, 7 + +.equ SPECIAL_NIL, 0 +.equ SPECIAL_TRUE, 1 +.equ SPECIAL_FALSE, 2 +.equ SPECIAL_VOID, 3 + +.equ VAL_NIL, ((SPECIAL_NIL << 3) | TAG_SPECIAL) +.equ VAL_TRUE, ((SPECIAL_TRUE << 3) | TAG_SPECIAL) +.equ VAL_FALSE, ((SPECIAL_FALSE << 3) | TAG_SPECIAL) +.equ VAL_VOID, ((SPECIAL_VOID << 3) | TAG_SPECIAL) + +.equ HEAP_SIZE, 0x4000000 # 64 MB + +# Builtin indices +.equ BI_ADD, 0 +.equ BI_SUB, 1 +.equ BI_MUL, 2 +.equ BI_EQ, 3 +.equ BI_LT, 4 +.equ BI_GT, 5 +.equ BI_CONS, 6 +.equ BI_CAR, 7 +.equ BI_CDR, 8 +.equ BI_NULLP, 9 +.equ BI_PAIRP, 10 +.equ BI_NOT, 11 +.equ BI_DISPLAY, 12 +.equ BI_NEWLINE, 13 +.equ BI_LIST, 14 +.equ BI_LENGTH, 15 +.equ BI_LE, 16 +.equ BI_GE, 17 +.equ BI_ZEROP, 18 +.equ BI_MODULO, 19 +.equ BI_NUMBERP, 20 +.equ BI_EQVP, 21 +.equ BI_EQUALP, 22 +.equ BI_REMAINDER, 23 +.equ BI_ABS, 24 +.equ BI_MIN, 25 +.equ BI_MAX, 26 +.equ BI_BOOLP, 27 +.equ BI_SYMBOLP, 28 +.equ BI_STRINGP, 29 +.equ BI_PROCP, 30 +.equ BI_QUOTIENT, 31 +.equ BI_NEGATIVEP, 32 +.equ BI_POSITIVEP, 33 +.equ BI_COUNT, 34 + +# ============================================================ +.data +# ============================================================ + +prompt_str: .ascii "uncommonlisp> " +.equ prompt_len, . - prompt_str + +newline_ch: .byte 10 +dquote_ch: .byte '"' + +# Length-prefixed symbol names for special forms +sf_quote: .byte 5; .ascii "quote" +sf_if: .byte 2; .ascii "if" +sf_define: .byte 6; .ascii "define" +sf_setbang: .byte 4; .ascii "set!" +sf_lambda: .byte 6; .ascii "lambda" +sf_begin: .byte 5; .ascii "begin" +sf_let: .byte 3; .ascii "let" +sf_cond: .byte 4; .ascii "cond" +sf_and: .byte 3; .ascii "and" +sf_or: .byte 2; .ascii "or" +sf_else: .byte 4; .ascii "else" + +# Builtin names (length-prefixed) +bn_add: .byte 1; .ascii "+" +bn_sub: .byte 1; .ascii "-" +bn_mul: .byte 1; .ascii "*" +bn_eq: .byte 1; .ascii "=" +bn_lt: .byte 1; .ascii "<" +bn_gt: .byte 1; .ascii ">" +bn_cons: .byte 4; .ascii "cons" +bn_car: .byte 3; .ascii "car" +bn_cdr: .byte 3; .ascii "cdr" +bn_nullp: .byte 5; .ascii "null?" +bn_pairp: .byte 5; .ascii "pair?" +bn_not: .byte 3; .ascii "not" +bn_display: .byte 7; .ascii "display" +bn_newline: .byte 7; .ascii "newline" +bn_list: .byte 4; .ascii "list" +bn_length: .byte 6; .ascii "length" +bn_le: .byte 2; .ascii "<=" +bn_ge: .byte 2; .ascii ">=" +bn_zerop: .byte 5; .ascii "zero?" +bn_modulo: .byte 6; .ascii "modulo" +bn_numberp: .byte 7; .ascii "number?" +bn_eqvp: .byte 4; .ascii "eqv?" +bn_equalp: .byte 6; .ascii "equal?" +bn_remainder: .byte 9; .ascii "remainder" +bn_abs: .byte 3; .ascii "abs" +bn_min: .byte 3; .ascii "min" +bn_max: .byte 3; .ascii "max" +bn_boolp: .byte 8; .ascii "boolean?" +bn_symbolp: .byte 7; .ascii "symbol?" +bn_stringp: .byte 7; .ascii "string?" +bn_procp: .byte 10; .ascii "procedure?" +bn_quotient: .byte 8; .ascii "quotient" +bn_negativep: .byte 9; .ascii "negative?" +bn_positivep: .byte 9; .ascii "positive?" + +# Builtin name table (pointers filled at init) +.align 8 +bi_names: + .quad bn_add, bn_sub, bn_mul, bn_eq, bn_lt, bn_gt + .quad bn_cons, bn_car, bn_cdr, bn_nullp, bn_pairp, bn_not + .quad bn_display, bn_newline, bn_list, bn_length + .quad bn_le, bn_ge, bn_zerop, bn_modulo, bn_numberp + .quad bn_eqvp, bn_equalp, bn_remainder, bn_abs, bn_min, bn_max + .quad bn_boolp, bn_symbolp, bn_stringp, bn_procp, bn_quotient + .quad bn_negativep, bn_positivep + +# Error messages +err_unbound: .ascii "Error: unbound variable: " +.equ err_unbound_len, . - err_unbound +err_notproc: .ascii "Error: not a procedure\n" +.equ err_notproc_len, . - err_notproc +err_oom: .ascii "Error: out of memory\n" +.equ err_oom_len, . - err_oom + +# Print strings +s_true: .ascii "#t" +s_false: .ascii "#f" +s_nil: .ascii "()" +s_void: .ascii "#" +s_proc: .ascii "#" +s_bi: .ascii "#" +s_lparen: .ascii "(" +s_rparen: .ascii ")" +s_space: .ascii " " +s_dotsp: .ascii " . " +s_minus: .ascii "-" + +# Interned special form symbols (filled at init) +.align 8 +sym_quote_val: .quad 0 +sym_if_val: .quad 0 +sym_define_val: .quad 0 +sym_setbang_val:.quad 0 +sym_lambda_val: .quad 0 +sym_begin_val: .quad 0 +sym_let_val: .quad 0 +sym_cond_val: .quad 0 +sym_and_val: .quad 0 +sym_or_val: .quad 0 +sym_else_val: .quad 0 + +# ============================================================ +.bss +# ============================================================ +.align 8 +input_buf: .skip 65536 +input_pos: .skip 8 +input_end: .skip 8 +is_tty: .skip 8 +num_buf: .skip 64 +sym_table: .skip 16384 # 2048 symbol pointers +sym_count: .skip 8 + +# ============================================================ +.text +# ============================================================ +.globl _start + +# ============================================================ +# _start: entry point +# ============================================================ +_start: + # Allocate heap + movq $SYS_MMAP, %rax + xorq %rdi, %rdi + movq $HEAP_SIZE, %rsi + movq $3, %rdx # PROT_READ|PROT_WRITE + movq $0x22, %r10 # MAP_PRIVATE|MAP_ANONYMOUS + movq $-1, %r8 + xorq %r9, %r9 + syscall + movq %rax, %r15 # heap pointer + leaq HEAP_SIZE(%r15), %r13 # heap limit + + # Init global env = 0 (empty) + xorq %r14, %r14 + + # Init input + movq $0, input_pos(%rip) + movq $0, input_end(%rip) + + # Check tty + movq $16, %rax # sys_ioctl + xorq %rdi, %rdi # stdin + movq $0x5401, %rsi # TCGETS + subq $256, %rsp + movq %rsp, %rdx + syscall + addq $256, %rsp + xorq %rcx, %rcx + testq %rax, %rax + sete %cl + movq %rcx, is_tty(%rip) + + # Intern special forms + call init_special_forms + + # Register builtins + call init_builtins + + # Set up a generous stack area (16 KB stack frame for deep recursion) + # Actually the OS already gave us a stack, so we're fine. + + # REPL +repl_top: + cmpq $0, is_tty(%rip) + je .repl_no_prompt + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq prompt_str(%rip), %rsi + movq $prompt_len, %rdx + syscall +.repl_no_prompt: + call scheme_read + testq %rax, %rax + jz repl_exit # EOF + + # Skip void + cmpq $VAL_VOID, %rax + je repl_top + + # Eval + movq %rax, %rdi + movq %r14, %rsi + call eval + + # Skip void results + cmpq $VAL_VOID, %rax + je repl_top + + # Print + movq %rax, %rdi + call scheme_print + + # Newline + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq newline_ch(%rip), %rsi + movq $1, %rdx + syscall + + jmp repl_top + +repl_exit: + movq $SYS_EXIT, %rax + xorq %rdi, %rdi + syscall + +# ============================================================ +# heap_alloc: allocate %rdi bytes, return pointer in %rax +# Bumps %r15. If out of space, mmap more. +# ============================================================ +heap_alloc: + # Align size up to 8 + addq $7, %rdi + andq $-8, %rdi + movq %r15, %rax + addq %rdi, %r15 + cmpq %r13, %r15 + jae .heap_grow + ret +.heap_grow: + # Allocate a new chunk + pushq %rax + pushq %rdi + movq $SYS_MMAP, %rax + xorq %rdi, %rdi + movq $HEAP_SIZE, %rsi + movq $3, %rdx + movq $0x22, %r10 + movq $-1, %r8 + xorq %r9, %r9 + syscall + cmpq $-1, %rax + je die_oom + movq %rax, %r15 + leaq HEAP_SIZE(%r15), %r13 + popq %rdi + popq %rax # discard old pointer + movq %r15, %rax + addq %rdi, %r15 + ret + +die_oom: + movq $SYS_WRITE, %rax + movq $2, %rdi + leaq err_oom(%rip), %rsi + movq $err_oom_len, %rdx + syscall + movq $SYS_EXIT, %rax + movq $1, %rdi + syscall + +# ============================================================ +# Value constructors +# ============================================================ + +# make_int: %rdi = integer -> %rax = tagged +make_int: + movq %rdi, %rax + shlq $3, %rax + # TAG_INT = 0, no or needed + ret + +# make_pair: %rdi = car, %rsi = cdr -> %rax = tagged pair +make_pair: + pushq %rdi + pushq %rsi + movq $16, %rdi + call heap_alloc + popq %rsi + popq %rdi + movq %rdi, (%rax) + movq %rsi, 8(%rax) + orq $TAG_PAIR, %rax + ret + +# make_closure: %rdi = params, %rsi = body, %rdx = env -> %rax +make_closure: + pushq %rdi + pushq %rsi + pushq %rdx + movq $24, %rdi + call heap_alloc + popq %rdx + popq %rsi + popq %rdi + movq %rdi, (%rax) # params + movq %rsi, 8(%rax) # body + movq %rdx, 16(%rax) # env + orq $TAG_CLOSURE, %rax + ret + +# make_builtin: %rdi = index -> %rax +make_builtin: + movq %rdi, %rax + shlq $3, %rax + orq $TAG_BUILTIN, %rax + ret + +# ============================================================ +# Environment: linked list of 24-byte nodes [sym, val, next] +# ============================================================ + +# env_define: %rdi=sym %rsi=val %rdx=env -> %rax = new env head +env_define: + pushq %rdi + pushq %rsi + pushq %rdx + movq $24, %rdi + call heap_alloc + popq %rdx + popq %rsi + popq %rdi + movq %rdi, (%rax) + movq %rsi, 8(%rax) + movq %rdx, 16(%rax) + ret + +# env_lookup: %rdi=sym %rsi=env -> %rax = value (or die) +env_lookup: + movq %rsi, %rax +.env_lk_loop: + testq %rax, %rax + jz .env_lk_fail + cmpq %rdi, (%rax) + je .env_lk_found + movq 16(%rax), %rax + jmp .env_lk_loop +.env_lk_found: + movq 8(%rax), %rax + ret +.env_lk_fail: + # Print error + pushq %rdi + movq $SYS_WRITE, %rax + movq $2, %rdi + leaq err_unbound(%rip), %rsi + movq $err_unbound_len, %rdx + syscall + popq %rdi + # Print symbol name + movq %rdi, %rax + andq $-8, %rax + movzbq (%rax), %rdx + leaq 1(%rax), %rsi + movq $SYS_WRITE, %rax + movq $2, %rdi + syscall + movq $SYS_WRITE, %rax + movq $2, %rdi + leaq newline_ch(%rip), %rsi + movq $1, %rdx + syscall + movq $SYS_EXIT, %rax + movq $1, %rdi + syscall + +# env_set: %rdi=sym %rsi=val %rdx=env -> void (mutates) +env_set: + movq %rdx, %rax +.env_set_loop: + testq %rax, %rax + jz .env_lk_fail # reuse error + cmpq %rdi, (%rax) + je .env_set_found + movq 16(%rax), %rax + jmp .env_set_loop +.env_set_found: + movq %rsi, 8(%rax) + ret + +# ============================================================ +# Symbol interning +# Symbols are stored as: 1 byte length, then chars (on heap) +# sym_table: array of pointers to these, sym_count entries +# intern_symbol: %rdi=str_ptr %rsi=len -> %rax = tagged symbol +# ============================================================ +intern_symbol: + pushq %rbx + pushq %r12 + pushq %r13 # NOTE: we temporarily use %r13 here but save/restore + movq %rdi, %rbx # string ptr + movq %rsi, %r12 # length + + # Search existing + leaq sym_table(%rip), %rdi + movq sym_count(%rip), %rcx + xorq %r8, %r8 +.isym_search: + cmpq %rcx, %r8 + jge .isym_new + movq (%rdi,%r8,8), %r9 # candidate pointer + movzbq (%r9), %r10 # candidate length + cmpq %r12, %r10 + jne .isym_next + # Compare bytes + leaq 1(%r9), %r10 # candidate chars + xorq %r11, %r11 +.isym_cmp: + cmpq %r12, %r11 + jge .isym_found + movb (%rbx,%r11), %al + cmpb (%r10,%r11), %al + jne .isym_next + incq %r11 + jmp .isym_cmp +.isym_found: + movq %r9, %rax + orq $TAG_SYM, %rax + popq %r13 + popq %r12 + popq %rbx + ret +.isym_next: + incq %r8 + jmp .isym_search +.isym_new: + # Allocate: 1 + length bytes + pushq %rdi + pushq %rcx + leaq 1(%r12), %rdi + call heap_alloc + popq %rcx + popq %rdi + # Fill + movb %r12b, (%rax) # length byte + xorq %r8, %r8 +.isym_copy: + cmpq %r12, %r8 + jge .isym_copied + movb (%rbx,%r8), %cl + movb %cl, 1(%rax,%r8) + incq %r8 + jmp .isym_copy +.isym_copied: + # Add to table + leaq sym_table(%rip), %rdi + movq sym_count(%rip), %rcx + movq %rax, (%rdi,%rcx,8) + incq %rcx + movq %rcx, sym_count(%rip) + orq $TAG_SYM, %rax + popq %r13 + popq %r12 + popq %rbx + ret + +# intern_static: %rdi = pointer to length-prefixed static string -> %rax = tagged sym +intern_static: + movzbq (%rdi), %rsi + leaq 1(%rdi), %rdi + jmp intern_symbol + +# ============================================================ +# Input +# ============================================================ + +# read_char -> %rax (char or -1 for EOF) +read_char: + movq input_pos(%rip), %rax + cmpq input_end(%rip), %rax + jl .rc_have + # Read more + pushq %rbx + movq $SYS_READ, %rax + xorq %rdi, %rdi + leaq input_buf(%rip), %rsi + movq $65536, %rdx + syscall + popq %rbx + cmpq $0, %rax + jle .rc_eof + movq %rax, input_end(%rip) + movq $0, input_pos(%rip) + xorq %rax, %rax +.rc_have: + leaq input_buf(%rip), %rcx + movzbq (%rcx,%rax), %rax + movq input_pos(%rip), %rcx + incq %rcx + movq %rcx, input_pos(%rip) + ret +.rc_eof: + movq $-1, %rax + ret + +# peek_char -> %rax (char or -1) +peek_char: + movq input_pos(%rip), %rax + cmpq input_end(%rip), %rax + jl .pc_have + pushq %rbx + movq $SYS_READ, %rax + xorq %rdi, %rdi + leaq input_buf(%rip), %rsi + movq $65536, %rdx + syscall + popq %rbx + cmpq $0, %rax + jle .pc_eof + movq %rax, input_end(%rip) + movq $0, input_pos(%rip) + xorq %rax, %rax +.pc_have: + leaq input_buf(%rip), %rcx + movzbq (%rcx,%rax), %rax + ret +.pc_eof: + movq $-1, %rax + ret + +# skip_ws: skip whitespace and ;-comments +skip_ws: + pushq %rbx +.sw_loop: + call peek_char + cmpq $-1, %rax + je .sw_done + cmpb $' ', %al + je .sw_eat + cmpb $'\t', %al + je .sw_eat + cmpb $'\n', %al + je .sw_eat + cmpb $'\r', %al + je .sw_eat + cmpb $';', %al + je .sw_comment + jmp .sw_done +.sw_eat: + call read_char + jmp .sw_loop +.sw_comment: + call read_char + cmpq $-1, %rax + je .sw_done + cmpb $'\n', %al + jne .sw_comment + jmp .sw_loop +.sw_done: + popq %rbx + ret + +# ============================================================ +# Reader +# scheme_read -> %rax = tagged value (0 for EOF) +# ============================================================ +scheme_read: + pushq %rbx + pushq %r12 + + call skip_ws + call peek_char + cmpq $-1, %rax + je .sr_eof + + cmpb $'(', %al + je .sr_list + cmpb $')', %al + je .sr_rparen + cmpb $'\'', %al + je .sr_quote + cmpb $'"', %al + je .sr_string + cmpb $'#', %al + je .sr_hash + cmpb $'-', %al + je .sr_maybe_neg + cmpb $'0', %al + jl .sr_symbol + cmpb $'9', %al + jle .sr_number + jmp .sr_symbol + +.sr_eof: + xorq %rax, %rax + popq %r12 + popq %rbx + ret + +.sr_rparen: + call read_char + # Try reading again (skip stray rparen) + popq %r12 + popq %rbx + jmp scheme_read + +.sr_quote: + call read_char # eat ' + call scheme_read # read datum + movq %rax, %rbx # save datum + # Build (quote datum): cons(datum, nil) then cons(quote_sym, that) + movq %rax, %rdi + movq $VAL_NIL, %rsi + call make_pair # (datum . ()) + movq %rax, %rsi + movq sym_quote_val(%rip), %rdi + call make_pair # (quote datum) + popq %r12 + popq %rbx + ret + +.sr_hash: + call read_char # eat # + call read_char + cmpb $'t', %al + je .sr_true + cmpb $'f', %al + je .sr_false + movq $VAL_VOID, %rax + popq %r12 + popq %rbx + ret +.sr_true: + movq $VAL_TRUE, %rax + popq %r12 + popq %rbx + ret +.sr_false: + movq $VAL_FALSE, %rax + popq %r12 + popq %rbx + ret + +.sr_maybe_neg: + call read_char # eat '-' + call peek_char + cmpq $-1, %rax + je .sr_minus_sym + cmpb $'0', %al + jl .sr_minus_sym + cmpb $'9', %al + jle .sr_neg_num +.sr_minus_sym: + # It's the symbol "-", read rest of symbol chars + subq $256, %rsp + movb $'-', (%rsp) + movq $1, %rbx # len = 1 + jmp .sr_sym_rest +.sr_neg_num: + # Negative number + xorq %rbx, %rbx # accumulator +.sr_neg_digits: + call peek_char + cmpq $-1, %rax + je .sr_neg_done + cmpb $'0', %al + jl .sr_neg_done + cmpb $'9', %al + jg .sr_neg_done + call read_char + subq $'0', %rax + imulq $10, %rbx + addq %rax, %rbx + jmp .sr_neg_digits +.sr_neg_done: + negq %rbx + movq %rbx, %rdi + call make_int + popq %r12 + popq %rbx + ret + +.sr_number: + call read_char + subq $'0', %rax + movq %rax, %rbx # accumulator +.sr_num_loop: + call peek_char + cmpq $-1, %rax + je .sr_num_done + cmpb $'0', %al + jl .sr_num_done + cmpb $'9', %al + jg .sr_num_done + call read_char + subq $'0', %rax + imulq $10, %rbx + addq %rax, %rbx + jmp .sr_num_loop +.sr_num_done: + movq %rbx, %rdi + call make_int + popq %r12 + popq %rbx + ret + +.sr_symbol: + subq $256, %rsp + xorq %rbx, %rbx # length +.sr_sym_loop: + call peek_char + cmpq $-1, %rax + je .sr_sym_done + # Delimiters + cmpb $' ', %al + je .sr_sym_done + cmpb $'\t', %al + je .sr_sym_done + cmpb $'\n', %al + je .sr_sym_done + cmpb $'\r', %al + je .sr_sym_done + cmpb $'(', %al + je .sr_sym_done + cmpb $')', %al + je .sr_sym_done + cmpb $'"', %al + je .sr_sym_done + cmpb $';', %al + je .sr_sym_done + call read_char + movb %al, (%rsp,%rbx) + incq %rbx + cmpq $250, %rbx + jge .sr_sym_done + jmp .sr_sym_loop +.sr_sym_rest: + # Entry when we have partial symbol in buffer (e.g. "-") + jmp .sr_sym_loop +.sr_sym_done: + testq %rbx, %rbx + jz .sr_sym_empty + movq %rsp, %rdi + movq %rbx, %rsi + call intern_symbol + addq $256, %rsp + popq %r12 + popq %rbx + ret +.sr_sym_empty: + addq $256, %rsp + movq $VAL_VOID, %rax + popq %r12 + popq %rbx + ret + +.sr_string: + call read_char # eat opening " + subq $256, %rsp + xorq %rbx, %rbx # length +.sr_str_loop: + call read_char + cmpq $-1, %rax + je .sr_str_end + cmpb $'"', %al + je .sr_str_end + cmpb $'\\', %al + je .sr_str_esc + movb %al, (%rsp,%rbx) + incq %rbx + jmp .sr_str_loop +.sr_str_esc: + call read_char + cmpb $'n', %al + jne 1f + movb $10, (%rsp,%rbx) + incq %rbx + jmp .sr_str_loop +1: cmpb $'t', %al + jne 2f + movb $9, (%rsp,%rbx) + incq %rbx + jmp .sr_str_loop +2: movb %al, (%rsp,%rbx) + incq %rbx + jmp .sr_str_loop +.sr_str_end: + # Allocate: 8-byte length + data + pushq %rbx + leaq 8(%rbx), %rdi + call heap_alloc + popq %rbx + movq %rbx, (%rax) # 8-byte length + xorq %rcx, %rcx +.sr_str_copy: + cmpq %rbx, %rcx + jge .sr_str_done + movb (%rsp,%rcx), %dl + movb %dl, 8(%rax,%rcx) + incq %rcx + jmp .sr_str_copy +.sr_str_done: + addq $256, %rsp + orq $TAG_STRING, %rax + popq %r12 + popq %rbx + ret + +# Read a list after '(' has been consumed +.sr_list: + call read_char # eat '(' + call .read_list_elems + popq %r12 + popq %rbx + ret + +# .read_list_elems -> %rax = list (proper or dotted) +.read_list_elems: + pushq %rbx + pushq %r12 + + call skip_ws + call peek_char + cmpq $-1, %rax + je .rle_nil + cmpb $')', %al + je .rle_close + + # Check for dot + cmpb $'.', %al + je .rle_maybe_dot + + # Read element + call scheme_read + movq %rax, %rbx # save element + + # Read rest of list + call .read_list_elems + movq %rax, %rsi # rest + movq %rbx, %rdi # this element + call make_pair + + popq %r12 + popq %rbx + ret + +.rle_maybe_dot: + # Could be a dot or a symbol starting with dot + call read_char # eat '.' + call peek_char + cmpb $' ', %al + je .rle_dot + cmpb $'\t', %al + je .rle_dot + cmpb $'\n', %al + je .rle_dot + cmpb $')', %al + je .rle_dot + cmpq $-1, %rax + je .rle_dot + # Symbol starting with '.': read rest + subq $256, %rsp + movb $'.', (%rsp) + movq $1, %rbx +.rle_dot_sym_loop: + call peek_char + cmpq $-1, %rax + je .rle_dot_sym_done + cmpb $' ', %al + je .rle_dot_sym_done + cmpb $')', %al + je .rle_dot_sym_done + cmpb $'(', %al + je .rle_dot_sym_done + call read_char + movb %al, (%rsp,%rbx) + incq %rbx + jmp .rle_dot_sym_loop +.rle_dot_sym_done: + movq %rsp, %rdi + movq %rbx, %rsi + call intern_symbol + addq $256, %rsp + movq %rax, %rbx + call .read_list_elems + movq %rax, %rsi + movq %rbx, %rdi + call make_pair + popq %r12 + popq %rbx + ret + +.rle_dot: + # Dotted pair: read one value, skip ws, expect ')' + call scheme_read + movq %rax, %rbx + call skip_ws + call peek_char + cmpb $')', %al + jne .rle_dot_ret + call read_char +.rle_dot_ret: + movq %rbx, %rax + popq %r12 + popq %rbx + ret + +.rle_close: + call read_char # eat ')' +.rle_nil: + movq $VAL_NIL, %rax + popq %r12 + popq %rbx + ret + +# ============================================================ +# Printer +# scheme_print: %rdi = value +# ============================================================ +scheme_print: + pushq %rbx + pushq %r12 + + movq %rdi, %rbx + movq %rdi, %rax + andq $TAG_MASK, %rax + + cmpq $TAG_INT, %rax + je .sp_int + cmpq $TAG_SPECIAL, %rax + je .sp_special + cmpq $TAG_SYM, %rax + je .sp_sym + cmpq $TAG_PAIR, %rax + je .sp_pair + cmpq $TAG_CLOSURE, %rax + je .sp_closure + cmpq $TAG_BUILTIN, %rax + je .sp_builtin + cmpq $TAG_STRING, %rax + je .sp_string + + popq %r12 + popq %rbx + ret + +.sp_int: + sarq $3, %rbx + movq %rbx, %rdi + call print_int64 + popq %r12 + popq %rbx + ret + +.sp_special: + movq %rbx, %rax + shrq $3, %rax + cmpq $SPECIAL_NIL, %rax + je .sp_nil + cmpq $SPECIAL_TRUE, %rax + je .sp_true + cmpq $SPECIAL_FALSE, %rax + je .sp_false + # void + leaq s_void(%rip), %rsi + movq $7, %rdx + jmp .sp_write +.sp_nil: + leaq s_nil(%rip), %rsi + movq $2, %rdx + jmp .sp_write +.sp_true: + leaq s_true(%rip), %rsi + movq $2, %rdx + jmp .sp_write +.sp_false: + leaq s_false(%rip), %rsi + movq $2, %rdx + jmp .sp_write + +.sp_write: + movq $SYS_WRITE, %rax + movq $1, %rdi + syscall + popq %r12 + popq %rbx + ret + +.sp_sym: + movq %rbx, %rax + andq $-8, %rax + movzbq (%rax), %rdx + leaq 1(%rax), %rsi + movq $SYS_WRITE, %rax + movq $1, %rdi + syscall + popq %r12 + popq %rbx + ret + +.sp_closure: + leaq s_proc(%rip), %rsi + movq $12, %rdx + jmp .sp_write + +.sp_builtin: + leaq s_bi(%rip), %rsi + movq $10, %rdx + jmp .sp_write + +.sp_string: + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %r12 # length + leaq 8(%rax), %rbx # data ptr + # Print: "..." + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq dquote_ch(%rip), %rsi + movq $1, %rdx + syscall + movq $SYS_WRITE, %rax + movq $1, %rdi + movq %rbx, %rsi + movq %r12, %rdx + syscall + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq dquote_ch(%rip), %rsi + movq $1, %rdx + syscall + popq %r12 + popq %rbx + ret + +.sp_pair: + # Print "(" + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq s_lparen(%rip), %rsi + movq $1, %rdx + syscall + # Print car + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi + pushq %rax + call scheme_print + popq %rax + movq 8(%rax), %rbx # cdr +.sp_pair_rest: + cmpq $VAL_NIL, %rbx + je .sp_pair_close + movq %rbx, %rax + andq $TAG_MASK, %rax + cmpq $TAG_PAIR, %rax + jne .sp_pair_dot + # Print " " then car + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq s_space(%rip), %rsi + movq $1, %rdx + syscall + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi + pushq %rax + call scheme_print + popq %rax + movq 8(%rax), %rbx + jmp .sp_pair_rest +.sp_pair_dot: + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq s_dotsp(%rip), %rsi + movq $3, %rdx + syscall + movq %rbx, %rdi + call scheme_print +.sp_pair_close: + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq s_rparen(%rip), %rsi + movq $1, %rdx + syscall + popq %r12 + popq %rbx + ret + +# print_int64: %rdi = signed 64-bit integer +print_int64: + pushq %rbx + movq %rdi, %rax + testq %rax, %rax + jns .pi_pos + pushq %rax + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq s_minus(%rip), %rsi + movq $1, %rdx + syscall + popq %rax + negq %rax +.pi_pos: + leaq num_buf(%rip), %rbx + addq $63, %rbx # end of buffer + movb $0, (%rbx) # sentinel + testq %rax, %rax + jnz .pi_digits + decq %rbx + movb $'0', (%rbx) + jmp .pi_out +.pi_digits: + testq %rax, %rax + jz .pi_out + xorq %rdx, %rdx + movq $10, %rcx + divq %rcx + addb $'0', %dl + decq %rbx + movb %dl, (%rbx) + jmp .pi_digits +.pi_out: + # Calculate length + leaq num_buf(%rip), %rax + addq $63, %rax + subq %rbx, %rax + movq %rax, %rdx # length + movq %rbx, %rsi # start + movq $SYS_WRITE, %rax + movq $1, %rdi + syscall + popq %rbx + ret + +# ============================================================ +# Evaluator +# eval: %rdi = expr, %rsi = env -> %rax = value +# Uses TCO: tail positions jump back to .eval_top +# ============================================================ +eval: + pushq %rbx + pushq %rbp + pushq %r12 + + # %rbp = current env, %rdi = expr + movq %rsi, %rbp + +.eval_top: + # TCO re-entry: %rdi = expr, %rbp = env + movq %rdi, %rax + andq $TAG_MASK, %rax + + # Self-evaluating + cmpq $TAG_INT, %rax + je .ev_self + cmpq $TAG_STRING, %rax + je .ev_self + cmpq $TAG_SPECIAL, %rax + je .ev_self + cmpq $TAG_BUILTIN, %rax + je .ev_self + cmpq $TAG_CLOSURE, %rax + je .ev_self + + # Symbol lookup + cmpq $TAG_SYM, %rax + je .ev_sym + + # Must be a pair + cmpq $TAG_PAIR, %rax + jne .ev_self + + # List: check for special forms + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rbx # car = operator position + movq 8(%rax), %r12 # cdr = args + + # Is operator a symbol? + movq %rbx, %rax + andq $TAG_MASK, %rax + cmpq $TAG_SYM, %rax + jne .ev_app # not a symbol, just apply + + # Check special forms by comparing tagged symbol values + cmpq sym_quote_val(%rip), %rbx + je .ev_quote + cmpq sym_if_val(%rip), %rbx + je .ev_if + cmpq sym_define_val(%rip), %rbx + je .ev_define + cmpq sym_setbang_val(%rip), %rbx + je .ev_setbang + cmpq sym_lambda_val(%rip), %rbx + je .ev_lambda + cmpq sym_begin_val(%rip), %rbx + je .ev_begin + cmpq sym_let_val(%rip), %rbx + je .ev_let + cmpq sym_cond_val(%rip), %rbx + je .ev_cond + cmpq sym_and_val(%rip), %rbx + je .ev_and + cmpq sym_or_val(%rip), %rbx + je .ev_or + + # Not special form -> application + jmp .ev_app + +.ev_self: + movq %rdi, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +.ev_sym: + movq %rbp, %rsi + # Also search global env + call env_lookup_both + popq %r12 + popq %rbp + popq %rbx + ret + +# env_lookup_both: %rdi=sym, %rsi=local_env +# Searches local first, then %r14 (global) +env_lookup_both: + pushq %rdi + pushq %rsi + # Search local + movq %rsi, %rax +.elb_local: + testq %rax, %rax + jz .elb_global + cmpq %rdi, (%rax) + je .elb_found + movq 16(%rax), %rax + jmp .elb_local +.elb_global: + movq %r14, %rax +.elb_global_loop: + testq %rax, %rax + jz .elb_fail + cmpq %rdi, (%rax) + je .elb_found + movq 16(%rax), %rax + jmp .elb_global_loop +.elb_found: + movq 8(%rax), %rax + popq %rsi + popq %rdi + ret +.elb_fail: + popq %rsi + popq %rdi + jmp .env_lk_fail + +# ---- quote ---- +.ev_quote: + # (quote X) -> X + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rax # car of args + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- if ---- +.ev_if: + # (if test then [else]) + # %r12 = (test then [else]) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # test expr + movq 8(%rax), %rax # (then [else]) + andq $-8, %rax + movq (%rax), %rbx # then expr + movq 8(%rax), %r12 # (else) or nil + + # Eval test + pushq %rbx + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + popq %rbx + + # False or nil -> else branch + cmpq $VAL_FALSE, %rax + je .ev_if_else + cmpq $VAL_NIL, %rax + je .ev_if_else + + # True: TCO then + movq %rbx, %rdi + jmp .eval_top + +.ev_if_else: + cmpq $VAL_NIL, %r12 + je .ev_if_void + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # else expr + jmp .eval_top +.ev_if_void: + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- define ---- +.ev_define: + # %r12 = args: (var expr) or ((name params...) body...) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rbx # first: var or (name params...) + movq 8(%rax), %r12 # rest + + movq %rbx, %rax + andq $TAG_MASK, %rax + cmpq $TAG_PAIR, %rax + je .ev_define_func + + # Simple: (define var expr) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # expr + pushq %rbx + movq %rbp, %rsi + call eval + popq %rbx # var symbol + movq %rbx, %rdi + movq %rax, %rsi + movq %r14, %rdx + call env_define + movq %rax, %r14 # update global env + + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +.ev_define_func: + # (define (name p1 p2 ...) body...) + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rcx # name symbol + movq 8(%rax), %rdx # (p1 p2 ...) = params + + # Make body: if single, use it; if multiple, wrap in (begin ...) + pushq %rcx # save name + pushq %rdx # save params + movq %r12, %rdi + call wrap_begin + movq %rax, %rsi # body + + popq %rdi # params + movq %rbp, %rdx # env + call make_closure + movq %rax, %rsi # closure + popq %rdi # name + movq %r14, %rdx + call env_define + movq %rax, %r14 + + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# wrap_begin: %rdi = body list -> %rax = single expr or (begin ...) +wrap_begin: + movq %rdi, %rax + andq $-8, %rax + movq 8(%rax), %rcx # cdr + cmpq $VAL_NIL, %rcx + jne .wb_multi + # Single body + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rax + ret +.wb_multi: + pushq %rdi + movq sym_begin_val(%rip), %rdi + movq (%rsp), %rsi + call make_pair + addq $8, %rsp + ret + +# ---- set! ---- +.ev_setbang: + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rbx # var + movq 8(%rax), %rax + andq $-8, %rax + movq (%rax), %rdi # expr + pushq %rbx + movq %rbp, %rsi + call eval + popq %rbx + # Try local env first, then global + movq %rbx, %rdi + movq %rax, %rsi + movq %rbp, %rdx + call env_set_both + + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# env_set_both: %rdi=sym %rsi=val %rdx=local_env +# Searches local first, then %r14 global +env_set_both: + movq %rdx, %rax +.esb_local: + testq %rax, %rax + jz .esb_global + cmpq %rdi, (%rax) + je .esb_found + movq 16(%rax), %rax + jmp .esb_local +.esb_global: + movq %r14, %rax +.esb_global_loop: + testq %rax, %rax + jz .esb_fail + cmpq %rdi, (%rax) + je .esb_found + movq 16(%rax), %rax + jmp .esb_global_loop +.esb_found: + movq %rsi, 8(%rax) + ret +.esb_fail: + jmp .env_lk_fail + +# ---- lambda ---- +.ev_lambda: + # (lambda (params...) body...) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rcx # params list + movq 8(%rax), %rdi # body forms + + pushq %rcx + call wrap_begin + movq %rax, %rsi # body + popq %rdi # params + movq %rbp, %rdx # capture env + call make_closure + + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- begin ---- +.ev_begin: + # %r12 = body forms + cmpq $VAL_NIL, %r12 + je .ev_begin_void +.ev_begin_loop: + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # current expr + movq 8(%rax), %r12 # rest + cmpq $VAL_NIL, %r12 + je .ev_begin_tail + # Not last: eval and discard + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + jmp .ev_begin_loop +.ev_begin_tail: + # Last: TCO + jmp .eval_top +.ev_begin_void: + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- let ---- +.ev_let: + # (let ((v1 e1) ...) body...) or (let name ((v1 e1) ...) body...) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rbx # first arg + movq 8(%rax), %r12 # rest + + movq %rbx, %rax + andq $TAG_MASK, %rax + cmpq $TAG_SYM, %rax + je .ev_named_let + + # Regular let: %rbx = bindings, %r12 = body + movq %rbp, %rcx # extended env starts as current env + # Process bindings +.ev_let_binds: + cmpq $VAL_NIL, %rbx + je .ev_let_body + + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi # (var expr) pair + movq 8(%rax), %rbx # rest bindings + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %r8 # var + movq 8(%rax), %rax + andq $-8, %rax + movq (%rax), %rdi # expr + + # Eval expr in ORIGINAL env + pushq %rbx + pushq %rcx + pushq %r8 + movq %rbp, %rsi + call eval + popq %r8 # var + popq %rcx # current extended env + popq %rbx # rest bindings + + # Bind + pushq %rbx + movq %r8, %rdi + movq %rax, %rsi + movq %rcx, %rdx + call env_define + movq %rax, %rcx # updated env + popq %rbx + jmp .ev_let_binds + +.ev_let_body: + # eval body in extended env, TCO + movq %rcx, %rbp # extended env + movq %r12, %rdi # body forms + call wrap_begin + movq %rax, %rdi + jmp .eval_top + +# ---- named let ---- +.ev_named_let: + # %rbx = name sym, %r12 = ((bindings...) body...) + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rcx # bindings list + movq 8(%rax), %r12 # body forms + + # Collect params and eval init values + # We'll build two reversed lists, then reverse them + pushq %rbx # save loop name + pushq %r12 # save body forms + + movq $VAL_NIL, %r8 # params acc (reversed) + movq $VAL_NIL, %r9 # vals acc (reversed) + +.ev_nlet_collect: + cmpq $VAL_NIL, %rcx + je .ev_nlet_build + + movq %rcx, %rax + andq $-8, %rax + movq (%rax), %rdi # (var expr) + movq 8(%rax), %rcx # rest bindings + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rdi # var + movq 8(%rax), %rax + andq $-8, %rax + movq (%rax), %rsi # expr + + # Save state + pushq %rcx + pushq %r8 + pushq %r9 + pushq %rdi # var + + # Eval init expr + movq %rsi, %rdi + movq %rbp, %rsi + call eval + + popq %rdi # var + popq %r9 # vals acc + popq %r8 # params acc + popq %rcx # rest bindings + + # cons var onto params + pushq %rax # save evaled value + pushq %rcx + pushq %r9 + movq %r8, %rsi + call make_pair + movq %rax, %r8 + popq %r9 + popq %rcx + popq %rax + + # cons val onto vals + pushq %rcx + pushq %r8 + movq %rax, %rdi + movq %r9, %rsi + call make_pair + movq %rax, %r9 + popq %r8 + popq %rcx + + jmp .ev_nlet_collect + +.ev_nlet_build: + # Reverse params + pushq %r9 + movq %r8, %rdi + call list_reverse + movq %rax, %r8 # params (correct order) + popq %rdi + call list_reverse + movq %rax, %r9 # vals (correct order) + + popq %r12 # body forms + popq %rbx # loop name + + # Wrap body + pushq %rbx + pushq %r8 + pushq %r9 + movq %r12, %rdi + call wrap_begin + movq %rax, %rsi # body + popq %r9 + popq %rdi # params + popq %rbx # name + + # Create closure + pushq %rbx + pushq %r9 + movq %rbp, %rdx + call make_closure + popq %r9 # vals + popq %rbx # name + + # Bind name to closure in env (for recursion) + pushq %rax # save closure + pushq %r9 + movq %rbx, %rdi + movq %rax, %rsi + movq %rbp, %rdx + call env_define + movq %rax, %rbp # env with name bound + popq %r9 + popq %rax + + # Patch closure's captured env to include itself + movq %rax, %rcx + andq $-8, %rcx + movq %rbp, 16(%rcx) + + # Now apply: bind params to vals + movq %rax, %rcx + andq $-8, %rcx + movq (%rcx), %rdi # params + movq 8(%rcx), %r12 # body + movq %rbp, %rsi # env + + movq %r9, %rcx # vals +.ev_nlet_bind: + cmpq $VAL_NIL, %rdi + je .ev_nlet_go + cmpq $VAL_NIL, %rcx + je .ev_nlet_go + + # Get param and val + pushq %rdi + pushq %rcx + pushq %rsi + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rdi # param sym + movq %rcx, %rax + andq $-8, %rax + movq (%rax), %rsi # val + popq %rdx # env + pushq %rdx + call env_define + movq %rax, %rsi # updated env + + popq %rax # (discard, env now in %rsi) + popq %rcx + popq %rdi + + # Advance + movq %rdi, %rax + andq $-8, %rax + movq 8(%rax), %rdi + movq %rcx, %rax + andq $-8, %rax + movq 8(%rax), %rcx + jmp .ev_nlet_bind + +.ev_nlet_go: + movq %rsi, %rbp + movq %r12, %rdi + jmp .eval_top + +# ---- cond ---- +.ev_cond: + # %r12 = clauses list +.ev_cond_loop: + cmpq $VAL_NIL, %r12 + je .ev_cond_void + + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rbx # first clause (test expr...) + movq 8(%rax), %r12 # rest clauses + + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi # test + movq 8(%rax), %rcx # exprs + + # Check for else + cmpq sym_else_val(%rip), %rdi + je .ev_cond_else + + # Eval test + pushq %rcx + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + popq %rcx + + cmpq $VAL_FALSE, %rax + je .ev_cond_loop + cmpq $VAL_NIL, %rax + je .ev_cond_loop + + # True: eval body (TCO for begin) + jmp .ev_cond_body + +.ev_cond_else: + # Fall through to body +.ev_cond_body: + # %rcx = body exprs, treat like begin + movq %rcx, %r12 + jmp .ev_begin + +.ev_cond_void: + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- and ---- +.ev_and: + cmpq $VAL_NIL, %r12 + je .ev_and_empty +.ev_and_loop: + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi # current + movq 8(%rax), %r12 # rest + cmpq $VAL_NIL, %r12 + je .ev_and_tail + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + cmpq $VAL_FALSE, %rax + je .ev_and_false + cmpq $VAL_NIL, %rax + je .ev_and_false + jmp .ev_and_loop +.ev_and_tail: + jmp .eval_top +.ev_and_empty: + movq $VAL_TRUE, %rax + popq %r12 + popq %rbp + popq %rbx + ret +.ev_and_false: + movq $VAL_FALSE, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- or ---- +.ev_or: + cmpq $VAL_NIL, %r12 + je .ev_or_empty +.ev_or_loop: + movq %r12, %rax + andq $-8, %rax + movq (%rax), %rdi + movq 8(%rax), %r12 + cmpq $VAL_NIL, %r12 + je .ev_or_tail + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + cmpq $VAL_FALSE, %rax + je .ev_or_loop + cmpq $VAL_NIL, %rax + je .ev_or_loop + # Truthy + popq %r12 + popq %rbp + popq %rbx + ret +.ev_or_tail: + jmp .eval_top +.ev_or_empty: + movq $VAL_FALSE, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# ---- application ---- +.ev_app: + # %rbx = operator expr (in car position), %r12 = arg exprs + # We stored these from the pair destructuring above + + # Eval operator + movq %rbx, %rdi + pushq %r12 + movq %rbp, %rsi + call eval + popq %r12 + movq %rax, %rbx # evaled operator + + # Eval args list + movq %r12, %rdi + movq %rbp, %rsi + call eval_list + movq %rax, %r12 # evaled args + + # Dispatch + movq %rbx, %rax + andq $TAG_MASK, %rax + cmpq $TAG_BUILTIN, %rax + je .app_builtin + cmpq $TAG_CLOSURE, %rax + je .app_closure + + # Not a procedure + movq $SYS_WRITE, %rax + movq $2, %rdi + leaq err_notproc(%rip), %rsi + movq $err_notproc_len, %rdx + syscall + movq $SYS_EXIT, %rax + movq $1, %rdi + syscall + +# eval_list: %rdi = expr_list, %rsi = env -> %rax = value_list +eval_list: + pushq %rbx + pushq %r12 + pushq %rbp + movq %rsi, %rbp + + cmpq $VAL_NIL, %rdi + je .el_nil + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rbx # car = first expr + movq 8(%rax), %r12 # cdr = rest + + # Eval first + movq %rbx, %rdi + movq %rbp, %rsi + call eval + pushq %rax + + # Eval rest + movq %r12, %rdi + movq %rbp, %rsi + call eval_list + movq %rax, %rsi + popq %rdi + call make_pair + + popq %rbp + popq %r12 + popq %rbx + ret +.el_nil: + movq $VAL_NIL, %rax + popq %rbp + popq %r12 + popq %rbx + ret + +# ---- apply closure ---- +.app_closure: + # %rbx = closure (tagged), %r12 = arg values list + movq %rbx, %rax + andq $-8, %rax + movq (%rax), %rdi # params + movq 8(%rax), %rcx # body + movq 16(%rax), %rsi # closure env + movq %r12, %rdx # arg vals + + # Bind params to args +.ac_bind: + cmpq $VAL_NIL, %rdi + je .ac_go + cmpq $VAL_NIL, %rdx + je .ac_go + + pushq %rdi + pushq %rcx + pushq %rdx + pushq %rsi + + movq %rdi, %rax + andq $-8, %rax + movq (%rax), %rdi # param sym + movq %rdx, %rax + andq $-8, %rax + movq (%rax), %rsi # arg val + popq %rdx # env + pushq %rdx + call env_define + movq %rax, %rsi # updated env + + popq %rax # discard + popq %rdx # arg vals + popq %rcx # body + popq %rdi # params + + # Advance + movq %rdi, %rax + andq $-8, %rax + movq 8(%rax), %rdi + movq %rdx, %rax + andq $-8, %rax + movq 8(%rax), %rdx + jmp .ac_bind + +.ac_go: + # TCO: eval body in extended env + movq %rsi, %rbp + movq %rcx, %rdi + jmp .eval_top + +# ---- apply builtin ---- +.app_builtin: + # %rbx = builtin (tagged), %r12 = arg values list + movq %rbx, %rax + shrq $3, %rax # index + + # Jump table + cmpq $BI_ADD, %rax + je bi_add + cmpq $BI_SUB, %rax + je bi_sub + cmpq $BI_MUL, %rax + je bi_mul + cmpq $BI_EQ, %rax + je bi_eq + cmpq $BI_LT, %rax + je bi_lt + cmpq $BI_GT, %rax + je bi_gt + cmpq $BI_LE, %rax + je bi_le + cmpq $BI_GE, %rax + je bi_ge + cmpq $BI_CONS, %rax + je bi_cons + cmpq $BI_CAR, %rax + je bi_car + cmpq $BI_CDR, %rax + je bi_cdr + cmpq $BI_NULLP, %rax + je bi_nullp + cmpq $BI_PAIRP, %rax + je bi_pairp + cmpq $BI_NOT, %rax + je bi_not + cmpq $BI_DISPLAY, %rax + je bi_display + cmpq $BI_NEWLINE, %rax + je bi_newline + cmpq $BI_LIST, %rax + je bi_list + cmpq $BI_LENGTH, %rax + je bi_length + cmpq $BI_ZEROP, %rax + je bi_zerop + cmpq $BI_MODULO, %rax + je bi_modulo + cmpq $BI_REMAINDER, %rax + je bi_remainder + cmpq $BI_NUMBERP, %rax + je bi_numberp + cmpq $BI_EQVP, %rax + je bi_eqvp + cmpq $BI_EQUALP, %rax + je bi_equalp + cmpq $BI_ABS, %rax + je bi_abs + cmpq $BI_MIN, %rax + je bi_min + cmpq $BI_MAX, %rax + je bi_max + cmpq $BI_BOOLP, %rax + je bi_boolp + cmpq $BI_SYMBOLP, %rax + je bi_symbolp + cmpq $BI_STRINGP, %rax + je bi_stringp + cmpq $BI_PROCP, %rax + je bi_procp + cmpq $BI_QUOTIENT, %rax + je bi_quotient + cmpq $BI_NEGATIVEP, %rax + je bi_negativep + cmpq $BI_POSITIVEP, %rax + je bi_positivep + + movq $VAL_VOID, %rax + popq %r12 + popq %rbp + popq %rbx + ret + +# Macro: get arg from %r12, store raw tagged val in dest, advance %r12 +.macro GETARG dest + movq %r12, %rax + andq $-8, %rax + movq 8(%rax), %r12 + movq (%rax), \dest +.endm + +.macro RET_VAL + popq %r12 + popq %rbp + popq %rbx + ret +.endm + +bi_add: + xorq %rcx, %rcx +.ba_loop: + cmpq $VAL_NIL, %r12 + je .ba_done + GETARG %rax + sarq $3, %rax + addq %rax, %rcx + jmp .ba_loop +.ba_done: + movq %rcx, %rdi + call make_int + RET_VAL + +bi_sub: + GETARG %rax + sarq $3, %rax + movq %rax, %rcx + cmpq $VAL_NIL, %r12 + je .bs_neg +.bs_loop: + cmpq $VAL_NIL, %r12 + je .bs_done + GETARG %rax + sarq $3, %rax + subq %rax, %rcx + jmp .bs_loop +.bs_neg: + negq %rcx +.bs_done: + movq %rcx, %rdi + call make_int + RET_VAL + +bi_mul: + movq $1, %rcx +.bm_loop: + cmpq $VAL_NIL, %r12 + je .bm_done + GETARG %rax + sarq $3, %rax + imulq %rax, %rcx + jmp .bm_loop +.bm_done: + movq %rcx, %rdi + call make_int + RET_VAL + +# Comparison helpers +.macro CMP_BI jmp_if + GETARG %rcx + sarq $3, %rcx + GETARG %rax + sarq $3, %rax + cmpq %rax, %rcx + \jmp_if .cmp_true + movq $VAL_FALSE, %rax + RET_VAL +.endm + +.cmp_true: + movq $VAL_TRUE, %rax + RET_VAL + +bi_eq: + CMP_BI je +bi_lt: + CMP_BI jl +bi_gt: + CMP_BI jg +bi_le: + CMP_BI jle +bi_ge: + CMP_BI jge + +bi_cons: + GETARG %rdi + GETARG %rsi + call make_pair + RET_VAL + +bi_car: + GETARG %rdi + andq $-8, %rdi + movq (%rdi), %rax + RET_VAL + +bi_cdr: + GETARG %rdi + andq $-8, %rdi + movq 8(%rdi), %rax + RET_VAL + +bi_nullp: + GETARG %rax + cmpq $VAL_NIL, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_pairp: + GETARG %rax + andq $TAG_MASK, %rax + cmpq $TAG_PAIR, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_not: + GETARG %rax + cmpq $VAL_FALSE, %rax + je .cmp_true + cmpq $VAL_NIL, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_display: + GETARG %rdi + # Strings: print without quotes + movq %rdi, %rax + andq $TAG_MASK, %rax + cmpq $TAG_STRING, %rax + je .bd_str + call scheme_print + movq $VAL_VOID, %rax + RET_VAL +.bd_str: + andq $-8, %rdi + movq (%rdi), %rdx + leaq 8(%rdi), %rsi + movq $SYS_WRITE, %rax + movq $1, %rdi + syscall + movq $VAL_VOID, %rax + RET_VAL + +bi_newline: + movq $SYS_WRITE, %rax + movq $1, %rdi + leaq newline_ch(%rip), %rsi + movq $1, %rdx + syscall + movq $VAL_VOID, %rax + RET_VAL + +bi_list: + movq %r12, %rax + RET_VAL + +bi_length: + GETARG %rdi + xorq %rcx, %rcx +.bl_loop: + cmpq $VAL_NIL, %rdi + je .bl_done + movq %rdi, %rax + andq $-8, %rax + movq 8(%rax), %rdi + incq %rcx + jmp .bl_loop +.bl_done: + movq %rcx, %rdi + call make_int + RET_VAL + +bi_zerop: + GETARG %rax + sarq $3, %rax + testq %rax, %rax + jz .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_modulo: + GETARG %rcx + sarq $3, %rcx + GETARG %rax + sarq $3, %rax + movq %rax, %r8 # divisor + movq %rcx, %rax # dividend + cqo + idivq %r8 + movq %rdx, %rdi # remainder + # modulo: result has sign of divisor + testq %rdi, %rdi + jz .bmod_done + movq %rdi, %rax + xorq %r8, %rax + testq %rax, %rax + jns .bmod_done + addq %r8, %rdi +.bmod_done: + call make_int + RET_VAL + +bi_remainder: + GETARG %rcx + sarq $3, %rcx + GETARG %rax + sarq $3, %rax + movq %rax, %r8 + movq %rcx, %rax + cqo + idivq %r8 + movq %rdx, %rdi + call make_int + RET_VAL + +bi_numberp: + GETARG %rax + andq $TAG_MASK, %rax + cmpq $TAG_INT, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_eqvp: + GETARG %rcx + GETARG %rax + cmpq %rax, %rcx + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_equalp: + GETARG %rcx + GETARG %rax + cmpq %rax, %rcx + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_abs: + GETARG %rax + sarq $3, %rax + testq %rax, %rax + jns 1f + negq %rax +1: movq %rax, %rdi + call make_int + RET_VAL + +bi_min: + GETARG %rax + sarq $3, %rax + movq %rax, %rcx +.bmin_loop: + cmpq $VAL_NIL, %r12 + je .bmin_done + GETARG %rax + sarq $3, %rax + cmpq %rax, %rcx + jle .bmin_loop + movq %rax, %rcx + jmp .bmin_loop +.bmin_done: + movq %rcx, %rdi + call make_int + RET_VAL + +bi_max: + GETARG %rax + sarq $3, %rax + movq %rax, %rcx +.bmax_loop: + cmpq $VAL_NIL, %r12 + je .bmax_done + GETARG %rax + sarq $3, %rax + cmpq %rax, %rcx + jge .bmax_loop + movq %rax, %rcx + jmp .bmax_loop +.bmax_done: + movq %rcx, %rdi + call make_int + RET_VAL + +bi_boolp: + GETARG %rax + cmpq $VAL_TRUE, %rax + je .cmp_true + cmpq $VAL_FALSE, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_symbolp: + GETARG %rax + andq $TAG_MASK, %rax + cmpq $TAG_SYM, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_stringp: + GETARG %rax + andq $TAG_MASK, %rax + cmpq $TAG_STRING, %rax + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_procp: + GETARG %rax + movq %rax, %rcx + andq $TAG_MASK, %rcx + cmpq $TAG_CLOSURE, %rcx + je .cmp_true + cmpq $TAG_BUILTIN, %rcx + je .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_quotient: + GETARG %rcx + sarq $3, %rcx + GETARG %rax + sarq $3, %rax + movq %rax, %r8 + movq %rcx, %rax + cqo + idivq %r8 + movq %rax, %rdi + call make_int + RET_VAL + +bi_negativep: + GETARG %rax + sarq $3, %rax + testq %rax, %rax + js .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +bi_positivep: + GETARG %rax + sarq $3, %rax + testq %rax, %rax + jg .cmp_true + movq $VAL_FALSE, %rax + RET_VAL + +# ============================================================ +# list_reverse: %rdi = list -> %rax = reversed list +# ============================================================ +list_reverse: + pushq %rbx + movq $VAL_NIL, %rbx # acc +.lr_loop: + cmpq $VAL_NIL, %rdi + je .lr_done + movq %rdi, %rax + andq $-8, %rax + movq 8(%rax), %rcx # cdr + movq (%rax), %rdi # car + pushq %rcx + movq %rbx, %rsi + call make_pair + movq %rax, %rbx + popq %rdi # continue with cdr + jmp .lr_loop +.lr_done: + movq %rbx, %rax + popq %rbx + ret + +# ============================================================ +# Initialization +# ============================================================ + +init_special_forms: + pushq %rbx + + leaq sf_quote(%rip), %rdi + call intern_static + movq %rax, sym_quote_val(%rip) + + leaq sf_if(%rip), %rdi + call intern_static + movq %rax, sym_if_val(%rip) + + leaq sf_define(%rip), %rdi + call intern_static + movq %rax, sym_define_val(%rip) + + leaq sf_setbang(%rip), %rdi + call intern_static + movq %rax, sym_setbang_val(%rip) + + leaq sf_lambda(%rip), %rdi + call intern_static + movq %rax, sym_lambda_val(%rip) + + leaq sf_begin(%rip), %rdi + call intern_static + movq %rax, sym_begin_val(%rip) + + leaq sf_let(%rip), %rdi + call intern_static + movq %rax, sym_let_val(%rip) + + leaq sf_cond(%rip), %rdi + call intern_static + movq %rax, sym_cond_val(%rip) + + leaq sf_and(%rip), %rdi + call intern_static + movq %rax, sym_and_val(%rip) + + leaq sf_or(%rip), %rdi + call intern_static + movq %rax, sym_or_val(%rip) + + leaq sf_else(%rip), %rdi + call intern_static + movq %rax, sym_else_val(%rip) + + popq %rbx + ret + +init_builtins: + pushq %rbx + pushq %r12 + + leaq bi_names(%rip), %rbx + xorq %r12, %r12 # index + +.ib_loop: + cmpq $BI_COUNT, %r12 + jge .ib_done + + movq (%rbx,%r12,8), %rdi # name pointer + call intern_static + pushq %rax # save symbol + + movq %r12, %rdi + call make_builtin + movq %rax, %rsi # builtin val + + popq %rdi # symbol + movq %r14, %rdx + call env_define + movq %rax, %r14 + + incq %r12 + jmp .ib_loop + +.ib_done: + popq %r12 + popq %rbx + ret