X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/46fcda16ac30c5555e21d11ea8e2089c657bf1d6..0868989592470c064bae35eea78a6d23669d1995:/csrc/pf_inner.c diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c index 8ecdec7..dcf12c6 100644 --- a/csrc/pf_inner.c +++ b/csrc/pf_inner.c @@ -1391,15 +1391,18 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql )); 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 @@ -1556,16 +1559,6 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql )); 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; @@ -1647,6 +1640,16 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql )); 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;