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