Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1.  
  2. REQUIRE PLACE  ~mak/place.f
  3. REQUIRE [IF] ~mak/CompIF.f
  4. REQUIRE DISASSEMBLER lib/ext/disasm.f
  5.  
  6. C" STREAM-FILE" FIND NIP
  7. [IF]
  8. : FROM_SOURCE-ID SOURCE-ID  STREAM-FILE ;
  9. : TO_SOURCE-ID FILE>RSTREAM TO SOURCE-ID ;
  10. [ELSE]
  11. : FROM_SOURCE-ID SOURCE-ID ;
  12. : TO_SOURCE-ID TO SOURCE-ID ;
  13. [THEN]
  14.  
  15. : INST [ ALSO DISASSEMBLER ] INST
  16.        [ PREVIOUS ]  ;
  17.  
  18. C" -CELL" FIND NIP 0=
  19. [IF] -1 CELLS CONSTANT -CELL
  20. [THEN]
  21.  
  22. CREATE  FILE_NAME_L 120 ALLOT
  23.  
  24. CREATE   HERE-TAB  5000 CELLS ALLOT
  25. HERE CELL-  CONSTANT HERE-TAB-MAX
  26. VARIABLE HERE-TAB-CUR
  27. HERE-TAB HERE-TAB-CUR !
  28. VARIABLE S_STATE
  29.  
  30. : HERE-TAB-CUR+
  31.   HERE-TAB-CUR @  CELL+ HERE-TAB-MAX UMIN
  32.   HERE-TAB-CUR
  33.  !
  34. \ [ .( XXXX) DIS-OPT KEY DROP ]
  35.  ;
  36.  
  37. : HERE-TO-TAB DP @ HERE-TAB-CUR @ ! HERE-TAB-CUR+ ;
  38.  
  39.  
  40. CREATE   SHERE-TAB  800 CELLS ALLOT
  41. HERE CELL-  CONSTANT SHERE-TAB-MAX
  42. VARIABLE SHERE-TAB-CUR
  43. SHERE-TAB SHERE-TAB-CUR !
  44.  
  45. : SHERE-TAB-CUR+
  46.   SHERE-TAB-CUR @  CELL+ SHERE-TAB-MAX UMIN
  47.   SHERE-TAB-CUR ! ;
  48.  
  49. : SHERE-TO-TAB DP @ SHERE-TAB-CUR @ ! SHERE-TAB-CUR+ ;
  50.  
  51. 80 VALUE DUMP_MAX
  52.  
  53. : MDUMP ( addr u -- )
  54.   DUP 0= IF 2DROP EXIT THEN
  55.   BASE @ >R HEX
  56.   BEGIN
  57.     CR OVER BASE-ADDR - 4 .0 SPACE
  58.     2DUP 0x10 MIN
  59.     2DUP 0 DO I 4 MOD 0= IF SPACE THEN
  60.              DUP C@ 2 .0 SPACE 1+
  61.            LOOP DROP
  62.     DUP >R PTYPE
  63.     R@ - SWAP R> + SWAP DUP 0=
  64.   UNTIL  2DROP
  65.   R> BASE ! CR
  66. ;
  67.  
  68. : .LIST ( ADDR  ADDR1 -- ADDR1' )
  69.          S_STATE @
  70.          IF
  71.             SWAP
  72.             BEGIN  2DUP U>
  73.             WHILE  INST CR
  74.             REPEAT  NIP
  75.          ELSE
  76.            TUCK  
  77.            OVER - DUP
  78.            IF   DUP DUMP_MAX U>
  79.  
  80.                IF  >R DUMP_MAX DUMP
  81.                    CR DUP U.  R> DUMP_MAX - U. ." bytes"
  82.                ELSE  MDUMP
  83.                THEN CR
  84.            ELSE 2DROP
  85.            THEN
  86.          THEN
  87. ;
  88. VECT INCLUDED$
  89.  
  90. ' INCLUDED TO INCLUDED$
  91. : INCLUDED_L
  92.    ['] <PRE> >BODY @ >R
  93.   ['] HERE-TO-TAB TO <PRE>
  94.      HERE-TAB  HERE-TAB-CUR !
  95.     SHERE-TAB SHERE-TAB-CUR !
  96.   2DUP 2>R  INCLUDED$  2R>  R> TO <PRE>
  97.  -1 SHERE-TAB-CUR @ !  SHERE-TAB-CUR+
  98.     HERE-TO-TAB
  99.     HERE-TO-TAB       -CELL HERE-TAB-CUR +!
  100.     HERE-TAB-CUR @ @  -CELL HERE-TAB-CUR +!
  101.     BEGIN HERE-TAB-CUR @ HERE-TAB <>
  102.     WHILE  HERE-TAB-CUR @ @ UMIN DUP HERE-TAB-CUR @ !
  103.           -CELL HERE-TAB-CUR +!
  104.     REPEAT DROP
  105.     S_STATE 0!
  106.     SHERE-TAB SHERE-TAB-CUR !
  107.  
  108.     2DUP FILE_NAME_L  PLACE
  109.   S" _L" FILE_NAME_L +PLACE  
  110.   R/O OPEN-FILE  THROW
  111.   FILE_NAME_L COUNT 2DUP + 0!
  112.   W/O CREATE-FILE THROW
  113.  
  114.   TIB >R >IN @ >R #TIB @ >R SOURCE-ID >R BLK @ >R CURSTR @ >R
  115.   H-STDOUT >R  BASE @ >R HEX
  116.   C/L 2 + ALLOCATE THROW TO TIB  BLK 0!
  117.   TO H-STDOUT
  118.   ." ZZ=" DUP .
  119.   TO_SOURCE-ID
  120.   CURSTR 0! HERE-TAB-CUR @ @
  121.   BEGIN    REFILL
  122.   WHILE
  123.         SOURCE TYPE CR
  124.         BEGIN  SHERE-TAB-CUR @ @ HERE-TAB-CUR @ CELL+ @ U<
  125.         WHILE  SHERE-TAB-CUR @ @ .LIST   SHERE-TAB-CUR+
  126.                  S_STATE @ INVERT S_STATE !
  127.         REPEAT  HERE-TAB-CUR+ HERE-TAB-CUR @ @ .LIST
  128.   REPEAT  DROP
  129.   TIB FREE THROW
  130.   FROM_SOURCE-ID
  131.   ." ZZ=" DUP .
  132.  CLOSE-FILE THROW ( îøèáêà çàêðûòèÿ ôàéëà )
  133.   H-STDOUT CLOSE-FILE THROW ( îøèáêà çàêðûòèÿ ôàéëà )
  134.   R> BASE ! R> TO H-STDOUT
  135.   R> CURSTR ! R> BLK ! R> TO SOURCE-ID R> #TIB ! R> >IN ! R> TO TIB
  136. ;
  137.  
  138. : REQUIRED_L ( waddr wu laddr lu -- )
  139.   2SWAP SFIND
  140.   IF DROP 2DROP EXIT
  141.   ELSE 2DROP INCLUDED_L THEN
  142. ;
  143.  
  144. [UNDEFINED] PSKIP [IF]
  145.   : PSKIP SKIP ;
  146. [THEN]
  147.  
  148. : REQUIRE_L ( "word" "libpath" -- )
  149.   BL PSKIP BL PARSE
  150.   BL PSKIP BL PARSE 2DUP + 0 SWAP C!
  151.   REQUIRED_L
  152. ;
  153.  
  154. : : : SHERE-TO-TAB ;
  155.  
  156. : ; POSTPONE ; SHERE-TO-TAB ; IMMEDIATE
  157.  
  158. : SSSS
  159.      HERE-TAB  HERE-TAB-CUR !
  160.     SHERE-TAB SHERE-TAB-CUR !
  161. ;
  162.