/*---------------------------------------------------------*/
/*	 PC Scheme 3.0 Transcendental Function Support	   */
/*  (c) Copyright 1987 by Texas Instruments Incorporated   */
/*		       All Rights Reserved.		   */
/*---------------------------------------------------------*/

/*
   This program is the Lattice C (version 3.0) implementation of the
   transcendental functions in PC Scheme, version 3, and is the one
   officially supported.  The file NEWTRIG.EXE on the Scheme diskettes is
   the compiled version of this file.

   Because this file uses the S (small) memory model, it requires a small
   assembly language program to do the far calls to the XLI "wait" and "bye"
   routines; refer to GLUE_LC.ASM.

   To build TRIG_LC.EXE (which is just NEWTRIG.EXE renamed), perform the
   following steps; you may need to substitute directory names and set
   your path accordingly.

	lc trig_lc
	masm glue_lc;
	link  \lc\s\c+trig_lc+glue_lc,trig_lc,,\lc\s\lcm+\lc\s\lc

   Lattice C's version 3 math library is a sensing library able to use
   an 8087/80287 if it is available or emulate it otherwise.  It is
   possible to split the library apart into the 8087 and non-8087 versions,
   which will make each one smaller (particularly the 8087 version), but
   then you can run each version only on a properly equipped machine.
   Refer to the Lattice documentation for details on how to do this.
*/


#include "dos.h"
#include "math.h"

#define F_NEAR	  0x0001
#define F_PAD	  0x0008

#define RT_DOUBLE  3

typedef unsigned short WORD;		/* 16-bit unsigned value */

extern WORD _psp;			/* Lattice C variables */
extern WORD _tsize;

/* Note xwait and xbye are the actual addresses we'll jump to when we
   call XLI from the glue routine.  C calls the glue routine at the
   two entry points xli_wait and xli_bye.  These 2 routines set
   up the stack for calling xwait and xbye.  */
WORD xwait[2];				/* XLI entry points */
WORD xbye[2];

struct xli_file_struct {
  WORD id;
  WORD flags;
  WORD table[2];			/* offset in 0, segment in 1 */
  WORD parm_block[2];
  WORD reserved[8];
} file_block;

struct xli_routine_struct {
  WORD select;
  WORD special_service;
  WORD ss_args[8];
  WORD reserved[8];
  WORD return_type;
  double return_value;
  double arg1;
  double arg2;
} parm_block;

char table[] =
/* 0	    2	    4	      6 	 8	  10	   12	  */
  "sqrt/sin/cos/tan/asin/acos/atan/atan2/exp/expt/ln/log10/log//";


void main(argc,argv)
int argc;
char *argv[];
{
  WORD psp;
/*WORD memsize;     */
  WORD buffer[2];
  struct SREGS segregs;
  int xli_wait();
  void xli_bye();

  /* Note PSP@ is not necessarily directly accessible in any
     Lattice C memory model. */
  psp = *(&_psp+1);			/* get seg addr of PSP */

  /* init file block */
  file_block.id = 0x4252;
  file_block.flags = F_NEAR+F_PAD;
  file_block.table[0] = (WORD) table;
  file_block.parm_block[0] = (WORD) &parm_block;
  segread(&segregs);
  file_block.table[1] = segregs.ds;
  file_block.parm_block[1] = segregs.ds;

  /* determine link address */
  buffer[0] = (WORD) &file_block;
  buffer[1] = segregs.ds;

  /* determine size to keep */
/*memsize = _tsize;   */	   /* done in glue routine for S Lattice */

  /* establish the link addresses between C and PCS */
  poke((int) psp, 0x5c, (char *) buffer, 4);  /* poke file block@ into PSP */
  peek((int) psp, 0x0a, (char *) xwait, 4);   /* get DOS ret@ */
  xbye[0] = xwait[0];
  xbye[1] = xwait[1];
  xwait[0] += 3;			      /* incr by 3 for normal call */
  xbye[0] += 6; 			      /* incr by 6 for termination */

  while (xli_wait()) {
    switch (parm_block.select) {
      case  0: parm_block.return_value = sqrt(parm_block.arg1);  break;
      case  1: parm_block.return_value = sin(parm_block.arg1);	 break;
      case  2: parm_block.return_value = cos(parm_block.arg1);	 break;
      case  3: parm_block.return_value = tan(parm_block.arg1);	 break;
      case  4: parm_block.return_value = asin(parm_block.arg1);  break;
      case  5: parm_block.return_value = acos(parm_block.arg1);  break;
      case  6: parm_block.return_value = atan(parm_block.arg1);  break;
      case  7: parm_block.return_value =
		 atan2(parm_block.arg1,parm_block.arg2);	 break;
      case  8: parm_block.return_value = exp(parm_block.arg1);	 break;
      case  9: parm_block.return_value =
		 pow(parm_block.arg1,parm_block.arg2);		 break;
      case 10: parm_block.return_value = log(parm_block.arg1);	 break;
      case 11: parm_block.return_value = log10(parm_block.arg1); break;
      case 12: parm_block.return_value =
		 log(parm_block.arg1) / log(parm_block.arg2);	 break;
      default: ;
    } /* end switch */
    parm_block.return_type = RT_DOUBLE;
  } /* end while */

  xli_bye();

} /* end main */