IDENT  SETCORE,SETCORE,SETCORE 
          ABS
          SYSCOM B1          DEFINE (B1) = 1
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
*COMMENT  SETCORE - PRESET MEMORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  SETCORE - PRESET MEMORY.
 SETCORE  SPACE  4
***       SETCORE - PRESET MEMORY.
*         R. A. LARSEN.  75/01/03.
*         ADAPTED FROM LINK BY G. R. MANSFIELD.
 SETCORE  SPACE  4
***              SETCORE PROCESSES THE PRESETTING OF MEMORY TO A
*         SPECIFIED VALUE.
 SETCORE  SPACE  4
***       SETCORE(P)
*         SETCORE(+P)
*         SETCORE(-P)
*         PRESET MEMORY ACCORDING TO *P*.
*
*         P      VALUE
*         0      ZEROES
*         ZERO   ZEROES
*         INDEF  INDEFINITES
*         INF    INFINITES
*
*         ASSUMED ARGUMENT.
*         P      ZERO


          ORG    110B

 SETCORE  SB1    1           PRESET PROGRAM
          SA1    ACTR        CHECK ARGUMENT COUNT
          BX6    X6-X6       CLEAR VALUE
          SX5    B0          CLEAR SIGN
          BX0    X0-X0       SET DEFAULT PATTERN
          SB7    X1
          ZR     B7,STC2     IF NO ARGUMENTS

*         PROCESS SIGN ARGUMENT.

          SA1    ARGR
          ZR     X1,STC2     IF BLANK
          SA2    STCA-2
          SB2    X1-1R+      CHECK SEPARATOR
          NG     B2,STC1     IF NOT *+*
          GT     B2,B1,STC1  IF NOT *-*
          SA1    A1+B1       NEXT ARGUMENT
          SX5    B2          SET SIGN

*         PROCESS VALUE ARGUMENT.

 STC1     SA2    A2+2        NEXT OPTION
          BX7    X1-X2
          ZR     X2,STC4     IF END OF OPTIONS
          NZ     X7,STC1     IF NO MATCH
          LX5    59          SET SIGN
          SA2    A2+B1       SET VALUE
          AX5    60
          BX0    X2-X5       SAVE SETCORE VALUE

*         MOVE PRESET PROGRAM.

 STC2     SB2    PMLL
 STC3     SA1    PML+B2
          SB2    B2-B1
          LX7    X1
          SA7    B2+1
          PL     B2,STC3     IF NOT END OF MOVE
          BX6    X0          SET VALUE
          LX7    X0
          SA4    PMLA
          SB3    A0-PMLL-2   SET WORD COUNT
          SB2    B1+B1
          SA6    A0-B1
          SA7    A6-B1
          JP     PML2        ENTER PRESET LOOP

*         PROCESS ARGUMENT ERROR.

 STC4     MESSAGE (=C* ILLEGAL ARGUMENT.*)
          ABORT
          SPACE  4
**        TABLE OF SETCORE OPTIONS.
*
*         WORD 1 = OPTION.
*         WORD 2 = VALUE.


 STCA     CON    0LZERO,0
          CON    0L0,0
          CON    0LINDEF,1777BS48
          CON    0LINF,3777BS48
          CON    0           END OF TABLE
 PML      SPACE  4
**        PRESET MEMORY LOOP.


 PML      BSS    0
          LOC    0
          CON    0
 PML1     CON    0

*         NEXT THREE INSTRUCTIONS ARE LEFT IN RA+2.

 PML1.1   SA7    B1          END PROGRAM
          SA6    A6+B1       PRESET (5)
          JP     PML1        WAIT MONITOR

 PML2     SA6    A6-B2       PRESET UPPER CORE
          SA7    A7-B2
          SB3    B3-2
          NZ     B3,PML2     IF UPPER MEMORY NOT PRESET
          SA6    B2+B1       PRESET (3)
          BX7    X4
          SB6    B1
          SA6    A6+B1       PRESET (4)
          EQ     PML1.1      COMPLETE PROGRAM IN WORD 2


          LOC    *O
 PMLL     EQU    *-PML

*         (RA+1) END MONITOR CALL.

 PMLA     VFD    30/0LEND
          EQ     PML1
          SPACE  4
**        COMMON DECKS.


*CALL     COMCSYS
          SPACE  4
          END