home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / MINIDECO.WRD < prev    next >
Encoding:
Text File  |  1992-11-20  |  1.3 KB  |  68 lines  |  [04] ASCII Text (0x0000)
  1.  
  2. : -WORD BL WORD ;
  3.  
  4. : &  ( ---  TAKES FOLLING CHARACTER & COMPILES IT AS A LITERAL )
  5.    -WORD 1+ C@ [COMPILE] LITERAL 
  6. ; IMMEDIATE
  7.  
  8.  
  9.  
  10. ( ========================================= )
  11. ( WORD DECOMPILER - FROM "FORTH TOOLS AND APPLICATIONS" )
  12. ( ========================================= )
  13.  
  14. FIND ;S      CONSTANT EXITCFA
  15. FIND 0BRANCH   CONSTANT ZBRACFA
  16. FIND BRANCH    CONSTANT BRACFA
  17. FIND LIT       CONSTANT LITCFA
  18. FIND CLIT      CONSTANT CLITCFA
  19. FIND (LOOP)    CONSTANT (LPCFA
  20. FIND (.")      CONSTANT (."CFA
  21.  
  22. VARIABLE CLITFLAG
  23.  
  24. ( PRINT NAME OF WORD GIVEN CODE FIELD ADDRESS )
  25. : CID.   ( CFA -- )
  26.    2+ NFA ID.
  27. ;
  28.  
  29. : GET#   ( ADRS -- ADRS+2 )
  30.    CLITFLAG @ IF 2+ DUP C@ . ELSE 2+ DUP @ . THEN
  31. ;
  32.  
  33. : NAME0
  34. DROP & . EMIT & " EMIT SPACE 2+ DUP COUNT >R R@ TYPE    & " EMIT SPACE R> 1- +
  35. ;
  36.  
  37. : NAME1
  38.  DUP (."CFA = IF NAME0   ELSE  CID. THEN
  39. ;
  40.  
  41. : NAME2
  42.       DUP ZBRACFA = OVER BRACFA = OR OVER (LPCFA = OR
  43. ;
  44.  
  45.  
  46. : NAME. ( PFA# CFA# -- PFA#' )
  47.    0 CLITFLAG ! DUP CLITCFA = IF 1 CLITFLAG ! THEN
  48.  
  49.    DUP LITCFA = OVER CLITCFA = OR
  50.    IF DROP GET# ELSE NAME2 IF CID. GET# ELSE NAME1 THEN THEN
  51. ;
  52.  
  53. : TESTCLIT
  54.     CLITFLAG @ -
  55. ;
  56.  
  57. : DECOMP0
  58.  BEGIN  DUP DUP . ." - " @ DUP EXITCFA -  WHILE   NAME. CR 2+ TESTCLIT REPEAT
  59.  2DROP
  60. ;
  61.  
  62. : DECOMP ( --   DECOMPILES FOLLOWING WORD )
  63.  CR  [COMPILE] '
  64.    DUP DUP CFA @ =
  65.  IF ." CODE WORD " DROP ELSE DECOMP0 THEN
  66. ;
  67.  
  68.