Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985, 1989.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.

	TITLE	MXUT10
	SEARCH	UUOSYM,ACTSYM,MACTEN,UFDPRM
;	Miscellaneous functions for MX

	.TEXT	",REL:UFDSET/SEGMENT:LOW"

	TWOSEG
	RELOC	400000
;	External references

	EXTERN	UM%GET		;MX's memory get routine

;	Define some ACs

	T1=1
	T2=T1+1
	T3=T2+1
	T4=T3+1
	P1=5
	P2=P1+1
	P3=P2+1
	P4=P3+1
	P5=P4+1
	P=17

	QUOTE==42		;ASCII VALUE OF QUOTE CHARACTER

;DATA AREA
	RELOC	0

PRTBLK:	XWD 1,.STDPC		;Set default protection for job(SETPRO)
PRTBL1: 0			;The default file protection

TRMBLK:	BLOCK	3		;TRMOP. BLOCK(SPLTTY & Friends)

MAIFLG:	BLOCK	1		;Anti-recursion flag (NAMPPN/PPNNAM)
NAMPTR: BLOCK	1		;Saved copy of the name to lookup (T1)
MAIBUF: BLOCK	20		;MAILING ADDRESS BUFFER...
QUEARG:	BLOCK	10		;QUEUE. ARG BLOCK
QUERSP:	BLOCK	1000		;QUEUE. RESPONSE BLOCK (This should do)

FLPBLK:	BLOCK 	.FOFSP		;(QUOTAS)
LKPBLK:	BLOCK	.RBUSD+1

BLDSAV:	BLOCK	3		;SAVE AREA FOR ACS 14-16 (BLDQUE)
BLDING:	Z			;NONZERO INDICATES REBUILD OF QUEUE IN PROGRESS

ERRFLG:	BLOCK	1		;NON-ZERO IF AN ERROR OCCURED (UFDCRE/UFDDEL)
FUNCT:	BLOCK	1		;FUNCTION CODE
AUXPTR:	BLOCK	1		;AOBJN POINTER TO STRUCTURES
USRPPN:	BLOCK	1		;USER PPN
PROFIL::BLOCK	1		;ADDRESS OF PROFILE (GLOBAL for MXUFDE)
UFDBLK:	BLOCK	.UFSIZ		;UFDSET ARGUMENT BLOCK

	RELOC	400000

;SETPRO	-sets the default protection of UPS: files.
;
;	CALL SETPRO
;
;Returns +1 always.
SETPRO::
	MOVE	T1,[F%FDAE&<-1,,0>!.GTFET] ;GETTAB ARGS
	GETTAB	T1,			;NEED TO KNOW IF MONITOR
	  SETZ	T1,			; SUPPORTS A FILE DAEMON
	MOVEI	T2,077			;FILE PROTECTION IF NO FILDAE
	TXNE	T1,F%FDAE&<0,,-1>	;FILDAE MONITOR?
	TRO	T2,400			;YES
	MOVEM	T2,PRTBL1		;Store it in the argument block
	MOVE	T1,[XWD .STDEF,PRTBLK]	;.STDEF set default function for SETUUO
	SETUUO	T1,			;Do it
	  JRST 	.+1			;Don't care
	POPJ	P,

;FNDUSR	- returns the next logged in job of a specific PPn
;
;	MOVE	T1,PPn
;	MOVX	T2,0 or last job number of PPn
;	PUSHJ	P,FNDUSR
;	  returns here if ppn has no more logged in jobs
;	returns here with next job # in T2
;
;	USES	T3,T4

FNDUSR::MOVX	T3,%CNSJN	;GET MAXIMUM NUMBER OF JOBS
	GETTAB	T3,		;FROM THE MONITOR
	  SETZ	T3,		;SHOULD NEVER HAPPEN
	HRRZS	T3		;GET THE MAXIMUM
FNDUS1:	AOS	T2 		;MOVE ON TO THE NEXT JOB
	CAMLE	T2,T3		;ARE THERE ANY MORE JOBS?
	  POPJ	P,		;NOPE, RETURN
	MOVX	T4,.GTPPN	;GET THE PPN
	HRL	T4,T2		;FOR THIS NEXT JOB
	GETTAB	T4,		;FROM THE MONITOR
	  JRST	FNDUS1		;(SHOULD NEVER HAPPEN) DO THE NEXT JOB
	CAME	T4,T1		;ARE THEY THE SAME
	  JRST	FNDUS1		;NO, THEN SKIP THIS
	JRST	CPOPJ1		;YES, SKIP RETURN

	SUBTTL	SPLCHR - SPLAT A CHARACTER TO A TERMINAL (VERY SLOW)

; We probably do NOT want to use this!



SPLCHR:	MOVEM	T1,TRMBLK+2	;SAVE IT IN THE BLOCK
	MOVX	T1,.TOOUC	;TYPE OUT A CHARACTER
	MOVEM	T1,TRMBLK	;SAVE IT
	MOVE	T1,[XWD 3,TRMBLK]	;LEN,,ADDRESS
	TRMOP. T1,		;DO IT
	  JFCL
	POPJ	P,		;RETURN WHEN DONE

	SUBTTL	SPLTTY - SPLAT a message across someones TTY if he has one

;SPLTTY	Splats a message across a specific jobs terminal
;
;	MOVEI	T1,message address
;	MOVE	T2,job number
;	PUSHJ	P,SPLTTY
;	  returns here always
;
;	USES	T1,T3

SPLTTY::HRRZ	T3,T2		;DON'T DESTROY THE JOB NUMBER
	TRMNO.	T3,		;GET THE TERMINAL NUMBER
	  POPJ	P,		;SPLAT RETURN AFTER POP
	MOVEM	T3,.TOUDX+TRMBLK ;GET IT IN THE TRMOP. BLOCK
	PUSHJ	P,CHKSND	;DOES HE CARE?
	  POPJ	P,		;NO, THEN FORGET ABOUT HIM
	MOVEM	T1,.TOAR2+TRMBLK ;MESSAGE TO BE SPLATTED
	MOVX	T1,.TODSP	;DISPLAY FUNCTION
	MOVEM	T1,TRMBLK	;SAVE IT
	MOVE	T1,[XWD 3,TRMBLK] ;FUNCTION IS DISPLAY
	TRMOP.	T1,		;SPLAT IT TO HIM
	  POPJ	P,		;OH WELL, DIDN'T MAKE IT MUST BE DETACHED
	POPJ	P,		;RETURN

	SUBTTL	CHKSND - See if he really wants to know about it

; T2/ Job number	uses T3


CHKSND:	MOVS	T3,T2		;GET THE JOB NUMBER
	HRRI	T3,.GTLIM	;GET THE TIME LIMIT WORD
	GETTAB	T3,		;GET THE INFO
	  JRST	CHKSN1		;FIGURE HE'S NOT BATCH
	TXNE	T3,JB.LBT	;IS IT ON?
	  POPJ	P,		;YES, THEN SKIP THIS STUFF
CHKSN1:	MOVX	T3,.TOSND	;GET THE FUNCTION CODE
	MOVEM	T3,TRMBLK	;FOR THE TTY
	MOVE	T3,[XWD 2,TRMBLK] ;LEN,,ADDRESS
	TRMOP. T3,		;DO IT
	  POPJ  P,		;RETURN TO CALLER
	TXNE	T3,1B35		;IS THIS GAGGED?
	  JRST	CPOPJ1		;SKIP RETURN
	POPJ	P,		;RETURN IF YES

;NAMPPN - TRANSLATE USERID NAME STRING INTO PPN FROM ACTDAE
;PPNNAM - TRANSLATE PPN INTO USERID NAME STRING FROM ACTDAE
;CALL IS:
;
;	MOVX	T1,<PTR>	MOVX	T1,<PTR2>
;	PUSHJ	P,NAMPPN   or	PUSHJ 	P,PPNNAM
;	 error return		  error	return
;	normal return		normal	return
;
;<PTR> is an eight bit byte pointer to the beginning of the username
;string (with any leading bracket trimmed) and ending in a null.
;<PTR2> is a pointer to a word containing the PPN to be traslated.
;
;On error return, no name match could be found, or <PTR> was no eight bit
;string.
;
;On normal return, T1 will contain the ppn or a pointer to the 8-bit username.
;
;	USES	T1-T4


NAMPPN::MOVEM	T1,NAMPTR	;Save the name in case of mail forwarding error
	SETZM	MAIFLG		;Initialize the Anti-recursion flag
NAMPP1:	MOVE	T3,[^D10,,.UGUSR] ;USERNAME DESCRIPTOR FOR QUEUE.
	PUSHJ	P,ACTCOM	;SET UP GENERIC ACTDAE CALL
	  JRST	[MOVE	T1,MAIFLG	;Get the forwarding flag
		CAIN	T1,0		;Was this for a forwarding address?
		POPJ	P,		;No.  Return now...
		MOVE	T1,[POINT 7,QUERSP] ;Yes. Frwrding failed.
		PUSHJ	P,MXUFDE	;Log it.
		MOVE	T1,NAMPTR	;Restore the original name
		SETZM	NAMPTR		;Clear it
		CAIE	T1,0		;Was it zero?
		JRST	NAMPP1		;No. Go get the original profile
		POPJ	P,]		;Yes. I've done this before. Return now
	MOVE	T1,QUERSP+.AEMAI;Get the pointer to the mailing address
	CAIE	T1,0		;Skip if zero
	JRST	GETMAI		;Go process the mailing address
NAMPP2:	HRRZ	T1,QUERSP	;Get the size of the profile for UM%GET
	ADDI	T1,1		;Include the first word
	PUSH	P,T1		;Pass it to...
	PUSHJ	P,UM%GET	;...the memory get routine
	ADJSP	P,-1		;Clean up the stack: T1 contains the address
	SKIPG	T1		;Is there an address here?
	  POPJ	P,		;  Too bad, no memory
	HRLI	T3,QUERSP	;Source = QUERSP
	HRR	T3,T1		;Destination = address from UM%GET
	HRRZ	T2,QUERSP	;Get the size of the profile for the BLT
	ADD	T2,T1		;Point to the last word
	BLT	T3,-1(T2)	;Copy the profile
	JRST	CPOPJ1		;AND RETURN HAPPY

GETMAI:	MOVE	T2,MAIFLG	;Get the mail flag
	CAIE	T2,0		;Is it zero?
	JRST	NAMPP2		;No, we've got a valid profile.
	MOVEI	T2,1		;Set the MAIFLG...
	MOVEM	T2,MAIFLG	;...so we won't do this again.
	HLRE	T3,T1		;Negative count is now in T3
	MOVN	T3,T3		;Positive count is now in T3
	ADDI	T1,QUERSP	;Add the base to the offset
	HRLZ	T1,T1		;Source is in LH
	HRRI	T1,MAIBUF	;Destination is in RH
	BLT	T1,MAIBUF(T3)	;Copy it
	MOVE	T1,[POINT 8,MAIBUF] ;build an 8-bit pointer to the name
	MOVE	T2,T1		;Make a copy of the pointer
	ILDB	T3,T2		;Get the first byte
	CAIN	T3,"["		;Is it a square bracket
	JRST	NAMPP2		;Yes.  We don't handle PPN's
NODLUP:	CAIN	T3,"@"		;Is it an "at-sign"?
	JRST	NODFND		;Yes. Go handle remote addresses
	CAIN	T3,0		;Is it a null?
	JRST	NAMPP1		;Yes, Get the new profile
	ILDB	T3,T2		;No.  Get the next byte,
	JRST	NODLUP		;...and keep looking.
NODFND: MOVEI   T3,QUERSP       ;Get the profile address
        SETZM   .AEPPN(T3)      ;Clear the PPN for this user.
        JRST    NAMPP2          ;Go finish up.

PPNNAM::MOVE	T3,[1,,.UGPPN] ;PPN DESCRIPTOR FOR QUEUE.
	PUSHJ	P,ACTCOM	;DO ACTDAE CALL
	  POPJ	P,		;NO SUCH PPN
	MOVEI	T1,QUERSP+.AENAM ;GET THE USERNAME RETURNED
	JRST	CPOPJ1		;AND HAPPY LANDINGS

ACTCOM:	SETZM   QUERSP		;Clear the first word
	MOVE	T4,[QUERSP,,QUERSP+1] ;Source,,destination
	BLT	T4,QUERSP+777	;Clear up to the last destination address
        MOVEI	T4,QUEARG-1	;POINT AT THE ARGUMENT BLOCK STORAGE
	PUSH	T4,[QF.RSP!.QUMAE] ;SAY WE WANT TO TALK TO ACTDAE
	PUSH	T4,[-1]		;SET THE NODE TO CENTRAL
	MOVEI	T2,QUERSP	;POINT AT THE RESPONSE STORAGE
	HRLI	T2,1000		;GET THE NUMBER OF WORDS WE CAN PLAY WITH HERE
	PUSH	T4,T2		;PUT IN THE ARG BLOCK
	PUSH	T4,[QA.IMM!<1,,.QBAFN>] ;GET THE SUBFUNCTION ARGUMENT TYPE
	PUSH	T4,[EXP AF.PRV!UGOUP$] ;SAY WE WANT THE USER PROFILE
	PUSH	T4,T3		;STORE THE USERNAME OR PPN DESCRIPTOR
	PUSH	T4,T1		;STORE THE USERNAME OR PPN POINTER
	ANDI	T4,-1		;GET RID OF JUNK IN THE LEFT HALF
	SUBI	T4,QUEARG	;COMPUTE THE NUMBER OF WORDS WE FILLED IN
	MOVEI	T1,QUEARG	;POINT AT THE ARGUMENT BLOCK
	HRL	T1,T4		;COPY THE BLOCK LENGTH
	QUEUE.	T1,		;ASK FOR THE PPN FOR THIS GUY
	 POPJ	P,		;WELL, WE GAVE OUR ALL
	JRST	CPOPJ1		;SUCCESSFUL RETURN
;NOTE
;
;To validate a username (what are you REALLY trying to do?) use NAMPPN.  You
;will probably want to cache the usernames because doing the QUEUE. is VERY,
;VERY, VERY slow!  Note also that the User Name is in *8*bit!

; T1=-1 OR UDT TO CONVERT  UDTDAT-DATE & TIME; DATTIM-TIME ONLY
; T2=ADDRESS WHERE TO PLACE DATE-TIME; USES T1-T4,P1-P5
;There are 3 related routines:
;	UDTNUM:	T2 points to a 2 word buffer which will be set up with:
;		year,,month
;		day in month
;
;	UDTDAT:	T2 is the address to return the ASCIZ string of the
;		DATE/TIME.
;
;	UDTTIM:	T2 is the address to return the ASCIZ string of the TIME.
;
UDTNUM::CAME	T1,[EXP -1]		;Is it -1 for "now"?
	JRST	UDTNU1			;No
	MOVX	T1,%CNDTM		;Get the current UDT
	GETTAB	T1,			;...
	 HALT				;Date/Time Unavailable - SNH
UDTNU1:	MOVE 	P3,T2			;Squirrel away the destination
	PUSHJ	P,.CNTDT		;Take apart the UDT
	IDIVI	T2,^D31			;Get the days in the month
	ADDI	T3,1			;Normalize it to 1-31
	MOVEM	T3,1(P3)		;Store the days in the month
	IDIVI	T2,^D12			;Get the month
	ADDI	T3,1			;Normalize it to 1-12
	HRRM	T3,(P3)			;Store the month
	ADDI	T2,^D1964		;Get the year
	HRLM	T2,(P3)			;Store the year
	POPJ	P,			;Return

UDTDAT::TDZA	P1,P1			;USE FOR FLAG THAT DATE IS WANTED
UDTTIM::SETO	P1, 			;-1 MEANS TIME ONLY
	CAME	T1,[EXP -1]		;IS IT -1, FOR "NOW"?
	  JRST	UDTDA1
	MOVX	T1,%CNDTM		;GET THE CURRENT UDT
	GETTAB	T1,			;...
	  HALT 				;DATE/TIME UNAVAILABLE - SNH
UDTDA1:	MOVE	P3,T2			;MOVE THE DESTINATION INTO P3
	HRLI	P3,(POINT 7,0)		;AND MAKE IT A BYTE POINTER

	PUSHJ	P,.CNTDT		;TAKE IT APART
	MOVE	P2,T2			;SAVE A RETURNED VALUE
	PUSH	P,T1			;SAVE TIME
	JUMPL	P1,UDTDA2		;IF FLAG IS UP, GIVE TIME ONLY
	MOVE	T1,T2			;POSITION DATE
	IDIVI	T1,^D31			;GET DAYS
	MOVE	T4,T1			;SAVE REST
	MOVEI	P1,1(T2)		;GET DAYS AS 1-31
	CAIGE	P1,^D10			;IF ONE DIGIT,
	PUSHJ	P,PUTSP			;FILL WITH A SPACE
	PUSHJ	P,PUTD			;PRINT DECIMAL NUMBER
	IDIVI	T4,^D12			;GET MONTHS
	MOVEI	P1,[ASCIZ /-Jan/
		    ASCIZ /-Feb/
		    ASCIZ /-Mar/
		    ASCIZ /-Apr/
		    ASCIZ /-May/
		    ASCIZ /-Jun/
		    ASCIZ /-Jul/
		    ASCIZ /-Aug/
		    ASCIZ /-Sep/
		    ASCIZ /-Oct/
		    ASCIZ /-Nov/
		    ASCIZ /-Dec/](P1)	;GET ASCII
	PUSHJ	P,PUTT			;TYPE THE ASCIZ STRING
	MOVEI	P1,^D64(T4)		;GET YEAR SINCE 1900
	IDIVI	P1,^D100		;GET JUST YEARS IN CENTURY
	MOVN	P1,P2			;NEGATE TO GET - SIGN
	PUSHJ	P,PUTD			;TYPE IT OUT
	PUSHJ	P,PUTSP			;NOW SPACE OVER ONE

UDTDA2:	POP	P,P1			;GET TIME BACK
	IDIV	P1,[DEC 3600000]	;GET HOURS
	MOVE	T4,P2			;SAVE REST
	CAIGE	P1,^D10			;IF ONLY ONE DIGIT,
	PUSHJ	P,PUTSP			;SPACE OVER
	PUSHJ	P,PUTD			;PUT DECIMAL NUMBER OUT
	PUSHJ	P,PUTCL			;NOW A COLON TO DIVIDE HOURS FROM MINUTES
	MOVE	P1,T4			;RESTORE REST
	IDIV	P1,[DEC 60000]		;GET MINUTES
	MOVE	T4,P2			;SAVE REST
	CAIGE	P1,^D10			;IF NOT TWO DIGITS,
	PUSHJ	P,PUT0			;GIVE A ZERO FILL
	PUSHJ	P,PUTD			;PRINT DECIMAL MINUTES
	PUSHJ	P,PUTCL			;AND SEPARATING COLON
	MOVE	P1,T4			;RESTORE THE REST
	IDIV	P1,[DEC 1000]		;EXTRACT THE SECONDS
	CAIGE	P1,^D10			;IF ITS NOT TWO DIGITS,
	PUSHJ	P,PUT0			; ZERO FILL IT
;	PJRST	PUTD			;THEN PRINT IT, RETURN
	PUSHJ	P,PUTD			;THEN PRINT IT
	PJRST	PUTZ			;MAKE IT ASCIZ, RETURN

SUBTTL	.CNTDT -- GENERALIZED DATE/TIME SUBROUTINE

;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL:	MOVE	T1,DATE/TIME
;	PUSHJ	P,.CNTDT
;	RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT ( < 0 IF ARG < 0 )
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4

	RADIX	10		;***** NOTE WELL *****

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365

.CNTDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)
	ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
				;T1=DAYS SINCE JAN 1, 1501
	IDIVI	T1,400*365+400/4-400/100+400/400
				;SPLIT INTO QUADRACENTUR
	LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS
	IDIVI	T2,<100*365+100/4-100/100>*4+400/400
				;SPLIT INTO CENTURY
	IORI	T3,3		;DISCARD FRACTIONS OF DAY
	IDIVI	T3,4*365+1	;SEPARATE INTO YEARS
	LSH	T4,-2		;T4=NO DAYS THIS YEAR
	LSH	T1,2		;T1=4*NO QUADRACENTURIES
	ADD	T1,T2		;T1=NO CENTURIES
	IMULI	T1,100		;T1=100*NO CENTURIES
	ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	T2,3		;IS THE YEAR A MULT OF 4?
	JRST	CNTDT0		;NO--JUST INDICATE NOT A LEAP YEAR
	IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100
	SKIPN	T3		;IF NOT, THEN LEAP
	TRNN	T2,3		;IS YEAR MULT OF 400?
	TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL

	;UNDER RADIX 10 **** NOTE WELL ****

CNTDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG
				;T3 IS 0 IF LEAP YEAR
CNTDT1:	SUBI	T1,1964		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN

	RADIX	8		;RETURN TO THE LAND OF THE NORM

; PUTD -- Put out a signed decimal number, number in P1

PUTD:: 	MOVE	P4,P1			;GET INTO PERMANENT PLACE
	JUMPGE	P4,PUTD.1		;IS IT NEGATIVE?
	PUSHJ	P,PUTDSH		;YES, SO PRINT A MINUS SIGN
	MOVMS	P4			;AND CONVERT TO POSITIVE
PUTD.1:	IDIVI	P4,^D10			;PICK OFF A DIGIT
 	HRLM	P5,0(P)			;BET YOU'VE SEEN THIS BEFORE
	SKIPE	P4			;ANY DIGITS LEFT?
	PUSHJ	P,PUTD.1		;YES, GET NEXT ONE
 	HLRZ	T3,0(P)			;GET A DIGIT
	ADDI	T3,"0"			;CONVERT TO ASCII
	PJRST	PUT7			;PUT OUT DIGIT, LOOP OR RETURN FORM THERE
; PUTT -- Output an ASCIZ string, address of string is in P1

PUTT:  	HRRZ	P4,P1			;GET ADDRESS INTO IT
	HRLI	P4,(POINT 7,0)		;CONVERT IT TO A BYTE POINTER
PUTT1:	ILDB	T3,P4			;GET A BYTE
	JUMPE	T3,CPOPJ		;IF NULL, RETURN
	PUSHJ	P,PUT7			;PRINT THE CHARACTER
	JRST	PUTT1			;LOOP FOR NEXT ONE

PUTSP:	MOVEI	T3," "
	PJRST 	PUT7

PUTCL:	MOVEI	T3,":"
	PJRST 	PUT7

PUTDSH:	MOVEI	T3,"-"
	PJRST 	PUT7

PUTZ:	MOVEI	T3,0
	PJRST	PUT7

PUT0:	MOVEI	T3,"0"
;	PJRST 	P,PUT7

PUT7:	IDPB	T3,P3
	POPJ	P,

; T1=PPN, T2=STRUCTURE IN SIXBIT, RETURNS T1-T3: IN, OUT, AND USED QUOTAS
; RETURNS+1 FOR NO UFD
; RETURNS+2 IF SUCCESSFUL
; *NOTE* THIS (AS EVERYTHING ELSE) SHOULD BE CHANGED TO USE FILOP.S
; *NOTE* ALSO THAT 377777,777777 EQUALS INFINITY


	QCHN=16

QUOTAS::MOVEM	T1,LKPBLK+.RBNAM	;PUT THE PPN IN THE FILENAME FIELD
	MOVEM	T1,FLPBLK+.FOPPN	;AND IN BAHALF OF THAT USER
	MOVE	T1,[%LDMFD]		;GET THE MASTER FILE DIRECTORY
	GETTAB	T1,			; ...
	  MOVE	T1,[1,,1]		;THIS WILL NEVER HAPPEN, BUT IF IT DOES
	MOVEM	T1,LKPBLK+.RBPPN	;STORE IT IN PPN FIELD
	HRLZI	T1,'UFD'		;WE ARE LOOKING UP THE UFD
	MOVEM	T1,LKPBLK+.RBEXT	;STORE EXTENSION IN FOR THE LOOKUP
	MOVEI	T1,.RBUSD		;STORE THE LENGTH
	MOVEM	T1,LKPBLK		;FOR THE LOOKUP
	MOVSI	T1,(UU.PHS)		;PHYSICAL DEVICE
	DMOVEM	T1,FLPBLK+.FOIOS	;SET UP THE FILOP BLOCK
	SETZM	FLPBLK+.FOBRH		;NO BUFFERS
	SETZM	FLPBLK+.FONBF		;I SAID NO BUFFERS
	SETZM	FLPBLK+.FOPAT		;NO RETURNED PATH
	MOVEI	T1,LKPBLK
	MOVEM	T1,FLPBLK+.FOLEB	;POINT TO LOOKUP BLOCK
	MOVE	T1,[FO.PRV!XWD QCHN,.FORED]
	MOVEM	T1,FLPBLK+.FOFNC	;JUST WANT TO FIND THE FILE
	MOVE	T1,[.FOPPN+1,,FLPBLK]
	FILOP.	T1,		;DO THE LOOKUP
	  POPJ	P,		;CAN'T
	MOVE	T1,[QCHN,,.FOREL]	;NOW GET RID OF THE CHANNEL
	MOVEM	T1,FLPBLK+.FOFNC
	MOVE	T1,[1,,FLPBLK]		;BY DOING A RELEAS
	FILOP.	T1,
	  JFCL
	MOVE	T1,LKPBLK+.RBQTF	;T1=LOGGED IN QUOTA
	MOVE	T2,LKPBLK+.RBQTO	;T2=LOGGED OUT QUOTA
	MOVE	T3,LKPBLK+.RBUSD	;T3=QUOTA USED
	JRST 	CPOPJ1			;SMILEY-FACED RETURN

;MISC ROUTINES
repeat 0,<
.SAVE1:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,(P)		;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	  JRST	RES1
	AOS	-1(P)
	JRST	RES1

.SAVE2:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,-1(P)	;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	  JRST	RES2
	AOS	-2(P)
	JRST	RES2

.SAVE3:	EXCH	P1,(P)		;SAVE P1, GET CALLER PC
	PUSH	P,P2
	PUSH	P,P3
	MOVEM	P1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	P1,-2(P)	;RESTORE P1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	  JRST	RES3
	AOS	-3(P)
;	JRST	RES3

RES3:	POP	P,P3
RES2:	POP	P,P2
RES1:	POP	P,P1
	POPJ	P,

.SAV2T:	EXCH	T1,(P)		;SAVE T1, GET CALLER PC
	PUSH	P,T2
	MOVEM	T1,1(P)		;SAVE CALLER PC ONE BEYOND END
	MOVE	T1,-1(P)	;RESTORE T1
	PUSHJ	P,@1(P)		;GO BACK TO CALLER, OVERWRITE CALLER PC WITH .+1
	  SKIPA
	AOS	-2(P)
	POP	P,T2
	POP	P,T1
	POPJ	P,

>;end repeat 0

;BLDQUE	- returns the next .ENV file in UPS:
;	MOVE	T1,addr of one zeroed page (FIRST CALL ONLY)
;	PUSHJ	P,BLDQUE
;	  return here if no more .ENV files.  The zeroed page may be returned.
;	return here with next filename in T2
;
; uses T1-T3

	BUF=14			;ACS FOR THE BUFFER HEADER BLOCK
	LKP=15			;AND THE LOOKUP BLOCK
	FLP=16			;THE FILOP BLOCK

	UPS=15			;CHANNEL FOR READING UPS:.UFD

BLDQUE::EXCH	BUF,BLDSAV	;SAVE/RESTORE ACS
	EXCH	LKP,BLDSAV+1	; ...
	EXCH	FLP,BLDSAV+2	; ...
	SKIPE	BLDING		;HAVE WE INITED THE FILE?
	  JRST	BLDMOR		;YES, SKIP THIS STUFF
	MOVE	BUF,T1		;BUFFER HEADER
	ADDI	T1,3		;WHICH IS 3 WORDS LONG

	MOVE	LKP,T1		;LOOKUP BLOCK
	MOVE	T2,[XWD	5,35]	;FILE NAME
	MOVEM	T2,(T1)		;TO LOOKUP BLOCK
	AOS	T1		;POINT TO EXTENSION FIELD
	HRLZI	T2,'UFD'	;EXTENSION
	MOVEM	T2,(T1)		;INTO LOOKUP BLOCK
	ADDI	T1,3		;POINT PAST LOOKUP BLOCK

	MOVE	FLP,T1		;FILOP BLOCK
	MOVX	T2,<FO.PRV!<UPS>B17!.FORED>	;(.FOFNC) FUNCION READ
	MOVEM	T2,.FOFNC(FLP)
	MOVEI	T2,.IOIMG	;(.FOIOS) IMAGE MODE
	MOVEM	T2,.FOIOS(FLP)
	HRLZI	T2,'MFD'	;(.FODEV) DEVICE
	MOVEM	T2,.FODEV(FLP)
	MOVE	T2,BUF		;(.FOBRH) BUFFER HEADERS
	MOVEM	T2,.FOBRH(FLP)
	MOVEI	T2,1		;(.FONBF) BUFFERS
	MOVEM	T2,.FONBF(FLP)
	MOVE	T2,LKP		;(.FOLEB) LOOKUP BLOCK
	MOVEM	T2,.FOLEB(FLP)
	SETZ	T2,		;(.FOPAT) PATH BLOCK
	MOVEM	T2,.FOPAT(FLP)
	MOVE	T2,[5,,35]	;(.FOPPN) LOGGED IN AS UPS
	MOVEM	T2,.FOPPN(FLP)
	ADDI	T1,.FOPPN+1	;INCREMENT POINTER TO WORK SPACE
	EXCH	T1,.JBFF	;FUDGE .JBFF FOR OUR BUFFER
	MOVE	T2,FLP		;POINT TO THE FILOP BLOCK
	HRLI	T2,.FOPPN+1	;AND PLUG IN ITS LENGTH
	FILOP.	T2,		;OPEN FOR READ UPS:.UFD
	 HALT			;NO UFD FOR QUEUED MAIL!
	EXCH	T1,.JBFF	;FIX .JBFF
	SETOM	BLDING		;REBUILD IN PROGRESS, LETS REMEMBER THAT

BLDMOR:	HRLZI	T3,'ENV'	;SAVE EXTENSION FOR COMPARISONS
BLD.0:	PUSHJ	P,GETWRD	;GET A WORD FROM THE FILE
	 JRST	BLD.EN		;END OF FILE, SO CLOSE IT UP
	JUMPE	T1,[PUSHJ P,GETWRD	;IF NULL FILENAME READ EXTN
		     JRST BLD.EN	;(EOF), STOP
		    JRST BLD.0]	;TRY FOR A REAL FILE ENTRY
	MOVE	T2,T1		;GET THE NODE NAME SAFE AND SOUND

BLD.2:	PUSHJ	P,GETWRD	;GET THE EXT
	 JRST	BLD.EN		;THE END OF THE FILE
	HLLZS	T1		;GET THE EXTENSION
	CAME	T1,T3		;IS THIS AN ENV FILE?
	 JRST	BLD.0		;NOPE, LETS LOOK AT THE NEXT ONE
	AOS	(P)		;YEP, INDICATE GOOD RETURN (WITH FILNAME IN T2)
	JRST	BLDEND		;FINISH UP AND RETURN

BLD.EN:	CLOSE	UPS,		;CLOSE THE FILE
	RELEASE	UPS,		;AND RELEASE THE CHANNEL
	SETZM	BLDING		;ZERO FLAG SO WE START AT TOP
BLDEND:	EXCH	BUF,BLDSAV	;SAVE/RESTORE ACS
	EXCH	LKP,BLDSAV+1	; ...
	EXCH	FLP,BLDSAV+2	; ...
	POPJ	P,		;RETURN TO CALLER

	SUBTTL	GETWRD - Get a word from the file

GETWRD:	SOSGE	.BFCTR(BUF)	;ANY MORE LEFT?
	 JRST	CPYBIN		;INPUT A BYTE THEN

	ILDB	T1,.BFPTR(BUF)	;GET THE WORD IN T1
	JRST	CPOPJ1		;AND SKIP RETURN

CPYBIN:	IN	UPS,		;DO THE INPUT
	 JRST	GETWRD		;AND GET THE NEXT WORD
	POPJ	P,		;JUST RETURN

; CREATE OR DELETE UFDS
; CALL:	MOVEI	T1, USER PROFILE ADDRESS
;	PUSHJ	P,UFDCRE/UFDDEL
;	  <NON-SKIP>
;	<SKIP>
;
; NON-SKIP:	FAILED, ERROR MESSAGE ISSUED
; SKIP:		SUCCEEDED
;
; *** NOTE ***
; THIS ROUTINE REQUIRES AN EXTERNAL SUBROUTINE CALLED MXUFDE (MX UFD
; ERROR HANDLER).  IT WILL BE CALLED ON CATASTROPHIC ERRORS WITH T1
; CONTAINING A RIGHT-JUSTIFIED SIXBIT PREFIX AND T2 CONTAINING THE
; ADDRESS OF AN ASCIZ STRING.  RETURN IF VIA A POPJ.  NO ACS NEED BE
; PRESERVED.

UFDCRE::SKIPA	T2,[.UFMNT]	;MOUNT ENTRY POINT
UFDDEL::MOVEI	T2,.UFDMO	;DISMOUNT ENTRY POINT
	SETZM	ERRFLG		;CLEAR THE ERROR FLAG
	MOVEM	T1,PROFIL	;SAVE PROFILE ADDRESS
	PUSHJ	P,UFDINI	;INIT LOOP

UFDCOM:	MOVE	T1,[UFDBLK,,UFDBLK+1] ;SETUP BLT
	SETZM	UFDBLK		;CLEAR FIRST
	BLT	T1,UFDBLK+.UFSIZ-1 ;ZERO THEM ALL
	MOVE	T1,FUNCT	;GET FUNCTION CODE
	DPB	T1,[POINTR UFDBLK+.UFFLG,UF.FNC] ;STORE
	MOVE	T1,USRPPN	;GET TARGET PPN
	MOVEM	T1,UFDBLK+.UFPPN ;SAVE
	SETOM	UFDBLK+.UFJOB	;MY JOB
	SETOM	UFDBLK+.UFPRO	;DEFAULT (OR DON'T TOUCH) PROTECTION
	MOVX	T1,<UF.NRD!UF.IBP> ;IN BEHALF OF ANOTHER PPN (DON'T RECOMPUTE)
	IORM	T1,UFDBLK+.UFFLG
	MOVE	T1,AUXPTR	;GET AOBJN POINTER TO AUXACC DATA
	SKIPN	T2,.AUSTR(T1)	;GET A STRUCTURE NAME
	JRST	[ADD	T1,[.AULEN-1,,.AULEN-1]	;ACCOUNT FOR MISSING .AUBIT
		 JRST	UFDCO1]	;FIND NEXT ENTRY
	MOVEM	T2,UFDBLK+.UFSTR
;.AULIN
	AOBJN	T1,.+2		;OK IF NEXT FIELD
	TDZA	T2,T2		;NO, VALUE IS ZERO
	MOVE	T2,(T1)		;FCFS QUOTA
	MOVEM	T2,UFDBLK+.UFQTF
;.AUOUT
	AOBJN	T1,.+2		;OK IF NEXT FIELD
	TDZA	T2,T2		;NO, VALUE IS ZERO
	MOVE	T2,(T1)	        ;LOGGED OUT QUOTA
	MOVEM	T2,UFDBLK+.UFQTO
;.AURES
	AOBJN	T1,.+2		;OK IF NEXT FIELD
	TDZA	T2,T2		;NO, VALUE IS ZERO
	MOVE	T2,(T1)		;RESERVED QUOTA
	MOVEM	T2,UFDBLK+.UFQTR
;.AUBIT
	AOBJN	T1,.+2		;OK IF NEXT FIELD
	TDZA	T2,T2		;NO, VALUE IS ZERO
	MOVE	T2,(T1)		;STATUS BITS
	MOVEM	T2,UFDBLK+.UFSTS
	MOVEM	T1,AUXPTR	;UPDATE POINTER
	MOVEI	T1,CPOPJ	;GET TYPER
	MOVEM	T1,UFDBLK+.UFTYO ;SAVE
	MOVEI	T1,UFDBLK	;POINT TO ARGS
	PUSHJ	P,.UFD##	;DO SOMETHING
	  JRST	[PUSHJ	P,UFDERR	;REPORT THE ERROR
		JRST 	UFDCO0]		;SKIP PAST SUCCESS INDICATOR
	MOVEI	T1,1		;SUCESS...
	MOVEM	T1,ERRFLG	;...AT LEAST ONE STRUCTURE MOUNTED
UFDCO0:	MOVE	T1,AUXPTR	;GET AOBJN POINTER TO AUXACC DATA
UFDCO1:	AOBJP	T1,UFDXIT	;RETURN IF DONE
	MOVEM	T1,AUXPTR	;ELSE UPDATE POINTER
	JRST	UFDCOM		;AND LOOP BACK

; INITIALIZE UFD MOUNT/DISMOUNT LOOP
; CALL:	MOVE	T2, FUNCTION CODE
UFDINI:	MOVEM	T2,FUNCT	;SAVE FUNCTION CODE
	MOVE	T1,PROFIL	;GET PROFILE ADDRESS
	MOVE	T2,.AEAUX(T1)	;POINT TO START OF AUXACC DATA
	ADDI	T2,(T1)		;INDEX INTO THE PROFILE
	MOVEM	T2,AUXPTR	;SAVE
	MOVE	T2,.AEPPN(T1)	;GET PPN
	MOVEM	T2,USRPPN	;SAVE
	POPJ	P,		;RETURN


; EXIT PROCESSING
UFDXIT:	SKIPE	ERRFLG		;WAS THERE AN ERROR?
CPOPJ1:	AOS	(P)		;NO
CPOPJ:	POPJ	P,		;RETURN


; ERROR PROCESSING
; CALL:	PUSHJ	P,UFDERR
;	<NON-SKIP>		;ALWAYS, TO CONTINUE PROCESSING
repeat 0,<
UFDERR:	MOVEI	T2,.UFDMO	;FUNCTION TO CHECK
	CAME	T2,FUNCT	;DISMOUNTING ALL STRUCTURES?
	PUSHJ	P,UFDINI	;NO, RESET POINTERS FOR DISMOUNT
	AOS	ERRFLG		;INDICATE AN ERROR OCCURED
	HRRZ	T1,UFDBLK+.UFPFX ;GET SIXBIT PREFIX
	MOVE	T2,UFDBLK+.UFTXT ;AND ASSOCIATED ERROR TEXT
	PJRST	MXUFDE##	;REPORT UFD ERROR AND RETURN
> ;End repeat zero

UFDERR:	HRRZ	T1,UFDBLK+.UFPFX ;GET SIXBIT PREFIX
	CAIN	T1,'IDV'	;[xxx]IS IT THE ILLEGAL DEVICE ERROR?
	POPJ	P,		;[xxx]Nothing to do
	MOVE	T2,UFDBLK+.UFTXT ;AND ASSOCIATED ERROR TEXT
	PJRST	MXUFDE##	;NO, REPORT UFD ERROR AND RETURN

	END