Reconstruct source code for FACTOR.

This is based on a disassembly of the binary AI:SYS1;TS FACTOR; the
binary and its help file .INFO.;FACTOR ORDER are both dated 1977-09-27.
MC had an identical copy with a later date.

This assembles into a binary that's identical to the original, except
that the original version has all its symbols marked as global, and no
assembly info.

Fixes #96.

build/build.tcl

@@ -1477,6 +1477,10 @@ expect ":KILL"
 respond "*" ":midas sys2;ts xhost_sysen3;xhost\r"
 expect ":KILL"
 
+# FACTOR
+respond "*" ":midas sys1;ts factor_sysen3;factor\r"
+expect ":KILL"
+
 # compile lisp compiler
 respond "*" ":link comlap;cdmacs fasl,cd.fas >\r"
 respond "*" "complr\013"

doc/_info_/factor.order

@@ -0,0 +1,33 @@
+
+FACTOR IS USED FOR FACTORING INTEGERS, AND ALSO FOR
+CALCULATIONS WITH INTEGERS < 2^70 = 10^21
+
+COMMANDS TAKE PRECEDING NUMERIC ARGUMENTS
+EXAMPLE: 1+F ADDS 1 TO THE CURRENT VALUE, AND FACTORS IT
+
+�RUBOUT IGNORES ITS ARGUMENT
+Q	FOLLOWED BY COMMAND, DESCRIBES COMMAND
+?	TYPES THIS FILE
+C	LISTS COMMANDS
+ 	SPACE STORES ARG IN CURRENT VALUE
+=	IGNORES ARG, TYPES CURRENT VALUE
+R	SETS INPUT RADIX TO ARG (MOD 2^35)
+D	SETS INPUT RADIX TO DECIMAL (IGNORES ARG)
+N	MOVES CURRENT VALUE INTO ARG SPACE; THUS N3 APPENDS A 3
+	TO THE CURRENT VALUE
+F	FACTORS ARG IF NOT ZERO; STORES INTO CURRENT VALUE
+	IF ARG IS 0, OR NO ARG, FACTORS CURRENT VALUE
+L	MOVES LARGEST FACTOR OF LAST NUMBER FACTORED
+	INTO CURRENT VALUE
++	ADDS ARG TO CURRENT VALUE
+;	ADDS ARG TO CURRENT VALUE
+-	SUBTRACTS ARG FROM CURRENT VALUE
+*	MULTIPLIES CURRENT VALUE BY ARG
+:	MULTIPLIES CURRENT VALUE BY ARG
+/	DIVIDES CURRENT VALUE BY LOW WORD OF ARG
+^	UPARROW TAKES LOW WORD OF CURRENT VALUE TO ARG POWER
+0-9	DIGITS
+
+OTHER CHARACTERS EVOKE ? AND ARE IGNORED; ANY NUMBER
+BEING ACCUMULATED IS NOT DISTURBED.
+IF PROGRAM IS RESTARTED, THE CURRENT VALUE IS NOT RESET

src/sysen3/factor.100

@@ -0,0 +1,299 @@
+;Factor integers using trial division		-*-MIDAS-*-
+;This was reconstructed in 2018 from AI:SYS1;TS FACTOR, dated 1977-09-27.
+
+Z=0
+A=1
+B=2
+C=3
+D=4
+DV=5
+E=5
+P=6
+
+TTYI=1
+TTYO=2
+FILEI=3
+.KILL TTYI, TTYO, FILEI
+
+;This is the inner loop of the trial division code - it's loaded into
+;the registers to speed it up.
+LOC 7
+;CD is the number being tested. E is the candidate factor.
+;The TRC/ADDI self-modifying code means that it alternates between
+;adding 2 and 4 to E on each iteration, so the factors it tries are
+;5, 7, 11, 13, 17, 19, 23, 25... i.e. it skips multiples of 2 and 3.
+;(See <https://oeis.org/A007310> for more about this sequence.)
+TEST:	TRC INCR,6		;Complement the 2 and 4 bits in ADDI below
+INCR:	ADDI E,2		;Next candidate; modified by TEST/NO3
+RETEST:	MOVE Z,C
+	MOVE B,D
+	IDIV Z,E		;Z := Z div E; A := Z mod E
+	DIV A,E			;A := AB div E; B := AB mod E
+	CAMLE E,A
+	 JUMPE Z,PRIME		;No more factors to try, so CD is prime
+	JUMPN B,TEST		;Not divisible by E; try the next candidate
+;That's the end of the registers; the instruction below is at 20.
+	JRST FOUND		;Found a factor (but CD may still be composite)
+
+;Entry point
+LOC 100
+G0:
+PDLL:	MOVE P,[777700,,PDL]
+	.OPEN TTYI,[10+.UAI,,'TTY]	;Open in "DDT mode" (don't echo CR etc.)
+	 .VALUE 0
+	.OPEN TTYO,[.UAO,,'TTY]
+	 .VALUE 0
+DECIMA:	MOVEI C,10.		;Base 10 input by default
+RADSET:	MOVEM C,RADX
+RESET:	PUSHJ P,PROMPT
+ZBC:	SETZB B,C		;BC holds current value; clear it
+LOOP:	PUSHJ P,TYI		;Read key and dispatch appropriately
+	CAIN A,177		;RUBOUT
+	 JRST RESET
+	CAIN A,"R
+	 JRST RADSET
+	CAIN A,"D
+	 JRST DECIMA
+	CAIE A,":
+	 CAIN A,"*
+	  JRST TIMES
+	CAIN A,"?
+	 JRST INFO
+	CAIN A,"C
+	 JRST CLIST
+	CAIN A,"Q
+	 JRST QUERY
+	CAIN A,"N
+	 JRST LOAD
+	CAIE A,";
+	CAIN A,"+
+	 JRST PLUS
+	CAIN A,"-
+	 JRST MINUS
+	CAIN A,"L
+	 JRST LARGE
+	CAIN A,"F
+	 JRST FACTOR
+	CAIN A,40		;space
+	 JRST STM2
+	CAIN A,"/
+	 JRST DIVIDE
+	CAIN A,"^
+	 JRST POWER
+	CAIN A,"=
+	 JRST EQUAL
+	CAIL A,"0
+	 CAILE A,"9
+	  JRST HUH		;Not recognised
+	IMUL B,RADX		;A digit - add it to BC
+	MUL C,RADX
+	ADDI D,777720(A)
+	TLZE D,400000
+	AOS C
+	ADD B,C
+	MOVE C,D
+	JRST LOOP
+
+INFO:	PUSHJ P,INFOPN		;Show the whole info file
+	.IOT FILEI,A
+	JUMPLE A,RESET
+	.IOT TTYO,A
+	JRST .-3
+
+INFOPN:				;Open the info file
+	.SUSET [.SSNAM,,[SIXBIT/.INFO./]]
+	.OPEN FILEI,[.UAI,,'DSK ? SIXBIT/FACTOR/ ? SIXBIT/ORDER/]
+	 JRST INFLOS
+	POPJ P,
+
+INFLOS:	SUB P,[1,,1]		;Info file can't be opened
+	MOVE B,[440700,,[ASCIZ/CAN'T OPEN INFO FILE/]]
+	JRST Q3
+
+QUERY:	PUSHJ P,INFOPN		;Look up a key in the info file
+	.IOT TTYI,B		;Get a key
+	CAIL B,"0		;Digit?
+	 CAILE B,"9
+	  JRST Q0
+	MOVE B,[440700,,[ASCIZ/	DIGIT/]]
+	JRST Q3
+Q0:	.IOT FILEI,A		;Skip chars until LF
+	JUMPL A,Q1
+	CAIE A,12
+	 JRST Q0
+	.IOT FILEI,A		;Read first char
+	CAME A,B		;Is it the key we're after?
+	 JRST Q0		;No - try next line
+	.IOT FILEI,A		;Read second char
+	JUMPL A,Q1
+	CAIE 1,11		;Is it tab?
+	 JRST Q0		;No - try next line
+	JRST Q2+1		;Found it!
+
+Q2:	.IOT FILEI,A		;Copy from file to tty until newline
+	.IOT TTYO,A
+	CAIE A,12
+	 JRST Q2
+	.IOT FILEI,A		;Does next line start with tab?
+	CAIN 1,11
+	 JRST Q2+1		;Yes - print it too
+	JRST RESET
+
+CLIST:				;List all keys we know about
+	SKIPA B,[440700,,[ASCIZ~	RD:*;+-/^NLF =QC?~]]
+Q1:				;Key not found in info file
+	 MOVE B,[440700,,[ASCIZ/	IGNORED/]]
+Q3:	ILDB 1,2		;Print the ASCIZ string in B
+	JUMPE A,RESET
+	.IOT TTYO,A
+	JRST Q3
+
+LOAD:	MOVE B,M1		;N - current value := arg
+	MOVE C,M2
+	JRST LOOP
+
+POWER:	MOVEI Z,777777(C)	;^ - power
+	MOVE A,M2
+	SETZ B,
+	MOVE C,A
+POW1:	IMUL B,A
+	MUL C,A
+	ADD B,C
+	MOVE C,D
+	SOJG Z,POW1
+	JRST STM2
+
+DIVIDE:	MOVE A,C		;/ - divide
+	MOVE B,M1
+	MOVE D,M2
+	IDIV B,A
+	DIV C,A
+	JRST STM2
+
+TIMES:	IMUL B,M2		;* or : - multiply
+	MOVE A,C
+	IMUL A,M1
+	MUL C,M2
+	ADD B,C
+	ADD B,A
+	TLZ B,400000
+	MOVEM D,M2
+	MOVEM B,M1
+	JRST ZBC
+
+MINUS:	MOVNS C			;- - subtract
+	ADD C,[400000,,]
+	AOS B
+	MOVNS B
+PLUS:	ADD C,M2		;+ - add
+	ADD B,M1
+	TLZE C,400000
+	AOS B
+STM2:	PUSHJ P,STM
+	JRST ZBC
+
+LARGE:	MOVE B,L1		;L - current value := largest factor
+	MOVE C,L2
+	JRST STM2
+
+STM:	MOVEM B,M1		;space - arg := current value
+	MOVEM C,M2
+	POPJ P,
+
+EQUAL:	MOVE A,M1		;= - print current value
+	MOVE B,M2
+	PUSHJ P,SPRAB
+	JRST RESET
+
+FACTOR:	SKIPN C			;F - factor arg
+	 SKIPE B
+	  PUSHJ P,STM		;Arg isn't 0; set current value from arg
+	MOVE D,M1		;Put number being factored into DE
+	MOVE E,M2
+TEST2:	JUMPN D,.+3		;Is DE small?
+	CAIG E,3
+	 JRST SPRIME		; DE < 3 - no need to factor
+	TRNE E,1		;Is DE divisible by 2?
+	 JRST ODD		; No
+	ASHC D,777777		;Take out a factor of 2
+	MOVEI B,2
+PRB:	SETZM A
+	PUSHJ P,SPRAB		;Print factor
+	JRST TEST2		;... and factor again
+
+ODD:	MOVE A,D		;Is DE divisible by 3?
+	MOVE C,E
+	IDIVI A,3
+	DIVI B,3
+	JUMPN C,NO3		; No
+	MOVE D,A		;Take out a factor of 3
+	MOVE E,B
+	MOVEI B,3
+	JRST PRB		;Print and factor again
+
+NO3:	MOVE C,D		;Not divisible by 2 or 3: start trial division
+	MOVE D,E
+	MOVEI E,5		;First factor to try
+	HRRI INCR,4		;Set next trial division step size
+	JRST RETEST		;... and jump into code in registers
+
+FOUND:	MOVE D,A		;Trial division found a factor
+	SETZM A
+	MOVE B,E
+	PUSHJ P,SPRAB		;Print it
+	MOVE C,Z
+	JRST RETEST		;... and keep looking (starting from existing E)
+
+SPRIME:	MOVE C,D		;DE was a trivial prime to start with
+	MOVE D,E
+PRIME:	MOVEM C,L1		;Found the largest prime factor; save it
+	MOVEM D,L2
+	MOVE A,C
+	MOVE B,D
+	PUSHJ P,SPRAB		;Print it
+	JRST RESET		;Done!
+
+SPRAB:	PUSHJ P,SPACE		;Print a space, then...
+PRAB:	MOVE C,B		;Print number in AB in decimal
+	IDIVI A,10.
+	DIVI B,10.
+	HRLM 3,(P)
+	SKIPN B
+	 SKIPE A
+	  PUSHJ P,PRAB
+	HLRZ 1,(P)
+	ADDI 1,60
+	JRST TYO
+
+SPACE:	PUSH P,A		;Print space
+	MOVEI A,40
+	PUSHJ P,TYO
+	POP P,A
+	POPJ P,
+
+HUH:	MOVEI A,"?		;Print ?
+	PUSHJ P,TYO
+	JRST LOOP
+
+PROMPT:	PUSHJ P,CR		;Print prompt
+	MOVEI A,"#
+	PUSHJ P,TYO
+CR:	MOVEI A,15		;Print CRLF - CR
+	PUSHJ P,TYO
+	MOVEI A,12		;LF
+TYO:	.IOT TTYO,A		;Print character in A
+	POPJ P,
+
+TYI:	.IOT TTYI,A		;Read character into A
+	POPJ P,
+
+PDL:	BLOCK 65.
+RADX:	BLOCK 1			;Input radix (output is always decimal)
+L1:	BLOCK 1			;L1/L2 holds largest factor found
+L2:	BLOCK 1
+M1:	BLOCK 1			;M1/M2 holds arg
+M2:	BLOCK 1
+
+CONSTA
+
+END G0