;›; Runtime code for scc65.›; assemble with atari.m65 and global.m65››.globl__start; program lo memory boundary›__start:›;›; this is the first piece of actual generated code...›;›jmpstart; so we don't need a start vector›;›; routines for inc/dec'ing sp›;››;.globldecsp2›;decsp2:; dec sp by 2›;pha; save a›;ldasp; get sp lo›;sec›;sbc#2; sub 2›;stasp›;ldasp+1; get sp hi›;sbc#0; sub carry›;stasp+1›;pla; get a back›;rts››.globladdysp; add Y to SP›addysp:›pha; save A›clc›tya; get the value›adcsp; add lo byte›stasp; put it back›bccaddysp_1; if no carry, we're done›incsp+1; inc hi byte›addysp_1:›pla; get A back›;rts; done›jmptstax; return condition codes››;.globlincsp1›;incsp1:›;ldy#1›;bneaddysp››.globlincsp2; inc sp by 2›incsp2:›; do this by hand, cause it gets used a lot›;ldy#2›;bneaddysp›incsp›bne*+4›incsp+1›; might as well do incsp1 here, as we have the code...›.globlincsp1›incsp1:›incsp›bne*+4›incsp+1›rts››.globlincsp3; inc sp by 3›incsp3:›ldy#3›bneaddysp››.globlincsp4; inc sp by 4›incsp4:›ldy#4›bneaddysp››.globlincsp5; inc sp by 5›incsp5:›ldy#5›bneaddysp››.globlincsp6; inc sp by 6›incsp6:›ldy#6›bneaddysp››.globlincsp7; inc sp by 7›incsp7:›ldy#7›bneaddysp››.globlincsp8; inc sp by 8›incsp8:›ldy#8›bneaddysp››.globlsubysp; sub Y from SP›subysp:›pha; save A›stytmp1; save the value›ldasp; get lo byte›sec›sbctmp1; sub y val›stasp; put it back›; wrong!›;bcssubysp_1; if carry, we're done›;decsp+1; dec hi byte›ldasp+1›sbc#0›stasp+1›subysp_1:›pla; get A back›rts; done››.globldecsp1›decsp1:›ldy#1›bnesubysp››.globldecsp2›decsp2:›;›; do this one by hand, cause it gets used a lot›;›;ldy#2›;bnesubysp›pha›sec›ldasp›sbc#2›stasp›ldasp+1›sbc#0›stasp+1›pla›rts››.globldecsp3›decsp3:›ldy#3›bnesubysp››.globldecsp4›decsp4:›ldy#4›bnesubysp››.globldecsp5›decsp5:›ldy#5›bnesubysp››.globldecsp6›decsp6:›ldy#6›bnesubysp››.globldecsp7›decsp7:›ldy#7›bnesubysp››.globldecsp8›decsp8:›ldy#8›bnesubysp››;›; ops for loading/indexing stack slots›;›.globlldaxysp; load AX from SP@(Y)›ldaxysp:›lda(sp),y; get lo byte›pha›iny›lda(sp),y; get hi byte›tax; into x›pla; get lo byte back›;rts›jmptstax; return cc››;.globlldsrysp; load SREG from SP@(Y)›;ldsrysp:›;pha; save A›;lda(sp),y; get lo byte›;stasreg; store it›;iny›;lda(sp),y; get hi byte›;stasreg+1; store it›;pla; get A back›;jsrldaxysp; just do the things we optimized›;jsrswapsreg;  out.›;rts››.globlldaysp; load A from SP@(Y)›ldaysp:; zzz maybe do this on line?›ldx#0›lda(sp),y›rts››.globllocysp; compute location of SP@(Y) in AX›locysp:›ldxsp+1; get hi byte›clc; set up for add›tya; get offset›adcsp; compute lo byte›bcclocysp_1›inx; add in carry›locysp_1:›rts››.globlplocysp; push addr y(sp)›plocysp:›jsrlocysp›jmppushax››;›; routines for inc/dec'ing AX›;›.globlincax8›incax8:›ldy#8›jmpindexax›.globlincax7›incax7:›ldy#7›jmpindexax›.globlincax6›incax6:›ldy#6›jmpindexax›.globlincax5›incax5:›ldy#5›jmpindexax›.globlincax4›incax4:›ldy#4›jmpindexax›.globlincax3›incax3:›ldy#7›jmpindexax››.globlincax2; inc AX by 2›incax2:›jsrincax1; inc it once, and fall thru››.globlincax1; inc AX by 1›incax1:›tay; use Y as a temp›iny›tya›bneincax1_1; if not zero, we're done›inx; inc top half›incax1_1:›;rts; done›jmptstax; return cond codes››;.globlincaxi1; load AX indirect, and increment by 1›;incaxi1:›;jsrldaxi›;jmpincax1››;.globlincaxi2; load AX indirect, and increment by 2›;incaxi2:›;jsrldaxi›;jmpincax2››;.globlinci1spp; load AX indirect, inc 1, store thru SP@+›;inci1spp:›;jsrincaxi1›;jmpstaxspp››;.globlinci2spp; load AX indirect, inc 2, store thru SP@+›;inci2spp:›;jsrincaxi2›;jmpstaxspp››;›.globldecax2; dec AX by 2›decax2:›jsrdecax1; dec it once, and fall thru››.globldecax1; dec AX by 1›decax1:›tay; use Y as a temp›dey›tya›cmp#$FF; wrap?›bnedecax1_1; if not -1, we're done›dex; dec top half›decax1_1:›;rts; done›jmptstax; return cond codes››;.globldecaxi1; load AX indirect, and decrement by 1›;decaxi1:›;jsrldaxi›;jmpdecax1››;.globldecaxi2; load AX indirect, and decrement by 2›;decaxi2:›;jsrldaxi›;jmpdecax2››;.globldeci1spp; load AX indirect, dec 1, store thru SP@+›;deci1spp:›;jsrdecaxi1›;jmpstaxspp››;.globldeci2spp; load AX indirect, dec 2, store thru SP@+›;deci2spp:›;jsrdecaxi2›;jmpstaxspp››;›; push/pop things on stack›;›.globlpush0›push0:›lda#0›tax›; ...›.globlpushax; push AX›pushax:›jsrdecsp2; dec sp›ldy#0; get index›sta(sp),y; store lo byte›pha; save it›txa; get hi byte›iny; bump idx›sta(sp),y; store hi byte›pla; get A back›rts; done››.globlpopax; pop stack into AX›popax:›ldy#0›lda(sp),y; get lo byte›pha; stash it›iny›lda(sp),y; get hi byte›tax; into x›pla; get lo byte back›jmpincsp2; bump stack and return››.globlpopsreg; pop stack into SREG›popsreg:›pha; save A›ldy#0›lda(sp),y; get lo byte›stasreg; store it›iny›lda(sp),y; get hi byte›stasreg+1; store it›pla; get A back›jmpincsp2; bump stack and return››.globlpushwysp; push a word from SP@(Y)›pushwysp:›;pha; save A›;txa›;pha; save X›lda(sp),y; get lo byte›pha; Save it›iny; bump idx›lda(sp),y; get hi byte›tax; into X›pla; get back lo byte›jsrpushax; push that›;pla; get original X›;tax; into X›;pla; get back original A›rts››.globlpushbysp; push a byte from SP@(Y)›pushbysp:›lda(sp),y; get lo byte›ldx#0›jsrpushax; push that›rts››;›; Various kinds of store operators›;›.globlstaxspidx; store AX at SP@@(Y)›staxspidx:›jsrstaspic; use common part›pha›iny›ldatmp2›sta(ptr1),y›tax›pla›jmptstax›.globlstaspidx›staspidx:›jsrstaspic; use common part›ldxtmp2›jmptstax›staspic:›statmp1›stxtmp2›stytmp3›jsrpopax; get the pointer›staptr1›stxptr1+1›ldytmp3›ldatmp1›sta(ptr1),y›rts››.globlstaxysp›staxysp:›sta(sp),y›pha›txa›iny›sta(sp),y›pla›jmptstax›.globlstaysp›staysp:›sta(sp),y›jmptstax››;.globlstasreg; store A thru SREG›;stasreg:›;ldy#0›;sta(sreg),y›;rts›;.globlstaxsreg; store AX thru SREG›;staxsreg:›;ldy#0›;sta(sreg),y; store lo byte›;pha; save A›;iny; bump idx›;txa; get hi byte›;sta(sreg),y; store it›;pla; get A back›;;rts; done›;jmptstax; return cc››.globlstaxspp; store AX thru (sp), and pop›staxspp:›pha; save A›txa›pha; save X›jsrpopax; pop addr into AX›staptr1; save into a pointer›stxptr1+1›ldy#1›pla; get hi byte back›sta(ptr1),y; store it›tax; back into X›pla; get lo byte›dey›sta(ptr1),y; store it›jmptstax; return cc››.globlstaspp; store A thru (sp), and pop›staspp:›pha; save A›txa›pha; save X›jsrpopax; pop addr into AX›staptr1; save into a pointer›stxptr1+1›pla; get X›tax›pla; get lo byte›ldy#0›sta(ptr1),y; store it›jmptstax; return cc›››;›; Operations on AX›;›.globlaslax; shift AX left 1›aslax:›aslA›pha›txa›rolA›tax›pla›rts››;.globlasrax; shift AX right 1›;asrax:›;pha›;txa›;pha›;rolA; get carry set right›;pla›;rorA; do the real rotate›;tax›;pla›;rorA›;rts››.globlldaxi; load AX indirect thru AX›ldaxi:›statmpptr›stxtmpptr+1›ldy#1›lda(tmpptr),y›tax›dey›lda(tmpptr),y›;rts›jmptstax; return cond codes››;›; load A indirect thru AX›;›.globlldai›ldai:›statmpptr; set pointer›stxtmpptr+1›ldy#0; set idx›lda(tmpptr),y; get byte›bplldai_1; pos...›ldx#$FF›rts›ldai_1:›ldx#0›;rts›jmptstax; return cond codes››.globlnegax; negate ax›negax:›pha; save A›txa; get X›eor#$FF; invert›tax; back to X›pla; get A back›eor#$FF; invert›clc›adc#1; inc›bccnegax_1›inx; bump X›negax_1:›rts››.globllnegax; logical complement AX›lnegax:›stxtmp3›oratmp3›beqlneg1; it's zero, so return 1›lda#0›tax›rts›lneg1:›ldx#0›lda#1›rts››.globlcomplax; one's complement AX›complax:›eor#$FF; Not A›pha›txa›eor #$FF; Not X›tax›pla›rts››.globlindexax; index in Y, add Y to AX›indexax:›statmp1›tya›clc›adctmp1›bcc*+3›inx›rts››.globlplocidx; push location of AX@(Y)›plocidx:›jsrindexax›jmppushax››;›; test (AX)›;›;.globltstaxi›;tstaxi:›;jsrldaxi›; and fall thru...›;›; test AX for nonzero-ness.  return result in CC›;›.globltstax›tstax:›;cmp#0›;beqtstax_0›;bpltstax_p›;; A was negative, try X›;tstax_0:; A was 0, try X›;cpx#0›;tstax_9:›;rts›;tstax_p:; A was positive›;cpx#0; try X›;bpltstax››cpx#0; test X›beqtstax_x0; 0, go see what A has›rts›tstax_x0:; X was 0, try A›cmp#0; test A›bpltstax_9; pos or zero is ok, just return›ldy#1; force 'positive'›tstax_9:›rts; done, just return›››.globlldaxidx; load AX from (AX)Y›ldaxidx:›jsrindexax; compute address›jmpldaxi; load indirect››.globlldaidx; load A from (AX)Y›ldaidx:›jsrindexax; compute address›jmpldai; load indirect››.globlpushwidx; push word at (AX)Y›pushwidx:›jsrindexax; index›jsrldaxi›jmppushax››.globlpushbidx; push byte at (AX)Y›pushbidx:›jsrindexax; index›jsrldai›jmppushax››;›; operations on SREG›;›.globlasltos›asltos:›jsrpopsreg; for optimized code›.globlaslsreg; shift SREG left AX times, result in AX›aslsreg:›cpx#0; X nonzero?›bneaslsreg_0; no, just return 0›tay; use Y as counter›ldasreg+1›statmp1; use A and tmp1 as register›ldasreg›cpy#0; shift count 0?›beqaslsreg_9; done shifting›aslsreg_1:›aslA; shift A›roltmp1›dey; dec counter›bneaslsreg_1›aslsreg_9:›ldxtmp1; get hi byte›;rts; done›jmptstax›aslsreg_0:›lda#0›tax›;rts›jmptstax; return status for optimized code››.globlasrtos›asrtos:›jsrpopsreg; for optimized code›.globlasrsreg; shift SREG right by AX, result in AX›asrsreg:›cpx#0; X nonzero?›bneaslsreg_0; no, just return 0›;tax; use X as counter›;php; save Z flag, for zero counter›;ldasreg›;statmp1; use tmp1 and A as register›;ldasreg+1›;and#$80; keep top bit›;statmp2›;plp; get Z flag back›;beqasrsreg_9; done shifting›;asrsreg_1:›;lsrA; shift hi byte›;rortmp1; and lo byte›;oratmp2; keep top bit›;dex; dec counter›;bneasrsreg_1›;asrsreg_9:›;tax; put hi byte in X›;ldatmp1; and get lo byte›;rts››;this isn't right... test after loading AX...›;cmp#0; shift count 0?›;beqaslsreg_0; yes, return 0›tay; use Y as shift counter›ldasreg›ldxsreg+1; get the value into AX›cpy#0›beqasrsreg_9; zero, return now›;cpx#0; test AX for minus-ness›;bpl*+5›;jsrnegax›stxtmp1; leave hi byte in tmp1›asrsreg_1:›ldxtmp1; get hi byte,›cpx#$80;  compare, to set carry bit if neg›rortmp1; shift hi byte, preserving hi bit›rorA; shift lo byte›dey; dec shift count›bneasrsreg_1; 0? done›ldxtmp1; get hi byte›;ldysreg+1; original value negative?›;bpl*+5›;jsrnegax; negate result›asrsreg_9:›jmptstax; return status for optimized code››.globladdtos›addtos:›jsrpopsreg; for optimized code›.globladdsreg; add SREG to AX›addsreg:›clc›adcsreg; add lo byte›pha›txa›adcsreg+1; add hi byte›tax›pla›;rts›jmptstax; return status for optimized code››;.globladdimm; add immediate following word›;addimm:›;statmp1; save A›;stxtmp1+1; and X›;pla; get return addr›;staptr1›;pla›;staptr1+1›;ldy#1›;lda(ptr1),y; get lo byte›;clc›;adctmp1; add to old A value›;statmp1; put it back›;iny›;lda(ptr1),y; get hi byte›;adctmp1+1›;statmp1+1›;clc; adjust return addr›;ldaptr1›;adc#3; so we can jump thru it›;staptr1›;bcc*+4›;incptr1+1›;ldatmp1; get A back›;ldxtmp1+1›;jmp(ptr1)››.globlsubtos›subtos:›jsrpopsreg; for optimized code›.globlsubsreg; sub AX from SREG, result in AX›subsreg:›statmp1›stxtmp2; save AX›ldasreg›sec›sbctmp1; sub lo byte›pha›ldasreg+1›sbctmp2; sub hi byte›tax›pla›;rts›jmptstax; return status for optimized code››;.globlswapsreg; swap AX and SREG›;swapsreg:›;statmp1›;stxtmp2›;ldasreg; get lo byte›;ldxsreg+1; get hi byte›;ldytmp1›;stysreg›;ldytmp2›;stysreg+1›;rts››.globlortos›ortos:›jsrpopsreg; for optimized code›.globlorsreg; OR sreg into AX›orsreg:›orasreg›pha›txa›orasreg+1›tax›pla›;rts›jmptstax; return status for optimized code››.globlxortos›xortos:›jsrpopsreg; for optimized code›.globlxorsreg; XOR sreg into AX›xorsreg:›eorsreg›pha›txa›eorsreg+1›tax›pla›;rts›jmptstax; return status for optimized code››.globlandtos›andtos:›jsrpopsreg; for optimized code›.globlandsreg; AND sreg into AX›andsreg:›andsreg›pha›txa›andsreg+1›tax›pla›;rts›jmptstax; return status for optimized code››;.globlldsr; load sreg from following word›;ldsr:›;statmp1; save A›;pla; get return addr›;staptr1›;pla›;staptr1+1›;ldy#1›;lda(ptr1),y; get lo byte›;stasreg›;iny›;lda(ptr1),y; get hi byte›;stasreg+1›;clc; adjust return addr›;ldaptr1›;adc#3; so we can jump thru it›;staptr1›;bcc*+4›;incptr1+1›;ldatmp1; get A back›;jmp(ptr1)››;›; comparisons›;›.globlaxzerop›axzerop:›cmp#0›bnereturn1›cpx#0›bnereturn1›beqreturn0››.globltoseqax›toseqax:›jsrpopsreg; for optimized code›.globlsregeqax; SREG == AX›sregeqax:›cmpsreg; A == sreg lo?›bnereturn0; nope, return 0›cpxsreg+1; X == sreg hi?›bnereturn0›beqreturn1››.globltosneax›tosneax:›jsrpopsreg; for optimized code›.globlsregneax; SREG != AX›sregneax:›cmpsreg; A == sreg lo?›bnereturn1; nope, return 1›cpxsreg+1; X == sreg hi?›bnereturn1›beqreturn0››.globltosltax›tosltax:›jsrpopsreg; for optimized code›.globlsregltax; SREG < AX›sregltax:; really AX > SREG...›cpxsreg+1; X < sreg hi?›bmireturn0; X < SR^ , return 0›bnereturn1; not =, so >; return 1›cmpsreg; A < sreg lo?›bccreturn0; A < SR\, return 0›beqreturn0›bcsreturn1››.globltosultax›tosultax:›jsrpopsreg; for optimized code›.globlsregultax; SREG u< AX›sregultax:; AX u> SREG›cpxsreg+1›bccreturn0; tos^ u< ax^ , return 0›bnereturn1; if ne, must be u>; return 1›cmpsreg›bccreturn0›beqreturn0›bcsreturn1››.globltosleax›tosleax:›jsrpopsreg; for optimized code›.globlsregleax; SREG <= AX›sregleax:; AX >= SR›cpxsreg+1›bmireturn0; X < SR^, return 0›bnereturn1; X > SR^, return 1›cmpsreg›bccreturn0; u> , return 0›bcsreturn1››.globltosuleax›tosuleax:›jsrpopsreg; for optimized code›.globlsreguleax; SREG u<= AX›sreguleax:›cpxsreg+1›bccreturn0; X < SR^, return 0›bnereturn1; X > SR^, return 1›cmpsreg›bccreturn0›bcsreturn1››;›; return functions for comparison ops.  these guys are careful›; to leave the condition codes correct for the AX value.  Compiler›; depends on that when optimizing; beware!›;›return1:›ldx#0›lda#1›rts››return0:›lda#0›tax›rts››.globltosgtax›tosgtax:›jsrpopsreg; for optimized code›.globlsreggtax; SREG > AX›sreggtax:; AX < SR›cpxsreg+1›bmireturn1; < , return 1›bnereturn0; not =, so >; return 0›cmpsreg›bccreturn1; < , return 1›bcsreturn0››.globltosugtax›tosugtax:›jsrpopsreg; for optimized code›.globlsregugtax; SREG u> AX›sregugtax:›cpxsreg+1›bccreturn1; < , return 1›bnereturn0; not =, so >; return 0›cmpsreg›bccreturn1; < , return 1›bcsreturn0››.globltosgeax›tosgeax:›jsrpopsreg; for optimized code›.globlsreggeax; SREG >= AX›sreggeax:; AX <= SR›cpxsreg+1›bmireturn1; < , return 1›bnereturn0; not =, so >; return 0›cmpsreg›bccreturn1; < , return 1›beqreturn1›bcsreturn0››.globltosugeax›tosugeax:›jsrpopsreg; for optimized code›.globlsregugeax; AX u<= SREG›sregugeax:›cpxsreg+1›bccreturn1; < , return 1›bnereturn0; not =, so >; return 0›cmpsreg›bccreturn1; < , return 1›beqreturn1›bcsreturn0››; kludgey constant for DIV, MOD›;onehalf:›;.byte$3F,$49,$99,$99,$99,$99›››;›; function ops›;››.globlenterfun0›enterfun0:›ldy#0›beqenterfun››.globlenterfun1›enterfun1:›ldy#1›bneenterfun››.globlenterfun2›enterfun2:›ldy#2›bneenterfun››.globlenterfun3›enterfun3:›ldy#3›bneenterfun››.globlenterfun4›enterfun4:›ldy#4›bneenterfun››.globlenterfun5›enterfun5:›ldy#5›;bneenterfun››;›; expect frame size in Y, push fp›;›.globlenterfun›enterfun:›tya; get arg count›;aslA›;clc›;adcsp; add to sp›;pha›;ldasp+1›;adc#0›;tax›;pla›ldx#0; just push arg count›jmppushax››.globlexitfun; exit a function.  pop stack and rts›exitfun:›pha; save A a sec›ldy#0›lda(sp),y; that's the pushed arg count›aslA; loses big for large arg counts...›tay›iny›iny; count the word the count's stored in›pla; get it back›jmpaddysp; pop that many word-sized things›››;›; random stuff›;››;›; call value on in AX›;›.globlcallax›callax:›;jsrpopax; pop function ptr›;jsrtos2ax; get tos›statmp1›stxtmp1+1›jmp(tmp1); jump there››;›; swap AX with TOS›;›.globlswapstk›swapstk:›statmpptr›stxtmpptr+1›ldy#1; index›lda(sp),y›tax›ldatmpptr+1›sta(sp),y›dey›lda(sp),y›pha›ldatmpptr›sta(sp),y›pla›rts; whew!››.globlpushwaxi›pushwaxi:; push word (ax)›jsrldaxi›jmppushax››.globlpushbaxi; push byte at (ax)›pushbaxi:›jsrldai›jmppushax››;.globlldaxysp›;ldaxysp:›;jsrlocysp›;jmpldaxi›››;›; or ax with tos, pop›;›;.globloraxtos›;oraxtos:›;ldy#0›;ora(sp),y›;pha›;txa›;iny›;ora(sp),y›;tax›;pla›;jmpincsp2›;›; eor ax with tos, pop›;›;.globleoraxtos›;eoraxtos:›;ldy#0›;eor(sp),y›;pha›;txa›;iny›;eor(sp),y›;tax›;pla›;jmpinc2sp››;›; and ax with tos, pop›;›;.globlandaxtos›;andaxtos:›;ldy#0›;and(sp),y›;pha›;txa›;iny›;and(sp),y›;tax›;pla›;jmpinc2sp››;›; add Y to sp, leave result in AX›;›;.globladdrysp›;addrysp:›;tya; get offset›;clc; set up for...›;adcsp;  add low byte›;pha›;ldasp+1; get hi byte›;adc#0; add carry›;tax; xfer to x›;pla; get a back›;rts; done››;›; handler for case jump inst.›;›.globlcasejump›casejump:›;›; case table after the call to casejmp.  val in AX.›; table is of the form <addr,val>,<addr,val>,...,0.›; rts from casejmp for default case, else pop return addr›; addr and jmp to address›;›statmp3›stxtmp4; save value›pla; get return addr›staptr1›pla›staptr1+1; store in ptr 1›incptr1; and adjust it, because of way 6502 works›bne*+4›incptr1+1›case1:›ldy#1; first see if at end›lda(ptr1),y; test address byte hi›bnecase2; nope, not yet›dey›lda(ptr1),y; test address byte lo›bnecase2›; oops, we're out of cases.  compute return address; 2 + ptr1›clc›ldaptr1; get lo byte›adc#2; inc past the 0›staptr1›bcc*+4; deal with carry›incptr1+1›jmp(ptr1); go there››case2:; test case value against this value›ldy#3›lda(ptr1),y; value hi›cmptmp4; match switchval hi?›bnecase3; no match, try next›dey›lda(ptr1),y; val lo›cmptmp3; match switchval lo?›bnecase3›; match!›dey; point at hi byte of addr›lda(ptr1),y›staptr2+1; stuff in ptr to jump thru›dey; point at lo byte of addr›lda(ptr1),y›staptr2›jmp(ptr2); go there››case3:; no match, try next case clause›clc›ldaptr1; get case ptr›adc#4; add 4›staptr1; put it back›bcc*+4›incptr1+1; deal with carry›jmpcase1; and go try again››;›; save and restore AX›;›.globlsaveax›saveax:›stasvax›stxsvax+1›rts›.globlrestax›restax:›ldasvax›ldxsvax+1›jmptstax››;›; support routines for runtime›;›;tos2ax:›;ldy#0›;ytos2ax:›;iny›;lda(sp),y›;tax›;dey›;lda(sp),y›;rts››;.globlpopax›;popax:›;jsrtos2ax›;jsrinc2sp›;rts››››;›; mult and div, using fp routines›;›;.globlumul›;umul:; unsigned multiply›;stafr0; set up the first num›;stxfr0+1›;jsrifp; make a float out of it›;jsrfmove; move to fr1›;jsrpopax; get second arg›;stafr0; set this one up›;stxfr0+1›;jsrifp; floatify...›;jsrfmul; mult them›;jsrfpi; back to int›;ldafr0›;ldxfr0+1; load it up›;rts; and return››.globlmultos›multos:›jsrpopsreg›.globlsmul; signed multiply AX by SREG›smul:›ldy#0›stytmp3; zap negative flag›cpx#0›bpl*+7›inctmp3›jsrnegax›statmpptr; use sreg and tmpptr›stxtmpptr+1;  as regs›ldasreg›ldxsreg+1›bplxsmul0›dectmp3›jsrnegax›stasreg›stxsreg+1›xsmul0:›lda#0›statmp1; tmp1/2 as accumulator›statmp1+1›lda#1; use A as bit mask against SREG›xsmul1:›bitsreg; this bit in sreg set?›beqxsmul2; nope, try next›jsrxsmadd; add AX val to accum›xsmul2:›asltmpptr; shift AX val left one›roltmpptr+1›aslA; shift bitmask left one›bccxsmul1; if bit not off end, keep working on lo byte›lda#1; set up mask for hi byte›xsmul3:›bitsreg+1; this bit in sreg set?›beqxsmul4; nope, try next›jsrxsmadd; add AX val to accum›xsmul4:›asltmpptr; shift AX val left one›roltmpptr+1›aslA; shift bitmask left one›bccxsmul3; if not off end, keep working on hi byte›ldxtmp1+1; load up accum›ldatmp1›ldytmp3; negate flag?›beqxsmul9›jsrnegax›xsmul9:›rts; done!››xsmadd:; helper fun›pha; save bit mask›clc›ldatmpptr; add AX value›adctmp1;  to accumulator›statmp1›ldatmpptr+1›adctmp1+1›statmp1+1›pla; get bitmask back›rts; done››››xsdiv0:; error return›lda#0›tax›stasreg›stasreg+1›rts››.globldivtos›divtos:›jsrpopsreg; pop other value into sreg›.globlsdiv; signed divide SREG by AX, ›sdiv:;   result in AX, remainder in SREG›ldy#0›stytmp3; zap denominator-negative flag›stytmp4; and numerator-negative flag›jsrtstax; AX zero?›beqxsdiv0; yup, give up now›bplxsdiv1; positive, it's ok›inctmp3; denom negative›jsrnegax; negate it›xsdiv1:›staptr1; use tmpptr1 and SREG as regs›stxptr1+1›ldasreg›ldxsreg+1; load up sreg›jsrtstax; what sort of value?›beqxsdiv0; zero, we lose›bplxsdiv2; positive, it's ok›inctmp4; set numerator-negative flag›jsrnegax; negate it›stasreg›stxsreg+1›xsdiv2:›ldy#1; bit mask›styptr2›dey›styptr2+1›stytmp1; use tmp1 as accum›stytmp1+1›;›; shift ptr1 and ptr2 left until ptr1 is greater than SREG,›; then shift right until it's <=›;›xsdiv3:›ldaptr1+1; compare›cmpsreg+1;  p1 to sreg›beqxsdiv3a; eq, try second byte›bcsxsdiv4; >, we're done shifting left›bccxsdiv3b; <, shift left›xsdiv3a:›ldaptr1›cmpsreg; compare lo byte›beqxsdiv5; =, skip the right shift›bcsxsdiv4; >, go right one›xsdiv3b:›aslptr1; shift p1 left 1›rolptr1+1›aslptr2; shift bitmask left one›rolptr2+1›jmpxsdiv3; round again.›xsdiv4:; shift p1, mask right one›lsrptr1+1; shift p1›rorptr1›lsrptr2+1; shift bitmask›rorptr2›bcsxsdiv7a; bit fell out end?!? ok, do exit processing›;›; whew! tmpptr1 (the divisor register) and tmpptr2 (the quotient bitmask)›; are now all set to enter the divide loop›;›xsdiv5:; compare sreg to p1.  if >=, subtract›ldasreg+1›cmpptr1+1›beqxsdiv5a; try lo byte›bcsxsdiv6; >, go subtract›bccxsdiv7; <, go shift right›xsdiv5a:›ldasreg›cmpptr1›bccxsdiv7; < go shift right›xsdiv6:; subtract p1 from sreg, and set bit in accum›sec›ldasreg; subtract ›sbcptr1;  p1 ›stasreg;   from ›ldasreg+1;    sreg›sbcptr1+1›stasreg+1›ldaptr2; or ›oratmp1;  bitmask›statmp1;   into ›ldaptr2+1;    quotient›oratmp1+1›statmp1+1›xsdiv7:›lsrptr1+1; shift p1 right›rorptr1›lsrptr2+1›rorptr2›bccxsdiv5; if no carry, round again›xsdiv7a:›;›; done!›;›ldatmp4; negate remainder?›beqxsdiv8›ldasreg›ldxsreg+1›jsrnegax›stasreg›stxsreg+1›xsdiv8:›ldatmp1›ldxtmp1+1›ldytmp3; numerator neg...›cpytmp4; same as denom-neg?›beqxsdiv9; yes, skip the negate›jsrnegax›xsdiv9:›rts››.globlmodtos›modtos:›jsrdivtos›ldasreg›ldxsreg+1›jmptstax››;›; library routines›;››.globl_strcpy›_strcpy:›jsrpopax›staptr1›stxptr1+1›jsrpopax›staptr2›stxptr2+1›ldy#0›strc1:›lda(ptr1),y›sta(ptr2),y›beqstrc9›iny›bnestrc1›incptr1+1›incptr2+1›bnestrc1›strc9:›rts››.globl_strlen›_strlen:›jsrpopax›staptr1›stxptr1+1›ldx#0; YX used as counter›ldy#0›strlen1:›lda(ptr1),y›beqstrlen9›iny›bnestrlen1›incptr1+1›inx›bnestrlen1›strlen9:›tya; get low byte of counter, hi's all set›rts››;›; find (char * str, int len, char c) -> index›;›;_find:›;jsrtos2ax›;staptr1›;stxptr1+1›;ldy#2›;jsrytos2ax›;statmp1›;stxtmp1+1›;ldy#4›;jsrytos2ax; gets char in A›;ldx#0›;stxptr2; use as counter here›;stxptr2+1›;ldy#0›;find1:›;cmp(ptr1),y; match?›;beqfind9; yup, return›; zzz›;find9:›;rts››››;›; startup›;›;argv:›;.word0,0,0,0,0,0,0,0›;.word0,0,0,0,0,0,0,0›start:›tsx›stxorigsp; save system stk ptr›;›;lda#0; init stk ptr›;stasp›;lda#$80; $80 for debugging...›;stasp+1›;›ldamemtop; memtop for real code›stasp›ldamemtop+1›stasp+1›;›; if running under SpartaDos, pass the command line to _main›;›lda$0700; check the sparta flag›cmp#'S'›beqstartcmd; nope, check for dos xl›;›; Try to guess what OS we're running under.›; Use the algorithm suggested by Dick Curzon.›; Look thru $0A.  Should see a jmp, another jmp,›; and something that's not a jump.›;›ldy#0›lda(cpaloc),y›cmp#$4C; a jmp?›bnestart0; nope, give up›ldy#3›lda(cpaloc),y›cmp#$4C; a jmp?›bnestart0; nope›ldy#6›lda(cpaloc),y›cmp#$4C; a jmp?›beqstart0; if yes, it's mydos or something››startcmd:›;›; parse command line etc.  for now, assume Sparta or Dos XL›;›clc›ldacpaloc; get pointer to›adc#cpcmdb; cmd buf›pha; save lo byte›ldacpaloc+1›adc#0›tax; get hi byte›pla; get lo byte back›jmpstart1›start0:›; no command line, just pass null›lda#0›tax›start1:›jsrpushax; push the ptr›ldy#1; 1 arg›jsr__main›;›; fall thru to exit...›;rts; done!›;›.globl_exit›_exit:›ldxorigsp›txs›;rts›jmp(dosvec)›;›