ASMB
      NAM SDIV,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-18010
*     RELOC:     24306-60001
* 
* 
* 
******************************************************************
* 
* 
* 
* 
*FUNCTION - DIVIDE ONE CHARACTER STRING FIELD OF
*ARBITRARY LENGTH,KSTR, BY ANOTHER CHARACTER STRING 
*OF ARBITRARY LENGTH,JSTR  AND PLACE THE QUOTIENT 
*AND THE REMAINDER IN KSTR
* 
*CALLING SEQUENCE 
*CALL SDIV(JSTR,J,JLAST,KSTR,K,KLAST,NER) 
* 
*UPON COMPLETION OF SDIV,KSTR WILL BE CONFIGURED AS FOLLOWS:
*THE LEFTMOST DIGIT OF THE QUOTIENT WILL BE IN
* POSITION A OF KSTR WHERE
*  A=K-(JLAST-J+1)
*THE RIGHTMOST DIGIT OF THE QUOTIENT WILL BE IN 
* POSITON B OF KSTR WHERE 
*  B=KLAST-(JLAST-J+1)
*THE LEFTMOST DIGIT OF THE REMAINDER WILL BE IN 
* POSITION C OF KSTR WHERE
*  C=KLAST-(JLAST-J)
*THE RIGHTMOST DIGIT OF THE REMAINDER WILL BE IN
* POSITION KLAST OF KSTR
* 
*ERROR CONDITIONS 
* 
*IF DIVISION BY ZERO IS ATTEMPTED, KSTR IS EXTENDED 
* AND FILLED WITH ZEROS AND NER IS SET TO KLAST 
*IF THERE IS NOT ENOUGH ROOM TO EXTEND THE KSTR FIELD 
* TO THE LEFT,NER=KLAST,AND SDIV RETURNS
*IF JSTR OR KSTR CONTAINS ANON-NUMERIC CHAR IN OTHER
* THAN THE LAST POSITION,NER=-1 
* 
      ENT SDIV
      EXT .ENTR,S.GET,SPUT,SSIGN,SFILL
      EXT SA2DE,SDEA2,SDCAR,SD2D1,SD1D2 
PARAM BSS 7 
SDIV  NOP 
      JSB .ENTR     TRANSFER PARAMETERS 
      DEF PARAM 
      CLA 
      STA IERR
      LDA PARAM+1,I EXTEND KSTR FIELD TO THE LEFT OF
      CMA,INA         THE JSTR FIELD
      INA           JSPAN=JLAST-J+1 
      ADA PARAM+2,I 
      STA JSPAN 
      CCA           KSTRT=K-1 
      ADA PARAM+4,I 
      STA KSTRT 
      LDA JSPAN     KLOW=K-JSPAN
      CMA,INA 
      ADA PARAM+4,I 
       STA KLOW 
      ADA KLOW      BLOW=2*KLOW-KLAST-1 
      LDB PARAM+5,I BLOW IS 1ST POSITION IN 
      CMB           KSTR AFTER CONVERSION 
      ADA 1          TO D1 FORMAT 
      STA BLOW
      LDA JSPAN    IS KLAST-KSTRT-JSPAN<0?(OVERFLO?)
      ADA KSTRT    KSTR FIELD EXTENDED TOO FAR TO 
      CMA,INA           THE LEFT?)
      ADA PARAM+5,I 
      SSA 
      JMP ERR1      IF SO 
      LDA BLOW      IF BLOW>0?
      SSA 
      JMP ERR1      IF NOT
      SZA,RSS 
      JMP ERR1      IF NOT
      JSB SA2DE     CONVERT JSTR TO D2 FORMAT 
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      LDA IERR      NON-NUMERIC CHAR IN JSTR? 
      SZA 
      JMP ERR2      IF SO 
      JSB SA2DE     CONVERT KSTR TO D2 FORMAT 
      DEF *+5 
      DEF PARAM+3,I 
      DEF PARAM+4,I 
      DEF PARAM+5,I 
      DEF IERR
      LDA IERR      NON-NUMERIC CHAR IN KSTR? 
      SZA 
      JMP ERR3      IF SO 
      JSB SSIGN     SAVE SIGN OF JSTR IN JSIGN AND
      DEF *+5       CLEAR SIGN
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF ONE 
      DEF JSIGN 
      JSB SSIGN     SAVE SIGN OF KSTR IN KSIGN AND
      DEF *+5       CLEAR SIGN
      DEF PARAM+3,I 
      DEF PARAM+5,I 
      DEF ONE 
      DEF KSIGN 
      JSB SFILL     FILL KSTR WITH ZEROS TO THE LEFT
      DEF *+5 
      DEF PARAM+3,I OF THE LENGTH OF THE JCARD FIELD
      DEF KLOW      (FROM KSTR(KLOW)TO KSTR(KSTRT)) 
      DEF KSTRT 
      DEF ZERO
      LDA PARAM+1,I JFRST=J 
      STA JFRST 
E1    JSB S.GET      JTEST=JSTR(JFRST)
      DEF *+4 
      DEF PARAM,I 
      DEF JFRST 
      DEF JTEST 
      LDA JTEST     IS JTEST>0? 
      SSA 
      JMP LOOP
      SZA 
      JMP A3        IF SO 
LOOP  LDA PARAM+2,I IS JFRST<JLAST? 
      CMA,INA 
      ADA JFRST 
      SSA,RSS 
      JMP ERR4      IF NOT,DIVISOR ALL ZEROS
      ISZ JFRST     IF SO JFRST=JFRST+1 
      JMP E1
A3    JSB SD2D1     CONVERT KSTR TO D1
      DEF *+5 
      DEF PARAM+3,I 
      DEF KLOW
      DEF PARAM+5,I 
      DEF DIFF
      LDA JTEST     JHIGH=JTEST  (FIRST DIGIT IN
      STA JHIGH       DIVISOR)
      LDA JFRST     BPUT=KLOW+JLAST-JFRST+DIFF
      CMA,INA         (BPUT IS POINTER TO QUOTIENT) 
      ADA PARAM+2,I 
      ADA KLOW
      ADA DIFF
      STA BPUT
      LDA PARAM+2,I BSTOP=KLAST+JFRST-JLAST-1+DIFF
      CMA        (BSTOP IS THE POINTER TO THE 1ST 
      ADA JFRST     POSITION TO THE RIGHT OF THE
      ADA PARAM+5,I    QUOTIENT)
      ADA DIFF
      STA BSTOP 
      LDA KSTRT     BKM=KSTRT+DIFF
      ADA DIFF
      STA BKM       BKM IS POINTER TO THE CURRENT 
MUL   LDB BKM         DIGIT OF THE DIVIDEND 
      ADB PARAM+3   KTEN=KSTR(BKM)
      LDA 1,I    (PICK NEXT 2 DIGITS OF DIVIDEND AS 
      STA KTEN          MULTIPLIER) 
      INB          KUNIT=KSTR(BKM+1)
      LDA 1,I 
      STA KUNIT 
      LDA KTEN      DMULT=(10*KUNIT+KTEN)/JHIGH 
      MPY TEN         MULT=CURRENT DIGIT OF QUOTIENT
      ADA KUNIT 
      DIV JHIGH 
      STA MULT
      STA NQUO      NQUO=MULT 
      SSA           MULT>0? 
      JMP NEWPT 
      SZA,RSS 
      JMP NEWPT 
RESUB LDA BKM       SUBTRACT PRODUCT OF MULT AND
      INA 
      STA KNOW        DIVISOR FROM DIVIDEND 
      LDA JFRST     KNOW=BKM+1
      STA JNOW         KNOW IS POINTER TO DIVIDEND
SUB   JSB S.GET      JNOW=JFRST 
      DEF *+4         JNOW IS POINTER TO DIVISOR
      DEF PARAM,I 
      DEF JNOW      JTEST=JSTR(JNOW)
      DEF JTEST 
      LDB KNOW      KTEST=KSTR(KNOW)
      ADB PARAM+3 
      LDA 1,I 
      STA KTEST 
      LDA MULT      KTEST=KTEST-MULT*JTEST
      MPY JTEST 
      CMA,INA 
      ADA KTEST 
      STA KTEST 
      LDB KNOW      KSTR(KNOW)=KTEST
      ADB PARAM+3 
      STA 1,I 
      LDA KNOW
      STA KNOW1 
      ISZ KNOW      KNOW=KNOW+1 
      LDA PARAM+2,I IS JNOW<JLAST?
      CMA,INA 
      ADA JNOW
      SSA,RSS 
      JMP CARY      IF NOT
      ISZ JNOW      JNOW=JNOW+1 
      JMP SUB 
CARY  JSB SDCAR     RESOLVE CARRY IN THE DIFFERENCE 
      DEF *+5 
      DEF PARAM+3,I 
      DEF BKM 
      DEF KNOW1 
      DEF KNOW
      LDA KNOW    IS THE CARRY>=0?(THE CARRY=KNOW)
      SSA,RSS 
      JMP NEWPT     IF SO 
      LDA KNOW     IF NO,KSTR(BKM)=KSTR(BKM)+10*KNOW
      MPY TEN 
      LDB BKM 
      ADB PARAM+3 
      ADA 1,I 
      STA 1,I 
      CCA           MULT=-1 
      STA MULT
      LDA NQUO      NQUO=NQUO-1 
      ADA NEG1
      STA NQUO
      JMP RESUB 
NEWPT LDA NQUO      KSTR(BPUT)=NQUO 
      LDB BPUT
      ADB PARAM+3 
      STA 1,I 
      ISZ BPUT      BPUT=BPUT+1 
      LDA BSTOP     IS BKM<BSTOP? 
      CMA,INA 
      ADA BKM 
      SSA,RSS 
      JMP QSIGN     IF SO 
      ISZ BKM       BKM=BKM+1 
      JMP MUL 
QSIGN  JSB SD1D2     CONVERT KSTR TO D2 
      DEF *+5 
      DEF PARAM+3,I 
      DEF KLOW
      DEF PARAM+5,I 
      DEF DIFF
      LDA JSIGN     ISIGN=JSIGN*KSIGN 
      MPY KSIGN 
      STA ISIGN 
      LDA JSPAN     COMPUTE QPTR,THE POINTER TO THE 
      CMA,INA        RIGHTMOST DIGIT OF QUOTIENT
      ADA PARAM+5,I   QPTR=KLAST-JSPAN
      STA QPTR
      JSB SSIGN    SET SIGN OF THE QUOTIENT TO ISIGN
      DEF *+5 
      DEF PARAM+3,I 
      DEF QPTR
      DEF ISIGN 
      DEF KNOW
RAPUP JSB SSIGN     RESTORE ORIGINAL SIGN(JSIGN)TO
      DEF *+5         JSTR
      DEF PARAM,I 
      DEF PARAM+2,I 
      DEF JSIGN 
      DEF KNOW
      JSB SSIGN     RESTORE ORIGINAL SIGN (KSIGN) TO
      DEF *+5         KSTR (THIS IS THE SIGN OF 
      DEF PARAM+3,I   THE REMAINDER)
      DEF PARAM+5,I 
      DEF KSIGN 
      DEF KNOW
CONV JSB SDEA2      CONVERT JSTR TO A2 FORMAT 
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      LDA JSPAN     LQUO=KLAST-(JLAST-J+1)
      CMA,INA        LQUO IS THE POSITION OF THE
      ADA PARAM+5,I  RIGHTMOST DIGIT OF THE QUOTIENT
      STA LQUO
      INA           FREM=KLAST-(JLAST-J), THE POSITION
      STA FREM        OF THE LEFTMOST DIGIT OF THE
      JSB SDEA2        REMAINDER
      DEF *+5       CONVERT THE QUOTIENT IN KSTR TO A2
      DEF PARAM+3,I 
      DEF BLOW
      DEF LQUO
      DEF IERR
      JSB SDEA2     CONVERT THE REMAINDER IN KSTR TO A2 
      DEF *+5 
      DEF PARAM+3,I 
      DEF FREM
      DEF PARAM+5,I 
      DEF IERR
      JMP SDIV,I    RETURN
ERR4  LDA PARAM+5,I NER=KLAST 
      STA PARAM+6,I 
      JMP RAPUP 
ERR1  LDA PARAM+5,I NER=KLAST 
      STA PARAM+6,I 
      JMP SDIV,I   RETURN 
ERR3  CCA           NER=-1
      STA PARAM+6,I 
      JMP CONV
ERR2  CCA           NER=-1
      STA PARAM+6,I 
      JSB SDEA2     CONVERT JSTR TO A2
      DEF *+5 
      DEF PARAM,I 
      DEF PARAM+1,I 
      DEF PARAM+2,I 
      DEF IERR
      JMP SDIV,I    RETURN
TEN   DEC 10
NEG1  DEC -1
ZERO  OCT 0 
ONE   OCT 1 
IERR  OCT 0 
JSPAN BSS 1 
KSTRT BSS 1 
KLOW  BSS 1 
JSIGN BSS 1 
KSIGN BSS 1 
JFRST BSS 1 
JTEST BSS 1 
JHIGH BSS 1 
BPUT  BSS 1 
BSTOP BSS 1 
BKM   BSS 1 
BLOW  BSS 1 
DIFF  BSS 1 
KTEN  BSS 1 
KUNIT BSS 1 
MULT  BSS 1 
NQUO BSS 1
KNOW  BSS 1 
JNOW  BSS 1 
KTEST BSS 1 
KNOW1 BSS 1 
ISIGN BSS 1 
QPTR  BSS 1 
LQUO  BSS 1 
FREM  BSS 1 
      END 
      END$