Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50343/allprt.mac
There is 1 other file named allprt.mac in the archive. Click here to see a list.
	TITLE	ALLPRT - INTERCONVERTS EBCDIC,ASCII AND SIXBIT
	ENTRY	ALLPRT
	EXTERN	.JBFF,.JBREL
;
; "STANDARD" MACROS
;
DEFINE HEX(X)
<XXX==0
IRPC X,<
IFLE "X"-"9",<XXX==^D16*XXX+"X"-"0">
IFG "X"-"9",<XXX==^D16*XXX+"X"-"A"+^D10>>>
;
; OPDEFS
;
	DEFINE INBYTE<
	JSP	Q2,IN.BYT>
	DEFINE OUTBYT<
	JSP	Q2,OU.BYT>
	DEFINE AOB (A)<
	AOBJN	A,.+1>
OPDEF	TRZ	[ANDCMI]
OPDEF	TRO	[IORI]
OPDEF	PJRST	[JRST]
OPDEF	PJUMPE	[JUMPE]
OPDEF	PJUMPL	[JUMPL]
OPDEF	PJUMPG	[JUMPG]
OPDEF	PJUMPN	[JUMPN]
;
; CUSP NAME AND VERSION
;
CUSP==SIXBIT/ALLPRT/
VERWHO==0
VERVER==1
VERUPD==0
VERPAT==1
	LOC 137
	BYTE	(3)VERWHO(9)VERVER(6)VERUPD(18)VERPAT
;
; AC DEFINITIONS
;
FLG=0					;HOLDS FLAGS
CHR=1					;HOLDS CHARACTER
ADR=2					;HOLDS DISPATCH ADDRESS
T1=3					;FIRST TEMPORARY
T2=4					;SECOND TEMPORARY
T3=5					;THIRD TEMPORARY
T4=6					;FOURTH TEMPORARY
T5=7					;FIFTH TEMPORARY
F=10					;BASE ADDRESS FOR FILE TABLE
S=11					;BASE ADDRESS FOR SWITCH TABLE
;
IN=10					;INPUT FILE HEADER WORD
AUT=11					;OUTPUT FILE HEADER WORD
;
P1=12					;FIRST PERMENANT AC
P2=13					;SECOND PERMENANT AC
Q1=15					;FIRST JSP AC
Q2=16					;SECOND JSP AC
P=17					;PUSHDOWN AC
;
LOW==0					;NO OFFSET SINCE TWOSEG
;
; FLAGS
;
;
; CONSTANTS
;
DV.DRI==1B0				;DTA WITH DIRECTORY IN CORE
DV.DSK==1B1				;DEVICE IS A FILE STRUCTURE
DV.CDR==1B2				;IF DVOUT=1 DEVICE IS A CDP
					;IF DVIN=1 DEVICE IS A CDR
DV.LPT==1B3				;DEVICE IS A LINE PRINTER
DV.TTA==1B4				;DEVICE IS A TTY CONTROLING A JOB
DV.TTU==1B5				;TTY DDB IS IN USE
DV.TTB==1B6				;FREE BIT LEFT FROM SCNSRF
DV.DIS==1B7				;DEVICE IS A DISPLAY
DV.LNG==1B8				;DEVICE HAS A LONG DISPATCH TABLE
DV.PTP==1B9				;DEVICE IS A PAPER TAPE PUNCH
DV.PTR==1B10				;DEVICE IS A PAPER TAPE READER
DV.DTA==1B11				;DEVICE IS A DEC TAPE
DV.AVL==1B12				;DEVICE IS AVAILABLE TO THIS JOB
DV.MTA==1B13				;DEVICE IS A MAG TAPE
DV.TTY==1B14				;DEVICE IS A TTY
DV.DIR==1B15				;DEVICE HAS A DIRECTORY
DV.IN==1B16				;DEVICE CAN DO INPUT
DV.OUT==1B17				;DEVICE CAN DO OUTPUT
DV.ASC==1B18				;DEVICE ASSIGNED BY ASSIGN COMMAND
DV.ASP==1B19				;DEVICE ASSIGNED BY INIT OR OPEN UUO
DV.M17==1B20				;DEVICE CAN DO MODE 17
DV.M16==1B21				;DEVICE CAN DO MODE 16
DV.M15==1B22				;DEVICE CAN DO MODE 15
DV.M14==1B23				;DEVICE CAN DO MODE 14
DV.M13==1B24				;DEVICE CAN DO MODE 13
DV.M12==1B25				;DEVICE CAN DO MODE 12
DV.M11==1B26				;DEVICE CAN DO MODE 11
DV.M10==1B27				;DEVICE CAN DO MODE 10
DV.M7==1B28				;DEVICE CAN DO MODE 7
DV.M6==1B29				;DEVICE CAN DO MODE 6
DV.M5==1B30				;DEVICE CAN DO MODE 5
DV.M4==1B31				;DEVICE CAN DO MODE 4
DV.M3==1B32				;DEVICE CAN DO MODE 3
DV.M2==1B33				;DEVICE CAN DO MODE 2
DV.M1==1B34				;DEVICE CAN DO MODE 1
DV.M0==1B35				;DEVICE CAN DO MODE 0
;
IFNDEF CH.HLP,<CH.HLP==0>		;HELP CHANNEL
IFNDEF CH.IN,<CH.IN==1>			;INPUT CHANNEL
IFNDEF CH.OUT,<CH.OUT==2>		;OUTPUT CHANNEL
IFNDEF CH.PCK,<CH.PCK==3>		;PACKED SPEC CHANNEL
IFNDEF PSIZE,<PSIZE==40>		;PUSHDOWN LIST LENGTH
IFNDEF PATSIZ,<PATSIZ==20>		;PATCH AREA LENGTH
IFNDEF SCNSIZ,<SCNSIZ==5>		;LARGEST SIXBIT ITEM SCANNED
IFNDEF SWHSIZ,<SWHSIZ==2>		;LONGEST SWITCH NAME
IFNDEF FDSIZE,<FDSIZE==5>		;LONGEST FD ALLOWED
IFNDEF COBSIZ,<COBSIZ==5>		;LARGEST COBOL ITEM ALLOWED
IFNDEF CH.EOL,<CH.EOL==33>		;PSEUDO COBOL EOL
IFNDEF LINSIZ,<LINSIZ==^D24>		;LENGTH OF DUMPED LINE
IFNDEF WD.CON,<WD.CON==^D106>		;WIDTH OF "CONVENTIONAL" COBOL LINE
IFNDEF WD.SEQ,<WD.SEQ==^D65>		;WIDTH OF "STANDARD" COBOL LINE
;
; DEFINE FLAGS
;
;	FL.XXX	IS PERMENANT FLAG (LH OF FLG)
;	FR.XXX	IS TEMPORARY FLAG (RH OF FLG)
;
FL.SPC==400000				;SPECIAL CONVERSION REQUIRED
FL.RWR==200000				;REWRITING COUNT WORD
FL.TRP==100000				;OUTPUT TRAP IS SET
FL.BNC==40000				;BLOCK INCOMPLETE
FL.RNC==20000				;RECORD INCOMPLETE
FL.DMP==10000				;DUMP REQUESTED
;
FR.CLN==400000				;COLON SEEN
FR.PER==200000				;PERIOD SEEN
FR.BLK==100000				;BLANK LINE
FR.MIN==40000				;MINUS SEEN
FR.DQT==20000				;DOUBLE QUOTE LITERAL MODE
FR.SQT==10000				;SINGLE QUOTE LITERAL MODE
FR.AST==4000				;COBOL COMMENT LINE
FR.CNT==2000				;COBOL CONTINUATION LINE
FR.CMA==400				;COMMA SEEN
FR.OCR==1				;OUTPUT PACKED BYTE IN CORE
FR.ICR==2				;INPUT PACKED BYTE IN CORE
FR.SGN==4				;SET ON NEGATIVE ITEM
FR.SSG==10				;HAVE DONE INPUT SOSG
FR.NCR==20				;DON'T INCREMENT
;
; SCANNER FLAGS
;
FS.REQ==400000				;SWITCH VALUE REQUIRED
;
; PROGRAM IS TWOSEGMENT
;
	TWOSEG
	RELOC	400000
;
ALLPRT:	RESET				;CLEAR CURRENT I/O
	TTCALL	3,[ASCIZ ./Help for HELP.]
	CAIA				;START UP ALLPRT
RESTRT:	RESET				;CLEAR I/O
	MOVEI	T5,1			;SET UP CHARACTER COUNT
	TTCALL	3,[ASCIZ /
*/]
	MOVE	P,[IOWD PSIZE,PLIST]	;SET UP PUSHDOWN
	MOVE	T1,[XWD FIRST,FIRST+1]
	SETZB	FLG,FIRST		;CLEAR
	BLT	T1,LAST-1		;CLEAR LOW CORE
;
; CLEAR .JBFF THROUGH .JBREL
;
	HRRZ	T1,.JBFF		;GET FIRST FREE
	SETZM	0(T1)			;CLEAR IT
	HRL	T1,T1			;SET UP BLT POINTER
	ADDI	T1,1
	HRRZ	T2,.JBREL		;GET LAST LOC
	BLT	T1,0(T2)		;CLEAR THROUGH .JBREL
	PUSHJ	P,TABGEN		;GENERATE CONVERSION TABLE
	MOVE	S,[XWD OUTSW1,OUTSW2]	;STORE SWITCH TABLE
	MOVEI	F,OUTFIL		;GET OUTPUT SPECIFICATION
	PUSHJ	P,SCANER		;GET OUTPUT SPECIFICATION
	JRST	RESTRT			;RESTART ALLPRT
;
; TEST FOR OUTPUT FD
;
	CAIE	CHR,","			;SEPERATOR
	JRST	ALLPR5			;NO - ERROR
	MOVE	S,[XWD PCKSW1,PCKSW2]	;SET FOR PACKED
	MOVEI	F,FP.STA(F)		;GET PACKED
	TRZ	FLG,FR.CLN		;CLEAR COLON FLAG
	PUSHJ	P,SCANER
	JRST	RESTRT
;
; TEST FOR OUTPUT DELIMITER
;
ALLPR5:	CAIE	CHR,"="
	CAIN	CHR,"_"
	JRST	ALLPR1			;DONE
;
; SCANNER ERROR
;
ALLPR3:	PUSHJ	P,SC%ERR		;CLEAR LINE - TYPE MESSAGE
	JRST	RESTRT
;
; NOW GET INPUT SPEC
;
ALLPR1:	MOVE	S,[XWD INSW1,INSW2]	;SET SWITCHES
	MOVEI	F,INFILE		;GET INPUT SPECIFICATION
	TRZ	FLG,FR.CLN		;CLEAR COLON FLAG
	PUSHJ	P,SCANER		;GET INPUT SPECIFICATIONS
	JRST	RESTRT			;RESTART ALLPRT
;
; TEST FOR PACKED
;
	CAIE	CHR,","			;FINISH WITH COMMA
	JRST	ALLPR4			;NO PACKED
	MOVE	S,[XWD PCKSW1,PCKSW2]	;SET SWITCHES
	MOVEI	F,FP.STA(F)		;SET PCKED FILE TABLE
	TRZ	FLG,FR.CLN		;CLEAR COLON FLAG
	PUSHJ	P,SCANER		;GET SPECIFICATION
	JRST	RESTRT			;RESTART ON ERROR
;
; TEST FOR EOL
;
ALLPR4:	CAIE	ADR,SC%BRK		;BREAK
	JRST	ALLPR3			;NO - ERROR
	PAGE
	SUBTTL	ACTUALLY PERFORM CONVERSION
;
; HERE WITH ALL SPECIFICATIONS
;
ALLPR2:	MOVEI	F,OUTFIL		;CHECK FOR PACKED
	SKIPN	FP.DEV(F)		;DEVICE SPECIFIED?
	JRST	ALLPR6			;NO
	PUSHJ	P,PCKTYP		;GET SPECIFICATION
	PUSHJ	P,PCKERR		;TYPE ERROR MESSAGE
	TTCALL	3,[ASCIZ /OUTPUT FD:
------ --
/]
	TLNN	F,FF.NLS		;DON'T LIST PACKED SPEC
	PUSHJ	P,FDDUMP		;DUMP THE FD
ALLPR6:	MOVEI	F,INFILE		;TEST FOR INPUT
	SKIPN	FP.DEV(F)		;DEVICE
	JRST	SETUP
	PUSHJ	P,PCKTYP
	PUSHJ	P,PCKERR
	TTCALL	3,[ASCIZ /INPUT FD:
----- --
/]
	TLZN	F,FF.NLS		;DON'T LIST PACKED SPEC
	PUSHJ	P,FDDUMP
SETUP:	TLZ	FLG,FL.RWR!FL.SPC!FL.TRP!FL.BNC!FL.RNC	;CLEAR FLAGS
	MOVSI	T2,(OUT CH.OUT,)	;SET UP EXOUT INSTRUCTION
	MOVE	IN,F.STA+INFILE		;SET FLAGS
	MOVE	T1,F.CODE(IN)		;GET CODE
	HRL	T1,FNDTAB(T1)		;GET CODE TABLE
	HLRZM	T1,F.CODE(IN)		;STORE CODE
	HRRI	T1,FC.PAD(IN)		;GET FILE CODE TABLE
	BLT	T1,FC.OFR(IN)		;COPY TABLE
	TSO	IN,FC.FLG(IN)		;SET FLAGS
	HRRZ	T1,F.CODE(IN)		;FIXED EBCDIC?
	CAIN	T1,%FEBCD		;FIXED EBCDIC?
	TLZ	IN,FF.VAR		;YES - CLEAR VARIABLE
	MOVEM	IN,F.STA(IN)		;STORE FLAGS
	MOVE	AUT,F.STA+OUTFIL	;SET FLAGS
	TLO	AUT,FF.OUT		;SET OUTPUT FILE
	MOVE	T1,F.CODE(AUT)		;GET CODE
	HRL	T1,FNDTAB(T1)		;GET CODE TABLE
	HLRZM	T1,F.CODE(AUT)		;STORE CODE
	HRRI	T1,FC.PAD(AUT)		;GET FILE CODE TABLE
	BLT	T1,FC.OFR(AUT)		;COPY TABLE
	TSO	AUT,FC.FLG(AUT)		;SET FLAGS
	HRRZ	T1,F.CODE(AUT)		;FIXED EBCDIC?
	CAIN	T1,%FEBCD		;FIXED EBCDIC?
	TLZ	AUT,FF.VAR		;YES - CLEAR VARIABLE
	MOVEM	AUT,F.STA(AUT)		;STORE FLAGS
	SKIPN	FP.ITM(IN)		;PACKED INPUT?
	JRST	SETUP3			;NO
	TLNE	AUT,FF.RCC!FF.BLC	;YES - RECORD OR BLOCK COUNT?
	JRST	SETUP4			;YES - TRAP REQUIRED
SETUP3:	TLNE	IN,FF.EOL		;INPUT SIZE KNOWN?
	TLNN	AUT,FF.VAR		;COMPUTED OUTPUT COUNT
	JRST	SETUP2			;YES/NO
	TLNN	AUT,FF.RCC!FF.BLC	;COUNT ON OUTPUT
	JRST	SETUP2			;NO - TRAP NOT NEEDED
SETUP4:	TLO	FLG,FL.SPC!FL.TRP	;TRAP NEEDED
;
; SET UP TRAP BLOCK
;
	MOVE	T2,[PUSHJ P,ADVBUF]	;GET TRAP INSTRUCTION
	MOVE	T1,[JRST R.RINT]	;SET NEW DISPATCH
	EXCH	T1,FC.OIR(AUT)		;SET NEW DISPATCH
	MOVEM	T1,TOIREC		;SET OLD DISPATCH
	MOVE	T1,[JRST R.RFIN]	;SET NEW DISPATCH
	EXCH	T1,FC.OFR(AUT)		;SET NEW DISPATCH
	MOVEM	T1,TOFREC		;SET OLD DISPATCH
	TLNN	AUT,FF.BLC		;BLOCK COUNT
	JRST	SETUP2			;NO
	MOVE	T1,[JRST R.BINT]	;SET NEW DISPATCH
	EXCH	T1,FC.OIB(AUT)		;SET NEW DISPATCH
	MOVEM	T1,TOIBLK		;SET OLD DISPATCH
	MOVE	T1,[JRST R.BFIN]	;SET NEW DISPATCH
	EXCH	T1,FC.OFB(AUT)		;SET NEW DISPATCH
	MOVEM	T1,TOFBLK		;SET OLD DISPATCH
;
SETUP2:	MOVEM	T2,EXOUT(LOW)		;SET UP OUTPUT INSTRUCTION
	MOVE	F,F.STA+INFILE		;INITIALIZE INPUT
	PUSHJ	P,INITFL		;INITIALIZE
	MOVE	F,F.STA+OUTFIL		;INITIALIZE OUTPUT
	PUSHJ	P,INITFL		;INITIALIZE
;
; HERE WITH FILES SET UP AND RINGS
; LINKED TO BUFFER HEADER IN FILE BLOCK
;
; GENERATE CODE TABLE
;
	MOVE	IN,F.STA+INFILE	;GET INPUT CONTROL
	MOVE	AUT,F.STA+OUTFIL	;GET OUTPUT CONTROL
	PUSHJ	P,CODGEN		;GENERATE CODE TABLE
;
; DETERMINE CONVERSION ROUTINE
; IF DUMP REQUESTED - USE DUMP-MODE
; IF INPUT OR OUTPUT ARE PACKED USE PACKED-MODE
; IF INPUT AND OUTPUT ARE NOT PACKED AND
;   RECORD , BLOCK AND CODE MATCH USE WORD-MODE
;   INPUT AND OUTPUT ARE BOTH SIXBIT USE SYNCH-MODE
;   OTHERWISE USE NORMAL CONVERSION
;
	TLNE	FLG,FL.DMP		;DUMP REQUESTED?
	JRST	FILDMP			;DO THE DUMP
	SKIPN	FP.ITM(IN)		;PACKED SPEC?
	SKIPE	FP.ITM(AUT)		;PACKED SPEC?
	JRST	PCKWRT			;YES - PACKED CONVERSION
	HRRZ	T1,F.CODE(IN)		;CHECK CODES
	HRRZ	T2,F.CODE(AUT)		;CHECK CODES
	CAME	T1,T2			;MATCH
	JRST	CONVRT			;DIFFERENT CODES
	MOVE	T1,F.RCSZ(IN)		;COMPARE RECORD SIZES
	CAME	T1,F.RCSZ(AUT)		;MATCH?
	JRST	TSTSYN			;NO - TEST SYNCH
	MOVE	T1,F.BLSZ(IN)		;COMPARE BLOCK SIZES
	CAME	T1,F.BLSZ(AUT)		;MATCH?
	JRST	TSTSYN			;NO - TEST SYNCH
	TLNN	IN,FF.VAR		;VARIABLE INPUT
	JRST	TSTFIX			;NO - TEST FIXED
	TLNN	AUT,FF.VAR		;VARIABLE OUTPUT
	JRST	TSTSYN			;TEST SYNCH
	JRST	WRDMOD			;SPEC'S MATCH
TSTFIX:	TLNN	AUT,FF.VAR		;FIXED OUTPUT
	JRST	WRDMOD			;YES - SPEC'S MATCH
TSTSYN:	TLNE	IN,FF.SYN		;SYNCHRONIZED MODE
	JRST	SYNC00			;YES - DO SYNCHRONIZED CONVERSION
;
; CONVERSION ROUTINES
;
CONVRT:	MOVE	T1,FC.SIZ(IN)		;SET CONTAB
	MOVE	T2,[AOS BCHRS]		;TO AOS
CONV21:	MOVEM	T2,CONTAB(T1)		;STORE
	AOBJN	T1,CONV21		;STORE FOR ALL
	TLNN	IN,FF.EOL		;END OF LINE CHARACTER?
	JRST	CONV02			;NO
;
; SET UP ASCII CONTAB
;
	MOVE	T1,[JRST CONV06]	;IGNORE CHARACTER
	MOVEM	T1,CONTAB		;IGNORE NULLS
	HRRI	T1,CONV15		;FOR CR
	MOVEM	T1,CONTAB+15		;SET FOR CR
	HRROS	CODTAB			;SET NULL BAD
	HRROS	CODTAB+15		;SET CR BAD
	TLNN	AUT,FF.TAB		;CODE WITH TAB?
	JRST	CONV20			;NO - SET TAB INTERCEPT
	TLNE	AUT,FF.VAR		;VARIABLE OUTPUT?
	JRST	CONV01			;YES - DON'T NEED TAB INTERCEPT
CONV20:	HRRI	T1,CONV16		;FOR TAB
	MOVEM	T1,CONTAB+11		;SET FOR TAB
	HRROS	T1,CODTAB+11		;FOR TAB
CONV01:
;
; START BLOCK
;
CONV02:	JSP	ADR,.IIBLK		;INITIALIZE INPUT BLOCK
	JSP	ADR,.OIBLK		;INITIALIZE OUTPUT BLOCK
;
; START A RECORD
;
CONV03:	JSP	ADR,.IIREC		;INITIALIZE INPUT RECORD
	JRST	CONV12			;NO ROOM FOR RECORD
	SKIPN	F.CREC(IN)		;ZERO RECORD SIZE
	TLNE	IN,FF.EOL		;RECORD COUNT KNOWN
	CAIA				;NO/YES
	JRST	CONV04			;ZERO LENGTH INITIALIZATION
	SOSG	F.CNT(IN)		;TEST FOR A BYTE
	JSP	Q1,IN.BUF		;GET A BUFFER
CONV04:	MOVE	P1,F.CREC(IN)		;GET INPUT RECSIZE
	TLNE	AUT,FF.VAR		;VARIABLE OUTPUT?
	SKIPA	P2,P1			;OUTPUT RECSIZE = INPUT RECSIZE
	MOVE	P2,F.CREC(AUT)		;GET OUTPUT RECSIZE
	JSP	ADR,.OIREC		;INITIALIZE OUTPUT RECORD
	JRST	CONV13			;NO ROOM FOR RECORD
	TLNE	IN,FF.EOL		;RECORD COUNT KNOWN?
	MOVE	P1,P2			;NO - USE OUTPUT SIZE
	SUB	P2,P1			;COMPUTE REMAINING CHARACTERS
	JUMPG	P2,CONV05		;TRUNCATING
	ADD	P1,P2			;YES
CONV05:	ADDM	P1,NCHRS(LOW)		;ADD INTO CHARACTER COUNT
	MOVN	P1,P1			;SET NEGATIVE
	SKIPN	F.CREC(IN)		;ZERO LENGTH INPUT
	TLNE	IN,FF.EOL		;RECORD COUNT KNOWN
	JRST	CONV07			;SKIP FIRST SOSG
	JUMPE	P2,CONV11		;ANYTHING TO PAD
	JRST	CONV09			;YES
;
; MAIN CONVERSION LOOP
; ENTERED WITH FOLLOWING 
;
; P1 = - # OF CHARACTERS TO CONVERT OR
;	0 IF VARIABLE OUTPUT RECORD
; CODTAB - INPUT TO OUTPUT CONVERSION TABLE
; CONTAB - ERROR CHARACTER PROCESSING TABLE
;
CONV06:	SOSG	F.CNT(IN)		;GET A BYTE
	JSP	Q1,IN.BUF		;INPUT A BUFFER
CONV07:	ILDB	CHR,F.PNT(IN)		;GET THE BYTE
	SKIPG	ADR,CODTAB(CHR)		;CONVERT
	XCT	CONTAB(CHR)		;PROCESS BAD CHARACTER
	SOSG	F.CNT(AUT)		;OUTPUT BYTE
	JSP	Q1,OU.BUF		;OUTPUT BUFFER
	IDPB	ADR,F.PNT(AUT)		;STORE THE BYTE
	AOJN	P1,CONV06		;CONVERT ALL
;
; EXIT HERE WITH P1 CHARACTERS TRANSLATED
; IF P2 = 0 NO PADDING OR TRUNCATION REQUIRED
; IF P2 GT 0 PADDING REQUIRED
; IF P2 LT 0 TRUNCATION REQUIRED
;
CONV18:	JUMPE	P2,CONV11		;PAD OR TRUNCATE?
	JUMPG	P2,CONV09		;PAD
;
; TRUNCATE INPUT RECORD
;
	TLNE	IN,FF.EOL		;RECORD COUNT KNOWN?
	JRST	CONV11			;NO RECORD COUNT
CONV08:	SOSG	F.CNT(IN)		;SKIP BYTE
	JSP	Q1,IN.BUF		;GET BUFFER
	IBP	F.PNT(IN)		;SKIP BYTE
	AOJL	P2,CONV08		;CONTINUE
	JRST	CONV11			;FINISH INPUT RECORD
;
; PAD OUTPUT RECORD
;
CONV09:	MOVE	CHR,FC.PAD(AUT)		;GET PAD CHARACTER
CONV10:	SOSG	F.CNT(AUT)		;ROOM IN BUFFER
	JSP	Q1,OU.BUF		;NO
	IDPB	CHR,F.PNT(AUT)		;YES - STORE PAD CHARACTER
	SOJG	P2,CONV10		;CONTINUE
;
; RECORD DONE
;
CONV11:	JSP	ADR,FC.IFR(IN)		;FINISH INPUT RECORD
	JSP	ADR,FC.OFR(AUT)		;FINISH OUTPUT RECORD
	JRST	CONV03			;START ANOTHER RECORD
;
; HERE WHEN INPUT COUNT EXPIRES
;
CONV12:	JSP	ADR,.IFBLK		;FINISH INPUT BLOCK
	JSP	ADR,.IIBLK		;START A NEW BLOCK
	JRST	CONV03			;START A NEW RECORD
;
; HERE WHEN OUTPUT COUNT EXPIRES
;
CONV13:	JSP	ADR,.OFBLK		;FINISH BLOCK
	JSP	ADR,.OIBLK		;START A BLOCK
	JRST	CONV04			;CONTINUE
;
; HERE WHEN CR FOUND IN INPUT STREAM
;
CONV15:	TLNE	AUT,FF.VAR		;VARIABLE OUTPUT
	JRST	CONV19			;YES
	SUB	P2,P1			;COMPUTE # TO PAD
	JUMPGE	P2,CONV18		;PAD IF NECESSARY
	HALT	CONV18			;LOGIC ERROR
CONV19:	JUMPN	P1,CONV11		;ZERO RECORD?
	TLNE	AUT,FF.ZER		;ZERO RECORDS ALLOWED
	JRST	CONV11			;YES
	MOVEI	P1,1			;SET 1 CHAR RECORD
	MOVEI	P2,1			;PAD 1 CHARACTER
	JRST	CONV09			;PAD 1 CHARACTER
;
; HERE ON A TAB
;
CONV16:	MOVE	ADR,CODTAB+" "		;GET BLANK EQUIVALENT
CONV17:	SOSG	F.CNT(AUT)		;OUTPUT A BLANK
	JSP	Q1,OU.BUF		;CLEAR BUFFER
	IDPB	ADR,F.PNT(AUT)		;STORE BLANK
	AOJE	P1,CONV18		;DONE WITH LINE
	TRNE	P1,7			;AT A TAB STOP
	JRST	CONV17			;NO
	JRST	CONV06			;YES
;
; WORD MODE
;
; CODE DEPENDENT MODE USED FOR BLOCKING AND UNBLOCKING FILES
;
; REQUIRES THAT INPUT AND OUTPUT CODES MATCH
;
; USED IN ALL CASES WHERE ONLY BUFFERSIZE IN BEING CHANGED
; (I.E. PACKING DISK BLOCKS ONTO TAPE AND VICA VERSA)
; AND FOR ALL SIXBIT TO SIXBIT TRANSFERS (SINCE IT IS
; SYNCHRONIZED IN WORDS SIXBIT CAN BE EASILY BLOCKED)
;
WRDMOD:	PUSHJ	P,SETBIN		;SET POINTERS BINARY
WRDMO1:	HRLOI	T1,377777		;TRANSFER + INF WORDS
	PUSHJ	P,BLTWRD
	HALT	.			;HITS DONE
;
; SIXBIT TO SIXBIT CONVERSION
;
SYNC00:	PUSHJ	P,SETBIN		;SET POINTER BINARY
SYNC01:	MOVE	T1,[JRST 0(ADR)]	;SET DISPATCH
	HRLI	T2,FC.OIB(AUT)		;SET DISPATCH
	HRRI	T2,FC.OIB+1(AUT)	;SET DISPATCH
	MOVEM	T1,FC.OIB(AUT)		;SET DISPATCH
	BLT	T2,FC.OFR(AUT)		;SET DISPATCH
	JRST	SYNC03			;JUMP INTO LOOP
SYNC02:	JSP	ADR,.OFBLK		;FINISH BLOCK
SYNC03:	JSP	ADR,.OIBLK		;INITIALIZE OUTPUT BLOCK
SYNC04:	JSP	ADR,.OIREC		;INITIALIZE OUTPUT RECORD
	JRST	SYNC02			;BLOCK EXPIRED
SYNC05:	SOSGE	F.CNT(IN)		;ANYTHING IN BUFFER
	JRST	SYNC13			;NO - GET SOMETHING
	ILDB	T1,F.PNT(IN)		;GET POINTER
	ANDI	T1,7777			;12 BITS IN RECORD COUNT
	JUMPE	T1,SYNC05		;IGNORE ZERO RECORDS
	HRRZ	T2,FC.BYT(IN)		;GET BYTES PER WORD
	PUSHJ	P,T1DT2			;COMPUTE WORDS IN RECORD
	ADDI	T1,1			;INCLUDE RECORD WORD
	TLNE	AUT,FF.VAR		;VARIABLE OUTPUT
	SKIPA	T2,T1			;COPY INPUT SIZE
	HRRZ	T2,F.CBUF(AUT)		;GET OUTPUT SIZE
	TLNN	AUT,FF.VAR		;VARIABLE OUTPUT?
	SKIPA	T3,F.RCSZ(AUT)		;GET REQUIRED
	LDB	T3,[POINT 12,F.PNT(IN),35]	;GET INPUT
SYNC06:	SOSGE	F.CNT(AUT)		;STORE COUNT
	JRST	SYNC14			;GET BUFFER
	IDPB	T3,F.PNT(AUT)		;STORE
	SUB	T2,T1			;COMPUTE EXCESS
	JUMPGE	T2,SYNC07		;USE WHOLE INPUT RECORD
	ADD	T1,T2			;USE PART OF RECORD
SYNC07:	MOVEM	T2,TMPADR		;STORE T2
	SUBI	T1,1			;IGNORE RECORD WORDS
	PUSHJ	P,BLTWRD		;TRANSFER
	SKIPN	T1,TMPADR		;EXTRA?
	JRST	SYNC04			;NEXT RECORD
	JUMPL	T1,SYNC10		;TRUNCATE
;
; PADDING RECORD
;
SYNC08:	CAMG	T1,F.CNT(AUT)		;SKIP WHOLE BLOCK
	JRST	SYNC09			;NO
	SUB	T1,F.CNT(AUT)		;REDUCE BY AMOUNT SKIPPED
	JSP	Q1,OU.BUF		;PAD
	JRST	SYNC08			;START AGAIN
SYNC09:	ADDM	T1,F.PNT(AUT)		;PUSH POINTER
	MOVN	T1,T1			;PUSH COUNTER
	ADDM	T1,F.CNT(AUT)		;PUSH COUNTER
	JRST	SYNC04			;PADDING COMPLETE
;
; TRUNCATING RECORD
;
SYNC10:	MOVM	T1,T1			;HOW MANY TO TRUNCATE
SYNC11:	CAMG	T1,F.CNT(IN)		;TRUNCATE WHOLE BUFFER
	JRST	SYNC12			;NO
	SUB	T1,F.CNT(IN)		;REDUCE BY BUFFER SIZE
	JSP	Q1,IN.BUF		;TRUNCATE
	JRST	SYNC11			;CONTINUE
SYNC12:	ADDM	T1,F.PNT(IN)		;PUSH POINTER
	MOVN	T1,T1			;PUSH COUNTER
	ADDM	T1,F.CNT(IN)		;PUSH COUNTER
	JRST	SYNC04			;TRUNCATION COMPLETE
SYNC13:	JSP	Q1,IN.BUF
	JRST	SYNC05
SYNC14:	JSP	Q1,OU.BUF
	JRST	SYNC06
;
; BLTWRD - TRANSFERS WORDS BETWEEN BUFFERS
; CALL:	MOVE	T1,# WORDS TO BE TRANSFERRED
;	PUSHJ	P,BLTWRD
;	(RETURN)
;
; UPDATES INPUT AND OUTPUT POINTERS
;
BLTWRD:	SKIPG	T3,F.CNT(IN)		;ANYTHING LEFT IN BUFFER
	JRST	BLTWR1			;NO - GET A BUFFER
BLTWR3:	SKIPG	T2,F.CNT(AUT)		;ROOM IN BUFFER
	JRST	BLTWR2			;NO - GET A BUFFER
	CAML	T3,T2			;PICK THE LESSER
					;LESS IN INPUT
	MOVE	T3,T2			;LESS IN OUTPUT
	CAML	T3,T1			;TRANSFER HOW MANY
	MOVE	T3,T1			;NOT MORE THAN REQUIRED
	SUB	T1,T3			;COMPUTE REMAINDER
	MOVN	T4,T3			;FIX WORD COUNTS
	ADDM	T4,F.CNT(IN)		;FIX INPUT COUNT
	ADDM	T4,F.CNT(AUT)		;FIX OUTPUT COUNT
	MOVE	T4,F.PNT(AUT)		;BLT TO OUTPUT
	HRL	T4,F.PNT(IN)		;BLT TO INPUT
	AOBJN	T4,.+1			;ILDB INCREMENTS FIRST
	ADDM	T3,F.PNT(IN)		;ADVANCE INPUT POINTER
	ADDM	T3,F.PNT(AUT)		;ADVANCE OUTPUT POINTER
	ADDI	T3,-1(T4)		;WHERE LAST GOES
	BLT	T4,0(T3)		;TRANSFER
	JUMPG	T1,BLTWRD		;CONTINUE
	POPJ	P,			;RETURN
BLTWR1:	JSP	Q1,IN.BUF		;INPUT A BUFFER
	JRST	BLTWRD			;START AGAIN
BLTWR2:	JSP	Q1,OU.BUF		;OUTPUT A BUFFER
	JRST	BLTWRD			;START OVER
;
; SETBIN - MAKE BUFFER POINTERS BINARY
; CALL:	PUSHJ	P,SETBIN
;	(RETURN)
;
SETBIN:	MOVSI	T1,4400			;GET BINARY POINTER
	HLLM	T1,F.PNT(IN)		;SET INPUT BINARY
	HLLM	T1,F.PNT(AUT)		;SET OUTPUT BINARY
	POPJ	P,			;DONE
	PAGE
	SUBTTL	SPECIAL BUFFER ROUTINES
;
; BUFFER FLAGS LH OF BUFFER LINK
;
BF.USE==400000				;BUFFER IN USE
BF.RNC==200000				;INCOMPLETE BUFFER - RECORD COUNT INCOMPLETE
BF.BNC==100000				;INCOMPLETE BUFFER - BLOCK COUNT INCOMPLETE
;
; R.BINT - INITIALIZE COMPUTED BLOCK COUNT
; CALL:	JSP	ADR,R.BINT
;	(RETURN)
;
R.BINT:	TLO	FLG,FL.BNC		;SET BLOCK INCOMPLETE
	MOVSI	T3,BF.BNC		;SET BUFFER INCOMPLETE
	IORM	T3,@F.ADR(AUT)		;SET BUFFER INCOMPLETE
	HRLI	T2,F.ADR(AUT)		;COPY BUFFER HEADER
	HRRI	T2,BLKADR		;TO BLKADR
	BLT	T2,BLKCNT		;COPY
	SETZM	F.EBC(AUT)		;ZERO BLOCK LENGTH
	MOVEM	ADR,TMPADR		;STORE RETURN
	JSP	ADR,TOIBLK		;STORE DUMMY COUNT
	MOVSI	T3,BF.BNC		;SET BUFFER INCOMPLETE
	IORM	T3,@F.ADR(AUT)		;SET BUFFER INCOMPLETE
	JRST	@TMPADR			;RETURN
;
; R.RINT - INITIALIZE COMPUTED RECORD COUNT
; CALL:	JSP	ADR,R.INT
;	(RETURN)
;
R.RINT:	TLO	FLG,FL.RNC		;SET RECORD INCOMPLETE
	MOVSI	T3,BF.RNC		;SET BUFFER INCOMPLETE
	IORM	T3,@F.ADR(AUT)		;SET BUFFER INCOMPLETE
	HRLI	T2,F.ADR(AUT)		;COPY BUFFER HEADER
	HRRI	T2,RECADR		;TO RECADR
	BLT	T2,RECCNT
	MOVEI	P2,0			;ZERO RECORD COUNT
	MOVEM	ADR,TMPADR		;STORE RETURN ADDRESS
	JSP	ADR,TOIREC		;STORE DUMMY COUNT
	MOVSI	T3,BF.RNC		;SET BUFFER INCOMPLETE
	IORM	T3,@F.ADR(AUT)		;SET BUFFER INCOMPLETE
	JRST	@TMPADR			;RETURN
;
; R.BFIN - STORE COMPUTED BLOCK COUNT IN BUFFER
; CALL:	JSP	ADR,R.BFIN
;	(RETURN)
;
R.BFIN:	TLO	FLG,FL.RWR		;SET REWRITING RECORD
	MOVEM	ADR,TMPADR		;STORE RETURN
	HRLI	T2,F.ADR(AUT)		;COPY BUFFER HEADER
	HRRI	T2,ACTADR		;TO ACTADR
	BLT	T2,ACTCNT
	HRLI	T2,BLKADR		;RESTORE BUFFER HEADER
	HRRI	T2,F.ADR(AUT)		;FROM BLKADR
	BLT	T2,F.CNT(AUT)
	MOVSI	T3,BF.BNC		;CLEAR BUFFER INCOMPLETE
	ANDCAM	T3,@F.ADR(AUT)		;CLEAR BUFFER INCOMPLETE
	JSP	ADR,TOIBLK		;STORE COUNT
	MOVSI	T3,BF.BNC		;CLEAR BUFFER INCOMPLETE
	ANDCAM	T3,@F.ADR(AUT)		;CLEAR BUFFER INCOMPLETE
	HRLI	T2,ACTADR		;RESTORE BUFFER HEADER
	HRRI	T2,F.ADR(AUT)		;FROM ACTADR
	BLT	T2,F.CNT(AUT)
	TLZ	FLG,FL.RWR!FL.BNC
	MOVE	ADR,TMPADR		;RESTORE RETURN
	XCT	TOFBLK			;COMPLETE BLOCK
;
; R.RFIN - STORE COMPUTED RECORD COUNT IN BUFFER
; CALL:	JSP	ADR,R.RFIN
;	(RETURN)
;
R.RFIN:	TLO	FLG,FL.RWR		;SET REWRITING RECORD
	MOVEM	ADR,TMPADR
	HRLI	T2,F.ADR(AUT)		;COPY BUFFER HEADER
	HRRI	T2,ACTADR		;TO ACTADR
	BLT	T2,ACTCNT
	HRLI	T2,RECADR		;RESTORE BUFFER HEADER
	HRRI	T2,F.ADR(AUT)		;FROM RECADR
	BLT	T2,F.CNT(AUT)
	MOVSI	T3,BF.RNC		;CLEAR BUFFER INCOMPLETE
	ANDCAM	T3,@F.ADR(AUT)		;CLEAR BUFFER INCOMPLETE
	MOVE	P2,P1			;COPY COUNT
	JSP	ADR,TOIREC		;OUTPUT COUNT
	MOVSI	T3,BF.RNC		;CLEAR BUFFER INCOMPLETE
	ANDCAM	T3,@F.ADR(AUT)		;CLEAR BUFFER INCOMPLETE
	HRLI	T2,ACTADR		;RESTORE BUFFER HEADER
	HRRI	T2,F.ADR(AUT)		;FROM ACTADR
	BLT	T2,F.CNT(AUT)		;RESTORE BUFFER HEADER
	TLZ	FLG,FL.RWR!FL.RNC	;TURN OFF REWRITE
	MOVE	ADR,TMPADR		;RESTORE RETURN
	XCT	TOFREC			;FINISH RECORD
;
; ADVBUF - ROUTINE TO ADVANCE OUTPUT BUFFERS
; CALL:	MOVEI	AUT,OUTFIL
;	PUSHJ	P,ADVBUF
;	(NORMAL RETURN)
;	(ERROR RETURN - MORE BUFFERS NEEDED)
;
ADVBUF:	SKIPG	T2,F.ADR(AUT)		;GET BUFFER RING STATUS
	PJRST	ADVBU2			;VIRGIN RING - INIT FIRST BUFFER
	TLNN	FLG,FL.RWR		;REWRITING
	SOS	F.BUFC(AUT)		;COUNT BUFFER
	MOVSI	T3,BF.USE		;SET BUFFER USED
	IORB	T3,0(T2)		;SET BUFFER USED
	HRRZ	T4,F.PNT(AUT)		;GET CURRENT POINTER WORD
	SUBI	T4,1(T2)		;COMPUTE WORDS USED
	MOVEM	T4,1(T2)		;STORE WORDS USED
	HRRM	T3,F.ADR(AUT)		;ADVANCE BUFFER ADDRESS
	PUSHJ	P,INTBUF		;INITIALIZE BUFFER
	MOVE	T2,@F.ADR(AUT)		;GET BUFFER STATUS WORD
	TLNN	FLG,FL.RWR		;REWRITING?
	TLNN	T2,BF.USE!BF.BNC!BF.RNC	;BUFFER IN USE?
	POPJ	P,			;RETURN
	PJRST	OUTRNG			;YES - CLEAR RING
;
; HERE TO INIT VIRGIN RING
;
ADVBU2:	HRRZS	F.ADR(AUT)		;CLEAR RING VIRGIN
					;DROP INTO INTBUF AND RETURN
;
; INTBUF - SET UP BUFFER RING HEADER
; CALL:	MOVEI	AUT,OUTFIL
;	PUSHJ	P,INTBUF
;	(RETURN)
;
INTBUF:	MOVE	T2,F.ADR(AUT)		;GET BUFFER ADDRESS
	MOVEI	T3,1(T2)		;SET BUFFER POINTER
	HRRM	T3,F.PNT(AUT)		;SET BUFFER POINTER
	LDB	T4,[POINT 6,F.PNT(AUT),11]	;GET BYTE SIZE
	MOVEI	T3,^D36			;GET WORD SIZE
	IDIV	T3,T4			;COMPUTE BYTES PER WORD
	HLRZ	T4,0(T2)		;GET BUFFER SIZE IN WORDS
	ANDCMI	T4,BF.USE!BF.RNC!BF.BNC	;CLEAR STATUS
	SUBI	T4,1			;GET BUFFER SIZE IN WORDS
	IMUL	T3,T4			;COMPUTE BYTES IN BUFFER
	MOVEM	T3,F.CNT(AUT)		;STORE BYTES IN BUFFER
	MOVSI	T3,770000		;CLEAR POINTER OFFSET
	ANDCAM	T3,F.PNT(AUT)		;CLEAR POINTER OFFSET
	POPJ	P,			;DONE
;
; OUTRNG - OUTPUTS OUTPUT BUFFER RING
; CALL:	MOVEI	AUT,OUTFIL
;	PUSHJ	P,OUTRNG
;	(NORMAL RETURN)
;	(ERROR RETURN - MORE BUFFERS NEEDED OR HARDWARE ERROR)
;
OUTRNG:	MOVE	T2,F.ADR(AUT)		;GET FIRST BUFFER ADDRESS
	MOVE	T3,0(T2)		;GET BUFFER STATUS WORD
	TLNE	T3,BF.BNC!BF.RNC	;INCOMPLETE BUFFER?
	PJRST	OUTRN4			;YES - ERROR
	TLNE	T3,BF.USE		;IN USE
	JRST	OUTRN2			;YES
;
; FIRST CHASE AROUND RING FOR BUFFER IN USE
;
OUTRN1:	HRR	T2,0(T2)		;ADVANCE POINTER
	MOVE	T3,0(T2)		;GET BUFFER HEADER
	TLNE	T3,BF.USE		;BUFFER IN USE
	JRST	OUTRN2			;YES
	CAME	T2,F.ADR(AUT)		;WHERE WE STARTED?
	JRST	OUTRN1			;NO - TRY NEXT BUFFER
	POPJ	P,			;YES - RING ALREADY CLEAR
;
; OUTPUT BUFFERS STARTING WITH BUFFER IN T2
;
OUTRN2:
OUTRN3:	HLLZ	T3,0(T2)		;GET BUFFER WORD
	TLNN	T3,BF.BNC!BF.RNC	;INCOMPLETE BUFFER?
	TLZN	T3,BF.USE		;CLEAR USE BIT
	POPJ	P,			;DONE
	HLLM	T3,0(T2)		;RESTORE STATUS
	HRLI	T3,200			;OUTPUT WHOLE BUFFER
	SKIPE	1(T2)			;ZERO WORD COUNT?
	HRLZ	T3,1(T2)		;NO - GET WORD COUNT
	MOVN	T3,T3			;NEGATE IT
	HRRI	T3,1(T2)		;COMPLETE POINTER
	MOVEI	T4,0			;CLEAR IO WORD +1
	OUT	CH.OUT,T3		;OUTPUT
	JRST	OUTRN5			;CLEAR BUFFER
	PJRST	CPOPJ1			;GIVE ERROR RETURN
;
; CLEAR CURRENT BUFFER AND WORD COUNT
;
OUTRN5:	HRRI	T3,2(T2)		;SET UP BLT POINTER
	HRLI	T3,1(T2)		;SET UP BLT POINTER
	SETZM	1(T2)			;CLEAR WORD COUNT
	HLRZ	T4,0(T2)		;GET BUFFER SIZE + 1
	ADDI	T4,0(T2)		;FIND LAST WORD
	BLT	T3,0(T4)		;CLEAR BUFFER
	HRRZ	T2,0(T2)		;ADVANCE TO NEXT
	JRST	OUTRN3
;
; HERE WHEN NOT ENOUGH BUFFERS
;
OUTRN4:	TTCALL	3,[ASCIZ /?OUTPUT ERROR - not enough BUFFERS
/]
	PJRST	CPOPJ1			;GIVE ERROR RETURN
;
; DONE
;
DONE:	CLOSE	CH.IN,			;FIRST CLOSE FILES
	TLNN	FLG,FL.SPC		;SPECIAL OUTPUT
	JRST	DONE3			;NO
	TLNE	FLG,FL.RNC		;RECORD INCOMPLETE
	JSP	ADR,R.RFIN		;COMPLETE IT
	TLNE	FLG,FL.BNC		;BLOCK INCOMPLETE
	JSP	ADR,.OFBLK		;COMPLETE IT
	SOS	T2,F.PNT(AUT)		;GET POINTER
	HRL	T3,FC.PNT(AUT)		;COMPUTE INITIAL POINTER
	HRR	T3,F.ADR(AUT)		;COMPUTE INITIAL POINTER
	CAME	T2,T3			;SAME
	PUSHJ	P,ADVBUF		;FINISH BUFFER
	PUSHJ	P,OUTRNG		;CLEAR RING
	JFCL				;IGNORE
DONE3:	CLOSE	CH.OUT,
	TLNE	IN,FF.TAP		;THEN PERFORM UNLOAD
	TLNN	IN,FF.UNL		;UNLOAD
	JRST	DONE1			;NO
	MTAPE	CH.IN,11		;REWIND AND UNLOAD
DONE1:	TLNE	AUT,FF.TAP		;MAG-TAPE?
	TLNN	AUT,FF.UNL		;UNLOAD DEVICE?
	JRST	DONE2			;NO
	MTAPE	CH.OUT,11		;UNLOAD MAGTAPE
;
DONE2:	RELEASE	CH.IN,			;RELEASE INPUT
	RELEASE	CH.OUT,			;RELEASE OUTPUT
	PUSHJ	P,STATS			;PRINT STATISTICS
	JRST	RESTRT			;FINISHED - TRY AGAIN
;
; I/O ROUTINES USED BY THE ABOVE
;
IN.BUF:	IN	CH.IN,			;DO INPUT
	AOSA	F.BUFN(IN)		;COUNT BUFFERS
	JRST	IN.BU1			;CHECK FOR EOF
	SOS	F.BUFC(IN)		;DECREMENT COUNTER
	JRST	0(Q1)			;RETURN
IN.BU1:	STATO	CH.IN,20000
	HALT	.
	JRST	DONE			;EOF
;
OU.BUF:	XCT	EXOUT			;EXECUTE EXOUT
	AOSA	F.BUFN(AUT)		;COUNT BUFFERS
	HALT	.
	SOS	F.BUFC(AUT)		;DECREMENT COUNTER
	JRST	0(Q1)			;RETURN
;
IN.BYT:	SOSG	F.CNT(IN)
	JSP	Q1,IN.BUF
	ILDB	CHR,F.PNT(IN)
	JRST	0(Q2)
;
OU.BYT:	SOSG	F.CNT(AUT)
	JSP	Q1,OU.BUF
	IDPB	CHR,F.PNT(AUT)
	JRST	0(Q2)
	PAGE
	SUBTTL	DUMP ROUTINES
;
; THIS ROUTINES DUMP THE INPUT FILE
; IN THE OUTPUT CODE
;
; CURRENTLY ONLY EBCDIC TO ASCII IS IMPLEMENTED
;
FILDMP:	HRRZ	T1,F.CODE(IN)		;GET INPUT CODE
	CAIE	T1,%FEBCD		;EBCDIC
	CAIN	T1,%VEBCD		;EBCDIC
	JRST	FILD01			;YES
FILD02:	TTCALL	3,[ASCIZ /?Non EBCDIC To ASCII DUMP not yet implemented
/]
	JRST	RESTRT			;RESTART
FILD01:	HRRZ	T2,F.CODE(AUT)		;GET OUTPUT CODE
	CAIE	T2,%ASCII		;ASCII
	JRST	FILD02			;CAN'T DO IT
;
; READY TO START DUMP
;
	PUSHJ	P,FILD09		;SET UP POINTERS
	MOVEI	P1,0			;CLEAR P1
	SETZM	SAVCHR			;CLEAR RECORD COUNT
	JRST	FILD17			;START
FILD04:	JSP	ADR,.IFBLK		;FINISH INPUT BLOCK
FILD17:	JSP	ADR,.IIBLK		;START BLOCK
FILD03:	JSP	ADR,.IIREC		;START RECORD
	JRST	FILD04			;START A NEW BLOCK
	AOS	T1,SAVCHR		;COUNT RECORD
	IDIVI	T1,^D1000
	IDIVI	T2,^D100
	IDIVI	T3,^D10
	MOVEI	CHR," "
	OUTBYT	
	MOVEI	CHR,"("
	OUTBYT	
	MOVEI	CHR,"0"(T1)
	OUTBYT	
	MOVEI	CHR,"0"(T2)
	OUTBYT	
	MOVEI	CHR,"0"(T3)
	OUTBYT	
	MOVEI	CHR,"0"(T4)
	OUTBYT	
	MOVEI	CHR,")"
	OUTBYT	
	SKIPN	P2,F.CREC(IN)		;GET INPUT SIZE
	JRST	FILD26			;ZERO LENGTH RECORD
FILD07:	SOSG	F.CNT(IN)		;GET A BYTE
	JRST	FILD05			;DO INPUT
FILD06:	ILDB	CHR,F.PNT(IN)		;GET CHARACTER
;
; HERE WITH CHARACTER IN CHR
;
	MOVEI	T1," "			;GET CONVERSION
	SKIPGE	T2,CODTAB(CHR)		;GET CONVERSION
	JRST	FILD27			;IGNORE BAD CONVERSION
;
; CONVERT "LOWER" CASE CHARACTERS (VALUE GE 140)
;
	CAIG	T2,"Z"		;UPPER CASE OR CONTROL
	JRST	FILD77		;YES
	MOVEI	T1,"'"		;OUTPUT AS ' CHARACTER
	MOVEI	T2,-<" ">(T2)	;CONVERT TO UPPER CASE
	JRST	FILD27		;OUTPUT
;
; CONVERT "CONTROL" CHARACTERS (VALUE LE 37)
;
FILD77:	CAILE	T2,37		;CONTROL
	JRST	FILD27		;NO
	MOVEI	T1,"^"		;YES
	ADDI	T2,"@"		;MAKE ALPHA
FILD27:	IDPB	T1,D.PTR2
	IDPB	T2,D.PTR2
	MOVE	T1,CHR			;GET HEX
	MOVE	T2,CHR			;GET HEX
	ANDI	T1,17			;GET HEX
	HEX(F0)
	ANDI	T2,XXX			;GET HEX
	LSH	T2,-4			;GET HEX
	MOVEI	T1,"0"(T1)		;GET ASCII
	MOVEI	T2,"0"(T2)		;GET ASCII
	CAILE	T1,"9"
	ADDI	T1,7
	CAILE	T2,"9"
	ADDI	T2,7
	IDPB	T2,D.PTR1
	IDPB	T1,D.PTR1
;
; STORE PACKED
;
	CAILE	T2,"9"			;IN RANGE
	JRST	FILD13			;NO
	CAILE	T1,"9"		;IN RANGE
	JRST	FILD14			;NO
FILD15:	IDPB	T2,D.PTR3
	IDPB	T1,D.PTR3
	MOVEI	P1,1(P1)		;INCREMENT
	CAIGE	P1,^D60			;DONE 60 YET
	JRST	FILD16			;NO
	PUSHJ	P,FILD09		;RESET
	PUSHJ	P,FILD08		;OUTPUT
FILD16:	SOJG	P2,FILD07		;EOR
FILD26:	JSP	ADR,FC.IFR(IN)		;CLEAR INPUT RECORD
	PUSHJ	P,FILD09
	PUSHJ	P,FILD08
	JSP	ADR,FC.OFR(AUT)
	JRST	FILD03
FILD05:	IN	CH.IN,			;DO INPUT
	JRST	FILD06			;CONTINUE
	STATO	CH.IN,20000		;EOF
	HALT	.+1			;ERROR
	CAIN	P1,^D60			;ANY STORWD
	JRST	FILD25			;NO
	PUSHJ	P,FILD09		;RESET
	PUSHJ	P,FILD08		;OUTPUT
FILD25:	CLOSE	CH.OUT,
	JRST	RESTRT			;DONE
;
; FILD08 - OUTPUT LINES
;
FILD08:	LSH	P1,1
	MOVE	T1,D.PTR1		;GET FIRST LINE
	PUSHJ	P,FILD10		;OUTPUT LINE
	MOVE	T1,D.PTR2		;GET SECOND LINE
	PUSHJ	P,FILD10		;OUTPUT SECOND LINE
	MOVE	T1,D.PTR3		;GET THIRD LINE
	PUSHJ	P,FILD10		;OUTPUT THIRD LINE
	JSP	ADR,FC.OFR(AUT)
	MOVEI	P1,0			;CLEAR COUNT
	POPJ	P,			;DONE
;
; SET UP BYTE POINTER
;
FILD09:	MOVE	T1,[POINT 7,D.LIN1 ]
	MOVEM	T1,D.PTR1
	HRRI	T1,D.LIN2
	MOVEM	T1,D.PTR2
	HRRI	T1,D.LIN3
	MOVEM	T1,D.PTR3
	POPJ	P,
;
; FILD10 - OUTPUT LINE
;
FILD10:	JUMPE	P1,FILD12		;NOTHING TO PRINT
	MOVEI	ADR,11		;START WITH TAB
	SOSG	F.CNT(AUT)
	JSP	Q1,OU.BUF
	IDPB	ADR,F.PNT(AUT)
	MOVE	T2,P1			;COPY SIZE
FILD11:	ILDB	ADR,T1		;GET BYTE
	JUMPE	ADR,FILD12
	SOSG	F.CNT(AUT)
	JSP	Q1,OU.BUF
	IDPB	ADR,F.PNT(AUT)
	SOJG	T2,FILD11
FILD12:	JSP	ADR,FC.OFR(AUT)
	POPJ	P,
;
; HERE WHEN NOT IN RANGE
;
FILD13:	MOVEI	T1," "
	MOVEI	T2," "
	JRST	FILD15
;
; HERE WHEN SECOND NOT I RANGE
;
FILD14:	CAIE	T1,"B"
	CAIN	T1,"D"
	ADDI	T2,(SIXBIT /  0/)
	MOVEI	T1," "
	JRST	FILD15
	PAGE
	SUBTTL	WRITE PACKED TAPES
PCKWRT:	MOVE	T1,FC.SIZ(IN)		;SET CONTAB
	MOVE	T2,[AOS BCHRS]		;TO AOS
PCKW16:	MOVEM	T2,CONTAB(T1)		;STORE
	AOBJN	T1,PCKW16		;STORE FOR ALL
	MOVE	T1,[MOVEI ADR,40]	;MAKE NULLS INTO BLANKS
	MOVEM	T1,CONTAB
	TLNN	IN,FF.EOL		;EOL CHARACTER?
	JRST	PCKW02			;NO
;
; SET UP ASCII CONTAB
;
	MOVE	T1,[JRST PCKW06]
	MOVEM	T1,CONTAB		;
	HRRI	T1,PCKW15		;FOR CR
	MOVEM	T1,CONTAB+15		;SET FOR CR
	HRROS	CODTAB			;SET NULL BAD
	HRROS	CODTAB+15		;SET CR BAD
;
; START BLOCK
;
PCKW02:	JSP	ADR,.IIBLK		;INITIALIZE INPUT BLOCK
	JSP	ADR,.OIBLK		;INITIALIZE OUTPUT BLOCK
;
; START A RECORD
;
PCKW03:	JSP	ADR,.IIREC		;INITIALIZE INPUT RECORD
	JRST	PCKW12			;NO ROOM FOR RECORD
	SKIPN	F.CREC(IN)		;ZERO RECORD SIZE
	TLNE	IN,FF.EOL		;RECORD COUNT?
	CAIA				;NO/YES
	JRST	PCKW04			;ZERO LENGTH INITIALIZATION
	SOSG	F.CNT(IN)		;TEST FOR A BYTE
	JSP	Q1,IN.BUF		;GET A BUFFER
	TRO	FLG,FR.SSG		;SET SOSG DONE
PCKW04:	JSP	ADR,.OIREC		;INITIALIZE OUTPUT RECORD
	JRST	PCKW13			;BLOCK EXPIRED
	SKIPN	P2,F.CREC(IN)		;GET INPUT SIZE
	MOVEI	P2,377777		;SET LARGEST RECORD
	SKIPN	P1,F.CREC(AUT)		;GET OUTPUT SIZE
	MOVEI	P1,377777		;SET LARGEST RECORD
	MOVN	P1,P1			;SET NEGATIVE
	MOVN	P2,P2			;SET NEGATIVE
	HRLZ	P1,P1			;SET UP AOBJN WORD
	HRLZ	P2,P2			;SET UP AOBJN WORD
	SKIPN	F.CREC(IN)		;ZERO INPUT COUNT?
	TLNE	IN,FF.EOL		;RECORD COUNT KNOWN?
	JRST	PCKW07			;NO/NO - SKIP FIRST SOSG
	SKIPN	F.CREC(AUT)		;ZERO OUTPUT RECORD
	JRST	PCKW11			;YES - DON'T PAD
	JRST	PCKW09			;NO - PAD
;
PCKW07:	PUSHJ	P,PCKRNT		;INITIALIZE POINTER
	PUSHJ	P,PCKWNT		;INITAILIZE POINTER
PCKW06:	JUMPG	P2,PCKW09		;PAD OUTPUT RECORD
	PUSHJ	P,PCKIN			;GET A CHARACTER
	SKIPG	ADR,CODTAB(CHR)		;CONVERT
	XCT	CONTAB(CHR)		;PROCESS BAD CHARACTER
	PUSHJ	P,PCKOUT		;OUTPUT PACKED BYTE
	JUMPL	P1,PCKW06		;GET NEXT INPUT CHARACTER
;
; TEST FOR INPUT TRUNCATION
;
	TLNE	IN,FF.EOL		;RECORD COUNT?
	JRST	PCKW11			;NO -DON'T TRUNCATE
PCKW08:	JUMPG	P2,PCKW11		;FINISHED TRUNCATING
	PUSHJ	P,PCKIN			;GET A BYTE
	JRST	PCKW08			;CONTINUE
;
; PAD OUTPUT RECORD
;
PCKW09:	MOVE	CHR,FC.PAD(AUT)		;GET PAD CHARACTER
PCKW10:	JUMPG	P1,PCKW11		;FINISHED PADDING
	PUSHJ	P,PCKOUT		;PAD
	JRST	PCKW10			;GET ANOTHER
;
; RECORD DONE
;
PCKW11:	JSP	ADR,FC.IFR(IN)		;FINISH INPUT RECORD
	JSP	ADR,FC.OFR(AUT)		;FINISH OUTPUT RECORD
	AOS	NRECS		;INCREMENT # OF RECORDS CONVERTED
	JRST	PCKW03			;START ANOTHER RECORD
;
; HERE WHEN INPUT COUNT EXPIRES
;
PCKW12:	JSP	ADR,.IFBLK		;FINISH INPUT BLOCK
	JSP	ADR,.IIBLK		;START A NEW BLOCK
	JRST	PCKW03			;START A NEW RECORD
;
; HERE WHEN OUTPUT COUNT EXPIRES
;
PCKW13:	JSP	ADR,.OFBLK		;FINISH BLOCK
	JSP	ADR,.OIBLK		;START A BLOCK
	JRST	PCKW04			;CONTINUE
;
; HERE WHEN CR FOUND IN INPUT STREAM
;
PCKW15:	PUSHJ	P,PCKWFN		;FINISH BYTE IN CORE
	TLNE	AUT,FF.VAR		;VARIABLE OUTPUT
	JRST	PCKW11		;FINISH OFF
	JRST	PCKW09			;PAD IF NECESSARY
;
; PCKRNT - INITIALIZE POINTER
; CALL:	PUSHJ P,PCKRNT
;	(RETURN)
;
PCKRNT:	MOVE	T1,FP.ITM(IN)			;GET FIRST ITEM
	MOVEM	T1,FP.CUR(IN)			;SET AS CURRENT
	TRZ	FLG,FR.ICR			;CLEAE INCORE 
	PJRST	PCKRD1				;ADVANCE IF NECESSARY
;
; PCKIN - GET A PACKED BYTE
; CALL:	PUSHJ	P,PCKIN
;	(RETURN)
;
; RETURNS BYTE AS EBCDIC CHARACTER
; UNPAKCS PACKED DATA
;
PCKIN:	SKIPL	FP.PCT(IN)			;COMP-3
	JRST	PCKI03				;NO - RETURN BYTE
;
; HERE ON PACKED INPUT
;
	MOVE	T1,FP.PSZ(IN)			;GET POSITION
	CAIN	T1,1				;LAST BYTE?
	JRST	PCKI30				;YES
;
; HERE TO PROCESS UNSIGNED BYTE
;
PCKI35:	TRZE	FLG,FR.ICR		;BYTE IN CORE
	JRST	PCKI31			;YES
	TRZE	FLG,FR.SSG		;SOSG DONE
	JRST	PCKI32			;YES
	SOSG	F.CNT(IN)		;GET COUNT
	JSP	Q1,IN.BUF		;GET BUFFER
PCKI32:	ILDB	CHR,F.PNT(IN)		;GET BYTE
	MOVEM	CHR,FP.TMP(IN)		;STORE BYTE
	TRO	FLG,FR.ICR		;SET BYTE IN CORE
	LSH	CHR,-4			;GET FIRST BYTE
		HEX(F0)		;MAKE NORMAL
PCKI34:	IORI	CHR,XXX			;MAKE NORMAL
	JRST	PCKI05			;RETURN BYTE
;
; HERE ON BYTE IN CORE
;
PCKI31:	LDB	CHR,[POINT 4,FP.TMP(IN),35]	;GET BYTE
	AOB	P2			;COUNT BYTE
	JRST	PCKI34			;RETURN BYTE
;
; HERE ON LAST BYTE
;
PCKI30:	MOVE	T1,FP.PCT(IN)		;GET PICTURE
	TLNN	T1,FD.SGN		;SIGNED
	JRST	PCKI35			;NO
	TRZE	FLG,FR.ICR		;BYTE IN CORE
	JRST	PCKI40			;YES
	TRNE	FLG,FR.SSG		;SOSG DONE
	JRST	PCKI41			;YES
	SOSG	F.CNT(IN)
	JSP	Q1,IN.BUF
PCKI41:	ILDB	CHR,F.PNT(IN)
	MOVEM	CHR,FP.TMP(IN)
	LSH	CHR,-4			;SHIFT BYTE
	JRST	PCKI43			;GET SIGN
PCKI40:	LDB	CHR,[POINT 4,FP.TMP(IN),35]
	AOB	P2			;COUNT BYTE
PCKI42:	TRZE	FLG,FR.ICR		;BYTE IN CORE
	JRST	PCKI43			;YES
	SOSG	F.CNT(IN)		;SOSG CANNOT HAVE BENN DONE
	JSP	Q1,IN.BUF		;GET THE BUFFER
	ILDB	T2,F.PNT(IN)		;GET THE BYTE
		HEX(F)
	ANDI	T2,XXX		;GET LAST BYTE
	JRST	PCKI44			;SKIP LDB
PCKI43:	LDB	T2,[POINT 4,FP.TMP(IN),35]

PCKI44:	;PATCH...D. BRAITHWAITE  JUNE 24,73
	;ILLEGAL TRANSLATION OF SIGN CHARACTER
	;WHICH IS HEX(C) FOR POSITIVE, AND HEX(D)
	;FOR NEGATIVE...PRESENT MERELY RETURNS
	;THE HEX CHARACTER  D# OR C# WHICH DOES
	; NOT TRANSLATE CORRECTLY.
	;
	;SOLUTION..HAVE IT RETURN  F# FOR POSITIVE
	; AND  #+EBCIDIC(J) FOR NEG (WITH NON-ZERO
	; LAST DIGIT) OR EBCIDIC(:) (FOR ZERO
	; LAST DIGIT).

	SKIPE	,T2	;IS IT A "0"?(POSITIVE)
	CAIN	T2,14	;IS IT A "C" ? (POSITIVE)
	SKIPA	T2,[17] ;YES...INSERT HIGH ORDER "F".
	CAIE	T2,15	;NO....IS IT THEN A "D" ? (NEGATIVE)
			;IF NO..PLAY OLD GAME AND LET USER
			;ADD HIS FIX ALSO.
	JRST	PCKI45
			;HERE WHEN NEGATIVE.
	SKIPE	T2,CHR	;IS LAST CHARACTER ZERO ?
	SKIPA	CHR,[221]	;NO...MAKE OFFSET EBCIDIC(J).
	MOVEI	CHR,172	;YES..MAKE OFFSET EBCIDIC(:).
	ADDI	CHR,0(T2)	;ADD IN LAST CHAR
	SETZ	T2,		;CLEAR T2.
PCKI45:
	LSH	T2,4		;SWAP BYTE.
			;;;;;;;;;;;;;;;;;;;;;;;;END OF PATCH.

	AOB	P2			;COUNT SIGN BYTE
	IORI	CHR,0(T2)		;SET SIGN
	JRST	PCKI05			;HAVE SIGNED BYTE
;
; RETURN A NORMAL BYTE
;
PCKI03:	TRZE	FLG,FR.SSG		;SOSG DONE?
	JRST	PCKI37			;YES
	SOSG	F.CNT(IN)
	JSP	Q1,IN.BUF		;GET BUFFER
PCKI37:	ILDB	CHR,F.PNT(IN)		;GET THE BYTE
	AOB	P2			;COUNT BYTE
PCKI05:	SOSE	FP.PSZ(F)			;END OF PICTURE
	POPJ	P,				;RETURN
						;DROP INTO PCKRDV
;
; PCKRDV - ADVANCE INPUT POINTER
; CALL: PUSHJ	P,PCKRDV
;	(RETURN)
;
PCKRDV:	MOVE	T1,FP.CUR(IN)		;GET CURRENT
	HRRZ	T1,0(T1)			;GET NEXT
	MOVEM	T1,FP.CUR(IN)			;ADVANCE
PCKRD1:	SKIPN	T1,FP.CUR(IN)			;GET ITEM
	JRST	PCKRD2				;SUPPLY DEFAULT
	SKIPN	T2,ITMPCT(T1)			;PICTURE?
	JRST	PCKRDV				;NO - FIND A PICTURE ITEM
PCKRD3:	HRRZM	T2,FP.PSZ(IN)			;STORE SIZE
	MOVEM	T2,FP.PCT(IN)			;STORE PICTURE
	SETZM	FP.TMP(IN)			;CLEAR STORAGE
	TRZE	FLG,FR.ICR			;CLEAR INPUT BYTE IN CORE
	AOB	P2			;COUNT INCORE BYTE
	POPJ	P,				;RETURN
PCKRD2:	MOVEI	T2,377777			;SET LARGEST PICTURE
	JRST	PCKRD3				;SET UP
;
; PCKWNT - INITIALIZE POINTER
; CALL:	PUSHJ	P,PCKWNT
;	(RETURN)
;
PCKWNT:	MOVE	T1,FP.ITM(AUT)		;GET FIRST ITEM BLOCK
	MOVEM	T1,FP.CUR(AUT)		;STORE AS ITEM
	PJRST	PCKWD1			;CHECK THAT ELEMENTARY
;
; PCKOUT - OUTPUT PACKED BYTE
; CALL:	MOVEI	ADR,EBCDIC BYTE
;	PUSHJ	P,PCKOUT
;	(RETURN)
;
PCKOUT:	SKIPL	FP.PCT(AUT)			;COMP-3
	JRST	PCKO03				;NO - STORE BYTE
;
; PCKO01 - PACKED BYTE
;
		HEX(F0)
PCKO01:	CAIL	ADR,<XXX>			;PACKABLE
		HEX(F9)
	CAILE	ADR,<XXX>			;PACKABLE
	JRST	PCKO02				;TEST IF LAST AND SIGNED
	TRCN	FLG,FR.OCR			;BYTE IN CORE
	JRST	PCKO04				;NO
	ANDI	ADR,17				;YES
	IOR	ADR,FP.TMP(AUT)			;GET BYTE FROM CORE
	JRST	PCKO03				;RETURN
;
; HERE WHEN NO BYTE IN CORE
;
PCKO04:	DPB	ADR,[POINT 4,FP.TMP(AUT),31]	;STORE LOWER FOUR BITS
	JRST	PCKO05				;RETURN
;
; TEST IF LAST SIGNED BYTE
;
PCKO02:	MOVE	T1,FP.PSZ(AUT)			;GET COUNT
	CAIE	T1,1				;LAST BYTE
	JRST	PCKO06				;NO - ERROR
		HEX(C0)
	CAIL	ADR,<XXX>			;POSITIVE BYTE
		HEX(C9)
	CAILE	ADR,<XXX>			;POSITIVE BYTE
	JRST	PCKO20				;NO
	JRST	PCKO21				;YES
		HEX(D0)
PCKO20:	CAIL	ADR,<XXX>			;NEGATIVE BYTE
		HEX(D9)
	CAILE	ADR,<XXX>			;NEGATIVE BYTE
	JRST	PCKO06				;ERROR
	TRO	FLG,FR.SGN			;SET MINUS
		HEX(F0)
PCKO21:	IORI	ADR,<XXX>			;SET NORMAL
	JRST	PCKOUT				;START AGAIN
;
; PCKO06 - NON PACKABLE
;
PCKO06:	TTCALL	3,[ASCIZ /?NON PACKABLE CHARACTER IN PACKED FIELD
/]
		HEX(F9)
	MOVEI	ADR,XXX				;SUPPLY A PACKABLE BYTE
	JRST	PCKOUT				;RESTART
;
; HERE WHEN READY TO STORE A BYTE
;
PCKO03:	SOSG	F.CNT(AUT)		;STORE BYTE
	JSP	Q1,OU.BUF		;OUTPUT
	IDPB	ADR,F.PNT(AUT)		;STORE BYTE
	AOS	NCHRS		;INCREMENT # OF BYTES CONVERTED
	AOB	P1			;COUNT BYTE
;
; HERE WHEN NOT READY TO STORE BYTE
;
PCKO05:	SOSE	FP.PSZ(AUT)			;END OF PICTURE
	POPJ	P,				;RETURN
						;DROP INTO PCKWFN
;
; PCKWFN - FINISH CURRENT PICTURE
; CALL:	PUSHJ	P,PCKWFN
;	(RETURN)
;
PCKWFN:	SKIPL	T1,FP.PCT(AUT)			;COMP-3
	JRST	PCKWDV				;NO
	TRZE	FLG,FR.OCR			;BYTE IN CORE
	SKIPA	ADR,FP.TMP(AUT)			;YES - FETCH IT
	SETZB	ADR,FP.TMP(AUT)			;NO - CLEAR BOTH
	TLNN	T1,FD.SGN			;SIGNED
	JRST	PCKO08				;NO
	TRZE	FLG,FR.SGN			;POSITIVE QUANTITY
		HEX(D)
	SKIPA	T2,[XXX]			;SET MINUS
		HEX(C)
	MOVEI	T2,XXX				;SET PLUS
	IORI	ADR,0(T2) 			;OR IN SIGN
PCKO08:	JUMPE	ADR,PCKWDV			;BYTE TO STORE
	SOSG	F.CNT(AUT)			;YES
	JSP	Q1,OU.BUF
	IDPB	ADR,F.PNT(AUT)			;DROP IN PCKWDV
	AOB	P1			;COUNT BYTE
;
; PCKWDV - ADVANCE TO NEXT ITEM
; CALL:	PUSHJ	P,PCKWDV
;	(RETURN)
;
; SETS UP NEXT ELEMENTARY ITEM
;
PCKWDV:	MOVE	T1,FP.CUR(AUT)			;GET CURRENT
	HRRZ	T1,0(T1)			;GET NEXT
	MOVEM	T1,FP.CUR(AUT)		;ADVANCE ITEM
PCKWD1:	SKIPN	T1,FP.CUR(AUT)		;GET CURRENT ITEM
	JRST	PCKWD2				;SET DUMMY ITEM
	SKIPN	T2,ITMPCT(T1)			;ELEMENTARY
	JRST	PCKWDV				;NO
PCKWD3:	HRRZM	T2,FP.PSZ(AUT)		;STORE SIZE
	MOVEM	T2,FP.PCT(AUT)			;STORE PICTURE
	SETZM	FP.TMP(AUT)			;CLEAR COUNTERS
	TRZ	FLG,FR.OCR!FR.SGN		;CLEAR BYTE IN CORE AND SIGN
	POPJ	P,
PCKWD2:	MOVEI	T2,777777			;SET LARGEST PICTURE
	JRST	PCKWD3				;SET UP
	PAGE
	SUBTTL	MANIPULATE FD POINTER LIST
;
; LAYOUT OF FD TABLES
; -------------------
;
; FOR EACH ITEM (LINE STARTING WITH LEVEL #) GENERATE A
; FOUR WORD TABLE
;
; TABLE FORMAT
; ----- ------
;
; WORD0		LAST ITM	NEXT ITM
; WORD1		LEVEL #		NAME POINTER
; WORD2		(OCCURS)	REDEFINES
; IF LEVEL 66	[REDEFINES 1	REDEFINES 2]
; WORD3		PIC TYPE	PIC SIZE
;
; NAME BLOCKS
; -----------
;
; 2 + WORDS AS FOLLOWS
;
; WORD0		LAST NAME BLOCK		NEXT NAME BLOCK
; WORD1		        		ITEM BLOCK
; WORD2+	ITEM NAME IN SIXBIT
;		(COBSIZ WORDS)
;
;
; LOW CORE LOCATIONS
;	FP.ITM POINTS TO 1ST ITEM BLOCK
;	FP.NAM POINTS TO 1ST NAME BLOCK
; DEFINE ENTRIES IN ITEM TABLE
;
ITMLNK==0			;LINK WORD
ITMLVL==1			;LEVEL WORD
ITMNAM==1			;NAME LINK
ITMOCR==2			;OCCURS WORD
ITMRDF==2			;REDEFINES WORD
ITMPCT==3			;PICTURE WORD
ITMLEN==ITMPCT+1		;LENGTH OF TABLE
;
; DEFINE ENTRIES IN NAME TABLE
;
NAMLNK==0			;LINK WORD
NAMITM==1			;ITEM WORD
NAMNAM==2			;NAME IN SIXBIT
NAMLEN==NAMNAM+COBSIZ		;LENGTH OF TABLE ENTRY
;
; PCKTYP - DECODE PACKED SPECIFICATION
; CALL:	PUSHJ	P,PCKTYP
;	(ERROR RETURN)
;	(RETURN)
;
; P1 HOLDS "CURRENT" ITEM BLOCK ADDRESS
; P2 HOLDS "CURRENT" NAME BLOCK ADDRESS
;
ITM==P1					;HOLDS CURRENT ITEM
NAM==P2					;HOLDS CURRENT NAME
;
PCKTYP:	HLL	F,FP.STA(F)		;GET PACKED STATUS
	MOVEI	T1,FP.ADR(F)		;GET HEADER
	MOVEM	T1,FP.BUF(F)		;STORE IN OPEN BLOCK
	OPEN	CH.PCK,FP.MOD(F)	;OPEN DEVICE
	HALT	.
	LOOKUP	CH.PCK,FP.NAM(F)	;LOOKUP FILE
	HALT	.			;ERROR
	PUSHJ	P,COBS00		;INITIALIZE FOR COBSIX
	MOVEI	ITM,FP.ITM(F)		;LINK TO FIRST ITEM
	MOVEI	NAM,FP.NMB(F)		;LINK TO FIRST NAME BLOCK
;
; FIRST SCAN FOR FD
;
	SKIPN	PCKFD(LOW)		;FD SPECIFIED
	JRST	PCKT01			;SCAN NOT REQUIRED
PCKT02:	PUSHJ	P,COBSIX		;GET ITEM
	POPJ	P,			;EOF - ERROR
	MOVE	T1,COBDAT(LOW)		;GET FIRST WORD
	CAMN	T1,[SIXBIT /FD/]	;FD?
	JRST	PCKT03			;YES
PCKT04:	PUSHJ	P,NXTLNE		;GET NEXT LINE
	POPJ	P,			;EOF - ERROR
	JRST	PCKT02			;TRY AGAIN
;
; HERE WHEN FD FOUND AT BEGINNING OF LINE
;
PCKT03:	PUSHJ	P,COBSIX		;GET FD NAME
	POPJ	P,			;EOF - ERROR
	ZZ==0
REPEAT FDSIZE,<
	MOVE	T1,PCKFD+ZZ(LOW)	;GET FD
	CAME	T1,COBDAT+ZZ(LOW)	;COMPARE TO DATA
	JRST	PCKT04			;NO MATCH
	ZZ==ZZ+1
	>
	PUSHJ	P,NXTLNE		;FD'S MATCH - SLEW LINE
	POPJ	P,			;EOF - ERROR
;
; HERE WHEN POSITIONED AFTER FD AT FIRST 01 LEVEL
;
PCKT01:	PUSHJ	P,COBSIX		;GET LINE START
	PJRST	CPOPJ1			;DONE
	PUSHJ	P,MAKNUM		;MAKE NUMERIC
	PJRST	CPOPJ1			;DONE
;
; HERE WITH LEVEL # IN T1
;
	PUSHJ	P,ALCITM		;ALLOCATE AN ITEM TABLE
PCKT05:	HRLM	ITM,ITMLNK(T2)		;STORE BACKWARD LINK
	HRRM	T2,ITMLNK(ITM)		;STORE FORWARD LINK
	MOVE	ITM,T2			;SET NEW "CURRENT" ITEM BLOCK
	HRLZM	T1,ITMLVL(ITM)		;STORE LEVEL #
	SETZM	ITMPCT(ITM)		;CLEAR PICTURE WORD
	SETZM	ITMOCR(ITM)		;CLEAR OCCURS WORD
;
; GET NAME AND STORE IT
;
	PUSHJ	P,COBSIX		;GET NAME IN COBDAT
	POPJ	P,			;ERROR RETURN
	PUSHJ	P,FNDNAM		;FIND NAME
	JRST	PCKT11			;UNIQUE NAME
	HLRZ	T2,ITMLVL(T3)		;GET LEVEL #
	CAIN	T2,^D66			;LEVEL 66?
	JRST	PCKT30			;YES - FILLER NOT LLOWED
	MOVE	T2,COBDAT(LOW)		;GET DATA
	MOVE	T3,COBDAT+1(LOW)		;GET DATA
	CAMN	T2,[SIXBIT /FILLER/]	;FILLER
	JUMPE	T3,PCKT31		;YES
PCKT30:	TTCALL	3,[ASCIZ /?NON-UNIQUE NAME
/]
	POPJ	P,			;ERROR RETURN
PCKT11:	PUSHJ	P,ALCNAM		;ALLOCATE NAME TABLE
	HRRM	T2,NAMLNK(NAM)		;STORE FORWARD LINK
	HRLZM	NAM,NAMLNK(T2)		;STORE BACKWARD LINK
	MOVE	NAM,T2			;SET "CURRENT" NAME BLOCK
	HRLI	T3,COBDAT(LOW)		;WHERE IS DATA
	HRRI	T3,NAMNAM(NAM)		;WHERE DOES NAME GO?
	BLT	T3,NAMNAM+COBSIZ-1(NAM)	;COPY DATA
	MOVEM	P1,NAMITM(P2)		;STORE ITEM IN NAME BLOCK
PCKT31:	HRRM	NAM,ITMNAM(ITM)		;STORE NAME IN ITEM BLOCK
;
; TEST IF LEVEL 66
;
	HLRZ	T1,ITMLVL(ITM)		;GET LEVEL #
	CAIN	T1,^D66			;LEVEL 66
	JRST	PCKT06			;YES - STORE LEVEL 66
;
; TEST COBOL KEYWORDS
;
; PIC OR PICTURE
; COMP-3 OR COMPUTATIONAL-3
; OCCURS
; REDEFINES
;
PKLOOP:	JUMPN	CHR,PCKT01		;DONE - GET NEXT ITEM
	PUSHJ	P,COBSIX		;GET ITEM
	POPJ	P,			;ERROR
	MOVE	T1,COBDAT(LOW)		;GET FIRST DATA WORD
	CAMN	T1,[SIXBIT /PIC/]	;"PIC"?
	JRST	PCTURE			;YES
	MOVE	T2,COBDAT+1(LOW)		;GET SECOND DATA WORD
	CAMN	T1,[SIXBIT /PICTUR/]	;"PICTUR"?
	CAME	T2,[SIXBIT /E/]		;"E"?
	JRST	PCKT07			;NO
;
; HERE ON "PIC" OR "PICTURE"
;
PCTURE:	JUMPN	CHR,CPOPJ		;ERROR IF EOL
	PUSHJ	P,COBSIX		;GET PICTURE
	POPJ	P,			;EOF - ERROR
	MOVE	T2,[POINT 6,COBDAT(LOW) ]	;SET POINTER IN P2
	MOVEI	T3,0			;SET ITEM SIZE TO 0
PCTUR1:	ILDB	T1,T2			;GET A CHARACTER
	JUMPE	T1,PCTUR2		;DONE
;
; TABLE OF COBOL PICTURE CHARACTERS AND THEIR VALUES
; --------------------------------------------------
;
; CHARACTER	TYPE	POSITION
; ---------	----	--------
;
;    9		NUM	  YES
;    A		ALPH	  YES
;    X		ALPH	  YES
;    V		NUM	  NO
;    P		NUM	  NO
;    S		NUM	  NO
;    Z		NUM	  YES
;    *		NUM	  YES
;    $		NUM	  YES
;    ,		NUM	  YES
;    .		NUM	  YES
;    B		BOTH	  YES
;    O		BOTH	  YES
;    +		NUM	  YES
;    -		NUM	  YES
;    CR		NUM	  YES(2)
;    DB		NUM	  YES(2)
;
	CAIE	T1,"V"-" "		;V
	CAIN	T1,"P"-" "		;P
	JRST	PCTUR1			;IGNORE
	CAIN	T1,"S"-" "		;S
	JRST	PCTURS			;PROCESS S
	CAIE	T1,"."-" "		;PERIOD
	CAIN	T1,","-" "		;COMMA
	JRST	PCTURZ		;NUMERIC
	CAIE	T1,"9"-" "		;NUMERIC
	CAIN	T1,"Z"-" "		;Z
	JRST	PCTURZ			;PROCESS 9 OR Z
	CAIE	T1,"A"-" "		;A
	CAIN	T1,"X"-" "		;X
	AOJA	T3,PCTUR1		;INCREASE SIZE AND CONTINUE
	CAIE	T1,"*"-" "		;ASTERISK
	CAIN	T1,"$"-" "		;DOLLAR SIGN
	JRST	PCTURZ			;NUMERIC
	CAIE	T1,"B"-" "		;B
	CAIN	T1,"O"-" "		;O
	JRST	PCTURZ
	CAIE	T1,"-"-" "		;MINUS
	CAIN	T1,"+"-" "		;PLUS
	JRST	PCTURZ
	CAIN	T1,"C"-" "		;CR
	JRST	PCTURC
	CAIN	T1,"D"-" "		;DB
	JRST	PCTURD
	CAIE	T1,"("-" "		;(
	POPJ	P,			;INVALID PICTURE
;
; COMPUTE SIZE
;
	CAIE	T3,1			;ONLY 1 TO NOW
	POPJ	P,			;ERROR
	MOVEI	T3,0			;CLEAR SIZE
PCTUR3:	ILDB	T1,T2			;GET NUMERIC
	CAIL	T1,"0"-" "
	CAILE	T1,"9"-" "
	JRST	PCTUR4			;NON-NUMERIC
	IMULI	T3,^D10
	ADDI	T3,-<"0"-" ">(T1)
	JRST	PCTUR3
PCTUR4:	CAIN	T1,")"-" "		;RIGHT PARENTHESIS?
PCTUR2:	JUMPN	T3,PCTUR5		;NON-ZERO PICTURE SIZE?
	POPJ	P,			;ERROR RETURN
PCTUR5:	HRRM	T3,ITMPCT(ITM)		;STORE PICTURE SIZE
	JRST	PKLOOP			;DONE
;
; HERE ON S
;
PCTURS:	MOVSI	T1,FD.SGN		;SET SIGNED
	IORM	T1,ITMPCT(ITM)		;OR IN
	JRST	PCTUR1
;
; HERE ON Z OR 9
;
PCTURZ:	MOVSI	T1,FD.NUM		;SET NUMERIC
	IORM	T1,ITMPCT(ITM)		;OR IN
	AOJA	T3,PCTUR1		;INCREASE SIZE
;
; C OF CR
;
PCTURC:	ILDB	T1,T2			;GET R
	CAIE	T1,"R"-" "		;R?
	POPJ	P,			;NO
	JRST	PCTURF			;INC SIZE
;
; D OF DB
;
PCTURD:	ILDB	T1,T2
	CAIE	T1,"B"-" "
	POPJ	P,
PCTURF:	ADDI	T3,2
	JRST	PCTUR2
;
; TEST FOR COMP-3 OR COMPUTATIONAL-3
;
PCKT07:	CAMN	T1,[SIXBIT /COMP-3/]	;"COMP-3"?
	JUMPE	T2,COMP3		;COMP-3 IF SECOND WORD BLANK
PCKT08:	CAMN	T1,[SIXBIT /COMPUTA/]	;"COMPUT"?
	CAME	T2,[SIXBIT /ATIONA/]	;"ATIONA"?
	JRST	PCKT09			;NO
	MOVE	T3,COBDAT+2(LOW)		;GET THIRD DATA WORD
	CAME	T3,[SIXBIT /L-3/]	;"L-3"?
	JRST	PCKT09			;NO
;
; HERE ON "COMP-3" OR "COMPUTATIONAL-3"
;
COMP3:	MOVSI	T1,FD.CMP		;SET COMP-3
	IORM	T1,ITMPCT(ITM)		;STORE
	JRST	PKLOOP
;
; TEST FOR "OCCURS"
;
PCKT09:	CAMN	T1,[SIXBIT /OCCURS/]	;"OCCURS"?
	JUMPE	T2,OCCURS		;"OCCURS" IF BLANK
PCKT10:	CAMN	T1,[SIXBIT /REDEFI/]	;"REDEFI"?
	CAME	T2,[SIXBIT /NES/]	;"NES"?
	JRST	PKLOOP			;UNDEFINED KEYWORD
;
; HERE ON REDEFINES
;
REDEFI:	JUMPN	CHR,CPOPJ		;ERROR IF EOL
	PUSHJ	P,COBSIX		;GET DATA
	POPJ	P,			;ERROR
	PUSHJ	P,FNDNAM		;FIND NAME
	JRST	RDFERR			;REDEFINE ERROR
	MOVE	T1,NAMITM(NAM)		;GET ITEM BLOCK
	HRRM	T1,ITMRDF(ITM)		;STORE
	JRST	PKLOOP
RDFERR:	TTCALL	3,[ASCIZ /?REDEFINES NON EXISTENT NAME
/]
	POPJ	P,
;
; HERE ON OCCURS
;
OCCURS:	JUMPN	CHR,CPOPJ		;ERROR IF EOL
	PUSHJ	P,COBSIX		;GET NUMBER
	POPJ	P,			;ERROR
	PUSHJ	P,MAKNUM		;MAKE NUMERIC
	POPJ	P,			;ERROR
	HRLM	T1,ITMRDF(ITM)		;STORE OCCURS
	JRST	PKLOOP
;
; PCKT06 - STORE LEVEL 66
;
PCKT06:	PUSHJ	P,COBSIX		;GET NEXT
	POPJ	P,			;ERROR
	MOVE	T1,COBDAT(LOW)		;GET FIRST DATA WORD
	MOVE	T2,COBDAT+1(LOW)	;GET SECOND DATA WORD
	CAMN	T1,[SIXBIT /REDEFI/]	;"REDEFI"
	CAME	T2,[SIXBIT /NES/]	;"NES"?
	POPJ	P,			;ERROR
	JUMPN	CHR,CPOPJ		;ALSO NOT EOL
	PUSHJ	P,COBSIX		;GET FIRST ITEM
	POPJ	P,			;ERROR
	JUMPN	CHR,PCKT01		;EOL
	PUSHJ	P,FNDNAM
	JRST	RDFERR			;REDEFINES ERROR
	MOVE	T1,NAMITM(NAM)		;GET ITEM BLOCK
	HRLM	T1,ITMRDF(ITM)		;STORE 1ST REDEFINES
	PUSHJ	P,COBSIX		;GET THRU
	POPJ	P,			;ERROR
	MOVE	T1,COBDAT(LOW)		;GET DATA
	CAME	T1,[SIXBIT /THRU/]	;"THRU"?
	POPJ	P,			;ERROR
	JUMPN	CHR,CPOPJ		;NOT EOL
	PUSHJ	P,COBSIX		;GET SECOND
	POPJ	P,			;ERROR
	PUSHJ	P,FNDNAM
	JRST	RDFERR
	MOVE	T1,NAMITM(NAM)		;GET ITEM BLOCK
	HRRM	T1,ITMRDF(ITM)		;STORE ITM BLOCK
	JUMPE	CHR,CPOPJ		;MUST BE EOL
	JRST	PCKT01			;DONE
;
; ALCITM - ALLOCATE AN ITM TABLE
; ALCNAM - ALLOCATE A NAME TABLE
; CALL:	PUSHJ	P,ALCXXX
;	(RETURN) WITH TABLE BASE IN T2
;
ALCITM:	SKIPA	T3,[ITMLEN]		;GET ITEM BLOCK SIZE
ALCNAM:	MOVEI	T3,NAMLEN		;GET NAME BLOCK SIZE
	MOVE	T2,.JBFF		;GET TABLE ADDRESS
	ADDB	T3,.JBFF		;GET NEW CORE SIZE
	CAMG	T3,.JBREL		;DO A CORE UUO?
	POPJ	P,			;NO
	CORE	T3,			;YES
	JRST	[TTCALL	3,[ASCIZ /?CORE FAILURE
/]
		 JRST RESTRT]
	POPJ	P,			;HAVE CORE
;
; MAKNUM - CONVERTS COBDAT INTO A NUMERIC ARGUMENT
; CALL:	PUSHJ	P,MAKNUM
;	(ERROR RETURN - NON NUMERIC CHARACTER - CHARACTER IN CHR)
;	(RETURN - NUMBER IN T1)
;
MAKNUM:	MOVEI	T1,0			;CLEAR NUMBER
	MOVE	T2,[POINT 6,COBDAT(LOW) ]
MAKNU1:	ILDB	T3,T2			;GET ENTRY
	JUMPE	T3,CPOPJ1		;DONE - RETURN
	CAIL	T3,"0"-" "
	CAILE	T3,"9"-" "
	POPJ	P,			;NON-NUMERIC
	IMULI	T1,^D10			;MOVE CURRENT
	ADDI	T1,-<"0"-" ">(T3)
	JRST	MAKNU1
;
; FNDNAM - SEARCH NAME TABLE FOR A NAME
; CALL:	PUSHJ	P,FNDNAM
;	(NO MATCH - LAST FP.NMB POINTED TO BY T2)
;	(MATCH - MATCHED FP.NMB POINTED TO BY T2)
;
FNDNAM:	MOVEI	NAM,FP.NMB(F)		;GET ADR
FNDN04:	HRRZ	T3,0(NAM)		;WHERE DOES IT POINT
	JUMPE	T3,CPOPJ		;ERROR RETURN
	MOVE	NAM,T3			;SET UP "CURRENT" NAME BLOCK
	ZZ==0
REPEAT COBSIZ,<
	MOVE	T2,COBDAT+ZZ(LOW)	;GET DATA
	CAME	T2,NAMNAM+ZZ(NAM)	;COMPARE WITH ENTRY
	JRST	FNDN04			;NO MATCH
	ZZ==ZZ+1
>
	PJRST	CPOPJ1			;HAVE A MATCH
;
; NXTLNE - ADVANCES FILE TO NEXT LINE
; CALL:	PUSHJ	P,NXTLNE
;	(EOF RETURN)
;	(RETURN)
;
NXTLNE:	JUMPN	CHR,CPOPJ1		;ALEARDY AT EOL?
	PUSHJ	P,COBSIX		;NO - GET NEXT ITEM
	POPJ	P,			;EOF - DONE
	JRST	NXTLNE			;TEST AGAIN
;
; PCKERR - ROUTINE CALLED FROM MAIN PROGRAM ON PACKED ERROR
; CALL:	PUSHJ	P,PCKERR
;	(RETURN - IF DESIRED)
;
PCKERR:	TTCALL	3,[ASCIZ /?PACKED Specification ERROR
/]
	POPJ	P,			;CONTINUE PROCESSING
;
; FDDUMP - DUMPS THS FD STORED IN CORE
; CALL:	PUSHJ	P,FDDUMP
;	(RETURN)
;
FDDUMP:	SKIPA	ITM,FP.ITM(F)		;LOCATE FIRST 01 LEVEL
FDDUM1:	HRRZ	ITM,ITMLNK(ITM)		;GET NEXT
	JUMPE	ITM,CPOPJ		;DONE - RETURN
	PUSHJ	P,ITMDMP		;DUMP ITEM
	JRST	FDDUM1
;
; ITMDMP - DUMPS AN ITEM BLOCK
; CALL:	MOVEI	ITM,ITMBLK
;	PUSHJ	P,ITMDMP
;	(RETURN)
;
; FLAGS
;
FD.CMP==400000				;COMP-3 ITEM
FD.SGN==200000				;SIGNED ITEM
FD.NUM==100000				;NUMERIC ITEM
;
ITMDMP:	HLRZ	T2,ITMLVL(ITM)		;GET LEVEL #
	CAIN	T2,^D66			;LEVEL 66?
	JRST	ITMDM7			;YES
	MOVE	T3,T2			;COPY LEVEL
ITMDM2:	TTCALL	3,[ASCIZ / /]		;1 SPACE PER LEVEL
	SOJG	T3,ITMDM2		;1 SPACE PER LEVEL
ITMDM1:	IDIVI	T2,^D10			;TYPE TWO DIGITS
	ADDI	T2,"0"			;TYPE 1ST DIGIT
	TTCALL	1,T2			;TYPE 1ST DIGIT
	ADDI	T3,"0"			;TYPE 2ND DIGIT
	TTCALL	1,T3			;TYPE 2ND DIGIT
	TTCALL	3,[ASCIZ / /]		;TYPE A SPACE
	HRRZ	NAM,ITMNAM(ITM)		;WHERE IS NAME BLOCK
	PUSHJ	P,NAMPRT		;TYPE LEVEL NAME
	HRRZ	T2,ITMRDF(ITM)		;TEST FOR REDEFINES
	JUMPE	T2,ITMDM3		;DOES NOT REDEFINE
	TTCALL	3,[ASCIZ / REDEFINES /]
	HRRZ	NAM,ITMNAM(T2)		;GET NAME BLOCK
	PUSHJ	P,NAMPRT		;TYPE NAME BLOCK
ITMDM3:	SKIPN	T2,ITMPCT(ITM)		;PICTURE?
	JRST	ITMDM4			;NO
	TTCALL	3,[ASCIZ / PICTURE /]
	TLNE	T2,FD.SGN		;SIGNED?
	TTCALL	3,[ASCIZ /S/]
	TLNE	T2,FD.NUM		;NUMERIC
	SKIPA	T3,["9"]		;YES
	MOVE	T3,["X"]		;NO
	TTCALL	1,T3			;TYPE 9 OR X
	HRRZ	T2,T2			;GET COUNT
	CAIN	T2,1			;NO ()
	JRST	ITMDM6			;NO ()
	TTCALL	1,["("]			;TYPE PAREN
	PUSHJ	P,DECPRT		;TYPE DECIMAL
	TTCALL	1,[")"]			;FINISH
ITMDM6:	SKIPG	ITMPCT(ITM)		;COMP-3?
	TTCALL	3,[ASCIZ / COMP-3/]
ITMDM4:	HLRZ	T2,ITMOCR(ITM)		;OCCURS?
	JUMPE	T2,ITMDM5		;NO
	TTCALL	3,[ASCIZ / OCCURS /]
	PUSHJ	P,DECPRT		;TYPE DECIMAL
	TTCALL	3,[ASCIZ / TIMES/]
ITMDM5:	TTCALL	3,[ASCIZ /.
/]
	POPJ	P,			;RETURN
ITMDM7:	TTCALL	3,[ASCIZ /  66 /]
	HRRZ	NAM,NAMITM(ITM)		;GET NAME
	PUSHJ	P,NAMPRT		;TYPE NAME
	TTCALL	3,[ASCIZ /  REDEFINES /]
	HLRZ	T2,ITMRDF(ITM)		;GET 1ST REDEFINES
	HRRZ	NAM,ITMNAM(T2)		;GET NAME BLOCK
	PUSHJ	P,NAMPRT		;PRINT NAME
	TTCALL	3,[ASCIZ / THRU /]
	HRRZ	T2,ITMRDF(ITM)		;GET 2ND REDEFINES
	HRRZ	NAM,ITMNAM(T2)		;GET NAME BLOCK
	PUSHJ	P,NAMPRT		;PRINT NAME
	JRST	ITMDM5			;RETURN
;
; NAMPRT - TYPE NAMBLK
; CALL:	MOVEI	NAM,NAMBLK
;	PUSHJ	P,NAMPRT
;	(RETURN)
;
NAMPRT:	MOVE	T3,[POINT 6,NAMNAM(NAM) ]	;SET T3
NAMPR1:	ILDB	T4,T3			;GET A BYTE
	JUMPE	T4,CPOPJ		;RETURN IF NULL (NO SPACES)
	ADDI	T4," "			;GO TO ASCII
	TTCALL	1,T4			;TYPE
	JRST	NAMPR1			;RETURN
;
; DECPRT - TYPE A DECIMAL NUMBER
; CALL:	MOVE	T2,#
;	PUSHJ	P,DECPRT
;	(RETURN)
;
DECPRT:	IDIVI	T2,^D10
	JUMPE	T2,DECPR1
	HRLM	T3,0(P)
	PUSHJ	P,DECPRT
	HLRZ	T3,0(P)
DECPR1:	ADDI	T3,"0"
	TTCALL	1,T3
	POPJ	P,
	PAGE
	SUBTTL	RETURN COBOL ITEM IN "STANDARD" FORMAT
;
; COBSIX - RETURNS A COBOL LINE IN "STANDARDIZED FORM"
;	   AS SIXBIT ITEMS
;
; STANDARDIZED FORM IS AS FOLLOWS
;
; INPUT IS TRUNCATED AFTER 72 OR 106 CHARACTERS
; SEQUENCE NUMBERS ARE REMOVED
; COMMENT LINES (* IN COLUMN 1) ARE REMOVED
; LINE CAN BE ANY LENGTH
; LINE TERMINATED BY A PERIOD FOLLOWED BY A NON-NUMERIC CHARACTER
; CONTINUATIONS ARE EXPANDED
; LITERALS ARE TRUNCATED TO DOUBLE DOUBLE QUOTES OR DOUBLE SINGLE QUOTES
;
; ON FIRST CALL NXTCNT SHOULD BE ZERO
;
; CALL:	PUSHJ	P,COBSIX	
;	(EOF RETURN)
;	(DATA RETURN - DATA IN COBDAT IN SIXBIT)
;
; ON RETURN CHR IS ZERO EXCEPT AT EOL
;
;
COBSIX:	MOVEI	T1,6*COBSIZ		;SET SIZE
	MOVE	T2,[POINT 6,COBDAT(LOW) ]	;SET POINTER
	MOVE	T3,[XWD COBDAT,COBDAT+1]
					;NB: ABOVE MUST BE CHANGED IF COBDAT OFFSET
	SETZM	COBDAT(LOW)		;CLEAR COBDAT
	BLT	T3,COBDAT+COBSIZ-1(LOW)
	PJRST	0(Q1)			;DISPATCH
COBS01:	TRO	FLG,FR.BLK		;BLANK ON
	TRZ	FLG,FR.DQT!FR.SQT		;LITERALS OFF
COBS02:	TRZ	FLG,FR.AST!FR.CNT!FR.PER!FR.CMA	;TURN OFF COMMENT AND SUPPRESS
COBS03:	SOSG	FP.CNT(F)		;CHARACTER IN BUFFER?
	JRST	COBS10			;NO - DO AN INPUT
COBS04:	ILDB	CHR,FP.PNT(F)		;LOAD CHARACTER
	MOVE	T4,NXTCNT(LOW)		;GET COUNT
	XCT	CONTAB(CHR)		;PROCESS CHARACTER
	ADDI	T4,1			;COMPUTE NEXT
COBS05:	EXCH	T4,NXTCNT(LOW)		;STORE NEXT
	TLNE	F,FF.SEQ		;SEQUENCED
	JRST	COBS06			;TEST SEQUENCED
	CAIE	CHR,CH.EOL			;ALWAYS RETURN BREAK
	CAIG	T4,WD.CON		;RETURNABLE CHARACTER
	JRST	COBS12			;YES
	JRST	COBS03			;NO
COBS06:	SUBI	T4,6			;OFFSET
	JUMPL	T4,COBS07		;PAST SEQUENCE FIELD
	CAIE	CHR,CH.EOL			;ALWAYS RETURN BREAK
	CAIG	T4,WD.SEQ		;RETURNABLE
	JRST	COBS12			;RETURN CHARACTER
	JRST	COBS03			;NO
COBS07:	CAIN	CHR,11			;TAB IN SEQUENCE FIELD
	JRST	COBS11			;YES - SET PAST SEQUENCE
	CAIN	CHR,CH.EOL			;BREAK IN SEQUENCE FIELD?
	TTCALL	3,[ASCIZ /%WARNING - SHORT LINE IN SEQUENCED FILE
/]
	JRST	COBS03			;IGNORE CHARACTER GET ANOTHER
;
; COBS08 - COMPUTE TAB STOP
;
COBS08:	ANDCMI	T4,7			;CLEAR JUNK
	ADDI	T4,10			;OFFSET
	JRST	COBS05			;RETURN
;
; COBS09 - HANDLE EOL
;
COBS09:	MOVEI	CHR,CH.EOL			;SET EOL
	MOVEI	T4,0			;SET NEXT IS 0
	JRST	COBS05
;
; COBS10 - INPUT A BUFFER
;
COBS10:	IN	CH.PCK,			;INPUT A BUFFER
	JRST	COBS04			;HAVE BUFFER
	STATO	CH.PCK,740000		;EOF?
	POPJ	P,			;YES - EOF RETURN
	HALT	COBS10			;HARDWARE PROBLEMS
;
; HERE WITH CHARACTER
;
COBS11:	MOVEI	T4,0			;CLEAR CURRENT
COBS12:	TRZE	FLG,FR.PER		;PERIOD SEEN
	JRST	COBS28			;YES
	TRZE	FLG,FR.CMA		;COMMA SEEM
	JRST	COBS32			;YES
COBS13:	CAIE	CHR,CH.EOL			;BREAK?
	TRNE	FLG,FR.AST		;IN COMMENT LINE
	JRST	COBS03			;REMOVE COMMENT
	TRNE	FLG,FR.CNT		;SUPPRESSING CONTINUATION?
	JRST	COBS16			;YES
	JUMPN	T4,COBS17		;FIRST CHARACTER?
;
; PROCESS FIRST CHARACTER
;
COBS14:	CAIE	CHR,"*"			;COMMENT LINE?
	JRST	COBS15			;NO
;
; COMMENT LINE
;
	TRO	FLG,FR.AST		;SET COMMENT LINE
	JRST	COBS03			;SKIP COMMENT LINE
;
; TEST CONTINUATION LINE
;
COBS15:	CAIE	CHR,"-"			;CONTINUATION LINE?
	JRST	COBS17			;NO
;
; CONTINUATION LINE
;
	TRO	FLG,FR.CNT		;SET CONTINUATION LINE
	JRST	COBS03			;GET NEXT
;
; SUPPRESS CONTINUATION
;
COBS16:	CAIE	CHR,11			;BLANK
	CAIN	CHR," "			;BLANK
	JRST	COBS03			;YES - SUPPRESS
	TRNN	FLG,FR.DQT!FR.SQT		;IN LITERAL
	JRST	COBS19			;NO - CONTINUE NON-LITERAL
					;WITH THIS CHARACTER
	MOVEI	T4,042			;WHICH LITERAL
	TRNN	FLG,FR.DQT		;DOUBLE OR SINGLE
	MOVEI	T4,"'"			;MUST BE SINGLE
	CAMN	CHR,T4			;MATCHING LITERAL
	JRST	COBS03			;YES - SKIP AND CONTINUE
	TTCALL	3,[ASCIZ /?LITERAL CONTINUATION EXPECTED
/]
	JRST	RESTRT			;RESTART
;
; TEST FOR BLANK SUPPRESSION
;
COBS17:	CAIE	CHR,11			;TAB
	CAIN	CHR," "			;SPACE
	JRST	COBS18			;YES
	JRST	COBS19			;NO
COBS18:	TRNN	FLG,FR.DQT!FR.SQT		;IN LITERAL
	TRO	FLG,FR.BLK		;NO
	JRST	COBS03			;SUPPRESS BLANK
;
; HERE WITH NON-BLANK CHARACTER
;
COBS19:	CAIN	T1,6*COBSIZ		;AT BOL?
	JRST	COBS21			;YES - SUPPRESS LEADING TAB
COBS20:	TRZN	FLG,FR.BLK		;HAVE WE SEEN A TAB?
	JRST	COBS21			;NO - DON'T OUTPUT ONE
	MOVEM	CHR,SAVCHR		;SAVE CHARACTER
	MOVEI	CHR,0			;SET NON EOL RETURN
	JSP	Q1,CPOPJ1		;RETURN ITEM
	MOVE	CHR,SAVCHR		;RESTORE CHARACTER
COBS21:	TRZ	FLG,FR.BLK		;CLEAR BLANK
	CAIE	CHR,042			;LITERAL DOUBLE QUOTE
	JRST	COBS22			;NO
	TRNN	FLG,FR.SQT		;SINGLE QUOTE ON
	TRC	FLG,FR.DQT		;NO - COMPLEMENT
	JRST	COBS24			;GET ANOTHER
COBS22:	CAIE	CHR,"'"			;SINGLE QUOTE LITERAL
	JRST	COBS23			;NO
	TRNN	FLG,FR.DQT		;DOUBLE QUOTE ON
	TRC	FLG,FR.SQT		;NO - COMPLEMENT
	JRST	COBS24			;OUTPUT QUOTE
COBS23:	TRNE	FLG,FR.DQT!FR.SQT		;IN A LITERAL
	JRST	COBS03			;YES
COBS24:	CAIN	CHR,"."			;PERIOD
	JRST	COBS27			;YES
	CAIN	CHR,","		;COMMA
	JRST	COBS31			;YES
COBS25:	SOJL	T1,COBS26		;ROOM IN ITEM
	MOVEI	T3,-40(CHR)
	IDPB	T3,T2			;STORE
;
; PERIOD TEST
;
COBS26:	CAIE	CHR,","			;WAS CHARACTER A COMMA
	CAIN	CHR,"."			;WAS CHARACTER A PERIOD
	JRST	COBS29			;YES
	JRST	COBS03			;GET NEXT
;
; INTERCEPT COMMA AND PERIOD
;
COBS31:	TROA	FLG,FR.CMA		;SET COMMA SEEN
COBS27:	TRO	FLG,FR.PER		;SET PERIOD SEEN
	JRST	COBS03			;GET NEXT
;
; HERE WHEN LAST WAS A PERIOD
;
COBS28:	CAIL	CHR,"0"			;NUMERIC
	CAILE	CHR,"9"			;NUMERIC
	JRST	COBS30			;NO
	MOVEM	CHR,SAVCHR		;STORE
	MOVEI	CHR,"."			;INSERT PERIOD
	JRST	COBS25			;INSERT
COBS29:	MOVE	CHR,SAVCHR		;RESTORE
	JRST	COBS13			;CONTINUE WITH NUMERIC
COBS30:	MOVEM	CHR,SAVCHR		;STORE CHARACTER
	MOVEI	CHR,1			;SET EOL
	JSP	Q1,CPOPJ1		;SKIP RETURN
	MOVE	CHR,SAVCHR		;RESTORE CHARACTER
	JRST	COBS13			;CONTINUE WITH CHARACTER
;
COBS32:	CAIL	CHR,"0"
	CAILE	CHR,"9"
	JRST	COBS13		;IGNORE COMMA
	MOVEM	CHR,SAVCHR
	MOVEI	CHR,","
	JRST	COBS25
;
; COBS00 - INITIALIZE FOR COBSIX
; SETS UP CONTAB AND ZEROES NXTCNT
;
; CALL:	PUSHJ	P,COBS00
;	(RETURN)
;
COBS00:	MOVEI	Q1,COBS01		;SET INITIAL ENTRY
	SETZM	NXTCNT(LOW)		;CLEAR POSITION COUNTER
	MOVSI	T3,(JFCL)		;NO-OP
	MOVEM	T3,CONTAB+1		;STORE FIRST NO-OP
	MOVE	T4,[XWD CONTAB+1,CONTAB+2]	;SET ALL TO NO-OP
	BLT	T4,CONTAB+174		;175,176,177 SPECIAL
	MOVE	T3,[JRST COBS03]	;INITIALIZE IGNORED CHARACTERS
	MOVEM	T3,CONTAB		;IGNORE NULLS
	MOVEM	T3,CONTAB+15		;IGNORE CR
	MOVEM	T3,CONTAB+177		;IGNORE RUBOUT
	HRRI	T3,COBS08		;INITIALIZE TAB
	MOVEM	T3,CONTAB+11		;INITIALIZE TAB
	HRRI	T3,COBS09		;INITIALIZE BREAKS
	MOVEM	T3,CONTAB+7		;CONTROL G IS A BREAK
	MOVEM	T3,CONTAB+12		;LINEFEED IS A BREAK
	MOVEM	T3,CONTAB+13		;CONTROL K IS A BREAK
	MOVEM	T3,CONTAB+14		;FORMFEED IS A BREAK
	MOVEM	T3,CONTAB+175		;ALTMODE IS BREAK
	MOVEM	T3,CONTAB+176		;ALTMODE IS BREAK
	MOVSI	T3,(POPJ P,)		;SET UP EOF
	MOVEM	T3,CONTAB+3		;CONTROL C IS EOF
	MOVEM	T3,CONTAB+32		;CONTROL Z IS EOF
	MOVE	T3,[SUBI CHR,40]	;SET UP LOWER CASE
	MOVEM	T3,CONTAB+140		;SET UP LC A
	MOVE	T4,[XWD CONTAB+140,CONTAB+141]
	BLT	T4,CONTAB+"Z"+" "	;SET UP LOWER CASE
	POPJ	P,			;DONE
	SUBTTL	CODE TRANSLATION TABLES
	PAGE
;
; DISPATCH ROUTINES FOR VARIOUS CODES
;
	DEFINE	CODDSP<
	CODTAB(PAD)			;PAD CHARACTER
	CODTAB(FLG)			;CODE FLAGS
	CODTAB(SIZ)			;# OF LEGAL CHARACTERS
	CODTAB(PNT)			;BYTE POINTER
	CODTAB(BYT)			;BYTES PER WORD
	CODTAB(IIB)			;ROUTINE TO INITIALIZE INPUT BLOCK
	CODTAB(IIR)			;ROUTINE TO INITIALIZE INPUT RECORD
	CODTAB(OIB)			;ROUTINE TO INITIALIZE OUTPUT BLOCK
	CODTAB(OIR)			;ROUTINE TO INITIALIZE INPUT RECORD
	CODTAB(IFB)			;ROUTINE TO FINISH INPUT BLOCK
	CODTAB(IFR)			;ROUTINE TO FINISH INPUT RECORD
	CODTAB(OFB)			;ROUTINE TO FINISH OUTPUT BLOCK
	CODTAB(OFR)			;ROUTINE TO FINISH OUTPUT RECORD
	>
;
; TABLE OF WHERE TO FIND TABLES
;
FNDTAB:	%ASCII				;DEFAULT CODE
	%ASCII				;FOR ASCII
	%SIXBI				;FOR SIXBIT
	%FEBCD				;FOR FIXED EBCDIC
	%VEBCD				;FOR VARIABLE EBCDIC
;
; DEFINE DISPATCH VIA MACRO
;
	DEFINE SPCDSP(A)<
	IF1, <JRST 0(ADR)>
	IF2, <
	IFE A,<JRST 0(ADR)		;NO-OP>
	IFN A,<JRST A			;SPECIAL PROCESSING>
	>>
;
; ASCII
;
%ASCII:	40				;PAD CHARACTER
	FF.EOL!FF.ZER!FF.TAB		;FLAG
	XWD	-^D128,0		;LENGTH
	0700				;BYTE POINTER
	5				;BYTES PER WORD
	SPCDSP(0)			;INITIALIZE INPUT BLOCK
	SPCDSP(0)			;INITIALIZE INPUT RECORD
	SPCDSP(0)			;INITIALIZE OUTPUT BLOCK
	SPCDSP(0)			;INITIALIZE OUTPUT RECORD
	SPCDSP(0)			;FINISH INPUT BLOCK
	SPCDSP(AIFREC)			;FINISH INPUT RECORD
	SPCDSP(0)			;FINISH OUTPUT BLOCK
	SPCDSP(AOFREC)			;FINISH OUTPUT RECORD
;
; SIXBIT
;
%SIXBI:	0				;PAD CHARACTER
	FF.SYN!FF.RCC			;FLAG
	XWD	-^D64,0			;LENGTH
	0600				;BYTE POINTER
	6				;BYTES PER WORD
	SPCDSP(0)			;INITIALIZE INPUT BLOCK
	SPCDSP(SIIREC)			;INITIALIZE INPUT RECORD
	SPCDSP(0)			;INITIALIZE OUTPUT BLOCK
	SPCDSP(SOIREC)			;INITIALIZE OUTPUT RECORD
	SPCDSP(0)			;FINISH INPUT BLOCK
	SPCDSP(SIFREC)			;FINISH INPUT RECORD
	SPCDSP(0)			;FINISH OUTPUT BLOCK
	SPCDSP(SOFREC)			;FINISH OUTPUT RECORD
;
; FIXED EBCDIC
;
	HEX(C0)
%FEBCD:	XXX				;PAD CHARACTER
	FF.TAB				;FLAGS
	XWD	-^D256,0		;LENGTH
	1000				;BYTE POINTER
	4				;BYTES PER WORD
	SPCDSP(0)			;INITIALIZE INPUT BLOCK
	SPCDSP(0)			;INITIALIZE OUTPUT BLOCK
	SPCDSP(0)			;INITIALIZE INPUT RECORD
	SPCDSP(0)			;INITIALIZE OUTPUT RECORD
	SPCDSP(0)			;FINISH INPUT BLOCK
	SPCDSP(0)			;FINISH INPUT RECORD
	SPCDSP(0)			;FINISH OUTPUT BLOCK
	SPCDSP(0)			;FINISH OUTPUT RECORD
;
; VARIABLE EBCDIC
;
	HEX(C0)
%VEBCD:	XXX				;PAD CHARACTER
	FF.BLC!FF.RCC!FF.ZER!FF.TAB	;FLAGS
	XWD	-^D256,0		;LENGTH
	1000				;BYTE POINTER
	4				;BYTES PER WORD
	SPCDSP(VIIBLK)			;INITIALIZE INPUT BLOCK
	SPCDSP(VIIREC)			;INITIALIZE INPUT RECORD
	SPCDSP(VOIBLK)			;INITIALIZE OUTPUT BLOCK
	SPCDSP(VOIREC)			;INITIALIZE OUTPUT RECORD
	SPCDSP(0)			;FINISH INPUT BLOCK
	SPCDSP(0)			;FINISH INPUT RECORD
	SPCDSP(0)			;FINISH OUTPUT BLOCK
	SPCDSP(0)			;FINISH OUTPUT RECORD
;
; DEFAULT ROUTINES FOR BUFFER AND RECORD COUNT INITIALIZATION
; AND TERMINATION
;
; .IIBLK - INITIALIZE A BLOCK
; CALL:	JSP	ADR,.IIBLK
;	(RETURN)
;
.IIBLK:	MOVE	T1,F.BLSZ(IN)		;GET RECORDS PER BLOCK
	MOVEM	T1,F.RECC(IN)		;STORE IN COUNTER
	HLRZ	T1,F.CBUF(IN)		;GET BUFFERS PER BLOCK
	MOVEM	T1,F.BUFC(IN)		;STORE IN COUNTER
	XCT	FC.IIB(IN)		;SPECIAL ROUTINE?
;
; .OIBLK - INITIALIZE AN OUTPUT BLOCK
; CALL:	JSP	ADR,.OIBLK
;	(RETURN)
;
.OIBLK:	MOVE	T1,F.BLSZ(AUT)		;GET BLOCK SIZE
	MOVEM	T1,F.RECC(AUT)		;STORE IN COUNTER
	HLRZ	T1,F.CBUF(AUT)		;GET BUFFERS PER BLOCK
	MOVEM	T1,F.BUFC(AUT)		;STORE IN COUNTER
	XCT	FC.OIB(AUT)		;SPECIAL ROUTINE?
;
; .IIREC - INITIALIZE INPUT RECORD
; CALL:	JSP	ADR,.IIREC
;	(BLOCK EXPIRED)
;	(RETURN)
;
.IIREC:	SKIPE	F.BLSZ(IN)		;BLOCK 0
	SOSL	F.RECC(IN)		;NO - RECORD IN THIS BLOCK
	AOSA	ADR			;SKIP RETURN
	JRST	0(ADR)			;BLOCK EXPIRED
	XCT	FC.IIR(IN)		;SPECIAL INITIALIZATION
;
; .OIREC - INITIALIZE AN OUTPUT RECORD
; CALL:	JSP	ADR,.OIREC
;	(BLOCK EXPIRED)
;	(RETURN)
;
.OIREC:	SKIPE	F.BLSZ(AUT)		;BLOCK 0
	SOSL	F.RECC(AUT)		;NO - RECORD IN THIS BLOCK
	AOSA	ADR			;SKIP RETURN
	JRST	0(ADR)			;BLOCK EXPIRED
	XCT	FC.OIR(AUT)		;SPECIAL INITIALIZATION
;
; .IFBLK - FINISH AN INPUT BLOCK
; CALL:	JSP	ADR,.IFBLK
;	(RETURN)
;
.IFBLK:	TLNE	IN,FF.SPN		;SPANNING
	JRST	.IFBL2			;YES - JUST RETURN
.IFBL1:	JSP	Q1,IN.BUF		;GRAB A BUFFER
	SKIPLE	F.BUFC(IN)		;COUNT EXPIRED
	JRST	.IFBL1			;NO
	AOS	F.CNT(IN)		;YES - FIX BYTE COUNT
.IFBL2:	XCT	FC.IFB(AUT)		;SPECIAL INITIALIZATION
;
; .OFBLK - FINISH AN OUTPUT BLOCK
; CALL:	JSP	ADR,.OFBLK
;	(RETURN)
;
.OFBLK:	TLNE	AUT,FF.SPN		;SPANNING?
	JRST	.OFBL2			;YES - JUST RETURN
.OFBL1:	JSP	Q1,OU.BUF		;OUTPUT A BUFFER
	SKIPLE	F.BUFC(AUT)		;ANY LEFT
	JRST	.OFBL1			;YES
	AOS	F.CNT(AUT)		;FIX BYTE COUNT
.OFBL2:	XCT	FC.OFB(AUT)		;SPECIAL INITIALIZATION
;
; AOFREC - FINISH ASCII OUTPUT RECORD
; CALL:	JSP	ADR,AOFREC		OUTPUT CR/LF
;	(RETURN)
;
AOFREC:	MOVEI	CHR,15			;FINISH RECORD WITH CRLF
	SOSG	F.CNT(AUT)		;ROOM IN BUFFER
	JSP	Q1,OU.BUF		;GET BUFFER
	IDPB	CHR,F.PNT(AUT)		;OUTPUT CHARACTER
	MOVEI	CHR,12			;INSERT LF
	SOSG	F.CNT(AUT)		;ROOM IN BUFFER
	JSP	Q1,OU.BUF		;OUTPUT BUFFER
	IDPB	CHR,F.PNT(AUT)		;OUTPUT LF
	JRST	0(ADR)			;RETURN
;
; AIFREC - FINISH ASCII INPUT RECORD
; SPACES TO CR
; GRABS NEXT CHARACTER
;
AIFREC:	LDB	CHR,F.PNT(IN)		;GET CHARACTER
AIFRE1:	CAIN	CHR,15		;CR
	JRST	AIFRE2
	SOSG	F.CNT(IN)
	JSP	Q1,IN.BUF
	ILDB	CHR,F.PNT(IN)
	JRST	AIFRE1
AIFRE2:	SOSG	F.CNT(IN)
	JSP	Q1,IN.BUF
	IBP	F.PNT(IN)
	JRST	0(ADR)
;
; SIIREC - INITIALIZE SIXBIT INPUT RECORD
; CALL:	JSP	ADR,SIIREC		STORE RECORD COUNT
;	(RETURN)
;
SIIREC:	INBYTE			;IGNORE 4 BYTES
	INBYTE	
	INBYTE	
	INBYTE	
	INBYTE			;GET FIRST 6 DIGITS
	MOVE	T1,CHR
	INBYTE			;GET LAST SIX DIGITS
	LSH	T1,6
	ADD	T1,CHR
	JUMPE	T1,SIIREC		;IGNORE EMPTY CONTROL WORDS
	MOVEM	T1,F.CREC(IN)		;STORE
	JRST	0(ADR)			;RETURN
;
; SOIREC - INITIALIZE SIXBIT OUTPUT RECORD
; CALL:	JSP	ADR,SOIREC	SYNCHRONIZE WORDS
;	(RETURN)
;
SOIREC:	MOVEI	CHR,0			;OUTPUT COUNT
	OUTBYT			;4 NULL BYTES
	OUTBYT	
	OUTBYT	
	OUTBYT	
	MOVE	CHR,P2
	ROT	CHR,-6
	OUTBYT	
	ROT	CHR,6
	OUTBYT	
	JRST	0(ADR)			;RETURN
;
; SIFREC - FINISH SIXBIT INPUT RECORD
; CALL:	JSP	ADR,SIFREC	SYNCHRONIZE
;	(RETURN)
;
SIFREC:	MOVE	T1,F.PNT(IN)		;GET BYTE COUNTER
	TLNN	T1,770000		;EMPTY
	JRST	0(ADR)			;YES
	INBYTE			;GET A BYTE
	JRST	SIFREC			;GO FOR EOW
;
; SOFREC - FINISH SIXBIT OUTPUT RECORD
; CALL:	JSP	ADR,SOFREC	SYNCHRONIZE
;	(RETURN)
;
SOFREC:	MOVE	CHR,FC.PAD(AUT)		;GET PAD CHARACTER
SOFRE1:	MOVE	T1,F.PNT(AUT)		;TEST POINTER
	TLNN	T1,770000		;EOW
	JRST	0(ADR)			;YES
	OUTBYT			;NO - OUTPUT A BYTE
	JRST	SOFRE1			;CONTINUE UNTIL EOW
;
; VIIBLK - INITIALIZE VARIABLE INPUT RECORD
; CALL:	JSP	ADR,VIIBLK	STORE BLOCK COUNT
;	(RETURN)
;
VIIBLK:	INBYTE			;GET A BYTE
	MOVE	T1,CHR			;STORE BYTE
	INBYTE			;GET ANOTHER
	LSH	T1,^D8			;SHIFT FIRST BYTE
	ADD	T1,CHR			;COMPUTE BLOCK SIZE
	INBYTE			;GET ANOTHER
	INBYTE			;GET ANOTHER
	JUMPE	T1,VIIBLK		;IGNORE ZERO BLOCK WORDS
	SUBI	T1,4			;COMPUTE BLOCK SIZE
	MOVNM	T1,F.EBC(IN)		;STORE IN EBC COUNTER
	MOVEM	T1,F.CBLK(IN)		;STORE BLOCK SIZE
	JRST	0(ADR)			;RETURN
;
; VIIREC - INITIALIZE VARAIBLE INPUT RECORD
; CALL:	JSP	ADR,VIIREC	STORE RECORD COUNT
;	(RETURN)
;
VIIREC:	SKIPL	F.EBC(IN)		;BLOCK EXPIRED
	JRST	-1(ADR)			;GIVE EXPIRED RETURN
	INBYTE			;GET A BYTE
	MOVE	T1,CHR			;STORE BYTE
	INBYTE			;GET ANOTHER
	LSH	T1,^D8			;SHIFT FIRST BYTE
	ADD	T1,CHR			;COMPUTE RECORD SIZE
	INBYTE			;GET ANOTHER
	INBYTE			;GET ANOTHER
	ADDM	T1,F.EBC(IN)		;COUNT RECORD
	SUBI	T1,4			;REDUCE BY RECORD COUNT
	MOVEM	T1,F.CREC(IN)		;STORE RECORD SIZE
	JRST	0(ADR)			;RETURN
;
; VOIBLK - INITIALIZE OUTPUT BLOCK
; VOIREC - INITIALIZE OUTPUT RECORD
; CALL:	JSP	ADR,VOI???	INITIALIZE OUTPUT BLOCK OR COUNT
;	(RETURN)
;
VOIBLK:	MOVE	CHR,F.EBC(AUT)		;GET BLOCK SIZE
	TLNE	FLG,FL.RWR		;REWRITING
	ADD	CHR,FC.BYT(AUT)
	JRST	VOIR01			;STORE COUNT
VOIREC:	MOVE	CHR,P2			;GET BLOCK OR RECORD SIZE
	TLNE	FLG,FL.RWR		;REWRITING
	ADD	CHR,FC.BYT(AUT)		;INCREASE BY COUNT SIZE
	ADDM	CHR,F.EBC(AUT)		;ADD TO SCORE
VOIR01:	ROT	CHR,-^D8		;GET FIRST BYTE
	OUTBYT			;OUTPUT BYTE
	ROT	CHR,^D8			;GET LAST BYTE
	OUTBYT			;STORE LAST BYTE
	MOVE	CHR,FC.PAD(AUT)		;GET PAD
	OUTBYT			;PAD TWO BYTES
	OUTBYT			;PAD TWO BYTES
	JRST	0(ADR)			;RETURN
	PAGE
	SUBTTL	INITIALIZE FILES
;
; INITFL - INITIALIZES FILE
; CALL:	MOVEI	F,FILTAB	ADDRESS OF FILETABLE
;	PUSHJ	P,INITFL	INITIALIZE
;	(RETURN)
;
INITFL:	MOVEI	T1,0			;SET MODE 0
	HRRZ	T2,F.CODE(F)		;GET CODE
	CAIN	T2,%ASCII		;ASCII CODE?
	JRST	INITF1			;YES - USE MODE 0
	MOVEI	T1,14			;SET BINARY
	TLNN	F,FF.OUT		;OUTPUT FILE?
	JRST	INITF1			;NO - USE MODE 14
	TLNE	FLG,FL.SPC		;SPECIAL SIXBIT/EBCDIC
	MOVEI	T1,17			;YES
INITF1:	MOVEM	T1,F.MOD(F)		;STORE MODE
	MOVEI	T1,F.ADR(F)		;ASSUME INPUT
	TLNE	F,FF.OUT		;OUTPUT FILE
	MOVSI	T1,F.ADR(F)		;MAKE OUTPUT
	MOVEM	T1,F.BUF(F)		;STORE BUFFER WORD
	TLNE	F,FF.OUT		;OUTPUT FILE
	SKIPA	T2,[OPEN CH.OUT,F.MOD(F)]
	MOVE	T2,[OPEN CH.IN,F.MOD(F)]
	XCT	T2
	JRST	[TTCALL 3,[ASCIZ /?CAN'T OPEN DEVICE
/]
		 JRST RESTRT]
	TLNE	F,FF.OUT		;OUTPUT FILE
	SKIPA	T2,[ENTER CH.OUT,F.NAM(F)]
	MOVE	T2,[LOOKUP CH.IN,F.NAM(F)]
	XCT	T2
	JRST	[TTCALL	3,[ASCIZ /?CAN'T LOOKUP OR ENTER FILE
/]
		 JRST RESTRT]
	PUSHJ	P,CMPBUF		;COMPUTE BUFFERS
	PUSHJ	P,SETBUF		;CREATE BUFFERS
;
; PERFORM TAPE OPERATIONS
;
	TLNN	F,FF.TAP		;IS DEVICE A MAGTAPE ?
	POPJ	P,			;NO - RETURN
	MOVSI	T2,(MTAPE CH.IN,)	;SET FOR INPUT CHANNEL
	TLNE	F,FF.OUT		;OUTPUT FILE
	MOVSI	T2,(MTAPE CH.OUT,)	;SET FOR OUTPUT CHANNEL
	TLNN	F,FF.IND		;INDUSTRY MODE
	JRST	INITF2			;NO
	HRRI	T2,101			;MAKE MTAPE 101
	XCT	T2			;SET INDUSTRY COMPATIBLE
INITF2:	TLNN	F,FF.REW		;REWIND
	JRST	INITF3			;NO
	HRRI	T2,1			;MAKE MTAPE 1
	XCT	T2			;REWIND
	PUSHJ	P,TPSYCH		;WAIT
INITF3:	SKIPN	T1,F.PSTN(F)		;ADVANCE OR BACKSPACE ?
	POPJ	P,			;NO - DONE INITIALIZING
	JUMPL	T1,INITF7		;BACKSPACE
INITF5:	HRRI	T2,16			;MAKE MTAPE 16
	XCT	T2			;ADVANCE ONE FILE
	PUSHJ	P,TPSYCH		;WAIT
	SOJG	T1,INITF5		;DO ENOUGH
	POPJ	P,			;DONE - RETURN
INITF7:	HRRI	T2,17			;MAKE MTAPE 17
	XCT	T2			;BACKSPACE A FILE
	PUSHJ	P,TPSYCH		;WAIT
	AOJL	T1,INITF7
	MOVE	T3,[STATZ CH.IN,4000]	;AT BOT?
	TLNE	F,FF.OUT		;OUTPUT FILE ?
	MOVE	T3,[STATZ CH.OUT,4000]	;AT BOT?
	XCT	T3			;AT BOT?
	POPJ	P,			;YES - RETURN
	HRRI	T2,16			;NO - ADVANCE PAST EOF
	XCT	T2			;ADVANCE FILE
TPSYCH:	ANDCMI	T2,-1			;MAKE MTAPE 0
	XCT	T2			;WAIT
	POPJ	P,			;RETURN
;
; CMPBUF - COMPUTE BUFFER NUMBER AND SIZE
;
; ALGORITHM:
; ---------
;
; IF DEVICE IS MTA CREATE TWO LONG BUFFERS LARGE ENOUGH
;		   TO HOLD A LOGICAL BLOCK
;
; IF DEVICE IS NOT MTA CREATE A BUFFER RING OF N + 1
;		       BUFFERS WHERE N BUFFERS WILL HOLD
;		       A LOGICAL BLOCK
;
; BLOCK IS SIZED IS DETERMINED
;
; A) FROM BUFFERSIZE IF PROVIDED
; B) FROM RECORDSIZE AND BLOCKSIZE IF BUFFERSIZE NOT PROVIDED
; C) FROM DEVSIZ UUO IF NEITHER RECORD NOR BUFFER SIZE PROVIDED
;
CMPBUF:	MOVE	T1,F.RCSZ(F)		;COPY RECORD SIZE
	MOVEM	T1,F.CREC(F)		;TO COMPUTED
	MOVE	T1,F.BLSZ(F)		;COPY BLOCKSIZE 
	MOVEM	T1,F.CBLK(F)		;TO COMPUTED
	SKIPN	T1,F.RCSZ(F)		;RECORD SIZE PROVIDIED
	JRST	CMPBU1			;NO - DON'T COMPUTE F.CBUF
	TLNE	F,FF.BLC		;BLOCK COUNT
	ADD	T1,FC.BYT(F)		;YES - ADD BLOCK COUNT BYTES
	TLNN	F,FF.SYN		;SYNCHRONIZE
	JRST	CMPBU3			;NO
	SUBI	T1,1			;YES
	IDIV	T1,FC.BYT(F)
	CAIE	T2,0
	ADDI	T1,1
	IMUL	T1,FC.BYT(F)
	ADD	T1,FC.BYT(F)
CMPBU3:	TLNE	F,FF.EOL		;EOL CHARACTER?
	ADDI	T1,2			;INCLUDE EOL CHARACTER
	SKIPE	T2,F.BLSZ(F)		;ZERO BLOCKSIZE?
	IMUL	T1,T2			;NO - MULTIPLY BY BLOCKSIZE
	TLNE	F,FF.BLC		;BLOCK COUNT
	ADD	T1,FC.BYT(F)		;ADD BLOCK COUNT
	MOVEM	T1,F.EBC(F)		;STORE AS EBC BLOCK SIZE
	SUBI	T1,1			;COMPUTE # OF WORDS
	IDIV	T1,FC.BYT(F)		;DIVIDE BY BYTES / WORD
	CAIE	T2,0			;EXTRA
	ADDI	T1,1			;YES
	HRRM	T1,F.CBUF(F)		;STORE RECORD SIZE IN BUFFERS
	HRRZ	T2,F.SIZ(F)		;GET DEFAULT SIZE
	SUBI	T1,1
	IDIVI	T1,-3(T2)
	CAIE	T2,0
	ADDI	T1,1
	TLNE	F,FF.TAP
	MOVEI	T1,1
	HRLM	T1,F.CBUF(F)
CMPBU1:	SKIPN	T1,F.BFSZ(F)		;BUFFER SIZE PROVIDIED
	HRRZ	T1,F.CBUF(F)		;BUFFER SIZE COMPUTED
	PJUMPE	T1,CPOPJ		;NO - USE DEVSIZ DEFAULT
	TLNN	F,FF.TAP		;MAGTAPE
	JRST	CMPBU5			;NO
	ADDI	T1,3			;ADD 3 FOR HEADER
	HRRM	T1,F.SIZ(F)		;STORE IN F.SIZ
	POPJ	P, 			;DONE
CMPBU5:	SUBI	T1,1			;COMPUTE NUMBER OF BUFFERS
	HRRZ	T2,F.SIZ(F)		;GET DEFAULT
	IDIVI	T1,-3(T2)		;GET NUMBER OF BUFFERS
	CAIE	T2,0			;EXTRA
	ADDI	T1,1			;YES
	ADDI	T1,1			;ADD ONE FOR LUCK
	HRLM	T1,F.SIZ(F)		;STORE BUFFERS IN RING
	POPJ	P, 			;RETURN
;
; SETBUF - CREATE BUFFERS
; WORKS OFF F.SIZ
;
SETBUF:	HRRZ	T1,F.SIZ(F)		;GET BUFFER SIZE
	MOVE	T2,T1			;SAME IN T2
	HLRZ	T3,F.SIZ(F)		;GET NUMBER IN T3
	IMUL	T2,T3			;COMPUTE NEEDED CORE
	MOVE	T4,.JBFF		;STORE CURRENT .JBFF
	ADDB	T2,.JBFF		;COMPUTE NEW CORE
	CAMG	T2,.JBREL		;DO A CORE UUO
	JRST	SETBU1			;NO
	CORE	T2,			;YES - DO A CORE UUO
	JRST	[TTCALL 3,[ASCIZ /?CAN'T OBTAIN CORE
/]
		 JRST RESTRT]
SETBU1:	MOVSI	T2,-2(T1)		;GET SIZE + 1 IN T1
	ADDI	T4,1			;SET FIRST LOCATION
	HRR	T2,T4			;MOVE START TO T2
SETBU2:	MOVEM	T2,0(T2)		;SET TO POINT TO SELF
	ADDM	T1,0(T2)		;SET TO POINT TO NEXT
	ADD	T2,T1			;INCREMENT
	SOJG	T3,SETBU2		;CONTINUE FOR ALL BUFFERS
	SUB	T2,T1			;CORRECT LAST BUFFER
	HRRM	T4,0(T2)		;CORRECT LAST BUFFER
	HRLI	T4,400000		;SET BUFFER VIRGIN
	MOVS	T3,FC.PNT(F)		;GET BYTE POINTER
	MOVEM	T3,F.PNT(F)		;SET BYTE POINTER
	MOVEM	T4,F.ADR(F)		;SET BUFFER VIRGIN
	POPJ	P,			;RETURN
	PAGE
	SUBTTL	GENERATE CODE TABLE
;
; CODGEN - GENERATES CODE TABLE
;
CODGEN:	HRRZ	T1,F.CODE(IN)		;GET INPUT CODE
	HRRZ	T2,F.CODE(AUT)		;GET OUTPUT CODE
	CAMN	T1,T2			;SAME CODE
	JRST	CODGE1			;YES
	CAIE	T1,%FEBCD		;INPUT FIXED OR
	CAIN	T1,%VEBCD		;VARIABLE EBCDIC
	JRST	CODGE4			;YES
	CAIE	T2,%FEBCD		;OUTPUT FIXED OR
	CAIN	T2,%VEBCD		;VARIABLE EBCDIC
	JRST	CODGE7			;YES
;
; ASCII TO SIXBIT OR VICA VERSA
;
	MOVE	T1,FC.SIZ(IN)		;GET TABLE LENGTH
CODGE9:	HRRZ	T4,T1			;GET CHARACTER
	CAIN	T2,%SIXBI		;SIXBIT OUTPUT
	JSP	Q1,CODGE6		;CONVERT TO SIXBIT
	CAIE	T2,%SIXBI		;SIXBIT OUTPUT
	ADDI	T4," "			;CONVERT TO ASCII
	MOVEM	T4,CODTAB(T1)		;STORE CONVERSION
	AOBJN	T1,CODGE9		;DO ALL CHARACTERS
	POPJ	P,			;RETURN
;
; EBCDIC OUTPUT
;
CODGE7:	HRL	T3,FC.PNT(AUT)		;SET UP POINTER
	HRRI	T3,AS%%EB-1		;ASCII INPUT
	CAIE	T1,%ASCII		;TEST
	HRRI	T3,SI%%EB-1		;NO SIXBIT INPUT
	MOVE	T1,FC.SIZ(IN)		;GET TABLE LENGTH
CODGE8:	ILDB	T4,T3			;GET CONVERSION
	MOVEM	T4,CODTAB(T1)		;STORE CONVERSION
	AOBJN	T1,CODGE8		;CONTINUE FOR ALL CHARACTERS
	POPJ	P,			;RETURN
;
; EBCDIC INPUT
;
CODGE4:	MOVE	T1,FC.SIZ(IN)		;GET CODE LENGTH
	MOVE	T3,[POINT 7,EB%%AS ]	;GET TABLE POINTER
CODGE5:	ILDB	T4,T3			;GET CODE
	CAIN	T4,134			;FILL
	ORCMI	T4,-1			;SET BAD CHARACTER
	CAIE	T2,%ASCII		;ASCII OUTPUT
	JSP	Q1,CODGE6		;NO - CONVERT TO SIXBIT
	MOVEM	T4,CODTAB(T1)		;STORE CODE
	AOBJN	T1,CODGE5		;DO ALL 256 CHARACTERS
	POPJ	P,			;RETURN
;
; SAME CODE
;
CODGE1:	MOVE	T1,FC.SIZ(IN)		;GET TABLE LENGTH
CODGE3:	HRRM	T1,CODTAB(T1)		;STORE CODE
	AOBJN	T1,CODGE3		;DO ALL CHARACTERS
	POPJ	P, 			;RETURN
;
; CODGE6 - CONVERT ASCII TO SIXBIT
;
CODGE6:	CAIL	T4," "			;IN RANGE
	CAILE	T4," "+77		;IN RANGE
	SKIPA	T4,[XWD -1,74]		;SUPPLY BAD RESULT
	SUBI	T4," "			;CONVERT
	JRST	0(Q1)			;RETURN
	PAGE
	SUBTTL	LOW CORE ALLOCATION
	RELOC
PATCH:	BLOCK	PATSIZ			;PATCH AREA
FIRST:
PLIST:	BLOCK	PSIZE			;PUSHDOWN AREA
;
; DEFINE A PROTOTYPE FILE TABLE
;
	DEFINE FILTAB(A,N)<
	A==ZZ
	ZZ==ZZ+N>
	ZZ==0
;
DEFINE FILBLK<
FILDAT(STA)			;LH STATUS (SEE FLAGS BELOW)
				;RH FILBLK OFFSET
				;OPEN BLOCK
FILDAT(MOD)			;MODE
FILDAT(DEV)			;DEVICE
FILDAT(BUF)			;BUFFER WORD
				;LOOKUP/ENTER BLOCK
FILDAT(NAM)			;FILENAME
FILDAT(EXT)			;EXTENSION
FILDAT(PRT)			;PROTECTION
FILDAT(PPN)			;PPN
FILDAT(TYP)			;DEVCHR WORD
FILDAT(SIZ)			;DEVSIZ WORD
				;BUFFER RING HEADER
FILDAT(ADR)			;CURRENT BUFFER ADDRESS
FILDAT(PNT)			;CURRENT BUFFER POINTER
FILDAT(CNT)			;CURRENT BUFFER COUNT
>
DEFINE FILDAT(A)<
FILTAB(F.'A,1)
>
;
; INCLUDE BASIC FILE BLOCK
;
FILBLK
;
FILTAB(F.PSTN,1)			;FILES TO ADVANCE OR BACKSPACE
;
; PACKED FILE SUB BLOCK
;
DEFINE FILDAT(A)<
FILTAB(FP.'A,1)
>
;
FILBLK
;
FILTAB(FP.ITM,1)			;LINK TO ITEM BLOCKS
FILTAB(FP.NMB,1)			;LINK TO NAME BLOCKS
;
FILTAB(FP.CUR,1)			;CURRENT ITEM
FILTAB(FP.PCT,1)			;CURRENT PICTURE
FILTAB(FP.PSZ,1)		;PICTURE SIZE
FILTAB(FP.TMP,1)			;BYTE IN CORE
;
; END OF PACKED SUB BLOCK
;
FILTAB(F.RCSZ,1)			;RECORD SIZE PARAMETER
FILTAB(F.BLSZ,1)			;BLOCKSIZE PARAMETER
FILTAB(F.BFSZ,1)			;BUFFERSIZE PARAMETER
FILTAB(F.CREC,1)
FILTAB(F.CBLK,1)
FILTAB(F.CBUF,1)			;COMPUTED RECORD LENGTH IN BUFFERS
FILTAB(F.BUFC,1)			;COUNTS BUFFERS USED IN RECORD
FILTAB(F.RECC,1)			;COUNTS RECORDS USED IN BLOCK
FILTAB(F.BUFN,1)			;COUNTS BUFFERS INPUT OR OUTPUT
FILTAB(F.EBC,1)				;HOLDS EBCDIC BLOCK SIZE
FILTAB(F.CODE,1)			;HOLDS CODE TYPE
	DEFINE	CODTAB(A)<
	ZZZ==ZZZ+1
	FILTAB(FC.'A,1)>
	ZZZ==0
	CODDSP
	CODDSP==ZZZ
FILTAB==ZZ				;LENGTH OF TABLE
;
; F.STA  -  FILE FLAGS
; BITS DEFINED VIA FF.BIT MACRO
;
DEFINE FF.BIT(A)<
FF.'A==ZZ
ZZ==<ZZ/2>
>
ZZ==400000
;
FF.BIT(VAR)			;VARIABLE MODE
FF.BIT(SEQ)			;PACKED FILE IN SEQUENCED FORMAT
FF.BIT(TAP)			;FILE IS A MAGTAPE
FF.BIT(LIN)			;DEVICE IS LINE-BLOCKED
FF.BIT(IND)			;DEVICE IN INDUSTRY COMPATIBLE MODE
FF.BIT(UNL)			;UNLOAD DEVICE WHEN DONE
FF.BIT(REW)			;REWIND DEVICE BEFORE PROCESSING
FF.BIT(SPN)			;LOGICAL BLOCKS SPAN PHYSICAL RECORDS
FF.BIT(OUT)			;FILE IS OUTPUT FILE
FF.BIT(BLC)			;CODE HAS A BLOCK COUNT
FF.BIT(RCC)			;CODE HAS A RECORD COUNT
FF.BIT(SYN)			;CODE IS SYNCHRONIZED
FF.BIT(TAB)			;CODE HAS TABS
FF.BIT(EOL)			;CODE HAS EOL CHARACTER
FF.BIT(ZER)			;CODE "ALLOWS" ZERO LENGTH RECORDS
FF.BIT(NLS)			;DON'T LIST PACKED FD'S.
;
; DEFINE TABLES FOR THE INPUT AND OUTPUT FILES
;
INFILE:	BLOCK	FILTAB			;INPUT FILE BLOCK
OUTFIL:	BLOCK	FILTAB			;OUTPUT FILE BLOCK
;
; DEFINE A BUFFER FOR THE HELP TEXT AND CHARACTER CONVERSION
; TABLE
;
HLPBUF:					;BLOCK FOR HELP I/O
CONTAB:	BLOCK	^D256			;LARGE ENOUGH FOR EBCDIC
;
; DEFINE CODE CONVERSION TABLE
;
CODTAB:	BLOCK	^D256			;LARGE ENOUGH FOR EBCDIC
;
; DEFINE COMMAND SCANNER DATA BASE
;
MASK1:	BLOCK	1			;FIRST TWO WORD MASK
MASK2:	BLOCK	1			;SECOND TWO WORD MASK
SAVCHR:	BLOCK	1			;SAVE CHARACTER
SCNPNT:	BLOCK	1			;SIXBIT POINTER
SCNCNT:	BLOCK	1			;SIXBIT BYTE COUNTER
SCNDAT:	BLOCK	SCNSIZ			;LARGEST SIXBIT ITEM
SWHDAT:	BLOCK	SWHSIZ			;LARGEST SWITCH
;
; DEFINE NEEDED DATA AREAS
;
PCKFD:	BLOCK	FDSIZE			;BLOCK FOR FD NAME
COBDAT:	BLOCK	COBSIZ			;BLOCK FOR COBOL ITEM
ZERO:	BLOCK	1			;ZERO WORD AFTER COBDAT
NXTCNT:	BLOCK	1			;COUNTER
NRECS:	BLOCK	1			;COUNTS RECORDS CONVERTED
NCHRS:	BLOCK	1			;COUNTS CHARACTERS CONVERTED
BCHRS:	BLOCK	1			;COUNTS BAD CHARACTERS
NREC:	BLOCK	3			;NUMBER OF RECORDS IN ASCIZ
NCHR:	BLOCK	3			;NUMBER OF CHARACTERS IN ASCIZ
NBCHR:	BLOCK	3			;NUMBER OGF BAD CHARACTERS
;
; DEFINE DATA AREA FOR DUMP
;
D.LIN1:	BLOCK	LINSIZ			;HOLDS ORIGINAL LINE
D.LIN2:	BLOCK	LINSIZ			;HOLDS TRANSLATED LINE
D.LIN3:	BLOCK	LINSIZ			;HOLDS PACKED CONVERSION
D.PTR1:	BLOCK	1			;POINTER TO D.LIN1
D.PTR2:	BLOCK	1			;POINTER TO D.LIN2
D.PTR3:	BLOCK	1			;POINTER TO D.LIN3
;
; DATA AREA FOR SPECIAL BUFFERS
;
EXOUT:	BLOCK	1			;WORD EXECUTED AT OU.BUF
TMPADR:	BLOCK	1			;USED FOR MULTIPLE JSP ADR,
ACTADR:	BLOCK	1
ACTPTR:	BLOCK	1
ACTCNT:	BLOCK	1
RECADR:	BLOCK	1
RECPTR:	BLOCK	1
RECCNT:	BLOCK	1
BLKADR:	BLOCK	1
BLKPTR:	BLOCK	1
BLKCNT:	BLOCK	1
;
;
; DATA FOR OUTPUT TRAP
;
TOIBLK:	BLOCK	1			;NORMAL BLOCK INITIALIZATION
TOIREC:	BLOCK	1			;NORMAL RECORD INITIALIZATION
TOFBLK:	BLOCK	1			;NORMAL BLOCK FINISH
TOFREC:	BLOCK	1			;NORMAL RECORD FINISH
;
LAST:
	RELOC
	PAGE
	SUBTTL	INTEGER DIVISION AND PUSHDOWN ROUTINES
;
; T1DT23	- COMPUTE  F((T1)/(T2-3))
; T1DT2		- COMPUTE F((T1)/(T2))
;
; WHERE F = INT(A/B) + 1 IF REM NOT = 0
;	  = INT(A/B) IF REM = 0
;	    WHERE INT IS INTEGER DIVISION RESULT
;	    REM IS INTEGER DIVISION REMAINDER
;
; CALL:	MOVE	T1,#
;	MOVE	T2,#
;	PUSHJ	P,ROUTINE
;	(RETURN)
;
T1DT23:	SUBI	T2,3			;REDUCE T2 BY 3
T1DT2:	IDIV	T1,T2			;DIVIDE
	JUMPE	T2,CPOPJ		;NO REMAINDER
	ADDI	T1,1			;REMAINDER
	POPJ	P,			;RETURN
;
TPOPJ1:	POP	P,T1			;RESTORE T1
CPOPJ1:	AOSA	0(P)			;ADVANCE PUSHDWON
TPOPJ:	POP	P,T1			;RESTORE T1
CPOPJ:	POPJ	P,			;RETURN
	PAGE
	SUBTTL	"HELP" - TYPE HELP TEXT
;
; SUBROUTINE HELPER
; CALL IS A PUSHJ P,HELPER
; INITIALIZE HELP FILE IF NOT INITIALIZED
; OTHERWISE - JUST TYPES THE HELP TEXT
;
; REQUIRES A 202(8) WORD AREA CALLED HLPBUF IN LOW CORE
;
HELPER:	MOVSI	T2,(SIXBIT /SYS/)	;HLPTXT ON DEVICE SYS
	MOVEI	T1,17			;READ IN DUMP MODE
	MOVEI	T3,0			;DON'T NEED BUFFER HEADERS
	OPEN	CH.HLP,T1		;GET THE DEVICE
	PJRST	HELPE4			;TYPE SORRY MESSAGE
	MOVE	T1,HLPBUF(LOW)		;GET CUSP NAME TO BE HELPED
	MOVSI	T2,(SIXBIT /HLP/)	;READ CUSP.HLP
	SETZB	T3,T4			;SET UP LOOKUP BLOCK
	LOOKUP	CH.HLP,T1		;LOOKUP HELP FILE
	PJRST	HELPE4			;TYPE SORRY MESSAGE
	PUSH	P,HLPBUF+201(LOW)	;STORE WORD AFTER BLOCK
	SETZM	HLPBUF+201(LOW)		;MAKE SURE ASCIZ
	MOVSI	T1,-200			;SET UP IOWD
	HRRI	T1,HLPBUF-1(LOW)	;SET UP IOWD
	MOVEI	T2,0			;CLEAR IOWD + 1
HELPE2:	INPUT	CH.HLP,T1		;READ A BLOCK
	STATZ	CH.HLP,740000		;EVERYTHING OK
	JRST	HELPE3			;NO
	STATZ	CH.HLP,20000		;EOF?
	JRST	HELPE1			;YES
	TTCALL	3,HLPBUF(LOW)		;TYPE THE BUFFER
	JRST	HELPE2			;GET ANOTHER
HELPE3:	TTCALL	3,[ASCIZ /?HARDWARE READ ERROR/]
HELPE1:	POP	P,HLPBUF+201(LOW)	;RESTORE WORD
;
; TABGEN - GENERATES SCANNER CONVERSION TABLE
;
TABGEN:	MOVSI	T1,-200			;200(8) ASCII CHARACTERS
	MOVE	T2,[POINT 4,DESTAB ]	;SET UP POINTER
TABGE1:	ILDB	T3,T2			;GET ADDRESS
	ADDI	T3,DS%ONE		;OFFSET
	MOVEM	T3,CONTAB(T1)		;STORE CONVERSION
	AOBJN	T1,TABGE1		;DO 200(8) CHARACTERS
;
	POPJ	P,			;RETURN
HELPE4:	TTCALL	3,[ASCIZ /%SORRY - I CAN'T HELP YOU/]
	POPJ	P,			;RETURN
	PAGE
	SUBTTL	COMMAND SCANNER
;
; SUBROUTINE SCANER
; GET A FILE SPECIFICATION FROM THE INPUT LINE
;
; CALL IS  MOVEI F,FILSPC	WHERE FILSPC ADDRESSES A FILE TABLE
;	   PUSHJ P,SCANER
;	   ERROR RETURN OR HELP TEXT TYPED OR BLANK LINE
;	   RETURN		WITH THE LAST CHARACTER IN CHAR
;
; A FILESPEC IF OF THE FORM
;
;	DEVICE:NAME.EXT[P,PN,SFD,...,SFD]/SWITCH/.../SWITCH
;	TERMINATED BY A PLUS, COMMA, OR BREAK CHARACTER
;
;	WHERE DEVICE IS A LOGICAL OR PHYSICAL DEVICE
;	NAME.EXT IS STANDARD FILENAME.EXTENSION
;	P,PN IS THE PPN (MAY APPEAR ANYWHERE IN THE SPEC)
;
; AND:
;
;
; SWITCHES SPECIFIED AS FOLLOWS:
;
; TWO TABLES:
;
; TABLE 2
;
; FOR EACH SWITCH
;
; RH	ADDRESS OF ROUTINE TO PROCESS SWITCH VALUE
;
; TABLE 1
;
; SWITCH NAMES IN SIXBIT (UP TO 6*SWHSIZ CHARACTERS)
;
; S POINTS TO SWITCH TABLES
; LH TO TABLE 1 RH TO TABLE 2
;
; START COMMAND SCANNER
;
SCANER:	TLO	F,FF.VAR		;DEFAULT IS VARIABLE CODE
	TRZ	FLG,FR.CLN!FR.PER!FR.BLK
	MOVSI	T1,(SIXBIT /DSK/)
	MOVEM	T1,F.DEV(F)
SCANE1:	PUSHJ	P,SETSIX		;GET A SIXBIT ITEM
	POPJ	P,			;ILLEGAL CHARACTER
SCANE2:	HRRZ	ADR,0(ADR)		;GET SCANNER DISPATCH
	CAIN	ADR,SC%BRK		;BREAK
	PJRST	SC%BRK			;YES
	TRO	FLG,FR.BLK		;SET NON-BLANK AND
	JRST	0(ADR)			;DISPATCH
;
; CONTROL CHARACTERS AND THEIR MEANING
;
; :	COLON - ENDS DEVICE SPECIFICATION
; [	LEFT BRACKET - START PPN
; #	POUND SIGN - START OCTAL NUMBER
; ,	COMMA - ENDS SCAN
; +	PLUS - ENDS SCAN
; LF	BREAK - ENDS SCAN
; .	PERIOD - ENDS FILENEAME
;
; WHEN TRANSLATING PPN
;
; [	LEFT BRACKET - START PPN
; ]	RIGHT BRACKET - END PPN
; ,	SEPERATE ELEMENTS OF PPN
;
; LINE CONTROL
;
; -	WHEN FOLLOWED BY A BREAK - CONTINUATION
; ;	SEMI-COLON COMMENT FOLLOWS
;
;
; SWITCH - A SWITCH FOLLOWS
; SEE ABOVE FOR SPECIFICATIONS
;
SC%SWH:	PJUMPE	S,SC%ERR		;MAKE SURE SWITCHES EXPECTED
	MOVEM	T1,SCNPNT(LOW)		;STORE POINTER
	MOVEM	T2,SCNCNT(LOW)		;STORE COUNT
	MOVEI	T1,SWHDAT		;GET SPACE FOR SWITCH
	MOVEI	T2,SWHSIZ		;SET LENGTH
	PUSHJ	P,GETSIX		;GET THE SWITCH
	POPJ	P,			;INVALID
;
; TRY FOR MATCH
;
	MOVSI	T1,SWHDAT		;GET DATA WORD
	HLR	T1,S			;GET TABLE ADDRESS
	PUSHJ	P,MATCH			;MATCH?
	PJRST	SC%ERR			;NO
	ADDI	T1,-1(S)		;GET DISPATCH
	HRRZ	T1,0(T1)		;GET ADDRESS
	PUSHJ	P,0(T1)			;DISPATCH SWITCH
	POPJ	P,			;SWITCH ERROR
	MOVE	T1,SCNPNT(LOW)		;RESTORE POINTER
	MOVE	T2,SCNCNT(LOW)		;RESTORE COUNTER
	JRST	SCANE2			;DISPATCH
;
; MATCH - MATCHES TWO WORD ITEM IN LH OF T1
;	  TO TABLE IN RH OF T1
;
; FIRST GENERATE TWO WORD MASK
;
MATCH:	MOVS	T3,T1			;REVERSE POINTER WORD
	MOVEI	T2,^D12			;TWELVE SHIFTS REQUIRED
	MOVE	T4,1(T3)		;GET SECOND WORD
	MOVE	T3,0(T3)		;GET FIRST WORD
MATCH1:	ROTC	T3,6			;SHIFT
	TLNE	T3,770000		;ANY SET
	TLO	T3,770000		;SET THEM ALL
	SOJG	T2,MATCH1		;DO THEM ALL
	MOVEM	T3,MASK1		;STORE MASK
	MOVEM	T4,MASK2		;STORE MASK
;
; NOW FIND A MATCH IF ANY
;
	MOVS	T3,T1			;REVERSE TABLE
	MOVS	T3,T1			;GET ITEM ADDRESS
	ANDI	T1,777777		;CLEAR LH OF T1
MATCH2:	SKIPN	T2,0(T1)		;MORE ON LIST
	JRST	MATCH3			;END OF LIST
	MOVE	T4,0(T2)		;GET FIRST ITEM
	AND	T4,MASK1		;MASK OUT FIRST WORD
	CAME	T4,0(T3)		;MATCH
	AOJA	T1,MATCH2		;NO - COUNT AND BUMP
	MOVE	T4,1(T2)		;GET SECOND WORD
	AND	T4,MASK2		;MASK
	CAME	T4,1(T3)		;MATCH
	AOJA	T1,MATCH2		;COUNT
	TLNE	T1,-1			;TWO MATCHES
	POPJ	P,			;YES
	HRL	T1,T1			;NO - COPY INDEX
	AOJA	T1,MATCH2		;BUMP AND COUNT
MATCH3:	HLRZ	T1,T1			;GET INDEX
	PJUMPE	T1,CPOPJ		;NO MATCH
	HLRZ	T3,T3			;FIND TABLE BASE
	SUBI	T1,-1(T3)		;COMPUTE OFFSET
	PJRST	CPOPJ1		;GO BACK
;
; POUND - OCTAL NUMBER FOLLOWS
;
SC%PND:	SKIPE	SCNDAT(LOW)		;DATA MUST BE EMPTY
	PJRST	SC%ERR			;SCANNER ERROR
	PUSHJ	P,GETOCT		;GET OCTAL NUMBER
	POPJ	P,			;INVALID
	MOVEM	T1,SCNDAT(LOW)		;STORE AS DATA
	JRST	0(ADR)			;DISPATCH
;
; COLON - ENDS DEVICE
;
SC%CLN:	TRON	FLG,FR.CLN		;PREVIOUS COLON
	SKIPN	T1,SCNDAT(LOW)		;DATA NOT EMPTY
	PJRST	SC%ERR			;IT IS ERROR
	MOVEM	T1,F.DEV(F)		;STORE DEVICE
	JRST	SCANE1			;CONTINUE
;
; PERIOD - ENDS FILENAME
;
SC%PER:	TRON	FLG,FR.PER		;PREVIOUS PERIOD
	SKIPN	T1,SCNDAT(LOW)		;DATA NOT EMPTY
	PJRST	SC%ERR			;IT IS
	MOVEM	T1,F.NAM(F)		;STORE NAME
	JRST	SCANE1			;CONTINUE
;
; LEFT BRACKET - STARTS PPN
;
SC%LFT:	MOVEM	T1,SCNPNT(LOW)		;STORE CURRENT POINTER
	PUSHJ	P,GETOCT		;GET OCTAL NUMBER
	POPJ	P,			;INVALID
	CAIE	CHR,","			;MUST BE COMMA
	PJRST	SC%ERR
	HRLM	T1,F.PPN(F)
	PUSHJ	P,GETOCT		;GET PN
	POPJ	P,			;INVALID
	HRRM	T1,F.PPN(F)
	MOVE	T1,SCNPNT(LOW)		;RESTORE POINTER
	CAIN	ADR,SC%BRK		;DONE
	PJRST	SC%BRK			;FINISH SPEC
	CAIE	CHR,"]"			;RIGHT BRACKET
	PJRST	SC%ERR			;NO
	PUSHJ	P,GETSI1		;CONTINUE ITEM
	POPJ	P,		
	JRST	SCANE2			;NORMAL DISPATCH
;
; SCANNER ERROR
;
SC%ERR:	TRO	FLG,FR.BLK		;SET NON-BLANK
	MOVE	T4,T5			;SAVE COUNTER
	PUSHJ	P,GETBRK		;CLEAR LINE
	SUBI	T4,2			;UPDATE CHARACTER COUNT
	TTCALL	1,[EXP " "]		;PRINT BLANK
	SOJGE	T4,.-1			;ANY MORE
	TTCALL	1,[EXP "^"]		;POINTER
	TTCALL	3,[ASCIZ /
	?SCANNER ERROR/]
	POPJ	P,			;GIVE ERROR RETURN
;
; HERE TO FINISH FILE-SPEC
; IF NAME NON BLANK STORE IT DEPENDING ON
; WHICH CHARACTERS SEEN
;
SC%BRK:	SKIPE	T1,SCNDAT(LOW)		;SKIP IF NON-EMPTY
	TRO	FLG,FR.BLK		;SET NON-BLANK
	TRNN	FLG,FR.BLK		;BLANK LINE
	POPJ	P,			;YES
;
; DO DEVCHR AND DEVSIZ UUO'S
;
	MOVEI	T2,F.MOD(F)		;GET ADDRESS OF OPEN BLOCK
	DEVSIZ	T2,			;GET DEFAULT SIZE
	HALT	.			;NO DEVSIZ UUO
	MOVEM	T2,F.SIZ(F)		;STORE SIZE
	MOVE	T2,F.DEV(F)		;GET DEVICE NAME
	DEVCHR	T2,			;GET DEVICE CHARACTERISTICS
	TLNE	T2,(DV.MTA)		;MAGTAPE
	TLO	F,FF.TAP		;SET MAGTAPE
	TLNE	T2,(DV.TTY!DV.DIS!DV.PTP!DV.LPT!DV.CDR)
	TLO	F,FF.LIN		;SET LINE BLOCK
	MOVEM	T2,F.TYP(F)		;STORE DEVICE CHARACTERISTICS
	MOVEM	F,F.STA(F)		;STORE STATUS AND OFFSET
	TRNE	FLG,FR.PER		;PERIOD SEEN
	PJRST	SCANE3			;YES
	MOVEM	T1,F.NAM(F)		;STORE NAME
	PJRST	CPOPJ1
SCANE3:	HLLM	T1,F.EXT(F)		;STORE EXTENSION
	PJRST	CPOPJ1			;RETURN
	PAGE
;
; SUBROUTINE GETCHR
; RETURNS EQUIVALENCED CHARACTER
;
GETCHR:	TRZE	FLG,FR.MIN		;TURN OFF MINUS FLAG
	JRST	GETCH2			;MINUS WAS SET - RETURN STORED
GETCH4:	TTCALL	4,CHR			;USE TTCALL
	MOVE	ADR,CONTAB(CHR)		;GET DISPATCH
	CAIN	ADR,DS%IGN		;IGNORE CHARACTER
	JRST	GETCH4			;YES
	AOS	T5			;INCREMENT CHARACTER COUNT
	CAIN	CHR,"-"			;MINUS
	JRST	GETCH1			;HOLD IT
	CAIN	CHR,";"			;SEMI - COLON
	PJRST	GETBRK			;CLEAR LINE
	CAIN	ADR,DS%SLW		;GIVE CR-LF
	TTCALL	3,[ASCIZ /
/]
	POPJ	P,			;YES
;
; HERE ON A MINUS
;
GETCH1:	TROE	FLG,FR.MIN		;SET MINUS SEEN
	POPJ	P,			;PREVENT LOOPING
	PUSHJ	P,GETCH4		;GET NEXT CHARACTER
	CAIE	ADR,DS%BRK		;IS NEXT A BREAK
	JRST	GETCH3			;NO STORE FOR NEXT AROUND
	SETZ	T5,			;ZERO COUNTER
	TRZ	FLG,FR.MIN		;TURN OFF MINUS FLAG
	JRST	GETCHR			;GET NEXT CHARACTER
GETCH3:	MOVEM	CHR,SAVCHR(LOW)		;STORE CHARACTER
	MOVEI	CHR,"-"			;RESTORE MINUS
	MOVE	ADR,CONTAB(CHR)		;GET DISPATCH
	POPJ	P,			;RETURN MINUS
;
GETCH2:	MOVE	CHR,SAVCHR(LOW)		;GET SAVED CHARACTER
	MOVE	ADR,CONTAB(CHR)		;GET DISPATCH
	POPJ	P,			;RETURN SAVED CHARACTER
;
; SUBROUTINE GETBRK
;
; INPUTS FROM TTY UNTIL A BREAK ENCOUNTERED
;
GETBRK:	CAIE	ADR,DS%BRK		;BREAK
	CAIN	ADR,SC%BRK		;BREAK
	POPJ	P,			;YES
	PUSHJ	P,GETCHR		;GET EQUIVALENCED CHARACTER
	JRST	GETBRK			;TEST IT
;
; GETSIX
;
; CALL:	MOVEI	T1,WHERE
;	MOVEI	T2,LENGTH
;	PUSHJ	P,GETSIX
;	ERROR RETURN
;	DATA RETURN - TERMINATOR IN CHR
;
SETSIX:	MOVEI	T1,SCNDAT(LOW)		;SET UP T1
	MOVEI	T2,SCNSIZ		;SET UP T2
GETSIX:	PUSHJ	P,ZERCOR		;ZERO THE AREA
	HRLI	T1,(POINT 6,0 )		;MAKE T1 A POINTER
	IMULI	T2,6			;CONVERT TO SIXBIT BYTES
GETSI1:	PUSHJ	P,GETCHR		;GET EQUIVALENCED CHARACTER
	CAIN	ADR,DS%INV		;VALID CHARACTER?
	PJRST	SC%ERR			;NO - GIVE ERROR MESSAGE
	CAIE	ADR,DS%APH		;ALPHA
	PJRST	CPOPJ1			;NO - END OF ITEM
	SOJL	T2,GETSI1		;TRUNCATE
	CAILE	CHR,"Z"			;NO - LOWER CASE?
	SUBI	CHR," "			;YES - CONVERT TO UPPER
	SUBI	CHR," "			;CONVERT TO SIXBIT
	IDPB	CHR,T1			;STORE
	JRST	GETSI1			;GET ANOTHER
;
; GETOCT - RETURN OCTAL NUMBER
;
GETOCT:	MOVEI	T1,0
GETOC1:	PUSHJ	P,GETCHR		;GET EQUIVALENCEC CHARACTER
	CAIN	ADR,DS%INV
	PJRST	SC%ERR			;GIVE ERROR MESSAGE
	CAIL	CHR,"0"
	CAILE	CHR,"7"
	PJRST	CPOPJ1
	LSH	T1,3
	ADDI	T1,-"0"(CHR)
	JRST	GETOC1
;
; GETDEC
;
GETDEC:	MOVEI	T1,0
GETDE1:	PUSHJ	P,GETCHR		;GET EQUIVALENCED CHARACTER
	CAIN	ADR,DS%INV
	PJRST	SC%ERR			;GIVE ERROR MESSAGE
	CAIL	CHR,"0"
	CAILE	CHR,"9"
	PJRST	CPOPJ1
	IMULI	T1,^D10
	ADDI	T1,-"0"(CHR)
	JRST	GETDE1
;
; ZERCOR - ZERO CORE
;
; CALL:	MOVEI	T1,WHERE
;	MOVEI	T2,LENGTH
;	PUSHJ	P,ZERCOR
;	RETURN
;
ZERCOR:	SETZM	0(T1)			;CLEAR FIRST WORD
	CAIN	T2,1			;1 WORD
	POPJ	P,			;YES
	MOVE	T4,T1			;WHERE IS LAST
	ADDI	T4,-1(T2)		;AT T1 + T2 -1
	MOVS	T3,T1			;WHERE TO START
	HRRI	T3,1(T1)		;MAKE BLT POINTER
	BLT	T3,0(T4)		;CLEAR
	POPJ	P,			;RETURN
	PAGE
	SUBTTL	DEFINE LINKAGE INTO ALLPR4
;
; DEFINE LINKAGE INTO ALLPR4
;
	INTERN	SCANE1,SC%BRK,SC%ERR,SC%PND,SC%PER,SC%SWH
	INTERN	SC%LFT,SC%CLN
	EXTERN	DS%ONE,DS%IGN,DS%INV,DS%BRK,DS%SLW,DS%APH
	EXTERN	DS%PND,DS%FIN,DS%MIN,DS%RHT,DS%PER,DS%SWH
	EXTERN	DS%LFT,DS%CLN
	EXTERN	DESTAB
	EXTERN	EB%%AS,AS%%EB,SI%%EB
	PAGE
	SUBTTL	SWITCH TABLES
;
; TABLES AS FOLLOWS:
;
; INSW1		INPUT FILE SWITCHES
; INSW2
; OUTSW1	OUTPUT FILE SWITCHES
; OUTSW2
; PCKSW1	PACKED FILE SWITCHES
; PCKSW2
;
; SWITCH TABLES ARE BUILT VIA MACROS
;
	DEFINE TAPSWH<
	SWHMAC(SIXBIT/SPAN/,0,0,.SPAN)
	SWHMAC(SIXBIT/INDUST/,SIXBIT/RY/,0,.INDST)
	SWHMAC(SIXBIT/REWIND/,0,0,.REW)
	SWHMAC(SIXBIT/UNLOAD/,0,0,.UNL)
	SWHMAC(SIXBIT/ADVANC/,SIXBIT/E/,0,.ADV)
	SWHMAC(SIXBIT/BACKSP/,SIXBIT/ACE/,0,.BACK)
	>
	DEFINE INPSWH,<
	TAPSWH				;INCLUDE TAPE SWITCHES
	SWHMAC(SIXBIT/HELP/,0,0,.HELP)
	SWHMAC(SIXBIT/CODE/,0,1,.CODE)
	SWHMAC(SIXBIT/RECORD/,SIXBIT/SIZE/,1,.SIZE)
	SWHMAC(SIXBIT/BLOCKS/,SIXBIT/IZE/,1,.BLOCK)
	SWHMAC(SIXBIT/MODE/,0,1,.MODE)
	SWHMAC(SIXBIT/BUFFER/,SIXBIT/SIZE/,1,.BFSIZ)
	>
	DEFINE OUTSWH,<
	INPSWH
	SWHMAC(SIXBIT/DUMP/,0,0,.DUMP)
	>
	DEFINE PCKSWH,<
	SWHMAC(SIXBIT/HELP/,0,0,.HELP)
	SWHMAC(SIXBIT/FORMAT/,0,1,.FORMT)
	SWHMAC(SIXBIT/FD/,0,1,.FD)
	SWHMAC(SIXBIT/NOLIST/,0,0,.NLST)
	>
	DEFINE SWHMAC(A,B,C,D)<
	[A
	B]
>
;
; DEFINE NAME TABLES
;
INSW1:	INPSWH
	Z
OUTSW1:	OUTSWH
	Z
PCKSW1:	PCKSWH
	Z
;
	DEFINE SWHMAC(A,B,C,D)<
	IFE C,<LH==0>
	IFN C,<LH==FS.REQ>
	XWD	LH,D
>
;
; DEFINE PROCESS TABLES
;
INSW2:	INPSWH
OUTSW2:	OUTSWH
PCKSW2:	PCKSWH
;
; SIXBIT SWITCH VALUES FOR ALPHA SWITCHES
;
	DEFINE MODSWH<
	SWHMAC(SIXBIT/FIXED/,0)
	SWHMAC(SIXBIT/VARIAB/,SIXBIT/LE/)
	>
;
	DEFINE CODSWH<
	SWHMAC(SIXBIT/ASCII/,0)
	SWHMAC(SIXBIT/SIXBIT/,0)
	SWHMAC(SIXBIT/FIXEDE/,SIXBIT/BCDIC/)
	SWHMAC(SIXBIT/VARIAB/,SIXBIT/LEEBCD/)
	>
	DEFINE FRMSWH<
	SWHMAC(SIXBIT/CONVEN/,SIXBIT/TIONAL/)
	SWHMAC(SIXBIT/STANDA/,SIXBIT/RD/)
	>
	DEFINE SWHMAC(A,B)<
	[A
	B]
	>
;
MODSW1:	MODSWH
	Z
CODSW1:	CODSWH
	Z
FRMSW1:	FRMSWH
	Z
;
; PROCESS ROUTINES FOR SWITCHES
;
;
; SPAN
;
.SPAN:	CAIN	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NONE ALLOWED
	TLO	F,FF.SPN		;SET SPAN
	PJRST	CPOPJ1			;GET NEXT
;
; INDUSTRY COMPATIBLE - INDUSTRY COMPATIBLE MODE
;
.INDST:	CAIN	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NONE ALLOWED
	TLO	F,FF.IND		;SET INDUSTRY COMPATIBLE
	PJRST	CPOPJ1			;RETURN
;
; REWIND - SET REWIND FIRST
;
.REW:	CAIN	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NONE ALLOWED
	TLO	F,FF.REW		;SET REWIND
	PJRST	CPOPJ1			;RETURN
;
; UNLOAD - SET UNLOAD AFTER
;
.UNL:	CAIN	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NONE ALLOWED
	TLO	F,FF.UNL		;SET UNLOAD
	PJRST	CPOPJ1
;
; ADVANCE
;
.ADV:	MOVEI	T1,1			;ASSUME 1 FILE
	CAIE	CHR,":"			;ARGUMENT
	JRST	.ADV1			;NO ARGUMENT
	PUSHJ	P,GETDEC		;GET HOW MANY
	PJRST	SC%ERR			;ERROR
.ADV1:	MOVEM	T1,F.PSTN(F)		;STORE COUNT
	PJRST	CPOPJ1			;RETURN
;
; BACKSPACE
;
.BACK:	MOVEI	T1,1			;ASSUME 1 FILE
	CAIE	CHR,":"			;ARGUMENT
	JRST	.BACK1			;NO - ASSUME 1
	PUSHJ	P,GETDEC		;GET ARGUMENT
	PJRST	SC%ERR			;ERROR
.BACK1:	MOVNM	T1,F.PSTN(F)		;STORE NEGATIVE
	PJRST	CPOPJ1			;GET NEXT
;
; DUMP - NO ARGUMENTS
;
.DUMP:	CAIN	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NONE ALLOWED
	TLO	FLG,FL.DMP		;REQUEST A DUMP
	PJRST	CPOPJ1			;RETURN
;
; MODE - SET FLAG IN LH OF F.STA
;
;
.MODE:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO
	MOVEI	T1,SWHDAT		;USE SWHDAT
	MOVEI	T2,SWHSIZ		;SAME
	PUSHJ	P,GETSIX		;GET ARGUMENT
	PJRST	SC%ERR			;ERROR
	MOVE	T1,[XWD SWHDAT,MODSW1]
	PUSHJ	P,MATCH			;FIND MATCH
	PJRST	SC%ERR			;ERROR
	CAIE	T1,1			;FIXED
	TLOA	F,FF.VAR		;TURN ON VARIABLE
	TLZ	F,FF.VAR		;TURN OFF VARIABLE
	PJRST	CPOPJ1			;RETURN
;
; CODE - SET CODE KEY IN RH OF F.STA
;
.CODE:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO - SCANNER ERROR
	MOVEI	T1,SWHDAT		;USE SWHDAT
	MOVEI	T2,SWHSIZ		;USE DEFAULT SIZE
	PUSHJ	P,GETSIX		;GET SWITCH
	PJRST	SC%ERR			;ERROR
	MOVE	T1,[XWD SWHDAT,CODSW1]
	PUSHJ	P,MATCH			;LOOK FOR MATCH
	PJRST	SC%ERR			;NOPE
	MOVEM	T1,F.CODE(F)		;STORE MATCH VALUE AS CODE
	PJRST	CPOPJ1			;RETURN
;
; BLOCKSIZE - GET BLOCKSIZE AND STORE
;
.BLOCK:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO
	PUSHJ	P,GETDEC		;GET DECIMAL ARGUMENT
	PJRST	SC%ERR			;ERROR
	MOVEM	T1,F.BLSZ(F)		;STORE BLOCK SIZE
	PJRST	CPOPJ1			;RETURN
;
; FORMAT - SET SWITCH IN F.STA
;
.FORMT:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO
	MOVEI	T1,SWHDAT		;USE SWHDAT
	MOVEI	T2,SWHSIZ		;USE DEFAULT SIZE
	PUSHJ	P,GETSIX		;GET SWITCH
	PJRST	SC%ERR			;ERROR
	MOVE	T1,[XWD SWHDAT,FRMSW1]
	PUSHJ	P,MATCH			;MATCH
	PJRST	SC%ERR			;NO
	CAIE	T1,1			;CONVENTONAL
	TLOA	F,FF.SEQ		;TURN ON STANDARD
	TLZ	F,FF.SEQ		;TURN OFF STANDARD
	PJRST	CPOPJ1			;RETURN
;
; SIZE - SET RECORD SIZE
;
.SIZE:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO - ERROR
	PUSHJ	P,GETDEC		;GET DECIMAL
	PJRST	SC%ERR			;ERROR
	MOVEM	T1,F.RCSZ(F)		;STORE RECORD SIZE
	PJRST	CPOPJ1			;RETURN
;
; BFSIZ - STORE BUFFER SIZE
;
.BFSIZ:	CAIE	CHR,":"			;ARGUEMNT
	PJRST	SC%ERR			;NO
	PUSHJ	P,GETDEC		;GET ARGUMENT
	PJRST	SC%ERR			;BAD RESPONSE
	MOVEM	T1,F.BFSZ(F)		;STORE
	PJRST	CPOPJ1			;RETURN
;
; FD - STORE FD NAME
;
.FD:	CAIE	CHR,":"			;ARGUMENT
	PJRST	SC%ERR			;NO - ERROR
	MOVEI	T4,DS%APH		;SET MINUS ALPHABETIC
	EXCH	T4,CONTAB+"-"		;SET AND STORE
	MOVEI	T1,PCKFD		;STORE IN PCKFD
	MOVEI	T2,FDSIZE		;GET DEFAULT SIZE
	PUSHJ	P,GETSIX		;GET ITEM
	SOS	0(P)			;SET ERROR
	EXCH	T4,CONTAB+"-"		;RESTORE MINUS
	PJRST	CPOPJ1			;RETURN (NB SOS)
;
;  HELP - OUTPUT HELP TEXT (ALLPRT.HLP UNLESS ARGUMENT)
;
.HELP:	MOVE	T1,[CUSP]		;ASSUME CUSP TO BE TYPED
	MOVEM	T1,HLPBUF(LOW)		;STORE CUSP NAME
	CAIE	CHR,":"			;ARGUMENT
	JRST	.HELP1			;NO
	MOVEI	T1,HLPBUF		;STORE NAME IN HLPBUF
	MOVEI	T2,1			;ONLY 1 WORD
	PUSHJ	P,GETSIX		;GET NAME
	POPJ	P,			;ERROR
.HELP1:	PUSHJ	P,GETBRK		;CLEAR INPUT LINE
	PJRST	HELPER			;CALL HELPER
;
;	NOLIST - DON'T LIST FD IF PACKED SPEC
;
.NLST:	CAIN	CHR,":"		;ARGUMENT
	PJRST	SC%ERR		;NONE ALLOWED
	TLO	F,FF.NLS	;SET FLAG
	PJRST	CPOPJ1		;RETURN
	PAGE
	SUBTTL	PRINT STATISTICS AT END OF RUN
STATS:	MOVE	7,APOINT	;SET UP POINTERS
	MOVSI	14,-3		;SET UP COUNTER
NXTPNT:	PUSHJ	P,GETPNT		;GET POINTERS
	PUSHJ	P,DECOUT
	ADDI	7,2
	AOBJN	14,NXTPNT
	TTCALL	3,[ASCIZ/
 # OF RECORDS CONVERTED     /]
	TTCALL	3,NREC
	TTCALL	3,[ASCIZ/
 # OF CHARACTERS CONVERTED  /]
	TTCALL	3,NCHR
	TTCALL	3,[ASCIZ/
 # OF BAD CHARACTERS        /]
	TTCALL	3,NBCHR
	POPJ	P,
;
;	GET POINTERS
;
GETPNT:	MOVE T3,0(7)		;SET UP POINTER TO ASCIZ RECORD
	MOVE T1,1(7)		;SET UP POINTER TO COUNT
	MOVE 	T1,0(T1)	;GET ACTUAL COUNT
	POPJ	P,
;
;	POINTERS
;
PNTERS:	POINT	7,NREC
	EXP	NRECS
	POINT	7,NCHR
	EXP	NCHRS
	POINT	7,NBCHR
	EXP	BCHRS
APOINT:	EXP	PNTERS
;
;	DECOUT - OUTPUT OCTAL NUMBER IN DECIMAL
;
DECOUT:	IDIVI	T1,12		;DIVIDE BY 10
	HRLM	T2,0(P)		;SAVE ON STACK
	SKIPE	T1		;DONE YET
	PUSHJ	P,DECOUT	;NEXT DIGIT
	HLRZ	T1,0(P)		;GET DIGIT
	ADDI	T1,60		;MAKE ASCIZ
	IDPB	T1,T3		;STORE
	POPJ	P,
	PAGE
	SUBTTL	LITERALS
	LIT
	END	ALLPRT