.macro $$branch,instr,value,a,b .if nb b instr a,b,value'$ .mexit .endc .if nb a instr a,value'$ .mexit .endc instr value'$ .endm $$branch .macro $$call,count,name CALLS #count,G^'name .endm $$call .macro $$for,index,by,to,value,type ACB'type to,by,index,value'$ .endm $$for .macro $$label,value value'$: .endm $$label .macro $$set,flag,value flag=value .endm $$set .macro $andor,true,false,a,b .macro and mlr_and=1 $branch false,mlr_if1,\mlr_ifs,a,b .endm and .macro or mlr_or=1 $branch true,mlr_if2,\mlr_ifs,a,b .endm or .mexit .endm $andor .macro $branch,instr,struc,value,a,b $$branch ,\struc'value,a,b .endm $branch .macro $call,name,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .narg mlr_count mlr_count=mlr_count-1 .if gt mlr_count .irp mlr,<,,,,,,,,- ,,
,,,,,,,- ,,,,,,,,> .if nb $push .endc .endr .endc $$call \mlr_count,name .endm $call .macro $descr,type,length,name,allot,?label .WORD length .BYTE DSC$K_DTYPE_%extract(4,1,type) .if idn <0>, .BYTE DSC$K_CLASS_D .if nb name: .endc .LONG 0 .iff .BYTE DSC$K_CLASS_S .if nb .if idn <*>, .LONG label label: type length .iff .LONG name .if idn <*>, name: type length .endc .endc .iff .LONG label label: .endc .endc .endm $descr .macro $emit,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .narg mlr_count .if gt mlr_count .irp mlr,<,,,,,,,,- ,,,,,,,
,,- ,,,,,,,,> .if nb mlr .endc .endr .endc .endm $emit .macro $endfor,value endfor'value .endm $endfor,value .macro $for,index,by,to,struct,value,type .macro endfor'value $$for index,by,to,\struct'value,type .endm endfor'value .endm $for .macro $label,struc,value $$label \struc'value .endm $label .macro $module,name,arglist,alias,xpsect,xmask,xtype module name,,alias,psect=xpsect,mask=,type=xtype .endm $module .macro $procedure,name,alias,xpsect,xtype procedure name,alias,psect=xpsect,type=xtype .endm $procedure .macro $push,name,type=L .ntype mlr_mode,name mlr_mode=mlr_mode@-4&^xF .if idn <0>, CLR'type -(SP) .mexit .endc .if idn <#0>, CLR'type -(SP) .mexit .endc mlr_flag=0 .iif le mlr_mode-1, mlr_flag=1 .iif eq mlr_mode-5, mlr_flag=1 .if eq mlr_flag PUSHA'type name .iff PUSH'type name .endc .endm $push .macro $set,flag,struc,value $$set flag,\struc'value .endm $set .macro $unique,struc,value,flag .if nb struc'value=flag .iff .iif ndf mlr_unique, mlr_unique=19999 mlr_unique=mlr_unique+1 struc'value=mlr_unique .endc .endm $unique .macro .blkt,length .BLKB length .endm .blkt .macro addq,add,sum,?tst1,?tst2,?tst3 ADDL add,sum ADWC 4+add,4+sum TSTL 4+sum BLSS tst1 BGTR tst2 TSTL sum BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm addq .macro addq3,add1,add2,sum,?tst1,?tst2,?tst3 MOVQ add2,sum ADDL add1,sum ADWC 4+add1,4+sum TSTL 4+sum BLSS tst1 BGTR tst2 TSTL sum BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm addq3 .macro and AND? .endm and .macro andif and .if eq 1-mlr_or $label mlr_if2,\mlr_ifs $unique mlr_if2,\mlr_ifs mlr_or=0 .endc .endm andif .macro bc,pos,base $andor BBC,BBS,pos,base .endm bc .macro bcc,pos,base $andor BBCC,BBSC,pos,base .endm bcc .macro bcs,pos,base $andor BBCS,BBSS,pos,base .endm bcs .macro begin,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .RESTORE_PSECT .ENABLE LOCAL_BLOCK $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, .endm begin .macro bs,pos,base $andor BBS,BBC,pos,base .endm bs .macro bsc,pos,base $andor BBSC,BBCC,pos,base .endm bsc .macro bss,pos,base $andor BBSS,BBCS,pos,base .endm bss .macro case,source,list,- a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,- type=L,base=#0,?table,?endtable CASE'type source,base,#</2>-1 table: .irp mlr, .if nb .WORD mlr-table .iff .WORD endtable-table .endc .endr endtable: .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,4 .iif ndf mlr_cases, mlr_cases=0 mlr_cases=mlr_cases+1 $unique mlr_case0,\mlr_cases,0 $unique mlr_case1,\mlr_cases $unique mlr_case2,\mlr_cases .macro do .endm do $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, $branch BRW,mlr_case1,\mlr_cases .endm case .macro cc $andor BCC,BCS .endm cc .macro cmpq,src1,src2,?tst1,?tst2,?tst3 MOVQ src1,r2 SUBL src2,r2 SBWC 4+src2,r3 TSTL r3 BLSS tst1 BGTR tst2 TSTL r2 BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm cmpq .macro const .endm const .macro continue .endm continue .macro cs $andor BCS,BCC .endm cs .macro descr,type,length,name,allot descr'type ,name,allot .endm descr .macro descr.blka,length,name,allot $descr .BLKA,,name,allot .endm descr.blka .macro descr.blkb,length,name,allot $descr .BLKB,,name,allot .endm descr.blkb .macro descr.blkd,length,name,allot $descr .BLKD,,name,allot .endm descr.blkd .macro descr.blkf,length,name,allot $descr .BLKF,,name,allot .endm descr.blkf .macro descr.blkg,length,name,allot $descr .BLKG,,name,allot .endm descr.blkg .macro descr.blkh,length,name,allot $descr .BLKH,,name,allot .endm descr.blkh .macro descr.blkl,length,name,allot $descr .BLKL,,name,allot .endm descr.blkl .macro descr.blko,length,name,allot $descr .BLKO,,name,allot .endm descr.blko .macro descr.blkq,length,name,allot $descr .BLKQ,,name,allot .endm descr.blkq .macro descr.blkt,length,name,allot $descr .BLKT,,name .endm descr.blkt .macro descr.blkw,length,name,allot $descr .BLKW,,name,allot .endm descr.blkw .macro divq4,divr,divd,quo,rem,- ?div1,?div2,?div3,?div4,?tst1,?tst2,?tst3 PUSHR #^M MOVQ divr,r0 MOVQ divd,r2 MOVQ r2,r4 CLRQ r6 CLRL r8 MOVL #65,r10 div1: ASHQ #1,r6,r6 BISL r8,r6 CLRL r8 CMPL r1,r7 BNEQ div2 CMPL r0,r6 div2: BGTRU div3 SUBL r0,r6 SBWC r1,r7 INCL r8 div3: CLRL r9 TSTL r5 BGEQ div4 INCL r9 div4: ASHQ #1,r4,r4 BISL r8,r4 MOVL r9,r8 DECL r10 BNEQ div1 MOVQ r4,quo MOVQ r6,rem POPR #^M TSTL 4+quo BLSS tst1 BGTR tst2 TSTL quo BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm divq4 .macro do .endm do .macro else,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z $unique mlr_if3,\mlr_ifs $branch BRW,mlr_if3,\mlr_ifs $label mlr_if1,\mlr_ifs $emit ,,,,,,,,,,,,,- ,,
~~~~~~,,,~~,,,,,,, .endm else .macro elseif,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z else if~~ ,,,,,,,,,,,,,- ,,~~~~~~
,,,,,,,,,, $unique mlr_if0,\mlr_ifs,1 .endm elseif .macro end,name $set mlr_flag,mlr_end,\mlr_ends .if eq mlr_flag endmodule name .mexit .endc .if eq 1-mlr_flag endprocedure name .mexit .endc .if eq 2-mlr_flag endif name .mexit .endc .if eq 3-mlr_flag endloop name .mexit .endc .if eq 4-mlr_flag endcase name .mexit .endc .if eq 5-mlr_flag endof name .mexit .endc .if eq 6-mlr_flag endrecord name .mexit .endc .if eq 7-mlr_flag endpsect name .mexit .endc .endm end .macro endcase,name $set mlr_flag,mlr_case0,\mlr_cases .if eq mlr_flag $label mlr_case1,\mlr_cases .endc $label mlr_case2,\mlr_cases mlr_cases=mlr_cases-1 mlr_ends=mlr_ends-1 .endm endcase .macro endfor endloop .endm endfor .macro endif,name $set mlr_flag,mlr_if3,\mlr_ifs .if gt mlr_flag $label mlr_if3,\mlr_ifs .iff $label mlr_if1,\mlr_ifs .endc $set mlr_flag,mlr_if0,\mlr_ifs mlr_ifs=mlr_ifs-1 mlr_ends=mlr_ends-1 .if ne mlr_flag endif .endc .endm endif .macro endloop,name $set mlr_flag,mlr_loop0,\mlr_loops .if eq mlr_flag $branch BRW,mlr_loop1,\mlr_loops .iff $endfor \mlr_loops .endc $label mlr_loop2,\mlr_loops mlr_loops=mlr_loops-1 mlr_ends=mlr_ends-1 .endm endloop .macro endmodule,name mlr_returns=mlr_returns-1 mlr_ends=mlr_ends-1 .endm endmodule .macro endof,name $branch BRW,mlr_case2,\mlr_cases mlr_ends=mlr_ends-1 .endm endof .macro endprocedure,name mlr_returns=mlr_returns-1 mlr_ends=mlr_ends-1 .endm endprocedure .macro endpsect,name mlr_ends=mlr_ends-1 .RESTORE_PSECT .endm endpsect .macro endrecord,name mlr_ends=mlr_ends-1 .RESTORE_PSECT .endm endrecord .macro endrepeat,name endloop .endm endrepeat .macro endwhile,name endloop .endm endwhile .macro eql $andor BEQL,BNEQ .endm eql .macro eqlu $andor BEQLU,BNEQU .endm eqlu .macro exit,value $set mlr_flag,mlr_end,\mlr_ends .if eq mlr_flag .if nb value MOV'type value,r0 .endc $EXIT_S r0 .mexit .endc $branch BRW,mlr_loop2,\mlr_loops .endm exit .macro external,mlr,name,arglist,alias .if idn , $module name,,alias,,,EXTERNAL .mexit .endc .if idn , $module name,,alias,,,EXTERNAL .mexit .endc .if idn , $procedure name,alias,,EXTERNAL .mexit .endc .if idn , $procedure name,alias,,EXTERNAL .mexit .endc .EXTERNAL mlr .endm external .macro for,index,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,- from=,to=,by=#1,type=L .if nb from .if dif ,<#0> .if dif ,<0> MOV'type from,index .iff CLR'type index .endc .iff CLR'type index .endc .endc loop $unique mlr_loop0,\mlr_loops,1 .macro do .endm do $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, $for index,,,mlr_loop1,\mlr_loops,type .endm for .macro forever,name endloop .endm forever .macro geq $andor BGEQ,BLSS .endm geq .macro gequ $andor BGEQU,BLSSU .endm gequ .macro global,mlr,name,arglist,psect=,mask= .if idn , .if nb $module name,,,psect,,GLOBAL .iff $module name,,,name,,GLOBAL .endc .mexit .endc .if idn , .if nb $module name,,,psect,,GLOBAL .iff $module name,,,name,,GLOBAL .endc .mexit .endc .if idn , .if nb $procedure name,,psect,GLOBAL .iff $procedure name,,name,GLOBAL .endc .mexit .endc .if idn , .if nb $procedure name,,psect,GLOBAL .iff $procedure name,,name,GLOBAL .endc .mexit .endc .endm global .macro goto,label BRW label .endm goto .macro gtr $andor BGTR,BLEQ .endm gtr .macro gtru $andor BGTRU,BLEQU .endm gtru .macro if,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,2 .iif ndf mlr_ifs, mlr_ifs=0 mlr_ifs=mlr_ifs+1 $unique mlr_if0,\mlr_ifs,0 $unique mlr_if1,\mlr_ifs $unique mlr_if2,\mlr_ifs $unique mlr_if3,\mlr_ifs,0 mlr_and=0 .macro and AND? .endm and mlr_or=0 .macro or OR? .endm or $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, .endm if .macro lbc,source $andor BLBC,BLBS,source .endm lbc .macro lbs,source $andor BLBS,BLBC,source .endm lbs .macro leq $andor BLEQ,BGTR .endm leq .macro lequ $andor BLEQU,BGTRU .endm lequ .macro loop,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,3 .iif ndf mlr_loops, mlr_loops=0 mlr_loops=mlr_loops+1 $unique mlr_loop0,\mlr_loops,0 $unique mlr_loop1,\mlr_loops $unique mlr_loop2,\mlr_loops $label mlr_loop1,\mlr_loops $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, .endm loop .macro lss $andor BLSS,BGEQ .endm lss .macro lssu $andor BLSSU,BGEQU .endm lssu .macro module,name,arglist,alias,- psect=,mask=,type=LOCAL .if idn , .if nb .if nb .macro alias,arglist $call name,arglist .endm alias .iff .macro alias $call name .endm alias .endc .iff .if nb .macro name,arglist $call name,arglist .endm name .iff .macro name $call name .endm name .endc .endc .mexit .endc .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,0 .iif ndf mlr_returns, mlr_returns=0 mlr_returns=mlr_returns+1 $unique mlr_return,\mlr_returns,0 .if nb .PSECT psect'_'type,RD,NOWRT,EXE,LONG .iff .PSECT name'_'type,RD,NOWRT,EXE,LONG .endc .if idn , name:: .iff name: .endc .if nb .WORD ^M .iff .WORD ^M .endc mlr_count=0 name'.narg=mlr_count .if nb .irp mlr, mlr_count=mlr_count+4 name'.'mlr=mlr_count .endr .endc .SAVE_PSECT .if nb .PSECT psect'_data,RD,WRT,NOEXE,LONG .iff .PSECT name'_data,RD,WRT,NOEXE,LONG .endc .ENABLE LOCAL_BLOCK .endm module .macro mulq,mulr,prod,?mul1,?mul2,?tst1,?tst2,?tst3 EMUL mulr,prod,#0,r2 MULL3 4+mulr,prod,r0 MULL3 mulr,4+prod,r1 MULL r1,r0 TSTL mulr BGEQ mul1 MULL prod,r0 mul1: TSTL prod BGEQ mul2 MULL mulr,r0 mul2: MULL r0,r3 MOVQ r2,prod TSTL 4+prod BLSS tst1 BGTR tst2 TSTL prod BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm mulq .macro mulq3,mulr,muld,prod,?mul1,?mul2,?tst1,?tst2,?tst3 EMUL mulr,muld,#0,prod MULL3 4+mulr,muld,r0 MULL3 mulr,4+muld,r1 MULL r1,r0 TSTL mulr BGEQ mul1 MULL muld,r0 mul1: TSTL muld BGEQ mul2 MULL mulr,r0 mul2: MULL r0,4+prod TSTL 4+prod BLSS tst1 BGTR tst2 TSTL prod BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm mulq3 .macro neq $andor BNEQ,BEQL .endm neq .macro nequ $andor BNEQU,BEQLU .endm nequ .macro of,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,5 $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, .endm of .macro or OR? .endm or .macro orif or .if eq 1-mlr_and $label mlr_if1,\mlr_ifs $unique mlr_if1,\mlr_ifs mlr_and=0 .endc .endm orif .macro otherwise,name $unique mlr_case0,\mlr_cases,1 $label mlr_case1,\mlr_cases .endm otherwise .macro procedure,name,alias,psect=,type=LOCAL .if idn , .if nb .macro alias BSBW G^'name .endm alias .iff .macro name BSBW G^'name .endm name .endc .mexit .endc .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,1 .iif ndf mlr_returns, mlr_returns=0 mlr_returns=mlr_returns+1 $unique mlr_return,\mlr_returns,1 .if nb .PSECT psect'_'type,RD,NOWRT,EXE,LONG .iff .PSECT name'_'type,RD,NOWRT,EXE,LONG .endc .if idn , name:: .iff name: .endc .SAVE_PSECT .if nb .PSECT psect'_data,RD,WRT,NOEXE,LONG .iff .PSECT name'_data,RD,WRT,NOEXE,LONG .endc .ENABLE LOCAL_BLOCK .macro name BSBW name .endm name .endm procedure .macro psect,name,attr .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,7 .SAVE_PSECT .PSECT name,attr .endm psect .macro record,name,psect= .iif ndf mlr_ends, mlr_ends=0 mlr_ends=mlr_ends+1 $unique mlr_end,\mlr_ends,6 .SAVE_PSECT .if nb .PSECT psect'_abs,ABS .iff .PSECT name'_abs,ABS .endc .endm record .macro repeat,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z loop $emit ,,,,,,,,,,,,,- ,,
~~~~~~,,,~~,,,,,,, .endm repeat .macro return,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z $emit~~ ,,,,,,,,,,,,,- ,,~~~~~~
,,,,,,,,,, $set mlr_flag,mlr_return,\mlr_returns .if eq mlr_flag RET .iff RSB .endc .endm return .macro subq,sub,dif,?tst1,?tst2,?tst3 SUBL sub,dif SBWC 4+sub,4+dif TSTL 4+dif BLSS tst1 BGTR tst2 TSTL dif BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm subq .macro subq3,sub,min,dif,?tst1,?tst2,?tst3 MOVQ min,dif SUBL sub,dif SBWC 4+sub,4+dif TSTL 4+dif BLSS tst1 BGTR tst2 TSTL dif BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm subq3 .macro then,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z and .iif eq 1-mlr_or, $label mlr_if2,\mlr_ifs $emit ,,,,,,,,,,,,,- ,,
,,,,,,,,,, .endm then .macro tstq,src,?tst1,?tst2,?tst3 TSTL 4+src BLSS tst1 BGTR tst2 TSTL src BNEQU tst2 CLRL r0 BRW tst3 tst1: MOVL #-1,r0 BRW tst3 tst2: MOVL #1,r0 tst3: .endm tstq .macro until,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z if ,,,,,,,,,,,,,- ,,
,,,,,,,,,, then exit endif endloop .endm until .macro var .endm var .macro vc $andor BVC,BVS .endm vc .macro vs $andor BVS,BVC .endm vs .macro while,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z loop .macro do then .endm do if ,,,,,,,,,,,,,- ,,
~~~~~~,,,~~,,,,,,, else exit endif .endm while~~~~~~~~