home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / forth / min4th25.arc / MINI.MIN < prev    next >
Text File  |  1988-08-08  |  2KB  |  59 lines
  1. : ' LOCATE ?? ;
  2. : IMMEDIATE TDP $40 CXR ; IMMEDIATE
  3. : ['] IMMEDIATE ' COMPILE LIT , ;
  4. : [COMPILE] IMMEDIATE ?C ' , ;
  5. : ASCII IMMEDIATE BL WORD 1+ C@ [COMPILE] LITERAL ;
  6. : =? = ?? ;
  7. : IF IMMEDIATE COMPILE 0br HERE 2 ALLOT 1 ;
  8. : ELSE IMMEDIATE 1 =? COMPILE br HERE 2+ SWAP ! HERE 2 ALLOT 1 ;
  9. : THEN IMMEDIATE 1 =? HERE SWAP ! ;
  10. : TO IMMEDIATE COMPILING IF COMPILE to ELSE ' 3+ @ ! THEN ;
  11. : +TO IMMEDIATE COMPILING IF COMPILE +to ELSE ' 3+ @ +! THEN ;
  12. : WIPE   DUP @ CURRENT @ ! TO HERE ;
  13. : BEGIN IMMEDIATE ?C HERE 2 ;
  14. : UNTIL IMMEDIATE 2 =? COMPILE 0br , ;
  15. : WHILE IMMEDIATE 2 =? COMPILE 0br HERE 2 ALLOT 0 ;
  16. : REPEAT IMMEDIATE 0 =? COMPILE br HERE 2+ SWAP ! , ;
  17. : do SWAP OVER - NEGATE $8000 + ;
  18. : DO IMMEDIATE COMPILE do COMPILE 2>R 2R> R> 0 2>R 2>R HERE ;
  19. : RL COMPILING ?? R>
  20.      BEGIN R> ?DUP
  21.      WHILE HERE SWAP !
  22.      REPEAT >R ;
  23. : LOOP IMMEDIATE COMPILE lp , 2R> R> RL >R 2>R ;
  24. : +LOOP IMMEDIATE COMPILE +lp , 2R> R> RL >R 2>R ;
  25. : LEAVE IMMEDIATE 1 =? COMPILE 2R> COMPILE 2DROP COMPILE br
  26.     2R> R> HERE 2>R 2>R 2 ALLOT 1 ;
  27. : N>C COUNT 1F AND + ;
  28. : C>N      1-     BEGIN DUP C@ $80 < 
  29.         WHILE 1-
  30.         REPEAT ;
  31. : C>L C>N 2- ;
  32. : ME TDP N>C ;
  33. : CLASS ME PATCH LINK ;
  34. : VARIABLE CREATE 2 ALLOT LINK ;
  35. : CONSTANT CREATE , ['] 0 CLASS ;
  36. : TOVAR CREATE HERE 2+ , 0 , ['] BASE CLASS ;
  37. TOVAR FENCE
  38. : VECTOR CREATE LINK ;
  39. VECTOR FORGET
  40. : FG  ' C>L FENCE OVER U< ?? WIPE ;
  41. ' FG ' FORGET PATCH
  42. HERE TO FENCE
  43. : ABS DUP 0< IF NEGATE THEN ;
  44. : DABS DUP 0< IF DNEGATE THEN ;
  45. : MU/MOD >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ;
  46. TOVAR HLD
  47. : PAD HERE 100 + ;
  48. : <# PAD TO HLD ;
  49. : #> 2DROP HLD PAD OVER - ;
  50. : HOLD -1 +TO HLD HLD C! ;
  51. : # BASE MU/MOD ROT 9 OVER < IF 7 + THEN ASCII 0 + HOLD ;
  52. : #S BEGIN # 2DUP OR 0= UNTIL ;
  53. : SIGN 0< IF ASCII - HOLD THEN ;
  54. : ## <# #S ROT SIGN #> ;
  55. : . DUP ABS 0 ## TYPE SPACE ;
  56. : .U  0 <# #S #> TYPE SPACE ;
  57. : .D DUP ROT SWAP DABS ## TYPE SPACE ;
  58. BYE
  59.