mirror of
https://github.com/PDP-10/stacken.git
synced 2026-05-01 06:09:11 +00:00
727 lines
22 KiB
Plaintext
727 lines
22 KiB
Plaintext
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
|
||
CAIN T3,QUOTE ;Is it a quote?
|
||
JRST NAMPP2 ;Yes, we don't handle quoted strings
|
||
NODLUP: CAIN T3,":" ;Is it a colon?
|
||
JRST NAMPP2 ;Yes. We don't 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.
|
||
|
||
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: 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 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
|
||
|
||
|
||
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
|
||
MOVE P3,T2 ;MOVE THE DESTINATION INTO P3
|
||
HRLI P3,(POINT 7,0) ;AND MAKE IT A BYTE POINTER
|
||
|
||
UDTDA1: 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
|
||
MOVE T2,UFDBLK+.UFTXT ;AND ASSOCIATED ERROR TEXT
|
||
PJRST MXUFDE## ;REPORT UFD ERROR AND RETURN
|
||
|
||
|
||
END
|