PDP-10 Archive: 10,7/unscsp/factor/factor.mac from scratch

Trailing-Edge - PDP-10 Archives - scratch - 10,7/unscsp/factor/factor.mac

There are 7 other files named factor.mac in the archive. Click here to see a list.

	SUBTTL	Try DAEMON first, then try FACT.SYS, FACT.X01 ... FACT.X77

;COPYRIGHT (C) 1969, 1974, 1979, 1980, 1984 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND 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.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH	MACTEN,UUOSYM,LGNUNV

	SALL
	.DIREC	FLBLST

	FCTVER==1		;MAJOR VERSION NUMBER
	FCTMIN==1		;MINOR VERSION NUMBER
	FCTEDT==11		;EDIT NUMBER
	FCTWHO==0		;WHO LAST EDITED
	%%FCTR==FCTVER		;VERSION

	TITLE.	(FCT,FACTOR,<Routine to append entries to FACT.SYS>)
	FCTTTL
	FCTPTX

	TWOSEG

	RELOC	400000		;GOES IN HIGH SEGMENT

.BCOPY
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1969,1984.
.ECOPY

	ENTRY	.FACTR		;ONLY ENTRY POINT

;SUBROUTINE TO APPEND AN ENTRY TO A FILE IN THE ACCOUNTING SYSTEM.
; THIS ROUTINE FIRST ATTEMPTS TO APPEND TO THE FILE NAMED FACT.SYS, BUT IF THIS FILE
; IS UNAVAILABLE, THEN FILES NAMED FACT.X01, FACT.X02,..., FACT.X77 WILL BE ATTEMPTED
; IN THAT ORDER, AND AN ERROR MESSAGE PRINTED ONLY IF ALL SUCH FILES ARE UNAVAILABLE.

;AC ASSIGNMENTS

	T1=1
	T2=2
	T3=3
	T4=4
	B=5		;BASE REGISTER FOR LOW SEGMENT
	P2=6
	N=7
	M=13
	P=17	 	;PUSH-DOWN POINTER

	SUBTTL	Edit history

;1)	(QAR 10-00704) PICK UP CORRECT ENTER CODE, ALLOCATE
;	ENOUGH SPACE FOR ENTER BLOCK

;2)	OPEN DEVICE STD INSTEAD OF SYS TO PREVENT /NEW CONFUSION

;3)	CHANGE NAME OF ENTRY POINT TO .FACTR TO CONFORM TO DEC
;	STANDARD FOR ENTRY POINT NAMES

;4)	(SPR 10-26315) If a FACT file exists on a full structure and
;	DAEMON is not running the date of the FACT file may get changed
;	to 5-Jan-75 or undated depending on the edit level of the
;	monitor. /EGF 18-May-79

;5)	Search MACTEN and UUOSYM instead of C.
;	/EGF 17-Oct-79

;6)	Generate symbols for Major Version, Minor Version, Edit, and
;	Who and use a macro to generate the Title line so as to
;	include the version and edit numbers. /EGF 17-Oct-79
;7)	/BAH 29-April-80 QAR 10-03781 DETFLG is referenced without indexing
;	by B, destroying a random word in the low segment if the job is
;	detached and DAEMON is not running.
;10)	(SPR 10-28831)/FRS 29-April-80 check to see if job you are trying
;	to attach to is DAEMON and is [1,2].  If so, skip trying to write
;	FACT entry.
;
;11)	29-Sep-83 /DPM
;	.CLNAM macro has bugs.  Remove it and use TITLE. from MACTEN.
;

;SOFTWARE CHANNELS

	FCT=6

;PARAMETERS

	TRANSZ==10		;MAXIMUM SIZE OF ENTRY
	DAEMSW==1		;TRY USING DAEMON FIRST

;
;CALLING SEQUENCE:
;		MOVE P2,[XWD SIZE,ADDRESS] ;POINTER TO ENTRY TO BE APPENDED.
;		PUSHJ P,.FACTR
;		RETURNS HERE IN ANY EVENT.
;

	SUBTTL	Low segment definitions

;MACRO TO DEFINE LOW SEGMENT LOCATIONS

	DEFINE	LBLOCK(SYMBOL,SIZE),<
	SYMBOL==..LOC
	..LOC==..LOC+SIZE
	>

	..LOC==0

LBLOCK	FCTBUF,200+TRANSZ+1	;DISK I/O BUFFER
LBLOCK	SECBUF,.RBSIZ+1	;[1] LOOKUP/ENTER BLOCK
LBLOCK	FCTBLK,TRANSZ	;TRANSACTION ENTRY
LBLOCK	ILIST,2		;I/O COMMAND LIST
LBLOCK	OLIST,2		;I/O COMMAND LIST
LBLOCK	DETFLG,1	;-1 IF DETACHED
LBLOCK	SYSPPN,1	;SYS: PPN
LBLOCK	APPEXT,1	;NEXT EXTENSION TO TRY
LBLOCK	TRYCTR,1	;COUNTER OF NO. OF TIMES TO TRY

	LOSGSZ==..LOC	;SIZE OF LOW SEGMENT

	PURGE	..LOC

	SUBTTL	Try DAEMON first, then try FACT.SYS ... FACT.X77

.FACTR::PUSHJ	P,SAVER		;SAVE REGISTERS AND ALLOCATE CORE
	PUSH	P,P2		;SAVE P2 FOR A MINUTE
	IFN DAEMSW,<		;IF USING DAEMON
	TLNN	F,FL.ATT	;[10] DOING AN ATTACH?
	JRST	FACTR0		;[10] NO, SKIP THIS
	MOVEI	T1,.GTPRG	;[10] GETTAB PROGRAM NAME
	HRL	T1,ATTJOB##	;[10] OF JOB FOR ATTACH
	GETTAB	T1,		;[10] DO IT
	JRST	FACTR0		;[10] SHOULD NEVER HAPPEN 
	CAME	T1,[SIXBIT/DAEMON/]	;[10] IS IT DAEMON?
	JRST	FACTR0		;[10] NO, WRITE FACT ENTRY
	MOVE	T1,PPN##	;[10] GET OUR PPN
	CAMN	T1,ALPPPN##	;[10] GOOD PPN?
	JRST	NODAEM		;[10] YES, DON'T TRY TO WRITE FACT ENTRY
FACTR0:	HLRE	T2,P2		;GET LENGTH IN B
	SOJ	P2,		;BACK UP POINTER
	MOVMS	T2		;POS LENGTH
	HRLI	P2,1(T2)	;LEN INCLUDING DAEMON FUN IN LEFT HALF
	MOVEI	T2,.FACT	;SPECIFY FACT FUNCTION
	MOVEM	T2,0(P2)	;IN DAEMON REQUEST BLOCK
	DAEMON	P2,		;ASK DAEMON TO WRITE FACT FILE
	  JRST	NODAEM		;DAEMON NOT RUNNING, OR FAILED
	POP	P,P2		;CORRECT STACK
	JRST	APPXIT		;MADE IT, TAKE THE EASY WAY
	>			;END IFN DAEMSW
NODAEM:	POP	P,P2		;RESTORE P2
	GETLIN	T1,		;SEE IF WE'RE DETACHED
	TLNN	T1,-1		;ARE WE?
	  SETOM	DETFLG(B)	;YES - REMEMBER THE FACT
	MOVX	T1,%LDSYS	;MAGIC NUMBER FOR SYS PPN
	GETTAB	T1,		;GET IT
	  MOVE	T1,[1,,4]	;DEFAULT
	MOVEM	T1,SYSPPN(B)	;STORE IN LOW SEGMENT
	MOVEI	T2,(SIXBIT /SYS/)	;TRY FACT.SYS FIRST.

APPLUP:	PUSH	P,T2		;SAVE LAST EXTENSION TRIED.
APPLP1:	MOVSS	T2		;SET UP ACCUMULATORS FOR APPNDF
	PUSHJ	P,APPNDF	;TRY TO APPEND ENTRY
	JRST	APPERR		;ERROR ON THAT FILE--TRY NEXT.
	JRST	APPBZY		;TRANSACTION FILE BUSY--TRY ANOTHER.
	POP	P,T2		;NORMAL EXIT--FILE SUCCESSFULLY UPDATED.
APPXIT:	POPJ	P,		;*** SUBROUTINE EXIT. ***

APPERR:	POP	P,T2		;NON-RECOVERABLE ERROR--TRY NEXT FILE.
	CAIN	T2,(SIXBIT /SYS/)	;WAS .SYS THE LAST EXTENSION ATTEMPTED?
	MOVEI	T2,(SIXBIT /X00/)	;YES, TRY .X01 NEXT.
APPERB:	CAIN	T2,(SIXBIT /X77/)	;NO, TRIED ALL 64 POSSIBLE FILES ?
	JRST	APPLUZ		;YES, GIVE UP.
	ADDI	T2,1		;NO, TRY NEXT FILE IN SEQUENCE.
	TRNN	T2,7		;CARRY INTO SECOND DIGIT ?
	ADDI	T2,100-10	;YES, CAUSE SIXBIT CARRY.
	JRST	APPLUP		;TRY AGAIN.

APPBZY:	POP	P,T2		;SPECIFIED FILE WAS BUSY--GET ITS EXTENSION.
	CAIE	T2,(SIXBIT /SYS/)	;WAS IT .SYS ?
	JRST	APPERB		;NO, GO TRY NEXT FILE IN SEQUENCE.
	PUSHJ	P,DELAYM	;YES, INFORM USER OF DELAY.
	PUSH	P,[SIXBIT /   X00/]	;TRY .SYS TWICE JUST TO BE SURE.
	JRST	APPLP1

	SUBTTL	Error messages

DELAYM:	JSP	M,MSG		;TELL USER TO BE PATIENT IF DELAY OCCURS.
	ASCIZ	/%FCTWAT Wait please . . .
/


APPLUZ:	MOVEI	M,APPLZM	;IN THE UNLIKELY EVENT THAT ALL FACT FILES
	PUSHJ	P,MSG		; ARE INACCESSIBLE, TELL USER TO GET HELP.
	JRST	APPXIT

APPLZM:	ASCIZ	/?FCTASF Accounting system failure....
?FCTCTO Please call the Operator.
/

	SUBTTL	Routine to try FACT.xxx, xxx in T2

;SUBROUTINE TO APPEND A TRANSACTION ENTRY TO THE END OF THE ACCOUNTING FILE
; (NORMALLY, THIS IS THE FILE NAMED FACT.SYS, BUT THE EXTENSION IS A PARAMETER
; SUPPLIED TO THIS SUBROUTINE SO THAT IF FACT.SYS BECOMES FOULED UP, AN ENTRY
; MAY BE APPENDED TO AN ALTERNATE FACT.XXX FILE.)

;CALLING SEQUENCE:
;	MOVSI T2,(SIXBIT /EXT/)   ;DESIRED EXTENSION FOR FACT FILE (NORMALLY .SYS)
;	MOVE P2,[XWD  -SIZE,ADDRESS]	;POINTER TO ENTRY TO BE APPENDED
;	PUSHJ P,APPNDF
;	NON-RECOVERABLE ERROR RETURN -- CAN'T APPEND TO FILE.
;	BUSY ERROR RETURN -- FILE HAS BEEN BUSY EVERY HALF-SECOND FOR TEN SECONDS.
;	NORMAL RETURN -- ENTRY HAS BEEN SUCCESSFULLY APPENDED TO THE FILE.


APPNDF:	MOVEM	T2,APPEXT(B)	;SAVE REQUESTED EXTENSION 
	MOVEI	N,^D20
	MOVEM	N,TRYCTR(B)	;SET NUMBER OF TIMES TO TRY IF BUSY.
	INIT	FCT,17		;OPEN SOFTWARE I/O CHANNEL FOR FACT FILE
	SIXBIT	/STD/		;[2]  IN DUMP MODE.
	0
	JSP	N,APPNDR	;IMMEDIATE ERROR RETURN IF CAN'T GET DEVICE SYS.

APPNDL:	PUSHJ	P,CLRRIB	;[4] CLEAR LOOKUP/ENTER BLOCK AND
				;[4]  SET UP .RBCNT
	MOVE	T1,[SIXBIT /FACT/]
	MOVEM	T1,SECBUF+.RBNAM(B) ;[4] PUT FILE NAME IN BLOCK
	MOVE	T2,APPEXT(B)
	MOVEM	T2,SECBUF+.RBEXT(B) ;[4] PUT EXTENSION IN BLOCK
;[4]	MOVEI	T3,0
	MOVE	T4,SYSPPN(B)
	MOVEM	T4,SECBUF+.RBPPN(B) ;[4] PUT PPN IN BLOCK
;[4]	LOOKUP	FCT,T1		;ATTEMPT TO OPEN FACT FILE FOR READING.
	LOOKUP	FCT,SECBUF(B)	;[4] ATTEMPT TO OPEN THE FACT FILE
				;[4]  FOR READING.
	JRST	APPNDN		;LOOK-UP FAILED--PERHAPS FILE DOESN'T EXIST.

	SUBTTL	Routine to write the accounting data

	PUSHJ	P,APPNDE	;ATTEMPT TO GRAB THE FACT FILE.
	MOVE	N,SECBUF+.RBSIZ(B)	;GET LENGTH OF FILE IN WORDS
	ROT	N,-7
	ADDI	N,1		;COMPUTE LAST BLOCK NUMBER WITHIN THE FACT FILE.
	HRRZM	N,FCTBLK(B)	;SAVE IT FOR USETI AND USETO.
	ROT	N,7
	ANDI	N,177		;N NOW HAS RELATIVE DEPTH (0-127) OF
	SOS	N
	ADD	N,B		;ADD IN ADDRESS OF LOW CORE
	USETI	FCT,@FCTBLK(B)	;LAST WORD IN LAST BLOCK.
	MOVE	T1,[IOWD 200,FCTBUF]
	ADD	T1,B		;ADD OFFSET INTO LOW SEG
	MOVEM	T1,ILIST(B)	;SET UP IOLIST
	SETZM	ILIST+1(B)
	INPUT	FCT,ILIST(B)	;READ LAST BLOCK OF FACT FILE INTO DUMP BUFFER.
	STATZ	FCT,740000
	JSP	N,APPNDR	;ERROR OR EOF WILL YIELD ERROR RETURN.

APPNDA:	MOVS	T1,FCTBUF(N)	;GET LAST WORD OF CURRENT FACT FILE.
	CAIN	T1,777000	;END-OF-FILE ENTRY ?
	JRST	APPNDB		;YES, THINGS ARE LOOKING GOOD.
	SKIPN	T1		;NO, FACT FILE SCREWED UP!  IS LAST WORD NON-ZERO ?
	TRNN	N,-1		;OR IS THIS THE FIRST WORD OF A 200-WORD BLOCK ?
	JSP	N,APPNDR	;YES TO EITHER QUESTION. TAKE ERROR EXIT.
	SUB	N,[XWD 1,1]	;TRY BACKING UP OVER ZERO WORDS ATTEMPTING TO FIND
	JRST	APPNDA		; THE END-OF-FILE ENTRY.

APPNDB:	TLNN	N,-1		;WAS END-OF-FILE ENTRY WHERE IT WAS SUPPOSED TO BE ?
	JRST	APPNDC		;YES, PROCEED.
	MOVE	T1,[XWD 377000,1]	;NO, FILL WITH DUMMY ONE-WORD ENTRIES TO
	MOVEM	T1,FCTBUF(N)	; SHOW WHERE DATA LOSS MAY HAVE OCCURED.
	AOBJN	N,.-1

APPNDC:	MOVE	T1,0(P2)	;PICK UP ENTRY AS SPECIFIED IN CALLING SEQUENCE.
	MOVEM	T1,FCTBUF(N)	;STORE IN FACT FILE OUTPUT BUFFER.
	ADDI	N,1
	AOBJN	P2,APPNDC
	MOVSI	T1,777000	;LAY DOWN END-OF-FILE ENTRY AGAIN.
	MOVEM	T1,FCTBUF(N)
	SUB	N,B		;RESTORE WORD COUNT
	SETCA	N,0		;(IN PLACE OF AOS N, MOVNS N)
	HRLM	N,OLIST(B)	;STORE CORRECT NUMBER OF WORDS TO BE WRITTEN.
	MOVEI	N,FCTBUF-1(B)	;START OF IO WORD
	HRRM	N,OLIST(B)
	SETZM	OLIST+1(B)
	USETO	FCT,@FCTBLK(B)
	OUTPUT	FCT,OLIST(B)	;OUTPUT UPDATED FACT FILE.
	STATZ	FCT,740000
	JSP	N,APPNDR	;ERROR OR EOF WILL YIELD ERROR EXIT.
	AOS	0(P)		;DOUBLE SKIP EXIT
FCTBSY:	AOS	0(P)		;SINGLE SKIP EXIT

;THIS ROUTINE IS CALLED WITH ERROR PC IN N
APPNDR:	RELEASE	FCT,0		;RELEASE FACT FILE'S CHANNEL.
	POPJ	P,		;*** SUBROUTINE EXIT .***

	SUBTTL	ENTER FACT.SYS, sleep if busy

APPNDE:	;[4] PUSHJ	P,CLRRIB	;CLEAR EXTENDED ENTER BLOCK
	MOVE	T1,[SIXBIT /FACT/]
	MOVEM	T1,SECBUF+.RBNAM(B)
	MOVE	T1,APPEXT(B)	;EXTENSION TO TRY FOR
;[4]	MOVEM	T1,SECBUF+.RBEXT(B)
	HLLM	T1,SECBUF+.RBEXT(B) ;[4] PUT THE EXTENSION IN AND
				    ;[4]  DO NOT DISTURB THE DATE
	MOVX	T1,%LDSSP	;GETTAB PROTECTION CODE
	GETTAB	T1,		;FOR .SYS FILES
	  MOVSI	T1,(157B8)
	MOVX	T2,777B8	;[4] CLEAR THE
	ANDCAM	T2,SECBUF+.RBPRV(B) ;[4] PROTECTION FIELD
;[4]	MOVEM	T1,SECBUF+.RBPRV(B)
	IORM	T1,SECBUF+.RBPRV(B) ;[4] PUT THE PROTECTION IN
	MOVE	T1,SYSPPN(B)	;SYS: PPN
	MOVEM	T1,SECBUF+.RBPPN(B)
;[4]	MOVEI	T1,.RBSIZ	;NO. OF ARGUMENTS WE WANT
;[4]	MOVEM	T1,SECBUF+.RBCNT(B)	;PUT IN ENTER BLOCK HEADER
	ENTER	FCT,SECBUF(B)	;TRY THE ENTER
	 SKIPA
	  POPJ	P,		;**GOOD EXIT. THE FACT FILE IS OPEN FOR WRITING.**
	POP	P,N		;CORRECT PUSH-DOWN STACK.
	HRRZ	N,SECBUF+.RBEXT(B)	;[1] GET ERROR CODE

	CAIE	N,ERFBM%	;FILE BEING MODIFIED?
	JSP	N,APPNDR	;ANY OTHER ERROR CODE LOSES.
	MOVEI	N,1
	SLEEP	N,		;TRY AGAIN IN A SECOND
	SOSG	TRYCTR(B)	;TRIED OFTEN ENOUGH ?
	JRST	FCTBSY		;YES, THE FILE IS BUSY AND HAS BEEN FOR TEN SECONDS.
	JRST	APPNDL		;NO, TRY AGAIN BEGINNING WITH LOOK-UP. (FILE COULD
	 			; HAVE COME INTO EXISTENCE OR DIED IN THE INTERIM.)


APPNDN:	HRRZ	T2,SECBUF+.RBEXT(B) ;[4] GET THE ERROR CODE
	TRNE	T2,-1		;ONLY ERROR CODE 0 IS REASONABLE ON LOOKUP FAILURE.
	JSP	N,APPNDR	;ERROR EXIT ON ANY OTHER LOOKUP FAILURE.
	PUSHJ	P,APPNDE	;FACT FILE DIDN'T EXIST.  TRY TO CREATE IT.
	SETZM	FCTBLK(B)	;ALL SET. SET POINTERS TO
	MOVE	N,B		; . .
	AOS	FCTBLK(B)	; BEGINNING OF FILE.
	JRST	APPNDC		;GO MOVE TRANSACTION ENTRY INTO FILE AND EXIT.

	SUBTTL	Random routines

;CLEAR EXTENDED LOOKUP/ENTER BLOCK
CLRRIB:	MOVEI	T1,SECBUF(B)	;;FIRST WORD TO ZERO
	HRL	T1,T1		;COPY TO LEFT HALF
	AOS	T1		;SET UP BLT POINTER
	SETZM	SECBUF(B)	;MAKE A ZERO
	BLT	T1,SECBUF+.RBSIZ(B)	;SPREAD THE WORD
	MOVX	T1,.RBSIZ	;[4] GET LENGTH OF BLOCK
	MOVEM	T1,SECBUF+.RBCNT(B) ;[4] PUT LENGTH OF BLOCK IN
	POPJ	P,		;RETURN

;SAVE REGISTERS AND ALLOCATE CORE - ALSO SNEAKILY PUT FAKE
;RETURN ON STACK TO ROUTINE TO RESTORE REGS AND RETURN CORE
SAVER:	EXCH	N,(P)		;PUT N ONTO STACK
	PUSH	P,T1		;SAVE REGISTERS
	PUSH	P,T2		;..
	PUSH	P,T3
	PUSH	P,T4
	PUSH	P,B
	PUSH	P,P2
	PUSH	P,M
	PUSH	P,[RESTOR]	;MAKE FAKE RETURN TO RESTORE P2
	HRRZ	T1,.JBFF	;GET FIRST FREE LOC.
	MOVE	B,T1		;COPY TO BASE REGISTER
	ADDI	T1,LOSGSZ	;ADD LOW SEGMENT SIZE
	MOVEM	T1,.JBFF	;SAVE NEW .JBFF
	CAMG	T1,.JBREL	;DO WE HAVE ENOUGH CORE?
	  JRST	COREOK		;YES - ALL SET
	CORE	T1,		;NO - GRAB IT
	  JSP	N,APPNDR	;FATAL ERROR
COREOK:	JRST	(N)		;RETURN

;RESTORE P2
RESTOR:	MOVEM	B,.JBFF		;RESTORE .JBFF
	CORE	B,		;SHRINK IF WE CAN
	  JFCL			;DON'T WORRY IF WE CAN'T
	POP	P,M		;RESTORE REGISTERS
	POP	P,P2
	POP	P,B
	POP	P,T4
	POP	P,T3
	POP	P,T2
	POP	P,T1
	POP	P,N
	POPJ	P,		;RETURN TO ORIGINAL CALLER

;TYPE THE ASCIZ STRING POINTED TO BY M
MSG:	SKIPGE	DETFLG(B)	;ARE WE DETACHED?
	  POPJ	P,		;YES - DON'T TRY TO TYPE
	OUTSTR	(M)		;TYPE IT
	POPJ	P,		;RETURN

;TYPE THE OCTAL NO. IN N

	END