File: IMAGE.PA of Tape: Various/Decus/decus-1

(Source file text) 

---

/IMAGE-TO-BINARY CONVERSION

/LOAD WITH OPTIONS /8/9=2000$

*2000
IMAGE,	CLA CLL
	CIF 10
	JMS I (7700
	 10		/USR IN
	CIF 10
	JMS I (200
	 5		/COMMAND DECODER
	 2326		/.SV
	TAD (INDEV+1	/ALLOW 2-PAGE HANDLER.
	DCA INHNDL
	CDF 10
	TAD I (7617	/INPUT DEVICE.
	AND (17
	CDF
	CIF 10
	JMS I (200
	 1		/FETCH HANDLER
INHNDL,	 INDEV+1
	 HLT

	CDF 10
	TAD I (7604
	SNA		/SKIP IF EXTENSION SUPPLIED.
	TAD (0216	/.BN
	DCA I (7604
	TAD I (7620	/INPUT BLOCK.
	CDF
	DCA INBLOK
	JMS I INHNDL
	 200
	 HEADER
INBLOK,	 0
	 HLT
	IAC
	TAD INBLOK
	DCA INBLK1
	TAD I (HEADER
	DCA SEGCNTR	/COUNTS SEGMENTS
	TAD (HEADER+3
	DCA SEGPNTR	/SETUP POINTER TO 1ST PAIR OF WORDS.
	JMS LEADER

SEGLOOP,ISZ SEGPNT
	TAD I SEGPNT	/ADDRESS
	DCA INBLOK	/SAVE TEMPORARILY.
	ISZ SEGPNT
	TAD I SEGPNT	/FIELDS AND PAGES.
	AND (70		/NOW JUST FIELDS.
	TAD (300
	CIF 10
	JMS I (OPUTC	/FIELD CHANGE IS NOT CHECKSUMMED.
	TAD INBLOK	/ADDRESS AGAIN.
	STL		/LINK(1)=SET-ORIGIN.
	JMS SEND
	TAD I SEGPNT
	AND (3700	/PAGES.
	RAL CLL
	CIA
	DCA WC
NXTBLK,	TAD (-400
	DCA BLWC
	TAD (INBUFF
	DCA CA
	JMS I INHNDL
	 200
	 INBUFF
INBLK1,	 0
	 HLT
	ISZ INBLK1
NXTWRD,	TAD I CA
	ISZ CA
	CLL
	JMS SEND	/LINK MUST BE CLEAR HERE
	ISZ WC		/SKIP WHEN LOCATIONS ALL SENT
	SKP
	JMP SEGDONE
	ISZ BLWC	/SKIP WHEN BLOCK EXHAUSTED.
	JMP NXTWRD
	JMP NXTBLK
SEGDONE,ISZ SEGCNT	/SKIP WHEN SEGMENTS COMPLETE
	JMP SEGLOOP
	TAD CHKSUM
	JMS SEND
	JMS LEADER
	TAD (232
	CIF 10
	JMS I (OPUTC	/^Z CLOSES FILE.
	CIF 10
	JMS I (200
	 11		/USR OUT
	CDF 10
	TAD I (7642
	CDF
	SMA CLA		/SKIP IF ALTMODE TERMINATOR.
	JMP IMAGE
	JMP I K7600	/BACK TO KEYMON.



/VARIABLES

CA,	0	/CURRENT-ADDRESS POINTER
WC,	0	/WORD-COUNTER
BLWC,	0	/BLOCK WORD-COUNTER.



SEGCNT,	0	/COUNTS SEGMENTS OF	SAVED FILE.
SEGPNT,	0	/POINTS TO SEGMENT TABLE IN DIRECTORY.

K7600,	-200	/ALSO 7600.
PAGE
	EJECT
/LEADER SUBROUTINE PUTS OUT 200 CODES.

LEADER,	0
	CDF 10
	CLA IAC
	AND I (7643	/IS /L OPTION SET?
	SZA CLA		/NO - SKIP NEXT LINE.
	TAD (7600	/YES - PUT OUT 200 CODES.
	TAD (-20
	CDF
	DCA LCNTR
	TAD (200
	CIF 10
	JMS I (OPUTC
	ISZ LCNTR
	JMP .-4
	DCA CHKSUM
	JMP I LEADER
/SEND ROUTINE TRANSMITTS A 12-BIT WORD IN 'BINARY' FORMAT,
/IF LINK(1), THEN BIT 5 IS SENT ON 1ST FRAME.

SEND,	0
	DCA STMP
	TAD STMP
	RTR;RTR;RTR
	AND (177
	JMS STUFF
	TAD STMP
	AND (77
	JMS STUFF
	JMP I SEND

LCNTR,
STMP,	0
STMP1,	0
CHKSUM,	0	/CHECKSUM, MODULO 4096.

STUFF,	0
	DCA STMP1
	TAD STMP1
	CIF 10
	JMS I (OPUTC
	TAD STMP1
	TAD CHKSUM
	DCA CHKSUM
	JMP I STUFF
PAGE
/ASCII I/O FOR PS-8

/DEFINITIONS REQUIRED FOR CHARACTER I/O ROUTINES.

INBUFF=.+1400
OUTBUFF=6600	/IN FIELD 1.
INDEV=.
OUTDEV=.+400
HEADER=.+1000
ERROR1=HLT
IOAREA=7200
O2PAGE=1

FIELD 1
*IOAREA
/USED BY OUTPUT ROUTINES.
/COME HERE IN CASE OUTPUT CANNOT BE OPENED ON FIRST TRY.
OFAIL,	TAD I I7600
	AND (7760
	SNA CLA		/SKIP IF NOT INDEFINITE REQUEST.
	ERROR1		/OUTPUT FILE PROBABLY TOO LARGE.
	TAD I I7600
	AND (17
	DCA I I7600
	JMP I (OUENTR	/TRY INDEFINITE.
I7600,	7600
PAGE
/DELIVERS A CHARACTER TO THE OUTPUT FILE. OUTPUT FILE NAME
/MUST HAVE BEEN DEFINED PREVIOUSLY!!
/^Z WILL CLOSE OUTPUT FILE.
/CALLED BY:
/	TAD CHAR
/	IOF		/SEE NOTE AT IGETC ABOVE.
/	CDF
/	CIF 10
/	JMS I (OPUTC
/	RETURN (ACC=0)


OPUTC,	0
	DCA LAST
	RDF
	TAD CDFCIF
	DCA ODONE
	CDF CIF 10
	TAD LAST
OL02,	DCA I OPNTR
	TAD OUTINH
	SNA CLA		/SKIP IF OUTPUT ENTERED.
	JMP OOPEN
OL01,	ISZ OPNTR
	TAD I OPNTR
	SMA		/SKIP WHEN 3 CHARACTERS SAVED.
	JMP OEXIT
	DCA OPNTR	/RESTORE POINTER.
	TAD OCHAR3
	CLL RTL;RTL
	AND O7400
	TAD OCHAR1
	DCA I OCA
	ISZ OCA
	TAD OCHAR3
	CLL RTR;RTR;RAR	/LEFT-SHIFT 8.
	AND O7400
	TAD OCHAR2
	DCA I OCA
	ISZ OCA
O7400,	7400		/IN CASE OCA PASSES THRU 0.
	ISZ OWC		/SKIP IF BUFFER FULL.
	JMP OEXIT

	ISZ OBLWC	/SKIP IF OUTPUT FILE TOO LARGE!
	SKP
	ERROR1
	CIF
	JMS I OUHAND
	 4210
OUTP,	 OUTBUFF
OUTBLK,	 0		/MUST BE FILLED BY 'OOPEN'.
	ERROR1
	ISZ OUTBLK
	JMS ORESET
O7600,
OEXIT,	7600
	TAD LAST
	TAD (-232
	SZA CLA		/SKIP IF ^Z RECIEVED.
	JMP ODONE

/CLOSE THE OUTPUT FILE.

CLOSE,	TAD OPUTC
	DCA RETURN
	TAD OUTBLK
	CIA
	DCA OUBLK	/SAVE -BLOCK.
	JMS OPUTC	/PACK WITH 0'S.
	TAD OUTBLK
	TAD OUBLK
	SNA CLA		/SKIP WHEN LAST ONE WRITTEN.
	JMP .-4
	TAD OULENGTH
	CIA		/NOW HAVE +LENGTH.
	TAD OBLWC	/GET -LENGTH+N
	DCA OBLWC
	TAD I O7600
	JMS I (200
	 4		/CLOSE
OU7601,	 7601
OBLWC,	 0		/COUNTS BLOCKS AVAILABLE.
	ERROR1
	DCA OUTINH	/MARK OUTPUT FILE CLOSED.
CDFCIF,	CDF CIF
	JMP I RETURN	/TO CALL+1.
ODONE,	CIF CDF
	JMP I OPUTC

	IFNDEF O2PAGE <O2PAGE=0>
OOPEN,	TAD OU7601
	DCA OUBLK
	TAD (11
OL03,	IAC
	DCA OUHAND-1
	TAD (OUTDEV+O2PAGE
	DCA OUHAND
	TAD I O7600
	SNA		/SKIP IF OUTPUT POSSIBLE.
	ERROR1
	JMS I (200
	 12		/CHECK HANDLER, OR FETCH IT.
OUHAND,	 OUTDEV+O2PAGE
	ERROR1		/HUH?
	TAD .-2
	SNA CLA		/SKIP IF NOW IN CORE.
	JMP OL03	/TRY TO LOAD IT.
OUENTR,	TAD I O7600
	JMS I (200
	 3		/ENTER OUTPUT FILE.
OUBLK,	 7601
OULENG,	 0
	JMP I (OFAIL	/CAN'T ENTER IT.
	TAD OUBLK
	DCA OUTBLK
	TAD OULENGTH
	DCA OBLWC
	JMS ORESET
	ISZ OUTINH
	JMP OL01

/RESET POINTERS.

ORESET,	0
	TAD OCHAR
	DCA OPNTR
	TAD O7600
	DCA OWC
	TAD OUTP
	DCA OCA
	JMP I ORESET

OPNTR,	.+1
OCHAR1,	0		/SIMILAR TO ICHAR1 ETC.
OCHAR2,	0
OCHAR3,	0
OCHAR,	OCHAR1		/SEE ICHAR3+1 FOR WARNING!

LAST,	0		/CONTAINS LAST CHAR RECIEVED.
OWC,	-200		/"
OCA,	OUTBUFF		/"
RETURN,	0		/RETURN ADDRESS FOR RECURSIVE OPUTC.
OUTINH,	0		/0 WHEN NO OUTPUT FILE IN PROGRESS.

XLIST ////////////////
$$$$$$$$$$$$


---