$BEGIN    PDP-9 SIMULATOR FOR 7502
/MANIPULATES OPERANDS DIRECTLY ON VIDEO SCREEN
/18-BIT OPERANDS ARE 11 CHAR SEQUENCES
/ -- 6 OCTAL DIGITS WITH SPACES BETWEEN DIGITS
/OCTAL DIGITS ARE SYMBOLS '0' : '7' IN ISO
/HENCE LOW-ORDER 3 BITS ARE 0 : 7
/THE LINK IS A SINGLE CHAR - '0' OR '1'
/
/THE REGISTERS SHOWN ON SCREEN ARE:
/  L  AC  PC  MB
/THE ADDRESS OF AN OPERAND IS THE ADDRESS OF
/THE LEFTMOST (MOST SIGNIFICANT) DIGIT

    JUMP START                  /INITIAL ENTRY

$TEMP R2,R3
$DEF TEMP=R2
$DEF AC=R4, MB=R5, LOC=R6, I=R7 /AV,MB,LOC,I IN SAME GROUP
$DEF L=R8, POS=R9, OP=R10, J=R11 /POS,J IN SAME GROUP
$DEF SKIP=R12, PC=R13, MODE=R14 /*PC IS PDP9 PC*
$DEF SYM=R12                    /*SKIP & SYM SAME REG*
$DEF DBASE=MB+80+79

$MACRO P A,B,C
A-64<<5+B-64<<5+C-64
$END

    P '@','D','A'
    P '@','G','O'
OP0:P 'C','A','L'
    P 'D','A','C'
    P 'J','M','S'
    P 'D','Z','M'
    P 'L','A','C'
    P 'X','O','R'
    P 'A','D','D'
    P 'T','A','D'
    P 'X','C','T'
    P 'I','S','Z'
    P 'A','N','D'
    P 'S','A','D'
    P 'J','M','P'
    P 'E','A','E'
    P 'I','O','T'
    P 'O','P','R'
    P 'L','A','W'
    P 'S','Z','L'; X'0300'
    P 'S','P','A'; X'0240'
    P 'S','N','A'; X'0280'
    P 'S','K','P'; X'0200'
    P 'S','N','L'; X'0100'
    P 'S','M','A'; X'0040'
    P 'S','Z','A'; X'0080'
    P 'S','T','L'; X'0802'
    P 'R','C','L'; X'0808'
    P 'R','C','R'; X'0810'
    P 'C','L','L'; X'0800'
    P 'C','L','A'; X'1000'
    P 'C','M','L'; X'0002'
    P 'C','M','A'; X'0001'
    P 'R','T','L'; X'0408'
    P 'R','T','R'; X'0410'
    P 'R','A','L'; X'0008'
    P 'R','A','R'; X'0010'
    P 'O','A','S'; X'0004'
    P 'H','L','T'; X'0020'
    P 'N','O','P'; X'0000'
    0

$DEF LTEMP=*
$LOC X'4000'
/VIDEO SCREEN (80 CHAR LINES)
$DEF V40=*+26, VPC=*+400+2, VMB=*+640+2
$DEF VL=*+1120+1, VAC=VL+4
80$' '
80$' '
40$' '
'           PDP-9 SIMULATOR              '
40$' '
'                                        '
40$' '
'    Simulates PDP-9 instructions,       '
40$' '
'    excluding CAL, EAE and IOT,         '
40$' '
'    with core addresses limited         '
40$' '
'    to the range 40 - 67.               '
40$' '
'    Store values are entered            '
40$' '
'    using standard mnemonics            '
40$' '
'    and/or octal numerals.              '
40$' '
'                                        '
40$' '
'    SPACEBAR: enter store values        '
40$' '
'       DA xx: define address xx         '
40$' '
'       GO xx: start at xx               '
40$' '
'                                        '
40$' '
'    To control program use blue keys    '
40$' '
'       DOT: single step                 '
40$' '
'      DASH: single inst                 '
40$' '
'       0-9: run (0 slowest 9 fastest)   '

$LOC VPC-80
'P C'
$LOC VMB-80
'M B'
$LOC VL-80
'L   A C'

$LOC X'70'
z:  '0 0 0 0 0 0'               /SCREEN FORM OF ZERO

$LOC LTEMP

$MACRO CALL ROUTINE
DUMP NP,R15,1; JUMP ROUTINE
$END

$DEF OUT=W(*)
    NP = NP-1
    TEMP = NP
    REC TEMP,R15,1

GETSYM:
    READSYM SYM
    SYM = SYM-32 IF SYM >= 96
    JUMP OUT

PTEXT:
    CYCLE
      W(NP) = W(NP)&X'3FFF'+1   /INCREMENT RETURN AD
      R3 = W(W(NP)+1)>>8
      PRINT R3 IF R3 # 0
      R3 = W(W(NP)+1)&255
      JUMP OUT IF R3 = 0
      PRINT R3
    REPEAT

GETTAG:                         /READ AND PACK MNEMONIC
    OP = 0
    WHILE SYM >= 'A' AND SYM <= 'Z'
      OP = OP<<5+SYM-64
      CALL GETSYM
    REPEAT
    JUMP OUT

$MACRO MARK D,V                 /MARK SCREEN AD OF DEST
R2=V; R3=10; MODS OR,D,R3
$END

$MACRO UNMARK D
R2=127; R3=10; MODS AND,D,R3
$END

$MACRO SHOW N                   /DISPLAY NTH MNEMONIC
R3=N; CALL SHOWR
$END
$TEMP R2
SHOWR:
    R3 = OP0(R3)
    W(POS) = R3>>10&31+64
    W(POS+1) = R3>>5&31+64
    W(POS+2) = R3&31+64
    POS = POS+3
    JUMP OUT
$TEMP R2,R3

PAUSE:
    CYCLE
      J = KSYM
      JUMP OUT IF J = ' '
      J = KBITS(5)
      JUMP PAUS5 IF J # 0
    REPEAT IF MODE <= 0 OR TIMER # 0
    TIMER = MODE
    JUMP OUT
PAUS5:
    CYCLE
    REPEAT IF KBITS(5) # 0
    IF J&6 # 0                  /DOT,DASH
      MODE = -1                 /DOT: SINGLE STEP
      MODE = 0 IF J&2 = 0       /DASH: SINGLE INST
    ELSE
      MODE = J>>6
      TIMER = MODE
    FINISH
    J = 0
    JUMP OUT

STPAUSE:
    W(LOC-1) = J; W(LOC+11) = J
    CALL PAUSE
    W(LOC-1) = ' '; W(LOC+11) = ' '
    JUMP OUT

$MACRO INC D                    /INCREMENT DEST BY 1
POS=D; CALL INCR
$END
INCR:
    J = 10; I = 1
    WHILE W(POS+J) = '7'
      W(POS+J) = '0'
      J = J-2
      JUMP OUT IF J < 0         /(I SET)
    REPEAT
    W(POS+J) = W(POS+J)+1
    I = 0
    JUMP OUT

$MACRO LOAD D,S                 /LOAD DEST WITH SOURCE
R2=10; MOVE S,D,R2
$END

$MACRO CLEAR D                  /SET DEST TO 'ZERO'
R3=#Z; R2=10; MOVE R3,D,R2
$END

$MACRO LOCATE S                 /SET LOC FROM SOURCE
POS=S; CALL LOCATR
$END
LOCATR:
    LOC = 0
    JUMP OUT IF W(POS+2)!W(POS+4)!W(POS+6) # '0'
    J = W(POS+8)-'6'
    JUMP OUT IF J > 0
    J = J+2
    JUMP OUT IF J < 0
    J = J<<3+W(POS+10)-'0'      /0:27
    LOC = (J<<2+J)<<4+#V40      /J*80+V40
    JUMP OUT

/INITIAL ENTRY
START:
    VLIM = VBASE+20
    VPOS = VLIM
    PC = VPC; MB = VMB
    L = VL; AC = VAC
    CLEAR PC; CLEAR MB
    W(L) = '0'; CLEAR AC
    LOC = V40; I = '4'; J = '0'
    CYCLE
      W(LOC-6) = I; W(LOC-4) = J
      CLEAR LOC
      LOC = LOC+80
      J = J+1
      IF J = '8'
        J = '0'
        I = I+1
      FINISH
    REPEAT IF I # '7'

/COMMAND STAGE
COMMAND:
    POS = DBASE                 /INST MNEMONIC DISPLAY
    I = POS+1; J = 17           /CLEAR GARBAGE
    MOVE I,POS,J
NEXT:
    LOCATE PC
    IF LOC = 0
      CLEAR PC; W(PC+8) = '4'   /SET 40
      LOC = V40
    FINISH
    CLEAR MB
    MARK LOC,CURSOR
    CYCLE
      CALL GETSYM
    REPEAT IF SYM = ' '
    UNMARK LOC
    PRINT NL                    /TO CLEAR REPORT AREA
    JUMP BUMP IF SYM = NL
    CALL GETTAG
    IF OP # 0
      POS = #OP0; J = -2        /LOOKUP INST MNEMONIC
      WHILE W(POS+J) # OP
        J = J+1
        JUMP GROUP IF J = 17
      REPEAT
      OP = J<<1
      OP = OP-1 IF OP = 32      /LAW
      IF OP < 26 AND SYM = '*'  /MEM-REF & INDIRECT
        OP = OP+1
        CALL GETSYM
      FINISH
      WHILE SYM = ' '
        GET GETSYM
      REPEAT
    FINISH
    WHILE SYM >= '0' AND SYM <= '7'
      POS = MB+12; I = MB+10    /SHIFT UP MB
      J = -10
      MOVE POS,I,J
      W(I) = SYM                /APPEND NEW DIGIT
      CALL GETSYM
    REPEAT
    JUMP SETOP
GROUP:
    J = 0                       /ACCUMULATE OPR
    CYCLE
      POS = #OP0(17)            /START OF OPR MNEMONICS
      WHILE W(POS) # OP
        JUMP ER1 IF W(POS) = 0
        POS = POS+2
      REPEAT
      J = J!W(POS+1)            /MNEMONIC VALUE
      OP = 0;
      IF SYM = '!'
        CALL GETSYM
        CALL GETTAG
      FINISH
    REPEAT IF OP # 0
    I = 10
    CYCLE
      W(MB+I) = J&7+'0'
      J = J/8; I = I-2
    REPEAT IF I # 0
    OP = 30
SETOP:
    JUMP ER5 IF SYM # NL
    JUMP SPECIAL IF OP < 0
    IF OP > 0
      JUMP ER3 IF W(MB+2)&6 # 0
      JUMP ER3 IF W(MB) # 0
      W(MB) = OP/4+'0'
      OP = (OP&3)<<1
      W(MB+2) = W(MB+2)+OP
    FINISH
    LOAD LOC,MB
BUMP:
    INC PC
    JUMP NEXT

SPECIAL:
    LOAD PC,MB IF W(MB+8) # '0'
    JUMP NEXT IF OP = -4        /DEFINE ADDRESS
    JUMP GO
ER1:CALL PTEXT; B '*UNKNOWN MNEMONIC',NL,0
    JUMP ER4
ER3:CALL PTEXT; B '*INVALID ADDRESS',NL,0
ER4:WHILE SYM # NL
      CALL GETSYM
    REPEAT
    JUMP NEXT
ER5:CALL PTEXT; B '* ?',0
    WHILE SYM # NL
      PRINT SYM
      CALL GETSYM
    REPEAT
    JUMP NEXT

/EXECUTION STAGE
OPERR:
    CALL PTEXT; B '*ILLEGAL OPCODE',NL,0
    POS = SKIP
    JUMP ER9
ADERR:
    CALL PTEXT; B '*ILLEGAL ADDRESS',NL,0
    MARK POS,CURSOR
ER9:MODE = 0
    CALL PAUSE
    UNMARK POS
    UNMARK SKIP IF SKIP # 0
    SKIP = 0
    PRINT NL
    JUMP COMMAND IF J = ' '
    IF POS = PC
      CLEAR PC; W(PC+8) = '4'
    FINISH
    JUMP EXEC
GO:
    MODE = 0; SKIP = 0
EXEC:
    INC PC IF SKIP # 0
    LOCATE PC
    SKIP = LOC; JUMP ADERR IF SKIP = 0
    INC PC
XXCT:
    SKIP = LOC
    POS = DBASE                 /INST MNEMONIC DISPLAY
    I = POS+1; J = 17           /CLEAR LAST
    MOVE I,POS,J
    LOAD MB,LOC                 /INSTRUCTION FETCH
    MARK SKIP,CURSOR
    OP = (W(MB)&7)<<1           /EXTRACT OP-CODE
    OP = OP+1 IF W(MB+2)&4 # 0
    I = W(MB+2)&2               /INDIRECT BIT
    JUMP XOPR IF OP = 15        /TREAT OPR INDEPENDENTLY
    SHOW OP                     /DISPLAY MNEMONIC
    W(POS) = '*' IF I # 0       /INDIRECT
    CALL PAUSE
    IF J = ' '
      UNMARK SKIP
      JUMP COMMAND
    FINISH
    JUMP OPERR IF OP=0 OR OP=13 OR OP=14 /CAL,EAE,IOT ->
    W(MB) = '0'                 /CLEAR TOP 5 BITS
    W(MB+2) = W(MB+2)&1
    LOCATE MB
    JUMP ADERR IF LOC = 0
    IF I # 0                    /INDIRECT
      IF MODE # 0
        J = '*'
        CALL STPAUSE
      FINISH
      LOAD MB,LOC
      LOCATE MB
      JUMP ADERR IF LOC = 0
    FINISH
    IF MODE # 0 AND OP # 12
      J = 2
      CALL STPAUSE
    FINISH
    UNMARK SKIP
    SKIP = 0
    R15 = R15+OP                /SWITCH ON OP-CODE
    JUMP W(*); JUMP XDAC; JUMP XJMS; JUMP XDZM
    JUMP XLAC; JUMP XXOR; JUMP XADD; JUMP XTAD
    JUMP XXCT; JUMP XISZ; JUMP XAND; JUMP XSAD
XJMP:
    LOAD PC,MB
    JUMP EXEC
XLAC:
    LOAD AC,LOC
    JUMP EXEC
XDAC:
    LOAD LOAD,AC
    JUMP EXEC
XDZM:
    CLEAR LOC
    JUMP EXEC
XISZ:
    INC LOC; SKIP = I
    JUMP EXEC
XJMS:
    LOAD LOC,PC
    W(LOC) = '4' IF W(L) # 0    /LINK TO SIGN
    INC MB; LOAD PC,MB
    JUMP EXEC
XADD:
    POS = W(AC)                 /SAVE MS DIGIT
XTAD:
    I = 10; J = 0
    CYCLE
      J = W(AC+I)+W(LOC+I)+J
      W(AC+I) = J&7+'0'
      J = J>>3&1
      I = I-2
    REPEAT IF I >= 0
    IF OP = 7                   /TAD
      W(L) = W(L)\7
    ELSE                        /ADD
      INC AC IF J # 0           /END-AROUND CARRY
      W(L) = '1' IF (W(LOC)\POS)&4 = 0 AND (W(AC)\POS)&4 # 0
    FINISH
    JUMP EXEC
XXOR:
    I = 10
    CYCLE
      W(AC+I) = W(AC+I)\W(LOC+I)+'0'
      I = I-2
    REPEAT IF I >= 0
    JUMP EXEC
XAND:
    I = 10
    CYCLE
      W(AC+I) = W(AC+I)&W(LOC+I)
      I = I-2
    REPEAT IF I >= 0
    JUMP EXEC
XSAD:
    I = 12
    CYCLE
      I = I-2
      JUMP EXEC IF I < 0
    REPEAT IF W(AC+I) = W(LOC+I)
    SKIP = 1
    JUMP EXEC
XOPR:
    JUMP XLAW IF I # 0
    OP = W(MB+2)&1              /ACCUMULATE SUB-BITS
    I = 4
    CYCLE
      OP = OP<<3+W(MB+I)-'0'
      I = I+2
    REPEAT IF I # 12
    J = 0; I = #OP0(17)
    CYCLE
      IF \OP&W(I+1) = 0 AND \J&W(I+1) # 0
        J = J!W(I+1)
        SHOW I-#OP0
        IF J # OP
          W(POS) = '!'
          POS = POS+1
          J = OP IF POS >= DBASE+15
        FINISH
      FINISH
      I = I+2
    REPEAT IF W(I) # 0
    CALL PAUSE
    UNMARK SKIP; SKIP = 0
    JUMP COMMAND IF J = ' '
    J = OP/64                   /HIGH-ORDER 7 BITS
    IF J&4 # 0                  /SNL,SZL
      SKIP = 1 IF W(L) = '1'
    FINISH
    IF J&1 # 0                  /SMA,SPA
      SKIP = 1 IF W(AC)&64 # 0
    FINISH
    IF J&2 # 0                  /SZA,SNA
      R2 = '0'; R3 = 10
      TEST 2,AC,R3              /REG < STORE
      SKIP = 1                  /(SINGLE INST)
    FINISH
    SKIP = SKIP\1 IF J&8 # 0    /INVERT
    IF J&X'20' # 0              /CLL
      W(L) = '0'
    FINISH
    IF J&X'40' # 0              /CLA
      CLEAR AC
    FINISH
    IF OP&2 # 0                 /CML
      W(L) = W(L)\1
    FINISH
    IF OP&1 # 0                 /CMA
      I = 10
      CYCLE
        W(AC+I) = W(AC+I)\7
        I = I-2
      REPEAT IF I >= 0
    FINISH
    MODE = 0 IF OP&X'20' # 0    /HLT
    IF OP&8 # 0                 /RAL,RTL
      OP = J&X'10'              /'ROTATE 2' BIT
      CYCLE
        I = 10; J = W(L)&1
        CYCLE
          J = W(AC+I)<<1+J
          W(AC+I) = J&7+'0'
          J = J>>3&1
          I = I-2
        REPEAT IF I >= 0
        W(L) = J+'0'
        OP = OP-X'10'
      REPEAT IF OP = 0
    ELSE IF OP&X'10' # 0        /RAR,RTR
      OP = J&X'10'
      CYCLE
        I = 0;  J = W(L)
        CYCLE
          J = ((J&1)<<3)+(W(AC+I)&7)
          W(AC+I) = J/2+'0'
          I = I+2
        REPEAT IF I # 12
        W(L) = J&1+'0'
        OP = OP-X'10'
      REPEAT IF OP = 0
    FINISH
    JUMP EXEC
XLAW:
    SHOW 16
    CALL PAUSE
    UNMARK SKIP; SKIP = 0
    JUMP COMMAND IF J = ' '
    LOAD AC,MB
    JUMP EXEC

$END
$END