Trailing-Edge
-
PDP-10 Archives
-
BB-FP64A-SB_1986
-
10,7/track/libfor.mac
There are 4 other files named libfor.mac in the archive. Click here to see a list.
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,<PRINTX NESTED CALLS TO HELLO: NAME
END
>>
..NEST==1
ENTRY NAME
SIXBIT/NAME/
NAME:
IFNB <SAVCOD>,<PUSHJ P,SAVCOD>
IFNB <ACLIST>,
<IRP ACLIST,<
PUSH P,ACLIST
>>
>;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,<PRINTX GOODBY WITHOUT HELLO: NAME
END>
IFN ..NEST-1,<PRINTX GOODBY WITHOUT HELLO: NAME
END>
..NEST==..NEST-1
IFNB <RSTCOD>,<PUSHJ P,RSTCOD>
IFNB <ACLIST>,<
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,,<AC2,AC3,AC4>
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,,<AC4,AC3,AC2>
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,,<AC2,AC3,AC4>
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,,<AC4,AC3,AC2>
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,,<AC1,AC2,AC3,AC4>
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,,<AC4,AC3,AC2,AC1>
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