Thread: [Win32forth-cvs] win32forth/src DBGSRC2.F, 1.4, 1.5 Debug.f, 1.14, 1.15 ENVIRON.F, 1.3, 1.4 Extend.

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	DBGSRC2.F Debug.f ENVIRON.F Extend.f Primutil.f imageman.f 
Log Message:
gah:Added ACTION-OF (per F200X) and made DEFER@ a (temporary) deprecated synonym. Replaced defer@ by action-of (accept in 486asm). Added DEFER!. Support for extension queries (partial) added to environment.f

Index: Extend.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Extend.f,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** Extend.f	22 Jul 2006 08:21:53 -0000	1.10
--- Extend.f	28 Sep 2006 10:16:48 -0000	1.11
***************
*** 115,119 ****
  : HELLO         { \ doing-app? -- }             \ startup stuff
                  only forth also definitions
!                 defer@ default-application ['] bye <> to doing-app?
                  init-console                    \ -- f1
                  dup                             \ init if we created a console
--- 115,119 ----
  : HELLO         { \ doing-app? -- }             \ startup stuff
                  only forth also definitions
!                 action-of default-application ['] bye <> to doing-app?
                  init-console                    \ -- f1
                  dup                             \ init if we created a console

Index: Debug.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Debug.f,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Debug.f	21 Sep 2006 12:46:08 -0000	1.14
--- Debug.f	28 Sep 2006 10:16:48 -0000	1.15
***************
*** 452,456 ****
                  left-margin-save to left-margin
                  indent-save      to indent
!                  key-save defer@ key = ?EXIT
                  emit-save        is emit
                  type-save        is type
--- 452,456 ----
                  left-margin-save to left-margin
                  indent-save      to indent
!                 key-save action-of key = ?EXIT
                  emit-save        is emit
                  type-save        is type
***************
*** 472,491 ****
  
  : debug-io      ( -- )
!                 defer@ key key-save = ?EXIT     \ leave already saved
!                 getxy to y-save to x-save
!                 defer@ emit    to   emit-save   \ save current contents
!                 defer@ type    to   type-save
!                 defer@ cr      to     cr-save
!                 defer@ ?cr     to    ?cr-save
!                 defer@ key     to    key-save
!                 defer@ key?    to   key?-save
!                 defer@ cls     to    cls-save
!                 defer@ page    to   page-save
!                 defer@ gotoxy  to gotoxy-save
!                 defer@ getxy   to  getxy-save
!                 defer@ col     to    col-save
!                 tabing?        to tabing?-save
!                 left-margin    to left-margin-save
!                 indent         to indent-save
                  remote-debug? 0=
                  IF      unhide-console
--- 472,491 ----
  
  : debug-io      ( -- )
!                 action-of key key-save = ?EXIT     \ leave already saved
!                 getxy to y-save  to x-save
!                 action-of emit   to   emit-save   \ save current contents
!                 action-of type   to   type-save
!                 action-of cr     to     cr-save
!                 action-of ?cr    to    ?cr-save
!                 action-of key    to    key-save
!                 action-of key?   to   key?-save
!                 action-of cls    to    cls-save
!                 action-of page   to   page-save
!                 action-of gotoxy to gotoxy-save
!                 action-of getxy  to  getxy-save
!                 action-of col    to    col-save
!                 tabing?          to tabing?-save
!                 left-margin      to left-margin-save
!                 indent           to indent-save
                  remote-debug? 0=
                  IF      unhide-console

Index: DBGSRC2.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/DBGSRC2.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** DBGSRC2.F	12 Jun 2006 12:25:11 -0000	1.4
--- DBGSRC2.F	28 Sep 2006 10:16:48 -0000	1.5
***************
*** 71,76 ****
                  then
                  editor-present? 0= ?EXIT
!                 defer@ type >r ['] buf-type is type
!                 defer@ emit >r ['] buf-emit is emit
                  ed-dbgline off
                  .smax @ >r 3 .smax !    \ limit stack display to 3 items
--- 71,76 ----
                  then
                  editor-present? 0= ?EXIT
!                 action-of type >r ['] buf-type is type
!                 action-of emit >r ['] buf-emit is emit
                  ed-dbgline off
                  .smax @ >r 3 .smax !    \ limit stack display to 3 items
***************
*** 114,119 ****
                          UNTIL   drop
                  then prev-return return-top -   \ if return stack has changed
!                 if      defer@ type >r ['] rst-type is type
!                         defer@ emit >r ['] rst-emit is emit
                          ed-return off
                          return-top      \ if returnstack is set
--- 114,119 ----
                          UNTIL   drop
                  then prev-return return-top -   \ if return stack has changed
!                 if      action-of type >r ['] rst-type is type
!                         action-of emit >r ['] rst-emit is emit
                          ed-return off
                          return-top      \ if returnstack is set

Index: imageman.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/imageman.f,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** imageman.f	13 Feb 2006 14:06:09 -0000	1.10
--- imageman.f	28 Sep 2006 10:16:48 -0000	1.11
***************
*** 955,961 ****
                  depth 3 < abort" Need 3 arguments, APP-MEM SYS-MEM and APP-CFA"
                  >r 2drop
!                 defer@ boot
!                 defer@ default-application
!                 defer@ default-hello is boot \ initialization program to BOOT
                  r> is default-application    \ calls default application after init
                  &except off                  \ no previous exceptions...
--- 955,961 ----
                  depth 3 < abort" Need 3 arguments, APP-MEM SYS-MEM and APP-CFA"
                  >r 2drop
!                 action-of boot
!                 action-of default-application
!                 action-of default-hello is boot \ initialization program to BOOT
                  r> is default-application    \ calls default application after init
                  &except off                  \ no previous exceptions...
***************
*** 970,974 ****
                  ignore-missing-procs?
                  true to ignore-missing-procs?     \ WHEN TURNKEYING, IGNORE MISSING PROCEDURE WARNINGS !
!                 defer@ INIT-CONSOLE ['] x_INIT-CONSOLE is INIT-CONSOLE \ no statusbar for the console
                  SYS-SIZE 0 ['] SYS-SIZE >BODY !   \ set system free space to zero, no system
                  FALSE to with-source?             \ no source level debugging
--- 970,974 ----
                  ignore-missing-procs?
                  true to ignore-missing-procs?     \ WHEN TURNKEYING, IGNORE MISSING PROCEDURE WARNINGS !
!                 action-of INIT-CONSOLE ['] x_INIT-CONSOLE is INIT-CONSOLE \ no statusbar for the console
                  SYS-SIZE 0 ['] SYS-SIZE >BODY !   \ set system free space to zero, no system
                  FALSE to with-source?             \ no source level debugging

Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** Primutil.f	13 Sep 2006 09:34:57 -0000	1.18
--- Primutil.f	28 Sep 2006 10:16:48 -0000	1.19
***************
*** 161,165 ****
                  then    ; immediate
  
! : defer@        ( -<name>- )    \ function currently in deferred word name
                  ' >BODY
                  state @
--- 161,166 ----
                  then    ; immediate
  
! : action-of     ( "<spaces>name" -- xt ) \ 200X   system      Core ext x:deferred
! \ *G Return xt that deferred word name is set to. When compiling put into current def.
                  ' >BODY
                  state @
***************
*** 168,173 ****
--- 169,185 ----
                  then    ; immediate
  
+ synonym defer@ action-of deprecated
+ 
  in-application
  
+ 
+ \ : defer@        ( xt1 -- xt2 )           \ 200X               Core ext x:deferred
+ \ *G xt1 is deffered word. xt2 is current setting.
+ \                >body @ ; \ currently unsupported until old use fades out.
+ 
+ : DEFER!        ( xt2 xt1 -- )           \ 200X               Core ext x:deferred
+ \ *G xt1 is deffered word. xt2 is new setting.
+                 >body ! ;
+ 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Index: ENVIRON.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/ENVIRON.F,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** ENVIRON.F	30 Aug 2005 11:55:15 -0000	1.3
--- ENVIRON.F	28 Sep 2006 10:16:48 -0000	1.4
***************
*** 24,32 ****
                 TRUE  CONSTANT CORE-EXT
          -10 7 / -2 = CONSTANT FLOORED
! 
! \ -rbs
! \         0xFFFFFFFF  CONSTANT MAX-CHAR
! 0xFF CONSTANT MAX-CHAR
! 
  0x7FFFFFFF.FFFFFFFF 2CONSTANT MAX-D
           0x7FFFFFFF  CONSTANT MAX-N
--- 24,28 ----
                 TRUE  CONSTANT CORE-EXT
          -10 7 / -2 = CONSTANT FLOORED
!                0xFF  CONSTANT MAX-CHAR
  0x7FFFFFFF.FFFFFFFF 2CONSTANT MAX-D
           0x7FFFFFFF  CONSTANT MAX-N
***************
*** 53,59 ****
                 TRUE  CONSTANT STRING-EXT
             #-LOCALS  CONSTANT #LOCALS
!                             : LOCALS TRUE ;
!                TRUE  CONSTANT LOCALS-EXT             
!                TRUE  CONSTANT WIN32FORTH
  
  LOADED? FLOAT.F [IF]
--- 49,54 ----
                 TRUE  CONSTANT STRING-EXT
             #-LOCALS  CONSTANT #LOCALS
!                TRUE  CONSTANT LOCALS
!                TRUE  CONSTANT LOCALS-EXT
  
  LOADED? FLOAT.F [IF]
***************
*** 64,68 ****
  [then]
  
! forth definitions
  
  
--- 59,74 ----
  [then]
  
! \ Win32Forth specific queries
!                TRUE  CONSTANT WIN32FORTH
! 
! 
! \ Added Wednesday, September 27 2006 to support Forth 200x extensions. gah
! 
!                             : X:EXTENSION-QUERY ;
!                             : X:DEFINED         ;
! \                            : X:DEFERRED        ; \ Not fully done yet
! \                            : X:PARSE-NAME      ; \ Not yet
! 
! previous definitions

Thread: [Win32forth-cvs] win32forth/src DBGSRC2.F, 1.4, 1.5 Debug.f, 1.14, 1.15 ENVIRON.F, 1.3, 1.4 Extend.

win32forth-cvs