.TITLE	TEXT
/
/   4 FEB 77 (012; PDH) CHANGE 'MOVE' STRATEGY FOR F4, FCN=2
/   3 FEB 77 (010; PDH) ALLOW ONLY INTEGER*2 VARIABLES IN F4
/   1 FEB 77 (009; PDH) CONVERT TO XVM/RSX
/  12 JAN 76 (PDH) CONVERT TO USE NEW ROUTINES 'DSPLAY' AND 'D.FIND'
/  11 MAR 74 - CHANGE WATRAN GENERAL ERROR TO '66' FROM '65'
/  31 DEC 73 - RETRO-FIT TO DEC FORTRAN, USING NEW WATRAN CALLING SEQUENCE
/  27 SEP 73 - ALLOW VERTICAL CHARACTER STRING AFTER '^'
/  23 MAY 73 - FIX UP RETURN FROM FCN 1 & 4
/  22 MAY 73 - FUDGE UP OTABLE DIMENSION INFORMATION (1ST ON SYSTEM)
/  18 MAY 73 - PAUL HENDERSON - COMPLETE RE-WRITE FOR WATRAN
/
/  NORMAL ASSEMBLY IS FOR WATRAN.  TO ASSEMBLE FOR DEC FORTRAN, THE SYMBOL
/
/F4=1		/ MUST BE DEFINED.
/
X10=10
X16=16
X15=15
IDX=ISZ			/ INDEX POINTER, SKIP NOT EXPECTED
MM=100000		/DATA MODE MULTIPLIER
OP=10000		/INTERPRETER OP CODE MULTIPLIER
/
/  MNEMONICS FOR VT15 INSTRUCTIONS
/
BKOFF=	211000
CHRI=	     0
CHRS=	040000
DJMP=	600000
EDGOFF=	210200
ESCR=	216000
INT0=	202000
LPON=	210004
OSETF=	210002
PTX=	144000
PTY=	140000
ROTOFF=	210040
SCALE=	200020
/
	.EJECT
	.IFDEF	F4
	.IODEV	4	/DEC FORTRAN DOES NOT SUPPORT CHARACTER I/O
	.ENDC
/
/  EXTERNAL GLOBALS:
/
	.IFUND	F4
	.GLOBL	.INTRP,.FETCH,.PSHBA,.INT2,.POINT,.NEXT,.NERR
	.ENDC
	.IFDEF	F4
	.GLOBL	.DA,.FW,.FE,.FF,.FQ,.FN
TTO=3
OP=0
	.ENDC
	.GLOBL	DSPLAY,D.FIND
/
/  INTERNAL GLOBALS
/
	.GLOBL	TEXT
/
	.EJECT
TEXT	XX
	.IFDEF	F4
	JMS*	.DA
	JMP	BYPASS		/JUMP PAST VITAL ARGUMENTS
FCN
ITAG
IX
IY
INT
ISCALE
FORMAT
BYPASS	NOP
	.ENDC
	.IFUND	F4
	DZM	CALLED		/INDICATE INTERPRETER NOT YET CALLED
	JMS	INTARG		/ FCN
	.ENDC
	.IFDEF	F4
	LAC*	FCN
	.ENDC
	DAC	FCN		/SAVE FOR FCN=3 CASE
	SPA!SNA
	JMP	FCNERR		/ FCN.LT.1
	AAC	-4
	SMA!SZA
	JMP	FCNERR		/ FCN.GT.4
	TAD	(JMP DSPCH+4	/ENTRY TO JUMP TABLE
	DAC	DSPCH
/
	.IFUND	F4
	JMS	INTARG		/ ITAG
	.ENDC
	.IFDEF	F4
	LAC*	ITAG
	.ENDC
	DAC	ITAG
DSPCH	XX
	JMP	FCN1		/CHANGE COORDINATES ONLY
	JMP	FCN2		/CREATE COMPLETE NEW DISPLAY
	JMP	FCN3		/DELETE FILE
/	JMP	FCN4		/CHANGE TEXT CONTENTS IN PLACE
/
	.EJECT
/  FCN=4:  CALL TEXT (4,ITAG,FORMAT,ARG, . . . ,ARG)
/
	.IFDEF	F4
FCN4	LAC	IX		/GET FORMAT STATEMENT ADDRESS
	.ENDC
	JMS	EXFOR		/EXECUTE FORMAT STATEMENT
	.IFDEF	F4
	LAC	(4		/ 'EXFOR' MUST STEP PAST 3 ARGUMENTS
	.ENDC
	JMS	FINDIT		/LOCATE SPECIFIED FILE
	LAW	-15		/ASSUME CURRENT DISPLAY FILE FILLS
	TAD*	FILEPT		/ENTIRE BLOCK.  ACCOUNT FOR
	AND	(77777		/BEAM POSITIONING & BOOKKEEPING OVERHEAD
	TCA
	DAC	WDCNT		/USED AS A COUNTER
	SMA
	JMP	RETURN		/ NO ROOM TO MOVE TO
	LAC	FILEPT
	AAC	11
	DAC*	(X15		/POINT TO BEGINNING OF CHARACTER AREA
	.IFUND	F4
	LAC	(LINE-1
	.ENDC
	.IFDEF	F4
	LAC	.FN
	IAC
	.ENDC
	DAC*	(X16		/POINTER TO NEW CONTENTS
FCN4MV	LAC*	X16
	DAC*	X15		/MOVE CONTENTS TO ACTIVE DISPLAY FILE
	ISZ	WDCNT
	JMP	FCN4MV
RETURN=.
	.IFUND	F4
	JMS	CALINT		/BECAUSE WE HAVE CALLED INTERPRETER
				/FROM 'TEXT', WE MUST USE IT TO
	76*OP	1		/ RETURN TO CALLING PROGRAM
	.ENDC
	.IFDEF	F4
	JMP*	TEXT
	.ENDC
/
	.EJECT
/  FCN=1:  CALL TEXT (1,ITAG,IX,IY)
/
FCN1	JMS	FINDIT		/LOCATE SPECIFIED FILE
	LAC	FILEPT
	AAC	6		/POINT AT X-COORDINATE WORD
	DAC	FILEPT
	.IFUND	F4
	JMS	INTARG		/ IX
	.ENDC
	.IFDEF	F4
	LAC*	IX
	.ENDC
	AND	(1777		/KEEP DOWN TO VALID SIZE
	XOR	(PTX
	DAC*	FILEPT		/NEW X-COORDINATE
	LAW	-1
	TAD	FILEPT		/POINT AT Y-COORDINATE WORD
	DAC	FILEPT
	.IFUND	F4
	JMS	INTARG		/ IY
	.ENDC
	.IFDEF	F4
	LAC*	IY
	.ENDC
	AND	(1777
	XOR	(PTY
	DAC*	FILEPT		/NEW Y-COORDINATE
	JMP	RETURN
/
	.EJECT
	.IFUND	F4
/
/  SUBROUTINE TO FETCH 1 INTEGER ARGUMENT FROM CALLING PROGRAM.
/  ERROR IS ISSUED IF ARGUMENT IS NOT INTEGER
/
INTARG	XX
	JMS*	.FETCH		/FETCH ARGUMENT TO ACCUMULATOR B
	JMS*	.PSHBA		/PUT IT WHERE WE CAN REACH IT
	SZA			/INTEGER ARGUMENT MODE HAS AC=0 HERE
	JMP	MODERR		/ILLEGAL MODE
	LAC*	.INT2		/GET ARGUMENT.  ASSUME USER HAS
	JMP*	INTARG		/SCALED DATA APPROPRIATELY
	.ENDC
/
/  SUBROUTINE TO LOCATE USER SPECIFIED DISPLAY FILE.  IF FILE IS FOUND,
/  'FILEPT' POINTS TO SIZE WORD (1ST WORD) OF FILE BLOCK.  IF FILE IS
/  NOT FOUND, AN ERROR IS ANNOUNCED.
/
FINDIT	XX
	LAC	ITAG		/ GET TAG NUMBER
	JMS*	D.FIND		/ USE ROUTINE LOCATED IN 'DSPLAY'
	JMP	NOFILE		/ FILE NOT FOUND
	DAC	FILEPT		/ SAVE DISPLAY FILE POINTER
	AAC	7
	DAC	LAST
	LAC*	LAST
	SAD	CSTAR		/ IS THIS A 'TEXT' FILE?
	JMP*	FINDIT
	JMP	NOFILE		/ COMPLAIN IF NOT.
/
	.EJECT
/  FCN=3:  CALL TEXT (3,ITAG)
/
	.IFUND	F4
FCN3	JMS	CALINT		/USE 2ND CALL IN FCN=2 SECTION
	50*OP	GO2F3-T		/ GO TO F3
	.ENDC
/
/  FCN=2:  CALL TEXT (2,ITAG,IX,IY,INT,ISCALE,FORMAT,ARG, . . . ,ARG)
/
FCN2	LAC	(6
	DAC	FCN		/ESTABLISH CORRECT FUNCTION FOR 'DISPLY'
	.IFUND	F4
	JMS	INTARG		/ IX
	.ENDC
	.IFDEF	F4
	LAC*	IX
	.ENDC
	AND	(1777
	XOR	(PTX
	DAC	XCOORD
	.IFUND	F4
	JMS	INTARG		/ IY
	.ENDC
	.IFDEF	F4
	LAC*	IY
	.ENDC
	AND	(1777
	XOR	(PTY
	DAC	YCOORD
	.IFUND	F4
	JMS	INTARG		/ INT
	.ENDC
	.IFDEF	F4
	LAC*	INT
	.ENDC
	ALSS	7
	AND	(1600
	XOR	(INT0!SCALE
	DAC	PARAM1
	.IFUND	F4
	JMS	INTARG		/ ISCALE
	.ENDC
	.IFDEF	F4
	LAC*	ISCALE
	.ENDC
	AND	(17
	XOR	PARAM1
	DAC	PARAM1		/BEAM MANIPULATION NOW PREPARED
/
	.EJECT
	.IFDEF	F4
	LAW	-23
	DAC	WDCNT
	LAC	.FN
	DAC*	(X16
	DZM*	X16		/ ZERO ENOUGH OF THE BUFFER FOR 90 CHARS
	ISZ	WDCNT
	JMP	.-2
	LAC	FORMAT		/ARGUMENT FOR 'EXFOR' IF DEC FORTRAN
	.ENDC
	JMS	EXFOR		/NOW EXECUTE FORMAT STATEMENT, ETC.
	.IFDEF	F4
	LAC	(10		/ 'EXFOR' MUST STEP PAST 1ST 7  ARGUMENTS
	.ENDC
/
	.IFUND	F4
TSW	LAC	(ENDLINE-LINE-1
	PAX
	CLLR
CK4SP	LAC	LINE,X		/ SEARCH BACKWARDS IN BUFFER FOR
	SAD	SPSPSP		/ NON-SPACE CHARACTER
	SKP
	JMP	ENDTXT
	AXS	-2
	SKP
	JMP	CK4SP
ENDTXT	LAC	ENDLINE		/ INSERT CARRIAGE RETURN
	DAC	LINE+1,X	/ AFTER TEXT STRING
	PXA
	AAC	14		/ CALCULATE VALUE FOR 'LAST'
	.ENDC
/
	.EJECT
	.IFDEF	F4
	LAC	.FN
	IAC
	DAC*	(X16
	LAC	(ENDLINE-LINE	/ DONT' OVERFLOW THE INTERNAL BUFFER
	PAL
	CLX
MOVE	LAC*	X16
	SNA			/ ZERO (NULL) ASCII SIGNIFIES
	JMP	ENDTXT		/ END OF TEXT STRING
	DAC	LINE,X
	LAC*	X16		/ MOVE ASCII IN PAIRS
	DAC	LINE+1,X
	AXS	2
	JMP	MOVE
ENDTXT	LAC	ENDLINE		/ ENSURE CARRIAGE RETURN AT
	DAC	LINE,X		/ END OF STRING
	PXA
	AAC	13		/ CALCULATE VALUE FOR 'LAST'
	.ENDC
	DAC	LAST
	LAC	ITAG
	SNA			/ZERO TAGS MUST NOT BE DELETED FIRST
	JMP	FCN3
	.IFUND	F4
	JMS	CALINT		/GO INTO INTERPRETER MODE
/
	43*OP	DSPLAY-T	/ CALL DSPLAY (3,ITAG,ERROR)
	DELOLD-T
F3	43*OP	DSPLAY-T	/ CALL DSPLAY (FCN,ITAG,ERROR,IVECT,1,LAST)
	PUTNEW-T
	76*OP	1		/ RETURN
	.ENDC
	.IFDEF	F4
	JMS*	DSPLAY		/DELETE PREVIOUS DISPLAY FIRST
	JMP	FCN3
	(3
	ITAG
	ERROR
/
FCN3	JMS*	DSPLAY		/THEN PUT UP NEW ONE
	JMP	FCN3R
	FCN
	ITAG
	ERROR
	IVECT
	(1
	LAST
FCN3R	JMP	RETURN
	.ENDC
	.EJECT
/  SUBROUTINE TO EXECUTE FORMAT STATEMENT, ONE ARGUMENT AT A TIME,
/  JUMPING IN & OUT OF INTERPRETER MODE AS REQUIRED.  WHEN FORMAT
/  STATEMENT IS FINISHED,  ROUTINE CONVERTS THE RESULTING 5/7 ASCII
/  TO .SIXBT DISPLAY CODE IN THE SAME BUFFER.
/
EXFOR	XX
	.IFUND	F4
	LAC*	.POINT		/GET POINTER TO ARGUMENT LIST
	DAC*	(X16
	LAC*	X16
	SAD	(600000		/PREMATURE END OF ARGUMENT LIST?
	JMP	ERR27		/INVALID ARGUMENT MATCH
	DAC	FORMPT		/'APOINT' POINTS DIRECTLY TO
	LAC*	FORMPT		/ARGUMENT LIST.
	DAC	FORMPT		/ARGUMENT LIST POINTER TO DATA
	JMS	CALINT		/FIRE UP THE INTERPRETER
	56*OP	CHARAY-T	/ WRITE (CHARAY,FORMAT) . . .
	FORMPT-T
/
S1	74*OP			/RETURN TO MACHINE CODE
	LAC*	X16		/GET POINTER FROM ARGUMENT LIST
	SAD	(600000
	JMP	FINIS		/END OF ARGUMENT LIST
	DAC	ARGPT
	LAC*	ARGPT
	DAC	ARGPT		/FETCH ARGUMENT
	JMS	CALINT		/NOW GO OUTPUT THIS SINGLE VARIABLE
	60*OP	ARGPT-T		/ OUTPUT SINGLE VARIABLE
	50*OP	GO2S1-T		/ GO TO S1
/
FINIS	JMS	CALINT		/ POINT INTERPRETER HERE
	61*OP			/ END OF OUTPUT LIST
	74*OP			/ RETURN TO MACHINE CODE
	.ENDC
/
	.EJECT
	.IFDEF	F4
	DAC	FRMAT		/PUT FORMAT ADDRESS IN CORRECT PLACE
	LAC*	TEXT
	AND	(7777		/REMOVE 'JMP'
	TCA
	DAC	RETAD		/CONSTANT TO TELL ABOUT END OF ARGUMENTS
	XCT*	EXFOR		/OFFSET FOR ADDRESSES
	TAD	TEXT
	DAC	ADRPNT		/POINTER TO ARGUMENT ADDRESSES
	JMS*	.FW
	(4			/  WRITE (4,FORMAT) . . .
FRMAT
S1	LAC	ADRPNT		/GET ADDRESS
	AND	(7777		/USE ONLY 12 BITS
	TAD	RETAD		/HAVE WE EXHAUSTED ARGUMENT LIST?
	SMA
	JMP	FINIS		/YES.  FINISH I/O
	LAC*	ADRPNT		/FETCH ARGUMENT ADDRESS
	IDX	ADRPNT
	DAC	ARG
	LAW	-1		/ SINGLE INTEGER MODE ONLY
	JMS*	.FE		/OUTPUT SINGLE VARIABLE
ARG
	JMP	S1		/GO DO NEXT ONE (IF PRESENT)
/
FINIS	LAC	.FQ
	IAC
	DAC	SAVAD
	LAC*	SAVAD
	DAC	SAVCON		/SAVE ENTRY AT '.FQ+1'
	LAC	.FQ
	AND	(7777		/WE NOW BUILD 'JMP* .FQ' TO
	XOR	(JMP*		/SHORT-CIRCUIT THE '.FQ' ROUTINE.
	DAC*	SAVAD
	JMS*	.FF		/FINISH FORMAT STATEMENT EXECUTION.
	LAC	SAVCON
	DAC*	SAVAD		/RESTORE '.FQ+1'.
	LAC	.FN
	AAC	2
	DAC	SAVAD		/ BECAUSE THE VT15 SEEMS TO WANT TO
	LAC*	SAVAD		/ ESCAPE FROM CHARACTER MODE ON
	AND	(003777		/ LINE FEED AS WELL AS CARRIAGE RETURN,
	DAC*	SAVAD		/ WE MUST STRIP THE LEADING LINE FEED.
	.ENDC
	JMP*	EXFOR
/
	.EJECT
	.IFUND	F4
/
/  SUBROUTINE TO FIRE UP THE INTERPRETER.  INSTRUCTION FOLLOWING
/  CALLING POINT IS IN INTERPRETER CODE.
/
CALINT	XX
	LAC	CALLED		/HAVE WE ALREADY CALLED INTERPRETER?
	SZA!CLC
	JMP	CALLED		/YES.  DON'T DO IT TWICE
	DAC	CALLED		/SET 'INTERPRETER CALLED' FLAG
	JMS*	.INTRP
	T
	S-1
S	62*OP	0		/ STATEMENT #0
	74*OP			/ RETURN TO MACHINE CODE
CALLED	LAW	-1		/CLEARED ON ENTRY TO 'TEXT'
	TAD	CALINT		/LOAD X10 WITH RETURN ADDRESS
	DAC*	(X10
	JMP*	.NEXT		/PROCEED AS IF NORMAL WATRAN
	.ENDC
	.EJECT
/  ANNOUNCE ERRORS FROM THIS POINT.  WE WILL CHANGE THE APPARENT
/  LINE NUMBER TO SIGNIFY DIFFERENT DEGREES OF THE SAME GENERAL
/  CLASS OF ERROR.
/
	.IFUND	F4
MODERR	LAW	66		/INCORRECT ARGUMENT
	JMP*	.NERR
/
ERR27	LAW	27		/NOT ENOUGH ARGUMENTS
	JMP*	.NERR
	.ENDC
/
NOFILE	LAC	(62*OP 1	/'FILE NOT FOUND' => STATEMENT #1
	SKP
FCNERR	LAC	(62*OP 2	/FCN NOT 1-4  => STATEMENT #2
	.IFUND	F4
	DAC	STMNT
	JMS	CALINT
STMNT	62*OP			/UPDATE LINE NUMBER BEFORE ERROR
	74*OP			/RETURN TO MACHINE CODE
	JMP	MODERR
	.ENDC
	.IFDEF	F4
	ALSS	4		/ OP=0 FOR F4; ONLY ERROR NUMBER
	XOR	ERRT		/ USED ONLY ONCE, SO THIS IS FINE
	DAC	ERRT
	CAL	WRERR		/ OUTPUT ERROR MESSAGE
	CAL	WTFOR		/ WAIT FOR IT TO FINISH
	CAL	(10		/ THEN EXIT (ERROR IS ALWAYS TERMINAL)
/
ERR	4002; 0; .ASCII	'TEXT ERROR'
ERRT	.ASCII	' 0 '<15>
WRERR	2700;	EV;	TTO; 2; ERR
WTFOR	20;	EV
	.ENDC
	.EJECT
	.IFUND	F4
/
/  OTABLE AND VARIABLE STORAGE
/
T	0; 0; 0			/OTABLE STARTS HERE
	.ASCII	'TEXT  '
	.LOC	.-1
CHARAY	7*MM+DOPEV-1
DOPEV	7*MM	132		/90 CHARACTERS IN CHARACTER VARIABLE
	-1+LINE			/DOPE VECTOR TO ACTUAL STORAGE
FORMPT
DIMEN	D.INFO			/ DIMENSION INFORMATION
ARGPT
DELOLD	.			/ENTRIES FOR DELETING OLD DISPLAY FILE
	3*MM+L.3
	3*MM+L.ITAG
	3*MM+L.ERROR
	6*MM
L.3	-1+L3
L.FCN	-1+FCN
L.ITAG	-1+ITAG
L.ERROR	-1+ERROR
L.IVECT	-1+IVECT
L.1	-1+L1
L.LAST	-1+LAST
/
PUTNEW	.		/ENTRIES FOR FCN=2 & FCN=3
	3*MM+L.FCN
	3*MM+L.ITAG
	3*MM+L.ERROR
	3*MM+L.IVECT
	3*MM+L.1
	3*MM+L.LAST
	6*MM
/
GO2F3	-1+F3
GO2S1	-1+S1
/
L1	1
L3	3
D.INFO	177; -1; 177
/
FCN;ITAG
	.ENDC
IVECT	0
PARAM1	INT0!SCALE
PARAM2	LPON!OSETF!ROTOFF!BKOFF!EDGOFF!ESCR
YCOORD	PTY
XCOORD	PTX
CSTAR	CHRI!10000 52		/ '*' FOR LIGHT PEN DETECTION
	CHRS	.+2		/ THIS LOCATION AND . . .
	DJMP	LAST-2		/ THIS LOCATION ARE FILLED BY 'DRAW'
LINE	.BLOCK	132/5*2
ENDLINE	.ASCII	<15>'    '
SPSPSP=ENDLINE+1
/
LAST
FILEPT;ERROR
WDCNT=LAST
	.IFDEF	F4
ADRPNT;RETAD;SAVAD;SAVCON
EV=LAST
	.ENDC
/
/	EDGE VIOLATION HANDLER WILL GO IN HERE
/
	.END