****************************************************************
*
*
*
*
*     PINTERP :  8080/Z80 P_CODE INTERPRETER.
*
*     (C) COPYRIGHT 1978, STANFORD LINEAR ACCELERATOR CENTER.
*
*     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*
*
*     THIS IS AN 8080/Z80 INTERPRETER FOR THE  P_CODE  GENERATED
*     BY THE SLAC MICRO PASCAL COMPILER/POST_PROCESSOR.  IT ALSO
*     'DEFINES'  THE SIMULATED STACK COMPUTER, THE SO CALLED "P"
*     MACHINE, ITS ORGANIZATION AS WELL AS ITS INSTRUCTION SET.
*   
*     IN ORDER TO RELOCATE THIS PROGRAM  AND/OR CHANGE  THE AREA
*     ALLOCATED FOR THE P_CODE BEING INTERPRETED, LOOK UNDER THE
*     "GLOBAL DEFINITIONS" HEADING.  BOTH  THE  INTERPRETER  AND
*     THE   P_CODE   AREA   MAY  BE  RELOCATED  FREELY  AND  THE
*     INTERPRETER DOES NOT USE ANY OF THE "RST" INSTRUCTIONS.
*
*     THE FOUR ROUTINES "GCH", "PCHG", "OPN", AND "CLS" ARE  ARE
*     PROTOTYPES FOR SPECIFYING THE NECCESSARY I/O INTERFACE AND
*     THEY  HAVE  TO  BE  REPLACED  BY  THE  ACTUAL ENTRY POINTS
*     PROVIDED BY THE HOST MACHINE'S FILE SYSTEM. THESE ROUTINES
*     BASICALLY PROVIDE GET, PUT, OPEN AND CLOSE  OPERATIONS  ON
*     PASCAL  FILES.   NOTE THAT A "255" (HEX FF) INPUT VALUE IS
*     USED TO INDICATE  THE  "END  OF  FILE"  CONDITION  ON  THE
*     CORRESPONDING FILE.
*
*     THE FLOATING POINT INSTRUCTIONS OF THE "P" MACHINE ARE NOT
*     IMPLEMENTED IN THIS VERSION OF THE INTERPRETER.
*
*
*                             SASSAN HAZEGHI
*                             LICHEN WANG
*
*                             STANFORD LINEAR ACCELERATOR CENTER
*                             STANFORD, CA 94305.
*
*                             MARCH 1978.
*
*
*
*   
*   
****************************************************************
*   
*   
  TITL  8080/Z80 P_CODE INTERPRETER
*
***************************************************
*   
*        GLOBAL DEFINITIONS, INCLUDING STORAGE LAYOUT
*   
***************************************************
*   
INTRPORG EQU  07A00H     ORIGIN FOR THE INTERPRETER (THIS PROG.)
PCODORG EQU  00100H      BEGINING OF USER P_CODE
*PCODORG EQU 0D000H      FOR 64K FULL SIZED SYSTEMS.
**  IOCOM(UNICATION) AREA IS DEFINED
**  AT THE END OF THE INTERPRETER CODE AND TO AVOIDE FORWARD
**  REFERENCE PROBLEM THE FOLLOWING SYMBOLS ARE (RE) DEFINED
**  THERE.
**IOCOM  EQU  INTERPORG+940H   I/O COMMUNICATION AREA
**STNDXIT  EQU  IOCOM+040H
**ERRXIT  EQU  IOCOM+040H  INTERPRETER ERROR EXIT
**  
HEAPEND  EQU  07AH  LAST PAGE AVAILABLE TO THE PASCAL PROGRAM
*ISTK    EQU  OPCTBL        INTERPRETER'S STACK GROWS FROM THE
*                           BEGINING OF OPCODE TABLE TOWARDS
*                           THE LOW MEMORY.
*   
*PSTK    EQU   ?             PCODE STACK GROWS UP FROM END OF
*                            USER PROGRAM TOWARDS HIGH MEMORY.
*   
*   
************************************************************
*   
*        INTERPRETERS LOCAL VARIABLES AND CONSTANTS
*   
************************************************************
*   
*   
EPADR  EQU  PCODORG  ADDRESS OF THE ENTRY POINT TO USER PROG
PCODLEN EQU  EPADR+2  LENGTH OF THE USER PROGRAM
PSTKORG  EQU  EPADR+4  LENGTH OF USER PROC. TABLE
PSTKEND  EQU  EPADR+6  SIZE OF THE USER STACK AREA
MSTAREA  EQU  8
ENDLINE  EQU  1
ENDFILE  EQU  3
BUFAREA  EQU  8
FLGAREA  EQU  BUFAREA  SPACE FOR EOF/ELN FLAGS
ENTAREA  EQU  10
TRUE  EQU  1
FALSE  EQU  0
READOPN  EQU  0  'OPEN' CODE FOR READ
WRITOPN  EQU  1  'OPEN' CODE FOR WRITE
BIASS  EQU  32  BIASS VALUE, CONVERT ASCII TO INT. CODE
SPACE  EQU  32
ASCZER  EQU  48
ASCNIN  EQU  57
ASCPLU  EQU  43
ASCMIN  EQU  45
LF  EQU  10  ASCII 'LF'
CR  EQU  13  ASCII 'CR'
EOT  EQU  4  ASCII 'EOT'
ASCEOF  EQU  0FFH  END OF FILE CHAR
*   
*        END OF INTERPRETERS LOCAL CONSTANTS AND VARIABLS
*   
*   
************************************************************
*   
*        BODY OF THE P_CODE INTERPRETER
*   
************************************************************
*   
  ORG  INTRPORG
*   
INTERP  LXI  H,0
  DAD  SP
  LXI  SP,ISTK  INITIALIZE INTERPRETER STACK POINTER
  PUSH  H  SAVE OLD STAK POINTER
*   
  CALL  SETUP  SET UP THE ENVIRONMENT FOR P_P MACHINE
*   
*** FETCH ***
*   
*  FETCH THE NEXT Z_CODE AND DECODE
*  BC IS Z_PC, DE IS Z_SP
*   
FETCH  INX  B
FET1  LDAX  B
  MVI  H,<OPCTBL
  MOV  L,A
  MOV  A,M
  INR  H
  MOV  H,M
  MOV  L,A
  PCHL  ,  BC <-- P_OPCODE, DE <-- P_SP
*   
********************************************
*   
*  TRIVIAL OR NO_OP INSTRUCTIONS
*   
********************************************
*   
**ZORD  JMP  FETCH
*   
**ZCHR  JMP  FETCH
*   
**ZSTP  JMP  0
**  JMP  INTERP
*   
********************************************
*   
*  LOAD / LOAD_CONSTANT INSTRUCTIONS
*   
********************************************
*   
*   
*** ZLDC1 ***
*   
*  SHORT (0-31) FORM OF LOAD CONST.
*   
ZLDC1  SUB  A  PUT 16 BIT VALUE ON STACK
  STAX  D  HIGH BYTE
  INX  D
  LDAX  B  GET P_OPCODE
  ANI  01FH  STRIP OPCODE BITS
  STAX  D  LOW BYTE
  INX  D  POINT TO NEXT LOCATION ON STACK
  JMP  FETCH
*   
*** ZLDC8 ***
*   
*  LOAD 8-BYTE LONG CONSTANT, THE CONSTANT FOLLOWS TH OPCODE
*   
ZLDC8  INX  B  POINT TO FIRST BYTE OF CONSTANT
  LDAX  B  GET BYTE
  STAX  D  PUT ON STACK
  INX  D  NEXT LOCATION OF STACK
  INX  B  NEXT BYTE OF CONSTANT
  LDAX  B  DO IT AGAIN (2)
  STAX  D
  INX  D
  INX  B
  LDAX  B  ...AND AGAIN (3)
  STAX  D
  INX  D
  INX  B
  LDAX  B  ...AND AGAIN (4)
  STAX  D
  INX  D
  INX  B
  LDAX  B  ...AND AGAIN (5)
  STAX  D
  INX  D
  INX  B
  LDAX  B  ...AND AGAIN (6)
  STAX  D
  INX  D  FALL THROUGH FOR TWO MORE TIMES
*** ZLDC ***
*   
*  LONG FORM OF LOAD CONST. 16 BIT OPERAND
*   
ZLDC  INX  B
  LDAX  B
  JMP  LDC2
*   
*** ZLDC2 ***
*   
*  2-BYTE FORM OF THE LOAD CONSTANT, 0NE-BYTE OPERAND !
*   
ZLDC2  XRA  A  ##  ZERO HIGH BYTE
LDC2  STAX  D
  INX  D
  INX  B
  LDAX  B
  STAX  D
  INX  D
  JMP  FETCH
*   
*   
*** ZLOD8 ***
*   
*  LOD OF 8 BYTE QUANTITIES (SETS, REALS)
*   
ZLOD8  MVI  A,255
  STA  FLG8  SET THE 8-BYTE OPERAND FLAG
*   
*** ZLOD ***
*   
*  LONG FORM OF LOAD
*   
ZLOD  LXI  H,DISP
  INX  B
  LDAX  B
  RLC  ,
  RLC  ,
  RLC  ,
  ANI  7
  RLC  ,
  ADD  L
  MOV  L,A
  MOV  A,M
  INX  H
  MOV  H,M
  MOV  L,A
  LDAX  B
  ANI  01FH
  ADD  A  COMPUTE THE ACTUAL DISPLACEMENT
  ADD  H
  MOV  H,A
  INX  B
  LDAX  B
  ADD  A
  JNC  LOD2
  INR  H  ADJUST HIGH ORDER ADDRESS IF NEEDED
  JMP  LOD2
*   
*** ZLOD2 ***
*   
*  2-BYTE VERSION OF LOAD GLOBAL
*   
ZLOD2  LHLD  DISP
  INX  B
  LDAX  B
  ADD  A
  JNC  LOD2
  INR  H  OVERFLOW INTO HIGH ORDER ADDRESS
  JMP  LOD2
*   
*** ZLODG ***
*   
*  SHORT (0-31) FORM OF LOAD GLOBAL
*   
ZLODG  LHLD  DISP
  JMP  LOD1
*   
*** ZLODL ***
*   
*  SHORT (0-31) FORM OF LOAD LOCAL
*   
ZLODL  LHLD  MP
LOD1  LDAX  B
  ANI  03EH
LOD2  ADD  L
  MOV  L,A
  JNC  LOD3
  INR  H
LOD3  MOV  A,M
  STAX  D
  INX  D
  INX  H
  MOV  A,M
  STAX  D
  INX  D
  LDA  FLG8
  ANA  A  SEE IF 8-BYTE OPERAND FLAG ON ?
  JZ  FETCH
*   
*        THE REST ARE FOR 8-BYTE LOAD
*   
  INX  H
  MOV  A,M
  STAX  D
  INX  D
  INX  H
  MOV  A,M
  STAX  D
  INX  H
  INX  D
  MOV  A,M
  STAX  D
  INX  D
  INX  H
  MOV  A,M
  STAX  D
  INX  D
  INX  H
  MOV  A,M
  STAX  D
  INX  H
  INX  D
  MOV  A,M
  STAX  D
  INX  D
  SUB  A
  STA  FLG8  RESET 8-BYTE OPERAND FLAG
  JMP  FETCH
*** ZIND1 ***
*   
*  SHORT (0-15) FORM OF INDEX
*   
ZIND1  LDAX  B
  ANI  00FH
IND1  XCHG  ,
  DCX  H
  ADD  M
  MOV  E,A
  DCX  H
  MOV  D,M
  JNC  IND3
  INR  D
IND3  XCHG  ,
  JMP  LOD3
*   
*** ZIND8 ***
*   
*  8-BYTE VESION OF 'ZIND'
*   
ZIND8  MVI  A,255
  STA  FLG8  SET 8-BYTE INSTR. FLAG
*   
*** ZIND ***
*   
*  LONG FORM OF INDEX
*   
ZIND  INX  B
  LDAX  B
  JMP  IND1
*   
********************************************
*   
*  STORE INSTRUCTIONS
*   
********************************************
*   
*   
*** ZSTR8 ***
*   
*  8-BYTE VERSION OF ZSTR
*   
ZSTR8  MVI  A,255
  STA  FLG8
*   
*** ZSTR ***
*   
*  LONG FORM OF STORE
*   
ZSTR  LXI  H,DISP
  INX  B
  LDAX  B
  RLC  ,
  RLC  ,
  RLC  ,
  ANI  7
  RLC  ,
  ADD  L
  MOV  L,A
*        JP    NC,STR6       THESE 2 INSTRUCTIONS MAY BE REMOVED
*        INC   H             F 'DISP' DOES NOT CROSS PAGE
*        BOUNDARY
STR6  MOV  A,M
  INX  H
  MOV  H,M
  MOV  L,A
  LDAX  B
  ANI  01FH
  ADD  A
  ADD  H
  MOV  H,A
  INX  B
  LDAX  B
  ADD  A  ADJUST THE DISPLACEMENT
  JNC  STR1
  INR  H
  JMP  STR1
*   
*** ZSTRLG ***
*   
*  SHORT FORM OF STORE LOCAL/GLOBAL
*   
ZSTRLG  INX  B
  LDAX  B
  ADD  A
  LHLD  MP
  JNC  STR1
  LHLD  DISP
STR1  ADD  L
  MOV  L,A
  JNC  STR4
  INR  H
STR4  INX  H
  LDA  FLG8
  ANA  A
  JZ  STR5
  SUB  A
  STA  FLG8
*   
**INX  H
**INX  H
**INX  H
**INX  H
**INX  H
**INX  H
**DCX  D
**LDAX D
**MOV  M,A
**DCX  H
**DCX  D
**LDAX  D
**MOV  M,A
**DCX  H
**DCX  D
**LDAX  D
**MOV  M,A
**DCX  H
**DCX  D
**LDAX  D
**MOV  M,A
**DCX  H
**DCX  D
**LDAX  D
**MOV  M,A
**DCX  H
**DCX  D
**LDAX  D
**MOV  M,A
**DCX  H
* INSTEAD OF THE ABOVE FASTER VERSION THIS IS MORE COMPACT
  PUSH B
  LXI  B,6
  DAD  B
STR42  DCX D
  LDAX  D
  MOV  M,A
  DCX  H
  DCR  C
  JNZ  STR42
  POP  B
*   
STR5  DCX  D
  LDAX  D
  MOV  M,A
  DCX  H
  DCX  D
  LDAX  D
  MOV  M,A
  JMP  FETCH
*   
*** ZSTO ***
*   
*  INDIRECT STORE, OPERAND ADDRESS ON 2_ND TOP.
*   
ZSTO  PUSH  B
  XCHG  ,
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M  BC GETS STORE OPERAND
  DCX  H
  MOV  A,M
  DCX  H
  MOV  D,H  NEW TOP OF THE P_STACK
  MOV  E,L
  MOV  H,M
  MOV  L,A  HL GETS OPERAND ADDRESS
  MOV  M,B
  INX  H
  MOV  M,C
  POP  B  RESTORE BC
  JMP  FETCH
*   
*** ZSTO8 ***
*   
*  8-BYTE VERSION OF ZSTO
*   
ZSTO8  XCHG  ,
*      ADD  HL,-9
  LXI  D,-9
  DAD  D
  MOV  E,M
  DCX  H
  MOV  D,M  DE GETS ADDRESS FOR STORE
  PUSH  H  SAVE NEW P_STACK POINTER
  INX  H
**INX  H
* MOV  A,M
* STAX  D  MOVE BYTE 1
* INX  H
* INX  D
* MOV  A,M
* STAX  D  MOVE BYTE 2
* INX  H
* INX  D
* MOV  A,M
* STAX  D  MOVE BYTE 3
* INX  H
* INX  D
* MOV  A,M
* STAX  D
* INX  H
* INX  D
* MOV  A,M
* STAX  D
* INX  H
* INX  D
* MOV  A,M
* STAX  D
* INX  H
* INX  D
* MOV  A,M
* STAX  D
* INX  H
* INX  D
* MOV  A,M
* STAX  D  MOVE BYTE 8
**  
  PUSH  B
  MVI  C,8
ZSTO9  INX  H
  MOV  A,M
  STAX  D
  INX  D
  DCR  C
  JNZ  ZSTO9
  POP  B
**  
  POP  D  RESTOR P_STACK PTR
  JMP  FETCH
*   
******************************************
*   
*  MOVE INSTRUCTION
*   
******************************************
*   
*** ZMVP ***
*   
* BLOCK MOVE, UNPACK WHILE MOVING, FOR CHAR ARRAYS ONLY
*   
ZMVP  XRA  A  SET 'PACKED' FLAG
  JMP  MOV0
*   
*** ZMOV ***
*   
* BLOCK MOVE
*   
ZMOV  MVI  A,1
MOV0  STA  PFLG  SET 'PACK/UNPACK' FLAG
  INX  B
  LDAX  B  PICK UP THE COUNT
  PUSH  B
  XCHG  ,
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M  BC <-- SOURCE ADDRESS
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M  DE <-- DESTINATION ADDRESS
  PUSH  H
  MOV  L,A  L <-- BYTE COUNT
MOV4  LDA  PFLG
  ANA  A  TEST PACK/UNPACK FLAG
  JZ  MOV6  INSERT 0=SPACE FOR UNPACKING
  LDAX  B
  INX  B
MOV6  STAX  D  MOVE ONE BYTE
  INX  D
  LDAX  B
  INX  B
  STAX  D  MOVE THE NEXT  BYTE
  INX  D
  DCR  L  DECREMENT THE COUNT
  JNZ  MOV4
  POP  D  RESTORE P_SP
  POP  B  RESTORE P_LC
  JMP  FETCH
*   
*   
********************************************
*   
*  ADDRESS COMPUTAION INSTRUCTIONS
*   
********************************************
*   
*   
*** ZLDA ***
*   
*  LONG FORM OF LOAD ADDR.
*   
ZLDA  LXI  H,DISP
  INX  B
  LDAX  B
  RLC  ,
  RLC  ,
  RLC  ,
  ANI  7
  RLC  ,
  ADD  L
  MOV  L,A
*        JP    NC,LDA6       DISPLAY TABLE DOES NOT CROSS
*        PAGE
*        INC   H             BOUNDARY, SO NO NEED FOR THIS.
LDA6  MOV  A,M
  INX  H
  MOV  H,M
  MOV  L,A
  LDAX  B
  ANI  01FH
  ADD  A
  ADD  H
  MOV  H,A
  INX  B
  LDAX  B
  ADD  A
  JNC  LDA1
  INR  H
  JMP  LDA1
*   
*** ZLDALG ***
*   
*  SHORT FORM OF LOAD ADDR. LOCAL/GLOBAL
*   
ZLDALG  INX  B
  LDAX  B
  ADD  A
  LHLD  MP
  JNC  LDA1
  LHLD  DISP
LDA1  ADD  L
  INX  D
  STAX  D
  JNC  LDA2
  INR  H
LDA2  MOV  A,H
  DCX  D
  STAX  D
  INX  D
  INX  D
  JMP  FETCH
*   
*** ZLCA ***
*   
*  LOAD CONSTANT ADDR.
*   
ZLCA  INX  B
  LDAX  B
  MOV  L,A
  INX  B
  MOV  A,B
  STAX  D
  INX  D
  MOV  A,C
  STAX  D
  INX  D
  MVI  H,0
  DAD  B
  MOV  B,H
  MOV  C,L
  JMP  FET1
*   
*** IXA ***
*   
*  COMPUTE INDEXED ADDRESS
*   
*  FIRST INDEXING BY POWERS OF TWO
*   
*   
*** INDEX BY 2
*   
ZIXA2  DCX  D
  LDAX  D
  DCX  D
  MOV  L,A
  LDAX  D
  MOV  H,A
  JMP  IX02
*   
*** INDEX BY 4
*   
ZIXA4  DCX  D
  LDAX  D
  DCX  D
  MOV  L,A
  LDAX  D
  MOV  H,A
  JMP  IX04
*   
*** INDEX BY 8
*   
ZIXA8  DCX  D
  LDAX  D
  DCX  D
  MOV  L,A
  LDAX  D
  MOV  H,A
  DAD  H
IX04  DAD  H
IX02  DAD  H
  DCX  D
*        NOW ADD THE SCALED INDEX TO BASE ADDRESS
  LDAX  D
  ADD  L
  STAX  D
  DCX  D
  LDAX  D
  ADC  H
  STAX  D
  INX  D
  INX  D
  JMP  FETCH
*   
*** ZIXA
*   
*  LONG FORM OF INDEXED ADDRESS COMPUTATION
*   
ZIXA  INX  B
  LDAX  B
  INX  B
  PUSH  B
  MOV  H,A
  LDAX  B
  MOV  B,H
  JMP  IX11
*   
*** IXA1
*   
*  SHORT (1-BYTE) IXA INSTRUCTION
*   
ZIXA1  LDAX  B
  ANI  00FH
  PUSH  B
  MVI  B,0
IX11  MOV  C,A
  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  CALL  MULTPLY
*        NOW ADD THE SCALED INDEX TO BASE ADDRESS
  MOV  D,H
  MOV  E,L
  DCX  H
  MOV  A,M
  ADD  C
  MOV  M,A
  DCX  H
  MOV  A,M
  ADC  B
  MOV  M,A
  POP  B
  JMP  FETCH
*   
********************************************
*   
*        ARITHMETIC INSTRUCTIONS
*   
********************************************
*   
*   
*** ZNGI ***
*   
*  NEGATE INTEGER
*   
ZNGI  DCX  D
  LDAX  D
  CMA  ,
  INR  A
  STAX  D
  DCX  D
  LDAX  D
  CMA  ,
  JNZ  N02
  INR  A
N02  STAX  D
  INX  D
  INX  D
  JMP  FETCH
*   
*** ZABI ***
*   
*  ABSOULTE VALUE FUNCTION (INTEGER ARGUMENT/RESULT)
*   
*   
ZABI  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  A,M
  CMA  ,
  JM  AB02
  MOV  D,A
  MOV  A,E
  CMA  ,
  MOV  E,A
  INX  D
  MOV  M,D
  INX  H
  MOV  M,E
  INX  H
  XCHG  ,
  JMP  FETCH
AB02  INX  H
  INX  H
  XCHG  ,
  JMP  FETCH
*** ZADI ***
*   
*  ADD INTEGERS
*   
ZADI  DCX  D
  XCHG  ,
  MOV  E,M
  DCX  H
  MOV  D,M
  DCX  H
  MOV  A,M
  ADD  E
  MOV  M,A
  DCX  H
  MOV  A,M
  ADC  D
  MOV  M,A
  INX  H
  XCHG  ,
  INX  D
  JMP  FETCH
*   
*** ZADIC ***
*   
*  ADD SMALL INTEGER CONSTANT TO TOP OF STACK
*   
ZADIC  MOV  H,D
  MOV  L,E
  INX  B
  LDAX  B
  DCX  H
  ADD  M
  MOV  M,A  ADD CONSTANT TO LIST SIG PART OF TOP
  JNC  FETCH
  DCX  H
  INR  M  ADJUST THE MOST SIG. PART IF NEEDED
  JMP  FETCH
*   
*** ZSBI ***
*   
*  SUBTRACT INTEGERS
*   
ZSBI  DCX  D
  XCHG  ,
  MOV  E,M
  DCX  H
  MOV  D,M
  DCX  H
  MOV  A,M
  SUB  E
  MOV  M,A
  DCX  H
  MOV  A,M
  SBB  D
  MOV  M,A
  INX  H
  XCHG  ,
  INX  D
  JMP  FETCH
*   
*** ZDEC1 ***
*   
*  DECREMENT TOP OF STACK BY ONE UNIT.
*   
ZDEC1  MOV  L,E
  MOV  H,D
  DCX  H
  MOV  A,M
  SUI  1
  MOV  M,A
  JNC  FETCH
  DCX  H
  DCR  M
  JMP  FETCH
*   
*** MPI ***
*   
*  INTEGER MULTIPLY
*   
ZMPI  XCHG  ,
  PUSH  B
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M
  CALL  MULTPLY
  MOV  M,B
  INX  H
  MOV  M,C
  INX  H
  XCHG  ,
  POP  B
  JMP  FETCH
*   
*** DVI ***
*   
*  INTEGER DEVIDE
*   
ZDVI  PUSH  B
  CALL  DIVMOD  UPDATES DE INTO HL
  MOV  M,B
  INX  H
  MOV  M,C
  INX  H
  XCHG  ,
  POP  B
  JMP  FETCH
*   
*** MOD ***
*   
*  (INTEGER) MOD FUNCTION
*   
ZMOD  PUSH  B
  CALL  DIVMOD  UPDATES DE INTO HL
  MOV  M,D
  INX  H
  MOV  M,E
  INX  H
  XCHG  ,
  POP  B
  JMP  FETCH
*   
*        MULTIPLY TWO SIXTEEN BIT LOGICAL NUMBERS
*                  INPUT:*                  OUTPUT: BC=PRODUCT,C
*   
MULTPLY PUSH  H
  LXI  H,0
  MVI  A,30  2*(16-1)
  DCR  D
  INR  D
  JNZ  MULTLOP
  MOV  D,E  SMALL MULTIPLIER,
  MVI  A,14  2*(8-1)  SPEED UP
MULTLOP DAD  H  DOUBLE OUTPUT
*        CALL      C,MULTOVR             NOTE OVERFLOW
  XCHG  ,
  DAD  H  TEST NEXT BIT OF MULTIPLIER
  XCHG  ,
  JNC  MULTTRM
  DAD  B
*        CALL      C,MULTOVR
MULTTRM SUI  2  DECREMENT LOOP COUNT
  JP  MULTLOP
MULTRET RRC  ,  DONE, SET CARRY FOR RETURN CODE
  MOV  B,H  PUT PRODUCT IN RETURN REGISTERS
  MOV  C,L
  POP  H
  RET  ,
MULTOVR ORI  1  OVERFLOW, TURN ON LOW ORDER BIT
  RET  ,
*   
*        INTERNAL DIVISION ROUTINE
*   
*        DEVIDES 2'S COMPLEMENT 2-BYTE INTEGER OPERANDS AND
*        PRODUCES
*        2'S COMPLEMENT REMAINDER 'DE' AND QUOTIENT 'BC'.
*        THE DIVIDEND
*        AND DIVISOR ARE ASSUMED TO BE IN LOCATIONS (DE-4..DE-3)
*        AND
*        (DE-2..DE-1) RESPECTIVELY.
*   
DIVMOD  XCHG  ,
  DCX  H
  MOV  E,M
  DCX  H
  MOV  D,M
  MOV  A,D
  ANA  A
  PUSH  PSW
  JP  DM02
  CMA  ,  CHANGE DIVISOR TO POSITIVE.
  MOV  D,A
  MOV  A,E
  CMA  ,
  MOV  E,A
  INX  D
DM02  DCX  H
  MOV  C,M
  DCX  H
  MOV  B,M
  MOV  A,B
  ANA  A
  PUSH  PSW
  JP  DM04
  CMA  ,  GET THE ABS. VALUE OF DIVIDEND.
  MOV  B,A
  MOV  A,C
  CMA  ,
  MOV  C,A
  INX  B
*   
DM04  CALL  DIVIDE
*   
  POP  PSW  ONLY THE SIGN OF DIVIDEND IS IMPORTANT
  JP  DM06  FOR SETTING THE SIGN OF REMAINDER
  MOV  A,D
  CMA  ,
  MOV  D,A
  MOV  A,E
  CMA  ,
  MOV  E,A
  INX  D
  POP  PSW
  RM  IF BOTH NEGATIVE, SIGN OF QUOTIENT OK.
  JMP  DM08
*   
DM06  POP  PSW  DETERMINE THE SIGN OF THE QUOTIENT
  RP  ,
DM08  MOV  A,B
  CMA  ,
  MOV  B,A
  MOV  A,C
  CMA  ,
  MOV  C,A
  INX  B
  RET  ,
*   
*   
*        DIVIDE TWO SIXTEEN BIT LOGICAL NUMBERS
*                  INPUT:  BC=DIVIDEND,DE=DIVISOR
*                  OUTPUT: BC=QUOTIENT,DE=REMAINDER
*   
DIVIDE  PUSH  H  SAVE UNINVOLVED REGISTERS
  MOV  A,E
  CMA  ,
  MOV  E,A
  MOV  A,D
  CMA  ,  FORM 2'S COMPLEMENT OF DIVISOR
  MOV  D,A
  INX  D
  LXI  H,0  INITIALIZE REMAINDER
  MVI  A,16+1  AND COUNT
DIVILOP PUSH  H  SAVE REMAINDER
  DAD  D  MAKE TRIAL SUBTRACTION
  JNC  DIVIRST
  XTHL  ,  SUCCESSFUL
DIVIRST POP  H  LOAD BACK NEW REMAINDER
  PUSH  PSW  SAVE COUNTER
  MOV  A,C  AND INCORPORATE RESULT
  RAL  ,  INTO QUOTIENT
  MOV  C,A
  MOV  A,B
  RAL  ,
  MOV  B,A  ADVANCE ANOTHER BIT OF DIVIDEND
  MOV  A,L  ADVANCE ANOTHER BIT OF DIVIDEND
  RAL  ,  INTO REMAINDER
  MOV  L,A
  MOV  A,H
  RAL  ,
  MOV  H,A
  POP  PSW  RETRIEVE COUNTER
  DCR  A  AND DECREMENT
  JNZ  DIVILOP  HAVE ANOTHER GO IF NECESSARY
  ORA  A  DONE, FIX REMAINDER
  MOV  A,H
  RAR  ,
  MOV  D,A
  MOV  A,L
  RAR  ,
  MOV  E,A
  POP  H
  RET  ,
*