[Win32forth-cvs] win32forth/src/lib FCOM.F, 1.4, 1.5 toolbar.f, 1.4, 1.5

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

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

Modified Files:
	FCOM.F toolbar.f 
Log Message:
gah:More dexing and minor optimisations

Index: toolbar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/toolbar.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** toolbar.f	29 Jun 2006 04:09:43 -0000	1.4
--- toolbar.f	13 Sep 2006 09:34:57 -0000	1.5
***************
*** 21,24 ****
--- 21,28 ----
  
          Change log:
+ 
+                 September 12th, 2006 - 20:47 - gah
+                 Added \in-system-ok to account for ?pairs being moved to system space
+ 
                  September 25th, 2005 - 18:59 - Rod
                  Changed to use Control rather than Child-Window
***************
*** 97,101 ****
                  ;
  : ;ToolBarTable ( addr1 addr2 12 -- )
!                 12 ?pairs
                  here rot !                      \ Resolve address of cust. table
                  here 0 ,                        \ no of buttons in cust. table
--- 101,105 ----
                  ;
  : ;ToolBarTable ( addr1 addr2 12 -- )
! \in-system-ok   12 ?pairs
                  here rot !                      \ Resolve address of cust. table
                  here 0 ,                        \ no of buttons in cust. table
***************
*** 115,119 ****
                  ;
  : ToolBarTableExtraButtons: ( addr 12 -- addr 12 )
!                 dup 12 ?pairs
                  over dup @ swap cell- !
                  ;
--- 119,123 ----
                  ;
  : ToolBarTableExtraButtons: ( addr 12 -- addr 12 )
! \in-system-ok   dup 12 ?pairs
                  over dup @ swap cell- !
                  ;
***************
*** 121,125 ****
                  2>r  rot ( bidx)   ,  swap ( id) ,  ( state) c,
                  2r> swap ( style) c, 0 w,      0 ,  ( txtno)  ,
!                 dup 12 ?pairs  over 1 swap +!
                  ;
  : SeparatorButton, ( addr 12 -- addr 12 )
--- 125,129 ----
                  2>r  rot ( bidx)   ,  swap ( id) ,  ( state) c,
                  2r> swap ( style) c, 0 w,      0 ,  ( txtno)  ,
! \in-system-ok   dup 12 ?pairs  over 1 swap +!
                  ;
  : SeparatorButton, ( addr 12 -- addr 12 )
***************
*** 160,164 ****
                  ;
  : ;ToolStrings  ( addr 13 -- )
!                 13 ?pairs
                  0 , align
                  here over !                     \ Resolve address of address table
--- 164,168 ----
                  ;
  : ;ToolStrings  ( addr 13 -- )
! \in-system-ok   13 ?pairs
                  0 , align
                  here over !                     \ Resolve address of address table
***************
*** 174,178 ****
                  ;
  : ts,"          ( 13 -<string">- 13 )
!                 dup 13 ?pairs
                  state @
                  if      true abort" Illegal use of tool string compiler"
--- 178,182 ----
                  ;
  : ts,"          ( 13 -<string">- 13 )
! \in-system-ok   dup 13 ?pairs
                  state @
                  if      true abort" Illegal use of tool string compiler"
***************
*** 375,379 ****
                  else
                          to Parent
!                         z" ToolbarWindow32" Create-Control 
                          register-struct-size
  
--- 379,383 ----
                  else
                          to Parent
!                         z" ToolbarWindow32" Create-Control
                          register-struct-size
  
***************
*** 632,636 ****
                    else  0
                    then  ;M
!                   
  ;Class
  
--- 636,640 ----
                    else  0
                    then  ;M
! 
  ;Class
  

Index: FCOM.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/FCOM.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** FCOM.F	19 Aug 2006 01:50:52 -0000	1.4
--- FCOM.F	13 Sep 2006 09:34:57 -0000	1.5
***************
*** 797,801 ****
  : cguid ( tinfo -- ) \ compiles a guid
    >r rp@ tattr-allot dup UseStruct TYPEATTR guid
!   state @ if 16 POSTPONE SLITERAL POSTPONE DROP
            else 16 new$ dup >r place r> 1+ then
    rp@ swap tattr-free rp@ UCOM ITypeInfo IReleaseref drop r> drop ;
--- 797,801 ----
  : cguid ( tinfo -- ) \ compiles a guid
    >r rp@ tattr-allot dup UseStruct TYPEATTR guid
! \in-system-ok state @ if 16 POSTPONE SLITERAL POSTPONE DROP
            else 16 new$ dup >r place r> 1+ then
    rp@ swap tattr-free rp@ UCOM ITypeInfo IReleaseref drop r> drop ;