rexx/src/rxfiles.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:39  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.6  1999/11/26 13:13:47  bnv
   8  * Added: Windows CE support.
   9  * Changed: To use the new macros.
  10  *
  11  * Revision 1.5  1999/03/10 16:55:02  bnv
  12  * Added MSC support
  13  *
  14  * Revision 1.4  1999/02/10 15:43:36  bnv
  15  * Long file name support for Win95/98/NT
  16  *
  17  * Revision 1.3  1999/01/22 17:29:17  bnv
  18  * Added the xxxBINARY options in the STREAM function
  19  *
  20  * Revision 1.2  1998/11/06 08:58:10  bnv
  21  * Corrected: real numbers with mantissa zero (integer)
  22  *            are treated as integers
  23  *
  24  * Revision 1.1  1998/07/02 17:34:50  bnv
  25  * Initial revision
  26  *
  27  */
  28
  29 #include <stdlib.h>
  30 #include <string.h>
  31
  32 #include <bmem.h>
  33 #include <lerror.h>
  34 #include <lstring.h>
  35
  36 #include <rexx.h>
  37 #include <rxdefs.h>
  38
  39 #define FSTDIN  0
  40 #define FSTDOUT 1
  41 #define FSTDERR 2
  42 #define FSTDAUX 3
  43 #define FSTDPRN 4
  44
  45 #define FILE_INC        10
  46 int     file_size;      /* file size in filelist structure      */
  47
  48 /* there are two types of files, std unix files and rexx files  */
  49 /* std unix files like old BRexx have one position pointer      */
  50 /* rexx files have 4 position pointers                          */
  51
  52 static
  53 struct files_st {
  54         PLstr   name;   /* IN STRUCTURE */
  55         FILEP   f;
  56         long    line;
  57 } *file;
  58
  59 /* ------------------------* RxInitFiles *------------------------ */
  60 void
  61 RxInitFiles(void)
  62 {
  63         int     i;
  64
  65         file = (struct files_st *)
  66                 MALLOC( FILE_INC * sizeof(struct files_st), "FILE");
  67         file_size = FILE_INC;
  68         for (i=0; i<file_size; i++) {
  69                 file[i].name = NULL;
  70                 file[i].f    = NULL;
  71                 file[i].line = 1;
  72         }
  73
  74         i = 0;
  75         LPMALLOC(file[i].name);
  76         Lscpy(file[i].name,"<STDIN>");    file[i].f = STDIN;
  77         file[i].line = 1;
  78
  79         i++;
  80         LPMALLOC(file[i].name);
  81         Lscpy(file[i].name,"<STDOUT>");   file[i].f = STDOUT;
  82         file[i].line = 1;
  83
  84         i++;
  85         LPMALLOC(file[i].name);
  86         Lscpy(file[i].name,"<STDERR>");   file[i].f = STDERR;
  87         file[i].line = 1;
  88
  89 #if defined(MSDOS) && !defined(__WIN32__) && !defined(_MSC_VER)
  90         i++;
  91         LPMALLOC(file[i].name);
  92         Lscpy(file[i].name,"<STDAUX>");   file[i].f = stdaux;
  93         file[i].line = 1;
  94
  95         i++;
  96         LPMALLOC(file[i].name);
  97         Lscpy(file[i].name,"<STDPRN>");   file[i].f = stdprn;
  98         file[i].line = 1;
  99 #endif
 100 } /* RxInitFiles*/
 101
 102 /* ------------------------* RxDoneFiles *------------------------ */
 103 void
 104 RxDoneFiles(void)
 105 {
 106         int i;
 107         for (i=0;i<file_size;i++) {
 108                 /* is it system file? */
 109                 if (file[i].name != NULL) {
 110                         if (LSTR(*(file[i].name))[0]!='<')      /* system file */
 111                                 FCLOSE(file[i].f);
 112                         LPFREE(file[i].name)
 113                 }
 114         }
 115         FREE(file);
 116 } /* RxDoneFiles */
 117
 118 /* -------------------------* find_file *------------------------- */
 119 static int
 120 find_file( const PLstr fn )
 121 {
 122         int     i, j=-1;
 123 #if defined(MSDOS) || defined(WCE)
 124         Lstr    str;
 125 #endif
 126
 127         /* search to see if it is a number */
 128         if ((LTYPE(*fn)==LSTRING_TY) && (_Lisnum(fn) == LINTEGER_TY))
 129                 j = (int)Lrdint(fn);
 130         else
 131         if (LTYPE(*fn) == LINTEGER_TY)
 132                 j = (int)LINT(*fn);
 133         else
 134         if (LTYPE(*fn) == LREAL_TY)
 135                 j = Lrdint(fn);
 136
 137         if (IN_RANGE(0,j,file_size-1))
 138                 if (file[j].name != NULL) return j;
 139
 140         L2STR(fn);
 141
 142 #if defined(MSDOS) || defined(WCE)
 143         LINITSTR(str); Lfx(&str,LLEN(*fn));
 144         Lstrcpy(&str,fn);
 145
 146         /* Make case insensity search */
 147         Lupper(&str);
 148
 149         for (i=0; i<file_size; i++)
 150                 if (file[i].name != NULL)
 151                         if (!Lstrcmp(&str, file[i].name)) {
 152                                 LFREESTR(str);
 153                                 return i;
 154                         }
 155         LFREESTR(str);
 156 #else
 157         for (i=0; i<file_size; i++)
 158                 if (file[i].name != NULL)
 159                         if (!Lstrcmp(fn, file[i].name))
 160                                 return i;
 161 #endif
 162         return -1;
 163 } /* find_file */
 164
 165 /* ------------------------* find_empty *------------------------- */
 166 static int
 167 find_empty( void )
 168 {
 169         int     i,j;
 170         for (i=0; i<file_size; i++)
 171                 if (file[i].name==NULL)
 172                         return i;
 173
 174         i = file_size;
 175         file_size += FILE_INC;
 176 /* then allocate some more space */
 177         file = (struct files_st *)
 178                 REALLOC( file, file_size * sizeof(struct files_st));
 179         for (j=i; j<file_size; j++) {
 180                 file[j].name = NULL;
 181                 file[j].f = NULL;
 182         }
 183         return i;
 184 } /* find_empty */
 185
 186 /* -------------------------* open_file *------------------------- */
 187 static int
 188 open_file( const PLstr fn, const char *mode )
 189 {
 190         int     i;
 191         Lstr    str;
 192
 193         i = find_empty();
 194
 195         LINITSTR(str); Lfx(&str,LLEN(*fn));
 196         Lstrcpy(&str,fn);
 197
 198         LASCIIZ(str);
 199
 200         if ((file[i].f=FOPEN(LSTR(str),mode))==NULL) {
 201                 LFREESTR(str);
 202                 return -1;
 203         }
 204         LPMALLOC(file[i].name);
 205 #if defined(MSDOS) || defined(WCE)
 206         /* For MSDOS or 32bit DOS store the name in uppercase */
 207         Lupper(&str);
 208 #endif
 209         Lstrcpy(file[i].name,&str);
 210         file[i].line = 1;
 211         LFREESTR(str);
 212         return i;
 213 } /* open_file */
 214
 215 /* -------------------------* close_file *------------------------ */
 216 static int
 217 close_file( const int f )
 218 {
 219         int     r;
 220         r = FCLOSE(file[f].f);
 221         file[f].f = NULL;
 222         LPFREE(file[f].name);
 223         file[f].name = NULL;
 224         return r;
 225 } /* close_file */
 226
 227 /* --------------------------------------------------------------- */
 228 /*  OPEN( file, mode )                                             */
 229 /* --------------------------------------------------------------- */
 230 void
 231 R_open( )
 232 {
 233         if (ARGN != 2) Lerror(ERR_INCORRECT_CALL, 0 );
 234         must_exist(1); L2STR(ARG1);
 235         must_exist(2); L2STR(ARG2);
 236         Llower(ARG2); LASCIIZ(*ARG2);
 237         Licpy(ARGR, open_file(ARG1,LSTR(*ARG2)));
 238 } /* R_open */
 239
 240 /* --------------------------------------------------------------- */
 241 /*  CLOSE( file )                                                  */
 242 /* --------------------------------------------------------------- */
 243 void
 244 R_close( )
 245 {
 246         int     i;
 247
 248         if (ARGN != 1)
 249                 Lerror(ERR_INCORRECT_CALL, 0);
 250         i=find_file(ARG1);
 251         if (i==-1) Lerror(ERR_FILE_NOT_OPENED,0 );
 252
 253         Licpy(ARGR,close_file(i));
 254 } /* R_close */
 255
 256 /* --------------------------------------------------------------- */
 257 /*  EOF( file )                                                    */
 258 /* --------------------------------------------------------------- */
 259 void
 260 R_eof( )
 261 {
 262         int     i;
 263         if (ARGN!=1)
 264                 Lerror(ERR_INCORRECT_CALL, 0);
 265         i = find_file(ARG1);
 266         if (i==-1)
 267                 Licpy(ARGR,-1);
 268         else
 269                 Licpy(ARGR,((FEOF(file[i].f))?1:0));
 270 } /* R_eof */
 271
 272 /* --------------------------------------------------------------- */
 273 /*  FLUSH( file )                                                  */
 274 /* --------------------------------------------------------------- */
 275 void
 276 R_flush( )
 277 {
 278         int     i;
 279         if (ARGN!=1)
 280                 Lerror(ERR_INCORRECT_CALL, 0);
 281         i = find_file(ARG1);
 282         if (i==-1)
 283                 Licpy(ARGR,-1);
 284         else
 285                 Licpy(ARGR,(FFLUSH(file[i].f)));
 286 } /* R_flush */
 287
 288 /* --------------------------------------------------------------- */
 289 /*  STREAM(file[,[option][,command]])                              */
 290 /* --------------------------------------------------------------- */
 291 void
 292 R_stream( )
 293 {
 294         char    option;
 295         Lstr    cmd;
 296         int     i;
 297
 298         if (!IN_RANGE(1,ARGN,3))
 299                 Lerror(ERR_INCORRECT_CALL, 0);
 300
 301         must_exist(1);
 302         i = find_file(ARG1);
 303
 304         if (exist(2)) {
 305                 L2STR(ARG2);
 306                 option = l2u[(byte)LSTR(*ARG2)[0]];
 307         } else
 308                 option = 'S';   /* Status */
 309
 310         /* only with option='C' we must have a third argument */
 311         if (option != 'C' && exist(3))
 312                 Lerror(ERR_INCORRECT_CALL, 0);
 313
 314         switch (option) {
 315                 case 'C':               /* command */
 316                         if (!exist(3))
 317                                 Lerror(ERR_INCORRECT_CALL, 0);
 318                         LINITSTR(cmd); Lfx(&cmd,LLEN(*ARG3));
 319                         Lstrip(&cmd,ARG3,LBOTH,' ');
 320                         Lupper(&cmd);
 321
 322                         if (!Lcmp(&cmd,"READ")) {
 323                                 if (i>=0) close_file(i);
 324                                 i = open_file(ARG1,"r");
 325                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 326                         } else
 327                         if (!Lcmp(&cmd,"READBINARY")) {
 328                                 if (i>=0) close_file(i);
 329                                 i = open_file(ARG1,"rb");
 330                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 331                         } else
 332                         if (!Lcmp(&cmd,"WRITE")) {
 333                                 if (i>=0) close_file(i);
 334                                 i = open_file(ARG1,"w");
 335                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 336                         } else
 337                         if (!Lcmp(&cmd,"WRITEBINARY")) {
 338                                 if (i>=0) close_file(i);
 339                                 i = open_file(ARG1,"wb");
 340                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 341                         } else
 342                         if (!Lcmp(&cmd,"APPEND")) {
 343                                 if (i>=0) close_file(i);
 344                                 i = open_file(ARG1,"a+");
 345                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 346                         } else
 347                         if (!Lcmp(&cmd,"APPENDBINARY")) {
 348                                 if (i>=0) close_file(i);
 349                                 i = open_file(ARG1,"ab+");
 350                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 351                         } else
 352                         if (!Lcmp(&cmd,"UPDATE")) {
 353                                 if (i>=0) close_file(i);
 354                                 i = open_file(ARG1,"r+");
 355                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 356                         } else
 357                         if (!Lcmp(&cmd,"UPDATEBINARY")) {
 358                                 if (i>=0) close_file(i);
 359                                 i = open_file(ARG1,"rb+");
 360                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 361                         } else
 362                         if (!Lcmp(&cmd,"CREATE")) {
 363                                 if (i>=0) close_file(i);
 364                                 i = open_file(ARG1,"w+");
 365                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 366                         } else
 367                         if (!Lcmp(&cmd,"CREATEBINARY")) {
 368                                 if (i>=0) close_file(i);
 369                                 i = open_file(ARG1,"wb+");
 370                                 if (i==-1) Lerror(ERR_CANT_OPEN_FILE,0);
 371                         } else
 372                         if (!Lcmp(&cmd,"CLOSE")) {
 373                                 if (i>=0) close_file(i);
 374                         } else
 375                         if (!Lcmp(&cmd,"FLUSH")) {
 376                                 if (i>=0) FFLUSH(file[i].f);
 377                         } else
 378                         if (!Lcmp(&cmd,"RESET")) {
 379                                 if (i>=0) FSEEK( file[i].f, 0L, SEEK_SET );
 380                         } else
 381                                 Lerror(ERR_INCORRECT_CALL, 0);
 382
 383                         Lscpy(ARGR,"READY");
 384                         LFREESTR(cmd);
 385                         break;
 386                 case 'D':               /* get a description */
 387                 case 'S':               /* status */
 388                         if (i==-1)
 389                                 Lscpy(ARGR,"UNKNOWN");
 390                         else {
 391                                 if (FEOF(file[i].f))
 392                                         Lscpy(ARGR,"NOTREADY");
 393                                 else
 394                                         Lscpy(ARGR,"READY");
 395                         }
 396                         /* ERROR??? where */
 397                         break;
 398                 default:
 399                         Lerror(ERR_INCORRECT_CALL, 0);
 400         }
 401 } /* R_stream */
 402
 403 /* --------------------------------------------------------------- */
 404 /*  CHARS((file))                                                  */
 405 /* --------------------------------------------------------------- */
 406 /*  LINES((file))                                                  */
 407 /* --------------------------------------------------------------- */
 408 void
 409 R_charslines( const int func )
 410 {
 411         int    i;
 412
 413         if (ARGN > 1)
 414                 Lerror(ERR_INCORRECT_CALL, 0);
 415         i = FSTDIN;
 416         if (exist(1))
 417                 if (LLEN(*ARG1)) i = find_file(ARG1);
 418         if (i==-1) i = open_file(ARG1,"r+");
 419         if (i==-1)
 420                 Lerror(ERR_CANT_OPEN_FILE,0);
 421
 422         if (func == f_chars)
 423                 Licpy(ARGR,Lchars(file[i].f));
 424         else
 425         if (func == f_lines)
 426                 Licpy(ARGR,Llines(file[i].f));
 427 } /* R_charslines */
 428
 429 /* --------------------------------------------------------------- */
 430 /*  CHARIN((file)(,(start)(,length)))                              */
 431 /* --------------------------------------------------------------- */
 432 /*  LINEIN((file)(,(line)(,count)))                                */
 433 /* --------------------------------------------------------------- */
 434 void
 435 R_charlinein( const int func )
 436 {
 437         int     i;
 438         long    start,length;
 439
 440         if (!IN_RANGE(1,ARGN,3))
 441                 Lerror(ERR_INCORRECT_CALL, 0);
 442         i = FSTDIN;
 443         if (exist(1))
 444                 if (LLEN(*ARG1)) i = find_file(ARG1);
 445         if (i==-1) i = open_file(ARG1,"r+");
 446         if (i==-1)
 447                 Lerror(ERR_CANT_OPEN_FILE,0);
 448         get_oiv(2,start,LSTARTPOS);
 449         get_oiv(3,length,1);
 450
 451         if (func == f_charin)
 452                 Lcharin(file[i].f,ARGR,start,length);
 453         else
 454         if (func == f_linein)
 455                 Llinein(file[i].f,ARGR,&(file[i].line),start,length);
 456 } /* R_charlinein */
 457
 458 /* --------------------------------------------------------------- */
 459 /*  CHAROUT((file)(,(string)(,start)))                             */
 460 /* --------------------------------------------------------------- */
 461 /*  LINEOUT((file)(,(string)(,start)))                             */
 462 /* --------------------------------------------------------------- */
 463 void
 464 R_charlineout( const int func )
 465 {
 466         int     i;
 467         long    start;
 468         PLstr   str;
 469
 470         if (!IN_RANGE(1,ARGN,3))
 471                 Lerror(ERR_INCORRECT_CALL, 0);
 472         i = FSTDOUT;
 473         if (exist(1))
 474                 if (LLEN(*ARG1)) i = find_file(ARG1);
 475         if (i==-1) {
 476                 i = open_file(ARG1,"r+");
 477                 if (i==-1) i = open_file(ARG1,"w+");
 478         }
 479         if (i==-1)
 480                 Lerror(ERR_CANT_OPEN_FILE,0);
 481
 482         if (exist(2)) {
 483                 L2STR(ARG2);
 484                 str = ARG2;
 485         } else
 486                 str = &(NullStr->key);
 487
 488         get_oiv(3,start,LSTARTPOS);
 489
 490         if (func == f_charout) {
 491                 Lcharout(file[i].f,str,start);
 492                 Licpy(ARGR,LLEN(*ARG2));
 493         } else
 494         if (func == f_lineout)
 495                 Licpy(ARGR,Llineout(file[i].f,str,&(file[i].line),start));
 496         FFLUSH(file[i].f);
 497 } /* R_charlineout */
 498
 499 /* --------------------------------------------------------------- */
 500 /*  WRITE( (file)(, string(,)))                                    */
 501 /* --------------------------------------------------------------- */
 502 void
 503 R_write( )
 504 {
 505         int     i;
 506
 507         if (!IN_RANGE(1,ARGN,3))
 508                 Lerror(ERR_INCORRECT_CALL, 0);
 509         i = FSTDOUT;
 510         if (exist(1))
 511                 if (LLEN(*ARG1)) i = find_file(ARG1);
 512         if (i==-1) i = open_file(ARG1,"w");
 513         if (i==-1)
 514                 Lerror(ERR_CANT_OPEN_FILE,0);
 515         if (exist(2)) {
 516                 Lwrite(file[i].f,ARG2,FALSE);
 517                 Licpy(ARGR, LLEN(*ARG2));
 518         } else {
 519                 FPUTC('\n',file[i].f);
 520                 Licpy(ARGR,1);
 521         }
 522         if (ARGN==3) {
 523                 FPUTC('\n',file[i].f);
 524                 LINT(*ARGR)++;
 525         }
 526 }  /* R_write */
 527
 528 /* --------------------------------------------------------------- */
 529 /*  READ( (file)(,length) )                                        */
 530 /*  length can be a number declaring number of bytes to read       */
 531 /*  or an option 'file', 'line' or 'char'                          */
 532 /* --------------------------------------------------------------- */
 533 void
 534 R_read( )
 535 {
 536         int     i;
 537         long    l=0;
 538
 539         if (!IN_RANGE(0,ARGN,2))
 540                 Lerror(ERR_INCORRECT_CALL, 0);
 541         i = FSTDIN;
 542         if (exist(1))
 543                 if (LLEN(*ARG1)) i = find_file(ARG1);
 544         if (i==-1) i = open_file(ARG1,"r");
 545         if (i==-1)
 546                 Lerror(ERR_CANT_OPEN_FILE,0);
 547
 548         if (exist(2)) {
 549                 /* search to see if it is a number */
 550                 if ((LTYPE(*ARG2)==LSTRING_TY) && (_Lisnum(ARG2) == LINTEGER_TY))
 551                         l = Lrdint(ARG2);
 552                 else
 553                 if (LTYPE(*ARG2) == LINTEGER_TY)
 554                         l = (int)LINT(*ARG2);
 555                 else
 556                 if (LTYPE(*ARG2) == LREAL_TY)
 557                         l = Lrdint(ARG2);
 558                 else
 559                 if (LTYPE(*ARG2) == LSTRING_TY) {
 560                         switch (l2u[(byte)LSTR(*ARG2)[0]]) {
 561                                 case 'F':
 562                                         l = LREADFILE;
 563                                         break;
 564                                 case 'L':
 565                                         l = LREADLINE;
 566                                         break;
 567                                 case 'C':
 568                                         l = 1;
 569                                         break;
 570                                 default:
 571                                         Lerror(ERR_INCORRECT_CALL, 0);
 572                         }
 573                 } else
 574                         Lerror(ERR_INCORRECT_CALL, 0);
 575         } else
 576                 l = LREADLINE;
 577
 578         Lread(file[i].f, ARGR, l);
 579 } /* R_read */
 580
 581 /* --------------------------------------------------------------- */
 582 /*  SEEK( file (,offset (,"TOF","CUR","EOF")))                     */
 583 /* --------------------------------------------------------------- */
 584 void
 585 R_seek( )
 586 {
 587         int     i;
 588         long    l=0;
 589         int     SEEK=SEEK_SET;
 590
 591         if (!IN_RANGE(1,ARGN,3))
 592                 Lerror(ERR_INCORRECT_CALL, 0);
 593         must_exist(1);  i = find_file(ARG1);
 594         if (i==-1)
 595                 Lerror( ERR_FILE_NOT_OPENED, 0);
 596
 597         if (exist(2)) {
 598                 l = Lrdint(ARG2);
 599                 if (exist(3)) {
 600                         L2STR(ARG3);
 601                         switch (l2u[(byte)LSTR(*ARG3)[0]]) {
 602                                 case 'T':       /* TOF */
 603                                         SEEK = SEEK_SET;
 604                                         break;
 605                                 case 'C':
 606                                         SEEK = SEEK_CUR;
 607                                         break;
 608                                 case 'E':
 609                                         SEEK = SEEK_END;
 610                                         break;
 611                                 default:
 612                                         Lerror(ERR_INCORRECT_CALL, 0 );
 613                         }
 614                 }
 615                 FSEEK( file[i].f, l, SEEK );
 616         }
 617         Licpy(ARGR, FTELL(file[i].f));
 618 } /* R_seek */