github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 09:21:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/fal/fal.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

6945 lines
246 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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==50 ; 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.
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.
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
; 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,1986,1988. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
Comment ~
FAL -- File Access Listener
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1985,1986,1988.
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
CAME S1,.MYNNM## ;[26] Is it the local node?
JRST [MOVX S1,$FSNRM ;[26] No, say that's an 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.
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>
;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,[-1] ;[31] 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 UGOUP$] ;[31] 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 MESSAGE
FJOB10: PUSHJ P,RDMSG1## ;GET A DAP MESSAGE HEADER
PJRST NETERI## ;[21] ERROR (MAYBE DISCONNECT)
;HERE WITH DAP MESSAGE CODE IN T2
FJOB12: JSP T4,.CDISP## ;DISPATCH ON RECEIVED MESSAGE TYPE
FJOB40,,$DHCFG ;[47] CONFIGURATION
FJOB17,,$DHSTS ;STATUS (HUH?)
FJOB20,,$DHATR ;MAIN ATTRIBUTES
FJOB20,,$DHALC ;ALLOCATION ATTRIBUTES
FJOB20,,$DHTIM ;DATE/TIME ATTRIBUTES
FJOB20,,$DHPRT ;PROTECTION ATTRIBUTES
FJOB30,,$DHUSR ;USER ID
FJOB50,,$DHACS ;FILE ACCESS
FJOB90,,$DHACM ;ACCESS COMPLETE
0 ;END OF TABLE
JSP T4,FEROS ;DAP MESSAGE RECEIVED OUT OF SEQUENCE
;RECEIVED STATUS - SHOULDN'T USUALLY HAPPEN!
FJOB17: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] NET DIED
CAIE M0,$EGOIP ;"OPERATION IN PROGRESS"?
CAIN M0,$EGAOK ;"A-OK"?
JRST FJOB10 ;YES, JUST EAT IT
;***
PUSHJ P,ERMSX1## ;TYPE OUT STATUS MESSAGE
JRST FJOB10 ;KEEP ON CRUSIN'
JRST FJOB10 ;KEEP ON CRUSIN'
;RECEIVED SOME FLAVOR OF FILE ATTRIBUTES
FJOB20: PUSHJ P,RDDAP1## ;READ IN THE REST OF THE DAP MESSAGE
JSP T4,FERDP ;DAP ERROR
JRST FJOB10 ;LOOP BACK FOR MORE
;RECEIVED USERID MESSAGE
FJOB30: PUSHJ P,RDDAP1## ;READ IN USERID MESSAGE
JSP T4,FERDP ;DAP ERROR
JRST FJOB10 ;*** IGNORE IT FOR NOW
;[47] RECEIVED CONFIGURATION MESSAGE
FJOB40: PUSHJ P,RDMSR1## ;[47] SAVE THE CURRENT MESSAGE
JSP T4,FERDP ;[47] DAP ERROR
PUSHJ P,DPICM1## ;[47] EXCHANGE CONFIGURATION MESSAGES
JSP T4,FERDP ;[47] DAP ERROR
JRST FJOB10 ;[47] LOOP BACK FOR MORE
;RECEIVED FILE ACCESS MESSAGE - TIME TO GO DO SOMETHING USEFUL!
FJOB50: PUSHJ P,RDDAP1## ;READ IN THE ACCESS REQUEST
JSP T4,FERDP ;DAP ERROR
;ALL ACCESS MESSAGES HAVE FILESPEC, SO READ IN AND SET THE SLAVE CDB
;WITH THE FILE SPEC(S) BLOCK(S)
PUSHJ P,FALIF0 ;PARSE THE ACCESS MESSAGE FILE SPEC
JRST FJOB55 ;DAP "FILE SPEC SYNTAX ERROR"
FJOB54: SKIPN T1,.IOXFF(CO) ;OUTPUT AREA
ERROR NSC,<No "extra" space in slace CDB in FJOB54>
ADDI T1,.FXMAX ;LENGTH OF FILE SPEC BLOCK
CAML T1,.IOXSZ(CO) ;ROOM FOR THIS FSB?
ERROR NRS,<No room is slave CDB for FSB in FJOB54>
EXCH T1,.IOXFF(CO) ;ALLOCATE ONE FSB FROM "EXTRA" SPACE
ADD T1,CO ;CALCULATE REAL MEMORY ADDRESS
SKIPN .IOFSB(CO) ;THIS THE FIRST FILE SPEC?
MOVEM T1,.IOFSB(CO) ;YES
MOVEM T1,.IOFSL(CO) ;IT IS ALSO THE LAST FILE SPEC
SKIPN .IOFSB(CI) ;DUPLICATE FSB POINTERS
MOVEM T1,.IOFSB(CI) ; IN PRIMARY CDB
MOVEM T1,.IOFSL(CI) ; FOR EASE OF ACCESS
MOVEI T2,.FXMAX ;LENGTH OF FILE SPEC BLOCK
PUSHJ P,.GTSPC## ;COPY OVER THE FILE SPEC
MOVE T3,.IOPPN(IO) ;ACCESSING ("ON-BEHALF-OF") PPN
SETO T4, ;NON-WILD
SKIPN .FXDIR(T1) ;DID FILESPEC HAVE AN EXPLICIT DIRECTORY?
DMOVEM T3,.FXDIR(T1) ;NO, USE ACCESSOR AS DIRECTORY
LDB T2,[POINTR .FXMOD(T1),FX.TRM] ;GET SPEC TERMINATION
JUMPE T2,FJOB59 ;DISPATCH ON ACCESS REQUEST
;RECEIVED A FILE EXPRESSION (E.G., A 'OR' B), MORE FILE SPECS COMING
PUSHJ P,FALIF1 ;READ IN NEXT FILE SPEC
POPJ P, ;NICE TRY
JRST FJOB54 ;ACCUMULATE FSB'S
FJOB55: MOVEI T1,40000+$DSSYN ;DAP "FILE SPEC SYNTAX ERROR"
SETZ T2, ;NO SECONDARY STATUS
SETZB T3,T4 ;NOTHING
PUSHJ P,FXSTS1 ;SEND DAP ERROR STATUS TO REMOTE
POPJ P, ;NET DIED?
JRST FJOB00 ;LOOP BACK TO IDLE STATE
FJOB59: PUSHJ P,FAJA01 ;VERIFY AND SETUP ATTRIBUTES/ET AL
DEBUG <FAJA failed in FJOB59>,,,FJOB10
MOVX T2,DIRCNT ;GET THE FILE FAIRNESS COUNT
MOVEM T2,J$DCNT(J) ;INITIALIZE IT
MOVD1 T2,AFC ;ACCESS FUNCTION REQUESTED
MOVEM T2,J$SACC(J) ;STORE THE FILE ACCESS FUNCTION
JSP T4,.CDISP## ;DISPATCH ON FUNCTION
FRED00,,$DVARD ;OPEN FILE (FOR READ)
FWRT00,,$DVAWR ;OPEN FILE (FOR WRITE)
FREN00,,$DVARN ;RENAME
FDEL00,,$DVADL ;DELETE
FDIR00,,$DVADR ;DIRECTORY LIST
FSUB00,,$DVASB ;SUBMIT AS COMMAND FILE
FEXE00,,$DVAEC ;EXECUTE COMMAND FILE
0 ;NO MORE
BADDAP (MA.UNS,ACS!20,<Unknown ACCESS message function in FJOB59>,FJOB10)
;HERE ON ACCESS COMPLETE
FJOB90: MOVE IO,CI ;RESET PRIMARY CDB ADDRESS
PUSHJ P,RDDAP1## ;READ IN ACCESS COMPLETE
PJRST NETERI## ;[21] NET ERROR?
MOVD T1,A2F ;GET ACCOMP FUNCTION
CAIE T1,$DVACL ;ACCOMP(CLOSE)?
BADDAP (MA.SYN,,<Access complete not ACCOMP(CLOSE) in FJOB90>)
FJOB93: MOVE IO,CI ;RESET PRIMARY CDB ADDRESS
PUSHJ P,XDARS1## ;SEND ACCOMP(RESPONSE)
PJRST NETERO## ;[21] NET ERROR?
FJOB95:
;***
;*** JRST .POPJ1## ;SHUT DOWN LINK NOW (DCPNSP LEAVES US DANGLING)
;***
JRST FJOB00 ;BACK TO PROCESS NEXT ACCESS COMMAND
SUBTTL File read access
FRED00:
;FILE-LEVEL STARTUP
;
;LOOP FINDING INPUT FILES
FRDF00: MOVEI T1,SCHEDL ;GET THE ADDRESS OF THE SCHEDULER
MOVEM T1,.IOSCH(CO) ;SET IN THE DISK CDB
MOVX T1,IM.AIO ;GET THE ASYNCHRONOUS I/O BIT
IORM T1,.IOIOM(CO) ;SAY WE WANT NON-BLOCKING I/O
PUSHJ P,FIFIL1 ;FIND NEXT POSSIBLY-WILD INPUT FILE
POPJ P, ;(0) NET DIED OR OTHER FATAL ERROR
JRST FRDZ90 ;(1) INPUT FILE STREAM EXHAUSTED
MOVE T1,.IOIOC(CO) ;(2) CONTINUE WITH RETURNED FILE
MOVE T2,.IOIOC(CI) ;PRIMARY CDB I/O CONTROL
TXNN T1,IC.RFM ;RESULTANT FILE RECORD-FORMATTED?
TXZA T1,IC.RSI ;NO
TXOA T1,IC.RSI ;YES
TXZA T2,IC.RSI ;NO
TXO T2,IC.RSI ;YES
MOVEM T1,.IOIOC(CO) ;SET SLAVE FILE I/O CONTROL
MOVEM T2,.IOIOC(CI) ;AND PRIMARY FLAGS TOO
MOVE T1,.IOCHN(CO) ;GET THE CHANNEL NUMBER
PUSHJ P,INDCON## ;SETUP INTERRUPTS ON THIS DEVICE
ERROR IFR,<Could not enable PSI for disk input at FRDF00>
MOVEI T1,IOSHUT ;GET THE SHUTDOWN ROUTINE
MOVEM T1,.IOISS(CO) ;SET AS THE INPUT SHUTDOWN ROUTINE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FRDF20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
;FIRST HANDLE ANY NAME MESSAGES NEEDED BY WILDCARDING
PUSHJ P,FANTY1 ;SEND NAME MESSAGES
POPJ P, ;CAN'T HAPPEN
;NOW HANDLE FILE ATTRIBUTES
FRDF22: PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FRDF22>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
FJUMPN P1,ADS,FRDF25 ;GO IF ANYTHING SET
TFO P1,DMA ;DEFAULT TO MAIN ATTRIBUTES
FRDF25: PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FRDF20>,,,.POPJ##
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;GO UNLESS GO/NOGO REQUESTED
;
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED
FRDG00: PUSHJ P,XDACK1## ;SEND AN ACK AFTER ALL ATTR/ET AL
PJRST NETERO## ;[21] NET DIED?
PUSHJ P,XDFLS1## ;NOW FLUSH OUT ALL MESSAGES TO THE REMOTE
PJRST NETERO## ;[21] NET DIED?
MOVD T1,AOP ;GET ACCESS OPTIONS
TFNN T1,GNG ;DID REMOTE SPECIFY GO/NOGO?
JRST FRDI00 ;NO, INITIALIZE FOR I/O
;WAIT FOR REMOTE TO MAKE UP ITS MIND
FRDG10: PUSHJ P,RDMSG1## ;GET REMOTE'S GO/NOGO DECISION
PJRST NETERI## ;[21] NET MUST HAVE DIED
FRDG11: JSP T4,.CDISP## ;DISPATCH BASED ON REMOTE'S DECISION
FRDG20,,$DHSTS ;STATUS - SHOULDN'T HAPPEN
FRDG30,,$DHCNT ;CONTINUE - RESPONSE FOR GO/NOGO
FRDI90,,$DHACM ;ACCESS COMPLETE
0 ;NONE OTHER
BADDAP (MA.SYN,,<Unknown GO/NOGO response from remote at FRDG10>)
;RECEIVED STATUS
FRDG20: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
BADDAP (MA.SYN,,<STATUS received in FRDG20>)
;RECEIVED CONTINUE
FRDG30: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,C2F ;CONTINUE FUNCTION CODE
CAIN T1,$DVCSK ;SKIP THIS FILE?
JRST FRDZ20 ;YES, ADVANCE TO THE NEXT FILE
CAIN T1,$DVCRS ;RESUME PROCESSING?
JRST FRDI00 ;YES, INITIALIZE FOR I/O
BADDAP (MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FRDG30>)
;INITIALIZE FOR I/O
;
;LOOP ON CONTROL MESSAGES
FRDI00: MOVE IO,CI ;SELECT PRIMARY CDB
PUSHJ P,RDMSG1## ;START UP NEXT INPUT MESSAGE
PJRST NETERI## ;[21] NET DIED
FRDI01: JSP T4,.CDISP## ;DISPATCH ON MESSAGE CODE
FRDI10,,$DHCTL ;CONTROL
FRDI90,,$DHACM ;ACCOMP?
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Received message not CONTROL nor ACCOMP in FRDT40>)
;RECEIVED CONTROL MESSAGE
FRDI10: PUSHJ P,RDDAP1## ;READ IN THE CONTROL MESSAGE
POPJ P, ;ERROR
MOVD1 T2,CFC ;CONTROL FUNCTION CODE
FRDI11: JSP T4,.CDISP## ;DISPATCH ON CONTROL CODE
FRDI20,,$DVCON ;CONTROL(CONNECT), INITIALIZE I/O STREAM
FRDI30,,$DVCGT ;CONTROL(GET), READ RECORD/FILE
0 ;NO OTHERS SUPPORTED
BADDAP (MA.SYN,,<CONTROL neither (CONNECT) nor (GET) in FRDI10>)
;HERE FOR CONTROL(CONNECT)
FRDI20: MOVX T1,IO.DCC ;THE DAP CONTROL(CONNECT) FLAG
TDNE T1,.IOCCF(IO) ;FIRST ONE?
BADDAP (MA.SYN,,<Multiple CONTROL(CONNECT)s in FRDI20>)
IORM T1,.IOCCF(IO) ;YES, FLAG I/O NOW ACTIVE
PUSHJ P,XDACK1## ;SEND AN ACK FOR THE CONTROL(CONNECT)
PJRST NETERO## ;[21] NET DIED?
PUSHJ P,XDFLS1## ;FORCE IT OUT NOW
PJRST NETERO## ;[21] NET DIED?
JRST FRDI00 ;BACK TO STATE DISPATCH
;HERE FOR CONTROL(GET)
FRDI30: MOVE T1,.IOCCF(IO) ;GET CHANNEL CONTROL FLAGS
TXNN T1,IO.DCC ;HAVE WE SEEN A CONTROL(CONNECT)?
BADDAP (MA.SYN,,<No CONTROL(CONNECT) before CONTROL(GET) in FRDI30>)
MOVD1 T2,RAC ;RECORD ACCESS CONTROL
CAIN T2,$DVCSF ;SEQUENTIAL FILE ACCESS?
JRST FRDL00 ;JUST START FILE TRANSFER LOOP
BADDAP (MA.UNS,CTL!22,<Not Sequential-File-Access for CONTROL(GET) in FRDI30>)
;HERE ON ACCOMP RATHER THAN CONTROL MESSAGE
FRDI90: PUSHJ P,RDCLR1## ;CLEAR OUT POSSIBLY-STALE FIELDS (LIKE AFO)
STOPCD ;CAN'T HAPPEN
SETOM .IDCKS(IO) ;'CUZ ACCOMP HAS NO MENU!!
PUSHJ P,RDDAP1## ;READ IN ACCOMP MESSAGE
PJRST NETERI## ;[21] NET DIED
SKIPL T1,.IDCKS(IO) ;DID ACCOMP INCLUDE A CRC VALUE?
CAMN T1,.IODOK(IO) ;YES, DOES IT MATCH OUR CALCULATION?
JRST FRDI93 ;NO CRC, OR CRC MATCHES, ALL IS WELL
MOVD T2,AOP ;GET ORIGINAL FILE ACCESS OPTIONS
TFNN T2,ACK ;DID USER REQUEST CHECKSUMMING?
JRST FRDI93 ;NO, THEN NOT A REAL ERROR
MOVX T2,IO.DCC ;THE "OPEN FOR I/O" FLAG
TDNN T2,.IOCCF(IO) ;IS FILE OPENED FOR I/O?
;*** JUMPE T1,FRDI93 ;IGNORE IF 0 (ASSUME REALLY A "BLANK" CRC)
JRST FRDI93 ;*** VAX HAS TAKEN TO SENDING A CRC OF 177777
;*** FOR FILE FOR WHICH NO READ WAS PERFORMED
;*** AS IN "SUBMIT/REMOTE 10::FILE.CTL"
MOVEI T1,50000+$DSCKE ;DAP FILE TRANSFER CHECKSUM (CRC) ERROR STATUS
SETZ T2, ;NO SECONDARY STATUS
SETZB T3,T4 ;NOTHING ELSE EITHER
PUSHJ P,FXSTS1 ;SEND A STATUS MESSAGE
POPJ P, ;NET DIED?
JRST FRDI00 ;BACK TO FILE-OPEN IDLE LOOP FOR ANOTHER ACCOMP
;FILE DATA IS OK (AS BEST AS WE CAN TELL), CLOSE OFF THE FILE
FRDI93: MOVX T2,IO.DCC ;THE "FILE IS OPEN FOR I/O" BIT
ANDCAM T2,.IOCCF(IO) ;NOTE NO MORE I/O
PUSHJ P,FACL01 ;CHECK FOR ACCOMP-TIME CLOSE OPTIONS
JRST [PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED?
JRST FRDI00] ;BACK TO FILE-OPEN IDLE LOOP
FRDI95: MOVD1 T2,A2F ;ACCOMP FUNCTION
JSP T4,.CDISP## ;DISPATCH ON MESSAGE TYPE
FRDI97,,$DVAES ;END OF STREAM (DON'T CLOSE THE FILE)
FRDZ00,,$DVACL ;CLOSE FILE (MIGHT IMPLY SKIP)
FRDZ20,,$DVASK ;CLOSE AND SKIP FILE
FRDZ30,,$DVACB ;CLOSE AND RENAME CURRENT FILE
FRDZ50,,$DVAKL ;KILL/RESET CURRENT FILE
FRDZ80,,$DVATR ;TERMINATE/ABORT ACCESS REQUEST
0 ;NONE OTHERS LEGAL
BADDAP (MA.UNS,ACM!20,<Unknown or illegal ACCOMP function in FRDI90>)
;HERE ON ACCOMP(EOS) - JUST MARK THE FILE NOT I/O-ACTIVE
FRDI97: PUSHJ P,XDARS1## ;SEND THE ACCOMP(RESPONSE)
PJRST NETERO## ;[21] NET DIED
JRST FRDI00 ;BACK INTO OPEN-BUT-NOT-I/O-ACTIVE IDLE LOOP
;LOOP READING FILE IN SEQUENTIAL FILE TRANSFER MODE
;
;HERE TO READ THE JUST-FOUND FILE
FRDL00: XMOVEI T1,.IOOIN## ;NET-LEVEL I/O INIT ROUTINE
MOVEM T1,.IOOSR(CI) ;FORCE PRIMARY TO RE-INIT OUTPUT ROUTINES
MOVEI T1,177777 ;DAP CRC POLYNOMIAL "SEED"
MOVEM T1,.IODOK(CI) ;IN CASE FIRST .IOISR FAILS, AND THEN CLOSES
; INPUT WITH CRC - SINCE OTHERWISE THE CRC
; WON'T GET INITIALIZED UNTIL .IOOSR CALLED
MOVE T1,.IOIOC(CI) ;GET PRIMARY CDB I/O CONTROL
TXNN T1,IC.RSI ;RECORD-STRUCTURED I/O?
JRST FRDL09 ;[36] NO, BYTE I/O, GO START IT UP
MOVE T1,.IORSZ(CI) ;GET PRIMARY RECORD SIZE
CAIG T1,0 ;GOT A RECORD SIZE?
MOVEI T1,1234 ;NO, HALLUCINATE ONE THEN
MOVEM T1,J$RLEN(J) ;SAVE FOR ISR CALLS
ADDI T1,3 ;*** 8-BIT BYTES
LSH T1,-2 ;*** 8-BIT BYTES
PUSHJ P,.MMGWD## ;ALLOCATE A RECORD-BUFFER
POPJ P, ;NO MEMORY
DMOVEM T1,J$RALC(J) ;SAVE THE PAIR
HRLI T2,(POINT 8,) ;CONCOCT A RECORD-BUFFER BYTE POINTER
MOVEM T2,J$RBUF(J) ;SAVE FOR ISR CALLS
JRST FRDL19 ;[36] GO START RECORD I/O
;LOOP READING BYTES FROM THE SLAVE FILE, WRITING TO THE REMOTE
FRDL09: MOVX T1,CHARFC ;[36] GET THE FAIRNESS COUNT FOR CHARS
MOVEM T1,J$SFC(J) ;[36] AND INIT THE LOOP COUNTER
FRDL10: MOVE T1,CO ;INPUT (SLAVE) CDB
PUSHJ P,@.IOISR(T1) ;READ NEXT INPUT BYTE
JRST FRDL18 ;[40] CHECK FOR LSN OR REAL ERROR
FRDL15: MOVE T1,CI ;OUTPUT (PRIMARY) CDB
PUSHJ P,@.IOOSR(T1) ;WRITE CURRENT BYTE TO THE REMOTE
JRST FRDL60 ;MAYBE ACCOMP
AOS J$SBYT(J) ;COUNT THIS BYTE
SOSLE J$SFC(J) ;[36] EXHAUSTED OUR QUANTUM YET?
JRST FRDL10 ;[36] NO, GO COPY ANOTHER BYTE
PUSHJ P,SCHEDZ ;[36] YES, GIVE SOMEONE ELSE A CHANCE
POPJ P, ;[36] MUST HAVE BEEN ABORTED
JRST FRDL09 ;[36] CONTINUE WITH THE COPY
;CHECK OUT INPUT EXCEPTION RETURN
FRDL18: CAIE M0,$EILSN ;[40] READ A LINE SEQUENCE NUMBER?
JRST FRDL30 ;[40] MAYBE EOF, TELL REMOTE IN ANY CASE
MOVE T3,T2 ;[40] POSITION LSN
MOVEI T2,.FULSN ;[40] FUNCTION: WRITE LSN
MOVE T1,CI ;[40] SELECT PRIMARY CDB
PUSHJ P,.IOFUN## ;[40] WRITE LSN
JRST FRDL60 ;[40] CHECK OUT ERROR
JRST FRDL10 ;[40] NOW GO BACK AND TRY FOR REAL DATA
;LOOP READING RECORDS FROM THE SLAVE FILE, WRITING TO THE REMOTE
FRDL19: MOVX T1,RECFC ;[36] GET THE FAIRNESS COUNT FOR RECORDS
MOVEM T1,J$SFC(J) ;[36] AND INIT THE LOOP COUNTER
FRDL20: MOVE T1,CO ;INPUT (SLAVE) CDB
SETO T2, ;NO PARTICULAR RECORD ADDRESS
DMOVE T3,J$RLEN(J) ;RECORD BUFFER COUNTER AND POINTER
PUSHJ P,@.IOISR(T1) ;READ NEXT INPUT RECORD
JRST FRDL30 ;MAYBE EOF, TELL REMOTE IN ANY CASE
FRDL25: MOVE P3,T3 ;COPY THE RECORD LENGTH
MOVE T1,CI ;OUTPUT (PRIMARY) CDB
PUSHJ P,@.IOOSR(T1) ;WRITE CURRENT RECORD TO THE REMOTE
JRST FRDL60 ;MAYBE ACCOMP
ADDM P3,J$SBYT(J) ;COUNT THE NUMBER OF BYTES MOVED
SOSLE J$SFC(J) ;[36] EXHAUSTED OUR QUANTUM YET?
JRST FRDL20 ;[36] NO, GO COPY ANOTHER RECORD
PUSHJ P,SCHEDZ ;[36] YES, GIVE SOMEONE ELSE A CHANCE
POPJ P, ;[36] MUST HAVE BEEN ABORTED
JRST FRDL19 ;[36] CONTINUE WITH THE COPY
;HERE ON EXCEPTION RETURN FROM INPUT BYTE
FRDL30: MOVE IO,CI ;SELECT PRIMARY CDB
PUSH P,M0 ;HANG ONTO ERROR/EXCEPTION CODE
PUSHJ P,@.IOOSS(IO) ;CALL NETWORK OUTPUT SHUTDOWN ROUTINE
JFCL ;HO HUM
POP P,M0 ;RETRIEVE ERROR/EXCEPTION CODE
CAIE M0,$EIEOF ;EOF ON INPUT (SLAVE) FILE?
JRST FRDL33 ;NO, I/O EXCEPTION/ERROR
FRDL31: MOVEI T1,50000+$DSEOF ;DAP I/O-LEVEL EOF STATUS
SETZ T2, ;NO SECONDARY STATUS
SETZB T3,T4 ;NOR ANYTHING ELSE
PUSHJ P,FXSTS1 ;SEND DAP STATUS TO REMOTE
POPJ P, ;NET DIED
JRST FRDI00 ;WAIT FOR ACCOMP
;ERROR READING INPUT (SLAVE) FILE
FRDL33: MOVE T2,M0 ;POSITION ERROR CODE
MOVEI T4,DS2EI## ;DAP STATUS TO I/O STATUS TRANSLATION TABLE
PUSHJ P,FFIND1 ;CONVERT TO DAP I/O STATUS CODE
SKIPA T1,$DSRER ;GENERIC READ ERROR, $E???? AS SECONDARY STATUS
SETZ T2, ;KNOWN ERROR, NO SECONDARY STATUS
ADDI T1,50000 ;DAP I/O LEVEL ERROR STATUS
SETZB T3,T4 ;NOTHING ELSE EITHER
PUSHJ P,FXSTS1 ;SEND DAP STATUS
POPJ P, ;NET DIED
;ERROR-STATE IDLE LOOP - WAIT FOR CONTINUE OR ABORT
FRDL40: PUSHJ P,RDMSG1## ;START NEW INPUT MESSAGE FROM REMOTE
PJRST NETERI## ;[21] NET DIED
FRDL41: JSP T4,.CDISP## ;DISPATCH ON MESSAGE TYPE
FRDL50,,$DHCNT ;CONTINUE
FRDI90,,$DHACM ;ACCOMP
0 ;THAT'S IT
BADDAP (MA.SYN,,<Unknown/illegal DAP message in FRDL40>)
;HERE ON "CONTINUE" AFTER INPUT ERROR
FRDL50: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] NET DIED
MOVD1 T2,C2F ;GET CONTINUE "FUNCTION" TYPE
JUMPE T2,FRDL54 ;IF NULL, ASSUME IGNORE ERROR
JSP T4,.CDISP## ;DISPATCH ON CONTINUE TYPE
FRDL53,,$DVCTA ;TRY AGAIN
FRDL54,,$DVCSK ;SKIP AND IGNORE ERROR
0 ;THAT'S ALL
BADDAP (MA.INV,CNT!20,<Unknown/illegal CONTINUE function in FRDL50>)
FRDL53: TDZA T2,T2 ;TRY AGAIN
FRDL54: MOVEI T2,1 ;IGNORE AND RESUME
STOPCD <Error-continuation not yet written in FRDL54>
;"EXCEPTION" WRITING OUTPUT FILE
FRDL60: MOVE IO,CI ;SELECT PRIMARY CDB
CAIE M0,$EINMP ;INPUT MESSAGE PENDING?
JRST FRDL63 ;NO, NET ERROR?
PUSHJ P,RDMSG1## ;START UP DAP MESSAGE
PJRST NETERI## ;[21] HMMMM
CAIE T2,$DHACM ;ACCESS COMPLETE?
BADDAP (MA.SYN,,<Received DAP message not ACCOMP in FRDL60>)
JRST FRDI90 ;GO PROCESS ACCOMP
FRDL63: POPJ P, ;NET DIED? JUST ABORT THE JOB
;END OF FILE ACCESS
FRDZ00: MOVE T1,.IOCCF(CI) ;GET PRIMARY CHANNEL CONTROL FLAGS
MOVE T2,.IOIOM(CO) ;GET SLAVE I/O MODE CONTROL
TXNN T1,IO.DCC ;WAS A CONTROL(CONNECT) SEEN?
TXNE T2,IM.CXX ;NO, ANY CLOSE-TIME OPTIONS?
JRST FRDZ10 ;NORMAL FILE CLOSE PROCESSING
JRST FRDZ20 ;"SKIP" FILE CLOSE PROCESSING
;NORMAL CLOSE FILE
FRDZ10: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOCLO1## ;CLOSE THE INPUT FILE
SKIPA T2,M0 ;BUTTS - SOMETHING FAILED IN THE CLOSE
JRST FRDZ60 ;END OF THIS FILE, BACK FOR THE NEXT ONE
FRDZ17: MOVEI T4,DS2EF## ;DAP STATUS TO FILE STATUS TABLE ADDRESS
PUSHJ P,FFIND1 ;SEE IF KNOWN ERROR
SKIPA T1,[$DSCCF] ;CANNOT CLOSE FILE, $E???? AS SECONDARY STATUS
SETZ T2, ;KNOWN ERROR, NO SECONDARY STATUS
ADDI T1,70000 ;"CLOSE-TIME" ERROR
SETZB T3,T4 ;NOTHING ELSE EITHER
MOVE IO,CI ;SELECT PRIMARY CDB
PUSHJ P,FXSTS1 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED
JRST FRDI00 ;BACK TO FILE-IS-OPEN IDLE LOOP
;SKIP CURRENT FILE
FRDZ20: MOVE IO,CO ;SELECT SLAVE CDB
MOVX P1,IM.SAD ;THE SUPPRESS-ACCESS-DATE FLAG
AND P1,.IOIOM(IO) ;MAKE A COPY OF THE CURRENT SETTING
MOVX T1,IM.SAD ;THE BIT AGAIN
IORM T1,.IOIOM(IO) ;SUPPRESS THE ACCESS DATE
PUSHJ P,IOCLO0## ;CLOSE CURRENT INPUT FILE
TDZA T1,T1 ;OOPS
SETO T1, ;GOOD
MOVX T2,IM.SAD ;THE BIT YET AGAIN
TDNN T2,P1 ;WAS IT SET BEFORE?
ANDCAM T2,.IOIOM(IO) ;NO, CLEAR IT OUT NOW
JUMPL T1,FRDZ60 ;NOW ADVANCE TO NEXT FILE
JRST FRDZ17 ;OOPS, ERROR, INFORM REMOTE
;RENAME CURRENT FILE
FRDZ30: PUSHJ P,FRDCB1 ;READ IN NEW ATTRIBUTES/NAME MESSAGES
JRST [CAIE M0,$ECAUR ;ABORTED AT [REMOTE] USER'S REQUEST?
POPJ P, ;NO, LINK BLOWN AWAY
CAIE T2,$DVATR ;ACCOMP(TERMINATE)?
BADDAP (MA.SYN,,<Unknown/illegal ACCOMP message in FWRZ30>)
PJRST FRDZ80] ;YES, SEND ACCOMP(RESPONSE), GO IDLE
SKIPN .IOFS3(CO) ;*** DID WE RECEIVE A FILE SPEC?
JRST FRDZ10 ;*** NO, JUST CLOSE THE FILE NORMALLY
PUSHJ P,FRDCE1 ;DO THE REQUESTED RENAME OPERATION
JRST FRDZ17 ;OOPS - RENAME FAILED, INFORM THE REMOTE
JRST FRDZ60 ;FILE CLOSED (BY IOFRN), SEE WHAT NEXT
;KILL/RESET CURRENT FILE
FRDZ50: MOVE IO,CO ;POINT TO SLAVE CDB
PUSHJ P,IOABO1## ;ABORT CURRENT FILE
DEBUG <IOABO failed in FRDZ50>,,,.POPJ##
; JRST FRDZ60 ;ADVANCE TO THE NEXT FILE (IF ANY)
;COMMON FILE-CLOSE, TRY FOR NEXT INPUT FILE
FRDZ60: SKIPN T1,J$RALC(J) ;GOT ANY RECORD-BUFFER LEFT OVER?
JRST FRDZ62 ;NOPE
MOVE T2,J$RALC+1(J) ;YUP
PUSHJ P,.MMFWD## ;FREE UP RECORD BUFFER
JFCL ;HO HUM
SETZM J$RALC(J) ;NO LONGER HAVE A RECORD BUFFER
FRDZ62: SKIPN .WLDFL## ;*** WILDCARDED FILE ACCESS?
JRST FRDZ90 ;*** NO, ACCESS IS COMPLETE
JRST FRDF00 ;TRY FOR ANOTHER FILE
;TERMINATE ACCESS
FRDZ80: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOABO1## ;ABORT THE CURRENT READ
JFCL ;HO HUM
;ACCESS IS COMPLETED
FRDZ90: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
SUBTTL File read access -- Subroutines - RENAME option
;FRDCB - read in new name/attributes on ACCOMP(RENAME)
FRDCB1: PUSHJ P,FRENA1 ;READ IN NEW ATTRIBUTES AND NAME
JRST [CAIN M0,$ECAUR ;RECEIVED AN ACCOMP BEFORE NAME MSG?
CAIN T2,$DVATR ;ACCOMP(TERMINATE)?
POPJ P, ;LET CALLER DEAL WITH IT
CAIE T2,$DVACE ;MUST BE ACCOMP(CHANGE-END)
BADDAP (MA.SYN,,<ACCOMP not CHANGE-END in FRDCB1>)
;NO NAME MESSAGE, NO FILE SPEC, NOTHING
;FOR SCWILD TO PLAY WITH. FOR THE TIME
;BEING, JUST IGNORE THE ACCOMP(RENAME)
;AND CLOSE THE FILE NORMALLY (YEAH, IF
;ONLY A PROTECTION WAS SENT, IT IS LOST)
JRST .POPJ1##] ;QUIT FOR NOW
MOVE T1,.IOFS3(CO) ;ADDRESS OF "OUTPUT" FILE SPEC BLOCK
DMOVE T2,.FXCTL(T1) ;GET FSB CONTROL FLAGS
TXOE T3,FX.SCE ;SOMEONE SLIP IN /SCERROR CONTROL?
JRST FRDCB3 ;YES, BIZARRE, ALLOW IT THEN
MOVEI T4,SCENEV## ;GET /SCERROR:NEVER VALUE %%%
DPB T4,[POINTR T2,FX.SCE] ;AND SET IN CONTROL WORD
; TO ALLOW WILDCARD READ, BUT SPECIFIC
; FILENAME RENAME OPERATION (WHICH IS
; THE USUAL CASE FOR ACCOMP(RENAME)...)
DMOVEM T2,.FXCTL(T1) ;SET VALUES IN FILE SPEC BLOCK
FRDCB3: PUSHJ P,RDMSG1## ;MUST NOW HAVE ACCOMP(CHANGE-END)
PJRST NETERI## ;[21] NET DIED?
CAIE T2,$DHACM ;LOOKING AT AN ACCOMP?
BADDAP (MA.SYN,,<Not ACCOMP after ACCOMP(CHANGE-BEGIN) in FRDCB1>)
PUSHJ P,RDCLR1## ;CLEAR OUT DAP AREA
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;PARSE THE ACCOMP
POPJ P, ;BAD NEWS
MOVD1 T2,A2F ;GET THE ACCOMP FUNCTION
CAIN T2,$DVATR ;ACCOMP(TERMINATE)?
JRST [MOVEI M0,$ECAUR ;YES, FLAG ABORT AT USER'S REQUEST
POPJ P,] ;AND BREAK OFF THE OPERATION
CAIE T2,$DVACE ;MUST BE "CHANGE-END"
BADDAP (MA.SYN,,<ACCOMP not ACCOMP(CHANGE-END) in FRDCB1>)
JRST .POPJ1## ;READY FOR THE RENAME!
;FRDCE - Do the actual RENAME operation as setup by FRDCB
FRDCE1: MOVE IO,CO ;POINT TO SLAVE CDB
PUSHJ P,IOFRN1## ;DO THE REQUESTED RENAME OPERATION
TDZA P1,P1 ;ERROR
SETO P1, ;SUCCESS
MOVNI T1,.FXMAX ;LENGTH OF FSB
ADDM T1,.IOXFF(CO) ;DEALLOCATE THE "ANCILLIARY" FSB FROM FRENA1
SETZM .IOFS3(CO) ;REMOVE POINTER TO DEALLOCATED FSB
SETZM .IOCU3(CO) ; AND THE OTHER ONE TOO
JUMPL P1,.POPJ1## ;TRY FOR A SUCCESS RETURN
POPJ P, ;NOPE, TAKE ERROR RETURN
SUBTTL File write access
FWRT00:
;FILE-LEVEL STARTUP
;
;CREATE THE OUTPUT FILE
FWRF00: MOVEI T1,SCHEDL ;GET THE ADDRESS OF THE SCHEDULER
MOVEM T1,.IOSCH(CO) ;SET IN THE DISK CDB
MOVX T1,IM.AIO ;GET THE ASYNCHRONOUS I/O BIT
IORM T1,.IOIOM(CO) ;SAY WE WANT NON-BLOCKING I/O
MOVE IO,CO ;ADDRESS OF SLAVE CDB
PUSHJ P,FOFIL1 ;GO CREATE THE SLAVE OUTPUT FILE
POPJ P, ;(0) NET DIED
JRST FWRZ50 ;(1) ERROR, ABORT FILE, SEND ACCOMP(RESPONSE)
MOVE T1,.IOIOC(CO) ;(2) CONTINUE WITH NEWLY-CREATED FILE
MOVE T2,.IOIOC(CI) ;PRIMARY CDB I/O CONTROL
TXNN T1,IC.RFM ;RESULTANT FILE RECORD-FORMATTED?
TXZA T1,IC.RSI ;NO
TXOA T1,IC.RSI ;YES
TXZA T2,IC.RSI ;NO
TXO T2,IC.RSI ;YES
MOVEM T1,.IOIOC(CO) ;SET SLAVE FILE I/O CONTROL
MOVEM T2,.IOIOC(CI) ;AND PRIMARY FLAGS TOO
MOVE T1,.IOCHN(CO) ;GET THE DISK FILE CHANNEL NUMBER
PUSHJ P,INDCON## ;ENABLE INTERRUPTS ON THIS GUY
ERROR IFW,<Failed to enable PSI for disk output at FWRF00>
MOVEI T1,IOSHUT ;GET OUR SHUTDOWN ROUTINE
MOVEM T1,.IOOSS(CO) ;SET AS THE OUTPUT SHUTDOWN ROUTINE
MOVE T1,.IOCCF(CO) ;SLAVE CHANNEL CONTROL FLAGS
MOVE T2,.IODCH(CO) ;GET FILE CHARACTERISTICS
TXNN T1,IO.NET ;IS THIS A NETWORKED (NON-LOCAL) FILE?
TXNN T2,IC.SPL ;THAT IS SPOOLED?
JRST FWRF20 ;NOT A LOCAL SPOOLED FILE, NO NONSENSE
PUSHJ P,NONPP1 ;DISALLOW NETPPN FROM USING THE LPT/ETC.
JRST [PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED?
JRST FJOB95] ;BACK TO IDLE STATE
PUSHJ P,FWSP01 ;GO WAVE OUR HANDS IN A FRENZIED FASHION
JRST FWRZ50 ;SO MUCH FOR THAT, BACK TO IDLE STATE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FWRF20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
FWRF22: PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FWRF20>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
FJUMPN P1,ADS,FWRF25 ;GO IF ANYTHING SET
TFO P1,DMA ;DEFAULT TO MAIN ATTRIBUTES
FWRF25: PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FWRF20>,,,.POPJ##
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
;GO UNLESS GO/NOGO REQUESTED
;
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED
FWRG00: PUSHJ P,XDACK1## ;SEND AN ACK AFTER ALL ATTR/ET AL
PJRST NETERO## ;[21] NET DIED?
PUSHJ P,XDFLS1## ;NOW FLUSH OUT ALL MESSAGES TO THE REMOTE
PJRST NETERO## ;[21] NET DIED?
MOVD T1,AOP ;GET ACCESS OPTIONS
TFNN T1,GNG ;DID REMOTE SPECIFY GO/NOGO?
JRST FWRI00 ;NO, INITIALIZE FOR I/O
;WAIT FOR REMOTE TO MAKE UP ITS MIND
FWRG10: PUSHJ P,RDMSG1## ;GET REMOTE'S GO/NOGO DECISION
PJRST NETERI## ;[21] NET MUST HAVE DIED
FWRG11: JSP T4,.CDISP## ;DISPATCH BASED ON REMOTE'S DECISION
FWRG20,,$DHSTS ;STATUS - SHOULDN'T HAPPEN
FWRG30,,$DHCNT ;CONTINUE - RESPONSE FOR GO/NOGO
FWRI90,,$DHACM ;ACCESS COMPLETE
0 ;NONE OTHER
BADDAP (MA.SYN,,<Unknown GO/NOGO response from remote at FWRG10>)
;RECEIVED STATUS
FWRG20: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
BADDAP (MA.SYN,,<STATUS received in FWRG20>)
;RECEIVED CONTINUE
FWRG30: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,C2F ;CONTINUE FUNCTION CODE
CAIN T1,$DVCSK ;SKIP THIS FILE?
JRST FWRZ50 ;YES, ABORT THE CREATE (IF POSSIBLE)
CAIN T1,$DVCRS ;RESUME PROCESSING?
JRST FWRI00 ;YES, INITIALIZE FOR I/O
BADDAP (MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FWRG30>)
;INITIALIZE FOR I/O
;
;LOOP ON CONTROL MESSAGES
FWRI00: MOVE IO,CI ;SELECT PRIMARY CDB
PUSHJ P,RDMSG1## ;START UP NEXT INPUT MESSAGE
PJRST NETERI## ;[21] NET DIED
FWRI01: JSP T4,.CDISP## ;DISPATCH ON MESSAGE CODE
FWRI10,,$DHCTL ;CONTROL
FWRI90,,$DHACM ;ACCOMP?
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Received message not CONTROL nor ACCOMP in FWRT40>)
;RECEIVED CONTROL MESSAGE
FWRI10: PUSHJ P,RDDAP1## ;READ IN THE CONTROL MESSAGE
POPJ P, ;ERROR
MOVD1 T2,CFC ;CONTROL FUNCTION CODE
FWRI11: JSP T4,.CDISP## ;DISPATCH ON CONTROL CODE
FWRI20,,$DVCON ;CONTROL(CONNECT), INITIALIZE I/O STREAM
FWRI30,,$DVCPT ;CONTROL(PUT), WRITE RECORD/FILE
0 ;NO OTHERS SUPPORTED
BADDAP (MA.SYN,,<CONTROL neither (CONNECT) nor (PUT) in FWRI10>)
;HERE FOR CONTROL(CONNECT)
FWRI20: MOVX T1,IO.DCC ;THE DAP CONTROL(CONNECT) FLAG
TDNE T1,.IOCCF(IO) ;FIRST ONE?
BADDAP (MA.SYN,,<Multiple CONTROL(CONNECT)s in FWRI20>)
IORM T1,.IOCCF(IO) ;YES, FLAG I/O NOW ACTIVE
PUSHJ P,XDACK1## ;SEND AN ACK FOR THE CONTROL(CONNECT)
PJRST NETERO## ;[21] NET DIED?
PUSHJ P,XDFLS1## ;FORCE IT OUT NOW
PJRST NETERO## ;[21] NET DIED?
JRST FWRI00 ;BACK TO STATE DISPATCH
;HERE FOR CONTROL(PUT)
FWRI30: MOVE T1,.IOCCF(IO) ;GET CHANNEL CONTROL FLAGS
TXNN T1,IO.DCC ;HAVE WE SEEN A CONTROL(CONNECT)?
BADDAP (MA.SYN,,<No CONTROL(CONNECT) before CONTROL(PUT) in FWRI30>)
MOVD1 T2,RAC ;RECORD ACCESS CONTROL
CAIN T2,$DVCSF ;SEQUENTIAL FILE ACCESS?
JRST FWRL00 ;JUST START FILE TRANSFER LOOP
BADDAP (MA.UNS,CTL!22,<Not Sequential-File-Access for CONTROL(PUT) in FWRI30>)
;HERE ON ACCOMP RATHER THAN CONTROL MESSAGE
FWRI90: PUSHJ P,RDCLR1## ;CLEAR OUT DAP REGION
STOPCD ;CAN'T HAPPEN
SETOM .IDCKS(IO) ;'CUZ ACCOMP HAS NO MENU!!
PUSHJ P,RDDAP1## ;READ IN ACCOMP MESSAGE
PJRST NETERI## ;[21] NET DIED
SKIPL T1,.IDCKS(IO) ;DID ACCOMP INCLUDE A CRC VALUE?
CAMN T1,.IODIK(IO) ;YES, DOES IT MATCH OUR CALCULATION?
JRST FWRI93 ;NO CRC, OR CRC MATCHES, ALL IS WELL
MOVD T2,AOP ;GET ORIGINAL FILE ACCESS OPTIONS
TFNN T2,ACK ;DID USER REQUEST CHECKSUMMING?
JRST FWRI93 ;NO, THEN NOT A REAL ERROR
MOVX T2,IO.DCC ;THE "OPEN FOR I/O" FLAG
TDNN T2,.IOCCF(IO) ;IS FILE OPENED FOR I/O?
JUMPE T1,FWRI93 ;IGNORE IF 0 (ASSUME REALLY A "BLANK" CRC)
MOVEI T1,50000+$DSCKE ;DAP FILE TRANSFER CHECKSUM (CRC) ERROR STATUS
SETZ T2, ;NO SECONDARY STATUS
SETZB T3,T4 ;NOTHING ELSE EITHER
PUSHJ P,FXSTS1 ;SEND A STATUS MESSAGE
POPJ P, ;NET DIED?
JRST FWRI00 ;BACK TO FILE-OPEN IDLE LOOP FOR ANOTHER ACCOMP
;FILE DATA IS OK (AS BEST AS WE CAN TELL), CLOSE OFF THE FILE
FWRI93: MOVX T2,IO.DCC ;THE "FILE IS OPEN FOR I/O" BIT
ANDCAM T2,.IOCCF(IO) ;NOTE NO MORE I/O
PUSHJ P,FACL01 ;CHECK FOR ACCOMP-TIME CLOSE OPTIONS
JRST [PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED?
JRST FWRI00] ;BACK TO FILE-OPEN IDLE LOOP
FWRI95: MOVD1 T2,A2F ;ACCOMP FUNCTION
JSP T4,.CDISP## ;DISPATCH ON MESSAGE TYPE
FWRI97,,$DVAES ;END OF STREAM (DON'T CLOSE THE FILE)
FWRZ00,,$DVACL ;CLOSE FILE
FWRZ30,,$DVACB ;CLOSE AND RENAME CURRENT FILE
FWRZ50,,$DVAKL ;KILL/RESET CURRENT FILE
FWRZ50,,$DVATR ;TERMINATE/ABORT CURRENT ACCESS
0 ;NONE OTHERS LEGAL
BADDAP (MA.UNS,ACM!20,<Unknown or illegal ACCOMP function in FWRI90>)
;HERE ON ACCOMP(EOS) - JUST MARK THE FILE NOT I/O-ACTIVE
FWRI97: PUSHJ P,XDARS1## ;SEND THE ACCOMP(RESPONSE)
PJRST NETERO## ;[21] NET DIED
JRST FWRI00 ;BACK INTO OPEN-BUT-NOT-I/O-ACTIVE IDLE LOOP
;LOOP WRITING FILE IN SEQUENTIAL FILE TRANSFER MODE
;
;HERE TO WRITE THE NEWLY-CREATED FILE
FWRL00: XMOVEI T1,.IOIIN## ;INPUT INITIALIZATION ADDRESS
MOVEM T1,.IOISR(CI) ;FORCE INPUT INITIALIZATION
MOVE T1,.IOIOC(CI) ;GET PRIMARY CDB I/O CONTROL
TXNN T1,IC.RSI ;RECORD-STRUCTURED I/O?
JRST FWRL09 ;[36] NO, BYTE I/O, GO START IT UP
MOVE T1,.IORSZ(CI) ;GET PRIMARY RECORD SIZE
CAIG T1,0 ;GOT A RECORD SIZE?
MOVEI T1,1234 ;NO, HALLUCINATE ONE THEN
MOVEM T1,J$RLEN(J) ;SAVE FOR ISR CALLS
ADDI T1,3 ;*** 8-BIT BYTES
LSH T1,-2 ;*** 8-BIT BYTES
PUSHJ P,.MMGWD## ;ALLOCATE A RECORD-BUFFER
POPJ P, ;NO MEMORY
DMOVEM T1,J$RALC(J) ;SAVE THE PAIR
HRLI T2,(POINT 8,) ;CONCOCT A RECORD-BUFFER BYTE POINTER
MOVEM T2,J$RBUF(J) ;SAVE FOR ISR CALLS
JRST FWRL19 ;[36] START UP RECORD I/O
;LOOP READING BYTES FROM THE REMOTE, WRITING TO THE SLAVE FILE
FWRL09: MOVX T1,CHARFC ;[36] GET THE FAIRNESS COUNT FOR CHARS
MOVEM T1,J$SFC(J) ;[36] AND INIT THE LOOP COUNTER
FWRL10: MOVE T1,CI ;INPUT (PRIMARY) CDB
PUSHJ P,@.IOISR(T1) ;READ NEXT INPUT BYTE
JRST FWRL18 ;[40] MAYBE LSN
FWRL15: MOVE T1,CO ;OUTPUT (SLAVE) CDB
PUSHJ P,@.IOOSR(T1) ;WRITE CURRENT BYTE TO THE SLAVE FILE
JRST FWRL60 ;ERROR, TELL REMOTE
AOS J$SBYT(J) ;COUNT THIS BYTE
SOSLE J$SFC(J) ;[36] EXHAUSTED OUR QUANTUM YET?
JRST FWRL10 ;[36] NO, GO COPY ANOTHER BYTE
PUSHJ P,SCHEDZ ;[36] YES, GIVE SOMEONE ELSE A CHANCE
POPJ P, ;[36] MUST HAVE BEEN ABORTED
JRST FWRL09 ;[36] CONTINUE WITH THE COPY
FWRL18: CAIE M0,$EILSN ;[40] GOT A LINE SEQUENCE NUMBER?
JRST FWRL30 ;[40] MAYBE ACCOMP
MOVE T3,T2 ;[40] POSITION LSN
MOVEI T2,.FULSN ;[40] FUNCTION: WRITE LSN
MOVE T1,CO ;[40] SELECT OUTPUT (SLAVE) CDB
PUSHJ P,.IOFUN## ;[40] WRITE THE LSN
JRST FWRL60 ;[40] CHECK OUT ERROR
JRST FWRL10 ;[40] GO BACK AND TRY FOR REAL DATA
;LOOP READING RECORDS FROM THE REMOTE, WRITING TO THE SLAVE FILE
FWRL19: MOVX T1,RECFC ;[36] GET THE FAIRNESS COUNT FOR RECORDS
MOVEM T1,J$SFC(J) ;[36] AND INIT THE LOOP COUNTER
FWRL20: MOVE T1,CI ;INPUT (PRIMARY) CDB
SETO T2, ;NO PARTICULAR RECORD ADDRESS
DMOVE T3,J$RLEN(J) ;RECORD BUFFER COUNTER AND POINTER
PUSHJ P,@.IOISR(T1) ;READ NEXT INPUT RECORD
JRST FWRL30 ;MAYBE ACCOMP
FWRL25: MOVE P3,T3 ;COPY THE RECORD LENGTH
MOVE T1,CO ;OUTPUT (SLAVE) CDB
PUSHJ P,@.IOOSR(T1) ;WRITE CURRENT RECORD TO THE SLAVE FILE
JRST FWRL60 ;ERROR, TELL REMOTE
ADDM P3,J$SBYT(J) ;COUNT HOW MANY WE COPIED
SOSLE J$SFC(J) ;[36] EXHAUSTED OUR QUANTUM YET?
JRST FWRL20 ;[36] NO, GO COPY ANOTHER RECORD
PUSHJ P,SCHEDZ ;[36] YES, GIVE SOMEONE ELSE A CHANCE
POPJ P, ;[36] MUST HAVE BEEN ABORTED
JRST FWRL19 ;[36] CONTINUE WITH THE COPY
;HERE ON EXCEPTION RETURN FROM INPUT BYTE
FWRL30: MOVE IO,CI ;SELECT PRIMARY CDB
CAIE M0,$EINMP ;INPUT MESSAGE PENDING?
POPJ P, ;[15] NO. OTHER SIDE MUST HAVE GONE AWAY
PUSHJ P,RDMSG1## ;START UP DAP MESSAGE
PJRST NETERI## ;[21] HMMMM
CAIE T2,$DHACM ;ACCESS COMPLETE?
BADDAP (MA.SYN,,<Received DAP message not DATA nor ACCOMP in FWRL10>)
JRST FWRI90 ;GO HANDLE ACCOMP
;ERROR WRITING SLAVE OUTPUT FILE
FWRL60: MOVE IO,CI ;SELECT PRIMARY CDB
MOVE T2,M0 ;POSITION RETURNED ERROR STATUS
MOVEI T4,DS2EI## ;DAP STATUS TO I/O STATUS TRANSLATION TABLE
PUSHJ P,FFIND1 ;TRANSLATE TO DAP STATUS
SKIPA T1,[$DSWER] ;GENERIC WRITE ERROR, $E???? AS SECONDARY STATUS
SETZ T2, ;KNOWN ERROR, NO SECONDARY STATUS
ADDI T1,50000 ;DAP I/O LEVEL ERROR
SETZB T3,T4 ;NOTHING ELSE EITHER
PUSHJ P,FXSTS1 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED
PUSHJ P,RDEAT1## ;EAT REST OF ANY CURRENT INPUT MESSAGE
POPJ P, ;NET DIED
;ERROR STATE IDLE LOOP - WAIT FOR CONTINUE OR ABORT
;*** REALLY NEEDS INTERRUPT LEVEL MESSAGES!!!
FWRL70: PUSHJ P,RDMSG1## ;START NEXT DAP INPUT MESSAGE
PJRST NETERI## ;[21] NET DIED
FWRL71: JSP T4,.CDISP## ;DISPATCH ON DAP MESSAGE TYPE
FWRL74,,$DHDAT ;DATA
FWRL80,,$DHCNT ;CONTINUE
FWRI90,,$DHACM ;ACCOMP
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Unknown/illegal DAP message type in FWRL70>)
;HERE ON DATA MESSAGE - EAT IT UP
FWRL74: PUSHJ P,RDDAT1## ;FIRE UP THE DATA MESSAGE
PJRST NETERI## ;[21] NET DIED
PUSHJ P,RDEAT1## ;EAT THE DATA MESSAGE (UPDATING THE CRC)
POPJ P, ;NET DIED
JRST FWRL70 ;LOOP WAITING FOR CONTINUE
;HERE ON "CONTINUE" MESSAGE
FWRL80: PUSHJ P,RDDAP1## ;READ IN CONTINUE MESSAGE
PJRST NETERI## ;[21] NET DIED
MOVD1 T2,C2F ;CONTINUE TYPE
FWRL81: JSP T4,.CDISP## ;DISPATCH ON CONTINUATION TYPE
FWRL83,,$DVCTA ;TRY AGAIN
FWRL84,,$DVCSK ;SKIP AND IGNORE
FWRL90,,$DVCAB ;ABORT FILE
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Unknown/illegal continue type in FWRL81>)
;HERE TO TRY TO CONTINUE THE I/O
FWRL83: TDZA T2,T2 ;TRY AGAIN
FWRL84: MOVEI T2,1 ;SKIP AND IGNORE
STOPCD <Error continuation not yet written in FWRL84>
;HERE TO ABORT FURTHER I/O - WAIT FOR ACCOMP OF SOME FLAVOR
FWRL90: PUSHJ P,RDMSG1## ;START UP NEXT DAP INPUT MESSAGE
PJRST NETERI## ;[21] NET DIED
FWRL91: JSP T4,.CDISP## ;DISPATCH ON RECEIVED MESSAGE TYPE
FWRL94,,$DHDAT ;DATA
FWRI90,,$DHACM ;ACCOMP
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Unknown/illegal message type in FWRL90>)
;HERE ON DATA MESSAGE, JUST EAT IT UP
FWRL94: PUSHJ P,RDDAT1## ;FIRE UP THE DATA MESSAGE
PJRST NETERI## ;[21] NET DIED
PUSHJ P,RDEAT1## ;EAT THE DATA (UPDATING THE CRC)
POPJ P, ;NET DIED
JRST FWRL90 ;LOOP WAITING FOR ACCOMP
;END OF FILE ACCESS
;
;FILE IS DONE, CLOSE OUTPUT FILE
FWRZ00:
FWRZ10: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOCLO0## ;CLOSE THE OUTPUT FILE
CAIA ;ERROR
JRST FWRZ90 ;CAP OFF WITH ACCOMP
FWRZ17: PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET MUST HAVE DIED
JRST FWRI00 ;BACK TO IDLE LOOP WITH OUTPUT FILE STILL OPEN
;RENAME CURRENT FILE
FWRZ30: PUSHJ P,FRDCB1 ;READ IN NEW ATTRIBUTES/NAME MESSAGES
JRST [CAIE M0,$ECAUR ;ABORTED AT [REMOTE] USER'S REQUEST?
POPJ P, ;NO, LINK BLOWN AWAY
CAIE T2,$DVATR ;ACCOMP(TERMINATE)?
BADDAP (MA.SYN,,<Unknown/illegal ACCOMP message in FWRZ30>)
PJRST FWRZ80] ;YES, SEND ACCOMP(RESPONSE), GO IDLE
SKIPN .IOFS3(CO) ;*** DID WE RECEIVE A FILE SPEC?
JRST FWRZ10 ;*** NO, JUST CLOSE THE FILE NORMALLY
PUSHJ P,FRDCE1 ;DO THE REQUESTED RENAME OPERATION
JRST FWRZ17 ;OOPS - RENAME FAILED, INFORM THE REMOTE
JRST FWRZ90 ;FILE CLOSED (BY IOFRN), SEND ACCOMP(RESPONSE)
;ABORT THE CURRENT FILE
FWRZ50:
;TERMINATE ACCESS (SAME AS ABORT FOR THE WRITE-CASE)
FWRZ80: MOVE IO,CO ;POINT TO SLAVE CDB
PUSHJ P,IOABO1## ;ABORT THE CURRENT FILE, IF POSSIBLE
DEBUG <IOABO failed in FWRZ50>,,,.POPJ##
;ACCESS IS COMPLETED
FWRZ90: SKIPN T1,J$RALC(J) ;GOT A RECORD BUFFER?
JRST FWRZ92 ;NOPE
MOVE T2,J$RALC+1(J) ;YUP
PUSHJ P,.MMFWD## ;FREE IT UP
JFCL ;SHOULDN'T AUGHTA HAPPEN!
SETZM J$RALC(J) ;NO LONGER HAVE A RECORD BUFFER
FWRZ92: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
;FWSP01 -- HERE TO PROCESS A "SPOOLED" FILE
;
;Here if the created file is a local "spooled" file. In order to do it
;"right" FAL must go through some pretty amazing gyrations so that, comme
;par example, the remote user's name appears on the (e.g.,) printer banner.
;
;For this to work requires monitor version 70155 or later, previous
;monitors will not properly set up ppn, account string, and user name
;(as set here by the SPPRM.).
FWSP01: SETO T2, ;FLAG "SPOOLED" NONSENSE TO QUEOP
PUSHJ P,QUEOP0## ;AND LET QUEOP FIGURE IT ALL OUT
WARN FWQ,<QUEOP to set spooling parameters didn't>
JRST .POPJ1## ;THAT TURNED OUT TO BE PRETTY EASY AFTER ALL...
;A stillborn method of handling the spooling stuff . . . included mostly
;for the reader's amusement . . .
REPEAT 0,< ;FOR PRE-70155 MONITORS, THIS ALMOST WORKS
MOVE P4,.IODCH(IO) ;STASH A COPY OF REAL SPOOLED CHARACTERISTICS
HLRZ T2,.I1DEV(IO) ;GET "REAL" DEVICE NAME
MOVEI T4,FWSPTQ ;TABLE OF DEVICE-TO-QUEUE CORRESPONDENCE
PUSHJ P,.CFIND## ;MATCH THE DEVICE TO A QUEUE
JRST .POPJ1## ;FORGET IT
MOVE P3,T1 ;SAVE THE QUEUE CODE FOR AWHILE
LDB T1,[POINTR .I1DEV(IO),<^O777700>] ;NOMINAL NODE FIELD
LDB T2,[POINTR .I1DEV(IO),<^O000077>] ;NOMINAL UNIT FIELD
JUMPN T2,FWSP06 ;IF UNIT THEN NODE MUST PRECEDE
JUMPN T1,FWSP03 ;NO UNIT, THEN ONLY ONE OF NODE OR UNIT
;HERE IF JUST GENERIC DEVICE (E.G., "LPT:")
SETZB T1,T2 ;IF BLANK THEN NEITHER NODE NOR UNIT
JRST FWSP09 ;SET NODE AND UNIT INFO
;HERE IF JUST NODE OR UNIT (E.G., "LPT1:" OR "LPT22:")
FWSP03: TRNN T1,000077 ;ONE IF BY UNIT, TWO IF BY NODE
JRST FWSP05 ;REALLY MEANT ONLY UNIT . . .
LSHC T1,-3 ;LOW ORDER DIGIT OF NODE
LSH T1,-3 ;STRIP OFF SIXBIT CHARACTER JUNK
LSHC T1,3 ;RECOMBINE THE TWO-DIGIT NODE NUMBER
ANDI T1,77 ;AND JUST THE TWO-DIGIT NODE NUMBER
SETZ T2, ;NO UNIT INFO
JRST FWSP09 ;SET NODE AND UNIT INFO
;HERE IF BOTH NODE AND UNIT (E.G., "LPT221:")
FWSP05: EXCH T1,T2 ;REPOSITION UNIT NUMBER, NULL NODE NUMBER
LSH T2,-6 ;RIGHT-JUSTIFY UNIT NUMBER
FWSP06: MOVEI M0,-'0'(T2) ;SAVE UNIT NUMBER IN M0
LSHC T1,-3 ;LOW ORDER DIGIT OF NODE
LSH T1,-3 ;STRIP OFF SIXBIT JUNK
LSHC T1,3 ;RECOMBINE THE TWO DIGIT NODE NUMBER
ANDI T1,77 ;AND JUST THE TWO-DIGIT NODE NUMBER
MOVE T2,M0 ;RETRIEVE THE UNIT NUMBER
HRLI T2,.QBUPH ;AND NOTE IT IS A PHYSICAL UNIT REQUEST
FWSP09: MOVEM T1,.IOQND(IO) ;SET /DESTINATION NODE NUMBER
MOVEM T2,.IOQUN(IO) ;SET /UNIT NUMBER, IF ANY
;NOW SET "JOB NAME" FROM USER-SPECIFIED FILE NAME (IF ANY)
FWSP10: MOVE T1,.I1LKP+.RBNAM(IO) ;GET ENTER'ED FILE NAME
MOVEM T1,.IOQ6J(IO) ;AND SET THAT AS THE QUEUE REQUEST NAME
;CONTINUED ON NEXT PAGE
;STILL IN REPEAT 0
;CONTINUED FROM PREVIOUS PAGE
;ABORT THE AS-SPECIFIED-BY-USER FILE
FWSP30: PUSHJ P,IOABO0## ;ABORT THE FILE
JFCL ;CAN'T HAPPEN
;NOW SETUP OUR VERY OWN IMITATION SPOOL FILE SPL:FALnnn.SPL
FWSP40: MOVE P1,.IOFSB(IO) ;ADDRESS OF FILE SPEC BLOCK FOR OUTPUT
SETO T2, ;NON-WILD MASK
MOVSI T1,'SPL' ;DEVICE IS SYSTEM-SPOOL
DMOVEM T1,.FXDEV(P1) ;SET IN FILE SPEC BLOCK
XMOVEI T3,[ASCIZ\SPL\] ;ASCII STRING DEVICE NAME
MOVEM T3,.FSDEV(P1) ;SET IN FILE SPEC BLOCK
SETZM .FXDIR(P1) ;NO DIRECTORY
SETZM .FXDIR(P1) ; . . .
SETZM .FSDIR(P1) ; . . .
MOVE T1,['FAL001'] ;FILE NAME
DMOVEM T1,.FXNAM(P1) ;SET IN FILE SPEC BLOCK
XMOVEI T3,[ASCIZ\FAL001\] ;ASCII STRING FILE NAME
MOVEM T3,.FSNAM(P1) ;SET IN FILE SPEC BLOCK
HRLOI T1,'SPL' ;DEFAULT FILE TYPE
MOVEM T1,.FXEXT(P1) ;SET IN FILE SPEC BLOCK
XMOVEI T3,[ASCIZ\SPL\] ;ASCII STRING FILE TYPE
MOVEM T3,.FSEXT(P1) ;SET IN FILE SPEC BLOCK
MOVX T1,FX.SUP ;ALSO SPECIFY /ERSUPERSEDE
IORM T1,.FXMOD(P1) ;IN THE FILE SPEC BLOCK
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY TOO!
;NOW CREATE THE FILE, LOOPING ON THE 'nnn' UNTIL A FILE IS CREATED
FWSP50: MOVX T1,IM.UNQ ;THE CREATE-UNIQUE-NAME FLAG
IORM T1,.IOIOM(IO) ;TELL IOPOU . . .
SETZ T2, ;NO INPUT FILE FROM WHICH TO WILDCARD
PUSHJ P,IOPOU0## ;CREATE OUTPUT FILE
PJRST [PUSHJ P,FOFI01 ;PROCESS UNEXPECTED FILE ERROR
POPJ P, ;ERROR RETURN
POPJ P,] ;DIFFERENT ERROR RETURN
;FAKE SPOOL FILE ALL SET UP!
FWSP60: MOVEM P4,.IODCH(IO) ;RETURN FAKE SPOOL CHARACTERISTICS
MOVEM P3,FQUFNC ;*** SET SPOOLED FLAG
JRST .POPJ1## ;SUCCESSFUL INTERCEPTED RETURN
;STILL IN REPEAT 0
;TABLE OF DEVICE TYPE TO QUEUE CORRESPONDENCE
FWSPTQ: .QUPRT,,'LPT' ;LINEPRINTERS
.QUCDP,,'CDP' ;CARD PUNCH
.QUPTP,,'PTP' ;PAPER TAPE PUNCH
.QUPLT,,'PLT' ;PLOTTER
0 ;THAT'S ALL
> ;END OF REPEAT 0 FOR PRE-70155 MONITORS
SUBTTL File rename access
FREN00: MOVE IO,CI ;ADDRESS OF PRIMARY CDB
;READ IN SECONDARY NAME MESSAGE (NEW FILE SPECIFICATION)
FREN02: PUSHJ P,FRENA1 ;READ IN ALL THE ANCILLIARY STUFF
JRST [CAIE M0,$ECAUR ;ABORTED AT [REMOTE] USER'S REQUEST?
POPJ P, ;NO, LINK BLOWN AWAY
CAIN T2,$DVATR ;YES, MUST BE ACCOMP(TERMINATE)
PJRST FJOB93 ;SEND ACCOMP(RESPONSE), GO IDLE
BADDAP (MA.SYN,,<Illegal/unknown ACCOMP message in FREN02>)
]
;LOOP FINDING FILES
FREN10: PUSHJ P,FIFIL1 ;FIND NEXT POSSIBLY-WILD INPUT FILE
POPJ P, ;(0) NET DIED OR OTHER FATAL ERROR
JRST FREN90 ;(1) INPUT FILE STREAM EXHAUSTED
;(2) CONTINUE WITH RETURNED FILE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FREN20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
MOVD T1,AOP ;ACCESS OPTIONS FIELD
MOVD P1,ADS ;ACCESS DISPLAY FIELD
TFNN T1,GNG ;IF NOT GO/NOGO
FJUMPE P1,ADS,FREN50 ;AND NO DISPLAY THEN ALL DONE HERE
;HERE IF NEED TO SEND NAME/ATTRIBUTES
FREN22: PUSHJ P,FANTY1 ;HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
POPJ P, ;NET DIED
MOVD P1,ADS ;RETRIEVE ACCESS DISPLAY FIELD AGAIN
FJUMPE P1,ADS,FREN29 ;CAP OFF WITH ACK IF NO DISPLAY REQUESTED
PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FREN20>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FREN20>,,,.POPJ##
FREN29: PUSHJ P,FX7ACK ;CAP OFF FILE NAME/ATTRIBUTES
POPJ P, ;NET DIED?
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED
FREN40: MOVD T1,AOP ;GET ACCESS OPTIONS
TFNN T1,GNG ;DID REMOTE SPECIFY GO/NOGO?
JRST FREN50 ;NO, JUST RENAME THE FILE
PUSHJ P,XDFLS1## ;YES, FLUSH OUT ATTR/ET AL TO REMOTE
PJRST NETERO## ;[21] NET DIED?
;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND
FREN41: PUSHJ P,RDMSG1## ;GET REMOTE'S GO/NOGO DECISION
PJRST NETERI## ;[21] NET MUST HAVE DIED
FREN42: JSP T4,.CDISP## ;DISPATCH BASED ON REMOTE'S DECISION
FREN43,,$DHSTS ;STATUS - SHOULDN'T HAPPEN
FREN45,,$DHCNT ;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
FREN48,,$DHACM ;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
0 ;NONE OTHER
BADDAP (MA.SYN,,<Unknown GO/NOGO response from remote at FREN42>)
;RECEIVED STATUS
FREN43: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
BADDAP (MA.SYN,,<STATUS received in FREN40>)
;RECEIVED CONTINUE
FREN45: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,C2F ;CONTINUE FUNCTION CODE
CAIN T1,$DVCSK ;SKIP THIS FILE?
JRST FREN70 ;YES, KEEP THIS FILE
CAIN T1,$DVCRS ;RESUME PROCESSING?
JRST FREN50 ;YES, RENAME THIS FILE
BADDAP (MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FREN45>)
;RECEIVED ACCOMP
FREN48: PUSHJ P,RDCLR1## ;CLEAR OUT DAP AREA
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;READ IN REST OF ACCESS COMPLETE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,A2F ;GET ACCESS COMPLETE FUNCTION
CAIN T1,$DVACL ;NORMAL FUNCTION TERMINATION?
JRST FREN50 ;YES, RENAME THE FILE
CAIN T1,$DVASK ;WANT TO SKIP THIS FILE?
JRST FREN70 ;YES, DON'T RENAME THE FILE
CAIN T1,$DVATR ;WANT TO TERMINATE/ABORT THIS ACCESS?
JRST FREN90 ;YES
BADDAP (MA.INV,ACM!20,<Unknown ACCOMP function in FREN48>)
;HERE TO RENAME THE CURRENT FILE
FREN50: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOFRN1## ;RENAME CURRENT FILE
CAIA ;ERROR RETURN
JRST FREN60 ;TIME FOR SECOND ATTRIBUTES/NAME
;HERE WHEN RENAME FAILS (NOTE NAME/ATTR ALREADY SENT . . .)
PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
JRST FREN90 ;NET DIED?
JRST FREN10 ;TRY FOR NEXT FILE
;NOW SEND RESULTANT NAME/ATTRIBUTES
FREN60: MOVE IO,CI ;SELECT PRIMARY CDB AGAIN
MOVD T1,AOP ;ACCESS OPTIONS FIELD
MOVD P1,ADS ;ACCESS DISPLAY FIELD
TFNN T1,GNG ;IF NOT GO/NOGO
FJUMPE P1,ADS,FREN10 ;AND NO DISPLAY THEN ALL DONE HERE
;HERE IF NEED TO SEND SECOND SET OF NAME/ATTRIBUTES
FREN62: PUSHJ P,FSNTY1 ;HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
POPJ P, ;NET DIED
MOVD P1,ADS ;RETRIEVE ACCESS DISPLAY FIELD AGAIN
FJUMPE P1,ADS,FREN69 ;CAP OFF WITH ACK IF NO DISPLAY REQUESTED
PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FREN60>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FREN60>,,,.POPJ##
FREN69: PUSHJ P,FX7ACK ;CAP OFF FILE NAME/ATTRIBUTES
POPJ P, ;NET DIED?
JRST FREN10 ;TRY FOR ANOTHER FILE
;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE
FREN70: MOVE IO,CO ;POINT TO SLAVE CDB
MOVX T1,IM.SAD ;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
IORM T1,.IOIOM(IO) ;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
PUSHJ P,IOCLO1## ;TOSS THE CURRENT FILE
JFCL ;DON'T CARE
MOVX T1,IM.SAD ;THE BIT AGAIN
ANDCAM T1,.IOIOM(IO) ;CLEAR BACK OUT OF THE CDB
JRST FREN10 ;TRY FOR ANOTHER FILE
;ALL FILES PROCESSED, ACCESS IS COMPLETED
FREN90: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
;RENAME-class helper subroutines
;FRENA - Read in the "ancilliary" messages that follow the ACCESS(RENAME)
;
;Also used by ACCOMP(RENAME)
FRENA1: PUSHJ P,RDMSG1## ;START THE NEXT MESSAGE IN
PJRST NETERI## ;NET DIED?
JSP T4,.CDISP## ;DISPATCH BASED ON MESSAGE TYPE
FRENA4,,$DHATR ;MAIN ATTRIBUTES, SLURP IT UP
FRENA4,,$DHALC ;ALLOCATION ATTRUBUTES
FRENA4,,$DHTIM ;DATE/TIME ATTRIBUTES
FRENA4,,$DHPRT ;PROTECTION ATTRIBUTES
FRENA5,,$DHNAM ;NAME
FRENA9,,$DHACM ;ACCOMP
0 ;NONE OTHERS
;RECEIVED ATTRIBUTES OF SOME FLAVOR, JUST SLURP THEM UP
FRENA4: PUSHJ P,RDDAP1## ;READ IN THE ATTRIBUTES MESSAGE
JSP T4,FERDP ;ERROR IN ATTRIBUTES MESSAGE
JRST FRENA1 ;LOOP WAITING FOR NAME MESSAGE
;RECEIVED NAME MESSAGE
FRENA5: PUSHJ P,RDDAP1## ;READ IN THE NAME MESSAGE BODY
PJRST NETERI## ;[21] NET DIED?
MOVD T1,NTY ;NAME TYPE FIELD
TFNN T1,NFS ;CONTAIN A FILE SPECIFICATION?
BADDAP (MA.SYN,,<Not a file spec NAME message in FRENA5>)
PUSHJ P,DPRNN1## ;PARSE THE RECEIVED NAME FILE SPEC
STOPCD <DPRNN failed in FRENA5>
SKIPN T1,.IOXFF(CO) ;SLAVE FREE SPACE
ERROR NES,<No "extra" space in slave CDB in FREN02>
ADDI T1,.FXMAX ;SIZE OF FILE SPEC BLOCK
CAML T1,.IOXSZ(CO) ;ROOM FOR TERTIARY FILE SPEC BLOCK?
ERROR NRI,<No room in slave CDB for tertiary FSB in FREN02>
EXCH T1,.IOXFF(CO) ;ALLOCATE ONE FSB FROM "EXTRA" SPACE
ADD T1,CO ;RELOCATE FSB ADDRESS INTO MEMORY
MOVEM T1,.IOFS3(CO) ;SET "OUTPUT" FILE SPEC BLOCK ADDRESS
MOVEM T1,.IOFS3(CI) ;SET PRIMARY TOO, JUST ON G.P.S
MOVEI T2,.FXMAX ;SIZE OF FILE SPEC BLOCK
PUSHJ P,.GTSPC## ;COPY OVER THE FILE SPEC BLOCK
;NOW COPY OVER ANY "NEW" ATTRIBUTES TOO
MOVE P3,.IOIOC(CO) ;CURRENT I/O CONTROL
MOVE P4,.IOIOM(CO) ;CURRENT I/O MODE FLAGS
PUSHJ P,FAJA10 ;VERIFY ATTRIBUTES/ET AL
POPJ P, ;OOPS
;THIS TERMINATES THE "ANCILLIARY" MESSAGES, TIME TO DO THE REAL WORK NOW!
JRST .POPJ1## ;SUCCESSFUL RETURN
;RECEIVED ACCOMP - REMOTE MUST WANT TO ABORT THE ACCESS
FRENA9: PUSHJ P,RDCLR1## ;CLEAR OUT THE DAP DATA
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;READ IN THE ACCOMP MESSAGE
POPJ P, ;OH WELL
MOVD T2,A2F ;THE ACCOMP FUNCTION CODE
MOVEI M0,$ECAUR ;NOTE RECEIVED ACCOMP BEFORE NAME MESSAGE
POPJ P, ;LET CALLER FIGURE OUT WHAT TO DO
SUBTTL File delete access
FDEL00:
;LOOP FINDING FILES
FDEL10: PUSHJ P,FIFIL1 ;FIND NEXT POSSIBLY-WILD INPUT FILE
POPJ P, ;(0) NET DIED OR OTHER FATAL ERROR
JRST FDEL90 ;(1) INPUT FILE STREAM EXHAUSTED
;(2) CONTINUE WITH RETURNED FILE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FDEL20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
MOVD T1,AOP ;ACCESS OPTIONS FIELD
MOVD P1,ADS ;ACCESS DISPLAY FIELD
TFNN T1,GNG ;UNLESS GO/NOGO
FJUMPE P1,ADS,FDEL50 ;THEN NO NAME/ATTR IF NO DISPLAY
;HERE IF NEED NAME AND/OR ATTRIBUTES MESSAGES
FDEL22: PUSHJ P,FANTY1 ;SEND WILDCARDED NAMES AS NEEDED
POPJ P, ;NET DIED?
MOVD P1,ADS ;RETRIEVE COPY OF ACCESS DISPLAY
FJUMPE P1,ADS,FDEL29 ;IF NO DISPLAY, CAP OFF NAME WITH AN ACK
PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FDEL20>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FDEL20>,,,.POPJ##
FDEL29: PUSHJ P,FX7ACK ;CAP OFF NAME/ATTRIBUTES WITH AN ACK
POPJ P, ;NET DIED?
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED
FDEL40: MOVD T1,AOP ;GET ACCESS OPTIONS
TFNN T1,GNG ;DID REMOTE SPECIFY GO/NOGO?
JRST FDEL50 ;NO, JUST DELETE THE FILE
PUSHJ P,XDFLS1## ;YES, FLUSH OUT ATTR/ET AL TO REMOTE
PJRST NETERO## ;[21] NET DIED?
;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND
FDEL41: PUSHJ P,RDMSG1## ;GET REMOTE'S GO/NOGO DECISION
PJRST NETERI## ;[21] NET MUST HAVE DIED
FDEL42: JSP T4,.CDISP## ;DISPATCH BASED ON REMOTE'S DECISION
FDEL43,,$DHSTS ;STATUS - SHOULDN'T HAPPEN
FDEL45,,$DHCNT ;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
FDEL48,,$DHACM ;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
0 ;NONE OTHER
BADDAP (MA.SYN,,<Unknown GO/NOGO response from remote at FDEL42>)
;RECEIVED STATUS
FDEL43: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
BADDAP (MA.SYN,,<STATUS received in FDEL40>)
;RECEIVED CONTINUE
FDEL45: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,C2F ;CONTINUE FUNCTION CODE
CAIN T1,$DVCSK ;SKIP THIS FILE?
JRST FDEL70 ;YES, KEEP THIS FILE
CAIN T1,$DVCRS ;RESUME PROCESSING?
JRST FDEL50 ;YES, DELETE THIS FILE
BADDAP (MA.INV,CNT!20,<Unknown or illegal CONTINUE function in FDEL45>)
;RECEIVED ACCOMP
FDEL48: PUSHJ P,RDCLR1## ;CLEAR OUT STALE DAP FIELDS FIRST
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;READ IN REST OF ACCESS COMPLETE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,A2F ;GET ACCESS COMPLETE FUNCTION
CAIN T1,$DVACL ;NORMAL FILE TERMINATION?
JRST FDEL50 ;YES, DELETE THE FILE
CAIN T1,$DVASK ;SKIP THIS FILE?
JRST FDEL70 ;YES, KEEP THIS FILE
CAIN T1,$DVATR ;WANT TO TERMINATE/ABORT THIS ACCESS?
JRST FDEL90 ;YES
BADDAP (MA.SYN,,<Unknown ACCOMP function in FDEL48>)
;HERE TO DELETE THE CURRENT FILE
FDEL50: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOFDL1## ;DELETE CURRENT FILE
CAIA ;ERROR RETURN
JRST FDEL10 ;TRY FOR ANOTHER FILE
;HERE WHEN DELETE FAILS (NOTE NAME/ATTR ALREADY SENT . . .)
PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
JRST FDEL90 ;NET DIED?
JRST FDEL10 ;TRY FOR NEXT FILE
;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE
FDEL70: MOVE IO,CO ;POINT TO SLAVE CDB
MOVX T1,IM.SAD ;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
IORM T1,.IOIOM(IO) ;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
PUSHJ P,IOCLO1## ;TOSS THE CURRENT FILE
JFCL ;DON'T CARE
MOVX T1,IM.SAD ;THE BIT AGAIN
ANDCAM T1,.IOIOM(IO) ;CLEAR BACK OUT OF THE CDB
JRST FDEL10 ;TRY FOR ANOTHER FILE
;ALL FILES PROCESSED, ACCESS IS COMPLETED
FDEL90: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
SUBTTL File directory-list access
;The multithreaded nature of this FAL will require a little high overhead
;handwaving here. Since this directory listing is just going to LOOKUP
;files on disk, and since LOOKUPs always block, it's likely that we'll
;spend more time doing LOOKUPs than it will take the remote end to process
;our message. If this is the case, this directory listing will run to the
;exclusion of all the other streams. In addition, no status update messages
;will ever be sent to QUASAR, so SHOW STATUS FAL-STREAM would give an
;erroneous indication of Idle in our behalf. What we're going to do here
;is deschedule the task after we've listed a few files, so that everyone
;else can get a chance.
FDIR00:
;LOOP FINDING FILES
FDIR10: PUSHJ P,FIFIL1 ;FIND NEXT POSSIBLY-WILD INPUT FILE
POPJ P, ;(0) NET DIED OR OTHER FATAL ERROR
JRST FDIR90 ;(1) INPUT FILE STREAM EXHAUSTED
;(2) CONTINUE WITH RETURNED FILE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FDIR20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
PUSHJ P,FANTY5 ;[6] FORCE NAME MESSAGES FOR "DIRECTORY"
DEBUG <FANTY failed in FDIR20>,,,.POPJ##
;COPY OVER AND SEND ANY FILE ATTRIBUTES REQUESTED
FDIR22: MOVD P1,ADS ;ACCESS DISPLAY FIELD
FJUMPE P1,ADS,FDIR29 ;[11] IF NO DISPLAY ALL DONE HERE
PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FDIR22>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FDIR22>,,,.POPJ##
FDIR29: PUSHJ P,FX7ACK ;[11] SEPARATE FILES WITH ACK IF V7.0
POPJ P, ;[11] NET DIED?
;END OF FILE INFORMATION.
FDIR40: ;NO FILE PROCESSING
;ADVANCE TO NEXT INPUT FILE
FDIR70: MOVE IO,CO ;POINT TO SLAVE CDB
PUSHJ P,IOCLO1## ;TOSS THE CURRENT FILE
JFCL ;DON'T CARE
JRST FDIR10 ;TRY FOR ANOTHER FILE
;ALL FILES PROCESSED, ACCESS IS COMPLETED
FDIR90: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
SUBTTL File (BATCH) submission access
FSUB00: BADDAP (MA.UNS,ACS!20,<DAP "SUBMIT" operation not supported>)
FEXE00: PUSHJ P,NONPP1 ;DISALLOW NETPPN HERE
JRST [PUSHJ P,FOFI01 ;SEND ERROR STATUS TO REMOTE
POPJ P, ;NET DIED?
JRST FJOB95] ;BACK TO IDLE STATE
;LOOP FINDING FILES
FEXE10: PUSHJ P,FIFIL1 ;FIND NEXT POSSIBLY-WILD INPUT FILE
POPJ P, ;(0) NET DIED OR OTHER FATAL ERROR
JRST FEXE90 ;(1) INPUT FILE STREAM EXHAUSTED
;(2) CONTINUE WITH RETURNED FILE
;RETURN FILE INFORMATION TO REMOTE ACCESSOR (E.G., NFT)
FEXE20: MOVE IO,CI ;RE-SELECT PRIMARY CDB
MOVD T1,AOP ;ACCESS OPTIONS
MOVD P1,ADS ;ACCESS DISPLAY FIELD
TFNN T1,GNG ;UNLESS GO/NOGO SPECIFIED
FJUMPE P1,ADS,FEXE50 ;THEN NO NAMES/ATTRIBUTES IF NO DISPLAY
;HERE WHEN MUST RETURN NAMES AND/OR ATTRIBUTES TO THE REMOTE ACCESSOR
FEXE22: PUSHJ P,FANTY1 ;SEND BACK RESULTANT WILDCARDED NAMES
POPJ P, ;NET DIED?
MOVD P1,ADS ;RETRIEVE ACCESS DISPLAY REQUEST
FJUMPE P1,ADS,FEXE29 ;IF NO DISPLAY THEN CAP OFF NAMES WITH AN ACK
PUSHJ P,FFAD01 ;TRANSLATE FILE ATTRIBUTES INTO DAP BLOCK
DEBUG <FFAD failed in FEXE20>,,,.POPJ##
MOVD P1,ADS ;RESTORE ACCESS DISPLAY FIELD
PUSHJ P,FXAT01 ;SEND ATTRIBUTES MESSAGES
DEBUG <FXAT failed in FEXE20>,,,.POPJ##
FEXE29: PUSHJ P,FX7ACK ;CAP OFF WITH AN ACK
POPJ P, ;NET DIED?
;END OF FILE INFORMATION - HANDLE GO/NOGO IF SPECIFIED
FEXE40: MOVD T1,AOP ;GET ACCESS OPTIONS
TFNN T1,GNG ;DID REMOTE SPECIFY GO/NOGO?
JRST FEXE50 ;NO, JUST SUBMIT THE FILE
PUSHJ P,XDFLS1## ;YES, FLUSH OUT ATTR/ET AL TO REMOTE
PJRST NETERO## ;[21] NET DIED?
;NOW WAIT FOR REMOTE TO MAKE UP ITS MIND
FEXE41: PUSHJ P,RDMSG1## ;GET REMOTE'S GO/NOGO DECISION
PJRST NETERI## ;[21] NET MUST HAVE DIED
FEXE42: JSP T4,.CDISP## ;DISPATCH BASED ON REMOTE'S DECISION
FEXE43,,$DHSTS ;STATUS - SHOULDN'T HAPPEN
FEXE45,,$DHCNT ;CONTINUE - RESPONSE FOR GO/NOGO (OBSOLETE)
FEXE48,,$DHACM ;ACCESS COMPLETE - RESPONSE FOR GO/NOGO
0 ;NONE OTHER
BADDAP (MA.SYN,,<Unknown GO/NOGO response from remote at FEXE42>)
;RECEIVED STATUS
FEXE43: PUSHJ P,RDSTS1## ;READ IN REST OF STATUS
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
BADDAP (MA.SYN,,<STATUS received in FEXE40>)
;RECEIVED CONTINUE
FEXE45: PUSHJ P,RDDAP1## ;READ IN REST OF CONTINUE MESSAGE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,C2F ;CONTINUE FUNCTION CODE
CAIN T1,$DVCSK ;SKIP THIS FILE?
JRST FEXE70 ;YES, KEEP THIS FILE
CAIN T1,$DVCRS ;RESUME PROCESSING?
JRST FEXE50 ;YES, SUBMIT THIS FILE
BADDAP (MA.SYN,,<Unknown or illegal CONTINUE function in FEXE45>)
;RECEIVED ACCOMP
FEXE48: PUSHJ P,RDCLR1## ;CLEAR OUT STALE DAP INFO
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;READ IN REST OF ACCESS COMPLETE
PJRST NETERI## ;[21] SHOULDN'T HAPPEN
MOVD1 T1,A2F ;GET ACCESS COMPLETE FUNCTION
CAIN T1,$DVACL ;NORMAL FILE TERMINATION?
JRST FEXE50 ;YES, EXECUTE THIS FILE
CAIN T1,$DVASK ;SKIP THIS FILE?
JRST FEXE70 ;YES, LEAVE THE BATCH SYSTEM ALONE
CAIN T1,$DVATR ;WANT TO TERMINATE/ABORT THIS ACCESS?
JRST FEXE90 ;YES
BADDAP (MA.INV,ACM!20,<Unknown ACCOMP function in FEXE48>)
;HERE TO SUBMIT THE CURRENT FILE
FEXE50: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOFSU1## ;SUBMIT THE CURRENT OPEN FILE
CAIA ;OOPS - FAILURE
JRST FEXE73 ;CLOSE THIS ONE AND TRY FOR ANOTHER FILE
;HERE WHEN THE SUBMIT REQUEST FAILS
PUSHJ P,FOFI01 ;SEND STATUS MESSAGE TO REMOTE
JRST FEXE90 ;NET DIED? ABORT ACCESS
JRST FEXE73 ;TRY FOR ANOTHER FILE
;SKIP CURRENT FILE, ADVANCE TO NEXT INPUT FILE
FEXE70: MOVE IO,CO ;POINT TO SLAVE CDB
MOVX T1,IM.SAD ;THE SUPPRESS-ACCESS-DATE-UPDATE BIT
IORM T1,.IOIOM(IO) ;PRETEND NOT TO HAVE ACCESSED CURRENT FILE
FEXE73: PUSHJ P,IOCLO1## ;TOSS THE CURRENT FILE
JFCL ;DON'T CARE
MOVX T1,IM.SAD ;THE BIT AGAIN
ANDCAM T1,.IOIOM(IO) ;CLEAR BACK OUT OF THE CDB
JRST FEXE10 ;TRY FOR ANOTHER FILE
;ALL FILES PROCESSED, ACCESS IS COMPLETED
FEXE90: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IORLS1## ;WE ARE DONE WITH FILE-LEVEL OPERATIONS
JFCL ;DON'T CARE
JRST FJOB93 ;SEND ACCOMP(RESPONSE)
SUBTTL General-purpose file-level subroutines
;HELPER TO PARSE FILE FROM ACCESS MESSAGE
FALIF0: TDZA T2,T2 ;FLAG FIRST TIME IN
FALIF1: MOVEI T2,1 ;FLAG CONTINUATION READ
PUSHJ P,.SAVE4## ;SCAN'S CH AND NM ARE OUR P3 AND P4 !!!
MOVE P2,T2 ;PROTECT FLAG
SETZM .IOXTO(IO) ;USE IOXTO AS COUNTER/FLAG HERE
XMOVEI T1,FALIFI ;OUR VERY OWN INPUT TYPER
PUSHJ P,.XTYPI## ;INTERCEPT "COMMAND" INPUT
XMOVEI T1,FALIFO ;OUR VERY OWN OUTPUT TYPER
PUSHJ P,.XTYPO## ;INTERCEPT "COMMAND" OUTPUT
XMOVEI T1,FALIFE ;OUR VERY OWN ERROR PROCESSOR
PUSHJ P,FALERI ;[50] INTERCEPT FATAL SCAN ERRORS
JUMPG P2,FALIF3 ;JUST CONTINUE IF NOT FIRST TIME
MOVE T1,[POINT 7,[0]];A DUMMY STRING
MOVEM T1,.IOXTI(IO) ;SET IN CASE .CLRTI NEEDS SOMETHING
PUSHJ P,.CLRTI## ;SETUP LOWLEVEL COMMAND INPUT ROUTINES
MOVE T1,[POINT 7,.IDFIL(IO)] ;BYTE POINTER TO FILE SPEC
MOVEM T1,.IOXTI(IO) ;SET FOR FALIFI
ILDB T1,T1 ;PEEK AT FIRST CHARACTER
JUMPE T1,.POPJ## ;IF NULL, NO FILESPEC, REJECT IT
;NOW PARSE THE FILE SPEC
FALIF3: PUSHJ P,.FILSP## ;LET SCAN DO ITS THING
JRST FALIFE ;ERROR - DIE
SKIPN .IOXTO(IO) ;IT BETTER NOT HAVE COMPLAINED
JRST .POPJ1## ;RETURN WITH PARSED FILE IN F.BLK
FALIFE:
IFE FTDEBUG,POPJ P, ;JUST RETURN IF NOT DEBUGGING
IFN FTDEBUG,< ;ONLY COMPLAIN IF DEBUGGING
DEBUG <Error in parsing received NAME message in FALIF>,FALIFF,,.POPJ##
FALIFF: MOVEI T1,[ASCIZ\
Bad name string = "\]
PUSHJ P,.TSTRG## ;IDENTIFY ERROR STRING
PUSH P,[POINT 7,.IDFIL(CI)] ;[20] POINTER TO OFFENDING STRING
SKIPA ;[20] GO GET THE FIRST CHAR
PUSHJ P,.TFCHR## ;TYPE POSSIBLY-FUNNY CHARACTER
ILDB T1,(P) ;[20] NEXT CHARACTER
JUMPN T1,.-2 ;TYPE CHARACTERS UNTIL END OF STRING
POP P,T1 ;[20] CLEAN THE STACK
MOVEI T1,[ASCIZ\" from node \]
PUSHJ P,.TSTRG## ;ANOTHER TEXT STRING
MOVE T1,.ION6M(IO) ;OFFENDING NODE
PJRST .TSIXN## ;FINK ON HIM >
;THE "COMMAND" INPUT ROUTINE
FALIFI: ILDB CH,.IOXTI(IO) ;GET NEXT CHARACTER FROM NAME STRING
JUMPN CH,.POPJ## ;RETURN USEFUL CHARACTER
MOVEI CH,.CHLFD ;END OF STRING, RETURN EOL TO SCAN
POPJ P, ;TERMINATE SCAN
;THE "COMMAND" OUTPUT ROUTINE
FALIFO: OUTCHR T1 ;OH WELL
AOS .IOXTO(IO) ;COUNT OCCURENCES
POPJ P, ;RETURN TO SCAN
;FIFIL -- FIND NEXT POSSIBLY-WILDCARDED INPUT FILE
;CALL IS:
;
; PUSHJ P,FIFIL
; fatal return
; exhausted return
; normal return
;
;The "fatal" return is taken when, for example, the network has died,
;or any other fatal processing error has occurred; The "exhausted"
;return is taken when the input file stream is exhausted (i.e., there
;are no more input files); The "normal" return is taken with the next
;(presumably slave) input file setup ready for I/O.
;
;On file access errors the remote (primary CDB) is informed of the
;error automatically, with whatever name/etc. messages are necessary
;being sent as appropriate.
;
;When the "exhausted" return is taken the caller should send an
;ACCOMP(RESPONSE) to the remote.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.
FIFIL1: MOVE IO,CO ;SELECT SLAVE CDB
PUSHJ P,IOPIN1## ;ADVANCE TO NEXT INPUT FILE
JRST FIFI01 ;ERROR/EXCEPTION
PUSHJ P,COPSPC ;GO COPY THE FILE SPECIFICATION
POPJ P, ;OOPS - ABORTED
CPOPJ2: AOS (P) ;SUCCESS HERE IS DOUBLE-
CPOPJ1: AOS (P) ; SKIP-
CPOPJ0: POPJ P, ; RETURN
;INPUT FILE ACCESS EXCEPTION RETURN - FIGURE OUT WHAT HAPPENED
FIFI01: CAIN M0,$EFIXN ;INPUT FILE STREAM EXHAUSTED?
JRST .POPJ1## ;YES, TAKE "EXHAUSTED" RETURN
CAIN M0,$EFIXE ;INPUT FILE STREAM EXHAUSTED (REDUNDANTLY)?
STOPCD <IOPIN returned "redundantly" exhausted in FIFI00>
;RANDOM FILE ACCESS ERROR, CONVERT TO DAPESE AND PUNT TO REMOTE
MOVE IO,CI ;SELECT PRIMARY CDB
PUSH P,M0 ;SAVE THE ERROR CODE
PUSHJ P,FANTY1 ;SEND ANY NAME MESSAGES AS NEEDED
JRST M0POPJ ;NET DIED - TAKE FATAL ERROR RETURN
POP P,T2 ;RESTORE FILE ACCESS ERROR CODE
MOVEI T4,DS2EF## ;DAP-STATUS-TO-FILE-STATUS-TABLE ADDRESS
PUSHJ P,FFIND1 ;SEE IF KNOWN ERROR
SKIPA T1,[$DSACC] ;FILE ACCESS ERROR, $E???? AS SECONDARY STATUS
SETZ T2, ;KNOWN ERROR, NO SECONDARY ERROR CODE
ADDI T1,40000 ;DAP FILE ACCESS ERROR LEVEL
SETZB T3,T4 ;NOTHING
PUSHJ P,FXSTS1 ;SEND REMOTE DAP STATUS
POPJ P, ;NET DIED - FATAL ERROR RETURN
;WE NOW WAIT FOR REMOTE TO MAKE UP ITS MIND AS TO ERROR RECOVERY
FIFI20: PUSHJ P,RDMSG1## ;START UP NEW DAP INPUT MESSAGE
PJRST NETERI## ;[21] NET DIED
;DISPATCH ON RECEIVED DAP MESSAGE TYPE
FIFI21: JSP T4,.CDISP## ;DISPATCH ON DAP MESSAGE TYPE
FIFI30,,$DHCNT ;CONTINUE
FIFI40,,$DHACM ;ACCOMP
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Unknown/illegal DAP message in FIFI21>)
;HERE ON CONTINUE MESSAGE, MUST BE CONTINUATION OF SOME SORT
FIFI30: PUSHJ P,RDDAP1## ;READ IN CONTINUE MESSAGE
PJRST NETERI## ;[21] NET DIED?
MOVD1 T2,C2F ;GET CONTINUE TYPE
CAIN T2,$DVCSK ;"SKIP" TO NEXT FILE?
JRST FIFIL1 ;YES, TRY FOR ANOTHER FILE
BADDAP (MA.INV,CNT!20,<Unknown/illegal CONTINUE type in FIFI30>)
;HERE ON ACCOMP MESSAGE, MAYBE CONTINUATION OR ABORT
FIFI40: PUSHJ P,RDCLR1## ;CLEAR OUT DAP REGION
STOPCD ;CAN'T HAPPEN
PUSHJ P,RDDAP1## ;READ IN ACCOMP MESSAGE
PJRST NETERI## ;[21] NET DIED?
MOVD1 T2,A2F ;GET ACCOMP TYPE
JSP T4,.CDISP## ;DISPATCH ON ACCOMP TYPE
FIFIL1,,$DVACL ;CLOSE
FIFIL1,,$DVAKL ;KILL
FIFIL1,,$DVASK ;SKIP
CPOPJ1,,$DVATR ;TERMINATE/ABORT
0 ;NONE OTHERS
BADDAP (MA.SYN,,<Unknown/illegal ACCOMP type in FIFI40>)
;FOFIL -- CREATE OUTPUT FILE
;CALL IS:
;
; PUSHJ P,FOFIL
; fatal return
; exhausted return
; normal return
;
;The "fatal" return is taken when, for example, the network has died,
;or any other fatal processing error has occurred; The "exhausted"
;return is taken when the output file create failed and the
;remote has been informed of the error; The "normal" return is taken
;with the slave output file setup ready for I/O.
;
;On file access errors the remote (primary CDB) is informed of the
;error automatically, with whatever name/etc. messages are necessary
;being sent as appropriate.
;
;When the "exhausted" return is taken the caller should return to
;the "pre-ACCESS" state.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.
FOFIL1: MOVE IO,CO ;SELECT SLAVE CDB
SETZ T2, ;NO INPUT FILE FROM WHICH TO WILDCARD
PUSHJ P,IOPOU1## ;CREATE OUTPUT FILE
JRST FOFI01 ;ERROR/EXCEPTION RETURN
PUSHJ P,COPSPC ;COPY THE FILESPEC FOR FALGLX
POPJ P, ;ABORTED - RETURN
JRST CPOPJ2 ;DOUBLE-SKIP RETURN FOR SUCCESS
;OUTPUT FILE CREATE ERROR - FIGURE OUT WHAT HAPPENED
FOFI01: MOVE IO,CI ;SELECT PRIMARY (REMOTE ACCESSOR) CDB
MOVE T2,M0 ;POSITION ERROR CODE
MOVEI T4,DS2EF## ;DAP-STATUS-TO-FILE-STATUS-TABLE ADDRESS
PUSHJ P,FFIND1 ;SEE IF KNOWN ERROR
SKIPA T1,[$DSACC] ;FILE ACCESS ERROR, $E???? AS SECONDARY STATUS
SETZ T2, ;KNOWN ERROR, NO SECONDARY STATUS
ADDI T1,40000 ;DAP FILE ACCESS ERROR LEVEL
SETZB T3,T4 ;NOTHING ELSE
PUSHJ P,FXSTS1 ;SEND DAP ERROR STATUS TO REMOTE
POPJ P, ;NET DIED
JRST CPOPJ1 ;SINGLE-SKIP "EXHAUSTED" RETURN
;FAJA -- VERIFY AND PROCESS RECEIVED ATTIBUTES/ET AL
;CALL IS:
;
; PUSHJ P,FAJA
; error return
; normal return
;
;FAJA reads and verifies the received attributes from the remote, and
;based on those attributes, and the access request, sets up the slave
;CDB for subsequent file access operations.
;
;FAJA expects the caller to have set up IO to the primary CDB, and CO
;to point to the slave CDB.
;
;On error return the remote requested an unsupported/illegal/etc.
;attribute/operation/etc., an error code is in M0.
;
;On normal return the slave CDB is ready for file access operations
;on behalf of the remote ACCESS message request.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.
FAJA01: MOVE P3,FALOVC ;PROTOTYPE I/O CONTROL
MOVE P4,FALOVM ;PROTOTYPE I/O MODE CONTROL
;CHECK OUT THE RECEIVED ACCESS MESSAGE
SKIPN .IDAFC(IO) ;WAS AN ACCESS FUNCTION RECEIVED?
BADDAP (MA.INV,ACS!20,<FAJA: No ACCESS function specified>)
MOVD T1,AOP ;GET ACCESS OPTIONS REQUESTED
TFZ T1,<GNG,ACK> ;CLEAR KNOWN/SUPPORTED STUFF
TFZ T1,<OKE> ;*** KEEP THE VAX HAPPY
FJUMPE T1,AOP,FAJA03 ;OK IF NOTHING ELSE LEFT
BADDAP (MA.UNS,ACS!21,<FAJA: Unknown or unsupported AOP flags>)
FAJA03: LDB T1,[POINT 7,.IDFIL(IO),6] ;FIRST BYTE OF FILE SPEC
JUMPN T1,FAJA04 ;ENSURE RECEIVED A FILE SPEC
BADDAP (MA.UNS,ACS!22,<FAJA: No ACCESS filespec>)
FAJA04: MOVD T1,FAC ;FILE ACCESS REQUESTED
TFZ T1,<PUT,GET,DEL,UPD,TRN> ;CLEAR OK STUFF
FJUMPE T1,FAC,FAJA06 ;OK IF NOTHING LEFTOVER
BADDAP (MA.UNS,ACS!23,<FAJA: Unknown or unsupported FAC flags>)
FAJA06: MOVD T1,SHR ;SHARED FILE ACCESS
TFZ T1,<GET,NIL> ;[44] CLEAR OK STUFF
FJUMPE T1,SHR,FAJA07 ;OK IF NOTHING LEFT OVER
BADDAP (MA.UNS,ACS!24,<FAJA: Unknown or unsupported SHR flags>)
FAJA07: MOVD T1,ADS ;ACCESS DISPLAY (RETURN ATTRIBUTES)
TFZ T1,<DMA,DAA,DDT,DFP,DNM,DN3> ;CLEAR OK STUFF
FJUMPE T1,ADS,FAJA08 ;OK IF NOTHING LEFT OVER
BADDAP (MA.UNS,ACS!25,<FAJA: Unknown or unsupported ADS flags>)
FAJA08: LDB T1,[POINT 7,.IDPSW(IO),6] ;FIRST CHAR OF PASSWORD
JUMPE T1,FAJA10 ;OK IF NO PASSWORD
BADDAP (MA.UNS,ACS!26,<FAJA: ACCESS password specified>)
;CHECK OUT MAIN ATTRIBUTES
FAJA10: MOVD P1,M02 ;MAIN ATTRIBUTES MENU
SETZ T4, ;INITIALLY NO DATA TYPE SELECTED
MOVD1 T2,AFC ;GET ACCESS TYPE (READ, WRITE, ETC)
CAIN T2,$DVAWR ;FILE CREATE OPERATION?
JRST FAJA15 ;YES
;HERE FOR ALL READ-CLASS FILE ACCESS OPERATIONS
FAJA11: TMNN P1,DTY ;WAS A DATA-TYPE FIELD SUPPLIED?
JRST FAJA12 ;NO
PUSHJ P,FAJAD1 ;YES, PROCESS DATA-TYPE
POPJ P, ;OOPS, ILLEGAL BITS SET
JUMPN T4,FAJA13 ;GO WITH USER-SUPPLIED DATA-MODE
FAJA12: TXO P4,IM.SMD ;NO DATA-MODE, SELECT DEFAULT FROM FILE
FAJA13: TMNN P1,BSZ ;GOT A BYTE-SIZE FIELD?
TDZA T3,T3 ;NO, GET IT FROM INPUT FILE THEN
MOVD1 T3,BSZ ;YES, SELECT USER-SUPPLIED BYTE SIZE
JRST FAJA19 ;DONE WITH READ-SPECIFIC
;HERE FOR WRITE-CLASS FILE ACCESS
FAJA15: TMNN P1,DTY ;DATA-TYPE GIVEN?
JRST FAJA16 ;NO
PUSHJ P,FAJAD1 ;YES, PROCESS USER-SPECIFIED DATA-TYPE
POPJ P, ;ILLEGAL FLAGS
JUMPN T4,FAJA17 ;GO WITH USER-SPECIFIED DATA-MODE
FAJA16: MOVD1 T1,FST ;REMOTE FILE SYSTEM TYPE
CAIN T1,$DVFF1 ;FCS-11?
JRST [MOVD T1,DTY ;GET DATA TYPE FIELD
TFO T1,ASC ;ASSERT ASCII DATA TYPE
MOVDM T1,DTY ;SET BACK IN MEMORY
MOVEI T4,.ICASC ;FLAG ASCII FILE MODE
JRST FAJA17] ;CONTINUE ONWARDS
BADDAP (MA.INV,ATR!21,<FAJA: no data mode specified for file create>)
FAJA17: TMNN P1,BSZ ;GOT A BYTE SIZE?
SKIPA T3,[^D08] ;NO, THEN DAP SAYS 8-BIT BYTES
MOVD1 T3,BSZ ;YES, GO WITH USER-SPECIFIED BYTE SIZE
FAJA19: DPB T4,[POINTR P3,IC.MOD] ;SET FILE MODE
CAIE T3,^D00 ;IF NO BYTE SIZE
CAIN T3,^D08 ;OR 8-BIT BYTES
CAIE T4,.ICASC ;AND ASCII FILE MODE
CAIA ; (NO TO ABOVE)
MOVEI T3,^D07 ;THEN REALLY WANT 7-BIT BYTES (GRRR!!)
HRRZM T3,.IOBSZ(CO) ;SELECT LOGICAL DATA BYTE SIZE
HRRZM T3,.IOFSZ(CO) ;SELECT PHYSICAL FRAME BYTE SIZE
HRRZM T3,.IOUBS(CO) ;SELECT OVERRIDING BYTE SIZE
;CHECK "FILE ORGANIZATION"
FAJA20: TMNN P1,ORG ;FILE ORGANIZATION SET?
JRST FAJA22 ;NO
MOVD T1,ORG ;YES
CAIE T1,$DVOSQ ;SEQUENTIAL FILE ORGANIZATION?
BADDAP (MA.UNS,ATR!22,<FAJA: Unknown or unsupported ORG type>)
;CHECK RECORD FORMAT
FAJA22: TMNN P1,RFM ;RECORD FORMAT SET?
JRST FAJA24 ;NO
MOVD T1,RFM ;YES
CAIE T1,$DVFNR ;NO-FORMAT RECORD FORMAT?
CAIN T1,$DVFST ;ASCII-STREAM RECORD FORMAT?
JRST FAJA24 ;YES
CAIE T1,$DVFVR ;VARIABLE-LENGTH RECORDS?
CAIN T1,$DVFVF ;VARIABLE-WITH-FIXED-HEADER RECORDS?
JRST FAJA24 ;YES
CAIN T1,$DVFFX ;FIXED-LENGTH RECORDS?
JRST FAJA24 ;YES
BADDAP (MA.UNS,ATR!23,<FAJA: Unknown or unsupported RFM type>)
;CHECK RECORD ATTRIBUTES
FAJA24: TMNN P1,RAT ;RECORD ATTRIBUTES SET?
JRST FAJA26 ;NO
MOVD T1,RAT ;GET REQUESTED RECORD ATTRIBUTES
TFZE T1,MCY ;MACY11-FORMATTING?
TXO P3,IC.MCY ;YES, SET IN I/O CONTROL
TFZE T1,LSA ;LINE-SEQUENCED ASCII?
TXO P3,IC.LSN ;YES, SET IN I/O CONTROL
TFZ T1,<ILC,NSB,EFC>;CLEAR OUT IGNORABLE STUFF
MOVD1 T3,AFC ;GET ACCESS FUNCTION
CAIN T3,$DVAWR ;IS THIS A FILE "CREATE"
TFZ T1,<CCC,FCC,PRN>;YES, IGNORE CARRIAGE-CONTROL FLAGS
; (I.E., FAL WILL BE "READING" FROM REMOTE
; WHICH ISR SUPPORTS ALL THESE VARIATIONS
; WHEREAS ALL OTHER FILE ACCESSES APPEAR
; AS "WRITING" TO REMOTE, WHICH OSR DOESN'T
; SUPPORT THAT STUFF, SO FLAG IT ERROR)
FJUMPE T1,RAT,FAJA26 ;ANYTHING LEFT OVER?
BADDAP (MA.UNS,ATR!24,<FAJA: Unknown or unsupported RAT bits>)
;CHECK FILE ACCESS OPTIONS
FAJA26: TMNN P1,FOP ;FILE ACCESS OPTIONS SET?
JRST FAJA40 ;NO
MOVD T1,FOP ;GET REQUESTED OPTIONS
TFZE T1,SUP ;SUPERSEDE FILE?
PUSHJ P,[MOVX T3,FX.SUP ;YES, GET /ERSUPERSEDE
MOVE T4,.IOFSB(CO) ;ADDRESS OF OUTPUT FILE SPEC BLOCK
ANDCAM T3,.FXMOD(T4) ;CLEAR /ERSUPERSEDE
IORM T3,.FXMOM(T4) ;AND INDICATE /OKSUPERSEDE
POPJ P,] ;CONTINUE
TFZE T1,CTG ;CONTIGUOUS ALLOCATION?
TXO P4,IM.CTG ;YES
TFZE T1,CBT ;CONTIGUOUS BEST TRY?
TXO P4,IM.CBT ;YES
;*** TFZE T1,SCF ;SUBMIT FILE ON CLOSE?
;*** TXO P4,IM.CSU ;YES
;*** TFZE T1,SPC ;PRINT FILE ON CLOSE?
;*** TXO P4,IM.CPR ;YES
;*** TFZE T1,DLT ;DELETE FILE ON CLOSE?
;*** TXO P4,IM.CDL ;YES
TFZ T1,<SCF,SPC,DLT>;*** HANDLED BY FACL01 INSTEAD
TFZ T1,<CIF,SQO,MXV,TEF> ;IGNORABLE FLAGS
FJUMPE T1,FOP,FAJA40 ;OK IF NOTHING LEFT OVER
BADDAP (MA.UNS,ATR!35,<FAJA: Unknown or unsupported FOP bits>)
;FINISH REST OF MAIN ATTRIBUTES (LENGTH/ALLOCATION/ETC.)
FAJA40: MOVEM P3,.IOIOC(CO) ;SET I/O CONTROL
MOVEM P4,.IOIOM(CO) ;SET I/O MODE CONTROL
MOVE T1,.IOIOC(CI) ;[40] FETCH PRIMARY-CDB I/O CONTROL
MOVX T2,IC.LSN ;[40] THE LSN FLAG
TDNE P3,T2 ;[40] LSN IN EFFECT?
TDOA T1,T2 ;[40] YES
TDZ T1,T2 ;[40] NO
MOVEM T1,.IOIOC(CI) ;[40] FORCE I/O CONTROL
MOVD1 T3,BLS ;GET RETURNED DAP DATA BLOCK SIZE (IF ANY)
MOVEM T3,.IOBLS(CO) ;AND SET FILE PARAMETER
MOVD1 T3,MRS ;GET RETURNED DAP RECORDSIZE (IF ANY)
MOVEM T3,.IORSZ(CO) ;AND SET FILE PARAMETER
MOVD1 T1,ALQ ;GET RETURNED DAP ALLOCATION ("BLOCKS" - IF ANY)
IMUL T1,.IOBLS(CO) ;CONVERT TO DATA BYTES
MOVEM T1,.IOALB(CO) ;SET ALLOCATION IN BYTES FILE PARAMETER
SKIPN .IOBSZ(CO) ;GOT A BYTE SIZE?
JRST FAJA43 ;NO (???)
MOVEI T2,^D36 ;-10 WORD SIZE
IDIV T2,.IOBSZ(CO) ;T2:=BYTES PER -10 WORD
IDIV T1,T2 ;T1:=FILE ALLOCATION IN -10 WORDS
CAIE T2,0 ;EXACT FIT?
ADDI T1,1 ;NO, NEED ONE MORE [PARTIAL] WORD
FAJA43: MOVEM T1,.IOALW(CO) ;SET ALLOCATION IN WORDS FILE PARAMETER
;HANDLE DATE/TIME ATTRIBUTES
FAJA50: MOVD P1,M13 ;DATE/TIME ATTRIBUTES MENU
TMNN P1,CDT ;GOT A CREATION DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,CDT ;GET RETURNED LOGICAL CREATION DATE/TIME
MOVEM T1,.IOCDT(CO) ;SET FILE PARAMETER
TMNN P1,UDT ;GOT UPDATE DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,UDT ;GET RETURNED UPDATE DATE/TIME
MOVEM T1,.IOUDT(CO) ;SET UPDATE TIME FILE PARAMETER
TMNN P1,EDT ;GOT EXPIRATION DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,EDT ;GET RETURNED EXPIRATION DATE/TIME
MOVEM T1,.IOEDT(CO) ;SET EXPIRATION DATE/TIME FILE PARAMETER
TMNN P1,BDT ;GOT BACKUP DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,BDT ;GET BACKUP DATE/TIME
MOVEM T1,.IOBDT(CO) ;SET BACKUP DATE/TIME FILE PARAMETER
TMNN P1,PDT ;GOT PHYSICAL DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,PDT ;GET RETURNED PHYSICAL CREATION DATE/TIME
MOVEM T1,.IOPDT(CO) ;SET PHYSICAL CREATION DATE/TIME FILE PARM
TMNN P1,ADT ;GOT ACCESS DATE/TIME?
TDZA T1,T1 ;NO, THEN BLANK THE FIELD
MOVD1 T1,ADT ;GET ACCESS DATE/TIME
MOVEM T1,.IOADT(CO) ;SET ACCESS DATE/TIME FILE PARAMETER
;HANDLE PROTECTION ATTRIBUTES
;
;FAJA ASSUMES THAT THE PROTECTION FIELDS ARE ALL ONE WORD LONG. AS THIS
;IS NOT REALLY GUARANTEED, CAUSE ASSEMBLY ERROR IF IT EVER CHANGES
IFN $DLPSY-1,<PRINTX ?PSY field not one word long in FAJA60>
IFN $DLPOW-1,<PRINTX ?POW field not one word long in FAJA60>
IFN $DLPGR-1,<PRINTX ?PGR field not one word long in FAJA60>
IFN $DLPWL-1,<PRINTX ?PWL field not one word long in FAJA60>
FAJA60: MOVD P1,M14 ;PROTECTION ATTRIBUTES MENU
SETZB T2,T3 ;START OFF BLANK
TMNN P1,PWL ;GOT A "WORLD" PROTECTION?
JRST FAJA62 ;NO
MOVD T1,PWL ;GET RETURNED "WORLD" PROTECTION
PUSHJ P,DPFPXL## ;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA62: LSHC T2,-3 ;SAVE VALUE SO FAR
SETZ T2, ;MAKE ROOM FOR NEW
TMNN P1,PGR ;GOT A "GROUP" PROTECTION?
JRST FAJA64 ;NO
MOVD T1,PGR ;GET RETURNED "GROUP" PROTECTION
PUSHJ P,DPFPXL## ;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA64: LSHC T2,-3 ;ACCUMULATE THIS "GROUP" FIELD TOO
SETZ T2, ;MAKE ROOM FOR OWNER
TMNN P1,POW ;GOT "OWNER" PROTECTION?
JRST FAJA66 ;NO
MOVD T1,POW ;GET RETURNED "OWNER" PROTECTION
PUSHJ P,DPFPXO## ;TRANSLATE INTO TOPS-10 LEVEL-D DISK PROTECTION
FAJA66: LSHC T2,6 ;T2:=NINE-BIT TOPS-10 LEVEL-D DISK PROTECTION
HRROM T2,.IOPRT(CO) ;SET FOR FILE SERVICE
;FILE ATTRIBUTES/ETC. ALL SET, READY FOR FILE OPERATIONS
FAJA90: JRST .POPJ1## ;SUCCESSFUL RETURN
;FAJAD - HELPER TO FAJA TO PROCESS DATA-TYPE FIELD
FAJAD1: MOVD T1,DTY ;GET DATA TYPE FIELD
;FIRST CHECK EXTRANEOUS KRUFT
TFZE T1,ZOD ;DID REMOTE REQUEST ZERO-ON-DELETE?
TXO P4,IM.ZOD ;YES, FLAG IT
;NOW LOOK FOR A REAL DATA-TYPE
MOVEI T4,.ICASC ;ASCII FILE MODE
TFZE T1,ASC ;ASCII DATA?
JRST FAJAD7 ;YES
MOVEI T4,.ICBIN ;BINARY FILE MODE
TFZE T1,IMG ;IMAGE DATA?
JRST FAJAD7 ;YES
SKIPN T4,T1 ;ALL BITS USED UP?
JRST .POPJ1## ;YES, NO FILE DATA MODE THEN
BADDAP (MA.UNS,ATR!21,<FAJAD: Unknown or unsupported DTY bits>)
FAJAD7: TXO P4,IM.CMD ;SET FORCED IC.MOD FLAG
JUMPE T1,.POPJ1## ;HAPPY IF NOTHING LEFT OVER
BADDAP (MA.UNS,ATR!21,<FAJAD: Conflicting, unknown, or unsupported DTY bits>)
;FANTY -- HANDLE ANY NAME MESSAGES DUE TO WILDCARDING
;CALL IS:
;
; PUSHJ P,FANTY
FANTY1: MOVE T1,.IODPV(CI) ;ACCESSOR'S PROTOCOL LEVEL
CAIGE T1,007000 ;7.0 OR LATER?
JRST FANTY3 ;NO, DO IT THE GUESS-HOW WAY
MOVD T1,ADS ;YES, REMOTE EXPLICITLY CONTROLS NAME MSGS
TFNN T1,DN3 ;DOES REMOTE WANT 3-PART NAME MESSAGES?
JRST .POPJ1## ;NO, NO NAME MESSAGES HERE THEN
JRST FANTY5 ;YES, FORCE 3-PART NAME MESSAGES
FANTY3: SKIPN .WLDFL## ;DOES WILD THINK THERE ARE ANY WILDCARDS?
JRST .POPJ1## ;NO, NOTHING TO DO HERE THEN
FANTY5: PUSHJ P,FGNTY1 ;SEE WHAT NAME MESSAGES NEED TO BE SENT
STOPCD <FGNTY failed in FANTY>
PUSHJ P,FXNA01 ;SEND NAME MESSAGES (P1 SET FROM ABOVE)
DEBUG <FXNA failed in FANTY>,,,.POPJ##
JRST .POPJ1## ;SUCCESSFUL RETURN
;FSNTY -- HANDLE ANY NAME MESSAGES DUE TO WILDCARDING (SECOND SET)
;CALL IS:
;
; PUSHJ P,FSNTY
FSNTY1: MOVE T1,.IODPV(CI) ;ACCESSOR'S PROTOCOL LEVEL
CAIGE T1,007000 ;7.0 OR LATER?
JRST FSNTY3 ;NO, DO IT THE GUESS-HOW WAY
MOVD T1,ADS ;YES, REMOTE EXPLICITLY CONTROLS NAME MSGS
TFNN T1,DN3 ;DOES REMOTE WANT 3-PART NAME MESSAGES?
JRST .POPJ1## ;NO, NO NAME MESSAGES HERE THEN
JRST FSNTY5 ;YES, FORCE 3-PART NAME MESSAGES
FSNTY3: SKIPN .WLDFL## ;DOES WILD THINK THERE ARE ANY WILDCARDS?
JRST .POPJ1## ;NO, NOTHING TO DO HERE THEN
FSNTY5: PUSHJ P,FCNTY1 ;SEE WHAT NAME MESSAGES NEED TO BE SENT
STOPCD <FCNTY failed in FSNTY>
DMOVE T1,.IOF3D(CO) ;PUT .IOF3D(CO), .IOF3V(CO)
DMOVEM T1,.IOFND(CO) ;INTO .IOFND(CO), .IOFDV(IO) FOR FXNA01
DMOVE T1,.IOF3R(CO) ;PUT .IOF3R(CO), .IOF3M(CO)
DMOVEM T1,.IOFDR(CO) ;INTO .IOFDR(CO), .IOFNM(IO) FOR FXNA01
DMOVE T1,.IOF3X(CO) ;PUT .IOF3X(CO), .IOF3N(CO)
DMOVEM T1,.IOFEX(CO) ;INTO .IOFEX(CO), .IOFGN(IO) FOR FXNA01
PUSHJ P,FXNA01 ;SEND NAME MESSAGES (P1 SET FROM ABOVE)
DEBUG <FXNA failed in FSNTY>,,,.POPJ##
JRST .POPJ1## ;SUCCESSFUL RETURN
REPEAT 0,<
;FCICO -- SET SLAVE CDB FROM PRIMARY CDB
;CALL IS:
;
; MOVX CI,<SRC>
; MOVX CO,<DST>
; PUSHJ P,FCICO
; error return
; normal return
;
;Where <SRC> is the source CDB address; and <DST> is the destination
;CDB address.
;
;FCICO is used to copy the various file-specific information from the
;primary (remote-driven to FAL) I/O CDB to the slave (FAL-driven on
;behalf of the remote) I/O CDB, usually in preparation for file-level
;operations via the slave CDB.
;
;The error return is not exercised.
;
;On normal return the file information from the <SRC> CDB has been
;copied into the <DST> CDB.
;
;Uses T1, T2, T3, T4.
FCICO:
;FIRST THE GENERIC FILE INFORMATION
FCICO1: MOVSI T3,.IOBZC(CI) ;SOURCE ADDRESS
HRRI T3,.IOBZC(CO) ;DESTINATION ADDRESS
BLT T3,.IOEZC-1(CO) ;COPY OVER GENERIC FILE INFO
DMOVE T3,.IOIOC(CI) ;GET PRIMARY I/O AND ERROR CONTROL
DMOVEM T3,.IOIOC(CO) ;SET IN THE SLAVE
MOVE T3,.IOIOM(CI) ;GET PRIMARY I/O MODE CONTROL
MOVEM T3,.IOIOM(CO) ;SET IN THE SLAVE
MOVE T3,.IOUBS(CI) ;GET OVER-RIDING BYTE SIZE
MOVEM T3,.IOUBS(CO) ;SET IN THE SLAVE
;NOW GET OPERATING-SYSTEM-SPECIFIC JUICIES
FCICO2: MOVSI T3,.IOB10(CI) ;SOURCE ADDRESS
HRRI T3,.IOB10(CO) ;DESTINATION ADDRESS
BLT T3,.IOE10-1(CO) ;COPY OVER TOPS-10 FILE INFO
REPEAT 0,< ;SIGH
FCICO3: MOVSI T3,.IOB20(CI) ;SOURCE ADDRESS
HRRI T3,.IOB20(CO) ;DESTINATION ADDRESS
BLT T3,.IOE20-1(CO) ;COPY OVER TOPS-20 FILE INFO
> ;END REPEAT 0 ;SIGH
JRST .POPJ1## ;SUCCESSFUL RETURN
> ;END REPEAT 0
REPEAT 0,< ;NOT NEEDED
;FCOCI -- SET PRIMARY CDB FROM SLAVE CDB
;CALL IS:
;
; MOVX CI,<DST>
; MOVX CO,<SRC>
; PUSHJ P,FCOCI
; error return
; normal return
;
;Where <SRC> is the source CDB address; and <DST> is the destination
;CDB address.
;
;FCOCI is used to copy the various file-specific information from the
;slave (FAL-driven on behalf of the remote) I/O CDB to the primary
;(remote-driven to FAL) I/O CDB, usually in preparation for returning
;attributes/et al to the remote.
;
;The error return is not exercised.
;
;On normal return the file information from the <SRC> CDB has been
;copied into the <DST> CDB.
;
;Uses T1, T2, T3, T4.
FCOCI:
;FIRST THE GENERIC FILE INFORMATION
FCOCI1: MOVSI T3,.IOBZC(CO) ;SOURCE ADDRESS
HRRI T3,.IOBZC(CI) ;DESTINATION ADDRESS
BLT T3,.IOEZC-1(CI) ;COPY OVER GENERIC FILE INFO
DMOVE T3,.IOIOC(CO) ;GET SLAVE I/O AND ERROR CONTROL
DMOVEM T3,.IOIOC(CI) ;COPY INTO THE PRIMARY CDB
MOVE T3,.IOIOM(CO) ;GET SLAVE I/O MODE CONTROL
MOVEM T3,.IOIOM(CI) ;COPY INTO THE PRIMARY CDB
;NOW GET OPERATING-SYSTEM-SPECIFIC JUICIES
FCOCI2: MOVSI T3,.IOB10(CO) ;SOURCE ADDRESS
HRRI T3,.IOB10(CI) ;DESTINATION ADDRESS
BLT T3,.IOE10-1(CI) ;COPY OVER TOPS-10 FILE INFO
REPEAT 0,< ;SIGH
FCOCI3: MOVSI T3,.IOB20(CO) ;SOURCE ADDRESS
HRRI T3,.IOB20(CI) ;DESTINATION ADDRESS
BLT T3,.IOE20-1(CI) ;COPY OVER TOPS-20 FILE INFO
> ;END REPEAT 0 ;SIGH
JRST .POPJ1## ;SUCCESSFUL RETURN
> ;END REPEAT 0
;FGNTY -- DETERMINE NAME MESSAGES TO BE SENT TO REMOTE
;CALL IS:
;
; PUSHJ P,FGNTY
; error return
; normal return
;
;FGNTY returns a NTY (see DAP field definitions) mask of the name
;messages (volume/device, directory, file name/type/generation)
;which should be sent to the remote based on a wildcard file access
;request.
;
;CI and IO should both point to the primary CDB, and CO should point
;to the slave CDB.
;
;The error return is not exercised.
;
;On normal return P1/P2 has the resultant NTY mask of name messages
;which should be sent.
;
;Uses T1, T2, T3, T4, P1, P2.
FGNTY1: MOVDII P1,NTY,NFN ;ALWAYS RETURN FILENAME NAME MESSAGE
MOVE T1,.I1DEV(CO) ;GET CURRENT INPUT DEVICE
CAME T1,.I1DEV(CI) ;SAME AS LAST TIME HERE?
TFO P1,NVN ;NO, NEED A VOLUME NAME TOO
MOVEM T1,.I1DEV(CI) ;SET NEW LAST DEVICE
MOVE T2,[-<.PTMAX-.PTPPN-1>,,.PTPPN] ;PROTOTYPE AOBJN'ER
MOVE T3,T2 ;NEED TWO OF 'EM
ADDI T2,.I1PT2(CO) ;THIS TIMES' PATH
ADDI T3,.I1PT2(CI) ;LAST TIMES' PATH
FGNTY3: MOVE T1,0(T2) ;CURRENT DIRECTORY
CAME T1,0(T3) ;SAME AS LAST TIME?
TFO P1,NDN ;NO, NEED DIRECTORY NAME TOO
MOVEM T1,0(T3) ;SET NEW LAST DIRECTORY
JUMPE T1,.POPJ1## ;EXIT AT END OF DIRECTORY PATH
AOBJP T2,.+1 ;ADVANCE
AOBJN T3,FGNTY3 ; TO NEXT DIRECTORY LEVEL
JRST .POPJ1## ;SUCCESSFUL RETURN
;FCNTY -- DETERMINE NAME MESSAGES TO BE SENT TO REMOTE (SECOND SET)
;CALL IS:
;
; PUSHJ P,FCNTY
; error return
; normal return
;
;FCNTY returns a NTY (see DAP field definitions) mask of the name
;messages (volume/device, directory, file name/type/generation)
;which should be sent to the remote based on a wildcard file access
;request.
;
;CI and IO should both point to the primary CDB, and CO should point
;to the slave CDB.
;
;The error return is not exercised.
;
;On normal return P1/P2 has the resultant NTY mask of name messages
;which should be sent.
;
;Uses T1, T2, T3, T4, P1, P2.
FCNTY1: MOVDII P1,NTY,NFN ;ALWAYS RETURN FILENAME NAME MESSAGE
MOVE T1,.I1LK3+.RBDEV(CO) ;GET CURRENT INPUT DEVICE
CAME T1,.I1LK3+.RBDEV(CI) ;SAME AS LAST TIME HERE?
TFO P1,NVN ;NO, NEED A VOLUME NAME TOO
MOVEM T1,.I1LK3+.RBDEV(CI) ;SET NEW LAST DEVICE
MOVE T2,[-<.PTMAX-.PTPPN-1>,,.PTPPN] ;PROTOTYPE AOBJN'ER
MOVE T3,T2 ;NEED TWO OF 'EM
ADDI T2,.I1PT3(CO) ;THIS TIMES' PATH
ADDI T3,.I1PT3(CI) ;LAST TIMES' PATH
FCNTY3: MOVE T1,0(T2) ;CURRENT DIRECTORY
CAME T1,0(T3) ;SAME AS LAST TIME?
TFO P1,NDN ;NO, NEED DIRECTORY NAME TOO
MOVEM T1,0(T3) ;SET NEW LAST DIRECTORY
JUMPE T1,.POPJ1## ;EXIT AT END OF DIRECTORY PATH
AOBJP T2,.+1 ;ADVANCE
AOBJN T3,FCNTY3 ; TO NEXT DIRECTORY LEVEL
JRST .POPJ1## ;SUCCESSFUL RETURN
;FFAD -- CONVERT FILE ATTRIBUTES INTO DAPESE
;CALL IS:
;
; PUSHJ P,FFAD
; error return
; normal return
;
;FFAD sets the DAP attributes/etc. fields in the primary CDB from
;the generic and os-specific file information (excluding names) contained
;in the slave CDB, usually in preparation to shipping the file attributes
;to the remote in response to an ACCESS request.
;
;FFAD expects the caller to have setup both IO and CI to point to the
;primary CDB, and CO to point to the slave CDB. In addition, P1/P2 are
;expected to hold the original remote-specified main attributes menu.
;
;On error return some incompatibility exists (an error code is in M0).
;
;On normal return the DAP attributes are set up and ready to be sent to
;the remote (e.g., via FXAT).
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.
FFAD01: MOVE P3,.IOIOC(CO) ;I/O CONTROL
MOVE P4,.IOIOM(CO) ;I/O MODE
;MAIN ATTRIBUTES FIELDS
FFAD10: MOVD P1,M02 ;PRELOAD WITH REMOTE'S MAIN ATTRIBUTES MENU
LDB T1,[POINTR P3,IC.MOD] ;PICKUP INTERNAL DATA MODE
SETZB T3,T4 ;INITIALIZE FLAGS
CAIE T1,.ICDEF ;NONE (?) - DEFAULT IS ASCII
CAIN T1,.ICASC ;7-BIT ASCII?
TFO T3,ASC ;YES
CAIN T1,.ICAS8 ;8-BIT ASCII?
TFO T3,ASC ;YES
CAIN T1,.ICEBC ;EBCDIC?
TFO T3,EBC ;YES
CAIE T1,.ICPIM ;PACKED IMAGE?
CAIN T1,.ICIMG ;OR NORMAL IMAGE?
TFO T3,IMG ;YES
CAIE T1,.ICBYT ;BYTE MODE?
CAIN T1,.ICBIN ;OR BINARY MODE?
TFO T3,IMG ;YES
TFNN T3,<ASC,EBC,IMG>;HAS A MODE BEEN SELECTED?
BADDAP (MA.UNS,ATR!21,<No (or unknown) DAP file data mode in FFAD10>)
TXNE P4,IM.ZOD ;ZERO ON DELETE?
TFO T3,ZOD ;YES
MOVDM T3,DTY ;SET MAIN ATTR DATA TYPE FIELD
MOVDII T3,ORG,$DVOSQ ;ALL FILE ACCESSES ARE SEQUENTIAL
MOVDM T3,ORG ;SET MAIN ATTR FILE ORGANIZATION FIELD
TMO P1,<DTY,ORG> ;DATATYPE AND ORGANIZATION ARE ALWAYS SENT
MOVD1 T1,OST ;REMOTE (NFT) OPERATING SYSTEM TYPE
MOVD T3,DTY ;RETRIEVE DATA TYPE
TFNN T3,ASC ;DEALING IN ASCII CHARACTER DATA?
JRST FFAD13 ;NO, BINARY
;SELECT RECORD FORMAT AND ATTRIBUTES FOR ASCII DATA
TMNN P1,RFM ;DID REMOTE SUPPLY "FORMAT"
SKIPA T2,DARFTB##(T1) ;NO, ASCII, GET APPROPRIATE RECORD FORMAT
MOVD1 T2,RFM ;YES, SELECT REMOTE'S ASCII FORMATTING
SETZ T4, ;OTHER HALF OF POTENTIAL WORDS
TMNN P1,RAT ;DID REMOTE SUPPLY RECORD ATTRIBUTES?
SKIPA T3,DARATB##(T1) ;NO, ASCII, GET APPROPRIATE RECORD ATTRIBUTES
MOVD T3,RAT ;YES, SELECT REMOTE'S ASCII RECORD ATTRIBUTES
TXNE P3,IC.LSN ;WANT LINE-SEQUENCED ASCII?
TFO T3,LSA ;YES, THE POOR DUMB FOOL
TXNE P3,IC.CCC ;COBOL CARRIAGE CONTROL?
TFO T3,CCC ;YES
TXNE P3,IC.FCC ;FORTRAN CARRIAGE CONTROL?
TFO T3,FCC ;YES
JRST FFAD19 ;CONTINUE WITH REST OF MAIN ATTR
;SELECT RECORD FORMAT AND ATTRIBUTES FOR IMAGE (BINARY) DATA
FFAD13: TMNN P1,RFM ;DID REMOTE SPECIFY RECORD FORMAT?
SKIPA T2,DBRFTB##(T1) ;NO, BINARY, GET APPROPRIATE RECORD FORMAT
MOVD1 T2,RFM ;YES, USE REMOTE'S FORMAT
SETZ T4, ;OTHER HALF OF POTENTIAL WORDS
TMNN P1,RAT ;DID REMOTE SPECIFY RECORD ATTRIBUTES?
SKIPA T3,DBRATB##(T1) ;NO, BINARY, GET APPROPRIATE RECORD ATTRIBUTES
MOVD T3,RAT ;YES, USE REMOTE'S RECORD ATTRIBUTES
FFAD19: TXNE P3,IC.MCY ;SLAVE FILE MACY11-PACKED?
TFO T3,MCY ;YES
MOVD1M T2,RFM ;SET MAIN ATTRIBUTES RECORD FORMAT FIELD
MOVDM T3,RAT ;SET MAIN ATTRIBUTES RECORD ATTRIBUTES FIELD
TMO P1,<RFM,RAT> ;AND FLAG THEM IN THE MENU TOO
FFAD20: TMZ P1,<BLS,MRS,ALQ>;CLEAR IN CASE DON'T HAVE ANYTHING TO SAY
SKIPN T3,.IOBSZ(CO) ;GET LOGICAL DATA BYTE SIZE
BADDAP (MA.UNS,ATR!36,<No byte size in FFAD20>)
MOVD T1,DTY ;***RETRIEVE COPY OF DATA TYPE
TFNE T1,ASC ;*** ASCII DATA?
MOVEI T3,^D08 ;*** YES, TELL NET WE ARE SENDING 8-BIT DATA
MOVD1M T3,BSZ ;SET MAIN ATTR BYTE SIZE FIELD
TMO P1,BSZ ;AND FLAG IT IN THE MENU TOO
FFAD21: SKIPN T3,.IORSZ(CO) ;DO WE HAVE A RECORD SIZE VALUE?
JRST FFAD22 ;NO
MOVD1M T3,MRS ;YES, SET MAIN ATTR RECORD SIZE FIELD
TMO P1,MRS ;AND FLAG IT IN THE MENU
FFAD22: SKIPN T3,.IOBLS(CO) ;DO WE HAVE A BLOCKSIZE VALUE?
JRST FFAD27 ;NO
MOVD1M T3,BLS ;YES, SET MAIN ATTR BLOCKSIZE FIELD
TMO P1,BLS ;AND FLAG IT IN THE MENU
FFAD23: SKIPN T1,.IOALB(CO) ;GOT A TOTAL ALLOCATION QUANTITY?
JRST FFAD24 ;NO
IDIV T1,.IOBLS(CO) ;CONVERT TO "BLOCK" ALLOCATION
CAIE T2,0 ;EXACT FIT?
ADDI T1,1 ;NO, ALLOW FOR PARTIAL LAST BLOCK
MOVD1M T1,ALQ ;SET MAIN ATTR ALLOCATION QUANTITY FIELD
MOVD1M T1,HBK ;ALSO CALL IT HIGHEST VIRTUAL BLOCK ALLOCATED
TMO P1,<ALQ,HBK> ;AND FLAG THEM IN THE MENU TOO
FFAD24: SKIPN T1,.IOLNB(CO) ;GOT A DATA LENGTH QUANTITY?
JRST FFAD27 ;NO
IDIV T1,.IOBLS(CO) ;T1:=LENGTH OF FILE IN BLOCKS
CAIE T2,0 ;EXACT FIT?
ADDI T1,1 ;ALLOW FOR TRAILING PARTIAL BLOCK
MOVD1M T1,EBK ;SET END-OF-FILE VIRTUAL BLOCK NUMBER
ADDI T2,1 ;T2:=FIRST FREE BYTE (MAY BE IN NEXT BLOCK)
MOVD1M T2,FFB ;SET FIRST FREE BYTE IN END OF FILE BLOCK
TMO P1,<EBK,FFB> ;NOTE EOF AND FFB FIELDS PRESENT
FFAD27: MOVD1 T3,RFM ;RETRIEVE RECORD FORMAT
CAIE T3,$DVFVF ;VARIABLE WITH FIXED CONTROL?
JRST FFAD28 ;NO
MOVD T3,RAT ;[40] RECORD ATTRIBUTES
TFNN T3,LSA ;[40] FVF LEGAL ONLY WITH LSA
BADDAP (MA.UNS,ATR!23,<Record format not supported at FFAD27>)
FFAD28: TMO P1,FOP ;[6] "ECHO" WHATEVER FOP THE REMOTE SENT TO US
MOVD T3,RAT ;[40] GET RECORD ATTRIBUTES
TFNN T3,LSA ;[40] DOING LSA?
JRST FFAD30 ;[40] NO
SKIPG T2,.IDFSZ(CO) ;[40] FETCH INPUT "FIXED HEADER SIZE"
MOVEI T2,6 ;[40] NONE (LOCAL), USE OUR VALUE
MOVD1M T2,FSZ ;[40] SET "FIXED CONTROL" SIZE
TMO P1,FSZ ;[40] AND FLAG FSZ IN THE MENU
FFAD30: MOVE T1,.IODCH(CO) ;GET THE SLAVE FILE/DEVICE CHARACTERISTICS
PUSHJ P,FFADC1 ;CONVERT TO DAP "DEV" CHARACTERISTICS
JFCL ;HO HUM
MOVDM T2,DEV ;SET DAP FILE/DEVICE CHARACTERISTICS
TMO P1,DEV ;SET MAIN ATTR DEV CHAR FIELD
MOVDM P1,M02 ;SET MAIN ATTRIBUTES MENU FIELD
;ALLOCATION ATTIBUTES
FFAD50: SETZB P1,P2 ;INIT ALLOCATION ATTR MENU
MOVD T3,ALQ ;MAIN ATTR ALLOCATION QUANTITY
MOVDM T3,AAL ;COPY INTO ALLOC ATTR ALLOCATION QUANTITY
MOVD T3,M02 ;MAIN ATTR MENU
TMNN T3,ALQ ;AN ALLOCATION QUANTITY?
TMO P1,AAL ;YES
SETZB T3,T4 ;INIT FLAGS
MOVD T1,FOP ;MAIN ATTR FILE ACCESS OPTIONS
TFNE T1,CBT ;CONTIGUOUS BEST TRY?
TFO T3,ACB ;YES, MARK IN ALLOCATION OPTIONS
TFNE T1,CTG ;CONTIGUOUS ALLOCATION REQUIRED?
TFO T3,ACT ;YES, MARK IN ALLOCATION OPTIONS
MOVDM T3,ALP ;SET ALLOC ATTR ALLOCATION OPTIONS FIELD
TFNE T3,<ACB,ACT> ;ANYTHING IN OPTIONS?
TMO P1,ALP ;YES, MARK IT IN THE MENU
SKIPN T3,.I1LKP+.RBPOS(CO) ;ALLOCATION ADDRESS SUPPLIED?
JRST FFAD56 ;NO
MOVD1M T3,LOC ;SET ALLOC ATTR ALLOCATION ADDRESS FIELD
MOVDII T3,ALN,ALB ;THE ALIGN-TO-SPECIFIED-BLOCK BIT
MOVDM T3,ALN ;SET ALLOC ATTR ALIGNMENT CONTROL FIELD
TMO P1,<ALN,LOC> ;MARK FIELDS PRESENT IN MENU
FFAD56: MOVDM P1,M11 ;SET ALLOCATION ATTRIBUTES MENU
;DATE/TIME ATTRIBUTES
FFAD70: SETZB P1,P2 ;INITIALIZE MENU SELECTION
MOVE T4,.IODPV(IO) ;CARRY AROUND DAP PROTOCOL VERSION
FFAD71: SKIPE T3,.IOCDT(CO) ;DO WE HAVE A CREATION DATE/TIME?
TMO P1,CDT ;YES, FLAG THE MENU ACCORDINGLY
MOVD1M T3,CDT ;SET DATE/TIME ATTR CREATION FIELD
SKIPE T3,.IOUDT(CO) ;DO WE HAVE AN UPDATE DATE/TIME?
TMO P1,UDT ;YES, FLAG THE MENU ACCORDINGLY
MOVD1M T3,UDT ;SET DATE/TIME ATTR UPDATE FIELD
SKIPE T3,.IOEDT(CO) ;DO WE HAVE AN EXPIRATION DATE/TIME?
TMO P1,EDT ;YES, FLAG THE MENU TOO
MOVD1M T3,EDT ;SET DATE/TIME ATTR EXPIRATION FIELD
FFAD73: CAIGE T4,006000 ;DAP 6.0 OR LATER?
JRST FFAD79 ;NO, REST OF FIELDS UNKNOWN
SKIPE T3,.IOBDT(CO) ;DO WE HAVE AN BACKUP DATE/TIME?
TMO P1,BDT ;YES, FLAG THE MENU
MOVD1M T3,BDT ;SET DATE/TIME ATTR BACKUP FIELD
SKIPE T3,.IOPDT(CO) ;DO WE HAVE A PHYSICAL CREATE DATE/TIME?
TMO P1,PDT ;YES, FLAG THE MENU APPROPRIATELY
MOVD1M T3,PDT ;SET DATE/TIME ATTR PHYSICAL CREATE FIELD
SKIPE T3,.IOADT(CO) ;DO WE HAVE AN ACCESS DATE/TIME?
TMO P1,ADT ;YES, FLAG THE MENU
MOVD1M T3,ADT ;SET DATE/TIME ATTR ACCESS FIELD
FFAD79: MOVDM P1,M13 ;SET DATE/TIME ATTRIBUTES MENU
;PROTECTION ATTRIBUTES
;
;FFAD8? ASSUMES PROTECTION FLAGS FIELDS ARE ONLY ONE WORD LONG. AS THIS
;IS NOT GUARANTEED, AT LEAST CAUSE ASSEMBLY ERROR IF IT EVER CHANGES
IFN $DLPSY-1,<PRINTX ?PSY field not one word long in FFAD80>
IFN $DLPOW-1,<PRINTX ?POW field not one word long in FFAD80>
IFN $DLPGR-1,<PRINTX ?PGR field not one word long in FFAD80>
IFN $DLPWL-1,<PRINTX ?PWL field not one word long in FFAD80>
FFAD80: SETZB P1,P2 ;INITIAL MENU FLAGS
SKIPN T3,.IOPRT(CO) ;GET PROTECTION CODE
JRST FFAD88 ;NONE
LSHC T3,-6 ;REDUCE TO OWNER PROTECTION
ANDI T3,7 ;AND ONLY OWNER PROTECTION
MOVE T2,FPDPTO##(T3) ;TRANSLATE TO DAPISH PROTECTION FLAGS
MOVDM T2,POW ;SET PROTECTION ATTR OWNER FIELD
LSHC T3,3 ;GET GROUP CODE
ANDI T3,7 ;AND ONLY THE GROUP CODE
MOVE T2,FPDPTB##(T3) ;TRANSLATE TO DAPISH PROTECTION FLAGS
MOVDM T2,PGR ;SET PROTECTION ATTR GROUP FIELD
LSHC T3,3 ;GET WORLD ACCESS FIELD
ANDI T3,7 ;AND ONLY WORLD ACCESS FIELD
MOVE T2,FPDPTB##(T3) ;TRANSLATE TO DAPISH PROTECTION FLAGS
MOVDM T2,PWL ;SET PROTECTION ATTR WORLD FIELD
TMO P1,<POW,PGR,PWL>;SELECT MENU FIELDS
FFAD88: MOVDM P1,M14 ;SET PROTECTION ATTRIBUTES MENU FIELD
;ALL DONE CONVERTING FILE ATTRIBUTES TO DAP ATTRIBUTES
JRST .POPJ1##
;FFADC - HELPER TO CONVERT .IODCH INTO DAP "DEV" FIELD
FFADC1: SETZB T2,T3 ;INITIALLY NO FLAGS
TXZE T1,IC.REC ;"RECORD-ORIENTED"?
TFO T2,REC ;YES
TXZE T1,IC.CCL ;CARRIAGE-CONTROL?
TFO T2,CCL ;YES
TXZE T1,IC.TRM ;TERMINAL?
TFO T2,TRM ;YES
TXZE T1,IC.MDI ;MULTIPLE DIRECTORIES?
TFO T2,MDI ;YES
TXZE T1,IC.SDI ;SINGLE-DIRECTORY?
TFO T2,SDI ;YES
TXZE T1,IC.SQD ;SEQUENTIAL BLOCK ORIENTED?
TFO T2,SQD ;YES
TXZE T1,IC.NUL ;NUL DEVICE?
TFO T2,NUL ;YES
TXZE T1,IC.FOD ;FILE-ORIENTED DEVICE?
TFO T2,FOD ;YES
TXZE T1,IC.DSH ;SHARABLE?
TFO T2,DSH ;YES
TXZE T1,IC.SPL ;SPOOLED DEVICE?
TFO T2,SPL ;YES
TXZE T1,IC.MNT ;MOUNTED?
TFO T2,MNT ;YES
TXZE T1,IC.DMT ;MARKED FOR DISMOUNT?
TFO T2,DMT ;YES
TXZE T1,IC.ALL ;DEVICE ALLOCATED?
TFO T2,ALL ;YES
TXZE T1,IC.IDV ;CAN DEVICE DO INPUT?
TFO T2,IDV ;YES
TXZE T1,IC.ODV ;CAN DEVICE DO OUTPUT?
TFO T2,ODV ;YES
TXZE T1,IC.SWL ;IS DEVICE SOWTWARE-WRITE-LOCKED?
TFO T2,SWL ;YES
TXZE T1,IC.AVL ;IS DEVICE AVAILABLE?
TFO T2,AVL ;YES
TXZE T1,IC.ELG ;ERROR-LOGGING ENABLED?
TFO T2,ELG ;YES
TXZE T1,IC.MBX ;A MAILBOX?
TFO T2,MBX ;YES
TXZE T1,IC.RTM ;REAL-TIME DEVICE?
TFO T2,RTM ;YES
TXZE T1,IC.RAD ;RANDOM-ACCESS?
TFO T2,RAD ;YES
TXZE T1,IC.DRC ;READ-CHECKING ENABLED?
TFO T2,DRC ;YES
TXZE T1,IC.DWC ;WRITE-CHECKING ENABLED?
TFO T2,DWC ;YES
TXZE T1,IC.FRN ;FOREIGN DEVICE?
TFO T2,FRN ;YES
TXZE T1,IC.NDV ;NETWORK DEVICE?
TFO T2,NDV ;YES
TXZE T1,IC.GDV ;GENERIC DEVICE?
TFO T2,GDV ;YES
TXZ T1,IC.CTG ;*** CLEAR OUT THE CONFIG FLAG
CAIE T1,0 ;*** SHOULD HAVE NOTHING LEFT OVER
STOPCD <Leftover .IODCH bits in FFADC> ;***
JRST .POPJ1## ;SUCCESSFUL RETURN
;FACL -- HANDLE "ACCESS OPTIONS" SPECIFIED AT ACCOMP TIME
;CALL IS:
;
; PUSHJ P,FACL01
; error return
; normal return
;
;At this time the error return is unused.
;
;On normal return the slave CDB has been set according to the received
;ACCOMP options (if none, the slave is left set as specifed by the FOP
;field of the originating main attributes message). Only the normal
;"CLOSE" operation is accepted, if the ACCOMP function is "SKIP", "ABORT",
;or the like the ACCOMP options are ignored.
FACL01: MOVD1 T1,A2F ;GET ACCOMP FUNCTION-TYPE FIELD
CAIE T1,$DVACL ;"CLOSE" IS THE ONLY ONE TO TRUST
JRST .POPJ1## ;ALL OTHERS (SKIP, ABORT, ETC.) WE IGNORE HERE
MOVE T3,.IOIOM(CO) ;GET THE SLAVE I/O MODE CONTROL
TXZ T3,IM.CXX ;CLEAR CLOSE OPTIONS
MOVD T1,AFO ;GET ACCOMP "FOP" FIELD
FJUMPN T1,AFO,FACL03 ;USE AFO IF SPECIFIED
MOVD T1,FOP ;OTHERWISE USE NORMAL "FOP" FIELD
FACL03: TFNE T1,DLT ;DELETE FILE ON CLOSE?
TXO T3,IM.CDL ;YES
TFNE T1,SPC ;PRINT FILE ON CLOSE?
TXO T3,IM.CPR ;YES
TFNE T1,SCF ;SUBMIT FILE ON CLOSE?
TXO T3,IM.CSU ;YES
MOVEM T3,.IOIOM(CO) ;SET UPDATED I/O MODE FOR SLAVE
TXNN T3,IM.CPR!IM.CSU;TRYING TO PRINT OR SUBMIT?
JRST .POPJ1## ;NO, ALL SET
PUSHJ P,NONPP1 ;YES, DISALLOW IF NETPPN ACCESS
POPJ P, ;PRINT/SUBMIT DISALLOWED
JRST .POPJ1## ;ALL OK
;FXAT -- SHIP ATTRIBUTES MESSAGES
;CALL IS:
;
; MOVX P1,<ADS>
; PUSHJ P,FXAT00/FXAT01
; error return
; normal return
;
;Where <ADS> is the "access display list" of attributes desired.
;
;FXAT will ship to the remote accessor various and sundry attributes
;messages as specified by the requested attributes in the "access
;display list" (see the ADS field definition in the DAP ACCESS
;message). The caller must set up the various attributes fields
;before calling FXAT!
;
;On error return the network died (error code in M0).
;
;On normal return all requested attributes messages have been given
;to network service (not guaranteed shipped yet).
;
;Uses T1, T2, T3, T4.
FXAT00: PUSHJ P,.SAVE4## ;SAVE THE P'S
FXAT01:
;MAIN ATTRIBUTES
FXAT10: TFNN P1,DMA ;REMOTE WANT MAIN ATTRIBUTES?
JRST FXAT15 ;NO
MOVEI T2,$DHATR ;YES
PUSHJ P,XDDAP0## ;SEND MAIN ATTRIBUTES
PJRST NETERO## ;[21] ERROR
;KEY DEFINITION ATTRIBUTES
FXAT15:;TFNN P1,DKD ;REMOTE WANT KEY DEFINITIONS?
; JRST FXAT20 ;NO
; MOVEI T2,$DHKYX ;YES
; PUSHJ P,XDDAP0## ;SEND KEY DEFINITION ATTRIBUTES
; PJRST NETERO## ;[21] ERROR
;ALLOCATION ATTRIBUTES
FXAT20: TFNN P1,DAA ;REMOTE WANT ALLOCATION?
JRST FXAT25 ;NO
MOVEI T2,$DHALC ;YES
PUSHJ P,XDDAP0## ;SEND ALLOCATION ATTRIBUTES
PJRST NETERO## ;[21] ERROR
;SUMMARY ATTRIBUTES
FXAT25:;TFNN P1,DSA ;REMOTE WANT SUMMARY?
; JRST FXAT30 ;NO
; MOVEI T3,$DHSUM ;YES
; PUSHJ P,XDDAP0## ;SEND SUMMARY ATTRIBUTES
; PJRST NETERO## ;[21] ERROR
;DATE/TIME ATTRIBUTES
FXAT30: TFNN P1,DDT ;REMOTE WANT DATE/TIME
JRST FXAT35 ;NO
MOVEI T2,$DHTIM ;YES
PUSHJ P,XDDAP0## ;SEND DATE/TIME ATTRIBUTES
PJRST NETERO## ;[21] ERROR
;PROTECTION ATTRIBUTES
FXAT35: TFNN P1,DFP ;REMOTE WANT PROTECTION?
JRST FXAT40 ;NO
MOVEI T2,$DHPRT ;YES
PUSHJ P,XDDAP0## ;SEND PROTECTION ATTRIBUTES
PJRST NETERO## ;[21] ERROR
;ACCESS CONTROL LIST
FXAT40:;TFNN P1,FAC ;REMOTE WANT ACCESS CONTROL LIST?
; JRST FXAT90 ;NO
; MOVEI T2,$DHACL ;YES
; PUSHJ P,XDDAP0## ;SEND ACCESS CONTROL LIST ATTRIBUTES
; PJRST NETERO## ;[21] ERROR
;RESULTANT FILE SPECIFICATION (MUST BE DONE LAST)
FXAT90: TFNN P1,DNM ;REMOTE WANT FILE NAME?
JRST .POPJ1## ;NO
MOVDII P1,NTY,NFS ;YES
PJRST FXNA01 ;SEND RESULTANT FILE SPEC NAME MESSAGE.
;FXNA -- SEND NAME MESSAGES
;CALL IS:
;
; MOVX P1,<NTY>
; PUSHJ P,FXNA00/FXNA01
; error return
; normal return
;
;Where <NTY> is the mask of name messages to be sent.
;
;FXNA sends name messages to the remote, based on the <NTY> mask
;passed by the caller. The name strings used come from the slave
;CDB (.IOFST, etc.).
;
;IO (and CI) have the address of the primary CDB, and CO has the
;address of the slave CDB.
;
;On error return the network died.
;
;On normal return the requested name messages have been sent.
;
;Uses T1, T2, T3, T4, P1, P2, P3, P4.
FXNA01: XMOVEI T1,FXNXTO ;TYPER
PUSHJ P,.TYOCH## ;SET CHARACTER STUFFER
MOVE P3,T1 ;REMEMBER PREVIOUS
MOVE P4,[POINT 7,.IDNMS(CI)] ;PROTOTYPE BYTE STUFFER
;VOLUME (DEVICE) NAME
FXNA10: TFNN P1,NVN ;NEED A VOLUME NAME?
JRST FXNA20 ;NO
MOVEM P4,.IOXTO(CI) ;YES
SKIPN T1,.IOFDV(CO) ;[SLAVE] ADDRESS OF DEVICE NAME STRING
DEBUG <No device name string in FXNA10>,,,.POPJ##
PUSHJ P,.TSTRG## ;SET IT UP
PUSHJ P,.TCOLN## ;AND A ":" TO KEEP DAP HAPPY
MOVDII T1,NTY,NVN ;THIS IS A VOLUME NAME
PUSHJ P,FXNA90 ;SEND NAME MESSAGE
JRST FXNA80 ;NET DIED
;DIRECTORY NAME
FXNA20: TFNN P1,NDN ;NEED A DIRECTORY NAME?
JRST FXNA30 ;NO
MOVEM P4,.IOXTO(CI) ;YES
PUSHJ P,.TLBRK## ;SET "["
SKIPE T1,.IOFDR(CO) ;[SLAVE] ADDRESS OF DIRECTORY NAME STRING
PUSHJ P,.TSTRG## ;SET DIRECTORY (IF ANY)
PUSHJ P,.TRBRK## ;CLOSING "]"
MOVDII T1,NTY,NDN ;THIS IS A DIRECTORY NAME
PUSHJ P,FXNA90 ;SEND NAME MESSAGE
JRST FXNA80 ;NET DIED
;FILE (AND EXTENSION (AND GENERATION)) NAME
FXNA30: TFNN P1,NFN ;WANT FILE (ETC.) NAME
JRST FXNA40 ;NO
MOVEM P4,.IOXTO(CI) ;YES
SKIPE T1,.IOFNM(CO) ;GET FILE NAME (IF ANY)
PUSHJ P,.TSTRG## ;SET IT UP
SKIPN .IOFEX(CO) ;IF A FILE TYPE,
SKIPE .IOFGN(CO) ;OR A GENERATION
CAIA ;THEN NEED A DOT
JRST FXNA33 ;ALL DONE (NO .TYPE.GENERATION)
PUSHJ P,.TDOT## ;SEPARATE FROM EXTENSION
SKIPE T1,.IOFEX(CO) ;GET FILE TYPE (IF ANY)
PUSHJ P,.TSTRG## ;SET IT TOO
SKIPN .IOFGN(CO) ;GOT A GENERATION TOO?
JRST FXNA33 ;NO
PUSHJ P,.TDOT## ;YES
MOVE T1,.IOFGN(CO) ;GENERATION STRING
PUSHJ P,.TSTRG## ;SET IT TOO
FXNA33: MOVDII T1,NTY,NFN ;FILE NAME
PUSHJ P,FXNA90 ;SEND NAME MESSAGE
JRST FXNA80 ;DIED
;FULL FILE SPECIFICATION
FXNA40: TFNN P1,NFS ;WANT FULL FILE SPECIFICATION?
JRST FXNA50 ;NO
MOVEM P4,.IOXTO(CI) ;YES
MOVE T1,CO ;SELECT SLAVE CDB FOR FILE NAME STRINGS
PUSHJ P,.TOCFL## ;TYPE OUT THE FILE SPECIFICATION STRING
WARN TFF,<TOCFL failed in FXNA40>,,,.POPJ##
MOVDII T1,NTY,NFS ;FILE SPECIFICATION
PUSHJ P,FXNA90 ;SEND NAME MESSAGE
JRST FXNA80 ;DIED
;DONE, RESTORE AND EXIT
FXNA50: MOVE T1,P3 ;ORIGINAL OUTPUT ROUTINE
PUSHJ P,.TYOCH## ;RESTORE ORIGINAL
JRST .POPJ1## ;SUCCESSFUL RETURN
;ABORT NAME MESSAGES
FXNA80: MOVE T1,P3 ;ORIGINAL OUTPUT ROUTINE
PUSHJ P,.TYOCH## ;[21] RESTORE ORIGINAL
PJRST NETERO## ;[21] ISSUE ERROR AND RETURN
;HELPER TO BUILD CHARACTER STRING
FXNA90: MOVDM T1,NTY ;SET NAME TYPE
SETZ T1, ;TERMINATING NULL
MOVE T2,.IOXTO(CI) ;BYTE STUFFER
IDPB T1,T2 ;TERMINATE ASCIZ STRING
TLNE T2,760000 ;ON A WORD BOUNDRY?
JRST .-2 ;NOT YET
MOVEI T2,$DHNAM ;NAME MESSAGE CODE
PUSHJ P,XDDAP0## ;[21] SEND A NAME MESSAGE
PJRST NETERO## ;[21] NET DIED?
JRST .POPJ1## ;[21] SUCCESS
;AUXILIARY HELPERS
FXNXTO: IDPB T1,.IOXTO(CI) ;STUFF THIS BYTE VIA THE PRIMARY CDB
POPJ P, ;RETURN TO SCAN
;FXSTS -- SEND DAP STATUS MESSAGE
;CALL IS:
;
; MOVX T1,<STS>
; MOVX T2,<STV>
; PUSHJ P,FXSTS
; error return
; normal return
;
;where <STS> is the 16-bit DAP status value; <STV> is the "secondary"
;status value.
;
;On error return the network died, error code is in M0.
;
;On normal return the specified status information has been encapsulated
;and sent to the remote "active" DAP process.
;
;Uses T1, T2, T3, T4.
FXSTS0::PUSHJ P,.SAVE4## ;PRESERVE THE P'S HERE
FXSTS1::MOVD1M T1,STC ;SET DAP STATUS CODE (MAJOR STATUS)
MOVD1M T2,STV ;SET DAP SECONDARY STATUS VALUE
SETZB T1,T2 ;ZERO DAP VALUE
MOVDM T1,SRA ;CLEAR STATUS RECORD ADDRESS
MOVDM T1,SRN ;CLEAR STATUS RECORD NUMBER
MOVDII T1,M09,<STC,SRA,SRN,STV> ;INVISIBLE MENU FOR ALL BUT TEXT
MOVDM T1,M09 ;SET STATUS [INVISIBLE] MENU FIELD
MOVEI T2,$DHSTS ;STATUS MESSAGE TYPE
PUSHJ P,XDDAP1## ;SEND A DAP STATUS MESSAGE
PJRST NETERO## ;[21] NET DIED?
PUSHJ P,XDFLS1## ;[21] FLUSH THE PIPE NOW
PJRST NETERO## ;[21] NET DIED?
JRST .POPJ1## ;[21] SUCCESS
;FX7ACK -- SEND DAP ACK IF PROTOCOL VERSION 7.0 OR LATER
;CALL ISL
;
; PUSHJ P,FX7ACK
; error return
; normal return
;
;On error return the network has died.
;
;On normal return an ACK message has been built (but not necessarily
;transmitted) if the remote DAP process supports version 7.0 or later
;protocol.
;
;Uses T1, T2, T3, T4.
FX7ACK: MOVE T1,.IODPV(IO) ;GET THE DAP PROTOCOL VERSION
CAIGE T1,007000 ;VERSION 7.0 OR LATER?
JRST .POPJ1## ;NO, JUST IGNORE
PUSHJ P,XDACK1## ;[21] YES, SEND AN ACK
PJRST NETERO## ;[21] NET DIED?
JRST .POPJ1## ;[21] SUCCESS
SUBTTL General-purpose non-specific subroutines
;F8BAZ - COPY 8-BIT STRING INTO 7-BIT STRING
;Call is:
;
; MOVX T1,<DST>
; MOVX P1,<8BP>
; PUSHJ P,F8BAZ
; error return
; normal return
;
;Where <DST> is the address for the resultant ASCIZ string; and <8BP>
;is the address of the 8-bit byte string
F8BAZ8: HRLI T1,(POINT 8,) ;[34] BYTE STUFFER
SKIPA ;[34] JOIN COMMON CODE
F8BAZ: HRLI T1,(POINT 7,) ;[34] BYTE STUFFER
HLRZ P2,0(P1) ;[34] COUNT OF BYTES FOLLOWING
JUMPLE P2,[SETZM 0(T1) ;JUST CLEAR FIRST WORD
JRST .POPJ1##] ;AND LET IT GO AT THAT
HRLI P1,(POINT 8,) ;BYTE SNATCHER
ADDI P1,1 ;POINT TO 8-BIT BYTE STRING
;LOOP COPYING BYTES
F8BAZ3: ILDB T2,P1 ;GET NEXT BYTE
IDPB T2,T1 ;AND STASH IT
SOJG P2,F8BAZ3 ;LOOP FOR REST OF STRING
SETZ T2, ;DONE, A NULL
IDPB T2,T1 ;TO ASCIZIZE THE STRING
TLNE T1,720000 ;END OF WORD YET?
JRST .-2 ;NO, CLEAR OUT REST OF WORD
JRST .POPJ1## ;YES, HAPPY
;F8BUP - CONVERT 8-BIT USERID STRING INTO PPN
;CALL IS:
;
; MOVX P1,<8BP>
; PUSHJ P,F8BUP
; error return
; normal return
;
;Where <8BP> is the address of the 8-bit byte string.
;
;If the string is a regular ppn it is translated directly into a
;binary-form ppn; If the string is not a direct representation of
;a ppn (i.e., it doesn't start with either a "[" character or an
;octal digit) then the string is treated as a "name" which will
;be matched from SYS:USERS.TXT, and translated accordingly into a
;ppn.
;
;On normal return the ppn is in T1.
F8BUP: HLRZ P2,@P1 ;GET BYTE COUNT
JUMPLE P2,.POPJ1## ;NULL STRING, NULL PPN
HRLI P1,(POINT 8,,32);BYTE SNATCHER
MOVE T4,P1 ;COPY OF USERID STRING POINTER
ILDB T1,T4 ;COPY OF FIRST USERID CHARACTER
CAIE T1,"<" ;> (MATCH ANGLE BRACKETS)
CAIN T1,"[" ;LEADING "NOISE" CHARACTER?
SOSA P2 ;YEAH, DISCOUNT THE "[" (OR WHATEVER)
JRST F8BUP5 ;NO, TREAT USERID STRING AS IS
IBP P1 ;SKIP LEADING NOISE CHARACTER
MOVE T4,P2 ;REMAINING USERID STRING LENGTH
ADJBP T4,P1 ;POINT TO LAST USERID CHARACTER
LDB T2,T4 ;COPY OF LAST USERID CHARACTER
CAIN T2,2(T1) ;MATCHING TERMINATOR?
SOS P2 ;YES, DISCOUNT TRAILING NOISE CHARACTER
F8BUP5:
IFN FTUTXT,<
PUSHJ P,F8BUN ;SEE IF NAME<=>PPN TRANSLATION APPLICABLE
POPJ P, ;ERROR, NO SUCH NAME
> ;END IFN FTUTXT
;EXTRACT PROJECT NUMBER FIRST
SETZ T1, ;INITIALIZE T1
PUSHJ P,F8XOC ;EXTRACT THE OCTAL NUMBER
JUMPE T2,[SETO T1, ;ERROR, GET A MINUS 1
ADJBP T1,P1 ;BACK UP TO THE BYTE WE ATE
MOVEI T2,1(P2) ;GET THE LENGTH OF THE STRING
PJRST F8BUNA] ;GO ASK ACTDAE ABOUT THE NAME
HRLZ T1,T2 ;POSITION PROJECT NUMBER
CAIN T3,"," ;BETTER BE COMMA SEPARATOR
CAIG P2,0 ;WITH MORE CHARACTERS LEFT TO COME
POPJ P, ;NO! JUNK FORMAT PPN
;NOW READ IN THE PROGRAMMER NUMBER
PUSHJ P,F8XOC ;EXTRACT THE OCTAL PROGRAMMER
JUMPE T2,.POPJ## ;NULL IS ERROR HERE
HRR T1,T2 ;POSITION PROGRAMMER
JRST .POPJ1## ;RETURN WITH PPN IN T1
;EXTRACT OCTAL NUMBER (HELPER FOR F8BUP)
F8XOC: SETZ T2, ;INITIALIZE NUMBER
F8XOC3: ILDB T3,P1 ;NEXT BYTE
CAIL T3,"0" ;OCTAL
CAILE T3,"7" ; DIGIT?
SOJA P2,.POPJ## ;NO, END OF NUMBER
ASH T2,3 ;MAKE ROOM AND
ADDI T2,-"0"(T3) ;ADD IN THIS OCTADE
SOJG P2,F8XOC3 ;LOOP FOR MORE DIGITS
SETO T3, ;OOPS, RAN OUT, TERMINATE SCAN
POPJ P, ;RETURN
;F8BUN - TRANSLATE USERID NAME STRING INTO PPN STRING FROM USERS.TXT
;CALL IS:
;
; MOVX P1,<PTR>
; MOVX P2,<CTR>
; PUSHJ P,P8BUN
; error return
; normal return
;
;Where <PTR> is the input byte pointer (presumed 8 bits, but not required);
;and <CTR> is the count of valid <PTR> bytes.
;
;On error return no name match could be found.
;
;On normal return, either the <PTR> string was not a name (in which case
;treat as ppn string) or the <PTR> string matched a name from USERS.TXT.
;In either case, P1/P2 contain a byte pointer and counter to a ppn string.
;
;Uses T1 - T4, P1 - P4
IFN FTUTXT,<
F8BUN: DMOVE T3,P1 ;SAVE COPY OF ORIGINAL USER-ID STRING POINTER
PUSHJ P,TSAV14## ;NEED SOME SCRATCH SPACE
PUSHJ P,F8BUNC ;READ FIRST USERID CHARACTER
POPJ P, ;THIS CAN'T HAPPEN . . .
CAIL T1,"0" ;OCTAL
CAILE T1,"7" ; DIGIT???
JRST F8BUN1 ;NO, LOOK FOR A NAME STRING MATCH
MOVE P1,-T3(P) ;YES, PPN, RESTORE ORIGINAL <PTR>
MOVE P2,-T4(P) ;AND <CTR> FOR CALLER
JRST .POPJ1## ;PROCESS USERID<=>PPN
;STILL IFN FTUTXT
;HERE TO TRANSLATE NAME FROM USERS.TXT INTO CORRESPONDING PPN STRING
F8BUN1: MOVE P3,UTXPTR ;BYTE POINTER TO USERS.TXT
MOVE P4,UTXCTR ;COUNT OF VALID BYTES IN USERS.TXT
F8BUN2: DMOVE T3,P3 ;SAVE COPY OF THIS USERS.TXT ENTRY
MOVE P1,-T3(P) ;FRESH POINTER AND
MOVE P2,-T4(P) ; COUNTER FOR USERID STRING
F8BUN3: PUSHJ P,F8BUNU ;READ NEXT CHARACTER FROM USERS.TXT
JRST .POPJ## ;EXHAUSTED, NO MATCH, ERROR RETURN
CAIE T2,"]" ;END OF PPN PART OF "[P,PN]NAME" PAIR?
JRST F8BUN3 ;NOT YET, KEEP GOING
;Note that UTXINI "compresses" USERS.TXT from "str:[p,pn],name<CR><LF>"
;entries into "[p,pn]name<LF>" entries . . .
F8BUN5: PUSHJ P,F8BUNU ;ANOTHER CHARACTER FROM USERS.TXT
JRST .POPJ## ;EXHAUSTED, NO MATCH (<LF> GUARANTEED AT END)
PUSHJ P,F8BUNC ;ANOTHER CHARACTER FROM USERID
JRST [CAIE T2,.CHLFD ;DONE, AT END OF USERS.TXT NAME TOO?
JRST F8BUN7 ;NO, SKIP NAME, CHECK NEXT ENTRY
JRST F8BUN9] ;YES, THEN THIS IS A MATCH
CAIN T2,.CHLFD ;STILL IN USERS.TXT NAME?
JRST F8BUN2 ;NO, NO MATCH, CHECK NEXT NAME
CAMN T1,T2 ;NAME CHARACTERS MATCH?
JRST F8BUN5 ;YES, CHECK REST OF NAME
F8BUN7: PUSHJ P,F8BUNU ;NO, EAT THIS USERS.TXT NAME
JRST .POPJ## ;DONE, NO MATCH AT ALL
CAIE T2,.CHLFD ;END OF USERS.TXT NAME ENTRY?
JRST F8BUN7 ;NO, KEEP EATING
JRST F8BUN2 ;CHECK NEXT USERS.TXT NAME ENTRY
;Here on successful match, return USERS.TXT ppn string in lieu of USERID
F8BUN9: DMOVE P1,T3 ;USERS.TXT PPN STRING
IBP P1 ;SKIP THE "[" CHARACTER
JRST .POPJ1## ;RETURN TO PROCESS PPN
;STILL IFN FTUTXT
;HELPERS FOR F8BUN
;F8BUNC -- RETURN ONE USERID CHARACTER
F8BUNC: SOJL P2,.POPJ## ;ERROR RETURN IF NO MORE CHARACTERS
ILDB T1,P1 ;NEXT USERID CHARACTER
ANDI T1,177 ;MAKE 7-BIT ASCII
JUMPE T1,F8BUNC ;SUPPRESS NULLS
CAIE T1," " ;COMPRESS SPACES
CAIN T1,.CHTAB ; AND TABS
JRST F8BUNC ; . . .
CAIL T1,"a" ;LOWER CASE ALPHA?
CAILE T1,"z" ; . . .
JRST .POPJ1## ;NO, SUCCESSFUL RETURN WITH CHARACTER IN T1
SUBI T1,"a"-"A" ;YES, SHIFT TO UPPER CASE
JRST .POPJ1## ;AND RETURN
;F8BUNU -- RETURN ONE USERS.TXT CHARACTER
F8BUNU: SOJL P4,.POPJ## ;ERROR IF NO MORE CHARACTERS LEFT
ILDB T2,P3 ;FETCH NEXT CHARACTER
JUMPN T2,.POPJ1## ;RETURN CHARACTER
JRST F8BUNU ;EAT NULLS
> ;END IFN FTUTXT
;F8BUNA - TRANSLATE USERID NAME STRING INTO PPN FROM ACTDAE
;CALL IS:
;
; MOVX T1,<PTR>
; MOVX T2,<CTR>
; PUSHJ P,F8BUNA
; error return
; normal return
;
;Where <PTR> is an eight bit byte pointer to the beginning of the username
;string (with any leading bracket trimmed), and <CTR> is the count of valid
;<PTR> bytes.
;
;On error return, no name match could be found, or <PTR> was no eight bit
;string.
;
;Since the username string we give to ACTDAE has to start on a word
;boundary, and since the remote end may have given us a username with
;[]s around it, we'll have to create a new username string, minus the
;brackets.
;
;On normal return, T1 will contain the ppn.
F8BUNA: XMOVEI T3,J$AUSR(J) ;POINT TO THE DESTINATION STORAGE
HRLI T3,(POINT 8,) ;MAKE A BYTE POINTER
;Loop here to copy the username string, minus the optional []s.
F8BU10: ILDB T4,T1 ;GET A BYTE
IDPB T4,T3 ;STORE THE BYTE
SOJG T2,F8BU10 ;LOOP IF MORE BYTES IN THIS STRING
SETZ T4, ;GET A NULL
IDPB T4,T3 ;TERMINATE THE STRING
XMOVEI T4,J$ABLK-1(J) ;POINT AT THE ARGUMENT BLOCK STORAGE
PUSH T4,[QF.RSP!.QUMAE] ;SAY WE WANT TO TALK TO ACTDAE
PUSH T4,[-1] ;SET THE NODE TO CENTRAL
XMOVEI T2,J$ARSP(J) ;POINT AT THE RESPONSE STORAGE
HRLI T2,ARSPLN ;GET THE NUMBER OF WORDS WE CAN PLAY WITH HERE
PUSH T4,T2 ;PUT IN THE ARG BLOCK
PUSH T4,[QA.IMM!<1,,.QBAFN>] ;GET THE SUBFUNCTION ARGUMENT TYPE
PUSH T4,[EXP UGOUP$] ;SAY WE WANT THE USER PROFILE
PUSH T4,[^D10,,.UGUSR] ;STORE THE USERNAME DESCRIPTOR
XMOVEI T1,J$AUSR(J) ;POINT TO OUR NICER NAME STRING
PUSH T4,T1 ;STORE THE USERNAME POINTER
ANDI T4,-1 ;GET RID OF JUNK IN THE LEFT HALF
SUBI T4,J$ABLK-1(J) ;COMPUTE THE NUMBER OF WORDS WE FILLED IN
XMOVEI T1,J$ABLK(J) ;POINT AT THE ARGUMENT BLOCK
HRL T1,T4 ;COPY THE BLOCK LENGTH
QUEUE. T1, ;ASK FOR THE PPN FOR THIS GUY
POPJ P, ;WELL, WE GAVE OUR ALL
MOVE T1,J$ARSP+.AEPPN(J) ;GET THE PPN RETURNED
TXO S,S.PROF ;[31] SAY WE HAVE THE USER'S PROFILE
JRST .POPJ1## ;AND RETURN HAPPY
;NAM826 -- CONVERT EIGHT BIT ASCII NAME FROM USER PROFILE TO SIXBIT
; USER NAME AND STORE IN .IOQ6N
;Call is:
;
; MOVX IO,<CDB>
; PUSHJ P,NAM826
; NORMAL RETURN
;
;Assumes user profile setup in J$ARSP(J), containing eight bit username at
;offset .AENAM. On return, SIXBIT doubleword stored in .IOQ6N(IO)
NAM826: PUSH P,T1 ;[31] SAVE A COUPLE
PUSH P,T2 ;[31] OF REGISTERS
PUSH P,[POINT 8,.AENAM+J$ARSP(J)] ;[31] INIT THE SOURCE BYTE POINTER
PUSH P,[POINT 6,.IOQ6N(IO)] ;[31] INIT DESTINATION BYTE POINTER
SETZM .IOQ6N(IO) ;[31] CLEAR BOTH OF THE
SETZM .IOQ6N+1(IO) ;[31] DESTINATION WORDS
MOVEI T2,^D12 ;[31] GET MAX NUMBER OF BYTES
NAM8.1: ILDB T1,-1(P) ;[31] GET THE NEXT BYTE
JUMPE T1,NAM8.2 ;[31] RETURN NOW IF END OF STRING
ANDI T1,177 ;[31] FORCIBLY MAKE IT 7 BIT ASCII (WELL ...)
CAIL T1,"a" ;[31] IS IT
CAILE T1,"z" ;[31] LOWER CASE?
SKIPA ;[31] NOPE
SUBI T1,"a"-"A" ;[31] YES, CONVERT TO UPPER
SUBI T1,"A"-'A' ;[31] CONVERT THE CHARACTER TO SIXBIT
IDPB T1,(P) ;[31] STORE THE SIXBIT CHARACTER
SOJG T2,NAM8.1 ;[31] LOOP IF MORE BYTES TO DO
NAM8.2: POP P,(P) ;[31] GET RID OF THE COUNT
POP P,(P) ;[31] AND THE BYTE POINTER
POP P,T2 ;[31] RESTORE THE
POP P,T1 ;[31] REGISTERS
POPJ P, ;[31] AND RETURN
;FFIND -- FIND A SWAPPED CONTROL CODE IN A TABLE
;Call is:
;
; MOVX T2,<CODE>
; MOVEI T4,<TABL>
; PUSHJ P,FFIND
; ERROR RETURN
; NORMAL RETURN
;
;Where <TABL> is a table a la CFIND (codes in right half of words,
;return value in left half of words, table terminated by a 0 word)
;and <CODE> is the code to match.
;
;On error return, <CODE> was not in the table.
;
;On normal return, T4 will point to the table entry that matched, and
;T1 will contain the matching value for <CODE>.
;
;Uses acs T1, T4.
FFIND1: MOVE T1,(T4) ;GET FIRST TABLE ENTRY
JRST FFIND4 ;AND START LOOKING THERE
FFIND2: SKIPN T1,(T4) ;END OF TABLE YET?
POPJ P, ;YES, TAKE ERROR RETURN
FFIND4: MOVS T1,T1 ;CODE TO MATCH IS IN LH
CAIE T2,(T1) ;CODES MATCH?
AOJA T4,FFIND2 ;NO, SEARCH REST OF TABLE
HRRZ T1,(T4) ;GET RETURN VALUE
JRST .POPJ1## ;SUCCESSFUL RETURN
SUBTTL FALERI Coroutine to process [SCAN] error interception
;[50]
;FALERI -- SET SCAN ERROR INTERCEPTION
;Call is:
;
; MOVX T1,<ADDR>
; PUSHJ P,FALERI
; RETURN
;
;Where <ADDR> is the address of the routine to call on error detection.
;
;On normal return, the caller can call SCAN routines, and if any fatal
;syntax errors occur, the caller's specified routine will be called rather
;than aborting. The specified error intercept routine will be entered
;with the stack "phased" to immediately after the caller's call to FALERI.
;
;This routine is identical to .XERRT in SWIMSC. However, FAL cannot use
;.XERRT since NFTERP and NFTERT do not have a stream context.
;
;Uses ac T1.
FALERI: PUSH P,T1 ;SAVE CALLER'S NEW ERROR INTERCEPT ROUTINE
HRRZ T1,P ;EXAMINE THE STACK POINTER
CAIL T1,J$RPDL(J) ;
CAILE T1,J$RPDL+PDSIZE(J) ;ARE J AND P IN SYNC?
JRST FALER2 ;NO, RESTART THE FAL JOB
PUSH P,J$SERP(J) ;SAVE THE ERROR STACK POINTER
PUSH P,J$SERT(J) ;SAVE THE ERROR INTERCEPT ROUTINE
PUSHJ P,FALER0 ;PSEUDOINCESTOUSLY CALL OURSELF
CAIA ;NON-SKIP RETURN
AOS -4(P) ;SKIP RETURN
POP P,J$SERT(J) ;RESTORE THE ERROR INTERCEPT ROUTINE
POP P,J$SERP(J) ;RESTORE THE ERROR STACK
POP P,(P) ;THROW AWAY THE CALLER'S INTERCEPT ROUTINE
POP P,(P) ;THROW AWAY THE RETURN FROM FALERI
POPJ P, ;RETURN FROM THE CALLING ROUTINE
; COME HERE TO CALL THE REST OF THE CALLER'S ROUTINE AS A SUBROUTINE.
FALER0: MOVEM P,J$SERP(J) ;SAVE THE PRE-INTERCEPT STACK
XMOVEI T1,FALER1 ;PROVIDE AN INTERMEDIATE INTERCEPT ROUTINE
MOVEM T1,J$SERT(J) ; TO PROVIDE A VALID STACK POINTER
PJRST @-4(P) ;GET BACK TO THE CALLING ROUTINE
; COME HERE WHEN AN ERROR OCCURS TO RESTORE THE STACK POINTER.
FALER1: MOVE P,J$SERP(J) ;RESTORE THE STACK POINTER
PJRST @-3(P) ;CALL THE USER'S INTERCEPT ROUTINE
FALER2: MOVEI T1,[ASCIZ /FALERI called while not in stream context/]
PJRST RESTRT## ;RESTART THE FAL JOB
; COME HERE ON FATAL ERRORS IN PLACE OF A MONRT. UUO.
FALERT: HRRZ T1,P ;EXAMINE THE STACK POINTER
CAIL T1,J$RPDL(J) ;
CAILE T1,J$RPDL+PDSIZE(J) ;ARE J AND P IN SYNC?
JRST FALER3 ;NO, RESTART THE FAL JOB
SKIPE J$SERT(J) ;IS THERE AN INTERCEPT ROUTINE
PJRST @J$SERT(J) ;YES, USE IT
SKIPA T1,[[ASCIZ /Fatal SCAN error/]]
FALER3: MOVEI T1,[ASCIZ /FALERT called while not in stream context/]
PJRST RESTRT## ;RESTART THE FAL JOB
;FAL ERRORS
FEROS: ERROR FDS,<FAL DAP message received out of sequence>
FERDP: ERROR FDR,<FAL DAP receive error>
FEXDP: ERROR FDX,<FAL DAP transmit error>
M0POPJ: POP P,M0 ;ADJUST STACK
POPJ P, ;PROPAGATE ERROR RETURN
SUBTTL FALGLX Interface Routines
;COPSPC - Copy the SWIL filespec to a GLXLIB FD
;CALL IS:
; PUSHJ P,COPSPC ;COPY THE CURRENT SPEC
; returns error if aborted
; normal return
;
;This will copy the file specification of the file currently being accessed
;into a GLXLIB FD style block in the per stream storage page. This done,
;we'll force a new checkpoint message to be sent to keep the operator happy,
;and make sure we're not soaking up too much time if this is a directory
;or delete access.
;
;Destroys T1
COPSPC: MOVE T1,.FODEV+.I1FLP(CO) ;GET THE STRUCTURE NAME
MOVEM T1,.FDSTR+J$STFD(J) ;STORE IT IN THE FD
MOVE T1,.RBNAM+.I1LKP(CO) ;GET THE FILENAME
MOVEM T1,.FDNAM+J$STFD(J) ;STORE IN THE FD ALSO
HLLZ T1,.RBEXT+.I1LKP(CO) ;GET THE EXTENSION
MOVEM T1,.FDEXT+J$STFD(J) ;STORE
HRLZI T1,.PTPPN+.I1PT2(CO) ;POINT TO THE RETURNED PATCH
HRRI T1,.FDPPN+J$STFD(J) ;POINT TO THE DESTINATION
BLT T1,.FDPPN+.PTMAX-.PTPPN-2+J$STFD(J) ;COPY THE PATH
MOVX T1,FDXSIZ ;GET THE LENGTH OF THE FD
HRLZM T1,.FDLEN+J$STFD(J) ;STORE IT
PUSHJ P,FRCCHK## ;FORCE A CHECKPOINT MESSAGE MAYBE
MOVE T1,J$SACC(J) ;GET THE FILE ACCESS CODE
CAXE T1,$DVARD ;READING A FILE?
CAXN T1,$DVAWR ;NO, WRITING IT?
JRST .POPJ1## ;YES, JUST RETURN NOW
;If not reading or writing a file, make sure we're not running too much.
PJRST CNTFIL ;PERHAPS SLEEP BEFORE WE RETURN
;CNTFIL - Unblock if we're doing too many LOOKUPs in a row
;CALL IS:
; PUSHJ P,CNTFIL ;COUNT THIS FILE
; returns error if aborted
; normal return
;
;This routine ensures that the DIRECTORY and DELETE class of access will
;not run to the exclusion of the other streams. Since these commands will
;spend more time in LOOKUP/RENAME code than it takes the remote end to
;process our output, they may never block on network I/O until completion.
;This code implements a "fairness counter" which will deschedule the stream
;after DIRCNT files have been opened.
;
;Destroys no registers
CNTFIL: SOSL J$DCNT(J) ;HAVE WE DONE TOO MANY?
JRST .POPJ1## ;NO, JUST RETURN HAPPY
PUSHJ P,SCHEDZ ;YES, GO DESCHEDULE
POPJ P, ;ABORTED, JUST RETURN NOW
PUSH P,[DIRCNT] ;WE'RE BACK, GET THE MAX FILES WE CAN DO
POP P,J$DCNT(J) ;RESET THE COUNTER
JRST .POPJ1## ;AND RETURN HAPPY
;SCHEDL - Call the FALGLX scheduler when I/O blocks
;CALL IS:
; MOVX M0,<block status>
; PUSHJ P,SCHEDL
; or
; PUSHJ P,SCHEDZ ;IF SIMPLY DESCHEDULING WITHOUT BLOCKING
; returns non-skip if aborted
; returns skip if unblocked
;
;Where <block status> is one of the scheduler codes defined in SWIL.
;Will return as soon as the blocking condition has been satisfied.
;
;Destroys no registers
SCHEDZ: PUSH P,M0 ;SAVE THE CONTENTS OF THIS JUST FOR KICKS
SETZ M0, ;SAY NO BLOCKING REASON
JRST SCHE.1 ;CONTINUE IN COMMON CODE BELOW
SCHEDL: PUSH P,M0 ;SAVE A TEMP REGISTER
MOVE M0,SCDBTS(T1) ;GET THE CORRECT BLOCKING BIT
SCHE.1: PUSHJ P,DSCHD## ;GO AWAY FOR A WHILE
POP P,M0 ;RESTORE THIS REGISTER
TXNN S,S.KILL ;ARE WE SUPPOSED TO ABORT THIS?
JRST .POPJ1## ;NO, JUST RETURN HAPPY
MOVE IO,CO ;YES, SELECT THE SLAVE CDB
PUSHJ P,IOABO1## ;ABORT THE CURRENT FILE
JFCL ;IGNORE ERRORS HERE
PUSHJ P,IORLS1## ;GET RID OF THE CHANNEL
JFCL ;DON'T CARE
MOVE IO,CI ;GET NETWORK CDB
SETZ T3, ;SAY NO OPTIONAL DATA
PUSHJ P,NTNAB1## ;ABORT THE CONNECTION
JFCL ;DON'T WORRY ABOUT ERRORS ON THE ABORT
SKIPN T1,J$RALC(J) ;ANY RECORD ALLOCATED?
POPJ P, ;NO, JUST RETURN ERROR NOW
MOVE T2,J$RALC+1(J) ;YES, GET THE RECORD LENGTH
PUSHJ P,.MMFWD## ;FREE THE MEMORY
JFCL ;PUNT ERRORS HERE
SETZM J$RALC(J) ;SAY NO MORE RECORD BUFFER
POPJ P, ;THEN GIVE THE ERROR RETURN
;Table to translate SWIL blocking reason to FALGLX blocking bit:
SCDBTS: PSF%DI ;BLOCKED FOR LOCAL INPUT
PSF%DO ;BLOCKED FOR LOCAL OUTPUT
PSF%NI ;BLOCKED FOR NETWORK INPUT
PSF%NO ;BLOCKED FOR NETWORK OUTPUT
PSF%CW ;BLOCKED WAITING FOR INCOMING CONNECTION
;IOSHUT -- HERE DURING DISK I/O SHUTDOWN
;CALL IS:
;
; MOVX IO,<CDB>
; PUSHJ P,IOSHUT
; (never takes error return)
; normal return
;
;Here when we close a disk channel. This routine will be called
;by SWIL before actually closing the channel. We will just turn
;off interrupts on this device and clear the scheduler pointer.
;
;Uses T1, T2
IOSHUT: SETZM .IOSCH(IO) ;ZERO THE SCHEDULER POINTER
PUSHJ P,INDDIS## ;REMOVE THIS FROM PSI SYSTEM
JFCL ;PUNT ERRORS
JRST .POPJ1## ;RETURN SUCCESS
SUBTTL CDB initialization vectors
;"FAL" INPUT (PRIMARY) CDB INITIALIZATION VECTOR
FALIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
600 ;"EXTRA" SIZE TO ALLOCATE
; (ENOUGH FOR NETWORK BUFFERS)
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
FALIVC: 0 ;I/O CONTROL (DEFAULT = ASCII MODE)
FALIVE: 0 ;I/O ERROR CONTROL
FALIVM: IM.DQA ;I/O MODE
0 ;RETURN FILE PARAMETERS
;"FAL" OUTPUT (SLAVE) CDB INITIALIZATION VECTOR
FALOV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
600 ;"EXTRA" SIZE TO ALLOCATE
; (COUPLA FSB'S, 2 128(10)-WORD DISK BUFFERS)
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
FALOVC: 0 ;I/O CONTROL (DEFAULT = ASCII MODE)
FALOVE: 0 ;I/O ERROR CONTROL
FALOVM: IM.DQA ;I/O MODE
0 ;RETURN FILE PARAMETERS
SUBTTL SWIL Argument Blocks
; ISCAN argument block:
ISBLK: XWD 12,%%FXVE ;PROTOCOL VERSION WORD
IOWD 0,0 ;IOWD OF LEGAL MONITOR COMMANDS
XWD [0],'FAL' ;ADDRESS OF STARTING OFFSET, CCL NAME
XWD .POPJ,.POPJ ;INPUT, OUTPUT ROUTINE ADDRESSES
EXP 0 ;INDIRECT FILE BLOCK POINTER
XWD .POPJ,FALERT ;PROMPT ROUTINE, MONRET ROUTINE
EXP FS.IFI ;DISALLOW INDIRECT COMMAND FILES
EXP FALERT ;ERROR ROUTINE
ISLEN==.-ISBLK ;LENGTH OF THE ISCAN PARAMETER BLOCK
SUBTTL Impure data
XLIST ;THE LITERALS
LIT ;THE LITERALS
LIST ;EVERYTHING AFTER THE LITERALS
;SOME IMPURE STORAGE
BZFAL: ;START OF TO-BE-ZEROED ON FAL STARTUP
IFN FTUTXT,<
UTXPTR: BLOCK 1 ;BYTE POINTER TO USERS.TXT BUFFER
UTXCTR: BLOCK 1 ;BYTE COUNTER TO ACCOMPANY UTXPTR
> ;END IFN FTUTXT
REJFIR::BLOCK 1 ;FIRST "REJECT"ION SPEC
REJLAS::BLOCK 1 ;LAST "REJECT"ION SPEC
NETPPN::BLOCK 1 ;DEFAULT NETWORK ACCESS PPN
S.MOAN::BLOCK 1 ;.GT. 0 THEN BITCH ABOUT MONITOR QUIRKS
NFTERT::BLOCK 1 ;.NE. 0 THEN ADDRESS OF SCAN ERROR INTERCEPT
NFTERP::BLOCK 1 ; STACK POINTER FOR C(NFTERT)'S USE
EZFAL: ;END OF TO-BE-ZEROED ON FAL STARTUP
END FAL##
Reference in New Issue View Git Blame Copy Permalink