Retro1.org codex

*DECK NP$ZRBK 
*IF DEF,XFR 
PROC NP$ZRBK (WORDADR,FLAG) ; 
 
      BEGIN  # NP$ZRBK #
 
# 
***   1.PROC NAME            AUTHOR        DATE 
*       NP$ZRBK              L.T.NGUYEN    83/06/22 
* 
*     2.FUNTIONAL DESCRIPTION:  
*       NP$ZRBK TAKES A WORD OF DISPLAY CHARACTER DATA AND REPLACES 
*       TRAILING BLANKS WITH BINARY ZEROS OR ZERO WITH BLANKS.
* 
*     3.INPUT PARAMS: 
*              WORDADR - ADR THE WORD WHICH CONTAINS THE CHARACTER DATA.
*              FLAG    - 0 FOR ZERO TO BLANK. 
*                        1 FOR BLANK TO ZERO. 
* 
*     4.EXIT PARAMS: WORD = WORD WITH TRAILING BLANKS REPLACED BY 
*                           BINARY ZEROS OR ZERO BY BLANKS. 
* 
# 
      DEF COLON #00# ;
      DEF BLNK #O"55"# ;
      BASED ARRAY WARDC S(1) ;
      BEGIN 
        ITEM WORD      C(0,0,10);              # INPUT WORD # 
      END 
      ITEM WORDADR U ;
      ITEM FLAG      B ;
      ITEM I  I ; 
 
      P<WARDC> = WORDADR ;
 
      IF FLAG 
      THEN
        BEGIN                            # TRAILING BLANKS TO ZEROS    #
        FOR I = 0 STEP 1 UNTIL 9
        DO
          IF C<I,1>WORD[0] EQ BLNK
          THEN
            C<I,1>WORD[0] = O"00" ; 
        END                              # TRAILING BLANKS TO ZEROS    #
      ELSE
        BEGIN                            # ZEROS TO BLANKS             #
        FOR I = 0 STEP 1 UNTIL 9
        DO
          IF C<I,1>WORD[0]  EQ COLON
          THEN
            C<I,1>WORD[0] = BLNK ;
        END 
 
      RETURN ;
      END  # NP$ZRBK #
 
      TERM
*ENDIF