.TITLE  PMP
	.IDENT	/GCE002/; G. EVERHART JULY 25, 1976
; AUTHOR: PETER WANNHEDEN
;
	;MODIFIED BY
;	H.A. NICHOLS 7/22/74
; ADAPTED FOR V6B BY:
;	G.C. EVERHART 25-JUL-76
;+
; THIS IS AN MCR FUNCTION TO DISPLAY THE TASKS THAT
; ARE ACTIVE AND/OR FIXED IN A SPECIFIED PARTITION.
; CALL:
;       MCR>PMP PARNAM <CR>/<AM>
;
; IT IS A PRIVILEGED TASK, AND USES LUN 6 FOR OUTPUT.
;  PMP IS A VARIATION OF MAP THAT WILL OMIT BOTH THE HEADER
; AND THE USUAL TASKS THAT ARE ALWAYS PRESENT FROM ITS
; DISPLAY. THE PRESENT LIST WILL OMIT ALL DEVICE HANDLERS,
; F11ACP, SYSRES, TTLIBA AND TTLIBB. HOLES AND ALL USER
; TASKS WILL BE LISTED IN ORDER. IF NO PARTITION NAME IS
; GIVEN, "GEN" WILL BE ASSUMED.
;
; NOTES:
; 1. IF THE PARTITION CONTAINS MORE THAN APPROX. 15 TASKS,
; ONLY THE 1ST 15 WILL BE SHOWN, IN ATL ORDER.
; TO INCREASE THIS CAPABILITY, ADD 4 WORD TO THE STACK SIZE FOR
; EACH EXTRA TASK AT TASK BUILD TIME.
; 2. THE TASK DOES NOT ATTACH THE OUTPUT DEVICE.
;
; TKB PROCEDURE:
; PMP/PR/-TA/-FP=PMP,[1,1]EXEC.STB
; /
; TASK=...PMP
; STACK=76
; ASG=TI:6
; /
;-
;
.MCALL  DIR$,QIO$,EXIT$S,WTSE$S
.MCALL  GMCR$
.MCALL  CALL,RETURN
;
LF      =12
CR      =15
SPACE   =40
ALTMOD  =33
PSW     =177776
;
PARNAM: .BLKW   2
STKBAS: .WORD   0
STKB1:  .WORD   0
PREVHI: .WORD   0
PARTHI: .WORD   0               ;PARTITION HIGH LIMIT
MRLLH:  .WORD   0
DPBQIO: QIO$    IO.WVB,6,1,,,,<0,0,SPACE>
DPBGMC: GMCR$
;NOTE--HEADER NOT PRINTED IN THIS TASK...DEFINITIONS LEFT OVER FROM ...MAP
HEADER: .BYTE   H2-H1
H1:     .BYTE   CR,LF
        .ASCII  /MAP OF PARTITION /
PARSTR: .BLKB   6
        .BYTE   CR,LF
        .ASCII  /LOW  LIMIT: /
PARLO:  .BLKB   6
        .ASCII  /00/<CR><LF>
        .ASCII  /HIGH LIMIT: /
PARHI:  .BLKB   6
        .ASCII  /00/<CR><LF><LF>
H2      =.
HOLELN: .BYTE   HO2-HO1
HO1:    .ASCII  /<HOLE>    /
HOLELO: .BLKB   6
        .ASCII  /00    /
HOLEHI: .BLKB   6
        .ASCII  /00/
HO2     =.
;FORCE TSKNAM TO BE AT AN EVEN ADDRESS.
	.ODD
LINE:   .BYTE   L2-L1
L1:
TSKNAM: .BLKB   6
        .ASCII  /    /
LOADR:  .BLKB   6
        .ASCII  /00    /
HIADR:  .BLKB   6
        .ASCII  /00  /
AFIELD: .ASCII  /  /
FFIELD: .ASCII  / /
L2      =.
ERMSG:  .BYTE   E12-E11
E11:    .ASCII  /PMP -- NO SUCH PARTITION/
E12     =.
        .EVEN
;

PMP:	MOV     #DPBGMC+G.MCRB+3,R0
        MOV     #PARSTR,R2      ;MOVE PARTITION NAME STRING INTO "PARSTR"
        MOV     R2,R4
        CLR     R1
	DIR$    #DPBGMC         ;GET COMMAND LINE
        BCS     4$
1$:     CMPB    (R0)+,#SPACE    ;IGNORE SPACES FOLLOWING "PMP"
        BEQ     1$
        DEC     R0
2$:     CMPB    @R0,#CR         ;CHECK FOR LINE TERMINATOR
        BEQ     3$
        CMPB    @R0,#ALTMOD
        BEQ     3$
        MOVB    (R0)+,(R4)+
        INC     R1              ;COUNT CHARACTERS IN R1
        CMP     R1,#6
        BLT     2$
3$:	TST	R1		;ANY PARTITION GIVEN?
	BNE	5$		;YES
4$:	MOV	#3,R1		;NO, USE DEFAULT
	MOVB	#'G,(R4)+	;FILL IN "GEN" HERE. MODIFY TO CHANGE DEFAULT.
	MOVB	#'E,(R4)+
	MOVB	#'N,(R4)+
5$:     MOV     #PARNAM,R3      ;CONVERT PART. NAME TO RAD50
        CALL    @#..ATRD
;
; SEARCH TPD FOR THIS PARTITION
;
STPD:   MOV     .TPDBA,R4       ;TPD START ADDRESS
2$:     CMP     T.PN(R4),PARNAM ;FIRST HALF OF NAME MATCHES?
        BNE     1$              ;NO - JUMP
        CMP     T.PN+2(R4),PARNAM+2 ;SECOND HALF MATCHES?
        BEQ     PRHEAD          ;YES - JUMP
1$:     ADD     #T.SZ,R4        ;FIND NEXT ENTRY
        CMP     R4,.TPDEA       ;POINTING OUTSIDE TPD?
        BLO     2$              ;NO - LOOP
        MOV     #ERMSG,R5
        CALL    PRINT
	JMP     EXIT
;
PRHEAD: MOV     T.BA(R4),R1     ;R1 = PART. BASE ADRS
        MOV     R1,PREVHI       ;INITIALIZE PREVHI
        MOV     #PARLO,R2       ;CONVERT BASE ADRS TO ASCII
        CALL    OTA
        MOV     T.BA(R4),R1
        ADD     T.PZ(R4),R1     ;R1 = PART. HIGH LIMIT
        MOV     R1,PARTHI
        ADD     #T.RF,R4        ;R4 = MRL LIST HEAD ADRS
        MOV     R4,MRLLH
        MOV     #PARHI,R2       ;CONVERT TO ASCII
        CALL    OTA
        MOV     #HEADER,R5      ;PRINT HEADER
;;;	CALL    PRINT	;***REMOVED FROM SHORTENED VERSION 11/16/78
        MOV     SP,STKBAS       ;STKBAS = SP
        MOV     SP,STKB1
        SUB     #10,STKB1       ;STKB1 = SP-10
;

;SEARCH GCD FOR COMMONS LIKE SYSRES, ETC.
;
SGCD:	MOV	#.GCDLH,R1	;LIST HEAD
	MOV	R1,R2	;SAVE TO SEE WHEN WE GET TO END
1$:	MOV	@R1,R1	;GET GCD ENTRY
	CMP	R1,R2
	BEQ	40$	;WHEN AT END, LEAVE
	CMP	G.BA(R1),PREVHI	;BASE BELOW PARTITION BASE?
	BLO	1$	;YES, GET NEXT ONE
	CMP	G.BA(R1),PARTHI	;STILL IN PARTITION?
	BHIS	1$	;NO, TRY NEXT ENTRY IF ANY
;HERE WE HAVE TO BE SOMEWHAT TRICKY AND SET A FLAG TO INDICATE
;UNPACKING AS A GCD ENTRY, NOT A TASK.
GCDENT=177777	;SET UNIQUE "FLAG" FOR GCD ENTRIES
	MOV	#GCDENT,-(SP)	;SHOVE ONTO STACK
	MOV	G.CZ(R1),-(SP)	;STASH SIZE
	MOV	G.BA(R1),-(SP)	;AND BASE ADDR
	MOV	R1,-(SP)	;AND GCD ENTRY ADDRESS
	BR	1$
40$:	;HERE CONTINUE.
;
;HERE SET UP A FLAG INTERNALLY TO HANDLE THE FTL.
;
;THE FTL IS COMPOSED OF ATL NODES, SO JUST SET A FLAG HERE AND USE
;THE ATL HANDLING CODE TWICE.
;
	MOV	#2,(PC)+
FTLFLG:	.WORD	0	;IMPURE---BUT SO WHAT??
;	AT END, WE TEST THIS FLAG AND BRANCH BACK TO SSTD
	MOV	#.FTLLH,R1	;GET LISTHEAD
	BR	ATLFMT	;THEN GO TO COMMON CODE
;
; SEARCH STD FOR ALL TASKS THAT ARE ACTIVE AND/OR FIXED,
; AND RESIDE IN THIS PARTITION.
;
;SSTD:   MOV     @#.STDTA,R1     ;BEGINNING OF ALPHA TABLE
;        MOV     @#.STDTZ,R2     ;ALPHA TABLE SIZE (BYTES)
SSTD:	MOV	#.ATLLH,R1	;GET ATL LISTHEAD
ATLFMT:	MOV	R1,R2		;SAVE SO WE CAN RECOGNIZE END OF LIST
        MOV     @#PSW,R5        ;INHIBIT TASK SWITCHING
        BIS     #140,@#PSW
2$:	MOV	@R1,R1		;POINT TO NEXT ATL ENTRY
	MOV	A.TD(R1),R3	;GET STL ENTRY ADDRESS IN R3
	CMP	R1,R2		;ARE WE AT END OF LIST NOW?
	BEQ	3$		;SURE ARE. NOW PRINT THE STUFF
        CMP     A.HA(R1),PREVHI ;TASK BASE ADRS < PART. BASE ADRS?
        BLO     1$              ;YES - JUMP
        CMP     A.HA(R1),PARTHI ;TASK BASE ADRS >= PART. HIGH LIMIT?
        BHIS    1$              ;YES - JUMP
	BIT	#AF.CP,A.TF(R1)	;TEST IF TASK IS CHECKPOINTED
	BNE	1$		;IF IT IS, IGNORE IT.
;
;SINCE V6 SUPPORTS M/U TASKS, LOOK IN STD ENTRY FOR ANY PURE
;AREA POINTERS AND SAVE THEM.
;
	TST	S.GC(R3)	;ANY COMMONS THERE?
	BEQ	5$		;NO, FORGET THIS
	MOV	S.GC(R3),R4	;R4 AVAIL.
	BIT	#SF.MU,S.FW(R3)	;CHECK THAT THE TASK IS REALLY M/U
	BEQ	5$	;IF NOT, HIS PURE AREA IS SYSRES OR SUCH
	;FINAL CHECK--LOOK IN GCD ENTRY AND SEE IF HDR POINTS TO
	;THE STD OR IF IT IS NULL
	TST	@R4	;IS IT NULL?
	BEQ	65$	;YES, MUST BE FROM THE TASK
	;IF NOT NULL IT MUSTN'T HAVE BACK POINTER HERE
	MOV	R3,-(SP)
	ADD	#S.GC,@SP	;GET ADDR OF STD NODE
	CMP	(SP)+,2(R4)	;IF IT DOESN'T POINT HERE + ISN'T
				;NULL IT'S A SYSTEM COMMON
	BNE	5$
65$:
	MOV	#PURSEC,-(SP)	;FLAG A PURE AREA FOR LATER
	MOV	G.CZ(R4),-(SP)	;PUT SIZE ON STACK
	MOV	G.BA(R4),-(SP)	;ALSO BASE ADDR
	PURSEC=1777	;SPECIAL VALUE FOR PURE SECTIONS
	MOV	R3,-(SP)	;SAVE STD POINTER
;
; FIND OUT IF TASK IS IN THE MRL BELONGING TO THIS PARTITION
; IF IT IS, IGNORE IT.
;
5$:     MOV     MRLLH,R4        ;R4 POINTS TO MRL LIST HEAD
6$:     MOV     @R4,R4          ;R4 POINTS TO NEXT NODE IN MRL
        CMP     R4,MRLLH        ;BACK TO LIST HEAD?
        BEQ     4$              ;YES - JUMP
        CMP     A.TD(R4),R3     ;MRL TASK = STD TASK?
        BEQ     1$              ;YES - IGNORE IT
        BR      6$              ;NO - FIND NEXT MRL NODE
4$:
        MOV     S.FW(R3),-(SP)  ;TASK IS IN PARTITION - SAVE FLAG WORD
;FIX UP THE WORD WITH STATUS INDICATOR TOO
ACTTSK=2000	;USE THIS BIT FOR ACTIVE
	BIC	#ACTTSK,@SP	;CLEAR IT ON STACK
	CMPB	A.TS(R1),#TS.RUN	;CHECK ACTIVE STATUS
		;(N.B. I DON'T REALLY KNOW WHAT THE ACTIVE STATUS SYMB
		;IS, SO EDIT IT LATER IF YOU FIND OUT.)
	BNE	20$
	BIS	#ACTTSK,@SP
20$:
        MOV     S.TZ(R3),-(SP)  ;SAVE SIZE
	MOV	A.HA(R1),-(SP)	;---AND BASE ADDRESS
        MOV     R3,-(SP)        ;-- AND STD ENTRY ADDRESS
        CMP     SP,#40          ;OUT OF SPACE?
        BLO     3$              ;YES - JUMP
1$:	CMP	R1,#.ATLLH	;CHECK AGAIN THAT WE'RE NOT PAST END
	BNE	2$		;KEEP GOING TILL WE ARE DONE
3$:     MOV     R5,@#PSW        ;REENABLE TASK SWITCHING
	TST	FTLFLG		;PASS 1?
	BEQ	SORT		;YES, NOW IT'S TIME TO SORT THE MESS
	CLR	FTLFLG
	JMP	SSTD		;NOT YET--GOTTA DO ATL FIRST
;
; SORT THE 4-WORD ENTRIES ON THE STACK IN THE ORDER THE CORRESPONDING
; TASKS OCCUPY MEMORY.
;
SORT:   CLR     R1              ;R1 IS USED TO FLAG IF ANY CHANGE WAS DONE
        MOV     SP,R0           ;  DURING THE LAST PASS
2$:     CMP     R0,STKB1        ;THIS PASS DONE?
        BHIS    3$              ;YES - JUMP
        CMP     2(R0),12(R0)    ;REARRANGEMENT NECESSARY?
        BHI     1$              ;YES - JUMP
        ADD     #10,R0          ;NO - POINT TO NEXT BLOCK
        BR      2$              ;LOOP
1$:                             ;SWAP 4-WORD BLOCKS AT R0 AND R0+10.
                                ;AFTER THIS, R0 IS INCREMENTED BY 10
        MOV     (R0)+,-(SP)
        MOV     (R0)+,-(SP)
        MOV     (R0)+,-(SP)
        MOV     (R0)+,-(SP)
        MOV     (R0)+,-12(R0)
        MOV     (R0)+,-12(R0)
        MOV     (R0)+,-12(R0)
        MOV     (R0)+,-12(R0)
        MOV     (SP)+,-(R0)
        MOV     (SP)+,-(R0)
        MOV     (SP)+,-(R0)
        MOV     (SP)+,-(R0)
        INC R1                  ;SET FLAG
        BR      2$              ;LOOP
3$:     TST     R1              ;IF FLAG SET, NEED ANOTHER PASS
        BNE     SORT            ;IF NOT SET AFTER A PASS, ALL IS DONE
;
; THE DATA BLOCKS ON THE STACK ARE NOW SORTED. PROCESS THE
; DATA AND MAKE THE LISTING
;
LIST:   CMP     SP,STKBAS       ;STACK EXHAUSTED?
	BNE	34$
	JMP	EXIT
34$:
        MOV     #6,R1
        MOV     #TSKNAM,R3      ;GET TASK NAME AND CONVERT TO ASCII
	CMP	6(SP),#PURSEC	;A PURE SECTION?
	BNE	40$		;NO, CLEAR FLAG
	CMP	@SP,PURFLG	;IS STD THE SAME AS THE LAST ONE?
	BEQ	41$		;YES, LEAVE FLAG ALONE
	INC	PURDO		;FLAG PRINT THIS TIME THRU
	MOV	@SP,PURFLG	;OTHERWISE SAVE STD ADDR FOR LATER
	BR	43$		;AND GO ON WITH IT
40$:	CLR	PURFLG		;ZERO PURE FLAG NOW
	CLR	PURDO		;CLEAR PRINT FLAG ALSO
	BR	43$		;SKIP STACK FLUSH
41$:				;CONTINUE NORMALLY.
	ADD	#10,SP		;FLUSH PURE ENTRY OFF STACK IF MULTIPLE
	BR	LIST		;THEN TRY NEXT
43$:
	CMP	6(SP),#GCDENT	;THIS A GCD ENTRY?
	BNE	42$		;NO, A TASK
	MOV	(SP)+,R2
	ADD	#G.BN,R2
	CALL	@#..RDTA	;UNPACK NAME
	ADD	R1,R3
23$:	TSTB	-(R3)	;PUT IN SPACES INSTEAD OF NULLS
	BNE	24$
	MOVB	#SPACE,@R3
	BR	23$
24$:	CMP	@SP,PREVHI	;THIS TASK NEXT TO PREVIOUS?
	BEQ	25$
	MOV	PREVHI,R1
	MOV	#HOLELO,R2	;GET HOLE ADDRESS
	CALL	OTA
	MOV	@SP,R1
	MOV	#HOLEHI,R2
	CALL	OTA
	MOV	#HOLELN,R5
	CALL	PRINT		;SEND THE STRING OUT FOR <HOLE>
25$:	MOV	@SP,R1
	MOV	#LOADR,R2
	CALL	OTA	;GET LOADDR
	MOV	(SP)+,R1	;GET HI ADDR
	ADD	(SP)+,R1
	MOV	R1,PREVHI
	MOV	#HIADR,R2
	CALL	OTA
	MOVB	#'C,AFIELD
	MOVB	#SPACE,FFIELD
	TST	(SP)+	;POP FLAG WORD OFF STACK
	BR	70$
42$:
        MOV     (SP)+,R2
        ADD     #S.TN,R2
        CALL    @#..RDTA
        ADD     R1,R3           ;TRAILING NULLS ARE REPLACED
3$:     TSTB    -(R3)           ;  BY SPACES
        BNE     4$
        MOVB    #SPACE,@R3
        BR      3$
4$:     CMP     @SP,PREVHI      ;IS THIS TASK ADJACENT TO PREVIOUS?
        BEQ     5$              ;YES - JUMP
        MOV     PREVHI,R1       ;NO - THERE IS A HOLE
        MOV     #HOLELO,R2      ;CONVERT HOLE LOW ADRS TO ASCII
        CALL    OTA
        MOV     @SP,R1          ;CONVERT HOLE HIGH ADRS
        MOV     #HOLEHI,R2
        CALL    OTA
        MOV     #HOLELN,R5      ;PRINT "HOLE" STRING
        CALL    PRINT
5$:     MOV     @SP,R1          ;CONVERT TASK LOW ADRS TO ASCII
        MOV     #LOADR,R2
        CALL    OTA
        MOV     (SP)+,R1        ;CALCULATE TASK HIGH ADRS
        ADD     (SP)+,R1
        MOV     R1,PREVHI       ;UPDATE PREVHI
        MOV     #HIADR,R2       ;CONVERT TASK HIGH ADRS
        CALL    OTA
        MOVB    #SPACE,AFIELD   ;CLEAR A AND F FIELDS
        MOVB    #SPACE,FFIELD
1$:
	CMP	@SP,#PURSEC	;THIS A PURE SECTION?
	BEQ	12$		;YES
	CLR	PURFLG		;NO, FLAG LAST SECTION IMPURE
	BR	31$		;GO AHEAD AND TEST--NOT PURE SECT
12$:
;PURE SECTIONS MAY APPEAR MORE THAN ONCE. PRINT FIRST ONE
;BUT IGNORE OTHERS UNTIL WE GET AN IMPURE SECTION
	MOVB	#'P,AFIELD	;FLAG PURE CODE AREA
	CLR	@SP		;NO MORE JUNK IN PRINTING
	TST	PURDO		;SHOULD WE DO IT?
	BEQ	JLIST	;IF 0 SKIP IT
	CLR	PURDO		;ELSE DO IT NOW BUT NOT NEXT TIME
31$:
	BIT     #ACTTSK,@SP      ;ACTIVE?
        BEQ     2$              ;NO - JUMP
        MOVB    #'A,AFIELD      ;YES
2$:     BIT     #SF.FX,(SP)+    ;FIXED?
        BEQ     7$              ;NO - JUMP
        MOVB    #'F,FFIELD      ;YES
70$:
7$:                             ;LINE IS COMPLETE - PRINT IT
        MOV     #LINE,R5
        CALL    PRINT
JLIST:	JMP	LIST
;
EXIT:   EXIT$S                  ;ALL IS DONE - GOOD-BYE
PURFLG:	.WORD	0	;CONTROLS PRINT OF PURE SECTIONS
PURDO:	.WORD	0
;
; SUBROUTINE TO PRINT A MESSAGE ON LUN 6.
; ON ENTRY, R5 POINTS TO A BYTE COUNT BYTE IMMEDIATELY PRECEDING
; THE ASCII STRING. CONTROL IS NOT RETURNED UNTIL IO IS DONE.
;
PRINT:  CMP	TSKNAM+2,DOT2	;CHARACTERS 3&4 PERIODS?
        BNE	1$
	CMP	TSKNAM+4,DOT2	;CHARACTERS 5&6 PERIODS?
	BEQ	65$		;I/O HANDLER -- SKIP PRINT
;
1$:	MOV     R4,-(SP)	;SAVE R4 VALUE
        MOV	RESLST,R4	;LOAD # ENTRIES IN RESTRICTED LIST
	MOV	R3,-(SP)	;SAVE R3 VALUE
	MOV	#RESLST+2,R3	;LOAD START OF LIST OF RESTRICTED NAMES	
2$:     CMP	(R3),TSKNAM	;COMPARE CHARACTERS 1&2
	BNE	100$
	CMP	2(R3),TSKNAM+2	;COMPARE CHARACTERS 3&4
	BNE	100$
	CMP	4(R3),TSKNAM+4	;COMPARE CHARACTERS 5&6
	BNE	100$
;	FOUND IT!!
	JMP	64$	;A RESTRICTED NAME!! -- SKIP PRINT
100$:
	ADD	#6,R3	;PASS LAST NAME TESTED
	DEC	R4
	BGT	2$	;LOOP FOR NEXT NAME
;
;	RESTORE R3 & R4
;
	MOV	(SP)+,R3
	MOV	(SP)+,R4
;
;	ITS OK -- PRINT LINE
;
15$:	MOVB    (R5)+,DPBQIO+Q.IOPL+2
        MOV     R5,DPBQIO+Q.IOPL
        DIR$    #DPBQIO
        WTSE$S  #1
	BR	65$
;
64$:	MOV	(SP)+,R3
	MOV	(SP)+,R4
65$:	RETURN
;
;	DATA AREA FOR PRINT SUBROUTINE
;
DOT2:	.ASCII	/../
;R3SAV:	.WORD	0
;R4SAV:	.WORD	0
RESLST:	.WORD	5
	.ASCII	/SYSRES/
	.ASCII	/TTLIBA/
	.ASCII	/TTLIBB/
	.ASCII	/ACCLOG/
	.ASCII	/F11ACP/
;
;
; SUBROUTINE TO CONVERT OCTAL TO ASCII.
; INPUT: R1 CONTAINS THE OCTAL VALUE IN THE RANGE 0 - 077777.
;
OTA:    MOV     #5,R3
	MOV	#'0,-(SP)
	BIT	#100000,R1	;TEST HIGH BIT OF 16
	BEQ	3$
	ADD	#1,(SP)		;MAKE LEADING 1 IF HI BIT IS ON
3$:	MOVB	(SP)+,(R2)+	;PUT OUT LEADING 1 OR 0
	ASL	R1		;THEN SHIFT IT OFF
1$:     ASHC    #3,R0
        BIC     #177770,R0
        ADD     #'0,R0
        MOVB    R0,(R2)+
        SOB     R3,1$
        RETURN
;
        .END    PMP