Subversion Repositories NedoOS

functionslist
        dw func_rnd
        db "$rnd",0
       
        dw -1 ;конец таблицы функций

getval_function
;hl'=text
        call eatword
        ld hl,functionslist ;list of internal commands
getval_function0
        ld c,(hl)
        inc hl
        ld b,(hl) ;адрес процедуры, соответствующей этой команде
        inc hl
        ld a,b
        cp -1
        jp z,fail_syntax ;ret z ;jr z,strcpexec_tryrun ;a!=0: no such internal command
        ld de,wordbuf
        push hl
        call strcp
        pop hl
        jr nz,getval_function_fail
        ld h,b
        ld l,c
        jp (hl) ;run internal command
getval_function_fail
        ld b,-1 ;чтобы точно найти терминатор
        xor a
        cpir ;найдём обязательно
        jr getval_function0

commandslist
        dw cmd_for
        db "for",0
        dw cmd_next
        db "next",0
       
        dw cmd_clear
        db "clear",0
        dw cmd_new
        db "new",0
        dw cmd_quit
        db "quit",0
        dw cmd_run
        db "run",0
        dw cmd_goto
        db "goto",0
        dw cmd_edit
        db "edit",0
        dw cmd_list
        db "list",0
        dw cmd_save
        db "save",0
        dw cmd_savecode
        db "savecode",0
        dw cmd_load
        db "load",0
        dw cmd_loadcode
        db "loadcode",0
        dw cmd_system
        db "system",0
        dw cmd_pause
        db "pause",0
       
        dw cmd_let
        db "let",0
        dw cmd_dim
        db "dim",0
        dw cmd_print
        db "print",0
        dw cmd_cls
        db "cls",0
        dw cmd_gfx
        db "gfx",0
        dw cmd_plot
        db "plot",0
        dw cmd_line
        db "line",0
       
        dw cmd_if
        db "if",0
        dw cmd_then
        db "then",0
        dw cmd_colon
        db ":",0
        dw cmd_rem
        db "rem",0
       
        dw -1 ;конец таблицы команд

docmd
;hl'=text
        exx
        push hl
        ld a,(curgfx)
        cp 6 ;textmode
        jr z,docmd_nogfx
        GET_KEY ;from BDOS
        jr docmd_nogfxq
docmd_nogfx
        GETKEY_ ;from stdin
docmd_nogfxq
        pop hl
        exx
        cp key_esc
        jp z,endbreak
        call eatword
        ld hl,commandslist ;list of internal commands
strcpexec0
        ld c,(hl)
        inc hl
        ld b,(hl) ;адрес процедуры, соответствующей этой команде
        inc hl
        ld a,b
        cp -1
        jp z,fail_syntax ;ret z ;jr z,strcpexec_tryrun ;a!=0: no such internal command
        ld de,wordbuf
        push hl
        call strcp
        pop hl
        jr nz,strcpexec_fail
        ld h,b
        ld l,c
        jp (hl) ;run internal command
strcpexec_fail
        ld b,-1 ;чтобы точно найти терминатор
        xor a
        cpir ;найдём обязательно
        jr strcpexec0
       
eat
;hl'=курсор
        exx
        inc hl
        call skipspaces
        exx
        ret

eatword
        exx
        ld de,wordbuf
        call getword
 ;Берем слово из (HL)-> wordbuf
        call skipspaces
 ; в (HL) пропускаем пробелы
        exx
        ret

eatclosebracket
        exx
        ld a,(hl)
        exx
        cp ')'
        jp nz,fail_syntax
        jp eat
       
eateq
        exx
        ld a,(hl)
        exx
        cp '='
        jp nz,fail_syntax
        jp eat
       
eatcomma
        exx
        ld a,(hl)
        exx
        cp ','
        jp nz,fail_syntax
        jp eat

cmd_pause
        exx
        push hl
        ld a,(curgfx)
        cp 6 ;textmode
        jr z,cmd_pause_nogfx
        YIELDGETKEYLOOP ;from BDOS
        jr cmd_pause_nogfxq
cmd_pause_nogfx
        call yieldgetkeyloop ;from stdin
cmd_pause_nogfxq
        pop hl
        exx
        ret

cmd_gfx
        call getexpr_dehl
        exx
        push hl
        exx
        ld a,l
        and 7
        ld e,a
         ld (curgfx),a
         cp 6
         jr nz,$+4
          ld e,-1 ;disable gfx (out: e=old gfxmode)
        OS_SETGFX
        pop hl
        exx
        ret

getexprcolor
;out: a=color = %33210210
        call getexpr_dehl
        ld a,l
        and 7
        ld d,a
        ld a,l
        and 15
        add a,a
        add a,a
        add a,a
        or d ;%.3210210
        rlca
        rlca ;%210210.3, CY=3
        rra  ;%3210210., CY=3
        rra  ;%33210210
        ret

cmd_line
;hl'=курсор
;line x2,y2,color
        call getexpr_dehl
        ld (cmd_line_x2),hl
        call eatcomma
        call getexpr_dehl
        ld (cmd_line_y2),hl
        call eatcomma
        call getexprcolor ;a=color = %33210210

        push af ;color
        call setpgs_scr
        pop af ;color
        ld bc,(cmd_plot_x)
        ld de,(cmd_plot_y)
cmd_line_x2=$+2
        ld ix,0
        ld (cmd_plot_x),ix
cmd_line_y2=$+1
        ld hl,0
        ld (cmd_plot_y),hl
;bc=x (в плоскости экрана, но может быть отрицательным)
;de=y (в плоскости экрана, но может быть отрицательным)
;ix=x2
;hl=y2
;a=color = %332103210
        exx
        push hl
        exx
        call shapes_line
        ;exx
        pop hl
        exx
        jp restorebasicpages
       
cmd_plot
;hl'=курсор
;plot x,y,color
        call getexpr_dehl
        ld (cmd_plot_x),hl
        call eatcomma
        call getexpr_dehl
        ld (cmd_plot_y),hl
        call eatcomma
        call getexprcolor
        ;ld lx,a ;lx=color = %33210210
        ld (prpixel_color_l),a
        ld (prpixel_color_r),a
cmd_plot_x=$+1
        ld hl,0
        ld bc,320
        or a
        sbc hl,bc
        add hl,bc
        ret nc
        ex de,hl
       
cmd_plot_y=$+1
        ld hl,0
        ld bc,200
        or a
        sbc hl,bc
        add hl,bc
        ret nc
;l=y
        call setpgs_scr
         ld b,d
         ld c,e
        ld e,l
        ld d,0
;bc=x ;de
;e=y ;c
;[lx=color = %33210210]
        call prpixel
        jp restorebasicpages

setpgs_scr
;setpgs_scr_low=$+1
        ld a,(user_scr0_low) ;ok
        SETPG32KLOW
;setpgs_scr_high=$+1
        ld a,(user_scr0_high) ;ok
        SETPG32KHIGH
        ret

       
scrbase=0x8000
shapes_line
;bc=x (в плоскости экрана, но может быть отрицательным)
;de=y (в плоскости экрана, но может быть отрицательным)
;ix=x2
;hl=y2
;a=color = %332103210
        ;ld (line_pixel_color),a
        ld (prpixel_color_l),a
        ld (prpixel_color_r),a
        or a
        sbc hl,de
        add hl,de
        jp p,shapes_line_noswap
        ex de,hl ;y <-> y2
        push ix
        push bc
        pop ix
        pop bc ;x <-> x2
shapes_line_noswap
        or a
        sbc hl,de ;dy >= 0
        push hl ;dy
        push ix
        pop hl
        sbc hl,bc
        push hl ;dx
        exx
        pop bc ;dx
        ld a,#03 ;inc bc
        jp p,shapes_line_nodec
        xor a
        sub c
        ld c,a
        sbc a,b
        sub c
        ld b,a ;dx >= 0
        ld a,#0b ;dec bc
shapes_line_nodec
        pop de ;dy
;a=код inc/dec bc
;bc'=x (в плоскости экрана, но может быть отрицательным)
;de'=y (в плоскости экрана, но может быть отрицательным)
;bc=dx
;de=dy
        ex de,hl
        or a
        sbc hl,bc
        add hl,bc
        ex de,hl
        jr nc,shapes_linever ;dy>=dx
        ld hy,b
        ld ly,c ;counter=dx
        ;inc iy ;inc hy ;рисуем, включая последний пиксель (учтено в цикле)
        ld h,b
        ld l,c
        sra h
        rr l ;ym=dx div 2 ;TODO а если dx<0?
         ;xor a
         ;sub l
         ;ld l,a
         ;sbc a,h
         ;sub l
         ;ld h,a ;mym=256-(dx div 2)
        exx
        ld (shapes_lineincx),a
;bc=x
;de=y
;hl'=xm
;bc'=dx
;de'=dy
shapes_linehor0
        call line_pixel
shapes_lineincx=$
        inc bc ;x+1        
        exx
        ;add hl,de ;mym+dy
        or a
        sbc hl,de ;ym-dy
        exx
        jr nc,shapes_linehor1
        inc de ;y+1
        exx
        ;or a
        ;sbc hl,bc ;mym-dx
        add hl,bc ;ym+dx
        exx
shapes_linehor1
        dec iy
        ld a,hy
        rla
        jp nc,shapes_linehor0
        ret
shapes_linever
        ld hy,d
        ld ly,e ;counter=dy
        ;inc iy ;inc hy ;рисуем, включая последний пиксель (учтено в цикле)
        ld h,d
        ld l,e
        sra h
        rr l
         ;xor a
         ;sub l
         ;ld l,a
         ;sbc a,h
         ;sub l
         ;ld h,a ;mxm=256-(dy div 2)
        exx
        ld (shapes_lineincx2),a
;bc=x
;de=y
;hl'=xm
;bc'=dx
;de'=dy
shapes_linever0
        call line_pixel
        inc de ;y+1
        exx
        ;add hl,bc ;mxm+dx
        or a
        sbc hl,bc ;xm-dx ;TODO а если dx<0?
        exx
        jr nc,shapes_linever1
shapes_lineincx2=$
        inc bc ;x+1
        exx
        ;or a
        ;sbc hl,de ;mxm-dy
        add hl,de ;xm+dy
        exx
shapes_linever1
        dec iy
        ld a,hy
        rla
        jp nc,shapes_linever0
        ret

line_pixel
;bc=x (может быть отрицательным)
;de=y (может быть отрицательным)
        ld hl,199
        or a
        sbc hl,de ;y
        ret c ;y>199
        ld hl,319
        or a
        sbc hl,bc ;x
        ret c ;x>319
        ;push bc
        ;push de
;        push ix
        ;ld a,e
        ;ld d,b
        ;ld e,c ;de=x
        ;ld c,a ;c=y
;line_pixel_color=$+2
;        ld lx,0
;de=x (не портится)
;c=y (bc не портится)
;lx=color = %33210210
        ;call prpixel
;        pop ix
        ;pop de
        ;pop bc
        ;ret
prpixel
;bc=x (не портится)
;e=y (de не портится)
;[lx=color = %33210210]
       ;ld a,d
        ld l,e
        ;ld h,0
        ;ld d,scrbase/256/8 ;h
        ld h,scrbase/256/32
        add hl,hl
        add hl,hl
        add hl,de
        add hl,hl
        add hl,hl
        add hl,hl ;y*40 + scrbase
       ;ld d,a
prpixel_cury
;bc=x (не портится)
;hl=addr(y)
;lx=color = %33210210
        ld a,b
        rra
        ld a,c
        rra
        jr c,prpixel_r
        rra
        jr nc,$+4
        set 6,h
        rra
        jr nc,$+4
        set 5,h
        and 0b00111111
        add a,l
        ld l,a
        adc a,h
        sub l
        ld h,a
prpixel_color_l=$+1
        ld a,0;lx
        xor (hl)
        and 0b01000111 ;keep left pixel
        xor (hl) ;right pixel from screen
        ld (hl),a
        ret
prpixel_r
        rra
        jr nc,$+4
        set 6,h
        rra
        jr nc,$+4
        set 5,h
        and 0b00111111
        add a,l
        ld l,a
        adc a,h
        sub l
        ld h,a
prpixel_color_r=$+1
        ld a,0;lx
        xor (hl)
        and 0b10111000 ;keep right pixel
        xor (hl) ;left pixel from screen
        ld (hl),a
        ret

cmd_system
;hl'=курсор
;system "command params"
        call getexpr_dehl
        bit 7,c
        jp z,fail_syntax
        exx
        push hl
        exx
;hl = wordbuf = string
        ld de,curdir ;DE = Pointer to 64 byte (MAXPATH_sz!) buffer
        OS_GETPATH
        OS_SETSYSDRV ;TODO каталог cmd
       
        ld de,tcmd
        OS_OPENHANDLE
        or a
        jp nz,fail_fo
        ld a,b
        ld (cmd_system_handle),a
        OS_NEWAPP
        or a
        jp nz,close_restoredir_fail
;dehl=номера страниц в 0000,4000,8000,c000 нового приложения, b=id, a=error
        push bc ;b=id
       
        ld a,d
        SETPGC000
        push de
        push hl
        ld hl,syscmdbuf
        ld de,0xc000+COMMANDLINE
        ld bc,COMMANDLINE_sz
        ldir ;command line
        xor a
        ld (0xc000+COMMANDLINE+COMMANDLINE_sz-1),a ;на случай, если "cmd "+wordbuf больше 128 байт
        pop hl
        pop de
cmd_system_handle=$+1
        ld b,0
        call readfile_pages_dehl
        call cmd_system_close_restoredir

        pop af ;a=id
        ld e,a
        push de
        OS_RUNAPP
        pop de
        WAITPID
        pop hl
        exx
        ret
       
cmd_system_close_restoredir
        ld a,(cmd_system_handle)
        ld b,a
        OS_CLOSEHANDLE
        ld de,curdir
        OS_CHDIR
        jp restorebasicpages
       
close_restoredir_fail
        call cmd_system_close_restoredir
        jp fail_fo

popret
        pop af
        ret
readfile_pages_dehl
        ld a,d
        push bc
        SETPGC000
        pop bc
         ld a,e
         push af
        ld a,+(#c000+PROGSTART)/256
        call cmd_loadpage
        jr nz,popret
         pop af ;e
        call cmd_setpgloadpage
        ret nz
        ld a,h
        call cmd_setpgloadpage
        ret nz
        ld a,l
cmd_setpgloadpage
        push bc
        SETPGC000
        pop bc
        ld a,0xc000/256
cmd_loadpage
;a=loadaddr/256
;b=handle
;out: de=bytes read, NZ=end of file
;keeps hl,bc
        push bc
        push hl
        ld d,a
        ld e,0
        ld hl,0
        or a
        sbc hl,de
;B = file handle, DE = Buffer address, HL = Number of bytes to read
        push hl
        OS_READHANDLE
;HL = Number of bytes actually read, A=error(=0)
        ex de,hl
        pop hl
        or a
        sbc hl,de ;Number of bytes to read - Number of bytes actually read
        pop hl
        pop bc
        ret


tcmd
        db "cmd.com",0
       
       
cmd_loadcode
;hl'=курсор
;load "name.bas"
        call getexpr_dehl
        bit 7,c
        jp z,fail_syntax
        call cmd_load_hl
;нельзя выходить по ret, потому что старая программа уничтожена
        jp endofprog
       
cmd_load_hl
;hl = wordbuf = filename
        ;exx
        ;ld a,(hl)
        ;exx
        ;cp '"'
        ;jp nz,fail
        ;call readstr
        ;jp c,fail
;wordbuf = filename
        ;ld de,wordbuf ;de=drive/path/file
        ex de,hl
        OS_OPENHANDLE
;b=new file handle
        or a
        jp nz,fail_fo
        ld de,progmem
        ld hl,szprogmem
;B = file handle, DE = Buffer address, HL = Number of bytes to read
        push bc
        OS_READHANDLE
        pop bc
;HL = Number of bytes actually read, A=error
        ld de,progmem
        add hl,de
        ld (progend),hl
        OS_CLOSEHANDLE        
        call cmd_clear
        ret

cmd_load
;hl'=курсор
;load "name.bas"
        call getexpr_dehl
        bit 7,c
        jp z,fail_syntax
        call cmd_load_text
;нельзя выходить по ret, потому что старая программа уничтожена
        jp endofprog

cmd_load_text
;hl = wordbuf = filename
        ;ld de,wordbuf ;de=drive/path/file
        ex de,hl
        OS_OPENHANDLE
;b=new file handle
        or a
        jp nz,fail_fo

read_next_str
        ld de,cmdbuf
        ld hl,1
read_fsmb
;B = file handle, DE = Buffer address, HL = Number of bytes to read
        push bc
        push de
        OS_READHANDLE
        pop de
        pop bc
        ld a,l
        or a
        jp z,endfile ;Если не прочитали = конец файла - выходим
        ld a,(de)
        cp 0x0A
        jp z,end_read ; Новая строка определяется по 0x0A
        ld a,(de)
        cp 0x0D
        jp z,read_fsmb ; Просто проглатываем символ возврата каретки
        inc de
        jp read_fsmb

end_read
        xor a
        ld (de),a ;ставим терминатор в строку
        ld hl,cmdbuf
 
        ex de,hl
        ;or a
        sbc hl,de ;вычисляем длину строки
        jp z, read_next_str ; если пустая строка, читаем следующую
        ex de,hl ;возвращаем на место hl=cmdbuf
        push bc ; На всякий случай сохраняем file handle, мало ли чего...
        call add_or_run_line
        pop bc
        jp read_next_str

endfile
        OS_CLOSEHANDLE
        ld hl,cmdbuf; иначе в командной строке последняя загруженная из файла команда
        ld (hl),0
        jp cmd_clear

cmd_savecode ; оригинальная процедура быстрой выгрузки программы в файл
;hl'=курсор
;save "name.bas"
        call getexpr_dehl
        bit 7,c
        jp z,fail_syntax
        ;exx
        ;ld a,(hl)
        ;exx
        ;cp '"'
        ;jp nz,fail
        ;call readstr
        ;jp c,fail
;wordbuf = filename
        ;ld de,wordbuf ;de=drive/path/file
        ex de,hl
        OS_CREATEHANDLE
;b=new file handle
        or a
        jp nz,fail_fo
        ld hl,(progend)
        ld de,progmem
        ;or a
        sbc hl,de
;B = file handle, DE = Buffer address, HL = Number of bytes to write
        push bc
        OS_WRITEHANDLE
        pop bc
        OS_CLOSEHANDLE
        ld hl,cmdbuf ; курсор на начало буфера
        ld (hl),0
        exx
        ret

cmd_save
;hl'=курсор
;save "name.bas"
        call getexpr_dehl
        bit 7,c
        jp z,fail_syntax
        ex de,hl
;de=drive/path/file
        OS_CREATEHANDLE
        push bc ;filehandle
        ;display cmd_save, " cmd_save"
        ;display cmdbuf, " cmdbuf"
       
;b=new file handle
        or a
        jp nz,fail_fo
;формат строк: номер строки(ст,мл), длина строки(мл,ст), строка(asciiz)
        ld hl,progmem
save_lines0
        ld de,(progend)
        or a
        sbc hl,de
        add hl,de
        jr z,save_end
       
        push hl ;Проверка на нажатие брик
        GETKEY_
        pop hl
        cp key_esc
        jp z,endbreak

        ld d, (hl) ; загружаем в DE номер строки
        inc hl
        ld e, (hl)
        inc hl

        push hl ; продолжение строки
        push de ; номер в hex
        ld hl,cmdbuf ; надо загрузить в hl' буфер куда положить уже текстовый номер строки
        exx ; в hl' теперь номер
        pop de ; номер в hex
        call prlinenum_tomem ; hl' куда, de номер в hex
        exx
        ex hl,de ; de на продолжение cmdbuf
        pop hl; продолжание строки

        ld a,' ' ; пробел
        ld (de),a
        inc de
        ld c,(hl) ;длина строки
        inc hl
        ld b,(hl) ;длина строки
        inc hl
        ldir      ;копируем всю строку в de
        ld a,0x0D
        ld (de),a
        inc de
        ld a,0x0A
        ld (de),a
        inc de
        inc hl; пропускаем терминатор

        pop bc ; достаем filehandle
        push bc ;filehandle нам ещё пригодится
        push hl ;там следующая строка
        ld hl,cmdbuf
        ex hl,de
        sbc hl,de ; в hl длина получившейся текстовой строки
        ld de,cmdbuf ; в de адрес самой строки

;B = file handle, DE = Buffer address, HL = Number of bytes to write
        OS_WRITEHANDLE
        pop hl ; следующая строка
        jr save_lines0
save_end
        pop bc
        OS_CLOSEHANDLE
        ld hl,cmdbuf
        ld (hl),0 ; очищаем командную строку
        exx ; hl' курсор на начало буфера
        ret
       
cmd_new
        ld hl,progmem
        ld (progend),hl
        call cmd_clear
        jp endofprog

cmd_clear
        ld hl,varmem
        ld (varend),hl
        ld hl,varindex_int
        ld de,varindex_int+1
        ld bc,511
        ld (hl),l;0
        ldir
        ret
       
cmd_rem
        jp gotonextline
       
cmd_for
;hl'=курсор
;for i=1 to 10 step 2
;параметры цикла (4+4(step)+4(to)+4(goto) байта)
        exx
        ld a,(hl)
        exx
        ld c,a ;имя
        call eat
       
        ld a,c
        call findvar_index
        jr nz,cmd_for_nocreate
        ld hl,(varend)
        push hl
        ld de,4*4
        add hl,de
        ld (varend),hl
        pop de
;de=addr
        ld h,varindex_int/256
        ld l,c
        ld (hl),e
        inc h
        ld (hl),d
cmd_for_nocreate

        call eateq
        push bc
        call getexpr_dehl
        pop bc
        ld a,c
        call setvar_int
       
        call eatword ;to
       
        push bc
        call getexpr_dehl
        pop bc
        push de ;HSW
        push hl ;LSW
        ld a,c
        call findvar_index
        ld de,4+4
        add hl,de
        pop de ;LSW
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        pop de ;HSW
        ld (hl),e
        inc hl
        ld (hl),d
       
        call eatword ;step
       
        push bc
        call getexpr_dehl ;dehl=step
        pop bc
       
        ld a,h
        or l
        or d
        or e
        jp z,fail_syntax
               
        push de ;HSW
        push hl ;LSW
        ld a,c
        call findvar_index
        ld de,4
        add hl,de
        pop de ;LSW
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        pop de ;HSW
        ld (hl),e
        inc hl
        ld (hl),d
       
        ld a,c
        call findvar_index
        ld de,4+4+4
        add hl,de
;currunline=$+1
        ;ld de,0
        ;inc de
        exx
        push hl
        exx
        pop de
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        ld (hl),0
        inc hl
        ld (hl),0

        ret
       
cmd_next
;hl'=курсор
;next i (i = i+step, if i<=to then goto...)
        exx
        ld a,(hl)
        exx
        ld c,a ;имя
        call eat
       
        ld a,c
        call findvar_index
        jp z,fail_syntax
       
        push hl
        ld c,(hl)
        inc hl
        ld b,(hl)
        inc hl
        ld e,(hl)
        inc hl
        ld d,(hl)
        inc hl ;debc = i
       
        ld a,(hl)
        add a,c
        ld c,a
        inc hl
        ld a,(hl)
        adc a,b
        ld b,a
        inc hl
        ld a,(hl)
        adc a,e
        ld e,a
        inc hl
        ld a,(hl)
        adc a,d
        ld d,a ;debc = i = i+step
       
        ex (sp),hl
        ld (hl),c
        inc hl
        ld (hl),b
        inc hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        pop hl
       
        bit 7,(hl) ;step>=0?
        push af
        inc hl
       
;to>=i?
        ld a,(hl)
        sub c
        ld c,a
        inc hl
        ld a,(hl)
        sbc a,b
        ld b,a
        inc hl
        ld a,(hl)
        sbc a,e
        ld e,a
        inc hl
        ld a,(hl)
        sbc a,d
        ld d,a
        inc hl
;debc = to-i
;TODO знаковое переполнение
        pop af ;NZ = step<0
        call nz,negdebc
;i<=to (to-i >= 0) - continue loop
        bit 7,d ;Z = to-i>=0
        ret nz ;end of loop
        call getint ;hl=адрес после for ;было dehl=номер строки
        exx
        ret
        ;jp cmd_goto_ok
       
cmd_dim
;hl'=курсор
;dim a(15) - нумерация элементов с нуля
        exx
        ld a,(hl)
        exx
        ld c,a ;имя
        call eat
       
        ld a,c
        call findvar_array
        jp nz,fail_syntax ;уже есть такая переменная

        exx
        ld a,(hl)
        exx
        cp '('
        jp nz,fail_syntax
        call eat
        push bc
        call getexpr_dehl
        pop bc
        call eatclosebracket
       
        ex de,hl ;de=size

;c=name (char)
        ld hl,(varend)
        push hl
        ld (hl),e
        inc hl
        ld (hl),d
        inc hl
        add hl,de
        add hl,de
        add hl,de
        add hl,de
        ld (varend),hl
        pop de
;de=addr
        ld h,varindex_int/256
        ld l,c
        ld (hl),e
        inc h
        ld (hl),d
        ret
       
cmd_edit
;hl'=курсор
        call getexpr_dehl
        ex de,hl
        call findline ;de номер
        ld a,(hl)
        cp d
        jp nz,fail_syntax
        inc hl
        ld a,(hl)
        cp e
        jp nz,fail_syntax
        ;hl=адрес строки, которую надо взять + 1
        inc hl
        inc hl
        inc hl
       
        push hl
        exx
        ld hl,cmdbuf
        exx
        call prlinenum_tomem ;de номер
        exx
        ld (hl),' '
        inc hl
        push hl
        exx
        pop de ;cmdbuf+номер
        pop hl ;hl=адрес строки (текст)
       
        push hl
        call strlen
        ld b,h
        ld c,l
        inc bc ;длина с терминатором
        pop hl
       
        ;ld de,cmdbuf
        ;ld bc,MAXCMDSZ+1
        ldir
        jp endofedit
       
cmd_then
cmd_colon
        ret
       
cmd_list
;номер строки(ст,мл), длина строки(мл,ст), строка(asciiz)
        ld hl,progmem ; progmem константа задающая начало памяти программы
list_lines0
        ld de,(progend) ; по адресу progend находится переменная указывающая на конец памяти программы
        or a
        sbc hl,de
        add hl,de
        ret z
       
        push hl ;Проверка на нажатие брик
        GETKEY_
        pop hl
        cp key_esc
        jp z,endbreak

        ld d,(hl)
        inc hl
        ld e,(hl) ;номер строки
        inc hl
        push hl
        call prword_de ;номер строки
        ld a,' '
        PRCHAR_
        pop hl

        ;ld e,(hl)
        inc hl
        ;ld d,(hl) ;длина строки
        inc hl
        call prtext ;hl after terminator
        call prcrlf

        jr list_lines0
       
       
        macro STRPUSH
;hl=string addr
        xor a
        push af
         ld a,(hl)
         inc hl
         or a
         push af
        jr nz,$-4
        pop af
;в стеке лежит \0, текст (без терминатора)
        endm
       
        macro STRPOP
;hl=string addr
        ld d,h
        ld e,l
         pop af
         ld (hl),a
         inc hl
         or a
        jr nz,$-4
        ex de,hl
        call strmirror
        endm
       
strmirror
;hl=string addr
        ld d,h
        ld e,l
        call strlen
        ld b,h
        ld c,l
;de=начало, bc=hl=длина
        ;ld h,b
        ;ld l,c
        add hl,de ;hl=конец+1
        srl b
        rr c ;bc=wid/2
mirrorbytes0
        dec hl
        ld a,(de)
        ldi
        dec hl
        ld (hl),a
        jp pe,mirrorbytes0
        ret
       

cmd_let
;hl'=курсор
        exx ;ld hl,(execcmd_pars)
        ld a,(hl)
        exx
        ld c,a
        exx
        inc hl ;call eat
        ld a,(hl)
        exx
        cp '$'
        jr z,cmd_let_str
        cp '('
        jr z,cmd_let_array
;hl'=курсор
        call eatspaces
        call eateq
        ld a,c
        call findvar_int
        jr nz,cmd_let_createq
        ld a,c
        call addvar_int
cmd_let_createq
        push bc
        call getexpr_dehl ;dehl=value
        pop bc ;иначе выражение может запороть c
        ld a,c
        call setvar_int ;TODO не искать переменную второй раз
        ret

cmd_let_array
        call eat ;skip '(' and spaces
        push bc
        call getexpr_dehl
        pop bc
        call eatclosebracket
        ld a,c
        call findvar_int
        jp z,fail_syntax
        call indexarray
        push hl ;адрес элемента
        call eateq
        call getexpr_dehl
        ld b,h
        ld c,l ;debc
        pop hl ;адрес элемента
        ld (hl),c
        inc hl
        ld (hl),b
        inc hl
        ld (hl),e
        inc hl
        ld (hl),d
        ret
       
cmd_let_str
        call eat ;skip '$' and spaces
        exx
        ld a,(hl)
        exx
        cp '('
        jr z,cmd_let_strarray
        ld a,c
        call findvar_str
        jr nz,cmd_let_str_createq
        ld a,c
        call addvar_str
cmd_let_str_createq
;hl'=курсор
        call eateq
        exx
        ld a,(hl)
        exx
        cp '"'
        jp nz,fail_syntax
       
        call readstr ;hl=str, hl'=after num and spaces, CY=error
        jp c,fail_syntax
       
        ;ld hl,wordbuf
        ;STRPUSH
       
        ;ld hl,wordbuf
        ld a,c
        call setvar_str
       
        ;ld hl,wordbuf
        ;STRPOP
       
        ret

cmd_let_strarray
        call eat ;skip '(' and spaces
        push bc
        call getexpr_dehl ;dehl=index
        pop bc
        call eatclosebracket
        call eateq
       ex de,hl
        ld a,c
        call findvar_str ;hl=str
        jp z,fail_syntax
        ld a,d ;de=index
        or a
        jp nz,fail_syntax ;range check
        add hl,de
        push hl ;addr in str
        call getexpr_dehl ;dehl=char
        ld a,l
        pop hl ;addr in str      
        ld (hl),a
        ret
       
cmd_cls
        exx
        push hl
        ld e,0;COLOR
        OS_CLS
        pop hl
        exx
        ret

cmd_if
;hl'=курсор
        call getexpr_dehl
        ld a,h
        or l
        or d
        or e
        ret nz ;true = continue this line
gotonextline
        exx
        xor a
        ld bc,0
        cpir
        dec hl ;на терминаторе 
        ld a,(runmode)
        cp RUNMODE_PROG
        jr nz,gotonextlineq
        inc hl ;после строки
        call startline
gotonextlineq
        exx
        ret
       
cmd_goto
;hl'=курсор
        call getexpr_dehl
        ex de,hl
;cmd_goto_ok
;de=номер строки
        call findline ;de номер
        call startline
        exx
        ld a,RUNMODE_PROG
        ld (runmode),a
        ret


cmd_run
;нельзя выходить по ret, потому что run могли вызвать из обработчика командной строки
        ld a,RUNMODE_PROG
        ld (runmode),a
        ld hl,progmem
        jr cmd_run_startline
cmd_run0
;hl'=адрес строки
        exx
        ld a,(hl)
        or a
        jr nz,cmd_run_nonextline
runmode=$+1
        ld a,0
        cp RUNMODE_INTERACTIVE
        jp z,endofprog ;ret z ;end of line in interactive mode
        inc hl
cmd_run_startline
        call startline
cmd_run_nonextline
        exx
        call docmd
        jr cmd_run0

startline
        ld bc,(progend)
        or a
        sbc hl,bc
        add hl,bc
        jp nc,endofprog ;ret nc ;end of program
        ;ld d,(hl)
        inc hl
        ;ld e,(hl)
        inc hl
        ;ld (currunline),de
        ;ld e,(hl)
        inc hl
        ;ld d,(hl) ;line size
        inc hl
        ret
       
eatcolon
;out: z=end of command
        exx
        ld a,(hl)
        exx
        or a
        ret z
        cp ':'
        ret nz
        call eat
        xor a ;Z
        ret
       
cmd_print
;hl'=курсор
        call eatcolon
        jp z,prcrlf
cmd_print0
        exx
        ld a,(hl)
        exx
        cp ';'
        jp z,cmd_print_semicolon
        call getexpr_dehl
        call prval_dehl
        jr cmd_print
cmd_print_semicolon
        call eat
        call eatcolon
        jr nz,cmd_print ;TODO cmd_print0?
        ret
       
getexpr_dehl
;out: dehl=value, c=type
        call getaddexpr
getexpr0
        exx
        ld a,(hl)
        exx
        ;cp ','
        ;ret z ;jp z,eat
        ;cp ')'
        ;ret z ;jp z,eat
        ;cp ':' ;call eatcolon
        ;ret z
        ;or a
        ;ret z
        cp '='
        jr z,getexpr_eq
        cp '>'
        jr z,getexpr_more
        cp '<'
        jr z,getexpr_less
        ret
       
getexpr_eq
        call eat
        call getexpr_eq_subr
        jr getexpr0
       
getexpr_more
        call eat
        exx
        ld a,(hl)
        exx
        cp '='
        jr z,getexpr_moreeq
        call getexpr_more_subr
        jr getexpr0

getexpr_less
        call eat
        exx
        ld a,(hl)
        exx
        cp '='
        jr z,getexpr_lesseq
        cp '>'
        jr z,getexpr_noteq
        call getexpr_less_subr
        jr getexpr0
       
getexpr_noteq
        call eat
        call getexpr_eq_subr
        call loginv
        jr getexpr0

getexpr_moreeq
        call eat
        call getexpr_less_subr
        call loginv
        jr getexpr0

getexpr_lesseq
        call eat
        call getexpr_more_subr
        call loginv
        jr getexpr0

getexpr_more_subr        
;old > new: new-old = CY
        push bc
        push de ;HSW
        push hl ;LSW
        call getaddexpr
        pop bc ;LSW
        or a
        sbc hl,bc
        pop bc ;HSW
        ex de,hl
        sbc hl,bc
        ex de,hl
        pop bc
        ld hl,0
        ld de,0
        ret nc
        dec hl
        dec de ;old > new
        ret
       
getexpr_less_subr
;old < new: old-new = CY
        push bc
        push de ;old HSW
        push hl ;old LSW
        call getaddexpr
        pop bc ;old LSW
        pop af ;old HSW
        push de ;new HSW
        push hl ;new LSW
        push af ;old HSW
        push bc ;old LSW
        pop hl ;old LSW
        pop de ;old HSW
       
        pop bc ;LSW
        or a
        sbc hl,bc
        pop bc ;HSW
        ex de,hl
        sbc hl,bc
        ex de,hl
        pop bc
        ld hl,0
        ld de,0
        ret nc
        dec hl
        dec de ;old < new
        ret

getexpr_eq_subr
        push bc
        push de ;HSW
        push hl ;LSW
        call getaddexpr
        pop bc ;LSW
        or a
        sbc hl,bc
        pop bc ;HSW
        ex de,hl
        sbc hl,bc
        ex de,hl
        ld a,d
        or e
        or h
        or l
        pop bc
        ld hl,0
        ld de,0
        ret nz
        dec hl
        dec de ;old = new
        ret
       
getaddexpr
        call getmulexpr
getaddexpr0
        exx
        ld a,(hl)
        exx
        ;or a
        ;ret z
        ;cp ')'
        ;ret z ;jp z,eat
        ;cp ','
        ;ret z ;jp z,eat
        ;cp ':' ;call eatcolon
        ;ret z
        cp '+'
        jr z,getaddexpr_plus
        cp '-'
        jr z,getaddexpr_minus
        ret
       
getaddexpr_plus
        call eat
        push bc
        push de ;HSW
        push hl ;LSW
        call getmulexpr
        pop bc ;LSW
        add hl,bc
        pop bc ;HSW
        ex de,hl
        adc hl,bc
        ex de,hl
        pop bc
        jr getaddexpr0
       
getaddexpr_minus
        call eat
        push bc
        push de ;HSW
        push hl ;LSW
        call getmulexpr
        pop bc ;LSW
        or a
        sbc hl,bc
        pop bc ;HSW
        ex de,hl
        sbc hl,bc
        ex de,hl
        call negdehl
        pop bc
        jr getaddexpr0

getmulexpr
        call getval_dehl_
getmulexpr0
        exx
        ld a,(hl)
        exx
        ;or a
        ;ret z
        ;cp ')'
        ;ret z ;jp z,eat
        ;cp ','
        ;ret z ;jp z,eat
        ;cp ':' ;call eatcolon
        ;ret z
        cp '*'
        jr z,getmulexpr_mul
        cp '/'
        jr z,getmulexpr_div
        ret
       
getmulexpr_div
        call eat
        push bc
        push de ;HSW old
        push hl ;LSW old
        call getval_dehl_
        push de ;HSW new
        push hl ;LSW new
        exx
        pop ix ;LSW new
        pop bc ;HSW new
        pop de ;LSW old
        ex (sp),hl ;pop hl ;HSW old
        call _DIVLONG. ;hl, de / bc, ix ;out: hl(high), de(low)
       ex de,hl ;dehl
        exx
        pop hl ;курсор
        exx
        pop bc
        jr getmulexpr0

getmulexpr_mul
        call eat
        push bc
        push de ;HSW
        push hl ;LSW
        call getval_dehl_
        pop ix ;LSW
        pop bc ;HSW
       ex de,hl ;hl,de
        call _MULLONG.
       ex de,hl ;dehl
        pop bc
        jr getmulexpr0
       
;hl, de / bc, ix
;out: hl(high), de(low)
_DIVLONG.
        ;EXPORT _DIVLONG.
        ld a,h
        xor b
        push af
        xor b
        call m,div_neghlde
        ld a,b
        rla
        jr nc,divlongnonegbcix
        xor a
        sub lx
        ld lx,a
        ld a,0
        sbc a,hx
        ld hx,a
        ld a,0
        sbc a,c
        ld c,a
        ld a,0
        sbc a,b
        ld b,a
divlongnonegbcix
;unsigned!!!
;hl'hl,de'de <= hlde,bcix:
        push bc
        exx
        pop de ;de' = "bc_in"
        ld hl,0
        exx
        ld a,e
        ex af,af' ;' ;e_in
        push de ;d_in
        ld c,l ;l_in
        ld a,h ;h_in
        ld hl,0
        push ix
        pop de ;de = "ix_in"
        ;a="h_in"
;hl'hla <= 0000h_in
        call _DIVLONGP. ;"h"
        ld b,c ;"l_in"
        ld c,a ;"h"
        ld a,b ;a="l_in"
;hl'hla <= 000hl_in
        call _DIVLONGP. ;"l"
        ld b,a ;"l"
        pop af ;a="d_in"
        push bc ;b="l"
;hl'hla <= 00hld_in
        call _DIVLONGP. ;"d"
        ex af,af' ;a="e_in", a'="d"
        ;a="e_in"
;hl'hla <= 0hlde_in
        call _DIVLONGP. ;"e"
        ld e,a ;"e"
        ex af,af' ;' ;"d"
        ld d,a
        pop hl ;h="l"
        ld l,h
        ld h,c ;"h"
       
        pop af
        ret p
div_neghlde
        xor a
        sub e
        ld e,a
        ld a,0
        sbc a,d
        ld d,a
        ld a,0
        sbc a,l
        ld l,a
        ld a,0
        sbc a,h
        ld h,a
        ret

;a = hl'hla/de'de
;c not used
_DIVLONGP.
;do 8 bits
        ld b,8
_DIVLONG0.
;shift left hl'hla
        rla
        adc hl,hl
        exx
        adc hl,hl
        exx
;no carry
;try sub
        sbc hl,de
        exx
        sbc hl,de
        exx
        jr nc,$+2+1+1+2+1
        add hl,de
        exx
        adc hl,de
        exx
;carry = inverted bit of result
        djnz _DIVLONG0.
        rla
        cpl
        ret
       
;hl, de * bc, ix
;out: hl(high), de(low)
_MULLONG.
        ;EXPORT _MULLONG.
;signed mul is equal to unsigned mul
;hlde*bcix = hlde*b000 + hlde*c00 + hlde*i0 + hlde*x
        ld a,lx
        push af ;lx
        push ix ;hx
        ld a,c
        push af ;c
        ld a,b
;bcde <= hlde:
        ld b,h
        ld c,l
;hlix <= 0
        ld hl,0
        ;ld ix,0
        push hl
        pop ix
        call _MULLONGP. ;hlix = (hlix<<8) + "b*hlde"
        pop af ;c
        call _MULLONGP. ;hlix = (hlix<<8) + "c*hlde"
        pop af ;hx
        call _MULLONGP. ;hlix = (hlix<<8) + "hx*hlde"
        pop af ;lx
        call _MULLONGP. ;hlix = (hlix<<8) + "lx*hlde"
        push ix
        pop de
        ret
;hlix = (hlix<<8) + a*bcde
_MULLONGP.
        exx
        ld b,8
_MULLONG0.
        exx
        add ix,ix
        adc hl,hl
        rla
        jr nc,$+2+2+2
        add ix,de
        adc hl,bc
        exx
        djnz _MULLONG0. ;можно по a==0 (первый вход с scf:rla, далее add a,a)
        exx
        ret


       
getval_unaryminus
        call eat
        call getval_dehl_
        jp negdehl
getval_bracket
        call eat
        call getexpr_dehl
        jp eatclosebracket
       
getval_dehl_
;hl'=курсор
;out: dehl=value, c=type
        exx
        ld a,(hl)
        exx
        cp '$'
        jp z,getval_function
        cp '-'
        jr z,getval_unaryminus
        cp '('
        jr z,getval_bracket
        cp '"'
        jp z,getval_str
        sub '0'
        cp 10
        jr c,getval_num_dehl
        exx
        ld a,(hl)
        exx
        ld c,a ;name
        exx
        inc hl ;call eat
        ld a,(hl)
        exx
        cp '$'
        jr z,getval_varstr
        cp '('
        jr z,getval_vararray
        call eatspaces
        ld a,c
        call findvar_int
        jp z,fail_syntax
        ;ld a,c
        ;call getvar_int
        call getint
        res 7,c ;ld c,0 ;int
        ret
getval_varstr
        call eat ;skip '$' and spaces
        exx
        ld a,(hl)
        exx
        cp '('
        jr z,getval_varchararray        
        ld a,c
        call findvar_str
        jp z,fail_syntax
        ;ld a,c
        ;call getvar_str
        set 7,c ;ld c,128 ;str
        ret
getval_varchararray
        call eat
        push bc
        call getexpr_dehl
        pop bc
        call eatclosebracket
       ex de,hl ;de=index
        ld a,c
        call findvar_str
        jp z,fail_syntax
        ld a,d ;de=index
        or a
        jp nz,fail_syntax ;range check
        add hl,de
        ld l,(hl)
        ld de,0
        ld h,d ;dehl=char
        res 7,c ;ld c,0 ;int
        ret
getval_vararray
        call eat
        push bc
        call getexpr_dehl
        pop bc
        call eatclosebracket
       ex de,hl ;de=index
        ld a,c
        call findvar_array
        jp z,fail_syntax
        call indexarray
        call getint
        res 7,c ;ld c,0 ;int
        ret
getval_num_dehl
        call readnum_dehl ;dehl=num, hl'=after num and spaces, CY=error
        jp c,fail_syntax
        res 7,c ;ld c,0 ;int
        ret
getval_str
        call readstr ;hl=str, hl'=after str and spaces, CY=error
        jp c,fail_syntax
        set 7,c ;ld c,0 ;str
        ret

prval_dehl
;dehl=value, c=type
        exx
        push hl
        exx
        bit 7,c
        jr nz,prval_str
        call prdword_dehl
        pop hl
        exx
        ret
prval_str
        call prstr_withlen
        pop hl
        exx
        ret


readstr
;hl'=курсор (указывает на открывающую кавычку)
;out: hl=str, hl'=after num and spaces, CY=error
        exx
        inc hl
        ld de,wordbuf
;TODO проверка длины
quote_getword0
        ld a,(hl)
        or a
        ccf
        ret z ;CY=error
        ;jp z,fail ;jr z,quote_getwordq
        sub '"'
        jr z,quote_getwordq
        ldi
        jp quote_getword0
quote_getwordq
        xor a
        ld (de),a
        exx
        call eat ;съедаем кавычку и последующие пробелы
        ld hl,wordbuf
        or a ;NC = OK
        ret ;NC

indexarray
;hl=адрес массива
;de=индекс
;c=имя массива?
;out: hl=адрес элемента (fail, если out of bounds)
        push bc
        ld c,(hl)
        inc hl
        ld b,(hl)
        inc hl
        ex de,hl
        or a
        sbc hl,bc
        add hl,bc
        ex de,hl
        pop bc
        jp nc,fail_syntax ;range check
        add hl,de
        add hl,de
        add hl,de
        add hl,de
        ret

func_rnd
;Patrik Rak
rndseed1=$+1
        ld  hl,0xA280   ; xz -> yw
rndseed2=$+1
        ld  de,0xC0DE   ; yw -> zt
        ld  (rndseed1),de  ; x = y, z = w
        ld  a,e         ; w = w ^ ( w << 3 )
        add a,a
        add a,a
        add a,a
        xor e
        ld  e,a
        ld  a,h         ; t = x ^ (x << 1)
        add a,a
        xor h
        ld  d,a
        rra             ; t = t ^ (t >> 1) ^ w
        xor d
        xor e
        ld  h,l         ; y = z
        ld  l,a         ; w = t
        ld  (rndseed2),hl
        ex de,hl
        ld hl,0
        res 7,c ;int
        ret