%begin %recordformat comf(%integerarray i1(1:25),%byteintegerarray b1(1:8), %integerarray i2(1:9),%longinteger l1, %integerarray i3(1:9),%integer MAXPROCS, %integerarray i4(1:4),%integer PROCAAD) %constrecord(comf)%name com=X'80000000'+48<<18 %integerfn VAL(%integer adr,len,rw,psr) %integer inseg0,beyondseg0,seg0,seg0ad,dr0 seg0=adr>>18 %result=0 %unless 0>18 %start seg0ad=seg0<<18 inseg0=X'400000'-(adr-seg0ad) beyondseg0=len-inseg0 %result=VAL(adr,inseg0,rw,psr)&VAL(adr+inseg0,beyondseg0,rw,psr) %finish dr0=x'18000000'!len *LDTB_DR0 *LDA_ADR *VAL_PSR *JCC_8, *JCC_4, *JCC_2, %result=0 CCZER:%result=1;!read&write OK CCONE:%if rw=1 %thenresult=0 %elseresult=1;!read 0K but not write CCTWO:%if rw=0 %thenresult=0 %elseresult=1;!write OK but not read %end %integerfn DPROCS(%integername max,%integer adr) %systemroutinespec move(%integer len,from,to) %integer ok %constinteger entrylen=32 max=com_maxprocs OK=val(com_procaad,max*entrylen,0,0) %if OK#1 %start printstring("VALIDATE FAILS!") newline %stop %finish move(max*entrylen,com_procaad,adr) %result=0 %end %routine idprocs %integer j,max,adr,l,k %byteintegerarray plist(0:32*256) %stringname user l=0 max=256 adr=addr(plist(0)) j=dprocs(max,adr) %returnif j#0 %cycle k=0,1,max-1 user==string(addr(plist(32*k))) %unless user="" %start write(k,3) space printstring(user) l=l+1 l=0 %and newline %if l=6 %finish %repeat newline %unless l=0 %end IDPROCS %endofprogram