[pdp8.git] / sw / kermit / hachti / K12IPG.PA

/	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.
\f/	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
\f	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
\f	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
\f/	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
\f/	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
\fDOFLD,	.-.				/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
\f/	<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
\f	PAGE
\fPUTBYTE,.-.				/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
\f	PAGE
\f/	TEXT MESSAGES.

LEADMSG,TEXT	"LEADER FOR DIRECT LOAD FILE WHICH MUST BE IN LOWER CASE%"
	TEXT	"%FILE CONTAINS KERMIT DATA IN IPL ENCODED FORMAT%%"
\f	TEXT	"THIS FILE CONTAINS DATA FOR FIELD"
ONEMSG,	TEXT	" ONE%%^"
SAVEMSG,TEXT	"END OF DATA%%^A^FTER THE PROGRAM EXITS BACK TO THE MONITOR, "
\f	TEXT	"YOU SHOULD SAVE THE DATA WITH:%%.^SAVE SYS FIELD^"
SVMSG,	TEXT	".^SV "
SV0MSG,	TEXT	"0000-"
SVEMSG,	TEXT	"7577=0%"
ZEROMSG,TEXT	" ZERO%%"
\f/	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!
Commit	Line	Data
81e70d48 PH	1	/ IPL GENERATING PROGRAM
	2
	3	/ LAST EDIT: 08-OCT-1991 12:00:00 CJL
	4
	5	/ MUST BE ASSEMBLED WITH '/F' SWITCH SET.
	6
	7	/ THIS IS A UTILITY NAMED IPLGEN (AKA K12IPG) TO CREATE FIELD0.IPL (AKA
	8	/ K12FL0.IPL) AND FIELD1.IPL (AKA K12FL1.IPL). THESE FILES ARE IN TURN MEANT
	9	/ FOR USE WITH THE DIRECT LOADING PROGRAM IPLOAD (AKA K12IPL). FUTURE VERSIONS
	10	/ OF K12MIT.SV MAY "GROW" TO USE FIELD TWO, IN WHICH CASE THIS PROGRAM WILL HAVE
	11	/ TO BE CHANGED.
	12
	13	/ THIS PROGRAM ALWAYS RESIDES IN THE NEXT FIELD BEYOND K12MIT.SV, AND CREATES
	14	/ FILES FOR ALL FIELDS LOWER THAN ITS LOADING FIELD. THIS CURRENTLY REQUIRES A
	15	/ 12K MACHINE TO ENCODE ALL LOCATIONS 00000-07577 AND 10000-17577.
	16
	17	/ USAGE:
	18
	19	/ SINCE K12MIT.SV IS A COMPLETE IMAGE FILE, IT MUST BE LOADED FIRST IN IMAGE
	20	/ MODE, AND THEN OVERLAYED WITH THE BINARY OF THIS ASSEMBLY:
	21
	22	/ .PAL IPLGEN<IPLGEN/E/F ASSEMBLE IPLGEN PROGRAM.
	23
	24	/ .LOAD K12MIT.SV/I$*IPLGEN/G=20200 LOAD K12MIT.SV IN IMAGE MODE; THE $
	25	/ INDICATES USING <ESC> TO TERMINATE
	26	/ THE LINE; THEN LOAD IPLGEN AND START.
	27
	28	/ THE FILES SYS:FIELD0.IP AND SYS:FIELD1.IP WILL BE CREATED AND THE PROGRAM
	29	/ EXITS TO THE KEYBOARD MONITOR. THE RESULTANT FILES MAY BE EDITED AS LONG AS
	30	/ THE RULES OF .IPL FORMAT ENCODING ARE OBEYED (ADDITIONAL LOWER-CASE LEADER
	31	/ COMMENTS SHOULD BE ADDED AT THE BEGINNING, AND UNRESTRICTED COMMENTS AT THE
	32	/ END).
	33
	34	/ ERROR MESSAGES:
	35
	36	/ ERROR NUMBER PROBABLE CAUSE
	37
	38	/ 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
	39
	40	/ 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
	41
	42	/ 7 ERROR WHILE CLOSING THE OUTPUT FILE.
	43
	44	/ 8 I/O ERROR WHILE ENCODING FILE DATA.
	45	\f/ EQUATED SYMBOLS.
	46
	47	CLOSE= 4 /CLOSE OUTPUT FILE
	48	DFIELD= 2 /PROGRAM LOADS INTO FIELD TWO (ALSO OUTPUT COUNT)
	49	DFLD= DFIELD^10 /PROGRAM FIELD FOR CDF INSTRUCTIONS
	50	ENTER= 3 /ENTER TENTATIVE FILE
	51	NL0001= CLA IAC /LOAD AC WITH 0001
	52	NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
	53	NL7777= CLA CMA /LOAD AC WITH 7777
	54	SBOOT= 7600 /MONITOR EXIT
	55	SYSENTR=7607 /CALL SYS: HANDLER HERE
	56	USERROR=7 /USER SIGNALLED ERROR
	57	USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT
	58	USRFLD= 10 /USR FIELD
	59	WRITE= 4000 /I/O WRITE BIT
	60	\f FIELD DFIELD /WHERE WE LOAD
	61
	62	*20 /GET PAST AUTO-INDEX AREA
	63
	64	BUFPTR, .-. /OUTPUT BUFFER POINTER
65	DANGCNT,.-. /DANGER COUNT FOR OUTPUT FILE
66	FCNT, -DFIELD /FIELD, FILE COUNTER
67	FNAME, FILENAM FIELD0.IP /OUTPUT FILE NAME FIELD
68	LATEST, .-. /LATEST OUTPUT CHARACTER
69	OUTRECO,.-. /OUTPUT RECORD
70	SCRCASE,.-. /CURRENT MESSAGE CASE
71	SCRCHAR,.-. /LATEST MESSAGE CHARACTER
72	SCRPTR, .-. /MESSAGE POINTER
73	TEMPTR, .-. /TEMPORARY OUTPUT POINTER
74	WRDADR, .-. /WORD ADDRESS
75	WRDCNT, .-. /WORD COUNTER
76
77	DSETUP, .-. /DATA FIELD SETUP
78	DATFLD, CDF 00+.-. /WILL BE LATEST DATA FIELD
79	JMP I DSETUP /RETURN TO CALLER
80	\f PAGE /START AT THE BEGINNING
81
82	BEGIN, NOP /IN CASE WE'RE CHAINED TO
83	LOOP, TAD (FNAME) /POINT TO
84	DCA ENTAR1 /STORED FILENAME
85	DCA ENTAR2 /CLEAR SECOND ARGUMENT
86	NL0001 /SYS: IS ALWAYS DEVICE ONE
87	CDF DFLD /INDICATE OUR CALLING FIELD
88	CIF USRFLD /GOTO USR FIELD
89	JMS I (USRENTRY) /CALL USR ROUTINE
90	ENTER /ENTER TENTATIVE FILENAME
91	ENTAR1, .-. /WILL POINT TO FILENAME
92	ENTAR2, .-. /WILL BE ZERO
93	JMP ENTERR /ENTER ERROR
94	TAD ENTAR1 /GET RETURNED FIRST RECORD
95	DCA OUTRECORD /STORE IT
96	TAD ENTAR2 /GET RETURNED EMPTY LENGTH
97	IAC /ADD 2-1 FOR OS/278 CRAZINESS
98	DCA DANGCNT /STORE AS DANGER COUNT
99	NL7777 /INDICATE INITIALIZATION
100	JMS I [PUTBYTE] /INITIALIZE OUTPUT FILE
101	JMS LEADER /OUTPUT LEADER
102	JMS I (DOFLD) /OUTPUT LATEST FIELD'S DATA
103	JMS TRAILER /OUTPUT TRAILER
104	TAD ("Z&37) /GET <^Z>
105	CLOSLUP,JMS I [PUTBYTE] /OUTPUT A BYTE (^Z OR NULL)
106	TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
107	TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
108	SZA CLA /SKIP IF IT MATCHES
109	JMP CLOSLUP /ELSE KEEP GOING
110	NL0001 /GET SYS:'S DEVICE NUMBER
111	CDF DFLD /INDICATE OUR CALLING FIELD
112	CIF USRFLD /GOTO USR FIELD
113	JMS I (USRENTRY) /CALL USR ROUTINE
114	CLOSE /CLOSE OUTPUT FILE
115	FNAME /POINTER TO FILENAME
116	OUTCNT, .-. /WILL BE ACTUAL COUNT
117	JMP CLSERR /CLOSE ERROR
118	ISZ FNAME+2 /BUMP THE FILENAME
119	TAD DATFLD /GET CURRENT DATA FIELD
120	TAD (10) /BUMP TO NEXT FIELD
121	DCA DATFLD /STORE BACK
122	ISZ FCNT /DONE ALL FIELDS YET?
123	JMP LOOP /NO, GO DO IT AGAIN
124	CIF CDF 00 /YES, GOTO MONITOR FIELD
125	JMP I [SBOOT] /EXIT TO MONITOR
126	\f/ ERROR WHILE OUTPUTTING THE FILE.
127
128	PROCERR,NL0002 /SET INCREMENT
129	SKP /DON'T USE NEXT
130
131	/ ERROR WHILE CLOSING THE OUTPUT FILE.
132
133	CLSERR, NL0001 /SET INCREMENT
134	SKP /DON'T CLEAR IT
135
136	/ OUTPUT FILE TOO LARGE ERROR.
137
138	SIZERR, CLA /CLEAN UP
139	TAD (3) /SET INCREMENT
140	SKP /DON'T USE NEXT
141
142	/ ENTER ERROR.
143
144	ENTERR, NL0002 /SET INCREMENT
145	TAD (3) /ADD ON OFFSET
146	DCA ERRNUMBER /STORE ERROR NUMBER
147	CDF DFLD /ENSURE OUR FIELD
148	CIF USRFLD /GOTO USR FIELD
149	JMS I (USRENTRY) /CALL USR ROUTINE
150	USERROR /USER ERROR
151	ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
152	\f/ LEADER ROUTINE.
153
154	LEADER, .-. /LEADER ROUTINE
155	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
156	LEADMSG /FOR LEADER MESSAGE
157	TAD DATFLD /GET CURRENT FIELD
158	RTR;RAR /MOVE DOWN
159	AND (7) /JUST FIELD NUMBER
160	TAD (NTABLE) /POINT TO TABLE ELEMENT
161	DCA MSGPTR /STASH THE POINTER
162	TAD I MSGPTR /GET THE MESSAGE ADDRESS
163	DCA MSGPTR /STORE IN-LINE
164	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
165	MSGPTR, .-. /WILL POINT TO CORRECT MESSAGE
166	JMP I LEADER /RETURN
167
168	/ TRAILER ROUTINE.
169
170	TRAILER,.-. /TRAILER ROUTINE
171	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
172	SAVEMSG /END OF FILE MESSAGE
173	JMS OUTFLD /OUTPUT FIELD DIGIT
174	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
175	SVMSG /.SV BRIDIGING MESSAGE
176	JMS OUTFLD /OUTPUT FIELD DIGIT
177	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
178	SV0MSG /0000 BRIDGING MESSAGE
179	JMS OUTFLD /OUTPUT FIELD DIGIT
180	JMS I (SCRIBE) /CALL SCRIBE ROUTINE
181	SVEMSG /FINISHING MESSAGE
182	JMP I TRAILER /RETURN
183
184	OUTFLD, .-. /OUTPUT FIELD DIGIT ROUTINE
185	TAD DATFLD /GET OUTPUT FIELD
186	RTR;RAR /MOVE OVER
187	AND (7) /JUST FIELD DIGIT
188	TAD ("0&177) /MAKE IT ASCII
189	JMS I [PUTBYTE] /OUTPUT IT
190	JMP I OUTFLD /RETURN
191
192	PAGE
193	\fDOFLD, .-. /DO LATEST FIELD ROUTINE
194	DCA WRDADR /CLEAR WORD ADDRESS
195	TAD (-7600) /SETUP THE
196	DCA WRDCNT /WORD COUNT
197	WRDLUP, JMS DSETUP /GOTO DATA FIELD
198	TAD I WRDADR /GET A WORD
199	DCA DSETUP /SAVE IT
200	CDF DFLD /BACK TO OUR FIELD
201	TAD DSETUP /GET THE WORD AGAIN
202	RTR;RTR;RTR /WANT HIGH-ORDER HALF FIRST
203	JMS DOBYTE /OUTPUT HIGH-ORDER BYTE
204	TAD DSETUP /GET THE WORD AGAIN
205	JMS DOBYTE /OUTPUT LOW-ORDER BYTE
206	ISZ WRDADR /BUMP TO NEXT ADDRESS
207	TAD WRDADR /GET LATEST ADDRESS
208	AND (37) /JUST LOW-ORDER BITS
209	SNA CLA /SKIP IF NOT AT GOOD BOUNDARY
210	JMS PUTCRLF /ELSE OUTPUT LINE BREAK
211	ISZ WRDCNT /DONE ALL WORD YET?
212	JMP WRDLUP /NO, KEEP GOING
213	JMP I DOFLD /YES, RETURN TO CALLER
214
215	DOBYTE, .-. /OUTPUT A SIX-BIT BYTE ROUTINE
216	AND (77) /JUST SIX BITS
217	TAD (41) /ADD ON OFFSET TO MAKE IT PRINTABLE
218	JMS I [PUTBYTE] /OUTPUT IT
219	JMP I DOBYTE /RETURN
220	\f/ <CR>/<LF> ROUTINE.
221
222	PUTCRLF,.-. /OUTPUT <CR>/<LF> ROUTINE
223	TAD ("M&37) /GET A <CR>
224	JMS I [PUTBYTE] /OUTPUT IT
225	TAD ("J&37) /GET A <LF>
226	JMS I [PUTBYTE] /OUTPUT IT
227	JMP I PUTCRLF /RETURN
228
229	/ MESSAGE PRINT ROUTINE.
230
231	SCRIBE, .-. /MESSAGE PRINT ROUTINE
232	TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT
233	DCA SCRPTR /STASH THE POINTER
234	ISZ SCRIBE /BUMP PAST ARGUMENT
235	TAD (140) /INITIALIZE TO
236	DCA SCRCASE /LOWER-CASE
237	SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD
238	RTR;RTR;RTR /MOVE OVER
239	JMS SCRPRNT /PRINT IT
240	TAD I SCRPTR /GET RIGHT HALF-WORD
241	JMS SCRPRNT /PRINT IT
242	ISZ SCRPTR /BUMP TO NEXT PAIR
243	JMP SCRLUP /KEEP GOING
244
245	SCRPRNT,.-. /CHARACTER PRINT ROUTINE
246	AND (77) /JUST SIX BITS
247	SNA /END OF MESSAGE?
248	JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER
249	DCA SCRCHAR /NO, SAVE FOR NOW
250	TAD SCRCHAR /GET IT BACK
251	TAD (-"%!200) /IS IT "%"?
252	SNA /SKIP IF NOT
253	JMP SCRCRLF /JUMP IF IT MATCHES
254	TAD (-"^+100+"%) /IS IT "^"
255	SNA CLA /SKIP IF NOT
256	JMP SCRFLIP /JUMP IF IT MATCHES
257	TAD SCRCHAR /GET THE CHARACTER
258	AND (40) /DOES CASE MATTER?
259	SNA CLA /SKIP IF NOT
260	TAD SCRCASE /ELSE GET PREVAILING CASE
261	TAD SCRCHAR /GET THE CHARACTER
262	JMS I [PUTBYTE] /OUTPUT THE CHARACTER
263	JMP I SCRPRNT /RETURN
264
265	SCRCRLF,JMS PUTCRLF /OUTPUT <CR>/<LF>
266	JMP I SCRPRNT /RETURN
267
268	SCRFLIP,TAD SCRCASE /GET CURRENT CASE
269	CIA /INVERT IT
270	TAD (140+100) /ADD SUM OF POSSIBLE VALUES
271	DCA SCRCASE /STORE NEW INVERTED CASE
272	JMP I SCRPRNT /RETURN
273	\f PAGE
274	\fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE
275	SPA /ARE WE INITIALIZING?
276	JMP PUTINITIALIZE /YES
277	AND (177) /JUST IN CASE
278	DCA LATEST /SAVE LATEST CHARACTER
279	TAD LATEST /GET LATEST CHARACTER
280	JMP I PUTNEXT /GO WHERE YOU SHOULD GO
281
282	PUTNEXT,.-. /EXIT ROUTINE
283	JMP I PUTBYTE /RETURN TO MAIN CALLER
284
285	PUTINIT,CLA /CLEAN UP
286	TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
287	DCA PUTRECORD /STORE IN-LINE
288	DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
289	PUTNEWR,TAD (OUTBUFFER) /SETUP THE
290	DCA BUFPTR /BUFFER POINTER
291	PUTLOOP,JMS PUTNEXT /GET A CHARACTER
292	DCA I BUFPTR /STORE IT
293	TAD BUFPTR /GET POINTER VALUE
294	DCA TEMPTR /SAVE FOR LATER
295	ISZ BUFPTR /BUMP TO NEXT
296	JMS PUTNEXT /GET A CHARACTER
297	DCA I BUFPTR /STORE IT
298	JMS PUTNEXT /GET A CHARACTER
299	RTL;RTL /MOVE UP
300	AND (7400) /ISOLATE HIGH NYBBLE
301	TAD I TEMPTR /ADD ON FIRST BYTE
302	DCA I TEMPTR /STORE COMPOSITE
303	TAD LATEST /GET LATEST CHARACTER
304	RTR;RTR;RAR /MOVE UP AND
305	AND (7400) /ISOLATE LOW NYBBLE
306	TAD I BUFPTR /ADD ON SECOND BYTE
307	DCA I BUFPTR /STORE COMPOSITE
308	ISZ BUFPTR /BUMP TO NEXT
309	TAD BUFPTR /GET LATEST POINTER VALUE
310	TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT
311	SZA CLA /SKIP IF AT END
312	JMP PUTLOOP /KEEP GOING
313	ISZ DANGCNT /TOO MANY RECORDS?
314	SKP /SKIP IF NOT
315	JMP I (SIZERR) /JUMP IF SO
316	CDF DFLD /SET OUR FIELD
317	CIF 00 /GOING TO SYSTEM FIELD
318	JMS I (SYSENTRY) /CALL I/O HANDLER
319	2^100+DFLD+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
320	OUTBUFFER /BUFFER ADDRESS
321	PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
322	JMP I (PROCERR) /OUTPUT ERROR!
323	ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
324	ISZ PUTRECORD /BUMP TO NEXT RECORD
325	JMP PUTNEWRECORD /KEEP GOING
326	\f PAGE
327	\f/ TEXT MESSAGES.
328
329	LEADMSG,TEXT "LEADER FOR DIRECT LOAD FILE WHICH MUST BE IN LOWER CASE%"
330	TEXT "%FILE CONTAINS KERMIT DATA IN IPL ENCODED FORMAT%%"
331	\f TEXT "THIS FILE CONTAINS DATA FOR FIELD"
332	ONEMSG, TEXT " ONE%%^"
333	SAVEMSG,TEXT "END OF DATA%%^A^FTER THE PROGRAM EXITS BACK TO THE MONITOR, "
334	\f TEXT "YOU SHOULD SAVE THE DATA WITH:%%.^SAVE SYS FIELD^"
335	SVMSG, TEXT ".^SV "
336	SV0MSG, TEXT "0000-"
337	SVEMSG, TEXT "7577=0%"
338	ZEROMSG,TEXT " ZERO%%"
339	\f/ DIGIT MESSAGE POINTER TABLE.
340
341	NTABLE, ZEROMSG /POINTER TO ZERO MESSAGE
342	ONEMSG /POINTER TO ONE MESSAGE
343
344	PAGE /GET TO A GOOD BOUNDARY
345
346	OUTBUFF=. /OUTPUT BUFFER HERE
347
348	$ /THAT'S ALL FOLK!