UNIVERSAL LIBUNV - UNIVERSAL FILE FOR LIBFOR SUBTTL DEFINE ARGUMENT RETRIEVAL MACROS ;+ ;.nofill ;.nojust ;.title ####################LIBFOR - FORTRAN-10 ROUTINE LIBRARY ;.SPACING 1 ;.CENTER ;PROGRAM LOGIC MANUAL FOR LIBFOR ;.CENTER ;25-AUGUST-77 ;.SKI 2 ;.CENTER ;Reed Powell, DEC ;.skip 10 ;LIBFOR.REL[464,105] ;.PAGE ;- DEFINE ARG1,<0(16)> DEFINE ARG2,<1(16)> DEFINE ARG3,<2(16)> DEFINE ARG4,<3(16)> DEFINE ARG5,<4(16)> DEFINE ARG6,<5(16)> DEFINE ARG7,<6(16)> DEFINE ARG8,<7(16)> DEFINE ARG9,<10(16)> DEFINE ARG10,<11(16)> SUBTTL DEFINE ACCUMULATOR MNEMONICS AC0=0 AC1=1 AC2=2 AC3=3 AC4=4 AC5=5 AC6=6 AC7=7 L=16 P=17 SUBTTL PROLOGUE AND EPILOGUE MACROS ;"HELLO" IS THE PROLOGUE MACRO, USED TO DEFINE ;THE START OF A SUBROUTINE OR FUNCTION. ;"GOODBY" IS THE EPILOGUE MACRO, USED TO DEFINE THE END ;OF A SUBROUTINE OR FUNCTION. ;HELLO: ;CALL IS ; HELLO NAME,SAVCOD,ACLIST ;WHERE ; "NAME" IS THE NAME OF THE SUBROUTINE OR FUNCTION. ; "SAVCOD" IS THE NAME OF THE ROUTINE TO SAVE ACCUMULATORS. ; "ACLIST" IS A LIST OF LOCATIONS TO BE PUSHED ONTO ; THE STACK. MUST BE WITHIN <> IF MORE THAN ONE ; LOCATION IN LIST. DEFINE HELLO(NAME,SAVCOD,ACLIST) < IFDEF ..NEST,< IFN ..NEST,> ..NEST==1 ENTRY NAME SIXBIT/NAME/ NAME: IFNB , IFNB , > >;END OF HELLO ;GOODBY: ;CALL IS ; GOODBY NAME,RSTCOD,ACLIST ;WHERE ; "NAME" IS THE NAME OF THE SUBROUTINE OR FUNCTION ; "RSTCOD" IS THE NAME OF THE ROUTINE TO RESTORE ACCUMULATORS. ; "ACLIST" IS THE LIST OF LOCATIONS TO BE POP-ED FROM ; THE STACK. DEFINE GOODBY(NAME,RSTCOD,ACLIST) < IFNDEF ..NEST, IFN ..NEST-1, ..NEST==..NEST-1 IFNB , IFNB ,< IRP ACLIST,< POP P,ACLIST >> POPJ P, >;END OF GOODBY PRGEND ;;END OF LIBUNV TITLE IGETTB- FORTRAN-10 INTEGER FUNCTION TO DO GETTABS SEARCH LIBUNV SEARCH UUOSYM,MACTEN ;+ ;.SUBTITLE IGETTB - GETTAB FUNCTION ;.INDEX IGETTAB ;.INDEX GETTAB ;CALL TO "IGETTB" IS: ; IGETTB(TABLE,ITEM) ;WHERE ; "TABLE" IS AN INTEGER WITH THE TABLE NUMBER IN IT. ; "ITEM" IS AN INTEGER WITH THE ITEM NUMBER IN IT. ;ON RETURN, THE VALUE IS =-1 IF THE GETTAB FAILED, ELSE ; IT IS THE RESULT RETURNED BY THE UUO. ;.PAGE ;- HELLO IGETTB HRR AC0,@ARG1 ;GET TABLE NUMBER HRL AC0,@ARG2 ;AND THE ITEM NUMBER GETTAB AC0, SETO AC0, GOODBY IGETTB PRGEND ;;END OF IGETTB TITLE IWHERE - WHERE UUO SUBROUTINE SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.SUBTITLE IWHERE - WHERE UUO SUBROUTINE ;.INDEX IWHERE ;.INDEX WHERE UUO ;WHERE: ;CALL IS ; IWHERE(DEV,STATUS,NODE) ;WHERE ; DEV IS THE DEVICE NAME ; "STATUS" IS WHERE THE STATUS BITS ARE RETURNED ; "NODE" IS THE NUMBER OF THE NODE ;IF WHERE UUO TAKES ERROR RETURN, THEN ; -1 IS RETURNED IN BOTH "STATUS" AND "NODE". ;.PAGE ;- HELLO IWHERE MOVE AC0,@ARG1 ;GET DEVICE NAME WHERE AC0, SETO AC0, HLREM AC0,@ARG2 ;STORE STATUS HRREM AC0,@ARG3 ;STORE NODE NUMBER GOODBY IWHERE PRGEND TITLE MISC - MISC SUBROUTINES SUBTTL EXITS: SUBROUTINE TO DO QUICK MONRET SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.SUBTITLE EXITS - " EXIT 1, " SUBROUTINE ;.INDEX EXITS ;.INDEX EXIT ;.INDEX MONRT ;EXITS - QUICK MONRET SUBROUTINE ;CALL IS ; CALL EXITS ;.PAGE ;- HELLO EXITS EXIT 1, GOODBY EXITS ;SUBROUTINE TO TURN OFF TTY ECHOING ;+ ;.SUBTITLE ECHO AND NOECHO ;.INDEX ECHO ;.INDEX NOECHO ;SUBROUTINE NO ECHO - TURNS OFF TERMINAL ECHOING ;SUBROUTINE ECHO - TURNS ON TERMINAL ECHOING ; ;CALL: ; CALL NOECHO ; CALL ECHO ;- HELLO NOECHO SETO 1, GETLCH 1 TXO 1,GL.LCP ;LOCAL COPY SETLCH 1 GOODBYE NOECHO HELLO ECHO SETO 1, GETLCH 1 TXZ 1,GL.LCP ;TURN OFF LOCAL COPY SETLCH 1 GOODBYE ECHO PRGEND TITLE HAFWRD - FUNCTIONS TO DO HALF-WORD INSTRUCTIONS SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.SUBTITLE HAFWRD - "ILEFT" AND "IRIGHT" ;.INDEX HAFWRD ;.INDEX ILEFT ;.INDEX IRIGHT ;.SKI 2 ;THESE TWO FUNCTIONS ARE USED TO DO HALF WORD MOVES OF ;DATA IN FORTRAN. ;EACH HAS AS ITS VALUE THE APPROPRIATE HALF OF THE PDP-10 ;WORD WHICH IS ITS ARGUMENT. ;.PAGE ;- HELLO ILEFT HLRZ AC0,@ARG1 GOODBY ILEFT HELLO IRIGHT HRRZ AC0,@ARG1 GOODBY IRIGHT PRGEND TITLE ILINUM SUBROUTINE TO DO THE "GTNTN." UUO SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.SUBTITLE ILINUM - "GTNTN." UUO, GETS LINE NUMBER ;.INDEX ILINUM ;.INDEX "GTNTN." ;ILINUM: ;CALL IS ; ILINUM(TTY,NODE,LINE) ;WHERE ; "TTY" IS THE SIXBIT TTY NAME ; "NODE" IS WHERE THE NONE # IS RETURNED ; "LINE" IS WHERE THE LINE NUMBER ON THAT ; NODE IS RETURNED. ;IF GTNTN. UUO FAILS, THEN -1 IS RETURNED IN "NODE", ; AND THE ERROR CODE IS RETURNED IN "LINE": ; ERROR 0: NO SUCH DEVICE ; ERROR 1: DEVICE IS NOT A TERMINAL ; ERROR 2: SPECIFIED TERMINAL IS NOT CONNECTED ;.PAGE ;- HELLO ILINUM MOVE AC0,@ARG1 ;GET TERMINAL NAME GTNTN. AC0, TLO AC0,-1 ;SET NODE NUMBER TO -1 HLREM AC0,@ARG2 ;STORE NODE NUMBER HRRM AC0,@ARG3 ;STORE LINE NUMBER ON NODE GOODBY ILINUM PRGEND TITLE IGETTY - FUNCTION TO DO THE GTXTN. UUO SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.SUBTITLE IGETTY - "GTXTN." UUO, GETS TTY NUMBER ;.INDEX IGETTY ;.INDEX "GTXTN." ;IGETTY: ;CALL ; IGETTY(INODE,ILINE) ;WHERE ; "INODE" IS THE NODE NUMBER ; "ILINE" IS THE LINE ON THAT NODE ;ON RETURN, THE VALUE OF THE FUNCTION IS THE SIXBIT ; NAME OF THE TERMINAL CONNECTED TO THE SPECIFIED ; NODE-LINE COMBINATION, OR ;ERROR THE VALUE OF THE FUNCTION IS THE ; ERROR CODE: ; ERROR 0: NOT A NETWORK TERMINAL ; ERROR 1: NOT A LOCAL TTY ;.PAGE ;- HELLO IGETTY HRL AC0,@ARG1 ;GET NODE NUMBER HRR AC0,@ARG2 ;AND LINE NUMBER GTXTN. AC0, JFCL ;VALUE IS THE ERROR CODE GOODBY IGETTY PRGEND TITLE INODE - SUBROUTINE TO DO NODE. UUOS SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.SUBTITLE INODE - "NODE." UUO SUBROUTINE ;.INDEX INODE ;.INDEX "NODE." ;INODE: ;CALL ; CALL INODE(IFUNCT,IARRY,IERR) ;WHERE: ; "IFUNCT" IS THE FUNCTION CODE FOR NODE. ; "IARRY" IS THE NAME OF THE ARGUMENT BLOCK ARRAY. ; "IERR" IS THE ERROR STATUS WORD: ; IF 0, THEN CALL WAS SUCCESSFUL, ; IF NON-0, THEN IT IS THE ERROR CODE RETURNED BY NODE.: ; ERROR 1: "IARRY" NOT SET UP PROPERLY ; ERROR 2: ILLEGAL NODE NAME OR NUMBER ; ERROR 3: NOT A PRIVILEGED JOB ; ERROR 4: NODE IS NOT AVAILABLE ; ERROR 5: JOB NOT LOCKED IN CORE AND MUST BE ; ERROR 6: TIME-OUT ERROR OCCURRED ; ERROR 7: IARRY(3) NON-0 FOR FUNCTION #5 ;.PAGE ;- HELLO INODE HRL AC0,@ARG1 ;GET FUNCTION CODE HRR AC0,@ARG2 ;GET ARG-BLOCK ADDRESS SETZM @ARG3 ;ASSUME WILL BE OK NODE. AC0, MOVEM AC0,@ARG3 ;STORE ERROR CODE GOODBY INODE PRGEND TITLE ISIXBT - FUNCTION TO CONVERT FROM ASCII TO SIXBIT SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.SUBTITLE ISIXBT _& IASCII - SIXBIT/ASCII CONVERSION FUNCTIONS ;.INDEX ISIXBT ;ISIXBT: ;CALL ; ISIXBT(IASCII,LIMIT) ;WHERE: ; "IASCII" IS THE ASCII WORD ; "LIMIT" IS THE MAX CHARS TO CONVERT ;.SKIP 10 ;- HELLO ISIXBT,, MOVE AC1,[POINT 7,@ARG1] ;ASCII PTR MOVE AC2,[POINT 6,AC0] ;SIXBIT PTR MOVN AC3,@ARG2 ;ITERATION CTR SETZ AC0, LOOP: ILDB AC4,AC1 ;GET ASCII CHAR JUMPE AC4,DONE ;DONE IF A NUL SUBI AC4,"0"-'0' ;ASCII TO SIXBIT IDPB AC4,AC2 ;STORE SIXBIT AOJL AC3,LOOP DONE: GOODBY ISIXBT,, PRGEND TITLE IASCII - FUNCTION TO CONVERT SIXBIT TO ASCII SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.INDEX IASCII ;IASCII: ;CALL ; IASCII(ISIXBT,LEN) ;WHERE ; ISIXBT IS THE SIXBIT WORD TO BE CONVERTED ; "LEN" IS THE MAX NUMBER OF CHARS TO CONVERT ;.PAGE ;- HELLO IASCII,, MOVE AC1,[POINT 6,@ARG1] ;SIXBIT PTR MOVE AC2,[POINT 7,AC0] ;ASCII PTR MOVN AC3,@ARG2 ;INTERATION CTR MOVE AC0,[ASCII/ /] LOOP: ILDB AC4,AC1 ;GET SIXBIT JUMPE AC4,DONE ;DONE IF SPACE ADDI AC4,"0"-'0' ;SIXBIT TO ASCII IDPB AC4,AC2 ;STORE ASCII AOJL AC3,LOOP DONE: GOODBY IASCII,, PRGEND TITLE LOGIC - FUNCTIONS TO PERFORM DEC-10 LOGICAL FUNCTIONS SUBTTL ROTATING, SHIFTING SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.SUBTITLE LOGIC - FUNCTIONS FOR DEC-10 LOGICAL INSTRUCTIONS ;.INDEX IROTAT ;.INDEX ROT ;IROTAT: ;CALL: ; IROTAT(IWORD,IBITS) ;WHERE ; "IWORD" IS WORD TO BE ROTATED ; "IBITS" IS NUMBER OF POSITIONS TO ROTATE (SIGNED INTEGER) ;.SKIP 10 ;- HELLO IROTAT MOVE AC0,@ARG1 ;WORD TO ROTATE MOVE AC1,@ARG2 ;POSITIONS TO ROTATE ROT AC0,(AC1) GOODBY IROTAT ;+ ;.INDEX ILSHFT ;.INDEX LSH ;ILSHFT: ;CALL ; ILSHFT(IWORD,IBITS) ;WHERE ; "IWORD" IS WORD TO SHIFT BITS OF ; "IBITS" IS NUMBER OF POSITIONS TO SHIFT (SIGNED INTEGER) ;.SKIP 10 ;- HELLO ILSHFT MOVE AC0,@ARG1 ;GET WORD MOVE AC1,@ARG2 ;GET NUM BITS TO MOVE LSH AC0,(AC1) GOODBY ILSHFT ;.INDEX IASHFT ;.INDEX ASH ;IASHFT: ;CALL ; IASHFT(IWORD,IBITS) ;WHERE ; "IWORD" IS WORD TO SHIFT BITS OF ; "IBITS" IS NUMBER OF POSITIONS TO SHIFT (SIGNED INTEGER) ;.PAGE ;- HELLO IASHFT MOVE AC0,@ARG1 ;GET WORD MOVE AC1,@ARG2 ;GET NUM BITS TO MOVE ASH AC0,(AC1) GOODBY IASHFT SUBTTL AND, IOR, COMP, XOR, EQV, CLEAR-BIT FUNCTIONS ;+ ;.INDEX AND ;.INDEX IOR ;.INDEX COMP ;.INDEX SETC ;.INDEX XOR ;.INDEX EQV ;.INDEX CLEAR-BIT ;.INDEX ANDC ;FUNCTION NAME DEC-10 INSTRUCTION PERFORMED ;IAND AND ;IOR IOR ;ICOMP SETCM ;IXOR XOR ;IEQV EQV ;ICLEAR ANDCM (BIT-CLEAR) ;CALLING SEQUENCE ; FUNCTION-NAME(WORD,MASK) ;WHERE ; "WORD" IS THE WORD WHOSE CONTENTS ARE TO ; BE USED AS INPUT (IT IS NOT ALTERED) ; "MASK" IS THE 36-BIT QUANTITY TO BE USED ; AS THE MASK FOR THE OPERATION ;NOTE THAT "ICOMP" HAS ONLY THE "WORD" ARGUMENT ;.PAGE ;- HELLO IAND MOVE AC0,@ARG1 AND AC0,@ARG2 GOODBY IAND HELLO IOR MOVE AC0,@ARG1 IOR AC0,@ARG2 GOODBY IOR HELLO ICOMP MOVE AC0,@ARG1 SETCM AC0 GOODBY ICOMP HELLO XOR MOVE AC0,@ARG1 XOR AC0,@ARG2 GOODBY XOR HELLO ICLEAR MOVE AC0,@ARG1 ANDCM AC0,@ARG2 GOODBY ICLEAR HELLO IEQV MOVE AC0,@ARG1 EQV AC0,@ARG2 GOODBY IEQV PRGEND TITLE BYTE - PERFORM DEC-10 BYTE OPERATIONS SUBTTL MAKEBP - CONSTRUCT BYTE-POINTERS SEARCH LIBUNV,MACTEN,UUOSYM ;+ ;.SUBTITLE BYTE - FUNCTIONS FOR DEC-10 BYTE MANIPULATION ;.INDEX BYTE-MANIPULATION ;.INDEX MAKEBP ;MAKEBP: ;FUNCTION TO MAKE A DEC-10 STYLE BYTE-POINTER ;CALL ; MAKEBP(IWORD,IPOS,ISIZE) ;WHERE ; "IWORD" IS THE WORD CONTAINING THE BYTE(S) ; "IPOS" IS THE BYTE'S POSITION, A LA "POINT" PSEUDO-OP ; IN MACRO-10 ; "ISIZE" IS THE SIZE OF THE BYTE ;THE VALUE RETURNED BY THE FUNCTION IS THE BYTE-POINTER ;CONSTRUCTED. NO VALIDITY CL`HECKING OF THE ARGUMENTS IS ;PERFORMED. ;.SKI 5 ;- HELLO MAKEBP MOVE AC1,@ARG2 ;GET POS FIELD MOVNS AC1 ADDI AC1,^D35 ;CONVERT TO HARDWARE POSITION LSH AC1,^D6 ;AND POSITION IN PTR MOVE AC0,@ARG3 ;GET SIZE FIELD IOR AC0,AC1 ;COMBINE POS AND SIZE LSH AC0,^D24 ;AND POSITION THEM HRR AC0,ARG1 ;GET **ADDRESS** OF MEMORY WORD GOODBY MAKEBP SUBTTL GETBYT AND PUTBYT SUBROUTINES ;+ ;.INDEX GETBYT ;.INDEX PUTBYT ;GETBYT: ;PUTBYT: ;.SKI 1 ;GETBYT GETS A BYTE FROM A MEMORY WORD ;PUTBYT DEPOSITS A BYTE INTO A MEMORY WORD ;CALLING FORMAT (FOR BOTH) ; CALL XXXBYT(IPTR,IBYTE,INCFLG) ;WHERE ; "IPTR" IS A DEC-10 BYTE-POINTER WORD ; "IBYTE" IS THE BYTE INVOLVED IN THE OPERATION ; "INCFLG" IS 0 IF NOT TO ADVANCE TO THE NEXT ; BYTE BEFORE PERFORMING THE OPERATION, ELSE ; NON-0 TO INCREMENT THE POINTER BEFORE THE OPERATION. ;NOTE THAT IF IN INCREMENTAL MODE, THE POINTER ITSELF IS ;MODIFIED UPON RETURN FROM THE SUBROUTINE. ;.PAGE ;- HELLO GETBYT SKIPE @ARG3 ;INCREMENTAL MODE?? IBP @ARG1 ;YES LDB AC0,@ARG1 MOVEM AC0,@ARG2 GOODBY GETBYT HELLO PUTBYT SKIPE @ARG3 ;INCREMENTAL MODE ?? IBP @ARG1 ;YES MOVE AC0,@ARG2 ;GET BYTE TO STORE DPB AC0,@ARG1 GOODBY PUTBYT PRGEND TITLE UV2BIN - UNIVERSAL DATE/TIME SUBROUTINE SEARCH LIBUNV .REQUEST SCAN ;+ ;.INDEX DATE ;.INDEX TIME ;.INDEX UNIVERSAL DATE/TIME ;.INDEX UV2BIN ;CALL: ; CALL UV2BIN(DATE,TIME,YEAR,MONTH,DAY,HOUR,MIN,SEC) ;WHERE: ; DATE IS THE UNIVERSAL DATE ; TIME IS THE UNIVERSAL TIME ; YEAR GETS THE YEAR NUMBER ; MONTH GETS THE MONTH NUMBER (1-12) ; DAY GETS THE DAY OF MONTH ; HOUR GETS THE HOUR OF DAY ; MIN GETS THE MINUTE OF THE HOUR ; SEC GETS THE SECOND OF THE MINUTE ; ;ALL VARIABLES ARE INTEGER ; ;USE OF THIS SUBROUTINE REQUIRES THAT SCAN BE LOADED ALSO ; ;.PAGE ;- HELLO UV2BIN,, HRLZ AC1,@ARG1 ;GET DATE HRR AC1,@ARG2 ;AND TIME PUSHJ P,.CNTDT## ;LET SCAN CONVERT TO DEC FORMAT PUSH P,AC1 ;SAVE TIME FOR LATER MOVE AC1,AC2 ;GET DATE IDIVI AC1,^D31 ;GET DAYS MOVE AC3,AC1 MOVEI AC1,1(AC2) ;COMPUTE DAY MOVEM AC1,@ARG5 ;STORE DAY IDIVI AC3,^D12 MOVEI AC1,1(AC4) ;GET MONTH INDEX MOVEM AC1,@ARG4 ;STORE MONTH MOVEI AC1,^D64(AC3) IDIVI AC1,^D100 MOVEM AC2,@ARG3 ;STORE YEAR OF CENTURY ;TIME POP P,AC1 IDIV AC1,[^D3600000] MOVEM AC1,@ARG6 ;STORE HOURS IDIVI AC2,^D60000 MOVEM AC2,@ARG7 ;STORE MINUTES IDIVI AC2,^D100 MOVEM AC2,@ARG8 ;STORE SECONDS GOODBY UV2BIN,, PRGEND TITLE ISIX2B - CONVERT SIXBIT TO BINARY SEARCH LIBUNV ;+ ;.INDEX ISIX2B ;.INDEX SIXBIT ;CALL: ; I=ISIX2B(J) ;WHERE: ; J IS THE SIXBIT WORD ; I IS WHERE THE BINARY FORM GOES ;ALL VARIABLES ARE INTEGER ;.PAGE ;- HELLO ISIX2B MOVE AC2,@ARG1 SETZ AC1, ;AC1 GETS SIXBIT BINARY LOOP: ROT AC2,3 ;LOSE THE FIRST BYTE ROTC AC1,3 ;GET THE BINARY PORTION JUMPN AC2,LOOP ;UNTIL NOTHING LEFT MOVE AC0,AC1 GOODBY ISIX2B PRGEND TITLE IB2SIX - CONVERTS BINARY TO SIXBIT SEARCH LIBUNV ;+ ;.INDEX IB2SIX ;.INDEX SIXBIT ;CALL: ; I=IB2SIX(J) ;WHERE: ; J IS THE BINARY NUMBER ; I IS WHERE THE SIXBIT FORMAT GOES ;N.B.: ONLY THE LOW ORDER 6 OCTAL DIGITS ; IN J ARE CONVERTED ;.PAGE ;- HELLO IB2SIX MOVE AC1,@ARG1 SETZ AC2, ;AC2 GETS THE SIXBIT MOVEI AC3,6 ;MAX CHARS TO MAKE LOOP: ROTC AC1,-3 ;GET BINARY BYTE ROT AC2,-3 ;MAKE ROOM FOR SIXBIT TLO AC2,200000 SKIPE AC1 ;DONE YET? SOJG AC3,LOOP MOVE AC0,AC2 GOODBY IB2SIX PRGEND TITLE NODENM - GET THE NAME OF A NETWORK NODE SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.INDEX NODENM ;.INDEX NODE NAME ;CALL: ; I=NODENM(J) ;WHERE: ; J IS THE NODE NUMBER ; I IS WHERE THESIXBIT NODE NAME IS RETURNED, ; OR 0 IF THE NODE NUMBER IS INVALID. ;.PAGE ;- HELLO NODENM MOVE AC1,@ARG1 MOVEM AC1,ARGBLK+1 ;POSITION NODE NUMBER MOVE AC1,[.NDRNN,,ARGBLK] NODE. AC1, SETZ AC1, ;BAD NODE NUMBER MOVE AC0,AC1 GOODBY NODENM ARGBLK: 2 ;NUMBER OF ARGS BLOCK 1 ;NODE # GOES HERE PRGEND TITLE CCTRAP - SUBROUTINES TO TRAP ^C FROM FORTRAN PROGS SUBTTL SUBROUTINES "CCINT" AND "CCLEAR" SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;.INDEX CCTRAP ;.INDEX CCINT ;.INDEX CCLEAR ;.PAGE ;SUBROUTINE CCINT - TRAPS ^C TO FORTRAN PROGRAM ;.SKIP 1 ;CALL IS: ; CALL CCINT($NNN) ;WHERE "NNN" IS THE STATEMENT NUMBER IN THE FORTRAN ; PROGRAM TO GOTO WHENEVER THE ^C IS TYPED ;.SKIP 4 ;SUBROUTINE CCLEAR - CLEARS ^C TRAPPING ;.SKIP 1 ;CALL IS: ; CALL CCLEAR ;- HELLO CCINT MOVE 1,ARG1 HRRM 1,INTBLK ;STORE INTERRCEPT ADDRESS MOVEI 1,INTBLK MOVEM 1,.JBINT## GOODBYE CCINT HELLO CCLEAR SETZM .JBINT## GOODBYE CCLEAR INTBLK: XWD 4,0 ;LENGTH. ADDR IS FILLED IN BY CCINT EXP ER.ICC ;TRAP ^C Z Z PRGEND TITLE ITRMOP - PERFORM TRMOP. UUO FUNCTIONS SEARCH LIBUNV,UUOSYM,MACTEN ;+ ;ITRMOP - FUNCTION TO DO TRMOP UUOS FOR FORTRAN PROGRAMS ;CALL IS: ; X=ITRMOP(IUDX,IFUNCT,ISKIP) ;WHERE: ; IUDX IS THE UDX OF THE LINE ; IFUNCT IS THE TRMOP FUNCTION CODE ; ISKIP WILL BE TRUE IF TRMOP SKIPED, ; FALSE IF IT DID NOT SKIP ;IF ERROR RET IS TAKEN FOR FUNCTIONS HAVING ONE, THEN ;"ISKIP" WILL BE FALSE, AND THE FUNCTION'S VALUE WILL ;BE THE ERROR CODE GIVEN BY THE MONITOR. ;.INDEX TRMOP ;.INDEX ITRMOP ;- HELLO ITRMOP MOVE AC0,[2,,AC2] ;POINTER FOR UUO HRRZ AC3,@ARG1 ;GET UDX MOVE AC2,@ARG2 SETO AC1, ;SET ISKIP TO .TRUE. TRMOP. AC0, SETZ AC1, ;SET FLAG TO FALSE (NO SKIP) MOVEM AC1,@ARG3 ;AND STORE INTO ISKIP GOODBYE ITRMOP ;+ ;.PAGE ;.DO INDEX ;- END