Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/pltunv.mac
There are 2 other files named pltunv.mac in the archive. Click here to see a list.
SUBTTL	Initialization  /RWS/JMS

;Define the version number
	PLTWHO==0	;Who last edited 'PLOT'
	PLTVER==12	;The version number of 'PLOT'
	PLTMIN=="A"-"@"	;The minor version number of 'PLOT'
	PLTEDT==533	;The edit number of 'PLOT'
			;Last edited 9-Nov-83 by Joe Smith

IFNDEF	TOPS,TOPS==10		;CSM runs version 7.02 of TOPS-10
DEFINE	TOPS10,<IFE TOPS-10,>
DEFINE	TOPS20,<IFE TOPS-20,>
	SALL

TOPS10<	SEARCH	MACTEN,UUOSYM >	;Standard TOPS-10 definitions
TOPS20<	SEARCH	MACSYM,MONSYM	;Standard TOPS-20 definitions
IF2,<	PRINTX	[Creating TOPS-20 PLTUNV]	>
	DEFINE	ND(SYM,VAL),<	;Macro not in MACSYM
IF2,<IFDEF SYM,<SYM==SYM>> IFNDEF SYM,<SYM==<VAL>> >
>  ;End TOPS20


SUBTTL	Feature-Test definitions

;FTDSKO='UUOS'   - Use traditional uuos (OPEN,ENTER,OUT,CLOSE,RELEAS),
;		   get I/O channel from ALCHN., invoke PA1050 on TOPS-20.
;FTDSKO='FILOP.' - Use FILOP with extended channels (7.01 or later).
;FTDSKO='FOROTS' - Use UNIT=99 for disk output, UNIT=-1 for TTY output.
;FTDSKO='JSYS'   - Use TOPS-20 Monitor calls for disk output.
;FTDSKI has same options, but uses UNIT=0 to read SYS:SYMBOL.DAT.
;FTTYIO='OUTSTR' - Use TTCALLs for TTY I/O.
;FTTYIO='TRMOP.' - Use TRMOP. function .TOISO for Image String Output
;FTTYIO='BUFFER' - Use the same sort of output as FTDSKO.
;FTTYIO='FOROTS' - Use UNIT=-1 for TTY I/O.
;FTTYIO='PSOUT%' - Use TOPS-20 terminal I/O.

TOPS10<	ND FTDSKO,'FILOP.'
	ND FTDSKI,'FILOP.'
	ND FTTYIO,'TRMOP.'
	ND FTSHR,-1>	;Define $HISEG and $LOSEG for code and data

TOPS20<	ND FTDSKO,'JSYS'
	ND FTDSKI,'FOROTS'
	ND FTTYIO,'PSOUT%'
	ND FTSHR,0 >	;No HISEG for orange toads

ND DPLOTT,<ASCII/SPOOL/>	;Default plotter type
ND FTKA,0	;Nonzero to use IFX.1 subroutine and DMOVEM macro
ND FTMKTB,0	;Do not include MKTBL and SETABL in SYMBOL (DEC compatibility)
ND FTAPLT,0	;Do not allow for alias plotters (subroutine PLOTER)
ND FTHEAD,-1	;Use subroutine SYMBOL to plot headers in DSK:.PLT file
ND SITGO,0	;Don't include SITGO interface
ND FTDBUG,0	;Do not include features for debugging PLOT.REL with DDT

IFN FTDBUG,<.TEXT ~/SEGMENT:LOW~>	;So LINK won't create nonsharable hiseg
;        Table of Contents for PLOT universal definitions
;
;
;			   Section			      Page
;
;    1. Feature-Test definitions . . . . . . . . . . . . . . .   1
;    2. Revision history . . . . . . . . . . . . . . . . . . .   3
;    3. Macro definitions  . . . . . . . . . . . . . . . . . .   5
;    4. Macros for ARGTST  . . . . . . . . . . . . . . . . . .   8
;    5. AC definitions . . . . . . . . . . . . . . . . . . . .  10
;    6. Subroutine Descriptions
;         6.1   ARGTST - Enable argument checking  . . . . . .  11
;         6.2   ERASE  - Erase screen or go to new page  . . .  12
;         6.3   FACTOR - Change size of plotter movements  . .  13
;         6.4   GETWIN - Get size of universal window  . . . .  14
;         6.5   IPLOT  - Fake a call to PLOTS  . . . . . . . .  15
;         6.6   ISETAB - Fake a call to SETSYM . . . . . . . .  15
;         6.7   MKTBL  - Make table from in-core array . . . .  16
;         6.8   MSETAB - Fake a call to SETSYM . . . . . . . .  17
;         6.9   NEWPEN - Change to different pen color . . . .  18
;         6.10  NUMBER - Plot numbers  . . . . . . . . . . . .  19
;         6.11  OPRTXT - Send a message to the OPR . . . . . .  20
;         6.12  PAUSEP - Cause the plotter to pause  . . . . .  21
;         6.13  PLOT   - Move the pen to X,Y coordinates . . .  22
;         6.14  PLOTCH - Output characters to plotter  . . . .  23
;         6.15  PLOTER - Define plotter aliases  . . . . . . .  24
;         6.16  PLOTOF - Temporarily disable output  . . . . .  25
;         6.17  PLOTOK - Get status of the plotter . . . . . .  26
;         6.18  PLOTON - Resume plotting . . . . . . . . . . .  27
;         6.19  PLOTS  - Initialize the plotter  . . . . . . .  28
;         6.20  ROTATE - Set up for a rotation of axis . . . .  29
;         6.21  SETABL - Change table for SYMBOL (DEC routin .  30
;         6.22  SETWIN - Set the size of the universal windo .  31
;         6.23  SUBWIN - Set/reset/status of sub-window  . . .  32
;         6.24  SYMBOL - Plot symbols (letters, digits, etc) .  33
;         6.25  SETSYM - Get data from SYMBOL.DAT  . . . . . .  34
;         6.26  TITLE  - Plot symbols (letters, digits, etc) .  35
;         6.27  TITLEP - Determine if TITLE is possible) . . .  36
;         6.28  WHERE  - Get current pen position  . . . . . .  37
;         6.29  XHAIRS - Trigger crosshairs on TEK 4012  . . .  38
;    7. %ARGET
;         7.1   Check if caller supplied enough arguments  . .  39
;         7.2   GET - Dispatch based on argument type  . . . .  40
;         7.3   Get single or double word numeric data . . . .  41
;         7.4   Get CHARACTER data . . . . . . . . . . . . . .  41
;    8. %ARGPT
;         8.1   PUT - Dispatch based on argument type  . . . .  43
;         8.2   Put single or double word numeric data . . . .  44
;         8.3   Return CHARACTER strings to caller . . . . . .  45
;    9. MISMAT - output warning message  . . . . . . . . . . .  46
;   10. Default plotter - End of PLTUNV.MAC  . . . . . . . . .  47
SUBTTL	Revision history

;Version number 11
;Edit	Date
; ***	**-***-**  RWS	No previous history.
;			PLOT.MAC was written by Rex Shadrick around 1976.
;
; 443	12-Aug-81  JMS	Last edit to version 11.
;			Joe Smith at CSM.
;
;************  START OF VERSION 12 ****************************************
;
; 500	16-Dec-81  JMS	Major changes.  Reset version number.
;			(PLOT.MAC)
;
; 501	26-Jul-82  JMS	Add ReGIS output for VT125 and GIGI terminals.
;			(PLTRGS portion of PLOT.MAC)
;
; 502	18-Aug-82  JMS	Split into separate source files, compile
;			PLOT.MAC+PLTDSK.MAC+PLTRGS.MAC+PLTTEK.MAC+PLTIOD.MAC
;
; 503	22-Sep-82  JMS	More on edit 502.
;			(all)
;
; 504	15-Oct-82  JMS	Remove all UUOs from PLOT.MAC, put them in PLTIOD.
;			(PLOT,PLTIOD)
;
; 505	20-Oct-82  JMS	Remove debugging HALT from SYMBOL.
;			(SYMBOL)
;
; 506	20-Oct-82  JMS	Implement CR, LF, TAB, BS, SI, and SO in SYMBOL.
;			(SYMBOL)
;
; 507	22-Oct-82  JMS	Clear the screen when XHAIRS reads a formfeed.
;			(PLTTEK,PLTRGS)
;
; 510	22-Oct-82  JMS	Initialize Tektronix 4025 properly.
;			(PLTTEK)
;
; 511	27-Oct-82  JMS	Do orthoganal or diagonal moves up to 8 pixels by
;			sending only digits to the GIGI.
;			(PLTRGS)
;
; 512	29-Oct-82  JMS	Implement SETSYM routine to replace ISETAB/MSETAB.
;			(SYMBOL)
;
; 513	 2-Nov-82  JMS	Allow [1,2] to create .PLT files in other directories.
;			(PLTIOD)
;
; 514	 9-Nov-82  JMS	Do not special case CR, LF, etc for centered symbols.
;			(SYMBOL)
;
; 515	 9-Nov-82  JMS	Installed in CSM's FORLIB, start of version 12A.
;			(FORLIB.REL, version 6)
;********  Version 12A of the Plotting Package
;
; 516	21-Feb-83  JMS	Change ROTATE to cancel the relative origin that was
;			set by CALL PLOT(X,Y,-3), and change FACTOR to preserve
;			said origin.
;			(PLOT, manual)
;
; 517	12-Apr-83  JMS	Change SYMBOL to handle FORTRAN-77 CHARACTER variables.
;			CALL SYMBOL (X,Y,HEIGHT,CSTRNG,ANGLE)
;			Note that the number of characters is defined by
;			the character string.
;			(SYMBOL, manual)
;
; 520	24-Aug-83  JMS	Convert all subroutines to handle FORTRAN-77.  This
;			edit forced ARGTST to be re-implemented.
;			(all)
;
; 521	 8-Sep-83  JMS	Re-install patch from V12, infinite loop in 3rd and
;			succeeding files to DSK in same run.
;			(PLTIOD)
;
;Version 12A(521) installed in CSM's FORLIB.REL for FORTRAN v7.
;
; 522	 9-Sep-83  JMS	Get PLOTOF and PLOTON working (had never been tested).
;			(PLOT)
;
; 523	12-Sep-83  JMS	Implement CALL PLOTCH('TEK','!COLOR BLUE') to output
;			to plotter's buffer.  Make call to NEWPEN dump the
;			buffer.
;			(PLTUNV,PLOT,doc)
;
; 524	13-Sep-83  JMS	Move ISETAB and MSETAB back into PLTUNV, change
;			PLTDSK to use SETSYM instead of ISETAB.
;			(PLTUNV,SYMBOL,PLTDSK)
;
; 525	14-Sep-83  JMS	Make a distinction between 4010, 4014, and 4113.
;			(PLTTEK)
;
; 526	16-Sep-83  JMS	SETSYM now exists in 2 places.  The TOPS-10 version
;			is in SYMBOL.MAC and uses UUO's for disk I/O, the
;			TOPS-20 version is in SETSYM.MAC and uses FOROTS I/O.
;			(SETSYM,SYMBOL)
;
; 527	23-Sep-83  JMS	Make SUBWIN take CHARACTER argument for ICODE.
;			(PLOT)
;
; 530	19-Oct-83  JMS	For GIGI, use 42 dots per inch to display 11 by 11
;			inch plot.  DMP4R uses 100 per inch full scale.
;			(PLTRGS)
;
; 531	 9-Nov-83  JMS	Watch out for jobs that do not have the plotter spooled
;			and no plotter exists on the system (KS2020).
;			(PLTIOD)
;
; 532	19-Mar-84  JMS	Fix bug in clipping routines.
;			(PLOT)
;
; 533	 2-Apr-84  JMS	Preserve ACs before calling TRACE to avoid ILL MEM REF.
;
;End of Revision History


;The version number will be changed to 12B when PLTDSK uses TITLE for headers.

	PAGE
;	Suggestions to be implemented
;
; Use subroutine TITLE instead of SYMBOL for spooled headers
;
; The CALCOMP routines in PLTCAL.MAC have not been tried.
;
; Make callable from ALGOL, COBOL, PASCAL, XPL0, etc.
; Make callable from SITGO by putting it in STGOTS.
;
; Return plotter type in ASCII as well as integer.
;
; Try to intercept calls to EXIT on fatal FORTRAN errors.
SUBTTL	Macro definitions

; $TITLE - This is a macro to the define the version number
;
; Calling sequence:
;	$TITLE \VERSION.NUMBER,\'MINOR.VER,\EDIT.LEVEL

DEFINE	$TITLE ($VER,$MIN,$EDT),<
  DEFINE  UNV ($TXT),<UNIVERSAL $TXT  %'$VER'$MIN($EDT)
		  IF2,<PRINTX - $TXT  %'$VER'$MIN($EDT)> >
  DEFINE  TTL ($TXT,$TYPE),<	SALL
    TITLE $TXT  %'$VER'$MIN($EDT)
    IFIDN <$TYPE>,<MAIN>,<IF2 <PRINTX - $TXT  %'$VER'$MIN($EDT)>>
    IFDIF <$TYPE>,<MAIN>,<NOSYM ;;Suppress symbol table
	IFDIF <$TYPE>,<DUMMY>,<IF2 <PRINTX - $TXT>>>
    IFDIF <$TYPE>,<DUMMY>,<
	TOPS10< SEARCH	MACTEN,UUOSYM >
	TOPS20< SEARCH	MACSYM,MONSYM >
	.DIRECTIVE FLBLST
	$RELOC	400000 >
>  ;End of DEFINE TTL
>  ;End of DEFINE $TITLE

IFN PLTMIN,<$TITLE \PLTVER,\'<PLTMIN+'@'>,\PLTEDT>
IFE PLTMIN,<$TITLE \PLTVER,,\PLTEDT>
	PURGE	$TITLE

UNV	<PLTUNV - UNV file for plotting package>

DEFINE STTL ($TXT),<SUBTTL- $TXT -
IF2,<PRINTX - $TXT>>

; $RELOC, $HISEG, $LOSEG - Relocation macros for 1 or 2 segments

IFE FTSHR,<	;Put everything in LOSEG, with data and code intermixed
  DEFINE $RELOC (ADDR),<..==.>
  DEFINE $HISEG,<..==.>
  DEFINE $LOSEG,<..==.>
>  ;End of IFE FTSHR

IFN FTSHR,<	;Put code in HISEG and data in LOSEG
  DEFINE $RELOC (ADDR),<	TWOSEG
			RELOC	ADDR>
  DEFINE $HISEG,<IFL  .-400000,<RELOC>>	;HISEG origin must be 400000 or above
  DEFINE $LOSEG,<IFGE .-400000,<RELOC>>
>  ;End of IFN FTSHR


; PFALL - Used to verify the flow by falling into subroutines

  DEFINE PFALL(LABEL),<IF2,<IFN .-LABEL,<
	PRINTX	?PFALL - LABEL: is not next statement
	STOPI;;Cause an "A" error>>  ;End IFN and IF2
	..==LABEL	>  ;End DEFINE PFALL
; ERRSTR - Output an error message to the terminal
; Produces 1 word of in-line code, can be skiped over

  DEFINE ERRSTR(TYP,MESSAGE),<IF2,<IFNDEF %OUTST,<EXTERN %OUTST>>
	PUSHJ	P,[MOVE T1,[''TYP'',,[ASCIZ ~MESSAGE~]]
	PJRST	%OUTST];;Restore TTY to normal before outputing string
>  ;End DEFINE ERRSTR


;BUGJMP is used where it is "impossible" to get an error return
IFN FTDBUG,< OPDEF BUGJMP [HALT] >  ;Halt so that DDT can be used
IFE FTDBUG,< OPDEF BUGJMP [JRST] >  ;Ignore error, should never happen anyway
	.NODDT	BUGJMP


; Definitions from MACTEN and UUOSYM that are not in MACSYM

TOPS20<	DEFINE	MONRT.,<HALTF%>		;Quiet exit to the EXEC
	OPDEF	PJRST	[JUMPA	17,]	;Not in MACSYM
	DEFINE INSVL.(A,B),<A>	;*KLUDGE* ;Insert value
	.IOASC==0			;Normal ASCII mode
	.IOPIM==3			;Packed Image Mode for TTY
	.IOIMG==10			;Image mode
	.IOIBN==13			;Image BINARY mode
	.IODMP==17			;DUMP mode
IF2,<PRINTX %PLTUNV *** The TOPS20 stuff has NOT been tested yet>
>  ;End TOPS20
;DMOVE and DMOVEM for handling (X,Y) as a pair

IFN FTKA,<	;Define DMOVE and DMOVEM to load/store X and Y
  DEFINE DMOVE (AC,MEM),<
    IFE MEM&@,<
	MOVE	AC,MEM
	MOVE	AC+1,MEM+1>
    IFN MEM&@,<
	MOVEI	AC+1,MEM
	MOVE	AC,0(AC+1)
	MOVE	AC+1,1(AC+1)>
  >  ;End of DMOVE

  DEFINE DMOVEM (AC,MEM),<
    IFE MEM&@,<
	MOVEM	AC,MEM
	MOVEM	AC+1,MEM+1>
    IFN MEM&@,<
	MOVEM	AC,MEM
	MOVEI	AC,MEM
	MOVEM	AC+1,1(AC)
	MOVE	AC,MEM>
  >  ;End of DMOVEM
>  ;End of IFN FTKA


;FLOAT macro - converts a signed integer with 27 or fewer bits to floating point

IFN FTKA,<
  DEFINE FLOAT (AC,MEM),<;;Convert small integers to floating point
    IFB <MEM>,<
	FSC	AC,233>
    IFNB <MEM>,<
	MOVE	AC,MEM
	FSC	AC,233>
>>  ;End of KA FLOAT

IFE FTKA,<
  DEFINE FLOAT (AC,MEM),<;;Convert small integers to floating point
    IFB <MEM>,<	FLTR	AC,AC>
    IFNB <MEM>,<FLTR	AC,MEM>
>>  ;End of non-KA FLOAT


	OPDEF	PJRST	[PJRST]		;Copy definition to PLTUNV.UNV
	DEFINE JRSTX(ADDR), <PJRST ADDR##>
	DEFINE PUSHJX(ADDR),<PUSHJ P,ADDR##>
;Note: FORTRAN's 1 word byte pointers will cause problems with 30-bit addresses
SUBTTL	Macros for ARGTST

;Subroutine %ARGET validates and retrieves arguments.  It trashes T1-T4 and
;returns results in T2 or T2+T3.  Upon call to %ARGET, T1 has 3 values
;  Left half of T1
;      -1 = RH has min and max counts, T2 has name of subroutine in SIXBIT
;       0 = RH has type and position, get a numeric argument
;    POS2 = RH has type (CHARACTER) and position, LH as position of byte count
;  Right half of T1
	ARG%TP==777000	;Expected argument type, a number from 0 to 17
	ARG%PS==   777	;Position in the argument list, 1=first argument
	ARG%MN==777000	;Minimum number of arguments to subroutine
	ARG%MX==   777	;Maximum

;Subroutine %ARGPT validates and stores arguments from T2 or T2+T3.
;  Left half of T1
;      -1 = RH is zero to turn off argument checking, nonzero to test args
;       0 = RH has type and position, put a numeric argument
;    POS2 = RH has type (CHARACTER) and position, LH as position of byte count
;  Right half of T1 = same as for %ARGET

DEFINE HELLO($NAME$,MIN,MAX,SAVAC),<	XALL
	 ENTRY  $NAME$
	 SIXBIT /$NAME$/  	;For subroutine TRACE.
$NAME$:	 MOVEM	L,L'$NAME$#	;Save arg pointer
IFNB <SAVAC>,<	ARRAY SAVAC[15-2+1]
	 MOVE	T1,[2,,SAVAC]	;Preserve ACs 2-15 also
	 BLT	T1,SAVAC-2+15
>;;End of IFNB SAVAC
	 HRROI	T1,<MIN_9>+MAX	;Number of arguments expected
	 MOVE	T2,$NAME$-1	;Get name of this module
	 PUSHJ	P,%ARGET##	;Check if required args are supplied
	SALL	>  ;End of DEFINE HELLO


DEFINE	$END$($NAME$),<	XLIST
	  $LOSEG
	  VAR			;Variables defined earlier
	  $HISEG
	  PURGE	..		;;Used by PFALL macro
LITS:	  LIT
	  LIST
	  LALL
Z'$NAME$==.-1		    ;Last word in HISEG
	  PRGEND	    ;End of $NAME$>


DEFINE NUMARG(POS),<;;Skips if the requested argument is supplied
	HLRE	T1,-1(L)	;Get argument count
	CAMLE	T1,[-^D<POS>]	;Non-skip if not enough args
>  ;End of DEFINE NUMARG
DEFINE GETARG(TYPE,POS,POS2<0>),<;;Gets value in T2 or T2+T3
	MOVX	T1,<^D<POS2>,,<<TYPE_-^D14>&ARG%TP>!^D<POS>>
	PUSHJ	P,%ARGET##	;Check the argument and get it
>  ;End of DEFINE GETARG


DEFINE PUTARG(TYPE,POS,POS2<0>),<;;Stores value from T2 or T2+T3
	MOVX	T1,<^D<POS2>,,<<TYPE_-^D14>&ARG%TP>!^D<POS>>
	PUSHJ	P,%ARGPT##	;Store the argument
>  ;End of DEFINE PUTARG


	OPDEF	XMOVEI	[SETMI]	    ;For extended addressing
	OPDEF	IFIW	[1B0]	    ;Instruction Format Indirect Word
		.NODDT IFIW


DEFINE $ARGTP,<	XALL
	XX (UNSPEC ,00,<unspecified (can be anything)>)
	XX (LOGICAL,01,<LOGICAL (36-bit Boolean)>)
	XX (INTEGER,02,<INTEGER>)
	XX ($3TYPE , 0,<type-3 (undefined)>)
	XX (REAL   ,04,<REAL (single-precision)>)
	XX ($5TYPE , 0,<type-5 (undefined)>)
	XX (OCTAL  ,06,<OCTAL (any 1-word variable)>)
	XX (PROC   ,07,<SUBROUTINE or PROCEDURE name>)
	XX (DREAL  ,10,<DOUBLE PRECISION floating point>)
	XX (DCOMP  ,11,<COMP (2-word COBOL integer)>)
	XX (DOCTAL ,12,<DOUBLE OCTAL (any 2 words)>)
	XX (GFLOAT ,13,<G-floating DOUBLE PRECISION>)
	XX (COMPLEX,14,<COMPLEX (Real & Imaginary)>)
	XX (CHARACT,15,<CHARACTER (byte string descriptor)>)
	XX ($16TYPE, 0,<type-16 (undefined)>)
	XX (STRING ,17,<ASCIZ string (literal)>)
;;Codes above 20 are defined for GETARG and PUTARG macros
	XX (IARRAY ,20,<INTEGER array>)
	XX (INTLOG ,21,<INTEGER or LOGICAL>)
	XX (CHAR%5 ,22,<INTEGER or CHARACTER*5>)
	XX (CHAR10 ,23,<DOUBLE or CHARACTER*10>)
SALL >  ;End of DEFINE $ARGTP

DEFINE XX(NAME,VAL,TEXT),<IFN VAL,<
	IFGE <VAL-20>,<OPDEF NAME [VAL_^D23]>	;;Special codes for GETARG
	IFL  <VAL-20>,<OPDEF NAME [IFIW VAL,0]>>>

	$ARGTP			;Define all the OPDEFs

	ACFLD==<Z 17,0>		;Argument type is in the AC field
	ACPNTR==POINT 4,0,12	;P and S of a byte pointer to the AC field
	DEFINE ACTYPE(TYPE),<<TYPE&ACFLD>_-^D23> ;For compare immediate
	CHR%TP==777700,,000000	;Character type flags (nonzero in COBOL only)
	CHR%BC==000000,,777777	;Byte count field (ignoring 77B17)
SUBTTL	AC definitions

	T0= 0		;Temporary
	T1= 1		; ACs usually
	T2= 2		; NOT saved
	T3= 3		; across
	T4= 4		; routines
	P1= 5		;Permanent ACs
	P2= 6		; always saved
	P3= 7		; across
	P4=10		; routines
	X= 11		;Holds the location
	Y= 12		; being moved to
	G3==13		;General ACs,
	G4==14		; redefined in
	G5==15		; modules that need them
	L= 16		;Pointer to the argument list
	P= 17		;Push down pointer

;Other definitions

	PEN.DN==2	;Lower the pen before moving
	PEN.UP==3	;Raise the pen before moving
	PEN.OR==-3	;Change the origin
	VERSON==<BYTE (3)PLTWHO(9)PLTVER(6)PLTMIN(18)PLTEDT>




;NOTE:	The modules in PLTUNV.REL are in alphabetical order except where
;	needed to create proper forward references.
;    'IPLOT' must come before 'PLOTS' and '.PLOT.' after 'PLOTS'.
;    'ISETAB' and 'MSETAB' must come before 'SETSYM'.
;    'NUMBER' must come before 'SYMBOL', which must come before 'SETSYM'.

	PRGEND		;End of PLTUNV universal
SUBTTL	Subroutine Descriptions -- ARGTST - Enable argument checking
	SEARCH	PLTUNV	;Search the universal file
TTL	(<ARGTST - Enable argument checking at run-time>)

;Calling sequence:
;	CALL ARGTST(IWARN)	!Nonzero to enable warning messages

HELLO	(ARGTST,1,1)

	GETARG	(INTEGER,1)	;Get first argument
	HRRO	T1,T2		;Set LH of T1 to -1, RH to number of warnings
	PJRST	%ARGPT##	;Store warning count

	$END$	(ARGTST)
SUBTTL	Subroutine Descriptions -- ERASE  - Erase screen or go to new page
	SEARCH	PLTUNV	;Search the universal file
TTL	(<ERASE  - Erases the screen on graphics terminals>)

;Calling sequence:
;	CALL ERASE
;
;  The current X and Y positions are set to zero, the origin is set to the
;lower left corner of the screen, and rotation is turned off.
;
;  The GENCOM, DIABLO, or PTC5 will move to the top of a new page.


HELLO	(ERASE,0,0)

	JRSTX	%ERASE		;Call routine in PLOT module

	$END$	(ERASE)
SUBTTL	Subroutine Descriptions -- FACTOR - Change size of plotter movements
	SEARCH	PLTUNV	;Search the universal file
TTL	(<FACTOR - Sets the scaling factor>)

;Calling sequence:
;	CALL FACTOR (FACT)
;	CALL FACTOR (FACT, FACTY)
;
;   FACT - The multiplicative factor value to be used
;  FACTY - (optional) Factor to be used in the Y directon.  If not given,
;	   FACT will be used for both directions.
;
;  If FACT or FACTY is zero, the corresponding factor is left unchanged.


HELLO	(FACTOR,1,2)

	GETARG	(REAL,1)	;Get FACTX
	MOVEM	T2,FACTX
	MOVEM	T2,FACTY
	NUMARG	2		;See if there are 2 arguments
	  JRST	FACTR1		;No, only one
	GETARG	(REAL,2)	;Yes, get FACTY
	MOVEM	T2,FACTY

FACTR1:	XMOVEI	L,[-2,,0	  ;2 args
		REAL	FACTX#
		REAL	FACTY#
		  ]+1		;Point to args
	JRSTX	%FACTOR		;Call routine in PLOT module

	$END$	(FACTOR)
SUBTTL	Subroutine Descriptions -- GETWIN - Get size of universal window
	SEARCH	PLTUNV	;Search the universal file
TTL	(<GETWIN - Gets the universal the window size>)

;Calling sequence:
;	CALL GETWIN (XMIN, YMIN, XMAX, YMAX)
;
;  XMIN - Coordinate of left edge of window
;  YMIN - Coordinate of bottom edge of window
;  XMAX - Coordinate of right edge of window
;  YMAX - Coordinate of upper edge of window

;Example:
;	CALL GETWIN (XMIN, YMIN, XMAX, YMAX)	!Get the current borders
;	CALL PLOT (XMIN, YMIN, -3)	!Go to real lower left corner


HELLO	(GETWIN,2,4)

	XMOVEI	L,[-4,,0	  ;4 args
		REAL	XMIN#
		REAL	YMIN#
		REAL	XMAX#
		REAL	YMAX#
		  ]+1		;Point to args
	PUSHJX	%GETWIN		;Call routine in PLOT module
	MOVE	L,LGETWIN	;Restore arg pointer

	MOVE	T2,XMIN		;Left edge
	PUTARG	(REAL,1)
	MOVE	T2,YMIN		;Bottom edge
	PUTARG	(REAL,2)
	NUMARG	4		;User specify 4 arguments?
	  POPJ	P,		;No, only 2
	MOVE	T2,XMAX		;Right edge
	PUTARG	(REAL,3)
	MOVE	T2,YMAX		;Top edge
	PUTARG	(REAL,4)
	POPJ	P,		;End of GETWIN

	$END$	(GETWIN)
SUBTTL	Subroutine Descriptions -- IPLOT  - Fake a call to PLOTS
	SEARCH	PLTUNV	;Search the universal file
	SALL
TOPS10<	;Obsolete function
TTL	(<IPLOT  - Calls PLOTS to initialize the plot file>,OBSOLETE)

;	FUNCTION IPLOT(IWARN)		! You should use PLOTS instead of IPLOT
;	IERR = IWARN			! Number of warnings to type
;	CALL PLOTS (IERR,0)		! Initialize the plot the right way
;	IPLOT = IERR			! Return 0 if OK, -1 if failed
;	END

HELLO	(IPLOT,1,1,IPLT02)

	OUTSTR	[ASCIZ /
[Function IPLOT has called subroutine PLOTS to set up the plotter]/]
				;Call PLOTS directly to avoid the message
	GETARG	(INTEGER,1)	;Get argument to IPLOT(IWARN)
	MOVEM	T2,IERR		;Store as 2nd arg to PLOTS
	SETZM	IPLT		;Zero for the default plotter type

	XMOVEI	L,[-2,,0	  ;2 args
		INTEGER IERR#	  ;IERR - Nonzero if error occured
		INTEGER IPLT#	  ;IPLT - Type of plotter
		  ]+1		;Point to args
	PUSHJX	PLOTS		;Call routine in PLOT module

	SKIPE	IERR		;Was IERR non-zero?
	 SETOM	IERR		;Yes, return -1 even for positive IERR
	MOVE	T0,[IPLT02,,2]	;Restore ACs
	BLT	T0,15
	MOVE	L,LIPLOT
	MOVE	T0,IERR		;Return function value in AC 0
	POPJ	P,

	$END$	(IPLOT)		>  ;End TOPS10
SUBTTL	Subroutine Descriptions -- ISETAB - Fake a call to SETSYM
	SEARCH	PLTUNV	;Search the universal file
	SALL
TOPS10<	;Obsolete function
TTL	(<ISETAB - Calls SETSYM to read SYS:SYMBOL.DAT[1,4]>,OBSOLETE)

;	INTEGER FUNCTION ISETAB(ITABLE)
;	CALL SETSYM ('TABLE',ITABLE,IERR)
;	ISETAB = IERR
;	RETURN
;	END	

;For a description of symbols, see SETSYM routine.

HELLO	(ISETAB,1,1,ISET02)
	GETARG	(INTEGER,1)	;Get arg to ISETAB (table number)
	MOVEM	T1,ITABLE	;Store as 2nd arg to SETSYM
	MOVE	T1,[ASCII /TABLE/]
	MOVEM	T1,IFUNC	;Tell SETSYM to switch tables
	OUTSTR	[ASCIZ /
[Function ISETAB has called subroutine SETSYM to change tables]/]
				;Call SETSYM directly to avoid the message
	XMOVEI	L,[-3,,0	  ;3 args
		INTEGER	IFUNC#	  ;'TABLE'
		INTEGER	ITABLE#	  ;Postive or 0 table number
		INTEGER	IERR#	  ;Error flag
		]+1		;Point to args
	PUSHJX	%SETSYM		;Call the routine in SYMBOL module
	MOVE	L,[ISET02,,2]	;Restore ACs
	BLT	L,15
	MOVE	L,LISETAB	;Restore arg pointer
	MOVE	T0,IERR		;Return error flag as function value
	POPJ	P,

	$END$	(ISETAB)	>  ;End TOPS10
SUBTTL	Subroutine Descriptions -- MKTBL  - Make table from in-core array
	SEARCH	PLTUNV	;Search the universal file
IFN FTMKTB,<
TTL	(<MKTBL  - Sets up the offset tables for SYMBOL>,DUMMY)

;Calling sequence:
;	CALL MKTBL(ITABLE, IARRAY)
;
;  ITABLE - The table to define.  Integer from 1 to 15.
;  IARRAY - Table of 128 pointers, the left half has the number of offsets
;	in the character, the right half points to a string of 5 bit bytes
;	in triplets (Pen up-down, X, and Y).


	ENTRY   MKTBL
	MKTBL=%MKTBL##		;Defined in SYMBOL module


;**** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ***


	PRGEND		> ;End of IFN FTMKTB
SUBTTL	Subroutine Descriptions -- MSETAB - Fake a call to SETSYM
	SEARCH	PLTUNV	;Search the universal file
	SALL
TOPS10<	;Obsolete function
TTL	(<MSETAB - Calls SETSYM to read SYMBOL:SYMBOL.DAT[-]>,OBSOLETE)

;	INTEGER FUNCTION MSETAB(ITABLE)
;	CALL SETSYM ('TABLE',-ITABLE,IERR)	!Negative
;	MSETAB = IERR
;	RETURN
;	END	

HELLO	(MSETAB,1,1,MSET02)
	GETARG	(INTEGER,1)	;Get arg to MSETAB (table number)
	MOVNM	T1,ITABLE	;Store negative number for SETSYM
	OUTSTR	[ASCIZ /
[Function MSETAB has called subroutine SETSYM to change tables]/]
				;Call SETSYM directly to avoid the message
	XMOVEI	L,[-3,,0	  ;3 args
		INTEGER	IFUNC#	  ;'TABLE'
		INTEGER	ITABLE#	  ;Postive or 0 table number
		INTEGER	IERR#	  ;Error flag
		]+1		;Point to args
	PUSHJX	%SETSYM		;Call the routine in SYMBOL module
	MOVE	L,[MSET02,,2]	;Restore ACs
	BLT	L,15
	MOVE	L,LMSETAB	;Restore arg pointer
	MOVE	T0,IERR		;Return error flag as function value
	POPJ	P,

	$END$	(MSETAB)	>  ;End TOPS10
SUBTTL	Subroutine Descriptions -- NEWPEN - Change to different pen color
	SEARCH	PLTUNV	;Search the universal file
TTL	(<NEWPEN - Allows the user to switch pens>)

;Calling sequence:
;	CALL NEWPEN(IPEN,IERR)
;
;  IPEN - The new pen to be used, return current pen if IPEN=0.
;	  IPEN can also be a CHARACTER variable, such as 'BLACK'.
;	  IERR will be returned as a CHARACTER variable if IPEN='QUERY'.
;  IERR - The error flag.  Returned as 0 if no errors in setting up the
;	  new pen, -1 if IPEN is illegal, and returns the current pen
;	  number if IPEN=0.
;  Pen 1 is blue, 2 is black, and 3 is red.


HELLO	(NEWPEN,1,2,NEWP02)

	GETARG	(CHAR%5,1)	;Get integer or CHARACTER*5 value
	MOVEM	T2,IPEN

	XMOVEI	L,[-2,,0	  ;2 args
		INTEGER	IPEN#	  ;Pen number
		INTEGER	IERR#	  ;Error flag
		  ]+1		;Point to args
	PUSHJX	%NEWPEN		;Call routine in PLOT module
	MOVE	L,LNEWPEN	;Restore argument pointer

	NUMARG	2		;Is 2nd arg supplied?
	 JRST	NEWPN1		;No
	MOVE	T2,IERR		;Yes
	PUTARG	(INTLOG,2)	;Store in INTEGER or LOGICAL variable

NEWPN1:	MOVE	T0,[NEWP02,,2]	;Restore ACs
	BLT	T0,15
	MOVE	T0,IERR		;Return function value in T0
	POPJ	P,		;End of NEWPEN

	$END$	(NEWPEN)
SUBTTL	Subroutine Descriptions -- NUMBER - Plot numbers
	SEARCH	PLTUNV	;Search the universal file
TTL	(<NUMBER - Convert floating point to digit string>)

	EXTERN	SYMBOL		;Set up forward reference

;Calling sequence:
;	CALL NUMBER (X, Y, HEIGHT, FNUMB, ANGLE, NDIG)
;	CALL NUMBER (X, Y, HEIGHT, FNUMB, ANGLE, NDIG, IRAD)
;
;  (X,Y)  - The coordinate of the first character to be drawn.
;  HEIGHT - The height of the characters in inches.
;  FNUMB  - The floating point number to be drawn.
;  ANGLE  - The angle of rotation, must be a multiple of 45 degrees.
;  NDIG   - The number of places past the decimal point to draw.
;  IRAD   - Optional radix, from 2 to 36.  Default is 10.
;
;This routine converts the number to a character string and calls SYMBOL.
;
;Example:
;	PI = 3.141592653
;	CALL NUMBER(X,Y,HEIGHT,PI,90.0,2)
;will draw "3.14" at 90 degrees

HELLO	(NUMBER,6,7)
	GETARG	(REAL,1)	;Get X
	MOVEM	T2,NUMBX
	GETARG	(REAL,2)	;Get Y
	MOVEM	T2,NUMBY
	GETARG	(REAL,3)	;Get HEIGHT
	MOVEM	T2,HEIGHT
	GETARG	(REAL,4)	;Get number to be drawn
	MOVEM	T2,FNUMB
	GETARG	(REAL,5)	;Get ANGLE
	MOVEM	T2,ANGLE
	GETARG	(INTEGER,6)	;Get NDIG
	MOVEM	T2,NDIG
	MOVEI	T2,^D10		;Decimal radix
	MOVEM	T2,IRAD
	NUMARG	7		;All 7 args specified?
	 JRST	NUMBR1		;No
	GETARG	(INTEGER,7)	;Yes, get IRAD
	MOVEM	T2,IRAD

NUMBR1:	XMOVEI	L,[-7,,0	  ;7 args for %NUMBER
		REAL	NUMBX#
		REAL	NUMBY#
		REAL	HEIGHT#
		REAL	FNUMB#
		REAL	ANGLE#
		INTEGER	NDIG#
		INTEGER	IRAD#
		  ]+1		;Point to args
	JRSTX	%NUMBER		;Call routine in SYMBOL module

	$END$	(NUMBER)
SUBTTL	Subroutine Descriptions -- OPRTXT - Send a message to the OPR
	SEARCH	PLTUNV	;Search the universal file
TTL	(<OPRTXT - Sends a message to the OPR>)

;Calling sequence:
;	CALL OPRTXT (CSTRNG)
;	CALL OPRTXT (IARRAY,N)
;
;  CSTRNG - CHARACTER string or variable
;  IARRAY - INTEGER array containg the message
;    N    - The number of characters in the message

;Example:
;	CALL OPRTXT ('Need black felt-tip in pen 1')
;	CALL PLOT (X, Y, 0)	!Wait for operator to change pens


HELLO	(OPRTXT,1,2)

	GETARG	(CHARACT,1,2)	;Get byte pointer and byte count (2nd arg)
	DMOVEM	T2,CSTRNG

	XMOVEI	L,[-1,,0	  ;1 arg
		CHARACT	CSTRNG	  ;Byte string descriptor
		  ]+1		;Point to args
	JRSTX	%OPRTXT		;Call routine in PLOT module

ARRAY	CSTRNG[2]

	$END$	(OPRTXT)
SUBTTL	Subroutine Descriptions -- PAUSEP - Cause the plotter to pause
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PAUSEP - Pauses the plotter>)

;Calling sequence:
;	CALL PAUSEP (NSEC)
;
;    NSEC - The number of seconds to pause
;
;Note:  PAUSEP can be used on graphics terminals to allow the user to
;	view the plot.  PAUSEP does not affect the spooled plotter (DP-8),
;	but the command is stored in the disk file in case the 'TEK'
;	program is used to view the plot.


HELLO	(PAUSEP,1,1)

	GETARG	(INTEGER,1)	;Get number of seconds to wait
	MOVEM	T2,NSEC

	XMOVEI	L,[-1,,0
		INTEGER	NSEC#
		  ]+1		;Point to args
	JRSTX	%PAUSEP		;Call routine in PLOT module

	$END$	(PAUSEP)
SUBTTL	Subroutine Descriptions -- PLOT   - Move the pen to X,Y coordinates
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOT.  - Moves the pen>)

;Calling sequence:
;	CALL PLOT (X, Y, IFUNC)
;
;(X,Y)	Floating point values of X and Y to be used in this call to PLOT.
;
;IFUNC	= 999  To finish off the PLOT in proper form.
;---------  999 must be executed before the end of your program  -------------
;	=  13  X and Y are polar coordinates (X = radus and Y = angle in
;	         radians), the movement is with pen up.
;	=  12  X and Y are polar coordinates, the movement is with the
;	         pen down.
;	=  11  X and Y are polar coordinates, the movement is with the last
;	         pen value (2 or 3).
;	=  10  X and Y are polar coordinates (X = radus and Y = angle in
;	         degrees), the movement is with pen up.
;	=   9  X and Y are polar coordinates, the movement is with the
;	         pen down.
;	=   8  X and Y are polar coordinates, the movement is with the last
;	         pen value (2 or 3).
;--------------							---------------------
;	=   7  X and Y are delta values, the movement is with the pen up.
;	=   6  X and Y are delta values, the movement is with the pen down.
;	=   5  X and Y are delta values, the movement is with the old pen (up or down)
;--------------							---------------------
;	=   4  Make the current pen position (X,Y) by shifting the origin.
;--------------   These next two functions are used the most	---------------------
;	=   3  X and Y are coordinates, the movement is with the pen up.
;	=   2  X and Y are coordinates, the movement is with the pen down.
;--------------							---------------------
;	=   1  X and Y are coodinates, leaving the pen as is (up or down).
;	=   0  Make the output to the plotter pause, CRT's will wait for LF.
;	=  -1  Same as '1', except after the movement this point is the origin.
;--------------							---------------------
;   -2 to -13  Set origin to (X,Y) after moving to new position.
;   -999 to abort the plot and delete the disk file (if any).
;
;##NOTE:  For absolute value of "IFUNC" greater than 13 ends the plot.
;The proper way to finish the plot is by:
;	CALL PLOT (X, Y, 999)

PAGE
HELLO	(PLOT,3,3)

	GETARG	(REAL,1)	;Get X coordinate
	MOVEM	T2,XPOS
	GETARG	(REAL,2)	;Get Y coordinate
	MOVEM	T2,YPOS
	GETARG	(INTEGER,3)	;Get function code
	MOVEM	T2,ICODE

	XMOVEI	L,[-3,,0	  ;3 args
		REAL	XPOS#
		REAL	YPOS#
		INTEGER	ICODE#
		  ]+1		;Point to args
	JRSTX	%PLOT		;Call routine in PLOT module

	$END$	(PLOT)
SUBTTL	Subroutine Descriptions -- PLOTCH - Output characters to plotter
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOTCH - Direct output to plotter>)

;Calling sequence:
;	CALL PLOTCH(IPLT,MESAGE,ICOUNT)
;	CALL PLOTCH('TEK','!COLOR BLUE')
;
;  IPLT - Name of plotter.
;
;  MESAGE - Integer array or character variable
;
;  ICOUNT - Number of characters if MESAGE is a numeric array


HELLO	(PLOTCH,2,3)
	GETARG	(CHAR%5,1)	;Get plotter name
	MOVEM	T2,IPLT
	GETARG	(CHARACT,2,3)	;Get byte pointer and count
	DMOVEM	T2,MESAGE
	XMOVEI	L,[-2,,0
		INTEGER	IPLT#
		CHARACT	MESAGE
		  ]+1		;Point to args
	JRSTX	%PLTCH		;Call routine in PLOT module

ARRAY	MESAGE[2]

	$END$	(PLOTCH)
SUBTTL	Subroutine Descriptions -- PLOTER - Define plotter aliases
	SEARCH	PLTUNV	;Search the universal file
IFN FTAPLT,<	;Only if alias plotters

TTL	(<PLOTER - Define new plotter name>)

;Calling sequence:
;	CALL PLOTER (IPLT,IALIAS,IERR)
;
;  IPLT - An existing plotter type.  See PLOTS for list of valid types.
;
;  IALIAS - The new name to define.  Up to 5 letters and/or digits.
;
;  IERR - Returned as 0 if OK, -1 if IPLT is unknown, -2 if table full.


HELLO	(PLOTER,3,3)

	GETARG	(CHAR%5,1)	;Get known plotter type
	MOVEM	T2,IPLT
	GETARG	(CHAR%5,2)	;Get alias
	MOVEM	T2,IALIAS

	XMOVEI	L,[-3,,0
		INTEGER	IPLT#
		INTEGER	IALIAS#
		INTEGER	IERR#
		  ]+1		;Point to args
	PUSHJX	%PLTER		;Call routine in PLOT module
	MOVE	L,LPLOTER	;Restore arg pointer

	MOVE	T2,IERR		;Get error flag
	PUTARG	(INTLOG,3)	;Store in INTEGER or LOGICAL variable
	POPJ	P,		;End of PLOTER

	$END$	(PLOTER)>  ;End of IFN FTAPLT
SUBTTL	Subroutine Descriptions -- PLOTOF - Temporarily disable output
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOTOF - Turn off one of the plotters>)

;Calling sequence:
;	CALL PLOTOF (IPLT)
;
;  IPLT - The plotter to turn off.  Zero means current plotter, -1
;	  or 'ALL' means all active plotters.  See PLOTS for list.
;
;NOTE:  If your program intends to do READ/ACCEPT from the terminal or
;	WRITE/TYPE to the terminal, you must call PLOTOF to reset the graphics
;	terminal to text mode.  Subroutine PLOTON will resume plotting without
;	erasing the screen, subroutine PLOTS will erase and start over.


HELLO	(PLOTOF,1,1)

	GETARG	(CHAR%5,1)	;Get plotter name
	MOVEM	T2,IPLT

	XMOVEI	L,[-1,,0
		INTEGER	IPLT#
		  ]+1		;Point to args
	JRSTX	%PLTOF		;Call routine in PLOT module

	$END$	(PLOTOF)
SUBTTL	Subroutine Descriptions -- PLOTOK - Get status of the plotter
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOTOK - Check on plotter status>)

;Calling sequence:
;	CALL PLOTOK (IPLT,IOK,DNAME,X,Y,IPEN,FACTX,FACTY,ORIGX,ORIGY,ANGLE)
;
;  IPLT  - The type of plotter to check.  See PLOTS for list.
;  IOK   - Plotter status, -1 if no such plotter, 0 if OFF, 1 if ON
;  DNAME - Output device and file name, double precision in (A10) format
;  X     - Current pen position
;  Y     -   "           "
;  IPEN  - Current pen number, negative if pen is up (Set by PLOT and NEWPEN)
;  FACTX - Scaling factor in X direction        (Set by call to FACTOR)
;  FACTY - Scaling factor in Y direction
;  ORIGX - Coordinate of absolute origin        (Set by CALL PLOT (X,Y,-3)
;  ORIGY -  "           "            "
;  ANGLE - Rotation angle in degrees            (Set by call to ROTATE)



;**** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ***



	ENTRY	PLOTOK
	PLOTOK==%PLTOK##	;Defined in PLOT module
	PRGEND
SUBTTL	Subroutine Descriptions -- PLOTON - Resume plotting
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOTON - Turn on one of the plotters>)

;Calling sequence:
;	CALL PLOTON (IPLT)
;
;  IPLT - The plotter to turn on.  Zero means current plotter, -1
;	  or 'ALL' means all active plotters.  See PLOTS for list.
;
;NOTE:  PLOTS can be called more than once, to send output to the spooled
;	plotter and to the Tektronix simultaneously.  You can call PLOTOF
;	and PLOTON to turn on and off each plotter individually.


HELLO	(PLOTON,1,1)

	GETARG	(CHAR%5,1)	;Get plotter name
	MOVEM	T2,IPLT

	XMOVEI	L,[-1,,0
		INTEGER	IPLT#
		  ]+1		;Point to args
	JRSTX	%PLTON		;Call routine in PLOT module

	$END$	(PLOTON)
SUBTTL	Subroutine Descriptions -- PLOTS  - Initialize the plotter
	SEARCH	PLTUNV	;Search the universal file
TTL	(<PLOTS  - Initializes the plot)>)

;Calling sequence:
;	CALL PLOTS (IERR)
;	CALL PLOTS (IERR, IPLT)
;	CALL PLOTS (IERR, IPLT, DFILE)
;
;  IERR   - (input) The number of "window exceeded" errors to display.
;		If negative, the subroutine calls will be traced.
;	    (output) The error flag.  Zero means no errors.
;		-1 if no such plotter, positive numbers for output file failure.
;
;  IPLT   - The type of plotter to set up.  This variable can be INTEGER,
;	    CHARACTER*5, or a character constant.
;     '     ' or   0	Default plotter ('SPOOL' unless set otherwise)
;     'PLOT'  or 'PLT'	Same as 0, use the default plotter
;     'TTY'		'TEK', 'GIGI', 'VT125' depending on terminal type
;     'SPOOL' or   1	Spooled disk file, use ".PLOT *.PLT" to send to plotter
;     'ARDS'  or   2	Advanced Remote Display Station
;     'TEK'   or   3	Generic Tektronix terminal (same as 4010)
;     'REGIS' or   4	Generic ReGIS terminal (GIGI, VT125, HI-DMP4R)
;     'XY10'  or  10	Unspooled output directly to plotter (DEC format)
;     100, 200, or 400	Spooled disk file, using that many increments per inch
;     'GIGI', 'VK100', 'VT125', or 'DMP4R' = Specific ReGIS terminals
;     '4006' or 4006	Tektronix 4006 terminal
;     '4010' or 4010	Tektronix 4010 or 4012 terminal
;     '4014' or 4014	Tektronix 4014 terminal using full resolution
;     '4025' or 4025	Tektronix 4025 raster scan terminal
;     '4113' or 4113	Tektronix 4113 raster scan terminal
;
;  DFILE  - (optional) A character string or double-precision variable
;	    specifying the device and file name for output.
;	    Only device and file name can be specified, the extensions are:
;	    SPOOL=.PLT, TEK=.TEK, REGIS=.PIC

;Examples:
;	IERR = 0			!Do not trace window exeeded errors
;	CALL PLOTS (IERR,'TEK')		!Set TEKTRONIX into graphics mode
;	IF (IERR.NE.0) STOP 'Cannot open PLOT file'
;
;		or
;
;	IERR = -9			!Trace first 9 errors
;	CALL PLOTS (IERR,'SPOOL','LIB:ABCDEF') !Send data to LIB:ABCDEF.PLT
;	IF (IERR.NE.0) STOP 'Cannot open PLOT file'
;
;Note: On the last example, logical device LIB: can be defined by
;	.PATH LIB:/SEARCH=[13,10,PLTLIB,V12A]

PAGE
IFL FTHEAD,<	EXTERN	SYMBOL,SETSYM >
	EXTERN	.PLOT.		;Default plotter (ASCII/SPOOL/)

HELLO	(PLOTS,1,3)

	MOVE	T1,.PLOT.##	;Get default plotter type
	MOVEM	T1,IPLT
	DMOVE	T1,[POINT 7,[ASCII /     /]
		    EXP 5]
	DMOVEM	T1,DFILE	;Point to 5 blanks
	GETARG	(INTLOG,1)	;Get initial value of IERR
	MOVEM	T2,IERR		;It is number of warnings to trace
	NUMARG	2		;Is IPLT specified?
	 JRST	PLOTS1		;No, use default
	GETARG	(CHAR%5,2)	;Yes, go get it
	MOVEM	T2,IPLT
	NUMARG	3		;File name supplied?
	 JRST	PLOTS1		;No
	GETARG	(CHAR10,3)	;Yes, get CHARACTER or DOUBLE-PRECISION name
	DMOVEM	T2,DFILE

PLOTS1:	XMOVEI	L,[-3,,0
		INTEGER	IERR#
		INTEGER	IPLT#
		CHARACT	DFILE
		  ]+1		;Point to args
	PUSHJX	%PLOTS		;Call routine in PLOT module
	MOVE	L,LPLOTS	;Restore arg pointer

	MOVE	T2,IERR		;Get error flag
	PUTARG	(INTLOG,1)	;Return as 1st arg
	POPJ	P,		;End of PLOTS

ARRAY	DFILE[2]

	$END$	(PLOTS)
SUBTTL	Subroutine Descriptions -- ROTATE - Set up for a rotation of axis
	SEARCH	PLTUNV	;Search the universal file
TTL	(<ROTATE - Sets up for a rotation of axis>)

;Calling sequence:
;	CALL ROTATE (IFUNC, X, Y, ANGLE)
;
; (X,Y) - The coordinate the plot is to be rotated about, new origin
; ANGLE - The angle the plot is to be rotated about, in degrees
; IFUNC = 0 or 'CLEAR' To clear all rotation, set origin to lower left corner
;		Current origin and angle are returned in X, Y, and ANGLE
;	< 0 or 'SET'   To set rotation to ANGLE, regardless of previous rotation.
;	> 0 or 'SUM'   To sum the new angle with old rotation.
;	IFUNC can be an INTEGER or a CHARACTER*5 variable.
;
;NOTE:	The origin set by CALL PLOT(X,Y,-3) affects all plotters equally.
;	The origin set by ROTATE affects only the plotters currently active.
;	The origin of the Tektronix can be set to be different from that of
;	the spooled plotter by calling PLOTOF to disable all other plotters
;	before calling ROTATE, and calling PLOTON after.


HELLO	(ROTATE,4,4)

	GETARG	(CHAR%5,1)	;Get function code
	MOVEM	T2,IFUNC
	GETARG	(REAL,2)	;Get X
	MOVEM	T2,ROTX
	GETARG	(REAL,3)	;Get Y
	MOVEM	T2,ROTY
	GETARG	(REAL,4)	;Get angle
	MOVEM	T2,ANGLE

	XMOVEI	L,[-4,,0
		INTEGER	IFUNC#
		REAL	ROTX#
		REAL	ROTY#
		REAL	ANGLE#
		  ]+1		;Point to args
	JRSTX	%ROTATE		;Call routine in PLOT module

	$END$	(ROTATE)
SUBTTL	Subroutine Descriptions -- SETABL - Change table for SYMBOL (DEC routine)
	SEARCH	PLTUNV	;Search the universal file
IFN FTMKTB,<
TTL	(<SETABL - Changes table for SYMBOL (DEC routine)>,DUMMY)

;Calling sequence:
;	CALL SETABL (ITABLE, IFLAG)
;
;  ITABLE - The table to define.  An integer from 1 to 15, or 0.
;  IFLAG  - Set to 0 if table is defined, -1 if not.  If ITABLE is zero
;	     IFLAG is returned as the number of the current table
;
;  This routine is included for compatiblity with DEC routines, subroutine
;SETSYM should be used instead.  Description of SETABL and MKTBL in MKTBL.DOC


	ENTRY	 SETABL
	SETABL=%SETABL##	;Defined in SYMBOL module


;**** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ** UNDOCUMENTED ** INCOMPLETE ***


	PRGEND		>  ;End of FTMKTB
SUBTTL	Subroutine Descriptions -- SETWIN - Set the size of the universal window
	SEARCH	PLTUNV	;Search the universal file
TTL	(<SETWIN - Sets up the window size>)

;Calling sequence:
;	CALL SETWIN (WX, WY, PRVX, PRVY, IERR)
;
;  WX  - The requested width of the window in inches (X direction)
;  WY  - The requested height of the window in inches (Y direction)
; PRVX - The maximum width you are allowed to use.
; PRVY - The maximum height you are allowed to use.
; IERR - Returned error flag
;	 0 = No errors, PRVX and PRVY are set to the max allowed for your job
;	 1 = WX and WY are bigger than the graphics terminal can handle, but
;	    no real error occured.  PRVX and PRVY are the terminal's maximums.
;	-1 = WX and WY are too big, try again using PRVX or PRVY limits.
;	-2 = Illegal to call SETWIN twice, or after first call to PLOT.
;
;	 Users are limited to 11 inches unless special privleges are granted.
;
;  This subroutine defines the universal window.  It must be called before
;PLOT and SUBWIN, but after PLOTS to avoid IERR = -2.


HELLO	(SETWIN,2,5)

	GETARG	(REAL,1)	;Get X limit
	MOVEM	T2,WX
	GETARG	(REAL,2)	;Get Y limit
	MOVEM	T2,WY

	XMOVEI	L,[-5,,0
		REAL	WX#
		REAL	WY#
		REAL	PRVX#
		REAL	PRVY#
		INTEGER	IERR#
		  ]+1		;Point to args
	PUSHJX	%SETWIN		;Call routine in PLOT module
	MOVE	L,LSETWIN	;Restore arg pointer

	NUMARG	5		;All 5 argument specified?
	 JRST	SETWI1		;No
	MOVE	T2,PRVX		;Max X as set by SYS:PRIV.SYS
	PUTARG	(REAL,3)
	MOVE	T2,PRVY
	PUTARG	(REAL,4)
	MOVE	T2,IERR		;Error code
	PUTARG	(INTLOG,5)
	POPJ	P,

SETWI1:	SKIPGE	IERR		;Any bad errors detected?
	 ERRSTR	(WRN,<% SETWIN arguments exceed plotting privileges, proceeding>)
	POPJ	P,		;End of SETWIN

	$END$	(SETWIN)
SUBTTL	Subroutine Descriptions -- SUBWIN - Set/reset/status of sub-window
	SEARCH	PLTUNV	;Search the universal file
TTL	(<SUBWIN - Allows the user to set up subwindows>)

;  This routine allows the user to set up a subwindow.  The user can
;also turn the subwindow feature off and on at will.  No lines will
;be plotted outside the current subindow.
;
;Calling sequence:
;
;	CALL SUBWIN (IFUNC, IVALUE, X0, Y0, WIDTH, HEIGHT)
;
;  IFUNC  - (Input) allows for 4 modes of operation
;	     0 or 'SET'  - Set up the window.
;	     1 or 'READ' - Read the window size and ON/OFF flag.
;	     2 or 'OFF'  - Disable the subwindow for now.
;	     3 or 'ON'   - Reenable the window with the last subwindow defined.
;
;  IVALUE - (Output) A mode (IFUNC) dependent value (if IFUNC < 0 or IFUNC > 4
;	    then IVALUE will be set equal to -1)
;	     IFUNC = 0 or 'READ'
;	      -1 - Error - The width or height was less than zero.
;	       0 - The window was set up.
;	     IFUNC = 1 or 'SET'
;	      -1 - Error - No subwindow has been set up yet.
;	       0 - The subwindow is defined, but disabled.
;	       1 - The subwindow is defined and active.
;	     IFUNC = 2 or 'OFF', or 3 or 'ON'
;	      -1 - Error - No subwindow was set up.
;	       0 - The subwindow checking was set or cleared.
;
;  X0,Y0  - (I/O) The coordinate of the lower hand corner of the subwindow
;	    (not used if IFUNC = 2, 3, 'OFF', or 'ON')
;
;  WIDTH  - (I/O) The width of the window (not used if IFUNC = 2 or 3)
;
;  HEIGHT - (I/O) The height of the window (not used if IFUNC = 2 or 3)


HELLO	(SUBWIN,6,6)

	GETARG	(CHAR%5,1)	;Get function code
	MOVEM	T2,IFUNC
	GETARG	(REAL,3)	;Get X limit
	MOVEM	T2,XLEFT
	GETARG	(REAL,4)	;Get Y limit
	MOVEM	T2,YBOTTM
	GETARG	(REAL,5)	;Delta X
	MOVEM	T2,WIDTH
	GETARG	(REAL,6)	;Delta Y
	MOVEM	T2,HEIGHT

	XMOVEI	L,[-6,,0
		INTEGER	IFUNC#
		INTEGER	IVALUE#
		REAL	XLEFT#
		REAL	YBOTTM#
		REAL	WIDTH#
		REAL	HEIGHT#
		  ]+1		;Point to args
	PUSHJX	%SUBWIN		;Call routine in PLOT module
	MOVE	L,LSUBWIN	;Restore arg pointer

	MOVE	T2,IVALUE	;Return error flag
	PUTARG	(INTEGER,2)
	POPJ	P,		;End of SUBWIN

	$END$	(SUBWIN)
SUBTTL	Subroutine Descriptions -- SYMBOL - Plot symbols (letters, digits, etc)
	SEARCH	PLTUNV	;Search the universal file
TTL	(<SYMBOL - Plots characters and symbols>)	;Must be BEFORE 'SETSYM'

	EXTERN	SETSYM		;Module with data for SYMBOL

;Calling sequence:
;	CALL SYMBOL (X, Y, HEIGHT, CSTRNG, ANGLE)
;	CALL SYMBOL (X, Y, HEIGHT, IARRAY, ANGLE, NUMCHR)
;
;  (X,Y)  - The coordinate of the first character to be drawn.
;  HEIGHT - The height of the characters in inches.
;  IARRAY - An integer array of Hollerith characters, or an integer number.
;  CSTRNG - A CHARACTER string or variable.
;  ANGLE  - The angle of rotation, must be a multiple of 45 degrees.
;  NUMCHR - the number of characters stored in IARRAY.
;	If NUMCHR is zero, plot the single char whose ASCII code is in ICHAR.
;
;This routine uses subroutine PLOT to draw the characters.
;
;Example:
;	IF(TITLEP(IPLT)) CALL TITLE (X,Y,H,'Testing',0.0)
;	ELSE             CALL SYMBOL(X,Y,H,'Testing',0.0)


HELLO	(SYMBOL,5,6)
	GETARG	(REAL,1)	;Get X
	MOVEM	T2,SYMX
	GETARG	(REAL,2)	;Get Y
	MOVEM	T2,SYMY
	GETARG	(REAL,3)	;Get HEIGHT
	MOVEM	T2,HEIGHT
	GETARG	(CHARACT,4,6)	;Get addr of string and byte count
	DMOVEM	T2,CSTRNG
	GETARG	(REAL,5)	;Get ANGLE
	MOVEM	T2,ANGLE

	XMOVEI	L,[-5,,0	  ;5 args for %SYMBOL
		REAL	SYMX#
		REAL	SYMY#
		REAL	HEIGHT#
		CHARACT	CSTRNG
		REAL	ANGLE#
		  ]+1		;Point to args
	JRSTX	%SYMBOL		;Call routine in SYMBOL module

ARRAY	CSTRNG[2]

	$END$	(SYMBOL)
SUBTTL	Subroutine Descriptions -- SETSYM - Get data from SYMBOL.DAT
	SEARCH	PLTUNV	;Search the universal file
TTL	(<SETSYM - Data for subroutine SYMBOL>)		;Must be AFTER 'SYMBOL'

;  This subroutine reads the SYMBOL table from either SYS:SYMBOL.DAT[1,4]
;or SYMBOL:SYMBOL.DAT[-], or returns information about the tables.
;NOTE:  In order to use the negative tables, the user must define the
;logical device SYMBOL: via the ASSIGN or PATH commands to the Monitor.

;Calling sequence:
;	CALL SETSYM(IFUNC,IARG,IANS)	!For 'NAME', DIMENSION IANS(3)
; IFUNC = (input)  Name of the function to perform.  INTEGER or CHARACTER*5.
; IARG  = (input)  The argument of the function
; IANS  = (output) Returned answer, INTEGER array for 'NAME'
;See SYMBOL.MAC for further details


HELLO	(SETSYM,3,3)
	GETARG	(CHAR%5,1)	;Get IFUNC
	MOVEM	T2,IFUNC
	GETARG	(INTEGER,2)	;Get IARG
	MOVEM	T2,IARG
	GETARG	(IARRAY,3)	;Get addr of IANS array
	MOVEM	T2,IANS

	XMOVEI	L,[-3,,0	  ;3 args for %SETSYM
		INTEGER	IFUNC#
		INTEGER	IARG#
		INTEGER	@IANS#
		  ]+1		;Point to args
	JRSTX	%SETSYM		;Call routine in SYMBOL module

	$END$	(SETSYM)
SUBTTL	Subroutine Descriptions -- TITLE  - Plot symbols (letters, digits, etc)
	SEARCH	PLTUNV	;Search the universal file
TTL	(<TITLE  - Activates hardware character generator>)

;Calling sequence:
;	CALL TITLE (X, Y, HEIGHT, CSTRNG, ANGLE)
;	CALL TITLE (X, Y, HEIGHT, IARRAY, ANGLE, NUMCHR)
;
;  (X,Y)  - The coordinate of the first character to be drawn.
;  HEIGHT - The height of the characters in inches.
;  IARRAY - An integer array of Hollerith characters, or an integer number.
;  CSTRNG - A CHARACTER string or variable.
;  ANGLE  - The angle of rotation, must be a multiple of 45 degrees.
;  NUMCHR - the number of characters stored in IARRAY.
;	If NUMCHR is zero, plot the single char whose ASCII code is in ICHAR.
;
;This routine uses the hardware character set if the plotter has one.
;
;Example:
;	IF(TITLEP(IPLT)) CALL TITLE (X,Y,H,'Testing',0.0)
;	ELSE             CALL SYMBOL(X,Y,H,'Testing',0.0)


HELLO	(TITLE,5,6)
	GETARG	(REAL,1)	;Get X
	MOVEM	T2,TITLX
	GETARG	(REAL,2)	;Get Y
	MOVEM	T2,TITLY
	GETARG	(REAL,3)	;Get HEIGHT
	MOVEM	T2,HEIGHT
	GETARG	(CHAR10,4,6)	;Get addr of string and byte count
	DMOVEM	T2,CSTRNG
	GETARG	(REAL,5)	;Get ANGLE
	MOVEM	T2,ANGLE

	XMOVEI	L,[-5,,0	  ;5 args for %TITLE
		REAL	TITLX#
		REAL	TITLY#
		REAL	HEIGHT#
		CHARACT	CSTRNG
		REAL	ANGLE#
		  ]+1		;Point to args
	JRSTX	%TITLE		;Call routine in PLOT module

ARRAY	CSTRNG[2]

	$END$	(TITLE)
SUBTTL	Subroutine Descriptions -- TITLEP - Determine if TITLE is possible)
	SEARCH	PLTUNV	;Search the universal file
TTL	(<TITLEP - Checks if plotter has hardware character set>)

;Calling sequence:
;	LOGICAL TITLEP,IFLAG
;	IFLAG = TITLEP(IPLT)
;
;  IFLAG  - Returned value is .TRUE. if plotter has a hardware character set
;  IPLT   - Plotter type, same as for subroutine PLOTS.
;
;Example:
;	IF(TITLEP(IPLT)) CALL TITLE (X,Y,H,'Testing',0.0)
;	ELSE             CALL SYMBOL(X,Y,H,'Testing',0.0)


HELLO	(TITLEP,1,1,TITL02)
	GETARG	(CHAR%5,1)	;Get plotter type
	MOVEM	T2,IPLT

	XMOVEI	L,[-1,,0	  ;1 arg for %TITLP
		INTEGER	IPLT#
		  ]+1		;Point to args
	PUSHJX	%TITLP		;Call routine in PLOT module
	MOVE	L,[TITL02,,2]	;Restore ACs
	BLT	L,15
	MOVE	L,LTITLEP
	POPJ	P,		;AC 0 has function value

	$END$	(TITLEP)
SUBTTL	Subroutine Descriptions -- WHERE  - Get current pen position
	SEARCH	PLTUNV	;Search the universal file
TTL	(<WHERE  - Returns the current loctation of the pen>)

;Calling sequence:
;	CALL WHERE (X, Y, FACT)
;	CALL WHERE (X, Y, FACT, IPLT, FACTY)
;
;    X   - The current X value of the point
;    Y   - The current Y value of the point
;   FACT - The current factor value
;   IPLT - (optional) The current type of plotter in use:
;		 1 - Spooled version, compressed output for PLTSPL
;		 2 - ARDS terminal
;		 3 - TEKTRONIX terminal
;		 4 - ReGIS terminal (GIGI,VT125)
;		10 - Expanded output for XY-10
;  FACTY - (optional) The current factor used in the Y direction


HELLO	(WHERE,2,5)

	XMOVEI	L,[-5,,0
		REAL	XPOS#
		REAL	YPOS#
		REAL	FACTX#
		INTEGER	IPLT#
		REAL	FACTY#
		  ]+1		;Point to args
	PUSHJX	%WHERE		;Call routine in PLOT module
	MOVE	L,LWHERE	;Restore arg pointer

	MOVE	T2,XPOS
	PUTARG	(REAL,1)
	MOVE	T2,YPOS
	PUTARG	(REAL,2)
	NUMARG	3		;3rd arg supplied?
	 POPJ	P,
	MOVE	T2,FACTX	;FACTOR in X direction
	PUTARG	(REAL,3)
	NUMARG	4		;4th arg wanted?
	 POPJ	P,
	MOVE	T2,IPLT		;Type of plotter
	PUTARG	(INTEGER,4)
	NUMARG	5		;5th arg wanted?
	 POPJ	P,
	MOVE	T2,FACTY	;Factor in Y direction
	PUTARG	(REAL,5)
	POPJ	P,		;End of WHERE

	$END$	(WHERE)
SUBTTL	Subroutine Descriptions -- XHAIRS - Trigger crosshairs on TEK 4012
	SEARCH	PLTUNV	;Search the universal file
TTL	(<XHAIRS - Triggers crosshairs on TEK 4012 and GIGI>)

;Calling sequence:
;	CALL XHAIRS (XPOS, YPOS, LETTER)
;	CALL XHAIRS (XPOS, YPOS, LETTER, DSTRNG)
;
;  XPOS  - The X coordinate of the crosshairs
;  YPOS  - The Y coordinate of the crosshairs
; LETTER - The character that was typed.  Normal characters are
;	   returned in an 'A1' format, control characters are returned
;	   as a number between 1 and 31 in an 'R1' format.
; DSTRNG - (optional) The string of characters as sent by terminal
;	   left justified in a DOUBLE PRECISION variable.  (10 characters
;	   for GIGI, only 5 for TEKTRONIX.)  May be a CHARACTER variable.
;
;  If the character typed is a Control-L (formfeed), the screen is erased,
;the beam position set to (0,0) at the lower left corner of the screen,
;and all arguments are returned as zero.


HELLO	(XHAIRS,3,4)

	XMOVEI	L,[-4,,0
		REAL	XPOS#
		REAL	YPOS#
		INTEGER	LETTER#
		CHARACT	DSTRNG
		  ]+1		;Point to args
	PUSHJX	%XHAIRS		;Call routine in PLOT module
	MOVE	L,LXHAIRS	;Restore arg pointer

	MOVE	T2,XPOS
	PUTARG	(REAL,1)
	MOVE	T2,YPOS
	PUTARG	(REAL,2)
	MOVE	T2,LETTER
	PUTARG	(CHAR%5,3)
	NUMARG	4		;Is 4th arg present?
	 POPJ	P,
	DMOVE	T2,DSTRNG	;Yes
	PUTARG	(CHAR10,4)
	POPJ	P,		;End of XHAIRS

ARRAY	DSTRNG[2]

	$END$	(XHAIRS)
SUBTTL	%ARGET -- Check if caller supplied enough arguments
	SEARCH	PLTUNV	;Search the universal file
TTL	(<%ARGET - Argument verification module>,MAIN)

	ENTRY	%ARGET		;Retrieve argument
	ENTRY	%ARGPT		;Store argument

	SIXBIT	/%ARGET/
%ARGET::JUMPGE	T1,ARGET	;-1 in LH to check size of arg list
	MOVEM	T2,MODULE	;Remember module name
	LDB	T2,[POINTR T1,ARG%MN] ;Get minimum number
	LDB	T3,[POINTR T1,ARG%MX] ;Get maximum
	HLRE	T4,-1(L)	;Get arg count
	MOVNS	T4		;Make positive
	CAMGE	T4,T2		;More than min?
	 JRST	NOTENF		;Not enough
	CAMLE	T4,T3		;More than max?
	 JRST	TOOMNY		;Yes
	POPJ	P,		;OK

NOTENF:	ERRSTR	(FTL,<?ARGTST - Not enough arguments>)
	PUSHJ	P,TRACE.##	;Trace subroutine calls
	MONRT.			;Abort
	POPJ	P,		;Proceed if user is foolish enough to continue

TOOMNY:	SOSGE	WRNCNT		;Want this warning?
	 POPJ	P,		;No
	ERRSTR	(MSG,<%ARGTST - Extra arguments ignored in subroutine >)
	MOVE	T2,MODULE	;Output the name of the subroutine
	PUSHJ	P,OUTSIX
	PUSHJ	P,TRACE.##	;Trace subroutine calls
	POPJ	P,		;Continue (PJRST confuses TRACE.)
SUBTTL	%ARGET -- GET - Dispatch based on argument type

ARGET:	LDB	T2,[POINTR T1,ARG%TP] ;Get expected type
	HLRZ	T3,T1		;Optional data
	LDB	T1,[POINTR T1,ARG%PS] ;Argument position
	MOVEM	T1,ARGPOS	;Save for MISMAT routine
	SUBI	T1,1		;First argument is at position 0
	ADD	T1,L		;Point to argument descriptor
	HRRO	T4,ARGTPG(T2)	;'GET' dispatch routine
	PJRST	(T4)		;Go to it


DEFINE XX(NAME,VAL,TEXT),<
	XWD VAL,G'NAME>		;LH is not really used

ARGTPG:	$ARGTP			;Dispatch table for GET


GUNSPE:		;(00) Unspecified
G$3TYP:		;(03) Undefined
G$5TYP:		;(05) Undefined
G$16TY:		;(16) Undefined
	ERRSTR	(FTL,<?ARGTST - GET of unsupported argument type>)
	MONRT.		;Will not happen
	POPJ	P,
SUBTTL	%ARGET -- Get single or double word numeric data

IFN SITGO,<PRINTX %ARGET needs to be re-written for SITGO calling conventions>

;INTEGER, REAL, LOGICAL, OCTAL - Get a single-word number

GLOGIC:		;(01) LOGICAL
GINTEG:		;(02) INTEGER
GREAL:		;(04) REAL
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAME	T4,T2		;Match?
G1WBAD:	 PUSHJ	P,MISMAT	;No
GOCTAL:		;(06) OCTAL (any single-word variable)
	MOVE	T2,@0(T1)	;Get it
	POPJ	P,


;INTLOG - Get an error flag (0 or -1) from a LOGICAL or INTEGER variable

GINTLO:		;(21) INTEGER or LOGICAL
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAIE	T4,ACTYPE(INTEGER)
	CAIN	T4,ACTYPE(LOGICAL)
	 JRST	GOCTAL		;Is INTEGER or LOGICAL, proceed
	JRST	G1WBAD		;Complain


;DREAL, DCOMP, GFLOAT, COMPLEX, DOCTAL - Get a double-word number

GDREAL:		;(10) DOUBLE PRECISION
GDCOMP:		;(11) 2-word COMP integer
GGFLOA:		;(13) G-Floating DOUBLE PRECISION
GCOMPL:		;(14) COMPLEX
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAME	T4,T2		;Match?
	 PUSHJ	P,MISMAT	;No
GDOCTA:		;(12) double OCTAL (any two-word variable)
	DMOVE	T2,@0(T1)	;Get double word
	POPJ	P,
SUBTTL	%ARGET -- Get CHARACTER data

;CHARACTER - Get byte pointer and byte count
;		T3 has position of optional byte count argument

GCHARA:		;(15) CHARACTER
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAMN	T4,T2		;Is it a CHARACTER string?
	 JRST	GETBSD		;Yes, get byte string descriptor
	JUMPE	T3,MISMAT	;No, give up if optional data not present
	MOVEI	T2,@0(T1)	;Get address of numeric array
	HRLI	T2,(POINT 7,)	;Make into byte pointer (not 30-bit addr)
	SUBI	T3,1		;First arg is at offset 0
	ADD	T3,L		;Point to descriptor of byte count
	MOVE	T3,@0(T3)	;Get the byte count
	POPJ	P,

GETBSD:				;Get Byte String Descriptor
	DMOVE	T2,@0(T1)	;Get double word
	ANDX	T3,CHR%BC	;Wipe out flags, keep only byte count
	POPJ	P,


;STRING - Get a pointer to ASCII string

GSTRIN:		;(17) ASCIZ
	MOVEI	T2,@0(T1)	;Get address (any type of variable is OK)
	HRLI	T2,(POINT 7,)	;Make into byte pointer (not 30-bit addr)
	POPJ	P,


;CHAR%5 - get one word integer or up to 5 bytes of character

GCHAR%:		;(22) CHARACTER*5 or INTEGER
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAIN	T4,ACTYPE(INTEGER)
	 JRST	GOCTAL		;Get integer, bypass check
	CAIE	T4,ACTYPE(CHARACT)
	 JRST	[PUSHJ	P,MISMAT  ;Not INTEGER or CHARACTER
		 JRST	GOCTAL	] ;Get the word anyway
	PUSHJ	P,GETBSD	;CHARACTER, get byte string descriptor
	DMOVEM	T2,ARGS		;Store elsewhere
	MOVEI	T1,5		;Get the first 5 bytes
	MOVEI	T2,0		;Clear result
	MOVE	T3,[POINT 7,T2]	;Destination pointer

G%5LOP:	MOVEI	T4," "		;In case at end
	SOSL	ARGS+1		;If byte is there,
	 ILDB	T4,ARGS+0	;Get it
	IDPB	T4,T3		;Store in T2
	SOJG	T1,G%5LOP	;Do all 5
	POPJ	P,		;Result is in T2

PAGE
;CHAR10 - Get byte string descriptor, or pointer/counter for double precision
;	T3 gets actual byte count if CHARACTER or ASCIZ, it is set to 5
;	for one-word variables, 10 for two-word variables

GCHAR1:		;(23) CHARACTER*10 or DOUBLE PRECISION
	LDB	T4,[ACPNTR (T1)];Get actual type of argument
	CAIN	T4,ACTYPE(CHARACT)
	 PJRST	GETBSD		;Get byte string descriptor

	MOVEI	T2,@0(T1)	;Get addr of numeric argument
	HRLI	T2,(POINT 7,)	;Make into byte pointer (not 30-bit addr)
	MOVEI	T3,5		;Assume one word var
	TRNE	T4,10		;In the range 10-17?
	 MOVEI	T3,^D10		;Assume DOUBLE PRECISION or COMPLEX
	CAIE	T4,ACTYPE(STRING) ;ASCIZ literal string?
GCHR01:	 POPJ	P,		;No
	MOVEI	T3,0		;Yes, clear to get actual byte count
	MOVE	T1,T2		;Copy byte pointer

GCHR02:	ILDB	T4,T1		;Get a char
	JUMPE	T4,GCHR01	;T2 and T3 set when null is encountered
	AOJA	T3,GCHR02	;Loop till end of ASCIZ


GIARRA:		;(20) INTEGER array
	MOVEI	T2,ACTYPE(INTEGER);Expecting an INTEGER argument
	LDB	T4,[ACPNTR (T1)]  ;Get type of actual argument
	CAIE	T4,ACTYPE(CHARACT);Found CHARACTER variable?
	 JRST	GADDR		;No, use MOVEI to get addr of array
	MOVE	T2,@0(T1)	;Yes, get byte pointer to CHARACTER
	POPJ	P,		;(address in RH, LH may or may not be used)


GPROC:		;(07) SUBROUTINE
GADDR:	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAME	T4,T2		;Match?
	 PUSHJ	P,MISMAT	;No
	XMOVEI	T2,@0(T1)	;Get addr of routine
	POPJ	P,
SUBTTL	%ARGPT -- PUT - Dispatch based on argument type

	SIXBIT	/%ARGPT/
%ARGPT::JUMPGE	T1,ARGPT	;-1 in LH to change warning count
	HRREM	T1,WRNCNT	;Number of warning messages to output
	POPJ	P,

ARGPT:	DMOVEM	T2,ARGS		;Store elsewhere for a while
	LDB	T2,[POINTR T1,ARG%TP] ;Get expected type
	HLRZ	T3,T1		;Optional data
	LDB	T1,[POINTR T1,ARG%PS] ;Argument position
	MOVEM	T1,ARGPOS	;Save for MISMAT routine
	SUBI	T1,1		;First argument is at position 0
	ADD	T1,L		;Point to argument descriptor
	HRRO	T4,ARGTPP(T2)	;'PUT' dispatch routine
	PJRST	(T4)		;Go to it

DEFINE XX(NAME,VAL,TEXT),<
	XWD VAL,P'NAME>		;LH is not really used

ARGTPP:	$ARGTP			;Dispatch table for PUT


PUNSPE:		;(00) Unspecified
P$3TYP:		;(03) Undefined
P$5TYP:		;(05) Undefined
PPROC:		;(07) SUBROUTINE
P$16TY:		;(16) Undefined
PSTRIN:		;(17) ASCIZ cannot be stored into
PIARRA:		;(20) Caller handles IARRAY, not PUTARG
	ERRSTR	(FTL,<?ARGTST - PUT of unsupported argument type>)
	MONRT.
	POPJ	P,
SUBTTL	%ARGPT -- Put single or double word numeric data

IFN SITGO,<PRINTX %ARGPT needs to be re-written for SITGO calling conventions>

PLOGIC:		;(01) LOGICAL
PINTEG:		;(02) INTEGER
PREAL:		;(04) REAL
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAME	T4,T2		;Match?
P1WBAD:	 PUSHJ	P,MISMAT	;No
POCTAL:		;(06) OCTAL (any single-word variable)
	MOVE	T2,ARGS		;The single word
	MOVEM	T2,@0(T1)	;Store it
	POPJ	P,

PINTLO:		;(21) INTEGER or LOGICAL
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAIE	T4,ACTYPE(INTEGER)
	CAIN	T4,ACTYPE(LOGICAL)
	 JRST	POCTAL		;Is INTEGER or LOGICAL, proceed
	JRST	P1WBAD		;Complain

PDREAL:		;(10) DOUBLE PRECISION
PDCOMP:		;(11) 2-word COMP integer
PGFLOA:		;(13) G-Floating DOUBLE PRECISION
PCOMPL:		;(14) COMPLEX
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAME	T4,T2		;Match?
	 PUSHJ	P,MISMAT	;No
	DMOVE	T2,ARGS		;The double word
PDOCTA:		;(12) double OCTAL (any two-word variable)
	DMOVEM T2,@0(T1)	;Get double word
	POPJ	P,
SUBTTL	%ARGPT -- Return CHARACTER strings to caller

;CHAR10 - Return A5 or A10 data to string, single word, or double word

PCHAR1:		;(23) CHARACTER*10 or DOUBLE PRECISION
	LDB	T4,[ACPNTR (T1)];Get actual type of argument
	CAIN	T4,ACTYPE(CHARACT)
	 JRST	PCHR01		;Use byte string descriptor to return data
	MOVEI	T2,@0(T1)	;Get addr of arg
	HRLI	T2,(POINT 7,)	;Make into byte pointer
	MOVEI	T3,5		;Assume one word var
	TRNE	T4,10		;In the range 10-17?
	 MOVEI	T3,^D10		;Yes, DOUBLE PRECISION or COMPLEX
	JRST	PCHR02		;Return the data


;CHARACTER - Copy string, truncate if too long, pad if too short

PCHARA:		;(15) CHARACTER
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAMN	T4,T2		;Is it a CHARACTER string?
	 JRST	PCHR01		;Yes, use byte string descriptor
	JUMPE	T3,MISMAT	;No, give up if optional data not present
	MOVEI	T2,@0(T1)	;Get address of numeric array
	HRLI	T2,(POINT 7,)	;Make into byte pointer
	SUBI	T3,1		;First arg is at offset 0
	ADD	T3,L		;Point to descriptor of byte count
	SKIPA	T3,@0(T3)	;Get the byte count and skip

PCHR01:	PUSHJ	P,GETBSD	;Get pointer and count to actual argument

;T2+T3 have pointer/counter for destination, ARGS has pointer/counter for source

PCHR02: MOVEI	T1," "		;In case at end of source
	SOSGE	ARGS+1		;Decrement source count
	 ILDB	T1,ARGS+0	;Get source byte
	IDPB	T1,T2		;Store in destination
	SOJG	T3,PCHR02	;Loop till destination is full
	POPJ	P,

;CHAR%5 - Return A5 variable to an INTEGER or CHARACTER variable

PCHAR%:		;(22) CHARACTER*5 or INTEGER
	LDB	T4,[ACPNTR (T1)];Get type of actual argument
	CAIN	T4,ACTYPE(INTEGER)
	 JRST	POCTAL		;Put integer (bypass check)
	CAIE	T4,ACTYPE(CHARACT)
	 JRST	[PUSHJ	P,MISMAT  ;Not INTEGER or CHARACTER
		 JRST	POCTAL	] ;Put the word anyway
	MOVE	T2,[POINT 7,TEMP]
	EXCH	T2,ARGS+0	;Set pointer, get number
	MOVEM	T2,TEMP
	MOVEI	T3,5		;Return up to 5 characters
	MOVEM	T3,ARGS+1
	JRST	PCHR01		;Copy from TEMP to caller
SUBTTL	MISMAT - output warning message

DEFINE XX(OPDF,NUM,TEXT),<
  IFE NUM,<-1,,[ASCIZ ~UNKNOWN~]>
  IFN NUM,<NUM,,[ASCIZ ~TEXT~]>
>

ARGTPS:	$ARGTP			;Table of pointers to ASCIZ

PAGE
;Output warning on mismatch.  T4 as actual type, T2 has expected type
; %ARGTST - Argument #3 to subroutine PLOT is DOUBLE PRECISION
; %ARGTST - It should be INTEGER

MISMAT:	SOSGE	WRNCNT		;This warning wanted?
	 POPJ	P,		;No
	PUSH	P,T2		;Save expected
	PUSH	P,T4		;Save actual
	ERRSTR	(MSG,<%ARGTST - Argument #>)
	MOVE	T1,ARGPOS	;Get position in argument list
	PUSHJ	P,OUTDEC	;Output decimal number
	MOVEI	T1,[ASCIZ / to subroutine /]
	PUSHJ	P,OUTSTG
	MOVE	T2,MODULE	;Subroutine name
	PUSHJ	P,OUTSIX	; in SIXBIT
	MOVEI	T1,[ASCIZ / is /]
	PUSHJ	P,OUTSTG
	POP	P,T1		;Get actual argument type
	MOVE	T1,ARGTPS(T1)	;Get description
	PUSHJ	P,OUTSTG
	MOVEI	T1,[ASCIZ /
%ARGTST - It should be /]
	PUSHJ	P,OUTSTG
	POP	P,T1		;Get actual type
	MOVE	T1,ARGTPS(T1)	;Get description
	PUSHJ	P,OUTSTG
	PJRST	TRACE.##	;Do a subroutine trace and return


OUTDEC:	IDIVI	T1,^D10		;Standard output routine
	HRLM	T2,(P)
	SKIPE	T1
	 PUSHJ	P,OUTDEC
	HLRZ	T1,(P)
	ADDI	T1,"0"
	PFALL	OUTCH

;*HACK* This conflicts with ERRSTR macro
OUTCH:	OUTCHR	T1		;Output single character in T1
CPOPJ:	POPJ	P,

OUTSTG:	HRLI	T1,(POINT 7,)	;Make into byte pointer
	MOVE	T2,T1
OUTST1:	ILDB	T1,T2
	JUMPE	T1,CPOPJ
	PUSHJ	P,OUTCH
	JRST	OUTST1

OUTSIX:	MOVEI	T1,0		;Clear junk
	ROTC	T1,6		;Put char in T1
	ADDI	T1,40		;Make into ASCII
	PUSHJ	P,OUTCH
	JUMPN	T2,OUTSIX	;Do all in T2
	POPJ	P,



	$LOSEG
WRNCNT:	EXP	-2		;Nonzero to output warning messages
MODULE:	BLOCK	1		;Name of subroutine in SIXBIT
ARGPOS:	BLOCK	1		;Position in argument list
TEMP:	BLOCK	1		;For PCHAR10
ARGS:	BLOCK	2		;Values to be returned via %ARGPT
	$HISEG

	$END$	(%ARGET)
SUBTTL	Default plotter - End of PLTUNV.MAC
	SEARCH	PLTUNV	;Search the universal file
TTL	(<.PLOT. - Default plotter definition for SPOOLer>,DUMMY)

IFE DPLOTT-<ASCII/SPOOL/>,<
IF2,<PRINTX - .PLOT. - Default plotter is ASCII/SPOOL/>>
IFE DPLOTT-<ASCII/TEK/>,<
IF2,<PRINTX - .PLOT. - Default plotter is ASCII/TEK/>>

	ENTRY	.PLOT.
	RELOC	0
.PLOT.::DPLOTT			;Default plotter type for CALL PLOTS(IERR,0)
				; or for CALL PLOTS(IERR).

	END