SETCORE 
          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 
