247 lines
8.8 KiB
NASM
247 lines
8.8 KiB
NASM
; =====> SAPROP.ASM
|
||
;***************************************
|
||
;* TIPC Scheme '84 Runtime Support *
|
||
;* Property List Support *
|
||
;* *
|
||
;* (C) Copyright 1986 by *
|
||
;* Texas Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: 7 May 1986 *
|
||
;* Last Modification: 11 May 1986 *
|
||
;***************************************
|
||
include scheme.equ
|
||
|
||
DGROUP group data
|
||
data segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
data ends
|
||
|
||
PGROUP group prog
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
|
||
;************************************************************************
|
||
;* Search for Property in Property List *
|
||
;* *
|
||
;* Calling Sequence: found? = prop_search(list,prop); *
|
||
;* *
|
||
;* Input Parameters: list - the property list for a symbol. *
|
||
;* prop - the property for which to search. *
|
||
;* *
|
||
;* Output Parameters: found? - if the property was found in the list, *
|
||
;* found?=1; else found?=0. *
|
||
;* list - a pointer to the property/value pair *
|
||
;* for the specified property. If not found, NIL. *
|
||
;* *
|
||
;* Note: This routine is an assembly language version of the following *
|
||
;* C source: *
|
||
;* prop_search(list, prop) *
|
||
;* int list[2],prop[2]; *
|
||
;* { *
|
||
;* int search[2]; /* current search entry in list */ *
|
||
;* int temp[2]; /* temporary "register" */ *
|
||
;* ENTER(prop_search); *
|
||
;* *
|
||
;* mov_reg(search, list); *
|
||
;* take_cdr(search); *
|
||
;* while(search[C_PAGE]) *
|
||
;* { *
|
||
;* mov_reg(temp, search); *
|
||
;* take_car(temp); *
|
||
;* if (eq(temp,prop)) *
|
||
;* { *
|
||
;* mov_reg(list, search); *
|
||
;* return(FOUND); *
|
||
;* } *
|
||
;* take_cddr(search); *
|
||
;* } /* end: while(search[C_PAGE]) */ *
|
||
;* return(NOT_FOUND); *
|
||
;* } /* end of function: prop_search(list, prop) */ *
|
||
;************************************************************************
|
||
p_arg struc
|
||
dw ? ; caller's BP
|
||
dw ? ; caller's ES
|
||
dw ? ; return address
|
||
p_list dw ? ; addr of reg containing list to search
|
||
p_prop dw ? ; the property for which we're searching
|
||
p_arg ends
|
||
|
||
public prop_sea
|
||
prop_sea proc near
|
||
push ES ; save caller's ES register
|
||
push BP ; save caller's BP register
|
||
mov BP,SP ; establish addressability
|
||
; Load up the property for which we're searching into CL:DX
|
||
mov BX,[BP].p_prop
|
||
mov CL,byte ptr [BX].C_page
|
||
mov DX,[BX].C_disp
|
||
; Load up a pointer to the beginning of the property list
|
||
mov SI,[BP].p_list
|
||
xor BX,BX
|
||
mov BL,byte ptr [SI].C_page
|
||
mov DI,[SI].C_disp
|
||
jmp short start
|
||
; Property didn't match-- keep searching list
|
||
no_match: mov BL,ES:[DI].cdr_page
|
||
mov DI,ES:[DI].cdr
|
||
; Take CDR to get to first property/value pair or to follow list
|
||
start: cmp BL,0
|
||
je p_nf
|
||
cmp byte ptr ptype+[BX],LISTTYPE*2
|
||
jne p_nf
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX]
|
||
mov BL,ES:[DI].cdr_page
|
||
mov DI,ES:[DI].cdr
|
||
; Test for valid list cell
|
||
cmp BL,0
|
||
je p_nf
|
||
cmp byte ptr ptype+[BX],LISTTYPE*2
|
||
jne p_nf
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX]
|
||
cmp DX,ES:[DI].car
|
||
jne no_match
|
||
cmp CL,ES:[DI].car_page
|
||
jne no_match
|
||
; Property found!-- return pointer to it
|
||
mov byte ptr [SI].C_page,BL ; move pointer to property entry
|
||
mov [SI].C_disp,DI ; into the "list" operand register
|
||
pop BP ; restore caller's BP register
|
||
pop ES ; restore caller's ES register
|
||
mov AX,1 ; indicate property found
|
||
ret ; return
|
||
; End of property list-- return not found
|
||
p_nf: xor AX,AX ; indicate no match found
|
||
pop BP ; restore caller's BP register
|
||
pop ES ; restore caller's ES register
|
||
ret ; return
|
||
prop_sea endp
|
||
|
||
;************************************************************************
|
||
;* Search for Symbol in Property List *
|
||
;* *
|
||
;* Calling Sequence: sym_search(sym) *
|
||
;* *
|
||
;* Input Parameters: sym - a register containing a symbol who's *
|
||
;* property list is to be located. *
|
||
;* *
|
||
;* Output Parameters: sym - the register is updated to point to the *
|
||
;* property list for the symbol. If no property *
|
||
;* list exists, it is set to NIL. *
|
||
;* *
|
||
;* Note: This routine is an assembly language version of the following *
|
||
;* C source: *
|
||
;* sym_search(sym) *
|
||
;* int sym[2]; *
|
||
;* { *
|
||
;* int hash_value; /* symbol's hash value */ *
|
||
;* int sym_save[2]; /* initial value of symbol argument */ *
|
||
;* int temp[2]; /* temporary "register" */ *
|
||
;* ENTER(sym_search); *
|
||
;* *
|
||
;* if (ptype[CORRPAGE(sym[C_PAGE])] == SYMTYPE*2) *
|
||
;* { *
|
||
;* /* save symbol's page and displacement for testing purposes */ *
|
||
;* mov_reg(sym_save, sym); *
|
||
;* *
|
||
;* /* obtain hash chain to search */ *
|
||
;* hash_value = sym_hash(sym); *
|
||
;* sym[C_PAGE] = prop_page[hash_value]; *
|
||
;* sym[C_DISP] = prop_disp[hash_value]; *
|
||
;* *
|
||
;* while(sym[C_PAGE]) *
|
||
;* { *
|
||
;* mov_reg(temp, sym); *
|
||
;* take_caar(temp); *
|
||
;* if (eq(temp, sym_save)) *
|
||
;* { *
|
||
;* /* symbol found-- return pointer to symbol's property list */*
|
||
;* take_car(sym); *
|
||
;* break; *
|
||
;* } *
|
||
;* else *
|
||
;* { *
|
||
;* take_cdr(sym); *
|
||
;* } *
|
||
;* } /* end: while(sym[C_PAGE]) */ *
|
||
;* } *
|
||
;* } /* end of function: sym_search(sym) */ *
|
||
;* *
|
||
;************************************************************************
|
||
sym_args struc
|
||
dw ? ; caller's ES register
|
||
dw ? ; caller's BP register
|
||
dw ? ; return address
|
||
s_sym dw ? ; address of symbol/result register
|
||
sym_args ends
|
||
|
||
public sym_sear
|
||
sym_sear proc near
|
||
push BP ; save the caller's BP register
|
||
push ES ; save the caller's ES register
|
||
mov BP,SP ; establish addressability
|
||
; Load a pointer to the symbol and get its hash value
|
||
mov SI,[BP].s_sym ; load symbol register's address
|
||
mov BX,[SI].C_page ; load symbol's page number
|
||
cmp byte ptr ptype+[BX],SYMTYPE*2 ; it is a symbol, isn't it?
|
||
jne s_nf ; if not a symbol, return NIL
|
||
mov SI,[SI].C_disp ; load symbol's displacement and
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX] ; paragraph address
|
||
mov CX,BX ; copy the symbol into CL:DX
|
||
mov DX,SI
|
||
mov BL,ES:[SI].sym_hkey ; load hash key
|
||
mov DI,BX ; copy hash key into DI and
|
||
shl DI,1 ; multiply by two for word index
|
||
mov BL,prop_pag+[BX] ; load property list header for this
|
||
mov DI,prop_dis+[DI] ; symbol's bucket
|
||
jmp short go
|
||
; Search the next entry in the bucket
|
||
s_next: mov BX,AX
|
||
LoadPage ES,BX
|
||
;;; mov ES,AX ; restore ES register for bucket entry
|
||
s_next1: mov BL,ES:[DI].cdr_page ; load pointer to next bucket entry from
|
||
mov DI,ES:[DI].cdr ; the CDR field
|
||
go: cmp BL,0 ; end of bucket?
|
||
je s_nf ; if so, jump
|
||
cmp byte ptr ptype+[BX],LISTTYPE*2 ; list cell?
|
||
jne s_nf ; if not a pair (?), jump
|
||
LoadPage ES,BX
|
||
mov AX,BX ; Save Bucket entry page number
|
||
;;; mov ES,pagetabl+[BX] ; load list cell's paragraph address
|
||
; Fetch the property list from the CAR field of the bucket entry
|
||
mov BL,ES:[DI].car_page
|
||
mov SI,ES:[DI].car
|
||
cmp BL,0 ; no property list for this bucket entry?
|
||
je s_next1 ; if not (?), ignore it
|
||
cmp byte ptr ptype+[BX],LISTTYPE*2 ; it is a pair, isn't it?
|
||
jne s_next1 ; if not (?), ignore it
|
||
;;; mov AX,ES ; save ES register for bucket entry
|
||
LoadPage ES,BX
|
||
;;; mov ES,pagetabl+[BX] ; load the paragraph addr of prop list entry
|
||
cmp DX,ES:[SI].car ; entry for our symbol?
|
||
jne s_next ; if not, jump
|
||
cmp CL,ES:[SI].car_page ; entry for our symbol?
|
||
jne s_next ; if not, jump
|
||
; Symbol's property list found-- return in symbol register (or return NIL)
|
||
mov DI,[BP].s_sym ; reload source/destination register address
|
||
mov byte ptr [DI].C_page,BL ; store prop list pointer into
|
||
mov [DI].C_disp,SI ; the register
|
||
pop ES ; restore the caller's ES register
|
||
pop BP ; restore the caller's BP register
|
||
ret ; return
|
||
; Invalid list structure-- return NIL
|
||
s_nf: xor AX,AX ; create a NIL pointer
|
||
mov DI,[BP].s_sym
|
||
mov byte ptr [DI].C_page,AL
|
||
mov [DI].C_disp,AX
|
||
pop ES
|
||
pop BP
|
||
ret
|
||
sym_sear endp
|
||
|
||
prog ends
|
||
end
|
||
|