.
.         DYNAMIC FACILITIES INTERFACE
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          AXR$
          DEFUNCT$
          FANG
          PURE      CODE
.
.         FAC COMMAND SERVICE
.
FACP*     REMOVE    PARQUE              GET PARAMETER
          TNE,U     A1,PARQUE           PARAMETER OMITTED ?
          J         FACLST              YES.  EDIT LAST STATUS
          LA        A5,PBVAL,A1         LOAD STATUS SUBMITTED BY USER
          BRELP     A1                  RELEASE THE PARAMETER
facpl     errpr$p   errpkt              ask system to explain reject
          J         ICOUT               END OF THIS COMMAND
.
FACLST    LA        A5,CSFSTBIT         LOAD CSF$ STATUS BITS
          JNZ       A5,FACPL            PROCESS IF ANY SPECIFIED
          F$DT1     fll$,fl$            NONE.  SET UP THE EDITOR
          F$MSG     NOREJY              EDIT THE MESSAGE
          F$PRT     1                   INFORM USER NO REJECTS SO FAR
          J         ICOUT               END OF THIS COMMAND
.
.         OPTION EDITOR
.
MBO*      TNZ       CWOPTION            ANY OPTIONS ?
          J         0,X5                NO.  DON'T EDIT ANYTHING
          F$CHAR    ','                 EDIT A COMMA
          LA,U      A5,'A'              GET THE LOW BIT'S LETTER
          LA        A4,CWOPTION         LOAD OPTION BITS
          LSSL      A4,10               SHIFT 'A' INTO SIGN POSITION
MBO1      JP        A4,SMBO             DON'T EDIT IF NOT PRESENT
          F$CHAR    A5,,W               EDIT THE CHARACTER
SMBO      LSSL      A4,1                SHIFT OFF THE BIT
          AA,U      A5,1                INCREMENT LETTER TO EDIT
          JNZ       A4,MBO1             KEEP GOING IF MORE OPTIONS
          J         0,X5                RETURN
.
.         STRING EDITOR
.
COPYS     REMOVE    PARQUE              REMOVE A PARAMETER
          TNE,U     A1,PARQUE           ANY PARAMETER SPECIFIED ?
          J         0,X6                NO.  SKIP EDITING
          LA,U      A3,,A1              SAVE ADDRESS
          LA,U      A0,PBSS,A3          LOAD STRING START ADDRESS
          LA        A1,PBVAL,A3         LOAD LENGTH IN CHARACTERS
          F$COPY    .                   COPY THE PARAMETER
          BRELP     A3                  RELEASE THE PARAMETER BUFFER
          J         0,X6                RETURN
.
.         FACILITIES REQUEST SUBROUTINE
.
CSF*      LA        A1,PARTBL           LOAD OPTIONS
          TOP       A1,(OPTION('C'))    IS THE 'C' OPTION ON ?
          J         DOCSF               NO.  DO THE CSF$ CALL
          LA        A1,A0               SAVE THE CSF$ PARAMETER
          LXI,U     A0,0116             LOAD SPACING AND LENGTH
          PRINT$    .                   LOG THE IMAGE
          LA        A0,A1               LOAD BACK THE CSF$ PARAMETER
DOCSF     CSF$      .                   SUBMIT THE REQUEST
          J         1,X11               RETURN
.
.         CSF$ STATUS EDITOR
.
CSFST*    JZ        A0,,X5              RETURN IF NO BITS SET
          SA        A0,CSFSTBIT         SAVE STATUS BITS FOR FAC COMMAND
          SA        A0,A5               SAVE STATUS
          R$DIT     .                   SET UP EDITOR
          TP        A5                  REJECT OR WARNING ?
          J         REJT                REJECT.
          E$MSG     WARN                EDIT WARNING
stj       jndem     stj1                skip if we'll print anyway
          e$octf    12,a5               edit status bits for demand
          E$SKIP    1                   SKIP A SPACE
stj1      E$COPY    50,LINE             EDIT SOME OF THE OFFENDING COMMAND
          JNDEM     BAMMO               EDIT FULL DIAGNOSTIC ?
          R$PRTX    1                   PRINT THE LINE
          J         0,X5                RETURN
REJT      E$MSG     REJCM               EDIT REJECTED
          J         STJ                 PROCESS STATUS
bammo     r$prtx    1                   print message and terminate editor
          errpr$p   errpkt              ask system to explain error
          j         0,x5                return to caller
.
.         STATUS EDITOR FOR REENTRANT CALLS ON CSF.  ASSUMES ENTERED IN
.         RDIT$ MODE WITH CSF$ IMAGE EDITED INTO BUFFER.  EXITS WITH
.         RDIT$ MODE OFF.
.
CSFSTR*   JZ        A0,CSFREN           RETURN IF NOTHING TO EDIT
          SA        A0,CSFSTBIT         SAVE CSF$ REJECT STATUS FOR FAC COMMAND
          SA        A0,A5               SAVE STATUS FOR ERROR MESSAGE EDITOR
          BGET      10                  ALLOCATE A MESSAGE SAVE BUFFER
          LX,U      X6,,A0              SAVE ADDRESS OF BUFFER
          LXI,U     A0,1                LOAD INCREMENT FOR BUFFER
          LA,H2     A1,,X1              LOAD IMAGE BUFFER FOR RDIT$
          LXI,U     A1,1                GET INCREMENT FOR EDITED IMAGE
          LR,U      R1,10               GET COUNT TO SAVE TEN WORDS
          BT        A0,,*A1             COPY EDITED COMMAND IMAGE TO BUFFER
          E$DITX    .                   LEAVE EDIT MODE
          E$DIT     .                   RE-ENTER EDIT MODE, CLEARING IMAGE
          JN        A5,REJCTR           EDIT REJECT IF STATUS WAS REJECT
          E$MSG     WARN                EDIT WARNING MESSAGE
stjr      jndem     stjr1               skip if we'll print messages
          e$octf    12,a5               demand.  just edit error code
          E$SKIP    1                   SKIP ONE SPACE AFTER STATUS
stjr1     E$COPY    50,,X6              COPT IMAGE TO BUFFER
          BRELP     X6                  RELEASE THE TEMPORARY IMAGE BUFFER
          JNDEM     BAMMO               EDIT BITS INTO MESSAGE FOR BATCH
          R$PRTX    1                   PRINT AND LEAVE EDIT MODE
          J         0,X5                RETURN TO CALLER
.
REJCTR    E$MSG     REJCM               EDIT REJECT MESSAGE
          J         STJR                EDIT REST OF MESSAGE
.
CSFREN    R$DITX    .                   TERMINATE EDIT MODE
          J         0,X5                RETURN TO CALLER
.
.
          PURE      DATA
WARN      'CSF$ WARNING: !'
REJCM     'CSF$ REJECT: !'
ILCM      'CSF$ BAD FORMAT: !'
.
NOREJY    'NO FACILITY REQUEST DIAGNOSTICS HAVE BEEN ISSUED SO FAR.&'
          END