/009 BINARY PUNCH  WITH FIELD SETTING
/THREE SUBROUTINES TO PUNCH AN AREA OF CORE IN BINARY
/LOADER FORMAT. FIELD SETTINGS AND ORIGIN SETTINGS
/ARE BEING PUUCHED AT EACH ENTRY; CHECKSUM IS PUNCHED
/WHEN PUNCHK IS CALLED.
/THE ROUTINE CAN TKE DATA FROM A DIFFERENT FIELD.
/IT CAN OPERATE IN ALL FIELDS. SEVERAL USES APPLY:
/1) NORMAL USE. THE DATA IS LOCATED IN THE SAME FIELD OR
/STRANGE FIELD. ENTER WITH FIELD IN AC; LINK=0
/2) THE CODE IS IN SAME FIELD AS BINPUN, ONLY A DIFFERENT
/FIELL SETTING NEEDS TO BE PUNCHED. ENTER BINPUN
/WITH FIELD IN AC AND LINK=1.
/3) THE CODE HAS BEEN MOVED IN CORE. THE FIRST LOCATION
/IS NOT NECESSARILY THE ORIGIN. NOW EETER BINPUN WITH
/AC=FIELD FOR SETTING; LINK=1; SET ORIGIN UNEQUAL TO
/FIRST LOCATION IF THIS IS TRUE.
/EXAMPLE OF NORMAL USE:
/
/	JMS LEADER	/PUNCH LEADER, CLEAR CHECKSUM
/	CLL
/	TAD (0010	/FIELD 1
/	JMS BINPUN
/	   ORIGIN	/IN NORMAL USE=FIRST LOO.
/	   FIRST LOC.
/	   LAST LOC.
/	JMS PUNCHK	/PUNCH CHKSM AND TRAILER

BINEND	0		/LAST LOC. TO PUNCH
	6201
	100
	300		/FOR FIELD SETTING
	0		/TEMP. STORAGE
BINPUN,	0
	DCA BINPUN-1
	SZL		/SET UP DF IF LINK=0
	JMP BIN3
	TAD BINPUN-1
	TAD INPUN-4	/MAKE CDF
BIN3,	DCA BIN2
	TAD BINPUN-1	/MAKE FIELD SETT. AND PUNCH
	TAD BINPUN-2	/NOTE!!FIELD SETT. NOT IN CHECKSUM!!
	JMS TYPE
	TAD I BINPUN	/GET ORIGIN
	ISZ BINPUN
	DCA BINPUN-1
	TAD BINPUN-1	/PUNCH ORIGIN
	JMS BINLH	/LEFT HALF 
	TAD B
NPUN-3	/+100 FOR ORIGIN
	JMS BINCHK
	TAD BINPUN-1	/RIGHT HALF AND PUNCH
	AND BINLH-1
	JMS BINCHK
	TAD I BINPUN	/SET UP POINTER
	DCA BINPUN-1
	ISZ BINPUN
	TAD I BINPUN	/GET END
	DCA BINEND
BIN2,	CDF 0		/OVERLAID BY CDF STRANGE FIELD
	TAD I BINPUN-1	/GET DATA
	JMS BINLH	/PUNCH LEFT HALF
	JMS BINCHK
	TAD I BINPUN-1	/PUNCH RIGHT HALF
	AND BINLH-1
	JMS BINCHK
	TAD BINEND	/END REACHED?
	CIA
	CLL
	TAD BINPUN-1
	ISZ BINPUN-1
	SNL CLA
	JMP BIN2+1	/NO, TAKE NEXT DATA
	RIF		/YES,RESTORE DF
	TAD BINPUN-4
	DCA .+1
	CDF 0		/OVERLAID
	ISZ BINPUN
	JMP I BINPUN
	SPA CLA

/GT LEFT HALF OF THE AC
	77
BINLH,	0
	RTR
	RTR
	RTR
	AND BINLH-1
	JMP I BINLH

/UPDATE THE CHECKSUM, AND PUNCH FRAME
	0		/CHECKSUM
BINCHK,	0		/ENTER WITH 6 BIT RAME IN AC
	DCA BINLH	/USE BINLH TEMPORARILY
	TAD BINLH
	TAD BINCHK-1	/UPD. CHKSM
	DCA BINCHK-1
	TAD BINLH
	JMS TYPE
	JMP I BINCHK

/PUNCH 100(8) LEADER OR TRAILLR HOLES; CLEAR CHECKSUM
	200
LEADER,	0
	TAD BINPUN-3	/USE CHKSM AS NEG COUNT
	CIA
	DCA BINCHK-1
	TAD LEADER-1
	JMS TYPE
	ISZ BINCHK-1	/READY?
	JMP .-3		/NO
	JMPPI LEADER	/YES

/PUNCH CHECKSUM; PUNCH TRAILER; CLEAR CHECKSUM

PUNCHK,	0
	TAD BINCHK-1	/GET CHECKSUM
	JMS BINLH
	JMS TYPE
	TAD BINCHK-1
	AND BINLH-1
	JMS TYPE
	JMS LEADER	/CLEARS CHECKSUM
	JMP I PUNCHK