From: George H. <geo...@us...> - 2006-11-04 11:19:16
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20150/win32forth-stc/src Modified Files: float.f primutil.f Log Message: gah:Added ASCIIZ to priimutil.f plus minor optimisations Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** primutil.f 31 Oct 2006 11:33:31 -0000 1.16 --- primutil.f 4 Nov 2006 11:19:10 -0000 1.17 *************** *** 40,49 **** \ ------------------------------------------------------------------------ ! in-application 0 value DPR-WARNING? \ null value *** to be done *** - in-system - \ : ANEW BL WORD DROP ; immediate \ *** to be done *** : IS-DEFAULT BL WORD 2DROP ; immediate \ *** to be done *** --- 40,47 ---- \ ------------------------------------------------------------------------ ! in-system 0 value DPR-WARNING? \ null value *** to be done *** \ : ANEW BL WORD DROP ; immediate \ *** to be done *** : IS-DEFAULT BL WORD 2DROP ; immediate \ *** to be done *** *************** *** 61,66 **** \ ------------------------------------------------------------------------ - in-system - : _commeof \ ( flag -- ) abort" EOF encountered in comment" ; --- 59,62 ---- *************** *** 102,105 **** --- 98,103 ---- \ ------------------------------------------------------------------------ + in-previous + : 2constant ( n m "name" ) >system create , , dp> *************** *** 113,121 **** ' maxbuffer alias max-path defer enter-assembler ' noop is enter-assembler defer exit-assembler ' noop is exit-assembler - in-application - : (comp-offs) ( xt -- ) 0 swap execute postpone literal postpone + ; --- 111,119 ---- ' maxbuffer alias max-path + in-system + defer enter-assembler ' noop is enter-assembler defer exit-assembler ' noop is exit-assembler : (comp-offs) ( xt -- ) 0 swap execute postpone literal postpone + ; *************** *** 129,135 **** over offset + ; ! : ascii char state @ if postpone literal then ; immediate ! : alt char 4096 or state @ if postpone literal then ; immediate ! : ctrl char 31 and state @ if postpone literal then ; immediate \ ------------------------------------------------------------------------ --- 127,144 ---- over offset + ; ! : ascii char compilation> execute postpone literal ; ! : alt char 4096 or compilation> execute postpone literal ; ! : ctrl char 31 and compilation> execute postpone literal ; ! ! in-previous ! ! \ Moved to user area to make asciiz thread safe gah 28jun04 ! MAXSTRING newuser z-buf ! \ *G Per-task buffer for holding the string for asciiz. ! ! : asciiz ( addr len -- z-buf ) ! \ *G Place string addr len in buffer z-buf and null terminate it. Note only one string ! \ ** per task can used at a time. ! z-buf ascii-z ; \ ------------------------------------------------------------------------ *************** *** 151,155 **** \ new-sys-chain post-forget-chain \ chain of types of things to forget ! in-application :noname ( -- ) \ chain for cleanup --- 160,164 ---- \ new-sys-chain post-forget-chain \ chain of types of things to forget ! in-previous :noname ( -- ) \ chain for cleanup Index: float.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/float.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** float.f 31 Oct 2006 00:06:31 -0000 1.3 --- float.f 4 Nov 2006 11:19:10 -0000 1.4 *************** *** 44,48 **** 0 [tos] endm ! in-application code >fregs ( addr -- ) \ Restore x87 FPU State --- 44,48 ---- 0 [tos] endm ! in-previous code >fregs ( addr -- ) \ Restore x87 FPU State *************** *** 121,125 **** FLOATSTACK + [ecx] [up] endm ! in-application -45 Constant THROW_FLOATSTACKUNDER --- 121,125 ---- FLOATSTACK + [ecx] [up] endm ! in-previous -45 Constant THROW_FLOATSTACKUNDER *************** *** 237,248 **** \ macro to end float words ! macro: float; fsp-adjust if add ecx, # fsp-adjust mov FSP_MEMORY , ecx 0 to fsp-adjust then ! false to fsp-cached? next ;c endm ! in-application \ Subroutine to check the depth of the float stack for underflow errors. --- 237,252 ---- \ macro to end float words ! ! macro: ?uncash-fsp fsp-adjust if add ecx, # fsp-adjust mov FSP_MEMORY , ecx 0 to fsp-adjust then ! false to fsp-cached? endm ! macro: float; ! ?uncash-fsp next ;c endm ! ! in-previous \ Subroutine to check the depth of the float stack for underflow errors. *************** *** 280,284 **** endm ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 284,288 ---- endm ! in-previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 371,375 **** float; )) does> f@ ; ! in-application code _fto ( FS: n - ) ( 'fvalue - ) --- 375,379 ---- float; )) does> f@ ; ! in-previous code _fto ( FS: n - ) ( 'fvalue - ) *************** *** 392,396 **** then ; IMMEDIATE ! in-application : FCONSTANT ( -<name>- ) ( F: r -- ) \ compile time --- 396,400 ---- then ; IMMEDIATE ! in-previous : FCONSTANT ( -<name>- ) ( F: r -- ) \ compile time *************** *** 653,657 **** ; immediate ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 657,661 ---- ; immediate ! in-previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 696,700 **** endm ! in-application external --- 700,704 ---- endm ! in-previous external *************** *** 806,810 **** endm ! in-application code fcomppx ( -- flags ) ( fs: r1 r2 -- ) --- 810,814 ---- endm ! in-previous code fcomppx ( -- flags ) ( fs: r1 r2 -- ) *************** *** 1276,1280 **** internal ! in-application (( \ pointer to a float primitives --- 1280,1284 ---- internal ! in-previous (( \ pointer to a float primitives *************** *** 1348,1352 **** ' ?#float 2 cells+ cfa-comp, ; immediate ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1352,1356 ---- ' ?#float 2 cells+ cfa-comp, ; immediate ! in-previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 1740,1744 **** IF postpone fliteral THEN ; immediate ! in-application \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 1744,1748 ---- IF postpone fliteral THEN ; immediate ! in-previous \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 2079,2083 **** defer .float ' see.float is .float ! in-application \ changed arm 25/04/2005 23:09:50 to use new number chain technique (see numconv.f) --- 2083,2087 ---- defer .float ' see.float is .float ! in-previous \ changed arm 25/04/2005 23:09:50 to use new number chain technique (see numconv.f) |