ASMB
      NAM SMPY,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-18017
*     RELOC:     24306-60001
* 
* 
* 
******************************************************************
* 
* 
* 
* 
*FUNCTION - MULTIPLY ONE CHARACTER STRING FIELD OF
*ARBITRARY LENGTH BY A SECOND CHARACTER STRING AND
*PLACE THE RESULT IN THE SECOND STRING
* 
*CALLING SEQUENCE 
*CALL SMPY(JSTR,J,JLAST,KSTR,K,KLAST,NER) 
* 
*ERROR CONDITIONS 
*IF KSTR DOES NOT HAVE ENOUGH POSITIONS TO ALLOW FOR
*ITS EXTENSION NER=KLAST AND SMPY TERMINATES
*IF JSTR OF KSTR CONTAINS A NON-NUMERIC CHAR IN OTHER 
*THAN THE LAST POSITION,NER=-1
* 
      ENT SMPY
      EXT .ENTR,SA2DE,SSIGN,SFILL 
      EXT S.GET,SDCAR,SDEA2,SD2D1,SD1D2 
PARAM BSS 7 
SMPY  NOP 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF PARAM 
      CLA 
      STA IERR
      LDA PARAM+2,I 
      CMA           KSTRT=K-JLAST+J-1 
      ADA PARAM+1,I 
      ADA PARAM+4,I 
      STA KSTRT 
      ADA KSTRT     BLOW=2*KSTRT-KLAST-1
      LDB PARAM+5,I BLOW IS 1ST POSITION IN KSTR
      CMB            AFTER CONVERSION TO D1 
      ADA 1 
      STA BLOW
      SSA           BLOW<0?(OVERFLOW?)
      JMP ERR1      IF SO 
      SZA           BLOW=0?(OVERFLOW?)
      JMP *+2 
      JMP ERR1      IF SO 
      JSB SA2DE     CONVERT JSTR TO D2
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      LDA IERR      ILLEGAL CHAR? 
      SZA 
      JMP ERR2      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      ILLEGAL CHAR? 
      SZA 
      JMP ERR3      IF SO 
      JSB SSIGN     PICK UP SIGN OF JSTR,SEJ JSTR>=0
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF ONE 
      DEF JSIGN     IF JSTR>=0,JSIGN=1,ELSE JSIGN=-1
      JSB SSIGN     PICK UP SIGN OF KSTR,SET KSTR>=0
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF ONE 
      DEF KSIGN     IF KSTR>=0,KSIGN=1,ELSE KSIGN=-1
      CCA           IY=K-1
      ADA PARAM+4,I 
      STA IY
      JSB SFILL     LEFT FILL KSTR WITH 0 
      DEF *+5 
      DEF PARAM+3,I 
      DEF KSTRT 
      DEF IY
      DEF ZERO
      LDA PARAM+1,I JFRST=J 
      STA JFRST 
E25   JSB S.GET      JTEST=JSTR(JFRST)
      DEF *+4 
      DEF PARAM,I 
      DEF JFRST 
      DEF JTEST 
      LDA JTEST     JTEST>O?
      SSA 
      JMP AGAIN 
      SZA 
      JMP E47       IF SO 
AGAIN LDA PARAM+2,I JFRST-JLAST>=O?(JSTR=0?)
      CMA,INA 
      ADA JFRST 
      SSA,RSS 
      JMP FILL      IF SO 
      ISZ JFRST     JFRST=JFRST+1 
      JMP E25 
FILL  JSB SFILL     FILL KSTR WITH 0
      DEF *+5 
      DEF PARAM+3,I 
      DEF BLOW
      DEF PARAM+5,I 
      DEF ZERO
E40   JSB SSIGN     RESTORE SIGN OF JSTR
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF JSIGN 
      DEF JNOW
E41   JSB SDEA2     CONVERT JSTR TO A2
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      JSB SDEA2     CONVERT KSTR TO A2
      DEF *+5 
      DEF PARAM+3,I 
      DEF BLOW
      DEF PARAM+5,I 
      DEF IERR
      JMP SMPY,I    RETURN
E47   JSB SD2D1     CONVERT KSTR TO D1
      DEF *+5 
      DEF PARAM+3,I 
      DEF KSTRT 
      DEF PARAM+5,I 
      DEF DIFF
      LDA PARAM+4,I CALCULATE WORD ADDRESS
      ADA DIFF       FOR INDICES FOR D1 FORMAT: 
      STA BKM        BKM=K+DIFF 
      LDA PARAM+5,I  BLAST=KLAST+DIFF 
      ADA DIFF
      STA BLAST 
      LDA KSTRT       BSTRT=KSTRT+DIFF
      ADA DIFF
      STA BSTRT 
E48   LDB BKM       MULT=KSTR(BKM)
      ADB PARAM+3 
      LDA 1,I 
      STA MULT
      SZA,RSS       MULT=0? 
      JMP E50       IF SO 
      SSA,RSS       MULT>0? 
      JMP E60       IF SO 
E50   LDA BLAST     BKM-BLAST>0?
      CMA,INA 
      ADA BKM 
      SSA,RSS 
      JMP CARY      IF SO 
      ISZ BKM       BKM=BKM+1 
      JMP E48 
CARY  JSB SDCAR     RESOLVE CARRIES IN KSTR 
      DEF *+5 
      DEF PARAM+3,I 
      DEF BSTRT 
      DEF BLAST 
      DEF KNOW
      JSB SD1D2     CONVERT KSTR TO D2
      DEF *+5 
      DEF PARAM+3,I 
      DEF KSTRT 
      DEF PARAM+5,I 
      DEF DIFF
      LDA JSIGN     IY=JSIGN*MSIGN
      MPY KSIGN 
      STA IY
      JSB SSIGN     MAKE IY SIGN OF KSTR
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF IY
      DEF KNOW
      JMP E40 
E60   LDB BKM       KSTR(BKM)=0 
      ADB PARAM+3 
      CLA 
      STA 1,I 
      LDA PARAM+2,I KNOW=BKM+JFRST-JLAST
      CMA,INA 
      ADA JFRST 
      ADA BKM 
      STA KNOW
      LDA JFRST     JNOW=JFRST
      STA JNOW
E62   JSB S.GET      **START OF INNER LOOP**
      DEF *+4       JTEST=JSTR(JNOW)
      DEF PARAM,I 
      DEF JNOW
      DEF JTEST     KTEST=KSTR(KNOW)
      LDB KNOW      KTEST=KSTR(KNOW)
      ADB PARAM+3 
      LDA 1,I 
      STA KTEST 
      LDA MULT      *******HEART OF ALGORITHM*******
      MPY JTEST     ITEST=MULT*JTEST+KTEST
      ADA KTEST 
      LDB KNOW
      ADB PARAM+3   KSTR(KNOW)=ITEST
      STA 1,I 
      ISZ KNOW      KNOW=KNOW+1 
      LDA PARAM+2,I JNOW-JLAST>=0?
      CMA,INA 
      ADA JNOW
      SSA,RSS 
      JMP E50       IF SO 
      ISZ JNOW      JNOW=JNOW+1 
      JMP E62       **END OF INNER LOOP** 
ERR1  LDA PARAM+5,I NER=KLAST 
      STA PARAM+6,I 
      JMP SMPY,I    RETURN
ERR2  CCA        NER=-1 
      STA PARAM+6,I CONVERT JSTR TO A2
      JSB SDEA2 
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      JMP SMPY,I
ERR3  CCA           NER=-1
      STA PARAM+6,I 
      JMP E41 
ZERO  OCT 0 
ONE   OCT 1 
IERR  OCT 0 
KSTRT BSS 1 
BLOW  BSS 1 
JSIGN BSS 1 
IY    BSS 1 
JFRST BSS 1 
JTEST BSS 1 
KSIGN BSS 1 
KTEST BSS 1 
JNOW  BSS 1 
KNOW  BSS 1 
BKM   BSS 1 
BLAST BSS 1 
DIFF  BSS 1 
MULT  BSS 1 
BSTRT BSS 1 
      END 
      END$
                                                                                                                                                                                                                    