d .TITLE ASTMAR .. STAT Macro routines ; Routines required for system STATus ,; ; ival= ML$PEEK( location ) !! Returns I*4 word from LOCATION ; X; ival= ML$EPEEK( location ) !! Returns I*4 word from LOCATION {CMEXEC} ; ; itic= ML$VCPU( inx_proc ) !!returns ticks or process ; ; ndks= ML$VDSK( ndks, dname, #io, iosize, #acp, #err, #oper ) L; -----Pending----- ; ; npid= ML$VJPI( npid, term, stat, prio, jpid, icpu, user, pageflts x; , wscurr, pagtot ) ; @; CALL ML$VPFL( inx, res, free ) !!REServed and FREE of PAGEFILE ; ; nblk= JJNBLK( i12_file_id, counted_device_string ) l; ; iret= ML$VMSPCB( inx, nbyt, ipcb ) 4; ; iret= ML$VMSPHD( inx, nbyt, iphd ) ; ` ; iret= JVDDB( locddb, iddb ) !! Returns DDB info ; ( ; call JVGET( numby, loc, result ) !! Gets bytes ; ;----------------------------------------------------------------- T ; Uses: SYS$LIBRARY:LIB.MLB !!for system macros ;  ; Note: These are Quick and Dirty, I suggest that they work, ; but are probable BAD examples of how to write MACRO, sorry. ; H ; I don't seem to be able to get MMG$GL_PAGSWPVC, and thus ; had to HARD code it in. ;--------------------------------------------------------end.of.info t;  .library /sys$library:lib.mlb/ <; --Def-- ; --Use-- LIB.REQ line ;  $AQBDEF ; ACP queue block h $DDBDEF ; Device data block  $PRDEF ; Process register 0 $IPLDEF ; IPL level definition  $IRPDEF ; I/O request packet  $JPIDEF ; Job Process Info \ $PCBDEF ; Process control block  $PFLDEF ; Page file Ctrl block $ $PHDDEF ; Process header  $SGNDEF ; Systen information {14066}  $UCBDEF ; Unit control block P $VCBDEF ; Volume Ctrl block ; d .PAGE .SBTTL ML$PEEK , ML$EPEEK .. Get data from MEMORY ,; ;;;;;;;;; ; iret= ML$PEEK( mem_loc ) X;;;;;;;;; ;  .PSECT ML$PEEK  .ENTRY ML$PEEK ^M<>  MOVL @4(AP),R0 L MOVL (R0),R0  RET ; ;;; x; ;;;;;;;;; @; iret= ML$EPEEK( mem_loc ) does {CMEXEC} ;;;;;;;;; ; l .ENTRY ML$EPEEK ^M ;; Get data from EXEC memory  MOVL @4(AP),EPEEKL 4 $CMEXEC_S EPEEK  MOVL EPEEKL,R0  RET ` ; EPEEK: .word ^M ( MOVL EPEEKL,R0 MOVL (R0),EPEEKL RET T ; EPEEKL: .LONG 0  ; ;;; ; ;;;;;;;;; H ; itic= ML$VCPU( inx ) ;;;;;;;;; ; t .PSECT ML$VCPU  .entry ML$VCPU ^m ; Entry < movl @4(ap),r1temp  $CMEXEC_S CPUGT  RET h; CPUGT: .word ^m ; Entry 0 movl r1temp,r1 ; Get index  movl SCH$GL_PCBVEC,r2 ; Point to zeroth PCB  movl (r2)[r1],r1 ;; Point to PCB \ blbc PCB$L_STS(r1),nullnm ;; Not in memory  movl PCB$L_PHD(r1),r1 ;; Point to PHD $ movl PHD$L_CPUTIM(r1),r0 ;; Get CPU time in ticks NULLNM:  ret P; r1temp: .long 0 ; ;;; d .PAGE .SBTTL ML$VDSK .. Get disk information, ;;LP !KUDGE! ,; ;;;;;;;;; ; ndsks= ML$VDSK( ins, dname, #io, iosize, #apc, #err, #oper ) X;;;;;;;;; ; Returns {i/o, bytes, acp}pend for DISK ; and Operations and Errors for ; Disk , LP, and TAPE  .PSECT ML$VDSK L .ENTRY ML$VDSK,^M  ;;Uses $AQB,$DDB,$IRP,$UCB,$VCBDEF ; x CLRL VD_NIO ; Init I/O request count  CLRL VD_SIZ ; Initalize SIZE @ CLRL VD_NAC ; Init ACP request count ;  cmpl VD_AGN,#0 ;Check FST time l bneq VLDID ; 4 $CMEXEC_S VLCRE ;;Create list ; VLDID: ` ; movl @4(ap),r3 ; Index of disk ( blss VDERR ; inx=0... cmpl r3,disk_count ; Inx .. Max blss VDOKD ;; .le. legal disk T ; VDERR: ;;ERR Disk #  movl #-1,r0 ;;R0 << -1 RET ; H VDOKD: $CMEXEC_S VDGET ;;Get Disk info ; t mull3 @4(ap),#name_siz,r0 ;Disp of #name  movl l^name_list+2(r0),@8(ap) ;e.g. DRA0 < movl VD_NIO,@12(ap) ;>> Num I/O pend  movl VD_SIZ,@16(ap) ;>> I/O Size pend  movl VD_NAC,@20(ap) ;>> Num ACP pend h movl VD_ERR,@24(ap) ;>> Num Errors  movl VD_NOP,@28(ap) ;>> Num Operations 0 movl @4(ap),r0 ; index of disk  incl r0 ; +1 ; \ RET ; $MAX_DISKS = 16 NAME_SIZ = 16 ; PNAME_LIST: .BLKB MAX_DISKS*NAME_SIZ UCB_LIST: .blkl MAX_DISKS ;;;FIX ; |DISK_COUNT: .LONG 0 VD_AGN: .LONG 0 DVD_NOP: .LONG 0 VD_NIO: .LONG 0 VD_SIZ: .LONG 0 pVD_ERR: .LONG 0 VD_NAC: .LONG 0 8; d .PAGE .sbttl ML$VDSK .. VLCRE .. Creates list ,;;;;;;;;; ; VLCRE: .WORD ^M X; ; Create disk list ;  movl #1,VD_AGN ;Note that the disk list exists  CLRL R3 ; Init device count L MOVAL G^IOC$GL_DEVLIST,R4 ; Get addr of DDB list VLNXD: MOVL (R4),R4 ; Get addr of next DDB  BEQL VLSEC ; If EQL, done x MOVL DDB$L_UCB(R4),R6 ; Get addr of first UCB  CMPB UCB$B_DEVCLASS(R6),#DC$_LP ;;LP Is device a LP? @ BEQL VLNXL ;;LP If a LINE PRINTER  CMPB UCB$B_DEVCLASS(R6),#DC$_TAPE ;;LP Is device a tape  BEQL VLNXT ;;LP If a TAPE l CMPB UCB$B_DEVCLASS(R6),#DC$_DISK ;;LP Is device a disk?  BNEQ VLNXD ; If not LP or Disk 4; VLNXU:  BBS #DEV$V_FOR,UCB$L_DEVCHAR(R6),VLFIN ; if foreign ` ; VLNXT: ( BBC #DEV$V_MNT,UCB$L_DEVCHAR(R6),VLFIN ; if not mounted ; VLNXL: T MOVL R6,UCB_LIST[R3] ; Save the UCB addr MULL3 #NAME_SIZ,R3,R0 ; Compute name index  PUSHAB NAME_LIST[R0] ; Compute name buf addr MOVL #NAME_SIZ-1,R0 ; Set buffer size ADDL3 #1,(SP),R1 ; Set buffer addr H JSB G^IOC$CVT_DEVNAM ; Get the device name MOVB R1,@(SP)+ ; Save name size  INCL R3 ; Increment number found t; VLFIN: MOVL UCB$L_LINK(R6),R6 ; Get addr of next UCB < BNEQ VLNXU ; If NEQ there is one  BRB VLNXD ; Else, try next device ; hVLSEC: MOVL R3,DISK_COUNT ; Save # of disks found  RET 0; d .PAGE .SBTTL ML$VDSK .. VDGET .. Compute waiting io, acp ,;;;;;;;;; ; VDGET: .word ^M X;  MOVL UCB_LIST[R3],R5 ; Get UCB address  MOVW UCB$W_ERRCNT(R5),VD_ERR ; move the error count  movl UCB$L_OPCNT(R5),VD_NOP ; Move the # of Oper.  CMPB UCB$B_DEVCLASS(r5),#DC$_DISK ;;LP Is device a disk? L BNEQ vdret ;;LP if not a Disk ; ; Total-up number of I/O requests queued to driver x;  BBC #UCB$V_BSY,UCB$W_STS(R5),VDIDL ; If not busy >> @ INCL VD_NIO ; Current I/O  MOVL UCB$L_IRP(R5),R0 ; addr of I/O req  MOVZWL IRP$W_BCNT(R0),R0 ; Get transfer size l ADDL R0,VD_SIZ ; Add to size total ; 4VDIDL: MOVAL UCB$L_IOQFL(R5),R6 ; Get addr of request listhead  MOVL R6,R7 ; Save a copy of it ; ` VDNXR: MOVL (R6),R6 ; addr of next request CMPL R6,R7 ; End of list? ( BEQL VDSTA ; If EQL yes - no more requests CMPL VD_NIO,#99 ; Probably stuck? ////temp//// BGEQU VDSTA ; If GEQU yes ////temp/// T INCL VD_NIO ; Increment request count MOVZWL IRP$W_BCNT(R6),R0 ; Get transfer size  ADDL R0,VD_SIZ ; Add to size total BRB VDNXR ; Try next one ; H ; Total-up requests queued to ACP ; VDSTA: MOVL UCB$L_VCB(R5),R6 ; Get address of VCB t BEQL VDFNA ; If EQL none - dismounted  MOVL VCB$L_AQB(R6),R6 ; Get address of request queue < MOVL R6,R7 ; Get address of listhead ; VDNXA: MOVL (R7),R7 ; Get address of next request h CMPL R7,R6 ; End of list?  BEQL VDFNA ; If EQL yes - no more 0 CMPL VD_NAC,#99 ; Probably stuck? ////temp////  BGEQU VDFNA ; If GEQU yes /////temp/////  INCL VD_NAC ; Increment ACP request count \ BRB VDNXA ; Get next one  $VDFNA: ; VDRET: ;; Exit from ML$VDSK P RET ; d .PAGE .SBTTL ML$VJPI ;; Get minimum JPI data ,; ;;;;;;;;; ; npid= ML$VJPI( npid, term, stat, prio, jpid, icpu, usr, pf X; wscurr, pagtot ) ;;;;;;;;; ;  .PSECT ML$VJPI  .ENTRY ML$VJPI,^M<> ;;uses $JPIDEF L movl @4(ap),jpid  movl 8(ap),jterp  movl 12(ap),jstap x movl 16(ap),jprip  movl 20(ap),jpidp @ movl 24(ap),jcpup  movl 28(ap),jusrp  movl 32(ap),jpagp l movl 36(ap),jwrkp  movl 44(ap),jprnp 4 $getjpi_s pidadr=jpid,itmlst=jdisc  addl3 lglo,lpro,@40(ap)  movl jpid,@4(ap) ` RET ; ( ;; jpi return ; jpid: .long 0 T ; jdisc: .word 4,jpi$_terminal ;;Format .. Avail_leng, Key  jterp: .long 0,0 ;;Dest_loc, Dest_for_leng .word 2,jpi$_pri jprip: .long 0,0 H .word 2,jpi$_state jstap: .long 0,0  .word 4,jpi$_pid tjpidp: .long 0,0  .word 4,JPI$_cputim <jcpup: .long 0,0  .word 12,JPI$_username jusrp: .long 0,0 h .word 4,JPI$_PAGEFLTS jpagp: .long 0,0 0 .word 4,JPI$_WSSIZE jwrkp: .long 0,0  .word 4,JPI$_GPGCNT \ .long lglo,0  .word 4,JPI$_PPGCNT $ .long lpro,0  .word 15,JPI$_PRCNAM jprnp: .long 0,0 P .long 0 ;End of JPI list ; lglo: .long 0 |lpro: .long 0 ; ;;; d .SBTTL ML$VPFL ;; Get page file data .PAGE ,; ;;;;;;;;; ; call ML$VPFL( inx, res, free ) X;;;;;;;;; ;  .PSECT ML$VPFL  .ENTRY ML$VPFL ^M<> ;;uses $PFLDEF  movl @4(ap),r1 ;Get index of block L;;;;;; movl @MMG$GL_PAGSWPVC[r1],r1 ;Get control vector  movl @^X80001C34[r1],r1 ;!KLUDGE!  movl PFL$L_RESERVCNT(r1),@8(ap) ;Put Reserved x movl PFL$L_FREPAGCNT(r1),@12(ap) ;Put Free  RET @; ;;; ; d .page .SBTTL JJNBLK .. Return number of blocks in a file ,; ;;;;;;;;; ; num_blocks = jjnblk( seqnum:fileid, counted_device_string ) X;;;;;;;;; ; ; end.of.info ;  .psect jjnblk,long L;  .entry jjnblk,^m  movl @4(ap),n+nam$w_fid x movl #^x41524404,n+nam$t_dvi  movl #^x00000030,n+nam$t_dvi+4 @ moval @8(ap),r2  movl (r2),n+nam$t_dvi  movl 4(r2),n+nam$t_dvi+4 l $open fab=f  $close fab=f 4 movl x+xab$l_ebk,r0  movl #0,x+xab$l_ebk  ret ` ; .align long ( f: $fab - fop=,- xab=x,- T nam=n .align long  n: $nam ; x: $xabfhc H ; ;;; ; d .page .sbttl ML$VMSPCB .. Get PCB and PHD information ,; ;;;;;;;;; ;;;;;;;;; X; IRET= ML$VMSPCB( inx, nbyt, ides ) ; ;Out ML$VMSPCB -- The Location of the PCB (0:end) ;Inp inx -- The index 0...N of the task ;Inp nbyt -- The number of bytes to be transfed L;Out ides -- The Contents of the PCB ;;;;;;;;; ; x .PSECT ML$VMSPCB  .entry ML$VMSPCB,^m @;  movl ap,r9 ;;old AP pointer  clrl r0 l cmpw SGN$GW_MAXPRCCT,@4(ap) ;; MAX_PRC ~~ Inx  blequ pcbend 4 $CMEXEC_S getpcb pcbend:  ret ;;;;;;;;; ` ; getpcb:: .word ^M<> ( movl @4(r9),r8 ; INX of task movl SCH$GL_PCBVEC,r7 ; Addr of PCB(0) moval (r7)[r8],r6 ; Addr of pcb(inx) T movc3 @8(r9),@(r6),@12(r9) ; Move PCB ;  movl (r7)[r8],r0 ; Ret pb(inx) ret ;;;;;;;;; ; ;;; H ; .PSECT VMSPHD ; t;;;;;;;;; ; IRET= ML$VMSPHD( inx, nbyt, ides ) <; ;Out ML$VMSPHD -- The Location of the phd (0:end, 1:swap) ;Inp inx -- The index 0...N of the task h;Inp nbyt -- The number of bytes to be transfed ;Out ides -- The Contents of the phd 0;;;;;;;;; ;  .entry ML$VMSPHD,^m \;  movl ap,r9 ;;old AP pointer $ clrl r0  cmpw SGN$GW_MAXPRCCT,@4(ap) ;; MAX_PRC ~~ Inx  blequ phdend P $CMEXEC_S getphd phdend:  ret ;;;;;;;;; |; getphd:: .word ^M<> D movl @4(r9),r8 ; INX of task  movl SCH$GL_PCBVEC,r7 ; Addr of PCB(0)  movl (r7)[r8],r6 ; Addr of PCB(inx) p movl #1,r0 ; Swap return  blbc PCB$L_STS(r6),getend ; .. Yes swapped 8 moval PCB$L_PHD(r6),r6 ; PHD addr  movc3 @8(r9),@(r6),@12(r9) ; Move phd ; d movl (r7)[r8],r0 ; Ret pb(inx) getend: , ret ;;;;;;;;; ; d; ;Has: JVDEV, JVGET ,;-------------------------------------------------------end.of.info ; ; FUNCTION JVDDB( locddb, iddbblk ) X; Return the DDB information ;  .entry JVDDB,^M ;  movl ap,r10 ; Save the ap L $CMEXEC_S getddb ;;; CALL  ret ; ;;; x; getddb: .word ^M @ movl @4(r10),r3 ; Point to last DDB  bneq nxtddb ;; There was one  moval G^IOC$GL_DEVLIST,r3 ; Point to DDB Chain l; nxtddb: 4 movl (r3),r3 ; Point to next  movl r3,@4(r10) ; Update pointer  beql finddb ;; No next ` ; movc3 #52,(r3),@8(r10) ; Move block ( ; finddb: ret T ; ;;; ;  ; SUBROUTINE JVGET( nbyt, Addr_from, to ) ; Get Nbyt's from From into To ; H .entry JVGET,^M movl ap,r10 ; Save the AP  $CMEXEC_S getmem ;;; CALL t ret ; ;;; <; getmem: .word ^M  movl @8(r10),r2 h movc3 @4(r10),(r2),@12(r10) ; Move the data  ret 0; ;;; ;  .end