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, DEFINE TOPS20, 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,> IFNDEF SYM,> > > ;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, ;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), > DEFINE TTL ($TXT,$TYPE),< SALL TITLE $TXT %'$VER'$MIN($EDT) IFIDN <$TYPE>,
,> IFDIF <$TYPE>,
,,,>> IFDIF <$TYPE>,,< TOPS10< SEARCH MACTEN,UUOSYM > TOPS20< SEARCH MACSYM,MONSYM > .DIRECTIVE FLBLST $RELOC 400000 > > ;End of DEFINE TTL > ;End of DEFINE $TITLE IFN PLTMIN,<$TITLE \PLTVER,\',\PLTEDT> IFE PLTMIN,<$TITLE \PLTVER,,\PLTEDT> PURGE $TITLE UNV DEFINE STTL ($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,> ;HISEG origin must be 400000 or above DEFINE $LOSEG,> > ;End of IFN FTSHR ; PFALL - Used to verify the flow by falling into subroutines DEFINE PFALL(LABEL),> ;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),> 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., ;Quiet exit to the EXEC OPDEF PJRST [JUMPA 17,] ;Not in MACSYM DEFINE INSVL.(A,B), ;*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, > ;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 ,< FSC AC,233> IFNB ,< MOVE AC,MEM FSC AC,233> >> ;End of KA FLOAT IFE FTKA,< DEFINE FLOAT (AC,MEM),<;;Convert small integers to floating point IFB ,< FLTR AC,AC> IFNB , >> ;End of non-KA FLOAT OPDEF PJRST [PJRST] ;Copy definition to PLTUNV.UNV DEFINE JRSTX(ADDR), DEFINE PUSHJX(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 ,< 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,+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] ;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,,<&ARG%TP>!^D> 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,,<&ARG%TP>!^D> 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,) XX (LOGICAL,01,) XX (INTEGER,02,) XX ($3TYPE , 0,) XX (REAL ,04,) XX ($5TYPE , 0,) XX (OCTAL ,06,) XX (PROC ,07,) XX (DREAL ,10,) XX (DCOMP ,11,) XX (DOCTAL ,12,) XX (GFLOAT ,13,) XX (COMPLEX,14,) XX (CHARACT,15,) XX ($16TYPE, 0,) XX (STRING ,17,) ;;Codes above 20 are defined for GETARG and PUTARG macros XX (IARRAY ,20,) XX (INTLOG ,21,) XX (CHAR%5 ,22,) XX (CHAR10 ,23,) SALL > ;End of DEFINE $ARGTP DEFINE XX(NAME,VAL,TEXT),, ;;Special codes for GETARG IFL ,>> $ARGTP ;Define all the OPDEFs ACFLD== ;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),<_-^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== ;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 () ;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 () ;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 () ;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 () ;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 (,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 (,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 (,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 (,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 () ;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 () 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 () ;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 () ;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 () ;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 () ;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 () ;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 () ;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 () ;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 () ;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 () ;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 () ;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 (,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 () ;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 () ; 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 () ;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 () ;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 () ;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