home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bwbasic.zip / src / bwb_dio.c < prev    next >
C/C++ Source or Header  |  1993-04-27  |  48KB  |  1,926 lines
  1. /***************************************************************
  2.  
  3.         bwb_dio.c       Device Input/Output Routines
  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 <string.h>
  37. #include <sys/types.h>
  38. #include <sys/stat.h>
  39.  
  40. #include "bwbasic.h"
  41. #include "bwb_mes.h"
  42.  
  43. #if INTENSIVE_DEBUG
  44. #define RANDOM_FILLCHAR        'X'
  45. #else
  46. #define RANDOM_FILLCHAR        ' '
  47. #endif
  48.  
  49. struct dev_element *dev_table;          /* table of devices */
  50.  
  51. static struct bwb_variable *v;
  52. static int pos;
  53. static int req_devnumber;
  54. static int rlen;
  55. static int mode;
  56.  
  57. static struct bwb_line *dio_lrset( struct bwb_line *l, int rset );
  58. static int dio_flush( int dev_number );
  59.  
  60. /***************************************************************
  61.  
  62.         FUNCTION:       bwb_open()
  63.  
  64.         DESCRIPTION: This function implements the BASIC OPEN
  65.         command to open a stream for device input/output.
  66.  
  67.         SYNTAX: 1. OPEN "I"|"O"|"R", [#]n, filename [,rlen]
  68.                 2. OPEN filename [FOR INPUT|OUTPUT|APPEND|] AS [#]n [LEN=n]
  69.  
  70. ***************************************************************/
  71.  
  72. struct bwb_line *
  73. bwb_open( struct bwb_line *l )
  74.    {
  75.    FILE *fp;
  76.    struct exp_ese *e;
  77.    register int n;
  78.    int previous_buffer;
  79.    char atbuf[ MAXSTRINGSIZE + 1 ];
  80.    char first[ MAXSTRINGSIZE + 1 ];
  81.    char devname[ MAXSTRINGSIZE + 1 ];
  82.  
  83.    /* initialize */
  84.  
  85.    mode = req_devnumber = rlen = -1;
  86.    previous_buffer = FALSE;
  87.  
  88.    /* get the first expression element up to comma or whitespace */
  89.  
  90.    adv_element( l->buffer, &( l->position ), atbuf );
  91.  
  92.    /* parse the first expression element */
  93.  
  94.    pos = 0;
  95.    e = bwb_exp( atbuf, FALSE, &pos );
  96.    str_btoc( first, exp_getsval( e ) );
  97.  
  98.    #if INTENSIVE_DEBUG
  99.    sprintf( bwb_ebuf, "in bwb_open(): first element is <%s>",
  100.       first );
  101.    bwb_debug( bwb_ebuf );
  102.    #endif
  103.  
  104.    /* test for syntactical form: if a comma follows the first element, 
  105.       then the syntax is form 1 (the old CP/M BASIC format); otherwise we
  106.       presume form 2 */
  107.  
  108.    adv_ws( l->buffer, &( l->position ) );
  109.  
  110.    /* Parse syntax Form 1 (OPEN "x", #n, devname...) */
  111.  
  112.    if ( l->buffer[ l->position ] == ',' )
  113.       {
  114.  
  115.       /* parse the next element to get the device number */
  116.  
  117.       ++( l->position );                        /* advance beyond comma */
  118.       adv_ws( l->buffer, &( l->position ) );
  119.       if ( l->buffer[ l->position ] == '#' )
  120.          {
  121.          ++( l->position );
  122.          adv_ws( l->buffer, &( l->position ) );
  123.          }
  124.  
  125.       adv_element( l->buffer, &( l->position ), atbuf );
  126.  
  127.       pos = 0;
  128.       e = bwb_exp( atbuf, FALSE, &pos );
  129.       if ( e->type == STRING )
  130.          {
  131.      #if PROG_ERRORS
  132.      bwb_error( "String where integer was expected for device number" );
  133.      #else
  134.      bwb_error( err_syntax );
  135.      #endif
  136.          l->next->position = 0;
  137.          return l->next;
  138.          }
  139.       req_devnumber = exp_getival( e );
  140.  
  141.       #if INTENSIVE_DEBUG
  142.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, req dev number is %d",
  143.          req_devnumber );
  144.       bwb_debug( bwb_ebuf );
  145.       #endif
  146.  
  147.       /* parse the next element to get the devname */
  148.  
  149.       adv_ws( l->buffer, &( l->position ) );    /* advance past whitespace */
  150.       ++( l->position );                        /* advance past comma */
  151.       adv_element( l->buffer, &( l->position ), atbuf );
  152.  
  153.       pos = 0;
  154.       e = bwb_exp( atbuf, FALSE, &pos );
  155.       if ( e->type != STRING )
  156.          {
  157.      #if PROG_ERRORS
  158.      bwb_error( "in bwb_open(): number where string was expected for devname" );
  159.      #else
  160.      bwb_error( err_syntax );
  161.          #endif
  162.          l->next->position = 0;
  163.          return l->next;
  164.          }
  165.       str_btoc( devname, exp_getsval( e ) );
  166.  
  167.       #if INTENSIVE_DEBUG
  168.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, devname <%s>",
  169.          devname  );
  170.       bwb_debug( bwb_ebuf );
  171.       #endif
  172.  
  173.       /* see if there is another element; if so, parse it to get the
  174.          record length */
  175.  
  176.       adv_ws( l->buffer, &( l->position ) );
  177.       if ( l->buffer[ l->position ] == ',' )
  178.          {
  179.  
  180.          ++( l->position );                     /* advance beyond comma */
  181.          adv_element( l->buffer, &( l->position ), atbuf );
  182.  
  183.          pos = 0;
  184.          e = bwb_exp( atbuf, FALSE, &pos );
  185.          if ( e->type == STRING )
  186.             {
  187.         #if PROG_ERRORS
  188.             bwb_error( "String where integer was expected for record length" );
  189.             #else
  190.             bwb_error( err_syntax );
  191.             #endif
  192.             l->next->position = 0;
  193.             return l->next;
  194.             }
  195.          rlen = exp_getival( e );
  196.  
  197.          #if INTENSIVE_DEBUG
  198.          sprintf( bwb_ebuf, "in bwb_open(): syntax 1, record length is %d",
  199.             rlen );
  200.          bwb_debug( bwb_ebuf );
  201.          #endif
  202.  
  203.          }
  204.  
  205.       /* the first letter of the first should indicate the
  206.          type of file opening requested: test this letter,
  207.          then parse accordingly */
  208.  
  209.       /* open file for sequential INPUT */
  210.  
  211.       if ( ( first[ 0 ] == 'i' ) || ( first[ 0 ] == 'I' ))
  212.          {
  213.          mode = DEVMODE_INPUT;
  214.          }
  215.  
  216.       /* open file for sequential OUTPUT */
  217.  
  218.       else if ( ( first[ 0 ] == 'o' ) || ( first[ 0 ] == 'O' ))
  219.          {
  220.          mode = DEVMODE_OUTPUT;
  221.          }
  222.  
  223.       /* open file for RANDOM access input and output */
  224.  
  225.       else if ( ( first[ 0 ] == 'r' ) || ( first[ 0 ] == 'R' ))
  226.          {
  227.          mode = DEVMODE_RANDOM;
  228.          }
  229.  
  230.       /* error: none of the appropriate modes found */
  231.  
  232.       else
  233.          {
  234.      #if PROG_ERRORS
  235.      sprintf( bwb_ebuf, "in bwb_open(): invalid mode" );
  236.      bwb_error( bwb_ebuf );
  237.      #else
  238.      bwb_error( err_syntax );
  239.      #endif
  240.          }
  241.  
  242.       #if INTENSIVE_DEBUG
  243.       sprintf( bwb_ebuf, "in bwb_open(): syntax 1, mode is %d", mode );
  244.       bwb_debug( bwb_ebuf );
  245.       #endif
  246.  
  247.       }
  248.  
  249.    /* Parse syntax Form 2 (OPEN devname FOR mode AS #n ... ) */
  250.  
  251.    else
  252.       {
  253.  
  254.       /* save the devname from first */
  255.  
  256.       strcpy( devname, first );
  257.  
  258.       #if INTENSIVE_DEBUG
  259.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, devname <%s>",
  260.          devname );
  261.       bwb_debug( bwb_ebuf );
  262.       #endif
  263.  
  264.       /* get the next element */
  265.  
  266.       adv_element( l->buffer, &( l->position ), atbuf );
  267.  
  268.       /* check for "FOR mode" statement */
  269.  
  270.       bwb_strtoupper( atbuf );
  271.       if ( strcmp( atbuf, "FOR" ) == 0 )
  272.          {
  273.          adv_element( l->buffer, &( l->position ), atbuf );
  274.          bwb_strtoupper( atbuf );
  275.          if ( strcmp( atbuf, "INPUT" ) == 0 )
  276.             {
  277.             mode = DEVMODE_INPUT;
  278.             }
  279.          else if ( strcmp( atbuf, "OUTPUT" ) == 0 )
  280.             {
  281.             mode = DEVMODE_OUTPUT;
  282.             }
  283.          else if ( strcmp( atbuf, "APPEND" ) == 0 )
  284.             {
  285.             mode = DEVMODE_RANDOM;
  286.             }
  287.          else 
  288.             {
  289.         #if PROG_ERRORS
  290.             bwb_error( "in bwb_open(): Invalid device i/o mode specified" );
  291.             #else
  292.             bwb_error( err_syntax );
  293.             #endif
  294.             l->next->position = 0;
  295.             return l->next;
  296.             }
  297.  
  298.          /* get the next element */
  299.  
  300.          adv_element( l->buffer, &( l->position ), atbuf );
  301.  
  302.          }
  303.       else
  304.          {
  305.          mode = DEVMODE_RANDOM;
  306.          }
  307.  
  308.       #if INTENSIVE_DEBUG
  309.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, mode is %d", mode );
  310.       bwb_debug( bwb_ebuf );
  311.       #endif
  312.  
  313.       /* This leaves us with the next element in the atbuf: it
  314.          should read "AS" */
  315.  
  316.       bwb_strtoupper( atbuf );
  317.       if ( strcmp( atbuf, "AS" ) != 0 )
  318.          {
  319.      #if PROG_ERRORS
  320.          bwb_error( "in bwb_open(): expected AS statement" );
  321.          #else
  322.          bwb_error( err_syntax );
  323.          #endif
  324.          l->next->position = 0;
  325.          return l->next;
  326.          }
  327.  
  328.       /* get the next element */
  329.  
  330.       adv_ws( l->buffer, &( l->position ) );
  331.  
  332.       if ( l->buffer[ l->position ] == '#' )
  333.          {
  334.          ++( l->position );
  335.          }
  336.  
  337.       adv_element( l->buffer, &( l->position ), atbuf );
  338.  
  339.       #if INTENSIVE_DEBUG
  340.       sprintf( bwb_ebuf, "in bwb_open(): string to parse for req dev number <%s>",
  341.          atbuf );
  342.       bwb_debug( bwb_ebuf );
  343.       #endif
  344.  
  345.       pos = 0;
  346.       e = bwb_exp( atbuf, FALSE, &pos );
  347.       if ( e->type == STRING )
  348.          {
  349.      #if PROG_ERRORS
  350.          bwb_error( "String where integer was expected for record length" );
  351.          #else
  352.          bwb_error( err_syntax );
  353.          #endif
  354.          l->next->position = 0;
  355.          return l->next;
  356.          }
  357.       req_devnumber = exp_getival( e );
  358.  
  359.       #if INTENSIVE_DEBUG
  360.       sprintf( bwb_ebuf, "in bwb_open(): syntax 2, req dev number is %d",
  361.          req_devnumber );
  362.       bwb_debug( bwb_ebuf );
  363.       #endif
  364.  
  365.       /* Check for LEN = n statement */
  366.  
  367.       adv_element( l->buffer, &( l->position ), atbuf );
  368.       bwb_strtoupper( atbuf );
  369.       if ( strncmp( atbuf, "LEN", (size_t) 3 ) == 0 )
  370.          {
  371.  
  372.          pos = l->position - strlen( atbuf );
  373.          while( ( l->buffer[ pos ] != '=' ) && ( l->buffer[ pos ] != '\0' ))
  374.             {
  375.             ++pos;
  376.             }
  377.          if ( l->buffer[ pos ] == '\0' )
  378.             {
  379.         #if PROG_ERRORS
  380.             bwb_error( "Failed to find equals sign after LEN element" );
  381.             #else
  382.             bwb_error( err_syntax );
  383.             #endif
  384.             l->next->position = 0;
  385.             return l->next;
  386.             }
  387.          ++pos;         /* advance past equal sign */
  388.  
  389.          e = bwb_exp( l->buffer, FALSE, &pos );
  390.  
  391.          if ( e->type == STRING )
  392.             {
  393.         #if PROG_ERRORS
  394.             bwb_error( "String where integer was expected for record length" );
  395.             #else
  396.             bwb_error( err_syntax );
  397.             #endif
  398.             l->next->position = 0;
  399.             return l->next;
  400.             }
  401.          rlen = exp_getival( e );
  402.  
  403.          #if INTENSIVE_DEBUG
  404.          sprintf( bwb_ebuf, "in bwb_open(): syntax 2, record length is %d",
  405.             rlen );
  406.          bwb_debug( bwb_ebuf );
  407.          #endif
  408.  
  409.          }
  410.  
  411.       }                                 /* end of syntax 2 */
  412.  
  413.    /* check for valid requested device number */
  414.  
  415.    if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  416.       {
  417.       #if PROG_ERRORS
  418.       bwb_error( "in bwb_open(): Requested device number is out of range." );
  419.       #else
  420.       bwb_error( err_devnum );
  421.       #endif
  422.       l->next->position = 0;
  423.       return l->next;
  424.       }
  425.  
  426.    if ( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED )
  427.       {
  428.       #if INTENSIVE_DEBUG
  429.       sprintf( bwb_ebuf, "in bwb_open(): using previously closed file (and buffer)" );
  430.       bwb_debug( bwb_ebuf );
  431.       #endif
  432.       previous_buffer = TRUE;
  433.       }
  434.  
  435.    if ( ( dev_table[ req_devnumber ].mode != DEVMODE_CLOSED ) &&
  436.       ( dev_table[ req_devnumber ].mode != DEVMODE_AVAILABLE ) )
  437.       {
  438.       #if PROG_ERRORS
  439.       bwb_error( "in bwb_open(): Requested device number is already in use." );
  440.       #else
  441.       bwb_error( err_devnum );
  442.       #endif
  443.  
  444.       l->next->position = 0;
  445.       return l->next;
  446.       }
  447.  
  448.    #if INTENSIVE_DEBUG
  449.    sprintf( bwb_ebuf, "in bwb_open(): ready to open device <%s> mode <%d>",
  450.       devname, mode );
  451.    bwb_debug( bwb_ebuf );
  452.    #endif
  453.  
  454.    /* attempt to open the file */
  455.  
  456.    switch( mode )
  457.       {
  458.       case DEVMODE_OUTPUT:
  459.          fp = fopen( devname, "w" );
  460.          break;
  461.       case DEVMODE_INPUT:
  462.          fp = fopen( devname, "r" );
  463.          break;
  464.       case DEVMODE_APPEND:
  465.          fp = fopen( devname, "a" );
  466.          break;
  467.       case DEVMODE_RANDOM:
  468.          fp = fopen( devname, "r+" );
  469.          if ( fp == NULL )
  470.             {
  471.             fp = fopen( devname, "w" );
  472.             fclose( fp );
  473.             fp = fopen( devname, "r+" );
  474.             }
  475.          break;
  476.       }
  477.  
  478.    /* check for valid file opening */
  479.  
  480.    if ( fp == NULL )
  481.       {
  482.       #if PROG_ERRORS
  483.       sprintf( bwb_ebuf, "Failed to open device <%s>", devname );
  484.       bwb_error( bwb_ebuf );
  485.       #else
  486.       bwb_error( err_dev );
  487.       #endif
  488.       l->next->position = 0;
  489.       return l->next;
  490.       }
  491.  
  492.    /* assign values to device table */
  493.  
  494.    dev_table[ req_devnumber ].mode = mode;
  495.    dev_table[ req_devnumber ].cfp = fp;
  496.    dev_table[ req_devnumber ].reclen = rlen;
  497.    dev_table[ req_devnumber ].next_record = 1;
  498.    dev_table[ req_devnumber ].loc = 0;
  499.    strcpy( dev_table[ req_devnumber ].filename, devname );
  500.  
  501.    /* allocate a character buffer for random access */
  502.  
  503.    if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE ))
  504.       {
  505.       if ( ( dev_table[ req_devnumber ].buffer = calloc( rlen + 1, 1 )) == NULL )
  506.          {
  507.          bwb_error( err_getmem );
  508.          return l;
  509.          }
  510.  
  511.       dio_flush( req_devnumber );
  512.  
  513.       #if INTENSIVE_DEBUG
  514.       sprintf( bwb_ebuf, "in bwb_open(): allocated new random-access buffer" );
  515.       bwb_debug( bwb_ebuf );
  516.       #endif
  517.  
  518.       }
  519.  
  520.    #if INTENSIVE_DEBUG
  521.    sprintf( bwb_ebuf, "in bwb_open(): file is open now; end of function" );
  522.    bwb_debug( bwb_ebuf );
  523.    #endif
  524.  
  525.    /* return next line number in sequence */
  526.  
  527.    l->next->position = 0;
  528.    return l->next;
  529.    }
  530.  
  531. /***************************************************************
  532.  
  533.         FUNCTION:       bwb_close()
  534.  
  535.         DESCRIPTION: This function implements the BASIC CLOSE
  536.         command to close a stream for device input/output.
  537.   
  538.         SYNTAX:         CLOSE [#]n [,[#]n...]
  539.  
  540. ***************************************************************/
  541.  
  542. struct bwb_line *
  543. bwb_close( struct bwb_line *l )
  544.    {
  545.    struct exp_ese *e;
  546.    char atbuf[ MAXSTRINGSIZE + 1 ];
  547.  
  548.    /* loop to get device numbers to close */
  549.  
  550.    do
  551.       {
  552.  
  553.       adv_ws( l->buffer, &( l->position ) );
  554.       if ( l->buffer[ l->position ] =='#' )
  555.          {
  556.          ++( l->position );
  557.          }
  558.  
  559.       adv_element( l->buffer, &( l->position ), atbuf );
  560.  
  561.       pos = 0;
  562.       e = bwb_exp( atbuf, FALSE, &pos );
  563.  
  564.       if ( e->type == STRING )
  565.          {
  566.      #if PROG_ERRORS
  567.          bwb_error( "String where integer was expected for device number" );
  568.          #else
  569.          bwb_error( err_syntax );
  570.          #endif
  571.          l->next->position = 0;
  572.          return l->next;
  573.          }
  574.  
  575.       req_devnumber = exp_getival( e );
  576.  
  577.       #if INTENSIVE_DEBUG
  578.       sprintf( bwb_ebuf, "in bwb_close(): requested device number <%d>",
  579.          req_devnumber );
  580.       bwb_debug( bwb_ebuf );
  581.       #endif
  582.  
  583.       /* check for valid requested device number */
  584.  
  585.       if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
  586.          {
  587.      #if PROG_ERRORS
  588.          bwb_error( "in bwb_close(): Requested device number is out if range." );
  589.          #else
  590.          bwb_error( err_devnum );
  591.          #endif
  592.          l->next->position = 0;
  593.          return l->next;
  594.          }
  595.  
  596.       if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
  597.          ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  598.          {
  599.      #if PROG_ERRORS
  600.          bwb_error( "in bwb_close(): Requested device number is not in use." );
  601.          #else
  602.          bwb_error( err_devnum );
  603.          #endif
  604.  
  605.          l->next->position = 0;
  606.          return l->next;
  607.          }
  608.  
  609.       #if INTENSIVE_DEBUG
  610.       sprintf( bwb_ebuf, "in bwb_close(): closing device # <%d>",
  611.      req_devnumber );
  612.       bwb_debug( bwb_ebuf );
  613.       #endif
  614.  
  615.       /* attempt to close the file */
  616.  
  617.       if ( fclose( dev_table[ req_devnumber ].cfp ) != 0 )
  618.          {
  619.      #if PROG_ERRORS
  620.          bwb_error( "in bwb_close(): Failed to close the device" );
  621.          #else
  622.          bwb_error( err_dev );
  623.          #endif
  624.          l->next->position = 0;
  625.          return l->next;
  626.          }
  627.  
  628.       /* mark the device in the table as unavailable */
  629.  
  630.       dev_table[ req_devnumber ].mode = DEVMODE_CLOSED;
  631.  
  632.       /* eat up any remaining whitespace */
  633.  
  634.       adv_ws( l->buffer, &( l->position ) );
  635.  
  636.       }
  637.  
  638.    while ( l->buffer[ l->position ] == ',' );
  639.  
  640.    /* return next line number in sequence */
  641.  
  642.    l->next->position = 0;
  643.    return l->next;
  644.    }
  645.  
  646. /***************************************************************
  647.  
  648.         FUNCTION:       bwb_chdir()
  649.  
  650.         DESCRIPTION: This function implements the BASIC CHDIR
  651.         command to switch logged directories.
  652.  
  653.         SYNTAX: CHDIR pathname$
  654.  
  655. ***************************************************************/
  656.  
  657. #if DIRECTORY_CMDS
  658. struct bwb_line *
  659. bwb_chdir( struct bwb_line *l )
  660.    {
  661.    int r;
  662.    static int position;
  663.    struct exp_ese *e;
  664.    static char *atbuf;
  665.    static int init = FALSE;
  666.  
  667.    /* get memory for temporary buffers if necessary */
  668.  
  669.    if ( init == FALSE )
  670.       {
  671.       init = TRUE;
  672.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  673.          {
  674.          bwb_error( err_getmem );
  675.          }
  676.       }
  677.  
  678.    /* get the next element in atbuf */
  679.  
  680.    adv_element( l->buffer, &( l->position ), atbuf  );
  681.  
  682.    #if INTENSIVE_DEBUG
  683.    sprintf( bwb_ebuf, "in bwb_chdir(): argument is <%s>", atbuf );
  684.    bwb_debug( bwb_ebuf );
  685.    #endif
  686.  
  687.    /* interpret the argument */
  688.  
  689.    position = 0;
  690.    e = bwb_exp( atbuf, FALSE, &position );
  691.  
  692.    if ( e->type != STRING )
  693.       {
  694.       bwb_error( err_argstr );
  695.       l->next->position = 0;
  696.       return l->next;
  697.       }
  698.  
  699.    /* try to chdir to the requested directory */
  700.  
  701.    str_btoc( atbuf, &( e->sval ) );
  702.    r = chdir( atbuf );
  703.  
  704.    /* detect error */
  705.  
  706.    if ( r == -1 )
  707.       {
  708.       bwb_error( err_opsys );
  709.       l->next->position = 0;
  710.       return l->next;
  711.       }
  712.  
  713.    l->next->position = 0;
  714.    return l->next;
  715.  
  716.    }
  717.  
  718. /***************************************************************
  719.  
  720.         FUNCTION:       bwb_rmdir()
  721.  
  722.         DESCRIPTION: This function implements the BASIC CHDIR
  723.         command to remove a subdirectory.
  724.  
  725.         SYNTAX: RMDIR pathname$
  726.  
  727. ***************************************************************/
  728.  
  729. struct bwb_line *
  730. bwb_rmdir( struct bwb_line *l )
  731.    {
  732.    int r;
  733.    static int position;
  734.    struct exp_ese *e;
  735.    static char *atbuf;
  736.    static int init = FALSE;
  737.  
  738.    /* get memory for temporary buffers if necessary */
  739.  
  740.    if ( init == FALSE )
  741.       {
  742.       init = TRUE;
  743.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  744.          {
  745.          bwb_error( err_getmem );
  746.          }
  747.       }
  748.  
  749.    /* get the next element in atbuf */
  750.  
  751.    adv_element( l->buffer, &( l->position ), atbuf  );
  752.  
  753.    #if INTENSIVE_DEBUG
  754.    sprintf( bwb_ebuf, "in bwb_rmdir(): argument is <%s>", atbuf );
  755.    bwb_debug( bwb_ebuf );
  756.    #endif
  757.  
  758.    /* interpret the argument */
  759.  
  760.    position = 0;
  761.    e = bwb_exp( atbuf, FALSE, &position );
  762.  
  763.    if ( e->type != STRING )
  764.       {
  765.       bwb_error( err_argstr );
  766.       l->next->position = 0;
  767.       return l->next;
  768.       }
  769.  
  770.    /* try to remove the requested directory */
  771.  
  772.    str_btoc( atbuf, &( e->sval ) );
  773.    r = rmdir( atbuf );
  774.  
  775.    /* detect error */
  776.  
  777.    if ( r == -1 )
  778.       {
  779.       bwb_error( err_opsys );
  780.       }
  781.  
  782.    l->next->position = 0;
  783.    return l->next;
  784.  
  785.    }
  786.  
  787. /***************************************************************
  788.  
  789.         FUNCTION:       bwb_mkdir()
  790.  
  791.         DESCRIPTION: This function implements the BASIC MKDIR
  792.         command to create a new subdirectory.
  793.  
  794.         SYNTAX: MKDIR pathname$
  795.  
  796. ***************************************************************/
  797.  
  798. struct bwb_line *
  799. bwb_mkdir( struct bwb_line *l )
  800.    {
  801.    int r;
  802.    static int position;
  803.    struct exp_ese *e;
  804.    static char *atbuf;
  805.    static int init = FALSE;
  806.  
  807.    /* get memory for temporary buffers if necessary */
  808.  
  809.    if ( init == FALSE )
  810.       {
  811.       init = TRUE;
  812.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  813.          {
  814.          bwb_error( err_getmem );
  815.          }
  816.       }
  817.  
  818.    /* get the next element in atbuf */
  819.  
  820.    adv_element( l->buffer, &( l->position ), atbuf  );
  821.  
  822.    #if INTENSIVE_DEBUG
  823.    sprintf( bwb_ebuf, "in bwb_mkdir(): argument is <%s>", atbuf );
  824.    bwb_debug( bwb_ebuf );
  825.    #endif
  826.  
  827.    /* interpret the argument */
  828.  
  829.    position = 0;
  830.    e = bwb_exp( atbuf, FALSE, &position );
  831.  
  832.    if ( e->type != STRING )
  833.       {
  834.       bwb_error( err_argstr );
  835.       l->next->position = 0;
  836.       return l->next;
  837.       }
  838.  
  839.    /* try to make the requested directory */
  840.  
  841.    str_btoc( atbuf, &( e->sval ) );
  842.    r = mkdir( atbuf , 0 );
  843.  
  844.    /* detect error */
  845.  
  846.    if ( r == -1 )
  847.       {
  848.       bwb_error( err_opsys );
  849.       }
  850.  
  851.    l->next->position = 0;
  852.    return l->next;
  853.  
  854.    }
  855.  
  856. #endif                /* DIRECTORY_CMDS */
  857.  
  858. /***************************************************************
  859.  
  860.         FUNCTION:       bwb_kill()
  861.  
  862.         DESCRIPTION: This function implements the BASIC KILL
  863.         command to erase a disk file.
  864.  
  865.         SYNTAX: KILL btbuf$
  866.  
  867. ***************************************************************/
  868.  
  869. struct bwb_line *
  870. bwb_kill( struct bwb_line *l )
  871.    {
  872.    int r;
  873.    static int position;
  874.    struct exp_ese *e;
  875.    static char *atbuf;
  876.    static int init = FALSE;
  877.  
  878.    /* get memory for temporary buffers if necessary */
  879.  
  880.    if ( init == FALSE )
  881.       {
  882.       init = TRUE;
  883.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  884.          {
  885.          bwb_error( err_getmem );
  886.          }
  887.       }
  888.  
  889.    /* get the next element in atbuf */
  890.  
  891.    adv_element( l->buffer, &( l->position ), atbuf  );
  892.  
  893.    #if INTENSIVE_DEBUG
  894.    sprintf( bwb_ebuf, "in bwb_kill(): argument is <%s>", atbuf );
  895.    bwb_debug( bwb_ebuf );
  896.    #endif
  897.  
  898.    /* interpret the argument */
  899.  
  900.    position = 0;
  901.   e = bwb_exp( atbuf, FALSE, &position );
  902.  
  903.    if ( e->type != STRING )
  904.       {
  905.       bwb_error( err_argstr );
  906.       l->next->position = 0;
  907.       return l->next;
  908.       }
  909.  
  910.    /* try to delete the specified file */
  911.  
  912.    str_btoc( atbuf, &( e->sval ) );
  913.    r = unlink( atbuf );
  914.  
  915.    /* detect error */
  916.  
  917.    if ( r == -1 )
  918.       {
  919.       bwb_error( err_opsys );
  920.       }
  921.  
  922.    l->next->position = 0;
  923.    return l->next;
  924.  
  925.    }
  926.  
  927. /***************************************************************
  928.  
  929.         FUNCTION:       bwb_name()
  930.  
  931.         DESCRIPTION: This function implements the BASIC NAME
  932.         command to rename a disk file.
  933.  
  934.         SYNTAX: NAME old_btbuf$ AS new_btbuf$
  935.  
  936. ***************************************************************/
  937.  
  938. struct bwb_line *
  939. bwb_name( struct bwb_line *l )
  940.    {
  941.    int r;
  942.    static int position;
  943.    struct exp_ese *e;
  944.    static char *atbuf;
  945.    static char *btbuf;
  946.    static int init = FALSE;
  947.  
  948.    /* get memory for temporary buffers if necessary */
  949.  
  950.    if ( init == FALSE )
  951.       {
  952.       init = TRUE;
  953.       if ( ( atbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  954.          {
  955.          bwb_error( err_getmem );
  956.          }
  957.       if ( ( btbuf = calloc( MAXSTRINGSIZE + 1, sizeof( char ) )) == NULL )
  958.          {
  959.          bwb_error( err_getmem );
  960.          }
  961.       }
  962.  
  963.    /* get the first argument in atbuf */
  964.  
  965.    adv_element( l->buffer, &( l->position ), atbuf  );
  966.  
  967.    /* interpret the first argument */
  968.  
  969.    position = 0;
  970.    e = bwb_exp( atbuf, FALSE, &position );
  971.  
  972.    if ( e->type != STRING )
  973.       {
  974.       bwb_error( err_argstr );
  975.       l->next->position = 0;
  976.       return l->next;
  977.       }
  978.  
  979.    /* this argument must be copied back to atbuf, else the next
  980.       call to bwb_exp() will overwrite the structure to which e
  981.       refers */
  982.  
  983.    str_btoc( atbuf, &( e->sval ) );
  984.  
  985.    #if INTENSIVE_DEBUG
  986.    sprintf( bwb_ebuf, "in bwb_name(): old name is <%s>", atbuf );
  987.    bwb_debug( bwb_ebuf );
  988.    #endif
  989.  
  990.    /* get the second argument in btbuf */
  991.  
  992.    adv_element( l->buffer, &( l->position ), btbuf  );
  993.    bwb_strtoupper( btbuf );
  994.  
  995.    #if INTENSIVE_DEBUG
  996.    sprintf( bwb_ebuf, "in bwb_name(): AS string is <%s>", btbuf );
  997.    bwb_debug( bwb_ebuf );
  998.    #endif
  999.  
  1000.    if ( strcmp( btbuf, "AS" ) != 0 )
  1001.       {
  1002.       bwb_error( err_syntax );
  1003.       l->next->position = 0;
  1004.       return l->next;
  1005.       }
  1006.  
  1007.    /* get the third argument in btbuf */
  1008.  
  1009.    adv_element( l->buffer, &( l->position ), btbuf  );
  1010.  
  1011.    /* interpret the third argument */
  1012.  
  1013.    position = 0;
  1014.    e = bwb_exp( btbuf, FALSE, &position );
  1015.  
  1016.    if ( e->type != STRING )
  1017.       {
  1018.       bwb_error( err_argstr );
  1019.       l->next->position = 0;
  1020.       return l->next;
  1021.       }
  1022.  
  1023.    str_btoc( btbuf, &( e->sval ) );
  1024.  
  1025.    #if INTENSIVE_DEBUG
  1026.    sprintf( bwb_ebuf, "in bwb_name(): new name is <%s>", btbuf );
  1027.    bwb_debug( bwb_ebuf );
  1028.    #endif
  1029.  
  1030.    /* try to rename the file */
  1031.  
  1032.    r = rename( atbuf, btbuf );
  1033.  
  1034.    /* detect error */
  1035.  
  1036.    if ( r != 0 )
  1037.       {
  1038.       bwb_error( err_opsys );
  1039.       }
  1040.  
  1041.    l->next->position = 0;
  1042.    return l->next;
  1043.  
  1044.    }
  1045.  
  1046. /***************************************************************
  1047.  
  1048.         FUNCTION:       bwb_field()
  1049.  
  1050.         DESCRIPTION:    This C function implements the BASIC
  1051.             FIELD command.
  1052.  
  1053. ***************************************************************/
  1054.  
  1055. struct bwb_line *
  1056. bwb_field( struct bwb_line *l )
  1057.    {
  1058.    int dev_number;
  1059.    int length;
  1060.    struct exp_ese *e;
  1061.    struct bwb_variable *v;
  1062.    bstring *b;
  1063.    int current_pos;
  1064.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1065.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1066.  
  1067.    current_pos = 0;
  1068.  
  1069.    /* first read device number */
  1070.  
  1071.    adv_ws( l->buffer, &( l->position ) );
  1072.    if ( l->buffer[ l->position ] =='#' )
  1073.       {
  1074.       ++( l->position );
  1075.       }
  1076.  
  1077.    adv_element( l->buffer, &( l->position ), atbuf );
  1078.  
  1079.    #if INTENSIVE_DEBUG
  1080.    sprintf( bwb_ebuf, "in bwb_field(): device # buffer <%s>", atbuf );
  1081.    bwb_debug( bwb_ebuf );
  1082.    #endif
  1083.  
  1084.    pos = 0;
  1085.    e = bwb_exp( atbuf, FALSE, &pos );
  1086.  
  1087.    if ( e->type != INTEGER )
  1088.       {
  1089.       #if PROG_ERRORS
  1090.       bwb_error( "in bwb_field(): Integer was expected for device number" );
  1091.       #else
  1092.       bwb_error( err_syntax );
  1093.       #endif
  1094.       return l;
  1095.       }
  1096.  
  1097.    dev_number = exp_getival( e );
  1098.  
  1099.    #if INTENSIVE_DEBUG
  1100.    sprintf( bwb_ebuf, "in bwb_field(): device <%d>", dev_number );
  1101.    bwb_debug( bwb_ebuf );
  1102.    #endif
  1103.  
  1104.    /* be sure that the requested device is open */
  1105.  
  1106.    if (( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1107.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1108.       {
  1109.       #if PROG_ERRORS
  1110.       bwb_error( "in bwb_field(): Requested device number is not in use." );
  1111.       #else
  1112.       bwb_error( err_devnum );
  1113.       #endif
  1114.       return l;
  1115.       }
  1116.  
  1117.    /* loop to read variables */
  1118.  
  1119.    do
  1120.       {
  1121.  
  1122.       /* read the comma and advance beyond it */
  1123.  
  1124.       adv_ws( l->buffer, &( l->position ) );
  1125.       if ( l->buffer[ l->position ] ==',' )
  1126.          {
  1127.          ++( l->position );
  1128.          }
  1129.  
  1130.       /* first find the size of the field */
  1131.  
  1132.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1133.  
  1134.       pos = 0;
  1135.       e = bwb_exp( atbuf, FALSE, &pos );
  1136.  
  1137.       if ( e->type != INTEGER )
  1138.          {
  1139.      #if PROG_ERRORS
  1140.          bwb_error( "in bwb_field(): integer value for field size not found" );
  1141.          #else
  1142.          bwb_error( err_syntax );
  1143.          #endif
  1144.          return l;
  1145.          }
  1146.  
  1147.       length = exp_getival( e );
  1148.  
  1149.       #if INTENSIVE_DEBUG
  1150.       sprintf( bwb_ebuf, "in bwb_field(): device <%d> length <%d> buf <%s>",
  1151.          dev_number, length, &( l->buffer[ l->position ] ) );
  1152.       bwb_debug( bwb_ebuf );
  1153.       #endif
  1154.  
  1155.       /* read the AS */
  1156.  
  1157.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1158.       bwb_strtoupper( atbuf );
  1159.  
  1160.       #if INTENSIVE_DEBUG
  1161.       sprintf( bwb_ebuf, "in bwb_field(): AS element <%s>", atbuf );
  1162.       bwb_debug( bwb_ebuf );
  1163.       #endif
  1164.  
  1165.       if ( strncmp( atbuf, "AS", 2 ) != 0 )
  1166.          {
  1167.      #if PROG_ERRORS
  1168.          bwb_error( "in bwb_field(): AS statement not found" );
  1169.          #else
  1170.          bwb_error( err_syntax );
  1171.          #endif
  1172.          return l;
  1173.          }
  1174.  
  1175.       /* read the string variable name */
  1176.  
  1177.       adv_element( l->buffer, &( l->position ), atbuf );    /* get element */
  1178.       v = var_find( atbuf );
  1179.  
  1180.       if ( v->type != STRING )
  1181.          {
  1182.      #if PROG_ERRORS
  1183.          bwb_error( "in bwb_field(): string variable name not found" );
  1184.          #else
  1185.          bwb_error( err_syntax );
  1186.          #endif
  1187.          return l;
  1188.          }
  1189.  
  1190.       #if INTENSIVE_DEBUG
  1191.       sprintf( bwb_ebuf, "in bwb_field(): device <%d> var <%s> length <%d>",
  1192.          dev_number, v->name, length );
  1193.       bwb_debug( bwb_ebuf );
  1194.       #endif
  1195.  
  1196.       /* check for overflow of record length */
  1197.  
  1198.       if ( ( current_pos + length ) > dev_table[ dev_number ].reclen )
  1199.          {
  1200.      #if PROG_ERRORS
  1201.          bwb_error( "in bwb_field(): record length exceeded" );
  1202.          #else
  1203.          bwb_error( err_overflow );
  1204.          #endif
  1205.          return l;
  1206.          }
  1207.  
  1208.       /* set buffer */
  1209.  
  1210.       b = var_findsval( v, v->array_pos );
  1211.       if ( b->buffer != NULL )
  1212.          {
  1213.          free( b->buffer );
  1214.          }
  1215.       b->buffer = dev_table[ dev_number ].buffer + current_pos;
  1216.       b->length = (unsigned char) length;
  1217.       b->rab = TRUE;
  1218.  
  1219.       current_pos += length;
  1220.  
  1221.       #if INTENSIVE_DEBUG
  1222.       sprintf( bwb_ebuf, "in bwb_field(): buffer <%lXh> var <%s> buffer <%lXh>",
  1223.          (long) dev_table[ dev_number ].buffer, v->name, (long) b->buffer );
  1224.       bwb_debug( bwb_ebuf );
  1225.       #endif
  1226.  
  1227.       /* eat up any remaining whitespace */
  1228.  
  1229.       adv_ws( l->buffer, &( l->position ) );
  1230.  
  1231.       }
  1232.  
  1233.    while ( l->buffer[ l->position ] == ',' );
  1234.  
  1235.    /* return */
  1236.  
  1237.    return l;
  1238.  
  1239.    }
  1240.  
  1241. /***************************************************************
  1242.  
  1243.         FUNCTION:       bwb_lset()
  1244.  
  1245.         DESCRIPTION:    This C function implements the BASIC
  1246.             LSET command.
  1247.  
  1248. ***************************************************************/
  1249.  
  1250. struct bwb_line *
  1251. bwb_lset( struct bwb_line *l )
  1252.    {
  1253.    return dio_lrset( l, FALSE );
  1254.    }
  1255.    
  1256. /***************************************************************
  1257.  
  1258.         FUNCTION:       bwb_rset()
  1259.  
  1260.         DESCRIPTION:    This C function implements the BASIC
  1261.             RSET command.
  1262.  
  1263. ***************************************************************/
  1264.  
  1265. struct bwb_line *
  1266. bwb_rset( struct bwb_line *l )
  1267.    {
  1268.    return dio_lrset( l, TRUE );
  1269.    }
  1270.  
  1271. /***************************************************************
  1272.  
  1273.         FUNCTION:       dio_lrset()
  1274.  
  1275.         DESCRIPTION:    This C function implements the BASIC
  1276.             RSET and LSET commands.
  1277.  
  1278. ***************************************************************/
  1279.  
  1280. struct bwb_line *
  1281. dio_lrset( struct bwb_line *l, int rset )
  1282.    {
  1283.    char varname[ MAXVARNAMESIZE + 1 ];
  1284.    bstring *d, *s;
  1285.    int *pp;
  1286.    int n_params;
  1287.    int p;
  1288.    register int n, i;
  1289.    int startpos;
  1290.    struct exp_ese *e;
  1291.  
  1292.    /* find the variable name */
  1293.  
  1294.    bwb_getvarname( l->buffer, varname, &( l->position ));
  1295.  
  1296.    v = var_find( varname );
  1297.  
  1298.    if ( v == NULL )
  1299.       {
  1300.       #if PROG_ERRORS
  1301.       sprintf( bwb_ebuf, "in dio_lrset(): failed to find variable" );
  1302.       bwb_error( bwb_ebuf );
  1303.       #else
  1304.       bwb_error( err_syntax );
  1305.       #endif
  1306.       }
  1307.  
  1308.    if ( v->type != STRING )
  1309.       {
  1310.       #if PROG_ERRORS
  1311.       sprintf( bwb_ebuf, "in dio_lrset(): assignment must be to string variable" );
  1312.       bwb_error( bwb_ebuf );
  1313.       #else
  1314.       bwb_error( err_syntax );
  1315.       #endif
  1316.       }
  1317.  
  1318.    /* read subscripts */
  1319.  
  1320.    pos = 0;
  1321.    if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 ))
  1322.       {
  1323.       #if INTENSIVE_DEBUG
  1324.       sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has 1 dimension",
  1325.          v->name );
  1326.       bwb_debug( bwb_ebuf );
  1327.       #endif
  1328.       n_params = 1;
  1329.       pp = &p;
  1330.       pp[ 0 ] = dim_base;
  1331.       }
  1332.    else
  1333.       {
  1334.       #if INTENSIVE_DEBUG
  1335.       sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has > 1 dimensions",
  1336.          v->name );
  1337.       bwb_debug( bwb_ebuf );
  1338.       #endif
  1339.       dim_getparams( l->buffer, &( l->position ), &n_params, &pp );
  1340.       }
  1341.  
  1342.    exp_es[ exp_esc ].pos_adv = pos;
  1343.    for ( n = 0; n < v->dimensions; ++n )
  1344.       {
  1345.       v->array_pos[ n ] = pp[ n ];
  1346.       }
  1347.  
  1348.    /* get bstring pointer */
  1349.  
  1350.    d = var_findsval( v, pp );
  1351.  
  1352.    /* find equals sign */
  1353.  
  1354.    adv_ws( l->buffer, &( l->position ));
  1355.    if ( l->buffer[ l->position ] != '=' )
  1356.       {
  1357.       #if PROG_ERRORS
  1358.       sprintf( bwb_ebuf, "in dio_lrset(): failed to find equal sign" );
  1359.       bwb_error( bwb_ebuf );
  1360.       #else
  1361.       bwb_error( err_syntax );
  1362.       #endif
  1363.       }
  1364.    ++( l->position );
  1365.    adv_ws( l->buffer, &( l->position ));
  1366.  
  1367.    /* read remainder of line to get value */
  1368.  
  1369.    e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  1370.    s = exp_getsval( e );
  1371.  
  1372.    /* set starting position */
  1373.  
  1374.    startpos = 0;
  1375.    if ( rset == TRUE )
  1376.       {
  1377.       if ( s->length < d->length )
  1378.          {
  1379.          startpos = d->length - s->length;
  1380.          }
  1381.       }
  1382.  
  1383.    #if INTENSIVE_DEBUG
  1384.    sprintf( bwb_ebuf, "in dio_lrset(): startpos <%d> buffer <%lX>", 
  1385.       startpos, (long) d->buffer );
  1386.    bwb_debug( bwb_ebuf );
  1387.    #endif
  1388.  
  1389.    /* write characters to new position */
  1390.  
  1391.    i = 0;
  1392.    for ( n = startpos; ( i < s->length ) && ( n < d->length ); ++n )
  1393.       {
  1394.       d->buffer[ n ] = s->buffer[ i ];
  1395.       ++i;
  1396.       }
  1397.  
  1398.    /* return */
  1399.  
  1400.    return l;
  1401.  
  1402.    }
  1403.  
  1404. /***************************************************************
  1405.  
  1406.         FUNCTION:       bwb_get()
  1407.  
  1408.         DESCRIPTION:    This C function implements the BASIC
  1409.             GET command.
  1410.  
  1411. ***************************************************************/
  1412.  
  1413. struct bwb_line *
  1414. bwb_get( struct bwb_line *l )
  1415.    {
  1416.    int dev_number;
  1417.    int rec_number;
  1418.    register int i;
  1419.    struct exp_ese *e;
  1420.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1421.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1422.  
  1423.    /* first read device number */
  1424.  
  1425.    adv_ws( l->buffer, &( l->position ) );
  1426.    if ( l->buffer[ l->position ] =='#' )
  1427.       {
  1428.       ++( l->position );
  1429.       }
  1430.  
  1431.    adv_element( l->buffer, &( l->position ), atbuf );
  1432.  
  1433.    pos = 0;
  1434.    e = bwb_exp( atbuf, FALSE, &pos );
  1435.  
  1436.    if ( e->type != INTEGER )
  1437.       {
  1438.       #if PROG_ERRORS
  1439.       bwb_error( "in bwb_get(): Integer was expected for device number" );
  1440.       #else
  1441.       bwb_error( err_syntax );
  1442.       #endif
  1443.       return l;
  1444.       }
  1445.  
  1446.    dev_number = exp_getival( e );
  1447.  
  1448.    #if INTENSIVE_DEBUG
  1449.    sprintf( bwb_ebuf, "in bwb_get(): device <%d>", dev_number );
  1450.    bwb_debug( bwb_ebuf );
  1451.    #endif
  1452.  
  1453.    /* be sure that the requested device is open */
  1454.  
  1455.    if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1456.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1457.       {
  1458.       #if PROG_ERRORS
  1459.       bwb_error( "in bwb_get(): Requested device number is not in use." );
  1460.       #else
  1461.       bwb_error( err_devnum );
  1462.       #endif
  1463.       return l;
  1464.       }
  1465.  
  1466.    /* see if there is a comma (and record number) */
  1467.  
  1468.    adv_ws( l->buffer, &( l->position ) );
  1469.    if ( l->buffer[ l->position ] == ',' )    /* yes, there is a comma */
  1470.       {
  1471.       ++( l->position );
  1472.  
  1473.       /* get the record number element */
  1474.  
  1475.       adv_element( l->buffer, &( l->position ), atbuf );
  1476.  
  1477.       pos = 0;
  1478.       e = bwb_exp( atbuf, FALSE, &pos );
  1479.       rec_number = exp_getival( e );
  1480.  
  1481.       }
  1482.  
  1483.    else                /* no record number given */
  1484.       {
  1485.       rec_number = dev_table[ dev_number ].next_record;
  1486.       }
  1487.  
  1488.    #if INTENSIVE_DEBUG
  1489.    sprintf( bwb_ebuf, "in bwb_get(): record number <%d>", rec_number );
  1490.    bwb_debug( bwb_ebuf );
  1491.    #endif
  1492.  
  1493.    /* wind the c file up to the proper point */
  1494.  
  1495.    if ( fseek( dev_table[ dev_number ].cfp,
  1496.       (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), 
  1497.       SEEK_SET ) != 0 )
  1498.       {
  1499.       #if PROG_ERRORS
  1500.       sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
  1501.         rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
  1502.       bwb_error( bwb_ebuf );
  1503.       #else
  1504.       bwb_error( err_dev );
  1505.       #endif
  1506.       return l;
  1507.       }
  1508.  
  1509.    /* read the requested bytes into the buffer */
  1510.  
  1511.    for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
  1512.       {
  1513.       dev_table[ dev_number ].buffer[ i ] =
  1514.          (char) fgetc( dev_table[ dev_number ].cfp );
  1515.       ++( dev_table[ dev_number ].loc );
  1516.       }
  1517.  
  1518.    /* increment (or reset) the current record */
  1519.  
  1520.    dev_table[ dev_number ].next_record = rec_number + 1;
  1521.  
  1522.    return l;
  1523.  
  1524.    }
  1525.  
  1526. /***************************************************************
  1527.  
  1528.         FUNCTION:       bwb_put()
  1529.  
  1530.         DESCRIPTION:    This C function implements the BASIC
  1531.             PUT command.
  1532.  
  1533. ***************************************************************/
  1534.  
  1535. struct bwb_line *
  1536. bwb_put( struct bwb_line *l )
  1537.    {
  1538.    int dev_number;
  1539.    int rec_number;
  1540.    register int i;
  1541.    struct exp_ese *e;
  1542.    struct bwb_variable *v;
  1543.    char atbuf[ MAXSTRINGSIZE + 1 ];
  1544.    char btbuf[ MAXSTRINGSIZE + 1 ];
  1545.  
  1546.    /* first read device number */
  1547.  
  1548.    adv_ws( l->buffer, &( l->position ) );
  1549.    if ( l->buffer[ l->position ] =='#' )
  1550.       {
  1551.       ++( l->position );
  1552.       }
  1553.  
  1554.    adv_element( l->buffer, &( l->position ), atbuf );
  1555.    dev_number = atoi( atbuf );
  1556.  
  1557.    #if INTENSIVE_DEBUG
  1558.    sprintf( bwb_ebuf, "in bwb_put(): device <%d>", dev_number );
  1559.    bwb_debug( bwb_ebuf );
  1560.    #endif
  1561.  
  1562.    /* be sure that the requested device is open */
  1563.  
  1564.    if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
  1565.       ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
  1566.       {
  1567.       #if PROG_ERRORS
  1568.       bwb_error( "in bwb_put(): Requested device number is not in use." );
  1569.       #else
  1570.       bwb_error( err_devnum );
  1571.       #endif
  1572.       return l;
  1573.       }
  1574.  
  1575.    /* see if there is a comma (and record number) */
  1576.  
  1577.    adv_ws( l->buffer, &( l->position ) );
  1578.    if ( l->buffer[ l->position ] == ',' )    /* yes, there is a comma */
  1579.       {
  1580.       ++( l->position );
  1581.  
  1582.       /* get the record number element */
  1583.  
  1584.       adv_element( l->buffer, &( l->position ), atbuf );
  1585.  
  1586.       #if INTENSIVE_DEBUG
  1587.       sprintf( bwb_ebuf, "in bwb_put(): rec no buffer <%s>", atbuf );
  1588.       bwb_debug( bwb_ebuf );
  1589.       #endif
  1590.  
  1591.       pos = 0;
  1592.       e = bwb_exp( atbuf, FALSE, &pos );
  1593.  
  1594.       #if INTENSIVE_DEBUG
  1595.       sprintf( bwb_ebuf, "in bwb_put(): return type <%c>", e->type );
  1596.       bwb_debug( bwb_ebuf );
  1597.       #endif
  1598.  
  1599.       rec_number = exp_getival( e );
  1600.  
  1601.       }
  1602.  
  1603.    else                /* no record number given */
  1604.       {
  1605.       rec_number = dev_table[ dev_number ].next_record;
  1606.       }
  1607.  
  1608.    #if INTENSIVE_DEBUG
  1609.    sprintf( bwb_ebuf, "in bwb_put(): record number <%d>", rec_number );
  1610.    bwb_debug( bwb_ebuf );
  1611.    #endif
  1612.  
  1613.    /* wind the c file up to the proper point */
  1614.  
  1615.    if ( fseek( dev_table[ dev_number ].cfp,
  1616.       (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ), 
  1617.       SEEK_SET ) != 0 )
  1618.       {
  1619.       #if PROG_ERRORS
  1620.       sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
  1621.         rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
  1622.       bwb_error( bwb_ebuf );
  1623.       #else
  1624.       bwb_error( err_dev );
  1625.       #endif
  1626.       return l;
  1627.       }
  1628.  
  1629.    #if INTENSIVE_DEBUG
  1630.    sprintf( bwb_ebuf, "in bwb_put(): ready to write to file, buffer <%lXh>",
  1631.       (long) dev_table[ dev_number ].buffer );
  1632.    bwb_debug( bwb_ebuf );
  1633.    xprintf( stderr, "Buffer: <" );
  1634.    #endif
  1635.  
  1636.    /* write the requested bytes to the file */
  1637.  
  1638.    for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
  1639.       {
  1640.       fputc( dev_table[ dev_number ].buffer[ i ],
  1641.          dev_table[ dev_number ].cfp );
  1642.       #if INTENSIVE_DEBUG
  1643.       xputc( stderr, dev_table[ dev_number ].buffer[ i ] );
  1644.       #endif
  1645.       ++( dev_table[ dev_number ].loc );
  1646.       }
  1647.  
  1648.    #if INTENSIVE_DEBUG
  1649.    xprintf( stderr, ">\n" );
  1650.    sprintf( bwb_ebuf, "in bwb_put(): write to file complete" );
  1651.    bwb_debug( bwb_ebuf );
  1652.    #endif
  1653.  
  1654.    /* flush the buffer */
  1655.  
  1656.    dio_flush( dev_number );
  1657.  
  1658.    /* increment (or reset) the current record */
  1659.  
  1660.    dev_table[ dev_number ].next_record = rec_number + 1;
  1661.  
  1662.    return l;
  1663.  
  1664.    }
  1665.  
  1666. /***************************************************************
  1667.  
  1668.         FUNCTION:       dio_flush()
  1669.  
  1670.         DESCRIPTION:    This C function flushes the random-access
  1671.             buffer associated with file dev_number.
  1672.  
  1673. ***************************************************************/
  1674.  
  1675. int
  1676. dio_flush( int dev_number )
  1677.    {
  1678.    register int n;
  1679.  
  1680.    if ( dev_table[ dev_number ].mode != DEVMODE_RANDOM )
  1681.       {
  1682.       #if PROG_ERRORS
  1683.       sprintf( bwb_ebuf, "in dio_flush(): only random-access buffers can be flushed" );
  1684.       bwb_error( bwb_ebuf );
  1685.       #else
  1686.       bwb_error( err_dev );
  1687.       #endif
  1688.       }
  1689.  
  1690.    /* fill buffer with blanks (or 'X' for test) */
  1691.  
  1692.    for ( n = 0; n < dev_table[ req_devnumber ].reclen; ++n )
  1693.       {
  1694.       dev_table[ req_devnumber ].buffer[ n ] = RANDOM_FILLCHAR;
  1695.       }
  1696.  
  1697.    return TRUE;
  1698.  
  1699.    }
  1700.  
  1701. /***************************************************************
  1702.  
  1703.         FUNCTION:       fnc_loc()
  1704.  
  1705.         DESCRIPTION:    This C function implements the BASIC
  1706.             LOC() function. As implemented here,
  1707.             this only workd for random-acess files.
  1708.  
  1709. ***************************************************************/
  1710.  
  1711. struct bwb_variable *
  1712. fnc_loc( int argc, struct bwb_variable *argv )
  1713.    {
  1714.    static struct bwb_variable nvar;
  1715.    static int init = FALSE;
  1716.    int dev_number;
  1717.  
  1718.    #if INTENSIVE_DEBUG
  1719.    sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
  1720.       var_getdval( &( argv[ 0 ] ) ) );
  1721.    bwb_debug( bwb_ebuf );
  1722.    #endif
  1723.  
  1724.    if ( argc < 1 )
  1725.       {
  1726.       #if PROG_ERRORS
  1727.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOC().",
  1728.          argc );
  1729.       bwb_error( bwb_ebuf );
  1730.       #else
  1731.       bwb_error( err_syntax );
  1732.       #endif
  1733.       return NULL;
  1734.       }
  1735.    else if ( argc > 1 )
  1736.       {
  1737.       #if PROG_ERRORS
  1738.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LOC().",
  1739.          argc );
  1740.       bwb_error( bwb_ebuf );
  1741.       #else
  1742.       bwb_error( err_syntax );
  1743.       #endif
  1744.       return NULL;
  1745.       }
  1746.  
  1747.    dev_number = var_getival( &( argv[ 0 ] ) );
  1748.  
  1749.    if ( init == FALSE )
  1750.       {
  1751.       init = TRUE;
  1752.       var_make( &nvar, INTEGER );
  1753.       }
  1754.  
  1755.    /* note if this is the very beginning of the file */
  1756.  
  1757.    if ( dev_table[ dev_number ].loc == 0 )
  1758.       {
  1759.       * var_findival( &nvar, nvar.array_pos ) = 0;
  1760.       }
  1761.    else
  1762.       {
  1763.       * var_findival( &nvar, nvar.array_pos ) =
  1764.          dev_table[ dev_number ].next_record;
  1765.       }
  1766.  
  1767.    return &nvar;
  1768.    }
  1769.  
  1770. /***************************************************************
  1771.  
  1772.         FUNCTION:       fnc_lof()
  1773.  
  1774.         DESCRIPTION:    This C function implements the BASIC
  1775.             LOF() function. 
  1776.  
  1777. ***************************************************************/
  1778.  
  1779. struct bwb_variable *
  1780. fnc_lof( int argc, struct bwb_variable *argv )
  1781.    {
  1782.    static struct bwb_variable nvar;
  1783.    static int init = FALSE;
  1784.    int dev_number;
  1785.    int r;
  1786.    static struct stat statbuf;
  1787.  
  1788.    #if INTENSIVE_DEBUG
  1789.    sprintf( bwb_ebuf, "in fnc_lof(): received f_arg <%f> ",
  1790.       var_getdval( &( argv[ 0 ] ) ) );
  1791.    bwb_debug( bwb_ebuf );
  1792.    #endif
  1793.  
  1794.    if ( argc < 1 )
  1795.       {
  1796.       #if PROG_ERRORS
  1797.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function LOF().",
  1798.          argc );
  1799.       bwb_error( bwb_ebuf );
  1800.       #else
  1801.       bwb_error( err_syntax );
  1802.       #endif
  1803.       return NULL;
  1804.       }
  1805.    else if ( argc > 1 )
  1806.       {
  1807.       #if PROG_ERRORS
  1808.       sprintf( bwb_ebuf, "Too many parameters (%d) to function LOF().",
  1809.          argc );
  1810.       bwb_error( bwb_ebuf );
  1811.       #else
  1812.       bwb_error( err_syntax );
  1813.       #endif
  1814.       return NULL;
  1815.       }
  1816.  
  1817.    dev_number = var_getival( &( argv[ 0 ] ) );
  1818.  
  1819.    if ( init == FALSE )
  1820.       {
  1821.       init = TRUE;
  1822.       var_make( &nvar, SINGLE );
  1823.       }
  1824.  
  1825.    /* stat the file */
  1826.  
  1827.    r = stat( dev_table[ dev_number ].filename, &statbuf );
  1828.  
  1829.    if ( r != 0 )
  1830.       {
  1831.       #if PROG_ERRORS
  1832.       sprintf( bwb_ebuf, "in fnc_lof(): failed to find file <%s>",
  1833.          dev_table[ dev_number ].filename );
  1834.       bwb_error( bwb_ebuf );
  1835.       #else
  1836.       sprintf( bwb_ebuf, ERR_OPENFILE,
  1837.          dev_table[ dev_number ].filename );
  1838.       bwb_error( bwb_ebuf );
  1839.       #endif
  1840.       return NULL;
  1841.       }
  1842.  
  1843.    * var_findfval( &nvar, nvar.array_pos ) = (float) statbuf.st_size;
  1844.  
  1845.    return &nvar;
  1846.    }
  1847.  
  1848. /***************************************************************
  1849.  
  1850.         FUNCTION:       fnc_eof()
  1851.  
  1852.         DESCRIPTION:    This C function implements the BASIC
  1853.             EOF() function. 
  1854.  
  1855. ***************************************************************/
  1856.  
  1857. struct bwb_variable *
  1858. fnc_eof( int argc, struct bwb_variable *argv )
  1859.    {
  1860.    static struct bwb_variable nvar;
  1861.    static int init = FALSE;
  1862.    int dev_number;
  1863.  
  1864.    #if INTENSIVE_DEBUG
  1865.    sprintf( bwb_ebuf, "in fnc_loc(): received f_arg <%f> ",
  1866.       var_getdval( &( argv[ 0 ] ) ) );
  1867.    bwb_debug( bwb_ebuf );
  1868.    #endif
  1869.  
  1870.    if ( argc < 1 )
  1871.       {
  1872.       #if PROG_ERRORS
  1873.       sprintf( bwb_ebuf, "Not enough parameters (%d) to function EOF().",
  1874.          argc );
  1875.       bwb_error( bwb_ebuf );
  1876.       #else
  1877.       bwb_error( err_syntax );
  1878.       #endif
  1879.       return NULL;
  1880.       }
  1881.    else if ( argc > 1 )
  1882.       {
  1883.       #if PROG_ERRORS
  1884.       sprintf( bwb_ebuf, "Too many parameters (%d) to function EOF().",
  1885.          argc );
  1886.       bwb_error( bwb_ebuf );
  1887.       #else
  1888.       bwb_error( err_syntax );
  1889.       #endif
  1890.       return NULL;
  1891.       }
  1892.  
  1893.    dev_number = var_getival( &( argv[ 0 ] ) );
  1894.  
  1895.    if ( init == FALSE )
  1896.       {
  1897.       init = TRUE;
  1898.       var_make( &nvar, INTEGER );
  1899.       }
  1900.  
  1901.    /* note if this is the very beginning of the file */
  1902.  
  1903.    if ( dev_table[ dev_number ].mode == DEVMODE_AVAILABLE )
  1904.       {
  1905.       bwb_error( err_devnum );
  1906.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1907.       }
  1908.    else if ( dev_table[ dev_number ].mode == DEVMODE_CLOSED )
  1909.       {
  1910.       bwb_error( err_devnum );
  1911.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1912.       }
  1913.    else if ( feof( dev_table[ dev_number ].cfp ) == 0 )
  1914.       {
  1915.       * var_findival( &nvar, nvar.array_pos ) = FALSE;
  1916.       }
  1917.    else
  1918.       {
  1919.       * var_findival( &nvar, nvar.array_pos ) = TRUE;
  1920.       }
  1921.  
  1922.    return &nvar;
  1923.    }
  1924.  
  1925.  
  1926.