; ; Name: SETACC.MAR ; ; Type: Integer*4 Function (MACRO) ; ; Author: M. R. London ; ; Date: Jan 26, 1983 ; ; Purpose: To set the account name of the current process (which turns out ; to be the process running this program.) ; ; Usage: ; status = SETACC(account) ; ; status - $CMKRNL status return. 0 if arguments wrong. ; account - Character string containing account name ; ; NOTES: ; Must link with SS:SYS.STB ; .Title SETACC .IDENT /830531/ ; ; Libraries: ; .LIBRARY /SYS$LIBRARY:LIB.MLB/ ; ; Global variables: ; $PCBDEF $JIBDEF ; ; local variables: ; .PSECT DATA,NOEXE NEWACC: .BLKB 12 ; Contains new account name ; ; Executable: ; .PSECT CODE,EXE,NOWRT ; Executable code .ENTRY SETACC,^M CLRL R0 ; 0 is error code MOVZBL (AP),R6 ; Get number of arguments CMPL R6,#1 ; Correct number of arguments? BNEQ 5$ ; If not, return MOVZBL @4(AP),R6 ; Get size of string MOVL 4(AP),R7 ; Get address of descriptor MOVL 4(R7),R7 ; Get address of string MOVC5 R6,(R7),#32,#8,NEWACC ; Get new account name string $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode 5$: RET 10$: .WORD ^M<> ; Entry mask MOVL SCH$GL_CURPCB,R6 ; Address of current process MOVL PCB$L_JIB(R6),R6 ; Address of Job Info Block ; NOTE: MOVC destroys r0-r5 MOVC3 #8,NEWACC,JIB$T_ACCOUNT(R6) ; change account JIB MOVC3 #8,NEWACC,CTL$T_ACCOUNT ; change account in P1 MOVZWL #SS$_NORMAL,R0 ; Normal ending RET ; ; Name: SETUIC.MAR ; ; Type: Integer*4 Function (MACRO) ; ; Author: M. R. London ; ; Date: May 31, 1983 ; ; Purpose: To set the UIC of the current process (which turns out ; to be the process running this program.) ; ; Usage: ; status = SETUIC(group number, user number) ; ; status - $CMKRNL status return. 0 if arguments wrong. ; group number - longword containing UIC group number ; user number - longword containing UIC user number ; ; NOTES: ; Must link with SS:SYS.STB ; .Title SETUIC Set uic .IDENT /830531/ ; ; Libraries: ; .LIBRARY /SYS$LIBRARY:LIB.MLB/ ; ; Global variables: ; $PCBDEF ; ; Executable: ; .PSECT SETUIC_CODE,EXE,NOWRT ; Executable code .ENTRY SETUIC,^M CLRL R0 ; 0 is error code MOVZBL (AP),R2 ; Get number of arguments CMPL R2,#2 ; Are there 2 arguments BNEQ 5$ ; If not, return MOVL @4(AP),R3 ; Group number into R3 ROTL #16,R3,R3 ; Move to upper half of R3 ADDL2 @8(AP),R3 ; User number to top half of R3 $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode 5$: RET 10$: .WORD ^M<> ; Entry mask MOVL SCH$GL_CURPCB,R2 ; Address of current process MOVL R3,PCB$L_UIC(R2) ; Set UIC to specified MOVZWL #SS$_NORMAL,R0 ; Normal ending RET ; ; Name: SETUSER.MAR ; ; Type: Integer*4 Function (MACRO) ; ; Author: M. R. London ; ; Date: Jan 26, 1983 ; ; Purpose: To set the Username of the current process (which turns out ; to be the process running this program.) ; ; Usage: ; status = SETUSER(username) ; ; status - $CMKRNL status return. 0 if arguments wrong. ; username - Character string containing username ; ; NOTES: ; Must link with SS:SYS.STB ; .Title SETUSER Set uic .IDENT /830531/ ; ; Libraries: ; .LIBRARY /SYS$LIBRARY:LIB.MLB/ ; ; Global variables: ; $PCBDEF $JIBDEF ; ; local variables: ; .PSECT SETUSER_DATA,NOEXE NEWUSE: .BLKB 12 ; Contains new username OLDUSE: .BLKB 12 ; Contains old username ; ; Executable: ; .PSECT SETUSER_CODE,EXE,NOWRT ; Executable code .ENTRY SETUSER,^M CLRL R0 ; 0 is error code MOVZBL (AP),R8 ; Get number of arguments CMPL R8,#1 ; Correct number of arguments BLSS 5$ ; If not, return MOVZBL @4(AP),R6 ; Get size of string MOVL 4(AP),R7 ; Get address of descriptor MOVL 4(R7),R7 ; Get address of string MOVC5 R6,(R7),#32,#12,NEWUSE ; Get new username string CMPL R8,#2 ; Old username given? BLSS 2$ ; No MOVZBL @8(AP),R6 ; Get size of string MOVL 8(AP),R7 ; Get address of descriptor MOVL 4(R7),R7 ; Get address of string MOVC5 R6,(R7),#32,#12,OLDUSE ; Get old username string $CMKRNL_S ROUTIN=20$ ; Must run in kernel mode TSTL R0 ; If old username is checks with BEQL 2$ ; present process name, change MOVL #2,R0 ; to new username, else flag RET ; error and return 2$: $CMKRNL_S ROUTIN=10$ ; Must run in kernel mode 5$: RET 10$: .WORD ^M<> ; Entry mask MOVL SCH$GL_CURPCB,R7 ; Address of current process MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block ; NOTE: MOVC destroys r0-r5 MOVC3 #12,NEWUSE,JIB$T_USERNAME(R7) ; change username JIB MOVC3 #12,NEWUSE,CTL$T_USERNAME ; change username in P1 MOVZWL #SS$_NORMAL,R0 ; Normal ending RET 20$: .WORD ^M<> ; Entry mask MOVL SCH$GL_CURPCB,R7 ; Address of current process MOVL PCB$L_JIB(R7),R7 ; Address of Job Info Block ; NOTE: MOVC destroys r0-r5 CMPC R6,OLDUSE,JIB$T_USERNAME(R7) ; change username JIB RET ; ; Name: USER_OPEN ; ; Type: Multilple Function (MACRO) ; ; Author: T.W.Fredian ; MIT Plasma Fusion Center ; ; Date: January 26, 1983 ; ; Version: ; ; Purpose: Used to permit qio access to files with fortran. ; Returns channel and file size information and ; provides file truncation capability. Files opened ; with these useopens cannot be accessed using fortran ; reads and writes and the dispose= keyword on the ; close of the file will have no effect. To make the ; logical unit reuseable for normal RMS access you must ; deassign the channel using SYS$DASSGN(%VAL(channel)) ; and then use the close (unit= ) statement. ; ; Types of useropens provided: ; ; USER_OPEN$OLD - open old file ; USER_OPEN$NEW - open new file ; USER_OPEN$TRUNCATE - open old file and truncate it ; to the size specified by the ; INITIALSIZE keyword of the open ; ; To receive the channel, open RMS status and size of the file ; include a common USER_OPEN as follows: ; ; Common /USER_OPEN/ CHANNEL,STATUS,SIZE ; Integer*4 CHANNEL - I/O channel assigned to the file ; Integer*4 STATUS - RMS status return of open ; Integer*4 SIZE - Size of the file opened in blocks ; ; ; Call seqence: NONE - USEROPEN keyword of fortran OPEN statement ; for example: ; ; External USER_OPEN$NEW ; . ; . ; . ; OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW) ; ; ; Description: ; ; Entry mask for USER_OPEN$OLD ; Get the FAB address ; Set the user file open bit ; Open old file ; Save the channel ; Save the size ; Save the status ; Return ; Entry mask for USER_OPEN$NEW ; Get the FAB address ; Set the user file open bit ; Open new file ; Save the channel ; Save the size ; Save the status ; Return ; Entry mask for USER_OPEN$TRUNCATE ; Get the FAB address ; Get the RAB address ; Save the size ; Open old file ; Connect file to record stream ; Load the size of the file in the RAB ; Set the access mode to relative file address ; Find the last record in the file ; Place the end of file marker at this location ; Mark the file to be truncated on close ; Close the file ; Return ; End ; .TITLE USER_OPEN .IDENT /V_830128/ ; ; ; Global variables: ; .PSECT USER_OPEN LONG,PIC,OVR,GBL,SHR,NOEXE CHANNEL: .BLKL 1 ; Channel number STATUS: .BLKL 1 ; Status return of open SIZE: .BLKL 1 ; Size of file ; ; ; Executable: ; .PSECT $CODE LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC .ENTRY USER_OPEN$OLD,^M ; Entry mask for USER_OPEN$OLD MOVL 4(AP),R2 ; Get the FAB address INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bit $OPEN FAB=(R2) ; Open old file MOVL FAB$L_STV(R2),CHANNEL ; Save the channel MOVL FAB$L_ALQ(R2),SIZE ; Save the size MOVL R0,STATUS ; Save the status RET ; Return .ENTRY USER_OPEN$NEW,^M ; Entry mask for USER_OPEN$NEW MOVL 4(AP),R2 ; Get the FAB address INSV #1,#FAB$V_UFO,#1,FAB$L_FOP(R2) ; Set the user file open bit INSV #0,#FAB$V_CBT,#1,FAB$L_FOP(R2) ; Disable contiguous best try $CREATE FAB=(R2) ; Open new file MOVL FAB$L_STV(R2),CHANNEL ; Save the channel MOVL FAB$L_ALQ(R2),SIZE ; Save the size MOVL R0,STATUS ; Save the status RET ; Return .ENTRY USER_OPEN$TRUNCATE,^M ; Entry mask MOVL 4(AP),R2 ; Get the FAB address MOVL 8(AP),R3 ; Get the RAB address MOVL FAB$L_ALQ(R2),R4 ; Save the size INCL R4 ; Increment the size INSV #0,#FAB$V_SQO,#1,FAB$L_FOP(R2) ; Clear the sequential only bit $OPEN FAB=(R2) ; Open old file BLBC R0,CLOSE ; If error branch to close $CONNECT RAB=@8(AP) ; Connect file to record stream BLBC R0,CLOSE ; If error branch to close MOVL R4,RAB$L_RFA0(R3) ; Load size of the file in RAB MOVW #0,RAB$W_RFA4(R3) MOVB #RAB$C_RFA,RAB$B_RAC(R3) ; Set access mode to relative $FIND RAB=(R3) ; Find the last record in file BLBC R0,CLOSE ; If error branch to close $TRUNCATE RAB=(R3) ; Put end of file marker here INSV #1,#FAB$V_TEF,#1,FAB$L_FOP(R2) ; Mark file to be truncated CLOSE: PUSHL R0 ; Save error status $CLOSE FAB=(R2) ; Close the file POPL R0 ; Restore error status MOVL R0,STATUS ; Return the status RET ; Return .END ; End