Hello all,
it’s quite easy to make a hexdump of an alpha-field in Natural. But I didn’t find a way to do convert a hexdump into a alpha-field…
define data local
1 #a16 (a16) init <'sample text'>
1 #hexdump (A60)
end-define
MOVE EDITED #A16 (EM=H^H^H^H^H^H^H^H^^H^H^H^H^H^H^H^H) TO #HEXDUMP /* works
MOVE EDITED #HEXDUMP TO #A16 (EM=H^H^H^H^H^H^H^H^^H^H^H^H^H^H^H^H) /* doesn't work
endOf course I can write my own conversion routine. But is there any other way?
Thanks
Matthias
Hi Matthias
Not pretty, but it works. The stack has always been available for strange conversions
define data local
1 #a (a5) init <‘qwert’>
1 #h (a20)
1 #b (b10)
1 redefine #b
2 #bb (a10)
end-define
*
move edited #a (em=hhhhh) to #h
write ‘=’ #h
stack top data #h
input #b
write #bb
end
Hi Steve,
nice workaround. But not really suitable for my problem. Seems like I have to write an own Subprog for conversion…
Thanks anyway
Matthias
Wow Steve - that is really a surprising feature of STACK DATA/INPUT!
I tried to go along that line and make a subprog with BY VALUE parameters - thinking that the stack involved here might behave similarly - but unfortunately no 
Do you have more examples of “freak conversions” using the stack ?
@Matthias: What is it that is stopping you from making use of Steve’s workaround ?
Finn
Two adjustments:
DEFINE DATA LOCAL
1 #A16 (A16) INIT <'sample text'>
1 #BIN (B60) 1 REDEFINE #BIN
2 #TEXT (A16)
1 #HEXDUMP (A60)
END-DEFINE
MOVE EDITED #A16 (EM=H^H^H^H^H^H^H^H^^H^H^H^H^H^H^H^H) TO #HEXDUMP /* works
DISPLAY (LS=100) #A16 #HEXDUMP #TEXT
EXAMINE #HEXDUMP FOR ' ' DELETE
DISPLAY (LS=100) #A16 #HEXDUMP #TEXT
MOVE EDITED #HEXDUMP TO #BIN (EM=HHHHHHHHHHHHHHHH)
DISPLAY (LS=100) #A16 #HEXDUMP #TEXT
END #A16 #HEXDUMP #TEXT
---------------- ------------------------------------------------------------ ----------------
sample text 73 61 6D 70 6C 65 20 74 65 78 74 20 20 20 20 20
sample text 73616D706C6520746578742020202020
sample text 73616D706C6520746578742020202020 sample textI got lots of hexdumped data in an Alpha dynamic field and I don’t want to risk to blow the stack…
Meanwhile I’ve coded the following universal routine. Any ideas for improvements?:
* DUMPA11N
*
* Hexdump --> A-field
*
DEFINE DATA PARAMETER
1 #I-FIELD (A) DYNAMIC BY VALUE
1 #O-FIELD (A) DYNAMIC BY VALUE RESULT OPTIONAL
1 #O-CHECK (L) OPTIONAL
1 #O-BYTES (I4) BY VALUE RESULT OPTIONAL
*
LOCAL
1 #I4 (I4)
1 #I2 (I2)
1 #B1 (B1)
1 #B2 (B2)
END-DEFINE
*
IF #O-FIELD SPECIFIED
REDUCE DYNAMIC #O-FIELD TO 0
END-IF
IF #O-BYTES SPECIFIED
RESET #O-BYTES
END-IF
*
EXAMINE #I-FIELD FOR ' ' DELETE /* eg. 20 20 20 --> 202020
EXAMINE #I-FIELD FOR H'09' DELETE
EXAMINE #I-FIELD FOR H'0D' DELETE
EXAMINE #I-FIELD FOR H'0A' DELETE
#I-FIELD := *TRIM(#I-FIELD) /* to set *LENGTH correctly
EXAMINE #I-FIELD TRANSLATE INTO UPPER /* eg. 2f --> 2F
*
IF #O-CHECK SPECIFIED
#O-CHECK := TRUE
DIVIDE 2 INTO *LENGTH(#I-FIELD) GIVING #I4 REMAINDER #I2
IF #I2 NE 0
#O-CHECK := FALSE
END-IF
END-IF
*
FOR #I4 = 1 TO *LENGTH(#I-FIELD) STEP +2
#B2 := SUBSTR(#I-FIELD,#I4)
DECIDE ON FIRST VALUE OF SUBSTR(#B2,1,1)
VALUE '0' #I2 := 0
VALUE '1' #I2 := 16
VALUE '2' #I2 := 32
VALUE '3' #I2 := 48
VALUE '4' #I2 := 64
VALUE '5' #I2 := 80
VALUE '6' #I2 := 96
VALUE '7' #I2 := 112
VALUE '8' #I2 := 128
VALUE '9' #I2 := 144
VALUE 'A' #I2 := 160
VALUE 'B' #I2 := 176
VALUE 'C' #I2 := 192
VALUE 'D' #I2 := 208
VALUE 'E' #I2 := 224
VALUE 'F' #I2 := 240
NONE VALUE
IF #O-CHECK SPECIFIED
#O-CHECK := FALSE
END-IF
IF #O-FIELD SPECIFIED
RESET #B1
COMPRESS FULL #O-FIELD #B1 INTO #O-FIELD LEAVING NO
END-IF
ESCAPE TOP
END-DECIDE
DECIDE ON FIRST VALUE OF SUBSTR(#B2,2,1)
VALUE '0' IGNORE
VALUE '1' ADD 1 TO #I2
VALUE '2' ADD 2 TO #I2
VALUE '3' ADD 3 TO #I2
VALUE '4' ADD 4 TO #I2
VALUE '5' ADD 5 TO #I2
VALUE '6' ADD 6 TO #I2
VALUE '7' ADD 7 TO #I2
VALUE '8' ADD 8 TO #I2
VALUE '9' ADD 9 TO #I2
VALUE 'A' ADD 10 TO #I2
VALUE 'B' ADD 11 TO #I2
VALUE 'C' ADD 12 TO #I2
VALUE 'D' ADD 13 TO #I2
VALUE 'E' ADD 14 TO #I2
VALUE 'F' ADD 15 TO #I2
NONE VALUE
RESET #I2
IF #O-CHECK SPECIFIED
#O-CHECK := FALSE
END-IF
END-DECIDE
IF #O-FIELD SPECIFIED
#B1 := #I2
COMPRESS FULL #O-FIELD #B1 INTO #O-FIELD LEAVING NO
END-IF
END-FOR
IF #O-BYTES SPECIFIED
#O-BYTES := *LENGTH(#O-FIELD)
END-IF
*
ENDThat’s cool. I didn’t know that…
Thanks
With Ralph’s tip I can narrow down my code to the following:
* DUMPA11N
*
* Hexdump --> A-field
*
DEFINE DATA PARAMETER
1 #I-FIELD (A) DYNAMIC BY VALUE
1 #O-FIELD (A) DYNAMIC BY VALUE RESULT OPTIONAL
1 #O-CHECK (L) OPTIONAL
1 #O-BYTES (I4) BY VALUE RESULT OPTIONAL
*
LOCAL
1 #I4 (I4)
1 #I1 (I1)
1 #B1 (B1)
1 #A2 (A2)
END-DEFINE
*
IF #O-FIELD SPECIFIED
REDUCE DYNAMIC #O-FIELD TO 0
END-IF
IF #O-BYTES SPECIFIED
RESET #O-BYTES
END-IF
*
EXAMINE #I-FIELD FOR ' ' DELETE /* eg. 20 20 20 --> 202020
EXAMINE #I-FIELD FOR H'09' DELETE
EXAMINE #I-FIELD FOR H'0D' DELETE
EXAMINE #I-FIELD FOR H'0A' DELETE
#I-FIELD := *TRIM(#I-FIELD) /* to set *LENGTH correctly
EXAMINE #I-FIELD TRANSLATE INTO UPPER /* eg. 2f --> 2F
*
IF #O-CHECK SPECIFIED
#O-CHECK := TRUE
DIVIDE 2 INTO *LENGTH(#I-FIELD) GIVING #I4 REMAINDER #I1
IF #I1 NE 0
#O-CHECK := FALSE
END-IF
END-IF
*
FOR #I4 = 1 TO *LENGTH(#I-FIELD) STEP +2
#A2 := SUBSTR(#I-FIELD,#I4)
IF #A2 = MASK (HH)
MOVE EDITED #A2 TO #B1 (EM=H)
ELSE
RESET #B1
IF #O-CHECK SPECIFIED
#O-CHECK := FALSE
END-IF
END-IF
IF #O-FIELD SPECIFIED
COMPRESS FULL #O-FIELD #B1 INTO #O-FIELD LEAVING NO
END-IF
END-FOR
IF #O-BYTES SPECIFIED
#O-BYTES := *LENGTH(#O-FIELD)
END-IF
*
ENDThank you, Ralph
Hi Finn;
The following program shows that when you STACK a packed decimal variable, trailing zeroes do not get STACK’ed, nor do leading zeroes. The same is true for unpacked numbers.
> + Program STACK01 Lib XSTRO
Top …+…1…+…2…+…3…+…4…+…5…+…6…+…7…
0010 DEFINE DATA LOCAL
0020 1 #PACKED (P4.3)
0030 1 #ALPHA (A10)
0040 END-DEFINE
0050 *
0060 INCLUDE AATITLER
0070 *
X 0080 MOVE 12.476 TO #PACKED
0090 STACK TOP DATA #PACKED
0100 INPUT #ALPHA
0110 WRITE 5T ‘=’ #PACKED 5X ‘=’ #ALPHA #ALPHA (EM=H(10))
Y 0120 *
0130 MOVE 12.34 TO #PACKED
0140 STACK TOP DATA #PACKED
0150 INPUT #ALPHA
0160 WRITE 5T ‘=’ #PACKED 5X ‘=’ #ALPHA #ALPHA (EM=H(10))
0170 *
0180 MOVE 12.4 TO #PACKED
0190 STACK TOP DATA #PACKED
0200 INPUT #ALPHA
0210 WRITE 5T ‘=’ #PACKED 5X ‘=’ #ALPHA #ALPHA (EM=H(10))
0220 *
0230 MOVE 12.000 TO #PACKED
0240 STACK TOP DATA #PACKED
0250 INPUT #ALPHA
0260 WRITE 5T ‘=’ #PACKED 5X ‘=’ #ALPHA #ALPHA (EM=H(10))
0270 *
0280 END
PAGE # 1 DATE: 15-06-03
PROGRAM: STACK01 LIBRARY: XSTRO
#PACKED: 12.476 #ALPHA: 12.476 F1F24BF4F7F640404040
PAGE # 2 DATE: 15-06-03
PROGRAM: STACK01 LIBRARY: XSTRO
#PACKED: 12.340 #ALPHA: 12.34 F1F24BF3F44040404040
PAGE # 3 DATE: 15-06-03
PROGRAM: STACK01 LIBRARY: XSTRO
#PACKED: 12.400 #ALPHA: 12.4 F1F24BF4404040404040
PAGE # 4 DATE: 15-06-03
PROGRAM: STACK01 LIBRARY: XSTRO
#PACKED: 12.000 #ALPHA: 12 F1F24040404040404040
There are other “goodies” with re to date, etc. Will get to it later.
Thanks Steve, Ralf and Matthias for interesting input and examples
@Matthias
inspired by Ralf’s example I did another experiment…
You don’t have to chop it up into two-character chunks.
You can have larger binary fields as well !
I also experimented with “(B) dynamic” but it is not possible to redefine dynamic fields, so at some point you need to define a static lenght of the redefine fields.
DEFINE DATA LOCAL
1 #X (A10) INIT <‘qwert12345’>
1 #A (A) DYNAMIC
1 #B (B10000)
1 REDEFINE #B
2 #A2 (A10000)
END-DEFINE
*
MOVE EDITED #X (EM=H(10)) TO #A
MOVE EDITED #A TO #B (EM=H(10000))
PRINT #A2
*
END
This is just to be failsave (in case the hex Input has an odd number of chars). Of couse you could check the remaining length as well…