.TITLE DSR .IDENT /V2.0/ ; DANIEL STEINBERG ;+ ; -- DSR -- ;TAKE A PEEK AT RSX11M SYSTEM POOL AND PRINT A QUICK FRAGMENTATION MAP ; ; IF $ROVER IS NOT ZERO, NEXT ALLOCATION LOCATION IS MARKED ; ;- CR=15 LF=12 ESC=33 ;SOROC CURSOR CONTROL FOLLOWS....CURSOR POSITIONING IS <=> ; SCREEN ERASE IS <*> CLR1=ESC CLR2='* CURS1=ESC CURS2='= MAXF=80. ;MAX NUMBER OF FRAGMENTS FRGPER=7 ;NUMBER OF FRAGMENTS PER LINE LINSZ=79. ;BUFFER SIZE FOR QIO .MACRO PUSH X MOV X,-(SP) .ENDM .MACRO POP X MOV (SP)+,X .ENDM .MCALL DIR$,GMCR$,EXIT$S,QIOW$S,MRKT$S,WTSE$S,QIO$S START: CALL INIT ;GET SOME QUICK ANSWERS TST TIX ;ONCE THRU? BEQ 10$ ;YUP QIOW$S #IO.ATA,#5,#1,,,,<#AST> 10$: CALL PEEK ;SCAN EXEC CALL TELL ;SHOW AND TELL TST TIX ;ONCE THROUGH? BEQ EXIT ;YUP MRKT$S #2,TIX,#1 ;SET AN ALARM WTSE$S #2 ;AND SLEEP BR 10$ ;TRY AGAIN AST: WTSE$S #1 ;WAIT FOR OUTSTANDING TERMINAL I/O EXIT: EXIT$S ;BYE BYE INIT: DIR$ #GMCR ;GET MCR COMMAND LINE BCC 5$ ; IF ONE, USE IT ; IF NONE, PRINT PROMPT AND GET ANSWER QIOW$S #IO.RPR,#5,#1,,,,<#INBUF,#50.,,#PMT,#PMTS,#0> ;GET #TICKS 5$: MOV #INBUF,R0 ;POINT TO NUMBER CALL $CDTB ;CONVERT TO BINARY (FROM DECIMAL) MOV R1,TIX ;SET NUMBER (0 MEANS ONCE THRU) MOV $EXSIZ,R1 ;GET TOP OF POOL ADDRESS SUB #$POOL,R1 ;SUBTRACT BOTTOM MOV #TOTM,R0 ;POINT TO DST MOV #25012,R2 ;UNSIGNED, FIVE DIGITS, ZERO FILL, BASE TEN CALL $CBTA ;CONVERT TO ASCII RETURN PEEK: MOV #NFRAG,R5 ;POINT TO DATA BLOCK CLR (R5)+ ;CLEAR NUMBER OF FRAGMENTS CLR (R5)+ ;AND SIZE OF BIGGEST ONE CLR (R5) ;CLEAR ACCUMULATOR MOV #1,RVFRAG ;DEFAULT SEARCH LISTHEAD IS FIRST FRAGMENT MOV #FREE,R4 ;POINT TO FRAGMENT LIST CALL $SWSTK,100$ ;BECOME AN EXEC ROUTINE MOV $PKNUM,IOPACK ;;GET NUMBER OF I/O PACKETS AVAILABLE MOV #$CRAVL,R0 ;;GET FREE POOL LISTHEAD TST #$ROVER ;;ANY ROVING ALLOCATION PTR? BEQ 10$ ;; NO MOV $ROVER,ROVER ;; YES, GET VALUE BNE 15$ ;; SKIP IF NOT DEFAULTED 10$: MOV R0,ROVER ;;DEFAULT LISTHEAD IS $CRAVL 15$: MOV @ROVER,ROVER ;;GET ADDRESS OF 1ST FRAG CHECKED 20$: MOV (R0),R0 ;;GET NEXT LINK BEQ 30$ ;;NONE...THAT'S ALL MOV 2(R0),R1 ;;GET SIZE OF THIS PIECE ADD R1,(R5) ;;ACCUMULATE FREE SPACE CMP R1,-(R5) ;;BIGGER THAN BIG? BLOS 25$ ;;NOPE MOV R1,(R5) ;;YUP...SET NEW BIG 25$: INC -(R5) ;;BUMP NFRAG CMP R0,ROVER ;;IS THIS THE LISTHEAD? BNE 27$ ;; NOPE MOV (R5),RVFRAG ;; YES..SAVE THE FRAGMENT NUMBER 27$: CMP (R5)+,#MAXF ;;GOT TOO MANY? BGT 28$ ;;YUP...QUIT STORING DATA, THEN ASR R1 ;;NO...DIVIDE BY FOUR ASR R1 ;;....TO GET BLOCK SIZE MOV R1,(R4)+ ;;....SAVE SIZE 28$: TST (R5)+ ;;POINT TO LEFT BR 20$ ;;AND TRY NEXT CHUNK 30$: RETURN ;;BACK TO TASK STATE 100$: ASR BIG ;SET TO WORDS ASR BIG ;SET TO 4-BYTE BLOCKS ASR LEFT ASR LEFT RETURN ;AND BACK TO CALLER TELL: CLR OCTR ;CLEAR OUTPUT COUNTER MOV #OBUF,OPTR ;RESET OUTPUT PTR CLR OFLG ;SET NO OUTSTANDING QIO FLAG MOV #PKT,R0 ;SET ADDRESS FOR NUMBER OF PACKETS MOVB IOPACK,R1 ;GET NUMBER MOV #13012,R2 ;TWO DIGITS UNSIGNED DECIMAL...SPACE FILL CALL $CBTA ;CONVERT MOVB #'.,(R0)+ MOVB #'/,(R0)+ ;NOW DO MAX AVAILABLE MOVB IOPACK+1,R1 MOV #13012,R2 CALL $CBTA MOV #BUF1,R0 ;SET PTR FOR INITIAL OUTPUT MOV #OUT1,R1 ;AND SIZE CALL OUTPUT ;AND SEND IT OUT MOV #BUF2,R0 ;SET PTR FOR NEXT STUFF MOV BIG,R1 ;GET SIZE OF BIGGEST CHUNK CALL OUT10 ;CONVERT TO DECIMAL MOVB #':,(R0)+ ;AND MAKE READABLE MOV LEFT,R1 ;FOLLOW RMD FORMAT CALL OUT10 MOVB #':,(R0)+ MOV NFRAG,R1 CALL OUT10 MOVB #CR,(R0)+ MOVB #LF,(R0)+ MOVB #LF,(R0)+ CALL OUT2 ;SEND OUT THE BUFFER ; ;NOW OUTPUT A MAP OF FREE SPACE ; MOV #FREE,R3 CLR R5 ;CLEAR COUNTER MOV NFRAG,R4 ;GET NUMBER OF FRAGMENTS CMP R4,#MAXF ;TOO MANY? BLE 20$ ;NO MOV #MAXF,R4 ;YES...ONLY DO MAX NUMBER 20$: MOV (R3)+,R1 ;GET NEXT FRAGMENT SIZE MOV #43012,R2 ;SPACE FILL, BASE 10, 8 DIGITS, UNSIGNED CALL $CBTA ;CONVERT DEC RVFRAG ;IS THIS THE LISTHEAD? BNE 25$ ; NO MOVB #'@,-7(R0) ; YES...MARK IT MOVB #'-,-6(R0) MOVB #'>,-5(R0) 25$: INC R5 ;COUNT NUMBERS PER LINE CMP R5,#FRGPER ;GOT FULL LINE? BLT 40$ ;NOT YET MOVB #CR,(R0)+ ;ADD CR/LF MOVB #LF,(R0)+ CALL OUT2 ;YES...SEND OUT THE LINE CLR R5 40$: SOB R4,20$ ;AND LOOP CALL OUT2 ;MAKE SURE ALL ARE OUT CALL FLUSH ;FLUSH THE OUTPUT BUFFER RETURN ;AND RETURN OUT2: MOV R0,R1 ;GET END ADDRESS MOV #BUF2,R0 ;POINT TO START SUB R0,R1 ;GET SIZE BEQ 10$ ;...ZERO CALL OUTPUT ;SEND OUT LINE MOV #BUF2,R0 ;RESET PTR 10$: RETURN ;THAT'S ALL OUT10: MOV #24012,R2 ;UNSIGNED DECIMAL, NO FILL, 5 DIGITS CALL $CBTA ;CONVERT MOVB #'.,(R0)+ ;TACK ON A DP RETURN OUTPUT: PUSH R4 ;SAVE REGS PUSH R5 MOV OPTR,R5 ;GET OUTPUT PTR MOV OCTR,R4 ;AND CTR 10$: MOVB (R0)+,(R5)+ ;STUFF A CHAR INC R4 CMP R4,#LINSZ ;FULL LINE? BLT 40$ ;NOT YET TST OFLG ;OUTSTANDING QIO? BEQ 15$ ;NO WTSE$S #1 ;YES...WAIT FOR IT CLR OFLG ;CLEAR FLAG 15$: SUB #LINSZ,R5 ;POINT TO START OF LINE QIO$S #IO.WAL,#5,#1,,,, ;START A WRITE TO LUN 5 INC OFLG ;SET FLAG ADD #LINSZ,R5 ;GET PTR BACK CMP R5,#OEND ;AT END? BLO 25$ ;NOPE..IN MIDDLE MOV #OBUF,R5 ;YES...SET TO START 25$: CLR R4 ;CLEAR COUNT 40$: SOB R1,10$ ;LOOP THRU BUFFER MOV R4,OCTR ;RESET STUFF MOV R5,OPTR POP R5 POP R4 RETURN FLUSH: TST OCTR ;EMTPY BUFFER? BEQ 10$ ;YES MOV #BUF3,R0 ;NO...TRY APPENDING A NULL MOV #1,R1 CALL OUTPUT BR FLUSH ;AND TRY AGAIN 10$: TST OFLG ;BUFFERS EMPTY...QIO DONE? BEQ 20$ ;YUP WTSE$S #1 ;NO...WAIT CLR OFLG ;DONE NOW 20$: CLR OCTR MOV #OBUF,OPTR ;RESET STUFF RETURN ;DATA ;THE FOLLOWING 3 WORDS MUST BE IN ORDER!!! IOPACK: .WORD NFRAG: .WORD BIG: .WORD LEFT: .WORD ROVER: .WORD ;ADDRESS OF ALLOCATION LISTHEAD RVFRAG: .WORD ;FRAGMENT NUMBER OF LISTHEAD FREE: .BLKW MAXF ;DATA STORAGE FOR FRAG INFO TIX: .WORD BUF1: .BYTE CLR1,CLR2,0,0,0 ;CLEAR SCREEN .BYTE CURS1,CURS2,37+1,37+12 ;SET CURSOR .BYTE CR,LF,LF .ASCII /TOTAL: / TOTM: .BLKB 5 .ASCII /. PACKETS: / PKT: .BLKB 6 .ASCII /. / OUT1=.-BUF1 BUF3: .BYTE 0 .EVEN BUF2: ;OUTPUT BUFFER OVERLAYS INPUT BUFFER GMCR: GMCR$ ;GET COMMAND LINE BUFFER INBUF=GMCR+G.MCRB+4 ;POINT PAST 'DSR ' IN COMMAND LINE .BLKB 80.- ;MAKE SURE THERE IS ENUF SPACE .EVEN OPTR: .WORD OBUF OCTR: .WORD OFLG: .WORD OBUF: .BLKB 2*LINSZ OEND=. PMT: .BYTE CLR1,CLR2,0,0,0 .ASCII /DSR -- TIME WINDOW IN TICKS? / PMTS=.-PMT .EVEN .END START