
CANUTE - I/O SECTION

/DECIMAL INTEGER PRINT SUBROUTINE MORSE  O-3 10-4-62

DECPNT=JMS .
	0
	CLL!SMA
	CMA!CML
	DAC DCPN#UM
	LAC (SKP
	SNL
	LAW CHAR R-
	DAC DCPSGN
	LAC DECOCT
	DAC DCPLOP 2
	LAM -5
	DAC DCPC#NT
	LAC (SZA
	DAC DCPMOD

DCPGDG,	DZM DCPD#IG
	LAC DCPNUM
	JMP . 3

DCPLOP,	DAC DCPNUM
	ISZ DCPDIG
	XX
	SPA
	JMP DCPLOP
	ISZ DCPLOP 2
	LAC DCPDIG
DCPMOD,	XX
	JMP DCPSGN
	ISZ DCPCNT
	JMP DCPGDG
	CLC
	DAC DCPCNT
	XOR DCPNUM
	DAC DCPDIG

DCPSGN,	XX
	JMS TYPCHR
	LAC DCPDIG
	TDIGIT
	LAC (JMP DCPSGN 2
	ISZ DCPCNT
	JMP DCPGDG-1
	JMP I DECPNT-JMS
DECIMAL

DCPTAB,	100000	10000	1000	100	10	1

OCTAL

OCPTAB,	100000	10000	1000	100	10	1

DECOCT,	XX

/SET MODE OF CONVERSION AND INPUT

SETOCT=JMS .
	0
	LAC (NOP
	DAC LUIFND 3
	LAC (ADD OCPTAB
	DAC DECOCT
	XT  SETOCT

SETDEC=JMS .
	0
	LAC (TAD LUINUM
	DAC LUIFND 3
	LAC (ADD DCPTAB
	DAC DECOCT
	XT  SETDEC

/DECIMAL INPUT VIA ON-LINE TELEPRINTER

DECLUI,	0
	DZM LUI#NUM
LUIDGT,	JMS LUI
	LAW LUIDTB
	DAC LUI#TEM
	LAM -11
	DAC LUI#CNT
	DZM LUI#DIG
	LAC LUICHR
	SAD I LUITEM
	JMP LUIFND
	ISZ LUIDIG
	ISZ LUITEM
	ISZ LUICNT
	JMP .-5
	LAC LUINUM
	JMP I DECLUI

LUIFND,	LAC LUINUM
	CLL
	RTL
	XX
	RAL
	ADD LUIDIG
	DAC LUINUM
	LAC DECLUI
	RAL
	ISZ LUININ
	JMP LUIDGT
	JMP I DECLUI

LUIDTB,	CHAR R0	CHAR R1	CHAR R2	CHAR R3	CHAR R4
	CHAR R5	CHAR R6	CHAR R7	CHAR R8	CHAR R9

/INPUT PORTION

LUI,	0
	LAC C#ASE
	RTR
	RAR
	CLA!CML		/LINK=0 FOR LOWER CASE BAUDOT
	LAC MEDIA#T	/DOLLAR SIGN CHARACTER?
	SZA
	JMP LUIA		/YES, THEN GO GET IT
	JMS LUI1		/PICK UP CHAR FROM KEYBOARD BUFFER
	703301		/SKIP IF KSR33
	SKP
LUIA,	JMS ATB		/ASCII TO BAUDOT CODE CONVERSION (5 BIT)
	SAD (33
	JMP LUICAS	/UPPER CASE.
	SAD (37	JMP LUICAS	/LOWER CASE
	SAD (2	JMP LUICR	/C.R.
	SZA!RAL	ISZ TABCNT	/SIX BIT BAUDOT, W/LOW ORDER BIT GIVING BAUDOT CASE, O FOR LOWER
	SAD (51	JMP LUITB
LUIXT,	DAC LUI#CHR
	JMP I LUI

LUITB,	CLC		/BELL
	TAD TABCNT
	DAC TABCNT
	LAS
	RAL
	SPA		/AC1=1?
	JMS TTAB		/YES, CONVERT TAB TO SPACE
	LAW 37
	JMS LUO
	LAC (51
	JMP LUIXT


LUICR,	LAW 20
	JMS TYPCHR		/OUTPUT A LINE FEED
	DZM TABCNT
	LAC (4
	JMP LUIXT		/RETURN W/6 BIT BAUDOT C.R.

LUICAS,	DAC CASE
	JMP LUI 1


ATB,	0
	XX		/INITIALIZE TO XCT AYTB; IF $ CHAR, JMP ADOL2
	SAD (240
	JMP ATBG		/SPACE
	TAD (-237
	SPA		/TABLE GOOD FOR ASCII CODES: 240-337
	JMP ATBL		/NOT IN TABLE - LOW, ASCII CODE LESS THEN 240, CHECK SPECIAL CHARS.
	TAD (-77
	SMA
	JMP ATBM		/ASCII CODE GREATER THAN 337, RETURN A BLANK
	TAD (400100
	RCR
	ADD (ASCT		/ASCII TO BAUDOT CONVERSION TABLE ADDRESS
	DAC .+1
	XX		/LOAD CORRESPONDING BAUDOT CODE FROM TABLE
	SNL
	JMS RAR9		/SWITCH WORD HALVES DEPENDING ON ODD OR EVEN ASCII CODES
ATBF,	AND (777
	DAC ITEM#C		/9 BIT BAUDOT CODE
	AND (700
	SNA
	JMP ADOL2		/NOT A DOLLAR SIGN CHAR
	SAD (600
	JMP ATBM		/$ . CHARACTER
	LAC (62		/RETURN A $ CHAR (22)
ATBB,	ISZ MEDIAT		/SET $ CHAR FLAG
	ISZ ATB+1		/MODIFY FLOW TO PICK UP THE CHARACTER
	JMP ADOL2 4
AYTB,	NOP
	JMP ADOL2
ADOL2,	DZM MEDIAT
	LAC (XCT AYTB
	DAC ATB+1
	LAC ITEMC
	DAC ITEM#AB
	AND (40		/BAUDOT FIGURES BIT SET?
	SZA
	ADD (-44		/YES, SET CASE=33
	ADD (37		/NO, SET CASE=37
ADOL3,	DAC CASE
	STL
	SAD (37
	CML
	LAC ITEMAB
	AND (37		/RETURN W/5 BIT ASCII CODE,
	JMP I ATB		/CASE IN LINK (O - LOWER CASE)
ATBL,	SAD (-26
	JMP ATBE		/TAB
	SAD (-25
	LAC (10		/LINE FEED
	SAD (-22
	LAC (2		/C.R.
	SAD (-37
ATBM,	CLA		/NULL
	SPA
ATBG,	LAC (4
	DAC ITEMAB
	LAC CASE
	JMP ADOL3
ATBE,	LAC (64
	JMP ADOL2 4

/ASCII TO BAUDOT
/LEFT 9 BITS FOR EVEN ASCII CODES, RIGHT 9 BITS ODD ASCII CODES
/IF LEADING OCTAL DIGIT 4, PRECEDE BY $
/IF LEADING OCTAL DIGIT 6, PRECEDE BY $.
/LEADING BIT OF 2 DIGIT BAUDOT CODE = 1 FOR FIGURES, 0 FOR LETTERS
/THEN LEAST 5 BITS = BAUDOT CODE

ASCT,	000467	/ ,!
	461072	/",#
	061446	/$,%
	445472	/&,'
	076051	/(,)
	045053	/*,+
	046070	/,,-
	047067	/.,/
	055075	/0,1
	071060	/2,3
	052041	/4,5
	065074	/6,7
	054043	/8,9
	56057	/;,;
	470456	/<,=
	453063	/>,?
	457030	/@,A	/A-Z=BAUDOT LETTERS
	023016	/B,C
	022020	/D,E	/ALL OTHER TYPING
	026013	/F,G
	005014	/H,I	/CHARS.=FIGURES
	032036	/J,K
	011007	/L,M
	006003	/N,O
	015035	/P,Q
	012024	/R,S
	001034	/T,U
	017031	/V,W
	027025	/X,Y
	021476	/Z,[
	466451	/\,]

	066463	/^,(LEFT ARROW)

/GET A CHARACTER FROM THE KEYBOARD BUFFER

LUI1,	0
	ISZ LUI#CCT	/-0 MEANS BUFFER EMPTY
	JMP LUIN
	LAC LUI
	RAL
	LAC LUICCT
	SMA
	JMP .-2
	JMP LUI1 1

LUIN,	LAC LUIO
	SAD (LAW LUIBUF LN
	LAW LUIBUF
	DAC LU#IO
	LAC LUI1
	RAL
	LAC I LUIO
	ISZ LUIO
	JMP  I LUI1

/INITIALIZE LINE UNIT INPUT

XT=JMP I -JMS

TTYSET=JMS .
	0
	DZM ME#DIAT
	LAC (NOP
	DAC BTASWT
	LAW LUIBUF
	DAC LU#IO
	DAC L#UII
	LAC (XCT AYTB
	DAC ATB+1
	CLC
	DAC LUI#CCT
	DZM C#ASE
	LUOSET
	JMS TCR
	XT TTYSET

/SERVICE KEYBOARD INTERRUPT

LUIINT,	KRB
	DAC I LUII
	ISZ LUII
	LAC LUII
	SAD (LAW LUIBUF LN
	LAW LUIBUF
	DAC LU#II
	LAM -1		/-0 MEANS NONE, -1 ONE
	ADD LUICCT
	DAC LUICCT
	SAD (-LN+2
	SKP
	DISMIS
	CLA		/LOCK KEYBOARD ON TOO FULL BUFFER
	JMS TY1O
	JMS TY1O
	JMS TY1O
	TCF
	DISMIS

TY1O,	0
	TLS
	TSF
	JMP .-1
	JMP I TY1O

TSP=JMS .	0
	LAW 4
	JMS LUO
	XT TSP

TTAB,	0
	LAC TABCNT
	TAD (-13
	SMA
	JMP .-2
	SAD (1
	LAM -12
	SNA
	LAM -11
	DAC TAB#TEM
	TSP
	ISZ TABTEM
	JMP .-2
TTABX,	LAW 37
	JMS LUO
	JMP I TTAB

/SOME INTERRUPT SERVICE ROUTINES

LUO,	0
	AND (37
	SAD (33	JMP LUOCAS
	SAD (37	JMP LUOCAS
	SAD (10	SKP
	ISZ TABCNT
	SAD (2	DZM TAB#CNT
LUO1,	JMS LUOCHR
	JMP I LUO

LUOCAS,	SAD CASE
	JMP I LUO
	DAC CASE
	JMP LUO1

/INITIALIZE OUTPUT

LUOSET=JMS .
	0
	DZM LUOACT
	LAW LUOBUF
	DAC #OUTI
	DAC #OUTO
	LAM -LUON 1
	DAC OUT#CNT
	JMP I LUOSET-JMS

/SERVICE LINE UNIT (OUT) INTERRUPTS.

LUOINT,	LAC OUTCNT
	SAD (-LUON 1	/BUFFER EMPTY
	JMP LUODON
	LAS
	SPA
	JMP LUOXT
	LAC I OUTO	/MORE TO OUTPUT
	703301
	SKP
	JMS BTA
	TLS
	ISZ OUTO		/DECREMENT AND CHECK POINTER
	LAC OUTO
	SAD (LAW LUOBUF LUON
	LAW LUOBUF
	DAC OUTO
	CLC
	TAD OUTCNT
	DAC OUTCNT
	DISMIS

/ALL DONE

LUOXT,	LUOSET		/EXIT FAST
LUODON,	DZM LU#OACT
	TCF
	DISMIS


/OUTPUT THE CHARACTER INT THE RIGHT 5 BITS OF THE AC.

LUOCHR,	0
	DAC OUTTEM
	IOF
	LAC LUOACT	/ACTIVE
	SNA!CLC
	JMP LUOIAC
	LAC OUTTEM
	DAC I OUTI
	ISZ OUTI
	LAC OUTI		/CHECK FOR END OF BUFFER
	SAD (LAW LUOBUF LUON
	LAW LUOBUF	/AND MAKE A RING
	DAC OUTI
	ISZ OUTCNT
	NOP
	ION
	LAC OUTCNT	/WAIT FOR SPACE IN BUFFER
	SMA
	JMP .-2
	LAC OUTTEM
	JMP I LUOCHR

/ONE CHARACTER ONLY

LUOIAC,	DAC LUOACT
	LAS
	SPA
	JMP LUOIA1
	LAC OUTTEM
	703301
	SKP
	JMS BTA
	TLS
	ION
	JMP I LUOCHR

LUOIA1,	DZM LUOACT
	ION
	JMP LUOIAC-2

LUOBUF,	LUOBUF LUON/
LUIBUF,	LUIBUF LN/

BTA,	0
	AND (37
	DAC ITE#MD
	SAD (37
	JMP BTAC
	SAD (33
	JMP BTAC
	LAC BTACAS
	SAD (33
	CLL!SKP
	STL
BTASWT,	XX	/NOP OR JMP BTAY
BTAW,	LAC ITEMD
	SZL
	JMP . 3
	SAD (22
	JMP BTAX
	ADD (LAC BTAT
BTAS,	DAC . 1
	XX
	SZL
	JMS RAR9
	AND (377
	JMP I BTA
BTAC,	DAC BTACAS
	LAC (200
	JMP I BTA
BTACAS,	37
BTAX,	LAC (JMP BTAY
	DAC BTASWT
	JMP BTAC 1
BTAY,	LAC (NOP
	DAC BTASWT
	SZL
	JMP BTAW
	LAC ITEMD
	RTR
	SNL
	RAL
	SPA!CLL
	STL
	AND (17
	ADD (LAC SUPTAB-1
	JMP BTAS
SUPTAB,	200245
	276246
	300275
	337335
	241334
	200247
	200333
	200242
	200200
	200200
	200200
	200274

/NORMAL BAUDOT TO ASCII
/FIGURES RIGHT HALF, LETTERS LEFT HALF

BTAT,	200200		/0
	324265		/1
	215215		/2
	317271		/3
	240240		/4
	310252		/5
	316254		/6
	315256		/7
	212212		/10
	314251		/11
	322264		/12
	307253		/13
	311270		/14
	320260		/15
	303272		/16
	326273		/17
	305263		/20
	332244		/21
	304200		/22
	302277		/23
	323211		/24
	331266		/25
	306336		/26
	330257		/27
	301255		/30
	327262		/31
	312243		/32
	200200		/33
	325267		/34
	321261		/35
	313250		/36
	200200		/37


/SOME BASIC  INTERRUPT SERVICE ROUTINES

INTRP,	DAC SV#AC
	TSF	SKP	JMP LUOINT
	KSF	SKP	JMP LUIINT
	RSF	SKP	JMP TAPINT
	PSF	SKP	JMP PUNINT
	CLSF	JMP .+3	ISZ 0
	CLOF	MTAF	RCLD
	LPCF	DCF	IDCF
	GCL	PLCF	DRCF
DISMIS=JMP .
	LAC 0
	RAL
	LAC SVAC
	ION
	JMP I 0

CLRINT=.
CLFLAG,	0
	CLOF
	CAF
	ION
	LAC (JMP INTRP
	DAC 1
	JMP I CLFLAG

/SOME BASIC TELETYPE OUTPUT ROUTINES

TCR,	0
	LAW 2
	JMS LUO
	LAW 20
	JMS TYPCHR
	JMP I TCR

TDIGIT=JMS .
	0
	AND (17
	TAD (LAC DGTB
	DAC . 1
	XX
	JMS TYPCHR
	XT TDIGIT

DGTB,	CHAR R0	CHAR R1	CHAR R2	CHAR R3	CHAR R4
	CHAR R5	CHAR R6	CHAR R7	CHAR R8	CHAR R9


TYPCHR,	0
	RAR
	AND (37
	DAC TYP#TEM
	SAD (4
	JMP TYPCH1
	LAC (33
	SNL
	LAC (37
	JMS LUO
	LAC TYPTEM
TYPCH1,	JMS LUO
	JMP I TYPCHR


/TYPE A MESSAGE

TYPE,	0
	DAC TYP#T
	LAM -2
	DAC TYP#CNT
	LAC I TYPT

TYPE0,	RTL	RTL	RTL
	DAC TYP#SAV
	RAL
	JMS TYPCHR
	SNA
	JMP I TYPE
	LAC TYPSAV
	ISZ TYPCNT
	JMP TYPE0
	ISZ TYPT
	JMP TYPE 2

/INITIALIZE TAPE INPUT ROUTINES

READST=JMS .
	0
	LAW TAPBUF
	DAC TAP#I
	DAC TAP#O
	DZM TAP#RON
	LAC (NOP
	DAC GCR1+2
	LAC (JMP GCR5	/INITIALIZE TO PDP-7
	DAC GCR0B+2		/END OF TAPE TIMING LOOP
	LAC (777
	DAC TAP#MSK
	CLC
	DAC TAPC#NT
	DZM TAP#OFI
	LAS
	RTR
	LAC (SKP		/FIOSWT = SKP IF FIODEC
	SZL
	LAC (NOP		/= NOP IF ASCII
	DAC FIO#SWT
	JMP I READST-JMS

/GET A CHARACTER FROM THE INPUT BUFFER

GETCHR=JMS .
	0
	LAC TAPO
	SAD (LAW TAPBUF+TN	/CHECK END OF BUFFER
	JMP GCR3

GCR0,	ISZ TAPCNT	/INCREMENT COUNT WHEN PROCESSING
	JMP GCR1
	LAC TAPRON	/READING AND PROCESSING CAUGHT UP
	SNA
	JMP GCR4		/RE-ENABLE INTERRUPT
GCR0A,	XCT TAPIND	/CLA
	DAC TAP#STC	/INITIALIZE TIMING COUNTER
GCR0B,	LAC TAPCNT	/WAIT FOR PTR INTERRUPT
	SMA
	JMP GCR5		/IF NO INTERRUPT, CHECK FOR END OF TAPE
	JMP GCR0

GCR1,	LAC I TAPO	/GET A CHARACTER
	ISZ TAPO
	SKP		/OR NOP
	JMP GCR2
	RTR		/CHARACTER IN LEFT HALF OF BUFFER
	RTR		/SO PLACE IN RT. HALF
	RTR
	RTR
	RAR
GCR2,	AND (377		/MASK OUT LEFT HALF
	DAC FC#HR
	ISZ GETCHR-JMS
	JMP I GETCHR-JMS

GCR3,	LAW TAPBUF	/RESET BUFFER POINTER
	DAC TAPO
	LAC GCR1 2
	XOR (SKP-NOP	/SKP IF CHAR IN LEFT HALF OF BUFFER
	DAC GCR1 2	/NOP IF CHAR IN RT. HALF ALREADY
	JMP GCR0

GCR4,	LAC TAPOFI
	DZM TAPOFI
	SZA		/IF STOP CODE HAS BEEN SEEN
	XT  GETCHR	/THEN RETURN
	RSA
	ISZ TAPRON
	JMP GCR0A

GCR5,	ISZ TAPSTC	/TIMING LOOP
	JMP GCR0B
	RRB		/STILL NO INTERRUPTS, SO LOAD LAST CHAR SEEN
	XT  GETCHR

/SERVICE A PAPER TAPE INTERRUPT

TAPINT,	RRB
	XCT FIOSWT	/SKP IF FIODEC
	JMP TAPASC
	SAD (277
	JMP TAPSTP		/FIODEC C.R.
	SAD (13
	JMP TAPOT1	/STOP CODE
	JMS ENDTAP	/MORE TAPE IN PTR?
TAPIN0,	RSA
	SNA
	JMP TAPIND	/IGNORE BLANK TAPE
	DAC TA#PTEM
	AND (100
	SZA
	JMP TAPIND	/IGNORE DELETED CHARACTER
	LAC TAPTEM
	TAPFIL
	JMP TAPIND

/ FILL THE TAPE BUFFER WITH C(AC)

TAPFIL=JMS .
	0
	DAC TAPTEM
	RTL	RTL	RTL	RTL	RAL
	ADD TAPTEM	/SET UP BUFFER RING
	XOR I TAPI
	AND TAPMSK	/TAPMSK DISTINGUISHES WHICH HALF PRESENTLY
	XOR I TAPI	/BEING FILLED
	DAC I TAPI
	ISZ TAPI
	LAC TAPI
	SAD (LAW TAPBUF+TN
	JMP TAPIN2	/ONE HALF OF BUFFER IS FULL

/COUNT AND CHECK FOR FULL BUFFER

TAPIN1,	LAM -1
	ADD TAPCNT	/DECREMENT COUNTER ON READ-IN
	DAC TAPCNT
	TAD (TN 1
	SPA
	JMP TAPINW	/READING IS HALF BUFFER AHEAD OF PROCESSING
	JMP I TAPFIL-JMS	/OTHERWISE OK, SO LEAVE

/SWITCH WORD HALFS, AND SET POINTER TO BEGINNING OF BUFFER

TAPIN2,	LAC TAPMSK
	CMA		/SET TO MASK OUT OTHER HALF OF WORD
	DAC TAPMSK
	LAW TAPBUF
	DAC TAPI		/RESET POINTER
	JMP TAPIN1

/SET NEXT INTERRUPT TO TURN OFF READER

TAPINW,	LAC (JMP .+3
	DAC TAPIN0
	JMP I TAPFIL-JMS
	DAC TAPS#AV	/COME HERE ON NEXT INTERRUPT
	LAC (RSA		/NO MORE INTERRUPTS TIL PROCESSING CATCHES UP
	DAC TAPIN0
	DZM TAPRON	/SET FLAG TO RE-ENABLE INTERRUPT
	LAC TAPSAV

TAPSTR,	XCT FIOSWT
	JMS DIT		/ASCII
	JMP TAPIN0 1	/CARRIAGE RETURN

/CHECK CARRIAGE RETURNS

TAPSTP,	ISZ CRC
	JMP TAPASD
	LAC (277
	TAPFIL
	DZM TAPRON

TAPOT1,	ISZ TAPOFI	/SET END OF PAGE FLAG
	LAC (RSA		/STOP READING
	DAC TAPIN0
	DISMIS

TAPIND,	CLA		/RE-INITIALIZE TIMING COUNTER
	DAC TAPSTC
	DISMIS

TAPBUF,	TAPBUF+TN/


TAPASC,	AND (177		/TO ACCEPT PARITY ASCII TAPES
	ADD (200
	SAD (215
	JMP TAPSTP	/C.R.
	SAD (214
	JMP TAPOT1	/FORM FEED
TAPASD,	JMS ENDTAP	/MORE TAPE IN PTR?

	XCT TAPIN0
	JMP TAPSTR
ENDTAP,	0
	DAC RRRB#
	IORS
	AND (1000		/CHECK END OF TAPE BIT
	SZA
	JMP .+3		/NO MORE TAPE
	LAC RRRB
	JMP I ENDTAP
	ISZ TAPRON	/DISABLE FURTHER PTR INTERRUPTS
	LAC (XT GETCHR
	DAC GCR0B+2
	DISMIS

/INITIALIZE PUNCH ROUTINE

PUNSET=JMS .
	0
	LAC (NOP
	DAC OPBM
	LAC (777
	DAC PUNM#SK
	DZM CASEB
	LAW PUNBUF
	DAC PU#NO
	DAC PU#NI
	LAM -PN-PN+1
	DAC PUN#CNT
	CLC
	DAC P#UNPON
	JMP I PUNSET-JMS

/PUNCH FOR INTERRUPT
PUNLDB=JMS .
	0
	DAC PUNTEM
	LAS
	RTR	RAR	/BIT 15, ASCII OUTPUT
	LAC PUNTEM
	SZL
	JMS NANCY	/WHO WILL TRANSLATE FIODEC TO ASCII
	PUNFIL
	JMP I PUNLDB-JMS

PUNFIL=JMS .
	0		/FILL PUNCH BUFFER
	DAC P#UNTEM
	RTL
	RTL
	RAL
	RTL
	RTL
	ADD PUNTEM	/SET UP BUFFER RING
	XOR I PUNI	/FILLING 1ST ONE HALF AND THEN THE OTHER
	AND PUNMSK	/ACCORDING AS PUNMSK IS SET
	XOR I PUNI
	DAC I PUNI
	ISZ PUNI
	LAC PUNI
	SAD (LAW PUNBUF+PN	/CHECK IF HALF OF RING IS FULL
	JMP PUNLD1


/CHECK COUNT FOR FULL BUFFER AND LEAVE

PUNLD0,	ISZ PUNCNT
	JMP PUNLDX
	LAC PUNCNT	/NO MORE ROOM IN BUFFER
	SMA		/WAIT FOR PTP INTERRUPT
	JMP .-2
PUNLDX,	LAC PUNPON
	SPA
	JMS PUNCHR
	LAC PUNTEM
	JMP I PUNFIL-JMS

/CHANGE WORD HALFS, START AT BUFFER BEGINNING

PUNLD1,	LAC PUNMSK
	CMA		/RESET TO MASK OUT OTHER HALF OF WORD
	DAC PUNMSK
	LAW PUNBUF	/RESET BUFFER POINTER
	DAC PUNI
	JMP PUNLD0

/COME HERE ON PUNCH INTERRUPT

PUNINT,	JMS PUNCHR
	DISMIS

/PUNCH ONE CHARACTER FROM THE PUNCH BUFFER

PUNCHR,	0
	LAS
	SPA
PUNCL,	PUNSET		/SUPPRESS PUNCHING SWITCH ON
	LAC PUNO
	SAD (LAW PUNBUF+PN	/CHECK END OF BUFFER
	JMP OPB1
OPB0,	LAC PUNCNT
	SAD (-PN-PN 1
	JMP OPBF		/PUNCHING CAUGHT UP WITH FILLING BUFFER
	TAD (-0
	DAC PUNCNT	/DECREMENT COUNT ON PUNCH-OUT
	LAC I PUNO
	ISZ PUNO
OPBM,	XX		/SKP OR NOP
	JMP OPBM1		/CHARACTER ALREADY IN RIGHT HALF OF AC
	RTR
	RTR
	RAR
	RTR
	RTR
OPBM1,	DAC PUNTE#
	IORS
	AND (400		/CHECK PTP EMPTY FLAG
	SNA
	JMP .+4
	CLC		/IF SO, SET AC TO ALL ONES
	HLT		/AND WAIT FOR TAPE REFILL
	JMP .-6
	LAC PUNTE
	PLS
	DZM PUNPON
	JMP I PUNCHR
OPB1,	LAW PUNBUF	/RESET BUFFER POINTER
	DAC PUNO
	LAC OPBM		/NOP IF CHARACTER IN RT. HALF OF BUFFER
	XOR (SKP-NOP	/SKP IF CHARACTER IN LEFT HALF OF BUFFER
	DAC OPBM
	JMP OPB0

OPBF,	PCF		/SET FLAG TO DISABLE INTERRUPT
	CLC
	DAC PUNPON	/SET FLAG TO RE-ENABLE IT AGAIN
	JMP I PUNCHR

PUNBUF,	PUNBUF+PN/

START
