home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 11.ddi / SSCOPE.LIF / PUTILS.P38 < prev    next >
Encoding:
Text File  |  1992-07-02  |  2.8 KB  |  106 lines
  1. $title ('putils')
  2. $optimize(0) word16
  3. $large
  4. $debug
  5.  
  6. putils: do;
  7. $include(/rmx386/inc/common.lit)
  8. $include(/rmx386/inc/rmxplm.ext)
  9.  
  10. declare UINT_8        literally 'byte';
  11. declare UINT_16        literally 'dword';
  12. declare UINT_32        literally 'word';
  13. declare NIL_SEL        literally 'selectorof(NIL)';
  14.  
  15. plm_data: procedure public;
  16. /**********************************************************************/
  17. /* Demonstrates PLM data references.                                  */
  18. /**********************************************************************/
  19.  
  20.     declare    array1(12)        byte data(30,31,32,33,34,35,36,37,38,39,40,41);
  21.     declare excep            word;
  22.     declare i                byte;
  23.  
  24.     declare CUSTOMER_TYPE    literally 'structure(
  25.                 tag            byte,
  26.                 name(8)        byte,
  27.                 phone(7)    byte,
  28.                 linkfor        pointer)';
  29.  
  30.     declare    customerlist(3)    CUSTOMER_TYPE;
  31.  
  32.     declare customer_ptr    pointer,
  33.             customer        based customer_ptr  CUSTOMER_TYPE;
  34.  
  35.     declare oldcust_ptr        pointer,
  36.             oldcust            based oldcust_ptr  CUSTOMER_TYPE;
  37.  
  38.     declare name_init(3)    pointer data(
  39.                                        @('Beth    ', 0),
  40.                                        @('Steve   ', 0),
  41.                                        @('Becky   ', 0));
  42.     declare phone_init(3)    structure(
  43.             number(7)        byte)    data(    '5551234',
  44.                                             '5555678',
  45.                                             '5554321'    );
  46.  
  47.     declare struc1            structure(
  48.                 xbyte        byte,
  49.                 xword        word,
  50.                 xint        integer,
  51.                 xdword        dword,
  52.                 xptr        pointer);
  53.  
  54.       /* Initialize STRUC1 to test variable types.                      */
  55.      struc1.xbyte    = '*';                                  /* byte      */
  56.       struc1.xword    = 65535;                                /* word      */
  57.       struc1.xint     = -32000;                                /* integer   */
  58.       struc1.xdword   = 4000000000;                              /* dword     */
  59.       struc1.xptr     = @array1;                                /* pointer   */
  60.  
  61.       /* Initialize CUSTOMERLIST structures to test based variables.    */
  62.     customer_ptr = NIL;
  63.     do i = 0 to 2;
  64.         oldcust_ptr = customer_ptr;
  65.         customer_ptr = @customerlist(i);
  66.         call movb(name_init(i),@customer.name, 8 );
  67.         call movb(@phone_init(i).number, @customer.phone, 7);
  68.         if ( NIL <> oldcust_ptr ) then
  69.             oldcust.linkfor = customer_ptr;
  70.         do case (i);
  71.             customer.tag = '0';
  72.             customer.tag = '1';
  73.             customer.tag = '2';
  74.             end;
  75.         end;
  76.     end plm_data;
  77.  
  78.  
  79. delay: procedure(msecs) reentrant public;
  80.     declare msecs        word;
  81.  
  82.     declare i            word;
  83.     declare sleep100    word;
  84.  
  85.     sleep100 = msecs / 100;
  86.  
  87.     do i = 1 to sleep100;
  88.         call delay_fine (10);    /*  delay_fine(10) delays for 100 msecs. */
  89.         end;
  90.  
  91.     end delay;
  92.  
  93. delay_fine: procedure(count) reentrant public;
  94.     declare count    word;
  95.  
  96.     declare exception    word;
  97.  
  98.     if count <> 0 then do;
  99.         call rqsleep (1, @exception);    /*  One rqsleep unit is 10 msecs. */
  100.         call delay_fine (count - 1);    /*  Call self recursively.          */
  101.     end;
  102.  
  103.     end delay_fine;
  104.  
  105. end putils;
  106.