home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / forth / mac / 28 < prev    next >
Encoding:
Text File  |  1992-12-14  |  1.4 KB  |  56 lines
  1. Newsgroups: comp.lang.forth.mac
  2. Path: sparky!uunet!zaphod.mps.ohio-state.edu!darwin.sura.net!spool.mu.edu!umn.edu!csus.edu!netcom.com!jimlynch
  3. From: jimlynch@netcom.com (Jim Lynch)
  4. Subject: Re: Pocket Forth
  5. Message-ID: <1992Dec15.032759.23843@netcom.com>
  6. Organization: Netcom - Online Communication Services  (408 241-9760 guest) 
  7. References: <sorry?no?email-141292131847@meded6.med.upenn.edu>
  8. Date: Tue, 15 Dec 1992 03:27:59 GMT
  9. Lines: 45
  10.  
  11. Here's a pre-83 PICK for Pocket Forth,,, ROLL, -ROLL and PACK might be
  12. forthcoming someday...
  13.  
  14. --- cut here
  15. : code create -8 allot ;
  16.  
  17. hex
  18.  
  19. code pick ( works! )
  20.  3D3C , 0002 ,  ( MOVE    #$02,-(PS) )
  21.  4EAB , ' * ,   ( JSR    times-base(BP) )
  22.  301E ,         ( MOVE    (PS)+,D0 )
  23.  41F6 , 0000 ,  ( LEA    0(PS,D0.W),A )
  24.  3D20 ,         ( MOVE    -(A0),-(PS) )
  25.  4E75 ,         ( RTS )
  26.  
  27. decimal
  28.  
  29. : (-loop) ( amount to subtract from index -> flag for until. )
  30.  r> r> ( ret addr )
  31.  r> ( index )
  32.  4 pick -
  33.  dup r > 0= ( terminate do...-loop now? ) dup
  34.  if   swap drop ( drop new index )
  35.       r> drop ( drop limit )
  36.       rot rot >r >r ( put ret addr back )
  37.  else swap >r ( put index back )
  38.       rot rot >r >r ( put ret addr back )
  39.  then
  40.  swap drop ( get rid of amount )
  41. ;
  42.  
  43. : -loop [ ' (-loop) literal ] compile [compile] until ; immediate
  44. --- cut here
  45.  
  46. Oh yeah, here's a bonus: -loop!
  47.  
  48. Try this:
  49.  
  50. : CountBackwards 0 4 do r . 1 -loop ; CountBackwards
  51.  
  52. One more thing: 1 pick = dup, 2 pick = over...
  53.  
  54. Enjoy.
  55.  
  56.