|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893 |
- /***************************************************************
-
- bwb_dio.c Device Input/Output Routines
- for Bywater BASIC Interpreter
-
- Copyright (c) 1993, Ted A. Campbell
- Bywater Software
-
- email: tcamp@delphi.com
-
- Copyright and Permissions Information:
-
- All U.S. and international rights are claimed by the author,
- Ted A. Campbell.
-
- This software is released under the terms of the GNU General
- Public License (GPL), which is distributed with this software
- in the file "COPYING". The GPL specifies the terms under
- which users may copy and use the software in this distribution.
-
- A separate license is available for commercial distribution,
- for information on which you should contact the author.
-
- ***************************************************************/
-
- /*---------------------------------------------------------------*/
- /* NOTE: Modifications marked "JBV" were made by Jon B. Volkoff, */
- /* 11/1995 (eidetics@cerf.net). */
- /*---------------------------------------------------------------*/
-
- #include <stdio.h>
-
- #include "bwbasic.h"
- #include "bwb_mes.h"
-
- #if HAVE_SYSSTAT
- #include <sys/stat.h>
- #endif
-
- #ifndef SEEK_SET
- #define SEEK_SET 0
- #endif
-
- #if INTENSIVE_DEBUG
- #define RANDOM_FILLCHAR 'X'
- #else
- #define RANDOM_FILLCHAR ' '
- #endif
-
- #if COMMON_CMDS
- struct dev_element *dev_table; /* table of devices */
- #endif
-
- static struct bwb_variable *v;
- static int pos;
- static int req_devnumber;
- static int rlen;
- static int mode;
-
- #if ANSI_C
- static struct bwb_line *dio_lrset( struct bwb_line *l, int rset );
- static int dio_flush( int dev_number );
- #else
- static struct bwb_line *dio_lrset();
- static int dio_flush();
- #endif
-
- #if COMMON_CMDS
-
- /***************************************************************
-
- FUNCTION: bwb_open()
-
- DESCRIPTION: This function implements the BASIC OPEN
- command to open a stream for device input/output.
-
- SYNTAX: 1. OPEN "I"|"O"|"R", [#]n, filename [,rlen]
- 2. OPEN filename [FOR INPUT|OUTPUT|APPEND|] AS [#]n [LEN=n]
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_open( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_open( l )
- struct bwb_line *l;
- #endif
- {
- FILE *fp;
- struct exp_ese *e;
- int previous_buffer;
- char atbuf[ MAXSTRINGSIZE + 1 ];
- char first[ MAXSTRINGSIZE + 1 ];
- char devname[ MAXSTRINGSIZE + 1 ];
-
- /* initialize */
-
- mode = req_devnumber = rlen = -1;
- previous_buffer = FALSE;
-
- /* get the first expression element up to comma or whitespace */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- /* parse the first expression element */
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- str_btoc( first, exp_getsval( e ) );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): first element is <%s>",
- first );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* test for syntactical form: if a comma follows the first element,
- then the syntax is form 1 (the old CP/M BASIC format); otherwise we
- presume form 2 */
-
- adv_ws( l->buffer, &( l->position ) );
-
- /* Parse syntax Form 1 (OPEN "x",#n, devname...) */
-
- if ( l->buffer[ l->position ] == ',' )
- {
-
- /* parse the next element to get the device number */
-
- ++( l->position ); /* advance beyond comma */
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] == '#' )
- {
- ++( l->position );
- adv_ws( l->buffer, &( l->position ) );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- if ( e->type == STRING )
- {
- #if PROG_ERRORS
- bwb_error( "String where number was expected for device number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- req_devnumber = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 1, req dev number is %d",
- req_devnumber );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* parse the next element to get the devname */
-
- adv_ws( l->buffer, &( l->position ) ); /* advance past whitespace */
- ++( l->position ); /* advance past comma */
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- if ( e->type != STRING )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): number where string was expected for devname" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- str_btoc( devname, exp_getsval( e ) );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 1, devname <%s>",
- devname );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* see if there is another element; if so, parse it to get the
- record length */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] == ',' )
- {
-
- ++( l->position ); /* advance beyond comma */
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- if ( e->type == STRING )
- {
- #if PROG_ERRORS
- bwb_error( "String where number was expected for record length" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- rlen = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 1, record length is %d",
- rlen );
- bwb_debug( bwb_ebuf );
- #endif
-
- }
-
- /* the first letter of the first should indicate the
- type of file opening requested: test this letter,
- then parse accordingly */
-
- /* open file for sequential INPUT */
-
- if ( ( first[ 0 ] == 'i' ) || ( first[ 0 ] == 'I' ))
- {
- mode = DEVMODE_INPUT;
- }
-
- /* open file for sequential OUTPUT */
-
- else if ( ( first[ 0 ] == 'o' ) || ( first[ 0 ] == 'O' ))
- {
- mode = DEVMODE_OUTPUT;
- }
-
- /* open file for RANDOM access input and output */
-
- else if ( ( first[ 0 ] == 'r' ) || ( first[ 0 ] == 'R' ))
- {
- mode = DEVMODE_RANDOM;
- }
-
- /* error: none of the appropriate modes found */
-
- else
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in bwb_open(): invalid mode" );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_syntax );
- #endif
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 1, mode is %d", mode );
- bwb_debug( bwb_ebuf );
- #endif
-
- }
-
- /* Parse syntax Form 2 (OPEN devname FOR mode AS#n ... ) */
-
- else
- {
-
- /* save the devname from first */
-
- strcpy( devname, first );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 2, devname <%s>",
- devname );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* get the next element */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- /* check for "FOR mode" statement */
-
- bwb_strtoupper( atbuf );
- if ( strcmp( atbuf, "FOR" ) == 0 )
- {
- adv_element( l->buffer, &( l->position ), atbuf );
- bwb_strtoupper( atbuf );
- if ( strcmp( atbuf, "INPUT" ) == 0 )
- {
- mode = DEVMODE_INPUT;
- }
- else if ( strcmp( atbuf, "OUTPUT" ) == 0 )
- {
- mode = DEVMODE_OUTPUT;
- }
- else if ( strcmp( atbuf, "APPEND" ) == 0 )
- {
- mode = DEVMODE_RANDOM;
- }
- else
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): Invalid device i/o mode specified" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- /* get the next element */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- }
- else
- {
- mode = DEVMODE_RANDOM;
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 2, mode is %d", mode );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* This leaves us with the next element in the atbuf: it
- should read "AS" */
-
- bwb_strtoupper( atbuf );
- if ( strcmp( atbuf, "AS" ) != 0 )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): expected AS statement" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- /* get the next element */
-
- adv_ws( l->buffer, &( l->position ) );
-
- if ( l->buffer[ l->position ] == '#' )
- {
- ++( l->position );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): string to parse for req dev number <%s>",
- atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- if ( e->type == STRING )
- {
- #if PROG_ERRORS
- bwb_error( "String where number was expected for dev number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- req_devnumber = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 2, req dev number is %d",
- req_devnumber );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* Check for LEN = n statement */
-
- adv_element( l->buffer, &( l->position ), atbuf );
- bwb_strtoupper( atbuf );
- if ( strncmp( atbuf, "LEN", (size_t) 3 ) == 0 )
- {
-
- pos = l->position - strlen( atbuf );
- while( ( l->buffer[ pos ] != '=' ) && ( l->buffer[ pos ] != '\0' ))
- {
- ++pos;
- }
- if ( l->buffer[ pos ] == '\0' )
- {
- #if PROG_ERRORS
- bwb_error( "Failed to find equals sign after LEN element" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- ++pos; /* advance past equal sign */
-
- e = bwb_exp( l->buffer, FALSE, &pos );
-
- if ( e->type == STRING )
- {
- #if PROG_ERRORS
- bwb_error( "String where number was expected for record length" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
- rlen = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): syntax 2, record length is %d",
- rlen );
- bwb_debug( bwb_ebuf );
- #endif
-
- }
-
- } /* end of syntax 2 */
-
- /* check for valid requested device number */
-
- if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): Requested device number is out of range." );
- #else
- bwb_error( err_devnum );
- #endif
- return bwb_zline( l );
- }
-
- if ( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED )
- {
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): using previously closed file (and buffer)" );
- bwb_debug( bwb_ebuf );
- #endif
- previous_buffer = TRUE;
- }
-
- if ( ( dev_table[ req_devnumber ].mode != DEVMODE_CLOSED ) &&
- ( dev_table[ req_devnumber ].mode != DEVMODE_AVAILABLE ) )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): Requested device number is already in use." );
- #else
- bwb_error( err_devnum );
- #endif
-
- return bwb_zline( l );
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): ready to open device <%s> mode <%d>",
- devname, mode );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* attempt to open the file */
-
- switch( mode )
- {
- case DEVMODE_OUTPUT:
- fp = fopen( devname, "w" );
- break;
- case DEVMODE_INPUT:
- fp = fopen( devname, "r" );
- break;
- case DEVMODE_APPEND:
- fp = fopen( devname, "a" );
- break;
- case DEVMODE_RANDOM:
- fp = fopen( devname, "r+" );
- if ( fp == NULL )
- {
- fp = fopen( devname, "w" );
- fclose( fp );
- fp = fopen( devname, "r+" );
- }
- break;
- }
-
- /* check for valid file opening */
-
- if ( fp == NULL )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "Failed to open device <%s>", devname );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_dev );
- #endif
- return bwb_zline( l );
- }
-
- /* assign values to device table */
-
- /* Random mode has a default record length (JBV) */
- if (mode == DEVMODE_RANDOM && rlen == -1) rlen = 128;
-
- dev_table[ req_devnumber ].mode = mode;
- dev_table[ req_devnumber ].cfp = fp;
- dev_table[ req_devnumber ].reclen = rlen;
- dev_table[ req_devnumber ].next_record = 1;
- dev_table[ req_devnumber ].loc = 0;
- strcpy( dev_table[ req_devnumber ].filename, devname );
-
- /* File length finding routine, added by JBV */
- fseek( dev_table[ req_devnumber ].cfp, 0, SEEK_END );
- dev_table[ req_devnumber ].lof = ftell( dev_table[ req_devnumber ].cfp );
- fseek( dev_table[ req_devnumber ].cfp, 0, SEEK_SET );
-
- /* allocate a character buffer for random access */
-
- if (( mode == DEVMODE_RANDOM ) && ( previous_buffer != TRUE ))
- {
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( dev_table[ req_devnumber ].buffer = CALLOC( rlen + 1, 1, "bwb_open" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_open(): failed to find memory for device buffer" );
- #else
- bwb_error( err_getmem );
- #endif
- return bwb_zline( l );
- }
-
- dio_flush( req_devnumber );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): allocated new random-access buffer" );
- bwb_debug( bwb_ebuf );
- #endif
-
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_open(): file is open now; end of function" );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* return next line number in sequence */
-
- return bwb_zline( l );
- }
-
- /***************************************************************
-
- FUNCTION: bwb_close()
-
- DESCRIPTION: This function implements the BASIC CLOSE
- command to close a stream for device input/output.
-
- SYNTAX: CLOSE [#]n [,[#]n...]
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_close( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_close( l )
- struct bwb_line *l;
- #endif
- {
- struct exp_ese *e;
- char atbuf[ MAXSTRINGSIZE + 1 ];
- int blanket_close; /* JBV */
- register int n; /* JBV */
-
- blanket_close = -1; /* JBV */
- req_devnumber = 0; /* JBV */
-
- /* loop to get device numbers to close */
-
- do
- {
-
- if ( l->buffer[ l->position ] == ',' && blanket_close == 0)
- ++( l->position); /* JBV */
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] == '#')
- {
- ++( l->position );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- if ( e->type == STRING )
- {
- #if PROG_ERRORS
- bwb_error( "String where number was expected for device number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- /*-------------------------------------------------------------*/
- /* Added the following section for blanket close feature (JBV) */
- /*-------------------------------------------------------------*/
- if (blanket_close == -1)
- if (strlen(atbuf) != 0) blanket_close = 0;
- else blanket_close = 1;
-
- if (blanket_close == 0) req_devnumber = (int) exp_getnval( e );
- else
- {
- ++req_devnumber;
-
- /* Find the next device in use */
- for (n = req_devnumber; n < DEF_DEVICES; ++n)
- {
- req_devnumber = -1;
- if (( dev_table[ n ].mode != DEVMODE_CLOSED ) &&
- ( dev_table[ n ].mode != DEVMODE_AVAILABLE ) )
- {
- req_devnumber = n;
- break;
- }
- }
- if (req_devnumber == -1) break; /* Skidoo if no more to close */
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_close(): requested device number <%d>",
- req_devnumber );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* check for valid requested device number */
-
- if ( ( req_devnumber < 0 ) || ( req_devnumber >= DEF_DEVICES ))
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_close(): Requested device number is out if range." );
- #else
- bwb_error( err_devnum );
- #endif
- return bwb_zline( l );
- }
-
- if (( dev_table[ req_devnumber ].mode == DEVMODE_CLOSED ) ||
- ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_close(): Requested device number is not in use." );
- #else
- bwb_error( err_devnum );
- #endif
-
- return bwb_zline( l );
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_close(): closing device# <%d>",
- req_devnumber );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* attempt to close the file */
-
- if ( fclose( dev_table[ req_devnumber ].cfp ) != 0 )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_close(): Failed to close the device" );
- #else
- bwb_error( err_dev );
- #endif
- return bwb_zline( l );
- }
-
- /* mark the device in the table as unavailable */
-
- dev_table[ req_devnumber ].mode = DEVMODE_CLOSED;
-
- /* Revised to FREE pass-thru call by JBV */
- if ( dev_table[ req_devnumber ].buffer != NULL )
- {
- FREE( dev_table[ req_devnumber ].buffer, "bwb_close" ); /* JBV */
- dev_table[ req_devnumber ].buffer = NULL; /* JBV */
- }
-
- /* eat up any remaining whitespace */
-
- adv_ws( l->buffer, &( l->position ) );
-
- }
-
- while ( l->buffer[ l->position ] == ',' || blanket_close == 1); /* JBV */
-
- /* return next line number in sequence */
-
- return bwb_zline( l );
- }
-
- #endif /* COMMON_CMDS */
-
- /***************************************************************
-
- FUNCTION: bwb_chdir()
-
- DESCRIPTION: This function implements the BASIC CHDIR
- command to switch logged directories.
-
- SYNTAX: CHDIR pathname$
-
- ***************************************************************/
-
- #if UNIX_CMDS
- #if ANSI_C
- struct bwb_line *
- bwb_chdir( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_chdir( l )
- struct bwb_line *l;
- #endif
- {
- int r;
- static int position;
- struct exp_ese *e;
- static char *atbuf;
- static int init = FALSE;
-
- /* get memory for temporary buffers if necessary */
-
- if ( init == FALSE )
- {
- init = TRUE;
-
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_chdir" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_chdir(): failed to find memory for atbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- }
-
- /* get the next element in atbuf */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_chdir(): argument is <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* interpret the argument */
-
- position = 0;
- e = bwb_exp( atbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- /* try to chdir to the requested directory */
-
- str_btoc( atbuf, &( e->sval ) );
- r = chdir( atbuf );
-
- /* detect error */
-
- if ( r == -1 )
- {
- bwb_error( err_opsys );
- return bwb_zline( l );
- }
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_rmdir()
-
- DESCRIPTION: This function implements the BASIC CHDIR
- command to remove a subdirectory.
-
- SYNTAX: RMDIR pathname$
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_rmdir( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_rmdir( l )
- struct bwb_line *l;
- #endif
- {
- int r;
- static int position;
- struct exp_ese *e;
- static char *atbuf;
- static int init = FALSE;
-
- /* get memory for temporary buffers if necessary */
-
- if ( init == FALSE )
- {
- init = TRUE;
-
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_rmdir" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in rmdir(): failed to find memory for atbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- }
-
- /* get the next element in atbuf */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_rmdir(): argument is <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* interpret the argument */
-
- position = 0;
- e = bwb_exp( atbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- /* try to remove the requested directory */
-
- str_btoc( atbuf, &( e->sval ) );
- r = rmdir( atbuf );
-
- /* detect error */
-
- if ( r == -1 )
- {
- bwb_error( err_opsys );
- }
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_mkdir()
-
- DESCRIPTION: This function implements the BASIC MKDIR
- command to create a new subdirectory.
-
- SYNTAX: MKDIR pathname$
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_mkdir( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_mkdir( l )
- struct bwb_line *l;
- #endif
- {
- int r;
- static int position;
- struct exp_ese *e;
- static char *atbuf;
- static int init = FALSE;
-
- /* get memory for temporary buffers if necessary */
-
- if ( init == FALSE )
- {
- init = TRUE;
-
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_mkdir" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_mkdir(): failed to find memory for atbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- }
-
- /* get the next element in atbuf */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_mkdir(): argument is <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* interpret the argument */
-
- position = 0;
- e = bwb_exp( atbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- /* try to make the requested directory */
-
- str_btoc( atbuf, &( e->sval ) );
- #if MKDIR_ONE_ARG
- r = mkdir( atbuf );
- #else
- r = mkdir( atbuf, PERMISSIONS );
- #endif
-
- /* detect error */
-
- if ( r == -1 )
- {
- bwb_error( err_opsys );
- }
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_kill()
-
- DESCRIPTION: This function implements the BASIC KILL
- command to erase a disk file.
-
- SYNTAX: KILL filename
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_kill( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_kill( l )
- struct bwb_line *l;
- #endif
- {
- int r;
- static int position;
- struct exp_ese *e;
- static char *atbuf;
- static int init = FALSE;
-
- /* get memory for temporary buffers if necessary */
-
- if ( init == FALSE )
- {
- init = TRUE;
-
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_kill" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_kill(): failed to find memory for atbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- }
-
- /* get the next element in atbuf */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_kill(): argument is <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* interpret the argument */
-
- position = 0;
- e = bwb_exp( atbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- /* try to delete the specified file */
-
- str_btoc( atbuf, &( e->sval ) );
- r = unlink( atbuf );
-
- /* detect error */
-
- if ( r == -1 )
- {
- bwb_error( err_opsys );
- }
-
- return bwb_zline( l );
-
- }
-
- #endif /* UNIX_CMDS */
-
- #if COMMON_CMDS
-
- /***************************************************************
-
- FUNCTION: bwb_name()
-
- DESCRIPTION: This function implements the BASIC NAME
- command to rename a disk file.
-
- SYNTAX: NAME old_filename AS new_filename
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_name( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_name( l )
- struct bwb_line *l;
- #endif
- {
- int r;
- static int position;
- struct exp_ese *e;
- static char *atbuf;
- static char *btbuf;
- static int init = FALSE;
-
- /* get memory for temporary buffers if necessary */
-
- if ( init == FALSE )
- {
- init = TRUE;
-
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( atbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_name" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_name(): failed to find memory for atbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- /* Revised to CALLOC pass-thru call by JBV */
- if ( ( btbuf = CALLOC( MAXSTRINGSIZE + 1, sizeof( char ), "bwb_name" )) == NULL )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_name(): failed to find memory for btbuf" );
- #else
- bwb_error( err_getmem );
- #endif
- }
- }
-
- /* get the first argument in atbuf */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- /* interpret the first argument */
-
- position = 0;
- e = bwb_exp( atbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- /* this argument must be copied back to atbuf, else the next
- call to bwb_exp() will overwrite the structure to which e
- refers */
-
- str_btoc( atbuf, &( e->sval ) );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_name(): old name is <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* get the second argument in btbuf */
-
- adv_element( l->buffer, &( l->position ), btbuf );
- bwb_strtoupper( btbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_name(): AS string is <%s>", btbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- if ( strcmp( btbuf, "AS" ) != 0 )
- {
- bwb_error( err_syntax );
- return bwb_zline( l );
- }
-
- /* get the third argument in btbuf */
-
- adv_element( l->buffer, &( l->position ), btbuf );
-
- /* interpret the third argument */
-
- position = 0;
- e = bwb_exp( btbuf, FALSE, &position );
-
- if ( e->type != STRING )
- {
- bwb_error( err_argstr );
- return bwb_zline( l );
- }
-
- str_btoc( btbuf, &( e->sval ) );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_name(): new name is <%s>", btbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* try to rename the file */
-
- r = rename( atbuf, btbuf );
-
- /* detect error */
-
- if ( r != 0 )
- {
- bwb_error( err_opsys );
- }
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_field()
-
- DESCRIPTION: This C function implements the BASIC
- FIELD command.
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_field( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_field( l )
- struct bwb_line *l;
- #endif
- {
- int dev_number;
- int length;
- struct exp_ese *e;
- struct bwb_variable *v;
- bstring *b;
- int current_pos;
- char atbuf[ MAXSTRINGSIZE + 1 ];
-
- current_pos = 0;
-
- /* first read device number */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] =='#' )
- {
- ++( l->position );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): device# buffer <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- if ( e->type != NUMBER )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): Number was expected for device number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- dev_number = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): device <%d>", dev_number );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* be sure that the requested device is open */
-
- if (( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
- ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): Requested device number is not in use." );
- #else
- bwb_error( err_devnum );
- #endif
- return bwb_zline( l );
- }
-
- /* loop to read variables */
-
- do
- {
-
- /* read the comma and advance beyond it */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] ==',' )
- {
- ++( l->position );
- }
-
- /* first find the size of the field */
-
- adv_element( l->buffer, &( l->position ), atbuf ); /* get element */
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- if ( e->type != NUMBER )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): number value for field size not found" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- length = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): device <%d> length <%d> buf <%s>",
- dev_number, length, &( l->buffer[ l->position ] ) );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* read the AS */
-
- adv_element( l->buffer, &( l->position ), atbuf ); /* get element */
- bwb_strtoupper( atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): AS element <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- if ( strncmp( atbuf, "AS", 2 ) != 0 )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): AS statement not found" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- /* read the string variable name */
-
- adv_element( l->buffer, &( l->position ), atbuf ); /* get element */
- v = var_find( atbuf );
-
- if ( v->type != STRING )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): string variable name not found" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): device <%d> var <%s> length <%d>",
- dev_number, v->name, length );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* check for overflow of record length */
-
- if ( ( current_pos + length ) > dev_table[ dev_number ].reclen )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_field(): record length exceeded" );
- #else
- bwb_error( err_overflow );
- #endif
- return bwb_zline( l );
- }
-
- /* set buffer */
-
- b = var_findsval( v, v->array_pos );
-
- #if DONTDOTHIS
- if ( b->sbuffer != NULL )
- {
- /* Revised to FREE pass-thru call by JBV */
- FREE( b->sbuffer, "bwb_field" );
- b->sbuffer = NULL; /* JBV */
- }
- #endif
-
- b->sbuffer = dev_table[ dev_number ].buffer + current_pos;
- b->length = (unsigned char) length;
- b->rab = TRUE;
-
- current_pos += length;
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_field(): buffer <%lXh> var <%s> buffer <%lXh>",
- (long) dev_table[ dev_number ].buffer, v->name, (long) b->sbuffer );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* eat up any remaining whitespace */
-
- adv_ws( l->buffer, &( l->position ) );
-
- }
-
- while ( l->buffer[ l->position ] == ',' );
-
- /* return */
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_lset()
-
- DESCRIPTION: This C function implements the BASIC
- LSET command.
-
- SYNTAX: LSET string-variable$ = expression
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_lset( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_lset( l )
- struct bwb_line *l;
- #endif
- {
- return dio_lrset( l, FALSE );
- }
-
- /***************************************************************
-
- FUNCTION: bwb_rset()
-
- DESCRIPTION: This C function implements the BASIC
- RSET command.
-
- SYNTAX: RSET string-variable$ = expression
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_rset( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_rset( l )
- struct bwb_line *l;
- #endif
- {
- return dio_lrset( l, TRUE );
- }
-
- /***************************************************************
-
- FUNCTION: dio_lrset()
-
- DESCRIPTION: This C function implements the BASIC
- RSET and LSET commands.
-
- ***************************************************************/
-
- #if ANSI_C
- static struct bwb_line *
- dio_lrset( struct bwb_line *l, int rset )
- #else
- static struct bwb_line *
- dio_lrset( l, rset )
- struct bwb_line *l;
- int rset;
- #endif
- {
- char varname[ MAXVARNAMESIZE + 1 ];
- bstring *d, *s;
- int *pp;
- int n_params;
- int p;
- register int n, i;
- int startpos;
- struct exp_ese *e;
-
- /* find the variable name */
-
- bwb_getvarname( l->buffer, varname, &( l->position ));
-
- v = var_find( varname );
-
- if ( v == NULL )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in dio_lrset(): failed to find variable" );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_syntax );
- #endif
- }
-
- if ( v->type != STRING )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in dio_lrset(): assignment must be to string variable" );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_syntax );
- #endif
- }
-
- /* read subscripts */
-
- pos = 0;
- if ( ( v->dimensions == 1 ) && ( v->array_sizes[ 0 ] == 1 ))
- {
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has 1 dimension",
- v->name );
- bwb_debug( bwb_ebuf );
- #endif
- n_params = 1;
- pp = &p;
- pp[ 0 ] = dim_base;
- }
- else
- {
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in dio_lrset(): variable <%s> has > 1 dimensions",
- v->name );
- bwb_debug( bwb_ebuf );
- #endif
- dim_getparams( l->buffer, &( l->position ), &n_params, &pp );
- }
-
- CURTASK exps[ CURTASK expsc ].pos_adv = pos;
- for ( n = 0; n < v->dimensions; ++n )
- {
- v->array_pos[ n ] = pp[ n ];
- }
-
- /* get bstring pointer */
-
- d = var_findsval( v, pp );
-
- /* find equals sign */
-
- adv_ws( l->buffer, &( l->position ));
- if ( l->buffer[ l->position ] != '=' )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in dio_lrset(): failed to find equal sign" );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_syntax );
- #endif
- }
- ++( l->position );
- adv_ws( l->buffer, &( l->position ));
-
- /* read remainder of line to get value */
-
- e = bwb_exp( l->buffer, FALSE, &( l->position ) );
- s = exp_getsval( e );
-
- /* set starting position */
-
- startpos = 0;
- if ( rset == TRUE )
- {
- if ( s->length < d->length )
- {
- startpos = d->length - s->length;
- }
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in dio_lrset(): startpos <%d> buffer <%lX>",
- startpos, (long) d->sbuffer );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* write characters to new position */
-
- i = 0;
- for ( n = startpos; ( i < (int) s->length ) && ( n < (int) d->length ); ++n )
- {
- d->sbuffer[ n ] = s->sbuffer[ i ];
- ++i;
- }
-
- /* return */
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_get()
-
- DESCRIPTION: This C function implements the BASIC
- GET command.
-
- SYNTAX: GET [#] device-number [, record-number]
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_get( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_get( l )
- struct bwb_line *l;
- #endif
- {
- int dev_number;
- int rec_number;
- register int i;
- struct exp_ese *e;
- char atbuf[ MAXSTRINGSIZE + 1 ];
- long offset; /* JBV */
-
- /* first read device number */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] =='#' )
- {
- ++( l->position );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- if ( e->type != NUMBER )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_get(): Number was expected for device number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- dev_number = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_get(): device <%d>", dev_number );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* be sure that the requested device is open */
-
- if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
- ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_get(): Requested device number is not in use." );
- #else
- bwb_error( err_devnum );
- #endif
- return bwb_zline( l );
- }
-
- /* see if there is a comma (and record number) */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */
- {
- ++( l->position );
-
- /* get the record number element */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
- rec_number = (int) exp_getnval( e );
-
- }
-
- else /* no record number given */
- {
- rec_number = dev_table[ dev_number ].next_record;
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_get(): record number <%d>", rec_number );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* wind the c file up to the proper point */
-
- /* Added by JBV */
- offset = (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen);
-
- if ( fseek( dev_table[ dev_number ].cfp, offset, SEEK_SET ) != 0 )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
- rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_dev );
- #endif
- return bwb_zline( l );
- }
-
- /* read the requested bytes into the buffer */
-
- dev_table[ dev_number ].loc = offset; /* Slight bug fix (JBV) */
- for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
- {
- dev_table[ dev_number ].buffer[ i ] =
- (char) fgetc( dev_table[ dev_number ].cfp );
- ++( dev_table[ dev_number ].loc );
- }
-
- /* increment (or reset) the current record */
-
- dev_table[ dev_number ].next_record = rec_number + 1;
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: bwb_put()
-
- DESCRIPTION: This C function implements the BASIC
- PUT command.
-
- SYNTAX: PUT [#] device-number [, record-number]
-
- ***************************************************************/
-
- #if ANSI_C
- struct bwb_line *
- bwb_put( struct bwb_line *l )
- #else
- struct bwb_line *
- bwb_put( l )
- struct bwb_line *l;
- #endif
- {
- int dev_number;
- int rec_number;
- register int i;
- struct exp_ese *e;
- char atbuf[ MAXSTRINGSIZE + 1 ];
- long offset; /* JBV */
-
- /* first read device number */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] =='#' )
- {
- ++( l->position );
- }
-
- adv_element( l->buffer, &( l->position ), atbuf );
- /* dev_number = atoi( atbuf ); */ /* Not quite right (JBV) */
-
- /* Added by JBV */
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- if ( e->type != NUMBER )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_put(): Number was expected for device number" );
- #else
- bwb_error( err_syntax );
- #endif
- return bwb_zline( l );
- }
-
- dev_number = (int) exp_getnval( e );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_put(): device <%d>", dev_number );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* be sure that the requested device is open */
-
- if ( ( dev_table[ dev_number ].mode == DEVMODE_CLOSED ) ||
- ( dev_table[ req_devnumber ].mode == DEVMODE_AVAILABLE ) )
- {
- #if PROG_ERRORS
- bwb_error( "in bwb_put(): Requested device number is not in use." );
- #else
- bwb_error( err_devnum );
- #endif
- return bwb_zline( l );
- }
-
- /* see if there is a comma (and record number) */
-
- adv_ws( l->buffer, &( l->position ) );
- if ( l->buffer[ l->position ] == ',' ) /* yes, there is a comma */
- {
- ++( l->position );
-
- /* get the record number element */
-
- adv_element( l->buffer, &( l->position ), atbuf );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_put(): rec no buffer <%s>", atbuf );
- bwb_debug( bwb_ebuf );
- #endif
-
- pos = 0;
- e = bwb_exp( atbuf, FALSE, &pos );
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_put(): return type <%c>", e->type );
- bwb_debug( bwb_ebuf );
- #endif
-
- rec_number = (int) exp_getnval( e );
-
- }
-
- else /* no record number given */
- {
- rec_number = dev_table[ dev_number ].next_record;
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_put(): record number <%d>", rec_number );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* wind the c file up to the proper point */
-
- /* Added by JBV */
- offset = (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen);
-
- if ( fseek( dev_table[ dev_number ].cfp, offset, SEEK_SET ) != 0 )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in bwb_get(): fseek() failed, rec number <%d> offset <%ld>",
- rec_number, (long) (( rec_number - 1 ) * dev_table[ dev_number ].reclen ) );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_dev );
- #endif
- return bwb_zline( l );
- }
-
- #if INTENSIVE_DEBUG
- sprintf( bwb_ebuf, "in bwb_put(): ready to write to file, buffer <%lXh>",
- (long) dev_table[ dev_number ].buffer );
- bwb_debug( bwb_ebuf );
- prn_xprintf( stderr, "Buffer: <" );
- #endif
-
- /* write the requested bytes to the file */
-
- dev_table[ dev_number ].loc = offset; /* Slight bug fix (JBV) */
- for ( i = 0; i < dev_table[ dev_number ].reclen; ++i )
- {
- fputc( dev_table[ dev_number ].buffer[ i ],
- dev_table[ dev_number ].cfp );
- #if INTENSIVE_DEBUG
- xputc( stderr, dev_table[ dev_number ].buffer[ i ] );
- #endif
- ++( dev_table[ dev_number ].loc );
- }
-
- #if INTENSIVE_DEBUG
- prn_xprintf( stderr, ">\n" );
- sprintf( bwb_ebuf, "in bwb_put(): write to file complete" );
- bwb_debug( bwb_ebuf );
- #endif
-
- /* flush the buffer */
-
- dio_flush( dev_number );
-
- /* increment (or reset) the current record */
-
- dev_table[ dev_number ].next_record = rec_number + 1;
-
- return bwb_zline( l );
-
- }
-
- /***************************************************************
-
- FUNCTION: dio_flush()
-
- DESCRIPTION: This C function flushes the random-access
- buffer associated with file dev_number.
-
- ***************************************************************/
-
- #if ANSI_C
- static int
- dio_flush( int dev_number )
- #else
- static int
- dio_flush( dev_number )
- int dev_number;
- #endif
- {
- register int n;
-
- if ( dev_table[ dev_number ].mode != DEVMODE_RANDOM )
- {
- #if PROG_ERRORS
- sprintf( bwb_ebuf, "in dio_flush(): only random-access buffers can be flushed" );
- bwb_error( bwb_ebuf );
- #else
- bwb_error( err_dev );
- #endif
- }
-
- /* fill buffer with blanks (or 'X' for test) */
-
- for ( n = 0; n < dev_table[ req_devnumber ].reclen; ++n )
- {
- dev_table[ req_devnumber ].buffer[ n ] = RANDOM_FILLCHAR;
- }
-
- return TRUE;
-
- }
-
- #endif /* COMMON_CMDS */
-
-
|