$LIST 5
   $BEGIN

   /
   / SOLITAIRE FOR THE 7502
   /

      $TEMP R9, R10, R11, R2, R13, R14
      $DEF STP = R5, GBASE = R6
      $DEF NP = R4, SYM = R3, TEMP = R7
      $DEF MARK = R8

      STP = #STACK
      GBASE = #STAT
      MARK = X'4000'
      JUMP SOLENT

OUT:  STP = W(STP)
      NP = NP-1
      TEMP = NP
      REC TEMP, PC, 1

      $MACRO CALL ROUT
         W(STP+VARP) = STP
         STP = STP+VARP
         DUMP NP, PC, 1
         JUMP ROUT
      $END


      $MACRO ROUTINE NAME
         $REDEF VARP = 1
      NAME:
         $BEGIN
      $END


      $DEF VARP = 1

      $MACRO VAR NAME
         $DEF NAME = W(STP+VARP)
         $REDEF VARP = VARP+1
      $END


      $DEF GVARP = 0

      $MACRO GVAR NAME
         $DEF NAME = W(GBASE+GVARP)
         $REDEF GVARP = GVARP+1
      $END

      $DEF WC = 0, FREF = .ZZZ, BREF = .AAA
      $DEF NESTL = 0

      $MACRO FORALL VAR, LOW, INC, UPPER
         $REDEF WC = WC+1, NESTL = NESTL+1
         $REDEF BREF = BREF-1, FREF = FREF+1
         VAR = LOW-INC
BREF?:   JUMP FREF? IF VAR >= UPPER
         VAR = VAR+INC
      $END


      $MACRO REP
         JUMP BREF?
FREF?:
         $REDEF BREF = BREF+1, FREF = FREF-1
         $IF NESTL = 1
         $REDEF FREF = .ZZZ+WC, BREF = .AAA-WC
         $FINISH
         $REDEF NESTL = NESTL-1
      $END

GVAR NOLEFT; GVAR X; GVAR Y; GVAR TOT
GVAR HUN; GVAR DOWN

$DEF BLANK = 2, PEG = 7
$DEF BOARD = X'415E', MIDDLE = 489
ROUTINE MOVE
VAR X; VAR Y; VAR Z; VAR JUMPP; VAR TO; VAR BP
DOWN=DOWN+1
FORALL X,1,1,7
   FORALL Y,1,1,7
      BP = (Y<<2+Y)<<5+(X<<1)+X-163
      JUMP EMPTY IF BOARD(BP) # PEG
         FORALL Z,1,1,4
            PC = PC+Z
            JUMP DIR1
            JUMP DIR2
            JUMP DIR3
            JUMP DIR4
DIR1:          JUMP CONT IF Y >= 6
               JUMPP=BP+160
               TO=JUMPP+160
               JUMP TESTI
DIR2:          JUMP CONT IF X >= 6
               JUMPP=BP+3
               TO=BP+6
               JUMP TESTI
DIR3:          JUMP CONT IF Y <= 2
               JUMPP=BP-160
               TO=JUMPP-160
               JUMP TESTI
DIR4:          JUMP CONT IF X <= 2
               JUMPP=BP-3
               TO=JUMPP-3
TESTI:       IF BOARD(JUMPP)=PEG AND BOARD(TO)=' '
               BOARD(BP)=' '
               BOARD(JUMPP)=' '
               BOARD(TO)=PEG
               NOLEFT=NOLEFT-1
               W(MARK) = PEG
               MARK = MARK+1
               CALL MOVE
               IF NOLEFT=1 AND BOARD(MIDDLE)=PEG
                  DOWN=DOWN-1
                  JUMP OUT
               FINISH
               BOARD(BP)=PEG
               BOARD(JUMPP)=PEG
               BOARD(TO)=' '
               NOLEFT=NOLEFT+1
               MARK = MARK-1
               W(MARK) = ' '
            FINISH
CONT:    REP
EMPTY:
   REP
REP
DOWN=DOWN-1
JUMP OUT
$END
/
/
SOLENT:
FORALL X,1,1,7
   FORALL Y,1,1,7
      BOARD((Y<<2+Y)<<5+(X<<1)+X-163) = BLANK
      BOARD((Y<<2+Y)<<5+(X<<1)+X-163) = PEG IF 3 <= X AND X <= 5
      BOARD((Y<<2+Y)<<5+(X<<1)+X-163) = PEG IF 3 <= Y AND Y <= 5
   REP
REP
BOARD(MIDDLE)=' '
TEMP = BOARD-80
FORALL X, 0, 1, 18
   W(TEMP+X) = '+'
REP

TEMP = BOARD-81
FORALL X, 0, 1, 14
   W(TEMP) = '+'; W(TEMP+20) = '+'
   TEMP = TEMP+80
REP

TEMP = TEMP-79
FORALL X, 0, 1, 18
   W(TEMP+X) = '+'
REP
TOT=0
HUN=0
DOWN=0
NOLEFT=32
TEMP = #MESS
WHILE W(TEMP) # 0
   SYM = W(TEMP)
   PRINT SYM
   TEMP = TEMP+1
REPEAT
CALL MOVE
HOWL
MESS: 'STARTED', 0
STAT: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
STACK:
$END
$END