*COMDECK  BEGIN 
          TITLE  BEGIN
**        BEGIN, VERB PROCESSOR - DATA WORDS
* 
  
 BGCSW    BSS    1           CONTROL STATEMENTS WRITTEN TO PROC.
 BGCPH    BSS    1           COUNT OF PROCEDURE HEADER CARDS
 BGELSE   BSS    1           1 = .ELSE IN PROC BODY 
 BGEOF    BSS    1           1 = EOF WRITTEN LAST ON DATA FILE
 BGEQMD   BSS    1           EQUIVALENCE MODE, 1=EQUIV. MODE
 BGDATA   BSS    1           BOOLEAN, 1= DATA FILE BEING WRITTEN
 BGHDR    BSS    1           BEGIN SAVES SCATBF1 POSITION 
 BGNAME   BSS    1           BEGIN COMMENT PARAMETER NAME 
 BGNAML   BSS    1           BEGIN COMMENT PARAMETER NAME LENGTH
 BGPHNL   BSS    1           1 = PROCEDURE HELP NOLIST
 BGSFPH   BSS    1           1 = SLASH FOUND ON PROC HEADER 
 BGPFSD   BSS    1           POSITION, FIRST SECOND DEFAULT 
 BGLABL   BSS    1           LABEL FROM .IF .IFE
 BGPRMT   BSS    1           1 = APPEND 0013 BYTE TO PROMPT 
 BGLFNC   BSS    1           LOCAL FILE NAME CALL FLAG
 BGLIBSR  BSS    1           =1 --> SEARCH LIBRARY FOR PROCEDURE
 BGTMP1   BSS    1
 BGTMP2   BSS    1
 BGTMP3   BSS    1
 BGSKIP   BSS    1                 1 = SKIP LINES IN PROC BODY
  
  
  
*         BGATP-  APPEND TO PROCEDURE 
*         THESE DATA DECLARATIONS MUST BE EITHER 8,18,28 ETC. CHARACTERS
*         THIS IS SO THAT THE ONLY ZERO CHARACTERS WILL BE THE ZERO BYTE
*         THE CHARACTERS   *CCL* AFTER EACH TERMINATOR IDENTIFIES 
*         THE LINE AS ONE ADDED BY CCL. 
  
 BGATPCL  BSS    1           CURRENT LOCATION PROCESSING BGATP
 OSNOS    IFEQ   HOST,NOS                                                CL0104 
 BGATP    DATA   18L$REVERT.CCL                                          CL0104 
 BGATPX   DATA   18L$EXIT.CCL 
          DATA   18L$REVERT,ABORT.CCL                                    CL0104 
 OSNOS    ELSE                                                           CL0104 
 BGATP    DATA   18LREVERT.CCL
          DATA   18LEXIT,S.CCL
          DATA   18LREVERT,ABORT.CCL
 BGATPX   DATA   8LEXIT.CCL 
          DATA   18LREVERT,ABORT.CCL
 OSNOS    ENDIF                                                          CL0104 
 BGATPL   EQU    *-BGATP      LENGTH OF ATP TABLE 
  
  
  
*         SPECIAL PROCEDURE COMMANDS
  
 BGCPROC  DATA   L$.PROC,$
  
          SPACE  4,20 
  
**        BEGIN  -  BEGIN NEW PROCEDURE 
* 
*         PROCESS THE BEGIN CARD USING THE SCATTER BUFFER.
*         ADVANCE THROUGH THE STATEMENT FAR ENOUGH TO IDENTIFY
*         THE PROCEDURE.  THEN FIND THE PROCEDURE AND READ THE
*         PROCEDURE HEADER INTO THE SCATTER BUFFER SCATBF2. 
*         CRACK THE HEADER AND SET UP THE TABLES PPT AND FPS
*         WITH ENTRIES FOR THE FORMAL PARAMETERS.  THEN 
*         CONTINUE CRACKING THE BEGIN STATEMENT (STILL IN SCATBF1)
*         AND PROCESS ANY FORMAL PARAMETER SPECIFICATIONS.
* 
 BEG01    BSS                ENTRY FROM VERBS 
          SX7    1
          SA7    BGIN        INDICATE BEGIN PROCESSING
 OSNOS    IFEQ   HOST,NOS 
          SA1    SNVPNL      NESTING LEVEL
          ZR     X1,BEG01.5  NO C.S.F. CHECK REQUIRED AT JOB LEVEL
  
*         CHECK WHAT THE CURRENT CONTROL STATEMENT FILE NAME IS 
*         IF THIS IS THE ORIGINAL JOB FILE THE PNL VALUE IS INCORRECT 
*         RESET THE PNL TO ZERO- CONTINUE AS IF THIS IS AN INITIAL CALL 
  
          SA5    =0L"M.FNOCS" 
          RJ     =XIOFIL     DETERMINE IF FILE EXISTS 
  
          NZ     X5,BEG01.5  INITIAL C.S.F. NOT EXECUTING 
  
          SA5    =0L"M.FNPS1" 
          RJ     =XIOFIL
          NZ     X5,BEG01.5  FILE DOES EXIST
  
          SA5    =0L"M.FNPS2" 
          RJ     =XIOFIL
          NZ     X5,BEG01.5  FILE DOES EXIST
  
*         RESET THE PROCEDURE NESTING LEVEL SO INITIAL CALLS ARE MADE 
  
          MX6    0
          SA6    SNVPNL      STORE NESTING LEVEL
  
 BEG01.5  BSS 
 OSNOS    ENDIF 
          RJ     SDD         CALL SDD BEFORE PNL INCREMENT
  
          SX1    1           INDICATE BEGIN 
          RJ     ZFS         CALL ZFS BEFORE PNL INCREMENT
  
          SA2    SNVPNL 
          SX5    V.PNLMX    MAXIMUM LEVEL OF PROCEDURE CALLS
          SX6    X2+B1       INCREMENT PNL
          IX7    X2-X5
          SX3    MSG200      $MAXIMUM NESTING LEVEL EXCEEDED$ 
          SA6    SNVPNL 
          PL     X7,BRWERR   IF LIMIT EXCEEDED
  
 OSSC2    IFEQ   HOST,SC2 
          OPENM  FILEPS,I-O,N   OPEN PROCEDURE STACK FILE 
 OSSC2    ENDIF 
  
          SA5    SNVPNL 
          SB2    X5-1        DECREMENT, PNL ALREADY INCREMENTED.
          EQ     B0,B2,BEG02  IF FIRST LEVEL CALL 
  
          SX2    FILEPS 
          RJ     =XIOREW     REWIND 
  
          SX2    FILEPS 
          RJ     =XIOSKP     SKIP FORWARD TO POSITION FILE
  
 BEG02    BSS 
          MX7    0
          MX6    0
          SA7    BGHMD
          SA6    BGERR
          SA7    BGPHNL 
          SA6    BGEOF
          SA7    BGPFSD 
          SA6    BGCPH
          SA7    BGEQMD 
          SA6    BGDATA 
          SA7    FILENAM
          SA6    BGLIBSR
          SA7    PROCNAM
          SA6    BGPNAM 
          SA7    BGPNML 
          SA6    BGLFNC      LOCAL FILE NAME CALL FLAG
          SA7    BGPRMT 
          SA6    BGSKIP 
          SA7    BGELSE 
          SA6    BGPHRN 
          SA7    BGNAML 
          SA6    BGNAME 
          SA7    BGLABL 
          SA6    SCATX
 SDOVL    IFNE   IP.SDO,0 
          SA7    CLOSTAT           CLOSE STATUS FOR PANELS
          SA6    SDNCOF 
          SA7    SDLS 
 SDOVL    ENDIF 
 OSSC2    IFNE   HOST,SC2 
          SA6    SDTACN 
 OSSC2    ENDIF 
          SA7    IACEXP 
          SA6    IACSUB 
          SA7    IACDSF 
          SA6    IACICF 
          SA7    IACERR 
          SA6    IACIMP 
          SA7    IACIDP 
          SA6    IACIPF 
          SA7    IACLPE 
          SA6    IACNPV 
          SA7    IACPRE 
          SA6    IACPVID
          SA7    IACNOTE
  
 SDOVL    IFNE   IP.SDO,0 
          MX7    1
          SA7    SDNCLE      SET LENGTH OF .NOCLR TO NEGATIVE 
 SDOVL    ENDIF 
  
*         SET DEFAULT INHIBIT AND CONCATENATION CHARACTERS. 
  
          SX7    60B         INHIBIT CHARACTER DEFAULT
          SX6    65B         CONCATENATION CHARACTER DEFAULT
          SA7    INHIBIT
          SA6    CCATENAT 
          SPACE  2,12 
*         THE PROCESSING OF THE PROCEDURE NAME AND THE FILE 
*         NAME ON WHICH THE PROCEDURE RESIDES HAS THESE OPTIONS.
* 
*         PNAME,,,...  THE PROCEDURE PNAME IS ASSUMED TO BE ON THE
*                            FILE PNAME (IF IT EXISTS) OTHERWISE THE
*                            LIBRARY IS SEARCHED FOR PROCEDURE PNAME
* 
*         BEGIN,,,...        NEXT PROCEDURE FROM DEFAULT FILE 
* 
*         BEGIN,PNAME,,...   PROCEDURE PNAME FROM DEFAULT FILE
* 
*         BEGIN,PNAME,PFILE,... PROCEDURE PNAME FROM FILE PFILE 
*                            IF PFILE IS NULL THEN PFILE=DEFAULT
*                            IF PFILE DOES NOT EXIST, ATTACH P.F. PFILE 
* 
*         BEGIN,,PFILE,...   NEXT PROCEDURE FROM FILE PFILE 
  
          SA2    ANSVRB 
          SA4    =0LBEGIN 
          SA5    ANSSEP 
          BX0    X2-X4
          ZR     X0,BEG03    VERB = BEGIN 
  
*         VERB = PNAME
  
          SX7    1
          SA7    BGLIBSR     SEARCH LIBRARY FOR PROC. 
          BX6    X2 
          SA6    PROCNAM     PNAME = PROCNAM
          SA4    ANSCHR 
          JP     BEG08.5     GO STORE FILENAM 
  
*         VERB = BEGIN
  
 BEG03    BSS 
 OSNOS    IFEQ   HOST,NOS 
          MX7    0
          SA7    PREFIX      NOT NAME CALL - CLEAR $ PREFIX 
 OSNOS    ENDIF 
          SX0    X5-1R. 
          SX6    X5-1R) 
          SX7    X5-1R, 
          MX2    0           FILENAM
          MX4    0           LENGTH OF NAME 
          ZR     X0,BEG04    TERMINATOR . 
          ZR     X6,BEG04    TERMINATOR ) 
          NZ     X7,BRWERR2  ERROR, COMMA MUST FOLLOW VERB
  
*         CASE = BEGIN, 
  
          RJ     =XCCLGNP    GET PROC NAME
          NZ     X5,BRWERR1  ABORT IF ERROR 
  
          SA2    ANSSTR      POSSIBLE PROC NAME 
          SA5    ANSSEP 
          SA4    =0LBEGIN 
          BX4    X4-X2
          SX3    MSG207      $PROCEDURE NAMED BEGIN IS INVALID$ 
          ZR     X4,BRWERR   PUT OUT ERROR MESSAGE
  
  
          SA4    ANSCHR 
          SX3    MSG201      $PNAME MORE THAN SEVEN CHARACTERS$ 
          BX6    X2 
          SX7    X4-V.PRNL-1
          SA6    PROCNAM
          PL     X7,BRWERR   IF PNAME TOO LONG
  
          MX2    0           FILE NAME
          MX4    0           LENGTH 
          SX6    X5-1R) 
          SX0    X5-1R, 
          SX7    X5-1R. 
          ZR     X7,BEG04    TERMINATOR --> BEGIN,. 
          ZR     X6,BEG04    TERMINATOR --> BEGIN,) 
          SX7    X5-1R? 
          ZR     X7,BEG04    TERMINATOR --> BEGIN,? 
  
          NZ     X0,BRWERR2  INVALID SEPARATOR
  
*         CASE = BEGIN,, OR BEGIN,PNAME,
  
          RJ     =XCCLGNP    GET FILE NAME
          NZ     X5,BRWERR1  ABORT IF ERROR 
  
          SA2    ANSSTR 
          SA4    ANSCHR 
  
*         X2 = FILE NAME OR FIRST TEN CHARACTERS
*         X4 = LENGTH OF FILE NAME
  
 BEG04    BSS 
          BX6    X2 
          BX7    X4 
          SA6    FILENAM
          SA7    FILENML
          SB7    -4 
          SB4    X4 
 OSNOS    IFEQ   HOST,NOS 
          SX7    X4-V.PRNL-1
          SX3    MSG203      $FILE NAME NOT SPECIFIED / INVALID$
          PL     X7,BRWERR   FILENAME TOO LONG
  
 OSNOS    ENDIF 
          NZ     X4,BEG05    IF FILE SPECIFIED
  
 DPF      IFEQ   IP.DPF,0    ERR EXIT IF NO DEFAULT 
          JP     BRWERR 
  
 DPF      ELSE               USE DEFAULT NAME IF PROVIDED 
          SA2    =0L"IP.DPFN" 
          SX4    MCTDPF 
          SB4    MCTDPF      NUMBER OF CHARACTERS 
 DPF      ENDIF 
  
  
 BEG05    BSS 
          SB6    40 
          LT     B6,B4,BRWERR   40 IS MAXIMUM P.F. NAME 
  
  
 ATT      IFNE   IP.ATT,0    MOVE FILE NAME TO FDB IF ATTACH
 BEG06    BSS 
          BX7    X2 
          SA2    A2+B1
          SA7    FDB+B7 
          SB4    B4-10
          SB7    B7+B1
          LT     B0,B4,BEG06  IF MORE WORDS IN NAME 
  
*         ZERO REMAINING WORDS IN PFN 
  
          GE     B7,B0,BEG08  IF MORE WORDS TO BE MOVED 
          MX7    0
 BEG07    BSS 
          SA7    A7+B1
          SB7    B7+B1
          LT     B7,B0,BEG07  IF MORE WORDS TO ZERO 
 BEG08    BSS 
          SA2    FDB-4       FIRST WORD OF NAME 
          SA5    FDB
          MX7    42 
          BX6    X2*X7
          BX7    -X7*X5 
          BX7    X6+X7       CREATE LOCAL FILE NAME 
 OSNOS    IFEQ   HOST,NOS 
          SX0    B1 
          BX7    X0+X7       SET COMPLETE BIT 
 OSNOS    ENDIF 
          SA7    FDB         RESET LFN FOR ATTACH MACRO 
 ATT      ENDIF 
  
  
*                X2  = FILE NAME OR FIRST TEN CHARACTERS
*                X4  = LENGTH OF FILE NAME
  
 BEG08.5  BSS 
          SA1    ANSHBA      GET HEADER PREVIOUS TO ASSEMBLY
          BX6    X1 
          SA6    BGHDR       SAVE HEADER POSITION 
          MX7    42 
          SB7    7
          BX6    X2*X7       FIRST SEVEN CHARACTERS OF NAME 
          SX7    B7 
          SA6    FILENAM
          SA6    SNFNAM      FILE SPECIAL NAME
          SB4    X4 
          GT     B4,B7,BEG09
          SX7    B4 
 BEG09    BSS 
          SA7    FILENML
          SA7    SNFNML      FILE SPECIAL NAME LENGTH 
          BX5    X6 
          SX2    FILEPC 
          RJ     =XIOFET     RESET FET FIELDS 
  
          RJ     BFP         BEGIN, FIND PROCEDURE
  
          MX7    -0          MAKE ASTERISK NOT A SEPARATOR
          SA7    ANSMDE 
  
          RJ     BCM         BEGIN CRACK MENU HEADER
  
          RJ     BIP         BEGIN INTERACTIVE PROCESSING 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    RSTRICT
          NZ     X1,BEG09.1  IF RESTRICTED PARAMETER(S) 
  
          RJ     DCI         DISPLAY COMMAND IMAGE
  
 BEG09.1  BSS    0
 OSNOSBE  ENDIF 
  
          RJ     BRH         BEGIN READ HELP
  
          RJ     BCH         BEGIN, CRACK HEADER
  
  
*         SINCE THE PROCEDURE HEADER HAS BEEN CRACKED, THE ANS DATA 
*         DESCRIBES THE PROCEDURE HEADER INSTEAD OF THE PROCEDURE CALL
*         STATEMENT WHICH IS STILL IN SCATBF1.  THE ANS DATA
*         FOR THE CALL STATEMENT NEEDS TO BE RESTORED.
  
          SA2    SCATBF1
          SA1    BGHDR       PREVIOUS HEADER POSITION 
          BX2    X1 
          RJ     =XSTRANS    RESTORE ANS DATA 
  
  
  
          RJ     BPM         BEGIN PROCESSING MENU
  
          RJ     BIV         BEGIN VALIDATION OF INTERACTIVE CALL 
  
          RJ     BPP         BEGIN, PROCESS PARAMETERS FROM BEGIN STA.
  
          SX7    0           MAKE ASTERISK A SEPARATOR AGAIN
          SA7    ANSMDE 
          SA7    IACERR      CLEAR OUT ERROR INDICATOR
  
          RJ     BCB         COPY BODY OF PROCEDURE 
  
*         CLOSE THE FILE FROM WHICH THE PROCEDURE WAS READ. 
  
 OSSC2    IFEQ   HOST,SC2 
          CLOSEM FILEPC,N,FILE
 OSSC2    ENDIF 
  
  
*         APPEND THE TRAILING CARDS TO THE PROCEDURE
  
          MX7    0
          MX5    0           START AT BEGINNING OF BGATP
          SA7    BGATPCL
 BEG10    BSS 
          SA1    BGATP+X5    LOCATION OF NEXT CARD
          SB2    V.CCC       LENGTH OF CONTROL STATEMENT
          RJ     =XSTRFZB 
  
*                B3  = NUMBER OF WORDS
  
          SA5    BGATPCL
          SA2    SCATBF2
          SX7    X5+B3       OFFSET TO NEXT CARD
          SA7    A5          BGATP-1   SAVE CURRENT 
          SX4    B2          NUMBER OF CHARACTERS TO WRITE
          SX3    A1          ADDRESS OF LINE TO WRITE 
          SX2    FILEPS 
          RJ     =XIOWTL     WRITE
  
          SA5    BGATPCL     CURRENT LOCATION PROCESSING BGATP
          SX0    X5-BGATPL
          NG     X0,BEG10    IF MORE CARDS TO WRITE 
  
*         WRITE EOR ON PROCEDURE FILE 
  
          SX2    FILEPS 
          RJ     =XIOEOR
  
*         THE FILE COULD BE CLOSED AND THEN REOPENED TO 
*         RELEASE ANY UNUSED M.S. SPACE.  HOWEVER ASSUMING
*         THE NORMAL NESTING OF PROCEDURE CALLS WILL ONLY 
*         BE A LOW NUMBER (LIKE FOUR) IT IS NOT WORTH IT. 
  
  
          SX2    FILEPS 
 OSNOSBE  IFNE   HOST,SC2 
          SB2    -1          BACKSPACE TO BEGINNING OF RECORD 
 OSNOSBE  ELSE
          SB2    -2          BACKSPACE TO BEGINNING OF SECTION
 OSNOSBE  ENDIF 
  
          RJ     =XIOSKP
  
 NOSBE    IFEQ   HOST,NOSBE 
          SA5    ZSYSLIB
          ZR     X5,BEG14    IF ZZZZZ03 OR ZZZZZ04 NOT TO BE RETURNED 
  
          RJ     =XIORTN     RETURN EITHER ZZZZZ03 OR ZZZZZ04 (X5=NAME) 
  
 BEG14    BSS 
 NOSBE    ENDIF 
  
  
  
  
*         ALL DATA FROM THE SECTION OF THE PROCEDURE FILE HAS 
*         BEEN READ.  CLOSE THE PROC. STACK FILE AND THE
*         LAST DATA FILE IF A DATA FILE WAS WRITTEN 
  
          RJ     CDF         CLOSE .DATA FILE IF ONE IS OPEN
  
          SA1    IACEX       CHECK FOR .EX. PENDING 
          NZ     X1,EXIT     RETURN FILES - EXECUTE .EX. COMMAND
  
          SA5    FILECS 
  
*         ACCESS C.S.F. 
  
          RJ     =XIOCSA      CONTROL STATEMENTS, ACCESS
  
 OSNOS    IFEQ   HOST,NOS 
          SA5    FILECS 
          RJ     IOFIL       SET IF CONTROL STATEMENT FILE EXISTS 
  
          ZR     X5,BEG11.5  NO CSF EXISTS
  
          SETFS  FILEIO,NDST SET *NO AUTO DROP* STATUS
  
 BEG11.5  BSS 
          SETFS  FILEPS,NDST SET *NO AUTO DROP* STATUS
          SETFS  FILEDS,NDST SET *NO AUTO DROP* STATUS
  
 OSNOS    ENDIF 
  
          SA2    FILEIO      GET FILE NAME OF OLD C.S.F.(SCOPE2)
          SA3    CSFPOS 
          MX0    N.BRPFN
          SX7    L.BR 
          BX2    X0*X2
          BX7    X2+X7
          BX6    X3 
          SA7    BRDATA+W.BRPFN 
          ERRNZ  W.BRPFN-W.BRLGTH 
  
 OSNOS    IFEQ   HOST,NOS 
          SA4    FILEIO+6    WORD WITH STATEMENT COUNT
          EX7    X4,CSFASC
          LX7    S.CSFESC-N.CSFESC+1
          MX0    N.CSFESC 
          ERRNZ  N.CSFESC-N.CSFASC
          ERRNZ  S.CSFESC-59
          ERRNZ  W.BRPFP-W.BRFSC
          BX0    -X0*X6      CLEAR STATEMENT COUNT FIELD
          BX6    X0+X7       ADD POSITION TO STATEMENT COUNT WORD 
 OSNOS    ENDIF 
  
          SA6    BRDATA+W.BRPFP   SAVE POSITION OF C.S.F. 
  
*         ENTER NEW C.S.F.
  
          SX2    FILEPS 
          RJ     =XIOPOS     GET POSITION 
  
          SX2    FILEPS 
          RJ     =XIOCSE      CONTROL STATEMENTS, ENTER 
  
  
*         BUILD CCL DATA RECORD FOR THE SUBSEQUENT REVERT 
*         MOVE  R1,R2,R3,EF,PNL AND DSC TO BRDATA 
*         NOTE THAT THE BRDATA RECORD MUST BE READ IN AS 80 CHARACTERS
*         OR LESS IF THE IORDL SUBROUTINE IS USED BECAUSE IT WILL 
*         TRUNCATE TO 80 CHARACTERS.
*         NOTE ALSO THAT THE READ IN REVERT WILL READ ONE LINE. 
*         ON SCOPE 2 THE READ WILL READ THE RECORD WRITTEN, HOWEVER 
*         ON THE OTHER SYSTEM THE READ WILL TERMINATE ON A ZERO BYTE. 
*         THUS BEGIN MUST ENSURE THERE IS NO ZERO BYTE IN THE BRDATA. 
*         DO SO BY STORING DATA IN THE UPPER 18 BITS AND BLANK THE
*         REST OF THE WORD (FOR R1,R2,R3,EF,DSC,PNL). 
  
  
          SA1    BLANKS 
          SA5    SNVR1
          SB7    B0 
          MX0    N.BRSR1
          BX1    -X0*X1 
          SB6    3
 BEG12    BSS 
          LX5    S.BRSR1+1-N.BRSR1
          BX6    X0*X5       SAVE 18 BITS 
          SA5    A5+B1       GET NEXT REGISTER
          BX6    X1+X6       ADD BLANKS 
          SA6    BRDATA+W.BRSR1+B7
          SB7    B7+B1
          LT     B7,B6,BEG12 IF ALL THREE NOT TRANSFERRED 
  
          ERRNZ  N.BRSR1-N.BRSEF
          SA5    SNVEF
          SA3    SNVDSC 
          SA4    SNVPNL 
          LX5    S.BRSEF+1-N.BRSEF
          LX3    S.BRDSC+1-N.BRDSC
          BX6    X0*X5       EF 
          BX7    X0*X3       DSC
          BX6    X1+X6       ADD BLANKS 
          BX7    X1+X7       ADD BLANKS 
          SA6    BRDATA+W.BRSEF 
          SA7    BRDATA+W.BRDSC 
          LX4    S.BRPNL+1-N.BRPNL
          BX6    X0*X4       PNL
          BX6    X1+X6       ADD BLANKS 
          SA6    BRDATA+W.BRPNL 
 OSSC2    IFEQ   HOST,SC2 
          SETFIT FILEDS 
 OSSC2    ENDIF 
  
          SX2    FILEDS 
          RJ     =XIOREW     REWIND FILEDS
  
*         IF THIS IS A FIRST LEVEL PROCEDURE CALL THAN THE
*         SKIP FORWARD IS A NULL OPERATION
  
          SA1    SNVPNL 
          SB2    X1-1        SUBTRACT ONE BECAUSE IT WAS INCREMENTED
          SX2    FILEDS 
          EQ     B0,B2,BEG13 IF FIRST LEVEL CALL
  
          RJ     =XIOSKP     SKIP TO EOS
  
  
  
*         WRITE DATA RECORD 
  
 BEG13    BSS 
 OSNOS    IFEQ   HOST,NOS 
          SX7    B1 
          SA7    RPVUBR      REPRIEVE RESUME ON USER BREAK
 OSNOS    ENDIF 
          MX6    0
          SA6    BRDATA+L.BR INSURE ZERO WORD FOR WRITE 
          SX2    FILEDS 
          SX3    BRDATA 
          SX4    L.BR*10     CHARACTER COUNT
          RJ     =XIOWTL     WRITE
  
  
*         WRITE EOS 
  
          SX2    FILEDS 
          RJ     =XIOEOR
  
  
 OSSC2    IFEQ   HOST,SC2 
          CLOSEM FILEDS,N,FILE   CLOSE DATA STACK FILE
 OSSC2    ENDIF 
  
          RJ     =XCCLSJC    RESET JOB CONTROL INFO. (PNL)
  
          SA4    BGCSW
          SX3    MSG252 
          NZ     X4,BEG15    CHECK FOR REPRIEVE RESUME
  
          RJ     =XSTRMSG    ISSUE INFORMATIVE MESSAGE
  
*         CHECK FOR A REPRIEVE RESUME AFTER A USER BREAK. 
*         EXIT VIA ABORT IF TRUE, OTHERWISE EXIT VIA ENDRUN.
  
 BEG15    BSS    0
  
 OSNOS    IFEQ   HOST,NOS 
          SX7    B0+         CLEAR USER BREAK TWO REPRIEVE RESUME 
          SA7    RPVUBR 
          SA1    RPVRR       REPRIEVE RESUME
          NZ     X1,RPV06    IF RESUMED RETURN FOR MESSAGE/RESET
  
 OSNOS    ENDIF 
  
*         IF A .NOTE DIRECTIVE WAS FOUND ANYWHERE IN THE PROCEDURE
*         BODY, NOW IS THE TIME TO DISPLAY THE TEXT/MESSAGE PORTION 
*         OF THE DIRECTIVE.  THE TEXT WAS SAVED IN THE PVT. 
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    CLOSTAT     CHECK FOR A .NOCLR DIRECTIVE 
          NZ     X1,EXIT     IF .NOCLR OR NOT THROUGH SCREEN MODE 
 SDOVL    ENDIF 
  
          SA1    IACNOTE     OFFSET OF FIRST .NOTE DIRECTIVE TEXT 
          ZR     X1,EXIT     NO .NOTE DIRECTIVE 
  
          SA2    PVTCL
          BX7    X1 
          BX6    X2 
          SA7    IACNPV      NEXT PVT OFFSET
          SA6    IACLPE      LAST PVT OFFSET
          SA7    IACPRE      PREVIOUS PVT OFFSET
 SDOVL    IFNE   IP.SDO,0 
          CSET   ASCII       SET TO ASCII FOR .NOTE PROCESSING
 SDOVL    ENDIF 
  
 BEG20    BSS    0
          RJ     =XCCLNPV    GET NEXT PVT ENTRY 
          ZR     X2,BEG21    IF END OF PVT ENTRIES
  
          SA4    =4LNOTE     SEARCH FOR .NOTE DIRECTIVE 
          BX6    X0-X4
          NZ     X6,BEG20    TRY NEXT PVT ENTRY 
  
          SB3    B0 
          SX3    PROCWSA     MOVE NOTE TO ENSURE ZERO BYTE
          LE     B2,B0,BEG20.2 IF ZERO LENGTH NOTE STRING 
  
 BEG20.1  BSS    0
          SA2    A2+B1
          BX6    X2 
          SA6    X3+B3
          SB3    B3+B1
          SB2    B2-10
          GT     B2,B0,BEG20.1 IF MORE WORDS TO MOVE
  
 BEG20.2  BSS    0
          SX6    B0          ENSURE ZERO BYTE 
          SA6    X3+B3
          SX6    MOSJDT      JOB DAYFILE AND TERMINAL 
          SA6    MSGOPT      STORE MESSAGE OPTION 
 SDOVL    IFNE   IP.SDO,0 
          SX2    O           OUTPUT FET 
          SX4    V.CCCPC
          RJ     =XIOWTL     DISPLAY MESSAGE
  
          SX3    PROCWSA     ADDRESS OF FIRST WORD OF MESSAGE 
 SDOVL    ENDIF 
          RJ     =XSTRMSG    DISPLAY MESSAGE
          JP     BEG20       FIND NEXT .NOTE DIRECTIVE
  
 BEG21    BSS    0
 SDOVL    IFNE   IP.SDO,0 
          WRITER O,RECALL    FLUSH BUFFER 
          CSET   RESTORE
 SDOVL    ENDIF 
          JP     EXIT        PROCESSING COMPLETED 
  
          TITLE  BCB  -  BEGIN, COPY BODY  OF PROCEDURE 
**        BCB  -  BEGIN, COPY BODY
* 
*         READ THE PROCEDURE BODY AND CREATE A SECTION OF 
*         CONTROL STATEMENTS.  IF ANY .DATA COMMANDS ARE
*         WITHIN THE PROCEDURE BODY ONE OR MORE DATA
*         FILES WILL ALSO BE CREATED. 
  
  
 BCB      BSSZ   1           ENTRY/EXIT 
          MX6    0
          SA6    BGCSW       ZERO C.S. WRITE COUNT
  
*         IF THE HELP RECORD NUMBER IS NEGATIVE, THEN 
*         THERE WAS NO HELP TEXT AND THE FIRST LINE 
*         OF THE PROC BODY HAS ALREADY BEEN READ BY BRH.
  
          SA1    BGPHRN 
          NG     X1,BCB01.2  1ST LINE ALREADY READ
  
 BCB01    BSS 
          SX6    SCATBF2
          SX2    FILEPC 
          SX3    PROCWSA
          SX4    V.CCCPC     MAXIMUM CHARACTERS 
          RJ     =XIORDL     READ LINE INTO SCATTER BUFFER
  
          NZ     X1,BCB25    EOF ON PROC BODY - CHECK .IF SKIPPING
  
*         CHECK IF SEQUENCE NUMBERS PRECEDE LINES                        CL0103 
                                                                         CL0103 
          SA2    SCATBF2
          SA3    PROCSEQ     SEQUENCE FLAG                               CL0103 
          ZR     X3,BCB01.2  NOT SEQUENCED                               CL0103 
                                                                         CL0103 
          RJ     CCLSSN      SKIP SEQUENCE NUMBERS                       CL0103 
                                                                         CL0103 
 BCB01.2  BSS                                                            CL0103 
                                                                         CL0103 
          MX7    0
          SA7    SCATBF1
          SA7    SCATX
          SA7    MORLINE
          SA7    MOREXP 
  
 BCB2     BSS    0
          RJ     =XCCLEXP    EXPAND LINE
          SA1    PROCWSA
          SA2    SCATBF1
          RJ     =XSTRPKS    PACK LINE
  
*                B2  = NUMBER OF CHARACTERS PACKED
*                B3  = NUMBER OF WORDS      PACKED
  
          SA4    MORLINE     CHECK CONTINUATION 
          NZ     X4,BCB22    CONTINUATION LINE/CHECK SKIPPING 
  
          LT     B0,B2,BCB3  NON-NULL LINES 
  
*         NULL LINE FOUND 
  
          SA2    BGSKIP      CHECK SKIPPING 
          NZ     X2,BCB01    SKIPPING - GET NEXT LINE 
          JP     BCB23.1     CHECK FOR DATA FILE
  
*         CHECK EXPANDED LINE FOR DIRECTIVE 
  
 BCB3     BSS    0
          SA2    SCATBF1     START AT BEGINNING OF BUFFER 
          EX7    X2,SBTOT 
          LX7    S.SBTOT-N.SBTOT+1
          BX2    X7 
  
 BCB5     BSS    0           SEARCH FOR BEGINNING OF .DIRECTIVE 
          SX6    B1 
          SA6    ANSMDE      STOP AT BLANK OR $ 
          RJ     =XSTRANS    SEARCH FOR BEGINNING PERIOD
  
          MX6    0
          SA6    ANSMDE      ALL ARE SEPARATORS 
          SA4    ANSCHR 
          NZ     X4,BCB22    NOT A DIRECTIVE
  
          SA3    ANSSEP 
          SX0    X3-1R. 
          SX7    X3-1R
          ZR     X0,BCB10    CHECK .DIRECTIVES
          NZ     X7,BCB22    LINE NOT A DIRECTIVE 
          JP     BCB5        SKIP SPACES
  
  
*         BEFORE PROCESSING .DIRECTIVE, CHECK FOR INHIBIT 
*         CHARACTER PRECEDING THE .DIRECTIVE IN THE ORIGINAL
*         UNEXPANDED LINE.  IF INHIBIT, DO NOT PROCESS .DIRECTIVE.
  
 BCB10    BSS    0           CHECK FOR PRECEDING INHIBIT
          SA2    SCATBF2     START AT BEGINNING OF BUFFER 
          EX7    X2,SBTOT 
          LX7    S.SBTOT-N.SBTOT+1
          BX2    X7 
          RJ     =XSTRANS 
  
          SA3    ANSSEP 
          SA1    INHIBIT
          BX0    X3-X1
          ZR     X0,BCB22    SKIP DIRECTIVE PROCESSING OF THIS LINE 
  
          RJ     BST         PROCESS .DIRECTIVE 
          ZR     X5,BCB01    IF SPECIAL TASK WAS EXECUTED 
  
          NG     X5,BCB3     IF RECHECK NEEDED FOR .DIRECTIVE 
  
 BCB22    BSS 
          SA1    BGSKIP 
          NZ     X1,BCB01    SKIPPING/NEXT LINE 
  
          SA5    BGDATA 
          SA1    BGCSW
          SX2    FILEDF      ASSUME DATA
          SA4    IACEX       CHECK FOR .EX COMMAND PENDING
          NZ     X5,BCB23    IF DATA BEING WRITTEN
          NZ     X4,BCB01    .EX COMMAND PENDING - GET NEXT LINE
  
          SX7    X1+B1
          SX2    FILEPS 
          SA7    A1          BGCSW
 BCB23    BSS 
          SX3    PROCWSA
          SA1    SCATBF1
          EX4    X1,SBTOT    SIZE OF OUTPUTED LINE
          MX7    0
          SA7    BGEOF       CLEAR EOF FLAG 
          RJ     =XIOWTL     WRITE STRING TO FILE 
  
          SA3    MOREXP 
          NZ     X3,BCB2     GET REST OF LINE 
          JP     BCB01       READ NEXT LINE FROM PROCEDURE FILE 
  
  
 BCB23.1  BSS 
          SA5    BGDATA 
          SX2    FILEDF 
          NZ     X5,BCB23    WRITE NULL LINE TO DATA
  
          JP     BCB01       READ NEXT LINE FROM PROCEDURE FILE 
  
  
  
*         EOF FOUND ON THE PROCEDURE BODY.  CHECK WHETHER A .IF/.ELSE 
*         WAS SKIPPING.  IF SO, ISSUE CCL379 DIAGNOSTIC, OTHERWISE
*         RETURN. 
  
 BCB25    BSS    0
          SA1    BGSKIP 
          ZR     X1,BCB      IF NOT SKIPPING - RETURN 
          SX3    MSG379A
          SX0    BGLABL 
          LX3    18 
          BX3    X0+X3
          SX0    MSG379      * NO .ENDIF FOR .IF/.ELSE LABEL *
          PL     X1,BCB26    IF SKIPPING DUE TO .IF, .ELSE OR .ELSEIF 
  
          SX0    MSG342      * NO .ENDW FOR .WHILE LABEL *
 BCB26    BSS 
          LX3    18 
          BX3    X0+X3
          JP     EXIT1       EXIT WITH CCL379 ERROR MESSAGE 
  
          TITLE  BCH  -  BEGIN, CRACK HEADER(OF PROCEDURE)
  
**        BCH  -  BEGIN, CRACK HEADER 
* 
*         GET THE FORMAL PARAMETER NAMES AND THEIR DEFAULT
*         SPECIFICATIONS FROM THE PROCEDURE HEADER. 
*         BUILD THE PROCEDURE PARAMETER TABLE (PPT).  AS EACH 
*         FORMAL PARAMETER NAME IS FOUND BUILD AN ENTRY THAT
*         CONTAINS THE FORMAL PARAMETER NAME.  THE FOLLOWING
*         PARAMETERS MAY BE THE FIRST AND SECOND DEFAULT.  AS THEY
*         ARE FOUND ADD THEM TO FPS AND RECORD THEIR OFFSETS
*         AND LENGTH IN THE ENTRY OF PPT.  IF THE DEFAULT IS NOT
*         SPECIFIED THE FORMAL PARAMETER NAME ITSELF IS ENTERED 
*         IN FPS AS THE FIRST DEFAULT.  IF NO SECOND DEFAULT
*         IS FOUND THE OFFSET AND LENGTH OF BOTH THE FIRST AND SECOND 
*         DEFAULT POINT TO THE SAME DATA IN FPS.
  
  
 BCH      BSSZ   1           ENTRY/EXIT 
          SA3    IACIPF 
          NZ     X3,BCH      RETURN IF INTERACTIVE FLAG SET 
  
          MX7    0
          SA7    BGPWPL 
          SA7    PPTCL
          SA7    FPSCL
 BCH01    BSS 
          SA3    ANSSEP 
          SX0    X3-1R, 
          SX6    X3-1R. 
          ZR     X0,BCH02    CONTINUE 
          ZR     X6,BCH      IF TERMINATED
  
          JP     BCH10
  
 BCH02    BSS 
          RJ     BHP         GET HEADER PARAMETER 
          NZ     X1,BCH09    IF ERR X3= MESSAGE CODE
  
          SA2    BGPWPL 
          SA1    ANSLIT 
          SA4    PPTCL
          SX7    X2+B1
          MX6    0           CLEAR LITERAL FLAG 
          SA7    BGPWPL 
          SX0    X4-L.PPT 
          SX3    MSG238 
          PL     X0,BCH09    IF MAXIMUM NUMBER FORMAL PAR. EXCEEDED 
  
          SA3    ANSSTR 
          SA5    ANSCHR 
          ZR     X1,BCH03    IF FORMAL PARAMETER NOT LITERAL
  
*         THE FORMAL PARAMETER NAME IS A LITERAL.  STORE THE
*         EVALUATED FORM IN PPT.
  
          SA3    ANSEVL 
          SA5    ANSEVLC
          MX6    1
          LX6    S.PPLIT+1
 BCH03    BSS 
          ZR     X5,BCH01    IGNORE NULL PARAMETER
  
          SA2    ANSSEP 
          SA6    PPT+W.PPLIT+X4 
          SX0    X5-V.FPC-1 
          BX7    X3 
          SX3    MSG235 
          PL     X0,BCH09    $FORMAL PARAM. GT V.FPC CHAR.$ 
  
          BX6    X7 
          MX0    -6 
          SX3    MSG240      * MAY NOT APPEAR IN FORMAL PARAMETER NAME
 BCH03A   LX6    6
          BX1    -X0*X6 
          SX5    X1-1R* 
          ZR     X5,BCH09    IF NAME CONTAINS * 
  
          BX6    X6-X1
          NZ     X6,BCH03A   IF MORE TO CHECK 
  
          SA7    PPT+W.PPFPN+X4  STORE FORMAL PARAMETER NAME
          SX7    X4+LE.PPT
          SX0    X2-1R= 
          SA7    PPTCL       UPDATE LENGTH OF PPT 
  
*         IF THE FORMAL PARAMETER IS NOT FOLLOWED BY AN = 
*         THEN THE FORMAL PARAMETER BECOMES ITS OWN FIRST 
*         DEFAULT.  I.E.  FORMAL=FORMAL 
  
          NZ     X0,BCH04    IF SEPARATOR NOT   = 
  
*         THE NEXT PARAMETER IS THE FIRST DEFAULT.
  
          RJ     BHP         GET HEADER PARAMETER 
          NZ     X1,BCH09    IF ERR, X3= MESSAGE CODE 
  
 BCH04    BSS 
          SB4    S.PPDC2-S.PPDC1  INDICATE THIS IS FIRST DEFAULT
  
*         STORE WORD OF PPT ENTRY AND MOVE SPECIFICATION TO FPS 
  
 BCH05    BSS 
          SA4    ANSSEP 
          SA1    ANSSTR 
          SA5    ANSCHR 
          SX0    X4-1R# 
          NZ     X0,BCH06    IF NOT SPECIAL CHAR. OF  # 
  
          NZ     X5,BCH10    INVALID SEPARATOR IF NOT NULL
  
          RJ     RSN         RECOGNIZE SPECIAL NAME 
          NZ     X3,BCH09    IF ERROR 
  
*         NOTE, ANSLIT IS NOT NOW SET SO NEXT JP GOES TO BCH07
  
  
  
*                B4  = FLAG 
*                A1  = STRING ADDRESS 
*                X5  = NUMBER OF CHARACTERS 
  
 BCH06    BSS 
          SA3    ANSLIT 
          SA2    PPTCL
          ZR     X3,BCH07    IF SPECIFICATION NOT A LITERAL 
  
          SA3    X2+PPT-LE.PPT+W.PPLIT
          LX3    59-S.PPLIT 
          NG     X3,BCH07    IF FORMAL PARAMETER WAS A LITERAL
  
*         THE SPECIFICATION IS A LITERAL.  HOWEVER, THE FORMAL
*         PARAMETER WAS NOT A LITERAL.  HENCE, USE THE EVALUATED FORM.
  
          SA5    ANSEVLC
          SA1    ANSEVL 
 BCH07    BSS 
          SA4    FPSCL
          LX5    S.PPDC1+1-N.PPDC1
          BX3    X4+X5       MERGE OFFSET, CHAR. COUNT
          SA2    X2-LE.PPT+PPT+W.PPDC2
          MX0    N.PPDC2+N.PPDO2
          LX3    S.PPDC2-S.PPDC1
          LX0    S.PPDC2+1
          AX5    S.PPDC1+1-N.PPDC1  RESTORE X5
          BX3    X0*X3
          BX2    -X0*X2 
          BX2    X2+X3
          LX3    X3,B4
          LX0    X0,B4
          BX2    -X0*X2 
          BX7    X2+X3
          SA7    A2          W.PPDC2
  
*         STORE THE DEFAULT SPECIFICATION 
*                A1  = ADDRESS OF SPECIFICATION STRING
*                X1  = FIRST TEN CHARACTERS 
*                B4  = SECOND DEFAULT FLAG
*                A2 = ADDRESS OF CURRENT W.PPDC2
  
          SB5    V.SCS       MAXIMUM CHARACTERS IN SPECIFICATION
          SB6    X5          NUMBER OF CHARACTERS 
          SB7    X4 
          SX3    MSG211 
          LT     B5,B6,BCH09  IF SPECIFICATION TOO LONG 
  
 BCH08    BSS 
          BX6    X1 
          SA1    A1+B1       NEXT WORD
          SA6    FPS+B7 
          SB6    B6-10
          SB7    B7+B1
          LT     B0,B6,BCH08  IF MORE WORDS 
  
          SX7    X4+LE.FPS   NEW LENGTH OF FPS
          SA3    ANSSEP 
          SA7    FPSCL       UPDATE LENGTH OF FPS 
          SX0    X3-1R/ 
          ZR     X0,BCH08A   SEP IS / STORE 2ND DEFAULT 
          EQ     B0,B4,BCH01 2ND DEFAULT ALREADY PROCESSED
  
*         THERE WAS NO 2ND DEFAULT.  CREATE AN FPS ENTRY WHICH
*         CONTAINS THE VALUE FROM THE 1ST DEFAULT 
  
  
          SB4    B0          INDICATE 2ND DEFAULT 
          SA5    ANSCHR 
          SA1    ANSSTR 
          JP     BCH06       CREATE IMPLICIT 2ND DEFAULT
  
  
 BCH08A   BSS    0
  
          SX3    MSG237      $SLASH FOLLOWS SECOND DEFAULT$ 
          EQ     B0,B4,BCH09  ERR IF SECOND DEFAULT ALREADY PROCESSED 
          RJ     BHP         GET HEADER PARAMETER 
          NZ     X1,BCH09    IF ERR, X3= MESSAGE CODE 
  
          SA5    BGPFSD 
          SA3    ANSSEP 
          SB4    B0          INDICATE SECOND DEFAULT
          NZ     X5,BCH05    IF NOT FIRST, SECOND DEFAULT, IN PROC HEAD.
  
*         RECORD THE POSITION OF THE FIRST EXPLICIT, SECOND DEFAULT 
  
          SA4    BGPWPL 
          BX7    X4 
          SA7    A5          BGPFSD 
          JP     BCH05
  
  
*         ERROR CONDITION.  IF BCH09 IS ENTERED THE MESSAGE CODE
*         IS IN X3.  IF BCH10 IS ENTERED THE PROBLEM IS AN
*         INVALID SEPARATOR.
*         FIRST, DUMP THE STATEMENT BUFFER TO LIST THE .PROC HEADER 
*         THEN ISSUE THE ERROR MESSAGE
  
 BCH09    BSS 
          BX7    X3 
          JP     BCH11
  
 BCH10    BSS 
          SA2    ANSHBA      GET SCATTER BUFFER HEADER BEFORE LAST ASSEM
          SA3    BCHMSG      PREVIOUS ERROR CODE                         CL0130 
          BX7    X3                                                      CL0130 
          BX6    X2 
          SA6    SCATBF2
 BCH11    BSS 
          SA7    BCHMSG      SAVE MESSAGE CODE
          MX6    0
          SA6    W.RACS      INHIBIT DSB FROM PRINTING W.RACS 
          MX1    0
          SX7    MOSJDT      SEND MESSAGE TO SYSTEM DAYFILE 
          SA7    MSGOPT 
          RJ     =XCCLDSB    DUMP PROC HEADER CARDS 
  
          SA3    BCHMSG 
          NZ     X3,BCH12    IF NOT THE INVALID SEPARATOR 
  
          SA2    SCATBF2
          RJ     =XSTRANS    REASSEMBLE STRING AND INVALID SEPARATOR
          SA4    ANSSEP 
          SX0    X4-1R) 
          NZ     X0,BRWERR2  ISSUE INVALID SEPARATOR MSG
  
          SX3    MSG239      $PROCEDURE HEADER MUST BE TERMINATED BY PER
  
 BCH12    BSS 
          JP     =XBRWERR4   ISSUE MESSAGE AND ABORT
  
 OSNOS    IFEQ   HOST,NOS 
 BCHDEF   BSS    1           SAVE DEFAULT FLAG
 OSNOS    ENDIF 
 BCHMSG   BSSZ   1           ERROR MESSAGE CODE                          CL0130 
 BCIC     TITLE  BEGIN, CHANGE INHIBIT/CONCATENATION CHARACTER. 
**        BCIC   BEGIN, CHANGE INHIBIT/CONCATENATION CHARACTER. 
* 
*         BCIC CHANGES THE INHIBIT OR CONCATENATION CHARACTER.  BCIC IS 
*         CALLED IF A .IC OR .CC DIRECTIVE IS FOUND BEFORE THE HELP 
*         TEXT BY *BRH* OR IN THE PROCEDURE BODY BY *BST*.
* 
*         ENTRY  (A2) = ADDRESS OF SCATTER BUFFER WITH DIRECTIVE LINE.
*                (X2) = SCATTER BUFFER HEADER.
*                (X7) = 0 IF PROCESSING .CC DIRECTIVE,
*                       1 IF PROCESSING .IC DIRECTIVE.
* 
*         EXIT   INHIBIT OR CONCATENATION CHARACTER CHANGED.
*                TO *BRWERR5* IF SEPARATOR OR TERMINATOR ERROR. 
* 
*         USES   X - 0, 1, 3, 4, 5, 6, 7. 
*                A - 1, 3, 4, 5, 6, 7.
*                B - 3. 
* 
*         CALLS  STRANS.
  
 BCIC     SUBR               ENTRY/EXIT 
          SA7    BCICA       SAVE DIRECTIVE NAME
          SX7    B1+
          SA7    ANSMDE      $ AND BLANK ARE SEPARATORS 
          SA4    ANSCHR 
 BCIC1    BSS    0
          SA5    ANSSEP 
          SX1    X5-1R
          NZ     X1,BCIC4    IF NOT BLANK SEPARATOR 
  
          RJ     =XSTRANS    SKIP BLANK SEPARATOR 
  
          SA4    ANSCHR 
          ZR     X4,BCIC1    IF NO STRING FOUND 
  
 BCIC2    BSS    0
          SB3    X4+
          SA4    BCICA
          SX3    MSG440      EXPECTING INHIBIT CHARACTER
          NZ     X4,BCIC3    IF PROCESSING .IC
  
          SX3    MSG441      EXPECTING CONCATENATION CHARACTER
 BCIC3    BSS    0
          GT     B3,B1,BCIC9 IF NOT A SINGLE CHARACTER
  
          SA3    ANSSTR 
          SB3    X4+
          BX7    X3 
          LX7    6
          ERRNZ  INHIBIT-CCATENAT-1 CODE DEPENDS ON RELATIVE LOCATIONS
          SA7    CCATENAT+B3
          JP     BCIC7       CHECK FOR TERMINATOR 
  
 BCIC4    BSS    0
          SX6    X5-1R= 
          SX0    X5-1R, 
          SX7    X5-1R( 
          ZR     X6,BCIC5    IF EQUAL SYMBOL SEPARATOR
  
          ZR     X0,BCIC5    IF COMMA SEPARATOR 
  
          ZR     X7,BCIC5    IF LEFT PARENTHESIS SEPARATOR
  
          ZR     X4,BCIC6    IF SEPARATOR IS REPLACEMENT CHARACTER
  
          SX3    MSG421      EXPECTING , OR ( AFTER DIRECTIVE 
          JP     BCIC9       SET SCATTER BUFFER FLAG AND EXIT 
  
 BCIC5    BSS    0
          RJ     =XSTRANS 
  
          SA4    ANSCHR 
          NZ     X4,BCIC2    IF A STRING WAS FOUND
  
 BCIC6    BSS    0
          SA4    BCICA       GET DIRECTIVE NAME FLAG - 0=CC, 1=IC.
          SA5    ANSSEP 
          SB3    X4 
          BX7    X5 
          SX3    MSG440      EXPECTING INHIBIT CHARACTER
          NZ     X4,BCIC6.1  IF PROCESSING .IC
  
          SX3    MSG441      EXPECTING CONCATENATION CHARACTER
 BCIC6.1  BSS    0
          NG     X5,BCIC9    IF NOTHING FOLLOWS FIRST SEPARATOR 
  
          ERRNZ  INHIBIT-CCATENAT-1 CODE DEPENDS ON RELATIVE LOCATIONS
          SA7    CCATENAT+B3
          RJ     =XSTRANS 
  
          SA1    ANSCHR 
          NZ     X1,BCIC8    IF GARBAGE FOLLOWS CHARACTER 
  
 BCIC7    BSS    0
          SX6    B0+
          SA6    ANSMDE      $ AND BLANK ARE NOT SEPARATORS 
          SA4    ANSSEP 
          NG     X4,BCICX    IF END OF LINE 
  
          SX0    X4-1R
          SX6    X4-1R. 
          SX7    X4-1R) 
          ZR     X0,BCICX    IF TERMINATOR IS BLANK - OK
  
          ZR     X6,BCICX    IF PERIOD TERMINATOR 
  
          ZR     X7,BCICX    IF PARENTHESIS TERMINATOR
  
 BCIC8    BSS    0
          SX3    MSG442      EXPECT TERMINATOR ENDING DIRECTIVE 
 BCIC9    BSS    0
          SX7    A2-SCATBF2  INDICATE SCATTER BUFFER TO DISPLAY 
          SA7    PBCOND 
          JP     BRWERR5     EXIT WITH ERROR MESSAGE
  
 BCICA    BSS    1           INHIBIT/CONCATENATE INDICATOR
 BCM      TITLE  BCM - BEGIN CRACK MENU HEADER
**        BCM    -  BEGIN CRACK MENU HEADER 
* 
*         STORE THE PARAMETER AND CHECKLIST SELECTIONS IN THE PPT.
*         STORE THE TITLE AND THE SELECTION PROMPTS IN THE PATTERN
*         VALUE TABLE (PVT).  THE COMMENT PARAMETER FOLLOWING 
*         THE CHECKLIST IS STORED IN BGNAME.
* 
* 
  
 BCM      BSSZ   1                 ENTRY/EXIT 
          SA1    IACIMP 
          ZR     X1,BCM            NON-MENU PROCEDURE 
  
          SA3    ANSSEP 
          PL     X3,BCM000         SEPARATOR FOLLOWS NAME 
  
          RJ     BHP               READ NEXT HEADER CARD
          NZ     X1,BRWERR5        HEADER NOT TERMINATED
  
 BCM000   BSS    0
          MX7    0
          SX6    1
          SA7    BGNAML 
          SA6    PVTCL
          SA7    FPSCL
          SA7    BGNAME 
          SA7    PPTCL
          ERRZR  W.PPFPN-W.PPMTP
          ERRZR  W.PPFPN-W.PPVAL
          ERRZR  W.PPVAL-W.PPMTP
          SA7    PPT+W.PPVAL       CLEAR PARAMETER PPT ENTRY
          SA7    PPT+W.PPMTP
          SA4    ANSSEP 
          SX3    MSG381            MISSING PARAMETER
          SX0    X4-1R. 
          SX6    X4-1R) 
          ZR     X0,BRWERR5        MISSING CHECKLIST
          ZR     X6,BRWERR5        MISSING CHECKLIST
  
          SX3    MSG380            EXPECTING TITLE OR , AFTER *M
          SX0    X4-1R" 
          SX6    X4-70B            APOSTROPHE 
          ZR     X6,BCM000A        STORE TITLE
          NZ     X0,BCM005         NO TITLE - CHECK FOR COMMA 
  
 BCM000A  BSS    0
          BX6    X4 
          SX7    1
          SA6    ANSPSP            STORE TITLE DELIMITING CHARACTER 
          SA7    IACDSF 
          RJ     BHP               READ TITLE 
          NZ     X1,BRWERR5        HEADER TITLE NOT TERMINATED
  
          SA5    ANSCHR 
 OSNOS    IFEQ   HOST,NOS 
          SX0    X5-V.PSIZ-1
 OSNOS    ELSE
          SX0    X5-V.SCS-1 
 OSNOS    ENDIF 
          SX3    MSG384            TITLE TOO LONG 
          PL     X0,BRWERR4        HEADER TITLE TOO LONG
  
          ERRZR  W.PPVAL-W.PPMTP
          SA4    PVTCL
          MX3    0
          OX7    X3,X4,PPVAL       STORE PVT OFFSET 
          SA7    PPT+W.PPVAL       STORE PVT OFFSET IN PPT
          MX6    N.PPMTP
          LX6    S.PPMTP+1
          SA6    PPT+W.PPMTP       INDICATE TITLE AVAILABLE 
          SA3    =0LDSCRTN         CREATE A PVT ENTRY 
          SA4    ANSSTR 
          BX6    X3 
          SA6    IACPVID
          RJ     =XCCLWPV          WRITE TITLE TO PVT 
  
          RJ     BHP               READ COMMA 
          NZ     X1,BRWERR5        SEP SHOULD END HEADER LINE 
  
          SX3    MSG386            EXPECTING COMMA AFTER TITLE
          SA1    ANSCHR 
          NZ     X1,BRWERR4        STRING FOLLOWS TITLE 
  
 BCM005   BSS    0
          SA4    ANSSEP 
          SX0    X4-1R, 
          NZ     X0,BRWERR5        SEPARATOR MUST BE ,
  
          SX6    -LE.PPT
          SA6    PPTCL             INITIAL LENGTH OF PPT
          RJ     BHP               GET PARAMETER NAME 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          MX6    0                 CLEAR LITERAL FLAG IN PPT
          SA1    ANSLIT 
          SA5    ANSCHR 
          SA4    ANSSTR 
          ZR     X1,BCM010         PARAMETER NOT A LITERAL
  
          SA5    ANSEVLC
          SA4    ANSEVL            EVALUATED LITERAL
          MX6    N.PPLIT
          LX6    S.PPLIT+1
  
  
*         X4 = NAME (SELECTION OR PARAMETER)
*         X5 = NAME LENGTH
*         X6 = LITERAL FLAG 
  
  
 BCM010   BSS    0
          SA1    PPTCL
          SX7    X1+LE.PPT         UPDATE POSITION WITHIN PPT 
          SA7    A1 
          SX3    MSG394            MAX PARAMETERS EXCEEDED
          SX0    X7-L.PPT-LE.PPT
          PL     X0,BRWERR4        TOO MANY SELECTIONS
  
          SX3    MSG381            MISSING PARAMETER
          ZR     X5,BRWERR5        MISSING PARAMETER MENU HEADER
  
          SA2    PPT+W.PPLIT+X7    FETCH 1ST WORD OF PPT ENTRY
          SX3    MSG235            PARAMETER .GT. 10 CHARACTERS 
          ZR     X7,BCM010A        IF PARAMETER ERROR 
  
          SX3    MSG395            SELECTION EXCEEDS 10 CHARACTERS
          MX2    0                 CLEAR PPT ENTRY WORD 
  
 BCM010A  BSS    0
          SX0    X5-V.FPC-1 
          PL     X0,BRWERR4        KEYWORD NAME TOO LARGE 
  
          BX7    X4 
          MX0    -6 
          SX3    MSG240            * MAY NOT APPEAR IN PARAMETER NAME 
 BCM010B  LX4    6
          BX1    -X0*X4 
          BX4    X4-X1
          SX1    X1-1R* 
          ZR     X1,BRWERR4        IF NAME CONTAINS * 
  
          NZ     X4,BCM010B        IF MORE TO CHECK 
  
*         CREATE PPT ENTRY FOR THIS PARAMETER 
  
          SA1    PPTCL
          SA7    PPT+W.PPFPN+X1 
          ERRNZ  W.PPLIT-W.PPDO1
          ERRNZ  W.PPLIT-W.PPFPC
          ERRNZ  W.PPLIT-W.PPDO2
          LX5    S.PPFPC-N.PPFPC+1
          BX0    X5+X6             ADD LITERAL FLAG 
          BX0    X2+X0
          ERRNZ  W.PPLIT-W.PPMTP
          SA3    FPSCL             FPS OFFSET FOR SUBSTITUTION VALUE
          MX7    -N.PPDO1 
          ERRNZ  S.PPDO1-N.PPDO1+1
          BX5    -X7*X3 
          BX2    X5+X0
          SX4    X3+LE.FPS
          BX6    X4 
          LX4    S.PPDO2-N.PPDO2+1
          BX7    X2+X4             UPDATE CURRENT FPS OFFSET
          SA7    A2 
          SA6    A3 
          SA1    PPTCL
          NZ     X1,BCM010C        IF SELECTION UPDATE PPVAL
  
          SA4    ANSSEP 
          SX3    MSG387            MISSING CHECKLIST
          SX0    X4-1R. 
          SX6    X4-1R) 
          ZR     X0,BRWERR5        NO CHECKLIST 
          ZR     X6,BRWERR5        NO CHECKLIST 
  
          SX3    MSG385            EXPECTING = AFTER KEYWORD
          SX0    =0LHEADER
          LX0    18 
          BX3    X0+X3
          SX0    X4-1R= 
          NZ     X0,BRWERR5        NO = AFTER KEYWORD 
          JP     BCM025            WHAT FOLLOWS = 
  
 BCM010C  BSS    0
          SA4    PVTCL             CURRENT PVT OFFSET TO PPT
          SA2    PPT+W.PPVAL+X1 
          MX3    0
          OX7    X3,X4,PPVAL       STORE PVT OFFSET 
          SA7    A2 
          SA4    ANSSEP 
          SX0    X4-1R" 
          SX6    X4-70B            APOSTROPHE 
          SX3    MSG390            EXPECTING , ) AFTER SELECTION
          ZR     X6,BCM010D        READ SELECTION PROMPT
          NZ     X0,BCM015         WHAT FOLLOWS SELECTION NUMBER
  
 BCM010D  BSS    0                 READ SELECTION PROMPT STRING 
          BX6    X4 
          SA6    ANSPSP            STORE SELECTION PROMPT DELIMITER 
          MX7    1
          SA7    IACDSF            TURN ON DESCRIPTION FLAG 
          SA2    SCATBF2
          RJ     =XSTRANS          READ PROMPT STRING 
  
          SA5    ANSCHR            CHECK LENGTH OF PROMPT 
          SA1    PPTCL
 OSNOS    IFEQ   HOST,NOS 
          SX0    X5-V.PSIZ-1
 OSNOS    ELSE
          SX0    X5-V.SCS-1 
 OSNOS    ENDIF 
  
          SX3    MSG382            SELECTION PROMPT TOO LONG
          PL     X0,BRWERR4        LONG SELECTION PROMPT
  
*         FOR FULL SCREEN DIALOGUES, IT IS NECESSARY TO KNOW THE
*         LENGTH OF EACH PROMPT.  SAVE THE LENGTH IN PPLCP. 
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    ANSSTR 
          SB2    X5 
          SA2    SCATX
          MX2    0
          RJ     =XSTRCADC         COUNT NUMBER OF ASCII CHARACTERS 
          MX7    0
          SX5    B3 
          SA7    SCATX
          SA1    PPTCL
          SA2    PPT+W.PPLCP+X1 
          OX6    X2,X5,PPLCP
          SA6    A2 
          SA5    ANSCHR 
 SDOVL    ENDIF 
  
          SA2    PPT+W.PPMTP+X1    INDICATE TITLE/PROMPT AVAILABLE
          MX3    N.PPMTP
          LX3    S.PPMTP+1
          BX7    X2+X3
          SA7    A2 
          SA3    =0LDSCRTN         CREATE A PVT ENTRY 
          BX6    X3 
          SA4    ANSSTR 
          SA6    IACPVID
  
          RJ     =XCCLWPV          WRITE TITLE OR PROMPT TO PVT 
  
  
          RJ     BHP
          NZ     X1,BRWERR5        NO SEP AT END OF LINE
  
          SA1    ANSCHR            GARBAGE AFTER QUOTE CHAR 
          SA2    PPTCL
          SX3    MSG392            EXPECTING COMMA AFTER PROMPT 
          SA4    ANSSEP 
          NZ     X1,BRWERR4        NO , OR ) AFTER SELECTION PROMPT 
  
  
 BCM015   BSS    0
          SX0    X4-1R) 
          SX1    X4-1R, 
          ZR     X0,BCM050         END OF CHECKLIST 
          NZ     X1,BRWERR5        NO , OR ) AFTER CHECKLIST SELECTION
          JP     BCM030            READ SELECTION OPTION
  
  
 BCM025   BSS    0
          RJ     BHP
          NZ     X1,BRWERR5        NO SEP AT END OF LINE
  
          SA1    ANSCHR 
          SX3    MSG387            EXPECTING BEGINNING OF CHECKLIST 
          SA4    ANSSEP 
          NZ     X1,BRWERR4        STRING PRECEDES CHECKLIST
  
          SX0    X4-1R( 
          NZ     X0,BRWERR5        NO ( BEGINNING CHECKLIST 
  
  
 BCM030   BSS    0                 READ SELECTION OPTIONS 
          RJ     BHP
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA4    ANSNUM 
          SA5    ANSCHR 
  
          SX3    MSG388            SELECTION IS NOT INTEGER 
          NZ     X4,BCM030A        VALIDATE INTEGER SELECTION 
          NZ     X5,BRWERR4        ALPHA SELECTION
  
          SX3    MSG383            MISSING CHECKLIST OPTIONS
          JP     BRWERR5           NULL SELECTION IN CHECKLIST
  
 BCM030A  BSS    0
          SA1    ANSLIT 
          MX6    0
          SA4    ANSSTR 
          ZR     X1,BCM035         NOT LITERAL
  
          MX6    N.PPLIT
          SA4    ANSEVL            EVALUATED LITERAL
          SA5    ANSEVLC
          LX6    S.PPLIT+1
  
 BCM035   BSS    0
          SB5    X5 
          SB4    B5-B1
          BX1    X4 
          MX2    -6 
  
 BCM040   BSS    0                 VALIDATE SELECTION OPTION
          LX1    6
          BX0    -X2*X1 
          SX7    X0-1R+ 
          SX0    X0-1R0 
          PL     X7,BRWERR4        SELECTION IS NON-INTEGER 
          NG     X0,BRWERR4        SELECTION IS NON-INTEGER 
  
          SB5    B5-B1
          NE     B5,B0,BCM040      GET NEXT CHARACTER 
 SDOVL    IFNE   IP.SDO,0 
  
*         SAVE THE LENGTH OF THE LONGEST SELECTION
  
          SA1    SDLS              PREVIOUS LONG SELECTION
          IX0    X1-X5
          PL     X0,BCM010         LONGEST SELECTION ALREADY SAVED
  
          BX7    X5 
          SA7    A1 
 SDOVL    ENDIF 
          JP     BCM010            STORE SELECTION IN PPT 
  
  
  
 BCM050   BSS    0                 END OF CHECKLIST 
          RJ     BHP
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA4    ANSSEP 
          SA5    ANSCHR 
          SX3    MSG393            EXPECTING PERIOD AFTER CHECKLIST 
          SX0    X4-1R. 
          NZ     X5,BRWERR4        STRING FOLLOWS CHECKLIST 
          NZ     X0,BRWERR5        NO TERMINATOR AFTER CHECKLIST
  
          SA1    PPTCL
          SX7    X1+LE.PPT
          SA7    A1                UPDATE PPT LENGTH
          JP     BCM               RETURN 
 BCR      TITLE  BCR - BEGIN CHECK RESTRICTED PARAMETER.
**        BCR - BEGIN CHECK RESTRICTED PARAMETER. 
* 
*         CHECKS TO SEE IF THE CURRENT PARAMETER HAS A *R ATTRIBUTE 
*         AND IF SO, REMOVES THE VALUE FROM THE COMMAND IMAGE.
* 
*         ENTRY  (X1) = POINTER TO CURRENT PPT ENTRY. 
*                (X2) = SCATBF1 HEADER BEFORE VALUE WAS EXTRACTED.
*                (SCATBF1) = CURRENT COMMAND IMAGE, 1 CHARACTER/WORD. 
* 
*         EXIT   CURRENT VALUE REMOVED FROM COMMAND IMAGE IN *SCATBF1*
*                IF CURRENT PARAMETER HAS A *R CHECKLIST PATTERN. 
* 
*         USES   X - 2, 3, 6. 
*                A - 2, 3, 6, 
*                B - 2, 3, 6. 
  
 OSNOSBE  IFNE   HOST,SC2 
 BCR      SUBR                     ENTRY/EXIT 
          SA3    PPT+W.PPRAP+X1 
          EX6    X3,PPRAP 
          ZR     X6,BCRX           IF NO *R ATTRIBUTE 
  
          SA3    SCATBF1           GET CURRENT SCATTER BUFFER HEADER
          EX6    X3,SBCUR 
          SB3    X6                SET SOURCE ADDRESS 
          EX3    X2,SBCUR 
          SB2    X3                SET DESTINATION ADDRESS
          EX6    X2,SBTOT 
          SB6    X6                SET LIMIT ADDRESS
          SX6    X3+B1             SET NEW CURRENT LOCATION 
          OX3    X2,X6,SBCUR
 BCR1     SA2    SCATBF1+B3        MOVE ONE WORD OF COMMAND IMAGE 
          SB2    B2+B1
          BX6    X2 
          SA6    SCATBF1+B2 
          SB3    B3+1 
          LE     B3,B6,BCR1        IF MORE WORDS TO MOVE
  
          SX2    B2                SET ALTERED TOTAL LENGTH 
          OX6    X3,X2,SBTOT
          SA6    A3                UPDATE BUFFER HEADER 
          JP     BCRX              RETURN 
  
 OSNOSBE  ENDIF 
 BDT      TITLE  BEGIN DISPLAY TITLE
**        BDT  -  BEGIN DISPLAY TITLE 
* 
*         BDT DISPLAYS THE PROCEDURE TITLE LINE IN THE DAYFILE
*         OR THE TERMINAL FOR MENU AND INTERACTIVE PROCEDURES.
*         BDT IS USED ONLY IN LINE MODE.
* 
* 
*         ENTRY - B1=1
*         EXIT  - NONE
* 
* 
 BDT      BSSZ   1                 ENTRY/EXIT 
  
*         DETERMINE WHETHER THERE IS A TITLE
  
          SA3    IACIMP 
          SX7    -LE.PPT           INTERACTIVE PPT OFFSET 
          ZR     X3,BDT50          INTERACTIVE PROC 
  
          MX7    0
  
 BDT50    BSS    0
          SA2    SCATX
          MX2    0
          SA4    PPT+W.PPMTP+X7 
          LX4    59-S.PPMTP 
          PL     X4,BDT            NO TITLE - RETURN
  
          SA1    =1H
          SB2    B1                BLANK LINE BEFORE TITLE
          RJ     =XSTRTASC
          RJ     =XCCLWID 
  
*         NOS CCL TALKS ASCII - SO DECIDE WHETHER TO USE CONTROL BYTE.
  
          SA1    =1H               LEADING SPACE
          SB2    B1 
 OSNOS    IFEQ   HOST,NOS 
          SA3    IACIDP 
          ZR     X3,BDT100         NON-ASCII
  
          SA1    =3L"EM"           CONTROL BYTE WITH SPACE
          SB2    3
  
 BDT100   BSS    0
 OSNOS    ENDIF 
          RJ     =XSTRTASC
          SA3    IACIMP 
          SX7    -LE.PPT
          ZR     X3,BDT150         INTERACTIVE PROC 
  
          MX7    0
  
 BDT150   BSS    0
          SA5    PPT+W.PPVAL+X7 
          EX0    X5,PPVAL 
          SA1    PVT+W.PVSTR+X0    1ST WORD OF TABLE
          SA3    PVT+W.PVSIZ+X0 
          EX4    X3,PVSIZ 
          SB2    X4                SIZE OF TITLE
          RJ     =XSTRCADC         TITLE TO SCATX 
          RJ     =XCCLWID 
  
*         PLACE BLANK LINE AFTER TITLE
  
          SA1    =1H
          SB2    B1 
          RJ     =XSTRTASC
          RJ     =XCCLWID 
          JP     BDT               RETURN 
  
 BESP     TITLE  BEGIN, ENTER STRING IN PVT.
**        BESP   BEGIN, ENTER STRING IN PVT.
* 
*         PLACE A PVID, STRING LENGTH AND STRING IN THE PVT.
* 
*         ENTRY  (A2) = SCATTER BUFFER ADDRESS CONTAINING STRING. 
*                (X2) = SCATTER BUFFER HEADER.
*                (X3) = PVID (DIRECTIVE IDENTIFIER).
*                (ANSSEP) = SEPARATOR FOLLOWING DIRECTIVE NAME. 
* 
*         EXIT   PVID, STRING LENGTH AND STRING STORED IN PVT.
*                TO *BRWERR5* IF BAD SEPARATOR AFTER DIRECTIVE NAME.
*                TO *BRWERR* IF PVT OVERFLOW OCCURS.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3, 4, 5.
* 
*         CALLS  STRANS, STRSBS, STRPKS.
  
 BESP     SUBR                     ENTRY/EXIT 
          SA5    PVTCL             SAVE IDENTIFIER IN PVID ENTRY
          BX7    X3 
          SA7    PVT+W.PVID+X5
          BX7    X2                SAVE SCATTER BUFFER HEADER 
          SA7    BESPA
          RJ     STRSBS            SKIP BLANK SEPARATOR(S)
  
          NZ     X4,BESP1          IF NO NON-BLANK SEPARATOR
  
          NG     X1,BESP5          IF A NULL STRING 
  
          SX4    X1-1R. 
          SX0    X1-1R, 
          SX7    X1-1R( 
          ZR     X4,BESP5          IF A NULL STRING 
  
          SX4    X1-1R= 
          SX3    MSG421            EXPECTING , OR ( 
          ZR     X0,BESP2          IF COMMA STORE DIRECTIVE TEXT
  
          ZR     X7,BESP2          IF LEFT PARENTHESIS STORE TEXT 
  
          NZ     X4,BRWERR5        IF NOT AN ALLOWABLE SEPARATOR
  
*         ALLOW $-DELIMITED STRINGS AFTER AN = SYMBOL.
  
          RJ     =XSTRANS          GET THE TEXT STRING
  
          SA3    ANSLIT 
          SA1    ANSSTR 
          SA4    ANSCHR 
          ZR     X3,BESP5          IF NOT A LITERAL 
  
          SA1    ANSEVL 
          SA4    ANSEVLC
          JP     BESP5             STORE STRING AND SIZE
  
*         NOT = SEPARATOR - FIND TERMINATOR MARKING END OF TEXT STRING. 
  
 BESP1    BSS    0
          SA3    BESPA             RESTORE SCATTER BUFFER HEADER
          BX2    X3 
 BESP2    BSS    0                 WRITE TEXT TO PVT
          ERRNZ  S.SBCUR-N.SBCUR+1
          SB5    X2                CURRENT CHARACTER
          EX3    X2,SBTOT 
          SB3    X3                TOTAL CHARACTERS 
          SB4    B5                LENGTH OF DIRECTIVE STRING 
 BESP3    BSS    0
          SB4    B4+B1
          GT     B4,B3,BESP4       NO TERMINATOR ON DIRECTIVE 
  
          SA5    A2+B4
          SX0    X5-1R. 
          SX6    X5-1R) 
          ZR     X0,BESP4          TERMINATOR FOUND 
  
          NZ     X6,BESP3          KEEP SEARCHING FOR TERMINATOR
  
 BESP4    BSS    0
          SB4    B4-B1
          SA2    A2+B5             NEW HEADER ADDRESS 
          SA1    ANSSTR 
          SX2    B4-B5             TOTAL CHARACTERS IN DIRECTIVE TEXT 
          LX2    S.SBTOT-N.SBTOT+1 STRING LENGTH
          RJ     =XSTRPKS          PACK PROMPT STRING 
  
          SX4    B2 
 BESP5    BSS    0
          SX5    10 
          SX3    X4+9 
          IX2    X3/X5
          SA5    PVTCL
          SX6    X2+B1
          SB4    X2 
          IX6    X5+X6
          SX7    X6-L.PVT 
          SX3    MSG323            PVT EXCEEDED 
          PL     X7,BRWERR         IF PVT HAS OVERFLOWED
  
          SA6    PVTCL
          SA3    PVT+W.PVID+X5     PUT STRING SIZE IN PVT CONTROL WORD
          OX7    X3,X4,PVSIZ
          SA7    A3 
          ERRNZ  W.PVID-W.PVSIZ    PVID AND SIZE MUST BE IN SAME WORD 
          SX6    X6-1 
 BESP6    BSS    0
          EQ     B4,B0,BESPX       IF STRING TRANSFER COMPLETED 
  
          SB4    B4-B1
          SA4    A1+B4
          SX6    X6-1 
          BX7    X4 
          SA7    PVT+W.PVSTR+X6 
          EQ     BESP6             CONTINUE STRING TRANSFER 
  
 BESPA    BSS    1                 SCATTER BUFFER HEADER STORAGE
          TITLE  BFP  -  BEGIN, FIND PROCEDURE
**        BFP  -  BEGIN, FIND PROCEDURE 
* 
*         DETERMINE WHERE THE PROCEDURE RESIDES.  IT MAY BE ON A
*         LOCAL FILE, PERMANENT FILE OR A LIBRARY.  IF THE LOCAL FILE 
*         DOES NOT EXIST THEN EITHER SEARCH THE LIBRARY OR ATTEMPT TO 
*         ATTACH A P.F..  ONCE THE FILE TO BE READ HAS BEEN DETERMINED
*         SEARCH FOR THE PROCEDURE.  IF PFILE IS A LIBRARY AND
*         (IP.RLD .EQ. 1) THEN LOCATE THE PROCEDURE RANDOMLY BY 
*         USING THE LIBRARY DIRECTORY.  OTHERWISE 
*         SEARCH FOR THE PROCEDURE BY READING THE FIRST CARD
*         FROM EACH SECTION AND DETERMINE IF IT IS THE PROCEDURE. 
* 
* 
  
  
 BFP      BSSZ   1           ENTRY/EXIT 
          SA5    FILENAM     INPUT FOR IOFIL
          SX7    1
          SA7    BFPREW      INITIALIZE SEARCH FLAG 
 OSBE     IFEQ   HOST,NOSBE 
          MX7    6
          BX7    X7*X5       ISOLATE UPPERMOST CHAR OF NAME 
          LX7    6
          SX7    X7-1R0 
          PL     X7,BFP0     NUMERIC NAME - SKIP FILINFO CHECK
  
 OSBE     ENDIF 
          RJ     =XIOFIL     DOES FILE EXIST (X5 INPUT-OUTPUT)
  
          SA1    BGLIBSR     VERB CALL TO PROCEDURE 
          ZR     X1,BFP0.5   DO NOT SET LFN CALL FLAG 
  
 OSNOS    IFEQ   HOST,NOS 
          SA3    PREFIX      CHECK FOR $ PREFIX ON NAME CALL
          NZ     X3,BFP0     SEARCH LIBRARY 
  
 OSNOS    ENDIF 
          BX7    X5          NZ IF LFN EXISTS 
          SA7    BGLFNC      SET LOCAL FILE NAME CALL 
 BFP0.5   BSS 
          NZ     X5,BFP2     IF FILE EXISTS 
  
 BFP0     BSS 
          SA1    BGLIBSR
          ZR     X1,BFP1     IF CLEAR DO NOT SEARCH LIBRARY 
  
*         SEARCH THE CURRENTLY DEFINED LIBRARY SET FOR PROCEDURE PNAME. 
  
*         IF THE PROCEDURE (ON A NAME CALL) IS ON A LIBRARY,
*         THEN THE SPECIAL DEFAULT SPECIFICATION OF #FILE WILL
*         BE DEFINED AS THE NAME OF THE LIBRARY.  IF THE LIBRARY
*         IS THE SYSTEM LIBRARY, #FILE WILL BE NULL.
* 
*         IF THE CALL WAS A BEGIN AND THE PROCEDURE IS ON A 
*         LIBRARY, THE #FILE WILL BE DEFINED AS THE FILE NAME 
*         SPECIFIED ON THE CALL.
  
          SA5    FILENAM
          SX2    FILEPC 
          RJ     =XIOFET     MOVE FILE NAME TO FILEPC 
  
          SX3    237B        REPRIEVE MASK
          RJ     =XCCLRPV    SET REPRIEVE CONDITIONS
  
*         INSURE THAT THE SYSTEM FILE WILL BE RETURNED, WHEN
*         THE PROCEDURE RESIDES ON THE SYSTEM LIBRARY.
  
 OSNOS    IFEQ   HOST,NOS 
          SA1    LIBFIL      DEFAULT LIBRARY NAME 
          SX6    4
          BX7    X1 
          SA6    FILENML
          SA7    FILENAM
 OSNOS    ENDIF 
  
          RJ     =XIOLIB     FIND LIBRARY PARTITION 
  
*         IF THE PROCEDURE WAS NOT FOUND IN THE LIBRARY SET THEN
*         ISSUE AN ERROR MESSAGE
*         IF THE LIBRARY PARTITION IS FOUND THEN GO READ THE FIRST
*         RECORD FROM IT AND ENSURE IT IS A VALID PROCEDURE HEADER. 
* 
*                X5  = RETURN CODE, 0=NOT FOUND.
  
          SX0    FILENAM
          SX3    MSG234 
          LX0    18 
          BX3    X0+X3
          ZR     X5,BRWERR   ERR IF NOT FOUND 
  
*         THE LIBRARY PARTITION WAS FOUND.  CHECK FOR EXECUTE ONLY
*         MODE, THEN READ THE FIRST RECORD. 
  
 OSNOS    IFEQ   HOST,NOS 
  
          SA5    FILEPC      CHECK FOR EXECUTE ONLY MODE
          RJ     =XIOFIL     FILINFO
  
          EX0    X5,FMRD     CHECK READ MODE 1ST
          NZ     X0,BFP3     READ MODE - READ HEADER
  
          SX3    MSG202      PROCFILE IS EXECUTE ONLY 
          EX4    X5,FMEXO 
          NZ     X4,BRWERR   ERR MSG AND ABORT
  
 OSNOS    ENDIF 
          JP     BFP3        GO READ PROC. HEADER 
  
  
 BFP1     BSS 
 ATT      IFNE   IP.ATT,0 
          RJ     =XIOATT     ATTACH FILE
  
 ATT      ELSE
          SX3    MSG230 
          JP     BRWERR 
 ATT      ENDIF 
  
  
*         OPEN THE PROCEDURE FILE 
  
 BFP2     BSS 
          SX3    237B 
          RJ     =XCCLRPV    SET REPRIEVE CONDITIONS
 OSSC2    IFEQ   HOST,SC2 
          OPENM  FILEPC,I-O,N   OPEN PROCEDURE FILE 
          SETFIT FILEPC      SET FIT INCASE FILE WAS ALREADY OPEN 
 OSSC2    ELSE
          SA3    BGLFNC 
          ZR     X3,BFP2.5   NOT CALL-BY-NAME FROM LOCAL FILE 
  
          SX2    FILEPC 
          BKSP   X2,R        POSITION TO PREVIOUS EOR 
  
 BFP2.5   BSS 
 OSSC2    ENDIF 
  
*         DETERMINE IF FILE WAS LEFT AT EOI 
  
          SA5    FILEPC 
          RJ     =XIOFIL     X5 OUTPUT IS STATUS WORD 
  
 OSNOS    IFEQ   HOST,NOS 
          EX0    X5,FMRD     CHECK READ MODE 1ST
          NZ     X0,BFP2.6   READ MODE - SEARCH LIBRARY 
  
          SX3    MSG202      PROCFILE IS EXECUTE ONLY 
          EX4    X5,FMEXO    CHECK MODE OF PROCFILE 
          NZ     X4,BRWERR   ERR MSG AND ABORT
  
 BFP2.6   BSS    0
 OSNOS    ENDIF 
 RLD      IFEQ   IP.RLD,1 
          SA3    BGLFNC      CHECK CALL BY NAME 
          NZ     X3,BFP2.A   NAME CALL - DO NOT SEARCH
  
          SA4    PROCNAM     WAS PROCNAME SPECIFIED ON CALL 
          ZR     X4,BFP2.A   NO PROCNAME - POSITIONAL CALL
  
 OSNOS    IFEQ   HOST,NOS 
          EX1    X5,FMMS           CHECK FOR MASS STORAGE 
          ZR     X1,BFP2.A   NOT MASS STORAGE 
 OSNOS    ENDIF 
  
          SA5    FILEPC      X5 = LFN 
          SX2    A5 
  
          RJ     BRD         READ LIBRARY DIRECTORY 
  
          NG     X1,BFP6     OPLD EXISTS, BUT PROC NOT FOUND
          NZ     X1,BFP3     PROC FOUND - FILE POSITIONED 
  
*         CONTINUE SEQUENTIAL SEARCH - NO DIRECTORY FOUND 
*                                       OR PROCNAM NOT FOUND ON DIRECTOR
  
          SA5    FILEPC 
          RJ     =XIOFIL     GET FILE POSITION
  
 BFP2.A   BSS    0
 RLD      ENDIF 
          EX3    X5,FMEOI    END OF INFORMATION INDICATOR 
          NZ     X3,BFP5.2   EOI SET - POSSIBLE REWIND REQUIRED 
  
  
 BFP3     BSS 
          MX7    0
          SA7    SCATBF2     CLEAR HEADER 
          SA7    CSBUF-1
          SA7    CSBUFOV
          SA7    PROCWSA
 OSNOSBE  IFNE   HOST,SC2 
  
*         MOVE PROCEDURE INFORMATION FROM USER FILE TO WORK AREA CIOPC
*         DATA IS READ TO FIND PROCEDURE NAME TO MATCH (PROCNAM)
  
          READ   FILEPC,R 
 OSNOSBE  ENDIF 
          SX6    B1          =1                                          CL0103 
          SA6    PROCSEQ     SET SO SKIP SEQUENCE NUMBERS IF EXIST       CL0103 
          RJ     BHP         READ FIRST CARD (BHP WILL NOT CALL STRANS) 
  
          NZ     X1,BFP4     IF EMPTY SECTION 
  
          SA1    SCATBF2                                                 CL0103 
          SX6    X1                                                      CL0103 
          SA6    PROCSEQ     NZ IF SEQUENCE NUMBERS EXIST                CL0103 
          SA2    BGCPROC
          SA4    PROCWSA
          MX7    36          6 CHAR. MASK FOR .PROC,
          BX2    X2*X7
          BX4    X4*X7
          BX0    X2-X4
          NZ     X0,BFP4     IF NOT PROC HEADER 
  
          RJ     BHP         ADVANCE TO PERIOD
  
          RJ     BHP         ADVANCE TO     PROC, 
          RJ     BHP         ADVANCE TO     PROCNAME
  
          ZR     X1,BFP3.5   NO ERROR DETECTED BY BHP                    CL0130 
                                                                         CL0130 
          BX7    X3                                                      CL0130 
          SA7    BCHMSG      ERROR CONDITION IN HEADER CARD              CL0130 
                                                                         CL0130 
 BFP3.5   BSS                                                            CL0130 
  
          SA2    ANSSTR 
          SA3    PROCNAM
          BX0    X2-X3
          ZR     X3,BFP7     IF PROC NAME NOT SPECIFIED 
          ZR     X0,BFP7     IF PROCEDURE FOUND 
  
          SA2    ANSVRB 
          SA4    =0LBEGIN 
          BX0    X2-X4
          ZR     X0,BFP4     IF BEGIN VERB CALLED PROCEDURE 
  
          SA4    BFPREW 
          SA3    BGLFNC      CHECK FOR LOCAL FILE NAME CALL 
          NG     X4,BFP7     IF SEARCH OVER USE FIRST PROCEDURE ON FILE 
          NZ     X3,BFP4.0   SEARCH LFN SEQUENTIALLY FOR PROCNAM
  
  
 BFP4     BSS 
          SA4    FILENAM
          SA5    LIBFIL 
          SX3    MSG233 
          BX0    X4-X5
          ZR     X0,BRWERR   ERR IF FROM LIBRARY AND NOT PROC HEADER
  
 BFP4.0   BSS    0
          SX2    FILEPC 
          RJ     =XIOSTS
          SB2    B1+
          ZR     X1,BFP4.1   IF IN MIDDLE OF SECTION
          NG     X1,BFP5.2   END OF INFORMATION DETECTED
  
          SB2    B0+         INPUT FOR IOSKP
 BFP4.1   BSS 
          SX2    FILEPC 
          RJ     =XIOSKP
  
          SX2    FILEPC 
          RJ     =XIOSTS
  
          PL     X1,BFP3     IF NOT AT EOI
  
 BFP5.2   BSS 
          SA5    =0LINPUT 
          SA3    FILENAM
          BX0    X3-X5
          ZR     X0,BFP6  IF FILE IS INPUT
  
*         IF THIS IS THE FIRST PASS, REWIND FILE AND
*         CONTINUE SEARCH FOR PROCEDURE.
  
          SA4    BFPREW 
          SX7    X4-1 
          SA7    BFPREW 
          NG     X4,BFP6     IF NO MORE SEARCHING TO BE DONE
  
          SX2    FILEPC 
          RJ     =XIOREW     REWIND PROCEDURE FILE
  
          JP     BFP3        SEARCH AGAIN 
  
*         THE PROCEDURE HAS NOT BEEN FOUND
  
*         IF CALL BY NAME EXECUTE THE FIRST PROCEDURE ON LFN, 
*         OTHERWISE CLOSE THE FILE (SCOPE 2) AND RETURN IT
*         IF NECESSARY. 
  
  
 BFP6     BSS 
 OSSC2    IFEQ   HOST,SC2 
          CLOSEM FILEPC,N,FILE
 OSSC2    ENDIF 
  
          SX3    MSG231      $PROCEDURE NOT FOUND$
          JP     BRWERR      GO ISSUE MSG AND ABORT 
  
 BFP7     BSS    0           CHECK FOR *I OR *M 
  
*         DETERMINE WHETHER THE PROCEDURE IS NONINTERACTIVE,
*         INTERACTIVE, OR MENU FROM THE PROCEDURE HEADER. 
  
          SA3    ANSSEP 
          SX0    X3-1R* 
          NZ     X0,BFP      NONINTERACTIVE, NON-MENU HEADER
  
          SA5    ANSSTR 
          SA4    ANSCHR 
          BX7    X5 
          BX6    X4 
          SA7    BGPNAM      STORE PROC NAME
          SA6    BGPNML      STORE PNAME LENGTH 
  
          RJ     BHP
  
          SX6    1
          SX3    MSG326      I OR M MUST FOLLOW PNAME*
          SA4    ANSSTR      CHECK CHARACTER AFTER PNAME* 
          SA5    =0LI 
          BX0    X4-X5
          ZR     X0,BFP8     INTERACTIVE HEADER 
  
          SA5    =0LM        CHECK FOR MENU PROC
          BX0    X4-X5
          NZ     X0,BRWERR4        ABORT WITH MSG326
  
          SA6    IACIMP      SET INTERACTIVE MENU PROCESSING
  
  
 BFP8     BSS    0
          SA6    IACIPF      SET INTERACTIVE PROCESSING 
          JP     BFP         RETURN 
  
 BFPREW   BSSZ   1
          TITLE  BHP  -  BEGIN, HEADER PARAMETERS 
**        BHP  -  BEGIN, HEADER PARAMETERS
* 
*         BHP IS CALLED TO GET THE NEXT PARAMETER FROM THE
*         PROCEDURE HEADER.  BHP IS FORCED TO READ THE
*         FIRST CARD OF A HEADER SIMPLY BY THE METHOD OF
*         CLEARING THE BUFFER BEFORE THE CALL.  IF AN EMPTY 
*         SECTION IS IN THE FILE THE FIRST CALL MAY NOT READ
*         ANYTHING.  THAT IS OK.  HOWEVER IF ANY OTHER
*         READ ENCOUNTERS AN EOS IT IS AN ERROR AND WILL ABORT. 
* 
*         EXIT   X1  = 0, IF PARAMETER FOUND, ELSE X1=1.
* 
  
 BHP      BSSZ   1           ENTRY/EXIT 
 BHP1     BSS 
          SA2    SCATBF2
          RJ     =XSTRANS 
  
          SA3    ANSSEP 
          SA4    ANSCHR 
          MX1    0
          MX7    0
          PL     X3,BHP      EXIT IF PARAMETER
  
          NZ     X4,BHP5     IF NO SEPARATOR FOLLOWS STRING 
  
          SA7    PROCWSA
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SA7    A7+B1
          SX6    SCATBF2
          SX3    PROCWSA
          SX4    V.CCCPC
          SX2    FILEPC 
          RJ     =XIORDL     READ NEXT LINE 
  
          SA2    CSBUF-1
          SB3    X2 
          NZ     X1,BHP4     IF NO DATA READ
  
          SA3    PROCSEQ                                                 CL0103 
          ZR     X3,BHP1.2   NO SEQUENCE NUMBERS                         CL0103 
                                                                         CL0103 
          SA2    SCATBF2                                                 CL0103 
          RJ     CCLSSN      SKIP SEQUENCE NUMBERS                       CL0103 
                                                                         CL0103 
          SX6    X7          NUMBER OF CHARACTERS SKIPPED                CL0103 
          ZR     X6,BHP1.2   NO SEQUENCE NUMBERS                         CL0103 
                                                                         CL0103 
          LX6    S.SBTOT-N.SBTOT+1                                       CL0103 
          SA2    SCATBF2+X7  FAKE SCATTER HEADER ADDRESS                 CL0103 
          IX2    X7-X6       DECREMENT NBR OF CHARS IN BUFFER            CL0103 
          SA1    PROCWSA     REPACK TO PROCWSA                           CL0103 
          RJ     STRPKS      PACK SCATBF2 INTO PROCWSA                   CL0103 
                                                                         CL0103 
 BHP1.2   BSS                                                            CL0103 
          SA2    CSBUF-1                                                 CL0103 
          SB3    X2          FLAG FOR EXIT                               CL0103 
          SX1    B0          INDICATE SUCCESSFUL READ                    CL0103 
          SX0    X2-CSBUFL
          NG     X0,BHP2     IF NOT AT END OF BUFFER
  
          SA3    CSBUFOV
          SX2    X2-CSBUFCL 
          SX7    X3+B1
          SA7    A3          CSBUFOV  COUNT SUPPRESSED CARDS
  
 BHP2     BSS 
          SX6    X2+CSBUFCL  ADD ENTRY SIZE FOR ONE CARD
          SA6    CSBUF-1     UPDATE CURRENT LOCATION
          SB7    CSBUF+X2+8 
          SA3    PROCWSA
          SB6    CSBUF+X2 
 BHP3     BSS 
          BX7    X3 
          SA7    B6 
          SB6    B6+B1
          SA3    A3+B1
          LT     B6,B7,BHP3  IF MORE WORDS TO TRANSFER
  
          MX7    0
          SA7    A7+B1       ENSURE ZERO BYTE 
 BHP4     BSS 
          EQ     B0,B3,BHP   IF READ OF FIRST CARD, OK,RETURN,X1=1. 
          ZR     X1,BHP1     IF CARD WAS READ 
  
          SX3    MSG239      $PROCEDURE HEADER NOT TERMINATED$
          JP     BHP
  
 BHP5     BSS 
          SX3    MSG101      $LAST NONBLANK CHAR. MUST BE SEPARATOR$
          SX1    1
          JP     BHP         EXIT 
          TITLE  BEGIN INTERACTIVE PROCESSING 
**        BIP - BEGIN INTERACTIVE PROCESSING
* 
*         VALIDATE THE PROCEDURE HEADER.  BUILD THE 
*         PROCEDURE PARAMETER TABLE (PPT).  AS EACH 
*         PARAMETER NAME IS FOUND BUILD AN ENTRY THAT 
*         CONTAINS THE PARAMETER NAME AND AN OFFSET.
*         THE OFFSET IN THE PPT POINTS TO ENTRIES IN THE
*         TABLE (FPS) FORMAL PARAMETER SPECIFICATIONS.
*         THE PPT ALSO CONTAINS OFFSETS TO THE PVT. 
*         (PATTERN VALUE TABLE)  THE PVT CONTAINS 
*         ENTRIES FOR PATTERNS, VALUES, DESCRIPTION, AND
*         DEFAULT VALUES FOR EACH PARAMETER ON THE
*         PROCEDURE HEADER. 
* 
*         PPTCL = CURRENT LENGTH PPT. 
*         FPSCL = CURRENT LENGTH FPS. 
*         PVTCL = CURRENT LENGTH PVT. 
  
  
 BIP      BSSZ   1                 ENTRY/EXIT 
          SA1    IACIPF 
          SA2    IACIMP 
          ZR     X1,BIP            NOT INTERACTIVE PROC 
          NZ     X2,BIP            MENU PROC
  
          SA3    ANSSEP 
          PL     X3,BIP000         SEPARATOR FOUND AFTER NAME 
  
          RJ     BHP               GET NEXT PROC CARD 
          NZ     X1,BRWERR5        HEADER NOT TERMINATED CORRECTLY
  
 BIP000   BSS    0
          SX6    1
          SA6    PVTCL             START PVT AT 1 
          MX7    0                 CLEAR
          SA7    BGEQMD            CLEAR EQ MODE FLAG 
          SA7    FPSCL
          SX6    -LE.PPT
          SA7    BGSFPH 
          SA6    PPTCL
          SA7    IACLCP 
  
          ERRZR  W.PPVAL-W.PPMTP   CLEAR TITLE PPT ENTRY
          SA7    PPT+W.PPVAL-LE.PPT 
          SA7    PPT+W.PPMTP-LE.PPT 
          SA3    ANSSEP 
          SX0    X3-1R" 
          SX7    X3-70B            CHECK FOR APOSTROPHE 
          ZR     X7,BIP000A        TITLE WITH APOSTROPHE DELIMITER
  
          NZ     X0,BIP00          NO TITLE STRING
  
 BIP000A  BSS    0
          BX6    X3 
          SX7    1
          SA6    ANSPSP            STORE QUOTE SEPARATOR
          SA7    IACDSF 
          RJ     BHP               READ TITLE 
          NZ     X1,BRWERR5        NO TERMINATOR ON TITLE 
  
          SA5    ANSCHR 
          SX0    X5-V.PSIZ-1
          SX3    MSG384 
          PL     X0,BRWERR4        TITLE TOO LONG 
  
          SA4    ANSSTR 
          SA1    PVTCL
          ERRZR  W.PPVAL-W.PPMTP
          MX0    0
          OX6    X0,X1,PPVAL
          SA6    PPT+W.PPVAL-LE.PPT 
          MX7    N.PPMTP
          LX7    S.PPMTP+1         INDICATE TITLE AVAILABLE 
          SA7    PPT-LE.PPT+W.PPMTP 
          SA3    =0LDSCRTN
          BX6    X3 
          SA6    IACPVID
          RJ     =XCCLWPV          WRITE TITLE TO PVT 
  
          RJ     BHP               WHAT FOLLOWS TITLE 
          NZ     X1,BRWERR5        HEADER NOT TERMINATED
  
          SX3    MSG386            EXPECTING COMMA
          SA1    ANSCHR 
          NZ     X1,BRWERR4        ERR MSG - STRING AFTER TITLE 
  
 BIP00    BSS    0                 .PROC,PNAME*I HAS BEEN READ
          SA1    PPTCL             UPDATE CURRENT LENGTH OF PPT 
          SX7    X1+LE.PPT
          SA7    PPTCL
          NG     X1,BIP005         IF NO PARAMETERS PROCESSED YET 
  
          SA3    PPT+W.PPNDA+X1 
          EX2    X3,PPNDA 
          ZR     X2,BIP005         IF NO *N OR *D CHECKLIST PATTERN 
  
          ERRNZ  W.PPNDA-W.PPNO    CODE DEPENDS ON VALUES 
          LX3    59-S.PPNO
          PL     X3,BIP005         IF *N OR *D ONLY 
  
          ERRNZ  W.PVDND-W.PVSIZ   CODE DEPENDS ON VALUES 
          SA3    PVT+W.PVSIZ+X2 
          EX5    X3,PVSIZ 
          LX3    59-S.PVDND 
          NG     X3,BIP004         IF *D SKIP VALIDITY CHECK
  
          SB7    B0 
          BX6    X1                SAVE THE CURRENT PPT OFFSET
          SA6    BGPWPL 
          SA4    PVT+W.PVSTR+X2    GET ADDRESS AND FIRST WORD OF VALUE
          RJ     BVK               VALIDATE *N TO *K PVT ENTRY
  
          SB5    B0 
          EQ     B6,B0,BIP001      IF *N MATCHED NO *K ENTRY OR PATTERN 
  
          SB5    A2 
          EQ     B6,B1,BIP001      IF THERE WAS NO REPLACEMENT VALUE
  
          SB7    B5 
          SB5    B0 
 BIP001   BSS    0
          RJ     BVP               VALIDATE *N TO ALL PVT ENTRIES 
  
          SX7    B5 
          EQ     B6,B0,BIP002      IF *N MATCHED NO CHECKLIST PATTERN 
  
          SB5    A2 
          EQ     B6,B1,BIP002      IF MATCH WITH NO REPLACEMENT VALUE 
  
          SB7    B5 
          SB5    X7 
 BIP002   BSS    0
          EQ     B5,B0,BIP005      IF NO MATCH WITHOUT REPLACEMENT
  
          EQ     B7,B0,BIP003      IF NO MATCH WITH REPLACEMENT 
  
          SX6    B5 
          SX7    B7 
          MX0    -18
          BX6    -X0*X6 
          BX7    -X0*X7 
          IX6    X6-X7
          PL     X6,BIP005         IF MATCH WITH REPLACEMENT IS EARLIER 
  
 BIP003   BSS    0
          SA1    BGPWPL            RESTORE CURRENT PPT OFFSET 
          SA3    PPT+W.PPNDA+X1 
          EX2    X3,PPNDA 
          SA3    PVT+W.PVDND+X2    FLAG *N AS DISPLAYABLE 
          MX6    N.PVDND
          LX6    S.PVDND+1
          BX6    X3+X6
          SA6    A3 
          ERRNZ  W.PVDND-W.PVSIZ   CODE DEPENDS ON VALUES 
          EX5    X3,PVSIZ 
 BIP004   BSS    0
          RJ     BIPL              CHECK INTERACTIVE PARAMETER LENGTH 
  
 BIP005   BSS    0
          SA4    ANSSEP            GET SEPARATOR AFTER *I 
          SX0    X4-1R. 
          ZR     X0,BIP            TERMINATOR FOUND - RETURN
  
          SX6    X4-1R, 
          ZR     X6,BIP010         COMMA FOUND-READ PARAMETER 
  
          SX7    X4-1R/ 
          NZ     X7,BIP005A        CHECK FOR BACK SLASH 
  
          SX6    1
          SA6    BGSFPH            SLASH FOUND ON PROC HEADER 
          SA6    BGEQMD            SET EQUIVALENCE MODE 
          JP     BIP010            READ PARAMETER 
  
 BIP005A  BSS    0                 CHECK BACK SLASH 
          SX3    MSG322            ILLEGAL CHARACTER FOLLOWING PARAM
          SX0    X4-1R\ 
          NZ     X0,BRWERR5        EXPECTING ,/\ OR TERMINATOR
  
          MX6    1
          SA6    BGEQMD            SET EQ MODE FLAG 
  
  
  
 BIP010   BSS    0
  
          RJ     BHP               GET PARAMETER NAME 
          NZ     X1,BRWERR5        HEADER NOT TERMINATED
  
          MX6    0                 CLEAR LITERAL FLAG IN PPT
          SA1    ANSLIT 
          SA5    ANSCHR 
          SA4    ANSSTR 
          ZR     X1,BIP015         IF KEYWORD IS NOT A LITERAL
  
          SA5    ANSEVLC           FORMAL PARAMETER IS A LITERAL
          SA4    ANSEVL            STORE EVALUATED FORM IN PPT
          MX6    N.PPLIT           SET LITERAL FLAG IN PPT
          LX6    S.PPLIT+1
 BIP015   BSS    0
          ZR     X5,BIP005         IGNORE NULL PARAMETER
  
          SX0    X5-V.FPC-1 
          SX3    MSG235            PARAMETER EXCEEDS 10 CHARACTERS
          PL     X0,BRWERR4        KEYWORD NAME TOO LARGE 
          BX7    X4 
          MX0    -6 
          SX3    MSG240            * MAY NOT APPEAR IN PARAMETER NAME 
 BIP016   LX4    6
          BX1    -X0*X4 
          SX2    X1-1R* 
          ZR     X2,BRWERR4        IF NAME CONTAINS * 
          BX4    X4-X1
          NZ     X4,BIP016         IF MORE TO CHECK 
  
  
  
                                   CREATE NEW PPT ENTRY 
          SA1    PPTCL             STORE FORMAL PARAMETER IN PPT
          SX0    X1-L.PPT 
          SX3    MSG238            FORMAL PARAMETER LIMIT EXCEEDED
          PL     X0,BRWERR4        IF TOO MANY KEYWORDS DEFINED 
  
          SA7    PPT+W.PPFPN+X1 
          SA2    PPT+W.PPLIT+X1    UPDATE FPS OFFSET FIELDS IN PPT
          ERRNZ  W.PPLIT-W.PPDO1
          ERRNZ  W.PPLIT-W.PPDO2
          ERRNZ  W.PPLIT-W.PPFPC
          ERRNZ  W.PPLIT-W.PPLCP
          ERRNZ  W.PPLIT-W.PPEMF
          LX5    S.PPFPC-N.PPFPC+1
          BX0    X6+X5
          SA3    FPSCL             REPLACEMENT VALUE OFFSET 
          MX7    -N.PPDO1 
          ERRNZ  S.PPDO1-N.PPDO1+1
          BX5    -X7*X3 
          BX6    X5+X0
          SX4    X3+LE.FPS         CALL VALUE OFFSET
          BX3    X4 
          LX4    S.PPDO2-N.PPDO2+1
          BX7    X6+X4
          SA5    BGEQMD 
          ZR     X5,BIP017         IF NOT IN EQUIVALENCE MODE 
  
          MX5    N.PPEMF
 BIP017   BSS    0
          LX5    S.PPEMF+1
          BX6    X5+X7
          SA6    A2                STORE NEW PPT ENTRY
          SX6    X3+LE.FPS         UPDATE CURRENT FPS OFFSET
          SA6    A3 
          SA4    PVTCL             PUT CURRENT PVT OFFSET IN PPT
          SA2    PPT+W.PPVAL+X1 
          MX3    0
          OX7    X3,X4,PPVAL
          SA7    A2 
          SA3    ANSSEP 
          SX0    X3-1R"            BEGINNING OF DESCRIPTION 
          SX6    X3-1R[ 
          SX7    X3-70B            CHECK FOR APOSTROPHE 
          ZR     X7,BIP17A         DESCRIPTION STRING ONLY
          ZR     X0,BIP017A        READ DESCRIPTION STRING
          NZ     X6,BIP025         NO DESCRIPTION 
  
*         THE [ ] BRACKETS INDICATES THAT CCL WILL USE ONLY THE 
*         TEXT IN THE DESCRIPTION STRING AND NOT  -ENTER KEYWORD- . 
*         SET PPDSO FLAG IN THE PPT TO INDICATE THIS TYPE OF DESCRIPTION
  
*         APOSTROPHE BEHAVES THE SAME AS [] 
  
  
 BIP17A   BSS    0
          MX6    1
          LX6    S.PPDSO+1         SET DESCRIPTION STRING ONLY FLAG 
          SA2    PPT+W.PPDSO+X1 
          BX7    X2+X6
          SA7    A2 
  
 BIP017A  BSS    0                 READ DESCRIPTION STRING
          BX6    X3 
          SA6    ANSPSP            STORE QUOTE OR BRACKET 
  
          MX7    1                 SET DESCRIPTION FLAG 
          SA7    IACDSF            FLAG RESET BY STRANS 
          SA2    SCATBF2
  
          RJ     =XSTRANS          READ DESCRIPTION STRING
  
          SA5    ANSCHR            CHECK LENGTH OF DESCRIPTION
          SA3    ANSSEP 
          SX0    X3-1R] 
          SX7    X3-70B            CHECK FOR APOSTROPHE 
          ZR     X7,BIP017B        SKIP LENGTH CHECK
          ZR     X0,BIP017B        SKIP LENGTH CHECK
  
 OSSC2    IFEQ   HOST,SC2 
          SX0    X5-V.SCS-1 
 OSSC2    ELSE
          SX0    X5-V.PSIZ-1
 OSSC2    ENDIF 
          SX3    MSG328            STRING EXCEEDS 40 CHARACTERS 
          PL     X0,BRWERR4        DESCRIPTION TOO LARGE
  
 BIP017B  BSS    0
          ZR     X5,BIP020         NULL PROMPT STRING 
  
          SA1    PPTCL             SET DESCRIPTION AVAILABLE FLAG 
          SA2    PPT+W.PPDES+X1 
          MX3    N.PPDES
          LX3    S.PPDES+1
          BX7    X2+X3
          SA7    A2 
          SA3    =0LDSCRTN
          BX6    X3 
          SA6    IACPVID
          SA4    ANSSTR 
  
          RJ     =XCCLWPV          WRITE DESCRIPTION TO PVT 
  
 BIP020   BSS    0
  
          RJ     BHP               GET SEPARATOR FOLLOWING DESCRIPTION
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA1    ANSCHR 
          SX3    MSG329            BAD SYNTAX AFTER DESCRIPTION 
          NZ     X1,BRWERR4        EXPECTING = OR TERMINATOR
  
 BIP025   BSS    0
          SA2    PPTCL
          MX6    0
          SA3    PPT+W.PPNO+X2     CLEAR PPNO FIELD FOR THIS PARAMETER
          OX7    X3,X6,PPNO 
          SA7    A3 
          SA4    ANSSEP            LOOK FOR PARAMETER CHECK LIST
          SX0    X4-1R= 
          ZR     X0,BIP030         READ CHECKLIST 
  
          SA3    =0LA              *A IS DEFAULT CHECKLIST
          MX5    0
          MX4    0
          SX6    40 
          OX7    X3,X6,PVMAX       STORE DEFAULT *A MAX RANGE 
          SA7    IACPVID           STORE *A ATTRIBUTE ID WORD 
  
          RJ     =XCCLWPV          CREATE PVT ENTRY FOR THIS PARAMETER
          RJ     BIPN              *N NOT THE ONLY CHECKLIST PATTERN
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    PPTCL
          SX5    40                STORE LENGTH OF 40 FOR *A VALUE
          RJ     BIPL              CHECK INTERACTIVE PARAMETER LENGTH 
  
 SDOVL    ENDIF 
          JP     BIP00             READ NEXT PARAMETER
  
  
  
  
 BIP030   BSS    0
  
          RJ     BHP               LOOK FOR BEGINNING OF CHECK LIST 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA4    ANSSEP            FIND BEGINNING OF CHECK LIST 
          SA1    ANSCHR 
          SX3    MSG321            INVALID CHECK LIST 
          SX5    X4-1R( 
          NZ     X1,BRWERR4        EXPECTING ( BEGINNING OF CHECKLIST 
          NZ     X5,BRWERR5        EXPECTING BEGINNING OF CHECKLIST 
  
 BIP040   BSS    0                 PATTERN=VALUE SYNTAX PROCESSING
  
          RJ     BHP               READ PATTERN 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA3    ANSCHR 
          SA5    ANSLIT 
          SA4    ANSSTR            MUST BE NON-LITERAL, NON-BLANK 
          ZR     X3,BIP300         IF A NULL PATTERN
          NZ     X5,BIP300         IF A LITERAL 
          EX0    X4,CHATT          EXTRACT CHECKLIST ATTRIBUTE
          SA3    =2L*N
          SX5    X0-2R*A
          ZR     X5,BIP080         PROCESS *A ATTRIBUTE 
  
          BX5    X3-X4
          ZR     X5,BIP100         PROCESS *N ATTRIBUTE 
  
          SA3    =2L*K
          SX5    X0-2R*F
          ZR     X5,BIP120         PROCESS *F ATTRIBUTE 
  
          BX5    X3-X4
          ZR     X5,BIP140         GO PROCESS *K ATTRIBUTE
  
          SA3    =2L*D
          SX5    X0-2R*P
          ZR     X5,BIP130         IF *P ATTRIBUTE
  
          BX6    X3-X4
          ZR     X6,BIP100         IF *D ATTRIBUTE
  
          SX6    X0-2R*S
          ZR     X6,BIP160         VALIDATE *S ATTRIBUTE
  
 OSNOSBE  IFNE   HOST,SC2 
          SX6    X0-2R*R
          ZR     X6,BIP150         IF *R ATTRIBUTE
  
 OSNOSBE  ENDIF 
  
          JP     BIP300            UNRECOGNIZED - TREAT AS ALPHANUMERIC 
  
  
  
  
  
 BIP080   BSS    0                 PROCESS *A ATTRIBUTE 
          RJ     BIPR              VALIDATE RANGE PORTION OF ATTRIBUTE
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SA3    =0LA 
          SA2    =0LAVALUE
  
*         (X2) = PVID IF REPLACEMENT VALUE FOR THIS ATTRIBUTE.
*         (X3) = PVID IF NO REPLACEMENT VALUE FOR THIS ATTRIBUTE. 
  
 BIP090   BSS    0                 CREATE PVT CONTROL WORD
          ERRNZ  59-S.PVID
          SA1    IACPVID
          MX7    N.PVID 
          BX0    -X7*X1 
          BX6    X0+X3
          SA6    IACPVID
          MX5    0
          SA3    ANSSEP 
          SX0    X3-1R= 
          NZ     X0,BIP210         STORE ATTRIBUTE DEFAULT
  
  
*         (X2) = PVID - ATTRIBUTE HAS A REPLACEMENT VALUE.
  
 BIP095   BSS    0
          ERRNZ  59-S.PVID
          SA1    IACPVID
          MX7    N.PVID 
          BX0    -X7*X1 
          BX6    X0+X2
          SA6    IACPVID
  
          RJ     BHP               READ VALUE FOLLOWING ATTRIBUTE 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
*         NULL AND NON-NULL VALUES ARE WRITTEN TO THE PVT 
*         CHECK NEXT SEPARATOR 1ST ON NULL VALUES 
  
          SA4    ANSCHR 
          SA1    ANSSEP 
          SX3    MSG327            EXPECTING VALUE AFTER PATTERN= 
          NZ     X4,BIP200         PUT NON-NULL VALUE IN PVT
  
          SX0    X1-1R, 
          SX5    X1-1R) 
          SX6    X1-1R#            #DATA #FILE #PRIMARY 
          ZR     X0,BIP200         PUT NULL VALUE IN PVT
          ZR     X6,BIP200         CONVERT #DATA AND #FILE
          NZ     X5,BRWERR5        NO VALUE - JUST BAD SEP
          JP     BIP200            STORE VALUES IN PVT
  
  
  
  
*         (X5) .EQ. 0 IF PROCESSING *N ATTRIBUTE. 
*         (X5) .NE. 0 IF PROCESSING *D ATTRIBUTE. 
  
 BIP100   BSS    0                 PROCESS *D OR *N ATTRIBUTE 
          SA1    PPTCL
          SA4    PPT+W.PPNDA+X1 
          SX3    MSG333N           DUPLICATE *N/*D SPECIFICATION
          MX0    N.PPNDA
          LX0    S.PPNDA+1
          BX6    X4*X0
          NZ     X6,BRWERR4        IF *N OR *D PREVIOUSLY SPECIFIED 
  
          ZR     X5,BIP110         IF PROCESSING *N ATTRIBUTE 
  
          MX6    N.PVDND           FORCE DEFAULT TO BE DISPLAYED
          LX6    S.PVDND+1
BIP110    BSS    0
          SA6    IACPVID           PRESET NULL DEFAULT DISPLAY FLAG 
          SA3    PVTCL
          OX7    X4,X3,PPNDA
          SA7    A4                STORE PVT OFFSET FOR *N ATTRIBUTE
          SA2    =0LNVALUE
          SA3    ANSSEP 
          SX0    X3-1R= 
          ZR     X0,BIP095         IF *N OR *D WITH SUBSTITUTION VALUE
  
          SA3    PPT+W.PPFPC+X1    GET PARAMETER NAME SIZE
          SA4    PPT+W.PPFPN+X1    GET PARAMETER NAME 
          SA1    IACPVID
          EX5    X3,PPFPC 
          ERRNZ  59-S.PVID         CODE DEPENDS ON POSITION IN WORD 
          MX7    N.PVID 
          BX0    -X7*X1 
          BX6    X0+X2
          SA6    A1 
          JP     BIP210            STORE DEFAULT IN PVT 
  
  
  
  
  
 BIP120   BSS    0                 PROCESS *F ATTRIBUTE 
          RJ     BIPR              VALIDATE RANGE PORTION OF ATTRIBUTE
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SA3    =0LF 
          SA2    =0LFVALUE
          JP     BIP090            CREATE PVT ENTRY 
  
  
  
  
 BIP130   BSS    0                 PROCESS *P ATTRIBUTE 
          RJ     BIPR              VALIDATE RANGE PORTION OF ATTRIBUTE
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SA3    =0LP 
          SA2    =0LPVALUE
          JP     BIP090            CREATE PVT ENTRY 
  
  
  
  
 BIP140   BSS    0                 PROCESS *K ATTRIBUTE 
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SX3    MSG333            DUPLICATE *K SPECIFICATION 
          SA1    PPTCL             *K PREVIOUSLY SPECIFIED FOR PARAMETER
          SA4    PPT+W.PPKAP+X1 
          MX0    N.PPKAP
          LX0    S.PPKAP+1
          BX6    X4*X0
          NZ     X6,BRWERR4        *K ATTRIBUTE PREVIOUSLY SPECIFIED
  
          SX0    B1 
          SA6    IACPVID           CLEAR PVID WORD
          OX7    X4,X0,PPKAP       INDICATE *K ATTRIBUTE PROCESSED
          SA7    A4+
          SA3    =0LK 
          SA2    =0LKVALUE
 SDOVL    IFNE   IP.SDO,0 
  
*         STORE THE LENGTH OF LONGEST CHECKLIST PATTERN 
  
          SA1    PPTCL
          SA4    PPT+W.PPFPC+X1 
          EX5    X4,PPFPC          SIZE OF FORMAL PARAMETER NAME
          RJ     BIPL              CHECK INTERACTIVE PARAMETER LENGTH 
  
 SDOVL    ENDIF 
          JP     BIP090            CREATE PVT ENTRY 
  
  
  
*         PROCESS THE *R ATTRIBUTE (RESTRICTED PARAMETER).
  
 OSNOSBE  IFNE   HOST,SC2 
 BIP150   BSS    0                 PROCESS *R ATTRIBUTE 
          SX3    MSG333R           *DUPLICATE *R PATTERN IN CHECKLIST*
          SA1    PPTCL
          SA4    PPT+W.PPRAP+X1 
          EX6    X4,PPRAP 
          NZ     X6,BRWERR4        IF *R ALREADY PROCESSED
  
          SX6    B1 
          SA6    RSTRICT           INDICATE PROCEDURE HAS *R ATTRIBUTE
          OX7    X4,X6,PPRAP       INDICATE PARAMETER HAS *R ATTRIBUTE
          SA7    A4+
          SX3    MSG337            $EXPECTING , OR ) AFTER PATTERN$ 
          JP     BIP250            CHECK FOR PROPER SEPARATOR 
  
 OSNOSBE  ENDIF 
  
  
*         INTERPRET AND STORE *S ATTRIBUTE FROM THE HEADER CHECKLIST. 
  
 BIP160   BSS    0                 VALIDATE *SN(SET)
          RJ     BIPR              VALIDATE RANGE PORTION OF ATTRIBUTE
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SA1    IACPVID
          SA4    =0LS              PUT S ATTRIBUTE IN PVT ID WORD 
          ERRNZ  59-S.PVID
          MX7    N.PVID 
          BX0    -X7*X1 
          BX6    X0+X4
          SA6    IACPVID
          SA4    ANSSEP 
          SX0    X4-1R(            FIND LEFT PAREN *SN(SET) 
          ZR     X0,BIP170         READ SET FROM *SN(SET) 
  
          SX0    X4-1R/            CHECK FOR SET OF THE FORM *SN/M
          SX3    MSG485            USE *SN(SET) OR *SN/M
          NZ     X0,BRWERR5 
  
*         READ ABBREVIATIONS FOR *SN/M WHERE
*            M = A   ALPHABETIC SET 
*                D   DECIMAL SET
*                B   OCTAL SET
*                AD  ALPHANUMERIC SET 
*                AB  ALPHA AND OCTAL SET
  
          SX7    B0+               MAKE * A SEPARATOR HERE TEMPORARILY
          SA7    ANSMDE 
          RJ     BHP               READ ABBREVIATION
  
          MX7    -0                MAKE * NOT A SEPARATOR AGAIN 
          SA7    ANSMDE 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
          SX2    X3-1R* 
          SA1    ANSSTR 
          SA4    =27LABCDEFGHIJKLMNOPQRSTUVWXYZ*
          SX5    26 
          SA3    =0LA 
          BX0    X1-X3
          ZR     X0,BIP165         STORE ALPHA STRING IN PVT
  
          SA4    =11L0123456789*
          SX5    10 
          SA3    =0LD 
          BX0    X1-X3
          ZR     X0,BIP165         STORE DECIMAL STRING IN PVT
  
          SA4    =9L01234567* 
          SX5    8
          SA3    =0LB 
          BX0    X1-X3
          ZR     X0,BIP165         STORE OCTAL STRING 
  
          SA4    =37LABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789*
          SX5    36 
          SA3    =0LAD
          BX0    X1-X3
          ZR     X0,BIP165         STORE ALPHANUMERIC STRING
  
          SA4    =35LABCDEFGHIJKLMNOPQRSTUVWXYZ01234567*
          SX5    34 
          SA3    =0LAB
          BX0    X1-X3
          ZR     X0,BIP165         STORE ALPHA AND OCTAL STRING 
  
          SX3    MSG486            BAD ABBREVIATION 
          JP     BRWERR4
  
 BIP165   BSS    0                 WRITE ABBREVIATED *S TO PVT
          NZ     X2,BIP166         IF NOT INCLUDING * 
  
          SX5    X5+1 
 BIP166   BSS    0
          RJ     =XCCLWPV          WRITE PATTERN VALUE
          SA3    ANSSEP 
          SX0    X3-1R* 
          NZ     X0,BIP167         IF NOT A * SEPARATOR 
  
          RJ     BHP
  
          SA3    ANSSEP 
          NZ     X1,BRWERR5        IF NO SEPARATOR AFTER *
  
 BIP167   BSS    0
          SX0    X3-1R= 
          SA2    =0LSVALUE
          ZR     X0,BIP095         PUT DEFAULT VALUE IN PVT 
  
          SX3    MSG330            COMMA OR ) MUST FOLLOW PATTERN 
          JP     BIP250            CHECK WHAT FOLLOWS *S
  
 BIP170   BSS    0                 READ SET FROM *SN(SET) 
          RJ     BHP               READ SET STRING
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA3    ANSLIT 
          SA5    ANSCHR 
          SA4    ANSSTR            NON-LITERAL SET STRING 
          ZR     X3,BIP180         PUT STRING IN PVT
  
          SA5    ANSEVLC
          SA4    ANSEVL            LITERAL STRING 
 BIP180   BSS    0                 MOVE SET TO PVT
  
          SX3    MSG332            WRITE SET AS *SN(SET)
          ZR     X5,BRWERR5        NULL SET *SN() 
  
*         CHECK LENGTH OF STRING
  
          SX0    X5-V.SCS-1 
          SX3    MSG336 
          PL     X0,BRWERR4        STRING EXCEEDS 40 CHARACTERS 
          RJ     =XCCLWPV          WRITE *S ATTRIBUTE TO PVT ENTRY
  
          SA4    ANSSEP            CHECK FOR CLOSING PAREN *SN(SET) 
          SX3    MSG332            WRITE SET AS *SN(SET)
          SX6    X4-1R) 
          NZ     X6,BRWERR5        MISSING PAREN *SN(SET
  
          RJ     BHP               GET SEPARATOR FOLLOWING *SN(SET) 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA1    ANSCHR 
          SX3    MSG330            EXPECTING , = OR ) AFTER PATTERN 
          NZ     X1,BRWERR4        STRING AFTER SET *SN(SET)STRING
  
          SA3    ANSSEP 
          SX0    X3-1R= 
          SA2    =0LSVALUE
          ZR     X0,BIP095         PUT PATTERN VALUE IN PVT 
  
          SX3    MSG330            COMMA OR ) MUST FOLLOW PATTERN 
          JP     BIP250            CHECK FOR , OR ) 
  
  
  
  
  
  
  
  
  
 BIP200   BSS    0                 STORE VALUES IN PVT
          SA4    ANSSTR 
          SA5    ANSCHR 
          SA1    ANSSEP            CHECK FOR #DATA AND #FILE
          SX0    X1-1R# 
          NZ     X5,BIP205         SPECIAL NAME NOT FOUND 
  
          NZ     X0,BIP205         VALUE IS NOT #DATA OR #FILE
  
          RJ     RSN               RECOGNIZE SPECIAL NAME 
          NZ     X3,BRWERR4        ERR IN SPECIAL NAME (MSG326) 
  
          BX4    X1 
          JP     BIP210            STORE SPECIAL NAME IN PVT
  
  
 BIP205   BSS    0
          SA3    ANSLIT 
          ZR     X3,BIP210         PROCESS NON - LITERAL VALUES 
  
          SA1    PPTCL             CHECK PPT PARAMETER LITERAL FLAG 
          SA2    PPT+W.PPLIT+X1 
          LX2    59-S.PPLIT 
          NG     X2,BIP210         FORMAL PARAMETER NOT A LITERAL 
  
          SA5    ANSEVLC           USE EVALUATED FORM 
          SA4    ANSEVL 
  
 BIP210   BSS    0
  
*         CHECK LENGTH OF VALUE 
  
          SX0    X5-V.SCS-1 
          SX3    MSG336 
          PL     X0,BRWERR4        VALUE EXCEEDS 40 CHARACTERS
  
          RJ     =XCCLWPV          WRITE VALUE TO PVT ENTRY 
  
          SX3    MSG331            COMMA OR ) MUST FOLLOW PATTERN VALUE 
 BIP250   BSS    0                 EVALUATE SEPARATOR FOLLOWING VALUE 
          SA5    ANSSEP 
          SX0    X5-1R,            IF A COMMA IS FOUND
          ZR     X0,BIP040         GO GET NEXT PATTERN=VALUE
  
          SX6    X5-1R)            OTHERWISE SEPARATOR SHOULD BE )
          NZ     X6,BRWERR5        EXPECTING , OR ) 
  
          RJ     BHP               END OF CHECKLIST, GET NEXT SEP 
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA5    ANSCHR 
          SX3    MSG322            EXTRA GARBAGE FOLLOWING CHECKLIST
          NZ     X5,BRWERR4        STRING FOLLOWS CHECKLIST 
  
          SA5    ANSEVLC           SAME FOR LITERALS
          NZ     X5,BRWERR4        LITERAL STRING AFTER CHECKLIST 
  
          JP     BIP00             GO PROCESS NEXT PARAMETER
  
  
  
  
 BIP300   BSS    0                 PROCESS NON-ATTRIBUTE PATTERNS 
          RJ     BIPN              *N NOT ONLY CHECKLIST PATTERN
          SA3    ANSLIT 
          SA4    ANSSTR 
          SA5    ANSCHR 
          ZR     X3,BIP310         STRING IS NOT A LITERAL
  
          SA1    PPTCL             CHECK PARAMETER LITERAL FLAG 
          SA2    PPT+W.PPLIT+X1 
          LX2    59-S.PPLIT 
          NG     X2,BIP310         FORMAL PARAMETER WAS A LITERAL 
  
          SA4    ANSEVL            USE EVALUATED FORM 
          SA5    ANSEVLC
  
 BIP310   BSS    0
          SA1    ANSSEP            CHECK FOR #DATA #FILE
          SX0    X1-1R# 
          NZ     X5,BIP350         NOT A SPECIAL NAME 
          NZ     X0,BIP350         NOT A SPECIAL NAME 
  
          RJ     RSN               RECOGNIZE SPECIAL NAME 
          NZ     X3,BRWERR4        ERR IN SPECIAL NAME (MSG326) 
  
          BX4    X1 
  
 BIP350   BSS    0
          SA3    =0LPATERN
          BX7    X3 
          SA7    IACPVID           STORE PATTERN ID 
  
*         CHECK LENGTH OF PATTERN 
  
          SX0    X5-V.SCS-1 
          SX3    MSG336 
          PL     X0,BRWERR4        PATTERN EXCEEDS 40 CHARACTERS
  
          RJ     =XCCLWPV          WRITE PATTERN TO PVT ENTRY 
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    PPTCL
          RJ     BIPL              CHECK INTERACTIVE PARAMETER LENGTH 
  
 SDOVL    ENDIF 
  
          SA4    ANSSEP 
          SX0    X4-1R=            DOES VALUE FOLLOW PATTERN P=V
          SA2    =0LVALUE 
          ZR     X0,BIP095         READ PATTERN VALUE 
          SX3    MSG330            EXPECTING , OR ) AFTER PATTERN 
          JP     BIP250            CHECK SEPARATOR
  
  
  
  
  
 BIPL     EJECT 
**        BIPL - BEGIN, INTERACTIVE PARAMETER LENGTH CHECK. 
* 
*         COMPARES LENGTH OF CURRENT PARAMETER CHECKLIST PATTERN TO 
*         PREVIOUS LONGEST AND STORES THE CURRENT LENGTH IF LONGER. 
* 
*         ENTRY  (X1) = OFFSET OF *PPT* ENTRY FOR THIS PARAMETER. 
*                (X5) = LENGTH OF CURRENT CHECKLIST PATTERN.
* 
*         EXIT   LENGTH OF LONGEST CHECKLIST PATTERN FOR THIS PARAMETER 
*                AND FOR ALL PARAMETERS STORED. 
* 
*         USES   X - 1, 4, 5, 6, 7. 
*                A - 1, 4, 6, 7.
  
 BIPL     SUBR                     ENTRY/EXIT 
  
 SDOVL    IFNE   IP.SDO,0 
          SA4    PPT+W.PPLCP+X1 
          EX6    X4,PPLCP          LENGTH OF LONGEST CHECKLIST PATTERN
          IX7    X6-X5
          PL     X7,BIPLX          IF LONGEST ALREADY STORED
  
          SA1    IACLCP            LONGEST CHECKLIST PATTERN OVERALL
          BX6    X5 
          OX7    X4,X5,PPLCP
          SA7    A4 
          IX7    X1-X6
          PL     X7,BIPLX          IF LONGEST OVERALL ALREADY STORED
  
          SA6    A1 
 SDOVL    ENDIF 
  
          JP     BIPLX             RETURN 
          EJECT 
**        BIPN   -  BEGIN INTERACTIVE PROCESSING (N ATTRIBUTE)
* 
* 
*         BIPN SETS PPNO FIELD IN THE PARAMETER PPT ENTRY AND IN THE
*         TITLE PPT ENTRY.  THIS INDICATES THAT *N IS NOT THE ONLY
*         CHECKLIST PATTERN FOR THAT PARAMETER AND PROMPTING CAN
*         OCCUR FOR THE PROCEDURE PARAMETERS. 
* 
*         ENTRY  -  NONE
* 
*         EXIT   -  NONE
* 
* 
 BIPN     BSSZ   1                 ENTRY/EXIT 
          SA1    PPTCL
          SA5    PPT+W.PPNO+X1     GET PARAMETER ENTRY
          SX6    1
          OX7    X5,X6,PPNO 
          SA7    A5 
          SA1    PPT+W.PPNO-LE.PPT
          SX6    1
          OX7    X1,X6,PPNO        SET PPNO IN TITLE PPT ENTRY
          SA7    A1 
          JP     BIPN              RETURN 
  
  
 BIPR     TITLE  BEGIN INTERACTIVE PROCESSING RANGE SPECIFICATION 
**        BIPR   -  BEGIN INTERACTIVE PROCESSING RANGE SPECIFICATION
* 
* 
*         BIPR PARSES THE RANGE SPECIFICATION FROM THE PROCEDURE
*         HEADER CHECKLIST FOR *A, *F, *P, AND *S ATTRIBUTES.  THE
*         MINIMUM AND MAXIMUM (I.E. MIN..MAX) FROM THE RANGE ARE
*         STORED IN THE PVT CONTROL WORD FOR THESE ATTRIBUTES.
*         LATER BVE WILL CHECK THESE AGAINST THE CALL VALUE.
*         DEFAULTS ARE -             MINIMUM   EXPLICIT IMPLICIT
*                                              MAXIMUM   MAXIMUM
*                          *A           0       V.SCS      40 
*                          *F AND *P    1         7         7 
*                          *S           1       V.SCS      40 
* 
*         ENTRY  (ANSSTR) = CHECKLIST ATTRIBUTE, INCLUDING FIRST VALUE
*                            OF MIN..MAX SPECIFICATION IF ANY.
* 
*         EXIT   TO BIP300 IF ATTRIBUTE CONTAINS SOMETHING WHICH IS NOT 
*                            A MIN..MAX SPECIFICATION.
*                IACPVID UPDATED WITH MIN/MAX RANGE IF VALID. 
* 
*         USES   X - 0, 1, 3, 4, 5, 6, 7. 
*                A - 1, 3, 4, 5, 6, 7.
* 
*         CALLS  BHP, BIPL, STREVN. 
 BIPR     BSSZ   1                 ENTRY/EXIT 
          SA4    ANSSTR            SAVE CHECKLIST ATTRIBUTE FIRST 
          ERRNZ  59-S.CHATT 
          MX6    N.CHATT
          BX7    X4 
          SA7    BIPRCAT
          BX1    -X6*X4 
          LX1    N.CHATT
          SA6    BIPRMIN           FLAG FOR DEFAULT MIN VALUE 
          SX6    B0+               SET DEFAULT MAX VALUE
          ZR     X1,BIPR50         IF NEITHER MIN NOR MAX SPECIFIED 
  
          LX4    N.CHATT+6
          MX7    -6 
          BX4    -X7*X4            FIRST CHARACTER AFTER IDENTIFIER 
          SX7    X4-1R0 
          NG     X7,BIP300         IF ALPHA TREAT AS A VALUE
  
          RJ     =XSTREVN          EVALUATE NUMERIC VALUE 
          SX3    MSG480            USE NUMERIC MIN..MAX VALUES
          NZ     X5,BRWERR4        1ST VALUE NOT NUMERIC
          SA3    ANSSEP 
          SX0    X3-1R. 
          NZ     X0,BIPR30         IF ONLY ONE VALUE SPECIFIED
  
*         X6 = PVMIN
  
          SA6    BIPRMIN
          RJ     BHP
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
          SA5    ANSCHR 
          SX3    MSG481            USE 2 CONSECUTIVE PERIODS FOR RANGE
          NZ     X5,BRWERR4        GARBAGE AFTER 1ST PERIOD 
  
          SA4    ANSSEP 
          SX0    X4-1R. 
          NZ     X0,BRWERR4        2ND SEPARATOR IS NOT A PERIOD
  
          RJ     BHP
          NZ     X1,BRWERR5        SEP MUST END HEADER LINE 
  
          SA1    ANSSTR 
          SX6    B0+
          ZR     X1,BIPR50         IF DEFAULT MAX MUST BE USED
  
          RJ     =XSTREVN          EVALUATE MAX VALUE 
          SX3    MSG480            MAX VALUE IS NON-NUMERIC 
          NZ     X5,BRWERR4        ERR MSG AND ABORT
  
 BIPR30   BSS    0
          SX3    MSG487            RANGE MAXIMUM MUST BE .GT. ZERO
          ZR     X6,BRWERR4        IF SPECIFIED MAX IS ZERO 
  
  
*         X6 = PVMAX
  
 BIPR50   BSS    0                 CHECK FOR RANGE IN BOUNDS
          SA1    BIPRCAT           GET SAVED ATTRIBUTE
          BX5    X6 
          EX6    X1,CHATT          EXTRACT ATTRIBUTE A, F, OR S 
          SX4    B1+               DEFAULT MIN FOR ALL EXCEPT *A
          SX0    X6-2R*F
          ZR     X0,BIPR60         IF PROCESSING *F ATTRIBUTE 
  
          SX0    X6-2R*P
          NZ     X0,BIPR100        IF NOT *P CHECK *A AND *S
  
 BIPR60   BSS    0                 CHECK RANGE FOR *F AND *P
          SX3    MSG483            *F RANGE MUST BE .GE. 1 .LE. 7 
          SX6    7                 DEFAULT MAX FOR *F 
          SX0    8                 *F MAX MUST NOT EXCEED 7 
          JP     BIPR130           CHECK DEFAULTS, RANGE, ETC.
  
*         X4 = DEFAULT PVMIN IF NOT *A ATTRIBUTE
*         X5 = PVMAX
*         X6 = CHECKLIST ATTRIBUTE RIGHT JUSTIFIED ZERO FILL. 
  
 BIPR100  BSS    0                 CHECK *A AND *S
          SX0    V.SCS+1           *A/*S MAX MUST NOT EXCEED V.SCS
          SX7    X6-2R*A
          SX6    40                DEFAULT MAX FOR *A/*S
          SX3    MSG325            *S RANGE MUST BE .GE. 1 .LE. 40
          NZ     X7,BIPR130        IF NOT *A ATTRIBUTE
  
          SX3    MSG484            *A RANGE MUST BE .GE. 1 .LE. 40
          SX4    B0+               DEFAULT MIN FOR *A 
  
  
*         X0 = MAXIMUM SIZE FOR PATTERN TYPE
*         X3 = ERROR MESSAGE ADDRESS
*         X4 = DEFAULT PVMIN VALUE
*         X5 = SPECIFIED PVMAX VALUE
*         X6 = DEFAULT PVMAX VALUE
  
 BIPR130  BSS    0
          ZR     X5,BIPR150        STORE DEFAULT
  
          IX1    X5-X0
          PL     X1,BRWERR4        IF MAX EXCEEDS ALLOWABLE RANGE 
  
          BX6    X5                SPECIFIED MAX VALUE
  
  
*         X0 = MAXIMUM SIZE FOR PATTERN TYPE
*         X3 = ERROR MESSAGE ADDRESS
*         X4 = DEFAULT PVMIN VALUE
*         X6 = FINAL PVMAX VALUE
  
 BIPR150  BSS    0                 STORE DEFAULT MAX
          SA1    BIPRMIN
          NG     X1,BIPR200        IF MIN WAS NOT SPECIFIED 
  
          IX0    X1-X0
          PL     X0,BRWERR4        IF MIN EXCEEDS ALLOWABLE RANGE 
  
          BX4    X1                SPECIFIED MIN VALUE
  
*         CHECK THAT MAX IS .GT. MIN
*         X4 = FINAL PVMIN VALUE
*         X6 = FINAL PVMAX VALUE
  
 BIPR200  BSS    0
          SX3    MSG482            MIN EXCEEDS MAX IN RANGE 
          IX0    X6-X4
          NG     X0,BRWERR4        MIN .GT. MAX 
          SX5    B0+
          OX1    X5,X4,PVMIN       INSERT MIN INTO IACPVID
          OX7    X1,X6,PVMAX       INSERT MAX INTO IACPVID
          SA7    IACPVID
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    PPTCL
          EX5    X7,PVMAX 
          RJ     BIPL              CHECK INTERACTIVE PARAMETER LENGTH 
  
 SDOVL    ENDIF 
  
          JP     BIPR              RETURN 
  
 BIPRCAT  BSSZ   1                 SAVE *A,*F,*S CHECKLIST ATTRIBUTE
 BIPRMIN  BSS    1                 SAVE SPECIFIED MIN VALUE 
 BITV     TITLE  BEGIN, INTERACTIVE TERMINAL VERIFICATION.
**        BITV  -  BEGIN, INTERACTIVE TERMINAL VERIFICATION.
* 
*         VERIFY THAT INPUT IS AN INTERACTIVE TERMINAL. 
* 
*         EXIT   (X3) .EQ. 0 IF INPUT IS UNASSIGNED OR A TERMINAL.
*                     .NE. 0 (ADDRESS OF ERROR MESSAGE) IF INPUT IS 
*                            ASSIGNED BUT IS NOT A TERMINAL.
*                (X1) = FILE POSITION STATUS IF (X3).NE.0.
*                       0 IF MID-RECORD (NOT EOR, EOS, EOF, EOP, EOI).
*                       1 IF EOR, EOS, EOF, EOP.
*                      -1 IF EOI. 
* 
*         USES   X - 1, 2, 3, 5.
*                A - 3, 5.
* 
*         CALLS IOFIL, IOSTS. 
  
 OSNOSBE  IFNE   HOST,SC2 
 BITV     SUBR               ENTRY/EXIT 
          SA5    I
          RJ     =XIOFIL     CHECK IF INPUT IS A TERMINAL 
  
          MX3    0
          ZR     X5,BITVX    IF FILE NOT ASSIGNED 
  
          EX1    X5,FMTRM 
          NZ     X1,BITVX    IF IT IS A TERMINAL
  
          SX2    I
          RJ     =XIOSTS     CHECK EOI STATUS 
  
          SX3    MSG213      END OF INFORMATION ON PROMPTED INPUT 
          JP     BITVX       RETURN 
 OSNOSBE  ENDIF 
          TITLE  BEGIN INTERACTIVE VALIDATION 
**        BIV    - BEGIN, VALIDATE THE INTERACTIVE CALL STATEMENT.
*         PPT CONTAINS AN ENTRY FOR EACH PROCEDURE PARAMETER. 
*         PATTERNS, VALUES AND HELP INFORMATION ARE STORED ON THE 
*         PATTERN VALUE TABLE (PVT).   WHEN THE CALL STATEMENT
*         HAS BEEN PROCESSED, AN FPS ENTRY FOR EACH PARAMETER WILL
*         CONTAIN THE PROPER VALUE TO BE SUBSTITUTED INTO THE 
*         PROCEDURE BODY.  BIV WILL PROMPT THE CALLER, WHEN 
*         DISCREPENCIES ARE FOUND ON THE CALL.  BIV WILL RESPOND
*         WITH HELP INFORMATION WHEN A REQUEST FOR HELP IS FOUND. 
* 
  
  
 BIV      BSSZ   1                 VALIDATE INTERACTIVE CALL
          SA1    IACIMP            CHECK FOR MENU 
          SA3    IACIPF            CHECK INTERACTIVE PROCESSING FLAG
          ZR     X3,BIV            NOT INTERACTIVE - RETURN 
          NZ     X1,BIV            MENU PROC - RETURN 
  
  
*         LOCATE THE USER SUPPLIED PROMPTS (IN THE PVT) FOR 
*         THE (CORRECT) AND (ENTER) MESSAGES.  STORE THE PROMPTS
*         AND THEIR LENGTHS.  DEFAULT PROMPTS ARE (CORRECT AND
*         ENTER). 
  
          SA1    BGODT             OFFSET OF .DIRECTIVE TEXT
          SA2    PVTCL
          BX7    X1 
          BX6    X2 
          SA7    IACNPV            NEXT PVT OFFSET
          SA6    IACLPE            LAST PVT ENTRY 
          SA7    IACPRE            PREVIOUS PVT OFFSET
  
 BIVCCC   BSS    0
          RJ     =XCCLNPV          GET NEXT PVT ENTRY 
          ZR     X2,BIVCFF         END OF PVT ENTRIES 
  
          SA4    =0LCORECT
          SX7    B2 
          BX6    X0-X4
          NZ     X6,BIVCDD         IF NOT *CORRECT* ENTRY 
  
          SA7    BIVCMLE           LENGTH OF *CORRECT* MESSAGE
          EQ     BIVCEE            STORE MESSAGE POINTER
  
 BIVCDD   BSS    0
          SA5    =5LENTER 
          BX6    X0-X5
          NZ     X6,BIVCCC         TRY NEXT ENTRY 
  
          SA7    BIVEMLE           LENGTH OF *ENTER* MESSAGE
 BIVCEE   BSS    0
          SX7    A2+B1             *CORRECT* OR *ENTER* MESSAGE POINTER 
          SA7    A7-B1
          JP     BIVCCC            NEXT .DIRECTIVE FROM PVT 
  
 BIVCFF   BSS    0
          SX7    1
          SA7    IACICF            INDICATE INTERACTIVE CALL
          MX6    0
          SA6    BGEQMD 
          SA6    BGERR             INITIALLY CLEAR ERROR CONDITIONS 
          SA6    BGHMD
          SX7    -LE.PPT           INITIALIZE PPT OFFSET
 SDOVL    IFNE   IP.SDO,0 
          SA7    SDTOP             SCREEN MODE INITIAL TOP OF PAGE
 SDOVL    ENDIF 
          SA7    BGPWPL 
          SA7    BIVLPP 
 BIV00    BSS    0
          SA3    ANSSEP 
          SA1    IACIDP            CHECK DIALOG 
          ZR     X1,BIV00A         NON-DIALOG - CHECK SEPARATOR 
  
          NG     X3,BIV100         VALIDATE PARAMETER LIST
  
 BIV00A   BSS    0
          SX0    X3-1R. 
          SX7    X3-1R) 
          ZR     X0,BIV00C         TURN OFF HELP MODE - VALIDATE LIST 
          ZR     X7,BIV00C         TURN OFF HELP MODE - VALIDATE LIST 
  
          SX0    X3-1R, 
          ZR     X0,BIV005         READ NEXT PARAMETER
  
          SX7    X3-1R? 
          ZR     X7,BIV00B         TURN ON HELP MODE
  
          SX0    X3-1R\ 
          ZR     X0,BIV000         TURN ON EQUIVALENCE MODE 
  
          SA2    BGSFPH            CHECK SLASH ON PROC HEADER 
          SX0    X3-1R/ 
          SX3    MSG339            EXPECTING ?,\
          ZR     X2,BIV00AA        CHECK DIALOG 
  
          SX3    MSG338            EXPECTING ?,/\ 
          ZR     X0,BIV000         TURN ON EQUIVALENCE MODE 
  
 BIV00AA  BSS    0
          ZR     X1,BIV095         NO DIALOG - PROMPT FOR ERROR 
  
          SX3    MSG369            EXPECTING ?,\ ON RESPONSE
          ZR     X2,BIV095         PROMPT FOR SLASH ON RESPONSE 
          SX3    MSG372            EXPECTING ?,/\ ON RESPONSE 
          JP     BIV095            PROMPT FOR BAD SEP ON RESPONSE 
  
  
  
  
  
 BIV00B   BSS    0                 TURN ON HELP MODE
          RJ     BRC               READ COMMENTS FROM HELP CALL 
  
          SX6    1
          SX3    1R?
          SA6    BGHMD
          JP     BIV300            BEGIN HELP MODE PROCESSING 
  
  
  
 BIV00C   BSS    0
  
          RJ     BRC               READ COMMENTS
  
          MX7    0
          SA7    BGHMD             TURN OFF HELP MODE 
          JP     BIV100            VALIDATE LIST
  
  
 BIV000   BSS     0                SET EQ MODE FLAG 
          MX7    1
          SA7    BGEQMD            SET EQUIVALENCE MODE FLAG
          JP     BIV005A           DONT REPOSITION LIST 
  
  
  
  
  
 BIV005   BSS    0                 READ NEXT PARAMETER
          SA1    BGPWPL            UPDATE POSITION
          SX7    X1+LE.PPT
          SA7    BGPWPL 
  
  
  
 BIV005A  BSS    0
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    SCATBF1           SAVE CURRENT SCATTER BUFFER HEADER 
          BX7    X1 
          SA7    BIVSHD 
 OSNOSBE  ENDIF 
  
          RJ     =XCCLGNP1         READ PARAMETER 
  
          SA3    IACERR 
          ZR     X3,BIV005R        IF NO ERROR
  
          SX6    MSG101 
          BX3    X3-X6             CHECK FOR NO SEPARATOR/TERMINATOR
          NZ     X3,BIV095         IF NOT MISSING SEPARATOR/TERMINATOR
  
          SX6    2RUC              FLAG UNTERMINATED PROCEDURE CALL 
          SA6    BGUTPC 
  
  
  
  
  
  
 BIV005R  BSS    0                 ENTRY FOR RESPONSES
          SA3    ANSSEP 
          SX6    X3-1R? 
          NZ     X6,BIV010         CHECK FOR EQUIVALENCE MODE 
  
          SA2    ANSCHR            KEYWORD PRECEEDS HELP REQUEST
          ZR     X2,BIV00B         TURN ON HELP MODE
  
          RJ     BRC               READ COMMENTS ON HELP CALL 
  
          SA2    ANSEVL 
          SA1    ANSLIT 
          NZ     X1,BIV005B        PARAMETER IS A LITERAL 
  
          SA2    ANSSTR 
 BIV005B  BSS    0
          SA1    PPTCL
          SB7    X1 
          SB6    -LE.PPT
 BIV005C  BSS    0                 FIND PARAMETER IN LIST 
  
          SB6    B6+LE.PPT
          LT     B7,B6,BIV005D     PARAMETER NOT IN LIST
  
          SA5    PPT+W.PPFPN+B6 
          BX0    X2-X5             COMPARE NAMES
          NZ     X0,BIV005C        GET NEXT NAME IN LIST
  
          SX7    B6                SAVE CURRENT POSITION
          BX6    X2 
          SA7    BGPWPL 
          SA6    BIVHPN            SAVE HELP KEYWORD NAME 
  
          RJ     =XCCLIDC          INITIALIZE DIALOGUE
  
 SDOVL    IFNE   IP.SDO,0 
          RJ     BIV1000           SORT *N PARAMETERS TO END OF LIST
          SX3    2RP? 
          RJ     BSM               SCREEN MODE IF POSSIBLE
 SDOVL    ENDIF 
  
          JP     BIV535            PUT OUT PARAMETER HELP 
  
  
 BIV005D  BSS    0                 CHECK HELP CALL FOR PROC NAME
          SA5    BGPNAM 
          BX0    X2-X5
          NZ     X0,BIV075         UNRECOGNIZED PARAMETER 
  
          JP     BIV00B            SET PROC HELP MODE 
  
  
  
  
  
  
 BIV010   BSS    0                 CHECK EQUIVALENCE MODE 
          SA4    ANSSEP 
          SA3    BGEQMD 
          SX0    X4-1R= 
          ZR     X0,BIV050         GO PROCESS IN EQUIVALENCE MODE 
  
          NZ     X3,BIV050         EQ MODE FLAG ON
  
*                                  POSITIONAL MODE PROCESSING 
  
  
  
          SA1    PPTCL             UPDATE PPT AND FPS ENTRY ADDRESSES 
          SA2    BGPWPL 
          IX6    X2-X1
          PL     X6,BIV00          IGNORE EXCESS POSITIONAL PARAMETERS
  
          BX7    X2 
          SA1    IACIDP            CHECK DIALOGUE 
          NZ     X1,BIV010A        IGNORE EQ MODE ON PROC 
  
          SA2    PPT+W.PPEMF+X7 
          LX2    59-S.PPEMF 
          NG     X2,BIV050         PROCESS IN EQ MODE 
  
          SA7    BIVLPP            LAST POSITIONAL MODE PARAMETER 
  
 BIV010A  BSS    0
          SA5    ANSCHR 
          SA2    ANSSEP            CHECK FOR SYMBOL VALUE 
          SX6    X2-1R- 
          SX7    X2-1R/ 
          SX0    X2-1R+ 
  
          ZR     X6,BIV010B        CONVERT SYMBOL 
          ZR     X0,BIV010B        CONVERT SYMBOL 
          NZ     X7,BIV010C        NON-SYMBOL VALUE 
  
          SA1    BGSFPH            CHECK FOR SLASH ON PROC HEADER 
          ZR     X1,BIV010B        / IS PART OF SYMBOLIC VALUE
          ZR     X5,BIV00          POSITIONAL KEYWORD NULL ON CALL
          JP     BIV010C           STORE PARAMETER VALUE PRECEEDING / 
  
 BIV010B  BSS    0
  
          RJ     BSC               CONVERT SYMBOL 
  
          SA3    IACERR 
          NZ     X3,BIV095         PROMPT FOR ERROR 
  
 BIV010C  BSS    0
          SA1    BGPWPL 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA2    BIVSHD 
          RJ     BCR               CHECK FOR RESTRICTED PARAMETER 
  
 OSNOSBE  ENDIF 
  
          SA2    PPT+W.PPCPV+X1    CLEAR CALL VALUE INDICATOR 
          MX7    N.PPCPV
          LX7    S.PPCPV+1
          BX6    -X7*X2 
          SA6    A2 
  
  
  
 BIV015   BSS    0                 PLACE VALUES IN FPS
          SA1    BGPWPL 
          SA2    PPT+W.PPLIT+X1    CHECK LITERAL FLAG 
          SA3    ANSLIT 
          SA4    ANSSTR 
          SA5    ANSCHR 
          ZR     X3,BIV020         CALL KEYWORD NOT LITERAL 
  
          LX2    59-S.PPLIT 
          PL     X2,BIV015A        USE EVALUATED LITERAL
  
          SA3    PPT+W.PPFPN+X1    IS LITERAL VALUE A KEYWORD 
          SA2    ANSEVL 
          BX0    X3-X2
          NZ     X0,BIV020         USE UNEVALUATED VALUE
  
          SA3    PPT+W.PPKAP+X1 
          EX0    X3,PPKAP 
          ZR     X0,BIV020         IF NO *K USE UNEVALUATED LITERAL 
  
 BIV015A  BSS    0
          SA4    ANSEVL            USE EVALUATED FORM 
          SA5    ANSEVLC
 BIV020   BSS    0
          SA2    PPT+W.PPDO2+X1    GET CALL VALUE OFFSET FPS
          MX6    N.PPDO2
          LX6    S.PPDO2+1
          BX0    X2*X6
          AX0    S.PPDO2-N.PPDO2+1
          ERRNZ  W.PPDO2-W.PPDC2
          MX1    -N.PPDC2          PUT CALL VALUE SIZE IN PPT 
          BX7    -X1*X5 
          LX7    S.PPDC2-N.PPDC2+1
          LX1    S.PPDC2-N.PPDC2+1
          BX6    X2*X1
          BX6    X6+X7
          SA6    A2 
          BX7    X4 
          SB7    X5 
          SA7    FPS+W.FPSCV+X0 
          SB6    V.SCS
          LE     B7,B6,BIV025      PUT CALL VALUE IN FPS
  
          SB7    B6 
 BIV025   BSS    0                 MAKE FPS CALL VALUE ENTRY
          SB7    B7-10
          LE     B7,B0,BIV030      MOVE COMPLETE
  
          SA4    A4+B1             GET NEXT WORD OF VALUE 
          BX7    X4 
          SA7    A7+B1             STORE WORD IN FPS
          JP     BIV025            GET NEXT WORD
  
 BIV030   BSS    0
          SA1    BGPWPL            FLAG BEGIN SPECIFICATION PROCESSED 
          SA2    PPT+W.PPBSP+X1 
          MX6    N.PPBSP
          LX6    S.PPBSP+1
          BX7    X2+X6
          SA7    A2 
          SA1    IACIDP            CHECK DIALOGUE 
          ZR     X1,BIV00          NO DIALOGUE - GET NEXT PARAMETER 
  
          RJ     BVE               VALIDATE CURRENT PARAMETER 
  
          JP     BIV00             READ NEXT CALL PARAMETER 
  
  
  
  
 BIV050   BSS    0                 EQUIVALENCE MODE PROCESSING
          MX7    1
          SA7    BGEQMD            SET EQUIVALENCE MODE FLAG
          SA5    ANSCHR 
          ZR     X5,BIV00          NULL KEYWORD - READ NEXT KEYWORD 
  
          SA3    BIVLPP            SEARCH PPT FOR MATCHING PARAMETER
          SA2    PPTCL
          SB6    X3 
          SB7    X2 
          SA1    ANSLIT 
          SA2    ANSSTR 
          ZR     X1,BIV055         KEYWORD NOT A LITERAL
  
          SA2    ANSEVL 
 BIV055   BSS    0
          SB6    B6+LE.PPT
          LT     B7,B6,BIV075      CALL PARAMETER NOT ON LIST 
  
          SA4    PPT+W.PPFPN+B6    GET FORMAL PARAMETER NAME
          BX0    X2-X4
          NZ     X0,BIV055         TRY NEXT PARAMETER ON PROC LIST
  
          SX7    B6                SAVE CURRENT POSITION OF PPT 
          SA7    BGPWPL 
          SA1    PPT+W.PPBSP+X7    GET SPECIFICATION PROCESSED FLAG 
          ERRNZ  59-S.PPBSP 
          PL     X1,BIV056         IF SPECIFICATION NOT PROCESSED 
  
          SA1    IACIDP 
          NZ     X1,BIV056         IF ALREADY IN DIALOGUE 
  
          SX0    A2                ADDRESS OF PARAMETER NAME
          SX3    MSG204            * CCL204 - MULT. EQUIV. SPEC. FOR *
          LX0    18 
          BX3    X0+X3
          RJ     =XSTRMSG          ISSUE INFORMATIVE MESSAGE
  
 BIV056   BSS    0
          SA1    BGPWPL            GET PPT ENTRY ADDRESS
          SA2    PPT+W.PPCPV+X1 
          MX1    N.PPCPV
          LX1    S.PPCPV+1
          SA3    ANSSEP            CHECK FOR PATTERN=VALUE ON CALL
          SX0    X3-1R= 
          ZR     X0,BIV057         IF KEYWORD=VALUE PRESENT 
  
          BX6    -X1*X2            NO VALUE - CLEAR FLAG
          SA6    A2 
          JP     BIV070            SET EQ MODE FLAG 
  
 BIV057   BSS    0
          BX6    X1+X2             SET CALL VALUE FLAG
          SA6    A2                STORE FLAG 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    SCATBF1           SAVE CURRENT SCATTER BUFFER HEADER 
          BX7    X1 
          SA7    BIVSHD 
 OSNOSBE  ENDIF 
  
          RJ     =XCCLGNP          READ VALUE 
  
          SA3    IACERR 
          ZR     X3,BIV058         IF NO ERROR
  
          SX6    MSG101            CHECK FOR NO SEPARATOR/TERMINATOR
          BX3    X3-X6
          NZ     X3,BIV095         IF NOT MISSING SEPARATOR/TERMINATOR
  
          SX6    2RUC              FLAG UNTERMINATED PROCEDURE CALL 
          SA6    BGUTPC 
 BIV058   BSS    0
          SA5    ANSCHR 
          SA3    ANSSEP 
          SX0    X3-1R+ 
          SX7    X3-1R/ 
          SX6    X3-1R- 
  
          ZR     X6,BIV065         CONVERT SYMBOL 
  
          ZR     X0,BIV065         CONVERT SYMBOLIC VALUE 
  
          NZ     X7,BIV070         NOT A SYMBOLIC VALUE 
  
 BIV065   BSS    0
          RJ     BSC               BEGIN SYMBOL CONVERSION
  
          SA3    IACERR 
          NZ     X3,BIV095         PROMPT FOR ERROR 
  
 BIV070   BSS    0
          SA1    BGPWPL            SET EQ MODE FLAG IN PPT
  
 OSNOSBE  IFNE   HOST,SC2 
          SA2    BIVSHD 
          RJ     BCR               CHECK FOR RESTRICTED PARAMETER 
  
 OSNOSBE  ENDIF 
  
          SA2    PPT+W.PPEMF+X1 
          MX6    N.PPEMF
          LX6    S.PPEMF+1
          BX7    X6+X2
          SA7    A2 
          JP     BIV015            SET PPBSP THEN READ NEXT PARAMETER 
  
  
  
  
 BIV075   BSS    0                 PROMPT FOR UNRECOGNIZED PARAMETER
          BX7    X2                SAVE THE UNRECOGNIZED PARAMETER
          SA7    BGURPN 
          SA1    ANSLIT 
          SA2    ANSCHR 
          ZR     X1,BIV075A        IF NOT A LITERAL 
  
          SA2    ANSEVLC
 BIV075A  BX7    X2                SAVE THE PARAMETER LENGTH
          SA7    BGURPL 
          MX7    0
          SA7    SCATX             CLEAR SCATTER BUFFER HEADER
          SA1    IACIDP 
 SDOVL    IFNE   IP.SDO,0 
          SX0    X1-2 
          SX3    2RUP              INDICATE UNRECOGNIZED PARAMETER
          ZR     X0,BIV300         IF SCREEN MODE 
  
 SDOVL    ENDIF 
  
          ZR     X1,BIV75C         INITIALIZE DIALOGUE
  
          BX6    X1 
          SA6    BIVIDP            DIALOGUE PROMPT UNRECOGNIZED PARAMETER 
          JP     BIV75G            SKIP TITLE 
  
 BIV75C   BSS    0
          RJ     =XCCLIDC 
 SDOVL    IFNE   IP.SDO,0 
          SA1    IACIDP 
          SX0    X1-2 
          SX3    2RUP              INDICATE UNRECOGNIZED PARAMETER
          ZR     X0,BIV300         IF SCREEN MODE 
 SDOVL    ENDIF 
  
          RJ     BDT               DISPLAY TITLE
  
 BIV75G   BSS    0
          SA2    SCATX
          SA1    =1H
          SB2    1
          RJ     =XSTRTASC         PUNCTUATION TO SCATX 
          SA1    BGURPN            UNRECOGNIZED KEYWORD 
          SA4    BGURPL            UNRECOGNIZED KEYWORD LENGTH
          SB2    X4 
          RJ     =XSTRTASC         ADD KEYWORD TO MESSAGE 
          SA1    MSG360            UNRECOGNIZED PARAMETER 
          SB2    24 
          RJ     =XSTRTASC         MESSAGE TO SCATX 
          SA1    BIVIDP 
          NZ     X1,BIV335         PROMPT THEN READ RESPONSE
  
          SX7    1
          SA7    BIVIDP            TITLE ALREADY DISPLAYED
          RJ     =XCCLWID          WRITE MESSAGE
          JP     BIV00B            BEGIN HELP MODE PROMPTING
  
  
  
  
  
  
  
  
 BIV095   BSS    0                 SEND ERR MSG THEN PROMPT 
          SA1    IACIDP 
 SDOVL    IFNE   IP.SDO,0 
          SX0    X1-2 
          ZR     X0,BIV100         VALIDATE LIST AS IS
 SDOVL    ENDIF 
          BX7    X3 
          SA7    BGERR             SAVE MSG 
          NZ     X1,BIV330         PROMPT THEN READ RESPONSE
  
          RJ     =XCCLIDC          INITIALIZE DIALOGUE
  
 SDOVL    IFNE   IP.SDO,0 
          SA1    IACIDP 
          SX0    X1-2 
          ZR     X0,BIV100         VALIDATE LIST AS IS
 SDOVL    ENDIF 
  
          RJ     BDT               DISPLAY TITLE
  
          SX6    1
          SA6    BIVIDP            TITLE DISPLAYED
          SA3    BGERR
          MX7    0
          SA7    SCATX
  
          RJ     =XCCLWID          SEND MESSAGE 
  
          JP     BIV00B            INITIATE HELP MODE PROMPTING 
  
  
  
  
  
  
  
*         THE PROCEDURE CALL HAS BEEN CRACKED INTO TABLES.
*         VALIDATE DEFAULTS AND SPECIFIED VALUES. WHEN
*         VALIDATION IS COMPLETE JUMP TO DIALOGUE (BIV300)
*         WITH X3=0.  OTHERWISE IF AN ERROR IS FOUND
*         JUMP TO DIALOGUE WITH X3 NON-ZERO.
* 
* 
 BIV100   BSS    0                 VALIDATE PARAMETER ENTRIES 
  
 OSNOSBE  IFNE   HOST,SC2 
          SA1    IACIDP 
          NZ     X1,BIV110         IF DIALOGUE IN PROGRESS
  
          SA1    RSTRICT
          ZR     X1,BIV110         IF NO RESTRICTED PARAMETERS
  
          SA1    W.RACS            PLACE COMMAND IMAGE IN DAYFILE 
          SA2    SCATBF1
          RJ     STRPKS            PACK COMMAND IMAGE 
  
          RJ     DCI               DISPLAY COMMAND IMAGE
  
 BIV110   BSS    0
 OSNOSBE  ENDIF 
  
          SA3    BGERR
          NZ     X3,BIV300         PROMPT FOR HELP AND ERRORS 
  
          SX7    -LE.PPT
          SA7    BGPWPL 
  
 BIV120   BSS    0
          SA1    BGPWPL 
          SA2    PPTCL             LENGTH OF LIST 
          SX6    X1+LE.PPT         CHECK FOR END OF LIST
          IX0    X6-X2
          PL     X0,BIV130         END OF LIST - TERMINATE DIALOGUE 
  
          SA6    BGPWPL 
  
          RJ     BVE               VALIDATE CURRENT PARAMETER 
  
          JP     BIV120            GET NEXT PARAMETER OFFSET
  
  
  
  
*         LIST VALID - TERMINATE DIALOGUE AND RUN PROC
  
  
 BIV130   BSS    0
 SDOVL    IFNE   IP.SDO,0 
          SX7    1
          MX3    0
          SA7    CLOSTAT
          RJ     BSM               CLOSE PANELS 
 SDOVL    ENDIF 
  
  
 OSSC2    IFNE   HOST,SC2 
          SA1    IACIDP 
          SX0    X1-1 
          NZ     X0,BIV150         NO DIALOGUE
  
 OSNOS    IFEQ   HOST,NOS 
          WRITER O                 FLUSH CIO BUFFER 
          CSET   RESTORE           RESTORE INITIAL CHARACTER SET
  
 OSNOS    ELSE
          WRITER O,R               FLUSH CIO BUFFER 
 OSNOS    ENDIF 
 OSSC2    ENDIF 
  
 BIV150   BSS    0
          MX7    0
          SA7    IACIDP            TURN OFF DIALOGUE
          SA7    IACICF            CLEAR INTERACTIVE CALL FLAG
          SA1    BGNAML 
          ZR     X1,BIV            RETURN - NO .PROC COMMENT KEYWORD
  
          SA2    PPTCL             COMMENTS ALREADY ENTERED 
          SX7    X2+LE.PPT
          SA7    A2                UPDATE LENGTH OF PPT 
          JP     BIV               RETURN 
  
  
  
  
  
* 
*         ENTER INTERACTIVE DIALOGUE
*                ENTRY -  X3 = ? REQUEST FOR HELP 
*                              10H ERROR
*                              10H ENTER
* 
* 
*                IACIDP - 1   - INTERACTIVE DIALOG IN PROGESS 
* 
  
 BIV300   BSS    0                 BEGIN INTERACTIVE DIALOG 
          BX7    X3 
          SA7    BGERR             STORE ERROR CONDITION
          SA3    BIVEOI 
          NZ     X3,BRWERR         IF END OF INPUT FILE 
          MX6    0
          SA6    SCATX             CLEAR SCATTER BUFFER HEADER
          RJ     BIV1000           SORT *N PARAMETERS TO END OF LIST
          SA1    IACIDP 
          ZR     X1,BIV300C        TITLE NOT DISPLAYED
  
          SX7    1
          SA7    BIVIDP            TITLE DISPLAYED
  
 BIV300C  BSS    0
          RJ     =XCCLIDC          INITIALIZE DIALOGUE CONDITIONS 
  
          SA3    BGERR
 SDOVL    IFNE   IP.SDO,0 
          RJ     BSM               SCREEN MODE IF POSSIBLE
 SDOVL    ENDIF 
  
          SA1    BIVIDP 
          NZ     X1,BIV300G        SKIP TITLE - DIALOGUE IN PROGRESS
  
          RJ     BDT               DISPLAY TITLE
  
          SX7    1
          SA3    BGERR
          SA7    BIVIDP 
  
 BIV300G  BSS    0
          SX0    X3-1R? 
          ZR     X0,BIV500         DISPLAY HELP IN HELP MODE
  
          SA1    IACIDP 
          NZ     X1,BIV305         DONT APPEND PREFIX 
  
          SA1    MSG320            CCL PREFIX 
          SB2    10 
          JP     BIV310            STORE PREFIX AND DETERMINE PROMPT
  
 BIV305   BSS    0
 OSNOS    IFEQ   HOST,NOS 
          SA1    =3L"EM"           CONTROL BYTE WITH SPACE
          SB2    3
 OSNOS    ELSE
          SA1    =1H
          SB2    1
 OSNOS    ENDIF 
  
 BIV310   BSS    0
          SA2    SCATX
          RJ     =XSTRTASC
          SA3    BGERR
          SA2    =10H ERROR 
          SA1    BIVCPTR           POINTER TO *CORRECT* MESSAGE 
          SA4    BIVCMLE           LENGTH 
          SA1    X1                FIRST WORD OF *CORRECT* MESSAGE
          SB2    X4 
          BX6    X3-X2
          ZR     X6,BIV315         PROMPT TO SCATX
  
          SA1    BIVEPTR           POINTER TO *ENTER* MESSAGE 
          SA4    BIVEMLE           LENGTH 
          SA1    X1                FIRST WORD OF *ENTER* MESSAGE
          SB2    X4 
  
 BIV315   BSS    0                 PROMPT FOR RE-ENTRY AND ERRORS 
          SA2    SCATX
          SA3    BGPWPL 
          SA4    PPT+W.PPDSO+X3 
          LX4    59-S.PPDSO 
          PL     X4,BIV317         USE DEFAULT CCL DIALOGUE 
  
          SA3    BGERR             CHECK FOR ERROR
          SA5    =10H ERROR 
          BX6    X5-X3
          NZ     X6,BIV325         USER SUPPLIED PROMPT 
  
          RJ     =XSTRCADC
          JP     BIV320            DEFAULT ERR + USER SUPPLIED
  
 BIV317   BSS    0
          RJ     =XSTRCADC         PROMPT TO SCATX
          SA1    =1H
          SB2    1
          RJ     =XSTRTASC         FOLLOWING SPACE
          SA3    BGPWPL 
          SA1    PPT+W.PPFPN+X3 
          SA4    PPT+W.PPFPC+X3 
          MX7    N.PPFPC
          LX7    S.PPFPC+1
          BX0    X7*X4
          LX0    59-S.PPFPC+N.PPFPC 
          SB2    X0 
          RJ     =XSTRTASC         KEYWORD TO SCATTER BUFFER
          SA3    BGPWPL 
          SA2    PPT+W.PPDES+X3    IS DESCRIPTION AVAILABLE 
          LX2    59-S.PPDES 
          PL     X2,BIV335         NO DESCRIPTION FOUND 
  
  
 BIV320   BSS    0
          SA1    =1H
          SB2    1
          SA2    SCATX
          RJ     =XSTRTASC
  
 BIV325   BSS    0
          RJ     =XCCLPVO          GET PVT OFFSETS
  
          RJ     =XCCLNPV          GET DESCRIPTION CONTROL WORD 
  
          SA5    =0LDSCRTN
          BX6    X0-X5
          NZ     X6,BIV335         DESCRIPTION NOT FOUND
  
          ERRNZ  W.PVSIZ-W.PVID 
          ERRNZ  S.PVSIZ-N.PVSIZ+1
          MX4    -N.PVSIZ 
          BX5    -X4*X2 
          SB2    X5 
          SA3    IACPRE 
          SA1    PVT+W.PVSTR+X3    GET 1ST WORD OF DESCRIPTION
          SA2    SCATX
  
          RJ     =XSTRCADC         UNPACK ASCII/DISPLAY 
  
          JP     BIV335            WRITE MESSAGE FROM SCATX 
  
  
  
  
  
 BIV330   BSS    0
          MX7    0
          SA7    SCATX             CLEAR SCATTER BUFFER HEADER
  
  
 BIV335   BSS    0                 MESSAGE IN SCATX 
          MX6    1
          SA6    BGPRMT            INDICATE 0013 BYTE 
          MX7    0
          SA7    BGERR             CLEAR ERROR CONDITIONS 
  
          RJ     =XCCLWID          WRITE MESSAGE
  
 OSNBE    IFEQ   HOST,NOSBE 
          SA1    =1H               SPACE BEFORE NEXT RESPONSE 
          SB2    1
          RJ     =XSTRTASC         SPACE TO SCATX 
          RJ     =XCCLWID          OUTPUT SPACE 
  
          WRITER O,R               FLUSH CIO BUFFER - NOSBE 
  
 OSNBE    ENDIF 
  
  
  
* 
* 
*         READ INTERACTIVE RESPONSES
  
  
 OSSC2    IFEQ   HOST,SC2 
  
          JP     BRWERR1           TERMINATE CALL ON SCOPE 2
  
 OSSC2    ELSE
          SA1    IACIDP            CHECK IF INTERACTIVE DIALOG ALLOWED
          ZR     X1,BRWERR1        EXIT BATCH MODE
  
 OSNBE    IFEQ   HOST,NOSBE 
  
          SA2    I
          MX3    59                SET CODE AND STATUS OF FET 
          LX3    1                 INDICATING CODED FILE
          BX7    X2*X3
          SA7    A2 
 OSNBE    ENDIF 
          MX7    0
          SX6    -LE.PPT
          SA7    BGEQMD 
          SA6    BIVLPP            PRESET LAST POSITIONAL PARAMETER 
  
          READ   I,R               REFRESH CIO BUFFER 
  
          SX2    I                 INPUT FET
          SX3    RBUF 
          SX6    SCATBF1
          SX4    V.SBSIZ
  
          RJ     =XIORDL           READ RESPONSE
  
          ZR     X1,BIV355         LOOK AT RESPONSE 
  
          RJ     BITV              INPUT TERMINAL VERIFICATION
  
          ZR     X3,BIV340         IF IT IS A TERMINAL
  
          PL     X1,BIV340         IF NOT AT END OF INFORMATION 
  
          BX7    X3                SAVE POSSIBLE ERROR MESSAGE ADDRESS
          SA7    BIVEOI 
*                                  (CR) ENTERED AT TERMINAL 
 BIV340   BSS    0
          SA1    BGPWPL            CLEAR PPT FLAGS
          SA2    PPT+W.PPBSP+X1    FORCE NULL DEFAULT FOR THIS PARAMETER
          ERRNZ  W.PPBSP-W.PPDC2
          ERRNZ  W.PPCPV-W.PPBSP
          MX3    N.PPCPV
          LX3    S.PPCPV+1
          MX7    N.PPDC2
          LX7    S.PPDC2+1
          BX6    X7+X3
          BX7    -X6*X2 
          MX6    N.PPBSP           SET PPBSP WHEN (CR) AT TERMINAL
          ERRNZ  59-S.PPBSP 
          BX7    X6+X7
          SA7    A2 
  
          RJ     BVE               VALIDATE RESPONSE
  
          JP     BIV100            VALIDATE *N ENTRY
  
  
 BIV355   BSS    0                 CHECK 1ST CHARACTER OF RESPONSE
  
          RJ     =XCCLGNP1         READ RESPONSE
          SA3    IACERR 
          NZ     X3,BIV095         SEND PROMPT OR ERR MSG 
  
          SA1    ANSCHR 
          NZ     X1,BIV005R        PROCESS PARAMETER ENTRY
  
          SA3    ANSSEP 
          SX0    X3-1R? 
          NZ     X0,BIV00          IF NOT QUESTION MARK CHECK DIALOG
  
          RJ     BRC               READ COMMENTS IF PRESENT 
          JP     BIV535            HELP FOR CURRENT PARAMETER 
  
  
  
  
  
  
 OSSC2    ENDIF 
* 
* 
*         RESPOND WITH HELP FOR THE FULL PROCEDURE. 
*         PARAMETERS FOR PROCEDURE Q ARE X, Y, Z
* 
* 
 BIV500   BSS    0                 HELP FOR FULL PROCEDURE
          SA1    BGPHRN            PROC HELP RECORD NUMBER
          NG     X1,BIV500A        NO PROC HELP TEXT
  
          SB2    X1 
  
          RJ     =XCCLWHT          WRITE PROC HELP TEXT 
  
 BIV500A  BSS    0
          SA4    PPTCL             CHECK FOR PARAMETERS ON PROC HEADER
          NZ     X4,BIV505         LIST PARAMETERS ON PROC HEADER 
  
          SA2    SCATX
          SA1    =11H PROCEDURE 
          SB2    11 
          RJ     =XSTRTASC         BUILD MESSAGE IN SCATX 
          SA1    BGPNAM 
          SA3    BGPNML            LENGTH OF PROC NAME
          SB2    X3 
          RJ     =XSTRTASC         PROC NAME TO SCATX 
          SA1    MSG371            PROC HAS NO FORMAL PARAMETERS
          SB2    26 
          RJ     =XSTRTASC         COMPLETE MESSAGE IN SCATX
          RJ     =XCCLWID          SEND MESSAGE 
  
          MX6    0
          SA6    BGERR
          SA6    BGHMD
          JP     BIV130            STATUS CLEAR - EXECUTE PROC
  
 BIV505   BSS    0                 LIST FORMAL PARAMETERS FROM PROC HEADER
          SA1    PPT+W.PPNO-LE.PPT
          LX1    59-S.PPNO         CHECK WHETHER ALL CHECKLISTS *N ONLY 
          NG     X1,BIV510         LIST PARAMETERS ON HEADER
  
*         ALL THE PARAMETERS ON THE HEADER HAVE *N ON CHECKLISTS. 
*         SO DO NOT LIST OR PROMPT FOR THESE PARAMETERS.
  
          MX6    0
          SA6    BGERR             CLEAR HELP 
          SA6    BGHMD
          JP     BIV100            VALIDATE LIST
  
 BIV510   BSS    0
          SA1    BGPHNL            CHECK PROC HELP NOLIST 
          NZ     X1,BIV530         SKIP PARAMETER LIST
  
          SA1    MSG368            PARAMETERS FOR PROCEDURE 
          SB2    16 
          SA2    SCATX
          RJ     =XSTRTASC         PUT STRING IN SCATX
          SA1    BGPNAM 
          SA3    BGPNML            LENGTH OF PROC NAME
          SB2    X3 
          SA2    SCATX
          RJ     =XSTRTASC         PUT NAME IN SCATX
          SA1    =L$ ARE  $ 
          SB2    6
          RJ     =XSTRTASC         STRING TO SCATX
          MX7    0
          SA7    BGPWPL            SET PPT TO 1ST ENTRY 
  
 BIV515   BSS    0                 LOOP THRU PPT - PUT KEYWORDS IN SCATX
          SA2    SCATX
          SA3    BGPWPL 
          ZR     X3,BIV517         SKIP PUNCTUATION 
          ZR     X2,BIV517         SKIP PUNCTUATION 
  
          SA4    PPTCL
          IX0    X3-X4
          PL     X0,BIV517         END OF PARAMETERS - NO PUNCTUATION 
  
          BX7    X2 
          SA7    BIVSHD            SAVE SCATTER BUFFER HEADER 
          SA1    =L$, $ 
          SB2    2
          RJ     =XSTRTASC         PUNCTUATION TO SCATX 
          SA3    BGPWPL 
  
 BIV517   BSS    0
          SA4    PPTCL
          IX0    X3-X4
          MX5    59-S.SBTOT 
          BX6    -X5*X2            NUMBER OF CHARACTERS IN SCATX
          AX6    S.SBTOT-N.SBTOT+1
          PL     X0,BIV525         END OF HEADER PARAMETERS 
  
          SA1    PPT+W.PPNO+X3     CHECK FOR *N ONLY IN CHECKLIST 
          LX1    59-S.PPNO
          NG     X1,BIV517A        PLACE PARAMETER NAME IN LIST 
  
          SA2    BIVSHD            RESTORE SCATX BEFORE PUNCTUATION 
          SX7    X3+LE.PPT         UPDATE PPT OFFSET
          BX6    X2 
          SA7    BGPWPL 
          SA6    SCATX
          JP     BIV515            GET NEXT PARAMETER 
  
 BIV517A  BSS    0
          SA1    PPT+W.PPFPN+X3 
          SA4    PPT+W.PPFPC+X3 
          MX5    N.PPFPC
          LX5    S.PPFPC+1
          BX7    X4*X5
          ERRZR  59-S.PPFPC 
          AX7    S.PPFPC-N.PPFPC+1
          SB2    X7 
          SB5    X6+2 
          SB5    B5+B2             WILL KEYWORD FIT IN LINE 
          SB4    V.SBSIZ
          GE     B4,B5,BIV520      KEYWORD INTO SCATX 
  
          RJ     =XCCLWID          WRITE LINE FROM SCATX
  
          JP     BIV515            KEYWORD FOR NEW LINE 
  
  
  
  
 BIV520   BSS    0
          SX7    X3+LE.PPT         UPDATE PPT OFFSET
          SA7    BGPWPL 
          RJ     =XSTRTASC         PUT KEYWORD IN SCATX 
          JP     BIV515            GET NEXT KEYWORD 
  
  
  
  
 BIV525   BSS    0
          ZR     X6,BIV530         LAST LINE ALREADY WRITTEN
  
          RJ     =XCCLWID          WRITE REMAINING KEYWORD
  
 BIV530   BSS    0
          MX6    0
          SA6    BGERR             CLEAR ERROR
          JP     BIV100            VALIDATE LIST
  
  
* 
* 
*         RESPOND WITH HELP FOR THE SPECIFIED KEYWORD.
*         FORMAT THE RESPONSE TO DISPLAY DEFAULTS AND 
*         ALLOWABLE SPECIFICATIONS FOR THE KEYWORD. 
*         DISPLAY HELP TEXT IF AVAILABLE. 
* 
* 
 BIV535   BSS    0                 FIND HELP KEYWORD IN PPT 
          MX7    0
          SA7    SCATX             CLEAR SCATTER BUFFER HEADER
          SA7    BIVHPN            CLEAR HELP CALL KEYWORD NAME 
          SA1    =18H CURRENT VALUE IS
          SA2    SCATX
          SB2    18 
          RJ     =XSTRTASC         STRING TO SCATX
          SA1    BGPWPL            GET VALUE SPECIFIED ON CALL
          SA2    PPT+W.PPDC2+X1 
          EX5    X2,PPDC2          CALL VALUE SIZE
          ERRNZ  W.PPBSP-W.PPDC2
          BX3    X2 
          LX3    59-S.PPBSP 
          PL     X3,BIV555         NOTHING SPECIFIED FOR THIS PARAMETER 
  
          ZR     X5,BIV540         CHECK FOR *N DEFAULT VALUE 
  
          ERRNZ  W.PPDC2-W.PPDO2
          EX0    X2,PPDO2          FPS OFSET
          SA1    FPS+W.FPSCV+X0 
          JP     BIV545            DISPLAY VALUE SPECIFIED
  
 BIV540   BSS    0
          SA2    PPT+W.PPNDA+X1 
          EX0    X2,PPNDA          CHECK FOR *N DEFAULT VALUE 
          ZR     X0,BIV555         NO DEFAULT - DONT DISPLAY
  
          SA1    PVT+W.PVSTR+X0 
          SA2    PVT+W.PVSIZ+X0 
          EX5    X2,PVSIZ 
          ZR     X5,BIV555         DO NOT DISPLAY NULL VALUE
  
 BIV545   BSS    0
          SB2    X5 
          SA2    SCATX
  
          RJ     =XSTRTASC         CALL VALUE TO SCATX (ASCII)
  
          RJ     =XCCLWID          WRITE CALL VALUE 
  
  
  
  
  
  
 BIV555   BSS    0                 WRITE HELP TEXT
*                                  HELP FILE OPEN AND REWOUND 
  
          SA1    BGPWPL 
          SA2    PPT+W.PPHLP+X1 
          LX2    59-S.PPHLP 
          PL     X2,BIV625         NO HELP - PROMPT FOR ENTRY 
  
          SA3    PPT+W.PPHRC+X1 
          EX0    X3,PPHRC 
          SB2    X0 
  
          RJ     =XCCLWHT          WRITE HELP TEXT
  
  
  
  
  
  
 BIV625   BSS    0
          SA1    =1H
          SB2    1
          SA2    SCATX
          RJ     =XSTRTASC         PUNCTUATION TO SCATX 
          RJ     =XCCLWID          TAB DOWN SCREEN
  
          SA4    IACIDP 
          ZR     X4,BIV630         ADD BATCH MODE PREFIX
  
 OSNOS    IFEQ   HOST,NOS 
          SA1    =3L"EM"           CONTROL BYTE WITH SPACE
          SB2    3
  
 OSNOS    ELSE
  
          SA1    =1H
          SB2    1
  
 OSNOS    ENDIF 
          RJ     =XSTRTASC         BEGINNING OF PROMPT LINE TO SCATX
  
          SA1    BIVEMSG           (ENTER) MESSAGE
          SA4    BIVEMLE           LENGTH 
          SB2    X4 
          JP     BIV315            ISSUE INTERACTIVE PROMPT 
  
  
 BIV630   BSS    0                 APPEND CCL320 PREFIX 
          SA1    MSG320            BATCH MODE PREFIX
          SB2    10 
  
          RJ     =XSTRUPS          PREFIX TO SCATX
  
          SA1    BIVEMSG           (ENTER) MESSAGE
          SA4    BIVEMLE           LENGTH 
          SB2    X4 
          JP     BIV315            PROMPT FOR RE-ENTRY
  
  
  
 BIVCPTR  CON    BIVCMSG           POINTER TO *CORRECT* MESSAGE 
 OSSC2    IFNE   HOST,SC2 
 BIVCMLE  CON    13                LENGTH OF (CORRECT) MESSAGE
 BIVCMSG  CON    10LC^O^R^R^E^
          CON    3LC^T
  
 OSSC2    ELSE
 BIVCMLE  CON    7                 LENGTH OF CORRECT MESSAGE
 BIVCMSG  CON    7LCORRECT
 OSSC2    ENDIF 
  
          ERRNZ  BIVCMLE-BIVCPTR-1  CODE DEPENDS ON RELATIVE LOCATIONS
 BIVEPTR  CON    BIVEMSG           POINTER TO *ENTER* MESSAGE 
 OSSC2    IFNE   HOST,SC2 
 BIVEMLE  CON    9                 LENGTH OF (ENTER) MESSAGE
 BIVEMSG  CON    9LE^N^T^E^R
  
 OSSC2    ELSE
 BIVEMLE  CON    5                 LENGTH OF (ENTER) MESSAGE
 BIVEMSG  CON    5LENTER
 OSSC2    ENDIF 
  
          ERRNZ  BIVEMLE-BIVEPTR-1  CODE DEPENDS ON RELATIVE LOCATIONS
 BIVIDP   BSSZ   1                 INTERACTIVE DIALOGUE IN PROGRESS 
*                                  0 = DISPLAY TITLE THEN HELP MODE 
*                                  1 = SKIP TITLE - INTERACTIVE DIALOGUE IN PROG
  
 BIVHPN   BSSZ   1                 HELP PARAMETER NAME
*         DURING SCREEN MODE AND CCL DIALOGUES, THE PARAMETERS WHICH
*         CONTAIN *N AS THE ONLY PATTERN IN THE CHECKLIST WILL BE 
*         MOVED TO THE END OF THE PARAMETER LIST (PPT).  THESE
*         PARAMETERS WILL NOT BE DISPLAYED OR PROMPTED FOR.  DOING
*         THIS MAKES PROMPTING FOR THE OTHER PARAMETERS IN LINE MODE
*         AND PAGINATION EASIER IN SCREEN MODE. 
  
 BIV1000  BSSZ   1                 ENTRY/EXIT 
          SA1    BIVSRT 
          NZ     X1,BIV1000        LIST ALREADY SORTED - RETURN 
  
          SX7    1
          SA7    A1 
          SA1    PPTCL             LENGTH OF PARAMETERS 
          ZR     X1,BIV1000        NO PARAMETERS - PERFORM DIALOGUE 
  
          SA3    PPT+W.PPNO-LE.PPT
          LX3    59-S.PPNO
          PL     X3,BIV1000        IF ALL PARAMETERS HAVE *N ONLY 
  
          SB6    -LE.PPT           OFFSET INTO THE PPT
          SB7    X1                LENGTH OF PPT
  
 BIV1050  BSS    0
          SB6    B6+LE.PPT
          GE     B6,B7,BIV1000     LIST SORTED - PERFORM DIALOGUE 
  
          SA1    PPT+W.PPNO+B6     CHECK FOR *N ONLY CHECKLIST
          LX1    59-S.PPNO
          NG     X1,BIV1050        NOT *N ONLY - CHECK NEXT ENTRY 
  
          SB3    BIVTMP 
          SB5    B6+LE.PPT
          SB4    B6 
  
 BIV1100  BSS    0
          SA3    PPT+B4            MOVE *N PPT ENTRY TO 
          BX7    X3                A TEMPORARY LOCATION 
          SA7    B3 
          SB3    B3+B1
          SB4    B4+B1
          LT     B4,B5,BIV1100     MOVE NEXT WORD OF PPT ENTRY
  
          SB5    B5-B1             NEXT WORD TO MOVE
 BIV1150  BSS    0
          SB5    B5+B1
          LE     B7,B5,BIV1200     NO MORE ENTRIES TO MOVE
  
          SA1    PPT+B5            MOVE ALL PPT ENTIES TOWARDS
          BX7    X1                THE FRONT OF THE LIST
          SA7    A1-LE.PPT
          EQ     BIV1150           GET THE NEXT WORD
  
 BIV1200  BSS    0
          SB4    B7-LE.PPT
          SB3    BIVTMP 
  
 BIV1250  BSS    0
          SA1    B3                STORE TEMPORARILY SAVED ENTRY AS 
          BX7    X1                THE LAST ENTRY IN THE PPT
          SA7    PPT+B4 
          SB3    B3+B1
          SB4    B4+B1
          LT     B4,B7,BIV1250     NEXT WORD OF ENTRY 
  
          SB5    B6 
          SB7    B7-LE.PPT
          SB6    B6-LE.PPT
          SA1    BGPWPL            ADJUST CURRENT POSITION
          SB4    X1 
          LE     B4,B5,BIV1050     DONT CHANGE BGPWPL 
  
          SX7    B4-LE.PPT
          SA7    A1 
          EQ     BIV1050           SEARCH FOR THE NEXT *N ONLY
  
 BIVEOI   BSSZ   1                 END OF INPUT/ERROR MESSAGE ADDRESS 
 BIVLPP   BSSZ   1                 LAST POSITIONAL PARAMETER
 BIVSHD   BSSZ   1                 SAVE SCATX HEADER
 BIVSRT   BSSZ   1                 1 = *N PARAMETERS SORTED 
 BIVTMP   BSSZ   LE.PPT            TEMP STORAGE FOR PPT ENTRY 
 BPM      TITLE  BPM - BEGIN PROCESSING MENU
**        BPM    -  BEGIN PROCESSING MENU 
* 
*         BPM READS THE CALL STATEMENT, DISPLAYS HELP,
*         DISPLAYS MENUS, AND PROMPTS FOR ERRORS IN SELECTION.
*         THE PROCEDURE HEADER PARAMETER AND CHECKLIST SELECTIONS 
*         HAVE BEEN STORED IN THE PPT.  THE PARAMETER TITLE 
*         AND SELECTION PROMPTS ARE STORED IN THE PVT.  BPM 
*         COMPARES THE SELECTION ON THE CALL OR THE INTERACTIVELY 
*         SPECIFIED SELECTION TO THE ENTRIES IN THE PPT.  WHEN
*         A CORRECT SELECTION IS MADE AN ENTRY IN THE FPS IS
*         CREATED (TO BE USED BY BCB FOR SUBSTITUTION). 
* 
* 
* 
  
 BPM      BSSZ   1                 ENTRY/EXIT 
          SA1    IACIMP            INTERACTIVE MENU PROCESSING
          ZR     X1,BPM            NOT INTERACTIVE MENU - RETURN
  
          SX7    B1 
          MX6    0
 SDOVL    IFNE   IP.SDO,0 
          SA6    SDTOP             SCREEN MODE INITIAL TOP OF PAGE
 SDOVL    ENDIF 
          SA7    IACICF            INTERACTIVE CALL FLAG
          SA6    BGERR
          SA6    IACERR 
          SX3    MSG400            EXPECTING ? OR TERMINATOR AFTER PNAME
  
  
  
 BPM000   BSS    0                 CHECK SEPRATOR 
          SA4    ANSSEP 
          SX0    X4-1R. 
          SX7    X4-1R) 
          ZR     X0,BPM090         READ COMMENTS
          ZR     X7,BPM090         READ COMMENTS
  
          SX0    X4-1R, 
          SX7    X4-1R? 
          ZR     X0,BPM020         READ SELECTION 
          NZ     X7,BPM200         PROMPT FOR BAD SYNTAX
  
  
  
 BPM005   BSS    0                 DISPLAY HELP TEXT
          RJ     BRC               READ COMMENTS AFTER QUESTION MARK
          RJ     =XCCLIDC          INITIALIZE DIALOG
 SDOVL    IFNE   IP.SDO,0 
          SX3    1R?
          RJ     BSM               SCREEN MODE IF POSSIBLE
 SDOVL    ENDIF 
          SA1    BGPHRN            PROC HELP RECORD NUMBER
          NG     X1,BPM010         NO PROC HELP - DISPLAY MENU
  
          SB2    X1 
          RJ     =XCCLWHT          DISPLAY HELP TEXT
  
 BPM010   BSS    0
          SA1    BGPHNL 
          NZ     X1,BPM130         NOLIST, NO MENU - JUST PROMPT
  
          JP     BPM100            DISPLAY MENU 
  
  
 BPM020   BSS    0
  
          RJ     =XCCLGNP1         READ SELECTION 
          SA3    IACERR 
          NZ     X3,BPM200         PROMPT FOR ERROR 
  
          SA1    ANSLIT 
          SA5    ANSCHR 
          SA4    ANSSTR 
          ZR     X1,BPM020A        NOT A LITERAL
  
          SA5    ANSEVLC
          SA4    ANSEVL            EVALUATED LITERAL
  
*         X4 = OPTION NAME
*         X5 = LENGTH OF OPTION NAME
  
  
 BPM020A  BSS    0
          SX3    MSG401            EXPECTING SELECTION
          NZ     X5,BPM025         FIND SELECTION IN CHECKLIST
  
          SA1    ANSSEP 
          SX6    X1-1R? 
          SX0    X1-1R. 
          SX7    X1-1R) 
          ZR     X0,BPM090         READ COMMENTS
          ZR     X7,BPM090         READ COMMENTS
          ZR     X6,BPM005         DISPLAY MENU HELP
          JP     BPM200            PROMPT FOR BAD SELECTION 
  
  
  
  
 BPM025   BSS    0
          SA1    PPTCL
          SB7    X1 
          SB6    B0 
  
 BPM030   BSS    0                 MATCH SELECTION TO CHECKLIST 
          SB6    B6+LE.PPT
          SX3    MSG402            SELECTION NOT IN LIST
          LE     B7,B6,BPM200      PROMPT FOR BAD SELECTION 
  
          SA2    PPT+W.PPFPN+B6 
          BX0    X2-X4             COMPARE CALL SELECTION 
          NZ     X0,BPM030         NEXT SELECTION IN LIST 
  
          SX7    B6 
          SA1    ANSSEP 
          SA7    BGPWPL            SAVE POSITION WITHIN PPT 
          SX0    X1-1R? 
          SX3    MSG403            EXPECTING ? OR TERMINATOR
          SX6    X1-1R. 
          SX7    X1-1R) 
          ZR     X6,BPM050         STORE SELECTION IN FPS 
          ZR     X7,BPM050         STORE SELECTION IN FPS 
          ZR     X0,BPM040         DISPLAY HELP TEXT
  
          SA2    IACIDP            CHECK DIALOG 
          ZR     X2,BPM200         PROMPT FOR NO .)?
          NG     X1,BPM050         STORE SELECTION IN FPS 
          JP     BPM200            PROMPT FOR BAD SEPARATOR 
  
  
  
*         DISPLAY HELP TEXT FOR A MENU SELECTION
  
 BPM040   BSS    0
          RJ     BRC               READ COMMENTS AFTER QUESTION MARK
          RJ     =XCCLIDC          INITIALIZE DIALOGUE
 SDOVL    IFNE   IP.SDO,0 
          SX3    2RP? 
          RJ     BSM               SCREEN MODE IF POSSIBLE
 SDOVL    ENDIF 
  
          SA3    BGPWPL 
          SA2    PPT+W.PPHLP+X3 
          LX2    59-S.PPHLP 
          PL     X2,BPM100         NO HELP TEXT - DISPLAY MENU
  
          SA1    PPT+W.PPHRC+X3 
          EX0    X1,PPHRC 
          SB2    X0                HELP RECORD NUMBER 
          RJ     =XCCLWHT          DISPLAY HELP TEXT
  
          SA1    BGPWPL 
          SA2    PPT+W.PPHPN+X1    CHECK NOLIST 
          LX2    59-S.PPHPN 
          NG     X2,BPM130         NOLIST, NO MENU - PROMPT 
  
          JP     BPM100            DISPLAY MENU 
  
  
  
*         X4 = OPTION NAME
*         X5 = LENGTH OF OPTION NAME
  
  
 BPM050   BSS    0
          SA2    PPT+W.PPDO1       GET FPS OFFSET 
          EX1    X2,PPDO1 
          BX7    X4 
          ERRNZ  W.PPDC1-W.PPDO1
          MX0    -N.PPDC1 
          BX6    -X0*X5 
          LX0    S.PPDC1-N.PPDC1+1
          LX6    S.PPDC1-N.PPDC1+1
          BX5    X0*X2
          BX6    X6+X5
          SA6    A2 
          SA7    FPS+W.FPSRV+X1 
  
  
*         AT THIS POINT THE SELECTION ON THE CALL IS VALID
*         AND WAS STORED IN THE FPS FOR SUBSTITUTION. 
*         CHANGE THE SIZE OF THE PPT TO INDICATE ONE
*         PARAMETER.  IF THERE WAS A COMMENT KEYWORD, 
*         MAKE IT THE SECOND PPT PARAMETER AND CHANGE 
*         THE LENGTH OF THE PPT ACCORDINGLY.
*         RESTORE THE ORIGINAL CHARACTER SET SELECTION. 
  
 OSNOS    IFEQ   HOST,NOS 
          CSET   RESTORE
 OSNOS    ENDIF 
  
          RJ     BRC               READ COMMENTS IF ANY 
  
          MX7    0
          SA7    IACIDP            TERMINATE DIALOG 
          SA7    IACICF            CLEAR INTERACTIVE CALL FLAG
          SA1    BGNAML 
          SX6    LE.PPT 
          SA2    PPTCL
          SA6    PPTCL             ONE FORMAL PARAMETER 
          ZR     X1,BPM            RETURN IF NO COMMENT KEYWORD 
  
          SA4    PPT+X2            MOVE COMMENT KEYWORD PPT ENTRY 
          BX7    X4 
          SA7    PPT+X6 
          SX6    X6+LE.PPT         UPDATE LENGTH OF PPT 
          SA5    A4+B1
          SA6    PPTCL
          BX7    X5 
          SA7    A7+B1
          SA4    A5+B1
          BX6    X4 
          SA6    A7+B1
          ERRNZ  LE.PPT-3 
          JP     BPM               RETURN - RUN PROC
  
  
  
  
 BPM090   BSS    0
  
          RJ     BRC               READ COMMENTS
  
 BPM100   BSS    0                 DISPLAY MENU 
  
          RJ     =XCCLIDC          INITIALIZE DIALOG CONDITIONS 
 SDOVL    IFNE   IP.SDO,0 
          MX3    0
          RJ     BSM               SCREEN MODE IF POSSIBLE
 SDOVL    ENDIF 
  
*         OTHERWISE TITLE IN LINE MODE
  
          RJ     BDT               DISPLAY TITLE
          MX7    0
          SA7    BGPWPL            INITIAL PPT POSITION 
 BPM110   BSS    0                 FORMAT EACH LINE FOR DISPLAY 
  
 OSNOS    IFEQ   HOST,NOS 
          SA3    IACIDP 
          ZR     X3,BPM110A        NO DIALOG - SKIP 0011B BYTE
  
          SA1    =2L"EM"
          SB2    2
          RJ     =XSTRUPS 
 BPM110A  BSS    0
 OSNOS    ENDIF 
  
          SA3    BGPWPL 
          SA4    PPTCL
          SX6    X3+LE.PPT
          IX0    X6-X4
          PL     X0,BPM130         END OF SELECTIONS
  
          SA6    BGPWPL 
          SA3    PPT+W.PPFPC+X6 
          EX0    X3,PPFPC          ALIGN OPTIONS FOR DISPLAY
          SX7    X0-2 
          SA1    =1H
          SB2    B1 
          PL     X7,BPM110B        OPTION IS 2 DIGITS OR .GT. 
  
          SA1    =2H
          SB2    2
  
 BPM110B  BSS    0
          RJ     =XSTRTASC
          SA5    BGPWPL 
          SA1    PPT+W.PPFPN+X5    OPTION NAME
          SA3    PPT+W.PPFPC+X5 
          EX0    X3,PPFPC 
          SB2    X0 
          RJ     =XSTRTASC
          SA1    =2H.              PUNCTUATION AND SPACE
          SB2    2
          RJ     =XSTRTASC
          SA1    BGPWPL 
          SA3    PPT+W.PPMTP+X1    PROMPT STRING AVAILABLE
          LX3    59-S.PPMTP 
          NG     X3,BPM115         DISPLAY PROMPT 
  
          RJ     =XCCLWID          DISPLAY OPTION - NO PROMPT 
          JP     BPM110            NEXT OPTION
  
  
 BPM115   BSS    0                 DISPLAY PROMPTS
          RJ     =XCCLPVO          PVT OFFSET OF PROMPT 
          RJ     =XCCLNPV          GET PROMPT FROM PVT
  
          SA3    IACPRE 
          EX0    X2,PVSIZ 
          SA1    PVT+W.PVSTR+X3 
          SB2    X0 
          SA2    SCATX
          RJ     =XSTRCADC         PROMPT TO SCATX
          RJ     =XCCLWID 
          JP     BPM110            GET NEXT SELECTION 
  
  
  
 BPM130   BSS    0                 PROMPT FOR SELECTION 
          SA2    SCATX
          SA1    =1H
          SB2    B1 
          RJ     =XSTRTASC
          RJ     =XCCLWID          SEND LINE
  
 OSNOS    IFEQ   HOST,NOS 
          SA1    =2L"EM"
          SB2    2
 OSNOS    ELSE
          SA1    =1H
          SB2    1
 OSNOS    ENDIF 
  
          SA4    IACIDP            CHECK DIALOGUE 
          NZ     X4,BPM140         SKIP CCL320 PREFIX 
  
          SA1    MSG320            BATCH MODE PREFIX
          SB2    10 
  
 BPM140   BSS    0
          RJ     =XSTRTASC         PREFIX TO SCATX
  
*         USE THE USER SUPPLIED PROMPT, IF THERE IS ONE.
  
          SA1    BGODT             OFFSET OF .DIRECTIVE TEXT
          SA2    PVTCL
          BX7    X1 
          BX6    X2 
          SA7    IACNPV            NEXT PVT OFFSET
          SA6    IACLPE            LAST ENTRY 
          SA7    IACPRE            PREVIOUS PVT OFFSET
  
 BPM150   BSS    0
          RJ     =XCCLNPV          GET NEXT PVT ENTRY 
          ZR     X2,BPM160         USE CCL SUPPLIED PROMPT
  
          SA4    =6LPROMPT
          BX7    X0-X4
          NZ     X7,BPM150         GET NEXT ENTRY 
  
          SA1    A2+W.PVSTR 
          GT     B2,B0,BPM165      USER SUPPLIED PROMPT TO SCATX
  
 OSNBE    IFEQ   HOST,NOSBE 
          MX7    0
          SA7    SCATX             CLEAR SCATX - DEFAULT PROMPT 
 OSNBE    ENDIF 
  
 BPM160   BSS    0
          SA1    MSG405            PROMPT FOR ENTRY 
          SB2    35 
 BPM165   BSS    0
          SA2    SCATX
          RJ     =XSTRCADC         PROMPT TO SCATX
          SX7    1
          SA7    BGPRMT            INDICATE 0013B BYTE ON NOS 
  
          RJ     =XCCLWID          SEND LINE
  
          SA3    IACIDP            CHECK DIALOGUE 
          ZR     X3,BRWERR1        DIALOGUE NOT POSSIBLE - BATCH JOB
  
  
 OSNOSBE  IFNE   HOST,SC2 
  
 OSNBE    IFEQ   HOST,NOSBE 
          SA1    =1H
          SB2    B1 
          RJ     =XSTRTASC         PUT BLANK LINE AFTER PROMPT
          RJ     =XCCLWID          SEND LINE
  
          WRITER O,R               FLUSH CIO BUFFER 
  
 OSNBE    ENDIF 
  
  
  
*         READ RESPONSES
  
  
 OSNBE    IFEQ   HOST,NOSBE 
          SA2    I                 SET CODE AND STATUS FIELD
          MX3    59                IN THE FET INDICATING
          LX3    1                 CODED FILE 
          BX7    X2*X3
          SA7    A2 
 OSNBE    ENDIF 
  
  
          READ   I,R               REFRESH CIO BUFFER 
  
          SX2    I
          SX3    RBUF              LINE BUFFER
          SX6    SCATBF1           SCATTER BUFFER ADDRESS 
          SX4    V.SBSIZ           SIZE OF BUFFER 
  
          RJ     =XIORDL           READ LINE
          ZR     X1,BPM170         IF NOT NULL RESPONSE 
  
          RJ     BITV              INPUT TERMINAL VERIFICATION
  
          ZR     X3,BPM100         IF IT IS A TERMINAL
  
          PL     X1,BPM100         IF NOT AT END OF INFORMATION 
  
          JP     BRWERR            ABORT WITH ERROR MESSAGE 
  
 BPM170   BSS    0
  
          RJ     =XCCLGNP1         GET 1ST STRING 
          SA3    IACERR 
          NZ     X3,BPM200         PROMPT FOR ERROR 
  
          SA1    ANSSEP 
          SX3    MSG404            EXPECTING SELECTION OR HELP
          SA4    ANSSTR 
          SA5    ANSCHR 
          ZR     X5,BPM000         CHECK FOR HELP CALL
  
          SA2    =1LQ 
          BX0    X4-X2
          NZ     X0,BPM025         CHECK SELECTION
  
 OSNOS    IFEQ   HOST,NOS 
          MESSAGE ,1,R             CLEAR MESSAGE BUFFER 
  
 OSNOS    ENDIF 
  
  
          EQ     EXIT2             RETURN FILES - ABORT 
 OSNOSBE  ENDIF 
  
  
  
  
 BPM200   BSS    0                 PROMPT FOR ERRORS
          MX6    0
          BX7    X3 
          SA6    SCATX
          SA7    BGERR
          RJ     =XCCLIDC          INITIALIZE DIALOG CONDITIONS 
  
 SDOVL    IFNE   IP.SDO,0 
          MX3    0
          RJ     BSM               TRY SCREEN MODE DIALOGUE 
  
 SDOVL    ENDIF 
  
*         OTHERWISE TITLE IN LINE MODE
  
          RJ     BDT               DISPLAY TITLE
  
          SA3    BGERR
          RJ     =XCCLWID          SEND ERROR MSG 
  
*         BLANK LINE AFTER ERROR MSG
  
          SA1    =1H
          SB2    1
          RJ     =XSTRTASC
          RJ     =XCCLWID 
          MX7    0
          SA7    BGERR
          SA7    IACERR 
          SA7    BGPWPL            INITIAL PPT POSITION 
          JP     BPM110            DISPLAY MENU SELECTIONS
  
          TITLE  BPP  -  BEGIN, PROCESS PARAMETERS(OF BEGIN STATEMENT)
**        BPP  -  BEGIN, PROCESS PARAMETERS FROM BEGIN STATEMENT
* 
*         PPT NOW CONTAINS AN ENTRY FOR EACH FORMAL PARAMETER 
*         WITH THE FIRST AND SECOND DEFAULT SPECIFICATIONS
*         IDENTIFIED VIA OFFSETS AND CHARACTER LENGTH IN FPS. 
*         AS THE BEGIN CARD IS PROCESSED THE VALUES TO BE 
*         SUBSTITUTED FOR THE PARAMETERS ARE MOVED INTO FPS.
*         THUS THE FIRST DEFAULT SPECIFICATION IS DESTROYED.  THERE 
*         IS ALWAYS ROOM BECAUSE ALL ENTRIES OF FPS ARE THE SIZE
*         OF THE MAXIMUM SPECIFICATION.  IF A SECOND DEFAULT IS 
*         SELECTED THEN THE PPT ENTRY IS MODIFIED SO THAT THE 
*         OFFSETS OF THE SECOND DEFAULT IS MOVED INTO THE 
*         OFFSETS OF THE FIRST DEFAULT.  THUS SELECTING SECOND DEF. 
  
 BPP      BSSZ   1           ENTRY/EXIT 
          SA4    IACIPF 
          NZ     X4,BPP      RETURN IF INTERACTIVE FLAG SET 
  
          MX7    0
          SA7    BGPWPL 
 BPP01    BSS 
          SA4    ANSSEP 
          SX0    X4-1R. 
          SX7    X4-1R) 
          ZR     X0,BPP      EXIT IF TERMINATOR 
          ZR     X7,BPP      EXIT IF TERMINATOR 
  
          SA5    PPTCL       LENGTH OF PARAMETER TABLE
          ZR     X5,BPP02    NO PARAM - IGNORE THOSE ON BEGIN 
  
          SX0    X4-1R, 
          NZ     X0,BRWERR2  INVALID SEPARATOR IF NOT COMMA 
  
 BPP02    BSS 
          RJ     =XCCLGNP    GET NEXT BEGIN PARAMETER 
          NZ     X5,BRWERR1  ABORT IF ERROR 
  
          SA5    BGPWPL 
          SA4    ANSSEP 
          SA3    BGEQMD 
          SA2    ANSCHR 
          SX7    X5+B1
          SA7    A5          BGPWPL 
          SX0    X4-1R= 
          ZR     X0,BPP03    IF   = 
  
          SA4    ANSSEP 
          SX0    X4-1R- 
          SX5    X4-1R+ 
          SX6    X4-1R/ 
          ZR     X0,BPP02B   - IS PART OF SYMBOLIC VALUE
          ZR     X5,BPP02B   + IS PART OF SYMBOLIC VALUE
          ZR     X6,BPP02B   / IS PART OF SYMBOLIC VALUE
  
          ZR     X2,BPP01    NULL, IGNORE IF NOT FOLLOWED BY =+-/ 
  
 BPP02B   BSS    0
  
          NZ     X3,BPP04    IF IN EQUIVALENCE MODE 
  
*         THE BEGIN CARD PROCESSING IS STILL IN POSITIONAL MODE.
*         IF THE PROCEDURE HAD A SECOND DEFAULT EXPLICITLY
*         DEFINED BEFORE THIS PARAMETER POSITION, INITIATE EQUIV. MODE. 
  
          SA5    BGPFSD 
          IX0    X7-X5
          ZR     X5,BPP09    IF NO EXPLICT, SECOND DEFAULT
          NG     X0,BPP09    IF STILL TO REMAIN POSITIONAL
  
 BPP03    BSS 
          SX7    B1 
          SA7    BGEQMD 
 BPP04    BSS 
  
*         SEARCH  PPT 
  
          SA1    PPTCL
          SA5    ANSLIT 
          SA2    ANSCHR 
          SB6    B0 
          SB7    X1          LENGTH OF PPT
          SA3    ANSSTR 
          ZR     X5,BPP05    IF NOT A LITERAL 
  
          SA2    ANSEVLC
          SA3    ANSEVL 
 BPP05    BSS 
          SX0    X2-V.FPC-1 
          ZR     X2,BPP15    IF NULL, ERR 
          PL     X0,BPP16    IF TOO MANY CHARS. 
  
 BPP06    BSS 
          GE     B6,B7,BPP16    ERR IF NOT FOUND
  
          SA5    PPT+W.PPFPN+B6 
          BX0    X3-X5
          SB6    B6+LE.PPT
          NZ     X0,BPP06    IF NOT CORRECT ENTRY 
  
          SA4    A5+B1       SECOND WORD OF ENTRY 
          SX7    A5 
          SA7    BPPENT      SAVE PPT ENTRY ADDRESS 
          MX7    1
          ERRNZ  59-S.PPBSP 
          BX7    X4+X7       SET PPBSP
          SA7    A4          STORE PPBSP
          PL     X4,BPP07    IF NOT ALREADY SPECIFIED 
  
*         ISSUE DUPLICATE SPECIFICATION MESSAGE 
  
          SX0    ANSSTR 
          SX3    MSG204 
          LX0    18 
          BX3    X0+X3
          RJ     =XSTRMSG    ISSUE INFORMATIVE MESSAGE
  
 BPP07    BSS 
          SA4    ANSSEP 
          SX0    X4-1R= 
          NZ     X0,BPP08    IF SEPARATOR NOT AN  = 
  
          RJ     =XCCLGNP 
          NZ     X5,BRWERR1  ABORT IF ERROR 
  
          JP     BPP10
  
*         FORMAL PARAMETER HAS SPECIFIED SECOND DEFAULT 
  
 BPP08    BSS 
          SA5    BPPENT 
          SA4    X5+W.PPDC1 
          MX7    -N.PPDO1-N.PPDC1 
          BX4    X4*X7       CLEAR FIRST DEFAULT
          BX0    X4 
          AX0    S.PPDC2-S.PPDC1
          BX0    -X7*X0 
          BX7    X0+X4
          SA7    A4 
          JP     BPP01
  
 BPP09    BSS 
          SA2    BGPWPL 
          SA1    PPTCL
          SX2    X2-1 
          SX4    LE.PPT 
          IX2    X2*X4
  
*         NOTE, PPBSP WAS NOT SET SO THAT IF AN EQUIVALENCED
*         SPECIFICATION OVERRIDES THE POSITIONAL SPECIFICATION
*         THE DUPLICATE SPECIFICATION MESSAGE IS NOT ISSUED.
  
          IX0    X2-X1
          SX7    PPT+X2 
          PL     X0,BPP01    IGNORE EXTRA POSITIONAL PAR. 
  
          SA7    BPPENT      SAVE PPT ENTRY ADDRESS 
 BPP10    BSS 
  
*         MOVE SPECIFICATION TO FPS.  IF THE SPECIFICATION IS FOLLOWED
*         BY A  +  THEN THE NUMERIC VALUE OF THE SYMBOL IS TO BE
*         CONVERTED TO DISPLAY CODE AND THAT CHARACTER STRING IS
*         THE REAL SPECIFICATION. 
  
          SA4    ANSSEP 
          SX0    X4-1R+ 
          SX1    X4-1R- 
          ZR     X0,BPP11    IF    +
          SX7    X4-1R/ 
          ZR     X1,BPP11    IF    -
          NZ     X7,BPP12    IF NOT  /
  
 BPP11    BSS 
          RJ     BSC         BEGIN, SPECIFICATION CONVERSION
  
 BPP12    BSS 
          SA5    BPPENT 
          SA4    ANSLIT 
          MX7    1
          LX7    S.PPBSP+1
          SA5    X5+W.PPBSP  FETCH WORD OF ENTRY
          SA2    ANSCHR 
          MX3    -N.PPDO1 
          BX7    X5+X7
          BX3    -X3*X5      EXTRACT OFFSET 
          SA1    ANSSTR 
          ZR     X4,BPP13    IF NOT LITERAL 
  
          LX5    59-S.PPLIT 
          NG     X5,BPP13    USE UNEVALUATED FORM 
  
          SA1    ANSEVL 
          SA2    ANSEVLC
 BPP13    BSS 
          MX0    N.PPDC1
          SB6    X2 
          LX0    S.PPDC1+1
          LX2    S.PPDC1+1-N.PPDC1
          BX7    -X0*X7      CLEAR OLD CHARACTER COUNT
          SB7    B0 
          BX7    X2+X7
          SB5    X3          FPS OFFSET 
          SA7    A5          W.PPBSP
          EQ     B0,B6,BPP01  IF NULL 
          SB4    V.SCS       MAXIMUM CHARACTERS IN SPECIFICATION
          SX3    MSG211      $SPECIFICATION EXCEEDS IP.SCS CHARS$ 
          LT     B4,B6,BRWERR  ERR IF TOO MANY CHARS. 
  
*                A1  = STRING ADDRESS 
*                B5  = OFFSET IN FPS
*                B6  = NUMBER CHARACTERS TO TRANSFER
*                B7  = 0, USED AS OFFSET IN STRING
  
 BPP14    BSS 
  
          SA3    A1+B7       NEXT TEN CHARACTERS OF STRING
          BX7    X3 
          SA7    FPS+B5 
          SB7    B7+B1
          SB5    B5+B1
          SB6    B6-10
          LT     B0,B6,BPP14
  
          JP     BPP01
  
 BPP15    BSS 
          SA3    =0L*NULL*
 BPP16    BSS 
          SX0    A3          LOCATION OF FORMAL PARA. STRING
          SX3    MSG205      $FORMAL PARAMETER LIST DOES NOT INCLUDE$ 
          LX0    18 
          BX3    X0+X3
          JP     BRWERR      ABORT
  
 BPPENT   BSS    1           TEMP STORAGE TO SAVE PPT ENTRY ADDRESS 
 BRC      TITLE  BRC - BEGIN READ COMMENTS
**        BRC    - BEGIN READ COMMENTS
* 
*         BRC DETERMINES WETHER A COMMENT PARAMETER WAS PRESENT 
*         ON THE PROC HEADER.  IF THERE WAS BRC READS THE COMMENTS
*         FOLLOWING THE TERMINATOR ON THE CALL.  BRC CREATES A PPT
*         AND FPS ENTRY.  THE COMMENTS ARE SUBSTITUTED FOR ALL
*         OCCURANCES OF THE COMMENT PARAMETER IN THE PROC BODY. 
* 
* 
*         ENTRY - BGNAME - COMMENT PARAMETER NAME 
*                 BGNAML - LENGTH OF PARAMETER NAME 
*                 CALL IN SCATBF1 
* 
*         EXIT - NONE 
* 
* 
 BRC      BSSZ   1                 ENTRY/EXIT 
          SB1    1
          SA4    BGNAME 
          SA5    BGNAML 
          ZR     X5,BRC            RETURN - NO COMMENT PARAMETER
  
          SA1    PPTCL             CREATE PPT ENTRY FOR COMMENT PARAMETER 
          ERRNZ  W.PPDO1-W.PPFPC
          ERRNZ  W.PPDO1-W.PPDC1
          SA3    PPT+W.PPDO1+X1 
          BX7    X3 
          SB3    X1                PPT OFFSET 
          EX0    X3,PPDO1 
          SB4    X0                FPS OFFSET 
  
*         B4 = FPS OFFSET 
*         B3 = PPT OFFSET 
*         X7 = PPT WORD W.PPDC1 
  
 BRC010   BSS    0
          SA3    SCATBF1
          SB7    X3                CURRENT SCATTER BUFFER POSITION
          AX3    S.SBTOT-N.SBTOT+1
          SB6    X3                TOTAL CHARACTERS IN BUFFER 
  
*         COMMENTS ARE USED IF THEY APPEAR FOLLOWING A TERMINATOR.
*         SEARCH THE REMAINDER OF THE CALL OR INTERACTIVE RESPONSE. 
*         IF A TERMINATOR IS FOUND READ THE COMMENTS, OTHERWISE 
*         RETURN. 
  
 BRC012   BSS    0
          SB2    B6-B7
          SA2    A3+B7             CHECK FOR TERMINATOR 
          SX0    X2-1R. 
          SX6    X2-1R) 
          ZR     X0,BRC015         TERMINATOR FOUND - READ COMMENTS 
          ZR     X6,BRC015         TERMINATOR FOUND - READ COMMENTS 
          LE     B2,B0,BRC         RETURN - NO COMMENTS 
  
          SB7    B7+B1
          JP     BRC012            KEEP LOOKING FOR TERMINATOR
  
 BRC015   BSS    0
 OSNBE    IFEQ   HOST,NOSBE 
  
*         ON NOS/BE A TERMINATOR IS APPENDED TO THE CALL, IF ONE
*         DOES NOT ALREADY EXIST.  THIS TERMINATOR WILL SHOW UP 
*         ON CALL COMMENTS UNLESS SOME EFFORT IS MADE TO REMOVE 
*         IT.  DIALOGUE RESPONSES (CONNECTED I/O) ARE NOT AFFECTED
*         BY THIS.  SO, CHECK THE DIALOGUE AND THEN REMOVE THE
*         TERMINATOR. 
  
          SA1    IACIDP            CHECK IF DIALOGUE IN PROGRESS
          NZ     X1,BRC020         PROCESS DIALOGUE RESPONSE COMMENTS 
          LE     B2,B0,BRC020      NO COMMENTS - SO CONTINUE
  
          SA5    SCATBF1+B6 
          SX0    X5-1R. 
          NZ     X0,BRC020         LAST CHARACTER NOT A PERIOD
  
  
          SB2    B2-B1
 BRC020   BSS    0
 OSNBE    ENDIF 
          SX2    B2 
          BX3    X2 
          LX2    S.SBTOT-N.SBTOT+1
          OX6    X7,X3,PPDC1
          BX7    X2 
          SA6    PPT+W.PPDC1+B3 
          SA7    A2                STORE HEADER BEFORE 1ST CHARACTER
          SA1    FPS+B4            FPS + PPDO1 OFFSET 
          RJ     =XSTRPKS          PACK INTO FPS ENTRY
          JP     BRC               RETURN 
  
  
  
 BRCREAD  BSSZ   1                 1 = CALL COMMENTS ALREADY READ 
          TITLE  BRD - BEGIN, READ DIRECTORY
**        BRD  -  BEGIN, READ DIRECTORY 
* 
*         ENTRY  (X2) = FET ADDRESS 
*                (X5) = FILE NAME 
* 
*         EXIT   (X1) = 0 IF DIRECTORY NOT FOUND
*                            FILE ADDRESS RESET FOR NEXT
*                            PROCEDURE TO BE READ 
* 
*                       0 IF PROCNAME NOT FOUND ON DIRECTORY
* 
*                       NONZERO (RANDOM ADDR) IF PROC FOUND 
* 
* 
 RLD      IFEQ   IP.RLD,1 
  
 BRD      BSSZ   1           ENTRY/EXIT 
  
          MX4    42 
          SA3    =5LINPUT    CHECK FOR INPUT
          BX0    X4*X5
          BX6    X0-X3
          MX1    0           PRESET DIRECTORY NOT FOUND 
          ZR     X6,BRD      RETURN IF LFN = INPUT
  
          SA1    X2+6        GET CURRENT RANDOM ADDRESS 
 OSNOS    IFEQ   HOST,NOS 
          AX1    30 
 OSNOS    ENDIF 
          BX6    X1 
          SA6    BRDA        SAVE NEXT READ ADDRESS 
  
          RJ     =XIOFET     RESET IN/OUT 
  
 OSNOS    IFEQ   HOST,NOS 
*         SEARCH FOR OPLD DIRECTORY 
  
          SKIPEI X2,R 
          SKIPB  X2,2,R 
          READ   X2 
          READW  X2,BRDB,B1 
          NZ     X1,BRD5     IF EOR OR EOF
  
          SA1    BRDB 
          LX1    18 
          SX6    X1-770000B 
          NZ     X6,BRD5     NO 7700 TABLE
  
          LX1    6
          SX3    X1-BRDBL 
          PL     X3,BRD5     IF UNUSUAL PREFIX TABLE
  
          READW  X2,BRDB,X1 
          READW  X2,BRDB,B1 
          SA4    BRDB 
          LX4    18 
          BX3    X4 
          SX6    X4-700000B 
          LX3    18 
          SX3    X3 
          NZ     X3,BRD5     IF NOT OPLD
  
          NZ     X6,BRD5     IF NOT OPLD
 OSNOS    ELSE
  
          RJ     =XIOREW     REWIND TO AVOID READ AFTER WRITE OR SKIP 
  
          OPEN   X2,READNR,R
  
          SA1    X2+W.FERA   CHECK FOR RANDOM ACCESS LIB
          LX1    59-S.FERA
          PL     X1,BRD5     NOT RANDOM ACCESS LIB
  
*         IF THE LIBRARY IS NOT A USER LIBRARY THE INDEX WILL BE
*         LONGER THAN 6 WORDS.  (FET+0 ERROR CODE 23B)
  
          SA3    X2+W.FEEC   CHECK FOR ERROR CODE 23B 
          EX0    X3,FEEC
          SX6    X0-23B 
          ZR     X6,BRD5     NOT A USER LIBRARY 
  
          SA4    PCINDX 
          MX0    24 
          BX6    X0*X4
          SA3    =4LEPNT     CHECK 1ST WORD OF INDEX
          BX0    X3-X6
          NZ     X0,BRD5     NOT A LIBRARY - RETURN 
  
*         PUT ADDRESS OF PNT IN FET+6 
  
          SA3    X2+W.FERI
          SA4    PCINDX+3 
          OX7    X3,X4,FERI 
          SA7    A3 
          READ   X2 
  
 OSNOS    ENDIF 
  
  
  
  
*         OPLD DIRECTORY FOUND - LOCATE PROC
  
 BRD3     BSS    0
          READW  X2,BRDB,2
          NZ     X1,BRD7     PROC NOT FOUND 
  
          SX4    20B         PROC TYPE
          SA3    PROCNAM
          SA1    BRDB 
 OSNOS    IFEQ   HOST,NOS 
          BX7    X4+X3
          BX6    X1-X7
 OSNOS    ELSE
          BX4    X1          CHECK FOR A PROCEDURE
          LX4    59-S.PNTPC 
          PL     X4,BRD3     THIS RECORD NOT A PROC 
  
          MX7    N.PNTNM
          BX0    X7*X1
          BX6    X0-X3
 OSNOS    ENDIF 
          NZ     X6,BRD3     IF NOT THIS RECORD 
  
          RJ     =XIOFET     RESET IN/OUT POINTERS
  
 OSNOS    IFEQ HOST,NOS 
          SA1    BRDB+1      GET RANDOM ADDRESS 
          BX6    X1 
          SA6    X2+6 
 OSNOS    ELSE
          SA1    BRDB+W.PNTDA 
          SA4    X2+W.FERI   GET ADDRESS OF PROC
          EX0    X1,PNTDA 
          OX6    X4,X0,FERI 
          SA6    A4 
 OSNOS    ENDIF 
          JP     BRD         RETURN WITH X1 .GT. 0
  
*         NO OPLD DIRECTORY WAS FOUND 
  
 BRD5     BSS    0
  
          RJ     =XIOFET     RESET POINTERS 
  
          SX6    B1          IF FILE NEVER POSITIONED BEFORE USE 1
          SA3    BRDA 
          MX1    0           SET NO DIRECTORY FOUND 
          ZR     X3,BRD6     IF FILE WAS NEVER POSITIONED 
  
          BX6    X3 
 BRD6     BSS    0
          SA6    X2+6        RESET READ ADDRESS 
          JP     BRD         RETURN WITH (X1=0) 
  
*         PROC NOT FOUND IN DIRECTORY 
  
 BRD7     BSS    0
          MX1    1           INDICATE PROC NOT IN OPLD
          EQ     BRD         RETURN 
  
 BRDA     CON    0           TEMP FOR RANDOM ADDRESS
  
 BRDBL    EQU    24          MAX LENGTH OF PREFIX TABLE 
 BRDB     BSSZ   BRDBL       PREFIX TABLE WORK SPACE
 RLD      ENDIF 
 BRH      TITLE  BRH - BEGIN, READ HELP 
**        BRH    -  BEGIN, READ HELP
  
  
  
*         BRH DOES SEVERAL TASKS BESIDES READING THE HELP TEXT. 
*         FIRST BRH MUST DETERMINE WHETHER A COMMENT KEYWORD
*         EXISTS AFTER THE TERMINATOR ON THE HEADER.  THE KEYWORD 
*         NAME AND LENGTH IS SAVED OTHERWISE BRH IGNORES ANY MISC.
*         COMMENTS WHICH MAY FOLLOW THE TERMINATOR ON THE HEADER. 
  
*         NEXT BRH WILL ATTEMPT TO READ THE .SCREEN FORMAT DIRECTIVES.
*         IF .* COMMENTS ARE FOUND THEY ARE IGNORED.  IF A .HELP
*         DIRECTIVE IS FOUND BRH WILL BEGIN PROCESSING OF HELP
*         TEXT.  IF A PROCEDURE BODY LINE IS FOUND DIRECTLY AFTER 
*         THE HEADER BRH WILL REPOSITION SCATBF2 AND RETURN.  IF A
*         SYSTEM EOR FOLLOWS THE HEADER, BRH WILL SEND AN INFORMATIVE 
*         DIAGNOSTIC AND EXIT.  THE PROMPT TEXT IS STORED IN THE PVT. 
*         THE LENGTH AND PVT OFFSET ARE STORED. 
  
*         FOR INTERACTIVE PROCEDURES BRH FORMATS THE CHECKLIST VALUES 
*         (IF NOLIST IS NOT SPECIFIED) FOR EACH PARAMETERS AND STORES 
*         THESE LINES IN THE SAME RECORD AS THE HELP TEXT FOR THAT
*         PARAMETER.  IF NO .HELP STATEMENTS ARE FOUND BRH REPOSITIONS
*         SCATBF2 AND RETURNS.  .* COMMENTS PRECEDING THE 1ST .HELP 
*         ARE DISCARDED.
* 
* 
  
 BRH      BSSZ   1           ENTRY/EXIT 
          SA1    IACIPF 
          ZR     X1,BRH      NOT INTERACTIVE PROC - RETURN
  
  
*         STORE PVT OFFSET OF 1ST .DIRECTIVE TEXT 
  
          SA3    PVTCL
          BX7    X3 
          SA7    BGODT
          SX7    B1 
          SA7    ANSMDE      BLANKS/LITERALS NOT COMMENT KEYWORDS 
          SA2    SCATBF2
          RJ     =XSTRANS    READ COMMENT KEYWORD 
          MX7    -0          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      ALL ARE SEPARATORS 
  
          SA4    ANSSEP 
          SX0    X4-1R.      PERIOD MUST FOLLOW KEYWORD 
          NZ     X0,BRH001   IGNORE COMMENT STRING
  
          SA5    ANSCHR 
          SA4    ANSSTR 
          ZR     X5,BRH001         NO COMMENT PARAMETER 
  
          SX0    X5-V.FPC-1 
          PL     X0,BRH001   IGNORE COMMENT STRINGS ON CALL 
  
          BX7    X5 
          BX6    X4 
          SA7    BGNAML            SAVE LENGTH OF NAME
          SA6    BGNAME 
          SA1    PPTCL             CREATE PPT ENTRY FOR COMMENT PARAM 
          SA6    PPT+W.PPFPN+X1    STORE PARAMETER NAME 
          ERRNZ  W.PPDO1-W.PPFPC
          ERRNZ  W.PPDO1-W.PPDC1
          SA3    FPSCL
          MX0    0
          OX6    X0,X5,PPFPC       LENGTH OF PARAMETER NAME 
          OX7    X6,X3,PPDO1       FPS OFFSET OF NAME 
          SX6    X3+V.CCCW         FPS ENTRY SIZE (LENGTH OF COMMAND) 
          SA7    PPT+W.PPDO1+X1 
          SA6    FPSCL             UPDATE LENGTH OF FPS 
  
  
 BRH001   BSS    0                 READ .HELP STATEMENTS
  
 OSSC2    IFEQ   HOST,SC2 
          OPENM  FILEHP,I-O,R 
 OSSC2    ENDIF 
  
          SX2    FILEHP 
          RJ     =XIOREW     REWIND HELP TEXT FILE
  
          SX7    -1 
          SA7    BGPHRN      SET HELP RECORD NUMBER TO -1 
          MX6    0
          SA7    BRHELP 
          SA6    SCATBF2     CLEAR SCATTER BUFFER HEADER
  
 BRH005   BSS    0
          SX6    SCATBF2
          SX2    FILEPC 
          SX3    HPBUF       LINE BUFFER ADDRESS
  
 OSSC2    IFEQ   HOST,SC2 
          SX5    HPBUFL 
          SB7    X5 
          MX7    0
  
 BRH005A  BSS    0           CLEAR LINE BUFFER
          SA7    X3+B7
          SB7    B7-B1
          GE     B7,B0,BRH005A  KEEP CLEARING 
  
 OSSC2    ENDIF 
          SX4    V.CCCPC     LENGTH OF LINE 
          RJ     =XIORDL     READ LINE
  
          NZ     X1,BRH060   NO .ENDHELP FOUND
  
          SA2    SCATBF2
          SA3    PROCSEQ     CHECK SEQUENCE NUMBERS 
          ZR     X3,BRH010   NO SEQUENCE NUMBERS
  
          RJ     =XCCLSSN    SKIP SEQUENCE NUMBERS
  
 BRH010   BSS    0           CHECK FOR .HELP
          SA2    SCATBF2
  
          SX7    B1 
          SA7    ANSMDE      $ AND SPACE ARE SEPARATORS 
  
          RJ     =XSTRANS    ADVANCE TO PERIOD
  
          MX7    -0          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      RESTORE ANSMDE 
  
          SA4    ANSCHR 
          NZ     X4,BRH050   STATEMENT IS NOT .HELP 
  
          SA3    ANSSEP 
          SX6    X3-1R
          SX0    X3-1R. 
          ZR     X6,BRH010   SKIP LEADING BLANKS
          NZ     X0,BRH050   STATEMENT IS NOT .HELP 
  
          SX7    B1 
          SA7    ANSMDE      $ AND SPACE ARE SEPARATORS 
          RJ     =XSTRANS    ADVANCE TO HELP, 
          MX6    -0          ASTERISK IS NOT A SEPARATOR
          SA6    ANSMDE      $ AND SPACE ARE NOT SEPARATORS 
  
          SA1    ANSCHR 
          ZR     X1,BRH045   CHECK FOR .* COMMENTS
  
          SA3    ANSSTR 
          SB3    BRHDLL      SET UP FOR LAST DIRECTIVE ENTRY FIRST
          MX0    42 
 BRH011   ZR     B3,BRH050   IF END OF DIRECTIVE LIST AND NO MATCH
  
          SB3    B3-1 
          SA4    BRHDL+B3    GET NEXT DIRECTIVE ENTRY 
          BX7    X0*X4
          BX7    X3-X7
          NZ     X7,BRH011   IF NO MATCH ON THIS DIRECTIVE ENTRY
  
          SB4    X4 
          JP     B4          PROCESS DIRECTIVE
  
  
*         .DIRECTIVE LIST PROCESSED BY *BRH*. 
  
 BRHDL    BSS    0
          CON    0LENDHELP+BRH500  .ENDHELP 
          CON    0LHELP+BRH015     .HELP
  
 BRHCC    CON    0LCC+BRH200       .CC (MUST BE JUST BEFORE .IC)
 BRHIC    CON    0LIC+BRH200       .IC (MUST BE JUST AFTER .CC) 
          ERRNZ  BRHIC-BRHCC-1      CODE DEPENDS ON RELATIVE VALUES 
          ERRNZ  INHIBIT-CCATENAT-1 CODE DEPENDS ON RELATIVE VALUES 
  
          CON    0LNOTE+BRH013     .NOTE
          CON    0LNOCLR+BRH100    .NOCLR 
          CON    0LF7+BRH100       .F7
          CON    0LF6+BRH100       .F6
          CON    0LF5+BRH100       .F5
          CON    0LF4+BRH100       .F4
          CON    0LF3+BRH100       .F3
          CON    0LF2+BRH100       .F2
          CON    0LF1+BRH100       .F1
          CON    0LPAGE+BRH100     .PAGE
          CON    0LENTER+BRH100    .ENTER 
          CON    0LCORRECT+BRH012  .CORRECT 
          CON    0LPROMPT+BRH100   .PROMPT
 BRHDLL   EQU    *-BRHDL
  
  
*         PROCESS .CORRECT DIRECTIVE. 
  
 BRH012   BSS    0
          SA3    =0LCORECT         REPLACE WITH 6 CHARACTER PVID
          JP     BRH100            STORE .CORRECT DIRECTIVE IN PVT
  
  
*         PROCESS .NOTE DIRECTIVE.
  
 BRH013   BSS    0
          SA1    PVTCL
          SA4    IACNOTE           PVT OFFSET OF FIRST .NOTE
          NZ     X4,BRH100         IF THERE WAS A PREVIOUS .NOTE
  
          BX7    X1 
          SA7    A4                INDICATE .NOTE BY STORING PVT OFFSET 
          JP     BRH100            NOW STORE TEXT 
  
  
 BRH015   BSS    0
          SA1    BRHELP 
          SX7    X1+B1       UPDATE RECORD NUMBER OF HELP TEXT
          SA7    BRHELP 
          NG     X1,BRH020   1ST HELP - SKIP WRITING EOR
  
          SX2    FILEHP 
          RJ     =XIOEOR     WRITE EOR ON HELP FILE 
  
  
 BRH020   BSS    0
          SA4    ANSSEP 
          PL     X4,BRH030   FIND KEYWORD ON .HELP STATEMENT
  
  
 BRH025   BSS    0
          SA1    BRHELP 
          SA2    BGPHRN      GET PROC HELP RECORD NUMBER
          SX3    MSG357      DUPLICATE HELP ERROR MSG 
          PL     X2,BRWERR   DUPLICATE .HELP STATEMENTS 
  
          BX7    X1 
          SA7    BGPHRN 
          JP     BRH005      READ NEXT LINE 
  
  
 BRH030   BSS    0
          SX1    X4-1R, 
          SX0    X4-1R.      ALLOW .HELP. 
          SX3    MSG353      ONLY COMMA BETWEEN .HELP AND KEYWORD 
          ZR     X0,BRH025   STORE TEXT FOR .HELP.
          NZ     X1,BRWERR5  SEPARATOR NOT A COMMA
  
          SA2    SCATBF2
          RJ     =XSTRANS    ADVANCE TO KEYWORD 
  
          SA1    ANSCHR 
          NZ     X1,BRH035   FIND PARAMETER IN LIST 
  
          SA4    ANSSEP 
          NG     X4,BRH025   .HELP,  STORE PROC HELP
  
          SX3    MSG353      EXPECTING , OR NOTHING AFTER KEYWORD 
          SX0    X4-1R, 
          NZ     X0,BRWERR5  EXPECTING , NOLIST 
  
          MX7    -1          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      $ AND SPACE ARE SEPARATORS 
          RJ     =XSTRANS    CHECK FOR NOLIST 
          MX6    -0          ASTERISK IS NOT A SEPARATOR
          SA6    ANSMDE      $ AND SPACE ARE NOT SEPARATORS 
  
          SA4    ANSSTR 
          SA5    =0LNOLIST
          SX3    MSG354      IF COMMA THEN NOLIST MUST FOLLOW 
          BX0    X4-X5
          NZ     X0,BRWERR4  NOLIST NOT FOUND 
  
          SX7    B1 
          SA7    BGPHNL      INDICATE PROC HELP NOLIST
          JP     BRH025      STORE PROC HELP RECORD NUMBER
  
  
  
 BRH035   BSS    0           CHECK KEYWORD AGAINST LIST 
          SA3    PPTCL
          SB6    B0 
          SB7    X3 
          SA4    ANSSTR 
          SX3    MSG352      .HELP KEYWORD UNRECOGNIZED 
          SA5    ANSLIT 
          ZR     X5,BRH040   KEYWORD NOT A LITERAL
  
          SA4    ANSEVL      USE EVALUATED FORM 
 BRH040   BSS    0
          LT     B7,B6,BRWERR4   KEYWORD NOT FOUND
  
          SA2    PPT+W.PPFPN+B6    PARAMETER NAME FROM PPT
          SX6    B6 
          SB6    B6+LE.PPT
          BX0    X4-X2       COMPARE NAMES
          NZ     X0,BRH040   GET NEXT PPT NAME
  
          SA6    BRHPPT      SAVE CURRENT POSITION WITHIN LIST
          SX3    MSG357      DUPLICATE HELP STATEMENT 
          SA5    PPT+W.PPHLP+X6 
          BX0    X5 
          LX0    59-S.PPHLP 
          NG     X0,BRWERR   DUPLICATE HELP STATEMENTS
  
          MX0    N.PPHLP
          LX0    S.PPHLP+1
          BX7    X5+X0
          SA7    A5          INDICATE HELP FOR THIS PARAMETER 
          SA3    PPT+W.PPHRC+X6 
          MX0    -N.PPHRC 
          SA5    BRHELP 
          BX4    -X0*X5      STORE HELP RECORD NUMBER 
          OX6    X3,X4,PPHRC
          SA6    A3 
          SA2    ANSSEP 
          SX0    X2-1R, 
          ZR     X0,BRH40A   CHECK NOLIST 
  
*         STORE CCL HELP DIALOGUE AT THE BEGINNING OF THE HELP RECORD 
  
          RJ     BRH1000     STORE DIALOGUE 
          JP     BRH005      NEXT LINE FROM PROC FILE 
  
 BRH40A   BSS    0
  
          MX7    -1          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      $ AND SPACE ARE SEPARATORS 
          SA2    SCATBF2
          RJ     =XSTRANS    ADVANCE TO NOLIST PARAMETER
          MX6    -0          ASTERISK IS NOT A SEPARATOR
          SA6    ANSMDE      $ AND SPACE ARE NOT SEPARATORS 
  
          SA4    ANSSTR 
          SA5    =0LNOLIST
          SX3    MSG354      EXPECTING NOLIST AFTER .HELP,KEYWORD,
          BX0    X4-X5
          NZ     X0,BRWERR4  EXPECTING NOLIST 
  
          SA1    BRHPPT 
          SA2    PPT+W.PPHPN+X1    SET HELP NOLIST FLAG 
          MX3    N.PPHPN
          LX3    S.PPHPN+1
          BX7    X2+X3
          SA7    A2 
          JP     BRH005      READ NEXT LINE 
  
  
 BRH045   BSS    0           CHECK PRECEDING .* COMMENTS
          SA1    BRHELP      1ST .HELP ALREADY FOUND
          PL     X1,BRH055   .* COMMENT IS HELP TEXT
  
          SA1    ANSSEP 
          SX0    X3-1R* 
          ZR     X0,BRH005   DISCARD PRECEDING .* COMMENTS
  
  
  
  
  
  
 BRH050   BSS    0           WRITE HELP TEXT TO FILE
          SA1    BRHELP 
          PL     X1,BRH055   WRITE TEXT LINE
  
          SA2    SCATBF2     NO .HELP FOUND 
          EX7    X2,SBTOT    REPOSITION SCATTER BUFFER
          ZR     X7,BRH005   IGNORE BLANK LINES IN FORMATTING SECTION 
  
          LX7    S.SBTOT-N.SBTOT+1
          SA7    A2          STORE FRESH HEADER 
          JP     BRH500      STORE CCL HELP DIALOGUE
  
 BRH055   BSS    0           WRITE TEXT LINES 
  
          SX2    FILEHP 
          SX3    HPBUF       LINE BUFFER ADDRESS
          SX4    V.CCCPC     LINE LENGTH
  
          RJ     =XIOWTL     WRITE TEXT LINE TO HELP FILE 
  
          JP     BRH005      GET NEXT LINE
  
  
  
 BRH060   BSS    0           NO .ENDHELP FOUND
          SA1    BRHELP 
          SX3    MSG355      NO .ENDHELP FOR .HELP
          PL     X1,BRWERR   ABORT IF NO .ENDHELP FOR .HELP 
  
          JP     BRH500      PUT CLL DIALOGUE IN HELP FILE
  
  
  
*         A .DIRECTIVE HAS BEEN FOUND BEFORE THE 1ST .HELP. 
*         STORE THE TEXT PORTION OF THE DIRECTIVE IN THE PVT. 
  
 BRH100   BSS    0                 PROCESS .DIRECTIVES
          SA1    BRHELP 
          PL     X1,BRH055         .DIRECTIVE IN HELP TEXT
  
          RJ     BESP              ENTER STRING IN PVT
  
          JP     BRH005            NEXT LINE OF PROC
  
  
*         REPLACE THE DEFAULT INHIBIT CHARACTER OR CONCATENATION
*         CHARACTER FROM THE DIRECTIVE. 
  
 BRH200   BSS    0
          SA1    BRHELP 
          PL     X1,BRH055         .DIRECTIVE IN HELP TEXT
  
          SX7    B3+BRHDL-BRHCC    FLAG INHIBIT OR CONCATENATE
          SA2    SCATBF2           SCATTER BUFFER ADDRESS/HEADER
          RJ     BCIC              CHANGE INHIBIT/CONCATENATE CHARACTER 
  
          JP     BRH005            GET NEXT PROC BODY LINE
  
*         IN AN INTERACTIVE PROCEDURE ONLY SOME OF THE PARAMETERS 
*         ON THE HEADER MAY HAVE HAD .HELP.  SEARCH THRU THE LIST 
*         AND PROVIDE CCL GENERATED HELP DIALOGUE FOR THOSE 
*         PARAMETERS THAT DO NOT ALREADY HAVE HELP.  MENUS ARE
*         EXEMPTED.  AND INTERACTIVE PROCEDURES WITHOUT PARAMETERS
*         ARE ALSO EXEMPTED.
  
 BRH500   BSS    0
          SA1    IACIMP 
          NZ     X1,BRH650         SKIP DIALOGUE FOR MENUS
  
          SA2    PPTCL
          ZR     X2,BRH650         NO PARAMETERS
  
          SX7    -LE.PPT
          SA7    BRHPPT 
  
 BRH550   BSS    0
          SA1    BRHPPT 
          SA2    PPTCL
          SX7    X1+LE.PPT
          IX0    X2-X7
          NG     X0,BRH650         WRITE EOP ON HELP FILE 
          ZR     X0,BRH650         WRITE EOP ON HELP FILE 
  
          SA7    BRHPPT 
          SA3    PPT+W.PPHLP+X7 
          LX3    59-S.PPHLP 
          NG     X3,BRH550         DIALOGUE WRITTEN - NEXT PARAMETER
  
          SA1    BRHELP            HELP RECORD NUMBER 
          SX6    X1+1 
          SA6    A1 
          NG     X1,BRH600         SKIP EOR 
  
          SX2    FILEHP 
          RJ     =XIOEOR           WRITE EOR
  
 BRH600   BSS    0
          ERRNZ  N.PPHLP-1
          SA1    BRHPPT 
          SX0    1
          SA2    BRHELP 
          SA3    PPT+W.PPHLP+X1 
          OX7    X3,X0,PPHLP
          SA7    A3                INDICATE HELP AVAILABLE
          SA4    PPT+W.PPHRC+X1 
          OX6    X4,X2,PPHRC
          SA6    A4 
  
          RJ     BRH1000           GENERATE CCL DIALOGUE
          JP     BRH550            NEXT PARAMETERS
  
 BRH650   BSS    0
          SA1    BRHELP 
          NG     X1,BRH            SKIP EOP - RETURN
  
          SX2    FILEHP 
          RJ     =XIOEOP           WRITE EOP
          SX2    FILEHP 
          RJ     =XIOREW           REWIND HELP FILE 
          JP     BRH               RETURN 
  
  
  
*         GENERATE CCL DIALOG INDICATING THE KNOWN VALUES FROM
*         THE CHECKLIST FOR THIS PARAMETER.  THIS PORTION OF THE
*         DIALOG IS WRITTEN TO THE HELP TEXT FILE AND DISPLAYED 
*         WHEN THE CALLER REQUESTS HELP FOR THIS PARAMETER. 
  
 BRH1000  BSSZ   1                 ENTRY/EXIT 
          SA1    IACIMP            CHECK FOR MENU HEADER
          NZ     X1,BRH1000        SKIP CCL GENERATED DIALOGUE FOR MENUS
  
          MX7    0
          SA7    BRHFIC 
          SA7    BRHAIC 
          SA7    BRHNUL 
          SA7    SCATX
          SX3    MSG362            ALLOWABLE VALUES MESSAGE 
          SX2    FILEHP 
          SX4    19 
          RJ     =XIOWTL           WRITE MSG TO HELP TEXT FILE
  
*         IF *N IS THE ONLY PATTERN IN THE CHECKLIST THEN WRITE THE 
*         PROPER MESSAGE TO THE HELP FILE AND DO NOT LOOK FOR OTHER 
*         PATTERNS.  OTHERWISE, READ ALL THE PVT ENTRIES FOR THIS 
*         PARAMETER.
          SA1    BRHPPT 
          BX7    X1 
          SA7    BGPWPL            STORE PPT OFFSET FOR CCLPVO
          SA4    PPT+W.PPNO+X1
          LX4    59-S.PPNO
          NG     X4,BRH1025        *N NOT THE ONLY CHECKLIST PATTERN
  
          SX3    MSG366            PARAMETER MUST BE OMITTED
          SX2    FILEHP 
          SX4    25 
          RJ     =XIOWTL           WRITE MSG TO HELP TEXT FILE
          JP     BRH1000           WRITE USER HELP TEXT 
  
 BRH1025  BSS    0
          RJ     =XCCLPVO          GET PVT OFFSETS
  
 BRH1050  BSS    0                 READ PVT ENTRIES 
          RJ     =XCCLNPV          GET PVT CONTROL WORD 
          ZR     X2,BRH1250        END OF PVT ENTRIES 
  
          MX6    6
          BX7    X6*X0
          LX7    6
          SX6    X7-1RF 
          NZ     X6,BRH1100        ENTRY NOT *F 
  
 BRH1075  BSS    0
          SX7    1
          SA7    BRHFIC            *F IN CHECKLIST
          JP     BRH1050           READ NEXT ENTRY
  
 BRH1100  BSS    0
          SX6    X7-1RA 
          NZ     X6,BRH1150        PVT ENTRY NOT *A 
  
          SX7    1
          SA7    BRHAIC            *A IN CHECKLIST
          JP     BRH1050           READ NEXT PATTERN
  
 BRH1150  BSS    0
          SX6    X7-1RP 
          NZ     X6,BRH1050        IF NOT *P*, *PVALUE*, OR *PATERN*
  
          SA1    =0LPATERN
          BX5    X0-X1
          NZ     X5,BRH1075        IF NOT *PATERN* BUT *P* OR *PVALUE*
          NE     B2,B0,BRH1200     NON-NULL VALUE 
  
          SX7    1
          SA7    BRHNUL            SET NULL VALUE FLAG
          JP     BRH1050           READ NEXT PVT ENTRY
  
 BRH1200  BSS    0                 WRITE CHECKLIST PATTERNS 
          SB2    3
          SA1    =3H
          SA2    SCATX
          MX2    0
          RJ     =XSTRUPS          PUNCTUATION TO SCATX 
  
          SA3    IACPRE 
          SA1    PVT+W.PVSTR+X3    1ST WORD CHECKLIST PATTERN 
          SA4    PVT+W.PVSIZ+X3 
          MX7    -N.PVSIZ 
          ERRNZ  S.PVSIZ-N.PVSIZ+1
          BX5    -X7*X4            LENGTH OF PATTERN
          SB2    X5 
          RJ     =XSTRUPS          VALUE TO SCATX 
  
          SA1    HPBUF
          RJ     =XSTRPKS          PACK STRING TO HPBUF 
          SX4    B2                LENGTH OF LINE 
          SX3    HPBUF
          SX2    FILEHP 
          RJ     =XIOWTL           WRITE LINE 
          JP     BRH1050           READ NEXT PVT ENTRY
  
  
 BRH1250  BSS    0                 CHECK ATTRIBUTES 
          SA1    BRHPPT            CHECK FOR KEYWORD ONLY 
          SA2    PPT+W.PPKAP+X1 
          EX0    X2,PPKAP 
          ZR     X0,BRH1300        IF NO *K ATTRIBUTE 
  
          SB2    3
          SA1    =3H
          SA2    SCATX
          MX2    0
          RJ     =XSTRUPS          PUNCTUATION TO SCATX 
  
          SA3    BRHPPT 
          SA1    PPT+W.PPFPN+X3    USE KEYWORD FOR PATTERN
          SA4    PPT+W.PPFPC+X3 
          EX5    X4,PPFPC 
          SB2    X5 
          RJ     =XSTRUPS          KEYWORD TO SCATX 
  
          SA1    HPBUF
          RJ     =XSTRPKS          PACK STRING TO HPBUF 
          SX4    B2                LENGTH OF LINE 
          SX3    HPBUF
          SX2    FILEHP 
          RJ     =XIOWTL           WRITE LINE IN HELP FILE
  
  
 BRH1300  BSS    0                 WRITE NULL VALUE 
          SA3    BRHNUL 
          ZR     X3,BRH1350        NOT A NULL PATTERN - CHECK *F
  
          SA1    =3H
          SA2    SCATX
          SB2    3
          MX2    0
          RJ     =XSTRUPS          PUNCTUATION TO SCATX 
  
          SA3    BRHPPT 
          SA4    PPT+W.PPFPC+X3    LENGTH OF KEYWORD
          EX5    X4,PPFPC 
          SB2    X5 
          SA1    PPT+W.PPFPN+X3 
          RJ     =XSTRUPS          KEYWORD TO SCATX 
  
          SB2    B1 
          SA1    =1H= 
          RJ     =XSTRUPS          PUNCTUATION TO SCATX 
  
          SA1    HPBUF
          RJ     =XSTRPKS          PACK LINE TO HPBUF 
          SX4    B2 
          SX2    FILEHP 
          SX3    HPBUF
          RJ     =XIOWTL           WRITE LINE TO HELP FILE
  
*         FORMAT HELP MESSAGES FOR ANY *F ATTRIBUTES FOUND
*         IN THE PROCEDURE HEADER CHECKLIST.  SINCE *F MAY HAVE 
*         A RANGE ASSOCIATED WITH IT, MORE THAN ONE *F CAN BE 
*         SPECIFIED IN A CHECKLIST.  LOCATE ALL OF THEM AND WRITE 
*         A HELP MESSAGE FOR EACH ONE.
  
 BRH1350  BSS    0                 *F ATTRIBUTE 
          SA1    BRHFIC 
          ZR     X1,BRH1500        *F NOT IN CHECKLIST
  
          RJ     =XCCLPVO          READ PVT ENTRIES 
  
 BRH1400  BSS    0
          RJ     =XCCLNPV          GET NEXT PVT CONTROL WORD
          ZR     X2,BRH1500        NO MORE *F - CHECK *N
  
          MX6    6*6
          BX7    X0*X6
          LX7    6
          BX3    X6*X7
          SX6    X7-1RF 
          ZR     X6,BRH1410        IF FOUND *F* 
  
          SX1    X7-1RP 
          NZ     X1,BRH1400        IF NOT *P*, *PVALUE* OR *PATERN* 
  
          ZR     X3,BRH1410        IF *P* ENTRY 
  
          SA1    =0LVALUE 
          BX7    X1-X3
          NZ     X7,BRH1400        IF NOT *PVALUE* CHECK NEXT PVT ENTRY 
  
 BRH1410  BSS    0
  
 OSNOS    IFEQ   HOST,NOS 
          SA6    BRHFIC            SET *F/*P FLAG FOR NOS ONLY
 OSNOS    ENDIF 
  
  
          BX6    X2 
          SA6    BRHSCW            SAVE CONTROL WORD
          SA1    =17LA FILE NAME FROM 
          SA2    SCATX
          SB2    17 
          MX2    0
          RJ     =XSTRUPS          FIRST PART OF MESSAGE TO SCATX 
          SA3    BRHSCW 
          EX1    X3,PVMIN          EXTRACT MIN PART OF RANGE
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          SA2    SCATX
          SB2    1
          RJ     =XSTRUPS          PLACE MIN RANGE IN HELP
          SA1    =0L- 
          SB2    1
          RJ     =XSTRUPS 
          SA3    BRHSCW            GET SAVED CONTROL WORD 
          EX1    X3,PVMAX 
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          SB2    2
          SA2    SCATX
          RJ     =XSTRUPS          PLACE MAX RANGE IN HELP
          SA1    =0LCHARACTERS
          SB2    10 
          RJ     =XSTRUPS 
  
 OSNOS    IFEQ   HOST,NOS 
          SA1    BRHFIC 
          ZR     X1,BRH1420        IF NOT *P* OR *PVALUE* 
  
          SA1    =24L BEGINNING WITH A LETTER 
          SB2    24 
          RJ     =XSTRUPS          INCLUDE ALPHABETIC NOTICE IN MESSAGE 
  
 OSNOS    ENDIF 
  
 BRH1420  BSS    0
          SA1    HPBUF
          RJ     =XSTRPKS          PACK HELP LINE 
          SX3    HPBUF
          SX4    B2 
          SX2    FILEHP 
          RJ     =XIOWTL           WRITE LINE TO HELP FILE
          JP     BRH1400           KEEP READING PATTERNS FROM CHECKLIST 
  
  
 BRH1500  BSS    0                 CHECK *N 
          SA1    BRHPPT 
          SA2    PPT+W.PPNDA+X1 
          EX0    X2,PPNDA 
          ZR     X0,BRH1550        CHECK *S(SET)
  
          SX3    MSG364            PARAMETER MAY BE OMITTED 
          SX2    FILEHP 
          SX4    25 
          RJ     =XIOWTL           WRITE LINE TO HELP FILE
  
*         FORMAT HELP MESSAGES FOR ANY *S CHECKLIST ATTRIBUTES
  
 BRH1550  BSS    0                 CHECK *S(SET)
          RJ     =XCCLPVO          GET PVT OFFSETS
  
 BRH1600  BSS    0
          RJ     =XCCLNPV          GET PVT CONTROL WORD 
          ZR     X2,BRH1700        *S(SET) NOT FOUND
  
          MX1    6
          BX6    X2*X1
          LX6    6
          SX4    X6-1RS 
          NZ     X4,BRH1600        READ NEXT PVT ENTRY
  
          SA5    =0LSVALUE
          BX4    X0-X5
          ZR     X4,BRH1600        READ NEXT PVT ENTRY
  
          BX6    X2 
          EX1    X2,PVMAX          GET MAX RANGE FROM SET 
          SA6    BRHSCW            SAVE CONTROL WORD
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          SA1    MSG361            N=1 DEFAULT MSG
          SB2    27 
          MX7    -12
          BX0    -X7*X6            ADD N TO MSG 
          SX7    X0-2R 1
          SA2    SCATX
          MX2    0
          ZR     X7,BRH1650        N=1 DEFAULT MSG
  
          SA1    =4LANY 
          SB2    4
          RJ     =XSTRUPS 
          SA3    BRHSCW            GET SAVED CONTROL WORD 
          EX1    X3,PVMIN          EXTRACT MIN RANGE FROM SET 
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          MX7    54                DETERMINE IF 1 OR 2 DIGITS CONVERTED 
          LX4    12 
          BX0    -X7*X4 
          SX3    X0-1R
          SB2    1
          ZR     X3,BRH1610        1 DIGIT CONVERTED - SPACE ADDED
  
          SB2    2                 2 DIGITS CONVERTED - SPACE ADDED 
  
 BRH1610  BSS    0
          SA2    SCATX
          RJ     =XSTRUPS 
          SA1    =0L- 
          SB2    1
          RJ     =XSTRUPS 
          SA3    BRHSCW            GET SAVED CONTROL WORD FROM SET
          EX1    X3,PVMAX          EXTRACT MAX RANGE FROM SET 
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          MX7    54                DETERMINE IF 1 OR 2 DIGITS CONVERTED 
          LX4    12 
          BX0    -X7*X4 
          SX3    X0-1R
          SB2    2
          ZR     X3,BRH1615        1 DIGIT CONVERTED - SPACE ADDED
  
          SB2    3                 2 DIGITS CONVERTED - SPACE ADDED 
  
 BRH1615  BSS    0
          SA2    SCATX
          RJ     =XSTRUPS 
          SA1    =24LCHARACTERS FROM THE SET
          SB2    24 
  
 BRH1650  BSS    0
          RJ     =XSTRUPS          MSG367 TO SCATX
          SA3    IACPRE            PVT OFFSET 
          SA2    PVT+W.PVSIZ+X3 
          EX5    X2,PVSIZ 
          SB2    X5 
          SA1    PVT+W.PVSTR+X3    BEGINNING OF STRING
          SA2    SCATX
          RJ     =XSTRUPS          (SET) TO SCATX 
  
          SA1    HPBUF
          RJ     =XSTRPKS          PACK LINE TO HPBUF 
          SX2    FILEHP 
          SX4    B2 
          SX3    HPBUF
          RJ     =XIOWTL           WRITE LINE TO HELP FILE
          JP     BRH1600           READ NEXT PVT ENTRY
  
*         FORMAT HELP MESSAGES FOR ALL *A CHECKLIST ATTRIBUTES. 
  
 BRH1700  BSS    0                 DOES CHECKLIST ALLOW ANY STRING
          SA1    BRHAIC 
          ZR     X1,BRH1000        NO *A ATTRIBUTE - GET USER HELP
  
          RJ     =XCCLPVO          SEARCH FOR ALL *A IN CHECKLIST 
  
 BRH1750  BSS    0
          RJ     =XCCLNPV          GET NEXT PVT CONTROL WORD
          ZR     X2,BRH1000        RETURN WHEN LIST SEARCHED
  
          AX0    54                REMOVE ALL BUT FIRST PVID CHARACTER
          BX6    X2 
          SX1    X0-1RA 
          NZ     X1,BRH1750        KEEP SEARCHING FOR *A
  
          SA2    SCATX
          SA6    BRHSCW            SAVE PVT CONTROL WORD
          SX2    B0+
          SA1    =4LANY 
          SB2    4
          RJ     =XSTRUPS 
          SA3    BRHSCW            GET SAVED CONTROL WORD 
          EX1    X3,PVMIN          EXTRACT MIN FROM RANGE 
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          MX7    54                DETERMINE IF 1 OR 2 DIGITS CONVERTED 
          LX4    12 
          BX0    -X7*X4 
          SX3    X0-1R
          SB2    1
          ZR     X3,BRH1760        1 DIGIT CONVERTED - SPACE ADDED
  
          SB2    2                 2 DIGITS CONVERTED - SPACE ADDED 
  
 BRH1760  BSS    0
          SA2    SCATX
          RJ     =XSTRUPS 
          SA1    =0L- 
          SB2    1
          RJ     =XSTRUPS 
          SA3    BRHSCW            EXTRACT RANGE MAX FROM CONTROL WORD
          EX1    X3,PVMAX 
          RJ     =XCDD             CONVERT TO DECIMAL DISPLAY CODE
          BX1    X4 
          MX7    54                DETERMINE IF 1 OR 2 DIGITS CONVERTED 
          LX4    12 
          BX0    -X7*X4 
          SX3    X0-1R
          SB2    2
          ZR     X3,BRH1765        1 DIGIT CONVERTED - SPACE ADDED
  
          SB2    3                 2 DIGITS CONVERTED - SPACE ADDED 
  
 BRH1765  BSS    0
          SA2    SCATX
          RJ     =XSTRUPS 
          SA1    =16LCHARACTER STRING 
          SB2    16 
          RJ     =XSTRUPS 
          SA1    HPBUF
          RJ     =XSTRPKS          PACK HELP LINE 
          SX3    HPBUF
          SX2    FILEHP 
          SX4    B2 
          RJ     =XIOWTL           WRITE LINE TO HELP FILE
          JP     BRH1000           WRITE USER HELP TEXT 
  
  
 BRHAIC   BSSZ   1                 1 = *A IN CHECKLIST
 BRHFIC   BSSZ   1                 1 = *F IN CHEKLIST 
 BRHELP   BSS    1           HELP RECORD NUMBER 
 BRHNUL   BSSZ   1           1 = NULL VALUE 
 BRHPPT   BSS    1           POSITION WITHIN PARAMETER LIST 
 BRHSCW   BSSZ   1                 SAVE PVT CONTROL WORD
 BRHSDN   BSSZ   1                 SAVE DIRECTIVE NAME
          TITLE  BSC  -  BEGIN, SPECIFICATION CONVERSION
**        BSC  -  BEGIN, SPECIFICATION CONVERSION 
* 
*         BSC IS CALLED BY BPP AND BIV.  BOTH BIV AND BPP PROCESS 
*         PARAMETERS FROM THE CALL. 
*         IF THE PARAMETER HAS A LEADING MINUS OR A TRAILING
*         SLASH OR PLUS THEN BSC IS CALLED. 
*         IF THE SEPARATOR IS A PLUS, THE SPECIFICATION 
*         IS A SYMBOLIC NAME WHOSE BINARY VALUE IS TO BE
*         CONVERTED TO DISPLAY CODE AND USED AS THE SPECIFICATION 
*         IF THERE IS A LEADING MINUS OR A TRAILING SLASH 
*         THEN THESE CHARACTERS ARE PART OF THE SPECIFICATION.
* 
*         ENTRY  -  STRING ADVANCED BY BPP, SEPARATOR IS   + - /
* 
*         EXIT  -  ANSSTR= STRING SPECIFIED 
  
 BSC      BSSZ   1           ENTRY/EXIT 
          SX7    B0+
          SA7    DISTIME     CLEAR MINIMUM SIZE FLAG
          SA7    BGTMP3      INITIAL FLAG TO POSITIVE SYMBOL VALUE
          SA4    ANSSEP 
          SA5    ANSCHR 
          SA1    ANSSTR 
          SX0    X4-1R+ 
          ZR     X5,BSC06    IF NULL STRING 
          NZ     X0,BSC06    IF NOT FOLLOWED BY  +
  
          BX7    X1 
          SA2    ANSNUM 
          SX3    X5-8 
          SA7    BGTMP1      SAVE SYMBOLIC NAME 
          PL     X3,BSC09    ERR IF GT 7 CHARACTERS 
  
          ZR     X2,BSC01    IF NOT NUMERIC 
  
          RJ     =XSTREVN    EVALUATE NUMERIC, X1= NUMERIC STRING 
          NZ     X5,BSC09    IF ERROR 
  
          JP     BSC02       X6  = NUMERIC VALUE
  
 BSC01    BSS 
          SX7    X5-8 
          PL     X7,BSC09    ERR IF GT 7 CHARACTERS 
  
          RJ     =XCCLSNV 
  
          ZR     X5,BSC09    ERR IF SYMBOLIC NOT KNOWN
  
*         X6 CONTAINS VALUE OF SYMBOL 
  
          PL     X6,BSC02    PROCESS POSITIVE VALUE 
  
*         VALUE IS NEGATIVE - SET FLAG WORD - COMPLEMENT VALUE
  
          BX6    -X6
          SX7    B1          =1 
          SA7    BGTMP3      INDICATE NEGATIVE SYMBOLIC VALUE 
  
 BSC02    BSS 
          SA6    BGTMP2      SAVE BINARY VALUE
          RJ     =XCCLGNP    GET NEXT PARAMETER 
          ZR     X5,BSC02B   NO ERRORS
          SA1    IACIDP 
          SX0    X1-2 
          ZR     X0,BSC      RETURN DURING SCREEN DIALOGUE
  
          SA1    IACICF 
          ZR     X1,BRWERR1  EXIT WITH ERR - NONINTERACTIVE 
  
          JP     BSC         RETURN WITH ERR - INTERACTIVE CALL 
  
 BSC02B   BSS    0
  
*         IF THE PLUS IS FOLLOWED BY A NULL STRING THEN THE VALUE 
*         IS TO BE CONVERTED TO DECIMAL.  HOWEVER THE PLUS MAY
*         BE FOLLOWED BY THE SINGLE CHARACTERS  B  WHICH INDICATES
*         OCTAL CONVERSION.  THE SINGLE CHARACTER  D  EXPLICITLY
*         DECLARES DECIMAL.  ANY OTHER STRING FOLLOWING THE PLUS
*         IS AN ERROR 
  
          SA3    ANSCHR 
          SA4    ANSSTR 
          ZR     X3,BSC03    IF NULL STRING,  THEN DECIMAL
  
          LX4    6
          SX0    X4-1RD 
          SX7    X4-1RB 
          ZR     X0,BSC03    IF DECIMAL 
          NZ     X7,BSC10    ERR, + FOLLOWED BY NEITHER D OR B
  
          SA1    BGTMP2      GET BINARY VALUE 
          RJ     =XCOD
  
          JP     BSC04
  
 BSC03    BSS 
          SA1    BGTMP2      GET BINARY VALUE 
          RJ     =XCDD
  
 BSC04    BSS 
          SA1    DISTIME
          SB3    X1 
          SB3    B2-B3
          PL     B3,BSC04.1  IF VALUE AT LEAST MINIMUM SIZE 
          SB2    X1          MINIMUM SIZE 
          LX4    B3          SHIFT RESULT TO ACCOMODATE EXTRA ZEROES
          SA1    =10H0000000000 
          SB3    B3+B1       FORM MASK
          MX0    1
          LX0    B3 
          BX4    -X0*X4      CLEAR SPACE FOR LEADING ZEROES 
          BX1    X0*X1       ISOLATE REQUIRED NUMBER OF ZEROES
          BX4    X1+X4       MERGE LEADING ZEROES WITH VALUE
  
*         B2 = 6*COUNT OF DIGITS CONVERTED
*         X4 = DPC CONVERSION, LEFT JUSTIFIED 
  
 BSC04.1  BSS    0
          SA1    BGTMP3      FLAG WORD FOR SYMBOL SIGN
          ZR     X1,BSC04.5  PROCESS POSITIVE VALUE 
  
          SX1    1R-
          LX1    60-6        LEFT JUSTIFY 
          SB2    B2+6        INCREMENT COUNT FOR MINUS SIGN 
          MX7    6
          LX4    60-6        POSITION VALUE 
          BX4    -X7*X4      CLEAR PLACE FOR MINUS SIGN 
          BX4    X1+X4       ADD MINUS SIGN TO VALUE WORD 
 BSC04.5  BSS 
          MX7    1
          SB7    B2-B1       6*(NO. OF CHARACTERS)-1
          AX7    X7,B7       MASK 
          BX7    X4*X7       LEFT JUSTIFIED, ZERO FILL
          SX6    B0 
          SA7    ANSSTR      STORE DISPLAY CODE 
 BSC05    BSS 
          SB2    B2-6 
          SX6    X6+B1
          LT     B0,B2,BSC05 IF MORE CHARACTERS TO COUNT
  
          SA6    ANSCHR      COUNT OF CHARACTERS CONVERTED
          JP     BSC
  
  
*         IF THE STRING IS NULL AND THE SEPARATOR IS A MINUS
*         THEN IT IS ASSUMED TO BE A LEADING MINUS. 
*         THE LEADING MINUS WILL BE 
*         PREFIXED TO THE FOLLOWING CHARACTER STRING AND
*         ALL TOGETHER CONSIDERED ONE SPECIFICATION.
*                X4  = ANSSEP 
*                X5  = ANSCHR 
  
 BSC06    BSS 
          SX0    X4-1R- 
          NZ     X5,BSC07    IF NOT NULL
          NZ     X0,BSC07    IF NOT MINUS 
  
          SA2    SCATX
          BX1    X4          X1=    MINUS 
          SB2    B1          ONE CHARACTER
          LX1    54          LEFT JUSTIFY CHARACTER 
          MX2    0           CLEAR BUFFER HEADER
          RJ     =XSTRUPS    STORE 1 CHAR. (-) IN SCATX 
  
          JP     BSC08       GET NEXT PARAMETER AND ADD IT
  
  
*         IF THE SEPARATOR IS A / THEN THIS STRING, THE SLASH AND THE 
*         NEXT PARAMETER ARE CONSIDERED ONE PARAMETER.
  
 BSC07    BSS 
          SX0    X4-1R/ 
          SX5    X4-1R+ 
          ZR     X5,BSC08    READ VALUE FOLLOWING + 
          NZ     X0,BSC      IF NOT  /
  
          SA5    ANSCHR 
          SA1    ANSSTR 
          SA2    SCATX
          SB2    X5          NUMBER OF CHARACTERS 
          MX2    0
          RJ     =XSTRUPS 
  
          SX1    1R/
          SB2    B1 
          LX1    54          LEFT JUSTIFY CHAR. 
          RJ     =XSTRUPS    ADD  /  TO SCATX 
  
 BSC08    BSS 
          SA1    IACIDP 
          SX0    X1-2 
          ZR     X0,BSC08F   SCREEN MODE DIALOGUE 
  
          RJ     =XCCLGNP    GET NEXT PARAMETER 
          ZR     X5,BSC08A   NO ERRORS
  
          SA1    IACIDP 
          SX0    X1-2 
          ZR     X0,BSC      RETURN DURING SCREEN DIALOGUE
  
  
          SA1    IACICF 
          ZR     X1,BRWERR1  EXIT WITH ERR - NONINTERACTIVE 
  
          JP     BSC         RETURN WITH ERR - INTERACTIVE CALL 
  
 BSC08A   BSS    0
  
          SA5    ANSCHR 
          SA1    ANSSTR 
          SA2    SCATX
          SB2    X5 
          RJ     =XSTRUPS    ADD THIS PARAMETER TO SCATX
          SX7    B3          NUMBER CHARACTERS IN SCATX 
          SA1    ANSSTR 
          SA7    ANSCHR      UPDATE NUMBER OF CHARACTERS
          RJ     =XSTRPKS    PACK INTO ANSSTR 
          SA4    ANSSEP 
          JP     BSC06       CHECK FOR TRAILING SLASH 
  
 BSC08F   BSS    0           SCREEN MODE - SAVE SPACES
          MX7    -1          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      $ AND BLANK ARE SEPARATORS 
          RJ     =XCCLGNP    GET NEXT PARAMETER 
          MX7    -0          ASTERISK IS NOT A SEPARATOR
          SA7    ANSMDE      IGNORE $ AND BLANKS
          NZ     X5,BSC      RETURN WITH ERROR
  
          SA5    ANSCHR 
          SA1    ANSSTR 
          SA2    SCATX
          SB2    X5 
          RJ     =XSTRUPS 
          SA1    ANSSEP 
          NG     X1,BSC08I   END OF STRING
  
          SB2    B1 
          LX1    54 
          RJ     =XSTRUPS    SAVE SEPARATOR 
          JP     BSC08F      GET NEXT STRING
  
 BSC08I   BSS    0
          SX7    B3 
          SA1    ANSSTR 
          SA7    ANSCHR 
          RJ     =XSTRPKS    PACK STRING
          JP     BSC         RETURN 
  
*         THE SPECIFICATION WAS FOLLOWED BY A PLUS INDICATING IT WAS
*         A SYMBOLIC NAME WHOSE VALUE WAS TO BE CONVERTED.  HOWEVER 
*         THERE IS AN ERROR.  SETUP THE NAME AND THE PLUS TO BE INCLUDED
*         IN THE DAYFILE MESSAGE
  
 BSC09    BSS 
          SX7    1R+
          SX0    ANSSTR      SYMBOLIC NAME
          LX7    54 
          SX5    MSGBUF      MESSAGE WILL CONTAIN PLUS AFTER NAME 
          SA7    MSGBUF 
          JP     BSC11
  
 BSC10    BSS 
          SA1    ANSSTR 
          SX7    1R+
          SX0    BGTMP1      SYMBOLIC NAME
          MX6    42          ACCEPT UP TO SEVEN CHAR. 
          BX1    X1*X6       ENSURE LOWER THREE CHAR. ZERO
          BX7    X1+X7
          LX7    6           PLUS NOW PRECEDES STRING 
          SX5    ANSSTR      STRING FOLLOWING  +
          SA7    ANSSTR      RESTORE STRING WITH LEADING PLUS, ZERO BYTE
 BSC11    BSS 
          LX5    18+18
          LX0    18 
          SX3    MSG206      $SYMBOLIC SPECIFICATION INVAL.$
          BX0    X0+X5
          BX3    X0+X3
          SA1    IACIDP 
          SX6    X1-2 
          ZR     X6,BSC20    STORE ERR DURING SCREEN DIALOGUE 
  
          SA1    IACICF 
          ZR     X1,EXIT1    EXIT WITH ERR - NONINTERACTIVE 
  
 BSC20    BSS    0
          BX7    X3 
          SA7    IACERR 
          JP     BSC         RETURN WITH ERR - INTERACTIVE CALL 
 BSM      TITLE  BEGIN SCREEN MODE
**        BSM  -  BEGIN SCREEN MODE 
* 
*         BSM CHECKS FOR POSSIBLE SCREEN MODE DIALOGUE
*         (IACIDP = 2).  IF SCREEN MODE DIALOGUE IS NOT 
*         POSSIBLE BSM RETURNS LEAVING X3 UNDISTURBED.
*         OTHERWISE, BSM JUMPS TO THE SCREEN DIALOGUE 
*         OVERLAY (SDO), STORING X3 IN BGERR. 
*         FOR INTERACTIVE PROCEDURES. 
* 
* 
*         ENTRY 
* 
*         X3   = HELP CALL OR ERROR CONDITION 
* 
*         EXIT
* 
*         X3    = UNDISTURBED WHEN RETURNING IMMEDIATELY
* 
* 
 SDOVL    IFNE   IP.SDO,0 
  
 BSM      BSSZ   1                 ENTRY/EXIT 
          SA1    IACIDP 
          SX0    X1-2 
          NZ     X0,BSM            RETURN - LINE MODE ONLY
  
          BX6    X3 
          SA6    BGERR             STORE ERROR
          RJ     BITV              INPUT TERMINAL VERIFICATION
  
          NZ     X3,BSM100         IF NOT A TERMINAL USE LINE MODE
  
          SA1    CLOSTAT
          NZ     X1,BSM075         DO NOT CLEAR IN/OUT STRING 
  
*         CLEAR IN/OUT STRING 
  
          SB6    L.VIO             LENGTH OF IN/OUT FIELDS
          MX6    0
  
 BSM060   BSS    0                 CLEAR VARIABLE IN/OUT FIELDS 
          SA6    VINOUT+B6
          SB6    B6-1 
          GE     B6,B0,BSM060      KEEP CLEARING
  
 BSM075   BSS    0
          SA2    SDENTRY
          SB7    X2 
          JP     B7                JUMP TO SCREEN DIALOG OVERLAY
  
*         SDO HAS DETERMINED THAT A SCREEN MODE DIALOGUE IS NOT 
*         POSSIBLE.  INITIALIZE FOR LINE MODE AND RETURN. 
  
 SDOVL    ENDIF 
  
 BSM100   BSS    0
  
 SDOVL    IFNE   IP.SDO,0 
  
          SETLOF BSMPTL            POINTER TO LIST OF FILES 
  
          CSET   NORMAL 
  
          MX7    0           CLEAR SCREEN MODE INDICATORS 
          SA7    SDMODE 
          SX7    B1 
          SA3    BGERR
          SA7    IACIDP            LINE MODE DIALOGUE 
          JP     BSM               RETURN 
  
  
 BSMPTL   BSS    0
          VFD    12/0,18/BSMLOF,30/0
  
 BSMLOF   BSS    0
          VFD    1/0,41/0,18/3
          VFD    42/6LOUTPUT,18/OUTPUT
          VFD    6/0
  
 SDOVL    ENDIF 
  
          TITLE  BST  - BEGIN, SPECIAL TASKS
**        BST  -  BEGIN, SPECIAL TASKS
* 
*         THE CARD OF THE PROCEDURE HAS BEEN PROCESSED AND
*         THE LEADING CHARACTER IS A PERIOD.  CHECK TO DETERMINE
*         IF IT IS A RECOGNIZED DIRECTIVE AND IF SO EXECUTE THE SPECIAL 
*         TASK INDICATED BY THE DIRECTIVE.
* 
*         EXIT   X5 = 0 IF SPECIAL COMMAND EXECUTED 
*                X5 = 1 IF NOT SPECIAL COMMAND
* 
  
 BST      BSSZ   1           ENTRY/EXIT 
          SA2    SCATBF1     START AT BEGINNING OF BUFFER 
          EX7    X2,SBTOT 
          LX7    S.SBTOT-N.SBTOT+1
          SA7    A2          NEW HEADER 
          BX2    X7 
          RJ     =XSTRANS    GET (NULL)  .
          SX7    B1+
          SA7    ANSMDE      ALL ARE SEPARATORS 
  
          RJ     =XSTRANS    GET STRING (THE COMMAND) 
  
          SX7    B0+
          SA7    ANSMDE      SKIP BLANKS
  
          SA4    ANSCHR 
          MX0    42 
          NZ     X4,BST0     IF NOT NULL CHECK DIRECTIVE LIST 
  
          SA1    ANSSEP 
          SX1    X1-1R* 
          ZR     X1,BST7     IF .* COMMENT - SKIP IT
  
 BST0     BSS    0
          SB3    BSTDLL      SET UP FOR LAST DIRECTIVE ENTRY FIRST
          SA3    ANSSTR      GET THE DIRECTIVE VERB 
 BST0.01  BSS    0
          ZR     B3,BST8     IF END OF DIRECTIVE LIST AND NO MATCH
  
          SB3    B3-1 
          SA4    BSTDL+B3 
          BX7    X0*X4
          BX1    X3-X7
          NZ     X1,BST0.01  IF NOT THIS DIRECTIVE
  
          SA7    BSTSDN      SAVE DIRECTIVE NAME
          SB4    B3+BSTDL-BSTEXP
          SA5    BGSKIP 
          ZR     B4,BST0.03  IF .EXPAND DIRECTIVE 
  
          SA1    IACEXP 
          NZ     X1,BST8     IF .EXPAND(OFF) IS IN EFFECT 
  
          SB4    B3+BSTDL-BSTWHL
          NG     B4,BST0.03  IF NOT A POSSIBLE SKIP TERMINATOR
  
          SB4    B3+BSTDL-BSTEIF
          PL     X5,BST0.02  IF NOT SKIPPING DUE TO .WHILE/.ENDW
  
          NG     B4,BST0.04  IF .WHILE OR .ENDW 
  
          JP     BST7        INDICATE COMMAND EXECUTED AND EXIT 
  
 BST0.02  BSS 
          PL     B4,BST0.04  IF .ENDIF/.ELSE/.ELSEIF
  
 BST0.03  BSS 
          NZ     X5,BST7     IF SKIPPING FOR ANY REASON 
  
 BST0.04  BSS 
          SB4    X4 
          JP     B4 
  
  
*         .DIRECTIVE LIST PROCESSED BY *BST*. 
  
 BSTDL    BSS    0
 BSTCC    CON    0LCC+BST85        .CC (MUST BE JUST BEFORE .IC)
 BSTIC    CON    0LIC+BST85        .IC (MUST FOLLOW .CC)
          ERRNZ  BSTIC-BSTCC-1      CODE DEPENDS ON RELATIVE VALUES 
          ERRNZ  INHIBIT-CCATENAT-1 CODE DEPENDS ON RELATIVE VALUES 
  
 BSTEXP   CON    0LEXPAND+BST76    .EXPAND
          CON    0LNOTE+BST40      .NOTE
  
 OSNOSBE  IFNE   HOST,SC2 
          CON    0LEX+BST10        .EX
 OSNOSBE  ENDIF 
  
 BSTEOR   CON    0LEOR+BST6        .EOR (MUST BE JUST BEFORE .EOF)
          CON    0LEOF+BST6        .EOF (MUST FOLLOW .EOR)
          CON    0LEOS+BST6        .EOS (MUST FOLLOW .EOF)
          CON    0LEOP+BST6        .EOP (MUST FOLLOW .EOS)
  
          CON    0LSET+BST110      .SET 
          CON    0LDATA+BST0.1     .DATA
          CON    0LIFE+BST5        .IFE 
          CON    0LIF+BST5         .IF
  
 BSTWHL   CON    0LWHILE+BST5      .WHILE (MUST BE AFTER .IF/.IFE)
 BSTENW   CON    0LENDW+BST00A     .ENDW  (MUST BE AFTER .WHILE)
 BSTEIF   CON    0LELSEIF+BST5     .ELSEIF (AFTER .ENDW, BEFORE .ENDIF) 
 BSTEND   CON    0LENDIF+BST00A    .ENDIF (MUST BE JUST BEFORE .ELSE) 
          CON    0LELSE+BST00A     .ELSE (MUST BE LAST IN LIST) 
 BSTDLL   EQU    *-BSTDL
  
  
  
*         PROCESS .ELSE, .ENDIF AND .ENDW DIRECTIVES. 
  
  
 BST00A   BSS    0
          SX7    B3+BSTDL-BSTEND  1=.ELSE, 0=.ENDIF, -2=.ENDW 
          SA7    BGELSE      ELSE FLAG
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          NZ     X4,BST5D    IF NO SEPARATOR
  
          SX0    X1-1R( 
          SX6    X1-1R, 
          ZR     X0,BST00B   LEFT PAREN FOUND 
  
          NZ     X6,BST5D    IF INCORRECT SEPARATOR 
  
 BST00B   BSS    0
          SA5    BGSKIP      SKIP (1=.IF, 2=.ELSE, -1=.ENDW, -2=.WHILE) 
          SA1    BGELSE      DIRECTIVE (0=.ENDIF, 1=.ELSE, -2=.ENDW)
          NZ     X5,BST00B1  IF SKIPPING LINES
  
          ZR     X1,BST7     IF .ENDIF DIRECTIVE WHILE NOT SKIPPING 
  
          JP     BST00C      CHECK THE LABEL
  
 BST00B1  BSS 
          BX0    X5-X7
          NG     X0,BST7     IF DIRECTIVE/SKIP TYPE MISMATCH
  
 BST00C   BSS    0           PROCESS LABEL
          SX7    1
          SA7    PBCOND      INDICATE PROC BODY CONDITIONAL 
          RJ     =XCCLLAB    READ LABEL 
  
          SX6    B0+         CLEAR PROC BODY CONDITIONAL FLAG 
          SA6    PBCOND 
          SA5    BGSKIP 
          SA4    BGLABL 
          SA3    LABEL
          SA1    BGELSE 
          ZR     X5,BST00C0  IF NOT SKIPPING
          BX0    X4-X3       COMPARE LABELS 
          ZR     X0,BST00D   LABELS MATCH 
  
          JP     BST7        EXIT - NOT THE DESIRED LABEL 
  
 BST00C0  BSS 
          SX6    2           PRESET SKIP INITIATED BY .ELSE 
          PL     X1,BST00C1  IF NOT .ENDW 
  
          SX2    FILEPC      BACK UP TO BEGINNING OF SECTION
          SB2    -1 
          RJ     =XIOSKP
  
 OSNOSBE  IFNE   HOST,SC2 
          READ   FILEPC,R    INITIATE THE READ
 OSNOSBE  ENDIF 
  
          SA3    LABEL
          SX6    -1          INDICATE SKIPPING INITIATED BY .ENDW 
  
*         ENTRY FOR .ELSEIF PROCESSING WHEN NOT SKIPPING. 
  
 BST00C1  BSS 
          SX7    B0+
          SA6    BGSKIP      START SKIPPING 
          SA7    BGELSE 
          BX6    X3 
          SA6    BGLABL      SAVE NEW LABEL 
          JP     BST7        .COMMAND PROCESSED 
  
 BST00D   BSS    0
          SX7    B0+
          ZR     X1,BST00E   .ENDIF - STOP SKIPPING 
  
          SA7    BGELSE 
          SX0    X5-2 
          ZR     X0,BST7     IF SKIP INITIATED BY PREVIOUS .ELSE
  
          SX0    X5+1 
          SX3    MSG341      * MATCHING .ENDW BEFORE .WHILE LABEL * 
          ZR     X0,EXIT1    IF SKIP WAS INITIATED BY .ENDW 
  
          NZ     X5,BST00E   IF SKIP TERMINATOR FOUND 
  
          SX7    2           2 = .ELSE - START SKIPPING 
 BST00E   BSS    0
          SA7    BGSKIP 
          JP     BST7        .COMMAND PROCESSED 
  
  
*         PROCESS .DATA DIRECTIVE.
  
 BST0.1   BSS    0
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          NZ     X4,BST1.2   IF BLANK SEPARATOR BEFORE FILE NAME
  
          SX0    X1-1R. 
          ZR     X0,BST0.5   .DATA. FOUND 
  
          SX0    X1-1R) 
          ZR     X0,BST0.5   .DATA) FOUND 
  
          PL     X1,BST1     NOT DEFAULT DATA COMMAND 
  
 BST0.5   BSS 
          SA3    DATAFIL
          SX7    7
          BX6    X3 
          SA7    ANSCHR      LENGTH OF STRING 
          SA6    ANSSTR      LFN FOR DATA FILE
          JP     BST1.2      SKIP STRANS CALL 
  
*         ALLOW , ( OR BLANK AS SEPARATOR BETWEEN .DATA AND LFN 
  
 BST1     BSS 
          SX0    X1-1R, 
          ZR     X0,BST1.1   .DATA, FOUND 
  
          SX0    X1-1R( 
          NZ     X0,BST8     NOT .DATA COMMAND, ADD TO CURRENT FILE/PROC
  
 BST1.1   BSS 
  
          SA2    SCATBF1
          RJ     =XSTRANS 
  
          SA4    ANSCHR 
          ZR     X4,BST8     IF NULL THIS IS NOT A DATA COMMAND 
  
*         ALLOW TERMINATOR AFTER LFN TO BE . ) OR BLANK 
*         ANYTHING FOLLOWING THIS TERMINATOR IS ASSUMED A COMMENT 
  
          SA1    ANSSEP 
 BST1.2   BSS    0
          SX0    X1-1R. 
          ZR     X0,BST1.3   .DATA,LFN. FOUND 
  
          SX0    X1-1R) 
          ZR     X0,BST1.3   .DATA,LFN) FOUND 
  
          PL     X1,BST8     NOT .DATA COMMAND, ADD TO CURRENT FILE/PROC
  
*         COMPLETE PROCESSING OF CURRENT DATA FILE IF WRITING ONE 
  
 BST1.3   BSS 
          RJ     CDF         CLOSE PREVIOUS DATA FILE IF WRITING ONE
  
          SA4    ANSCHR 
          SA3    ANSSTR 
          SX0    X4-8 
          PL     X0,BST2.2   LFN IS LONGER THAN 7 CHARACTERS
  
          SA1    =0L"M.FNOCS" 
          SA2    =0L"M.FNPS1" 
          SA5    =0L"M.FNPS2" 
          BX0    X1-X3
          BX7    X2-X3
          ZR     X0,BST2     IF EQUAL TO "M.FNOCS"
          ZR     X7,BST2     IF EQUAL TO "M.FNPS1"
          SA1    =0L"M.FNHLP" 
          BX0    X3-X1
          ZR     X0,BST2     IF EQUAL TO "M.FNHLP"
  
          BX0    X3-X5
          NZ     X0,BST4     IF FILE NAME SPECIFIED NOT A CCL WORK FILE 
  
 BST2     BSS 
          SX3    MSG251      $DATA COMMAND SPECIFIED CCL FILE-$ 
 BST2.1   BSS 
          SX0    ANSSTR 
          LX0    18 
          BX3    X0+X3
          JP     EXIT1       ISSUE MESSAGE AND ABORT
  
  
 BST2.2   BSS 
          SX3    MSG249      $DATA FILE LFN EXCEEDS 7 CHARACTERS$ 
          JP     BST2.1      ISSUE MESSAGE AND ABORT
  
 BST4     BSS 
          SX6    B1 
          SA1    PROCNAM     CHECK FOR PNAME .EQ. .DATA,LFN 
          IX0    X1-X3
          NZ     X0,BST4.5   RETURN LFN 
  
          SA6    PROCDAT     SET FLAG 
 BST4.5   BSS    0
          SA6    BGDATA      SET FLAG, PROCESSING DATA STATEMENTS 
          BX5    X3 
          SX2    FILEDF 
          RJ     =XIOFET     RESET FET FIELDS 
  
          RJ     =XIORTN     RETURN FILE IN CASE IT EXISTS
  
 OSSC2    IFEQ   HOST,SC2 
          OPENM  FILEDF,I-O,N   OPEN DATA FILE
 OSSC2    ENDIF 
  
          SX2    FILEDF 
          RJ     =XIOREW
  
          JP     BST7        EXIT, COMMAND EXECUTED 
  
  
  
*         PROCESS .IF, .IFE, .ELSEIF AND .WHILE DIRECTIVES. 
  
 BST5     BSS 
          SX7    B3+BSTDL-BSTWHL  .ELSEIF>0, .WHILE=0, .IF/IFE<0
          SA7    BGELSE 
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          NZ     X4,BST5D    IF NO SEPARATOR
  
          SX0    X1-1R( 
          SX6    X1-1R, 
          ZR     X0,BST5B    EVALUATE EXPRESSION
  
          NZ     X6,BST5D    IF INCORRECT SEPARATOR 
  
 BST5B    BSS    0
          SX6    B1 
          SA6    PBCOND      INDICATE PROC BODY CONDITIONAL 
          SA6    PROCESS     INDICATE IF PROCESSING 
          RJ     =XCCLEVX    EVALUATE EXPRESSION
          SA4    SCATBF1
          BX6    X4 
          SA6    SCATBF2
          NZ     X5,BRWERR5  INVALID EXPRESSION - ERR MSG IN X3 
  
          MX7    0
          SA7    ANSMDE      SKIP BLANKS
          SA2    ANSSEP 
          SX3    X2-1R, 
          SX0    X2-1R. 
          SX6    X2-1R) 
          ZR     X3,BST5E    IF SEPARATOR IS COMMA
  
          ZR     X0,BST5C    IF PERIOD FOUND
  
          SX3    MSG377      *EXPECTING , OR .* 
          NZ     X6,BRWERR4  IF NOT RIGHT PAREN 
  
 BST5C    BSS 
          SA1    BGELSE 
          NG     X1,BST30    IF SINGLE STATEMENT .IF/.IFE 
  
 BST5D    SX0    BSTSDN      DIRECTIVE NAME 
          SX3    MSG373      * EXPECTING ( OR , AFTER * 
          LX0    18 
          BX3    X3+X0
          JP     BRWERR4     EXIT WITH ERROR MESSAGE
  
 BST5E    BSS 
          RJ     =XCCLLAB    READ LABEL OFF IF
  
          BX7    X7-X7       CLEAR PROC BODY CONDITIONAL FLAG 
          SX6    B1          SET FOR .IF SKIP 
          SA7    PBCOND 
          SA1    BGELSE 
          SA2    BGSKIP 
          SA3    LABEL
          NG     X1,BST5F    IF PROCESSING .IF/.IFE 
  
          IX6    X1+X1       0 IF .WHILE, 4 IF .ELSEIF
          SX6    X6-2        -2 IF .WHILE, 2 IF .ELSEIF 
          NZ     X2,BST5E1   IF SKIPPING
  
          ZR     X1,BST5F    IF .WHILE FOUND
  
          JP     BST00C1     PROCESS .ELSEIF WHILE NOT SKIPPING 
  
 BST5E1   BSS 
          SA4    BGLABL 
          IX1    X2-X6
          BX7    X3-X4
          ZR     X1,BST7     IF PREVIOUS .ELSE OR .WHILE INITIATED SKIP 
  
          NZ     X7,BST7     IF LABELS DO NOT MATCH 
  
          SA7    A2+         CLEAR THE SKIP FLAG
          NG     X6,BST5F    IF PROCESSING .WHILE 
  
          SX6    B1+         CONVERT .ELSEIF TO .IF 
 BST5F    BSS 
          BX7    X3          STORE LABEL FOR SKIP 
          SA7    BGLABL 
          SA5    EXPCHR 
          NZ     X5,BST7     IF NON-NULL STRING - NOT SKIPPING
  
          SA5    EXPVAL 
          NZ     X5,BST7     IF NOT SKIPPING - .DIRECTIVE COMPLETE
  
          NG     X5,BST7     IF NOT SKIPPING - .DIRECTIVE COMPLETE
  
          SA6    BGSKIP      INITIATE SKIPPING
          JP     BST7        .IF .IFE PROCESSED 
  
  
*         PROCESS .EOR/.EOS AND .EOF/.EOP DIRECTIVES
  
 BST6     BSS 
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          NZ     X4,BST8     IF STRING W/O SEPARATOR
  
          SX0    X1-1R. 
          SX7    X1-1R) 
          NG     X1,BST6A    IF NO TERMINATOR 
  
          ZR     X7,BST6A    RIGHT PAREN FOLLOWS .EOF 
  
          NZ     X0,BST8     EXIT IF NO TERMINATOR
  
 BST6A    BSS    0
          SX7    B3+BSTEND-BSTEOR 
          MX0    -1 
          BX7    -X0*X7 
          SX2    FILEDF 
          NZ     X7,BST6B    IF .EOF OR .EOP
  
          RJ     =XIOEOR     WRITE EOR
  
          JP     BST7        EXIT, COMMAND EXECUTED 
  
 BST6B    BSS    0
          SA7    BGEOF       SET FLAG WHEN WRITING EOF
          RJ     =XIOEOP     WRITE EOP
  
 BST7     BSS 
          SX5    0           SET FLAG= COMMAND EXECUTED 
          JP     BST         EXIT 
  
 BST8     BSS 
          SX5    1           RETURN CODE, TASK NOT EXECUTED 
          JP     BST         EXIT 
  
  
*         PROCESS .EX DIRECTIVE.
  
 OSNOSBE  IFNE   HOST,SC2 
 BST10    BSS    0           PROCESS .EX. 
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          SX3    MSG374      EXPECTING .AFTER .EX 
          SX0    X1-1R. 
          SA1    IACEX
          NZ     X1,BST7     .EX DIRECTIVE ALREADY PENDING
  
          NZ     X4,BST100   IF STRING W/O SEPARATOR
  
          NZ     X0,BST100   ERR MSG AND EXIT 
  
          SA2    SCATBF1
          SB7    X2          CURRENT CHARACTER
          EX3    X2,SBTOT 
          SB3    X3          TOTAL CHARACTERS 
          SB4    B3-B7       TOTAL REMAINING
          SX3    MSG375      NULL COMMAND ON .EX. 
          EQ     B4,B0,BST100    ERR MSG AND EXIT 
  
          SX7    B4 
          LX7    S.SBTOT-N.SBTOT+1
          SA7    A2+B7
          SA2    A7          NEW HEADER 
          SA1    EXBUF
          RJ     =XSTRPKS    PACK LINE
  
          SX7    1
          SA7    IACEX       INDICATE .EX. PENDING
          JP     BST7        DIRECTIVE PROCESSED
  
 OSNOSBE  ENDIF 
  
  
*         PROCESS SINGLE STATEMENT .IF OR .IFE DIRECTIVES.
  
 BST30    BSS    0           SINGLE STATEMENT .IF .IFE
          SA2    SCATBF1
          SB7    X2          CURRENT CHARACTER
          EX3    X2,SBTOT 
          SB3    X3          TOTAL CHARACTERS 
          SB4    B3-B7       TOTAL REMAINING
          SX7    B4 
          LX7    S.SBTOT-N.SBTOT+1
          SA7    SCATBF1
          BX2    X7 
          SB3    B1          MOVE REST OF LINE TO TOP OF BUFFER 
          ZR     X7,BST31A   IF NOTHING LEFT TO MOVE
  
 BST31    BSS    0
          SB7    B7+B1
          SA1    A2+B7
          SB4    B4-B1
          BX7    X1 
          SA7    A2+B3
          SB3    B3+B1
          NZ     B4,BST31    IF MORE CHARACTERS TO SHIFT
  
 BST31A   BSS    0
          SA1    PROCWSA
          RJ     =XSTRPKS 
  
          SA4    EXPCHR 
          NZ     X4,BST32    IF NON-NULL STRING (TRUE)
  
          SA4    EXPVAL      WAS .IF EXPRESSION TRUE
          NZ     X4,BST32    IF .IF EXPRESSION TRUE 
  
          PL     X4,BST7     IF .IF EXPRESSION FALSE
  
 BST32    BSS    0
          SX5    -1          FLAG SINGLE STATEMENT .IF PROCESSED
          JP     BST         EXIT 
  
  
*         PROCESS .NOTE DIRECTIVE.
  
 BST40    BSS    0
          SA4    IACIPF 
          ZR     X4,BST7     IF .NOTE IN NON-INTERACTIVE PROCEDURE
  
          SA5    PVTCL
          SA4    IACNOTE     CHECK FOR PREVIOUS NOTE
          NZ     X4,BST47A   IF THERE WAS A PREVIOUS .NOTE
  
          BX6    X5          CREATE PVT CONTROL WORD
          SA6    A4 
 BST47A   BSS    0
          SA2    SCATBF1     SCATTER BUFFER ADDRESS/HEADER
          RJ     BESP        ENTER .NOTE STRING IN PVT
  
          JP     BST7        INDICATE DIRECTIVE PROCESSED 
  
  
*         PROCESS .EXPAND DIRECTIVE.
  
 BST76    BSS    0
          RJ     STRSBS      SKIP BLANK SEPARATOR(S)
  
          SX7    B0+         PRESET FOR .EXPAND(ON) 
          NZ     X4,BST80    IF STRING W/O SEPARATOR
  
          NG     X1,BST80    IF NO SEPARATOR BEFORE END OF LINE 
  
          SX6    X1-1R) 
          SX3    X1-1R. 
          ZR     X6,BST80    .EXPAND) DEFAULT EXPAND ON 
  
          ZR     X3,BST80    .EXPAND. DEFAULT EXPAND ON 
  
          SX0    X1-1R( 
          SX6    X1-1R, 
          SX3    MSG421      EXPECTING , OR ( AFTER .DIRECTIVE
          ZR     X0,BST77    COMMA FOUND - READ ARGUMENT
  
          NZ     X6,BRWERR5  ABORT WITH ERROR 
  
 BST77    BSS    0
          SA2    SCATBF1
          RJ     =XSTRANS 
  
          SA1    ANSSEP 
          NG     X1,BST78    IF END OF LINE 
  
          SX3    MSG442      EXPECTING TERMINATOR 
          SX5    X1-1R. 
          SX6    X1-1R) 
          ZR     X5,BST78    IF . TERMINATOR
  
          NZ     X6,BRWERR5  IF NOT ) ABORT WITH ERROR
  
 BST78    BSS    0
          SA4    ANSCHR 
          SX3    MSG443      EXPECTING ON/OFF ARGUMENT
          ZR     X4,BRWERR5  IF NO STRING WAS FOUND 
  
          SA4    ANSSTR 
          SA5    =2LON
          SA1    =3LOFF 
          BX7    X4-X5
          BX6    X4-X1
          ZR     X7,BST80    IF ARGUMENT IS *ON*
  
          SX7    B1+         PRESET FOR EXPANSION *OFF* 
          ZR     X6,BST79.1  IF ARGUMENT IS *OFF* 
  
          SA5    =8LIMPLICIT
          SA1    =8LEXPLICIT
          SX7    B0+         SET EXPANSION *ON* 
          BX6    X4-X5
          BX0    X4-X1
          ZR     X6,BST79    IF ARGUMENT IS *IMPLICIT*
  
          NZ     X0,BRWERR5  IF INCORRECT .EXPAND ARGUMENT
  
          SX6    B1+         FLAG EXPLICIT EXPANSION
 BST79    BSS 
          SA6    IACSUB      SET IMPLICIT/EXPLICIT EXPANSION FLAG 
          JP     BST80       SET EXPANSION ON 
  
 BST79.1  BSS 
          SA1    IACEXP 
          NZ     X1,BST8           EXPAND ALREADY OFF 
  
 BST80    BSS    0
          SA7    IACEXP 
          JP     BST7        RETURN, TASK EXECUTED
  
  
*         PROCESS .IC AND .CC DIRECTIVES. 
  
 BST85    BSS    0
          SX7    B3+BSTDL-BSTCC 
          SA2    SCATBF1     GET SCATTER BUFFER ADDRESS/HEADER
          RJ     BCIC        CHANGE INHIBIT/CONCATENATION CHARACTER 
  
          JP     BST7        RETURN, TASK EXECUTED
  
  
 BST100   BSS    0           EXCHANGE SCATTER BUFFER POSITIONS
          SA2    SCATBF2
          SA1    SCATBF1
          EX6    X1,SBCUR    CURRENT CHARACTER
          OX7    X2,X6,SBCUR
          SA7    A2 
          JP     BRWERR5     POINTER ON SEPARATOR 
  
*         .SET ENCOUNTERED. 
  
 BST110   SX6    B0 
          SA6    ANSMDE      PROCESS LITERALS 
          SX6    B1 
          SA6    PBCOND      INDICATE WITHIN PROC BODY
          SA6    PROCESS     INDICATE PROCESSING, NOT SKIPPING
  
*         FETCH THE PARAMETER NAME TO SET.
  
          SA2    SCATBF1
          RJ     STRANS 
  
          SA1    ANSSEP 
          SX3    MSG385      *EXPECTING = AFTER KEYWORD*
          SX0    =5L.SET     IDENTIFY WHERE ERROR OCCURRED
          LX0    18 
          BX3    X0+X3
          SX0    X1-1R= 
          NZ     X0,BRWERR5  IF EQUALS SIGN NOT FOUND 
  
*         SEARCH *PPT* FOR PARAMETER. 
  
          SA2    ANSSTR 
          SA3    PPTCL
          SA4    ANSCHR 
          SA5    ANSLIT 
          SB2    B0+
          SB3    X3+
          SX3    MSG235      FORMAL PARAMETER .GT. IP.FPC CHARACTERS
          ZR     X5,BST110A  IF NOT A LITERAL KEYWORD 
  
          SA2    ANSEVL 
          SA4    ANSEVLC
 BST110A  BSS    0
          SX0    X4-V.FPC-1 
          PL     X0,BRWERR4  IF KEYWORD TOO LONG
  
          EQ     B3,B0,BST111A  IF NO FORMAL PARAMETERS 
  
 BST111   BSS    0
          SA1    PPT+W.PPFPN+B2  PARAMETER NAME 
          BX0    X1-X2
          ZR     X0,BST113   IF MATCHING PARAMETER NAME FOUND 
  
          SB2    B2+LE.PPT
          NE     B2,B3,BST111  IF MORE ENTRIES TO CHECK 
  
 BST111A  BSS    0
          BX7    X2 
          MX0    -6 
          SX3    MSG240      * MAY NOT APPEAR IN FORMAL PARAMETER NAME
 BST112   BSS    0
          LX2    6
          BX1    -X0*X2 
          BX2    X2-X1
          SX1    X1-1R* 
          ZR     X1,BRWERR4  IF KEYWORD NAME CONTAINS * 
  
          NZ     X2,BST112   IF MORE CHARACTERS TO CHECK
  
          SX0    B2-L.PPT 
          SX3    MSG238      FORMAL PARAMETER LIMIT EXCEEDED
          PL     X0,BRWERR4  IF TOO MANY KEYWORDS DEFINED 
  
          SX6    B2+LE.PPT
          SA6    A3          EXTEND PPT 
          SA7    PPT+W.PPFPN+B2  SET PARAMETER NAME IN PPT
          SA1    FPSCL       CREATE NEW FPS ENTRY AS WELL 
          SX6    X1+LE.FPS
          SA6    A1 
          BX0    X0-X0
          ERRNZ  W.PPFPC-W.PPDO1  FOLLOWING CODE ASSUMES SAME WORD
          OX2    X0,X4,PPFPC INSERT LENGTH OF KEYWORD 
          OX6    X2,X1,PPDO1 INSERT FPS OFFSET
          SA6    PPT+W.PPDO1+B2 
  
*         (B2) = PPT OFFSET.
*         (X5) = LITERAL KEYWORD FLAG.
  
 BST113   BSS    0
          SA2    PPT+W.PPLIT+B2 
          OX7    X2,X5,PPLIT INSERT LITERAL KEYWORD FLAG
          SX6    B2 
          SA7    A2 
          SA6    BSTPPT      SAVE PPT OFFSET
          RJ     =XCCLEVX    EVALUATE THE FOLLOWING EXPRESSION
  
          NZ     X5,BRWERR4  IF INVALID EXPRESSION ERROR IN X3
  
          SA1    EXPCHR 
          SA4    EXPVAL 
          NZ     X1,BST116   IF STRING RESULT 
  
          ZR     X4,BST116   IF NULL VALUE
  
          SX1    11 
          MX0    6
          BX6    X4 
          LX6    -6 
 BST114   LX6    6
          BX4    X0*X6
          ZR     X4,BST114   IF NOT JUSTIFIED 
  
 BST115   LX0    6
          BX4    X0*X6
          SX1    X1-1 
          ZR     X4,BST115   IF LENGTH NOT DETERMINED 
  
          SA6    EVXVS
 BST116   BSS    0
          SX3    MSG156 
          SX0    EVXVS
          LX0    18 
          BX3    X0+X3
          SX0    X1-V.SCS-1 
          PL     X0,BRWERR4  IF STRING IS TOO LONG
  
          SA4    BSTPPT      OFFSET OF PPT ENTRY
          BX3    X1 
          SA4    PPT+W.PPDC1+X4 
          OX6    X4,X3,PPDC1
          SA6    A4 
          EX3    X6,PPDO1    GET FPS OFFSET 
          SA4    EVXVS
          SA0    X3+FPS 
 BST117   BX6    X4 
          SA6    A0 
          SX1    X1-10
          NG     X1,BST118   IF MOVE COMPLETE 
  
          ZR     X1,BST118   IF MOVE COMPLETE 
  
          SA0    A6+B1
          SA4    A4+B1
          EQ     BST117      CONTINUE MOVING PARAMETER
  
 BST118   SA1    ANSSEP 
          SX0    X1-1R, 
          ZR     X0,BST110   IF ANOTHER SYMBOL TO PROCESS 
  
          JP     BST7        EXIT - ONLY , OR TERMINATOR ENDS CCLEVX
  
  
 BSTPPT   BSS    1           SAVE AREA FOR PPT OFFSET 
 BSTSDN   BSSZ   1           SAVE DIRECTIVE NAME
          TITLE  BEGIN, VALIDATE ENTRY
**        BVE  -  BEGIN, VALIDATE ENTRY 
* 
*         THE INTERACTIVE CALL HAS BEEN CRACKED INTO
*         TABLES PPT,FPS, AND PVT.  BVE WILL CHECK
*         THE SPECIFIED ENTRY FOR A PARAMETER AGAINST 
*         THE ATTRIBUTES ON THE PROCEDURE HEADER CHECKLIST. 
* 
* 
*         ENTRY - BGPWPL CONTAINS THE PPT OFFSET OF THE PARAMETER 
* 
*         EXIT  - JUMP TO BIV300 IF ERRORS
*                 OTHERWISE - RETURN
* 
* 
* 
 BVE      BSSZ   1                 ENTRY/EXIT 
  
*         CHECK FOR *N BEING THE ONLY PATTERN IN THE CHECKLIST
*         FOR THIS PARAMETER.  IF *N IS THE ONLY PATTERN, THEN
*         DO NOT PROMPT FOR THIS PARAMETER.  ALSO IGNORE ANY
*         VALUES ENTERED ON THE CALL.  ESSENTIALLY CCL DOES 
*         NOT TALK ABOUT *N PARAMETERS DURING DIALOGUES.
  
          SA1    BGPWPL 
          SA2    PPT+W.PPNO+X1
          LX2    59-S.PPNO
          PL     X2,BVE020         *N ONLY - USE DEFAULT VALUE
  
*         CHECK FOR HELP MODE.  IF NOT IN HELP MODE, CHECK FOR
*         AN ENTRY ON THE CALL.  IN HELP MODE PROMPT FOR THIS 
*         PARAMETER UNLESS SOMETHING WAS ENTERED ON THE CALL, 
*         THEN THIS SHOULD BE VALIDATED.
  
          SA3    =10H ENTER 
          SA4    BGHMD             HELP MODE
          SA2    PPT+W.PPBSP+X1 
          ERRNZ  59-S.PPBSP 
          ZR     X4,BVE010         NOT IN HELP MODE 
          NG     X2,BVE015         VALIDATE ENTRY ON CALL 
          JP     BIV300            PROMPT FOR THIS PARAMETER
  
  
*         DETERMINE IF AN ENTRY WAS ON THE CALL (NON-HELP MODE) 
  
 BVE010   BSS    0
  
          PL     X2,BVE020         NO ENTRY ON CALL - CHECK *N
  
 BVE015   BSS    0                 VALIDATE ENTRY ON CALL 
          ERRNZ  W.PPBSP-W.PPDO2
          EX0    X2,PPDO2 
          SA4    FPS+W.FPSCV+X0    X4 = 1ST WORD OF CALL VALUE
          ERRNZ  W.PPBSP-W.PPDC2
          EX5    X2,PPDC2 
          ERRNZ  W.PPBSP-W.PPCPV
          LX2    59-S.PPCPV 
          NG     X2,BVE060         READ PATTERNS FROM PVT 
  
          RJ     BVK               VALIDATE AGAINST *K PVT ENTRIES
  
          GE     B6,B1,BVE050      IF A MATCH WAS FOUND 
  
          NZ     X5,BVE060         IF VALUE IS NOT NULL 
  
  
*         SEARCH THE CHECKLIST FROM LEFT TO RIGHT.  NULL WILL MATCH 
*         THE *N DEFAULT OR A NULL PATTERN WHICHEVER COMES FIRST. 
  
 BVE017   BSS    0
          RJ     =XCCLPVO          GET PVT OFFSETS
  
 BVE018   BSS    0
          RJ     =XCCLNPV          GET NEXT CHECKLIST PATTERN 
  
          ZR     X2,BVE060         IF NO MORE CHECK OTHER PATTERNS
  
          SA1    =0LN 
          BX7    X0-X1
          ZR     X7,BVE025         IF *N OR *D WITH NO REPLACEMENT
  
          SA1    =0LNVALUE
          BX7    X0-X1
          ZR     X7,BVE021         IF *N OR *D WITH REPLACEMENT 
  
          SA1    =0LPATERN
          BX7    X0-X1
          NZ     X7,BVE018         IF NOT A PATTERN 
  
          NE     B2,B0,BVE018      IF NOT A NULL PATTERN
  
          SA1    =0LVALUE 
          BX7    X1 
          SA7    IACPVID
          RJ     =XCCLNPV          FIND VALUE AFTER PATTERN 
  
          ZR     X2,BVE050         IF NOTHING FOLLOWS PATTERN 
  
          SA1    =0LVALUE 
          BX7    X0-X1
          NZ     X7,BVE050         IF NO VALUE FOLLOWS PATTERN
  
          SA4    A2+W.PVSTR-W.PVID FIRST WORD OF VALUE
          SX5    B2                SIZE OF VALUE
          JP     BVE050            SAVE REPLACEMENT VALUE IN FPS
  
  
 BVE020   BSS    0                 CHECK *N DEFAULT 
          SA3    =10H ENTER       PARAMETER MISSING MESSAGE 
          SA1    BGPWPL 
          SA2    PPT+W.PPNDA+X1 
          EX0    X2,PPNDA 
          ZR     X0,BIV300         PARAMETER MAY NOT BE OMITTED - PROMPT
  
          SA2    PVT+W.PVID+X0     CHECK FOR *N = VALUE 
          MX7    N.PVID 
          ERRNZ  59-S.PVID
          BX6    X7*X2
          SA1    =0LNVALUE
          BX7    X6-X1
          NZ     X7,BVE025         IF *N OR *D WITH NO REPLACEMENT
 BVE021   BSS    0
          SA4    A2+W.PVSTR-W.PVID FIRST WORD OF REPLACEMENT VALUE
          ERRNZ  W.PVID-W.PVSIZ    CODE DEPENDS UPON VALUES 
          EX5    X2,PVSIZ          REPLACEMENT STRING SIZE
          JP     BVE030            CHECK FOR DISPLAYABLE DEFAULT
  
 BVE025   BSS    0
          SA1    BGPWPL 
          SA4    PPT+W.PPFPN+X1    KEYWORD BECOMES FPS ENTRY
          SA3    PPT+W.PPFPC+X1    THIS INDICATES NO SUBSTITUTION 
          EX5    X3,PPFPC          NUMBER OF CHARACTERS IN CALL VALUE 
  
*         X2 = PVT CONTROL WORD FOR THIS ENTRY. 
*         X4 = 1ST WORD OF REPLACEMENT VALUE. 
*         X5 = NUMBER OF CHARACTERS IN REPLACEMENT VALUE. 
*         A4 = ADDRESS OF REPLACEMENT VALUE.
  
 BVE030   BSS    0
          LX2    59-S.PVDND        CHECK FOR DISPLAYABLE DEFAULT
          NG     X2,BVE060         IF DISPLAYABLE DEFAULT 
  
* 
* 
*         BUILD AN FPS ENTRY CONTAINING VALUE TO BE 
*         SUBSTITUTED FOR THE KEYWORD IN THE PROCEDURE
*         BODY (FPS REPLACEMENT ENTRY). 
* 
*         X4 = 1ST WORD OF REPLACEMENT VALUE
*         A4 = ADDRESS OF REPLACEMENT VALUE 
*         X5 = NUMBER OF CHARACTERS 
* 
* 
 BVE050   BSS    0
          SA1    BGPWPL 
          SA2    PPT+W.PPDO1+X1    GET FPS ENTRY OFFSET 
          EX1    X2,PPDO1 
          BX7    X4 
          SB7    X5                NUMBER OF CHARACTERS IN STRING 
          SA3    =10H ERROR 
          SB6    B7-V.SCS-1 
          GE     B6,B0,BIV300      VALUE TOO LARGE
  
          ERRNZ  W.PPDC1-W.PPDO1
          OX6    X2,X5,PPDC1       PUT SIZE OF VALUE IN PPT 
          SA6    A2 
          EQ     B7,B0,BVE         NULL VALUE - RETURN
  
          SA7    FPS+W.FPSRV+X1 
 BVE055   BSS    0
          SB7    B7-10
          GE     B0,B7,BVE         MOVE COMPLETE - RETURN 
  
          SA4    A4+B1
          BX7    X4 
          SA7    A7+B1
          JP     BVE055            MOVE NEXT WORD 
  
  
*         READ PATTERNS AND VALUES FROM THE PVT 
*                X4 = 1ST WORD OF VALUE 
*                X5 = SIZE OF VALUE 
  
  
 BVE060   BSS    0
          SA1    BGPWPL            CURRENT PPT ENTRY ADDRESS
          RJ     BVP               VALIDATE AGAINST ALL PVT ENTRIES 
  
          GE     B6,B1,BVE050      IF MATCH FOUND IN PVT
  
          SA3    =10H ERROR 
          NZ     X5,BIV300         IF INCORRECT VALUE PROMPT USER 
  
          SA1    BGPWPL 
          SA2    PPT+W.PPCPV+X1 
          LX2    59-S.PPCPV 
          NG     X2,BIV300         IF EXPLICIT NULL PARAMETER 
  
          SA3    =10H ENTER 
          JP     BIV300            PROMPT FOR OMITTED PARAMETER 
  
 BVK      SPACE  4,25 
**        BVK - BEGIN, VALIDATE AGAINST *K PVT ENTRIES. 
* 
*         CHECKS ITEM AGAINST *K ENTRY OR PATTERN ENTRIES PRIOR TO *K.
* 
*         ENTRY  (BGPWPL) = ADDRESS OF CURRENT PPT ENTRY. 
*                (X1) = ADDRESS OF CURRENT PPT ENTRY. 
*                (A4) = ADDRESS OF ITEM BEING CHECKED.
*                (X4) = FIRST WORD OF ITEM BEING CHECKED. 
*                (X5) = LENGTH OF ITEM BEING CHECKED. 
* 
*         EXIT   (B6) = 0 IF NO MATCHING PVT ENTRY FOUND, 
*                            ((A4), (X5), AND (X5) ARE PRESERVED) 
*                       1 IF A MATCH WITH NO REPLACEMENT VALUE, 
*                            ((A2) = ADDRESS OF PVT ENTRY)
*                            ((A4), (X5), AND (X5) ARE PRESERVED) 
*                       2 IF A MATCH WITH *K WITH REPLACEMENT,
*                            ((A2) = ADDRESS OF PVT ENTRY)
*                            ((A4) = ADDRESS OF REPLACEMENT VALUE)
*                            ((X4) = FIRST WORD OF REPLACEMENT VALUE) 
*                            ((X5) = LENGTH OF REPLACEMENT VALUE) 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 7. 
*                A - 1, 3, 4, 7.
*                B - 6. 
* 
*         CALLS  CCLNPV, CCLPVO.
  
 BVK      SUBR                     ENTRY/EXIT 
          SB6    B0                PRESET NO MATCH INDICATOR
          SA2    PPT+W.PPKAP+X1    CHECK *K ATTRIBUTE 
          EX0    X2,PPKAP 
          ZR     X0,BVKX           IF NO *K DEFAULT 
  
          SA1    PPT+W.PPFPN+X1 
          BX3    X4-X1
          NZ     X3,BVKX           IF ENTRY .NE. KEYWORD
  
          RJ     =XCCLPVO          GET PVT OFFSETS
  
*         SEARCH THE CHECKLIST FROM LEFT TO RIGHT.  THE KEYWORD WILL
*         MATCH EITHER THE *K DEFAULT OR A PATTERN WHICHEVER COMES 1ST. 
  
 BVK1     BSS    0
          SB6    B0                PRESET FOR NO MATCH
          RJ     =XCCLNPV          NEXT PATTERN VALUE 
  
          ZR     X2,BVKX           IF NO MATCH ON *K OR PATTERN 
  
          SA1    =0LKVALUE
          BX7    X0-X1
          ZR     X7,BVK2           IF *K WITH SUBSTITUTION
  
          SB6    B1                SET MATCH INDICATOR
          SA1    =0LK 
          BX7    X0-X1
          ZR     X7,BVKX           IF MATCH FOUND ON *K 
  
          SA1    =0LPATERN
          BX7    X0-X1
          NZ     X7,BVK1           IF NOT A PATTERN 
  
          SA1    A2+W.PVSTR-W.PVID FIRST WORD OF PATTERN
          BX7    X4-X1
          NZ     X7,BVK1           IF PATTERN DOES NOT MATCH
  
          RJ     =XCCLNPV          FIND VALUE AFTER PATTERN 
  
          ZR     X2,BVKX           IF NOTHING FOLLOWS PATTERN 
  
          SA1    =0LVALUE 
          BX7    X0-X1
          NZ     X7,BVKX           IF NO VALUE FOLLOWS PATTERN
  
 BVK2     BSS    0
          SX5    B2                SIZE OF VALUE
          SB6    B1+B1             INDICATE PATTERN WITH VALUE
          SA4    A2+W.PVSTR-W.PVID FIRST WORD OF VALUE
          JP     BVKX              RETURN 
 BVP      SPACE  4,25 
**        BVP - BEGIN, VALIDATE ITEM AGAINST PVT ENTRIES. 
* 
*         CHECKS ITEM AGAINST ALL PVT ENTRIES.
* 
*         ENTRY  (BGPWPL) = ADDRESS OF CURRENT PPT ENTRY. 
*                (A4) = ADDRESS OF ITEM BEING CHECKED.
*                (X4) = FIRST WORD OF ITEM BEING CHECKED. 
*                (X5) = LENGTH OF ITEM BEING CHECKED. 
* 
*         EXIT   (B6) = 0 IF NO MATCHING PVT ENTRY FOUND, 
*                            ((A4), (X5), AND (X5) ARE PRESERVED) 
*                       1 IF A MATCH WITH NO REPLACEMENT VALUE, 
*                            ((A2) = ADDRESS OF PVT ENTRY)
*                            ((A4), (X5), AND (X5) ARE PRESERVED) 
*                       2 IF A MATCH WITH A REPLACEMENT VALUE,
*                            ((A2) = ADDRESS OF PVT ENTRY)
*                            ((A4) = ADDRESS OF REPLACEMENT VALUE)
*                            ((X4) = FIRST WORD OF REPLACEMENT VALUE) 
*                            ((X5) = LENGTH OF REPLACEMENT VALUE) 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 7. 
*                B - 2, 3, 4, 6.
* 
*         CALLS  CCLNPV, CCLPVO.
  
 BVP      SUBR                     ENTRY/EXIT 
          RJ     =XCCLPVO          GET PVT OFFSETS
  
 BVP1     BSS    0
          SB6    B0 
          RJ     =XCCLNPV          GET NEXT PVT ENTRY 
  
          ZR     X2,BVPX           IF NO MORE PVT ENTRIES 
  
          MX7    6
          BX6    X0*X7
          SA3    =0LS 
          LX6    6
          SX7    X6-1RF 
          BX1    X0-X3
          ZR     X7,BVP6           IF COMPARING TO *F ATTRIBUTE 
  
          ZR     X1,BVP10          IF COMPARING TO *S ATTRIBUTE 
  
          SA1    =0LA 
          BX7    X0-X1
          ZR     X7,BVP4           IF COMPARING TO *A ATTRIBUTE 
  
          SA1    =0LAVALUE
          BX3    X0-X1
          ZR     X3,BVP4           IF COMPARING TO *A WITH REPLACEMENT
  
          SA1    =0LP 
          BX3    X0-X1
          ZR     X3,BVP6           IF COMPARING TO *P ATTRIBUTE 
  
          SA1    =0LPVALUE
          BX3    X0-X1
          ZR     X3,BVP6           IF COMPARING TO *P WITH REPLACEMENT
  
          SA1    =0LPATERN
          BX7    X0-X1
          ZR     X7,BVP2           IF COMPARING TO PATTERN
  
          SA1    =0LNVALUE
          BX1    X0-X1
          LX2    59-S.PVDND 
          NZ     X1,BVP1           IF NO MATCH CHECK NEXT PVT ENTRY 
  
          PL     X2,BVP1           IF NOT A *D OR DISPLAYABLE *N
  
 BVP2     BSS    0
          SA1    =0LVALUE          NEXT EXPECTED PVT ENTRY
          SB4    X5 
          BX7    X1 
          SA7    IACPVID
  
          NE     B2,B4,BVP1        IF STRING SIZES NOT EQUAL
  
          EQ     B2,B0,BVP8        IF MATCH ON NULL PATTERN 
  
          SB3    V.SCS             MAXIMUM LENGTH OF STRING 
          SA2    A2+W.PVSTR-W.PVID FIRST WORD OF STRING 
          SA1    A4 
 BVP3     BSS    0
          BX6    X1-X2             COMPARE VALUES 
          NZ     X6,BVP1           IF NO MATCH CHECK NEXT PVT ENTRY 
  
          SB4    B4-10
          SB3    B3-10
          GE     B0,B4,BVP8        IF MATCHING PATTERN FOUND
  
          LE     B3,B0,BVP1        IF STRING IS TOO LONG
  
          SA2    A2+B1
          SA1    A1+B1
          JP     BVP3              COMPARE NEXT WORD
  
  
  
*         COMPARE SIZE OF CALL VALUE TO THE RANGE ON THE *A 
*         ATTRIBUTE (FROM THE PROC HEADER CHECKLIST). 
  
*         X2 = PVT CONTROL WORD FOR THE *A ATTRIBUTE
*         X3 .EQ. 0 IF *A ATTRIBUTE HAS A REPLACEMENT VALUE 
*            .NE. 0 IF NO REPLACEMENT - CALL VALUE WILL BE USED.
*         X4 = 1ST WORD OF CALL VALUE 
*         X5 = SIZE OF CALL VALUE 
  
 BVP4     BSS    0                 PROCESS *A ATTRIBUTE 
          EX6    X2,PVMIN          MINIMUM SIZE FROM CHECKLIST RANGE
          IX7    X5-X6
          NG     X7,BVP1           IF ITEM SIZE LESS THAN MINIMUM 
  
          EX6    X2,PVMAX          MAXIMUM SIZE FROM CHECKLIST RANGE
          IX7    X6-X5
          NG     X7,BVP1           IF ITEM SIZE EXCEEDS MAXIMUM 
  
 BVP5     BSS    0
          MX7    6
          BX7    -X7*X0 
          NZ     X7,BVP9           IF THERE IS A REPLACEMENT VALUE
  
          SB6    B1                INDICATE NO REPLACEMENT VALUE
          JP     BVPX              RETURN WITH ORIGINAL VALUE 
  
  
*         COMPARE CALL VALUE TO THE *F OR *P ATTRIBUTE FROM THE 
*         PROC HEADER CHECKLIST.
  
*         X2 = PVT CONTROL WORD FOR *F OR *P ATTRIBUTE. 
*         X3 .EQ. 0 IF *P ATTRIBUTE BEING CHECKED.
*            .NE. 0 IF *F ATTRIBUTE BEING CHECKED.
*         X4 = 1ST WORD OF CALL VALUE 
*         X5 = SIZE OF CALL VALUE 
  
  
  
  
 BVP6     BSS    0                 PROCESS *F OR *P ATTRIBUTE 
          EX6    X2,PVMIN          MINIMUM SIZE FROM CHECKLIST RANGE
          IX7    X5-X6
          NG     X7,BVP1           IF ITEM SIZE LESS THAN MINIMUM 
  
          EX6    X2,PVMAX          MAXIMUM SIZE FROM CHECKLIST RANGE
          IX7    X6-X5
          NG     X7,BVP1           IF ITEM SIZE EXCEEDS MAXIMUM 
  
          SB6    X5 
          SB4    B6-B1
          BX1    X4 
 BVP7     BSS    0
          EQ     B6,B0,BVP5        IF ITEM MATCHES THIS ENTRY 
  
          LX1    6
          MX6    -6 
          BX6    -X6*X1            ISOLATE NEXT FILE NAME CHARACTER 
          SB6    B6-B1
          SX7    X6-1R+ 
          PL     X7,BVP1           IF NOT ALPHANUMERIC
  
 OSNOS    IFEQ   HOST,NOS 
          NZ     X3,BVP7           IF PROCESSING *F ATTRIBUTE 
  
 OSNOS    ENDIF 
  
          LT     B6,B4,BVP7        IF ALREADY PAST FIRST CHARACTER
  
          SX7    X6-1R0 
          NG     X7,BVP7           IF ALPHABETIC CONTINUE 
  
          JP     BVP1              NO MATCH - CHECK NEXT PVT ENTRY
  
 BVP8     BSS    0                 CHECK FOR REPLACEMENT VALUE
          SB6    B1                PRESET FOR NO REPLACEMENT VALUE
          RJ     =XCCLNPV          FIND VALUE AFTER PATTERN 
  
          ZR     X2,BVPX           IF NO VALUE FOLLOWS PATTERN
  
          SA1    IACPVID
          BX7    X0-X1
          NZ     X7,BVPX           IF NO VALUE FOLLOWS PATTERN
  
 BVP9     BSS    0
          SB6    B1+B1             INDICATE REPLACEMENT VALUE 
          SX5    B2                SIZE OF VALUE
          SA4    A2+W.PVSTR-W.PVID REPLACEMENT VALUE
          NZ     X5,BVPX           IF NON-NULL REPLACEMENT VALUE
  
          SX4    B0+
          JP     BVPX              RETURN WITH NULL REPLACEMENT VALUE 
  
  
  
*         COMPARE THE CALL VALUE WITH THE SET SPECIFIED IN THE
*         *S ATTRIBUTE FROM THE PROCEDURE HEADER. 
  
*         A2 = ADDRESS OF PVT CONTROL WORD FOR THE *S ATTRIBUTE 
*         X2 = PVT CONTROL WORD FOR THE *S ATTRIBUTE
*         X4 = 1ST WORD OF CALL VALUE 
*         X5 = SIZE OF CALL VALUE 
*         B2 = LENGTH OF SET (PVSIZ)
  
 BVP10    BSS    0                 COMPARE ENTRY TO *S ATTRIBUTE
          SA1    =0LSVALUE
          BX7    X1 
          SA7    IACPVID
          EX6    X2,PVMIN          MINIMUM SIZE FROM CHECKLIST RANGE
          IX7    X5-X6
          NG     X7,BVP1           IF ITEM SIZE LESS THAN MINIMUM 
  
          EX6    X2,PVMAX    MAXIMUM SIZE FROM CHECKLIST RANGE
          IX7    X6-X5
          NG     X7,BVP1           IF ITEM SIZE EXCEEDS MAXIMUM 
  
          MX1    -6 
          SA0    A2                PRESERVE CURRENT PVT PVID ADDRESS
          BX7    X5                LENGTH OF CALL VALUE 
          SA3    A4                1ST WORD OF CALL VALUE 
          SB3    10 
 BVP11    BSS    0
          ZR     X7,BVP8           IF ITEM MATCHES THIS SET 
  
          GT     B3,B0,BVP12       IF NOT FINISHED WITH WORD OF ITEM
  
          SA3    A3+1              GET NEXT WORD OF VALUE 
          SB3    10 
 BVP12    BSS    0
          SB6    B2                LENGTH OF SET
          LX3    6
          BX6    -X1*X3 
          SB3    B3-B1
          SX7    X7-1 
          SA2    A0+W.PVSTR-W.PVID FIRST WORD OF SET
 BVP13    BSS    0
          SB4    10 
 BVP14    BSS    0
          LX2    6
          BX0    -X1*X2            ISOLATE CURRENT CHARACTER OF SET 
          BX0    X0-X6
          ZR     X0,BVP11          IF ITEM CHARACTER IS MEMBER OF SET 
  
          SB6    B6-B1
          SB4    B4-B1
          LE     B6,B0,BVP1        IF FINISHED WITH SET AND NO MATCH
  
          GT     B4,B0,BVP14       IF NOT FINISHED WITH WORD OF SET 
  
          SA2    A2+B1             READ NEXT WORD OF (SET)
          JP     BVP13             CONTINUE COMPARISON
  
 CDF      SPACE  4,15 
**        CDF - CLOSE .DATA FILE. 
* 
*         TERMINATES AND REWINDS .DATA FILE.
* 
*         ENTRY  NONE.
* 
*         EXIT   .DATA FILE CLOSED AND REWOUND. 
* 
*         USES   X - 1, 2, 5, 6.
*                A - 1, 2, 5, 6.
* 
*         MACROS NOS - SETFS. 
*                SC2 - CLOSEM.
  
 CDF      SUBR                     ENTRY/EXIT 
          SA5    BGDATA 
          ZR     X5,CDFX           IF NO .DATA FILE BEING WRITTEN 
  
          SA1    BGEOF
          NZ     X1,CDF1           IF EOF JUST WRITTEN TO FILE
  
          SX2    FILEDF 
          RJ     =XIOEOR           WRITE EOR ON .DATA FILE
  
          SX6    B0+               CLEAR THE EOF FLAG 
          SA6    BGEOF
 CDF1     BSS    0
          SX2    FILEDF 
          RJ     =XIOREW           REWIND THE DATA FILE 
  
 OSNOS    IFEQ   HOST,NOS 
          SETFS  FILEDF,0          AVOID FILE RETURN AFTER SYS PROLOG 
 OSNOS    ENDIF 
  
 OSSC2    IFEQ   HOST,SC2 
          CLOSEM FILEDF,N,FILE     CLOSE .DATA FILE 
 OSSC2    ENDIF 
  
          JP     CDFX              RETURN 
