home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / fdis.seq < prev    next >
Text File  |  1987-12-11  |  5KB  |  162 lines
  1. \ FDISASS.SEQ   Floating point disassembler extensions  by Robert L. Smith
  2.  
  3. NEEDS DISASSEM.SEQ
  4.  
  5. \ Floating Point disassembler
  6. HEX   DISASSEMBLER DEFINITIONS
  7. : NOTYPE ;
  8. .SELF INTEGER*2     .SELF INTEGER*4      .SELF INTEGER*8
  9. .SELF REAL*4        .SELF REAL*8         .SELF TEMP_REAL
  10. .SELF BCD
  11.  
  12. : FTYPE7    ( op ext -- op ext )
  13.      DUP 3 2/S 1 AND EXEC:  BCD INTEGER*8 STOP[
  14.  
  15. .SELF ST      .SELF ST(0)    .SELF ST(1)    .SELF ST(2)
  16. .SELF ST(3)   .SELF ST(4)    .SELF ST(5)    .SELF ST(6)
  17. .SELF ST(7)
  18.  
  19. comment:
  20. \ Disassembler definitions
  21.  
  22. NOTYPE       Print nothing for "type."
  23.              Various self-printing types.
  24.  
  25. FTYPE7       There are two possibilities for an ESC-7 code type:
  26.              either BCD or INTEGER*8.
  27.  
  28. ST(i)        Various self-identifying ST registers
  29.  
  30. comment;
  31. \ Print floating point arguments
  32.  
  33. : .STI   ( ext -- ext )
  34.      DUP 7 AND EXEC: ST(0) ST(1) ST(2) ST(3) ST(4)
  35.      ST(5) ST(6) ST(7) STOP[
  36.  
  37. : FTYPE   ( op ext -- op ext )
  38.      DUP C0 =  IF   NOTYPE EXIT   THEN
  39.      OVER 7 AND 2* OVER 20 AND  IF  1+  THEN
  40.      EXEC: REAL*4    REAL*4    REAL*4    NOTYPE
  41.           INTEGER*4 INTEGER*4 INTEGER*4 TEMP_REAL
  42.           REAL*8    REAL*8    REAL*8    NOTYPE
  43.           INTEGER*2 INTEGER*2 INTEGER*2 FTYPE7  STOP[
  44.  
  45. comment:
  46. \ Floating Point Arguments
  47.  
  48. .STI      Print an ST register, depending on the low order
  49.           3 bits.
  50.  
  51. FTYPE     Print the operand types.
  52.  
  53. comment;
  54.  
  55. : FST,STI   .STI ST ;
  56. : FSTI,ST   ST .STI ;
  57.  
  58. : FSTARGS  ( op ext -- op ext )
  59.      OVER DE =  IF  DUP 30 AND 10 -  IF FSTI,ST THEN EXIT THEN
  60.      OVER D9 =  IF  DUP 30 AND 0=  IF .STI  THEN  EXIT  THEN
  61.      OVER 7 AND EXEC:  FST,STI NOTYPE NOTYPE NOTYPE
  62.      FSTI,ST .STI NOTYPE NOTYPE STOP[
  63.  
  64. : FARGS  ( op ext -- op ext )
  65.      DUP C0 AND C0 =  IF  FSTARGS EXIT  THEN
  66.      FTYPE OVER 1 AND 0=
  67.      IF  ST  THEN  .MREG ;
  68.  
  69. comment:
  70.  
  71. FST,STI     Print an argument of the form  ST, ST(i)
  72. FSTI,ST     Print an argument of the form  ST(i), ST
  73.  
  74. FSTARGS     Print the arguments for the mod=11 case.  These
  75.             are typically of the form  ST,ST(i)  or  ST(i),ST
  76.             or none.
  77.  
  78. comment;
  79.  
  80. .SELF FADD    .SELF FMUL    .SELF FCOM    .SELF FCOMP
  81. .SELF FSUB    .SELF FSUBR   .SELF FDIV    .SELF FDIVR
  82.  
  83. .SELF FLD     .SELF FST     .SELF FSTP    .SELF FLDENV
  84. .SELF FLDCW   .SELF FSTENV  .SELF FSTCW   .SELF FRSTOR
  85. .SELF FSAVE   .SELF FSTSW
  86.  
  87. .SELF FXCH      .SELF FNOP      .SELF FCHS      .SELF FABS
  88. .SELF FTST      .SELF FXAM      .SELF FLD1      .SELF FLD2T
  89. .SELF FLDL2E    .SELF FLDPI     .SELF FLDLG2    .SELF FLDLN2
  90. .SELF FLDZ      .SELF FENI      .SELF FDISI     .SELF FCLEX
  91. .SELF FINIT     .SELF FADDP     .SELF FMULP     .SELF FSUBP
  92. .SELF FSUBRP    .SELF FDIVP     .SELF FSCALE    .SELF FFREE
  93. .SELF FDIVRP     .SELF F2XM1     .SELF FYL2X    .SELF FPTAN
  94. .SELF FPATAN     .SELF FXTRACT   .SELF FDECSTP  .SELF FINCSTP
  95. .SELF FPREM      .SELF FYL2XP1   .SELF FSQRT    .SELF FRNDINT
  96.  
  97. : FCOMPP   ( op ext -- op ext )
  98.      DUP 7 AND 1 =
  99.      IF   .MOI EXIT  THEN
  100.      ESC, EXIT ;
  101.  
  102. : F1FX   ( op ext -- op ext )
  103.      DUP 0F AND EXEC:
  104.      F2XM1  FYL2X  FPTAN  FPATAN FXTRACT ESC,  FDECSTP FINCSTP
  105.      FPREM  FYL2XP1 FSQRT ESC,  FRNDINT FSCALE ESC, ESC, STOP[
  106.  
  107. : F1EX   ( op ext -- op ext )
  108.      DUP 0F AND EXEC:
  109.      FCHS  FABS  ESC,   ESC,  FTST   FXAM   ESC,  ESC,
  110.      FLD1  FLD2T FLDL2E FLDPI FLDLG2 FLDLN2 FLDZ  ESC,  STOP[
  111.  
  112. : F1MOD11   ( op ext -- op ext )
  113.      DUP 38 AND 8 =  IF  FARGS FXCH EXIT  THEN
  114.      DUP F8 AND C0 =  IF  FARGS FLD EXIT  THEN
  115.      DUP D0 =  IF  FNOP  EXIT  THEN
  116.      DUP E0 <  IF  ESC, EXIT  THEN
  117.      DUP 4 2/S 1 AND EXEC: F1EX F1FX STOP[
  118.  
  119. : F5MOD11   ( op ext -- op ext )
  120.      DUP 3 2/S 7 AND DUP 3 >  IF  DROP ESC, EXIT  THEN
  121.      >R .STI R> EXEC: FFREE OOPS FST FSTP STOP[
  122.  
  123. : F6MOD11   ( op ext -- op ext )
  124.      FARGS DUP 3 2/S 7 AND EXEC:
  125.      FADDP FMULP ESC,  FCOMPP FSUBP FSUBRP FDIVP FDIVRP STOP[
  126.  
  127. : F3MOD11   ( op ext -- op ext )
  128.      DUP 38 AND 20 -
  129.      IF  ESC,
  130.      ELSE  DUP 7 AND EXEC:  FENI FDISI FCLEX FINIT
  131.      THEN ;
  132.  
  133. : FEVEN   ( op ext -- op ext )
  134.      FARGS DUP 3 2/S 7 AND EXEC:
  135.      FADD FMUL FCOM FCOMP FSUB FSUBR FDIV FDIVR  STOP[
  136.  
  137. : FMOD11OP  ( op ext -- op ext )
  138.      OVER 7 AND EXEC: FEVEN F1MOD11 FEVEN F3MOD11
  139.      FEVEN F5MOD11 F6MOD11 ESC, STOP[
  140.  
  141. : FODD0  ( op ext -- op ext )
  142.      FARGS DUP 3 2/S 3 AND EXEC: FLD ESC, FST FSTP STOP[
  143.  
  144. : FODD4  ( op ext -- op ext )
  145.      FARGS OVER 6 AND 2* OVER 3 2/S 3 AND OR EXEC:
  146.      FLDENV FLDCW FSTENV FSTCW ESC, FLD FSTP ESC,
  147.      FRSTOR FSAVE ESC, FSTSW FLD FLD FSTP FSTP STOP[
  148.  
  149. : FODD   ( op ext -- op ext )
  150.      DUP 38 AND 20 <  IF FODD0  ELSE FODD4  THEN ;
  151.  
  152. : FOPS  ( op ext -- op ext )
  153.      DUP C0 AND C0 =  IF  FMOD11OP EXIT THEN
  154.      OVER 1 AND  IF  FODD  ELSE  FEVEN  THEN ;
  155.  
  156. ' FOPS IS ESCCODE   \ Enable Floating Point
  157.  
  158. FORTH DEFINITIONS
  159.  
  160. DECIMAL
  161.  
  162.