[Win32forth-cvs] win32forth/src ASMWIN32.F, 1.5, 1.6 Class.f, 1.20, 1.21 Debug.f, 1.11, 1.12 Nforge

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-serv17644/win32forth/src

Modified Files:
	ASMWIN32.F Class.f Debug.f Nforget.f Primutil.f SEE.F 
Log Message:
gah:Added code so that a warning is given if the Does> part of the defing word is in in-system and is used to create a word in-application (which would cause problems for TURNKEYed programs). NOTE needs the new FKERNEL.EXE from the CVS to build.

Index: ASMWIN32.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/ASMWIN32.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ASMWIN32.F	31 Aug 2005 09:04:49 -0000	1.5
--- ASMWIN32.F	3 Aug 2006 13:08:22 -0000	1.6
***************
*** 44,48 ****
  : _opt-code     ( -<name>- )    \ redefine to resolve code length in bytes
                  code-align
!                 _code 
                  code-here ofa-last code-d! \ init OFA with start of definition
                  ;
--- 44,48 ----
  : _opt-code     ( -<name>- )    \ redefine to resolve code length in bytes
                  code-align
!                 _code
                  code-here ofa-last code-d! \ init OFA with start of definition
                  ;
***************
*** 51,55 ****
  
  : _code>        ( -- ) \ create the ;code part of a low level defining word
!         ?csp !csp postpone (;code) 
          [ also forth ] code-align code-here , [ previous ]
          postpone [ init-asm ;
--- 51,55 ----
  
  : _code>        ( -- ) \ create the ;code part of a low level defining word
!         ?csp !csp postpone (;code)
          [ also forth ] code-align code-here , [ previous ]
          postpone [ init-asm ;
***************
*** 57,60 ****
--- 57,66 ----
  ' _code> is ;code
  
+ warning @ warning off nostack1
+ 
+ : subr: sys-warning? >r sys-warning-off subr: r> to sys-warning? ;
+ 
+ warning !
+ 
  defer ncode
  
***************
*** 75,79 ****
  
  macro: c;       ( -- )          \ alias for ;c and end-code
!                 end-code 
                  endm
  
--- 81,85 ----
  
  macro: c;       ( -- )          \ alias for ;c and end-code
!                 end-code
                  endm
  
***************
*** 85,89 ****
                  TCB - [edx],
                  endm
!                 
  \ Top of stack macros
  
--- 91,95 ----
                  TCB - [edx],
                  endm
! 
  \ Top of stack macros
  

Index: Debug.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Debug.f,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Debug.f	20 Feb 2006 12:06:14 -0000	1.11
--- Debug.f	3 Aug 2006 13:08:22 -0000	1.12
***************
*** 215,218 ****
--- 215,219 ----
       ['] (ABORT") OF  <STRING>                                  ENDOF
       ['] (;CODE)  OF  <EXIT>                                    ENDOF
+      ['] (DOES>)  OF  <EXIT>                                    ENDOF
       ['] UNNEST   OF  <EXIT>                                    ENDOF
       ['] UNNESTP  OF  <EXITP>                                   ENDOF

Index: Nforget.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Nforget.f,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Nforget.f	30 Aug 2005 13:07:31 -0000	1.3
--- Nforget.f	3 Aug 2006 13:08:22 -0000	1.4
***************
*** 159,163 ****
  
  : mark  ( -<name>- )
!         >application create save-source do-mark application> ;
  
  \ January 27th, 1999 - 11:27 tjz
--- 159,164 ----
  
  : mark  ( -<name>- )
!         >application create save-source sys-warning? sys-warning-off
!         do-mark to sys-warning? application> ;
  
  \ January 27th, 1999 - 11:27 tjz
***************
*** 177,181 ****
          current @ ,                                     \ save current
          context here #vocs cells allot #vocs cells move \ save context search list
!         do-marker
          application> ;
  
--- 178,182 ----
          current @ ,                                     \ save current
          context here #vocs cells allot #vocs cells move \ save context search list
!         sys-warning? sys-warning-off do-marker to sys-warning?
          application> ;
  

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** Class.f	17 Jul 2006 12:07:39 -0000	1.20
--- Class.f	3 Aug 2006 13:08:22 -0000	1.21
***************
*** 492,495 ****
--- 492,501 ----
                          0 op! ;                 \ for error checking in runIvarRef
  
+ : Build:Class   ( -- )
+                 does>
+                         [ code-here 12 - to doClass ] \ a dirty trick!
+                         (Build) ;
+ 
+ 
  : :Class        ( -<class-name>- )
  \ *G Define a class for creating a group of similar objects.
***************
*** 498,505 ****
                  create
                          (class)
!                 does>
!                         [ code-here 12 - to doClass ] \ a dirty trick!
!                         (Build) ;
! 
  
  : <Super        ( -- )        \ W32F     Class
--- 504,508 ----
                  create
                          (class)
!                 sys-warning? sys-warning-off Build:Class to sys-warning? ;
  
  : <Super        ( -- )        \ W32F     Class
***************
*** 542,545 ****
--- 545,553 ----
  \                 ' Clone ;
  
+ : Build|Class   ( -- )
+                 does>
+                         [ code-here 12 - to do|Class ] \ a dirty trick!
+                         (|Build) ;
+ 
  : |Class        ( -- )
  \ *G Defines a class that creates headerless objects.
***************
*** 552,558 ****
                  create
                          (class)
!                 does>
!                         [ code-here 12 - to do|Class ] \ a dirty trick!
!                         (|Build) ;
  
  classes definitions
--- 560,565 ----
                  create
                          (class)
!                 sys-warning? sys-warning-off Build|Class to sys-warning? ;
! 
  
  classes definitions

Index: SEE.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/SEE.F,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** SEE.F	29 Aug 2005 15:56:27 -0000	1.6
--- SEE.F	3 Aug 2006 13:08:22 -0000	1.7
***************
*** 37,41 ****
  \ : dummy.float   ( a1 -- a2 )
  \                 ." ???" cells/float cells+ ;
! \ 
  \ defer .float    ' dummy.float is .float
  
--- 37,41 ----
  \ : dummy.float   ( a1 -- a2 )
  \                 ." ???" cells/float cells+ ;
! \
  \ defer .float    ' dummy.float is .float
  
***************
*** 114,118 ****
  : .CALL         ( ip -- ip' )
                  .word .word ;
!                 
  : (.LOCALS)     ( t-1 n -- )
                  0 ?do dup i - ." LOCAL" 1 .r space loop drop ;
--- 114,118 ----
  : .CALL         ( ip -- ip' )
                  .word .word ;
! 
  : (.LOCALS)     ( t-1 n -- )
                  0 ?do dup i - ." LOCAL" 1 .r space loop drop ;
***************
*** 129,140 ****
                  then ." } "
                  CELL+ ;
!                 
  \ Decompile each type of word                         28Feb84map
  
  : .(;code)      ( ip -- ip' )
!                 cell+ dup cell+ swap does>?
!                 IF      ." DOES> "
!                 ELSE    ." ;CODE "  drop false
!                 THEN    ;
  
  : d_cr          ( -- )
--- 129,140 ----
                  then ." } "
                  CELL+ ;
! 
  \ Decompile each type of word                         28Feb84map
  
  : .(;code)      ( ip -- ip' )
!                 drop ." ;CODE " false ;
! 
! : .(does>)      ( ip -- ip' )
!                 cell+ cell+ ." DOES> " ;
  
  : d_cr          ( -- )
***************
*** 151,155 ****
                         \ past this address
          cell+ dup hi-branch u< 0= if ." ;"  drop  0
!                                 else ." EXIT"  then ; 
  
  : .execution-class  ( ip cfa -- ip' )
--- 151,155 ----
                         \ past this address
          cell+ dup hi-branch u< 0= if ." ;"  drop  0
!                                 else ." EXIT"  then ;
  
  : .execution-class  ( ip cfa -- ip' )
***************
*** 190,193 ****
--- 190,194 ----
          ['] unnestm     of .end ." M "                                endof
          ['] (;code)     of -tab d_cr .(;CODE) tab +tab                endof
+         ['] (does>)     of -tab d_cr .(DOES>) tab +tab                endof
          ['] create      of d_cr ." CREATE" cell+ tab +tab             endof
          ['] init-locals of               .locals                      endof

Index: Primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Primutil.f	20 May 2006 12:02:06 -0000	1.14
--- Primutil.f	3 Aug 2006 13:08:22 -0000	1.15
***************
*** 518,523 ****
  \ BINARY double number display with commas
  
- in-system
- 
  : RADIX:        ( n1 -<name>- )
                  CREATE  , DOCOL ,  !CSP ]
--- 518,521 ----
***************
*** 526,531 ****
                          R> BASE ! ;
  
- in-application
- 
  2 RADIX: BUD,.R ( ud width -- )   UD,.R ;
  2 RADIX: BU,.R  ( n1 width -- )   U,.R ;
--- 524,527 ----

[Win32forth-cvs] win32forth/src ASMWIN32.F, 1.5, 1.6 Class.f, 1.20, 1.21 Debug.f, 1.11, 1.12 Nforge

[Win32forth-cvs] win32forth/src ASMWIN32.F, 1.5, 1.6 Class.f, 1.20, 1.21 Debug.f, 1.11, 1.12 Nforget.f, 1.3, 1.4 Primutil.f, 1.14, 1.15 SEE.F, 1.6, 1.7