Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0108/cobedt.mac
There are 2 other files named cobedt.mac in the archive. Click here to see a list.
	TITLE	COBEDT		
	SUBTTL	A COBOL FILE EDITOR
	SEARCH	APROC
	SEARCH	UUOSYM
	TWOSEG
	SALL
;/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/
;	
;			C O B E D T 
;
;		    A COBOL FILE EDITOR
;
;				DAVE GORKA
;				18-JUNE-76
;
;/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/

F=0				; THE FLAG REGISTER
P=17				; THE PDL

PDLLEN==^D30			; PDL LENGTH
POSLEN==^D1000			; MAX RECORD SIZE SUPPORTED
STRLEN==POSLEN			; MAX # CHARS IN A FIND STRING


OPDEF	CALL	[PUSHJ P,]	; CALL OPCODE
OPDEF	RET	[POPJ  P,]	; RETURN FROM SUBROUTINE
OPDEF	PJRST	[JRST	 ]	; JUMP TO SUBROUTINE AFTER PUSHJ
OPDEF	ERRS	[001000,,0]	; ERROR OCCURRED IN SCAN ROUTINE
OPDEF	ERRC	[002000,,0]	; ERROR OCCURRED IN MANIPULATION LANGUAGE
OPDEF	ERRO	[003000,,0]	; ERROR IN COBOL FILE SCANNER

DEFINE	PRINT(TXT),<
	OUTSTR	[ASCIZ/TXT/]
	>

DEFINE	P$RINT(TXT),<
	PRINT	<TXT>
	OUTSTR	CRLF
	>

;	ERROR DEFINES

DEFINE	SE(TXT),<
	ERRS	[ASCIZ/TXT/]
	>

DEFINE	CE(TXT),<
	ERRC	[ASCIZ/TXT/]
	>

DEFINE	OE(TXT),<
	ERRO	[ASCIZ/TXT/]
	>
	SUBTTL	EXTERNALS AND FLAGS

EXTERNAL	SCAN		; FILE NAME SCANNER
EXTERNAL	TTYINI,TTYI	; INPUT TTY HANDLER
EXTERNAL	DSKINI,DSKIN	; INPUT DISK HANDLER
EXTERNAL	DSKCLS		; CLOSE OUT THIS DEVICE
EXTERNAL	DS2INI,DS2OUT	; OUTPUT FILE HANDLER
EXTERNAL	DS2CLS
EXTERNAL	DS3INI,DS3OUT	; OUTPUT LIST FILE ROUTINES
EXTERNAL	DS3CLS		; CLOSE THE OPEN FILE
EXTERNAL	DS4INI,DS4IN	; ASCII INPUT ROUTINES
EXTERNAL	DS4CLS		; AND CLOSE ROUTINE
EXTERNAL	TTYLST		; LAST CHAR READ FROM TTY

;	IN RH: F

FOURFG==1			; 4 DIGITS IN DECIMAL FIELD
FILEIT==2			; PROCESSING AN INDIRECT COMMAND FILE
CHARFL==4			; 1 HAS A SCANNED CHARACTER IN IT
COMNFL==10			; PROCESSING A CHAR
RECWRT==20			; A RECORD NEEDS TO BE WRITTEN
JUSTEX==40			; JUST EXIT AFTER COPY
GOTCR==100			; WE HAVE SEEN A CR
DFLAG==200			; TELL PRINT TO REALLY DELETE
NULLF==400			; CONTINUE THE FIND SEQUENCE
NOACWF==1000			; NO ACCESS WORDS IN FILE
AFLAG==2000			; ASCII FILE -- CHECK FOR CRLF 
SFLAG==4000			; LET STRSCN DO INSERTS DIRTY WORK
FINDFG==10000			; [00] IN A FIND SEQUENCE

;	IN LH: F

COMP==1				; SINGLE PRECISION COMP
COMP1==2			; DOUBLE PRECISION COMP
INFILE==4			; PROCESSING A COBOL FD FILE
PICFLG==10			; A PICTURE STRING WAS SCANNED FROM OCCURS
	SUBTTL	COBEDT START

	RELOC	400000

COBEDT:	RESET			; ALWAYS NICE
	MOVE	1,[CALL UUOH]
	MOVEM	1,.JB41##		; THE PRINT ROUTINES
	P$RINT	<COBEDT VERSION 4.0>
	MOVE	1,[ZEROB,,ZEROB+1]
	SETZB	F,-1(1)
	BLT	1,ZEROE		; ZERO THE OLD CORE ON ENTRY
	MOVE	P,[IOWD	PDLLEN,PDL]
	CALL	TTYINI		; INIT THE TTY
	SE	<?CANNOT INITIALIZE TTY>
COB1:	PRINT	<ENTER COBOL FILE TO EDIT: >
	CALL	SCAN		; GO SCAN THE FILE NAME
	JRST	COB1		; OOPS - HE BLEW IT
	CALL	DSKINI		; LOOKUP THIS FILE
	JRST	[P$RINT <?INIT FAILURE FOR DEVICE DSK:>
		 JRST	COB1]
	JRST	[P$RINT <?FILE CANNOT BE FOUND>
		 JRST	COB1]
COB101:	MOVEI	14,TTYI		; GET FROM TTY
COB10:	TRNN	F,FILEIT	; IN FILE MODE ?
	OUTSTR	[ASCIZ/FD-/]
	SETZ	2,		; WHERE THE COMMAND GOES
	MOVEI	4,6		; 4 = # CHARS IN A COMMAND
	MOVE	3,[POINT 6,2]	; IN SIXBIT
COB2:	CALL	0(14)		; GET A CHAR FROM THE INPUT MEDIUM
	JFCL			; JUST IN CASE IF FROM FILE
	TRNE	1,777600	; AN EOF YET ?
	TRNN	F,FILEIT	; IN FILE MODE ?
	CAIA			; NO
	JRST	FILEO		; YES -- ALL DONE
	CAIE	1,33		; ALTMODE ?
	CAIN	1,15		; OR CR
	JRST	COB2
	CAIE	1,12		; A LF ?
	CAIN	1," "		; OR START OF NEXT FIELD ?
	JRST	COB3		; YES
	CAIN	1,"@"		; INDIRECT FILE ?
	JRST	FILE		; YES -- HANDLE IT RIGHT HERE
	CAIL	1,"A"		; ALPHA ?
	CAILE	1,"Z"
	CAIA
	TRC	1,40		; CVT TO SIXBIT
	IDPB	1,3		; SAVE IN 0
	SOJGE	4,COB2		; REPEAT FOR ALL

	SE	<%COMMAND TO LONG>
	SUBTTL	FILE DESCRIPTOR COMMAND DISPATCH

COB3:	MOVSI	3,-CLEN		; SEARCH FOR THE COMMAND
	SUBI	4,6		; 4 = - # OF CHARS IN WORD
	JUMPE	4,ENDIT		; NULL ?     YES,ENDIT
	MOVE	4,MASKTB+1(4)	; 4 = MASK
	MOVE	5,CTBL(3)	; GET THE COMMAND
	AND	5,4		; LESS WHAT WE DIDN'T TYPE
	CAME	2,5		; SAME WITH THE LOST BITS ?
	AOBJN	3,.-3		; NO -- REPEAT AS NEEDED
	JUMPL	3,@CLEN+CTBL(3) ; GO TO THE RIGHT ROUTINE
	SE	<%BAD COMMAND>

CTBL:	'RECORD'		; RECORD N
	'SIXBIT'		; SIXBIT(M:N[,M:N])
	'ASCII '		; ASCII(M:N[,M:N])
	'COMP  '		; COMP(M[,N])
	'COMP-2'		; COMP-2(M[,N])
	'BLOCK '		; BLOCK SIZE COMMAND
	'FD    '		; COBOL FD FILE
	'NOACW '		; NO INTERNAR DATA ACCESS WORDS
	'HELP  '
CLEN==.-CTBL
	+	RECORD		; ROUTINE ADDRESSES
	+	SIX
	+	ASC
	+	COM
	+	COM2
	+	BLOCKN		; BLOCK SCANNING ROUTINE
	+	HFILE		; ROUTINE TO SETUP THE COBOL CONVERTOR
	+	NOACW		; SET NO ACW FLAG
	+	HELP		; DO THE HELP

	-	1		; MASK FOR A FULL WORD
	-	1B29		; LESS S6
	-	1B23		; LESS S5+S6
	-	1B17		; LESS S4+S5+S6
	-	1B11		; LESS S3+S4+S5+S6
MASKTB:	-	1B5		; LESS S2+S3+S4+S5+S6

HELP:	OUTSTR	FDHLP
	JRST	COBCLR
	SUBTTL	RECORD(N) SCANNER + SUBROUTINES

BLOCKN:	SKIPA	5,[ BSIZE ]	; SAVE THE BLOCK SIZE
RECORD:	MOVEI	5,RECSIZ	; WHERE TO PUT THE RECORD
	CALL	SCANC		; USING THIS ROUTINE
	CALL	GETNUM
	MOVEM	2,0(5)		; SAVE THE RECORD SIZE
	JRST	COBCLR
SCANCI:	CALL	0(14)		; CALL THE RIGHT INPUT ROUTINE
	JFCL			; JUST IN CASE IF FROM FILE
SCANC:	CAIE	1,11		; TAB OR 
	CAIN	1," "
	JRST	SCANCI		; YES - IGNORE
	CAIN	1,15		; CR ?
	JRST	SCANCI		; YES -- IGNORE ALSO
	TRO	F,CHARFL	; 1 NOW HAS A CHARACTER IN IT
	RET			; RETURN -- 1 = NEXT CHAR IN SCAN

COBCLR:	CAIE	1,33		; ALT ?
	CAIN	1,"Z"-100	; CNTL-Z ?
	JRST	COB10
	CAIN	1,12		; LF ?
	JRST	COB10		; YES -- START AGAIN
	CALL	0(14)		; CALL THE RIGHT ROUTINE
	JFCL
	JRST	COBCLR		; ANOTHER CHAR -- SEE IF DONE

GETNUM:	MOVE	4,[CALL	0(14)]	; 4 = ROUTINE TO GET CHARS FROM
GETNU1:	SETZ	2,		; 2 = RETURNED #
GETNU2:	TRZN	F,CHARFL	; GOT A CHAR IN 1 ALREADY ?
	XCT	4		; NO -- GET A CHAR FROM WHOMEVER
	JFCL			; JUST IN CASE
	CAIN	1,"."		; CURRENCY ?
	JRST	GETNU3		; YES - ASSUME WHATEVER
	CAIN	1," "		; IGNORE SPACES
	JRST	GETNU2		;
	CAIL	1,"0"		; NUMERIC
	CAILE	1,"9"
	RET			; NON-NUMERIC
	IMULI	2,^D10
	ADDI	2,-"0"(1)
	JRST	GETNU2		; AND CONTINUE
GETNU3:	MOVE	2,CURLIN	; GET CURRENCY
	JRST	GETNU2		; AND CONTINNUE

NOACW:	TRO	F,NOACWF	; SAY WE HAVE NO ACCESS WORD
	JRST	COBCLR		; AND CONTINUE
	SUBTTL	ASCII AND SIXBIT SCANNER
;/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/
;
;	THE POS TABLE CONSISTS OF 3 BIT ENTRY'S FOR EACH 
;	CHARACTER POSITION IN THE RECORDS FOR THE FILES.
;	THE TYPES CURRENTLY DEFINED ARE:
;		0 => UNDEFINED (POSITIONS ARE IGNORED)
;		1 => SIXBIT
;		2 => ASCII
;		3 => COMP
;		4 => COMP-2
;
;/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/-/

ASC:	MOVEI	5,2		; TYPE FOR ASCII DEFINITIONS
	MOVEI	2,377777	; ASSUME A LARGE RECORD SIZE
	MOVEM	2,RECSIZ	; AND SET
	TROA	F,AFLAG!NOACWF	; IN ASCII MODE (CHECK FOR CRLF)
SIX:	MOVEI	5,1		; FOR SIXBIT
	SKIPN	2,MODE
	JRST	.+3		; NO
	CAME	2,5		; YES -- SAME MODE ?
	SE	<%CANNOT MIX SIXBIT AND ASCII RECORDS>
	MOVEM	5,MODE		; SET THE MODE
	CALL	SCANC		; SKIP TO THIS CHAR
SIX1:	CALL	SCANR		; GO SCAN A RANGE
	PUSH	P,1		; SAVE TERMINAL CHAR
	SOS	1,2		; 1 = WHERE TO START
SIXENT:	IDIVI	1,^D12		; 1 = WORD, 2 = POS IN WORD
	MOVSI	4,(POINT 3,)
	ADDI	4,POS(1)	; 4 = BP TO START
	JUMPE	2,.+3
	IBP	4		; INCREMENT TO ACTUAL POSITION
	SOJG	2,.-1		; REPEAT FOR ALL
SIXX:	EXCH	3,CURPOS	; [00] SAVE COUNT, GET CURRENT
	ADD	3,CURPOS	; [00] 3 = # CHARS NEW
	CAIL	3,POSLEN	; [00] BEYOND MAX ?
	SE	<?EXCEEDING MAXIMUM RECORD SIZE>
	EXCH	3,CURPOS	; [00] GET ORIGINAL, SAVE NEW TOTAL
	ILDB	1,4		; GET THE CHAR WE WILL ZAP
	JUMPN	1,SIXERR	; IS THIS POSITION COVERED ?
	DPB	5,4		; NO - SET TYPE
	SOJG	3,.-3		; REPEAT FOR ALL CHARACTERS
	TLNE	F,INFILE	; IN A FILE (COBOL THAT IS)
	RET			; YES
	POP	P,1		; GET LAST CHAR SEEN
	CAIN	1,","		; COMMA ?
	JRST	SIX1		; YES - AGAIN
	JRST	COBCLR
SIXERR:	P$RINT	<?THESE POSITIONS HAVE BEEN COVERED>
	JRST	COBCLR		; CLEAR THE BUFFER
	SUBTTL	IMBEDDED COMPUTATION FIELDS SCANNER

COM2:	SKIPA	5,[4]	; COMP-2 TYPE
COM:	MOVEI	5,3		; COMP TYPE
	CALL	SCANC		; IN THE INPUT
COM1:	CALL	GETNUM		; GET THE POSITION
	MOVE	3,2		; COPY ORIGINAL
	CAIE	1,","		; COMMA ?
	JRST	COM3		; NO
	CALL	GETNUM
	EXCH	3,2		; 2 = FIRST #, 3 = 2ND
	CAIN	1,","		; COMMA HERE ALSO
COM3:	SE	<%SECOND COMMA ILLEGAL>
	PUSH	P,1		; SAVE LAST CHAR SCANNED
	SKIPN	2		; SPECIFIED ?
	MOVE	2,CURPOS	; NO -- USE CURRENT
	SKIPN	3		; # COMP FIELDS SPECIFIED 
	MOVEI	3,1		; OOPS -- ASSUME 1 ONLY
	CAIN	5,4
	LSH	3,1		; MUL BY 2 IF DOUBLE PRECISION
	IMULI	3,6
	MOVEI	1,0(2)		; HIT THE RIGHT WORD
	IDIVI	1,6		; 1 = HALFWORD ADDRESS
	SKIPE	2		; CROSSES RIGHT POSITIONS ?
	SE	<%POSITIONS NOT ON A WORD BOUNDARY>
	MOVSI	4,(POINT 3,0)
	TRNE	1,1		; IN OTHER HALFWORD ?
	MOVSI	4,(POINT 3,0,17)
	LSH	1,-1		; DIVIDE BY 2
	ADDI	4,POS(1)	
	PJRST	SIXX		; GO BLOT OUT THESE POSITIONS
	SUBTTL	COBOL FILE DESCRIPTOR CONVERTOR

SCNBEG:	MOVEI	14,DS4IN	; 14 = ROUTINE TO CALL FOR DATA
	HRRZS			; NO FLAGS IN LH:
	CALL	SETUPL		; AND BUILD A WHOLE LINE
	RET			; $E TO ORIGINAL CALLER ON EOF
	MOVE	14,[POINT 7,RECSTR]
	
	CALL	GETID		; SCAN AN IDENTIFIER
	CALL	NAMEF		; LOOKUP THE NAME IN THE RESERVED WORD LIST
	CAIN	1,^D17		; TYPE 17 ?
	OE	<%ILLEGAL TO USE LEVEL NUMBERS 66 AND 88>
	CALL	GETID		; SCAN IDENTIFIER ONTO FLOOR
SCNLP:	CALL	GETID		; SCAN A KEY WORD (MAYBE A PERIOD)
	CALL	NAMEF		; GIVE IT A NAME (FIND IT)
	CAIL	1,1		; [00] IS IT LEGAL ?
	CAILE	1,^D19		; [00] ?
	JRST	WHATQ		; [00] NO -- BETTER TELL THE GUY
	CAIL	1,^D11		; A CHARACTER TYPE ?
	CAILE	1,^D16
	JRST	@.+1(1)		; DISPATCH AS INDICATED
	JRST	@USA		; YES -- DO DISPLAY-6 STUFF
	
	+	NLEVEL		; 1 = '.'
	[OE 	<%REDEFINES ARE ILLEGAL>
	]
	+	PIC		; 3 = PICTURE CODES
	+	USAGE		; 4 = USAGE
	+	NOOP		; 5 = SYNCHRONIZED
	+	NOOP		; 6 = JUSTIFIED
	+	NOOP2		; 7 = BLANK
	+	NOOP2		; 8 = VALUE 
	+	OCCURS		; 9 = OCCURS
	+	SCNLP		; 10 = IS

;	THROW A IDENTIFIER ON THE FLOOR

NOOP:	CALL	GETID		; THEN THE IDENTIFIER
	JRST	SCNLP		; AND RETURN

;	THROW A POSSIBLE 2 IDENTIFIES ON THE FLOOR

NOOP2:	CALL	GETID		; THEN THE IDENTIFIER
	HRRZ	1,STRING		; CHECK TO SEE WHAT WE SCANNED
	CAIE	1,'WHE'		; THE OPTIONAL WORDS PRESENT ?
	CAIN	1,'IS '
	JRST	NOOP		; YES - SCAN THE NEXT SET
	JRST	SCNLP		; NO,SCNLP

WHATQ:	PRINT	<?YOU HAVE CONFUSED ME ON LINE: >
	OUTSTR	RECSTR		; [00] GIVE HIM THE LINE
	HALT	.		; [00] DO NOT PROCEED
;	SET ALL THOSE PARAMETER WE HAVE JUST SCANNED

NLEVEL:	SKIPN	3,LENGTH	; # OF POSITIONS THIS ITEM OCCUPIES
	JRST	SCNBEG		; NO POSITIONS -- IGNORE AND GET NEXT
	SKIPN	5,MODE		; DID WE ESTABLISH THE MODE OF THE RECORD ?
	AOS	5,MODE		; NO -- JUMP ON ASCII
	TLZN	F,COMP!COMP1	; [00] COMP FIELD ?
	JRST	NLVL1		; [00] NO -- JUST PASS
	CAIL	3,9		; [00] DOUBLE PRECISION ?
	SKIPA	5,[4]		; [00] YES
	MOVEI	5,3		; [00] NO -- SINGLE
NLVL1:	MOVE	1,CURPOS	; GET CURRENT POSITION IN RECORD
	TLO	F,INFILE	; WE ARE IN A COBOL RECORD FILE
	CAIN	5,3		; COMP VAR ?
	MOVEI	3,6
	CAIN	5,4
	MOVEI	3,^D12		; DOUBLE PRECISION
	SKIPE	TIMES		; OBJECT OF AN OCCURS ?
	IMUL	3,TIMES		; YES -- INCREASE PROPOTIONATELY
	CALL	SIXENT		; GO USE THIS SUBROUTINE FOR THE WORK
	SETZM	LENGTH		; NO LENGTH
	JRST	SCNBEG
	SUBTTL	HANDLE THE 'OCCURS' CLAUSE

OCCURS:	CALL	GETID		; THEN GET AND IDENTIFIER
	PUSH	P,STRING	; SAVE THIS POSSIBLE NUMBER
	CALL	GETID		; SCAN THE IDENTIFIER
	CALL	NAMEF		; SEE IF A NAME EXISTS
	CAIN	1,^D18		; 18 = 'TO'
	JRST	OCCUR1		; POSITION TO NEXT
	CAIN	1,^D19		; 19 = 'TIMES'
	JRST	OCCUR2		; YES -- LAST IS OUR NUMBER
	CAIE	1,1		; A PERIOD ?
	OE	<%CONFUSION IN 'OCCURS'>
OCCUR2:	POP	P,1		; THIS IS THE NUMBER OF TIMES
OCCUR0:	SETZ	3,		; 3 = BINARY
	SETZ	2,
	ROTC	1,6		; SHIFT NUMBER TO LOWER 2
	IMULI	3,^D10		; ADJUST
	ADDI	3,-'0'(2)	; AND ADD
	JUMPN	1,.-4		; REPEAT FOR ALL DIGITS
	MOVEM	3,TIMES		; # TIMES TO REPEAT THIS PIC STRING
OCCUR3:	CALL	NAMEF		; FIND OUT THE NAME AGAIN
	CAIN	1,1		; WAS IT A PERIOD ?
	JRST	NLEVEL		; YES -- DONE WITH THIS STRING
	CAIN	1,3		; 3 = A PICTURE CLAUSE
	JRST	OCCUR4
	CALL	GETID		; GET THE NEXT ID
	JRST	OCCUR3		; AND REPEAT UNTIL A PERIOD IS FOUND !

OCCUR4:	TLO	F,PICFLG	; WE MUST RETURN HERE
	JRST	PIC		; GO DO THE PICTURE

OCCUR1:	CALL	GETID
	JRST	OCCUR0		; AND PROCESS
	SUBTTL	PICTURE SCANNER

PIC:	CALL	GETID		; SCAN THE ID
	CALL	NAMEF		; GIVE IT A NAME
	CAIN	1,^D10		; 10 = 'IS'
	JRST	PIC		; SKIP UP TO THE ACTUAL PICTURE STRING
	MOVE	5,[POINT 6,STRING]	
	SETZ	4,		; 4 = # CHARS IN PICTURE STRING
PICLP:	ILDB	1,5		; GET A CHARACTER
	JUMPE	1,PICDON	; EOF OF STRING ?  YES,PICDON
	MOVSI	2,-PICLEN	; THE TABLE INDEX
	HLRZ	3,PICTAB(2)	; CHECK THIS TABLE
	CAME	1,3		; SAME ?
	AOBJN	2,.-2		; NO -- REPEAT
	HRRE	1,PICTAB(2)	; GET POSSIBLE ADDRESS
	TRNN	1,200000	; AND ADDRESS
	HRRZS	1		; YES - KEEP ONLY THAT
	JUMPL	1,[AOJA 4,PICLP]; JUST KEEP A COUNT
	JUMPN	1,0(1)		; A GO TO ADDRESS ?   YES,0(1)
	JRST	PICLP		; IGNORE THE UNFOUND


PICCR:	ILDB	1,5		; GET THAT CHAR
	CAIN	1,'R'		; THE REST OF THE FIELD ?
	JRST	PICLP		; JUST IGNORE
	OE	<%BAD PIC STRING>
PICDB:	ILDB	1,5
	CAIN	1,'B'		; THE DB ?
	JRST	PICLP		; YES
	OE	<%BAD PIC STRING>

PICDON:	MOVEM	4,LENGTH	; SAVE THE LENGTH OF THE PICTURE
	TLZE	F,PICFLG	; IN A OCCUR PICTURE STRING
	JRST	OCCUR3		; YES,OCCUR3
	JRST	SCNLP		; AND CONTINUE WITH THE REST
	
PICREP:	SETZ	2,		; 2 = # CHARACTERS IN THIS STRING
	ILDB	1,5		; GET A CHARACTER
	CAIL	1,'0'		; A NUMERIC ?
	CAILE	1,'9'		; ?
	JRST	.+4		; NO
	IMULI	2,^D10
	ADDI	2,-'0'(1)	; ADD ON
	JRST	PICREP+1	; REPEAT AS NEEDED
	ADDI	4,0(2)		; AND ADD
	SOJA	4,PICLP		; CONTINUE BUT DECREMENT FOR LEAD CHAR
	SUBTTL	USAGE - SCAN THE USAGE

USAGE:	CALL	GETID		; READ THE IDENTIFIER
	CALL	NAMEF		; GIVE IT A NAME
	CAIN	1,^D10		; 10 = 'IS'
	JRST	USAGE		; SKIP THE IS AND POSITION
USA:	JRST	@.-^D10(1)	; CALL THE PROPER ROUTINE
	
	+	UCOMP		; 11 = COMPUTATIONAL
	+	UCOMP1		; 12 = COMPUTATIONAL-1
	+	UDISP		; 13 = DISPLAY   (SIXBIT)
	+	UDISP7		; 14 = DISPLAY-7 (ASCII)
	[OE	<%INDEX USAGE IS NOT ALLOWED>
	]
	[OE	<%DATABASE KEY USAGE IS NOT ALLOWED>
	]
	
UDISP7:	SKIPA	5,[2]		; THE ASCII TYPE
UDISP:	MOVEI	5,1		; THE SIXBIT TYPE
	SKIPN	4,MODE		; GET THE MODE
	MOVE	4,5		; OOPS -- LOAD THE CURRENT ONE
	MOVEM	4,MODE		; AND SET
	CAME	4,5		; SAME ?
	OE	<?CANNOT MIX RECORD MODES!>
	JRST	SCNLP	

UCOMP:	TLOA	F,COMP		; WE SCANNED A COMP FIELD
UCOMP1:	TLO	F,COMP1		; A DOUBLE PRECISION
	MOVE	1,CURPOS	; GET CURRENT POSITION IN LINE
	IDIVI	1,6		; BE SURE OF A COMP MULTIPLE
	SKIPE	2		; LEFTOVERS ?
	ADDI	1,1		; YES -- TO NEXT  WORD
	IMULI	1,6		; BACK TO REGULAR PSITION
	JRST	SCNLP		; AND CONTINUE
	SUBTTL	SCANNING SUBROUTINES

;	SCAN A WHOLE LINE OFTEXT (FROM PERIIOD TO PERIIOD)

SETUPL:	MOVE	2,[POINT 7,RECSTR] ; WHERE TO SAVE THE FULL LINE AT
	SETZM	OLDCHR		; WE HAVE NO LYING CHARACTER
SETUP0:	CALL	0(14)		; READ FROM THE FILE
	RET			; A NO SKIP RETURN
	CAIN	1,15		; CR ?
	JRST	.-3		; YES -- IGNORE
	CAIE	1,","		; THE "BLANK" CHARACTERS ?
	CAIN	1,";"		; ?
	MOVEI	1," "		; YES
	CAIE	1,11		; TAB ?
	CAIN	1,12		; LF ?
	MOVEI	1," "		; YES
	IDPB	1,2		; SAVE THE CHAR AWAY
	CAIE	1,"."		; PERIOD ?
	JRST	SETUP0		; NO
	SETZ	1,
	IDPB	1,2		; FOR A POSSIBLE ERROR
	AOS	0(P)		; GIVE A SKIP ON A LINE FOUND
	RET			; $E

;	SKIP TO THE FIRST NON BLANK

SKIPNB:	SKIPN	1,OLDCHR	; LYING A CHARACTER ?
	ILDB	1,14		; NO -- JUST READ A CHAR
	MOVEM	1,OLDCHR	; SAVE HERE
	CAIN	1," "		; BLANK ?
	JRST	.-3		; YES -- IGNORE
	RET			; NO,$E

;	SCAN A IDENTIFIER INTO A SIXBIT FORMAT

GETID:	CALL	SKIPNB		; DO THIS FIRST
	MOVE	2,[POINT 6,STRING] ; WHERE TO PUT THE COMPLETE STRING
	MOVE	1,[STRING,,STRING+1]
	SETZM	-1(1)
	BLT	1,STRING+4	; ZERO THE STRING
	SKIPN	1,OLDCHR	; LYING A CHARACTER
GETID0:	ILDB	1,14		; GET THAT CHAR
	MOVEM	1,OLDCHR	; SAVE FOR LATER
	TRC	1," "		; CVT TO SIXBIT
	JUMPE	1,GETID1	; BLANK     YES,GETID1
	CAIE	1,'.'		; A PERIOD ?
	JRST	.+4		; NO
	CAMN	2,[POINT 6,STRING] ; ANY CHARACTERS SCANNED ?
	IDPB	1,2		; NO -- SAVE THE PERIOD
GETID1:	RET			; $E
	IDPB	1,2		; SAVE A CHARACTER IN STRING
	JRST	GETID0		; AND REPEAT AS NEEDED
;	LOOKUP A COBOL RESERVED WORD AND ASSIGN IT A TYPE

NAMEF:	MOVEI	2,NAMETB+1	; 2 = POINTS TO STRINGS
NAME0:	SKIPN	3,-1(2)		; 3 = # WORDS IN A COBOL ENTRY
	JRST	NAMEDN		; OOPS -- NO LONGER ANY ENTRY'S
	MOVEI	4,STRING		; 4 = TEXT ADDRESS OF MATCH STRING
	HLRZ	1,3		; 1 = TYPE OF THE VARIABLE
	HRRZS	3		; 3 = WC LESS TYPE
	MOVE	5,0(2)		; GET COBOL STRING 
	ADDI	2,1		; INCREMENT POINTER
	CAME	5,0(4)		; SAME AS OUR STRING
	AOJA	2,NAME0		; NO -- SKIP TO NEXT
	ADDI	4,1		; INCREMENT OUR STRING POINTER
	SOJG	3,.-5		; REPEAT FOR ALL WORDS
	RET			; WE HAVE A MATCH !
	
NAMEDN:	SETZ	1,		; WE HAVE NO BANANNAS !
	RET			; AND LEAVE

;	NAMETB FORMAT IS:	TYPE,,# WORDS IN STRING
;				<STRING IN SIXBIT>

	RADIX	10

NAMETB:	+	1,,1		; TYPE 1
	SIXBIT	'.     '
	+	2,,2		; TYPE 2
	SIXBIT	'REDEFINES   '
	+	3,,2		; TYPE 3
	SIXBIT	'PICTURE     '
	+	3,,1
	SIXBIT	'PIC   '
	+	4,,1		; TYPE 4
	SIXBIT	'USAGE '
	+	5,,2		; TYPE 5
	SIXBIT	'SYNCHRONIZED'	
	+	5,,1
	SIXBIT	'SYNC  '
	+	6,,2		; TYPE 6
	SIXBIT	'JUSTIFIED   '
	+	6,,1
	SIXBIT	'JUST  '
	+	7,,1		; TYPE 7
	SIXBIT	'BLANK '
	+	8,,1		; TYPE 8
	SIXBIT	'VALUE '
	+	9,,1		; TYPE 9
	SIXBIT	'OCCURS'
	+	10,,1		; TYPE 10
	SIXBIT	'IS    '
	+	11,,3		; TYPE 11
	SIXBIT	'COMPUTATIONAL     '
	+	11,,1
	SIXBIT	'COMP  '
	+	12,,3		; TYPE 12
	SIXBIT	'COMPUTATIONAL-1   '
	+	12,,1
	SIXBIT	'COMP-1'
	+	13,,2		; TYPE 13
	SIXBIT	'DISPLAY     '
	+	13,,2		
	SIXBIT	'DISPLAY-6   '
	+	14,,2		; TYPE 14
	SIXBIT	'DISPLAY-7   '
	+	15,,1		; TYPE 15
	SIXBIT	'INDEX '
	+	16,,2		; TYPE 16
	SIXBIT	'DATABASE-KEY'
	+	17,,1		; TYPE 17
	SIXBIT	'66    '		
	+	17,,1
	SIXBIT	'88    '
	+	18,,1		; TYPE 18
	SIXBIT	'TO    '
	+	19,,1		; TYPE 19
	SIXBIT	'TIMES '
	Z			; ** END OF THE LIST **

	RADIX	8
	SUBTTL	INDIRECT FILE HANDLER

FILE:	TROE	F,FILEIT	; IN FILE MODE ALREADY ?
	SE	<%FILE COMMAND ILLEGAL IN FILE MODE>
	CALL	SCAN		; SCAN THE INPUT FILE NAME
	JRST	FILEO		; BAD WHATEVER
	SKIPN	2		; EXTENSION ?
	MOVSI	2,'CMD'		; ASSUME CMD FILE
	CALL	DS4INI		; INIT THAT DEVICE
FILE1:	JRST	[P$RINT <?INIT FAILED FOR DEVICE>
		 JRST	FILEO]
	JRST	[P$RINT <?LOOKUP FAILED FOR FILE>
		 JRST	FILEO]
	MOVEI	14,DS4IN	; 14 = INPUT SUBROUTINE TO CALL
	JRST	COB10

FILEO:	CALL	DS4CLS		; CLOSE CHANNEL
	TRZ	F,FILEIT	; CLEAR FLAG
	JRST	COB101


;	START THE INTERPRETING OF THE COBOL FD

HFILE:	TRNE	F,FILEIT	; IN A INDIRECT COMMAND ?
	SE	<%COBOL RECORD SCANNER UNAVAILABLE>
	CALL	SCAN		; GET THE FILE NAME
	JRST	COB101		; OOPS
	CALL	DS4INI
	JRST	FILE1
	JRST	FILE1+1
	CALL	SCNBEG		; START THE WHEELS ROLLING
	MOVE	1,CURPOS	; GET # POSITIONS IN FILE
	MOVEM	1,RECSIZ	; SET HERE
	CALL	NOUT		; EDIT OUT THE NUMBER
	OUTSTR	[ASCIZ/ POSITIONS SCANNED FOR RECORD/]
	OUTSTR	CRLF
	JRST	FILEO		; CLOSE DOWN 
	SUBTTL	BEGIN INTERACTIVE PROCESSING

ENDIT:	SKIPE	1,RECSIZ	; THIS ONE MUST BE ENTERED
	JRST	ENDI2
	P$RINT	<%RECORD SIZE MUST BE ENTERED!>
	JRST	COB101		; REINIT
ENDI2:	MOVSI	4,'TTY'		; LIST FILE IS TTY FOR NOW !
	CALL	DS3INI		; INIT THE DEFAULT LIST DEVICE
	JRST	[P$RINT <?CANNOT INIT DEFAULT LIST DEVICE>
		 HALT .]
	JFCL
	SETZM	CURLIN
	MOVEI	1,5		; SET MODE
	ADDB	1,MODE
	TRNE	F,AFLAG		; ASCII FILE ?
	JRST	ENDI1		; YES -- SKIP THIS
	ADD	1,RECSIZ	; DO A COVERED DIVIDE
	SUBI	1,1		; OFF BY ONE
	IDIV	1,MODE		; 1 = # OF FULL WORDS
	IMUL	1,MODE		; # OF FULL CHARS
	SUB	1,RECSIZ	; 1 = # OF DUMMY RECORDS
	MOVEM	1,DUMMY		; SAVE HERE FOR LATER
	SKIPN	4,BSIZE		; A BLOCK SIZE SPECIFIED ?
	JRST	ENDI1		; NO -- JUST PASS THE DATA LINEARLY
	MOVEM	4,GETREX	; # RECORDS BEFORE DATA SKIP
	MOVEM	4,PUTREX	; HERE FOR PUTREC
	ADD	1,RECSIZ	; 1 = # OF POSITIONS IN REC + DUMMY
	MOVE	3,MODE		; GET THE MODE
	CAIN	3,7		; ASCII ?
	SUBI	3,2		; YES -- 5 CHARS PER WORD
	IDIVI	1,0(3)		; 1 = # OF WORDS THIS REC
	ADDI	1,1		; INCLUDE THE RECORD DESCRIPTOR !!
	IMULI	4,0(1)		; 4 = # WORDS OF GOOD DATA
	SUBI	4,^D128		; 4 = # WORDS OF BAD DATA
	IMULI	4,0(3)		; 4 = # POSITIONS OF SKIPPED DATA
	MOVMM	4,BSIZEC	; SAVE HERE FOR GETREC
ENDI1:	PRINT	<ENTER OUTPUT FILE NAME >
	CALL	SCAN		; SCAN THE FILE NAME TYPED
	JRST	ENDI1		; OOPS -- SOMETHING HAPPENED
	DMOVEM	1,OFN		; SAVE OUTPUT FILE NAME
	DMOVEM	3,OFN+2		; FOR LATER
	SETOM	EOFFLG		; DONE NOTHING YET
	CALL	DS2INI		; INIT THE OUTPUT FILE
	JRST	[P$RINT <?CANNOT INIT DEVICE>
	 JRST	ENDI1]
	JRST	[P$RINT <?CANNOT ENTER FILENAME>
		 JRST	ENDI1]
;	COMMAND PROCESSING

CMDLP:	TRNE	F,COMNFL	; IN A COMMAND ?
	JRST	CMDCLR		; HERE WITH A COMMAND IN PROGRESS -- CLEAR
	OUTSTR	[ASCIZ/ML-/]	; CATCH THE MANIPULATION LANGUAGE COMMANDS
CMDLP1:	CALL 	TTYI
	MOVE	2,[IOWD MLLEN,MLTBL+1]
	CAME	1,0(2)		; IN TABLE ?
	AOBJN	2,.-1		; NO - SEARCH THE TABLE
	TRO	F,COMNFL	; IN A COMMAND
	JUMPL	2,@MLLEN(2)
	CE	<%ILLEGAL COMMAND>

MLTBL:	+	"L"		; LIST
	+	"P"		; PRINT
	+	"F"		; FIND
	+	"R"		; REPLACE
	+	"E"		; EXIT
	+	12		; SET FLAG
	+	15		; AND CR
	+	33		; ALT IS BACKUP !
	+	"D"		; DELETE THE CURRENT RECORD !
	+	"S"		; TYPE THE SCALE
	+	"H"		; HELP
	+	"I"		; INSERT A LINE OR TWO
MLLEN==.-MLTBL
	+	LISTEM
	+	PRINTM
	+	FINDIT
	+	REPIT
	+	EXITIT		; $E
	+	NLINE		; DO THE NEXT LINE
	+	SETCR
	+	LLINE		; DO THE LAST LINE
	+	DLINE		; DO THE DELETE
	+	PSCALE
	+	HELPM
	+	INSERT		; INSERT

HELPM:	OUTSTR	MLHLP		; HELP !
CMDCLR:	SKIPA	1,TTYLST	; GET LAST CHAR TYPED
	CALL	TTYI		; THERE BETTER BE ANOTHER CHAR
	CAIE	1,"Z"-100
	CAIN	1,33
	MOVEI	1,12		; ASSUME THE BEST
	CAIE	1,12		; LF ?
	JRST	CMDCLRI+1
	TRZ	F,COMNFL
	MOVE	P,[IOWD PDLLEN,PDL]
	JRST	CMDLP
	SUBTTL	NEXT LINE AND BACKUP A LINE
SETCR:	TRO	F,GOTCR		; WE HAVE A CR
	JRST	CMDLP1		; CHECK ON NEXT
NLINE:	TRZE	F,GOTCR		; LYING A CR ?
	JRST	CMDLP		; YES -- IGNORE
	AOS	2,CURLIN	; GET CURRENT LINE
	MOVEI	3,1		; # LINES TO PRINT 
	MOVEI	1,15		; DO A CR
	CALL	DS3OUT		; TO THE LIST DEVICE
	HALT	.		; JUST STOP
	JRST	PRINTN		; PRINT THE NEXT LINE

;	BACKUP A LINE

LLINE:	SKIPG	CURLIN		; TO NEXT ?
	JRST	LLAT
	MOVEI	2,CRLF		; DO THIS
	CALL	DS3PRT		; TO THE LIST FILE
	SOS	2,CURLIN
	MOVEI	3,1		; ONLY ONE FLINE
	JUMPG	2,PRINTN	; PRINT IT IF POSSIBLE
LLAT:	P$RINT	<%AT BEGINNING OF FILE>
	JRST	CMDLP

;	SCALE - PRINT OUT THE SCALE

PSCALE:	CALL	SCALE
	JRST	CMDLP
	SUBTTL	EXIT ROUTINES

EXITIT:	CALL	SCAN		; SCAN A FILE NAME
	JRST	CMDLP		; OOPS -- ERROR
	JUMPE	1,.+3		; ANYTHING ?
	DMOVEM	1,OFN		; OUTPUT FILE NAME
	DMOVEM	1,OFN+2		; FOR LATER
	CALL	EXITRT		; ON THE EXIT
	EXIT	1,
	JRST	COBEDT		; ON THE CONTINUE

EXITRT:	CALL	GETREC		; READ A RECORD
	JRST	EXITI0		; ALL DONE
	JRST	EXITRT		; DO FOR ALL

EXITI0:	TRZE	F,JUSTEX	; JUST EXIT ?
	RET			; YES -- NO RENAME
	DMOVE	1,OFN		; 1,2 = FN,EXT
	MOVE	4,OFN+2		; PPN
	SETZ	3,
	RENAME	3,1		; YES -- RENAME THE MAGIC ONE
	CE	<%CANNOT RENAME FILE>
	SETOM	EOFFLG		; AT THE BEGINNING
EXITN:	RET
	SUBTTL	FIND ROUTINES
FINDIT:	TRO	F,FINDFG	; [00] FINDING
	CALL	STRSCN		; SCAN S<STR>$<COL RANGE>
	JRST	CMDLP		; OOPS -- BAD STRING
	TRZE	F,NULLF		; JUST A F ?
	JRST	FINF		; YES -- GO DUMMY THE RANGE
	SKIPGE	16		; OK ?
	CE	<%LINE RANGE MUST BE SPECIFIED>
	CALL	SCANR	
	DMOVEM	2,STARTL	; SAVE FOR BLANK FINDS
FINDI:	HRLI	3,0(2)		; SAVE IN ACW
	MOVE	16,3
	CALL	RECPOS		; POSITION TO THE REQUIRED RECORD
	CE	<%NO SUCH RECORD>
	HRRI	15,0(16)	; 15 = # RECORDS TO LOOK AT
	MOVE	1,FTBL-1(5)	; GET ADDRESS
	MOVEM	1,FJUMP		; OF COMPARISON ROUTINE
	JRST	FIN3		; AND ENTER CORRECTLY
FIN2:	CALL	GETREC		; GET THE RECORD
	JRST	FATEOF		; AT END OF FILE
FIN3:	CALL	@FJUMP		; GO TO RIGHT STRING MATCH
	JRST	FINP		; GO PRINT
	SOJG	15,FIN2		; REPEAT FOR ALL
FATEOF:	P$RINT	<%SEARCH FAILED>
	SKIPE	15		; FALL THROUGH ?
	CALL	EOFRES		; NO -- DO A EOF RESET
	JRST	CMDLP

FTBL:	+	FSIXC		; SIXBIT COMPARE ROUTINE
	+	FASCC		; ASCII
	+	FCOMP		; SINGLE COMP
	[CE 	<%NOT IMPLEMENTED FOR DOUBLE WORD>
	]

FINP:	CALL	PRTREC		; PRINT THE RECORD
	JRST	CMDLP

FINF:	MOVE	2,EOFFLG	; # RECORDS - 2
	ADDI	2,2		; WHERE TO START THE SEARCH
	MOVE	3,STARTL	; GET STARTED LAST
	SUBI	3,0(2)		; WHERE WE ARE NOW = # LEFT
	SUB	3,STARTB
	MOVMS	3
	JRST	FINDI
;	THE COMPARISON ROUTINES FOR THE FILES

FSIXC:	MOVE	1,FDAT		; 1 = POSITION TO MOVE OVER
	IDIVI	1,6		; NOW GET WORD AND SPOT IN WORD
	MOVE	4,[POINT 6,RECSTR]
	ADDI	4,0(1)		; 4 = BP TO START OF MATCH
	SKIPE	2		; ANY SPOTS TO MOVE OVER ?
	IBP	4		; YES -- INC THE BP
	SOJG	2,.-1		; REPEAT AS NEEDED
	MOVE	5,[POINT 7,STRING]
	MOVE	6,FDAT+1	; 6 = # CHARS IN THE MATCH
FSIXC1:	ILDB	1,4		; GET CHAR FROM RECORD
	ILDB	2,5		; AND FROM THE MATCH REQUEST
	TRC	2,40		; CVT FOR A SIXBIT MATCH
	ANDI	2,77		; KEEP THE BOTTOM ONLY
	CAIE	1,0(2)		; A POSITIVE MATCH ?
	AOSA	0(P)		; NOT -- STOP SCAN 
	SOJG	6,FSIXC1		; REPEAT FOR ALL CHARS
	RET			; RETURN AS NEEDED

;	ASCII COMPARE ROUTINE

FASCC:	MOVE	1,FDAT		; DISP IN RECORD REQUESTED
	IDIVI	1,6		; 1 = WORD, 2 = DISP IN WORD
	MOVE	4,[POINT 7,RECSTR]
	ADDI	4,0(1)		; 4 = BYTE POINTER IN CURRENT RECORD
	SKIPE	2		; ANY OFF  ?
	IBP	4		; YES - MAKE UP FOR IT
	SOJG	2,.-1
	MOVE	5,[POINT 7,STRING] ; 5 = WHERE THE MATCH REQUESTED IT
	MOVE	6,FDAT+1	; 6 = # CHARS TO MATCH ON
FASC1:	ILDB	1,4		; GET A CHAR FROM THE RECORD
	ILDB	2,5		; AND FROM THE MATCH
	CAIE	1,0(2)		; EQUAL ?
	AOSA	0(P)		; NO -- EXIT WITH A SKIP RIGHT NOW
	SOJG	6,FASC1		; REPEAT AS NEEDED
	RET			; RETURN AS REQUESTED
;	COMPUTATION COMPARISON ROUTINE

FCOMP:	CALL	CMPSCN		; SCAN A COMP FIELD FOR ACCURACY
	JRST	CMDLP		; OOPS -- ERROR
FCOMP1:	CALL	GETNU1		; SCAN THE NUMBER
	MOVE	1,0(7)		; GET ACTUAL DATA FROM RECORD
	ADDI	7,1		; TO NEXT JUST IN CASE
	CAME	2,1		; SAME ?
	AOSA	0(P)		; NO -- EXIT WITH A SKIP
	SOJG	6,FCOMP1	; YES -- REPEAT FOR ALL
	RET			; RETURN TO CALLER CORRECTLY

;	SCAN A COMP FIELD FOR ACCURACY

CMPSCN:	MOVE	1,FDAT		; 1 = # POSITION THIS FIELD STARTS ON
	IDIVI	1,6		; DETURMINE ITS WORD ADDRESS
	SKIPE	2		; BETTER BE A WORD BOUNDARY !
	CE	<%COMP FIELD MUST BEGIN ON WORD BOUNDARY>
	MOVEI	7,RECSTR(1)	; 7 = WORD ADDR OF COMP DATA
	MOVE	4,FDAT+1	; 4 = # POSITIONS OF COMPARE
	IDIVI	4,6		; GOT TO BE A MULTIPLE OF 6
	SKIPE	5		; ALL OK ?
	CE	<%COLUMN RANGE DOES NOT END AT END OF COMP FIELD>
	MOVE	6,4		; 6 = # WORDS IN SEARCH LOOP
	MOVE	5,[POINT 7,STRING] ; 5 = BP TO DATA
	MOVE	4,[ILDB 1,5]	; 4 = INSTRUCTION FOR NUMBER SCANNING
	AOS	0(P)		; GIVE A SKIP
	RET			; ON RETURN
	SUBTTL	INSERT A LINE

INSERT:	CALL	SCANR		; SCAN THE RANGE
	CAIE	3,1		; ONLY ONE LINE NUMBER PERMITTED
	CE	<%LINE RANGE NOT PERMITTED>
	PUSH	P,14		; SAVE THIS GUY !
	TRZE	F,RECWRT	; DO WE ALREADY HAVE A RECORD ?
INSERL:	CALL	PUTREC		; YES -- MAKE SURE ITS WRITTEN.
	MOVE	16,[POINT 3,POS] ; 16 = START OF STRING SCAN
	MOVE	15,[1,,1]	; 15 = COLUMN RANGE CURRENTLY ON
	MOVE	13,RECSIZ	; DO ALL THE CHARACTERS

INSERX:	CALL	INSET		; MAKE SURE WE SET UP TO A VALID FIELD
	CAIE	14,3		; COMP ?
	JRST	INSER0		; NO -- JUST SIX/ASC
	SUBI	13,6		; YES -- DO FUNNY THINGS
	ADDI	15,6		; TO SAVE A FEW STEPS
	TRNN	15,1		; GOT A SPECIAL FUDGE ?
	ADD	15,[1,,1]	; ** FUDGE **
	JRST	INSER2		; GO DIRECTLY
INSER0:	ILDB	1,16		; GET THE TYPE
	CAIE	1,0(14)		; SAME TYPE AS PREDECESSOR
	JRST	INSER2		; NO
	ADDI	15,1		; INCREMENT COLUMN PPOSITION
INSER1:	SOJG	13,INSER0	; REPEAT UNTIL NO FIND

INSER2:	OUTSTR	[ASCIZ/INSERT: /]
	MOVE	1,TYPTBL-1(14)
	OUTSTR	0(1)		; GIVE THE TYPE
	HLRZ	1,15		; GET STARTING COLUMN
	CALL	NOUT
	MOVEI	1,":"
	OUTCHR	1		; FOLLOWED BY A ":"
	MOVEI	1,0(15)		; THE ENDING COLUMN NUMBER
	SUBI	1,1		; OFF BY ONE
	CALL	NOUT
	SUB	15,[1,,1]	; NOW FOOL REPLACE !
	HLRZM	15,FDAT		; SET STARTING COLUMN
	SUB	15,FDAT		; AND ENDING COLUMN
	HRRZM	15,FDAT+1
	ADD	15,FDAT		; AND CORRECT
	ADD	15,[1,,1]	
	MOVEI	1,">"		; DO THE ">" STUFF
	OUTCHR	1		; TO THE TERMINAL
	TRO	F,SFLAG		; DO A STRING SCAN
	SETZM	TTIBUF##+2	; ZERO THE INPUT BUFF
	CALL	STRSCN		; YOU HAVE TO FOOL THIS GUY TOO
	CAIN	1,33		; ALT ?
	JRST	CRCMDL		; ALL DONE
	TLNN	15,777776	; THE FIRST TIME THROUGH
	CALL	BLTSTR
	CALL	@REPTBL-1(14)	; AND ENTER THE RIGHT ROUTINE
	LDB	14,16		; GET THE NEW MODE
	HRLS	15
	JUMPN	13,INSERX	; REPEAT AS NEEDED
	AOS	EOFFLG		; INCREMENT RECORD WE ARE ON
	AOS	CURLIN		; AND THIS ONE ALSO
	JRST	INSERL		; AND CONTINUE

TYPTBL:	[ASCII "S "]
	[ASCII "A "]
	[ASCII "1 "]
	[ASCII "2 "]

CRCMDL:	OUTSTR	CRLF		; GIVE A CRLF AFTER THE ALTMODE
	POP	P,14		; RESTORE 14
	JRST	CMDLP

INSET:	ILDB	14,16		; GET A TYPE CODE
	JUMPN	14,[SOJA 13,INSET1]
	SOJG	13,INSET	; REPEAT AS NEEDED
	POP	P,0(P)		; LESS THIS CALL ADDRESS
	TLNN	15,777776	; FIRST TIME THROUGH ?
	CALL	BLTSTR		; YES -- ZERO THE REC
	JRST	INSERL

BLTSTR:	MOVE	1,[RECSTR,,RECSTR+1]
	SETZM	-1(1)		; ZERO THE AREA
	BLT	1,<<POSLEN+4>/5>-1+RECSTR
INSET1:	RET
	SUBTTL	REPLACE ROUTINES
;
;	R<STRING>$<COLUMN RANGE>
;

REPIT:	CALL	STRSCN		; SCAN THE FIRST PART OF THE STRING
	JRST	CMDLP		; OOPS -- BAD
	CAIN	1,","		; TRIED TO SPECIFY A RANGE
	CE	<%LINE RANGE NOT PERMITTED>
	CALL	@REPTBL-1(5)	; GO TO THE CORRECT SUBROUTINE
	JRST	CMDLP		; AND RETURN TO CALLER

REPTBL:	+	RSIX		; SIXBIT REPLACE
	+	RASC		; ASCII REPLACE
	+	RCOMP		; COMPUTATIONAL REPLACE
	[CE	<%DOUBLE PRECISION NOT YET IMPLEMENTED>
	]

;	REPLACE SIXBIT/ASCII STRINGS

RSIX:	MOVE	4,[POINT 6,RECSTR]
	MOVEI	3,6		; # CHARS PER WORD
	JRST	RASC1		; GO DO THE SUBSTITUTION
RASC:	MOVE	4,[POINT 7,RECSTR]
	MOVEI	3,5		; # CHARS PER WORD
RASC1:	MOVE	1,FDAT		; POSITION # WE STARTED ON
	IDIVI	1,0(3)		; 1 = WORD, 2 = POSITION IN WORD
	ADDI	4,0(1)		; CORRECT THE BYTE POINTER
	SKIPE	2		; BETWEEN WORDS ?
	IBP	4		; YES
	SOJG	2,.-1
	MOVE	5,[POINT 7,STRING] ; WHERE TO COME FROM
	MOVE	6,FDAT+1	; 6 = # CHARACTERS TO MATCH ON
RASC2:	ILDB	1,5		; GET A CHARACTER
	CAIN	3,6		; SIXBIT ?
	TRC	1,40		; YES
	IDPB	1,4		; SAVE WHILE TRUNCATING HIGH BIT
	SOJG	6,RASC2		; REPEAT FOR ALL
	RET			; ALL OK

;	REPLACE A COMP FIELD WITH THE SPECIFICS

RCOMP:	CALL	CMPSCN		; SCAN THE INPUT PARAMS
	JRST	CMDLP
RCOMP1:	CALL	GETNU1		; TRANSLATE A NUMBER TO BINARY
	MOVEM	2,0(7)		; SAVE IN THE RECORD
	ADDI	7,1		; INCREMENT FOR OTHERS
	SOJG	6,RCOMP1	; REPEAT FOR ALL FIELDS
	RET			; ALL OK
	SUBTTL	PRINT AND LIST ROUTINES

LISTEM:	CALL	SCAN		; PICKUP THE FILE NAME
	JRST	CMDLP
	CALL	DS3INI		; SET UP THE OUTPUT FILE NAME
	CE	<%CANNOT INIT OUTPUT DEVICE>
	CE	<%CANNOT ENTER FILENAME SPECIFIED>
	JRST	CMDLP		; AND RETURN

DLINE:	TRO	F,DFLAG		; WE ARE REALLY DELETING
PRINTM:	CALL	SCANR		; SCAN THE RANGE
PRINTN:	MOVE	15,3		; 15 = # LINES TO PRINT
	HRLI	16,0(2)		; 16 = LH:START LINE #,,RH:# LINES
	CALL	RECPOS		; POSITION TO THAT RECORD
	JRST	ATEOF
	JRST	PRINT2		; NOW EDIT THE RECORD POSITIONED TO
PRINT1:	CALL	GETREC		; READ A RECORD
	JRST	ATEOF		; AT THE EOF
PRINT2:	TRNE	F,DFLAG		; DELETING ?
	TRZA	F,RECWRT	; YES - DO IT !
	CALL	PRTREC		; PRINT A RECORD
	SOJG	15,PRINT1	; REPEAT AS SPECIFIED
	TRZ	F,DFLAG		; WERE WE DELETING ?
	JRST	CMDLP		; NO -- RETURN TO COMMAND MODE

PRINTE:	CE	<%BAD LINE RANGE>
	SUBTTL	EOF ROUTINE

ATEOF:	INCHRS	1		; CLEARA CONTROL O
	JFCL
	TRZ	F,DFLAG		; TURN OFF IF ON
	PRINT	<%EOF ENCOUNTERED >
	PUSH	P,[ CMDLP ]	; NOTE FALL THROUGH

;	EOFRES -- A EOF RESET ROUTINE
		
EOFRES:	INCHRS	1		; CLEAR A CONTROL O
	JFCL
	CALL	DS2CLS		; CLOSE OUTPUT
	CALL	DSKCLS		; AND INPUT
	DMOVE	1,OFN		; GET OUTPUT FILE NAME
	DMOVE	3,OFN+2
	CALL	DSKINI		; INIT INPUT
	JRST	4,.		; IMPOSSIBLE
	JRST	4,.		; LIKEWISE
	DMOVE	1,OFN		; INIT A NEW GENERATION OF OUTPUT
	DMOVE	3,OFN+2
	CALL	DS2INI		
	JRST	4,.		; IMPOSSIBLE UNLESS OVER QUOTE
	JRST	4,.		; LIKEWISE
	CLRBFI			; CLEAR A CONTROL O IF ANY ?
	AOS	1,EOFFLG	; GET THE COUNT
	CALL	NOUT		; DUMP THE NUMBER TO THE TTY
	OUTSTR	[ASCIZ/ RECORDS/]
	OUTSTR	CRLF
	SETOM	EOFFLG		; SET AT END FLAG
	SKIPN	1,BSIZE		; BLOCK FACTOR
	RET
	MOVEM	1,GETREX
	MOVEM	1,PUTREX	; SAVE FOR ROUTINES
	RET
	SUBTTL	GET A RECORD (WHILE PUTTING)

GETREC:	TRZE	F,RECWRT	; DID WE READ A RECORD ?
	CALL	PUTREC		; YES -- WRITE THE OLD BEFOR READING NEW
	MOVE	10,RECSIZ	; GET THE SIZE OF THE RECORD
	TRNN	F,NOACWF	; A INTERNAL ACW ?
	ADDI	10,6		; ** ASSUME A SIXBIT FILE **
	MOVE	7,[POINT 6,RECSTR-1]
	TRNE	F,NOACWF	; AND INTERNAL ACW ?
	ADDI	7,1		; YES -- CORRECT BP
	TRNE	F,AFLAG		; ASCII ?
	HRLI	7,(POINT 7,0)	; YES -- CORRECT 
GETRE1:	CALL	DSKIN		; GET 1 SIXBIT CHARACTER
	JRST	GETRE2		; AT EOF
	IDPB	1,7		; SAVE CHAR
	TRNE	F,AFLAG		; IN AN ASCII FILE
	CAIE	1,12		; YES -- A LF ?
	SOJG	10,GETRE1	; NO FOR ALL - REPEAT FOR ALL
	MOVE	10,DUMMY	; GET # OF FILLERS
	JUMPE	10,.+4
	CALL	DSKIN		; LOSE THEM
	JRST	GETRE2
	SOJG	10,.-2
	TRNE	F,NOACWF	; A INTERNAL ACW PRESENT ?
	JRST	GETREE		; NO -- NO NO VERIFICATION
	SKIPN	1,RECSTR-1	; 1 = SIXBIT DESC -- IS THERE ONE ?
	SKIPN	BSIZE		; DID WE HAVE A BLOCK SIZE ?
	JRST	.+3		; YES -- JUST TELL AND CONTINUE !
	OUTSTR	HMSG		; PRINT THE HOLY MESSAGE
	MOVE	1,RECSIZ	; ASSUME THE GOOD ONE
	HRRZS	1		; KEEP ONLY LOWER HALF FOR ISAM
	CAME	1,RECSIZ	; BETTER COMPARE
	JRST	GETRE3		; TELL US MORE !
GETREE:	AOS	0(P)		; NOT A EOF RETURN !
	AOS	EOFFLG		; CLEAR FLAG + KEEP COUNT OF RECS
	TRO	F,RECWRT	; THERE IS A RECORD TO WRITE
	SOSE	GETREX		; TIME TO DUMMY UP FOR BLOCK ?
	RET			; NO,$E
	MOVE	1,BSIZE		; GET # RECORDS BEFORE ONE OF THESE
	MOVEM	1,GETREX	; SAVE HERE
	SKIPE	10,BSIZEC	; 10 = # CHARS TO PAD - IF ANY
	CALL	DSKIN		; READ
	JFCL
	SOJG	10,.-2
	RET			; AND EXIT
GETRE2:	SUB	10,RECSIZ	; 10 = # CHARS XFERED
	SUBI	10,6		; LESS HEADER WORD
	SKIPN	10		; ANY ?
	RET
	P$RINT	<%INCOMPLETE RECORDS EXIST>
	RET			; EOF EXIT

GETRE3:	OUTSTR	[ASCIZ/?RECORD LENGTH INCORRECT/]
	OUTSTR	CRLF
	OUTSTR	[ASCIZ/DESCRIBED: /]
	MOVE	1,RECSIZ
	CALL	NOUT
	OUTSTR	[ASCIZ/ IS: /]
	MOVE	1,RECSTR-1
	CALL	NOUT
	OUTSTR	CRLF
	HALT	CMDLP
	SUBTTL	SAVE A RECORD (PRIMITIVE)

PUTREC:	MOVE	10,RECSIZ	; # CHARS THIS RECORD TYPE
	TRNN	F,NOACWF	; INTERNAL ACW'S IN FILE ?
	ADDI	10,6		; NO -- ADD ON LENGTH OF DESCRIPTOR
	MOVE	7,[POINT 6,RECSTR-1]
	TRNE	F,NOACWF	; INTERNAL ACW'S IN FILE ?
	ADDI	7,1		; NO -- USE RIGHT WORD
	TRNE	F,AFLAG		; ASCII ?
	HRLI	7,(POINT 7,0)
PUTRE1:	ILDB	1,7		; GET THE CHAR FROM REC
	CALL	DS2OUT		; TO THE OUTPUT FILE
	JRST	PUTERR		; OOPS -- ERROR
	TRNE	F,AFLAG		; ASCII ?
	CAIE	1,12		; AND THE LAST CHAR ?
	SOJG	10,PUTRE1	; NO TO BOTH -- REPEAT FOR ALL
	MOVE	10,DUMMY	; PAD CORRECTLY
	MOVEI	1,0
	JUMPE	10,.+4
	CALL	DS2OUT		; WITH NULLS
	JRST	PUTERR
	SOJG	10,.-2
	SOSE	PUTREX		; TIME TO PAD OUT A BLOCK ?
	RET			; EXIT OK
	MOVE	1,BSIZE		; # BEFORE A BLOCK DONE
	MOVEM	1,PUTREX	; FOR THE PUT ROUTINES
	SETZ	1,		; OUTPUT NULLS
	SKIPE	10,BSIZEC	; 10 = # OF NULLS TO OUTPUT
	CALL	DS2OUT
	JFCL
	SOJG	10,.-2
	RET			; $E
PUTERR:	P$RINT	<?OUTPUT FILE ERROR>
	HALT	.
	SUBTTL	MISC SUBROUTINES
;
;	SCAN A LINE/COLUMN RANGE
;		1/	CHAR THAT TERMINATED SCAN
;		2/	START NUMBER
;		3/	ENDING NUMBER (START # IF OMITTED)
;		
SCANR:	TRNE	F,CHARFL	; LYING A CHARACTER ?
	CALL	SCANC		; NO -- CLEAR THE NECESSARY
	CALL	GETNUM		; GET A NUMBER FROM USER
	MOVE	3,2		; COPY HERE
	CAIN	1,":"		; A COLON TERMINATED GETNUM'S SCAN ?
	CALL	GETNUM		; GET ANOTHER
	EXCH	3,2		; NO -- IN REVERSE ORDER
	SUBI	3,-1(2)		; 3 = # LINES AFTER 1
	JUMPL	3,PRINTE	; OOPS -- ERROR
	RET			; $E


;	NOUT -- OUTPUT A DIGIT TO THE TTY

NOUT:	IDIVI	1,^D10		; DIVIDE TO DECIMAL
	HRLM	2,0(P)		; SAVE IN LH OF STACK
	SKIPE	1		; ANY LEFT ?
	CALL	NOUT		; NO -- DO A RECURSIVE CALL
	HLRZ	1,0(P)		; GET BACK THE NUMBER
	ADDI	1,"0"		; TO DECIMAL
	OUTCHR	1		; TO TTY
	RET			; $E
;	DECIMAL EDITING ROUTINE  (1 = #)

DECOUT:	MOVE	2,1		; SAVE ACROSS CALL
	A$DIT	APKT		; ENTER ASCII EDIT MODE
	MOVE	1,2		; AND RESTORE
	MOVEI	2,^D12		; 12 DIGIT FIELD
	TRNE	F,FOURFG	; ONLY 4 DIGITS ?
	MOVEI	2,4
	A%DECF
	MOVEI	1,0		; EDIT IN A NULL
	A%CHAR
	MOVE	2,[POINT 7,IM]	; NOW COPY THE NUMBER OVER
	ILDB	1,2
	JUMPE	1,.+4
	CALL	DS3OUT
	HALT	.		; NO WAY THIS SHOULD HAPPEN
	JRST	.-4		; REPEAT FOR ALL
	RET

;	POSITION TO THE RECORDS SPECIFIED IN 16

RECF:	CAIN	3,1(2)		; THIS RECORD IN ALREADY ?
	JRST	RECPO2		; YES -- NO NEED FOR FIND
	TRO	F,JUSTEX	; INSURE A COPY
	CALL	EXITRT
	CALL	EOFRES		; EOF RESET ON FILE
RECPOS:	HLRZ	3,16		; GET RECORD NUMBER
	MOVE	2,EOFFLG	; GET CURRENT RECORD
	CAIGE	3,1(2)		; POSITION BACKWARDS REQUIRED ?
	JRST	RECF		; YES
	SUBI	3,1(2)		; 3 = # RECORDS TO POSITION AHEAD
	JUMPE	3,RECPO2	; ANY TO MOVE ?
	CALL	GETREC		; YES -- LET GETREC DO IT
	RET			; AT EOF !
	SOJG	3,.-2		; REPEAT FOR ALL
RECPO2:	AOS	0(P)		; SKIP IF ALL OK
	RET			
;	COMPUTE A BYTE POINTER BASED ON INPUT DATA

BITFIG:	SUBI	12,0(1)		; 12 = # BITS LEFT THIS WORD OF DATA
	JUMPL	12,BITN		; EXHAUSTED ?    YES,BITN
	MOVEI	6,0(12)		; 6 = CREATED BYTE POINTER
	ADDI	6,0(1)		; CORRECT FOR THE SUBTRACT
	LSH	6,^D6		; P IS MOVED PREPARE FOR S
	ADDI	6,0(1)		; ADD ON S (# BITS THIS BYTE)
	LSH	6,^D6+^D18
	ADDI	6,0(11)		; ADD ON CURRENT ADDRESS
	CAIN	1,^D36
	JRST	BITX1		; COMPHENSATE 
	CAME	1,[^D72,,^D36]	; [00] COMP 2 ?
	RET			; 6 = BYTE POINTER
BITX2:	MOVEI	2,^D11		; # LEFT IN POS TABLE
	AOJA	11,.+2
BITX1::	MOVEI	2,^D5
	IBP	10		; POSITION TO NEXT WHATEVER
	SOJG	2,.-1
	RET			; $E
BITN:	MOVEI	12,^D36		; GET SET FOR NEXT WORD
	AOJA	11,BITFIG	; INCREMENT FOR NEXT WORD

;	UUOH -- HANDLE THE PRINT UUO'S

UUOH:	SOS	1,0(P)
	HRRZ	2,0(1)		; GET THE TEXT ADDRESS
	OUTSTR	0(2)		; PRINT THE MESSAGE
	OUTSTR	CRLF
	LDB	2,[POINT 7,0(2),6] ; GET FIRST CHAR IN MSG
	CAIN	2,"?"		; A STOPCODE ?
	HALT	.		; YES -- HALT
	LDB	2,[POINT 9,0(1),8]
	CAIE	2,3		; FROM COBOL FD SCANNER ?
	JRST	@UUOHT-1(2)	; RETURN TO PROPER ROUTINE
	OUTSTR	RECSTR		; OUTPUT THE BAD LINE
	OUTSTR	CRLF		; AND A CRLF
	JRST	SCNBEG		; AND TRY TO CONTINUE

UUOHT:	+	COBCLR		; ERRS
	+	CMDLP		; ERRC
;	SCAN A STRING OF THE FORMAT <C><STR>$<COLUMN RANGE>

STRSCN:	MOVEI	5,STRLEN	; MAX LENGTH OF STRINGS
	MOVE	4,[POINT 7,STRING]
	TRZE	F,FINDFG	; [00] FINDING (MAYBE FOR A SECOND TIME)
	JRST	FIN0		; [00] YES -- DON'T ZERO THE DATA
	MOVE	1,[ASCII "     " ]
	MOVEM	1,STRING	; PUT IN BLANKS !
	MOVE	1,[STRING,,STRING+1]
	BLT	1,<<STRLEN+4>/5>-1+STRING
FIN0:	CALL	TTYI		; READ A CHARACTER
	CAIN	1,15		; CR ?
	JRST	FIN0		; YES - IGNORE
	CAIN	1,12		; LF ?
	JRST	FIN12		; YES - DO NOT RESET ANYTHING
	IDPB	1,4		; 4 = STRING BYTE PTR
	CAIN	1,33		; MUST BE AN ALTMODE
	JRST	FIN1		; IT IS
	CAIN	1,"Z"-100
	TDZA	5,5
	SOJG	5,FIN0		; SCAN AS MANY AS REQUIRED
	OUTSTR	CRLF
	CE	<%STRING TOO LONG>

FIN1:	SUBI	5,STRLEN	; 5 = -LENGTH OF STRING
	MOVMM 	5,STRSIZ	; SAVE THE SIZE
	TRZE	F,SFLAG		; FROM A INSERT STRING SCAN ?
	RET			; YES -- RETURN NOW WITH NO COLUMN RANGE
	PRINT	< COLUMN RANGE >
	CALL	SCANR		; READ THE RANGE
	SETZM	16		; 16 = FLAG REG FOR LINE RANGE
	CAIE	1,","		; COMMA ?
	SOJ	16,
	SOS	2		; 2 = STARTING POSITION
	DMOVEM	2,FDAT		; FDAT = STARTING POS, FDAT+1 = # POSITIONS
FIN10:	IDIVI	2,^D12		; 2 = WORD POSITION, 3 = CHAR IN WORD
	ADD	2,[POINT 3,POS]	; INTO A BYTE PTR
	SKIPE	3		; PRESENT ?
	IBP	2		; NO -- CORRECT FOR NON WORD BOUNDARY
	SOJG	3,.-1		; REPEAT UNTIL MATCHED
	MOVEM	2,FDAT+2	; FDAT+2 = START OF DESCRIPTORS
	MOVE	4,FDAT+1	; 4 = # POSITIONS IN RANGE
	ILDB	5,2		; 5 = TYPE OF STRING
	SOJLE	4,.+5		; DON'T DO IF SINGLE CHARACTER
	ILDB	1,2		; GET NEXT CHAR
	CAIE	1,0(5)		; MATCH FIRST ?
	CE	<%MATCH MAY NOT INVOLVE DIFFERENT DATA TYPES>
	SOJG	4,.-3		; ALL DATA TYPES THE SAME ?
	AOS	0(P)		; SKIP FOR OK
	RET

FIN12:	TRNE	F,SFLAG		; A STRING SCAN FROM INSERT ?
	JRST	FIN1		; YES -- COMPUTE CC AND EXIT
	CAIE	5,STRLEN	; TYPED ANYTHING ?
	CE	<%NO MATCH PERMITTED>
	TRO	F,NULLF		; NULL STRING -- JUST CONTINUE
	DMOVE	2,FDAT		; GET THE OLD
	JRST	FIN10		; AND ENTER
	SUBTTL	PRINT OUT A PRINT PAGE

PRTREC:	MOVE	10,[POINT 3,POS] ; 10 = POSITION TABLE ADDRESS
	MOVEI	11,RECSTR	; 11 = WHERE THE DATA IS
	MOVEI	12,^D36		; 12 = BIT POINTER IN DATA WORD !
	MOVE	13,RECSIZ	; # CHARS THIS RECORD
	MOVE	1,EOFFLG	; GET RECORD # - 2
	ADDI	1,1		; OFF BY 1
	MOVEM	1,CURLIN	; THE CURRENT LINE NUMBER
	TRO	F,FOURFG	; 4 DIGITS TO DECOUT
	CALL	DECOUT		; TO LIST DEVICE
	TRZ	F,FOURFG
	MOVEI	2,[ASCII/. /]	; PRINT 
	CALL	DS3PRT		; GO PRINT
PRTRET:	ILDB	1,10		; GET A POSITION TYPE
	JRST	@PRTCMD(1)	; DISPATCH PROPERLY
	
PRTCMD:	+	PRTSKP		; DO NOTHING - SKIP
	+	PRTSIX		; PRINT SIXBIT
	+	PRTASC		; PRINT ASCII
	+	PRTCOM		; PRINT COMPUTATIONAL
	+	PRTCM2		; PRINT COMP-2

PRTSKP:	MOVE	1,MODE		; GET THE MODE OF THE FILE
	CALL	BITFIG		; ADVANCE CORRECTLY
	ILDB	1,6		; MAKE SURE WE HAVE THE CHAR !
PRTREB:	TRNE	F,AFLAG		; ASCII ?
	CAIE	1,12		; LF GIVEN ?
	SOJG	13,PRTRET	; CONTINUE ?  YES,PRTRET
	MOVEI	2,CRLF		; THE CRLF SEQUENCE
	CALL	DS3PRT
	RET

;	PRINT OUT THE SCALE

SCALE:	SKIPN	FMT		; FORMAT BEE BUILT YET ?
	CALL	SETHED		; NO -- GO BUILD THE HEADERS
	MOVEI	2,FMT
	CALL	DS3PRT
	MOVEI	2,FMT1
	CALL	DS3PRT		; PRINT THE HEADERS
	RET
PRTSIX:	MOVEI	1,6		; 6 BITS OF DATA
	CALL	BITFIG		; FIGURE OUT BIT PATTERN
	ILDB	1,6		; GET THE CHAR
	CAIL	1,'A'		; CVT TO ASCII
	CAILE	1,'Z'
	TRCA	1,40		; CVT TO ASCII
	TRC	1,140		; YES -- CVT CORRECTLY
PRTSI1:	CALL	DS3OUT		; AND PRINT
	HALT	.		; CANNOT HAPPEN
	JRST	PRTREB		; EXIT FOR NEXT

PRTASC:	MOVEI	1,7		; DO A ASCII FIELD
	CALL	BITFIG		; CREATE A BYTE PTR
	ILDB	1,6		; 1 = CHAR
	CAIE	1,15		; LF ?
	CAIN	1,12		; CR ?
	JRST	PRTREB		; YES -- DON'T PRINT
	JRST	PRTSI1		; AND EDIT IT OUT

PRTCOM:	MOVEI	1,^D36		; 36 BIT CHUNKS
	CALL	BITFIG		; BUILD A BYTE POINTER
PRTCO1:	ILDB	1,6		; GET THE FULL WORD
	CALL	DECOUT		; CVT TO DECIMAL
	SUBI	13,5		; 6 CHARS PER WORD
	JUMPG	13,PRTREB	; ALL OK ?
	P$RINT	<%A COMP FIELD IS LARGER THAT RECORD SIZE>
	HALT	.

PRTCM2:	MOVE	1,[^D72,,^D36]	; [00] 36 BIT BYTES
	CALL	BITFIG		; DETERMINE BYTE PTR
	ILDB	1,6		; GET WORD
	CALL	DECOUT		; CVT TO DECIMAL
	MOVEI	1,"/"		; SEP WITH A SLASH
	CALL	DS3OUT	
	HALT	.		; [00] DON'T FORGET THIS !
	SUBI	13,6		; DECREASE SIZE OF FIELD
	JRST	PRTCO1		; AND DO LAST WORD

DS3PRT:	HRLI	2,(POINT 7,)
	ILDB	1,2		; GET CHAR
	JUMPE	1,.+4
	CALL	DS3OUT		; TO OUTPUT DEVICE
	HALT	.		; ON ERROR
	JRST	.-4
	RET			; RETURN
;	BUILD THE HEADERS FOR PRETTY OUTPUT

SETHED:	MOVE	1,[FMTLEN,,FMT]	; THE FIRST HEADER
	MOVEM	1,APKT		; INTO THE EDIT PACKAGE
	A$DIT	APKT
	A$FD2	[ASCIZ/REC # /]
	MOVE	5,RECSIZ	; GET THE RECORD SIZE
	TRNE	F,AFLAG		; ASCII ?
	MOVEI	5,^D132		; ASSUME MAX HERE
	MOVE	4,[POINT 3,POS]	; 4 = THE POSITION DESCRIPTORS
	ILDB	1,4		; GET A DESCRIPTOR
	JUMPN	1,.+3		; A ENTRY ?
SETHE1:	SOJG	5,.-2		; REPEAT FOR ALL
	JRST	SETHE2		; NEXT STAGE
	MOVE	1,SETTBL-1(1)	; GET THE DEMARKATION CHARACTER
	A%FD1			; EDIT IN THE CHAR(S)
	JRST	SETHE1		; AND COUNTINUE
SETTBL:	ASCII	/S/		; SIXBIT
	ASCII	/A/		; ASCII
	ASCII	/ 1/		; SINGLE PRESCISION BINARY
	ASCII	/ 2/		; DOUBLE PRECISION BINARY
SETHE2:	A$LINE
	A$CHAR			; A NULL
	MOVE	1,[FMTLEN,,FMT1]
	MOVEM	1,APKT		; SET FOR NEXT LINE
	A$DIT	APKT
	A$POS	6		; ROOM FOR THE RECORD #
	MOVE	3,[POINT 3,POS]	; 3 = DESCRIPTOR TABLE POINTER
	MOVEI	4,1		; 4 = WHAT POS WE ARE ON MOD 10
	MOVE	6,RECSIZ	; RECORD SIZE
	TRNE	F,AFLAG
	MOVEI	6,^D132
SETHE3:	ILDB	2,3		; GET POS TABLE DESCRIPTOR
	JUMPE	2,SETHE4	; ANY DESCRIPTION ?
	IDIVI	4,^D10		; MOD 10 (5 = POSITION)
	MOVEI	1," "		; CHECK FOR COMP STUFF
	CAIL	2,3		; ?
	A%CHAR			; YES -- INSERT THAT EXTRA SPACE
	MOVEI	1,"0"(5)	; CVT TO ASCII
	A%CHAR			; AND EDIT IT IN
	AOS	4,5		; TO NEXT AND LOAD FOR DIVIDE
SETHE4:	SOJG	6,SETHE3	; REPEAT FOR ALL POSITIONS
	A$LINE
	A$CHAR			; 
	MOVE	1,[IML,,IM]
	MOVEM	1,APKT		; SET UP EDIT PACKET FOR NEXT PASS
	RET			; $E
	SUBTTL	LITERALS AND HELPS - NOT LISTED
%%=.
	XLIST
	LIT
FDHLP:	ASCIZ/
RECORD N	- THE SIZE OF THE RECORD
BLOCK N 	- THE # OF RECORDS PER 128 WORD BLOCK
NOACW		- THE FILE CONTAINS NO INTERNAL COBOL ACCESS WORDS
FD <FILE.EXT>	- SCAN THE FD GIVEN INTO INTERNAL FORMAT
SIXBIT M:N[,M:N]- SPECIFY SIXBIT FIELD SPECS
ASCII M:N[,M:N]	- SPECIFY ASCII FIELD SPECS
COMP M,N	- SPECIFY COMPUTATIONAL FIELDS
COMP-2 M,N	- SPECIFY DOUBLE PRECISION COMP FIELDS
		- (NOTHING) PROCEED TO MANIPULATION LANGUAGE
/
MLHLP:	ASCIZ/
D<R>		- DELETE A RECORD
E<FILE.EXT>	- EXIT NAME THE FILE (OPTIONAL FN)
F<STR>$<COL>,<R>- FIND THE STRING GIVEN IN THE COLUMNS AND RECORDS SPECIFIED
L<FILE.EXT>	- LIST ALL OUTPUT TO THE FILE GIVEN
R<STR>$<COL>	- REPLACE THE COLUMNS SPECIFIED WITH THE STRING GIVEN
S		- TYPE THE SCALE FOR THE RECORD GIVEN
$		- (ALTMODE) MOVE UP A RECORD
LF		- (LINEFEED) MOVE DOWN A RECORD
/
	LIST
%%=.-%%
	SUBTTL	COBEDT DATA AREA

HMSG:	ASCII	"%FILE IS BLOCKED WITH NULL RECORDS "
CRLF:	BYTE	(7)15,12
	
	RELOC	0

APKT:	A$PKT	IML,IM
PICTAB:	+	'9',,-1		; NUMERIC
	+	'A',,-1		; ALPHABETIC
	+	'X',,-1		; GENERAL
	+	'Z',,-1		; ZERO FILLED
	+	'C',,PICCR	; CREDIT
	+	'D',,PICDB	; DEBIT 
	+	'(',,PICREP	; MULTIPLE WHATEVERS
PICLEN==.-PICTAB
	Z			; FALL THROUGH
ZEROB:				; START OF AREA TO ZERO ON START
MODE:	Z			; THE MODE OF THE FILE (6 OR 7)
LENGTH:	Z			; # OF POSITIONS OCCUPIED BY A PIC STRING
OLDCHR:	Z			; LAST CHARACTER SEEN (SCANNED) FROM DS4IN
TIMES:	Z			; # TIMES TO REPEAT PICTURE STRING
PDL:	BLOCK	PDLLEN		; PDL
STARTL:	Z			; WHERE WE STARTED IN FIND
STARTB:	Z			; AND # LINES WE DID
CURLIN:	Z			; CURRENT USER LINE
BSIZE:	Z			; # OF RECORDS PER BLOCK
BSIZEC:	Z			; # OF POSITIONS TO DUMMY OUT THIS BLOCK
GETREX:	Z			; # OF RECORDS LEFT IN GETREC
PUTREX:	Z			; # OF RECORDS LEFT THIS  BLOCK IN PUTREC
RECSIZ:	Z			; SIZE OF RECORD IN POSITIONS
	Z			; ** SIXBIT RECORD SIZE **
RECSTR:	BLOCK	<POSLEN+6>/5	; MAX SIZED RECORD GOES HERE
POS:	BLOCK	<POSLEN+5>/^D12	; BIT MASK FIELD
CURPOS:	Z			; CURRENT POSITION IN RECORD
OFN:	BLOCK	4		; OUTPUT FILE NAME FN,EXT,PPN,DEV
EOFFLG:	Z			; -1 => AT EOF
STRSIZ:	Z			; SIZE OF STRING
STRING:	BLOCK	<STRLEN+4>/5	; WHERE THE STRING COMPARE GOES
NUMBER:	Z			; FOR COMP  AND
	Z			; COMP-1 FIELDS
FMTLEN==<POSLEN+4>/5
FMT:	BLOCK	FMTLEN		; FORMAT HEADER # 1
FMT1:	BLOCK	FMTLEN		; FORMAT HEADER # 2
IML==<132+4>/5
IM:	BLOCK	IML
FJUMP:	Z			; JUMP ADDRESS FOR ROUTINES
FDAT:	BLOCK	3		; 0 = START IN POS TABLE
DUMMY:	Z			; # OF PAD CHARS THIS REC
				; 1 = # POSITIONS
ZEROE:	Z			; END OF ZERO AREA
	END	COBEDT