home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / CONDEC.PLM < prev    next >
Encoding:
Text File  |  1992-07-06  |  3.7 KB  |  112 lines
  1. $include(subsys.inc)
  2. /*****************************************************************************
  3. *
  4. *    MODULE NAME:    condec (note: module name should always be the same as
  5. *                                  the source file name without the extension)
  6. *
  7. *    DESCRIPTION:    This module contains a decimal conversion procedure.
  8. *
  9. *****************************************************************************/
  10.  
  11. condec:  DO;
  12.  
  13. $include(:rmx:inc/error.lit)
  14. $include(:rmx:inc/common.lit)
  15. $include(strng.ext)
  16.  
  17. $subtitle('construct$integer')
  18. /****************************************************************************
  19. *
  20. *   PROC NAME:      construct$integer
  21. *
  22. *   DESCRIPTION:    a procedure to convert a WORD into a decimal string
  23. *
  24. *   CALL:           CALL construct$integer(buff$ptr,number);
  25. *
  26. *   INPUTS:         number   a WORD to be converted to decimal
  27. *
  28. *   OUTPUTS:        buff$ptr a pointer to a string to which the converted
  29. *                            number will be appended
  30. *                   
  31. ****************************************************************************/
  32.  
  33. construct$integer:    PROCEDURE(buff$ptr,number)   REENTRANT;
  34.  
  35.     DECLARE 
  36.  
  37.             buff$ptr     POINTER,
  38.             number       WORD,
  39.             buff  BASED  buff$ptr  STRING,
  40.             num10        WORD;
  41.  
  42.  
  43.     num10 = number / 10;
  44.     IF  num10 <> 0  THEN
  45.         CALL construct$integer(buff$ptr,num10);
  46.     buff.char(buff.length) = (number MOD 10) + '0';
  47.     buff.length = buff.length + 1;
  48.  
  49. END construct$integer;
  50. $subtitle('convert$decimal')
  51. /****************************************************************************
  52. *
  53. *   PROC NAME:      convert$decimal
  54. *
  55. *   DESCRIPTION:    Converts a 16 bit binary number to a decimal string
  56. *                   and right justifies it in a fixed width field. The
  57. *                   field will be blank padded. If the field width is zero 
  58. *                   no padding will be done.
  59. *
  60. *
  61. *   CALL:           CALL convert$decimal(buff$ptr,buff$max,number,length,
  62. *                                        status$ptr);
  63. *
  64. *
  65. *   INPUTS:         buff$max a WORD containing the size of the buffer
  66. *                   number   a WORD to be converted to decimal
  67. *                   length   a byte containing the width of the field
  68. *                            that the output should be right justified in
  69. *
  70. *
  71. *   OUTPUTS:        buff$ptr   a pointer to a string to which the converted
  72. *                              number will be appended
  73. *                   status$ptr a pointer to a WORD that will receive the
  74. *                              exception word
  75. *
  76. ****************************************************************************/
  77.  
  78.  
  79. convert$decimal:    PROCEDURE(buff$ptr,buff$max,number,length,status$ptr)
  80.                                       REENTRANT  PUBLIC;
  81.  
  82.  
  83.     DECLARE 
  84.  
  85.               buff$ptr     POINTER,
  86.             buff$max     WORD,
  87.             number       WORD,
  88.             length       BYTE,
  89.             i            BYTE,
  90.             status$ptr   POINTER,
  91.             buff  BASED  buff$ptr    STRING,
  92.             status BASED status$ptr  WORD;
  93.  
  94.     DECLARE local$buff   STRUCTURE(
  95.                             length         BYTE,
  96.                             char(5)        BYTE);
  97.  
  98.  
  99.     local$buff.length = 0;
  100.     CALL construct$integer(@local$buff,number);
  101.     IF (length > 0) AND (local$buff.length <= length) THEN
  102.     DO i = 1 TO (length - local$buff.length);
  103.         CALL concatenate$string(buff$ptr,buff$max,@(1,' '),status$ptr);
  104.         IF status <> E$OK THEN
  105.             RETURN;
  106.     END;
  107.     CALL concatenate$string(buff$ptr,buff$max,@local$buff,status$ptr);
  108.  
  109. END convert$decimal;
  110.  
  111. END condec;
  112.