home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / assign.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-05  |  27.7 KB  |  1,132 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Parser: variable assignment 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,22nd December 1992,
  33.    6th January 1993,
  34.    12th,15th February 1993,
  35.    12th,16th April 1993,
  36.    20th,30th June 1993,
  37.    11th October 1993,
  38.    5th,16th-18th December 1993,
  39.    2nd January 1994,
  40.    21st June 1994,
  41.    20th August 1994,
  42.    1st,10th September 1994,
  43.    1st October 1994,
  44.    11th March 1995
  45.  */
  46.  
  47. #include <string.h>
  48. #include <clib/mathffp_protos.h>
  49. #include "acedef.h"
  50.  
  51. #define QUN_CODE 3
  52.  
  53. /* locals */
  54. static char *frame_ptr[] = {"(a4)", "(a5)"};
  55.  
  56. /* externals */
  57. extern int sym;
  58. extern int lastsym;
  59. extern int obj;
  60. extern int typ;
  61. extern char id[MAXIDSIZE];
  62. extern char ut_id[MAXIDSIZE];
  63. extern SHORT shortval;
  64. extern LONG longval;
  65. extern float singleval;
  66. extern char stringval[MAXSTRLEN];
  67. extern SYM *curr_item;
  68. extern SHORT dimsize[MAXDIMS];
  69. extern char string_const_start[7];
  70. extern char string_const_end[4];
  71. extern int lev;
  72. extern long strstorecount;
  73. extern long stringvarcount;
  74. extern char strstorename[80], strstorelabel[80];
  75. extern int storetype;
  76. extern long arraycount;
  77. extern char tempstrname[80];
  78. extern BOOL readpresent;
  79. extern BOOL have_lparen;
  80. extern BOOL have_equal;
  81. extern long address;
  82.  
  83. /* functions */
  84.  
  85. int assign_coerce (int storetype, int exptype)
  86. {
  87.   /* coerce expression type to store type */
  88.  
  89.   if (((storetype == stringtype) && (exptype != stringtype)) ||
  90.       ((storetype != stringtype) && (exptype == stringtype)))
  91.     return (notype);
  92.   else if (((storetype == shorttype) || (storetype == longtype))
  93.        && (exptype == singletype))
  94.     {
  95.       gen_round (storetype);
  96.     }
  97.   else if ((storetype == singletype) &&
  98.        ((exptype == shorttype) || (exptype == longtype)))
  99.     {
  100.       gen_Flt (exptype);
  101.     }
  102.   else if ((storetype == longtype) && (exptype == shorttype))
  103.     {
  104.       gen ("move.w", "(sp)+", "d0");
  105.       gen ("ext.l", "d0", "  ");
  106.       gen ("move.l", "d0", "-(sp)");
  107.     }
  108.   else if ((storetype == shorttype) && (exptype == longtype))
  109.     {
  110.       gen ("move.l", "(sp)+", "d0");
  111.       /*gen("andi.l","#$ffff","d0"); */
  112.       gen ("move.w", "d0", "-(sp)");
  113.     }
  114.  
  115.   return (storetype);        /* could be bytetype (for struct member) */
  116. }
  117.  
  118. void make_string_store (void)
  119. {
  120.   char numbuf[40];
  121.  
  122.   itoa (strstorecount++, numbuf, 10);
  123.   strcpy (strstorename, "_stringstore");
  124.   strcat (strstorename, numbuf);
  125.   strcpy (strstorelabel, strstorename);
  126.   strcat (strstorelabel, ":\0");
  127. }
  128.  
  129. void create_string_variable (SYM * string_item, long string_size)
  130. {
  131. /* creates a unique BSS object for a string variable 
  132.    and stores its address in the string variable
  133.    pointer in the stack frame. 
  134.  */
  135.   char stringvarname[40], stringvarlabel[40], bss_size[20];
  136.   char numbuf[10], addrbuf[20];
  137.  
  138.   /* keep a record of "stringvar" number which is
  139.      about to be created (for simple string variables
  140.      and string SUBs only) for future reference. 
  141.    */
  142.   string_item->numconst.longnum = stringvarcount;
  143.  
  144.   /* make name of BSS object */
  145.   strcpy (stringvarname, "_stringvar");
  146.   itoa (stringvarcount++, numbuf, 10);
  147.   /* name */
  148.   strcat (stringvarname, numbuf);
  149.   /* label */
  150.   strcpy (stringvarlabel, stringvarname);
  151.   strcat (stringvarlabel, ":\0");
  152.  
  153.   /* size of BSS object */
  154.   itoa (string_size, numbuf, 10);
  155.   strcpy (bss_size, "ds.b ");
  156.   strcat (bss_size, numbuf);
  157.  
  158.   /* enter bss object */
  159.   enter_BSS (stringvarlabel, bss_size);
  160.  
  161.   /* store bss object address in stack frame */
  162.   itoa (-1 * string_item->address, addrbuf, 10);
  163.   strcat (addrbuf, frame_ptr[lev]);
  164.  
  165.   gen ("pea", stringvarname, "  ");
  166.   gen ("move.l", "(sp)+", addrbuf);
  167. }
  168.  
  169. void assign_to_string_variable (SYM * string_item, long string_size)
  170. {
  171. /* assigns a string on the stack 
  172.    to the specified string variable 
  173.  */
  174.   char addrbuf[20], buf[80];
  175.  
  176.   /* get stack frame address holder */
  177.   itoa (-1 * string_item->address, addrbuf, 10);
  178.   strcat (addrbuf, frame_ptr[lev]);
  179.  
  180.   if (string_item->new_string_var)
  181.     {
  182.       /* create a BSS object for new string variable */
  183.       create_string_variable (string_item, string_size);
  184.       string_item->new_string_var = FALSE;
  185.     }
  186.   else if (string_item->decl != declared && !string_item->shared)
  187.     {
  188.       /* Make sure there is a valid address in the 
  189.          variable's stack-frame address holder EACH
  190.          time the variable is to be assigned a value.
  191.  
  192.          The reason is that unlike a declared string
  193.          variable or array, an undeclared string variable 
  194.          might not have a valid address at the time of 
  195.          assignment since the first occurrence of said 
  196.          variable may be as part of a case statement which 
  197.          might NEVER be reached.
  198.  
  199.          However, we still need string variable address
  200.          in stack frame for other purposes (eg: passing
  201.          to SUBs, use in factor() etc). 
  202.        */
  203.       sprintf (buf, "#_stringvar%ld", string_item->numconst.longnum);
  204.       gen ("move.l", buf, addrbuf);
  205.     }
  206.  
  207.   /* copy string on stack to variable */
  208.   gen ("move.l", "(sp)+", "a1");    /* source */
  209.   gen ("move.l", addrbuf, "a0");    /* destination */
  210.   gen ("jsr", "_strcpy", "  ");    /* copy source to destination */
  211.   enter_XREF ("_strcpy");
  212. }
  213.  
  214. void assign_to_string_array (char *addrbuf)
  215. {
  216. /* - assigns a string on the stack 
  217.    to the specified string array element.
  218.    - assumes absolute index is in d7.
  219.  */
  220.  
  221.   gen ("move.l", "(sp)+", "a1");    /* source */
  222.   gen ("move.l", addrbuf, "a0");
  223.   gen ("adda.l", "d7", "a0");    /* destination */
  224.  
  225.   gen ("jsr", "_strcpy", "  ");    /* copy source to destination */
  226.   enter_XREF ("_strcpy");
  227. }
  228.  
  229. void assign_to_struct (SYM * item)
  230. {
  231. /* assign either an address to 
  232.    a structure variable or a
  233.    value to one of its members.
  234.  */
  235.   SYM *structype;
  236.   char addrbuf[40], absbuf[40], numbuf[40];
  237.   STRUCM *member;
  238.   BOOL found = FALSE;
  239.   int exprtype, storetype;
  240.  
  241.   if (sym == memberpointer)
  242.     {
  243.       /* assign value to a member */
  244.  
  245.       /* get pointer to structure 
  246.          type definition. 
  247.        */
  248.       structype = item->other;
  249.  
  250.       insymbol ();
  251.  
  252.       if (sym != ident)
  253.     _error (7);
  254.       else
  255.     {
  256.       /* does member exist? */
  257.       member = structype->structmem->next;
  258.       while ((member != NULL) && (!found))
  259.         {
  260.           if (strcmp (member->name, id) == 0)
  261.         found = TRUE;
  262.           else
  263.         member = member->next;
  264.         }
  265.  
  266.       /* dereference it? */
  267.       if (!found)
  268.         {
  269.           _error (67);
  270.           insymbol ();
  271.         }            /* not a member! */
  272.       else
  273.         {
  274.           /* assign value */
  275.           insymbol ();
  276.           if (sym != equal)
  277.         _error (5);
  278.           else
  279.         {
  280.           insymbol ();
  281.           exprtype = expr ();
  282.  
  283.           /* treat byte type as a SHORT when coercing */
  284.           if (member->type == bytetype)
  285.             storetype = shorttype;
  286.           else
  287.             storetype = member->type;    /* short, long, single */
  288.  
  289.           storetype = assign_coerce (storetype, exprtype);
  290.           if (storetype == notype)
  291.             _error (4);    /* type mismatch */
  292.           else
  293.             {
  294.               /* address of structure */
  295.               ltoa (-1 * item->address, addrbuf, 10);
  296.               strcat (addrbuf, frame_ptr[lev]);
  297.  
  298.               if (item->shared && lev == ONE)
  299.             {
  300.               gen ("movea.l", addrbuf, "a0");    /* structure variable address */
  301.               gen ("movea.l", "(a0)", "a0");    /* start address of structure */
  302.             }
  303.               else
  304.             gen ("movea.l", addrbuf, "a0");        /* start address of structure */
  305.  
  306.               /* offset from struct start */
  307.               if (member->type != stringtype)
  308.             {
  309.               ltoa (member->offset, absbuf, 10);
  310.               strcat (absbuf, "(a0)");
  311.             }
  312.  
  313.               if (member->type == bytetype)
  314.             {
  315.               gen ("move.w", "(sp)+", "d0");
  316.               gen ("move.b", "d0", absbuf);        /* byte */
  317.             }
  318.               else if (member->type == stringtype)    /* string */
  319.             {
  320.               sprintf (numbuf, "#%ld", member->offset);
  321.               gen ("move.l", "(sp)+", "a1");    /* source */
  322.               gen ("adda.l", numbuf, "a0");        /* destination = struct address + offset */
  323.               gen ("jsr", "_strcpy", "  ");        /* copy source to destination */
  324.               enter_XREF ("_strcpy");
  325.             }
  326.               else if (member->type == shorttype)
  327.             gen ("move.w", "(sp)+", absbuf);    /* short */
  328.               else
  329.             gen ("move.l", "(sp)+", absbuf);    /* long, single */
  330.             }
  331.         }
  332.         }
  333.     }
  334.     }
  335.   else
  336.     {
  337.       /* assign address of structure */
  338.       if (sym != equal)
  339.     _error (5);
  340.       else
  341.     {
  342.       insymbol ();
  343.       if (expr () != longtype)
  344.         _error (4);
  345.       else
  346.         {
  347.           /* address of structure */
  348.           ltoa (-1 * item->address, addrbuf, 10);
  349.           strcat (addrbuf, frame_ptr[lev]);
  350.  
  351.           if (item->shared && lev == ONE)
  352.         {
  353.           gen ("movea.l", addrbuf, "a0");    /* address of structure variable */
  354.           gen ("move.l", "(sp)+", "(a0)");    /* store new address in variable */
  355.         }
  356.           else
  357.         gen ("move.l", "(sp)+", addrbuf);    /* store new address in variable */
  358.         }
  359.     }
  360.     }
  361. }
  362.  
  363. void assign (void)
  364. {
  365.   char addrbuf[80], sub_name[80];
  366.   char ext_name[MAXIDSIZE], buf[MAXIDSIZE];
  367.   SYM *storage_item;
  368.   int oldlevel;
  369.   int exprtype;
  370.  
  371.   /* in case it's a subprogram */
  372.   strcpy (sub_name, "_SUB_");
  373.   strcat (sub_name, id);
  374.  
  375.   /* make external variable name 
  376.      by removing qualifier and  
  377.      adding an underscore prefix 
  378.      if one is not present. 
  379.    */
  380.   strcpy (buf, ut_id);
  381.   remove_qualifier (buf);
  382.   if (buf[0] != '_')
  383.     {
  384.       strcpy (ext_name, "_\0");
  385.       strcat (ext_name, buf);
  386.     }
  387.   else
  388.     strcpy (ext_name, buf);
  389.  
  390.   /* does it exist? */
  391.   if (exist (id, constant))
  392.     {
  393.       _error (53);
  394.       return;
  395.     }
  396.   else if (exist (id, array))
  397.     obj = array;
  398.   else if (exist (id, structure))
  399.     {
  400.       assign_to_struct (curr_item);
  401.       return;
  402.     }
  403.   else if (exist (sub_name, subprogram))
  404.     obj = subprogram;
  405.   else if (exist (ext_name, extvar))
  406.     obj = extvar;
  407.   else if (!exist (id, obj))
  408.     enter (id, typ, obj, 0);    /* create a simple variable */
  409.  
  410.   storage_item = curr_item;
  411.  
  412.   if (obj == array)
  413.     push_indices (storage_item);    /* parse indices first! */
  414.  
  415.   /* assign it */
  416.   if (!have_equal)
  417.     insymbol ();
  418.   if (sym == equal)
  419.     {
  420.       if (storage_item->object != array)    /* get expression later! */
  421.     {
  422.       insymbol ();
  423.       exprtype = expr ();
  424.       if (exprtype == undefined)
  425.         _error (0);        /* illegal syms? */
  426.       storetype = assign_coerce (storage_item->type, exprtype);
  427.       if (storetype == notype)
  428.         _error (4);        /* type mismatch */
  429.     }
  430.  
  431.       if (obj != extvar)
  432.     {
  433.       /* get address of object */
  434.       if (storage_item->object == subprogram)
  435.         {
  436.           oldlevel = lev;
  437.           lev = ZERO;
  438.         }
  439.  
  440.       itoa (-1 * storage_item->address, addrbuf, 10);
  441.       strcat (addrbuf, frame_ptr[lev]);
  442.  
  443.       if (storage_item->object == subprogram)
  444.         lev = oldlevel;
  445.     }
  446.  
  447.       switch (storage_item->object)
  448.     {
  449.     case variable:
  450.       if ((storage_item->shared) && (lev == ONE)
  451.           && (storage_item->type != stringtype))
  452.         {
  453.           gen ("move.l", addrbuf, "a0");    /* absolute address of store */
  454.           if (storage_item->type == shorttype)
  455.         gen ("move.w", "(sp)+", "(a0)");
  456.           else
  457.         gen ("move.l", "(sp)+", "(a0)");
  458.         }
  459.       else
  460.         /* ordinary variable or shared string variable */
  461.       if (storage_item->type == stringtype)
  462.         assign_to_string_variable (storage_item, MAXSTRLEN);
  463.       else if (storage_item->type == shorttype)
  464.         gen ("move.w", "(sp)+", addrbuf);
  465.       else
  466.         /* longtype or singletype */
  467.         gen ("move.l", "(sp)+", addrbuf);
  468.       break;
  469.  
  470.     case subprogram:
  471.       if (storage_item->address != extfunc)
  472.         {
  473.           if (storage_item->type == stringtype)
  474.         {
  475.           oldlevel = lev;
  476.           lev = ZERO;
  477.           assign_to_string_variable (storage_item, MAXSTRLEN);
  478.           lev = oldlevel;
  479.         }
  480.           else if (storage_item->type == shorttype)
  481.         gen ("move.w", "(sp)+", addrbuf);
  482.           else
  483.         /* longtype or singletype */
  484.         gen ("move.l", "(sp)+", addrbuf);
  485.         }
  486.       else
  487.         {
  488.           /* External subprogram being assigned a value */
  489.           if (storage_item->type == shorttype)
  490.         gen ("move.w", "(sp)+", "d0");
  491.           else
  492.         /* longint, single, string */
  493.         gen ("move.l", "(sp)+", "d0");
  494.         }
  495.       break;
  496.  
  497.     case extvar:
  498.       if (storage_item->type == shorttype)
  499.         /* short integer */
  500.         gen ("move.w", "(sp)+", ext_name);
  501.       else if (storage_item->type == stringtype)
  502.         {
  503.           /* string */
  504.           gen ("move.l", "(sp)+", "a1");
  505.           gen ("lea", ext_name, "a0");
  506.           gen ("jsr", "_strcpy", "  ");
  507.           enter_XREF ("_strcpy");
  508.         }
  509.       else
  510.         /* long integer, single-precision */
  511.         gen ("move.l", "(sp)+", ext_name);
  512.       break;
  513.  
  514.     case array:
  515.       get_abs_ndx (storage_item);
  516.  
  517.       /* save storage info in case it gets clobbered
  518.          by other arrays in expr()!! */
  519.       gen ("move.l", "d7", "_tmpelement");
  520.       enter_BSS ("_tmpelement", "ds.l 1");
  521.  
  522.       /*if (storage_item->type == stringtype)
  523.          {
  524.          gen("move.l","_stroffset","_tmpstroffset");
  525.          enter_BSS("_tmpstroffset","ds.l 1");
  526.          } */
  527.  
  528.       /* get expression */
  529.       insymbol ();
  530.       have_lparen = FALSE;    /* may encounter another array */
  531.       exprtype = expr ();
  532.       if (exprtype == undefined)
  533.         _error (0);        /* illegal syms? */
  534.       storetype = assign_coerce (storage_item->type, exprtype);
  535.       if (storetype == notype)
  536.         _error (4);        /* type mismatch */
  537.  
  538.       /* restore storage item info */
  539.       gen ("move.l", "_tmpelement", "d7");
  540.  
  541.       if (storage_item->type == stringtype)
  542.         assign_to_string_array (addrbuf);
  543.       else if (storage_item->type == shorttype)
  544.         {
  545.           gen ("move.l", addrbuf, "a0");
  546.           gen ("move.w", "(sp)+", "0(a0,d7.L)");
  547.         }
  548.       else
  549.         {
  550.           /* long or single */
  551.           gen ("move.l", addrbuf, "a0");
  552.           gen ("move.l", "(sp)+", "0(a0,d7.L)");
  553.         }
  554.       break;
  555.     }
  556.     }
  557.   else
  558.     _error (5);            /* '=' expected */
  559. }
  560.  
  561. void make_array_name (char *name, char *lab)
  562. {
  563.   char num[20];
  564.  
  565.   strcpy (name, "_array");
  566.   itoa (arraycount++, num, 10);
  567.   strcat (name, num);
  568.   strcpy (lab, name);
  569.   strcat (lab, ":\0");
  570. }
  571.  
  572. void dim (void)
  573. /* declare an array */
  574. {
  575.   BOOL dimmed = TRUE;
  576.   int index;
  577.   int arraytype;
  578.   char arrayid[50];
  579.   SYM *array_item;
  580.   char buf[80], numbuf[80], addrbuf[80];
  581.   char arrayname[80], arraylabel[80];
  582.   LONG max_element, string_element_size;
  583.  
  584.   do
  585.     {
  586.       arraytype = undefined;
  587.  
  588.       insymbol ();
  589.  
  590.       /* type identifiers */
  591.       if (sym == shortintsym || sym == longintsym || sym == addresssym ||
  592.       sym == singlesym || sym == stringsym)
  593.     {
  594.       switch (sym)
  595.         {
  596.         case shortintsym:
  597.           arraytype = shorttype;
  598.           break;
  599.         case longintsym:
  600.           arraytype = longtype;
  601.           break;
  602.         case addresssym:
  603.           arraytype = longtype;
  604.           break;
  605.         case singlesym:
  606.           arraytype = singletype;
  607.           break;
  608.         case stringsym:
  609.           arraytype = stringtype;
  610.           break;
  611.         }
  612.       insymbol ();
  613.     }
  614.  
  615.       if (sym == ident)
  616.     {
  617.       if (!exist (id, array))
  618.         {
  619.           dimmed = FALSE;
  620.           strcpy (arrayid, id);
  621.           if (arraytype == undefined)
  622.         arraytype = typ;
  623.         }
  624.       else
  625.         {
  626.           _error (22);
  627.           insymbol ();
  628.           return;
  629.         }            /* array already declared */
  630.  
  631.       insymbol ();
  632.  
  633.       if (sym != lparen)
  634.         _error (14);
  635.       else
  636.         {
  637.           index = 0;
  638.           do
  639.         {
  640.           insymbol ();
  641.           /* literal constant? */
  642.           if ((sym == shortconst) && (shortval > 0))
  643.             dimsize[index++] = shortval + 1;
  644.           else
  645.             /* defined constant? */
  646.           if ((sym == ident) && (exist (id, constant)))
  647.             {
  648.               if ((curr_item->type == shorttype) && (curr_item->numconst.shortnum > 0))
  649.             dimsize[index++] = curr_item->numconst.shortnum + 1;
  650.               else
  651.             _error (23);
  652.             }
  653.           else
  654.             _error (23);    /* illegal array index */
  655.           insymbol ();
  656.         }
  657.           while ((sym == comma) && (index < MAXDIMS));
  658.  
  659.           if (sym != rparen)
  660.         _error (9);
  661.  
  662.           if (!dimmed)
  663.         {
  664.           enter (arrayid, arraytype, array, index - 1);
  665.           array_item = curr_item;
  666.  
  667.           max_element = max_array_ndx (array_item);    /* number of linear elements */
  668.  
  669.           /* frame address to hold array pointer */
  670.           itoa (-1 * array_item->address, addrbuf, 10);
  671.           strcat (addrbuf, frame_ptr[lev]);
  672.  
  673.           insymbol ();
  674.  
  675.           /* specify size of string array elements with "SIZE"? */
  676.           if (sym == sizesym && array_item->type == stringtype)
  677.             {
  678.               insymbol ();
  679.               if (sym == shortconst)
  680.             string_element_size = (LONG) shortval;
  681.               else if (sym == longconst)
  682.             string_element_size = longval;
  683.               else if (sym == ident && exist (id, constant))
  684.             {
  685.               if (curr_item->type == shorttype)
  686.                 string_element_size = (LONG) curr_item->numconst.shortnum;
  687.               else if (curr_item->type == longtype)
  688.                 string_element_size = curr_item->numconst.longnum;
  689.               else
  690.                 _error (4);
  691.             }
  692.               else if (sym == singleconst)
  693.             _error (4);
  694.               else
  695.             _error (27);    /* numeric constant expected */
  696.  
  697.               if (string_element_size <= 0L)
  698.             _error (41);    /* non-positive string size */
  699.  
  700.               insymbol ();
  701.             }
  702.           else
  703.             string_element_size = MAXSTRLEN;
  704.  
  705.           /* record size of array in bytes (for SIZEOF) 
  706.              plus string element size */
  707.           if (array_item->type == stringtype)
  708.             {
  709.               array_item->size = max_element * string_element_size;
  710.               /* size of each string array element */
  711.               array_item->numconst.longnum = string_element_size;
  712.             }
  713.           else if (array_item->type == shorttype)
  714.             array_item->size = max_element * 2;
  715.           else
  716.             /* long or single */
  717.             array_item->size = max_element * 4;
  718.  
  719.           /* specify ADDRESS? */
  720.           if (sym != addresssym)
  721.             {
  722.               /* set up BSS object for array */
  723.  
  724.               if (array_item->type == stringtype)
  725.             strcpy (buf, "ds.b ");
  726.               else if (array_item->type == shorttype)
  727.             strcpy (buf, "ds.w ");
  728.               else
  729.             /* long or single */
  730.             strcpy (buf, "ds.l ");
  731.  
  732.               if (array_item->type == stringtype)
  733.             ltoa (max_element * string_element_size, numbuf, 10);
  734.               else
  735.             ltoa (max_element, numbuf, 10);
  736.  
  737.               strcat (buf, numbuf);
  738.               make_array_name (arrayname, arraylabel);
  739.  
  740.               /* create the BSS object */
  741.               enter_BSS (arraylabel, buf);
  742.  
  743.               /* store address of array in stack frame */
  744.               gen ("pea", arrayname, "  ");
  745.               gen ("move.l", "(sp)+", addrbuf);
  746.             }
  747.           else
  748.             {
  749.               /* push specified array start address */
  750.               insymbol ();
  751.               if (expr () != longtype)
  752.             _error (4);
  753.               else
  754.             /* store address of array in stack frame */
  755.             gen ("move.l", "(sp)+", addrbuf);
  756.             }
  757.         }
  758.         }
  759.     }
  760.       else
  761.     _error (7);
  762.     }
  763.   while (sym == comma);
  764. }
  765.  
  766. /* --------------- */
  767. /* INPUT functions */
  768. /* --------------- */
  769.  
  770. void input (void)
  771. {
  772.   int inptype;
  773.   char addrbuf[80];
  774.   SYM *storage;
  775.  
  776.   if ((sym != comma) && (sym != semicolon) && (sym != ident))
  777.     {
  778.       /* print a string constant? */
  779.       inptype = expr ();
  780.       if ((inptype == stringtype) && (lastsym == stringconst))
  781.     {
  782.       gen ("jsr", "_Ustringprint", "  ");
  783.       gen ("addq", "#4", "sp");
  784.       enter_XREF ("_Ustringprint");
  785.     }
  786.       else
  787.     _error (18);
  788.     }
  789.  
  790.   do
  791.     {
  792.       /* ";" or "," -> "?" */
  793.       if ((sym == comma) || (sym == semicolon))
  794.     {
  795.       if (sym == semicolon)
  796.         {
  797.           gen_printcode (QUN_CODE);
  798.           gen_printcode (SPACE_CODE);
  799.         }
  800.       insymbol ();
  801.     }
  802.       else
  803.     {
  804.       gen_printcode (QUN_CODE);
  805.       gen_printcode (SPACE_CODE);
  806.     }
  807.  
  808.       /* allocate variable storage, call _input* and store value in variable */
  809.       if ((sym == ident) && (obj == variable))
  810.     {
  811.       if ((!exist (id, obj)) && (!exist (id, array)))
  812.         enter (id, typ, obj, 0);    /* allocate storage for a simple variable */
  813.  
  814.       storage = curr_item;
  815.  
  816.       itoa (-1 * storage->address, addrbuf, 10);
  817.       strcat (addrbuf, frame_ptr[lev]);
  818.  
  819.       /* ALL data types need a temporary string */
  820.       make_temp_string ();
  821.       if (storage->type != stringtype)
  822.         gen ("lea", tempstrname, "a1");
  823.       else
  824.         gen ("pea", tempstrname, "  ");
  825.  
  826.       /* When storing an input value into an array element, must save
  827.          value (d0) first, since array index calculation may be corrupted
  828.          if index has to be coerced from ffp to short.
  829.        */
  830.  
  831.       switch (storage->type)
  832.         {
  833.         case shorttype:
  834.           gen ("jsr", "_inputshort", "  ");
  835.  
  836.           if (storage->object == variable)
  837.         {
  838.           if ((storage->shared) && (lev == ONE))
  839.             {
  840.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  841.               gen ("move.w", "d0", "(a0)");
  842.             }
  843.           else
  844.             /* ordinary variable */
  845.             gen ("move.w", "d0", addrbuf);
  846.         }
  847.           else if (storage->object == array)
  848.         {
  849.           gen ("move.w", "d0", "_short_input_temp");
  850.           point_to_array (storage, addrbuf);
  851.           gen ("move.w", "_short_input_temp", "0(a2,d7.L)");
  852.           enter_BSS ("_short_input_temp:", "ds.w 1");
  853.         }
  854.  
  855.           enter_XREF ("_inputshort");
  856.           break;
  857.  
  858.         case longtype:
  859.           gen ("jsr", "_inputlong", "  ");
  860.  
  861.           if (storage->object == variable)
  862.         {
  863.           if ((storage->shared) && (lev == ONE))
  864.             {
  865.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  866.               gen ("move.l", "d0", "(a0)");
  867.             }
  868.           else
  869.             /* ordinary variable */
  870.             gen ("move.l", "d0", addrbuf);
  871.         }
  872.           else if (storage->object == array)
  873.         {
  874.           gen ("move.l", "d0", "_long_input_temp");
  875.           point_to_array (storage, addrbuf);
  876.           gen ("move.l", "_long_input_temp", "0(a2,d7.L)");
  877.           enter_BSS ("_long_input_temp:", "ds.l 1");
  878.         }
  879.  
  880.           enter_XREF ("_inputlong");
  881.           break;
  882.  
  883.         case singletype:
  884.           gen ("jsr", "_inputsingle", "  ");
  885.  
  886.           if (storage->object == variable)
  887.         {
  888.           if ((storage->shared) && (lev == ONE))
  889.             {
  890.               gen ("move.l", addrbuf, "a0");    /* abs address of store */
  891.               gen ("move.l", "d0", "(a0)");
  892.             }
  893.           else
  894.             /* ordinary variable */
  895.             gen ("move.l", "d0", addrbuf);
  896.         }
  897.           else if (storage->object == array)
  898.         {
  899.           gen ("move.l", "d0", "_long_input_temp");
  900.           point_to_array (storage, addrbuf);
  901.           gen ("move.l", "_long_input_temp", "0(a2,d7.L)");
  902.           enter_BSS ("_long_input_temp:", "ds.l 1");
  903.         }
  904.  
  905.           enter_XREF ("_inputsingle");
  906.           enter_XREF ("_MathBase");        /* need math libs */
  907.           enter_XREF ("_MathTransBase");
  908.           break;
  909.  
  910.         case stringtype:
  911.           gen ("jsr", "_Ustringinput", "  ");
  912.  
  913.           if (storage->object == variable)
  914.         assign_to_string_variable (storage, MAXSTRLEN);
  915.           else if (storage->object == array)
  916.         {
  917.           point_to_array (storage, addrbuf);
  918.           assign_to_string_array (addrbuf);
  919.         }
  920.  
  921.           enter_XREF ("_Ustringinput");
  922.           break;
  923.         }
  924.     }
  925.       else
  926.     _error (19);
  927.  
  928.       insymbol ();
  929.       if (sym == lparen && storage->object != array)
  930.     _error (71);        /* undeclared array */
  931.     }
  932.   while ((sym == comma) || (sym == semicolon) || (sym == ident));
  933. }
  934.  
  935. void point_to_array (SYM * storage, char *addrbuf)
  936. {
  937.  
  938.   /* get absolute index of array element */
  939.   have_lparen = FALSE;
  940.   push_indices (storage);
  941.   get_abs_ndx (storage);
  942.  
  943.   if (storage->type != stringtype)
  944.     gen ("move.l", addrbuf, "a2");    /* --> pointer to start of array <-- */
  945. }
  946.  
  947. /* -------------- */
  948. /* DATA functions */
  949. /* -------------- */
  950.  
  951.  
  952. void get_data (void)
  953. {
  954. /* parse a line of BASIC DATA */
  955.   char fnumbuf[40];
  956.   float fnum, sign;
  957.  
  958.   do
  959.     {
  960.       sign = 1.0;
  961.  
  962.       insymbol ();
  963.  
  964.       /* arithmetic sign? */
  965.       if ((sym == minus) || (sym == plus))
  966.     {
  967.       if (sym == minus)
  968.         sign = -1.0;
  969.       insymbol ();
  970.       if ((sym == ident) || (sym == stringconst))
  971.         _error (27);
  972.     }
  973.  
  974.       if (sym == ident)
  975.     make_data_const (ut_id);
  976.       else if (sym == stringconst)
  977.     make_data_const (stringval);
  978.       else if (sym == singleconst)
  979.     {
  980. /*      sprintf (fnumbuf, "%lx", SPMul (singleval, sign));    original */
  981.       sprintf (fnumbuf, "%x", SPMul (singleval, sign));
  982.       make_data_const (fnumbuf);
  983.     }
  984.       else if (sym == longconst)
  985.     {
  986.       fnum = SPMul (SPFlt (longval), sign);
  987. /*      sprintf (fnumbuf, "%lx", fnum);        original */
  988.       sprintf (fnumbuf, "%x", fnum);
  989.       make_data_const (fnumbuf);
  990.     }
  991.       else if (sym == shortconst)
  992.     {
  993. /*      fnum = SPMul (SPFlt ((long) shortval), sign);*/
  994.       fnum = ((float)shortval) * sign;
  995. /*      sprintf (fnumbuf, "%lx", fnum);       original    */
  996.       sprintf (fnumbuf, "%x", fnum);
  997.       make_data_const (fnumbuf);
  998.     }
  999.       else
  1000.     _error (26);        /* constant expected */
  1001.  
  1002.       insymbol ();
  1003.     }
  1004.   while (sym == comma);
  1005. }
  1006.  
  1007. void read_data (void)
  1008. {
  1009.   char addrbuf[80];
  1010.   SYM *storage;
  1011.  
  1012. /* read a value from the DATA list into a variable or array element */
  1013.  
  1014.   readpresent = TRUE;
  1015.  
  1016.   do
  1017.     {
  1018.       insymbol ();
  1019.  
  1020.       if ((sym == ident) && (obj == variable))
  1021.     {
  1022.       if ((!exist (id, obj)) && (!exist (id, array)))
  1023.         enter (id, typ, obj, 0);    /* allocate storage */
  1024.  
  1025.       storage = curr_item;    /* save storage item information */
  1026.  
  1027.       itoa (-1 * storage->address, addrbuf, 10);
  1028.       strcat (addrbuf, frame_ptr[lev]);
  1029.  
  1030.       /* is it an array? (this must already have been dimensioned!) */
  1031.       if (storage->object == array)
  1032.         {
  1033.           /* get absolute index of array element */
  1034.           have_lparen = FALSE;
  1035.           push_indices (storage);
  1036.           get_abs_ndx (storage);
  1037.  
  1038.           /* --> get pointer to start of array <-- */
  1039.           if (storage->type != stringtype)
  1040.         gen ("move.l", addrbuf, "a2");
  1041.         }
  1042.  
  1043.       /* get next item from DATA list */
  1044.       if (typ != stringtype)
  1045.         gen ("move.l", "_dataptr", "a1");    /* for _htol */
  1046.  
  1047.       switch (storage->type)
  1048.         {
  1049.         case stringtype:
  1050.           gen ("move.l", "_dataptr", "-(sp)");    /* addr of source */
  1051.  
  1052.           if (storage->object == variable)
  1053.         assign_to_string_variable (storage, MAXSTRLEN);
  1054.           else if (storage->object == array)
  1055.         assign_to_string_array (addrbuf);
  1056.           break;
  1057.  
  1058.         case singletype:
  1059.           gen ("jsr", "_htol", "  ");    /* return LONG from (a1) */
  1060.           if (storage->object == variable)
  1061.         {
  1062.           if ((storage->shared) && (lev == ONE))
  1063.             {
  1064.               gen ("move.l", addrbuf, "a0");    /* abs addr of store */
  1065.               gen ("move.l", "d0", "(a0)");
  1066.             }
  1067.           else
  1068.             gen ("move.l", "d0", addrbuf);
  1069.         }
  1070.           else if (storage->object == array)
  1071.         gen ("move.l", "d0", "0(a2,d7.L)");
  1072.           enter_XREF ("_htol");
  1073.           break;
  1074.  
  1075.         case longtype:
  1076.           gen ("jsr", "_htol", "  ");
  1077.           gen ("move.l", "d0", "-(sp)");
  1078.           make_integer (singletype);
  1079.           if (storage->object == variable)
  1080.         {
  1081.           if ((storage->shared) && (lev == ONE))
  1082.             {
  1083.               gen ("move.l", addrbuf, "a0");    /* abs addr of store */
  1084.               gen ("move.l", "(sp)+", "(a0)");
  1085.             }
  1086.           else
  1087.             gen ("move.l", "(sp)+", addrbuf);
  1088.         }
  1089.           else if (storage->object == array)
  1090.         gen ("move.l", "(sp)+", "0(a2,d7.L)");
  1091.           enter_XREF ("_htol");
  1092.           break;
  1093.  
  1094.         case shorttype:
  1095.           gen ("jsr", "_htol", "  ");
  1096.           gen ("move.l", "d0", "-(sp)");
  1097.           make_sure_short (singletype);
  1098.           if (storage->object == variable)
  1099.         {
  1100.           if ((storage->shared) && (lev == ONE))
  1101.             {
  1102.               gen ("move.l", addrbuf, "a0");    /* abs addr of store */
  1103.               gen ("move.w", "(sp)+", "(a0)");
  1104.             }
  1105.           else
  1106.             gen ("move.w", "(sp)+", addrbuf);
  1107.         }
  1108.           else if (storage->object == array)
  1109.         gen ("move.w", "(sp)+", "0(a2,d7.L)");
  1110.           enter_XREF ("_htol");
  1111.           break;
  1112.         }
  1113.     }
  1114.       else
  1115.     _error (19);        /* variable expected */
  1116.  
  1117.       /* advance to next DATA item */
  1118.       gen ("move.l", "_dataptr", "a2");
  1119.       gen ("jsr", "_strlen", "  ");
  1120.       enter_XREF ("_strlen");
  1121.       gen ("addq", "#1", "d0");    /* include EOS in length */
  1122.       gen ("move.l", "_dataptr", "d1");
  1123.       gen ("add.l", "d0", "d1");
  1124.       gen ("move.l", "d1", "_dataptr");
  1125.  
  1126.       insymbol ();
  1127.       if (sym == lparen && storage->object != array)
  1128.     _error (71);        /* undeclared array */
  1129.     }
  1130.   while (sym == comma);
  1131. }
  1132.