Go to the documentation of this file.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 #pragma ident "@(#) libfi/char/repeat.c 92.2 07/30/99 10:09:59"
00038
00039
00040
00041 #include <fortran.h>
00042 #include <liberrno.h>
00043 #include <stdlib.h>
00044 #include <stddef.h>
00045 #include <string.h>
00046 #include <cray/dopevec.h>
00047
00048 void
00049 _REPEAT(
00050 DopeVectorType *result,
00051 _fcd source,
00052 _f_int *ncopies)
00053 {
00054 char *sptr;
00055 char *rptr;
00056 char *rptr1;
00057 int src_len;
00058 int i, j, k;
00059 int tot_chr;
00060 int lp_cnt;
00061 _f_int copies;
00062
00063
00064
00065 sptr = _fcdtocp (source);
00066 src_len = _fcdlen (source);
00067
00068
00069
00070 copies = (_f_int) *ncopies;
00071
00072 if (copies < 0)
00073 _lerror (_LELVL_ABORT, FERPTNEG);
00074 else if (copies == 0 || src_len == 0) {
00075 result->base_addr.charptr = _cptofcd ((char *) NULL, 0);
00076 #if !defined(_ADDR64) && !defined(_WORD32) && !defined(__mips) && !defined(_LITTLE_ENDIAN)
00077 result->base_addr.a.el_len = 0;
00078 #endif
00079 return;
00080 }
00081
00082
00083
00084 tot_chr = src_len * copies;
00085
00086
00087
00088 if (result->assoc)
00089 _lerror (_LELVL_ABORT, FEINTUNK);
00090
00091 result->assoc = 1;
00092 result->base_addr.a.ptr = (void *) malloc (tot_chr);
00093 if (result->base_addr.a.ptr == NULL)
00094 _lerror (_LELVL_ABORT, FENOMEMY);
00095 rptr = (char *) result->base_addr.a.ptr;
00096 result->base_addr.charptr = _cptofcd (rptr, tot_chr);
00097 result->orig_base = result->base_addr.a.ptr;
00098 result->orig_size = tot_chr;
00099 #if !defined(_ADDR64) && !defined(_WORD32) && !defined(__mips) && !defined(_LITTLE_ENDIAN)
00100 result->base_addr.a.el_len = tot_chr << 3;
00101 #endif
00102
00103
00104
00105 for (i = 0; i < copies; i++) {
00106 rptr1 = (char *) rptr + (i * src_len);
00107 (void) memcpy (rptr1, sptr, src_len);
00108 }
00109
00110 return;
00111 }