ASMB,R,L,C   ** .EMAS **
      HED .EMAS INTERNAL ROUTINE TO RESOLVE ELEMENT ADDRESS IN EMA
*     SOURCE: 92067-18292 
*     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 .EMAS,7 92067-1X292 REV.2013 771031 
      SUP 
      ENT .EMAS,.EMAT,.ARRY,.SUM2 
      EXT .MMAP,.MSGS,.EMSZ,.MSG#,.NPGS,.IPGS 
* 
* 
*   ROUTINE TO RESOLVE ELEMENT ADDRESS FOR AN EMA ARRAY 
* 
*  CALLING SEQUENCE: JSB .EMAS
*                    A REG = POINTER TO TABLE ADDRESS IN
*                             THE LIST OF PARAMETERS
* 
*  RETURNS:  A REG =  0 IF NORMAL RETURN
*                  = -1 IF AN ERROR WAS ENCOUNTERED 
*            B REG =  TOTAL # OF WORDS DISPLACEMENT FROM
*                     THE START OF MSEG TO THE ELEMENT
* 
* 
.EMAS NOP           ROUTINE TO RESOLVE ARRAY ADDRESS
      STA TEMP      SAVE ADDRESS
      CLA           CLEAR VARIABLES TO KEEP RUNNING SUM 
      STA .SUM1     OF THE ELEMENT ADDRESS
      STA .SUM2 
      LDA TEMP,I    ADDRESS OF THE TABLE OF PARAMETERS
      RSS           REMOVE INDIRECTS IF ANY 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      STA PTABL     PTABL IS THE POINTER TO THE PARM TABLE
      LDA A,I       # OF DIMENSIONS IN THE A REG
      SSA           -VE?
      JMP ERROR     YES, THEN ERROR 
      ISZ PTABL     INCREMENT POINTER INTO THE TABLE
      SZA,RSS       0?
      JMP NODIM     YES, NO DIMENSIONS SPECIFIED
      CMA,INA       NEGATE IT TO KEEP COUNT 
      STA NDIM      -VE # OF DIMENSIONS 
* 
LOOP  ISZ TEMP      GET THE NEXT SUBSCRIPT VALUE
      LDA TEMP,I
      LDA A,I 
      CLO           CLEAR OVERFLOW REGISTER 
      ADA PTABL,I   ADD -LI TO AI 
      SSA,RSS       IS THIS VALUE -VE?
      SOC C         OVERFLOW REG SET? 
      JMP ERROR     YES,SUBSCRIPT VALUE < LOWER BOUND  ERROR
      ADA .SUM1     ADD LOWER 14 BITS OF SUM ELEMENT ADDRESS
      SSA           IS BIT 15 SET?
      ISZ .SUM2     YES,ADD 1 TO THE MOST SIGNIFICANT BITS OF SUM 
      ELA,CLE,ERA   CLEAR SIGN BIT IN THE A REGISTER
      ISZ PTABL     POINT TO UPPER BOUNDS OF (I-1)TH DIMENSION
      LDB PTABL,I   DIMENSION SIZE D(I-1) IN B REG
      STB DIMLN 
      SSB           -VE?
      JMP ERROR     YES 
      MPY B         MULTIPLY .SUM1 BY DIMENSION SIZE
      RAL,CLE,ERA   CLEAR BIT 15 IN A REG AND SAVE IN E REG 
      ELB           SHIFT BIT 15 OF AREG INTO BIT 0 POSITION OF BREG
      STA .SUM1     NEW VALUE OF BITS 0-14 OF ELEMENT ADDRESS 
      STB .SUM3 
      LDA .SUM2     BITS 15-31 OF ELEMENT ADDRESS 
      MPY DIMLN     NO, THEN MULTIPLY BY DIMENSION SIZE 
.EMA3 ADA .SUM3     ADD BITS 15-31 FROM PREVIOUS MULTIPLICATION 
      STA .SUM2     .SUM2 HAS BITS 15-31 OF ELEMENT ADDRESS SO FAR
      SZB,RSS       OVERFLOW INTO B REG?
      SSA           SIGN BIT SET ?
      JMP ERROR     YES, ERROR
      ISZ PTABL     POINT TO NEXT SET OF ARRAY PARAMETERS 
      ISZ NDIM      ALL DIMENSIONS DONE?
      JMP LOOP      NO, THEN EVALUATE NEXT DIMENSION
* 
NODIM XLA XIDEX,I   GET FIRST WORD OF ID SEG EXT
      CAY           SAVE IT IN Y REG
      AND B37       MASK MSEG SIZE
      STA .MSGS     SAVE IT 
      LDA XIDEX 
      INA           GET 2ND WORD OF ID SEG EXT
      XLA A,I 
      CLE,ERA 
      AND B76K      GET LOGICAL START EMA ADDRESS 
      STA .ARRY     SAVE IT 
* 
      DLD PTABL,I   GET TWO OFFSET WORDS
      RAL,CLE,ERA   IF BIT 15 OF AREG SET, CLEAR IT AND SAVE
      ELB           SHIFT IT IN BIT 0 POSITION OF HIGH ORDER BITS 
      SEZ,SSB,RSS   OFFSET HAS SIGN BIT SET OR TOO LARGE? 
      RSS 
      JMP ERROR     YES, THEN ERROR 
      ADA .SUM1     OFFSET WORD 1 
      RAL,CLE,SLA,ERA     CLEAR SIGN BIT IF SET 
      INB           INCREMENT HIGH ORDER BITS TO ACCOUNT
      ADB .SUM2     FOR SIGN BIT OF LOW ORDER BITS
      SSB           OVERFLOW? 
      JMP ERROR     YES 
      RAL           MOVE BITS 0-14 IN 1-15 POSITION 
      ASL 5         B REG HAS TOTAL # OF PAGES IN DISPLACEMENT
      SOC C         WERE SOME SIGNIFICANT BITS LOST?
      JMP ERROR     YES 
      STB .SUM2     FROM BEGINNING OF EMA UPTO PAGE CONTAINING ELEMENT
      ALF,ALF       MOVE REMAINING WORDS INTO LOW BITS
      RAL,RAL 
      STA .SUM1     SAVE # OF WORDS OFFSET IN THE LAST PAGE 
      CMB           - (#PAGES DISP + 1) 
      LDA XEQT
      ADA .28       WORD 29 OF ID SEGMENT 
      XLA A,I 
      AND B1777     MASK EMA SIZE 
      STA .EMSZ 
      ADB A         TOTAL #PGS DISP+1(IF OFFSET INTO LAST PAGE) 
      SSB              > EMA SIZE?
      JMP ERROR     YES, THEN ERROR 
      LDA .SUM2     # OF PAGES DISP FROM START OF EMA 
      CLB 
      DIV .MSGS     DIVIDE DISP BY MSEG SIZE
      STA .MSG#     QUOTIENT IS THE MSEG # TO MAP 
      LDA B         SAVE B REG
      CMA,INA       # PAGES DISP - # PAGES OFFSET INTO MSEG 
      ADA .SUM2 
      STA .IPGS 
      BLF,BLF       CONVERT REMAINDER # PAGES INTO WORDS
      RBL,RBL 
      ADB .SUM1     TOTAL # OF WORDS DISP INTO MSEG 
      STB TEMP      SAVE THIS VALUE 
      CLA 
      JMP .EMAS,I   RETURN
* 
*   MAP THE STANDARD MAPPING SEGMENT
* 
.EMAT NOP 
      CYA           GET THE FIRST WORD OF THE ID SEG EXT
      SSA           BIT 15 SET? 
      JMP MSGMP     YES, THEN MSEG NEEDS TO BE MAPPED 
      CLB 
      LSR 5         GET MSEG# CURRENTLY MAPPED
      CPA .MSG#     IS IT THE SAME AS THE ONE WE WANT 
      JMP RETRN     YES,NO NEED TO MAP MSEG  RETURN 
* 
*   MAPPING SEGMENT TO BE MAPPED
* 
MSGMP LDA .EMSZ     SIZE OF EMA 
      CLB 
      DIV .MSGS     DIVIDE BY MSEG SIZE TO GET THE
      SZB,RSS       HIGHEST MSEG #  -  REMAINDER = 0? 
      ADA N1        YES, THEN SUBTRACT 1 FROM QOUTIENT
      CPA .MSG#     IS THE HIGHEST MSEG# = MSEG# WE WANT? 
      JMP MSGM1     YES 
      LDB .MSGS     NO, ADJUST# PAGES TO BE MAPPED
      INB           FOR OVERFLOW
      JMP MSGM2 
MSGM1 SZB,RSS       REMAINDER=0?
      LDB .MSGS     YES,#PAGES TO BE MAPPED IS MSEG SIZE
MSGM2 STB .SUM1     # OF PAGES TO BE MAPPED 
      JSB .MMAP     MAP THE MAPPING SEGMENT 
* 
RETRN LDB .ARRY     LOGICAL START ADDRESS OF MSEG 
      ADB TEMP      # OF WORDS DISP INTO MSEG 
      CLA 
      JMP .EMAT,I   RETURN
* 
ERROR CCA           ERROR RETURN
      JMP .EMAS,I 
* 
.SUM1 EQU .NPGS     LOWER SIGNIFICANT BITS 0-14 OF DISPLACEMENT 
.SUM2 NOP           UPPER SIGNIFICANT BITS 15-31 OF DISPLACEMENT
.SUM3 NOP 
PTABL NOP           POINTER INTO TABLE
NDIM  NOP 
DIMLN NOP 
TEMP  NOP 
.ARRY EQU NDIM
XIDEX EQU 1645B 
XEQT  EQU 1717B 
.28   DEC 28
N1    DEC -1
B37   OCT 37
B76K  OCT 76000 
B1777 OCT 1777
A     EQU 0 
B     EQU 1 
      END 
                                    