/CPS TO P?S CONVERSION PROGRAM
 
/LAST EDIT:	05-NOV-1976	03:10:00	CJL
 
/USES P?S LINC-8 I/O ROUTINES ZAPPED FOR CPS CHECKSUMS
/AS NECESSARY, THEN RESTORES THEM TO P?S CHECKSUM.
/DEFAULTS TO CPS BLOCK 400 UNLESS EQUALS PARM OVERRIDES
 
	*7000
 
CPS,	TAD I	(SPARM		/GET EQUALS PARM
	CMA			/INVERT FOR TEST
	SNA			/ANY PASSED ?
	TAD	(-400-1		/NO, USE 400
	CMA			/RESET
	DCA I	(CPSBLK		/SAVE BLOCK NUMBER
	TAD I	(SOUTFLS	/GET # OF OUTPUT FILES
	SNA			/BETTER BE SOME
	JMP	BAD		/BARF
	TAD	(SFILES		/UPDATE TO FIRST INPUT FILE
	DCA	CPS		/SAVE POINTER
	DCA I	CPS		/DESTROY ANY INPUT FILES
	TAD	(SBOOT+2&177+RET/SETUP THE
	DCA I	LSBOOT		/BOOTSTRAP
	TAD	(BOTRAP		/TRAP
	DCA I	(SBOOT+2	/ADDRESS
	JMP I	(CPS2		/START IT UP
 
BOTRAP,	JMS I	(SYSIO		/CALL I/O
LSBOOT,	SBOOT			/TO BOOTSTRAP
	1^100			/THIS IS ENOUGH
	0			/USE BLOCK 0
 
BAD,	CLA			/AC MAY BE DIRTY
	TAD	(7		/GET A <BELL>
	TLS			/RING IT
	STA STL			/TURN ON SOME LIGHTS
	MQL			/TURN ON SOME MORE
	MQA			/WITH THIS
	HLT			/BARF
	JMP I	LSBOOT		/BYE, BYE
 
INEOF,	STA			/CLOSE
	JMS I	(PQWRITE	/FILE
	JMP I	LSBOOT		/BOOTSTRAP
FUDGE2,	JMS	REST		/RESTORE CODE
	TAD	("P&77+7701	/IS IT A "P" ?
	SZA CLA			/SKIP IF SO
	JMP I	(FINISH		/IGNORE
	TAD	(NOLIST-ENLIST	/<NOPUNCH>
DOENP,	TAD	(ENLIST-ELIST	/<ENPUNCH>
DOFORM,	TAD	(ELIST		/<EJECT>
	DCA	PTR		/SETUP POINTER
FORLUP,	TAD I	PTR		/GET A CHARACTER
	SNA			/END ?
	JMP I	(PUTEOL		/YES, FINISH WITH <EOL>
	JMS I	(PQWRITE	/INSERT IT
ALTEMP,	HLT			/THIS CAN'T EXECUTE ! ?
	ISZ	PTR		/BUMP TO NEXT
	JMP	FORLUP		/GO DO ANOTHER

FUDGE,	JMS	REST		/RESTORE CODE
	TAD	("E&77+7701	/IS IT AN "E" ?
	SNA			/SKIP IF NOT
	JMP	DOFORM		/JUMP IF SO
	TAD	("P-"E		/IS IT A "P" ?
	SNA			/SKIP IF NOT
	JMP	DOENP		/JUMP IF SO
	TAD	("N-"P		/IS IT AN "N" ?
	SZA CLA			/SKIP IF SO
	JMP I	(FINISH		/IGNORE IT
	CLA IAC			/INCREMENT ADDRESS
DOALT,	TAD	(FUDGIT&177+5600/GET ZAP INSTRUCTION
	DCA I	(GETC+3		/ZAP IT IN
	JMP I	(FINISH		/GO GET NEXT

REST,	0			/CODE RESTORE
	DCA	ALTEMP		/SAVE CHARACTER
	TAD	(THIS&177+3200	/GET ORIGINAL INSTRUCTION
	DCA I	(GETC+3		/PUT IT BACK
	TAD	ALTEMP		/GET CHARACTER AGAIN
	JMP I	REST		/RETURN
ELIST,	37;"E&77;"J&77;"E&77;"C&77;"T&77;0
ENLIST,	37;"E&77;"N&77;"P&77;"U&77;"N&77;"C&77;"H&77;0
NOLIST,	37;"N&77;"O&77;"P&77;"U&77;"N&77;"C&77;"H&77;0
PTR,	0			/<FF> POINTER
 
	PAGE
CPSTRT,	DCA	POINTER		/RESET BUFFER POINTER
	TAD	(4213		/\
	DCA I	(7727		/ \MAKE IT USE CPS TYPE
	TAD	(CIA		/ /CHECKSUM CONVENTION
	DCA I	(7730		//
	JMS I	(SYSIO		/CALL I/O
POINTER,0			/TO READ IN
	14^100+1		/14 CPS BLOCKS
CPSBLK,	.-.			/FILLED IN
	TAD	(CIA		/\
	DCA I	(7727		/ \RESTORE THE P?S TYPE
	TAD	(4213		/ /CHECKSUM CONVENTION
	DCA I	(7730		//
INIT,	TAD I	POINTER		/GET FIRST CHARACTER PAIR
	RTR			/GET
	RTR			/LEFT
	RTR			/FIRST
	JMS	GETC		/PUT IT OUT
	TAD I	POINTER		/GET AGAIN
	JMS	GETC		/PUT OUT LOWER CHARACTER
RESET,	ISZ	POINTER		/BUMP TO NEXT PAIR
	TAD	POINTER		/GET POINTER
	TAD	(-FILBUF	/COMPARE TO LIMIT
	SZA CLA			/SKIP IF EMPTY
	JMP	INIT		/OK, KEEP GOING
	TAD	CPSBLK		/GET CURRENT BLOCK
	TAD	(14		/UPDATE
	DCA	CPSBLK		/SAVE BACK
	JMP	CPSTRT		/GET ANOTHER BUFFER
GETC,	CPSTRT			/CHARACTER PUT ROUTINE
	CMA			/INVERT
	AND	(77		/JUST SIX-BIT
	DCA	THIS		/SAVE IT
	TAD	PREV		/GET PREVIOUS
	SNA CLA			/CASE CODE ?
	JMP	CASE		/YES
	TAD	THIS		/NO, GET LATEST
	SNA			/IS THIS ONE A CASE ?
	JMP	FNDCAS		/YES
	CMA			/NO, INVERT BACK
LOWER,	AND	(77		/JUST SIX-BIT
	SNA			/AT SIGN ?
	JMP I	(DOAT		/YES, POSSIBLY ACCENT ALSO
	TAD	(-37		/BACK ARROW ?
	SNA			/SKIP IF NOT
	JMP I	(DOBACK		/JUMP IF SO
DOTAB,	TAD	(37		/RESTORE CHARACTER
PUTIN,	AND	(77		/JUST SIX-BIT
PUTEOL,	JMS I	(PQWRITE	/WRITE OUT A CHARACTER
	SKP			/SKIP IF IT CLOSED
	JMP	FINISH		/DONE WITH THIS ONE
	ISZ	FILPTR		/BUMP TO NEXT FILE
CPS2,	TAD I	FILPTR		/GET NEXT FILE
	SNA			/END OF LIST ?
	JMP I	(BAD		/BARF
	DCA	INBLK		/SAVE INLINE
	JMS I	(PQINIT		/CALL INIT
INBLK,	.-.			/BLOCK
	144			/LINE
	12			/INCREMENT
FINISH,	TAD	THIS		/GET CURRENT
FNDCAS,	DCA	PREV		/MAKE PREVIOUS
	JMP I	GETC		/RETURN
 
FILPTR,	7757			/FILE LIST POINTER
PREV,	.			/PREVIOUS CHARACTER
THIS,	.			/CURRENT CHARACTER
FUDGIT,	FUDGE			/FUDGE POINTER #1
	FUDGE2			/#2
CASE,	TAD	THIS		/GET CURRENT
	SNA			/"?" ???
	JMP I	(DOQUES		/YES
	CMA			/INVERT BACK
	AND	(77		/JUST SIX-BIT
	TAD	(-75		/<ALT> ?
	SNA			/SKIP IF NOT
	JMP I	(DOALT		/JUMP IF SO
	TAD	(-40+75		/LOWER CASE ?
	SMA			/SKIP IF NOT
	JMP	LOWER		/FOLD IT IF SO
	TAD	(-3+40		/^C ?
	SNA			/SKIP IF NOT
	JMP I	(INEOF		/CLOSE FILES
	TAD	(-15+3		/<CR> ?
	SZA			/SKIP IF SO
	TAD	(-12+15		/<LF> ?
	SNA			/SKIP IF NEITHER
	JMP I	(DOCRLF		/JUMP IF EITHER
	TAD	(-14+12		/<FF> ?
	SNA			/SKIP IF NOT
	JMP I	(DOFORM		/JUMP IF SO
	TAD	(-11+14		/<TAB> ?
	SNA			/SKIP IF NOT
	JMP	DOTAB		/JUMP IF SO
	IAC			/<BS> ?
	SNA CLA			/SKIP IF NOT
	JMP I	(DOALT		/JUMP IF SO
	JMP	FINISH		/IGNORE
	PAGE
DOQUES,	STA			/MAKE SURE
	DCA I	(THIS		/CASE IS CLEAR
	STA			/GET A "?"
	JMP I	(PUTIN		/PUT IT IN
 
DOAT,	TAD	("<&77		/GET A "<"
	JMS I	(PQWRITE	/PUT IT IN
	HLT			/THIS CAN'T EXECUTE
	TAD	(">&77		/GET A ">"
	JMP I	(PUTIN		/FINISH THERE
 
DOBACK,	TAD	("<&77		/GET A "<"
	JMS I	(PQWRITE	/PUT IT IN
	HLT			/THIS CAN'T EXECUTE
	TAD	("<&77		/GET ANOTHER "<"
	JMP I	(PUTIN		/FINISH THERE
 
DOCRLF,	TAD	(RESET		/RESET
	DCA I	(GETC		/CO-ROUTINE
	JMP I	(PUTEOL		/FINISH THERE
/P?S FILE CREATOR

PQINIT,	0			/INITIALIZE ROUTINE
PQ7770,	SPA SNA SZL CLA		/THIS CLEARS AC
PQ7,	7			/THIS MAY BE SKIPPED
	TAD I	PQINIT		/GET FILE ARGUMENT
	AND	PQ7770		/JUST BLOCK BITS
	DCA	PQFILE		/SAVE AS BLOCK WORD
	TAD I	PQINIT		/GET FILE ARGUMENT AGAIN
	AND	PQ7		/JUST UNIT BITS
	TAD	(20^100+WRITE	/ADD ON WRITE FUNCTION
	DCA	PQFUN		/SAVE AS FUNCTION WORD
	ISZ	PQINIT		/BUMP TO NEXT ARGUMENT
	TAD I	PQINIT		/GET LINE NUMBER
	DCA	PQNUM		/SAVE IT
	ISZ	PQINIT		/BUMP TO NEXT ARGUMENT
	TAD I	PQINIT		/GET INCREMENT
	DCA	PQINC		/SAVE IT
	ISZ	PQINIT		/BUMP PAST ARGUMENT
	TAD	PQBUFF		/RESET
	DCA	PQPTR		/POINTER
	TAD	(PQLEFT+1	/RESET
	DCA	PQPUT		/CO-ROUTINE
	TAD	(6777		/INITIALIZE
	DCA	PQWORK		/WORK POINTER
	JMS	PQLINE		/FINISH EMPTY LINE
	JMP I	PQINIT		/RETURN
PQWRITE,0			/WRITE ROUTINE
PQPROT,	AND	(4077		/JUST NECESSARY BITS
	SPA			/CLOSE ?
	JMP	PQCLOSE		/YES
	SNA			/<EOL> ?
	JMP	PQEOL		/YES
	JMS	PQSTORE		/STORE CHARACTER
PQSRET,	ISZ	PQWRITE		/BUMP RETURN
	JMP I	PQWRITE		/RETURN
 
PQEOL,	JMS	PQSTORE		/STORE 0
	ISZ	PQPTR		/BUMP TO NEXT PAIR
	DCA I	PQPTR		/CLOSE FILE IN CASE LAST
	TAD	(PQLEFT+1	/RESET
	DCA	PQPUT		/CO-ROUTINE
	TAD	PQNUM		/GET LINE NUMBER
	DCA I	PQWORK		/STORE IN LINE WORD
	TAD	PQNUM		/GET CURRENT LINE NUMBER
	TAD	PQINC		/UPDATE
	DCA	PQNUM		/SAVE IT BACK
	JMS	PQLINE		/FINALIZE LINE
	TAD I	(6776		/GET LINE INFO POINTER
	TAD	PQPROT		/ADD ON PROTECTION FACTOR
	CIA			/INVERT FOR TEST
	TAD I	(6777		/COMPARE TO WORD POINTER
PQCLOSE,SMA CLA			/SKIP IF FULL
	JMP	PQSRET		/JUMP IF NOT
	JMS I	(SYSIO		/CALL I/O
PQBUFF,	3000			/TO WRITE OUT
PQFUN,	.-.			/A FULL FILE
PQFILE,	.-.			/TO THIS BLOCK
	JMS	PQINIT		/REINITIALIZE FILE
	40			/TO $:0
	144			/LINE 100
	12			/BY 10'S
	JMP I	PQWRITE		/RETURN
PQLINE,	0			/LINE FINISHING ROUTINE
	NL7775			/BACKUP 3
	TAD	PQWORK		/ADD ON CURRENT POINTER
	DCA	PQWORK		/SAVE IT
	TAD	PQWORK		/GET CURRENT POINTER
	DCA I	(6777		/SAVE AS LINE INFO POINTER
	TAD	PQPTR		/GET CURRENT POINTER
	DCA I	(6776		/SAVE AS FILE POINTER
	TAD	PQPTR		/GET CURRENT POINTER
	DCA I	PQWORK		/SAVE IN DUMMY PAIR
	ISZ	PQWORK		/BUMP TO NEXT
	STA			/-1 IS THE DUMMY LINE NUMBER
	DCA I	PQWORK		/SAVE IN DUMMY PAIR
	JMP I	PQLINE		/RETURN
 
PQSTORE,0			/STORE ROUTINE
	JMP I	PQPUT		/GO WHEREVER
 
PQPUT,	PQLEFT+1		/EXIT ROUTINE
	DCA I	PQPTR		/STORE PAIR
	JMP I	PQSTORE		/RETURN TO MAIN
 
PQLEFT,	ISZ	PQPTR		/BUMP TO NEXT PAIR
	STL RTL			/SHIFT LEFT
	STL RTL			/WITH APPROPRIATE
	STL RTL			/GARBAGE
	JMS	PQPUT		/STORE IT
	DCA	PQINIT		/SAVE PASSED CHARACTER
	TAD I	PQPTR		/GET PREVIOUS CHARACTER
	AND	PQCLOSE		/JUST HIGH SIX BITS
	TAD	PQINIT		/ADD ON LATEST CHARACTER
	JMS	PQPUT		/STORE BACK
	JMP	PQLEFT		/KEEP GOING
 
PQINC,	0			/INCREMENT
PQNUM,	0			/LINE NUMBER
PQPTR,	0			/BUFFER POINTER
PQWORK,	0			/REAR FILE POINTER
/	EQUATED SYMBOLS
 
	FILBUF=	3000		/EDITOR FILES CREATED HERE
	JMSC=	200+JMS		/CURRENT PAGE JMS INSTRUCTION
	NL7775=	CLA CLL CMA RTL	/LOAD AC WITH 7775
	RET=	5600		/RETURN INSTRUCTION
	SBOOT=	7600		/SYSTEM BOOTSTRAP
	SFILES=	7757		/FILES ARE PASSED STARTING HERE
	SOUTFLS=7607		/OUTPUT FILE COUNT
	SPARM=	7756		/= PARM HERE
	SWAL=	7604		/A-/L
	SWMX=	7605		/M-/X
	SWY9=	7606		/Y-/9
	SYSIO=	7640		/I/O ENTRY
	WRITE=	4000		/SYSIO WRITE BIT
 
	$*$*$*$*$		/THAT'S ALL FOLK!