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