ASMB,R,L,T,C,B  ** CIOC: CALL IOC **
      HED ** CIOC: FORTRAN CALLABLE IOC INTERFACE **
      NAM CIOC,6
      ENT CIOC
      EXT .ENTR,.IOC. 
      SKP 
* 
*** CIOC: CALL IOC ***
* 
UREF# OCT 0 
RCODE OCT 0 
STAT  OCT 0 
BUFAD OCT 0 
BUFL  OCT 0 
* 
CIOC  NOP 
      JSB .ENTR     GET PARAM 
      DEF UREF#          ADDRESSES
* 
*     FORM WD2 (<REQ. CODE>+<UNIT REF.#>) OF CALL TO IOC
* 
      LDA UREF#,I   GET <UNIT REF. #> 
      AND =B77      IOSOLATE BITS 0-5 
      LDB RCODE,I   GET <REQ. CODE> 
      BLF           POSTION IN
      RBL,RBL            UPPER WORD 
      IOR B         MERGE <UR#> AND <RC>
      STA WD2       PUT INO WD2 OF CALL 
* 
*     FORM WD3 OF CALL TO IOC 
* 
      AND =B030000  ISOLATE BITS 12-13
      LDB JMPC      GET JMP CMPLT INST
      SZA           TEST IF <RC> = 1,2 OR 3 
      LDB JMPR      YES: GET JMP REJ INST 
*                                   NO: USE JMP CMPLT INST
      STB WD3       PUT INTO WD3 OF CALL
* 
*     DETERMINE IF CONTROL REQUEST
* 
      CPA =B030000  TEST IF CTL REQ.(RCODE =03XX) 
      JMP SUCTL     YES: GO TO CTL SET-UP SEC.
*                                   NO: CONTINUE TO R/W SET-UP SEC. 
* 
*     SET-UP CALL FOR READ OR WRITE 
* 
SURW  LDA BUFAD 
      STA WD4 
      LDA BUFL,I
      STA WD5 
      JMP CALL
JMPR  JMP REJ 
* 
*     SET-UP CALL FOR CTL REQUEST 
* 
SUCTL LDA JMPC      GET JMP RET INSTRUCT
      STA WD4       PUT IT INTO WD4 OF CALL TO IOC
      SKP 
* 
*     CALL TO IOC 
* 
CALL  JSB .IOC. 
WD2   OCT 0         <REQ.CODE> +<UNIT REF #>
WD3   NOP           <COMPLETION RETURN>:CLEAR & STATUS REQ. 
*                                   <REJECT RETURN>:READ,WRITE,CONTROL REQ. 
WD4   DEF BUFAD,I   <BUFFER ADDR> FOR READ,WRITE REQ. 
*                                   <COMPLETION RETURN> FOR CONTROL REQUEST 
WD5   DEF BUFL,I    <BUFFER LENGTH> 
WD6   JMP REQC      <REQ INIT RET> FOR READ,WRITE REQ 
JMPC  EQU WD6 
* 
*     SET-UP FLAG FOR REJ OR CMPLT RETURN 
* 
REJ   CCE           SET E FOR REJ FLAG
      RSS 
REQC  CLE 
* 
*     PUT CONTENTS OF A AND B INTO STATUS BUFFER
* 
RET   STA STAT,I    PUT CONTENTS OF A INTO WD1 OF STATUS BUFFER 
      ISZ STAT      SET POINTER TO WD2
      STB STAT,I    PUT CONTENTS OF B INTO WD2 OF STATUS BUFFER 
      ISZ STAT      SET PNTR TO WD3 
      CLA 
      ERA           PUT E INTO A15
      STA STAT,I    PUT REJ FLG INTO WD3
* 
*     EXIT
* 
      JMP CIOC,I    EXIT
      SKP 
* 
*     VARIABLES 
* 
A     EQU 0 
B     EQU 1 
* 
*     CONSTANTS 
* 
      END 
                                                                                                                                                                                                                