.TITLE	CPO
/
/  16 MAR 77 (026; PDH) RE-ADJUST TO ACCOMODATE NEW CPB FOR 'FC'
/   4 MAR 77 (024; PDH) MOVE RELAY CLOSEURES TO 'FC'
/   3 MAR 77 (022; PDH) REDUCE LINE BUFFER SIZE TO 80
/   3 MAR 77 (020; PDH) DON'T FORGET TO CONVERT TO MICROSECONDS
/   1 MAR 77 (016; PDH) CONVERT TO RSX ON THE PDP-15
/   4 MAY 76 (PDH) ANNOUNCE END OF EACH 5 MINUTE SPECIAL SECTION; BEGIN
/		EACH SESSION WITH 'ATTENTION', 'SP', 'SP'
/  16 MAR 76 (PDH) FINISH IMPLEMENTATION BEGUN 11 MAR 76
/  11 MAR 76 (PDH) BEGIN IMPLEMENTATION OF SPECIAL CODE PRACTISE (VE3KSR)
/   1 MAR 76 (PDH) INCLUDE 'ATTENTION' OR 'COMMENCEMENT' SYMBOL
/   8 APR 75 (PDH) COMPLAIN IF REQUESTED SPEED TOO SLOW
/  25 SEP 74 (PDH) ADD ADDRESS SEPARATOR (AA)
/  12 SEP 74 (PDH) ALLOW 320 CHARACTER INPUT FOR QUADRUPLE SPACED LINE
/  11 SEP 74 (PDH) ADD CHARACTERS 'DOUBLE DASH', '&', 'WAIT',
/		'END OF MESSAGE', AND 'END OF COMMUNICATION'
/  21 MAY 74 - WAIT ON TTY IN CASE OF SHORT, FAST LINES.
/  15 MAY 74 - ADD TEST SECTION FOR CALIBRATING SPEED
/  13 MAY 74 - ADD PROVISION FOR USING THE RELAY BUFFER INSTEAD OF HYBRID
/  27 FEB 73 - TIDY UP SPOT ERROR ANNOUNCEMENT
/  23 OCT 72 - OUTPUT LINE COUNT ON TT
/  20 SEP 72 - CORRECT API 4 REQUEST BITS
/  30 JUN 72 - PAUL HENDERSON
/
/  PROGRAM TO READ SPECIFIED ASCII FILE AND, USING THE
/  RELAY BUFFER IN THE PDP-9, OUTPUT THE FILE IN INTERNATIONAL
/  MORSE CODE, AT A SPECIFIED RATE; IN EFFECT BEING A
/  CODE PRACTISE OSCILLATOR
/
/  PROGRAM HAS BEEN WRITTEN TO OPERATE IN EITHER FOREGROUND OR
/  ADVANCED MONITOR WITHOUT RE-ASSEMBLY OR PARAMETER INPUT.
/
	.EJECT
/  ASSIGNMENTS FOR LUNS, ETC
/
	.DEC
MCR=3
FC=29
TTO=31
TTI=31
DK=51
TICKS=15		/ NUMBER OF 60 HZ TICKS BETWEEN SPEED ADJUSTMENTS
	.OCT
X14=14
IDX=ISZ			/ INCREMENT POINTER, SKIP NEVER EXPECTED
INC=ISZ			/ INCREMENT POSITIVE COUNTER
SET=ISZ			/ SET FLAG NON-ZERO (.TRUE.)
/
BNA=716610
ELD=711500
EMP=713100
EST=713700
FLQ=715050
ILD=713000
IMP=711400
IST=713600
/
	.GLOBL	UNPACK,FILENM,OCTDEC
/
	.EJECT
CPO	CAL	CLOSE		/ MAKE SURE ANY OPEN FILES ARE CLOSED
	CAL	WRNEWL		/ MUST BEGIN WITH <CR>
	DZM	ADJFLG		/ MAKE SURE SPEED ADJUSTMENT IS DISABLED
	DZM	ADJCNT		/ CLEAR SPEED ADJUSTMENT FACTOR
	DZM	HSPACE		/ DON'T HALT ON SPACE
	LAC	(JMP SOUGHT
	DAC	SETVAR		/ ASSUME NO SPEED ADJUSTMENT
	LAC	(AMP.E
	DAC	AMPER		/ ENSURE PROPER SET UP FOR '&'
	CAL	UNMARK		/ THE FIRST TIME, THIS IS REALLY A
	LAC	(23		/ 'TSKNAM' DIRECTIVE, WHICH THEN GETS
	DAC	UNMARK		/ CONVERTED TO 'UNMARK'
/
ASPEC	LAC	(ASPC		/ 'SPECIAL CODE PRACTISE? (Y OR N) >'
	JMS	WRTTO
	CAL	READTT
	LAC	(NOP
	DAC	BRSPEC		/ ASSUME NO SPECIAL CODE PRACTISE
	DAC	BRLONG
	JMS	WTFOR
	EVTTI
/
	LAC	LINE+2
	SAD	EXIT		/ ARE WE TO EXIT FTHE PROGRAM?
	SKP
	JMP	CKYORN		/ NOT THIS TIME.
	777400
	AND	LINE+3		/ CHECK 3RD & 4TH CHARACTERS
	SAD	EXIT+1
	CAL	(10		/ EXIT HAS BEEN REQUESTED.  DO IT.
/
CKYORN	774000
	AND	LINE+2
	SAD	YES
	SKP
	JMP	ASKSPD		/ NOT 'Y' IMPLIES 'N'
/
	.EJECT
	LAC	(NOP
	DAC	SETVAR		/ ENABLE '.TIMER'
	LAC	(JMP SPADJ	/ BRANCH TO SPECIAL SECTION ON
	DAC	BRSPEC		/ CONSOLE CLOCK INTERRUPTS
	LAC	(..5
	DAC	SPDSP		/ BEGIN AT FIRST DISPATCH ADDRESS
	DZM	WTDSP		/ NO SECONDARY BRANCH ADDRESS IN 'BRLONG'
	LAC	(JMS WTLONG	/ INSERT HOOK TO GIVE LONG SPACE
	DAC	BRLONG		/ BETWEEN CHARACTERS, AND CHECK FOR 5 MIN END
	LAC	(136		/ .-... (AS)
	DAC	WTCODE		/ NOT LAST 5 MIN SECTION
	.DEC
	LAW	-480		/ SPECIAL COUNTER SET FOR 2 MIN
	JMS	SETSPEC		/ AT 4 INTERRUPTS PER SECOND
	LAC	FACTOR
	CLL
	IDIV;	20		/ 20 WPM START SPEED
	LACQ
	DAC	F3
	DAC	FSAVE		/ SAVE INITIAL SPEED FOR VARIATION CALCULATION
	CMA
	DAC	F2		/ SAVE 1'S COMPLEMENT
	LAC	FACTOR
	CLL
	IDIV;	15		/ 15 WPM AT END OF 1ST PERIOD
	LACQ
	DAC	NXTF3		/ SAVE START SPEED OF NEXT PERIOD
	ADD	F2
	DAC	F2		/ POSITIVE DIFFERENCE BETWEEN START & END
	JMP	ASKF
	.OCT
	.EJECT
ASKSPD	LAC	(ASPEED		/ 'DESIRED CODE SPEED  >'
	JMS	WRTTO
	CAL	READTT
	JMS	WTFOR
	EVTTI
	LAC	(LINE+2
	DAC	UNPCK+1
	LAC	(IMAGE
	DAC	UNPCK+2
UNPCK	JMS*	UNPACK
	0; 0
	LAC	IMAGE	/GET 1ST DIGIT
	AND	(17	/CONVERT TO BINARY
	DAC	F1	/STORE
	LAC	IMAGE+1	/GET 2ND DIGIT
	SAD	(15	/IS IT CARRIAGE RETURN?
	SKP!CLA
	SKP
	JMP	ONECHR
	LAC	IMAGE+1
	AND	(17	/CONVERT 2ND DIGIT TO BINARY
	DAC	F2	/TEMPORARY STORE
	LAC	F1	/RETRIEVE 1ST DIGIT
	ALSS	3	/SHIFT TO 10'S POSITION
	DAC	F1	/STORE
	LRSS	2	/OCTAL-DECIMAL CONVERSION REQUIRES 2*(10'S DIGIT)
	TAD	F2	/ADDED TO 1'S DIGIT
ONECHR	TAD	F1	/NOW ADD ON 10'S DIGIT VALUE
	DAC	F1	/STORE COMPLETELY CONVERTED NUMBER
	AAC	5	/IN CASE WE WISH TO SLOWLY INCREASE CODE SPEED
	DAC	F2	/BY 5 WPM OVER A PERIOD OF 15 MIN.
/
	.EJECT
SPEDOK	LAC	FACTOR	/FACTOR BASED ON BIT RATE VS WPM & 8 USEC CLOCK
	CLL
	IDIV
F1	XX
	LACQ
	DAC	F3	/STORE MULTIPLIER USED IN ELEMENT DURATION CALCULATION
	DAC	FSAVE	/ALSO SAVE HERE FOR SPEED VARIATION
/
ASKVAR	LAC	(ASKV		/ 'GRADUAL SPEED INCREASE? (Y OR N) >'
	JMS	WRTTO
	CAL	READTT
	JMS	WTFOR
	EVTTI
	774000
	AND	LINE+2	/CHECK 1ST CHARACTER IN LINE FOR
	SAD	YES	/ 'Y' ?
	SKP
	JMP	ASKF	/NOT 'Y' IMPLIES NO SPEED INCREASE
	.DEC
	LAC	FACTOR	/ (SEE ABOVE)
	.OCT
	CLL
	IDIV
F2	XX
	LACQ		/FETCH RESULT
	CMA
	ADD	F3	/CALCULATE DIFFERENCE BETWEEN START SPEED FACTOR
	DAC	F2	/AND SPEED+(5 WPM) FACTOR
	LAC	(NOP
	DAC	SETVAR	/EXECUTE ' .TIMER' TO ADJUST SPEED
/
ASKF	CAL	CLOSE		/ CLOSE FILE, IF OPEN
	LAC	(AFILE		/ 'NAME INPUT FILE (LUN 51)  >'
	JMS	WRTTO
	CAL	READTT
	JMS	WTFOR
	EVTTI
/
	.EJECT
	JMS*	FILENM
	LINE+2
	NAME
	LAC	NAME+2
	SNA
	LAC	SRC	/DEFAULT EXTENSION IS 'SRC'
	DAC	NAME+2
	CAL	SEEK
	JMS	WTFOR
	EVDK
	SAD	(-13		/ CHECK FOR REQUESTED FILE
	JMP	ASKF	/FILE NOT FOUND
SETVAR	JMP	SOUGHT
	SET	ADJFLG		/ NOW ALLOW "TIMER" TO RUN
SOUGHT	LAW	-12
	DAC	NUMCNT		/INITIALIZE NUMBERS PER LINE COUNTER
	DZM	LINCNT		/AND LINE COUNTER
	LAC	(FIRSTL
	DAC	UNPCK2+1	/ CODE PRACTISE SESSIONS ALWAYS
	LAC	(IMAGE		/ BEGIN WITH
	DAC	UNPCK2+2	/ 'ATTENTION', 'SPACE', 'SPACE'
	CAL	UNMARK		/ NULLIFY ALL PREVIOUS TIME REQUESTS
	CAL	MKBIGT		/ RE-ISSUE 'MARK' IN CASE OF SPECIAL CASE
	CAL	MK15T		/ ADJUST SPEED EVERY 250 MSEC (15 TICKS)
	JMP	UNPCK2
/
	.EJECT
WAITDK	LAC	(LINE+2
	DAC	UNPCK2+1
	LAC	(IMAGE
	DAC	UNPCK2+2
	JMS	WTFOR
	EVDK
	JMS	WTFOR		/ IN CASE OF SHORT FAST LINES
	EVTTO
	LAC	LINE
	AND	(7
	SAD	(2
	SKP!STL		/ 'STL' FOR OCTDEC
	JMP	CPO
	INC	LINCNT		/COUNT LINES
	LAC	LINCNT
	JMS*	OCTDEC		/CONVERT LINE NUMBER TO IMAGE ASCII
	IMGDIG+2
	LAC	(4003		/WORD COUNT FOR NORMAL NUMBER
	ISZ	NUMCNT		/TIME FOR CARRIAGE RETURN YET?
	JMP	NOCR
	LAW	-12
	DAC	NUMCNT		/RESET NUMBER-PER-LINE COUNTER
	LAC	(5003		/HEADER WORD FOR LAST GROUP IN LINE
NOCR	DAC	IMGDIG
	CAL	WRIMDG
UNPCK2	JMS*	UNPACK
	0; 0
	SMA
	JMP	UNPCK2
	CAL	READDK		/ READ NEXT LINE
	LAC	(IMAGE-1
	DAC*	(X14
	LAC*	X14	/PICK UP CHARACTER
	.EJECT
NXTCHR	AAC	-40		/ MAKE SURE CHAR FALLS INSIDE THE TABLE
	SPA
	JMP	CTRLCH		/ SIPHON OFF CONTROL CHARACTERS
	AAC	40-140
	SMA
	AAC	-40		/ CONVERT LOWER CASE TO UPPER CASE
	AAC	140		/ RECOVER CHARACTER
	TAD	(TABLE
	DAC	POINTR		/ POINTER TO CHARACTER TABLE
	LAC*	POINTR
	DAC	POINTR		/ POINT TO CHARACTER CONSTRUCTION CHART
LOOP	LAC*	POINTR		/ PICK UP ENTRY FROM TABLE
	SPA
	JMP	NOMARK		/ (CF. "MARK" & "SPACE")
	TCA
	DAC	MTIME		/ SAVE IT
	DZM	CLONOF		/ NO ADJUSTMENT WHILE TONE IS ON
	JMS	WAIT
	LAW	-1
NOMARK	DAC	MTIME		/ SET SPACE AT END OF ELEMENT OR CHARACTER
	LAC	ADJFLG		/ PERMIT SPEED ADJUSTMENT (IF REQUESTED)
	DAC	CLONOF		/ ONLY WHILE TONE IS OFF.
	JMS	WAIT
	LAC*	POINTR
	SPA
	JMP	CRALT		/ CHECK NEXT CHARACTER FOR END OF LINE
	IDX	POINTR		/ POINT TO NEXT CODE ELEMENT
	JMP	LOOP
CRALT	LAC*	X14
	SAD	(46		/ '&' ?
	JMP*	AMPER		/ TAKE SPECIAL ACTION ON AMPERSAND
BRLONG	JMS	WTLONG		/ CHANGED TO 'NOP' IF NOT SPECIAL CASE
	SAD	(15		/ CHECK FOR CARRIAGE RETURN
	SKP
	SAD	(175		/ & ALTMODE
	SKP
	JMP	NXTCHR
	ISZ	CCNT
	SKP!CLC
	JMP	WAITDK
	DAC	CCNT		/ PROCESS CR, ALTMODE TWICE
	TAD*	(X14
	DAC*	(X14		/ BACK UP AUTO-INDEX POINTER
CTRLCH	LAC	SPACE		/ CONTROL CHARACTERS OUTPUT AS 'SPACE'
	JMP	NOMARK
/
	.EJECT
AMP.E	LAW	-1
	TAD*	(X14		/ BACK UP AUTO-INDEX TO PROCESS '&' TWICE
	DAC*	(X14
	LAC	(105		/ AMPERSAND COMES OUT AS 'ES'
	JMS	AMPER
/
AMP.S	LAC	(123		/ 'S'
	JMS	AMPER
	JMP	AMP.E
/
AMPER	AMP.E
	JMP	NXTCHR
/
/  SUBROUTINE TO GENERATE CORRECT INTERVAL DELAY
/
WAIT	XX
	ILD+1;	MTIME		/ LOAD POSITIVE VALUE
	EMP;	F3M1
WAIT0	IMP;	(10		/ CONVERT TO MICROSECONDS
	EST+1;	DELAY		/ STORE POSITIVE
	CAL	FCPUT		/ INITIATE TIME DELAY
	LAC	CLONOF		/ ARE WE PERMITTED TO ADJUST SPEED?
	SNA
	JMP	WAIT1		/ NOT THIS TIME -- SIMPLY WAIT.
	LAC	EVMK15		/ YES.  IS IT TIME YET?
	SZA
	JMS	ADJUST		/ ADJUST SPEED AS REQUIRED
/
WAIT1	JMS	WTFOR
	EVFC
	SAD	(5
	SKP			/ SPECIFIED INTERVAL TOO SHORT?
	JMP*	WAIT
	LAC	(TSHORT		/ 'TIME INTERVAL TOO SHORT'
	JMS	WRTTO
	JMP	CPO
/
/  SUBROUTINE TO INITIATE OUTPUT TO CONTROL TTY 'TTO'
/
WRTTO	XX
	DAC	TTOCPB+4	/ ENTER WITH LINE ADDRESS IN AC
	CAL	CPOCPB		/ 'CPO: '
	CAL	TTOCPB		/ INITIATE OUTPUT
	JMP*	WRTTO
/
	.EJECT
/  SUBROUTINE TO WAIT FOR EVENT VARIABLE, AND ANNOUNCE ERROR MESSAGE
/  IF NOT ACCEPTABLE.
/
WTFOR	XX
	LAC*	WTFOR		/ GET ADDRESS OF EV
	IDX	WTFOR		/ STEP PAST ARGUMENT
	DAC	WAITFR+1	/ INSERT INTO CPB
	LAC*	WAITFR+1	/ GET EVENT VARIABLE
	SNA			/ IS IS SET ALREADY?
	CAL	WAITFR		/ NOT SET YET.  WAIT FOR IT.
	LAC*	WAITFR+1	/ GET EVENT VARIABLE
	SMA
	JMP*	WTFOR		/ POSITIVE EV IS OK
	SAD	(-6
	JMP*	WTFOR		/ UNIMPLEMENTED FUNCTIONS ARE ACCEPTED
	SAD	(-13
	JMP*	WTFOR		/ 'FILE NOT FOUND' IS NOT TERMINAL
	TCA
	CLQ!LRS	11		/ SHIFT BAD EV TO UPPER HALF OF MQ
	LAC	(6		/ OCTAL TO ASCII CONVERSION
	LLSS	3		/ SHIFT IN FIRST DIGIT
	ALSS	4
	XOR	(6		/ CONVERSION FOR 2ND DIGIT
	LLSS	3
	ALSS	4
	XOR	(6		/ CONVERSION FOR 3RD DIGIT
	DAC	ERRB		/ PUT IN LINE BUFFER
	LACQ
	XOR	(32		/ APPEND CARRIAGE RETURN
	DAC	ERRB+1
	CAL	WRERR		/ ANNOUNCE THE ERROR
	CAL	WTFMCR
	CAL	(10		/ ERROR IS TERMINAL!
/
	.EJECT
/  SUBROUTINE TO SET 'SPCNT' AND ALSO TO HAVE THE SYSTEM PERFORM
/  AN INTERVAL TIMING FOR US.
/
SETSPEC	XX
	DAC	SPCNT		/ STORE NEGATIVE OF NUMBER OF INTERVALS
	ILD+1;	SPCNT		/ LOAD POSITIVE VALUE
	IMP;	(TICKS		/ MULTIPLY BY NUMBER OF TICKS PER INTERVAL
	IST;	MKBIGT+2	/ VALUE FOR 'MARK' DIRECTIVE
	CAL	UNMARK		/ IN CASE PREVIOUS INTERVAL DID NOT EXPIRE
	CAL	MKBIGT		/ INITIATE DELAY NOTIFICATION
	JMP*	SETSPEC
/
ADJUST	0
	CAL	MK15T		/ INVOKE 'MARK' FOR ANOTHER 15 TICKS
	INC	ADJCNT	/INCREMENT SPEED INCREASE FACTOR