Google
 

Trailing-Edge - PDP-10 Archives - KS10_APT_INSTALL_TAPE - uetp/lib/cmlbad.mac
There is 1 other file named cmlbad.mac in the archive. Click here to see a list.
	TITLE	ADMLIB	LIBRARY OF MODULES FOR ADMINISTRATION PROGS.
	SUBTTL	C.MITCHELL 1977

	SEARCH	CMLBSM		;FOR VERSION NUMBER

	;;THE FOLLOWING IS A LIBRARY OF MODULES WHICH ARE USED BY

	;;VARIOUS SYSTEM ADMINISTRATION PROGRAMS. THE IDEA IS THAT

	;;EACH MAIN FUNCTION SHOULD BE MADE MODULAR SO THAT A NEW

	;;SYSTEM ADMINISTRATION PROGRAM CAN BE QUICKLY WRITTEN TO

	;;READ OR MODIFY STANDARD FILES, ETC. THE CONSTRUCTION OF

	;;THIS LIBRARY SHOULD BE THAT OF A STANDARD LIBRARY SO THAT

	;;ONLY THOSE MODULES WHICH ARE REQUIRED ARE LOADED.

	;;ORDER IS IMPORTANT!!!


	ADMLBV==1	;VERSION NUMBER OF THIS FILE

	IFN <ADMLBV-CMSYMV>,<PRINTX <MISMATCHED UNIVERSAL AND ADMLIB!>>

	PRGEND
	TITLE	EXIT	EXIT TO MONITOR
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	.EXIT,.EXIT1

	;HERE TO EXIT TO MONITOR. CALL PROGRAM DEPENDENT ROUTINE
	;"CLSUP" TO TIDY UP ANYTHING SPECIFIED IN THE PROGRAM, 
	;AND CLOSES ALL FILES. FINALLY IT EXITS TO MONITOR AND
	;WILL NOT ALLOW A CONTINUE.

.EXIT:	HRROI	T2,[ASCIZ /TO MONITOR/]
	PUSHJ	P,CRMNOI##	;MAKE SOME NOISE
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD. GIVE A SKIP RETURN
.EXIT1:	PUSHJ	P,CLSUP##	;PROGRAM DEPENDENT ROUTINE
	SETOM	T1		;CLOSE ALL FILES
	CLOSF
	 PUSHJ	P,JSERPJ##	;COULD NOT CLOSE UP.
	HALTF			;EXIT TO MONITOR
	JRST	.-1		;NO CONTINUES

	PRGEND
	TITLE	DISABL	DISABLE WHEEL PRIVILEDGES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	.DSABL,.DSAB1

	;HERE TO DISABLE WHEEL PRIVILEDGES. ENTER AT .DSABL IF
	;CONFIRMATION REQUIRED. ELSE ENTER AT .DSAB1.

.DSABL:	HRROI	T2,[ASCIZ /WHEEL PRIVILEDGES/]
	PUSHJ	P,CRMNOI##	;MAKE SOME NOISE
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD CONFIRMATION. CONVENTIONAL RETURN
	AOS	(P)		;GIVE SKIP RETURN WHEN DONE
.DSAB1:	PJRST	DISWHL##	;ALL THERE IS TO DO!

	PRGEND
	TITLE	ENABLE	ENABLE WHEEL PRIVILEDGES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	.ENABL,.ENAB1

	;ROUTINE TO ENABLE WHEEL PRIVILEDGES. ENTER AT .ENABLE
	;IF CONFIRMATION REQUIRED. ELSE ENTER AT .ENAB1.

.ENABL:	HRROI	T2,[ASCIZ /WHEEL PRIVILEDGES/]
	PUSHJ	P,CRMNOI##	;MAKE SOME NOISE
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD. RETURN SKIP
	AOS	(P)		;SKIP RETURN
.ENAB1:	PUSHJ	P,ENBWHL##	;TURN ON!
	 JFCL			;FREAK OUT!!
	POPJ	P,		;**** OFF!!!

	PRGEND
	TITLE	HELP	PRINT HELP FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	.HELP,.HELP1

	;COMMAND TO TYPE HELP FILE. LOOKS FOR A FILE WITH EXTENSION
	;"HLP" ON DEVICE "HLP:" AND PRINTS IT. LOCATION "HELPNM##"
	;SHOULD CONTAIN THE NAME OF THE HELP FILE.

.HELP:	HRROI	T2,[ASCIZ /for this program/]
	PUSHJ	P,CRMNOI##	;MAKE A LOT OF NOISE!!
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD
	AOS	(P)		;GIVE SKIP AT END
.HELP1:	MOVX	A,<GJ%OLD>	;MUST EXIST
	HRRI	A,[ASCIZ /HLP:/] ;ON DEVICE HELP
	SETZM	B		;NO DIRECTORY
	HRROI	C,HELPNM##	;GET FILENAME
	HRRZI	D,[ASCIZ /HLP/]	;EXTENSION
	PUSHJ	P,GTJCLS##	;SET UP
	MOVE	T1,[.NULIO,,.NULIO]
	MOVEM	T1,GTJBLK+.GJSRC ;NO INPUT
	MOVEI	T1,GTJBLK##	;POINT TO BLOCK
	HRROI	T2,[ASCIZ //]	;NONAME
	GTJFN			;GET JFN FOR IT
	 ERROR	CPOPJ##,<UNABLE TO FIND HELP FILE>
	HRRZ	INP,T1		;SAVE JFN
	PUSHJ	P,OPFLIA##	;OPEN FOR INPUT
	 ERROR	CPOPJ##,<UNABLE TO READ HELP FILE>
HLPLP1:	PUSHJ	P,JBIN##	;GET CHAR
	 JRST	EOF		;OK
	HRRZ	T1,T2		;COPY CHAR
	PBOUT			;TYPE IT
	JRST	HLPLP1		;DO ALL

	;HERE ON EOF

EOF:	PUSHJ	P,CIFLLJ##	;CLOSE UP
	 JFCL			;NO ERRORS
	HRROI	T1,[ASCIZ /
[END OF HELP FILE]
/]
	PSOUT
	POPJ	P,		;OK

	PRGEND
	TITLE	RNGOUT	OUTPUT TO FILE AND RING WITH STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RNGOUT

	;ROUTINE TO OUTPUT CHARACTER TO FILE AND RING FILE WITH
	;STARS. ENTER WITH CHARACTER TO OUTPUT IN T2.

RNGOUT:	SKIPN	FFSEEN##	;START OF PAGE?
	JRST	RNGLP1		;NO
	PUSH	P,T2		;SAVE CHARACTER
	PUSH	P,T4		;AND BYTE POINTER
	PUSHJ	P,LAYSTP##	;START PAGE
	POP	P,T4		;RESTORE POINTER
	POP	P,T2		;AND CHARACTER
	SETZM	FFSEEN##	;NO FORM FEED
RNGLP1:	CAIN	T2,15		;CR?
	POPJ	P,		;IGNORE
	CAIN	T2,12		;LF?
	JRST	RNGLF		;YES
	CAIN	T2,14		;FORM-FEED?
	JRST	RNGFF		;YES
	CAIN	T2,11		;TAB?
	JRST	RNGTAB		;YES
	AOSL	T1,TABSTP##	;INCREMENT TABS
	MOVNI	T1,^D8		;RESET
	MOVEM	T1,TABSTP##	;RESAVE IT
	IDPB	T2,RNGBP##	;SAVE CHARACTER
	POPJ	P,		;DO NEXT

	;HERE ON FORM FEED

RNGFF:	PUSHJ	P,RNGEOF##	;PRETEND EOF
	JRST	RNGRES##	;RESET

	;HERE ON TAB

RNGTAB:	AOSG	TABSTP##	;INCREMENT COUNT
	JRST	SIMSPC		;SIMULATE WITH SPACE
	MOVNI	T2,^D8		;RESET
	MOVEM	T2,TABSTP##	;SAVE IT
	POPJ	P,		;GET NEXT CHARACTER
SIMSPC:	MOVEI	T2," "		;SEND SPACE
	IDPB	T2,T4		;WRITE IT
	JRST	RNGTAB		;GO ROUND

PAGE
	;HERE TO FINISH OFF LINE

FINLIN::MOVEI	T2,0		;MAKE ASCIZ
	IDPB	T2,RNGBP##	;SAVE IT
	HRROI	T2,BUFFER##	;POINT TO STRING
	PJRST	OTSTST##	;PRINT IT WITH STARS

	;HERE TO FINISH OFF PAGE

FINPAG::SKIPG	LINES##		;ANY LINES TO THROW?
	JRST	RNGCOM		;FINISH OFF
FINPG2:	PUSHJ	P,BLANK##	;THROW A LINE
	SOSLE	LINES##		;DECREMENT COUNT
	JRST	FINPG2		;KEEP ON
	PJRST	RNGCOM		;FINISH OFF

	;HERE ON LINE FEED

RNGLF:	PUSHJ	P,FINLIN	;FINISH OFF LINE FIRST
	SOSL	LINES##		;DECREMENT LINES
	JRST	RNGRS1##	;DO NEXT
RNGCOM:	SETOM	FFSEEN##	;SEEN FORM FEED
	PJRST	LAYFFO##	;FINISH OFF

	PRGEND
	TITLE	RNGEOF	RING A FILE WITH STARS-DEAL WITH EOF
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RNGEOF

	;ROUTINE TO DEAL WITH EOF WHEN RINGING WITH STARS.

RNGEOF:	SKIPE	FFSEEN##	;JUST SEEN FORM FEED?
	POPJ	P,		;NOTHING TO DO
	PUSHJ	P,FINLIN##	;FINISH LINE
	PJRST	FINPAG##	;FINISH PAGE

	PRGEND
	TITLE	LAYOUT	PRINT ACCORDING TO BIT MAP
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYOUT

	;ROUTINE TO PRINT A LAYOUT ACCORDING TO A BIT MAP.
	;ENTER WITH "A" POINTING TO A TABLE. THE LEFT HALF
	;SHOULD CONTAIN BITS AND THE RIGHT HALF SHOULD
	;CONTAIN DISPATCHES. PERFORMS THE FOLLOWING FUCTIONS:-

	;IF LY%PNT=1	;PRINT STRING POINTED TO BY DISPATCH
	;IF LY%PST=1	;PRINT STRING RINGED WITH "*"
	;IF LY%RTN=1	;PUSHJ TO ROUTINE IN DISPATCH.

LAYOUT:	MOVE	T1,(A)		;GET TABLE ENTRY
	JUMPE	T1,CPOPJ1##	;ALL DONE
	TLNN	T1,LY%PNT	;STRING?
	JRST	NTSTG		;NO
	HRRO	T2,T1		;POINT TO IT
	PUSHJ	P,STGOUT##	;PRINT IT
	PUSHJ	P,CRLF##	;NEW LINE
	JRST	STGCOM		;DO NEXT

NTSTG:	TLNN	T1,LY%PST	;STRING WITH STARS?
	JRST	NTSTR		;NO
	HRRO	T2,(A)		;POINT TO STRING
	PUSHJ	P,OTSTST##	;PRINT IT
	JRST	STGCOM		;DO NEXT

NTSTR:	TLNN	T1,LY%HDR	;DO HEADER?
	JRST	NTHDR		;NO
	HRROI	T2,(T1)		;POINT TO NEW HEADER
	MOVEM	T2,TITLE##	;SAVE IT
	PUSHJ	P,LAYSTP##	;START PAGE
	JRST	STGCOM		;DONE

NTHDR:	TLNN	T1,LY%CST	;CENTRE ALIGN BETWEEN STARS?
	JRST	NTCST		;NO
	HRRO	T2,(A)		;POINT TO STRING
	PUSHJ	P,OTSTCA##	;DO IT
	JRST	STGCOM		;DONE

NTCST:	TLNE	T1,LY%RTN	;DO ROUTINE?
	PUSHJ	P,(T1)		;DO IT
STGCOM:	AOJA	A,LAYOUT	;DO NEXT

	PRGEND
	TITLE	LAYNMA	LAYOUT ROUTINE TO PRINT NAME AND ADDRESS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYNMA,LAYNMI

	;ROUTINE TO PRINT NAME AND ADDRESS FOR USE IN THE
	;"LAYOUT" ROUTINE IN CONJUNCTION WITH THE NEWSLETTER.
	;ROUTINE "LAYNMI" SHOULD BE CALLED TO INITIALISE THE
	;NAME AND ADDRESS. SUBSEQUENTLY, EACH CALL TO "LAYNMA"
	;WILL RESULT IN ONE LINE BEING WRITTEN OF WIDTH "PAGWID"
	;STARTING AND FINISHING WITH AN "*" WITH ONE LINE OF
	;THE NAME AND ADDRESS.

LAYNMI:	SETZM	LAYFLG##	;INITIALISE FLAG
	POPJ	P,		;THAT'S ALL

LAYNMA:	SKIPE	LAYFLG##	;FIRST TIME?
	JRST	LAYADR##	;PRINT ADDRESS
	HRRZ	T1,CADR(BUF)	;POINT TO ADDRESS BLOCK
	HRRZI	T1,AADR(T1)	;POINT TO ADDRESS
	HRLI	T1,440700	;MAKE BYTE POINTER
	MOVEM	T1,LAYFLG##	;SAVE IT
	PJRST	LAYNAM##	;PRINT NAME

	PRGEND
	TITLE	LAYNAM	LAYOUT ROUTINE TO PRINT NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYNAM

	;"LAYOUT" ROUTINE TO PRINT NAME CENTRE-ALIGNED BETWEEN
	;"*" OF WIDTH "PAGWID".

LAYNAM:	PUSH	P,OUTP		;SAVE JFN
	HRROI	OUTP,LAYSPC##	;POINT TO FREE SPACE
	MOVE	T2,BUF		;POINT TO OUR ENTRY
	PUSHJ	P,PNTPEP##	;WRITE IT IN CORE
	POP	P,OUTP		;RESTORE JFN
	HRROI	T2,LAYSPC##	;POINT TO GENERATED STRING
	PJRST	OTSTCA##	;OUTPUT IT CENTER ALIGNED IN STARS!

	PRGEND
	TITLE	LAYADR	LAYOUT PRINT ADDRESS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYADR

	;ROUTINE TO PRINT ADDRESS FOR "LAYOUT" ROUTINE. ENTER WITH
	;BYTE POINTER TO ADDRESS IN "LAYFLG". PRINTS ONE LINE
	;OF THE ADDRESS FOR EACH CALL, CENTRE-ALIGNED WITHIN STARS.

LAYADR:	MOVEI	T2,LAYSPC##	;POINT TO FREE SPACE
	HRLI	T2,440700	;MAKE BYTE POINTER
	MOVE	T3,LAYFLG##	;GET POINTER TO ADDRESS
LAYAD1:	ILDB	T1,T3		;GET BYTE
	CAIN	T1,15		;CR?
	JRST	LAYAD1		;IGNORE IT
	JUMPE	T1,LAYAD3	;IGNORE ZERO
	CAIN	T1,12		;LF?
	JRST	LAYAD2		;YES
	IDPB	T1,T2		;SAVE IT
	MOVEM	T3,LAYFLG##	;SAVE BYTE POINTER
	JRST	LAYAD1		;DO NEXT
LAYAD2:	MOVEM	T3,LAYFLG##	;RESAVE BYTE POINTER
LAYAD3:	MOVEI	T1,0		;MAKE ASCIZ
	IDPB	T1,T2		;SAVE IT
	HRROI	T2,LAYSPC##	;POINT TO STRING
	PJRST	OTSTCA##	;PRINT IT

	PRGEND
	TITLE	LAYEDN	LAYOUT PRINT EDITION NUMBER
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYEDN

	;ROUTINE TO PRINT EDITION NUMBER CENTRE-ALIGNED BETWEEN
	;STARS.

LAYEDN:	PUSH	P,OUTP		;SAVE JFN
	HRROI	OUTP,LAYSPC##	;WHERE TO BUILD MESSAGE
	HRROI	T2,[ASCIZ /EDITION NUMBER /]
	PUSHJ	P,STGOUT##	;WRITE IT
	MOVE	T2,EDNUM##	;GET IT
	MOVX	T3,<^D10>	;DECIMAL
	PUSHJ	P,NUMOUT##	;WRITE IT
	POP	P,OUTP		;RESTORE JFN
	HRROI	T2,LAYSPC##	;POINT TO STRING
	PJRST	OTSTCA##	;WRITE IT

	PRGEND
	TITLE	LAYEDT	LAYOUT PRINT EDITION DATE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYEDT

	;ROUTINE TO PRINT EDITION DATE.

LAYEDT:	PUSH	P,OUTP		;SAVE JFN
	HRROI	OUTP,LAYSPC##	;POINT TO OPEN SPACE
	HRROI	T2,[ASCIZ /PUBLICATION DATE /]
	PUSHJ	P,STGOUT##	;PRINT IT
	MOVE	T2,DATE##	;GET DATE
	PUSHJ	P,DTONPT##	;PRINT IT
	POP	P,OUTP		;RESTORE JFN
	HRROI	T2,LAYSPC##	;POINT TO STRING
	PJRST	OTSTCA##	;WRITE IT

	PRGEND
	TITLE	LAYFFO	LAYOUT FINISH PAGE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYFFO,LAYTHR

	;ROUTINE TO FINISH CURRENT PAGE DURING "LAYOUT" ROUTINES.

LAYFFO:	PUSHJ	P,BLANK##	;PRINT A BLANK LINE
	PUSHJ	P,STARS##	;PRINT SOME STARS
LAYTHR:	PJRST	FFOUT##		;AND A FORM FEED

	PRGEND
	TITLE	LAYSTP	LAYOUT START PAGE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	LAYSTP

	;ROUTINE TO START A NEW PAGE DURING LAYOUT. ENTER WITH
	;POINTER TO TITLE IN "TITLE".

LAYSTP:	PUSHJ	P,STARS##	;PRINT STARS
	PUSHJ	P,BLANK##	;PRINT BLANK LINE
	HRRO	T2,TITLE##	;POINT TO TITLE
	PUSHJ	P,OTSTCA##	;PRINT IT
	PUSHJ	P,BLANK##	;BLANK LINE
	PUSHJ	P,STARS##	;PRINT STARS
	PUSHJ	P,BLANK##	;BLANK LINE
	PJRST	RNGRES##	;RESET VALUES

	PRGEND
	TITLE	RNGRES	RESET PAGE WHEN OUTPUTTING WITH STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RNGRES,RNGRS1

	;ROUTINE TO SET UP TO OUTPUT A FILE RINGED WITH STARS!

RNGRES:	MOVE	T1,LENGTH##	;GET LENGTH
	MOVEM	T1,LINES##	;SAVE IT
RNGRS1:	MOVNI	T1,^D8		;RESET TABS
	MOVEM	T1,TABSTP##	;SAVE VALUE
	MOVE	T1,[440700,,BUFFER##] ;WHERE TO ASSEMBLE LINE
	MOVEM	T1,RNGBP##	;SAVE IT
	POPJ	P,

	PRGEND
	TITLE	BLANK	PRINT A BLANK LINE RINGED WITH STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	BLANK

	;ROUTINE TO PRINT A BLANK LINE RINGED WITH STARS.
	;WIDTH IS C(WIDTH).

BLANK:	HRROI	T2,[ASCIZ //]	;NOTHING TO PRINT
	PJRST	OTSTCA##	;SO DO IT

	PRGEND
	TITLE	STARS	PRINT ROW OF STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	STARS

	;ROUTINE TO PRINT A ROW OF STARS. WIDTH IS C(WIDTH)

STARS:	MOVE	T2,[440700,,OTLNBF##] ;WHERE TO BUILD IT
	MOVEI	T1,"*"		;WHAT TO PRINT
	MOVE	T3,WIDTH##	;GET NUMBER TO PRINT
STAR1:	IDPB	T1,T2		;SAVE ONE
	SOJG	T3,STAR1	;DO ALL
	MOVEI	T1,0		;MAKE ASCIZ
	IDPB	T1,T2		;FINISH IT
	HRROI	T2,OTLNBF##	;POINT TO BUFFER
	PUSHJ	P,STGOUT##	;PRINT IT
	PJRST	CRLF##		;AND A NEW LINE

	PRGEND
	TITLE	OTSTCA	OUTPUT STRING CENTRE-ALIGNED WITH STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	OTSTCA

	;ROUTINE TO OUTPUT A STRING, CENTRE-ALIGNED SURROUNDED
	;WITH STARS. ENTER WITH T2 POINTING TO STRING.

OTSTCA:	PUSHJ	P,CALNST##	;CENTRE ALIGN IT
	PJRST	OTSTST##	;OUTPUT IT

	PRGEND
	TITLE	CALNST	CENTRE ALIGN A LINE--ALOW FOR STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	CALNST

	;ROUTINE TO CENTRE-ALIGN A STRING ALLOWING FOR STARS
	;ON EACH SIDE. ENTER WITH T2 POINTING TO STRING. RETURN
	;+1 ALWAYS WITH T2 POINTING TO STRING.

CALNST:	MOVE	T1,WIDTH##	;GET WIDTH
	SUBI	T1,4		;ALLOW FOR STARS
	MOVEM	T1,WIDTH##	;RESAVE IT
	PUSHJ	P,CALIGN##	;CENTRE-ALIGN IT
	MOVEI	T1,4		;READJUST
	ADDM	T1,WIDTH##	;DO IT
	POPJ	P,		;OK

	PRGEND
	TITLE	CALIGN	CENTRE ALIGN A STRING.
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	CALIGN

	;ROUTINE TO CENTRE ALIGN A STRING. ENTER WITH T2 POINTING
	;TO THE STRING. RETURN +1 WITH T2 POINTING TO THE NEW
	;STRING 0F WIDTH C(WIDTH).

CALIGN:	HLRZ	T1,T2		;GET BITS IN BYTE POINTER
	CAIN	T1,777777	;DEFAULT?
	HRLI	T2,440700	;MAKE IT GOOD
	PUSH	P,T2		;SAVE POINTER
	SETZM	T3		;RESET COUNT
CALIG1:	ILDB	T1,T2		;COUNT CHARACTERS
	JUMPE	T1,CALIG2	;FINISHED
	AOJA	T3,CALIG1	;DO ALL
CALIG2:	MOVE	T1,WIDTH##	;GET PAGE WIDTH
	SUB	T1,T3		;ALLOW FOR STRING
	ASH	T1,-1		;HALVE IT
	MOVE	T4,[440700,,OTLNBF##] ;POINT TO BUFFER
	JUMPLE	T1,CALIG4	;LONG LINE--NO SPACES
	MOVEI	T3," "		;SET FOR SPACES
CALIG3:	IDPB	T3,T4		;SAVE IT
	SOJG	T1,CALIG3	;DO ALL
CALIG4:	POP	P,T3		;GET POINTER TO STRING
	MOVE	T2,WIDTH##	;MAX SIZE
CALIG5:	ILDB	T1,T3		;GET CHARACTER
	IDPB	T1,T4		;PUT IT DOWN
	JUMPE	T1,CALIG6	;FINISHED
	SOJG	T2,CALIG5	;DO ALL
CALIG6:	MOVEI	T3,0		;MAKE ASCIZ
	IDPB	T3,T4		;DO IT
	MOVEI	T2,OTLNBF##	;POINT TO STRING
	HRLI	T2,440700	;MAKE BYTE POINTER
	POPJ	P,

	PRGEND
	TITLE	OTSTST	OUTPUT A STRING BETWEEN STARS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	OTSTST

	;ROUTINE TO OUTPUT A STRING BETWEEN STARS OF WIDTH C(WIDTH).
	;ENTER WITH T2 POINTING TO STRING.

OTSTST:	PUSH	P,T2		;SAVE POINTER
	HRROI	T2,[ASCIZ /* /]	;START OFF RIGHT
	PUSHJ	P,STGOUT##	;PRINT IT
	POP	P,T2		;POINT TO STRING
	MOVE	T3,WIDTH##	;GET MAX SIZE
	SUBI	T3,4		;ADJUST FOR STARS
	MOVEI	T4,0		;END ON ZERO
	PUSHJ	P,JSOUT##	;PRINT IT
	 JFCL			;NO ERRORS
	LDB	T4,T2		;GET LAST BYTE
	SKIPE	T4		;IF ZERO-FUDGE IT
	JUMPE	T3,OTSTS1	;ALL DONE
	AOS	T3		;GIVE EXTRA SPACE
	HRROI	T2,SPCBUF##	;POINT TO SPACES
	PUSHJ	P,JSOUT##	;PRINT THEM
	 JFCL			;NO ERRORS
OTSTS1:	HRROI	T2,[ASCIZ / */]
	PUSHJ	P,STGOUT##	;PRINT IT
	PJRST	CRLF##		;NEW LINE

	PRGEND
	TITLE	GENNMF	GENERATE STRING FROM FIRSTNAM & LASTNAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	GENNMF,GENNMO

	;ROUTINE TO GENERATE A STRING SUITABLE FOR A FILENAME FROM
	;A PERSON'S NAME. ENTER WITH BUF POINTING TO NAME BLOCK. RETURN
	;WITH T1 POINTING TO A STRING OF FORM "LASTNAME-FIRSTNAME" OF
	;THE NAME. ENTER AT "GENNMO" WITH BUF POINTING TO DIRECTORY TO
	;GENERATE NAME BASED ON THE OWNER. IF NO OWNER, RETURNED STRING
	;IS THE DIRECTORY NAME.

GENNMO:	SKIPE	DOWN(BUF)	;GET OWNER
	JRST	GENNM1		;OK
	HRROI	T1,DNMB(BUF)	;POINT TO DIRECTORY NAME
	POPJ	P,		;RETURN
GENNM1:	PUSH	P,BUF		;SAVE POINTER
	HRRZ	BUF,DOWN(BUF)	;POINT TO OWNER
	PUSHJ	P,GENNMF	;GENERATE IT
	POP	P,BUF		;RESTORE POINTER
	POPJ	P,		;OK

GENNMF:	HRROI	T1,OTLNBF##	;WHERE TO GENERATE IT
	HRROI	T2,CNAM(BUF)	;LASTNAME
	SETZM	T3		;LONG STRING
	SOUT			;COPY IT
	MOVEI	T2,"-"		;HYPHEN
	BOUT			;WRITE IT
	HRROI	T2,CFST(BUF)	;THEN FIRST NAME
	SETZM	T3		;LONG STRING
	SOUT			;WRITE IT
	HRROI	T1,OTLNBF##	;POINT TO STRING
	POPJ	P,		;DONE

	PRGEND
	TITLE	INIHEP	INITIALISE THE HEAP
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	INIHEP

	;ROUTINE TO INITIALISE THE HEAP. THE HEAP IS AN AREA OF
	;CORE STARTING AT END OF CORE. LOCATION "NXTBUF" IS
	;USED AS A POINTER TO THE NEXT FREE LOCATION ON THE
	;HEAP AND HEPLEN CONTAINS LENGTH OF THE HEAP.
	;ROUTINES USING THE HEAP SHOULD RESPECT THIS LOCATION

INIHEP:	HLRZ	T1,.JBSA##	;GET PROGRAM BREAK
	MOVEM	T1,NXTBUF##	;SAVE IT
	MOVEM	T1,HEAP##	;TWICE
	SUBI	T1,HEPTOP	;GET NEGATIVE LENGTH
	MOVEM	T1,HEPLEN##	;SAVE IT
	POPJ	P,		;OK

	PRGEND
	TITLE	USFLRD	READ A DLUSER-TYPE FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USFLRD

	;ROUTINE TO READ A "DLUSER" TYPE FILE INTO CORE. THE FILE
	;WHICH IS SIMILAR TO THAT OUTPUT BY DLUSER, IS READ INTO A
	;LARGE BUFFER IN CORE. LINKS ARE MADE THROUGH IT TO FACILITATE
	;REFERENCING.

USFLRD:	PUSHJ	P,PLFLRD##	;FIRST READ "PEOPLE" FILE
	 POPJ	P,		;ERROR
	PUSHJ	P,USFLIS##	;GET FILESPEC AND OPEN FILE
	 POPJ	P,		;COULD NOT
	PUSHJ	P,USFLIP##	;READ IT INTO CORE
	 POPJ	P,		;ERROR
	PUSHJ	P,CIFLLJ##	;CLOSE UP
	 JFCL
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	USFLIS	GET INPUT FILESPEC FOR DIRECTORY FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USFLIS

	;HERE TO GET INPUT SPECIFICATION FOR "DLUSER" TYPE FILE.
	;OPENS FILE FOR INPUT ASCII MODE.

USFLIS:	HRROI	T1,[ASCIZ /"DLUSER" FORMAT FILESPEC: /]
	MOVX	A,<GJ%OLD>	;MUST EXIST
	SETZM	B		;FROM OUR DIRECTORY
	HRROI	C,[ASCIZ /USERNAMES/]
	HRRZI	D,[ASCIZ /TXT/]
	PUSHJ	P,CCGTFL##	;GET IT
	HRRZ	INP,T2		;COPY IT
	PJRST	OPFLIA##	;OPEN FOR INPUT ASCII

	PRGEND
	TITLE	USFLIP	INPUT DLUSER-TYPE FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USFLIP

	;ROUTINE TO INPUT "DLUSER"-TYPE FILE INTO CORE.

USFLIP:	MOVEI	T1,DMXUSR	;MAX NUMBER OF USERS
	MOVEM	T1,USNMTB##	;INITIALISE TABLE OF USER NAMES
	SETZM	USCHNS##	;NO START YET
USIPL1:	PUSHJ	P,USRCLD##	;READ ALL RECORDS
	 ERROR	CPOPJ##,<ERROR WHILST READING "DLUSER" FILE>
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	USRCLD	READ RECORDS FROM THE "DLUSER" FILE INTO CORE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USRCLD

	;ROUTINE TO READ RECORDS FROM THE "DLUSER" FILE INTO CORE.

USRCLD:	SKIPL	HEPLEN##	;FILLED HEAP?
	ERROR	CPOPJ##,<FILLED HEAP>
	MOVE	BUF,NXTBUF##	;GET NEXT FREE LOCATION
	MOVE	T1,BUF		;COPY IT
	MOVEI	T2,DSPC(T1)	;UPPER LIMIT
	PUSHJ	P,BLTCLR##	;CLEAR SPACE FIRST
USRCL1:	PUSHJ	P,JBIN##	;GET A CHARACTER
	 JRST	RDRCEF##	;EOF?
	CAIN	T2,"#"		;TYPE?
	JRST	USRCTP		;YES
	CAIE	T2,"&"		;NEW STYLE DLUSER?
	CAIN	T2,"!"		;OR OUR NAME MARKER?
	JRST	USRCNM		;YES
	CAIN	T2,"*"		;OWNER?
	JRST	USRCOW		;YES
	CAIE	T2,"$"		;DOLLAR?
	JRST	USRCL1		;IGNORE IT
	PUSHJ	P,JFLIN##	;GET NUMBER
	 POPJ	P,		;BAD
	MOVEM	T2,DNCN(BUF)	;SAVE IT
	PUSHJ	P,JFLIN##	;GET NEXT
	 POPJ	P,		;BAD
	MOVEM	T2,DNCP(BUF)	;SAVE IT
	PUSHJ	P,JFLIN##	;GET NEXT
	 POPJ	P,		;BAD
	MOVEM	T2,DPCN(BUF)	;SAVE IT
	PUSHJ	P,JFLIN##	;GET NEXT
	 POPJ	P,		;BAD
	MOVEM	T2,DPCP(BUF)	;SAVE IT
	PUSHJ	P,JFLIN##	;GET NEXT
	 POPJ	P,		;BAD
	MOVEM	T2,DDSK(BUF)	;SAVE IT
	JRST	USRCL1		;GET NEXT

PAGE
	;HERE WHEN WE HAVE A TYPE MARKER

USRCTP:	HRROI	T2,NAMBUF##	;WHERE TO PUT IT
	MOVEI	T3,^D39		;MAX CHARACTERS
	PUSHJ	P,RDUPCR##	;READ IT
	 PJRST	RDRCEF##	;BAD?
	MOVEI	T1,TYPTAB##	;LOOK IT UP
	HRROI	T2,NAMBUF##	;POINT TO STRING
	TBLUK			;FIND IT
	TXNN	T2,TL%EXM	;MATCH?
	JRST	[SETZM T1
		 JRST  SAVTYP]	;NONE YET
	HRRZ	T1,(T1)		;GET INDEX
	MOVE	T1,(T1)		;A LONG WAY BUT...
SAVTYP:	MOVEM	T1,DTYP(BUF)	;SAVE IT
	JRST	USRCL1		;LOOK FOR NEXT ITEM

	;HERE TO CHECK VALID TYPE

CHKTYP:	SKIPN	USNCHK##	;NO CHECKS?
	SKIPE	DTYP(BUF)	;VALID?
	POPJ	P,		;YES
	HRROI	T2,[ASCIZ /
UNKNOWN OR BAD TYPE FOR /]
	PUSHJ	P,STGOUT##	;TELL HIM
	PUSHJ	P,PNDRNM##	;ALL
	PUSHJ	P,CRLF##	;THROW LINE
	PUSHJ	P,ESTTYP##	;GET NEW TYPE
	MOVEM	T2,DTYP(BUF)	;SAVE IT
	SETOM	USCHFG##	;SOMETHING CHANGED
	POPJ	P,		;DONE

PAGE
	;HERE WHEN WE HAVE A DIRECTORY MARKER

USRCNM:	HRRZI	T2,DNMB(BUF)	;MAKE A BYTE POINTER
	HRLI	T2,440700	;TO POINT TO NAME
	MOVEM	T2,DNAM(BUF)	;SAVE IT
	MOVEI	T3,^D39		;MAX SIZE
	PUSHJ	P,RDUPCR##	;READ UP TO CARRIAGE RETURN
	 PJRST	RDRCEF##	;ERROR?
	HRROI	T1,DNMB(BUF)	;POINT TO NAME
	PUSHJ	P,JSTNAM##	;ONLY THE NAME WANTED
	PUSHJ	P,USSCNS	;READ UP TO SPACE MARKING PASSWORD
	 PJRST	RDRCEF##	;ERROR?
	HRRZI	T2,DPSB(BUF)	;MAKE A BYTE POINTER
	HRLI	T2,440700	;TO POINT TO PASSWORD
	MOVEM	T2,DPAS(BUF)	;SAVE IT
	MOVEI	T3,^D39		;MAX SIZE
	PUSHJ	P,RDUPCR##	;READ PASSWORD
	 PJRST	RDRCEF##	;BAD?
	MOVSI	D,-<.CDLLD-.CDLIQ+1> ;NUMBER OF PARAMETERS
	HRRI	D,DWOR(BUF)	;WHERE TO PUT IT ALL
USRCL2:	PUSHJ	P,USSCNS	;POSITION TO BEGINNING OF NUMBER
	 PJRST	RDRCEF##	;ERROR?
	MOVEI	T3,10		;OCTAL
	PUSHJ	P,JNIN##	;READ A NUMBER
	 JRST	[CAIE T3,IFIXX3	;OVERFLOW?
		 PJRST RDRCEF##	;NO--ERROR
		 JRST .+1]
	MOVEM	T2,(D)		;SAVE RESULT
	AOBJN	D,USRCL2	;DO ALL
	PUSHJ	P,CHKTYP	;CHECK TYPE
	PUSHJ	P,CHKOWN	;CHECK OWNER
	MOVEI	D,DSPC(BUF)	;WHERE TO LOAD GROUPS
	PUSHJ	P,LODGRP	;LOAD USER GROUPS
	 PJRST	RDRCEF##	;BAD?
	MOVEM	D,DUGP(BUF)	;SAVE POINTER
	ADD	D,(D)		;POINT TO FREE AREA
	AOS	D		;+1
	PUSHJ	P,LODGRP	;LOAD DIRECTORY GROUPS
	 PJRST	RDRCEF##	;ERROR?
	MOVEM	D,DDGP(BUF)	;SAVE POINTER
	ADD	D,(D)		;UPDATE POINTER
	AOS	D
	SUB	D,NXTBUF##	;HOW LONG DID WE GO?
	ADDM	D,NXTBUF##	;A BIT STRANGE BUT..
	ADDM	D,HEPLEN##	;WE MUST DO IT
	MOVE	T2,DNUM(BUF)	;GET NUMBER
	SKIPE	PNT,USCHNS##	;POINT TO START OF CHAIN
	PUSHJ	P,USFNNO##	;FIND WHERE TO PUT IT
	 SKIPA	T1,USCHNS##	;OK--POINT TO CHAIN AGAIN
	ERROR	USRCLD,<TWO DIRECTORIES WITH THE SAME NUMBER>
	PUSHJ	P,LINKIN##	;LINK IT IN
	MOVEM	T1,USCHNS##	;SAVE NEW START
	PUSHJ	P,USINTB##	;PUT IN TABLES
	 POPJ	P,		;COULD NOT
	JRST	USRCLD		;GET NEXT
PAGE
	;HERE WHEN WE HAVE FOUND AN ASTERISK. AN OWNER'S NAME
	;FOLLOWS.


USRCOW:	HRROI	T2,NAMBUF##	;MAKE A BYTE POINTER
	MOVEI	T3,^D39		;MAX SIZE FOR NAME
	PUSHJ	P,RDUPSP##	;GET STRING
	 PJRST	RDRCEF##	;BAD
	HRROI	T2,FSTBUF##	;MAKE BYTE POINTER
	MOVEI	T3,^D39		;MAX SIZE FOR NAME
	PUSHJ	P,RDUPCR##	;GET STRING
	 PJRST	RDRCEF##	;BAD
	JRST	USRCL1		;GET NEXT

	;HERE TO CHECK FOR VALID OWNER

CHKOWN:	PUSHJ	P,PLFNDN##	;SEE IF IT IS A VALID NAME
	 SKIPA	OUTP,[.PRIOU]	;NO
	JRST	USRCN1		;OK
	SKIPN	USNCHK##	;NO CHECKS?
	PUSHJ	P,CHKSYS##	;OR SYSTEM DIRECTORY?
	POPJ	P,		;FORGET IT
	HRROI	T2,[ASCIZ /
UNKNOWN OWNER OF /]
	PUSHJ	P,STGOUT##	;TELL HIM
	PUSHJ	P,PNDRNM##	;TYPE DIRECTORY NAME
	HRROI	T2,[ASCIZ /  (/]
	PUSHJ	P,STGOUT##	;PRINT IT
	PUSHJ	P,PNTNAM##	;PRINT OWNER
	HRROI	T2,[ASCIZ /)
/]
	PUSHJ	P,STGOUT##	;FINISH OFF
	HRROI	T1,[ASCIZ /NEW OWNER: /]
	PUSHJ	P,OWNER1##	;ASK HIM
	SETOM	USCHFG##	;WE HAVE CHANGED SOMETHING
USRCN1:	MOVEM	T2,DOWN(BUF)	;SAVE POINTER
	POPJ	P,		;OK

PAGE
	;ROUTINE TO LOOK FOR A SPACE

USSCNS:	PUSHJ	P,JBIN##	;GET A CHARACTER
	 POPJ	P,		;BAD
	CAIE	T2," "		;SPACE?
	JRST	USSCNS		;NO
	PJRST	CPOPJ1##	;OK

	;HERE TO LOAD USER AND DIRECTORY GROUPS

LODGRP:	PUSHJ	P,USSCNS	;LOOK FOR SPACE
	 POPJ	P,		;BAD
	MOVEI	P1,1(D)		;ADDRESS OF GROUP BLOCK PLUS 1
	MOVEI	T3,^D10		;DECIMAL
LODGP1:	PUSHJ	P,JNIN##	;INPUT NUMBER
	 JRST	LODGP2		;END OF LIST
	MOVEM	T2,(P1)		;SAVE IT
	JUMPE	T2,LODGP2	;END OF LIST
	AOJA	P1,LODGP1	;DO NEXT

LODGP2:	SUB	P1,D		;GET LENGTH
	MOVEM	P1,(D)		;SAVE IT
	PJRST	CPOPJ1##	;SKIP HOME

	PRGEND
	TITLE	PLFLRD	READ "PEOPLE" FILE INTO CORE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLFLRD

	;HERE TO READ THE "PEOPLE" FILE INTO CORE.

PLFLRD:	PUSHJ	P,PLFLIS##	;GET FILESPEC
	 POPJ	P,		;COULD NOT
	PUSHJ	P,PLFLIP##	;READ IT
	 POPJ	P,		;COULD NOT
	PUSHJ	P,CIFLLJ##	;CLOSE UP
	 JFCL
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	PLFLIS	GET INPUT FILESPEC FOR "PEOPLE" FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLFLIS

	;ROUTINE TO GET FILESPEC AND OPEN FILE FOR READING THE
	;"PEOPLE" FILE.

PLFLIS:	HRROI	T1,[ASCIZ /"PEOPLE" FORMAT FILESPEC: /]
	MOVX	A,<GJ%OLD>	;MUST EXIST
	SETZM	B		;FROM OUR DIRECTORY
	HRROI	C,[ASCIZ /CIRCULATION/]
	HRRZI	D,[ASCIZ /TXT/]
	PUSHJ	P,CCGTFL##	;READ IT
	HRRZ	INP,T2		;COPY JFN
	PJRST	OPFLIA##	;OPEN IT
	
	PRGEND
	TITLE	PLFLIP	INPUT "PEOPLE" FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLFLIP

	;ROUTINE TO INPUT "PEOPLE FILE INTO CORE

PLFLIP:	MOVEI	T1,ADRMAX	;MAXIMUM NUMBER OF ADDRESSES
	MOVEM	T1,ADRTAB##	;SET UP TABLE
	MOVEM	T1,CODTAB##	;AND CODE TABLE
	MOVEI	T1,PEPMAX	;MAXIMUM NUMBER OF PEOPLE
	MOVEM	T1,PLNMTB##	;SET UP TABLE
	PUSHJ	P,ADRI##	;READ ADDRESSES
	 POPJ	P,		;BAD OR EOF
	PUSHJ	P,PLRCLD##	;GET NAME ETC.
	 POPJ	P,		;BAD
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	ADRI	READ ADDRESSES FROM FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	ADRI

	;ROUTINE TO READ ADDRESSES FROM "PEOPLE" FILE

ADRI:	PUSHJ	P,JBIN##	;GET A CHARACTER
	 PJRST	RDRCEF##	;BAD
	CAIN	T2,"!"		;START OF NAMES?
	JRST	ADRFNN		;ALL DONE
	CAIE	T2,"*"		;START OF ADDRESS?
	JRST	ADRI		;LOSE IT
	SKIPL	HEPLEN##	;ROOM?
	ERROR	CPOPJ##,<HEAP FULL>
	HRRZ	BUF,NXTBUF##	;POINT TO SPACE
	HRROI	T2,ALOC(BUF)	;POINT TO BUFFER FOR LOCATION
	MOVEI	T3,^D39		;MAX NUMBER OF CHARACTERS
	PUSHJ	P,RDUPCR##	;GET STRING
	 PJRST	RDRCEF##	;BAD
ADILP3:	PUSHJ	P,JBIN##	;GET CHARACTER
	 PJRST	RDRCEF##	;ERROR
	CAIE	T2,"%"		;START OF CODE?
	JRST	ADILP3		;NO
	HRROI	T2,ACOD(BUF)	;POINT TO BUFFER
	MOVEI	T3,4		;UP TO 4 CHARACTERS
	PUSHJ	P,RDUPCR##	;GET IT
	 PJRST	RDRCEF##	;ERROR
ADILP4:	PUSHJ	P,JBIN##	;GET BYTE
	 PJRST	RDRCEF##	;ERROR
	CAIE	T2,"&"		;ADDRESS?
	JRST	ADILP4		;NO
	HRROI	T2,AADR(BUF)	;WHERE TO PUT IT
	MOVEI	T3,^D199	;MAX SIZE
ADILP5:	MOVEI	T4,12		;END ON LF
	PUSHJ	P,JSIN##	;GET STRING
	 PJRST	RDRCEF##	;ERROR
	PUSH	P,T2		;SAVE BYTE POINTER
	PUSHJ	P,JBIN##	;GET CHARACTER
	 JRST	[POP P,T2
		 PJRST RDRCEF##] ;BAD
	CAIE	T2,"&"		;MORE?
	JRST	ADRDUN		;NO
	POP	P,T2		;RESTORE BYTE POINTER
	JRST	ADILP5		;LOOP UP

PAGE
	;HERE WHEN ADDRESS DONE.

ADRDUN:	POP	P,T2		;RESTORE BYTE POINTER
	SETZM	T3		;MAKE ASCIZ
	IDPB	T3,T2		;DO IT
	PUSHJ	P,ADRIN##	;PUT IT IN CORRECT PLACE
	 ERROR	ADRI,<IGNORING ADDRESS>
	MOVEI	T1,ASPC		;UPDATE COUNTERS
	ADDM	T1,HEPLEN##
	ADDM	T1,NXTBUF##	;TO BE CLEAN
	JRST	ADRI		;GET NEXT

	;HERE WHEN WE HAVE READ ALL THE ADDRESSES

ADRFNN:	PUSHJ	P,JBKJFN##	;BACKUP THE POINTER
	 ERROR	CPOPJ##,<NAMES MAY BE MISSING FROM THE FILE!>
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	ADRIN	PUT NEW ADDRESS IN TABLE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	ADRIN

	;ROUTINE TO PUT NEW ADDRESS IN TABLES.

ADRIN:	HRLI	T2,ALOC(BUF)	;POINT TO LOCATION NAME
	HRRI	T2,ALOC(BUF)	;BOTH SIDES
	MOVEI	T1,ADRTAB##	;ADDRESS OF TABLE
	TBADD			;ADD IT
	 ERJMP	.+2		;ERROR
	JRST	CODUPD		;OK
	MOVEI	T1,400000	;GET ERROR CODE
	GETER			;GET IT
	HRRZS	T2		;JUST THE CODE
	CAIN	T2,TADDX1	;FULL?
	 ERROR	CPOPJ##,<LOCATION TABLE FULL>
	CAIN	T2,TADDX2	;ALREADY THERE?
	 ERROR	CPOPJ##,<LOCATION ALREADY IN TABLE>
	POPJ	P,		;RETURN

	;HERE TO INCLUDE NEW CODE IN TABLE

CODUPD:	HRLI	T2,ACOD(BUF)	;POINT TO CODE
	HRRI	T1,ALOC(BUF)	;AND WHOLE BLOCK
	MOVEI	T1,CODTAB##	;POINT TO TABLE
	TBADD			;PUT IT IN
	 ERJMP	.+2		;ERROR
	PJRST	CPOPJ1##	;OK
	HRROI	T2,ACOD(BUF)	;FAILED--DELETE LOCATION ALSO
	MOVEI	T1,ADRTAB##	;POINT TO LOCATION TABLE
	TBLUK			;LOOK IT UP
	MOVE	T2,T1		;MUST BE THERE
	MOVEI	T1,ADRTAB##	;SO DELETE IT
	TBDEL
	ERROR	CPOPJ##,<DUPLICATE CODES ENCOUNTERED--ADDRESS IGNORED>

	PRGEND
	TITLE	PLRCLD	READ CIRCULATION LIST RECORDS INTO CORE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLRCLD

	;ROUTINE TO READ CIRCULATION LIST ENTRIES IN TO CORE.

PLRCLD:	SETZM	BUF		;NOT STARTED YET
	MOVEI	T1,INTTAB##	;SET UP INTERESTS
	PUSHJ	P,SETT36##	;SET IT
	 POPJ	P,		;COULD NOT
	MOVEI	T1,CLSTAB##	;SET UP CLASSIFICATION
	PUSHJ	P,SETT36##	;SET IT
	 POPJ	P,		;COULD NOT
PLRCL1:	PUSHJ	P,JBIN##	;GET CHARACTER
	 PJRST	RDRCEF##	;EOF?
	CAIN	T2,"!"		;START OF ENTRY?
	JRST	PLRCNM		;YES
	JUMPE	BUF,PLRCL1	;LOOP UP
	CAIN	T2,"#"		;INTEREST?
	JRST	PLRCIN		;YES
	CAIE	T2,"@"		;CLASSIFICATION?
	JRST	PLRCL1		;NO
	HRROI	T2,NAMBUF##	;WHERE TO PUT IT
	MOVEI	T3,^D39		;MAX SIZE
	PUSHJ	P,RDUPCR##	;READ IT
	 PJRST	RDRCEF##	;BAD
	MOVEI	T1,CLSTAB##	;AND CLASS TABLE
	PUSHJ	P,FNDDEF##	;FIND IT
	 POPJ	P,		;BAD
	IORM	T2,CCLS(BUF)	;SET BIT
	JRST	PLRCL1		;LOOP UP

	;HERE WHEN WE HAVE FOUND AN INTEREST

PLRCIN:	HRROI	T2,NAMBUF##	;WHERE TO PUT IT
	MOVEI	T3,^D39		;MAX SIZE
	PUSHJ	P,RDUPCR##	;READ IT
	 PJRST	RDRCEF##	;BAD
	MOVEI	T1,INTTAB##	;POINT TO TABLE
	PUSHJ	P,FNDDEF##	;GET IT
	 POPJ	P,		;BAD
	IORM	T2,CINT(BUF)	;SET INTEREST
	JRST	PLRCL1		;GET NEXT

PAGE
	;HERE WHEN WE HAVE AN ENTRY

PLRCNM:	SKIPL	HEPLEN##	;ROOM?
	ERROR	CPOPJ##,<HEAP FULL>
	MOVE	BUF,NXTBUF##	;POINT TO FREE SPACE
	MOVE	T1,BUF		;COPY POINTER
	MOVEI	T2,CSPC(BUF)	;UPPER LIMIT
	PUSHJ	P,BLTCLR##	;CLEAR UP FIRST
	HRROI	T2,CNAM(BUF)	;WHERE TO PUT NAME
	MOVEI	T3,NMLEN*5-1	;MAX LENGTH
	PUSHJ	P,RDUPSP##	;READ IT
	 PJRST	RDRCEF##	;BAD
	HRROI	T2,CFST(BUF)	;NOW FOR FIRST NAME
	MOVEI	T3,NMLEN*5-1	;MAX LENGTH
	PUSHJ	P,RDUPCR##	;READ IT
	 PJRST	RDRCEF##	;BAD
PLRCN1:	PUSHJ	P,JBIN##	;GET A CHARACTER
	 PJRST	RDRCEF##	;BAD
	CAIE	T2,"%"		;FOUND LOCATION?
	JRST	PLRCN1		;NO
	HRROI	T2,NAMBUF##	;AND ADDRESS
	MOVEI	T3,^D39		;MAX SIZE
	PUSHJ	P,RDUPCR##	;READ IT
	 PJRST	RDRCEF##	;BAD
	PUSHJ	P,PLFNDL##	;CHECK IT
	 PUSHJ	P,CHKLOC	;GET NEW ONE
	MOVEM	T2,CADR(BUF)	;SAVE POINTER
	PUSHJ	P,PLINTB##	;PUT IN TABLES
	 POPJ	P,		;FAILED
	MOVEI	T1,CSPC		;UPDATE THINGS
	ADDM	T1,NXTBUF##	;TWO OF THEM
	ADDM	T1,HEPLEN##	;FOR SAFETY
	JRST	PLRCL1		;GET NEXT

	;HERE TO GET NEW LOCATION WHEN FILE VERSION UNRECOGNISED.

CHKLOC:	HRROI	T2,[ASCIZ /
UNKNOWN LOCATION FOR /]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	T2,BUF		;POINT TO BLOCK
	PUSHJ	P,PNTPEP##	;PRINT NAME
	PUSHJ	P,CRLF##	;NEW LINE
	PJRST	PLPRLC##	;GET NEW LOCATION

	PRGEND
	TITLE	PLINTB	PUT PEOPLE DETAILS IN TABLES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLINTB

	;ROUTINE TO PUT ENTRIES FROM "PEOPLE" ENTRY INTO TABLES.

PLINTB:	MOVEI	T1,PLNMTB##	;POINT TO NAME TABLE
	HRLI	T2,CNAM(BUF)	;POINT TO NAME
	HRR	T2,BUF		;MAKE ENTRY
	TBADD			;PUT IT IN
	 ERJMP	.+2		;ERROR
	PJRST	CPOPJ1##	;OK
	MOVEI	T1,400000	;GET ERROR
	GETER
	HRRZS	T2		;JUST ERROR
	CAIE	T2,TADDX2	;ALREADY THERE?
	ERROR	CPOPJ##,<NAME TABLE FULL>
	MOVEI	T1,PLNMTB##	;POINT TO TABLE
	HRROI	T2,CNAM(BUF)	;FIND ENTRY
	TBLUK			;MUST BE THERE
	HRRZ	T1,(T1)		;GET POINTER
PLTBL1:	HRRZ	T2,(T1)		;END OF CHAIN?
	JUMPE	T2,PLTBL2	;YES
	HRRZ	T1,(T1)		;MOVE ON
	JRST	PLTBL1		;KEEP ON
PLTBL2:	HRRM	BUF,(T1)	;MAKE LINK
	HRLZM	T1,(BUF)	;BOTH WAYS
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	USINTB	PUT DIRECTORY IN TABLES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USINTB

	;ROUTINE TO PUT DIRECTORY NAME IN TABLES. ENTER WITH
	;BUF POINTING TO DIRECTORY. RETURN +1 IF ERROR, OR SKIP
	;IF OK.

USINTB:	MOVEI	T1,USNMTB##	;POINT TO TABLE
	HRLI	T2,DNMB(BUF)	;POINT TO NAME
	HRR	T2,BUF		;BUILD ENTRY
	PUSHJ	P,NMITAB##	;PUT IT IN
	 ERROR	CPOPJ##,<NAME TABLE FULL>
	 POPJ	P,
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	PNDRLS	LIST SPECIFIED DIRECTORIES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRLS

	;ROUTINE TO LIST DIRECTORIES. ENTER WITH A=0 IF PASSWORD
	;NOT REQUIRED, OR -1 OTHERWISE. ROUTINE ASKS FOR 
	;SPECIFICATION OF DIRECTORIES TO BE PRINTED AND THEN
	;PRINTS THEM.

PNDRLS:	HRROI	T1,[ASCIZ /LIST SPECIFICATIONS: /]
	MOVEI	T2,LSTTAB	;AND KEY WORDS
	PUSHJ	P,CDSRGS##	;SAVE PARAMETERS
	PUSHJ	P,CDSETP##	;SET UP
LSTLS1:	MOVE	T2,CMDT2##	;GET POINTER TO TABLE
	PUSHJ	P,CDGKEY##	;LOOK IT UP
	 JRST	LSTLS1		;REPARSE
	 ERROR	PNDRLS,<NOT VALID>
	HRRZ	T2,(T2)		;GET DISPATCH
	PUSHJ	P,(T2)		;AND DISPATCH
	 JRST	LSTLS1		;REPARSE
	JRST	PNDRLS		;DO NEXT

LSTTAB:	LSTSIZ,,LSTMAX
	TB (.LSNMR,EXIT-FROM-LISTING)
	TB (.LSNAM,NAME-OF-DIRECTORY)
	TB (.LSOWN,OWNER-OF-DIRECTORY)
	TB (.LSTYP,TYPE-OF-DIRECTORIES)
LSTSIZ==.-LSTTAB-1
LSTMAX==LSTSIZ+1

PAGE
	;HERE TO TYPE DIRECTORY WITH GIVEN NAME

.LSNAM:	PUSHJ	P,USGTNM##	;GET NAME
	 ERROR	CPOPJ1##,<NAME MUST BE SPECIFIED>
	 ERROR	CPOPJ1##,<UNKNOWN NAME>
	PUSHJ	P,PNDRDR##	;LIST IT
	PJRST	CPOPJ1##	;SKIP HOME

	;HERE TO TYPE DIRECTORIES OF A GIVEN TYPE

.LSTYP:	HRROI	T2,[ASCIZ /DIRECTORY TYPE/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T2,TYPTAB##	;POINT TO TYPE TABLES
	PUSHJ	P,CRGKEY##	;GET IT
	 ERROR	CPOPJ1##,<BAD DIRECTORY TYPE>
	PUSHJ	P,CRGTCM##	;AND CONFIRMATION
	 ERROR	CPOPJ1##,<BAD CONFIRMATION>
	HRRZ	T2,(T2)		;GET TYPE INDEX
	MOVE	B,(T2)		;AND TYPE
	MOVE	PNT,USCHNS##	;POINT TO CHAIN OR DIRECTORIES
.LSSC1:	MOVE	BUF,PNT		;COPY POINTER
	PUSH	P,B		;SAVE TYPE
	CAMN	B,DTYP(BUF)	;SATISFIED?
	PUSHJ	P,PNDRDR##	;YES--PRINT IT
	POP	P,B		;RESTORE TYPE
	PUSHJ	P,MOVEUP##	;GET NEXT
	 PJRST	CPOPJ1##	;AT END
	JRST	.LSSC1		;DO ALL

	;HERE TO FINISH UP

.LSNMR:	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 JFCL
	PJRST	T1POPJ##	;GO UP ONE

PAGE
	;HERE TO LIST ALL DIRECTORIES OWNED BY SOMEBODY

.LSOWN:	PUSHJ	P,PLGTNM##	;GET NAME
	 POPJ	P,		;REPARSE
	 ERROR	CPOPJ1##,<UNKNOWN NAME>
	HRRZ	B,BUF		;POINT TO OWNER BLOCK
	MOVE	PNT,USCHNS##	;AND START OF CHAIN
.LSOW1:	MOVE	BUF,PNT		;POINT TO DIRECTORY
	PUSH	P,B		;SAVE B
	CAMN	B,DOWN(BUF)	;OWNED BY HIM?
	PUSHJ	P,PNDRDR##	;YES--PRINT IT
	POP	P,B		;RESTORE POINTER TO OWNER
	PUSHJ	P,MOVEUP##	;DO NEXT
	 PJRST	CPOPJ1##	;DONE
	JRST	.LSOW1		;DO NEXT

	PRGEND
	TITLE	PNDRDR	LIST DIRECTORY
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRDR

	;ROUTINE TO LIST DETAILS OF DIRECTORY. ENTER WITH A=0 IF
	;PASSWORD NOT REQUIRED, OR -1 OTHERWISE.

PNDRDR:	HRROI	T2,[ASCIZ /
********************** DIRECTORY ENTRY **************************

/]
	PUSHJ	P,STGOUT##	;START OFF RIGHT
	PUSHJ	P,PNDRNM##	;PRINT DIRECTORY NAME
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRTP##	;AND TYPE
	PUSHJ	P,CRLF##
	JUMPE	A,NOPAS		;NO PASSWORD?
	PUSHJ	P,PNDRPW##	;YES
	PUSHJ	P,CRLF##
NOPAS:	PUSHJ	P,PNDROW##	;OWNER
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRNO##	;NUMBER
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRWS##	;WORKING STOREAGE
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRPS##	;PERMANENT STOREAGE
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRGN##	;GENERATION RETENTION COUNT
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRDP##	;DIRECTORY PROTECTION
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRFP##	;FILE PROTECTION
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRLG##	;LAST LOGGED IN
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDCHG##	;CHARGES
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRMD##	;MODE WORD
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRCP##	;CAPABILITIES
	PUSHJ	P,CRLF##
	PUSHJ	P,PNDRGP##	;GROUPS
	PUSHJ	P,CRLF##
	PJRST	CRLF##		;OK

	PRGEND
	TITLE	PNDRNM	PRINT DIRECTORY NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRNM

	;ROUTINE TO PRINT NAME OF DIRECTORY. ENTER WITH "BUF"
	;POINTING TO DIRECTORY BLOCK.

PNDRNM:	HRROI	T2,[ASCIZ /DIRECTORY: /]
	PUSHJ	P,STGOUT##	;PRINT FIRST BIT
	HRROI	T2,DNMB(BUF)	;POINT TO NAME
	PJRST	STGOUT##	;PRINT STRING

	PRGEND
	TITLE	PNDRTP	PRINT DIRECTORY TYPE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRTP

	;ROUTINE TO PRINT DIRECTORY TYPE. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRTP:	HRROI	T2,[ASCIZ /TYPE: /]
	PUSHJ	P,STGOUT##	;START OFF RIGHT
	HRRZ	T2,DTYP(BUF)	;POINT TO BLOCK
	HRRZ	T2,TYPLNK(T2)	;AND TYPE STRING
	HLRO	T2,(T2)		;POINT TO STRING
	PJRST	STGOUT##	;OK

	PRGEND
	TITLE	PNDRPW	PRINT DIRECTORY PASSWORD
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRPW

	;ROUTINE TO PRINT PASSWORD. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRPW:	HRROI	T2,[ASCIZ /PASSWORD: /]
	PUSHJ	P,STGOUT##	;START OFF
	HRROI	T2,DPSB(BUF)	;AND PASSWORD
	PJRST	STGOUT##	;DO IT

	PRGEND
	TITLE	PNDROW	PRINT OWNER OF DIRECTORY
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDROW

	;ROUTINE TO PRINT OWNER OF DIRECTORY. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDROW:	HRROI	T2,[ASCIZ /OWNER: /]
	PUSHJ	P,STGOUT##	;START OFF
	HRRZ	T2,DOWN(BUF)	;POINT TO OWNER
	JUMPE	T2,CPOPJ##	;NONE
	PJRST	PNTPEP##	;PRINT IT

	PRGEND
	TITLE	PNDRNO	PRINT DIRECTORY NUMBER
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRNO

	;ROUTINE TO PRINT DIRECTORY NUMBER. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.


PNDRNO:	HRROI	T2,[ASCIZ /DIRECTORY NUMBER: /]
	PUSHJ	P,STGOUT##	;START OFF
	MOVE	T2,DNUM(BUF)	;GET IT
	MOVEI	T3,10		;OCTAL
	PJRST	NUMOUT##	;PRINT IT

	PRGEND
	TITLE	PNDRWS	PRINT WORKING STORAGE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRWS

	;ROUTINE TO PRINT WORKING STOREAGE. ENTER WITH BUF POINTING
	;TO DIRECTORY.

PNDRWS:	HRROI	T2,[ASCIZ /WORKING LIMIT: /]
	PUSHJ	P,STGOUT##
	MOVE	T2,DWOR(BUF)	;GET IT
	MOVEI	T3,^D10		;DECIMAL
	PJRST	NUMOUT##	;PRINT IT

	PRGEND
	TITLE	PNDRPS	PRINT PERMANENT LIMIT
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRPS

	;ROUTINE TO PRINT PERMANENT LIMIT. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRPS:	HRROI	T2,[ASCIZ /PERMANENT LIMIT: /]
	PUSHJ	P,STGOUT##
	MOVE	T2,DPER(BUF)	;GET IT
	MOVEI	T3,^D10		;DECIMAL
	PJRST	NUMOUT##	;PRINT IT

	PRGEND
	TITLE	PNDRGN	PRINT GENERATION RETENTION COUNT
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRGN

	;ROUTINE TO PRINT GENERATION RETENTION COUNT. ENTER WITH BUF
	;POINTING TO DIRECTORY BLOCK.

PNDRGN:	HRROI	T2,[ASCIZ /GENERATION RETENTION COUNT: /]
	PUSHJ	P,STGOUT##
	HRRZ	T2,DRET(BUF)	;GET IT
	MOVEI	T3,^D10		;DECIMAL
	PJRST	NUMOUT##	;DO IT

	PRGEND
	TITLE	PNDRDP	PRINT DIRECTORY PROTECTION
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRDP

	;ROUTINE TO PRINT DIRECTORY PROTECTION. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRDP:	HRROI	T2,[ASCIZ /DIRECTORY PROTECTION: /]
	PUSHJ	P,STGOUT##	;START OFF
	HRRZ	T2,DDPT(BUF)	;GET IT
	MOVEI	T3,10		;OCTAL
	PJRST	NUMOUT##	;PRINT IT

	PRGEND
	TITLE	PNDRFP	PRINT FILE PROTECTION
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRFP

	;ROUTINE TO PRINT FILE PROTECTION .ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRFP:	HRROI	T2,[ASCIZ /FILE PROTECTION: /]
	PUSHJ	P,STGOUT##
	HRRZ	T2,DPRT(BUF)	;GET IT
	MOVEI	T3,10		;OCTAL
	PJRST	NUMOUT##	;PRINT IT

	PRGEND
	TITLE	PNDRLG	PRINT DATE OF LAST LOGIN
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRLG

	;ROUTINE TO PRINT DATE OF LAST LOGIN. ENTER WITH BUF
	;POINTING TO DIRECTORY BLOCK.

PNDRLG:	HRROI	T2,[ASCIZ /LAST LOGIN DATE: /]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	T2,DLLG(BUF)	;GET DATE
	PJRST	DATEOT##	;PRINT IT

	PRGEND
	TITLE	PNDCHG	PRINT CHARGES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDCHG

	;ROUTINE TO PRINT CHARGES. ENTER WITH BUF POINTING TO DIRECTORY
	;BLOCK.

PNDCHG:	HRROI	T2,[ASCIZ /CHARGES (NCN,NCP,PCN,PCP,DSK): /]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	T2,DNCN(BUF)	;NON-PEAK CONNECT CHARGE
	MOVX	T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
	PUSHJ	P,JFLOUT##	;PRINT IT
	 POPJ	P,		;BAD
	MOVEI	T2,","		;PRINT COMMA
	PUSHJ	P,JBOUT##	;DO IT
	 POPJ	P,		;BAD
	MOVE	T2,DNCP(BUF)	;NON-PEAK CPU CHARGE
	MOVX	T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
	PUSHJ	P,JFLOUT##	;PRINT IT
	 POPJ	P,		;BAD
	MOVEI	T2,","		;PRINT COMMA
	PUSHJ	P,JBOUT##	;DO IT
	 POPJ	P,		;BAD
	MOVE	T2,DPCN(BUF)	;PEAK CONNECT CHARGE
	MOVX	T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
	PUSHJ	P,JFLOUT##	;PRINT IT
	 POPJ	P,		;BAD
	MOVEI	T2,","		;PRINT COMMA
	PUSHJ	P,JBOUT##	;DO IT
	 POPJ	P,		;BAD
	MOVE	T2,DPCP(BUF)	;PEAK CPU TIME
	MOVX	T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
	PUSHJ	P,JFLOUT##	;PRINT IT
	 POPJ	P,		;BAD
	MOVEI	T2,","		;PRINT COMMA
	PUSHJ	P,JBOUT##	;DO IT
	 POPJ	P,		;BAD
	MOVE	T2,DDSK(BUF)	;GET DISK CHARGE
	MOVX	T3,<FL%ONE+FL%PNT+FLD(2,FL%SND)>
	PUSHJ	P,JFLOUT##	;PRINT IT
	 POPJ	P,		;BAD
	POPJ	P,		;OK

	PRGEND
	TITLE	PNDRMD	PRINT MODE WORD
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRMD

	;ROUTINE TO PRINT MODE WORD. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRMD:	HRROI	T2,[ASCIZ /MODE WORD:- 

/]
	PUSHJ	P,STGOUT##	;START OFF
	MOVE	D,DMOD(BUF)	;GET MODE WORD
	JUMPE	D,NOMOD		;NO BITS
	HRROI	T2,[ASCIZ /	FILES ONLY
/]
	TXNE	D,CD%DIR	;ARE WE?
	PUSHJ	P,STGOUT##	;YES
	HRROI	T2,[ASCIZ /	ALPHANUMERIC ACCOUNTS
/]
	TXNE	D,CD%ANA	;ARE WE?
	PUSHJ	P,STGOUT##	;YES
	HRROI	T2,[ASCIZ /	REPEAT LOGIN MESSAGES
/]
	TXNE	D,CD%RLM	;DO WE?
	PUSHJ	P,STGOUT##	;YES
	POPJ	P,

	;HERE IF NOTHING

NOMOD:	HRROI	T2,[ASCIZ /	** NO BITS SET **
/]
	PJRST	STGOUT##	;TELL HIM

	PRGEND
	TITLE	PNDRCP	PRINT CAPABILITIES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRCP

	;ROUTINE TO PRINT CAPABILITIES. ENTER WITH BUF POINTING
	;TO DIRECTORY BLOCK.

PNDRCP:	HRROI	T2,[ASCIZ /
CAPABILITIES

/]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	A,DCAP(BUF)	;GET BITS
	MOVEI	B,"	"	;PREFIX WITH A TAB
	MOVEI	D,CAPTAB##	;POINT TO TABLE
	PUSHJ	P,PNTBIT##	;PRINT THEM
	 JFCL		;IGNORE ERRORS
	POPJ	P,		;RETURN

	PRGEND
	TITLE	PNDGRP	PRINT DIRECTORY GROUPS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNDRGP

	;ROUTINE TO PRINT GROUPS FOR A DIRECTORY. ENTER WITH BUF
	;POINTING TO DIRECTORY.

PNDRGP:	HRROI	T2,[ASCIZ /
USER GROUPS: /]
	PUSHJ	P,STGOUT
	MOVE	D,DUGP(BUF)	;POINT TO USER GROUPS
	PUSHJ	P,PNTGRP	;PRINT IT
	HRROI	T2,[ASCIZ /

DIRECTORY GROUPS: /]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	D,DDGP(BUF)	;POINT TO GROUP LIST
	PUSHJ	P,PNTGRP	;PRINT IT
	PJRST	CRLF##		;FINISH UP

	;HERE TO PRINT A GROUP LIST

PNTGRP:	MOVEI	C,^D10		;A COUNT
PNTGP1:	AOS	D		;LOOK AT NEXT GROUP
	MOVE	T2,(D)		;GET IT
	JUMPE	T2,CPOPJ##	;FINISHED
	MOVEI	T3,^D10		;DECIMAL
	PUSHJ	P,NUMOUT##	;PRINT IT
	PUSHJ	P,SPCOUT##	;AND A SPACE
	SOJG	C,PNTGP1	;DO NEXT
	PUSHJ	P,CRLF##	;NEW LINE
	JRST	PNTGRP		;RESET

	PRGEND
	TITLE	PLPRLS	LIST SPECIFIED PEOPLE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLPRLS

	;ROUTINE TO LIST ENTRIES FROM THE "PEOPLE" FILE. ASKS
	;FOR SPECIFICATIONS OF PRINTOUT AND THEN PRINTS THEM.

PLPRLS:	HRROI	T1,[ASCIZ /LIST SPECIFICATIONS: /]
	MOVEI	T2,LSTTAB	;POINT TO TABLE
	PUSHJ	P,CDSRGS##	;SAVE ARGS
	PUSHJ	P,CDSETP##	;SET UP AND INITIALISE
LSTLS1:	MOVE	T2,CMDT2##	;GET POINTERS TO TABLE
	PUSHJ	P,CDGKEY##	;GET COMMAND
	 JRST	LSTLS1		;REPARSE
	 ERROR	PLPRLS,<NOT VALID>
	HRRZ	T2,(T2)		;GET DISPATCH
	PUSHJ	P,(T2)		;DO IT
	 JRST	LSTLS1		;REPARSE
	JRST	PLPRLS		;DO NEXT

LSTTAB:	LSTSIZ,,LSTMAX
	TB (.LSADR,ADDRESS)
	TB (.LSNMR,EXIT-FROM-LISTING)
	TB (.LSINT,INTERESTED-PEOPLE)
	TB (.LSNAM,NAME)
LSTSIZ==.-LSTTAB-1
LSTMAX==LSTSIZ+1

PAGE
	;HERE TO LIST PERSON BY NAME

.LSNAM:	PUSHJ	P,PLGTNM##	;GET NAME
	 POPJ	P,		;REPARSE
	 ERROR	CPOPJ1##,<UNKNOWN PERSON>
	PUSHJ	P,PLPRPR##	;PRINT HIM
	PJRST	CPOPJ1##	;OK

	;HERE TO LIST AN ADDRESS

.LSADR:	PUSHJ	P,PLADLC##	;GET LOCATION
	 POPJ	P,		;REPARSE
	 ERROR	CPOPJ1##,<UNKNOWN ADDRESS>
	PUSHJ	P,PLADPR##	;LIST IT
	PJRST	CPOPJ1##	;OK

	;HERE TO FINISH UP

.LSNMR:	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 JFCL
	PJRST	T1POPJ##	;RETURN

PAGE
	;LIST PEOPLE WITH INTERESTS

.LSINT:	HRROI	T2,[ASCIZ /INTERESTED IN/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T2,INTTAB##	;POINT TO TABLE
	PUSHJ	P,CRGKEY##	;GET IT
	 ERROR	CPOPJ1##,<UNKNOWN INTEREST>
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD
	HRRZ	P1,(T2)		;GET ADDRESS OF BIT
	MOVE	P1,(P1)		;GET BIT
	MOVEI	D,PLNMTB##	;LOOK AT NAMES
	PUSHJ	P,SETTBD##	;SET UP D
	 PJRST	CPOPJ1##	;NONE
.LSIN1:	HRRZ	BUF,(D)		;POINT TO ENTRY
.LSIN2:	PUSH	P,D		;SAVE POINTER
	TDNE	P1,CINT(BUF)	;INTERESTED?
	PUSHJ	P,PLPRPS##	;YES
	POP	P,D		;RESTORE POINTER
	HRRZ	BUF,CLOC(BUF)	;FOLLOW CHAIN
	JUMPN	BUF,.LSIN2	;FOR MULTIPLES
	AOBJN	D,.LSIN1	;DO ALL
	PJRST	CPOPJ1##	;ALL DONE

	PRGEND
	TITLE	PLPRPR	LIST A PERSON'S DETAILS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLPRPR,PLPRPS,PLPRIN

	;ROUTINE TO LIST A PERSON'S DETAILS.

PLPRPR:	PUSHJ	P,PLPRPS	;NAME AND ADDRESS
	PJRST	PLPRIN		;AND OTHER DETAILS

	;ROUTINE TO PRINT NAME AND ADDRESS

PLPRPS:	PUSHJ	P,CRLF##	;START AFRESH
	HRROI	T2,[ASCIZ /    NAME: /]
	PUSHJ	P,STGOUT##	;PRINT IT
	MOVE	T2,BUF		;COPY POINTER
	PUSHJ	P,PNTPEP##	;PRINT NAME
	PUSH	P,BUF		;SAVE POINTER
	HRRZ	BUF,CADR(BUF)	;GET ADDRESS OF ADDRESS
	PUSHJ	P,PLADPR##	;PRINT ADDRESS
	POP	P,BUF		;RESTORE POINTER
	POPJ	P,		;OK
	;ROUTINE TO PRINT PERSON'S OTHER DETAILS

PLPRIN:	HRROI	T2,[ASCIZ /    CLASSIFICATION:
/]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	A,CCLS(BUF)	;GET BITS
	MOVEI	B,"	"	;PREFIX WITH A TAB
	MOVEI	D,CLSTAB##	;POINT TO TABLE
	PUSHJ	P,PNTBIT##	;PRINT THEM
	 JFCL			;IGNORE ERRORS
	HRROI	T2,[ASCIZ /    INTERESTS:
/]
	PUSHJ	P,STGOUT##	;PRINT IT
	MOVE	A,CINT(BUF)	;GET BITS
	MOVEI	B,"	"	;TAB PREFIX
	MOVEI	D,INTTAB##	;POINT TO TABLE
	PUSHJ	P,PNTBIT##	;PRINT THEM
	 JFCL			;IGNORE ERRORS
	PJRST	CRLF##		;NEW LINE

	PRGEND
	TITLE	PLADPR	PRINT AN ADDRESS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLADPR

	;ROUTINE TO PRINT AN ADDRESS

PLADPR:	PUSHJ	P,CRLF##	;START AFRESH
	HRROI	T2,[ASCIZ /    LOCATION: /]
	PUSHJ	P,STGOUT##	;TELL HIM
	HRROI	T2,ALOC(BUF)	;POINT TO IT
	PUSHJ	P,STGOUT##	;DO IT
	PUSHJ	P,CRLF##	;NEW LINE
	HRROI	T2,[ASCIZ /    CODE: /]
	PUSHJ	P,STGOUT##	;TELL HIM
	HRROI	T2,ACOD(BUF)	;WRITE IT
	PUSHJ	P,STGOUT##	;PRINT IT
	PUSHJ	P,CRLF##	;NEW LINE
	HRROI	T2,[ASCIZ /    ADDRESS:
    /]
	PUSHJ	P,STGOUT##	;TELL HIM
	MOVE	T3,[440700,,AADR(BUF)] ;POINT TO ADDRESS
ADPLP1:	ILDB	T2,T3		;GET CHAR
	JUMPE	T2,CRLF##	;ALL DONE
	CAIN	T2,15		;CR?
	JRST	ADPLP1		;IGNORE IT
	CAIN	T2,12		;LF?
	JRST	ADPLP2		;YES
	PUSHJ	P,CHROUT##	;TYPE IT
	JRST	ADPLP1		;GET NEXT
ADPLP2:	HRROI	T2,[ASCIZ /
    /]
	PUSH	P,T3		;SAVE BYTE POINTER
	PUSHJ	P,STGOUT##	;NEW LINE
	POP	P,T3		;RESTORE BYTE POINTER
	JRST	ADPLP1		;DO NEXT

	PRGEND
	TITLE	PNTNAM	PRINT A NAME OF A PERSON
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNTNAM

	;ROUTINE TO PRINT A NAME. ENTER WITH FIRST NAME IN "FSTBUF"
	;AND LAST NAME IN "NAMBUF".

PNTNAM:	HRROI	T2,FSTBUF##	;POINT TO IT
	PUSHJ	P,STGOUT##	;PRINT IT
	PUSHJ	P,SPCOUT##	;A SPACE
	HRROI	T2,NAMBUF##	;AND LAST NAME
	PJRST	STGOUT##	;DO IT

	PRGEND
	TITLE	PNTPEP	PRINT A NAME FROM A RECORD
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNTPEP

	;ROUTINE TO PRINT A "PEOPLE" NAME ENTRY. ENTER WITH T2
	;POINTING TO ENTRY.

PNTPEP:	PUSH	P,T2		;SAVE POINTER
	HRROI	T2,CFST(T2)	;POINT TO FIRST NAME
	PUSHJ	P,STGOUT##	;PRINT IT
	PUSHJ	P,SPCOUT##	;PRINT A SPACE
	POP	P,T2		;GET POINTER AGAIN
	HRROI	T2,CNAM(T2)	;AND POINT TO SECOND NAME
	PJRST	STGOUT##	;PRINT IT

	PRGEND
	TITLE	PLGTNM	GET A RECOGNISED NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLGTNM

	;ROUTINE TO GET A RECOGNISED NAME. ENTER ALREADY INITIALISED
	;RETURN +1 FOR REPARSE, SKIP FOR ERROR, OR DOUBLE SKIP IF OK
	;WITH BUF POINTING TO ENTRY.

PLGTNM:	PUSHJ	P,OWNER2##	;GET IT
	 POPJ	P,		;REPARSE
	 PJRST	CPOPJ1##	;BAD
	MOVE	BUF,T2		;POINT TO IT
	PJRST	CPOPJ2##	;DOUBLE SKIP

	PRGEND
	TITLE	PLADLC	GET A RECOGNISED ADDRESS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLADLC

	;ROUTINE TO GET RECOGNISED ADDRESS. ENTER ALREADY INITIALISED
	;RETURN +1 FOR REPARSE. SKIP FOR ERROR, OR DOUBLE SKIP IF OK
	;WITH BUF POINTING TO ADDRESS BLOCK.
PLADLC:	HRROI	T2,[ASCIZ /ADDRESS ID/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T2,ADRTAB##	;POINT TO TABLE
	PUSHJ	P,CRGKEY##	;FIND IT
	 PJRST	CPOPJ1##	;BAD
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD
	HRRZ	BUF,(T2)	;GET DISPATCH
	PJRST	CPOPJ2##	;OK

	PRGEND
	TITLE	PEPLST	GET A LIST OF PEOPLE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PEPLST

	;ROUTINE TO GET A LIST OF PEOPLE. ENTER WITH "C" CONTAINING
	;AN "AOBJN" POINTER FOR A LIST, AND "B" CONTAINING AN "AOBJN"
	;POINTER FOR A SECOND LIST. "T1" SHOULD POINT TO A PROMPT.
	;THE ROUTINE ASKS FOR EITHER NAMES OR CLASSIFICATIONS AND FILLS
	;THE LIST POINTED TO BY "C" WITH THE ADDRESSES OF EACH IN-CORE
	;BLOCK. IF AN ENTRY ALREADY EXISTS IN THE LIST POINTED TO BY
	;"C" OR "B" IT IS NOT REPEATED. RETURN +1 ALWAYS.

PEPLST:	PUSHJ	P,CDSRGS##	;SAVE PROMPT
PEPER1:	PUSHJ	P,CDSETP##	;SET UP AND INITIALISE
PEPRP1:	MOVEI	T2,PEPTAB	;ALL OR NOTHING
	MOVEI	T3,PLNMTB##	;NAMES
	PUSHJ	P,CDDKEY##	;GET IT
	 JRST	PEPRP1		;REPARSE
	 ERROR	PEPER1,<BAD NAME OR OPTION>
	HRRZ	T1,(T2)		;GET DISPATCH
	CAMGE	T1,HEAP##	;ON THE HEAP?
	JRST	(T1)		;EXECUTE ROUTINE
	PUSHJ	P,OWNER3##	;GET FULL DETAILS
	 JRST	PEPRP1		;REPARSE
	 JRST	PEPER1		;BAD
	PUSHJ	P,INLIST	;PUT IT IN
	JRST	PEPER1		;GET NEXT

	;HERE AT END

ENDLST:	PUSHJ	P,CDGTCM##	;GET CONFIRMATION
	 JRST	PEPRP1		;REPARSE
	 JRST	PEPER1		;BAD
	POPJ	P,		;OK

ALORNN:	HRROI	T2,[ASCIZ /WITH CLASSIFICATION/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T2,CLSTAB##	;CLASSIFICATION
	PUSHJ	P,CDGKEY##	;GET IT
	 JRST	PEPRP1		;REPARSE
	 ERROR	PEPER1,<BAD CLASSIFICATION>
	PUSHJ	P,CDGTCM##	;GET CONFIRMATION
	 JRST	PEPRP1		;REPARSE
	 JRST	PEPER1		;ERROR
	HRRZ	T1,(T2)		;GET DISPATCH
	MOVE	T1,(T1)		;GET BIT
	MOVEI	D,PLNMTB##	;SET UP D
	PUSHJ	P,SETTBD##	;DO IT
	 JRST	PEPER1		;NONE!!
ALORN1:	HRRZ	T2,(D)		;POINT TO IT
ALORN2:	PUSH	P,D		;SAVE POINTER
	PUSH	P,T1		;AND BIT
	TDNE	T1,CCLS(T2)	;GOOD?
	PUSHJ	P,INLIST	;YES-- PUT HIM IN
	POP	P,T1		;GET BIT BACK
	POP	P,D		;RESTORE D
	HRRZ	T2,CLOC(T2)	;FOLLOW CHAIN
	JUMPN	T2,ALORN2	;FOR MULTIPLES
	AOBJN	D,ALORN1	;DO ALL
	JRST	PEPER1		;ALL DONE

PAGE
	;ALL OR NOTHING TABLE

PEPTAB:	PEPSIZ,,PEPMAX
	TB (ALORNN,ALL-PEOPLE)
	TB (ENDLST,END-OF-LIST)
PEPSIZ==.-PEPTAB-1
PEPMAX==PEPSIZ+1

	;ROUTINE TO PUT ENTRY IN LIST. ENTER WITH ADDRESS IN T2 AND
	;WITH "C" AND "B" POINTING TO LISTS. ROUTINE PUTS ENTRY IN
	;LIST "C" IF NOT ALREADY IN EITHER

INLIST:	SKIPN	T1,B		;LOOK AT OTHER LIST FIRST
	JRST	INLST1		;NONE
INLSL1:	SKIPN	(T1)		;END?
	JRST	INLST1		;YES
	CAMN	T2,(T1)		;MATCH?
	POPJ	P,		;RETURN
	AOBJN	T1,INLSL1	;DO ALL
INLST1:	MOVE	T1,C		;REAL LIST
INLSL2:	CAMN	T2,(T1)		;MATCH?
	POPJ	P,		;YES
	SKIPN	(T1)		;SOMETHING THERE?
	JRST	PUTIN		;NO
	AOBJN	T1,INLSL2	;DO ALL
	ERROR	CPOPJ##,<LIST FULL>

	;HERE TO PUT IT IN

PUTIN:	MOVEM	T2,(T1)		;SAVE ADDRESS
	POPJ	P,		;OK

	PRGEND
	TITLE	OWNER	ROUTINE TO GET A RECOGNISED NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	OWNER,OWNER1

	;ROUTINE TO GET OWNER OF A DIRECTORY.

OWNER:	HRROI	T1,[ASCIZ /OWNER: /]
OWNER1:	PUSHJ	P,CDSRGS##	;SAVE ARGS
OWNRP1:	PUSHJ	P,CDSETP##	;SET UP AND INITIALISE
OWNRP2:	PUSHJ	P,OWNER2##	;GET NAME
	 JRST	OWNRP2		;REPARSE
	 JRST	OWNRP1		;UNKNOWN
	POPJ	P,		;RETURN

	PRGEND
	TITLE	OWNER2	GET A RECOGNISED NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	OWNER2,OWNER3

	;ROUTINE TO GET A RECOGNISED NAME. ENTER ALREADY INITIALISED.
	;RETURN +1 FOR REPARSE, SKIP FOR ERROR, OR DOUBLE SKIP WITH
	;T2 POINTING TO ENTRY.

OWNER2:	HRROI	T2,[ASCIZ /LAST NAME/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T2,PLNMTB##	;POINT TO TABLE
	PUSHJ	P,CRGKEY##	;LOOK IT UP
	 ERROR	CPOPJ1##,<NO SUCH NAME>
OWNER3:	HRRZ	T1,(T2)		;GET DISPATCH
	SKIPE	(T1)		;UNIQUE?
	JRST	OWNLP1		;NO
	PUSH	P,T1		;SAVE IT
	HRRZ	T2,(P)		;FOLLOW IT
	HRROI	T2,CFST(T2)	;POINT TO FIRST NAME
	PUSHJ	P,CDMNOI##	;PRINT IT
OWNLP4:	 PJRST	T1POPJ##	;REPARSE
	POP	P,T2		;RESTORE POINTER
OWNLP2:	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 JFCL
	PJRST	CPOPJ2##	;DOUBLE SKIP HOME

PAGE
	;HERE WHEN MORE THAN ONE FIRST NAME

OWNLP1:	HRRZ	T4,T1		;COPY POINTER
	HRROI	T2,[ASCIZ /FIRST NAME/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	MOVEI	T1,FSTMAX	;SET UP FIRST NAME TABLE
	MOVEM	T1,FSTTAB##	;FOR RECOGNITION
OWNLP3:	HRRZ	T2,T4		;BUILD ENTRY
	HRLI	T2,CFST(T4)	;AND TABLE
	MOVEI	T1,FSTTAB##	;POINT TO TABLE
	TBADD			;ADD IT
	ERJMP	.+1		;FULL, OR SOMETHING
	HRRZ	T4,(T4)		;FOLLOW CHAIN
	JUMPN	T4,OWNLP3	;DO ALL
	MOVEI	T2,FSTTAB##	;POINT TO IT
	PUSHJ	P,CRGKEY##	;FIND ENTRY
	 ERROR	CPOPJ1##,<BAD NAME>
	HRRZ	T2,(T2)		;POINT TO IT
	JRST	OWNLP2		;GET IT

	PRGEND
	TITLE	ESTTYP	FIND TYPE OF DIRECTORY
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	ESTTYP

	;ROUTINE TO GET TYPE OF DIRECTORY. RETURN +1 ALWAYS
	;WITH DIRECTORY TYPE CODE IN  T2.

ESTTYP:	HRROI	T1,[ASCIZ /DIRECTORY TYPE: /]
	MOVEI	T2,TYPTAB##	;POINT TO POSSIBLE TYPES
	PUSHJ	P,CCKYCM##	;GET IT
	HRRZ	T2,(T2)		;GET POINTER TO TYPE
	MOVE	T2,(T2)		;GET TYPE
	POPJ	P,		;OK

	PRGEND
	TITLE	CHKSYS	CHECK DIRECTORY FOR "SYSTEM"
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	CHKSYS

	;ROUTINE TO SEE IF DIRECTORY BELONGS TO THE SYSTEM.
	;ENTER WITH "BUF" POINTING TO DIRECTORY BLOCK.
	;RETURN +1 IF SYSTEM DIRECTORY OR SKIP IF NOT

CHKSYS:	MOVE	T1,DTYP(BUF)	;GET TYPE
	TXNN	T1,TYP%US	;USER?
	POPJ	P,		;SYSTEM DIRECTORY
	PJRST	CPOPJ1##	;USER DIRECTORY

	PRGEND
	TITLE	PLFNDN	FIND VALID USER NAME
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLFNDN

	;ROUTINE TO FIND VALID USER NAME. ENTER WITH LAST NAME
	;IN "NAMBUF" AND FIRST NAME IN "FSTBUF". RETURN NON-SKIP
	;IF NAME IS UNKNOWN, OR SKIP IF KNOWN WITH T2 POINTING
	;TO THE NAME ENTRY.

PLFNDN:	MOVEI	T1,PLNMTB##	;POINT TO NAMES
	HRROI	T2,NAMBUF##	;AND OUR NAME
	TBLUK			;FIND IT
	TXNN	T2,TL%EXM	;MATCH?
	POPJ	P,		;NO
	HRRZ	T2,(T1)		;POINT TO IT
FNDNM1:	PUSH	P,T2		;SAVE POINTER
	HRROI	T1,FSTBUF##	;POINT TO FIRST NAME
	HRROI	T2,CFST(T2)	;AND THIS FIRST NAME
	STCMP			;COMPARE
	POP	P,T2		;RESTORE POINTER
	JUMPE	T1,CPOPJ1##	;ZERO SAYS MATCH
	HRRZ	T2,(T2)		;FOLLOW CHAIN
	JUMPN	T2,FNDNM1	;FOLLOW IT
	POPJ	P,		;NO MATCH

	PRGEND
	TITLE	PLFNDL	FIND LOCATION
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLFNDL,PLFNDC

	;ROUTINE TO FIND VALID LOCATION. ENTER WITH LOCATION
	;IN "NAMBUF". RETURN NON-SKIP IF NAME IS UNKNOWN, OR SKIP
	;IF KNOWN WITH T2 POINTING TO THE ADDRESS ENTRY.
	;ENTER WITH CODE IN "NAMBUF" FOR CODE LOOKUP.

PLFNDC:	SKIPA	T1,[CODTAB##]	;POINT TO CODES
PLFNDL:	MOVEI	T1,ADRTAB##	;POINT TO TABLE
	HRROI	T2,NAMBUF##	;AND LOCATION
	TBLUK			;FIND IT
	TXNN	T2,TL%EXM	;MATCH
	POPJ	P,		;NO
	HRRZ	T2,(T1)		;GET POINTER
	PJRST	CPOPJ1##	;SKIP HOME

	PRGEND
	TITLE	PLPRCL	GET A PERSON'S CLASS.
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLPRCL

	;ROUTINE TO GET THE CLASSIFICATION OF A PERSON.
	;ENTER WITH EXISTING BITS IN T3. RETURN WITH UPDATED
	;BITS IN T3.

PLPRCL:	HRROI	T1,[ASCIZ /SET CLASSIFICATION: /]
	MOVEI	T2,CLSTAB##	;POINT TO TABLE
	PUSHJ	P,SETBIT##	;SET BITS
	POPJ	P,		;OK

	PRGEND
	TITLE	PLPRLN	GET A PERSON'S INTERESTS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLPRLN

	;ROUTINE TO SET INTERESTS FOR A PERSON. ENTER WITH EXISTING
	;INTERESTS IN T3. RETURN +1 ALWAYS WITH NEW SELECTION IN T3.

PLPRLN:	HRROI	T1,[ASCIZ /SET INTEREST: /]
	MOVEI	T2,INTTAB##	;POINT TO TABLE
	PUSHJ	P,SETBIT##	;SET BITS
	POPJ	P,		;OK

	PRGEND
	TITLE	PLPRLC	GET LOCATION OF PERSON
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PLPRLC

PLPRLC:	HRROI	T1,[ASCIZ /LOCATION: /]
	MOVEI	T2,ADRTAB##	;POINT TO TABLE
	PUSHJ	P,CCKYCM##	;GET IT WITH CONFIRMATION
	HRRZ	T2,(T2)		;GET DISPATCH
	POPJ	P,		;RETURN

	PRGEND
	TITLE	USGTNM	GET NAME OF DIRECTORY
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USGTNM

	;ROUTINE TO INPUT NAME OF DIRECTORY. USES TABLE USNMTB
	;FOR RECOGNITION. RETURN +1 IF "ALL-USERS" TYPED, SKIP IF
	;ERROR, OR DOUBLE SKIP IF OK WITH "BUF" POINTING TO
	;THE INCORE BUFFER.

USGTNM:	HRROI	T2,[ASCIZ /EXISTING DIRECTORY NAME/]
	PUSHJ	P,CDMNOI##	;MAKE NOISE
	 PJRST	T1POPJ##	;REPARSE
	MOVEI	T2,EVRYTB	;OR EVERYBODY
	MOVEI	T3,USNMTB##	;POINT TO TABLE
	PUSHJ	P,CDDKEY##	;GET ENTRY
	 PJRST	T1POPJ##	;REPARSE
	 PJRST	CPOPJ1##	;ERROR
	HRRZ	BUF,(T2)	;POINT TO BUFFER
	PUSHJ	P,CDGTCM##	;GET CONFIRMATION
	 PJRST	T1POPJ##	;REPARSE
	 PJRST	CPOPJ1##	;BAD
	JUMPE	BUF,CPOPJ##	;EVERBODY
	PJRST	CPOPJ2##	;OK

	;TABLE FOR "ALL-USERS"

EVRYTB:	EVRSIZ,,EVRMAX
	TB (0,ALL-USERS)
EVRSIZ==.-EVRYTB-1
EVRMAX==EVRSIZ+1

	PRGEND
	TITLE	USLOCN	FIND DIRECTORY IN FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USLOCN

	;ROUTINE TO SEARCH IN-CORE DATA BASE FOR DIRECTORY
	;WITH NAME CORRESPONDING TO THAT IN "NAMBUF". RETURN
	;SKIP IF FOUND WITH "BUF" POINTING TO IT. RETURN NON-SKIP
	;IF NOT FOUND

USLOCN:	MOVE	BUF,USCHNS##	;POINT TO START OF CHAIN
LOCLP1:	HRROI	T1,NAMBUF##	;POINT TO OUR NAME
	HRROI	T2,DNMB(BUF)	;POINT TO DIRECTORY NAME
	PUSHJ	P,MTCHSG##	;MATCH?
	 SKIPA			;NO
	PJRST	CPOPJ1##	;YES-SKIP HOME
	HRRZ	BUF,PLOC(BUF)	;DOWN THE CHAIN
	JUMPN	BUF,LOCLP1	;DO NEXT
	POPJ	P,		;ERROR

	PRGEND
	TITLE	USFNNO	FIND DIRECTORY FROM NUMBER
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	USFNNO

	;ROUTINE TO SEARCH THROUGH THE IN-CORE DATA BASE FOR
	;DIRECTORY WHOSE NUMBER CORRESPONDS TO THAT IN T2.
	;RETURNS SKIP IF MATCH FOUND WITH "PNT" POINTING TO
	;DIRECTORY BLOCK. RETURN NON-SKIP IF NO MATCH FOUND
	;WITH "PNT" POINTING TO DIRECTORY BEFORE THE PLACE
	;WHERE IT WOULD BE.

USFNNO:	MOVE	T4,DNUM(PNT)	;GET NUMBER
	CAMN	T4,T2		;MATCH?
	JRST	CPOPJ1##	;YES
	CAML	T4,T2		;THERE YET?
	JRST	NOMTCH		;YES-NO MATCH
	PUSHJ	P,MOVEUP##	;MOVE UP
	 POPJ	P,		;CANNOT
	JRST	USFNNO		;OK
NOMTCH:	PUSHJ	P,BACKUP##	;BACKUP POINTER
	 JFCL
	POPJ	P,		;OK

	PRGEND
	TITLE	STRUCT	ASK FOR A STRUCTURE--SAVE IS IN "STRID"
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	STRUCT

	;HERE TO GET STRUCTURE AND SAVE ID IN "STRID"
	;ENTER WITH PROMPT IN T1. RETURN +1 ALWAYS.

STRUCT:	PUSHJ	P,CDSRGS##	;SAVE ARG
STRUC2:	PUSHJ	P,CDSETP##	;SET UP
STRUC1:	PUSHJ	P,CDGDEV##	;GET IT
	 JRST	STRUC1		;REPARSE
	 ERROR	STRUC2,<BAD STRUCTURE NAME>
	PUSHJ	P,CDGTCM##	;GET CONFIRMATION
	 JRST	STRUC1		;REPARSE
	 ERROR	STRUC2,<BAD CONFIRMATION>
	MOVEM	T2,STRID##	;SAVE IT
	POPJ	P,

	PRGEND
	TITLE	DIRSPC	ROUTINE TO BUILD FULL DIRECTORY SPEC.
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	DIRSPC

	;ROUTINE TO BUILD FULL DIRECTORY SPEC FROM JUST THE NAME.
	;ENTER WITH STRUCTURE ID IN "STRID" AND JFN IN T1.
	;RETURN +1 ALWAYS.

DIRSPC:	PUSH	P,OUTP		;A KLUDGE
	HRRO	OUTP,T1		;WHERE TO PUT IT
	MOVE	T2,STRID##	;WRITE STRUCTURE ID
	PUSHJ	P,PNTDEV##	;PRINT IT
	PUSHJ	P,COLOUT##	;PRINT COLON
	MOVEI	T2,"<"		;DO IT PROPERLY
	PUSHJ	P,CHROUT##	;SEND IT
	HRROI	T2,DNMB(BUF)	;POINT TO NAME
	PUSHJ	P,STGOUT##	;WRITE IT
	MOVEI	T2,">"		;FINISH OFF
	PUSHJ	P,CHROUT##	;PROPERLY
	SETZM	T2		;MAKE ASCIZ
	IDPB	T2,OUTP		;FINISH OFF
	POP	P,OUTP		;RESTORE OUTPUT
	POPJ	P,		;FINISHED

	PRGEND
	TITLE	DEFNWD	GET NEW DEFAULT FOR DIRECTORY
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	DEFNWD

	;ROUTINE TO GET NEW DIRECTORY SPEC. ENTER VIA "PUSHJ" WITH
	;T2 POINTING TO A TABLE OF OPTIONS WITH THEIR DISPATCHES
	;POINTING TO A "DEFDIR" BLOCK. THE ROUTINE COMPLETES THE 
	;COMMAND (SUCH AS "DEFINE NEW DIRECTORY FOR COMPONENTS")
	;AND THEN CALLS "DIRGET" TO GET THE NEW SPEC AND UPDATE THE
	;"DEFDIR" BLOCK. RETURN +1 IF REPARSE NECCESSARY, SKIP IF
	;BAD, OR DOUBLE SKIP IF OK.

	DEFINE	DEFDIR(A,B)<
	PHASE 0
DE%STR:	A		;DEFAULT STRUCTURE
DE%DIR:	B		;DEFAULT DIRECTORY
DE%STS:	BLOCK	10	;HWERE TO PUT NEW STRUCTURE
DE%DRS:	BLOCK	20	;WHERE TO PUT NEW DIRECTORY
	DEPHASE>


DEFNWD:	PUSH	P,T2		;SAVE OPTION TABLE
	HRROI	T2,[ASCIZ /NEW STRUCTURE AND DIRECTORY FOR/]
	PUSHJ	P,CRMNOI##	;MAKE NOISE
	POP	P,T2		;POINT TO TABLE
	PUSHJ	P,CRGKEY##	;GET IT
	 ERROR	CPOPJ1##,<BAD COMMAND>
	PUSHJ	P,CRGTCM##	;GET CONFIRMATION
	 PJRST	CPOPJ1##	;BAD
	HRRZ	T2,(T2)		;GET DISPATCH
	HRROI	T1,[ASCIZ /NEW DIRECTORY SPEC: /]
	PUSHJ	P,DIRGET##	;GET IT
	PJRST	CPOPJ2##	;OK

	PRGEND
	TITLE	DIRGET	GET DIRECTORY SPECIFICATIONS IN "DEFDIR" FORMAT
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	DIRGET

	;ROUTINE TO ASK FOR A DIRECTORY AND RETURN FULL DETAILS.
	;ENTER WITH T1 POINTING TO PROMPT, T2 POINTING TO A "DEFDIR"
	;BLOCK. RETURN +1 ALWAYS

DIRGET:	PUSH	P,T2		;SAVE ADDRESS OF BLOCK
	PUSHJ	P,CCGTDR##	;GET DIRECTORY
	MOVE	T1,(P)		;WHERE TO PUT DIRECTORY
	HRROI	T1,DE%DRS(T1)	;POINT TO IT
	PUSH	P,T1		;SAVE POINTER
	DIRST			;WRITE IT
	 JFCL			;MUST BE OK
	POP	P,T2		;RESTORE POINTER
	HRLI	T2,440700	;MAKE BYTE POINTER
	MOVE	T3,(P)		;POINT TO STRUCTURE SPACE
	MOVEI	T3,DE%STS(T3)	;POINT TO IT
	HRLI	T3,440700	;MAKE BYTE POINTER
DIRFL1:	ILDB	T1,T2		;GET A CHARACTER
	CAIN	T1,"<"		;START OF DIRECTORY?
	MOVEI	T1,0		;PUT ZERO
	IDPB	T1,T3		;WRITE IT
	JUMPN	T1,DIRFL1	;DO ALL
	POP	P,T1		;POINT TO DIRECTORY STRING
	MOVEI	T2,DE%STS(T1)	;WHERE WE HAVE PUT THE STRING
	MOVEM	T2,DE%STR(T1)	;SAVE IT
	MOVEI	T2,DE%DRS(T1)	;AND FOR THE DIRECTORY
	MOVEM	T2,DE%DIR(T1)	;SAVE IT
	HRROI	T1,DE%DRS(T1)	;MAKE POINTER
	PJRST	JSTNAM##	;GET JUST THE DIRECTORY NAME

	PRGEND
	TITLE	MOVEUP	ROUTINES TO ADVANCE AND DEADVANCE POINTERS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	MOVEUP,BACKUP

	;ROUTINE TO ADVANCE THROUGH A CHAIN. ENTER WITH "PNT"
	;POINTING TO A CHAIN. RETURN SKIP IF OK, OR NON-SKIP IF
	;AT END.

MOVEUP:	PUSH	P,PNT		;SAVE OUR POINTER
	HRRZ	PNT,(PNT)	;ADVANCE
	JUMPE	PNT,[POP P,PNT
		     POPJ P,]	;REACHED END
	POP	P,(P)		;JUNK ENTRY
	PJRST	CPOPJ1##	;SKIP HOME

	;ROUTINE TO MOVE BACKWARDS THROUGH A CHAIN. ENTER WITH
	;"PNT" POINTING TO AN ELEMENT OF A CHAIN. RETURN SKIP IF OK
	;AND NON-SKIP IF AT START OF CHAIN

BACKUP:	HLRZ	PNT,(PNT)	;GO BACK
	JUMPE	PNT,CPOPJ##	;START OF CHAIN
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	SETT36	SET UP A TABLE FOR THE "FNDDEF" ROUTINE.
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	SETT36

	;ROUTINE TO SET UP A TABLE FOR THE "FNDDEF" ROUTINE. ENTER
	;WITH T1 POINTING TO AN AREA OF CORE OF SIZE ^D40+^D36*^D9
	;WORDS LONG. THIS IS INITIALISED TO CONTAIN A LOOKUP TABLE
	;WITH 3 ENTRIES OF "NO", "EXIT", AND "LIST" TO CONFORM
	;WITH THE TABLE REQUIRED BY THE "PNTBIT" ROUTINE. THE REST
	;OF THE ENTRIES ARE EMPTY. THE REST OF THE WORDS ARE CLEARED.

SETT36:	PUSH	P,T1		;SAVE POINTER
	MOVEI	T2,^D40+^D36*^D9(T1) ;CLEAR UP FIRST
	PUSHJ	P,BLTCLR##	;CLEAR IT
	MOVE	T1,(P)		;POINT TO TABLE
	MOVEI	T2,^D40		;MAX SIZE
	MOVEM	T2,(T1)		;SAVE IT
	MOVE	T2,[[ASCIZ /NO/],,0]
	TBADD			;PUT IN "NO"
	 ERJMP	SETERR		;BAD
	MOVE	T1,(P)		;POINT TO TABLE
	MOVE	T2,[[ASCIZ /EXIT-CHANGES/],,1]
	TBADD			;PUT IN EXIT
	 ERJMP	SETERR		;BAD
	MOVE	T1,(P)		;POINT TO TABLE
	MOVE	T2,[[ASCIZ /LIST-ENTRIES/],,2]
	TBADD			;PUT IN LIST
	 ERJMP	SETERR		;BAD
	POP	P,T1		;RESTORE POINTER
	PJRST	CPOPJ1##	;OK

SETERR:	POP	P,T1		;RESTORE POINTER
	ERROR	CPOPJ##,<COULD NOT SET UP TABLE>

	PRGEND
	TITLE	FNDDEF	FIND AN ENTRY IN A TABLE OR DEFINE ONE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	FNDDEF

	;ROUTINE TO LOOK UP AN ENTRY IN A TABLE OR DEFINE IT
	;IF IT IS NOT THERE. THE IDEA IS THAT A SKELETON TABLE
	;CAN BE SET UP WITH 39 ENTRIES. THREE OF THESE ENTRIES
	;ARE FOR "NO", "LIST", AND "EXIT". THE OTHER 36 ENTRIES
	;ARE DEFINED BY THIS ROUTINE AND A BIT IS ALLOCATED
	;REPRESENTING THIS ENTRY. SUBSEQUENT CALLS TO THIS ROUTINE
	;WILL RETURN THE BIT. ENTER WITH T1 POINTING TO A TABLE
	;AS DESCRIBED IN ROUTINE "SETT36". THE ASCIZ STRING TO BE
	;ENTERED SHOULD BE IN "NAMBUF". RETURN +1 IF ERROR,
	;OR SKIP WITH BIT RETURNED IN T2.

FNDDEF:	PUSH	P,T1		;SAVE POINTER
	HRROI	T2,NAMBUF##	;POINT TO STRING
	TBLUK			;FIND IT
	TXNN	T2,TL%EXM	;MATCH?
	PUSHJ	P,DEFNEW	;DEFINE IT
	HRRZ	T1,(T1)		;GET DISPATCH
	MOVE	T2,(T1)		;GET BIT
	POP	P,T1		;RESTORE POINTER
	PJRST	CPOPJ1##	;OK

	;HERE TO DEFINE NEW ENTRY.

DEFNEW:	HRRZ	T3,-1(P)	;GET POINTER TO TABLE
	MOVEI	T3,^D40(T3)	;POINT TO BIT MAP
	HRLI	T3,-^D35	;MAKE AOBJN POINTER
DEFNW1:	SKIPN	(T3)		;IN USE?
	JRST	DEFNW2		;NO
	AOBJN	T3,DEFNW1	;LOOK AT ALL
	JRST	DEFN1		;FULL
DEFNW2:	HLRE	T2,T3		;GET COUNTER
	MOVX	T1,1B0		;SET BIT
	LSH	T1,(T2)		;MOVE IT
	MOVEM	T1,(T3)		;SAVE IT
	HLRE	T2,T3		;GET COUNT AGAIN
	IMULI	T2,-10		;FIND PLACE FOR STRING
	HRRZ	T1,-1(P)	;ADD IN BASE
	ADD	T2,T1		;FOR STRING
	HRROI	T1,NAMBUF##	;POINT TO STRING
	HRLI	T2,^D39		;MAX SIZE
	PUSH	P,T3		;SAVE POINTER TO BIT
	PUSH	P,T2		;AND STRING
	PUSHJ	P,COPSTG##	;COPY IT
	 JFCL			;TRUDGE ON
	POP	P,T2		;GET ADDRESS OF STRING
	HRLZS	T2		;IN LEFT HALF
	POP	P,T1		;RESTORE POINTER TO BIT
	HRR	T2,T1		;GET BIT POINTER
	MOVE	T1,-1(P)	;POINT TO TABLE
	TBADD			;PUT IT IN
	 ERJMP	.+2		;OK
	POPJ	P,		;OK
DEFN1:	POP	P,(P)		;ADJUST STACK
	ERROR	T1POPJ##,<TABLE FULL>
	
	PRGEND
	TITLE	SETBIT	SET OR CLEAR BITS ACCORDING TO COMMANDS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	SETBIT

	;ROUTINE TO SET OR CLEAR BITS ACCORDING TO COMMANDS.
	;ENTER WITH T1 POINTING TO PROMPT, T2 POINTING TO A
	;COMMAND TABLE AND T3 CONTAINING BITS SET SO FAR. THE
	;RIGHT HALF OF THE TABLE POINTED TO BY T2 SHOULD
	;POINT TO A WORD CONTAINING BITS TO BE SET OR
	;CLEARED ACCORDING TO THE COMMANDS. THE TABLE SHOULD
	;ALSO CONTAIN ENTRIES FOR "EXIT" WITH DISPATCH POINTING
	;TO 1, "LIST BITS SET" POINTING TO 2 AND "NO" POINTING
	;TO ZERO. RETURN +1 ALWAYS WITH BITS SET IN T2.

SETBIT:	PUSHJ	P,CDSRGS##	;SAVE ARGS
	PUSH	P,T3		;SAVE BITS SO FAR.
	PUSH	P,[0]		;NEGATIVE FLAG
SETBT1:	PUSHJ	P,CDSETP##	;SET UP AND INITIALISE
	SETZM	(P)		;NOT NEGATIVE
SETBT4:	MOVE	T2,CMDT2##	;GET POINTER TO TABLE
	PUSHJ	P,CDGKEY##	;LOOK IT UP
	 JRST	SETBT4		;REPARSE
	 ERROR	SETBT1,<BAD FORMAT>
	HRRZ	T1,(T2)		;GET ENTRY
	JUMPE	T1,[SETOM (P)
		    JRST  SETBT4] ;FLAG "NO"
	PUSHJ	P,CDGTCM##	;GET CONFIRMATION
	 JRST	SETBT4		;REPARSE
	 ERROR	SETBT1,<BAD CONFIRMATION>
	CAIN	T1,1		;CODE 1?
	PJRST	[POP P,(P)
		 POP P,T3
		 POPJ P,]
	CAIN	T1,2		;CODE 2?
	JRST	SETBT3		;LIST CAPABILITIES
	MOVE	T1,(T1)		;GET BITS
	IORM	T1,-1(P)	;SET BITS
	SKIPE	(P)		;SHOULD WE?
	ANDCAM	T1,-1(P)	;NO
	JRST	SETBT1		;DO NEXT

PAGE
	;HERE TO LIST BITS SET SO FAR

SETBT3:	MOVE	A,-1(P)		;GET BITS
	MOVEI	B,"	"	;PRINT A TAB FIRST
	MOVE	D,CMDT2##	;POINT TO TABLE
	PUSHJ	P,PNTBIT##	;PRINT BITS SO FAR
	 JFCL			;IGNORE ERRORS
	MOVEM	A,-1(P)		;SAVE BITS
	JRST	SETBT1		;GET NEXT COMMAND

	PRGEND
	TITLE	PNTBIT	PRINT BITS SET SO FAR
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.


	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	PNTBIT

	;ROUTINE TO PRINT BITS SET. ENTER WITH BITS IN "A" AND
	;WITH "D" POINTING TO COMMAND TABLE AS DESCRIBED FOR "SETBIT".
	;"B" SHOULD CONTAIN THE CHARACTER TO BE PRINTED FIRST.
	;RETURN +1 ON OUTPUT ERRORS, SKIP IF OK. IF "B" CONTAINS
	;A TAB A FREE CRLF IS OUTPUT BEFORE AND AFTER THE LIST.

PNTBIT:	PUSHJ	P,SETTBD##	;SET UP D
	 PJRST	PNTBT3		;NOTHING TO DO
	CAIE	B,"	"	;TAB?
	JRST	PNTBT1		;NO
	PUSHJ	P,WTNEWL##	;THROW A LINE FIRST
	 POPJ	P,		;ERROR
PNTBT1:	HRRZ	T1,(D)		;GET POINTER TO BITS
	CAIG	T1,2		;REAL BITS?
	JRST	PNTBT2		;NO
	TDNN	A,(T1)		;ANY BITS SET?
	JRST	PNTBT2		;NO
	MOVE	T2,B		;GET NEW CHARACTER
	PUSHJ	P,JBOUT##	;PRINT IT
	 POPJ	P,		;BAD
	HLRO	T2,(D)		;POINT TO STRING
	SETZM	T3		;LONG STRING
	PUSHJ	P,JSOUT##	;PRINT IT
	 POPJ	P,		;BAD
	PUSHJ	P,WTNEWL##	;AND NEW LINE
	 POPJ	P,		;BAD
PNTBT2:	AOBJN	D,PNTBT1	;DO ALL
PNTBT3:	CAIE	B,"	"	;TAB?
	PJRST	CPOPJ1##	;OK
	PJRST	WTNEWL##	;FINISH UP

	PRGEND
	TITLE	SETTBD	SET UP D TO POINT TO A COMMAND TABLE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>
	SALL

	ENTRY	SETTBD

	;ROUTINE TO SET UP TO TO MAKE AN "AOBJN" POINTER
	;FOR A COMMAND TABLE. ENTER WITH D POINTING TO THE
	;TABLE. RETURN WITH "AOBJN" POINTER IN D. RETURN +1
	;IF TABLE EMPTY OR SKIP IF SOMETHING THERE.

SETTBD:	PUSH	P,D		;SAVE POINTER
	HLRZ	D,(D)		;GET LENGTH
	MOVNI	D,(D)		;MAKE NEGATIVE
	HRLZS	D		;IN LEFT HALF
	HRR	D,(P)		;POINT TO TABLE
	POP	P,(P)		;JUNK ORIGINAL
	TLNN	D,777777	;ANYTHING THERE?
	POPJ	P,		;NO
	AOJA	D,CPOPJ1##	;SKIP HOME

	PRGEND
	TITLE	RDUPSP	READ UNTIL WE FIND A SPACE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RDUPSP

	;ROUTINE TO READ UNTIL WE FIND A SPACE. ENTER WITH
	;POINTER FOR OUTPUT IN T3 AND MAX NUMBER OF CHARACTERS
	;IN T3. RETURN +1 IF ERROR, OR SKIP IF OK.

RDUPSP:	MOVEI	T4,40		;END ON SPACE
	PUSHJ	P,JSIN##	;GET IT
	 POPJ	P,		;ERROR
	MOVEI	T3,0		;DELETE SPACE
	DPB	T3,T2		;LOSE IT
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	RDUPCR	READ UP TO CR.
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RDUPCR

	;ROUTIN TO READ UP TO NEXT CARRIAGE RETURN. ENTER WITH
	;OUTPUT POINTER IN T2 AND MAX NUMBER OF CHARACTERS IN
	;T3. RETURN +1 IF ERROR OR SKIP IF OK.

RDUPCR:	MOVEI	T4,15		;END ON CR.
	PUSHJ	P,JSIN##	;GET IT
	 POPJ	P,		;BAD
	MOVEI	T3,0		;LOSE CR
	DPB	T3,T2		;OVERWRITE IT
	PJRST	CPOPJ1##	;OK

	PRGEND
	TITLE	WTSPAC	WRITE A SPACE IN OUTPUT FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	WTSPAC

	;ROUTINE TO WRITE A SPACE IN A FILE. RETURN +1 IF ERROR
	;OR SKIP IF OK.

WTSPAC:	MOVEI	T2," "		;SEND SPACE
	PJRST	JBOUT##		;SEND IT
	PRGEND
	TITLE	WTNEWL	WRITE CRLF TO FILE
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	WTNEWL

	;ROUTINE TO SEND CRLF TO A FILE. RETURN +1 IF ERROR
	;OR SKIP IF OK.
WTNEWL:	HRROI	T2,[ASCIZ /
/]
	SETZM	T3		;LONG STRING
	PJRST	JSOUT##		;WRITE IT

	PRGEND
	TITLE	RDRCEF	CHECK INPUT ERRORS
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	RDRCEF

	;ROUTINE TO CHECK INPUT ERRORS. RETURN +1 IF BAD ERROR,
	;SKIP IF END OF FILE. PRINTS ERROR MESSAGE.

RDRCEF:	PUSHJ	P,GSTSIN##	;GET STATUS
	 PJRST	JSERPJ##	;BAD ERROR
	PJRST	CPOPJ1##	;EOF
	PJRST	JSERPJ##	;ERROR

	PRGEND
	TITLE	CAPTAB	TABLE OF CAPABILITIES
	SUBTTL	C.MITCHELL 1977. ROUTINES WRITTEN AT COLOGNE.

	SEARCH	MONSYM,MACSYM,CMLBSM

	IFNDEF	.PSECT,<
	.DIRECT	.XTABM>

	SALL

	ENTRY	CAPTAB

	;TABLE OF CAPABILITIES

CAPTAB:	CAPSIZ,,CAPMAX
	TB ([SC%CNF],CONFIDENTIAL)
	TB ([SC%CTC],CONTROL-C-TRAPPING)
	TB ([SC%ENQ],ENQ-DEQ)
	TB (1,EXIT-FROM-CAPABILITY-MODS)
	TB ([SC%FRZ],FREEZE)
	TB ([SC%GTB],GETAB-MONITOR-TABLES)
	TB ([SC%IPC],IPCF)
	TB (2,LIST-CAPABILITIES)
	TB ([SC%LOG],LOG-FUNCTIONS)
	TB ([SC%MNT],MAINTENANCE)
	TB ([SC%MMN],MAP-RUNNING-MONITOR)
	TB (0,NO)
	TB ([SC%OPR],OPERATOR)
	TB ([SC%MPP],PAGE-PRIV-MAPPING)
	TB ([SC%SDV],SPECIAL-DEVICE-HANDLING)
	TB ([SC%SUP],SUPERIOR-MAPPINGS)
	TB ([SC%WHL],WHEEL)
CAPSIZ==.-CAPTAB-1
CAPMAX==CAPSIZ+1

	PRGEND
	END