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