ASMB,R,L,C
      HED <<BASIC - DECIMAL STRING INTERFACE>>
      NAM BADEC,7 92101-16020 REV.1650
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS    *
* RESERVED.  NO 
* PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
      ENT D.
SUB,D.ADD,D.MPY,D.DIV,D.EDT 
* 
      EXT .ENTR,SADD,SSUB,SMPY,SDIV,SEDIT,SMOVE 
* 
**********************************************
*                                            *
*    DECIMAL STRING BASIC INTERFACE PACKAGE  *
* 
* 
**********************************************
* 
JSTR  NOP 
KSTR  NOP 
AERR  NOP 
D.ADD NOP 
      JSB .ENTR 
      DEF JSTR
* 
      CLA 
      STA AERR,I       INITIALIZE ERROR INDICATOR 
      LDA JSTR,I       GET STRING CHARACTER COUNT 
      STA JEND         SAVE AS STRING END 
      LDA KSTR,I       GET CHARACTER COUNT OF 2ND STRING
      STA KEND         SAVE AS STRING END 
      ISZ JSTR         SKIP TO NEXT WORD OF EACH STRING 
      ISZ KSTR
      JSB SADD
         CALL STRING ADD
      DEF *+8 
      DEF JSTR,I       JSTR 
      DEF .1             IS ADDED TO
      DEF JEND             KSTR 
      DEF KSTR,I
      DEF .1
      DEF KEND
      DEF AERR,I
      JMP D.ADD,I      RETURN 
* 
* 
* 
* 
LSTR  NOP 
MSTR  NOP 
SERR  NOP 
D.SUB NOP 
      JSB .ENTR 
      DEF LSTR
* 
      CLA 
      STA SERR,I       INITIALIZE ERROR INDICATOR 
      LDA LSTR,I       GET STRING CHARACTER COUNT 
      STA JEND         SAVE AS STRING END 
      LDA MSTR,I       GET CHARACTER COUNT OF 2ND STRING
      STA KEND         SAVE AS STRING END 
      ISZ LSTR         SKIP TO NEXT WORD OF EACH STRING 
      ISZ MSTR
      JSB SSUB         CALL STRING SUBTRACT 
      DEF *+8 
      DEF LSTR,I       LST
      DEF .1             IS SUBTRACTED FROM 
      DEF JEND             MSTR 
      DEF MSTR,I
      DEF .1
      DEF KEND
      DEF SERR,I
      JMP D.SUB,I      RETURN 
* 
* 
* 
* 
RSTR  NOP 
SSTR  NOP 
MERR  NOP 
D.MPY NOP 
      JSB .ENTR 
      DEF RSTR
* 
      CLA 
      STA MERR,I       INITIALIZE ERROR INDICATOR 
      LDA RSTR,I       GET STRING CHARACTER COUNT 
      STA JEND         SAVE AS STRING END 
      LDA SSTR,I       GET CHARACTER COUNT OF 2ND STRING
      STA KEND         SAVE AS STRING END 
      ISZ RSTR         SKIP TO NEXT WORD OF EACH STRING 
      ISZ SSTR
* 
      LDA JEND         COMPUTE EXTRA WORK SPACE 
      ALS                REQUIRED FOR THE COMPUTATION 
      ADA KEND             N1-(2*JEND)+KEND+1 
      INA 
      STA N1
      ADA KEND             N2=(2*JEND)+(2*KEND) 
      ADA M1
      STA N2
* 
      JSB SMOVE        CALL STRING MOVE 
      DEF *+6 
      DEF SSTR,I       SSTR 
      DEF .1             IS MOVED TO
      DEF KEND         KTEMP
      DEF KTEMP 
      DEF N1
* 
      JSB SMPY         CALL STRING MULTIPLY 
      DEF *+8 
      DEF RSTR,I       RSTR 
      DEF .1             IS MULTIPLIED BY 
      DEF JEND             SSTR (IN KTEMP)
      DEF KTEMP 
      DEF N1
      DEF N2
      DEF MERR,I
* 
      LDB MERR,I       TEST ERROR INDICATOR 
      LDA 1            SAVE IN A-REGISTER 
      CMB,INB          TEST FOR SMPY OVERFLOW 
      ADB N2             (MERR=N2)
      SZB,RSS 
      JMP OVFL          YES 
      SZA              TEST FOR OTHER SMPY ERRORS 
      JMP EXIT2        YES, ERROR RETURN
      LDA JEND
      CMA,INA 
      ADA N1
      STA N3           N3=N1-JEND 
* 
      CMA,INA          COMPUTE LENGTH OF PRODUCT
      ADA N2
      INA 
      STA LEN          SAVE AS RESULT STRING CHAR COUNT 
      LDB PTRS,I       GET ADDRESS OF RESULT STRING 
      CMB,INB          SUBTRACT FROM ADDRESS OF ERR PARM
      ADB PTRM,I
      BLS              DOUBLE TO GET SPACE IN CHARACTERS
      CMA,INA 
      ADB 0            COMPARE DIFFERENCE (DIM SPACE) 
      SSB                WITH SPACE NEEDED FOR PRODUCT
      JMP OVFL         NOT ENOUGH SPACE - OVERFLOW
* 
      JSB SMOVE        CALL STRING MOVE 
      DEF *+6 
      DEF KTEMP         KTEMP 
      DEF N3             IS MOVED TO
      DEF N2               SSTR 
      DEF SSTR,I
      DEF .1
* 
      LDA LEN          GET LENGTH OF RESULT 
      LDB SSTR         GET STRING ADDRESS 
      ADB M1           GET ADDRESS OF FIRST WORD
      STA 1,I          STORE IN FIRST WORD OF STRING
      CLA,RSS          SET MERR=0 
OVFL  LDA KEND         SET MERR=KEND
      STA MERR,I
* 
EXIT2 JMP D.MPY,I      RETURN 
* 
* 
* 
* 
* 
* 
GSTR  NOP 
HSTR  NOP 
DERR  NOP 
REM   NOP 
D.DIV NOP 
      JSB .ENTR 
      DEF GSTR
* 
      CLA 
      STA DERR,I       INITIALIZE ERROR INDICATOR 
      STA REM,I        INITIALIZE REMAINDER INDICATOR 
      LDA GSTR,I       GET STRING CHARACTER COUNT 
      STA JEND         SAVE AS STRING END 
      LDA HSTR,I       GET CHARACTER COUNT OF 2ND STRING
      STA KEND         SAVE AS STRING END 
      ISZ GSTR
      ISZ HSTR
* 
* 
      LDA JEND         COMPUTE EXTRA WORK SPACE 
      ALS                REQUIRED FOR THE COMPUTATION 
      ADA KEND             N1=(2*JEND)+KEND+1 
      INA 
      STA N1
      ADA KEND             N2=(2*JEND)+(2*KEND) 
      ADA M1
      STA N2
* 
      JSB SMOVE        CALL STRING MOVE 
      DEF *+6 
      DEF HSTR,I       HSTR 
  
    DEF .1             IS MOVED TO
      DEF KEND             KTEMP
      DEF KTEMP 
      DEF N1
* 
      JSB SDIV         CALL STRING DIVIDE 
      DEF *+8 
      DEF GSTR,I       GSTR 
      DEF .1             IS DIVIDED INTO
      DEF JEND
         HSTR (IN KTEMP)
      DEF KTEMP 
      DEF N1
      DEF N2
      DEF DERR,I
* 
      LDB DERR,I       TEST ERROR INDICATOR 
      LDA 1            SAVE IN A-REGISTER 
      CMB,INB          TEST FOR SDIV OVERFLOW 
      ADB N2            (DERR-N2) 
      SZB,RSS 
      JMP OVFL2        YES
      SZA              TEST FOR OTHER SDIV ERRORS 
      JMP EXIT         YES, ERROR RETURN
      LDA JEND
      CMA,INA 
      ADA N1
      STA N3           N3=N1-JEND 
* 
      CMA,INA          COMPUTE LENGTH OF QUOTIENT 
      ADA N2
      INA 
      STA LEN          SAVE AS RESULT STRING CHAR COUNT 
      LDB PTRH,I       GET ADDRESS OF RESULT STRING 
      CMB,INB          SUBTRACT FROM ADDRESS OF ERR PARM
      ADB PTRD,I
      BLS               DOUBLE TO GET SPACE IN CHARACTERS 
      CMA,INA 
      ADB 0            COMPARE DIFFERENCE (DIM SPACE) 
      SSB                WITH SPACE NEEDED FOR QUOTIENT 
      JMP OVFL2        NOT ENOUGH SPACE - OVERFLOW
* 
      JSB SMOVE         CALL STRING MOVE
      DEF *+6 
      DEF KTEMP          RESULT IN KTEMP
      DEF N3               IS MOVED TO
      DEF N2                 HSTR 
      DEF HSTR,I
      DEF .1
* 
      LDA LEN          GET LENGTH OF RESULT 
      LDB HSTR         GET STRING ADDRESS 
      ADB M1           GET ADDRESS OF FIRST WORD
      STA 1,I 
* 
      LDB JEND         GET DIVISOR STRING CHAR. COUNT 
      ADB M1           (JEND-1) IS RELATIVE LOCATION OF 
      CMD,INB            REMAINDER IN THE RESULT STRING 
      ADB 0            CHARACTER COUNT - (JEND-1) 
      STB REM,I        POSITION OF REMAINDER IN RESULT
      CLA,RSS          SET DERR=0 
OVFL2 LDA KEND         SET DERR=KEND
      STA DERR,I
* 
EXIT  JMP D.DIV,I      RETURN 
* 
* 
* 
* 
PSTR  NOP 
QSTR  NOP 
EERR  NOP 
D.EDT NOP              ENTRY
      JSB .ENTR        GET PARAMETERS 
      DEF PSTR
      LDA PSTR,I       GET STRING CHARACTER COUNT 
      STA JEND         SAVE AS STRING END 
      LDB,QSTR,I       GET CHAR COUNT OF 2ND STRING 
      CMA,INA          TEST IF PSTR GREATER THAN QSTR 
      ADA 1 
      SSA 
      JMP OVFL3        YES, ERROR RETURN
      STB KEND         NO, SAVE AS STRING END 
      ISZ PSTR         SKIP TO NEXT WORD OF EACH STRING 
  
  ISZ QSTR
* 
      JSB SEDIT        CALL STRING EDIT ROUTINE 
      DEF *+7 
      DEF PSTR,I       PSTR IS EDITED 
      DEF .1             USING EDIT MASK
      DEF JEND             IN QSTR
      DEF QSTR,I       RESULT IN QSTR 
      DEF .1
  
    DEF KEND
      CLB              SET ERROR INDICATOR TO ZERO
OVFL3 STB EERR,I       RETURN 0 OR KEND AS ERROR NUMBER 
* 
      JMP D.EDT,I      RETURN 
* 
* 
* 
* 
M1    DEC -1
.1    DEC 1 
N1    BSS 1 
N2    BSS 1 
N3    BSS 1 
KTEMP BSS 
1020
JEND  BSS 1 
KEND  BSS 1 
LEN   BSS 1 
PTRD  DEF DERR
PTRH  DEF HSTR
PTRM  DEF MERR
PTRS  DEF SSTR
* 
      END