;################################################################################ ;# # ;# avr-chipbasic2 - single chip basic computer with ATmega644 # ;# BASIC runtime engine # ;# copyright (c) 2006-2015 Joerg Wolfram (joerg@jcwolfram.de) # ;# # ;# This program is free software; you can redistribute it and/or # ;# modify it under the terms of the GNU General Public License # ;# as published by the Free Software Foundation; either version 3 # ;# of the License, or (at your option) any later version. # ;# # ;# This program is distributed in the hope that it will be useful, # ;# but WITHOUT ANY WARRANTY; without even the implied warranty of # ;# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.See the GNU # ;# General Public License for more details. # ;# # ;# You should have received a copy of the GNU General Public # ;# License along with this library; if not, write to the # ;# Free Software Foundation, Inc., 59 Temple Place - Suite 330, # ;# Boston, MA 02111-1307, USA. # ;# # ;################################################################################ tbrun: ;----------------------------------------------------------------------- ; clear all variables ;----------------------------------------------------------------------- ldi ZH,HIGH(varspace) ldi ZL,LOW(varspace) ldi XL,0 ;zero ldi XH,180 ;variables tbrun_i1: st Z+,XL dec XH brne tbrun_i1 ldi ZH,HIGH(bas_ram) ldi ZL,LOW(bas_ram) ldi XH,16 ;basic system tbrun_i2: st Z+,XL dec XH brne tbrun_i2 ldi ZH,HIGH(bas_array) ldi ZL,LOW(bas_array) ldi XH,0 ;array tbrun_i3: st Z+,XL st Z+,XL st Z+,XL dec XH brne tbrun_i3 clr r13 ;statement 1 clr r12 ;line 1 sts libmio_border,const_0 sts libmio_font,const_0 ldi XL,0x0e ;white on black sts libmio_color,XL ;set color ldi XL,libmio_v0cols ;set clipping to mode 0 sts libmio_clipx2,XL ldi XL,libmio_v0rows sts libmio_clipy2,XL ldi XL,0xff ;no error handling sts bas_ram+15,XL sts bas_mta,XL ;no multitasking sts bas_mta+3,const_0 ;clear pending interrupts libmio_clrscr ;clear screen sts libmio_seqspeed,const_0 ;stop sequencer ldi XL,0xff sts libmio_volume,XL ;volume=max sts libmio_mvolume,XL ;volume=max ldi XL,0x02 sts libmio_seqstat,XL ;status=stopped ldi XL,0xc6 sts ADCSRA,XL ;enable ADC lds tempreg1,libmio_lastmenu;program number sts libmio_prog,tempreg1 ;temp program number (run) sts libmio_tprog,tempreg1 call mem_setprog ;set program number ;----------------------------------------------------------------------- ; main loop for all lines ;----------------------------------------------------------------------- tbrun_02: mov ctrl,r12 ;set line number call mem_readline ;read line from flash rcall basrun ;interpret line cpi ereg,0x00 brne tbrun_03 mov XL,r12 ;linenumber cpi XL,bas_lines brcs tbrun_02 ldi ctrl,0x0c ;standard format sts libmio_seqspeed,const_0 ;stop sequencer ret ;line numer exceeds ;error tbrun_03: sts bas_ram+5,r12 ;line sts bas_ram+6,r13 ;statement sts bas_ram+7,ereg ;error cpi ereg,1 breq tbrun_04 sts libmio_seqspeed,const_0 ;stop sequencer lds tempreg1,bas_ram+15 ;on error cpi tempreg1,bas_lines ;deactivated brcc tbrun_04 clr r13 mov r12,tempreg1 clr ereg ;clear error rjmp tbrun_02 ;error handling tbrun_04: ldi ctrl,0x0c ;standard format sts libmio_seqspeed,const_0 ;stop sequencer ret ;line numer exceeds tbrun_loop: movw ZL,r14 ;get pointer tbrun_mtest: rjmp basrun_05 ;end ;----------------------------------------------------------------------- ; interpret line from Z ;----------------------------------------------------------------------- basrun: ldi ZH,HIGH(bas_linebuf) ;start of buffer ldi ZL,LOW(bas_linebuf) ;start of buffer sts libmio_channel,const_0 ;set output to screen clr ereg ;clear Error mov XL,r13 ;statement to go clr XH basrun_01: cp XL,XH ;found? breq basrun_05 ;yes basrun_02: ld tempreg4,Z+ ;get char cpi tempreg4,0xff ;end of line breq basrun_07 ;next line cpi tempreg4,'_' ;external command brne basrun_02a jmp bas_ext basrun_02a: cpi tempreg4,0x1c ;numbers breq basrun_cnum8 cpi tempreg4,0x1e ;numbers breq basrun_cnum8 cpi tempreg4,0x1d ;numbers breq basrun_cnum16 cpi tempreg4,0x1f ;numbers breq basrun_cnum16 cpi tempreg4,0x27 ;comment breq basrun_07 ;next line cpi tempreg4,'"' ;string brne basrun_04 basrun_03: ld tempreg4,Z+ ;get char cpi tempreg4,0xff ;end of line breq basrun_07 ;yes cpi tempreg4,0x27 ;comment breq basrun_07 cpi tempreg4,'"' ;string brne basrun_03 rjmp basrun_02 basrun_04: cpi tempreg4,':' ;separator brne basrun_02 inc XH ;statement+1 cp XL,XH ;found? brne basrun_02 rjmp basrun_05 basrun_07: rjmp basrun_07x basrun_cnum16: ld tempreg4,Z+ ;ignore compressed value basrun_cnum8: ld tempreg4,Z+ ;ignore compressed value rjmp basrun_02 basrun_05: lds tempreg4,libmio_kflags ;break sbrc tempreg4,0 rjmp basrun_brk cpi ereg,0 breq basrun_mtest rjmp basrun_mtest2 basrun_brk: ldi ereg,1 ;set ereg to 1 andi tempreg4,0xfe ;clear break flag sts libmio_kflags,tempreg4 ret basrun_mtest: sbrs tempreg4,2 rjmp basrun_06 ;no monitor andi XL,0xfb ;clear monitor flag sts libmio_kflags,tempreg4 ;store back lds XL,libmio_vidmode cpi XL,0x05 breq basrun_mtest0 cpi XL,0x00 brne basrun_mtest1 basrun_mtest0: call mon_main ;call monitor basrun_mtest1: sbrs XL,0 ;esc flag rjmp basrun_06 ldi ereg,1 basrun_mtest2: pop r0 ;kill stack pop r0 ret ;end basrun_06: libmio_screenshot lds tempreg4,bas_mta+3 ;int line cpi tempreg4,0x00 ;disabled? breq basrun_06e lds XL,bas_mta ;line number dec r13 ;decrement statement sts bas_mta+3,const_0 ;clear flag jmp bas_gosub_00a ;now start gosub basrun_06e: ld tempreg4,Z+ ;get char cpi tempreg4,0xff ;EOL? brne basrun_08 basrun_07x: clr r13 ;first statement inc r12 ;next line ret ;end of line basrun_08: cpi tempreg4,'_' ;external command brne basrun_08a jmp bas_ext basrun_08a: sbrc tempreg4,7 rjmp basrun_kw ;token cpi tempreg4,32 ;space breq basrun_05 cpi tempreg4,':' brne basrun_10 inc r13 rjmp basrun_05 basrun_10: cpi tempreg4,0x27 ;comment brne basrun_10a ;next line rjmp basrun_07 ;next line basrun_10a: cpi tempreg4,'A' brcs basrun_se cpi tempreg4,'Z'+1 brcs basrun_vset subi tempreg4,0x20 ;set to caps cpi tempreg4,'A' brcs basrun_se cpi tempreg4,'Z'+1 brcc basrun_se ;----------------------------------------------------------------------- ; check for variable setting ;----------------------------------------------------------------------- basrun_vset: mov tempreg7,tempreg4 ;store variable number call bas_ispace ;space cpi tempreg4,'=' brne basrun_se rcall expar ;call parser cpi ereg,0 brne basrun_end mov tempreg4,tempreg7 subi tempreg4,'A' lsl tempreg4 ldi YH,high(varspace) ldi YL,low(varspace) add YL,tempreg4 adc YH,const_0 st Y+,XL st Y+,XH rjmp tbrun_mtest ;monitor test basrun_arse: pop ZL ;restore pointer pop ZH basrun_se: ldi ereg,7 ;syntax error basrun_end: ret cpi tempreg4,0x80 brcc basrun_kw ldi ereg,7 ;syntax error rjmp tbrun_loop ;----------------------------------------------------------------------- ; check for keywords ;----------------------------------------------------------------------- basrun_kw: movw r14,ZL ;store pointer ldi ZL,LOW(basrun_kw1) mov ZH,tempreg4 andi ZH,0x3f ;64 token add ZL,ZH ldi ZH,HIGH(basrun_kw1) adc ZH,const_0 ijmp basrun_kw1: rjmp bas_print ;80 rjmp bas_cls ;81 rjmp bas_goto ;82 rjmp bas_box ;83 rjmp bas_acopy ;84 rjmp bas_sync ;85 rjmp bas_end ;86 rjmp bas_bcopy ;87 rjmp bas_then ;88 rjmp bas_posxy ;89 rjmp bas_note ;8a rjmp bas_onsync ;8b rjmp bas_rread ;8c rjmp bas_rwrite ;8d rjmp bas_gosub ;8e rjmp bas_return ;8f rjmp bas_vmode ;90 rjmp bas_next ;91 rjmp bas_input ;92 rjmp bas_plot ;93 rjmp bas_wait ;94 rjmp bas_tset ;95 rjmp bas_tget ;96 rjmp bas_fsel ;97 rjmp bas_onerr ;98 rjmp bas_sput ;99 rjmp bas_sget ;9a rjmp bas_epoke ;9b rjmp bas_gpix ;9c rjmp bas_circle ;9d rjmp bas_color ;9e rjmp bas_border ;9f rjmp bas_font ;a0 rjmp bas_chpump ;a1 rjmp bas_xpoke ;a2 rjmp bas_vpoke ;a3 rjmp bas_limit ;a4 rjmp bas_gchar ;a5 rjmp bas_drawto ;a6 rjmp bas_play ;a7 rjmp bas_sprite ;a8 rjmp bas_scrollx ;a9 rjmp bas_breakpoint ;aa rjmp bas_repeat ;ab rjmp bas_until ;ac rjmp bas_draw ;ad rjmp bas_icomm ;ae rjmp bas_data ;af rjmp bas_ctext ;b0 rjmp bas_fread ;b1 read page rjmp bas_fwrite ;b2 write page rjmp bas_cbox ;b3 rjmp bas_gattr ;b4 rjmp bas_fdelete ;b5 rjmp bas_fbox ;b6 rjmp bas_setpal ;b7 rjmp bas_for ;b8 rjmp bas_if ;b9 rjmp bas_dir ;ba rjmp bas_out ;bb rjmp bas_fcircle ;bc rjmp bas_alert ;bd rjmp bas_fcreate ;be rjmp bas_ask ;bf tbrun_wrongpar: ldi ereg,19 ;incomplete parameter ret bas_onsync: sbrc tempreg4,6 ;upper=PIE jmp bas_pie bas_onsyncx: jmp bas_onsync_0 ;jump extender bas_scrollx: jmp bas_scroll ;jump extender bas_vpoke: jmp bas_vpoke_0 ;jump extender ;----------------------------------------------------------------------- ; keyword is PRINT ;----------------------------------------------------------------------- bas_print: call bas_rlp ;restore Z-register bas_print_01: ldi ctrl,0x0c ;standard format mov tempreg8,const_1 ;enable newline sts libmio_channel,const_0 ;print to screen bas_print_02: ld XH,Z+ cpi XH,32 ;leading space breq bas_print_02 cpi XH,':' ;end of statement breq bas_print_end cpi XH,0x27 ;comment breq bas_print_end cpi XH,0x80 ;end of line brcs bas_print_sep bas_print_end: sbiw ZL,1 ;points to this char sbrc tempreg8,0 ;newline? libmio_newline lds tempreg1,libmio_channel cpi tempreg1,5 ;I2C brcs bas_print_end1 libi2c_stop bas_print_end1: rjmp tbrun_mtest ;return to main loop ;-------------- separator ---------------------------------------------- bas_print_sep: cpi XH,0x3b ;";" brne bas_print_tab clr tempreg8 ;no newline rjmp bas_print_02 ;print loop ;-------------- tabulator ---------------------------------------------- bas_print_tab: cpi XH,',' ;tab brne bas_print_05 lds tempreg1,libmio_channel cpi tempreg1,0 ;screen brne bas_print_tab2 bas_print_tab1: libmio_outspace mov XH,libmio_cur_x andi XH,0x07 brne bas_print_tab1 rjmp bas_print_tab3 bas_print_tab2: libmio_outspace lds XH,libmio_lpos andi XH,0x07 brne bas_print_tab2 bas_print_tab3: clr tempreg8 ;no newline rjmp bas_print_02 ;print loop1 ;-------------- enable newline if no separator -------------------------- bas_print_05: mov tempreg8,const_1 ;enable newline ;------------- set channel ---------------------------------------------- bas_print_ch: cpi XH,'#' ;channel set? brne bas_print_at ;no sts bas_partab,const_0 ;set array index to 0 sts bas_partab+1,const_0 rcall expar ;get value mov tempreg1,XL ;copy value sts libmio_channel,tempreg1 ;store channel number cpi tempreg1,5 ;above 4 -> I2C brcc bas_print_ch2 bas_print_ch1: rjmp bas_print_02 ;return to print loop bas_print_ch2: libi2c_start ;start cpi tempreg3,0x08 brne bas_print_i2e lds tempreg2,libmio_channel andi tempreg2,0xfe ;mask bit 0 (write) libi2c_wbyte ;write address to bus cpi tempreg3,0x18 brne bas_print_i2e rjmp bas_print_02 ;return to print loop ;------------- set position -------------------------------------------------------- bas_print_at: cpi XH,'@' ;position set? brne bas_print_for ;no call bas_g2b ;get two byte values lds tempreg1,libmio_channel ;get channel number cpi tempreg1,3 brcc bas_print_at1 libmio_gotoxy ;set position rjmp bas_print_02 ;print loop bas_print_at1: brne bas_print_at2 sts bas_partab,XL ;set array index sts bas_partab+1,XH sts libmio_lpos,XL rjmp bas_print_02 ;print loop bas_print_at2: ldi tempreg2,0xff ;cordic statement libi2c_wbyte ;write to I2C cpi tempreg3,0x28 brne bas_print_i2e mov tempreg2,XL ;X-coord libi2c_wbyte ;write to I2C cpi tempreg3,0x28 brne bas_print_i2e mov tempreg2,XH ;Y-coord libi2c_wbyte ;write to I2C cpi tempreg3,0x28 brne bas_print_i2e bas_print_at3: rjmp bas_print_02 ;print loop bas_print_i2e: ldi ereg,15 ;I2C error ret ;------------- set format -------------------------------------------------------- bas_print_for: cpi XH,'!' ;format? brne bas_print_str ;no rcall expar mov ctrl,XL rjmp bas_print_02 bas_print_ex: rjmp bas_print_end bas_print_02x: rjmp bas_print_02 ;-------------- a string ------------------------------------------------ bas_print_str: cpi XH,'"' ;is it a string? brne bas_print_atx ;no bas_print_str1: ld tempreg1,Z+ ;get string char cpi tempreg1,0xff breq bas_print_ex ;yes cpi tempreg1,'"' ;end of string breq bas_print_02x ;yes libmio_outchar ;output char rjmp bas_print_str1 ;string loop ;------------- array text -------------------------------------------------------- bas_print_atx: cpi XH,'&' ;format? brne bas_print_char ;no rcall expar cpi XH,0x03 brcs bas_print_atx1 ldi ereg,18 ;out of array ret bas_print_atx1: ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) add YL,XL adc YH,XH bas_print_atx2: ld tempreg1,Y+ cpi tempreg1,0x00 breq bas_print_atx4 libmio_outchar adiw XL,1 cpi XH,0x03 brcs bas_print_atx2 bas_print_atx4: rjmp bas_print_02 ;------------- a single char -------------------------------------------- bas_print_char: cpi XH,'%' ;char brne bas_print_equ rcall expar mov tempreg1,XL libmio_outchar rjmp bas_print_02 ;------------- an equation -------------------------------------------- bas_print_equ: sbiw ZL,1 ;set pointer to char before rcall expar ;mathematics cpi ereg,0 breq bas_print_14 ret bas_print_14: cpi ctrl,0x80 ;Hex/dez brcc bas_print_15 libmio_outdez rjmp bas_print_02 bas_print_15: libmio_outhex rjmp bas_print_02 ;----------------------------------------------------------------------- ; keyword is CLS ;----------------------------------------------------------------------- bas_cls: sbrc tempreg4,6 ;upper=XSEND jmp bas_xsend libmio_clrscr rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is color ;----------------------------------------------------------------------- bas_color: ldi XL,2 ;max 2 parameters ldi XH,1 ;min 1 rcall bas_getpar ;get parameters lds XH,bas_partab ;foreground andi XH,0x0f cpi XL,1 ;only foreground breq bas_color_1 lds XL,bas_partab+2 ;background swap XL andi XL,0xf0 or XL,XH libmio_setcolor rjmp tbrun_loop ;goto main interpreter loop bas_color_1: mov XL,XH libmio_setdrawcolor rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is acopy ;----------------------------------------------------------------------- bas_acopy: sbrc tempreg4,6 ;upper=LOAD jmp bas_pload bas_acopy_0: call bas_get3 sts bas_ram+10,XL ;copy sts bas_ram+11,XH lds XL,bas_partab+2 ;dest lds XH,bas_partab+3 sts bas_partab+0,XL ;dest sts bas_partab+1,XH lds r16,bas_partab+4 ;par3 is number lds r17,bas_partab+5 bas_acopy_1: cp r17,const_0 cpc r16,const_0 breq bas_acopy_9 bas_acopy_2: call arr_read ;read array value call arr_write ;write array value cpi ereg,0x00 ;OK? brne bas_acopy_o ;exit if error sub r16,const_1 sbc r17,const_0 rjmp bas_acopy_1 bas_acopy_9: rjmp tbrun_loop ;goto main interpreter loop bas_acopy_e: rjmp tbrun_wrongpar ;error bas_acopy_o: ret ;----------------------------------------------------------------------- ; keyword is box ;----------------------------------------------------------------------- bas_box: sbrc tempreg4,6 ;upper=TO rjmp tbrun_loop bas_box_1: ldi XL,0x05 ;max 5 pars ldi XH,0x04 ;min 4 pars rcall bas_getpar ;get parameters call bas_ccheck push tempreg4 rcall bas_g4c sts bas_ram+3,ZL ;last X sts bas_ram+4,ZH ;last Y libmio_box ;draw box pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop bas_box_e: rjmp tbrun_wrongpar ;error ;----------------------------------------------------------------------- ; keyword is font ;----------------------------------------------------------------------- bas_font: sbrc tempreg4,6 rjmp bas_xcall call bas_get1 andi XL,0x01 sts libmio_font,XL rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is fbox ;----------------------------------------------------------------------- bas_fbox: sbrc tempreg4,6 rjmp bas_extpage ldi XL,0x05 ;max 5 pars ldi XH,0x04 ;min 4 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 rcall bas_g4c sts bas_ram+3,ZL ;last X sts bas_ram+4,ZH ;last Y libmio_fbox ;draw box pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop bas_extpage: ldi XL,0x01 ;max 1 pars ldi XH,0x01 ;min 1 pars rcall bas_getpar ;get parameters lds XL,bas_partab sts xram_page,XL rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is circle ;----------------------------------------------------------------------- bas_circle: ldi XL,0x05 ;max 5 pars ldi XH,0x04 ;min 4 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 rcall bas_g4c sts bas_ram+3,YL ;last X sts bas_ram+4,YH ;last Y libmio_circle ;draw circle pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is fcircle ;----------------------------------------------------------------------- bas_fcircle: ldi XL,0x05 ;max 5 pars ldi XH,0x04 ;min 4 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 rcall bas_g4c sts bas_ram+3,YL ;last X sts bas_ram+4,YH ;last Y libmio_fcircle ;draw circle pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is plot ;----------------------------------------------------------------------- bas_plot: ldi XL,0x03 ;max 3 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 lds XH,bas_partab ;X1 lds XL,bas_partab+2 ;Y1 sts bas_ram+3,XL ;last X sts bas_ram+4,XH ;last Y libmio_plot pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is draw ;----------------------------------------------------------------------- bas_draw: ldi XL,0x05 ;max 5 pars ldi XH,0x04 ;min 4 pars rcall bas_getpar ;get parameters rcall bas_ccheck ;color value? push tempreg4 rcall bas_g4c sts bas_ram+3,ZL ;set new old sts bas_ram+4,ZH libmio_draw pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is alert ;----------------------------------------------------------------------- bas_alert: sbrc tempreg4,6 jmp bas_s2baud lds XL,libmio_vidmode cpi XL,0x00 breq bas_alert_tm ldi ereg,28 ;not in graphics mode ret bas_alert_tm: call bas_get1 ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) add YL,XL adc YH,XH lds tempreg1,libmio_color push tempreg1 ;save status push libmio_cur_x push libmio_cur_y libmio_alert ;alert pop libmio_cur_y ;restore status pop libmio_cur_x pop tempreg1 sts libmio_color,tempreg1 rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is ask ;----------------------------------------------------------------------- bas_ask: lds XL,libmio_vidmode cpi XL,0x00 breq bas_ask_tm ldi ereg,28 ;not in graphics mode ret bas_ask_tm: rcall bas_getvar ;variable rcall bas_ispace cpi tempreg4,',' brne bas_ask_err movw r14,ZL ;new position call bas_get1 ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) add YL,XL adc YH,XH lds tempreg1,libmio_color push tempreg1 ;save status push libmio_cur_x push libmio_cur_y libmio_ask ;ask box pop libmio_cur_y ;restore status pop libmio_cur_x rcall bas_loadv st Y+,tempreg1 ;result is 0/1 st Y+,const_0 pop tempreg1 sts libmio_color,tempreg1 clr ereg rjmp tbrun_loop ;goto main interpreter loop bas_ask_err: ldi ereg,0x07 ;syntax error 0x07 rjmp tbrun_loop ;error ;----------------------------------------------------------------------- ; keyword is fsel ;----------------------------------------------------------------------- bas_fsel: lds XL,libmio_vidmode cpi XL,0x00 breq bas_fsel_tm ldi ereg,28 ;not in graphics mode ret bas_fsel_tm: rcall bas_getvar ;variable rcall bas_ispace1 cpi tempreg4,',' brne bas_ask_err ldi XL,0x01 ;get 1 parameter ldi XH,0x01 rcall bas_getpar_0 bas_fsel_02: push libmio_cur_x ;push recent cursor position push libmio_cur_y lds tempreg1,libmio_color push tempreg1 push tempreg4 call fsys_check cpi tempreg1,0 ;no DF breq bas_nofsel call mon_backup ;backup screen lds XL,libmio_color lsr XL andi XL,0x0f call fsys_fselbox ;draw box libmio_thistext .db 3,2,0,0 ;set pos lds XL,bas_partab ;lo ptr lds XH,bas_partab+1 ;hi ptr ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) add YL,XL adc YH,XH ldi XL,22 ;max chars bas_fsel_03: ld tempreg1,Y+ ;get char cpi tempreg1,32 ;space brcs bas_fsel_04 ;less cpi tempreg1,0x80 brcc bas_fsel_04 libmio_outchar dec XL brne bas_fsel_03 bas_fsel_04: call fsys_select call mon_restore ;restore screen cpi tempreg1,0xed ;ESC breq bas_nofsel rcall bas_loadv st Y+,tempreg4 ;result st Y+,const_0 bas_fsel_05: pop tempreg4 pop tempreg1 sts libmio_color,tempreg1 pop libmio_cur_y ;restore status pop libmio_cur_x clr ereg rjmp tbrun_loop ;goto main interpreter loop bas_nofsel: rcall bas_loadv ldi tempreg4,0xff st Y+,tempreg4 ;result = -1 st Y+,tempreg4 rjmp bas_fsel_05 bas_fsel_err: ldi ereg,0x07 ;syntax error rjmp tbrun_loop ;error ;----------------------------------------------------------------------- ; keyword is drawto ;----------------------------------------------------------------------- bas_drawto: ldi XL,0x03 ;max 3 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters rcall bas_ccheck ;color value? push tempreg4 lds YH,bas_ram+4 ;Y1 lds YL,bas_ram+3 ;X1 lds ZH,bas_partab+0 ;Y2 lds ZL,bas_partab+2 ;X2 sts bas_ram+3,ZL ;set new old sts bas_ram+4,ZH libmio_draw pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is cbox ;----------------------------------------------------------------------- bas_cbox: sbrc tempreg4,6 ;upper=LOAD jmp bas_baud call bas_get4 rcall bas_g4c libmio_cbox ;draw clear box rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is ibox ;----------------------------------------------------------------------- bas_ibox: call bas_get4 rcall bas_g4c libmio_ibox ;draw clear box rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is frame ;----------------------------------------------------------------------- bas_frame: call bas_get4 rcall bas_g4c libmio_wbox ;draw clear box rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is hframe ;----------------------------------------------------------------------- bas_hframe: call bas_get4 rcall bas_g4c libmio_whbox ;draw clear whbox rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is BORDER ;----------------------------------------------------------------------- bas_border: call bas_get1 libmio_setborder rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is GOTO ;----------------------------------------------------------------------- bas_goto: call bas_get1 subi XL,1 mov r12,XL clr r13 ret ;----------------------------------------------------------------------- ; keyword is onerr ;----------------------------------------------------------------------- bas_onerr: sbrc tempreg4,6 ;upper=LOAD rjmp bas_volume call bas_get1 subi XL,1 sts bas_ram+15,XL ;store number rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is volume ;----------------------------------------------------------------------- bas_volume: call bas_get1 mov XH,XL ;get parameter set ;set also master volume libmio_setvolume ;set master volume rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is palette ;----------------------------------------------------------------------- bas_setpal: ldi XL,0x07 ;max 6 palette entries ldi XH,0x02 ;min 2 parameters rcall bas_getpar ;get parameters ldi YL,LOW(bas_partab) ldi YH,HIGH(bas_partab) ld XH,Y ;set mov ZL,XL dec ZL ;-adrbyte bas_setpal_1: adiw YL,2 ld XL,Y ;get value libmio_setpalette inc XH dec ZL brne bas_setpal_1 bas_setpal_2: rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is vmode ;----------------------------------------------------------------------- bas_vmode_e: rjmp tbrun_wrongpar ;error bas_vmode: call bas_get1 andi XL,7 ;only 0..7 bas_vmode_1: libmio_setvmode lds XL,libmio_vidmode cpi XL,7 brcc bas_vmode_2 libmio_clrscr bas_vmode_2: rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is sync ;----------------------------------------------------------------------- bas_sync: sbrc tempreg4,6 ;upper=scale jmp bas_scale bas_sync_0: call bas_get1 bas_sync_1: cpi XH,0x00 brne bas_sync_2 cpi XL,0x00 brne bas_sync_2 rjmp tbrun_loop bas_sync_2: libmio_sync sbiw XL,1 rjmp bas_sync_1 bas_sync_e: rjmp tbrun_wrongpar ;error ;----------------------------------------------------------------------- ; keyword is play ;----------------------------------------------------------------------- bas_play: sbrc tempreg4,6 ;upper=wrap jmp bas_wrap sts libmio_seqstat,const_0 ;stopp sequencer call bas_get4 ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) movw ZL,YL ;copy for end cpi XH,0x03 brcc bas_play_e add YL,XL ;add offset to array base adc YH,XH lds r16,bas_partab+2 ;get parameter 2 (len) add XL,r16 adc XH,const_0 add XL,r16 adc XH,const_0 cpi XH,0x03 brcc bas_play_e add ZL,XL adc ZH,XH lds XL,bas_partab+4 ;get parameter 3 (speed) lds XH,bas_partab+6 ;get parameter 4 (number of loops) libmio_startseq bas_play_s: rjmp tbrun_loop bas_play_e: ldi ereg,18 ;out of array rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is end ;----------------------------------------------------------------------- bas_end: sbrc tempreg4,6 ;upper=XREC bas_cchar0: rjmp bas_cchar sts libmio_seqspeed,const_0 ;stop sequencer pop XH pop XH ret ;----------------------------------------------------------------------- ; keyword is if ;----------------------------------------------------------------------- bas_if: sbrc tempreg4,6 ;upper=VIDEO jmp bas_video rcall bas_expar or XL,XH brne bas_if1 rjmp basrun_07 ;next line bas_if1: rjmp tbrun_mtest ;continue ;----------------------------------------------------------------------- ; keyword is then ;----------------------------------------------------------------------- bas_then: sbrc tempreg4,6 ;upper=PSAVE jmp bas_psave bas_then_0: rcall bas_rlp rjmp tbrun_mtest ;continue ;----------------------------------------------------------------------- ; keyword is pos ;----------------------------------------------------------------------- bas_posxy: sbrc tempreg4,6 ;upper=ARC jmp bas_arc bas_posxy_0: movw ZL,r14 ;restore pointer rcall bas_g2b ;get 2 byte parameters libmio_gotoxy bas_posxy_ext: rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is note ;----------------------------------------------------------------------- bas_note: ldi XL,0x02 ;max 2 pars ldi XH,0x01 ;min 1 PAR rcall bas_getpar ;get parameters brne bas_note_1 lds r0,libmio_mvolume ;get master volume sts libmio_volume,r0 rjmp bas_note_2 bas_note_1: lds XH,bas_partab+2 ;get parameter clt ;set no master volume libmio_setvolume ;set volume bas_note_2: lds XL,bas_partab ;get parameter libmio_note rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is GOSUB ;----------------------------------------------------------------------- bas_gosub: ldi XL,0x06 ;max 6 pars ldi XH,0x01 ;min 1 par rcall bas_getpar ;get parameters ldi XH,0x01 ;max parameters before ldi ZL,LOW(bas_partab+2) ldi ZH,HIGH(bas_partab+2) rcall bas_parset bas_gosub_00: lds XL,bas_partab ;get line number dec XL ;-1 bas_gosub_00a: cpi XL,bas_lines brcs bas_gosub_02 bas_gosub_01: ldi ereg,10 ;no valid linenumber rjmp tbrun_loop ;goto main interpreter loop bas_gosub_02: lds XH,bas_stackp ;stackpointer cpi XH,bas_stackdepth-1 ;maximum-1 brcs bas_gosub_03 ldi ereg,13 ;too many gosub rjmp tbrun_loop ;goto main interpreter loop bas_gosub_03: push XL ;this is the new linenumber rcall bas_stackplus ; ori XH,0x40 ;mark as gosub st Y+,XH ;return statement number mov XH,r12 ;our line number st Y+,XH lds XH,libmio_lastmenu ;prog number st Y+,XH ;store clr r13 ;statement=0 pop r12 ;new linenumber ret ;end of working on this line ;----------------------------------------------------------------------- ; keyword is GOSUB (XCALL) ;----------------------------------------------------------------------- bas_xcall_str: jmp bas_sxcall bas_xcall: ldi XL,0x07 ;max 7 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters cpi tempreg4,0x22 breq bas_xcall_str ;check with string ldi XH,0x02 ldi ZL,LOW(bas_partab+4) ldi ZH,HIGH(bas_partab+4) rcall bas_parset bas_xcall_p2: lds tempreg1,bas_partab ;program number dec tempreg1 call mem_readf1 ;get first char cpi tempreg1,'N' ;binary brne bas_xcall_01 lsr ZH ror ZL lds XL,bas_partab+2 ;address offset sbrs tempreg2,4 ;skip if no exec flag? rjmp bas_xcall_p3 ;is binary program add ZL,XL adc ZH,const_0 sbrs tempreg2,5 ;skip if no lib flag rjmp bas_xcall_p3 ldi ereg,41 ;no library ret bas_xcall_p3: adiw ZL,16 ;code offset clt ;par mode icall bas_xcall_lo: rjmp tbrun_loop bas_xcall_01: lds XL,bas_partab+2 ;get line number dec XL cpi XL,bas_lines brcc bas_xcall_p3 ;invalid line number ; rjmp bas_gosub_02 ;debug lds XH,bas_partab ;prog number dec XH andi XH,0x07 sts libmio_tprog,XH ;set temp prognumber bas_xcall_02: lds XH,bas_stackp ;stackpointer cpi XH,bas_stackdepth-1 ;maximum-1 brcs bas_xcall_03 ldi ereg,13 ;too many gosub rjmp tbrun_loop ;goto main interpreter loop bas_xcall_03: push XL rcall bas_stackplus ; ori XH,0x40 ;mark as gosub st Y+,XH ;return statement number mov XH,r12 ;our line number st Y+,XH lds XH,libmio_prog ;caller prog number st Y+,XH ;store clr r13 ;statement=0 pop r12 lds tempreg1,libmio_tprog ;get temp program sts libmio_prog,tempreg1 ;set as new call mem_setprog ;set program ret bas_parset: ldi YL,LOW(bas_values+2) ldi YH,HIGH(bas_values+2) mov tempreg1,XL sub tempreg1,XH sts bas_values+12,tempreg1 bas_parset_1: cpi tempreg1,0 brne bas_parset_2 ret bas_parset_2: ld tempreg2,Z+ st Y+,tempreg2 ld tempreg2,Z+ st Y+,tempreg2 dec tempreg1 rjmp bas_parset_1 ;----------------------------------------------------------------------- ; keyword is RETURN ;----------------------------------------------------------------------- bas_return: ldi XL,0x01 ;max 1 par ldi XH,0x00 ;min 0 par rcall bas_getpar ;get parameters lds XH,bas_stackp ;stackpointer cpi XH,0 brne bas_return_02 bas_return_01: ldi ereg,12 ;return without call ret bas_return_02: cpi XL,0x01 ;min 1 brne bas_return_03 lds XL,bas_partab sts bas_values,XL lds XL,bas_partab+1 sts bas_values+1,XL bas_return_03: dec XH rcall bas_stackget sts bas_stackp,XH ld XH,Y+ ;get TOS sbrs XH,6 ;check if TOS is call rjmp bas_return_01 ;no andi XH,0x0f mov r13,XH ;statement ld r12,Y+ ;linenumber ld tempreg1,Y+ ;program sts libmio_prog,tempreg1 ;set as "this" call mem_setprog ret ;----------------------------------------------------------------------- ; keyword is REPEAT ;----------------------------------------------------------------------- bas_repeat: lds XH,bas_stackp ;stackpointer cpi XH,bas_stackdepth-1 ;maximum-1 brcs bas_repeat_01 ldi ereg,13 ;too many repeat rjmp tbrun_loop ;goto main interpreter loop bas_repeat_01: rcall bas_stackplus ; ori XH,0x20 ;mark as repeat st Y+,XH ;return statement number mov XH,r12 ;our line number st Y+,XH rjmp tbrun_loop ;goto main interpreter loop ;----------------------------------------------------------------------- ; keyword is UNTIL ;----------------------------------------------------------------------- bas_until: lds XH,bas_stackp ;get stackpointer dec XH ;we need the last stack entry brcs bas_until_e ;stack is empty rcall bas_stackget ;calc stack address ld XH,Y+ sbrs XH,5 ;check if TOS is repeat rjmp bas_until_e ;no rcall bas_expar or XL,XH lds XH,bas_stackp ;get stackpointer brne bas_until_1 ;branch if we must loop dec XH ;kill stack entry sts bas_stackp,XH ; rjmp tbrun_mtest ;continue bas_until_1: dec XH ;we need the last stack entry rcall bas_stackget ;calc stack address ld XL,Y+ ;get statement ld r12,Y+ ;get line andi XL,0x0f mov r13,XL ;statement ret bas_until_e: ldi ereg,14 ;until without repeat ret ;----------------------------------------------------------------------- ; keyword is FOR ;----------------------------------------------------------------------- bas_for_err: ldi ereg,7 ret bas_for: sbrc tempreg4,6 ;upper=tfind jmp bas_tfind rcall bas_rlp ;restore Z-register rcall bas_ispace ;space cpi tempreg4,'A' brcs bas_for_err cpi tempreg4,'Z'+1 brcc bas_for_err subi tempreg4,'A' lsl tempreg4 mov tempreg7,tempreg4 ;store variable number rcall bas_ispace ;space cpi tempreg4,'=' brne bas_for_err ;syntax error call expar ;call parser cpi ereg,0 breq bas_for_1 ret bas_for_1: ldi YH,high(varspace) ldi YL,low(varspace) add YL,tempreg7 adc YH,const_0 st Y+,XL ;set variable to initial value st Y+,XH rcall bas_ispace cpi tempreg4,0xc3 ;to brne bas_for_err call expar ;target value movw tempreg5,XL ;save target value cpi ereg,0x00 breq bas_for_2 ret bas_for_2: lds XH,bas_stackp ;stackpointer cpi XH,bas_stackdepth-1 ;maximum-1 brcs bas_for_3 ldi ereg,13 ;too many for ret bas_for_3: rcall bas_stackplus ori XH,0x80 ;mark as for st Y+,XH ;return statement number st Y+,r12 st Y+,tempreg7 ;variable offset st Y+,tempreg5 ;target value low st Y+,tempreg6 ;target value high rjmp tbrun_mtest bas_stackplus: rcall bas_stackget inc XH ;inc pointer sts bas_stackp,XH mov XH,r13 inc XH ;next must skip this andi XH,0x0f ret bas_stackget: ldi YL,LOW(bas_stacks) ;stack root ldi YH,HIGH(bas_stacks) ldi XL,5 ;bytes/record mul XL,XH add YL,r0 adc YH,r1 ret ;----------------------------------------------------------------------- ; keyword is NEXT ;----------------------------------------------------------------------- bas_next: cpi tempreg4,0xc0 ;upper=IBOX brcs bas_next_0 jmp bas_ibox bas_next_0: rcall bas_rlp ;restore Z-register lds XH,bas_stackp ;stackpointer cpi XH,0 brne bas_next_02 bas_next_01: ldi ereg,11 ;next without for ret bas_next_02: dec XH rcall bas_stackget ld XH,Y+ ;statement sbrs XH,7 ;check if TOS is for rjmp bas_next_01 ;no andi XH,0x0f mov r0,XH ;save statement temporary ld tempreg6,Y+ ;get line number to jump ld tempreg4,Y+ ;variable ldi XH,high(varspace) ldi XL,low(varspace) add XL,tempreg4 adc XH,const_0 ld r16,X+ ;variable low ld r17,X+ ;variable high add r16,const_1 adc r17,const_0 st -X,r17 st -X,r16 ld XL,Y+ ;target low ld XH,Y+ ;target high adiw XL,1 ;+1 cp r16,XL brne bas_next_03 cp r17,XH brne bas_next_03 lds XH,bas_stackp ;stackpointer dec XH sts bas_stackp,XH rjmp tbrun_mtest ;next statement bas_next_03: mov r12,tempreg6 mov r13,r0 ret ;----------------------------------------------------------------------- ; keyword is INPUT ;----------------------------------------------------------------------- bas_input: lds XL,libmio_vidmode cpi XL,0x00 breq bas_input_tm ldi ereg,28 ;not in graphics mode ret bas_input_tm: rcall bas_rlp ;restore Z-register ldi XH,0xff sts bas_inbuf,XH bas_input_00: ld XH,Z+ cpi XH,32 ;space breq bas_input_00 mov tempreg1,XH cpi XH,0xff brne bas_input_02 bas_input_01: libmio_newline sbiw ZL,1 rjmp tbrun_mtest bas_input_02: cpi XH,':' ;end of statement breq bas_input_01 cpi XH,0x3b ;";" ignore this breq bas_input_00 cpi XH,',' ;tab brne bas_input_04 bas_input_03: libmio_outspace mov XH,libmio_cur_x andi XH,0x07 brne bas_input_03 rjmp bas_input_00 bas_input_04: cpi XH,'"' ;is it a string? brne bas_input_06 ;no bas_input_05: ld tempreg1,Z+ ;get string char cpi tempreg1,0xff breq bas_input_01 cpi tempreg1,'"' ;end of string breq bas_input_00 ;yes libmio_outchar ;output char rjmp bas_input_05 ;string loop bas_input_06: cpi XH,'A' brcs bas_input_err cpi XH,'Z'+1 brcc bas_input_err subi XH,'A' lsl XH sts bas_ram+2,XH ;variable number ld XH,Z cpi XH,'A' brcs bas_input_07 cpi XH,'Z'+1 brcc bas_input_07 rjmp bas_input_err bas_input_07: rcall bas_inval ;get value ldi YH,high(varspace) ldi YL,low(varspace) lds r17,bas_ram+2 add YL,r17 adc YH,const_0 st Y+,XL ;set variable to initial value st Y+,XH rjmp bas_input_00 bas_input_err: ldi ereg,7 ;syntax error ret ;----------------------------------------------------------------------- ; load varpointer ;---------------------------------------------------------------------- bas_loadv: lds YL,bas_ram+10 lds YH,bas_ram+11 ret ;----------------------------------------------------------------------- ; keyword is wait ;----------------------------------------------------------------------- bas_wait: sbrc tempreg4,6 ;upper=FRAME jmp bas_frame rcall bas_expar cpi ereg,0 breq bas_wait_01 bas_wait_end: rjmp tbrun_mtest bas_wait_01: mov tempreg1,XL or tempreg1,XH breq bas_wait_end bas_wait_02: lds tempreg1,libmio_time0 cpi tempreg1,0x00 breq bas_wait_02 bas_wait_03: lds tempreg1,libmio_time0 cpi tempreg1,0x00 brne bas_wait_03 sbiw XL,1 rjmp bas_wait_01 ;----------------------------------------------------------------------- ; keyword is tset ;----------------------------------------------------------------------- bas_tset: sbrc tempreg4,6 ;upper=HFRAME jmp bas_hframe rcall bas_expar ;get value sts libmio_time_l,XL sts libmio_time_h,XH rjmp bas_wait_01 ;----------------------------------------------------------------------- ; keyword is tget ;----------------------------------------------------------------------- bas_tget: sbrc tempreg4,6 ;upper=LFIND jmp bas_lfind rcall bas_getvar ;get variable lds XL,libmio_time_l st Y+,XL ;low timer lds XL,libmio_time_h st Y+,XL ;high timer rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is sput ;----------------------------------------------------------------------- bas_sput: sbrc tempreg4,6 ;upper=TLEN jmp bas_tlen rcall bas_expar bas_sput_01: mov tempreg1,XL libmio_pser rcall bas_ispc cpi tempreg4,',' brne bas_sput_ext rcall bas_ispace call expar rjmp bas_sput_01 bas_sput_ext: rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is sget ;----------------------------------------------------------------------- bas_sget: sbrc tempreg4,6 ;upper=TO jmp bas_ashift libmio_gserb mov XL,tempreg1 clr XH rjmp bas_s2get_chk ;----------------------------------------------------------------------- ; keyword is epoke ;----------------------------------------------------------------------- bas_epoke: movw ZL,r14 ;restore pointer rcall bas_g2w ;get parameters mov tempreg1,XL cpi YH,HIGH(2000) ;max EEPROM adr brcs bas_epoke0 cpi YL,LOW(2000) ;max EEPROM adr brcc bas_epoke1 bas_epoke0: libeep_write bas_epoke1: rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is xpoke ;----------------------------------------------------------------------- bas_xpoke: movw ZL,r14 ;restore pointer rcall bas_g2w mov tempreg2,XL movw XL,YL ;set address in tempreg4,GPIOR1 ;data EEPROM address andi tempreg4,0x07 libi2c_write cpi tempreg4,6 ;addr 6,7 are for FRAM etc brcc bas_xpoke_1 libmio_sync ;wait min 32ms libmio_sync bas_xpoke_1: rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is dir ;----------------------------------------------------------------------- bas_dir: sbrc tempreg4,6 ;upper=ESPUT jmp bas_s2put rcall bas_expar rcall sys_iocheck brts bas_dir_1 ;io enabled bas_dir_e: ldi ereg,38 ;io disabled ret bas_dir_1: clr ereg out DDRA,XL bas_dir_2: rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is out (Y=pin XL=val) ;----------------------------------------------------------------------- bas_out: sbrc tempreg4,6 ;upper=ESGET jmp bas_s2get movw ZL,r14 ;restore pointer rcall bas_g2w bas_out_1: cpi YH,0x02 ;spiset? brne bas_out_2 ;no call spi_set rjmp tbrun_mtest bas_out_2: cpi YH,0x04 ;sys write? brne bas_out_3 ;no clr YH st Y,XL rjmp tbrun_loop bas_out_3: cpi YH,0x08 ;ext brcs bas_out_31 lds ZH,prg_vdrv sbrc ZH,7 rjmp bas_out_7 ;no vdriver ldi ZL,vdrv_outex ;OUT extension icall cpi ereg,0x00 breq bas_dir_2 ret bas_out_31: call sys_iocheck brtc bas_dir_1 ;io enabled bas_out_4: cpi YH,0x00 ;single bit? brne bas_out_6 ;no mov XH,YL andi XH,0x07 ;8 Bits inc XH clr tempreg4 ;or mask for reset ldi tempreg3,0x7f ;and mask for reset sbrc XL,0 ;value bit ldi tempreg4,0x80 ;or mask for set sbrc XL,0 ;value bit ldi tempreg3,0xff ;and mask for set bas_out_5: bst tempreg4,7 ;rotate or mask lsl tempreg4 bld tempreg4,0 bst tempreg3,7 ;rotate and mask lsl tempreg3 bld tempreg3,0 dec XH brne bas_out_5 in r16,PORTA or r16,tempreg4 and r16,tempreg3 out PORTA,r16 rjmp tbrun_loop bas_out_6: cpi YH,0x01 ;use mask? brne bas_out_7 ;no in XH,PORTA ;get stat com YL ;invert mask and XH,YL ;clear bits com YL ;invert mask again and YL,XL ;and value or XH,YL out PORTA,XH ;out byte bas_out_e: rjmp tbrun_loop bas_out_7: ldi ereg,40 ;no io driver ret ;----------------------------------------------------------------------- ; keyword is pump ;----------------------------------------------------------------------- bas_chpump: sbrc tempreg4,6 rjmp bas_xcall rcall bas_expar libmio_chpump rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is limit ;----------------------------------------------------------------------- bas_limit: rcall bas_getvar ;variable ld r16,Y+ ;set var value ld r17,Y+ subi r17,0x80 ;change sign bit rcall bas_ispace cpi tempreg4,',' brne bas_limit_err rcall bas_g2w ;get min & max value subi XH,0x80 ;change sign bit subi YH,0x80 cp YL,r16 ;lower limit cpc YH,r17 brcs bas_limit1 ;is greater movw r16,YL bas_limit1: cp XL,r16 cpc XH,r17 brcc bas_limit2 movw r16,XL bas_limit2: rcall bas_loadv subi r17,0x80 st Y+,r16 st Y+,r17 rjmp tbrun_mtest bas_limit_err: ldi ereg,6 ;syntax error ret ;----------------------------------------------------------------------- ; keyword is gchar ;----------------------------------------------------------------------- bas_gchar: lds XL,libmio_vidmode cpi XL,0x06 breq bas_gchar_tm andi XL,0x03 ;allow mode 0+4 cpi XL,0x00 breq bas_gchar_tm ldi ereg,28 ;not in graphics mode ret bas_gchar_tm: rcall bas_getvar ;variable movw tempreg7,YL rcall bas_ispace cpi tempreg4,',' brne bas_limit_err rcall bas_g2b ;get X & Y value ldi YL,LOW(libmio_vram) ldi YH,HIGH(libmio_vram) ldi tempreg4,libmio_cols mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ld XL,Y bas_gchar_sval: clr XH movw YL,tempreg7 st Y+,XL st Y+,XH rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is gattr ;----------------------------------------------------------------------- bas_gattr: lds XL,libmio_vidmode andi XL,0x03 ;allow mode 0+4 cpi XL,0x00 breq bas_gattr_tm ldi ereg,28 ;not in graphics mode ret bas_gattr_tm: rcall bas_getvar ;variable movw tempreg7,YL rcall bas_ispace cpi tempreg4,',' brne bas_limit_err rcall bas_g2b ;get x & y value ldi YL,LOW(libmio_vram) ldi YH,HIGH(libmio_vram) ldi tempreg4,libmio_cols mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ldi XL,LOW(libmio_cols*libmio_rows) add YL,XL ldi XL,HIGH(libmio_cols*libmio_rows) add YH,XL clr XH ld XL,Y lsr XL mov XH,XL andi XL,0x77 swap XH andi XH,0x80 or XL,XH rjmp bas_gchar_sval ;----------------------------------------------------------------------- ; keyword is GPIX ;----------------------------------------------------------------------- bas_gpix_err: ldi ereg,6 ;syntax error ret bas_gpix: rcall bas_getvar ;variable movw tempreg7,YL rcall bas_ispace cpi tempreg4,',' brne bas_gpix_err rcall bas_g2b ;get X & Y value ldi YL,LOW(libmio_vram) ldi YH,HIGH(libmio_vram) lds tempreg4,libmio_vidmode andi tempreg4,0x07 ;mask bits cpi tempreg4,0x00 ;mode 0 brne bas_gpix_10 bas_gpix_00: push XL ;save x coord push XH ;save y lsr XL ;X/2 lsr XH ;Y/2 ldi tempreg4,libmio_cols mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ;address of char ld tempreg4,Y ;get char pop XH ;restore coords pop XL sbrc XL,0 lsr tempreg4 sbrc XH,0 lsr tempreg4 sbrc XH,0 lsr tempreg4 ldi XL,LOW(690) ldi XH,HIGH(690) add YL,XL ;address of attribute adc YH,XH ld XL,Y ;get color sbrs tempreg4,0 swap XL bas_gpix_01: lsr XL bas_gpix_02: andi XL,0x0f rjmp bas_gchar_sval bas_gpix_10: cpi tempreg4,0x01 ;mode 1 brne bas_gpix_20 push XL ;save x coord lsr XL ;/8 lsr XL lsr XL ldi tempreg4,libmio_v1bpl ;bytes per line bas_gpix_11: mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ;address of byte ld tempreg4,Y ;get byte pop XL ;restore coords sbrc XL,2 swap tempreg4 sbrc XL,1 lsr tempreg4 sbrc XL,1 lsr tempreg4 sbrc XL,0 lsr tempreg4 andi tempreg4,0x01 mov XL,tempreg4 rjmp bas_gpix_02 bas_gpix_20: cpi tempreg4,0x02 ;mode 2 brne bas_gpix_30 push XL ;save x coord lsr XL ;/4 lsr XL ldi tempreg4,libmio_v2bpl ;bytes per line mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ;address of byte ld tempreg4,Y ;get byte pop XL ;restore coords sbrc XL,1 swap tempreg4 sbrc XL,0 lsr tempreg4 sbrs XL,0 lsr tempreg4 andi tempreg4,0x03 mov XL,tempreg4 rjmp bas_gpix_02 bas_gpix_30: cpi tempreg4,0x03 ;mode 3 brne bas_gpix_50 push XL ;save x coord lsr XL ldi tempreg4,libmio_v3bpl ;bytes per line mul tempreg4,XH add YL,r0 adc YH,r1 add YL,XL adc YH,const_0 ;address of byte ld tempreg4,Y ;get byte pop XL ;restore coords sbrs XL,0 swap tempreg4 mov XL,tempreg4 rjmp bas_gpix_02 bas_gpix_50: push XL ;save x coord lsr XL ;/8 lsr XL lsr XL ldi tempreg4,libmio_v5bpl ;bytes per line rjmp bas_gpix_11 ;----------------------------------------------------------------------- ; keyword is sprite ;----------------------------------------------------------------------- bas_sprite: lds XL,libmio_vidmode cpi XL,0x06 breq bas_sprite_tm andi XL,0x03 ;allow mode 0+4 cpi XL,0x00 breq bas_sprite_tm ldi ereg,28 ;not in graphics mode ret bas_sprite_tm: rcall bas_get3 cpi XH,0x03 brcs bas_sprite_01 ldi ereg,18 ;out of array ret bas_sprite_01: cpi XH,0x02 brne bas_sprite_02 cpi XL,0xf7 ;max brcs bas_sprite_02 bas_sprite_oa: ldi ereg,18 ;out of array ret bas_sprite_wd: ldi ereg,33 ;wrong sprite ret bas_sprite_e: rjmp tbrun_wrongpar ;error bas_sprite_02: ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) add YL,XL adc YH,XH sts libmio_bcsrcx,YL ;address sts libmio_bcsrcy,YH ldd XL,Y+4 ;dx cpi XL,0x00 ;=0 breq bas_sprite_wd ;error cpi XL,libmio_cols ;>8 brcc bas_sprite_wd ;error ldd XH,Y+3 ;dy cpi XH,0x00 ;=0 breq bas_sprite_wd ;error cpi XH,libmio_rows ;>8 brcc bas_sprite_WD ;error lds YL,bas_partab ;adr lo lds YH,bas_partab+1 ;adr hi adiw YL,5 ;header mul XH,XL lsl r0 rol r1 lsl r0 rol r1 add YL,r0 adc YL,r1 cpi YH,3 brcc bas_sprite_wd ;error lds YH,bas_partab+2 ;Y lds YL,bas_partab+4 ;X sts libmio_bcdestx,YL ;coords sts libmio_bcdesty,YH cpi YL,0xff ;hide breq bas_sprite_03 cpi YH,0xff ;hide breq bas_sprite_03 add YL,XL ;x+dx dec YL ;-1 cpi YL,libmio_cols brcc bas_sprite_os add YH,XH ;y+dy dec YH ;-1 cpi YH,libmio_rows brcc bas_sprite_os bas_sprite_03: libmio_sprite ;now we can draw rjmp tbrun_loop bas_sprite_os: ldi ereg,22 ;out of screen ret ;----------------------------------------------------------------------- ; keyword is break ;----------------------------------------------------------------------- bas_breakpoint: lds XL,libmio_vidmode cpi XL,0x00 breq bas_break_tm ldi ereg,28 ;not in graphics mode ret bas_break_tm: rcall bas_rlp lds XL,libmio_kflags ori XL,4 ;set monitor flag sts libmio_kflags,XL rjmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is fread (read from dataflash) ; par1=file ; par2=page ; par3=position in array (0/1/2) ;----------------------------------------------------------------------- bas_fread: rcall bas_get3 bas_fread_1: call fsys_read ;read page cpi ereg,0x00 brne bas_fread_2 rjmp tbrun_loop bas_fread_2: ret ;----------------------------------------------------------------------- ; keyword is fwrite (write to dataflash) ; par1=file ; par2=page ; par3=position in array (0/1/2) ;----------------------------------------------------------------------- bas_fwrite: rcall bas_get3 bas_fwrite_1: call fsys_write ;write page cpi ereg,0x00 brne bas_fwrite_2 rjmp tbrun_loop bas_fwrite_2: ret ;----------------------------------------------------------------------- ; keyword is fcreate (create/delete file) ; par1=file ; par2=pages ; par3= ;----------------------------------------------------------------------- bas_fcreate: ldi XL,0x03 ;max 3 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters cpi XL,0x03 ;max 3 breq bas_fcreate_1a rjmp tbrun_wrongpar ;error bas_fcreate_1: ldi XL,0x14 ;file type sts bas_partab+4,XL bas_fcreate_1a: call fsys_create ;create new file cpi ereg,0x00 brne bas_fcreate_2 rjmp tbrun_loop bas_fcreate_2: ret ;error ;----------------------------------------------------------------------- ; keyword is dfile (delete file) ;----------------------------------------------------------------------- bas_fdelete: rcall bas_get1 bas_fdelete_1: call fsys_delete ;delete file cpi ereg,0x00 brne bas_fdelete_2 rjmp tbrun_loop bas_fdelete_2: ret ;----------------------------------------------------------------------- ; keyword is rread (raw read from dataflash) ; par1=page ; par2=position in array (0/1/2) ;----------------------------------------------------------------------- bas_rread: rcall bas_get2 bas_rread_1: lds tempreg1,bas_partab+2 ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) cpi tempreg1,0x00 breq bas_rread_2 inc YH cpi tempreg1,0x01 breq bas_rread_2 inc YH cpi tempreg1,0x02 breq bas_rread_2 ldi ereg,18 ;out of array ret bas_rread_2: call fsys_readraw cpi ereg,0 breq bas_rread_3 ret bas_rread_3: rjmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is rwrite (raw write to dataflash) ; par1=page ; par2=position in array (0/1/2) ;----------------------------------------------------------------------- bas_rwrite: rcall bas_get2 lds tempreg1,bas_partab+2 ldi YL,LOW(bas_array) ldi YH,HIGH(bas_array) cpi tempreg1,0x00 breq bas_rwrite_2 inc YH cpi tempreg1,0x01 breq bas_rwrite_2 inc YH cpi tempreg1,0x02 breq bas_rwrite_2 ldi ereg,18 ;out of array ret bas_rwrite_2: call fsys_writeraw cpi ereg,0 breq bas_rread_3 ret ;----------------------------------------------------------------------- ; keyword is icomm ;----------------------------------------------------------------------- bas_icomm_ex: rjmp bas_icomm_e ;jump extender bas_icomm: movw ZL,r14 ;restore pointer call bas_get3 lds ctrl,bas_partab lds XH,bas_partab+2 lds XL,bas_partab+4 sts bas_ram+12,XL ;number of bytes libi2c_start ;startbit cpi tempreg3,0x08 brne bas_icomm_ex ;error sbrs ctrl,0 ;skip if read rjmp bas_icomm_w ;jump to write mov tempreg2,ctrl ;address libi2c_wbyte ;output cpi tempreg3,0x40 brne bas_icomm_ex ;error cpi XL,0x00 ;read number? breq bas_icomm_r4 ;yes bas_icomm_r1: ldi YH,high(bas_array) ;array ldi YL,low(bas_array) lds tempreg1,bas_ram+12 ;number of bytes add tempreg1,XH ;add offset sub tempreg1,XL ;sub number of bytes to do add YL,tempreg1 ;array element address adc YH,const_0 cpi XL,1 ;last? breq bas_icomm_r2 libi2c_rbyte ;read byte with ack cpi tempreg3,0x50 brne bas_icomm_e ;error st Y,tempreg2 ;store byte dec XL ;dec number of bytes to read rjmp bas_icomm_r1 bas_icomm_r2: libi2c_rbyten ;read byte without ack cpi tempreg3,0x58 brne bas_icomm_e ;error st Y,tempreg2 ;store byte bas_icomm_r3: libi2c_stop ; jmp tbrun_mtest bas_icomm_r4: libi2c_rbyte ;get number of bytes cpi tempreg3,0x50 brne bas_icomm_e ;error cpi tempreg2,0x00 ;no bytes to read breq bas_icomm_r3 ;-> send stop sts bas_ram+12,tempreg2 ;store number of bytes mov XL,tempreg2 ;bytes to do rjmp bas_icomm_r1 ;read bytes bas_icomm_w: mov tempreg2,ctrl ;address libi2c_wbyte ;output cpi tempreg3,0x18 brne bas_icomm_e ;error mov r19,XL ;number of bytes bas_icomm_w1: ldi YH,high(bas_array) ;array ldi YL,low(bas_array) lds tempreg1,bas_ram+12 ;number of bytes add tempreg1,XH ;add offset sub tempreg1,XL ;sub number of bytes to do add YL,tempreg1 ;array element address adc YH,const_0 ld tempreg2,Y ;get byte cpi tempreg2,0x00 ;zero? brne bas_icomm_w2 cpi r19,0x00 ;stop at zero? breq bas_icomm_w3 ;exit loop bas_icomm_w2: libi2c_wbyte ;write byte cpi tempreg3,0x28 brne bas_icomm_e ;error dec XL ;dec number of byte to read brne bas_icomm_w1 bas_icomm_w3: libi2c_stop jmp tbrun_mtest bas_icomm_e: ldi ereg,15 ;i2c error libi2c_stop ret ;end ;----------------------------------------------------------------------- ; keyword is DATA ;----------------------------------------------------------------------- bas_data: rcall bas_expar sts bas_partab,XL ;array index sts bas_partab+1,XH ;Z points to char bas_data_01: rcall bas_ispc ;wait for no space cpi tempreg4,',' ;comma? brne bas_data_02 ;no -> end adiw ZL,1 rcall bas_ispace ;next nonspace char cpi tempreg4,'"' ;string? breq bas_data_03 ;yes sbiw ZL,1 call expar rcall arr_write ;write array value rjmp bas_data_01 bas_data_02: jmp tbrun_mtest bas_data_03: ld tempreg4,Z+ cpi tempreg4,'"' breq bas_data_04 cpi tempreg4,0xff breq bas_data_04 clr XH mov XL,tempreg4 rcall arr_write ;write array value rjmp bas_data_03 bas_data_04: ld tempreg4,Z rjmp bas_data_01 ;----------------------------------------------------------------------- ; keyword is BCOPY ;----------------------------------------------------------------------- bas_bcopy_m46: cpi XL,4 ;have brne bas_bcopy_err ;branch if not jmp bas_bcopy46 bas_bcopy: ldi XL,7 ;max 7 parameters ldi XH,4 ;min 4 pars rcall bas_getpar ;get parameters lds XH,bas_partab ;parameter 1=mode sts libmio_bcmode,XH ;mode cpi XH,0x01 ;vmem->vmem breq bas_bcopy_vv cpi XH,0x00 ;vmem->vmem breq bas_bcopy_err cpi XH,0x02 ;vmem->mem breq bas_bcopy_vm bas_copy_1: cpi XH,3 breq bas_bcopy_mv cpi XH,7 brcs bas_bcopy_m46 bas_bcopy_err: ldi ereg,21 ;bcopy def err ret bas_bcopy_vv: cpi XL,7 ;we need 7 parameters brne bas_bcopy_err ;error ldi YL,LOW(bas_partab) ldi YH,HIGH(bas_partab) ldd XH,Y+2 sts libmio_bcsrcy,XH ;source X ldd XH,Y+4 sts libmio_bcsrcx,XH ;source Y ldd XH,Y+6 sts libmio_bcdy,XH ;blocks v ldd XH,Y+8 sts libmio_bcdx,XH ;blocks h ldd XH,Y+10 sts libmio_bcdesty,XH ;dest Y ldd XH,Y+12 sts libmio_bcdestx,XH ;dest X libmio_bcopy ;transfer cpi ereg,0x00 breq bas_bcopy_vv1 ret bas_bcopy_vv1: jmp tbrun_loop ;goto main loop bas_bcopy_vm: cpi XL,6 ;we need 6 parameters brne bas_bcopy_err ;error ldi YL,LOW(bas_partab) ldi YH,HIGH(bas_partab) ldd XH,Y+2 sts libmio_bcsrcy,XH ;source y ldd XH,Y+4 sts libmio_bcsrcx,XH ;source x ldd XH,Y+6 sts libmio_bcdy,XH ;pixel columns ldd XH,Y+8 sts libmio_bcdx,XH ;pixel rows ldd XH,Y+10 ;arrayptr low sts libmio_bcdestx,XH ;low pointer ldd XH,Y+11 ;arrayptr high sts libmio_bcdesty,XH ;high pointer libmio_bcopy ;transfer cpi ereg,0x00 breq bas_bcopy_vm1 ret bas_bcopy_vm1: jmp tbrun_loop ;goto main loop bas_bcopy_errx: rjmp bas_bcopy_err ;jump extender bas_bcopy_mv: cpi XL,4 ;we need 4 parameters brne bas_bcopy_errx ;error ldi YL,LOW(bas_partab) ldi YH,HIGH(bas_partab) ldd XH,Y+2 ;arrayptr low sts libmio_bcsrcx,XH ;low pointer ldd XH,Y+3 ;arrayptr high sts libmio_bcsrcy,XH ;high pointer ldd XH,Y+4 sts libmio_bcdesty,XH ;dest y ldd XH,Y+6 sts libmio_bcdestx,XH ;dest x libmio_bcopy ;transfer cpi ereg,0x00 breq bas_bcopy_mv1 ret bas_bcopy_mv1: jmp tbrun_loop ;goto main loop ;----------------------------------------------------------------------- ; keyword is CTEXT ;----------------------------------------------------------------------- bas_ctext: sbrc tempreg4,6 jmp bas_spisel lds XL,libmio_vidmode cpi XL,0x00 breq bas_ctext_tm ldi ereg,28 ;not in graphics mode ret bas_ctext_tm: movw ZL,r14 ;restore pointer rcall bas_g2w sts bas_partab,YL ;offset sts bas_partab+1,YH ;array area lds r18,bas_ram+12 ;number of chars cp XL,r18 ;limit brcc bas_ctext_00 mov r18,XL bas_ctext_00: ldi XL,LOW(bas_inbuf) ldi XH,HIGH(bas_inbuf) bas_ctext_01: cpi r18,0 breq bas_ctext_02 ld tempreg1,X+ movw r16,XL mov XL,tempreg1 clr XH rcall arr_write movw XL,r16 dec r18 rjmp bas_ctext_01 bas_ctext_02: clr XL clr XH rcall arr_write jmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is scroll ;----------------------------------------------------------------------- bas_scroll: lds XL,libmio_vidmode cpi XL,0x00 breq bas_scroll_tm cpi XL,0x04 breq bas_scroll_tm cpi XL,0x06 breq bas_scroll_tm ldi ereg,28 ;not in graphics mode ret bas_scroll_tm: rcall bas_get1 lds XL,bas_partab ;lo ptr mov tempreg1,XL andi tempreg1,0x03 libmio_scroll jmp tbrun_loop ;goto main interpreter loop bas_scroll_e: jmp tbrun_wrongpar ;----------------------------------------------------------------------- ; get XL parameters to bas_par ;----------------------------------------------------------------------- bas_getpar: movw ZL,r14 ;get line pointer bas_getpar_0: push YH push YL push XH ldi YL,LOW(bas_partab) ;set ptr ldi YH,HIGH(bas_partab) ldi tempreg1,0x00 ;no value mov tempreg2,XL ;max value count bas_getpar_3: push YH ;save registers push YL push tempreg1 push tempreg2 call expar ;call parser pop tempreg2 ;restore registers pop tempreg1 pop YL pop YH bas_getpar_4: st Y+,XL ;write low st Y+,XH ;write high inc tempreg1 ;number of params dec tempreg2 cpi tempreg2,0x00 ;all done? breq bas_getpar_6 ;end now bas_getpar_5: ld tempreg4,Z+ ;get next cpi tempreg4,32 ;space breq bas_getpar_5 ;wait for not cpi tempreg4,',' ;delimiter breq bas_getpar_3 ;OK, check next value sbiw ZL,1 ;set pointer back to this char bas_getpar_6: mov XL,tempreg1 ;number of values movw r14,ZL ;set new pointer pop XH ;restore min cp XL,XH ;< brcc bas_getpar_7 pop YL ;prepare kill stack pop YH ldi ereg,19 ;incomplete PAR bas_getpar_7: pop YL pop YH ret ;----------------------------------------------------------------------- ; get 3 byte parameters (ctrl,XH,XL) ;----------------------------------------------------------------------- bas_g4c: lds YH,bas_partab ;Y1 lds YL,bas_partab+2 ;X1 lds ZH,bas_partab+4 ;Y2 lds ZL,bas_partab+6 ;X2 bas_g4c_1: sts libmio_bcsrcx,YL sts libmio_bcsrcy,YH sts libmio_bcdx,ZL sts libmio_bcdy,ZH ret ;----------------------------------------------------------------------- ; get 2 byte parameters (XH,XL) ;----------------------------------------------------------------------- bas_g2b: ldi XL,0x02 ;2 parameters ldi XH,0x00 ;disable minimum rcall bas_getpar_0 ;get cpi XL,0x02 ;2 found brne bas_g2b_e ;no lds XH,bas_partab lds XL,bas_partab+2 ret bas_g2b_e: pop XL pop XL jmp tbrun_wrongpar ;----------------------------------------------------------------------- ; get 2 word parameters (Y,X) ;----------------------------------------------------------------------- bas_g2w: ldi XL,0x02 ldi XH,0x00 ;disable minimum rcall bas_getpar_0 cpi XL,0x02 brne bas_g2b_e lds YL,bas_partab lds YH,bas_partab+1 lds XL,bas_partab+2 lds XH,bas_partab+3 ret ;----------------------------------------------------------------------- ; get variable address ;----------------------------------------------------------------------- bas_getvar: movw ZL,r14 ;get line pointer bas_va: rcall bas_ispace bas_va_1: cpi tempreg4,'A' brcs bas_va_err cpi tempreg4,'Z'+1 brcc bas_va_3 subi tempreg4,'A' bas_va_2: lsl tempreg4 ldi YH,high(varspace) ldi YL,low(varspace) add YL,tempreg4 adc YH,const_0 sts bas_ram+10,YL ;save var address sts bas_ram+11,YH movw r14,ZL ;store back line pointer ret bas_va_3: cpi tempreg4,'a' brcs bas_va_err cpi tempreg4,'z'+1 brcc bas_va_err subi tempreg4,'a' rjmp bas_va_2 bas_va_err: pop ereg pop ereg ldi ereg,7 ret ;----------------------------------------------------------------------- ; read until char is not space ;----------------------------------------------------------------------- bas_ispace: ld tempreg4,Z+ bas_ispc: cpi tempreg4,32 ;space breq bas_ispace bas_ignoresp01: ret ;----------------------------------------------------------------------- ; read until char is not space ;----------------------------------------------------------------------- bas_ispace1: movw ZL,r14 bas_ispace1_1: movw r14,ZL ld tempreg4,Z+ cpi tempreg4,32 ;space breq bas_ispace1_1 ret ;----------------------------------------------------------------------- ; restore line pointer ;----------------------------------------------------------------------- bas_rlp: movw ZL,r14 ;get line pointer ret ;----------------------------------------------------------------------- ; restore line pointer and get parameter ;----------------------------------------------------------------------- bas_expar: movw ZL,r14 ;get line pointer jmp expar ;----------------------------------------------------------------------- ; input value ;----------------------------------------------------------------------- bas_inval: push ZL ;save pointer push ZH libmio_calc ;calculate address movw ZL,YL ;set start of pointer ldi r16,0 ;length bas_inval_01: libmio_cursor ;view cursor lds tempreg4,libmio_kflags ;break cpi tempreg4,1 brne bas_inval_01b mov ereg,tempreg4 rjmp bas_inval_01c bas_inval_01b: cpi tempreg1,0xea ;enter brne bas_inval_04 sts bas_ram+12,r16 ;number of chars cpi r16,0 ;no char brne bas_inval_02 clr XL clr XH bas_inval_01a: clr ereg bas_inval_01c: pop ZH ;restore pointer pop ZL ret bas_inval_02: ldi YL,LOW(bas_inbuf) ldi YH,HIGH(bas_inbuf) bas_inval_03: ld XL,Z+ st Y+,XL dec r16 brne bas_inval_03 ; ldi XL,0x20 ; st Y+,XL ldi XL,0xff ;eol st Y+,XL call clin_main ;compress ldi ZL,LOW(bas_linebuf) ldi ZH,HIGH(bas_linebuf) call expar ;calculate value movw r16,XL call mem_readline movw XL,r16 rjmp bas_inval_01a bas_inval_04: cpi tempreg1,0xec ;backspace brne bas_inval_05 cpi r16,0 breq bas_inval_01 ;nothing dec libmio_cur_x libmio_calc ldi XL,0x20 st Y,XL dec r16 rjmp bas_inval_01 bas_inval_05: cpi tempreg1,0x20 brcs bas_inval_01 cpi tempreg1,'z'+1 brcc bas_inval_01 mov XL,libmio_cur_x cpi XL,libmio_cols-1 brcc bas_inval_01 libmio_outchar inc r16 rjmp bas_inval_01 bas_vline: ldi ctrl,2 clr XH mov XL,r12 ;line inc XL libmio_outdez ldi tempreg1,':' libmio_outchar clr XH mov XL,r13 ;statement libmio_outdez libmio_outspace ret ;----------------------------------------------------------------------- ; check for color store and fill flag ;----------------------------------------------------------------------- bas_ccheck: lds tempreg4,libmio_color ;get recent color sbrs XL,0 ret cpi XL,3 ;3 paramters brne bas_ccheck_2 ;no lds XL,bas_partab+4 ;low of p3 bas_ccheck_1: libmio_setdrawcolor ;temporary color ret bas_ccheck_2: cpi XL,5 ;5 paramters brne bas_ccheck_3 ;no lds XL,bas_partab+8 ;low of p5 rjmp bas_ccheck_1 bas_ccheck_3: lds XL,bas_partab+12 ;low of p7 rjmp bas_ccheck_1 ;------------------------------------------------------------------------------ ;check memory for useability ;------------------------------------------------------------------------------ bas_fcheck: call fsys_maxpage ;get no of pages cpi tempreg1,0x00 brne bas_fcheck_01 clr tempreg3 ret bas_fcheck_01: sts bas_partab+8,tempreg1 ;store no of pages call fsys_checkf ;test for valid format cpi tempreg1,0x01 ;OK breq bas_fcheck_02 clr tempreg3 bas_fcheck_02: ret ;----------------------------------------------------------------------- ; keyword is onsync ;----------------------------------------------------------------------- bas_onsync_0: ldi XL,0x02 ;max 2 pars ldi XH,0x01 ;min 1 par rcall bas_getpar ;get parameters ldi XH,1 ;1 if no cycle number defined cpi XL,0x01 breq bas_onsync_1 lds XH,bas_partab+2 ;get parameter 2 bas_onsync_1: lds XL,bas_partab ;get parameter 1 subi XL,1 sts bas_mta,XL ;store line number sts bas_mta+1,XH ;store cycle number libmio_sync ;sync to prevent immediate INT sts bas_mta+2,XH ;set counter sts bas_mta+3,const_0 ;no interrupt jmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is vpoke ;----------------------------------------------------------------------- bas_vpoke_0: ldi XL,0x03 ;max 3 pars ldi XH,0x02 ;min 2 par rcall bas_getpar ;get parameters lds YL,bas_partab ;low offset lds YH,bas_partab+1 ;high offset lds tempreg1,bas_partab+2 ;value ldi r16,LOW(2760) ;limit ldi r17,HIGH(2760) ldi r18,LOW(libmio_vram) ;base ldi r19,HIGH(libmio_vram) cpi XL,0x02 ;min parameters brne bas_vpoke_1 ;multiple poke rcall bas_vpoke_wr ;write jmp tbrun_loop bas_vpoke_1: lds tempreg3,bas_partab+4 ;number of cycles (low) bas_vpoke_2: lds ZH,bas_partab+3 ;array offset high andi ZH,1 ;only sector 0+1 lds ZL,bas_partab+2 ;array offset low ldi tempreg1,LOW(bas_array) add ZL,tempreg1 ldi tempreg1,HIGH(bas_array) adc ZH,tempreg1 clr tempreg1 bas_vpoke_3: add YL,tempreg1 adc YH,const_0 ld tempreg1,Z+ ;get value rcall bas_vpoke_wr ;write ld tempreg1,Z+ ;get offset cpi tempreg1,0x80 ;end? brcs bas_vpoke_3 subi tempreg1,0x80 add YL,tempreg1 adc YH,const_0 dec tempreg3 ;cycles brne bas_vpoke_2 jmp tbrun_loop ;write value (offset=Y, value=tempreg1) bas_vpoke_wr: cp YL,r16 cpc YH,r17 brcc bas_vpoke_wre movw XL,YL ;copy add XL,r18 ;add base adc XH,r19 st X,tempreg1 bas_vpoke_wre: ret ;----------------------------------------------------------------------- ; bcopy for mode 4 and 6 ;----------------------------------------------------------------------- bas_bcopy46: push ZH push ZL ldi r16,LOW(bas_array+768) ;array limit ldi r17,HIGH(bas_array+768) ldi r18,LOW(libmio_vram+2760) ldi r19,HIGH(libmio_vram+2760) lds XH,bas_partab ;mode cpi XH,4 ;vmem->vmem brne bas_bcopy46_20 ldi ZL,LOW(libmio_vram) ;base ldi ZH,HIGH(libmio_vram) lds XL,bas_partab+2 ;get vmem source address lds XH,bas_partab+3 andi XH,0x0f ;limit to 4095 add XL,ZL adc XH,ZH lds YL,bas_partab+4 ;get vmem dest address lds YH,bas_partab+5 andi YH,0x0f ;limit to 4095 add YL,ZL adc YH,ZH lds ZL,bas_partab+6 ;bytes to copy lds ZH,bas_partab+7 bas_bcopy46_10: cp XL,r18 cpc XH,r19 brcc bas_bcopy46_11 cp YL,r18 cpc YH,r19 brcc bas_bcopy46_11 sbiw ZL,1 brcs bas_bcopy46_11 ld r0,X+ st Y+,r0 rjmp bas_bcopy46_10 bas_bcopy46_11: pop ZL pop ZH jmp tbrun_loop bas_bcopy46_20: cpi XH,5 ;vmem->array brne bas_bcopy46_30 ldi ZL,LOW(libmio_vram) ;base ldi ZH,HIGH(libmio_vram) lds XL,bas_partab+2 ;get vmem source address lds XH,bas_partab+3 andi XH,0x0f ;limit to 4095 add XL,ZL adc XH,ZH ldi ZL,LOW(bas_array) ;base ldi ZH,HIGH(bas_array) lds YL,bas_partab+4 ;get array dest address lds YH,bas_partab+5 andi YH,0x0f ;limit to 4095 add YL,ZL adc YH,ZH lds ZL,bas_partab+6 ;bytes to copy lds ZH,bas_partab+7 bas_bcopy46_21: cp XL,r18 cpc XH,r19 brcc bas_bcopy46_11 cp YL,r16 cpc YH,r17 brcc bas_bcopy46_11 sbiw ZL,1 brcs bas_bcopy46_11 ld r0,X+ st Y+,r0 rjmp bas_bcopy46_21 bas_bcopy46_30: cpi XH,6 ;array->vmem brne bas_bcopy46_40 ldi ZL,LOW(bas_array) ;base ldi ZH,HIGH(bas_array) lds XL,bas_partab+2 ;get array source address lds XH,bas_partab+3 andi XH,0x0f ;limit to 4095 add XL,ZL adc XH,ZH ldi ZL,LOW(libmio_vram) ;base ldi ZH,HIGH(libmio_vram) lds YL,bas_partab+4 ;get vmem dest address lds YH,bas_partab+5 andi YH,0x0f ;limit to 4095 add YL,ZL adc YH,ZH lds ZL,bas_partab+6 ;bytes to copy lds ZH,bas_partab+7 bas_bcopy46_31: cp XL,r16 cpc XH,r17 brcc bas_bcopy46_32 cp YL,r18 cpc YH,r19 brcc bas_bcopy46_32 sbiw ZL,1 brcs bas_bcopy46_32 ld r0,X+ st Y+,r0 rjmp bas_bcopy46_31 bas_bcopy46_32: rjmp bas_bcopy46_11 bas_bcopy46_40: pop ZL pop ZH ldi ereg,21 ;bcopy def err ret ;----------------------------------------------------------------------- ; copy char matrix in mode 4+6 ;----------------------------------------------------------------------- bas_cchar: ldi XL,0x03 ;max 3 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters lds tempreg4,libmio_vidmode ;video mode lds tempreg2,bas_partab+2 ;dest char lds tempreg1,bas_partab lds tempreg3,bas_partab+4 cpi tempreg4,0x06 ;mode 6 breq bas_cchar6 cpi tempreg4,0x04 ;mode 4 breq bas_cchar4 jmp tbrun_loop ;works not in other modes bas_cchar6: cpi XL,0x03 ;min parameters brne bas_cchar_e ;<3 is not OK libmio_copychar6 jmp tbrun_loop bas_cchar4: cpi XL,0x02 ;min parameters brne bas_cchar_e ;<2 is not OK libmio_copychar4 jmp tbrun_loop bas_cchar_e: jmp tbrun_wrongpar ;----------------------------------------------------------------------- ; load program file ; par 1 file ; par 2 prog ;----------------------------------------------------------------------- bas_pload: ldi XL,0x02 ;max 2 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters bas_pload_1: call fsys_gettype cpi ereg,0 breq bas_pload_2 ret bas_pload_2: cpi tempreg1,0x10 ;basic file breq bas_pload_3 cpi tempreg1,0x18 ;native file breq bas_pload_3 ldi ereg,35 ;no prg file ret bas_pload_3: lds ctrl,bas_partab+2 ;prog no dec ctrl lds tempreg4,libmio_prog cp tempreg4,ctrl breq bas_pload_err lds tempreg4,bas_partab ;file no call fsys_bload_0 jmp tbrun_loop bas_pload_err: ldi ereg,37 ret ;----------------------------------------------------------------------- ; save program file ; par 1 file ; par 2 prog ;----------------------------------------------------------------------- bas_psave: ldi XL,0x02 ;max 2 pars ldi XH,0x02 ;min 2 pars rcall bas_getpar ;get parameters bas_psave_1: call fsys_gettype cpi ereg,0 breq bas_psave_2 ret bas_psave_2: cpi tempreg1,0xfc ;empty file breq bas_psave_3 ldi ereg,23 ;cannot create ret bas_psave_3: lds tempreg8,libmio_lastmenu lds tempreg4,bas_partab ;file no lds ctrl,bas_partab+2 ;prog no dec ctrl sts libmio_lastmenu,ctrl call fsys_bsave sts libmio_lastmenu,tempreg8 ;restore recent file bas_psave_4: jmp tbrun_loop ;----------------------------------------------------------------------- ; send xmodem block XSEND ;----------------------------------------------------------------------- bas_xsend: ldi XL,2 ;max 2 parameter ldi XH,2 rcall bas_getpar ;get parameters ldi XL,LOW(640) ldi XH,HIGH(640) lds tempreg3,bas_partab lds YL,bas_partab+2 lds YH,bas_partab+4 cp YL,XL cpc YH,XH brcc bas_xsend_err ldi XL,LOW(bas_array) ldi XH,HIGH(bas_array) add YL,XL adc YH,XH libmio_sendx ;send data jmp tbrun_loop bas_xsend_err: ldi ereg,18 ret ;----------------------------------------------------------------------- ; draw pie ;----------------------------------------------------------------------- bas_pie: ldi XL,0x07 ;max 7 pars ldi XH,0x06 ;min 6 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 ldi ZL,LOW(bas_ram) ldi ZH,HIGH(bas_ram) rcall bas_arcp ;get coords of pt1 sts bas_ram+3,YL ;last X sts bas_ram+4,YH ;last Y lds ZL,bas_partab+2 ;X0 lds ZH,bas_partab ;Y0 libmio_draw rcall bas_arcn_1 ;draw arc lds YL,bas_ram+3 ;last X lds YH,bas_ram+4 ;last Y lds ZL,bas_partab+2 ;X0 lds ZH,bas_partab ;Y0 libmio_draw pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp bas_psave_4 ;goto main interpreter loop ;----------------------------------------------------------------------- ; draw arc ;----------------------------------------------------------------------- bas_arc: ldi XL,0x07 ;max 7 pars ldi XH,0x06 ;min 6 pars rcall bas_getpar ;get parameters rcall bas_ccheck push tempreg4 rcall bas_arcn ;draw arc pop tempreg4 sts libmio_color,tempreg4 ;restore color rjmp bas_psave_4 ;goto main interpreter loop ;draw arc bas_arcn: ldi ZL,LOW(bas_ram) ldi ZH,HIGH(bas_ram) rcall bas_arcp ;point1 movw XL,YL ldi ZL,LOW(bas_ram) ldi ZH,HIGH(bas_ram) std Z+3,XL ;last X std Z+4,XH ;last Y libmio_plot ;draw point bas_arcn_1: ldi ZL,LOW(bas_ram) ldi ZH,HIGH(bas_ram) ldd XL,Z+24 ;angle low ldd XH,Z+25 ;angle high ldd YL,Z+26 ;angle 2 low ldd YH,Z+27 ;angle 2 high adiw YL,1 ;2+1 cp XL,YL cpc XH,YH brcs bas_arcn_2 ret bas_arcn_2: adiw XL,1 std Z+24,XL std Z+25,XH rcall bas_arcp lds ZL,bas_ram+3 lds ZH,bas_ram+4 sts bas_ram+3,YL ;last X sts bas_ram+4,YH ;last Y libmio_draw rjmp bas_arcn_1 ;draw arc point bas_arcp: ldd XL,Z+24 ;angle low ldd XH,Z+25 ;angle high rcall bas_cos ldd r16,Z+20 ;ry low clr r17 call expar_mul ;calc dy ldd YH,Z+16 ;Y0 sub YH,XH ;this is our Y coord ldd XL,Z+24 ;angle low ldd XH,Z+25 ;angle high sbiw XL,45 ;prepare sin sbiw XL,45 call bas_cos ;get sinus ldd r16,Z+22 ;rx low clr r17 call expar_mul ;calc dy ldd YL,Z+18 ;X0 add YL,XH ;this is our X coord ret ;----------------------------------------------------------------------- ; keyword is VID ;----------------------------------------------------------------------- bas_video: rcall bas_get1 sbrs XL,0 libmio_fast sbrc XL,0 bas_video_1: libmio_slow jmp tbrun_loop ;----------------------------------------------------------------------- ; keyword is SCALE ;----------------------------------------------------------------------- bas_scale: rcall bas_getvar ;get variable push YL push YH rcall bas_ispace ldi XL,0x05 ;max 5 pars ldi XH,0x00 ;no min rcall bas_getpar_0 ;get parameters cpi XL,0x05 ;min parameters brne bas_scale_e call math_scale pop YH pop YL st Y+,XL ;low result st Y+,XH ;high result jmp tbrun_loop bas_scale_e: pop YH pop YL jmp tbrun_wrongpar bas_cos: push ZH push ZL call expar_cos ;get cosinus pop ZL pop ZH ret ;----------------------------------------------------------------------- ; keyword is lfind ;----------------------------------------------------------------------- bas_lfind: rcall bas_getvar ;variable rcall bas_ispace cpi tempreg4,',' brne bas_lfind_err ldi XL,0x01 ;get 1 parameter ldi XH,0x01 rcall bas_getpar_0 lds XL,bas_partab rcall lfind bas_lfind_02: rcall bas_loadv st Y+,tempreg2 ;LOW value st Y+,const_0 ;HIGH is zero jmp tbrun_loop bas_lfind_err: ldi ereg,0x07 ;syntax error jmp tbrun_loop ;error ;----------------------------------------------------------------------- ; keyword is ashift ;----------------------------------------------------------------------- bas_ashift: rcall bas_getvar ;variable rcall bas_ispace cpi tempreg4,',' brne bas_lfind_err ldi XL,0x01 ;get 1 parameter ldi XH,0x01 rcall bas_getpar_0 lds ZL,bas_partab ;lo value lds ZH,bas_partab+1 ;hi value clt cpi ZH,0x80 brcs bas_ashift_01 com ZL inc ZL set bas_ashift_01: rcall bas_loadv ld XL,Y ldd XH,Y+1 bas_ashift_02: subi ZL,1 brcs bas_ashift_e brts bas_ashift_03 lsl XL rol XH rjmp bas_ashift_02 bas_ashift_03: mov r0,XH lsl r0 ror XH ror XL rjmp bas_ashift_02 bas_ashift_e: st Y,XL std Y+1,XH jmp tbrun_loop ;----------------------------------------------------------------------- ; XCALL with string as second parameter ;----------------------------------------------------------------------- bas_sxcall: ld tempreg1,Z+ cpi tempreg1,0x22 ;start of string brne bas_sxcall_en movw YL,ZL ;this points to the rest of basic line bas_sxcall_1: ld tempreg1,Z+ cpi tempreg1,0x22 ;end of string breq bas_sxcall_2 cpi tempreg1,0xff ;EOL brne bas_sxcall_1 bas_sxcall_2: movw r14,ZL lds tempreg1,bas_partab ;program number dec tempreg1 call mem_readf1 ;get first char lsr ZH ror ZL cpi tempreg1,'N' ;binary brne bas_sxcall_en lds XL,bas_partab+2 ;address offset sbrs tempreg2,4 ;skip if no exec flag? rjmp bas_sxcall_p3 ;is binary program add ZL,XL adc ZH,const_0 bas_sxcall_p3: adiw ZL,16 ;code offset set ;string mode icall jmp tbrun_loop bas_sxcall_en: jmp tbrun_wrongpar ;----------------------------------------------------------------------- ; find library ; XL=code, tempreg2=place or zero ;----------------------------------------------------------------------- lfind: ldi ZH,HIGH(bas_programs*2) ldi tempreg2,1 ;we start with one lfind_01: ldi ZL,0x0d ;ID offset lpm tempreg3,Z ;get flag byte sbrc tempreg3,3 ;skip if library rjmp lfind_02 ;no lib ldi ZL,0x0f ;ID byte lpm tempreg3,Z ;get ID cp tempreg3,XL brne lfind_02 lfind_01a: ret lfind_02: subi ZH,0xF4 ;PTR +3072 inc tempreg2 cpi tempreg2,9 brne lfind_01 ldi tempreg2,0 ret lcall: push tempreg1 dec tempreg1 andi tempreg1,0x07 ldi ZL,0x06 mul ZL,tempreg1 pop tempreg1 ldi ZL,LOW(bas_programs+8) ldi ZH,HIGH(bas_programs+8) add ZL,r0 adc ZH,r1 add ZL,tempreg2 adc ZH,const_0 ijmp ;----------------------------------------------------------------------- ; keyword is esput ;----------------------------------------------------------------------- bas_s2put: sbic GPIOR0,2 rjmp bas_s2put_1 ldi ereg,39 ;only m644p ret bas_s2put_1: rcall bas_expar bas_s2put_01: mov tempreg1,XL libmio_pser2 rcall bas_ispc cpi tempreg4,',' brne bas_s2put_ext rcall bas_ispace call expar rjmp bas_s2put_01 bas_s2put_ext: jmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is esget ;----------------------------------------------------------------------- bas_s2get: clr ctrl sbic GPIOR0,2 rjmp bas_s2get_1 ldi ereg,39 ;only m644p jmp tbrun_loop bas_s2get_1: libmio_gserb2 mov XL,tempreg1 clr XH bas_s2get_chk: lds tempreg1,libmio_keycode cpi tempreg1,0xed ;ESC brne bas_s2get_2 bas_s2get_esc: ldi XL,0xff ;-1 ldi XH,0xff bas_s2get_2: rcall bas_getvar ;get variable st Y+,XL ;low value st Y+,XH ;high value jmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is ebaud ;----------------------------------------------------------------------- bas_s2baud: rcall bas_get1 sbic GPIOR0,2 rjmp bas_s2baud_1 ldi ereg,39 ;only m644p ret bas_s2baud_1: libmio_baud2 jmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is baud ;----------------------------------------------------------------------- bas_baud: rcall bas_get1 andi XL,0x01 sts PCMSK0,XL jmp tbrun_mtest ;----------------------------------------------------------------------- ; keyword is wrap ;----------------------------------------------------------------------- bas_wrap: rcall bas_get1 bst XL,0 in XL,GPIOR2 bld XL,7 out GPIOR2,XL jmp tbrun_mtest ;----------------------------------------------------------------------- ; get one parameter ;----------------------------------------------------------------------- bas_get1: ldi XL,0x01 ldi XH,0x00 rcall bas_getpar ;get parameters cpi XL,0x01 ;min parameters brcc bas_getn_r ;<1 is not OK rjmp bas_getn_e ;----------------------------------------------------------------------- ; get two parameters ;----------------------------------------------------------------------- bas_get2: ldi XL,0x02 ldi XH,0x00 rcall bas_getpar ;get parameters cpi XL,0x02 ;min parameters brcc bas_getn_r ;<1 is not OK rjmp bas_getn_e ;----------------------------------------------------------------------- ; get three parameters ;----------------------------------------------------------------------- bas_get3: ldi XL,0x03 ldi XH,0x00 rcall bas_getpar ;get parameters cpi XL,0x03 ;min parameters brcc bas_getn_r ;<1 is not OK rjmp bas_getn_e ;----------------------------------------------------------------------- ; get four parameters ;----------------------------------------------------------------------- bas_get4: ldi XL,0x04 ldi XH,0x00 rcall bas_getpar ;get parameters cpi XL,0x04 ;min parameters brcs bas_getn_e ;<1 is not OK bas_getn_r: lds XL,bas_partab lds XH,bas_partab+1 ret bas_getn_e: pop XL pop XL jmp tbrun_wrongpar ;----------------------------------------------------------------------- ; external command ;----------------------------------------------------------------------- bas_ext: movw r14,ZL lds ZH,prg_basext sbrc ZH,7 rjmp bas_ext_ne ldi ZL,0x10 ;routine start icall cpi ereg,0 brne bas_ext_err ;abort with error jmp tbrun_loop bas_ext_ne: ldi ereg,8 ;unknown keyword bas_ext_err: ret bas_spisel: call bas_get1 ;get parameter mov tempreg1,XL ;copy to tr1 cpi tempreg1,0xff ;disable? brne bas_spisel_1 ;branch if not sbi PORTB,4 ;disable jmp tbrun_loop ;done bas_spisel_1: call libdfl_out ;output selector byte cbi PORTB,4 ;enable jmp tbrun_loop ;done sys_iocheck: push ZL push ZH set ;io enabled lds ZH,prg_xmem sbrc ZH,7 rjmp sys_iocheck_1 ;no xmem ldi ZL,0x0d lpm ZL,Z sbrs ZL,6 clt ;io disabled sys_iocheck_1: lds ZH,prg_vdrv sbrc ZH,7 rjmp sys_iocheck_2 ;no vdriver ldi ZL,0x0d lpm ZL,Z sbrs ZL,6 clt ;io disabled sys_iocheck_2: pop ZH pop ZL ret ;----------------------------------------------------------------------- ; tfind command ;----------------------------------------------------------------------- bas_tfind: rcall bas_getvar ;variable rcall bas_ispace cpi tempreg4,',' brne bas_tfind_err rcall bas_g2w ;pointers to Y and X movw r16,YL movw r18,XL rcall bas_loadv ;get var addr movw r4,YL ;store to temp register bas_tfind_01: clr tempreg3 bas_tfind_02: movw tempreg1,r16 ;haystack addr (HIGH) call arr_read_2 mov tempreg7,XL movw tempreg1,r18 ;needle addr call arr_read_2 mov XH,tempreg7 bas_tfind_03: cpi XL,0x20 ;end of needle? brcs bas_tfind_end ;OK,found cpi XH,0x20 ;end of haystack? brcs bas_tfind_no ;not found, if end cp XL,XH ;equal? brne bas_tfind_10 ;branch if not rcall bas_tnext inc tempreg3 rjmp bas_tfind_02 ;do char loop bas_tfind_10: sub r16,tempreg3 ;reset X pointer sbc r17,const_0 sub r18,tempreg3 ;reset Y pointer sbc r19,const_0 add r16,const_1 adc r17,const_0 rjmp bas_tfind_01 ;check at next position bas_tfind_no: ldi r16,0xff ;result is -1 (-1) ldi r17,0xff rjmp bas_tfind_sto bas_tfind_end: sub r16,tempreg3 sbc r17,const_0 bas_tfind_sto: movw YL,r4 ;get var addr st Y+,r16 ;set var value to result st Y+,r17 jmp tbrun_loop ;main loop bas_tfind_err: ldi ereg,7 ;syntax error ret ;----------------------------------------------------------------------- ; tlen command ;----------------------------------------------------------------------- bas_tlen: rcall bas_getvar ;variable rcall bas_ispace cpi tempreg4,',' brne bas_tfind_err movw r14,ZL ;new position call bas_get1 movw r18,XL clr r16 clr r17 rcall bas_loadv ;get var addr movw r4,YL ;store to temp register bas_tlen_1: movw tempreg1,r18 ;needle addr call arr_read_2 cpi XL,0x20 brcs bas_tfind_sto rcall bas_tnext rjmp bas_tlen_1 ;next text position bas_tnext: add r16,const_1 adc r17,const_0 sbrc r17,2 rjmp bas_tnext_err add r18,const_1 adc r19,const_0 sbrc r19,2 rjmp bas_tnext_err ret bas_tnext_err: pop ereg ;kill stack pop ereg ldi ereg,18 ;out of array ret