ASMB
      NAM SADD,7 24306-60001 REV.2026 791205  
* 
* 
******************************************************************* 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
* NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
* TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN
* CONSENT OF HEWLETT-PACKARD COMPANY. 
******************************************************************* 
* 
* 
*     SOURCE:    24306-18004
*     RELOC:     24306-60001
* 
* 
* 
******************************************************************
* 
* 
* 
* 
*FUNCTION - ADDS TWO CHARACTER STRING FIELDS OF 
*ARBITRARY  LENGTH.  THE RESULT IS SET IN THE SECOND
*FIELD. 
* 
*CALLING SEQUENCE 
*   CALL SADD(JSTR,JBEG,JEND,KSTR,KBEG,KEND,IERR) 
* 
*WHERE
*JSTR NAMES A ONE-DIMENSIONAL STRING INTEGER ARRAY
*IN A2 FORMAT CONTAINING THE FIRST CHARACTER STRING 
*FIELD TO BE ADDED. 
*JBEG IS AN INTEGER CONSTANT, INTEGER VARIABLE, OR
*IFTEGER EXPRESSIGN IFDICATIFG THE FIRST CHARACTER
*IN JSTR TO BE ADDED. 
*JEND IS AN INTEGER CONSTANT, INTEGER VARIABLE, OR
*INTEGER EXPRESSION INDICATING THE LAST CHARACTER IN
*JSTR TO BE ADDED.
*KSTR NAMES A ONE-DIMENSIONAL STRING INTEGER ARRAY
*CONTAINING THE DATA TO WHICH THE DATA IN JSTR IS 
*ADDED.IT WILL CONTAIN THE RESULT IN A2 FORMAT
*FOLLOWING ADDITION.
*KBEG IS AN INTEGER CONSTANT, INTEGER VARIABLE, OR
*INTEGER EXPRESSION GIVING THE POSITION OF THE FIRST
*CHARACTER IN KSTR TO BE ADDED. 
*KEND IS AN INTEGER CONSTANT, INTEGER VARIABLE, OR
*INTEGER EXPRESSION GIVING THE POSITION OF TE LAST 
*CHARACTER IN KSTR TO BE ADDED. 
*IERR IS AN INTEGER USED AS AN ERROR INDICATOR. 
*IERR IS SET IF AN INVALID CHARACTER IS ENCOUNTERED 
*OR IF OVERFLOW OCCURS. 
* 
      ENT SADD
      EXT .ENTR,SA2DE,SDEA2,S.GET,SPUT
      EXT SSIGN,SFILL,SCARY 
PARAM BSS 7 
SADD  NOP 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF PARAM 
      CLA 
      STA IERR
      JSB SA2DE     CONVERT JSTR TO D2
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      LDA IERR
      SZA           IFVALID CHAR?
      JMP ERR1      IF SO 
      JSB SA2DE     CONVERT KSTR TO D2
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+4,I 
      DEF PARAM+5,I 
      DEF IERR
      LDA IERR      INVALID CHAR? 
      SZA 
      JMP ERR2      IF SO 
      JSB SSIGN     MAKE NEW SIGN OF JSTR POS.
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF ONE       JSIGN=1 IF JSTR>=0, 
      DEF JSIGN          -1 IF JSTR<0 
      JSB SSIGN     MAKE NEW SIGN OF KSTR POS.
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF ONE       KSIGN=1 IF KSTR>=0
      DEF KSIGN          -1 IF KSTR<0 
      LDA KSIGN     ISIGN=KSIGN*JSIGN 
      MPY JSIGN 
      STA ISIGN 
      LDA PARAM+2,I KNOW=KLAST-JLAST+J
      CMA,INA 
      ADA PARAM+1,I 
      ADA PARAM+5,I 
      STA KNOW
      LDB PARAM+4,I IS KNOW<K?
      CMB,INB 
      ADA 1 
      SSA 
      JMP ERR3      IF SO, OVERFLOW ERROR 
      LDA PARAM+1,I JNOW=J
      STA JNOW
E14   JSB S.GET      ADD JSTR TO KSTR LEFT TO RIGHT 
      DEF *+4 
      DEF PARAM,I 
      DEF JNOW
      DEF JTEST 
      JSB S.GET      KTEST=KSTR(KNOW) 
      DEF *+4 
      DEF PARAM+3,I 
      DEF KNOW
      DEF KTEST 
      LDA JTEST     KTEST=(ISIGN*JTEST)+KTEST 
      MPY ISIGN     NOTE:KTEST=KTEST-JTEST
      ADA KTEST          IF JSTR AND KSTR 
      STA KTEST          HAD DIFFERENT SIGNS
      JSB SPUT      KSTR(KNOW)=KTEST
      DEF *+4 
      DEF PARAM+3,I 
      DEF KNOW
      DEF KTEST 
      ISZ KNOW       KNOW=KNOW+1
      LDA PARAM+2,I IS JNOW>JLAST?
      CMA,INA 
      ADA JNOW
      SSA,RSS 
      JMP CARY      IF SO 
      ISZ JNOW      JNOW=JNOW+1 
      JMP E14       ADD NEXT 2 CHARS
CARY  JSB SCARY     PERFORM CARRY ON KSTR 
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+4,I 
      DEF PARAM+5,I 
      DEF KNOW      KNOW=THE CARY 
      LDA KNOW      KNOW NOT=0?(CARRY OVERFLOW?)
      SZA 
      JMP FILL      IF SO 
BETA  JSB SSIGN     IF NO OVERFLOW
      DEF *+5       RE-ENTER ORIGINAL SIGN IN JSTR
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF JSIGN 
      DEF JNOW
      JSB SSIGN     RE-ENTER ORIGINAL SIGN IN KSTR
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF KSIGN 
      DEF KNOW
EPS   JSB SDEA2     CONVERT JSTR TO A2 FORMAT 
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      JSB SDEA2     CONVERT KSTR TO A2 FORMAT 
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+4,I 
      DEF PARAM+5,I 
      DEF IERR
      JMP SADD,I    RETURN
ERR1  CCA           IERR=-1 
      STA PARAM+6,I 
      JSB SDEA2     CONVERT JSTR TO A2 FORMAT 
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      JMP SADD,I
ERR2  CCA           IERR=-1 
      STA PARAM+6,I 
      JMP EPS 
FILL  SSA           KNOW>0?(POSITIVE CARRY?)
      JMP CMPL
      JSB SFILL     IF SO LEFT FILL KSTR WITH 9'S 
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+4,I 
      DEF PARAM+5,I 
      DEF NINE
ERR3  LDA PARAM+5,I IERR=KLAST
      STA PARAM+6,I 
      JMP BETA
CMPL  JSB S.GET      ADD THE CARRY TO KSTR(KLAST) 
      DEF *+4       KTEST=KSTR(KLAST) 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF KTEST 
      LDA KTEST     KTEST=KTEST+KNOW
      ADA KNOW
      STA KTEST 
      JSB SPUT      KSTR(KLAST)=KTEST 
      DEF *+4 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF KTEST 
      LDA PARAM+4,I KNOW=K
      STA KNOW
GET   JSB S.GET      SUBTRACT EACH NUMBER IN KSTR FROM 9
      DEF *+4       KTEST=KSTR(KNOW)
      DEF PARAM+3,I 
      DEF KNOW
      DEF KTEST 
      LDA KTEST     KTEST=9-KTEST 
      CMA,INA 
      ADA NINE
      STA KTEST 
      JSB SPUT      KSTR(KNOW)=KTEST
      DEF *+4 
      DEF PARAM+3,I 
      DEF KNOW
      DEF KTEST 
      LDA PARAM+5,I IS KNOW<KLAST?
      CMA,INA 
      ADA KNOW
      SSA,RSS 
      JMP *+3       IF SO 
      ISZ KNOW      KNOW=KNOW+1 
      JMP GET 
      LDA KSIGN     KSIGN=-KSIGN
      CMA,INA 
      STA KSIGN 
      JMP CARY
IERR  OCT 0 
JSIGN BSS 1 
KSIGN BSS 1 
ISIGN BSS 1 
KNOW  BSS 1 
JNOW  BSS 1 
JTEST BSS 1 
KTEST BSS 1 
ONE   OCT 1 
NINE  DEC 9 
      END 
      END$
                                                                                                                                                                                    