/* ---------------------------------------------------------------------- */
/*                     This file is not copyrighted!                      */
/* ---------------------------------------------------------------------- */
#include "defines.h"
#include "nasm.h"

/* ---------------------------------------------------------- */
/*  This is from the ATARI BASIC Source Book reverse          */
/*  engineered. OK. Since only mathematicians would be        */
/*  interested in optimizing this code, and knowing their     */
/*  humorlessness let me explain: "This is a 9K joke!"        */
/*  **-PORT #6-**                                             */
/* ---------------------------------------------------------- */

#define _fprec     6
#define _fmprec    _fprec - 1

static signed char   a, x, y;
static signed char   c, t;
signed char          page0[ 0x100];
static signed char   page1[ 0x100];
static unsigned char p1_sp = 0xFF;
static signed char   *inbuff;

#define _fr0     0xD4U
#define _fr0m    0xD5U
#define _fre     0xDAU
#define _frx     0xECU
#define _eexp    0xEDU
#define _nsign   0xEEU
#define _esign   0xEFU
#define _fchrflg 0xF0U
#define _digrt   0xF1U
#define _cix     0xF2U

#define fr0      page0[ _fr0]
#define fr0m     page0[ _fr0m]
#define fre      page0[ _fre]
#define frx      page0[ _frx]
#define eexp     page0[ _eexp]
#define nsign    page0[ _nsign]
#define esign    page0[ _esign]
#define fchrflg  page0[ _fchrflg]
#define digrt    page0[ _digrt]
#define cix      page0[ _cix]


#define pha()  page1[ --p1_sp ] = a
#define pla()  a = page1[ p1_sp++]
#define bcc(v) if( ! c) goto v
#define bcs(v) if( c)   goto v
#define clc()  c = 0
#define sec()  c = 1
#define rts()  return
#define jmp(v) goto  v;
#define jsr(v) v()
#define lda(v) a = v
#define ldx(v) x = v
#define ldy(v) y = v
#define sta(v) v = a
#define stx(v) v = x
#define sty(v) v = y
#define iny()  ++y
#define dey()  --y
#define inx()  ++x
#define dex()  --x
#define ora(v) a |= v
#define eor(v) a ^=  v
#define and(v) a &= v
#define inc(v) ++v
#define dec(v) --v
#define tax()  x = a
#define tay()  y = a
#define txa()  a = x
#define tya()  y = a
#define cmp(v) c = (( a - v) >= 0)
#define asl(v) c = (v) & 0x80; v <<= 1
#define lsr(v) c = (v) & 0x01; v >>= 1
#define rol(v) t = c; c = ((v) & 0x80) != 0; (v) = ((v) << 1) | t
#define ror(v) t = c; c = (v) & 0x01; (v) = ((v) >> 1) | (t ? 0x80 : 0)
#define adc(v)                      \
   if( ((int) a + v + c) >= 0x100)  \
   {                                \
      a += v + c;                   \
      c = 1;                        \
   }                                \
   else                             \
   {                                \
      a += v + c;                   \
      c = 0;                        \
   }
#define sbc(v)                      \
   if( ((int) a - v - ! c ) < 0)    \
   {                                \
      a -= v - ! c;                 \
      c = 0;                        \
   }                                \
   else                             \
   {                                \
      a -= v - ! c;                 \
      c = 1;                        \
   }

void  ab_tstnum()
{
   ldy( cix);
   lda( inbuff[y]);
   sec();
   sbc( 0x30);
   bcc( tsnfail1);
   c = ((a - 0xA) >= 0);
   rts();

tsnfail1:
   sec();
   rts();
}

void ab_getchar()
{
   jsr( ab_tstnum);
   ldy( cix);
   bcc( _gchr1);
   lda( inbuff[y]);
_gchr1:
   jsr( ab_gchr1);
}

void ab_gchr1()
{
   iny();
   sty( cix);
   rts();
}

void  ab_tstchar()
{
   lda( cix);
   pha();
   jsr( ab_getchar);
   bcc( rtpass);
   if( a == '.')
      goto tstn;
   if( a == '+')
      goto tstn1;
   if( a == '-')
      goto tstn1;

rtfail:
   pla();
   sec();
   rts();

tstn1:
   jsr( ab_getchar);
   bcc( rtpass);
   if( a != '.')
      goto rtfail;

tstn:
   jsr( ab_getchar);
   bcc( rtpass);
   bcs( rtfail);

rtpass:
   pla();
   sta( cix);
   clc();
   rts();
}

void ab_nibsh0()
{
   ldx( _fr0m);
   ldy( 4);
nibs:
   clc();
   rol( page0[ 4 + (byte) x]);
   rol( page0[ 3 + (byte) x]);
   rol( page0[ 2 + (byte) x]);
   rol( page0[ 1 + (byte) x]);
   rol( page0[ (byte) x]);
   rol( frx);
   if( dey())
      goto nibs;
   rts();
}

void ab_norm()
{
   ldx(0);
   stx( page0[ _fr0 + _fprec]);
   ldx( _fmprec - 1);
   if( ! (lda( fr0)))
      goto ndone;
norm:
   if( lda( fr0m))
      goto tstbig;

   ldy(0);
nsh:
   lda( page0[ _fr0m + 1 + (byte) y]);
   sta( page0[ _fr0m + (byte) y]);
   iny();
   if( y < _fmprec)
      goto nsh;

   dec( fr0);
   if( dex())
      goto norm;

   if( ! (lda( fr0m)))
      goto tstbig;
   sta( fr0);
   clc();
   rts();

tstbig:
   lda( fr0);
   and( 0x7F);
   if( a < 49 + 64)
      goto tstund;
   rts();

tstund:
   if( a >= -49 + 64)
      goto ndone;
   jsr( ab_zfr0);

ndone:
   clc();
   rts();
}

void ab_zfr0()
{
   ldx( _fr0);
   ldy( 6);
   jsr( ab_zxly);
}

void ab_zxly()
{
   lda( 0);

zf2:
   sta( page0[ (byte) x]);
   inx();
   if( dey())
      goto zf2;
   rts();
}

int  ab_ascin( s)
signed char  *s;
{
   inbuff = s;
   cix    = 0;


   jsr( ab_tstchar);
   bcs( nonum);

   ldx( _eexp);
   ldy( 4);
   jsr( ab_zxly);

   ldx( 0xFF);
   stx( digrt);
   jsr( ab_zfr0);
   jmp( in2);

in1:
   lda( 0xFF);
   sta( fchrflg);
in2:
   jsr( ab_getchar);
   bcs( non1);

   pha();                                    /* it's a number */
   if( ldx( fr0m))                           /* get 1st byte  */
      goto ince;                             /* incr exponent */

   jsr( ab_nibsh0);                          /* shift fr0 one nibble left */

   pla();
   ora( page0[ _fr0m + _fmprec - 1]);
   sta( page0[ _fr0m + _fmprec - 1]);

   if( (ldx( digrt)) < 0)
      goto in1;
   inx();
   if( stx( digrt))
      goto in1;

ince:
   pla();
   if( (ldx( digrt)) >= 0)
      goto ince2;
   inc( eexp);

ince2:
   jmp( in1);

nonum:
   return( (int) c);

non1:
   if( a == '.')
      goto dp;
   if( a == 'E')
      goto exp;

   if( ldx( fchrflg))
      goto exit;
   if( a == '+')
      goto in1;
   if( a == '-')
      goto minus;    /* it's unbelievable */

minus:
   if( ! (sta( nsign)))
      goto in1;

dp:
   if( (ldx( digrt)) >= 0)
      goto exit;
   inx();
   if( ! (stx( digrt)))
      goto in1;

exp:
   lda( cix);
   sta( frx);
   jsr( ab_getchar);
   bcs( non2);

exp2:
   tax();
   lda( eexp);
   pha();
   stx( eexp);
   jsr( ab_getchar);

   bcs( exp3);
   pha();

   lda( eexp);
   asl( a);
   sta( eexp);
   asl( a);
   asl( a);
   adc( eexp);
   sta( eexp);
   pla();
   clc();
   adc( eexp);

   ldy( cix);
   jsr( ab_gchr1);

exp3:
   if( ! (lda( esign)))
      goto exp1;
   lda ( eexp);
   eor( 0xFF);
   clc();
   adc( 1);
   sta( eexp);

exp1:
   pla();
   clc();
   adc( eexp);
   if( sta( eexp))
      goto exit;

non2:
   if( a == '+')
      goto eplus;
   if( a != '-')
      goto note;

   sta( esign);
eplus:
   jsr( ab_getchar);
   bcc( exp2);

note:
   lda( frx);
   sta( cix);

exit:
   dec( cix);

   lda( eexp);
   if( (ldx( digrt)) <= 0)
      goto exit1;
   sec();
   sbc( digrt);

exit1:
   pha();
   rol( a);
   pla();
   ror( a);
   sta( eexp);
   bcc( even);

   jsr( ab_nibsh0);
even:
   lda( eexp);
   clc();
   adc( 0x44);
   sta( fr0);

   jsr( ab_norm);
   bcs( ind2);

   if( ! (ldx( nsign)))
      goto indon;
   lda( fr0);
   ora( 0x80);
   sta( fr0);
indon:
   clc();
ind2:
   return( c);
}