.TITLE LOG HANDLER FUNCTION CODE .IDENT "V3.0" .nlist bex,me,cnd .enabl lc .SBTTL AUTHOR'S CREDITS ; Author: Henry R. Tumblin ; Date: ; Version: 3.0 ; For: Systems - Utilities ; Machine/System: PDP-11/70 IAS V3.0 ; Type/Language: Subroutines/Assembler ; Residence: DB0:[1,20]LGROOT.MAC ; Abstract: This module contains all the ; currently supported utility ; functions for the LG.... ; handler. ; ; Edits: ;NO. Date By Reason ;--- --------- ----- -------------------------------------------- ; 03-Feb-79 HRT Removed carriage control from LOG record. ; 03-Feb-79 HRT Added User name lookup function. ; 04-Feb-79 HRT Added UPF lookup function. ; 05-Feb-79 HRT Added DAC lookup function. ; 18-Feb-79 HRT Fixed up file open, added call to .FIND to ; determine if the file exists. ;+06 28-Aug-79 HRT Re-documented for IAS V3.0. ;+07 14-Apr-80 EAJ Eliminated Debug statment and changed QIOW$ ; to QIO$ so CTRL/S on operators console ; won't hang system. .sbttl Mcall's, Local and Global definitions .mcall FCSMC$,GTIM$S,GCOM$,ASTX$S,SPRA$ .mcall PUSH,POP,DIR$,C$C,MRKT$S,SVTK$ .mcall WTSE$S,CMKT$S,RQST$,QIO$ .globl TS,BUF FCSMC$ ; Mcall FCS macros C$C ; define control characters LGLUN==2 ; lun for FCS UP.UIC=10 ; Offset to UPF UIC UP.USN=0 ; Offset to UPF user name .SBTTL MACROS .MACRO .INH ; Inhibit task switching macro MOV @#PS,-(SP) ; Save our current status BIS #340,@#PS ; Change our mode to KERNAL .ENDM .INH .MACRO .ENB ; Enable task-switching macro MOV (SP)+,@#PS ; Restore the prior status .ENDM .ENB .MACRO PRINT BUFF,LENGTH,CCW ; Print data to terminal macro .IF B CCW CLR -(SP) .IFF PUSH .ENDC PUSH ; Get the address + length CALL $OUT ; Call common output routine .ENDM PRINT .SBTTL Define Handler special function codes ; The functions described here are all the currently supported ; functions of this handler. Each function has a macro ; associated with it for the user to interface to. To define ; these symbols locally within a user program, use the ; LGDEF$ macro. .MCALL .WORD.,DEFIN$ ...gbl=0 ; Define offsets globally .WORD. LG.LOG,000,001 ; Log record to file .WORD. LG.ATT,000,003 ; Attach .WORD. LG.DET,000,004 ; Detach .WORD. LG.NAM,000,005 ; Get user name subfunction(P) .WORD. LG.UPF,001,005 ; Get UPF record (P) .WORD. LG.UIC,002,005 ; Get UPF record by UIC (P) .WORD. LG.DAC,003,005 ; Get disk accounting info .WORD. LG.ACT,004,005 ; Return list of terminals .sbttl FCS Stuff .sbttl Log file FDB FSRSZ$ 1 ; define buffer area for FCS LGFDB:: FDBDF$ ; Allocate space for a File ; Descriptor Block. FDAT$A R.VAR,FD.CR,160.,-10.,-10. ; Record Attributes: ... ; ...Variable Length ; ...Implied carriage control ; ...Maxbuf of 160. bytes ; ...Create 10. blocks initially ; ...Extend by 10. blocks each time FDRC$A ,BUF,BUFS ; File Access: ... ; Input buffer is BUF ; Input buffer size is BUFS FDOP$A LGLUN,LGDPST,,FO.APD!FA.SHR,FA.DLK ; File Open: ... ; ...File lun is LGLUN ; ...File name block pointer ; ...Open for append ; ...and shared access ; ...Don't lock file if aborted. LGDPST:: .WORD LGDEVS,LGDEV ; File name block descriptor .WORD LGUICS,LGUIC ; .WORD LGNAMS,LGNAM ; LGDEV: .ASCII "LB0:" ; Output device LGDEVS=.-LGDEV LGUIC: .ASCII "[1,2]" ; Output UIC LGUICS=.-LGUIC LGNAM: .ASCII " .LOG" ; Output File name LGNAMS=.-LGNAM .sbttl UPF file FDB UPFFDB:: ; Define a FDB for the UPF file FDBDF$ ; Allocate a FDB FDRC$A FD.RAN,BUF,64. ; Record access: ; ...Random access ; ...Input buffer is BUF ; ...Input record size is 64. bytes FDOP$A LGLUN,UPFDSD,,FO.RD!FA.SHR ; File Open: ; ...File lun is 1 ; ...Dataset descriptor. ; ...Readonly-shared FDBF$A ,,1 ; Block buffer: ; ...Multi buffer count = 1 UPFDSD: .WORD DEVS,DEV ; device .WORD UICS,UIC ; uic .WORD FNAMS,FNAM ; filename DEV: .ASCII "LB00:" ; DEVS=.-DEV UIC: .ASCII "[001,100]" ; UICS=.-UIC FNAM: .ASCII "PDSUPF.DAT" ; FNAMS=.-FNAM .even .sbttl Impure areas .even ; The following table is the Synchronous System Trap ; vector table. It is used to allow the handler to ; die gracefully in the event of an internal handler ; error. TRPTAB: .WORD TRPHND ; Odd address trap .WORD TRPHND ; Segment fault .WORD TRPHND ; T-bit trap .WORD TRPHND ; IOT .WORD TRPHND ; Reserved instruction .WORD TRPHND ; Non-IAS EMT .WORD TRPHND ; Trap instruction .WORD TRPHND ; 11/40 flting pnt exec. .WORD TRPHND ; Memory parity error TTSIZ=<.-TRPTAB>/2 ; # of entries in table TS: .BLKW 10. ; Trap register save area ; The File-ID is saved after the LOG file is initially ; created so that all subsequent file opens can be ; made by File-ID and reduce overhead of OPEN$ FIDADR: .BLKW 3 ; area to store filename block ; The following buffer is used for a variety of different ; things. It can be used by any subroutine as a record ; buffering area, or scratch area to be used to build a ; message, etc. BUF: BASEA: .WORD 0 ; IASCOM Base address SIZE: .WORD 0 ; IASCOM size .BLKB 296. ; output buffer BUFS=.-BUF ; buffer size .EVEN ; The following table is the dispatch table for the ; special PDS> functions. Each entry to the table ; consists of the address of the subroutine to CALL. PDSDPT: .WORD GETNAM ; Get User Name from IASCOM .WORD GETUPF ; Get User Profile Record(Name) .WORD GETUIC ; Get User Profile Record(UIC) .WORD GETDAC ; Get Disk Accounting Summary .WORD GETTER ; Get List of terminals specified ; user is active on. PMXFC=<.-PDSDPT>/2 ; Max number of functions. ; The following 4 words are used by the PDS User Profile ; lookup routines as temporary relative record # pointers. RECNO: .WORD 0 ; Record number in UPF file INDXNO: .WORD 0 ; Index record # in UPF file IEND: .WORD 0 ; Ending index record # END: .WORD 0 ; Ending UPF record # RECSIZ: .BLKW 1 ; Size of record to output to log file .sbttl DPB's of interest .globl PWRF,SVTB PWRF: SPRA$ PWRAST ; Declare power fail AST SVTB: SVTK$ TRPTAB,TTSIZ ; Declare SST table GCOM: GCOM$ IASCOM,BUF ; Get common DPB REQDAC: RQST$ DSKACN,,150,1,1 ; Request Disk Accounting $WRT: QIO$ IO.WLB,SYLUN,10,100,,,<0,0,0> ;+07 Msgs to console. .SBTTL MESSAGE STRINGS CRERR: .ASCII "%NLG -- Unable to open LOG file" .ASCII "%N FCS Error # %D%N" .ASCIZ "LG -- Continuing" NEWD: .ASCIZ "%NLG -- Today's date is %Y" PWRFL: .ASCII "LG -- Power fail occurred, System restarting" .ASCIZ ", Time of failure = %3Z, %Y" PWRFLS=.-PWRFL TRPDMP: .ASCII "LG -- Aborting due to error%N" .ASCII "Crashing SP = %P%N" .ASCII "Crashing PC = %P%N" .ASCII "Crashing PS = %P%N" .ASCII "%9SR0 = %P%N" .ASCII "%9SR1 = %P%N" .ASCII "%9SR2 = %P%N" .ASCII "%9SR3 = %P%N" .ASCII "%9SR4 = %P%N" .ASCIZ "%9SR5 = %P%N" .EVEN .SBTTL Attach and Detach ; Attach and Detach function ; The attach and detach functions have been added ; here for compatability with some tasks that ; attach to the device first then start ; up their I/O. At all times, the attach and or ; detach will always succeed. ATTC:: MOV $RQIO,R1 ; Get request node -> R1 MOV $PDPTR,R2 ; Get PUD pointer -> R2 CALL ..ATUN ; Attach the task MOV #1,$STAT0 ; set sucess JMP IODUN ; Go do I/O done processing DEAT:: MOV $RQIO,R1 ; Get Request node -> R1 MOV $PDPTR,R2 ; Get PUD pointer -> R2 CALL ..DTUN ; Deattach unit BCC 10$ ; CC - then return success MOV #IE.DNA,$STAT0 ; Device Not Attached 10$: JMP IODUN ; Go do I/O Done .SBTTL WRITE LOG FUNCTION WRTLOG:: ; This function will output to a log file any information ; regarding the system that is sent to it via a IO.WLB or IO.WVB ; QIO function code. ; First move the users output string into our buffer area MOV $RQIO,R1 ; R1 = QI/O request node address MOV R.PB(R1),R2 ; get pointer to line descriptor MOV R.PB+2(R1),R3 ; set length of transfer MOV #BUF,R4 ; set output buffer address CALL ..BLXI ; get user string BCC CMPRS ; cc - then no errors CLR $STAT0 ; Clear out any junk MOVB #IE.SPC,$STAT0 ; error - out of address space ; IODUN is a common return point for all function routines. ; a JMP IODUN is made by each function routine to allow a ; common return point for I/O done processing. IODUN: CALL $IODUN ; perform I/O done JMP $WAIT ; go back to wait loop ; Compress the record by eliminating control characters. CMPRS: MOV R3,RECSIZ ; Get size of record x-ferred MOV #7,$BUFF ; ... PUSH <#$BUFF,#RECSIZ,#BUF,#3> ; Set up parameter list MOV SP,R5 ; Point to the argument list -> R5 CALL KILC ; Compress the record ADD #10,SP ; Clean up the stack. .sbttl Append the record to the log file .enabl lsb ; Output record to CO0: PRINT #BUF,RECSIZ,#40 ; also output to operator's console ; If the file open fails, then try to create a new file. ; also, let's store the file ID to allow for quicker opens MOV #LGFDB,R0 ; Point to the FDB MOV #LGFDB+F.FNB,R1 ; Point to the file name block CLR N.FVER(R1) ; Find the most recent version CALL .FIND ; Is it there? BCC FNDOK ; CS - Then file not found. ; Open error 13$: CALL OPNERR ; Go process open error MOV #IE.BAD,$STAT0 ; Set bad code BR WREX ; Go exit function FNDOK: OFID$A ; open log file for append BCS 13$ ; CS - then error ; Now output the completed record to the output file ; OPOK: PUT$ R0,,RECSIZ ; output the record CLOSE$ R0 ; close the file ; Now restore the file id information to the FDB CALL UNSFID ; restore file ID CLR $STAT0 ; Clear out junk MOVB #IS.SUC,$STAT0 ; set I/O success WREX: JMP IODUN ; Go to wait loop .dsabl lsb .sbttl New file stuff .enabl lsb ; The way that this routine works, is that it is ; initially entered when the handler is ; loaded. It checks to see what the time is, and schedules ; itself to be entered after midnite to print up the system ; log for the previous day, then requests itself again. NEWFIL:: CALL $SAVAL ; Save all registers ; Set up so that we will be woken up ; at midnite. GTIM$S #BUF ; Get current time MOV #23.,R1 ; 24-1 hours in a day SUB BUF+G.TIHR,R1 ; Get hours left today MUL #60.,R1 ; Convert to minutes MOV #60.,R0 ; Set up for miutes this hour ADD #1,R0 ; BE SURE TO GET INTO TOMORROW SUB BUF+G.TIMI,R0 ; Correct the minutes left ADD R0,R1 ; Add in minutes so far this hour MRKT$S #0,R1,#3,#NEWAST ; Set up AST to create next file ; Now get today's date in order to generate a ; file name. The filename will be of the ; general format : ; DDMMMYY.LOG ; ; Convert date to form DD-MMM-YY MOV #$BUFF,R0 ; Point to output area MOV #BUF+G.TIYR,R1 ; Point to input area CALL $DAT ; Convert date to ascii ; Convert date to form DDMMMYY and move into filename ; buffer. MOV #$BUFF,R0 ; Reset pointer MOV #9.,R1 ; Set counter MOV #LGNAM,R2 ; Set output pointer 5$: CMPB #40,(R0) ; Is it a blank ? BNE 10$ ; NE - then go on. MOVB #'0,(R2)+ ; Replace the blank with a 0 BR 40$ ; Go to end of block 10$: CMPB #'-,(R0) ; Is it a hyphen ?? BEQ 40$ ; EQ - then go on. MOVB (R0),(R2)+ ; Move into position 40$: INC R0 ; Point to next character SOB R1,5$ ; Loop till Thru. ; Now parse the filename string and check to see ; if the file already exists. If it doesn't, then ; open a new file. MOV #LGFDB,R0 ; Set pointer to the FDB MOV #LGFDB+F.FNB,R1 ; Point to the filename block. MOV #LGDPST,R2 ; Point to the dataset descriptor. CLR R3 ; No default file name CALL .PARSE ; Parse the input filespecs. CLR N.FVER(R1) ; Clear the version # CALL .FIND ; Try to find the file. BCC 100$ ; CC - then it exists!!, save the FID ; If the file doesn't exist, then create a new LOG file ; on the LB: device under the UFD of [1,2] OFNB$W ; Else open a new file BCC 100$ ; CC - then we're ok ; If there is an open error, then display a message to the ; operator's console, and do I/O done processing. CALL OPNERR ; Process open error BR 110$ ; And go return to caller ; Save the contents of the File Name Block for faster ; opens on the log file. 100$: CALL SAVFID ; Save file ID for subsequent opens CALL CLSFIL ; Close the file. CALL UNSFID ; Unsave the file ID. 110$: RETURN ; Return to calling proc. .dsabl lsb .SBTTL Special PDS related functions .enabl lsb PDSFUN:: ; Each Special routine is entered via a ; JSR PC,addrs. This allows easy addition of ; functions to this handler as each being a ; subroutine. It is the responsibility of ; each function to set the proper success/failure ; code in $STAT0 and $STAT1. If the routine ; returns the C-bit set, then a JMP to $ERROR is ; made, else a JMP to IODUN is performed. ; Verify that the subfunction code is valid. MOV $RQIO,R1 ; Get the Rqst node address MOVB R.FC(R1),R1 ; Get the sub-function code BIC #<^C377>,R1 ; Clear off any junk CMP #PMXFC,R1 ; Is it > max function code? BGE 30$ ; GE - then ok subfunct. code MOV #IE.IFC,$STAT0 ; Else tell them its bad JMP $ERROR ; Error - bad function code ; Now dispatch the request to the appropriate ; subroutine. If the C-bit is set on return, ; then go to the error processing routine. Else ; do normal I/O done processing. 30$: ASL R1 ; Get offset into dsptch table CALL @PDSDPT(R1) ; Go to the proper routine BCC 40$ ; CC - Then no errors JMP $ERROR ; Else go do error stuff 40$: JMP IODUN ; Go do IO-done .dsabl lsb .sbttl Subfunction 0, Get user name from IASCOM .enabl lsb ; GET_NAM - Get user name from IASCOM. ; ; This function will scan IASCOM for the user name and return ; it to the requesting task in ASCII and RAD-50. ; ; The parameters list should be as follows: ; ; QIOW$ LG.NAM,LUN,EF1,PRI,IOSB,AST, ; ; Where: ; LG.NAM - The function code to the handler ; LUN - The LUN to use. Should be assigned ; to LG0: somehow. ; EF1 - The event flag to use ; PRI - The priority of the request ; IOSB - The address of the I/O status block ; AST - An AST entry point ; BUFF - The address of a 10. word buffer to use. GETNAM:: CALL $SAVAL ; Save our registers ; Get the information from the request node. MOV $RQIO,R1 ; Get their RN address MOV R.AT(R1),R0 ; Get their ATL address MOV A.TI(R0),R0 ; Point to their PUD ; Get the user name from IASCOM. This function ; was made into a subroutine to allow other ; functions to share its use. CALL FNDUSR ; Get the user name BCS 26$ ; CS - then do errors ; Now convert the user name to RAD-50, so that we ; give both back to the user. ; We'll re-use the same buffer as GCOM$ does.(why not?) ;+07 One line removed. ; The format of the returned buffer is: ; ; ***************************************** ; * Words 1-6: 12 character user name * ; * total length - 12. bytes * ; ***************************************** ; * Words 7-10: RAD-50 user name. * ; * total length - 8. bytes * ; ***************************************** ; ; Total length of user buffer required = 20. bytes, 10. words. 31$: MOV #4.,R4 ; Set loop count MOV #BUF+14,R3 ; Get pointer to dst buffer MOV #BUF,R0 ; Set src pointer 22$: MOV #1,R1 ; Set for proper conversion MOV R0,-(SP) ; Save pointer CALL $CAT5 ; Convert 3 bytes to R-50 MOV R1,(R3)+ ; Move into the buffer MOV (SP)+,R0 ; Restore pointer ADD #3,R0 ; Point to next 3 characters SOB R4,22$ ; Loop until thru ; Now move the data back to the users space. MOV $RQIO,R1 ; Get RN address MOV R.PB(R1),R2 ; Set VA of where it's going MOV #24,R3 ; And the # of bytes to XFER MOV #BUF,R4 ; And where it's coming from CALL ..BLXO ; Send it to the user BCC 40$ ; CC - then X-fer successfull MOV #IE.SPC,$STAT0 ; Set error condition BR 26$ ; And return 40$: MOV #1,$STAT0 ; Set I/O Success 26$: RETURN ; Return to caller .dsabl lsb .SBTTL GET_UIC .enabl lsb ; GETUIC - THIS ROUTINE SCANS PDSUPF.DAT SEQUENTIALLY ; - SEARCHING FOR A MATCH FOR THE UIC SPECIFIED. ; ; The parameters list should be as follows: ; ; QIOW$ LG.UIC,LUN,EF1,PRI,IOSB,AST, ; ; Where: ; LG.NAM - The function code to the handler ; LUN - The LUN to use. Should be assigned ; to LG0: somehow. ; EF1 - The event flag to use ; PRI - The priority of the request ; IOSB - The address of the I/O status block ; AST - An AST entry point ; UIC - The UIC of the UPF record to scan for. The ; general format of the UIC is: ; .BYTE MEMBER,GROUP ; BUFF - The address of a 32. word buffer to use. ; **Note** ; To use this function, the user much ; be a [1,*] user or else the handler ; will return a priviledge violation error. GETUIC: CALL $SAVAL ; Save our registers ; Check to see if they are a priviledeged user. ; If so, then continue. Else return with priv. violation ; error. MOV $RQIO,R1 ; Point to the request node CMPB #1,R.GC(R1) ; Are they priviledged? BEQ 12$ ; EQ - Yup, continue MOV #IE.PRI,$STAT0 ; Else set error ERET: SEC ; Set carry RETURN ; And leave ; Now set up to scan the UPF. Use GETDEF to open ; the UPF and read the first(default) record. ; If there is an error, then that means that we are unable to ; access the UPF for some reason. For now, let's die ; instead of stalling. 12$: MOV R.PB(R1),R4 ; Get the UIC to find -> R4 CALL GETDEF ; Get the default record # BCS 90$ ; CS - Then unable to access UPF MOV #BUF,R3 ; Point to buffer to use MOV (R3),RECNO ; RECNO has starting record # DEC RECNO ; -1 for start of loop MOV 2(R3),END ; END has the ending record # ; Start the main scan loop. Scan the UPF file sequentially ; looking for the UIC that was specified. If not found, then ; the UIC does not have a valid UPF account. 5$: INC RECNO ; Bump up the count to the next record CMP RECNO,END ; Are we at the end yet? BLE 10$ ; LE - Nope. ; Can't find record for account in UPF. ; So, Return an error of 0 to indicate UPF record not found CLR $STAT0 ; Set status BR ERET ; Go do error stuff 10$: GET$R ,R3,,RECNO,#0 ; Get next record BCS 90$ ; CS - then quit TST UP.UIC(R3) ; Is this a null record? BEQ 5$ ; EQ - yup, try next record CMP R4,UP.UIC(R3) ; Do the UIC's match? BNE 5$ ; NE - then check next record 90$: CALL CLSFIL ; Close the file ; The UPF record has been found and read into the ; buffer. Set up to transfer the record back to the ; users buffer using the ..BLXO subroutine. MOV $RQIO,R1 ; Request node addres -> R1 MOV R.PB+2(R1),R2 ; Set starting address of X-fer MOV #64.,R3 ; Length of transfer MOV #BUF,R4 ; Where it's coming from CALL ..BLXO ; Transfer it to the users area BCC 34$ ; CC - then X-fer successfull. MOV #IE.SPC,$STAT0 ; Else set error BR ERET ; Go return 34$: MOV #IS.SUC,$STAT0 ; Set success MOV #64.,$STAT1 ; And buffer length 36$: RETURN ; Return to caller .dsabl lsb .sbttl GET_UPF Find user profile record by user name .enabl lsb ; GET_UPF - Get user profile record ; ; This function will scan PDSUPF for the user profile record ; for the user name specified. ; The parameters list should be as follows: ; ; QIOW$ LG.UPF,LUN,EF1,PRI,IOSB,AST, ; ; Where: ; LG.NAM - The function code to the handler ; LUN - The LUN to use. Should be assigned ; to LG0: somehow. ; EF1 - The event flag to use ; PRI - The priority of the request ; IOSB - The address of the I/O status block ; AST - An AST entry point ; UNM1-4 - The Rad-50 User name. ; BUFF - The address of a 32. word buffer to use. GETUPF:: ; Define global entry point CALL $SAVAL ; Save our registers ; Get a pointer to the User name to lookup. MOV $RQIO,R4 ; Point to the request node ADD #R.PB,R4 ; Point to the requested user name ; Use GETDEF to open the UPF file and read the default record. CALL GETDEF ; Get the default record MOV #BUF,R3 ; Point to the input buffer MOV (R3),RECNO ; Get the first profile record # MOV (R3),IEND ; The last index Record # MOV 2(R3),END ; The last record # in the UPF MOV #2,INDXNO ; Set current index record number to 2 F001: GET$R ,R3,,INDXNO,#0 ; Read next index record BCS RET001 ; CC - then no errors 30$: MOV #8.,R1 ; Set counter in R1 F002: CMP (R4),(R3) ; Does the 1st word match? BNE F003 ; NE - nope, check next index entry CMP 2(R4),2(R3) ; Does the second word match? BNE F003 ; NE - nope, check next index entry CMP 4(R4),4(R3) ; Does the 3rd word match? BNE F003 ; NE - nope, check next index entry CMP 6(R4),6(R3) ; Does the last word match? BEQ F004 ; Eq - then we've found it! F003: ADD #8.,R3 ; Point to next index entry INC RECNO ; Bump up profile record count SOB R1,F002 ; Loop till thru MOV #BUF,R3 ; Point to the input buffer INC INDXNO ; Point to next index record CMP INDXNO,IEND ; Are we at the end of the index ? BLT F001 ; LT - then get next index record SEC ; Set carry on error BR RET001 ; Go return F004: MOV #BUF,R3 ; Point to the input buffer GET$R ,R3,,RECNO,#0 ; Read the proper UPF record BCS RET001 ; CS - then error CLC ; Else clear carry bit ; Set up to transfer the UPF record back to the users buffer. MOV $RQIO,R1 ; Point to the request node MOV 10(R4),R2 ; Set the program buffer VA MOV #64.,R3 ; Length of transfer MOV #BUF,R4 ; Source buffer address CALL ..BLXO ; Transfer the record. BCC RET001 ; CC - then transfer successfull. RET001: CALL CLSFIL ; Close the input file RETURN ; Return to who called us .dsabl lsb .sbttl Support Subroutines .sbttl 1) Open UPF file and read default record. .enabl lsb ; This module will open the UPF file and ; return the address of the FDB in R0. ; ; Inputs are: ; ; ; Outputs are: ; ; CC - Then file open was successfull. ; CS - Then unable to access file. GETDEF:: ; MOV #UPFFDB,R0 ; Set FDB address in R0 MOV #UPFFDB+F.FNB,R1 ; Point to the FNB TST N.FNAM(R1) ; Has .PARSE been called? BNE 10$ ; NE - Yup, skip other calls MOV #UPFDSD,R2 ; Point to the DSD CLR R3 ; No Default name block CALL .PARSE ; Parse the file specs. 10$: MOV #-1,N.FVER(R1) ; Set to get most recent # CALL .FIND ; Find the file. BCS 100$ ; CS - then file not found OFNB$R ; Else open the UPF file read. BCS 100$ ; CS - then unable to access GET$R ,#BUF,,#1,#0 ; Read the default record BCS 100$ ; CS - then bad record # CLC ; Else clear carry 100$: RETURN ; Return to calling prog. .sbttl 2) Close file. ; This subroutine will close the file whose ; FDB address is in R0. CLSFIL: TST F.BDB(R0) ; Is the file already open ? BEQ 11$ ; EQ - no CLOSE$ R0 ; Close the file 11$: RETURN ; Return to user prog. .dsabl lsb .SBTTL 3) GET DAC Record for user. ; ; This function still has to be written. GETDAC:: ; Define entry point MOV #IE.IFC,$STAT0 ; Make it a bad function code SEC ; Set carry for error RETURN ; Return to caller .sbttl 4) GET_TERminals ; This function will return a list of terminals that the ; user specified is active on. If not specified, then ; an error return will occur. ; this function still needs to be written. GETTER:: MOV #IE.IFC,$STAT0 ; Make it a bad function code SEC ; Set carry for error RETURN ; Return to caller .sbttl 4) New file AST routine. .ENABL LSB ; This AST is entered at MIDNITE each day. The ; purpose of this routine is to create a new log ; file for that particular day. This AST is queued by ; the NEWFIL routine. NEWAST:: TST (SP)+ ; Clear off event flag info GTIM$S #BUF ; Get today's date PUSH ; Save work registers MOV #BUF+16.,R0 ; Point to output area MOV #NEWD,R1 ; Point to format string -> R1 MOV #BUF+G.TIYR,R2 ; Point to input date CALL $EDMSG ; Format the message PRINT #BUF+16.,R1,#40 ; Print newday message POP ; Restore Registers CALL NEWFIL ; Create a new file DIR$ #REQDAC ; Request disk accounting ASTX$S ; Exit the AST .sbttl 5) Power Fail AST ; On power fail, let's log the power-out ; to the log file, and also to the Operator's ; console. There isn't really much more that ; is really needed to do in the event of a power fail. ; And wait for 3 minutes before servicing a request. This ; is to insure that the time has been correctly set ; by the operator and we can start up or create a new file. PWRAST:: ; Declare entry point PRINT #PWRFL,#PWRFLS ; Output message to operator's console CMKT$S ; Cancel any outstanding MRKTS TST LGFDB+F.FNB+N.FNAM ; Is there a filename? BNE 12$ ; NE - Yes, ignore waitfor MRKT$S #10,#3,#3 ; Wait 5 minutes WTSE$S #10 ; Wait for timeout 12$: CALL NEWFIL ; Check the file CALL UNSFID ; Restore the file name block OFNB$A #LGFDB ; Open the output file PUT$ R0,#PWRFL,#PWRFLS ; Output power-fail message CALL CLSFIL ; Close the file ASTX$S ; Exit the AST .dsabl lsb .sbttl 7) Find user name in IASCOM .enabl LSB ; This subroutine picks up the users User Terminal Node ; address from the PUD, remaps APR3 to IASCOM, then returns ; the user name as it exists in IASCOM. ; ; This has been completely re-written from version 2. ; Input arguments are : ; R0 - Pointer to PUD that user is on ; ; Outputs: ; ; BUFF - Contains the user name ; R0 - Destroyed ; R1 - Destroyed ; R5 - Destroyed ; CC - Successfull ; CS - Error - User name not found. FNDUSR:: DIR$ #GCOM ; Get APR info for IASCOM TST @#$DSW ; Was the common area there? BPL 10$ ; MI - then directive error MOV @#$DSW,$STAT0 ; Set return status SEC ; Set error indicator BR 50$ ; And leave 10$: MOV U.ACP(R0),R0 ; Point to our UTN BNE 15$ ; NE - Then OK MOV #IE.PRI,$STAT0 ; Set error SEC ; ... BR 50$ ; And leave 15$: SUB #40000,R0 ; Get rid of APR2 mapping CMP #20000,R0 ; Is UTN mapped thru APR3 ? BHIS 20$ ; HIS - no SUB #20000,R0 ; Get rid of additional APR mapping ADD #200,BASEA ; Point to next 4k of IASCOM 20$: PUSH <#77406,BASEA> ; Set up access PDR,PAR Pair CALL ..SPD3 ; Map into IASCOM ADD #I.UN+60000,R0 ; Point to the user name -> R0 MOV #BUF,R5 ; Get pointer of dest. buff MOV #12.,R1 ; Length of user name ; Now move the user name into the buffer. If any nulls are encountered ; in the user name, they are converted to blanks. 30$: MOVB (R0)+,(R5) ; Move into place BNE 40$ ; NE - then valid char MOVB #' ,(R5) ; If null, blank substitute 40$: TSTB (R5)+ ; Bump up pointer SOB R1,30$ ; Loop till thru CALL ..SPD3 ; Map back to my task CMP (SP)+,(SP)+ ; Get rid of PDR,PAR pair CLC ; Clear error indicator 50$: RETURN ; Return to calling proc. .DSABL LSB .sbttl 8) SAVFID -- Save file ID .enabl lsb ; This routine saves the file name block information ; in the FDB so that it can be restored when the ; file is subsequently re-opened. SAVFID:: MOV R0,-(SP) ; Save work register MOV #LGFDB+F.FNB,R0 ; Point to file name block in FDB MOV N.FID(R0),FIDADR ; Save File-ID MOV N.FID+2(R0),FIDADR+2 ; ... MOV N.FID+4(R0),FIDADR+4 ; ... MOV (SP)+,R0 ; Restore R0 RETURN ; Return to calling proc. .sbttl 9) UNSFID -- Unsave file ID ; This routine takes the file name block information ; and restores it to the File Descriptor Block UNSFID:: MOV R0,-(SP) ; Save work register MOV #LGFDB+F.FNB,R0 ; Point to file name block in FDB MOV FIDADR,N.FID(R0) ; Restore File-ID MOV FIDADR+2,N.FID+2(R0) ; ... MOV FIDADR+4,N.FID+4(R0) ; ... MOV (SP)+,R0 ; Restore R0 RETURN .sbttl 10) MOVDAT -- Move data routine ; This routine will move a block of data from a location ; referenced by r0 to the location referenced by r2 ; for a length specified by r1. ; NOTE: This routine performs a word move. All data ; that is to be moved must be aligned on a fullword ; boundary, else the program will trap out. MOVDAT:: MOV (R0)+,(R2)+ ; Move a word of data SOB R1,MOVDAT ; Loop till thru RETURN ; Return to calling proc. .sbttl 11) $OUT -- Output data to the terminal. BUFF = 2 LENGTH = 4 CCW = 6 $OUT:: MOV LENGTH(SP),$WRT+Q.IOPL+2 ; Set buffer length BEQ 90$ ; EQ - then quit MOV BUFF(SP),$WRT+Q.IOPL ; Set the buffer length MOV CCW(SP),$WRT+Q.IOPL+4 ; Set Format control DIR$ #$WRT ; Output the message 90$: MOV (SP),CCW(SP) ; Restore return address ADD #CCW,SP ; Clean stack RETURN ; Return to call site .dsabl lsb .Sbttl 12) Trap handling module. .enabl lsb ; This module attempts to save the handler and allows ; it to to a gracefull exit in the event of an ; internal error. This will hopefully keep ; the system from crashing in the event of a ; handler abort. Currently, the old SP is restored, ; all registers are dumped and output to the log ; file, the handler declares itself non-resident, ; and does a normal exit. TRPHND:: MOV SP,TS+2 ; Save the current SP BMI 12$ ; MI - then bad stack MOV (SP)+,TS+4 ; Start to save crash info MOV (SP)+,TS+6 ; save old PC and PSW 12$: MOV TS,SP ; Reset the stack MOV R0,TS+10 ; Save the general registers MOV R1,TS+12 ; ... MOV R2,TS+14 ; ... MOV R3,TS+16 ; ... MOV R4,TS+20 ; ... MOV R5,TS+22 ; ... ; Now set up to call $EDMSG to format the ; output string for us. MOV #BUF,R0 ; Point to the output area MOV #TRPDMP,R1 ; Point to the format string MOV #TS+2,R2 ; Point to the parameter block CALL $EDMSG ; Format the message CALL UNSFID ; Restore the file ID OFNB$A #LGFDB ; Open the output file PUT$ ,#BUF,R1 ; Output the crash string CALL CLSFIL ; Close the output file ; Now declare ourselves non-resident and exit JMP $EXIT ; Go to exit code .dsabl lsb .sbttl 13) OPNERR -- Display file open error message ; This routine assumes that R0 contains the address ; of the FDB that has the error. No registers are ; destroyed by this routine. OPNERR: PUSH ; Save work registers CLR R1 ; Clear out junk MOVB F.ERR(R0),R1 ; Get Error code -> R1 PUSH R1 ; Set up argument list MOV #BUF,R0 ; Point to output area -> R0 MOV #CRERR,R1 ; Point to format string -> R1 MOV SP,R2 ; Point to argument list -> R2 CALL $EDMSG ; Format string TST (SP)+ ; Clear off argument list PRINT #BUF,R1,#40 ; Output error message to CO: POP ; Retore registers RETURN ; Return to caller .END