
      HED ASCII TO BINARY NUMBER CONVERSION 
**                     ** 
***  HANDLE OVERFLOW  *** 
**                     ** 
* 
*  (A) CONTAINS THE HIGH MANTISSA UPON ENTRY.  (A) AND
*  (B) CONTAIN THE LARGEST REPRESENTABLE NUMBER OF
*  APPROPRIATE SIGN, PACKED, UPON EXIT. 
* 
#OVFL LDB .-2 
      SSA 
      LDB BB776 
      IOR INF 
      SSA 
      LDA MNEG
      JMP OVFLW,I 
**                           ** 
***  CHECK OVER/UNDERFLOWS  *** 
**                           ** 
* 
*  EXIT TO (P+1) IF STATUS IS NOT SYNTAX.  ELSE EXIT TO (P+2),
*  SETTING SYMTB = 4 IF IN KEYBOARD MODE.  THESE ERRORS ARE NOT 
*  REPORTED IF IN TAPE MODE.
* 
#CHOU LDA LNAME     COMPUTE 
      ADA .+?STAT-?ID 
      LDB 0,I         STATUS
      CPB .+4       SYNTAX? 
      RSS           YES 
      JMP CHOU1     NO
      LDA TAPEF     TAPE
      AND MAIN,I
      SZA,RSS         MODE? 
      STB OFLAG     NO                           [B]
      ISZ CHOUF 
      JMP CHOUF,I 
CHOU1 ISZ ENOUF     ARE WE EXECUTING ENTER STATE? 
      RSS           NO
      ISZ CHOUF     YES--SUPPRESS ERROR 
      JMP CHOUF,I 
**                       ** 
***  LOOK FOR A NUMBER  *** 
**                       ** 
* 
*  NUMCK LOOKS FOR AN UNSIGNED NUMBER, SIGN MUST BE SET 
*  BY THE CALLER (SIGN = -1 FOR NEGATIVE, ELSE POSITIVE). 
*  (A) CONTAINS A CHARACTER UPON ENTRY; IF IT IS NEITHER
*  A DIGIT NOR A DECIMAL POINT, EXIT IS TO (P+1) WITH 
*  (A) UNCHANGED AND (B) = 0.  EXIT IS TO ERROR ON FINDING
*  AN EXPONENT PART OF INCORRECT FORMAT.  ZERO REPLACES AN
*  UNDERFLOW; THE LARGEST REPRESENTABLE NUMBER OF THE 
*  APPROPRIATE SIGN REPLACES AN OVERFLOW.  AFTER STORING A
*  FLOATING POINT NUMBER IN M AND M+1 (WHERE SBPTR,I = M) 
*  EXIT IS TO (P+2) WITH THE NEXT INPUT STRING CHARACTER
*  IN (A) AND TEMP+1. 
* 
#NMCK CLB           ZERO
      STB EXP         ALL 
      STB MANT1         COMPONENTS
      STB MANT2           OF THE
      STB EXPON             NUMBER
      STB TEMP+1    SET 'NUMBER FLAG' FALSE 
      CCB           SET 'DECIMAL POINT' 
      STB DPFLG            FLAG FALSE 
NUMC1 CPA .+56B     DECIMAL POINT?
      ISZ DPFLG     YES 
      JMP NUMC2     NO
      CLA           ZERO POST-DECIMAL 
      STA EXPON       DIGIT 
      JMP NUMC4+1       COUNTER 
NUMC2 JSB DIGCK     DIGIT?
      JMP NUMC7     NO
      ISZ EXPON     YES, COUNT DIGIT
      ASL 11        LEFT-JUSTIFY DIGIT
      STA TEMP+2      AND SAVE IT 
      JSB MBY10     MULTIPLY PREVIOUS NUMBER BY 10
      LDB EXP       ZERO
      SZB,RSS         EXPONENT? 
      JMP NUMC6     YES 
      ADB .-4       NO, 
      CMB             SAVE
      LDA TEMP+2        SHIFT 
      STB TEMP+2          COUNT 
      CLB           CLEAR LOWER MANTISSA
NUMC3 ISZ TEMP+2    ALL SHIFTS DONE?
      JMP NUMC5     NO
      CLE           YES, ADD IN 
      ADB MANT2       LOW PART
      CLO               OF NUMBER 
      SEZ           OVERFLOW FROM (B)?
      INA           YES 
      ADA MANT1     ADD IN HIGH PART OF MANTISSA
      SOS           OVERFLOW? 
      JMP NUMC4     NO
      CLE,ERA       YES, CORRECT
      ERB             MANTISSA
      ISZ EXP           AND BUMP
      NOP                 EXPONENT
NUMC4 JSB NORML     NORMALIZE THE NUMBER
      ISZ TEMP+1    SET 'NUMBER FLAG' TRUE
      JSB GETCR     FETCH CHARACTER 
      JMP NUM12-1   NONE FOUND
      JMP NUMC1 
NUMC5 CLE,ERA       SHIFT 
      ERB             DIGIT 
      JMP NUMC3         RIGHT 
NUMC6 LDA .+4       SET 
      STA EXP         EXPONENT
      LDA TEMP+2    LOAD
      CLB             NUMBER
      JMP NUMC4 
NUMC7 CLB           SET EXPONENT
      STB TEMP+2      SIGN TO '+' 
      CPB TEMP+1    DIGIT OR DECIMAL POINT FOUND? 
      JMP NUMCK,I   NO
      CPA E         'E' ? 
      RSS           YES 
      JMP NUM12     NO
      JSB GETCR     FETCH CHARACTER 
      JMP NUM16     NONE FOUND
      CPA .+53B     '+' ? 
      JMP NUMC8     YES 
      CPA .+55B     NO, '-' ? 
      CCA,RSS       YES 
      JMP NUMC9     NO
      STA TEMP+2    SET EXPONENT SIGN TO '-'
NUMC8 JSB GETCR     FETCH CHARACTER 
      JMP NUM16     NONE FOUND
NUMC9 JSB DIGCK     DIGIT?
      JMP NUM16     NO
      STA TEMP+1    YES, SAVE IT
      JSB GETCR 
      JMP NUM11 
      JSB DIGCK     DIGIT?
      JMP NUM11     NO
      LDA TEMP+1    YES, MULTIPLY 
      STB TEMP+1      PREVIOUS DIGIT
      MPY .+10          BY 10 
      ADA TEMP+1    ADD IN NEW DIGIT
      STA TEMP+1    SAVE EXPONENT 
      JSB GETCR 
      JMP NUM11 
      JSB DIGCK     THIRD DIGIT?
      RSS           NO
      JMP NUM16     YES 
NUM11 LDB TEMP+1    LOAD EXPONENT 
      ISZ TEMP+2    POSITIVE? 
      CMB,INB       YES, COMPLEMENT IT
      RSS           NO
      CLB 
NUM12 STA TEMP+1    SAVE CHARACTER
      ISZ DPFLG     DECIMAL POINT FOUND?
      ADB EXPON     YES, CORRECT EXPONENT 
      SZB,RSS       NO, ZERO EXPONENT?
      JMP NUM14     YES 
      SSB           NO, POSITIVE EXPONENT?
      JMP NUM13     YES 
      CMB,INB       NO, SET 
      STB EXPON       COUNTER 
      JSB DBY10     DIVIDE NUMBER BY 10 
      ISZ EXPON     DONE? 
      JMP *-2       NO
      JMP NUM14     YES 
NUM13 STB EXPON     SET COUNTER 
      JSB MBY10     MULTIPLY NUMBER BY 10 
      ISZ EXPON     DONE? 
      JMP *-2       NO
NUM14 LDA MANT1     LOAD
      LDB MANT2       MANTISSA
      ISZ SIGN      POSITIVE? 
      JMP NUM15     YES 
      CMA           NO, COMPLEMENT
      CMB,INB,SZB,RSS  THE
      INA                NUMBER 
NUM15 JSB .PACK     NORMALIZE AND PACK
      STA SBPTR,I   STORE 
      JSB SBPUD       NUMBER IN 
      STB SBPTR,I       DESTINATION 
      JSB SBPUD           ADDRESS 
      LDA TEMP+1    RETRIEVE CHARACTER
      ISZ NUMCK 
NUM16 ISZ NUMCK 
      JMP NUMCK,I 
**                                    **
***  MULTIPLY UNPACKED NUMBER BY 10  ***
**                                    **
* 
*  THE FLOATING POINT NUMBER IN MANT1, MANT2, AND EXP 
*  IS MULTIPLIED BY 10. 
* 
#MB10 LDA MANT1     LOAD HIGH MANTISSA
      SZA,RSS       ZERO NUMBER?
      JMP MBY10,I   YES 
      LDB EXP       NO, 
      ADB .+3         MULTIPLY
      STB EXP           BY 8
      LDB MANT2     LOAD LOW MANTISSA 
      CLE,ERA       DIVIDE
      ERB             BY
      CLE,ERA           4 
      ERB,CLE 
      ADB MANT2     ADD INTO
      SEZ             BOTH REGISTERS
      INA               PRODUCING 
      ADA MANT1           1.25 * MANTISSA 
      SSA,RSS       CORRECT 
      JMP MBY01 
      CLE,ERA         ON
      ERB 
      ISZ EXP           OVERFLOW
      NOP 
MBY01 STA MANT1     STORE 
      STB MANT2       MANTISSA
      JMP MBY10,I 
      SKP 
**                               ** 
***  NORMALIZE UNPACKED NUMBER  *** 
**                               ** 
* 
*  ENTER WITH NUMBER IN (A), (B), AND EXP.  EXIT WITH 
*  NORMALIZED NUMBER IN MANT1, MANT2, AND EXP (MANTISSA 
*  IS LEFT IN (A) AND (B) AS WELL). 
* 
#NRML STA NT0       SET 
      CLA             LEFT-SHIFT
      STA TEMP+2        COUNTER 
      LDA NT0             TO ZERO 
      SZA,RSS       IF NUMBER 
      SZB             IS ZERO,
      JMP NORM2+1       CLEAR 
      STA EXP             EVERYTHING
      STA MANT1     STORE 
NORM1 STB MANT2       MANTISSA
      JMP NORML,I 
NORM2 ISZ TEMP+2    COUNT A LEFT SHIFT
      CLE,ELB       ROTATE (A)
      ELA             AND (B) LEFT
      SEZ,SSA,RSS   TWO HIGHEST BITS 0? 
      JMP NORM2     YES, POSITIVE UNNORMALIZED
      SEZ,SSA       NO, TWO HIGHEST BITS 1? 
      JMP NORM2     YES, NEGATIVE UNNORMALIZED
      ERA           NO, NORMALIZE 
      ERB,CLE         MANTISSA
      STA MANT1     COMPUTE 
      LDA TEMP+2
      CMA,INA         CORRECTED 
      ADA EXP 
      STA EXP           EXPONENT
      LDA MANT1 
      JMP NORM1 
**                               ** 
***  NORMALIZE AND PACK NUMBER  *** 
**                               ** 
* 
*  NUMBER IN (A), (B), AND EXP ON ENTRY.  ON EXIT (A) 
*  AND (B) CONTAIN THE NORMALIZED, ROUNDED, AND PACKED
*  NUMBER.  UNDERFLOW BECOMES A ZERO, OVERFLOW BECOMES
*  THE LARGEST REPRESNTABLE NUMBER OF APPROPRIATE SIGN. 
* 
#PACK JSB NORML     NORMALIZE NUMBER
      CLE,SZA,RSS   ZERO? 
      JMP .PACK,I   YES 
      ADB B177      NO, ROUND 
      SSA,RSS       POSITIVE? 
      INB           YES, FINISH ROUND 
      CLO 
      SEZ           ON OVERFLOW FROM (B)
      CLE,INA         CORRECT (A) 
      SOS           OVERFLOW? ( (A)=100000, (B)=0 ) 
      RAL           TWO HIGH BITS 
      SSA,SLA,RSS     BOTH 1? ( IF (A) WAS 140000 ) 
      JMP PACK1     NO
      CCE           YES 
      ARS,SLA,ALS   SET (A) = 100000 AND SKIP 
PACK1 RAR           UNDOES RAL ABOVE
      STA TEMP+2    SAVE (A)
      LSR 8         DELETE 8 LOW BITS 
      BLF,BLF         OF MANTISSA 
      LDA EXP       DECREMENT 
      SEZ             EXPONENT
      ADA .-1           ON (E) # 0
      SOC           INCREMENT 
      INA             EXPONENT ON OVERFLOW
      ADA B200      EXPONENT
      SSA             UNDERFLOW?
      JMP PACK3     YES 
      ADA M256      NO, EXPONENT
      SSA,RSS         OVERFLOW? 
      JMP PACK4     YES 
      ADA B200      NO, RESTORE EXPONENT
      RAL           POSITION
      AND B377        EXPONENT AND
      ADB 0             ADD LOW MANTISSA
      LDA TEMP+2    RETRIEVE HIGH MANTISSA
      CPA MNEG
      RSS           NEGATIVE
      JMP .PACK,I 
      CPB MNEG+1      OVERFLOW? 
      JMP PACK4     YES 
      JMP .PACK,I   NO
PACK3 JSB CHOUF     CHECK STATUS
      JSB WERRS+6,I 
      CLA           ZERO RESULT 
      CLB             ON UNDERFLOW
      JMP .PACK,I 
PACK4 JSB CHOUF     CHECK STATUS
      JSB WERRS+5,I 
      LDA TEMP+2    RETRIEVE HIGH MANTISSA
      JSB OVFLW 
      JMP .PACK,I 
**                                  **
***  DIVIDE UNPACKED NUMBER BY 10  ***
**                                  **
* 
*  INVERSE OF MBY10 
* 
#DB10 LDA MANT1     RETURN
      SZA,RSS         ON
      JMP DBY10,I       ZERO
      LDB .-2       ADD EXPONENT
      ADB EXP         OF 1/10 TO
      STB EXP           THAT OF NUMBER
      LDA MANT2     JUSTIFY 
      CLE,ERA         LOWER MANTISSA
      MPY TENTH         MULTIPLY BY 1/10
      CLE,ELA       SHIFT 
      ELB,CLE         BACK
      ADA 1         ADD IN EQUIVALENT OF
      SEZ             LOWER MANTISSA* 
      CLE,INB           TENTH*2^(-16) 
      STB MANT2           AND ROUND TO 16 BITS
      LDA MANT1     DO
      MPY TENTH       SAME TO 
      ADA 1             HIGH MANTISSA 
      ADA MANT2     PERFORM EFFECTIVE 
      SEZ             SUM OF DOUBLE-LENGTH
      INB               PRODUCTS
      SWP           SWAP (A) AND (B)
      JSB NORML     NORMALIZE 
      JMP DBY10,I     RESULT
      HED PRINT NAME TABLE
**                                                 ** 
***  PRINT NAME TABLE FOR MULTICHARACTER SYMBOLS  *** 
**                                                 ** 
* 
*  BITS 15-9 OF THE 'OCT' WORD ARE THE BASIC OPERATOR 
*  CODES OF THE SYMBOLS.  BITS 2-0 ARE THE LENGTH IN
*  CHARACTERS OF THE SYMBOLS.  THE ASCII VERSION (PRINT 
*  NAME) FOLLOWS. 
* 
*                                    *
**  MULTICHARACTER BINARY OPERATORS  ** 
*                                    *
MCBOS OCT 32003     AND 
      ASC 1,AN
      OCT 42000 
      OCT 33002     OR
      ASC 1,OR
      OCT 34003     MIN 
      ASC 1,MI
      OCT 47000 
      OCT 35003     MAX 
      ASC 1,MA
      OCT 54000 
MRELS OCT 36002     UNEQUAL 
      ASC 1,<>
      OCT 37002     GREATER THAN OR EQUAL 
      ASC 1,>=
      OCT 40002     LESS THAN OR EQUAL
      ASC 1,<=
*                                   * 
**  MULTICHARACTER UNARY OPERATOR  ** 
*                                   * 
NOT   OCT 41003 
      ASC 1,NO
      OCT 52000 
*                     * 
**  STATEMENT TYPES  ** 
*                     * 
STYPS OCT 42006     ASSIGN
      ASC 3,ASSIGN
USTMT OCT 43005     USING 
      ASC 2,USIN
      OCT 43400 
      OCT 44005     IMAGE 
      ASC 2,IMAG
      OCT 42400 
      OCT 45003     COM 
      ASC 1,CO
      OCT 46400 
      OCT 46003     LET 
      ASC 1,LE
      OCT 52000 
      OCT 47003     DIM 
      ASC 1,DI
      OCT 46400 
      OCT 50003     DEF 
      ASC 1,DE
      OCT 43000 
      OCT 51003     REM 
      ASC 1,RE
      OCT 46400 
      OCT 52004     GOTO
      ASC 2,GOTO
      OCT 53002     IF
      ASC 1,IF
      OCT 54003     FOR 
      ASC 1,FO
      OCT 51000 
      OCT 55004     NEXT
      ASC 2,NEXT
      OCT 56005     GOSUB 
      ASC 2,GOSU
      OCT 41000 
      OCT 57006     RETURN
      ASC 3,RETURN
EOFOP OCT 60003     END 
      ASC 1,EN
      OCT 42000 
      OCT 61004     STOP
      ASC 2,STOP
      OCT 62004     DATA
      ASC 2,DATA
IOSTS OCT 63005     INPUT 
      ASC 2,INPU
      OCT 52000 
      OCT 64004     READ
      ASC 2,READ
      OCT 65005     PRINT 
      ASC 2,PRIN
      OCT 52000 
      OCT 66007     RESTORE 
      ASC 3,RESTOR
      OCT 42400 
      OCT 67003     MAT 
      ASC 1,MA
      OCT 52000 
      OCT 70005     FILES 
      ASC 2,FILE
      OCT 51400 
      OCT 71005     CHAIN 
      ASC 2,CHAI
      OCT 47000 
      OCT 72005     ENTER 
      ASC 2,ENTE
      OCT 51000 
      OCT 73001     'IMPLIED' LET 
      OCT 0 
*                             * 
**  MISCELLANEOUS OPERATORS  ** 
*                             * 
      OCT 74002     OF
      ASC 1,OF
THEN  OCT 75004 
      ASC 2,THEN
      OCT 76002     TO
      ASC 1,TO
STEP  OCT 77004 
      ASC 2,STEP
*                                               * 
**  PREDEFINED FUNCTIONS.  BITS 13-9 ARE USED  ** 
**    FOR INTERNAL IDENTIFICATION              ** 
*                                               * 
TAB   OCT 1003      TAB 
      ASC 1,TA
      OCT 41000 
      OCT 2003      LIN 
      ASC 1,LI
      OCT 47000 
      OCT 3003      SPA 
      ASC 1,SP
      OCT 40400 
PRDFS OCT 4003      TAN 
      ASC 1,TA
      OCT 47000 
      OCT 5003      ATN 
      ASC 1,AT
      OCT 47000 
      OCT 6003      EXP 
      ASC 1,EX
      OCT 50000 
      OCT 7003      LOG 
      ASC 1,LO
      OCT 43400 
      OCT 10003     ABS 
      ASC 1,AB
      OCT 51400 
      OCT 11003     SQR 
      ASC 1,SQ
      OCT 51000 
      OCT 12003     INT 
      ASC 1,IN
      OCT 52000 
      OCT 13003     RND 
      ASC 1,RN
      OCT 42000 
      OCT 14003     SGN 
      ASC 1,SG
      OCT 47000 
      OCT 15003     LEN 
      ASC 1,LE
      OCT 47000 
      OCT 16003     TYP 
      ASC 1,TY
      OCT 50000 
      OCT 17003     TIM 
      ASC 1,TI
      OCT 46400 
      OCT 20003     SIN 
      ASC 1,SI
      OCT 47000 
      OCT 21003     COS 
      ASC 1,CO
      OCT 51400 
      OCT 22003     BRK 
      ASC 1,BR
      OCT 45400 
*                      *
**  MATRIX FUNCTIONS  **
*                      *
MATFS OCT 24003     ZER 
      ASC 1,ZE
      OCT 51000 
      OCT 25003     CON 
      ASC 1,CO
      OCT 47000                                                           999999
      OCT 26003     IDN                                                     9999
      ASC 1,ID
      OCT 47000 
      OCT 27003     INV 
      ASC 1,IN
      OCT 53000 
      OCT 30003     TRN 
      ASC 1,TR
      OCT 47000 
