MATIOTA Source Code

This is the 80386 assembler source code for the MATIOTA FastFn, written to be used on the APL*PLUS II/386 and III/Windows systems. For more information about the APL-to-assembler interface, see the APL*PLUS reference manuals. This page includes two files:

Remember, this assembler code was written by someone who is mainly an APL programmer, so prepare yourself...


MATIOTA.AS3 File

; MATIOTA -  Searches for each row of character matrix B in character
;            matrix A.  Returns the index of the row in A or 0 if not found.
;            Called with:
;               R <- ((#STPTR'Z A B T'),ALG) #CALL MATIOTA{delta}OBJ
;            where:
;                Z  - the result, integer vector
;                A  - the left argument, character scalar/vector/matrix
;                B  - the right argument,   "        "      "      "
;                T  - temporary variable used for hash table
;              ALG  - what algorithm to use:
;                       1 = linear search
;                       2 = hashing
;                       0 = choose fastest
;             R[1]  - error code:
;                       0 = no error
;                       1 = RANK ERROR
;                       2 = WS FULL
;                       3 = VALUE ERROR
;                       4 = DOMAIN ERROR
;
; Copyright (c) 1988, 1989, 1994 by Jim Weigang.  All rights reserved.
;
; July 1989:  Hashing version implemented.
; 3 Jan 94:
;   Fixed bug that caused crash with A{<-}51 0{reshape}'' and
;   B{<-}77 0{reshape}''.  In the hashing
;   algorithm, the offsets of the current row within A and B were being used
;   as the loop counters.  However, because A and B were empty, the offsets
;   never changed, causing the loops to not terminate (for the A loop) or
;   terminate too quickly (for the B loop).  This caused a system crash if
;   A had zero columns, or an incorrect result if only B had zero columns.
;   Thanks to Carol Pascale for tracking down and reporting this bug.
; 20 Jun 94:  Adapted to run under APL*PLUS II or III
; 17 Dec 94:  Adapted to use QUADCALL.INC
; 25 Aug 96:
;   Source code placed on my Web site.  Permission is granted to adapt and
;   use this algorithm on systems other than APL*PLUS.  This code is supplied
;   as-is, without any warranties of any kind.  In no event shall the author
;   be liable for any damages whatsoever arising from the use or inability
;   to use this code.
;   *** Caution:  Do not rely on the comments being correct!  Unlike the
;       code, they have never been tested.
;
.386P
CODE SEGMENT BYTE
 ASSUME CS:CODE

MATIOTA PROC NEAR

; Parameters used in deciding which algorithm to use
; These were derived on a 386/DX16 system and could probably stand some
; updating.  Use ALG parameters of 1 and 2 to measure the execution
; time of the hashing and linear search algorithms.  See the section
; "Decide which algorithm to use" for how these constants are used
; to estimate the execution time.
;
HSET  EQU 1050000000  ; setup time for hashing
HPSET EQU    4000000  ; setup time for coefficient
HPPER EQU      72900  ; per-column time for coefficient
LSET  EQU  900000000  ; setup time for linear search
LPSET EQU     361000  ; setup time for coefficient
LPPER EQU        352  ; per-column time for coefficient
;
; (Times are expressed in units of 1E-11 seconds.)

;--------------------------------------------------------------------;
; Stack Frame--contains all variables used within the program        ;
;                                                                    ;
SF      struc

APOS DD 0       ; These variables are above the VIBs to avoid having
ANROWS DD 0     ;    to use 32-bit offsets to refer to them.
ANCOLS DD 0
AEND DD 0
IROW DD 0
BPOS DD 0
BNROWS DD 0
BNCOLS DD 0
BEND DD 0
ZEND DD 0
XSWID DD 0
MINWID DD 0
ZPOS DD 0
J DD 0
SFBASE DD 0
VIBLEN DW 0
HM DD 0
NDPTR DD 0
LHM DB 0
ALG DB 0

; VIB for A
A       dw ?    ; length of VIB
ahandle dw ?    ; #STPTR value for variable
atype   db ?    ; variable type
arank   db ?    ; rank
anpack  db ?    ; always 0
anshape db ?    ; number of shape elements (2 in this case)
anelm   dd ?    ; number of elements
adptr   dd ?    ; address of first element
ashp1   dd ?    ; first shape element
ashp2   dd ?    ; second shape element

; VIB for B
B       dw ?    ; length of VIB
bhandle dw ?    ; #STPTR value for variable
btype   db ?    ; variable type
brank   db ?    ; rank
bnpack  db ?    ; always 0
bnshape db ?    ; number of shape elements (2 in this case)
bnelm   dd ?    ; number of elements
bdptr   dd ?    ; address of first element
bshp1   dd ?    ; first shape element
bshp2   dd ?    ; second shape element

; VIB for T
T       dw ?    ; length of VIB
thandle dw ?    ; #STPTR value for variable
ttype   db ?    ; variable type
trank   db ?    ; rank
tnpack  db ?    ; always 0
tnshape db ?    ; number of shape elements (1 in this case)
tnelm   dd ?    ; number of elements
tdptr   dd ?    ; address of first element
tshp1   dd ?    ; first shape element
TSHP2   DD ?    ; ooh, was this a hard bug to find...

; VIB for Z
Z       dw ?    ; length of VIB
zhandle dw ?    ; #STPTR value for variable
ztype   db ?    ; variable type
zrank   db ?    ; rank
znpack  db ?    ; always 0
znshape db ?    ; number of shape elements (2 in this case)
znelm   dd ?    ; number of elements
zdptr   dd ?    ; address of first element
zshp1   dd ?    ; first shape element
zshp2   dd ?    ; second shape element

dummy   dw ?    ; dummy length for last VIB

SF      ends
;                                                                    ;
; End of stack frame                                                 ;
;--------------------------------------------------------------------;

VIBLENGTH EQU DUMMY-Z

;--------------------------------------------------------------------;
; Beginning of Program                                               ;
;                                                                    ;
 INCLUDE QUADCALL.INC   ; define CALL_ISS and TYP_*
 SUB ESP,TYPE SF        ; push stack frame onto the stack
 MOV [ESP].SFBASE,ESP   ; remember address of stack frame
 MOV [ESP].VIBLEN,VIBLENGTH

 MOV [ESP].ZHANDLE,AX   ; remember #STPTRs
 MOV [ESP].AHANDLE,BX
 MOV [ESP].BHANDLE,CX
 MOV [ESP].THANDLE,DX
 MOV EAX,EBP
 MOV [ESP].ALG,AL       ; algorithm selection byte
 MOV EBP,ESP            ; now allow addressing via EBP

 MOV [EBP].ANSHAPE,2    ; these VIBs have room for 2 shape elts
 MOV [EBP].BNSHAPE,2
 MOV [EBP].TNSHAPE,2
 MOV [EBP].ZNSHAPE,2
 MOV [EBP].ANPACK,0     ; and have no extra address fields
 MOV [EBP].BNPACK,0
 MOV [EBP].TNPACK,0
 MOV [EBP].ZNPACK,0
 MOV AX,[EBP].VIBLEN    ; length of each VIB
 MOV [EBP].A,AX         ; chain the VIBs together
 MOV [EBP].B,AX
 MOV [EBP].T,AX
 MOV [EBP].Z,AX
 MOV [EBP].DUMMY,0
 LEA EBP,[EBP].A        ; point at first VIB
 MOV AX,1
 CALL_ISS               ; tell interpreter where the VIBs are
 MOV EBP,[ESP].SFBASE

 LEA EBP,[EBP].A
 MOV AX,2
 CALL_ISS               ; open variable A
 JC SHORT ERR_VALUE     ; err if not defined
 MOV EBP,[ESP].SFBASE
 CMP [EBP].ATYPE,TYP_CHAR
 JNE SHORT ERR_DOMAIN   ; err if A is not character type

 LEA EBP,[EBP].B
 MOV AX,2
 CALL_ISS               ; open variable B
 JC SHORT ERR_VALUE     ; err if not defined
 MOV EBP,[ESP].SFBASE
 CMP [EBP].BTYPE,TYP_CHAR
 JNE SHORT ERR_DOMAIN   ; err if B is not character type

; Open the left argument, A
 SUB EAX,EAX
 INC EAX                ; will hold num rows in A
 MOV EBX,EAX            ; will hold num cols in A
 MOV CL,[EBP].ARANK
 CMP CL,0
 JE SHORT L3            ; goto L3 if scalar
 CMP CL,1
 JE SHORT L1            ; goto L1 if vector
 CMP CL,2
 JE SHORT L2            ; goto L2 if matrix

ERR_RANK:
 MOV AL,1               ; set low byte of return code
 JMP SHORT ERR
ERR_WSFULL:
 MOV AL,2
 JMP SHORT ERR
ERR_VALUE:
 MOV AL,3
 JMP SHORT ERR
ERR_DOMAIN:
 MOV AL,4
 JMP SHORT ERR
ERR:
 AND EAX,0FFH           ; zero out high order of error code
 JMP DONE               ; and return to APL

L1:                     ; vector A
 MOV EBX,[EBP].ASHP1
 JMP SHORT L3
L2:                     ; matrix A
 MOV EAX,[EBP].ASHP1
 MOV EBX,[EBP].ASHP2
L3:
 MOV [EBP].ANROWS,EAX
 MOV [EBP].ANCOLS,EBX

; Open the right argument, B
 SUB EAX,EAX
 INC EAX                ; will hold num rows in B
 MOV EBX,EAX            ; will hold num cols in B

 MOV CL,[EBP].BRANK
 CMP CL,0
 JE SHORT L28
 CMP CL,1
 JE SHORT L12
 CMP CL,2
 JE SHORT L22
 JMP SHORT ERR_RANK
L12:                    ; vector B
 MOV EBX,[EBP].BSHP1
 JMP SHORT L28
L22:                    ; matrix B
 MOV EAX,[EBP].BSHP1
 MOV EBX,[EBP].BSHP2
L28:
 MOV [EBP].BNROWS,EAX
 MOV [EBP].BNCOLS,EBX

; Find width that both arguments have in common (MINWID),
;   and the extra amount the wider argument has (XSWID)
 MOV EAX,[EBP].ANCOLS
 MOV EBX,[EBP].BNCOLS
 CMP EAX,EBX
 JG SHORT L4            ; ->(ANcols>BNcols)/L4
 MOV ECX,EBX
 SUB ECX,EAX
 MOV [EBP].XSWID,ECX    ; XSWID <- BNcols-ANcols
 MOV [EBP].MINWID,EAX   ; MINWID <- ANcols
 JMP SHORT L5
L4:
 MOV ECX,EAX
 SUB ECX,EBX
 MOV [EBP].XSWID,ECX    ; XSWID <- ANcols-BNcols
 MOV [EBP].MINWID,EBX   ; MINWID <- BNcols
L5:

; Create the result variable Z, initialize with zeros
 MOV [EBP].ZTYPE,TYP_INT; type integer
 MOV AH,1               ; rank 1 (vector)
 CMP [EBP].BRANK,1      ; If B was a scalar or vector,
 JG SHORT L27
 MOV AH,0               ;    return a scalar
L27:
 MOV [EBP].ZRANK,AH     ; set the rank
 MOV [EBP].ZNSHAPE,AH   ; and this too
 MOV ECX,[EBP].BNROWS
 MOV [EBP].ZSHP1,ECX    ; set the shape
 LEA EBP,[EBP].Z        ; point at VIB for Z
 MOV AX,3
 CALL_ISS               ; allocate Z
 JC ERR_WSFULL          ; watch for WS FULL
 MOV EBP,[ESP].SFBASE   ; restore normal EBP
 CMP [EBP].ZNELM,0
 JE DONEOK              ; done if result is empty
 MOV EDI,[EBP].ZDPTR
 SUB EAX,EAX
 REP STOSD              ; fill Z with zeroes
 CMP [EBP].ANROWS,0
 JE DONEOK

; Decide which algorithm to use
 MOV AL,[EBP].ALG
 CMP AL,1
 JE L42                 ; use linear search if ALG=1
 CMP AL,2
 JE SHORT L45           ; use hashing if ALG=2
                        ; Else, use the faster algorithm
 MOV EAX,HPPER          ;    compute HPRT <- HPSET+HPPER*MINWID
 MUL [EBP].MINWID
 ADD EAX,HPSET
 MOV EBX,[EBP].ANROWS
 ADD EBX,[EBP].BNROWS
 MUL EBX
 ADD EAX,HSET           ;    compute HSET+HPRT*(ANrows+BNrows)
 ADC EDX,0
 MOV ESI,EDX
 MOV EDI,EAX            ;    ESI:EDI is time for hashing

 MOV EAX,LPPER          ;    compute LPRT <- LPSET+LPPER*MINWID
 MUL [EBP].MINWID
 ADD EAX,LPSET
 MOV EBX,EAX
 MOV EAX,[EBP].ANROWS   ;    compute LSET+LPRT*ANrows*BNrows
 MUL [EBP].BNROWS
 CMP EDX,0              ;    If ANrows*BNrows overflows 32 bits,
 JNE L45                ;       it's a very big case; use hashing
 MUL EBX
 ADD EAX,LSET
 ADC EDX,0              ;    EDX:EAX is time for linear search

 CMP ESI,EDX
 JA L42                 ;    branch if hash time is larger in high order
 JB SHORT L45           ;    branch if hash time is smaller
 CMP EDI,EAX            ;    high order is tied; check low order
 JA L42                 ;    branch if hash time is larger in low order


; HASHING ALGORITHM  ------------------------------------------------;
;                                                                    ;
;                                                                    ;
L45:

; Compute the hashing modulus, HM <- 2*{ceiling}2{log}ANrows
 MOV EBX,[EBP].ANROWS
 SUB ECX,ECX
 MOV CL,31
L43:                    ; Loop for CL=31...1
 SUB EAX,EAX
 INC EAX                ;   EAX <- 1
 SHL EAX,CL             ;   shift bit leftwards
 CMP EAX,EBX            ;   is result bigger than ANrows?
 JBE SHORT L44          ;   if not, quit
 LOOP L43               ;   else, repeat
L44:                    ; Endloop
 INC CL
 MOV [EBP].LHM,CL       ; number of bits in hash
 ADD EAX,EAX
 MOV [EBP].HM,EAX       ; hashing modulus

; Allocate variable T
;    T[0..HM-1] is the hash table HT.  Element HT[h] is 4 times the zero-origin
;               index of the first row of A with hash equal to h.
;    T[HM..end] is the vector NEXT.  Element NEXT[i] is 4 times the
;               index of the next row of A that has the same hash value
;               as row i of A, or -1 if there are no others.
;
 MOV [EBP].TTYPE,TYP_INT; type integer
 MOV [EBP].TRANK,1      ; rank 1 (vector)
 MOV [EBP].TNSHAPE,1    ; *** Is this really necessary?
 MOV EAX,[EBP].HM       ; one elt for each hash value
 ADD EAX,[EBP].ANROWS   ; plus one elt for each row of A
 MOV [EBP].TSHP1,EAX    ; shape of T
 LEA EBP,[EBP].T        ; point at VIB for T
 MOV AX,3
 CALL_ISS               ; allocate T
 JC ERR_WSFULL          ; watch for WS FULL
 MOV EBP,[ESP].SFBASE   ; restore normal EBP
 MOV EDI,[EBP].TDPTR
 MOV ECX,[EBP].TNELM
 SUB EAX,EAX
 DEC EAX                ; EAX <- -1
 CLD                    ; scan upwards
 REP STOSD              ; fill T with -1s

; Build the hash table
;   Irow   - offset to current element of NEXT vector from start of NEXT
;   APOS   - address of start of current row of A
;   NDPTR  - address of first elt of NEXT vector
;   TDPTR  - address of first elt of HT
;
 MOV EAX,[EBP].ADPTR
 ADD EAX,[EBP].ANELM
 MOV [EBP].AEND,EAX     ; points just past end of A
 SUB EAX,[EBP].ANCOLS   ; points to start of last row of A
 MOV [EBP].APOS,EAX

 MOV EAX,[EBP].ANROWS
 DEC EAX
 SHL EAX,2              ; times 4 bytes per elt
 MOV [EBP].IROW,EAX     ; Irow <- offset to current elt of NEXT

 MOV EAX,[EBP].HM
 SHL EAX,2
 ADD EAX,[EBP].TDPTR
 MOV [EBP].NDPTR,EAX    ; points to start of NEXT vector

L34:                    ; Loop for each row of A, last to first
 MOV ESI,[EBP].APOS
 CALL HASHROW
 SHL EAX,2              ;    times 4 bytes per element
 MOV ECX,[EBP].TDPTR    ;    address of T
 MOV EBX,[ECX+EAX]      ;    HT[hash]
 CMP EBX,-1
 JE SHORT L35           ;    If HT[hash] is {/=} -1,
 MOV EDX,[EBP].NDPTR    ;      address of NEXT vector
 ADD EDX,[EBP].IROW
 MOV [EDX],EBX          ;      NEXT[Irow] <- HT[hash]
L35:                    ;    Endif
 MOV EDX,[EBP].IROW
 MOV [ECX+EAX],EDX      ;    HT[hash] <- Irow

 MOV EAX,[EBP].ANCOLS
 SUB [EBP].APOS,EAX     ;    offset to start of next row of A

 SUB [EBP].IROW,4       ;    Irow <- Irow - 4
 JNS L34                ; Endloop

; Look up each row of B in table
 MOV EAX,[EBP].BDPTR
 MOV [EBP].BPOS,EAX
 ADD EAX,[EBP].BNELM
 MOV [EBP].BEND,EAX

 MOV EAX,[EBP].ZDPTR
 MOV [EBP].ZPOS,EAX
 MOV EDX,[EBP].ZSHP1
 SHL EDX,2
 ADD EAX,EDX
 MOV [EBP].ZEND,EAX     ; points just past end of Z

L39:                    ; Loop for each row of B
 MOV ESI,[EBP].BPOS
 CALL HASHROW           ;   compute hash of this row
 SHL EAX,2              ;   times 4 bytes per elt
 MOV EDX,[EBP].TDPTR    ;   address of HT
 MOV EBX,[EDX+EAX]      ;   get EBX <- HT[hash]

L40:
 CMP EBX,-1
 JE SHORT L37           ;   If EBX is not -1,
 MOV EAX,EBX
 SHR EAX,2              ;     index of row in A
 MUL [EBP].ANCOLS       ;     offset to start of row in A
 ADD EAX,[EBP].ADPTR    ;     address of row

 MOV EDI,EAX
 MOV ESI,[EBP].BPOS
 MOV ECX,[EBP].MINWID
 CMP AL,AL              ;     set flag for zero-count case
 REPE CMPSB             ;     compare rows of A and B
 JNE SHORT L38          ;     if not equal, go to next in chain

; The common columns match.  Now see if extra columns are all-blank
 MOV EAX,[EBP].ANCOLS
 CMP EAX,[EBP].BNCOLS
 JA SHORT L41           ;     If B is wider,
 MOV EDI,ESI            ;       put address of B in EDI
L41:                    ;     Endif
 MOV ECX,[EBP].XSWID
 JECXZ L49              ;     If no extra cols, we have a match
 MOV AL,' '
 REPE SCASB             ;     scan for non-blank
 JNE SHORT L38          ;     If all-blank, we have a match
L49:
 SHR EBX,2              ;        convert from offset to index
 INC EBX                ;        1-origin index
 MOV EAX,[EBP].ZPOS     ;
 MOV [EAX],EBX          ;        Z[J] <- Irow
 JMP SHORT L37          ;     Else,

L38:
 ADD EBX,[EBP].NDPTR    ;        go to next in chain
 MOV EBX,[EBX]          ;        EBX <- NEXT[EBX]
 JMP L40

L37:                    ;   go on to the next row of B
 MOV EAX,[EBP].BNCOLS
 ADD [EBP].BPOS,EAX     ;   point to next row of B

 ADD [EBP].ZPOS,4       ;   point to next elt of Z
 MOV EAX,[EBP].ZEND
 CMP [EBP].ZPOS,EAX
 JB L39                 ; Endloop (do next row of B)

 JMP DONEOK
;                                                                    ;
;                                                                    ;
; END of hashing algorithm  -----------------------------------------;



; LINEAR SEARCH ALGORITHM  ------------------------------------------;
;                                                                    ;
;                                                                    ;
L42:

; Now Loop and Loop, comparing rows
 CLD                    ; scan forwards
 MOV EDI,[EBP].BDPTR
 MOV [EBP].BPOS,EDI     ; BPOS <- start of data in B

 MOV EAX,[EBP].ZDPTR
 MOV [EBP].ZPOS,EAX     ; ZPOS <- start of data in Z

 MOV EBX,[EBP].ZSHP1
 SHL EBX,2
 ADD EBX,EAX
 MOV [EBP].ZEND,EBX     ; ZEND points just past end of Z

 MOV EAX,[EBP].MINWID
 MOV EBX,[EBP].ANROWS
 MOV EDX,[EBP].ANCOLS
LOOPB:
 MOV ESI,[ESP].ADPTR    ; Apos <- Afirst
 SUB EBP,EBP
 INC EBP                ; J <- 1
LOOPA:
 MOV EDI,[ESP].BPOS
 MOV ECX,EAX            ; CX <- MINWID
 CMP AX,AX              ; set compare flag for MINWID=0 case
 REPE CMPSB             ; look for mismatch
 JNE SHORT L25          ; if found, goto next row of A
                        ; if no mismatch,
 MOV AL,' '             ;    AL <- ' '
 MOV ECX,[ESP].XSWID    ;    CX <- excess width
 CMP EDX,[ESP].BNCOLS
 JLE SHORT L13          ;    if A is wider than B,
 MOV EDI,ESI            ;       ES:DI <- Aseg,Apos
 ADD ESI,ECX            ;       advance Apos to start of next row
 REPE SCASB             ;       look for non-blank
 JNE SHORT L24          ;       if found, no match
L13:
 CMP EDX,[ESP].BNCOLS
 JGE SHORT L23          ;   if B is wider than A,
 REPE SCASB             ;       look for non-blank
 JE SHORT L23           ;       if found, no match
L24:
 MOV EAX,[ESP].MINWID   ;   No match found,
 JMP SHORT NEXTA
L23:
 MOV EDI,[ESP].ZPOS
 MOV [EDI],EBP          ;   Zseg:Zpos <- J
 MOV EAX,[ESP].MINWID   ;   restore registers
 JMP SHORT NEXTB

L25:
 ADD ESI,ECX            ;   advance Apos to start of next row
 CMP EDX,[ESP].BNCOLS
 JLE SHORT L26
 ADD ESI,[ESP].XSWID
L26:

NEXTA:
 INC EBP                ; J <- J + 1
 CMP EBP,EBX
 JLE SHORT LOOPA        ; ->(J<=ANrows)/LOOPA

NEXTB:
 MOV EDI,[ESP].BNCOLS
 ADD [ESP].BPOS,EDI     ; Bpos <- Bpos + BNcols
 ADD [ESP].ZPOS,4       ; Zpos <- Zpos + 4 (bytes per element)
 MOV EDI,[ESP].ZPOS
 CMP EDI,[ESP].ZEND
 JNE LOOPB              ; ->(Zpos{/=}Zend)/LOOPB
;                                                                    ;
; END of linear search algorithm-------------------------------------;


DONEOK:
 SUB EAX,EAX            ; indicate success
;                                                                    ;
; End of program                                                     ;
;--------------------------------------------------------------------;

DONE:
 ADD ESP,TYPE SF  ; pop our storage off the stack
 RET
MATIOTA ENDP


;--------------------------------------------------------------------;
; HASHROW  - computes the hash of a string                           ;
;            Arguments:                                              ;
;               ESI     - pointer to start of string                 ;
;               MINWID  - number of bytes in string                  ;
;               LHM     - number of bits in hashing modulus          ;
;            Results:                                                ;
;               EAX   - hash value                                   ;
;               ESI   - points just past end of string               ;
;            Also alters ECX and EDX                                 ;
;            This is Fibonacci hashing, as described in Knuth's      ;
;            Sorting and Searching, page 511.                        ;
;                                                                    ;
HASHROW PROC NEAR

 SUB EDX,EDX
 MOV ECX,[EBP].MINWID
 SHR ECX,2              ; divide by 4 bytes per element
 JECXZ SHORT L47
L33:
 LODSD
 XOR EDX,EAX            ; blend together the whole doublewords in the string
 ROL EDX,1
 LOOP L33
L47:
 SUB EAX,EAX
 MOV ECX,[EBP].MINWID
 AND CL,3               ; how many bytes left over
 CMP CL,0
 JE SHORT L48
 LODSB                  ; load the 1st byte
 CMP CL,1
 JE SHORT L48
 SHL EAX,8              ; move the first byte leftwards
 LODSB                  ; load the 2nd byte
 CMP CL,2
 JE SHORT L48
 SHL EAX,8              ; move first 2 bytes leftwards
 LODSB                  ; load the 3rd byte
L48:
 XOR EAX,EDX            ; blend in the odd word
 MOV EDX,2671865257     ; my magic multiplier
 MUL EDX
 SUB EDX,EDX
 MOV CL,[EBP].LHM       ; number of digits in hash
 SHLD EDX,EAX,CL        ; shift hash into EDX
 MOV EAX,EDX

 RET
HASHROW ENDP
;                                                                    ;
;--------------------------------------------------------------------;


CODE ENDS
 END

QUADCALL.INC File

 ; Include file used with APL*PLUS II and III #CALL assembler routines.
 ;
 ; The include statement that inserts this file should appear at the top of
 ;   the program, just before the first executable statement.
 ;
 ; If the program's stack frame structure is not named "SF", or if the stack
 ;   frame is more than one structure, the program must define constant
 ;   SFSIZE to be the size of the stack frame, after the INCLUDE statement.
 ;   For example:
 ;
 ;      INCLUDE QUADCALL.INC
 ;      SFSIZE = (TYPE SFSTRUC1) + (TYPE SFSTRUC2)


 ; Signature of an APL*PLUS II #CALL program:
QUADCALL_L1:            ; this label is used by CALL_ISS, below
 DB '386P'              ; this will be changed to '386w' on +III


 ; Signature that identifies the code as being able to run under
 ;   either APL*PLUS II or III (after changing 386P to 386w):
 JMP SHORT QUADCALL_L2
 DB '23'
QUADCALL_L2:


 ; Type codes used in the VIBs:
TYP_BOOL  EQU 1
TYP_CHAR  EQU 0
TYP_INT   EQU 2
TYP_REAL  EQU 3
TYP_FLOAT EQU 3

 ; ISS service call codes
ISS_INIT     EQU 1
ISS_OPEN     EQU 2
ISS_ALLOCATE EQU 3
ISS_ERASE    EQU 4
ISS_COERCE   EQU 6


 ; Macro to call the ISS routine on either APL*PLUS II or III
 ;   Assumes that ESP points to the stack frame, and that nothing extra
 ;   has been pushed on the stack (i.e., no PUSHes and no subr calls).
 ;
CALL_ISS MACRO
 LOCAL L1,L2,L3
 PUSH EAX               ; save original EAX
 CALL L1                ; push EIP onto the stack
L1:
 POP EAX                ; EAX <- address of L1:
 CMP CS:[EAX+3+QUADCALL_L1-L1],BYTE PTR 'P'  ; check last char of signature
 POP EAX                ; restore original value of EAX
 JNE SHORT L2           ; If the char was 'P',
 INT 0C8H               ;   make II-style call
 JMP SHORT L3
L2:                     ; Else,
 CALL DWORD PTR [ESP+SFSIZE+4] ;   make III-style call
L3:                     ; Endif
 ENDM


 ; Constant SFSIZE is the size of the stack frame.  If the stack frame
 ;   in your program is not named SF or is other than a single structure,
 ;   you must define SFSIZE explicitly in your program.
 ;
IFDEF SF                ; define SFSIZE only if SF is defined
SFSIZE = TYPE SF        ; use = instead of EQU so it can be redefined
ENDIF


Home Page