Hallo, IBMler!
Bekanntlich geht movea nicht im free code.
Manche empfehlen statt dessen memcpy zu nehmen. Memcpy kopiert aber den gesamten Speicherbereich. Substrings von arrays muss man mit %subarr kopieren.
Daher habe ich eine Prozedur selbst gestrickt, die alles macht.
MfG
Thomas J. Fuchs
Code:
h text('movea in free code')
h dftname(MOVEA)
h copyright('(C) Copyright APL Services 2010-08-07')
/if defined(*crtrpgmod)
h nomain option(*srcstmt:*nodebugio) aut(*all) fixnbr(*zoned:*inputpacked)
h truncnbr(*yes) ccsid(*char:*jobrun)
/endif
//‚Include Global Header Files
/include qrpglesrc,prototypes
//‚Required Prototypes
//‚movea in free code
d*movea pr
d* * value options(*string) Pointer from
d* * value options(*string) Pointer to
d* 10i 0 const options(*nopass) Length from
d* 10i 0 const options(*nopass) Elements from
d* 10i 0 const options(*nopass) Length to
d* 10i 0 const options(*nopass) Elements to
d* 10a const options(*nopass:*trim) *KEEP/*CLEAR
//‚Binding Source Entry
// EXPORT SYMBOL('MOVEA') /* movea in free code */
/*-------------------------------------------------------------------*/
//‚movea in free code
pmovea b export
d pi
d ptr_from * value options(*string) Pointer from
d ptr_to * value options(*string) Pointer to
d len_from 10i 0 const options(*nopass) Length from
d elem_from 10i 0 const options(*nopass) Elements from
d len_to 10i 0 const options(*nopass) Length to
d elem_to 10i 0 const options(*nopass) Elements to
d pi_option 10a const options(*nopass:*trim) *KEEP/*CLEAR
//‚Local Variables
doption s 10a inz
dpos_from s 10i 0 inz
dpos_to s 10i 0 inz
dstring_from s 32767a inz varying
dstring_to s 32767a inz varying
dstrlen_from s 10i 0 inz
dstrlen_to s 10i 0 inz
dwrkstr s 32767a inz
//‚Local Constants
dlo c x'8182838485868788899192939495969798-
d 99A2A3A4A5A6A7A8A943CCDC'
dnull c x'00'
dup c x'C1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8-
d D9E2E3E4E5E6E7E8E936ECFC'
/free
if %parms>=7;
option=%xlate(lo:up:pi_option);
if option<>'*KEEP' and option<>'*CLEAR';
option='*KEEP';
endif;
endif;
if %len(%str(ptr_from))>0;
string_from=%str(ptr_from);
strlen_from=%len(%trim(string_from))+1;
if %parms>=6;
pos_from=(elem_from-1)*len_from+1;
pos_to=(elem_to-1)*len_to+1;
if %parms>=7 and option='*KEEP';
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
clear wrkstr;
wrkstr=string_to;
%subst(wrkstr:pos_to)=%triml(string_from);
elseif %parms>=7 and option='*CLEAR';
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
clear string_to;
if len_from>len_to;
%len(string_to)=len_from;
endif;
%subst(wrkstr:pos_to:strlen_from)=string_from;
if len_to>len_from;
%subst(wrkstr:len_to+1)=null;
endif;
else;
%subst(wrkstr:pos_to:strlen_from)=string_from;
endif;
%str(ptr_to:%len(%trimr(wrkstr))+1)=wrkstr;
else;
if %parms<3;
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
strlen_from+=strlen_to;
endif;
%str(ptr_to:strlen_from)=string_from;
endif;
endif;
return;
/end-free
pmovea e
/*-------------------------------------------------------------------*/
Folgendes Testprogramm zeigt die Funktion der Prozedur movea:
Code:
h text('movea in free code')
h dftname(MOVEAL)
h copyright('(C) Copyright APL Services 2010-08-07')
/if defined(*crtbndrpg)
h dftactgrp(*no) actgrp(*caller)
/endif
dmovea pr
d * value options(*string) Pointer from
d * value options(*string) Pointer to
d 10i 0 const options(*nopass) Length from
d 10i 0 const options(*nopass) Elements from
d 10i 0 const options(*nopass) Length to
d 10i 0 const options(*nopass) Elements to
d 10a const options(*nopass:*trim) *KEEP/*CLEAR
darr_days s 1a inz dim(31)
darr1 s 10a inz dim(10)
darr2 s 10a inz dim(10)
dbrk s 1a inz
ddays s 31a inz('0000000001000000000000001000000-
d ')
delem s 10i 0 inz(3)
dname s 10a inz('Fuchs')
dstring s 30a inz('Müller Maier Schmidt Schulze')
/free
movea(%addr(name):%addr(arr1));
clear brk;
movea(%addr(arr1):%addr(arr2));
clear brk;
movea(%addr(arr1):%addr(arr2):%len(name):1:%len(name):3);
clear brk;
movea(%addr(string):%addr(arr2):%len(string):1:%size(arr2):4:'*KEEP');
clear brk;
name='1234567890';
movea(%addr(name):%addr(arr2):%len(name):1:%size(arr2):10:'*KEEP');
clear brk;
movea(%addr(arr2):%addr(arr1):%size(arr2):1:%size(arr1):2:'*KEEP');
clear brk;
name='Elem 6';
movea(%addr(name):%addr(arr1):%len(name):1:%size(arr1):6:'*KEEP');
clear brk;
movea(%addr(string):%addr(arr1):%len(string):1:%size(arr1:*all):1:
'*CLEAR');
clear brk;
movea(%addr(arr1):%addr(arr2));
clear brk;
movea(%addr(days):%addr(arr_days));
clear brk;
arr_days(1)=*on;
arr_days(31)=*on;
movea(%addr(arr_days):%addr(days));
clear brk;
*inlr=*on;
return;
/end-free
pmovea b export
d pi
d ptr_from * value options(*string) Pointer from
d ptr_to * value options(*string) Pointer to
d len_from 10i 0 const options(*nopass) Length from
d elem_from 10i 0 const options(*nopass) Elements from
d len_to 10i 0 const options(*nopass) Length to
d elem_to 10i 0 const options(*nopass) Elements to
d pi_option 10a const options(*nopass:*trim) *KEEP/*CLEAR
//‚Local Variables
doption s 10a inz
dpos_from s 10i 0 inz
dpos_to s 10i 0 inz
dstring_from s 32767a inz varying
dstring_to s 32767a inz varying
dstrlen_from s 10i 0 inz
dstrlen_to s 10i 0 inz
dwrkstr s 32767a inz
//‚Local Constants
dlo c x'8182838485868788899192939495969798-
d 99A2A3A4A5A6A7A8A943CCDC'
dnull c x'00'
dup c x'C1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8-
d D9E2E3E4E5E6E7E8E936ECFC'
/free
if %parms>=7;
option=%xlate(lo:up:pi_option);
if option<>'*KEEP' and option<>'*CLEAR';
option='*KEEP';
endif;
endif;
if %len(%str(ptr_from))>0;
string_from=%str(ptr_from);
strlen_from=%len(%trim(string_from))+1;
if %parms>=6;
pos_from=(elem_from-1)*len_from+1;
pos_to=(elem_to-1)*len_to+1;
if %parms>=7 and option='*KEEP';
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
clear wrkstr;
wrkstr=string_to;
clear brk;
%subst(wrkstr:pos_to)=%triml(string_from);
clear brk;
elseif %parms>=7 and option='*CLEAR';
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
clear string_to;
if len_from>len_to;
%len(string_to)=len_from;
endif;
clear brk;
%subst(wrkstr:pos_to:strlen_from)=string_from;
if len_to>len_from;
%subst(wrkstr:len_to+1)=null;
endif;
else;
%subst(wrkstr:pos_to:strlen_from)=string_from;
endif;
%str(ptr_to:%len(%trimr(wrkstr))+1)=wrkstr;
else;
if %parms<3;
string_to=%str(ptr_to);
strlen_to=%len(%trim(string_to))+1;
strlen_from+=strlen_to;
clear brk;
endif;
%str(ptr_to:strlen_from)=string_from;
endif;
endif;
return;
/end-free
pmovea e
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[User]
Mit Zitat antworten
Bookmarks