Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/pltlib/v12a/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