2012年（18）
分类： LINUX
2012-04-16 22:09:08
新增CAT, CHECK，XLATE, CHECKR，DOU, DOW, EVAL, CALLB，CALLP等操作码。
CAT
连接字符串
C string1 CAT string2(:n) result
如果没有定义n,那么string1的后续空格和string2的前导空格都将会被作为有效字符放入result中。否则的话，string1的后续空格将被删除，但result的前导空格不会被删除。
例：
* The following example shows leading blanks in factor 2. After
* the CAT, the RESULT contains 'MR. SMITH'.
C MOVE 'MR.' NAME 3
C MOVE ' SMITH' FIRST 6
C NAME CAT FIRST RESULT 9
* The following example shows the use of CAT without factor 1.
* FLD2 is a 9 character string. Prior to the concatenation, it
* contains 'ABC'; FLD1 contains 'XYZ
* After the concatenation, FLD2 contains 'ABC XYZ'.
C MOVEL(P) 'ABC' FLD2 9
C MOVE 'XYZ' FLD1 3
C CAT FLD1:2 FLD2
* CAT concatenates LAST to NAME and inserts one blank as specified
* in factor 2. TEMP contains 'Mr. Smith'.
C MOVE 'Mr. ' NAME 6
C MOVE 'Smith ' LAST 6
C NAME CAT LAST:1 TEMP 9
* CAT concatenates 'RPG' to STRING and places 'RPG/400' in TEMP.
C MOVE '/400' STRING 4
C 'RPG' CAT STRING TEMP 7
*
* The following example is the same as the previous example except
* that TEMP is defined as a 10 byte field. P operation extender
* specifies that blanks will be used in the rightmost positions
* of the result field that the concatenation result, 'RPG/400',
* does not fill. As a result, TEMP contains 'RPG/400'
* after concatenation.
C MOVE *ALL'*' TEMP 10
C MOVE '/400' STRING 4
C 'RPG' CAT(P) STRING TEMP
* After this CAT operation, the field TEMP contains 'RPG/4'.
* Because the field TEMP was not large enough, truncation occurred.
C MOVE '/400' STRING 4
C 'RPG' CAT STRING TEMP 5
* Note that the trailing blanks of NAME are not included because
* NUM=0. The field TEMP contains 'RPGIV'.
C MOVE 'RPG ' NAME 5
C MOVE 'IV ' LAST 5
C Z-ADD 0 NUM 1 0
C NAME CAT(P) LAST:NUM TEMP 10
CHECK
检查String2中是否含有不属于String1的字符。
N2
C string1 CHECK(E) string2（:N） result ER
如果没有N就从string2的第一位开始检查，否则从第N位开始检查
result中会返回第一个不符合条件的字符在string2中所处的位置
如果result是一个变量，那么此指令会在遇到第一个不符合条件的字母时停止检查；如果result是一个数组，那么此指令会持续检查直到遇到string2的结尾或者是string2中不符合条件的字母个数超过数组的元素个数。
检查完成后，我们可以使用%FOUND检查是否有不匹配的字符。
例：
* In this example, the result will be N=6, because the start
* position is 2 and the first nonnumeric character found is the '.'.
* The %FOUND built-in function is set to return '1', because some
* nonnumeric characters were found.
D Digits C '0123456789'
C
C MOVE '$2000.' Salary
C Digits CHECK Salary:2 N 2 0
C IF %FOUND
C EXSR NonNumeric
C ENDIF
* Because factor 1 is a blank, CHECK indicates the position
* of the first nonblank character. If STRING contains 'th
* NUM will contain the value 4.
C ' ' CHECK String Num 2 0
* The following example checks that FIELD contains only the letters
* A to J. As a result, ARRAY=(136000) after the CHECK operation.
* Indicator 90 turns on.
D Array S 1P 0 DIM(7)
D Letter C 'ABCDEFGHIJ'
C MOVE '1A=BC*' Field 6
C Letter CHECK Field Array 90
* In the following example, because FIELD contains only the
* letters F to G, ARRAY=(000000). Indicator 90 turns off.
C MOVE 'FGFGFG' Field 6
C Letter CHECK Field Array 90
CHECKR
与CHECK功能基本相同，只是CHECK是从左边开始检查，CHECKR是从右边开始。用法完全相同。
XLATE：
N2
C FROM:TO XLATE(E) STRING:START_POS TARGET ER
从START_POS开始，将字符串STRING中的符合条件（存在于FROM中）的字符替换成相应的（TO中）另外一个字符
例：
* The following translates the blank in NUMBER to '-'. The result
* in RESULT will be '999-9999'.
C MOVE '999 9999' Number 8
C ' ':'-' XLATE Number Result 8
例：
D Up C 'ABCDEFGHIJKLMNOPQRS-
D 'TUVWXYZ'
D Lo C 'abcdefghijklmnopqrs-
D 'tuvwxyz'
* In the following example, all values in STRING are translated to
* uppercase. As a result, RESULT='RPG DEPT'.
C MOVE 'rpg dept' String 8
C Lo:Up XLATE String Result
* In the following example only part of the string is translated
to lowercase. As a result, RESULT='RPG Dept'.
C Up:Lo XLATE String:6 Result
新增位操作新增位操作有TESTB
TESTB:
使用方法如下：
indicators
C TESTB bit_numbers Character_field N1 N2 N3
当factor2中指定的所有位都为off时，N1=*on
当factor2中指定的位中至少有一个为on时，N2=*on；但是，当factor2中只指定了一个位时，N2无效
当factor2中指定的所有位都为on时，N3=*on
例（TESTB）：
* The field bit settings are FieldF = 00000001, and FieldG = 11110001.
* Indicator 16 is set on because bit 3 is off (0) in FieldF.
* Indicator 17 is set off.
C TESTB '3' FieldF 16 17
* Indicator 16 is set on because both bits 3 and 6 are off (0) in
* FieldF. Indicators 17 and 18 are set off.
C TESTB '36' FieldF 161718
* Indicator 17 is set on because bit 3 is off (0) and bit 7 is on
* (1) in FLDF. Indicators 16 and 18 are set off.
C TESTB '37' FieldF 161718
* Indicator 17 is set on because bit 7 is on (1) in FLDF.
* Indicator 16 is set off.
C TESTB '7' FieldF 16 17
* Indicator 17 is set on because bits 0,1,2, and 3 are off (0) and
* bit 7 is on (1). Indicators 16 and 18 are set off.
C TESTB FieldG FieldF 161718
* The hexadecimal literal X'88' (10001000) is used in factor 2.
* Indicator 17 is set on because at least one bit (bit 0) is on
* Indicators 16 and 18 are set off.
C TESTB X'88' FieldG 161718
新增日期、时间操作
增加ADDDUR, EXTRCT, SUBDUR, TEST等日期操作。
ADDDUR
计算Factor1/Result加上一段时间后的时间。
N1 N2 N3
C 原时间 ADDDUR(E) 时间段:类型 结果 ER
Factor1可以是日期、时间、时间戳类型的变量，当没有指定Factor1时，result将被用作factor1。
Factor2必须是numeric类型的变量，不能含有小数位。Factor2可以是负数，此时实际上是在做减操作。Factor2由两部分组成，两部分使用”:”分割。第一部分是时间，第二部分使用来表示时间类型的关键字。
当Factor1中不是一个有效的时间，或者当没有指定factor1而且result没有指定一个有效的时间值时，此指令会运行出错。我们可以使用两种方式检查指令执行地是否正确：
在此指令执行完成后检查指示器。
在adddur后面使用”(E)”,在执行完此指令后检查%ERROR是否为*ON。
HKeywords+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
H TIMFMT(*USA) DATFMT(*MDY&)
DName+++++++++++ETDsFrom+++To/L+++IDc.Keywords+++++++++++++++++++++++++++
DDateconst C CONST(D'12 31 92')
* Define a Date field and initialize
DLoandate S D DATFMT(*EUR) INZ(D'12 31 92')
DDuedate S D DATFMT(*ISO)
Dtimestamp S Z
Danswer S T
* Determine a DUEDATE which is xx years, yy months, zz days later
* than LOANDATE.
C LOANDATE ADDDUR XX:*YEARS DUEDATE
C ADDDUR YY:*MONTHS DUEDATE
C ADDDUR ZZ:*DAYS DUEDATE
* Determine the date 23 days later
C ADDDUR 23:*D DUEDATE
* Add a 1234 microseconds to a timestamp
C ADDDUR 1234:*MS timestamp
* Add 12 HRS and 16 minutes to midnight
C T'00:00 am' ADDDUR 12:*Hours answer
C ADDDUR 16:*Minutes answer
* Subtract 30 days from a loan due date
C ADDDUR -30:*D LOANDUE
EXTRACT
从time/timestamp/date变量中截取年/月/日/小时/分钟/秒钟/微秒
N1 N2 N3
C EXTRCT(E) 时间:类型 结果 ER
结果字段可以是数值类型也可以是字符类型。
错误检查方法与ADDDUR相同。
例：
D LOGONDATE S D
D DATE_STR S 15
D MONTHS S 8 DIM(12) CTDATA
* Move the job date to LOGONDATE. By default, LOGONDATE has an *ISO
* date format, which contains a 4-digit year. *DATE also contains a
* 4-digit year, but in a different format, *USA.
C *USA MOVE *DATE LOGONDATE
* Extract the month from a date field to a 2-digit field
* that is used as an index into a character array containing
* the names of the months. Then extract the day from the
* timestamp to a 2-byte character field which can be used in
* an EVAL concatenation expression to form a string.
* For example, if LOGONDATE is March 17, 1996, LOGMONTH will
* contain 03, LOGDAY will contain 17, and DATE_STR will contain
* 'March 17'.
C EXTRCT LOGONDATE:*M LOGMONTH 2 0
C EXTRCT LOGONDATE:*D LOGDAY 2
C EVAL DATE_STR = %TRIMR(MONTHS(LOGMONTH))
C + ' ' + LOGDAY
C SETON LR
** CTDATA MONTHS
January
February
March
April
May
June
July
August
September
October
November
December
SUBDUR:计算两个时间之间的间隔时间或者是某一时间之前一段时间。
C DATE/TIME/TIMESTAMP SUBDUR DATE/TIME/TIMESTAMP DURATION:DURATION_CODE
OR
C DATE/TIME/TIMESTAMP SUBDUR DURATION:DURATION_CODE DATE/TIME/TIMESTAMP
错误判断方法与ADDDUR同
例：
* Determine a LOANDATE which is xx years, yy months, zz days prior to
* the DUEDATE.
C DUEDATE SUBDUR XX:*YEARS LOANDATE
C SUBDUR YY:*MONTHS LOANDATE
C SUBDUR ZZ:*DAYS LOANDATE
* Add 30 days to a loan due date
C SUBDUR -30:*D LOANDUE
* Calculate the number or days between a LOANDATE and a DUEDATE.
C LOANDATE SUBDUR DUEDATE NUM_DAYS:*D 5 0
* Determine the number of seconds between LOANDATE and DUEDATE.
C LOANDATE SUBDUR DUEDATE NUM_SECS:*S 5 0
例:
D CURDATE S D DATFMT(*ISO)
C
C*ADDDUR
C TIME CURDATE
C CURDATE DSPLY
C ADDDUR 1:*Y CURDATE
C CURDATE DSPLY
C ADDDUR 1:*M CURDATE
C CURDATE DSPLY
C ADDDUR 1:*D CURDATE
C CURDATE DSPLY
C*EXTRCT
C TIME CURDATE
C EXTRCT CURDATE:*Y YEAR 4 0
C YEAR DSPLY
C EXTRCT CURDATE:*M MONTH 2 0
C MONTH DSPLY
C EXTRCT CURDATE:*D DAY 2 0
C DAY DSPLY
C*SUBDUR
C TIME CURDATE
C CURDATE DSPLY
C SUBDUR 1:*Y CURDATE
C CURDATE DSPLY
C SUBDUR 1:*M CURDATE
C CURDATE DSPLY
C SUBDUR 1:*D CURDATE
C CURDATE DSPLY
C
C
C ENDPGM TAG
C EVAL *INLR = '1'
C RETURN
