* ====================================================================== * Program : R3MCONV * On the Web at: www.poemsareforever.com\NAT_CODE\R3MCONV.txt * Function : Data Conversion Binary/Hex/Decomal/Character * Date Written : 2005-07-21 * Author : Richard J. Mills * Email : R3M2000@cs.com * Cell Phone : +1-510-396-0996 (USA) * ====================================================================== * --+----1----+----2----+----3----+----4----+----5----+----6----+----7-- * ====================================================================== DEFINE DATA LOCAL * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #CV-BIN ( C ) 01 #CV-HEX ( C ) 01 #CV-CHAR ( C ) 01 #CV-CODE ( C ) 01 #I (p03) 01 #MARK (P01) INIT <1> * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #HEX-IN (A02) 01 REDEFINE #HEX-IN 02 #HX (A01/01:02) 01 #BIN-IN (A08) 01 REDEFINE #BIN-IN 02 #B4 (A04/01:02) 01 #CODE-IN (I02) (EM=999) 01 #CHAR-IN (A01) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #VALID-BIN (A04/00:15) INIT < '0000','0001','0010','0011' , '0100','0101','0110','0111', '1000','1001','0010','1011' , '1100','1101','1110','1111'> * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #TAB (A02/00:15) INIT < '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'> 01 REDEFINE #TAB 02 #OCC (00:15) 03 #H-CHAR (A01) 03 #I-VAL (I01) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #CHAR-MAX (P03) CONST <259> 01 #ELEMENT (00:#CHAR-MAX) 02 #VALUE (I02) (HD='Val') 02 REDEFINE #VALUE 03 #ALPHA (A01)(HD='Ch') 03 FILLER 1X 02 REDEFINE #VALUE 03 #HEX (A01)(HD='Hx') 03 FILLER 1X * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 01 #HEX-CONV (A02) 01 REDEFINE #HEX-CONV 02 #HEX-V1 (I01) 02 #HEX-V2 (I01) * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - END-DEFINE * ====================================================================== FORMAT (0) PS=23 LS=80 SET CONTROL 'MT' SET KEY PF3 = PGM NAMED 'Exit' SET KEY PF6 = PGM NAMED 'List' * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - FOR #I = 0 THRU 015 #I-VAL(#I) := #I END-FOR FOR #I = 0 THRU 255 #VALUE(#I) := #I END-FOR * ====================================================================== REPEAT UNTIL *PF-KEY = 'PF3' * ---------------------------------------------------------------------- INPUT (IP=OFF AD=M) MARK #MARK 03/20 'Change any' 'ONE'(CD=RE) 'of the Values Below' /20T '-'(34) //18T ' Binary ' 5X 'HEX' 5X 'Decimal' 4X 'EBCDIC' /18T '--------' 5X '---' 5X '-------' 4X '------' /18T #BIN-IN (CV=#CV-BIN ) 5X #HEX-IN (CV=#CV-HEX AD=MT ) 8X #CODE-IN (CV=#CV-CODE SG=OFF) 8X #CHAR-IN (CV=#CV-CHAR ) 23/18 ':Exit' (CD=RE) 46T ':List' (CD=GR) * ---------------------------------------------------------------------- IF *PF-KEY = 'PF3' ESCAPE BOTTOM END-IF IF *PF-KEY = 'PF6' PERFORM TABLE-LIST ESCAPE TOP END-IF * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF #CV-BIN MODIFIED AND NOT (#B4(1) = #VALID-BIN(*) AND #B4(2) = #VALID-BIN(*)) REINPUT FULL 'Invalid - NOT Binary Value' (CD=RE) MARK *#BIN-IN END-IF * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF #CV-HEX MODIFIED AND NOT (#HX(1) = #H-CHAR (*) AND #HX(2) = #H-CHAR (*)) REINPUT FULL 'Invalid - NOT Hex Value' (CD=RE) MARK *#HEX-IN END-IF * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - IF #CV-CODE MODIFIED AND NOT #CODE-IN = 0 THRU 255 REINPUT FULL 'Invalid - Range is 000~255'(CD=RE) MARK *#CODE-IN END-IF * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - DECIDE FOR FIRST CONDITION WHEN #CV-BIN MODIFIED #MARK := 1 PERFORM BIN-TO-HEX PERFORM HEX-TO-CODE PERFORM CODE-TO-CHAR WHEN #CV-HEX MODIFIED #MARK := 2 PERFORM HEX-TO-BIN PERFORM HEX-TO-CODE PERFORM CODE-TO-CHAR WHEN #CV-CODE MODIFIED #MARK := 3 PERFORM CODE-TO-CHAR PERFORM CHAR-TO-HEX PERFORM HEX-TO-BIN WHEN #CV-CHAR MODIFIED #MARK := 4 PERFORM CHAR-TO-HEX PERFORM HEX-TO-BIN PERFORM HEX-TO-CODE WHEN NONE IGNORE END-DECIDE * ---------------------------------------------------------------------- END-REPEAT * ====================================================================== DEFINE SUBROUTINE BIN-TO-HEX * ---------- EXAMINE #VALID-BIN(*) FOR #B4(1) GIVING INDEX IN #I #HX(1):= #H-CHAR(#I) EXAMINE #VALID-BIN(*) FOR #B4(2) GIVING INDEX IN #I #HX(2):= #H-CHAR(#I) * ---------- END-SUBROUTINE /* BIN-TO-HEX * ====================================================================== DEFINE SUBROUTINE HEX-TO-BIN * ---------- EXAMINE #H-CHAR(*) FOR #HX(1) GIVING INDEX IN #I #B4(1):= #VALID-BIN(#I) EXAMINE #H-CHAR(*) FOR #HX(2) GIVING INDEX IN #I #B4(2):= #VALID-BIN(#I) * ---------- END-SUBROUTINE /* HEX-TO-BIN * ====================================================================== DEFINE SUBROUTINE HEX-TO-CODE * ----------- MOVE #HEX-IN TO #HEX-CONV EXAMINE #HEX-CONV TRANSLATE USING #TAB(*) #CODE-IN := (#HEX-V1 * 16) + #HEX-V2 * ----------- END-SUBROUTINE /* HEX-TO-CODE * ====================================================================== DEFINE SUBROUTINE CODE-TO-CHAR * ------------ IF #CODE-IN = 0 THRU 255 MOVE #ALPHA (#CODE-IN) TO #CHAR-IN RESET #CV-CODE ELSE MOVE (AD=N) TO #CV-CODE END-IF * ------------ END-SUBROUTINE /* CODE-TO-CHAR * ====================================================================== DEFINE SUBROUTINE CHAR-TO-HEX * ----------- MOVE EDITED #CHAR-IN (EM=H) TO #HEX-IN * ----------- END-SUBROUTINE /* CHAR-TO-HEX * ====================================================================== DEFINE SUBROUTINE TABLE-LIST * ---------- SET KEY PF6 = OFF NEWPAGE WRITE TITLE UNDERLINED *PROGRAM 19X 'Decinal/Character/Hex' 69T *PAGE-NUMBER(EM=^Page^9^of^3) * FOR #I = 0 THRU 51 DISPLAY (SG=OFF) 4T #VALUE(#I+000)(EM=999) #ALPHA(#I+000)(CD=BL) #HEX(#I+000)(EM=H) 7X #VALUE(#I+051)(EM=999) #ALPHA(#I+051)(CD=BL) #HEX(#I+051)(EM=H) 7X #VALUE(#I+102)(EM=999) #ALPHA(#I+102)(CD=BL) #HEX(#I+102)(EM=H) 7X #VALUE(#I+153)(EM=999) #ALPHA(#I+153)(CD=BL) #HEX(#I+153)(EM=H) 7X #VALUE(#I+204)(EM=999) #ALPHA(#I+204)(CD=BL) #HEX(#I+204)(EM=H) IF #I = 16 or= 33 WRITE '_'(09)':Exit'(CD=RE)'_'(33)':Cont.'(CD=GR)'_'(10) END-IF END-FOR SET KEY PF6 = ON SET CONTROL 'K0' * ---------- END-SUBROUTINE /* TABLE-LIST * ====================================================================== AT END OF PAGE INPUT NO ERASE 2/30 ' ' IF *PF-KEY = 'PF3' SET KEY PF6 = ON ESCAPE BOTTOM END-IF END-ENDPAGE * ====================================================================== END