;/* P_UNIFY.ASM:
COMMENT ~
************************************************************************
ASSEMBLY-LANGUAGE extensions for VISUAL PROLOG 5 (and PDC PROLOG 3.31)
************************************************************************
by G. A. Stathis
"PAIR-STRING PREDICATES"
------------------------
A family of external PREDICATES for VISUAL PROLOG(tm)
to handle Grammatic and Syntactic attributes
of (large) human dictionaries
GLOBAL PREDICATES
p_unifyx(STRING,STRING,STRING) -(i,i,o) language c
p_select(STRING,STRING,STRING) -(i,i,o) language c
p_remove(STRING,STRING,STRING) -(i,i,o) language c
p_rename(STRING,STRING,STRING) -(i,i,o) language c
p_delval(STRING,STRING,STRING) -(i,i,o) language c
~
; *********************************************************************
IDEAL
MODEL LARGE
DATASEG
PUBLIC _p_ctb ;make the internal char-table public;
PUBLIC _p_512 ;other programs allowed to use _p_512
_p_ctb db 256 dup (00h)
_p_512 db 513 dup (00h)
CODESEG
extrn _MEM_SaveStringGStack:far ;PDC/Visual Prolog calls
extrn _RUN_Fail:far
; *********************************************************************
; ********************* LOCAL NEAR PROCEDURES: ************************
; *********************************************************************
; **** INITIALISATION (setting all bytes in '_p_ctb' to 0) ****
PROC cleartb near
; assuming: DS = standard data-segment (copying it also to ES)
; uses: ax, cx, bx
; exits with: bx = offset of _p_ctb, es = clone of DS
; ============================================================
mov di,offset DS:_p_ctb ;
mov ax,ds ;
mov es,ax ;
mov bx,di ;
mov cx,64 ;
P386N ;
xor eax,eax ;
rep stosd ;fill 64*4=256 places of table with 0.
MASM ;
ret
ENDP cleartb
; **** READING PHASE (updating character-table _p_ctb) *****
PROC emplant near
; assuming: DS:SI is a source-pairstring and ES:BX is _p_ctb
; uses: ax, dx
; =========================================================
xor dh,dh ;make dh = 0
jmp short LP1 ;
; -----------------------
LP00: mov dl,al ;
mov di,bx ;restore starting_offset of _p_ctb
add di,dx ;
movsb ;
LP1: lodsb ;
or al,al ;
jnz LP00 ;
ret
ENDP emplant
; **************** COLLECT and DUMP PHASE: ******************
PROC retriev near
; assuming: ES:DI is suitable string-target, such as '_p_512',
; DS:SI is segment/offset of '_p_ctb'.
; uses: ax, cl, bx
; returns: AX=length of (new) target_string
; ===========================================================
xor ah,ah ;
mov cl,ah ;now CL=AH=0
not cl ;now CL=255
mov bx,di ;copy start_offset of target to BX
jmp short LP2 ;
; -----------------------
LP2a: dec cl ;
jz short Zx2 ;
; - - - - - - - - - - - -
LP2b: inc ah ;
LP2: lodsb ;
or al,al ;
jz short LP2a ;
; - - - - - - - - - - - -
xchg al,ah ;
stosw ;
xchg al,ah ;
dec cl ;
jnz short LP2b ;
; =======================
Zx2: mov byte ptr ES:DI,cl ;end with ascii-zero
mov ax,bx ;
mov dx,es ;return buffer_string in DX:AX
ret
ENDP retriev
; *********************************************************************
; *********************** PUBLIC PREDICATES: **************************
; *********************************************************************
; STRING pp_sort(STRING) -(i) language c
; OUT_p_512SORTED <- (PairSTRi)
; =======================================
public _pp_sort
PROC _pp_sort far
ARG pairstring
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================
cld ;direction forward
ALIGN 2 ;word-alignment (required by PDC documentation)
call cleartb ;clear table '_p_ctb', then ES:BX=_p_ctb
lds si,dword ptr [pairstring] ;.............ARG-1
call emplant ;read pairstring (updating '_p_ctb')
mov ax, es ;
mov ds, ax ;restore standard data-segment in DS
mov si, bx ;now _p_ctb's offset is SI
call retriev ;retrieve sorted pairstring (in _p_512)
; =======================
pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_sort
; *********************************************************************
; STRING pp_unifyx(STRING,STRING) -(i,i) language c
; OUT_p_512 <- (PairSTR1i,PairSTR2i)
; =================================================
public _pp_unifyx
PROC _pp_unifyx far
ARG pairstr1:dword, pairstr2:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================
cld ;direction forward
ALIGN 2 ;word-alignment
call cleartb ;clear table '_p_ctb', then ES:BX=_p_ctb
lds si, dword ptr [pairstr1] ;PAIR_STRING 1...........ARG-1
call emplant ;read pairstring (updating '_p_ctb')
lds si, dword ptr [pairstr2] ;PAIR_STRING 2...........ARG-2
mov ah,'?' ;symbol of 'uninstantiated attrib-value' in AH
mov di,bx ;restoe offset of '_p_ctb' from 'emplant' to DI
xor bx,bx ;clear BX (preparing to use BX temporarily)
mov cx,bx ;also clear CX
jmp short UU1 ;go to start of unification-loop
; =======================
AD1: mov byte ptr ES:[DI+BX],al ;write value in '_p_ctb'
; -----------------------
UU1: lodsb ;load an attribute from pairstring
or al,al ;end of pairstring?
jz UUX ;if so, exit (with success),
mov bl,al ;else move 'attrib_symbol' AL to BL (i.e. BX)
lodsb ;load next byte (the 'value_byte' of the pair)
cmp al,ah ;is pairstring_value uninstantiated?
jz UU1 ;if so, ignore it and go on,
mov cl,byte ptr ES:[DI+BX] ;move 'value' from _p_ctb to CL
jcxz AD1 ;if no value recorded, go record it!
cmp al,cl ;same new value as old?
jz UU1 ;repeat loop if so
cmp cl,ah ;is char_table_value uninstantiated?
jz AD1 ;if so, instantiate it and go on
; ****************************** else fail:
xor al,al ;
mov di,offset DS:_p_512 ;
stosb ;nake STRbuffer=""
call _RUN_fail ;invoke PDC/Visual Prolog's FAIL
jmp short SSX ;
; *******************************
UUX: mov si,di ;now make SI=offset of _p_ctb
mov ax,es ;
mov ds,ax ;restore standard data-seg from ES
mov di,offset DS:_p_512 ;now ES:DI = target_strg _p_512
call retriev ;build result in _p_512, return _p_512
; ===============================
SSX: pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_unifyx
; *********************************************************************
; STRING pp_select(STRING,STRING) -(i,i) language c
; OUT_p_512 <- (PairSTR1i,PairSTR2i)
; =================================================
public _pp_select
PROC _pp_select proc
ARG selection:dword, pairstring:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; ===============================
cld ;direction forward
ALIGN 2 ;word-alignment
call cleartb ;clear table '_p_ctb', then ES:BX=_p_ctb
lds si, dword ptr [selection] ;selection_pairstring.....ARG-1
call emplant ;read selection_pairstring, updating _p_ctb
lds si, dword ptr [pairstring] ;pairstring 2.............ARG-2
mov di,bx ;make DI=offset of _p_ctb
mov ch,'?' ;put uninstantiation-symbol '?' in CH
xor bh,bh ;clear BH (to use BX for access of _p_ctb)
jmp short UU1s ;go to start of selection-loop
; =======================================
AD1s: mov byte ptr ES:[DI+BX],ah ;record new value-byte (in _p_ctb)
; ---------------------------------------
UU1s: lodsw ;load pair (al=attrib, ah=value) from ARG-2
or al,al ;end of pairstring ARG-2?
jz UUXs ;if so, exit (with success)
cmp ah,ch ;is value='?' (i.e. no "new information")?
jz UU1s ;if so, skip and repeat
mov bl,al ;else put attrib in bl to access table-value,
mov cl,byte ptr ES:[DI+BX] ;get table-value into CL
or cl,cl ;not wanted? (void selection in CL?)
jz UU1s ;if not wanted, skip & repeat
cmp cl,ah ;same new value-byte as old?
jz UU1s ;if so, repeat this loop
cmp cl,ch ;is selection value-byte "wanted but unknown"?
jz AD1s ;if so, record new value (now made known as AH)
; ********************** else, incompatible bound-selection:
FLxs: xor ax,ax ; return zero on failure (just in case...)
mov di,offset DS:_p_512 ;
stosb ;nake STRbuffer=""
call _RUN_fail ;invoke PDC/Visual Prolog fail,
jmp short SSXs ;and exit
; *******************************
UUXs: mov si,di ;now make SI=offset of _p_ctb
mov ax,es ;
mov ds,ax ;restore standard data-seg from ES
mov di,offset DS:_p_512 ;now ES:DI = target_str _p_512
call retriev ;
; ===============================
SSXs: pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_select
; *********************************************************************
; STRING pp_remove(STRING,STRING) -(i,i) language c
; OUT_p_512 <- (PairSTR1i,PairSTR2i)
; =================================================
COMMENT ~ This predicate removes from the 'pairstring' ARG-2
all the 'pairs' that _also_ exist within ARG-1. It
will only remove unifiable values, i.e. If told to
remove say "x1" from the pairstring "a1b2", it will
do nothing and return "a1b2" unchanged, since "x1"
is not _present_ inside "a1b2", nor _unifiable_ it.
("Unifiable pairs" are e.g. "x1" and "x?", ...but NOT
"x1" and "x2", since the Axiom of Uniqueness demands
that there is only ONE bound value attached to "x").
~
public _pp_remove
PROC _pp_remove far
ARG selection:dword, pairstring:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================
cld ;direction forward
ALIGN 2 ;word-alignment
call cleartb ;clear table '_p_ctb', then ES:BX=_p_ctb
lds si, dword ptr [pairstring] ;ATTRs.............ARG-2
call emplant ;read pairstring, updating _p_ctb
lds si, dword ptr [selection] ;(to ignore).......ARG-1
mov di,bx ;make DI=offset of _p_ctb
xor bh,bh ;clear BH (to use BX for table-access)
mov ch,'?' ;put uninstantiation-symbol into CH
jmp short UU1z ;goto ignore-selection_loop
; ***********************
SKP1: xor al,al ;
mov byte ptr ES:[DI+BX],al ;clear this value (inside _p_ctb)
UU1z: lodsw ;read pair (attrib=al, value=ah) from ARG-1
or al,al ;end of pairstring?
jz UUXz ;if so exit (with success)
UU1z2: mov bl,al ;else put attrib in BL (to use BX for access)
mov cl,byte ptr ES:[DI+BX] ; get value accessed by DI+BX
or cl,cl ;absent value?
jz UU1z ;if absent_value, it's impossible to ignore...
cmp ah,ch ;is it requested to ignore ANY value?
jz SKP1 ;if so, go clear table-value (and repeat)
cmp ah,cl ;is value-to-ignore same as the existing value?
jz SKP1 ;if so, go clear table-value (and repeat)
cmp cl,ch ;uninstantiated existing valie?
jz SKP1 ;if so, go clear table-value (and repeat) anyway
lodsw ;else read the next pair
or al,al ;end of pairstring?
jnz UU1z2 ;if not so, continue
; *******************************
UUXz: mov si,di ;now make SI=offset of _p_ctb
mov ax,es ;
mov ds,ax ;restore standard data-seg from ES
mov di,offset DS:_p_512 ;now ES:DI = target_string = _p_512
call retriev ;
; ===============================
pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_remove
; *********************************************************************
; STRING pp_rename(STRING,STRING) -(i,i) language c
; OUT_p_512 <- (TransfPAIRi,PairSTR2i)
; =========================================================
COMMENT ~ Sometimes it's required to rename attributes, e.g. from
'Subject=X' to 'Object=X'. In this case, if 'S' signifies
'Subject', and 'O' signifies 'Object', then the attribute-
byte 'S' must become an 'O' (and vice versa). Here, ARG-1
expresses Attribute_name_Changes in the form of pairs, i.e.
if ARG1 ="SO" and ARG2 = "SxOy" then the output must become
"SyOx". If ARG=1 is "SO" it dictates: - Swap 'S' with 'O'!
(Why swap? Well... if 'Sx' becomes 'Ox' and there exists an
'Oy', then we'll get contradiction Ox=/=Oy! So either there
exists no previous value like 'Ox', or else (if there _is_)
then we need to do _something_ about it; Swapping is a good
policy, since if we don't like the converse of the "mapping"
then we can simply call 'pp_rename' again, with an entirely
NEW attribute_name. New attribute_names are not 'swapped').
~
public _pp_rename
PROC _pp_rename far
ARG namechanges:dword, pairstring:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================
cld ;direction forward
ALIGN 2 ;word-alignment
call cleartb ;clear table '_p_ctb', then ES:BX=_p_ctb
lds si, dword ptr [pairstring] ;PAIRstring.......ARG-2
call emplant ;read pairstring, updating _p_ctb
lds si, dword ptr [namechanges] ;NAME-CHANGES.....ARG-1
mov di,bx ;make DI=offset of _p_ctb
xor bh,bh ;clear BH (to use BX for table-access)
xor dh,dh ;clear DH (to use in alternate table-access)
mov ch,'?' ;put uninstantiation-symbol into CH
; ***********************
RU1z: lodsw ;load names to be changed (AL <-> AH)
or al,al ;end of namechange_string?
jz RUXz ;if so, exit (with success)
RU1z2: mov bl,al ;else, copy name1(AL) in BL
mov cl,byte ptr ES:[DI+BX] ;get value1(of name1) in CL
mov dl,ah ; copy name2 in DL
xchg dl,bl ; now bx is dx and dx is bx
mov ch,byte ptr ES:[DI+BX] ;get value2(of name2) in CH
mov byte ptr ES:[DI+BX],cl ;replace value2 by value1
mov bl,dl ;restore BX(for value1)
mov byte ptr ES:[DI+BX],ch ;replace value1 by value2
lodsw ;load next two bytes (attrib/value) from ARG-1
or al,al ;end of namechange_pairstring?
jnz RU1z2 ;if not so, repeat
; *******************************
RUXz: mov si,di ;now make SI=offset of _p_ctb
mov ax,es ;
mov ds,ax ;restore standard data-seg from ES
mov di,offset DS:_p_512 ;now ES:DI = target_string = _p_512
call retriev ;
; ===============================
pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_rename
; *********************************************************************
; STRING pp_delval(STRING,STRING) -(i,i) language c
; OUT_p_512 <- (valuestring,PairSTRi)
; =================================================
COMMENT ~ Sometimes we need to delete inside a PairString
particular 'value_bytes', irrespectively of the
attributes (with which they're associated). The
predicate 'pp_delval' does this; assuming that
the first argument is a collection of attribute-
bytes (rather than a pairstring "operator"), and
that the second argument is the pairstring (from
which it is required to delete those attributes). ~
public _pp_delval
PROC _pp_delval far
ARG toRemove:dword, attribs:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================================
cld ;direction forward
call cleartb ;clear '_p_ctb', ES:BX=_p_ctb
lds si, dword ptr [toRemove] ;..........................ARG-1
mov di,bx ;make di=offset(_p_ctb)
xor bh,bh ;prepare to use bx for access
LPDV1: lodsb ;\
or al,al ;\
jz XLPD1 ;\
LPDVa: mov bl,al ;Loop to plant value-string
mov byte ptr ES:[di+bx],al ;/
lodsb ;/
or al,al ;/
jnz LPDVa ;/
; ***************************************
XLPD1: lds si, dword ptr [attribs] ;..........................ARG-2
mov bx,offset DS:[_p_ctb] ;
mov di,offset DS:[_p_512] ;
LPDV2: lodsw ;read two bytes
or al,al ;zero?
jz DUXz ;
LPDVb: mov dx,ax ;copy them to dx
xchg al,ah ;change al <-> ah to examine al=value
xlat DS:[BX] ;look at value (since _p_ctb is table of values)
or al,al ;
jnz LPDV2 ;if not mapping to zero, repeat without writing
mov ax,dx ;
stosw ;else write (to _p_512), advance DI,
lodsw ;and load next two bytes
or al,al ;end of ARG-2?
jnz LPDVb ;if not so, repeat
; ***********************
DUXz: stosb ;write last zero
mov ax,offset DS:[_p_512] ;
mov dx,es ;return _p_512
; ===============================
pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _pp_delval
; *********************************************************************
; STRING attrib(STRING) -(i) language c
; =====================================
; NOTE: Attributes are already sorted, and unique. To
; collect them all in a string, we only need to
; copy alternate bytes (skipping 'value_bytes').
public _attrib
PROC _attrib far
ARG pairstring:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; ========================
mov ax,ds ;
mov es,ax ;
mov di,offset DS:[_p_512] ;
mov bx,di ;
lds si,dword ptr [pairstring] ;.................ARG-1
; -----------------------
PVL1: lodsb ;load value_byte
or al,al ;zero?
jz PVLx ;exit if so
; -----------------------
PVL1a: movsb ;move attribute_byte to _p_512
lodsb ;load next value_byte
or al,al ;zero?
jnz PVL1a ;if not so, repeat this loop
; =======================
PVLx: stosb ;write terminating zero
mov ax,bx ;
mov dx,es ;return _p_512 in DX:AX
; =======================
pop ds ;restore C's standard data seg
pop si ;
pop bp ;
ret
ENDP _attrib
; *********************************************************************
; STRING p_values(STRING) -(i) language c
; =======================================
; NOTE: 'Value_bytes' are not necessarily unique, nor
; sorted. In order to collect them all in sorted
; form without duplicates, we first 'plant' them
; in the character-table '_p_256'. Then, they are
; 'collected' from this table in sorted form (and
; without duplicates) into string-buffer '_p_512'.
public _p_values
PROC _p_values far
ARG pairstring:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; ========================
mov ax,ds ;
mov es,ax ;
mov di,offset DS:[_p_512] ;
mov bx,di ;
lds si,dword ptr [pairstring] ;.................ARG-1
; -----------------------
PWL1: lodsb ;load value_byte
or al,al ;zero?
jz PWLx ;exit if so
PWL1a: stosb ;else write it to string_buffer _p_512
inc di ;ignore attribute byte
lodsb ;load next value_byte
or al,al ;zero?
jnz PWL1a ;exit if so
; =======================
PWLx: stosb ;write terminating zero
mov ax,bx ;
mov dx,es ;return _p_512 in DX:AX
; =======================
pop ds ;restore C's standard data seg
pop si ;
pop bp ;
ret
ENDP _p_values
; *********************************************************************
; STRING p_strx(byte) -(i) language c % returns "internal strings".
; OUTstr <- (choice) where choice=0 gives _p_ctb, choice=1 gives _p_512
; ===================================================================
public _p_strx
PROC _p_strx far
ARG WhichOne:byte
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; ===============================
mov ax,offset DS:_p_ctb ;
xor bl,bl ;
mov bh,[WhichOne] ;which (0,1?)................ARG-1
add ax,bx ;add 256 accordingly
mov dx,ds ;now AX:DX is inner string
; ===============================
pop ds ;restore C's standard data seg
pop si ;
pop bp ;
ret
ENDP _p_strx
; *********************************************************************
; ******* PUBLIC PREDICATES using PDC/Visual Prolog's "GStack": *******
; *********************************************************************
; p_unifyx(STRING,STRING,STRING) -(i,i,o) language c
; ==================================================
public _p_unifyx
PROC _p_unifyx far
push bp
mov bp,sp
push word ptr [bp+12]
push word ptr [bp+10]
push word ptr [bp+8]
push word ptr [bp+6]
call _pp_unifyx
mov sp,bp
push dx
push ax
call _MEM_SaveStringGStack
mov sp,bp
les bx,dword ptr [bp+14]
mov word ptr es:[bx+2],dx
mov word ptr es:[bx],ax
pop bp
ret
ENDP _p_unifyx
; *********************************************************************
; p_select(STRING,STRING,STRING) -(i,i,o) language c
; ==================================================
public _p_select
PROC _p_select far
push bp
mov bp,sp
push word ptr [bp+12]
push word ptr [bp+10]
push word ptr [bp+8]
push word ptr [bp+6]
call _pp_select
mov sp,bp
push dx
push ax
call _MEM_SaveStringGStack
mov sp,bp
les bx,dword ptr [bp+14]
mov word ptr es:[bx+2],dx
mov word ptr es:[bx],ax
pop bp
ret
ENDP _p_select
; *********************************************************************
; p_remove(STRING,STRING,STRING) -(i,i,o) language c
; ==================================================
public _p_remove
PROC _p_remove far
push bp
mov bp,sp
push word ptr [bp+12]
push word ptr [bp+10]
push word ptr [bp+8]
push word ptr [bp+6]
call _pp_remove
mov sp,bp
push dx
push ax
call _MEM_SaveStringGStack
mov sp,bp
les bx,dword ptr [bp+14]
mov word ptr es:[bx+2],dx
mov word ptr es:[bx],ax
pop bp
ret
ENDP _p_remove
; *********************************************************************
; p_rename(STRING,STRING,STRING) -(i,i,o) language c
; ==================================================
public _p_rename
PROC _p_rename far
push bp
mov bp,sp
push word ptr [bp+12]
push word ptr [bp+10]
push word ptr [bp+8]
push word ptr [bp+6]
call _pp_rename
mov sp,bp
push dx
push ax
call _MEM_SaveStringGStack
mov sp,bp
les bx,dword ptr [bp+14]
mov word ptr es:[bx+2],dx
mov word ptr es:[bx],ax
pop bp
ret
ENDP _p_rename
; *********************************************************************
; p_delval(STRING,STRING,STRING) -(i,i,o) language c
; ==================================================
public _p_delval
PROC _p_delval far
push bp
mov bp,sp
push word ptr [bp+12]
push word ptr [bp+10]
push word ptr [bp+8]
push word ptr [bp+6]
call _pp_delval
mov sp,bp
push dx
push ax
call _MEM_SaveStringGStack
mov sp,bp
les bx,dword ptr [bp+14]
mov word ptr es:[bx+2],dx
mov word ptr es:[bx],ax
pop bp
ret
ENDP _p_delval
public _sdsinitx
PROC _sdsinitx far
ARG string1:dword, outSepCh:dword, lengthx:dword
push bp ;
mov bp,sp ;
push si ;
push ds ;preserve C's standard data seg
; =======================
cld ;forwards
les di,dword ptr [string1] ;................ARG-1
; =======================================
ALIGN 2 ;
xor cx,cx ;
mov al,cl ;
not cx ;
repne scasb ;find end of ARG-1 (ascii 0)
not cx ;now CX=length of ARG-1
push cx ;store length in the stack
dec di ;go back to ascii-0
dec di ;go back to last_char of string
mov al,byte ptr ES:[DI] ;SepCHAR = last_char_of_String
dec di ;one more char backwards
dec cx ;
dec cx ;
; ===============================
std ;backwards
xor dx,dx ;clear dx, as substring_counter
; -------------------------------
@@1: repne scasb ;find next_previous_Separator-Character AL
jcxz @@X1 ;if exhausted, exit
inc dx ;increment substring_counter
jmp short @@1 ;
; ===============================
@@X1: ;
pop cx ;recover length from the stack
cld ;restore forward flag
lds si,[outSepCh] ;
mov [si],al ;SepCHARoutput...................ARG-2(o)
lds si,[lengthx] ;
mov [si],cx ;LengthOfString..................ARG-3(o)
mov ax,dx ;return number of substrings found
cld ;restore forward flag
; ===============================
@XX: pop ds ;restore C's standard data seg
pop si ;
pop bp
ret
ENDP _sdsinitx
END ;*/
ifndef include_defs
CONSTANTS
test_p_unify = 1
GLOBAL PREDICATES
STRING p_strx(byte) -(i) language c %ARG1=0 gives _p_ctb, 1 gives _p_512
STRING pp_sort(STRING) -(i) language c
% OUT_p_512 <- (PairSTRi)
STRING pp_attrib(STRING) -(i) language c
% attrib_bytes <- (pairstring)
STRING pp_values(STRING) -(i) language c
% value_bytes <- (pairstring)
STRING pp_unifyx(STRING,STRING) -(i,i) language c
% OUT_p_512 <- (PairSTR1i,PairSTR2i)
STRING pp_remove(STRING,STRING) -(i,i) language c
% OUT_p_512 <- (PairSTR1i,PairSTR2i)
p_unifyx(STRING,STRING,STRING) -(i,i,o) language c
p_select(STRING,STRING,STRING) -(i,i,o) language c
p_remove(STRING,STRING,STRING) -(i,i,o) language c
p_rename(STRING,STRING,STRING) -(i,i,o) language c
p_delval(STRING,STRING,STRING) -(i,i,o) language c
include ".\\AUXPREDS.INC"
PREDICATES
do_p_unify(INTEGER)
GOAL
do_p_unify(1).
enddef
CLAUSES
do_p_unify(1):- clearwindow, attribute(A), rep, attribute(79),
write("PairString Unification & related predicates:\n"),
attribute(31), write("Now testing 'p_unify/3':\n"), attribute(14),
write("Give FIRST PairSTRING:> "), unread_str("X9e5b2d4A1f6"),
attribute(15), readln(PS1), attribute(14),
write("Give SECOND PairSTRING:> "), unread_str("c3A1f?X?h0"),
attribute(15), readln(PS2), p_unifyx(PS1,PS2,Sx),
write("\nSx=\"",Sx,"\"\n"), pkey, getbacktrack(LP2), rep,
attribute(79), write("PairString Unification & related preds:\n"),
attribute(30), write("Now testing 'p_select/3':\n"),
attribute(14), write("Give a pairstring(AEG2):> "),
unread_str(Sx), attribute(15), readln(Sx1), attribute(14),
write("\nNow give a selection:> "), unread_str("A?c3h0"),
attribute(15), readln(SEL), p_select(SEL,Sx1,Sx2), attribute(13),
write("\nSx2=\"",Sx2,"\"\n"), nl, pkey, cutbacktrack(LP2),
getbacktrack(LP3), rep, attribute(79),
write("PairString Unification and related predicates:\n"),
attribute(14), write("\n\nOK, now testing 'p_remove/3':\n"),
write("Now give a pairstring(AEG2):> "), unread_str(Sx2),
attribute(15), readln(Sx3), attribute(14),
write("Now give a remove-list:> "), unread_str("A?h0"),
attribute(15), readln(DEL), p_remove(DEL,Sx3,Sx4),
write("\nSx4=\"",Sx4,"\"\n"), nl, pkey, cutbacktrack(LP3),
getbacktrack(LP4), rep, attribute(79),
write("PairString Unification and related predicates:\n"),
attribute(13), write("\nFinally testing 'p_rename/3':\n"),
write("Now give a pairstring(AEG2):> "), unread_str("a1b2c3"),
attribute(15), readln(Sx5), attribute(14),
write("Now give a rename-list:> "), unread_str("aAbBcCxy"),
attribute(15), readln(RNM), p_rename(RNM,Sx5,Sx6),
write("\nSx6=\"",Sx6,"\"\n"), pkey, cutbacktrack(LP4),
attribute(A), xkey, !.
/**********************************************************************
This code is Public Domain; distribute freely but please keep it intact.
Last Update: January 1998.(16-bit version; sorry no 32-bit version yet;
write to me if you would like a 32-bit version and I might do it! :) )
Company: HyperLOGIC R&D, Athens, Greece. (now closed due to heavy taxation
combined with unpunished software theft -of our products by others)
Author: George A. Stathis (c). E-mail: <omadeon@hotmail.com>.
Home Page: <http://www.geocities.com/omadeon>.
More source-code on the Web:
<http://www.geocities.com/omadeon/gs_sourcecode.html>
* All E-mail with modifications/suggestions/code-applications welcome *
**********************************************************************//
Back to ASM-Library Index Author's
home page