home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / factor.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-05  |  14.2 KB  |  623 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 <string.h>
  45. #include "acedef.h"
  46.  
  47.  
  48. /* locals */
  49. static char *frame_ptr[] = {"(a4)", "(a5)"};
  50.  
  51. /* externals */
  52. extern int sym;
  53. extern int obj;
  54. extern int typ;
  55. extern char id[MAXIDSIZE];
  56. extern char ut_id[MAXIDSIZE];
  57. extern SHORT shortval;
  58. extern LONG longval;
  59. extern float singleval;
  60. extern char stringval[MAXSTRLEN];
  61. extern SYM *curr_item;
  62. extern CODE *curr_code;
  63. extern SHORT dimsize[255];
  64. extern BOOL end_of_source;
  65. extern FILE *dest;
  66. extern char ch;
  67. extern int lev;
  68. extern char numbuf[80];
  69. extern char librarybase[MAXIDSIZE + 6];
  70. extern ACELIBS acelib[NUMACELIBS];
  71. extern BOOL restore_a4;
  72. extern BOOL restore_a5;
  73. extern BOOL cli_args;
  74.  
  75. /* functions */
  76. BOOL factorfunc (void)
  77. {
  78. /* 
  79.    ** Return TRUE if fsym is in the list of
  80.    ** functions (generally parameterless) 
  81.    ** found in factor(). 
  82.    ** PRINT needs this information.
  83.  */
  84.  
  85.   switch (sym)
  86.     {
  87.     case argcountsym:
  88.       return (TRUE);
  89.     case csrlinsym:
  90.       return (TRUE);
  91.     case datestrsym:
  92.       return (TRUE);
  93.     case daysym:
  94.       return (TRUE);
  95.     case errsym:
  96.       return (TRUE);
  97.     case headingsym:
  98.       return (TRUE);
  99.     case inkeysym:
  100.       return (TRUE);
  101.     case possym:
  102.       return (TRUE);
  103.     case rndsym:
  104.       return (TRUE);        /* has optional parameter! */
  105.     case systemsym:
  106.       return (TRUE);
  107.     case timersym:
  108.       return (TRUE);
  109.     case timestrsym:
  110.       return (TRUE);
  111.     case xcorsym:
  112.       return (TRUE);
  113.     case ycorsym:
  114.       return (TRUE);
  115.     default:
  116.       return (FALSE);
  117.     }
  118. }
  119.  
  120. int factor (void)
  121. {
  122.   char buf[80], srcbuf[80], sub_name[80];
  123.   char func_name[MAXIDSIZE], func_address[MAXIDSIZE + 9];
  124.   char ext_name[MAXIDSIZE + 1];
  125.   int ftype = undefined;
  126.   int arraytype = undefined;
  127.   SYM *fact_item;
  128.   int oldlevel;
  129.   BYTE libnum;
  130.   BOOL need_symbol;
  131.  
  132.   ftype = stringfunction();
  133.   if (ftype != undefined)
  134.     return (ftype);
  135.  
  136.   ftype = numericfunction();
  137.   if (ftype != undefined)
  138.     return (ftype);
  139.  
  140.   switch (sym)
  141.     {
  142.     case shortconst:
  143.       sprintf (numbuf, "#%d", shortval);
  144.       gen ("move.w", numbuf, "-(sp)");
  145.       ftype = typ;
  146.       insymbol ();
  147.       return (ftype);
  148.       break;
  149.  
  150.     case longconst:
  151.       sprintf (numbuf, "#%ld", longval);
  152.       gen ("move.l", numbuf, "-(sp)");
  153.       ftype = typ;
  154.       insymbol ();
  155.       return (ftype);
  156.       break;
  157.  
  158.     case singleconst:
  159. /*      sprintf (numbuf, "#$%lx",singleval);    original */
  160.       sprintf (numbuf, "#$%x",singleval);
  161.       gen ("move.l", numbuf, "-(sp)");
  162.       ftype = typ;
  163.       insymbol ();
  164.       return (ftype);
  165.       break;
  166.  
  167.     case stringconst:
  168.       make_string_const (stringval);
  169.       ftype = typ;
  170.       insymbol ();
  171.       return (ftype);
  172.       break;
  173.  
  174.     case ident:        /* does object exist? */
  175.  
  176.       /* in case it's a subprogram */
  177.       strcpy (sub_name, "_SUB_");
  178.       strcat (sub_name, id);
  179.  
  180.       /* store id in case it's a function */
  181.       strcpy (func_name, id);
  182.       remove_qualifier (func_name);
  183.  
  184.       /* make external variable name */
  185.       /* add an underscore prefix 
  186.          if one is not present. 
  187.        */
  188.       strcpy (buf, ut_id);
  189.       remove_qualifier (buf);
  190.       if (buf[0] != '_')
  191.     {
  192.       strcpy (ext_name, "_\0");
  193.       strcat (ext_name, buf);
  194.     }
  195.       else
  196.     strcpy (ext_name, buf);
  197.  
  198.       /* what sort of object is it? */
  199.       if (exist (id, array))
  200.     {
  201.       obj = array;
  202.       arraytype = typ = curr_item->type;
  203.     }
  204.       else if (exist (sub_name, subprogram))
  205.     {
  206.       obj = subprogram;
  207.       typ = curr_item->type;
  208.     }
  209.       else if (exist (sub_name, definedfunc))
  210.     {
  211.       obj = definedfunc;
  212.       typ = curr_item->type;
  213.     }
  214.       else if (exist (func_name, function))
  215.     {
  216.       obj = function;
  217.       typ = curr_item->type;
  218.     }
  219.       else if (exist (ext_name, extfunc))
  220.     {
  221.       obj = extfunc;
  222.       typ = curr_item->type;
  223.     }
  224.       else if (exist (ext_name, extvar))
  225.     {
  226.       obj = extvar;
  227.       typ = curr_item->type;
  228.     }
  229.       else if (exist (id, structure))
  230.     obj = structure;
  231.       else if (exist (id, constant))
  232.     {
  233.       obj = constant;
  234.       typ = curr_item->type;
  235.     }
  236.       else if (exist (id, obj))    /* obj == variable? */
  237.     typ = curr_item->type;
  238.       else
  239.     {
  240.       /* object doesn't exist so create a default variable */
  241.       enter (id, typ, obj, 0);
  242.     }
  243.  
  244.       fact_item = curr_item;
  245.  
  246.       /* frame address of object */
  247.       if (obj == subprogram)
  248.     {
  249.       oldlevel = lev;
  250.       lev = ZERO;
  251.     }
  252.  
  253.       itoa (-1 * curr_item->address, srcbuf, 10);
  254.       strcat (srcbuf, frame_ptr[lev]);
  255.  
  256.       if (obj == subprogram)
  257.     lev = oldlevel;
  258.  
  259.       /* 
  260.          ** what sort of object? -> constant,variable,subprogram,
  261.          ** function (library,external,defined),array,structure.
  262.        */
  263.  
  264.       if (obj == variable)    /* variable */
  265.     {
  266.       /* shared variable in SUB? */
  267.       if ((fact_item->shared) && (lev == ONE) && (typ != stringtype))
  268.         {
  269.           gen ("move.l", srcbuf, "a0");
  270.           if (typ == shorttype)
  271.         gen ("move.w", "(a0)", "-(sp)");
  272.           else
  273.         gen ("move.l", "(a0)", "-(sp)");
  274.         }
  275.       else
  276.         /* ordinary variable */
  277.       if (typ == shorttype)
  278.         gen ("move.w", srcbuf, "-(sp)");
  279.       else            /* string, long, single */
  280.         gen ("move.l", srcbuf, "-(sp)");    /* push value */
  281.  
  282.       ftype = typ;
  283.       insymbol ();
  284.       if (sym == lparen)
  285.         _error (71);    /* undimensioned array? */
  286.       return (ftype);
  287.     }
  288.       else if (obj == structure)    /* structure */
  289.     {
  290.       ftype = push_struct (fact_item);
  291.       return (ftype);
  292.     }
  293.       else if (obj == constant)    /* defined constant */
  294.     {
  295.       push_num_constant (typ, fact_item);
  296.       ftype = typ;
  297.       insymbol ();
  298.       if (sym == lparen)
  299.         _error (71);    /* undimensioned array? */
  300.       return (ftype);
  301.     }
  302.       else if (obj == extvar)    /* external variable */
  303.     {
  304.       if (typ == shorttype)
  305.         /* short integer */
  306.         gen ("move.w", ext_name, "-(sp)");
  307.       else if (typ == stringtype)
  308.         /* string */
  309.         gen ("pea", ext_name, "  ");
  310.       else
  311.         /* long integer, single-precision */
  312.         gen ("move.l", ext_name, "-(sp)");
  313.       ftype = typ;
  314.       insymbol ();
  315.       if (sym == lparen)
  316.         _error (71);    /* undimensioned array? */
  317.       return (ftype);
  318.     }
  319.       else if (obj == subprogram || obj == definedfunc)        /* subprogram */
  320.     {
  321.       /* CALL the subprogram */
  322.       if (fact_item->no_of_params != 0)
  323.         {
  324.           insymbol ();
  325.           load_params (fact_item);
  326.         }
  327.       gen ("jsr", sub_name, "  ");
  328.  
  329.       /* push the return value */
  330.       if (fact_item->type == shorttype)
  331.         {
  332.           if (fact_item->object == subprogram &&
  333.           fact_item->address != extfunc)
  334.         gen ("move.w", srcbuf, "-(sp)");
  335.           else
  336.         gen ("move.w", "d0", "-(sp)");
  337.         }
  338.       else
  339.         /* string, long, single */
  340.         {
  341.           if (fact_item->object == subprogram &&
  342.           fact_item->address != extfunc)
  343.         gen ("move.l", srcbuf, "-(sp)");    /* push value */
  344.           else
  345.         gen ("move.l", "d0", "-(sp)");
  346.         }
  347.       ftype = fact_item->type;
  348.       insymbol ();
  349.       return (ftype);
  350.     }
  351.       else if (obj == function)    /* library function */
  352.     {
  353.       if (fact_item->no_of_params != 0)
  354.         {
  355.           insymbol ();
  356.           load_func_params (fact_item);
  357.         }
  358.       /* call it */
  359.       if ((libnum = check_for_ace_lib (fact_item->libname)) == NEGATIVE)
  360.         make_library_base (fact_item->libname);
  361.       else
  362.         strcpy (librarybase, acelib[libnum].base);
  363.       gen ("move.l", librarybase, "a6");
  364.       itoa (fact_item->address, func_address, 10);
  365.       strcat (func_address, "(a6)");
  366.       gen ("jsr", func_address, "  ");
  367.  
  368.       if (fact_item->type == shorttype)
  369.         gen ("move.w", "d0", "-(sp)");
  370.       else
  371.         gen ("move.l", "d0", "-(sp)");    /* push return value */
  372.  
  373.       if (restore_a4)
  374.         {
  375.           gen ("move.l", "_a4_temp", "a4");
  376.           restore_a4 = FALSE;
  377.         }
  378.       if (restore_a5)
  379.         {
  380.           gen ("move.l", "_a5_temp", "a5");
  381.           restore_a5 = FALSE;
  382.         }
  383.  
  384.       ftype = fact_item->type;
  385.       insymbol ();
  386.       return (ftype);
  387.     }
  388.       else if (obj == extfunc)
  389.     {
  390.       /* external function call */
  391.       insymbol ();
  392.       call_external_function (ext_name, &need_symbol);
  393.       /* push return value */
  394.       if (fact_item->type == shorttype)
  395.         gen ("move.w", "d0", "-(sp)");
  396.       else
  397.         gen ("move.l", "d0", "-(sp)");
  398.       ftype = fact_item->type;
  399.       if (need_symbol)
  400.         insymbol ();
  401.       return (ftype);
  402.     }
  403.       else if (obj == array)
  404.     {
  405.       push_indices (fact_item);
  406.       get_abs_ndx (fact_item);
  407.       gen ("move.l", srcbuf, "a0");
  408.  
  409.       if (arraytype == stringtype)
  410.         {
  411.           /* push start address of string within BSS object */
  412.           gen ("adda.l", "d7", "a0");
  413.           gen ("move.l", "a0", "-(sp)");
  414.         }
  415.       else if (arraytype == shorttype)
  416.         gen ("move.w", "0(a0,d7.L)", "-(sp)");
  417.       else
  418.         gen ("move.l", "0(a0,d7.L)", "-(sp)");
  419.  
  420.       ftype = arraytype;    /* typ killed by push_indices()! */
  421.       insymbol ();
  422.       return (ftype);
  423.     }
  424.       break;
  425.  
  426.     case lparen:
  427.       insymbol ();
  428.       ftype = expr ();
  429.       if (sym != rparen)
  430.     _error (9);
  431.       insymbol ();
  432.       return (ftype);
  433.       break;
  434.  
  435.       /* @<object> */
  436.     case atsymbol:
  437.       insymbol ();
  438.       if (sym != ident)
  439.     {
  440.       _error (7);
  441.       ftype = undefined;
  442.       insymbol ();
  443.     }
  444.       else
  445.     {
  446.       strcpy (buf, id);
  447.       ftype = address_of_object ();
  448.       /* structure and array code returns next symbol */
  449.       if (!exist (buf, structure) && !exist (buf, array))
  450.         insymbol ();
  451.     }
  452.       return (ftype);
  453.       break;
  454.  
  455.       /* parameterless functions */
  456.  
  457.     case argcountsym:
  458.       gen ("jsr", "_argcount", "  ");
  459.       gen ("move.l", "d0", "-(sp)");
  460.       enter_XREF ("_argcount");
  461.       ftype = longtype;
  462.       cli_args = TRUE;
  463.       insymbol ();
  464.       return (ftype);
  465.       break;
  466.  
  467.     case csrlinsym:
  468.       gen ("jsr", "_csrlin", "  ");
  469.       gen ("move.w", "d0", "-(sp)");
  470.       enter_XREF ("_csrlin");
  471.       ftype = shorttype;
  472.       insymbol ();
  473.       return (ftype);
  474.       break;
  475.  
  476.     case datestrsym:
  477.       gen ("jsr", "_date", "  ");
  478.       gen ("move.l", "d0", "-(sp)");
  479.       enter_XREF ("_date");
  480.       enter_XREF ("_DOSBase");    /* DateStamp() needs dos.library */
  481.       ftype = stringtype;
  482.       insymbol ();
  483.       return (ftype);
  484.       break;
  485.  
  486.     case daysym:
  487.       gen ("jsr", "_getday", "  ");
  488.       gen ("move.l", "d0", "-(sp)");
  489.       enter_XREF ("_getday");
  490.       ftype = longtype;
  491.       insymbol ();
  492.       return (ftype);
  493.       break;
  494.  
  495.     case errsym:
  496.       gen ("jsr", "_err", "  ");
  497.       gen ("move.l", "d0", "-(sp)");
  498.       enter_XREF ("_err");
  499.       ftype = longtype;
  500.       insymbol ();
  501.       return (ftype);
  502.       break;
  503.  
  504.     case headingsym:
  505.       gen ("jsr", "_heading", "  ");
  506.       gen ("move.w", "d0", "-(sp)");
  507.       enter_XREF ("_heading");
  508.       enter_XREF ("_IntuitionBase");
  509.       ftype = shorttype;
  510.       insymbol ();
  511.       return (ftype);
  512.       break;
  513.  
  514.     case inkeysym:
  515.       gen ("jsr", "_inkey", "  ");
  516.       gen ("move.l", "d0", "-(sp)");
  517.       enter_XREF ("_inkey");
  518.       enter_XREF ("_DOSBase");
  519.       ftype = stringtype;
  520.       insymbol ();
  521.       return (ftype);
  522.       break;
  523.  
  524.     case possym:
  525.       gen ("jsr", "_pos", "  ");
  526.       gen ("move.w", "d0", "-(sp)");
  527.       enter_XREF ("_pos");
  528.       ftype = shorttype;
  529.       insymbol ();
  530.       return (ftype);
  531.       break;
  532.  
  533.     case rndsym:
  534.       insymbol ();
  535.       if (sym == lparen)
  536.     {
  537.       /* ignore dummy expression if exists */
  538.       insymbol ();
  539.       ftype = make_integer (expr ());
  540.       switch (ftype)
  541.         {
  542.         case shorttype:
  543.           gen ("move.w", "(sp)+", "d0");
  544.           break;
  545.  
  546.         case longtype:
  547.           gen ("move.l", "(sp)+", "d0");
  548.           break;
  549.  
  550.         default:
  551.           _error (4);
  552.         }
  553.       if (sym != rparen)
  554.         _error (9);
  555.       else
  556.         insymbol ();
  557.     }
  558.       gen ("jsr", "_rnd", "  ");
  559.       gen ("move.l", "d0", "-(sp)");
  560.       enter_XREF ("_rnd");
  561.       enter_XREF ("_MathBase");    /* make sure mathffp lib is open */
  562.       ftype = singletype;
  563.       return (ftype);
  564.       break;
  565.  
  566.     case systemsym:
  567.       gen ("jsr", "_system_version", "  ");
  568.       gen ("move.w", "d0", "-(sp)");
  569.       enter_XREF ("_system_version");
  570.       ftype = shorttype;
  571.       insymbol ();
  572.       return (ftype);
  573.       break;
  574.  
  575.     case timersym:
  576.       gen ("jsr", "_timer", "  ");
  577.       gen ("move.l", "d0", "-(sp)");
  578.       enter_XREF ("_timer");
  579.       enter_XREF ("_DOSBase");    /* DateStamp() needs dos.library */
  580.       enter_XREF ("_MathBase");    /* _timer needs basic ffp funcs */
  581.       ftype = singletype;
  582.       insymbol ();
  583.       return (ftype);
  584.       break;
  585.  
  586.     case timestrsym:
  587.       gen ("jsr", "_timeofday", "  ");
  588.       gen ("move.l", "d0", "-(sp)");
  589.       enter_XREF ("_timeofday");
  590.       enter_XREF ("_DOSBase");    /* DateStamp() needs dos.library */
  591.       ftype = stringtype;
  592.       insymbol ();
  593.       return (ftype);
  594.       break;
  595.  
  596.     case xcorsym:
  597.       gen ("jsr", "_xcor", "  ");
  598.       gen ("move.w", "d0", "-(sp)");
  599.       enter_XREF ("_xcor");
  600.       enter_XREF ("_GfxBase");
  601.       ftype = shorttype;
  602.       insymbol ();
  603.       return (ftype);
  604.       break;
  605.  
  606.     case ycorsym:
  607.       gen ("jsr", "_ycor", "  ");
  608.       gen ("move.w", "d0", "-(sp)");
  609.       enter_XREF ("_ycor");
  610.       enter_XREF ("_GfxBase");
  611.       ftype = shorttype;
  612.       insymbol ();
  613.       return (ftype);
  614.       break;
  615.     }
  616.  
  617.   /* none of the above! */
  618.   ftype = undefined;
  619.   _error (13);            /* illegal expression */
  620.   insymbol ();
  621.   return (ftype);
  622. }
  623.