Trailing-Edge
-
PDP-10 Archives
-
de-10-omona-v-mc9
-
factor.mac
There are 7 other files named factor.mac in the archive. Click here to see a list.
TITLE FACTOR - Routine to append entry to FACT file
SUBTTL Try DAEMON first, then try FACT.SYS, FACT.X01 ... FACT.X77
SEARCH C
SALL
%%FCTR==1 ;VERSION
TWOSEG
RELOC 400000 ;GOES IN HIGH SEGMENT
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
;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
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 ;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: MOVE T1,[SIXBIT /FACT/]
MOVE T2,APPEXT(B)
MOVEI T3,0
MOVE T4,SYSPPN(B)
LOOKUP FCT,T1 ;ATTEMPT TO OPEN FACT FILE 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: PUSHJ P,CLRRIB ;CLEAR EXTENDED ENTER BLOCK
MOVE T1,[SIXBIT /FACT/]
MOVEM T1,SECBUF+.RBNAM(B)
MOVE T1,APPEXT(B) ;EXTENSION TO TRY FOR
MOVEM T1,SECBUF+.RBEXT(B)
MOVX T1,%LDSSP ;GETTAB PROTECTION CODE
GETTAB T1, ;FOR .SYS FILES
MOVSI T1,(157B8)
MOVEM T1,SECBUF+.RBPRV(B)
MOVE T1,SYSPPN(B) ;SYS: PPN
MOVEM T1,SECBUF+.RBPPN(B)
MOVEI T1,.RBSIZ ;NO. OF ARGUMENTS WE WANT
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: 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
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 ;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