%include "itrimp_hostcodes"
!
%CONSTINTEGER TARGET=M88K
!%EXTERNALROUTINESPEC IOCP %ALIAS "s#iocp"(%INTEGER EP,N)
!
! crude versions of the fortran exponentiation functions used by imp
!
%EXTERNALINTEGERFN POWII %ALIAS "F_POWII" %C
         (%%INTEGER ARG, %INTEGER NARG)
!
!     CALCULATES ARG**NARG
!
%integer XX,YY
%INTEGER N

%IF NARG<0 %THEN %signal %event 5,5

%IF NARG=0 %then %result=1

%IF ARG=0 %START
    %RESULT= 0
%FINISH

%IF ARG=1 %THEN %RESULT= 1
%IF ARG=-1 %START
  %IF N&1=1 %THEN %RESULT= -1 %ELSE %RESULT= 1
%FINISH
!
!
  XX= ARG
  YY= 1 
  %CYCLE
    %IF NARG&1#0 %THEN YY= YY*XX
    NARG = NARG>>1
    %IF NARG#0 %THEN XX= XX*XX %ELSE %EXIT
  %REPEAT
      %result=YY
%END {OF POWRI}
%externalrealfn powrr %alias "F_POWRR" (%real x,y)
%real z
      z=exp(y*log(x))
      %result=z
%end
%EXTERNALREALFN POWRI %ALIAS "F_POWRI" %C
         (%REAL ARG, %INTEGER NARG)
%CONSTANTLONGREAL LONE= 1.0
!
!     CALCULATES ARG**NARG
!
%LONGREAL XX,YY
%REAL Y
%INTEGER N

%IF NARG<0 %THEN N= -NARG %ELSE N= NARG

%IF N=0 %then %result=1.0

%IF ARG=0.0 %START
    %RESULT= 0.0
%FINISH

%IF ARG=1.0 %THEN %RESULT= 1.0
%IF ARG=-1.0 %START
  %IF N&1=1 %THEN %RESULT= -1.0 %ELSE %RESULT= 1.0
%FINISH
!
!     USER POWER FUNCION FOR REAL EXPONENT IF MAGNITUDE OF EXPONENT > 64
!
%IF N>64 %START
  %IF ARG>=0.0 %THEN %RESULT=  POWRR( ARG,FLOAT(NARG)) %ELSESTART
    %IF N&1#1   %THEN %RESULT=  POWRR(-ARG,FLOAT(NARG)) %C
                %ELSE %RESULT= -POWRR(-ARG,FLOAT(NARG))
  %FINISH
%FINISHELSESTART
!
!     USE EXTENDED PRECISION FOR LOWER POWERS (<=64)
!     ALLOW OVERFLOW TO SIGNAL FAILURE ON DIVISION OR MULT
!
  XX= ARG
  YY= LONE 
  %CYCLE
    %IF N&1#0 %THEN YY= YY*XX
    N = N>>1
    %IF N#0 %THEN XX= XX*XX %ELSE %EXIT
  %REPEAT
  Y= YY
  %IF NARG<0 %THEN %RESULT= 1.0/Y %ELSE %RESULT= Y
%FINISH
%END {OF POWRI}
%externalrealfn powdd %alias "F_POWDD" (%longreal x,y)
%longreal z
      z=exp(y*log(x))
      %result=z
%end
%EXTERNALLONGREALFN POWDI %ALIAS "F_POWDI" %C
         (%longreal ARG, %INTEGER NARG)
%CONSTANTLONGREAL LONE= 1.0
!
!     CALCULATES ARG**NARG
!
%LONGREAL XX,YY
%INTEGER N

%IF NARG<0 %THEN N= -NARG %ELSE N= NARG

%IF N=0 %then %result=1.0

%IF ARG=0.0 %START
    %RESULT= 0.0
%FINISH

%IF ARG=1.0 %THEN %RESULT= 1.0
%IF ARG=-1.0 %START
  %IF N&1=1 %THEN %RESULT= -1.0 %ELSE %RESULT= 1.0
%FINISH
!
!     USER POWER FUNCION FOR REAL EXPONENT IF MAGNITUDE OF EXPONENT > 64
!
%IF N>64 %START
  %IF ARG>=0.0 %THEN %RESULT=  powdd( ARG,FLOAT(NARG)) %ELSESTART
    %IF N&1#1   %THEN %RESULT=  powdd(-ARG,FLOAT(NARG)) %C
                %ELSE %RESULT= -powdd(-ARG,FLOAT(NARG))
  %FINISH
%FINISHELSESTART
!
!     USE EXTENDED PRECISION FOR LOWER POWERS (<=64)
!     ALLOW OVERFLOW TO SIGNAL FAILURE ON DIVISION OR MULT
!
  XX= ARG
  YY= LONE 
  %CYCLE
    %IF N&1#0 %THEN YY= YY*XX
    N = N>>1
    %IF N#0 %THEN XX= XX*XX %ELSE %EXIT
  %REPEAT
  %IF NARG<0 %THEN %RESULT= 1.0/YY %ELSE %RESULT= YY
%FINISH
%END {OF POWDI}
%externalroutine Cstring(%string(*)%name Impstring,%integer adcstr)
!***********************************************************************
!*    Converts an Imp string to C format                               *
!***********************************************************************
%integer l,i
      l=length(Impstring)
      %for i=1,1,L %cycle
         byteinteger(adcstr+i-1)=charno(Impstring,i)
       %repeat
      byteinteger(adcstr+l)=0
%end
%externalstring(255)%fn Impstring(%integer acstring)
!***********************************************************************
!*    Converts a cstring at acstring to an imp string                  *
!***********************************************************************
%integer i,j
%string(255) s
      %for i=0,1,255 %cycle
         j=byteinteger(acstring+i)
         %if j=0 %then %exit
         byteinteger(addr(s)+1+i)=j
      %repeat
      byteinteger(addr(s))=i
      %result=s
%end
%ENDOFFILE