void s_abort(int32 errno) { char *dumpflag, *getenv(); int32 coredump=0; #ifndef FTN90_IO void _cleanup(); #endif if (dumpflag = getenv("f77_dump_flag")) { coredump = up_low(*dumpflag) == 'y' ? 1 : 0; } if (coredump) { #ifndef FTN90_IO _cleanup(); #endif abort(); /* cause a core dump */ } else { #ifndef FTN90_IO _cleanup(); #endif fprintf(stderr,"*** Execution Terminated (%d) ***\n",errno); exit(errno); } }
int main(void) { char str[100] = "I like programming!"; int len; len = show(str); reverse(str, len); up_low(str); printf("%s\n", str); return 0; }
void main() { clrscr(); char string[50]; cout<<"Enter a string: "; gets(string); int l=stringlength(string); cout<<"The length of the string is: "<<l ; cout<<endl<<endl; cout<<"The new string is: "; for(int i=0; i<=l;i++) up_low(string[i]); getch(); }
static ftnint f_clos_com (cllist *a, int lock) { unit *ftnunit; char *cbuf, c, buf[256], tbuf[12]; int n, istat; if ((ftnunit = find_luno (a->cunit)) == NULL) { return 0; } while (lock && test_and_set( &ftnunit->lock_unit, 1L )) ; if (ftnunit->uconn <= 0) { /* could be disconnected by other threads */ ftnunit->uconn = 0; ftnunit->lock_unit = 0; return(0); } ftnunit->uend = 0; if (cbuf = a->csta) switch (up_low (*cbuf++)) { case 'd': ftnunit->udisp = DELETE; break; case 'p': ftnunit->udisp = PRINT; goto checkdelete; /* * Fix BN 7869. * This is very sloppy code for checking the specifiers to close. Currently * both DISP and STATUS cannot be used as specifiers to close. This is a kludge * that allows SAVE to be passed and treats it like KEEP instead of SUBMIT. * ---ravi--- 10/30/91 * case 's': ftnunit->udisp = SUBMIT; */ case 's': ftnunit->udisp = up_low (*cbuf) == 'a' ? KEEP : SUBMIT; checkdelete: while (c = (*cbuf++)) if ((c == '/') && (c = (*cbuf)) && (up_low (c) == 'd')) ftnunit->udisp |= DELETE; break; case 'k': if (ftnunit->uscrtch == 1) err(a->cerr, F_ERKEEPSCRATCH, "close"); default: ftnunit->udisp = KEEP; } if (ftnunit->uscrtch == 1) ftnunit->udisp |= DELETE; if (ftnunit->uacc == KEYED) { n = idxclose(ftnunit, a->cerr); ftnunit->lock_unit = 0; return (n); } #ifdef I90 /* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */ if ( (ftnunit->f90sw == 1) && (ftnunit->f90nadv == 1) && (ftnunit->uwrt & WR_OP) ) { putc ('\n', ftnunit->ufd); ftnunit->f90nadv = 0; } #endif if (ftnunit->ucc == CC_FORTRAN && ftnunit->ucchar) putc (ftnunit->ucchar, ftnunit->ufd); if (ftnunit->ufd == stdin || ftnunit->ufd == stdout || ftnunit->ufd == stderr) { /* * Don't close stdin, stdout, and stderr otherwise other files * can be opened using those pointers and caused a lot of confusion */ fflush(ftnunit->ufd); goto cont; } if (ftnunit->uwrt & WR_OP) (void) t_runc (ftnunit, a->cerr); /* Close the file. */ if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) { /* direct unformatted */ while (lock && test_and_set( &io_lock, 1L )) ; if (ftnunit->uistty) { _fio_du_close ((int) ftnunit->ufd); /* no error */ } else if (((int)ftnunit->ufd) != _fio_du_close ((int) ftnunit->ufd)) { io_lock = 0; if (lock) ftnunit->lock_unit = 0; err (a->cerr, errno, "close"); } io_lock = 0; } else { if (ftnunit->uistty) { /* have to call isatty() first to get * correct result */ /* obtain exclusive lock for special I/O operation */ while (lock && test_and_set( &io_lock, 1L )) ; istat = fclose (ftnunit->ufd); io_lock = 0; } else { /* obtain exclusive lock for special I/O operation */ while (lock && test_and_set( &io_lock, 1L )) ; istat = fclose (ftnunit->ufd); io_lock = 0; if (istat) { if (lock) ftnunit->lock_unit = 0; err (a->cerr, errno, "close"); } } } if (ftnunit->ufnm) { if (ftnunit->udisp & SUBMIT) { (void) strcpy (tbuf, "tmp.FXXXXXX"); (void) mktemp (tbuf); sprintf (buf, "cp %s %s", ftnunit->ufnm, tbuf); system (buf); sprintf (buf, "( chmod +x %s; %s; rm %s ) &", tbuf, tbuf, tbuf); system (buf); } else if (ftnunit->udisp & PRINT) { sprintf (buf, "lpr %s", ftnunit->ufnm); system (buf); } if (ftnunit->udisp & DELETE) (void) unlink (ftnunit->ufnm); /* SYSDEP */ free (ftnunit->ufnm); ftnunit->ufnm = NULL; } cont: /* The following fixes bug #231656. The pointers involved are initialized to zero (both when originally allocated in f_init() and when reallocated in map_luno()). So, if non-zero, the buffers must have been allocated, and we should free them. */ if (ftnunit->f77syl) { free(ftnunit->f77syl); ftnunit->f77syl = NULL; } if (ftnunit->f77fio_buf) { free(ftnunit->f77fio_buf); ftnunit->f77fio_buf = NULL; ftnunit->f77fio_size = 0; } if (ftnunit->ukeys) { free(ftnunit->ukeys); ftnunit->ukeys = NULL; } ftnunit->ufd = NULL; ftnunit->uconn = 0; ftnunit->luno = 0; if (lock) ftnunit->lock_unit = 0; /* added in MIPS version 2.20 fix bug 6084 BN-8077. Undo 6084 fix */ return (0); }
f_open_com (olist *a, ftnint *mask, char **mode_, char **buf_, unit **fu) #endif { unit *b; ino_t inod; int n, org; char *mode = "r"; char *abuf, c, *cbuf, errstr[80]; char buf[PATH_MAX]; /* temp buffer */ char ubuf[PATH_MAX]; /* temp buffer */ unsigned int need; #if 00 cllist64 x; #else cllist x; #endif struct stat sbuf; static char seed[] = "aa"; char *q = seed; char ch; unit *dupunit; int dupopen; int istty = 0; /* Flag to indicate whether file * being opened is /dev/tty */ /* extern FILE *debugfile; */ struct stat stat_struct; unit *ftnunit; /* bug fix 12787 : need to initialize to zero */ /* sjc #1827: The cretin who coded this originally assumed that an * 80-byte temporary string would always be enough. We dynamically * allocate it to be 80 bytes plus whatever we can easily find out * about the length of the filename being passed to us. That may * not be enough (the string gets passed all over creation, so * it's hard to know) but it's better than before. Note that this * relies on f_open continuing not to be recursive. */ if (a->ofnm) istty = !strncmp ("/dev/tty", a->ofnm, 8); need = a->odfnm ? a->odfnmlen : 0; need += a->ofnm ? a->ofnmlen : 0; need += 40; if ((*fu = ftnunit = b = map_luno (a->ounit)) == NULL) err(a->oerr, 101, "open"); while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L )) { sginap(0); } /* obtain exclusive lock for special I/O operation, this should always be done after the lock onthe unit has been done to avoid deadlock */ while (test_and_set( &io_lock, 1L )) sginap(0); * buf_ = buf; /* Fix BN 9310 . If the the terminal is being opened do not test to see if this * file is already connected to a fortran unit since the terminal should be * able to be connected to various fortran units simultaneously * ---ravi---1/7/91 */ /* From the ANSI standard: to make this clear once and for all: ** If a unit is connnected to a file that exists, execution of an OPEN ** statement for that unit is permitted. If the FILE= specifier is not ** included in the OPEN statement, the file to be connected to the unit is ** the same as the file to which the unit is connected. ** If the file to be connected to the unit does not exist, but is the ** same as the file to which the unit is preconnected, the properties ** specifies by the OPEN statement become a part of the connection. ** If the file to be connected to the unit is not the same as the ** file to which the unit is conencted, the effect is as if a CLOSE ** statement without a STATUS= specifier had been executed for the unit ** immediately to the execution of the OPEN statement. ** If the file to be connected to the unit is the same as the file ** to which the unit is connected, only the BLANK= specifier may have a ** value different from the one currently in effect. The position of ** the file is unaffected. ** If a file is connected to a unit, execution of an OPEN statement ** on that file and a different unit is not permitted */ if (!istty) { if (dupopen = f_duped (a, ftnunit, &dupunit)) if (!a->oshared) return(dupopen); } else dupopen = 0; if (a->odfnm) { g_char (a->odfnm, a->odfnmlen, buf); abuf = &buf[strlen(buf)]; } else abuf = buf; if (b->uconn > 0 && (!a->osta || up_low (*a->osta) != 's')) { if (a->ofnm == 0) { same:if (a->oblnk != 0) b->ublnk = up_low (*a->oblnk) == 'z' ? 1 : 0; /* Ignore this open statement if it is not a preconnected unit ** otherwise redefine the unit characteristics */ if ((b->ufd == stdin || b->ufd == stdout || b->ufd == stderr) && b->ufnm == NULL) dupopen = 1; else return (0); } if (a->ofnm) { g_char (a->ofnm, a->ofnmlen, abuf); if (b->uacc == KEYED) mkidxname (buf, buf); f77inode (buf, &inod); if ((inod == b->uinode) && inod) goto same; buf[a->ofnmlen] = '\0'; } x.cunit = a->ounit; x.csta = 0; x.cerr = a->oerr; /* fix bug 6084 */ /* BN-8077 */ /* Leave the stdin, stdout, stderr alone without closing them, * since if that is done a normal file will be opened which will * have the ufd value of stdin, stdout, or stderr and mess up all * the conditional testing for stdin, stdout, and stderr */ if (b->ufd == stdin || b->ufd == stdout || b->ufd == stderr) { if (!dupopen) { b->uconn = 0; b->ufd = NULL; } #if 00 #define NAMEf_clos f_clos64 #else #define NAMEf_clos f_clos #endif } else if ((n = NAMEf_clos (&x)) != 0) return (n); b->luno = a->ounit; #undef NAMEf_clos } org = a->oorg ? up_low (*a->oorg) : 0; b->umask = *mask; if (a->oacc == 0) switch (org) { case 'r': b->uacc = DIRECT; break; case 'i': if (dupopen) err(a->oerr, 186, "open") b->uacc = KEYED; break; default: b->uacc = SEQUENTIAL; } else switch (up_low (*a->oacc)) { case 'd': b->uacc = DIRECT; if (org == 'i') err(a->oerr, 149, "open") break; case 'k': b->uacc = KEYED; if (org == 's') err(a->oerr, 150, "open") if (org == 'r') err(a->oerr, 151, "open") break; case 'a': b->uacc = APPEND; if (org == 'i') err(a->oerr, 152, "open") break; /* Fix BN 11769 * Currently if the access parameter is not a keywords, it * sets it to the default ,sequential. Generate error instead. * ---ravi---2/21/92 * case 's': default: b->uacc = org == 'i' ? KEYED : SEQUENTIAL; */ case 's': b->uacc = org == 'i' ? KEYED : SEQUENTIAL; break; default: err(a->oerr, 130, "open"); } if (a->oassocv && b->uacc == DIRECT) set_var ((ftnintu *)(b->uassocv = a->oassocv), b->umask, ASSOCV, 1); else b->uassocv = NULL; if (a->omaxrec && b->uacc == DIRECT) b->umaxrec = a->omaxrec; else b->umaxrec = 0; if (cbuf = a->odisp) switch (up_low (*cbuf++)) { case 'd': b->udisp = DELETE; break; case 'p': b->udisp = PRINT; goto checkdelete; case 's': if (up_low (*cbuf) == 'a') goto keep; b->udisp = SUBMIT; checkdelete: while (c = (*cbuf++)) if ((c == '/') && (c = (*cbuf)) && (up_low (c) == 'd')) b->udisp |= DELETE; break; keep: default: b->udisp = KEEP; } else b->udisp = KEEP; b->ushared = a->oshared; b->ureadonly = a->oreadonly; if (a->oblnk && up_low (*a->oblnk) == 'z') b->ublnk = 1; else b->ublnk = 0; #ifdef I90 b->uaction = b->ureadonly ? READONLY : READWRITE; b->unpad = 0; b->udelim = DELIM_NONE; #endif b->url = a->orl; if (a->ofm == 0) { if (b->uacc == DIRECT || b->uacc == KEYED) { b->ufmt = 0; if (!f77vms_flag_[OLD_RL]) b->url *= sizeof (int); } else b->ufmt = 1; } else if (up_low (*a->ofm) == 'f') b->ufmt = 1; else if (up_low (*a->ofm) == 'b') b->ufmt = 2; else if (up_low (*a->ofm) == 's') { /* system file = direct unformatted file with record length = 1 */ b->ufmt = 0; b->url = 1; b->uacc = DIRECT; } else { b->ufmt = 0; if (!f77vms_flag_[OLD_RL]) b->url *= sizeof (int); /* all sequential unformatted must need a minimum of 1K buffer to avoid fseek() operations when reading which causes data to be read from the disk each time and cause a 12X performance loss. */ check_buflen( b, 1024 ); } if (a->orectype) switch (up_low (*a->orectype)) { case 'f': if (b->uacc != DIRECT && b->uacc != KEYED) err(a->oerr, 156, "open") break; case 'v': if (b->uacc == DIRECT || b->uacc == KEYED || b->ufmt == 1) err(a->oerr, 157, "open") break; case 's': if (b->uacc == DIRECT || b->uacc == KEYED || b->ufmt != 1) err(a->oerr, 158, "open") default: break; } if (a->occ == 0) b->ucc = (char) (b->ufmt ? ((b->luno == 6 && f77vms_flag_[VMS_CC]) ? CC_FORTRAN : CC_LIST) : CC_NONE); else switch (up_low (*a->occ)) { case 'l': b->ucc = CC_LIST; break; case 'f': b->ucc = CC_FORTRAN; b->ucchar = '\0'; break; case 'n': b->ucc = CC_NONE; break; default: b->ucc = (char) (b->ufmt ? ((b->luno == 6 && f77vms_flag_[VMS_CC]) ? CC_FORTRAN : CC_LIST) : CC_NONE); } if (!b->ufmt && b->ucc != CC_NONE) err(a->oerr, 162, "open"); if (a->ofnm == 0) #ifdef SIZEOF_LUNO_IS_64 (void) sprintf (abuf, "fort.%lld", a->ounit); #else (void) sprintf (abuf, "fort.%d", a->ounit); #endif else