Oakland CPM Archive/oakcpm.iso/sigm/vol167/mkv86.a86

Text File | 1984-04-29 | 18.9 KB | 624 lines

;    =======================================================
;
;
;    Module composed of workspace operators for REC/MARKOV.
;    These are specialized subroutines for manipulating a
;    "workspace,"  which is an array together with five
;    pointers.  The workspace will probably (but not always)
;    hold text, subdivisions of which are marked off by the
;    pointers.  They in turn are:
;
;        p0  the beginning of both space and text
;        p1  the beginning of a specific segment
;        p2  the end of a specific segment
;        p3  the end of the entire text
;        p4  the physical end of the available space
;
;    The uniform method to designate intervals is that the
;    beginning is inclusive, while the end is exclusive.  In
;    that way a null interval can be represented through two
;    equal pointers.  The workspace operators and predicates
;    move data around and compare it with the help of these
;    pointers.  Other operators move data between the work-
;    space and the pushdown list.
;
;    The complete list of operators and predicates is:
;
;        A    advance pointer 1 if possible
;        B    retract pointer 1 if possible
;        D    delete interval between p1 and p2
;        E    test equality between workspace and PDL
;        F    find a specified segment in the workspace
;        I    insert in the workspacve following p2
;        J    move p1 to beginning
;        M    test workspace for lexicographically larger
;        Q    move interval between p1 and p2 to PDL
;        U    find segment between delimiters
;        V    find segment including delimiters
;        Y   restore pointer 1 to previous value
;        Z    move p2 to end
;        a    extend interval from p1 if possible
;        b    extend interval to p2 if possiblle
;        e    extend limit of text if possible
;        f    fill if space is available
;        h    fetch workspace header for PDL
;        j    null interval at front of segment
;        q    place p1, p2-p1 on PDL
;        w    store (or possibly exchange) workspace header
;        z    null interval at end of segment
;        <    restrict workspace to segment p1-p2
;        >    open workspace to previous span
;
;    Version released during the Summer School, 1980.
;
;          MKV86 - Copyright (C) 1980
;        Universidad Autonoma de Puebla
;             All Rights Reserved
;
;         [Harold V. McIntosh, 25 April 1982]
;
;    May 1, 1982 - M tests for an interval rather than making
;        a simple comparison.  <a,'',M> should be used
;        where <a,M> was formerly written.  In general,
;        <a,b,M> tests for a .LE. WS .LE. b and leaves
;        P1 and P2 surrounding such a segment.  Both a
;        and b are always lifted.
;    May 29, 1983 - h discontinued; use ''w instead
;    =======================================================

;    =======================================================
;    Workspace subroutines for REC/MARKOV.
;    =======================================================

;    (a)  Generate a segment of length n forward from p1 if
;    possible.  A predicate which, when FALSE, leaves the
;    deficit by which the segment could not be formed on the
;    pushdown list.

LCA:    call    CXLD        ;load n into (cx)
    add    cx,P1
    cmp    P3,cx
    jb    LAF
    mov    P2,cx
    jmp    SKP        ;return with the value TRUE
LAF:    sub    cx,P3
    push    cx        ;argument to putw must be on 8080 stack
    call    PUTW        ;record deficit
    ret            ;FALSE return: <jmp putw> won't do

;    (A)  Pointer 1 advances by one byte, if possible.

UCA:    mov    ax,P1        ;fetch pointer 1
    inc    ax        ;advance by 1
    cmp    P3,ax
    jb    UAF        ;forget it, return FALSE if past limit
    mov    P1,ax        ;we can safely store pointer 1
    cmp    P2,ax        ;but it still must not pass pointer 2
    jnb    UA2        ;but it still must not pass pointer 2
    mov    P2,ax        ;if it did, pointer 2 = pointer 1
UA2:    jmp    SKP        ;but in either event, return TRUE
UAF:    ret

;    (b)  Generate a segment of length n backward from p2,
;    if possible.

LCB:    call    CXLD        ;load top argument into (cx), erase it
    mov    ax,P2        ;fetch pointer 2 into (HL)
    sub    ax,cx        ;calculate difference
    cmp    ax,P0
    jb    LBF        ;low limit passed, abandon the attempt
    mov    P1,ax        ;record it
    jmp    SKP        ;generate TRUE return for the predicate
LBF:    ret

;    (B)  Pointer 1 retreats by one byte, if possible.

UCB:    mov    ax,P1        ;fetch pointer
    dec    ax        ;move backwards one byte
    cmp    ax,P0        ;
    jb    UBF
    mov    P1,ax        ;otherwise store new position
    jmp    SKP        ;and return with value TRUE
UBF:    ret            ;return false as NOP if passed

;    (D) Delete text between pointers 1 and 2.

UCD:    mov    si,P2        ;fetch end of deleted text
    mov    di,P1        ;fetch beginning of deleted text
    cmp    si,di
    jz    UD2        ;null interval to delete
    mov    P2,di        ;after deletion, interval is null
    mov    cx,P3
    sub    cx,si        ;length of string to move
    jz    UD1
    cld
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
UD1:    mov    P3,di        ;destination limit is new end of text
UD2:    ret

;    (e)  Attempt to move pointer 3 forward. If insufficient
;    space remains, this predicate is false and places the
;    amount of remaining space [p4-p3] on the pushdown list.
;    If the extension is possible, P1 and P2 will surround it.

LCE:    call    CXLD        ;load argument into (cx), pop it
    add    cx,P3
    cmp    P4,cx
    jb    LEF        ;skip if increment not greater
    mov    ax,P3
    mov    P2,cx
    mov    P3,cx
    mov    P1,ax        ;make it the beginning of new interval
    jmp    SKP        ;TRUE return
LEF:    sub    cx,P4
    push    cx        ;putw requires argument on 8080 stack
    call    PUTW        ;insert balance on pushdown list
    ret            ;TRUE return: <jmp putw> won't work

;    (E) Check equality between the pushdown list and the
;    workspace.  The top argument will be erased whatever
;    the outcome of the test, a characteristic common to
;    E, F, M, U, and V.  If there is a segment originating
;    at p1 which is equal to the argument, p2 will move to
;    delimit it, otherwise p2 remains unchanged.

UCE:    mov    cx,PY        ;end of top argument
    mov    si,PX        ;beginning of top argument
    mov    di,P1        ;beginning of workspace segment in (HL)
    sub    cx,si
    jcxz    UEN        ;''E is TRUE, sets P2=P1
    cld
    mov    ax,ds
    mov    es,ax
    repz    cmps    byte [di],[si]
    jnz    UEF        ;mismatch terminated scan
    cmp    P3,di        ;see whether we've run over
    jb    UEF
UEN:    mov    P2,di
    jmp    CUCL        ;skip for TRUE
UEF:    jmp    UCL        ;FALSE for one reason or another

;    (f)  Fill. <'XXX' f> will replace the text following
;    pointer 1 by XXX if pointer 2 does not conflict,
;    whereupon pointers 1 and 2 delimit what remains of
;    the interval they originally encompassed, making this
;    predicate TRUE.  Otherwise it will be FALSE, with the
;    pointers unaltered.  When f fails, its argument is
;    erased, otherwise the insert is conserved for repeated
;    use in a block fill.  f is true even if its argument
;    completely fills the available space, since it reports
;    whether or not an insertion took place rather than
;    whether any space remains.

LCF:    mov    si,PX
    mov    cx,PY
    sub    cx,si
    mov    di,P1        ;load p2
    mov    dx,P2        ;now load p1
    sub    dx,di
    cmp    dx,cx        ;compare this to p2
    jnb    LFT
    jmp    UCL        ;insert too big, FALSE and erase insert
LFT:    cld
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    mov    P1,di        ;final destination location is new p1
    jmp    SKP        ;keep insert, generate TRUE return

;    (F)  Search for text.  The text in the workspace is
;    examined from left to right beginning at pointer 1 to
;    see if the object of comparison on the pushdown list
;    can be found.  If so, its replica in the workspace is
;    bracketed by pointers 1 and 2, while the model itself
;    is discarded.  Even if no replica is found, the model
;    is still discarded, but then the value is FALSE and the
;    pointers 1 and 2 retain their original sites.  Should
;    several replicas exist, only the first is taken; if
;    consecutive searches for the same object are made, the
;    same replica will be found repeatedly.  This permits
;    nested fragments of the same object to be found on
;    successive searches, but requires an intermediate
;    collapse of the interval p1-p2 in favor of p2 [say by
;    using ''I] to scan multiple occurrences of the same
;    object.

UCF:    mov    dx,PY
    mov    bx,PX
    mov    di,P1
    sub    dx,bx        ;length of comparison object
    jz    UFX        ;fast exit for null object
    mov    cx,P3
    sub    cx,di        ;length of search field
    cmp    cx,dx
    jb    UFF        ;useless to even try
    cld            ;searches go forward
    mov    ax,ds
    mov    es,ax        ;CP/M might derange ES
    dec    dx
    jz    UFS        ;look for single byte
UF1:    mov    si,bx
    lods    byte [si]
    repnz    scas    byte [di]            ;search by increment until limit
    jnz    UFF        ;end without even 1st word
    cmp    cx,dx        ;are there enough chars left
    jb    UFF        ;can't possibly fit it in
    push    cx
    push    di
    mov    cx,dx
    repz    cmps    byte [di],[si]
    jz    UFT
    pop    di        ;comparison failed
    pop    cx
    jmp    UF1        ;go on where we left off
UFT:    pop    ax        ;comparison accomplished
    pop    cx
UFV:    dec    ax
    mov    P1,ax
UFX:    mov    p2,di
    jmp    CUCL
UFS:    mov    al,[bx]
    repnz    scas    byte [di]
    jnz    UFF
    mov    ax,di
    jmp    UFV
UFF:    jmp    UCL

;    (I)  Insert text following pointer 2; upon completion
;    pointers bracket inserted material.  If the proposed
;    insertion will not fit, an error indicator is generated
;    and the attempt is abandoned.  An F followed by an I
;    will insert material after the found text, but if an
;    intermediate ''F is given, insertion will be made at
;    the front of the text.  A ''I may be used to form null
;    intervals, if they are desired at the end of a segment.

UCI:    mov    ax,P2        ;point where insertion will be made
    mov    P1,ax        ;pointer 1 to precede inserted material
    mov    dx,PY        ;source origin
    sub    dx,PX        ;source end
    jz    UIN        ;null insert
    mov    si,P3
    mov    cx,P4
    sub    cx,si
    cmp    cx,dx
    jb    UIE        ;insufficient space for insert
    mov    cx,si
    sub    cx,P2
    add    P2,dx
    add    P3,dx
    mov    ax,ds
    mov    es,ax
    jcxz    UIA
    mov    di,P3
    dec    si
    dec    di
    std
    repnz    movs    byte [di],[si]
UIA:    mov    cx,dx
    mov    si,PX        ;source origin into (DE)
    mov    di,P1        ;new p1 is destination origin, in (HL)
    cld
    repnz    movs    byte [di],[si]
UIN:    jmp    UCL        ;I removes its argument upon completion
UIE:    call    RER

;    (j)  Null interval at p1.  Equivalent to ''F or ''E.

LCJ:    mov    ax,P1        ;pointer to beginning of interval
    mov    P2,ax        ;make end of interval the same
    ret

;    (J) Back to beginning of workspace.  Extends whatsoever
;     interval back to the beginning of the entire text.

UCJ:    mov    ax,P0        ;fetch pointer to beginning of text
    mov    P1,ax        ;make it the beginning of the interval
    ret

;    (M)  Compare inequality between the pushdown list and
;    the workspace.  M is TRUE if there is a segment in the
;    workspace beginning at p1 which is lexicographically
;    larger than the argument on the pushdown list.  In that
;    event, p2 marks the "larger" interval, which terminates
;    after the first byte in the workspace which is larger -
;    by unsigned integer comparison - than the argument.  M
;    is also TRUE if an equal segment lies in the workspace.
;    According to the common style of E, F, I, M, U, and V,
;    the argument is erased whatever might be the outcome of
;    the comparison.  Likewise, FALSE results in no pointer
;    changes.

UCM:    mov    cx,PY
    mov    si,PX
    sub    cx,si
    push    cx
    push    si
    call    UCL
    mov    cx,PY        ;pointer to argument to be compared
    mov    si,PX        ;pointer to workspace under comparison
    sub    cx,si
    call    UCL
    mov    bp,P1
    jcxz    UMT        ;trivial comparison to be made
    cld
    mov    ax,ds
    mov    es,ax
    mov    di,bp
UML:    cmps    byte [di],[si]            ;(SI) - (DI) sets flags
    jb    UMM        ;decided if WS > PD
    jnz    UMF        ;failure if WS < PD
    loop    UML        ;repeat for WS = PD
UMM:    xchg    di,bp
    cmp    P3,bp
    jb    UMF        ;fail if we run over
    pop    si
    pop    cx
    jcxz    UMT        ;treat '' as 'no comparison'
    mov    ax,cx
    mov    cx,bp
    sub    cx,di
    cmp    ax,cx        ;set flags by l(PD) - l(WS)
    sbb    dx,dx        ;(nc) when l(WS) .LE. l(PD)
    jz    UMN        ;(z): workspace is shorter, equal
    xchg    ax,cx        ;check only common segment
UMN:    cmps    byte [di],[si]            ;set flags from PD - WS
    jb    UMG        ;WS > PD means outside inclusive bound
    jnz    UMT        ;WS < PD means bound is satisfied
    loop    UMN        ;WS = PD means keep testing
    or    dx,dx
    jnz    UMG        ;(z): workspace fulfils 'short before long'
UMT:    mov    P2,bp
    jmp    SKP
UMF:    add    sp,4
UMG:    ret

;    (q)  Put p1, p2-p1 on PDL.

LCQ:    mov    ax,P2
    sub    ax,P1
    push    ax        ;stash P2-P1 on 8086's PDK
    push    P1        ;and then P1 on top of that
    call    PUTW        ;one argument from top of 8080 stack
    call    PUTW        ;then another so we've got both
    ret            ;cannot use jmp putw for call putw, ret

;    (Q)  Copy workspace to pushdown.  The interval between
;    p1 and p2 is placed on the pushdown list.

UCQ:    mov    si,P1        ;fetch beginning of interval
    mov    cx,P2        ;fetch end of interval
    sub    cx,si        ;length of interval into (cx)
    call    NARG        ;close old arg, check space, def new
    mov    di,PX        ;fetch destination origin for (HL)
    cld
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    mov    PY,di        ;destination end is argument end
    ret

;    (w)  Store workspace header.  There are two forms of
;    this operator which are available: the argument may be
;    either a single block of ten bytes, or else the pair
;    <org, siz>.  The distinction is implicit, according to
;    whether the top argument has two bytes or ten bytes.
;    The first case arises from a previous usage of h (or
;    perhaps deliberate construction), while the second is
;    more likely in the initial allocation of a workspace. A
;    single block is erased after use, while it is supposed
;    that a previous definition existed when the pair form
;    is used.  In such a case, the old block of bytes would
;    be substituted for the two arguments in case it needed
;    to be restored later.  When a workspace is generated
;    from its specifications, pointers 1 and 2 as well as 3
;    are set to encompass the entire space. Many other forms
;    can be arranged by a subsequent use of j, D, and so on.

LCW:    mov    si,PX
    mov    cx,PY
    sub    cx,si        ;determine size of argument
    cmp    cx,10        ;ten for comparison
    jnz    LWW        ;if length not 10, suppose it was 2
    cmp    cx,0
    jnz    LWX
    call    UCL
LWH:    mov    cx,10        ;10 bytes required from PDL
    call    NARG        ;verify space, new px into (HL)
    mov    si,(offset P0)        ;source is pointer block itself
    cld
    mov    di,bx
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    mov    PY,di        ;final destination is arg end
    ret
LWX:    mov    di,(offset P0)        ;p0 is destination origin
    cld
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    jmp    UCL        ;erase the argument
LWW:    mov    bx,PX        ;create p0...p4 from org,siz
    call    TWOL        ;trnsfr two args from PDL to 8080 stack
    call    LWH        ;place existing header on PDL
    pop    bx        ;recover under arg, namely org
    pop    cx        ;recover upper arg, namely siz
    mov    P0,bx        ;origin of workspace
    mov    P1,bx        ;segment at front of workspace
    add    bx,cx        ;add size
    mov    P2,bx        ;segment traverses whole workspace
    mov    P3,bx        ;which defines end of occupied text
    mov    P4,bx        ;as well as physical end
    ret

;    (U)  Search for interval, excluding limits.  The object
;    of the search is defined by its delimiters: thus if the
;    text YYY is to be found, it must be specified as the
;    one sandwiched between XXX and ZZZ.  Then by executing
;    'XXX'F followed by 'ZZZ'U pointers 1 and 2 will bracket
;    YYY.  U erases its argument, whether TRUE or FALSE, by
;    a custom common to all search or comparison predicates.
;    By the same custom, pointers 1 and 2 remain unmoved if
;    the search fails. ''U generates a null interval at the
;    end of the last interval that was created.

UCU:    push    P1        ;fetch beginning of last interval
    mov    ax,P2        ;fetch end of last interval
    mov    P1,ax        ;search begins at end of p1-p2 interval
    push    ax
    call    UCF        ;use the search subroutine
    jmp    UUF        ;search failed [MUST be 3-byte jmp] <===
    mov    ax,P1        ;beginning of found interval
    mov    P2,ax        ;is end of result interval
    pop    P1        ;recover end of last interval
    pop    ax        ;discard beginning of last interval
    jmp    SKP        ;TRUE return from predicate
UUF:    pop    ax        ;discard end of last interval-it's same
    pop    P1        ;recover beginning of last interval
    ret            ;FALSE return from predicate

;    (V)  Search for interval, including limits.  This
;    predicate is similar to U, the difference being that
;    after a successful search, p1 and p2 bracket both the
;    delimiters as well as the text which they define,
;    whereas U merely brackets the intervening text.

UCV:    push    P1        ;pointer to beginning of last interval
    mov    ax,P2
    mov    P1,ax        ;pointer to end of last interval
    call    UCF        ;predicate F always makes the search
    jmp    UVF        ;search failed, F was FALSE
    pop    P1        ;recover the old p1
    jmp    SKP        ;TRUE return with old p1, new p2
UVF:    pop    P1        ;recover original p1
    ret            ;FALSE return with p1 and p2 unchanged

;    (Y)  Recover pointer 1.  There are those times when it
;    is desirable to note a spot in the workspace, through
;    qL for example, and then be able to return to it later
;    on.  However intervening deletions, insertions or even
;    workspace openings and closings may have rendered it
;    invalid so a check is made to ensure the preservation
;    of the relative order of p0, p1, and p3.  If p2 lies
;    in an acceptable range, it is untouched; otherwise it
;    is set to define a null interval at p1.

UCY:    mov    bx,PX
    mov    cx,PY
    sub    cx,bx
    cmp    cx,4
    jz    UYI
    mov    bx,[bx]        ;fetch low byte of pointer
    cmp    bx,P0        ;check that p1 will be greater or equal
    jnb    UYM        ;if less, store p0 instead
    mov    bx,P0
    jmp    UYZ
UYM:    cmp    P3,bx        ;check that p1 will be less or equal
    jnb    UYN        ;if not, make p2 = p1 = p3
    mov    bx,P3
    jmp    UYY
UYN:    cmp    P2,bx        ;check that p1 less or equal to p2
    jnb    UYZ
UYY:    mov    P2,bx        ;record null interval between p1 and p2
UYZ:    mov    P1,bx        ;give p1 whatever value it'll have
    jmp    CUCL        ;pop the argument
UYI:    mov    cx,[bx]
    mov    bx,2[bx]
    cmp    cx,P0
    jb    UYF
    add    bx,cx
    cmp    P3,bx
    jb    UYF
    mov    P1,cx
    mov    P2,bx
    jmp    CUCL
UYF:    jmp    UCL

;    (z)  Null interval at end of segment.  Equivalent to
;    ''I, ''U, or 0b.

LCZ:    mov    ax,P2        ;pointer to end of interval
    mov    P1,ax        ;make beginning of interval the same
    ret

;    (Z)  Move p2 to the end of the workspace, thereby
;    extending whatever interval on to the end of the text.

UCZ:    mov    ax,P3        ;pointer to the end of text
    mov    P2,ax        ;make end of interval the same
    ret

;    (<)  Close down workspace. The workspace is confined to
;    the interval between pointers 1 and 2.  The reason for
;    this could be to restrict the editing operations to a
;    smaller range, or it could be to have absolute freedom
;    to work over some material before incorporating it into
;    the main text.  As a practical matter, the text between
;    pointers 2 and 3 is displaced to the far end of the
;    workspace and the original values of pointers 0 and 4
;    are recorded before setting up the new values of the
;    pointers. Subsequent insertions and deletions then have
;    much less material to move.

BRA:    mov    di,P4
    mov    si,P3
    mov    cx,di
    sub    cx,si
    sub    cx,4
    jb    BRE
    mov    cx,si
    sub    cx,P2
    dec    di
    dec    si
    std
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    dec    di
    mov    ax,P4
    stos    word [di]
    mov    P4,di
    mov    ax,P0
    stos    word [di]
    mov    ax,P2
    mov    P3,ax
    mov    ax,P1
    mov    P0,ax        ;store it as new beginning of text
    ret            ;p2 remains at end of newly made text
BRE:    call    RER

;    (>)  Open up the workspace.  This is the complementary
;    operator to <, which is used to return the scope of the
;    pointers p0 and p4 to their original range.  The text
;    forming the restricted workspace is incorporated in its
;    entirity in place of the material originally lying in
;    the interval p1-p2.  An error condition can arise from
;    opening a workspace that was never closed, but it will
;    be anulled if a zero address was placed at the pointer
;    4 during initialization of the workspace.

KET:    mov    bx,P4        ;load the end of the universe
    mov    cx,[bx]
    jcxz    KEE        ;zero means opening too many times
    mov    P0,cx        ;restore it
    mov    cx,2[bx]
    mov    P4,cx
    add    bx,4
    sub    cx,bx
    mov    si,bx
    mov    di,P3        ;end of txt is dest to replace old tail
    cld
    mov    ax,ds
    mov    es,ax
    repnz    movs    byte [di],[si]
    mov    P3,di        ;destination end is new end of text
    ret
KEE:    call    RER        ;note error and abandon attempt

    END