ASMB,R,Q,C
      HED DEB$, DELETE LEADING AND TRAILING BLANKS SUBROUTINE 
      NAM DEB$,7  92076-1X037  REV.2001  790425 
      ENT DEB$
      EXT .ENTR,EXEC,ERRCD
* 
*********************************************** 
* 
*     SOURCE: 92076-18037 
*     RELOC.: PART OF 92076-12001 
* 
*********************************************** 
* 
*     THIS SUBROUTINE DELETES LEADING AND 
*     TRAILING BLANKS IN A STRING AND RESETS
*     THE LOGICAL LENGTH TO THE STRING
*     LENGTH MINUS THE NUMBER OF LEADING
*     AND TRAILING BLANKS.THE FORMAT OF 
*     THIS CALL IS AS FOLLOWS:
* 
*       XXXX DEB$(A$) 
* 
*     WHERE: A$=ANY VALID STRING
* 
********************************************************************* 
* 
CPAR  DEF * 
DEB$  NOP 
      JSB .ENTR     RETRIEVE PARAMETERS 
      DEF CPAR
* 
* 
      LDA .0        LOAD ZERO 
      STA TBLKS     INITIALIZE # OF TRAILING BLANKS 
      STA LBLKS     AND LEADING BLANKS TO ZERO
* 
* 
* CHECK FIRST WORD OF STRING PASSED FOR NONZERO LENGTH
* IF LENGTH IS ZERO, STRING IS NOT INITIALIZED AND WE 
* WILL EXIT WITHOUT DOING ANYTHING TO IT. 
* 
* 
      LDA CPAR,I    LOAD FIRST WORD OF STRING 
      AND B177      MASK LOWER BYTE(LENGTH) 
      SZA,RSS       LENGTH=0? 
      JMP ERR1      YES,EXIT WITH MESSAGE 
      STA WLGTH     NO,SAVE WORKING STRING LENGTH 
      STA OLGTH     AND ORIGINAL STRING LENGTH
* 
* 
      CLB 
      DIV .2        DIVIDE LENGTH BY TWO
      SZB           REMAINDER=0?
      INA           NO(ODD #OF CHARS),ADD 1 TO WORD COUNT 
      STA WORDS     AND SAVE # OF WORDS IN STRING 
* 
* 
      LDA CPAR      LOAD ADDRESS OF FIRST WORD IN STRING
      ADA WORDS     INCREMENT TO ADDRESS OF LAST WORD IN STRING.
      STA WADDR     AND SAVE IN WORKING ADDRESS 
* 
* 
      LDA WADDR,I   LOAD LAST WORD IN STRING
      SZB,RSS       ODD # OF CHARACTERS IN STRING?
      JMP TBLK1     NO, EVEN # OF CHARACTERS
* 
* 
      AND B7740     YES,MASK UPPER BYTE 
      CPA SBLKU     UPPER BYTE=BLANK? 
      JMP TBLK4     YES 
      JMP LBLK1     NO TRAILING BLANKS,CHECK FOR LEADING BLANKS 
* 
* 
TBLK1 CPA DBLNK     IS WORD A DOUBLE BLANK? 
      JMP *+2       YES 
      JMP TBLK3     NO,CHECK FOR BLANK IN LOWER BYTE
* 
* 
      LDA WLGTH     LOAD CURRENT STRING LENGTH
      ADA M2        DECREMENT BY 2
      STA WLGTH     AND SAVE
* 
* 
      LDA TBLKS     LOAD CURRENT # OF TRAILING BLANKS 
      ADA .2        INCREMENT BY 2
      STA TBLKS     AND SAVE
* 
* 
TBLK2 LDA WADDR     LOAD CURRENT STRING WORD ADDRESS
      ADA M1        DECREMENT ADDRESS BY 1
      STA WADDR     AND SAVE
* 
* 
      LDA WADDR,I   LOAD NEXT WORD
      JMP TBLK1     CHECK FOR DOUBLE BLANKS 
* 
* 
TBLK3 AND B177      MASK LOWER BYTE 
      CPA SBLKL     LOWER BYTE=BLANK? 
      JMP TBLK4     YES 
      JMP TBLK5     NO MORE TRAILING BLANKS 
* 
* 
TBLK4 LDA WLGTH     LOAD CURRENT STRING LENGTH
      ADA M1        DECREMENT BY 1
      STA WLGTH     AND SAVE
* 
* 
      LDA TBLKS     LOAD CURRENT # OF TRAILING BLANKS 
      ADA .1        INCREMENT BY 1
      STA TBLKS     AND SAVE
* 
* 
      SZB,RSS       ODD # OF CHARACTERS FLAG=0? 
      JMP TBLK5     YES,NO MORE TRAILING BLANKS 
* 
* 
      CLB           NO,CLEAR ODD # OF CHARACTERS FLAG 
      JMP TBLK2     CHECK NEXT WORD FOR BLANKS
* 
* 
* IF STRING IS ALL BLANKS,THEN EXIT WITH MESSAGE AND
* DON'T DO ANYTHING TO STRING.
* 
* 
TBLK5 LDA TBLKS     LOAD TOTAL # OF TRAILING BLANKS 
      CMA,INA       MAKE NEGATIVE 
      STA 1         SAVE IN B REGISTER. 
      ADA OLGTH     ADD TO ORIGINAL STRING LENGTH 
      SZA,RSS       IS IT ZER0? 
      JMP ERR2      YES,STRING IS ALL BLANKS,EXIT 
* 
*                   FIX STRING LENGTH, DROP BLANKS. 
* 
      ADB CPAR,I    ADJUST BYTE COUNT 
      STB CPAR,I     FOR RETURN AND 
      STB OLGTH      LEADING CHECK. 
* 
* 
* 
* THIS PART OF THE SUBROUTINE 
* CHECKS FOR LEADING BLANKS 
* 
* 
* 
LBLK1 LDB CPAR      LOAD ADDRESS OF FIRST WORD OF STRING
      INB           INCREMENT TO SECOND WORD
      LDA 1,I       LOAD SECOND WORD IN STRING
* 
* 
LBLK2 CPA DBLNK     IS WORD A DOUBLE BLANK? 
      JMP *+2       YES 
      JMP LBLK3     NO,CHECK FOR BLANK IN UPPER BYTE
* 
* 
      LDA WLGTH     LOAD CURRENT STRING LENGTH
      ADA M2        DECREMENT LENGTH BY 2 
      STA WLGTH     AND SAVE
* 
* 
      LDA LBLKS     LOAD CURRENT # OF LEADING BLANKS
      ADA .2        ADD 2 
      STA LBLKS     AND SAVE
* 
* 
      INB           INCREMENT WORKING ADDRESS BY 1
* 
* 
      LDA 1,I       LOAD NEXT WORD
      JMP LBLK2     CHECK NEXT WORD FOR BLANKS
* 
* 
LBLK3 AND B7740     MASK UPPER BYTE 
      CPA SBLKU     UPPER BYTE=BLANK? 
      JMP LBLK4     YES 
      LDA LBLKS     PICK UP COUNT.
      SZA,RSS       DON'T BOTHER IF = 0 
      JMP EXIT
      JMP RFMT      NO MORE LEADING BLANKS
* 
* 
LBLK4 LDA WLGTH     LOAD CURRENT STRING LENGTH
      ADA M1        DECREMENT BY 1
      STA WLGTH     AND SAVE
* 
* 
      LDA LBLKS     LOAD CURRENT # OF LEADING BLANKS
      INA           ADD 1 
      STA LBLKS     AND SAVE
* 
* 
* 
* THIS SECTION OF THE SUBROUTINE RESETS THE STRING
* LENGTH IN THE FIRST WORD AND DELETES LEADING
* BLANKS BY SHIFTING THE STRING TO THE LEFT 
* 
* (A)=# OF LEADING BLANKS 
* (B)=CURRENT WORKING ADDRESS OF STRING 
*    =FIRST WORD WITH A NON-BLANK CHARACTER IN IT 
* 
* 
RFMT  CMA,INA       MAKE # OF LEADING BLANKS NEGATIVE 
      ADA OLGTH      ADD TO ORIGINAL STRING LENGTH
      STA CPAR,I     SAVE NEW LENGTH IN FIRST WORD OF STRING
      STA WLGTH      AND IN STRING WORKING LENGTH 
* 
* 
      LDA CPAR       LOAD ADDRESS OF FIRST WORD IN STRING 
      INA            INCREMENT TO SECOND WORD 
      STA SADDR      AND SAVE IN NEW STRING ADDRESS 
* 
* 
      LDA LBLKS      LOAD # OF LEADING BLANKS 
      SLA,RSS        # OF LEADING BLANKS ODD? 
      JMP RFMT2      NO,EVEN
* 
* 
RFMT1 LDA 1,I        LOAD NON-BLANK WORD FROM STRING
      AND B177       MASK LOWER BYTE
      ALF,ALF        ROTATE TO UPPER BYTE 
      STA SADDR,I    STORE IN NEW STRING LOCATION 
* 
* 
      LDA WLGTH      LOAD NEW STRING LENGTH COUNTER 
      ADA M1         DECREMENT BY 1 
      STA WLGTH      AND SAVE 
* 
* 
      SZA,RSS        LENGTH COUNTER=0?
      JMP EXIT       YES,EXIT 
* 
* 
      INB            INCREMENT WORKING ADDRESS OF STRING
* 
* 
      LDA 1,I        LOAD NEXT NON-BLANK WORD 
      AND B7740      MASK UPPER BYTE
      ALF,ALF        ROTATE TO LOWER BYTE 
      ADA SADDR,I    PUT BYTE IN LOWER PART OF WORD.
      STA SADDR,I    STORE IN NEW STRING LOCATION 
* 
* 
      LDA WLGTH      LOAD NEW STRING LENGTH COUNTER 
      ADA M1         DECREMENT LENGTH BY 1
      STA WLGTH      AND SAVE 
* 
* 
      SZA,RSS        LENGTH COUNTER=0?
      JMP EXIT       YES,EXIT 
* 
* 
      LDA SADDR      NO,LOAD NEW STRING LOCATION
      INA            INCREMENT BY 1 
      STA SADDR      AND SAVE 
* 
* 
      JMP RFMT1      GET NEXT CHARACTER 
* 
* 
RFMT2 LDA 1,I        LOAD NEXT WORD 
      AND B7740      MASK UPPER BYTE
      STA SADDR,I    STORE IN NEW STRING LOCATION 
* 
* 
      LDA WLGTH      LOAD NEW STRING LENGTH COUNTER 
      ADA M1         DECREMENT BY 1 
      STA WLGTH      AND SAVE 
* 
* 
      SZA,RSS        NEW STRING LENGTH COUNTER=0? 
      JMP EXIT       YES, EXIT
* 
* 
      LDA 1,I        LOAD CURRENT WORKING WORD
      AND B177       MASK LOWER BYTE
      ADA SADDR,I    PUT IN UPPER BYTE. 
      STA SADDR,I    STORE IN NEW STRING LOCATION 
* 
* 
      LDA WLGTH      LOAD NEW STRING LENGTH COUNTER 
      ADA M1         DECREMENT BY 1 
      STA WLGTH      AND SAVE 
* 
* 
      SZA,RSS        NEW STRING LENGTH COUNTER=0? 
      JMP EXIT       YES,EXIT 
* 
* 
      LDA SADDR      NO,LOAD NEW STRING ADDRESS 
      INA            INCREMENT BY 1 
      STA SADDR      AND SAVE 
* 
* 
      INB            INCREMENT STRING WORKING ADDRESS 
      JMP RFMT2      GET NEXT NON-BLANK WORD
* 
* 
* MESSAGES
* 
* 
*CHANGED 800425*****
ERR1  LDA .100       LOAD IN NUMBER OF ERROR
      STA ERRCD      PASS IN ERROR INDICATOR IN CALSB 
      JMP EXIT
* 
* 
ERR2  LDA .200       LOAD IN NUMBER OF ERROR
      STA ERRCD      AND SAVE 
EXIT  JMP DEB$,I     EXIT 
******800425***** 
* 
* 
* 
* CONSTANTS 
* 
.0    DEC 0 
TBLKS BSS 1 
LBLKS BSS 1 
B177  OCT 177 
WLGTH BSS 1 
OLGTH BSS 1 
.2    DEC 2 
WORDS BSS 1 
M1    DEC -1
.100  DEC 100 
.200  DEC 200 
WADDR BSS 1 
B7740 OCT 77400 
SBLKU OCT 20000 
DBLNK OCT 20040 
M2    DEC -2
SBLKL OCT 40
.1    DEC 1 
SADDR BSS 1 
* 
* 
      END