*DECK C$WAIO
          IDENT  C$WAIO 
          TITLE  C$WAIO - WORD ADDRESS INPUT-OUTPUT PROCESSOR 
          COMMENT  WORD ADDRESS INPUT-OUTPUT PROCESSOR
          SST 
          B1=1
* 
**        CBWAIO - WORD ADDRESS INPUT-OUTPUT PROCESSOR
* 
*         INPUT 
*                SA0  FIT 
*                SX1  KEY (WORD ADDRESS NUMBER) 
*                SX3  RECORD LENGTH 
*                SB6  RETURN
*                EQ   FUNCTION
* 
*         FUNCTIONS ARE 
* 
*                C.CLOWA - CLOSE
*                C.OPXWA - OPEN - X1 AND X3 NOT INPUT 
*                C.RDNWA - READ NEXT
*                C.RDRWA - READ 
*                C.WRIWA - WRITE NEXT (SEQUENTIAL)
*                C.WRRWA - WRITE
* 
*                ON RDN AND WRI THE NEW WORD ADDRESS IS RETURNED IN X1
* 
*CALL IOMICROS
*CALL IODEFSC 
  
          EJECT 
          ENTRY  C.OPWA 
 C.OPWA   BSS    0           OPEN 
          RJ     =XC.SFEQ    SET FILE EQUIVALENCE AND SAVE PTRS 
          STORE  A0,BFS=66   SET BUFFER SIZE
          STORE  A0,WA=1     RESET WA TO INITIAL VALUE
          STORE  A0,WALA=1   SET LWA + 1
          SB3    #R#         REWIND 
          SA5    B6-B1       GET LINE NUMBER
          SB6    OPNRTN      RETURN FROM OPEN 
          BX7    X5 
          SA7    OPNRTN-1    SAVE FOR POSSIBLE DIAGS
          JP     B5          GO TO PROPER OPEN ROUTINE
          SPACE  2
          DATA   0           LINE NUMBER SAVED HERE 
 OPNRTN   BSS    0           RETURN FROM OPEN PROCESS 
          FETCH  A0,PD,X5    GET ORIGINAL OPEN MODE 
          SX5    X5-#OUTPUT#
          ZR     X5,=XC.NORRT  EXIT IF OUTPUT 
          FETCH  A0,EOIWA,X5  GET ADDR OF LAST WORD + 1 
          STORE  A0,WALA=X5,4      SET IN LAST WORD + 1 
          SX4    B1 
          FETCH  A0,RT,X6,3  GET RECORD TYPE
          SX6    X6-#WT#
          NZ     X6,OPNNTW   JP IF NOT W TYPE RECORDS 
          SX4    X4+B1       FOR W RECORDS BACK UP 2
 OPNNTW   BSS    0
          IX5    X5-X4       POINTS TO LAST WORD ON FILE
          GET    A0,HDRAREA,10,EMPTY,X5  READ HEADER
          MX0    30 
          SA1    HDRSKEL
          SA2    HDRAREA
          BX3    X0*X2       MASK OFF HEADER IDENTIFIER 
          IX4    X3-X1
          NZ     X4,NOTCBWA  JUMP IF NOT A COBOL WA FILE
          STORE  A0,WALA=X2  STORE REAL LWA + 1 
 NOTCBWA  BSS    0
          STORE  A0,WA=1     RESET WA TO FIRST WORD 
          EQ     =XC.NORRT   RETURN 
 C.CLOWA  SPACE  4
          ENTRY  C.CLOWA
 C.CLOWA  BSS    0           CLOSE
          RJ     =XC.SVRTN   SAVE RETURN
          FETCH  A0,PD,X5    GET OPEN MODE
          SX5    X5-#INPUT# 
          ZR     X5,CLINP    JUMP IF AN INPUT FILE - NO LABEL 
          SA1    HDRSKEL
          FETCH  A0,WALA,X3  GET LWA + 1
          IX6    X3+X1       MAKE A HEADER
          SA6    HDRAREA
          FETCH  A0,EOIWA,X5  GET ADDR OF LAST WORD + 1 
          IX4    X5-X3       EOIWA - MY EOI 
          PL     X4,FLUSHED  JUMP IF SAME OR BIGGER (EOIWA) 
*      BUFFER IS NOT FLUSHED - DO A READ TO FLUSH IT
          CLOSEM A0,R,FILE   CLOSE THE FILE 
          STORE  A0,PD=IO    CHANGE TO I-O FOR RE-OPEN
          OPENM  A0          OPEN IT AGAIN - IT IS NOW FLUSHED
          FETCH  A0,WALA,X3 
          FETCH  A0,EOIWA,X5  GET ADDR OF LAST WORD + 1 
 FLUSHED  BSS    0
          SX4    B1 
          FETCH  A0,RT,X6,2  GET RECORD TYPE
          SX6    X6-#WT#
          NZ     X6,CLONWT   JP IF NOT W TYPE RECORDS 
          SX4    X4+B1       BACK UP 2 FOR W TYPE RECORDS 
 CLONWT   BSS    0
          SX6    X4 
          SA6    =SSVDEC     SAVE DEC AMOUNT
          IX5    X5-X4       POINT TO LAST AVAILABLE WORD ON FILE 
          IX4    X5-X3       LAST - LAST ONE I WROTE
          PL     X4,ISROOM1  JUMP IF ROOM FOR HEADER
          PUT    A0,HDRAREA,10,ERREX,X3  WRITE DUMMY TO ALLOC SPACE 
          CLOSEM A0,R,FILE   CLOSE TO FLUSH BUFFER
          STORE  A0,PD=IO    CHANGE TO I-O FOR RE-OPEN
          OPENM  A0          RE-OPEN
          FETCH  A0,EOIWA,X5  GET ADDR OF LAST WORD + 1 
          SA4    SVDEC       GET DECREMENT AMOUNT 
          IX5    X5-X4       BACK TO ALLOWED PLACE
 ISROOM1  BSS    0
          PUT    A0,HDRAREA,10,ERREX,X5  WRITE THE HEADER AT EOF
 CLINP    BSS    0
          RJ     =XC.GETRT   GET THE RETURN FOR CLOSE TO USE
          SB3    #R#         REWIND 
          EQ     =XC.CLOSE   GO CLOSE IT
  
 HDRSKEL  DATA   61003257610000000000B   HEADER SKELETON
 HDRAREA  DATA   0           HEADER READ INTO HERE
          TITLE  READS
          EJECT 
**        C.RDNWA - READ NEXT RECORD
* 
          ENTRY  C.RDNWA
 C.RDNWA  BSS    0           READ NEXT
          MX6    0
          EQ     RDCOMM 
          SPACE  3
* 
**        C.RDRWA - READ RANDOM 
* 
          ENTRY  C.RDRWA
 C.RDRWA  BSS    0
          STORE  A0,WA=X1    SET WORD ADDRESS FROM INPUT PARAMETER
          MX6    1
 RDCOMM   BSS    0
          SA6    =SINVKFLG   SET INVAID KEY FLAG
          RJ     INITIO      INITIALIZE 
          FETCH  A0,WA,X4    GET ADDRESS TO BE READ 
          FETCH  A0,WALA,X5  GET ADDR OF LAST STUFF 
          IX5    X4-X5       WA - (LWA + 1) 
          PL     X5,IKAE     JUMP IF PAST END 
          FETCH  A0,MRL,X3   GET MAX REC LENGTH 
          GET    A0,X2,X3    READ A RECORD
          EQ     WAIOEX      EXIT 
          TITLE  WRITES 
          EJECT 
* 
**        C.WRIWA - WRITE SEQUENTIAL
* 
          ENTRY  C.WRIWA
 C.WRIWA  BSS    0
          EQ     WRCOMM 
          SPACE  2
* 
**        C.WRRWA - WRITE RANDOM
* 
*         WORD ADDRESS IS IN X1 
* 
          ENTRY  C.WRRWA
 C.WRRWA  BSS    0
          STORE  A0,WA=X1    SET WORD ADDRESS FROM INPUT PARAMETER
 WRCOMM   BSS    0
          RJ     INITIO      INITIALIZE 
          MX6    1
          SA6    INVKFLG     SET INV KEY FLAG 
          PUT    A0,X2,X3    WRITE A RECORD 
          FETCH  A0,WA,X1    GET NEXT AVAIL WORD
          FETCH  A0,WALA,X5  GET LWA + 1
          IX4    X5-X1
          PL     X4,NONEW    JUMP IF NOT HIGHER THAN END
          STORE  A0,WALA=X1 
 NONEW    BSS    0
 WAIOEX   BSS    0           COMMON EXIT
          SB6    EX2         SET RETURN TO LOCAL PLACE
          RJ     =XC.SVRTN   PUT PHONY RETURN IN STACK
          EQ     =XC.NORRT   DO NORMAL RETURN PROCESS - RTNS TO DUMMY 
 EX2      BSS    0           RETURNS HERE 
          RJ     =XC.GETRT   GET THE REGULAR RETURN 
          FETCH  A0,WA,X1    GET UPDATED WORD ADDRESS TO RETURN 
          JP     B6          TAKE THE NORMAL RETURN 
          SPACE  2
 INITIO   DATA   0
          STORE  A0,EX=ERREX
          RJ     =XC.SVRTN   SAVE RETURN
          STORE  A0,DX=DATAEX 
          FETCH  A0,RECA,X2  GET ADDR OF RECORD AREA
          EQ     INITIO 
          SPACE  2
 ERREX    DATA   0           COMES HERE ON ERRORS 
          RJ     =XC.EX      TAKE ERROR EXIT
          SPACE  2
 DATAEX   DATA   0           COMES HERE ON EOF
 IKAE     BSS    0           HERE FOR INV KEY OR AT END TEST
          SA1    INVKFLG
          ZR     X1,=XC.ATEND  AT END CASE
          SX1    2R23        INDICATE NO RECORD FOUND 
          EQ     =XC.INVKY   INVALID KEY EXIT 
          SPACE  2
 EMPTY    DATA   0           HERE IF NOTHING IN FILE
          EQ     EMPTY       TEMPORARILY IGNORE IT
          END 
