Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50441/lib.mac
There are no other files named lib.mac in the archive.
	UNIVERSAL	LIB

	IFNDEF	CITPPN,<CITPPN==0>	;ON FOR CIT TYPE PPN'S
	IFNDEF	.HI.,<.HI.==-1>		;DEFAULT TO HI SEG

	OPDEF	PJRST	[JRST]
	OPDEF	PJSP	[JSP]

;AC'S

	T1=1	;LIB ROUTINES USE ONLY TEMP AC'S
	T2=2
	T3=3
	T4=4
	P=17	;PDL POINTER

;RIB DEF'S

	.RBPPN==1
	.RBNAM==2
	.RBEXT==3
	.RBPRV==4
	.RBSIZ==5

	PRGEND
	TITLE	IOFAIL
	SEARCH	LIB
	ENTRY	LOOKFA,RENFA,ENTFA,TYPSPC,TYPNAM
	INTERN	ERRBLK
	EXTERN	CHROUT,STROUT,LINOUT	;TYPE OUT

IFN	.HI.,<
	TWOSEG	400000>		;HI SEG IF SPECIFIED


;PUSHJ HERE WITH RH OF T1 POINTING TO BAD EXTENDED BLOCK
;LH SHOULD HAVE CHANNEL NO. OR ADR OF OPEN BLOCK.


LOOKFA:	PUSHJ	P,STROUT
	  ASCIZ/? LOOKUP Error /
	JRST	FAIL1

RENFA:	PUSHJ	P,STROUT
	  ASCIZ/? RENAME Error /
	JRST	FAIL1

ENTFA:	PUSHJ	P,STROUT
	  ASCIZ/? ENTER Error /
;	JRST	FAIL1

FAIL1:	HRRZ	T2,.RBEXT(T1)		;GET ERROR CODE
	PUSH	P,T1
	MOVEI	T1,@ERRBLK(T2)		;POINT TO ERROR MESSAGE
	PUSHJ	P,LINOUT
	POP	P,T1
	PUSHJ	P,STROUT
	  ASCIZ/ - /
TYPSPC:	HRLM	T1,(P)			;SAVE ADR OF BLOCK
	HLRZ	T2,T1			;T2 GETS CHANNEL NO.
	CAILE	T2,17			;IS IT A CHANNEL?
	  JRST	[MOVE	T2,1(T2)	;NO, GET SIXBIT DEV
		 JRST	.+4]		;AND CONTINUE
	MOVE	T1,[1,,T2]		;1 ARG, POINT TO T2
	PATH.	T1,			;WHERE DOES CHANNEL GO?
	  JRST	FAIL2			;DON'T TYPE NULL DEVICE
	MOVE	T1,T2			;PLACE ARG WHERE WRDOUT WILL GET IT
	PUSHJ	P,WRDOUT##		;TYPE THE DEVICE
	MOVEI	T1,":"			;TYPE QUOTE
	PUSHJ	P,CHROUT		;TYPE IT
FAIL2:	HLRZ	T1,(P)
TYPNAM:	HRLM	T1,(P)			;PUT BACK IN CASE ENTERING
	HLRZ	T2,.RBEXT(T1)		;NOW GET EXTENSION
	CAIN	T2,'UFD'		;TROUBLE WITH A UFD?
	  JRST	UFDFAL			;YES, SKIP ON
	MOVE	T1,.RBNAM(T1)		;GET FILE NAME
	PUSHJ	P,WRDOUT##		;GO TYPE THE NAME
	MOVEI	T1,"."			;TYPE DOT
	PUSHJ	P,CHROUT
	HLRZ	T1,(P)			;RESTORE POINTER
	HLLZ	T1,.RBEXT(T1)		;RECOVER EXTENSION
	PUSHJ	P,WRDOUT##		;AND TYPE THAT
	HLRZ	T1,(P)			;RESTORE POINTER
	MOVE	T1,.RBPPN(T1)		;GET THE PPN
	PUSHJ	P,PPNOUT##		;TYPE THE PPN
	PJRST	TCRLF##			;TYPE CRLF AND RETURN

UFDFAL:	HLRZ	T1,(P)			;RESTORE POINTER
	MOVE	T1,.RBNAM(T1)		;GET NAME
	PUSHJ	P,PPNOUT##		;TYPE FILE NAME
	JSP	T1,LINOUT		;PJSP TO TYPE FINNISH AND RETURN
	  ASCIZ/.UFD
/
ERRBLK:	[ASCIZ/(0) not found/]
	[ASCIZ/(1) no such UFD/]
	[ASCIZ/(2) protected/]
	[ASCIZ/(3) file being modified/]
	[ASCIZ/(4) file already exists/]
	[ASCIZ/(5) illegal sequence of UUO's/]
	[ASCIZ/(6) read error/]
	Z
	Z
	Z
	Z
	Z
	[ASCIZ/(14) no room/]
	[ASCIZ/(15) write-locked/]
	[ASCIZ/(16) monitor quits/]
	[ASCIZ/(17) partial allocation/]
	[ASCIZ/(20) block not free on allocated position/]
	[ASCIZ/(21) can't supersede directory/]
	[ASCIZ/(22) can't delete directory/]
	[ASCIZ/(23) SFD not found/]
	[ASCIZ/(24) search list empty/]
	[ASCIZ/(25) SFD nesting too deep/]
	[ASCIZ/(26) write-locked/]
	Z

	PRGEND
	TITLE	PPNOUT
	SEARCH	LIB
	ENTRY	PPNOUT
	EXTERN	CHROUT,LINOUT,STROUT	;TYPE OUT
;THIS ROUTINE TYPES OUT A CALTECH TYPE PPN
;GIVE PPN IN T1

IFN	.HI.,<
	TWOSEG>		;HI SEG

$SFDCN:	BLOCK	1
$SFDPT:	BLOCK	1

IFN	.HI.,<
	RELOC	400000>	;CODE IN HI SEG

PPNOUT:	SETZ	T2,		;NO SFD'S YET
	TLNE	T1,-1		;POINTER TO PATH LIST?
	  JRST	PPNOT1		;NO, SKIP ON
	MOVNI	T2,5		;YES -- SET UP SFD COUNTER
	ADDI	T1,2		;POINT TO START OF PATH LIST
	MOVEM	T1,$SFDPT	;AND SAVE POINTER
	MOVE	T1,(T1)		;GET REAL PPN
PPNOT1:	MOVEM	T2,$SFDCN	;AND SAVE COUNT
	HRLM	T1,(P)		;SAME PROGRAMMER NO.
	PUSHJ	P,STROUT
	  ASCIZ/[/
	HLRZS	T1		;PROJECT NO. ONLY
IFN CITPPN,<	PUSHJ	P,DECOUT##	;GIVE DECIMAL>
IFE CITPPN,<	PUSHJ	P,OCTOUT##	;GIVE IT>
	MOVEI	T1,","		;COMMA OUT
	PUSHJ	P,CHROUT
	HLRZ	T1,(P)		;GET PROGRAMMER NO.
IFN CITPPN,<	PUSHJ	P,R64OUT##	;RADIX 64 IS NICE>
IFE CITPPN,<	PUSHJ	P,OCTOUT##	;HOW DRAB>

SFDOUT:	AOS	$SFDPT		;INCREMENT POINTER
	AOSLE	$SFDCN		;AND LEVEL COUNTER
	  JRST	PPNDON		;TOO MANY -- QUIT
	MOVE	T1,@$SFDPT	;GET SFD NAME
	JUMPE	T1,PPNDON	;DONE IF NULL
	PUSHJ	P,STROUT	;TYPE COMMA
	  ASCIZ/,/
	PUSHJ	P,WRDOUT##	;TYPE IT
	JRST	SFDOUT		;LOOP FOR MORE

PPNDON:	JSP	T1,LINOUT	;PJSP TO FINISH UP
	  ASCIZ/]/

	PRGEND
	TITLE	TYPVER
	SEARCH	LIB
	ENTRY	TYPVER

IFN	.HI.,<
	TWOSEG	400000>

;THIS ROUTINE TYPES OUT A VERSION GIVEN IN T1

TYPVER:	PUSH	P,T1		;SAVE VERSION
	LSH	T1,-^D24	;GET MAJOR VERSION
	ANDI	T1,777		;ELIMINATE GARBAGE
	SKIPE	T1		;IF ANYTHING TO TYPE
	  PUSHJ	P,OCTOUT##	;THEN TYPE IT
	HLRZ	T1,(P)		;GET MINOR VERSION
	ANDI	T1,77		;ELIMINATE GARBAGE
	JUMPE	T1,TYPVR2	;JUMP IF NONE
	SOJ	T1,		;
	IDIVI	T1,^D26		;
	JUMPE	T1,TYPVR1	;JUMP IF NONE
	MOVEI	T1,"A"-1(T1)	;GET LETTER
	PUSHJ	P,CHROUT##	;SEND IT
TYPVR1:	MOVEI	T1,"A"(T2)	;AGAIN
	PUSHJ	P,CHROUT##	;SEND
TYPVR2:	HRRZ	T1,(P)		;RECOVER
	JUMPE	T1,TYPVR3	;JUMP IF NONE
	PUSHJ	P,STROUT##	;PAREN
	  ASCIZ/(/
	PUSHJ	P,OCTOUT##	;OCTAL
	MOVEI	T1,")"		;CLOSE
	PUSHJ	P,CHROUT##	;SEND
TYPVR3:	POP	P,T1		;RESTORE T1
	LSH	T1,-^D33	;CUSTOMER VERSION
	JUMPE	T1,CPOPJ##	;RETURN IF NONE
	PUSHJ	P,STROUT##	;PREFIX
	  ASCIZ/-/
	PJRST	OCTOUT##	;TYPE THE DIGIT AND RETURN

	PRGEND
	TITLE	TYPDAT
	SEARCH	LIB
	ENTRY	TYPDAT

IFN	.HI.,<
	TWOSEG	400000>	;HI SEG

;THIS ROUTINE TYPES OUT DATE GIVEN IN T1
;DESTROYS T1,T2,T3

TYPDAT:	IDIVI	T1,^D31		;GET DAY - 1 IN T2
	HRLM	T1,(P)		;SAVE THE REST
	MOVEI	T1," "		;SET UP LEADING SPACE
	CAIGE	T2,^D9		;SEE IF DATE IS LESS THAN 10
	  PUSHJ	P,CHROUT##	;YES, TYPE LEADING SPACE
	MOVEI	T1,1(T2)	;GET DAY IN T1
	PUSHJ	P,DECOUT##	;TYPE IT
	MOVEI	T1,"-"		;DASH
	PUSHJ	P,CHROUT##	;TYPE IT
	HLRZ	T2,(P)		;RESTORE DATA
	IDIVI	T2,^D12		;GET MONTH IN T3, YEAR IN T2
	MOVEI	T1,MONTAB(T3)	;GET ASCIZ MON- PTR IN T1
	PUSHJ	P,LINOUT##	;TYPE IT
	MOVEI	T1,^D64(T2)	;GET YEAR IN T1
	JRST	DECOUT##	;(PJRST) TYPE IT AND RETURN

MONTAB:	ASCIZ/Jan-/
	ASCIZ/Feb-/
	ASCIZ/Mar-/
	ASCIZ/Apr-/
	ASCIZ/May-/
	ASCIZ/Jun-/
	ASCIZ/Jul-/
	ASCIZ/Aug-/
	ASCIZ/Sep-/
	ASCIZ/Oct-/
	ASCIZ/Nov-/
	ASCIZ/Dec-/

	PRGEND
	TITLE	OPNDEV
	SEARCH	LIB
	ENTRY	OPNDEV
	EXTERN	LINOUT,STROUT

	TY.RAS==1B29	;RESTRICTED DEVICE
IFN	.HI.,<
	TWOSEG	400000>	;HI SEG

;THIS ROUTINE OPENS A DEVICE ON A GIVEN CHANNEL
;ARGUMENTS ARE GIVEN IN T1
;THE LH OF T1 CONTAINS THE CHANNEL NO. TO OPEN
;THE RH HAS THE ADDRESS OF THE OPEN BLOCK
;SKIP RETURN IF SUCCESSFUL, NON-SKIP IF NOT

OPNDEV:	HLRZ	T2,T1			;RECOVER THE CHANNEL NO.
	HRLI	T1,(OPEN)		;SET UP THE OPEN INSTR
	DPB	T2,[POINT 4,T1,12]	;PUT IN PROPER CHANNEL NO.
	XCT	T1			;DO THE OPEN
	  SKIPA	T1,1(T1)		;CAN'T -- GET DEVICE IN T1
	JRST	CPOPJ1##		;GOOD RETURN

BADOPN:	PUSHJ	P,STROUT		;TYPE ERROR
	  ASCIZ/? Can't open device /
	PUSH	P,T1			;SAVE IT AWAY
	PUSHJ	P,WRDOUT##		;AND TYPE IT
	POP	P,T1			;WHAT DEVICE WAS THAT?
	DEVTYP	T1,			;MORE INFO ABOUT IT
	  PJRST	TCRLF##			;I DUNNO
	JUMPN	T1,BAD1			;JUMP IF IT EXISTS
	JSP	T1,LINOUT		;TYPE REASON
	  ASCIZ/, device does not exist
/

BAD1:	TRNN	T1,TY.RAS		;WAS IT RESTRICTED?
	  JRST	BAD2			;NO, NOT THE PROBLEM
	JSP	T1,LINOUT		;PJSP -- TYPE REASON
	  ASCIZ/, device is restricted
/

BAD2:	LDB	T1,[POINT 9,T1,26]	;GET THE JOB THAT'S GOT IT
	JUMPE	T1,TCRLF##		;NO JOB HAS IT!
	PUSHJ	P,STROUT		;TELL JOB
	  ASCIZ/, in use by job /
	PUSHJ	P,DECOUT##		;BY THIS S.O.B.
	PJRST	TCRLF##			;TYPE CRLF AND RETURN
	PRGEND
	TITLE	NUMOUT
	SEARCH	LIB
	ENTRY	DECOUT,OCTOUT,R64OUT,NUMOUT
	EXTERN	CHROUT,STROUT		;CHARACTER OUTPUT

;TYPES ON THE TTY THE NUMBER GIVEN IN T1.  NO SKIP RETURN

IFN	.HI.,<
	TWOSEG	400000>	;HI SEG

R64OUT:	MOVEI	T3,70
	JRST	NUMOT1

OCTOUT:	TDZA	T3,T3		;ZERO T3 AND SKIP -- OCTAL OUTPUT

DECOUT:	MOVEI	T3,2		;DECIMAL
NUMOUT:	JUMPGE	T1,NUMOT1	;IF POSITIVE, JUST SKIP ON
	PUSHJ	P,STROUT	;OUTPUT SIGN
	  ASCIZ/-/
	MOVNS	T1		;AND GET POSITIVE VALUE
NUMOT1:	IDIVI	T1,10(T3)
	HRLM	T2,(P)		;SAVE REMAINDER ON STACK
	SKIPE	T1		;SKIP IF DONE WITH DIVISION
	PUSHJ	P,NUMOT1	;BE RECURSIVE
	HLRZ	T1,(P)		;RECOVER FROM STACK
	ADDI	T1,"0"		;MAKE ASCII
	JRST	CHROUT		;PJRST -- TYPE IT AND GET NEXT

	PRGEND
	TITLE	WRDOUT
	SEARCH	LIB
	ENTRY	WRDOUT
	EXTERN	CHROUT
;THIS ROUTINE TYPE ON THE TTY A SIXBIT WORD
;GIVE THE WORD IN T1, TEMPORARY AC'S ARE USED
;THE WORD IF TYPED UP TO THE LAST NON-BLANK CHARACTER, TRAILING SPACES
;ARE NOT TYPED

IFN	.HI.,<
	TWOSEG	400000>	;HI SEG


WRDOUT:	SKIPN	T2,T1		;GET ARG, IF ANY
	  POPJ	P,		;NONE, JUST RETURN
WRD1:	SETZ	T1,		;CLEAR SPACE
	LSHC	T1,6		;GET A CHAR
	ADDI	T1,40		;MAKE ASCII
	PUSHJ	P,CHROUT	;TYPE IT
	JUMPN	T2,WRD1		;RETURN IF MORE
	POPJ	P,		;DONE

	PRGEND
	TITLE	SIXOUT
	ENTRY	SIXOUT
	SEARCH	LIB

;HERE TO TYPE THE SIXBIT WORD IN T1
;WHOLE WORD IS TYPED, EVEN IF TRAILING SPACES

	IFN .HI.,<TWOSEG 400000>

SIXOUT:	MOVE	T2,T1		;SAVE
	MOVEI	T3,6		;SIX LOOPS
SIXOT1:	SETZ	T1,		;CLEAR
	LSHC	T1,6		;NEXT CHAR
	MOVEI	T1,"0"-'0'(T1)	;MAKE SIXBIT TO ASCII
	PUSHJ	P,CHROUT##	;TYPE
	SOJG	T3,SIXOT1	;LOOP
	POPJ	P,		;RETURN

	PRGEND
	TITLE	TCRLF
	ENTRY	TCRLF	;TYPE CRLF
	SEARCH	LIB

	IFN .HI.,<TWOSEG 400000>

TCRLF:	PUSHJ	P,STROUT##	;TYPE STRING
	  ASCIZ/
/
	POPJ	P,		;AND RETURN

	PRGEND
	TITLE	CHROUT
	SEARCH	LIB
	ENTRY	CHROUT,STROUT,LINOUT
	INTERN	OUTADR

IFN	.HI.,<
	TWOSEG>		;HI SEG


;OUTPUT ROUTINES.  THESE WILL BE OUTCHRS UNLESS THE USER HAS
;SET UP HIS OWN OUTPUT ROUTINE.  IN THIS CASE, THE WORD OUTADR
;SHOULD BE LOADED WITH THE ADDR OF THE USER'S CHARACTER OUTPUT
;ROUTINE.  CHARACTERS WILL BE FED INTO AC 1, AND NO AC'S SHOULD BE
;CHANGED BY USER'S ROUTINE

OUTADR:	BLOCK	1

IFN	.HI.,<
	RELOC	400000>	;CODE IN HI SEG

;HERE TO TYPE OUT A SINGLE CHARACTER
;CALL IS 	MOVEI	T1,"X"
;		PUSHJ	P,CHROUT
;NO AC'S TOUCHED

CHROUT:	SKIPE	OUTADR		;ANY USER SUPPLIED ROUTINE?
	  JRST	@OUTADR		;(PJRST) YES, GO THERE
	OUTCHR	T1		;NO, JUST TYPE IT
	POPJ	P,		;AND RETURN


;HERE TO TYPE OUT AN ASCII STRING
;CALL IS	PUSHJ	P,STROUT
;		 ASCIZ/STRING/
;CONTROL RETURNED TO WORD FOLLOWING STRING.  NO AC'S HARMED

STROUT:	PUSH	P,T1		;SAVE AN AC
	SKIPE	OUTADR		;USER SUPPLIED ROUTINE?
	  JRST	STR2		;YES, SKIP ON
	OUTSTR	@-1(P)		;NO, WE TYPE IT OURSELVES
	MOVEI	T1,376		;SET ALL SEVEN BITS, LIKE ASCII
STR1:	TDNN	T1,@-1(P)	;DONE WITH STRING?
	  JRST	TPOPJ1##	;YES, DONE
	AOS	-1(P)		;NO, INCREMENT PDL
	JRST	STR1		;AND TRY AGAIN

STR2:	MOVEI	T1,(POINT 7,0)	;SET UP BYTE POINTER FOR ASCII
	HRLM	T1,-1(P)	;PUT ON STACK
STR3:	ILDB	T1,-1(P)	;GET A CHAR
	JUMPE	T1,TPOPJ1##		;EXIT IF DONE
	PUSHJ	P,@OUTADR	;CALL OUTPUT ROUTINE
	JRST	STR3		;AND GET NEXT
;HERE TO TYPE OUT AN ASCII STRING
;CALL IS	MOVEI	T1,[ASCIZ/STRING/]
;		PUSHJ	P,LINOUT
;AC 1 IS DESTROYED

LINOUT:	SKIPE	OUTADR		;USER SUPPLIED ROUTINE?
	  JRST	LIN1		;YES, SKIP ON
	OUTSTR	(T1)		;NO, JUST TYPE IT
	POPJ	P,		;AND RETURN

LIN1:	HRLI	T1,(POINT 7,0)	;MAKE T1 A BYTE POINTER
	PUSH	P,T1		;SAVE ON STACK
LIN2:	ILDB	T1,(P)		;GET A CHAR
	JUMPE	T1,TPOPJ##		;EXIT IF DONE
	PUSHJ	P,@OUTADR	;CALL USER
	JRST	LIN2		;AND LOOP

	PRGEND
	TITLE	CPOPJ
	SEARCH	LIB
	ENTRY	TPOPJ1,TPOPJ,CPOPJ1,CPOPJ
;HERE FOR SKIP OR NON-SKIP RETURN TO POPJ

IFN	.HI.,<
	TWOSEG	400000>	;HI SEG

TPOPJ1:	AOSA	-1(P)
CPOPJ1:	AOSA	(P)
TPOPJ:	POP	P,T1
CPOPJ:	POPJ	P,

IF2	<PRINTX	DELETE LIB.UNV!>
	END