diff --git a/programs/develop/SPForth/debug.inc b/programs/develop/SPForth/debug.inc deleted file mode 100644 index 1f43e064a7..0000000000 --- a/programs/develop/SPForth/debug.inc +++ /dev/null @@ -1,137 +0,0 @@ -macro debug_print str -{ - local ..string, ..label - - jmp ..label - ..string db str,0 - ..label: - - pushf - pushad - mov edx,..string - call debug_outstr - popad - popf -} - -dps fix debug_print - -macro debug_print_dec arg -{ - pushf - pushad - if ~arg eq eax - mov eax,arg - end if - call debug_outdec - popad - popf -} - -dpd fix debug_print_dec - -;--------------------------------- -debug_outdec: ;(eax - num, edi-str) - push 10 ;2 - pop ecx ;1 - push -'0' ;2 - .l0: - xor edx,edx ;2 - div ecx ;2 - push edx ;1 - test eax,eax ;2 - jnz .l0 ;2 - .l1: - pop eax ;1 - add al,'0' ;2 - call debug_outchar ; stosb - jnz .l1 ;2 - ret ;1 -;--------------------------------- - -debug_outchar: ; al - char - pushf - pushad - mov cl,al - mov eax,63 - mov ebx,1 - int 0x40 - popad - popf -ret - -debug_outstr: - mov eax,63 - mov ebx,1 - @@: - mov cl,[edx] - test cl,cl - jz @f - int 40h - inc edx - jmp @b - @@: - ret - -_debug_crlf db 13, 10, 0 - -macro newline -{ - pushf - pushad - mov edx, _debug_crlf - call debug_outstr - popad - popf -} - -macro print message -{ - dps message - newline -} - -macro pregs -{ - dps "EAX: " - dpd eax - dps " EBX: " - dpd ebx - newline - dps "ECX: " - dpd ecx - dps " EDX: " - dpd edx - newline -} - -macro debug_print_hex arg -{ - pushf - pushad - if ~arg eq eax - mov eax, arg - end if - call debug_outhex - popad - popf -} -dph fix debug_print_hex - -debug_outhex: - ; eax - number - mov edx, 8 - .new_char: - rol eax, 4 - movzx ecx, al - and cl, 0x0f - mov cl, [__hexdigits + ecx] - pushad - mcall 63, 1 - popad - dec edx - jnz .new_char -ret - -__hexdigits: - db '0123456789ABCDEF' \ No newline at end of file diff --git a/programs/develop/SPForth/mbuild.bat b/programs/develop/SPForth/mbuild.bat index 8d2cc125f5..3517fc9414 100644 --- a/programs/develop/SPForth/mbuild.bat +++ b/programs/develop/SPForth/mbuild.bat @@ -1 +1,3 @@ fasm.exe meforth.ASM + +pause diff --git a/programs/develop/SPForth/meforth.ASM b/programs/develop/SPForth/meforth.ASM index 7d31ea680d..4175d45d7a 100644 --- a/programs/develop/SPForth/meforth.ASM +++ b/programs/develop/SPForth/meforth.ASM @@ -1,6 +1,6 @@ ; KolSPForth v12 - SYSTEM equ EMUL +SYSTEM equ EMUL ;Memory Map ; @@ -86,18 +86,19 @@ cfa_#F_CFA: } - ;; Main entry points and COLD start data +;; Main entry points and COLD start data use32 + format binary as "" org 0x0 - db 'MENUET01' ; 8 byte id - dd 0x01 ; header version - dd ORIG ; start of code - dd I_END ; size of image -MEMS: dd EM ; memory for app - dd SPP ; esp + db 'MENUET01' + dd 0x01 + dd ORIG ; start of code + dd I_END ; size of image +MEMS: dd EM ; memory for app + dd SPP ; esp if SYSTEM eq MEOS dd FINFO.path else @@ -107,7 +108,7 @@ end if lang fix ru include 'MACROS.INC' - include "proc32.inc" + include '..\..\proc32.inc' align 4 proc strncmp stdcall, s1:dword, s2:dword, n:dword @@ -179,47 +180,53 @@ BYE: mcall -1 draw_cursor: draw_window: - pusha - mcall 12,1 - mov [fRed],ebx - mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x03000000, 0x805080D0, 0x005080D0 - mcall 4, <8,8>, 0x10DDEEFF, header, header.size + pusha + mcall 12,1 + mov [fRed],ebx + mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x54000000 + ; mcall 0,,,COL_WINDOW_BG, ,title ; define window + mcall 71, 1, header - mcall 9,pinfo,-1 - mov eax,[pinfo.x_size] - cdq - sub eax,20 - mov ebx,6 - div ebx - mov [pinfo.x_start],eax + mcall 9,pinfo,-1 + mov eax,[pinfo.x_size] + cdq + sub eax,20 + mov ebx,6 + div ebx + mov [pinfo.x_start],eax - mov eax,[pinfo.y_size] - cdq - sub eax,40 - mov ebx,ROWH - div ebx + mov eax,[pinfo.y_size] + cdq + sub eax,40 + mov ebx,ROWH + div ebx - mov [pinfo.y_start],eax - call erase_screen - mcall 12, 2 -if ~ SYSTEM eq EMUL - mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT -end if - popa - ret + mov [pinfo.y_start],eax + call erase_screen + mcall 12, 2 + mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT + popa + ret - lsz header,\ - ru,'”®àâ ¤«ï MenuetOS (SPF)',\ - en,'EXAMPLE APPLICATION',\ - fr,"L'exemplaire programme" - erase_screen: - mov ebx,[pinfo.x_size] - add ebx,10 shl 16-20 - mov ecx,[pinfo.y_size] - add ecx,30 shl 16-35 - mcall 13,,,0;xff - ret +macro GetSkinHeight +{ + mov eax,48 + mov ebx,4 + int 0x40 +} + +erase_screen: + GetSkinHeight + mov ecx,eax + shl ecx,16 + add ecx,[pinfo.y_size] + sub ecx,eax + sub ecx,4 + mov ebx,[pinfo.x_size] + add ebx,5 shl 16 - 9 + mcall 13,,,0;xff + ret AHEADER 0,"CC_LINES",cfa_CC_LINES @@ -463,6 +470,8 @@ cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result ) last_ebp dd 0 include 'amain.asm' + + header db 'Kolibri Forth v12.1',0 FINFO: .mode dd 0 @@ -471,17 +480,9 @@ cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result ) .buf dd 0 .work dd os_work .path: - if SYSTEM eq MEOS -; .path db 0 -; .path db '/HD/1/FORTH/AUTORUN.DAT',0 -; db '/RD/1/AUTOLOAD.F' - else db '/RD/1/AUTOLOAD.F' ; db '/RD/1/EXAMPLE.F' -; db '/RD/1/PICTURE.F' -; db '/RD/1/AUTORUN.DAT' -; db '/HD/1/FORTH/AUTORUN.DAT' - end if +; db '/RD/1/PICTURE.F' db 0 .end_path: diff --git a/programs/develop/SPForth/proc32.inc b/programs/develop/SPForth/proc32.inc deleted file mode 100644 index 98a1bd3342..0000000000 --- a/programs/develop/SPForth/proc32.inc +++ /dev/null @@ -1,268 +0,0 @@ - -; Macroinstructions for defining and calling procedures - -macro stdcall proc,[arg] ; directly call STDCALL procedure - { common - if ~ arg eq - reverse - pushd arg - common - end if - call proc } - -macro invoke proc,[arg] ; indirectly call STDCALL procedure - { common - if ~ arg eq - reverse - pushd arg - common - end if - call [proc] } - -macro ccall proc,[arg] ; directly call CDECL procedure - { common - size@ccall = 0 - if ~ arg eq - reverse - pushd arg - size@ccall = size@ccall+4 - common - end if - call proc - if size@ccall - add esp,size@ccall - end if } - -macro cinvoke proc,[arg] ; indirectly call CDECL procedure - { common - size@ccall = 0 - if ~ arg eq - reverse - pushd arg - size@ccall = size@ccall+4 - common - end if - call [proc] - if size@ccall - add esp,size@ccall - end if } - -macro proc [args] ; define procedure - { common - match name params, args> - \{ define@proc name, \{ prologue name,flag,parmbytes,localbytes,reglist \} - macro locals - \{ virtual at ebp-localbytes+current - macro label . \\{ deflocal@proc .,:, \\} - struc db [val] \\{ \common deflocal@proc .,db,val \\} - struc dw [val] \\{ \common deflocal@proc .,dw,val \\} - struc dp [val] \\{ \common deflocal@proc .,dp,val \\} - struc dd [val] \\{ \common deflocal@proc .,dd,val \\} - struc dt [val] \\{ \common deflocal@proc .,dt,val \\} - struc dq [val] \\{ \common deflocal@proc .,dq,val \\} - struc rb cnt \\{ deflocal@proc .,rb cnt, \\} - struc rw cnt \\{ deflocal@proc .,rw cnt, \\} - struc rp cnt \\{ deflocal@proc .,rp cnt, \\} - struc rd cnt \\{ deflocal@proc .,rd cnt, \\} - struc rt cnt \\{ deflocal@proc .,rt cnt, \\} - struc rq cnt \\{ deflocal@proc .,rq cnt, \\} \} - macro endl - \{ purge label - restruc db,dw,dp,dd,dt,dq - restruc rb,rw,rp,rd,rt,rq - restruc byte,word,dword,pword,tword,qword - current = $-(ebp-localbytes) - end virtual \} - macro ret operand - \{ match any, operand \\{ retn operand \\} - match , operand \\{ match epilogue:reglist, epilogue@proc: - \\\{ epilogue name,flag,parmbytes,localbytes,reglist \\\} \\} \} - macro finish@proc \{ localbytes = (((current-1) shr 2)+1) shl 2 - end if \} } - -macro defargs@proc [arg] - { common - if ~ arg eq - forward - local ..arg,current@arg - match argname:type, arg - \{ current@arg equ argname - label ..arg type - argname equ ..arg - if dqword eq type - dd ?,?,?,? - else if tbyte eq type - dd ?,?,? - else if qword eq type | pword eq type - dd ?,? - else - dd ? - end if \} - match =current@arg,current@arg - \{ current@arg equ arg - arg equ ..arg - ..arg dd ? \} - common - args@proc equ current@arg - forward - restore current@arg - common - end if } - -macro deflocal@proc name,def,[val] - { common - match vars, all@vars \{ all@vars equ all@vars, \} - all@vars equ all@vars name - forward - local ..var,..tmp - ..var def val - match =?, val \{ ..tmp equ \} - match any =dup (=?), val \{ ..tmp equ \} - match tmp : value, ..tmp : val - \{ tmp: end virtual - initlocal@proc ..var,def value - virtual at tmp\} - common - match first rest, ..var, \{ name equ first \} } - -macro initlocal@proc name,def - { virtual at name - def - size@initlocal = $ - name - end virtual - position@initlocal = 0 - while size@initlocal > position@initlocal - virtual at name - def - if size@initlocal - position@initlocal < 2 - current@initlocal = 1 - load byte@initlocal byte from name+position@initlocal - else if size@initlocal - position@initlocal < 4 - current@initlocal = 2 - load word@initlocal word from name+position@initlocal - else - current@initlocal = 4 - load dword@initlocal dword from name+position@initlocal - end if - end virtual - if current@initlocal = 1 - mov byte [name+position@initlocal],byte@initlocal - else if current@initlocal = 2 - mov word [name+position@initlocal],word@initlocal - else - mov dword [name+position@initlocal],dword@initlocal - end if - position@initlocal = position@initlocal + current@initlocal - end while } - -macro endp - { purge ret,locals,endl - finish@proc - purge finish@proc - restore regs@proc - match all,args@proc \{ restore all \} - restore args@proc - match all,all@vars \{ restore all \} } - -macro local [var] - { common - locals - forward done@local equ - match varname[count]:vartype, var - \{ match =BYTE, vartype \\{ varname rb count - restore done@local \\} - match =WORD, vartype \\{ varname rw count - restore done@local \\} - match =DWORD, vartype \\{ varname rd count - restore done@local \\} - match =PWORD, vartype \\{ varname rp count - restore done@local \\} - match =QWORD, vartype \\{ varname rq count - restore done@local \\} - match =TBYTE, vartype \\{ varname rt count - restore done@local \\} - match =DQWORD, vartype \\{ label varname dqword - rq count+count - restore done@local \\} - match , done@local \\{ virtual - varname vartype - end virtual - rb count*sizeof.\#vartype - restore done@local \\} \} - match :varname:vartype, done@local:var - \{ match =BYTE, vartype \\{ varname db ? - restore done@local \\} - match =WORD, vartype \\{ varname dw ? - restore done@local \\} - match =DWORD, vartype \\{ varname dd ? - restore done@local \\} - match =PWORD, vartype \\{ varname dp ? - restore done@local \\} - match =QWORD, vartype \\{ varname dq ? - restore done@local \\} - match =TBYTE, vartype \\{ varname dt ? - restore done@local \\} - match =DQWORD, vartype \\{ label varname dqword - dq ?,? - restore done@local \\} - match , done@local \\{ varname vartype - restore done@local \\} \} - match ,done@local - \{ var - restore done@local \} - common - endl }