MACRO .*- .* Double-linked list .* Simple version - add, delete, locate and search of un-ordered list .* .* Syntax: .* .* Add first entry .* label DLNKLST ADD,ADDR=0,SIZE=n|DATA=dataspec, .* SP=subpool,LOC=loc .* .* Add new entry after existing .* label DLNKLST ADD,ADDR=addr,SIZE=n|DATA=dataspec, .* SP=subpool,LOC=loc .* .* Add new entry before existing, also before first .* label DLNKLST ADD,BEFORE=addr,SIZE=n|DATA=dataspec, .* SP=subpool,LOC=loc .* .* Delete entry .* label DLNKLST DEL,ADDR=addr .* .* Delete all entries from given address onwards .* label DLNKLST DELALL,ADDR=addr .* .* Address next entry .* label DLNKLST NEXT,ADDR=addr .* .* Address previous entry .* label DLNKLST PREV,ADDR=addr .* .* Scan forward for leading text (prefix). .* label DLNKLST LOCATE,ADDR=addr,DATA=dataspec .* .* Scan backward for leading text (prefix). .* label DLNKLST LOCATE,ADDR=addr,DATA=dataspec,LOCDIR=PREV .* .* Scan forward for text anywhere in data .* label DLNKLST SEARCH,ADDR=addr,DATA=dataspec .* .* Scan backward for text anywhere in data .* label DLNKLST SEARCH,ADDR=addr,DATA=dataspec,LOCDIR=PREV .* .* Operand descriptions .* .* addr Label, (reg) or f.label .* Can be '0' for ADD, in which case neither .* forward nor backward pointers are updated - .* note that '0' may be a register with zeroes. .* f.label => l reg,label .* n Value, (reg) or f.label .* subpool Storage subpool .* loc Storage location, 24 or 31. 31 is default. .* dataspec label - length is assembled length .* (label,length) - both label and length may be .* registers (rn). .* 'literal' .* .* Samples .* .* Add first entry .* DLNKLST add,size=textl,addr=0 acquire storage .* st r1,dlfirst .* st r1,dllast .* or .* DLNKLST add,data=text,addr=0 acquire and load data .* st r1,dlfirst .* st r1,dllast .* .* Add 2nd and later entries .* DLNKLST add,size=textl,addr=f.dllast .* st r1,dllast save address of latest .* .* The 'dllast' field can be used for a later LOCATE with .* LOCDIR=PREV. .* .* Delete one .* DLNKLST del,addr=(r4) .* .* Delete all .* DLNKLST delall,addr=f.dlfirst .* .* Find entry in list by (starting) value in an ordered list .* DLNKLST Locate,data=(text,6),addr=f.dlfirst .* ltr r15,r15 .* * nz => r1 -> block, r14 -> data, r15 = size .* .* Process list sequentially (FIFO) .* l r2,dlfirst -> first .* SCAN equ * .* .. do something .. .* DLNKLST next,addr=(r2) .* ltr r2,r1 .* jnz SCAN .* .* dlfirst dc a(0) .* dllast dc a(0) .* text dc c'Sunday morning is a time for sleeping in' .* textl equ *-text .* .* .* by: Willy Jensen .* mail: willy@harders-jensen.com .* web : http://harders-jensen.com/wjtech/index.html .*- &ml DLNKLST &addr=,&size=,&data=,&loc=31,&sp=0,&clear=, c &before=,&locdir=NEXT,&trace= lclc &s,&l,&len1,&len2 lcla &nexto,&prevo,&sizeo,&datao,&poolo,&pfxl gblc $xlalen &nexto seta 0 &prevo seta 4 &sizeo seta 8 &poolo seta 12 &dsizo seta 16 &datao seta 20 &pfxl seta 20 gblb &@dlnklst &s setc Upper('&syslist(1)') aif ('&s' eq 'DSECT').dsect aif (&@dlnklst).sel2 &sysmac Dsect .sel2 anop aif ('&s' eq 'XLA').xla aif ('&s' eq 'ADD').add aif ('&s' eq 'LOCATE').locate aif ('&s' eq 'SEARCH').search aif ('&s' eq 'NEXT').next aif ('&s' eq 'PREV').prev aif ('&s' eq 'DELALL').delall aif ('&s' eq 'DEL').del mnote 8,'***Error invalid option' mexit .ERR1 mnote 8,'***Error ADDR parm is required' mexit .*- .* add new entry .*- .ADD ANOP &l setc 'DLA&sysndx' *add *getmain &ml &SYSMAC XLA,r0,&sp &SYSMAC XLA,r14,&size,&data(2),l'&data(1) la r14,&pfxl.(,r14) add prefix Getmain R,lv=(14),bndry=DBLWD,sp=&sp,loc=&loc xc 0(&pfxl,r1),0(r1) st r14,&sizeo.(,r1) save size lr r0,r14 data ahi r0,-&pfxl section st r0,&dsizo.(,r1) size aif ('&sp' eq '0').sp0 &SYSMAC XLA,r0,&sp stc r0,&poolo.(,r1) save subpool .sp0 anop aif (k'&before gt 0).addbef *chain after &SYSMAC XLA,r15,&addr ltr r15,r15 any current jz &l.b else bypass chaining icm r14,15,&nexto.(r15) -> next jz &l.a no next st r1,&prevo.(,r14) set prev in next &l.a st r1,&nexto.(r15) set next in current st r15,&prevo.(,r1) set prev in new st r14,&nexto.(,r1) set next in new ago .addbefn .addbef anop *chain before &SYSMAC XLA,r15,&before -> 'next' entry l r14,&prevo.(r15) prev in next st r1,&prevo.(r15) set prev in next st r15,&nexto.(,r1) set next in new ltr r14,r14 jz &l.b nope st r1,&nexto.(r14) set next in prev st r14,&prevo.(r1) set prev in new .addbefn anop &l.b equ * .* clear &s setc Upper('&clear') aif ('&s '(1,1) ne 'Y').addcn *clear st r1,24(,r13) la r0,&datao.(,r1) set target addr &SYSMAC XLA,r1,&size,&data(2),l'&data(1) sr r14,r14 sr r15,r15 mvcl r0,r14 l r1,24(,r13) .addcn anop aif (n'&data eq 0).adddn *get data &SYSMAC XLA,r14,&data(1) &s setc '&$xlalen' &SYSMAC XLA,r15,&data(2),&$xlalen st r1,24(,r13) la r0,&datao.(,r1) &SYSMAC XLA,r1,&size,&data(2),&s cr r1,r15 test l'target gt l'data jh *+6 lr r15,r1 else use l'target mvcl r0,r14 l r1,24(,r13) .adddn anop .* setup pointers for caller la r0,&datao.(r1) -> data section *add end mexit .*- .* address next entry - r1 -> block, or is 0 .*- .NEXT ANOP &l setc 'DLN&sysndx' &ml &SYSMAC XLA,r1,&addr ltr r1,r1 jz &l.x no current l r1,&nexto.(,r1) -> next la r0,&datao.(r1) -> data section &l.x equ * mexit .*- .* address previous entry .*- .PREV ANOP &l setc 'DLP&sysndx' &ml &SYSMAC XLA,r1,&addr ltr r1,r1 jz &l.x no current l r1,&prevo.(,r1) -> previous la r0,&datao.(r1) -> data section &l.x equ * mexit .*- .* delete one, r1 -> entry .*- .del ANOP &l setc 'DLD&sysndx' *unchain &ml &SYSMAC XLA,r1,&addr .deluc2 l r14,&prevo.(,r1) -> previous l r15,&nexto.(,r1) -> next ltr r14,r14 jz &l.a st r15,&nexto.(,r14) update next in prev &l.a ltr r15,r15 if there a next? jz &l.b st r14,&prevo.(,r15) update prev in next aif (k'&trace eq 0).deltn &trace .deltn anop *freemain &l.b l r15,&sizeo.(,r1) size lb r0,&poolo.(,r1) Freemain R,lv=(15),a=(1),sp=(0) *delete end mexit .*- .* delete all .*- .DELALL ANOP &l setc 'DLX&sysndx' *drop all entries &ml &SYSMAC XLA,r14,&addr -> starting point &l.a ltr r14,r14 test for block jz &l.x no queue l r15,&sizeo.(,r14) size lr r1,r14 copy address lb r0,&poolo.(,r1) sp l r14,&nexto.(,r14) -> next aif (k'&trace eq 0).delatn &trace .delatn anop Freemain R,lv=(15),a=(1),sp=(0) j &l.a &l.x equ * *drop all end mexit .*- .* locate entry by data(prefix) .* After .* r1 -> block .* r14 -> data .* r15 = datalen or 0 .*- .LOCATE ANOP &l setc 'DLL&sysndx' *locate &ml st r2,28(,r13) &s setc '&addr' &SYSMAC XLA,r2,&s .*locate setup - r14->arg, r15=l'arg &SYSMAC XLA,r14,&data(1) &SYSMAC XLA,r15,&data(2),&$xlalen bctr r15,0 mch length sr r1,r1 default=not found &l.a l r0,dlnklstdsizo(r2) data size bctr r0,r0 mch length cr r0,r15 check length jl &l.b data too short ex r15,&l.t je &l.ok &l.b icm r2,15,dlnklst&locdir.o(r2) -> next/prev jnz &l.a if any j &l.nok &l.t clc 0(*-*,r14),dlnklstdatao(r2) &l.nok sr r15,r15 j &l.x &l.ok la r14,dlnklstdatao(r2) -> data l r15,dlnklstdsizo(r2) data size lr r1,r2 &l.x l r2,28(,r13) ltr r15,r15 *locate end mexit .*- .* scan list by data, set r1 -> block or 0, r0 = data length .*- .SEARCH ANOP &l setc 'DLS&sysndx' *search &ml st r2,28(,r13) &SYSMAC XLA,r2,&addr &l.a StrPos arg=&data, c str=(dlnklstdatao(r2),f.dlnklstdsizo(r2)) jnz &l.ok &l.b icm r2,15,dlnklst&locdir.o(r2) -> next/prev jnz &l.a if any sr r1,r1 j &l.x &l.ok la r14,dlnklstdatao(r2) l r15,dlnklstdsizo(r2) lr r1,r2 &l.x l r2,28(,r13) ltr r1,r1 *search end mexit .*- .* dsect .*- .DSECT ANOP &s setc '&sysloc' aif (&@dlnklst).mend &@dlnklst setb 1 DLNKLSTBLOK dsect dlnklstnexto equ &nexto dlnklstnext ds a -> next in queue dlnklstprevo equ &prevo dlnklstprev ds a -> prev in queue dlnklstsizeo equ &sizeo dlnklstsize ds a size of block incl pfx dlnklstpoolo equ &poolo dlnklstpool ds x subpool # ds 3x future dlnklstdsizo equ &dsizo dlnklstdsiz ds a data size dlnklstdatao equ &datao dlnklstdata ds 0x start of data dlnklstpfxl equ &datao prefix size &s Loctr mexit .*- .* XLA - subroutine, generate Lx instruction .* Syntax: macname XLA,reg,what .* what: label or (reg) or 'literal' or f/h/b.label .*- .XLA ANOP lclc &xlar,&xlap,&xla lcla &xlapn,&xlan &$xlalen setc '' &xlar setc '&syslist(2)' &xlapn seta 2 .xlanext anop &xlapn seta &xlapn+1 aif (&xlapn gt n'&syslist).xlan &xlap setc '&syslist(&xlapn)' aif (k'&xlap eq 0).xlanext aif ('&xlap '(1,1) eq '(').xlareg aif ('&xlap '(1,1) eq '''').xlalit aif ('&xlap '(2,1) eq '.').xlafld &xla setc t'&xlap aif ('&xla' eq 'N').xlanum &ml la &xlar,&xlap aif ('&xlap '(1,2) eq 'l''').mend &$xlalen setc 'l''&xlap' mexit .xlanum anop &ml lgfi &xlar,&xlap mexit .xlafld anop &xlan seta k'&xlap-2 &xla setc '&xlap'(1,1) &xla setc Upper('&xla') aif ('&xla' ne 'F').xlafld2 &xla setc '' .xlafld2 anop &xlap setc '&xlap'(3,&xlan) &ml l&xla &xlar,&xlap mexit .xlareg anop &xlan seta k'&xlap-2 &xlap setc '&xlap'(2,&xlan) &ml lr &xlar,&xlap mexit .xlalit anop &ml la &xlar,=c&xlap &xlan seta k'&xlap-2 &$xlalen setc '&xlan' .xlan mexit Mexit .*- .* MEND .*- .mend MEND