*20
/	GENASYS		PROGRAM FOR BUILDING A DIAL-MS TAPE
/
B1=1
B2=2
B3=3
B4=4
MSISW=10
RPLYSW=11
REPLY=12
/
/
/	FRED ENTRY POINTS
/
LOOKUP=20
READ=30
WRITE=35
/
/
	PMODE
/
	*400
/
/
	0002			/FORCE PMODE
	CLA
	TLS			/PRIME THE TTY
	DCA	MSISW
	DCA	RPLYSW
	TAD	TESTV		/GET CORE-TEST VALUE
	CDF	10		/TRY TO SET FIELD 1
	DCA I	P0		/STORE TEST VALUE AT 0, FIELD 1
	DCA	0		/CLEAR 0, FIELD 0
	TAD I	P0		/GET TEST VALUE FROM FIELD 1
	CDF	0
	CIA
	TAD	TESTV		/COMPARE RESULT TO TEST
	SZA CLA
	JMP I	PNOT8K		/BOMB IF NOT EQUAL
/
	CLA CMA
	DCA	RPLYSW		/SET REPLY EXPECTED
START,	JMS I	PDISP
	ASKIN
	TAD	MZERO
	SPA			/REPLY GT ZERO?
	JMP	START		/NO - TRY AGIN
	TAD	M7		/GT 7?
	SMA SZA CLA
	JMP	START		/YES - TRY AGAIN
	TAD	REPLY
	TAD	MZERO
	DCA I	PLOOK		/SET LOOKUP UNIT
	DCA	RPLYSW		/SET NO REPLY
/
	EJECT
/
/	THE CORE IS THERE - FIND THE DIAL-MS FILES
/
	LINC
	LMODE
	SET I	B1		/FILE NAME MODIFIERS
	NUMBS-4000
	SET I	B2		/FILE COUNT
	-4
	SET I	B3		/POINTER PUSH-DOWN LIST
	LOCLST-1
	SET I	B4		/LENGTH VERIFICATION LIST
	LENCHK-1
LOOKLP,	LDH I	B1		/GET NUMBER
	STH			/INSERT IN LOOKUP PARAMS
	LOOK+4004
	LDA I			/PARAM LIST POINTER
	LOOK
	LIF	3
	JMP	LOOKUP
	JMP	NOFIND		/FILE ISNT THERE
	LDA			/GET STARTING BLOCK
	LOOK+6
	STA I	B3		/ONTO PUSH LIST
	LDA
	LOOK+7			/LENGTH
	STA I	B3		/ALSO ON LIST
	ADA I	B4		/CHECK LENGTH
	AZE
	JMP	WRONGL
	XSK I	B2
	JMP	LOOKLP		/LOOP TO GET FOUR FILES
/
/	ALL FILES ARE OK - ASK WHAT UNIT HE WANTS
/
	PDP
	PMODE
	CLA CMA
	DCA	RPLYSW		/SET REPLY-EXPECTED SW
/
RESTART,JMS I	PDISP		/ASK FOR OUTPUT UNIT
	ASKOUT
	TAD	MZERO
	SPA			/REPLY GE ZERO?
	JMP	RESTART		/NO - TRY AGAIN
	TAD	M7
	SMA SZA CLA		/GREATER THAN 7?
	JMP	RESTART		/YES - TRY AGAIN
	TAD	REPLY
	TAD	MZERO		/VALID UNIT
	LINC
	LMODE
	BSE I			/SET FIELD BIT FOR WRITING
	1000
	STC	WRPARM		/SET OUTPUT UNIT
	ADD	LOOK		/GET UNIT NO
	BSE I			/INSERT FIELD BITS
	1000
	STC	RDPARM		/SET INPUT UNIT
/
/	NOW COPY THE FILE
/
	SET I	B1		/STARTING TBLKS LIST
	STARTS-1
	SET I	B2		/FILE COUNT
	-4
	SET I	B3		/INPUT LIST
	LOCLST-1
COPYLP,	LDA I	B3		/INPUT STARTING TBLK
	STC	RDPARM+2	/TO PARAMETER LIST
	LDA I	B3		/INPUT LENGTH
	STA			/TO OUTPUT LIST
	WRPARM+3
	STC	RDPARM+3	/AND INPUT LIST
	LDA I	B1		/OUTPUT TBLK
	STC	WRPARM+2	/TO OUTPUT PARMS
	LDA I			/ADDR OF INPUT LIST
	RDPARM
	LIF	3
	JMP	READ
	LDA I			/ADDR OF OUTPUT LIST
	WRPARM
	LIF	3
	JMP	WRITE
	XSK I	B2		/CHECK COUNT
	JMP	COPYLP		/LOOP TIL DONE
	LDA			/GET OUTPUT UNIT
	WRPARM
	BCL I			/DROP JUNK
	7770
	AZE			/UNIT ZERO?
	JMP	DRSTRT		/NO - RETURN TO DIAL
	SET I	MSISW		/SET INIT SWITCH
	7777
	PDP
	PMODE
	DCA	RPLYSW		/NO REPLY
	JMS I	PDISP
	INIT
	HLT			/WAIT FOR CONTINUE
	JMS I	PDISP
	HELP2
	JMP I	.+1
	DRSTRT
/
	EJECT
/
TESTV,	707
P0,	0
MZERO,	-260
M7,	-7
PDISP,	DISPLAY
PNOT8K,	NOT8K
PLOOK,	LOOK
/
/
/
	PAGE
/
/
NOT8K,	JMS	DISPLAY
	MESS1			/INSUFFICIENT CORE
	JMP	DRSTRT
/
/
/
	LMODE
NOFIND,	LDH	B1		/FILE NUMBER MISSING
	STH			/TO MESSAGE
	MESS2A
	PDP
	PMODE
	JMS	DISPLAY
	MESS2
	JMP I	PSTART		/TRY FOR ANOTHER UNIT
PSTART,	START
/
/
/
	LMODE
WRONGL,	LDH	B1		/FILE NUMBER IN ERROR
	STH			/TO FILE LENGTH ERROR MESSAGE
	MESS3A
	PDP
	PMODE
	JMS	DISPLAY
	MESS3
/
/	THATS THE JOB
/
DRSTRT,	0002			/FROM ANYTHING TO PDP MODE
	TSF			/WAIT FOR TTY COMPLETION
	JMP	.-1
	CLA
	LINC			/LINC MODE FOR EXIT
	LMODE
	AXO			/CLEAR TAPE
	LDA I
	20
	ESF			/DO I/O PRESET
	SET I	B1		/POINT BEFORE 16 IN SEGMENT 2
	2015
	LDF	2
	LDA I			/DIAL STARTUP COMMAND
	RCG
	STA I	B1		/MOVED TO SEGMENT 2
	LDA I			/NORMAL START
	7300
	XSK	MSISW		/INIT START?
	JMP	.+3		/NO - USE 7300
	ADA I			/YES - USE 7310
	10
	STA I	B1		/MOVE THAT TO SEG 2
	LDF	3
	LIF	2		/DIAL STARTS IN SEG 2
	JMP	16
/
	EJECT
/
	PMODE
/
DISPLAY,0
	CLA
	TAD I	DISPLAY		/MESSAGE ADDRESS
	DCA	LPOINT
	ISZ	DISPLAY
DSPLP,	TAD I	LPOINT		/GET LEFT CHARACTER
	RTR
	RTR
	RTR
	JMS	CVTO		/GET ASCII FROM 6BIT
	JMS	TTYO		/TYPE IT
	TAD I	LPOINT		/GET RIGHT CHAR
	JMS	CVTO
	JMS	TTYO
	ISZ	LPOINT
	JMP	DSPLP
/				CONVERT TO ASCII FROM 6BIT
CVTO,	0
	AND	P77
	SNA			/CHECK FOR END OF MESSAGE
	JMP	RDREPLY
	TAD	MBLNK		/COMPARE TO BLANK
	SPA
	TAD	P100		/01-37 BECOMES 301-337
	TAD	P240		/40-77 BECOMES 240-277
	JMP I	CVTO
/				PRINT ON TTY
TTYO,	0
	TSF			/WAIT FOR FLAG
	JMP	.-1
	TLS
	CLA
	JMP I	TTYO
/				WAIT FOR REPLY
RDREPLY,TAD	RPLYSW		/REPLY EXPECTED?
	SNA CLA
	JMP	NORPLY		/NO
	KSF
	JMP	.-1
	KRB
	DCA	REPLY		/HOLD RESPONSE
	TAD	REPLY
	JMS	TTYO		/ECHO
NORPLY,	TAD	CARRET
	JMS	TTYO
	TAD	LINFED
	JMS	TTYO
	TAD	REPLY
	JMP I	DISPLAY
/
	EJECT
/
CARRET,	215
LINFED,	212
LPOINT,	0
P77,	77
MBLNK,	-40
P100,	100
P240,	240
/
/
	LMODE
/
/
/
/
LOOK,	0
	TEXT	"DIAL-MS "
	TEXT	" B"
	0
	0
/
RDPARM,	1000
	0;0;0
/
WRPARM,	1000
	0;0;0
/
/
LENCHK,	-20;-20;-6;-20
/
NUMBS,	TEXT	"1234"
/
STARTS,	300;320;340;350
/
LOCLST,	0;0
	0;0
	0;0
	0;0
/
ASKIN,	TEXT	"TAPE UNIT CONTAINING GENASYS:"
	0
/
ASKOUT,	TEXT	"TAPE UNIT FOR DIAL-MS:"
	0
MESS1,	TEXT	"THIS MACHINE HAS ONLY 4K. DIAL-MS REQUIRES 8K."
	0
MESS2,	TEXT	"THIS TAPE DOES NOT CONTAIN BINARY DIAL-MS "
MESS2A=.-4000
	TEXT	", NEEDED FOR GENASYS."
	0
MESS3,	TEXT	"LENGTH ERROR IN DIAL-MS "
MESS3A=.-4000
	0
INIT,	TEXT	"PRESS CONTINUE TO INITIALIZE DIAL-MS."
	0
HELP2,	TEXT	"WHEN EDITOR DISPLAY APPEARS, TYPE (LINE FEED)EX(RETURN)."
	0
/
/