home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / PPCbwb111 / source / bwb_prn.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-06-24  |  39.5 KB  |  1,724 lines
  1. /***************************************************************
  2.  
  3.         bwb_prn.c       Print Commands
  4.                         for Bywater BASIC Interpreter
  5.  
  6.                         Copyright (c) 1992, Ted A. Campbell
  7.  
  8.                         Bywater Software
  9.                         P. O. Box 4023
  10.                         Duke Station
  11.                         Durham, NC  27706
  12.  
  13.                         email: tcamp@acpub.duke.edu
  14.  
  15.         Copyright and Permissions Information:
  16.  
  17.         All U.S. and international copyrights are claimed by the
  18.         author. The author grants permission to use this code
  19.         and software based on it under the following conditions:
  20.         (a) in general, the code and software based upon it may be
  21.         used by individuals and by non-profit organizations; (b) it
  22.         may also be utilized by governmental agencies in any country,
  23.         with the exception of military agencies; (c) the code and/or
  24.         software based upon it may not be sold for a profit without
  25.         an explicit and specific permission from the author, except
  26.         that a minimal fee may be charged for media on which it is
  27.         copied, and for copying and handling; (d) the code must be
  28.         distributed in the form in which it has been released by the
  29.         author; and (e) the code and software based upon it may not
  30.         be used for illegal activities.
  31.  
  32. ***************************************************************/
  33.  
  34. #include <stdio.h>
  35. #include <stdlib.h>
  36. #include <ctype.h>
  37. #include <string.h>
  38. #include <math.h>
  39.  
  40. #include "bwbasic.h"
  41. #include "bwb_mes.h"
  42.  
  43. /* Prototypes for functions visible only to this file */
  44.  
  45. static int prn_cr( char *buffer, FILE *f );
  46. static int prn_col = 1;
  47. static int prn_width = 80;    /* default width for stdout */
  48. static struct bwb_variable * bwb_esetovar( struct exp_ese *e );
  49.  
  50. struct prn_fmt
  51.    {
  52.    int type;            /* STRING, DOUBLE, SINGLE, or INTEGER */
  53.    int exponential;        /* TRUE = use exponential notation */
  54.    int right_justified;        /* TRUE = right justified else left justified */
  55.    int width;            /* width of main section */
  56.    int precision;        /* width after decimal point */
  57.    int commas;            /* use commas every three steps */
  58.    int sign;            /* prefix sign to number */
  59.    int money;            /* prefix money sign to number */
  60.    int fill;            /* ASCII value for fill character, normally ' ' */
  61.    int minus;            /* postfix minus sign to number */
  62.    };
  63.  
  64. static struct prn_fmt *get_prnfmt( char *buffer, int *position, FILE *f );
  65. static int bwb_xerror( char *message );
  66. static int xxputc( FILE *f, char c );
  67.  
  68. /***************************************************************
  69.  
  70.         FUNCTION:       bwb_print()
  71.  
  72.         DESCRIPTION:    This function implements the BASIC PRINT
  73.                         command.
  74.  
  75. ***************************************************************/
  76.  
  77. struct bwb_line *
  78. bwb_print( struct bwb_line *l )
  79.    {
  80.    FILE *fp;
  81.    static int pos;
  82.    int req_devnumber;
  83.    struct exp_ese *v;
  84.    static char *s_buffer;              /* small, temporary buffer */
  85.    static int init = FALSE;
  86.  
  87. #if INTENSIVE_DEBUG
  88.    sprintf( bwb_ebuf, "in bwb_print(): enter function" );
  89.    bwb_debug( bwb_ebuf );
  90. #endif
  91.  
  92.    /* initialize buffers if necessary */
  93.  
  94.    if ( init == FALSE )
  95.       {
  96.       init = TRUE;
  97.       if ( ( s_buffer = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL )
  98.          {
  99.          bwb_error( err_getmem );
  100.          }
  101.       }
  102.  
  103.    /* advance beyond whitespace and check for the '#' sign */
  104.    
  105.    adv_ws( l->buffer, &( l->position ) );
  106.    
  107.    if ( l->buffer[ l->position ] == '#' )
  108.       {
  109.       ++( l->position );
  110.       adv_element( l->buffer, &( l->position ), s_buffer );
  111.       pos = 0;
  112.       v = bwb_exp( s_buffer, FALSE, &pos );
  113.       adv_ws( l->buffer, &( l->position ) );
  114.       if ( l->buffer[ l->position ] == ',' )
  115.          {
  116.          ++( l->position );
  117.          }
  118.       else
  119.          {
  120. #if PROG_ERRORS
  121.          bwb_error( "in bwb_print(): no comma after #n" );
  122. #else
  123.          bwb_error( err_syntax );
  124. #endif
  125.          l->next->position = 0;
  126.          return l->next;
  127.          }
  128.  
  129.       req_devnumber = exp_getival( v );
  130.  
  131.       /* check the requested device number */
  132.       
  133.       if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  134.          {
  135. #if PROG_ERRORS
  136.          bwb_error( "in bwb_input(): Requested device number is out of range." );
  137. #else
  138.          bwb_error( err_devnum );
  139. #endif
  140.          l->next->position = 0;
  141.          return l->next;
  142.          }
  143.  
  144.       if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
  145.          ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ))
  146.          {
  147. #if PROG_ERRORS
  148.          bwb_error( "in bwb_input(): Requested device number is not open." );
  149. #else
  150.          bwb_error( err_devnum );
  151. #endif
  152.  
  153.          l->next->position = 0;
  154.          return l->next;
  155.          }
  156.  
  157.       if ( dev_table[ req_devnumber ].mode != DEVMODE_OUTPUT )
  158.          {
  159. #if PROG_ERRORS
  160.          bwb_error( "in bwb_print(): Requested device is not open for OUTPUT." );
  161. #else
  162.          bwb_error( err_devnum );
  163. #endif
  164.  
  165.          l->next->position = 0;
  166.          return l->next;
  167.          }
  168.  
  169. #if INTENSIVE_DEBUG
  170.       sprintf( bwb_ebuf, "in bwb_print(): device number is <%d>",
  171.          req_devnumber );
  172.       bwb_debug( bwb_ebuf );
  173. #endif
  174.  
  175.       /* look up the requested device in the device table */
  176.  
  177.       fp = dev_table[ req_devnumber ].cfp;
  178.  
  179.       }
  180.  
  181.    else
  182.       {
  183.       fp = stdout;
  184.       }
  185.  
  186.    bwb_xprint( l, fp );
  187.  
  188.    l->next->position = 0;
  189.    return l->next;
  190.    }
  191.  
  192. /***************************************************************
  193.  
  194.         FUNCTION:       bwb_xprint()
  195.  
  196.         DESCRIPTION:
  197.  
  198. ***************************************************************/
  199.  
  200. int
  201. bwb_xprint( struct bwb_line *l, FILE *f )
  202.    {
  203.    struct exp_ese *e;
  204.    int loop;
  205.    static int p;
  206.    static int fs_pos;
  207.    struct prn_fmt *format;
  208.    static char *format_string;
  209.    static char *output_string;
  210.    static char *element;
  211.    static char *prnbuf;
  212.    static int init = FALSE;
  213. #if INTENSIVE_DEBUG || TEST_BSTRING
  214.    bstring *b;
  215. #endif
  216.  
  217.    /* initialize buffers if necessary */
  218.  
  219.    if ( init == FALSE )
  220.       {
  221.       init = TRUE;
  222.       if ( ( format_string = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL )
  223.          {
  224.          bwb_error( err_getmem );
  225.          }
  226.       if ( ( output_string = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL )
  227.          {
  228.          bwb_error( err_getmem );
  229.          }      
  230.       if ( ( element = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL )
  231.          {
  232.          bwb_error( err_getmem );
  233.          }      
  234.       if ( ( prnbuf = calloc( MAXSTRINGSIZE + 1, sizeof(char) ) ) == NULL )
  235.          {
  236.          bwb_error( err_getmem );
  237.          }      
  238.       }
  239.  
  240.    /* Detect USING Here */
  241.  
  242.    fs_pos = -1;
  243.  
  244.    /* get "USING" in format_string */
  245.  
  246.    p = l->position;
  247.    adv_element( l->buffer, &p, format_string );
  248.    bwb_strtoupper( format_string );
  249.  
  250.    /* check to be sure */
  251.  
  252.    if ( strcmp( format_string, "USING" ) == 0 )
  253.       {
  254.       l->position = p;
  255.       adv_ws( l->buffer, &( l->position ) );
  256.  
  257.       /* now get the format string in format_string */
  258.  
  259.       e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  260.       if ( e->type == STRING )
  261.          {
  262.  
  263.          /* copy the format string to buffer */
  264.  
  265.          str_btoc( format_string, exp_getsval( e ) );
  266.  
  267.          /* look for ';' after format string */
  268.  
  269.          fs_pos = 0;
  270.          adv_ws( l->buffer, &( l->position ) );
  271.          if ( l->buffer[ l->position ] == ';' )
  272.             {
  273.             ++l->position;
  274.             adv_ws( l->buffer, &( l->position ) );
  275.             }
  276.          else
  277.             {
  278. #if PROG_ERRORS
  279.             bwb_error( "Failed to find \";\" after format string in PRINT USING" );
  280. #else
  281.             bwb_error( err_syntax );
  282. #endif
  283.             return FALSE;
  284.             }
  285.  
  286. #if INTENSIVE_DEBUG
  287.          sprintf( bwb_ebuf, "in bwb_xprint(): Found USING, format string <%s>",
  288.             format_string );
  289.          bwb_debug( bwb_ebuf );
  290. #endif
  291.  
  292.          }
  293.  
  294.       else
  295.          {
  296. #if PROG_ERRORS
  297.          bwb_error( "Failed to find format string after PRINT USING" );
  298. #else
  299.          bwb_error( err_syntax );
  300. #endif
  301.          return FALSE;
  302.          }
  303.       }
  304.  
  305.    /* if no arguments, simply print CR and return */
  306.  
  307.    adv_ws( l->buffer, &( l->position ) );
  308.    switch( l->buffer[ l->position ] )
  309.       {
  310.       case '\0':
  311.       case '\n':
  312.       case '\r':
  313.       case ':':
  314.          xprintf( f, "\n" );
  315.          return TRUE;
  316.       default:
  317.          break;
  318.       }
  319.  
  320.    /* LOOP THROUGH PRINT ELEMENTS */
  321.  
  322.    loop = TRUE;
  323.    while( loop == TRUE )
  324.       {
  325.  
  326.       /* resolve the string */
  327.  
  328.       e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  329.  
  330. #if INTENSIVE_DEBUG
  331.       sprintf( bwb_ebuf, "in bwb_xprint(): op <%d> type <%c>",
  332.          e->operation, e->type );
  333.       bwb_debug( bwb_ebuf );
  334. #endif
  335.  
  336.       /* an OP_NULL probably indicates a terminating ';', but this
  337.          will be detected later, so we can ignore it for now */
  338.  
  339.       if ( e->operation != OP_NULL )
  340.          {
  341. #if TEST_BSTRING
  342.          b = exp_getsval( e );
  343.          sprintf( bwb_ebuf, "in bwb_xprint(): bstring name is <%s>",
  344.             b->name );
  345.          bwb_debug( bwb_ebuf );
  346. #endif
  347.          str_btoc( element, exp_getsval( e ) );
  348.          }
  349.       else
  350.          {
  351.          element[ 0 ] = '\0';
  352.          }
  353.  
  354. #if INTENSIVE_DEBUG
  355.       sprintf( bwb_ebuf, "in bwb_xprint(): element <%s>",
  356.          element );
  357.       bwb_debug( bwb_ebuf );
  358. #endif
  359.  
  360.       /* print with format if there is one */
  361.  
  362.       if (( fs_pos > -1 ) && ( strlen( element ) > 0 ))
  363.          {
  364.          format = get_prnfmt( format_string, &fs_pos, f );
  365.  
  366. #if INTENSIVE_DEBUG
  367.          sprintf( bwb_ebuf, "in bwb_xprint(): format type <%c> width <%d>",
  368.             format->type, format->width );
  369.          bwb_debug( bwb_ebuf );
  370. #endif
  371.  
  372.          switch( format->type )
  373.             {
  374.             case STRING:
  375.                if ( e->type != STRING )
  376.                   {
  377. #if PROG_ERRORS
  378.                   bwb_error( "Type mismatch in PRINT USING" );
  379. #else
  380.                   bwb_error( err_mismatch );
  381. #endif
  382.                   }
  383.                sprintf( output_string, "%.*s", format->width,
  384.                   element );
  385.  
  386. #if INTENSIVE_DEBUG
  387.                sprintf( bwb_ebuf, "in bwb_xprint(): output string <%s>",
  388.                   output_string );
  389.                bwb_debug( bwb_ebuf );
  390. #endif
  391.  
  392.                xprintf( f, output_string );
  393.                break;
  394.             case INTEGER:
  395.                if ( e->type == STRING )
  396.                   {
  397. #if PROG_ERRORS
  398.                   bwb_error( "Type mismatch in PRINT USING" );
  399. #else
  400.                   bwb_error( err_mismatch );
  401. #endif
  402.                   }
  403.                sprintf( output_string, "%.*d", format->width,
  404.                   exp_getival( e ) );
  405.                xprintf( f, output_string );
  406.                break;
  407.             case SINGLE:
  408.             case DOUBLE:
  409.                if ( e->type == STRING )
  410.                   {
  411. #if PROG_ERRORS
  412.                   bwb_error( "Type mismatch in PRINT USING" );
  413. #else
  414.                   bwb_error( err_mismatch );
  415. #endif
  416.                   }
  417.                if ( format->exponential == TRUE )
  418.                   {
  419.                   sprintf( output_string, "%.le", 
  420.                      e->dval );
  421.                   xprintf( f, output_string );
  422.                   }
  423.                else
  424.                   {
  425.                   sprintf( output_string, "%*.*lf", 
  426.                      format->width + 1 + format->precision,
  427.                      format->precision, e->dval );
  428.                   xprintf( f, output_string );
  429.                   }
  430.                break;
  431.             default:
  432. #if PROG_ERRORS
  433.                sprintf( bwb_ebuf, "in bwb_xprint(): get_prnfmt() returns unknown type <%c>",
  434.                   format->type );
  435.                bwb_error( bwb_ebuf );
  436. #else
  437.                bwb_error( err_mismatch );
  438. #endif
  439.                break;
  440.             }
  441.          }
  442.  
  443.       /* not a format string: use defaults */
  444.  
  445.       else if ( strlen( element ) > 0 )
  446.          {
  447.  
  448.          switch( e->type )
  449.             {
  450.             case STRING:
  451.                xprintf( f, element );
  452.                break;
  453.             case INTEGER:
  454.                sprintf( prnbuf, " %d", exp_getival( e ) );
  455.                xprintf( f, prnbuf );
  456.                break;
  457.             case DOUBLE:
  458.                sprintf( prnbuf, " %.*f", prn_precision( bwb_esetovar( e )), 
  459.                   exp_getdval( e ) );
  460.                xprintf( f, prnbuf );
  461.                break;
  462.             default:
  463.                sprintf( prnbuf, " %.*f", prn_precision( bwb_esetovar( e )), 
  464.                   exp_getfval( e ) );
  465.                xprintf( f, prnbuf );
  466.                break;
  467.             }
  468.          }
  469.  
  470.       /* check the position to see if the loop should continue */
  471.  
  472.       adv_ws( l->buffer, &( l->position ) );
  473.       switch( l->buffer[ l->position ] )
  474.          {
  475.          case ':':        /* end of line segment */
  476.         loop = FALSE;
  477. /*        ++( l->position ); */
  478.         break;
  479.          case '\0':        /* end of buffer */
  480.          case '\n':
  481.          case '\r':
  482.         loop = FALSE;
  483.             break;
  484.          case ',':        /* tab over */
  485.             xputc( f, '\t' );
  486.             ++l->position;
  487.             adv_ws( l->buffer, &( l->position ) );
  488.             break;
  489.          case ';':        /* concatenate strings */
  490.             ++l->position;
  491.             adv_ws( l->buffer, &( l->position ) );
  492.             break;
  493.          }
  494.  
  495.       }                /* end of loop through print elements */
  496.  
  497.    /* call prn_cr() to print a CR if it is not overridden by a
  498.       concluding ';' mark */
  499.  
  500.    prn_cr( l->buffer, f ); 
  501.  
  502.    return TRUE;
  503.  
  504.    }                            /* end of function bwb_xprint() */
  505.  
  506. /***************************************************************
  507.  
  508.         FUNCTION:       get_prnfmt()
  509.  
  510.         DESCRIPTION:
  511.  
  512. ***************************************************************/
  513.  
  514. struct prn_fmt *
  515. get_prnfmt( char *buffer, int *position, FILE *f )
  516.    {
  517.    static struct prn_fmt retstruct;
  518.    register int c;
  519.    int loop;
  520.  
  521.    /* set some defaults */
  522.  
  523.    retstruct.type = FALSE;
  524.    retstruct.exponential = FALSE;
  525.    retstruct.right_justified = FALSE;
  526.    retstruct.commas = FALSE;
  527.    retstruct.sign = FALSE;
  528.    retstruct.money = FALSE;
  529.    retstruct.fill = ' ';
  530.    retstruct.minus = FALSE;
  531.  
  532.    /* check for negative position */
  533.  
  534.    if ( *position < 0 )
  535.       {
  536.       return &retstruct;
  537.       }
  538.  
  539.    /* advance past whitespace */
  540.  
  541.    adv_ws( buffer, position );
  542.  
  543.    /* check first character: a lost can be decided right here */
  544.  
  545.    loop = TRUE;
  546.    while( loop == TRUE )
  547.       {
  548.  
  549. #if INTENSIVE_DEBUG
  550.       sprintf( bwb_ebuf, "in get_prnfmt(): loop, buffer <%s>",
  551.          &( buffer[ *position ] ) );
  552.       bwb_debug( bwb_ebuf );
  553. #endif
  554.  
  555.       switch( buffer[ *position ] )
  556.          {
  557.          case ' ':        /* end of this format segment */
  558.             loop = FALSE;
  559.             break;
  560.          case '\0':        /* end of format string */
  561.          case '\n':
  562.          case '\r':
  563.             *position = -1;
  564.             return &retstruct;
  565.          case '_':        /* print next character as literal */
  566.             ++( *position );
  567.             xputc( f, buffer[ *position ] );
  568.             ++( *position );
  569.             break;
  570.          case '!':
  571.             retstruct.type = STRING;
  572.             retstruct.width = 1;
  573.             return &retstruct;
  574.          case '\\':
  575. #if INTENSIVE_DEBUG
  576.             sprintf( bwb_ebuf, "in get_prnfmt(): found \\" );
  577.             bwb_debug( bwb_ebuf );
  578. #endif
  579.             retstruct.type = STRING;
  580.             ++( *position );
  581.             for ( retstruct.width = 0; buffer[ *position ] == ' '; ++( *position ) )
  582.                {
  583.                ++retstruct.width;
  584.                }
  585.             if ( buffer[ *position ] == '\\' )
  586.                {
  587.                ++( *position );
  588.                }
  589.             return &retstruct;
  590.          case '$':
  591.             ++( *position );
  592.             retstruct.money = TRUE;
  593.             if ( buffer[ *position ] == '$' )
  594.                {
  595.                ++( *position );
  596.                }
  597.             break;
  598.          case '*':
  599.             ++( *position );
  600.             retstruct.fill = '*';
  601.             if ( buffer[ *position ] == '*' )
  602.                {
  603.                ++( *position );
  604.                }
  605.             break;
  606.          case '+':
  607.             ++( *position );
  608.             retstruct.sign = TRUE;
  609.             break;
  610.          case '#':
  611.             retstruct.type = INTEGER;        /* for now */
  612.             ++( *position );
  613.             for ( retstruct.width = 1; buffer[ *position ] == '#'; ++( *position ) )
  614.                {
  615.                ++retstruct.width;
  616.                }
  617.             if ( buffer[ *position ] == ',' )
  618.                {
  619.                retstruct.commas = TRUE;
  620.                }
  621.             if ( buffer[ *position ] == '.' )
  622.                {
  623.                retstruct.type = DOUBLE;
  624.                ++( *position );
  625.                for ( retstruct.precision = 0; buffer[ *position ] == '#'; ++( *position ) )
  626.                   {
  627.                   ++retstruct.precision;
  628.                   }
  629.                }
  630.             if ( buffer[ *position ] == '-' )
  631.                {
  632.                retstruct.minus = TRUE;
  633.                ++( *position );
  634.                }
  635.             return &retstruct;
  636.          case '^':
  637.             retstruct.type = DOUBLE;
  638.             retstruct.exponential = TRUE;
  639.             for ( retstruct.width = 1; buffer[ *position ] == '^'; ++( *position ) )
  640.                {
  641.                ++retstruct.width;
  642.                }
  643.             return &retstruct;
  644.          
  645.          }
  646.       }                    /* end of loop */
  647.       
  648.    return &retstruct;
  649.    }
  650.    
  651. /***************************************************************
  652.  
  653.         FUNCTION:       prn_cr()
  654.  
  655.         DESCRIPTION:
  656.  
  657. ***************************************************************/
  658.  
  659. static int
  660. prn_cr( char *buffer, FILE *f )
  661.    {
  662.    register int c;
  663.    int loop;
  664.  
  665.    /* find the end of the buffer */
  666.  
  667.    for ( c = 0; buffer[ c ] != '\0'; ++c )
  668.       {
  669.       }
  670.  
  671. #if INTENSIVE_DEBUG
  672.    sprintf( bwb_ebuf, "in prn_cr(): initial c is <%d>", c );
  673.    bwb_debug( bwb_ebuf );
  674. #endif
  675.  
  676.    /* back up through any whitespace */
  677.  
  678.    loop = TRUE;
  679.    while ( loop == TRUE )
  680.       {
  681.       switch( buffer[ c ] )
  682.          {
  683.          case ' ':                              /* if whitespace */
  684.          case '\t':
  685.          case 0:
  686.  
  687. #if INTENSIVE_DEBUG
  688.             sprintf( bwb_ebuf, "in prn_cr(): backup: c is <%d>, char <%c>[0x%x]",
  689.                c, buffer[ c ], buffer[ c ] );
  690.             bwb_debug( bwb_ebuf );
  691. #endif
  692.  
  693.             --c;                                /* back up */
  694.             if ( c < 0 )                        /* check position */
  695.                {
  696.                loop = FALSE;
  697.                }
  698.             break;
  699.  
  700.          default:                               /* else break out */
  701. #if INTENSIVE_DEBUG
  702.             sprintf( bwb_ebuf, "in prn_cr(): breakout: c is <%d>, char <%c>[0x%x]",
  703.                c, buffer[ c ], buffer[ c ] );
  704.             bwb_debug( bwb_ebuf );
  705. #endif
  706.             loop = FALSE;
  707.             break;
  708.          }
  709.       }
  710.  
  711.    if ( buffer[ c ] == ';' )
  712.       {
  713.  
  714. #if INTENSIVE_DEBUG
  715.       sprintf( bwb_ebuf, "in prn_cr(): concluding <;> detected." );
  716.       bwb_debug( bwb_ebuf );
  717. #endif
  718.  
  719.       return FALSE;
  720.       }
  721.  
  722.    else
  723.       {
  724.       xprintf( f, "\n" );
  725.       return TRUE;
  726.       }
  727.  
  728.    }
  729.  
  730. /***************************************************************
  731.  
  732.         FUNCTION:       xprintf()
  733.  
  734.         DESCRIPTION:
  735.  
  736. ***************************************************************/
  737.  
  738. int
  739. xprintf( FILE *f, char *buffer )
  740.    {
  741.    char *p;
  742.  
  743.    /* DO NOT try anything so stupid as to run bwb_debug() from 
  744.       here, because it will create an endless loop. And don't
  745.       ask how I know. */
  746.  
  747.    for ( p = buffer; *p != '\0'; ++p )
  748.       {
  749.       xputc( f, *p );
  750.       }
  751.  
  752.    return TRUE;
  753.    }
  754.  
  755. /***************************************************************
  756.  
  757.         FUNCTION:       xputc()
  758.  
  759.         DESCRIPTION:
  760.  
  761. ***************************************************************/
  762.  
  763. int
  764. xputc( FILE *f, char c )
  765.    {
  766.    static int tab_pending = FALSE;
  767.    register int i;
  768.  
  769.    /* check for pending TAB */
  770.  
  771.    if ( tab_pending == TRUE )
  772.       {
  773.       if ( (int) c < ( * prn_getcol( f ) ) )
  774.          {
  775.          xxputc( f, '\n' );
  776.          }
  777.       while( ( * prn_getcol( f )) < (int) c )
  778.          {
  779.          xxputc( f, ' ' );
  780.          }
  781.       tab_pending = FALSE;
  782.       return TRUE;
  783.       }
  784.  
  785.    /* check c for specific output options */
  786.  
  787.    switch( c )
  788.       {
  789.       case PRN_TAB:
  790.          tab_pending = TRUE;
  791.          break;
  792.  
  793.       case '\t':
  794.          while( ( (* prn_getcol( f )) % 14 ) != 0 )
  795.             {
  796.             xxputc( f, ' ' );
  797.             }
  798.          break;
  799.  
  800.       default:
  801.          xxputc( f, c );
  802.          break;
  803.       }
  804.  
  805.    return TRUE;
  806.  
  807.    }
  808.  
  809. /***************************************************************
  810.  
  811.         FUNCTION:       xxputc()
  812.  
  813.         DESCRIPTION:
  814.  
  815. ***************************************************************/
  816.  
  817. int
  818. xxputc( FILE *f, char c )
  819.    {
  820.  
  821.    /* check to see if width has been exceeded */
  822.  
  823.    if ( * prn_getcol( f ) >= prn_getwidth( f ))
  824.       {
  825.       fputc( '\n', f );            /* output LF */
  826.       * prn_getcol( f ) = 1;        /* and reset */
  827.       }
  828.  
  829.    /* adjust the column counter */
  830.  
  831.    if ( c == '\n' )
  832.       {
  833.       * prn_getcol( f ) = 1;
  834.       }
  835.    else
  836.       {
  837.       ++( * prn_getcol( f ));
  838.       }
  839.       
  840.    /* now output the character */
  841.  
  842.    return fputc( c, f );
  843.  
  844.    }
  845.  
  846. /***************************************************************
  847.  
  848.         FUNCTION:       prn_getcol()
  849.  
  850.         DESCRIPTION:
  851.  
  852. ***************************************************************/
  853.  
  854. int *
  855. prn_getcol( FILE *f )
  856.    {
  857.    register int n;
  858.    static int dummy_pos;
  859.  
  860.    if (( f == stdout ) || ( f == stderr ))
  861.       {
  862.       return &prn_col;
  863.       }
  864.  
  865.    for ( n = 0; n < DEF_DEVICES; ++n )
  866.       {
  867.       if ( dev_table[ n ].cfp == f )
  868.          {
  869.          return &( dev_table[ n ].col );
  870.          }
  871.       }
  872.  
  873.    /* search failed */
  874.  
  875. #if PROG_ERRORS
  876.    bwb_error( "in prn_getcol(): failed to find file pointer" );
  877. #else
  878.    bwb_error( err_devnum );
  879. #endif
  880.  
  881.    return &dummy_pos;
  882.  
  883.    }
  884.  
  885. /***************************************************************
  886.  
  887.         FUNCTION:       prn_getwidth()
  888.  
  889.         DESCRIPTION:
  890.  
  891. ***************************************************************/
  892.  
  893. int
  894. prn_getwidth( FILE *f )
  895.    {
  896.    register int n;
  897.  
  898.    if (( f == stdout ) || ( f == stderr ))
  899.       {
  900.       return prn_width;
  901.       }
  902.  
  903.    for ( n = 0; n < DEF_DEVICES; ++n )
  904.       {
  905.       if ( dev_table[ n ].cfp == f )
  906.          {
  907.          return dev_table[ n ].width;
  908.          }
  909.       }
  910.  
  911.    /* search failed */
  912.  
  913. #if PROG_ERRORS
  914.    bwb_error( "in prn_getwidth(): failed to find file pointer" );
  915. #else
  916.    bwb_error( err_devnum );
  917. #endif
  918.  
  919.    return 1;
  920.  
  921.    }
  922.  
  923. /***************************************************************
  924.  
  925.         FUNCTION:       prn_precision()
  926.  
  927.         DESCRIPTION:
  928.  
  929. ***************************************************************/
  930.  
  931. int
  932. prn_precision( struct bwb_variable *v )
  933.    {
  934.    int max_precision = 6;
  935.    double dval, d;
  936.    int r;
  937.  
  938.    /* check for double value */
  939.  
  940.    if ( v->type == DOUBLE )
  941.       {
  942.       max_precision = 12;
  943.       }
  944.  
  945.    /* get the value in dval */
  946.  
  947.    dval = var_getdval( v );
  948.  
  949.    /* cycle through until precision is found */
  950.  
  951.    d = 1.0;
  952.    for ( r = 0; r < max_precision; ++r )
  953.       {
  954.  
  955. #if INTENSIVE_DEBUG
  956.       sprintf( bwb_ebuf, "in prn_precision(): fmod( %f, %f ) = %.12f",
  957.          dval, d, fmod( dval, d ) );
  958.       bwb_debug( bwb_ebuf );
  959. #endif
  960.  
  961.       if ( fmod( dval, d ) < 0.0000001 )
  962.          {
  963.          return r;
  964.          }
  965.       d /= 10;
  966.       }
  967.  
  968.    /* return */
  969.  
  970.    return r;
  971.  
  972.    }
  973.  
  974. /***************************************************************
  975.  
  976.         FUNCTION:       fnc_tab()
  977.  
  978.         DESCRIPTION:    
  979.  
  980. ***************************************************************/
  981.  
  982. struct bwb_variable *
  983. fnc_tab( int argc, struct bwb_variable *argv )
  984.    {
  985.    static struct bwb_variable nvar;
  986.    static int init = FALSE;
  987.    static char t_string[ 4 ];
  988.    static char nvar_name[] = "(tmp)";
  989.    bstring *b;
  990.    
  991.    /* initialize nvar if necessary */
  992.  
  993.    if ( init == FALSE )
  994.       {
  995.       init = TRUE;
  996.       var_make( &nvar, (int) STRING );
  997. /*      nvar.name = nvar_name; */
  998.       }
  999.  
  1000.    /* check for correct number of parameters */
  1001.  
  1002.    if ( argc < 1 )
  1003.       {
  1004. #if PROG_ERRORS
  1005.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function TAB().",
  1006.          argc );
  1007.       bwb_error( bwb_ebuf );
  1008. #else
  1009.       bwb_error( err_syntax );
  1010. #endif
  1011.       break_handler();
  1012.       return NULL;
  1013.       }
  1014.    else if ( argc > 1 )
  1015.       {
  1016. #if PROG_ERRORS
  1017.       sprintf( bwb_ebuf, "Too many parameters (%d) to function TAB().",
  1018.          argc );
  1019.       bwb_error( bwb_ebuf );
  1020. #else
  1021.       bwb_error( err_syntax );
  1022. #endif
  1023.       break_handler();
  1024.       return NULL;
  1025.       }
  1026.  
  1027.    t_string[ 0 ] = PRN_TAB;
  1028.    t_string[ 1 ] = (char) var_getival( &( argv[ 0 ] ));
  1029.    t_string[ 2 ] = '\0';
  1030.  
  1031.    b = var_getsval( &nvar );
  1032.    str_ctob( b, t_string );
  1033.  
  1034.    return &nvar;
  1035.    }
  1036.  
  1037. /***************************************************************
  1038.  
  1039.         FUNCTION:       fnc_spc()
  1040.  
  1041.         DESCRIPTION:    
  1042.  
  1043. ***************************************************************/
  1044.  
  1045. struct bwb_variable *
  1046. fnc_spc( int argc, struct bwb_variable *argv )
  1047.    {
  1048.    return fnc_space( argc, argv );
  1049.    }
  1050.  
  1051. /***************************************************************
  1052.  
  1053.         FUNCTION:       fnc_space()
  1054.  
  1055.         DESCRIPTION:    
  1056.  
  1057. ***************************************************************/
  1058.  
  1059. struct bwb_variable *
  1060. fnc_space( int argc, struct bwb_variable *argv )
  1061.    {
  1062.    static struct bwb_variable nvar;
  1063.    static char *tbuf;
  1064.    static int init = FALSE;
  1065.    int spaces;
  1066.    register int i;
  1067.    bstring *b;
  1068.    
  1069.    /* check for correct number of parameters */
  1070.  
  1071.    if ( argc < 1 )
  1072.       {
  1073. #if PROG_ERRORS
  1074.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function SPACE$().",
  1075.          argc );
  1076.       bwb_error( bwb_ebuf );
  1077. #else
  1078.       bwb_error( err_syntax );
  1079. #endif
  1080.       break_handler();
  1081.       return NULL;
  1082.       }
  1083.    else if ( argc > 1 )
  1084.       {
  1085. #if PROG_ERRORS
  1086.       sprintf( bwb_ebuf, "Too many parameters (%d) to function SPACE$().",
  1087.          argc );
  1088.       bwb_error( bwb_ebuf );
  1089. #else
  1090.       bwb_error( err_syntax );
  1091. #endif
  1092.       break_handler();
  1093.       return NULL;
  1094.       }
  1095.  
  1096.    /* initialize nvar if necessary */
  1097.  
  1098.    if ( init == FALSE )
  1099.       {
  1100.       init = TRUE;
  1101.       var_make( &nvar, (int) STRING );
  1102.       if ( ( tbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  1103.          {
  1104.          bwb_error( err_getmem );
  1105.          }
  1106.       }
  1107.  
  1108.    tbuf[ 0 ] = '\0';
  1109.    spaces = var_getival( &( argv[ 0 ] ));
  1110.  
  1111.    /* add spaces to the string */
  1112.  
  1113.    for ( i = 0; i < spaces; ++i )
  1114.       {
  1115.       tbuf[ i ] = ' ';
  1116.       tbuf[ i + 1 ] = '\0';
  1117.       }
  1118.  
  1119.    b = var_getsval( &nvar );
  1120.    str_ctob( b, tbuf );
  1121.  
  1122.    return &nvar;
  1123.    }
  1124.  
  1125. /***************************************************************
  1126.  
  1127.         FUNCTION:       fnc_pos()
  1128.  
  1129.         DESCRIPTION:    
  1130.  
  1131. ***************************************************************/
  1132.  
  1133. struct bwb_variable *
  1134. fnc_pos( int argc, struct bwb_variable *argv )
  1135.    {
  1136.    static struct bwb_variable nvar;
  1137.    static int init = FALSE;
  1138.    static char nvar_name[] = "<pos()>";
  1139.  
  1140.    /* initialize nvar if necessary */
  1141.  
  1142.    if ( init == FALSE )
  1143.       {
  1144.       init = TRUE;
  1145.       var_make( &nvar, (int) INTEGER );
  1146. /*      nvar.name = nvar_name; */
  1147.       }
  1148.  
  1149.    * var_findival( &nvar, nvar.array_pos ) = prn_col;
  1150.  
  1151.    return &nvar;
  1152.    }
  1153.  
  1154. /***************************************************************
  1155.  
  1156.         FUNCTION:       fnc_err()
  1157.  
  1158.         DESCRIPTION:    
  1159.  
  1160. ***************************************************************/
  1161.  
  1162. struct bwb_variable *
  1163. fnc_err( int argc, struct bwb_variable *argv )
  1164.    {
  1165.    static struct bwb_variable nvar;
  1166.    static int init = FALSE;
  1167.    static char nvar_name[] = "<err()>";
  1168.  
  1169.    /* initialize nvar if necessary */
  1170.  
  1171.    if ( init == FALSE )
  1172.       {
  1173.       init = TRUE;
  1174.       var_make( &nvar, (int) INTEGER );
  1175. /*      nvar.name = nvar_name; */
  1176.       }
  1177.  
  1178.    * var_findival( &nvar, nvar.array_pos ) = err_number;
  1179.  
  1180.    return &nvar;
  1181.    }
  1182.  
  1183. /***************************************************************
  1184.  
  1185.         FUNCTION:       fnc_erl()
  1186.  
  1187.         DESCRIPTION:    
  1188.  
  1189. ***************************************************************/
  1190.  
  1191. struct bwb_variable *
  1192. fnc_erl( int argc, struct bwb_variable *argv )
  1193.    {
  1194.    static struct bwb_variable nvar;
  1195.    static int init = FALSE;
  1196.    static char nvar_name[] = "<erl()>";
  1197.  
  1198.    /* initialize nvar if necessary */
  1199.  
  1200.    if ( init == FALSE )
  1201.       {
  1202.       init = TRUE;
  1203.       var_make( &nvar, (int) INTEGER );
  1204. /*      nvar.name = nvar_name; */
  1205.       }
  1206.  
  1207.    * var_findival( &nvar, nvar.array_pos ) = err_line;
  1208.  
  1209.    return &nvar;
  1210.    }
  1211.  
  1212. /***************************************************************
  1213.  
  1214.         FUNCTION:       bwb_debug()
  1215.  
  1216.         DESCRIPTION:    This function is called to display
  1217.                         debugging messages in Bywater BASIC.
  1218.                         It does not break out at the current
  1219.                         point (as bwb_error() does).
  1220.  
  1221. ***************************************************************/
  1222.  
  1223. #if PERMANENT_DEBUG
  1224. int
  1225. bwb_debug( char *message )
  1226.    {
  1227.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1228.  
  1229.    fflush( stdout );
  1230.    fflush( errfdevice );
  1231.    if ( prn_col != 1 )
  1232.       {
  1233.       xprintf( errfdevice, "\n" );
  1234.       }
  1235.    sprintf( tbuf, "DEBUG %s\n", message );
  1236.    xprintf( errfdevice, tbuf );
  1237.  
  1238.    return TRUE;
  1239.    }
  1240. #endif
  1241.  
  1242. /***************************************************************
  1243.  
  1244.         FUNCTION:       bwb_lerror()
  1245.  
  1246.         DESCRIPTION:    This function implements the BASIC ERROR
  1247.                         command.
  1248.  
  1249. ***************************************************************/
  1250.  
  1251. struct bwb_line *
  1252. bwb_lerror( struct bwb_line *l )
  1253.    {
  1254.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1255.    int n;
  1256.  
  1257. #if INTENSIVE_DEBUG
  1258.    sprintf( bwb_ebuf, "in bwb_lerror(): entered function " );
  1259.    bwb_debug( bwb_ebuf );
  1260. #endif
  1261.  
  1262.    /* Check for argument */
  1263.  
  1264.    adv_ws( l->buffer, &( l->position ) );
  1265.    switch( l->buffer[ l->position ] )
  1266.       {
  1267.       case '\0':
  1268.       case '\n':
  1269.       case '\r':
  1270.       case ':':
  1271.          bwb_error( err_incomplete );
  1272.          l->next->position = 0;
  1273.          return l->next;
  1274.       default:
  1275.          break;
  1276.       }
  1277.  
  1278.    /* get the variable name or numerical constant */
  1279.  
  1280.    adv_element( l->buffer, &( l->position ), tbuf );
  1281.    n = atoi( tbuf );
  1282.  
  1283. #if INTENSIVE_DEBUG
  1284.    sprintf( bwb_ebuf, "in bwb_lerror(): error number is <%d> ", n );
  1285.    bwb_debug( bwb_ebuf );
  1286. #endif
  1287.  
  1288.    /* check the line number value */
  1289.  
  1290.    if ( ( n < 0 ) || ( n >= N_ERRORS ))
  1291.       {
  1292.       sprintf( bwb_ebuf, "Error number %d is out of range", n );
  1293.       bwb_xerror( bwb_ebuf );
  1294.       return l;
  1295.       }
  1296.  
  1297.    bwb_xerror( err_table[ n ] );
  1298.  
  1299.    return l;
  1300.  
  1301.    }
  1302.  
  1303. /***************************************************************
  1304.  
  1305.         FUNCTION:       bwb_error()
  1306.  
  1307.         DESCRIPTION:    This function is called to handle errors
  1308.                         in Bywater BASIC.  It displays the error
  1309.                         message, then calls the break_handler()
  1310.                         routine.
  1311.  
  1312. ***************************************************************/
  1313.  
  1314. int
  1315. bwb_error( char *message )
  1316.    {
  1317.    register int e;
  1318.    static char tbuf[ MAXSTRINGSIZE + 1 ];    /* must be permanent */
  1319.  
  1320.    /* try to find the error message to identify the error number */
  1321.  
  1322.    err_line = bwb_number;        /* set error line number */
  1323.    for ( e = 0; e < N_ERRORS; ++e )
  1324.       {
  1325.       if ( message == err_table[ e ] )    /* set error number */
  1326.          {
  1327.          err_number = e;
  1328.          e = N_ERRORS;            /* break out of loop quickly */
  1329.          }
  1330.       }
  1331.  
  1332.    /* if err_gosubn is not set, then use xerror routine */
  1333.  
  1334.    if ( err_gosubn == 0 )
  1335.       {
  1336.       return bwb_xerror( message );
  1337.       }
  1338.  
  1339.    /* err_gosubn is not set; call user-defined error subroutine */
  1340.  
  1341.    sprintf( tbuf, "GOSUB %d", err_gosubn );
  1342.    cnd_xpline( bwb_l, tbuf );
  1343.    return TRUE;
  1344.  
  1345.    }
  1346.  
  1347. /***************************************************************
  1348.  
  1349.         FUNCTION:       bwb_xerror()
  1350.  
  1351.         DESCRIPTION:    This function is called by bwb_error()
  1352.                         in Bywater BASIC.  It displays the error
  1353.                         message, then calls the break_handler()
  1354.                         routine.
  1355.  
  1356. ***************************************************************/
  1357.  
  1358. int
  1359. bwb_xerror( char *message )
  1360.    {
  1361.    static char tbuf[ MAXSTRINGSIZE + 1 ];    /* this memory should be 
  1362.                            permanent in case of memory
  1363.                            overrun errors */
  1364.  
  1365.    fflush( stdout );
  1366.    fflush( errfdevice );
  1367.    if ( prn_col != 1 )
  1368.       {
  1369.       xprintf( errfdevice, "\n" );
  1370.       }
  1371.    if ( bwb_number == 0 )
  1372.       {
  1373.       sprintf( tbuf, "\n%s: %s\n", ERRD_HEADER, message );
  1374.       }
  1375.    else
  1376.       {
  1377.       sprintf( tbuf, "\n%s %d: %s\n", ERROR_HEADER, bwb_number, message );
  1378.       }
  1379.    xprintf( errfdevice, tbuf );
  1380.    break_handler();
  1381.  
  1382.    return FALSE;
  1383.    }
  1384.  
  1385. /***************************************************************
  1386.  
  1387.         FUNCTION:       matherr()
  1388.  
  1389.         DESCRIPTION:    This function is called to handle math
  1390.                         errors in Bywater BASIC.  It displays
  1391.                         the error message, then calls the
  1392.                         break_handler() routine.
  1393.  
  1394. ***************************************************************/
  1395.  
  1396. int
  1397. matherr( struct exception *except )
  1398.    {
  1399.  
  1400.    perror( MATHERR_HEADER );
  1401.    break_handler();
  1402.  
  1403.    return FALSE;
  1404.    }
  1405.  
  1406. static struct bwb_variable * 
  1407. bwb_esetovar( struct exp_ese *e )
  1408.    {
  1409.    static struct bwb_variable b;
  1410.    static init = FALSE;
  1411.  
  1412.    var_make( &b, e->type );
  1413.  
  1414.    switch( e->type )
  1415.       {
  1416.       case STRING:
  1417.          str_btob( var_findsval( &b, b.array_pos ), exp_getsval( e ) );
  1418.          break;
  1419.       case DOUBLE:
  1420.          * var_finddval( &b, b.array_pos ) = e->dval;
  1421.          break;
  1422.       case INTEGER:
  1423.          * var_findival( &b, b.array_pos ) = e->ival;
  1424.          break;
  1425.       default:
  1426.          * var_findfval( &b, b.array_pos ) = e->fval;
  1427.          break;
  1428.       }
  1429.  
  1430.    return &b;
  1431.  
  1432.    }
  1433.  
  1434. /***************************************************************
  1435.  
  1436.         FUNCTION:       bwb_width()
  1437.  
  1438.         DESCRIPTION:
  1439.  
  1440. ***************************************************************/
  1441.  
  1442. struct bwb_line *
  1443. bwb_width( struct bwb_line *l )
  1444.    {
  1445.    int req_devnumber;
  1446.    int req_width;
  1447.    struct exp_ese *e;
  1448.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1449.    int pos;
  1450.  
  1451.    /* detect device number if present */
  1452.  
  1453.    req_devnumber = -1;
  1454.    adv_ws( l->buffer, &( l->position ) );
  1455.    
  1456.    if ( l->buffer[ l->position ] == '#' )
  1457.       {
  1458.       ++( l->position );
  1459.       adv_element( l->buffer, &( l->position ), tbuf );
  1460.       pos = 0;
  1461.       e = bwb_exp( tbuf, FALSE, &pos );
  1462.       adv_ws( l->buffer, &( l->position ) );
  1463.       if ( l->buffer[ l->position ] == ',' )
  1464.          {
  1465.          ++( l->position );
  1466.          }
  1467.       else
  1468.          {
  1469. #if PROG_ERRORS
  1470.          bwb_error( "in bwb_width(): no comma after #n" );
  1471. #else
  1472.          bwb_error( err_syntax );
  1473. #endif
  1474.          l->next->position = 0;
  1475.          return l->next;
  1476.          }
  1477.  
  1478.       req_devnumber = exp_getival( e );
  1479.  
  1480.       /* check the requested device number */
  1481.       
  1482.       if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  1483.          {
  1484. #if PROG_ERRORS
  1485.          bwb_error( "in bwb_width(): Requested device number is out of range." );
  1486. #else
  1487.          bwb_error( err_devnum );
  1488. #endif
  1489.          l->next->position = 0;
  1490.          return l->next;
  1491.          }
  1492.  
  1493. #if INTENSIVE_DEBUG
  1494.       sprintf( bwb_ebuf, "in bwb_width(): device number is <%d>",
  1495.          req_devnumber );
  1496.       bwb_debug( bwb_ebuf );
  1497. #endif
  1498.  
  1499.       }
  1500.  
  1501.    /* read the width requested */
  1502.  
  1503.    e = bwb_exp( l->buffer, FALSE, &( l->position ));
  1504.    req_width = exp_getival( e );
  1505.  
  1506.    /* check the width */
  1507.  
  1508.    if ( ( req_width < 1 ) || ( req_width > 255 ))
  1509.       {
  1510. #if PROG_ERRORS
  1511.       bwb_error( "in bwb_width(): Requested width is out of range (1-255)" );
  1512. #else
  1513.       bwb_error( err_valoorange );
  1514. #endif
  1515.       }
  1516.  
  1517.    /* assign the width */
  1518.  
  1519.    if ( req_devnumber == -1 )
  1520.       {
  1521.       prn_width = req_width;
  1522.       }
  1523.    else
  1524.       {
  1525.       dev_table[ req_devnumber ].width = req_width;
  1526.       }
  1527.  
  1528.    /* return */
  1529.  
  1530.    return l->next;
  1531.    }
  1532.  
  1533. /***************************************************************
  1534.  
  1535.         FUNCTION:       bwb_write()
  1536.  
  1537.         DESCRIPTION:
  1538.  
  1539. ***************************************************************/
  1540.  
  1541. struct bwb_line *
  1542. bwb_write( struct bwb_line *l )
  1543.    {
  1544.    struct exp_ese *e;
  1545.    int req_devnumber;
  1546.    int pos;
  1547.    FILE *fp;
  1548.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1549.    int loop;
  1550.    static struct bwb_variable nvar;
  1551.    static int init = FALSE;
  1552.  
  1553.    /* initialize variable if necessary */
  1554.  
  1555.    if ( init == FALSE )
  1556.       {
  1557.       init = TRUE;
  1558.       var_make( &nvar, SINGLE );
  1559.       }
  1560.  
  1561.    /* detect device number if present */
  1562.  
  1563.    adv_ws( l->buffer, &( l->position ) );
  1564.    
  1565.    if ( l->buffer[ l->position ] == '#' )
  1566.       {
  1567.       ++( l->position );
  1568.       adv_element( l->buffer, &( l->position ), tbuf );
  1569.       pos = 0;
  1570.       e = bwb_exp( tbuf, FALSE, &pos );
  1571.       adv_ws( l->buffer, &( l->position ) );
  1572.       if ( l->buffer[ l->position ] == ',' )
  1573.          {
  1574.          ++( l->position );
  1575.          }
  1576.       else
  1577.          {
  1578. #if PROG_ERRORS
  1579.          bwb_error( "in bwb_write(): no comma after #n" );
  1580. #else
  1581.          bwb_error( err_syntax );
  1582. #endif
  1583.          l->next->position = 0;
  1584.          return l->next;
  1585.          }
  1586.  
  1587.       req_devnumber = exp_getival( e );
  1588.  
  1589.       /* check the requested device number */
  1590.       
  1591.       if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  1592.          {
  1593. #if PROG_ERRORS
  1594.          bwb_error( "in bwb_write(): Requested device number is out of range." );
  1595. #else
  1596.          bwb_error( err_devnum );
  1597. #endif
  1598.          l->next->position = 0;
  1599.          return l->next;
  1600.          }
  1601.  
  1602.       if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
  1603.          ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ))
  1604.          {
  1605. #if PROG_ERRORS
  1606.          bwb_error( "in bwb_write(): Requested device number is not open." );
  1607. #else
  1608.          bwb_error( err_devnum );
  1609. #endif
  1610.  
  1611.          l->next->position = 0;
  1612.          return l->next;
  1613.          }
  1614.  
  1615.       if ( dev_table[ req_devnumber ].mode != DEVMODE_OUTPUT )
  1616.          {
  1617. #if PROG_ERRORS
  1618.          bwb_error( "in bwb_write(): Requested device is not open for OUTPUT." );
  1619. #else
  1620.          bwb_error( err_devnum );
  1621. #endif
  1622.  
  1623.          l->next->position = 0;
  1624.          return l->next;
  1625.          }
  1626.  
  1627. #if INTENSIVE_DEBUG
  1628.       sprintf( bwb_ebuf, "in bwb_write(): device number is <%d>",
  1629.          req_devnumber );
  1630.       bwb_debug( bwb_ebuf );
  1631. #endif
  1632.  
  1633.       /* look up the requested device in the device table */
  1634.  
  1635.       fp = dev_table[ req_devnumber ].cfp;
  1636.  
  1637.       }
  1638.  
  1639.    else
  1640.       {
  1641.       fp = stdout;
  1642.       }
  1643.  
  1644.    /* be sure there is an element to print */ 
  1645.  
  1646.    adv_ws( l->buffer, &( l->position ) );
  1647.    loop = TRUE;
  1648.    switch( l->buffer[ l->position ] )
  1649.       {
  1650.       case '\n':
  1651.       case '\r':
  1652.       case '\0':
  1653.       case ':':
  1654.          loop = FALSE;
  1655.          break;
  1656.       }
  1657.  
  1658.    /* loop through elements */
  1659.  
  1660.    while ( loop == TRUE )
  1661.       {
  1662.  
  1663.       /* get the next element */
  1664.  
  1665.       e = bwb_exp( l->buffer, FALSE, &( l->position ));
  1666.  
  1667.       /* perform type-specific output */
  1668.  
  1669.       switch( e->type )
  1670.          {
  1671.          case STRING:
  1672.             xputc( fp, '\"' );
  1673.             str_btoc( tbuf, exp_getsval( e ) );
  1674.             xprintf( fp, tbuf );
  1675.             xputc( fp, '\"' );
  1676. #if INTENSIVE_DEBUG
  1677.             sprintf( bwb_ebuf, "in bwb_write(): output string element <\"%s\">",
  1678.                tbuf );
  1679.             bwb_debug( bwb_ebuf );
  1680. #endif
  1681.             break;
  1682.          default:
  1683.             * var_findfval( &nvar, nvar.array_pos ) =
  1684.                exp_getfval( e );
  1685.             sprintf( tbuf, " %.*f", prn_precision( &nvar ), 
  1686.                var_getfval( &nvar ) );
  1687.             xprintf( fp, tbuf );
  1688. #if INTENSIVE_DEBUG
  1689.             sprintf( bwb_ebuf, "in bwb_write(): output numerical element <%s>",
  1690.                tbuf );
  1691.             bwb_debug( bwb_ebuf );
  1692. #endif
  1693.             break;
  1694.          }                /* end of case for type-specific output */
  1695.  
  1696.       /* seek a comma at end of element */
  1697.  
  1698.       adv_ws( l->buffer, &( l->position ) );
  1699.       if ( l->buffer[ l->position ] == ',' )
  1700.          {
  1701.          xputc( fp, ',' );
  1702.          ++( l->position );
  1703.          }
  1704.  
  1705.       /* no comma: end the loop */
  1706.  
  1707.       else
  1708.          {
  1709.          loop = FALSE;
  1710.          }
  1711.  
  1712.       }                    /* end of loop through elements */
  1713.  
  1714.    /* print LF */
  1715.  
  1716.    xputc( fp, '\n' );
  1717.  
  1718.    /* return */
  1719.  
  1720.    l->next->position = 0;
  1721.    return l->next;
  1722.    }
  1723.  
  1724.