*COMDECK TRAPCOM
          TITLE  COMMON I/O CONSTANTS AND MACROS
**        ** DEBUG AIDS COMMON DECK 
          SPACE  2
**        *IPARAMS* IS CALLED TO OBTAIN *OS.NAME*.
          SPACE  4
          IPARAMS 
          SPACE  4
**        MACROS *IFSCOPE* AND *IFNOS* ARE DEFINED. 
          SPACE  4
**        IFSCOPE - ASSEMBLE IF SCOPE OPERATING SYSTEM. 
* 
* TAG     IFSCOPE  COUNT
* 
*         ENTRY  COUNT = LINE COUNT IF PRESENT
*                TAG   = OPTIONAL TAG 
  
          MACRO  IFSCOPE,A,B
IFMIC     MICRO  1,,**
          IFC    NE,*B**,1
IFMIC     MICRO  1,,*,B+1*
          IFC    EQ,*SCOPE *"OS.NAME"*"IFMIC" 
          ENDM
          SPACE  4
**        IFNOS - ASSEMBLE IF NOT SCOPE OPERATING SYSTEM. 
* 
*         SAME FORMAT AS *IFSCOPE* MACRO. 
  
          MACRO  IFNOS,A,B
IFMIC     MICRO  1,,**
          IFC    NE,*B**,1
IFMIC     MICRO  1,,*,B+1*
          IFC    NE,*SCOPE *"OS.NAME"*"IFMIC" 
          ENDM
          SPACE  4
K         IFNOS 
**        IF NOT SCOPE THEN THE MACROS *SETLC* AND *GETLC* ARE DEFINED. 
          SPACE  4
**        SETLC - SET LOADER CONTROL WORD, KRONOS/NOS FORMAT. 
*               - COPY OF *SETLC* AS IN *COMCMAC*.
* 
*         SETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS OF NEW LOADER CONTROL WORD.
* 
*         CALLS  CPM= 
  
          PURGMAC  SETLC
  
SETLC     MACRO  ADR
          SX1    ADR
          SX2    22B
          RJ   =XCPM= 
          ENDM
          SPACE  4
**        GETLC - GET LOADER CONTROL WORD, KRONOS/NOS FORMAT. 
*               - COPY OF *GETLC* AS IN *COMCMAC*.
* 
*         GETLC  ADR
* 
*         ENTRY  *ADR* = ADDRESS FOR RESPONSE.
* 
*         CALLS  CPM= 
  
          PURGMAC  GETLC
  
GETLC     MACRO  ADR
          SX1    ADR
          SX2    45B
          RJ   =XCPM= 
          ENDM
          SPACE  4
**        BIT AND BYTE DEFINITIONS ASSOCIATED WITH *GETLC* AND *SETLC*. 
          SPACE  4
C.CPLT    EQU    0                 DEBUG BYTE IN LOADER CONTROL WORD
S.CPLT    EQU    4                 DEBUG BIT IN LOADER CONTROL WORD 
          SPACE  4
K         ENDIF 
****      **** I/O CONSTANTS AND ASSEMBLY OPTIONS ****
  
CODED     EQU    0
BINARY    EQU    2
READ      EQU    10B
WRITE     EQU    14B
WRITER    EQU    24B
REWINDER  EQU    50B
 RETURN   EQU    174B 
  
LINELIM   EQU    60                NUMBER OF LINES PER PAGE FOR OUTPUT
  
  
**        **** COMMUNICATIONS AREA **** 
* 
 RA.CMU   CEQU   65B
 RA.LWP   CEQU   65B         CMM *DABA* POINTER 
****
          SPACE  4
**        **** I/O MACROS ****
          SPACE  2
**        CIOCALL -- ISSUE CIO FUNCTION 
* 
*         CIOCALL  FET,RCL,FUNC 
*         ENTRY  *FET*  = FET ADDRESS 
*                *RCL*  = AUTO-RECALL INDICATOR 
*                *FUNC* = CIO FUNCTION
          SPACE  2
          PURGMAC CIOCALL 
CIOCALL   MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    EQ,**B*,1
          SX7    C
          IFC    NE,**B*,1
          SX7    -C 
          RJ   CIO
          ENDM
          SPACE  4
**        READ -- READ FILE 
* 
*         READ   FET,RCL
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
          SPACE  2
          PURGMAC  READ 
READ      MACRO  A,B
          CIOCALL  A,B,READ 
          ENDM
          SPACE  3
**        RETURN - RETURN FILE
* 
*         RETURN FET,RCL
* 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-CALL INDICATOR
  
          PURGMAC RETURN
 RETURN   MACRO  A,B
          CIOCALL A,B,RETURN
 RETURN   ENDM
          SPACE  4
**        MESSAGE -- ISSUE DAYFILE MESSAGE
* 
*         MESSAGE  ADR,RCL
*         ENTRY  *ADR* = MESSAGE ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
          SPACE  2
          PURGMAC  MESSAGE
MESSAGE   MACRO  A,B
          IFC    NE,#X1#_A_#,1
          SX1    A
          IFC    EQ,**B*,1
          MX6    0
          IFC    NE,**B*,1
          SX6    200000B
          RJ   MSG
          ENDM
          SPACE  4
**        READW -- READ WORDS FROM CIRCULAR BUFFER TO A WORKING BUFFER
* 
*         READW  FET,FWA,WORDS
*         ENTRY  *FET*   = FET ADDRESS
*                *FWA*   = FWA OF WORKING BUFFER
*                *WORDS* = WORD COUNT OF THE WORKING BUFFER 
          SPACE  2
          PURGMAC READW 
READW     MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          SB7    C
          RJ   RDW
          ENDM
          SPACE  4
**        WRITER - ISSUE END-RECORD WRITE 
* 
*         WRITER  FET,RCL 
*         ENTRY  *FET* = FET ADDRESS
*                *RCL* = AUTO-RECALL INDICATOR
          SPACE  2
          PURGMAC  WRITER 
WRITER    MACRO  A,B
          CIOCALL A,B,WRITER
          ENDM
          SPACE  4
**        WRITEC - MOVE A LINE IMAGE (-C- FORMAT) FROM
*                  WORKING BUFFER TO A CIRCULAR BUFFER
* 
*         WRITEC  FET,FWA 
*         ENTRY  *FET* = FET ADDRESS
*                *FWA* = FWA OF WORKING BUFFER
          SPACE  2
          PURGMAC  WRITEC 
WRITEC    MACRO  A,B
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          RJ   WTC
          ENDM
          SPACE  4
**        RECALL - WAIT NOT BUSY
* 
*         RECALL  FET 
*         ENTRY  *FET* = FET ADDRESS (IF ABSENT, ISSUE SINGLE RECALL) 
          SPACE  2
          PURGMAC  RECALL 
RECALL    MACRO  A
          IFC    EQ,*A**,1
          RJ   RCL
          IFC    NE,*A**,3
          IFC    NE, X2 A ,1
          SX2    A
          RJ   WNB
          ENDM
          SPACE  4
**        CLOCK - GET THE CURRENT SYSTEM CLOCK READING. 
* 
*         CLOCK  ADR
*         ENTRY  *ADR* = ADDRESS TO STORE TIME. 
          SPACE  2
          PURGMAC  CLOCK
CLOCK     MACRO  A
          SX6    3RTIM
          SX1    A
          LX6    42 
          BX6    X1+X6
          SX1    200002B
          LX1    24 
          BX6    X1+X6
          RJ   SYS
          ENDM
          SPACE  4
**        DATE - GET DATE.
* 
*         DATE   ADR
*         ENTRY  *ADR* = ADDRESS TO STORE DATE. 
          SPACE  2
          PURGMAC  DATE 
DATE      MACRO  A
          SX6    3RTIM
          SX1    A
          LX6    42 
          BX6    X1+X6
          SX1    200001B
          LX1    24 
          BX6    X1+X6
          RJ   SYS
          ENDM
          SPACE  3
**        MOVE - MOVE DATA BLOCK
* 
*         MOVE   COUNT,FROM,TO
* 
*         ENTRY  *COUNT* = WORD COUNT OF BLOCK TO BE MOVED
*                *FROM*  = FWA OF BLOCK 
*                *TO*    = FWA OF DESTINATION 
* 
*         USE    X - 1, 2, 3
*                A - NONE 
*                B - 1
* 
*         CALLS  MVE=  (COMCMVE)
  
          PURGMAC MOVE
 MOVE     MACRO  C,F,T
          R=     X1,C 
          R=     X2,F 
          R=     X3,T 
          IF     -DEF,B1=1,1
          SB1    1
          RJ     =XMVE= 
 MOVE     ENDM
          SPACE  4
          TITLE  COMMON I/O ROUTINES
**        **** I/O ROUTINES ****
          SPACE  2
**        CDD - CONSTANT TO DECIMAL CONVERSION. 
*         G. R. MANSFIELD, 11/13/69.
*         ADAPTED FROM SUBROUTINE *CONDEC* IN *COMPASS VER 2.0*.
* 
*         CDD CONVERTS UP TO 10 DIGITS TO DISPLAY CODE WITH LEADING ZERO
*         SUPPRESSION.  CONVERSION CONTAINS SPACE FILL AND IS RIGHT 
*         JUSTIFIED.
*         ENTRY  (X1) = NUMBER TO BE CONVERTED. 
*                (B1) = 1.
*         EXIT   (X6) = DPC CONVERSION. 
*                (B2) = 6*COUNT OF DIGITS IN (X6).
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 2, 3, 4. 
*         CALLS  NONE.
          SPACE  2
CDD1      DX6    X1*X2             COMPUTE QUOTIENT 
          FX1    X1*X2
          SB5    X1                SET NEXT DIGIT 
          LX4    60-6              SHIFT ASSEMBLY 
          SB2    B2+B4
          FX6    X6*X3             EXTRACT REMAINDER DIGIT
          SX7    X6+B3             CONVERT DIGIT
          IX4    X7+X4
          NZ   B5,CDD1             LOOP TO ZERO DIGIT 
          LX4    60-6              RIGHT JUSTIFY ASSEMBLY 
          LX6    X4,B2
CDD       PS                       ENTRY/EXIT 
          SA2    CDDA              =.1P48+1 
          SA3    A2+B1             =10.P
          PX1    X1 
          SB2    B0                CLEAR JUSTIFY COUNT
          SA4    A3+B1             =1H
          SB3    1R0-1R            (B3) = CONVERSION COUNT
          SB4    6                 (B4) = SHIFT INCREMENT 
          EQ   CDD1 
          SPACE  1
CDDA      CON    0.1P48+1 
CDDB      CON    10.P 
CDDC      DATA   1H 
          SPACE  4
**        CIO - I/O FUNCTION PROCESSOR. 
*         G. R. MANSFIELD, 12/08/69.
* 
*         CIO PERFORMS I/O FUNCTIONS VIA THE PP PROGRAM *CIO*.
*         OPERATION WILL BE PROCESSED WHEN THE BUFFER IS NOT BUSY.
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (X7) = FUNCTION CODE.
*                (B1) = 1.
*                IF (X7) < 0, (X7) IS THE COMPLEMENT OF THE 
*                REQUEST AND AUTO RECALL WILL BE REQUESTED. 
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 6, 7.
*                B - NONE.
*                A - 1, 7.
*         CALLS  SYS, WNB.
          SPACE  2
CIO3      LX6    42                PROCESS REQUEST
          IX6    X6+X2
          RJ   SYS
          SPACE  1
CIO       PS                       ENTRY/EXIT 
          SA1    X2                CHECK BUFFER STATUS
          LX1    59 
          NG   X1,CIO1             IF BUFFER NOT BUSY 
          ZR   X1,CIO1             IF ZERO FILE STATUS
          RECALL  X2
CIO1      PL   X7,CIO2             IF NO AUTO RECALL
          SX1    B1                 SET AUTO RECALL BIT 
          BX7    -X7
          LX1    40 
          NO
          IX2    X1+X2
CIO2      MX6    42                MASK FILE NAME AND MODE
          SX1    B1+B1
          BX6    X6+X1
          SA1    X2 
          BX6    X6*X1
          SA7    CIOB              SAVE FUNCTION CODE 
          BX7    X6+X7             STORE BUFFER STATUS
          SA7    X2 
          SA1    CIOA              GET PP CALL WORD 
          BX6    X1 
          EQ   CIO3 
          SPACE  1
CIOA      VFD    42/0,18/3RCIO
CIOB      DATA   0                 LAST FUNCTION CODE ISSUED
          SPACE  4
**        SYS - PROCESS SYSTEM REQUEST. 
* 
*         ENTRY (X6) = SYSTEM REQUEST.
*         EXIT   REQUEST PROCESSED. 
*         USES   X - 1. 
*                B - NONE.
*                A - 1, 6.
*         CALLS  NONE.
          SPACE  2
SYS1      SA1    A1 
          LX1    59-40
          NG   X1,* 
SYS       PS                       ENTRY/EXIT 
+         SA1    B1 
          NZ   X1,* 
          SA6    A1 
          EQ   SYS1 
          SPACE  4
**        WNB - WAIT NOT BUSY.
* 
*         WAIT FOR FET STATUS WORD BIT ZERO TO BE SET.
*         IF WORD IS INITIALLY ZERO, RETURN.
* 
*         ENTRY  (X2) = ADDRESS OF STATUS WORD. 
*         EXIT   RETURN WHEN BIT 0 OF STATUS WORD IS SET. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
*         CALLS  SYS. 
          SPACE  2
WNB2      LX1    40 
          IX6    X6+X1
          RJ   SYS
WNB       PS                       ENTRY/EXIT 
          SX6    3RRCL
          LX6    42 
          IX6    X6+X2
WNB1      SA1    X6                CHECK STATUS WORD
          LX1    59 
          NG   X1,WNB              RETURN IF STATUS BIT SET 
          ZR   X1,WNB              RETURN IF BLANK STATUS 
          SA1    B1                WAIT (RA+1) CLEAR
          NZ   X1,WNB1
          SX1    A1                CONTINUE RECALL
          EQ   WNB2 
          SPACE  4
**        RCL - PLACE PROGRAM ON RECALL.                                      :]
*         EXIT   REQUEST PROCESSED. 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
*         CALLS  SYS. 
          SPACE  2
RCL1      LX6    42                PROCESS REQUEST
          RJ   SYS
+         SA1    B1                WAIT (RA+1) CLEAR
          NZ   X1,* 
RCL       PS                       ENTRY/EXIT 
          SA1    B1 
          NZ   X1,RCL              RETURN IF (RA+1) NOT CLEAR 
          SX6    3RRCL             FORM RECALL REQUEST
          EQ   RCL1 
          SPACE  4
**        MSG - SEND MESSAGE. 
* 
*         ENTRY  (X1) = ADDRESS OF MESSAGE. 
*                (X6) = MESSAGE OPTION(S).
*                       BIT 16 = AUTO RECALL. 
*         EXIT   RETURN WHEN OPERATION COMPLETE.
*         USES   X - 1, 6.
*                B - NONE.
*                A - 6. 
*         CALLS  SYS. 
          SPACE  2
MSG1      SX6    3RMSG*2           FORM MSG REQUEST 
          BX6    X6+X1
          LX6    41 
          RJ   SYS                 PROCESS REQUEST
MSG       PS                       ENTRY/EXIT 
          LX6    24                MERGE OPTIONS AND ADDRESS
          BX1    X6+X1
          SX6    X1 
          LX1    19 
          PL   X1,MSG1             IF NO AUTO RECALL
          LX1    41                REMOVE ADDRESS 
          BX1    X1-X6
          LX6    30                SET INDIRECT ADDRESS 
          SA6    MSGA 
          SX6    A6 
          BX1    X1+X6
          LX1    19 
          EQ   MSG1 
          SPACE  1
MSGA      CON    0
          SPACE  4
**        RDW - READ WORDS TO WORKING BUFFER. 
*         G. R. MANSFIELD, 12/08/69.
*         MODIFIED BY P. M. OVERELL, 4/22/71. 
* 
*         RDW READS A GIVEN NUMBER OF WORDS FROM A
*         CIO BUFFER TO A WORKING BUFFER. 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B1) = 1.
*                (B6) = FWA OF WORKING BUFFER.
*                (B7) = WORD COUNT OF THE WORKING BUFFER. 
*         EXIT   (X1) = 0 FOR TRANSFER COMPLETE.
*                (X1) = -1 IF EOF DETECTED ON FILE. 
*                (X1) = ADDRESS OF LAST WORD TRANSFERRED INTO 
*                       WORKING BUFFER IF EOR DETECTED ON FILE
*                       BEFORE TRANSFER WAS COMPLETED.
*                (B6) = ADDRESS OF LAST WORD TRANSFERRED
*                       TO WORKING BUFFER.
*                (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  RDX, LCB.
          SPACE  2
          EQ   RDW1 
  
RDW       PS                       ENTRY/EXIT 
          SA4    RDW               SET RETURN ADDRESS 
          SA1    X2+4             (B5) = LIMIT
          SA3    X2+B1             (X3) = FIRST 
          SB7    B6+B7             (B7) = LWA+1 WORKING BUFFER
          SB5    X1 
          SPACE  1
**        INITIALIZE REGISTERS FOR TRANSFER.
          SPACE  1
RDW1      SA1    A3+B1             (B3) = IN
          SA2    A1+B1             (B4) = OUT 
          SB3    X1 
          SB4    X2 
          SPACE  1
**        TRANSFER DATA FROM CIRCULAR BUFFER TO WORKING BUFFER. 
          SPACE  1
RDW2      EQ   B4,B3,LCB           LOAD CIRCULAR BUFFER IF OUT = IN 
          SA1    B4                READ WORD
          BX6    X1 
          SB4    B4+B1             (OUT+1)
          NE   B4,B5,RDW3          IF (OUT+1) " LIMIT 
          SB4    X3                (OUT+1) = FIRST
RDW3      SA6    B6                STORE WORD 
          SB6    B6+B1             ADVANCE WORKING BUFFER 
          NE   B6,B7,RDW2          LOOP TO FILL WORKING BUFFER
*         EQ   RDX
          SPACE  4
**        RDX - READ EXIT.
* 
*         EXIT FROM READ SUBROUTINE TO THE CALLER.
*         IF CIRCULAR BUFFER IS BUSY, OR EOR/EOF
*         IS SENSED, NO ACTION IS TAKEN.
*         OTHERWISE, THE WORD COUNT REMAINING IN THE BUFFER 
*         IS CHECKED AND A READ FUNCTION ISSUED IF NECESSARY. 
* 
*         ENTRY  (A2) = ADDRESS OF OUT. 
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (X3) = FIRST.
*                (B1) = 1.
*                (B3) = IN. 
*                (B4) = OUT.
*                (B5) = LIMIT.
*         EXIT   TO RETURN ADDRESS. 
*         CALLS  CIO. 
          SPACE  2
RDX       SA1    A3-B1             CHECK BUFFER STATUS. 
          SX6    B4                STORE OUT
          LX1    59 
          SA6    A2 
          SX2    A3-B1             RESET (X2) 
          PL   X1,RDX1             IF BUFFER BUSY 
          LX1    -4 
          NG   X1,RDX1             IF EOR/EOF SET 
          SPACE  1
**        IF BUFFER IS NOT BUSY, CHECK BUFFER SIZE. 
*         ISSUE READ IF BUFFER THRESHOLD IS REACHED.
          SPACE  1
          SX6    B3-B4             (IN-OUT) 
          SB2    X3                (LIMIT-FIRST)
          LX3    X6,B1             2*(IN-OUT) 
          SX7    B5-B2
          AX6    60                SIGN OF (IN-OUT) 
          BX4    X6-X7             INVERT BUFFER IF OUT \ IN
          IX6    X4-X3             BUFFER SIZE - 2*(IN-OUT) 
          NG   X6,RDX1             IF BUFFER THRESHOLD NOT REACHED. 
          SA1    CIOB              ISSUE PREVIOUS READ FUNCTION 
          BX7 X1
          RJ   CIO
RDX1      SX1    B0                RESPONSE = 0 
          SB2    A4                SET RETURN ADDRESS 
          JP   B2 
          BSS    0
          SPACE  4
**        LCB - LOAD CIRCULAR BUFFER. 
* 
*         REQUEST READ IF BUFFER IS EMPTY, NOT BUSY, AND
*         NOT EOR/EOF.  IF BUFFER IS BUSY, RECALL AND RETURN. 
* 
*         ENTRY  (A2) = ADDRESS OF OUT. 
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (B1) = 1.
*                (B4) = OUT.
*         EXIT   TO RETURN ADDRESS-1 IF CONTINUATION READ.
*                TO RETURN ADDRESS IF EOR/EOF.
*                (X1) = LAST WORD ADDRESS OF WORKING BUFFER.
*                (X1) = -1 IF EOF.
*         CALLS  CIO, RCL.
          SPACE  2
LCB       SA1    A3-B1             CHECK BUFFER STATUS
          SX6    B4                STORE OUT. 
          LX1    59 
          SA6    A2 
          NG   X1,LCB2             IF BUFFER NOT BUSY 
          RECALL
LCB1      SB2    A4-B1
          JP   B2 
          BSS    0
          SPACE  1
LCB2      SA1    A2-B1             RE-READ IN 
          SB3    X1 
          NE   B3,B4,LCB1          IF BUFFER NOT EMPTY
          SA1    A3-B1             CHECK BUFFER STATUS
          LX1    59-4 
          NG   X1,LCB3             IF EOR SET 
          SA1    CIOB              ISSUE PREVIOUS READ FUNCTION 
          SX2    A3-B1
          BX7    X1 
          RJ   CIO
          SB2    A4-B1             CONTINUE READ
          JP   B2 
          BSS    0
          SPACE  1
LCB3      LX6    X1,B1
          SA1    A3                SET IN = OUT = FIRST 
          SX7    X1 
          SA7    A1+B1
          SX1    B6                RESPONSE = LAST WORD ADDRESS 
          PL   X6,LCB4             IF NOT EOF 
          SX1    -B1               RESPONSE = -1
LCB4      SB2    A4                SET RETURN ADDRESS 
          SX2    A3-B1             RESET (X2) 
          SA7    A7+B1
          JP   B2 
          BSS    0
          SPACE  4
**        WTC - WRITE CODED LINE , -C- FORMAT.
*         G. R. MANSFIELD, 12/08/69.
* 
*         WTC TRANSFERS ONE CODED LINE IN -C- FORMAT
*         FROM A WORKING BUFFER TO A CIRCULAR BUFFER. 
* 
*         ENTRY  (X2) = ADDRESS OF FET FOR FILE.
*                (B1) = 1.
*                (B6) = FWA OF WORKING BUFFER.
*         EXIT   (X2) = ADDRESS OF FET FOR FILE.
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*         CALLS  DCB, WTX.
          SPACE  2
          EQ   WTC1 
  
WTC       PS                       ENTRY/EXIT 
          SA4    WTC               SAVE RETURN ADDRESS
          SA1    X2+4              (B5) = LIMIT 
          SA3    X2+B1             (X3) = FIRST 
          MX4    -12               (X4) = BYTE MASK 
          SB5    X1 
          SPACE  1
**        INITIALIZE REGISTERS FOR TRANSFER.
          SPACE  1
WTC1      SA1    A3+2              (B4) = OUT 
          SA2    A3+B1             (X2) = IN                             LDR0207
          SB4    X1 
          SPACE  1
**        TRANSFER DATA FROM WORKING BUFFER TO CIRCULAR BUFFER. 
          SPACE  1
WTC2      SB3    X2+B1             (IN+1) 
          NE   B3,B5,WTC3          IF (IN+1) " LIMIT
          SB3    X3                (IN+1) = FIRST 
WTC3      SA1    B6                NEXT WORD
          EQ   B3,B4,DCB           DUMP CIRCULAR BUFFER IF (IN+1) = OUT 
          LX6    X1 
          SB6    B6+B1             ADVANCE WORKING BUFFER 
          BX7    -X4*X1 
          SA6    X2                STORE WORD 
          SX2    B3                IN = IN + 1
          NZ   X7,WTC2             LOOP TO END OF LINE
*         EQ   WTX                 EXIT 
          SPACE  4
**        WTX - WRITE EXIT. 
* 
*         IF BUFFER IS BUSY, RETURN.
*         OTHER WISE, WORD COUNT OF BUFFER IS CHECKED, AND
*         A WRITE FUNCTION IS REQUESTED IF NECESSARY. 
* 
*         ENTRY  (A2) = ADDRESS OF IN.
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (B1) = 1.
*                (B3) = IN + 1. 
*                (B4) = OUT.
*                (B5) = LIMIT.
*                (X2) = IN. 
*         EXIT   TO RETURN ADDRESS
*         CALLS  CIO. 
          SPACE  2
WTX       SA1    A3-B1             CHECK BUFFER STATUS
          SX6    X2                STORE IN 
          LX1    59 
          SA6    A2 
          PL   X1,WTX1             IF BUFFER BUSY 
          SPACE  1
**        IF BUFFER IS NOT BUSY, CHECK SIZE OF BUFFER.
*         ISSUE WRITE IF THRESHOLD IS REACHED.
          SPACE  1
          SA3    A3                FIRST
          SX6    B4-B3             (OUT - IN+1) 
          SB2    X3                (LIMIT - FIRST)
          LX3    X6,B1             2*(OUT - IN+1) 
          SX7    B5-B2
          AX6    60                SIGN OF (OUT - IN+1) 
          BX4    X6-X7             INVERT BUFFER IF IN+1 \ OUT
          IX6    X4-X3             BUFFER SIZE - 2*(OUT - IN + 1) 
          NG   X6,WTX1             IF BUFFER THRESHOLD NOT REACHED
          SX2    A3-B1             ISSUE WRITE
          SX7    WRITE
          RJ   CIO
WTX1      SB2    A4                SET RETURN ADDRESS 
          SX2    A3-B1             RESET (X2) 
          JP   B2                  RETURN 
          BSS    0
          SPACE  4
**        DCB - DUMP CIRCULAR BUFFER. 
* 
*         IF BUFFER IS BUSY, RECALL AND RETURN. 
*         IF BUFFER IS NOT BUSY, REQUEST WRITE FUNCTION AND RETURN. 
* 
*         ENTRY  (A2) = ADDRESS OF IN.
*                (A3) = ADDRESS OF FIRST. 
*                (A4) = RETURN ADDRESS. 
*                (B1) = 1.
*                (X2) = IN. 
*         EXIT   TO RETURN ADDRESS-1. 
*         CALLS  CIO, RCL.
          SPACE  2
DCB       SA1    A3-B1             CHECK BUFFER STATUS
          SX6    X2                STORE IN 
          LX1    59 
          SA6    A2 
          NG   X1,DCB1             IF NOT BUSY
          ZR   X1,DCB1             IF BLANK FET 
          RECALL
          SB2    A4-B1             CONTINUE WRITE 
          JP   B2 
          BSS    0
          SPACE  1
DCB1      SX2    A3-B1
          SX7    WRITE
          RJ   CIO
          SB2    A4-B1             CONTINUE WRITE 
          JP   B2 
          BSS    0
          SPACE  4
K         IFNOS 
**        IF NOT SCOPE THEN THE ROUTINE *CPM=* IS NEEDED. 
          SPACE  4
**        CPM -  CALLS *CPM* TO PERFORM TASKS INVOLVING 
*                CONTROL POINT ACTIVITY.
* 
*         LOCAL COPY OF *COMCCPM*.
* 
*         ENTRY  (X1) = PARAMETER.
*                (X2) = REQUEST.
* 
*         EXIT   NONE.
* 
*         USES   X - 1, 2, 6. 
*                A - NONE.
*                B - NONE.
* 
*         CALLS  SYS
  
CPM1      RJ   SYS
  
CPM=      PS
          MX6    -24
          BX1    -X6*X1 
          LX2    24D
          SX6    4RCPMP/16
          BX1    X2+X1
          LX6    40D
          BX6    X6+X1
          EQ   CPM1 
  
K         ENDIF 
          SPACE  4
**        ** END COMMON DECK ** 
