Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / sigm / vol164 / mkv80.mac < prev next >

Wrap

Text File | 1984-04-29 | 29.8 KB | 900 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 an interval ; 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 ; 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. ; ; MKV80 - Copyright (C) 1980 ; Universidad Autonoma de Puebla ; All Rights Reserved ; ; [Harold V. McIntosh, 28 August 1980] ; ; May 20, 1983 - M modified to test interval membership ; May 20, 1983 - h suppressed, ''w replaces it ; ======================================================= ; Entry points to locations in RAM storage, which will be ; found in the module FXT. ext p0,p1,p2,p3,p4 ext px,py,pz,pt ; Entry points to programs in the REC nucleus, which will ; be found in the module REC. ext ucl,cucl ext psiz,siz,narg,oarg ext sng,sing,skp,seq ext req,rer,rr2 ext miuc,mduc ; Entry points in the module PDL. ext onel,twol,thrl,bcld ext putw ; ======================================================= ; Further auxiliary subroutines pertinent to REC/MARKOV. ; ======================================================= ; Move by increment until source limit. miul:: mov a,c ;compare low bytes cmp e ; jnz mil ;disagreement so continue mov a,b ;compare high bytes cmp d ; rz ;agreement so limit was reached mil: ldax d ;fetch source mov m,a ;store in destination inx d ;advance source pointer inx h ;advance destination pointer jmp miul ;repeat ; Move by decrement until source limit. mdul:: mov a,c ;compare low bytes cmp e ; jnz mdl ;disagreement so continue mov a,b ;compare high bytes cmp d ; rz ;limit was reached so we're through mdl: dcx d ;retract source pointer dcx h ;retract destination pointer ldax d ;fetch source byte mov m,a ;place in destination jmp mdul ;repeat ; Compare by increment until limit. On entry, (BC) holds ; the limit, (DE) points to the principal chain, and (HL) ; points to the secondary chain. On exit, (BC) remains ; unchanged, while (DE) and (HL) either point to where ; the discrepancy occurred if the chains were not equal, ; or the byte beyond the chains when they are equal. ; This latter is the REC convention to indicate segments. ; Return is to the calling sequence for a mismatch, or ; through a three byte skip when the chains match, which ; is also the REC convention. ciul: mov a,c ;get the low byte of the limit cmp e ;compare to low byte of principal jnz cil ;doesn't match so keep comparing mov a,b ;now get high byte of limit cmp d ;to compare to high byte of principal jz skp ;limit reached so leave pointers, skip cil: ldax d ;fetch byte in principal string cmp m ;compare to byte in secondary string rnz ;no match: keep pointers, go right back inx d ;advance principal inx h ;advance secondary jmp ciul ;ready for the next go around ; Search by increment until limit. On entry, (BC) holds ; a limit, (DE) the reference pointer which indicates the ; byte to be found and which does not change, while (HL) ; holds the variable pointer which steps along a chain. ; On exit, (BC) and (DE) are unchanged, leaving (HL) to ; point either to the matching byte [TRUE] or just beyond ; the searched chain [FALSE]. According to the REC norms, ; a TRUE result generates a skip, while a FALSE result ; produces an immediate return to the calling point. ; It would be more efficient to load the reference byte ; rather than point to it, but this form serves as an ; inner loop to a program which prefers to modify (DE). siul: mov a,c ;fetch low byte of limit cmp l ;compare to low byte of pointer jnz sil ;mismatch so limit can't have arrived mov a,b ;high byte of limit cmp h ;versus high byte of pointer rz ;equal: byte wasn't found, false sil: ldax d ;load the reference byte cmp m ;compare to the string jz skp ;they match, leave the pointer, skip inx h ;go on to next byte jmp siul ;and repeat the cycle ; And by increment until count. On entry, (BC) holds the ; count, (DE) points to the beginning of an array which ; will not be modified [source], and (HL) points to the ; beginning of an array which will be modified by ANDing ; it bytewise with the first [destination]. On exit, the ; count will be zero while the pointers will lie at the ; ends of their ranges. aiuc:: mov a,c ;fetch low byte of count ora b ;superimpose high byte rz ;return when count reaches zero ldax d ;fetch unchanging participant ana m ;AND with the alterable participant mov m,a ;store the result of the encounter inx h ;increment ANDed pointer inx d ;increment ANDing pointer dcx b ;decrement count jmp aiuc ;repeat cycle ; Or by increment until count. oiuc:: mov a,c ;fetch low byte of count ora b ;superimpose high byte rz ;quit whenever count is zero ldax d ;fetch unchanging participant ora m ;OR with the alterable participant mov m,a ;store the result inx h ;increment pointer to ORed byte inx d ;increment pointer to ORing byte dcx b ;decrement counter jmp oiuc ;repeat cycle ; Exclusive Or by increment until count. xiuc:: mov a,c ;fetch low byte of count ora b ;superimpose high byte rz ;return when count reaches zero ldax d ;fetch unchanging participant xra m ;XOR with the alterable participant mov m,a ;store the result inx h ;increment pointer to XORed byte inx d ;increment pointer to XORing byte dcx b ;decrement counter jmp xiuc ;repeat cycle ; Complement by increment until count. kiuc:: mov a,c ;fetch low byte of count ora b ;superimpose high byte rz ;return when count reaches zero mov a,m ;fetch operand cma ;complement it mov m,a ;return it to memory inx h ;advance pointer to operand dcx b ;diminish count jmp kiuc ;repeat cycle ; ======================================================= ; 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 bcld ;load n into (BC) lhld p3 ;p3 is the limit for the segment xchg ;place it in register (DE) lhld p1 ;we want to advance pointer 1 call sing ;skip if increment not greater jmp lcaf ;insufficient space, calculate deficit shld p2 ;give p2 the incremented value jmp skp ;return with the value TRUE lcaf: mov a,l ;low byte of p1+n sub e ;low byte of limit mov c,a ;low byte of deficit mov a,h ;high byte of p1+n sbb d ;high byte of limit mov b,a ;high byte of deficit push b ;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:: lhld p1 ;fetch pointer 1 inx h ;advance by 1 xchg ;and set it aside lhld p3 ;fetch limit mov a,l ;compare low bytes sub e ; mov a,h ;and then high bytes sbb d ; rc ;forget it, return FALSE if past limit lhld p2 ;fetch pointer 2 xchg ;and swap with pointer 1 shld p1 ;we can safely store pointer 1 call sng ;but it still must not pass pointer 2 shld p2 ;if it did, pointer 2 = pointer 1 jmp skp ;but in either event, return TRUE ; (b) Generate a segment of length n backward from p2, ; if possible. lcb:: call bcld ;load top argument into (BC), erase it lhld p2 ;fetch pointer 2 into (HL) mov a,l ;calculate low order byte of difference sub c ;by subtracting the displacement mov e,a ;and storing it in register E mov a,h ;then high order byte of difference sbb b ;which must consider a possible borrow mov d,a ;and then goes into regisger D lhld p0 ;now get the beginning of the workspace mov a,e ;get ready to compare to new p1 sub l ;first the low byte mov a,d ;then the high byte sbb h ;likewise requiring the carry bit rc ;low limit passed, abandon the attempt xchg ;otherwise move new p1 into (HL) shld p1 ;record it jmp skp ;generate TRUE return for the predicate ; (B) Pointer 1 retreats by one byte, if possible. ucb:: lhld p0 ;fetch left limit xchg ;place in registers (DE) lhld p1 ;fetch pointer dcx h ;move backwards one byte mov a,l ;compare low bytes for limit sub e ; mov a,h ;compare high bytes for limit sbb d ; rc ;return false as NOP if passed shld p1 ;otherwise store new position jmp skp ;and return with value TRUE ; Delete text between pointers 1 and 2. ucd:: lhld p2 ;fetch end of deleted text xchg ;put it in (DE) lhld p1 ;fetch beginning of deleted text call req ;return if interval is null shld p2 ;after deletion, interval is null lhld p3 ;end of text mov c,l ;place in (BC) as source limit mov b,h ; lhld p1 ;beginning of interval is destination call miul ;close interval by a block move shld p3 ;destination limit is new end of text 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. lce:: call bcld ;load argument into BC, pop it lhld p4 ;fetch p4, which is physical limit xchg ;move it to register (DE) lhld p3 ;end of text, which we want to extend call sing ;skip if increment not greater jmp lcef ;insufficient space: calculate balance xchg ;put extended value of p3 aside lhld p3 ;fetch the previous end of text shld p1 ;make it the beginning of new interval xchg ;now we are ready to use the new p3 shld p2 ;p1-p2 comprises the whole extension shld p3 ;record the extended value of p3 jmp skp ;TRUE return lcef: lhld p3 ;to calculate p4-p3 we need p3 mov a,e ;low byte of p4 sub l ;low byte of p3 mov c,a ;low byte of balance mov a,d ;high byte of p4 sbb h ;high byte of p3 mov b,a ;high byte of balance push b ;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:: lhld py ;end of top argument mov b,h ;move it to (BC) mov c,l ; lhld px ;beginning of top argument xchg ;move it to (DE) lhld p1 ;beginning of workspace segment in (HL) call ciul ;subroutine making actual comparison jmp ucl ;comparison failed, lift argument, quit xchg ;end of matching segment to (DE) lhld p3 ;end of valid text mov a,l ;see whether we've run over sub e ;compare low bytes mov a,h ; sbb d ;compare high bytes jc ucl ;failed by running over xchg ;put end of segment in (HL) shld p2 ;it becomes the new p2 jmp cucl ;erase argument anyway, skip for TRUE ; (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:: call psiz ;determine length of insert lhld p2 ;load p2 xchg ;place it in register (DE) lhld p1 ;now load p1 dad b ;add the length of the insert to it mov a,e ;compare this to p2 sub l ;begin with the low byte mov a,d ;then compare high bytes sbb h ; jc ucl ;insert too big, FALSE and erase insert lhld px ;get insert origin xchg ;place it in register (DE) lhld p1 ;load destination origin call miuc ;call block move until count shld p1 ;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:: lhld px ;beginning of object of search xchg ;place pointer in (DE) lhld py ;end of object of search into (HL) call seq ;skip if equal jmp uf1 ;continuation if object is non-null lhld p1 ;beginning of null workspace interval shld p2 ;record it as end of a null interval jmp cucl ;pop argument, TRUE return uf1: lhld p3 ;fetch address of end of text mov b,h ;move it to (BC) mov c,l ; lhld p1 ;load origin of search uf2: call siul ;search by increment until limit jmp ucl ;pop argument, FALSE return shld pt ;location where first characters match push b ;save limit lhld py ;limit of search object mov b,h ;place it in (BC) mov c,l ; lhld pt ;comparison origin call ciul ;compare by increment until limit jmp uf3 ;comparison failed pop b ;end of text = search limit mov a,c ;compare to end of matching text sub l ; mov a,b ; sbb h ; jc ucl ;matching text ran over, so FALSE shld p2 ;mark end of matching text lhld pt ;fetch beginning of matching text shld p1 ;mark beginning of interval jmp cucl ;pop argument, TRUE return uf3: pop b ;recover search limit lhld px ;front of search object again xchg ;(DE) points to comparison character lhld pt ;point of last first-character match inx h ;move past it jmp uf2 ;continue the search ; (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:: lhld p2 ;point where insertion will be made shld p1 ;pointer 1 to precede inserted material push h ;keep destination end for future use lhld px ;source origin xchg ;place it in (DE) lhld py ;source end call siz ;calculate size of insert xthl ;save source end push h ;but keep it under destination end lhld p4 ;end pf physical space xchg ;place it in register (DE) lhld p3 ;end of present text call sing ;skip if increment not greater call rr2 ;no space, pop PDL twice xchg ;destination origin into (DE) lhld p3 ;source origin into (HL) xchg ;exchange these two registers shld p3 ;destination origin is new end of text pop b ;destination limit into (BC) call mdul ;move by decrement until source limit shld p2 ;source limit is end of insert pop b ;source limit into (BC) lhld px ;source origin into (HL) xchg ;really ought to be in (DE) lhld p1 ;new p1 is destination origin, in (HL) call miul ;move by increment until source limit jmp ucl ;I removes its argument upon completion ; (j) Null interval at p1. Equivalent to ''F or ''E. lcj:: lhld p1 ;pointer to beginning of interval shld p2 ;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:: lhld p0 ;fetch pointer to beginning of text shld p1 ;make it the beginning of the interval ret ; (M) Test whether a segment of the workspace lies in the ; interval defined by the pushdown list, inclusive of its ; endpoints. <a,b,M> is TRUE if there is a segment x starting ; at p1, such that a .LE. x .LE. b, FALSE otherwise. According ; to the common style of E, F, I, M, U, and V, the arguments ; are erased whatever might be the outcome of the comparison. ; Likewise, FALSE results in no workspace pointer changes. ; <'',b,M> will trivially succeed with '' in the workspace, ; but <a,'',M> will be interpreted by ignoring b, then ; looking for a workspace segment equal to or greater than a. ucm:: lhld px ;calculate <org, siz> for the xchg ; top argument, b. They have lhld py ; to be saved so that a can be mov a,l ; tested first. sub e ; mov l,a ; mov a,h ; sbb d ; mov h,a ; push h ;HL = siz(b) push d ;DE = org(b) call UCL ;discard b lhld px ;pointer to argument a xchg ;place it in DE lhld p1 ;pointer to workspace under comparison mov b,h ;place it in BC as tentative p2 mov c,l ; um1: lhld py ;pointer to end of argument a call seq ;skip if null argument - eg px=py jmp um7 ;non-trivial comparison to be made ; We get to um2 if the comparison of argument a was ; completed successfully, so we have to go back and ; puck up argument b, then compare it too. um2: mov h,b ;move BC over to HL mov l,c ; pop d ;org(b) pop b ;siz(b) mov a,c ;siz = 0 means TRUE ora b ; jz um4 ;record endpoint, quit push h ;save p2 lhld p1 ;run through interval again um3: ldax d ; cmp m ; jc um6 ;wrong inequality, so FALSE inx h ; inx d ; dcx b ; mov a,c ; ora b ; jnz um3 ; pop h ;recover the saved p2 um4: shld p2 ;it can be stored as end pointer jmp cucl ;TRUE return um5: pop h ; um6: pop h ; jmp UCL ;FALSE return um7: lhld p3 ;fetch end of text mov a,h ;compare it with end of interval cmp b ;compare high bytes jnz um8 ;whole addresses can't be equal mov a,l ;compare low bytes cmp c ; jz um5 ;end of text without success - FALSE um8: xchg ;pointer to argument back in (HL) ldax b ;fetch byte from workspace inx b ;advance pointer automatically cmp m ;compare to argument jc um5 ;fail if argument is bigger jnz um2 ;byte comparison decided, check limits xchg ;bytes were equal, keep trying inx d ;advance argument pointer jmp um1 ;repeat cycle ; (q) Put p1, p2-p1 on PDL. lcq:: lhld p1 ;fetch p1 xchg ;put it aside lhld p2 ;fetch p2 call siz ;leaves (HL)-(DE) in (BC) push b ;stash p2-p1 on 8080's PDL push d ;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:: lhld p1 ;fetch beginning of interval xchg ;place in (DE) lhld p2 ;fetch end of interval call siz ;length of interval into (BC) call narg ;close old arg, check space, def new lhld p1 ;fetch source origin xchg ;place it in register (DE) lhld px ;fetch destination origin for (HL) call miuc ;move by increment until count shld py ;destination end is argument end ret ; (w) Exchange workspace header. There are three forms of ; this operator which are available: the argument may be ; null, indicating that the header block goes onto the PDL, ; 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:: call psiz ;determine size of argument mov a,c ;check whether it is null ora b ; jnz lw2 ; lw1: lxi b,10 ;10 bytes required from PDL call narg ;verify space, new px into (HL) lxi d,p0 ;source is pointer block call miuc ;block movement shld py ;final destination is arg end ret lw2: lxi h,-10 ;ten for comparison dad b ;subtract it from size mov a,l ;check low byte for zero ora h ;but the high byte can be mixed in jnz lww ;if length not 10, suppose it was 2 lhld px ;fetch pointer to argument xchg ;place in (DE) as source origin lxi h,p0 ;p0 is destination origin call miuc ;move by increment until count (10) jmp ucl ;erase the argument lww: lhld px ;create p0...p4 from org,siz call twol ;trnsfr two args from PDL to 8080 stack call lw1 ;place existing header on PDL pop h ;recover under arg, namely org pop b ;recover upper arg, namely siz shld p0 ;origin of workspace shld p1 ;segment at front of workspace dad b ;add size shld p2 ;segment traverses whole workspace shld p3 ;which defines end of occupied text shld p4 ;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:: lhld p1 ;fetch beginning of last interval push h ;save for possible restoration lhld p2 ;fetch end of last interval push h ;save for future use shld p1 ;search begins at end of p1-p2 interval call ucf ;use the search subroutine jmp uuu ;search failed lhld p1 ;beginning of found interval shld p2 ;is end of result interval pop h ;recover end of last interval shld p1 ;it is beginning of U-interval pop h ;discard beginning of last interval jmp skp ;TRUE return from predicate uuu: pop h ;discard end of last interval-it's same pop h ;recover beginning of last interval shld p1 ;restore it 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:: lhld p1 ;pointer to beginning of last interval push h ;save it until later lhld p2 ;pointer to end of last interval shld p1 ;which is starting point for new search call ucf ;predicate F always makes the search jmp uvv ;search failed, F was FALSE pop h ;recover the old p1 shld p1 ;which still applies to V jmp skp ;TRUE return with old p1, new p2 uvv: pop h ;recover original p1 shld p1 ;and restore it 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. We may only ; want to restore p1, or alternatively both p1 and p2. ; A distinction between the cases is made by the size of ; the argument: <qL ... Y> will give a two-byte argument ; and restore p1; while <q| ... Y> will yield a four-byte ; argument and restore both p1 and p2. Y is a predicate, ; in the first case always TRUE with p1 and p2 accomodated ; as best can be. In the second case, failure to accomodate ; makes Y FALSE. ucy:: call psiz ;BC = py-px lxi h,-4 ; dad b ; mov a,l ; ora h ; jz uyi ;siz=4 means p1,p2-p1 concatinated lhld px ;pointer to top argument mov e,m ;fetch low byte of pointer inx h ;pass to high byte mov d,m ;DE contains the old pointer lhld p0 ;fetch beginning of text mov a,e ;check that p1 will be greater or equal sub l ; mov a,d ; sbb h ; jc uyy ;if less, store p0 instead lhld p3 ;fetch end of text mov a,l ;check that p1 will be less or equal sub e ; mov a,h ; sbb d ; jc uyn ;if not, make p2 = p1 = p3 lhld p2 ;fetch p2 xchg ;p1 and p2 in more favorable registers mov a,e ;check that p1 less or equal to p2 sub l ; mov a,d ; sbb h ; jnc uyy ;if so, just record p1 uyn: shld p2 ;record null interval between p1 and p2 uyy: shld p1 ;give p1 whatever value it'll have jmp cucl ;pop the argument ; A four-byte argument means we have concatinated <org, siz> ; and that both p1 and p2 are to be restored. uyi: mov c,m ;BC = old p1 inx h ; mov b,m ; inx h ; mov a,c ;DE = old p2 [p1+(p2-p1)] add m ; mov e,a ; inx h ; mov a,b ; adc m ; mov d,a ; lhld p0 ;check that p1 is not less than p0 mov a,e ; sub l ; mov a,d ; sbb h ; jc ucl ;no - so take FALSE return lhld p3 ;check that p1 is not beyond p3 mov a,l ; sub e ; mov a,h ; sbb d ; jc ucl ;no - so take false return mov l,c ;all clear, so restore them mov h,b ; shld p1 ; xchg ; shld p2 ; jmp cucl ;TRUE return ; (z) Null interval at end of segment. Equivalent to ; ''I, ''U, or 0b. lcz:: lhld p2 ;pointer to end of interval shld p1 ;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:: lhld p3 ;pointer to the end of text shld p2 ;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:: lxi b,4 ;need 4 bytes from wkspace for pointers lhld p4 ;fetch physical end of workspace xchg ;place it in (DE) lhld p3 ;fetch end of text call sing ;skip if increment not greater call rer ;error if no space left in workspace lhld p2 ;pointer to source limit mov b,h ;move it to (BC) mov c,l ; lhld p3 ;pointer to source origin xchg ;move it to (DE) lhld p4 ;pointer to destination origin call mdul ;move by decrement until limit xchg ;place destination limit in (DE) lhld p4 ;fetch old value of physical end mov a,h ;store at ws end in front of seg p2-p3 dcx d ; stax d ;store high byte mov a,l ; dcx d ; stax d ;store low byte lhld p0 ;fetch old value of physical beginning mov a,h ;store at ws end in front of old p4 dcx d ; stax d ;store high byte mov a,l ; dcx d ; stax d ;store low byte xchg ;put new physical end in (HL) shld p4 ;record it in p4 mov l,c ;move p2 into (HL) mov h,b ; shld p3 ;store it as new end of text lhld p1 ;move p1 into (HL) shld p0 ;store it as new beginning of text ret ;p2 remains at end of newlymade text ; (>) 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:: lhld p4 ;load the end of the universe mov e,m ;load the old p0 into (DE) inx h ; mov d,m ; mov a,e ;zero means opening too many times ora d ; cz rer ;so note error and abandon attempt inx h ;go on to fetch old p4 into (BC) mov c,m ; inx h ; mov b,m ; inx h ;pointer always one ahead xchg ;place old p0 in (HL) shld p0 ;to facilitate returning it to p0 lhld p3 ;end of txt is dest to replace old tail call miul ;move by increment until limit shld p3 ;destination end is new end of text xchg ;origin end is new end of universe shld p4 ;which must be duly recorded ret ; ------------------------------------------------------- ; ; Some of the block action subroutines which might be ; found as external references in the other modules: ; ; miul move by increment until source limit ; mdul move by decrement until source limit ; aiuc and by increment until count ; oiuc or by increment until count ; xiuc xor by increment until count ; kiuc complement by increment until count ; ; ------------------------------------------------------- end