File DIBOLQ.QS

Directory of image this file is from
This file as a plain text file

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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search