#include "config.h"
#include "libgfortran.h"
#include <string.h>
#include "../io/io.h"
static const int five = 5;
static const int six = 6;
extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
export_proto_np(PREFIX(fgetc));
int
PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
{
int ret;
size_t s;
gfc_unit * u = find_unit (*unit);
if (u == NULL)
return -1;
s = 1;
memset (c, ' ', c_len);
ret = sread (u->s, c, &s);
unlock_unit (u);
if (ret != 0)
return ret;
if (s != 1)
return -1;
else
return 0;
}
#define FGETC_SUB(kind) \
extern void fgetc_i ## kind ## _sub \
(const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fgetc_i ## kind ## _sub); \
void fgetc_i ## kind ## _sub \
(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fgetc) (unit, c, c_len); \
else \
PREFIX(fgetc) (unit, c, c_len); }
FGETC_SUB(1)
FGETC_SUB(2)
FGETC_SUB(4)
FGETC_SUB(8)
extern int PREFIX(fget) (char *, gfc_charlen_type);
export_proto_np(PREFIX(fget));
int
PREFIX(fget) (char * c, gfc_charlen_type c_len)
{
return PREFIX(fgetc) (&five, c, c_len);
}
#define FGET_SUB(kind) \
extern void fget_i ## kind ## _sub \
(char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fget_i ## kind ## _sub); \
void fget_i ## kind ## _sub \
(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fgetc) (&five, c, c_len); \
else \
PREFIX(fgetc) (&five, c, c_len); }
FGET_SUB(1)
FGET_SUB(2)
FGET_SUB(4)
FGET_SUB(8)
extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
export_proto_np(PREFIX(fputc));
int
PREFIX(fputc) (const int * unit, char * c,
gfc_charlen_type c_len __attribute__((unused)))
{
size_t s;
int ret;
gfc_unit * u = find_unit (*unit);
if (u == NULL)
return -1;
s = 1;
ret = swrite (u->s, c, &s);
unlock_unit (u);
return ret;
}
#define FPUTC_SUB(kind) \
extern void fputc_i ## kind ## _sub \
(const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fputc_i ## kind ## _sub); \
void fputc_i ## kind ## _sub \
(const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fputc) (unit, c, c_len); \
else \
PREFIX(fputc) (unit, c, c_len); }
FPUTC_SUB(1)
FPUTC_SUB(2)
FPUTC_SUB(4)
FPUTC_SUB(8)
extern int PREFIX(fput) (char *, gfc_charlen_type);
export_proto_np(PREFIX(fput));
int
PREFIX(fput) (char * c, gfc_charlen_type c_len)
{
return PREFIX(fputc) (&six, c, c_len);
}
#define FPUT_SUB(kind) \
extern void fput_i ## kind ## _sub \
(char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
export_proto(fput_i ## kind ## _sub); \
void fput_i ## kind ## _sub \
(char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
{ if (st != NULL) \
*st = PREFIX(fputc) (&six, c, c_len); \
else \
PREFIX(fputc) (&six, c, c_len); }
FPUT_SUB(1)
FPUT_SUB(2)
FPUT_SUB(4)
FPUT_SUB(8)