; ; COPYRIGHT (C) 1976 ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A ; SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION ; OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER ; COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE ; TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE ; WHO AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF ; THE SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT ; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ; EQUIPMENT CORPORATION. ; ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY ; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; #SET VERSON=1 #SET EDIT=0 #SUBS 'VV'VERSON,'EE'EDIT #PRINT DECGRAPHIC-11 FORTRAN PACKAGE VERSION VV.EE #ENDS #PRINT #ASK WOULD YOU LIKE THE LONG FORM OF THE QUESTIONS (Y OR N) ?LONGF #IF LONGF #PRINT THIS PROGRAM PRODUCES SEVERAL FILES NEEDED FOR THE GENERATION #PRINT OF THE DECGRAPHIC-11 LIBRARY. THESE FILES, TOGETHER WITH THE #PRINT LIBRARY ITSELF CAN BE DIRECTED TO ANY FILE STRUCTURED DEVICE. #IFTF LONGF #ASK OUTPUT DEVICE (DDU:) ?OUTDEV #IFT LONGF #PRINT THE GENERATION PROCESS PRODUCES (OPTIONALLY) SEVERAL LISTING #PRINT FILES WHICH CAN BE DIRECTED TO ANY PRINTER-LIKE DEVICE FOR #PRINT IMMEDIATE OUTPUT, OR TO SOME OTHER DEVICE FOR LATER LISTING. #PRINT IF A FILE STRUCTURED DEVICE IS SPECIFIED AND THE SYSTEM CONTAINS #PRINT A PRINT SPOOLER, THE LISTINGS WILL BE AUTOMATICALLY SPOOLED. #IFTF LONGF #ASK LISTING DEVICE (DDU:) ?LSTDEV #IFT LONGF #PRINT THE DECGRAPHIC-11 SOFTWARE SUPPORTS BOTH THE VT11 AND VS60 #PRINT DISPLAY PROCESSORS CONNECTED DIRECTLY TO THE UNIBUS, OR THE #PRINT GT43 AND GT62 DISPLAY TERMINALS CONNECTED VIA A COMM- #PRINT UNICATION INTERFACE. IF YOU HAVE EITHER A VS60 OR GT62 ANSWER #PRINT YES TO THIS QUESTION. #ENDC LONGF #ASK VS60 (Y OR N) ?VS60 #IF VS60 #IF LONGF #PRINT THE VS60 CAN OPTIONALLY SUPPORT TWO SCOPES (OR DISPLAY SCREENS) #PRINT ON THE SAME CONTROLLER. #ENDC LONGF #ASK TWO SCOPES (Y OR N) ?SCOPES #IFF #SET SCOPES=N #ENDC #IF LONGF #PRINT THE LK-11 PUSHBUTTON BOX CAN ALSO BE SUPPORTED AS A #PRINT PART OF THE PACKAGE. IT IS TYPICALLY USED BY THE APPLICATION #PRINT AS AN ALTERNATIVE OR SUPPLEMENT TO LIGHT PEN MENU SELECTION #PRINT AS A PROGRAM CONTROL TECHNIQUE. #IFTF #ASK LK-11 ?LK11 #IFT #PRINT THE DECGRAPHIC-11 SOFTWARE WILL RUN UNDER SEVERAL OPERATING #PRINT SYSTEMS. IN THE FOLLOWING QUESTION(S) ANSWER YES FOR THE SYSTEM #PRINT YOU ARE USING. #ENDC LONGF #ASK RT-11 (Y OR N) ?RT11 #IF RT11 #SET HOSAT=N #SET RSX11M=N #SET RSX11D=N #SET IAS=N #SET MAXR=0 #IFF RT11 #ASK RSX-11M (Y OR N) ?RSX11M #IF RSX11M #SET RSX11D=N #SET IAS=N #SET MAXR=30 #IF LONGF #PRINT THE DECGRAPHIC-11 SOFTWARE WILL SUPPORT SEVERAL POSSIBLE HOST- #PRINT SATELLITE CONFIGURATIONS. THESE CONFIGURATIONS ALL INVOLVE A #PRINT MAIN SYSTEM RUNNING EITHER RSX-11M, RSX-11D, OR IAS, AND ONE #PRINT OR MORE GRAPHIC TERMINALS (GT43 OR GT62) CONNECTED TO #PRINT THE MAIN SYSTEM VIA A COMMUNICATION LINE. IF YOU ANSWER NO #PRINT TO THE FOLLOWING QUESTION, IT IMPLIES THAT YOU ARE RUNNING #PRINT WITH THE DISPLAY PROCESSOR (VT11 OR VS60) CONNECTED DIRECTLY #PRINT TO THE UNIBUS. #ENDC LONGF #ASK HOST-SATELLITE (Y OR N) ?HOSAT #IFF RSX11M #ASK RSX-11D (Y OR N) ?RSX11D #IF RSX11D #SET IAS=N #IFF RSX11D #ASK IAS (Y OR N) ?IAS #IFN IAS #PRINT NO OTHER SYSTEM SUPPORTED #ENDC IAS #ENDC RSX11D #SET MAXR=24 #SET HOSAT=Y #ENDC RSX11M #ENDC RT11 #IF HOSAT #IF LONGF #PRINT WHEN GENERATING THE DECGRAPHIC-11 SOFTWARE FOR A HOST-SATELLITE #PRINT CONFIGURATION IT IS NECESSARY TO MAKE TWO PASSES THROUGH #PRINT THIS PROGRAM, ONE FOR EACH END OF THE SYSTEM. #ENDC LONGF #ASK SATELLITE END (Y OR N) ?SATEL #SET OVRLAY=N #IFF HOSAT #SET SATEL=N #IF LONGF #PRINT IT MAY BE DESIRABLE TO USE OVERLAYS IF THE APPLICATION PROGRAM #PRINT IS VERY LARGE. TO THIS END, IT IS POSSIBLE TO GENERATE COMMAND #PRINT FILES WHICH WILL ASSIST IN THE CREATION OF AN OVERLAY STRUCTURE. #PRINT IT IS LIKELY THAT THESE COMMAND FILES WILL WILL NOT SUIT YOUR #PRINT APPLICATION EXACTLY, BUT THEY WILL PROVIDE A STARTING POINT. #ENDC LONGF #ASK OVERLAID (Y OR N) ?OVRLAY #ENDC HOSAT #IF SATEL #IF LONGF #PRINT THE SATELLITE WILL CONTAIN THREE MAIN COMPONENTS: THE SATELLITE #PRINT CONTROL PROGRAM, THE DISPLAY FILE, AND THE (OPTIONAL) EXTENSIONS #PRINT TO THE CONTROL PROGRAM. THE CONTROL PROGRAM OCCUPIES ABOUT #PRINT 8K WORDS OF MEMORY, WITH THE REMAINDER BEING AVAILABLE FOR #PRINT DISPLAY FILE PLUS USER EXTENSIONS TO THE CONTROL PROGRAM. #PRINT THIS LEAVES 8K WORDS IN A 16K SATELLITE. IF YOU PLAN TO EXTEND #PRINT THE CONTROL PROGRAM, SUBTRACT THE AMOUNT OF SPACE YOU WILL #PRINT NEED FROM 8K AND EXPRESS THAT AS OCTAL BYTES (HINT: 2K WORDS #PRINT IS 10000 OCTAL BYTES). YOUR ANSWER WILL BE THE SIZE OF #PRINT THE SATELLITE'S DISPLAY FILE UNTIL YOU RUN THIS PROGRAM #PRINT AGAIN TO CHANGE THE SIZE. #ENDC LONGF #ASK DISPLAY FILE SIZE (OCTAL BYTES) ?DFSIZE #IF LONGF #PRINT IF YOU HAVE A GT62 TERMINAL WITH RX11 (FLOPPY) DISKS, YOU #PRINT MAY WANT TO HAVE A LOCAL SAVE/RESTORE CAPABILITY IN ADDITION #PRINT TO THE SAVE/RESTORE AVAILABLE VIA THE HOST SYSTEM. #PRINT SELECTION OF THIS OPTION WILL ALSO PROVIDE SOME GENERAL #PRINT FILE ACCESS SUBROUTINES FOR USE IN THE SATELLITE. #PRINT IF YOU SAY 'YES' TO THE FOLLOWING QUESTION, YOU MUST #PRINT MODIFY THE USER'S SATELLITE ROUTINE (USRSAT) SO THAT #PRINT THE SAVE AND RSTR SUBROUTINES WILL BE EXECUTED BY THE #PRINT SATELLITE (SEE APPENDIX D OF THE DECGRAPHIC-11 FORTRAN #PRINT PROGRAMMING MANUAL). #ENDC LONGF #ASK LOCAL SAVE/RSTR ?LOCSAV #SET SORNHS=Y #IFF SATEL #SET DFSIZE=20000 #SET LOCSAV=N #IFN HOSAT #SET SORNHS=Y #IFF -HOSAT #SET SORNHS=N #ENDC -HOSAT #ENDC SATEL #IF RT11 #IF OVRLAY #SET BRAKUP=Y #IFF #SET BRAKUP=N #ENDC #IFF #SET BRAKUP=N #ENDC #IFN HOSAT #IF LONGF #PRINT THE DECGRAPHIC-11 SOFTWARE WILL PRODUCE FAIRLY DESCRIPTIVE #PRINT ERROR MESSAGES UPON DETECTION OF ANY ERRORS IN THE USE OF #PRINT THE GRAPHIC SUBROUTINES. UNFORTUNATELY THE TEXT OF THESE #PRINT MESSAGES TAKES UP A FAIRLY LARGE AMOUNT OF MEMORY SPACE.IF #PRINT YOU WOULD LIKE TO ELIMINATE THIS TEXT, ANSWER NO TO THE NEXT #PRINT QUESTION. IN THIS EVENT, ANY ERROR WILL PRODUCE A CODE WHICH #PRINT IS DESCRIBED IN APPENDIX B OF THE DECGRAPHIC-11 #PRINT FORTRAN PROGRAMMING MANUAL. #ENDC LONGF #ASK ERROR MESSAGE TEXT (Y OR N) ?MSGTXT #IFF #SET MSGTXT=N #ENDC #IFN RT11 #IFN SATEL #IF LONGF #PRINT THE DECGRAPHIC-11 SOFTWARE ALSO SUPPORTS THE FORTRAN IV- #PRINT PLUS COMPILER, WHICH GIVES MUCH FASTER PROGRAM EXECUTION AT #PRINT THE COST OF MEMORY SPACE. THE FORTRAN IV-PLUS SYSTEM REQUIRES #PRINT THAT THE FP11 HARDWARE BE PRESENT WHEN THE PROGRAM IS EXECUTED. #PRINT NOTE: FORTRAN IV-PLUS CANNOT BE USED IN THE SATELLITE OF #PRINT HOST-SATELLITE SYSTEM. #ENDC LONGF #ASK FORTRAN IV-PLUS (Y OR N) ?F4PLUS #IFF -SATEL #SET F4PLUS=N #ENDC -SATEL #IFF -RT11 #SET F4PLUS=N #ENDC -RT11 #IF LONGF #PRINT THE SOFTWARE MAY BE GENERATED TO ACCEPT UNSCALED INTEGER DATA #PRINT INSTEAD OF REAL DATA. IN THE INTEGER CASE, ALL NUMBERS REPRE- #PRINT SENTING POINTS AND VECTORS MUST BE INTEGERS IN THE APPROPRIATE #PRINT RANGE (SHORT VECTOR: -63<>63, LONG VECTOR: -1023<>1023, ABSOLUTE #PRINT POINT FOR VT11: 0<>1023, ABSOLUTE POINT, ABSOLUTE VECTOR, OR #PRINT WINDOW FOR VS60: -4095<>4095). THE ADVANTAGES OF USING THE #PRINT INTEGER FORMAT ARE SMALLER PROGRAMS (DATA ONLY TAKE ONE WORD, #PRINT NOT TWO) AND FASTER EXECUTION TIMES (INTEGER ARITHMETIC IS #PRINT FASTER THAN REAL ARITHMETIC). THE DISADVANTAGE IS LESS FLEXI- #PRINT BILITY IN CREATING DISPLAYS NOT REPRESENTED IN CONVENIENT UNITS. #IFTF LONGF #ASK INTEGER ARGUMENTS ?INTEGR #IFT LONGF #PRINT THE GENERATION PROCEDURE WILL PRODUCE LISTINGS OF BOTH THE #PRINT MACRO-11 AND FORTRAN COMPONENTS OF THE DECGRAPHIC-11 SOFTWARE #PRINT IF DESIRED. THESE LISTINGS WILL BE SENT TO THE LISTING DEVICE #PRINT NAMED PREVIOUSLY. #IFTF LONGF #ASK MACRO LISTINGS (Y OR N) ?MACLST #ASK FORTRAN LISTINGS (Y OR N) ?FORLST #IFT LONGF #PRINT THE COMMAND FILE NORMALLY PRODUCED WILL DELETE ALL TEMPORARY #PRINT FILES CREATED DURING THE GENERATION PROCESS. THESE FILES MAY #PRINT BE PRESERVED IF DESIRED. #ENDC LONGF #ASK DELETE FILES (Y OR N) ?DELFIL ; ; ; DISPLAY LIST STRUCTURE ; ---------------------- ; ; ; ITEM VT11 VS60 ; ; SUBP ON DJSR DJSRR .+12 ; DJMP ; <.+6> ; ; ; ; SUBP OFF DJMP DJMPR .+2 ; DJMP ; <.+6> ; ; ; ; SUBP CALL ON DJSR+1 DJSR ; <.+10> ; DJMPR .+6 ; ; ; ; SUBP CALL OFF DJMP+1 DJMPR .+12 ; <.+10> ; DJMPR .+6 ; ; ; ; SUBP OPEN ON DJSR+2 DJSRR .+12 ; DHALT ; <.+6> 0 ; ; ; ; SUBP OPEN OFF DRET+2 DJMPR .+2 ; 0 DHALT ; <.+6> 0 ; ; ; ; ESUB DRET DRET ; 0 ; ; ESUB RESTORED *** DRETR ; ; ERASED SUBP DJMP+2 DJMP+2 ; ; <.+6> ; ; ; ; ERASED CALL DJMP+2 DJMP+2 ; <.+10> <.+10> ; DJMPR .+6 ; ; ; ; NMBR SUBP
; ; ; ; FIGR SUBP
; ; ; ; GRAPH SUBP
; LSRB LSRB ; GRAX/Y GRAX/Y ; ; ; ; END OF LIST DHALT DHALT ; 0 0 ; ; ; ; ; DISPLAY FILE STRUCTURE ; ---------------------- ; ; ; ; ; ; ; ; 256 WORD DIRECT ACCESS RECORDS (PURE DATA) ; ; ; COMMON DESCRIPTIONS ; ------------------- ; ; ; VARIABLE COMMON DESCRIPTION ; -------- ------ ----------- ; ; LOCK DFILE LIGHT PEN DATA INTERLOCK ; NOTE: LOCK IS REALLY THE FIRST WORD ; OF THE USER SPECIFIED DISPLAY ; LIST ; NAME(9) DFILE LPEN HIT TAG LIST ; IDPC DFILE LPEN HIT DPU PC ; IDSR DFILE LPEN HIT DPU STATUS ; IX DFILE LPEN HIT DPU X POSITION ; IY DFILE LPEN HIT DPU Y POSITION ; IDSR2 DFILE LPEN HIT DPU EXTENDED STATUS ; IXO DFILE LPEN HIT DPU X OFFSET ; IYO DFILE LPEN HIT DPU Y OFFSET ; IXYOS DFILE LPEN HIT DPU X/Y OFFSET SIGNS ; TIP1 DFILE LPEN HIT TIP 1 STATUS ; TIP2 DFILE LPEN HIT TIP 2 STATUS ; LPFLAG DFILE LPEN HIT FLAG ; IRSVD(5) DFILE RESERVED ; IBUF(N) DFILE REAL DISPLAY BUFFER ; IFLG GRDAT 'INIT CALLED' FLAG ; ISIZ GRDAT SIZE OF REAL DISPLAY BUFFER ; IBAS GRDAT ADDRESS OF IBUF(1) ; ITXT GRDAT DPU TEXT ; ISHV GRDAT DPU SHORT VECTOR ; ILOV GRDAT DPU LONG VECTOR ; IAPT GRDAT DPU ABSOLUTE POINT ; IGRX GRDAT DPU GRAPH X ; IGRY GRDAT DPU GRAPH Y ; IRPT GRDAT DPU RELATIVE POINT ; IBSV GRDAT DPU BASIC VECTOR ; IARC GRDAT DPU ARC/CIRCLE ; IABV GRDAT DPU ABSOLUTE VECTOR ; INAM GRDAT DPU LOAD NAME REGISTER ; ISRC GRDAT DPU LOAD STATUS REG C ; IJMP GRDAT DPU JUMP ABSOLUTE ; IJMPR GRDAT DPU JUMP RELATIVE ; IJSR GRDAT DPU JSR ABSOLUTE ; IJSRR GRDAT DPU JSR RELATIVE ; INOP GRDAT DPU NO OPERATION ; IRET GRDAT DPU SUBPICTURE RETURN ; IRETR GRDAT DPU SUBP. RETURN AND RESTORE ; ICTL GRDAT ; ISRA GRDAT DPU LOAD STATUS REG A ; IHLT GRDAT DPU HALT AND INTERRUPT ; ISRB GRDAT DPU LOAD STATUS REG B ; ISRBP GRDAT DPU LOAD STATUS REG B' ; IINT GRDAT DPU INTENSIFY BIT ; IOFF GRDAT DPU OFFSET BIT ; IPTR GRDAT IBUF INDEX OF NEXT USABLE WORD ; IPWS GRDAT 1ST, 2ND, OR NTH PUTWD WITHOUT PUTEM ; ISTP GRDAT SUBPICTURE OPEN DEPTH ; MOLD GRDAT PREVIOUS GRAPHIC MODE ; LUNS GRDAT LUN FOR SAVE/RSTR ; IAUT GRDAT AUTO 'DISPLY' MODE ; ICHR GRDAT EVEN BYTE FOR PUTCHR ; IINS GRDAT INSERT MODE FLAG ; IPWP GRDAT IPTR AT START OF DFILE ADDITION ; IPW1 GRDAT WORD TO REPLACE DHALT AT PUTEM ; IPW2 GRDAT WORD TO REPLACE 0 AT PUTEM ; ILST GRDAT IBUF INDEX OF 1ST SUBP LINK ; IEND GRDAT IBUF INDEX OF LAST SUBP LINK ; IPRV GRDAT IBUF INDEX OF PREVIOUS LINK (TAGSRH) ; IVIS GRDAT INTENSIFY YES/NO (MODE) ; ITEX GRDAT CURRENT TEXT MODE (TEXT) ; ICHT GRDAT CHANGET ARG COUNT (CHANGT) ; IPBF GRDAT LAST LK11 STATUS ; ISTK(8) GRDAT SUBPICTURE BUILD STACK ; ICHI(21) GRDAT CURRENT IBUF INDEX FOR POINTERS ; ICHM(21) GRDAT CURRENT MODE FOR POINTERS ; IATT(41) GRDAT ATTACH LIST(S) ; XSCF GRDAT X SCALE FACTOR ; XBAS GRDAT X BASE ; YSCF GRDAT Y SCALE FACTOR ; YBAS GRDAT Y BASE ; ISSIZ GRDAT H/S MAX MESSAGE SIZE ; ISCNT GRDAT H/S CURRENT MESSAGE SIZE ; ISBUF(30) GRDAT H/S MESSAGE BUFFER ; JADV GRDAT H/S ADVANC CODE ; JATT GRDAT H/S ATTACH CODE ; JCHA GRDAT H/S CHANGA CODE ; JCHE GRDAT H/S CHANGE CODE ; JCHT GRDAT H/S CHANGT CODE ; JCMP GRDAT H/S CMPRS CODE ; JCOP GRDAT H/S COPY CODE ; JCVS GRDAT H/S CVSCAL CODE ; JDET GRDAT H/S DETACH CODE ; JUSD GRDAT H/S DPTR CODE ; JERA GRDAT H/S ERAS CODE ; JERP GRDAT H/S ERASP CODE ; JESB GRDAT H/S ESUB CODE ; JFLA GRDAT H/S FLASH CODE ; JFRE GRDAT H/S FREE CODE ; JGET GRDAT H/S GET CODE ; JGRD GRDAT H/S GRID CODE ; JINI GRDAT H/S INIT CODE ; JINS GRDAT H/S INSERT CODE ; JINT GRDAT H/S INTENS CODE ; JLTY GRDAT H/S LINTYP CODE ; JLPE GRDAT H/S LPEN CODE ; JOFF GRDAT H/S OFF CODE ; JON GRDAT H/S ON CODE ; JPTR GRDAT H/S POINTR CODE ; JNWD GRDAT H/S PUTWD, PUTWD, ..., PUTEM CODE ; JSCL GRDAT H/S SCAL CODE ; JSNS GRDAT H/S SENSE CODE ; JSUB GRDAT H/S SUBP CODE ; JTRK GRDAT H/S TRAK CODE ; JTXY GRDAT H/S TRAKXY CODE ; JGRA GRDAT H/S GRATTN CODE ; JSAV GRDAT H/S SAVE CODE ; JRST GRDAT H/S RSTR CODE ; JDIS GRDAT H/S DISPLY CODE ; JPBH GRDAT H/S PBH CODE ; JPBL GRDAT H/S PBL CODE ; JPBS GRDAT H/S PBS CODE ; JKBC GRDAT H/S KBC CODE ; ; GRAPHICS PROTOCOL DEFINITION ; ---------------------------- ; ; ; DEFINITIONS: ; ; K = POINTER, <1:21>, BYTE ; M(N) = SUBPICTURE(S), <1:32767>, WORD ; X(N) = X-VALUE(S), , DOUBLE WORD ; Y(N) = Y-VALUE(S), , DOUBLE WORD ; N = COUNT, <-32768:32767>, WORD ; S = SCOPE, <1:2>, BYTE ; L = LIGHT PEN SENSITIVITY, <-1:1>, BYTE ; I = INTENSITY, <-9:9>, BYTE ; F = FLASH, <-1:1>, BYTE ; T = LINE TYPE, <1:4>, BYTE ; IC = CHARACTER SCALE, <1:4>, BYTE ; IV = VECTOR SCALE, <1:15>, BYTE ; ID = ATTACH DIRECTION, <-1:1>, BYTE ; IH = HIT FLAG, <0:2>, BYTE ; IP = PRIMITIVE NUMBER, <1:32767>, WORD ; IA = ANCESTOR ARRAY, <1:32767>, 8 WORDS (ENDS IN -2) ; IM = AREA, <1:2>, BYTE ; IT1 = TIP SWITCH 1, <0:1>, BYTE ; IT2 = TIP SWITCH 2, <0:1>, BYTE ; II = INDEX, <1:32767>, WORD ; ; ; CODE ARGUMENTS EQUIVALENT FORTRAN CALL RETURNS ; ; ; JADV K,N ADVANC(K,N) ; JATT K,ID,S ATTACH(K,ID,S) ; JCHA K,X,Y CHANGA(K,X,Y) ; JCHE K,X,Y CHANGE(K,X,Y) ; JCHT K, CHANGT(K,A1,A2,A3,...) ; JCMP CMPRS ; JCOP M2,M1 COPY(M1,M2) ; JCOP M2,0 COPY(,M2) ; JCVS M,IC,IV CVSCAL(M,IC,IV) ; JDET S DETACH(S) ; JUSD DPTR(II) II ; JERA M ERAS(M) ; JERA 0 ERAS ; JERP K ERASP(K) ; JESB M ESUB(M) ; JESB 0 ESUB ; JFLA K,F FLASH(K,F) ; JFRE FREE ; JGET K GET(K,X,Y) X,Y ; JGRD X,Y,S GRID(X,Y,S) ; JINI INIT ; JINS K INSERT(K) ; JINS 0 INSERT ; JINT K,I INTENS(K,I) ; JLTY K,T LINTYP(K,T) ; JLPE LPEN(IH,M,X,Y,IP,IA,IM,IT1,IT2) IH,M,X,Y,IP,IA,IM,IT1,IT2 ; JOFF M OFF(M) ; JON M ON(M) ; JPOI K,M,IP POINTR(K,M,IP) ; JNWD N,W1,W2,... PUTWD, PUTWD, ..., PUTEM ; JSCL X1,X2,Y1,Y2 SCAL(XL,YL,XH,YH) ; JSNS K,L,S SENSE(K,L,S) ; JSUB M1,M2 SUBP(M1,M2) ; JSUB M1,0 SUBP(M1,0) ; JTRK X,Y,S TRAK(X,Y,S) ; JTXY S TRAKXY(X,Y,S) X,Y ; JGRA IW,ID1,ID2,ID3 GRATTN(IW,I,ID1,ID2,ID3) I ; JTAG M TAGSRH(M,II) II ; JSAV SAVE(FILNAM) N,W1,W2,....,WN ; JRST N,W1,...,WN RSTR(FILNAM) ; JDIS N DISPLY(N) ; JPBS S PBS(FLAGS,S) I ; JPBL ION,IOFF,S PBL(ONS,OFFS,S) ; JKBC KBC(I) I ; ; ; COMMUNICATIONS PROTOCOL ; ----------------------- ; ; .REPT SYNCT ; .BYTE SYN ; .ENDR ; .BYTE DLE,CNT ; .BYTE CRCL,CRCH ; .BYTE CODE ; ; .BYTE CRCL,CRCH ; ; CODES: ASK=10, ACK=20, DAT=30+&7 ; DLY=40, RPT=60 ; ; RULES: ; ; 1) HOST IS MASTER. ; 2) HOST SENDS DATA MSG WITH MSG NUM (MOD 7) VIA TOSAT OR ; TOOSAT AND WAITS FOR ACK FROM SAT. IF TWAIT SECS EXPIRE, ; OR CRC ERROR, RETRIES UP TO TRIES TIMES. ; 3) SAT RECIEVES DAT MSG IN FRHOST, SENDS ACK IF OK. ALSO ; WSENDS ACK IF MSG NUM SAME AS PREVIOUS MSG (ACK WAS LOST). ; IGNORES OTHER CODES IN FRHOST. ; 4) HOST SENDS ASK IN FRSAT AND WAITS FOR DAT MSG (MSG NUM = 0). ; IT IS ASSUMED THAT THE SAT IS READY. IF NO MSG COMES BACK ; IN TWAIT SECS, A RPT IS SENT, UP TO TRIES TIMES. ; NO ACK IS SENT BACK TO SAT. IF DLY, RETRIES READ SANS TIMEOUT. ; 5) WHEN TOHOST IS CALLED IN SAT, IT WAITS FOR ASK, THEN SENDS DAT ; MSG (MSG NUM = 0). IF NEXT MSG IS NOT A RPT, AN ACK ; IS ASSUMED. IF A RPT, RETRANSMITS DAT MSG. ; 6) A CALL TO TOHOST IN SAT MUST BE MATCHED BY A CALL TO FRSAT ; IN HOST. ; 7) DHOST WAITS FOR ASK, SENDS DLY. ; 8) SIZE OF MESSAGE SENT BY TOHOST MUST MATCH SIZE EXPECTED ; BY FRSAT. DHOST MUST ALSO KNOW SIZE OF MESSAGE IT IS DELAYING. #NAME GRSUBS #SUBS 'OD:'OUTDEV #FILE OD:GRSUBS.MA #ENDS #SUBS 'VV'VERSON,'EE'EDIT .IDENT /VV.EE/ #ENDS .GLOBL V$$,V$60,SCOPE$,RT$11,HO$AT,$ATEL,M$GTXT,OV$LAY .GLOBL IA$,R$X11D,R$X11M,F4PLU$,INT$,LK$11,LOC$AV #IF VS60 V$60=1 ;VS60 #IFF V$60=0 ;VT11 #ENDC #IF SCOPES SCOPE$=1 ;VS60 DUAL SCOPES #IFF SCOPE$=0 ;SINGLE SCOPE #ENDC #IF MSGTXT M$GTXT=1 ;TEXTUAL ERROR MESSAGES #IFF M$GTXT=0 ;ERROR CODES ONLY #ENDC #IF RT11 RT$11=1 ;RT-11 #IFF RT$11=0 ;NOT RT-11 #ENDC #IF HOSAT HO$AT=1 ;HOST / SATELLITE #IFF HO$AT=0 ;SINGLE PROCESSOR #ENDC #IF SATEL $ATEL=1 ;SATELLITE #IFF $ATEL=0 ;NOT SATELLITE #ENDC #IF OVRLAY OV$LAY=1 ;OVERLAID LIBRARY #IFF OV$LAY=0 ;NON OVERLAID LIBRARY #ENDC #IF RSX11M R$X11M=1 ;RSX-11M #IFF R$X11M=0 ;NOT RSX-11M #ENDC #IF RSX11D R$X11D=1 ;RSX-11D (BUT NOT IAS) #IFF R$X11D=0 ;NOT RSX-11D (BUT MAYBE IAS) #ENDC #IF IAS IA$=1 ;IAS #IFF IA$=0 ;NOT IAS #ENDC #IF F4PLUS F4PLU$=1 ;FORTRAN IV PLUS #IFF F4PLU$=0 ;FORTRAN IV #ENDC #IF INTEGR INT$=1 ;INTEGER COORDINATES - NO SOFTWARE SCALING #IFF INT$=0 ;REAL COORDINATES - SOFTWARE SCALING #ENDC #IF LK11 LK$11=1 ;LK-11 PUSHBUTTON BOX #IFF LK$11=0 ;NO LK-11 PUSH BUTTON BOX #ENDC #IF LOCSAV LOC$AV=1 ;LOCAL FLOPPY DISK SUPPORT FOR SATELLITE #IFF LOC$AV=0 ;NO LOCAL FLOPPY DISK SUPPORT FOR SATELLITE #ENDC #SUBS 'VV'VERSON,'EE'EDIT V$$=+VVEE00 #ENDS #NAME GRGEN #SUBS 'OD:'OUTDEV,'LD:'LSTDEV #IF RT11 #FILE OD:GRGEN.BAT $JOB/RT11 .R PIP *OD:*.OB/D *LD:*.LI/D #IFN OVRLAY *OD:GLIB.OBJ/D #IFTF -OVRLAY .R MACRO #IF MACLST *OD:GRSUBS.OB,LD:GRSUBS.LI/N:TTM=OD:GRSUBS.MA,GRSUBS #IFF MACLST *OD:GRSUBS.OB=OD:GRSUBS.MA,GRSUBS #ENDC MACLST .R FORTRA #IFF -OVRLAY #IF FORLST *OD:ADVANC.OB,LD:ADVANC.LI/L:SRC=OD:ADVANC.FO/S *OD:APNT.OB,LD:APNT.LI/L:SRC=OD:APNT.FO/S *OD:AREA.OB,LD:AREA.LI/L:SRC=OD:AREA.FO/S *OD:ATTACH.OB,LD:ATTACH.LI/L:SRC=OD:ATTACH.FO/S *OD:AVECT.OB,LD:AVECT.LI/L:SRC=OD:AVECT.FO/S *OD:BUFTST.OB,LD:BUFTST.LI/L:SRC=OD:BUFTST.FO/S *OD:CHANGA.OB,LD:CHANGA.LI/L:SRC=OD:CHANGA.FO/S *OD:CHANGE.OB,LD:CHANGE.LI/L:SRC=OD:CHANGE.FO/S *OD:CHANGP.OB,LD:CHANGP.LI/L:SRC=OD:CHANGP.FO/S *OD:CHANGT.OB,LD:CHANGT.LI/L:SRC=OD:CHANGT.FO/S *OD:CMPRS.OB,LD:CMPRS.LI/L:SRC=OD:CMPRS.FO/S *OD:COPY.OB,LD:COPY.LI/L:SRC=OD:COPY.FO/S *OD:CVSCAL.OB,LD:CVSCAL.LI/L:SRC=OD:CVSCAL.FO/S *OD:DETACH.OB,LD:DETACH.LI/L:SRC=OD:DETACH.FO/S *OD:DISPLY.OB,LD:DISPLY.LI/L:SRC=OD:DISPLY.FO/S *OD:DPTR.OB,LD:DPTR.LI/L:SRC=OD:DPTR.FO/S *OD:DPYNOP.OB,LD:DPYNOP.LI/L:SRC=OD:DPYNOP.FO/S *OD:DPYWD.OB,LD:DPYWD.LI/L:SRC=OD:DPYWD.FO/S *OD:ERAS.OB,LD:ERAS.LI/L:SRC=OD:ERAS.FO/S *OD:ERASP.OB,LD:ERASP.LI/L:SRC=OD:ERASP.FO/S *OD:ERROR.OB,LD:ERROR.LI/L:SRC=OD:ERROR.FO/S *OD:ESUB.OB,LD:ESUB.LI/L:SRC=OD:ESUB.FO/S *OD:FIGR.OB,LD:FIGR.LI/L:SRC=OD:FIGR.FO/S *OD:FLASH.OB,LD:FLASH.LI/L:SRC=OD:FLASH.FO/S *OD:FREE.OB,LD:FREE.LI/L:SRC=OD:FREE.FO/S *OD:GET.OB,LD:GET.LI/L:SRC=OD:GET.FO/S *OD:GRATTN.OB,LD:GRATTN.LI/L:SRC=OD:GRATTN.FO/S *OD:GRID.OB,LD:GRID.LI/L:SRC=OD:GRID.FO/S *OD:INIT.OB,LD:INIT.LI/L:SRC=OD:INIT.FO/S *OD:INSERT.OB,LD:INSERT.LI/L:SRC=OD:INSERT.FO/S *OD:INTENS.OB,LD:INTENS.LI/L:SRC=OD:INTENS.FO/S *OD:KBC.OB,LD:KBC.LI/L:SRC=OD:KBC.FO/S *OD:LINTYP.OB,LD:LINTYP.LI/L:SRC=OD:LINTYP.FO/S *OD:LPEN.OB,LD:LPEN.LI/L:SRC=OD:LPEN.FO/S *OD:LVECT.OB,LD:LVECT.LI/L:SRC=OD:LVECT.FO/S *OD:MENU.OB,LD:MENU.LI/L:SRC=OD:MENU.FO/S *OD:MODE.OB,LD:MODE.LI/L:SRC=OD:MODE.FO/S *OD:NMBR.OB,LD:NMBR.LI/L:SRC=OD:NMBR.FO/S *OD:NOSC.OB,LD:NOSC.LI/L:SRC=OD:NOSC.FO/S *OD:OFF.OB,LD:OFF.LI/L:SRC=OD:OFF.FO/S *OD:ON.OB,LD:ON.LI/L:SRC=OD:ON.FO/S *OD:PBH.OB,LD:PBH.LI/L:SRC=OD:PBH.FO/S *OD:PBL.OB,LD:PBL.LI/L:SRC=OD:PBL.FO/S *OD:PBS.OB,LD:PBS.LI/L:SRC=OD:PBS.FO/S *OD:POINTR.OB,LD:POINTR.LI/L:SRC=OD:POINTR.FO/S *OD:PTRCHK.OB,LD:PTRCHK.LI/L:SRC=OD:PTRCHK.FO/S *OD:PUTCHR.OB,LD:PUTCHR.LI/L:SRC=OD:PUTCHR.FO/S *OD:PUTEM.OB,LD:PUTEM.LI/L:SRC=OD:PUTEM.FO/S *OD:PUTWD.OB,LD:PUTWD.LI/L:SRC=OD:PUTWD.FO/S *OD:RPNT.OB,LD:RPNT.LI/L:SRC=OD:RPNT.FO/S *OD:RSTR.OB,LD:RSTR.LI/L:SRC=OD:RSTR.FO/S *OD:SAVE.OB,LD:SAVE.LI/L:SRC=OD:SAVE.FO/S *OD:SCOPE.OB,LD:SCOPE.LI/L:SRC=OD:SCOPE.FO/S *OD:SCAL.OB,LD:SCAL.LI/L:SRC=OD:SCAL.FO/S *OD:SENSE.OB,LD:SENSE.LI/L:SRC=OD:SENSE.FO/S *OD:SUBP.OB,LD:SUBP.LI/L:SRC=OD:SUBP.FO/S *OD:SVECT.OB,LD:SVECT.LI/L:SRC=OD:SVECT.FO/S *OD:TAGSRH.OB,LD:TAGSRH.LI/L:SRC=OD:TAGSRH.FO/S *OD:TEXOO.OB,LD:TEXOO.LI/L:SRC=OD:TEXOO.FO/S *OD:TEXT.OB,LD:TEXT.LI/L:SRC=OD:TEXT.FO/S *OD:TRAK.OB,LD:TRAK.LI/L:SRC=OD:TRAK.FO/S *OD:TRAKXY.OB,LD:TRAKXY.LI/L:SRC=OD:TRAKXY.FO/S *OD:VECT.OB,LD:VECT.LI/L:SRC=OD:VECT.FO/S *OD:VECTS.OB,LD:VECTS.LI/L:SRC=OD:VECTS.FO/S *OD:WINDOW.OB,LD:WINDOW.LI/L:SRC=OD:WINDOW.FO/S *OD:XGRA.OB,LD:XGRA.LI/L:SRC=OD:XGRA.FO/S *OD:YGRA.OB,LD:YGRA.LI/L:SRC=OD:YGRA.FO/S #IFF FORLST *OD:ADVANC.OB=OD:ADVANC.FO/S *OD:APNT.OB=OD:APNT.FO/S *OD:AREA.OB=OD:AREA.FO/S *OD:ATTACH.OB=OD:ATTACH.FO/S *OD:AVECT.OB=OD:AVECT.FO/S *OD:BUFTST.OB=OD:BUFTST.FO/S *OD:CHANGA.OB=OD:CHANGA.FO/S *OD:CHANGE.OB=OD:CHANGE.FO/S *OD:CHANGP.OB=OD:CHANGP.FO/S *OD:CHANGT.OB=OD:CHANGT.FO/S *OD:CMPRS.OB=OD:CMPRS.FO/S *OD:COPY.OB=OD:COPY.FO/S *OD:CVSCAL.OB=OD:CVSCAL.FO/S *OD:DETACH.OB=OD:DETACH.FO/S *OD:DISPLY.OB=OD:DISPLY.FO/S *OD:DPTR.OB=OD:DPTR.FO/S *OD:DPYNOP.OB=OD:DPYNOP.FO/S *OD:DPYWD.OB=OD:DPYWD.FO/S *OD:ERAS.OB=OD:ERAS.FO/S *OD:ERASP.OB=OD:ERASP.FO/S *OD:ERROR.OB=OD:ERROR.FO/S *OD:ESUB.OB=OD:ESUB.FO/S *OD:FIGR.OB=OD:FIGR.FO/S *OD:FLASH.OB=OD:FLASH.FO/S *OD:FREE.OB=OD:FREE.FO/S *OD:GET.OB=OD:GET.FO/S *OD:GRATTN.OB=OD:GRATTN.FO/S *OD:GRID.OB=OD:GRID.FO/S *OD:INIT.OB=OD:INIT.FO/S *OD:INSERT.OB=OD:INSERT.FO/S *OD:INTENS.OB=OD:INTENS.FO/S *OD:KBC.OB=OD:KBC.FO/S *OD:LINTYP.OB=OD:LINTYP.FO/S *OD:LPEN.OB=OD:LPEN.FO/S *OD:LVECT.OB=OD:LVECT.FO/S *OD:MENU.OB=OD:MENU.FO/S *OD:MODE.OB=OD:MODE.FO/S *OD:NMBR.OB=OD:NMBR.FO/S *OD:NOSC.OB=OD:NOSC.FO/S *OD:OFF.OB=OD:OFF.FO/S *OD:ON.OB=OD:ON.FO/S *OD:PBH.OB=OD:PBH.FO/S *OD:PBL.OB=OD:PBL.FO/S *OD:PBS.OB=OD:PBS.FO/S *OD:POINTR.OB=OD:POINTR.FO/S *OD:PTRCHK.OB=OD:PTRCHK.FO/S *OD:PUTCHR.OB=OD:PUTCHR.FO/S *OD:PUTEM.OB=OD:PUTEM.FO/S *OD:PUTWD.OB=OD:PUTWD.FO/S *OD:RPNT.OB=OD:RPNT.FO/S *OD:RSTR.OB=OD:RSTR.FO/S *OD:SAVE.OB=OD:SAVE.FO/S *OD:SCOPE.OB=OD:SCOPE.FO/S *OD:SCAL.OB=OD:SCAL.FO/S *OD:SENSE.OB=OD:SENSE.FO/S *OD:SUBP.OB=OD:SUBP.FO/S *OD:SVECT.OB=OD:SVECT.FO/S *OD:TAGSRH.OB=OD:TAGSRH.FO/S *OD:TEXOO.OB=OD:TEXOO.FO/S *OD:TEXT.OB=OD:TEXT.FO/S *OD:TRAK.OB=OD:TRAK.FO/S *OD:TRAKXY.OB=OD:TRAKXY.FO/S *OD:VECT.OB=OD:VECT.FO/S *OD:VECTS.OB=OD:VECTS.FO/S *OD:WINDOW.OB=OD:WINDOW.FO/S *OD:XGRA.OB=OD:XGRA.FO/S *OD:YGRA.OB=OD:YGRA.FO/S *OD:ZGRA.OB=OD:ZGRA.FO/S #ENDC FORLST #IFT -OVRLAY #IF FORLST *OD:GRPAK1.OB,LD:GRPAK1.LI/L:SRC=OD:GRPAK1.FO/S #IFF FORLST *OD:GRPAK1.OB=OD:GRPAK1.FO/S #ENDC FORLST #IFTF -OVRLAY #IF DELFIL .R PIP *OD:*.FO/D #ENDC DELFIL #IFT -OVRLAY .R PIP *OD:GRPAK1.OB=OD:GRPAK1.OB/B .R LIBR *OD:GLIB=OD:GRPAK1.OB,GRSUBS.OB #IFTF -OVRLAY #IFF -OVRLAY .R PIP *OD:GRP01.OB=OD:ERROR.OB,LPEN.OB,MODE.OB,PTRCHK.OB,PUTCHR.OB,PUTEM.OB/B *OD:GRP01.OB=OD:GRP01.OB,BUFTST.OB,PUTWD.OB,DISPLY.OB,GRATTN.OB/B *OD:GRP01.OB=OD:GRP01.OB,PBH.OB,PBL.OB,PBS.OB,KBC.OB/B *OD:ERROR.OB,LPEN.OB,MODE.OB/D *OD:PTRCHK.OB,PUTCHR.OB,PUTEM.OB/D *OD:BUFTST.OB,PUTWD.OB,KBC.OB/D *OD:DISPLY.OB,GRATTN.OB,PBH.OB/D *OD:PBL.OB,PBS.OB/D *OD:GRP02.OB=OD:DPTR.OB,DPYNOP.OB,DPYWD.OB/B *OD:DPTR.OB,DPYNOP.OB,DPYWD.OB/D *OD:GRP03.OB=OD:GET.OB,CHANGE.OB/B #IFT -OVRLAY #IF DELFIL .R PIP *OD:*.OB/D #ENDC DELFIL #IFTF -OVRLAY #IF DELFIL *OD:*.MA/D *OD:GRGEN.BAT/D *OD:GRCOM.CND/D #ENDC DELFIL $EOJ #ENDC -OVRLAY #IFF RT11 #IF RSX11M #FILE OD:GRGEN.CMD PIP OD:*.OB;*/DE PIP LD:*.LI;*/DE #IF HOSAT #IF SATEL PIP OD:GLIBS.OLB;*/DE #IFF SATEL PIP OD:GLIBH.OLB;*/DE #ENDC SATEL #IFF HOSAT PIP OD:GLIB.OLB;*/DE #IFTF HOSAT #IF MACLST MAC OD:GRSUBS.OB,LD:GRSUBS.LI=OD:GRSUBS.MA,GRSUBS #IFF MACLST MAC OD:GRSUBS.OB=OD:GRSUBS.MA,GRSUBS #ENDC MACLST #IFN F4PLUS #IF FORLST FOR OD:GRPAK1.OB,LD:GRPAK1.LI/LI:SRC=OD:GRPAK1.FO/-SN #IFF FORLST FOR OD:GRPAK1.OB=OD:GRPAK1.FO/-SN #ENDC FORLST #IFF -F4PLUS #IF FORLST F4P OD:GRPAK1.OB,LD:GRPAK1.LI/LI:SRC=OD:GRPAK1.FO/CO:20. #IFF FORLST F4P OD:GRPAK1.OB=OD:GRPAK1.FO/CO:20. #ENDC FORLST #ENDC -F4PLUS #IFT HOSAT #IFN SATEL #IFN F4PLUS #IF FORLST FOR OD:LGR,LD:LGR.LI/LI:SRC=OD:LGR.FO/-SN #IFF FORLST FOR OD:LGR=OD:LGR.FO/-SN #ENDC FORLST #IFF -F4PLUS #IF FORLST F4P OD:LGR,LD:LGR.LI/LI:SRC=OD:LGR.FO/CO:20. #IFF FORLST F4P OD:LGR=OD:LGR.FO/CO:20. #ENDC FORLST #ENDC -F4PLUS TKB OD:LGR=OD:LGR #IFF -SATEL #IF FORLST FOR OD:SATDSP,LD:SATDSP.LI/LI:SRC=OD:SATDSP.FO/-SN FOR OD:USRSAT,LD:USRSAT.LI/LI:SRC=OD:USRSAT.FO/-SN #IFF FORLST FOR OD:SATDSP=OD:SATDSP.FO/-SN FOR OD:USRSAT=OD:USRSAT.FO/-SN #ENDC FORLST #ENDC -SATEL #IFTF HOSAT #IF DELFIL PIP OD:*.FO;*/DE #ENDC DELFIL #IFF HOSAT LBR OD:GLIB/CR=OD:GRPAK1.OB,GRSUBS.OB #IFT HOSAT #IF SATEL LBR OD:GLIBS/CR=OD:GRPAK1.OB,GRSUBS.OB #IFF SATEL LBR OD:GLIBH/CR=OD:GRPAK1.OB,GRSUBS.OB #ENDC SATEL #IFTF HOSAT #IF DELFIL PIP OD:*.OB;*/DE PIP OD:*.MA;*/DE PIP OD:GRCOM.CND;*/DE #ENDC DELFIL #IFF HOSAT PIP OD:GRBLD.*/PU #IFT HOSAT #IF SATEL PIP OD:SATDSP.OBJ/PU PIP OD:USRSAT.OBJ/PU PIP OD:GRSBLD.*/PU #IFF SATEL PIP OD:LGR.OBJ;*/DE PIP OD:GRHBLD.*/PU #ENDC SATEL #ENDC HOSAT #IFF RSX11M #IF RSX11D #FILE OD:GRGEN.BIS $JOB/MCR $MCR PIP OD:*.OB;*/DE $MCR PIP LD:*.LI;*/DE #IF HOSAT #IF SATEL $MCR PIP OD:GLIBS.OLB;*/DE #IFF SATEL $MCR PIP OD:GLIBH.OLB;*/DE #ENDC SATEL #IFF HOSAT $MCR PIP OD:GLIB.OLB;*/DE #IFTF HOSAT #IF MACLST $MCR MAC OD:GRSUBS.OB,LD:GRSUBS.LI=OD:GRSUBS.MA,GRSUBS #IFF MACLST $MCR MAC OD:GRSUBS.OB=OD:GRSUBS.MA,GRSUBS #ENDC MACLST #IFN F4PLUS #IF FORLST $MCR FOR OD:GRPAK1.OB,LD:GRPAK1.LI/LI:SRC=OD:GRPAK1.FO/-SN #IFF FORLST $MCR FOR OD:GRPAK1.OB=OD:GRPAK1.FO/-SN #ENDC FORLST #IFF -F4PLUS #IF FORLST $MCR F4P OD:GRPAK1.OB,LD:GRPAK1.LI/LI:SRC=OD:GRPAK1.FO/CO:20. #IFF FORLST $MCR F4P OD:GRPAK1.OB=OD:GRPAK1.FO/CO:20. #ENDC FORLST #ENDC -F4PLUS #IFT HOSAT #IFN SATEL #IFN F4PLUS #IF FORLST $MCR FOR OD:LGR,LD:LGR.LI/LI:SRC=OD:LGR.FO/-SN #IFF FORLST $MCR FOR OD:LGR=OD:LGR.FO/-SN #ENDC FORLST #IFF -F4PLUS #IF FORLST $MCR F4P OD:LGR,LD:LGR.LI/LI:SRC=OD:LGR.FO/CO:20. #IFF FORLST $MCR F4P OD:LGR=OD:LGR.FO/CO:20. #ENDC FORLST #ENDC -F4PLUS $MCR TKB OD:LGR=OD:LGR #IFF -SATEL #IF FORLST $MCR FOR OD:SATDSP,LD:SATDSP.LI/LI:SRC=OD:SATDSP.FO/-SN $MCR FOR OD:USRSAT,LD:USRSAT.LI/LI:SRC=OD:USRSAT.FO/-SN #IFF FORLST $MCR FOR OD:SATDSP=OD:SATDSP.FO/-SN $MCR FOR OD:USRSAT=OD:USRSAT.FO/-SN #ENDC FORLST #ENDC -SATEL #IFTF HOSAT #IF DELFIL $MCR PIP OD:*.FO;*/DE #ENDC DELFIL #IFF HOSAT $MCR LBR OD:GLIB/CR=OD:GRPAK1.OB,GRSUBS.OB #IFT HOSAT #IF SATEL $MCR LBR OD:GLIBS/CR=OD:GRPAK1.OB,GRSUBS.OB #IFF SATEL $MCR LBR OD:GLIBH/CR=OD:GRPAK1.OB,GRSUBS.OB #ENDC SATEL #IFTF HOSAT #IF DELFIL $MCR PIP OD:*.OB;*/DE $MCR PIP OD:*.MA;*/DE $MCR PIP OD:GRCOM.CND;*/DE #ENDC DELFIL #IFF HOSAT $MCR PIP OD:GRBLD.*/PU #IFT HOSAT #IF SATEL $MCR PIP OD:SATDSP.OBJ/PU $MCR PIP OD:USRSAT.OBJ/PU $MCR PIP OD:GRSBLD.*/PU #IFF SATEL $MCR PIP OD:LGR.OBJ;*/DE $MCR PIP OD:GRHBLD.*/PU #ENDC SATEL #ENDC HOSAT $EOJ #IFF RSX11D #FILE OD:GRGEN.CMD DEL OD:*.OB;* DEL LD:*.LI;* #IF HOSAT #IF SATEL DEL OD:GLIBS.OLB;* #IFF SATEL DEL OD:GLIBH.OLB;* #ENDC SATEL #IFF HOSAT DEL OD:GLIB.OLB;* #IFTF HOSAT #IF MACLST MAC/OBJ:OD:GRSUBS.OB/LIS:LD:GRSUBS.LI OD:GRSUBS.MA+OD:GRSUBS #IFF MACLST MAC/OBJ:OD:GRSUBS.OB OD:GRSUBS.MA+OD:GRSUBS #ENDC MACLST #IFN F4PLUS #IF FORLST FOR/FOR/SW:(/-SN/LI:SRC)/OBJ:OD:GRPAK1.OB/LIS:LD:GRPAK1.LI OD:GRPAK1.FO #IFF FORLST FOR/FOR/SW:(/-SN)/OBJ:OD:GRPAK1.OB OD:GRPAK1.FO #ENDC FORLST #IFF -F4PLUS #IF FORLST FOR/F4P/SW:(/CO:20.)/OBJ:OD:GRPAK1.OB/LIS:LD:GRPAK1.LI OD:GRPAK1.FO #IFF FORLST FOR/F4P/SW:(/CO:20.)/OBJ:OD:GRPAK1.OB OD:GRPAK1.FO #ENDC FORLST #ENDC -F4PLUS #IFT HOSAT #IFN SATEL #IFN F4PLUS #IF FORLST FOR/FOR/SW:(/-SN/LI:SRC)/OBJ:OD:LGR/LIS:LD:LGR OD:LGR.FO #IFF FORLST FOR/FOR/SW:(/-SN)/OBJ:OD:LGR OD:LGR.FO #ENDC FORLST #IFF -F4PLUS #IF FORLST FOR/F4P/SW:(/CO:20.)/OBJ:OD:LGR/LIS:LD:LGR OD:LGR.FO #IFF FORLST FOR/F4P/SW:(/CO:20.)/OBJ:OD:LGR OD:LGR.FO #ENDC FORLST #ENDC -F4PLUS LINK OD:LGR #IFF -SATEL #IF FORLST FOR/FOR/SW:(/-SN/LI:SRC)/OBJ:OD:SATDSP/LIS:LD:SATDSP OD:SATDSP.FO FOR/FOR/SW:(/-SN/LI:SRC)/OBJ:OD:USRSAT/LIS:LD:USRSAT.LI OD:USRSAT.FO #IFF FORLST FOR/FOR/SW:(/-SN)/OBJ:OD:SATDSP OD:SATDSP.FO FOR/FOR/SW:(/-SN)/OBJ:OD:USRSAT OD:USRSAT.FO #ENDC FORLST #ENDC -SATEL #IFTF HOSAT #IF DELFIL DEL OD:*.FO;* #ENDC DELFIL #IFF HOSAT LIB CREATE OD:GLIB OD:GRPAK1.OB,OD:GRSUBS.OB #IFT HOSAT #IF SATEL LIB CREATE OD:GLIBS OD:GRPAK1.OB,OD:GRSUBS.OB #IFF SATEL LIB CREATE OD:GLIBH OD:GRPAK1.OB,OD:GRSUBS.OB #ENDC SATEL #IFTF HOSAT #IF DELFIL DEL OD:*.OB;* DEL OD:*.MA;* DEL OD:GRCOM.CND;* #ENDC DELFIL #IFF HOSAT DEL/KEEP OD:GRBLD.*;* #IFT HOSAT #IF SATEL DEL/KEEP OD:SATDSP.OBJ;* DEL/KEEP OD:USRSAT.OBJ;* DEL/KEEP OD:GRSBLD.*;* #IFF SATEL DEL OD:LGR.OBJ;* DEL/KEEP OD:GRHBLD.*;* #ENDC SATEL #ENDC HOSAT #ENDC RSX11D #ENDC RSX11M #ENDC RT11 #ENDS #NAME GRLINK #SUBS 'OD:'OUTDEV,'LD:'LSTDEV #IF RT11 #IF OVRLAY #FILE OD:GRLINK.BAT $JOB/RT11 .R LINK *OD:USER,LD:USER=OD:USER,GRP01.OB,TAGSRH.OB,TRAK.OB,TRAKXY.OB,GRSUBS.OB/F/C *OD:COPY.OB/O:1/C *OD:MENU.OB/O:1/C *OD:ADVANC.OB,CHANGA.OB,CHANGE.OB,CHANGT.OB,GET.OB,POINTR.OB/O:2/C *OD:CHANGP.OB,CVSCAL.OB,FLASH.OB,INTENS.OB,LINTYP.OB,SENSE.OB/O:2/C *OD:ATTACH.OB,DETACH.OB,GRID.OB/O:2/C *OD:APNT.OB,AVECT.OB,LVECT.OB,RPNT.OB,SVECT.OB,VECTS.OB/O:2/C *OD:GRP02.OB,ERAS.OB,ERASP.OB,OFF.OB,ON.OB/O:2/C *OD:FIGR.OB,NMBR.OB,XGRA.OB,YGRA.OB,ZGRA.OB/O:2/C *OD:GRP04.OB,INIT.OB,NOSC.OB,SCAL.OB,SCOPE.OB,WINDOW.OB/O:3/C *OD:CMPRS.OB,RSTR.OB,SAVE.OB/O:3/C *OD:INSERT.OB/O:3/C *OD:ESUB.OB,SUBP.OB,TEXOO.OB,TEXT.OB/O:3/C $EOJ #ENDC OVRLAY #IFF RT11 #IFN HOSAT #FILE OD:GRBLD.CMD #IF OVRLAY OD:USER=OD:GRBLD/MP #IFF OVRLAY OD:USER=OD:USER,GLIB/LB #IFTF OVRLAY / ASG=GR0:1 #IF LK11 ASG=PB0:3 #ENDC LK11 MAXBUF=512 // #IFT OVRLAY #FILE OD:GRBLD.ODL .ROOT OD:USER-GR0-GR1,GR2,GR3 GR0: .FCTR GR0A-GR0B-GR0C GR0A: .FCTR OD:GLIB/LB:ERROR:LPEN:MODE:PTRCHK:PUTCHR:PUTEM GR0B: .FCTR OD:GLIB/LB:BUFTST:PUTWD:TAGSRH:TRAK:TRAKXY:GRSUBS GR0C: .FCTR OD:GLIB/LB:DISPLY:GRATTN:PBH:PBL:PBS:KBC GR1: .FCTR *(OD:GLIB/LB:COPY,OD:GLIB/LB:MENU) GR2: .FCTR *(GR2A,GR2B,GR2C,GR2D,GR2E,GR2F) GR2A: .FCTR OD:GLIB/LB:ADVANC:CHANGA:CHANGE:CHANGT:GET:POINTR GR2B: .FCTR OD:GLIB/LB:CHANGP:CVSCAL:FLASH:INTENS:LINTYP:SENSE GR2C: .FCTR OD:GLIB/LB:ATTACH:DETACH:GRID GR2D: .FCTR OD:GLIB/LB:APNT:AVECT:LVECT:RPNT:SVECT:VECTS GR2E: .FCTR OD:GLIB/LB:DPTR:DPYNOP:DPYWD:ERAS:ERASP:OFF:ON GR2F: .FCTR OD:GLIB/LB:NMBR:XGRA:YGRA:ZGRA:FIGR GR3: .FCTR *(GR3A,GR3B,GR3C,GR3D) GR3A: .FCTR OD:GLIB/LB:INIT:NOSC:SCAL:SCOPE:WINDOW GR3B: .FCTR OD:GLIB/LB:CMPRS:RSTR:SAVE GR3C: .FCTR OD:GLIB/LB:INSERT GR3D: .FCTR OD:GLIB/LB:ESUB:SUBP:TEXOO:TEXT .END #ENDC OVRLAY #IFF -HOSAT #IFN IAS #IF SATEL #FILE OD:GRSBLD.CMD OD:SATCTL/-HD,OD:SATCTL/SH=OD:SATDSP,USRSAT,GLIBS/LB / STACK=256 #SUBS '20000'DFSIZE EXTSCT=DFILE:20000 // #IFF SATEL #FILE OD:GRHBLD.CMD OD:USER=OD:USER,GLIBH/LB / MAXBUF=512 // #ENDC SATEL #IFF -IAS #IF SATEL #FILE OD:GRSBLD.CMD LINK/MAP/OPTION/TASK:OD:SATCTL/NOHEADER OD:SATDSP,OD:USRSAT,OD:GLIBS/LIB,[1,1]FORLIB/LIB STACK=256 #SUBS '20000'DFSIZE EXTSCT=DFILE:20000 / #IFF SATEL #FILE OD:GRHBLD.CMD LINK/OPTION/TASK:OD:USER OD:USER,OD:GLIBH/LIB MAXBUF=512 / #ENDC SATEL #ENDC -IAS #ENDC -HOSAT #ENDC RT11 #ENDS #NAME USRSAT #SUBS 'OD:'OUTDEV #IF SATEL #FILE OD:USRSAT.FO SUBROUTINE USRSAT(B,I) LOGICAL*1 B(60) RETURN END #ENDC SATEL #ENDS #NAME LGR #IF HOSAT #IFN SATEL #SUBS 'OD:'OUTDEV #FILE OD:LGR.FO #ENDS ; ; LGR -- LOADER FOR GRAPHICS TERMINALS ; ; TRANSMITS RSX11M/D TASK IMAGE TO GT40/VS62 IN ; SPECIAL LOADER FORMAT. EACH RECORD ; LOOKS LIKE: ; ; #BYTE 1,0 ;MESSAGE HEADER ; #WORD COUNT ;COUNT OF MESSAGE (LESS LAST BYTE) ; #WORD LODADR ;BEGINNING LOAD ADDRESS ; #WORD DATA,DATA,... ;DATA BYTES ; #BYTE CHKSUM ;CHECKSUM OF ALL PRECEEDING BYTES ; #BYTE 0 ;IGNORED ; ; IN ADDITION, EACH GROUP OF THREE EIGHT BIT BYTES OF THE ; MESSAGE IS TRANSFORMED INTO A GROUP OF FOUR SIX BIT BYTES ; WHICH ARE MAPPED INTO THE LEGAL ASCII CHARACTERS 40-137 ; COMMON/LOAD/BUFFER,TSKBAS,TSKBLK,TSKSIZ LOGICAL*1 FILNAM(40),DOT,DTSK(4),STMSG(9),CKSUM,LODMSG(10), X MCRLIN(80) INTEGER BUFFER(256),TSKBAS,TSKBLK,TSKSIZ,TSKTRA, X BYTES(3),MSGST(9),IPRM(6),IOSTAT(2) EQUIVALENCE (DTSK,DOT),(STMSG(5),TSKTRA),(STMSG(7),CKSUM) DATA DTSK/'.','T','S','K'/ DATA LODMSG/"175,'R',"175,'L',0,0,0,0,0,0/ DATA STMSG/1,0,6,0,0,0,0,0,0/ C C DISABLE ERROR PRINT FOR FILE READ ERROR C CALL ERRSET(39,.TRUE.,.FALSE.,.TRUE.,.FALSE.,31) C C READ FILE NAME C CALL GETMCR(MCRLIN,IDS) IF(IDS.LE.4)GOTO 9 N=IDS-4 DO 5 I=1,N 5 FILNAM(I)=MCRLIN(I+4) GOTO 25 9 WRITE(5,10) 10 FORMAT('$LGR>') READ(5,20)N,FILNAM 20 FORMAT(Q,40A1) C C DEFAULT EXTENSION .TSK C 25 DO 30 I=1,N IF(FILNAM(I).EQ.DOT)GOTO 50 30 CONTINUE DO 40 I=1,4 40 FILNAM(N+I)=DTSK(I) N=N+4 50 FILNAM(N+1)=0 C C OPEN FILE C CALL ASSIGN(2,FILNAM) DEFINE FILE 2 (128,256,U,INDEX) C C READ TASK LABEL BLOCK C READ(2'1)BUFFER #IF RSX11M TSKSIZ=BUFFER(7) TSKBAS=BUFFER(9) TSKBLK=BUFFER(10)+1 TSKTRA=BUFFER(12) #IFF RSX11M TSKSIZ=BUFFER(7) TSKBAS=0 TSKBLK=BUFFER(10)+1 WRITE(5,111) 111 FORMAT('$STARTING ADDRESS ?') READ(5,112)TSKTRA 112 FORMAT(O7) #ENDC RSX11M C C OUTPUT RL C CALL GETADR(IPRM,LODMSG) IPRM(2)=10 IPRM(3)=0 CALL QIO("410,5,10,,,IPRM) CALL WAITFR(10) C C READ 3 BYTES AND OUTPUT 4 C 100 CALL GETBYT(BYTES) IF(TSKSIZ.LT.0)GOTO 105 CALL PUT6B(BYTES) GOTO 100 C C COMPUTE CHECKSUM FOR STARTUP MESSAGE C 105 CKSUM=0 DO 110 I=1,6 110 CKSUM=CKSUM-STMSG(I) DO 120 I=1,9 120 MSGST(I)=STMSG(I) C C OUTPUT STARTUP MESSAGE C CALL PUT6B(MSGST) CALL PUT6B(MSGST(4)) CALL PUT6B(MSGST(7)) STOP END SUBROUTINE GETBYT(BYTES) INTEGER BYTES(3),TSKBAS,TSKBLK,TSKSIZ LOGICAL*1 BUFFER(512),RECBUF(72),CKSUM,ZERO EQUIVALENCE (LODADR,RECBUF(5)),(CKSUM,RECBUF(71)) COMMON/LOAD/BUFFER,TSKBAS,TSKBLK,TSKSIZ DATA RECBUF/1,0,71,69*0/ DATA N,NXTREC/73,512/ DO 400 I=1,3 IF(N.LE.72)GOTO 350 100 TSKSIZ=TSKSIZ-1 NXTREC=NXTREC+64 IF(NXTREC.LT.512)GOTO 200 READ(2'TSKBLK,ERR=500,END=500)BUFFER TSKBLK=TSKBLK+1 NXTREC=0 200 LODADR=TSKBAS C ZERO BLOCKS ARE NOT TRANSMITTED UNLESS THEY FALL C INTO THE AREAS WHICH ARE NOT ZEROED BY C THE GT40 BOOT: 0-76, 300-376, 1000-7076 LODBLK=LODADR/"100.AND."1777 ZERO=LODBLK.NE.0.AND.LODBLK.NE.3.AND. X (LODBLK.LT."10.OR.LODBLK.GT."70) TSKBAS=TSKBAS+"100 CKSUM=-(72+RECBUF(5)+RECBUF(6)) DO 300 J=1,64 ZERO=ZERO.AND.BUFFER(NXTREC+J).EQ.0 RECBUF(J+6)=BUFFER(NXTREC+J) 300 CKSUM=CKSUM-BUFFER(NXTREC+J) N=1 IF(ZERO.AND.TSKSIZ.GE.0)GOTO 100 350 BYTES(I)=RECBUF(N) 400 N=N+1 RETURN 500 TSKSIZ=-1 RETURN END SUBROUTINE PUT6B(BYTES) INTEGER BYTES(3),IPRM(6) LOGICAL*1 OCHARS(4),OC1,OC2,OC3,OC4 EQUIVALENCE (OCHARS(1),OC1),(OCHARS(2),OC2),(OCHARS(3),OC3), X (OCHARS(4),OC4) OC1=(BYTES(1).AND."374)/"4 OC2=(BYTES(1).AND."3)*"20+(BYTES(2).AND."360)/"20 OC3=(BYTES(2).AND."17)*"4+(BYTES(3).AND."300)/"100 OC4=BYTES(3).AND."77 DO 100 I=1,4 100 IF(OCHARS(I).LT."40)OCHARS(I)=OCHARS(I)+"100 CALL GETADR(IPRM,OCHARS) IPRM(2)=4 IPRM(3)=0 CALL QIO("410,5,10,,,IPRM) CALL WAITFR(10) RETURN END #ENDC SATEL #ENDC HOSAT #NAME GRCOM ; ; ; BEWARE !!! ; ; IF ANY CHANGES ARE MADE TO THE COMMON SECTIONS, CORRESPONDING CHANGES ; MUST ALSO BE MADE TO GRSUBS.MAC ; ; #SUBS 'OD:'OUTDEV #FILE OD:GRCOM.CND #ENDS #IF SORNHS COMMON/DFILE/LOCK,NAME(9),IDPC,IDSR,IX,IY,IDSR2,IXO,IYO, X IXYOS,ITIP1,ITIP2,LPFLAG,IRSVD(5),IBUF(32) COMMON/GRDAT/IFLG,ISIZ,IBAS,ITXT,ISHV,ILOV,IAPT,IGRX,IGRY, X IRPT,IBSV,IARC,IABV,INAM,ISRC,IJMP,IJMPR,IJSR,IJSRR,INOP,IRET, X IRETR,ICTL,ISRA,IHLT,ISRB,ISRBP,IINT,IOFF,IPTR,IPWS,ISTP,MOLD, X LUNS,IAUT,ICHR,IINS,IPWP,IPW1,IPW2,ILST,IEND,IPRV,IVIS,ITEX, #IF SCOPES X ICHT,IPBF,ISTK(8),ICHI(21),ICHM(21),IATT(83) #IFF SCOPES X ICHT,IPBF,ISTK(8),ICHI(21),ICHM(21),IATT(41) #ENDC SCOPES #IFN INTEGR X ,XSCF,XBAS,YSCF,YBAS #ENDC -INTEGR DATA IFLG/0/ #IFF SORNHS COMMON/GRDAT/IFLG,ITXT,ISHV,ILOV,IAPT,IGRX,IGRY, X IRPT,IBSV,IARC,IABV,INAM,ISRC,IJMP,IJMPR,IJSR,IJSRR,INOP,IRET, X IRETR,ICTL,ISRA,IHLT,ISRB,ISRBP,IINT,IOFF,ISSIZ,LUNS,ICHT, X JADV,JATT,JCHA,JCHE,JCHT,JCMP,JCOP,JCVS,JDET,JUSD,JERA,JERP, X JESB,JFLA,JFRE,JGET,JGRD,JINI,JINS,JINT,JLTY,JLPE,JOFF,JON, X JPTR,JNWD,JSCL,JSNS,JSUB,JTRK,JTXY,JGRA,JTAG,JSAV,JRST,JDIS, X JPBH,JPBL,JPBS,JKBC, #SUBS 'MAXR'MAXR X IAUT,ICHR,IVIS,ITEX,ISCNT,ISBUF(MAXR),XSCF,XBAS,YSCF,YBAS #ENDS #ENDC SORNHS #NAME SATDSP #IF SATEL #SUBS 'OD:'OUTDEV #FILE OD:SATDSP.FO #ENDS #SUBS 'MAXR'MAXR INTEGER IN(MAXR),IA(8),INTEGR #ENDS #IF INTEGR INTEGER R1,R3,R5,R7,X,Y #IFF INTEGR REAL REEL #IFTF INTEGR LOGICAL*1 B(36),B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13, X B14,B15,B16,B17,B18,B19,B20,B21,B22,B23,B24,B25,B26,B27,B28, X B29,B30,B31,B32,B33,B34,B35,B36 EQUIVALENCE (B,IN,B1,I1,R1),(B(2),B2),(B(3),B3,I3,R3), X (B(4),B4),(B(5),B5,I5,R5),(B(6),B6),(B(7),B7,I7,R7), X (B(8),B8),(B(9),B9), X (B(10),B10),(B(11),B11),(B(12),B12),(B(13),B13), X (B(14),B14),(B(15),B15),(B(16),B16),(B(17),B17), X (B(18),B18),(B(19),B19),(B(20),B20),(B(21),B21), X (B(22),B22),(B(23),B23),(B(24),B24),(B(25),B25), X (B(26),B26),(B(27),B27),(B(28),B28),(B(29),B29), X (B(30),B30),(B(31),B31),(B(32),B32),(B(33),B33), X (B(34),B34),(B(35),B35),(B(36),B36) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS IFLG=0 #SUBS '20000'DFSIZE CALL INIT("20000) #ENDS 5 CALL FRHOST(B,I) K2=B2 I2=INTEGR(B2) #IFF INTEGR R2=REEL(B2) #IFTF INTEGR K3=B3 K4=B4 I4=INTEGR(B4) K5=B5 #IFT INTEGR K6=B6 #IFF INTEGR R6=REEL(B6) K10=B10 #IFTF INTEGR IF(B1.GE.1.AND.B1.LE.40.AND.I.NE.0) X GOTO (10,20,30,40,50,60,70,80,90,100, X 110,120,130,140,150,160,170,180,190,200,210,220,230,240,250, X 260,270,280,290,300,310,320,330,340,350,360,370,380,390,400),B1 CALL USRSAT(B,I) GOTO 5 10 CALL ADVANC(K2,I3) GOTO 5 20 CALL ATTACH(K2,K3,K4) GOTO 5 #IFT INTEGR 30 CALL CHANGA(K2,I3,I5) #IFF INTEGR 30 CALL CHANGA(K2,R3,R7) #IFTF INTEGR GOTO 5 #IFT INTEGR 40 CALL CHANGE(K2,I3,I5) #IFF INTEGR 40 CALL CHANGE(K2,R3,R7) #IFTF INTEGR GOTO 5 50 CALL FRHOST(B) CALL PTRCHK(K2,J,M) IF(M.NE.ITXT)GOTO 5 #SUBS 'MAXR'MAXR DO 55 I=3,MAXR #ENDS #IFN VS60 IF(IBUF(J).LT.0.AND.IAND(IBUF(J),"176000).NE.ISRA)GOTO 5 #IFF K3=IAND(IBUF(J),"176000) IF(K3.LT.0.AND.K3.NE.ISRA.AND.K3.NE.ISRC)GOTO 5 #ENDC IBUF(J)=IN(I) IF(I.GT.B2)IBUF(J)=0 J=J+1 55 CONTINUE CALL ERROR(5) 60 CALL CMPRS GOTO 5 70 IF(I4.EQ.0)CALL COPY(,I2) IF(I4.NE.0)CALL COPY(I4,I2) GOTO 5 80 CALL CVSCAL(I2,K4,K5) GOTO 5 90 CALL DETACH(K2) GOTO 5 100 CALL DPTR(I) CALL TOHOST(2,I) GOTO 5 110 IF(I2.EQ.0)CALL ERAS IF(I2.NE.0)CALL ERAS(I2) GOTO 5 120 CALL ERASP(K2) GOTO 5 130 IF(I2.EQ.0)CALL ESUB IF(I2.NE.0)CALL ESUB(I2) GOTO 5 140 CALL FLASH(K2,K3) GOTO 5 150 CALL FREE STOP 160 CALL GET(K2,X,Y) #IFT INTEGR CALL TOHOST(2,X,2,Y) #IFF INTEGR CALL TOHOST(4,X,4,Y) #IFTF INTEGR GOTO 5 #IFT INTEGR 170 CALL GRID(I2,I4,K6) #IFF INTEGR 170 CALL GRID(R2,R6,K10) #IFTF INTEGR GOTO 5 180 CALL VERSON(I) IF(I.NE.I2)CALL ERROR(19) CALL INIT GOTO 5 190 IF(K2.EQ.0)CALL INSERT IF(K2.NE.0)CALL INSERT(K2) GOTO 5 200 CALL INTENS(K2,K3) GOTO 5 210 CALL LINTYP(K2,K3) GOTO 5 220 CALL LPEN(IH,IT,X,Y,IP,IA,IM,IT1,IT2) #IFT INTEGR CALL TOHOST(1,IH,2,IT,2,X,2,Y,2,IP,16,IA,1,IM,1,IT1,1,IT2) #IFF INTEGR CALL TOHOST(1,IH,2,IT,4,X,4,Y,2,IP,16,IA,1,IM,1,IT1,1,IT2) #IFTF INTEGR GOTO 5 230 CALL OFF(I2) GOTO 5 240 CALL ON(I2) GOTO 5 250 CALL POINTR(K2,I3,I5) GOTO 5 260 IF(K2.LT.2)GOTO 5 DO 265 I=2,K2 IF(IN(I).GE.0.OR.IAND(IN(I),"70000).GE."50000)GOTO 264 IF(MOLD.EQ.IN(I))GOTO 265 MOLD=IN(I) 264 CALL PUTWD(IN(I)) 265 CONTINUE CALL PUTEM #IFT INTEGR 270 GOTO 5 #IFF INTEGR GOTO 5 270 XSCF=R2 XBAS=R6 YSCF=REEL(B10) YBAS=REEL(B14) GOTO 5 #IFTF INTEGR 280 CALL SENSE(K2,K3,K4) GOTO 5 290 IF(I4.EQ.0)CALL SUBP(I2) IF(I4.NE.0)CALL SUBP(I2,I4) GOTO 5 #IFT INTEGR 300 CALL TRAK(I2,I4,K6) #IFF INTEGR 300 CALL TRAK(R2,R6,K10) #IFTF INTEGR GOTO 5 310 CALL TRAKXY(X,Y,K2) #IFT INTEGR CALL TOHOST(2,X,2,Y) #IFF INTEGR CALL TOHOST(4,X,4,Y) #ENDC INTEGR GOTO 5 320 IF(K2.NE.0)CALL DHOST(1) CALL GRATTN(K2,I,K3,K4,K5) CALL TOHOST(1,I) GOTO 5 330 CALL TAGSRH(I2,I) CALL TOHOST(2,I) GOTO 5 340 CALL CMPRS(1) #IFN SCOPES CALL TOHOST(2,IPTR-29) #SUBS 'MAXR'MAXR DO 345 I=31,IPTR+1,MAXR #IFF CALL TOHOST(2,IPTR-62) DO 345 I=64,IPTR+1,MAXR #ENDC 345 CALL TOHOST(MAXR*2,IBUF(I)) CALL CMPRS(2) GOTO 5 350 CALL CMPRS(1) CALL VERSON(I) IF(IAND(I-K4,"3).NE.0)CALL ERROR(19) I=IPTR IPTR=IPTR+I2-2 IF(IPTR.GT.ISIZ)CALL ERROR(9) DO 355 J=I,IPTR+1,MAXR #ENDS CALL FRHOST(IBUF(J)) 355 CONTINUE CALL CMPRS(2) GOTO 5 360 CALL DISPLY(K2) GOTO 5 370 GOTO 5 #IF LK11 380 CALL PBWRIT(I2,I4,K6) GOTO 5 #IFF LK11 380 GOTO 5 #IFT LK11 390 CALL PBREAD(I) CALL TOHOST(2,IPBF,2,I) IPBF=I GOTO 5 #IFF LK11 390 GOTO 5 #ENDC LK11 400 CALL KBC(I) CALL TOHOST(1,I) GOTO 5 END #ENDC SATEL #NAME GRPAK1 #IFN BRAKUP #SUBS 'OD:'OUTDEV #FILE GRPAK1.FO #ENDS #ENDC -BRAKUP #NAME ACCESS #IF SATEL SUBROUTINE ACCESS(MODEA,FILNAM,ICHAN,IORET,ISIZE) #IF LOCSAV ; ; ACCESS FILE ON RT11 FORMAT FLOPPY DISK ; IN ONE OF FOUR MODES : ; ; 1 ACCESS OLD FILE FOR READ/WRITE ; 2 CREATE NEW FILE FOR READ/WRITE ; 3 DELETE OLD FILE ; 4 RENAME FILE (ICHAN IS OLD NAME) ; ; RESTRICTIONS : ; ; ONE DIRECTORY SEGMENT PER VOLUME ; NO EXTRA WORDS IN DIRECTORY SEGMENTS ; NEW FILES MUST SPECIFY SIZE UPON CREATION ; RENAME AND CREATE FAIL IF NEW FILE NAME IS IN USE ; ; STATUS RETURNS (IORET) : ; ; +1 SUCCESSFUL ; -1 IO ERROR ON FILE ; -2 BAD FILE NAME STRING ; -3 ERROR READING DIRECTORY ; -4 ERROR WRITING DIRECTORY ; -5 FILE NAME IN USE ; -6 FILE NOT FOUND ; -7 DEVICE FULL ; -8 DIRECTORY FULL ; -9 BAD DIRECTORY ; -10 END OF FILE ; -11 NO LOCAL RX01 SUPPORT ; ; COMMON/IOX/KUNIT(8),KSTRT(8),KLEN(8),KDIR(512) INTEGER NAME(3) EQUIVALENCE (NAME(1),NAM1),(NAME(2),NAM2),(NAME(3),NAM3) MODE=MODEA CALL CSI(FILNAM,IUNIT,NAME,IORET) IF(IORET.LT.0)RETURN IUNIT=IUNIT.AND.1 CALL DX(IUNIT,0,6,512,KDIR,IORET) 10 IF(IORET)3000,10,100 100 IBLOCK=KDIR(5) DO 200 I=6,503,7 IF(KDIR(I).EQ."4000)GOTO (6000,500,1900,300,6000),MODE IF(KDIR(I).EQ."2000.AND.KDIR(I+1).EQ.NAM1.AND.KDIR(I+2).EQ.NAM2 X .AND.KDIR(I+3).EQ.NAM3)GOTO (250,5000,400,5000,350),MODE 200 IBLOCK=IBLOCK+KDIR(I+4) GOTO 9000 250 KUNIT(ICHAN)=IUNIT KSTRT(ICHAN)=IBLOCK KLEN(ICHAN)=KDIR(I+4) RETURN 300 MODE=5 CALL CSI(ICHAN,II,NAME,IORET) IF(IORET)1900,100,100 350 CALL CSI(FILNAM,II,NAME,IORET) KDIR(I+1)=NAM1 KDIR(I+2)=NAM2 KDIR(I+3)=NAM3 GOTO 1100 400 KDIR(I)="1000 DO 480 II=6,496,7 440 IF(KDIR(II).NE."1000.OR.KDIR(II+7).NE."1000)GOTO 480 INEWS=KDIR(II+4)+KDIR(II+11) DO 460 K=II,496,7 DO 460 L=K,K+6 460 KDIR(L)=KDIR(L+7) KDIR(II+4)=INEWS GOTO 440 480 CONTINUE GOTO 1100 500 IBLOCK=KDIR(5) DO 1700 I=6,503,7 IF(KDIR(I).EQ."4000)GOTO 7000 IF(KDIR(I).EQ."1000)IF(KDIR(I+4)-ISIZE)1700,600,520 GOTO 1700 520 DO 550 J=I+7,496,7 550 IF(KDIR(J).EQ."4000)GOTO 560 GOTO 8000 560 DO 580 K=I,J,7 DO 580 L=J+I-K,J+I-K+6 580 KDIR(L+7)=KDIR(L) KDIR(I+11)=KDIR(I+11)-ISIZE 600 KUNIT(ICHAN)=IUNIT KSTRT(ICHAN)=IBLOCK KLEN(ICHAN)=ISIZE KDIR(I)="2000 KDIR(I+1)=NAM1 KDIR(I+2)=NAM2 KDIR(I+3)=NAM3 KDIR(I+4)=ISIZE KDIR(I+5)=0 KDIR(I+6)="22604 1100 CALL DX(IUNIT,1,6,512,KDIR,IORET) 1200 IF(IORET)4000,1200,1900 1700 IBLOCK=IBLOCK+KDIR(I+4) GOTO 9000 1900 RETURN 3000 IORET=-3 RETURN 4000 IORET=-4 RETURN 5000 IORET=-5 RETURN 6000 IORET=-6 RETURN 7000 IORET=-7 RETURN 8000 IORET=-8 RETURN 9000 IORET=-9 #IFF LOCSAV IORET=-11 #ENDC LOCSAV RETURN END #ENDC SATEL #NAME ADVANC #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ADVANC.FO #ENDS #ENDC BRAKUP SUBROUTINE ADVANC(K,N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS NA=1 IF(NOPTS(1).EQ.1)NA=N CALL PTRCHK(K,II,M) CALL PUTEM(0) 100 NA=NA-1 IF(NA.LT.0)GOTO 350 M=ICHM(K) IF(M.EQ.1)RETURN I=1 #IFN VS60 IF(M.EQ.IAPT.OR.M.EQ.ILOV)I=2 #IFF IF(M.EQ.IAPT.OR.M.EQ.ILOV.OR.M.EQ.IABV)I=2 #IFTF 200 II=II+I 250 L=IBUF(II) IF(M.NE.ITXT)IF(L)300,100,100 #IFT IF(L.GE.0.OR.IAND(L,"176000).EQ.ISRA)GOTO 200 #IFF IF(L.GE.0.OR.IAND(L,"176000).EQ.ISRA.OR. X IAND(L,"176000).EQ.ISRC)GOTO 200 #IFT 300 IF(L.NE.IJSR+2.AND.(L.NE.IRET.OR.IBUF(II+1).NE.0))GOTO 400 #IFF 300 IF(II.NE.IPTR.AND.L.NE.IRET.AND.L.NE.IRETR)GOTO 400 #IFTF 320 ICHM(K)=1 350 ICHI(K)=II RETURN #IFT 400 IF(L.NE.IJSR.AND.L.NE.IJMP.AND.L.NE.IJSR+1.AND.L.NE.IJMP+1) X GOTO 500 II=NWDS(IBUF(II+1)-IBAS)+1 GOTO 250 #IFF 400 IF(L.NE.IJSRR+4.AND.L.NE.IJMPR)GOTO 450 IF(IBUF(II+2).EQ.0)GOTO 320 II=NWDS(IBUF(II+2)-IBAS)+1 GOTO 250 450 IF(L.NE.IJSR.AND.L.NE.IJMPR+4)GOTO 500 II=II+5 GOTO 250 #IFTF 500 M=IAND(L,"174000) #IFT IF(M.NE.INOP.AND.M.NE.ISRA.AND.M.NE.ISRB)GOTO 600 #IFF IF(M.NE.INOP.AND.M.NE.ISRA.AND.M.NE.ISRB.AND.M.NE.ISRC) X GOTO 600 #ENDC I=1 GOTO 200 600 ICHM(K)=M II=II+1 GOTO 100 #IFF CALL BUFTST CALL PUTEM(0) CALL TOSAT(JADV,1,1,K,NOPTS(1),2,N,1) RETURN #ENDC END #NAME APNT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:APNT.FO #ENDS #ENDC SUBROUTINE APNT(X,Y,L,I,F,T) #IF INTEGR INTEGER X,Y #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IFT INTEGR CALL MPNT(X,IDX) CALL MPNT(Y,IDY) #IFF INTEGR CALL MPNT(INTR(X*XSCF-XBAS),IDX) CALL MPNT(INTR(Y*YSCF-YBAS),IDY) #ENDC INTEGR CALL MODE(IAPT,NOPTS(2),L,I,F,T) CALL PUTWD(IVIS+IDX) CALL PUTWD(IDY) CALL PUTEM RETURN END #NAME AREA #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:AREA.FO #ENDS #ENDC SUBROUTINE AREA(N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF VS60 CALL BUFTST IF(N.EQ.1)CALL PUTWD(ISRA+2) IF(N.EQ.2)CALL PUTWD(ISRA+3) CALL PUTEM #ENDC VS60 RETURN END #NAME ATTACH #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ATTACH.FO #ENDS #ENDC SUBROUTINE ATTACH(K,L,N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL PTRCHK(K,I,M) LL=1 #IFN SCOPES IF(NOPTS(1).GT.0)LL=ISIGN(1,IOPTV(L)) #IFF NN=1 IF(NOPTS(1)-1)40,30,20 20 IF(N.EQ.2)NN=43 30 LL=ISIGN(1,IOPTV(L)) #IFTF 40 IF(M.EQ.ILOV)GOTO 50 #IFT IF(M.NE.IAPT)RETURN #IFF IF(M.NE.IAPT.AND.M.NE.IABV)RETURN #IFTF LL=0 #IFT 50 DO 200 J=1,39,2 #IFF 50 DO 200 J=NN,NN+38,2 #ENDC IF(IATT(J).NE.0)GOTO 200 IATT(J+2)=0 IATT(J+1)=LL IATT(J)=IADRS(IBUF(I)) RETURN 200 CONTINUE #IFF SORNHS CALL BUFTST CALL TOSAT(JATT,1,1,K,NOPTS(1),1,L,1,1,N,1) #ENDC SORNHS RETURN END #NAME AVECT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:AVECT.FO #ENDS #ENDC SUBROUTINE AVECT(X,Y,L,I,F,T) #IF VS60 #IF INTEGR INTEGER X,Y #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IFT INTEGR CALL MPNT(X,IDX) CALL MPNT(Y,IDY) #IFF INTEGR CALL MPNT(INTR(X*XSCF-XBAS),IDX) CALL MPNT(INTR(Y*YSCF-YBAS),IDY) #ENDC INTEGR CALL MODE(IABV,NOPTS(2),L,I,F,T) CALL PUTWD(IVIS+IDX) CALL PUTWD(IDY) CALL PUTEM #ENDC VS60 RETURN END #NAME BUFTST #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:BUFTST.FO #ENDS #ENDC SUBROUTINE BUFTST #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS IF(IFLG.NE.1)CALL ERROR(2) #IFF SORNHS IF(IFLG.NE.1)CALL INIT #ENDC SORNHS RETURN END #NAME CHANGA #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CHANGA.FO #ENDS #ENDC SUBROUTINE CHANGA(K,X,Y) #IF INTEGR INTEGER X,Y,XX,YY,XXX,YYY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL PTRCHK(K,I,MO) CALL GET(K,XX,YY) CALL ADVANC(K) M=ICHM(K) IF(M.NE.IRPT.AND.M.NE.ISHV.AND.M.NE.ILOV)GOTO 100 CALL GET(K,XXX,YYY) CALL CHANGE(K,XXX-X+XX,YYY-Y+YY) 100 ICHI(K)=I ICHM(K)=MO CALL CHANGE(K,X,Y) #IFF SORNHS CALL BUFTST #IF INTEGR CALL TOSAT(JCHA,3,1,K,2,X,2,Y) #IFF INTEGR CALL TOSAT(JCHA,3,1,K,4,X,4,Y) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME CHANGE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CHANGE.FO #ENDS #ENDC SUBROUTINE CHANGE(K,X,Y) #IF INTEGR INTEGER X,Y #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL PTRCHK(K,L,M) II=IAND(IBUF(L),IINT) #IF INTEGR CALL MVECT(X,IDX,IXS) CALL MVECT(Y,IDY,IYS) #IFF INTEGR CALL MVECT(INTR(X*XSCF),IDX,IXS) CALL MVECT(INTR(Y*YSCF),IDY,IYS) #IFTF INTEGR IF(M.NE.ILOV)GOTO 100 IBUF(L)=II+IXS+IDX IBUF(L+1)=IYS+IDY RETURN 100 IF(M.NE.ISHV.AND.M.NE.IRPT)GOTO 200 IBUF(L)=II+IXS+MIN0(63,IDX)*128+IYS/128+MIN0(63,IDY) RETURN #IFT INTEGR 200 CALL MPNT(X,IDX) CALL MPNT(Y,IDY) #IFF INTEGR 200 CALL MPNT(INTR(X*XSCF-XBAS),IDX) CALL MPNT(INTR(Y*YSCF-YBAS),IDY) #ENDC INTEGR #IFN VS60 IF(M.NE.IAPT)GOTO 300 #IFF IF(M.NE.IAPT.AND.M.NE.IABV)GOTO 300 #IFT IBUF(L)=II+IDX #IFF IBUF(L)=IAND(IBUF(L),IINT+IOFF)+IDX #ENDC IBUF(L+1)=IDY RETURN 300 IF(M.EQ.IGRX)IBUF(L)=IDX IF(M.EQ.IGRY)IBUF(L)=IDY #IFF SORNHS CALL BUFTST #IF INTEGR CALL TOSAT(JCHE,3,1,K,2,X,2,Y) #IFF INTEGR CALL TOSAT(JCHE,3,1,K,4,X,4,Y) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME CHANGP #IF SORNHS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CHANGP.FO #ENDS #ENDC SUBROUTINE CHANGP(K,I,M) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL PTRCHK(K,I,M) IF(IAND(IBUF(I-1),"174000).EQ.M.OR.M.EQ.1)RETURN CALL INSERT(K) CALL PUTWD(M) CALL INSERT I=I+1 RETURN END #ENDC #NAME CHANGT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CHANGT.FO #ENDS #ENDC SUBROUTINE CHANGT(K,I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL PTRCHK(K,I,M) IF(M.NE.ITXT)RETURN CALL PUTEM(0) II=IPTR+3 CALL PUTWD(0) CALL PUTWD(0) #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JCHT,1,1,K) #IFTF SORNHS ICHT=NOPTS(2)-1 CALL TEXT(I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) #IFF SORNHS CALL PUTEM(0) #IFT SORNHS #IFN VS60 100 IF(IBUF(I).LT.0.AND.IAND(IBUF(I),"176000).NE.ISRA)GOTO 200 #IFF -VS60 100 IF(IBUF(I).LT.0.AND.IAND(IBUF(I),"176000).NE.ISRA.AND. X IAND(IBUF(I),"176000).NE.ISRC)GOTO 200 #ENDC -VS60 IBUF(I)=IBUF(II) IF(II.GE.IPTR)IBUF(I)=0 I=I+1 II=II+1 GOTO 100 200 IPTR=IPWP IPWS=1 #ENDC SORNHS RETURN END #NAME CMPRS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CMPRS.FO #ENDS #ENDC SUBROUTINE CMPRS(IPAS) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST IF(IINS.NE.0)CALL ERROR(16) CALL PUTEM(0) IPASS=0 IF(NOPTS(0).EQ.1)IPASS=IPAS IF(IPASS.EQ.2)GOTO 700 ; ; PASS ONE : ; ; STOPS DISPLAY ; REPLACES POINTERS TO SUBPS IN CALLS WITH SUBP TAGS ; COMPRESSES OUT ALL JUNK ; RESETS STACK AND SETS TAG LIST EMPTY ; LEAVES ALL ADDRESSES MESSED UP ; CALL STOP IR=31 IX=IPTR+1 IPTR=31 100 IF(IR.GT.IX)GOTO 600 I=IBUF(IR) IF(I.NE.IJMP+2)GOTO 200 IR=NWDS(IBUF(IR+1)-IBAS)+1 GOTO 100 #IFN VS60 200 J=IAND(I,"177774) IF((I.EQ.IRET.AND.IBUF(IR+1).EQ.0).OR. X (J.NE.IJSR.AND.J.NE.IJMP))GOTO 500 #IFF 200 IF(IAND(I,"174000).NE.IJMP)GOTO 500 #IFTF IBUF(IPTR)=I IBUF(IPTR+1)=IBUF(IR+1) #IFF IF(I.EQ.IJSR.OR.I.EQ.IJMPR+4) X IBUF(IPTR+1)=IBUF(NWDS(IBUF(IR+1)-IBAS)-1) #IFTF IBUF(IPTR+2)=IBUF(IR+2) #IFT IF(IAND(I,1).EQ.1)IBUF(IPTR+2)=IBUF(NWDS(IBUF(IR+2)-IBAS)-1) #IFTF IBUF(IPTR+3)=IBUF(IR+3) IBUF(IPTR+4)=IBUF(IR+4) IR=IR+5 IPTR=IPTR+5 GOTO 100 500 IR=IR+1 IF(I.EQ.INOP+4)GOTO 100 IBUF(IPTR)=I IPTR=IPTR+1 GOTO 100 600 IPTR=IPTR-2 IF(IPASS.EQ.1)RETURN ; ; PASS TWO: ; ; REPLACES TAGS WITH SUBP ADDRESSES IN CALLS ; REBUILDS STACK ; REBUILDS TAG LIST ; ADJUSTS ADDRESSES IN SUBP HEADERS ; RESTARTS DISPLAY ; VOIDS ALL POINTERS AND ATTACH LIST(S) ; 700 ISTP=1 ILST=0 IEND=0 J=30 1000 J=J+1 2000 IF(J.EQ.IPTR)GOTO 6000 I=IBUF(J) #IFT IF(I.NE.IJSR+1.AND.I.NE.IJMP+1)GOTO 3000 CALL TAGSRH(IBUF(J+2),N) #IFF IF(I.NE.IJSR.AND.I.NE.IJMPR+4)GOTO 3000 CALL TAGSRH(IBUF(J+1),N) #IFTF IF(N.EQ.0)CALL ERROR(6,1) #IFT IBUF(J+1)=IADRS(IBUF(J+5)) IBUF(J+2)=IADRS(IBUF(N+1)) #IFF IBUF(J+1)=IADRS(IBUF(N+1)) #IFTF GOTO 5000 #IFT 3000 IF(I.NE.IRET.OR.IBUF(J+1).NE.0)GOTO 4000 #IFF 3000 IF(I.NE.IRET.AND.I.NE.IRETR)GOTO 4000 #IFTF IF(ISTP.EQ.1)CALL ERROR(6,2) ISTP=ISTP-1 #IFT IBUF(ISTK(ISTP)+1)=IADRS(IBUF(J+2)) #IFF IBUF(ISTK(ISTP)+2)=IADRS(IBUF(J+1)) #IFTF GOTO 1000 #IFT 4000 IF(I.NE.IJSR.AND.I.NE.IJSR+2.AND.I.NE.IJMP)GOTO 1000 IF(ISTP.GT.8)CALL ERROR(6,3) IF(IBUF(J+1).NE.0)IBUF(J+1)=IADRS(IBUF(29)) #IFF 4000 IF(I.NE.IJSRR+4.AND.I.NE.IJMPR)GOTO 1000 IF(ISTP.GT.8)CALL ERROR(6,3) #IFT IBUF(J+2)=IADRS(IBUF(J+5)) #ENDC ISTK(ISTP)=J ISTP=ISTP+1 5000 IF(IEND.NE.0)IBUF(IEND)=J+4 IEND=J+4 IBUF(IEND)=0 IF(ILST.EQ.0)ILST=IEND J=J+5 GOTO 2000 6000 CALL CONT DO 7000 I=1,21 7000 ICHI(I)=-1 IATT(1)=0 #IF SCOPES IATT(43)=0 #ENDC #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JCMP,0) #ENDC SORNHS RETURN END #NAME CONT #IF HOSAT #IFN SATEL SUBROUTINE CONT RETURN END #ENDC #ENDC #NAME COPY #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:COPY.FO #ENDS #ENDC SUBROUTINE COPY(M1,M2) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS MM=IOPTV(M1) CALL TAGSRH(M2,I) IF(I.EQ.0)CALL ERROR(12,M2) CALL PUTEM(0) #IFN VS60 IF(IBUF(I-4).EQ.IJSR+2)CALL ERROR(13,M2) #IFF IF(IBUF(I-2).EQ.0)CALL ERROR(13,M2) #IFTF IF(MM.GT.0)CALL SUBP(M1) 100 I=I+1 #IFT J=IAND(IBUF(I),"177774) IF(J.EQ.IRET.AND.IBUF(I+1).EQ.0)GOTO 200 IF(J.EQ.IJSR.OR.J.EQ.IJMP)CALL ERROR(18) CALL PUTWD(IBUF(I)) #IFF J=IBUF(I) IF(J.EQ.IRET.OR.J.EQ.IRETR)GOTO 200 IF(J.EQ.IJSRR+4.OR.J.EQ.IJMPR.OR.J.EQ.IJSR.OR.J.EQ.IJMPR+4) X CALL ERROR(18) CALL PUTWD(J) #ENDC GOTO 100 200 IF(MM.GT.0)CALL ESUB #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JCOP,1,2,M2,1,2,M1,0) #ENDC SORNHS RETURN END #NAME CVSCAL #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:CVSCAL.FO #ENDS #ENDC SUBROUTINE CVSCAL(M,IC,IV) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF VS60 #IF SORNHS CALL PUTEM(0) 10 CALL TAGSRH(M,I) IF(I.EQ.0)CALL ERROR(12,M) IF(IBUF(I-2).EQ.0)CALL ERROR(13,M) J=IBUF(I+1) IF(IAND(J,"174000).EQ.ISRC)IF(NOPTS(1)-1)300,200,100 CALL POINTR(21,M) CALL INSERT(21) CALL PUTWD(ISRC) CALL INSERT GOTO 10 100 IF(IV.GE.1.AND.IV.LE.15)J=IAND(J,"177740)+IV+"20 200 IF(IOPTV(IC).GE.1.AND.IOPTV(IC).LE.4) X J=IAND(J,"177437)+IC*"40+"140 IBUF(I+1)=J #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JCVS,1,2,M,NOPTS(1),1,IC,0,1,IV,0) #ENDC #ENDC 300 RETURN END #NAME DETACH #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:DETACH.FO #ENDS #ENDC SUBROUTINE DETACH(N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS #IFN SCOPES IATT(1)=0 #IFF NN=1 IF(NOPTS(0).EQ.1.AND.NN.EQ.2)NN=43 IATT(NN)=0 #ENDC #IFF SORNHS CALL BUFTST CALL TOSAT(JDET,0,NOPTS(0),1,N,1) #ENDC SORNHS RETURN END #NAME DISPLY #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:DISPLY.FO #ENDS #ENDC BRAKUP SUBROUTINE DISPLY(N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS NN=IAUT IF(N.NE.0)NN=N IAUT=NN CALL PUTEM(0) #IFN SORNHS CALL TOSAT(JDIS,1,1,N) #ENDC -SORNHS RETURN END #NAME DPTR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:DPTR.FO #ENDS #ENDC SUBROUTINE DPTR(I) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IF SORNHS I=IPTR+26 #IFF SORNHS CALL PUTEM(0) CALL TOSAT(JUSD,0) CALL FRSAT(1,2,I) #ENDC SORNHS RETURN END #NAME DPYNOP #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:DPYNOP.FO #ENDS #ENDC SUBROUTINE DPYNOP(N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST DO 100 I=1,N 100 CALL PUTWD(INOP) CALL PUTEM RETURN END #NAME DPYWD #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:DPYWD.FO #ENDS #ENDC SUBROUTINE DPYWD(I,J) CALL BUFTST CALL PUTWD(I) IF(J.EQ.0)CALL PUTEM RETURN END #NAME ERAS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ERAS.FO #ENDS #ENDC SUBROUTINE ERAS(NAM) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS IF(NOPTS(0).GE.1)GOTO 50 #IFN VS60 IBUF(1)=IJMP #IFF -VS60 IBUF(1)=IJMPR #IFTF -VS60 RETURN 50 CALL TAGSRH(NAM,I) ; ; RETURN IF SUBP IS OPEN OR UNDEFINED ; #IFT -VS60 IF(I.EQ.0.OR.IBUF(I-4).EQ.IJSR+2)RETURN #IFF -VS60 IF(I.EQ.0.OR.IBUF(I-3).EQ.IHLT)RETURN CALL STOP ; ; MAKE CALLS LOOK LIKE SUBP DEFS ; IBUF(I-3)=IBUF(I-2) IF(IBUF(I-4).EQ.IJSR.OR.IBUF(I-4).EQ.IJMPR+4) X IBUF(I-3)=IADRS(IBUF(I+1)) #IFTF -VS60 ; ; ERASE IT ; IBUF(I-4)=IJMP+2 J=I ; ; ELIMINATE SUBP AND ALL NESTED SUBPS FROM LIST ; 100 J=IBUF(J) IF(IPRV.EQ.0)ILST=J IF(IPRV.NE.0)IBUF(IPRV)=J IF(J.NE.0.AND.NWDS(IBUF(I-3)).GT.NWDS0(IBUF(J)))GOTO 100 200 IF(J.EQ.0)GOTO 400 K=IBUF(J) ; ; LOOK FOR ANY CALLS TO SUPB(S) ERASED AND ERASE THEM TOO ; #IFT -VS60 IF(IBUF(NWDS(IBUF(J-2)-IBAS)-4).NE.IJMP+2)GOTO 300 #IFF -VS60 IF(IBUF(J-4).NE.IJSR.AND.IBUF(J-4).NE.IJMPR+4)GOTO 300 IF(IBUF(NWDS(IBUF(J-3)-IBAS)-4).NE.IJMP+2)GOTO 300 ; ; ERASE CALLS TO ERASED SUBP(S) AND ELIMINATE FROM LIST ; #IFTF -VS60 IF(IPRV.EQ.0)ILST=K IF(IPRV.NE.0)IBUF(IPRV)=K IBUF(J-4)=IJMP+2 #IFF -VS60 IBUF(J-3)=IADRS(IBUF(J+1)) #IFTF -VS60 J=K GOTO 200 300 IPRV=J J=K GOTO 200 400 IEND=IPRV #IFF -VS60 CALL CONT #ENDC -VS60 #IFF SORNHS CALL BUFTST CALL TOSAT(JERA,0,NOPTS(0),2,NAM,0) #ENDC SORNHS RETURN END #NAME ERASP #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ERASP.FO #ENDS #ENDC SUBROUTINE ERASP(K) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST CALL PUTEM(0) #IF SORNHS CALL PTRCHK(K,I,M) IF(M.EQ.1)RETURN II=I N=1 #IFN VS60 IF(M.EQ.IAPT.OR.M.EQ.ILOV)N=2 #IFF IF(M.EQ.IAPT.OR.M.EQ.ILOV.OR.M.EQ.IABV)N=2 #IFTF 200 IBUF(II)=INOP+4 II=II+1 N=N-1 #IFT IF(N.GT.0.OR.(M.EQ.ITXT.AND.(IBUF(II).GE.0.OR. X IAND(IBUF(II),"176000).EQ.ISRA)))GOTO 200 #IFF IF(N.GT.0.OR.(M.EQ.ITXT.AND.(IBUF(II).GE.0.OR. X IAND(IBUF(II),"176000).EQ.ISRA.OR. X IAND(IBUF(II),"176000).EQ.ISRC)))GOTO 200 LL=IAND(IBUF(I-2),"174001) #IFTF IF(IAND(IBUF(I-1),"174000).NE.M)GOTO 850 CALL STOP 300 J=IBUF(II) IF(J.GT.0)GOTO 700 #IFT IF(J.NE.IJSR+2.AND.(J.NE.IRET.OR.IBUF(II+1).NE.0))GOTO 500 #IFF IF(J.NE.IRET.AND.J.NE.IRETR.AND.II.NE.IPTR)GOTO 400 #IFTF 350 ICHM(K)=1 GOTO 800 #IFT 500 N=IAND(J,"177774) IF(N.NE.IJSR.AND.N.NE.IJMP)GOTO 600 II=NWDS(IBUF(II+1)-IBAS)+1 GOTO 300 #IFF 400 IF(J.NE.IJSR.AND.J.NE.IJMPR+4)GOTO 500 II=II+5 GOTO 300 500 IF(J.NE.IJSRR+4.AND.J.NE.IJMPR)GOTO 600 IF(IBUF(II+2).EQ.0)GOTO 350 II=NWDS(IBUF(II+2)-IBAS)+1 GOTO 300 #IFTF 600 L=IAND(J,"174000) #IFT IF(L.NE.INOP.AND.L.NE.ISRA.AND.L.NE.ISRB)GOTO 650 #IFF IF(L.NE.INOP.AND.L.NE.ISRA.AND.L.NE.ISRB.AND. X L.NE.ISRC)GOTO 650 #IFTF II=II+1 GOTO 300 650 ICHM(K)=L II=II+1 GOTO 800 700 IBUF(II-1)=IBUF(I-1) #IFF IF(LL.EQ.INOP)IBUF(II-2)=IBUF(I-2) #ENDC 800 IBUF(I-1)=INOP+4 IF(LL.EQ.INOP)IBUF(I-2)=INOP+4 CALL CONT 850 DO 900 J=1,21 IF(ICHI(J).NE.I)GOTO 900 ICHI(J)=II ICHM(J)=ICHM(K) 900 CONTINUE #IFF SORNHS CALL TOSAT(JERP,1,1,K) #ENDC SORNHS RETURN END #NAME ERROR #IF SORNHS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ERROR.FO #ENDS #ENDC SUBROUTINE ERROR(N,IVAR) #IF MSGTXT INTEGER MSGS(12,19) DATA MSGS/ X 'UN','AB','LE',' T','O ','LI','NK',' T','O ','SC','OP','E ', X 'IN','IT',' N','OT',' C','AL','LE','D ',' ',' ',' ',' ', X 'MO','RE',' E','SU','BS',' T','HA','N ','SU','BP','S ',' ', X 'SA','TE','LL','IT','E ','I/','O ','ER','RO','OR',' ',' ', X 'CH','AN','GT',' T','OO',' L','ON','G ',' ',' ',' ',' ', X 'SY','ST','EM',' F','AU','LT',' ',' ',' ',' ',' ',' ', X ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', X 'DI','SP','LA','Y ','FI','LE',' F','UL','L ',' ',' ',' ', X 'FI','LE',' T','OO',' B','IG',' ',' ',' ',' ',' ',' ', X 'IS',' I','N ','US','E ',' ',' ',' ',' ',' ',' ',' ', X 'MO','RE',' T','HA','N ',' 8',' N','ES','TE','D ','SU','BP', X 'IS',' N','OT',' A',' S','UB','PI','CT','UR','E ',' ',' ', X 'IS',' S','TI','LL',' O','PE','N ',' ',' ',' ',' ',' ', X 'IL','LE','GA','L ','IN','CR','EM','EN','T ',' ',' ',' ', X 'IL','LE','GA','L/','UN','DE','F ','PO','IN','TE','R ',' ', X 'IL','LE','GA','L ','DU','RI','NG',' I','NS','ER','T ',' ', X 'TO','O ','FE','W ','AR','GS',' ',' ',' ',' ',' ',' ', X 'CA','N''','T ','CO','PY',' N','ES','TE','D ','SU','BP','S ', X 'VE','RS','IO','N ','MI','SM','AT','CH',' ',' ',' ',' '/ #IFF MSGTXT LOGICAL*1 ICB(10) #IFTF IF(NOPTS(1).EQ.1)GOTO 100 #IFT CALL TTW(24,MSGS(1,N)) #IFF CALL ITOA(N,3,ICB) CALL TTW(0,' ') CALL TTW(0,'ERROR #',3,ICB) #IFTF CALL EREXIT CALL TRAP0 #IFT 100 CALL ITOA(IVAR,7,ICB) CALL TTW(7,ICB,0,' ',24,MSGS(1,N)) #IFF 100 CALL ITOA(N,3,ICB,IVAR,7,ICB(4)) CALL TTW(0,' ') CALL TTW(0,'ERROR #',10,ICB) #ENDC CALL EREXIT CALL TRAP0 END #ENDC #NAME ESUB #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ESUB.FO #ENDS #ENDC SUBROUTINE ESUB(NAM) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST IF(IINS.NE.0)CALL ERROR(16) IF(ISTP.EQ.1)CALL ERROR(3) ISTP=ISTP-1 I=ISTK(ISTP) #IFN VS60 CALL PUTWD(IRET) CALL PUTWD(0) #IFF -VS60 J=IRET IF(NOPTS(0).EQ.1)J=IRETR CALL PUTWD(J) #IFTF -VS60 CALL PUTEM(0) CALL STOP #IFT -VS60 J=IBUF(I+1) IBUF(I)=IJSR IBUF(I+1)=IADRS(IBUF(IPTR)) IF(J.EQ.0)IBUF(I)=IJMP #IFF -VS60 IBUF(I+1)=IJMP IBUF(I+2)=IADRS(IBUF(IPTR)) #ENDC -VS60 CALL CONT MOLD=2 #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JESB,0,NOPTS(0),2,NAM,0) #ENDC SORNHS RETURN END #NAME FIGR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:FIGR.FO #ENDS #ENDC SUBROUTINE FIGR(A,N,NAM,L,I,F,T) #IF INTEGR INTEGER A(N) #IFF INTEGR DIMENSION A(N) #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL SUBP(NAM) CALL MODE(ILOV,NOPTS(3),L,I,F,T) DO 100 J=1,N,2 #IFT INTEGR CALL MVECT(A(J),IDX,IXS) CALL MVECT(A(J+1),IDY,IYS) #IFF INTEGR CALL MVECT(INTR(A(J)*XSCF),IDX,IXS) CALL MVECT(INTR(A(J+1)*YSCF),IDY,IYS) #ENDC INTEGR CALL PUTWD(IVIS+IXS+IDX) 100 CALL PUTWD(IYS+IDY) CALL ESUB RETURN END #NAME FLASH #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:FLASH.FO #ENDS #ENDC SUBROUTINE FLASH(K,F) INTEGER FF,F #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL CHANGP(K,I,M) FF=1 IF(NOPTS(1).EQ.1)FF=F IF(M.NE.1)IBUF(I-1)=IAND(IBUF(I-1),"177747)+"24+ISIGN(4,FF) #IFF SORNHS CALL BUFTST CALL TOSAT(JFLA,1,1,K,NOPTS(1),1,F,1) #ENDC SORNHS RETURN END #NAME FREE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:FREE.FO #ENDS #ENDC SUBROUTINE FREE #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL UNLINK IFLG=0 #IFF SORNHS CALL BUFTST CALL TOSAT(JFRE,0) IFLG=0 #ENDC SORNHS RETURN END #NAME GET #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:GET.FO #ENDS #ENDC SUBROUTINE GET(K,X,Y) #IF INTEGR INTEGER X,Y #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS X=0 Y=0 CALL PTRCHK(K,I,M) CALL UNMAKV(IBUF(I),J) CALL UNMAKV(IBUF(I+1),L) IF(M.NE.ILOV)GOTO 100 #IF INTEGR 50 X=J Y=L #IFF INTEGR 50 X=FLOAT(J)/XSCF Y=FLOAT(L)/YSCF #IFTF INTEGR RETURN 100 IF(M.NE.ISHV.AND.M.NE.IRPT)GOTO 200 CALL UNMKSV(IBUF(I),J,L) GOTO 50 200 IF(M.NE.IGRY)GOTO 300 #IFT INTEGR Y=J #IFF INTEGR Y=(FLOAT(J)+YBAS)/YSCF #IFTF INTEGR RETURN 300 IF(M.NE.IGRX)GOTO 400 #IFT INTEGR X=J #IFF INTEGR X=(FLOAT(J)+XBAS)/XSCF #IFTF INTEGR RETURN #IFN VS60 400 IF(M.NE.IAPT)RETURN #IFF -VS60 400 IF(M.NE.IAPT.AND.M.NE.IABV)RETURN #ENDC -VS60 #IFT INTEGR X=J Y=L #IFF INTEGR X=(FLOAT(J)+XBAS)/XSCF Y=(FLOAT(L)+YBAS)/YSCF #ENDC INTEGR #IFF SORNHS CALL BUFTST CALL TOSAT(JGET,1,1,K) #IF INTEGR CALL FRSAT(2,2,X,2,Y) #IFF INTEGR CALL FRSAT(2,4,X,4,Y) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME GRATTN #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:GRATTN.FO #ENDS #ENDC SUBROUTINE GRATTN(IW,IR,ID1,ID2,ID3) #IFN RT11 #IF HOSAT #IF SATEL #ENDC SATEL #IFF HOSAT INTEGER IEFN(3) #ENDC HOSAT #ENDC -RT11 #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IFN RT11 #IF HOSAT #IF SATEL #ENDC SATEL #IFF HOSAT DATA IEFN/11,12,10/ #ENDC HOSAT #ENDC -RT11 CALL BUFTST #IF RT11 10 DO 200 IR=1,NOPTS(2) CALL ARG(J,IR,1,2,ID1,ID2,ID3) GOTO (200,110,120,130),J+1 110 IF(LPFLAG.NE.0.AND.NAME(1).GT.0)RETURN GOTO 200 #IF LK11 120 CALL PBREAD(II) IF(IPBF.NE.II)RETURN GOTO 200 #IFF LK11 120 GOTO 200 #ENDC LK11 130 CALL KBG(J,1) IF(J.NE.0)RETURN 200 CONTINUE IF(IW.NE.0)GOTO 10 IR=0 RETURN #IFF RT11 #IF HOSAT #IF SATEL 10 DO 200 IR=1,NOPTS(2) CALL ARG(J,IR,1,2,ID1,ID2,ID3) GOTO (200,110,120,130),J+1 110 IF(LPFLAG.NE.0.AND.NAME(1).GT.0)RETURN GOTO 200 #IF LK11 120 CALL PBREAD(II) IF(IPBF.NE.II)RETURN GOTO 200 #IFF LK11 120 GOTO 200 #ENDC LK11 130 CALL KBG(J,1) IF(J.NE.0)RETURN 200 CONTINUE IF(IW.NE.0)GOTO 10 IR=0 RETURN #IFF SATEL CALL TOSAT(JGRA,1,1,IW,NOPTS(2),1,ID1,0,1,ID2,0,1,ID3,0) CALL FRSAT(1,1,IR) RETURN #ENDC SATEL #IFF HOSAT CALL KBG IF(IW.NE.0)CALL WFLOR(10,11,12) DO 200 IR=1,NOPTS(2) CALL ARG(J,IR,1,2,ID1,ID2,ID3) CALL READEF(IEFN(J),I) IF(I.NE.0)GOTO 300 200 CONTINUE IR=0 J=0 300 IF(J.NE.3)CALL KBG(J,0) RETURN #ENDC HOSAT #ENDC RT11 END #NAME GRID #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:GRID.FO #ENDS #ENDC SUBROUTINE GRID(GX,GY,N) #IF INTEGR INTEGER X,Y,XX,YY,GX,GY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST #IFN SCOPES CALL TRAKXY(X,Y) #IFF CALL TRAKXY(X,Y,N) #IFTF #IF INTEGR XX=(X+GX/2)/GX*GX YY=(Y+GY/2)/GY*GY #IFF INTEGR XX=INT(X/GX+.5)*GX YY=INT(Y/GY+.5)*GY #ENDC INTEGR #IFT CALL TRAK(XX,YY) #IFF CALL TRAK(XX,YY,N) #IFTF #IF INTEGR IDX=XX-X IDY=YY-Y #IFF INTEGR IDX=(XX-X)/XSCF IDY=(YY-Y)/YSCF #ENDC INTEGR #IFT DO 100 J=1,39,2 #IFF NN=1 IF(NOPTS(2).EQ.1.AND.N.EQ.2)NN=43 DO 100 J=NN,NN+38,2 #IFTF IF(IATT(J).EQ.0)GOTO 150 I=NWDS(IATT(J)-IBAS)+1 #IFT II=IAND(IBUF(I),IINT) #IFF II=IAND(IBUF(I),IINT+IOFF) #IFTF CALL UNMAKV(IBUF(I),I1) CALL UNMAKV(IBUF(I+1),I2) I1=I1+ISIGN(1,IATT(J+1))*IDX I2=I2+ISIGN(1,IATT(J+1))*IDY IF(IATT(J+1).NE.0)GOTO 50 CALL MPNT(I1,I1) CALL MPNT(I2,I2) IXS=0 IYS=0 GOTO 90 50 CALL MVECT(I1,I1,IXS) CALL MVECT(I2,I2,IYS) 90 IBUF(I)=II+IXS+I1 IBUF(I+1)=IYS+I2 100 CONTINUE #IFT 150 IATT(1)=0 #IFF 150 IATT(NN)=0 #ENDC #IFF SORNHS CALL BUFTST #IF INTEGR CALL TOSAT(JGRD,2,2,GX,2,GY,NOPTS(2),1,N,1) #IFF INTEGR CALL TOSAT(JGRD,2,4,GX,4,GY,NOPTS(2),1,N,1) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME INIT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:INIT.FO #ENDS #ENDC BRAKUP SUBROUTINE INIT(N) #IF SORNHS EXTERNAL GRWAIT #IFN SCOPES INTEGER ITRAK(32),ISTUFF(33),INIT1(33),INIT2(110),IHEDR(26) #IFF -SCOPES INTEGER ITRAK(65),ISTUFF(33),INIT1(33),INIT2(152),IHEDR(26) #ENDC -SCOPES EQUIVALENCE (IHEDR,LOCK),(INIT1,ITXT),(INIT2,IINS) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS DATA ISTUFF/"100000,"104000,"110000,"114000,"120000,"124000, #IFN VS60 #IF RT11 X "130000,"134000,"140000,"144000,"150000,"154000,"160000, #IFF RT11 #IF SATEL X "130000,"134000,"140000,"144000,"150000,"154000,"160000, #IFF SATEL X "130000,"134000,"140000,"144000,"150000,"154000,"173500, #ENDC SATEL #ENDC RT11 X "161000,"173400,"163000,"164000,"173400,"166000,"167000, #IFF -VS60 X "130000,"134000,"140000,"144000,"150000,"154000,"160000, X "161000,"162000,"163000,"164000,"165000,"166000,"167000, #IFTF -VS60 #IFN SCOPES X "170000,"173400,"174000,"176000,"40000,"10000,31,1,1,1,2,1,-1/ #IFF -SCOPES X "170000,"173400,"174000,"176000,"40000,"10000,64,1,1,1,2,1,-1/ #ENDC -SCOPES #IFT -VS60 #IF RT11 DATA ITRAK/"160000,0,0,-1,0,"170200,"117524,0,0, #IFF RT11 #IF SATEL DATA ITRAK/"160000,0,0,-1,0,"170200,"117524,0,0, #IFF SATEL DATA ITRAK/"173500,0,0,-1,0,"170200,"117524,0,0, #ENDC SATEL #ENDC RT11 #IFF -VS60 DATA ITRAK/"161000,"160000,0,-1,0,"170200,"117524,0,0, #IFTF -VS60 X "104140,"50416,"40134,"65124,"67000,"65024,"40034, X "45024,"47000,"45124,"30516,"70416,"10516,"70516, X "10416,"50516,"116724,0,0, #IFT -VS60 X "173400,0,"173400,0/ #IFF -VS60 #IFN SCOPES X "166000,0,"173400,0/ #IFF -SCOPES X "166000,0,"161000,"160000,0,-1,0,"170200,"117424,0,0, X "164240,"164760, X "104140,"50416,"40134,"65124,"67000,"65024,"40034, X "45024,"47000,"45124,"30516,"70416,"10516,"70516, X "10416,"50516,"116724,0,0, X "166000,0,0,"173400,0/ #ENDC -SCOPES #IFTF -VS60 #IF RT11 IF(IFLG.EQ.1)GOTO 6 WRITE(5,5) 5 FORMAT(' ') I=NOPTS(1) GOTO 7 6 CALL STOP #IFF RT11 IF(IFLG.EQ.1)CALL STOP IF(IFLG.NE.1)I=NOPTS(1) #ENDC RT11 7 DO 10 I=1,33 10 INIT1(I)=ISTUFF(I) DO 15 I=1,26 15 IHEDR(I)=0 #IFN SCOPES DO 20 I=1,110 #IFF -SCOPES DO 20 I=1,152 #IFTF -SCOPES 20 INIT2(I)=0 #IFT -SCOPES DO 50 I=1,32 #IFF -SCOPES DO 50 I=1,65 #ENDC -SCOPES 50 IBUF(I)=ITRAK(I) IBAS=IADRS(IBUF) #IFT -VS60 IBUF(2)=IADRS(IBUF(31)) IBUF(3)=IADRS(IBUF(6)) #IFF -VS60 #IFN SCOPES IBUF(3)=IADRS(IBUF(31)) #IFF -SCOPES IBUF(3)=IADRS(IBUF(64)) IBUF(33)=IADRS(IBUF(64)) #ENDC -SCOPES #ENDC -VS60 #IF LK11 CALL PBREAD(IPBF) #ENDC LK11 IF(NOPTS(0).EQ.1)ISIZ=N-28 CALL NOSC IF(IFLG.NE.1)GOTO 100 CALL CONT RETURN 100 CALL LINK(IHEDR,N,IFLG) IF(IFLG.NE.1)CALL ERROR(1) #IFN SATEL CALL USEREX(GRWAIT) #ENDC -SATEL #IFF SORNHS INTEGER ISTUFF(75),INIT1(75) EQUIVALENCE (IFLG,INIT1) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS DATA ISTUFF/1,"100000,"104000,"110000,"114000,"120000,"124000, X "130000,"134000,"140000,"144000,"150000,"154000,"160000, #IFN VS60 X "161000,"173400,"163000,"164000,"173400,"166000,"167000, #IFF -VS60 X "161000,"162000,"163000,"164000,"165000,"166000,"167000, #IFTF -VS60 #SUBS 'MAXR'MAXR X "170000,"173400,"174000,"176000,"40000,"10000,MAXR,2,0, #ENDS X 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22, X 23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40, X 1,-1,0,0,1/ #ENDC -VS60 DO 10 I=1,75 10 INIT1(I)=ISTUFF(I) CALL VERSON(I) CALL TOSAT(JINI,1,2,I) #IFN INTEGR XSCF=1. XBAS=0. YSCF=1. YBAS=0. #ENDC -INTEGR #ENDC SORNHS RETURN END #NAME INSERT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:INSERT.FO #ENDS #ENDC SUBROUTINE INSERT(K) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST CALL PUTEM(0) #IF SORNHS CALL STOP IF(NOPTS(0).EQ.0)GOTO 600 IF(IINS.NE.0)CALL ERROR(16) MOLDS=MOLD CALL PTRCHK(K,I,MOLD) IF(IAND(IBUF(I-1),"174000).NE.MOLD)GOTO 20 I=I-1 MOLD=6 20 IREL=ISIZ-IPTR-1 IF(IREL.LT.2)CALL ERROR(8) 50 DO 100 J=1,21 100 IF(ICHI(J).GE.I)ICHI(J)=ICHI(J)+IREL DO 200 J=1,ISTP 200 IF(ISTK(J).GE.I)ISTK(J)=ISTK(J)+IREL IF(ILST.GE.I)ILST=ILST+IREL IF(IEND.GE.I)IEND=IEND+IREL NWD=NWDS0(IBUF(I)) #IF SCOPES DO 250 J=1,81,2 #IFF DO 250 J=1,39,2 #ENDC 250 IF(NWDS(IATT(J)).GE.NWD.AND.IATT(J).NE.0) X CALL IADD(IATT(J),IREL,IREL) J=30 300 J=J+1 IF(J.GE.IPTR)IF(IINS)900,400,900 M=IBUF(J) #IFN VS60 L=IAND(M,"177774) IF((M.EQ.IRET.AND.IBUF(J+1).EQ.0).OR.(L.NE.IJSR.AND.L.NE.IJMP)) X GOTO 300 IF(NWDS(IBUF(J+1)).GE.NWD.AND.IBUF(J+1).NE.0) X CALL IADD(IBUF(J+1),IREL,IREL) IF(NWDS(IBUF(J+2)).GE.NWD)CALL IADD(IBUF(J+2),IREL,IREL) #IFF IF(IAND(M,"174000).NE.IJMP)GOTO 300 IF((M.EQ.IJSRR+4.OR.M.EQ.IJMPR).AND.IBUF(J+2).NE.0.AND. X NWDS(IBUF(J+2)).GE.NWD)CALL IADD(IBUF(J+2),IREL,IREL) IF((M.EQ.IJSR.OR.M.EQ.IJMPR+4.OR.M.EQ.IJMP+2).AND. X NWDS(IBUF(J+1)).GE.NWD)CALL IADD(IBUF(J+1),IREL,IREL) #ENDC J=J+4 IF(IBUF(J).GE.I)IBUF(J)=IBUF(J)+IREL GOTO 300 400 DO 500 J=1,IPTR+2-I 500 IBUF(ISIZ+1-J)=IBUF(IPTR+2-J) IINS=I+IREL IBUF(I)=IJMP IBUF(I+1)=IADRS(IBUF(IINS)) IPTR=I CALL CONT RETURN 600 IF(IINS.EQ.0)RETURN IREL=IPTR-IINS I=IINS DO 800 J=IINS,ISIZ IBUF(IPTR)=IBUF(J) 800 IPTR=IPTR+1 IPTR=IPTR-2 GOTO 50 900 IINS=0 CALL CONT MOLD=MOLDS #IFF SORNHS CALL TOSAT(JINS,0,NOPTS(0),1,K,0) #ENDC SORNHS RETURN END #NAME INTENS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:INTENS.FO #ENDS #ENDC SUBROUTINE INTENS(K,I) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL PTRCHK(K,II,M) IF(M.EQ.1)RETURN IN=10 IF(NOPTS(1).EQ.1)IN=I IF(M.NE.ITXT) X IBUF(II)=IAND(IBUF(II),"37777)+"20000+ISIGN("20000,IN) IN=IABS(IN) IF(IN.LT.1.OR.IN.GT.8)RETURN CALL CHANGP(K,II,M) IBUF(II-1)=IAND(IBUF(II-1),"174177)+"1600+"200*IN #IFF SORNHS CALL BUFTST CALL TOSAT(JINT,1,1,K,NOPTS(1),1,I,10) #ENDC SORNHS RETURN END #NAME INTR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:INTR.FO #ENDS #ENDC BRAKUP FUNCTION INTR(X) #IF INTEGR INTEGER X INTR=X #IFF INTEGR INTR=INT(X+SIGN(.5,X)) #ENDC INTEGR RETURN END #NAME KBC #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:KBC.FO #ENDS #ENDC BRAKUP SUBROUTINE KBC(IC) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL KBG(IC) #IFF SORNHS CALL TOSAT(JKBC,0) CALL FRSAT(1,1,IC) #ENDC SORNHS RETURN END #NAME LINTYP #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:LINTYP.FO #ENDS #ENDC SUBROUTINE LINTYP(K,T) INTEGER T #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS IF(T.LT.1.OR.T.GT.4)RETURN CALL CHANGP(K,I,M) IF(M.NE.1)IBUF(I-1)=IAND(IBUF(I-1),"177770)+T+3 #IFF SORNHS CALL BUFTST CALL TOSAT(JLTY,2,1,K,1,T) #ENDC SORNHS RETURN END #NAME LPEN #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:LPEN.FO #ENDS #ENDC BRAKUP SUBROUTINE LPEN(IHIT,ITAG,RX,RY,IP,IA,IM,IT1,IT2) #IF INTEGR INTEGER RX,RY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST LOCK=1 IHIT=LPFLAG IF(IHIT.EQ.0)GOTO 600 ITAG=NAME(1) GOTO (600,500,400,300,200,100,40,20),NOPTS(2)+1 20 CALL CSTORE(IT2,ITIP2,1) 40 CALL CSTORE(IT1,ITIP1,1) 100 CALL CSTORE(IM,IAND(IDSR2,"100)/"100+1,1) 200 CALL CSTORE(IA,NAME(2),8) 300 CALL TAGSRH(ITAG,I) IF(IADRS(IP).EQ.-1.OR.I.EQ.0)GOTO 400 CALL POINTR(21,ITAG) IP=1 350 CALL ADVANC(21) IF(NWDS0(IBUF(ICHI(21))).GE.NWDS(IDPC))GOTO 400 IP=IP+1 GOTO 350 #IF INTEGR 400 CALL CSTORE(RY,IAND(IYO,"170000)/4+IAND(IY,"1777) X -ISIGN(IAND(IYO,"7777),-IAND(IXYOS,"40000)),1) 500 CALL CSTORE(RX,IAND(IXO,"170000)/4+IAND(IX,"1777) X -ISIGN(IAND(IXO,"7777),IXYOS),1) #IFF INTEGR 400 CALL CSTORE(RY,(IAND(IYO,"170000)/4+IAND(IY,"1777) X -ISIGN(IAND(IYO,"7777),-IAND(IXYOS,"40000))+YBAS)/YSCF,2) 500 CALL CSTORE(RX,(IAND(IXO,"170000)/4+IAND(IX,"1777) X -ISIGN(IAND(IXO,"7777),IXYOS)+XBAS)/XSCF,2) #ENDC INTEGR 600 LPFLAG=0 LOCK=0 #IFF SORNHS CALL BUFTST CALL TOSAT(JLPE,0) #IF INTEGR CALL FRSAT(NOPTS(2)+2,1,IHIT,2,ITAG,2,RX,2,RY,2,IP,16,IA,1,IM, X 1,IT1,1,IT2) #IFF INTEGR CALL FRSAT(NOPTS(2)+2,1,IHIT,2,ITAG,4,RX,4,RY,2,IP,16,IA,1,IM, X 1,IT1,1,IT2) #ENDC INTEGR #ENDC SORNHS #IFN RT11 #IF HOSAT #IF SATEL #ENDC SATEL #IFF HOSAT CALL CLREF(11) #ENDC HOSAT #ENDC -RT11 RETURN END #NAME LVECT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:LVECT.FO #ENDS #ENDC SUBROUTINE LVECT(RDX,RDY,L,I,F,T) #IF INTEGR INTEGER RDX,RDY #ENDC INTEGR CALL VECTS(RDX,RDY,0,NOPTS(2),L,I,F,T) RETURN END #NAME MENU #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:MENU.FO #ENDS #ENDC SUBROUTINE MENU(X0,Y0,DY,NAM,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10) #IF INTEGR INTEGER X0,Y0,DY,XX,YY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS NO=NOPTS(4) YY=Y0 IF(IADRS(X0).NE.-1)GOTO 5 #IF VS60 #IF INTEGR XX=0 #IFF INTEGR XX=XBAS/XSCF #ENDC INTEGR CALL BUFTST CALL PUTWD(ISRA+3) #IFF VS60 #IF INTEGR XX=850 #IFF INTEGR XX=(850.+XBAS)/XSCF #ENDC INTEGR #IFTF VS60 GOTO 6 5 XX=X0 6 DO 250 IT=1,NO CALL APNT(XX,YY,1,-4,-1,1) CALL SUBP(NAM+IT-1) CALL MODE(ITXT,0) DO 100 I=1,10000 CALL ARG(J,IT,I,1,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10) IF(J.EQ.0)GOTO 200 100 CALL PUTCHR(J) 200 CALL PUTCHR(0) ICHR=-1 CALL PUTEM CALL ESUB YY=YY+DY 250 CONTINUE #IFT IF(IADRS(X0).EQ.-1)CALL PUTWD(ISRA+2) #ENDC #IF INTEGR CALL RPNT(0,0,-1,-4) #IFF INTEGR CALL RPNT(0.,0.,-1,-4) #ENDC INTEGR RETURN END #NAME MODE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:MODE.FO #ENDS #ENDC SUBROUTINE MODE(MOD,N,L,I,F,T) INTEGER F,T #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS MNEW=MOD IVIS=IINT GOTO (500,400,300,200,100),N+1 100 IF(IOPTV(T).GE.1.AND.IOPTV(T).LE.4)MNEW=MNEW+T+3 200 IF(IOPTV(F).NE.0)MNEW=MNEW+"24+ISIGN("4,F) 300 IF(IOPTV(I))320,400,340 320 IVIS=0 340 IF(IABS(I).LE.8)MNEW=MNEW+"1600+"200*IABS(I) 400 IF(IOPTV(L).NE.0)MNEW=MNEW+"120+ISIGN("20,L) #IF SORNHS 500 IF(MOLD.NE.MNEW)CALL PUTWD(MNEW) MOLD=MNEW #IFF 500 CALL PUTWD(MNEW) #ENDC RETURN END #NAME NMBR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:NMBR.FO #ENDS #ENDC SUBROUTINE NMBR(NAM,VAR,N,FMT) #IFN SATEL LOGICAL*1 FMT0(40),BUFR(41),FMT(40) INTEGER FMTX(20) #IF INTEGR INTEGER VAR #ENDC INTEGR EQUIVALENCE (FMT0,FMTX) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF INTEGR DATA N0/6/ DATA FMTX/'(I','6)',18*0/ #IFF INTEGR DATA N0/16/ DATA FMTX/'(F','16','.8',') ',16*0/ #ENDC INTEGR IF(NOPTS(2).EQ.0)GOTO 200 DO 100 I=1,40 100 FMT0(I)=FMT(I) N0=N 200 ENCODE(40,FMT0,BUFR)VAR BUFR(N0+1)=0 #IFN HOSAT CALL TAGSRH(NAM,I) #IFF -HOSAT CALL BUFTST CALL TOSAT(JTAG,1,2,NAM) CALL FRSAT(1,2,I) #ENDC -HOSAT IF(I.NE.0)GOTO 500 CALL SUBP(NAM) CALL TEXT(BUFR) CALL ESUB RETURN 500 CALL POINTR(21,NAM) CALL CHANGT(21,BUFR) #ENDC -SATEL RETURN END #NAME NOSC #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:NOSC.FO #ENDS #ENDC SUBROUTINE NOSC #IFN INTEGR CALL SCAL(0.,0.,1023.,1023.) #ENDC -INTEGR RETURN END #NAME OFF #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:OFF.FO #ENDS #ENDC SUBROUTINE OFF(NAM) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL TAGSRH(NAM,I) IF(I.EQ.0)RETURN #IFN VS60 IF(IBUF(I-4).NE.IJSR+2)GOTO 100 CALL STOP IBUF(I-3)=0 CALL CONT RETURN 100 IF(IBUF(I-4).EQ.IJSR)IBUF(I-4)=IJMP IF(IBUF(I-4).EQ.IJSR+1)IBUF(I-4)=IJMP+1 #IFF IF(IBUF(I-4).EQ.IJSR)IBUF(I-4)=IJMPR+4 IF(IBUF(I-4).EQ.IJSRR+4)IBUF(I-4)=IJMPR #ENDC #IFF SORNHS CALL BUFTST CALL TOSAT(JOFF,1,2,NAM) #ENDC SORNHS RETURN END #NAME ON #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ON.FO #ENDS #ENDC SUBROUTINE ON(NAM) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL TAGSRH(NAM,I) IF(I.EQ.0)RETURN #IFN VS60 IF(IBUF(I-4).EQ.IJSR+2)IBUF(I-3)=IADRS(IBUF(29)) IF(IBUF(I-4).EQ.IJMP)IBUF(I-4)=IJSR IF(IBUF(I-4).EQ.IJMP+1)IBUF(I-4)=IJSR+1 #IFF IF(IBUF(I-4).EQ.IJMPR)IBUF(I-4)=IJSRR+4 IF(IBUF(I-4).EQ.IJMPR+4)IBUF(I-4)=IJSR #ENDC #IFF SORNHS CALL BUFTST CALL TOSAT(JON,1,2,NAM) #ENDC SORNHS RETURN END #NAME PBH #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PBH.FO #ENDS #ENDC SUBROUTINE PBH(IH,FLAGS) LOGICAL*1 FLAGS(16),TEMP(16) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF LK11 CALL BUFTST #IF SORNHS CALL PBREAD(INEW) #IFF SORNHS CALL TOSAT(JPBS,0) CALL FRSAT(2,2,IPBF,2,INEW) #IFTF SORNHS CALL BTL(IPBF,FLAGS) CALL BTL(INEW,TEMP) DO 100 I=1,16 FLAGS(I)=.NOT.(TEMP(I).EQV.FLAGS(I)) 100 CONTINUE CALL LTB(FLAGS,IH) #IFT SORNHS IPBF=INEW #ENDC SORNHS #IFN RT11 #IF HOSAT #IF SATEL #ENDC SATEL #IFF HOSAT CALL CLREF(12) #ENDC HOSAT #ENDC -RT11 #ENDC LK11 RETURN END #NAME PBL #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PBL.FO #ENDS #ENDC SUBROUTINE PBL(OFFS,ONS) LOGICAL*1 OFFS(16),ONS(16) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF LK11 CALL BUFTST IOFF=-1 ION=-1 IF(NOPTS(0).EQ.0)GOTO 100 CALL LTB(OFFS,IOFF) CALL LTB(ONS,ION) #IF SORNHS 100 CALL PBWRIT(IOFF,ION) #IFF SORNHS 100 CALL TOSAT(JPBL,2,2,IOFF,2,ION) #ENDC SORNHS #ENDC LK11 RETURN END #NAME PBS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PBS.FO #ENDS #ENDC SUBROUTINE PBS(FLAGS) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF LK11 CALL BUFTST #IF SORNHS CALL PBREAD(IPBF) #IFF SORNHS CALL TOSAT(JPBS,0) CALL FRSAT(1,2,IPBF,2,I) #ENDC SORNHS CALL BTL(IPBF,FLAGS) #IFN RT11 #IF HOSAT #IF SATEL #ENDC SATEL #IFF HOSAT CALL CLREF(12) #ENDC HOSAT #ENDC -RT11 #ENDC LK11 RETURN END #NAME POINTR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:POINTR.FO #ENDS #ENDC SUBROUTINE POINTR(K,M,J) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL TAGSRH(M,I) CALL PUTEM(0) #IFN VS60 IF(I.EQ.0.OR.IBUF(I-4).EQ.IJMP+1.OR.IBUF(I-4).EQ.IJSR+1) X CALL ERROR(12,M) #IFF IF(I.EQ.0.OR.IBUF(I-4).EQ.IJSR.OR.IBUF(I-4).EQ.IJMPR+4) X CALL ERROR(12,M) #ENDC IF(K.LT.1.OR.K.GT.21)CALL ERROR(15,K) ICHI(K)=I ICHM(K)=0 JJ=1 IF(NOPTS(2).EQ.1)JJ=MAX0(JJ,J) CALL ADVANC(K,JJ) #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JPTR,2,1,K,2,M,NOPTS(2),2,J,1) #ENDC SORNHS RETURN END #NAME PTRCHK #IF SORNHS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PTRCHK.FO #ENDS #ENDC SUBROUTINE PTRCHK(K,I,M) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST I=0 IF(K.GE.1.AND.K.LE.21)I=ICHI(K) IF(I.LE.0)CALL ERROR(15,K) M=ICHM(K) RETURN END #ENDC #NAME PUTCHR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PUTCHR.FO #ENDS #ENDC SUBROUTINE PUTCHR(IC) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS IF(ICHR.NE.-1)GOTO 100 ICHR=IC RETURN 100 CALL PUTWD(ICHR+IC*256) ICHR=-1 RETURN END #NAME PUTEM #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PUTEM.FO #ENDS #ENDC SUBROUTINE PUTEM(I) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS IF(IAUT.LT.0.AND.NOPTS(0).EQ.0)RETURN CALL STOP IBUF(IPTR)=IHLT IBUF(IPTR+1)=0 IF(IINS.EQ.0)GOTO 50 IBUF(IPTR)=IJMP IBUF(IPTR+1)=IADRS(IBUF(IINS)) 50 GOTO (300,200,100),IPWS 100 IBUF(IPWP+1)=IPW2 200 IBUF(IPWP)=IPW1 IPWS=1 300 CALL CONT #IFF SORNHS IF(ISCNT.EQ.1.OR.(IAUT.LT.0.AND.NOPTS(0).EQ.0))RETURN ISBUF(1)=ISCNT*256+JNWD CALL TOOSAT(ISCNT*2,ISBUF) ISCNT=1 #ENDC SORNHS RETURN END #NAME PUTWD #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:PUTWD.FO #ENDS #ENDC SUBROUTINE PUTWD(I) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS IF(IFLG.NE.1)CALL ERROR(2) IF(IPTR.GE.ISIZ.OR.(IPTR.GE.IINS.AND.IINS.NE.0))CALL ERROR(8) GOTO (100,200,300),IPWS 100 IPW1=I IPWS=2 IPWP=IPTR IPTR=IPTR+1 RETURN 200 IPW2=I IPWS=3 IPTR=IPTR+1 RETURN 300 IBUF(IPTR)=I IPTR=IPTR+1 #IFF IF(ISCNT.LT.ISSIZ)GOTO 100 ISBUF(1)=ISCNT*256+JNWD CALL TOOSAT(ISCNT*2,ISBUF) ISCNT=1 100 ISCNT=ISCNT+1 ISBUF(ISCNT)=I #ENDC RETURN END #NAME READWR SUBROUTINE READWR(IFUN,ICHAN,IBLK,NWDS,IBUF,IORET) #IF LOCSAV COMMON/IOX/KUNIT(8),KSTRT(8),KLEN(8),KDIR(512) IORET=-10 IF(IBLK.LT.0.OR.IBLK.GT.KLEN(ICHAN))RETURN CALL DX(KUNIT(ICHAN),IFUN,KSTRT(ICHAN)+IBLK,NWDS,IBUF,IORET) 100 IF(IORET.EQ.0)GOTO 100 #IFF LOCSAV IORET=-11 #ENDC LOCSAV RETURN END #NAME RPNT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:RPNT.FO #ENDS #ENDC SUBROUTINE RPNT(RDX,RDY,L,I,F,T) #IF INTEGR INTEGER RDX,RDY #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IFT INTEGR CALL MVECT(RDX,IDX,IXS) CALL MVECT(RDY,IDY,IYS) #IFF INTEGR CALL MVECT(INTR(RDX*XSCF),IDX,IXS) CALL MVECT(INTR(RDY*YSCF),IDY,IYS) #ENDC INTEGR CALL MODE(IRPT,NOPTS(2),L,I,F,T) CALL PUTWD(IVIS+IXS+MIN0(63,IDX)*128+IYS/128+MIN0(63,IDY)) CALL PUTEM RETURN END #NAME RSTR #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:RSTR.FO #ENDS #ENDC SUBROUTINE RSTR(FNAME) LOGICAL*1 FNAME(30) #IFN HOSAT #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL CMPRS(1) CALL ASSIGN(LUNS,FNAME) DEFINE FILE LUNS(64,256,U,IBLK) I=IPTR READ(LUNS'1)J,III,(II,K=1,254) CALL VERSON(II) IF(IAND(II-III,"3).NE.0)CALL ERROR(19) IPTR=IPTR+J-2 IF(IPTR.GT.ISIZ)CALL ERROR(9) DO 100 J=I,IPTR+1,256 100 READ(LUNS'IBLK)(IBUF(K),K=J,J+255) CALL CLOSE(LUNS) CALL CMPRS(2) #IFF -HOSAT #IF SATEL #IF LOCSAV COMMON/IOX/KUNIT(8),KSTRT(8),KLEN(8),KDIR(512) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL CMPRS(1) CALL ACCESS(1,FNAME,1,IORET) IF(IORET.LT.0)CALL ERROR(4,IORET) I=IPTR CALL READWR(0,1,0,256,KDIR,IORET) IF(IORET.LT.0)CALL ERROR(4,IORET) CALL VERSON(II) IF(IAND(II-KDIR(2),"3).NE.0)CALL ERROR(19) IPTR=IPTR+KDIR(1)-2 IF(IPTR.GT.ISIZ)CALL ERROR(9) CALL READWR(0,1,1,KDIR(1),IBUF(I),IORET) IF(IORET.LT.0)CALL ERROR(4,IORET) CALL CMPRS(2) #ENDC LOCSAV #IFF SATEL COMMON/GRIO/IOBUF(290) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST CALL PUTEM(0) CALL ASSIGN(LUNS,FNAME) DEFINE FILE LUNS(64,256,U,IBLK) READ(LUNS'1)J,I,(II,K=1,254) CALL TOSAT(JRST,2,2,J,1,I) IE=0 II=1 #SUBS 'MAXR'MAXR DO 200 I=1,J,MAXR IF(IE.GE.II+MAXR-1)GOTO 150 IE=IE-II+1 DO 100 K=1,IE 100 IOBUF(K)=IOBUF(II+K-1) II=1 READ(LUNS'IBLK)(IOBUF(K),K=IE+1,IE+256) IE=IE+256 150 CALL TOOSAT(MAXR*2,IOBUF(II)) II=II+MAXR #ENDS 200 CONTINUE CALL CLOSE(LUNS) #ENDC SATEL #ENDC -HOSAT RETURN END #NAME SAVE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SAVE.FO #ENDS #ENDC SUBROUTINE SAVE(FNAME) LOGICAL*1 FNAME(30) #IFN HOSAT #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL CMPRS(1) CALL ASSIGN(LUNS,FNAME) DEFINE FILE LUNS(64,256,U,IBLK) CALL VERSON(I) #IFN SCOPES WRITE(LUNS'1)IPTR-29,I,(J,J=1,254) DO 100 I=31,IPTR+1,256 100 WRITE(LUNS'IBLK)(IBUF(J),J=I,I+255) #IFF WRITE(LUNS'1)IPTR-62,I,(J,J=1,254) DO 100 I=64,IPTR+1,256 100 WRITE(LUNS'IBLK)(IBUF(J),J=I,I+255) #ENDC -SCOPES CALL CLOSE(LUNS) CALL CMPRS(2) #IFF -HOSAT #IF SATEL #IF LOCSAV COMMON/IOX/KUNIT(8),KSTRT(8),KLEN(8),KDIR(512) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL CMPRS(1) CALL ACCESS(3,FNAME,,IORET) CALL ACCESS(2,FNAME,1,IORET,IPTR/256+2) IF(IORET.LT.0)CALL ERROR(4,IORET) CALL VERSON(KDIR(2)) #IFN SCOPES KDIR(1)=IPTR-29 CALL READWR(1,1,0,256,KDIR,IORET) IF(IORET.LT.0)CALL ERROR(4,IORET) CALL READWR(1,1,1,IPTR-29,IBUF(31),IORET) #IFF -SCOPES KDIR(1)=IPTR-62 CALL READWR(1,1,0,256,KDIR,IORET) IF(IORET.LT.0)CALL ERROR(4,IORET) CALL READWR(1,1,1,IPTR-62,IBUF(64),IORET) #ENDC -SCOPES IF(IORET.LT.0)CALL ERROR(4,IORET) CALL CMPRS(2) #ENDC LOCSAV #IFF SATEL COMMON/GRIO/IOBUF(290) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST CALL PUTEM(0) CALL ASSIGN(LUNS,FNAME) DEFINE FILE LUNS(64,256,U,IBLK) CALL TOSAT(JSAV,0) CALL FRSAT(1,2,N) CALL VERSON(I) WRITE(LUNS'1)N,I,(J,J=1,254) II=1 #SUBS 'MAXR'MAXR DO 200 I=1,N,MAXR CALL FRSAT(1,MAXR*2,IOBUF(II)) II=II+MAXR #ENDS IF(II.LE.256)GOTO 200 WRITE(LUNS'IBLK)(IOBUF(J),J=1,256) DO 100 J=257,II 100 IOBUF(J-256)=IOBUF(J) II=II-256 200 CONTINUE WRITE(LUNS'IBLK)(IOBUF(J),J=1,256) CALL CLOSE(LUNS) #ENDC SATEL #ENDC -HOSAT RETURN END #NAME SCAL #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SCAL.FO #ENDS #ENDC SUBROUTINE SCAL(XL,YL,XH,YH,FX,FY) #IF INTEGR RETURN #IFF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IFN SORNHS CALL BUFTST #IFTF -SORNHS XSCF=1023./(XH-XL) XBAS=XL*XSCF YSCF=1023./(YH-YL) YBAS=YL*YSCF IF(1-NOPTS(4))100,200,300 100 FY=1./YSCF 200 FX=1./XSCF #IFF -SORNHS 300 RETURN #IFT -SORNHS 300 CALL TOSAT(JSCL,1,16,XSCF) RETURN #ENDC -SORNHS #ENDC INTEGR END #NAME SCOPE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SCOPE.FO #ENDS #ENDC SUBROUTINE SCOPE(S) INTEGER S #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SCOPES CALL BUFTST N=IABS(S) IF(N.EQ.1)CALL PUTWD(INOP+"240+ISIGN("40,S)) IF(N.EQ.2)CALL PUTWD(INOP+"640+ISIGN("40,S)) CALL PUTEM #ENDC SCOPES RETURN END #NAME SENSE #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SENSE.FO #ENDS #ENDC SUBROUTINE SENSE(K,L,N) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS LL=0 IF(NOPTS(1).GE.1)LL=IOPTV(L) #IF SCOPES IF(NOPTS(1).LT.2.OR.N.EQ.1)GOTO 200 CALL CHANGP(K,I,M) IF(IAND(IBUF(I-2),"174400).EQ.INOP+"400)GOTO 100 ICHI(K)=I-1 CALL INSERT(K) CALL PUTWD(INOP+"450+ISIGN("10,LL)) CALL INSERT ICHI(K)=I+1 RETURN 100 IBUF(I-2)=IAND(IBUF(I-2),"177710)+"50+ISIGN("10,LL) RETURN #ENDC 200 CALL CHANGP(K,I,M) IBUF(I-1)=IAND(IBUF(I-1),"177637)+"120+ISIGN("20,LL) #IFF SORNHS CALL BUFTST CALL TOSAT(JSNS,1,1,K,NOPTS(1),1,L,0,1,N,1) #ENDC SORNHS RETURN END #NAME STOP #IF HOSAT #IFN SATEL SUBROUTINE STOP RETURN END #ENDC #ENDC #NAME SUBP #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SUBP.FO #ENDS #ENDC SUBROUTINE SUBP(NAM1,NAM2) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL TAGSRH(NAM1,I) IF(IINS.NE.0)CALL ERROR(16) IF(I.NE.0.OR.NAM1.LT.0)CALL ERROR(10,NAM1) IF(NOPTS(1).GT.0)GOTO 500 IF(ISTP.GT.8)CALL ERROR(11) ISTK(ISTP)=IPTR ISTP=ISTP+1 IA=IADRS(IBUF(IPTR+5)) #IFN VS60 CALL PUTWD(IJSR+2) CALL PUTWD(IADRS(IBUF(29))) 100 CALL PUTWD(IA) #IFF CALL PUTWD(IJSRR+4) CALL PUTWD(IHLT) CALL PUTWD(0) #IFTF 150 CALL PUTWD(NAM1) IF(ILST.EQ.0)ILST=IPTR IF(IEND.NE.0)IBUF(IEND)=IPTR IEND=IPTR CALL PUTWD(0) CALL PUTEM(0) MOLD=3 RETURN 500 CALL TAGSRH(NAM2,I) IF(I.EQ.0)CALL ERROR(12,NAM2) #IFT IF(IBUF(I-4).EQ.IJSR+2)CALL ERROR(13,NAM2) CALL PUTWD(IJSR+1) CALL PUTWD(IADRS(IBUF(IPTR+4))) IA=IBUF(I-2) GOTO 100 #IFF IF(IBUF(I-2).EQ.0)CALL ERROR(13,NAM2) CALL PUTWD(IJSR) J=IBUF(I-3) IF(IBUF(I-4).EQ.IJSRR+4.OR.IBUF(I-4).EQ.IJMPR) X J=IADRS(IBUF(I+1)) CALL PUTWD(J) CALL PUTWD(IJMPR+2) GOTO 150 #ENDC #IFF SORNHS CALL BUFTST CALL PUTEM(0) CALL TOSAT(JSUB,1,2,NAM1,NOPTS(1),2,NAM2,0) RETURN #ENDC SORNHS END #NAME SVECT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:SVECT.FO #ENDS #ENDC SUBROUTINE SVECT(RDX,RDY,L,I,F,T) #IF INTEGR INTEGER RDX,RDY #ENDC INTEGR CALL VECTS(RDX,RDY,1,NOPTS(2),L,I,F,T) RETURN END #NAME TAGSRH #IF SORNHS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:TAGSRH.FO #ENDS #ENDC SUBROUTINE TAGSRH(NAM,I) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST I=ILST IPRV=0 100 IF(I.EQ.0)RETURN IF(IBUF(I-1).EQ.NAM)RETURN IPRV=I I=IBUF(I) GOTO 100 END #ENDC #NAME TEXOO #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:TEXOO.FO #ENDS #ENDC SUBROUTINE TEXOO(IOO) INTEGER IONOFF(7,2) #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS DATA IONOFF/ X "16,"170060,"155400,"21,"23,"22,"24, X "17,"170040,"155000,0,0,0,0/ 700 J=1 #IF VS60 DO 800 K=1,7 #IFF VS60 DO 800 K=1,2 #ENDC VS60 IF(IAND(ITEX,J).EQ.0)GOTO 800 IF(IONOFF(K,IOO))720,800,750 720 CALL PUTCHR(0) CALL PUTWD(IONOFF(K,IOO)) GOTO 800 750 CALL PUTCHR(IONOFF(K,IOO)) 800 J=J*2 IF(IOO.EQ.2)ITEX=0 RETURN END #NAME TEXT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:TEXT.FO #ENDS #ENDC SUBROUTINE TEXT(I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) ; ; ARG MEANING ; ; 'STRING' PRINT STRING ; 0<=N<32 N CR/LF ; N<0 ABS(N) BIT ENCODED ; 1 SHIFT OUT ; 2 ITALLICS ; 4 ROTATED ; 8 SUPERSCRIPT INCREASE ; 16 SUPERSCRIPT DECREASE ; 32 SUBSCRIPT INCREASE ; 64 SUBSCRIPT DECREASE ; #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST N=ICHT IF(ICHT.EQ.0)N=NOPTS(0) MOLD=4 CALL MODE(ITXT,0) DO 1000 I=1,N CALL ARG(J,I,1,1,I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) IF(J.LT."200)GOTO 20 ITEX="400-J CALL TEXOO(1) GOTO 1000 20 IF(J.GE."40)GOTO 100 DO 50 K=1,J CALL PUTCHR("15) 50 CALL PUTCHR("12) GOTO 600 100 DO 500 K=1,10000 CALL ARG(J,I,K,1,I1,I2,I3,I4,I5,I6,I7,I8,I9,I10) IF(J.EQ.0)GOTO 600 IF(IAND(ITEX,1).EQ.0)GOTO 500 J=IAND(J,"37) IF(J.NE."17)GOTO 500 CALL PUTCHR(J) CALL PUTCHR("40) J="16 500 CALL PUTCHR(J) 600 CALL TEXOO(2) 1000 CONTINUE CALL TEXOO(2) CALL PUTCHR(0) ICHR=-1 IF(ICHT.EQ.0)CALL PUTEM ICHT=0 RETURN END #NAME TRAK #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:TRAK.FO #ENDS #ENDC SUBROUTINE TRAK(RX,RY,N) #IF INTEGR INTEGER RX,RY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST #IFN VS60 #IF INTEGR IBUF(8)=RX IBUF(9)=RY #IFF INTEGR IBUF(8)=XSCF*RX-XBAS IBUF(9)=YSCF*RY-YBAS #ENDC INTEGR IBUF(1)=IJSR #IFF #IFN SCOPES #IF INTEGR IBUF(8)=RX IBUF(9)=RY #IFF INTEGR IBUF(8)=XSCF*RX-XBAS IBUF(9)=YSCF*RY-YBAS #ENDC INTEGR IBUF(1)=IJSRR+4 #IFF I=1 IF(NOPTS(2).EQ.1.AND.N.EQ.2)I=31 #IF INTEGR IBUF(I+7)=RX IBUF(I+8)=RY #IFF INTEGR IBUF(I+7)=XSCF*RX-XBAS IBUF(I+8)=YSCF*RY-YBAS #ENDC INTEGR IBUF(I)=IJSRR+4 #ENDC #ENDC #IFF SORNHS CALL BUFTST #IF INTEGR CALL TOSAT(JTRK,2,2,RX,2,RY,NOPTS(2),1,N,1) #IFF INTEGR CALL TOSAT(JTRK,2,4,RX,4,RY,NOPTS(2),1,N,1) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME TRAKXY #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:TRAKXY.FO #ENDS #ENDC SUBROUTINE TRAKXY(RX,RY,N) #IF INTEGR INTEGER RX,RY #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF SORNHS CALL BUFTST #IFN SCOPES #IF INTEGR RX=IBUF(8) RY=IBUF(9) #IFF INTEGR RX=(FLOAT(IBUF(8))+XBAS)/XSCF RY=(FLOAT(IBUF(9))+YBAS)/YSCF #ENDC INTEGR #IFF I=1 IF(NOPTS(2).EQ.1.AND.N.EQ.2)I=31 #IF INTEGR RX=IBUF(I+7) RY=IBUF(I+8) #IFF INTEGR RX=(FLOAT(IBUF(I+7))+XBAS)/XSCF RY=(FLOAT(IBUF(I+8))+YBAS)/YSCF #ENDC INTEGR #ENDC #IFF SORNHS CALL BUFTST CALL TOSAT(JTXY,0,NOPTS(2),1,N,1) #IF INTEGR CALL FRSAT(2,2,RX,2,RY) #IFF INTEGR CALL FRSAT(2,4,RX,4,RY) #ENDC INTEGR #ENDC SORNHS RETURN END #NAME VECT #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:VECT.FO #ENDS #ENDC SUBROUTINE VECT(RDX,RDY,L,I,F,T) #IF INTEGR INTEGER RDX,RDY #ENDC INTEGR CALL VECTS(RDX,RDY,-1,NOPTS(2),L,I,F,T) RETURN END #NAME VECTS #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:VECTS.FO #ENDS #ENDC SUBROUTINE VECTS(RDX,RDY,ITYP,NO,L,I,F,T) #IF INTEGR INTEGER RDX,RDY #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IFT INTEGR CALL MVECT(RDX,IDX,IXS) CALL MVECT(RDY,IDY,IYS) #IFF INTEGR CALL MVECT(INTR(RDX*XSCF),IDX,IXS) CALL MVECT(INTR(RDY*YSCF),IDY,IYS) #ENDC INTEGR IF(ITYP)200,300,400 200 IF(IDX.LE.63.AND.IDY.LE.63)GOTO 400 300 CALL MODE(ILOV,NO,L,I,F,T) CALL PUTWD(IVIS+IXS+IDX) CALL PUTWD(IYS+IDY) CALL PUTEM RETURN 400 CALL MODE(ISHV,NO,L,I,F,T) CALL PUTWD(IVIS+IXS+MIN0(63,IDX)*128+IYS/128+MIN0(63,IDY)) CALL PUTEM RETURN END #NAME WINDOW #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:WINDOW.FO #ENDS #ENDC SUBROUTINE WINDOW(X,Y) #IF INTEGR INTEGER X,Y #ENDC INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IF VS60 CALL BUFTST #IF INTEGR CALL MPNT(-X,IDX) CALL MPNT(-Y,IDY) #IFF INTEGR CALL MPNT(INTR(-X*XSCF-XBAS),IDX) CALL MPNT(INTR(-Y*YSCF-YBAS),IDY) #ENDC INTEGR CALL MODE(IAPT,0) CALL PUTWD(IOFF+IDX) CALL PUTWD(IDY) CALL PUTEM #ENDC VS60 RETURN END #NAME XGRA #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:XGRA.FO #ENDS #ENDC SUBROUTINE XGRA(DELTA,A,N,NAM,L,I,F,T) #IF INTEGR INTEGER DELTA,A #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IFT INTEGR CALL ZGRA(DELTA,A,N,NAM,IGRX,NOPTS(4),L,I,F,T) #IFF INTEGR CALL ZGRA(DELTA*YSCF,A,N,NAM,IGRX,XSCF,XBAS,NOPTS(4),L,I,F,T) #ENDC INTEGR RETURN END #NAME YGRA #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:YGRA.FO #ENDS #ENDC SUBROUTINE YGRA(DELTA,A,N,NAM,L,I,F,T) #IF INTEGR INTEGER DELTA,A #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS #IFT INTEGR CALL ZGRA(DELTA,A,N,NAM,IGRY,NOPTS(4),L,I,F,T) #IFF INTEGR CALL ZGRA(DELTA*XSCF,A,N,NAM,IGRY,YSCF,YBAS,NOPTS(4),L,I,F,T) #ENDC INTEGR RETURN END #NAME ZGRA #IF BRAKUP #SUBS 'OD:'OUTDEV #FILE OD:ZGRA.FO #ENDS #ENDC SUBROUTINE ZGRA(DEL,A,N,NAM,M,SCF,BAS,NO,L,I,F,T) #IF INTEGR INTEGER A(N),DEL #IFF INTEGR DIMENSION A(N) #IFTF INTEGR #SUBS 'OD:'OUTDEV #CALL OD:GRCOM.CND #ENDS CALL BUFTST #IFT INTEGR IF(DEL.LE.0.OR.DEL.GE.64)CALL ERROR(14) #IFF INTEGR IDEL=INTR(DEL) IF(IDEL.LE.0.OR.IDEL.GE.64)CALL ERROR(14) #IFTF INTEGR CALL SUBP(NAM) CALL PUTWD(ISRB+"100+IDEL) CALL MODE(M,NO,L,I,F,T) DO 200 J=1,N #IFT INTEGR 200 CALL PUTWD(MIN0(1023,MAX0(0,A(J)))) #IFF INTEGR 200 CALL PUTWD(MIN0(1023,MAX0(0,INTR(A(J)*SCF-BAS)))) #ENDC INTEGR CALL ESUB RETURN END