TITLE BLOCK  PROGRAM TO TRANSLATE AN ASCII FILE TO BCD(026,029)
;AND/OR EBCDIC ON MULTIPLE OUTPUT UNITS
	SUBTTL W.H.KROPP AUG 1971

;BROOKHAVEN NATIONAL LABS
;BLD 197
;UPTON L.I. N. Y. 11973
;TEL AC/516 345 2903 OR 2902

;AC DEFINITION
	AC0=0
	AC1=1
	AC2=2
	AC3=3
	AC4=4
	AC5=5
	AC6=6
	AC7=7
	AC10=10
	AC11=11
	AC12=12
	AC13=13
	AC14=14
	AC15=15
	AC16=16
	Q=16
	PDL=17
	INDEX=1
	RES=2
	NUM=4
	FLG=0


	UNITS==5
;CONFIGURED FOR FIVE UNITS-HOWEVER IT CAN BE EXTENDED ARBITARILY
;TO 14 (# OF SOFTWARE CHANNELS AVAILABLE) ----THUS SET UNITS TO DESIRED NUMBER OF OUTPUT UNITS

	EXTERN	JOBFF,JOBVER,JOBSA,JOBREL
	VBLK==UNITS,,2

	;VERSION 2 JULY 1972
	;VERSION 1 DEC 1971
	LOC	137
	VBLK
	RELOC



BLOCK:	CALL	[SIXBIT/RESET/]			;RESET I/O
	MOVEI	AC2,GRPPTR-BUFPTR-1		;NUM OF LOCATIONS TO CLEAR
CLRLP:	SETZM	,BUFPTR(AC2)			;CLEAR LOCATION
	SOJGE	AC2,CLRLP			;LOOP OVER CLEAR AREA
	MOVE	PDL,[IOWD 15,PDLST]		;SET UP PUSH DOWN LST
	PUSHJ	PDL,TTYINT			;INITALIZE TTY
	MOVE	AC6,JOBFF			;PICK UP LOWESTS LOC
	MOVEM	AC6,JOBFFP#			;SAVE FOR RELEASING CORE
INPT:	SETZB	FLG,INDEX			;SET FLAG FOR INPUT
	TTCALL	3,IN1				;TYPE MESSAGE
	PUSHJ	PDL,UNITDF			;DEFINE INPUT UNIT
	MOVE	AC6,[XWD 0,INBBUF]		;GET BUFFER WD
	MOVEM	AC6,SPEC+2			;STORE IN SPEC+2
OPENN:	OPEN	15,SPEC				;INPUT ON CHANNEL 15
	JRST	ERRNA				;INPUT UNIT NOT AVAIL
	SETZM	,SPEC+2				;CLEAR BUFFER WORD
	LOOKUP	15,FILNA			;SEARCH FOR FILE
	JRST	LOOKER				;FILE NOT FOUND
	MOVEI	INDEX,15			;SET INDEX FOR SKIPER
	HLRZ	AC6,SPEC+1			;GET SIXBIT DEVICE NAME
	CAIN	AC6,556441			;MTA?
	PUSHJ	PDL,SKIPER			;YES SKIP FILES
	SETZ	INDEX,				;ZERO INDEX
	SETO	FLG,				;SET FLG
	MOVEI	AC6,ONE				;GET ADR OF DECODING LOOP
	MOVEM	AC6,STONE			;STORE ADR
DEFLP:	TTCALL	3,OT1				;TYPE OUTPUT MESSAGE
	PUSHJ	PDL,UNITDF			;DEFINE OUTPUT UNIT
STDQUS:	TTCALL	3,STD				;TYPE MESSAGE
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	JUMPE	RES,STDQU			;CR ANS SKIP STD OPTION
	TLNE	RES,230000			;ANS YES?
	SKIPA					;NO---SKIP INST
	JRST	STDOP				;YES--SET STANDARD OPTION
	TLNE	RES,260000			;ANS SAME?
	SKIPA					;NO-- SKIP NEXT INST
	JRST	SAMSET				;YES---SKIP OVER PROCESSING
	TLNE	RES,304000			;ANS NO?
	JRST	STDQUS				;---NO REPEAT QUESTION
STDQU:	TTCALL	3,STDFMT			;TYPE STANDARD FORMAT MESS
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	JUMPE	RES,CODQU			;CR ANS---GO TO NEXT QUESTION
	LSH	RES,-^D29			;SHIFT RESPONSE
	SUBI	RES,101				;SUBTRACT 100
	JUMPL	RES,STDQU			;REPEAT QUESTION
	CAIG	RES,3				;103-101 
	JRST	@DSP(RES)			;YES DISPATCH
	CAIE	RES,7				;HELP?
	JRST	STDQU				;NO REPEAT QUESTION
	TTCALL	3,STDMTS			;YES---EXPAND DEFINITION
	JRST	STDQU+1				;GET RESPONSE
CODQU:	PUSHJ	PDL,CODE			;DEFINE CODE
LRECQU:	TTCALL	3,BKFATR			;TYPE LOGICAL PHY REC MESS
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	JUMPE	RES,.-2				;LOOP ANS BLANK
	PUSHJ	PDL,CONVT			;CONVERT TO INTEGER
	PUSHJ	PDL,EXPAND			;SET UP OUTPUT BUFFER
GPMK:	TTCALL	3,GPMRK				;TYPE GROUP MARKER MESS
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	JUMPE	RES,RECMK			;SKIP IF BLANK
	MOVEI	AC16,2				;SET CTR FOR OCTIN
	MOVE	AC10,STATWD(INDEX)		;GET STATWD
	TLNE	AC10,1B19			;BCD MODE?
	MOVEI	AC16,3				;NO---SET FOR EBCDIC ANS
	MOVE	AC3,AC16				;STORE CTR
	PUSHJ	PDL,OCTIN			;CONVERT TO OCTAL
	IMULI	AC3,3				;COMP # OF PLACES
	ROT	NUM,0(AC3)			;ROTATE LEFT
	PUSHJ	PDL,STOGRP			;STORE GROUP MARKER
RECMK:	TTCALL	3,RCMRK				;TYPE RECORD MARKER MESS
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	JUMPE	RES,SETLP			;SKIP PROCESSING
	MOVEI	AC16,2				;SET CTR FOR OCTIN
	TLNE	AC10,1B19			;SKIP IF BCD
	MOVEI	AC16,3				;SET FOR EBCDIC
		MOVE	AC3,AC16			;STORE CTR
	PUSHJ	PDL,OCTIN			;CONVERT TO OCTAL
	IMULI	AC3,3			;COMP # OF PLACES
	ROT	NUM,0(AC3)				;ROTATE LEFT
	PUSHJ	PDL,STORMK			;STORE RECORD MARKER
SETLP:	HRLI	AC6,COPY			;SET UP AC FOR BLT
	HRR	AC6,STONE			;PICK UP STONE ADR
	MOVE	AC7,STONE			;GET STONE ADR
	BLT	AC6,2(AC7)			;STORE 3 INST IN DECODING LOOP
	ADDI	AC7,3				;INCR STONE
	MOVEM	AC7,STONE#			;RESTORE STONE
DEFENT:	JSP	AC16,STOCHN			;STORE CHANNEL #
	OPEN	0,SPEC				;INIT UNIT
	JRST	ERRNA1				;CHANNEL NOT AVAILABLE
	MOVE	AC6,SPEC			;GET SPEC
	MOVEM	AC6,UNITST(INDEX)		;SAVE UNIT SPECS
	PUSHJ	PDL,SKIPER			;SKIP FILES
	MOVE	AC6,STATWD(INDEX)		;GET STATWD
	TLNN	AC6,1B19			;EBCDIC?
	JRST	DEFEND				;NO SKIP OVER 9TK SET
	JSP	AC16,STOCH1			;STORE CHANNEL NUMBER
	MTAPE	0,101				;SET FOR 9TK
	MTAPE	0,13				;WRITE 3 INCHES BLANK TAPE
DEFEND:	AOJA	INDEX,DEFLP			;LOOP OVER DEFINITIONS

FINDEF:	MOVN	AC6,INDEX		;GET NEGATIVE
	HRLZM	AC6,INDLOC		;SWAP HALFS
	MOVE	AC6,NEEDLO			;PICK UP JRST INST
	SOS	AC7,STONE			;OVER WRITE 
	MOVEM	AC6,(AC7)			;TERMINATE LOOP
	SETZ	AC0,			;ZERO FOR CHAR CTR
	JRST	LOOP

;	SAME AS PREVIOUS FORMAT

SAMSET:	JUMPE	INDEX,ERRR4			;CAN'T TYPE SAME ON 1 ST OUTPUT
	MOVE	AC6,STONE			;GET LAST LOOP INST
	SOJ	AC6,				;SUBTRACT ONE
	AOS	,@AC6				;BUMP INST IN DECODING LOOP
	MOVE	AC6,STATWD-1(INDEX)		;PICK UP LAST STATWD
	TLZ	AC6,1B18			;ZERO BUFFER BIT
	MOVEM	AC6,STATWD(INDEX)		;STORE MODIFIED STATWD WD
	MOVE	AC6,UNMARK-1(INDEX)		;GET PREVIOUS UNMARK
	MOVEM	AC6,UNMARK(INDEX)		;STORE UNMARK
	MOVE	AC6,GETCHR-1(INDEX)		;USED IN HEADER
	MOVEM	AC6,GETCHR(INDEX)		;TO DETERMINE CODE
	JRST	DEFENT				;RETURN TO DEFINITION LOOP


ERRR4:	TTCALL	3,ERRR4M			;TYPE ERROR MESS
	JRST	DEFLP				;RETURN TO DEFINITION LOOP


;	LOOP INSTRUCTIONS

COPY:	LDB	AC11,GETCHR(INDEX)
	IDPB	AC11,STOCHR(INDEX)
	ADDI	INDEX,1



;	GENERAL TRANSLATION LOOP

READ:	INPUT	15,			;READ INPUT ASCII RECORD
	STATZ	15,362000		;STATUS OK?
	PUSHJ	PDL,STATIN		;NO PROCESS INPUT STATUS
	AOS	,PSYIN			;INCR INPUT PSY REC CTR
LOOP:	SOSGE	,INBBUF+2		;-1 FROM BUFFER WD CTR
	JRST	READ			;BUFFER EMPTY READ NEXT RECORD
	ILDB	AC10,INBBUF+1		;GET CHAR FROM INPUT BUFFER
	JUMPE	AC10,LOOP		;JUMP IF NULL
	CAIN	AC10,15			;END OF LOG REC ON INPUT
	JRST	ENTRY			;YES PROCESS REC MARKS ETC
	SUBI	AC10,40			;REMOVE OFFSET
	JUMPL	AC10,LOOP		;LOOP IF LESS THAN 40
	AOJ 	AC0,			;INCREMENT CHAR CTR
	SETZ	INDEX,			;ZERO INDEX
ONE:	BLOCK UNITS*3-1

;	ROUTINE ENTERED AFTER LOGICAL RECORD READ ON INPUT

ENTRY:	MOVE	INDEX,INDLOC		;SET UP INDEX
	AOS	,LOGCTR			;INCR LOGICAL RECORD CTR
	SKIPN	,CHLOGR			;SKIP IF NOT 1 ST TIME THRU
	MOVEM	AC0,CHLOGR		;STORE CHARACTERS PER LOG REC
	CAMN	AC0,CHLOGR		;IS LOGICAL REC FIXED LENGTH?
	JRST	ENTRY1			;YES
ENTRY0:	MOVE	AC16,STATWD(INDEX)	;GET STATWD
	TLNE	AC16,1B21		;HAS IT BEEN SET TO VAR LENGTH?
	JRST	ENTRY1			;YES--SKIP PROCESSING
	TLO	AC16,1B21		;NO---FLAG VARIABLE LENGTH
	MOVEM	AC16,STATWD(INDEX)	;RESTORE STATWD
	AOBJN	INDEX,ENTRY0		;LOOP OVER UNITS
	MOVE	INDEX,INDLOC		;RESET INDEX
ENTRY1:	AOS	AC16,STATWD(INDEX)	;ADD ONE TO LOGICAL RECORD CTR
	SKIPGE	AC10,UNMARK(INDEX)	;GROUP OR RECORD MARKER USED
	PUSHJ	PDL,MARKER		;YES --INSERT MARKER
	LDB	AC10,LOGPTR		;GET CURRENT LOG REC CTR
	HRRZS	,AC16			;ZERO LEFT HALF
	CAML	AC16,AC10		;CURRENT LOG REC# = SET # OF LOG RECS
	JRST	OUTPUT			;YES --DO OUTPUT
	AOBJN	INDEX,ENTRY1		;LOOP OVER UNITS
ENTRY2:	SETZ	AC0,			;CLEAR CHARACTER CTR
	SKIPGE	,BUFCLR			;DO ANY BUFFER HAVE TO BE CLEARED
	JRST	SETPTR			;YES SET POINTERS & CLR BUFFER
NEEDLO:	JRST	LOOP			;RETURN TO TRANSLATION

OUTPUT:	HRRZ	AC10,STOCHR(INDEX)	;GET ADR IN OUTBUF
	HRRZ	AC11,BUFPTR(INDEX)	;GET INITAL ADR OF BUFFER
	SUB	AC10,AC11		;WDS IN OUTBUF	
	JUMPE	AC10,PLUS6		;FIX ????
	MOVN	AC12,AC10		;GET NEGATIVE
	MOVE	AC13,BUFPTR(INDEX)	;GET BUF STATS
	HRRM	AC13,LST		;STORE ADR IN OUTPUT LST
	HLRES	,AC13			;GET NEG # OF WDS IN BUFFER
	CAMGE	AC12,AC13		;BUFFER EXCEED AREA PROVIDED?
	JRST	ERRR1			;YES---PROBLEM
	HRLM	AC12,LST		;NO STORE WD CT IN LST
SAME:	JSP	AC16,STOCH1		;STORE CHANNEL NUMBERS
	OUTPUT	0,LST			;OUTPUT
	STATZ	0,742000		;STATUS OK?
	PUSHJ	PDL,STATOT		;NO PROCESS OUTPUT STATUS
	AOS	,PSYCTR(INDEX)		;INCR OUTPUT PSY CTR
	SKIPE	,FINFLG			;SKIP IF NOT FINISHING
	POPJ	PDL,			;RETURN TO DMPOUT ROUTINE
PLUS6:	SETOM	,BUFCLR#		;SET FLAG FOR CLEARING BUFF
	HRLZI	AC10,1B20		;GET CLEAR BUFFER BIT
	IORM	AC10,STATWD(INDEX)	;SET BIT IN STATWD
	AOBJN	INDEX,.+2		;END OF LOOP
	JRST	ENTRY2			;YES
	SKIPL	,STATWD(INDEX)		;SAME POUPUT BUFFER?
	JRST	SAME			;YES
	JRST	ENTRY1			;CONTINUE LOOP


;	ERROR ROUTINES

ERRR1:	TTCALL	3,ERRR1M		;TYPE ERROR MESSAGE
	CALL	[SIXBIT/EXIT/]		;EXIT


;	ROUTINE TO CLOSE OUT OUPUT UNITS WHEN EOF ON INPUT

DMPOUT:	SETOM	,FINFLG			;SET FINFLG CLOSING BUFFERS
	MOVE	INDEX,INDLOC		;SET UP INDEX
EXOUT:	SKIPL	AC16,STATWD(INDEX)	;SAME OUTPUT BUFFER?
	JRST	SAMCLS			;YES PROCESS
	SETZM	,LASTOT			;ZERO LASTOT---RESET FLG
	TRNN	AC16,377777		;ANY MISC RECORDS IN OUTBUF?
	JRST	CLSOUT			;NO---CLOSE OUTPUT---EOF
	TLNN	AC16,1B21		;FIXED LENGTH?
	JRST	FILOUT			;YES--FILL OUT LAST REC
FILRET:	SETOM	,LASTOT			;SET LAST OUTPUT FLG
	SKIPL	AC10,UNMARK(INDEX)	;ANY MARKERS USED?
	JRST	EXOUT1			;NO---SKIP MARKER PROCESS
	LDB	AC11,LOGPTR		;GET BLOCKING FACTOR
	IORM	AC11,AC16		;SET TO FORSE RECORD MARKER
	PUSHJ	PDL,MARKER		;WRITE MARKER
EXOUT1:	PUSHJ	PDL,OUTPUT		;WRITE LAST OUTPUT
CLSOUT:	JSP	AC16,STOCHN		;SET SOFTWARE CHANNEL #
	CLOSE	0,0			;WRITE EOF
	AOBJN	INDEX,EXOUT		;LOOP
	CLOSE	15,0			;CLOSE INPUT
	JRST	DESCPT		

;SAME OUTPUT BUFFER
SAMCLS:	SKIPE	,LASTOT			;LAST OUTPUT BUFFER WRITTEN?
	PUSHJ	PDL,SAME		;YES---DUMP BUFFER
	JRST	CLSOUT			;WRITE EOF

;	ROUTINE TO FILL OUT LAST PHYSICAL RECORD IF BLOCKING FACTOR
;	GT 1 AND FIXED LENGTH LOGICAL RECORDS

FILOUT:	LDB	AC6,LOGPTR		;GET BLOCKING FACTOR
	CAIN	AC6,1			;BF=1
	JRST	FILRET			;YES---RETURN
	MOVE	AC13,BCDBLK		;GET BCD FILLER CHAR
	TLNE	AC16,1B19		;EBCDIC?
	SETZ	AC13,			;YES--SET TO NULL CHAR
	HRRZS	,AC16			;GET CURRENT # OF LOGICAL RECS
	SUB	AC6,AC16		;# OF LOGICAL RECS TO FILL
	MOVEM	AC6,FILREC(INDEX)	;STORE COUNT OF FILLER RECS
	SOJ	AC6,			;SUBTRACT ONE
	JUMPL	AC6,FILRET		;RECORD FILLED OUT
	SETZM	,FINFLG			;RESET FLG FOR FILLER
RECLOP:	MOVEI	AC5,1			;SET UP AC CTR
FILOP:	IDPB	AC13,STOCHR(INDEX)	;STORE FILLER CHAR
	CAMGE	AC5,CHLOGR		;LOGICAL RECORD FILLED?
	AOJA	AC5,FILOP		;NO CONTINUE FILLING
	SKIPGE	AC10,UNMARK(INDEX)	;GROUP OR RECORD MARKER USED?
	PUSHJ	PDL,MARKER		;YES INSERT MARKER
	SOJGE	AC6,RECLOP		;LOOP OVER RECORDS
	SETOM	,FINFLG			;RESET FLG
	JRST	FILRET			;RETURN


;	ROUTINETO INSERT GROUP AND RECORD MARKERS

MARKER:	TLNN	AC10,1B20		;RECORD MARKER USED
	JRST	GRPMRK			;NO PROCESS AS GROUP MARKER
	LDB	AC11,LOGPTR		;GET # OF LOG REC PER PHYSICAL
	HRRZ	AC12,AC16		;GET CURRENT # OF LOG RECS
	CAML	AC12,AC11		;BUFFER FULL OF LOG RECS
	JRST	RECMRK			;YES GENERATE RECORD MARKER
	TLNN	AC10,1B19		;GROUP MARKERS USED?
	POPJ	PDL,			;NO --RETURN
GRPMRK:	LDB	AC10,GRPPTR		;GET GROUP MARKER
	SKIPGE	,FINFLG			;LAST OUTPUT BUFFER?
	JRST	LASTMK			;YES---DON'T INCR BYTE POINTER
	IDPB	AC10,STOCHR(INDEX)	;STORE MARKER IN OUTBUF
	POPJ	PDL,			;RETURN
RECMRK:	LDB	AC10,RECPTR		;GET RECORD POINTER
	JRST	GRPMRK+1		;STORE AND RETURN

;WRITE OVER LAST MARKER
LASTMK:	DPB	AC10,STOCHR(INDEX)	;STORE MARKER
	POPJ	PDL,			;RETURN

;	ROUTINE TO STORE CHANNEL NUMBER IN I/O UUO'S


STOCH2:	DPB	INDEX,STOCP2		;STORE CHANNEL NUMBER
STOCH1:	DPB	INDEX,STOCP1		;STORE CHANNEL NUMBER
STOCHN:	DPB	INDEX,STOCHP		;DEPOSIT INDEX IN CHANNEL #
	JRST	(AC16)				;RETURN

STOCHP:	POINT 4,(AC16),12
STOCP1:	POINT 4,1(AC16),12
STOCP2:	POINT 4,2(AC16),12





;	ROUTINE TO RESET POINTERS AND CLEAR BUFFERS

SETPTR:	SETZM	,BUFCLR			;RESET FLAG
	MOVE	INDEX,INDLOC		;SET UP INDEX
SETPT1:	SKIPL	AC16,STATWD(INDEX)	;SAME OUTPUT BUFFER
	JRST	SETLOP			;YES ---SKIP PROCESSING
	TLZN	AC16,1B20		;IS BUFFER TO BE CLEARED?
	JRST	SETLOP			;NO
	HLLZS	,AC16			;ZERO LOG REC CTR
	MOVE	AC10,STOCHR(INDEX)	;GET STOCHR POINTER
	TLZ	AC10,770000		;ZERO POSITION
	HRR	AC10,BUFPTR(INDEX)	;RESET BUFFER ADR
	MOVEM	AC10,STOCHR(INDEX)	;STORE NEW POINTER
	MOVE	AC10,BUFPTR(INDEX)	;GET BUFPTR
	MOVE	AC6,BCDBLK		;GET WD OF BCD BLANKS
	TLNE	AC16,1B19		;IS CODE EBCDIC?
	SETZ	AC6,			;YES--SET FILLERS TO ZEROS
	MOVEM	AC6,1(AC10)		;SET UP INPUT BUFFER
	AOBJN	AC10,.-1		;LOOP
RESTOR:	MOVEM	AC16,STATWD(INDEX)	;RESTORE STATWD
SETLOP:	AOBJN	INDEX,SETPT1		;LOOP OVER UNITS
	JRST	LOOP			;CONTINUE TRANSLATION

BCDBLK:	202020202020

;	ROUTINE TO SKIP FILES

SKIPER:	TTCALL	3,SKPMES		;TYPE MESSAGE
	PUSHJ	PDL,INCHRS		;GET RESPONSE
	PUSHJ	PDL,CONVT		;CONVERT TO INTEGER
SKPENT:	JUMPE	NUM,SKPRET		;RETURN IF 0
	MOVE	AC6,NUM			;SAVE CTR
	MOVMS	,NUM			;GET MAGNITUDE
	MOVEI	AC3,16			;SET FOR FORWARD DIRECTION
	SKIPG	,AC6			;BACKSPACE
	TRO	AC3,1B35		;YES--SET TO 17
	JSP	AC16,STOCH2		;STORE CHANNEL NUMBERS
SKPFIL:	MTAPE	0,0(AC3)		;SKIP
	MTAPE	0,0			;I/O WAIT
	STATO	0,4000			;BEG OF TAPE?
	SOJG	NUM,SKPFIL		;LOOP OVER FILES
	JUMPG	AC6,SKPRET		;FORWARD RETURN
	JSP	AC16,STOCHN		;STORE CHANNEL NUMBER
	STATZ	0,4000			;BEG OF TAPE?
SKPRET:	POPJ	PDL,			;YES--RETURN
	JSP	AC16,STOCH1		;STORE CHANNEL NUMBERS
	MTAPE	0,16			;SKIP OVER EOF 
	MTAPE	0,0			;I/O WAIT
	POPJ	PDL,		;RETURN




;	UNIT NOT AVAILABLE MESSAGES

ERRNA:	TTCALL	3,IN1			;TYPE INPUT
	JRST	ERRNA2			;SKIP
ERRNA1:	TTCALL	3,UNITNA(INDEX)		;TYPE OUTPUT
ERRNA2:	TTCALL	3,MESS3			;TYPE NOT AVAILABLE MESSAGE
	JUMPE	FLG,INPT		;RETURN TO INPUT
	JRST	DEFLP		;RETURN

MESS3:	ASCIZ/UNIT NOT AVAILABLE 
/


;	ROUTINE TO SET GROUP MARKER

STOGRP:	DPB	NUM,GRPPTR		;STORE GROUP MARKER
	HRLZI	AC6,1B18+1B19		;SET UP MASK
	IORM	AC6,UNMARK(INDEX)	;SET BITS
	POPJ	PDL,			;RETURN

;	ROUTINE TO SET RECORD MARKER

STORMK:	DPB	NUM,RECPTR		;STORE RECORD MARKER
	HRLZI	AC6,1B18+1B20		;SET UP MASK
	IORM	AC6,UNMARK(INDEX)	;SET BITS
	POPJ	PDL,			;RETURN


;	ROUTINE TO SET OUTPUT FOR STANDARD OPTION
;	STANDARD OPTION
; A	ONE(1) PHYSICAL RECORD PER LOGICAL RECORD
; B	O26 BCD FORMAT

STDOP:	PUSHJ	PDL,STDCOD		;SET O26 CODE
	MOVEI	NUM,1			;SET NUMBER FOR EXPAND
	PUSHJ	PDL,EXPAND		;SET UP OUTPUT BUFFERS
	JRST	SETLP			;RETURN TO LOOP

;	ROUTINE TO COMPUTE OUTPUT BUFFER SIZE AND EXPAND CORE
;	ASSUMPTION----- LOGICAL RECORD DOES NOT EXCEED 134 CHARACTERS

	BCDWDS==^D24
	EBCDWD==^D34

EXPAND:	DPB	NUM,LOGPTR		;DEPOSITE # OF LOGICAL RECORDS
	MOVE	AC16,STATWD(INDEX)	;GET STATWD
	TLO	AC16,1B18		;SET BUFFER BIT
	TLNN	AC16,1B19		;EBCDIC?
	IMULI	NUM,BCDWDS		;NO--SET FOR BCD
	TLNE	AC16,1B19		;BCD?
	IMULI	NUM,EBCDWD		;NO-- SET FOR EBCDIC
	MOVEM	AC16,STATWD(INDEX)	;RESTORE STATWD
	MOVE	AC6,JOBFF		;GET PROG CURRENT SIZE
	HRRZM	AC6,BUFPTR(INDEX)	;STORE OUTPUT BUFFER ADR
	HRRM	AC6,STOCHR(INDEX)	;SET FOR 1ST PASS
	ADDM	NUM,JOBFF		;INCREASE PROG SIZE
	AOS	AC7,JOBFF		;ADD ONE BEYOND BUFFER
CORTST:	CAML	AC7,JOBREL		;REQUIRED TO EXPAND CORE?
	JRST	CORE			;YES----
	MOVNS	,NUM			;GET NEGATIVE BUFFER SIZE CT
	HRLM	NUM,BUFPTR(INDEX)	;STORE
	HRLZS	NUM,NUM			;SET UP CTR
	HRRM	AC6,ZLOOP		;STORE STARTING ADR
	MOVE	AC6,BCDBLK		;GET BCD FILLER
	TLNE	AC16,1B19		;EBCDIC CODE?
	SETZ	AC6,			;YES ZERO FILLER
ZLOOP:	MOVEM	AC6,(NUM)		;SETUP NEW BUFFER AREA
	AOBJN	NUM,ZLOOP		;LOOP
	POPJ	PDL,			;RETURN

CORE:	CALL	AC7,[SIXBIT/CORE/]	;EXPAND CORE
	JRST	CORERR			;ERROR---CORE NOT AVAIL
	JRST 	CORTST			;TEST  AGAIN

CORERR:	TTCALL	3,CORER
	JRST	EXIT


;	ROUTINE TO SET STANDARD FORMATS

;	DISPATCH TABLE

DSP:	JRST	CODQU
	JRST	USAEU1
	JRST	IBM36

;	USAER1----80 CHARS PER LOGICAL REC; BLOCKING FACTOR 10
;	GROUP MARKER 32(8); RECORD MARKER 77(8)

USAEU1:	PUSHJ	PDL,STDCOD		;SET CODE TO BCD O26
	MOVEI	NUM,^D10		;GET BLOCKING FACTOR
	PUSHJ	PDL,EXPAND		;EXPAND CORE
	MOVEI	NUM,32			;GET GROUP MARKER
	PUSHJ	PDL,STOGRP		;STORE GROUP MARKER
	MOVEI	NUM,77			;GET RECORD MARKER
	PUSHJ	PDL,STORMK		;STORE RECORD MARKER
	JRST	SETLP			;RETURN TO DEFINITION LOOP

;	IBM360----BLOCKING FACTOR 91; NO GROUP & REC MARKERS
;	UPPER & LOWER CASE EBCDIC

IBM36:	PUSHJ	PDL,CDEBL+2		;SET EBCDIC CODE
	MOVEI	NUM,^D91		;GET BLOCKING FACTOR
	PUSHJ	PDL,EXPAND		;EXPAND CORE
	JRST	SETLP			;RETURN TO DEFINITION LOOP

	;STATUS PROCESSING

	EOT==1B25
	RECLNG==1B21
	EOF==1B22
	MISDAT==1B19
	PARER==1B20
	WRLOK==1B18

STATOT:	SETZM	STATFG#			;ZERO STATFG
	JSP	AC16,STOCHN		;STORE UNIT CH NUM
	GETSTS	0,AC2			;GET STATUS
	JRST	STATUS			;PROCESS STATUS

VERST:	MOVEI	AC2,1			;GET ONE
	MOVEM	AC2,STATFG		;SET FLAG
	AOJ	AC7,			;INCR ERROR CTR
	MOVEM	AC10,LOGCTR		;RESET LOGCTR
	JRST	STATOT+1		;GET STATUS ETC

STATIN:	GETSTS	15,AC2			;GET STATUS
	SETOM	STATFG			;STORE STATUS
STATUS:	TTCALL	3,CR			;SKIP LINE
	TRNE	AC2,WRLOK		;UNIT WRITE LOCKED
	JRST	WRTLK			;YES PROCESS
	TRNE	AC2,EOF			;END OF FILE?
	JRST	ENDOF			;YES PROCESS
	TRNE	AC2,PARER		;PARITY ERROR
	JRST	PARERR			;YES PROCESS
	TRNE	AC2,EOT			;END OF TAPE?
	JRST	EDOT			;YES PRICESS
	TRNE	AC2,RECLNG		;BLOCK TO LARGE?
	JRST	RECLG			;YES PROCESS
	TRNE	AC2,MISDAT		;MISSED DAT?
	JRST	MISSDT			;YES PROCESS

WRTLK:	POP	PDL,			;DROP LAST ADR ON PDL LIST
	TTCALL	3,WLK			;TYPE WRITE LOCK MESSAGE
	TRZ	AC2,WRLOK		;COMPLEMENT BIT
	PUSHJ	PDL,SETOUT		;SET STATUS
	JRST	SAME			;TRY WRITE AGAIN

PARERR:	TTCALL	3,PARR			;TYPE PARITY ERROR
	TRZ	AC2,PARER		;COMPLEMENT BIT
DECISN:	SKIPL	,STATFG			;SKIP IF INPUT
	JRST	SETOUT			;SET OUTPUT AND VERIFY STATUS
	JRST	SETIN			;SET INPUT STATUS

EDOT:	TTCALL	3,ENDOT			;TYPE END OF TAPE MESS
	TRZ	AC2,EOT				;COMPLEMENT BIT
	JRST	DECISN		

RECLG:	TTCALL	3,RECLRG		;TYPE RECORD TO LARGE
	TRZ	AC2,RECLNG		;COMPLEMENT BIT
	JRST	DECISN			;FINISH PROCESSING

MISSDT:	TTCALL	3,MISDT			;TYPE MISSED DATA MESS
	TRZ	AC2,MISDAT		;COMPLEMENT BIT
	JRST	DECISN			;FINISH PROCESSING

ENDOF:	POP	PDL,			;DROP LAST ADR ON PDL LIST
	SKIPL	,STATFG			;SKIP IF IN OUTPUT LOOP
	JRST	ENDVER			;RETURN TOVERIFY LOOP
	JRST	DMPOUT			;RETURN TO OUTPUT LOOP

SETOUT:	TTCALL	3,UNITNA(INDEX)		;TYPE UNIT
	JSP	AC16,STOCHN		;SET CHANNEL # IN UUO
	SETSTS	0,(AC2)			;STORE STATUS
	PUSHJ	PDL,GENMES		;TYPE GENERAL MESSAGE
	POPJ	PDL,			;RETURN

SETIN:	TTCALL	3,IN1			;TYPE INPUT
	SETSTS	15,(AC2)		;RESET STATUS
	JRST	SETOUT+3		;FINISH PROCESSING

GENMES:	TTCALL	3,CR			;SKIP LINE
	PUSHJ	PDL,RECTR		;TYPE RECORD COUNTER
	TTCALL	3,EXCONT		;MESS TO CONT OR EXIT
	PUSHJ	PDL,INCHRS		;GET RESPONSE
	JUMPE	RES,EXIT		;CR?---YES EXIT
	TLNE	RES,360000		;ANS C?
	JRST	GENMES+2		;NO--REPEART MESSAGE
	POPJ	PDL,			;RETURN

	;STATUS TELETYPE MESSAGES

WLK:	ASCIZ/ UNIT WRITE LOCKED /
EXCONT:	ASCIZ/ CONT OR CR TO EXIT: /
PARR:	ASCIZ/ PARITY ERROR ON /
ENDOT:	ASCIZ/ END OF TAPE ON /
RECLRG:	ASCIZ/ RECORD TO LARGE ON /
MISDT:	ASCIZ/ DATA MISSED;OR DSK SEARCH ERROR ON /



;	EXIT ROUTINE

EXIT:	CALL	[SIXBIT/EXIT/]



;	GENERAL ROUTINES******************

;	TTY INITALIZATION AND INPUT ROUTINE INCHRS

TTYINT:	INIT	17,0			;INIT CHANNEL 17
	SIXBIT/TTY/			;TELETYPE
	XWD	0,TTYBUF		;ONLY INPUT BUFFER
	JRST	EXIT			;TELETYPE NOT AVAILABLE
	INBUF	17,1			;ONLY ONE BUFFER
	POPJ	PDL,			;RETURN

TTYBUF:	BLOCK	3

INCHRS:	MOVE	AC13,CHPNTR		;GET BYTE POINTER
	INPUT	17,0			;READ INPUT
TTYOK:	SETZB	RES,RES+1		;ZERO ACS
INNN:	ILDB	AC6,TTYBUF+1		;GET CHARACTER
	CAIN	AC6,15			;END OF LINE?
	POPJ	PDL,			;YES
	IDPB	AC6,AC13		;DEPOSITE CHAR
	JRST	INNN			;LOOP OVER INPUT


CHPNTR:	POINT	7,RES

;	ROUTINE TO CONVERT ASCII TO INTEGER

CONVT:	MOVE	AC11,ASCPT		;GET ASCII POINTER
	SETZB	AC3,NUM			;ZERO REGS
	ILDB	AC7,AC11		;GET 1ST CHAR
	CAIE	AC7,"-"			;IS IT NEG?
	JRST	ANOTH+1			;NO CONTINUE PROCESSING
	SETO	AC3,			;YES FLAG NEG
ANOTH:	ILDB	AC7,AC11		;GET CHARACTER
	CAIL	AC7,60			;TEST IF IT IS A NUMBER
	CAILE	AC7,71			;
	JRST	ENDER			;IT ISN'T--PROCESS
	SUBI	AC7,60			;REMOVE OFFSET
	ADD	AC7,NUM			;ADD TO LOC
	IMULI	AC7,12			;MULT BY 10
	MOVEM	AC7,NUM			;STORE RESULT
	JRST	ANOTH			;LOOP

ENDER:	JUMPE	AC7,FINIS		;END OF INPUT STRING
	TTCALL	3,ERRCHR		;ERROR IN INPUT MESSAGE
	POP	PDL,AC15		;GET RETURN ADR
	JRST	-3(AC15)			;RETURN

FINIS:	IDIVI	NUM,12			;REMOVE LAST MULT
	SKIPE	,AC3			;SKIP IF NEG FLAG NOT SET
	MOVNS	,NUM			;GET NEGATIVE RESULT
	POPJ	PDL,			;RETURN

ASCPT:	POINT	7,RES

;	ROUTINE TO CONVERT ASCII TO SIXBIT

CVTSIX:	MOVE	AC10,ASCPT		;GET POINTER
	MOVE	AC11,SIXPTR		;GET SIXBIT POINTER
	SETZ	NUM,			;ZERO RESULT
NEXT:	ILDB	AC12,AC10		;GET CHARACTER
	JUMPE	AC12,.+3		;END OF STRING?
	CAIE	AC12,"."		;EXTENSION?
	CAIN	AC12," "		;BLANK-END OF STRING ASSUMED
	POPJ	PDL,			;RETURN
	CAIL	AC12,"0"		;CHARACTER WITHIN LEGAL RANGE
	CAILE	AC12,"Z"		;   "      "    "      "
	JRST	ERRIN			;NO ERROR PROCESS
	SUBI	AC12,40			;REMOVE OFFSET
	IDPB	AC12,AC11		;STOPE IN NUM
	AOJL	AC6,NEXT		;LOOP
	POPJ	PDL,			;RETURN

SIXPTR:	POINT 6,NUM


;	ERROR ROUTINE FOR CVTSIX--AC7 CONTAINS CTR TO REPROCESS

ERRIN:	TTCALL	3,ERRCHR		;TYPE MESSAGE
	POP	PDL,.+1			;STORE ADR
	JRST	0(AC7)			;RETURN


;	RECORD COUNTER MESSAGE

RECTR:	TTCALL	3,LOGREC		;TYPE MESS
	MOVE	AC15,PSYCTR(INDEX)	;GET COUNTER
	AOJ	AC15,			;ADD ONE
	SKIPGE	,STATFG			;INPUT STATUS?
	MOVE	AC15,PSYIN		;YES SET CTR FOR IN CTR
	PUSHJ	PDL,DECMAL		;TYPE COUNTER
	TTCALL	3,CR			;TYPE CR
	POPJ	PDL,			;RETURN

LOGREC:	ASCIZ/ PHYSICAL RECORD /

;	ROUTINE TO CONVERT ASCII TO OCTAL

OCTIN:	MOVE	AC5,CHPNTR		;GET ASCII POINTER
	MOVE	AC6,PTROIN		;GET OCTAL POINTER
	SETZ	NUM,			;ZERO REG
OCTINN:	ILDB	AC15,AC5		;GET CHAR
	CAIL	AC15,60			;WITH IN LEGAL RANGE
	CAILE	AC15,71			;
	JRST	OCTER			;NO ERROR
	SUBI	AC15,60			;REMOVE OFFSET
	IDPB	AC15,AC6		;STORE
	SOJG	AC16,OCTINN		;LOOP
	POPJ	PDL,			;RETURN

OCTER:	TTCALL	3,ERRCHR		;TYPE ERROR MESSAGE
	POP	PDL,AC15		;GET RETURN ADR
	JRST	-5(AC15)		;RETURN

PTROIN:	POINT	3,NUM

;	ROUTINE TO CONVERT OCTAL TO DECIMAL

DECMAL:	SETZ	AC6,			;ZERO CTR
DECLOP:	JUMPE	AC15,DECOUT		;JUMP IF NUM=0
	IDIVI	AC15,12			;DIVIDE BY 10
	ADDI	AC16,60			;OFFSET REMAINDER
	PUSH	PDL,AC16		;STORE ON PUSH DNWN LST
	AOJA	AC6,DECLOP		;LOOP

DECOUT:	JUMPE	AC6,DECRET		;RETURN IF ZERO
	POP	PDL,AC16		;GET NUMBER
	TTCALL	1,AC16			;TYPE NUMBER
	SOJG	AC6,DECOUT+1		;LOOP
DECRET:	POPJ	PDL,			;RETURN

;	ROUTINE TO OUTPUT OCTAL NUMBERS

OCTOUT:	MOVEI	AC16,^D12		;SET CTR TO 12
	MOVE	AC5,OCTPTR		;GET POINTER
LOAD:	ILDB	AC15,AC5		;GET CHARACTER
	ADDI	AC15,60			;ADD OFFSET
	TTCALL	1,AC15			;TYPE CHARACTER
	SOJG	AC16,LOAD		;LOOP OVER NUMBER
	POPJ	PDL,			;RETURN


;OCTRZ ROUTINE SKIPS LEADING ZERO OCTAL DIGITS

OCTRZ:	MOVEI	AC16,^D12		;SET UP CTR
	MOVE	AC5,OCTPTR		;GET OCTAL POINTER
	ILDB	AC15,AC5		;GET OCTAL CHARACTER
	JUMPN	AC15,LOAD+1		;GO TO OUTPUT LOOP
	SOJG	AC16,OCTRZ+2
OCTPTR:	POINT	3,AC6


;	ROUTINE TO DEFINE UNIT

UNITDF:	TTCALL	3,UNT				;TYPE UNIT
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	SKIPE	,FLG				;SKIP IF INPUT
	JUMPE	RES,FINDEF			;END OF DEFINITION
	CAIL	INDEX,UNITS			;SKIP IF LESS THAN UNITS
	JRST	ERTOMY				;TYPE ERROR
	MOVEM	RES,UNITNA(INDEX)		;STORE UNIT NAME
	MOVNI	AC6,4				;MAX # OF CHARS
	MOVNI	AC7,7				;ERROR RET CTR
	PUSHJ	PDL,CVTSIX			;CONVERT TO SIXBIT
	MOVEM	NUM,SPEC+1			;STORE DEVICE NAME
	LSH	RES,-^D18			;SHIFT RESPONSE
	CAIN	RES,466510			;MTA?
	JRST	TAPEE				;YES
	JUMPN	FLG,UNTRET			;NO---OUTPUT TAPE ONLY
	JRST	DSKSPC				;YES--DEFINE FILE ETC
UNTRET:	POP	PDL,AC15			;GET RETURN ADR
	TTCALL	3,TAPONL			;TYPRE TAPE ONLY MESS
	JRST	-2(AC15)			;TYPE MESSAGE AGAIN

ERTOMY:	TTCALL	3,ERTM				;TYPE ERROR
	JRST	FINDEF				;CONTINUE PROCESSING


DSKSPC:	TTCALL	3,FILNAM			;TYPE MESSAGE
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	MOVNI	AC6,7				;SET CHAR CTR
	MOVNI	AC7,5				;SET RET ADR
	PUSHJ	PDL,CVTSIX			;CONVERT TO SIXBIT
	MOVEM	NUM,FILNA			;STORE FILE NAME
	MOVNI	AC6,3				;SET CHAR CTR
	MOVNI	AC7,11				;SET RETURN ADR
	PUSHJ	PDL,CVTSIX+1			;CONVERT TO SIXBIT
	MOVEM	NUM,FILEXT			;SAVE FILE EXTENSION
	POPJ	PDL,				;RETURN

LOOKER:	TTCALL	3,LOKER			;TYPE LOOKUP ERROR MESSAGE
	JRST	INPT			;GIVE EM ANOTHER CHANCE


TAPEE:	TTCALL	3,DENMES			;TYPE DENSITY MESS
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	TLNE	RES,464000		;200 BPI?
	JRST	D556			;NO
	MOVEI	AC14,200		;SET MODE
	JRST	SET			;STORE IN SPEC
D556:	TLNE	RES,450000		;IS IT 556?
	JRST	D800			;NO TRY 800 BPI
	MOVEI	AC14,400		;SET MODE
	JRST	SET			;STORE IN SPEC
D800:	TLNE	RES,434000		;IS IT 800 BPI?
	JRST	TAPEE			;NO TRY AGAIN
	MOVEI	AC14,600		;SET MODE
SET:	SKIPE	,FLG			;INPUT UNIT SKIP!
	IORI	AC14,1017		;SET DUMP MODE EVEN PARITY
	HRRM	AC14,SPEC		;STORE IT
	POPJ	PDL,			;RETURN

;	CODE DEFINITION

CODE:	TTCALL	3,CODMES			;TYPE MESSAGE
	PUSHJ	PDL,INCHRS			;GET RESPONSE
	MOVNI	AC6,3				;SET UP ACS
	MOVNI	AC7,5				;FOR SIXBIT ROUTINE
	PUSHJ	PDL,CVTSIX			;CONVERT TO SIXBIT
	LSH	NUM,-^D18			;SHIFT
	CAIE	NUM,572226			;IS IT O26?
	JRST	CD29				;NO TRY 029
STDCOD:	MOVE	AC6,PTRO26			;GET CHAR POINTER
	JRST	CD29+3				;STORE REST AND EXIT
CD29:	CAIE	NUM,572231			;IS IT O29?
	JRST	CDEB				;NO-TRY EBCDIC
	MOVE	AC6,PTRO29			;GET O29 CHAR POINTER
	MOVE	AC7,OUTBCD			;GET OUTPUT POINTER
	JRST	CODRET				;STORE AND RETURN
CDEB:	CAIE	NUM,654542			;EBCDIC UPPER CASE ONLY?
	JRST	CDEBL				;NO-TRY EBCDIC UPPER AND LOWER
	MOVE	AC6,PTREBU			;GET EBCDIC UPPER POINTER
	JRST	CDEBL+3				;STORE AND RETURN
CDEBL:	CAIE	NUM,655445			;EBCDIC UPPER AND LOWER CASE?
	JRST	CODE				;NO --TRY AGAIN
	MOVE	AC6,PTREBL			;GET POINTER
	MOVE	AC7,OUTEB			;GET EBCDIC OUTPUT POINTER
	HRLZI	AC5,1B19			;SET MASK BIT
	IORM	AC5,STATWD(INDEX)		;SET BIT TO INDICATE EBCDIC
CODRET:	MOVEM	AC6,GETCHR(INDEX)		;STORE CHAR POINTER
	MOVEM	AC7,STOCHR(INDEX)		;STORE LEFT HALF OF OUTPUT POINTER
	POPJ	PDL,				;RETURN

;	CODE POINTERS

PTRO26:	POINT 6,TAB(AC10),17	;POINTER TO RETRIEVE CHAR FROMTAB
PTRO29:	POINT 6,TAB(AC10),8
PTREBU:	POINT 8,TAB(AC10),35
PTREBL:	POINT 8,TAB(AC10),26
OUTBCD:	POINT 6,0,35
OUTEB:	POINT 8,0,35


	





;	TABLES

BUFPTR:	BLOCK	UNITS			;CONTAINSINITAL ADR OF OUTBUF AND WD CTR
;LEFT HALF CONTAINS NEG # OF WDS ALLOCATED FOR BUFFER
;RIGHT HALF CONTAINS INITAL BUFFER ADR -1

GETCHR:	BLOCK	UNITS			;CONTAINS BYTE POINTER TO RETRIEVE CHAR
;FROM TAB
;	FORMAT OF BYTE POINTERS
;029 	POINT	6,TAB(AC10),8
;026	POINT	6,TAB(AC10),17
;EBCDIC	POINT	8,TAB(AC10),26	(UPPER AND LOWER CASE)
;EBCDIC	POINT	8,TAB(AC10),35		(UPPER CASE ONLY)

STOCHR:	BLOCK	UNITS			;CONTAIS INCR POINTER TO STORE CHAR IN
;OUTPUT BUFFER
;BCD FORMAT	POINT	6,
;EBCDIC FORMAT	POINT	8,

;	STATUS WORD CONVENTIONS

UNMARK:	BLOCK 	UNITS
;BITS 0,1,2 GROUP AND RECORD MARKERS USED
;	110 GROUP MARKERS USED
;	101 RECORD MARKERS USED
;BITS 3-10 GROUP MARKER CHAR
;BITS 11-18 RECORD MARKER CHAR
;BITS 19-35 # OF LOGICAL RECS PER PHYSICAL REC


;STATUS WORD -STATWD---CONTAINS GENERAL INFORMATION
STATWD:	BLOCK 	UNITS
;BIT 1	=1 EBCDIC
;	=0 BCD
;BITS 18-35 CURRENT # OF LOG RECS IN OUTBUF
;BIT 0-SAME OUTPUT BUFFER AS PREVIOS TRANSLATION
;	=0 SAME BUFFER AS PREVIOUS OUTPUT
;	=1 UNIT HAS ITS OWN OUTPUT BUFFER

;BIT 2-SHOULD OUTPUT BUFFER BE CLEARED
;	=0 DON'T CLEAR OUTPUT BUFFER
;	=1 CLEAR OUTPUT BUFFER

;BIT 3--FIXED OR VARIABLE LENGTH INPUT LOGICAL RECORDS
;	=0 FIXED LENGTH 
;	=1 VARIABLE LENGTH
;PROGRAM ASSUMES FIXED LENGTH UNTILL OTHERWISE DETECTED

CHLOGR:	0			;CHARACTERS IN INPUT LOGICAL REC
LST:	BLOCK	2			;OUTPUT LST

INDLOC:	0
;LEFT HALF CONTAINS NEGATIVE # OF UNITS
;RIGTH HALF CONTAINS ZERO

;PUSH DOWN LIST
PDLST:	BLOCK	15

;INPUT BUFFER HEADER
INBBUF:	BLOCK	3

;OUTPUT UNIT NAME TABLE
UNITNA:	BLOCK 	UNITS

;OUTPUT UNIT SPECS
UNITST:	BLOCK	UNITS

SPEC:	BLOCK	3			;OPEN UUO SPECS
FILNA:	0				;FILE NAME FOR LOOKUP UUO
FILEXT:	BLOCK	3			;EXT PG,PJ PROT
LOGCTR:	0

STATFG:	0				;STATUS FLAG

FILREC:	BLOCK UNITS			;# OF FILLER RECS IN LAST PHYSICAL REC
LASTOT:	0				;PREVIOUS OUTPUT FLG
FINFLG:	0				;FINISHED FLAG--CLOSE BUFFERS
PSYIN:	0				;INPUT PHYSICAL REC CTR
PSYCTR:	BLOCK UNITS				;OUTPUT PHYSICAL REC CTR

;PHYSICAL RECORD COUNTER FOR OUTPUT

;UNMARK POINTERS
GRPPTR:	POINT	8,UNMARK(INDEX),10	;SETS AND RETRIEVES GROUP MARKER
RECPTR:	POINT	8,UNMARK(INDEX),18	;SETS AND RETRIEVES RECORD MARKER
LOGPTR:	POINT	17,UNMARK(INDEX),35	;GETS LOGICAL RECORD COUNTER


			PAGE


;TABLE TO CONVERT ASCII TO BCD(029,026) AND EBCDIC
;TABLE CONFIGURATION
;BITS 0-8	BCD 029  FORMAT
;BITS 9-17	BCD 026  FORMAT
;BITS 18-26	EBCDIC UPPER AND LOWER CASE FORMAT
;BITS 27-35	EBCDIC UPPER CASE ONLY FORMAT
;COMMENT ABOVE TABLE ENTRY--1 ST LETTER ASCII CHAR
;				2 ND LETTER 029 BCD CHAR
;				3 RD LETTER 026 BCD CHAR
;				4 TH LETTER EBCDIC U&L CASE CHAR
;				5 TH LETTER EBCDIC UPPER CASE CHAR
;NOTE DASH SEPERATES CHARACTERS--ALSO IF SPACE IN LETTER POSITION
;INDICATES THAT SET DOES NOT HAVE AN EQUIVALENT CHAR AND
;A BLANK IS INSERTED
;NOTE-- UPPER CASE CHARACTERS USED IN LIEU OF LOWER CASE CHAR
;IN BCD(026&029) AND EBCDIC UPPER CASE ONLY SETS

;		 - - - - ,	!- - -!-!,	"- - -"-",	#- - -#-#,
TAB:	EXP	020020100100,	020020132132,	020020177177,	020020173173
;		$-$-$-$-$,	%- -%-%-%,	&- - -&-&,	'- - -'-'
	EXP	053053133133,	020016154154,	020020120120,	020020175175
;		(-(-(-(-(,	)-)-)-)-),	*-*-*-*-*,	+-+-+-+-+
	EXP	075034115115,	055074135135,	054054134134,	076060116116
;		,-,-,-,-,,	---------,	.-.-.-.-.,	/-/-/-/-/
	EXP	033033153153,	040040140140,	073073113113,	021021141141
;		0-0-0-0-0,	1-1-1-1-1,	2-2-2-2-2,	3-3-3-3-3
	EXP	012012360360,	001001361361,	002002362362,	003003363363
;		4-4-4-4-4,	5-5-5-5-5,	6-6-6-6-6,	7-7-7-7-7
	EXP	004004364364,	005005365365,	006006366366,	007007367367
;		8-8-8-8-8,	9-9-9-9-9,	:- - -:-:,	;-;-;-;-;
	EXP	010010370370,	011011371371,	020020172172,	077077136136
;		<-<-<-<-<,	=-=-=-=-=,	>->->->->,	?- - -?-?
	EXP	072072114114,	016013176176,	057057156156,	020020157157
;		@- - -@-@,	A-A-A-A-A,	B-B-B-B-B,	C-C-C-C-C
	EXP	020020174174,	061061301301,	062062302302,	063063303303
;		D-D-D-D-D,	E-E-E-E-E,	F-F-F-F-F,	G-G-G-G-G
	EXP	064064304304,	065065305305,	066066306306,	067067307307
;		H-H-H-H-H,	I-I-I-I-I,	J-J-J-J-J,	K-K-K-K-K
	EXP	070070310310,	071071311311,	041041321321,	042042322322
;		L-L-L-L-L,	M-M-M-M-M,	N-N-N-N-N,	O-O-O-O-O
	EXP	043043323323,	044044324324,	045045325325,	046046326326
;		P-P-P-P-P,	Q-Q-Q-Q-Q,	R-R-R-R-R,	S-S-S-S-S
	EXP	047047327327,	050050330330,	051051331331,	022022342342
;		T-T-T-T-T,	U-U-U-U-U,	V-V-V-V-V,	W-W-W-W-W
	EXP	023023343343,	024024344344,	025025345345,	026026346346
;		X-X-X-X-X,	Y-Y-Y-Y-Y,	Z-Z-Z-Z-Z,	[-[-[- - 
	EXP	027027347347,	030030350350,	031031351351,	017017100100
;				]-]-]- - ,	^- -^- - ,	_- - - - 
	EXP	020020100100,	032032100100,	020055100100,	020020100100
;			*******LOWER CASE********
;				A-A-A-A-A,	B-B-B-B-B,	C-C-C-C-C
	EXP	020020100100,	061061201301,	062062202302,	063063203303
;		D-D-D-D-D,	E-E-E-E-E,	F-F-F-F-F,	G-G-G-G-G
	EXP	0640644204304,	065065205305,	066066206306,	067067207307
;		H-H-H-H-H,	I-I-I-I-I,	J-J-J-J-J,	K-K-K-K-K
	EXP	070070210310,	071071211311,	041041221321,	042042222322

;		L-L-L-L-L,	M-M-M-M-M,	N-N-N-N-N,	O-O-O-O-O
	EXP	043043223323,	044044224324,	045045225325,	046046226326	
;		P-P-P-P-P,	Q-Q-Q-Q-Q,	R-R-R-R-R,	S-S-S-S-S
	EXP	047047227327,	050050230330,	051051231331,	022022242342
;		T-T-T-T-T,	U-U-U-U-U,	V-V-V-V-V,	W-W-W-W-W
	EXP	023023243343,	024024244344,	025025245345,	026026246346
;		X-X-X-X-X,	Y-Y-Y-Y-Y,	Z-Z-Z-Z-Z,	
	EXP	027027247347,	030030250350,	031031251351,	020020100100
;		174,		175,		176,		177
	EXP	020020100100,	020020100100,	020020100100,	020020100100
	PAGE

;TELETYPE MESSAGES

IN1:	ASCIZ/INPUT /
OT1:	ASCIZ/OUTPUT /
UNT:	ASCIZ/UNIT:/
STD:	ASCIZ/ STANDARD OPTION:/
DENMES:	ASCIZ/ DENSITY:/
LOKER:	ASCIZ/ ?CAN'T FIND INPUT FILE?/
ERRCHR:	ASCIZ/ ?ILLEGAL CHARACTER TYPED?/
FILNAM:	ASCIZ/ FILE NAME(NAME.EXT):/
GPMRK:	ASCIZ/ GROUP MARKER(OCTAL):/
RCMRK:	ASCIZ/ RECORD MARKER(OCTAL):/
CODMES:	ASCIZ/ CODE BCD(O26,O29) OR EBCDIC(UEB,ULE):/
STDFMT:	ASCIZ/ STANDARD FORMAT(A-C OR H):/
SKPMES:	ASCIZ / # OF FILES TO SKIP:/
ERRR1M:	ASCIZ/ ?EXCEEDED OUTPUT BUFFER AREA---- CALL SYS PROGRAMMER
 (INCREASE BCDWDS OR EBCDWD IN EXPAND)?/
ERRR4M:	ASCIZ/ ?1 ST OUTPUT DEFINITION AS SAME?/
TAPONL:	ASCIZ/ ?OUTPUT ON TAPE ONLY?
/
CR:	ASCIZ/
/
CORER:	ASCIZ/? EXCEEDED AVAILABLE CORE?/
ERTM:	ASCIZ/ ?EXCEEDED PROGRAMABLE UNITS---CALL SYS PROGRAMMER
(INCREASE PARAMETER UNITS)---PROG CONTINUES?/
STDMTS:	ASCIZ/	FORMATS AVAILABLE:
 A	DEFINE BLOCKING FACTOR ETC
 B	USAEU1 BF:10 GM:32 RM:77 BCD O26
 C	IBM360 BF:91 EBCDIC
 TYPE LETTER OF FORMAT DESIRED: /


	PAGE

;ROUTINE TO TYPE DESCRIPTION OF OUTPUT FILE

DESCPT:	MOVE	AC6,JOBFFP		;GET LOW END OF PROG
	CALL	AC6,[SIXBIT/CORE/]	;DROP CORE
	JFCL	0,			;ERROR RETURN FOR CORE UUO
	MOVE	INDEX,INDLOC		;SET UP INDEX
HEAD:	TTCALL	3,CR2			;SKIP TWO LINES
	TTCALL	3,HEADER		;TYPE HEADER
	TTCALL	3,FILDES		;TYPE FILE DESCRIPTION
	TTCALL	3,TPDEN			;TYPE TAPE DENSITY
	LDB	AC10,[POINT 2,UNITST(INDEX),28]	;GET DENSITY BITS
	TTCALL 	3,D2-1(AC10)		;TYPE DENSITY
	TTCALL	3,BPI			;TYPE BPI
	TTCALL	3,CRDATE		;TYPE CREATION DATE
	CALL	AC14,[SIXBIT/DATE/]	;GET DATE
	IDIVI	AC14,^D31		;GET DAY
	AOJ	AC15,			;ADD ONE TO DAY
	PUSHJ	PDL,DECMAL		;TYPE DAY
	IDIVI	AC14,^D12		;GET MONTH
	TTCALL	3,MONTH(AC15)		;TYPE MONTH
	TTCALL	3,SPACE			;INSERT SPACE
	MOVEI	AC15,^D1964(AC14)	;CONSTRUCT YEAR
	PUSHJ	PDL,DECMAL		;TYPE NUMBER
	TTCALL	3,CR			;TYPE CR
	TTCALL	3,FILNUM		;TYPE FILE NUMBER
	TTCALL	3,CODEM			;TYPE CODE OUTPUT
	LDB	AC10,[POINT 2,GETCHR(INDEX),5]	;GET CODE
	CAILE	AC10,1			;SKIP IF EBCDIC
	TTCALL	3,CB			;TYPE BCD
	CAIGE	AC10,2			;SKIP IF BCD
	TTCALL	3,CE			;TYPE EBCDIC
	XCT	3,C10(AC10)		;TYPE REST OF MESSAGE
	TTCALL	3,CR			;TYPPE CR
	TTCALL	3,BKFATR		;TYPE BLOCKING FACTOR
	LDB	AC15,LOGPTR		;GET BLOCKING FACTOR
	PUSHJ	PDL,DECMAL		;TYPE #
	TTCALL	3,TAB1			;INSERT TAB
	TTCALL	3,TPID			;TYPE TAPE IDENTIFICATION
	SKIPL	AC7,UNMARK(INDEX)	;GROUP & RECORD MARKERS USED?
	JRST	TPUNIT			;SKIP PROCESSING
	TLNN	AC7,1B19		;GROUP MARKER USED?
	JRST	RMARKR			;NO
	LDB	AC6,GRPPTR		;GET GROUP MARKER
	TTCALL	3,GPMRK			;TYPE GROUP MARKER
	PUSHJ	PDL,OCTRZ		;TYPE IT
	CAILE	AC10,1			;SKIP IF EBCDIC
	TTCALL	3,SPACE			;NO---NEED SPACE FOR BCD
RMARKR:	TLNN	AC7,1B20		;RECORD MARKER USED?
	JRST	TPUNIT-1		;NO
	LDB	AC6,RECPTR		;GET RECORD MARKER
	TTCALL	3,RCMRK			;TYPE MESS
	PUSHJ	PDL,OCTRZ		;TYPE OCTAL
	TTCALL	3,CR			;CR
TPUNIT:	TTCALL	3,TPUT			;TYPE UNIT
	TTCALL	3,UNITNA(INDEX)	;TYPE TAPE UNIT
	MOVE	AC10,STATWD(INDEX)	;GET STATWD
	TLNE	AC10,1B19		;BIT 19=0----BCD?
	TTCALL	3,S9TK			;NO----EBCDIC
	TLNN	AC10,1B19		;SKIP IF BIT 19=1
	TTCALL	3,S7TK			;BCD
	TTCALL	3,NLOGRC		;TYPE # OF LOGICAL RECORDS
	MOVE	AC15,LOGCTR		;GET # OF LOGICAL RECS
	PUSHJ	PDL,DECMAL		;TYPE DECIMAL NUMBER
	SKIPN	,FILREC(INDEX)		;ANY FILLER RECS USED?
	JRST	DCLR			;NO----SKIP
	TTCALL	3,FILRC1		;TYPE BEGINING OF STATEMENT
	MOVE	AC15,FILREC(INDEX)	;GET # OF FILLER RECS
	PUSHJ	PDL,DECMAL		;TYPE #
	TTCALL	3,FILRC2		;FINNISH MESSAGE
DCLR:	TTCALL	3,DCPLR			;TYPE DATA CHARS/LOG REC
	TLNE	AC10,1B21		;FIXED OR VARIABLE LENGTH LOG REC
	JRST	VAR			;VARIABLE
	TTCALL	3,FIXED			;TYPE FIXED---
	MOVE	AC15,CHLOGR		;GET # OF CHARS 
	PUSHJ	PDL,DECMAL		;TYPE # OF CHARS
	TTCALL	3,CHRS			;TYPE REST OF MESSAGE
	SKIPA				;SKIP
VAR:	TTCALL	3,VAR1			;TYPE VARIABLE
HDLP:	AOBJN	INDEX,HEAD		;LOOP OVER UNITS
	JRST	VERIFY			;VERIFY UNITS

;MESSAGES FOR TAPE LABEL

HEADER:	ASCIZ/	BROOKHAVEN NATIONAL LABS
	NNCSC,BLD 197
	UPTON L.I. N.Y. 11973
	TEL: AC(516) 345-2903 OR 2902

/
FILDES:	ASCIZ/ FILE DESCRIPTION:
/
FILRC1:	ASCIZ/ +( /
FILRC2:	ASCIZ/FILLER LOG RECS)/
TPDEN:	ASCIZ/ TAPE DENSITY: /
FILNUM:	ASCIZ/ TAPE FILE:		/
CRDATE:	ASCIZ/ CREATION DATE: /
CODEM:	ASCIZ/ CODE: /
BPI:	ASCIZ/BPI	/
BKFATR:	ASCIZ/ BLOCKING FACTOR: /
D2:	ASCIZ/200 /
D5:	ASCIZ/556 /
D8:	ASCIZ/800 /
MONTH:	ASCIZ/ JAN/
	ASCIZ/ FEB/
	ASCIZ/ MAR/
	ASCIZ/ APR/
	ASCIZ/ MAY/
	ASCIZ/ JUN/
	ASCIZ/ JUL/
	ASCIZ/ AUG/
	ASCIZ/ SEP/
	ASCIZ/ OCT/
	ASCIZ/ NOV/
	ASCIZ/ DEC/
CB:	ASCIZ/ BCD/
CE:	ASCIZ/ EBCDIC/
C0:	ASCIZ/ UPPER CASE ONLY/
C1:	ASCIZ/ UPPER & LOWER CASE/
C2:	ASCIZ/ O26/
C3:	ASCIZ/ O29/
TPID:	ASCIZ/ TAPE IDENTIFICATION:
/
TPUT:	ASCIZ/ TAPE UNIT: /
NLOGRC:	ASCIZ/ NUM OF LOGICAL RECS: /
DCPLR:	ASCIZ/
 NUM OF DATA CHARS PER LOG REC: /
CHRS:	ASCIZ/ CHARS (NOT INCLUDING MARKERS)
/
FIXED:	ASCIZ/FIXED-- /
VAR1:	ASCIZ/ VARIABLE
/


C10:	TTCALL	3,C0
C20:	TTCALL	3,C1
C30:	TTCALL	3,C2
C40:	TTCALL	3,C3
SPACE:	ASCIZ/ /
CR2:	ASCIZ/

/
TAB1:	ASCIZ/	/
S7TK:	ASCIZ/ 7TK	/
S9TK:	ASCIZ/ 9TK	/

	PAGE

;	ROUTINE TO VERIFY OUTPUT UNITS FOR PARITY ERRORS

VERIFY:	MOVE	INDEX,INDLOC		;GET INDEX
	TTCALL	3,CR2			;SKIP TWO LINES
	TTCALL	3,VERUNT		;TYPE VERIFY UNITS:?
	PUSHJ	PDL,INCHRS		;GET RESPONSE
	JUMPE	RES,EXIT		;CR---EXIT
	TLNE	RES,304000		;ANS NO?
	SKIPA				;NO---SKIP
	JRST	EXIT			;ANS IS NO----EXIT
	TLNE	RES,230000		;ANS YES?
	JRST	VERIFY+1		;NO---REPEAT QUESTION
VERLP:	MOVEI	NUM,1			;USE ONLY 1 AS BLOCKING FACTOR
	PUSHJ	PDL,EXPAND		;EXPAND CORE FOR BUFFER
	MOVE	AC6,BUFPTR		;GET BUFFER POINTER
	MOVEM	AC6,LST			;STORE IN LIST
VERLP1:	TTCALL	3,CR2			;SKIP 2 LIMES
	TTCALL	3,TPUT			;TYPE OUTPUT UNIT
	TTCALL	3,UNITNA(INDEX)	;TYPE UNIT NAME
	MOVE	RES,UNITNA(INDEX)	;GET UNITNAME
	MOVNI	AC6,4			;SET UP CVTSIX CTR
	SETZM	,AC7			;ZERO AC7
	PUSHJ	PDL,CVTSIX		;CONVERT TO SIXBIT
	MOVEM	NUM,SPEC+1		;STORE IN SPEC +1
	MOVE	AC6,UNITST(INDEX)	;GET UNIT STATUS
	MOVEM	AC6,SPEC		;STORE IN SPEC
	JSP	AC16,STOCHN		;STORE CHANNEL NUMBER
	OPEN	0,SPEC			;OPEN UNIT
	JRST	EXIT			;SOMEBODY STOLE THE UNIT
	MOVE	AC6,STATWD(INDEX)	;GET STATWD
	TLNN	AC6,1B19		;EBCDIC?
	JRST	RLOOP			;NO---SKIP MATPE
	JSP	AC16,STOCHN		;STORE CHANNEL NUMBER
	MTAPE	0,101			;SET FOR 9 TK
RLOOP:	SETZB	AC10,AC7		;ZERO CTRS
	SETZM	,PSYCTR(INDEX)		;ZERO PHYSICAL REC CTR
	HRREI	NUM,-2			;BACKSPACE
	PUSHJ	PDL,SKPENT		;SKIP
	JSP	AC16,STOCH1		;STORE CHANNEL NUMBERS
RLOOP1:	INPUT	0,LST			;READ UNIT
	STATZ	0,362000		;CHECK STATUS
	PUSHJ	PDL,VERST		;ERROR---PROCESS
	AOS	,PSYCTR(INDEX)		;INCR PHSICAL REC CTR
	AOJA	AC10,RLOOP1		;LOOP
LOOPED:	AOBJN	INDEX,VERLP1		;LOOP OVER UNITS
	JRST	EXIT			;EXIT

;END OF VERIFY LOOP PROCESSING

ENDVER:	SOJ	AC7,			;-1 FROM ERROR CTR
	JUMPE	AC7,AOK			;JUMP IF NO ERRORS
	TTCALL	3,UNITNA(INDEX)		;TYPE UNIT NAME
	TTCALL	3,TAB1			;TYPE TAB
	MOVE	AC15,AC7		;SET UP ERROR CTR FOR DECMAL
	PUSHJ	PDL,DECMAL		;TYPE # OF ERRORS
	SKIPA				;FINISH PROCESSING

AOK:	TTCALL	3,NO			;TYPE NO
	TTCALL	3,ERRDET		;TYPE ERROR MESS
	JRST	LOOPED			;CONTINUE VERIFYING

NO:	ASCIZ/ NO/
ERRDET:	ASCIZ/ ERRORS DETECTED/
VERUNT:	ASCIZ/ VERIFY OUTPUT UNITS: /

	END	BLOCK