mirror of
https://github.com/PDP-10/stacken.git
synced 2026-02-28 09:07:42 +00:00
141 lines
3.9 KiB
Plaintext
141 lines
3.9 KiB
Plaintext
|
||
TITLE SCDEXE
|
||
SEARCH MACTEN,UUOSYM,ACTSYM
|
||
|
||
|
||
|
||
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1980,1983,1984,1985,1986.
|
||
;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 WHICH IS NOT SUPPLIED BY DIGITAL.
|
||
;
|
||
; Note: The version for SCDSET is stored here since no facility to
|
||
; set .JBVER exists in FORTRAN.
|
||
|
||
VERSCD==5
|
||
WHOSCD==0
|
||
PATSCD==0
|
||
EDTSCD==22
|
||
|
||
.JBVER==137
|
||
LOC .JBVER
|
||
INTERNAL .JBVER
|
||
BYTE (3)WHOSCD (9)VERSCD (6)PATSCD (18)EDTSCD
|
||
RELOC
|
||
|
||
; THIS PROGRAM EXECUTES THE SCHED. UUO FOR THE ARGUMENTS
|
||
; SET UP IN A, AND ARRAY D. IT ONLY EXECUTES AND RETURNS A VALUE.
|
||
; IT IS INTENDED AS A FORTRAN (4 OR 10) SUBROUTINE THAT EXPECTS
|
||
; NO (REPEAT NO) ARGUMENTS AND TAKES IN COMMON A, B, D.
|
||
;
|
||
; IT SETS B TO THE ERROR CODE OF THE SCHED. UUO IF THE UUO FAILS.
|
||
; B IS SET TO ZERO OTHERWISE.
|
||
|
||
SCHED.=CALLI 150 ;WHEN WILL MACRO EVER KNOW?
|
||
|
||
EXTERNAL .COMM. ;FORTRAN COMMON
|
||
A=.COMM.
|
||
B=.COMM.+1
|
||
D=.COMM.+2
|
||
ENTRY SCDEXE
|
||
|
||
SCDEXE::CAIA ;THIS IS FOR FORTRAN 4-10
|
||
PUSH 17, [EXSCHD] ;SO IS THIS
|
||
SETZM B ;CLEAR B
|
||
PUSH 17, A ;SAVE A FOR FORTRAN CODE
|
||
HRL 0, A
|
||
HRRI 0, D ;GET [ LH(A),, D ] INTO A
|
||
MOVEM 0, A
|
||
HRLI 0, 1 ;GET [1,,A] INTO 0 FOR THE CALL
|
||
HRRI 0, A
|
||
SCHED. ;DO UUO
|
||
MOVEM 0, B ;PUT ERROR CODE IN B
|
||
POP 17, A ;NOW RESTORE A.
|
||
POPJ 17, ;RETURN FORTRAN 10 STYLE
|
||
|
||
|
||
EXSCHD: JRA 16, (16) ;RETURN FORTRAN 4 STYLE
|
||
|
||
; THIS FORTRAN CALLABLE ROUTINE RETURNS IN A THE JOB NUMBER
|
||
; OF THE JOB. THERE ARE NO ERROR RETURNS, OR VALUES EXPECTED.
|
||
|
||
MYJOB:: CAIA ;FORTRAN CALLABLE ROUTINE
|
||
PUSH 17, [EXSCHD] ;TO RETURN CALLER'S JOB #
|
||
PJOB ;DO THE UUO
|
||
MOVEM 0, A ;STORE IN A
|
||
POPJ 17, ;RETURN
|
||
|
||
|
||
|
||
|
||
; THIS ROUTINE IS A GENERAL GETTAB EXECUTER. IT EXPECTS IN A
|
||
; THE VALUE OF THE AC FOR THE GETTAB. IT RETURNS THE ANSWER IN
|
||
; A, AND SETS B TO SOME NON-ZERO VALUE IF THERE IS AN ERROR
|
||
|
||
|
||
TABGET::CAIA ;FOR FORTRAN
|
||
PUSH 17, [EXSCHD]
|
||
SETZM B ;CLEAR ERROR FLAG
|
||
MOVE 0, A ;GET THE ARGUMENT INTO 0
|
||
GETTAB ;DO THE UUO
|
||
SETOM B ;UUO FAILED
|
||
MOVEM 0, A ;STORE THE ANSWER IN A
|
||
POPJ 17, ;RETURN
|
||
|
||
; THIS ROUTINE RETURNS A USER PROFILE IN ARRAY D FOR THE PPN PASSED
|
||
; IN A. SCANAC IN SCDSET.FOR NO LONGER READS ACCT.SYS ITSELF.
|
||
|
||
|
||
PROGET::CAIA ;FOR FORTRAN 4
|
||
PUSH 17,[EXSCHD]
|
||
SETZM B ;CLEAR ERROR FLAG
|
||
PUSH 17,1 ;SAVE AN AC
|
||
MOVEI 0,UGOUP$ ;GET OBTAIN USER PROFILE FUNC
|
||
MOVEM 0,QUEFCN ;STORE IT IN ARG BLOCK
|
||
DMOVE 0,[EXP 1B17!.UGPPN
|
||
EXP A] ;GET PPN ARG HEADER AND DATA
|
||
DMOVEM 0,QUEPPA ;PUT IN ARG BLOCK
|
||
POP 17,1 ;RESTORE AC
|
||
MOVE 0,[XWD <QUEPPN-QUEBLK+1>,QUEBLK] ;GET ARG FOR QUEUE. UUO
|
||
QUEUE. ;DO THE UUO
|
||
SETOM B
|
||
POPJ 17, ;RETURN
|
||
|
||
; THIS ROUTINE DOES A QUEUE. UUO TO TELL THE ACCOUNT DAEMON TO
|
||
; REREAD SYS:SCDMAP.SYS
|
||
|
||
NEWSCD::CAIA
|
||
PUSH 17,[EXSCHD]
|
||
SETZM B ;CLEAR ERROR FLAG
|
||
MOVEI 0,UGSCD$ ;GET REREAD SCDMAP FUNCTION
|
||
MOVEM 0,QUEFCN ;PUT IT QUEUE. UUO ARG BLOCK
|
||
MOVE 0,[XWD <QUEFCN-QUEBLK+1>,QUEBLK] ;GET ARG FOR QUEUE. UUO
|
||
QUEUE. ;DO THE UUO
|
||
SETOM B ;INDICATE ERROR
|
||
POPJ 17,
|
||
|
||
;ARG BLOCK FOR DOING QUEUE. UUOS.
|
||
|
||
QUEBLK: EXP QF.RSP!.QUMAE ;WANT A REPSPONSE, FUNCTION CODE
|
||
0 ;NODE
|
||
XWD .AEMAX,D ;PROFILE SIZE,,WHERE TO PUT IT
|
||
EXP QA.IMM!1B17!.QBAFN ;SUBFUNCTION HEADER
|
||
QUEFCN: 0 ;THE SUBFUNCTION
|
||
QUEPPA: 0 ;PPN ARG BLOCK
|
||
QUEPPN: 0 ;ADDRESS OF PPN WHOSE PROFILE WE WANT
|
||
|
||
LIT
|
||
END
|