*DECK LFGZAP
          IDENT  LFGZAP 
          ENTRY  LFGZAP 
          SYSCOM B1 
**    LFGZAP - INTERFACE TO *Z* ARGUMENT PROCCESSOR.
* 
*     D.K. ENDO    81/12/17 
* 
*     THIS PROCEDURE CALLS THE *Z* ARGUMENT PROCESSOR FOR LFG TO READ 
*     THE DIRECTIVES OFF THE CONTROL CARD.
* 
*     LFGZAP(INFET) 
* 
*     ENTRY        INFET = INPUT DIRECTIVE FET. 
* 
*     EXIT         INFET CIO BUFFER IS FILLED WITH SOURCE LINE. 
* 
*     METHOD
* 
*     INITIATE CALL TO *Z* ARGUMENT PROCESSOR(ZAP FROM CALLCPU) 
* 
 LFGZAP   DATA   0
          SB1    1
          SX2    X1 
          RJ     ZAP
          EQ     LFGZAP 
          IF     -DEF,QUAL$,1 
          QUAL   COMCZAP
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1976.
 ZAP      SPACE  4
***       COMCZAP - *Z* ARGUMENT PROCESSOR. 
*         A. D. FORET.       77/02/08.
*         D. R. HILGREN.     79/04/15.
*         J. L. LARSON.      79/04/15.
 ZAP      SPACE  4,10 
***       ZAP - *Z* ARGUMENT PROCESSOR. 
* 
*         ENTRY  (X2) = ADDRESS OF INPUT FET TO ENTER DIRECTIVES INTO.
*                (B6) = STRING BUFFER LENGTH.  REQUIRED AND USED ONLY 
*                       WHEN VARIABLE LENGTH STRING BUFFER OPTION IS
*                       SELECTED (USBL$ DEFINED).  SEE COMCUSB. 
*                USBB = STRING BUFFER.  MUST BE USER DEFINED IF USBL$ 
*                       IS SELECTED.  SEE COMCUSB.
*                CCDR = CONTROL STATEMENT IMAGE.
* 
*         EXIT   DIRECTIVES ENTERED INTO BUFFER OF FET SPECIFIED. 
*                FET STATUS SET TO EOR READ.
*                *COMCZAP* WILL SUPPLY A TERMINATOR AT THE END OF A 
*                DIRECTIVE IF NO TERMINATOR (PERIOD OR CLOSED 
*                PARENTHESIS) HAS BEEN SUPPLIED FOR THAT DIRECTIVE
*                AND IF *ZAP$* HAS BEEN DEFINED IN THE CALLING PROGRAM. 
* 
*         USES   A - 1, 3, 6, 7.
*                B - 2, 6, 7. 
*                X - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  /COMCUSB/USB.
* 
*         MACROS RECALL, WRITES.
* 
*         NOTES  THE FIRST CHARACTER AFTER THE CONTROL STATEMENT
*                TERMINATOR IS THE SEPARATOR CHARACTER FOR ALL
*                DIRECTIVES ON THE CONTROL STATEMENT.  ANY DISPLAY
*                CODE CHARACTER NOT USED IN ANY DIRECTIVE (INCLUDING
*                SPACE) CAN BE USED AS THE SEPARATOR CHARACTER. 
 
 
 ZAP      SUBR               ENTRY/EXIT 
 
*         SET INPUT FET STATUS TO EOR READ. 
 
          BX4    X2 
          RECALL X2 
          MX3    42 
          SA1    X4          SET EOR READ STATUS IN FET 
          SX2    31B
          BX6    X3*X1
          SX3    41B         PRESET TERMINATOR INDICATOR
          BX6    X6+X2
          LX3    12 
          SA6    A1 
          SB2    CCDR        FWA CONTROL STATEMENT
          RJ     /COMCUSB/USB  UNPACK CONTROL STATEMENT 
 
*         FIND CONTROL STATEMENT TERMINATOR.
 
 ZAP1     SA1    B6          GET NEXT CHARACTER FROM CONTROL STATEMENT
          SB2    X1 
          LX7    X3,B2
          SB6    B6+B1
          GE     B6,B7,ZAPX  IF END OF CONTROL STATEMENT
          PL     X7,ZAP1     IF NOT TERMINATOR
 
*         EXTRACT ONE DIRECTIVE.
 
 ZAP2     SA3    B6+         GET SEPARATOR
          SB2    B6+1        SAVE FWA DIRECTIVE 
 .C       IF     DEF,ZAP$ 
          SX2    B1          ASSUME NO TERMINATOR FOUND 
 .C       ENDIF 
 ZAP3     SB6    B6+B1
          SA1    B6+         GET NEXT CHARACTER FROM CONTROL STATEMENT
          BX7    X3-X1       CHECK FOR SEPARATOR
          GT     B6,B7,ZAP4  IF END OF CONTROL STATEMENT
 .D       IF     DEF,ZAP$ 
          ZR     X7,ZAP3.2   IF END OF DIRECTIVE
          SX7    X1-1R. 
          ZR     X7,ZAP3.1   IF TERMINATOR
          SX7    X1-1R) 
          NZ     X7,ZAP3     IF NOT TERMINATOR
 ZAP3.1   SX2    B0+
          EQ     ZAP3        GET SEPARATOR
 
 ZAP3.2   BSS    0
 .D       ELSE
          NZ     X7,ZAP3     IF NOT END OF DIRECTIVE
 .D       ENDIF 
          EQ     B2,B6,ZAP2  IF TWO SEPARATORS IN A ROW 
 
*         ENTER DIRECTIVE INTO INPUT FET BUFFER.
 
 ZAP4     SX6    B6          SAVE SEPARATOR ADDRESS 
          SA6    ZAPA 
 .A       IF     DEF,ZAP$ 
          BX7    X1          SAVE SEPARATOR 
          SA7    ZAPB 
          ZR     X2,ZAP5     IF TERMINATOR FOUND
          SX6    1R.
          SA6    A1 
          SB6    B6+B1       INCREMENT DIRECTIVE LENGTH 
 ZAP5     BSS    0
 .A       ENDIF 
          SB7    B6-B2       SET DIRECTIVE LENGTH 
          WRITES X4,B2,B7 
 .B       IF     DEF,ZAP$ 
          SA1    ZAPA        RESTORE PROPER SEPARATOR 
          SA3    ZAPB 
          SA1    X1 
          BX6    X3 
          SA6    A1+
 .B       ENDIF 
          SA1    ZAPA        RESTORE SEPARATOR ADDRESS
          SA3    /COMCUSB/USBC  RESTORE LWA CONTROL STATEMENT 
          SX4    X2          RESET INPUT FET ADDRESS
          SB6    X1 
          SB7    X3+
          LT     B6,B7,ZAP2  IF MORE DIRECTIVES TO PROCESS
          EQ     ZAPX        RETURN 
 
 
 ZAPA     CON    0           SEPARATOR ADDRESS
 ZAPB     CON    0           SEPARATOR USED BY CALLER 
 ZAP      SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 ZAP      EQU    /COMCZAP/ZAP 
 QUAL$    ENDIF 
          ENDX
          SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCUSB
          BASE   D
*         COMMENT COPYRIGHT CONTROL DATA CORP. 1972.
 USB      SPACE  4
***       USB - UNPACK DATA BLOCK TO STRING BUFFER. 
*         D. A. HIVELEY.     72/03/01.
*         S. R. MCPHERSON.   74/09/30.
*         A. D. FORET.       74/12/04. RESEQUENCE.
 USB      SPACE  4
***       USB - UNPACK DATA BLOCK TO STRING BUFFER. 
* 
*         IF THE SYMBOL USBL$ IS DEFINED IN THE USER PROGRAM, THE 
*         VARIABLE LENGTH STRING BUFFER OPTION IS SELECTED.  THIS 
*         VARIABLE LENGTH OPTION REQUIRES THAT THE STRING BUFFER USBB,
*         OF LENGTH SPECIFIED BY B6 UPON ENTRY, ALSO BE DEFINED IN THE
*         USER PROGRAM. 
* 
*         ENTRY  (B1) - 1.
*                (B2) - FWA OF PACKED DATA. 
*                (B6) - STRING BUFFER LENGTH, REQUIRED AND USED ONLY
*                       WHEN VARIABLE LENGTH STRING BUFFER OPTION 
*                       SELECTED (USBL$ DEFINED). 
* 
*         EXIT   CHARACTER UNPACKED 1 TO A WORD, RIGHT JUSTIFIED
*                            STARTING AT (USBB). A MAXIMUM OF 
*                            80 CHARACTERS ARE ACCOMMODATED, BY 
*                            DEFAULT.  AN ADDITIONAL WORD IS PROVIDED 
*                            FOR THOSE PROGRAMS THAT GUARANTEE A
*                            TERMINATOR AT THE END OF STRING. 
*                (A1) = LWA PACKED DATA PROCESSED.
*                ((A6)) = LWA OF UNPACK BUFFER. 
*                (B2) = 0, IF MAXIMUM CHARACTERS PROCESSED. 
*                (B6) = FWA OF UNPACK BUFFER. 
*                (B7) = LWA OF UNPACKED BUFFER. 
*                (USBC) = LWA OF UNPACKED BUFFER. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 6.
*                B - 2, 6, 7. 
 
 
 USB3     SX6    B7+         ADDRESS OF LAST CHARACTER
          SA6    USBC 
          SB6    USBB        SET BEGINNING ADDRESS OF STRING
 
 USB      PS                 ENTRY/EXIT 
          SA1    B2+         CONTROL CARD BUFFER
          SB7    USBB-1      DATA BLOCK STRING BUFFER 
          MX2    -6 
          IF     DEF,USBL$
          SB2    B6+
          ELSE   1
          SB2    80 
          SB6    B0          SET CHARACTER COUNT IN WORD
 USB1     LX1    6
          SB6    B6+B1       BUMP CHARACTER COUNT THIS WORD 
          BX6    -X2*X1 
          BX1    X2*X1       CLEAR CURRENT CHARACTER FROM WORD
 USB2     SB7    B7+B1       INCREMENT STRING BUFFER ADDRESS
          SB2    B2-B1       DECREMENT CHARACTER COUNT
          SA6    B7+         STORE CURRENT CHARACTER IN STRING BUFFER 
          ZR     B2,USB3     IF MAXIMUM CHARACTERS PROCESSED
          NZ     X1,USB1     IF MORE CHARACTERS THIS WORD 
          SX6    B6-9        CHECK CHARACTERS PROCESSED THIS WORD 
          NG     X6,USB3     IF END OF LINE 
          SB6    B0          RESET CHARACTER COUNT WITHIN WORD
          SA1    A1+B1       GET NEXT WORD
          ZR     X1,USB3     IF END OF LINE 
          NZ     X6,USB1     IF LAST WORD COMPLETELY PROCESSED
          EQ     USB2        PROCESS *00* TERMINATING PREVIOUS WORD 
          SPACE  4
          IF     -DEF,USBL$,2 
          IF     -DEF,USBB,1
 USBB     BSS    81          STRING BUFFER
          IF     -DEF,USBC,1
 USBC     BSS    1
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 USB      EQU    /COMCUSB/USB 
          IF     -DEF,USBL$,2 
          IF     -DEF,USBB,1
 USBB     EQU    /COMCUSB/USBB
          IF     -DEF,USBC,1
 USBC     EQU    /COMCUSB/USBC
 QUAL$    ENDIF 
          BASE   *
          ENDX
          END