home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 15 / 15.iso / s / s038 / 1.ddi / SUPP.LIF / UTILS.PLM < prev    next >
Encoding:
Text File  |  1992-07-06  |  3.1 KB  |  76 lines
  1. $compact optimize(3) debug pw(79) rom
  2.  
  3. utils_mod: DO;
  4.  
  5. $INCLUDE (utils.lit)
  6. $INCLUDE (:RMX:inc/hi.ext)
  7.  
  8. /***********************************************************************
  9.  **                                                                   **
  10.  ** OBJECTIVE: To be used as an exception handler by this program.    **
  11.  **                                                                   **
  12.  ** INPUT : [sys$call$ptr] A pointer to a string containing the       **
  13.  **                        system call.                               **
  14.  **         [status] the exception code returned by the system call.  **
  15.  **                                                                   **
  16.  ** OUTPUT: The system call causing the exception, followed by the    **
  17.  **         exception code converted from Hex to Decimal.             **
  18.  **                                                                   **
  19.  ***********************************************************************/
  20. check$exception:    PROCEDURE    (sys$call$ptr,status)    PUBLIC;
  21.     DECLARE    sys$call$ptr    POINTER,
  22.             status            WORD,
  23.             ascii$value    (8)    BYTE,
  24.             hex$char    (*)    BYTE DATA ('0123456789ABCDEF'),
  25.             sys$call$msg(*)    BYTE DATA (22,': SYSTEM CALL FAILED',CR,LF),
  26.             excep$msg    (*)    BYTE DATA (24,'          : EXCEPTION = ');        
  27.  
  28.     IF (status <> E$OK) THEN
  29.     DO;
  30.         ascii$value(0) = 6;
  31.         ascii$value(1) = hex$char(status/1000h MOD 10h);
  32.         ascii$value(2) = hex$char(status/100h MOD 10h);
  33.         ascii$value(3) = hex$char(status/10h MOD 10h);
  34.         ascii$value(4) = hex$char(status MOD 10h);
  35.         ascii$value(5) = CR;
  36.         ascii$value(6) = LF;
  37.  
  38.         CALL rq$c$send$co$response (NIL,0,sys$call$ptr,@status);
  39.         CALL rq$c$send$co$response (NIL,0,@sys$call$msg,@status);
  40.         CALL rq$c$send$co$response (NIL,0,@excep$msg,@status);
  41.         CALL rq$c$send$co$response (NIL,0,@ascii$value,@status);
  42.     END;    /*    status <> E$OK    */
  43.  
  44.     RETURN;
  45. END check$exception;
  46.  
  47.    
  48.  
  49. /***********************************************************************
  50.  **                                                                   **
  51.  ** OBJECTIVE: This function will decrypt any character into its      **
  52.  **            original form. The identity of the original had been   **
  53.  **            preserved by the encryption function.                  **
  54.  **                                                                   **
  55.  ***********************************************************************/
  56. decrypt:    PROCEDURE    (char)    BYTE    PUBLIC;
  57.     DECLARE    char    BYTE;
  58.  
  59.     RETURN ((ror((char-4),4)));
  60. END decrypt;
  61.  
  62. /***********************************************************************
  63.  **                                                                   **
  64.  ** OBJECTIVE: This function will encrypt a character into a dif-     **
  65.  **            ferent character, preserving the identity of the       **
  66.  **            original character.                                    **
  67.  **                                                                   **
  68.  ***********************************************************************/
  69. encrypt:    PROCEDURE    (char)    BYTE    PUBLIC;
  70.     DECLARE    char    BYTE;
  71.  
  72.     RETURN ((rol(char,4))+4);
  73. END encrypt;
  74.  
  75. END utils_mod;
  76.