midrange.com code scratchpad
Name:
Using memcpy to compress blanks out of an array
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
04/27/2011 01:31:20 am
IP:
Logged
Description:
This program will compress out the blanks from a simple array. It uses memcpy() to shift entries around.

This is intended as a demonstration of concept, and lacks practical application as a standalone entity.
Code:
  1.      H OPTION(*NOSHOWCPY:*NOEXPDDS:*NODEBUGIO:*SRCSTMT)
  2.      H DATFMT(*ISO) TIMFMT(*ISO)
  3.      H BndDir('QC2LE')
  4.      H DFTACTGRP(*NO)
  5.  
  6.      D ARRMEMCPY       PR                  ExtPgm('ARRMEMCPY')
  7.  
  8.      D ARRMEMCPY       PI
  9.  
  10.  
  11.      D MemCpy          PR              *   ExtProc('__memcpy')
  12.      D  ToAddr                         *   value
  13.      D  FromAddr                       *   value
  14.      D  copyLen                      10I 0 value
  15.  
  16.  
  17.      D compressArray   PR                  ExtProc('compressArray')
  18.  
  19.      D MAX_DIM         C                   6
  20.  
  21.      D line            S             30    DIM(6) Inz(*Blanks)
  22.  
  23.  
  24.       /Free
  25.  
  26.        line(2) = '   data 1' ;
  27.        line(5) = '  data here' ;
  28.        line(6) = ' f=data 2' ;
  29.        compressArray() ;
  30.  
  31.        *INLR = *On ;
  32.  
  33.       /End-free
  34.  
  35.  
  36.      P compressArray   B
  37.      D compressArray   PI
  38.  
  39.  
  40.      D pSrc            S               *
  41.      D pTgt            S               *
  42.      D len             S             10I 0
  43.      D i               S              3U 0
  44.      D j               S              3U 0
  45.      D skipped         S              3U 0 Inz(*Zero)
  46.      D nextEnt         S              3U 0
  47.  
  48.       /Free
  49.  
  50.        i = 1 ;
  51.        nextEnt = MAX_DIM + 1 ;
  52.        DoU i = *Zero or i >= nextEnt ;      // Essentially forever.
  53.           i = %Lookup(*Blanks: line: i) ;
  54.           If i > *Zero and i < nextEnt ;    // We found a target
  55.              skipped = *Zero ;
  56.              pTgt = %Addr(line(i)) ;        // We'll copy TO here...
  57.              For j = i+1 to nextEnt - 1 ;   // Find our source (FROM) addr
  58.                 skipped += 1 ;              // Number skipped (blank) lines
  59.                 If line(j) <> *Blank ;      // We found our source
  60.                    pSrc = %Addr(line(j)) ;  // Set our FROM addreess
  61.                                             // Length is number of elements
  62.                                             // from j to end of array *
  63.                                             // length of each element
  64.                    len = %Size(LINE) * (nextEnt - j) ;
  65.                    memcpy(pTgt: pSrc: len) ;
  66.                    nextEnt -= skipped ;     // Last possible nonblank + 1
  67.  
  68.                    // Now we need to overlay blank lines at the end
  69.                    // Number of lines to clear is the value in SKIPPED.)
  70.  
  71.                    line(nextEnt) = *Blanks ;
  72.                    If skipped > 1 ;
  73.                       pSrc = %Addr(line(nextEnt)) ;    // Blank line
  74.                       pTgt = pSrc + %Size(line) ;      // Next entry
  75.                       len = %Size(line) * (skipped - 1) ;
  76.                       memcpy(pTgt: pSrc: len) ;
  77.                    EndIF ;
  78.                    Leave ;                  // Out of inner FOR loop
  79.                 EndIF ;                     // Found non-blank after blank
  80.              EndFOR ;                       // Find next blank
  81.              If j >= nextEnt ;              // No more non-blank entries
  82.                 Leave ;                     // We're done!
  83.              EndIF ;
  84.           EndIF ;                           // End: found a target
  85.        EndDO ;
  86.        Return ;
  87.  
  88.       /End-free
  89.  
  90.      P compressArray   E
  91.  
© 2004-2019 by midrange.com generated in 0.008s valid xhtml & css