MACRO .*- .* Single-linked list .* Syntax: .* label SLNKLST ADD,SIZE=n,ADDR=addr|0 .* label SLNKLST NEXT,ADDR=addr .* label SLNKLST DROP,ADDR=addr,PREV=addr|0 .* label SLNKLST DROPALL,ADDR=addr-of-first .* label SLNKLST ANCHOR .* n Value, (reg) or f.label .* 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 .* registers after ADD and NEXT: .* r1 -> block, r0 -> data section. r1 is 0 if no next. .* .* Samples .* .* add first .* SLNKLST add,size=textl,addr=0 .* st r1,SLNKlsta .* .* add 2 entries (first and second) .* la r8,SLNKLSTA .* SLNKLST add,size=textl,addr=(r8) .* lr r8,r1 .* SLNKLST add,size=textl,addr=(r8) .* st r8,SLNKLSTE save address of last .* add 1 after last .* l r8,SLNKLSTE .* SLNKLST add,size=textl,addr=(r8) .* drop one .* SLNKLST drop,addr=(r2),prev=(r3) .* drop all .* SLNKLST dropall,addr=f.SLNKLSTA .* scan list .* l r2,SLNKLSTA -> first .* SCAN equ * .* .. do something .. .* SLNKLST next,addr=(r2) .* ltr r2,r1 .* jnz SCAN .* .* SLNKLSTA dc a(0) .* SLNKLSTE dc a(0) .* .* Changelog .* 2019-01-05 Expand dsect at first call, unless DSECT=N .* .* By .* Willy Jensen .* mail: willy@harders-jensen.com .* web : http://harders-jensen.com/wjtech/index.html .*- &ml SLNKLST &addr=,&prev=,&clear=,&size=,&sp=0,&data=,&trace=, c &dsect=Y lclc &que,&s,&l lcla &nexto,&sizeo,&datao,&poolo,&pfxl gblc $xlalen &nexto seta 0 &sizeo seta 4 &poolo seta 8 &datao seta 12 &pfxl seta 12 &l setc 'SLL&sysndx' gblb @SLNKlst &que setc Upper('&syslist(1)') aif ('&que' eq 'XLA').xla aif ('&que' eq 'DSECT').dsect aif ('&que' eq 'ANCHOR').anchr aif (k'&addr eq 0).err2 ADDR= required for rest .* aif ('&dsect' ne 'Y' or &@SLNKlst).dsct1n &s setc '&sysect' SLNKLST DSECT &s Csect .dsct1n anop .* aif ('&que' eq 'ADD').add aif ('&que' eq 'NEXT').next aif ('&que' eq 'DROP').drop aif ('&que' eq 'DROPALL').dropa err1 mnote 8,'***Error invalid option' mexit err2 mnote 8,'***Error ADDR parm is required' mexit err3 mnote 8,'***Error PREV parm is required' mexit .*- .* add new entry .*- .ADD ANOP &ml SLNKLST XLA,r0,&sp *getmain SLNKLST XLA,r14,&size la r14,&pfxl.(,r14) add prefix Getmain R,lv=(14),bndry=DBLWD,sp=&sp xc 0(&pfxl,r1),0(r1) st r14,&sizeo.(,r1) save size aif ('&sp' eq '0').sp0 SLNKLST XLA,r0,&sp stc r0,&poolo.(,r1) save subpool .sp0 anop .* chain *chain SLNKLST XLA,r15,&addr ltr r15,r15 any current jz &l.b else bypass chaining l r14,&nexto.(r15) -> next st r1,&nexto.(r15) set next in current st r14,&nexto.(,r1) set next in new &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 SLNKLST XLA,r1,&size sr r14,r14 sr r15,r15 mvcl r0,r14 l r1,24(,r13) .addcn anop aif (n'&data eq 0).adddn *get data SLNKLST XLA,r14,&data(1) SLNKLST XLA,r15,&data(2),&$xlalen st r1,24(,r13) la r0,&datao.(,r1) SLNKLST XLA,r1,&size 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 *data ptr la r0,&datao.(r1) -> data section *end mexit .*- .* address next entry .*- .NEXT ANOP &ml SLNKLST 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 .*- .* drop one .*- .DROP ANOP aif (k'&prev eq 0).err3 PREV= required for rest *unchain &ml SLNKLST XLA,r1,&addr SLNKLST XLA,r14,&prev -> previous ltr r14,r14 jz &l.a l r15,&nexto.(,r1) -> next st r15,&nexto.(,r14) update next in prev *free &l.a l r15,&sizeo.(,r1) size lb r0,&poolo.(,r1) Freemain R,lv=(15),a=(1),sp=(0) *end mexit .*- .* drop all .*- .DROPA ANOP &ml SLNKLST 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).dropatn &trace .dropatn anop Freemain R,lv=(15),a=(1),sp=(0) j &l.a &l.x equ * mexit .*- .* anchor .*- .anchr anop &ml dc a(0) mexit .*- .* dsect .*- .dsect anop aif (&@SLNKlst).mend &@SLNKlst setb 1 SLNKLSTBLOK dsect SLNKlstnexto equ &nexto SLNKlstnext ds a -> next in queue SLNKlstsizeo equ &sizeo SLNKlstsize ds a size of block incl pfx SLNKlstpoolo equ &poolo SLNKlstpool ds x subpool # ds 3x future SLNKlstpfxl equ &datao prefix size SLNKlstdatao equ &datao SLNKlstdata ds 0a mexit .*- .* XLA - subroutine, generate Lx instruction .* Syntax: macname XLA,reg,ahat .* what: label, (reg), 'literal', 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 la &xlar,&xlap &$xlalen setc 'l''&xlap' mexit .xlanum anop 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) l&xla &xlar,&xlap mexit .xlareg anop &xlan seta k'&xlap-2 &xlap setc '&xlap'(2,&xlan) lr &xlar,&xlap mexit .xlalit anop la &xlar,=c&xlap &xlan seta k'&xlap-2 &$xlalen setc '&xlan' .xlan mexit .mend MEND