1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 17:26:38 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

403 lines
13 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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