**
***************************************************************/
+#ifndef AMIGA
#include <sys/types.h>
+#else
+typedef long off_t;
+#endif
#include "pf_all.h"
TOS = TOS | PF_FAM_BINARY_FLAG;
endcase;
+ case ID_FILE_FLUSH: /* ( fileid -- ior ) */
+ {
+ FileStream *Stream = (FileStream *) TOS;
+ TOS = (sdFlushFile( Stream ) == 0) ? 0 : THROW_FLUSH_FILE;
+ }
+ endcase;
+
+ case ID_FILE_RENAME: /* ( oldName newName -- ior ) */
+ {
+ char *New = (char *) TOS;
+ char *Old = (char *) M_POP;
+ TOS = sdRenameFile( Old, New );
+ }
+ endcase;
+
+ case ID_FILE_RESIZE: /* ( ud fileid -- ior ) */
+ {
+ FileStream *File = (FileStream *) TOS;
+ ucell_t SizeHi = (ucell_t) M_POP;
+ ucell_t SizeLo = (ucell_t) M_POP;
+ TOS = sdResizeFile( File, SizeLo, SizeHi );
+ }
+ endcase;
+
case ID_FILL: /* ( caddr num charval -- ) */
{
register char *DstPtr;
case ID_PLUSLOOP_P: /* ( delta -- ) ( R: index limit -- | index limit ) */
{
- ucell_t OldIndex, NewIndex, Limit;
-
- Limit = M_R_POP;
- OldIndex = M_R_POP;
- NewIndex = OldIndex + TOS; /* add TOS to index, not 1 */
-/* Do indices cross boundary between LIMIT-1 and LIMIT ? */
- if( ( (OldIndex - Limit) & ((Limit-1) - NewIndex) & 0x80000000 ) ||
- ( (NewIndex - Limit) & ((Limit-1) - OldIndex) & 0x80000000 ) )
- {
+ cell_t Limit = M_R_POP;
+ cell_t OldIndex = M_R_POP;
+ cell_t Delta = TOS; /* add TOS to index, not 1 */
+ cell_t NewIndex = OldIndex + Delta;
+ cell_t OldDiff = OldIndex - Limit;
+
+ /* This exploits this idea (lifted from Gforth):
+ (x^y)<0 is equivalent to (x<0) != (y<0) */
+ if( ((OldDiff ^ (OldDiff + Delta)) /* is the limit crossed? */
+ & (OldDiff ^ Delta)) /* is it a wrap-around? */
+ < 0 )
+ {
InsPtr++; /* skip branch offset, exit loop */
}
else
endcase;
#endif
-/* Source Stack
-** EVALUATE >IN SourceID=(-1) 1111
-** keyboard >IN SourceID=(0) 2222
-** file >IN lineNumber filePos SourceID=(fileID)
-*/
- case ID_SAVE_INPUT: /* FIXME - finish */
- {
- }
- endcase;
-
case ID_SP_FETCH: /* ( -- sp , address of top of stack, sorta ) */
PUSH_TOS;
TOS = (cell_t)STKPTR;
else M_DROP;
endcase;
+ case ID_SOURCE_LINE_NUMBER_FETCH: /* ( -- linenr ) */
+ PUSH_TOS;
+ TOS = gCurrentTask->td_LineNumber;
+ endcase;
+
+ case ID_SOURCE_LINE_NUMBER_STORE: /* ( linenr -- ) */
+ gCurrentTask->td_LineNumber = TOS;
+ TOS = M_POP;
+ endcase;
+
case ID_SWAP:
Scratch = TOS;
TOS = *STKPTR;