START ;  THIS IS DIBOL 8 TO QBOL 8 CONVERSION
 SPACE 3
 RECORD ,C	;SO WE CAN CRACK THE LENGTH
	BIN,	B1
  RECORD DIBOL,C	;THE BUFFER FOR DIBOL INPUT LINE
	DBUFF, A120	;ASSUME MAX LENGTH IS 120 CHARS
 SPACE 1
  RECORD QBOL,X
	MBUFF,	A2  ;SKIP THE LINE NUMBER
	,	A118
 RECORD ,X
	MBUFF2, 120A1
 SPACE 3
			;****MISCELLANEOUS VARIABLES
  RECORD ,C
	N,	D4
	M,	D4
	K,	D4		;(FORTRAN ALWAYS SHINES THROUGH))
	L,	D4
	CHARS,	D4	;NUMBER OF CHARS IN LINE
	DIFN,	D2	;INTERNAL FILE NUMBER FOR INPUT
	MIFN,	D2	;INTERNAL FILE NUBER FOR OUTPUT
	LINECNT,D4	;COUNT TOTAL LINES OUT
	DEVICE,	A4,'SYS '  ;1	;A LIST OF DEVICES FOR ERROR CONDIDTION
	,	A4,'DSK '  ;2
	,	A4,'CHN0'  ;3
	,	A4,'CHN1'  ;4
	,	A4,'CHN2'  ;5
	,	A4,'CHN3'  ;6
	,	A4,'RXA0'  ;7
	,	A4,'RXA1'  ;8
	,	A4,'RXA2'  ;9
	,	A4,'RXA3'  ;10
	,	A4,'LPT '  ;10
	,	A4,'TTY ' ;11
	,	A4,'SLU2'  ;12
	,	A4,'SLU3' ;13
	,	A4,'LQP '  ;14
	,	A4,'QLP ' ;15
	,	A4,'CDR '   ;16
	,	A4,'TTY3'  ;17
	,	A4,'TTY4'  ;18
 SPACE 2
 RECORD ,C
	OPENSTRING, A14
 RECORD ,X
	TYPE,	D2	;OPEN STRING (TYPE IS 0-15 ASCII, BIN, IN OUT ETC)
	IFN,	D2	;INTERNAL FILE NUMBER
	EDN,	D2	;EXTERNAL DEVICE NUMBER
	NAME,	A8	;FILE NAME
 SPACE 3
  RECORD TTY,C	;FOR TTY IO
	TTYIN,	A80
 RECORD ,X
	ONE,	A1
 PROC  ;DIBOL TO QBOL
 SPACE 3
		;THIS IS A CHEAPY..USE THE DEFAULT DEVICES THAT ARE
		;AUTOMATICALLY OPEN I.E. IFN 6=LPT 7=TTY IN 8 =TTYOUT
 SPACE 1
	DIFN=1	;INTERNAL FILE NUBER FOR DIBOL FILE
	MIFN=2
 SPACE 2
	XMIT(8,"TURN PRINTER ON PLEASE')
	XMIT(6,"DIBOL TO QBOL SOURCE CONVERSION')
 SPACE 2
 BEGIN,
	CALL GETIN   ;GET INPUT FILE 
	CALL GETOUT  ;GET OUTPUT FILE NAME
 SPACE 3
			;O.K., LET US STOP FOOLING AROUND AND DO IT
	LINECNT=	;COUNT THE LINES
 LOOP,
	XMIT(DIFN,DIBOL,EOF)  ;RERAD THE FIRST LINE
 SPACE 1
				;CHECK FOR THE LENGTH
	CHARS=-BIN(2)	;THIS WILL BE -(#WORDS)
	CHARS=CHARS+CHARS  ;FASTER THAN MULTIPLY
 SPACE 1
			;O.K. DO THE CONVERSION
	MBUFF=		;CLEAR THE LINE NUMBERS
 SPACE 1
		;WHY NOT BE NICE AND FIND THE *TRACE* , *,P* ,AND *INIT* STATEMENTS
	M=2  ;SKIP OLD LINE NUMBER
 LOOP2,
	INCR M
		;USE THE # OPERATOR 'CAUSE IT IS FASTER
	IF(#MBUFF2(M).EQ.#';') GO TO OUTIT   ;COMMENTS NOW
 SPACE 2
	IF(#MBUFF2(M).EQ.#'T') GOTO TRACECKECK
 NOTRACE,
	IF(#MBUFF2(M).EQ.#'I') GO TO INITCHECK
 NOINIT,
	IF(#MBUFF2(M).EQ.#'P') GO TO COMMAPEE
 NOCOMMA,
	IF(#MBUFF2(M).EQ.#'O') GO TO CHKERR  ; ON ERROR?
 NOERR,
	IF(#MBUFF2(M).EQ.#'C') GO TO CHKCHAIN  ;CHIAN??
 NOCHAIN,
	IF(#MBUFF2(M).EQ.#'<') GO TO COND   ;CONDITIONAL
	IF(#MBUFF2(M).EQ.#'>') GO TO COND	;CONDITIONAL
 SPACE 1
	IF(M.LT.CHARS) GO TO LOOP2
 SPACE 1
			;ALL LOOKED AT
 OUTIT,
	XMIT(6,QBOL)
	FORMS(6,1)
	XMIT(MIFN,QBOL)  ;OUT IT GOES..(WAS OPENED NO BLANK FILL SO ALL O.K.
	INCR LINECNT
	GO TO LOOP	;NEXT LINE
 SPACE 3
 TRACECHECK,
			;IS  THIS THE TRACE STATEMENT?
	IF(MBUFF(M,M+4).NE.'TRACE') GOTO NOTRACE
			;HO HO
	XMIT(6,"*****POSSIBLE TRACE STATEMENT*****')
	GO TO OUTIT
 SPACE 2
 INITCHECK,
	IF(MBUFF(M,M+3).NE.'INIT') GOTO NOINIT
			;AH HA
	XMIT(6,"****************INIT***************')
		;BUT WRITE IT ANYWAY
	GO TO OUTIT
 SPACE 3
 COMMAPEE,
	IF(M.EQ.1) GO TO NOCOMMA
	IF(MBUFF(M-1,M).NE.',P') GOTO NOCOMMA
	XMIT(6,"*********, P HERE*******')
	GO TO OUTIT
 SPACE 3
 COND,		;CONDITIONAL COMPILATION
	XMIT(6,"******CONDITIONAL COMPILATION ?**********')
	GO TO OUTIT
 SPACE 3
  CHKERR,
	IF(MBUFF(M,M+1).NE.'ON') GO TO NOERR
	IF(MBUFF(M,M+7).NE.'ON ERROR') GO TO NOERR
	XMIT(6,"********ON ERROR***********')
	GO TO OUTIT
 SPACE 3
 CHKCHAIN,
	IF(MBUFF(M,M+4).NE.'CHAIN') GO TO NOCHAIN
	XMIT(6,"******** CHAIN ***********')
	GO TO OUTIT
 SPACE 3
 EOF,
			;WE READ THEM ALL
	XMIT(6,"***EOF FOUND****')
	XMIT(8,"EOF FOUND')
	FINI(DIFN)	;SHUT IT DOWN
 SPACE 2
				;MORE SEGMENTS
 EOF1,
	XMIT(8,"DO YOU HAVE MORE PROGRAM SEGMENTS TO ADD TO THIS SOURCE?')
	XMIT(7,TTY)
	IF(TTYIN(1,1).EQ.'N') GO TO EOF2
	IF(TTYIN(1,1).NE.'Y') GO TO EOF1
		;WE HAVE MORE
	CALL GETIN
	GO TO LOOP
 SPACE 1
 EOF2,
	FINI(MIFN)	;END OF NEW FILE
 SPACE 2
	TTY=
	TTYIN='QBOL FILE HAS #LINES='
	TTYIN(26,30)=LINECNT
	XMIT(8,TTY)
 SPACE 2
 ASK9,
	FORMS(6,0)
	XMIT(8,"MORE TO CONVERT?')
	XMIT(7,TTY)
	IF(#ONE.EQ.#'Y') GO TO BEGIN
	IF(#ONE.NE.#'N') GOTO ASK9
	XMIT(8,"OOOOOOOOOK')
	XMIT(8,"NORMAL END TO DIBOLQ.QB')
	STOP
 SPACE 3
 NONEW,
	XMIT(8,"UNABLE TO OPEN FILE FOR OUTPUT ???')
	XMIT(8,"VERY WEIRD I SAY.....WILL STOP')
	STOP
 SPACE 3
 GETIN,			;GET INPUT FILE
	XMIT(8,"PLEASE ENTER EXTERNAL DEVICE NUMBER FOR DIBOL SOURCE FILE')
	ON ERROR GETIN
	XMIT(7,TTY)
	EDN=TTYIN(1,2)
	ON ERROR
 SPACE 2
 GETI2,
	XMIT(8,"PLEASE ENTER THE FILE NAME NNNNNN.XX')
	ON ERROR GETI2
	XMIT(7,TTY)
	IF(TTYIN(7,7).EQ.'.') TTYIN(7,8)=TTYIN(8,9)
	NAME=TTYIN(1,8)
 SPACE 1
		;O.K. LET US OPEN IT UP
	IFN=DIFN  ;SET INTERNAL FILE NUMBER
	TYPE=16  ;BINARY FILE INPUT (WITH WEIRDO LINE #S)
	ON ERROR NOFILE
	OPEN(OPENSTRING)
	ON ERROR
	XMIT(8,"INPUT FILE FOUND')
	RETURN
 SPACE 3
 NOFILE,
	ON ERROR
	XMIT(8,"SORRY CANNOT FIND THE FILE....')
	DISPLAY(0,0,'OPEN CALL WAS :')
	DISPLAY(0,0,OPENSTRING)
	FORMS(8,1)
	XMIT(8,"WHICH DECODES AS:')
	XMIT(8,"FILE INPUT: EXISTING BINARY')
	XMIT(8,"INTERNAL FILE NUMBER=1')
	TTY=
	TTYIN='EXTERNAL DEVICE='
	TTYIN(18,19)=EDN
	ON ERROR NOFL2
	TTYIN(21,24)=DEVICE(EDN+1)
 NOFL2,
	ON ERROR
	XMIT(8,TTY(1,26))
	TTY=
	TTYIN='FILE NAME='
	TTYIN(11,16)=NAME(1,6)
	TTYIN(17,17)='.'
	TTYIN(18,19)=NAME(7,8)
	XMIT(8,TTY(1,22))
	GO TO GETIN
 SPACE 3
 GETOUT,			;OUTPUT FILE HERE
	IFN=MIFN
	TYPE=09  ;NEW FILE, ASCII, NO BLANK FILL (SAVE SPACE JACK)
	XMIT(8,"GIVE EXTERNAL DEVICE NUMBER FOR OUTPUT FILE:')
	XMIT(7,TTY)
	ON ERROR GETOUT
	EDN=TTYIN(1,2)
	ON ERROR
 SPACE 1
	NAME(7,8)='QS'
	ON ERROR NONEW
	OPEN(OPENSTRING)
	ON ERROR
	TTY=
	TTYIN(1,4)='FILE'
	TTYIN(6,11)=NAME(1,6)
	TTYIN(12,12)='.'
	TTYIN(13,14)=NAME(7,8)   ;REALLY GROSS CODING
	TTYIN(16,50)='OPEN FOR OUTPUT ON DSK:'
	XMIT(8,TTY)
	XMIT(6,TTY)
	FORMS(6,4)
	RETURN
 END