PAGE 64,132
TITLE LISTING 1 - PAS87 PASCAL SUPPORT FOR 8087
;
;	************	BYTE MAGAZINE 	***************
;			SEPTEMBER 1983

MEMOP	MACRO	P1,P2
	PUSH	BP
	MOV	BP,SP
	MOV	BP,[BP+6]
	P1 P2 [BP]
	POP	BP
	RET	2
ENDM

PASSTACK MACRO R1,R2,R3
	LOCAL FLAG
	PUSH	BP
	MOV	BP,SP
	MOV	BX,OFFSET FLAG+2
	MOV	AL,CS:[BX]
	AND	AL,0F8H
	OR	AL,[BP+6]
	MOV	CS:[BX],AL
	JMP	FLAG
FLAG:
	R1 R2 R3
	POP 	BP
	RET	2
ENDM

PAGE

PAS87 	MACRO P1,P2,P3
	IFB <P2>
		PUBLIC F_&P1
		F_&P1 PROC FAR
		P1
		RET
		F_&P1 ENDP
	ELSE
		IFIDN <P2>,<SHORT>
			PUBLIC FSHORT_&P1
			FSHORT_&P1 PROC FAR
			MEMOP P1 P2
			FSHORT_&P1 ENDP
		ELSE
			IFIDN <P2>,<LONG>
				PUBLIC FLONG_&P1
				FLONG_&P1 PROC FAR
				MEMOP P1 P2
				FLONG_&P1 ENDP
			ELSE
				IFIDN <P2>,<TEMP>
				    PUBLIC FTEMP_&P1
				    FTEMP_&P1 PROC FAR
				    MEMOP P1 P2
				    FTEMP_&P1 ENDP
				ELSE
				    IFIDN <P2>,<WORD>
					PUBLIC FWORD_&P1
					FWORD_&P1 PROC FAR
					MEMOP P1 P2
					FWORD_&P1 ENDP
				    ELSE	
					IFIDN <P2>,<ST>
					   PUBLIC FST_&P1
					   FST_&P1 PROC FAR
 					   PASSTACK P1 P2 P3
					   FST_&P1 ENDP
				        ELSE
					   IFIDN <P2>,<SPECIAL>
						PUBLIC FSPEC_&P1
						FSPEC_&P1 PROC FAR			
						MEMOP P1
					   	FSPEC_&P1 ENDP
					ELSE
					   PUBLIC FSTI_&P1
					   FSTI_&P1 PROC FAR
					   PASSTACK P1 P2 P3
					   FSTI_&P1 ENDP
					ENDIF
				    ENDIF
				ENDIF
			   ENDIF
		      ENDIF		
		ENDIF
	ENDIF
ENDM

IF1
	INCLUDE A:M8087.MAC
ENDIF

ASSUME CS:CODE, DS:CODE
CODE  SEGMENT

PAS87	FABS
PAS87	FADD
PAS87	FADD	ST,ST(i)
PAS87	FADD	ST(i),ST
PAS87	FADD	SHORT
PAS87	FADD	LONG
PAS87	FADDP
PAS87	FADDP	ST(i),ST
PAS87	FBLD	SPECIAL
PAS87	FBSTP	SPECIAL
PAS87	FCHS
PAS87	FCLEX
PAS87	FCOM
PAS87	FCOM	ST(i)
PAS87	FCOM	SHORT
PAS87	FCOM	LONG
PAS87	FCOMP
PAS87	FCOMP	ST(i)
PAS87	FCOMP	SHORT
PAS87	FCOMP	LONG
PAS87	FCOMPP
PAS87	FDECSTP
PAS87	FDISI
PAS87	FDIV
PAS87	FDIV	ST(i),ST
PAS87	FDIV	SHORT
PAS87	FDIV	LONG
PAS87	FDIVP	ST(i),ST
PAS87	FDIVR
PAS87	FDIVR	ST,ST(i)
PAS87	FDIVR	ST(i),ST
PAS87	FDIVR	SHORT
PAS87	FDIVR	LONG
PAS87	FDIVRP	ST(i),ST
PAS87	FENI
PAS87	FFREE	ST(i)	
PAS87	FIADD	WORD
PAS87	FIADD	SHORT
PAS87	FICOM	WORD
PAS87	FICOM	SHORT
PAS87	FICOMP	WORD
PAS87	FICOMP	SHORT
PAS87	FIDIV	WORD
PAS87	FIDIV	SHORT
PAS87	FIDIVR	WORD
PAS87	FIDIVR	SHORT	
PAS87	FILD	WORD
PAS87	FILD	SHORT
PAS87	FILD	LONG
PAS87	FIMUL	WORD
PAS87	FIMUL	SHORT
PAS87	FINCSTP
PAS87	FINIT
PAS87	FIST	WORD
PAS87	FIST	SHORT
PAS87	FISTP	WORD
PAS87	FISTP	SHORT
PAS87	FISTP	LONG
PAS87	FISUB	WORD
PAS87	FISUB	SHORT
PAS87	FISUBR	WORD
PAS87	FISUBR	SHORT
PAS87	FLD	ST(i)
PAS87	FLD	SHORT	
PAS87	FLD	LONG
PAS87	FLD	TEMP
PAS87	FLDCW	SPECIAL
PAS87	FLDENV	SPECIAL	
PAS87	FLDLG2
PAS87	FLDLN2	
PAS87	FLDL2E
PAS87	FLDL2T
PAS87	FLDPI
PAS87	FLDZ
PAS87	FLD1
PAS87	FMUL
PAS87	FMUL	ST(i),ST
PAS87	FMUL	ST,ST(i)
PAS87	FMUL	SHORT
PAS87	FMUL	LONG
PAS87	FMULP	ST(i),ST
PAS87	FNCLEX
PAS87	FNDISI
PAS87	FNENI
PAS87	FNINIT
PAS87	FNOP
PAS87	FNSAVE	SPECIAL
PAS87	FNSTCW	SPECIAL
PAS87	FNSTENV	SPECIAL
PAS87	FNSTSW	SPECIAL
PAS87	FPATAN
PAS87	FPREM
PAS87	FPTAN
PAS87	FRNDINT
PAS87	FRSTOR	SPECIAL
PAS87	FSAVE	SPECIAL
PAS87	FSCALE
PAS87	FSQRT
PAS87	FST	ST(i)
PAS87	FST	SHORT
PAS87	FST	LONG
PAS87	FSTCW	SPECIAL
PAS87	FSTENV	SPECIAL
PAS87	FSTP	ST(i)
PAS87	FSTP	SHORT
PAS87	FSTP	LONG
PAS87	FSTP	TEMP
PAS87	FSTSW	SPECIAL
PAS87	FSUB	
PAS87	FSUB	ST,ST(i)
PAS87	FSUB	ST(i),ST
PAS87	FSUB	SHORT
PAS87	FSUB	LONG
PAS87	FSUBP	ST(i),ST
PAS87	FSUBR
PAS87	FSUBR	ST(i),ST
PAS87	FSUBR	ST,ST(i)
PAS87	FSUBR	SHORT
PAS87	FSUBR	LONG
PAS87	FSUBRP	ST(I),ST
PAS87	FTST
PAS87	FWAIT
PAS87	FXAM
PAS87	FXCH
PAS87	FXCH	ST(i)
PAS87	FXTRACT
PAS87	FYL2X
PAS87	FYL2XP1
PAS87	F2XM1

PAGE

;PROCEDURE C_IBM_8087(VAR X : REAL);

PUBLIC C_IBM_8087

C_IBM_8087	PROC	FAR
	PUSH	BP
	MOV	BP,SP
	MOV	BP,[BP+6]
	MOV	AX,[BP+2]
	CMP	AX,0
	JNE	CONTIBM
	CMP	WORD PTR [BP],0
	JE	EXITIBM
CONTIBM:
	DEC	AH
	DEC	AH
	RCL	AL,1
	RCR	AH,1
	RCR	AL,1
	MOV	[BP+2],AX
EXITIBM:
	POP	BP
	RET	2
C_IBM_8087	ENDP

;PROCEDURE C_8087_IBM(VAR X : REAL);

PUBLIC C_8087_IBM

C_8087_IBM	PROC	FAR
	PUSH	BP
	MOV	BP,SP
	MOV	BP,[BP+6]
	MOV	AX,[BP+2]
	CMP	AX,0
	JNE	CONT8087
	CMP	WORD PTR [BP],0
	JE	EXIT8087
CONT8087:
	RCL	AL,1
	RCL	AH,1
	RCR	AL,1
	INC	AH
	INC	AH
	MOV	[BP+2],AX
EXIT8087:
	POP	BP
	RET	2
C_8087_IBM	ENDP

;FUNCTION CHK87 : INTEGER

PUBLIC CHK87

CHK87	PROC	FAR
	PUSH	AX
	PUSH	BP
	MOV	BP,SP
	FSTSW	[BP+2]
	POP	BP
	POP	AX
	SAHF
	JB	A_LESS_OR_UNORDERED
	JNE	A_GREATER
A_EQUAL:
	MOV	AL,0
	JMP	SHORT EXIT_CHK
A_GREATER:
	MOV	AL,1
	JMP	SHORT	EXIT_CHK
A_LESS_OR_UNORDERED:
	JNE	A_LESS
A_B_UNORDERED:
	MOV	AL,3
	JMP	SHORT EXIT_CHK
A_LESS:
	MOV	AL,2
EXIT_CHK:
	MOV	AH,0
	RET
CHK87	ENDP

;FUNCTION EXAM87 : INTEGER

PUBLIC	EXAM87
EXAM87	PROC	FAR
	FXAM
	PUSH	AX
	PUSH	BP
	MOV	BP,SP
	FSTSW	[BP+2]
	POP	BP
	POP	AX
	MOV	AL,AH
	AND	AX,4007H
	SHR	AH,1
	SHR	AH,1
	SHR	AH,1
	OR	AL,AH
	MOV	AH,0
	RET
EXAM87	ENDP
PAGE	

;FUNCTION GETST : INTEGER

PUBLIC GETST

GETST	PROC	FAR
	PUSH	AX
	PUSH	BP
	MOV	BP,SP
	FSTSW	[BP+2]
	POP	BP
	POP	AX
	MOV	AL,AH
	AND	AX,0038H
	SHR	AL,1
	SHR	AL,1
	SHR	AL,1
	RET
GETST	ENDP

;FUNCTION STATUS : INTEGER

PUBLIC STATUS

STATUS 	PROC 	FAR
	PUSH	AX
	PUSH	BP
	MOV	BP,SP
	FSTSW	[BP+2]
	POP	BP
	POP	AX
	MOV	AH,0
	RET
STATUS	ENDP

CODE	ENDS
END
STAT