TITLE PICK -- locks page peeker  PDL (7/25/76)

.MLLIT=1

; ================================================================
;		ac definitions
; ================================================================

A=1
B=2
C=3
D=4
E=5
F=6
G=7
H=10
I=11
J=12
K=13
L=14	; only for super-temp uses under these names
M=15	; only for super-temp uses
P=17	; PDL pointer

; ================================================================
;		channels
; ================================================================

TYIC==1	; tty input
TYOC==2	; tty output
U==3
DSKI==4

; ================================================================
;		its file system definitions
; ================================================================

.INSRT SYSTEM;FSDEFS >

; ================================================================
;		variables
; ================================================================

PDL:	BLOCK 101.		; PDL
COMMND:	BLOCK 40.

FILE:
DEV:	SIXBIT /DSK   /
NM1:	SIXBIT /LOCKS /
NM2:	SIXBIT /PAGE  /
SNM:	SIXBIT /MUDDLE/			; sname default

USER:	SIXBIT /  .USR/
USROPN:	0
	0

; ================================================================
;		start up
; ================================================================

START:	MOVE	P,[-100.,,PDL+1]	; set up pdls
	.OPEN	TYIC,[SIXBIT /   TTYFIND  INPUT /]
	 .VALUE	[ASCIZ /:CAN'T OPEN TTY/]
	.OPEN	TYOC,[SIXBIT /  5TTY/]
	 .VALUE	[ASCIZ /:CAN'T OPEN TTY/]
	.SUSET	[.SMASK,,[1]]
	.SUSET	[.RUIND,,INDEX']
	SETZM	ALLFLG'			; initially, show only active locks
	SETZM	INFO'

; ================================================================
;		read a command line or two
; ================================================================

; get command line from superior
	.SUSET	[.ROPTIO,,A]		; get superiors option word
	MOVEM	A,OPTION'

; has jcl for us?
JCLARG:	TLNN	A,OPTCMD		; OPTCMD has JCL?
	 JRST	PICK
	.BREAK	12,[..RJCL,,COMMND]
	SKIPE	COMMND			; none there?
	 PUSHJ	P,SCNAME


PICK:	OCTLP	"C
	.CALL	[SETZ ? SIXBIT /OPEN/ ? [6,,DSKI] ? DEV ? NM1 ? NM2 ? SETZ SNM]
	 JRST	LOST
	.CALL	[SETZ
		 'CORBLK
		 MOVEI %CBRED
		 MOVEI -1
		 MOVEI BUFPAG
		 MOVEI DSKI
		 SETZI ]
	 .LOSE	1000
	.CLOSE	DSKI,

PICKLP:	OCTLP	"T
	OASC	[ASCIZ /PICK./]
	OSIX	[.FNAM2]
	OASCR	[0]
	OASCR	[0]
	SKIPN	INFO
	 JRST	PICKL1
	OASCR	[ASCIZ /A program for examining the status of a MUDDLE locks page.
Invoke with

	:PICK <optional-lock-file-name>

(which defaults to MUDDLE;LOCKS PAGE)

Commands are:

	U	toggle viewing of used locks (initially off)
	Q	quit
	?	view this

	...	anything else causes a new cycle/]
	JRST	PICKSL

PICKL1:	OASC	[ASCIZ /Locks Page:  /]
	OSIX	DEV
	OASCI	":
	OSIX	SNM
	OASCI	";
	OSIX	NM1
	OASCI	" 
	OSIX	NM2
	OASC	[ASCIZ / is /]
	SKIPGE	BUFFER		; page lock
	 OASCR	[ASCIZ /UNLOCKED./]
	SKIPLE	BUFFER
	 OASCR	[ASCIZ /LOCKED./]

	OASC	[ASCIZ /Initialized: /]
	MOVE	M,BUFFER+2	; last init date/time
	PUSHJ	P,DSKPRT
	MOVE	M,BUFFER+2
	CAME	M,BUFFER+3
	 OASC	[ASCIZ / (Not yet initialized)/]
	OASCR	[0]

; here find out who shares this locks page
	MOVE	A,INDEX
	MOVEM	A,PAGUSR
	MOVEI	A,BUFPAG
	MOVEM	A,PAGPAG
	MOVEI	B,1
	SETZ	C,
	JRST	CORLU1
CORLUP:	MOVE	A,INDEX
	SKIPL	PAGUSR
	CAMN	A,PAGUSR
	 JRST	CORDON
CORLU1:	MOVE	A,PAGUSR
	TRO	A,400000	; job spec. for call
	MOVEM	A,PAGUSR
	.CALL	[SETZ
		 'CORTYP
		 MOVE PAGUSR'	; user
		 MOVE PAGPAG'	; user's page
		 MOVEM PAGRW'	; state of it
		 MOVEM PAGUSR'	; next sharer
		 MOVEM PAGPAG'	; mapped as page #
		 SETZM PAGSHR']	; number sharers
	 .LOSE	1000

	HRRZS	PAGSHR
	SKIPL	PAGRW		; if page is writable, really using it
	 JRST	CORLUP
	TRZ	A,400000
	TLO	A,400000
	MOVEM	A,USROPN
	.OPEN	U,USER
	 JRST	CORLUP
	.USET	U,[.RUNAM,,UNAME']
	.USET	U,[.RJNAM,,JNAME']
	.USET	U,[.ROPTI,,A]
	SETZM	OPTION
	TLNN	A,OPTLOK
	 SETOM	OPTION'
	.CALL	[SETZ ? 'ACCESS ? MOVEI U ? SETZI 43 ]
	 .LOSE	1000
	HRROI	A,G
	.IOT	U,A
	JUMPE	G,CORUSR

; get locks used by this user
	MOVEI	H,USEBUF
CORTBL:	.CALL	[SETZ ? 'ACCESS ? MOVEI U ? SETZ G ]
	 .LOSE 1000
	MOVE	A,[-2,,F]
	.IOT	U,A
	TLNN	G,20		; indirect bit
	 JRST	CORTNX
	ANDI	F,1777
	SUBI	F,4
	MOVEM	F,(H)
	MOVE	UNAME
	MOVEM	1(H)
	MOVE	JNAME
	MOVEM	2(H)
	ADDI	B,3
CORTNX:	HRRZS	G
	JUMPN	G,CORTBL
	SETZM	(H)

CORUSR:	.CLOSE	U,
	JUMPN	C,.+3
	 OASC	[ASCIZ /In use by:  /]
	 SKIPA
	OASC	[ASCIZ /, /]
	OSIX	UNAME
	OASCI	" 
	OSIX	JNAME
	SKIPE	OPTION
	 OASC	[ASCIZ / (OPTLOK?)/]
	SETO	C,
	JRST	CORLUP

; end of list of sharers
CORDON:	JUMPE	C,UNUSED
	OASCR	[ASCIZ /./]
	JRST	HASH

; here if page not being used
UNUSED:	OASCR	[ASCIZ /No-one is using this locks page./]

; here hack hashing table of locks, looking for ones in use
HASH:	OASCR	[0]
	MOVE	L,BUFFER+4	; hash table pointer
	ADDI	L,BUFFER
	MOVEI	K,BUCKET
HASHLP:	SKIPN	A,(L)
	 JRST	HASHNX
	ADDI	A,BUFFER
	MOVEM	A,(K)
	ADDI	K,1
	SUB	K,[1,,0]
HASHNX:	AOBJN	L,HASHLP

	HRRI	K,BUCKET
	MOVE	J,K

SORT:	SETZ	I,
SORTLP:	MOVE	A,(K)
	SKIPN	B,1(K)
	 JRST	SORTDN
	MOVE	C,1(A)
	CAML	C,1(B)
	 JRST	SORT1
SORTNX:	AOBJN	K,SORTLP
SORTDN:	JUMPE	I,PRTLUP
	MOVE	K,J
	JRST	SORT
SORT1:	CAMG	C,1(B)
	 JRST	SORT2
SORTX:	MOVEM	A,1(K)
	MOVEM	B,(K)
	SETO	I,
	JRST	SORTNX
SORT2:	MOVE	C,2(A)
	CAMGE	C,2(B)
	 JRST	SORTNX
	CAME	C,2(B)
	 JRST	SORTX
	MOVE	C,3(A)
	CAMGE	C,3(B)
	 JRST	SORTNX
	CAME	C,3(B)
	 JRST	SORTX
	JRST	SORTNX

PRTLUP:	MOVE	A,(J)
	SKIPE	ALLFLG		; if 0, don't print used locks
	 JRST	PRTLU1
	SKIPN	B,4(A)
	 JRST	PRTNXT		; ignore unlocked locks
PRTLU1:	OASC	1(A)
	OHPOS	18.
	MOVE	B,4(A)
	SKIPGE	B
	 OASC	[ASCIZ /Hard-locked/]
	SKIPN	B
	 OASC	[ASCIZ /Unlocked/]
	JUMPLE	B,WHOUSE
	OASC	[ASCIZ /Soft-locked, /]
	ODEC	B

WHOUSE:	SETZ	C,
	MOVEI	B,USEBUF
	SUBI	A,BUFFER

WHOLUP:	SKIPN	(B)
	 JRST	WHOEND
	CAME	A,(B)
	 JRST	WHONXT
	JUMPN	C,.+3
	 OHPOS	35.
	 SKIPA
	  OASC	[ASCIZ /, /]
	OSIX	1(B)
	OASCI	" 
	OSIX	2(B)
	SETO	C,

WHONXT:	ADDI	B,3
	JRST	WHOLUP

WHOEND:	OASCR	[0]

PRTNXT:	AOBJN	J,PRTLUP

PICKSL:	OCTLP	"E
	MOVEI	A,10.*30.
	.SLEEP	A,
	JRST	PICKLP

SHORT:	OASCR	[ASCIZ /File too short?/]
	JRST	EXIT
LOST:	OASCR	[ASCIZ /File not found?/]
	JRST	EXIT

EXIT:	.BREAK	16,160000

; ===================================================================
; 		command line reading and parsing section
; ===================================================================

; read a file spec
SCNAME:	MOVE	C,[440700,,COMMND]
	MOVEM	C,COMPTR'
	MOVE	D,[-2,,NM1]
SCLOOP:	PUSHJ	P,GETSYL
	CAIN	A,';
	 MOVEM	B,SNM
	CAIN	A,':
	 MOVEM	B,DEV
	JUMPG	A,SCLOOP
	 MOVEM	B,(D)
	AOBJN	D,SCLOOP
	POPJ	P,

; get a syllable from command buffer
GETSYL:	PUSH	P,C
	PUSH	P,[0]
	MOVEI	B,(P)
	HRLI	B,440600
GETSLP:	PUSHJ	P,GETCCA
	JUMPL	A,GETSX
	SETO	E,
GETSL2:	CAIN	A,^Q		; ^Q quotes next character
	 JRST	GETQOT
	SUBI	A,40
	JUMPL	A,GETSX		; other controls exit
	JUMPE	A,GETSP		; space?
	CAIE	A,':
	 CAIN	A,';
	  JRST	GETSX
GETSPT:	CAIL	A,100
	 SUBI	A,40
	TLNN	B,770000
	 JRST	GETSLP
	IDPB	A,B
	IDPB	E,C
	JRST	GETSLP

GETQOT:	ILDB	A,COMPTR
	SUBI	A,40
	JUMPGE	A,GETSPT
	JRST	GETSX
GETSP:	TLNE	B,400000
	 JRST	GETSLP
GETSX:	POP	P,B		; character word
	POP	P,C
	POPJ	P,

GETCCA:	ILDB	A,COMPTR
	JUMPE	A,GETCCX
	CAIN	A,^I
	 MOVEI	A,40
	CAIN	A,^M
GETCCX:	 SETOM	A
	POPJ	P,


DSKPRT:	LDB	K,[270400,,M]
	ODEC	K
	OASCI	"/
	LDB	K,[220500,,M]
	ODEC	K
	OASCI	"/
	LDB	K,[330700,,M]
	ODEC	K
	OASCI	" 
	HRRZ	B,M
	MOVEI	A,3
	SETZI	D,
	LSH	B,-1
TILOP:	IDIVI	B,10.
	ADDI	C,'0
	LSHC	C,-6
	IDIVI	B,6
	ADDI	C,'0
	LSHC	C,-6
	SOJG	A,TILOP
	MOVEI	B,2
	MOVEI	A,":
TILOP2:	SETZI	C,
	LSHC	C,6
	OASCI	40(C)
	SETZI	C,
	LSHC	C,6
	OASCI	40(C)
	SKIPE	B
	OASCI	(A)
	SOJGE	B,TILOP2
	POPJ	P,

; ================================================================
;		interrupt handler (tty only)
; ================================================================

ZZZ=.

LOC 42
	JSR	TSINT
LOC ZZZ

TSINT:	0
	0
	PUSH	P,A
	PUSH	P,B
	MOVEI	A,TYIC
	.ITYIC	A,
	 JRST	TSDIS
	.RESET	TYIC,		; reset channel
	.RESET	TYOC,
	CAIN	A,"?
	 JRST	TSINFO
	SETZM	INFO
	CAIGE	A,100
	 JRST	TSCONT
	TRZ	A,40
	CAIN	A,"Q
	 JRST	TSKILL
	CAIN	A,"U
	 JRST	TSLOCK
	JRST	TSCONT
TSDISX:	MOVEM	A,TSINT+1
TSDIS:	POP	P,B
	POP	P,A
	.DISMIS	TSINT+1

TSINFO:	SETOM	INFO
	SKIPA

TSLOCK:	SETCMM	ALLFLG		; complement flag to show all locks in page

; here to do a new cycle
TSCONT:	MOVE	P,[-100.,,PDL+1]	; set up pdls
	MOVEI	A,PICKLP
	JRST	TSDISX

; here kill job
TSKILL:	MOVEI	A,EXIT
	JRST	TSDISX

; ================================================================
;		uuo handler (typeout uuos)
; ================================================================

ZZZ==.
        LOC 40
        0
        JSR UUOH
        LOC ZZZ
UUOCT==0
UUOTAB:	JRST ILUUO
	IRPS X,,[DEC BPTR OCT CTLP ASCC SIX ASC ASCI ASCR SIXS HPOS ALIGN SIGN]
	UUOCT==UUOCT+1
	O!X=UUOCT_27.
	JRST UO!X
	TERMIN

IFG UUOCT-37, PRINTC /---TOO MANY UUO'S---/

UUOMAX==.-UUOTAB


UUOD:	0		; contents of UUO eff addr.
UUOE:	0		; UUO effad.

UUOH:	0
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	MOVEI	@40			; get eff addr. of uuo
	MOVEM	UUOE
	MOVE	@0
	MOVEM	UUOD			; contents of eff adr
	MOVE	B,UUOE			; eff adr
	LDB	A,[270400,,40]		; get uuo ac,
	LDB	C,[330600,,40]		; op code
	CAIL	C,UUOMAX
	MOVEI	C,0			; grt=>illegal
	JRST	@UUOTAB(C)		; go to proper rout

UUORET:	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A			; restore ac's
	JRST	2,@UUOH

ILUUO:	.VALUE	[ASCIZ /:ILLEGAL UUO
/]

UOBPTR:	MOVEI	C,0
	MOVE	B,UUOD
	JRST	UOASC1

UOASCR:	SKIPA	C,[^M]			; cr for end of type
UOASC:	MOVEI	C,0			; no cr
	HRLI	B,440700		; make ascii pointer
UOASC1:	ILDB	A,B			; get char
	JUMPE	A,.+3			; finish?
	PUSHJ	P,IOTA
	JRST	.-3			; and get another
	SKIPE	A,C			; get saved cr?
	PUSHJ	P,IOTA
	JRST	UUORET

UOASCC:	HRLI	B,440700		; make ascii pointer
UOAS1C:	ILDB	A,B			; get char
	CAIN	A,^C
	JRST	UUORET
	PUSHJ	P,IOTA
	JRST	UOAS1C			; and get another

UOCTLP:	MOVEI	A,^P
	PUSHJ	P,IOTA1

UOASCI:	MOVE	A,B			; prt ascii immediate
	PUSHJ	P,IOTA
	JRST	UUORET

UOSIX:	MOVE	B,UUOD
USXOOP:	JUMPE	B,UUORET
	LDB	A,[360600,,B]
	ADDI	A,40
	PUSHJ	P,IOTA
	LSH	B,6
	JRST	USXOOP

UOSIXS:	MOVE	A,[440600,,UUOD]
USLOOP:	ILDB	C,A
	ADDI	C,40
	PUSHJ	P,IOTC
	TLNE	A,770000
	JRST	USLOOP
	JRST	UUORET

UOHPOS:	SUB B,HPOS
	SKIPG B
	MOVEI B,1	; always at least one space
UOHPO1:	MOVEI A,40
	PUSHJ P,IOTA
	SOJG B,UOHPO1
	JRST UUORET

POWER:	0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.

UOSIGN:	MOVM D,UUOD
	ANDI A,7
	MOVE A,POWER-1(A)
	MOVEI C,40
UOSIG1:	CAMLE A,D
	PUSHJ P,IOTC
	IDIVI A,10.
	CAIE A,1
	 JRST UOSIG1
	MOVEI A,"+
	SKIPGE UUOD
	MOVEI A,"-
	SKIPN UUOD
	MOVEI A," 
	PUSHJ P,IOTA
	SETZ A,
	JRST UODEC

UOALIG:	MOVE D,UUOD
	ANDI A,7
	MOVE A,POWER(A)
	MOVEI C,40
UOALI1:	CAMLE A,D
	PUSHJ P,IOTC
	IDIVI A,10.
	CAIE A,1
	 JRST UOALI1
	SETZ A,

UODEC:	SKIPA	C,[10.]			; get base for decimal
UOOCT:	MOVEI	C,8.			; octal base
	MOVE	B,UUOD			; get actual word to prt
	JRST	.+3			; join code
UODECI:	SKIPA	C,[10.]			; decimal
UOOCTI:	MOVEI	C,8.
	MOVEM	C,BASE'
	SKIPN	A
	HRREI	A,-1			; a=digit count
	PUSHJ	P,UONUM			; print numbr
	JRST	UUORET

UONUM:	IDIV	B,BASE
	HRLM	C,(P)			; save digit
	SOJE	A,UONUM1		; done if 0
	SKIPG	A			; + => more
	SKIPE	B			; - => b=0 => done
	PUSHJ	P,UONUM			; else more
UONUM1:	HLRZ	C,(P)			; retreive digits
	ADDI	C,"0			; make to ascii
	CAILE	C,"9			; is it good dig
	ADDI	C,"A-"9-1		; make hex digit
	PUSHJ	P,IOTC
	POPJ	P,			; ret

IOTC:	PUSH	P,A
	MOVE	A,C
	PUSHJ	P,IOTA
	POP	P,A
	POPJ	P,

HPOS:	0	; line pos

IOTA:	CAIN	A,^P
	JRST	[.IOT TYOC,["^]
		 ADDI A,100
		 JRST IOTA1]
	CAIN	A,^J
	POPJ	P,
IOTA1:	.IOT	TYOC,A
	CAIE	A,^M
	 JRST	IOTTAB
	.IOT TYOC,[^J]
	SETZM	HPOS
	POPJ	P,
; update line pos
IOTTAB:	CAIN	A,^I
	 JRST	[MOVE A,HPOS
		 ADDI A,10
		 ANDI A,7770
		 MOVEM A,HPOS
		 POPJ P,]
	AOS	HPOS
	POPJ	P,

BUCKET:	BLOCK 205.

VARIAB
CONSTA

USEBUF:

	BUFFER==<<.+1777>&6000>
	BUFPAG==<BUFFER_-10.>

	END	START