home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / ace / c / factor.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-10-04  |  14.2 KB  |  551 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Parser: Factor code **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.      Date: 26th October-30th November, 1st-13th December 1991,
  24.        14th,20th-27th January 1992, 
  25.            2nd-17th, 21st-29th February 1992, 
  26.        1st,13th,14th,22nd,23rd March 1992,
  27.        21st,22nd April 1992,
  28.        2nd,3rd,11th,15th,16th May 1992,
  29.        7th,8th,9th,11th,13th,14th,28th,29th,30th June 1992,
  30.        2nd-8th,14th-19th,26th-29th July 1992,
  31.        1st-3rd,7th,8th,9th August 1992,
  32.        6th,29th December 1992,
  33.        15th,28th February 1993,
  34.        6th,12th,13th June 1993,
  35.        6th September 1993,
  36.        24th,27th,28th,31st December 1993,
  37.        2nd,5th January 1994,
  38.        21st June 1994,
  39.        22nd August 1994,
  40.        1st October 1994,
  41.        11th March 1995
  42. */
  43.  
  44. #include "acedef.h"
  45.  
  46. /* locals */
  47. static    char     *frame_ptr[] = { "(a4)","(a5)" };
  48.  
  49. /* externals */
  50. extern    int    sym;
  51. extern    int    obj;
  52. extern    int    typ;
  53. extern    char       id[MAXIDSIZE]; 
  54. extern    char       ut_id[MAXIDSIZE];
  55. extern    SHORT      shortval;
  56. extern    LONG       longval; 
  57. extern    float      singleval;
  58. extern    char       stringval[MAXSTRLEN];
  59. extern    SYM    *curr_item;
  60. extern    CODE    *curr_code;
  61. extern    SHORT    dimsize[255];
  62. extern    BOOL    end_of_source;
  63. extern    FILE    *dest;
  64. extern    char    ch;
  65. extern    int      lev;
  66. extern    char     numbuf[80];
  67. extern    char     librarybase[MAXIDSIZE+6];
  68. extern    ACELIBS    acelib[NUMACELIBS];
  69. extern    BOOL     restore_a4;
  70. extern    BOOL    restore_a5;
  71. extern     BOOL     cli_args;
  72.  
  73. /* functions */
  74. BOOL factorfunc()
  75. {
  76. /* 
  77. ** Return TRUE if fsym is in the list of
  78. ** functions (generally parameterless) 
  79. ** found in factor(). 
  80. ** PRINT needs this information.
  81. */
  82.  
  83.   switch(sym)
  84.   {
  85.         case argcountsym    : return(TRUE);
  86.         case csrlinsym        : return(TRUE);
  87.     case datestrsym        : return(TRUE);
  88.     case daysym        : return(TRUE);
  89.         case errsym        : return(TRUE);
  90.     case headingsym        : return(TRUE);
  91.     case inkeysym        : return(TRUE);
  92.     case possym        : return(TRUE);
  93.     case rndsym        : return(TRUE); /* has optional parameter! */
  94.     case systemsym        : return(TRUE);
  95.     case timersym        : return(TRUE);
  96.     case timestrsym        : return(TRUE);
  97.     case xcorsym        : return(TRUE);
  98.     case ycorsym        : return(TRUE);
  99.     default            : return(FALSE);
  100.   }
  101. }
  102.  
  103. int factor()
  104. {
  105. char buf[80],srcbuf[80],strname[80],strlabel[80],sub_name[80];
  106. char func_name[MAXIDSIZE],func_address[MAXIDSIZE+9];
  107. char ext_name[MAXIDSIZE+1];
  108. char *strbuf;
  109. int  ftype=undefined;
  110. int  arraytype=undefined;
  111. SYM  *fact_item;
  112. int  oldlevel;
  113. BYTE libnum;
  114. BOOL need_symbol;
  115.  
  116.  ftype=stringfunction();
  117.  if (ftype != undefined) return(ftype);
  118.  
  119.  ftype=numericfunction();
  120.  if (ftype != undefined) return(ftype);
  121.  
  122.  switch(sym)
  123.  {
  124.   case shortconst  : sprintf(numbuf,"#%d",shortval);
  125.                      gen("move.w",numbuf,"-(sp)");
  126.                      ftype=typ;
  127.                      insymbol();
  128.                      return(ftype);
  129.                      break;
  130.  
  131.   case longconst   : sprintf(numbuf,"#%ld",longval);
  132.                     gen("move.l",numbuf,"-(sp)");
  133.                      ftype=typ;
  134.                      insymbol();
  135.                      return(ftype);
  136.                      break;
  137.  
  138.   case singleconst : sprintf(numbuf,"#$%lx",singleval);
  139.                     gen("move.l",numbuf,"-(sp)");
  140.                      ftype=typ;
  141.                     insymbol();
  142.                      return(ftype);
  143.                      break;
  144.   
  145.   case stringconst : make_string_const(stringval);
  146.                     ftype=typ;
  147.                     insymbol();
  148.                      return(ftype);
  149.                     break;
  150.  
  151.   case ident : /* does object exist? */
  152.  
  153.            /* in case it's a subprogram */
  154.              strcpy(sub_name,"_SUB_");
  155.               strcat(sub_name,id);
  156.  
  157.            /* store id in case it's a function */
  158.            strcpy(func_name,id);
  159.              remove_qualifier(func_name);
  160.  
  161.            /* make external variable name */
  162.              /* add an underscore prefix 
  163.                  if one is not present. 
  164.              */
  165.            strcpy(buf,ut_id);
  166.              remove_qualifier(buf);
  167.                if (buf[0] != '_')
  168.                {
  169.                 strcpy(ext_name,"_\0");
  170.                 strcat(ext_name,buf);
  171.                }
  172.                else 
  173.                    strcpy(ext_name,buf);
  174.  
  175.            /* what sort of object is it? */
  176.            if (exist(id,array)) 
  177.                   { obj=array; arraytype=typ=curr_item->type; }
  178.                else
  179.                 if (exist(sub_name,subprogram)) 
  180.                    { obj=subprogram; typ=curr_item->type; }
  181.            else
  182.                 if (exist(sub_name,definedfunc)) 
  183.                    { obj=definedfunc; typ=curr_item->type; }
  184.                else
  185.                 if (exist(func_name,function)) 
  186.                    { obj=function; typ=curr_item->type; }
  187.            else        
  188.         if (exist(ext_name,extfunc)) 
  189.            { obj=extfunc; typ=curr_item->type; } 
  190.            else
  191.         if (exist(ext_name,extvar)) 
  192.            { obj=extvar; typ=curr_item->type; }    
  193.            else
  194.         if (exist(id,structure)) obj=structure; 
  195.                else
  196.         if (exist(id,constant)) 
  197.            { obj=constant; typ=curr_item->type; } 
  198.            else
  199.             if (exist(id,obj))    /* obj == variable? */
  200.            typ=curr_item->type;
  201.                else
  202.           {
  203.            /* object doesn't exist so create a default variable */
  204.            enter(id,typ,obj,0);  
  205.           }
  206.  
  207.            fact_item=curr_item; 
  208.  
  209.                /* frame address of object */
  210.            if (obj == subprogram) { oldlevel=lev; lev=ZERO; }
  211.  
  212.                itoa(-1*curr_item->address,srcbuf,10);
  213.                strcat(srcbuf,frame_ptr[lev]);
  214.            
  215.            if (obj == subprogram) lev=oldlevel;
  216.   
  217.                /* 
  218.            ** what sort of object? -> constant,variable,subprogram,
  219.            ** function (library,external,defined),array,structure.
  220.            */
  221.  
  222.                if (obj == variable)         /* variable */
  223.                {
  224.                 /* shared variable in SUB? */
  225.         if ((fact_item->shared) && (lev == ONE) && (typ != stringtype))
  226.                 {
  227.          gen("move.l",srcbuf,"a0");
  228.          if (typ == shorttype)
  229.                     gen("move.w","(a0)","-(sp)");
  230.          else
  231.                     gen("move.l","(a0)","-(sp)");
  232.         }
  233.                 else  
  234.         /* ordinary variable */ 
  235.           if (typ == shorttype)
  236.                    gen("move.w",srcbuf,"-(sp)");
  237.           else  /* string, long, single */ 
  238.                 gen("move.l",srcbuf,"-(sp)"); /* push value */
  239.  
  240.            ftype=typ;
  241.            insymbol();
  242.           if (sym == lparen) _error(71);  /* undimensioned array? */
  243.            return(ftype);
  244.              }
  245.                else
  246.            if (obj == structure)  /* structure */
  247.            {
  248.         ftype=push_struct(fact_item);
  249.         return(ftype);
  250.            }
  251.            else
  252.               if (obj == constant)  /* defined constant */
  253.            {
  254.         push_num_constant(typ,fact_item); 
  255.         ftype=typ;
  256.         insymbol();
  257.           if (sym == lparen) _error(71);  /* undimensioned array? */
  258.         return(ftype);
  259.            }
  260.         else
  261.         if (obj == extvar)  /* external variable */
  262.         {
  263.          if (typ == shorttype)
  264.             /* short integer */    
  265.             gen("move.w",ext_name,"-(sp)");
  266.          else
  267.          if (typ == stringtype)
  268.             /* string */
  269.             gen("pea",ext_name,"  ");         
  270.          else
  271.             /* long integer, single-precision */
  272.             gen("move.l",ext_name,"-(sp)");
  273.          ftype=typ;
  274.          insymbol();
  275.             if (sym == lparen) _error(71);  /* undimensioned array? */
  276.          return(ftype);
  277.         }
  278.               else
  279.           if (obj == subprogram || obj == definedfunc)  /* subprogram */
  280.           { 
  281.          /* CALL the subprogram */
  282.          if (fact_item->no_of_params != 0) 
  283.          {
  284.           insymbol();
  285.           load_params(fact_item);
  286.          }
  287.          gen("jsr",sub_name,"  ");
  288.  
  289.          /* push the return value */
  290.              if (fact_item->type == shorttype)
  291.           {
  292.                 if (fact_item->object == subprogram && 
  293.               fact_item->address != extfunc)
  294.             gen("move.w",srcbuf,"-(sp)");
  295.           else
  296.             gen("move.w","d0","-(sp)");
  297.          }
  298.            else  /* string, long, single */
  299.            {
  300.           if (fact_item->object == subprogram &&
  301.               fact_item->address != extfunc)
  302.                 gen("move.l",srcbuf,"-(sp)"); /* push value */
  303.           else
  304.             gen("move.l","d0","-(sp)");
  305.            }
  306.            ftype=fact_item->type;
  307.             insymbol();
  308.             return(ftype);
  309.          }
  310.             else
  311.             if (obj == function)    /* library function */
  312.          {
  313.              if (fact_item->no_of_params != 0)
  314.                 { insymbol(); load_func_params(fact_item); }
  315.              /* call it */
  316.            if ((libnum=check_for_ace_lib(fact_item->libname))==NEGATIVE) 
  317.                    make_library_base(fact_item->libname);
  318.              else
  319.                    strcpy(librarybase,acelib[libnum].base);
  320.              gen("move.l",librarybase,"a6");
  321.              itoa(fact_item->address,func_address,10);
  322.              strcat(func_address,"(a6)");
  323.              gen("jsr",func_address,"  ");
  324.  
  325.          if (fact_item->type == shorttype)
  326.             gen("move.w","d0","-(sp)");
  327.          else
  328.             gen("move.l","d0","-(sp)"); /* push return value */
  329.  
  330.                  if (restore_a4) 
  331.                     { gen("move.l","_a4_temp","a4"); restore_a4=FALSE; }
  332.                  if (restore_a5) 
  333.                     { gen("move.l","_a5_temp","a5"); restore_a5=FALSE; }
  334.  
  335.            ftype=fact_item->type;
  336.             insymbol();
  337.             return(ftype);
  338.             }         
  339.           else
  340.             if (obj == extfunc)
  341.                 {
  342.          /* external function call */
  343.          insymbol();
  344.              call_external_function(ext_name,&need_symbol);
  345.          /* push return value */
  346.          if (fact_item->type == shorttype)
  347.             gen("move.w","d0","-(sp)");
  348.          else
  349.             gen("move.l","d0","-(sp)");
  350.          ftype=fact_item->type;
  351.          if (need_symbol) insymbol();
  352.          return(ftype);
  353.         }
  354.          else
  355.                 if (obj == array)
  356.                 {
  357.          push_indices(fact_item);
  358.            get_abs_ndx(fact_item);
  359.          gen("move.l",srcbuf,"a0");
  360.  
  361.          if (arraytype == stringtype)
  362.          {
  363.           /* push start address of string within BSS object */
  364.           gen("adda.l","d7","a0");
  365.           gen("move.l","a0","-(sp)");
  366.          }   
  367.           else
  368.          if (arraytype == shorttype)
  369.             gen("move.w","0(a0,d7.L)","-(sp)");
  370.          else
  371.             gen("move.l","0(a0,d7.L)","-(sp)");
  372.  
  373.             ftype=arraytype;  /* typ killed by push_indices()! */
  374.             insymbol();
  375.             return(ftype);
  376.         }
  377.           break;
  378.  
  379.   case lparen : insymbol();
  380.           ftype=expr();
  381.           if (sym != rparen) _error(9);
  382.           insymbol();
  383.           return(ftype);
  384.              break;
  385.  
  386.   /* @<object> */
  387.   case atsymbol : insymbol();
  388.           if (sym != ident)
  389.              { _error(7); ftype=undefined; insymbol(); }
  390.           else
  391.           {
  392.            strcpy(buf,id);
  393.            ftype=address_of_object();
  394.            /* structure and array code returns next symbol */
  395.            if (!exist(buf,structure) && !exist(buf,array)) 
  396.               insymbol();
  397.           }
  398.               return(ftype);
  399.           break;
  400.  
  401.   /* parameterless functions */
  402.  
  403.   case argcountsym : gen("jsr","_argcount","  ");
  404.              gen("move.l","d0","-(sp)");
  405.              enter_XREF("_argcount");
  406.              ftype=longtype;
  407.              cli_args=TRUE;
  408.              insymbol();
  409.              return(ftype);
  410.              break;
  411.  
  412.   case csrlinsym  : gen("jsr","_csrlin","  ");
  413.             gen("move.w","d0","-(sp)");
  414.             enter_XREF("_csrlin");
  415.             ftype=shorttype;
  416.             insymbol();
  417.             return(ftype);
  418.             break;
  419.  
  420.   case datestrsym : gen("jsr","_date","  ");
  421.             gen("move.l","d0","-(sp)");
  422.             enter_XREF("_date");
  423.             enter_XREF("_DOSBase"); /* DateStamp() needs dos.library */
  424.             ftype=stringtype;
  425.             insymbol();
  426.             return(ftype);
  427.             break;            
  428.  
  429.   case daysym   : gen("jsr","_getday","  ");
  430.           gen("move.l","d0","-(sp)");
  431.           enter_XREF("_getday");
  432.           ftype=longtype;
  433.           insymbol();
  434.           return(ftype);
  435.           break;
  436.  
  437.   case errsym : gen("jsr","_err","  ");
  438.         gen("move.l","d0","-(sp)");
  439.         enter_XREF("_err");
  440.         ftype=longtype;
  441.         insymbol();
  442.         return(ftype);
  443.         break;
  444.  
  445.   case headingsym : gen("jsr","_heading","  ");
  446.             gen("move.w","d0","-(sp)");
  447.             enter_XREF("_heading");
  448.             enter_XREF("_IntuitionBase");
  449.             ftype=shorttype;
  450.             insymbol();
  451.             return(ftype);
  452.             break;
  453.  
  454.   case inkeysym : gen("jsr","_inkey","  ");
  455.           gen("move.l","d0","-(sp)");
  456.           enter_XREF("_inkey");
  457.           enter_XREF("_DOSBase");
  458.           ftype=stringtype;
  459.            insymbol();
  460.           return(ftype);
  461.           break;
  462.  
  463.   case possym  : gen("jsr","_pos","  ");
  464.          gen("move.w","d0","-(sp)");
  465.          enter_XREF("_pos");
  466.          ftype=shorttype;
  467.          insymbol();
  468.          return(ftype);
  469.          break;
  470.  
  471.   case rndsym : insymbol();
  472.         if (sym == lparen)
  473.         {
  474.           /* ignore dummy expression if exists */
  475.           insymbol();
  476.           ftype = make_integer(expr());
  477.           switch(ftype)
  478.           {
  479.             case shorttype     : gen("move.w","(sp)+","d0");
  480.                       break;
  481.  
  482.             case longtype      : gen("move.l","(sp)+","d0");
  483.                       break;
  484.  
  485.             default        : _error(4);
  486.           }    
  487.           if (sym != rparen) _error(9);
  488.           else
  489.               insymbol();
  490.         }
  491.         gen("jsr","_rnd","  ");
  492.         gen("move.l","d0","-(sp)");
  493.         enter_XREF("_rnd");
  494.         enter_XREF("_MathBase"); /* make sure mathffp lib is open */
  495.         ftype=singletype;
  496.         return(ftype);
  497.         break;
  498.  
  499.   case systemsym : gen("jsr","_system_version","  ");
  500.            gen("move.w","d0","-(sp)");
  501.            enter_XREF("_system_version");
  502.            ftype=shorttype;
  503.            insymbol();
  504.            return(ftype);
  505.            break;
  506.  
  507.   case timersym : gen("jsr","_timer","  ");
  508.           gen("move.l","d0","-(sp)");
  509.           enter_XREF("_timer");
  510.           enter_XREF("_DOSBase"); /* DateStamp() needs dos.library */
  511.           enter_XREF("_MathBase"); /* _timer needs basic ffp funcs */
  512.           ftype=singletype;
  513.           insymbol();
  514.           return(ftype);
  515.           break;
  516.  
  517.   case timestrsym : gen("jsr","_timeofday","  ");
  518.             gen("move.l","d0","-(sp)");
  519.             enter_XREF("_timeofday");
  520.             enter_XREF("_DOSBase"); /* DateStamp() needs dos.library */
  521.             ftype=stringtype;
  522.             insymbol();
  523.             return(ftype);
  524.             break;
  525.  
  526.   case xcorsym    : gen("jsr","_xcor","  ");
  527.           gen("move.w","d0","-(sp)");
  528.           enter_XREF("_xcor");
  529.           enter_XREF("_GfxBase");
  530.           ftype=shorttype;
  531.           insymbol();
  532.           return(ftype);
  533.           break;
  534.  
  535.   case ycorsym    : gen("jsr","_ycor","  ");
  536.           gen("move.w","d0","-(sp)");
  537.           enter_XREF("_ycor");
  538.           enter_XREF("_GfxBase");
  539.           ftype=shorttype;
  540.           insymbol();
  541.           return(ftype);
  542.           break;
  543.  }
  544.  
  545.  /* none of the above! */
  546.  ftype=undefined;
  547.  _error(13);  /* illegal expression */
  548.  insymbol();
  549.  return(ftype);
  550. }
  551.