home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / clarion / brokcode.zip / RE4-1.EXE / INTLEM.CLA < prev   
Text File  |  1992-01-17  |  24KB  |  502 lines
  1.  
  2.              TITLE( 'Listing One - IntLEM.CLA' )
  3.              SUBTITLE( 'HEED WARNING ON FIRST PAGE!  Demonstrate INT.BIN LEM' )
  4.  
  5. INTLEM       PROGRAM
  6.  
  7.             !╔══════════════════════════════════════════════════════╗
  8.             !║                                                      ║
  9.             !║                                                      ║
  10.             !║   W A R N I N G !                  W A R N I N G !   ║
  11.             !║   W A R N I N G !     WARNING!     W A R N I N G !   ║
  12.             !║   W A R N I N G !                  W A R N I N G !   ║
  13.             !║                                                      ║
  14.             !╟──────────────────────────────────────────────────────╢
  15.             !║                                                      ║
  16.             !║   The program presented here can easily cause your   ║
  17.             !║   computer system to crash - or worse.  This can     ║
  18.             !║   happen if you incorrectly specify the calling      ║
  19.             !║   parameters for any particular interrupt.  Play     ║
  20.             !║   it safe - do not run this program if you feel      ║
  21.             !║   uncomfortable exploring low-level system calls!    ║
  22.             !║   By using this program, you acknowledge that you    ║
  23.             !║   take FULL responsibility for any consequences.     ║
  24.             !║                                                      ║
  25.             !╟──────────────────────────────────────────────────────╢
  26.             !║                                                      ║
  27.             !║           DO NOT MODIFY THIS SOURCE CODE!!!          ║
  28.             !║                                                      ║
  29.             !║   Unless you are an experienced Clarion developer    ║
  30.             !║   with knowledge about low-level operations.         ║
  31.             !║   To do so could cause unexpected and possibly       ║
  32.             !║   serious results.                                   ║
  33.             !║                                                      ║
  34.             !╟──────────────────────────────────────────────────────╢
  35.             !║                                                      ║
  36.             !║   That said - don't be afraid to simply load this    ║
  37.             !║   program.  By itself it won't do anything - until   ║
  38.             !║   you tell it to call an interrupt via an explicit   ║
  39.             !║   keyboard command ([^ENTER]).  As long as you do    ║
  40.             !║   not press that key command you can play with the   ║
  41.             !║   various entry fields on the screen.                ║
  42.             !║                                                      ║
  43.             !║                                                      ║
  44.             !╚══════════════════════════════════════════════════════╝
  45.  
  46.  
  47.  !┌────────────────────────────────────────────────────────────────────┐
  48.  !│                                                                    │
  49.  !│  Program..: IntLEM.CLA                                             │
  50.  !│  Module...: Global module.                                         │
  51.  !│  Function.: N/A                                                    │
  52.  !│  Version..: 1.00                                                   │
  53.  !│  Date.....: 12/10/91                                               │
  54.  !│  Published: Clarion Tech Journal, Volume x, number x               │
  55.  !│  Notice...: Copyright (c) 1991, 1992 Ronald J. Eisner.             │
  56.  !│           : All Rights Reserved                                    │
  57.  !│  Author...: Ronald J. Eisner,  PC Consulting Services              │
  58.  !│           : P.O. Box 30137, Columbia, MO  65205-3137               │
  59.  !│           : Compuserve I.D. # 74010,3011                           │
  60.  !│                                                                    │
  61.  !└────────────────────────────────────────────────────────────────────┘
  62.  
  63.  
  64.               MAP
  65.                 PROC( StrZeroPad  )          ! StrZeroPad( s4HexString )
  66.                 FUNC( DecToStrHex ), STRING  ! s4SHexStr=DecToStrHex(isDecVal)
  67.                 FUNC( StrHexToDec ), LONG    ! ilRegVal = StrHexToDec( sAX )
  68.                 INCLUDE( 'INT.CPY' )         ! INT.BIN declaration.
  69.               END
  70.  
  71.  
  72. eFieldOffset  EQUATE( 1 )                    !. Used in screen LOOPs.
  73.  
  74.               !*****  KEYBOARD EQUATES  *****!
  75.  
  76. Esc_Key       EQUATE(  256 )
  77. Up_Key        EQUATE(  262 )
  78. Ctrl_Esc      EQUATE(  279 )
  79. Ctrl_Enter    EQUATE(  280 )
  80. F10_Key       EQUATE( 2058 )
  81.  
  82.               !*****  LOCAL VARIABLES  *****!
  83.  
  84. GlobalVars    GROUP, PRE( Gbl )              ! Global variables:
  85. bbQuit          BYTE                         !. TRUE = Quit program.
  86. ibNdx           BYTE                         !. Loop index.
  87. ibField         BYTE                         !. FIELD().
  88. isFlagMask      SHORT                        !. Mask to set screen flags.
  89.  
  90. ilRegVal        LONG                         !. Temp home of register value.
  91. gOverReg        GROUP, PRE( Ovr ), OVER( Gbl:ilRegVal )  !. Over temp reg value.
  92. gLow              GROUP                      !.  Low Short.
  93. ibLowLow            BYTE                     !.   Low Byte.
  94. ibLowHigh           BYTE                     !.   High Byte.
  95.                   END                        !.
  96. gHigh             GROUP                      !.  High Short.
  97. ibHighLow           BYTE                     !.   Low Byte.
  98. ibHighHigh          BYTE                     !.   High Byte.
  99.                   END                        !.
  100.                 END                          !.  gOverReg GROUP.
  101.               END                            !. LocalVars GROUP.
  102.  
  103. gCPU_Strings  GROUP, PRE( SPU )              !. "Screen" display CPU Regs group:
  104. sAX             STRING( '0000' )             !.. AX Reg (accumulator)
  105. sBX             STRING( '0000' )             !.. BX Register (base)
  106. sCX             STRING( '0000' )             !.. CX Register (count)
  107. sDX             STRING( '0000' )             !.. DX Register (data)
  108. sSI             STRING( '0000' )             !.. SI Reg (source index)
  109. sDI             STRING( '0000' )             !.. DI Reg (dest. index)
  110. sDS             STRING( '0000' )             !.. DS Reg (data segment)
  111. sES             STRING( '0000' )             !.. ES Reg (extra)
  112. sInt            STRING(   '00' )             !.. Int to call (00h-FFh)
  113.               END                            !. gCPU_Strings
  114.  
  115.                 ! INT.BIN LEM PARAMETER GROUP:
  116.               INCLUDE( 'INT.CLI' )
  117.  
  118. !╔═════════════════════════════════════════════════════════════════════════════╗
  119. !║   .. = Unused                       FLAGS:                                  ║
  120. !╟─────────────────────────────────────────────────────────────────────────────╢
  121. !║                                                                             ║
  122. !║    F  E  D   C   B  A  9  8  7  6      5     4  3  2  1  0h                 ║
  123. !║   .. NF  └IOP┘  OF DF IF TF SF ZF     ..    AF .. PF .. CF                  ║
  124. !║ ┌─────┴─┐  │     │  │  │  │  │  └ Zero       │     │     └─ Carry           ║
  125. !║ │Nested │  │     │  │  │  │  └─── Sign       │     └─────── Parity          ║
  126. !║ │Process│  │     │  │  │  └────── Trap       └───────────── Auxilary Carry  ║
  127. !║ ├───────┴──┴─┐   │  │  └───────── Int Enable                                ║
  128. !║ │I/O Prot Lvl│   │  └──────────── Direction                                 ║
  129. !║ ├─────┬──────┤   └─────────────── Overflow                                  ║
  130. !║ │ 286+ Only  │                                                              ║
  131. !║ └────────────┘                                                              ║
  132. !╚═════════════════════════════════════════════════════════════════════════════╝
  133.  
  134. fScreen       SCREEN       PRE(Scr),HUE(7,0)
  135.                 ROW(1,1)   PAINT(23,28),HUE(7,1)
  136.                 ROW(1,47)  PAINT(23,34),HUE(7,1)
  137.                   COL(1)   STRING('<218,196{26},191,0{18},218,196{32},191>')
  138.                 ROW(2,1)   REPEAT(2),EVERY(2)
  139.                              STRING('<179,0{26},179,0{18},179,0{32},179>') .
  140.                 ROW(3,1)   STRING('<195,196{26},180,0{18},195,196{32},180>')
  141.                 ROW(5,1)   REPEAT(2),EVERY(16)
  142.                              STRING('<179,0{26},179,0{18},179,0{32},179>') .
  143.                 ROW(6,1)   STRING('<179,0{26},179,0{18},195,196{32},180>')
  144.                 ROW(7,1)   REPEAT(12)
  145.                              STRING('<179,0{26},179,0{18},179,0{32},179>') .
  146.                 ROW(19,1)  STRING('<179,0{26},179,0{18},179,0{6},196,194,196>' |
  147.                              & '<0{23},179>')
  148.                 ROW(20,1)  STRING('<179,0{26},179,0{18},179,0{6},196,217>'     |
  149.                              & '<0{24},179>')
  150.                 ROW(22,1)  STRING('<179,0{26},179,0{18},179,0{32},179>')
  151.                 ROW(23,1)  STRING('<192,196{26},217,0{18},192,196{32},217>')
  152.                 ROW(1,30)  REPEAT(2),EVERY(6);STRING('<196{16}>') .
  153.                 ROW(6,32)  STRING('<24,0,25>'),HUE(10,0)
  154.                 ROW(2,8)   STRING('CPU REGISTERS:'),ENH
  155.                   COL(31)  STRING('Keys to ACCEPT'),HUE(2,0)
  156.                   COL(53)  STRING(' INTERRUPT LEM TESTER '),HUE(14,6)
  157.                 ROW(3,31)  STRING('and SELECT'),HUE(2,0)
  158.                 ROW(4,31)  STRING('fields:'),HUE(2,0)
  159.                   COL(59)  STRING('Processor'),ENH
  160.                 ROW(5,61)  STRING('Flags'),ENH
  161.                 ROW(6,37)  STRING('[ENTER]'),HUE(10,0)
  162.                 ROW(7,7)   STRING('AHAL'),HUE(14,1)
  163.                   COL(52)  STRING('0 Carry {9}.. = Unused')
  164.                 ROW(8,13)  STRING('Accumulator')
  165.                   COL(32)  STRING('Other Keys:'),HUE(2,0)
  166.                   COL(52)  STRING('1 ..')
  167.                 ROW(9,52)  STRING('2 Parity')
  168.                 ROW(10,7)  STRING('BHBL'),HUE(14,1)
  169.                   COL(31)  STRING('[ESC]'),HUE(10,0)
  170.                   COL(38)  STRING('Restore'),HUE(2,0)
  171.                   COL(52)  STRING('3 ..')
  172.                 ROW(11,13) STRING('Base')
  173.                   COL(38)  STRING('Entry'),HUE(2,0)
  174.                   COL(52)  STRING('4 Auxiliary Carry')
  175.                 ROW(12,52) STRING('5 ..')
  176.                 ROW(13,7)  STRING('CHCL'),HUE(14,1)
  177.                   COL(31)  STRING('[F10]'),HUE(10,0)
  178.                   COL(38)  STRING('Clear'),HUE(2,0)
  179.                   COL(52)  STRING('6 Zero')
  180.                 ROW(14,13) STRING('Count')
  181.                   COL(38)  STRING('All'),HUE(2,0)
  182.                   COL(52)  STRING('7 Sign')
  183.                 ROW(15,38) STRING('Fields'),HUE(2,0)
  184.                   COL(52)  STRING('8 Trap')
  185.                 ROW(16,7)  STRING('DHDL'),HUE(14,1)
  186.                   COL(52)  STRING('9 Interrupt Enable')
  187.                 ROW(17,13) STRING('Data')
  188.                   COL(30)  STRING('^[ENTER]'),HUE(10,0)
  189.                   COL(40)  STRING('Call'),HUE(2,0)
  190.                   COL(52)  STRING('A Direction')
  191.                 ROW(18,36) STRING('Selected'),HUE(2,0)
  192.                   COL(52)  STRING('B Overflow')
  193.                 ROW(19,13) STRING('Source Index')
  194.                   COL(35)  STRING('Interrupt'),HUE(2,0)
  195.                   COL(52)  STRING('C')
  196.                   COL(58)  STRING('I/O Protection Level')
  197.                 ROW(20,13) STRING('Dest Index')
  198.                   COL(52)  STRING('D')
  199.                 ROW(21,13) STRING('Data Segment')
  200.                   COL(30)  STRING('^[ESC]'),HUE(10,0)
  201.                   COL(38)  STRING('Exit'),HUE(2,0)
  202.                   COL(52)  STRING('E Nested Process')
  203.                 ROW(22,13) STRING('Extra Segment')
  204.                   COL(38)  STRING('Program'),HUE(2,0)
  205.                   COL(52)  STRING('F ..')
  206.                 ROW(24,1)  STRING('**'),HUE(30,1)
  207.                   COL(3)   STRING('**'),HUE(16,7)
  208.                   COL(27)  STRING('By Ron Eisner (c) 1991, 1992'),ENH
  209.                   COL(77)  STRING('**'),HUE(25,3)
  210.                   COL(79)  STRING('**'),HUE(28,2)
  211.                 ROW(25,1)  STRING('**'),HUE(26,5)
  212.                   COL(3)   STRING('**'),HUE(27,4)
  213.                   COL(17)  STRING('  Clarion Tech Journal {5}Hand Crafted '    |
  214.                              & 'Clarion  '),HUE(14,6)
  215.                   COL(77)  STRING('**'),ENH,BLK
  216.                   COL(79)  STRING('**'),HUE(20,7)
  217.                   COL(80)  ENTRY,USE(?FirstField)
  218.                 ROW(5,4)   STRING('Interrupt To Call:'),HUE(14,1)
  219.                   COL(24)  ENTRY(@S2),USE(SPU:sInt),HUE(15,0),SEL(0,7),OVR,UPR
  220.                 ROW(8,4)   STRING('AX'),HUE(14,1)
  221.                   COL(7)   ENTRY(@S4),USE(SPU:sAX),HUE(15,0),SEL(0,7),OVR,UPR
  222.                 ROW(11,4)  STRING('BX'),HUE(14,1)
  223.                   COL(7)   ENTRY(@S4),USE(SPU:sBX),HUE(15,0),SEL(0,7),OVR,UPR
  224.                 ROW(14,4)  STRING('CX'),HUE(14,1)
  225.                   COL(7)   ENTRY(@S4),USE(SPU:sCX),HUE(15,0),SEL(0,7),OVR,UPR
  226.                 ROW(17,4)  STRING('DX'),HUE(14,1)
  227.                   COL(7)   ENTRY(@S4),USE(SPU:sDX),HUE(15,0),SEL(0,7),OVR,UPR
  228.                 ROW(19,4)  STRING('SI'),HUE(14,1)
  229.                   COL(7)   ENTRY(@S4),USE(SPU:sSI),HUE(15,0),SEL(0,7),OVR,UPR
  230.                 ROW(20,4)  STRING('DI'),HUE(14,1)
  231.                   COL(7)   ENTRY(@S4),USE(SPU:sDI),HUE(15,0),SEL(0,7),OVR,UPR
  232.                 ROW(21,4)  STRING('DS'),HUE(14,1)
  233.                   COL(7)   ENTRY(@S4),USE(SPU:sDS),HUE(15,0),SEL(0,7),OVR,UPR
  234.                 ROW(22,4)  STRING('ES'),HUE(14,1)
  235.                   COL(7)   ENTRY(@S4),USE(SPU:sES),HUE(15,0),SEL(0,7),OVR,UPR
  236.                 ROW(25,80) ENTRY,USE(?LastField)
  237.                            REPEAT(16),INDEX(Gbl:ibNdx)
  238. ssFlagBit       ROW(7,50)    STRING(1),HUE(14,1)
  239.               .            .
  240.  
  241.  
  242.               !*****  CODE SECTION  ****!
  243.  
  244.               CODE
  245.  
  246.   OPEN( fScreen )
  247.   DISPLAY()
  248.   DO ClearFlags
  249.   Gbl:bbQuit = 0
  250.  
  251.   ALERT( Esc_Key )
  252.   ALERT( Up_Key  )
  253.   ALERT( Ctrl_Enter )
  254.   ALERT( Ctrl_Esc   )
  255.   ALERT( F10_Key    )
  256.  
  257.   LOOP
  258.     SELECT( ?FirstField )
  259.     LOOP
  260.       ACCEPT
  261.       Gbl:ibField = FIELD()
  262.       IF REFER()
  263.         UPDATE( ? )
  264.           ! Pad invalid hex digits with zero ('0'):
  265.         DO ZeroPadField
  266.         DISPLAY( ? )                         !.... Display padded field.
  267.         DO ConvertToDec                      !.... Convert hex string to dec.
  268.       END                                    !... IF REFER()
  269.  
  270.       CASE KEYCODE()     ! Process hot keys:
  271.       OF Ctrl_Esc
  272.         Gbl:bbQuit = 1
  273.         BREAK
  274.  
  275.       OF Esc_Key
  276.         SELECT( ? )
  277.         DISPLAY( ? )
  278.  
  279.       OF Up_Key
  280.         SELECT( ? - 1 )
  281.         IF SELECTED() = ?FirstField
  282.           SELECT( ?LastField - 1 )
  283.         END                                  !.... IF FIELD() = ?FirstField
  284.  
  285.       OF Ctrl_Enter                          !... Call Interrupt:
  286.         SELECT( ? )
  287.           !. Filter out Divide By Zero interrupt
  288.           !. (causes system to abort program):
  289.         IF CPU:ibInt = 00h
  290.           CYCLE
  291.         END                                  !.... IF CPU:ibInt = 00h
  292.  
  293.           ! CALL INTERRUPT:
  294.         Interrupt( gCPU_Regs )
  295.  
  296.           ! Update all fields with interrupt return values:
  297.         LOOP Gbl:ibField = ?FirstField TO ?LastField
  298.           DO ConvertToHex
  299.           DO SetCPUFlags
  300.           DISPLAY( Gbl:ibField )
  301.         END                                  !.... LOOP Gbl:ibNdx = ...
  302.  
  303.       OF F10_Key
  304.         SELECT( ?FirstField + 1 )
  305.         CLEAR( gCPU_Strings )
  306.         LOOP Gbl:ibField = ?FirstField TO ?LastField
  307.           DO ZeroPadField
  308.           DISPLAY( Gbl:ibField )
  309.         END                                  !.... LOOP Gbl:ibNdx = ...
  310.         DO ClearFlags                        !.... Clear screen flags.
  311.  
  312.         CPU:ibInt   = 0
  313.         CPU:isAX    = 0
  314.         CPU:isBX    = 0
  315.         CPU:isCX    = 0
  316.         CPU:isDX    = 0
  317.         CPU:isSI    = 0
  318.         CPU:isDI    = 0
  319.         CPU:isDS    = 0
  320.         CPU:isES    = 0
  321.         CPU:isFlags = 0
  322.  
  323.       END                                    !... CASE KEYCODE()
  324.  
  325.       IF Gbl:ibField = ?LastField
  326.         SELECT( ?FirstField + 1 )
  327.       END                                    !... IF Gbl:ibField = ?LastField.
  328.  
  329.     END                                      !.. LOOP
  330.     IF Gbl:bbQuit THEN BREAK.                !.. Quit if TRUE.
  331.   END                                        !. LOOP
  332.   RETURN
  333.  
  334. !────────────────────────────────
  335. ClearFlags    ROUTINE                        ! Clear all screen flags:
  336.   LOOP Gbl:ibNdx = 1 TO SIZE( Gbl:isFlagMask ) * 8
  337.     Scr:ssFlagBit = 0
  338.     DISPLAY( Scr:ssFlagBit )
  339.   END                                        !. LOOP SIZE(Gbl:isFlagMask)...
  340.  
  341. !────────────────────────────────
  342. SetCPUFlags   ROUTINE                        ! Set screen display flag bits:
  343.   Gbl:isFlagMask = 01b
  344.     !. Loop once per bit:
  345.   LOOP Gbl:ibNdx = 1 TO SIZE( Gbl:isFlagMask ) * 8
  346.     IF BAND( CPU:isFlags, Gbl:isFlagMask )
  347.       Scr:ssFlagBit = 1
  348.     ELSE
  349.       Scr:ssFlagBit = 0
  350.     END                                      !.. IF BAND(CPU:isFlags...)
  351.     DISPLAY( Scr:ssFlagBit )
  352.       !. "Walk" mask to the left to test next bit:
  353.     Gbl:isFlagMask = BSHIFT( Gbl:isFlagMask, 1 )
  354.   END                                        !. LOOP SIZE(Gbl:isFlagMask)...
  355.  
  356. !────────────────────────────────
  357. ConvertToHex  ROUTINE                        ! Convert current field to hex:
  358.  
  359.   EXECUTE Gbl:ibField - eFieldOffset         !. -1 offset from ?FirstField.
  360.       !. SPU:sInt only uses the "xx" characters "--xx----" of the return val:
  361.     SPU:sInt = SUB( DecToStrHex( CPU:ibInt ), 3, 2 )
  362.     SPU:sAX = DecToStrHex( CPU:isAX  )
  363.     SPU:sBX = DecToStrHex( CPU:isBX  )
  364.     SPU:sCX = DecToStrHex( CPU:isCX  )
  365.     SPU:sDX = DecToStrHex( CPU:isDX  )
  366.     SPU:sSI = DecToStrHex( CPU:isSI  )
  367.     SPU:sDI = DecToStrHex( CPU:isDI  )
  368.     SPU:sDS = DecToStrHex( CPU:isDS  )
  369.     SPU:sES = DecToStrHex( CPU:isES  )
  370.   END                                        !. EXECUTE Gbl:ibField
  371.  
  372. !────────────────────────────────
  373. ConvertToDec  ROUTINE                        ! Convert current field to decimal:
  374.  
  375.                                   !┌─────────────────────────────────────────┐
  376.                                   !│  Assign low two bytes to CPU register:  │
  377.                                   !└─────────────────────────────────────────┘
  378.   CASE Gbl:ibField
  379.   OF ?SPU:sAX;  Gbl:ilRegVal = StrHexToDec( SPU:sAX );  CPU:gAX   = Ovr:gLow
  380.   OF ?SPU:sBX;  Gbl:ilRegVal = StrHexToDec( SPU:sBX );  CPU:gBX   = Ovr:gLow
  381.   OF ?SPU:sCX;  Gbl:ilRegVal = StrHexToDec( SPU:sCX );  CPU:gCX   = Ovr:gLow
  382.   OF ?SPU:sDX;  Gbl:ilRegVal = StrHexToDec( SPU:sDX );  CPU:gDX   = Ovr:gLow
  383.   OF ?SPU:sSI;  Gbl:ilRegVal = StrHexToDec( SPU:sSI );  CPU:gSI   = Ovr:gLow
  384.   OF ?SPU:sDI;  Gbl:ilRegVal = StrHexToDec( SPU:sDI );  CPU:gDI   = Ovr:gLow
  385.   OF ?SPU:sDS;  Gbl:ilRegVal = StrHexToDec( SPU:sDS );  CPU:gDS   = Ovr:gLow
  386.   OF ?SPU:sES;  Gbl:ilRegVal = StrHexToDec( SPU:sES );  CPU:gES   = Ovr:gLow
  387.   OF ?SPU:sInt; Gbl:ilRegVal = StrHexToDec( SPU:sInt ); CPU:ibInt = Ovr:ibLowLow
  388.   END                                        !. CASE Gbl:ibField.
  389.  
  390. !────────────────────────────────
  391. ZeroPadField  ROUTINE                        ! Zero-pad current field:
  392.  
  393.   EXECUTE Gbl:ibField - eFieldOffset         !. -1 offset from ?FirstField.
  394.     StrZeroPad( SPU:sInt )
  395.     StrZeroPad( SPU:sAX )
  396.     StrZeroPad( SPU:sBX )
  397.     StrZeroPad( SPU:sCX )
  398.     StrZeroPad( SPU:sDX )
  399.     StrZeroPad( SPU:sSI )
  400.     StrZeroPad( SPU:sDI )
  401.     StrZeroPad( SPU:sDS )
  402.     StrZeroPad( SPU:sES )
  403.   END                                        !. EXECUTE FIELD()
  404.  
  405. !────────────────────────────────
  406. StrZeroPad    PROCEDURE( xsString )          ! Replace invalid chars with '0':
  407. !────────────────────────────────
  408.  
  409. xsString      EXTERNAL
  410.  
  411. LocalVars     GROUP, PRE( Lcl )
  412. ilStrLen        LONG                         !. Length of external string.
  413. ilNdx           LONG                         !. Loop index.
  414. s1Char          STRING( 1 )                  !. Character being compared.
  415.               END
  416.  
  417.               CODE
  418.   Lcl:ilStrLen = LEN( xsString )
  419.   LOOP Lcl:ilNdx = 1 TO Lcl:ilStrLen
  420.     Lcl:s1Char = SUB( xsString, Lcl:ilNdx, 1 )
  421.     IF NOT INSTRING( Lcl:s1Char, '0123456789ABCDEF' )
  422.         ! Replace non-valid characters with zero ('0'):
  423.       xsString = SUB( xsString, 1, Lcl:ilNdx - 1 )          |
  424.                & '0'                                        |
  425.                & SUB( xsString, Lcl:ilNdx + 1, Lcl:ilStrLen )
  426.     END                                      !.. IF NOT INSTRING()
  427.   END                                        !. LOOP ibNdx = 1 TO ilStrLen
  428.  
  429. !────────────────────────────────
  430. DecToStrHex   FUNCTION( pisDec )             ! Convert decimal to hex "string":
  431. !────────────────────────────────
  432.  
  433. LocalVars     GROUP, PRE( Lcl )
  434. pisDec          SHORT                        !. Short parameter to convert.
  435.                   !. aibOverDec lays BYTEs over the decimal value:
  436. aibOverDec      BYTE, DIM(SIZE( Lcl:pisDec )), OVER( Lcl:pisDec )
  437. ibNdx           BYTE                         !. Loop index.
  438. ibNibble        BYTE                         !. Nibble being converted.
  439. s1Nibble        STRING( 1 )                  !. Nibble converted to string Hex.
  440. sConverter      STRING( '123456789ABCDEF' )  !. Used to convert hex to dec.
  441. s4RetVal        STRING( 8 )                  !. String Hex return value.
  442.               END
  443.  
  444.               CODE
  445.   Lcl:s4RetVal = ''                          !. Clear any stray value.
  446.     !. Step through overlaid bytes:
  447.   LOOP Lcl:ibNdx = 1 TO MAXIMUM( Lcl:aibOverDec[], 1 )
  448.  
  449.       !. Get low nibble:
  450.     Lcl:ibNibble = BAND( Lcl:aibOverDec[ Lcl:ibNdx ], 0Fh )
  451.     DO NibToHex                              !.. Convert to hex.
  452.  
  453.       !. Get high nibble:
  454.     Lcl:ibNibble = BAND( Lcl:aibOverDec[ Lcl:ibNdx ], 0F0h )
  455.       !. Shift to low nibble for conversion:
  456.     Lcl:ibNibble = BSHIFT( Lcl:ibNibble, -4 )
  457.     DO NibToHex                              !.. Convert to hex.
  458.  
  459.   END                                        !. LOOP Lcl:ibNdx = 1 TO MAX...
  460.   RETURN( Lcl:s4RetVal )
  461.  
  462. !────────────────────────────────
  463. NibToHex      ROUTINE                        ! Convert nibble to hex:
  464.  
  465.   Lcl:s1Nibble = SUB( Lcl:sConverter, Lcl:ibNibble, 1 )
  466.     !. '0' must be handled as an exception because SUB() will return NULL:
  467.   IF Lcl:s1Nibble = ''
  468.     Lcl:s1Nibble = '0'
  469.   END                                        !. IF Lcl:s1Nibble = ''.
  470.     !. Tack nibble onto left side of hex string:
  471.   Lcl:s4RetVal = Lcl:s1Nibble & CLIP( Lcl:s4RetVal )
  472.  
  473. !────────────────────────────────
  474. StrHexToDec   FUNCTION( xsHexStr )           ! Convert hex "string" to decimal:
  475. !────────────────────────────────
  476.  
  477. xsHexStr      EXTERNAL                       !. Converts up to a SHORT.
  478.  
  479. LocalVars     GROUP, PRE( Lcl )
  480. ilRetVal        LONG                         !. Decimal return value.
  481. ibStrLen        BYTE                         !. Length of sHexStr.
  482. ibNdx           BYTE                         !. Loop index.
  483. sConverter      STRING( '123456789ABCDEF' )  !. Used to convert hex to dec.
  484. s1Char          STRING( 1 )                  !. Char to convert.
  485. ibOffset        BYTE                         !. Offset into sConverter.
  486.               END
  487.  
  488.               CODE
  489.   Lcl:ilRetVal = 0
  490.   Lcl:ibStrLen = LEN( xsHexStr )
  491.   LOOP Lcl:ibNdx = Lcl:ibStrLen TO 1 BY - 1
  492.       !. Get one character to convert:
  493.     Lcl:s1Char = SUB( xsHexStr, Lcl:ibNdx, 1 )
  494.       !. Get offset into value table:
  495.     Lcl:ibOffset = INSTRING( Lcl:s1Char, Lcl:sConverter )
  496.       !. Raise character to correct power of 16
  497.       !. (Rightmost position is ^0):
  498.     ilRetVal += Lcl:ibOffset * 16^( Lcl:ibStrLen - Lcl:ibNdx )
  499.   END                                        !. LOOP Lcl:ibNdx=Lcl:ibStrLen...
  500.   RETURN( Lcl:ilRetVal )
  501.  
  502.