Retro1.org codex

*DECK XCTLW 
USETEXT NIPDEF
USETEXT NP$NWNC 
 PROC XCTLW(WORD,TLW);           #COMPUTE TEXT LENGTH IN WORDS         #
 
 STARTIMS;
 #
*1DC  XCTLW 
* 
*     1. PROC NAME           AUTHOR               DATE
*        XCTLW               P.C.TAM              80/02/12
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE COMPUTES THE TEXT LENGTH IN WORDS.
* 
*     3. METHOD USED. 
*        THE TEXT LENGTH IN WORDS IS COMPUTED FROM THE APPLICATION
*          CHARACTER TYPE AND THE TEXT LENGTH IN CHARACTERS.
* 
*     4. ENTRY CONDITIONS.
*          ABHACT            APPLICATION CHARACTER TYPE 
*          ABHTLC            APPLICATION TEXT LENGTH IN CHARACTERS
*          WORD              APPLICATION BLOCK HEADER 
* 
*     5. EXIT CONDITIONS. 
*          TLW               TEXT LENGTH IN WORDS 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        HEADER     NIPDEF     NP$NWNC
* 
*     7. ROUTINES CALLED. 
*          XTRACE            RECORD CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        THIS PROCEDURE IS CALLED BY BDELINK, HPGET, HPPUT, 
*        AND HPUTF. 
* 
 #
 STOPIMS; 
 ARRAY WORD [0:0] S(1); 
 BEGIN
*CALL HEADER
 END
 ITEM TLW, TMP; 
 XREF 
      BEGIN 
      PROC XTRACE;
      END 
 
#**********************************************************************#
 
      BEGIN 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("XCTLW") ; 
      CONTROL FI; 
 
      IF ABHABT[0] EQ APPNULL 
      THEN # A NULL BLOCK TO BE DELIVERED TO THE APPLICATION           #
        TLW = 0;
      ELSE # COMPUTE TLW FOR NON-NULL BLOCK                            #
        BEGIN 
        TMP = ABHACT[0]; # CHARACTER TPYE OF BLOCK                     #
        TLW = (2*ABHTLC[0] + NW$ROUND[TMP])/NW$FACT[TMP]; 
        END 
 
      RETURN; 
 
      END 
  TERM