/	IPL GENERATING PROGRAM

/	LAST EDIT:	08-OCT-1991	12:00:00	CJL

/	MUST BE ASSEMBLED WITH '/F' SWITCH SET.

/	THIS  IS  A  UTILITY  NAMED  IPLGEN  (AKA  K12IPG) TO CREATE  FIELD0.IPL  (AKA
/	K12FL0.IPL)  AND  FIELD1.IPL (AKA K12FL1.IPL).  THESE FILES ARE IN TURN  MEANT
/	FOR USE WITH THE DIRECT LOADING PROGRAM IPLOAD (AKA K12IPL).  FUTURE  VERSIONS
/	OF K12MIT.SV MAY "GROW" TO USE FIELD TWO, IN WHICH CASE THIS PROGRAM WILL HAVE
/	TO BE CHANGED.

/	THIS PROGRAM ALWAYS RESIDES IN THE NEXT FIELD  BEYOND  K12MIT.SV,  AND CREATES
/	FILES FOR ALL FIELDS LOWER THAN ITS LOADING FIELD.   THIS CURRENTLY REQUIRES A
/	12K MACHINE TO ENCODE ALL LOCATIONS 00000-07577 AND 10000-17577.

/	USAGE:

/	SINCE K12MIT.SV IS A COMPLETE IMAGE FILE, IT MUST BE  LOADED  FIRST  IN  IMAGE
/	MODE, AND THEN OVERLAYED WITH THE BINARY OF THIS ASSEMBLY:

/	.PAL IPLGEN<IPLGEN/E/F			ASSEMBLE IPLGEN PROGRAM.

/	.LOAD K12MIT.SV/I$*IPLGEN/G=20200	LOAD K12MIT.SV IN IMAGE MODE;  THE $
/						INDICATES USING <ESC> TO TERMINATE
/						THE LINE; THEN LOAD IPLGEN AND START.

/	THE  FILES  SYS:FIELD0.IP AND SYS:FIELD1.IP WILL BE CREATED  AND  THE  PROGRAM
/	EXITS TO THE KEYBOARD MONITOR.  THE RESULTANT FILES  MAY  BE EDITED AS LONG AS
/	THE  RULES  OF  .IPL FORMAT ENCODING ARE OBEYED (ADDITIONAL LOWER-CASE  LEADER
/	COMMENTS  SHOULD  BE ADDED AT THE BEGINNING, AND UNRESTRICTED COMMENTS AT  THE
/	END).

/	ERROR MESSAGES:

/	ERROR NUMBER		PROBABLE CAUSE

/	5			ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.

/	6			OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.

/	7			ERROR WHILE CLOSING THE OUTPUT FILE.

/	8			I/O ERROR WHILE ENCODING FILE DATA.
/	EQUATED SYMBOLS.

	CLOSE=	4			/CLOSE OUTPUT FILE
	DFIELD=	2			/PROGRAM LOADS INTO FIELD TWO (ALSO OUTPUT COUNT)
	DFLD=	DFIELD^10		/PROGRAM FIELD FOR CDF INSTRUCTIONS
	ENTER=	3			/ENTER TENTATIVE FILE
	NL0001=	CLA IAC			/LOAD AC WITH 0001
	NL0002=	CLA CLL CML RTL		/LOAD AC WITH 0002
	NL7777=	CLA CMA			/LOAD AC WITH 7777
	SBOOT=	7600			/MONITOR EXIT
	SYSENTR=7607			/CALL SYS: HANDLER HERE
	USERROR=7			/USER SIGNALLED ERROR
	USRENT=	7700			/USR ENTRY POINT WHEN NON-RESIDENT
	USRFLD=	10			/USR FIELD
	WRITE=	4000			/I/O WRITE BIT
	FIELD	DFIELD			/WHERE WE LOAD

	*20				/GET PAST AUTO-INDEX AREA

BUFPTR,	.-.				/OUTPUT BUFFER POINTER
DANGCNT,.-.				/DANGER COUNT FOR OUTPUT FILE
FCNT,	-DFIELD				/FIELD, FILE COUNTER
FNAME,	FILENAM	FIELD0.IP		/OUTPUT FILE NAME FIELD
LATEST,	.-.				/LATEST OUTPUT CHARACTER
OUTRECO,.-.				/OUTPUT RECORD
SCRCASE,.-.				/CURRENT MESSAGE CASE
SCRCHAR,.-.				/LATEST MESSAGE CHARACTER
SCRPTR,	.-.				/MESSAGE POINTER
TEMPTR,	.-.				/TEMPORARY OUTPUT POINTER
WRDADR,	.-.				/WORD ADDRESS
WRDCNT,	.-.				/WORD COUNTER

DSETUP,	.-.				/DATA FIELD SETUP
DATFLD,	CDF	00+.-.			/WILL BE LATEST DATA FIELD
	JMP I	DSETUP			/RETURN TO CALLER
	PAGE				/START AT THE BEGINNING

BEGIN,	NOP				/IN CASE WE'RE CHAINED TO
LOOP,	TAD	(FNAME)			/POINT TO
	DCA	ENTAR1			/STORED FILENAME
	DCA	ENTAR2			/CLEAR SECOND ARGUMENT
	NL0001				/SYS: IS ALWAYS DEVICE ONE
	CDF	DFLD			/INDICATE OUR CALLING FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	(USRENTRY)		/CALL USR ROUTINE
	ENTER				/ENTER TENTATIVE FILENAME
ENTAR1,	.-.				/WILL POINT TO FILENAME
ENTAR2,	.-.				/WILL BE ZERO
	JMP	ENTERR			/ENTER ERROR
	TAD	ENTAR1			/GET RETURNED FIRST RECORD
	DCA	OUTRECORD		/STORE IT
	TAD	ENTAR2			/GET RETURNED EMPTY LENGTH
	IAC				/ADD 2-1 FOR OS/278 CRAZINESS
	DCA	DANGCNT			/STORE AS DANGER COUNT
	NL7777				/INDICATE INITIALIZATION
	JMS I	[PUTBYTE]		/INITIALIZE OUTPUT FILE
	JMS	LEADER			/OUTPUT LEADER
	JMS I	(DOFLD)			/OUTPUT LATEST FIELD'S DATA
	JMS	TRAILER			/OUTPUT TRAILER
	TAD	("Z&37)			/GET <^Z>
CLOSLUP,JMS I	[PUTBYTE]		/OUTPUT A BYTE (^Z OR NULL)
	TAD	BUFPTR			/GET THE OUTPUT BUFFER POINTER
	TAD	(-OUTBUFFER)		/COMPARE TO RESET VALUE
	SZA CLA				/SKIP IF IT MATCHES
	JMP	CLOSLUP			/ELSE KEEP GOING
	NL0001				/GET SYS:'S DEVICE NUMBER
	CDF	DFLD			/INDICATE OUR CALLING FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	(USRENTRY)		/CALL USR ROUTINE
	CLOSE				/CLOSE OUTPUT FILE
	FNAME				/POINTER TO FILENAME
OUTCNT,	.-.				/WILL BE ACTUAL COUNT
	JMP	CLSERR			/CLOSE ERROR
	ISZ	FNAME+2			/BUMP THE FILENAME
	TAD	DATFLD			/GET CURRENT DATA FIELD
	TAD	(10)			/BUMP TO NEXT FIELD
	DCA	DATFLD			/STORE BACK
	ISZ	FCNT			/DONE ALL FIELDS YET?
	JMP	LOOP			/NO, GO DO IT AGAIN
	CIF CDF	00			/YES, GOTO MONITOR FIELD
	JMP I	[SBOOT]			/EXIT TO MONITOR
/	ERROR WHILE OUTPUTTING THE FILE.

PROCERR,NL0002				/SET INCREMENT
	SKP				/DON'T USE NEXT

/	ERROR WHILE CLOSING THE OUTPUT FILE.

CLSERR,	NL0001				/SET INCREMENT
	SKP				/DON'T CLEAR IT

/	OUTPUT FILE TOO LARGE ERROR.

SIZERR,	CLA				/CLEAN UP
	TAD	(3)			/SET INCREMENT
	SKP				/DON'T USE NEXT

/	ENTER ERROR.

ENTERR,	NL0002				/SET INCREMENT
	TAD	(3)			/ADD ON OFFSET
	DCA	ERRNUMBER		/STORE ERROR NUMBER
	CDF	DFLD			/ENSURE OUR FIELD
	CIF	USRFLD			/GOTO USR FIELD
	JMS I	(USRENTRY)		/CALL USR ROUTINE
	USERROR				/USER ERROR
ERRNUMB,.-.				/WILL BE PASSED ERROR NUMBER
/	LEADER ROUTINE.

LEADER,	.-.				/LEADER ROUTINE
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
	LEADMSG				/FOR LEADER MESSAGE
	TAD	DATFLD			/GET CURRENT FIELD
	RTR;RAR				/MOVE DOWN
	AND	(7)			/JUST FIELD NUMBER
	TAD	(NTABLE)		/POINT TO TABLE ELEMENT
	DCA	MSGPTR			/STASH THE POINTER
	TAD I	MSGPTR			/GET THE MESSAGE ADDRESS
	DCA	MSGPTR			/STORE IN-LINE
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
MSGPTR,	.-.				/WILL POINT TO CORRECT MESSAGE
	JMP I	LEADER			/RETURN

/	TRAILER ROUTINE.

TRAILER,.-.				/TRAILER ROUTINE
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
	SAVEMSG				/END OF FILE MESSAGE
	JMS	OUTFLD			/OUTPUT FIELD DIGIT
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
	SVMSG				/.SV BRIDIGING MESSAGE
	JMS	OUTFLD			/OUTPUT FIELD DIGIT
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
	SV0MSG				/0000 BRIDGING MESSAGE
	JMS	OUTFLD			/OUTPUT FIELD DIGIT
	JMS I	(SCRIBE)		/CALL SCRIBE ROUTINE
	SVEMSG				/FINISHING MESSAGE
	JMP I	TRAILER			/RETURN

OUTFLD,	.-.				/OUTPUT FIELD DIGIT ROUTINE
	TAD	DATFLD			/GET OUTPUT FIELD
	RTR;RAR				/MOVE OVER
	AND	(7)			/JUST FIELD DIGIT
	TAD	("0&177)		/MAKE IT ASCII
	JMS I	[PUTBYTE]		/OUTPUT IT
	JMP I	OUTFLD			/RETURN

	PAGE
DOFLD,	.-.				/DO LATEST FIELD ROUTINE
	DCA	WRDADR			/CLEAR WORD ADDRESS
	TAD	(-7600)			/SETUP THE
	DCA	WRDCNT			/WORD COUNT
WRDLUP,	JMS	DSETUP			/GOTO DATA FIELD
	TAD I	WRDADR			/GET A WORD
	DCA	DSETUP			/SAVE IT
	CDF	DFLD			/BACK TO OUR FIELD
	TAD	DSETUP			/GET THE WORD AGAIN
	RTR;RTR;RTR			/WANT HIGH-ORDER HALF FIRST
	JMS	DOBYTE			/OUTPUT HIGH-ORDER BYTE
	TAD	DSETUP			/GET THE WORD AGAIN
	JMS	DOBYTE			/OUTPUT LOW-ORDER BYTE
	ISZ	WRDADR			/BUMP TO NEXT ADDRESS
	TAD	WRDADR			/GET LATEST ADDRESS
	AND	(37)			/JUST LOW-ORDER BITS
	SNA CLA				/SKIP IF NOT AT GOOD BOUNDARY
	JMS	PUTCRLF			/ELSE OUTPUT LINE BREAK
	ISZ	WRDCNT			/DONE ALL WORD YET?
	JMP	WRDLUP			/NO, KEEP GOING
	JMP I	DOFLD			/YES, RETURN TO CALLER

DOBYTE,	.-.				/OUTPUT A SIX-BIT BYTE ROUTINE
	AND	(77)			/JUST SIX BITS
	TAD	(41)			/ADD ON OFFSET TO MAKE IT PRINTABLE
	JMS I	[PUTBYTE]		/OUTPUT IT
	JMP I	DOBYTE			/RETURN
/	<CR>/<LF> ROUTINE.

PUTCRLF,.-.				/OUTPUT <CR>/<LF> ROUTINE
	TAD	("M&37)			/GET A <CR>
	JMS I	[PUTBYTE]		/OUTPUT IT
	TAD	("J&37)			/GET A <LF>
	JMS I	[PUTBYTE]		/OUTPUT IT
	JMP I	PUTCRLF			/RETURN

/	MESSAGE PRINT ROUTINE.

SCRIBE,	.-.				/MESSAGE PRINT ROUTINE
	TAD I	SCRIBE			/GET IN-LINE POINTER ARGUMENT
	DCA	SCRPTR			/STASH THE POINTER
	ISZ	SCRIBE			/BUMP PAST ARGUMENT
	TAD	(140)			/INITIALIZE TO
	DCA	SCRCASE			/LOWER-CASE
SCRLUP,	TAD I	SCRPTR			/GET LEFT HALF-WORD
	RTR;RTR;RTR			/MOVE OVER
	JMS	SCRPRNT			/PRINT IT
	TAD I	SCRPTR			/GET RIGHT HALF-WORD
	JMS	SCRPRNT			/PRINT IT
	ISZ	SCRPTR			/BUMP TO NEXT PAIR
	JMP	SCRLUP			/KEEP GOING

SCRPRNT,.-.				/CHARACTER PRINT ROUTINE
	AND	(77)			/JUST SIX BITS
	SNA				/END OF MESSAGE?
	JMP I	SCRIBE			/YES, RETURN TO ORIGINAL CALLER
	DCA	SCRCHAR			/NO, SAVE FOR NOW
	TAD	SCRCHAR			/GET IT BACK
	TAD	(-"%!200)		/IS IT "%"?
	SNA				/SKIP IF NOT
	JMP	SCRCRLF			/JUMP IF IT MATCHES
	TAD	(-"^+100+"%)		/IS IT "^"
	SNA CLA				/SKIP IF NOT
	JMP	SCRFLIP			/JUMP IF IT MATCHES
	TAD	SCRCHAR			/GET THE CHARACTER
	AND	(40)			/DOES CASE MATTER?
	SNA CLA				/SKIP IF NOT
	TAD	SCRCASE			/ELSE GET PREVAILING CASE
	TAD	SCRCHAR			/GET THE CHARACTER
        JMS I	[PUTBYTE]		/OUTPUT THE CHARACTER
	JMP I	SCRPRNT			/RETURN

SCRCRLF,JMS	PUTCRLF			/OUTPUT <CR>/<LF>
	JMP I	SCRPRNT			/RETURN

SCRFLIP,TAD	SCRCASE			/GET CURRENT CASE
	CIA				/INVERT IT
	TAD	(140+100)		/ADD SUM OF POSSIBLE VALUES
	DCA	SCRCASE			/STORE NEW INVERTED CASE
	JMP I	SCRPRNT			/RETURN
	PAGE
PUTBYTE,.-.				/OUTPUT A BYTE ROUTINE
	SPA				/ARE WE INITIALIZING?
	JMP	PUTINITIALIZE		/YES
	AND	(177)			/JUST IN CASE
	DCA	LATEST			/SAVE LATEST CHARACTER
	TAD	LATEST			/GET LATEST CHARACTER
	JMP I	PUTNEXT			/GO WHERE YOU SHOULD GO

PUTNEXT,.-.				/EXIT ROUTINE
	JMP I	PUTBYTE			/RETURN TO MAIN CALLER

PUTINIT,CLA				/CLEAN UP
	TAD	OUTRECORD		/GET STARTING RECORD OF TENTATIVE FILE
	DCA	PUTRECORD		/STORE IN-LINE
	DCA I	(OUTCNT)		/CLEAR ACTUAL FILE LENGTH
PUTNEWR,TAD	(OUTBUFFER)		/SETUP THE
	DCA	BUFPTR			/BUFFER POINTER
PUTLOOP,JMS	PUTNEXT			/GET A CHARACTER
	DCA I	BUFPTR			/STORE IT
	TAD	BUFPTR			/GET POINTER VALUE
	DCA	TEMPTR			/SAVE FOR LATER
	ISZ	BUFPTR			/BUMP TO NEXT
	JMS	PUTNEXT			/GET A CHARACTER
	DCA I	BUFPTR			/STORE IT
	JMS	PUTNEXT			/GET A CHARACTER
	RTL;RTL				/MOVE UP
	AND	(7400)			/ISOLATE HIGH NYBBLE
	TAD I	TEMPTR			/ADD ON FIRST BYTE
	DCA I	TEMPTR			/STORE COMPOSITE
	TAD	LATEST			/GET LATEST CHARACTER
	RTR;RTR;RAR			/MOVE UP AND
	AND	(7400)			/ISOLATE LOW NYBBLE
	TAD I	BUFPTR			/ADD ON SECOND BYTE
	DCA I	BUFPTR			/STORE COMPOSITE
	ISZ	BUFPTR			/BUMP TO NEXT
	TAD	BUFPTR			/GET LATEST POINTER VALUE
	TAD	(-2^200-OUTBUFFER)	/COMPARE TO LIMIT
	SZA CLA				/SKIP IF AT END
	JMP	PUTLOOP			/KEEP GOING
	ISZ	DANGCNT			/TOO MANY RECORDS?
	SKP				/SKIP IF NOT
	JMP I	(SIZERR)		/JUMP IF SO
	CDF	DFLD			/SET OUR FIELD
	CIF	00			/GOING TO SYSTEM FIELD
	JMS I	(SYSENTRY)		/CALL I/O HANDLER
	2^100+DFLD+WRITE		/WRITE SOME PAGES FROM OUTPUT BUFFER
	OUTBUFFER			/BUFFER ADDRESS
PUTRECO,.-.				/WILL BE LATEST RECORD NUMBER
	JMP I	(PROCERR)		/OUTPUT ERROR!
	ISZ I	(OUTCNT)		/BUMP ACTUAL LENGTH
	ISZ	PUTRECORD		/BUMP TO NEXT RECORD
	JMP	PUTNEWRECORD		/KEEP GOING
	PAGE
/	TEXT MESSAGES.

LEADMSG,TEXT	"LEADER FOR DIRECT LOAD FILE WHICH MUST BE IN LOWER CASE%"
	TEXT	"%FILE CONTAINS KERMIT DATA IN IPL ENCODED FORMAT%%"
	TEXT	"THIS FILE CONTAINS DATA FOR FIELD"
ONEMSG,	TEXT	" ONE%%^"
SAVEMSG,TEXT	"END OF DATA%%^A^FTER THE PROGRAM EXITS BACK TO THE MONITOR, "
	TEXT	"YOU SHOULD SAVE THE DATA WITH:%%.^SAVE SYS FIELD^"
SVMSG,	TEXT	".^SV "
SV0MSG,	TEXT	"0000-"
SVEMSG,	TEXT	"7577=0%"
ZEROMSG,TEXT	" ZERO%%"
/	DIGIT MESSAGE POINTER TABLE.

NTABLE,	ZEROMSG				/POINTER TO ZERO MESSAGE
	ONEMSG				/POINTER TO ONE MESSAGE

	PAGE				/GET TO A GOOD BOUNDARY

	OUTBUFF=.			/OUTPUT BUFFER HERE

	$				/THAT'S ALL FOLK!
