         SYSTEM   SIG7FDP
         SYSTEM   BPM
*
*        WRITEVAR WRITE A VARIABLE LENGTH RECORD
*
*                 PERMITS THE USER TO WRITE VARIABLE LENGTH RECORDS INTO
*                 A KEYED OR CONSECUTIVE FILE
*                 THE RUN-TIME ROUTINE ASSUMES THAT THE FILE HAS BEEN
*                 OPENED BY THE USER, AND EXAMINES THE APPROPRIATE DCB
*                 TO DETERMINE THE ORGANIZATION AND OUTPUT FUNCTIONS
*                 IF THE FILE IS CONSECUTIVE, NO KEY IS PERMITTED
*                 IF KEYED, THE USER SUPPLIES A VALUE TO BE USED AS THE
*                 MONITOR KEY
*                 IF THE FILE IS "INPUT-OUTPUT" THE RECORD WILL BE
*                 WRITTEN WITH THE ONEWKEY OPTION TO FORCE AN UPDATE OF
*                 ANY PREVIOUSLY EXISTING RECORD
*                 THE USER MAY ALSO SPECIFY A PROCEDURE TO BE EXECUTED
*                 IF AN END-OF-TAPE ENCOUNTED WHILE WRITING A USER
*                 FORMATTED FILE
*
*      USER SYNTAX:
*        ENTER    WRITEVAR  FILE-NAME, RECORD-NAME, DATA-NAME-1
*                  |, DATA-NAME-2, DATA-NAME-3| |, PROCEDURE-NAME|
*
*                 WRITEVAR: THE ENTRY POINT IN THE RUN-TIME ROUTINE
*                FILE-NAME: THE APPROPRIATE FD NAME
*              RECORD-NAME:  THE DESIRED RECORD-NAME FROM THE FD
*              DATA-NAME-1: CONTAINS THE LENGTH OF THE RECORD TO BE
*                           WRITTEN (COMPUTATIONAL)
*              DATA-NAME-2: CONTAINS THE VALUE TO BE USED AS THE
*                           MONITOR KEY (DISPLAY)
*              DATA-NAME-3: CONTAINS THE LENGTH OF DATA-NAME-2 (COMP.)
*                           IF THE FILE IS CONSECUTIVE, NO KEY IS
*                           PERMITTED, AND DATA-NAME-2 & 3 SHOULD NOT BE
*                           SUPPLIED, OTHERWISE THEY WILL BE IGNORED.
*           PROCEDURE-NAME: TO BE EXECUTED IF AN END-OF-TAPE CONDITION
*                           IS ENCOUNTERED WHILE WRITING A USER
*                           FORMATTED FILE (ALL OTHER ERRORS OR
*                           ABNORMAL RETURNS WILL CAUSE AN ABORT)
*                           THIS PARAMETER IS OPTIONAL
*
*        AUTHER   YOW-YUAN ROBERT LIN            MAY, 1970
*
         DEF      WRITEVAR
         OPEN     INOUTMOD,ABNA,PROCNAME,SETDCBK,KEYA
         OPEN     SAVE,RETURN,NOTKEY,FPT1,FPT2,FPT3,FPT4
WRITEVAR LCI      0
         STM,0    SAVE
         STW,15   RETURN
         AWM,14   RETURN
         LI,3     X'1FFFF'
         LS,2     *15               R2 = DCB ADDR
         STS,2    FPT1
         STS,2    FPT2
         STS,2    FPT3
         STS,2    FPT4
         AND,3    4,2               R3 = ORG ABNADDR
         AI,15    1                 TO GET RECORD ADDR
         LI,4     X'7FFFF'          MASK FOR BYTE ADDR
         AND,4    *15               R4 = BYTE ADDR OF RECORD AREA
         SAS,4    -2                R4 = WORD ADDR OF RECORD AREA
         LI,5     X'1FFFF'
         AI,15    1
         AND,5    *15
         LW,5     *5                R5 = RECORD LENGTH
         LW,1     5,2
         AND,1    L(X'000000F0')
         CI,1     X'20'             TEST IF ORG = KEYED
         BNE      NOTKEY
         AI,15    1
         LI,6     X'7FFFF'
         AND,6    *15               R6 = ADDR OF KEY
         AI,15    1
         LI,8     X'1FFFF'
         AND,8    *15               R8 = ADDR OF KEY LENGTH
         LW,8     *8                R8 = KEY LENGTH
         STB,8    KEYA
         LI,7     BA(KEYA)+1        KEY DEST ADDR
         STB,8    7
         MBS,6    0
         LI,1     5
         LI,9     0
         LB,9     *2,1              GET DCB FUN
         CI,9     8                 TEST INOUT MODE FUN = 4
         BE       INOUTMOD
,FPT1    M:WRITE  0,(BUF,*4),(SIZE,*5),(ABN,ABNA),(KEY,KEYA),(NEWKEY)
         B        SETDCBK
INOUTMOD RES      0
,FPT2    M:WRITE  0,(BUF,*4),(SIZE,*5),(ABN,ABNA),(KEY,KEYA),(ONEWKEY)
         B        SETDCBK
NOTKEY   RES      0
         CI,14    4                 TEST NUMBER OF PARAM
         BG       %+3               TO SPECIFY KEY AND KEY-LEN
         AI,14    2                 UPDATE NUMBER OF PARAM
         B        %+2               TO WRITE RECORD
         AI,15    2                 SKIP KEY AND KEY-LEN.
,FPT4    M:WRITE  0,(BUF,*4),(SIZE,*5),(ABN,ABNA)
         B        SETDCBK
ABNA     LI,7     X'1C'             TEST END OF TAPE
         CB,7     10                CHECK FIRST OF R10
         BE       PROCNAME
         B        *3                R3 = ORG ABNADDR
PROCNAME AI,14    -6                HAVE PROCNAME ?
         BNEZ     SETDCBK           TO NO PROCNAME
         AI,15    1
         LI,7     X'1FFFF'
         AND,7    *15               GET PROC NAME ADDR
         STW,7    RETURN
SETDCBK  RES      0
,FPT3    M:SETDCB 0,(ABN,*3)
          LCI      0
         LM,0     SAVE
         B        *RETURN
SAVE     RES      16
RETURN   RES      1
KEYA     RES      8
         CLOSE    INOUTMOD,ABNA,PROCNAME,SETDCBK,KEYA
         CLOSE    SAVE,RETURN,NOTKEY,FPT1,FPT2,FPT3,FPT4
         END
