Google
 

Trailing-Edge - PDP-10 Archives - BB-F494Z-DD_1986 - 10,7/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