[Win32forth-cvs] win32forth/src GENERIC.F, 1.20, 1.21 Primutil.f, 1.27, 1.28 SEE.F, 1.10, 1.11

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25565/src

Modified Files:
	GENERIC.F Primutil.f SEE.F 
Log Message:
Added IMPORT: and modified see for it. Used in generic.f (as a test). NOTE you need the new fkernel.exe to metacompile.

Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** Primutil.f	29 Jun 2008 05:12:39 -0000	1.27
--- Primutil.f	16 Jul 2008 20:48:23 -0000	1.28
***************
*** 198,206 ****
                  dup negate hld +! hld @ swap move ;
  
- in-system
- 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
  : allot-to      ( n1 -- )       \ extend the dictionary space of most recent
                                  \ word compile to length n1
--- 198,218 ----
                  dup negate hld +! hld @ swap move ;
  
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  
+ cfa-func DoImport ( i*x -- res )
+                 dup>r cell+ @ S-REVERSE \ reverse the stack arguments
+                 r> perform ;
+ 
+ in-system
+ 
+ : \IN-SYSTEM-OK ( -<line_to_interpret>- )
+ \ *G Suppress in-system warnings for the rest of the current line, restoring the previous
+ \ ** state of the sys-warning? flag afterwards, even if an error occurs.
+                 sys-warning? >r
+                 sys-warning-off
+                 ['] interpret catch
+                 r> to sys-warning? throw ; immediate
+ 
  : allot-to      ( n1 -- )       \ extend the dictionary space of most recent
                                  \ word compile to length n1
***************
*** 211,214 ****
--- 223,232 ----
                  winproc-last @ proc>cfa alias ;
  
+ : import:       ( c "name" -- )
+ \in-system-ok   >IN @ >r dup proc r> >IN ! \ make sure proc exists before doing create
+                 header DoImport compile,
+                 winproc-last @ proc>cfa , , \ cfa then number of arguments for this proceedure
+                 ;
+ 
  in-application
  
***************
*** 352,363 ****
                  then    ; immediate
  
- : \IN-SYSTEM-OK ( -<line_to_interpret>- )
- \ *G Suppress in-system warnings for the rest of the current line, restoring the previous
- \ ** state of the sys-warning? flag afterwards, even if an error occurs.
-                 sys-warning? >r
-                 sys-warning-off
-                 ['] interpret catch
-                 r> to sys-warning? throw ; immediate
- 
  IN-APPLICATION
  
--- 370,373 ----

Index: SEE.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/SEE.F,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** SEE.F	15 May 2008 04:28:27 -0000	1.10
--- SEE.F	16 Jul 2008 20:48:24 -0000	1.11
***************
*** 59,63 ****
                  OVER sys-origin sys-here within or
                  over code-origin code-here within or
!         IF      DUP >R @
                  CASE   DOVALUE   OF R@                         .NAME   ENDOF
                         DOVALUE!  OF R@ ." TO "       2 CELLS - .NAME   ENDOF
--- 59,63 ----
                  OVER sys-origin sys-here within or
                  over code-origin code-here within or
!         IF      DUP>R  @
                  CASE   DOVALUE   OF R@                         .NAME   ENDOF
                         DOVALUE!  OF R@ ." TO "       2 CELLS - .NAME   ENDOF
***************
*** 277,280 ****
--- 277,283 ----
                  .name ;
  
+ : .Import       ( cfa -- )
+                 >body dup cell+ @ . ." Import: " @ .proc-name ;
+ 
  0 value a_value
  
***************
*** 295,298 ****
--- 298,302 ----
              doObj       of .object      endof
              doPointer   of .pointer     endof
+             doImport    of .import      endof
          swap .other
      endcase ;

Index: GENERIC.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** GENERIC.F	15 May 2008 04:28:26 -0000	1.20
--- GENERIC.F	16 Jul 2008 20:48:23 -0000	1.21
***************
*** 300,308 ****
  maxstring newuser gettext$
  
  :M GetText:     ( -- addr len )
  \ *G The GetWindowText function copies the text of the window's title bar (if it has one)
  \ ** into a buffer. If the window is a control, the text of the control is copied.
                  gettext$ hWnd
!                 -if  over MAXCOUNTED 3reverse Call GetWindowText
                  then ;M
  
--- 300,310 ----
  maxstring newuser gettext$
  
+ 3 import: GetWindowText
+ 
  :M GetText:     ( -- addr len )
  \ *G The GetWindowText function copies the text of the window's title bar (if it has one)
  \ ** into a buffer. If the window is a control, the text of the control is copied.
                  gettext$ hWnd
!                 -if  over MAXCOUNTED ( 3reverse Call ) GetWindowText
                  then ;M