home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / basfun.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-05  |  45.0 KB  |  2,162 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Intrinsic Functions **
  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: 16th-30th November, 1st-12th December 1991,
  24.    27th January 1992, 
  25.    6th,11th,14th,17th,28th,29th February 1992,
  26.    23rd March 1992,
  27.    21st April 1992,
  28.    2nd,11th,15th May 1992,
  29.    8th,14th,28th June 1992,
  30.    2nd,5th,14th,15th,26th-28th July 1992,
  31.    2nd,9th August 1992,
  32.    6th,7th,8th,13th,29th December 1992,
  33.    5th January 1993,
  34.    14th,18th February 1993,
  35.    8th,10th March 1993,
  36.    25th,30th May 1993,
  37.    6th,13th,19th,30th June 1993,
  38.    1st,3rd,4th July 1993,
  39.    5th,25th September 1993,
  40.    10th,11th October 1993,
  41.    2nd,9th November 1993,
  42.    24th,28th December 1993,
  43.    6th January 1994,
  44.    7th,26th,27th February 1994,
  45.    4th April 1994,
  46.    28th August 1994,
  47.    3rd,4th September 1994,
  48.    5th,11th March 1995,
  49.    10th March 1996
  50.  */
  51.  
  52. #include "acedef.h"
  53. #include <string.h>
  54.  
  55. /* locals */
  56. static char *addreg[] = {"a4", "a5"};
  57.  
  58. /* externals */
  59. extern int sym;
  60. extern int lev;
  61. extern int struct_member_type;
  62. extern char id[MAXIDSIZE];
  63. extern char ut_id[MAXIDSIZE];
  64. extern SYM *curr_item;
  65. extern char tempstrname[80];
  66. extern char strstorename[80];
  67. extern char strstorelabel[80];
  68. extern BOOL cli_args;
  69. extern BOOL break_opt;
  70. extern BOOL have_lparen;
  71.  
  72. /* string functions */
  73. BOOL strfunc (void)
  74. {
  75.   switch (sym)
  76.     {
  77.     case argstrsym:
  78.       return (TRUE);
  79.     case ascsym:
  80.       return (TRUE);
  81.     case binstrsym:
  82.       return (TRUE);
  83.     case chrstrsym:
  84.       return (TRUE);
  85.     case cstrsym:
  86.       return (TRUE);
  87.     case fileboxstrsym:
  88.       return (TRUE);
  89.     case hexsym:
  90.       return (TRUE);
  91.     case inputboxsym:
  92.       return (TRUE);        /* this is here for convienience */
  93.     case inputboxstrsym:
  94.       return (TRUE);
  95.     case inputstrsym:
  96.       return (TRUE);
  97.     case instrsym:
  98.       return (TRUE);
  99.     case leftstrsym:
  100.       return (TRUE);
  101.     case lensym:
  102.       return (TRUE);
  103.     case midstrsym:
  104.       return (TRUE);
  105.     case octstrsym:
  106.       return (TRUE);
  107.     case ptabsym:
  108.       return (TRUE);
  109.     case rightstrsym:
  110.       return (TRUE);
  111.     case saddsym:
  112.       return (TRUE);
  113.     case spacestrsym:
  114.       return (TRUE);
  115.     case spcsym:
  116.       return (TRUE);
  117.     case strstrsym:
  118.       return (TRUE);
  119.     case stringstrsym:
  120.       return (TRUE);
  121.     case tabsym:
  122.       return (TRUE);
  123.     case translatestrsym:
  124.       return (TRUE);
  125.     case ucasestrsym:
  126.       return (TRUE);
  127.     case valsym:
  128.       return (TRUE);
  129.     }
  130.   return (FALSE);
  131. }
  132.  
  133. int stringfunction (void)
  134. {
  135.   int func;
  136.   int sftype = undefined;
  137.   int ntype = undefined;
  138.   char buf[80], srcbuf[80];
  139.   BOOL commaset = FALSE;
  140.   BOOL offset_on_stack;
  141.  
  142.   if (strfunc ())
  143.     {
  144.       func = sym;
  145.       insymbol ();
  146.       if (sym != lparen)
  147.     _error (14);
  148.       else
  149.     {
  150.       insymbol ();
  151.       sftype = expr ();
  152.  
  153.       switch (func)
  154.         {
  155.           /* CHR$ */
  156.         case chrstrsym:
  157.           sftype = make_integer (sftype);
  158.           if (sftype == longtype)
  159.         {
  160.           make_short ();
  161.           sftype = shorttype;
  162.         }
  163.  
  164.           if (sftype != notype)
  165.         {
  166.           /* Ascii value to copy to string */
  167.           gen ("move.w", "(sp)+", "d0");
  168.           /* create a string to copy value to */
  169.           make_string_store ();
  170.           strcpy (buf, strstorename);
  171.           gen ("lea", buf, "a0");
  172.           gen ("jsr", "_chrstring", "  ");
  173.           gen ("pea", strstorename, "  ");
  174.           enter_XREF ("_chrstring");
  175.           enter_BSS (strstorelabel, "ds.b 2");
  176.           sftype = stringtype;
  177.         }
  178.           else
  179.         {
  180.           _error (4);
  181.           sftype = undefined;
  182.         }
  183.           break;
  184.  
  185.           /* ARG$ */
  186.         case argstrsym:
  187.           if (sftype != stringtype)
  188.         {
  189.           /* argument number */
  190.           if (make_integer (sftype) == shorttype)
  191.             make_long ();
  192.           /* destination buffer */
  193.           make_temp_string ();
  194.           gen ("pea", tempstrname, "  ");
  195.           gen ("jsr", "_arg", "  ");
  196.           gen ("addq", "#8", "sp");
  197.           gen ("move.l", "d0", "-(sp)");
  198.           enter_XREF ("_arg");
  199.           cli_args = TRUE;
  200.           sftype = stringtype;
  201.         }
  202.           else
  203.         {
  204.           _error (4);
  205.           sftype = undefined;
  206.         }
  207.           break;
  208.  
  209.           /* ASC */
  210.         case ascsym:
  211.           if (sftype == stringtype)
  212.         {
  213.           gen ("move.l", "(sp)+", "a2");
  214.           gen ("jsr", "_asc", "  ");
  215.           gen ("move.w", "d0", "-(sp)");
  216.           enter_XREF ("_asc");
  217.           sftype = shorttype;
  218.         }
  219.           else
  220.         {
  221.           _error (4);
  222.           sftype = undefined;
  223.         }
  224.           break;
  225.  
  226.           /* BIN$ */
  227.         case binstrsym:
  228.           if (sftype != stringtype)
  229.         {
  230.           if (make_integer (sftype) == shorttype)
  231.             make_long ();    /* only handle long val */
  232.           make_temp_string ();
  233.           gen ("lea", tempstrname, "a0");
  234.           gen ("move.l", "(sp)+", "d0");    /* long argument */
  235.           gen ("jsr", "_binstr", "  ");
  236.           enter_XREF ("_binstr");
  237.           gen ("move.l", "a0", "-(sp)");    /* push string result */
  238.           sftype = stringtype;
  239.         }
  240.           else
  241.         {
  242.           _error (4);
  243.           sftype = undefined;
  244.         }
  245.           break;
  246.  
  247.           /* CSTR */
  248.         case cstrsym:
  249.           if ((sftype == stringtype) || (sftype == longtype))
  250.         sftype = stringtype;
  251.           else
  252.         {
  253.           _error (4);
  254.           sftype = undefined;
  255.         }
  256.           break;
  257.  
  258.           /* FILEBOX$ */
  259.         case fileboxstrsym:
  260.           if (sftype == stringtype)        /* title */
  261.         {
  262.           /* default directory? */
  263.           if (sym == comma)
  264.             {
  265.               insymbol ();
  266.               if (expr () != stringtype)
  267.             _error (4);
  268.             }
  269.           else
  270.             gen ("move.l", "#0", "-(sp)");
  271.  
  272.           gen ("jsr", "_filerequest", "  ");
  273.           gen ("addq", "#8", "sp");
  274.           gen ("move.l", "d0", "-(sp)");
  275.           enter_XREF ("_filerequest");
  276.           enter_XREF ("_GfxBase");
  277.           sftype = stringtype;
  278.         }
  279.           else
  280.         {
  281.           _error (4);
  282.           sftype = undefined;
  283.         }
  284.           break;
  285.  
  286.           /* HEX$ */
  287.         case hexsym:
  288.           if (sftype != stringtype)
  289.         {
  290.           sftype = make_integer (sftype);
  291.           make_temp_string ();
  292.           gen ("lea", tempstrname, "a0");
  293.           if (sftype == longtype)
  294.             {
  295.               gen ("move.l", "(sp)+", "d0");
  296.               gen ("jsr", "_hexstrlong", "  ");
  297.               enter_XREF ("_hexstrlong");
  298.             }
  299.           else
  300.             /* shorttype */
  301.             {
  302.               gen ("move.w", "(sp)+", "d0");
  303.               gen ("jsr", "_hexstrshort", "  ");
  304.               enter_XREF ("_hexstrshort");
  305.             }
  306.           gen ("move.l", "a0", "-(sp)");    /* push string result */
  307.           sftype = stringtype;
  308.         }
  309.           else
  310.         {
  311.           _error (4);
  312.           sftype = undefined;
  313.         }
  314.           break;
  315.  
  316.           /* INPUTBOX and INPUTBOX$ */
  317.         case inputboxsym:
  318.         case inputboxstrsym:
  319.           if (sftype == stringtype)        /* prompt */
  320.         {
  321.           /* all other parameters are optional */
  322.  
  323.           if (sym == comma)    /* title */
  324.             {
  325.               insymbol ();
  326.               if (sym != comma)
  327.             {
  328.               if (expr () != stringtype)
  329.                 _error (4);
  330.             }
  331.               else
  332.             gen ("move.l", "#0", "-(sp)");
  333.             }
  334.           else
  335.             gen ("move.l", "#0", "-(sp)");
  336.  
  337.           if (sym == comma)    /* default value */
  338.             {
  339.               insymbol ();
  340.               if (sym != comma)
  341.             {
  342.               if (expr () != stringtype)
  343.                 _error (4);
  344.             }
  345.               else
  346.             gen ("move.l", "#0", "-(sp)");
  347.             }
  348.           else
  349.             gen ("move.l", "#0", "-(sp)");
  350.  
  351.           if (sym == comma)    /* xpos */
  352.             {
  353.               insymbol ();
  354.               if (sym != comma)
  355.             {
  356.               if (make_integer (expr ()) == shorttype)
  357.                 make_long ();
  358.             }
  359.               else
  360.             gen ("move.l", "#0", "-(sp)");
  361.             }
  362.           else
  363.             gen ("move.l", "#0", "-(sp)");
  364.  
  365.           if (sym == comma)    /* ypos */
  366.             {
  367.               insymbol ();
  368.               if (sym != comma)
  369.             {
  370.               if (make_integer (expr ()) == shorttype)
  371.                 make_long ();
  372.             }
  373.               else
  374.             gen ("move.l", "#0", "-(sp)");
  375.             }
  376.           else
  377.             gen ("move.l", "#0", "-(sp)");
  378.  
  379.           /* which function? */
  380.           if (func == inputboxsym)
  381.             {
  382.               /* INPUTBOX */
  383.               gen ("jsr", "_longint_input_box", "  ");
  384.               gen ("add.l", "#20", "sp");
  385.               gen ("move.l", "d0", "-(sp)");
  386.               enter_XREF ("_longint_input_box");
  387.               sftype = longtype;
  388.             }
  389.           else
  390.             {
  391.               /* INPUTBOX$ */
  392.               gen ("jsr", "_string_input_box", "  ");
  393.               gen ("add.l", "#20", "sp");
  394.               gen ("move.l", "d0", "-(sp)");
  395.               enter_XREF ("_string_input_box");
  396.               sftype = stringtype;
  397.             }
  398.  
  399.           /* both functions need graphics and intuition libraries! */
  400.           enter_XREF ("_GfxBase");
  401.         }
  402.           else
  403.         {
  404.           _error (4);
  405.           sftype = undefined;
  406.         }
  407.           break;
  408.  
  409.           /* INPUT$(X,[#]filenumber) */
  410.         case inputstrsym:
  411.           if (sftype != stringtype)
  412.         {
  413.           check_for_event ();
  414.  
  415.           if (make_integer (sftype) == shorttype)
  416.             make_long ();    /* no. of characters */
  417.  
  418.           if (sym == comma)
  419.             {
  420.               insymbol ();
  421.               if (sym == hash)
  422.             insymbol ();
  423.               if (make_integer (expr ()) == shorttype)
  424.             make_long ();    /* filenumber */
  425.             }
  426.           else
  427.             {
  428.               _error (16);
  429.               sftype = undefined;
  430.             }
  431.  
  432.           gen ("move.l", "(sp)+", "d0");    /* pop filenumber */
  433.           gen ("move.l", "(sp)+", "d1");    /* pop no. of characters */
  434.           gen ("jsr", "_inputstrfromfile", "  ");
  435.           gen ("move.l", "d0", "-(sp)");    /* push string result */
  436.  
  437.           enter_XREF ("_inputstrfromfile");
  438.           enter_XREF ("_DOSBase");
  439.           sftype = stringtype;
  440.         }
  441.           else
  442.         {
  443.           _error (4);
  444.           sftype = undefined;
  445.         }
  446.           break;
  447.  
  448.           /* INSTR$([I,]X$,Y$) */
  449.         case instrsym:
  450.           if (sftype != stringtype)
  451.         {
  452.           if (make_integer (sftype) == shorttype)
  453.             make_long ();
  454.  
  455.           if (sym == comma)
  456.             {
  457.               offset_on_stack = TRUE;    /* optional offset I */
  458.               insymbol ();
  459.               sftype = expr ();
  460.             }
  461.           else
  462.             {
  463.               _error (16);
  464.               sftype = undefined;
  465.             }
  466.         }
  467.           else
  468.         offset_on_stack = FALSE;
  469.  
  470.           /* get X$ and Y$ */
  471.           if (sftype == stringtype)
  472.         {
  473.           if (sym == comma)
  474.             {
  475.               insymbol ();
  476.               if (expr () == stringtype)
  477.             {
  478.               gen ("movea.l", "(sp)+", "a1");    /* Y$ */
  479.               gen ("movea.l", "(sp)+", "a0");    /* X$ */
  480.               if (offset_on_stack)
  481.                 gen ("move.l", "(sp)+", "d0");    /* I */
  482.               else
  483.                 gen ("moveq", "#1", "d0");    /* I=1 */
  484.  
  485.               /* call INSTR */
  486.               gen ("jsr", "_instr", "  ");
  487.               gen ("move.l", "d0", "-(sp)");    /* posn of Y$ in X$ */
  488.               enter_XREF ("_instr");
  489.               sftype = longtype;
  490.             }
  491.               else
  492.             {
  493.               _error (4);
  494.               sftype = undefined;
  495.             }
  496.             }
  497.           else
  498.             {
  499.               _error (16);
  500.               sftype = undefined;
  501.             }
  502.         }
  503.           else
  504.         {
  505.           _error (4);
  506.           sftype = undefined;
  507.         }
  508.           break;
  509.  
  510.           /* LEFT$ */
  511.         case leftstrsym:
  512.           if (sftype == stringtype)
  513.         {
  514.           if (sym == comma)
  515.             {
  516.               insymbol ();
  517.               make_sure_short (expr ());
  518.               gen ("move.w", "(sp)+", "d0");    /* index */
  519.               gen ("move.l", "(sp)+", "a0");    /* string */
  520.               make_temp_string ();
  521.               gen ("lea", tempstrname, "a1");
  522.               gen ("jsr", "_leftstr", "  ");
  523.               gen ("move.l", "a0", "-(sp)");    /* addr of left$ */
  524.               enter_XREF ("_leftstr");
  525.               sftype = stringtype;
  526.             }
  527.           else
  528.             {
  529.               _error (16);
  530.               sftype = undefined;
  531.             }
  532.         }
  533.           else
  534.         {
  535.           _error (4);
  536.           sftype = undefined;
  537.         }
  538.           break;
  539.  
  540.           /* LEN */
  541.         case lensym:
  542.           if (sftype == stringtype)
  543.         {
  544.           gen ("move.l", "(sp)+", "a2");
  545.           gen ("jsr", "_strlen", "  ");
  546.           gen ("move.l", "d0", "-(sp)");
  547.           enter_XREF ("_strlen");
  548.           sftype = longtype;
  549.         }
  550.           else
  551.         {
  552.           _error (4);
  553.           sftype = undefined;
  554.         }
  555.           break;
  556.  
  557.           /* OCT$ */
  558.         case octstrsym:
  559.           if (sftype != stringtype)
  560.         {
  561.           if (make_integer (sftype) == shorttype)
  562.             make_long ();    /* only handle long val */
  563.           make_temp_string ();
  564.           gen ("lea", tempstrname, "a0");
  565.           gen ("move.l", "(sp)+", "d0");    /* long argument */
  566.           gen ("jsr", "_octstr", "  ");
  567.           enter_XREF ("_octstr");
  568.           gen ("move.l", "a0", "-(sp)");    /* push string result */
  569.           sftype = stringtype;
  570.         }
  571.           else
  572.         {
  573.           _error (4);
  574.           sftype = undefined;
  575.         }
  576.           break;
  577.  
  578.           /* RIGHT$ */
  579.         case rightstrsym:
  580.           if (sftype == stringtype)
  581.         {
  582.           if (sym == comma)
  583.             {
  584.               insymbol ();
  585.               make_sure_short (expr ());
  586.               gen ("move.w", "(sp)+", "d0");    /* index */
  587.               gen ("move.l", "(sp)+", "a0");    /* string */
  588.               make_temp_string ();
  589.               gen ("lea", tempstrname, "a1");
  590.               gen ("jsr", "_rightstr", "  ");
  591.               gen ("move.l", "a0", "-(sp)");    /* addr of right$ */
  592.               enter_XREF ("_rightstr");
  593.               sftype = stringtype;
  594.             }
  595.           else
  596.             {
  597.               _error (16);
  598.               sftype = undefined;
  599.             }
  600.         }
  601.           else
  602.         {
  603.           _error (4);
  604.           sftype = undefined;
  605.         }
  606.           break;
  607.  
  608.           /* SADD */
  609.         case saddsym:
  610.           if (sftype == stringtype)
  611.         sftype = longtype;    /* address is on stack */
  612.           else
  613.         {
  614.           _error (4);
  615.           sftype = undefined;
  616.         }
  617.           break;
  618.  
  619.           /* SPC, SPACE$ */
  620.         case spcsym:
  621.         case spacestrsym:
  622.           if (sftype != stringtype)
  623.         {
  624.           make_sure_short (sftype);
  625.           gen ("move.w", "(sp)+", "d0");
  626.           make_temp_string ();
  627.           gen ("lea", tempstrname, "a0");
  628.           if (func == spacestrsym)
  629.             gen ("jsr", "_spacestring", "  ");
  630.           else
  631.             gen ("jsr", "_spc", "  ");
  632.           gen ("move.l", "d0", "-(sp)");
  633.           if (func == spacestrsym)
  634.             enter_XREF ("_spacestring");
  635.           else
  636.             enter_XREF ("_spc");
  637.           sftype = stringtype;
  638.         }
  639.           else
  640.         {
  641.           _error (4);
  642.           sftype = undefined;
  643.         }
  644.           break;
  645.  
  646.           /* STR$ */
  647.         case strstrsym:
  648.           if (sftype != stringtype)
  649.         {
  650.           make_temp_string ();
  651.           gen ("lea", tempstrname, "a0");
  652.           if (sftype == longtype)
  653.             {
  654.               gen ("move.l", "(sp)+", "d0");
  655.               gen ("jsr", "_strlong", "  ");
  656.               enter_XREF ("_strlong");
  657.               gen ("move.l", "a0", "-(sp)");    /* push string result */
  658.             }
  659.           else if (sftype == shorttype)
  660.             {
  661.               gen ("move.w", "(sp)+", "d0");
  662.               gen ("jsr", "_strshort", "  ");
  663.               enter_XREF ("_strshort");
  664.               gen ("move.l", "a0", "-(sp)");    /* push string result */
  665.             }
  666.           else if (sftype == singletype)
  667.             {
  668.               gen ("jsr", "_strsingle", "  ");
  669.               gen ("addq", "#4", "sp");
  670.               gen ("move.l", "d0", "-(sp)");    /* push string result */
  671.               enter_XREF ("_strsingle");
  672.               enter_XREF ("_MathBase");
  673.             }
  674.           sftype = stringtype;
  675.         }
  676.           else
  677.         {
  678.           _error (4);
  679.           sftype = undefined;
  680.         }
  681.           break;
  682.  
  683.           /*   STRING$(I,J) 
  684.              or STRING$(I,X$) */
  685.         case stringstrsym:
  686.           if (sftype != stringtype)
  687.         {
  688.           make_sure_short (sftype);
  689.  
  690.           if (sym == comma)
  691.             {
  692.               insymbol ();
  693.               ntype = expr ();
  694.  
  695.               if (ntype == stringtype)
  696.             {
  697.               gen ("move.l", "(sp)+", "a0");
  698.               gen ("move.b", "(a0)", "d1");
  699.               gen ("ext.w", "d1", "  ");
  700.               gen ("ext.l", "d1", "  ");    /* MID$(X$,1,1) */
  701.             }
  702.               else
  703.             {
  704.               if (make_integer (ntype) == shorttype)
  705.                 make_long ();
  706.               gen ("move.l", "(sp)+", "d1");    /* J */
  707.             }
  708.  
  709.               gen ("move.w", "(sp)+", "d0");    /* I */
  710.  
  711.               /* call STRING$ */
  712.               make_temp_string ();
  713.               gen ("lea", tempstrname, "a0");
  714.               gen ("jsr", "_stringstr", "  ");
  715.               gen ("move.l", "d0", "-(sp)");    /* push string result */
  716.               enter_XREF ("_stringstr");
  717.               sftype = stringtype;
  718.             }
  719.           else
  720.             {
  721.               _error (16);
  722.               sftype = undefined;
  723.             }
  724.         }
  725.           else
  726.         {
  727.           _error (4);
  728.           sftype = undefined;
  729.         }
  730.           break;
  731.  
  732.           /* MID$ -> MID$(X$,n[,m]) */
  733.         case midstrsym:
  734.           if (sftype == stringtype)
  735.         {
  736.           if (sym == comma)
  737.             {
  738.               insymbol ();    /* start position */
  739.               make_sure_short (expr ());
  740.  
  741.               if (sym == comma)
  742.             {
  743.               insymbol ();    /* character count */
  744.               make_sure_short (expr ());
  745.               commaset = TRUE;
  746.             }
  747.  
  748.               if (commaset)
  749.             gen ("move.w", "(sp)+", "d1");    /* char count */
  750.               else
  751.             /* take the full length of the string */
  752.             gen ("move.w", "#-1", "d1");
  753.  
  754.               gen ("move.w", "(sp)+", "d0");    /* start posn */
  755.               gen ("move.l", "(sp)+", "a0");    /* string */
  756.               make_temp_string ();
  757.               gen ("lea", tempstrname, "a1");
  758.               gen ("jsr", "_midstr", "  ");
  759.               gen ("move.l", "a0", "-(sp)");    /* addr of mid$ */
  760.               enter_XREF ("_midstr");
  761.               sftype = stringtype;
  762.             }
  763.           else
  764.             {
  765.               _error (16);
  766.               sftype = undefined;
  767.             }
  768.         }
  769.           else
  770.         {
  771.           _error (4);
  772.           sftype = undefined;
  773.         }
  774.           break;
  775.  
  776.           /* PTAB */
  777.         case ptabsym:
  778.           if (sftype != stringtype)
  779.         {
  780.           make_sure_short (sftype);
  781.           gen ("move.w", "(sp)+", "d0");    /* x coordinate */
  782.           gen ("jsr", "_ptab", "  ");
  783.           gen ("move.l", "a0", "-(sp)");    /* NULL ptab string */
  784.           enter_XREF ("_ptab");
  785.           enter_XREF ("_GfxBase");
  786.           sftype = stringtype;
  787.         }
  788.           else
  789.         sftype = undefined;
  790.           break;
  791.  
  792.           /* TAB */
  793.         case tabsym:
  794.           if (sftype != stringtype)
  795.         {
  796.           make_sure_short (sftype);
  797.           gen ("move.w", "(sp)+", "d0");    /* # of columns */
  798.           gen ("jsr", "_horiz_tab", "  ");
  799.           gen ("move.l", "a0", "-(sp)");    /* addr of tab string */
  800.           enter_XREF ("_horiz_tab");
  801.           enter_XREF ("_DOSBase");
  802.           enter_XREF ("_GfxBase");
  803.           sftype = stringtype;
  804.         }
  805.           else
  806.         sftype = undefined;
  807.           break;
  808.  
  809.           /* TRANSLATE$ */
  810.         case translatestrsym:
  811.           if (sftype == stringtype)
  812.         {
  813.           gen ("movea.l", "(sp)+", "a0");    /* instr */
  814.           make_temp_string ();
  815.           gen ("lea", tempstrname, "a1");    /* outstr */
  816.           gen ("movea.l", "a0", "a2");
  817.           gen ("jsr", "_strlen", "  ");        /* inlen in d0 */
  818.           sprintf (srcbuf, "#%ld", MAXSTRLEN);    /* #MAXSTRLEN */
  819.           gen ("move.l", srcbuf, "d1");        /* outlen = MAXSTRLEN */
  820.           gen ("movea.l", "_TransBase", "a6");
  821.           gen ("jsr", "_LVOTranslate(a6)", "  ");
  822.           gen ("pea", tempstrname, "  ");    /* outstr on stack */
  823.           enter_XREF ("_TransBase");
  824.           enter_XREF ("_LVOTranslate");
  825.           enter_XREF ("_strlen");
  826.           sftype = stringtype;
  827.         }
  828.           else
  829.         {
  830.           _error (4);
  831.           sftype = undefined;
  832.         }
  833.           break;
  834.  
  835.           /* UCASE$ */
  836.         case ucasestrsym:
  837.           if (sftype == stringtype)
  838.         {
  839.           gen ("move.l", "(sp)+", "a1");
  840.           make_temp_string ();
  841.           gen ("lea", tempstrname, "a0");    /* result buffer */
  842.           gen ("jsr", "_ucase", "  ");
  843.           gen ("move.l", "a0", "-(sp)");
  844.           enter_XREF ("_ucase");
  845.           sftype = stringtype;
  846.         }
  847.           else
  848.         {
  849.           _error (4);
  850.           sftype = undefined;
  851.         }
  852.           break;
  853.  
  854.           /* VAL */
  855.         case valsym:
  856.           if (sftype == stringtype)
  857.         {
  858.           gen ("jsr", "_val", "  ");    /* string is on the stack */
  859.           gen ("addq", "#4", "sp");
  860.           gen ("move.l", "d0", "-(sp)");
  861.           enter_XREF ("_val");
  862.           enter_XREF ("_MathBase");    /* _val needs math libs */
  863.           enter_XREF ("_MathTransBase");
  864.           sftype = singletype;
  865.         }
  866.           else
  867.         {
  868.           _error (4);
  869.           sftype = undefined;
  870.         }
  871.           break;
  872.         }
  873.  
  874.       if (sym != rparen)
  875.         {
  876.           _error (9);
  877.           sftype = undefined;
  878.         }
  879.     }
  880.       insymbol ();
  881.     }
  882.   return (sftype);
  883. }
  884.  
  885. /* numeric functions */
  886. int gen_single_func (char *funcname, int nftype)
  887. {
  888.   char func[80];
  889.  
  890.   if (nftype != stringtype)
  891.     {
  892.       if (nftype != singletype)
  893.     gen_Flt (nftype);
  894.       gen ("move.l", "(sp)+", "d0");
  895.       gen ("movea.l", "_MathTransBase", "a6");
  896.       strcpy (func, funcname);
  897.       strcat (func, "(a6)");
  898.       gen ("jsr", func, "  ");
  899.       gen ("move.l", "d0", "-(sp)");
  900.       enter_XREF (funcname);
  901.       enter_XREF ("_MathTransBase");
  902.       enter_XREF ("_MathBase");
  903.       nftype = singletype;
  904.     }
  905.   else
  906.     {
  907.       _error (4);
  908.       nftype = undefined;
  909.     }
  910.   return (nftype);
  911. }
  912.  
  913. BOOL numfunc (void)
  914. {
  915.   switch (sym)
  916.     {
  917.     case abssym:
  918.       return (TRUE);
  919.     case allocsym:
  920.       return (TRUE);
  921.     case atnsym:
  922.       return (TRUE);
  923.     case cintsym:
  924.       return (TRUE);
  925.     case clngsym:
  926.       return (TRUE);
  927.     case cossym:
  928.       return (TRUE);
  929.     case csngsym:
  930.       return (TRUE);
  931.     case eofsym:
  932.       return (TRUE);
  933.     case expsym:
  934.       return (TRUE);
  935.     case fixsym:
  936.       return (TRUE);
  937.     case fresym:
  938.       return (TRUE);
  939.     case gadgetsym:
  940.       return (TRUE);
  941.     case handlesym:
  942.       return (TRUE);
  943.     case iffsym:
  944.       return (TRUE);
  945.     case intsym:
  946.       return (TRUE);
  947.     case locsym:
  948.       return (TRUE);
  949.     case lofsym:
  950.       return (TRUE);
  951.     case logsym:
  952.       return (TRUE);
  953.     case longintsym:
  954.       return (TRUE);
  955.     case menusym:
  956.       return (TRUE);
  957.     case mousesym:
  958.       return (TRUE);
  959.     case msgboxsym:
  960.       return (TRUE);
  961.     case peeksym:
  962.       return (TRUE);
  963.     case peekwsym:
  964.       return (TRUE);
  965.     case peeklsym:
  966.       return (TRUE);
  967.     case pointsym:
  968.       return (TRUE);
  969.     case potxsym:
  970.       return (TRUE);
  971.     case potysym:
  972.       return (TRUE);
  973.     case saysym:
  974.       return (TRUE);
  975.     case screensym:
  976.       return (TRUE);
  977.     case serialsym:
  978.       return (TRUE);
  979.     case sgnsym:
  980.       return (TRUE);
  981.     case shlsym:
  982.       return (TRUE);
  983.     case shrsym:
  984.       return (TRUE);
  985.     case sinsym:
  986.       return (TRUE);
  987.     case sizeofsym:
  988.       return (TRUE);
  989.     case sqrsym:
  990.       return (TRUE);
  991.     case sticksym:
  992.       return (TRUE);
  993.     case strigsym:
  994.       return (TRUE);
  995.     case tansym:
  996.       return (TRUE);
  997.     case varptrsym:
  998.       return (TRUE);
  999.     case windowsym:
  1000.       return (TRUE);
  1001.     }
  1002.   return (FALSE);
  1003. }
  1004.  
  1005. int numericfunction (void)
  1006. {
  1007.   int func;
  1008.   int nftype = undefined;
  1009.   char labname[80], lablabel[80];
  1010.   char varptr_obj_name[MAXIDSIZE];
  1011.  
  1012.   if (numfunc ())
  1013.     {
  1014.       func = sym;
  1015.       insymbol ();
  1016.       if (sym != lparen)
  1017.     _error (14);
  1018.       else
  1019.     {
  1020.       insymbol ();
  1021.       if ((func != varptrsym) && (func != sizeofsym))
  1022.         nftype = expr ();
  1023.  
  1024.       switch (func)
  1025.         {
  1026.           /* ABS */
  1027.         case abssym:
  1028.           if (nftype == shorttype)
  1029.         {
  1030.           gen ("move.w", "(sp)+", "d0");
  1031.           gen ("jsr", "_absw", "  ");
  1032.           gen ("move.w", "d0", "-(sp)");
  1033.           enter_XREF ("_absw");
  1034.         }
  1035.           else if (nftype == longtype)
  1036.         {
  1037.           gen ("move.l", "(sp)+", "d0");
  1038.           gen ("jsr", "_absl", "  ");
  1039.           gen ("move.l", "d0", "-(sp)");
  1040.           enter_XREF ("_absl");
  1041.         }
  1042.           else if (nftype == singletype)
  1043.         {
  1044.           gen ("move.l", "(sp)+", "d0");
  1045.           gen ("jsr", "_absf", "  ");
  1046.           gen ("move.l", "d0", "-(sp)");
  1047.           enter_XREF ("_absf");
  1048.           enter_XREF ("_MathBase");
  1049.         }
  1050.           else
  1051.         {
  1052.           _error (4);
  1053.           nftype = undefined;
  1054.         }
  1055.           break;
  1056.  
  1057.           /* ALLOC */
  1058.         case allocsym:
  1059.           if (nftype != stringtype)
  1060.         {
  1061.           /* minimum number of bytes to reserve */
  1062.           if (make_integer (nftype) == shorttype)
  1063.             make_long ();
  1064.  
  1065.           if (sym != comma)
  1066.             {
  1067.               gen ("move.l", "#9", "-(sp)");    /* 9 = default type */
  1068.               nftype = longtype;
  1069.             }
  1070.           else
  1071.             {
  1072.               /* memory type specification */
  1073.               insymbol ();
  1074.               nftype = expr ();
  1075.               if (nftype != stringtype)
  1076.             {
  1077.               if (make_integer (nftype) == shorttype)
  1078.                 make_long ();
  1079.               nftype = longtype;
  1080.             }
  1081.               else
  1082.             {
  1083.               _error (4);
  1084.               nftype = undefined;
  1085.             }
  1086.             }
  1087.  
  1088.           /* call ACEalloc() function */
  1089.           gen ("jsr", "_ACEalloc", "  ");
  1090.           gen ("addq", "#8", "sp");
  1091.           gen ("move.l", "d0", "-(sp)");    /* push result */
  1092.           enter_XREF ("_ACEalloc");
  1093.           enter_XREF ("_IntuitionBase");
  1094.         }
  1095.           else
  1096.         {
  1097.           _error (4);
  1098.           nftype = undefined;
  1099.         }
  1100.           break;
  1101.  
  1102.           /* ATN */
  1103.         case atnsym:
  1104.           nftype = gen_single_func ("_LVOSPAtan", nftype);
  1105.           break;
  1106.  
  1107.           /* CINT */
  1108.         case cintsym:
  1109.           nftype = make_integer (nftype);
  1110.           if (nftype == longtype)
  1111.         {
  1112.           make_short ();
  1113.           nftype = shorttype;
  1114.         }
  1115.           if (nftype == notype)
  1116.         {
  1117.           _error (4);
  1118.           nftype = undefined;
  1119.         }
  1120.           break;
  1121.  
  1122.           /* CLNG */
  1123.         case clngsym:
  1124.           if (nftype == singletype)
  1125.         {
  1126.           gen_round (nftype);
  1127.           nftype = longtype;
  1128.         }
  1129.           else if (nftype == shorttype)
  1130.         {
  1131.           gen ("move.w", "(sp)+", "d0");
  1132.           gen ("ext.l", "d0", "  ");
  1133.           gen ("move.l", "d0", "-(sp)");
  1134.           nftype = longtype;
  1135.         }
  1136.           else if (nftype == stringtype)
  1137.         {
  1138.           _error (4);
  1139.           nftype = undefined;
  1140.         }
  1141.           break;
  1142.  
  1143.           /* COS */
  1144.         case cossym:
  1145.           nftype = gen_single_func ("_LVOSPCos", nftype);
  1146.           break;
  1147.  
  1148.           /* CSNG */
  1149.         case csngsym:
  1150.           if ((nftype == shorttype) || (nftype == longtype))
  1151.         {
  1152.           gen_Flt (nftype);
  1153.           nftype = singletype;
  1154.         }
  1155.           else if (nftype == stringtype)
  1156.         {
  1157.           _error (4);
  1158.           nftype = undefined;
  1159.         }
  1160.           break;
  1161.  
  1162.           /* EOF */
  1163.         case eofsym:
  1164.           if (nftype != stringtype)
  1165.         {
  1166.           check_for_event ();
  1167.  
  1168.           if (make_integer (nftype) == shorttype)
  1169.             make_long ();
  1170.           gen ("move.l", "(sp)+", "d0");    /* pop filenumber */
  1171.           gen ("jsr", "_eoftest", "  ");
  1172.           gen ("move.l", "d0", "-(sp)");
  1173.           enter_XREF ("_eoftest");
  1174.           enter_XREF ("_DOSBase");
  1175.           nftype = longtype;
  1176.         }
  1177.           else
  1178.         {
  1179.           _error (4);
  1180.           nftype = undefined;
  1181.         }
  1182.           break;
  1183.  
  1184.           /* EXP */
  1185.         case expsym:
  1186.           nftype = gen_single_func ("_LVOSPExp", nftype);
  1187.           break;
  1188.  
  1189.           /* FIX */
  1190.         case fixsym:
  1191.           if (nftype == singletype)
  1192.         {
  1193.           gen ("move.l", "(sp)+", "d0");
  1194.           gen ("movea.l", "_MathBase", "a6");
  1195.           gen ("jsr", "_LVOSPFix(a6)", "  ");
  1196.           gen ("move.l", "d0", "-(sp)");
  1197.           enter_XREF ("_MathBase");
  1198.           enter_XREF ("_LVOSPFix");
  1199.           nftype = longtype;
  1200.         }
  1201.           else if (nftype == stringtype)
  1202.         {
  1203.           _error (4);
  1204.           nftype = undefined;
  1205.         }
  1206.  
  1207.           /* else if short or long, leave on stack 
  1208.              and let nftype remain the same! */
  1209.           break;
  1210.  
  1211.           /* FRE */
  1212.         case fresym:
  1213.           if (nftype != stringtype)
  1214.         {
  1215.           make_sure_short (nftype);
  1216.           gen ("move.w", "(sp)+", "d0");    /* pop argument */
  1217.           gen ("jsr", "_fre", "  ");
  1218.           gen ("move.l", "d0", "-(sp)");
  1219.           enter_XREF ("_fre");
  1220.           nftype = longtype;
  1221.         }
  1222.           else
  1223.         {
  1224.           _error (4);
  1225.           nftype = undefined;
  1226.         }
  1227.           break;
  1228.  
  1229.           /* GADGET */
  1230.         case gadgetsym:
  1231.           nftype = make_integer (nftype);
  1232.           if (nftype == shorttype)
  1233.         make_long ();
  1234.           gen ("jsr", "_GadFunc", "  ");
  1235.           gen ("addq", "#4", "sp");
  1236.           gen ("move.l", "d0", "-(sp)");
  1237.           enter_XREF ("_GadFunc");
  1238.           nftype = longtype;
  1239.           break;
  1240.  
  1241.           /* HANDLE */
  1242.         case handlesym:
  1243.           if (nftype != stringtype)
  1244.         {
  1245.           check_for_event ();
  1246.  
  1247.           if (make_integer (nftype) == shorttype)
  1248.             make_long ();
  1249.           gen ("move.l", "(sp)+", "d0");
  1250.           gen ("jsr", "_handle", "  ");
  1251.           gen ("move.l", "d0", "-(sp)");
  1252.           enter_XREF ("_handle");
  1253.           nftype = longtype;
  1254.         }
  1255.           else
  1256.         {
  1257.           _error (4);
  1258.           nftype = undefined;
  1259.         }
  1260.           break;
  1261.  
  1262.           /* IFF */
  1263.         case iffsym:
  1264.           if (nftype != stringtype)
  1265.         {
  1266.           check_for_event ();
  1267.  
  1268.           /* channel */
  1269.           if (make_integer (nftype) == shorttype)
  1270.             make_long ();
  1271.  
  1272.           /* function number */
  1273.           if (sym == comma)
  1274.             {
  1275.               insymbol ();
  1276.               if (make_integer (expr ()) == shorttype)
  1277.             make_long ();
  1278.  
  1279.               gen ("jsr", "_iff_func", "  ");
  1280.               gen ("addq", "#8", "sp");
  1281.               gen ("move.l", "d0", "-(sp)");    /* push return value */
  1282.               enter_XREF ("_iff_func");
  1283.  
  1284.               nftype = longtype;
  1285.             }
  1286.           else
  1287.             {
  1288.               _error (16);
  1289.               nftype = undefined;
  1290.             }
  1291.         }
  1292.           else
  1293.         {
  1294.           _error (4);
  1295.           nftype = undefined;
  1296.         }
  1297.           break;
  1298.  
  1299.           /* INT */
  1300.         case intsym:
  1301.           if (nftype == singletype)
  1302.         {
  1303.           gen ("move.l", "(sp)+", "d0");
  1304.           gen ("move.l", "_MathBase", "a6");
  1305.           gen ("jsr", "_LVOSPFloor(a6)", "  ");
  1306.           gen ("jsr", "_LVOSPFix(a6)", "  ");
  1307.           gen ("move.l", "d0", "-(sp)");
  1308.           enter_XREF ("_MathBase");
  1309.           enter_XREF ("_LVOSPFloor");
  1310.           enter_XREF ("_LVOSPFix");
  1311.           nftype = longtype;
  1312.         }
  1313.           else if (nftype == stringtype)
  1314.         {
  1315.           _error (4);
  1316.           nftype = undefined;
  1317.         }
  1318.  
  1319.           /* else if short or long, leave on stack 
  1320.              and let nftype remain the same! */
  1321.           break;
  1322.  
  1323.           /* LOC */
  1324.         case locsym:
  1325.           if (nftype != stringtype)
  1326.         {
  1327.           check_for_event ();
  1328.  
  1329.           if (make_integer (nftype) == shorttype)
  1330.             make_long ();
  1331.           gen ("jsr", "_FilePosition", "  ");
  1332.           gen ("addq", "#4", "sp");
  1333.           gen ("move.l", "d0", "-(sp)");
  1334.           enter_XREF ("_FilePosition");
  1335.           nftype = longtype;
  1336.         }
  1337.           else
  1338.         {
  1339.           _error (4);
  1340.           nftype = undefined;
  1341.         }
  1342.           break;
  1343.  
  1344.           /* LOF */
  1345.         case lofsym:
  1346.           if (nftype != stringtype)
  1347.         {
  1348.           check_for_event ();
  1349.  
  1350.           if (make_integer (nftype) == shorttype)
  1351.             make_long ();
  1352.           gen ("move.l", "(sp)+", "d0");
  1353.           gen ("jsr", "_lof", "  ");
  1354.           gen ("move.l", "d0", "-(sp)");
  1355.           enter_XREF ("_lof");
  1356.           nftype = longtype;
  1357.         }
  1358.           else
  1359.         {
  1360.           _error (4);
  1361.           nftype = undefined;
  1362.         }
  1363.           break;
  1364.  
  1365.           /* LOG */
  1366.         case logsym:
  1367.           nftype = gen_single_func ("_LVOSPLog", nftype);
  1368.           break;
  1369.  
  1370.           /* LONGINT */
  1371.         case longintsym:
  1372.           if (nftype == stringtype)
  1373.         {
  1374.           gen ("jsr", "_long_from_string", "  ");
  1375.           gen ("addq", "#4", "sp");
  1376.           gen ("move.l", "d0", "-(sp)");
  1377.           enter_XREF ("_long_from_string");
  1378.           nftype = longtype;
  1379.         }
  1380.           else
  1381.         {
  1382.           _error (4);
  1383.           nftype = undefined;
  1384.         }
  1385.           break;
  1386.  
  1387.           /* MENU */
  1388.         case menusym:
  1389.           if (nftype != stringtype)
  1390.         {
  1391.           nftype = make_integer (nftype);
  1392.           if (nftype == shorttype)
  1393.             make_long ();
  1394.           gen ("jsr", "_MenuFunc", "  ");
  1395.           gen ("addq", "#4", "sp");
  1396.           gen ("move.l", "d0", "-(sp)");
  1397.           enter_XREF ("_MenuFunc");
  1398.           nftype = longtype;
  1399.         }
  1400.           else
  1401.         {
  1402.           _error (4);
  1403.           nftype = undefined;
  1404.         }
  1405.           break;
  1406.  
  1407.           /* MOUSE */
  1408.         case mousesym:
  1409.           if (nftype != stringtype)
  1410.         {
  1411.           make_sure_short (nftype);
  1412.           gen ("move.w", "(sp)+", "d0");
  1413.           gen ("jsr", "_mouse", "  ");
  1414.           gen ("move.w", "d0", "-(sp)");
  1415.           enter_XREF ("_mouse");
  1416.           enter_XREF ("_IntuitionBase");
  1417.           nftype = shorttype;
  1418.         }
  1419.           else
  1420.         nftype = undefined;
  1421.           break;
  1422.  
  1423.           /* MSGBOX */
  1424.         case msgboxsym:
  1425.           if (nftype == stringtype)        /* message */
  1426.         {
  1427.           if (sym != comma)
  1428.             {
  1429.               _error (16);
  1430.               nftype = undefined;
  1431.             }
  1432.           else
  1433.             {
  1434.               insymbol ();
  1435.               if (expr () == stringtype)    /* response #1 */
  1436.             {
  1437.               if (sym == comma)
  1438.                 {
  1439.                   insymbol ();
  1440.                   if (expr () != stringtype)    /* response #2 */
  1441.                 {
  1442.                   _error (4);
  1443.                   nftype = undefined;
  1444.                   return(0);
  1445.                 }
  1446.                 }
  1447.               else
  1448.                 gen ("move.l", "#0", "-(sp)");    /* #2 = NULL */
  1449.  
  1450.               /* call the function */
  1451.               gen ("jsr", "_sysrequest", "  ");
  1452.               gen ("add.l", "#12", "sp");
  1453.               gen ("move.w", "d0", "-(sp)");
  1454.               enter_XREF ("_sysrequest");
  1455.               enter_XREF ("_IntuitionBase");
  1456.               nftype = shorttype;
  1457.             }
  1458.               else
  1459.             {
  1460.               _error (4);
  1461.               nftype = undefined;
  1462.             }
  1463.             }
  1464.         }
  1465.           else
  1466.         {
  1467.           _error (4);
  1468.           nftype = undefined;
  1469.         }
  1470.           break;
  1471.  
  1472.           /* PEEK */
  1473.         case peeksym:
  1474.           nftype = make_integer (nftype);
  1475.           if ((nftype == longtype) || (nftype == shorttype))
  1476.         {
  1477.           /* get address */
  1478.           if (nftype == shorttype)
  1479.             {
  1480.               gen ("move.w", "(sp)+", "d0");
  1481.               gen ("ext.l", "d0", "  ");
  1482.               gen ("move.l", "d0", "a0");
  1483.             }
  1484.           else
  1485.             gen ("move.l", "(sp)+", "a0");
  1486.           /* get value */
  1487.           gen ("move.b", "(a0)", "d0");
  1488.           gen ("ext.w", "d0", "  ");
  1489.           /* if n<0 n=255-not(n) */
  1490.           gen ("cmp.w", "#0", "d0");
  1491.           make_label (labname, lablabel);
  1492.           gen ("bge.s", labname, "  ");
  1493.           gen ("not.w", "d0", "  ");
  1494.           gen ("move.w", "#255", "d1");
  1495.           gen ("sub.w", "d0", "d1");
  1496.           gen ("move.w", "d1", "d0");
  1497.           gen (lablabel, "  ", "  ");
  1498.           gen ("move.w", "d0", "-(sp)");
  1499.           nftype = shorttype;
  1500.         }
  1501.           else
  1502.         {
  1503.           _error (4);
  1504.           nftype = undefined;
  1505.         }
  1506.           break;
  1507.  
  1508.           /* PEEKW */
  1509.         case peekwsym:
  1510.           nftype = make_integer (nftype);
  1511.           if ((nftype == longtype) || (nftype == shorttype))
  1512.         {
  1513.           /* get address */
  1514.           if (nftype == shorttype)
  1515.             {
  1516.               gen ("move.w", "(sp)+", "d0");
  1517.               gen ("ext.l", "d0", "  ");
  1518.               gen ("move.l", "d0", "a0");
  1519.             }
  1520.           else
  1521.             gen ("move.l", "(sp)+", "a0");
  1522.           /* get value */
  1523.           gen ("move.w", "(a0)", "-(sp)");
  1524.           nftype = shorttype;
  1525.         }
  1526.           break;
  1527.  
  1528.           /* PEEKL */
  1529.         case peeklsym:
  1530.           nftype = make_integer (nftype);
  1531.           if ((nftype == longtype) || (nftype == shorttype))
  1532.         {
  1533.           /* get address */
  1534.           if (nftype == shorttype)
  1535.             {
  1536.               gen ("move.w", "(sp)+", "d0");
  1537.               gen ("ext.l", "d0", "  ");
  1538.               gen ("move.l", "d0", "a0");
  1539.             }
  1540.           else
  1541.             gen ("move.l", "(sp)+", "a0");
  1542.           /* get value */
  1543.           gen ("move.l", "(a0)", "-(sp)");
  1544.           nftype = longtype;
  1545.         }
  1546.           break;
  1547.  
  1548.           /* POINT */
  1549.         case pointsym:
  1550.           if (nftype != stringtype)
  1551.         {
  1552.           make_sure_short (nftype);
  1553.           if (sym != comma)
  1554.             {
  1555.               _error (16);
  1556.               nftype = undefined;
  1557.             }
  1558.           else
  1559.             {
  1560.               insymbol ();
  1561.               make_sure_short (expr ());
  1562.               gen ("move.w", "(sp)+", "d1");    /* y */
  1563.               gen ("move.w", "(sp)+", "d0");    /* x */
  1564.               gen ("move.l", "_RPort", "a1");    /* rastport */
  1565.               gen ("move.l", "_GfxBase", "a6");
  1566.               gen ("jsr", "_LVOReadPixel(a6)", "  ");
  1567.               gen ("move.l", "d0", "-(sp)");
  1568.               enter_XREF ("_LVOReadPixel");
  1569.               enter_XREF ("_GfxBase");
  1570.               enter_XREF ("_RPort");
  1571.               nftype = longtype;
  1572.             }
  1573.         }
  1574.           else
  1575.         {
  1576.           _error (4);
  1577.           nftype = undefined;
  1578.         }
  1579.           break;
  1580.  
  1581.           /* POTX */
  1582.         case potxsym:
  1583.           if (nftype != stringtype)
  1584.         {
  1585.           make_sure_short (nftype);
  1586.           gen ("move.w", "(sp)+", "d0");    /* pop argument */
  1587.           gen ("jsr", "_potx", "  ");
  1588.           gen ("move.w", "d0", "-(sp)");
  1589.           enter_XREF ("_potx");
  1590.           enter_XREF ("_DOSBase");
  1591.           nftype = shorttype;
  1592.         }
  1593.           else
  1594.         {
  1595.           _error (4);
  1596.           nftype = undefined;
  1597.         }
  1598.           break;
  1599.  
  1600.           /* POTY */
  1601.         case potysym:
  1602.           if (nftype != stringtype)
  1603.         {
  1604.           make_sure_short (nftype);
  1605.           gen ("move.w", "(sp)+", "d0");    /* pop argument */
  1606.           gen ("jsr", "_poty", "  ");
  1607.           gen ("move.w", "d0", "-(sp)");
  1608.           enter_XREF ("_poty");
  1609.           enter_XREF ("_DOSBase");
  1610.           nftype = shorttype;
  1611.         }
  1612.           else
  1613.         {
  1614.           _error (4);
  1615.           nftype = undefined;
  1616.         }
  1617.           break;
  1618.  
  1619.           /* SERIAL */
  1620.         case serialsym:
  1621.           if (nftype != stringtype)
  1622.         {
  1623.           check_for_event ();
  1624.  
  1625.           /* channel */
  1626.           if (make_integer (nftype) == shorttype)
  1627.             make_long ();
  1628.  
  1629.           /* function number */
  1630.           if (sym == comma)
  1631.             {
  1632.               insymbol ();
  1633.               if (make_integer (expr ()) == shorttype)
  1634.             make_long ();
  1635.  
  1636.               gen ("jsr", "_serial_func", "  ");
  1637.               gen ("addq", "#8", "sp");
  1638.               gen ("move.l", "d0", "-(sp)");    /* push return value */
  1639.               enter_XREF ("_serial_func");
  1640.  
  1641.               nftype = longtype;
  1642.             }
  1643.           else
  1644.             {
  1645.               _error (16);
  1646.               nftype = undefined;
  1647.             }
  1648.         }
  1649.           else
  1650.         {
  1651.           _error (4);
  1652.           nftype = undefined;
  1653.         }
  1654.           break;
  1655.  
  1656.           /* SGN */
  1657.         case sgnsym:
  1658.           if (nftype == shorttype)
  1659.         {
  1660.           gen ("move.w", "(sp)+", "d0");
  1661.           gen ("jsr", "_sgnw", "  ");
  1662.           gen ("move.l", "d0", "-(sp)");
  1663.           enter_XREF ("_sgnw");
  1664.           nftype = longtype;
  1665.         }
  1666.           else if (nftype == longtype)
  1667.         {
  1668.           gen ("move.l", "(sp)+", "d0");
  1669.           gen ("jsr", "_sgnl", "  ");
  1670.           gen ("move.l", "d0", "-(sp)");
  1671.           enter_XREF ("_sgnl");
  1672.           nftype = longtype;
  1673.         }
  1674.           else if (nftype == singletype)
  1675.         {
  1676.           gen ("move.l", "(sp)+", "d1");
  1677.           gen ("jsr", "_sgnf", "  ");
  1678.           gen ("move.l", "d0", "-(sp)");
  1679.           enter_XREF ("_sgnf");
  1680.           enter_XREF ("_MathBase");
  1681.           nftype = longtype;
  1682.         }
  1683.           else
  1684.         {
  1685.           _error (4);
  1686.           nftype = undefined;
  1687.         }
  1688.           break;
  1689.  
  1690.  
  1691.           /* SHL */
  1692.         case shlsym:
  1693.           if (nftype != stringtype)
  1694.         {
  1695.           /* value to be shifted */
  1696.           if (make_integer (nftype) == shorttype)
  1697.             make_long ();
  1698.  
  1699.           if (sym == comma)
  1700.             {
  1701.               insymbol ();
  1702.               /* shifted by how many bits? */
  1703.               if ((nftype = expr ()) != stringtype)
  1704.             {
  1705.               if (make_integer (nftype) == shorttype)
  1706.                 make_long ();
  1707.  
  1708.               gen ("move.l", "(sp)+", "d0");    /* pop shift factor */
  1709.               gen ("move.l", "(sp)+", "d1");    /* pop value */
  1710.               gen ("asl.l", "d0", "d1");    /* shift d1 by d0 */
  1711.               gen ("move.l", "d1", "-(sp)");    /* push result */
  1712.               nftype = longtype;
  1713.             }
  1714.               else
  1715.             {
  1716.               _error (4);
  1717.               nftype = undefined;
  1718.             }
  1719.             }
  1720.           else
  1721.             {
  1722.               _error (16);
  1723.               nftype = undefined;
  1724.             }
  1725.         }
  1726.           else
  1727.         {
  1728.           _error (4);
  1729.           nftype = undefined;
  1730.         }
  1731.           break;
  1732.  
  1733.           /* SHR */
  1734.         case shrsym:
  1735.           if (nftype != stringtype)
  1736.         {
  1737.           /* value to be shifted */
  1738.           if (make_integer (nftype) == shorttype)
  1739.             make_long ();
  1740.  
  1741.           if (sym == comma)
  1742.             {
  1743.               insymbol ();
  1744.               /* shifted by how many bits? */
  1745.               if ((nftype = expr ()) != stringtype)
  1746.             {
  1747.               if (make_integer (nftype) == shorttype)
  1748.                 make_long ();
  1749.  
  1750.               gen ("move.l", "(sp)+", "d0");    /* pop shift factor */
  1751.               gen ("move.l", "(sp)+", "d1");    /* pop value */
  1752.               gen ("asr.l", "d0", "d1");    /* shift d1 by d0 */
  1753.               gen ("move.l", "d1", "-(sp)");    /* push result */
  1754.               nftype = longtype;
  1755.             }
  1756.               else
  1757.             {
  1758.               _error (4);
  1759.               nftype = undefined;
  1760.             }
  1761.             }
  1762.           else
  1763.             {
  1764.               _error (16);
  1765.               nftype = undefined;
  1766.             }
  1767.         }
  1768.           else
  1769.         {
  1770.           _error (4);
  1771.           nftype = undefined;
  1772.         }
  1773.           break;
  1774.  
  1775.           /* SQR */
  1776.         case sqrsym:
  1777.           nftype = gen_single_func ("_LVOSPSqrt", nftype);
  1778.           break;
  1779.  
  1780.           /* SIN */
  1781.         case sinsym:
  1782.           nftype = gen_single_func ("_LVOSPSin", nftype);
  1783.           break;
  1784.  
  1785.           /* SIZEOF */
  1786.         case sizeofsym:
  1787.           nftype = find_object_size ();
  1788.           break;
  1789.  
  1790.           /* STICK */
  1791.         case sticksym:
  1792.           make_sure_short (nftype);
  1793.           gen ("move.w", "(sp)+", "d0");
  1794.           gen ("jsr", "_stick", "  ");
  1795.           gen ("move.w", "d0", "-(sp)");
  1796.           enter_XREF ("_stick");
  1797.           nftype = shorttype;
  1798.           break;
  1799.           /* STRIG */
  1800.         case strigsym:
  1801.           make_sure_short (nftype);
  1802.           gen ("move.w", "(sp)+", "d0");
  1803.           gen ("jsr", "_strig", "  ");
  1804.           gen ("move.w", "d0", "-(sp)");
  1805.           enter_XREF ("_strig");
  1806.           nftype = shorttype;
  1807.           break;
  1808.  
  1809.           /* TAN */
  1810.         case tansym:
  1811.           nftype = gen_single_func ("_LVOSPTan", nftype);
  1812.           break;
  1813.  
  1814.           /* VARPTR */
  1815.         case varptrsym:
  1816.           if (sym == ident)
  1817.         {
  1818.           strcpy (varptr_obj_name, id);
  1819.           nftype = address_of_object ();
  1820.           /* structure and array code returns next symbol */
  1821.           if (!exist (varptr_obj_name, structure) &&
  1822.               !exist (varptr_obj_name, array))
  1823.             insymbol ();
  1824.         }
  1825.           else
  1826.         {
  1827.           _error (7);
  1828.           nftype = undefined;
  1829.           insymbol ();
  1830.         }
  1831.           break;
  1832.  
  1833.           /* WINDOW */
  1834.         case windowsym:
  1835.           make_sure_short (nftype);
  1836.           gen ("move.w", "(sp)+", "d0");
  1837.           gen ("jsr", "_windowfunc", "  ");
  1838.           gen ("move.l", "d0", "-(sp)");
  1839.           enter_XREF ("_windowfunc");
  1840.           enter_XREF ("_IntuitionBase");
  1841.           nftype = longtype;
  1842.           break;
  1843.  
  1844.           /* SAY */
  1845.         case saysym:
  1846.           if (nftype != stringtype)
  1847.         {
  1848.           nftype = make_integer (nftype);
  1849.           if (nftype == shorttype)
  1850.             make_long ();
  1851.           gen ("jsr", "_sayfunc", "  ");
  1852.           gen ("addq", "#4", "sp");
  1853.           gen ("move.l", "d0", "-(sp)");
  1854.           enter_XREF ("_sayfunc");
  1855.           nftype = longtype;
  1856.         }
  1857.           else
  1858.         {
  1859.           _error (4);
  1860.           nftype = undefined;
  1861.         }
  1862.           break;
  1863.  
  1864.           /* SCREEN */
  1865.         case screensym:
  1866.           if (nftype != stringtype)
  1867.         {
  1868.           nftype = make_integer (nftype);
  1869.           if (nftype == shorttype)
  1870.             make_long ();
  1871.           gen ("jsr", "_screenfunc", "  ");
  1872.           gen ("addq", "#4", "sp");
  1873.           gen ("move.l", "d0", "-(sp)");
  1874.           enter_XREF ("_screenfunc");
  1875.           enter_XREF ("_IntuitionBase");
  1876.           nftype = longtype;
  1877.         }
  1878.           else
  1879.         {
  1880.           _error (4);
  1881.           nftype = undefined;
  1882.         }
  1883.           break;
  1884.         }
  1885.       if (sym != rparen)
  1886.         {
  1887.           _error (9);
  1888.           nftype = undefined;
  1889.         }
  1890.     }
  1891.       insymbol ();
  1892.     }
  1893.   return (nftype);
  1894. }
  1895.  
  1896. int address_of_object (void)
  1897. {
  1898. /* return the address of a variable, array or structure */
  1899.   SYM *varptr_item;
  1900.   char buf[50], numbuf[40];
  1901.   char addrbuf[40];
  1902.   char extobjid[MAXIDSIZE];
  1903.   char subname[MAXIDSIZE + 5];
  1904.   SYM *structype;
  1905.   STRUCM *member;
  1906.   BOOL found;
  1907.  
  1908.   /* 
  1909.      ** Make external variable/function
  1910.      ** name by removing qualifier and 
  1911.      ** adding an underscore prefix 
  1912.      ** if one is not present. 
  1913.    */
  1914.   strcpy (buf, ut_id);
  1915.   remove_qualifier (buf);
  1916.   if (buf[0] != '_')
  1917.     {
  1918.       strcpy (extobjid, "_\0");
  1919.       strcat (extobjid, buf);
  1920.     }
  1921.   else
  1922.     strcpy (extobjid, buf);
  1923.  
  1924.   /*
  1925.      ** Make SUB name.
  1926.    */
  1927.   sprintf (subname, "_SUB_%s", id);
  1928.  
  1929.   /*
  1930.      ** Push address of valid object
  1931.      ** [see ref.doc].
  1932.    */
  1933.   /* external variable or function? */
  1934.   if (exist (extobjid, extvar) ||
  1935.       exist (extobjid, extfunc))
  1936.     {
  1937.       gen ("pea", extobjid, "  ");
  1938.       return (longtype);
  1939.     }
  1940.   else if (exist (subname, subprogram))
  1941.     {
  1942.       gen ("pea", subname, "  ");
  1943.       return (longtype);
  1944.     }
  1945.   else
  1946.     /* ordinary variable? */
  1947.   if (exist (id, variable))
  1948.     {
  1949.       varptr_item = curr_item;
  1950.  
  1951.       /* get the frame start address */
  1952.       strcpy (addrbuf, addreg[lev]);
  1953.  
  1954.       /* get the frame offset */
  1955.       sprintf (numbuf, "#%ld", varptr_item->address);
  1956.  
  1957.       /* calculate the absolute address */
  1958.       gen ("move.l", addrbuf, "d0");
  1959.       gen ("sub.l", numbuf, "d0");
  1960.       if ((varptr_item->type == stringtype)
  1961.       || ((varptr_item->shared) && (lev == ONE)))
  1962.     {
  1963.       /* location in frame contains address */
  1964.       gen ("move.l", "d0", "a0");
  1965.       gen ("move.l", "(a0)", "-(sp)");
  1966.     }
  1967.       else
  1968.     /* absolute address in frame of variable */
  1969.     gen ("move.l", "d0", "-(sp)");
  1970.       return (longtype);
  1971.     }
  1972.   else if ((exist (id, array)) || (exist (id, structure)))
  1973.     {
  1974.       varptr_item = curr_item;
  1975.  
  1976.       /* get the frame start address */
  1977.       strcpy (addrbuf, addreg[lev]);
  1978.  
  1979.       /* get the frame offset */
  1980.       sprintf (numbuf, "#%ld", varptr_item->address);
  1981.  
  1982.       /* calculate the absolute address */
  1983.       gen ("move.l", addrbuf, "d0");
  1984.       gen ("sub.l", numbuf, "d0");
  1985.  
  1986.       /* location in frame contains array/struct address 
  1987.          (except for shared structure (see below) */
  1988.       gen ("movea.l", "d0", "a0");
  1989.  
  1990.       /* address of a structure member? */
  1991.       if (exist (id, structure))
  1992.     {
  1993.       /* shared struct? -> get struct variable address */
  1994.       if (varptr_item->shared && lev == ONE)
  1995.         gen ("movea.l", "(a0)", "a0");
  1996.  
  1997.       insymbol ();
  1998.       if (sym == memberpointer)
  1999.         {
  2000.           insymbol ();
  2001.           if (sym != ident)
  2002.         _error (7);
  2003.           {
  2004.         structype = varptr_item->other;
  2005.         member = structype->structmem->next;
  2006.         found = FALSE;
  2007.         while ((member != NULL) && (!found))
  2008.           {
  2009.             if (strcmp (member->name, id) == 0)
  2010.               found = TRUE;
  2011.             else
  2012.               member = member->next;
  2013.           }
  2014.         if (!found)
  2015.           _error (67);    /* not a valid member */
  2016.         else
  2017.           {
  2018.             /* push address of struct member */
  2019.             sprintf (numbuf, "#%ld", member->offset);
  2020.             gen ("movea.l", "(a0)", "a0");
  2021.             gen ("adda.l", numbuf, "a0");
  2022.             gen ("move.l", "a0", "-(sp)");
  2023.             /* store type for SWAP command */
  2024.             struct_member_type = member->type;
  2025.           }
  2026.           }
  2027.           insymbol ();
  2028.         }
  2029.       else
  2030.         {
  2031.           /* address of struct variable in stack frame */
  2032.           gen ("move.l", "a0", "-(sp)");
  2033.           /* store type for SWAP command */
  2034.           struct_member_type = longtype;
  2035.         }
  2036.     }
  2037.       else
  2038.     /* array or array element address? */
  2039.     {
  2040.       /* push array address */
  2041.       gen ("move.l", "(a0)", "-(sp)");
  2042.  
  2043.       insymbol ();
  2044.  
  2045.       if (sym == lparen)
  2046.         {
  2047.           /* calculate array element address */
  2048.           have_lparen = TRUE;
  2049.           push_indices (varptr_item);
  2050.           get_abs_ndx (varptr_item);    /* offset -> d7 */
  2051.           gen ("move.l", "(sp)+", "d0");    /* array start */
  2052.           gen ("add.l", "d7", "d0");    /* start+offset=addr */
  2053.           gen ("move.l", "d0", "-(sp)");    /* push address */
  2054.           insymbol ();    /* symbol after rparen */
  2055.         }
  2056.     }
  2057.       return (longtype);
  2058.     }
  2059.   else
  2060.     {
  2061.       _error (43);
  2062.       return (undefined);
  2063.     }
  2064. }
  2065.  
  2066. int find_object_size (void)
  2067. {
  2068. /* push the size (in bytes) 
  2069.    of a data object or type 
  2070.    onto the stack. 
  2071.  */
  2072.   char numbuf[40];
  2073.   int nftype;
  2074.  
  2075.   if (sym == ident)
  2076.     {
  2077.       /* variable */
  2078.       if (exist (id, variable))
  2079.     {
  2080.       if (curr_item->type == shorttype)
  2081.         {
  2082.           gen ("move.l", "#2", "-(sp)");
  2083.           nftype = longtype;
  2084.         }
  2085.       else if (curr_item->type == longtype)
  2086.         {
  2087.           gen ("move.l", "#4", "-(sp)");
  2088.           nftype = longtype;
  2089.         }
  2090.       else if (curr_item->type == singletype)
  2091.         {
  2092.           gen ("move.l", "#4", "-(sp)");
  2093.           nftype = longtype;
  2094.         }
  2095.       else if (curr_item->type == stringtype)
  2096.         {
  2097.           sprintf (numbuf, "#%ld", curr_item->size);
  2098.           gen ("move.l", numbuf, "-(sp)");
  2099.           nftype = longtype;
  2100.         }
  2101.     }
  2102.       else
  2103.     /* array variable or structure definition? */
  2104.       if (exist (id, array) || exist (id, structdef))
  2105.     {
  2106.       sprintf (numbuf, "#%ld", curr_item->size);
  2107.       gen ("move.l", numbuf, "-(sp)");
  2108.       nftype = longtype;
  2109.     }
  2110.       else
  2111.     /* structure variable? */
  2112.       if (exist (id, structure))
  2113.     {
  2114.       sprintf (numbuf, "#%ld", curr_item->other->size);
  2115.       gen ("move.l", numbuf, "-(sp)");
  2116.       nftype = longtype;
  2117.     }
  2118.       else
  2119.     {
  2120.       _error (43);        /* undeclared array or variable */
  2121.       nftype = undefined;
  2122.     }
  2123.     }
  2124.   else
  2125.     /* type identifier? */
  2126.   if (sym == bytesym)
  2127.     {
  2128.       gen ("move.l", "#1", "-(sp)");
  2129.       nftype = longtype;
  2130.     }
  2131.   else if (sym == shortintsym)
  2132.     {
  2133.       gen ("move.l", "#2", "-(sp)");
  2134.       nftype = longtype;
  2135.     }
  2136.   else if (sym == longintsym || sym == addresssym)
  2137.     {
  2138.       gen ("move.l", "#4", "-(sp)");
  2139.       nftype = longtype;
  2140.     }
  2141.   else if (sym == singlesym)
  2142.     {
  2143.       gen ("move.l", "#4", "-(sp)");
  2144.       nftype = longtype;
  2145.     }
  2146.   else if (sym == stringsym)
  2147.     {
  2148.       sprintf (numbuf, "#%ld", MAXSTRLEN);
  2149.       gen ("move.l", numbuf, "-(sp)");
  2150.       nftype = longtype;
  2151.     }
  2152.   else
  2153.     {
  2154.       /* expected an identifier or type */
  2155.       _error (60);
  2156.       nftype = undefined;
  2157.     }
  2158.  
  2159.   insymbol ();
  2160.   return (nftype);
  2161. }
  2162.