.TITLE  WYL_RIO - RMS file IO procedures.
	.IDENT  /0-01/

;++
;
;  TITLE:  WYLRIO       Read VFC files.
;
;  FACILITY:  WYLVAX
;
;  ABSTRACT:
;
;       Procedures to manipulate normal sequential text files.
;       The purpose is to allow fast and convenient access to
;       files with variable format but with fixed control regions.
;       Files of this nature are numbered. Examples are numbered
;       files generated by the SOS, TECO and WYLVAX editors. The
;       numbering is compatible with these editors and with the
;       Fortran, Macro and Bliss routines. If the file accessed is
;       unnumbered the returned line number is always zero.
;       A typical file access consists of a call to PARSE to set up
;       the file name followed by a call to OPEN.  Multiple file
;       GETs read the records and a CLOSE ends file contact.
;
;  ENVIRONMENT: Run at any access mode. AST re-entrant if a
;               different channel is used for AST re-entry.
; 
;  AUTHOR:  Douglas Palmer, CREATION DATE: 20-SEP-1980
;
;  REVISION HISTORY:
;
;  27 NOV 1984	A. KREYMER   FNAL
;	Reverse role of RIO_M_AHT to make SAVE NOTABS the default.
;       Implement by changeing BBC to BBS in WYL_RIO_PUT
;--
  
	$FABDEF
	$RABDEF
	$NAMDEF
	$RMSDEF
  
RIO_K_USZ       = 512                           ; User buffer size
 
	$DEFINI RIO, GLOBAL
$DEF    RIO_B_FAB       .BLKB   FAB$C_BLN       ; Offset to FAB
$DEF    RIO_B_RAB       .BLKB   RAB$C_BLN       ; Offset to RAB
$DEF    RIO_B_NAM       .BLKB   NAM$C_BLN       ; Offset to NAM
$DEF    RIO_L_OPT       .BLKL   1               ; Copy of user options
	_VIELD  RIO, 0,    <-
	        <NOP,  , M> -           ; No operation
	        <DLT,  , M> -           ; Delete option
	        <SPL,  , M> -           ; Spool to lineprinter
	        <UNN,  , M> -           ; Create unnumbered
	        <CC ,  , M> -           ; Create with carriage control
	        <SCF,  , M> -           ; Submit command file.
	        <CIF,  , M> -           ; Create if option.
	        <TMD,  , M> -           ; Temporary & delete.
	        <SUP,  , M> -           ; Supersede files
	        <EOF,  , M> -           ; Space to EOF on open
	        <PUT,  , M> -           ; Open with PUT option
	        <OFP,  , M> -           ; Output file parsing
	        <RHT,  , M> -           ; Remove horizontal tabs
	        <AHT,  , M> -           ; Add horizontal tab.
	        <CVT,  , M> -           ; TTY - Convert to upper case
	        <PTA,  , M> -           ; TTY - Purge type-ahead
	        <RNE,  , M> -           ; TTY - Read no-echo
	        <NOW,  , M> -           ; TTY - No wait
	        <RBS,  , M> -           ; TTY - Remove backspaces
	                   >
$DEF    RIO_L_DUM       .BLKL   1               ; Dummy longword
$DEF    RIO_L_STS       .BLKL   1               ; RIO return code
$DEF    RIO_L_OFF       .BLKL   1               ; TAB offset
$DEF    RIO_L_ESS       .BLKL   1               ; Size of dir nam str
$DEF    RIO_L_RSS       .BLKL   1               ; Result. name size
$DEF    RIO_L_FSS       .BLKL   1               ; Size of filename 
$DEF    RIO_L_VEC       .BLKL   8               ; RMS message vector
$DEF    RIO_W_DID       .BLKW   3               ; Old DID
$DEF    RIO_Q_DSC       .BLKQ   1               ; Temporary descriptor
$DEF    RIO_B_ENM       .BLKB   NAM$C_MAXRSS    ; Dir file nam string
$DEF    RIO_B_RNM       .BLKB   NAM$C_MAXRSS    ; Dir file name string
$DEF    RIO_B_FNM       .BLKB   NAM$C_MAXRSS    ; File name string
$DEF    RIO_B_UBF       .BLKB   RIO_K_USZ       ; Record buffer
$DEF    RIO_K_BLN
	$DEFEND RIO, GLOBAL, DEF
 
	.PSECT  WYL_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,QUAD
   
	.PAGE   
	.SBTTL  FETCH           Definitions
 
;++
;
;       Array of codes and definitions for fetching quantities from the
;       file context fields.  The COD indicates the size and address
;       field interpretations:
;       Bit 0 set ==> Offset to byte containing size
;             clr ==> Real size of data
;       Bit 1 set ==> Offset to longword containing address
;           1 clr ==> Offset to data
;
;--
 
RIO_K_FETCNT = 0

	.MACRO  _QUAN   NAM, SIZ, LOC, TYP
	RIO_K_FETCNT = RIO_K_FETCNT + 1
	.BYTE   TYP
	.ASCII  /'NAM'/
	.WORD   SIZ, LOC
	.ENDM   _QUAN
 
FETLST:
_QUAN   ALQ,    4,                      RIO_B_FAB+FAB$L_ALQ,    0
_QUAN   BLS,    2,                      RIO_B_FAB+FAB$W_BLS,    0
_QUAN   DEQ,    2,                      RIO_B_FAB+FAB$W_DEQ,    0
_QUAN   DEV,    RIO_B_NAM+NAM$B_DEV,    RIO_B_NAM+NAM$L_DEV,    3
_QUAN   DID,    6,                      RIO_B_NAM+NAM$W_DID,    0
_QUAN   DIR,    RIO_B_NAM+NAM$B_DIR,    RIO_B_NAM+NAM$L_DIR,    3
_QUAN   DVI,    RIO_B_NAM+NAM$T_DVI,    RIO_B_NAM+NAM$T_DVI+1,  1
_QUAN   ENM,    RIO_B_NAM+NAM$B_ESL,    RIO_B_ENM,              1
_QUAN   FID,    6,                      RIO_B_NAM+NAM$W_FID,    0
_QUAN   FNB,    4,                      RIO_B_NAM+NAM$L_FNB,    0
_QUAN   FSZ,    1,                      RIO_B_FAB+FAB$B_FSZ,    0
_QUAN   MRS,    4,                      RIO_B_FAB+FAB$W_MRS,    0
_QUAN   NAM,    RIO_B_NAM+NAM$B_NAME,   RIO_B_NAM+NAM$L_NAME,   3
_QUAN   NOD,    RIO_B_NAM+NAM$B_NODE,   RIO_B_NAM+NAM$L_NODE,   3
_QUAN   PDC,    4,                      RIO_B_FAB+FAB$L_DEV,    0
_QUAN   RAT,    1,                      RIO_B_FAB+FAB$B_RAT,    0
_QUAN   RFM,    1,                      RIO_B_FAB+FAB$B_RFM,    0
_QUAN   RNM,    RIO_B_NAM+NAM$B_RSL,    RIO_B_RNM,              1
_QUAN   SDC,    4,                      RIO_B_FAB+FAB$L_SDC,    0
_QUAN   STV,    4,                      RIO_B_FAB+FAB$L_STV,    0
_QUAN   TYP,    RIO_B_NAM+NAM$B_TYPE,   RIO_B_NAM+NAM$L_TYPE,   3
_QUAN   VER,    RIO_B_NAM+NAM$B_VER,    RIO_B_NAM+NAM$L_VER,    3
 
	.PAGE
	.SBTTL  WYL_RIO_PARSE   Parse a filename.
  
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       A supplied filename is presented to the RMS PARSE facility
;       and missing components to the name are supplied from the 
;       directory specifications. If a default name is supplied then
;       it is used as the source of the default name string.
;       Missing information from the default specification is supplied
;       by the system (process) default characterstics.
;       A call to this procedure MUST precede a call to any other
;       RIO procedure.  
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_PARSE(chan.rl.r,rnmstr.rt.dx
;                           [,dfnstr.rt.dx] [,option.rl.v])
;
;  INPUT PARAMETERS:
;
;       rnmstr  Address of a character string descriptor containing
;               the input filename to be modified.
;
;       dfnstr  Optional address of character string descriptr
;               containing the name of a default file specification
;               to be used for parsing the raw input name.
;
;       option  Optional longword specifying a file name bit
;               parsing options mask. Options are:
;               RIO_M_OFP       Output file parsing (def = input)
;
;  OUTPUT PARAMETERS:
;
;       chan    Address of longword to receive the RIO channel number.
;               This channel carries the context of RMS processing 
;               between calls.  If chan is zero a new internal block
;               is allocated.  If non-zero it is assumed that an
;               internal context block has already been established
;               with a previous call to PARSE.
;
;  COMPLETION STATUS:
; 
;       Rmsts   System status return codes.
;
;--
  
RIO_M_PRS       = ^C<RIO_M_OFP>
RNMSTR  = 8     ; #2
DFNSTR  = 12    ; #3
OPTION  = 16    ; #4
  
	.ENTRY  WYL_RIO_PARSE,^M<R2,R3,R4,R5,R11>
	BSBW    RIO___GETCHN_R0
	CLRL    RIO_W_DID(R11)
	MOVL    RNMSTR(AP), R2                  ; RNMSTR descr addr
	MOVZWL  (R2), RIO_L_FSS(R11)            ; Set size
	MOVC5   (R2), @4(R2), #^A/ /, -         ; Move string
	        #NAM$C_MAXRSS, RIO_B_FNM(R11)
	$FAB_STORE      -
	        FAB     = RIO_B_FAB(R11), -
	        FOP     = <NAM>, -
	        FNS     = RIO_L_FSS(R11), -
	        FNA     = RIO_B_FNM(R11)
	CMPB    (AP), #4                        ; Options?
	BLSS    20$                             ; If no 4th arg go on
	BICL3   #RIO_M_PRS, OPTION(AP), R0      ; Valid options mask
	BSBW    RIO__SETOPT_R0
20$:
	CMPB    (AP), #3                        ; Default filename
	BLSS    40$
	MOVL    DFNSTR(AP), R2                  ; Descriptor address
	BEQL    40$
	$FAB_STORE      -
	        FAB     = RIO_B_FAB(R11), -
	        DNS     = (R2), -
	        DNA     = @4(R2)
40$:
	$PARSE  FAB     = RIO_B_FAB(R11)        ; Do the parsing
	BLBS    R0, 80$
	MOVL    #WYL__PRSERR, RIO_L_STS(R11)
80$:
	RET

	.PAGE
	.SBTTL  WYL_RIO_SEARCH  Read search parameters.
   
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure to return a file search result. When the list is
;       exhausted the return code is false to terminate reading.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_SEARCH(chan.rl.r,fnstr.wt.dx[,fnsiz.wl.r])
;
;  INPUT PARAMETERS:
;
;       chan  Address of longword specifying IO channel.
; 
;  OUTPUT PARAMETERS:
;
;       fnstr   Address of character string descriptor pointing
;               to a buffer to receive the file name.
;
;       fnsiz   Optional ddress of longword to receive the file name
;               length.
;
;  COMPLETION STATUS:
;
;       RMS$_NMF        No more files.
;       RMS$_PRV        Privilege violation
;       WYL__NEWDIR     Successful but new directory.
;
;--
  
FNSTR   = 8
FNSIZ   = 12

	.ENTRY  WYL_RIO_SEARCH, ^M<R2,R3,R4,R5,R6,R7,R11>
	BSBW    RIO___CHKCHN_R1
	$SEARCH FAB     = RIO_B_FAB(R11)        ; Search for file
	CMPL    #RMS$_PRV, R0                   ; Priv violation?
	BEQL    20$
	BLBC    R0, 100$
20$:
	MOVZBL  <RIO_B_NAM + NAM$B_RSL>(R11), R6; RS len
	MOVL    <RIO_B_NAM + NAM$L_RSA>(R11), R7; RS add
	MOVQ    @FNSTR(AP), R0                  ; R0, R1 <-- Descr
	MOVC5   R6, (R7), #32, R0, (R1)         ; Move string
	CMPB    (AP), #3                        ; Size argument?
	BLSS    40$
	TSTL    FNSIZ(AP)                       ; Valid?
	BEQL    40$
	SUBL3   R0, R6, @FNSIZ(AP)              ; Truncate
40$:
	MOVL    <RIO_B_FAB+FAB$L_STS>(R11), R0  ; Get status
	CMPL    RIO_W_DID(R11), <RIO_B_NAM+NAM$W_DID>(R11)
	BEQL    60$
	MOVL    #WYL__NEWDIR, R0
60$:
	MOVL    <RIO_B_NAM+NAM$W_DID>(R11), RIO_W_DID(R11)
	RET
100$:
	MOVL    #WYL__SEAERR, RIO_L_STS(R11)
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_OPEN    Open a VFC file.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to open a file identified by a previous call to PARSE.
;       Establishes a single record stream to the file.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_OPEN(chan.ml.r[,option.rl.v])
;   
;  INPUT PARAMETERS:
;  
;       chan    Address of longword to specifying the IO access block
;               address.
;
;       option  Optional longword file processing options mask.
;               The possible options are defined by control masks.
;               These are:
;               RIO_M_DLT  - Delete file when closing.
;               RIO_M_SCF  - Submit as batch-command file.
;               RIO_M_SPL  - Spool. Send to print queue.
;               RIO_M_PUT  - Open with PUT option. Must have privs.
;               RIO_M_EOF  - Space to end of file.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--
 
RIO_M_OPE       = ^C<RIO_M_DLT!RIO_M_SCF!RIO_M_SPL!RIO_M_PUT!RIO_M_EOF>
  
CHAN    = 4
OPTION  = 8

	.ENTRY  WYL_RIO_OPEN, ^M<R2,R3,R11>
	BSBW    RIO___CHKCHN_R1
	CLRL    <FAB$L_FOP+RIO_B_FAB>(R11)      ; Clear FOP
	CLRB    <FAB$B_FAC+RIO_B_FAB>(R11)      ; Clear FAC
	CLRB    <FAB$B_RFM+RIO_B_FAB>(R11)      ; Clear RFM
	$FAB_STORE -
	        FAB     = RIO_B_FAB(R11),-
	        FAC     = <GET>, -
	        FOP     = <NAM,SQO,TEF>, -
	        RFM     = <VFC>
	CMPB    (AP), #2                        ; Option argument?
	BLSS    20$
	TSTL    OPTION(AP)                      ; Valid address?
	BEQL    20$
	BICL3   #RIO_M_OPE, OPTION(AP), R0      ; Valid option bits
	BSBW    RIO__SETOPT_R0
20$:
	$OPEN   FAB     = RIO_B_FAB(R11)
	BLBC    R0, 40$
	$CONNECT -
	        RAB     = RIO_B_RAB(R11)
	BLBC    R0, 40$
	RET
40$:
	MOVL    #WYL__OPEERR, RIO_L_STS(R11)
	RET
  
	.PAGE
	.SBTTL  WYL_RIO_CREATE  Create a VFC file.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to create a file given by a filename esablished by
;       a previous call to PARSE.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_CREATE(chan.ml.r[,option.rl.v]
;                      [,alq.rl.v=0][,deq.rl.v=0])
;   
;  INPUT PARAMETERS:
;  
;       chan    Address of longword specifying the IO channel returned
;               by a previous call to PARSE.
;
;       option  Optional longword containing bits set to indicate
;               create options. The possible options are defined by
;               control masks. These are:
;               RIO_M_DLT  - Delete file when closing.
;               RIO_M_SCF  - Submit as batch-command file.
;               RIO_M_UNN  - Omit line numbers from output.
;               RIO_M_SPL  - Spool. File is to be send to print queue
;               RIO_L_SUP  - Supersede; allows replacing existing file
;                            of the same name, type and version. CIF
;                            takes precedence over this option.
;               RIO_M_CC   - Enable Fortran carriage control.
;               RIO_M_TMD  - Temporay marked fro delete.
;               RIO_M_CIF  - Create file if it does not already
;                            exist. If it exists file is opened
;                            with a return RMS$_CREATED.
;               RIO_M_EOF  - Space to end of file.
;
;       alq     Optional allocation quantity specifies the initial
;               block allocation for the file.  Unusued blocks may be 
;               released when the file is closed. Performance is
;               greatly enhanced by allocating sufficient space when a
;               file is created.  Passed by value.
;
;       deq     Optional value specifying the default file extension
;               quantity.  Specifies the number of blocks to add for
;               each file extension.  Passed by value.
;
;  OUTPUT PARAMETERS:
;
;       None.
; 
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--

RIO_M_CRE       = RIO_M_DLT!RIO_M_SCF!RIO_M_UNN!RIO_M_SPL!RIO_M_SUP
RIO_M_CRE       = ^C<RIO_M_CRE!RIO_M_CC !RIO_M_TMD!RIO_M_CIF!RIO_M_EOF>
ALQ     = 12
DEQ     = 16
  
	.ENTRY  WYL_RIO_CREATE, ^M<R2,R3,R11>
	BSBW    RIO___CHKCHN_R1
	CLRL    <FAB$L_FOP+RIO_B_FAB>(R11)      ; Clear FOP
	CLRB    <FAB$B_FAC+RIO_B_FAB>(R11)      ; Clear FAC
	CLRB    <FAB$B_RFM+RIO_B_FAB>(R11)      ; Clear RFM
	$FAB_STORE -
	        FAB     = RIO_B_FAB(R11),-
	        FAC     = <GET>, -
	        ALQ     = #0, -                 ; Allocate 1 block
	        DEQ     = #0, -                 ; 1 block extents
	        FAB     = RIO_B_FAB(R11),-      ; Address of FAB
	        FAC     = <PUT,GET,UPD>, -      ; Put access
	        FOP     = <SQO,MXV,TEF,OFP>, -  ; Contiguous
	        FSZ     = #2,-                  ; 2 byte control field
	        NAM     = RIO_B_NAM(R11),-      ; Get resultant name
	        ORG     = SEQ,-                 ; Sequential
	        RAT     = <CR>,-                ; Print with CR
	        RFM     = <VFC>                 ; Variable
	CMPB    (AP), #2                        ; Option argument?
	BLSS    20$
	TSTL    OPTION(AP)                      ; Valid address?
	BEQL    20$
	BICL3   #RIO_M_CRE, OPTION(AP), R0      ; Valid option bits
	BSBW    RIO__SETOPT_R0
20$:
	CMPB    (AP), #3                        ; 3 Args?
	BLSS    60$
	MOVL    ALQ(AP), <RIO_B_FAB+FAB$L_ALQ>(R11)
40$:
	CMPB    (AP), #4                        ; 4 Args?
	BLSS    60$
	MOVW    DEQ(AP), <RIO_B_FAB+FAB$W_DEQ>(R11)
60$:
	$CREATE FAB     = RIO_B_FAB(R11)
	BLBC    R0, 100$
	$CONNECT -
	        RAB     = RIO_B_RAB(R11)
	BLBC    R0, 100$
	RET
100$:
	MOVL    #WYL__CREERR, RIO_L_STS(R11)
	RET

	.PAGE
	.SBTTL  WYL_RIO_CLOSE   Close an open file.
  
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure to close a file previously created or opened.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_CLOSE(chan.rl.r[,option.rl.v])
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword containing address of IO block
;
;       option  Optional longword bit mask to specify
;               various file closing options. Options are:
;               RIO_M_DLT  - Delete file when closing.
;               RIO_M_SCF  - Submit as batch-command file.
;               RIO_M_SPL  - Spool. Send to print queue.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--
  
RIO_M_CLO       = ^C<RIO_M_DLT!RIO_M_SCF!RIO_M_SPL>
OPTION  = 8
 
	.ENTRY  WYL_RIO_CLOSE, ^M<R11>
	BSBW    RIO___CHKCHN_R1
	CMPB    (AP), #2                        ; Option argument?
	BLSS    20$
	TSTL    OPTION(AP)                      ; Valid address?
	BEQL    20$
	BICL3   #RIO_M_CLO, OPTION(AP), R0      ; Valid option bits
	BSBW    RIO__SETOPT_R0
20$:
	$CLOSE  FAB     = RIO_B_FAB(R11)
	BLBC    R0, 100$
	MOVL    #WYL__CLOERR, RIO_L_STS(R11)
100$:
	RET
        
	.PAGE
	.SBTTL  WYL_RIO_REWIND  Rewind file.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure to rewind a file to commence reading from
;       the beginning.  File must have been opened.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_REWIND(chan.rl.r)
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword containing the channel block.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--
  
	.ENTRY  WYL_RIO_REWIND, ^M<R2,R3,R11>
	BSBW    RIO___CHKCHN_R1
	$REWIND RAB     = RIO_B_RAB(R11)
	BLBC    R0, 100$
	MOVL    #WYL__REWERR, RIO_L_STS(R11)
100$:
	RET

	.PAGE
	.SBTTL  WYL_RIO_ERASE   Delete a file.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure deletes a file and removes it's directory entry.
;       Must not be preceded by a OPEN.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_ERASE(chan.rl.r)
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword containing the access channel.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--

	.ENTRY  WYL_RIO_ERASE, ^M<R11>
	BSBW    RIO___CHKCHN_R1
	$ERASE  FAB     = RIO_B_FAB(R11)
	BLBS    R0, 100$
	MOVL    #WYL__DELERR, RIO_L_STS(R11)
100$:
	RET

	.PAGE
	.SBTTL  WYL_RIO_ERROR   Report IO error.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure to report an RMS IO error relating to the last
;       performed IO operation.  Uses the PUTMSG facility.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_ERROR(chan.rl.r)
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword containing address of IO block
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       Error code which caused error.
;
;--

	.ENTRY  WYL_RIO_ERROR, ^M<R2,R11>
	MOVAW   G^LIB$SIG_TO_RET, 0(FP)
	MOVL    @CHAN(AP), R11                  ; R11 <-- Chn address
	BEQL    100$
	MOVL    #6,                             < 0+RIO_L_VEC>(R11)
	MOVL    RIO_L_STS(R11),                 < 4+RIO_L_VEC>(R11)
	MOVL    #2,                             < 8+RIO_L_VEC>(R11)
	MOVL    <RIO_B_FAB+FAB$L_STS>(R11),     <20+RIO_L_VEC>(R11)
	MOVL    <RIO_B_FAB+FAB$L_STV>(R11),     <24+RIO_L_VEC>(R11)
	CMPL    RIO_L_STS(R11), #WYL__ACCERR    
	BNEQ    10$
	MOVL    <RIO_B_RAB+RAB$L_STS>(R11),     <20+RIO_L_VEC>(R11)
	MOVL    <RIO_B_RAB+RAB$L_STV>(R11),     <24+RIO_L_VEC>(R11)
10$:
	MOVZBL  <RIO_B_NAM+NAM$B_RSL>(R11),     <12+RIO_L_VEC>(R11)
	BEQL    20$
	MOVL    <RIO_B_NAM+NAM$L_RSA>(R11),     <16+RIO_L_VEC>(R11)
	BRB     60$
20$:
	MOVZBL  <RIO_B_NAM+NAM$B_ESL>(R11),     <12+RIO_L_VEC>(R11)
	BEQL    40$
	MOVL    <RIO_B_NAM+NAM$L_ESA>(R11),     <16+RIO_L_VEC>(R11)
	BRB     60$
40$:
	MOVZBL  RIO_L_FSS(R11),                 <12+RIO_L_VEC>(R11)
	MOVAB   RIO_B_FNM(R11),                 <16+RIO_L_VEC>(R11)
60$:
	$PUTMSG_S -
	        MSGVEC  = RIO_L_VEC(R11)
	MOVL    <4+RIO_L_VEC>(R11), R0          ; Return code
	RET
100$:
	MOVL    #WYL__INVRIOCHN, R0
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_FETCH   Fetch file parameters.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Procedure fetches from the appropriate RMS data structure the
;       requested information called for by the user.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_FETCH(chan.rl.r,code.rt.dx,
;                       bufsiz.rl.v,buffer.rl.r[,bufmov.rl.r])
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword containing address of IO block
;
;       code    Address of code character string descriptor indicating
;               the quantity desired.  The available codes are:
;               ALQ  -  Allocation quantity (longword)
;               BLS  -  Block size (word)
;               DEQ  -  Default extension quantity (word)
;               DEV  -  Device name (string)
;               DID  -  Directory ID (3 words)
;               DIR  -  Directory name (string)
;               DVI  -  Device name (string)
;               ENM  -  Expanded string name
;               FID  -  File ID (3 words)
;               FNB  -  File name status bits (longword)
;               FSZ  -  Fixed control area size (longword)
;               MRS  -  Maximum record size (longword)
;               NAM  -  File name (string)
;               NOD  -  Node name (string)
;               PDC  -  Primary device characteristics (longword)
;               RAT  -  Record carriage control attribute (string)
;               RNM  -  Resultant complete file name
;               RFM  -  Record format (string)
;               SDC  -  Secondary device char.s (longword)
;               STV  -  Status value field (longword)
;               TYP  -  File type (string)
;               VER  -  Version of file (string)
;
;       bufsiz  Value indicating the size of the buffer to accept the
;               returned data.
;
;  OUTPUT PARAMETERS:
;
;       buffer  Address of buffer to accept the returned data.
;
;       bufmov  Optional address of longword to accept the number of
;               bytes transferred to the users buffer.
;
;  RETURN STATUS:
;
;       WYL__NORMAL     Normal successful completion
;       WYL__INVSYMNAM  Invalid symbol name.
;
;--

CODE    = 8
BUFSIZ  = 12
BUFFER  = 16
BUFMOV  = 20
 
	.ENTRY  WYL_RIO_FETCH, ^M<R2,R3,R4,R5,R11>
	BSBW    RIO___CHKCHN_R1
	MOVQ    @CODE(AP), R0                   ; R0, R1 <-- Descr
	CMPW    R0, #3                          ; 3 Characters?
	BNEQ    100$
	MOVW    (R1), R0                        ; R0 gets first 3 chars
	CLRL    R1                              ; Index
	MOVAL   FETLST, R3                      ; Addr of list
10$:
	MOVAQ   (R3)[R1], R2                    ; Bump address
	CMPW    R0, 1(R2)                       ; Compare 2 bytes
	BEQL    20$
	AOBLEQ  #RIO_K_FETCNT, R1, 10$
	BRB     100$
20$:
	MOVZWL  4(R2), R0                       ; Length parm
	MOVZWL  6(R2), R1                       ; Address parm
	MOVAB   (R11)[R1], R1                   ; Address
	BBC     #0, (R2), 40$                   ; Offset size?
	MOVZBL  (R11)[R0], R0                   ; Length
40$:
	BBC     #1, (R2), 50$                   ; Offset address?
	MOVL    (R1), R1                        ; Real address
50$:
	CMPL    R0, BUFSIZ(AP)                  ; Too big?
	BLEQ    60$
	MOVL    BUFSIZ(AP), R0                  ; Truncate
60$:
	CMPB    (AP), #5                        ; BUFMOV arg?
	BLSS    80$
	TSTL    BUFSIZ(AP)                      ; Valid?
	BEQL    80$
	MOVL    R0, @BUFMOV(AP)                 ; Set bytes moved
80$:
	MOVC3   R0, (R1), @BUFFER(AP)           ; Move data
	MOVL    #WYL__NORMAL, R0
	RET
100$:
	MOVL    #WYL__INVSYMNAM, R0
	RET
  
	.PAGE
	.SBTTL  WYL_RIO_GET     Read one record.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to get one record from the file opened or created
;       previously.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_GET(chan.rl.r,reclin.wl.r,recsiz.wl.dx,
;                                      recstr.wt.dx)
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword specifying the IO access block
;               address.
;
;  OUTPUT PARAMETERS:
;
;       reclin  Address of longword to receive the record line number.
;
;       recsiz  Address of longword to receive the size of the
;               string returned.
;
;       recstr  Address of character string descriptor pointing to
;               buffer to receive the record.
;
;  RETURN STATUS:
;
;       RMS$_RTB   Record too big for users buffer.     
;       RMS$_EOF   End of file encountered this operation.
;
;--
  
RECLIN  = 8
RECSIZ  = 12
RECSTR  = 16
  
	.ENTRY  WYL_RIO_GET,^M<R2,R3,R11>
	BSBW    RIO___CHKCHN_R1
	MOVQ    @RECSTR(AP), R2                 ; R2, R3 <-- Descr
	$RAB_STORE -
	        RAB     = RIO_B_RAB(R11), -
	        RHB     = @RECLIN(AP), -
	        UBF     = (R3), -
	        USZ     = R2
	$GET    RAB     = RIO_B_RAB(R11)        ; Get record
	BLBC    R0, 100$
	BICL2   #^XFFFF0000, @RECLIN(AP)        ; Zero top 2 bytes
	MOVZWL  <RIO_B_RAB+RAB$W_RSZ>(R11), @RECSIZ(AP)
	RET
100$:
	MOVL    #WYL__ACCERR, RIO_L_STS(R11)
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_PUT     Put a record into the file.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to put one record into the file alredy opened.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_PUT(chan.rl.r,reclin.wl.r,
;                      recsiz.rl.r,recadr.rl.r[,optmsk.rl.v])
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword specifying the IO access block
;               address.
;
;       reclin   Address of longword containing the line number.
;
;       recsiz  Record size in bytes.   Passed by value.
;
;       recadr  Address of record string to be written.
;
;       optmsk  Optional mask specifying various output options.
;               Passed by value.  Possible options are:
;               RIO_M_AHT       Add horizontal tab.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--

RECLIN   = 8
RECSIZ  = 12
RECADR  = 16
OPTMSK  = 20

	.ENTRY  WYL_RIO_PUT,^M<R2,R3,R4,R5,R6,R7,R11>
	BSBW    RIO___CHKCHN_R1
	MOVQ    RECSIZ(AP), R6                  ; R6, R7 <-- Descr
	CMPB    (AP), #5                        ; Option
	BLSS    40$
	BBS     #RIO_V_AHT, OPTMSK(AP), 40$     ; If .not.AHT THEN
	CMPW    R6, #8                          ; Too small?
	BLEQ    40$
	SKPC    #^X20, #8, (R7)                 ; 8 Blanks?
	BNEQ    40$
	ADDL3   #4, R6, R2                      ; Make longword size
	BICL2   #3, R2                          ; LW align stack
	SUBL2   R2, SP                          ; Room on stack
	MOVB    #^X09, (SP)                     ; Put in byte
	SUBL2   #8, R6                          ; Move size
	MOVC3   R6, (R1), 1(SP)                 ; Move remainder
	INCL    R6                              ; Add tab size
	MOVL    SP, R7                          ; Change address
40$:
	MOVL    RECLIN(AP), <RIO_B_RAB+RAB$L_RHB>(R11)  ; Linum
	MOVW    R6,          <RIO_B_RAB+RAB$W_RSZ>(R11) ; Record size
	MOVL    R7,          <RIO_B_RAB+RAB$L_RBF>(R11) ; Record addr
	$PUT    RAB     = RIO_B_RAB(R11)        ; Put record
	BLBC    R0, 100$
	RET
100$:
	MOVL    #WYL__ACCERR, RIO_L_STS(R11)
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_FAO     Put a formatted record.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine formats a record for output and then puts the record.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_FAO(chan.rl.r,ctrstr.rt.dx [,p1]...)
; 
;  INPUT PARAMETERS:
; 
;       chan    Address of longword containing the channel number.
;
;       ctrstr  Address of character string descriptor pointing to
;               a buffer containing the string to be sent to 
;               SYS$OUTPUT.
;               If optional parameters are supplied this string is
;               used as a control string to FAO.
;
;       p1, p2  Optional formatting parameters. See SYS$FAO.
;
;  OUTPUT PARAMETERS:
;
;       None.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--

CTRSTR  = 8
P1      = 12
  
RIO_K_MAXCOL    = 512
  
	$DEFINI STK
$DEF    STK_L_DUMMY     .BLKL   1
$DEF    STK_Q_TMPDSC    .BLKQ   1               ; Temp descriptor
$DEF    STK_T_TMPBUF    .BLKB   RIO_K_MAXCOL    ; Temp buffer
$DEF    STK_K_STKSIZ
	$DEFEND STK
 
	.ENTRY  WYL_RIO_FAO, ^M<R2,R3,R11>
	MOVAW   G^LIB$SIG_TO_RET, 0(FP)
	SUBL2   #STK_K_STKSIZ, SP               ; Room on stack
	MOVL    SP, R11                         ; Base of stack
	MOVL    CTRSTR(AP), R3                  ; Default address
	CMPB    (AP), #2                        ; More than one arg?
	BLEQ    60$
	MOVL    #RIO_K_MAXCOL,          <0+STK_Q_TMPDSC>(R11) ; Set len
	MOVAL   STK_T_TMPBUF(R11),      <4+STK_Q_TMPDSC>(R11) ; Set add
	PUSHAL  P1(AP)                          ; ARG4 (plist)
	PUSHAL  STK_Q_TMPDSC(R11)               ; ARG3 (retstr)
	PUSHAL  STK_Q_TMPDSC(R11)               ; ARG2 (rsiz)
	PUSHL   CTRSTR(AP)                      ; ARG1 (ctrstr)
	CALLS   #4, G^SYS$FAOL
	BLBC    R0, 60$
	MOVAL   STK_Q_TMPDSC(R11), R3           ; Formatted string
60$:
	MOVQ    (R3), R0                        ; R0, R1 <-- Descr
	MOVZWL  R0, R0                          ; Zero extend length
	PUSHL   R1                              ; ARG4 (address)
	PUSHL   R0                              ; ARG3 (length)
	PUSHAL  STK_L_DUMMY(R11)                ; ARG2 (linum )
	PUSHL   CHAN(AP)                        ; ARG1 (channel)
	CALLS   #4, G^WYL_RIO_PUT
80$:
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_PROMPT  Prompt for record.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to read a line of text from a terminal.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_PROMPT(chan.rl.r,recstr.wt.dx
;               [,pmtstr.rt.dx] [,recsiz.wl.r] [,optmsk.rl.v])
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword specifying the IO access block
;               address.
;
;       pmtstr  Optional address of prompt string descriptor.
;
;       optmsk  Optional value of options mask to specify terminal
;               input processing options.
;               RIO_M_PTA - Purge type-ahead buffer
;               RIO_M_RNE - Read no-echo
;               RIO_M_RBS - Remove backspace characters
;               RIO_M_RHT - Remove horizontal tabs
;               RIO_M_NOW - Don't wait for input.
;
;  OUTPUT PARAMETERS:
;
;       recstr  Address of character string descriptor pointing to
;               buffer to receive the data record.
;
;       recsiz  Optional address of longword to receive the
;               record size.
;
;  RETURN STATUS:
;
;       WYL, RMS and LIB return codes.
;
;--

RECSTR  = 8
PMTSTR  = 12
RECSIZ  = 16
OPTION  = 20

	.ENTRY  WYL_RIO_PROMPT,^M<R2,R3,R4,R5,R11>
	BSBW    RIO___CHKCHN_R1
 
;+
;  Fill in special terminal type options here.
;-
 
	MOVL    <RIO_B_RAB+RAB$L_ROP>(R11), R4  ; Save ROP
	MOVL    RECSTR(AP), R3
	MOVZWL  (R3), R1                        ; Length
	CMPL    R1, #RIO_K_USZ                  ; Too big?
	BLEQU   10$
	MOVL    #RIO_K_USZ, R1                  ; Truncate
10$:
	$RAB_STORE -
	        RAB     = RIO_B_RAB(R11), -
	        RHB     = #0, -
	        UBF     = RIO_B_UBF(R11), -
	        USZ     = R1
	CLRL    RIO_L_OFF(R11)                  ; Zero offset
	CMPB    (AP), #3                        ; Prompt?
	BLSS    20$
	TSTL    PMTSTR(AP)
	BEQL    20$
	MOVL    PMTSTR(AP), R2
	MOVZWL  (R2), RIO_L_OFF(R11)            ; Prompt size offset
	$RAB_STORE -
	        RAB     = RIO_B_RAB(R11), -
	        PBF     = @4(R2), -
	        PSZ     = (R2), -
	        ROP     = <PMT>
20$:
	MOVAL   RIO_L_DUM(R11), R3              ; Default retsiz
	CMPB    (AP), #4                        ; RECSIZ?
	BLSS    40$
	TSTL    RECSIZ(AP)
	BEQL    40$
	MOVL    RECSIZ(AP), R3
40$:
	CLRL    R5                              ; Default options
	CMPB    (AP), #5                        ; Options?
	BLSS    120$
	MOVL    OPTION(AP), R5                  ; R5 <-- OPTION
	BBC     #RIO_V_CVT, R5, 60$             ; CVT
	BISL2   #RAB$M_CVT, <RIO_B_RAB+RAB$L_ROP>(R11)
60$:    BBC     #RIO_V_PTA, R5, 80$             ; PTA
	BISL2   #RAB$M_PTA, <RIO_B_RAB+RAB$L_ROP>(R11)
80$:    BBC     #RIO_V_RNE, R5, 100$            ; RNE
	BISL2   #RAB$M_RNE, <RIO_B_RAB+RAB$L_ROP>(R11)
100$:   BBC     #RIO_V_NOW, R5, 120$            ; NOW
	BISL2   #RAB$M_TMO, <RIO_B_RAB+RAB$L_ROP>(R11)

;+
;  Process record and set up error vector if error.
;-

120$:
	$GET    RAB     = RIO_B_RAB(R11)        ; Get record
	MOVL    R4, <RIO_B_RAB+RAB$L_ROP>(R11)  ; Restore ROPs
	BLBS    R0, 140$
	MOVZWL  <RIO_B_RAB+RAB$W_RSZ>(R11), (R3)
	MOVL    #WYL__ACCERR, RIO_L_STS(R11)
	RET

;+
;  Process departing options.
;-

140$:
	MOVZWL  <RIO_B_RAB+RAB$W_RSZ>(R11), <0+RIO_Q_DSC>(R11)
	MOVL    <RIO_B_RAB+RAB$L_RBF>(R11), <4+RIO_Q_DSC>(R11)
	BBC     #RIO_V_RHT, R5, 160$            ; RHT
	PUSHL   RIO_L_OFF(R11)                  ; ARG4 - Offset
	PUSHAL  (R3)                            ; ARG3 - Outlen
	PUSHAQ  @RECSTR(AP)                     ; ARG2 - Outstr
	PUSHAQ  RIO_Q_DSC(R11)                  ; ARG1 - Inpstr
	CALLS   #4, G^WYL_EXPAND
	BLBC    R0, 200$
	PUSHR   #^M<R2,R3,R4,R5>                ; Save registers
	MOVQ    @RECSTR(AP), R0                 ; R0, R1 <-- Descr
	MOVQ    (R3), R2                        ; Number of characters
	SUBW3   R2, R0, R3                      ; Fill count
	MOVC5   #00, (AP), #32, R3, (R1)[R2]    ; Blank fill
	POPR    #^M<R2,R3,R4,R5>                ; Restore registers
	BRB     180$
160$:
	PUSHAL  (R3)                            ; ARG3 - Outlen
	PUSHAQ  @RECSTR(AP)                     ; ARG2 - Outstr
	PUSHAQ  RIO_Q_DSC(R11)                  ; ARG1 - Inpstr
	CALLS   #3, G^WYL_CPYSTR
	BLBC    R0, 200$
180$:
	BBC     #RIO_V_RBS, R5, 200$            ; RBS
	MOVQ    @RECSTR(AP), RIO_Q_DSC(R11)     ; Descriptor
	MOVZWL  (R3), RIO_Q_DSC(R11)            ; Set length
	PUSHAL  (R3)                            ; ARG3 - Outlen
	PUSHL   #0                              ; ARG2 - Outstr
	PUSHAQ  RIO_Q_DSC(R11)                  ; ARG1 - Inpstr
	CALLS   #3, G^WYL_CNV_BKSP
200$:
	RET
 
	.PAGE
	.SBTTL  WYL_RIO_LOCATE  Locate record.

;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Routine to obtain one record from the file opened or created
;       previously.  Uses locate mode to save time.
;
;  CALLING SEQUENCE:
;
;       Sts.wlc.v = WYL_RIO_LOCATE(chan.rl.r,reclin.wl.r,recsiz.wl.dx,
;                                      recadr.wl.r)
;
;  INPUT PARAMETERS:
;
;       chan    Address of longword specifying the IO access block
;               address.
;
;  OUTPUT PARAMETERS:
;
;       reclin  Address of longword to receive the record line number.
;
;       recsiz  Address of longword to receive the size of the
;               string returned.
;
;       recstr  Address of longword to receive the records address.
;
;  RETURN STATUS:
;
;       RMS$_RTB   Record too big for users buffer.
;       RMS$_EOF   End of file encountered this operation.
;
;--

RECLIN  = 8
RECSIZ  = 12
RECADR  = 16

	.ENTRY  WYL_RIO_LOCATE,^M<R2,R3,R11>
	BSBW    RIO___CHKCHN_R1
	BISL2   #RAB$M_LOC, <RIO_B_RAB+RAB$L_ROP>(R11)  ; Locate mode
	$RAB_STORE -
	        RAB     = RIO_B_RAB(R11), -
	        RHB     = @RECLIN(AP), -
	        UBF     = RIO_B_UBF(R11), -
	        USZ     = #512
	$GET    RAB     = RIO_B_RAB(R11)                ; Loc record
	BICL2   #RAB$M_LOC, <RIO_B_RAB+RAB$L_ROP>(R11)  ; Reset mode
	BLBC    R0, 100$
	BICL2   #^XFFFF0000, @RECLIN(AP)        ; Zero top 2 bytes
	MOVZWL  <RIO_B_RAB+RAB$W_RSZ>(R11), @RECSIZ(AP)
	MOVL    <RIO_B_RAB+RAB$L_RBF>(R11), @RECADR(AP)
	RET
100$:
	MOVL    #WYL__ACCERR, RIO_L_STS(R11)
	RET
 
	.PAGE
	.SBTTL  RIO___GETCHN_R0
 
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Co-routine to setup a channel (allocate VM and initialize it)
;       If there is already a context block allocated initialize it.
;
;  INPUTS:      None.
;  OUTPUTS:     R11     Block base address
;
;--
    
RIO___GETCHN_R0:
	MOVAW   G^LIB$SIG_TO_RET, 0(FP)
 
;+
;  New or old context block?  If new allocate VM for it.
;-
 
	TSTL    @CHAN(AP)               ; Channel already?
	BNEQ    40$
	PUSHL   #0                      ; Room for location
	PUSHL   #RIO_K_BLN              ; Size of VM
	MOVL    SP, R2                  ; R2 <-- Addr of loc
	PUSHAL  4(R2)                   ; ARG2
	PUSHL   R2                      ; ARG1
	CALLS   #2, G^LIB$GET_VM
	BLBS    R0, 20$                 ; If okay ret code go on
	RET
20$:
	ADDL2   #8, SP                  ; Restore stack
	MOVL    4(R2), @CHAN(AP)        ; Put into arg
	MOVL    4(R2), R11              ; R11 <-- Address of CHAN
	BRB     60$
 
;+
;  Check quality of old context block.  If okay reset options.
;  If there is an uncompleted search operation the next PARSE will
;  deallocate any internal search blocks.
;-
  
40$:
	BSBW    RIO___CHKCHN_R1
	CLRB                            <RIO_B_FAB+FAB$B_FAC>(R11)
	MOVL    #FAB$M_NAM,             <RIO_B_FAB+FAB$L_FOP>(R11)
	MOVB    #FAB$C_VFC,             <RIO_B_FAB+FAB$B_RFM>(R11)
	MOVL    #RAB$M_RAH!RAB$M_WBH,   <RIO_B_RAB+RAB$L_ROP>(R11)
	RSB
 
;+
;  Initialize a new context block
;-
 
60$:
	PUSHR   #^M<R1,R2,R3,R4,R5>
	MOVC5   #0, (SP), #^X00, #RIO_K_BLN, (R11) ; Zero block
	POPR    #^M<R1,R2,R3,R4,R5>
	$FAB_STORE      -
	        FAB     = RIO_B_FAB(R11), -
	        BID     = #FAB$C_BID, -
	        BLN     = #FAB$C_BLN, -
	        FOP     = <NAM>, -
	        NAM     = RIO_B_NAM(R11)
	$NAM_STORE      -
	        NAM     = RIO_B_NAM(R11), -
	        BID     = #NAM$C_BID, -
	        BLN     = #NAM$C_BLN, -
	        ESS     = #NAM$C_MAXRSS, -
	        ESA     = RIO_B_ENM(R11), -
	        RSS     = #NAM$C_MAXRSS, -
	        RSA     = RIO_B_RNM(R11)
	$RAB_STORE -
	        BID     = #RAB$C_BID, -
	        BLN     = #RAB$C_BLN, -
	        FAB     = RIO_B_FAB(R11), -
	        RAB     = RIO_B_RAB(R11), -
	        RAC     = <SEQ>, -
	        ROP     = <RAH,WBH>
	MOVL    #WYL__NORMAL,   RIO_L_STS(R11)          ; Set success
	RSB
  
	.PAGE
	.SBTTL  RIO___CHKCHN_R1
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Co-routine entry for determining the validity of a channel
;       assignment. Sets R11 to address of VM block.
;
;--
  
RIO___CHKCHN_R1:
	MOVAW   G^LIB$SIG_TO_RET, 0(FP)
	MOVL    @CHAN(AP), R11        ; R11 <-- Chn address
	BEQL    100$
	CMPB    #FAB$C_BID, <RIO_B_FAB+FAB$B_BID>(R11)
	BNEQ    100$
	MOVL    #WYL__NORMAL,   RIO_L_STS(R11)          ; Set success
	RSB
100$:
	MOVL    #WYL__INVRIOCHN, R0             ; Signal bad channel
	RET
  
	.PAGE
	.SBTTL  RIO__SETOPT_R0
 
;++
;
;  FUNCTIONAL DESCRIPTION:
;
;       Co-routine to set FOP bits from RIO option bits.
;
;  INPUT PARAMETERS:  R0 - Option bits
;  OUTPUT PARAMETERS: None.
;
;--
   
RIO__SETOPT_R0:
	MOVL    R0, RIO_L_OPT(R11)                      ; Save options
	BBC     #RIO_V_SPL, R0, 20$                     ; Spooled?
	BISL2   #FAB$M_SPL, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Set spool bit
20$:
	BBC     #RIO_V_SCF, R0, 30$                     ; SCF?
	BISL2   #FAB$M_SCF, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Set SCF
30$:
	BBC     #RIO_V_DLT, R0, 40$                     ; Delete bit?
	BISL2   #FAB$M_DLT, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Delete!
40$:
	BBC     #RIO_V_CIF, R0, 50$                     ; CIF?
	BISL2   #FAB$M_CIF, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Set CIF
50$:
	BBC     #RIO_V_TMD, R0, 60$                     ; TMD bit?
	BISL2   #FAB$M_TMD, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Delete!
60$:
	BBC     #RIO_V_SUP, R0, 70$                     ; SUP bit?
	BICL2   #FAB$M_MXV, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Elim MXV
	BISL2   #FAB$M_SUP, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Set SUP
70$:
	BBC     #RIO_V_OFP, R0, 80$                     ; OFP ?
	BISL2   #FAB$M_OFP, <RIO_B_FAB+FAB$L_FOP>(R11)  ; Set OFP bit
80$:
	BBC     #RIO_V_EOF, R0, 90$                     ; Space to EOF
	BISL2   #RAB$M_EOF, <RIO_B_RAB+RAB$L_ROP>(R11)  ; Set EOF bit
90$:
	BBC     #RIO_V_PUT, R0, 100$                    ; Put option
	BISL2   #FAB$M_PUT, <RIO_B_FAB+FAB$B_FAC>(R11)  ; FAC = PUT
100$:
	BBC     #RIO_V_UNN, R0, 110$                    ; UNN?
	MOVB    #FAB$C_VAR, <RIO_B_FAB+FAB$B_RFM>(R11)  ; Change to var
110$:
	BBC     #RIO_V_CC , R0, 120$                    ; CC?
	MOVB    #FAB$M_FTN, <RIO_B_FAB+FAB$B_RAT>(R11)  ; Change to ftn
120$:
	RSB
	.END