1 line
10 KiB
Plaintext
1 line
10 KiB
Plaintext
\ 8087 support - information 8087 extensions for DX-FORTH assembler Based on Pollack 8087 assembler \ 8087 support - load block [undefined] ASSEMBLER [if] 1 fload ASM [then] forth definitions hex sys @ system warning @ warning off cr .( loading 8087 Assembler ) 2 #screens 1- thru forth definitions decimal warning ! sys ! \ 8087 support assembler hidden definitions forth 0 value fm \ 0=real32 1=int64 2=int32 3=bcd \ 4=real64 5=tmp80 6=int16 assembler definitions hidden : WORD 6 to fm ; : DWORD 0 to fm ; : QWORD 4 to fm ; : TBYTE 5 to fm ; \ 8087 support A00 constant ST aka ST ST(0) A01 constant ST(1) A02 constant ST(2) A03 constant ST(3) A04 constant ST(4) A05 constant ST(5) A06 constant ST(6) A07 constant ST(7) assembler hidden definitions forth : fst? ( r -- r f ) dup ST and ST = ; : st? ( r -- r f ) dup ST = ; \ 8087 support create fmap \ translation table 0 c, 1 c, 0 c, 3 c, 4 c, 5 c, 4 c, \ real 2 c, 1 c, 2 c, 3 c, 1 c, 5 c, 6 c, \ integer : i/r ( -- ) \ map int/real fm dup 0< if 0FF and 7 + then fmap + c@ to fm ; : fr, ( r m1 m2 -- ) esc, swap low op, ; : esm, ( disp mr m1 m2 ) esc, m, qword ; : fm, ( disp mr m -- ) fm esm, ; : fm1, ( disp mr m -- ) fm 1 or esm, ; \ 8087 support : mf value does> @ , ; : mg constant does> c@ 6 fr, ; : mh value does> dup c@ swap 1+ c@ esm, ; : mi value does> >r fst? if r> c@ 0 fr, else r> 1+ c@ i/r fm, then ; : mj value does> >r fst? if st? if swap 0 esc, low 0 else 4 esc, low r@ 1+ c@ then r> c@ xor op, drop else r> c@ 3F and i/r fm, then ; \ 8087 support : mk value , does> >r fst? if r@ 1+ c@ r@ c@ fr, else r@ 2+ c@ i/r fm case 1 of 8 or 7 esm, endof \ I64 3 of 7 esm, endof \ BCD 5 of 8 or 3 esm, endof \ T80 2drop r@ 3 + c@ fm1, 0 endcase then r> drop ; : ml value does> fm 8000 or to fm @ execute ; : mm 2constant does> 2@ to fm execute ; assembler definitions hidden \ 8087 support D0D9 mf FNOP E0D9 mf FCHS E1D9 mf FABS E4D9 mf FTST E5D9 mf FXAM E8D9 mf FLD1 E9D9 mf FLDL2T EAD9 mf FLDL2E EBD9 mf FLDPI ECD9 mf FLDLG2 EDD9 mf FLDLN2 EED9 mf FLDZ F0D9 mf F2XM1 F1D9 mf FYL2X F2D9 mf FPTAN F3D9 mf FPATAN F4D9 mf FXTRACT F5D9 mf FPREM1 F6D9 mf FDECSTP F7D9 mf FINCSTP F8D9 mf FPREM F9D9 mf FYL2XP1 FAD9 mf FSQRT FBD9 mf FSINCOS FCD9 mf FRNDINT FDD9 mf FSCALE FED9 mf FSIN FFD9 mf FCOS E0DB mf FENI E1DB mf FDISI E2DB mf FCLEX E3DB mf FINIT D9DE mf FCOMPP C0 mg FADDP C8 mg FMULP E0 mg FSUBRP E8 mg FSUBP F0 mg FDIVRP F8 mg FDIVP \ 8087 support 120 mh FLDENV 128 mh FLDCW 130 mh FSTENV 138 mh FSTCW 520 mh FRSTOR 530 mh FSAVE 10D0 mi FCOM 18D8 mi FCOMP 0C0 mj FADD 0C8 mj FMUL 8E8 mj FSUBR 8E0 mj FSUB 8F0 mj FDIV 8F8 mj FDIVR 0020 C001 mk FLD 1830 D805 mk FSTP : FFREE C0 5 fr, ; : FXCH C8 1 fr, ; : FST fst? if D0 5 fr, else i/r 10 fm1, then ; \ 8087 support : FSTSW dup AX = if drop E0DF , else 38 5 esm, then ; ' fadd ml FIADD ' fcom ml FICOM ' fcomp ml FICOMP ' fdiv ml FIDIV ' fdivr ml FIDIVR ' fld ml FILD ' fmul ml FIMUL ' fst ml FIST ' fstp ml FISTP ' fsub ml FISUB ' fsubr ml FISUBR ' fld 3 mm FBLD ' fstp 3 mm FBSTP \ ' fld 5 mm FTLD ' fstp 5 mm FTSTP ( use TBYTE) |