File CUDDLE1

Directory of image this file is from
This file as a plain text file

[CUDDLE   10-70
[CONTROL FOR SAP
[A SEARCH FOR PERFECT NUMBERS, AMICABLE 
[PAIRS, AND SOCIABLE GROUPS
[N A BICKET
[WASHINGTON UNIVERSITY--CSL
[USES BLKS 0-100 u0
JMP 6N [RE-ENTRY
SET i 11
#2Z  -100 [SNAPSHOT COUNTER
CLR
OPR 8Y
LDA i
 9K
OPR 8Y
STA i
#2I  00 [IN VECTOR
STA i
#2O  00 [OUT VECTOR
#1A KST
JMP 1A
KBD i
SHD i
"I;
JMP 3I [INTERRUPT
SHD i
"S;
JMP 1S [GET NEW ROOT CANDIDATE--START
SHD i
"K;
JMP 1K [RESUME FROM KEY TEST
SHD i
"D;
JMP 7W [DISPLAY RC
JMP 1A
[
[
[START WITH RC INITIALIZED BY USER
[RC + 1 -> RC
#1S SET i 15
#8R  -1  [ROOT LENGTH
SET i 17
 9R [ADDRESS OF RC0
XSK i 11
JMP p+4
JMP 3B [SNAPSHOT
SET 11 
 2Z
CLR
STC 9P
LDA i
1
LAM i 17
STC 1776
XSK i 15
JMP p-3
ADD 1776
APO i [INCREASE RL ?
JMP p+11 [NO
LDA i [DECREMENT RL
 -1
ADM
 8R
SAE i
 -3
JMP p+2
HLT [RC TOO BIG
LDA
 8R
ADA i
  1
AZE [RL = 1 ?
JMP 1R [NO
[RC ON LIST A ?
CLR
STC 2S [S* = 0
SET i 16
 -4
SET i 17
 1777
LDA [S*-> S
 2S
OPR 8P [DATA OUT
LDA i [GET A
 9H
JMP 2B [CNTRL OUT AND CHK
CLR
OPR 8F [A-> LINC
COM
ADA
9R+1 [RC0-A
AZE [EQUAL ?
JMP p+7 [NO
LDA i [YES
 9B [CLR RC FROM A
JMP 2J [CNTRL OUT
CLR
OPR 8P
JMP 1L [CHECK FOR RETURN
LDA
 2S
ADA i
 1
STC 2S [S*+1->S*
XSK i 17
JMP p-31
XSK i 16
JMP p-33
[RC NOT ON LIST
CLR
OPR 8P [0->S
[RC --> WC
#1R SET i 16
 9R
SET i 17
 9W
JMP 1T
SET i 17
 9W
LDA i 17
OPR 8O [RC0 OUT
LDA i 17
OPR 8N [RC1 OUT
[SET STEP COUNTER
SET i 4
#3Z  -400
LDA i [START
 9F
JMP 2J [CNTRL OUT
JMP 1L [GO TO SLAVE LOOP
[
[
[SLAVE LOOP
#1L CLR
OPR 8Z
SAE [RETURN
 2I
JMP p+2
JMP p-5 [NO RET
BCO
 2I
STA i
 0 [BIT
CLR
ADD 2I
BCO
p-4
STC 2I
ADD p-6 [BIT
SAE i
 9A
JMP p+2
JMP 1P [PI ON?
SAE i
 9B
JMP p+2
JMP 1I [SET PI ON
SAE i
 9C
JMP p+2
JMP 3L [KEY INTERRUPT
SAE i
 9D
JMP p+2
JMP 1S [GET NEW RC
SAE i
 9E 
JMP p+2
JMP 4C [NO ON LISTS
SAE i
 9F
JMP p+2
JMP 2E [EUREKA
SAE i 
 9G
JMP p+2
JMP 1B [WC ON LIST A
SAE i
 9I
JMP p+2
JMP 4Z [OVERFLOW OF SYSTEM
HLT [UNEXPECTED RETURN
[P.I. ON ?
#1P LDA
 9P
AZE
JMP p+5 [ON
LDA i [OFF
 9A
JMP 2J [CNTRL OUT
JMP 1L [GO TO SLAVE LOOP
[GET WC
JMP p+2
JMP 5C-2
SET i 17
 9W
CLR
OPR 8D [GET WC0
STA i 17
CLR
OPR 8C [WC1
STA i 17
CLR
STA i 17
STA i 17
STA i 17
STA i 17
STA i 17
STA i 17
JMP 0
[PRINT WC
JMP 4T
JMP 1W
#5C LDA i [RESUME WITH LIST BYPASS
 9G [CALCULATE NEW WC
JMP 2J [CNTRL OUT
JMP 1L [TO SLAVE LOOP
[SET P.I. ON
#1I LDA
9P
AZE
JMP 1S [SET PI OFF--GET NEW RC
LDA i [OFF-SET ON
1
STC 9P [1 TO PI
[PRINT RC
SET i 16
 9W
SET i 17
 4K
JMP 1T [WC TO TEMP
SET i 16
 9R
SET i 17
 9W
JMP 1T [RC TO WC
JMP 4T
JMP 4T
JMP 1W
SET i 16
 4K
SET i 17
9W
JMP 1T [TEMP TO WC
JMP 1R [RC TO WC
[EUREKA -- ON LIST B
#2E CLR
OPR 8E [GET B
[PRINT B -- EUREKA
STA
 9W+1
CLR
SET i 17
 9W+1
SET i 16
-7
STA i 17
XSK i 16
JMP p-2
JMP 4T
SET i 10
-40
LDA i
3534 [PERIOD
JMP 3T+3
XSK i 10
JMP p-4
JMP 4T
JMP 1W [PRINT B
JMP 4T
SET i 10
 -10
LDA i
3534 [PERIOD
JMP 3T+3
XSK i 10
JMP p-4
JMP 4T
[ADD LIST B TO LIST A
#1B LDA i
 9L
JMP 2J [CNTRL OUT
LDA i
 9L
JMP 2K [CNTRL RET
JMP p-3 [NO
JMP 1S [YES--GET NEW RC
[KEY INTERRUPT
#3L KST i
JMP 1A+2 [YES, GET INSTRUCTION
#1K LDA i [NO
 9C
JMP 2J [CNTRL OUT
JMP 1L
[WC NOT ON LISTS
#4C XSK i 11 [SNAPSHOT?
JMP p+4 [NO
JMP 3B
SET 11
 2Z
XSK i 4 [INDEX STEP CTR
JMP 5C [MORE--CALCULATE NEW WC
[THROUGH--PRINT RC.....WC
JMP 7U
JMP 1S [GET NEW RC
[SYSTEM OVFL
#4Z JMP 3B
JMP 4T
JMP 4T
SET i 10
 -10
LDA i
 3524 [ASTERISK
JMP 3T+3
XSK i 10
JMP p-4
[GET WC
JMP 1P+12
JMP 5U [SPACE
JMP 5U [SPACE
JMP 7U [PRINT RC...WC TERM|CTR
JMP 1S [GET NEW RC
[MM SUBRS
[CONTROL OUT + CHK
#2B STA
p+5
BCO [MOD IN VECT
 2I
STC 2I
LDA i
  0 [BIT TO CHK
BCO [MOD OUT VECT
 2O
OPR 8Y [CNTRL OUT
STC 2O
LDA [SELECT BITS TO TEST
p-6
COM
STC p-10
ADD 2I
BCL
p-13
STC p+11
NOP [WAIT A BIT
NOP
NOP
NOP
OPR 8Z [CNTRL IN
BCL
p-23
SAE i [HAVE RET?
  0 [CHK
HLT [NO RET
JMP 0 [YES
[
[CONTROL OUT
#2J BCO [MOD OUT VECTOR
 2O
OPR 8Y [OUT
STC 2O
JMP 0
[
[TEST CNTRL RET
[TO p+1 IF NO RET
[TO p+2 IF RET
#2K STC p+21 [SAVE
ADD 0 [SAVE RET
STC p+15
ADD p+16
BCO [MOD IN VECT
 2I
STC 2I
OPR 8Z [IN
SAE
 2I
JMP p+6 [NO RET
LDA i
  1
ADM [INCR RET ADDR
 p+1
0 [RET
LDA i [FIX IN VECTOR
  0 [STORAGE
BCO
 2I
STC 2I
JMP p-6
[PRINT WC
#1W LDA
0
STC 2W
JMP 1H
JMP 3H
JMP 5H
JMP 3H
JMP 3H
SET i 16
5K [LA
SET i 17 
3K [Y
JMP 2A [ADD
JMP 4P [LENGTHEN ?
SET i 16
3K [Y
SET i 17
9W [WC
JMP 2G [X>Y?
APO i
JMP p-20
JMP 5H
SET i 17
6K [LD
JMP 1Z
LDA i
12
STA
 6K+1
JMP 1D
SET i 16
 7K
SET i 17
 3K
JMP 1T
LDA
 3K+1
ROR 1
APO
JMP 3Q
JMP 7H
JMP 1D
LDA
7K+1
JMP 3T [TELETYPE
SET i 16
5K [LA
SET i 17
 9W [WC
JMP 1T
JMP p-35
#3Q LDA
9W+1
JMP 3T
#2W XXX [RETURN
[X TO Y
#1T LDA
0
STC p+6
JMP 2P
LDA i 16
STA i 17
XSK i 15
JMP p-3
XXX [RETUQN
[X+Y TO Y
#2A LDA
0
STC p+11
JMP 2P
CLR
LDA i 16
LAM i 17
XSK i 15
JMP p-3
STA i
#3A 0
XXX [RETURN
[SET UP LENGTH CNTR
#2P SET i 15
#3P  -1
JMP 0
[Y+1 TO Y
#1N LDA
0
STC p+12
JMP 2P
CLR
LDA i
  1
LAM i 17
STC 1777
XSK i 15
JMP p-3
ADD 1777
XXX [RETURN
[-X TO Y
#2C LDA
 0
STC p+14
JMP 2P
LDA i 16
COM
STA i 17
XSK i 15
JMP p-4
LDA
17
ADD 3P
STC 17
JMP 1N
XXX [RETURN
[X > Y?
#2G LDA
0
STC p+15
JMP 2P
LDA
17
STC 3G
SET i 17
 8K
JMP 2C
SET i 17
 8K
SET i 16
#3G 0
JMP 2A
XXX [RETURN
[0 TO Y
#1Z LDA
0
STC p+6
JMP 2P
CLR
STA i 17
XSK i 15
JMP p-2
XXX [RETUQN
[1 TO TD
#1H LDA
  0
STC p+10
SET i 17
 3K
JMP 1Z
LDA i
 1
STA
 3K+1
XXX [RETURN
[TWICE TD TO TD
#3H LDA
  0
STC p+6
SET i 17
 3K
CLR
JMP 2F
JMP 4P
XXX [RETURN
[ADJUST LENGTH
#4P SET 1
 0
APO i
JMP 1
LDA i
 -1
ADM
 3P
SAE i
 -3 [MAX WORD LENGTH
JMP 1
HLT
[TD TO LA
#5H LDA
  0
STC p+6
SET i 16
 3K
SET i 17
 5K
JMP 1T
XXX [RETURN
[WC TO LA, TD TO LD
#7H LDA
 0
STC p+13
SET i 16
 9W
SET i 17
 5K
JMP 1T
SET i 16
 3K
SET i 17 
 6K
JMP 1T
 XXX [RETURN
[SHIFT Y LEFT 1
#2F LDA
  0
STC p+7
JMP 2P
LDA i 17
ROL i 1
STA 17
XSK i 15
JMP p-4
XXX [RETURN
[DIVIDE
#1D LDA
  0
STC 6D
[LD>LA?
SET i 16
 6K
SET i 17
 5K
JMP 2G
APO i
JMP p+5
SET i 17
 7K
JMP 1Z
JMP 6D
[NORMALIZE LA AND LD
SET i 14
 0
LDA
 3P
COM
ADA i
 5K
STC p+2
LDA
 0
ROL 1
APO
JMP p+11
SET i 17
 5K
CLR
JMP 2F
XSK i 14
ROL 1
APO i
JMP p-7
SET i 13
 0
LDA
 3P
COM
ADA i
 6K
STC p+2
LDA
 0
ROL 1
APO
JMP p+11
SET i 17
 6K
CLR
JMP 2F
XSK i 13
ROL 1
APO i
JMP p-7
[SET THE DIVIDE COUNTER
LDA
 13
ADA i
  1
COM
ADD 14
STC 12
[-LD TO LC
SET i 16
 6K
SET i 17 
 7L
JMP 2C
[0 TO LQ
CLR
SET i 17
 7K
JMP 1Z
[LC + LA TO LA
#2D SET i 16
 7L
SET i 17
 5K
JMP 2A
[SHIFT LQ LEFT 1
#3D SET i 17
 7K
JMP 2F
XSK i 12
JMP p+2
JMP 4D
[SHIFT LA LEFT 1
SET i 17
 5K
CLR
JMP 2F
LDA
 7K+1
ROR 1
APO
JMP 2D
[LD + LA TO LA
SET i 16
 6K
SET i 17
 5K
JMP 2A
JMP 3D
#4D LDA
 3A
APO i 
JMP 5D
[LD + LA TO LA
SET i 16
 6K
SET i 17
 5K
JMP 2A
[SHIFT LA RIGHT BETA TIMES
#5D LDA
 13
COM
STC 13
LDA
 3P
COM
ADA i
 5K
STC 17
JMP 2P
CLR
LDA 17
ROR i 1
STA 17
XSK i 15
JMP p+2
JMP 7D
LDA i
 -1
ADM
 17
JMP p-12
#7D XSK i 13
JMP 5D+4
#6D XXX [RETURN
#9P  00 [P.I.
#2S  00 [S*
[
[TAGS
[
[CONTROL BITS
[PI ON?
9A=1
[SET PI ON RET--0 TO A
9B=2
[KEY INTERRUPT
9C=4
[GET NEW RC
9D=10
[NOT ON LISTS
9E=20
[EUREKA | START
9F=40
[ON LIST A | RESUME
9G=100
[CHECK LIST A FOR RC
9H=200
[OVERFLOW
9I=400
[FILL LISTS
9J=1000
[EXTRA
9K=2000
[ADD LIST B TO LIST A
9L=4000
[
[DATA TRANSFER
[WC TO LINC
8A=70
8B=71
8C=72
8D=73
[B TO LINC
8E=74
[A TO LINC
8F=75
[LINC TO A
8S=56
[LINC TO B
8T=57
[RC TO WC
8L=50
8M=51
8N=52
8O=53
[LINC TO S
8P=54
[LINC TO P
8Q=55
[CONTROL OUT
8Y=47
[CONTROL IN
8Z=67
[
[ADDRESSES
9R=2007 [RC
9W=9R+10 [WC
3K=9W+10 [Y
4K=3K+10
5K=4K+10 [LA
6K=5K+10 [LD
7K=6K+10 [LQ
8K=7K+10 [TEMP
7L=8K+10 [LC
[DISPLAY RC
5W=7L+10
[TELETYPE
#3T ROL 1
ADA i
3540
SET 2
0
[CLASSIC VS MICRO FIX
MSC 2
SKP 17
JMP p+5
[MICRO
SCR 1
OPR 42
JMP p-1
JMP 2
[CLASSIC
ATR
SET i 3
-435
XSK i 3
JMP p-1
SCR 1
AZE
JMP p-7
JMP 2
[CARR RET AND LINE FEED
#4T LDA
0
STC 5T
LDA i
3432
JMP 3T+3
LDA i
3424
JMP 3T+3
#5T
[THE ABOVE TELETYPE ROUTINE WAS KINDLY SUPPLIED BY MAURICE L. PEPPER JR.
#3U LDA
0
STC 4U
SET i 16
9W
SET i 17
 4K
JMP 1T [WC TO TEMP
SET i 16
9R
SET i 17
9W
JMP 1T [RC TO WC
JMP 1W
JMP 5U [SPACE
SET i 10
-3
LDA i
3534 [PERIOD
JMP 3T+3
XSK i 10
JMP p-4
JMP 5U
SET i 16
 4K
SET i 17
 9W
JMP 1T [TEMP TO WC
JMP 1W
#4U
#5U LDA
0
STC p+4
LDA i
3500 [SPACE
JMP 3T+3
XXX [RET
#7U LDA
0
STC p+3
JMP 3U
JMP 3R
 0 [RET
[PRINT TERM NO. AND COUNT NO.
#3R LDA
0
STC 4R
JMP 5U
LDA i
3666
JMP 3T+3
SET i 17
 9W
JMP 1Z
LDA
 3Z [STEP CTR
COM
ADD 4
STA
 9W+1
JMP 1W [PRINT TERM
LDA i
3536
JMP 3T+3
SET i 17
 9W
JMP 1Z
LDA
 3Z
COM
STA
 9W+1
JMP 1W
LDA i
3672
JMP 3T+3
JMP 4T
JMP 4T
#4R
[RE-ENTRY POINT
#6N JMP 7U
RCG [RESTORE PROGRAM
 2000
CLR
OPR 8Y
LDA i
 9K
OPR 8Y
STA
 2I
STC 2O
STC 9P [PI OFF
[CHANGE PAGE
UMB 2
[FILL MEMORIES A,B
LDA i
4|004
STC p+10
SET i 3
 -10
SET i 5
 0 [ADDR IN MEM
SET i 6
 2000 [ADDR IN LINC
RCG 
4|004
LDA 6
OPR 8S [A OUT
LDA i 6
OPR 8T [B OUT
CLR
ADD 5
OPR 8P [S OUT
OPR 8Q [P OUT
LDA i
 9J
JMP 2B [CNTRL OUT AND CHK
XSK i 5
JMP p+5
LDA i
 2000
ADD 5
STC 5
XSK i 6
JMP p-22
LDA i
 10
ADD p-26
STC p-27
XSK i 3
JMP p-34
[CHANGE PAGE
UMB 1
CLR
OPR 8P
OPR 8Q
LDA i
 400
ADD 4
AZE i
JMP 1R [START WITH RC
JMP 1R+5 [START WITH WC
[INTERRUPT
#3I JMP 3B [SNAPSHOT
JMP 4T [CAR RET
JMP 4T
JMP 4T
JMP 7U
HLT
JMP 6N+1
[SNAPSHOT
#3B LDA 
 0
STC 4B
JMP 1P+12 [GET WC
WCG [WRITE PROGRAM ON BLKS 0-2
 2000
[CHANGE PAGE
UMB 2
[GET MEMORIES A,B
LDA i
 4|004
STC 4B-7
SET i 3
 -10
SET i 5
 0 [ADDR IN B,A
SET i 6
 2000 [ADDR IN LINC
CLR
ADD 5
OPR 8P [S OUT
OPR 8Q [P OUT
LDA i
 9H
JMP 2B
CLR
OPR 8F [GET A
STA 6
CLR
OPR 8E [GET B
STA i 6
XSK i 5
JMP p+5
LDA i
 2000
ADD 5
STC 5
XSK i 6
JMP p-24
WCG
 4|004
LDA i
 10
ADD p-3
STC p-4
XSK i 3
JMP p-36
[CHANGE PAGE
UMB 1
[CLEAR P AND S
CLR
OPR 8P
OPR 8Q
#4B  0 [RETURN
[PATTERNS
#4W 4136 [0
3641
2101 [1
1077
4523 [2
2151
4122 [3
2651
2414 [4
0477
5172 [5
0651
1506 [6
4225
4443 [7
6050
5126 [8
2651
5120 [9
3651
[DISPLAY RC
#7W LDA
 0
STC p+46
SET i 1 [H POSIT
 200
LDA i [VERT
 0
DSC i [R
4477
DSC i
3146
DSC i [SPACE
0000
DSC i [C
4136
DSC i 
2241
LDA i
 300
STC 2H
STC 2V
LDA
 9R+1
JMP 2R
CLR
ADD 1
STC 2H
LDA
 9R+2
JMP 2R
LDA i
 600
STC 2H
LDA
 3Z
COM
ADD 4
JMP 2R
KST [ ?
JMP 7W+3 [NO
XXX [RET
[DISPLAY REGISTER
#2R STC 3C
ADD 0
STC 2V+7
SET i 3 [#CHARS
 -4
SET i 1
#2H  0 [H POS
LDA i
#3C 000
ROL 3
STA 
 3C
BCL i
 7770
ROL 1
ADA i
 4W
STC 2
LDA i
#2V  0 [VERT POS
DSC 2
DSC i 2
XSK i 1
XSK i 1
XSK i 3
JMP 2H+1
XXX [RET



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search