*DECK C$ACCMN 
          IDENT  C$ACCMN
          SST 
 TAF      IFEQ   OP.TAF,OP.NO 
          TITLE  C$ACCMN - ACCEPT DATA-NAME FROM MNEMONIC NAME
* 
          COMMENT  ACCEPT DATA-NAME FROM MNEMONIC NAME
* 
**        NAME   CBACCMN - ACCEPT DATA-NAME FROM MENMONIC NAME
* 
*         CALLING SEQUENCE
*                SB5  FWA 
*                SB6  CHAR OFFSET 
*                SB7  SIZE
*                SA1  MENMONIC NAME 
*                RJ   =XC.ACCMN 
* 
*         USES
*                REGUALR SEQUENTIAL I/O TO READ FILE
*                PUTS DATA INTO DATA NAME 
*                DESTROYS ALL REGISTERS 
* 
  
 ACPTMRL  EQU    80          DEFAULT MRL
 CONSLL   EQU    40          MAX NO. CHARS POSSIBLE FROM CONSOLE
  
*CALL IODEFSC 
*CALL IOMICROS
          ENTRY  C.ACCMN
 C.ACCMN  DATA   0
          SX6    B6          SAVE PARAMETERS
          SA6    SAVEPS 
          SX7    B5 
          SA7    A6+B1
          SX6    B7 
          SA6    A7+B1
          SA4    =XC.SYSF+#CONS#-1 GET NAME CONSOLE 
          MX2    42 
          BX1    X2*X1             MASK OFF CARR-CTL BITS (FOR TERMINL) 
          IX4    X4-X1
          ZR     X4,ACCCONS  JUMP IF CONSOLE
          MX6    0
          SA6    =SCONSFLG   INDICATE NOT CONSOLE 
          SB2    RDLNNB      LINE NUMBER PLACE
          SX7    =XC.OPIN    SET OPEN INPUT ADDR
          SA4    C.ACCMN
          RJ     =XC.ACDSC   GO SET UP STUFF
          FETCH  A0,RECA,X6 
          SA6    =SSVRECA    SAVE RECORD AREA ADDR
          STORE  A0,RECA==XC.BUFF  NEW REC AREA 
 ACCDORD  BSS    0           DO READ OPERATION
          FETCH  A0,CNF,X1
          FETCH  A0,ACDMRL,X5 
          NG     X5,ACMN.0   JUMP, MRL NOT PRESET 
          FETCH  A0,MRL,X4         X4 = PRESET MRL
          SA3    =XC.BUFFS         BUFFER SIZE
          SX2    10 
          IX3    X3*X2             BUFFER SIZE IN CHRS
          IX2    X3-X4
          PL     X2,ACMN.2         JUMP IF MRL < BUFFER SIZE
          BX4    X3                SET MRL TO BUFFER SIZE 
          EQ     ACMN.1 
 ACMN.0   SX4    ACPTMRL     DEFAULT MRL FOR ACCEPT 
          PL     X1,ACMN.1   JUMP IF NOT CONNECTED FILE 
          SA4    SAVEPS+2    RECEIVER SIZE
          SA3    =XC.BUFFS   BUFFER SIZE
          SX2    10 
          IX3    X3*X2       BUFFER SIZE IN CHARS 
          IX2    X3-X4
          PL     X2,ACMN.1   SELECT SMALLER 
          BX4    X3          SIZE FOR FL
 ACMN.1   STORE  A0,MRL=X4
 ACMN.2   SX4    X4+9 
          SX5    1S20/10+1   1 TENTH
          IX4    X5*X4
          AX4    20          GIVES WORDS
          STORE  A0,RLWD=X4  PUT SIZE IN WORDS AWAY 
          PL     X1,NOTTERM  JUMP IF NOT CONNECTED FILE 
 OPSYS    IFC    EQ,/"OSNAME"/SCOPE / 
          FETCH  A0,NOAD,X4 
          STORE  A0,NOAD=NO 
          MI     X4,NOTTERM  JIF DISPLAYED WITH NO ADVANCING
          SA3    TRMREQ      GET QUERY THING
          BX7    X3 
          SA7    =XC.BUFF    PUT IN BUFFER AREA 
          SA2    RDLNNB      LINE NBR 
          BX6    X2 
          SA6    WRLN 
          MX4    0           NO INV KEY 
          SX3    2           OUTPUT 2 CHARS 
          SB6    NOTTERM     RETURN 
          EQ     =XC.WRISQ   WRITE QUESTION MARK
 WRLN     DATA   0           LINE NUMBER IS PUT HERE FOR DIAGS
 OPSYS    ELSE
          STORE  A0,NOAD=NO  CLEAR DISPLAYED WITH NO ADVANCING
 OPSYS    ENDIF 
 NOTTERM  BSS    0
          MX4    1           INDICATE TO TAKE AT END EXIT IF ONE FOUND
          SB6    ACCRTRD     RETURN 
          EQ     =XC.RDNSQ   READ THE STUFF 
 RDLNNB   DATA   0           LINE NUMBER IS PUT HERE FOR DIAGS
 ACCRTRD  BSS    0
          SB5    =XC.BUFF    SENDER FOR LATER MOVE
          EQ     B0,B3,NOATEN  JUMP IF NO AT-END
          FETCH  A0,CNF,X5   GET CONNECTED FLAG 
          PL     X5,ATEND    JP IF NOT A CONNECTED FILE 
*       AN AT END ON A CONNECTED FILE IS TREATED AS A READ OF ALL SPACES
          SA3    =XC.BLANK
          FETCH  A0,MRL,X5   GET MAX RECORD LENGTH
          SX5    X5+9        ROUND
          SA4    =XC.TNTH    1/10*2**24 
          BX6    X3 
          IX5    X5*X4
          AX5    24          CONVERT CHARACTERS TO WORDS
          SB2    X5-1 
 EOFLP    BSS    0
          SA6    B2+=XC.BUFF SET BUFFER TO SPACES 
          SB2    B2-B1
          PL     B2,EOFLP 
          EQ     ACCZT       CONTINUE AS IF BLANKS READ 
 ATEND    BSS    0           AT END ON NON-CONNECTED FILE DETECTED
          SA1    C.ACCMN
          AX1    30 
          SB6    X1          RETURN FOR LINE NUMBER AND USER RETURN 
          RJ     =XC.SVRTN   PUT IT ON STACK
 +        SX1    #ATENAC     ERROR - AT END DURING ACCEPT 
          RJ     =XC.FIOER
 NOATEN   BSS    0
          FETCH  A0,RT,X5    GET RECORD TYPE
          SX5    X5-#ZT#
          NZ     X5,ACMN.3   JUMP IF NOT Z RECORDS
 ACCZT    FETCH  A0,MRL,X5   USE MRL
          EQ     ACCLN
 ACMN.3   FETCH  A0,RL,X5    USE LENGTH OF REC READ 
 ACCLN    BSS    0
          SA2    SAVEPS      SAVED PARAMS 
          SA3    A2+B1
          SA4    A3+B1       REMAINING LENGTH 
          SB3    X3          FWA RECEIVER 
          SB4    X2          BCP RECEIVER 
          IX6    X4-X5       RECEIVER - REC LENGTH
          NG     X6,RECSH    JUMP IF RECEIVER SHORTER 
          BX4    X5          USE LENGTH OF RECORD 
          IX7    X4+X2
          SA7    A2          UPDATE BCP TO NEW RECEIVING PLACE
 RECSH    BSS    0
          SA6    A4          SET SIZE LEFT
          SB7    X4          SIZE TO MOVE 
          SB6    B0          BCP SENDER 
          MX2    0           APPEND NO BLANKS 
          RJ     =XC.MOVE    MOVE STUFF TO AREA 
          SA1    SAVEPS+2    GET SIZE LEFT
          SA2    CONSFLG
          PL     X2,ACCNCN2  JUMP IF NOT CONSOLE
          ZR     X1,C.ACCMN  EXIT IF DONE 
          NG     X1,C.ACCMN  EXIT IF DONE 
          EQ     ACCCONS
 ACCNCN2  BSS    0
          ZR     X1,ACCEX    EXIT IF NOTHING LEFT 
          PL     X1,ACCDORD  GO READ AGAIN IF STUFF LEFT TO FILL
 ACCEX    BSS    0
          SA2    SVRECA 
          STORE  A0,RECA=X2  RESTORE RECORD AREA PTR
          EQ     C.ACCMN     EXIT 
 ACCCONS  BSS    0           ACCEPT FROM CONSOLE PROCESS
          MX6    1
          SA6    CONSFLG     INDICATE CONSOLE 
          MESSAGE  CONREQ,,RECALL  PUT OUT OPERATOR MESSAGE 
          SA5    B0 
          SX2    50000B      SET CFO AND PAUSE BITS (14 AND 12) 
          BX7    X2+X5
          SA7    A5          PUT IN RA+0
 RCLLP    BSS    0
          RECALL             WAIT A WHILE 
          SA5    B0          RA+0 
          BX5    X2*X5       X2 HAS PAUSE BIT 
          NZ     X5,RCLLP    WAIT FOR BIT TO CLEAR
          SB2    70B         FWA OF MESSAGE FROM OPERATOR 
          SB5    B2          FWA FOR MOVE 
          SX5    CONSLL      MAX NUMBER OF CHAR TYPED FROM CONSOL 
          SB3    73B         LWA OF TYPED STUFF 
          MX4    54 
 FZBLP1   BSS    0           FIND TERMINATING ZERO BYTE 
          SB7    10 
          SA2    B2          GET A WORD OF DATA 
          SB2    B2+B1
 FZBLP2   BSS    0
          LX2    6
          BX3    -X4*X2 
          ZR     X3,FZBFND   JUMP IF ONE FOUND
          SB7    B7-B1
          NZ     B7,FZBLP2
          GT     B2,B3,ACCLN  MOVE IT IF NO TRAILING ZB 
          EQ     FZBLP1      TRY ANOTHER WORD 
 FZBFND   BSS    0
          SX4    55B         BLANK
          BX2    X2+X4       PUT IT IN TO REPLACE ZB
          LX2    6
          SB7    B7-B1
          NZ     B7,FZBFND   FILL NEXT ONE IF WORD NOT DONE 
          LX2    54          RE-POSITION
          BX7    X2 
          SA7    A2          PUT IT IN
          SA1    =XC.BLANK   WORD OF SPACES 
          BX6    X1 
 FZBLP3   BSS    0
          GT     B2,B3,ACCLN DO MOVE IF LAST WORD DONE
          SA6    B2          SET   REMAINING WORDS TO SPACES
          SB2    B2+B1
          EQ     FZBLP3 
 SAVEPS   BSS    3
 OPSYS    IFC    EQ,/"OSNAME"/SCOPE / 
 CONREQ   DIS    ,* TYPE J.CFO + COBOL INPUT* 
 TRMREQ   VFD    12/5571B,48/0   QUESTION MARK PREC BY SPACE
 OPSYS    ELSE
 CONREQ   DIS    ,*TYPE N.CFO + COBOL INPUT*
 OPSYS    ENDIF 
 TAF      ELSE
          ENTRY  C.ACCMN
          ENTRY  C.ACMD 
          EXT    C.NOAD 
          SYSCOM B1 
*COMMENT  TAF/COBOL ACCEPT DATA-NAME PROCESSOR. 
          COMMENT  COPYRIGHT CONTROL DATA CORP.  78/06/30.
          TITLE  CBACCMN - TAF/COBOL ACCEPT DATA-NAME PROCESSOR.
          SPACE  4
*****     CBACCMN - TAF/COBOL ACCEPT DATA-NAME PROCESSOR. 
* 
*         W. E. MARTIN       78/06/30.
          SPACE  4
***       CBACCMN - TAF/COBOL ACCEPT DATA-NAME PROCESSOR. 
* 
*         THIS ROUTINE IS ENTERED VIA A USER SOURCE LINE WHICH
*         HAS DECLARED A MNEMONIC IN A *SPECIAL-NAMES* CLAUSE AND 
*         THEN EXECUTES AN *ACCEPT DATA-NAME FROM MNEMONIC*.  IN THE
*         TRANSACTION ENVIRONMENT, ONLY THE *TTY* TYPE MNEMONIC WILL
*         BE SUPPORTED.  THE TRANSACTION TERMINAL READ REQUESTS WILL
*         BE ISSUED INSTEAD OF THE NORMAL *CRM/CIO* REQUESTS. 
* 
* 
*         ENTRY  (B5) = FWA OF DATA-NAME. 
*                (B6) = CHARACTER OFFSET. 
*                (B7) = SIZE OF FIELD.
*                (X1) = MNEMONIC NAME.
* 
*         EXIT   (DATA-NAME) UPDATED WITH TERMINAL INPUT. 
*                (DATA-NAME) SPACED FILLED - IF CARRIAGE RETURN 
*                (CR) ENTERED AT TERMINAL.
*                (ACMG) UPDATED TO REFLECT ACTIVE TELE-PROCESSOR. 
          SPACE  4
*         ASSEMBLY CONSTANTS ( FROM COMKMAC ).
*         IF VALUES IN COMKMAC CHANGE THEY MUST CHANGE HERE ALSO. 
  
  
 COMCL    EQU    69 
 BUFFS    EQU    57*10       BUFFER AREA SIZE IN CHARS
          SPACE  4
          VFD    42/0LC.ACCMN,18/C.ACCMN
  
 ACM8     SA1    ACMA        RESTORE (A0) 
          SA0    X1+
  
 C.ACCMN  PS                 ENTRY/EXIT 
  
*         SAVE PASSED PARAMETERS. 
  
          SX6    A0+         SAVE (A0)
          SB1    1
          SA6    ACMA 
          SX6    B6 
          SX7    B5 
          SA6    ACMB 
          SA7    A6+B1
          SX6    B7 
          SA6    A7+1 
          SA1    ACMG        READ *TPSTATUS* FLAG 
          PL     X1,ACM0     IF *TPSTATUS* CALL ALREADY MADE
  
*         DETERMINE WHICH TELE-PROCESSOR IS ACTIVE. 
  
          SYSTEM CTI,R,ACMG,20  *TPSTATUS* REQUEST
          SA1    ACMG        READ RETURNED VALUE
 ACM0     SA2    C.NOAD      READ PRIOR GLOBAL *NO-ADVANCE* FLAG
          ZR     X2,ACM1     IF NO PRIOR *NO-ADVANCE* 
          SX6    B0+
          SA6    A2 
          EQ     ACM3A       DO NOT PROMPT AFTER *NO-ADVANCE* 
 ACM1     SX6    X1-1        (1) = NAMTP
          ZR     X6,ACM2     IF IN *NAM* MODE 
          SA0    ACME        (A0) = FWA OF *TELEX* TERMINAL PROMPT
          EQ     ACM3        ISSUE *SEND* 
  
 ACM2     SA0    ACMC        (A0) = FWA OF *NAM* PROMPT REQUEST 
  
*         SEND TERMINAL PROMPT AND THEN READ TERMINAL.
  
 ACM3     SYSTEM CTI,R,A0,0B  PROMPT TERMINAL WITH QUESTION MARK
 ACM3A    SYSTEM SCT,R,C.ACMD,9    *BWAITINP* REQUEST 
          SA5    C.ACMD+1    READ TERMINAL WORD COUNT 
          MX3    -12
          BX5    -X3*X5      MASK OUT WORD COUNT FROM LOWER 12 BITS 
          NZ     X5,ACM4     JUMP IF NON-ZERO WORD COUNT
          SA3    =XC.BLANK
          BX6    X3 
          SA6    C.ACMD+2    BLANK OUT FIRST WORD OF BUFFER 
          SX5    B1          SO TO MOVE BLANKS TO RECEIVER
          EQ     ACM5 
  
  
*         CLEAR REAL-TIME CLOCK WORD IN COMMUNICATION BLOCK 
*         MOVE TERMINAL DATA TO USER DATA-NAME
*         IF DATA-NAME SIZE LESS THAN OR EQUAL TO RECEIVED DATA SIZE
*         THEN MOVE RECEIVED DATA TO DATA-NAME (TRUNCATE OFF RIGHTMOST) 
*         ELSE IF DATA-NAME SIZE LESS THAN OR EQUAL TO BUFFER SIZE
*              THEN MOVE RECEIVED DATA TO DATA-NAME, SPACE FILL ON RIGHT
*              ELSE MOVE RECEIVED DATA TO DATA-NAME, SPACE FILL ON
*                   RIGHT ONLY UNTIL BUFFER SIZE NUMBER OF CHARS HAVE 
*                   BEEN MOVED TO DATA-NAME, AND GO READ MORE DATA. 
*              END-IF.
*         END-IF. 
*         EXIT. 
  
  
 ACM4     SA1    C.ACMD+1+X5 READ LAST WORD TRANSFERED
          RJ     =XSFN=      SPACE FILL NAME
          SA6    A1 
 ACM5     MX6    0
          SA6    C.ACMD+COMCL-1 
          SX6    10 
          IX5    X5*X6       NUMBER OF CHARS READ 
          SA2    ACMB        RESTORE PASSED PARAMETERS
          SA3    A2+B1
          SA4    A3+B1       (X4) = REMAINING LENGTH
          SB3    X3          (B3) = FWA OF RECEIVING BUFFER 
          SB4    X2          (B4) = BCP OF RECEIVER 
          MX2    0           NO BLANK PADDING 
          IX6    X4-X5       RECEIVER - RECEIVED DATA LENGTH
          NG     X6,ACM7     JUMP IF RECEIVER SHORTER 
          SX1    BUFFS
          SX7    B4+X1
          SA7    A2          UPDATE BCP TO NEW RECEIVING PLACE
          IX2    X4-X1       RECEIVER - BUFFER LENGTH 
          SX4    X5          NO. OF CHARS TO MOVE TO RECEIVER 
          NG     X2,ACM6     BUFFER LARGER THAN RECEIVER, JUMP
          IX2    X5-X1       NUMBER OF BLANKS TO PAD
          IX6    X6-X1       (RECEIVER - RECD DATA LEN) - PADDED SPACES 
          EQ     ACM7 
 ACM6     BX2    -X6         NUMBER OF BLANKS TO PAD
          SX6    B0 
 ACM7     SA6    A4          SET SIZE LEFT OF RECEIVER TO FILL
          SB7    X4          (B7) = SIZE TO MOVE
          SB5    C.ACMD+2    (B5) = FWA OF SENDER 
          SB6    B0          (B6) = BCP OF SENDER 
          RJ     =XC.MOVE    MOVE INPUT TO DATA-NAME
          SA1    ACMB+2      GET SIZE LEFT
          ZR     X1,ACM8     RESTORE (A0) AND RETURN IF NOTHING LEFT
          NG     X1,ACM8     RESTORE (A0) AND RETURN IF NOTHING LEFT
          MX2    0
          SA1    ACMG        *TPSTATUS* FLAG
          EQ     ACM1        GO REQUEST MORE INPUT IF STUFF LEFT TO FILL
          SPACE  4
*         PROGRAM STORAGE FOR TEMPORARIES AND NETWORK ABH-S.
  
  
 ACMA     CON    0           STORAGE FOR (A0) 
 ACMB     BSS    1           STORAGE FOR (B6) - CHARACTER OFFSET
          BSS    1           STORAGE FOR (B5) - FWA OF DATA-NAME
          BSS    1           STORAGE FOR (B7) - SIZE OF FIELD 
 ACMC     VFD    1/0,1/0,1/0,1/0,1/0,1/1,6/0,18/ACMCC,12/0,18/ACMCCL
          CON    0           STORAGE FOR *SEND* TERMINAL NAME 
          VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/0,3/0,12/ACMCCL*10 
          CON    0           STORAGE FOR *SEND* STATUS
 ACMCC    VFD    18/3H.? ,42/0  TERMINAL PROMPT 
 ACMCCL   EQU    *-ACMCC     LENGTH OF PROMPT 
 C.ACMD   BSS    COMCL       STORAGE FOR TERMINAL I/O 
 ACME     VFD    1/0,1/0,1/0,1/0,1/0,1/1,6/0,18/ACMF,12/0,18/ACMFL
          BSSZ   3           STORAGE FOR REMAINING *SEND* HEADER
 ACMF     VFD    12/2L? ,12/0014B,36/0  STORAGE FOR *TELEX*  PROMPT 
 ACMFL    EQU    *-ACMF      LENGTH OF PROMPT 
 ACMG     CON    -1          STORAGE FOR ACTIVE TELE-PROCESSOR FLAG 
          SPACE  4
 TAF      ENDIF 
          END 
