ASMB,R,L,C   ** .EMAP **
      HED .EMAP ROUTINE TO RESOLVE ELEMENT ADDRESS OF AN ARRAY
*     SOURCE: 92067-18290 
*     RELOC:  PART OF 92067-16268 AND 92067-16035 
*     PGMR:   S.P.K.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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.       *
*  ***************************************************************
* 
      NAM .EMAP,7 92067-1X290 REV.2013 771031 
      SUP 
      ENT .EMAP 
      EXT .EMAS,.EMAT 
* 
* 
*  ROUTINE TO RESOLVE ELEMENT ADDRESS FOR EMA AND NON-EMA 
*  ARRAYS.  IF THE ARRAY IS NON-EMA 16 BIT ARITHMETIC IS
*  PERFORMED.  IF THE ARRAY IS AN EMA 32 BIT ARITHMETIC IS
*  PERFORMED AND THE APPROPIATE MAPPING SEGMENT CONTAINING
*  THE ELEMENT IS MAPPED IN THE MSEG LOG ADDRESS SPACE
* 
*  CALLING SEQUENCE:
*      JSB .EMAP
*      DEF RTN      RETURN ADDRESS FOR ERROR RETURNS
*      DEF ARRAY    START ADDRESS OF ARRAY
*      DEF TABLE    TABLE CONTAINING ARRAY PARAMETERS 
*      DEF A(N)     SUBSCRIPT VALUE FOR NTH DIMENSION 
*      DEF A(N-1)       "       "    "  (N-1)ST  "
*         . 
*         . 
*      DEF A(2)         "       "    "  2ND      "
*      DEF A(1)         "       "    "  1ST      "
* RTN  -- ERROR RETURN -- 
*      -- NORMAL RETURN --
* 
*THE PARAMETER TABLE IS:
*    -------------------- 
*      # DIMENSIONS 
*      - L(N) 
*        D(N-1) 
*      - L(N-1) 
*        .
*        .
*      - L(2) 
*        D(1) 
*      - L(1) 
*      # WORDS/ELEMENT
*      OFFSET WORD 1    (LOW 16 BITS)  USED ONLY
*      OFFSET WORD 2    (HIGH 16 BITS)    FOR EMA 
*   --------------------- 
* 
* 
*  RETURNS:  ERROR RETURN: AT LOC RTN 
*            AREG=15(ASCII), BREG=EM(ASCII) 
*            NORMAL RETURN: AT LOC RTN+1
*            AREG = MEANINGLESS 
*            BREG = ELEMENT ADDRESS 
* 
* 
.EMAP NOP           ROUTINE TO RESOLVE ARRAY ADDRESS
      LDA .EMAP,I   GET RETURN ADDRESS
      STA RETRN     SAVE IT 
      ISZ .EMAP     POINT TO ARRAY ADDRESS
      LDB .EMAP,I   GET ARRAY ADDRESS 
      JMP *+2       REMOVE INDIRECTS
      LDB B,I 
      RBL,CLE,SLB,ERB 
      JMP *-2 
* 
      ISZ .EMAP     POINT TO THE TABLE ADDRESS
      LDA XIDEX     DETERMINE WHETHER ARRAY ADDRESS 
      SZA,RSS       GIVEN IS THAT OF AN EMA OR NON-EMA ARRAY
      JMP NOEMA     CALLING PROG DOES NOT HAVE EMA DECLARED 
      INA           POINT 2ND WORD OF ID SEG EXT
      XLA A,I       GET CONTENTS OF 2ND WORD OF ID SEG EXT OF PROG
      CLE,ERA       MOVE BITS 15-11 INTO 14-10 POSITION 
      AND B76K      GET LOGICAL START ADDR OF MSEG
      CMA,INA 
      ADA B         ARRAY ADDRESS SPECIFIED < START MSEG? 
      SSA 
      JMP NOEMA     NO THEN A NON-EMA ARRAY 
      LDA .EMAP     POINTER TO TABLE ADDRESS
      JSB .EMAS     RESOLVE ELEMENT ADDRESS FOR EMA ARRAY 
      SSA,RSS       ERROR ENCOUNTERED?
      JSB .EMAT     MAP NECESSARY MSEG TO GET ELEM IN LOG ADDR SPACE
      SSA           ERROR ENCOUNTERED?
      JMP ERROR 
      ISZ RETRN     NO, ELEMENT ADDRESS IS IN B REG 
      JMP RETRN,I   NORMAL RETURN TO RTN+1 LOCATION 
* 
*    NON - EMA ARRAY  -  RESOLVE ELEMENT ADDRESS USING
*           16 BIT ARITHMETIC 
* 
NOEMA STB ARRAY     SAVE ARRAY ADDRESS
      LDA .EMAP,I   GET TABLE ADDRESS 
      RSS           REMOVE INDIRECTS IF ANY 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      STA PTABL     ADDRESS OF PARAMETER TABLE
      LDA A,I       # OF DIMENSIONS 
      SSA           -VE?
      JMP ERROR     YES, ERROR
      SZA,RSS       0 DIMENSIONS? 
      JMP NODIM     YES 
      CMA,INA 
      STA NDIM      -VE # OF DIMENSIONS TO USE AS COUNTER 
      CLA 
      STA SUM1      INITIALIZE VARIABLE TO HOLD DISPLACEMENT
LOOP  ISZ PTABL     POINT TO -(LOWER BOUND) OF ITH DIMENSION
      ISZ .EMAP     POINT TO SUBSCRIPT VALUE OF ITH DIMENSION 
      LDA .EMAP,I   GET SUBSCRIPT VALUE --- A(I)
      LDA A,I 
      CLO           CLEAR OVERFLOW REGISTER 
      ADA PTABL,I   A(I)-L(I)   SUBSCRIPT VALUE-LOWER BOUND 
      SSA,RSS       LOWER BOUND > SUBSCRIPT VALUE?
      SOC C         OVERFLOW REG SET? 
      JMP ERROR     YES, ERROR
      ADA SUM1      ACCUMULATE DISPLACEMENT - IF OVERFLOW 
      ISZ PTABL     IT WILL BE DETECTED AFTER MULTIPLY
      LDB PTABL,I   DIMENSION SIZE OF (I-1)ST DIMENSION  D(I-1) 
      SSB           -VE?
      JMP ERROR     YES, THEN ERROR 
      MPY B         (A(I) - L(I))*D(I-1)
      SZB,RSS       OVERFLOW INTO B REG?
      SSA           NO, OVERFLOW INTO BIT 15 OF A REG?
      JMP ERROR     YES 
      STA SUM1      NEW VALUE FOR DISPLACEMENT
      ISZ NDIM      INCREMENT # DIMENSIONS COUNTER
      JMP LOOP      ALL DIMENSIONS NOT DONE YET 
* 
NODIM LDB ARRAY     ARRAY ADDRESS 
      ADB A         ADD DISPLACEMENT
      ISZ RETRN     NORMAL RETURN AT LOC RTN+1
      JMP RETRN,I 
* 
* 
ERROR DLD ERRCD     ERROR ENCOUNTERED 
      JMP RETRN,I   RETURN AT LOC RTN 
* 
* 
ERRCD ASC 2,15EM    ERROR CODE
PTABL NOP 
SUM1  NOP 
NDIM  NOP 
ARRAY NOP 
RETRN NOP 
* 
B76K  OCT 76000 
* 
XIDEX EQU 1645B 
A     EQU 0 
B     EQU 1 
* 
      END 
* 
* 
                                                                                                                                                                                                                                  