<div id='wikitext'>
<pre><b> File: PXPB.PA of Tape: Sources/Other/new-14</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/ PROGRAM TO SPOOL PLOTTER IMAGE FILE TO CHAR FILE
/
/
/
/ CORE LAYOUT :-
/  00000 - 03777	INPUT BUFFER #1
/  04000 - 06400	OUTPUT BUFFER
/  06600 - 07177	INPUT HANDLER
/  07200 - 07577	OUTPUT HANDLER
/  10000 - 11777	USR
/  12000 - 13377	PROGRAM
/  13400 - 13577	LINE BUFFER
/  13600 - 17577	NOT USED
/  20000 - 23777	INPUT BUFFER #2
/
/ TO ASSEMBLE, ETC :-
/  .R PAL8
/  *PXPB/L/9=12000$
/  .SAVE SYS PXPB
/
/***********************************************************************

			ICOMM=7400	/!!!! COMMUNICATION AREA

/ DEFINE FIELDS USED
	PF=1
	IFLD1=00
	IFLD2=20
	PFLD=PF^10
	BFLD=0

/ OS/8 FILE BUFFER
BUFFER=4000

/ DEFINE VARIABLES IN USR AREA
TMP=20
CTR=21
CTR1=21
CTR2=22
CTR3=23
CTR4=24
BLC=25
NLC=26
AIH=27
AOH=30
FCF=31

	FIELD PF
	*2000

START,	DCA I (ICOMM	/NO CHAIN TO PXPA IF RUN
CHST,	CLA CMA
	DCA ERCHK	/ALLOW ONE BAD LOOKUP
	JMS I (7700	/LOCK IN USR
	10
	TAD I (7617
	SZA
	JMP GOTIF	/GOT INPUT-FILE
ERTWO,	TAD (FN
	DCA SB
	IAC		/SET SYS:
	JMS I (200
	2		/LOOKUP
SB,	FN		/SYS:PLOT.IM
MFL,	0
	JMP ER1		/ERROR - NO INPUT FILE
	CLA IAC
	DCA I (7617	/SET SYS:
	TAD SB
	DCA I (7620	/AND START BLOCK
	TAD MFL
	JMP DFIF

ERONE,	ISZ ERCHK	/TRY ONCE MORE ?
	JMP ER2		/WRONG LENGTH INPUT
	JMP ERTWO
ERCHK,	-1

/GOT INPUT FILE
GOTIF,	RTR
	RTR
DFIF,	AND (377
	TAD (7400
	TAD (200	/CHECK FOR 384 BLOCKS (WELL... MOD 256)
	SZA CLA
	JMP ERONE
/DEFAULT OUTPUT :- LPT:
	JMS I (200
	12
	4020		/=LPT:
DDN,	0
	0
	JMP ER3		/NO LPT: !!!
	TAD DDN
	DCA I (7600

/FETCH OUTPUT HANDLER &amp; OPEN OUTPUT
GOTOF,	TAD (7201
	DCA HA
	TAD I (7600
	JMS FH
	TAD HA
	DCA AOH
	JMS OPEN
	 JMP ER6	/ OPEN FAILURE

/FETCH INPUT HANDLER &amp; OPEN INPUT FILE
	TAD (6601
	DCA HA
	TAD I (7617
	JMS FH
	TAD HA
	DCA AIH
	TAD I (7620
	DCA PFNB
	JMP COPYF	/ COPY FILE THROUGH

/ FETCH HANDLER
FH,	0
	JMS I (200
	1
HA,	0
	JMP ER4		/ FAILURE
	JMP I FH
/ ERRORS !!
ER7,	ISZ ERCT
ER6,	ISZ ERCT
ER5,	ISZ ERCT
ER4,	ISZ ERCT
ER3,	ISZ ERCT
ER2,	ISZ ERCT
ER1,	ISZ ERCT
ER0,	CLA
	TAD ERCT
	TAD (ERMT
	DCA TMP		/ POINT TO ADDR OF MESSAGE
	DCA ERCT	/ CLEAR ERROR COUNT
	TAD I TMP
	JMS TXOUT	/ PRINT MESSAGE
MONEXT,	CDF CIF 0
	JMP I (7600	/ &amp; EXIT TO MONITOR

/ STORAGE
ERCT,	0		/ ERROR COUNTER
FN,	FILENAME PLOT.IM
	PAGE
/ NOW THE SPOOLING OF THE DATA
COPYF,	TAD (-30-1	/ 24 LUMPS
	DCA CTR1
	IAC		/ THROW 1 LINE TO ENSURE _ DONE PROPERLY
	DCA BLC
	DCA NLC
	TAD (-14
	DCA CTR3	/DO ONCE FOR EACH PRINT LINE = 12 PLOT LINES

/DO ONCE FOR EACH SEGMENT
NXSEG,	ISZ CTR1	/MORE SEGS ?
	SKP
	JMP I (SEGEND	/NO
	CIF 0
	JMS I AIH
	2000+IFLD1	/GET 8 BLOCKS TO FIELD 0
	0		/0-3777
PFNB,	0		/FROM THIS BLOCK ON
	JMP ER5		/ERROR
	TAD PFNB
	TAD (10
	DCA PFNB2	/MOVE ON
	CIF 0
	JMS I AIH
	2000+IFLD2	/GET 8 BLOCKS TO FIELD 2
	0		/0-3777
PFNB2,	0		/FROM THIS BLOCK ON
	JMP ER5		/ERROR
	TAD PFNB2
	TAD (10
	DCA PFNB	/MOVE ON
	DCA 1		/SET INPUT BUFFER POINTER TO START OF BUFFER
	DCA 2		/ALSO BUFFER #2
	TAD (-100	/64 PLOT LINES PER SEG
	DCA CTR2
/DO ONCE FOR EACH PLOT LINE
NXLN,	TAD (LBUF-1
	DCA 17
	DCA FCF		/ NO FUNNY CHARS YET
	TAD (-10	/128 CHAR LINES (64 WORDS) (2*8 BLOCKS)
	DCA CTR4
GPL0,	TAD (-4		/GET PLOT LINE INTO BUFFER
	DCA GPC
GPL1,	CDF IFLD1
	TAD I 1
	ISZ 1
	CDF PFLD
	DCA TMP
	TAD TMP
	JMS CKFC	/ CHECK FOR FUNNY CHAR &amp; STORE
	TAD TMP
	BSW
	JMS CKFC
	ISZ GPC
	JMP GPL1
	TAD (400-4
	TAD 1
	DCA 1
	ISZ CTR4
	JMP GPL0
	TAD (-4000+4
	TAD 1
	DCA 1
	TAD (-10	/128 CHAR LINES (64 WORDS) (2*8 BLOCKS)
	DCA CTR4
GPL2,	TAD (-4		/GET PLOT LINE INTO BUFFER
	DCA GPC
GPL3,	CDF IFLD2
	TAD I 2
	ISZ 2
	CDF PFLD
	DCA TMP
	TAD TMP
	JMS CKFC	/ CHECK FOR FUNNY CHAR &amp; STORE
	TAD TMP
	BSW
	JMS CKFC
	ISZ GPC
	JMP GPL3
	TAD (400-4
	TAD 2
	DCA 2
	ISZ CTR4
	JMP GPL2
	TAD (-4000+4
	TAD 2
	DCA 2
/DELETE TRAILING @&#039;S
	TAD (-200	/128 CHARS
	DCA CTR4
	TAD 17
	DCA TMP
DELAT,	TAD I TMP
	SZA CLA
	JMP I (NNL	/NOT NULL
	CMA
	TAD TMP
	DCA TMP
	ISZ CTR4
	JMP DELAT

	ISZ NLC		/ONE MORE NULL LINE

CKEPL,	ISZ CTR3	/DONE 12 PLOT LINES?
	JMP SEGCHK
	TAD (-14
	DCA CTR3

/CHECK NULL LINES COUNTER
	TAD NLC
	TAD (-14
	SNA CLA
	JMP SCL

/DUMP NULL LINES
	JMS DNL
	SKP

/JUST SEND CRLF
SCL,	ISZ BLC		/COUNT ONE MORE BLANK LINE
	DCA NLC
SEGCHK,	ISZ CTR2
	JMP NXLN
	JMP NXSEG

GPC,	0
	PAGE
/ CHECK FOR FUNNY CHAR &amp; STORE CHAR AWAY
/ NECESSARY TO OVERCOME PROBLEMS IN PRINTRONIX
CKFC,	0
	AND (77
	TAD (-37
	CLL
	TAD (-2		/ CHECK FOR UNDERLINE OR SPACE
	SNL
	ISZ FCF		/ GOT FUNNY CHAR
	TAD (41		/ RESTORE CHAR CODE
	DCA I 17
	JMP I CKFC

/NON-NULL LINE ; DUMP NULL LINES, THEN CURRENT LINE
NNL,	JMS DNL
	TAD (205
	JMS OUTPUT
	TAD (LBUF-1
	DCA 17
OPNC,	TAD I 17
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS OUTPUT
	ISZ CTR4
	JMP OPNC
	JMS CRLF
	JMP I (CKEPL
/ DUMP NULL LINES
DNL,	0
	TAD FCF
	SNA CLA
	JMP DNL2	/ NO FUNNY CHARS
	TAD NLC
	SZA CLA
	JMP DNL2	/ FUNNY CHARS DON&#039;T MATTER
	TAD BLC
	SNA CLA
	JMP I DNL	/ NOTHING TO DO
	TAD (14
	DCA NLC		/ DO 12 PLOT LINES INSTEAD OF LAST BLANK LINE
	CMA

DNL2,	TAD BLC
	CMA
	DCA BLC
	SKP

	JMS CRLF
	ISZ BLC
	JMP .-2

	TAD NLC
	CMA
	DCA NLC
	JMP .+6

	TAD (205
	JMS OUTPUT
	TAD (300
	JMS OUTPUT
	JMS CRLF
	ISZ NLC
	JMP .-6
	JMP I DNL
	PAGE
/ SEND CRLF
CRLF,	0
	TAD (215
	JMS OUTPUT
	TAD (212
	JMS OUTPUT
	JMP I CRLF

/ OUTPUT CHAR TO OS/8 FILE
OUTPUT,	0
	AND (377
	TAD (-232
	SNA
	JMP OUTEND	/ ^Z ; CLOSE FILE
	TAD (232
	JMS PACK	/ PACK CHAR
	JMP I OUTPUT	/ ALL OK
	JMS PUTBUF	/ FILLED BUFFER
	 JMP ER0	/ NO SPACE LEFT
	JMP I OUTPUT

OUTEND,	JMS CLOSE
	 JMP ER7	/ NO SPACE LEFT
	JMP I OUTPUT
/ PACK CHARACTERS INTO OS/8 BUFFER
PACK,	0
	ISZ PACKJ
PACKJ,	JMP .		/ SWITCH FOR CHARS 1, 2, 3 OF TRIO
	JMP PACK1
	JMP PACK2
/ CHAR 3 OF TRIO ; NOW DO WORK
	DCA PACKT
	TAD JMPPJ
	DCA PACKJ	/ RESTORE SWITCH
	TAD PACKT
	CLL RTL
	RTL
	AND (7400
	TAD PACKW1
	CDF BFLD
	DCA I FPTR	/ STORE 1ST WORD
	ISZ FPTR
	TAD PACKT
	CLL RTR
	RTR
	RAR
	AND (7400
	TAD PACKW2
	DCA I FPTR
	ISZ FPTR
	CDF PFLD
	ISZ FCTR
	JMP I PACK	/ RETURN 1 IF SPACE LEFT IN BUFFER
	ISZ PACK
	JMP I PACK	/ RETURN 2 IF BUFFER FULL
/ PACK CHAR 1
PACK1,	DCA PACKW1
	JMP I PACK
/ PACK CHAR 2
PACK2,	DCA PACKW2
	JMP I PACK
PACKW1,	0
PACKW2,	0
PACKT,	0
JMPPJ,	JMP PACKJ

/ FILE POINTER &amp; COUNTER
FPTR,	0
FCTR,	0
/CLOSE OUTPUT FILE
SEGEND,	TAD (214
	JMS OUTPUT
	TAD (232
	JMS OUTPUT

/ WIND UP PROGRAM
	TAD I (ICOMM	/ LOOK AT &#039;ICOMM&#039;
	TAD (-6000	/ MAGIC VALUE ?
	SZA CLA
	JMP MONEXT	/ JUST EXIT

	TAD (PXPAFN
	DCA FPFN
	CDF 0
	TAD I	(7776	/ ON CCL-DEVICE (SBLOCK)
	CDF 10
	JMS I (200
	2
FPFN,	0		/ LOOKUP CCLDEV:PXPA.SV
	0
	JMP MONEXT	/ NOT THERE ; EXIT
	TAD FPFN
	DCA CHB		/ START BLOCK OF PXPA

	CDF 0
	TAD I	(7756	/ ON CCL-DEVICE (MREAD-1)
	CDF 10
	JMS I (200
	6
CHB,	0		/ START BLOCK OF PXPA
/ PROGRAM TO CHAIN TO
PXPAFN,	FILENAME PXPA.SV

	PAGE
/ OUTPUT BUFFER TO OS/8 FILE
PUTBUF,	0
	TAD FCTR	/ MUST BE MULTIPLE OF 200 AT THIS STAGE
	TAD MAXB	/ FULL BUFFER
	DCA BFW		/ SET FUNCTION WORD
	TAD BFW
	AND (3600
	CLL RTL
	RTL
	RTL
	DCA PBT		/ NO OF BLOCKS TO GO
	TAD PBT
	TAD MNB
	SZL
	JMP FULL
	DCA MNB		/ NEW -VE NO OF BLOCKS
	CIF 0
PB2,	JMS I AOH	/ CALL OUTPUT HANDLER
BFW,	0		/ FUNCTION WORD
ABUF,	BUFFER		/ FROM BUFFER
CBLOK,	0		/ TO THIS BLOCK
	 JMP I PUTBUF	/ ERROR
	TAD PBT
	TAD CBLOK
	DCA CBLOK	/ UPDATE BLOCKS
	TAD PBT
	TAD NBU
	DCA NBU		/ &amp; BLOCKS USED

/ INITIALISE BUFFER
IBUF,	TAD ABUF
	DCA FPTR
	TAD MAXC
	DCA FCTR
	TAD JMPPJ
	DCA PACKJ
	ISZ PUTBUF
	JMP I PUTBUF	/ RETURN 2 IF ALL WELL
/ ALL SPACE FILLED UP
FULL,	SZA CLA
	JMP I PUTBUF	/ ABSOLUTELY NO SPACE
	TAD CLOSE
	SNA CLA
	JMP I PUTBUF	/ NO SPACE FOR ^Z
	JMP PB2		/ OK IF JUST FULL DURING CLOSE
PBT,	0
/ OPEN NEW OUTPUT FILE
OPEN,	0
	DCA CLOSE	/ CLEAR CLOSE INDICATOR
	TAD AFN2
	DCA AFN
	TAD I (7600
	JMS I (200
	3		/ ENTER NEW FILE
AFN,	0
MNB,	0
	 JMP I OPEN	/ OPEN FAIL
	TAD AFN
	DCA CBLOK	/ SET CURRENT BLOCK
	DCA NBU		/ 0 BLOCKS USED
	TAD OPEN	/ TRANSFER RETURN ADDRESS
	DCA PUTBUF
	JMP IBUF	/ INITIALISE BUFFER

/ CLOSE OUTPUT FILE
CLOSE,	0
	TAD (232	/ PACK ^Z, THEN AT LEAST 2 NULLS
	JMS PACK	/ TO FORCE OUT ^Z IF 1ST OR 2ND CHAR IN BLOCK
	JMS PACK	/ IF ANY OF THESE 3 JMS PACK SKIP,
	JMS PACK	/ CONTROL WILL FALL THROUGH TO JMS PUTBUF
	TAD FCTR
	AND (177
	SZA CLA
	JMP .-4		/ PAD OUT BUFFER WITH 0&#039;S
	JMS PUTBUF
	 JMP I CLOSE	/ NO SPACE
	TAD I (7600
	JMS I (200
	4		/ CLOSE
AFN2,	7601
NBU,	0		/ NO OF BLOCKS USED
	SKP
CLOSEX,	ISZ CLOSE
	JMP I CLOSE
MAXB,	5200+BFLD	/ WRITE 12 RECORDS FROM BUFFER FIELD
MAXC,	-1200		/ NO OF TRIOS IN 12 RECORDS

	PAGE
/ NOW THE TEXT HANDLING PART

/ OUTPUT TEXT TO CONSOLE
TXOUT,	0
	DCA TMP
TXO2,	TAD I TMP
	CLL RTR
	RTR
	RTR
	JMS OP6B
	TAD I TMP
	ISZ TMP
	JMS OP6B
	JMP TXO2

/ OUTPUT 6-BIT CHAR
OP6B,	0
	AND (77
	SNA
	JMP TXEND
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS TYPE
	JMP I OP6B

/ END OF TEXT STRING ; DO CRLF
TXEND,	TAD (215
	JMS TYPE
	TAD (212
	JMS TYPE
	JMP I TXOUT

/ TYPE CHAR ON CONSOLE
TYPE,	0
	TLS
	TSF
	JMP .-1
	CLA
	JMP I TYPE
/ ERROR MESSAGES
ERMT,	ERM0; ERM1; ERM2; ERM3; ERM4; ERM5; ERM6; ERM7

ERM0,	TEXT &quot;LPT: FEHLER&quot;
ERM1,
ERM2,	TEXT &quot;PLOT.IM NICHT IN ORDNUNG&quot;
ERM3,	TEXT &quot;ES GIBT KEIN LPT: !!&quot;
ERM4,	TEXT &quot;KANN HANDLER NICHT LADEN&quot;
ERM5,	TEXT &quot;LESE-FEHLER BEI PLOT.IM&quot;
ERM6,
ERM7,	TEXT &quot;USR INTERNER FEHLER&quot;

	PAGE
LBUF,	ZBLOCK 200	/ ROOM FOR 128 CHARS

	PAGE
	FIELD 1
	*2000
	$$$$$$$$
</pre>
<hr/>
</div>