/ DOUBLE PRECISION INTERPRETIVE PACKAGE
INTERP,  0
  JMP .+2
INTRTN,  ISZ INTERP  /INCREMENT ADDRESS POINTER
  CLA
  TAD I INTERP       /GET INSTRUCTION
  SZA                /IS IT DPEXIT
  JMP .+3
  ISZ INTERP         /RESET RETURN
  JMP I INTERP       /EXIT DP PKG
  AND R7
  DCA ADDR                      /SAVE ADDRESS FIELD
  TAD I INTERP
  AND PBIT
  SNA CLA            /IS IT CURRENT PAGE
  JMP .+5            /NO, PAGE ZERO, ADDR CORRECT
  TAD INTERP         /ADJUST ADDR
  AND L5
  TAD ADDR
  DCA ADDR
  TAD I INTERP
  AND IBIT
  SNA CLA            /IS IT AN INDIRECT ADDRESS
  JMP .+3
  TAD I ADDR         /YES, RESET ADDR
  DCA ADDR                      /YES, RESET ADDR FOR INDIRECT
  TAD I INTERP
  RTL                /GET OP CODE
  RTL
  AND R3
  TAD TABSTR         /TABSTR = JMP I TAB+1
  DCA TAB
  CLA CLL
  DCA DPSGN
TAB,  JMP I .+1
  IF                 /DPIF POINTER
  ADD                /DPADD POINTER
  SUB                /DPSUB POINTER
  MUL                /DPMUL POINTER
  DIV                /DPDIV POINTER
  GET                /DPGET POINTER
  PUT                /DPPUT POINTER
  INTJMP             /INTERPRETIVE JMP POINTER
INTJMP,  TAD ADDR    //INTERPRETIVE JMP ROUTINE
  DCA INTERP
  JMP INTRTN+1
R3,  7
L5,  7600
IF,  ISZ INTERP      //ARITHMETIC BRANCH ROUTINE
  TAD DPAC2
  SPA                /NEGATIVE AC, TRANSFER TO CALL+1
  JMP .+7
  ISZ INTERP
  SZA CLA
  JMP INTRTN         /POSITIVE AC, EXECUTE CALL+3
  TAD DPAC1
  SZA CLA
  JMP INTRTN         /POSITIVE AC, EXECUTE CALL+3
  CLA
  TAD I INTERP       /GET BRANCH ADDRESS FOR ZERO OR NEGATIVE AC
  DCA INTERP
  JMP INTRTN+1       /RETURN TO INTERPRETER - DON'T INCREMENT POINTER
TABSTR,  JMP I TAB+1 /CONSTANT FOR ARITHMETIC COMPUTATION BRANCH
GET,  TAD I ADDR     //START GET
  DCA DPAC1                     /STORE LEAST SIG HALF
  ISZ ADDR
  TAD I ADDR
  DCA DPAAC2                     /STORE MOST SIG HALF
  JMP INTRTN         /END GET
PUT,  TAD DPAC1      //START PUT
  DCA I ADDR         /STORE LEAST SIG HALF
  ISZ ADDR
  TAD DPAC2
  DCA I ADDR         /STORE MOST SIG HALF
  JMP INTRTN         /END PUT
/DOUBLE PRECISION ADD AND SUBTRACT SUBROUTINE WITH OVERFLOW DETECTION
ADD,  TAD I ADDR     //SUM
  TAD DPAC1                     /LEAST
  DCA DPAC1                     /SIG HALF
  ISZ ADDR
  TAD DPAC2
  SPA CLA            /SET SIGN OF ADDEND
  ISZ DPSGN
  TAD I ADDR         /GET OTHER ADDEND
SUBENT,  SPA
  ISZ DPSGN                     /XOR SIGNS OF ADDENDS
  SZL                /IS THERE A CARRY FROM LSH
  IAC                /YES
  TAD DPAC2                     /SUM MOST SIG HALVES
  CLL
  SPA                /PUT SIGN OF
  CML                /  SUM IN LINK
  DCA DPAC2                     /STORE MOST SIG HALF OF SUM
  RTL                /PUT SIGN OF SUM IN BIT 10
  TAD DPSGN                     /XOR SUM SIGN WITH COMMON SIGN OF ADDENDS
  RTR
  SPA CLA            /WERE ADDEND SIGNS ALIKE
  JMP INTRTN         /YES, RETURN
  SZL                /NO, WAS THERE AN OVERFLOW
  JMP DPERR                     /YES-
  JMP INTRTN         /NO, RETURN TO INTERPRETER
SUB,  DCA SAV        /SUBTRACT ROUTINE
  TAD I ADDR
  CIA                /NEGATE LSH OF SUBTRAHEND
  SZL                /IS THERE CARRY TO MSH
  ISZ SAV            /YES
  CLL
  TAD DPAC1                     /SUM LSH
  DCA DPAC1                     /STORE LSH
  ISZ ADDR
  TAD DPAC2
  SPA CLA            /SET SIGN OF MINUEND
  ISZ DPSGN
  TAD I ADDR
  CMA                /COMPLEMENT MSH OF SUBTRAHEND
  TAD SAV            /ADD CARRY
  JMP SUBENT         /FINISH IN ADDITION SUBROUTINE
SAV,  0
DPCMA,  0            //COMPLEMENT DPAC
  CLA CLL
  TAD DPAC1
  CIA
  DCA DPAC1
  TAD DPAC2
  CMA
  SZL
  IAC CLL
  DCA DPAC2
  ISZ DPSGN
  JMP I DPCMA
MUL,  TAD I ADDR     //DOUBLE PRECISION MULTIPLY ROUTINE
  DCA MULT1
  ISZ ADDR
  TAD I ADDR
  DCA MULT2
  DCA DPAC3
  DCA DPAC4
  TAD MULT2
  SPA CLA
  JMS CMAMLT
  TAD DPAC2
  SPA CLA
  JMS I DPCMAP
  TAD MULCNT
  DCA MULCTR
  CLL
MULLP,  TAD DPAC2
  RAR
  DCA DPAC2
  TAD DPAC1
  RAR
  DCA DPAC1
  ISZ MULCTR
  JMP .+6
  TAD DPSGN
  RAR 
  SZL
  JMS BIGCMA
  JMP I INRTNP
  SNL
  JMP .+7
  CLA CLL
  TAD MULT1
  TAD DPAC3
  DCA DPAC3
  GLK
  TAD MULT2
  TAD DPAC4
  RAR
  DCA DPAC4
  TAD DPAC3
  RAR
  DCA DPAC3
  JMP MULLP
CMAMLT,  0                      //COMPLEMENT MULTIPLIER
  CLA CLL
  TAD MULT1
  CIA
  DCA MULT1
  TAD MULT2
  CMA
  SZL
  IAC
  DCA MULT2
  ISZ DPSGN
  JMP I CMAMLT
BIGCMA,  0                      //COMPLEMENT DPAC AND DPACEXT
  JMS I DPCMAP
  TAD DPAC3
  CMA
  SZL
  IAC CLL
  DCA DPAC3
  TAD DPAC4
  CMA
  SZL
  IAC CLL
  DCA DPAC4
  JMP I BIGCMA
DIV,  TAD I ADDR     //DOUBLE PRECISION DIVIDE ROUTINE
  CIA
  DCA MULT1
  ISZ ADDR
  TAD I ADDR
  CMA
  SZL
  IAC CLL
  SZL                /IS DIVISOR ZERO
  JMP DPERR                     /YES, ERROR EXIT
  DCA MULT2
  TAD MULT2
  SMA CLA
  JMS CMAMLT
  TAD DPAC4
  SPA CLA
  JMS BIGCMA
  TAD MULCNT
  DCA MULCTR
  CLA CLL
DIVLP,  TAD DPAC3
  TAD MULT1
  DCA DPAC3
  GLK
  TAD DPAC4
  TAD MULT2
  SPA
  JMP .+4
  CLL CML
  DCA DPAC4
  JMP .+7
  CLA
  TAD MULT1
  CIA
  TAD DPAC3
  DCA DPAC3
  CLL
  TAD DPAC1
  RAL
  DCA DPAC1
  TAD DPAC2
  RAL
  DCA DPAC2
  ISZ MULCTR
  JMP .+6
  TAD DPSGN
  RAR
  SZL CLA
  JMS I DPCMAP
  JMP I INRTNP
  TAD DPAC3
  RAL
  DCA DPAC3
  TAD DPAC4
  RAL
  DCA DPAC4
  JMP DIVLP
INRTNP,  INTRTN
DPCMAP,  DPCMA
*7
INTP,  INTERP        /ENTRY POINTER FOR DOUBLE PRECISION INTERP PKG
*40
DPAC1,  0 / DOUBLE PRECISION ACCUMULATOR - LEAST SIG HALF
DPAC2,  0 /DOUBLE PRECISION ACCUMULATOR - MOST SIG HALF
DPAC3,  0 /DOUBLE PRECISION ACCUMULATOR EXTENSION - LSH
DPAC4,  0 / DOUBLE PRECISION ACCUMULATOR EXTENSION - MSH
MULT1,  0 /MULTIPLIER OR DIVISOR - LEAST SIG HALF
MULT2,  0 /MULTIPLIER OR DIVISOR - MOST SIG HALF
MULCTR,  0           /SUBROUTINE LOOP COUNTER
MULCNT,  -31         /MULTIPLY STEP COUNTER
ADDR,  0  /POINTER TO ADDRESS OF ARGUMENT
DPSGN,  0 /SIGN STORAGE
R7,  177
PBIT,  200
IBIT,  400
DPERR,  HLT          /RETURN FOR ADD, SUBTRACT OVRFLO OR ZERO DIVISOR
PAUSE
{*U*!8