ASMB,R,L,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      NAM INDEX,7 24998-1X252 REV.2001 750701 
      ENT .INDA,.INDR 
      EXT REIO,IND.E
*  .INDA AND .INDR ARE USED BY THE ALGOL COMPILER 
*  IN ORDER TO ACCESS ARRAY ELEMENTS.  .INDA PRODUCES 
*  THE ABSOLUTE ADDRESS OF AN ARRAY ELEMENT, WHEREAS
*.INDR PRODUCES THE VALUE STORED IN THAT LOCATION.
*  THE CALLING SEQUENCE TO THESE ROUTINES IS: 
* 
*     JSB .INDA OR .INDR
*     DEF ARRAY TABLE 
*     ABS -NUMBER OF INDICES
*     DEF INDEX1
*     ..... 
*     DEF INDEX N 
* 
*  THE ARRAY TABLE FOR A GIVEN ARRAY HAS THE FORM:
* 
* TABLE ABS NUMBER OF INDICES (+=REAL, -=INTEGER) 
*       ABS SIZE OF 1ST DIM 
*     ABS -LOWER BOUND OF 1ST DIM 
*     ..... 
*     ABS SIZE OF LAST DIM
*     ABS -LOWER BOUND OF LAST DIM
* 
.INDA NOP 
      LDA .INDA 
      JSB GETAD 
      JMP T,I 
* 
.INDR NOP 
      LDA .INDR 
      JSB GETAD 
      LDB 0 
      LDA 1,I 
      INB 
      LDB 1,I 
      JMP T,I 
* GETAD IS THE ROUTINE THAT DOES ALL THE WORK. THE
* COMPUTATION OF THE LOCATION IS DONE AS FOLLOWS: 
* 
*         M_INDEX[1]-LB[1]; 
*         FOR I_2 STEP 1 UNTIL NUMBEROFINDICES DO 
*           M_SIZE[I]*M+INDEX[I]-LB[I]; 
*         IF REAL ARRAY THEN M_2*M. 
*         ADDRESS_M+BASE
GETAD NOP 
      STA T         SAVE POINTER TO INDICES.
      LDA T,I       GET ADDRESS OF ARRAY TABLE
      RAL,CLE,SLA,ERA     TEST FOR INDIRECT.
      LDA 0,I       RELOAD IF INDIRECT
      STA TABLE     SAVE TABLE ADDRESS
      LDA TABLE,I   BET # OF INDICES FROM TABLE 
      STA MODE      SAVE IN MODE FOR LATER USE. 
      ISZ T         BUMP T TO POINT AT ACTUAL COUNT.
      SSA,RSS       SET COUNT IN CALLING SEQUENCE 
      CMA,INA        NEGATIVE 
      STA COUNT       AND SAVE IN COUNT 
      CPA T,I       MAKE SURE COUNT AGREES
      JMP CNTOK     THEY DO--WE CAN CONTINUE
* 
* ILLEGAL ARRAY REFERENCE*
* 
ERROR ISZ T         FIXUP FOR CORRECT RETURN
      ISZ COUNT REPOSITION FOR
      JMP ERROR       PROPER RETURN 
      LDB T         GET ADDRESS TO BE PRINTED 
      LDA .1+3
      STA COUNT     SET FOR 3 TIMES 
      LDA BNLOC 
      STA MODE
      LDA B2006     GET BLANK UPPER OF 1ST CHAR 
      RBL,CLE        POSITION B REG.
      JMP *+4 
POOL  LDA B3006 
      JSB RRL3
      ALF,RAL 
      JSB RRL3
      STA MODE,I      STORE 2 DIGITS
      ISZ MODE        BUMP BUFFER ADDRESS 
      ISZ COUNT     ARE WE DONE?
      JMP POOL      NO, GO NEXT 2 DIGITS
      JSB REIO      PRINT ERROR MESSAGE 
      DEF *+5 
      DEF .1+1
      DEF IND.E     PRINT ON THE SYST. TTY
      DEF FLAG
      DEF .1+2      3WORDS(6 CHARS.)
      CLA 
      CLB 
BACK  ISZ T 
      JMP GETAD,I 
RRL3  NOP             ROTATE B AND A 3 BITDS
      ELB 
      ELA 
      ELB 
      ELA 
      ELB 
      ELA 
      JMP RRL3,I
      SUP 
B2006 OCT 2006
B3006 OCT 3006
.1    OCT 1,2,6,-3
FLAG  ASC 6,INDEX?
BNLOC DEF FLAG+3    LOCN. K OF START OF NUMBER
CNTOK ISZ TABLE     POINT TABLE TO FIRST SIZE 
      CLA           CLEAR M INITIALLY.
LOOP  STA M 
      LDA TABLE,I   GET DIMENSION SIZE
      CMA,INA       AS NEGATIVE 
      STA SIZE
      ISZ TABLE     POINT AT LOWER BOUND
      LDA TABLE,I   GET LOWER BOUND 
      ISZ T         ADD IN
      LDB T,I       INDEX 
      ADA 1,I 
      SSA           TEST FOR LEGAL
      JMP ERROR+1   ERROR INDEX TOO LOW 
      STA 1         SAVE IN B 
      ADA M         ADD TO INDEX
      ADB SIZE
      SSB,RSS 
      JMP ERROR+1   ERROR-INDEX TOO HIGH
      ISZ COUNT     TEST FOR DONE 
      JMP MULT      NO--GO DO A MULTIPLY
* 
      LDB MODE      TEST MODE 
      SSB,RSS       IF + (REAL) 
      ALS           DOUBLE M
      ISZ TABLE 
      ADA TABLE,I   ADD IN BASE ADDRESS 
      JMP BACK
* 
MULT  ISZ TABLE 
      MPY TABLE,I 
      JMP LOOP
* 
T     NOP 
TABLE NOP 
MODE  NOP 
COUNT NOP 
M     EQU .INDA 
SIZE  EQU .INDR 
* 
      END 
* 
* 
                                                                                  