Trailing-Edge
-
PDP-10 Archives
-
BB-BT99S-BB_1990
-
10,7/fal/fal.mac
Click 10,7/fal/fal.mac to
see without markup as text/plain
There are 22 other files named fal.mac in the archive. Click here to see a list.
Universal FALUNV - Universal Symbol Definitions for the FAL Modules
Search MACTEN,UUOSYM ; Get the standard symbol definitions
Search SWIL ; Get some SWIL symbols
Search GLXMAC,QSRMAC,ORNMAC ; 'Coupla other nice universals
Search ACTSYM ; Get the accounting system symbols
SALL ; Make the listing look nice
.Directive FLBLST ; very nice
; Version number information:
FALVER==2 ; Major version number
FALMIN==1 ; Minor version number
FALEDT==56 ; Edit number
FALWHO==0 ; Who last patched
%FAL==<BYTE(3)FALWHO(9)FALVER(6)FALMIN(18)FALEDT>
Comment ~
FAL -- File Access Listener
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1987,1988,1990.
ALL RIGHTS RESERVED.
~ ; End Comment
SUBTTL Table of Contents
; Table of Contents for FAL
;
; Section Page
;
;
; 1. Definitions
; 1.1 Assembly Parameters, Channel, Other Random Sym 5
; 1.2 Status Flags, Stream Blocking Bits . . . . . . 6
; 1.3 Macros . . . . . . . . . . . . . . . . . . . . 7
; 1.4 Error Handler Interface . . . . . . . . . . . 8
; 1.5 GLXLIB Symbols . . . . . . . . . . . . . . . . 10
; 1.6 Stream Parameter Area . . . . . . . . . . . . 11
; 2. End of FALUNV . . . . . . . . . . . . . . . . . . . . 12
; 3. Commentary . . . . . . . . . . . . . . . . . . . . . . 14
; 4. Definitions
; 4.1 Local Accumulator Usage . . . . . . . . . . . 15
; 4.2 Macros . . . . . . . . . . . . . . . . . . . . 16
; 5. Storage
; 5.1 Static Impure . . . . . . . . . . . . . . . . 17
; 5.2 Static Pure - IB and HELLO Message Blocks . . 18
; 5.3 Static Pure
; 5.3.1 WTO Response Strings . . . . . . . . . . 19
; 6. Program Startup . . . . . . . . . . . . . . . . . . . 20
; 7. Scheduler
; 7.1 Idle Loop . . . . . . . . . . . . . . . . . . 21
; 7.2 CHKHNG - Check for Hung Streams . . . . . . . 22
; 7.3 CHKTIM - Routine to Check Wakeup Time . . . . 23
; 7.4 DSCHD - Deschedule the Current Stream . . . . 24
; 7.5 CHKQUE - Receive and Schedule an IPCF Message 26
; 7.6 CHKOBJ - Validate the QUASAR/Orion/OPR Message 28
; 7.7 GETBLK - Break an IPCF Message into its Data B 29
; 8. QUASAR Service Routines
; 8.1 ACK - Process an ACK . . . . . . . . . . . . . 30
; 8.2 CONTIN, PAUSE - Continue or Pause a Stream . . 31
; 8.3 DEFINE - Set Object Data . . . . . . . . . . . 32
; 8.4 DSTATUS - Send Status Info . . . . . . . . . . 33
; 8.5 CHKPNT - Checkpoint A Stream . . . . . . . . . 34
; 8.6 KILL - Abort a Connection . . . . . . . . . . 36
; 8.7 SETUP - Handle Stream Setup . . . . . . . . . 37
; 8.8 SHUTDN - Shutdown Processing on a Stream . . . 39
; 8.9 FALEND - Process FAL Stream Termination . . . 40
; 9. FALSWI Service
; 9.1 SETCHN - Inform the World about a New Channel 41
; 10. IPCF Subroutines
; 10.1 FNDOBJ - Find an Object Block in our Data Base 42
; 10.2 RSETUP - Respond to a Setup Message . . . . . 43
; 10.3 SNDQSR - Send a Message to Quasar . . . . . . 44
; 10.4 QSRGON - Flag that QUASAR has Gone Away . . . 45
; 10.5 QSRBAK - Flag QUASAR is Back . . . . . . . . . 46
SUBTTL Table of Contents (page 2)
; Table of Contents for FAL
;
; Section Page
;
;
; 11. PSI Routines
; 11.1 INTINI - Initialize the PSI System . . . . . . 47
; 11.2 INDCON - Connect a Disk Channel to the Interru 48
; 11.3 INDDIS - Disconnect a Disk Channel from the In 49
; 11.4 INTCON - Connect a Stream to the Interrupt Sys 50
; 11.5 INTDIS - Disconnect a Stream from the Interrup 51
; 11.6 INTCNA, INTDNA - Connect an ANF-10 Channel to 52
; 11.7 INTCND - Connect a DECnet Channel to the Inter 53
; 11.8 ANFINT - ANF-10 Interrupt Service . . . . . . 54
; 11.9 DECINT - DECnet Interrupt Service . . . . . . 55
; 11.10 DSKINT - Disk Interrupt Service . . . . . . . 57
; 11.11 IPCINT - IPCF Message Available Interrupt Serv 58
; 12. SWIL Memory Manager
; 12.1 .MMGWD - Get some Words of Memory . . . . . . 59
; 12.2 .MMFWD - Deallocate a Chunk of Memory . . . . 60
; 13. Operator Messages
; 13.1 BEGJOB - Begin a FAL Job . . . . . . . . . . . 61
; 13.2 ENDJOB - End a FAL Job . . . . . . . . . . . . 62
; 13.3 ERRMSG - STOPCD/ERROR/WARN/INFRM Processor . . 63
; 13.4 FRCCHK - Force a Checkpoint . . . . . . . . . 65
; 13.5 NETERR - Report a Network Lossage Error . . . 66
; 13.6 .STOPCD - Abort a Stream . . . . . . . . . . . 67
; 14. Dummy SWIL Routines
; 14.1 .ASKYN, .ASKNY . . . . . . . . . . . . . . . . 68
; 15. End of FALQSR . . . . . . . . . . . . . . . . . . . . 69
; 16. Definitions
; 16.1 Accumulator Usage . . . . . . . . . . . . . . 71
; 17. FAL initialization
; 17.1 FALINI set FAL job parameters . . . . . . . . 73
; 17.2 UTXINI initialize USERS.TXT buffer . . . . . . 75
; 18. Main FAL processing loop . . . . . . . . . . . . . . . 79
; 19. FAL "JOB" process . . . . . . . . . . . . . . . . . . 81
; 20. File read access . . . . . . . . . . . . . . . . . . . 91
; 20.1 Subroutines - RENAME option . . . . . . . . . 100
; 21. File write access . . . . . . . . . . . . . . . . . . 101
; 22. File rename access . . . . . . . . . . . . . . . . . . 113
; 23. File delete access . . . . . . . . . . . . . . . . . . 115
; 24. File directory-list access . . . . . . . . . . . . . . 116
; 25. File (BATCH) submission access . . . . . . . . . . . . 117
; 26. General-purpose file-level subroutines . . . . . . . . 118
; 27. General-purpose non-specific subroutines . . . . . . . 137
; 28. FALGLX Interface Routines . . . . . . . . . . . . . . 147
; 29. CDB initialization vectors . . . . . . . . . . . . . . 151
; 30. SWIL Argument Blocks . . . . . . . . . . . . . . . . . 152
; 31. Impure data . . . . . . . . . . . . . . . . . . . . . 153
Subttl Revision History
;INITIAL VERSION CREATED FROM NIK 25-MAR-80
;6 RDH 18-Mar-84
; Fix typo that broke RSX/RSTS/VAX non-wildcarded directory; Do not
; generate a FOP field (at FFAD28), just "echo" back whatever the
; remote has sent (keeps RSTS happy, probably the right thing to do
; anyway).
;11 RDH 16-Jul-84
; Send ACK between each file for DIRECTORY LIST if talking to
; a DAP protocol version 7 (or later) accessor.
;12 RDH 29-Nov-84
; A zero-length USERS.TXT file causes UTXINI to do a "random"
; core allocation, typically resulting in ?PC out of bounds
; (by deallocating part of the hi seg).
;13 DRB 13-Dec-84
; Add multistream operation to allow a single copy of FAL to provide
; multiple FAL server connections. This edit makes the following
; major changes:
; 1) Add multithreaded support. Make all network I/O non-
; blocking and add a scheduler.
; 2) Add a QUASAR/ORION interface to allow control of FAL
; via OPR.
; 3) Remove from the NFT/NIP/TSC utility and make FAL a
; standalone module.
; 4) Remove the command interface, which is replaced by (2)
; above.
; 5) Add a GLXLIB interface so that we don't have to reinvent
; the wheel when we're talking with QUASAR.
; The last point above implies that FAL will now be dealing with both
; GLXLIB and SWIL. In order to keep conflicts to a minimum, this edit
; will also split FAL into two code modules: one which contains the
; scheduler and GLXLIB interface, the other contains the mainline FAL
; code and SWIL interface.
;14 DRB 29-Jan-85
; Release any I/O channels if a connection is aborted.
;15 DRB 31-Jan-85
; Clean up the file write error code if we get an input error from the
; network. This is probably due to the other end going away, and is
; nothing to get riled up about.
;16 DRB 05-Feb-85
; Make sure the "file open" status bit always gets cleared before we
; call ENDJOB so that we don't send bogus status updates to QUASAR.
;17 DRB 07-Feb-85
; Clear all related blocking and wake bits when disabling interrupts for
; network or disk.
;20 DRB 14-Feb-85
; FILIFF (called by the ERROR macro handler) is observing the register
; preservation conventions. Make it do so.
;21 DRB 14-Feb-85
; Remove lots of error and/or warning messages that get sent to OPR due
; to user command error (from NFT). Change lots of spurious STOPCDs to
; non-fatal errors or warnings. Change other error/warning messages to
; DEBUG messages which only get typed if FTDEBUG is on.
;22 DRB 25-Mar-85
; Re-implement the rejection list and add code to receive both the
; rejection list and network ppn via the new .QOODB QUASAR message.
;23 DRB 16-Apr-85
; Don't crash when/if QUASAR goes away or restarts. If C%SEND returns an
; error, just mark all current streams as potentially killable when
; QUASAR restarts, and corrupt all their object blocks so that any new
; streams started by a new QUASAR won't look like any of the old ones.
; Keep trying to retransmit HELLO messages to QUASAR until it looks up
; again. If we successfully receive or transmit a message to QUASAR,
; mark all the old streams for shutdown, since the new QUASAR is probably
; going to tell us to start some new streams. Note that this leaves two
; holes: First, if QUASAR is stopped and restarted with the same PID,
; and we don't try to send anything while he's out, we'll never know that
; he was gone. The new guy won't know who we are, and this whole edit is
; for naught. Perhaps we should watch for NAKs, and assume that QUASAR
; is gone and back. Second, if we were running more than 1/2 NFAL
; streams at the time of failure, and the new QUASAR attempts to start
; more than 1/2 NFAL new streams, we're probably going to fail in some
; random fashion. We really ought to keep a queue of streams to be
; started if no slots are available.
;24 DRB 17-Apr-85
; Prevent ILM crashes if we receive a shutdown for a stream we don't
; have.
;25 DRB 18-Apr-85
; Pay attention to received NAKs from QUASAR.
;26 DRB 11-Jul-85 QAR 868149
; Don't allow setups from remote operators. This can be detected by
; comparing the node number in the setup object block with that stored
; by SWIL in .MYNNM.
;27 DRB 23-Jul-85
; Don't allow the job to go virtual until some monitor bugs get fixed.
;30 LEO 15-AUG-85
; DO COPYRIGHTS.
;31 DRB 16-Oct-85
; Always get the user's profile when starting a new DAP access. Use
; this profile to find the user's name. Convert the eight bit username
; to SIXBIT, and supply it for spooled file prints. Additionally, pay
; attention to the bit in the user's profile which enables network file
; access, and refuse any connection (with invalid user/password error)
; which attempts to reference a userid that doesn't have this set
; in the profile.
;32 DRB 30-Oct-85
; Edit 31 correctly gets the user's name from the user profile and stores
; it in .IOQ6N. Unfortunately, SWIQUE stomps on .IOQ6N later when it
; tries to validate the username/password. Save .IOQ6N around the call
; to QUEOP1 until SWIQUE gets fixed such as to not put garbage into
; these two words. Also, output more descriptive error messages to
; the operator than "invalid PPN/Password" if the connection is rejected
; due to the operator's rejection list or if the user doesn't have
; network file access privileges.
;33 DRB 19-Nov-85
; Update for new ACTSYM symbols.
;34 DRB 20-Nov-85
; New ACTDAE uses 8 bit ASCII passwords in SIXBIT, so do the same here.
;35 DRB 22-Nov-85
; Fix the I/O abort code such that channels really do get released when
; the network link is aborted. This requires edit 1025 to SWIL.
;36 DRB 02-Dec-85
; If a stream gets going reading or writing a file at full speed, it may
; never deschedule, especially on heavily loaded systems. This somewhat
; defeats the multithreaded idea. Add fairness counts to the file read
; and write loops. Also, fix a typo in the write record loop.
;37 DRB 26-Dec-85
; Another iteration on aborting I/O, due to edit 1026 of SWIL. With any
; luck, this is the last time around on this one.
;40 RDH 4-Jan-86 SPR 10-35424
; Can't transfer LSN-formatted ASCII.
;41 DRB 16-Jan-86
; Non-blocking disk I/O misses interrupts, because we're too smart about
; when we enable the PSI system. Quit being so "smart".
;42 DRB 22-Jan-86
; Pre-zero the password block so we don't get confused over old fragments
; laying around from prior connections.
;43 BSC 25-Mar-86
; Modify the BADDAP Macro to return a STATUS message to remote task when
; a DAP error occurs.
;44 BSC 8-Apr-86
; Let SHR flags in an ACCESS message include the flag for
; "No access by other users". DECnet/E DAP version 5.6 sets this.
;45 TL 4-Dec-86
; Use edit 1047 of SWILIO to correctly transfer implied-CRLF files
; with imbedded non-trailing carriage control (such as MACRO-32's
; listing files). See edit 1047 in SWIL for more details.
;46 RCB 5-Dec-86
; Change to use the new STOPCD macro rather than the old $STOP.
; This only words because FALGLX searches GLXMAC before FALUNV, and
; the FAL module doesn't search GLXMAC at all. Keep it this way.
;47 KDO 13-Aug-87
; Allow a Configuration message at the start of a new access.
;50 KDO 18-Aug-87
; Fix the SCAN (SWIL) intercept routine.
;51 JJF/KDO 21-Nov-88
; If we are talking to a VAX/VMS system, convert all commas in
; directory spec to dots, as VMS RMS fails to conform
; to the DAP spec. This new behavior is controlled by the FTDOT
; feature-test switch, which is on by default.
; SPR:10-36163
;52 JJF 21-Dec-88
; FAL is far too paranoid about the incoming data type bits that
; are lit. Once we've determined ASCII or BINARY data types, the
; rest of the bits don't matter (as far as accepting or rejecting
; the connection), so don't test them. Makes transfers with RSTS
; systems work (since they like to send files with both ASCII
; and EXECUTABLE attributes).
; SPR: 10-35591
;53 JJF 9-Jan-89
; Make remote directory specs work better. If we're doing remote
; directory parsing, after looking at the whole name, check the file
; name and extension. If either is null (the case from some remote
; nodes, such as RSTS), change them to * (full wildcard), and light
; appropriate wildcard bits and set appropriate masks.
; SPR: 10-35591
;54 JJF 11-Apr-89
; Add support for appending to local files. If a CONTROL(CONNECT)
; message comes in that has the 'position-to-EOF' bit lit in the
; Record Operations Menu, then light the IO.APP flag and do
; some setup work, then jump into the file-writing routines.
; SPR: 10-36155
;55 RCB 30-Nov-89
; Fix priv handling for administrative privs with the QUEUE. UUOs to
; talk to ACTDAE.
; Also requires an edit to SWIL.
; No SPR
;56 LWS 3-Dec-89
; Edit 26 doesn't work when there's no ANF support in monitor. If
; .MYNNM is zero, there can't be a remote operator.
; No SPR
Subttl Definitions -- Assembly Parameters, Channel, Other Random Symbols
; Feature tests
ND FTUTXT,0 ; Default exclude support for USERS.TXT
ND FTDEBUG,-1 ; Default to debugging features
ND FTDOT,-1 ; Convert comma-separated directories to
; dot-separated, but ONLY if the remote
; system is VAX/VMS
; Other assembly parameters:
ND $NTPPN,<377777,,377777> ; Default access PPn
ND NFAL,^D30 ; Maximum number of concurrent streams
ND NANF10,^D15 ; Maximum number of ANF-10 streams
ND PDSIZE,200 ; Size of push down list
ND CHKPTIM,^D30 ; Default time between checkpoints
ND CHKMIN,^D10 ; Minimum number of seconds between checkpoints
ND HNGTIM,^D60*3 ; Time (seconds) before I/O is considered hung
ND QSRTRY,^D60*3 ;[23] Hello retry interval when QUASAR down
ND DIRCNT,^D10 ; Number of files to list before blocking (directory)
ND PSWDLN,^D39 ; Maximum number of characters in a password
PSWDWD==<PSWDLN+3>/4 ;[34] Number of words in password string
ND ARSPLN,.AEACC+1 ;[33] Length of the ACTDAE response buffer
ND CHARFC,10000 ;[36] Maximum chars copied before deschedule
ND RECFC,100 ;[36] Maximum records copied before deschedule
; I/O channels internally dedicated
UTX==10 ; For reading USERS.TXT
; Constant parameters:
XP MSBSIZ,<FAL.ST+<^D60/5>>; The size of a message block
XP .PSLEN,.PSVIS+1 ; Length of a PSI block
; Some stream abort reasons:
$FSNNS==1 ; No network software
$FSISP==2 ; Insufficient privileges
$FSNRM==3 ;[26] Can't start remote FAL streams
; Some message type symbols:
.ETINF==0 ; Informational message
.ETBEG==1 ; Beginning of session message
.ETEND==2 ; End of session message
.ETREJ==3 ; Connection rejected
.ETWRN==4 ; Warning message
.ETERR==5 ; Error message
.ETSTP==6 ; Stream STOPCD
.ETPRO==7 ;[21] Protocol error message
.ETMAX==.ETPRO ;[21] Maximum message type value
IFN FTDEBUG,<
.ETDBG==10 ;[21] Debug error message
.ETMAX==.ETDBG ;[21] Redefine the maximum message type >
Subttl Definitions -- Status Flags, Stream Blocking Bits
; Some status flags we'll find in S:
S.RUN==1B0 ; The FAL stream has been started
S.OPEN==1B1 ; A connection is active for this stream
S.PSIN==1B2 ; Network interrupts have been enabled
S.PSID==1B3 ; Disk interrupts have been enabled
S.SHUT==1B4 ; Shut this stream down
S.KILL==1B5 ; Abort the current connection
S.NPPN==1B6 ; Connection is using NETPPN
S.CONN==1B7 ; Connection accepted, waiting for link to start
S.QSRD==1B8 ;[23] QUASAR has gone away
S.PROF==1B9 ;[31] We have the user's profile
S.CLR==S.OPEN!S.PSIN!S.PSID!S.KILL!S.NPPN!S.CONN!S.PROF ; Flags to clear between connections
; Stream blocking status bits:
PSF%NI==1B0 ; Stream is blocked waiting for network input
PSF%NO==1B1 ; Stream is blocked waiting for network output
PSF%SL==1B2 ; Sleeping
PSF%ST==1B3 ; Stopped by the operator
PSF%CW==1B4 ; Waiting for network connection
PSF%DI==1B5 ; Stream is blocked waiting for local input
PSF%DO==1B6 ; Stream is blocked waiting for local output
PSF%DF==1B7 ; Stream is blocked because disk is offline
PSF%CR==1B8 ; Stream has crashed
PSF%IO==PSF%NI!PSF%NO!PSF%DI!PSF%DO ; Stream is blocked for some kind of I/O
Subttl Definitions -- Macros
; Define a macro to allocate storage on the per stream process pages.
; This macro was copied from LPTSPL.MAC
DEFINE LP(SYM,VAL),<
IF1,<
XLIST
IFNDEF J...X,<J...X=0>
IFDEF SYM,<PRINTX ? Parameter SYM used twice>
SYM==J...X
J...X==J...X+VAL
LIST
SALL
> ;; End IF1
IF2,<
.XCREF
J...X==SYM
.CREF
SYM==J...X
> ;; End IF2
> ; End DEFINE LP
; A macro to pull a symbol from a universal file that we've searched
DEFINE GS (SYM),<
.XCREF
...FOO==SYM
.CREF >
Subttl Definitions -- Error Handler Interface
; The following definitions are to provide the SWIL context routines
; a mechanism for accessing the Orion WTO facility.
; A macro to kill of a stream, with optional $WTO text:
DEFINE STOPCD (TXT,RTN,ADR,DIE<.STOPCD##>),<
IFB <TXT>,JRST DIE ;; If no text, just kill off the stream
IFNB <TXT>,<
PUSHJ P,@[Z ERRMSG## ;; Got some text - type it
XWD .ETSTP,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to go die > >
; A macro to complain about protocol errors
DEFINE BADDAP (MAC<0>,MIC,TXT,DIE<.POPJ##>),<
PUSHJ P,@[EXP DAPERR## ;; Address of DAP status sender
IFB <MIC>,<EXP MAC> ;; DAP status for MA.SYN
IFNB <MIC>,<EXP MAC!<$DH'MIC_6>> ;; DAP status otherwise
EXP [ASCIZ ~TXT~];; Text to type out
EXP DIE] ;; A place to go when we're done >
; A macro to type an error message:
DEFINE ERROR (PFX,TXT,RTN<0>,ADR<0>,DIE<.POPJ##>),<
E..'PFX:!PUSHJ P,@[Z ERRMSG## ;; Address of text typer
XWD .ETERR,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to go when we're done >
; A macro to say we're rejecting a connection:
DEFINE REJECT (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
R..'PFX:!PUSHJ P,@[Z ERRMSG## ;; Address of text typer
XWD .ETREJ,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to go when we're done >
; A macro to type warning messages:
DEFINE WARN (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
W..'PFX:!PUSHJ P,@[Z ERRMSG## ;; Address of text typer
XWD .ETWRN,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to go on return >
; One more time, for information messages:
DEFINE INFRM (PFX,TXT,RTN<0>,ADR<0>,DIE<.+1>),<
I..'PFX:!PUSHJ P,@[Z ERRMSG## ;; Address of text typer
XWD .ETINF,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to return to >
; Last one is for DEBUG only errors:
IFE FTDEBUG,<DEFINE DEBUG (TXT,RTN,ADR,DIE<.+1>),<JRST DIE> >
IFN FTDEBUG,<
DEFINE DEBUG (TXT,RTN<0>,ADR<0>,DIE<.+1>),<
PUSHJ P,@[Z ERRMSG## ;; Address of text typer
XWD .ETDBG,[ASCIZ ~TXT~]
Z RTN ;; Optional typeout routine
Z ADR ;; Optional data for typeout routine
Z DIE] ;; A place to return to > >
; Definitions of MACCODE field values to use when invoking BADDAP macro.
MA.PND==0B23 ; Operation in progress
MA.SUC==1B23 ; Successful result
MA.UNS==2B23 ; Unsupported DAP request
MA.RES==3B23 ; Reserved
MA.FOP==4B23 ; Error occurred before file opened
MA.TER==5B23 ; Transfer error i.e. I/O error on a file
MA.TWN==6B23 ; Transfer warning i.e. operation completed abnormally
MA.ACT==7B23 ; Access termination error on a file
MA.FMT==10B23 ; Format error parsing message
MA.INV==11B23 ; Invalid field in message
MA.SYN==12B23 ; Synchronization error i.e. DAP message out of order
Subttl Definitions -- GLXLIB Symbols
; Pull some symbols out of GLXLIB so that the SWIL half of FAL doesn't
; have to search any QUASAR/GLXLIB related universals to mess with these
; symbols.
; Symbols in a file descriptor block:
GS .FDLEN ; Length and type word
GS FD.LEN ; Mask to length field
GS FD.TYP ; Mask to type field
GS .FDLEN ; Length of the FD
GS .FDFIL ; Pointer to first word in file descriptor
GS .FDSTR ; Structure name
GS .FDNAM ; File name
GS .FDEXT ; Extension
GS .FDPPN ; Project programmer number
GS .FDPAT ; Remaining path (SFDs)
GS FDXSIZ ; Maximum length of an FD
; Some symbols from SWIL for FALGLX
GS IO.DCN ; DECnet network type
GS IO.ANF ; ANF-10 network type
GS JWW.FL ; Watch bits for "first" in error processing
; Some symbols for reading the rejection list:
RJ.NOD==REJ.ND-ARG.DA ;[22] Rejected node name
;RJ.NDM==REJ.NM-ARG.DA ;[22] Rejected node name mask
RJ.PPN==REJ.PP-ARG.DA ;[22] Rejected PPN
RJ.PPM==REJ.MK-ARG.DA ;[22] Rejected PPN mask
RJ.MAX==REJ.SZ-ARG.DA ;[22] Length of the rejection sub block
Subttl Definitions -- Stream Parameter Area
; Define the storage on the per stream pages:
LP J$$BEG,0 ; Beginning of the parameter area
; Storage required by the scheduler:
LP J$RPDL,PDSIZE ; The context pushdown list
LP J$RACS,20 ; The saved context ACs
LP J$RTIM,1 ; Time that the current request started
; Parameter storage for the FAL process:
LP J$FTYP,1 ; FAL stream type (ANF-10 or DECnet)
LP J$FSLP,1 ; Sleep time after FAL disconnect
LP J$DOFF,1 ; Old PC when disk offline
; Record management:
LP J$RALC,2 ; Allocation pointer to record buffer
LP J$RLEN,1 ; Record length (Input Service Routine call)
LP J$RBUF,1 ; Record buffer (Input Service Routine call)
; Stream status storage:
LP J$STFD,FDXSIZ ; File descriptor of current file being accessed
LP J$SNOD,1 ; Node that this stream is connected to
LP J$SACC,1 ; File access type
LP J$SBYT,1 ; Number of bytes transfered
LP J$SUSR,^D8 ; Username of accessor
LP J$SPSW,PSWDWD ; Password string (8 bit ASCIZ)
LP J$SACT,^D8 ; Account string of access
; Storage for SWIL interface:
LP J$SMSG,^D100 ; Area to build error message strings
LP J$SWLD,1 ; Pointer to WILD's storage
LP J$SERP,1 ;[50] Saved PDL pointer
LP J$SERT,1 ;[50] Error routine
; Storage for talking to the accounting daemon
LP J$ABLK,20 ; ACTDAE QUEUE. UUO argument block
LP J$AUSR,^D10 ; A copy of the 8 bit username
LP J$ARSP,ARSPLN ; A buffer for ACTDAE's response
; Other misc variables:
LP J$DCNT,1 ; Number of directory files before blocking
LP J$LCHK,1 ; Time of last checkpoint/status update
LP J$SFC,1 ;[36] Fairness count for reading/writing files
LP J$$END,0 ; Size of the per stream area
Subttl End of FALUNV
PRGEND
Title FALGLX -- GLXLIB Interface and Scheduler for FAL
Search JOBDAT ; Get the job data symbols
Search GLXMAC ; Get the GLXLIB parameters
PROLOG (FAL) ; Do the standard GLXLIB setup
Search QSRMAC ; Get QUASAR symbols
Search ORNMAC ; and the OPR/ORION parmeters
Search FALUNV ; Get our symbols
Search SWIL ; And finally, SWIL
SALL ; Make the listing look nice
.Directive FLBLST ; etc...
; Stuff the version number in .JBVER:
LOC .JBVER
EXP %FAL
RELOC 0 ; Normal relocation
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1990. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
Comment ~
FAL -- File Access Listener
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1988,1990.
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 OR 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.
~
Subttl Commentary
Comment ~
Herein lies FAL's interface to GLXLIB and the stream scheduler. These
functions have been taken out of the main FAL module so that the GLXLIB
interface does not interfere with the SWIL interface in the main line
code. Thus, this module will interface the SWIL environment routines to
GLXLIB, performing any calling and AC convention translation. Since
GLXLIB and SWIL use different AC definitions, AC usage will probably be
the largest potential source of problems. The following is a map of AC
usage of both the subroutine libraries:
AC GLXLIB SWIL
0 TF M0
1 S1 T1
2 S2 T2
3 T1 T3
4 T2 T4
5 T3 P1
6 T4 P2
7 P1 P3
10 P2 P4
11 P3 IO
12 P4/M ID
13 CI
14 CO
15 J J
16 S S
17 P P
The most notable fallout of this is that GLXLIB's T3 and T4 map
to SWIL's P1 and P2. Thus, we must save SWIL's P1/2 so that they are
not destroyed by calls to FALGLX which may assume that these are
temporary registers.
NOTE WELL:
Calls to .SAVE1, .SAVE2, .SAVE3, .SAVE4 or $SAVE (P1), $SAVE(P1,P2),
$SAVE (P1,P2,P3) and $SAVE (P1,P2,P3,P4) will result in SWIL's .SAVEn routine
being called and NOT GLXLIB's. These routines will save FALGLX's T3, T4, P1
and P2. In general, don't try these routines from FALGLX.
~ ; End Comment
Subttl Definitions -- Local Accumulator Usage
; Despite the fact the the GLXLIB universals should have already defined
; these for us, we're going to go redefine them ourselves, just to avoid
; any confusion:
TF==0 ; Returned True/False status
S1==1 ; Argument register
S2==2 ; other argument register
T1==3 ; Temporaries
T2==4
T3==5
T4==6
P1==7 ; Preserved registers
P2==10
P3==11
P4==12
M==12 ; Current message pointer (overlaps P4)
J==15 ; Job context pointer
S==16 ; Current stream status
P==17 ; Stack pointer
Subttl Definitions -- Macros
; Define a macro to build an interrupt service routine header for ANF-10
; interrupts.
DEFINE ANFINH(Z),<
XLIST
$BGINT 1, ;; Normal interrupt service routine entry
MOVEI S1,Z ;; Get the stream number
MOVEI S2,ANFVEC+<.PSLEN*Z> ;; Point to the PSI block
JRST ANFINT ;; Continue in main line code
ANHDSZ==4 ;; Length of this header
LIST > ; End define ANFINH
; Another one, but this time for disk interrupts:
DEFINE DSKINH(Z),<
XLIST
$BGINT 1, ;; Normal interrupt service routine entry
MOVEI S1,Z ;; Get the stream number
MOVEI S2,DSKVEC+<.PSLEN*Z> ;; Point to the PSI block
JRST DSKINT ;; Continue in main line code
DSHDSZ==4 ;; Length of this header
LIST >
Subttl Storage -- Static Impure
; Some impure storage
PDL: BLOCK PDSIZE ; The stack
BZER==. ; Start of memory to zero on startup
QSRDIE: BLOCK 1 ;[23] Non-zero if QUASAR is dead
MESSAG: BLOCK 1 ; Address of the message just received
IMESS: BLOCK 1 ; IPCF message: -1 means something to be released
BLKADR: BLOCK 1 ; IPCF message block address save area
SAB: BLOCK SAB.SZ ; Send argument block
MSGBLK: BLOCK MSBSIZ ; A block to build message into
RUTINE: BLOCK 1 ; IPCF message dispatch
TEXTCT: BLOCK 1 ;[21] Number of chars remaining in TEXTBP
TEXTBP: BLOCK 1 ; A byte pointer for DEPBP
SCHEDL: BLOCK 1 ; Stream scheduling counter
SLEEPT: BLOCK 1 ; Sleep interval
FALBTS: BLOCK 1 ; Non-zero if status wants to be stored to saved register block
; The resident stream database:
STREAM: BLOCK 1 ; The current stream number
FALACT: BLOCK NFAL ; -1 if stream is active, 0 otherwise
FALPAG: BLOCK NFAL ; Address of the FAL stream data
FALOBA: BLOCK NFAL ; Table of object block addresses
FALOBJ: BLOCK OBJ.SZ*NFAL ; Table of object blocks
FALWKT: BLOCK NFAL ; Stream's wakeup time
FALSTW: BLOCK NFAL ; Stream status word
FALWAK: BLOCK NFAL ; Reasons why a stream should wake up.
; Parallel to FALSTW (prevents races)
IFN FTDEBUG,<
FALBLK: BLOCK NFAL ; UDT when stream blocked for I/O >
FALCHK: BLOCK NFAL ; Stream checkpoint indicator
; contains the time for the next checkpoint
FALCHN: BLOCK NFAL ; FAL stream's channel number
FC%ANF==1B0 ; Channel is ANF-10 (not DECnet)
FALDSK: BLOCK NFAL ; FAL stream's disk channel number
; Interrupt system storage:
PSIVEC: BLOCK 0 ; Start of the interrupt system storage
IPCVEC: BLOCK .PSLEN ; IPCF interrupt block
DECVEC: BLOCK .PSLEN ; DECnet interrupt block
ANFVEC: BLOCK .PSLEN*NANF10 ; ANF-10 interrupt blocks
DSKVEC: BLOCK .PSLEN*NFAL ; Disk interrupt blocks
EZER==.-1 ; End of memory to zero on startup
Subttl Storage -- Static Pure - IB and HELLO Message Blocks
; Setup the interrupt system block ala GLXLIB:
IB: $BUILD IB.SZ
$SET (IB.PRG,,%%.MOD) ; Setup the program name
$SET (IB.INT,,PSIVEC) ; Setup the interrupt vector address
$SET (IB.PIB,,PIB) ; Setup the PIB address
$SET (IB.FLG,IP.STP,1) ; Stopcodes to Orion
$SET (IB.FLG,IB.NPF,1) ;[27] Don't enable the page fault handler
$EOB
; The PIB:
PIB: $BUILD PB.MNS
$SET (PB.HDR,PB.LEN,PB.MNS) ; PIB length,,0
$SET (PB.FLG,IP.PSI,1) ; PSI on
$SET (PB.INT,IP.CHN,0) ; Interrupt channel
$EOB
; The hello message we send to QUASAR on startup:
HELLO: $BUILD HEL.SZ
$SET (.MSTYP,MS.TYP,.QOHEL) ; Message type (Hello again)
$SET (.MSTYP,MS.CNT,HEL.SZ) ; Message length
$SET (HEL.NM,,<'FAL '>) ; Program name
$SET (HEL.FL,HEFVER,%%.QSR) ; QUASAR version number
$SET (HEL.NO,HENNOT,1) ; Number of object types (1)
$SET (HEL.NO,HENMAX,NFAL) ; Maximum number of streams
$SET (HEL.OB,,.OTFAL) ; FAL's object type
$EOB
; A dummy object block for stray $WTOs
DUMOBJ: $BUILD OBJ.SZ
$SET (OBJ.TY,,.OTFAL) ;[23] Our object type
$SET (OBJ.UN,OU.LRG,0) ;[23] The unit number (zero)
$SET (OBJ.ND,,0) ;[23] The node name/number
$EOB
Subttl Storage -- Static Pure -- WTO Response Strings
; Table of abort messages:
SETMSG: [ASCIZ ~Shutdown by operator~]
[ASCIZ ~No network software~]
[ASCIZ ~Insufficient privileges~]
[ASCIZ ~Cannot start remote FAL streams~]
[ASCIZ ~Shutdown~]
; Table of file access strings indexed by function code (from J$SACC)
CHKFNC: [ASCIZ ~(unknown function)~] ; 0 - Not known
[ASCIZ ~Reading~] ; 1 - Read file
[ASCIZ ~Writing~] ; 2 - Write file
[ASCIZ ~Rename~] ; 3 - Rename file
[ASCIZ ~Delete~] ; 4 - Delete file
[ASCIZ ~(illegal function)~] ; 5 - ???
[ASCIZ ~Directory of~] ; 6 - Directory of files
[ASCIZ ~Submit~] ; 7 - Submit file
[ASCIZ ~Execute~] ; 10 - Execute file
CHKFLN==.-CHKFNC ; Highest function code we know about
Subttl Program Startup
FAL:: JFCL ; Avoid CCL entry
RESET ; As usual
MOVE P,[IOWD PDSIZE,PDL] ; Setup the stack pointer
SETZM BZER ; Clear a word of storage
MOVE S1,[BZER,,BZER+1] ; Make a pointer to get the rest
BLT S1,EZER ; Clear all our impure storage
MOVEI S1,IB.SZ ; Get the IB size
MOVEI S2,IB ; Point to the IB
PUSHJ P,I%INIT ; Initialize the world
PUSHJ P,FALINI## ; Initialize the SWIL side of the world
PUSHJ P,INTINI ; Initialize the interrupt system
PUSHJ P,I%ION ; Turn the interrupt system on
MOVEI T1,HELLO ; Point to the hello message
PUSHJ P,SNDQSR ; Tell QUASAR we're here
MOVSI P1,-NFAL ; Setup the stream counter
; Fall into the scheduler loop
Subttl Scheduler -- Idle Loop
; Here is the stream scheduler. We loop over each stream, running it
; if possible, then check for any pending IPCF messages to process.
; This code borrowed from LPTSPL.MAC
MAIN: SKIPN FALACT(P1) ; Is this stream active?
JRST MAIN.2 ; No, skip it
HRRZM P1,STREAM ; Yes, store as the current stream number
MOVE J,FALPAG(P1) ; Get the context storage page
PUSHJ P,CHKTIM ; Adjust the sleep time if needed
PUSHJ P,DSTATUS ; Do any status stuff
SKIPE FALSTW(P1) ; Is this stream blocked?
JRST MAIN.2 ; Yes, go on to the next stream
SETZM FALWAK(P1) ; If we're awake, no reason to wake us
MOVEM P1,SCHEDL ; No, store the scheduling counter
HRLZ T1,J$SWLD(J) ; * Hack * Point at the saved WILD data
HRRI T1,.WILDZ## ; * Hack * Point to where it goes
BLT T1,.WILDZ##+.WILDL##-1 ; Move WILD's data back
MOVSI 0,J$RACS+1(J) ; Setup the source address for the BLT
HRRI 0,1 ; Get the destination address
BLT 0,17 ; Restore the stream ACs
POPJ P, ; And return to the stream context
; Here when the stream blocks again
MAIN.1: MOVE P1,SCHEDL ; Restore the scheduler counter
PUSHJ P,DSTATUS ; Do the status thing again
PUSHJ P,CHKTIM ; Reset the wakeup timer
; Here to schedule the next stream
MAIN.2: AOBJN P1,MAIN ; Loop back for the next stream number
PUSHJ P,CHKQUE ; Check for incoming IPCF messages
SKIPN QSRDIE ;[23] Is QUASAR dead?
JRST MAIN.3 ;[23] No, don't send any hellos then
MOVEI T1,HELLO ;[23] Yes, try to send
PUSHJ P,SNDQSR ;[23] a HELLO message
SKIPN QSRDIE ;[23] We tried. Did we succeed?
JRST MAIN.4 ;[23] Yes. Everything probably just woke up
SKIPE S1,SLEEPT ;[23] No. Get the sleep interval
JRST MAIN.3 ;[23] None, don't sleep then
SKIPG S1 ;[23] Is there really one?
MOVX S1,QSRTRY ;[23] No, set our default interval
MOVEM S1,SLEEPT ;[23] Store the new sleep interval
MAIN.3: SKIPE MESSAGE ; Did we process a message?
JRST MAIN.4 ; Yes, don't sleep then
IFN FTDEBUG,<
PUSHJ P,CHKHNG ; See if anyone's hung
JRST MAIN.4 ; Yup. Try to run him again >
MOVE S1,SLEEPT ; No, get the sleep time
JUMPE S1,MAIN.4 ; Don't sleep if no sleep time specified
SKIPG S1 ; Positive value, or default?
IFE FTDEBUG,SETZ S1, ; Default, set infinite sleep time
IFN FTDEBUG,MOVEI S1,HNGTIM*3 ; (Unless debugging)
PUSHJ P,I%SLP ; Go wait
; Here if message have been processed. Restart the scheduler
MAIN.4: MOVE P,[IOWD PDSIZE,PDL] ; Reset the stack pointer
SETOM SLEEPT ; Reset the sleep timer
MOVSI P1,-NFAL ; Reset the loop counter
JRST MAIN ; And restart the scan
Subttl Scheduler -- CHKHNG - Check for Hung Streams
; Here if we just completed a scan of all streams and found nothing
; to run and no IPCF messages to play with. This routine is called under
; the debug conditional to see if there are any streams that have been
; blocked for I/O for an undue length of time. If we find such a stream,
; we'll send a warning to the operator, and clear the I/O wait bits, to
; see if the stream can continue (thus unblocking an unforseen race).
; Calling sequence:
; PUSHJ P,CHKHNG ; See if anything is hung
; returns non-skip if something was hung
; returns skip if nothing hung
; Destroys S1, S2, T1-T4
IFN FTDEBUG,<
CHKHNG: MOVSI T4,-NFAL ; Setup an AOBJN pointer to the tables
PUSHJ P,I%NOW ; Go get the current date/time
MOVE T3,S1 ; Get a safer copy of it
MOVEI T2,1 ; Assume skip return
; Loop here for each task. See if it's just blocked for I/O only. If it
; is, see if it's been out for a long time.
CHKH.1: SKIPN FALACT(T4) ; Is this guy active?
JRST CHKH.3 ; No, skip it
SKIPN T1,FALSTW(T4) ; Yes, is it blocked?
JRST CHKH.2 ; No, but there's something to run now,
; so pretend we just unnblocked it
TXNE T1,^-PSF%IO ; Blocked for any non-I/O conditions?
JRST CHKH.3 ; Yes, leave this guy alone
MOVE S1,T3 ; Get the current time
SUB S1,FALBLK(T4) ; Subtract the time we started waiting
CAIGE S1,HNGTIM*3 ; Been too long?
JRST CHKH.3 ; No, skip over it
; Here if we got a task that's been waiting too long. Just unblock any I/O
; wait and tell the operator about it.
TXZ T1,PSF%IO ; Clear any I/O block
EXCH T1,FALSTW(T4) ; Store the new hoked up status
TXNE T1,PSF%NI!PSF%NO ; Network wait?
SKIPA T1,[[ASCIZ ~Network~]] ; Yes, say so
MOVEI T1,[ASCIZ ~Disk~] ; No, say disk
$WTOJ (Error,<Restarting apparently hung ^T/@T1/ I/O>,@FALOBA(T4))
CHKH.2: SETZ T2, ; Say we want the non-skip return
CHKH.3: AOBJN T4,CHKH.1 ; Loop if more streams to check
ADDM T2,(P) ; Adjust the return address
POPJ P, ; Return >
Subttl Scheduler -- CHKTIM - Routine to Check Wakeup Time
; The purpose of this routine is to check and set the sleep time based
; on the current conditions. The sleep time is checked based on the stream's
; wakeup time. Whoever wants to wake up the earliest sets the sleep time.
; Calling sequence:
; PUSHJ P,CHKTIM ; Set the wakeup time
; returns here, True if time to wake this stream
; Destroys S1, S2, T1
CHKTIM: PUSHJ P,I%NOW ; Get the current time into S1
MOVE T1,STREAM ; Get the stream number
SKIPN S2,FALWKT(T1) ; Get the wakeup time for this stream
$RETF ; No time set, nothing to do here
SUB S2,S1 ; Calculate the number
IDIVI S2,3 ; of seconds to sleep
JUMPLE S2,CHKT.1 ; Wake stream if it's wakeup time
CAILE S2,^D60 ; Is it a full minute?
MOVEI S2,^D60 ; Yes, truncate to one minute
SKIPL SLEEPT ; Always set new time if none set
CAMGE S2,SLEEPT ; Is this less than the previous?
MOVEM S2,SLEEPT ; Yes, set new sleep time
$RETF ; And say we're still asleep
; Here if it's time to run us
CHKT.1: SETZM SLEEPT ; Clear the sleep time
MOVE T1,STREAM ; Get the stream number back
MOVX S1,PSF%SL ; And clear the status
ANDCAM S1,FALSTW(T1) ; flag for this stream
SETZM FALWKT(T1) ; Clear the wakeup time
$RETT ; Return true and wake the stream
Subttl Scheduler -- DSCHD - Deschedule the Current Stream
; This routine will descedule the current process, and return to the top
; level scheduling loop.
; Calling sequence:
; J/ current per context storage pointer
; MOVX M0,<blocking status>
; PUSHJ P,DSCHD ; Block until condition satisfied
; returns here when unblocked and rescheduled
; This routine makes the following assumptions:
; 1) STREAM contains the current stream number and J points to the
; per stream storage.
; 2) We're currently in stream context. If this is not the case, bad
; things can happen.
; 3) If called with an IPCF message currently in use, it is assumed
; that the user has everything needed from the message, and the
; message will be released. This assumption is necessary to
; prevent another message being received before the old message
; is released.
; A stream context registers are preserved in the per stream memory
; Top level ACs S1, S2 and T1 are clobbered.
DSCHD:: MOVEM 0,J$RACS(J) ; Save the registers
MOVEI 0,J$RACS+1(J) ; with a BLT
HRLI 0,1 ; ...
BLT 0,J$RACS+17(J) ; Save them all
MOVE T1,STREAM ; Get the current stream number
; Store the blocking flags in the stream status
HLLZ S1,TF+J$RACS(J) ; Get the flags
HRRZ S2,TF+J$RACS(J) ; Get the sleep time
IORM S1,FALSTW(T1) ; Store the new blocking bits
IFN FTDEBUG,<
PUSHJ P,I%NOW ; Get the current time
MOVEM S1,FALBLK(T1) ; Store it for the hung checker >
SETZ S1, ; Get a zero
EXCH S1,FALWAK(T1) ; Clear the reasons why we should wake
ANDCAM S1,FALSTW(T1) ; Clear any sloppiness on our part
; Copy the WILD data back to the per stream area so it doesn't get
; wiped out. This is a temporary solution to this problem until WILD
; learns about multithreaded operation.
HRLZI T2,.WILDZ## ; * Hack * Get the source of the data
HRR T2,J$SWLD(J) ; * Hack * Get the destination
HRRZ T3,T2 ; * Hack * Copy the destination base
BLT T2,.WILDL##-1(T3) ; Copy the WILD data
JUMPE S2,DSCH.D ; If no sleep time given, go away
PUSHJ P,I%NOW ; Get the current time
IMULI S2,3 ; Convert seconds to UDT ticks (sort of)
ADD S1,S2 ; Build the wakeup time
MOVEM S1,FALWKT(T1) ; Save the wakeup time
; Make sure we're really in stream context.
DSCH.D: HRRZ S1,P ; Get the current stack address
CAIL S1,J$RPDL(J) ; Is it less than stream stack base?
CAILE S1,PDSIZE+J$RPDL(J) ; No, is it inside the stream stack?
STOPCD (CDS,HALT,,Call to DSCHD while not in stream context)
MOVE P,[IOWD PDSIZE,PDL] ; Reset the scheduler stack pointer
JRST MAIN.1 ; And re-enter the scheduler cycle
Subttl Scheduler -- CHKQUE - Receive and Schedule an IPCF Message
; Here to receive and schedule an incoming IPCF message.
; Calling sequence:
; PUSHJ P,CHKQUE ; Process incoming IPCF messages
; returns here always, no particular status
; Destroys S1, S2, T1-T4
CHKQUE: SETZM MESSAG ; Say no messages received yet
PUSHJ P,C%RECV ; Go try to get one
JUMPF .POPJ ; Nothing there, return
SETOM IMESS ; Say we got something
SETZM BLKADR ; Clear the IPCF message block address save area
LOAD S2,MDB.SI(S1) ; Get the special index word
TXNN S2,SI.FLG ; Is there an index there?
JRST CHKQ.5 ; No, ignore it
ANDX S2,SI.IDX ; AND out the index
CAIE S2,SP.OPR ; Is it from OPR?
CAIN S2,SP.QSR ; No, is it from QUASAR?
SKIPA ; Yes, go on
JRST CHKQ.5 ; No, punt the message
CAIN S2,SP.QSR ;[23] So it's ok. Was it from QUASAR?
PUSHJ P,QSRBAK ;[23] Yes, go make sure we know it's there
; Here with something valid to do.
CHKQ.2: LOAD M,MDB.MS(S1),MD.ADR ; Get the message address
MOVEM M,MESSAG ; Save it away
LOAD S2,.MSTYP(M),MS.TYP ; Get the message type
MOVSI S1,-NMSGT ; Get an AOBJN pointer to the type table
CHKQ.3: HRRZ T1,MSGTAB(S1) ; Get a message type
CAMN S2,T1 ; Is it our boy?
JRST CHKQ.4 ; Yes, go handle it
AOBJN S1,CHKQ.3 ; No, try the next one
JRST CHKQ.5 ; No match anywhere, punt it
CHKQ.4: HLRZ T2,MSGTAB(S1) ; Get the processing routine address
MOVEM T2,RUTINE ; Save the routine address
PUSHJ P,CHKOBJ ; Go find the object block
JUMPF CHKQ.5 ; Not there, just delete it
PUSHJ P,@RUTINE ; Call the processor
SKIPN FALBTS ; Do we want to save the status bits?
MOVEM S,J$RACS+S(J) ; Yes, save the status bits then
SETZM FALBTS ; Reset the default for saving flags
CHKQ.5: SKIPE IMESS ; Do we have a message allocated?
PUSHJ P,C%REL ; Yes, release it
SETZM IMESS ; Say we don't have a message anymore
POPJ P, ; And return to the scheduler
; Table of message types and corresponding processor routine:
MSGTAB: XWD DSTATUS,.QORCK ; Checkpoint request
XWD SETUP,.QOSUP ; Setup/shutdown
XWD DEFINE,.QOODB ; Define (object data)
XWD CONTIN,.OMCON ; Operator continue request
XWD PAUSE,.OMPAU ; Operator pause/stop request
XWD KILL,.OMCAN ; Cancel transfer
XWD ACK,MT.TXT ;[25] Acknowledgement we hope
NMSGT==.-MSGTAB ; The number of message types we know about
Subttl Scheduler -- CHKOBJ - Validate the QUASAR/Orion/OPR Message Object Blocks
; This routine is called on the receipt of an IPCF message to validate
; the message's object blocks.
; Calling sequence:
; S1/ offset into MSGTAB
; S2/ message type
; PUSHJ P,CHKOBJ ; Check the object blocks
; returns false if not valid
; returns true with:
; STREAM/ stream number
; J/ database address
; S/ status bits
; Destroys S1, S2, T1-T3
CHKOBJ: CAIL S2,MT.OFF ;[25] Is it a common message?
$RETT ;[25] Yes, no object to look for
CAIL S2,.OMOFF ; No, is this an OPR/Orion message?
JRST CHKO.1 ; Yes, go setup the object search
XCT MSGOBJ(S1) ; Get the object block address
JRST CHKO.2 ; Continue below
; Here if an OPR/Orion message:
CHKO.1: PUSHJ P,GETBLK ; Get a message block
JUMPF .RETF ; No more, that's an error
CAIE T1,.OROBJ ; Is this the object block?
JRST CHKO.1 ; No, try the next one then
MOVE S1,T3 ; Get the block data address
CHKO.2: PUSHJ P,FNDOBJ ; Go find the object block
POPJ P, ; Return and propogate T/F
; Here if .QOODB - find object type block
CHKO.3: PUSHJ P,GETBLK ;[22] Get the next block
JUMPF .RETF ;[22] No more. That's an error
CAIE T1,.ORTYP ;[22] Is this an object type block?
JRST CHKO.3 ;[22] No, skip it
MOVEI T1,.OTFAL ;[22] Yes, get our object type
CAME T1,(T3) ;[22] Is it for us?
$RETF ;[22] No, punt it off
$RETT ;[22] Yes, return happy
MSGOBJ: MOVEI S1,RCK.TY(M) ; Get the checkpoint message object address
$RETT ;[22] Return happy if setup message
JRST CHKO.3 ;[22] Look for object type block for .QOODB
Subttl Scheduler -- GETBLK - Break an IPCF Message into its Data Blocks
; here to extract data blocks from an IPCF message.
; Calling sequence:
; M/ message address
; PUSHJ P,GETBLK ; Get the next block from the message
; returns false if no more message blocks
; returns true with message block:
; T1/ block type
; T2/ block length
; T3/ block data pointer
; Destroys S1, T1-T3
GETBLK: SOSGE .OARGC(M) ; Subtract one from block count
$RETF ; No more. Return in shame
SKIPN S1,BLKADR ; Get the previous block address
MOVEI S1,.OHDRS+ARG.HD(M) ; None there, get the first block address
LOAD T1,ARG.HD(S1),AR.TYP ; Get the block type
LOAD T2,ARG.HD(S1),AR.LEN ; Get the block length
MOVEI T3,ARG.DA(S1) ; Point to the data block address
ADD S1,T2 ; Point to the next block
MOVEM S1,BLKADR ; Save it for next time
$RETT ; And return success
Subttl Program Restart -- RESTRT - Restart after a Fatal Error
;[50] Here after a fatal error to restart the FAL job.
; Calling sequence:
; S1/ address of ASCIZ text
; PJRST RESTRT
RESTRT::MOVE P,[IOWD PDSIZE,PDL] ; Give GLXLIB a valid stack
PJOB S2, ; Get our job number
$WTO (<FAL job ^D/S2/ restarting>,<^T/(S1)/>,,$WTFLG(WT.SJI))
JRST FAL ; Restart this job
Subttl QUASAR Service Routines -- ACK - Process an ACK
; Here when we receive a text message. Normally, this should be an
; ACK, but it could be some sort of error. Ignore acks, and attempt the
; appropriate action on a NAK.
; Calling sequence:
; M/ message address
; PUSHJ P,ACK ; Process hopeful ACK
; returns true always (unless we halt)
; Destroys S1, S2, T1-T4
ACK: SETOM FALBTS ;[25] Don't try to update S
MOVX S1,MF.FAT ;[25] Get the fatal error indicator
TDNN S1,.MSFLG(M) ;[25] Fatal error?
$RETT ;[25] No, just ignore the message
LOAD S1,.MSFLG(M),MF.SUF ;[25] Yes, get the suffix
MOVSI S2,-NAKLEN ;[25] Get the number of known errors
; Loop here throught a table of errors that needs to be processed specially
ACK.01: HLRZ T1,NAKTBL(S2) ;[25] Get an error prefix
CAME S1,T1 ;[25] Is it a match?
AOBJN S2,ACK.01 ;[25] No, try the next one
JUMPGE S2,ACK.02 ;[25] No match? Go handle normally
HRRZ T1,NAKTBL(S2) ;[25] Got one, get the dispatch address
PJRST (T1) ;[25] Call the special processor
; Here if some unknown or normal error:
ACK.02: PUSHJ P,GETBLK ;[25] Go get the ASCII string if any
$RETT ;[25] None, just return
CAIE T1,.CMTXT ;[25] Text string?
JRST ACK.02 ;[25] No, try the next block
PJOB T1, ;[25] Get our job number
$WTO (<Error from QUASAR to FAL job ^D/T1/>,<^T/(T3)/>,DUMOBJ)
$RETT ;[25] Just return after this
NAKTBL: XWD 'IPE',NOPRIV ;[25] Not enough privs
XWD 'SNY',NEWQSR ;[25] QUASAR gone away and come back?
XWD 'WVN',BADVER ;[25] Bad version number
NAKLEN==.-NAKTBL ;[25] Length of this table
; Here if bad QSRMAC version number. Just complain and exit.
BADVER: PJOB T1, ;[25] Get our job number
$WTO (<FAL job ^D/T1/ not starting>,<Built for wrong version of QUASAR>,DUMOBJ)
JRST STOPIT ;[25] All done, exit
; Here if QUASAR says we don't have enough privs to do this. If this is the
; case, there's little chance that we're running from FRCLIN, so I suppose
; it's ok to OUTSTR a message:
NOPRIV: OUTSTR [ASCIZ ~?FALIPE Insufficient privileges
~] ;[25] Type our complaint
STOPIT: MONRT. ;[25] And exit
JRST STOPIT ;[25] (If we're continued)
; Here if we think QUASAR went away and came back again
NEWQSR: PUSHJ P,QSRGON ;[25] Say he's gone
MOVEI T1,HELLO ;[25] And try to send
PJRST SNDQSR ;[25] a HELLO message
Subttl QUASAR Service Routines -- CONTIN, PAUSE - Continue or Pause a Stream
; Here to continue a stream paused by OPR.
; Calling sequence:
; STREAM/ current stream number
; PUSHJ P,CONTIN ; Continue processing on this stream
; returns true always
; Destroys S1, S2
CONTIN: MOVX S2,PSF%ST ; Get the stopped but
MOVE S1,STREAM ; Get the current stream number
ANDCAM S2,FALSTW(S1) ; Clear the stop condition
$ACK (Continued,,@FALOBA(S1),.MSCOD(M)) ; Tell the operator
SETZM FALCHK(S1) ; Cause a status update
$RETT ; Return happy
; Same thing, but this time, stop the stream instead of continuing it.
; Calling sequence:
; STREAM/ current stream number
; PUSHJ P,PAUSE ; Pause processing on this stream
; returns true always
; Destroys S1, S2
PAUSE: MOVE S1,STREAM ; Get the current stream number
MOVX S2,PSF%ST ; Get the stopped bit
IORM S2,FALSTW(S1) ; Stop the stream
$ACK (Stopped,,@FALOBA(S1),.MSCOD(M)) ; Tell the operator
SETZM FALCHK(S1) ; Make a checkpoint happen
$RETT ; And return happy
Subttl QUASAR Service Routines -- DEFINE - Set Object Data
; This routine is called in response to an OPR DEFINE FILE-ACCESS
; command, and will process the object data sent. The data to be set
; depends on the blocks we find in the message. We assume that the .ORTYP
; block has already been checked to verify our object type, and that the
; next block is a valid data block.
; Calling sequence:
; M/ message address
; BLKADR/ previous block address
; PUSHJ P,DEFINE ; Go set the object data
; returns true always
; Destroys S1, S2, T1-T4
DEFINE: SETOM FALBTS ; Make sure we don't update S
PUSHJ P,GETBLK ; Get the next block in the message
JUMPF .RETT ; No more. Just return
MOVE S2,[-DEFLEN,,DEFTYP] ; Get an AOBJN pointer
DEFI01: HLRZ S1,(S2) ; Get a block type
CAME T1,S1 ; Is it our type?
AOBJN S2,DEFI01 ; No, try the next type
JUMPGE S2,DEFINE ; Didn't find it? Try next block
HRRZ S1,(S2) ; Got it. Get the dispatch
JRST (S1) ; Call the appropriate processor
; Table of DEFINE block types:
DEFTYP: XWD .ORDPP,DEFPPN ; DEFINE FILE-ACCESS DEFAULT-PPN
XWD .ORREJ,DEFREJ ; DEFINE FILE-ACCESS REJECTION-LIST
DEFLEN==.-DEFTYP
; Here to set the default access PPN
DEFPPN: MOVE S1,(T3) ; Get the default access PPN
MOVEM S1,NETPPN## ; Store it
JRST DEFINE ; And go try for more blocks
; Here to set the rejection list:
DEFREJ: SKIPN S2,REJFIR## ; Is there any old rejection list?
JRST DEFR01 ; No, skip this
MOVE S1,REJLAS## ; Get the last one
SUB S1,S2 ; Compute number of words to deallocate
SETZM REJFIR## ; Then, zero the pointers
SETZM REJLAS## ; to the old list
PUSHJ P,.MMFWD ; Deallocate the old list
JRST DEFINE ; Oh, punt!
DEFR01: MOVEI S1,-ARG.DA(T2) ; Get the number of words to allocate
PUSHJ P,.MMGWD ; Go allocate memory for the new list
JRST DEFINE ; Oh well, try another block
MOVE T1,S2 ; Copy the new block pointer
HRL T1,T3 ; Point to the incoming data
ADD S1,S2 ; Get BLT destination
BLT T1,-1(S1) ; Copy the list
IFN ARG.DA-1,SUBI S1,ARG.DA-1 ; Compute REJLAS pointer
MOVEM S1,REJLAS## ; Store it
MOVEM S2,REJFIR## ; Store the new first pointer
JRST DEFINE ; And go try for another block
Subttl QUASAR Service Routines -- DSTATUS - Send Status Info
; This routine provides a uniform means of handling checkpointing
; within a stream. it decides whether to send status messages.
; CHKPNT is called based on FALCHK or elapsed time since the last CHKPNT.
; The time till the next checkpoint is set if called. If FALCHK is 0,
; CHKPNT is always called.
; This is the only routine that should call CHKPNT.
; Calling sequence:
; STREAM/ current stream number
; J/ per stream storage pointer
; PUSHJ P,DSTATUS ; Send a statups update
; returns here always, no particular status
; Destroys S1, S2, T1-T4
DSTATU: $SAVE <P1,P2,P3,P4,S> ; Save a couple of preserved registers
MOVE P1,STREAM ; Get the stream number
MOVE S,J$RACS+S(J) ; Get the stream's status
SKIPN FALACT(P1) ; Are we active?
$RET ; No. Nothing to checkpoint then
PUSHJ P,I%NOW ; Get the current time
MOVE P2,S1 ; Copy to a safer place
SUB S1,FALCHK(P1) ; Compute time to checkpoint
SKIPGE S1 ; Is it time to checkpoint yet?
$RET ; No, just return now
PUSHJ P,CHKPNT ; Yes, do a checkpoint then
ADDI P2,CHKPTIM*3 ; Get UDT (sort of) for next time
MOVEM P2,FALCHK(P1) ; Store the next checkpoint time
$RET ; And return
Subttl QUASAR Service Routines -- CHKPNT - Checkpoint A Stream
; We come here periodically to checkpoint the progress on a FAL stream.
; The checkpoint message we are about to send to QUASAR is not the normal
; QUASAR checkpoint, but rather one tailored for this application. This
; routine should be called by DSTATUS only.
; Calling sequence:
; J/ pointer to the stream's data pages
; S/ current stream status bits
; PUSHJ P,CHKPNT ; Do a checkpoint
; returns here always. Aborts if error in send
; Destroys S1, S2, T1-T4
CHKPNT: TXNE S,S.QSRD ;[23] Is our QUASAR gone?
POPJ P, ;[23] Yes. Don't try to send anything
MOVEI T1,MSGBLK ; Point at the message storage
; Pre-zero the message block storage in case we're not copying a file:
SETZM MSGBLK ; Zero a word
MOVE S1,[MSGBLK,,MSGBLK+1] ; Make a BLT pointer
BLT S1,FAL.ST(T1) ; Clear up to the first string word
; Figure out what this stream's doing:
MOVE S2,FALSTW(P1) ; Get the blocked bits for this stream
MOVX S1,%IDLE ; Assume that we're idle
TXNE S2,PSF%ST ; Are we stopped?
MOVX S1,%STOPD ; Yes, say so
TXNE S2,PSF%CR ; Did it crash?
MOVX S1,%NAVAL ; Yes, say so
CAIE S1,%IDLE ; Get any status yet?
JRST CHKP.0 ; Yes, don't look any more
MOVE S2,FALPAG(P1) ; Get the per stream storage pointer
MOVE S2,J$RACS+S(S2) ; Get the stream's status word
TXNE S2,S.OPEN ; Do we have a file open?
MOVX S1,%ACTIV ; Yes, say so
TXNE S2,S.CONN ; Did we just connect to someone?
MOVX S1,%CNECT ; Yes, say so
TXNE S2,S.KILL ; Are we killing this connection?
MOVX S1,%CNCLG ; Yes, tell him that
CHKP.0: MOVEM S1,STU.CD(T1) ; Store the status word
HRLZ S1,FALOBA(P1) ; Get the object block pointer
HRRI S1,STU.RB(T1) ; Point at the destination
BLT S1,STU.RB+OBJ.SZ-1(T1) ; Copy the object block into the message
; Store the network type and see if we're active. If not, send a message
; minus the connect time, node names, bytes sent and status string
MOVE S1,J$FTYP(J) ; Get the network type
CAXE S1,IO.ANF ; ANF-10?
SKIPA S1,[2] ; No, say it's DECnet
MOVEI S1,1 ; Yes, say it's ANF
MOVEM S1,FAL.PR+.OBNTY(T1) ; Store the network type
MOVEI S1,FAL.ST+1 ; Assume this is a short message
TXNN S,S.OPEN ; Do we have a connection open?
JRST CHKP.1 ; No, send a short message
; Compute the connect time for this stream, and convert from UDT units
; to jiffies.
PUSHJ P,I%NOW ; Get the current date/time
SUB S1,J$RTIM(J) ; Compute the connect time
MOVX S2,%CNSTS ; Get the system status
GETTAB S2, ; So we can get cycles/second
SKIPA ; Error? Assume 60Hz
TXNN S2,ST%CYC ; Ok, is this 50 Hz?
SKIPA S2,[^D60] ; No, it's good ol' 60 Hz
MOVEI S2,^D50 ; Yes, remember this
IMUL S1,S2 ; Multiply by jiffies/sec
IMULI S1,^D60*^D60*^D24 ; Convert from UDT fraction to seconds
HLRZM S1,FAL.PR+1(T1) ; * hack.OBCTM(T1) ; Store it
MOVE S1,J$SBYT(J) ; Get the number of bytes moved
MOVEM S1,FAL.PR+.OBBYT(T1) ; Store in the status message
MOVE S1,J$SNOD(J) ; Get the node name
MOVEM S1,FAL.PR+.OBNDN(T1) ; Store the node name
; Make a status string which says what's happening:
MOVEI S1,FAL.ST(T1) ; Point at the string storage
HRLI S1,(POINT 7,) ; Make it an ASCII byte pointer
MOVEM S1,TEXTBP ; Store for the following $TEXT call
MOVEI S1,<<MSBSIZ-FAL.ST>*5>-1 ;[21] Get the max string length
MOVEM S1,TEXTCT ;[21] Store as max byte count
MOVE T2,J$SACC(J) ; Get the file access type
$TEXT (DEPBP,<^T/@CHKFNC(T2)/ ^F/J$STFD(J)/ for user ^T/J$SUSR(J)/^0>)
HRRZ S1,TEXTBP ; Get the ending byte pointer
SUBI S1,MSGBLK-1 ; Compute the number of words filled
CHKP.1: STORE S1,.MSTYP(T1),MS.CNT ; Store the length of the message
MOVX S1,.QOFAS ; Get the function code
STORE S1,.MSTYP(T1),MS.TYP ; Store it
PUSHJ P,SNDQSR ; Go send this to QUASAR
PUSHJ P,I%NOW ; Get the current time and date
MOVEM S1,J$LCHK(J) ; Store as last checkpoint time
$RETT ; And return happy
PJRST SNDQSR ; Send it and return
; Helper routine for storing $TEXT strings
DEPBP: SOSL TEXTCT ;[21] Skip if no more room
IDPB S1,TEXTBP ; Store the byte
$RETT ; And return
Subttl QUASAR Service Routines -- KILL - Abort a Connection
; Here to abort processing on a connection. This routine is called
; by an operator command to tell a FAL stream to stop whatever it's doing.
; If it isn't doing anything, there's nothing to stop ...
; Calling sequence:
; S/ current stream status word
; PUSHJ P,KILL ; Kill it off
; returns true always
; Destroys no registers
KILL: TXNN S,S.OPEN ; Do we really have something going?
$RETT ; No, just punt it off
TXO S,S.KILL ; Yes, say we want to kill it
MOVE S1,STREAM ; Get the current stream number
$WTOJ (Abort,<Aborting due to operator command>,@FALOBA(S1))
$RETT ; Return
Subttl QUASAR Service Routines -- SETUP - Handle Stream Setup
; Here when we receive a setup stream message from QUASAR. Decide
; whether it's a setup or shutdown, and dispatch to the appropriate
; processor. If this is a setup, we will start and enter a stream context
; to perform the remainder of this call. This will cause the stream context
; to be started.
; Calling sequence:
; PUSHJ P,SETUP ; Go handle SETUP/SHUTDOWN message
; returns here, no particular status
; Destroys all registers
SETUP: LOAD S1,SUP.FL(M) ; Get the flags
TXNE S1,SUFSHT ; Is this really a shudown?
JRST SHUTDN ; Yes, go to the other processor
SETZ T2, ; Initialize a loop counter
SETU.1: SKIPN FALPAG(T2) ; Do we have a free stream here?
JRST SETU.2 ; Yes, go use it
CAIGE T1,NFAL-1 ; No, have we tried them all?
AOJA T2,SETU.1 ; No, go try another one then
STOPCD (TMS,HALT,,Too many setups) ; Yes, die
; Here if we have an idle stream:
SETU.2: MOVEM T2,STREAM ; Store as the current stream number
MOVEI S1,<J$$END+PAGSIZ-1>_-<WID(PAGSIZ-1)> ; Get the number of pages needed
PUSHJ P,M%AQNP ; Go allocate some pages
JUMPF [STOPCD (NEM,HALT,,Not enough memory to start stream)]
LSH S1,WID(PAGSIZ-1) ; Convert page number to address
MOVEM S1,FALPAG(T2) ; Save the stream storage pointer
MOVE J,S1 ; Copy the pointer to the traditional place
MOVEI S1,.WILDL## ; * Hack * Get the number of words required for WILD
PUSHJ P,.MMGWD ; * Hack * Go allocate it
STOPCD (CWD,HALT,,Cannot Allocate WILD data storage)
MOVEM S2,J$SWLD(J) ; * Hack * Store the memory pointer
SETZM FALSTW(T2) ; No reason why we can't run yet ...
MOVEM J,J$RACS+J(J) ; Save the storage address pointer
MOVE S2,T2 ; Copy the stream number
IMULI T2,OBJ.SZ ; Get the offset of an object block
ADDI T2,FALOBJ ; Add in the table base
MOVEM T2,FALOBA(S2) ; Store the object block address
MOVE S1,T2 ; Get a BLT destination pointer
HRLI S1,SUP.TY(M) ; Get the BLT source pointer
BLT S1,OBJ.SZ-1(T2) ; Copy the object block
MOVE S1,OBJ.ND(T2) ;[26] Get the processing node
SKIPE S2,.MYNNM## ;[56] ANF support?
CAMN S1,S2 ;[56] If so, is it the local node?
TRNA ;[56] No ANF support or local node
JRST [MOVX S1,$FSNRM ;[26] Not local node - error
PJRST RSETUP] ;[26] Inform QUASAR and quit
SETOM FALCHN(S2) ; Say no channel number assigned yet
MOVX S1,%RSUOK ; Get the startup code
PUSHJ P,RSETUP ; Reply to the setup message
MOVE S2,STREAM ; Get the stream number back
$WTO (<Started>,,@FALOBA(S2)) ; Say we've started ok
SETOM FALACT(S2) ; Make the stream active
SETZM FALCHK(S2) ; Force a checkpoint/status update
MOVE S1,SUP.CN(M) ; Get the fake conditioning data
MOVE S1,[EXP IO.DCN,IO.ANF,IO.DCN](S1) ; Convert to our own flavor of expression
MOVEM S1,J$FTYP(J) ; Store as the network type
MOVEI S1,J$RPDL-1(J) ; Point at the beginning of the stack
HRLI S1,-PDSIZE ; Setup the stack length
PUSH S1,[EXP FALEND] ; Last thing to call is final shutdown
PUSH S1,[EXP FALL##] ; Store the start address
MOVEM S1,J$RACS+P(J) ; Save the initial stack pointer
MOVX S,S.RUN ; Get the running bit
SETZM FALBTS ; Say we want to update the status
POPJ P, ; And return to the scheduler
Subttl QUASAR Service Routines -- SHUTDN - Shutdown Processing on a Stream
; SHUTDN will shut down processing on a stream. This routine will just
; set a flag to the effect that we're supposed to drop everything, and assume
; that everyone else down the line will take care of things appropriately.
; Calling sequence:
; S/ current stream status word
; PUSHJ P,SHUTDN ; Shut the stream down
; returns true always
; Destroys S1, S2, T1-T4, modifies S
SHUTDN: SETOM FALBTS ;[24] Assume we don't want to update bits
MOVEI S1,SUP.TY(M) ; Get the object block address
PUSHJ P,FNDOBJ ; Find the matching stream
JUMPF .RETT ; Return if no such stream
SHUTIN::TXO S,S.SHUT ; Mark this stream for shutdown
SETZM FALBTS ; Say we want the status stored
MOVE S2,STREAM ; Get the stream number
MOVX S1,PSF%CW ; If we're in connect wait
ANDCAM S1,FALSTW(S2) ; we're not anymore
SETZM FALCHK(S2) ; Make sure we send a status update
$RETT ; Return happily
Subttl QUASAR Service Routines -- FALEND - Process FAL Stream Termination
; We come here when a FAL stream has shut down. This routine will
; output the appropriate error message if the stream aborted due to
; unnatural causes, and in any case, clse the stream down. This mostly
; consists of deallocating any per stream data that may be lying about.
; Calling sequence:
; (not formally called, other than being POPJed to by FALL)
; S1/ shutdown/abort reason code
FALEND: MOVE P,[IOWD PDSIZE,PDL] ; Reset the stack pointer to scheduler context
MOVE T2,S1 ; Copy the abort/shutdown reason
MOVE P1,STREAM ; Get the stream number
SETOM FALBTS ; Say no status update needed
SKIPE T2 ; Abort reason given?
$WTO (<^T/@SETMSG(T2)/>,,@FALOBA(P1)) ; Yes, complain
SETZM FALACT(P1) ; Say the stream isn't active
MOVE S2,FALOBA(P1) ; Get the object block address
MOVE T1,S2 ; Make another copy of this
SETZM (S2) ; Clear the first word
HRL S2,S2 ; Make a BLT pointer
ADDI S2,1 ; (Point at obj+1)
BLT S2,OBJ.SZ-1(T1) ; Clear the object block
SKIPN J,FALPAG(P1) ; Get any per stream storage pointer
JRST MAIN.4 ; Nothing. Don't try to deallocate
MOVX S1,.WILDL## ; * Hack * Get the size of the WILD data
SKIPE S2,J$SWLD(J) ; * Hack * Get the pointer to it
PUSHJ P,.MMFWD ; * Hack * Release the memory
JFCL ; * Hack * Punt any error here
SETZM J$SWLD(J) ; * Hack * No more WILD data
SETZM FALPAG(P1) ; Say no more stream pages
MOVEI S1,<<J$$END+PAGSIZ-1>_-<WID(PAGSIZ-1)>> ; Get the number of pages to release
MOVE S2,J ; Copy the base address
LSH S2,-<WID(PAGSIZ-1)> ; Convert to a page number
PUSHJ P,M%RLNP ; Release a few pages
PUSHJ P,M%CLNC ; Get rid of unwanted pages
JRST MAIN.4 ; And return to the scheduler
Subttl FALSWI Service -- SETCHN - Inform the World about a New Channel
; Here when a FAL stream (running in FALSWI) opens a new network channel,
; usually just after a stream is started. This routine is called to inform the
; scheduler about the existance of this new channel, and to setup the interrupt
; system.
; Calling sequence:
; S1/ new channel number
; J/ pointer to per stream storage area
; S/ current stream flags word
; PUSHJ P,SETCHN ; Setup channel stuff
; returns non-skip if error in the PSI setup
; returns skip on success.
; Destroys S1, S2, T1 (SWIL's T1-T3)
SETCHN::MOVE T1,STREAM ; Get the current stream number
MOVE S2,J$FTYP(J) ; Get the stream type
CAXN S2,IO.ANF ; Is it an ANF-10 channel?
TXO S1,FC%ANF ; Yes, remember this for later
MOVEM S1,FALCHN(T1) ; Store the channel number in our tables
PUSHJ P,INTCON ; Connect this guy to the interrupt system
POPJ P, ; That's bad, pass it on
JRST .POPJ1 ; Ok, return happily
Subttl IPCF Subroutines -- FNDOBJ - Find an Object Block in our Data Base
; here when we've received an IPCF message refering to some object. This
; routine will compare the object block given with those that we have tucked
; away in our stream tables, so that we can figure out which one of the streams
; this message is refering to.
; Calling sequence:
; S1/ pointer the the object block in question.
; PUSHJ P,FNDOBJ ; Match this object block against ours
; returns false if we don't have this guy
; returns true on success. J contains the stream data pointer, status in S.
; Destroys S2, T1-T4, J, S
FNDOBJ: MOVE T1,.ROBTY(S1) ; Get the object type
MOVE T2,.ROBAT(S1) ; Get the unit number
MOVE T3,.ROBND(S1) ; Get the node number
SETZ T4, ; And init our loop counter
FNDO.1: MOVE S2,T4 ; Copy the stream number
IMULI S2,OBJ.SZ ; Multiply by words per object block
CAMN T1,FALOBJ+.ROBTY(S2) ; Is it the right object type?
CAME T2,FALOBJ+.ROBAT(S2) ; Yes, is it also the right unit number?
JRST FNDO.2 ; No, try the next one
CAMN T3,FALOBJ+.ROBND(S2) ; Yes, is it the right node number?
JRST FNDO.3 ; Yes, go do this one
; Here if this one doesn't match. Try the next one.
FNDO.2: ADDI T4,1 ; Bump to the next stream number
CAIL T4,NFAL ; HAve we done them all?
$RETF ; Yes, return error
JRST FNDO.1 ; No, try this one
; We got a match. Setup the stream data pointer and status, then return.
FNDO.3: MOVEM T4,STREAM ; Store the stream number
SKIPN J,FALPAG(T4) ; Get the stream data pointer
$RETF ; Nothing? That's an error
MOVE S,J$RACS+S(J) ; Get the stream's status word
$RETT ; And return happy
Subttl IPCF Subroutines -- RSETUP - Respond to a Setup Message
; here when processing is complete on a SETUP message from QUASAR
; This routine is called to send the IPCF response.
; Calling sequence:
; S1/ SETUP condition code
; PUSHJ P,RSETUP ; Respond to the SETUP
; returns true always
; Destroys S1, S2, T1-T2
RSETUP: MOVE T2,S1 ; Copy the setup condition code
MOVX S1,RSU.SZ ; Get the message length
MOVEI S2,MSGBLK ; And point to the message block
PUSHJ P,.ZCHNK ; Clear the message block
MOVEI T1,MSGBLK ; Point back at it
MOVX S1,RSU.SZ ; Get the message size again
STORE S1,.MSTYP(T1),MS.CNT ; Store the message size
MOVX S1,.QORSU ; Get "Response to SETUP" code
STORE S1,.MSTYP(T1),MS.TYP ; Store it
MOVE S1,STREAM ; Get the stream number
MOVS S1,FALOBA(S1) ; Get object addr,,0
HRRI S1,RSU.TY(T1) ; Get the place to move it to
BLT S1,RSU.TY+OBJ.SZ-1(T1) ; And move the object block
SKIPE S1,T2 ;[26] Setup ok?
MOVX S1,%RSUDE ;[26] No, say the device doesn't exist
STORE S1,RSU.CO(T1) ; Store the response code
PUSHJ P,SNDQSR ; Send it off to QUASAR
SKIPN S1,T2 ;[26] Copy the response code back
$RETT ;[26] No errors, just return
PJRST FALEND ;[26] Error, shut the stream
Subttl IPCF Subroutines -- SNDQSR - Send a Message to Quasar
; Routine to send an IPCF message to QUASAR.
; Calling sequence:
; T1/ pointer to message to be sent
; PUSHJ P,SNDQSR ; Send the message
; returns here if success, crashes on failure
; Preserves P1-P4
SNDQSR: MOVX S1,SP.QSR ; Get the QUASAR flag
TXO S1,SI.FLG ; Set the special index flag
STORE S1,SAB+SAB.SI ; and store it
SETZM SAB+SAB.PD ; Clear the PID word
LOAD S1,.MSTYP(T1),MS.CNT ; Get the message length
STORE S1,SAB+SAB.LN ; Save the message address
STORE T1,SAB+SAB.MS ; Save the message address
MOVEI S1,SAB.SZ ; Load the message size
MOVEI S2,SAB ; And point at the message text
PUSHJ P,C%SEND ; Send the message
JUMPT QSRBAK ;[23] Make sure we know QUASAR's here
; PJRST QSRGON ;[23] Say QUASAR's gone away
Subttl IPCF Subroutines -- QSRGON - Flag that QUASAR has Gone Away
; Here if we think QUASAR has gone away. This can be because we couldn't
; send to QUASAR, or that QUASAR is insisting that our streams shouldn't be
; here. Flag all the streams for possible shutdown.
; Calling sequence:
; PUSHJ P,QSRGON ; QUASAR has gone away
; returns true always
; Destroys S1, S2, T1-T2
QSRGON: SKIPE QSRDIE ;[23] Already been here?
$RETT ;[23] Yes, just return now
MOVSI T1,-NFAL ;[23] No, setup an AOBJN pointer
MOVX S2,S.QSRD ;[23] Get the "QUASAR is DEAD" flag
; Loop here, flagging each stream as going away soon:
QSRG01: SKIPE FALACT(T1) ;[23] Is this stream active?
SKIPN S1,FALPAG(T1) ;[23] Yes, any memory assigned?
JRST QSRG02 ;[23] No, skip this stream
IORM S2,J$RACS+S(S1) ;[23] Yes, lite the QUASAR gone bit
SKIPE S1,FALOBA(T1) ;[23] Any object block address?
SETZM OBJ.TY(S1) ;[23] Yes, corrupt the object block
QSRG02: AOBJN T1,QSRG01 ;[23] Loop for all possible streams
TXO S,S.QSRD ;[23] Make sure we set it for ourselves
SETOM QSRDIE ;[23] Flag for the world
$RETT ;[23] And return sort of happy
Subttl IPCF Subroutines -- QSRBAK - Flag QUASAR is Back
; Here when we either received or transmitted an IPCF message to QUASAR
; successfully. We'll see if we thought it was gone, and if so, flag all the
; old stale streams for shutdown.
; Calling sequence:
; QSRDIE/ non-zero if we thought QUASAR was dead
; PUSHJ P,QSRBAK ; Kill stale streams
; returns true always
; Destroys S1, S2, T1
QSRBAK: SKIPN QSRDIE ;[23] Did we think QUASAR's dead?
$RETT ;[23] No, just return fdh
SETZM QSRDIE ;[23] Yes. It ain't anymore
$WTO (Reset,<Shutting down stale FAL streams>,DUMOBJ)
$SAVE <P1,S,J,STREAM> ;[23] Save a bunch of registers
MOVSI P1,-NFAL ;[23] Setup an AOBJN pointer
; Loop here for each possible stream. Flag each broken one we find for
; shutdown at end of job.
QSRD01: SKIPE FALACT(P1) ;[23] Is this stream active?
SKIPN J,FALPAG(P1) ;[23] Maybe. Is there memory assigned?
JRST QSRD02 ;[23] No, skip this one.
MOVE S,J$RACS+S(J) ;[23] Yes, get the status bits
HRRZM P1,STREAM ;[23] Store the stream number in a nice place
PUSHJ P,SHUTIN ;[23] Go shut the stream down
MOVEM S,J$RACS+S(J) ;[23] Put the new status back
QSRD02: AOBJN P1,QSRD01 ;[23] Loop for all streams
$RETT ;[23] And return happy
Subttl PSI Routines -- INTINI - Initialize the PSI System
; Here on program startup to initialize the interrupt system. This simply
; consists of putting the interrupt routine address in the vector block
; for each condition. GLXLIB handles the rest.
; Calling sequence:
; PUSHJ P,INTINI ; Initialize the interrupt system
; returns here always, no particular status
; Destroys S1, T1-T3
INTINI: MOVEI S1,IPCINT ; Get the address of the IPCF interrupt routine
MOVEM S1,IPCVEC+.PSVNP ; Store in the vector block
MOVEI S1,DECINT ; Get the DECnet interrupt vector
MOVEM S1,DECVEC+.PSVNP ; Store it
; Setup the ANF-10 interrupt vector blocks:
SETZ T1, ; Init the index/loop counter
INTI.1: MOVEI S1,INTANF(T1) ; Get the service routine address
MOVEM S1,ANFVEC+.PSVNP(T1) ; Store in the interrupt block
ADDI T1,ANHDSZ ; Bump the pointer
CAIGE T1,ANHDSZ*NANF10 ; Done all of them?
JRST INTI.1 ; No, do another one
; Setup the disk interrupt vector blocks:
SETZ T1, ; Init the index again
INTI.2: MOVEI S1,INTDSK(T1) ; Get the service routine address
MOVEM S1,DSKVEC+.PSVNP(T1) ; Store in the interrupt block
ADDI T1,DSHDSZ ; Bump the pointer
CAIGE T1,DSHDSZ*NFAL ; Done them all?
JRST INTI.2 ; No, go do another one
MOVX S1,PS.FAC!T1 ; Setup function and arg block pointer
MOVX T1,.PCNSP ; Set interrupts for NSP.
MOVSI T2,DECVEC-PSIVEC ; Get the PSI block offset
SETZ T3, ; No priority
PISYS. S1, ; Turn the condition on/off
$RETF ; Error, punt
$RETT ; Ok, return happy
POPJ P, ; And return
Subttl PSI Routines -- INDCON - Connect a Disk Channel to the Interrupt System
; Here from FALSWI when we've opened a new channel to disk. This
; routine is called to connect that stream to the interrupt system.
; Calling sequence:
; S1/ channel number
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INDCON ; Connect us to the interrupt system
; returns non-skip if errors
; returns skip if success
; Destroys S1, S2 (SWIL's T1 and T2)
INDCON::$SAVE <T1,T2,T3,T4> ; Save some temporaries
MOVE S2,STREAM ; Get the stream number
MOVEM S1,FALDSK(S2) ; Store the disk channel number
IMULI S2,.PSLEN ; Make an offset into the interrupt blocks
ADDI S2,DSKVEC-PSIVEC ; Add in the base PSI offset
HRLZS S2 ; Put the offset in the left half
TXO S2,PS.RID!PS.ROD!PS.RDO!PS.ROL ; Get the interrupt enables
IFN <S2+1-T1>,<Printx ? Foo on AC assignments>
SETZ T1, ; No priority (as if it matters)
MOVX T2,PS.FAC!S1 ; Say we want to add a condition
PISYS. T2, ; Tell the system about it
POPJ P, ; Error, just punt
TXO S,S.PSID ; Ok. Say we were here
JRST .POPJ1## ; And return happy
Subttl PSI Routines -- INDDIS - Disconnect a Disk Channel from the Interrupt System
; Here from FALSWI when we're about to close a disk channel. This
; routine will remove the channel from the interrupt system.
; Calling sequence:
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INDDIS ; Disconnect us from the interrupt system
; returns here if error (not likely)
; returns skip if success
; Destroys S1 and S2 (SWIL's T1 and T2)
INDDIS::$SAVE <T1,T2,T3,T4> ; Save some registers
MOVE S2,STREAM ; Get the stream number
SETO S1, ; Get a null channel number
EXCH S1,FALDSK(S2) ; Get rid of our knowledge of this
TXZE S,S.PSID ; Were we enabled for PSI?
SKIPGE S1 ; Yes, was there a channel number?
JRST INDD.1 ;[17] No, skip this
IMULI S2,.PSLEN ; Multiply stream number by PSI block size
ADDI S2,DSKVEC-PSIVEC ; Add in the base PSI vector offset
HRLZS S2 ; Put it in the left half
TXO S2,PS.RID!PS.ROD!PS.RDO!PS.ROL ; Get what we were enabled for
SETZ T1, ; No priority
MOVX T2,PS.FRC!S1 ; Point at the arg block
PISYS. T2, ; Remove us from interruptions
JFCL ; Don't worry about errors here
INDD.1: MOVX S1,PSF%DI!PSF%DO!PSF%DF ;[17] Get the valid blocking reasons
MOVE S2,STREAM ;[17] Get the stream number back
ANDCAM S1,FALSTW(S2) ;[17] Clear any block from disk
ANDCAM S1,FALWAK(S2) ;[17] And clear any bogus pending wake
JRST .POPJ1## ; Just return happy
Subttl PSI Routines -- INTCON - Connect a Stream to the Interrupt System
; Here from FALSWI when we've opened a new stream. This routine is
; called to connect that stream to the interrupt system.
; Calling sequence:
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INTCON ; Connect us to the interrupt system
; returns non-skip if errors
; returns skip if success
; Destroys S1, S2 (SWIL's T1 and T2)
INTCON: $SAVE <T1,T2,T3,T4> ; Save some temporaries
TXNE S,S.PSIN ; Are we already enabled?
JRST .POPJ1 ; Yes, just return happy
MOVE S1,STREAM ; No, get the stream number
MOVX S2,PSF%NI!PSF%NO!PSF%CW ;[17] Get all the reasons we may be blocked
ANDCAM S2,FALSTW(S1) ;[17] Make sure we aren't blocked from these
ANDCAM S2,FALWAK(S1) ;[17] and that we're not going to unblock
MOVE S2,FALCHN(S1) ; Get the channel number
TXNN S2,FC%ANF ; Is this an ANF-10 channel?
JRST INTC.1 ; No, try DECnet
PUSHJ P,INTCNA ; Yes, call the appropriate processor
JRST INTC.2 ; Continue below
INTC.1: PUSHJ P,INTCND ; Connect to the DECnet interrupt system
INTC.2: JUMPF .POPJ ; Give error return if we failed
TXO S,S.PSIN ; Ok, say we're turned on
JRST .POPJ1 ; And return happy
Subttl PSI Routines -- INTDIS - Disconnect a Stream from the Interrupt System
; Here from FALSWI to disconnect a network channel from the interrupt
; system.
; Calling sequence:
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INTDIS ; Disconnect from the interrupt system
; never gives error return
; returns skip always
; Destroys S1 and S2 (SWIL's T1 and T2)
INTDIS::$SAVE <T1,T2,T3,T4> ; Save some termporaries
TXNN S,S.PSIN ; Are we enabled?
JRST INTD.2 ; No. Not much to do then.
MOVE S1,STREAM ; Get the stream number
MOVE S2,FALCHN(S1) ; Get the channel number
TXNN S2,FC%ANF ; Is this an ANF-10 channel?
JRST INTD.1 ; No, go do DECnet
PUSHJ P,INTDNA ; Yes, call the appropriate handler
JRST INTD.2 ; Continue below
INTD.1: PUSHJ P,INTDND ; Disconnect from DECnet interrupts
INTD.2: TXZ S,S.PSIN ; Say we aren't enabled anymore
MOVE S2,STREAM ; Get the stream number back
SETZM FALCHN(S2) ; Clear to avoid interrupt confusion
MOVX S1,PSF%NI!PSF%NO!PSF%CW ;[17] Get all the reasons we may be blocked
ANDCAM S1,FALSTW(S2) ;[17] Make sure we aren't blocked from these
ANDCAM S1,FALWAK(S2) ;[17] and that we're not going to unblock
JRST .POPJ1## ; And return
Subttl PSI Routines -- INTCNA, INTDNA - Connect an ANF-10 Channel to the Interrupt System
; Here to add or remove a channel from the interrupt system.
; Calling sequence:
; J/ pointer to the stream context data
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INTCNA ; Connect the ANF channel to an interrupt
; or
; PUSHJ P,INTDNA ; Remove the ANF channel from the interrupt system
; returns false if errors
; returns true on success
; Destroys S1, S2, T1-T3
INTCNA: SKIPA S1,[PS.FAC+T1] ; Say we want to add a condition
; Special entry to remove the channel from the interrupt system
INTDNA: MOVX S1,PS.FRC!T1 ; Say we want to remove the condition
MOVE T2,STREAM ; Get the current stream number
MOVE T1,FALCHN(T2) ; Get the channel number
TXNN T1,FC%ANF ; Is this really an ANF-10 channel?
STOPCD (CDA,HALT,,Tried to connect DECnet channel to ANF-10 interrupt system)
TLZ T1,-1 ; Get rid of junk.
IMULI T2,.PSLEN ; Multiply buy the PSI block length
ADDI T2,ANFVEC-PSIVEC ; Add in the block offset
HRLZS T2 ; Make it offset,,0
HRRI T2,PS.RID!PS.ROD!PS.REF!PS.RDO!PS.ROL ; Get enable bits
SETZ T3, ; No particular priority
PISYS. S1, ; Add/remove the condition
$RETF ; Error, punt
$RETT ; Ok, return happy
Subttl PSI Routines -- INTCND - Connect a DECnet Channel to the Interrupt System
; Here when we open a new DECnet channel. This routine will connect
; that channel to the interrupt system.
; Calling sequence:
; J/ pointer to stream context data
; S/ current stream status
; STREAM/ current stream number
; PUSHJ P,INTCND ; Connect the channel to the DECnet interrupts
; returns false if error
; returns true on success
; Destroys S1, T1-T3
INTCND: TXNE S,S.PSIN ; Are interrupts already enabled?
$RETT ; Yes, just punt this
HRRZI T3,-1 ; Enable interrupts on all events
JRST INCD.1 ; Continue in common code below
; Here if we want to disconnect:
INTDND: TXNN S,S.PSIN ; Were we enabled?
$RETT ; No, nothing to do here then
SETZ T3, ; Yes, disable everything
INCD.1: MOVE T1,[.NSFPI,,3] ; Get the function set set reason mask
HRRZ T2,STREAM ; Get the stream number
MOVE T2,FALCHN(T2) ; Get the DECnet channel number
TXNE T2,FC%ANF ; Is this really an ANF-10 channel?
STOPCD (CAD,HALT,,Tried to connect ANF channel to DECnet interrupt system)
TLZ T2,-1 ; In any case, get rid of flags
MOVEI S1,T1 ; Point at the argument block
NSP. S1, ; Tell the system about it
$RETF ; Error, punt
$RETT ; And return happy
Subttl PSI Routines -- ANFINT - ANF-10 Interrupt Service
; Here when ANF-10 I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found. Note that most link failure interrupts
; will simply unblock the top level if it is waiting for I/O to complete, on
; the assumption that we'll get an error as soon as we try anything, and will
; therefore notice the event for ourselves.
; Calling sequence:
; (none - this is an interrupt service routine)
; All registers are preserved
INTANF: ; Label for start of the headers
ZZ==0 ; Init the kludge counter
REPEAT NANF10,<ANFINH(ZZ) ;; Generate an isr header
ZZ==ZZ+1 ;; Bump the kludge counter >
ANFINT: MOVE J,FALPAG(S1) ; Get the per stream storage pointer
HRRZ T1,.PSVFL(S2) ; Get the interrupt reason flags
ANDCAM T1,.PSVFL(S2) ; Clear them
SETZ T2, ; Init our wake conditions
TXNE T1,PS.ROL ; Did we just get a connect initiate?
TXO T2,PSF%CW ; Yes, not in connect wait any longer
TXNE T1,PS.RID ; Input done?
TXO T2,PSF%NI ; Yes, unblock if that's what we're waiting for
TXNE T1,PS.ROD ; Output done?
TXO T2,PSF%NO ; Yes, clear the condition
TXNE T1,PS.RDO!PS.REF ; Connection drop or eof?
TXO T2,PSF%NO!PSF%NI!PSF%CW ; Yes, unblock whatever we're doing
ANDCAM T2,FALSTW(S1) ; Clear any blocked bits
IORM T2,FALWAK(S1) ; And set wake bits to prevent race in DSCHD
$DEBRK ; And return from the interrupt
Subttl PSI Routines -- DECINT - DECnet Interrupt Service
; Here when DECnet I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found. Note that most link failure interrupts
; will simply unblock the top level if it is waiting for I/O to complete, on
; the assumption that we'll get an error as soon as we try anything, and will
; therefore notice the event for ourselves.
; Calling sequence:
; (none - this is an interrupt service routine)
; All registers are preserved
DECINT: $BGINT 1 ; Normal isr entry stuff
HRRZ S1,DECVEC+.PSVIS ; Get the interrupting channel number
MOVSI S2,-NFAL ; Setup an AOBJN counter to find the stream
; Loop here to find the stream number corresponding to this channel number:
DECI.1: SKIPN FALACT(S2) ; Is this stream active?
JRST DECI.2 ; No, skip it then
MOVE T1,FALCHN(S2) ; Yes, get the channel number
TXNE T1,FC%ANF ; Is this an ANF channel number?
JRST DECI.2 ; Yes, skip it
CAIN S1,(T1) ; No, is it the one we're looking for?
JRST DECI.3 ; Yes, go play with it then
DECI.2: AOBJN S2,DECI.1 ; Loop if more streams to look at
; here if we got an interrupt from a channel that we don't have any matching
; stream for. This really shouldn't happen. I dunno, do sumthin'
HRRZ T2,S1 ; Copy the channel number
MOVEI S1,T1 ; Point at a temp argument block
MOVX T1,.NSFPI ; Say we want to set an interrupt mask
SETZ T3, ; Don't allow interrupts on this channel
NSP. S1, ; Tell the system about it
JFCL ; Oh well, punt it
$DEBRK ; Return
; Here with the winning stream number in the right half of S2:
DECI.3: HLLZ S1,DECVEC+.PSVIS ; Get the channel status
SETZ T1, ; Init our reasons for waking
TXNE S1,NS.IDA!NS.IDR!NS.NDA!NS.NDR ; Anything we recognize?
JRST DECI.4 ; Yes, go unblock the right thing
CAMN S1,[.NSSCW,,0] ; No, are we just in connect wait?
JRST DECI.5 ; Yes, just exit the interrupt now
TXO T1,PSF%NI!PSF%NO!PSF%CW ; No. Just unblock and hope the top
; level can figure out the link state
; change
DECI.4: TXNE S1,NS.NDA ; Input data available?
TXO T1,PSF%NI ; Yes, unblock if waiting for input
TXNE S1,NS.NDR ; Can we do output now?
TXO T1,PSF%NO ; Yes, unblock if waiting for output
ANDCAM T1,FALSTW(S2) ; Clear the appropriate blocks
IORM T1,FALWAK(S2) ; And set wake bits (prevent DSCHD racee)
DECI.5: $DEBRK ; And return from this interrupt
Subttl PSI Routines -- DSKINT - Disk Interrupt Service
; Here when disk I/O is complete or when the link status changes.
; This routine will determine the class of event and unblock the appropriate
; stream according to the event found. If we see the disk go offline, we'll
; block the stream until it comes back online. Sometime, we should queue
; a message to the operator saying that this is happening.
; Calling sequence:
; (none - this is an interrupt service routine)
; All registers are preserved
INTDSK: ; Label for start of the headers
ZZ==0 ; Init the kludge counter
REPEAT NFAL,<DSKINH(ZZ) ;; Generate an isr header
ZZ==ZZ+1 ;; Bump the kludge counter >
DSKINT: MOVE J,FALPAG(S1) ; Get the per stream storage pointer
HRRZ T1,.PSVFL(S2) ; Get the interrupt reason flags
ANDCAM T1,.PSVFL(S2) ; Clear them
SETZ T2, ; Init our mask of wake reasons
; TXNE T1,PS.RDO ; Did the disk just go offline?
; TXO T2,PSF%DF ; Yes, block the process
TXNE T1,PS.ROL ; Did the disk just come back on line?
TXO T2,PSF%DF ; Yes, unblock the task
TXNE T1,PS.RID ; Input done?
TXO T2,PSF%DI ; Yes, unblock if that's what we're waiting for
TXNE T1,PS.ROD ; Output done?
TXO T2,PSF%DO ; Yes, clear the condition
ANDCAM T2,FALSTW(S1) ; Reset any blocking bits
IORM T2,FALWAK(S1) ; And prevent race in DSCHD
$DEBRK ; And return from the interrupt
Subttl PSI Routines -- IPCINT - IPCF Message Available Interrupt Service Routine
; Here on an IPCF message available PSI interrupt. This handler will
; simply make the top level aware of the condition, and return from the
; interrupt.
; Calling sequence:
; (none, this is an interrupt service routine)
; All registers preserved
IPCINT: $BGINT 1 ; Preserve registers, etc
PUSHJ P,C%INTR ; Tell the top level about this
$DEBRK ; And return from the interrupt
Subttl SWIL Memory Manager -- .MMGWD - Get some Words of Memory
; This routine replaces the routine of the same name in SWIL. Since
; GLXLIB insists on being in charge of memory allocation, and since it
; does a better job than the default SWIL mechanism, we just intercept all
; calls to the default SWIL memory manager here, and forward them to the
; corresponding routine in GLXLIB.
; Calling sequence:
; S1/ number of words to allocate (SWIL's T1)
; PUSHJ P,.MMGWD ; Get a chunk of memory
; returns non-skip if allocation failure
; returns skip if success, pointer to block in S2 (SWIL's T2)
; Destroys S2 (SWIL's T2)
.MMGWD::PUSHJ P,M%GMEM ; Call GLXLIB's memory manager
; (which works just the way we want
; it to).
JUMPT .POPJ1 ; Take the good return if success
POPJ P, ; Else take the non-skip return
Subttl SWIL Memory Manager -- .MMFWD - Deallocate a Chunk of Memory
; This preforms the inverse of .MMGWD; that is it deallocates memory.
; Calling sequence:
; S1/ size of chunk to be deallocated (SWIL's T1)
; S2/ address of chunk to deallocate (SWIL's T2)
; PUSHJ P,.MMFWD ; Free some memory
; never returns non-skip
; returns skip when done
; Destroys no registers
.MMFWD::PUSHJ P,TSAV12## ; Save the registers we'll use
PUSHJ P,M%RMEM ; Go release the memory
JRST .POPJ1 ; And return happily
Subttl Operator Messages -- BEGJOB - Begin a FAL Job
; Here when a FAL stream has accepted a connection. This routine is
; called to notify the operator that we're talking to someone.
; Calling sequence:
; J/ pointer to the per stream storage
; STREAM/ current stream number
; J$SUSR/ username of accessing person
; J$SNOD/ node we're talking to
; PUSHJ P,BEGJOB ; Tell the operator
; returns non-skip always
; Destroys S1, S2 (SWIL's T1 and T2), updates J$RTIM
BEGJOB::TXNE S,S.QSRD ;[23] Is QUASAR dead?
POPJ P, ;[23] Yes, don't bother
PUSHJ P,I%NOW ; Get the current time
MOVEM S1,J$RTIM(J) ; Store for the checkpoints
MOVE S1,STREAM ; Get the stream number
MOVE S2,J$FTYP(J) ; Get the stream type
CAXE S2,IO.ANF ; ANF-10 node?
SKIPA S2,[[ASCIZ \DECnet\]] ; No, say it's DECnet
MOVEI S2,[ASCIZ \ANF-10\] ; Yes, say so
$WTOJ (Begin,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>,@FALOBA(S1))
POPJ P, ; Return
Subttl Operator Messages -- ENDJOB - End a FAL Job
; Here when a FAL stream has closed a FAL session. This routine is
; called to notify the operator that we're done talking to someone.
; Calling sequence:
; J/ pointer to the per stream storage
; STREAM/ current stream number
; J$SUSR/ username of accessing person
; J$SNOD/ node we're talking to
; PUSHJ P,ENDJOB ; Tell the operator
; returns non-skip always
; Destroys S1, S2 (SWIL's T1 and T2)
ENDJOB::TXNE S,S.QSRD ;[23] Is QUASAR dead?
POPJ P, ;[23] Yes, don't bother
MOVE S1,STREAM ; Get the stream number
SETZM FALCHK(S1) ; Say we want the status updated
MOVE S2,J$FTYP(J) ; Get the stream type
CAXE S2,IO.ANF ; ANF-10 node?
SKIPA S2,[[ASCIZ \DECnet\]] ; No, say it's DECnet
MOVEI S2,[ASCIZ \ANF-10\] ; Yes, say so
$WTOJ (End,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>,@FALOBA(S1))
POPJ P, ; Return
Subttl DAP Status messages -- DAPERR -- Processor
; This routine is called by the BADDAP macro to type an error message and
; send a DAP status message to the remote task to inform it of the error.
; Calling sequence:
; STREAM/ current stream number
; J/ per stream storage pointer
; PUSHJ P,@[EXP DAPERR ; Call the error processor
; EXP MAC!MIC ; DAP status
; EXP [ASCIZ ~TXT~] ; Error text
; EXP DIE] ; Address to resume from
; returns to DIE (defaults to call+1)
; Destroys no registers
IO==11 ; I/O CDB Address
DAPERR::$SAVE <S1,S2,T1,T2,T3,T4,P1> ; Save some registers
MOVE P1,-11(P) ; Get the return address
HRRZ P1,-1(P1) ; Get the argument block address
MOVE S1,1(P1) ; Get the DAP status <MACCODE!MICCODE>
LDB S2,[POINT 6,1(P1),23] ; Get the MACCODE by itself
CAIE S2,MA.SYN ; MACCODE indicate DAP msg out of sync?
JRST DAPE.0 ; No, full <MACCODE!MICCODE> is in S1
HRRZ S2,.IODIM(IO) ; Yes, get the MICCODE (i.e. msg type)
DPB S2,[POINT 12,S1,35] ; Now <MACCODE!MICCODE> is in S1
DAPE.0: CLEAR S2, ; No secondary status
PUSHJ P,FXSTS0## ; Send the status to the remote
JFCL ; Do not care here if link is gone
TXNE S,S.QSRD ; Is QUASAR dead?
JRST DAPE.1 ; Yes, don't bother
MOVE S1,[POINT 7,J$SMSG(J)] ; Point at the message buffer
MOVEM S1,TEXTBP ; Can use this as the pointer storage
MOVEI S1,<100*5>-1 ; Get the max string length
MOVEM S1,TEXTCT ; Store for DEPBP
MOVEI S1,DEPBP ; Get the address of the byte stuffer
PUSHJ P,.TYOCH## ; Swap SWIL's output routine
PUSH P,S1 ; Save the old one
HRRZ S1,2(P1) ; Get the text string
PUSHJ P,.TSTRG## ; Copy to our storage
SETZ S1, ; Then, null terminate
IDPB S1,TEXTBP ; the error string
MOVE T1,STREAM ; Get our stream number
LDB T3,[POINT 6,1(P1),23] ; Get the MACCODE
$WTOJ (<^T/@MACFLD(T3)/>,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error off
POP P,S1 ; Restore SWIL's old output routine
PUSHJ P,.TYOCH## ; Put it back
DAPE.1: MOVEI S1,@3(P1) ; Get the return address
MOVEM S1,-11(P) ; Set it as our return
POPJ P, ; Restore our ACs and return
MACFLD: [ASCIZ ~Pending~]
[ASCIZ ~Successful~]
[ASCIZ ~Unsupported~]
[ASCIZ ~Reserved~]
[ASCIZ ~File Open~]
[ASCIZ ~Transfer Error~]
[ASCIZ ~Transfer Warning~]
[ASCIZ ~Access Termination~]
[ASCIZ ~Format~]
[ASCIZ ~Invalid~]
[ASCIZ ~Sync~]
Subttl Operator Messages -- ERRMSG - STOPCD/ERROR/WARN/INFRM Processor
; Here from FALSWI on execution of a STOPCD, ERROR, WARN or INFRM
; macro. This routine is called by those macros to type an error message.
; In this case, typing an error message means sending a WTO to ORION so
; that everyone running OPR can see it.
; Calling sequence:
; STREAM/ current stream number
; J/ per stream storage pointer
; PUSHJ P,@[Z ERRMSG ; Call the error processor
; XWD type,[ASCIZ ~TXT~] ; Message type and error text
; Z RTN ; Additional output routine
; Z ADR ; Additional data for output routine
; Z DIE] ; Address to resume from
; returns to DIE (defaults to call+1)
; Destroys no registers
ERRMSG::$SAVE <S1,S2,T1,T2,T3,T4> ; Save some registers
TXNE S,S.QSRD ;[23] Is QUASAR dead?
JRST ERRM.3 ;[23] Yes, don't bother
MOVE T4,-10(P) ; Get the return address
HRRZ T4,-1(T4) ; Get the argument block address
MOVE S1,[POINT 7,J$SMSG(J)] ; Point at the message buffer
MOVEM S1,TEXTBP ; Can use this (I hope) as the pointer storage
MOVEI S1,<100*5>-1 ;[21] Get the max string length
MOVEM S1,TEXTCT ;[21] Store for DEPBP
MOVEI S1,DEPBP ; Get the address of the byte stuffer
PUSHJ P,.TYOCH## ; Swap SWIL's output routine
PUSH P,S1 ; Save the old one
HLRZ T3,1(T4) ; Get the message type
SKIPL T3 ; Out of range?
CAILE T3,.ETMAX ; ...
JRST ERRM.2 ; Yes, just punt the WTO
CAIE T3,.ETREJ ; Is this a rejection message?
JRST ERRM.0 ; No, skip this mess
MOVE S1,STREAM ; Get the stream number
MOVE S2,J$FTYP(J) ; Get the stream type
CAXE S2,IO.ANF ; ANF-10 node?
SKIPA S2,[[ASCIZ \DECnet\]] ; No, say it's DECnet
MOVEI S2,[ASCIZ \ANF-10\] ; Yes, say so
$TEXT (DEPBP,<Servicing ^T/@S2/ node ^W/J$SNOD(J)/ for userid ^T/J$SUSR(J)/>)
ERRM.0: HRRZ S1,1(T4) ; Get the text string
PUSHJ P,.TSTRG## ; Copy to our storage
SKIPN S2,2(T4) ; Did he request a routine?
JRST ERRM.1 ; No, don't even bother
SKIPE S1,3(T4) ; Did he give an address
MOVE S1,@S1 ; Yes, load the data
PUSHJ P,@S2 ; Call the processor
ERRM.1: SETZ S1, ; Then, null terminate
IDPB S1,TEXTBP ; the error string
MOVE T1,STREAM ; Get our stream number
$WTOJ (<^T/@MSGPFX(T3)/>,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error off
ERRM.2: POP P,S1 ; Restore SWIL's old output routine
PUSHJ P,.TYOCH## ; Put it back
ERRM.3: MOVEI S1,@4(T4) ; Get the return address
MOVEM S1,-10(P) ; Set it as our return
POPJ P, ; Restore our ACs and return
; A table of message types:
MSGPFX: [ASCIZ ~Information~]
[ASCIZ ~Begin~]
[ASCIZ ~End~]
[ASCIZ ~Connect rejected~]
[ASCIZ ~Warning~]
[ASCIZ ~Error~]
[ASCIZ ~Stream abort~]
[ASCIZ ~Received DAP protocol error~] ;[21]
IFN FTDEBUG,[ASCIZ ~Diagnostic warning~] ;[21]
Subttl Operator Messages -- FRCCHK - Force a Checkpoint
; Here when we've opened a new file to disk. This routine is called
; to force a checkpoint on this stream.
; Calling sequence:
; STREAM/ current stream number
; PUSHJ P,FRCCHK ; Force a checkpoint
; returns non-skip always
; Destroys no registers
FRCCHK::$SAVE <S1,S2> ; Save a couple of registers
PUSHJ P,I%NOW ; Get the current date and time
MOVE S2,J$LCHK(J) ; Get the last checkpoint time
ADDI S2,CHKMIN*3 ; Compute minimum checkpoint interval
CAMGE S1,S2 ; Have we passed that time yet?
MOVE S1,S2 ; Now, force the minimum interval
MOVE S2,STREAM ; Get the stream number
MOVEM S1,FALCHK(S2) ; Store the new checkpoint time
POPJ P, ; And return
Subttl Operator Messages -- NETERR - Report a Network Lossage Error
; Here if FAL decides that the network has gone away, which is the
; usual reason for one of the SWIL routines to take the error return.
; This routine will redirect the SWIL output routines to our cannonical
; string in memory, call the SWIL error routine to decode the error
; string, then WTO the message to OPR.
; Calling sequence:
; TF(M0)/ SWIL funny error number
; P3(IO)/ SWIL funny CDB pointer for SWIERM
; PUSHJ P,NETERI ; Network input error
; or
; PUSHJ P,NETERO ; Network output error
; returns non-skip always (what's the point of an error return here?)
; Destroys TF, S1, S2, T1, T2 (SWIL's M0, T1-T4)
NETERI::SKIPA T1,[.ERISR##] ; Save the input error routine addr
NETERO::XMOVEI T1,.EROSR## ; Get the output error routine addr
TXNE S,S.QSRD ;[23] Is QUASAR dead?
POPJ P, ;[23] Yes, don't bother
MOVE S1,[POINT 7,J$SMSG(J)] ; Get the string pointer
MOVEM S1,TEXTBP ; Store in the proper place
MOVEI S1,<<100*5>-1> ; Get the max string length
MOVEM S1,TEXTCT ; Store for the char putter
MOVEI S1,DEPBP ; Get the address of the char putter
PUSHJ P,.TYOCH## ; Go reset the output routine address
PUSH P,S1 ; Save the old routine address
MOVE S1,P3 ; Copy the CDB pointer
PUSHJ P,(T1) ; Go call the processor
SETZ S1, ; Get a null
IDPB S1,TEXTBP ; Terminate the string
MOVE T1,STREAM ; Get the stream number
$WTOJ (Error,<^T/J$SMSG(J)/>,@FALOBA(T1)) ; Send the error
POP P,S1 ; Restore the old output routine addr
PUSHJ P,.TYOCH## ; Go restore it
POPJ P, ; And return
Subttl Operator Messages -- .STOPCD - Abort a Stream
; Here when a stream decides that the best thing to do is to stop
; running. This will just type a message to the operator and mark the
; stream as having crashed.
; PUSHJ P,.STOPCD ; Go away
; never returns
.STOPCD::MOVE T1,STREAM ; Get our stream number
TXNN S,S.QSRD ;[23] Is QUASAR dead?
$WTOJ (<Stream shutting down>,<Aborting stream>,@FALOBA(T1))
SETZM FALCHK(T1) ; Say we want the status updated
MOVX TF,PSF%CR ; Say we've crashed
PUSHJ P,DSCHD ; Deschedule this task
JRST .-2 ; In the unlikely event that it returns
Subttl Dummy SWIL Routines -- .ASKYN, .ASKNY
; A couple of dummy entries to satisfy some SWIL externals. These
; will always give the non-skip (error return).
.ASKNY:: ; Ask Yes or No
.ASKYN:: ; Ask No or Yes
.DFLND:: ; Ask for userid, password, etc.
ONERCK:: ; /OKERR checker
POPJ P, ; Error return
; Some randy error messages:
ERRCDI::STOPCD (CDI,HALT,,Can't initialize input CDB)
ERRCDO::STOPCD (CDO,HALT,,Can't initialize output CDB)
Subttl End of FALQSR
PRGEND
TITLE FAL NFT File Access Listener module
SUBTTL Robert Houk/RDH
SEARCH JOBDAT,MACTEN,UUOSYM ;STANDARD DEFINITIONS
SEARCH FALUNV ;FAL DEFINITIONS
SEARCH SWIL ;SWIL PACKAGE DEFINITIONS
SEARCH ACTSYM ;GET SOME ACTDAE INTERFACE SYMBOLS
SALL ;PRETTY LISTINGS
.DIREC FLBLST ;PRETTIER LISTINGS
.TEXT \REL:SWIL/S/EXCLUDE:.POPJ/INCLUDE:.ERROR/SEGMENT:LOW,REL:GLXLIB/SUPPRESS:(.SAVE1,.SAVE2,.SAVE3,.SAVE4)/S/INCLUDE:GLXINI\
COMMENT \
FAL -- NFT "File Access Listener" module
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1988,1990.
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 TIS
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
\
SUBTTL Definitions -- Accumulator Usage
; Define our accumulator usage here:
M0==0 ;RETURNED STATUS
T1==1 ;TEMPORARIES
T2==2
T3==3
T4==4
P1==5 ;PRESERVED
P2==6
P3==7
P4==10
NM==7 ;SWIL'S PLACE TO PUT A NUMBER
CH==10 ;SWIL'S PLACE TO PUT A CHARACTER
IO==11 ;CURRENT CDB
ID==12
CI==13 ;INPUT CDB
CO==14 ;OUTPUT CDB
J==15 ;PER STREAM DATA STORAGE POINTER
S==16 ;STATUS FLAGS WORD
P==17 ;STACK POINTER
;NONPP - Routine to check for and disallow NETPPN access
NONPP1: MOVE M0,.IOPPN(CI) ;GET ACCESSING PPN
CAME M0,NETPPN ;IS IT NETPPN?
JRST .POPJ1## ;NO, NO PROBLEM
MOVEI M0,$EFPRT ;YES, DISALLOW WITH A "PRIVILEGE VIOLATION"
POPJ P, ;AND TELL CALLER TO FLICK THIS REQUEST IN
SUBTTL FAL initialization -- FALINI set FAL job parameters
;FALINI -- INITIALIZE FAL JOB RUNTIME PARAMETERS
;Call is:
;
; PUSHJ P,FALINI
; error return
; normal return
;
;FALINI sets up FAL's runtime job parameters so that FAL stands a chance
;of working:
;
; 1) Set program name to "FAL-10" 'cuz it looks purty
;
; 2) DSKFUL ERROR so that error codes returned to FAL rather
; than stopping the job and barfing on the "user"
;
; 3) LOCATE 0 so that batch/etc. submissions via QUEUE. UUO
; work right (else batch jobs end up on a DN87's "processor"
; queue! Amusing, but...)
;
; 4) SPOOL ALL so that randoms from remote places can't tie up
; real lineprinters or whatever. This is somewhat dubious,
; but since DAP doesn't give the user choice of real or
; spooled, this is the most "practical" choice . . .
;
;The error return is not exercised.
;
;Uses T1, T2.
FALINI::SETZM BZFAL ;CLEAR OUT AND INITIALIZE IMPURE DATA
MOVE T1,[BZFAL,,BZFAL+1] ;BLT POINTER TO
BLT T1,EZFAL-1 ;CLEAN OUT DATA AREAS
;SET PROGRAM NAME TO "FAL-10"
MOVE T2,['FAL-10'] ;TENTATIVE NAME
SETNAM T2, ;DECLARE MORE MEANINGFUL PROGRAM NAME
;SET THE JOB'S MESSAGE WATCH BITS TO FIRST, NO PREFIX
HRROI T1,.GTWCH ;[21] GET THIS JOB'S
GETTAB T1, ;[21] WATCH BITS
SETZ T1, ;[21] NONE?
ANDX T1,JW.WAL ;[21] GET RID OF THE OLD MESSAGE BITS
TXO T1,JW.WFL ;[21] SET FIRST ONLY
HLRZS T1 ;[21] PUT IN A SETUUOABLE PLACE
HRLI T1,.STWTC ;[21] GET THE SET WATCH SETUUO FUNCTION
SETUUO T1, ;[21] RESET OUR WATCH BITS
JFCL ;[21] OH WELL, IT'S NOT THAT IMPORTANT
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;SET DSKFUL ERROR SO GET ERRORS WE CAN RETURN TO REMOTE ACCESSOR
MOVE T1,[.STDFL,,.DFERR] ;ARGUMENT TO SETUUO TO
SETUUO T1, ;SET DSKFUL ERROR
WARN DFL,<Can't set DSKFUL ERROR>
;LOCATE TO CENTRAL HOST SO BATCH JOB SUBMISSION A LA QUEUE. UUO WORKS
SETZ T1, ;0 = CENTRAL HOST
LOCATE T1, ;PUT US THERE TO NOT CONFUSE GALAXY
WARN LCS,<Can't LOCATE to central site>
;SET SPOOL ALL (IT'S A COP OUT, BUT DAP DOESN'T GIVE US PROPER CONTROL!)
MOVE T1,[.STSPL,,JS.PAL] ;SETUUO ARGUMENT TO
SETUUO T1, ;SET SPOOL ALL
WARN SPL,<Can't SET SPOOL ALL>
;[55] SET ADMINISTRATIVE PRIVILEGES, SO WE CAN DO ACCOUNTING FUNCTIONS
MOVE T1,[.STPRV,,[EXP .STCPS,JP.ADM]] ;[55] SETUUO ARGUMENT TO
SETUUO T1, ;[55] LIGHT JP.ADM IN JBTPRV
WARN AMF,<Administrative privilege failure>
;INITIALIZE USERS.TXT FOR "USERID" NAME TO PPN TRANSLATION
IFN FTUTXT,< ;IF TRANSLATING NAMES TO PPNS, THEN
PUSHJ P,UTXINI ;INITIALIZE USERS.TXT TRANSLATION BUFFER
WARN UTX,<Couldn't initialize USERS.TXT name<=>ppn translation>
> ;END IFN FTUTXT
;CALL .ISCAN SO'S TO INITIALIZE ALL THE GOOD STORAGE
MOVE T1,[ISLEN,,ISBLK] ;GET THE .ISCAN ARG BLOCK POINTER
PUSHJ P,.ISCAN## ;INITIALIZE SCAN/SWIL
XMOVEI T1,.POPJ## ;GET A NICE NULL ROUTINE
PUSHJ P,.TYOCH## ;MAKE SURE SPURIOUS SWIL OUPTUT GETS FLUSHED
MOVX T1,$NTPPN ;GET THE DEFAULT NETPPN
MOVEM T1,NETPPN ;STORE IT
POPJ P, ;RETURN
SUBTTL FAL initialization -- UTXINI initialize USERS.TXT buffer
;UTXINI -- INITIALIZE USERS.TXT BUFFER
;Call is:
;
; PUSHJ P,UTXINI
; return
;
;On return, UTXCTR and UTXPTR are the byte counter and pointer to the
;USERS.TXT name to ppn translation buffer, or 0 if no translation is to
;be performed.
;
;*** This routine needs much smartening . . .
;
;Uses T1 - T4, P1 - P4.
IFN FTUTXT,<
UTXINI: OPEN UTX,[.IODMP ;DUMP MODE I/O HERE FOR CONVENIENCE
'SYS ' ;FROM DEVICE SYS:
0,,0] ;WITH NO RING HEADERS
JRST UTXIE0 ;NO, BOMB IT OUT
MOVE P1,.JBFF ;ADDRESS OF START OF BUFFER AREA
MOVEI T1,.RBSIZ+1(P1) ;END ADDRESS OF LOOKUP BLOCK
CORE T1, ;ALLOCATE MEMORY FOR LOOKUP BLOCK
JRST UTXIE5 ;CAN'T EVEN GET A LOOKUP BLOCK???
MOVEI T1,.RBSIZ+1 ;EXTENDED LOOKUP BLOCK LENGTH
MOVEM T1,.RBCNT(P1) ;SET IN THE LOOKUP BLOCK
SETZM .RBPPN(P1) ;NO EXPLICIT PATH
DMOVE T1,[EXP 'USERS ','TXT '] ;USERS.TXT
DMOVEM T1,.RBNAM(P1) ;SET IN THE LOOKUP BLOCK
LOOKUP UTX,(P1) ;SEE IF THE FILE IS AVAILABLE
JRST UTXIEL ;NO, BOMB IT OUT
SKIPG P2,.RBSIZ(P1) ;[12] SIZE OF FILE (DATA WORDS WRITTEN)
JRST UTXIEZ ;[12] EMPTY FILE, IGNORE IT.
MOVE T1,P1 ;ADDRESS OF START OF BUFFER
ADDI T1,-1(P2) ;ADDRESS OF END OF BUFFER
CORE T1, ;MAKE SURE THE BUFFER WILL FIT
JRST UTXIE5 ;NO, BOMB IT OUT
MOVN T1,P2 ;IOWDS WANT NEGATIVE LENGTH
HRLZ T1,T1 ; IN THE LEFT HALF
HRRI T1,-1(P1) ;AND ADDRESS-1 IN THE RIGHT HALF
SETZ T2, ;TERMINATE THE I/O LIST
IN UTX,T1 ;READ IN USERS.TXT
CAIA ;BINGO!
JRST UTXIE6 ;NO, BOMB IT OUT
RELEAS UTX, ;WE ARE DONE WITH THE FILE NOW
HRLI P1,(POINT 7,) ;BYTE POINTER TO USERS.TXT BUFFER
MOVEM P1,UTXPTR ;REMEMBER USERS.TXT BUFFER POINTER
IMULI P2,5 ;BYTE COUNTER FOR USERS.TXT BUFFER
MOVE P3,P1 ;BYTE POINTER TO WRITE USERS.TXT
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;STILL IFN FTUTXT
;USERS.TXT contains ASCII ppn<=>name correspondences of the form
;"dev:[p,pn],name" (this format is defined by the MS mail proggie).
;Internally, they will be compressed to just "[p,pn]name<LF>" form.
UTXIN2: PUSHJ P,UTXGT1 ;GET ONE USERS.TXT CHARACTER
JRST UTXIN9 ;DONE, REMEMBER IT
CAIE T1,"[" ;START OF PPN YET?
JRST UTXIN2 ;NO, SKIP REST OF DEVICE PORTION
UTXIN3: PUSHJ P,UTXPT1 ;YES, SAVE START OF PPN FIELD
JRST UTXIE7 ;NO, BOMB OUT
PUSHJ P,UTXGT1 ;GET NEXT USERS.TXT CHARACTER
JRST UTXIN9 ;DONE
CAIE T1,"]" ;END OF PPN PART YET?
JRST UTXIN3 ;NO, STILL PPN, SAVE IT
PUSHJ P,UTXPT1 ;YES, CAP OFF PPN
JRST UTXIE7 ;BOMB IT OUT
PUSHJ P,UTXGT1 ;NEXT INPUT CHARACTER
JRST UTXIN9 ;DONE
CAIE T1,"," ;SHOULD BE A COMMA
JRST UTXIN2 ;NO, JUST RESTART, JUNKING THIS ENTRY . . .
UTXIN5: PUSHJ P,UTXGT1 ;GET NAME CHARACTER
JRST UTXIN9 ;DONE
PUSHJ P,UTXPT1 ;AND SAVE IT TOO
JRST UTXIE7 ;DOMB IT OUT
CAIE T1,.CHLFD ;END OF PPN<=>NAME ENTRY?
JRST UTXIN5 ;NO, FINISH OFF NAME
JRST UTXIN2 ;YES, DO NEXT ENTRY
;Here when completed successfully
UTXIN9: MOVEI T1,.CHLFD ;A <LF> CHARACTER
PUSHJ P,UTXPT1 ;ENSURE USERS.TXT BUFFER ENDS WITH A <LF>
JRST UTXIE7 ;HOW INCONVENIENT A PLACE TO BOMB
TDZA T1,T1 ;A NULL CHARACTER
IDPB T1,P3 ;STASH ANOTHER NULL
TXNE P3,74B5 ;BYTE POINTER FILLED UP A WORD YET?
JRST .-2 ;NO, ZERO-FILL THE WORD
MOVEI P1,1(P3) ;END ADDRESS+1 OF USERS.TXT BUFFER
MOVE T2,.JBFF ;START ADDRESS OF USERS.TXT BUFFER
SUBM P1,T2 ;T2:=COUNT OF WORDS IN BUFFER
IMULI T2,5 ;T2:=COUNT OF BYTES IN BUFFER
MOVEM T2,UTXCTR ;SAVE BYTE COUNTER FOR UTXPTR
MOVEM P1,.JBFF ;MARK THAT WE NOW OWN USERS.TXT BUFFER
MOVEM P1,CMDFF## ;TELL REST OF WORLD TOO
MOVEM P1,SAVFF## ;TELL REST OF THE UNIVERSE ALSO
HRLM P1,.JBSA ;*** FINALLY, TELL EVEN THE GODS . . .
JRST .POPJ1## ;HAPPY
;STILL IFN FTUTXT
;Here when error setting up USERS.TXT
UTXIEL: HRRZ T1,.RBEXT(P1) ;RETRIEVE LOOKUP ERROR CODE
CAIN T1,ERPRT% ;PROTECTION FAILURE?
JRST UTXIE1 ;YES
CAIN T1,ERTRN% ;RIB/DIRECTORY ERROR?
JRST UTXIE2 ;YES
CAIE T1,ERFNF% ;FILE NOT FOUND?
JRST UTXIE3 ;RANDOM ERROR
INFRM UTM,<No SYS:USERS.TXT file, no names <=> ppn translation will be performed>
UTXIEZ: AOS (P) ;[12] TAKE HAPPY (ALBEIT FAILED IN THIS CASE) RETURN
PJRST UTXINE ;BLAST AWAY THE I/O CHANNEL
UTXIE0: ERROR UT0,<Can't OPEN device SYS: for SYS:USERS.TXT>,,,UTXINE
UTXIE1: ERROR UT1,<Protection failure reading file SYS:USERS.TXT>,,,UTXINE
UTXIE2: ERROR UT2,<RIB error reading file SYS:USERS.TXT>,,,UTXINE
UTXIE3: ERROR UT3,<Can't LOOKUP file SYS:USERS.TXT>,,,UTXINE
UTXIE5: ERROR UT5,<Can't get memory to read SYS:USERS.TXT>,,,UTXINE
UTXIE6: ERROR UT6,<Can't read file SYS:USERS.TXT>,,,UTXINE
UTXIE7: ERROR UT7,<Format error reading SYS:USERS.TXT>,,,UTXINE
UTXINE: RELEAS UTX, ;STOMP ON I/O CHANNEL
SETZM UTXPTR ;MARK NO USERS.TXT BUFFER
MOVE T1,.JBFF ;START OF BUFFER
CORE T1, ;DEALLOCATE NOW-USELESS BUFFER
JFCL ;HO HUM
POPJ P, ;AND THAT IS THAT
;STILL IFN FTUTXT
;UTXGT1 - GET ONE USERS.TXT CHARACTER
UTXGT1: SOJL P2,.POPJ## ;ERROR IF NO MORE
ILDB T1,P1 ;NEXT INPUT CHARACTER
JUMPE T1,UTXGT1 ;SUPPRESS NULLS
CAIN T1,.CHCRT ;<CR>?
JRST UTXGT1 ;YES, JUST RETURN THE <LF>
CAIE T1," " ;SPACE?
CAIN T1,.CHTAB ; OR TAB?
JRST UTXGT1 ;YES, SUPPRESS
CAIE T1,";" ;COMMENT?
CAIN T1,"!" ; ALTERNATE COMMENT?
JRST UTXGT3 ;YES, EAT IT UP
CAIL T1,"a" ;LOWERCASE ALPHA?
CAILE T1,"z" ; . . .
JRST .POPJ1## ;NO, RETURN VALID CHARACTER
SUBI T1,"a"-"A" ;SHIFT TO UPPERCASE ALPHA
JRST .POPJ1## ;AND RETURN IT
UTXGT3: SOJL P2,.POPJ## ;ERROR IF NO MORE
ILDB T1,P1 ;NEXT CHARACTER
CAIN T1,.CHLFD ;END OF LINE (COMMENT) YET?
JRST UTXGT3 ;NO, KEEP EATING
JRST .POPJ1## ;YES, RETURN END OF LINE
;UTXPT1 -- WRITE ONE USERS.TXT CHARACTER
UTXPT1: IDPB T1,P3 ;STASH VALID CHARACTER
JRST .POPJ1## ;ALL DONE!
> ;END IFN FTUTXT
SUBTTL Main FAL processing loop
FALL:: TXZ S,S.CLR ;CLEAR THE PER CONNECTION BITS
PUSHJ P,FALLI ;INITIALIZE A FAL JOB PROCESS
JRST FALL70 ;CHECK OUR ERROR
TXZE S,S.KILL ;DID WE JUST ABORT A TRANSFER?
JRST FALL ;YES, START A NEW ONE THEN
TXNN S,S.SHUT ;ARE WE SUPPOSED TO SHUT DOWN?
JRST FALL ;NO, TRY FOR ANOTHER SESSION
SETZ T1, ;YES, SAY WE'RE SHUTTING DOWN NORMALLY
POPJ P, ;AND FINISH THIS STREAM OFF
;HERE ON ERROR FROM FALLI
FALL70: TXZE S,S.KILL ;DID WE JUST ABORT A TRANSFER?
JRST FALL ;YES, START A NEW ONE THEN
CAIE M0,$EFUID ;DID WE REJECT THE USER ID?
CAIN M0,$EFUAC ;DID WE REJECT THE USER ACCOUNT DATA?
JRST FALL77 ;YES, RETRY IMMEDIATELY
CAIN M0,$EINLA ;DID LINK "TERMINATE" NORMALLY?
JRST FALL77 ;YES, RETRY IMMEDIATELY
CAIN M0,$EFNNS ;GOT ANY NETWORK SOFTWARE?
JRST [MOVEI T1,$FSNNS ;SAY NO NETWORK SOFTWARE
POPJ P,] ;RETURN TO TOP LEVEL
CAIN M0,$EFPRV ;PRIVILEGE VIOLATION?
JRST [MOVEI T1,$FSISP ;SAY NO PRIVS
POPJ P,] ;RETURN TO SETUP PROCESSOR
;LINK TERMINATED ABNORMALLY - USE SLIDING WAIT INTERVAL TO ALLOW
;THE WORLD TO CALM DOWN
MOVE M0,J$FSLP(J) ;GET THE SLEEPER VALUE
SKIPN M0 ;ANY VALUE SET?
MOVEI M0,1 ;NONE, START WITH 1
LSH M0,1 ;DOUBLE THE INTERVAL
CAILE M0,^D64 ;TIME GOTTEN TOO BIG?
MOVEI M0,^D64 ;YES, PEG AT ABOUT ONE MINUTE WAITS
MOVEM M0,J$FSLP(J) ;SAVE FOR NEXT TIME
TXO M0,PSF%SL ;SAY WE'RE SLEEPING
PUSHJ P,DSCHD## ;DESCHEDULE FOR A WHILE
TXNN S,S.SHUT ;SHOULD WE SHUT DOWN?
JRST FALL ;NO, NOW TRY AGAIN
SETZ T1, ;YES, GET THE REASON
POPJ P, ;AND RETURN
FALL77: JRST FALL ;JUST TRY AGAIN IMMEDIATELY
;INITIALIZE ONE FAL JOB PROCESS
FALLI: MOVE P1,J$FTYP(J) ;SELECT EITHER ANF (IO.ANF) OR DECNET (IO.DCN)
SETZM J$RTIM(J) ;FLAG THAT WE HAVEN'T DONE ANYTHING YET
PUSHJ P,FALJB ;FIRE UP A SINGLE FAL JOB STREAM
SKIPA P1,M0 ;SAVE ERROR CODE FROM FALJB
SETZ P1, ;FLAG NO ERROR
TXZ S,S.OPEN!S.CONN ;[16] NO FILES OPEN ANYMORE
SKIPE IO,CI ;[14] GET THE NETWORK CDB POINTER
SKIPN .IONCH(IO) ;[14] ANY CHANNEL OPEN HERE?
JRST FALLI1 ;[14] NO, DON'T TRY TO CLOSE IT THEN
MOVE IO,CI ;[14] YES, GET THE CDB ADDRESS
SETZ T3, ;[14] NO OPTIONAL DATA ON ABORT
PUSHJ P,NTNAB1## ;[14] GO ABORT THIS CONNECTION
JFCL ;[14] NOT REAL FATAL IF ERROR HERE
FALLI1: PUSHJ P,INTDIS## ;DISCONNECT AND/OR CLEAR INTERRUPT ENABLES
JFCL ;ERROR IS MEANINGLESS HERE
SKIPN IO,CO ;[14] GET THE SLAVE CDB ADDRESS
JRST FALLI3 ;[14] NO, DON'T TRY TO CLOSE IT THEN
PUSHJ P,IOZAP1## ;[37] KILL OFF ANYTHING THAT'S STILL AROUND
JFCL ;[37] DON'T WORRY ABOUT ERRORS
FALLI3: PUSHJ P,INDDIS## ;DISCONNECT FROM DISK INTERRUPTS
JFCL ;DON'T WORRY ABOUT ERRORS HERE
SKIPE J$RTIM(J) ;DID WE DO ANYTHING?
PUSHJ P,ENDJOB## ;YES, SAY WE'RE DONE WITH THIS SESSION
FALLI2: SKIPN T2,CI ;PRIMARY CDB ADDRESS
JRST FALLI4 ;NONE?
SKIPN T1,.IOXSZ(T2) ;SIZE OF CDB ALLOCATED
MOVE T1,.IOSIZ(T2) ;SIZE OF CDB ALLOCATED
PUSHJ P,.MMFWD## ;DEALLOCATE THE CDB
DEBUG <Deallocation of primary CDB failed at FALLI2>
FALLI4: SKIPN T2,CO ;SLAVE CDB ADDRESS
JRST FALLI6 ;NONE
SKIPN T1,.IOXSZ(T2) ;SIZE OF CDB ALLOCATED
MOVE T1,.IOSIZ(T2) ;SZIE OF CDB ALLOCATED
PUSHJ P,.MMFWD## ;DEALLOCATE THE CDB
DEBUG <Deallocation of slave CDB failed at FALLI4>
FALLI6: JUMPE P1,.POPJ1## ;RETURN HAPPILY IF SUCCESSFUL
MOVE M0,P1 ;RESTORE ERROR CODE TO STATUS REGISTER
POPJ P, ;AND PROPAGATE FALJB'S ERROR
SUBTTL FAL "JOB" process
;STARTUP A FAL PROCESS
FALJB: SETZB CI,CO ;NO CDB'S ALLOCATED YET
;ALLOCATE AND INITIALIZE PRIMARY CDB FOR THE NETWORK-BASED LINK
MOVEI T2,FALIV ;FAL'S INIT STUFF
PUSHJ P,.IOINA## ;ALLOCATE AND INITIALIZE PRIMARY CDB
JRST ERRCDI## ;DUH?
MOVE CI,T1 ;REMEMBER PRIMARY CDB ADDRESS
;FROM HERE ON FAL OPERATES IN A "NATIVE" MODE RE THE I/O PACKAGE, FREELY
;USING T1 - P4, AND IO AS THE I/O CDB INDEX.
;
;THIS SAVES OODLES OF AC PUSHING/SHOVING/POPPING!
MOVE IO,CI ;SELECT THE PRIMARY CDB
IORM P1,.IOCCF(IO) ;SELECT REQUESTED NETWORK PROTOCOL
MOVEI T1,SCHEDL ;GET THE SCHEDULER ADDRESS
MOVEM T1,.IOSCH(IO) ;STORE FOR SWIL
;SETUP THE DESTINATION (THAT'S US) PROCESS DESCRIPTOR BLOCK
FALOBJ:!MOVX T3,<0,,21> ;GENERIC FAL FORMAT/OBJECT TYPE
MOVEM T3,.IONDF(IO) ;SET IN THE CDB
SETZM .IONDP(IO) ;NO PPN SPECIFIED
SETZM .IONDN(IO) ;NOR ANY SPECIFIC PROCESS NAME
;SETUP THE SOURCE (REMOTE NFT/ETC.) PROCESS DESCRIPTOR BLOCK
MOVX T3,<0,,-1> ;GENERIC ANYTHING FORMAT/OBJECT TYPE
MOVEM T3,.IONSF(IO) ;SOURCE FORMAT/OBJECT (DON'T CARE)
SETZM .IONSP(IO) ;SOURCE PPN (DON'T CARE)
SETZM .IONSN(IO) ;SOURCE NAME (DON'T CARE)
;NO OTHER RESTRICTIONS EITHER
SETZM .IONUS(IO) ;USER ID (DON'T CARE)
SETZM .IONPW(IO) ;USER PASSWORD (DON'T CARE)
SETZM .IONAC(IO) ;USER ACCOUNT STRING (DON'T CARE)
SETZM .IONUD(IO) ;USER DATA (DON'T CARE)
;TELL MONITOR WHAT WE'RE UP TO
FALJ20: SETZ T2, ;ANY NODE OK
PUSHJ P,NTNIP1## ;INITIALIZE A PASSIVE NETWORK CHANNEL
POPJ P, ;OOPS - NETWORK NOT BEING COOPERATIVE
MOVE T1,.IONCH(IO) ;GET THE NETWORK CHANNEL NUMBER
PUSHJ P,SETCHN## ;SETUP INTERRUPTS ON THIS CHANNEL
JRST [PUSHJ P,NTFIN1## ;ERROR, BLOW OFF THIS CHANNEL
JFCL ;PUNT ANY ERRORS HERE
MOVEI M0,$EEXXX ;GET A GENERIC ERROR CODE
POPJ P,] ;AND BLOW US OFF
;NOW WAIT FOR SOMEONE, SOMEWHERE, SOMETIME, . . .
FALJ30: MOVX M0,PSF%CW ;SAY WE'RE WAITING FOR A CONNECTION
PUSHJ P,DSCHD## ;GO AWAY FOR A WHILE
TXNE S,S.SHUT!S.KILL ;ARE WE SHUTTING DOWN?
JRST [PUSHJ P,NTNRL1## ;YES, BLOW OFF THIS CHANNEL
JFCL ;PUNT ERROR RETURNS HERE
SETZ M0, ;FLAG NORMAL SHUTDOWN
POPJ P,] ;RETURN
PUSHJ P,NTNCW1## ;GO RECEIVE THE CONNECT INITIATE DATA
POPJ P, ;HMMM - A RECALCITRANT NOTWORK
TXO S,S.CONN ;SAY WE'RE CONNECTING
MOVE T1,.ION6M(IO) ;GET THE SIXBIT NODE NAME
MOVEM T1,J$SNOD(J) ;LET FALGLX KNOW ABOUT IT TOO
SETZM J$SBYT(J) ;SAY NO BYTES MOVED YET
;WE HAVE A CONNECT, SEE IF WE ARE WILLING TO CONSIDER IT
FALJ32: MOVX T1,%CNSTS ;GETTAB POINTER TO
GETTAB T1, ;READ THE SYSTEM "STATES" FLAGS
SETZ T1, ;DUH?
TXNE T1,ST%NRT!ST%NLG;DEBUGGING/ETC?
JRST FALJR0 ;YES, REJECT "ABORT BY DIALOG PROCESS"
MOVX T1,%NSKTM ;GETTAB POINTER TO
GETTAB T1, ;READ THE KSYS TIMER VALUE
SETZ T1, ;DUH?
JUMPL T1,FALJR1 ;REJECT "NODE SHUTTING DOWN"
XMOVEI P1,.IONUS(IO) ;POINT AT THE ORIGINAL USERNAME STRING
XMOVEI T1,J$SUSR(J) ;POINT AT THE DESTINATION
PUSHJ P,F8BAZ ;CONVERT TO ASCIZ NAME STRING
JFCL ;DON'T WORRY ABOUT AN ERROR HERE
XMOVEI P1,.IONUS(IO) ;ADDRESS OF USER ID STRING
HLRZ T1,@P1 ;GET USER ID STRING LENGTH (IF ANY)
LDB T2,[POINT 8,.IONUS+1(IO),7] ;*** PEEK AT FIRST BYTE
CAIN T2,0 ;*** ANYTHING THERE?
SETZ T1, ;*** NO - VAX SENDS 4 NULLS!!!!!
JUMPE T1,[SKIPN T1,NETPPN ;FETCH DEFAULT USER NETPPN
JRST FALJR2 ;NONE, REJECT USERID
MOVEM T1,.IOPPN(IO) ;SET DEFAULT "ON-BEHALF-OF" PPN
DMOVE T1,[EXP 'NETWOR', 'K USER'] ;FAKE UP A USER NAME
DMOVEM T1,.IOQ6N(IO) ;SET DEFAULT USER NAME TOO
DMOVE T1,[ASCII ~Network us~] ;THEN, COPY THE
DMOVEM T1,J$SUSR(J) ;ASCII VERSION OF THAT
MOVE T1,[ASCIZ ~er~] ;TO THE PER STREAM
MOVEM T1,J$SUSR+2(J) ;STORAGE
SETZM .IOACT(IO) ;WITH NO ACCOUNT STRING
JRST FALJ34] ;AND ALLOW THE NETWORK CONNECTION
PUSHJ P,F8BUP ;CONVERT 8-BIT USERID STRING INTO PPN
JRST FALJR2 ;CAN'T MAKE A PPN, JUNK USER ID
MOVEM T1,.IOPPN(IO) ;STORE "ON-BEHALF-OF" PPN
TXNE S,S.PROF ;[31] DO WE HAVE THE USER'S PROFILE?
JRST FALJ33 ;[31] YES, DON'T GET IT THEN
XMOVEI T4,J$ABLK-1(J) ;[31] POINT AT THE ARGUMENT BLOCK STORAGE
PUSH T4,[QF.RSP!.QUMAE] ;[31] SAY WE WANT TO TALK TO ACTDAE
PUSH T4,[0] ;[31,55] SET THE NODE TO CENTRAL
XMOVEI T2,J$ARSP(J) ;[31] POINT AT THE RESPONSE STORAGE
HRLI T2,ARSPLN ;[31] GET THE NUMBER OF WORDS WE CAN PLAY WITH HERE
PUSH T4,T2 ;[31] PUT IN THE ARG BLOCK
PUSH T4,[QA.IMM!<1,,.QBAFN>] ;[31] GET THE SUBFUNCTION ARGUMENT TYPE
PUSH T4,[EXP AF.PRV!UGOUP$] ;[31,55] SAY WE WANT THE USER PROFILE
PUSH T4,[QA.IMM!<1,,.UGPPN>] ;[31] SAY WE'RE SUPPLYING THE PPN
PUSH T4,T1 ;[31] STORE THE USER'S PPN
ANDI T4,-1 ;[31] GET RID OF JUNK IN THE LEFT HALF
SUBI T4,J$ABLK-1(J) ;[31] COMPUTE THE NUMBER OF WORDS WE FILLED IN
XMOVEI T2,J$ABLK(J) ;[31] POINT AT THE ARGUMENT BLOCK
HRL T2,T4 ;[31] COPY THE BLOCK LENGTH
QUEUE. T2, ;[31] ASK FOR THE PPN FOR THIS GUY
SETZM .AEACC+J$ARSP(J) ;[31,33] NO PROFILE? ASSUME NO FAL PRIVS
FALJ33: SKIPE T2,.AEACC+J$ARSP(J) ;[31,33] GET THE JOB'S PROFILE BITS
TXO S,S.PROF ;[31] YES, REMEMBER THAT WE DID
TXNE S,S.PROF ;[31] DID WE GET A PROFILE?
PUSHJ P,NAM826 ;[31] YES, STORE IT IN .IOQ6N
TXNN S,S.NPPN ;[31] IS THIS THE NETWORK ACCESS PPN?
TXNE T2,AE.FAL ;[31] NO, DO WE HAVE FILE ACCESS PRIVS?
SKIPA ;[32] YES, GO ON
JRST FALJR6 ;[32] NO, REJECT THE USERID
FALJ34: PUSHJ P,FALCR1 ;SEE IF NODE/PPN REJECTED BY COMMAND
JRST FALJR5 ;[32] YES, REJECT USERID
XMOVEI P1,.IONAC(IO) ;ADDRESS OF USER ACCOUNT STRING
XMOVEI T1,.IOACT(IO) ;WHERE TO STORE ASCIZ STRING
PUSHJ P,F8BAZ ;COPY AND ASCIZIZE STRING
JRST FALJR4 ;JUNK ACCOUNT STRING
MOVSI T1,J$SPSW(J) ;[42] CLEAR THE OLD
HRRI T1,J$SPSW+1(J) ;[42] PASSWORD STRING
SETZM J$SPSW(J) ;[42] ...
BLT T1,J$SPSW+PSWDWD-1(J) ;[42]
XMOVEI P1,.IONPW(IO) ;ADDRESS OF USER ID PASSWORD
XMOVEI T1,J$SPSW(J) ;POINT TO THE PASSWORD STRING STORAGE
PUSHJ P,F8BAZ8 ;[34] CONVERT 8-BIT STRING INTO 6-BIT WORD
JRST FALJR4 ;JUNK PASSWORD STRING
;VERIFY THE USERID/PASSWORD/ACCOUNT
FALJ37: DMOVE P1,.IOQ6N(IO) ;[32] SAVE THE USERNAME 'CAUSE SWIL STOMPS IT
MOVE T2,.IOPPN(IO) ;RETRIEVE COPY OF ACCESSING PPN
CAMN T2,NETPPN ;IS THIS THE DEFAULT USER PPN?
JRST FALJ40 ;YES, THEN IT WORKS.
XMOVEI T3,J$SPSW(J) ;POINT TO THE PASSWORD IN T3
MOVEI T2,.QUMAE ;ACCESS VALIDATION
PUSHJ P,QUEOP0## ;[32] ASK ACTDAE IF USER IS A GOOD GUY
SKIPA T2,M0 ;CAN'T VALIDATE USERID/ETC.
JRST FALJ40 ;USERID/ETC OK, USER NAME/ETC SETUP
JSP T4,.CDISP## ;DISPATCH BASED ON ERROR
FALJR2,,$EQILP ;ILLEGAL PPN/USERID
FALJR2,,$EQIPW ;INVALID PASSWORD
FALJR3,,$EQIVA ;INVALID ACCOUNT STRING
0 ;NO OTHERS RETURN AN ERROR
;HERE WHEN CAN'T VALIDATE USERID/ETC., REJECT UNLESS DEBUGGING
FALJ3A: CAIN M0,$EQCNR ;"COMPONET NOT RUNNING"? (I.E., NO ACTDAE)
ERROR ANR,<ACTDAE not running, can't validate USERID/etc.>,,,FALJR4
CAIE M0,$EQPRA ;LACKING PRIVILEGES TO DO ACCOUNTING?
DEBUG <QUEUE. UUO failed for FALJ40>,,,FALJR4
MOVE T1,.MYPPN## ;GET MY JOB'S PPN
CAME T1,.PPFFA## ;AM I [OPR]?
SKIPN .JBDDT ;NO, ALLOW IF DEBUGGING
JRST FALJR4 ;CALL FUNNY USERID/ETC ERROR
INFRM UAR,<Can't validate USERID/PASSWORD/ACCOUNT, continuing for DDT>,,,FALJ40
;VALID USER ID, ACCEPT NETWORK CONNECTION
FALJ40: DMOVEM P1,.IOQ6N(IO) ;[32] RESTORE THE USERNAME WORDS
MOVE T1,.IOPPN(IO) ;GET OUR PPN
CAME T1,NETPPN ;IS IT THE NETWORK PPN?
TXZA S,S.NPPN ;NO, CLEAR ANY INDICATION OF THAT
TXO S,S.NPPN ;YES, REMEMBER THAT FOR LATER
SETZB T2,T3 ;NO OPTIONAL CONNECT CONFIRM DATA
PUSHJ P,NTNCA1## ;SEND A CONNECT ACCEPT MESSAGE
POPJ P, ;BUTTS
PUSHJ P,BEGJOB## ;GO NOTIFY THE OPERATOR THAT WE'RE STARTING
;BUILD BUFFERS FOR FURTHER "REAL" COMMUNICATIONS
FALJ45: PUSHJ P,NTINI1## ;BUILD BUFFERS ETC.
POPJ P, ;BUTTS
;EXCHANGE CONFIGURATION MESSAGES WITH THE REMOTE DAP PROCESS
FALJ50: PUSHJ P,DPICM1## ;EXCHANGE CONFIGURATION MESSAGES
ERROR FCM,<Error exchanging CONFIG messages with node >,.TSIXN,J$SNOD(J)
SETZM J$FSLP(J) ;GOOD CONNECT, RESET WAIT INTERVAL
TXZ S,S.CONN ;SAY WE'RE NO LONGER WAITING TO CONNECT
TXO S,S.OPEN ;SAY WE HAVE A CONNECTION OPEN
PJRST FJOB00 ;ENTER FAL JOB MAIN LOOP
;SEE IF INCOMING CONNECT REQUEST IS REJECTED BY OPERATOR COMMAND
FALCR1: SKIPN P1,REJFIR ;GOT A REJECTION LIST?
JRST .POPJ1## ;NO, INCOMING CONNECT OK BY US
;LOOP CHECKING AGAINST THE REJECTION LIST, SPEC BY SPEC
FALCR2: SKIPN T1,RJ.NOD(P1) ;[22] GET REJECTED NODE SPEC
JRST FALCR5 ;NO NODE, JUST CHECK THE PPN
; XOR T1,.ION6M(IO) ;COMPARE AGAINST CONNECTING NODE
; TDNE T1,RJ.NDM(P1) ;[22] DOES THIS NODE MATCH THE REJECTION?
CAME T1,.ION6M ;[22] DOES THIS NODE MATCH THE REJECTION?
JRST FALCR9 ;NO, SKIP TO NEXT SPEC THEN
FALCR5: MOVE T2,RJ.PPN(P1) ;[22] GET REJECTED PPN SPEC
XOR T2,.IOPPN(IO) ;COMPARE AGAINST CONNECTING USERID
TDNN T2,RJ.PPM(P1) ;[22] DOES THIS PPN MATCH THE REJECTION?
POPJ P, ;YES, USERID REJECTED
FALCR9: ADDI P1,RJ.MAX ;[22] DOESN'T MATCH THIS REJECTION SPEC, ADVANCE
CAMGE P1,REJLAS ;ANY MORE SPECS TO CHECK?
JRST FALCR2 ;YES
JRST .POPJ1## ;NO, INCOMING CONNECT NOT REJECTED HERE
;CONNECT REJECTS COME HERE
FALJR0: REJECT BDP,<Rejected because system being debugged>
MOVEI T3,^D09 ;REJECT "BY DIALOGE PROCESS"
JRST FALRJ1 ;COMMON CODE
FALJR1: REJECT NSD,<Local node shutting down>
MOVEI T3,^D03 ;REJECT "NODE SHUTTING DOWN"
JRST FALRJ1 ;COMMON CODE
FALJR2: REJECT IPP,<Invalid userid or password>
MOVEI T3,^D34 ;REJECT "INVALID PPN/PASSWORD"
JRST FALRJ1 ;COMMON CODE
FALJR3: REJECT IAC,<Invalid account string>
MOVEI T3,^D36 ;REJECT "INVALID ACCOUNT STRING"
JRST FALRJ1 ;COMMON CODE
FALJR4: REJECT FFE,<Image field format error>
MOVEI T3,^D43 ;REJECT GENERAL IMAGE FIELD FORMAT ERROR
JRST FALRJ1 ;COMMON CODE
FALJR5: REJECT UNJ,<Userid or node rejected by operator command>
MOVEI T3,^D34 ;[32] REJECT "INVALID PPN/PASSWORD"
JRST FALRJ1 ;[32] COMMON CODE
FALJR6: REJECT NUP,<User does not have network file access privileges>
MOVEI T3,^D34 ;[32] REJECT "INVALID PPN/PASSWORD"
; JRST FALRJ1 ;[32] COMMON CODE
;ALL CONNECT REJECTS COME THROUGH HERE
FALRJ1: TXZ S,S.CONN!S.OPEN ;NOT CONNECTING ANYMORE
PUSHJ P,INTDIS## ;DISCONNECT THIS CHANNEL FROM THE INTERRUPT SYSTEM
JFCL ;PUNT ERRORS HERE
SETZ T2, ;NO OPTIONAL DISCONNECT DATA
PUSHJ P,NTNCR1## ;REJECT THE CONNECT
JFCL ;DUH???
MOVEI M0,$EFUID ;DECLARE THIS TERMINATION "USERID"
POPJ P, ;END OF THIS ACCESS
;TOP-LEVEL OR MAIN FAL "JOB" PROCESS IDLE LOOP - WAIT FOR SOMETHING TO DO
FJOB00: MOVE IO,CI ;SELECT PRIMARY CDB
PUSHJ P,RDMSG1## ;START UP FIRST DAP MESSAGE
JRST .POPJ1## ;ASSUME ALL DONE
;WE HAVE SOMETHING TO DO, INITIALIZE THE SLAVE CDB AND GO DO IT
JUMPN CO,FJOB03 ;JUST RESET SLAVE IF ALREADY ALLOCATED
MOVEI T2,FALIV ;FAL'S INIT STUFF
PUSHJ P,.IOINA## ;ALLOCATE AND INITIALIZE SLAVE CDB
JRST ERRCDO## ;DUH?
MOVE CO,T1 ;REMEMBER SLAVE CDB ADDRESS
JRST FJOB07 ;CLEAR OUT COMMUNICATIONS AREAS
;HERE WHEN ALREADY HAVE A SLAVE CDB, AS AFTER AN ACCESS COMPLETE, WITH
;MORE ACCESS MESSAGES COMING UP
FJOB03: MOVE IO,CO ;SELECT SLAVE CDB
SKIPN .IOCHN(IO) ;GOT AN I/O CHANNEL?
SKIPE .IONCH(IO) ;OR A NETWORK CHANNEL?
CAIA ;YES???
JRST FJOB05 ;NO
IFN FTDEBUG,INFRM ASS,<Aborting stale slave CDB I/O>
PUSHJ P,IOABO1## ;ABORT WHATEVER IS THERE
JFCL ;HOHUM
FJOB05: MOVE T1,CO ;ADDRESS OF SLAVE CDB
MOVEI T2,FALIV ;FAL'S INIT STUFF
PUSHJ P,.IOINI## ;[RE-]INITIALIZE SLAVE CDB
; IN PARTICULAR, CLEAR OUT OLD .IOFSB
; AND RESET .IOXFF
JRST ERRCDO## ;DUH?
;SETUP THE CDB FOR SLAVE USAGE BY REST OF FAL
FJOB07: MOVX T2,IO.SLV ;THE "SLAVE" BIT
IORM T2,.IOCCF(CO) ;MARK THE SLAVE CDB (E.G., FOR QUEOP)
;SET "ON-BEHALF-OF" STUFF IN THE SLAVE CDB (WHERE IT REALLY COUNTS)
MOVE T1,.IOPPN(CI) ;"ON-BEHALF-OF" PPN
MOVEM T1,.IOPPN(CO) ;COPY IT INTO THE SLAVE CDB
MOVSI T1,.IOACT(CI) ;"ON-BEHALF-OF" ACCOUNT STRING
HRRI T1,.IOACT(CO) ;WHERE WE WANT IT
BLT T1,.IOACT+7(CO) ;LEAVE IT FOR FILOP ETC. TO FIND
DMOVE T1,.IOQ6N(CI) ;"ON-BEHALF-OF" USER NAME
DMOVEM T1,.IOQ6N(CO) ;LEAVE IT FOR QUEOP ETC.
;CLEAR OUT INTERNAL "JOB" DATA BASE
;CLEAR OUT DAP COMMUNICATIONS REGION FOR A FRESH START
MOVE IO,CI ;REFRESH CDB ADDRESS (JUST IN CASE)
MOVEI T2,$DHACS ;ACCESS MESSAGE
PUSHJ P,RDCLR1## ;CLEAR OUT DAP MESSAGE AREA
STOPCD ;CAN'T HAPPEN
MOVEI T2,$DHATR ;MAIN ATTRIBUTES MESSAGE
PUSHJ P,RDCLR1## ;CLEAR OUT DAP MESSAGE AREA
STOPCD ;CAN'T HAPPEN
MOVEI T2,$DHALC ;ALLOCATION ATTRIBUTES MESSAGE
PUSHJ P,RDCLR1## ;CLEAR OUT DAP MESSAGE AREA
STOPCD ;CAN'T HAPPEN
MOVEI T2,$DHTIM ;DATE/TIME ATTRIBUTES MESSAGE
PUSHJ P,RDCLR1## ;CLEAR OUT DAP MESSAGE AREA
STOPCD ;CAN'T HAPPEN
MOVEI T2,$DHPRT ;PROTECTION ATTRIBUTES MESSAGE
PUSHJ P,RDCLR1## ;CLEAR OUT DAP MESSAGE AREA
STOPCD ;CAN'T HAPPEN
SKIPG T2,.IODIM(IO) ;GET PENDING DAP MESSAGE CODE
STOPCD <No DAP message pending in FJOB07>
JRST FJOB12 ;DISPATCH ON DAP MESSAGE TYPE
;START UP NEW DAP INPUT