00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041 #include <cmplrs/fio.h>
00042 #include <mutex.h>
00043 #include "fmt.h"
00044 #include "iomode.h"
00045 #include "backspace.h"
00046 #include "bcompat.h"
00047 #include "util.h"
00048 #include "err.h"
00049 #include "close.h"
00050 #include "sue.h"
00051
00052
00053 static ftnint
00054 __f77_f_back_com (alist *a, int lock) ;
00055
00056
00057 ftnint
00058 __f77_f_back (alist *a)
00059 {
00060 return( __f77_f_back_com (a, 0 ) );
00061 }
00062
00063 ftnint
00064 __f77_f_back64_mp (alist *a)
00065 {
00066 return( __f77_f_back_com (a, 1 ) );
00067 }
00068
00069 static ftnint
00070 __f77_f_back_com (alist *a, int lock)
00071
00072 {
00073 unit *ftnunit;
00074 int n, i;
00075 ftnll x, y;
00076 char buf[512];
00077
00078 if ((ftnunit = find_luno (a->aunit)) == NULL)
00079 err(a->aerr, 114, "backspace");
00080 while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
00081 ;
00082 if (ftnunit->uacc == APPEND || ftnunit->uacc == KEYED)
00083 errret(a->aerr, 165, "backspace");
00084 if (ftnunit->useek == 0 || ftnunit->url == 1)
00085 errret(a->aerr, 106, "backspace");
00086 if (ftnunit->uend == 1) {
00087 ftnunit->uend = 0;
00088 ftnunit->lock_unit = 0;
00089 return (0);
00090 }
00091 if (ftnunit->uwrt & WR_OP) {
00092 #ifdef I90
00093
00094 if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
00095 putc ('\n', ftnunit->ufd);
00096 ftnunit->f90nadv = 0;
00097 }
00098 #endif
00099
00100
00101
00102 (void) t_runc (ftnunit, a->aerr);
00103
00104
00105
00106 if (f77nowreading(ftnunit))
00107 errret(a->aerr, 106, "backspace");
00108 }
00109
00110
00111 if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
00112 if (ftnunit->uirec != 0)
00113 ftnunit->uirec--;
00114 ftnunit->lock_unit = 0;
00115 return (0);
00116 }
00117 if (ftnunit->ufmt != 1) {
00118 if (ftnunit->uerror)
00119 unf_position (ftnunit->ufd, ftnunit);
00120 if (fseek (ftnunit->ufd, -(long) sizeof (int), 1)) {
00121 fseek(ftnunit->ufd, 0L, 0);
00122 ftnunit->lock_unit = 0;
00123 return(0);
00124 }
00125
00126 (void) fread ((char *) &n, sizeof (int), 1, ftnunit->ufd);
00127 (void) fseek (ftnunit->ufd, (long) (-n - 2 * sizeof (int)), 1);
00128 ftnunit->lock_unit = 0;
00129 return (0);
00130 }
00131
00132 y = x = FTELL (ftnunit->ufd) - 1;
00133
00134
00135
00136 if (x < 0) {
00137 ftnunit->lock_unit = 0;
00138 return (0);
00139 }
00140
00141 #ifdef I90
00142
00143 ftnunit->f77recpos = 0;
00144 ftnunit->f77recend = 0;
00145 #endif
00146
00147 for (;;) {
00148 if (x < sizeof (buf))
00149 x = 0;
00150 else
00151 x -= sizeof (buf);
00152 (void) FSEEK (ftnunit->ufd, x, 0);
00153
00154 n = (int) fread (buf, 1, (int) (y - x), ftnunit->ufd);
00155 for (i = n - 1; i >= 0; i--) {
00156 if (buf[i] != '\n')
00157 continue;
00158 (void) fseek (ftnunit->ufd, (long) (i + 1 - n), 1);
00159 ftnunit->lock_unit = 0;
00160 return (0);
00161 }
00162 if (x == 0) {
00163 (void) fseek (ftnunit->ufd, 0L, 0);
00164 ftnunit->lock_unit = 0;
00165 return (0);
00166 } else if (n <= 0)
00167 errret (a->aerr, (EOF), "backspace")
00168 (void) FSEEK (ftnunit->ufd, x, 0);
00169 y = x;
00170 }
00171 }
00172
00173 #pragma weak __f77_f_back64 = __f77_f_back
00174 #pragma weak f_back64 = __f77_f_back
00175 #pragma weak f_back64_mp = __f77_f_back