ASMB,L,C
      HED ".WCOM" - VECTOR EMA INTERFACE. 
      NAM .WCOM,7 12824-1X045 REV.2026 800506 
      ENT .WCOM 
      EXT .VSET,.ESEG,ERR0
**************************************************************
* 
*     NAME:   .WCOM 
*     SOURCE: 12824-18045 
*     RELOC:  PART OF 12824-12001 
*     PGMR:   BG,CG 
* 
*  ***********************************************************
*  * (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 CONSENT OF HEWLETT-PACKARD COMPANY.   *
*  ***********************************************************
* 
**************************************************************
A     EQU 0 
B     EQU 1 
      SUP 
* 
*     ".WCOM" interfaces FORTRAN programs to the Vector Instruction 
*     Set using vectors which reside in EMA.  For each VIS routine
*     which is to be duplicated for EMA vectors, a unique interface 
*     routine is called.  The call to that interface has the form:
* 
*                   JSB <routine> 
*                   DEF RTN                       Must be correct.
*                   DEF <misc. param 1>           "i" misc. params. 
*                     ... 
*                   DEF <misc. param i> 
*                   DEF <vector 1>                "j" vectors in EMA. 
*                   DEF <index for vector 1>      (with indices)
*                     ... 
*                   DEF <vector j>
*                   DEF <index for vector j>
*                   DEF <# of operations> 
* 
*     This call is identical to the call to the non-EMA version,
*     except the vectors are in EMA.  The standard FORTRAN calling
*     sequence is used, so the EMA addresses are actually pointers
*     to the true EMA addresses, which are two words long.
*     The interface part unique to each routine has the form: 
* 
*            <name> NOP 
*                   JSB .WCOM 
*                   DEF <real name>+0 
*                   BYT <# scalars = i>,<# vectors = j> 
*                   ABS <1024 / (# words per element)> - 1 + flags
* 
*     where the flags have the meaning: 
* 
*           bit 14: set up calls after remaps as if the microcode 
*                   were reentering after an interrupt. 
*           bit 13: after each microcode call, JSB to the next
*                   word after the call with the following
*                   parameters: the address of the parameter
*                   list and the last-time flag.
*           bit 12: the first parameter in the microcode call 
*                   is an output-only parameter which is an 
*                   index into some vector.  Since the call is
*                   broken into parts, this value will be set 
*                   (at interface exit) to the correct value
*                   using the total length of previous calls. 
      SKP 
*     Some notes on the above:  the "+0" in the first DEF is to guarantee 
*     a direct address.  The interface uses the sign bit of this word 
*     to see if the non-EMA version is actually in microcode.  The last 
*     value is used to compute the maximum number of operations which can 
*     before the maps must be adjusted.  The interface needs to know the
*     number of words per element and computes it from this last value. 
*     If the number of words per element exceeds 37, this computation may 
*     fail, so the following restriction is put on the number of words
*     per element:
* 
*            Let NW be the number of words per element.  The
*            following must be true:
*                   1024 / ( 1024 / NW) = NW
*            where "/" indicates integer division.
* 
*     The sequence of events in .WCOM is as follows:
* 
*       1) Copy the parameters and true return address. 
*       2) Set up and call .VSET to copy the real parameters, set up
*          maps, compute the maximum number of operations before
*          remap, and decide if this is an "easy" or a "hard" case. 
*       3) If hard: adjust the maps for negative indices.  Decide if
*          this is the only set of maps needed. 
*       4) Call .ESEG to load the map registers in the MSEG.
*       5) Call the non-EMA routine.  Do any special processing.
*       6) If easy or last time of hard, exit.
*       7) Adjust the maps & vector addresses for the next section and
*          decide if it is the last one.
*       8) Go to step 4.
      SPC 2 
*                   LOCALS & TEMPS. 
* 
TV1   DEF *-*       POINTER TO WALK THRU VECTORS. 
TMAPS DEF *-*       POINTER TO WALK THRU MAPS.
TNV   ABS *-*       COUNTER.
TN    ABS *-*       - (# OF OPS LEFT TO DO) 
M     ABS *-*       MAX PER REMAP.
MNW   ABS *-*       M * NW
FLAGS ABS *-*       SPECIAL ENTRY FLAG. 
OFSET ABS *-*       # DONE BEFORE SEGMENT JUST COMPLETED. 
SAVEA BSS 1         TEMP FOR SAVING "A" BETWEEN CALLS.
SAVEB BSS 1         TEMP FOR SAVING "B" BETWEEN CALLS.
MAPS  BSS 6         MAP TABLE.
T1    BSS 1         TEMP. 
* 
NEXIT DEF *-*       NORMAL EXIT ADDRESS.
DFSUB DEF *-*       ADDR SUBROUTINE FOR NON-EMA.
JSBSB JSB DFDFS,I   JSB TO IT.
      ORB 
DFDFS DEF DFSUB,I   LINK TO SUBROUTINE. 
BEXIT DEF EXIT      BASE PAGE LINK TO EXIT. 
      ORR 
      SKP 
*                   ENTRY.  COPY PARAMETERS.
* 
.WCOM NOP 
      LDA .WCOM,I   SET UP CALL / OPCODE. 
      STA DFSUB     (IN CASE SUB ADDR)
      SSA,RSS       WHICH IS IT ? 
      LDA JSBSB     SUB ADDR.  USE JSB THRU BASE PAGE.
      STA CALL
      ISZ .WCOM 
      LDA .WCOM,I   EXTRACT # SCALARS & # VECT. 
      AND =B377 
      STA #VECT 
      XOR .WCOM,I 
      ISZ .WCOM 
      ALF,ALF 
      STA #MISC 
      LDA .WCOM,I   COPY FLAGS: 
      ALF,RAR       CHANGE BITS 14,13,12 TO BITS 1,0,15 
      STA FLAGS 
      LDA .WCOM,I   ISOLATE KNW.
      ISZ .WCOM 
      AND =B1777
      STA KNW       SAVE 1024 / # WDS PER 
* 
*                   SET UP CALL TO MICROCODE.  (& .VSET)
* 
      LDA .WCOM     COPY RETURN ADDR OF UNIQUE INTERFACE. 
      ADA =D-5      (HAS BEEN ISZ'D)
      LDA A,I 
      LDB A,I       THIS IS THE ONE.
      STB NEXIT     (*+N+1) 
      CMA           (-*-1)
      ADB A         N 
      ADB VOUT      FORM RETURN ADDRESS.
      STB RTN 
      LDB JEXIT     STORE JUMP THERE. 
      STB RTN,I 
      CMA,INA       (*+1) 
      STA VIN       FOR .VSET 
      CLA           CLEAR LAST-TIME FLAG. 
      STA LASTF 
      STA OFSET     AND SET TOTAL # SO FAR = 0. 
* 
*                   USE .VSET TO FINISH SETTING UP. 
* 
      JSB .VSET     SET IT UP ! 
      DEF *+7 
VIN   DEF *-*       OLD PARAM LIST. 
VOUT  DEF PARAM     NEW PARAM LIST. 
DMAPS DEF MAPS      MAP TABLE.
#MISC ABS *-*       # MISC PARAMS.
#VECT ABS *-*       # VECTORS.
KNW   ABS *-*       (1024 / # WORDS PER ELEMENT) - 1
      JMP ERROR     ERROR EXIT. 
      JMP HARD      HARD WAY EXIT.
      SKP 
*                   LOAD MAPS.
* 
ESEG  JSB .ESEG     A = 0,  B = 2 * # VECT. 
      DEF *+2 
      DEF MAPS
      JMP ERROR     IF MAPPING ERROR. 
* 
*                   DO THE NON-EMA CALL.
* 
      LDA SAVEA     RESTORE A,B. (X,Y WEREN'T CHANGED)
      LDB SAVEB 
CALL  JSB *-*       CALL TO NON-EMA ROUTINE.
RTN   DEF *-* 
PARAM BSS 16        ROOM FOR 16 PARAMS & JUMP AFTER THEM. 
JEXIT JMP BEXIT,I   THE JUMP TO BE PUT THERE. 
EXIT  STA SAVEA     SAVE A,B
      STB SAVEB 
* 
*                   DO ANY SPECIAL PROCESSING AFTER EACH CALL.
* 
      LDA FLAGS     SEE IF WE RETURN TO THE CALLER FOR SPECIALS.
      SLA,RSS       IT'S BIT 0 NOW. 
      JMP EXIT2     NO. 
      JSB .WCOM,I   YES. DO IT. 
      DEF PARAM     ADDRESS OF PARAM LIST.
LASTF ABS *-*       LAST-TIME FLAG. 
      LDA FLAGS 
EXIT2 SSA,RSS       IS SCALAR AN ORDINAL ?  (BIT 15 NOW)
      JMP EXIT4     NO. 
      LDA PARAM,I   YES. A = THE ORDINAL. 
      CMA,SSA,RSS   NEW ONE ? 
      JMP EXIT3     NO.  ("A" IS CORRECT VALUE) 
      CMA           YES. RESTORE "A". 
      ADA OFSET     MAKE IT RELATIVE TO TRUE START. 
EXIT3 XOR LASTF     IF NOT LAST TIME, COMPLEMENT IT.
      STA PARAM,I 
      LDA OFSET     UPDATE OFFSET.
      ADA M 
      STA OFSET 
EXIT4 LDA SAVEA     RESTORE A,B (X,Y UNCHANGED) 
      LDB SAVEB 
      ISZ LASTF     LAST TIME ? 
      JMP NEXIT,I   YES, ALL DONE.
* 
*                   HARDWAY CODE BETWEEN SECTIONS.
* 
      LDA VOUT      SET UP POINTERS.
      ADA #MISC 
      STA TV1 
      LDA DMAPS 
      STA TMAPS 
      LDA #VECT 
      CMA,INA 
      STA TNV 
      SKP 
*                   LOOP THRU VECTORS UPDATING MAPS & MSEG POINTERS.
* 
LOOP1 DLD TV1,I     B = INDEX ADDR. 
      LDA B,I       A = INDEX.
      MPY MNW       MNW * INDEX.
      ASL 6         B = PAGE INCREMENT. 
      ALF,ALF 
      RAL,RAL       A = DISPLACEMENT INCREMENT. 
      STA T1        SAVE DISP INCR. 
      LDA TV1,I     BUMP VECTOR ADDRESS.
      AND =B176000  PAGE #
      STA LASTF     (USE LASTF AS TEMP) 
      XOR TV1,I     DISP
      ADA T1        BUMP DISPLACEMENT.
      ADA =D-1024   CHECK IF PAGE OVERFLOW. 
      SSA,RSS       IF SO, A >= 0.
      INB           YES. ADVANCE PAGE #.
      AND =B1777    REMOVE OVERFLOW IF THERE. 
      IOR LASTF     ADD PAGE # FOR FULL ADDRESS.
      STA TV1,I     UPDATE IT.
      ISZ TV1 
      ISZ TV1 
      ADB TMAPS,I   BUMP PAGE.
      STB TMAPS,I   UPDATE MAPS.
      ISZ TMAPS 
      INB 
      STB TMAPS,I 
      ISZ TMAPS 
      ISZ TNV       COUNT VECTORS.
      JMP LOOP1     IF MORE.
* 
*                   COMPUTE AMOUNT LEFT.  SET RETURN ADDRESS IF FLAGGED.
* 
      LDB TN        B = - (AMOUNT LEFT) 
      LDA B         A = (AMOUNT LEFT) 
      CMA,INA 
      ADB M         B = - (NEW AMOUNT LEFT) 
      SSB,RSS       LAST TIME ? 
      STA M         YES. CORRECT OPERATION COUNT. 
      LDA FLAGS     IF SPECIAL, SET RTN ADDR TO -M. 
      RAR,ERA       E=1 IF SPECIAL. 
      LDA M         M 
      CMA,INA 
      SEZ           SPECIAL ? 
      STA RTN       YES.
NEXT  STB TN        B = - (NEW AMOUNT LEFT) 
      ASR 15        B = 0 IF LAST TIME, -1 IF NOT.
      STB LASTF 
      CLA           SET A = 0 
      LDB #VECT     AND B = 2 * # VECTORS.
      BLS 
      JMP ESEG      GO DO ANOTHER.
      SKP 
*                   HARD WAY SETUP.  COMPUTE M*NW.
* 
HARD  STA M         MAX PER REMAP.
      ISZ KNW       FORM 1024 / NW
      LDA =D1024    RECONSTRUCT NW. 
      CLB 
      DIV KNW 
      STA T1
      MPY M         M*NW
DEFM  EQU *-1 
      STA MNW       (FITS IN 15 BITS) 
* 
*                   LOOP TO ADJUST FOR NEGATIVE INDICES.
* 
      LDA VOUT      SET UP POINTERS ETC.
      ADA #MISC 
      STA TV1 
      LDA DMAPS 
      STA TMAPS 
      LDA #VECT 
      CMA,INA 
      STA TNV 
LOOP2 DLD TV1,I     B = ADDR INDEX. 
      LDB B,I       B = INDEX.
      SSB,RSS       NEG INCREMENT ? (NEG INDEX) 
      JMP LOOP3     NO. 
      AND =B1777    YES.  SEE IF FIRST ELEMENT CROSSES PAGE.
      ADA T1
      ADA =D-1025 
      SSA,RSS       WELL ?
      JMP LOOP3     YES.  LEAVE ALL AS IT WAS.
      LDB TMAPS,I   NO.  BACK UP MAPS.
      CCA 
      ADA B 
      DST TMAPS,I 
      LDA TV1,I     AND ADVANCE MSEG ADDR TO SECOND PAGE. 
      ADA =D1024
      STA TV1,I 
LOOP3 ISZ TMAPS     LOOP. 
      ISZ TMAPS 
      ISZ TV1 
      ISZ TV1 
      ISZ TNV       COUNT # VECT. 
      JMP LOOP2     IF MORE.
      LDB TV1,I     GET N.
      LDB B,I       N.
      LDA DEFM      CHANGE DEF IN CALL TO POINT TO M. 
      STA TV1,I 
      LDA B         A = N.
      CMB,INB       B = -N. 
      ADB M         B - -(NEW AMOUNT LEFT)
      SSB,RSS       LAST TIME ? 
      STA M         YES. CORRECT OPERATION COUNT. 
      JMP NEXT      GO DO FIRST OP. 
      SKP 
*                   ERROR HANDLING. 
* 
ERROR JSB ERR0      COMPLAIN. 
      JMP NEXIT,I   & EXIT. 
      SPC 3 
      UNS 
      END