github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-31 14:02:09 +00:00
Code Issues Releases Wiki Activity
Files
299dfd277ed2840b4321bab74c680bdb83812f88
PDP-10.its/src/kshack/nsalv.261
Lars Brinkhoff 299dfd277e Make MC great again.
2019-09-15 23:15:43 +02:00

8790 lines
202 KiB
Plaintext
Executable File
Raw 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.
; -*- Midas -*-
.SYMTAB 3607.,5003.
.NSTGW
IF1, TITLE NSALVATION
IF2,[ PRINTX /
/
.TYO6 .FNAM1
PRINTX / /
.TYO6 .FNAM2
PRINTX/
/]
IFNDEF $$DBG, $$DBG==0 ; Debugging the Salvager.
IFNDEF $$EXTRA, $$EXTRA==0 ; Assemble code apparently never used.
DEFINE DBG
IFN $$DBG!TERMIN
DEFINE EXTRA
IFN $$EXTRA!TERMIN
SUBTTL Basic definitions
MEMSIZ=1000000 ;The size of memory.
PG$BTS==10. ;# Bits in page addr.
PG$SIZ=1_PG$BTS ;ITS page size in words.
PG$DEC=PG$SIZ/2 ;DEC page size in words.
PG$MSK==PG$SIZ-1 ;Mask for page address bits.
;;; Accumulators.
Z=0 ;ZERO
A=1 ;A-E general purpose
B=2
C=3
D=4
E=5
N=6
W=7
U=W+1
I=11 ;Unit #.
Q=12
T=13 ;Temporaries
TT=T+1
J=15 ;Block #.
K=J+1
P=17 ;Stack pointer
PDLLEN==256. ;Stack length.
.SEE CHKR ;SALVAGER
.SEE GOGO ;SALVAGER - (AUTO FOR ALL DRIVES)
.SEE GETSTS ;GET CONTROLLER AND CURRENT DRIVE STATUS
.SEE MARK ;FORMAT PACK
.SEE COPY ;COPY BLOCK TO BLOCK
.SEE UCOP ;COPY UDIRS FROM DRIVE TO DRIVE
.SEE DUP ;DUPLICATE ENTIRE DISC PACK
.SEE UNLOCK ;TEST & UNLOCK A BLOCK
.SEE LISTF ;PRINT USER DIRECTORY ON LPTR
.SEE ZAP ;ZERO DIR BLOCKS, WRITE OUT EMPTY TUT,MFD, WRITE READIN BLOCK
.SEE TRAN ;LOAD FROM MAG TAPE UNIT 5
; (KS code ignores unit number says JTW)
.SEE CTRAN ;LOAD FROM CHAOS NET
.SEE NEWUFD ;CREATE NEW USER DIR
.SEE MFDR ;TRY TO RECONSTRUCT MFD FROM USER DIRS
.SEE REMAP ;REMAP PACK #S AND FIX UFDS
.SEE RDHEAD ;READ HEADER FROM TRACK
.SEE SPKID ;SET PACK ID IN TUT
.SEE SECOND ;SET SECONDARY PACK NAME
.SEE MARK69 ;FINISH FORMATTING PACK
.SEE READ ;READ and WRITE the disk
.SEE FESET ;Set pointer to front end filesystem for KS10'S 8080 console
.SEE QACT ;Active disks
.SEE HCRASH ;VARIABLE TO BE SET NON-ZERO IF DUP'ING A DISK AFTER HEAD CRASH
.SEE NOQUES ;IF NON-ZERO, NO QUESTIONS IN GOGOX MODE
.SEE FERRS ;COUNT OF CORRECTABLE ERRORS
.SEE CERRS ;COUNT OF ECC-CORRECTED ERRORS (RP04/6 ONLY)
;;; MIDAS extensions.
;;; Canonical symbol definition macro, FOO==BAR with error check.
IFNDEF DEFSYM,[
DEFINE DEFSYM X/
IRPS Z,,[X]
IFNDEF Z,X
.ELSE [ $$TEM1==Z
X
IFN Z-$$TEM1,.ERR Z MULTIPLY .QUOTE`.QUOTE/DEFINED/`
]
.ISTOP
TERMIN TERMIN
$$TEMP==1
];DEFSYM
.ELSE $$TEMP==0
;;; Concatentation.
DEFINE CONC A,B
A!B!TERMIN
;;; IFCE - Like IFSE but ignores case.
DEFINE IFCE A,B
IFE SIXBIT/A/-SIXBIT/B/,TERMIN
;;; IFNDEZ "Error msg",FOO,BAR,BAZ,QUUX
;;; Sets the undefined symbols to zero and complains unless something defined.
DEFINE IFNDEZ &ERMSG,-ARGS
.DEZ==0 ;Count of mutually exclusive symbols d e f i n e d so far.
IRPS Z,,[ARGS]
IFNDEF Z, Z==0
.DEZ==.DEZ+Z
TERMIN
;Now ensure that one and only one symbol was d e f i n e d.
IFE .DEZ, .FATAL ERMSG not deffd
IFG .DEZ-1, .ERR ERMSG multiply deffd
TERMIN
;;; CRLF while assembling
DEFINE .CRLF
.TYO 15
.TYO 12
TERMIN
;;; INFORMation.
DEFINE INFORM A,B,C,D,E,F,G
PRINTX \A!B!C!D!E!F!G
\
TERMIN
;;; INFORMation about the length of something. (In decimal.)
DEFINE SAYSIZ FOO,MSG
ORADIX==10
RADIX 10.
SAYSZ1 \FOO,[MSG]
RADIX ORADIX
TERMIN
DEFINE SAYSZ1 FOO,MSG
PRINTX /FOO!. MSG
/
TERMIN
;;; TMPLOC <loc>,<parenthesized arg> - puts argument at given LOC
;;; without changing location counter outside macro call.
DEFINE TMPLOC VAL,ARG
%%%TLC==.
LOC VAL
ARG
LOC %%%TLC
TERMIN
SUBTTL Configuration
;;; Specify for each machine:
;;; o processor type
;;; o number of physical and virtual units (usually both the same)
;;; o the first and last packs which must be mounted in GOGO mode
;;; o number of user file directories in the file system
;;; o disk drive and controller types
;;; o width of console TTY
;;; o device code for console lights (or zero)
;;; o if it has a Chaos interface and associated addresses for the
;;; MINI36 user in CTRAN to use
IF1,[
PRINTX /Which machine? /
.TTYMAC MCHN
IFCE MCHN,AI,[
;;; The new AI KS10 machine.
KS10P==1
NDRIVE==2 ;# physical units
NUNITS==2 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;Has Unibus Chaosnet board
LHOST==3130 ;Local chaos host address (AI)
RHOST==3131 ;Remote chaos host (MC)
GWHOST==RHOST
];AI
IFCE MCHN,MCKS,[
;;; The new Mail Computer KS10.
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI)
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;Has Unibus Chaosnet board
LHOST==3131 ;Local chaos host address (MC)
RHOST==3130 ;Remote chaos host (AI)
GWHOST==RHOST
];MCKS
IFCE MCHN,ML,[
;;; The Math Lab KS10.
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI)
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;Has Unibus Chaosnet board
LHOST==3133 ;Local chaos host address (ML)
RHOST==3130 ;Remote chaos host (AI)
GWHOST==RHOST
];ML
IFCE MCHN,MD,[
;;; The Mostly Development KS10.
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RM80P==1 ;RM80 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI)
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;Has Unibus Chaosnet board
LHOST==3132 ;Local chaos host address (MD)
RHOST==3130 ;Remote chaos host (AI)
GWHOST==RHOST
];MD
IFCE MCHN,SI,[
;;; Stacken ITS
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI)
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
];SI
IFCE MCHN,FU,[
;;; Australian KS10
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI)
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
];FU
IFCE MCHN,PM,[
;;; MRC'S PandaMonium KS10
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RM03P==1 ;RM03 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
];PM
IFCE MCHN,DX,[
;;; DigeX's KS10
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RM03P==1 ;RM02/3 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
];DX
IFCE MCHN,KSRP06,[
;;; Generic KS10 with one RP06 and one TM03
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP06P==1 ;RP06 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;May well have Unibus Chaosnet board
LHOST==3130 ;Local chaos host address (AI, can be patched)
RHOST==3131 ;Remote chaos host (MC, can be patched)
GWHOST==RHOST
];KSRP06
IFCE MCHN,KSRP07,[
;;; Generic KS10 with one RP07 and one TM03
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RP07P==1 ;RP07 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;May well have Unibus Chaosnet board
LHOST==3130 ;Local chaos host address (AI, can be patched)
RHOST==3131 ;Remote chaos host (MC, can be patched)
GWHOST==RHOST
];KSRP07
IFCE MCHN,KSRM03,[
;;; Generic KS10 with one RM03 and one TM03
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RM03P==1 ;RM03 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;May well have Unibus Chaosnet board
LHOST==3130 ;Local chaos host address (AI, can be patched)
RHOST==3131 ;Remote chaos host (MC, can be patched)
GWHOST==RHOST
];KSRM03
IFCE MCHN,KSRM80,[
;;; Generic KS10 with one RM80 and one TM03
KS10P==1
NDRIVE==1 ;# physical units
NUNITS==1 ;# virtual units
FIRSPK==0 ;First pack that must be mounted in GOGO mode.
LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!)
NUDSL==500.
RM80P==1 ;RM80 on RH11 UNIBUS controller.
TM03P==1 ;Tape on a TM03/RH11
TCMXH==120. ;DECwriter.
LIGHTS==0 ;There aren't any (sob!)
CHAOSP==1 ;May well have Unibus Chaosnet board
LHOST==3130 ;Local chaos host address (AI, can be patched)
RHOST==3131 ;Remote chaos host (MC, can be patched)
GWHOST==RHOST
];KSRM80
IFCE MCHN,MC,[
;;; The Macsyma Consortium machine.
KL10P==1
SA=105*2000 ; MC-KL system is big, need to push SALV higher.
FIRSPK==0
LASTPK==1
NUDSL==500.
RH10P==1 ;RP04 on RH10 MASSBUS controller.
T300P==3 ;UNIT 3 IS FIRST T-300 UNIT
TM10P==1 ;TM10 Tape code
TCMXH=100. ;LA36
LIGHTS==500 ;KL-UDGE
NDRIVE==6 ;8 DOESN'T FIT IN 128K
NUNITS==6
];MCKL
IFCE MCHN,MLKA,[
;;; The original Mathlab machine (R.I.P.)
KA10P==1
FIRSPK==2
LASTPK==3
NUDSL==250.
RP10P==1
TCMXH=55.
LIGHTS==4 ;PI
NLPTP=464
];MLKA
IFCE MCHN,DM,[
;;; The Dynamod machine (R.I.P.)
KA10P==1
FIRSPK==17.
LASTPK==21.
NUDSL==200.
RP10P==1
TTLPTP==100
TCMXH=55.
LIGHTS==4 ;PI
NLPTP=464
];DM
IFCE MCHN,AIKA,[
;;; The original ITS machine (R.I.P.)
KA10P==1
FIRSPK==1
LASTPK==5
NUDSL==440.
DC10P==1
TCMXH=55.
LIGHTS==4 ;PI
NLPTP=464
];AIKA
IFCE MCHN,ITS,ITS==1
IFCE MCHN,TS,ITS==1
IFNDEF ITS,ITS==0
IFN ITS,[
ITS==1 ;Timesharing version.
KL10P==1 ;Pretend to be KL10 I suppose.
TM10P==0 ;Don't bother with tape code.
FIRSPK==0
LASTPK==5
TCMXH=79.
LIGHTS==0
NUDSL==500.
TTYI==1 ;TTY typein channel
TTYO==2 ;TTY typeout channel
LPTC==3 ;LPT channel
;Busted NLPTP==1 ;Pretend to have LPT
QIN==4 ;Disk input channel
];TS
IFNDEF FIRSPK, .FATAL Unknown machine "MCHN"
TERMIN
IFNDEF NUDSL, .FATAL Number of UFDs undeffd
IFNDEF LIGHTS, .FATAL Lights undeffd
DEFINE TS
IFN ITS!TERMIN
DEFINE NTS
IFE ITS!TERMIN
IFNDEZ "Processor type",KA10P,KL10P,KS10P
IFNDEF T300P,T300P==0
IFNDEZ "Disk/control types",DC10P,RP10P,RH10P,RP06P,RP07P,RM03P,RM80P,ITS
;;; Select at most one kind of tape subsystem.
IFNDEF TM03P,TM03P==0
IFNDEF TM10P,TM10P==0
NTS, IFG TM10P+TM03P-1,.FATAL Too many tape controller types selected.
TS, IFN TM03P+TM10P,.ERR Tape code in timesharing SALV?
IFN TM03P, IFE KS10P, .FATAL TM03 Tapes only supported on KS10.
IFN TM10P, IFN KS10P, .FATAL TM10 on KS10?
IFNDEF CHAOSP, CHAOSP==0
DEFINE KA
IFN KA10P!TERMIN
DEFINE KL
IFN KL10P!TERMIN
DEFINE KS
IFN KS10P!TERMIN
DEFINE KLKS ;Code common to KL and KS machines.
IFN KS10P+KL10P!TERMIN
DEFINE KAKL ;Code common to KL and KA machines.
IFN KA10P+KL10P!TERMIN
DEFINE DC ;Calcomp on Systems Concepts controller.
IFN DC10P!TERMIN
DEFINE RP ;RP03 on DEC controller.
IFN RP10P!TERMIN
DEFINE RH ;RP04 on RH10 MASSBUSS controller.
IFN RH10P!TERMIN
RH11P==RP06P+RP07P+RM03P+RM80P
; "PH" stands for phucked, I guess...
DEFINE PH ;RP06 or RP07 or RM03 or RM80 on RH11 UNIBUS controller.
IFN RH11P!TERMIN
DEFINE RHPH ;Code common to RH10 and RH11.
IFN RH10P+RH11P!TERMIN
DEFINE DCRH ;Code common to DC10 and RH10.
IFN DC10P+RH10P!TERMIN
DEFINE SH ;Code common to drives with pack # in Sector Header
IFN DC10P+RH10P+RP06P!TERMIN
DEFINE T300 ;Trident T300 on PDP11 "controller".
IFN T300P!TERMIN
DEFINE TM10 ;TM10A or TM10B tape subsystem.
IFN TM10P!TERMIN
DEFINE TM03 ;TM03 on RH11
IFN TM03P!TERMIN
DEFINE TMXX ;Any tape
IFN TM10P+TM03P!TERMIN
;;; Lineprinter definition.
IFNDEF OLPTP, OLPTP==0
IFNDEF NLPTP, NLPTP==0
IFNDEF TTLPTP, TTLPTP==0
DEFINE LPT
IFN OLPTP+NLPTP+TTLPTP!TERMIN
DEFINE OLPT
IFN OLPTP!TERMIN
DEFINE NLPT
IFN NLPTP!TERMIN
DEFINE TLPT
IFN TTLPTP!TERMIN
];IF1
;;; Unless the "virtual drive" hack is being used, default the number
;;; of disk drives to the maximum possible and find out at run time how
;;; many there really are on-line with the right packs.
IFNDEF NDRIVE, NDRIVE==8 ;# physical units
IFNDEF NUNITS, NUNITS==8 ;# virtual units
SA=100*2000 ;Our starting address.
NTS,DDT=MEMSIZ-4000 ;Well-known address of Exec DDT.
.YSTGW ; OK, now you can output stuff
LOC SA ;Code begins assembling here.
JRST GOGO ;Make easy to start from ITS.
SALVRT: 0 ;System may JSR here.
JRST SALVAG
;;; Device definitions.
IF2,[
KA, INFORM KA-10 processor
KL, INFORM KL-10 processor
KS, INFORM KS-10 processor
TS INFORM Runs under time-sharing (fake KL)
OLPT, INFORM Old LPT Interface
NLPT, INFORM New LPT Interface
TLPT, INFORM LPT on MTY line number ,\TTLPTP&77
TM03, INFORM TM03/TUxx on RH11
TM10, INFORM TM10A/B Magtape on IO Bus or Data Channel
];IF2
KA,[
APR==0 ;Processor.
PI==4 ;Interrupt system.
TTY==120 ;TTY.
PTP==100 ;Paper tape.
MTY==400 ;Scanner.
;;; Disk channel program words.
DEFSYM SLVICWA=20
DEFSYM SLVIOWD=22
];KA
KS,[
;Include KS10 defs
EPT==:0 ; This MUST be the same as in ITS itself!
HSB==:500
.INSRT SYSTEM;KSDEFS
PIOFF==: 000400 ; Turn off PI system
PICLR==: 010000 ; Clear PI system
APRCHN==:3 ; APR channel.
];KS
KL,[
APR==0 ;Processor.
PI==4 ;Interrupt system.
PAG==10 ;Pager.
T300, DLB==60 ;DL-10
.ALSO DLC==64
;;; Include KL10 defs (DTE, DL10, etc).
.INSRT SYSTEM;EPT >
..D010==0
;;; Set up addr for the "DDT" KLDCP command.
ZZ==.
LOC EPTDDT
JRST DDT ;FOR 'DDT' COMMAND IN KLDCP
LOC ZZ
;;; Tell DDT about cache intructions.
SWPIA=701440,,0
SWPUO=701740,,0
SWPIO=701640,,0
SWPUA=701540,,0
];KL
;;; DL10 communications area in non-encached low core.
;;; Actual storage layout defined in ITS and in T300 defs.
T300, DL10AR==500
IF2,[
DC, INFORM Systems Concepts disk control
RP, INFORM RP03 on RP10 control
RH, INFORM RP04 on RH10 MASSBUS control
IFN RP06P, INFORM RP06 on RH11 UNIBUS control
IFN RP07P, INFORM RP07 on RH11 UNIBUS control
IFN RM03P, INFORM RM03 or RM02 on RH11 UNIBUS control
IFN RM80P, INFORM RM80 on RH11 UNIBUS control
T300, INFORM T-300 disk on PDP-11 control
ORADIX==10
RADIX 10.
INFORM Number of disk drives = ,\NDRIVES
;INFORM Number of virtual units = ,\NUNITS
RADIX ORADIX
];IF2
;;; Disk physical parameters.
DC, .INSRT SYSTEM;DC10
RP, .INSRT SYSTEM;RP10
RH, .INSRT SYSTEM;RH10
PH, .INSRT SYSTEM;RH11
IFN RP06P, .INSRT SYSTEM;RP06
IFN RP07P, .INSRT SYSTEM;RP07
IFN RM03P, .INSRT SYSTEM;RM03
IFN RM80P, .INSRT SYSTEM;RM80
TS, NTUTBL==4 ;Maximum number of blocks per TUT on any ITS
RHPH,[
SECTOR==128. ;Disk sector size in PDP10 words.
SH, HSECTOR==:SECTOR+2 ; Two word header if pack # stored there
.ELSE,[
IFN RP07P, HSECTOR==:SECTOR+4 ; RP07 has lots of sector header bits....
.ELSE, HSECTOR==:SECTOR+1 ; Else just one word
]
];RHPH
;;; File system parameters.
.INSRT SYSTEM;FSDEFS >
;;; Maybe T-300s too.
T300, .INSRT SYSTEM;T300 >
T300, MXTUTB==NTUTB1 ;MAXIMUM OF NTUTBL AND NTUTB1
.ELSE MXTUTB==NTUTBL
IF2,[
TS,[ ;;; Fake ITS file system definitions.
NBLKS==10000. ;Fake
TBLKS==10000. ;Fake
MFDBLK==-1 ;JUST TO AVOID UNDEF SYM ERROR, VALUE NEVER USED
; TUTBLK==-1 ;..
TUTPAG==600000 ;Read TUT by mapping in absolute page
NBLKSC==47 ;Fake blks/cyl
];TS
];IF2
DC,[
DEFINE QCOPY A,B
DCOPY A(-<B>_2&37774)!TERMIN
];DC
;;; Instructions
CALL=<PUSHJ P,> ;Procedure call.
X==<PUSHJ P,> ;(Old name for it.)
RET=<POPJ P,> ;Return.
CALRET==:JRST ;Tail-recursive call.
KA, NOP=<JFCL>
.ELSE NOP=<CAI>
NTS, HALT=<JRST 4,> ;Halting.
TS,[
DEFINE HALT NEWPC
.CALL [SETZ ? SIXBIT /LOSE/ ? MOVEI 0 ? SETZI NEWPC]
TERMIN
DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
DEFINE EVAL SYM,PLACE
MOVE T,[SQUOZE 0,SYM]
.EVAL T,
.VALUE [ASCIZ ":Symbol initialization error"]
MOVEM T,PLACE
TERMIN
];TS
;;; Initialize ACs
DEFINE ACINIT
SETZI 0,
MOVEI P,1
BLT P,P
MOVE P,[-PDLLEN,,PDL-1] ;Init the stack.
TERMIN
;;; PUSHER/POPPER for saving/restoring ACs.
DEFINE PUSHER AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN
DEFINE POPPER AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN
;;; ROUND - Check for a remainder in AC+1 and round AC up.
;;; Useful after IDIVI instructions.
DEFINE ROUND AC
SKIPE AC+1
AOS AC
TERMIN
;;; HNRLZ - Halfword Negated Right to Left
;;; An idiom for making AOBJN pointers.
DEFINE HNRLZ AC1,AC2
MOVN AC1,AC2
HRLZ AC1,AC1
TERMIN
;;; Approximate time delays.
; In theory DELAY should have different values on different CPUs.
; In practice, this macro isn't worth much, since people don't really
; compute these things this accurately. If I were to fix this to
; -really- delay 4 US when you asked for such a delay, then (on the KL)
; it would actually delay considerably -less- than it does now.
; Better just leave it alone and on the KS the delays will just be
; longer...
DEFINE DELAY SCALE,TIM
IFCE SCALE,MS, MOVEI Z,2000.*TIM
IFCE SCALE,US, MOVEI Z,TIM
SOJG Z,.
TERMIN
;;; PUNT, BARF, and ERR are various flavors of copping out.
IF2, PUNT=:JRST TODDT
IF2, BARF=:JRST ERRDDT
DEFINE ERR
SKIPE GOGOX
BARF
TERMIN
SUBTTL I/O Utilities
;;; LIGHTUP for hacking console lights.
IFN LIGHTS,[
LIGHTUP=:DATAO LIGHTS,
]
IFE LIGHTS,[
LIGHTUP==:NOP
]
;;; RHQGET and RHQSET hack the disk controller registers.
RHPH,[
DEFINE RHQGET REG
MOVSI A,REG
CALL RHGET
TERMIN
DEFINE RHQSET REG,<ADR>
MOVSI A,REG ;LH A gets addr of IO ptr
HRR A,ADR ;RH A gets the data.
CALL RHSET
TERMIN
];RHPH
;;; QCNVT - Convert physical unit number to virtual unit number.
;;; A/ physical unit number
;;; Returns in B the virtual unit number (from QTRAN).
;;; Non-skip means unit was unknown to QTRAN.
QCNVT: MOVSI B,-NUNITS
CAME A,QTRAN(B)
AOBJN B,.-1
JUMPGE B,CPOPJ ; Not found, don't skip
MOVEI B,(B) ; Found, extract virtual unit number
JRST POPJ1 ; and skip
;;; FINDPK - Find unit pack is mounted on.
;;; (QPKN must be set up.)
;;; Takes in C the pack number and returns in C the unit number.
;;; Returns -1 if pack not mounted.
FINDPK: PUSH P,B
MOVEI B,NUNITS-1 ;This many units.
FINDP1: CAMN C,QPKN(B) ;This pack?
JRST [ HRRZ C,B ; Yes, get unit #.
JRST FINDP9 ] ; Return it in C.
SOJGE B,FINDP1 ;Else keep looking.
SETOM C ;When bored, fail.
FINDP9: POP P,B
RET
DBG,[
;;; Zap the buffer in A, length in C.
BUFZAP: SETZM (A)
HRLI T,(A)
HRRI T,1(A)
ADDI C,-1(A)
BLT T,(C)
PUNT
];DBG
;;; Include ALAN's winning FORMAT package. Yow!
DEFINE TYPE S,&STRING&,ARGS
CALL [ CALL FMTIN
ZZZ==-1
IRP ARG,,[ARGS]
PUSH P,ARG
ZZZ==.IRPCNT
TERMIN
HRROI A,[ASCII STRING]
MOVEI B,.LENGTH STRING
MOVNI C,ZZZ+1
CALRET FORMAT"FORMAT ]
TERMIN
FMTIN: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,[FMTOUT]
JRST @-4(P)
FMTOUT: POP P,C
POP P,B
POP P,A
POP P,(P)
RET
;;; LOSE dumps us into DDT.
DEFINE LOSE &STRING&,ARGS
CALL [ TYPE T,STRING,[ARGS]
BARF ]
TERMIN
;;; If FORMAT runs into problems it should LOSE to!
EQUALS FORMAT"FMTERR,LOSE
;;; QLOSE does a GSTS before going to DDT.
DEFINE QLOSE &STRING&,ARGS
JRST [ TYPE T,STRING,[ARGS]
CALL GSTS
BARF ]
TERMIN
;;; ASKYN uses format to query for a Y or N response.
DEFINE ASKYN &STRING&,ARGS
CALL [ TYPE T,STRING,[ARGS]
JRST YORNP ]
TERMIN
$$IERR==1 ;Handle errors ourselves.
$$PFN==0 ;Don't bother
$$ERRS==0 ;No ERR: device available
$$ENGL==0 ;English numbers feature
$$ITAB==1
$$UTAB==0
NTS, $$ITS==0 ;Nothing above us
NTS, $$PCODE==0 ;No ^P handler in OUTSTR
TS, $$ITS==1 ;(unless under timesharing)
TS, $$PCODE==1
.INSRT SYSENG;FORMAT
;;; CRR outputs just a carriage return.
;;; LPRCRR of course does it on the LPT.
;;; LPRTAB tabs on the LPT.
CRR=:CALL .
$CRR: TYPE T,"~%"
RET
LPRCRR=:CALL .
$LPCRR: TYPE LPT,"~%"
RET
LPRTAB=:CALL .
$LPTAB: TYPE LPT," "
RET
;;; OUTSTR - Outputs a string on the system console
;;; This is called by the FORMAT package.
;;; A/ byte ptr
;;; B/ count of chars
TS,[
OUTSTR: SYSCAL SIOT,[MOVEI TTYO ? A ? B] ;Type out a string.
.LOSE %LSSYS
RET
];TS
NTS,[
OUTSTR: JUMPE B,CPOPJ
ILDB T,A ;Get a charater
CAIN T,^M ;Dig ^M (but not ^H or others.)
JRST [ CALL TYO
SETZM CTYXH ; Zero the pos.
JRST OUTST6 ]
MOVE T,CTYXH ;Else count the char.
CAIL T,TCMXH ;If we are going to overrun
JRST [ MOVEI T,^M ; CR
CALL TYO
MOVEI T,^J ; LF
CALL TYO
SETZM CTYXH ; Zero the pos.
JRST .+1]
LDB T,A ; Restore T
CALL TYO ;Type it out.
OUTST6: SOJG B,OUTSTR ;Loop for B chars.
RET ;Does not skip.
];NTS
;;; GETPOS reads our horizontal cursor position for FORMAT.
NTS,[
GETPOS: MOVE A,CTYXH
RET
];NTS
TS,[
GETPOS: SYSCAL RCPOS,[MOVEI TTYO ? MOVEM A]
MOVEI A,-1
HRRE A,A
RET
];TS
;;; TYO types character on the console TTY.
;;; T/ char to type
;;; Bashes no ACs; Never skips.
LINPOS::
CTYXH: 0 ;CTY horizontal cursor position.
TYO:
TS, .IOT TTYO,A
NTS,[
AOS CTYXH ; Track horizontal position.
KA,[ CONSZ TTY,20
JRST .-1
DATAO TTY,A
];KA
KL,[ PUSH P,T
ANDI T,177
CALL DTEXIO
POP P,T
];KL
KS,[ PUSH P,T
ANDI T,177 ;ASCII only.
IORI T,400 ;Set CTY-char-pending
MOVEM T,8CTYOT ;Store in comm area
CONO 80INT\APRCHN
SKIPE 8CTYOT ;Wait for completion
JRST .-1
POP P,T
];KS
];NTS
RET
;;; TYI - Read character from console TTY.
;;; Skip returns with char in T, else fails.
TYI:
TS, .IOT TTYI,T
NTS,[
KA,[ CONSO TTY,40
RET
DATAI TTY,T
];KA
KL,[ MOVEI T,3400 ;DDT mode input req
CALL DTEXIO
JUMPE T,CPOPJ
];KL
KS,[ SKIPN T,8CTYIN ;Chars stored here by 8080.
RET
SETZM 8CTYIN ;Remember to clear it.
];KS
ANDI T,177 ;ASCIIfy.
CALL TYO ;Echo it.
];NTS
CAIE T,^C ; General punting feature...
CAIN T,^Z
PUNT
JRST POPJ1
;;; DTE20 Communication Routine ...( copied from DEC "SUBRTN" program.)
KL,[
DTEXIO: SETZM DTEFLG
MOVEM T,DTECMD
SETZM DTEF11
CONO DTE,%DBL11
SKIPN DTEFLG
JRST .-1
SETZM DTEFLG
MOVE T,DTEF11
RET
];KL
;;; TYIPSE - Return to DDT if character typed.
TYIPSE:
TS,[ .LISTEN T,
JUMPE T,CPOPJ
];TS
CALL TYI
RET
PUNT
;;; NTYI reads a digit into A and should skip.
NTYI: CALL TYI
JRST NTYI
MOVE A,T
CAIL A,"0
CAILE A,"9
RET
SUBI A,"0
JRST POPJ1
;;; DTYI reads a decimal number into A.
;;; OTYI reads an octal number into A.
;;; Never skips.
DTYI: PUSH P,B
MOVEI B,0
DTYI1: CALL NTYI
JRST DTYI2
IMULI B,10.
ADD B,A
JRST DTYI1
DTYI2: MOVE A,B
POP P,B
RET
OTYI: PUSH P,B
MOVEI B,0
OTYI1: CALL NTYI
JRST DTYI2
LSH B,3
ADD B,A
JRST OTYI1
;;; 6TYI - Sixbit input into B and don't skip.
6TYI: PUSHER P,[A,C]
MOVE C,[440600,,B]
MOVEI B,0
6TYL: CALL TYI
JRST 6TYL
MOVE A,T
CAIN A,^M
JRST 6TYI9
TRZN A,100
TRCA A,40 ; Sixbitify character
TRO A,40
JUMPLE A,6TYI9
TLNE C,77^4
IDPB A,C
JRST 6TYL
6TYI9: POPPER P,[C,A]
RET
;;; Y or N querying.
;;; Returns for negative, skips for affirmative.
;;; Groks Y,N in either case, and SPACE,RUBOUT.
YORNP: TYPE T," (Y or N) "
CALL TYI
JRST .-1
CAIN T,177
JRST CPOPJ
CAIN T,40
JRST POPJ1
CAIN T,"Y
JRST POPJ1
CAIN T,"N
JRST CPOPJ
CAIN T,"y
JRST POPJ1
CAIN T,"n
JRST CPOPJ
TYPE T,""
JRST YORNP
;;; RFNAME - Read File Names
;;; Prompts with the default and reads new filename.
;;; Sets up filename block in B
RFN"$$RFN==:1
RFN"$$RUC==:1
.INSRT DSK:SYSENG;RFN
RUC: CALL TYI
JRST RUC
MOVE A,T
CAIL A,"a
CAILE A,"z
RET
SUBI A,"a-"A
RET
RSIXTP: CAIE A,177
CAIN A,33
AOS (P)
RET
RFNAME: PUSHER P,[A,C,D,E]
RFNM1: TYPE T,"~& ~F ",B
CALL RFN"RFN
CAIE A,177
CAIN A,33
JRST RFNM1
POPPER P,[E,D,C,A]
RET
SUBTTL Crufty LPT routines
NOLPT: 0 ;-1 for no LPT
LPBUST: 0 ;-1 LPT is busted don't keep asking
;;; UPLPT - Up your LPT!
UPLPT:
LPT,[ .ERR If you want to use the LPT, you'll have to fix this code.
SKIPE LPBUST ;If known to be busted
JRST UPLP9 ; flush this noise.
SKIPE NOLPT ;If no LPT wanted
JRST UPLP9 ; don't bother loser again.
SETOM NOLPT ;Assume no LPT wanted.
SETOM LPFRST' ;Find out what user wants.
ASKYN "Want LPT"
CAIA
TS,[ JRST [ASKYN "~&Want LPT output to DSK?"
CALRET [ SYSCAL OPEN,[%CLBIT,,.UAO
%CLIMM,,LPTC
[SIXBIT /LPT/]]
.LOSE %LSFIL
SETZM NOLPT
SETZM LPBUST
RET ]
SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LPTC
[SIXBIT /DSK/]
[SIXBIT /NSALV/]
[SIXBIT /OUTPUT/]]
.LOSE %LSFIL
RET ]
];TS
LPTUP2:
NTS, LOSE "~&Only REAL programmers use line printers."
];LPT
UPLP9: RET
SUBTTL Misc.
POPJ1: AOS (P)
CPOPJ: RET
POPBAJ: POP P,B
POPAJ: POP P,A
RET
POPBJ: POP P,B
POPJ P,
POPTJ: POP P,T
RET
CONTIN: ASKYN " Continue"
RET
JRST POPJ1
UUOHLT:
KA, 0 ;KA10 JSRs here.
LOSE "~&UUO in Salvager??"
KL, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[PFOPC,EPTPFW]
KS, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[EPTPFO,EPTPFW]
ERRDDT: TYPE T,"~&*** ERROR *** THE SYSTEM MAY NOT BE BROUGHT UP"
ERRDD1: SETZM SALVRT ;Can't return to system.
TODDT: TYPE T,"~2&" ;Get us to a fresh line please.
SKIPE SALVRT ;If invoked from another system
JRST @SALVRT ; jump back into it.
TYPE T,"DDT"
SKIPN DDT ;Something where DDT should be?
HALT . ; No.
JRST DDT ;Yes - imagine it is DDT and jump into it.
ZAPLUZ: LOSE "Lossage." ;Quick and losing way to DDT.
TS,[
DDT: .BREAK 16,100000
JRST DDT
];TS
SUBTTL Main Program
;;; Vector Of Mysteries (in case up creek without symbol table)
GOGO: JRST [ JSR INIT ? JRST GOGO2 ]
SALVAG: JRST [ JSR INIT
SETOM NOQUES ;If started by BEG$G in ITS, be fast
JRST GOGO2 ] ;(no routine typeout)
CHKR: JRST CHKR0
NOP LPBUST ;-> LPT BUSTED FLAG
NOP NOQUES ;-> NO QUESTIONS FLAG
NOP GOODUN ;-> ONLY RTN THAT KNOWS WHICH ARE "RIGHT" PACKS
NOP GETSTS ;-> ROUTINE TO TYPEOUT CURRENT DISK STATUS
NOP DSKTST ;-> SIMPLE READ/WRITE TEST
NOP SEKTST ;-> SIMPLE SEEK TEST (READ ONLY)
NOP DUP ;-> DISK COPYING ROUTINE
NOP HCRASH ;-> AS FAST AS POSSIBLE FLAG
INIT: 0
ACINIT
TS,[ .CLOSE TTYI, ;If under timesharing, open TTY.
.CLOSE TTYO,
SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]]
.LOSE %LSFIL
SYSCAL OPEN,[%CLBIT,,.UAO+%TJDIS ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
.LOSE %LSFIL
];TS
NTS,[
KA,[ CONO 675550 ;Reset APR
CONO PI,710000 ;Reset PI
MOVE TT,[JSR UUOHLT] ;Halt on UUOs.
SKIPN 41
MOVEM TT,41
MOVEI A,SA ;Ensure all necessary memory is present.
INIT0: MOVE B,(A)
CONSZ 10000
LOSE "~%NXM in Salvager memory"
ADDI A,2000
CAIGE A,THEEND
JRST INIT0
];KA
KS,[ CLRCSH ;Clear the cache.
WRPI PICLR\PIOFF ;Turn off interrupts.
WRHSB [HSB] ;Set up the halt status block.
WREBR 400000+<EPT/PG$DEC> ;ITS paging, Off, set up EPT.
WRUBR [100^9+EPT] ;UPT=EPT
MOVEI TT,SALVPF ;Routine to call upon page failures.
MOVEM TT,EPTPFN
MOVEI TT,UUOHLT ;Routine to call upon exec mode UUO.
SKIPN EPTUEN
MOVEM TT,EPTUEN
MOVEI A,SA ;Ensure all necessary memory is present.
INIT0: MOVE B,(A) ;Touch a page.
CONSZ 400 ;NXM?
LOSE "~%NXM in Salvager memory"
ADDI A,2000 ;Nope, go to next page.
CAIGE A,THEEND
JRST INIT0
];KS
KL,[ SETZM DTEOPR ;BTB IF QUIT OUT AND RESTART
CONO 267760 ;I/O reset, clear + disable all flags
CONO PI,010000 ;Clear PI system
CONSO PAG,600000 ;If cache off
SWPIA ; invalidate entire cache.
CONSZ PAG,600000 ;If cache on
SWPUA ; unload entire cache.
CONSZ 200000 ;Clear the entire cache.
JRST .-1
MOVEI TT,SALVPF ;Set to halt on page fail (e.g. parity error)
MOVEM TT,PFNPC
CONO PAG,600000+EPT/PG$DEC ;Set up EPT, enable cache,
;Disable paging and traps.
DATAO PAG,[100000,,400000+EPT/PG$DEC] ;UPT=EPT
MOVEI TT,UUOHLT
SKIPN EPT+430 ;Halt on kernel UUO
MOVEM TT,EPT+430
MOVEI A,SA ;Ensure all necessary memory is present
INIT0: MOVE B,(A)
CONSZ 2000
LOSE "~%NXM in Salvager memory"
ADDI A,PG$DEC
CAIGE A,THEEND
JRST INIT0
];KL
];NTS
TS,[ .CORE <THEEND+1777>_-12 ;Make core exist.
.VALUE [ASCIZ ":Can't get core."]
EVAL NQS,NQS ;Find # disks this machine.
EVAL QACT,SQACT ;Find active unit table.
EVAL NUDSL,NUDS ;Find # special blocks.
EVAL MFDBLK,MFDBK ;Find MFD block.
EVAL NTUTBL,B ;Find NTUTBL.
MOVEI C,NUNITS-1
MOVEM B,NTBL(C)
SOJGE C,.-1
CAILE B,MXTUTB
.VALUE [ASCIZ ":Not assembled for big enough TUTs"]
MOVE B,[SQUOZE 0,T300P] ;Need kludges for 2 sizes OF TUT.
.EVAL B,
MOVEI B,0
JUMPE B,INI03
EVAL NTUTB1,C
CAILE C,MXTUTB
.VALUE [ASCIZ ":Not assembled for big enough TUTs"]
MOVEM C,NTBL(B)
CAIGE B,NUNITS-1
AOJA B,.-2
INI03: EVAL NBLKS,SNBLKS
MOVE A,SNBLKS
SUBI A,1
MOVEM A,SNBLKS-1
];TS
NTS,[
KL,[
RH,[ CONI DSK,TT
TLNN TT,(%HID22)
LOSE "~%SALV: The DF10 is in KA mode"
];RH
IFN T300,[ ;Turn on DL10 to access T-300
CONO DLC,400000 ;MR CLR
CONO DLB,1 ;Turn off excess lights
CONO DLB,2 ;..
CONO DLB,3 ;..
CONO DLB,DL10AR ;64 words for pdp11 #0 at DL10AR
DATAO DLC,[200001,,] ;KA interrupt mode
CONO DLC,100020 ;Enable pdp11 port #0 no interrupts
];T300
];KL
INIT2:
DC, SETZM ENCS
RH, SETZM MARKF
RP,[ DATAI DPC,A
TLNN A,NOWRIH
TYPE T,"~%[RP Write Headers enabled]"
];RP
];NTS
KAKL,[ MOVEI A,SLVIOWD ;Set up channel program area
MOVEM A,SLVICWA
SETZM SLVIOWD+1
SETZM SLVICWA+1
];KAKL
SETOM DRIVE ;For now, assume all drives on-line.
MOVE A,[DRIVE,,DRIVE+1]
BLT A,DRIVE+NDRIVE-1
MOVEI A,NUNITS-1 ;Say TUTs not in yet
SETOM QPKN(A)
SOJGE A,.-1
SETZM GOGOX ;Not in automatic mode.
SETZM NOQUES ;Ask questions.
NTS,[
TM10,[ CONSZ MTC,7 ;If Data Channel Magtape subsystem?
SETOM TMDCP
];TM10
];NTS
CALL UPLPT ;Turn on lineprinter if any.
INIT99: JRST @INIT ;End of initialization.
CHKR0: JSR INIT ;Ask questions mode.
TYPE T,"~2&Salvager ~S~&",[VERSHN]
MOVEI A,NUNITS-1
SETZM QACT(A)
SOJGE A,.-1
TYPE T,"~&Active unit numbers? "
CHKR1: CALL NTYI ;Get a digit.
JRST CHKR2
CAIGE A,NUNITS
SETOM QACT(A)
JRST CHKR1
CHKR2: CALL ACTUN
CHKR3: TYPE T,"~&Use MFD from unit: "
CALL NTYI
JRST CHKR3
CAIGE A,NUNITS
SKIPN QACT(A)
JRST CHKR3
MOVEM A,MDSK
CALL DRPHAS ;Verify all dirs on all packs are in phase.
SETZM CKFLSW
SETZM CKFIX
DC, ASKYN "~&Check files for clobbered blocks?"
.ELSE ASKYN "~&Read all blocks of all files?"
CAIA
SETOB A,CKFLSW
JUMPGE A,CHKR4
DC,[ SETZM CKFIX
ASKYN "~&Fix pointers then?"
CAIA
SETOM CKFIX
];DC
CHKR4: TYPE T,"~&Get user dirs from unit: "
CALL NTYI
JRST CHKR4
CAIGE A,NUNITS
SKIPN QACT(A)
JRST CHKR4
MOVEM A,UDSK
CRR
JRST SALV1
GOGO2: TYPE T,"~2&Salvager ~S~&",[VERSHN]
SETOM GOGOX ;Automatic mode.
MOVEI A,NUNITS-1 ;Assume all units are active.
SETOM QACT(A)
SOJGE A,.-1
CALL ACTUN ;Activate all units that are really on-line.
CALL GOODUN ;Ensure that packs are mounted.
MOVEM I,MDSK ;First active unit (to get MFD and UFD from).
MOVEM I,UDSK
CALL DRPHAS ;Verify that UFDs on all packs are in phase.
SETZM CKFLSW ;Don't check all blocks.
JRST SALV1
SUBTTL Activating the Disks
;;; RSTALL - Reset all active disks
RSTALL: PUSH P,I ;Don't smash I.
MOVEI I,0 ;Start with lowest disk.
RSTAL1: SKIPE QACT(I) ;If it is active
CALL RESET ; reset it.
CAIGE I,NUNITS-1 ;Do this for all disks.
AOJA I,RSTAL1
POP P,I
RET
;;; ACTUN - Activate all units which are on line.
ACTUN: MOVEI C,NUNITS-1
ACTUN2: SKIPN QACT(C)
JRST ACTUN1
MOVE I,C
CALL RESET
SKIPN QACT(C) ;Still there?
JRST ACTUN1
MOVE I,C
MOVE A,QOTUTO(I)
CALL RDTUT
JUMPL T,ACTUE1
MOVE I,QOTUTO(C)
MOVE A,QPKNUM(I)
ANDI A,37
MOVEM A,QPKN(C)
SKIPE NOQUES
JRST ACTUN1
MOVE A,QPAKID(I)
MOVE B,QPKNUM(I)
TYPE T,"~&Unit #~D. ID is ~S, Pack #~D",[C,A,B]
SH,[
MOVE A,PKNUM(C) ;If we have hardware pack number
CAMN A,QPKNUM(I) ; don't bother if they agree.
JRST ACTUN4 ;Print 'em if virtual units.
T300,[ CAIL C,T300P ;If hacking T-300s,
JRST ACTUN4 ; PKNUM not really set up.
];T300
TYPE T," (hardware says ~D.)",[A]
];SH
ACTUN4: SKIPN A,QTRSRV(I)
JRST ACTUN5
CAMN A,[-1]
JRST [ TYPE T,"(Reserved)"
JRST ACTUN5 ]
TYPE T," ~S:",[A]
ACTUN5: CRR
ACTUN1: SOJGE C,ACTUN2
SETOM ACTIVE
RET
NTS,[
;;; GOODUN - Make sure all necessary packs are mounted
;;; Returns master disk # in I.
GOODUN: MOVEI A,FIRSPK
GOODN1: MOVEI C,NUNITS-1
GOODN2: SKIPE QACT(C)
CAME A,QPKN(C)
SOJGE C,GOODN2
SKIPGE C
LOSE "~&Pack #~D not mounted.",[A]
CAIGE A,LASTPK
AOJA A,GOODN1
MOVEI A,LASTPK-FIRSPK+1 ;Number of primary packs.
MOVEI C,NUNITS-1 ;Scan for secondary packs.
GOODN4: SKIPN QACT(C)
JRST GOODN5
MOVE B,QOTUTO(C)
SKIPE B,QTRSRV(B)
CAMN B,[-1]
JRST GOODN5
ADDI A,1 ;This secondary pack is ok to have mounted.
GOODN5: SOJGE C,GOODN4
MOVEI C,NUNITS-1 ;Find master disk (lowest numbered active unit)
SKIPE QACT(C) ;Compute good packs - all packs in A.
JRST [ MOVE I,C
SOJA A,.+1 ]
SOJGE C,.-2
JUMPGE A,CPOPJ
LOSE "~&Extra packs mounted."
];NTS
TS, GOODUN: RET
SUBTTL SALVATION - Main Salvager
;;; DRPHAS - Check that directories are in phase on all packs
.SEE MDNUM
NTS,[
DRPHAS: MOVEI I,NUNITS-1 ;This many disks.
DRPHS1: SKIPN QACT(I) ;First, get all the MFDs.
JRST DRPHS2 ; When gots, check phase.
MOVE J,MFDBK ;Find where MFD block will be on disk.
MOVE A,QNTUTO(I) ;Ptr to this disk's MFD in core.
CALL READ ;Slurp.
JUMPL T,ACTUE3 ; Eh?
DRPHS2: SOJGE I,DRPHS1 ;Hack next disk.
MOVE I,MDSK ;Get MFDs from here.
MOVE A,@QNTUTO(I) ;Get that ascending directory number.
MOVE B,A ;Don't bash it.
SUBI B,1 ;Allowed to be off at most by 1 less.
MOVEI I,NUNITS-1 ;Now compare againts the other MDNUMs.
DRPHS3: SKIPE QACT(I) ;Only check disks which are active.
JRST [ CAMG B,@QNTUTO(I)
CAMGE A,@QNTUTO(I)
JRST DRPHS6 ; Looks bad.
JRST .+1 ] ;Else check next MDNUM.
SOJGE I,DRPHS3
RET
DRPHS6: TYPE T,"~&Directories out of phase."
MOVEI I,0 ;Start with lowest numbered disk.
DRPHS4: SKIPN QACT(I) ;If not active
JRST DRPHS5 ; check next disk.
HRRZ A,I ;Unit number.
MOVE B,QPKN(I) ;Get pack number.
MOVE C,@QNTUTO(I) ;Get MDNUM.
TYPE T,"~&Unit #~O, Pack ~D. Ascending dir number is ~O",[A,B,C]
DRPHS5: CAIGE I,NUNITS-1 ;All disks mentioned?
AOJA I,DRPHS4 ; No, do next one.
TYPE T,"~&Verify that the proper packs are mounted.~@
If you aren't sure, get help. If they are proper,~@
and one is just coming on-line after being off for~@
a while, you will have to UCOP to it."
ERR
RET
];NTS
TS, DRPHAS: RET
;;; SALV1 - Main entrypoint for salvaging.
;;;
;;; Rebuilds TUTs, Checks NUDSLs; Garbage collects empty UFDs.
SALV1: SETZM MFDWRT ;MFD not hacked yet (ie., no UFDs GC'd)
SETZM SHARED ;No shared blocks found yet.
MOVEI I,NUNITS-1 ;# disks.
SALV2: SKIPN QACT(I) ;Frob only active disks.
JRST SALV3
HRRZ B,QNTUTO(I) ;Gonna rebuild the TUT.
HRL B,B ;Ptr to new TUT.
SETZM (B) ;Gonna zap new TUT.
MOVE A,B
AOS B
BLT B,2000*MXTUTB-1(A) ;Fresh slate.
HRRZ B,QNTUTO(I) ;Ptr to old TUT.
HRL B,QOTUTO(I)
MOVE A,B
BLT A,LTIBLK-1(B) ;Copy random info from old TUT to new.
HRRZ A,QNTUTO(I)
CALL TUTFIL ;Fill in blocks area of TUT.
SALV3: SOJGE I,SALV2 ;Do all active TUTs.
MOVE I,MDSK ;Get master disk.
MOVEI A,MFD ;Want an MFD.
MOVE J,MFDBK ;Block on disk.
CALL READ ;Get it.
JUMPL T,ACTUE3 ; Bogus QACT?
SETZM LUFDS ;No UFDs checked yet.
MOVE A,MFD+MDNUDS ;Check NUDSLs.
CAME A,NUDS
LOSE "~&Wrong NUDSL: ~D.",[A]
MOVE A,MFD+MDCHK ;Get check word.
CAME A,MFDCHK ;OK?
JRST [ TYPE T,"~&MFD check word garbaged? ~S",[A]
SKIPN GOGOX ;Unless in automatic mode
CALL CONTIN ; Ask user if we should bother.
BARF ; Otherwise lose now.
JRST .+1] ; Keep going.
MOVE Q,MFD+MDNAMP ;Now check name area.
ADDI Q,MFD ;Ptr to it.
MFDLUP: CAIL Q,MFD+2000 ;Past name area?
JRST MFDFIN ; Yes, done.
SKIPN A,MNUNAM(Q) ;User name?
JRST MFDLU1 ; No, try next name.
CALL USRLUP ;Look up UFD.
SKIPN LFILES ;Gots any files?
CALL DELUSR ; No, GC this directory.
MFDLU1: ADDI Q,LMNBLK ;Check next name in MFD.
JRST MFDLUP ;Loop for all names.
SUBTTL Main Salvager - Write MFD & TUT
MFDFIN: SKIPE NOISE
TYPE T,"~&Checking TUT differences."
MOVEI I,0 ;Use disk zero.
MFDFN0: SKIPE QACT(I) ;If it is active
CALL TUTCMP ; compare TUTs.
CAIGE I,NUNITS-1 ;Compared all units?
AOJA I,MFDFN0 ; No, keep trucking.
SKIPN MFDWRT ;If te MFD does not need writing
JRST SHARCK ; proceed directly to hack shared blocks.
MFDWR0: SKIPE NOQUES ;Else maybe ask permission from user.
JRST MFDWR1 ; If in no-questions mode just do it.
ASKYN "~&Write out changes in MFD"
JRST SHARCK ; Use may elect not to update MFD (ha!)
MFDWR1: MOVE J,MFDBK ;OK, gonna write out the MFD.
MOVEI I,NUNITS-1 ;On each unit.
MFDWR2: MOVEI A,MFD ;MFD in core.
SKIPE T,QACT(I) ;For each active disk
CALL WRITE ; Write out the MFD.
SKIPGE T ; Oh, shit.
JRST [ TYPE T,"~&Error writing out the MFD:~%"
CALL GSTS ; Print controller status.
SKIPE GOGOX ; If in automatic mode
BARF ; just lose.
JRST MFDWR0 ] ; Else ask if we should proceed.
MFDWR3: SOJGE I,MFDWR2 ;Loop for all disks.
;Fall in to SHARCK.
SUBTTL Main Salvager - Track Down Shared Blocks
SHARCK: SKIPN SHARED ;Any shared blocks?
JRST [ SKIPE NOISE ; No, all done!
TYPE T,"~&Done Salvaging ~D user directories.",[LUFDS]
PUNT ]
TYPE T,"~&Tracking down shared blocks."
MOVE I,MDSK ;Get master disk.
MOVEI A,MFD ;Gonna get an MFD from it.
MOVE J,MFDBK ;Into the usual place.
CALL READ ;Read it.
JUMPL T,ACTUE3 ; Bogus QACT?
MOVE Q,MFD+MDNAMP ;Fetch name pointer.
ADDI Q,MFD ;Check user name blocks.
SMFDLP: CAIL Q,MFD+2000 ;When checked them all
JRST SHRCKF ; Yow, are we confused yet!
SKIPN A,MNUNAM(Q) ;Get username.
JRST SMFDL1 ; Missing? Try next.
CALL SUSRLP ;OK, check.
SMFDL1: ADDI Q,LMNBLK ;Next name block.
JRST SMFDLP ;Loop for all name blocks.
SHRCKF: SKIPN GOGOX ;Hmmm, thought there were
PUNT ;shared blocks but could
BARF ;not find them.
;;; SUSRLP - Check for shared blocks.
;;; Q/ MFD ptr to UFD we are hacking
SUSRLP: HRREI J,-MFD-2000(Q) ;Convert MFD index to block number.
ASH J,-1
ADD J,NUDS
MOVEM A,USRNAM ;Remember UFD we're hacking.
PUSH P,Q
MOVE I,UDSK
PUSH P,UDSK
SUSRL1: MOVEI A,OUSRD
CALL READ ;Read it in.
JUMPGE T,SDIRL1 ;OK.
MOVEM J,DBLK ;Remember which block.
TYPE T,"User Directory parity error block #~D, unit ~D~%",[DBLK,I]
CALL GSTS ;Print controller status.
ERR
ASKYN "Try next drive"
BARF
MOVE I,UDSK ;Start with disk read UFD from.
SUSRER: AOS I ;Try next one.
CAIL I,NUNITS ;If no next one
SUBI I,NUNITS ; try counting down instead.
SKIPN QACT(I) ;Make sure it's active.
JRST SUSRER
MOVEM I,UDSK ;OK, it's active
MOVE J,DBLK ;Block where UFD
JRST SUSRL1 ;Try UFD from this disk.
SDIRL1: MOVEI Q,2000-LUNBLK+OUSRD
MOVEI J,OUSRD ;Examine UFD.
ADD J,UDNAMP(J) ;Ptr to name area.
PUSH P,J ;Popped off later.
SDIRL2: CAML Q,J ;Checked last file?
JRST SDIRL3 ; No, keep going
SUSRFN: POP P,J ;All done.
POP P,UDSK
POP P,Q
RET
SDIRL3: MOVEM Q,LASTQ ;Check this file.
SKIPE A,UNFN1(Q) ;Get FN1.
JRST .+3
SKIPN UNFN2(Q) ;Get FN2.
JRST SDIRLP ;Missing filename - try next file.
LDB C,[UNPKN UNRNDM(Q)] ;Get pack the file is on.
LDB A,[UNDSCP UNRNDM(Q)] ;Get ptr to descriptor.
IDIVI A,UFDBYT ;Number of bytes.
ADDI A,OUSRD+UDDESC
HLL A,QBTBLI(B)
TLNE A,400000 ;Ptr into UFD.
SUB A,[440000,,1] ; (Starts before first byte.)
MOVE N,A
MOVEI J,0
ILDB B,A ;Get byte.
SDIRL4: MOVE E,UNRNDM(Q) ;Get random bits.
TLNE E,UNLINK ;If this is a link
JRST SDIRLP ; do next file.
CALL FINDPK ;Where is the pack mounted.
SKIPL C
SKIPN QACT(C) ;Make sure drive is active.
JRST SDIRLP ;Pack not mounted, try next file.
CAIG B,UDWPH ;If this is just a write-place-holder.
JRST SDIRLP ; try next file.
STRLUP: ILDB B,N ;Check blocks this file.
JUMPE B,SDIRLP ;If end of desc, hack next file.
CAIN B,UDWPH ;If write-place-holder
JRST STRLUP ; hack next file.
CAIGE B,UDWPH ;If not a take-n code
JRST STRSKP ; skip it.
SLOAD: ;; 8/20/90 DM "funny" bit officially gone
;; ANDCMI B,20 ;Flush the DM funny bit.
MOVEI J,-UDWPH-1(B) ;Compute load address for
MOVEI K,NXLBYT ;the block.
SLOAD1: ILDB B,N
LSH J,6
ADD J,B
SOJG K,SLOAD1 ;J gets entire load address.
MOVE Q,J ;Remember it.
MOVE I,C ;Unit where file's pack is mounted.
CALL TUTPNN ;Get Bp to TUT.
ADD J,[TUTBYT_14,,] ;Compensate for ILDB.
MOVEI B,1 ;Only check one block.
JRST STLUP1 ;So, go check it already!
;;; Here to skip some blocks.
STRSKP: CAIG B,UDTKMX ;If not blocks to skip
JRST STLUP
SUBI B,UDTKMX ;Else compute # blocks to skip.
STRSK1: IBP J ;Skip them.
AOS Q
SOJG B,STRSK1 ;Skip all blocks we're supposed to.
MOVEI B,1 ;We need to tattle on one block only.
STLUP: AOS Q ;Ptr back to file it belongs to.
STLUP1: ILDB D,J ;Get reference count for this block.
CAIE D,1 ;If more than one user of it
CALL [ PUSHER P,[A,B,C]; It's a nasty ole' shared block.
EXCH Q,LASTQ ; Which we're gonna tattle on.
MOVE A,UNFN1(Q) ; Nasty old FN1
MOVE B,UNFN2(Q) ; Nasty old FN2.
HRRZ D,C ; Unit the file is on.
TYPE LPT,"~&~S ;~S ~S ~D-~D, TUT=~D",[USRNAM,A,B,C,LASTQ,D]
EXCH Q,LASTQ
POPPER P,[C,B,A]
RET ]
SOJG B,STLUP ;Tattle on each nasty ole block.
JRST STRLUP ;When done,
SDIRLP: MOVE Q,LASTQ ;Find next file.
SUBI Q,LUNBLK
MOVE J,(P) ;Recover name area ptr.
JRST SDIRL2 ;Go see if we checked the last file.
SUBTTL Garbage Collect a UFD
;;; DELUSR - Flush UFD from Q.
DELUSR: MOVE A,MNUNAM(Q) ;Get UFD name.
CAME A,[SIXBIT /.LPTR./];Don't flush this directory.
CAMN A,[SIXBIT /.KLFE./] ;Make these UFDs sacred.
JRST DELUS9
TYPE T,"~&~S has no files, User File Directory DELETED",[A]
SETZM MNUNAM(Q) ;Zap his name.
SETOM MFDWRT ;Say we munged the MFD.
DELUS9: RET
SUBTTL Main Salvager - Check a UFD
USRLUP: MOVEM A,USRNAM ;Remember who we're hacking.
SETZM UFDLOS ;Not losing yet.
SETZM UFDSEE ;Don't print the UFD upon lossage.
SETZM LFILES ;No files found yet.
MOVE J,Q
SUBI J,MFD+2000 ;Map MFD entry into UFD block.
IDIVI J,LMNBLK ;-Nth UFD.
ADD J,NUDS ;End of user dir area -N.
PUSH P,Q
PUSH P,UDSK ;Save UFD disk, might change if UFD is bad.
MOVEM J,DBLK ;Remember directory number.
MOVE I,UDSK ;Start with this disk.
USRLU1: MOVEI A,OUSRD ;Come back to here on try next drive.
CALL READ ;Read the UFD from this disk.
JUMPGE T,USRLU2 ;Got it.
TYPE T,"~&UFD Read Error"
SETOM HARDER ;Fuck me harder.
USRLER: TYPE T," ~S;~%",[USRNAM]
SKIPE HARDER ;If hardware lost
CALL GSTS ; print controller status.
SETZM HARDER ;Reset hardware losing flag.
ERR ;Maybe continue.
ASKYN "~&Try next drive?"
PUNT ;Maybe not.
MOVE I,UDSK ;Disk to get UFD from.
USRL2B: AOS I ;Try next disk.
CAIL I,NUNITS ;If there is no next disk
SUBI I,NUNITS ; use the highest numbered one.
SKIPN QACT(I) ;If the disk is not active
JRST USRL2B ; Try next higher disk.
MOVEM I,UDSK ;(Will get popped before next user)
SETOM UFDLOS ;Cause dir to be written on all drives.
MOVE J,DBLK ;Remember which losing UFD to hack.
JRST USRLU1 ;Retry.
USRLU2: MOVE Q,OUSRD+UDNAME ;All disks should have the same UFD here.
CAMN Q,USRNAM ;If they do
JRST USRLU3 ; things are OK.
TYPE T,"~&UFD on unit ~D block ~D is ~S, but expected ~S.",[I,DBLK,USRNAM,OUSRD+UDNAME]
ERR
ASKYN "Correct it? (taking MFD entry as good)"
BARF
MOVE A,USRNAM ;Else use user name from master disk MFD.
MOVEM A,OUSRD+UDNAME ;Change name of old UFD.
MOVEI A,OUSRD
CALL WRITE ;Write it back out to disk.
JUMPL T,WRERR
USRLU3: MOVE Q,[OUSRD,,NUSRD] ;Ptr from original to copy.
BLT Q,NUSRD+1777 ;Copy old for garbage check.
MOVEI Q,2000-LUNBLK+OUSRD ;Q gets addr of old name block.
MOVEI J,OUSRD ;J gets addr of old UFD.
ADD J,UDNAMP(J) ;Origin of file name area (lowest file name block).
CAIG J,OUSRD+2000 ;Make sure ptr to file is within UFD,
CAIGE J,OUSRD+UDDESC ; and inside descriptor area.
JRST [ TYPE T,"~&User directory name-pointer scrambled"
JRST USRLER ]
MOVE T,OUSRD+UDESCP ;Get ptr to descriptor area.
IDIVI T,UFDBYT ;Before using it, see if plausible ptr.
ADDI T,OUSRD+UDDESC
CAML T,J
JRST [ TYPE T,"Name area, descriptor area overlap"
JRST USRLER ]
PUSH P,J ;Stash file name ptr.
JRST DIRL1 ;First time falls in.
;;; DIRLUP - Per file loop.
;;; Q/ addr of old UFD name block
;;; J/ addr of old UFD
DIRLUP: SKIPN BADFIL ;Retrieval error?
JRST DIRLP1 ; No, hack next file.
TYPE T,"Bad retrieval: "
CALL PNTNAM ;Print file name.
DIRLP1: MOVE Q,LASTQ ;Start with file last block.
MOVE J,(P) ;Recover ptr to name area.
MOVSI A,UNMARK ;Reset GC bit for this file.
ANDCAM A,UNRNDM(Q) ;GC unmark.
SUBI Q,LUNBLK ;Point back to name block.
;;; First, examine the name area.
DIRL1: CAMGE Q,J ;If past beginning of UFD
JRST USRFIN ; finish up by checking for extra garbage
SETOM FILEER ;Print file name only on first error.
SETZM BADFIL ;No bad retrievals discovered yet.
MOVEM Q,LASTQ ;Stash ptr to file.
SKIPN A,UNFN1(Q) ;Get FN1.
SKIPE UNFN2(Q) ;Get FN2.
CAIA
JRST DIRLUP ; Eh?
AOS LFILES ;Ok, here's a file.
LDB C,[UNPKN UNRNDM(Q)] ;Get pack number.
LDB A,[UNDSCP UNRNDM(Q)];Get ptr to desc wds.
CAML A,OUSRD+UDESCP ;If it points outside the descriptor area.
JRST [ CALL LPTNAM
TYPE LPT,"~%Desc points out of desc area"
ERR
SETOM UFDSEE ; Too weird!
JRST DIRLUP ] ; Next UFD, please.
;;; Now examine the UFD file descriptor area.
IDIVI A,UFDBYT ;Cons up a Bp into the UFD.
ADDI A,OUSRD+UDDESC ;The first descriptor.
HLL A,QBTBLI(B) ;Retrieve Bp.
TLNE A,400000 ;First word?
SUB A,[440000,,1] ; Yes, back up one.
MOVEI Z,0 ;Accumulate new descriptor bits here.
LDB B,A ;Get last word of previous descriptor.
JUMPN B,[ CALL LPTNAM ; All descriptors end with a zero word.
TYPE LPT,"File not preceeded by zero~%"
ERR
SETOM UFDSEE ; Saw a weird UFD.
JRST DIRL2 ] ; Examine the rest of it.
DIRL2: MOVE N,A ;Get Bp to descriptor.
MOVEI J,0
ILDB B,A ;Get first word of descriptor.
JUMPE B,[ CALL LPTNAM ; Slot should not be free.
TYPE LPT,"File points to zero~%"
ERR
SETOM UFDSEE ; Saw a weird UFD.
JRST .+1 ]
DIRL3: MOVE E,UNRNDM(Q) ;Get random bits.
TLNE E,UNLINK ;If this is a link
JRST DIRLNK ; go hack it.
SETZM NOTUT ;Otherwise probably a file (TUT active).
CALL FINDPK ;Find which pack file lives on.
SKIPL C ;Pack mounted?
SKIPN QACT(C) ; Yes, Active unit?
SETOM NOTUT ; File on unmounted pack, don't hack TUT.
MOVEM C,FUNIT ;Remember which unit file's on.
SETZM LSTBLK ;Dont know last block yet.
SETZM ADRSET ;Address not set.
TRLUP: MOVE E,N ;Bp to descriptor.
ADDI E,NUSRD-OUSRD ;Point into new descriptor.
IDPB Z,E ;Put bits into this copy.
ILDB B,N ;Get descriptor byte.
JUMPE B,DIRLUP ;Not expecting descriptor end: Bad retrieval.
CAIN B,UDWPH ;Null file?
JRST TRLUP ; skip this write-place-holder.
CAIL B,UDWPH ;Take-N code?
JRST LOAD ; Yes, get load address.
CAILE B,UDTKMX ;If larger than highest Take-N
CALL SKIPF ; Skip some.
JRST TLUP
SKIPF: SUBI B,UDTKMX ; Subtract highest Take-N code.
IBP J ; Next block number.
AOS Q ; (Next block number.)
SOJG B,.-2
MOVEI B,1
RET
LOAD: SETOM ADRSET ;Say we have a load address.
;; 8/20/90 DM "funny" bit officially gone
;; ANDCMI B,20 ;Ignore DM funny bits (whatever those are).
MOVEI J,-UDWPH-1(B) ;J gets load address first part.
MOVEI K,NXLBYT ;Need above 5 bits plus NXLBYT bits.
LOAD1: MOVE E,N ;Get Bp to descriptor.
ADDI E,NUSRD-OUSRD ;Point into new UFD.
IDPB Z,E ;Zap some more bits into it.
ILDB B,N ;Get next descriptor byte.
LSH J,UFDBYT ;Swish it over.
ADD J,B ;Add in to get load address.
SOJG K,LOAD1 ;Get the entire load address.
MOVE Q,J ;Q gets load address (file block).
SKIPE NOTUT ;If TUT not active for this file
JRST LOAD2 ; no TUT ptr.
MOVE I,C ;Disk unit this file is on.
CALL TUTPNN ;J gets ptr to new TUT.
JUMPE J,[ LOSE "~&LOAD tried to find TUT for unTUTed file block ~D.",[Q] ]
ADD J,[TUTBYT_14,,] ;Back up for ILDB.
LOAD2: MOVEI B,1 ;Hack only one block.
JRST TLUP1
;;; Examine the TUT to be sure that the file's blocks are properly in use.
TLUP: AOS Q ;Each time through loop check next block.
TLUP1: MOVE A,Q ;Block to check.
SKIPE ADRSET ;If address set
JRST TLUP2 ; Read in block's TUT info.
CALL LPTNAM ;Else complain
TYPE LPT,"Starting Address not set"
DIRLER: LPRCRR ;Here for TUT errors.
ERR
SETOM UFDSEE
JRST CKFL3
TLUP2: SKIPE NOTUT ;File on active unit?
JRST CKFL3 ; No, skip it.
MOVE D,QOTUTO(C) ;Get old TUT.
CAMGE A,QLASTB(D) ;Block may not be after last TUTed block
CAML A,QFRSTB(D) ; Or before first block.
JRST TLUP3 ; If outside range, complain.
CALL LPTNAM
TYPE LPT,"Block points off dsk (past last TUTed block) ~D",[A]
JRST DIRLER
TLUP3: CAMGE A,NUDS ;Block should be past special hacking area.
JRST DIRLE1
CKFL2A: MOVSI D,-LSBTAB ;Check against all special blocks.
CAMN A,SBTAB(D)
JRST DIRLE1
AOBJN D,.-2 ;Loop through all special blocks.
MOVE D,MFDBK
SUB D,NTBL(C)
CAML A,D ;Is block part of TUT?
CAMLE A,MFDBK ; or part of MFD?
CAIA ; No.
DIRLE1: JRST [ CALL LPTNAM ;Here when block is in reserved area.
TYPE LPT,"Block in reserved area: ~D",[A]
JRST DIRLER ]
NTS, SKIPGE CKFLSW ;Checking for clobbered file blocks?
NTS, CALL CKFL ; Yes, do so.
MOVEM Q,LSTBLK ;Remember last block in file.
SKIPN NOTUT ;TUT active?
SKIPN ADRSET ; Yes, address set?
JRST CKFL3 ; No, check next file.
MOVE D,J ;Bp to block info.
SUBI D,NTUT0-OTUT0 ;In old TUT.
ILDB D,D ;Get block state.
CAIN D,TUTLK ;Blocked already locked out?
JRST [ CALL LPTNAM ; Yes, mention it.
TYPE LPT,"File contains locked block ~D~%",[Q]
SETZM SALVRT ;Don't allow auto startup of ITS.
JRST .+1 ]
ILDB D,J ;Get usage count.
SKIPE D ;If not in use
JRST [ LPRCRR
CALL LPTNAM
TYPE LPT,"Shares block with some other file"
AOS SHARED ;Shared block flag.
SETZM SALVRT ;NO automatic sys start.
JRST .+1 ]
CAIGE D,TUTMNY ;Unless maximum count
AOS D ; count it again.
DPB D,J ;Update usage count in new TUT.
MOVE K,J
SUBI K,NTUT0-OTUT0 ;K gets same ptr in old TUT.
LDB D,K ;Update usage count in old TUT too.
SKIPN D ;If usage count zero
JRST [ SKIPE NOQUES ; Complain.
JRST CKFL3
TYPE LPT,"~%File unprotected in old TUT, Block ~D. - ",[Q]
CALL LPTNAM
JRST CKFL3 ]
CKFL3: SOJG B,TLUP ;Do next block.
JRST TRLUP
;;; Here to examine a link.
DIRLNK: MOVE E,N ;Bp into descriptor.
ADDI E,NUSRD-OUSRD ;Point into new UFD.
CALL LTYPE ;Check sname.
JRST DIRLN6
CALL LTYPE ;Check FN1.
JRST DIRLN6
CALL LTYPE ;Check FN2.
JRST DIRLUP
ILDB B,N ;Get terminator.
JUMPE B,DIRLUP ;Link should be follwed by a zero.
TYPE LPT,"~&Link not followed by a zero"
JRST DIRLN7
DIRLN6: CALL LPTNAM ;Here if not three names long.
TYPE LPT,"~&Link not three names"
DIRLN7: ERR ;Here when something wrong with link.
SETOM UFDSEE ;Better print UFD later.
JRST DIRLUP ;Do next file.
;;; LTYPE - Hack a link name.
;;; Skip returns if encounters zero (error).
LTYPE: MOVEI B,6
LTYPE2: IDPB Z,E ;Z accumulates the link.
ILDB A,N ;Get a byte.
JUMPE A,CPOPJ ;Not expecting zeros in the link.
CAIN A,': ;Quoting character?
JRST [ ILDB A,N ; No, get char.
IDPB Z,E ; Stuff it.
JRST LTYPE3] ; Get another.
CAIE A,'; ;
LTYPE3: SOJG B,LTYPE2 ;Get all words.
JRST POPJ1 ;Skip return if ends naturally.
;;; Finish up our examination of this UFD.
USRFIN: AOS LUFDS
MOVE Z,NOISE
CAMN Z,[-2]
TYPE T,"~&Finishing #~D~16T~S~26TQ=~D,~32TJ=~D.",[LUFDS,USRNAM,Q,J]
SETZM GARBF ;No garbage in free area yet.
SETZM EXGARB ;No extra garbage in UFD yet.
CLEARB Z,J ;Z will accumulate bits.
MOVE Q,[440600,,NUSRD+UDDESC] ;Bp to new descriptor words.
GARB2: CAML J,OUSRD+UDESCP ;Check ptr to descriptor area.
JRST USRFN2 ; OK if really points into right area.
GARB4: ILDB B,Q ;Otherwise, what are these bits about?
JUMPE B,GARB3 ;Better be zero.
SETOM UFDSEE ;Else garbage in descriptor area
SKIPN EXGARB ;Tell user about it.
JRST [ TYPE LPT,"~&Extra garbage in UFD ~S; block #~D.",[USRNAM,DBLK]
ERR
SETOM UFDLOS ;UFD losing.
SETOM EXGARB ;Extra garbage seen.
JRST .+1 ]
TYPE T,"~&~O ~O",[J,B] ;Print out garbage words.
MOVE E,Q ;Get back Bp to new descriptors.
SUBI E,NUSRD-OUSRD ;Point into old UFD.
DPB Z,E ;Clear out extra garbage in old UFD.
GARB3: AOJA J,GARB2 ;Check all descriptor words.
USRFN2: TLNE Q,770000 ;Done this descriptor word?
JRST GARB4 ; No.
MOVEI Q,-NUSRD+1(Q) ;Check free space pointer.
GARB6: CAML Q,NUSRD+UDNAMP ;Likely?
JRST GARB5 ; Yes, done hacking this UFD.
SKIPN NUSRD(Q) ;If ptr not already in new UFD?
AOJA Q,GARB6 ; go insert it.
SETOM UFDSEE ;Else extra garbage is in the free area.
SKIPN GARBF
JRST [ TYPE LPT,"~&Garbage in free area~%~S; block ~D~%",[USRNAM,DBLK]
ERR
SETOM UFDLOS
SETOM GARBF
JRST .+1 ]
MOVE A,NUSRD(Q) ;Get garbage from new UFD.
ANDCAM A,OUSRD(Q) ;Clear out the garbage in the old version.
TYPE LPT,"~&Pointer= ~O, Garbage is ~O",[Q,A]
AOJA Q,GARB6 ;Do next block.
GARB5: SKIPE UFDSEE ;Saw a weird cookie UFD.
CALL UFDPR ;Print it out.
SKIPN UFDLOS ;Garbage found in UFD?
JRST USRFN5 ; No, done.
SKIPE NOQUES ;If no questions
JRST GARB5A ; just fix it.
ASKYN "UFD needs update - Write"
JRST USRFN5
GARB5A: MOVEI A,OUSRD ;UFD.
MOVEI I,NUNITS-1 ;This many disks.
MOVE J,DBLK ;This directory block.
GARB7: SKIPE QACT(I) ;Use only online units.
JRST [ CALL WRITE ; Write out this UFD.
JUMPL T,WRERR
JRST .+1 ]
SOJGE I,GARB7 ;Loop for all drives.
USRFN5: POP P,J ;Done.
POP P,UDSK
POP P,Q
RET
;;; CKFL - Check all blocks of a file for clobberage.
;;; Note well: Only tries to fix errors on a DC-10 controller!
;;; A/ block
;;; C/ unit file is on
;;; Returns in Q the last block of the file.
CKFIX: 0 ;-1 iff auto fix retrieval pointers
UNIT: 0 ;unit
CKFL: PUSHER P,[J,I]
SETOM XWDSEE ;Haven't typed out extra words.
MOVE J,A ;Get block number.
MOVEI A,FDBUF ;Reading into buffer.
MOVE I,C ;Unit file is on.
CALL READ ;Read it in.
CKFLBP: JUMPL T,CKFLE1 ; If lossage, report it.
CKFL4: ;If DC-10 controller, try to fix it.
DC,[ MOVE A,RXWDS+XWSYSN
CAME A,USRNAM
JRST CKFLE2
CKFL5: LDB A,[XWBLK RXWDS]
CAME A,LSTBLK
JRST CKFL6
CKFL6A: SKIPE CKFIX ;FIX ERRORS?
SKIPGE XWDSEE ;ANY ERRORS?
JRST CKFL7
LDB A,[XWAWC RXWDS]
DPB A,[XWAWC WXWDS]
MOVE A,LSTBLK
DPB A,[XWBLK WXWDS]
MOVE A,USRNAM
MOVEM A,WXWDS+XWSYSN
MOVE Q,LASTQ
MOVE A,UNFN1(Q)
MOVEM A,WXWDS+XWFN1
MOVE A,UNFN2(Q)
MOVEM A,WXWDS+XWFN2
MOVEI A,FDBUF
CALL WRITE
MOVEI A,FDBUF
CALL READ
JUMPL T,CKFLE1
TYPE LPT,"Retrieval now:"
CALL LPTXWD
SETOM XWDSEE
JRST CKFL4
];DC
CKFL7: POPPER P,[I,J]
RET
CKFLE1: CALL PNTNAM
TYPE T,"Error reading block "
CKFLE3: MOVE A,J
TYPE T,"~D~%",[J]
CALL PNTXWD
CALL GSTS
JRST CKFL4
DC,[
CKFLE2: JRST CKFL6A ;JFCL THIS IF YOU HATE ARCHIVES
AOS BADFIL
CALL LPTNAM
LPRTAB
CALL LPTXWD
LPRTAB
TYPE LPT,"Retrieval User-name differs"
LDB A,[XWBLK RXWDS]
CAMN A,LSTBLK ;Checking the last block?
JRST [ LPRCRR ; Yeah, kerchink.
JRST CKFL6A]
TYPE LPT,","
JRST CKFLE4
CKFL6: JRST CKFL6A ;JFCL THIS IF YOU HATE ARCHIVES
AOS BADFIL
CALL LPTNAM
LPRTAB
CALL LPTXWD
LPRTAB
CKFLE4: TYPE LPT,"Chain ptr wrong, Last block= ~D~%",[LSTBLK]
JRST CKFL6A
];DC
EXTRA,[
OLDFIL: SETOM UFDSEE ;Say to print whole UFD later.
AOSE FILEER ;File error detected.
JRST CKFL2A ; Continue checking.
TYPE T,"!!! Over-writing user-directory area block ~D, by",[Q]
CALL PNTNAM
JRST CKFL2A
];EXTRA
SUBTTL Main Salvager - TUT hackery
TUTCMP: SETZM TUTDFR ;No TUT differences encountered yet.
SETZM NLKBKS' ;Let's hack the 'tute...
SETZM TUTCHG ;Make summary table of differences
MOVE Q,[TUTCHG,,TUTCHG+1]
BLT Q,TUTCHG+<TUTMAX*TUTMAX>-1 ;Zap it.
MOVE Q,QTTBLI ;Get Bp to TUT.
HRR Q,QNTUTO(I) ;Into new TUT.
ADDI Q,LTIBLK ;First byte which maps the disk.
MOVE J,Q ;Get it.
HRR J,QOTUTO(I) ;Bp to old TUT.
MOVE E,QFRSTB(J) ;Get first block TUTed.
MOVE B,QLASTB(J) ;Get last block TUTed.
SOS B ;The one before it.
MOVEM B,TUTHIB' ;is the highest block #.
ADDI J,LTIBLK
TUTC1: ILDB B,Q ;Get old block info.
ILDB D,J ;Get new block into.
CAMN B,D ;If they are the same
JRST TUTC2 ; everything's cool.
CAIN D,TUTLK ;If new TUT says block locked
JRST [ MOVE B,D ; Keep it locked.
DPB B,Q ; Update the old TUT.
AOS NLKBKS ;Count blocks locked due to disk errors.
HRRZ A,I ;A gets TUT unit #.
SKIPN GOGOX ;If in CHKR mode, report locked blocks.
TYPE T,"~&Locked block ~D-~D",[A,E]
JRST TUTC2 ] ;Hack next block.
IMULI B,TUTMAX ;Ptr to summary table.
ADD B,D
MOVE T,QOTUTO(I)
CAML E,NUDS
CAML E,QSWAPA(T) ;Don't list TUT changes in swapping area.
AOS TUTCHG(B)
AOS TUTDFR ;Count TUT differences.
TUTC2: CAMGE E,TUTHIB ;If more disk blocks TUTed
AOJA E,TUTC1 ; do another one.
SKIPN NOQUES ;Else we are done checking the TUT.
SKIPN NLKBKS ;Any error-locked blocks?
SKIPA
TYPE T,"~&~D locked block~P on unit #~D",[NLKBKS,I]
SKIPN TUTDFR ;If TUT has not changed,
JRST TUTCM9 ; all done hacking the TUT.
;;; TUTCM0 Print TUT differences (falls in).
TUTCM0: SKIPE NOQUES ;Here when TUT has differences.
JRST TUTCM3 ;If no-questions mode, just write.
MOVEI A,TUTMAX*TUTMAX-1 ;See if any TUT diffs not in swapping area
SKIPN TUTCHG(A)
SOJGE A,.-1
JUMPL A,TUTCM4 ;None, go ask if should write.
TYPE T,"~&TUT #~D",[I] ;Otherwise, summarize TUT differences.
MOVEI B,TUTMAX-1
TUTSM1: MOVEI E,TUTMAX-1
TUTSM2: MOVE C,B
IMULI C,TUTMAX
ADD C,E
SKIPE C,TUTCHG(C)
TYPE T," ~D ~D_~D",[C,B,E]
TUTSM3: SOJGE E,TUTSM2
SOJGE B,TUTSM1
ASKYN "~&Print?"
JRST TUTCM4
SETZM TUTDFR ;Print out the TUT.
MOVE Q,QTTBLI
HRR Q,QNTUTO(I) ;Bp to new TUT.
ADDI Q,LTIBLK
MOVE J,Q
HRR J,QOTUTO(I) ;Bp to old TUT.
MOVE E,QFRSTB(J) ;Start with first block TUTed.
MOVE B,QLASTB(J) ;Finish with last one.
SOS B
MOVEM B,TUTHIB' ;Highest block #
ADDI J,LTIBLK
TUTCM1: ILDB B,Q ;Get old TUT data.
ILDB D,J ;Get new TUT data.
CAME B,D ;If they differ
CALL TUTDIF ; mention it.
TUTCM2: CAMGE E,TUTHIB ;Done comparison?
AOJA E,TUTCM1 ; No, keep going.
TUTCM4: ASKYN "~%TUT #~D need updating - Write",[I]
JRST TUTCM9
TUTCM3: MOVE A,QNTUTO(I) ;Get new TUT.
CALL WRTUT ;Write it out.
SKIPGE T ;Should work.
JRST [ TYPE T,"~&Error writing the TUT."
CALL GSTS ; Shit.
SKIPN GOGOX ; If in CHKR mode
JRST TUTCM4 ; ask again.
BARF ] ; Else don't continue in automatic mode.
TUTCM9: RET
;;; TUTDIF - Print TUT a difference if it's relavent
;;; I/ disk
;;; E/ block
;;; Clobbers A.
;;; Does not skip.
TUTDIF: MOVE T,QOTUTO(I) ;TUT info differs.
CAML E,NUDS ;See if relavent.
CAML E,QSWAPA(T)
CAIA
JRST TUTDF9 ;Ignore differences in swapping area.
HRRZ Z,I ;Get TUT unit.
SKIPN TUTDFR ;Print heading just once.
JRST [ TYPE T,"~&TUT differences for drive ~D~%",[Z]
SETZ A, ;Count frobs printed.
JRST .+1 ]
CAIE A,5. ;Print 5 per line.
JRST TUTDF6
CRR
SETZ A,
TUTDF6: TYPE T,"~D ~O_~O ",[E,B,D]
AOS A ;Count frobs printed.
SETOM TUTDFR ;Say we printed herald.
TUTDF9: RET
DBG,[
IFN 0,[
;;; TUTX - Print out the TUT information for a file.
;;; Q/ ptr to file in UFD
TUTX: PUSHER P,[Z,A,B,C,D,E,N,W,U,I,Q,T,TT,J,K] ;Smash nothing!
CRR
CRR
MOVE A,UNFN1(Q)
MOVE B,UNFN2(Q)
TYPE T,"~&~S; ~S ~S is ",[USRNAM,A,B]
MOVE E,UNRNDM(Q) ;Get random bits.
TLNE E,UNLINK ;If this is a link
JRST [ TYPE T,"a link."
JRST TUTX90 ]
LDB C,[UNPKN UNRNDM(Q)] ;Pack #.
MOVE D,C
CALL FINDPK ;Get disk # in C.
LDB A,[UNDSCP UNRNDM(Q)];Descriptor offset.
TYPE T," on pack ~D (mounted on unit ~O)~%FS desc offset = ~O",[D,C,A]
IDIVI A,UFDBYT
ADDI A,OUSRD+UDDESC ;The first descriptor.
HLL A,QBTBLI(B) ;Retrieve Bp.
TLNE A,400000 ;First word?
SUB A,[440000,,1] ; Yes, back up one.
MOVEI Z,0 ;Accumulate new descriptor bits here.
LDB B,A ;Get last word of previous descriptor.
JUMPN B,[ TYPE T,"~&Error: File not preceeded by zero"
JRST TUTX90 ]
MOVE N,A ;Get Bp to descriptor.
MOVEI J,0
ILDB B,A ;Get first word of descriptor.
JUMPE B,[ TYPE T,"~&Error: File points to zero"
JRST TUTX90 ]
TUTX10: MOVE E,N ;Bp to descriptor.
ADDI E,NUSRD-OUSRD ;Point into new descriptor.
TYPE T,"~&Bp to (old) descriptor is ~H, descriptor byte: ",[N]
IDPB Z,E ;Put bits into this copy.
ILDB B,N ;Get descriptor byte.
TYPE T,"~O",[B]
JUMPE B,[ TYPE T,"~&Error: Unexpected descriptor end"
JRST TUTX90 ]
CAIN B,UDWPH ;Null file?
JRST TUTX10 ; skip this write-place-holder.
CAIL B,UDWPH ;Take-N code?
JRST TUTX20 ; Yes, get load address.
CAILE B,UDTKMX ;If larger than highest Take-N
CALL SKIPF
JRST TUTX40
TUTX20: TYPE T,"~&Computing load address.."
;; 8/20/90 DM "funny" bit officially gone
;; ANDCMI B,20 ;Ignore DM funny bits (whatever those are).
MOVEI J,-UDWPH-1(B) ;J gets load address first part.
MOVEI K,NXLBYT ;Need above 5 bits plus NXLBYT bits.
TUTX21: MOVE E,N ;Get Bp to descriptor.
ADDI E,NUSRD-OUSRD ;Point into new UFD.
IDPB Z,E ;Zap some more bits into it.
ILDB B,N ;Get next descriptor byte.
LSH J,UFDBYT ;Swish it over.
ADD J,B ;Add in to get load address.
SOJG K,TUTX21 ;Get the entire load address.
MOVE Q,J ;Block of the file we want.
MOVE I,C ;Disk unit this file is on.
CALL TUTPNN ;Get in B ptr to new TUT.
TYPE T,"Block ~D has new TUT ptr = ~H",[Q,J]
ADD J,[TUTBYT_14,,] ;Back up for ILDB.
MOVEI B,1 ;Hack only one block.
CAIA
TUTX40: AOS Q
TUTX41: MOVE A,Q
MOVE D,J ;Copy Bp to block info.
SUBI D,NTUT0-OTUT0 ;In old TUT.
ILDB A,D ;Get block state.
ILDB B,J ;Get usage count.
TYPE T,"~&Old count ~D, New count ~D",[A,B]
TUTX90: POPPER P,[K,J,TT,T,Q,I,U,W,N,E,D,C,B,A,Z]
RET
];0
];DBG
SUBTTL Print out UFD
;;; PNTNAM - Print UFD name and file name on console.
;;; LPTNAM - Print UFD name and file name on LPT.
;;; LPTFIL - Print just the file name on LPT.
PNTNAM: PUSH P,NOLPT ;Kludge kludge.
SETOM NOLPT ;Fake out LPT routines.
CALL LPTNAM ;Do output.
POP P,NOLPT ;Restore LPT state.
RET ;That's all.
LPTNAM: TYPE LPT,"~S;",[USRNAM]
LPTFIL: PUSHER P,[A,B,C,D,E]
MOVE A,LASTQ ;Last block frobbed should be UFD.
MOVE B,UNFN1(A) ;Get FN1 from it.
MOVE D,UNFN2(A)
LDB C,[UNPKN UNRNDM(A)]
TYPE T,"~S ~S Pack ~D.",[B,D,C]
CALL FINDPK ;Find pack file is on
SKIPL C
TYPE LPT,", Unit #~D",[C]
LPTFI1: TYPE LPT," "
POPPER P,[E,D,C,B,A]
RET
;;; PNTXWD - Print extra words on the console.
;;; LPTXWD - Print extra words on the LPT.
;;; Note well: these routines only do something useful on a DC-10 disk.
PNTXWD: PUSH P,NOLPT
SETOM NOLPT
CALL LPTXWD
POP P,NOLPT
RET
LPTXWD:
DC,[ PUSH P,A
TYPE LPT,"Extra words: Block #~D-~O ~S;~S ~S ",[UNIT,BLK,RXWDS+XWSYSN,RXWDS+XWFN1,RXWDS+XWFN2]
LDB A,[XWBLK RXWDS]
TYPE LPT,"Chain pointer=~O",[A]
LDB A,[XWAWC RXWDS]
TYPE LPT,", Active Wd Cnt=~O~%",[A]
POP P,A
];DC
SETZM XWDSEE .SEE CKFL6A
RET
USBYTE: TYPE LPT,"~2<~;0~O~> ",[B]
RET
; For laughs, here is what CStacy's fevered brain had turned this code
; into:
;
; ;;; USBYTE prints some bytes.
; ;;; It was coded in this obscure fashion originally.
; USBYTE: PUSHER P,[A,B]
; LDB A,[30300,,(P)]
; LDB B,[300,,(P)]
; TYPE LPT,"~6<~;0~O~>. ~6<~;0~O~>",[A,B]
; POPPER P,[B,A]
; RET
;;; UFDPR - Print out a losing UFD in all its glory.
UFDPR: SETZM SALVRT ;No auto sys startup.
SKIPN NOLPT
TYPE T,"~2&Errors in directory ~S",[OUSRD+UDNAME]
USEE0: MOVE Q,OUSRD+UDNAME
TYPE LPT,"~&User Directory: ~S;~%",[Q]
DBG, JRST USEEF
MOVEI J,OUSRD
ADD J,UDNAMP(J)
CAIG J,OUSRD+2000
CAIGE J,OUSRD+UDDESC
JRST [ TYPE LPT,"~&UFD Name Area ptr out of range"
JRST USEEF ]
MOVE T,OUSRD+UDESCP
IDIVI T,UFDBYT
ADDI T,OUSRD+UDDESC
CAML T,J
JRST [ TYPE LPT,"~&Descriptor Free ptr overlaps Name Area"
JRST USEEF ]
MOVEM J,LAST
MOVEI Q,OUSRD+2000-LUNBLK
USEE1: CAMGE Q,LAST ;Per file loop.
JRST USEEF
MOVEM Q,LASTQ
SKIPN A,UNFN1(Q)
SKIPE UNFN2(Q)
CAIA
JRST USEELP
CALL LPTFIL
LPRCRR
LDB C,[UNPKN UNRNDM(Q)]
CALL FINDPK
MOVEM C,FUNIT ;Kludge Kludge (looks at TUTs).
LDB A,[UNDSCP UNRNDM(Q)]
CAML A,OUSRD+UDESCP
JRST [ TYPE LPT,"~&File descriptor ptr points outside Descriptor Area"
JRST USEELY ]
IDIVI A,UFDBYT
ADDI A,OUSRD+UDDESC
HLL A,QBTBLI(B)
TLNE A,400000
SUB A,[440000,,1]
LDB B,A
LPRTAB
CALL USBYTE
TYPE LPT,"(INITIAL ZERO)"
JUMPN B,[ TYPE LPT," - is not present"
JRST USEELY ]
LPRCRR
USEE2: MOVE N,A
MOVEI J,0
ILDB B,A ;Peek at next byte
JUMPE B,[ CALL USBYTE
TYPE LPT," (First byte should be non-zero) "
JRST USEELY]
LDB A,[UNDSCP UNRNDM(Q)]
TYPE LPT,"~O",[A] ;Show desc addr before first desc byte.
USEE3: MOVE E,UNRNDM(Q)
TLNE E,UNLINK
JRST USLINK
SETZM ADRSET
USLUP: ILDB B,N ;Get file desc bits.
LPRTAB
CALL USBYTE ;Print em.
JUMPE B,[ TYPE LPT,"(STOP)~%"
JRST USEELP]
CAIN B,UDWPH
JRST [ TYPE LPT,"(WRITE-PLACE-HOLDER)~%"
JRST USLUP]
CAIL B,UDWPH
JRST USLOAD
CAILE B,UDTKMX
JRST USSKIP
TYPE LPT,"(TAKE-N BLOCKS) "
USLP1: AOS Q ;Next block #.
USLP2: TYPE LPT,"~O ",[Q] ;Print block #.
SKIPGE E,FUNIT ;Make sure file on active unit.
JRST USLP3
MOVE E,QOTUTO(E) ;Old TUT entry.
CAMGE Q,QLASTB(E) ;Block in range of TUT?
SKIPN ADRSET ; Or starting addr known?
JRST USLPE ;No - bad block out of range this TUT.
ILDB E,J ;Ok - get TUT entry.
CAMGE Q,NUDS ;Make sure not in hacking area.
JRST USLPE ; Those blocks not supposed to be TUTed.
MOVSI D,-LSBTAB ;AOBJN to hacker's area.
CAMN Q,SBTAB(D) ;Make sure not in there.
JRST USLPE ; Bad desc if so.
AOBJN D,.-2 ;Hands off reserved disk area.
MOVE A,FUNIT ;Get unit file is on.
MOVE D,MFDBK ;We want the MFD.
SUB D,NTBL(A) ;How many blocks this TUT.
CAML Q,MFDBK ;Must not overlap MFD.
CAMLE Q,D ; Or TUT.
CAIA
JRST USLPE ;Else is bad block.
SKIPL FUNIT ;If file not on active unit
CAIN E,1
JRST USLP3
MOVE A,E ;Print weird TUT entry.
TYPE LPT,"~&?? TUT = ~D ??",[A]
USLP3: SOJG B,USLP1
LPRCRR
JRST USLUP
USLPE: TYPE LPT,"?? BAD BLOCK # ?? "
JRST USLP3
USEELP: MOVE Q,LASTQ
SUBI Q,LUNBLK
JRST USEE1
USEELY: LPRCRR
USSELP: MOVE Q,LASTQ
SUBI Q,LUNBLK
JRST USEE1
USEEF: LPRCRR
RET
USLOAD: SETOM ADRSET
;; 8/20/90 DM "funny" bits officially gone
;; ANDCMI B,20 ;DM FUNNY BITS
MOVEI J,-UDWPH-1(B)
MOVEI K,NXLBYT
USLOD1: ILDB B,N
CALL USBYTE
LSH J,6
ADD J,B
SOJG K,USLOD1
MOVE Q,J
SKIPGE I,FUNIT
TDZA J,J ;NO TUT
CALL TUTPNO ;GET PTR TO OLD TUT
ADD J,[TUTBYT_14,,] ;BACK UP FOR ILDB
TYPE LPT,"(JUMP ~O) ",[Q]
MOVEI B,1
JRST USLP2
USSKIP: SUBI B,UDTKMX
TYPE LPT,"(SKIP ~O) ",[B]
USSKI1: IBP J
AOS Q
SOJG B,USSKI1
MOVEI B,1
JRST USLP1
;;; Print out a link entry.
;;; Smashes E.
USLINK: TYPE LPT," (Link) "
CALL USLINP ;Get SNAME.
JRST USLIN3 ; Eh?
TYPE LPT,"~S;",[E] ;Print FN2.
CALL USLINP ;Get FN1.
JRST USLIN3 ; Eh?
TYPE LPT,"~S ",[E] ;Print FN1.
CALL USLINP ;Get FN2.
ADD N,[060000,,] ; Ends with zero.
ILDB B,N ;Re-read the zero byte.
TYPE LPT,"~S ",[E] ;Print FN2.
CALL USBYTE ;Print last byte.
TYPE LPT,"(ZERO)"
JUMPE B,USLIN4
TYPE LPT,"?? no end zero ??"
USLIN4: LPRCRR
JRST USEELP
USLIN3: TYPE LPT,"?? ends early ??"
JRST USLIN4
;;; USLINP - Get sixbit link name.
;;; Does not skip if premature end, else result is in E.
USLINP: MOVE T,[440600,,E] ;Bp to result.
SETZ E,
MOVEI B,6 ;Number of chars.
USLIN2: ILDB A,N ;Get char.
JUMPE A,CPOPJ ;Should not be zero.
CAIN A,';
JRST POPJ1 ;Skip return on end.
CAIN A,': ;Quote char?
ILDB A,N ; Yes, get real char.
IDPB A,T ;Accumulate sixbit.
SOJG B,USLIN2 ;All the way.
JRST POPJ1 ;Skip return when happy.
;;; LISTF - Dump out user directory
LISTF: JSR INIT
SKIPL ACTIVE ;If need to reset drives.
CALL ACTUN ; Do so.
TYPE T,"Directory name? "
CALL 6TYI ;Get UFD name to list.
JUMPE B,TODDT ;If none, punt.
MOVEI I,NUNITS-1 ;Units.
SETOM FUNIT ;Assume pack not mounted.
LISTF3: SKIPN QACT(I) ;Look for it.
JRST LISTF2
MOVEM I,FUNIT ;Use this drive.
MOVE A,QNTUTO(I) ;Get TUT.
CALL RDTUT ;Read it in.
JUMPL T,[ TYPE T,"~&Error reading TUT #~D~%",[I]
CALL GSTS
CALL CONTIN ;Want to go on?
PUNT ; No, punt.
JRST LISTF2]
LISTF2: SOJGE I,LISTF3 ;Try another disk.
MOVEM B,USRNAM ;Remember UFD to get
MOVEI A,MFD
MOVE J,MFDBK ;We want the MFD too.
SKIPGE I,FUNIT ;Use first active unit.
LOSE "No active unit to get dir from!"
CALL READ ;Read MFD.
JUMPL T,[ TYPE T,"~&Error reading MFD #~D~%",[I]
CALL GSTS
CALL CONTIN ;Want to go on?
PUNT ; No, punt.
JRST .+1 ]
MOVE D,USRNAM ;UFD.
MOVE Q,MFD+MDNAMP ;Seach for it in MFD.
LISTF1: CAIL Q,2000 ;Missing?
LOSE "~&Can't find UFD ~S",[D]
CAME D,MFD(Q) ;Found it?
JRST [ ADDI Q,LMNBLK ; No, offset to next name.
JRST LISTF1] ; Keep looking.
SUBI Q,2000 ;Cleverly compute which UFD block.
IDIVI Q,LMNBLK
HRRZ J,Q
ADD J,NUDS
MOVEM J,DBLK ;Remember UFD block.
MOVE I,FUNIT ;Use first active unit.
MOVEI A,OUSRD
CALL READ ;Read UFD.
JUMPL T,[ TYPE T,"~&Error reading UFD~%"
CALL GSTS
CALL CONTIN ;Want to go on?
PUNT ; No, punt.
JRST .+1 ]
CALL USEE0 ;Now print it allllll out.
PUNT ;Then punt to DDT.
SUBTTL UNIBUS Routines
KS,[
;;; The UNIBUS address space is divided into 64 sections, each of
;;; which has a corresponding page map register. Each section
;;; represents 1 DEC block (512 PDP-10 words), so you need two
;;; sections per ITS page. Note that only the bottom 32 sections can
;;; be addressed using a 16 bit UNIBUS address.
;;;
;;; QUBMAP - Map UNIBUS address space for disk to KS10 address space.
;;; Expects: A/ LH: # ITS pages to map
;;; RH: first ITS page number
;;; Does not skip.
;;; This routine maps UNIBUS space to KS10 space sequentially,
;;; starting with the first UBA PAGING RAM register (UNIBUS address
;;; zero).
QUBMAP: PUSHER P,[A]
HLRZ T,A ;# PDP10 core pages required.
LSH T,1 ;UNIBUS pages are 1/2 size.
HNRLZ T,T ;T gets AOBJN pointer.
HRRZ A,A ;Base PDP10 page number.
LSH A,1 ;Convert to "DEC" page number.
TRO A,%UQVAL+%UQFST ;Set VALID and FAST.
QUBMA1: IOWRQ A,UBAPAG(T) ;Map the page.
AOS A ;Next "DEC" core page.
AOBJN T,QUBMA1 ;Next paging register.
POPPER P,[A]
RET ;Never fails.
];KS
TS,[ ;Under time sharing, all UNIBUS hackery is a NOOP.
QUBMAP: NOP ? RET
];TS
SUBTTL Timesharing "Disk Routines"
TS,[
WRITT: MOVE I,TOU
WRITE: HRRZM J,LBLK
HRRZ TT,I
CAML TT,NQS
.VALUE [ASCIZ ":Cannot write random blocks."]
HRRZ TT,J
CAIGE TT,TBLKS
SKIPGE TT
.VALUE [ASCIZ ":Cannot write - no such block."]
JRST SUCCESS
READ: HRRZ TT,I
CAIL TT,NUNITS
.VALUE [ASCIZ ":Cannot read - no such unit."]
HRRZ TT,J
CAMN TT,MFDBK
JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,QIN
[SIXBIT /DSK/]
[SIXBIT /M.F.D./]
[SIXBIT /(FILE)/]]
.LOSE %LSSYS
JRST RDIN ]
CAML TT,NUDS
.VALUE [ASCIZ ":Cannot read random blocks."]
.SUSET [.SSNAM,,USRNAM]
SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,QIN
[SIXBIT /DSK/]
[SIXBIT /.FILE./]
[SIXBIT /(DIR)/]]
.LOSE %LSSYS
RDIN: HRLI A,-PG$SIZ
.IOT QIN,A
.CLOSE QIN,
SUCCES: MOVEI T,30.
RET
];TS
SUBTTL RH11 Controller Routines
NTS,[
PH,[
;;; RHQCMD commands the disk.
DEFINE RHQCMD OP
MOVEI A,OP
CALL RH6CMD
TERMIN
;;; RH6CMD - Command a disk.
;;; A/ command (for CS1, including GO bit)
;;; I/ unit number
;;; Returns 16 bits IO register contents right-justified in A.
RH6CMD: IOWRQ I,%HRCS2 ;Select drive.
IORDQ T,%HRCS1 ;Read CS1 (don't clobber %HXIE.)
DPB A,[$HXCMD T] ;Insert opcode + GO.
IOWRQ A,%HRCS1 ;Command the disk.
JRST RHCHK ;Go check status.
;;; RHGET/RHSET - Read/Set an IO register.
;;; A/ LH: ptr to IO register addr, RH: 16 bits of data.
;;; I/ unit number
;;; Skip returns with 16 bits right-justified in A.
;;; If non-skip, RAE or something happened - see CS2 in A.
RHGET: IOWRQ I,%HRCS2 ;Select drive.
HLRZ T,A ;T gets register addr.
IORDQ A,(T) ;Read contents of desired reg into A.
JRST RHCHK ;Go check status.
RHSET: IOWRQ I,%HRCS2 ;Select drive.
HLRZ T,A ;T gets register addr.
IOWRQ A,(T)
;Fall into RHCHK.
RHCHK: DELAY US,3. ; (Ensure 3 usec delay to allow
; MASSBUS transaction to complete.)
IORDQ T,%HRCS2 ;Check for errors.
TRNE T,%HYNED ;Drive nonexistant?
JRST RHRAE ; No - register access error.
IORDQ T,%HRCS1 ;Read status register.
TRNE T,%HXMCP ;Ctrl bus parerr?
JRST RHRAE
ANDI A,177777 ;Data is only 16 bits.
JRST POPJ1
RHRAE: TYPE T,"~&RH11 disk RAE, CS2 = ~H",[T]
CALL RHCLR
RET
;;; RHQCLR - Clear disk and controller errors:
;;; RHCLR - Clear controller errors.
;;; I/ disk unit.
;;; Smashes no ACs and does not skip.
RHQCLR: IOWRQ I,%HRCS2 ;Select drive.
MOVEI T,%HMCLR ;Clear ctlr and drive.
IOWRQ T,%HRCS1 ;Command the disk.
DELAY US,3
;; Falls in:
RHCLR: IOWRQ I,%HRCS2 ;Select known unit to avoid Massbus parerr.
MOVEI T,%HYCLR ;Reset controller errors.
IOWRQ T,%HRCS2
MOVEI T,%HXTRE+%HXIE ;Int enable, transfer err bit.
IOWRQ T,%HRCS1 ;Clear errors (doesn't reset drive.)
IORDQ A,%HRCS2
RET
];PH
];NTS
SUBTTL Disk I/O - RH11
NTS,[
PH,[
;;; Disk routine variables
RHCMD: 0 ;Command for the disk
RHIOW: 0 ;-#wds,,addr-1 for xfer
RHPGA: 0 ;Cylinder,,Head_8+Sector (RH is like RPDA)
RHIOWC: 0 ; WC for each xfer.
RHIOBA: 0 ; BA for each xfer.
OFFSTF: 0 ;-1 iff need to centerline disk heads
OFFSTB: ;Head offsets
IFN RP06P, 230 ? 30 ? 220 ? 20 ? 210 ? 10
IFN RP07P, 0 ; Actually, you can't offset an RP07...
IFN RM03P, 220 ? 20
IFN RM80P, 200 ? 0
LOFFSTB==.-OFFSTB ;Retry disk operations this many times.
;;; Smart IO for an RP06, RP07, RM03 or RM80 disk on an RH-11 controller.
;;; READ and WRITE transfer a single ITS block (1024 words).
;;; RW1 is the continuation of other IO routines.
;;;
;;; These routines will break big jobs into multiple xfers and hack the page map.
;;;
;;; I/ disk unit number
;;; J/ disk block number
;;; A/ core address
;;;
;;; Returns T -- Negative for failure.
;;; Never skips.
WRITT: MOVE I,TOU ;TO unit is often set up here.
WRITE: HRRZM J,LBLK ;Enter here for writing on disk.
SKIPA TT,[%HMWRT]
READ: MOVEI TT,%HMRED ;Enter here for reading from disk.
T300,[ CAIL I,T300P ;If this is a T-300 unit
JRST T3IO ] ; use the T-300 rtns of course.
MOVEM TT,RHCMD ;Remember command.
HRRZ T,J ;Get disk block #.
CAIL T,TBLKS ;Ensure it's in range of total blocks.
LOSE "~&No such disk block ~D",[T]
IDIVI T,NBLKSC ;T gets cylinder, TT gets blocks into it.
HRLZM T,RHPGA ;Remember which cylinder we want.
MOVE T,TT ;Blocks into cylinder.
IMULI T,SECBLK ;Sectors into cylinder.
IDIVI T,NSECS ;T gets track, TT gets sector.
LSH T,8 ;Gonna complete disk addr format.
IOR T,TT
HRRM T,RHPGA ;Remember head_8+sector too.
MOVEI T,-1(A) ;Xfer destination is addr-1.
HRLI T,-PG$SIZ ;Xfer length is 1 ITS block.
MOVEM T,RHIOW ;Remember xfer parameters.
;;; Other IO routines enter here with xfer variables set up.
;;;
;;; RHPGA LH/ cylinder
;;; RH/ device addr (track and sector)
;;;
;;; RHIOW should have the -# PDP10 words to xfer and
;;; the core address minus one. From this we compute
;;; a UNIBUS address and count used inside the transfer routines.
;;;
;;; Inside these routines:
;;; Q is the retry count
;;;
;;; (The return protocol described for READ/WRITE is implemented here.)
RW1: PUSHER P,[A,B,C,Q,E,K] ;Smash no ACs.
MOVEI Q,LOFFSTB ;Number of retries.
QTRY: CALL QGO ;Attempt disk operation.
JRST QWIN ; Won!
SKIPN HCRASH ;Lost.
JRST QRTRY ;Retry under normal circumstances.
JRST QLOST ;If the pack is crashed, we have failed.
QLOST: SKIPGE Q ;If there were real disk errors.
AOS FERRS ; count them.
SETO T, ;Failure.
CAIA
QWIN: MOVE T,Q ;Return value in T.
QDONE: MOVEI A,%HMCEN ;Command to center heads.
AOSN OFFSTF ;If need to return to centerline
CALL RH6CMD ; issue command to do it.
NOP ; (Also reset the flag.)
POPPER P,[K,E,Q,C,B,A] ;Smash no ACs.
RET
;;; Here for retries.
QRTRY: DELAY MS,10. ;Wait a bit for good luck (???).
DBG, TYPE T,"~%Disk retry #~D.",[Q]
CALL QGO ;Attempt disk operation retry.
JUMPGE Q,QWIN ; Won!
SOJL Q,QLOST ;Don't retry forever.
MOVSI A,%HROFS ;Let's try offsetting the heads.
HRR A,OFFSTB(Q) ;Use a different offset each retry.
SETOM OFFSTF ;Remember to return to centerline later.
CALL RHSET ;Attack offset register.
JRST QLOST ; Eh?
RHQCMD %HMOFS ;Offset the heads a little.
JRST QLOST ; Eh?
JRST QRTRY ;If at first you don't succeed...
;;; QGO Attempts an actual disk transfer.
;;; If it succeeds, does NOT skip.
;;; Skip returns if lost.
;;; If really losing, will go directly to QLOST throwing away the return
;;; address on the stack.
;;; The transfer is determined solely by looking at
;;; RHIOW: -<word count>,,<base address>-1
;;; RHPGA: <cylinder>,,<track & sector>
;;; RHCMD: <%HMxxx command>
;;; Each QGO, we map needed space starting with UNIBUS address zero.
QGO: HLRE T,RHIOW
MOVNS T ; T: # wds to xfer.
JUMPLE T,CPOPJ ; The easy case!
;; Maximum transfer size is 36000, this keeps us in the
;; low half of the Unibus paging RAM (the part addressable using
;; 16. bits of Unibus address) even in the worst unaligned case.
CAILE T,36000
MOVEI T,36000
LSH T,1 ; T: # UNIBUS words
MOVNM T,RHIOWC ; For loading %HRWC
MOVE T,RHIOW
MOVEI T,1(T) ; starting address
LDB A,[090900,,T] ; A: DEC page number
ANDI T,777 ; DEC line number
LSH T,2 ; ... measured in bytes
MOVEM T,RHIOBA ; For loading %HRBA
HRLZI T,-32. ; Might as well set up the whole map.
TRO A,%UQVAL\%UQFST ; Valid and Fast
QGOMAP: IOWRQ A,UBAPAG(T)
AOS A
AOBJN T,QGOMAP
QXBUSY: CALL RHCLR ;Clear (just) the controller.
MOVEI B,80000. ;Wait for the disk (up to 1/2 second.)
QXFR2: RHQGET %HRSTS ;Get drive status register.
JRST QXLUZ ; Eh?
TRNE A,%HSPIP ;Positioning in progress?
JRST QXFR3 ; Maybe offsetting heads.
TRNE A,%HSERR ;If errors.
JRST [ CALL RHQCLR ; Try clearing drive and controller.
RHQGET %HRSTS ; Check status now.
JRST QXLUZ ; Really losing.
TRNE A,%HSERR ; Any errors?
JRST QXLUZ ; Yes.
JRST .+1 ]
TRC A,%HSVV+%HSMOL+%HSRDY ;Valid, Online, and Ready?
TRCE A,%HSVV+%HSMOL+%HSRDY ;Now is the time for all good bits...
QXFR3: SOJG B,QXFR2 ;Wait for a little more.
JUMPLE B,QXLUZ ;Timeout waiting for the disk to look
; yummy.
HLRZ A,RHPGA ;OK to gobble the disk.
TLO A,%HRCYL
CALL RHSET ;Set Cylinder.
JRST QXLUZ
HRRZ A,RHPGA
TLO A,%HRADR
CALL RHSET ;Set Disk Address (track-sector).
JRST QXLUZ
RHQSET %HRWC,RHIOWC ;Set the word count.
JRST QXLUZ
RHQSET %HRBA,RHIOBA ;Reset UNIBUS address for xfer.
JRST QXLUZ
MOVE A,RHCMD ;Get the command.
SKIPE NOISE
CALL [ TYPE T,"~&Disk command: ~D. ",[A]
CALL GSTS
RET ]
CALL RH6CMD ;Do it!
JRST QXFR4 ; Eh?
CALL QWAIT ;Wait for completion.
JRST QXFR4 ; Problem: see what went wrong.
SKIPE NOISE
CALL [ TYPE T,"~&Disk op success: "
CALL GSTS
RET ]
RHQGET %HRWC ;Xfer has succeeded.
JRST QXFR4 ;Check the resulting word count.
SKIPE A ;It should have counted down all the way.
LOSE "~&Undetected incomplete disk xfer."
RHQGET %HRBA
JRST QXFR4
SUB A,RHIOBA ; A: # bytes xfered according to BA
MOVN B,RHIOWC
LSH B,1 ; B: # bytes we intended to xfer
CAME A,B
LOSE "~&Disk xfer confused: Word Count and Bus Address disagree."
LSH B,-2 ; B: # PDP10 words xfered this time
HRLI B,(B)
ADDM B,RHIOW ; Update the IO pointer
QXFREX: RHQGET %HRADR ;Read the updated disk address.
JRST QXFR4
HRRM A,RHPGA ;New disk addr.
JRST QGO ;Continue until no more to do.
QXFR4: TYPE T,"~&Disk transfer error on unit ~D.",[I]
SKIPE NOISE
CALL GSTS
RHQGET %HRSTS ;Transfer has gone awry.
JRST QXLUZ ; Eh?
TRNN A,%HSERR ;Transfer error?
JRST QXLUZ ; What the hell?
RHQGET %HRER2 ;Check for unsafes.
JRST QXLUZ
JUMPN A,QUNSAF
IFDEF %HRER3,[
RHQGET %HRER3
JRST QXLUZ
JUMPN A,QUNSAF
]
RHQGET %HRER1 ;Some kind of soft error.
JRST QXLUZ
TRNE A,%H1OPI+%H1DTE+%H1WLK+%H1IAE+%H1AOE+%H1CRC+%H1WCF+%H1FER+%H1RMR+%H1ILR+%H1ILF ;If really gross error
JRST QXLUZ ; abort.
TRZE A,%H1ECC ;If correctable data error
JUMPE A,QECC ; go fix it.
JRST POPJ1 ;Else maybe a retry will work.
QUNSAF: TYPE T,"~&Disk Unit ~O UNSAFE.",[I]
QXLUZ: POP P,(P) ;Transfer loses completely.
JRST QLOST
;;; QWAIT - Wait for disk IO completion.
;;; Skip returns unless there were xfer errors.
QWAIT: PUSHER P,[A]
QWAIT1: IORDQ A,%HRSTS ;Check drive status.
TRNN A,%HSPIP ; Wait if positioning in progress.
TRNN A,%HSRDY ; Wait until drive ready.
JRST QWAIT1 ; Wait for transfer completion.
IORDQ A,%HRCS1 ;Check CS1.
TRNN A,%HXTRE ;Transfer error?
AOS -1(P) ; Lossage return.
QWAIT9: POPPER P,[A]
RET
SUBTTL RH11 Error Correction Code
;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING. RETAKEN FROM ITS.
; THAT CODE DIDN'T WORK EITHER. TAKEN FROM NEWER ITS.
; MODIFIED FOR RH-11 CONTROLLER (UNIBUS).
; THAT WAS WRONG TOO, SO MOON TOLD US HOW TO FIX IT. (BUT WE HAVEN'T
; DONE IT YET.)
; Alan finally wrote this based on the RH11 version in ITS.
QECC: MOVE TT,RHCMD ;Examine command.
TRNN TT,10 ;If writing just retry
JRST [ TYPE T,"~&ECC Error while writing?"
RET ]
PUSHER P,[A,B,C,D,E]
RHQGET %HRPOS
JRST QECCLZ
MOVE D,A ; D: ECC error position
RHQGET %HRPAT
JRST QECCLZ
MOVE B,A ; B: ECC error pattern.
SOJL D,QECCLZ ; Hardware position is off by 1. If 0,
; error is not correctable.
IDIVI D,36. ; D, E: Word # within sector, Bit #
CAIL D,177 ; If last word in sector,
JRST [ ADDI E,36. ? SOJA D,.+1 ] ; hack it to avoid NXM
RHQGET %HRBA
JRST QECCLZ
SUB A,RHIOBA
TRNE A,777
LOSE "~&Didn't stop at sector boundary?"
LSH A,-2 ; A: # of words transfered
ADDI D,-200(A) ; D: Word # within transfer
HRRZ C,RHIOW ; C: Transfer base address - 1
ADDI D,1(C) ; D: Word # in memory
SETZI C,
ROTC B,(E)
MOVS B,B
MOVS C,C ; B!C: bits to correct
RWECCB:: ;SET BREAKPOINT HERE IF DON'T TRUST.
XORM B,0(D)
XORM C,1(D)
HRLI A,(A)
ADDM A,RHIOW ; Update the IO pointer
RHQGET %HRADR ;Read the updated disk address.
JRST QECCLZ
HRRM A,RHPGA ;New disk addr.
HLRZ A,RHPGA
LDB B,[$HATRK RHPGA]
LDB C,[$HASEC RHPGA]
SOJL C,[
MOVEI C,NSECS-1
SOJGE B,.+1
MOVEI B,NHEDS-1
JRST .+1 ]
TYPE T,"~&ECC Corrected error: Unit #~O Cylinder ~O Head ~O Sector ~O",[I,A,B,C]
AOS CERRS ; Count an ECC performed.
POPPER P,[E,D,C,B,A]
JRST QGO ;Continue until no more to do.
QECCLZ: POPPER P,[E,D,C,B,A]
TYPE T,"~&ECC lost."
JRST QXLUZ ;Transfer loses.
];PH
];NTS
SUBTTL RH10 Controller Routines
;ROUTINES TO ACCESS RH10 CONTROLLER AND DRIVE REGISTERS
;CALL WITH
; I UNIT NUMBER
; A REGISTER NUMBER IN LH
; NON-SKIP RETURN IF RAE ERROR
; SKIP RETURN IF WIN
;CLOBBERS ONLY A
;SET REGISTER. TAKES DATA TO GO IN REGISTER IN RH OF A
;CLOBBERS A (PROBABLY)
NTS,[
RH,[
RHSET: TLOA A,%HRLOD ;TELL HARDWARE IS SET INSTEAD OF GET
;AND FALL INTO RHGET
;GET REGISTER. RETURNS 16 BITS RIGHT-JUSTIFIED IN A
RHGET: TLZ A,%HRLOD
TLO A,(I) ;INSERT PHYS DRV NO
DATAO DSK,A ;TELL RH10 TO FETCH REGISTER
MOVEM A,RHLAST' ;SAVE FOR REBUGGING
MOVEI A,4 ;ENSURE 3 USEC DELAY BEFORE DATAI
SOJG A,. ;TO ALLOW MASSBUS TRANSACTION TO COMPLETE
DATAI DSK,A ;GET REG CONTENTS AND FLAGS
TLNE A,%HDERR ;ERROR?
JRST RHRAE ;YES, GO REPORT
ANDI A,177777 ;MASK TO 16 BITS
AOS (P) ;AND TAKE SUCCESS RETURN
RET
RHRAE: MOVSI A,%HRRAE+%HRLOD(I)
DATAO DSK,A ;CLEAR RAE REGISTER IN CONTROLLER
RET ;AND TAKE NON-SKIP RETURN
;DISK ROUTINE VARIABLES
RHCMD: 0 ;%HMRED OR %HMWRT
RHIOW: 0 ;IOWD -NWDS,,ADR-1 FOR TRANSFER
RHTIOW: 0 ;TEMPORARY IOWD FOR CONTINUING FROM ECC
RHPGA: 0 ;DISK ADDRESS CYL,,HED_8+SEC
RHTPGA: 0 ;TEMPORARY DISK ADDRESS FOR CONTINUING FROM ECC
RHSUCC: 0 ;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED BEFORE ECC
];RH
];NTS
SUBTTL Disk I/O - RH10
NTS,[
RH,[
; ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
.SEE RHCMD ;VARIABLES CONTROLLING WHAT GOES ON HERE
;INSIDE RW2 TT GENERALLY HAS THE DISK COMMAND AND T HAS THE RETRY COUNT
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR
WRITT: MOVE I,TOU
WRITE: HRRZM J,LBLK
SKIPA TT,[%HMWRT]
READ: MOVEI TT,%HMRED
T300,[ CAIL I,T300P
JRST T3IO
SETZM T3IOP
];T300P
MOVEM TT,RHCMD
HRRZ T,J
CAIL T,TBLKS
JRST 4,.
IDIVI T,NBLKSC ;TT:=CYLINDER, T:=BLOCKS INTO CYLINDER
HRLZM T,RHPGA ;SAVE CYLINDER
MOVE T,TT ;GET BLOCKS INTO CYLINDER
IMULI T,SECBLK ;SECTORS INTO CYLINDER
IDIVI T,NSECS ;TT:=HEAD, T:=SECTOR
LSH T,8 ;FORM ADDRESS WORD
IOR T,TT
HRRM T,RHPGA ;COMPLETE THE ADDRESS
MOVEI T,-1(A) ;SET UP IOWD TO TRANSFER ONE BLOCK
HRLI T,-2000
MOVEM T,RHIOW
;ENTER HERE WITH RHCMD, RHIOW, AND RHPGA SET UP. I HAS UNIT#.
RW1: MOVEI Q,5 ;INIT LOSAGE COUNT
CALL RW2 ;TRY
JRST RW7 ;FAILED
;HERE TO RETURN. T SAYS WHETHER WINNING OR LOSING.
RW5: MOVE A,[%HRDCL,,%HMCEN] ;RETURN TO CENTER-LINE IF NECESSARY
AOSN OFFSTF
CALL RHSET
NOP
SKIPGE Q ;Retry countdown in Q.
AOS FERRS
MOVE A,RHIOW ;RESTORE A
MOVEI A,1(A)
MOVE T,Q ;Return value in T.
RET
;HERE IF LOSING.
RW7: SKIPE HCRASH
JRST RWL0 ;SPEED IS OF THE ESSENCE, TRY ONLY ONCE
CALL RW2 ;HMM, TRY AGAIN
JRST RWLOSS ;STILL LOSING, COGITATE
JRST RW5 ;WINNING NOW
RWLOSS: MOVSI A,%HROFS ;ATTACK OFFSET REGISTER
HRR A,OFFSTB(Q) ;SET APPROPRIATE OFFSET VALUE
SETOM OFFSTF' ;REMEMBER TO RETURN TO CENTERLINE LATER
CALL RHSET
JRST RWL0 ;WHAT??
MOVE A,[%HRDCL,,%HMOFS]
CALL RHSET
JRST RWL0
MOVEI A,20000. ;WAIT 10 MS OR SO FOR GOOD LUCK
SOJG A,.
CALL RW2 ;TRY IT NOW
SOJGE Q,RWLOSS ;LOSE, TRY WITH DIFFERENT OFFSET
JUMPGE Q,RW5 ;WON, SO TAKE WIN RETURN
RWL0: SETO Q, ;COMPLETE LOSS, RETURN NOW
JRST RW5
OFFSTB: 260
60
240
40
220
20
;RH10 I/O ROUTINE PROPER
;FIRST STEP IS TO SET UP CHANNEL COMMAND LIST
RW2: MOVE TT,RHIOW ;SET UP ADDRESSES
MOVEM TT,RHTIOW
MOVE TT,RHPGA
MOVEM TT,RHTPGA
;RE-ENTER HERE AFTER ECC ERROR
RW2OVR: PUSH P,B
PUSH P,C
MOVE A,[-6,,SLVIOWD] ;POINTS TO WHERE CCWS WILL BE STORED
HLRO C,RHTIOW ;MINUS NUMBER OF WORDS TO TRANSFER
MOVNS C ;POSITIVE
HRRZ B,RHTIOW ;ADDRESS MINUS ONE
RW2CC1: MOVN TT,C ;WORDS TO TRANSFER IN THIS CCW
CAIL C,40000-200 ;WC IS ONLY A 14-BIT FIELD
MOVNI TT,40000-200
MOVEM B,(A) ;STORE CA
DPB TT,[$DFWC (A)] ;STORE WC
ADD C,TT ;LESS WORDS TO DO
SUB B,TT ;ADVANCE ADDRESS
AOBJP A,[HALT .] ;ADVANCE CCW PTR, HALT IF TOO BIG!
JUMPG C,RW2CC1 ;NEED MORE WORDS
SETZM (A) ;END CCW LIST
HRRZI A,SLVIOWD ;POINT CHANNEL AT IT
MOVEM A,SLVICWA
SETZM SLVICWA+1 ;INIT FOR CONTROL WORD WRITING
POP P,C
POP P,B
MOVEI A,SLVICWA ;BUILD DATAO CMD
MOVE TT,RHCMD
DPB A,[$HCICWA TT]
TLO TT,%HRCTL ;FILL OUT COMMAND WORD
;NOW BEFORE GIVING COMMAND CHECK STATUS
CONSZ DSK,%HIBSY ;WAIT FOR DSK CONTROL
JRST .-1
CONO DSK,%HOCLR ;CLEAR ANY LEFT-OVER ERROR INDICATORS
RW2A: MOVSI A,%HRSTS ;CHECK DRIVE STATUS
CALL RHGET
JRST RW3 ;DRIVE VANISHED??
TRNE A,%HSPIP ;WAIT FOR POSITIONING
JRST RW2A ;(MIGHT BE OFFSETTING HEADS?)
TRNE A,%HSERR ;ANY ERRORS IN DRIVE?
JRST RW6 ;YES, TRY TO RECOVER
TRC A,%HSVV+%HSMOL+%HSRDY ;CHECK FOR ALL READY BITS ON
TRCE A,%HSVV+%HSMOL+%HSRDY
JRST RW3 ;NOT READY??
HLRZ A,RHTPGA ;SET CYLINDER
TLO A,%HRCYL
CALL RHSET
JRST RW3
HRRZ A,RHTPGA ;SET TRACK-SECTOR
TLO A,%HRADR
CALL RHSET
JRST RW3
KL,[ MOVE A,RHTIOW ;SWEEP THE CACHE
AOS A ;RH ADDRESS OF BUFFER, LH - # WDS
LSH A,-9.
TRZ A,777000
TLO A,777000 ;A NOW HAS AOBJN PTR TO PAGES
RWSWP3: TRNE TT,10 ;SWEEP ONE PAGE
SWPIO (A) ;IF READING, INVALIDATE
TRNN TT,10
SWPUO (A) ;IF WRITING, UNLOAD
CONSZ 200000 ;WAIT UNTIL SWEEPER WAKES
JRST .-1
AOBJN A,RWSWP3
SWPUO 0 ;STORE CHANNEL PROGRAM IN CORE
CONSZ 200000
JRST .-1
];KL
;DROPS THROUGH
;DROPS IN
RWGO: MOVE A,TT ;ISSUE I/O COMMAND
CALL RHSET
JRST RW3
CONSO DSK,%HIDONE ;WAIT FOR COMPLETION
JRST .-1
MOVSI A,%HRSTS ;CHECK DISK STATUS, ERRORS DON'T ALWAYS SHOW UP IN CONI
CALL RHGET
JRST RW3
TRNN A,%HSERR
CONSZ DSK,%HIERR
CAIA
JRST POPJ1 ;NO ERROR, SKIP RETURN FROM RW2
;FOLLOWING TWO LINES CAUSE ECC NOT TO WORK
; CONSO DSK,%HIEXC
; RET ;NOT DRIVE EXCEPTION, PROBABLY CORRIGIBLE BY RETRY
TRNN A,%HSERR ;ANYTHING IN ERR REGS?
JRST RW3 ;FOO, WHAT IS GOING ON??
MOVSI A,%HRER2 ;MAKE SURE NO UNSAFES
CALL RHGET
JRST RW3
JUMPN A,RW3
IFDEF %HRER3,[
MOVSI A,%HRER3
CALL RHGET
JRST RW3
JUMPN A,RW3
]
MOVSI A,%HRER1 ;GET ERROR1 REG
CALL RHGET
JRST RW3
TRNE A,077067 ;GROSS ERROR?
JRST RW3 ;YES, ABORT
TRZE A,100000 ;SEE IF CORRECTABLE DATA ERROR
JUMPE A,RWECC ;YES, GO FIX IT
RET ;ERROR, BUT RETRY MAY WIN
RW6: MOVE A,[%HRDCL,,%HMCLR] ;ERROR IN DRIVE, TRY CLEARING
CALL RHSET
JRST RW3
MOVSI A,%HRSTS
CALL RHGET
JRST RW3
TRNN A,%HSERR
JRST RW2A ;WON
;LOST, FALL INTO RW3
RW3: POP P,(P) ;UNCORRECTABLE ERROR, RW FAILS
JRST RWL0
SUBTTL RH10 Error Correction Code
;ERROR CORRECTION CODE -- TAKEN FROM MAINDEC-10-DDRPF
; THAT CODE HAD NO HOPE WHATSOEVER OF WORKING. RETAKEN FROM ITS.
; THAT CODE DIDN'T WORK EITHER. TAKEN FROM NEWER ITS.
RWECC: TRNN TT,10 ;SKIP IF READ
RET ;RETRY IF WRITE
PUSHER P,[B,W,U,J,K,E]
DW1==W ;FIRST WORD IN ERROR
DW2==U ;SECOND WORD IN ERROR
EP1==J ;FIRST WORD OF ERROR PATTERN
EP2==K ;SECOND WORD OF ERROR PATTERN
ADR==E ;ADDRESS OF LOSING WORDS
;B ;SO CAN DIVIDE A
SKIPN A,SLVICWA+1 ;GET ADDRESS OF LAST WORD TRANSFERRED
JRST 4,.-1 ;CHANNEL SHOULD HAVE STORED CONTROL WORD
SOS ADR,A ;LAST WORD TRANSFERRED (SUPPOSEDLY)
ANDI ADR,-200 ;IN ANY CASE, THIS MAKES ADR TO START OF SECTOR
HRRZ A,RHTIOW ;ADR-1 OF START OF TRANSFER
SUBM ADR,A
SOS B,A ;NUMBER OF WORDS SUCCESSFULLY TRANSFERRED
MOVEM B,RHSUCC ;SAVE
HLRO K,RHTIOW
MOVNS K
CAIL B,0 ;CHECK FOR CHANNEL LYING
CAILE B,-200(K)
JRST RWECC3 ;FRAUD, TRANSFERRED NEGATIVE OR TOO MANY WORDS
MOVSI A,%HRPOS ;GET ERROR POSITION
CALL RHGET
JRST RWECC3
SOJL A,RWECC3 ;WHICH IS OFF BY 1. IF ZERO, LOSE.
IDIVI A,36. ;CONVERT TO WORD AND BIT
ADD ADR,A
MOVS DW1,(ADR) ;FETCH THE TWO LOSING WORDS
MOVS DW2,1(ADR)
MOVSI A,%HRPAT ;GET ERROR PATTERN
CALL RHGET
JRST RWECC3
MOVE EP1,A
SETZ EP2,
ROTC EP1,(B) ;ALIGN IT
XOR DW1,EP1 ;FIX THE ERRONEOUS BITS
XOR DW2,EP2
RWECCB: ;SET BREAK HERE IF DON'T TRUST...
MOVSM DW1,(ADR) ;PUT CORRECTED DATA BACK
MOVSM DW2,1(ADR)
POPPER P,[E,K,J,U,W]
AOS CERRS ;COUNT NUMBER OF TIMES ECC DONE
MOVEI A,%HMCLR ;CLEAR THE ECC-ERROR CONDITION
CALL RHSET
NOP
MOVEI A,200 ;ALLOW FOR THE SECTOR WE CORRECTED
ADDB A,RHSUCC ;GET BACK NUMBER OF WORDS TRANSFERRED
IDIVI A,200 ;NUMBER OF SECTORS TRANSFERRED INCLUDING CORRECTED ONE
LDB B,[$HASEC RHTPGA] ;UPDATE DISK ADDRESS
ADD A,B
IDIVI A,NSECS
DPB B,[$HASEC RHTPGA]
LDB B,[$HATRK RHTPGA]
ADD A,B
DPB A,[$HATRK RHTPGA] ;NO NEED TO IDIVI A,NHEDS SINCE ALL XFERS WITHIN CYLINDER
MOVE A,RHSUCC ;NOW ADVANCE CCW
HRL A,A
ADDB A,RHTIOW
POP P,B
TLNE A,-1
JRST RW2OVR ;NOT EXHAUSTED, CONTINUE DISK XFER
JRST POPJ1 ;ECC IN LAST SECTOR OF XFER, XFER COMPLETED SUCCESSFULLY
RWECC3: POPPER P,[E,K,J,U,W,B]
JRST RW3
];RH10
];NTS
SUBTTL Disk I/O - DC10
NTS,[
DC,[
WRITT: MOVE I,TOU
WRITE: HRRZM J,LBLK
SKIPA T,[DWR]
READ: MOVEI T,DRD ;A/ CORE LOCN, I/ DRIVE J/TRACK #
HRRM T,DGO
PUSH P,B
MOVE B,T
HRRZM J,BLK
MOVEM I,UNIT
HRRZ TT,I
CAIL TT,NUNITS
HALT .
HRRZ TT,J ;Get block #.
CAIGE TT,TBLKS ;Make sure in range.
SKIPGE TT
HALT .
MOVE TT,QTRAN(I) ;Get physical drive #.
DPB TT,[DUNFLD (B)] ;Stuff into command.
DPB A,[DCCA 1(B)]
DPB A,[DCCA 4(B)]
POP P,B
HRRZ T,J ;Get block #.
CAIL T,NBLKS+XBLKS
HALT .
IDIVI T,NSECS
DPB TT,[DSECT @DGO]
IDIVI T,NHEDS
DPB TT,[DSURF @DGO]
MOVE TT,T
SKIPGE QTRAN(I)
ADDI TT,NCYLS+XCYLS ;MAP INTO 2ND HALF OF CALCOMP
DPB TT,[DCYL @DGO]
MOVE TT,PKNUM(I)
CAIL T,NCYLS
MOVEI TT,0
DPB TT,[DPKID @DGO]
HRRZ T,DGO
MOVE TT,(T)
TLZ TT,340000 ;CHANGE TO READ COMPARE
MOVEM TT,3(T)
RW1: MOVEI Q,30.
SKIPE HCRASH
MOVEI Q,0 ;SPEED IS OF THE ESSENCE - TRY ONLY ONCE
RW2: CONO DC0,DCCSET\DCDENB
DATAO DC0,DGO
MOVSI TT,3 ;WAIT AT MOST 3 SECONDS
CONSZ DC0,DSSACT
SOJGE TT,.-1
JUMPL TT,[ PUSHER P,[T,TT]
CALL RECAL
POPPER P,[TT,T]
JRST .+2 ]
CONSZ DC0,DSSERR
SOJGE Q,RW2
SKIPGE Q
AOS FERRS
MOVE T,Q ;Return result in T.
RET
DGO: DJMP .
DRD: DREAD+DUNENB
DCOPY .(-2000_2&37774)
DCOPY RXWDS(-4_2&37774)
DRC
DCCOMP .(-2000_2&37774)
DCCOMP RXWDS (-4_2&37774)
DHLT
DWR: DWRITE+DUNENB
DCOPY .(-2000_2&37774)
DCOPY WXWDS(-4_2&37774)
DRC
DCCOMP .(-2000_2&37774)
DCCOMP WXWDS(-4_2&37774)
DHLT
];DC
];NTS
SUBTTL Disk I/O - T300
NTS,[
T300,[ ;;; (Fall in from WRITE)
;ENTER WITH: A ADDRESS, J BLOCK NUMBER, I VIRTUAL UNIT
; TT %HMWRT OR %HMRED
;ONLY T AND TT CLOBBERED
;ON RETURN T MINUS IF ERROR
T3IO: PUSHER P,[A,B,C,D]
SETOM T3IOP'
CAIE TT,%HMRED ;GET READ OR WRITE COMMAND
SKIPA D,[%DMWRT]
MOVEI D,%DMRED
T3IO1: HRRZ A,J ;GUBBISH IN LH
IDIVI A,NBLKC1 ;A CYLINDER, B BLOCK WITHIN CYLINDER
MOVEM A,DSCCYL
IMULI B,SECBL1 ;B SECTOR WITHIN CYLINDER
IDIVI B,NSECS1 ;B HEAD, C SECTOR
MOVEM B,DSCHED
MOVEM C,DSCSEC
MOVE B,-3(P) ;ORIGINAL ADDRESS
HRLI B,730000 ;12-BIT BYTES, START WITH FIRST BYTE IN WORD
MOVE C,[-4,,DSCPNT] ;SET UP BYTE POINTERS
MOVEM B,(C)
ADDI B,400
AOBJN C,.-2
KL,[ SWPUA ;DUMP EVERYTHING OUT OF CACHE
CONSZ 200000
JRST .-1
];KL
CALL T3CMD ;PERFORM THE OPERATION
JUMPE T,T3IO2 ;RETURN IF SUCCESS
MOVE A,T ;SEE IF ERROR MAY BE RECOVERABLE
TRZ A,%DSECH+%DSIDE+%DSHCE
JUMPN A,T3IO3 ;IF IRRECOVERABLE
TRNE D,%DMRED ;OR IF NOT A READ COMMAND
CAIN D,%DMRED+10 ;OR IF TRIED ALL RECOVERY FEATURES
T3IO3: TLOA T,(SETZ) ;ENSURE T NEGATIVE TO INDICATE ERROR
AOJA D,T3IO1 ;OTHERWISE RETRY USING NEXT ERROR RECOVERY FEATURE
T3IO2: POPPER P,[D,C,B,A]
RET
;;; Do command in D on drive number in I, return status in T (0 if ok)
;;; You must set up DSCCYL, etc. before calling
;;; LH(T) gets DSCFLT, RH(T) gets DSCSTS
T3CMD: MOVEI T,2561
MOVEM T,DSCCHK
MOVEM D,DSCCMD
MOVEI T,-T300P(I)
MOVEM T,DSCDRV
SETZM DSCDON
KL,[ SWPUO 0 ;UNLOAD PAGE 0 FROM THE CACHE
CONSZ 200000
JRST .-1
];KL
MOVEI T,1
MOVEM T,DSCREQ
KL,[ SWPUO 0 ;UNLOAD PAGE 0 FROM THE CACHE
CONSZ 200000 ;AGAIN SO 11 WILL SEE DSCREQ ON IN INTERRUPT
JRST .-1
];KL
CONO DLC,100040 ;INTERRUPT 11
MOVEI T,60000. ;I THINK THIS TIMEOUT IS ABOUT 3 SECONDS
;UNFORTUNATELY, THIS TIMEOUT DOESN'T WORK ANYWAY
;REALLY, BECAUSE IF DRIVE 0 IS OFFLINE THE
;CONTROLLER HANGS AND EXECUTES COMMANDS WRONG
;AND OTHERWISE LOSES ITS ASS.
T3CMD1:
KL,[ SWPUO 0 ;UNLOAD PAGE 0 FROM THE CACHE
CONSZ 200000 ;AGAIN SO DSCDON GETS PICKED UP FROM MAIN MEMORY
JRST .-1
];KL
SKIPN DSCDON
SOJG T,T3CMD1
JUMPLE T,[ MOVSI T,(SETZ) ;SIGNAL TIMEOUT (DRIVE OFFLINE?)
RET ] ;DSCFLT & DSCSTS WILL SAY NON-ERROR
SETZM DSCDON
CONO DLC,10 ;11 IS TRYING TO INTERRUPT -10, TURN IT OFF
HRLZ T,DSCFLT
HRR T,DSCSTS
TRZE T,%DSRTR+%DSECC ;THESE ARE NOT ERRORS
AOS CERRS
RET
];T300P
];NTS
SUBTTL Disk I/O - RP10
NTS,[
RP,[
;;; VARIABLES SET UP TO CONTROL TRANSFER
;;; WHEN AN ERROR OCCURS, IT GOES INTO SECTOR AT A TIME MODE, AND
;;; THESE VARIABLES ARE STEPPED ALONG TO REFLECT THAT.
;;;
;;; Unit is in I
RPAOBJ: 0 ;AOBJN ptr to words to be transferred
RPIOCY: 0 ;Cylinder to start at
RPIOHD: 0 ;Head to start at
RPIOSC: 0 ;Sector to start at
RPIOOP: 0 ;Command word. SLVICWA already added in
DRD: DREADC+SLVICWA+5000 ;Disable parity error stops.
DWR: DWRITC+SLVICWA
WRITT: MOVE I,TOU ;Set TO block.
WRITE: HRRZM J,LBLK ;Remember block we're hacking.
SKIPA T,DWR ;Get disk op.
READ: MOVE T,DRD
MOVEM T,RPIOOP ;Remember op.
HRRZ T,J ;Get block.
CAIL T,MBLKS+XBLKS ;Make sure it exists.
HALT .
IMULI T,SECBLK ;Set up command.
IDIVI T,NSECS
MOVEM TT,RPIOSC
IDIVI T,NHEDS
MOVEM TT,RPIOHD
MOVEM T,RPIOCY
MOVEM A,RPAOBJ
MOVNI T,2000
HRLM T,RPAOBJ
;;; High-level I/O routine. Tries to do it all at once,
;;; if that loses twice tries it a sector at a time.
;;; If HCRASH is set, try only once.
;;; Smashes T, TT. Returns T negative if error.
RPIO: PUSH P,A
SETZM SLVIOWD+1
MOVE T,RPAOBJ
SOS T
MOVEM T,SLVIOWD
CALL RPXIO ;Try it.
JRST RPIO1
MOVEI T,102 ;Won!
JRST RPIO9
RPIO1: SETOM T ;Flag failure.
SKIPE HCRASH ;If pack crashed
JRST RPIO9 ; give up.
CALL RPRCAL ;Else recalibrate, then
CALL RPXIO ;try it again.
JRST RPIO2 ; Lost twice try sector at a time.
MOVEI T,101 ;Won!
RPIO9: SKIPGE T ;If retries
AOS FERRS ; Count disk errors.
POP P,A ;Don't smash ACs.
RET ;All done.
;;; Sector at a time mode
RPIO2: MOVEI T,100
SKIPL TT,RPAOBJ
JRST RPIO9 ;Transfer exhausted, won.
SOS TT
HRLI TT,-200
MOVEM TT,SLVIOWD
MOVEI T,10. ;Try this sector 10 times.
CALL RPXIO
SOJGE T,.-1
JUMPL T,RPIO9 ;Give up.
MOVE T,[200,,200] ;Advance to next sector.
ADDM T,RPAOBJ
AOS T,RPIOSC
CAIGE T,NSECS
JRST RPIO2
SETZM RPIOSC
AOS T,RPIOHD
CAIGE T,NHEDS
JRST RPIO2
SKIPL RPAOBJ
JRST RPIO2
HALT . ;Cylinder overflow?
;;; Low-level IO, just do the operation specified in the variables.
;;; Clobber A,TT.
;;; Skip if success.
RPXIO: MOVEI TT,SLVIOWD ;Set up DF10 command.
HRRZM TT,SLVICWA
SETZM SLVICWA+1
PUSH P,T ;Don't clobber retry count.
CALL SEEK ;Make sure at desired cylinder.
JRST POPTJ ; Seek failed?
POP P,T ;Recover try count.
MOVE A,RPIOOP ;Set up DATAO.
DPB I,[DUNFLD A]
MOVE TT,RPIOCY
DPB TT,[DCYL A]
LSH TT,-8 ;For an RP03.
DPB TT,[DCYLXB A]
MOVE TT,RPIOHD
DPB TT,[DSURF A]
MOVE TT,RPIOSC
DPB TT,[DSECT A]
CONO DPC,DCLEAR
SKIPN HCRASH ;If pack crashed
DATAO LIGHTS,A ; Maybe luser monitoring something in lights?
DATAO DPC,A ;Issue command
CONSO DPC,DONE ;Await done.
JRST .-1
CONSZ DPC,ALLER ;Skip-return unless error.
RET
HLRO TT,RPAOBJ ;Seems successful, check the channel control word stored
HRRZ A,RPAOBJ
SUB A,TT ;Supposed end of transfer.
HRRZ TT,SLVICWA+1
CAIE A,1(TT) ;Finished?
DF10FK: RET ; No, channel trying to fuck you over.
JRST POPJ1 ;Yes.
;;; Recalibrate unit in I, smashes T,TT.
RPRCAL: CONO DPC,DCLEAR
MOVE T,[DEASEC 776]
DPB I,[DUNFLD T] ;LEAVE PROPER UNIT SELECTED FOR GETSTS
DATAO DPC,T ;CLEAR ATTNS
DPB I,[DUNFLD DRST]
DATAO DPC,DRST
RPRCL1: DATAI DPC,TT
TLNN TT,(ONLINE)
RET ;OFF LINE
TLNE TT,(NSCHDR)
RET ;NO SUCH DRIVE
TRNN TT,776
JRST RPRCL1 ;AWAIT ATTENTION
DATAO DPC,T ;GOT ATTENTION, CLEAR IT
RPRCL2: TLNE TT,(ONCYL+SKINC)
RET ;DONE
DATAI DPC,TT
JRST RPRCL2 ;ON CYLINDER SOMETIMES TAKES A WHILE TO SET
;;; Seek to cylinder in RPIOCY on unit I.
;;; Smashes T,TT, Skips on success.
SEEKC: 0
SEEK: MOVEI TT,10.
MOVEM TT,SEEKC
SEEK1: CONSZ DPC,BUSY
JRST .-1
DATAO DPC,[DEASEC 776]
MOVSI TT,(DSEEKC)
DPB I,[DUNFLD TT]
MOVE T,RPIOCY
DPB T,[DCYL TT]
LSH T,-8 ;FOR RP03
DPB T,[DCYLXB TT]
SKIPN HCRASH
DATAO LIGHTS,TT
CONO DPC,DCLEAR
DATAO DPC,TT
MOVE T,[DEASEC 776]
DPB I,[DUNFLD T] ;LEAVE PROPER UNIT SELECTED FOR GETSTS
CALL RPRCL1 ;AWAIT COMPLETION
TLNE TT,(ONCYL) ;SUCCEED IF ON CYLINDER
JRST POPJ1
SOSGE T,SEEKC ;COUNT FAILURES
RET ;GIVE UP
CALL RPRCAL ;RECALIBRATE
JRST SEEK1 ;AND TRY AGAIN
];RP
];NTS
SUBTTL Cylinder I/O for RH10/RH11
NTS,[
RHPH,[
READCY: SKIPA TT,[%HMRED]
WRITCY: MOVEI TT,%HMWRT
T300,[ CAIL I,T300P
LOSE "~&SALV:Cylinder IO not implemented for T-300s"
];T300
MOVEM TT,RHCMD ;Set up command.
HRLZM J,RHPGA ;First half Addr: Track 0, sector 0.
MOVEI T,-1(A) ;Specify cylinder.
HRL T,[-SECTOR*NHEDS*NSECS] ;Xfer entire cylinder.
MOVEM T,RHIOW
CALRET RW1 ;Continue into smart disk code.
];RHPH
];NTS
SUBTTL Cylinder I/O for RP10
NTS,[
RP,[
;;; RP10 cylinder I/O always succeeds. If problems occur, goes sector
;;; at a time, typing out what is going on, zeroing sectors that can't be read,
;;; then returns claiming to have won.
READCY: SKIPA T,DRD
WRITCY: MOVE T,DWR
MOVEM T,RPIOOP
MOVEM J,RPIOCY
SETZM RPIOHD
SETZM RPIOSC
MOVEM A,RPAOBJ
MOVNI T,NBLKSC*2000
HRLM T,RPAOBJ
RPCY0: CALL RPIO
JUMPGE T,CPOPJ ;WON
IFN 0,[ ;Someone doesn't think this code works
SKIPE HCRASH
RET
MOVE T,RPIOOP
CAMN T,DWR
JRST [ TYPE WRITE ERROR ON BLOCK
JRST .+3 ]
TYPE READ ERROR ON BLOCK
PUSH P,A
PUSH P,B
MOVE A,I
CALL DPT
TYPE -
MOVE A,RPIOHD
IMULI A,NSECS
ADD A,RPIOSC
IDIVI A,SECBLK
MOVE B,RPIOCY
IMULI B,NBLKSC
ADD A,B
CALL DPT
CRR
POP P,B
POP P,A
CALL GSTS ;EXPLAIN WHAT HAPPENED TO THIS SECTOR
MOVE T,RPIOOP ;IF READ, ZERO THE BUFFER
HRLZ TT,RPAOBJ ;IF WAS REALLY IN SECTOR AT A TIME MODE
CAMN T,DRD
CAIE TT,-200
JRST RPCY1
MOVE TT,RPAOBJ
SETZM (TT)
HRLZ T,TT
HRRI T,1(TT)
BLT T,177(TT)
RPCY1: AOS T,RPIOSC ;ADVANCE TO NEXT SECTOR
CAIGE T,NSECS
JRST RPCY2
SETZM RPIOSC
AOS T,RPIOHD
CAIL T,NHEDS
RET ;MUST BE DONE
RPCY2: MOVE T,[200,,200]
ADDB T,RPAOBJ
JUMPL T,RPCY0 ;GO DO THE REST OF THE CYLINDER
];IFN0
RET ;HMM, MUST BE DONE
];RP
];NTS
SUBTTL Cylinder I/O for DC10
NTS,[
DC,[
READCY: SKIPA T,[DREADC+DUNENB] ;READ CONTINUOUS
WRITCY: MOVSI T,(DWRITC+DUNENB) ;WRITE CONTINUOUS
MOVE TT,QTRAN(I)
DPB TT,[DUNFLD T]
MOVE TT,J
SKIPGE QTRAN(I)
ADDI TT,NCYLS+XCYLS
DPB TT,[DCYL T]
DPB TT,[DCYL CYLCM3]
CYL1: SKIPLE TT,PKNUM(I)
JRST CYL2
PUSH P,T
CALL RESET
POP P,T
JRST CYL1
CYL2: CAIL J,NCYLS
MOVEI TT,0
DPB TT,[DPKID T]
DPB TT,[DPKID CYLCM3]
MOVEM T,CYLCOM
DPB A,[DCCA CYLCM1]
DPB A,[DCCA CYLCM2]
MOVEI T,CYLCOM
RW0: HRRM T,DGO
JRST RW1 ;TRY TRANSFER UNTIL SUCCEEDS
CYLCOM: 0
DALU+DLDBWC+DLLB -2004*NBLKSC(3) ;LOAD WORD COUNT WITH -2004*NO. OF BLOCKS/CYL
CYLCM1: DCOPY .
CYLCM3: DRCC ;READ COMPARE CONTINUOUS
DALU+DLDBWC+DLLB -2004*NBLKSC(3)
CYLCM2: DCCOMP .
DHLT
CYLRIR: DREAD+DUNENB
DCOPY CYLBUF(-LRIBLK_2&37774)
CYLRIW: DWRITE+DUNENB
DCOPY CYLBUF(-LRIBLK_2&37774)
DHLT
];DC
];NTS
SUBTTL Print Disk/Controller Status
;;; WPERR and CPERR are jumped to by various routines.
WRERR: LOSE "~&Write error."
CPERR: LOSE "~&Read Error."
;;; Salvaging routines bomb into ACTUEn (QACT problem.)
ACTUE1: QLOSE "~&Error reading TUT block"
ACTUE3: QLOSE "~&Error reading MFD block"
;;; For each kind of controller there is a slightly different version of
;;; GETSTS (and GSTS, the workhorse subroutine) which prints the status of
;;; the disk controller and disk registers. GETSTS is the hand-callable
;;; routine (and ends in DDT with a new stack). See the next page.
TS,[ ;; Not very useful in timesharing.
GETSTS: NOP
T3STS: NOP
GSTS: RET
];TS
;;; TYPSTS - Type Status Bits
;;; C/ addr of IO flags table
;;; D/ LH: right justified bits to test
TYPSTS: PUSHER P,[A,B,C,D]
TYPST1: SKIPN A,(C) ;A gets a bit and a name string.
JRST TYPST9 ; Zero marks end of table.
DC, HLRZ B,A ;Get a bit's mask.
RH, HLLZ B,A ;(DC10 has them backwards).
RP, HLLZ B,A
PH, HRRZ B,A
TDNN D,B ;Is this one on?
JRST TYPST8 ; No, try another.
HLRZ T,A ;Yes - get name string of bit.
HRLI T,440700 ;Bp to it
TYPE T,"~A ",[T] ;Type the bit's name.
TYPST8: AOJA C,TYPST1 ;Go for next bit.
TYPST9: POPPER P,[D,C,B,A]
RET
;;; Macro to name bit positions in a status word.
DEFINE STS BIT,MEANS/
[ASCIZ \MEANS\],,BIT
TERMIN
;;; RH11 version of GSTS
NTS,[
PH,[
GETSTS: ACINIT ;Init stack
PUSH P,[DDT] ;and return to DDT when done.
GSTS:
T300,[ CAIL I,T300P ;If current disk is a T-300
JRST T3STS ] ; Use T300 rtns of course.
PUSHER P,[A,B,C,D,E,I] ;Smash no ACs.
TYPE T,"~&RH-11 disk ctl status: "
IORDQ T,%HRCS2 ;Read CS2.
LDB A,[$HYDSK T] ;Get controller current unit.
TYPE T,"I = ~O; Current drive is #~O, which is ",[I,A]
CALL QCNVT ;Convert to virtual unit.
LOSE "not active in the virtual unit table (QTRAN)!"
TYPE T,"virtual unit #~O",[B]
IORDQ T,%HRATN
TYPE T,"~&Disk Attention Summary: ~16<~;0~B~>",[T]
GSTS10: MOVSI E,-LGSTSR ;Display some IO register's bits.
GSTS12: MOVE D,GSTSRT(E)
MOVE A,RHRGTB(E) ;Get Bp to ASCIZ register name.
HRLI A,440700
TYPE T,"~&~A = ",[A] ;Type it out.
HRLZ A,D ;A gets register ptr.
CALL RHGET ;Read the IO register.
JRST [ TYPE T,"~&Error reading IO register ~H",[D]
JRST GSTS90 ]
TYPE T,"(~O)~20T",[A] ;Type register contents octally.
HLRZ C,D ;C gets status bit table ptr.
MOVE D,A ;Right-justified IO bits.
CALL TYPSTS ;Type register contents symbolicly.
AOBJN E,GSTS12 ;Loop for all IO registers in GSTSRT.
GSTS20: IORDQ A,%HRWC ;Word count in 14 bit twos complment.
JUMPE A,GSTS21
TDC A,[177777] ;Convert to normal positive number.
AOS A ;En Guard!
GSTS21: IORDQ B,%HRBA ;Type other interesting registers.
TYPE T,"~&Word Count = ~D., Unibus Address = ~O",[A,B]
IORDQ A,%HRCYL
IFDEF %HRCCY,[
IORDQ B,%HRCCY
TYPE T,"~&Desired Cyl = ~D., Current Cyl = ~D.",[A,B]
]
IFNDEF %HRCCY,[
TYPE T,"~&Desired Cyl = ~D.",[A]
]
IORDQ A,%HRADR
LDB B,[$HATRK A]
LDB C,[$HASEC A]
TYPE T,"~&Desired Addr = ~O (Track ~D. Sector ~D.)",[A,B,C]
MOVEI A,UBAQ
ASKYN "~&Do you want to see all the UNIBUS registers "
CAIA
CALL UBSTS
GSTS90: POPPER P,[I,E,D,C,B,A]
RET
DBG,[ ;;; Quickie GSTS for debugging.
QGSTS: PUSHER P,[A,B,C,D]
IORDQ B,%HRCS2
LDB A,[$HYDSK B]
IORDQ B,%HRCS1
IORDQ C,%HRCS2
IORDQ D,%HRADR
TYPE T,"Disk ~O: CS1=~O, CS2=~O, DA=~O, ",[A,B,C,D]
IORDQ A,%HRCYL
%IFDEF %HRCCY,[
IORDQ B,%HRCCY
TYPE T,"DC=~O, CC=~O, ",[A,B]
]
IFNDEF %HRCCY,[
TYPE T,"DC=~O ",[A]
]
IORDQ A,%HRBA
IORDQ B,%HRWC
MOVE C,B
JUMPE C,QGSTS1
TDC C,[177777]
AOS C
QGSTS1: TYPE T,"BA=~O, WC=~O (~D.)",[A,B,C]
POPPER P,[D,C,B,A]
RET
];DBG
;;; RH11 disk bits
;Implementation note for someday: Perhaps these tables should be
;generated by a macro available under some switch in each of the
;drive-description insert files. Information such as the register
;names and the names of the bits is already available in the comments
;there. The macro for the table of interesting bits could take a mask.
;Then we could at least write something like:
; GSTS-REG REGNAME %HRCS1,%HRCS1,[QBITS %HRSTS,777777]
;Instead of typing in all this duplicate information in several tables.
GSTSRT: BLOCK 10. ;Table of register nums and bits.
RHRGTB: BLOCK 10. ;Names of above registers.
;;; Macro to define table of IO registers which GSTS will display.
LGSTSR==0
DEFINE GSTSRE BITPTR,REG,&NAME
ZZZ==.
LOC GSTSRT+LGSTSR
REG,,BITPTR
LOC RHRGTB+LGSTSR
[ASCIZ NAME]
LGSTSR==LGSTSR+1
LOC ZZZ
TERMIN
GSTSRE %HRSTS,STSDS,"Drive Status"
GSTSRE %HRCS1,STSCS1,"Ctrl & Status 1"
GSTSRE %HRCS2,STSCS2,"Ctrl & Status 2"
GSTSRE %HROFS,STSOF,"Offset"
GSTSRE %HRER1,STSER1,"Error 1"
GSTSRE %HRER2,STSER2,"Error 2"
IFDEF %HRER3,[
GSTSRE %HRER3,STSER3,"Error 3"
]
STSCS1: STS 1,GO
STS 200,READY
STS 2000,PORT-SELECT
STS 4000,DRIVE-AVAILABLE
STS 20000,MASS-IO-CTL-BUS-PARITY-ERROR
STS 40000,TRANSFER-ERROR
STS 100000,SPECIAL-CONDITION
0
STSCS2: STS 20,PARITY-TEST
STS 40,CONTROLLER-CLEAR
STS 100,SILO-INPUT-READY
STS 200,SILO-OUTPUT-READY
STS 400,MASS-DATA-BUS-PARITY-ERROR
STS 1000,MISSED-TRANSFER
STS 2000,PROGRAM-ERROR
STS 4000,UNIBUS-ADDR-NXM
STS 10000,NONEXISTANT-DRIVE
STS 20000,PARITY-ERROR
STS 40000,WRITE-CHECK-ERROR
STS 100000,DATA-LATE
0
STSDS:
IFN RP07P,[
STS 1,OFFSET-MODE
STS 2,EARLY-WARNING
STS 4,INTERLEAVED-SECTORS
]
STS 100,VOLUME-VALID
STS 200,DRIVE-READY
STS 400,DRIVE-PRESENT
STS 2000,LAST-SECTOR-XFERD
STS 4000,WRITE-LOCK
STS 10000,MEDIUM-ONLINE
STS 20000,POSITIONING-IN-PROGRESS
STS 40000,ERR
STS 100000,ATTENTION
0
STSER1: STS 1,ILL-FUNC
STS 2,ILL-REG
STS 4,REG-MOD-REFUSE
STS 10,BUS-PARITY-ERR
STS 20,PACK-FORMAT-ERR
STS 40,WRITE-CLOCK-FAIL
STS 100,ECC-HARD-ERR
STS 200,HEADER-COMPARE-ERROR
STS 400,HEADER-CRC-ERR
STS 1000,ADDR-OVERFLOW
STS 2000,INVALID-ADDR
STS 4000,WRITE-LOCK-ERR
STS 10000,DRV-TIMING-ERR
STS 20000,OP-NOT-COMPLETE
STS 40000,UNSAFE
STS 100000,DATA CHECK
0
IFN RP06P,[
; RP06 version of ERROR 2 Register
STSER2: STS 1,WRITE-CURRENT-UNSAFE
STS 2,CURRENT-SINK-FAILURE
STS 4,WRITE-SELECT-UNSAFE
STS 10,CURRENT-SWITCH-UNSAFE
STS 20,MOTOR-SEQUENCE-ERR
STS 40,TRANSITIONS-DET-FAIL
STS 100,TRANSITIONS-UNSAFE
STS 200,UNSAFE-EXCEPT-R/W
STS 400,WRITE-READY-UNSAFE
STS 1000,MULTIPLE-HEAD-SELECT
STS 2000,NO-HEAD-SELECT
STS 4000,INDEX-ERROR
STS 10000,30-VOLT-UNSAFE
STS 20000,PHASE-LK-OSC-UNSAFE
STS 100000,AC-UNSAFE
0
]
IFN RM03P+RM80P,[
;RMxx version of ERROR 2
STSER2: STS 10,DATA-PARITY-ERROR
STS 40,SKIP-SECTOR-ERROR
STS 200,DEVICE-CHECK
STS 2000,LOST-BITCHECK
STS 4000,LOST-SYSTEM-CLOCK
STS 10000,INVALID-COMMAND
STS 20000,OPERATOR-PLUG-ERROR
STS 40000,SEEK-INCOMPLETE
STS 100000,BAD-SECTOR
0
]
IFN RP07P,[
; RP07 version of ERROR 2 Register
STSER2: STS 400,WRITE-READY-UNSAFE
STS 1000,WRITE-OVERRUN
STS 2000,NO-WRITE-TRANS
STS 4000,GT-ONE-HEAD-SELECTD
STS 10000,WRITE-CURRENT
STS 20000,8080-HUNG
STS 40000,CROM-PARITY-ERROR
STS 100000,PROGRAM-ERROR
0
]
IFN RM03P+RM80P,[
;RMxx version of ERROR 2
STSER2: STS 10,DATA-PARITY-ERROR
STS 40,SKIP-SECTOR-ERROR
STS 200,DEVICE-CHECK
STS 2000,LOST-BITCHECK
STS 4000,LOST-SYSTEM-CLOCK
STS 10000,INVALID-COMMAND
STS 20000,OPERATOR-PLUG-ERROR
STS 40000,SEEK-INCOMPLETE
STS 100000,BAD-SECTOR
0
]
IFN RP06P,[
; RP06 version of ERROR 3 Register
STSER3: STS 1,PACK-SPEED-UNSAFE
STS 2,VELOCITY-UNSAFE
STS 10,UNSAFE-EXCEPT-R/W
STS 40,AC-LOW
STS 100,DC-LOW
STS 40000,SEEK-INCOMPLETE
STS 100000,OFF-CYLINDER
0
]
IFN RP07P,[
; RP07 version of ERROR 3 register
STSER3: STS 1,RUN-TIMEOUT
STS 2,SYNC-CLOCK-FAIL
STS 4,SYNC-BYTE-ERROR
STS 10,WRITE-DATA-PARITY-ERR
STS 20,SERDES-DATA-FAILURE
STS 40,DC-LOW
STS 100,INDEX-UNSAFE/BAD-HEADER
STS 200,DEVICE-CHECK
STS 400,8080-NOT-RESPONDING
STS 1000,LOSS-OF-CYLINDER
STS 2000,LOSS-OF-BIT-CLOCK
STS 4000,LOGIC-CONTROL-FAILURE
STS 10000,WRITE-CURRENT-FAILURE
STS 20000,DEFECT-SKIP-ERROR
STS 40000,SEEK-INCOMPLETE/SEE-ER2
STS 100000,BAD-SECTOR
0
]
STSOF: STS 2000,HDR-COMPARE-INH
STS 4000,ECC-INHIBIT
STS 10000,PDP-11-FORMAT
IFN RP07P, STS 40000,MOVE-TRACK-DESCRIPTOR
IFN RP06P, STS 100000,SIGN-CHANGE
IFN RP07P, STS 100000,COMMAND-MODIFIER
0
];PH
;;; DC10 version of GSTS
DC,[
GETSTS: ACINIT
PUSH P,[DDT]
GSTS: PUSHER P,[A,B,C,D]
CONI DC0,D
MOVEI C,DC0STS
TYPE T,"Controller status:"
CALL TYPSTS
CONI DC1,D
MOVEI C,DC1STS
CALL TYPSTS
CONO DC0,DCCSET+DCDENB
DATAO DC0,[DJMP GETUNT]
CONSZ DC0,DSSACT
JRST .-1
LDB A,[DUNFLD GOTUNT]
DPB A,[DUNFLD STOSTS]
TYPE T,"~&Current unit= ~D, Drive Status:",[A]
DATAO DC0,[DJMP STOSTS]
CONSZ DC0,DSSACT
JRST .-1
MOVE D,STATUS
LSH D,-15.
MOVEI C,DRVSTS
CALL TYPSTS
LDB A,[101100,,STATUS]
TYPE T,"~%Cylinder=~O",[A]
POPPER P,[D,C,B,A]
RET
GETUNT: DJSR .+1
GOTUNT: 0
DHLT
STOSTS: DSDRST+DUNENB STATUS(74)
DHLT
STATUS: 0
;;; DC10 disk bits
DC0STS: STS 4000,ERROR-FLG
STS 1000,ATTENTION
STS 200,RUN
STS 100,ACTIVE
0
DC1STS: STS 4000,INTERNAL-PARITY-ERROR
STS 2000,RECORD-LENGTH
STS 1000,READ-COMPARE
STS 400,OVERRUN
STS 200,CHECKSUM/DECODER
STS 100,BARK!!
STS 40,FILE-UNSAFE/SEEK-INCOMPLETE/END-OF-DISC
STS 20,OFF-LINE/MULTIPLE-SELECT
STS 10,RDG-KEY/PROTECT/READONLY
STS 4,DATAO-WHILE-BUSY
STS 2,NON-EX-MEM
STS 1,CORE-PARITY-ERROR
0
DRVSTS: STS 4,UNIT-SELECTED
STS 10,ON-LINE
STS 20,READY
STS 40,SEEK-INCOMPLETE
STS 100,READ-ONLY
STS 200,UNSAFE
STS 400,WRITE-CURRENT-SENSED(?)
0
];DC
;;; RP version of GSTS
RP,[
GETSTS: ACINIT
PUSH P,[DDT]
GSTS: PUSHER P,[A,B,C,D]
TYPE T,"~&Disk Status:"
CONI DPC,D
MOVEI C,CNLSTS
TLNE D,-1
CALL TYPSTS
MOVSS D
MOVEI C,CNISTS
CALL TYPSTS
DATAI DPC,D
TLC D,1 ;REVERSE SENSE OF WRITE HEADER LOCKOUT SWITCH
MOVEI C,DTISTS
CALL TYPSTS
LDB A,[DUNFLI D]
LDB B,[DCYLI D]
TRNE D,.BM DCYLXI
ADDI B,400
TYPE T,"~&Current unit =~D., Cylinder =~O, ",[A,B]
TYPE T,"Last addressed cyl=~O, Surf=~O, Sec=~O",[RPIOCY,RPIOHD,RPIOSC]
POPPER P,[D,C,B,A]
RET
;;; RP disk bits
; CONI STATUS TABLE (RH)
CNISTS: STS 400000,SEARCH DONE
STS 200000,END OF CYLINDER
STS 100000,POWER FAILURE
STS 040000,SEARCH ERROR
STS 020000,OVERRUN
STS 010000,NXM
STS 002000,DRIVE NOT READY
STS 001000,WRITE PROTECT
STS 000400,DATAO WHEN BUSY
STS 000200,SECTOR ADDRESS ERROR
STS 000100,SURFACE ADDRESS ERROR
STS 000020,BUSY
STS 000010,DONE
0
; CONI STATUS TABLE (LH)
CNLSTS: STS 000010,CONTROL WORD PARITY ERROR
STS 000004,SECTOR PARITY ERROR
STS 000002,MEMORY WORD PARITY ERROR
STS 000001,DISK WORD PARITY ERROR
0
; DATAI STATUS TABLE (LH)
DTISTS: STS 000100,SEEK INCOMPLETE
STS 000040,ON CYLINDER
STS 000020,DISK ON-LINE
STS 000010,FILE UNSAFE
STS 000004,NON EXISTENT DRIVE
STS 000002,DRIVE IS READ-ONLY
STS 000001,WRITE HEADER LOCKOUT OFF!!
0
];RP
;;; RH10 version of GSTS
RH,[
GETSTS: MOVEI P,PDL
PUSH P,[DDT]
GSTS:
T300,[ SKIPE T3IOP
JRST T3STS ] ;T300P
PUSHER P,[A,B,C,D,I,K]
TYPE T,"~&RH10 Controller Status:"
CONI DSK,D
MOVEI C,CNLSTS
TLNE D,-1
CALL TYPSTS
MOVSS D
MOVEI C,CNISTS
CALL TYPSTS
TYPE T,"~&Current register: "
DATAI DSK,D
CALL TYPRGN
MOVE A,D
TYPE T,"~O",[A] ;TYPE REG NO, STATUS, AND CONTENTS IN OCTAL
JUMPL D,GSTS0 ;DO FOLLOWING ONLY FOR DRIVE REGS
TYPE T,","
MOVEI C,DIBSTS
CALL TYPSTS
CAIA ;DON'T GIVE BLANK LINE
GSTS0: CRR
LDB A,[$HCDRV D]
TYPE T,"Current Drive=~D.~%",[A]
MOVEI I,NUNITS-1 ;CONVERT BACK TO VIRTUAL UNIT
CAME A,QTRAN(I) ;TO MAKE RHGET HAPPY
SOJGE I,.-1
JUMPL I,GSTS3 ;FOO!! ADDRESSING NON EXISTENT DRIVE
MOVSI K,-LGSTSR ;DISPLAY DRIVE REGS SPEC'ED IN TABLE
GSTS1: MOVE D,GSTSRT(K)
CALL TYPRGN ;TYPE REG NAME
HRRZ C,D ;C -> STATUS BIT TABLE
HLLZ A,D ;A := REG NUMBER
CALL RHGET ;GET CONTENTS OF REG
JRST GSTSER ;??
TYPE T,"~O ",[A] ;GIVE CONTENTS IN OCTAL
MOVS D,A ;AND SYMBOLICLY
CALL TYPSTS
AOBJN K,GSTS1
GSTS3: POPPER P,[K,I,D,C,B,A]
RET
GSTSER: TYPE T,"BARF:"
MOVE D,A
MOVEI C,DIBSTS
CALL TYPSTS
JRST GSTS3 ;DON'T TRY ANY MORE REGS
TYPRGN: LDB A,[360600,,D] ;TYPE NAME OF REGISTER ADDRESSED BY D
ROT A,-1
HRRO B,RHRGTB(A)
JUMPL A,.+2
MOVSS B
TYPE T,"~A= ",[B]
RET
;;; RH-10 disk and ctrlr bits
; CONI STATUS (LH)
CNLSTS: STS 400000,AR FULL
STS 200000,CB FULL
STS 040000,CC INH
STS 020000,CHANNEL ACTIVE
STS 010000,CHANNEL PULSE
STS 004000,22-BIT CHANNEL
STS 000400,CXR ILL FUNC
STS 000200,CXR DRIVE ACCESS ERR
STS 000004,MEMORY PARITY
STS 000002,CONTROL WORD PARITY
STS 000001,NXM
0
; CONI STATUS (RH)
CNISTS: STS 400000,DATA BUS PARITY
STS 200000,DRIVE EXCEPTION
STS 100000,CHANNEL ERROR
STS 020000,CHANNEL OVERRUN
STS 010000,DRIVE RESPONSE ERR
STS 004000,CXR ILL CMD
STS 002000,CXR POWER FAIL
STS 000200,CONTROL BUS OVERRUN
STS 000100,RAE INTR
STS 000040,ATTN INTR
STS 000020,BUSY
STS 000010,DONE
0
;TABLE OF DRIVE REGISTERS THAT NEED TO BE DISPLAYED
; LH = REG ADDR, RH = STATUS BITS TABLE ADDR
GSTSRT: %HRDCL,,[0]
%HRSTS,,STSSTS
%HRCYL,,[0]
IFDEF %HRCCY,[
%HRCCY,,[0]
]
%HRADR,,[0]
%HROFS,,OFSSTS
%HRER1,,ER1STS
%HRER2,,ER2STS
IFDEF %HRER3,[
%HRER3,,ER3STS
]
LGSTSR==.-GSTSRT
; REGISTERS
ZZ==-1
XX==0
YY==0
DEFINE REG N,T/
IFLE N-ZZ, .ERR REG OUT OF ORDER
REPEAT N-ZZ-1, REGH [ASCIZ\????\]
REGH [ASCIZ\T\]
TERMIN
DEFINE REGH [A]
ZZ==ZZ+1
IFE XX, YY==A
IFN XX, YY,,A
XX==1-XX
TERMIN
RHRGTB: REG 0,DRV CTL
REG 1,DRV STATUS
REG 2,DRV ER1
REG 3,DRV MAINT
REG 4,ATTENTION
REG 5,DRV TRACK-SECTOR
REG 6,DRV TYPE
REG 7,DRV LOOK-AHEAD
REG 10,DRV SERIAL NO
REG 11,DRV OFFSET
REG 12,DRV DESIRED CYL
REG 13,DRV CURRENT CYL
REG 14,DRV ER2
REG 15,DRV ER3
REG 16,DRV ECC POS
REG 17,DRV ECC PAT
REG 40,CONTROL
REG 44,INTR ADDR
REG 50,DATA BUFFER
REG 54,RAE STATUS
REG 74,CHANNEL BUFFER
REG 100,FOO
LOC RHRGTB+40
EXPUNGE REG,REGH,XX,YY,ZZ
; BITS IN DIB REGISTER
DIBSTS: STS 004000,CTL-TO-DRIVE
STS 002000,CTL BUS TIMEOUT
STS 001000,CTL BUS PARITY
STS 000400,DIB DATA LATE
STS 000200,DIB ILL CMD
0
; DRIVE STATUS REGISTER
STSSTS: STS 1,FWD 5 IPS
STS 2,FWD 20 IPS
STS 4,INNER GUARD BAND
STS 10,GO REVERSE
STS 20,DIFF < 64
STS 40,DIFF = 1
STS 100,VOLUME VALID
STS 200,DRIVE READY
STS 400,CONN THIS CTRLR
STS 2000,LAST SECTOR XFERD
STS 4000,WRITE LOCK
STS 10000,MEDIUM ONLINE
STS 20000,POSITIONING IN PROGRESS
STS 40000,ERR
STS 100000,ATTENTION
0
; DRIVE ERROR REGISTER 1
ER1STS: STS 1,ILL FUNC
STS 2,ILL REG
STS 4,REG MOD REFUSE
STS 10,BUS PARITY ERR
STS 20,PACK FORMAT ERR
STS 40,WRITE CLOCK FAIL
STS 100,ECC HARD ERR
STS 200,HEADER WRONG
STS 400,HEADER CRC ERR
STS 1000,ADDR OVERFLOW
STS 2000,INVALID ADDR
STS 4000,WRITE LOCK ERR
STS 10000,DRV TIMING ERR
STS 20000,OP NOT COMPLETE
STS 40000,UNSAFE
STS 100000,DATA CHECK
0
; DRIVE ERROR REGISTER 2
ER2STS: STS 1,WRITE CURRENT UNSAFE
STS 2,CURRENT SINK FAILURE
STS 4,WRITE SELECT UNSAFE
STS 10,CURRENT SWITCH UNSAFE
STS 20,MOTOR SEQUENCE ERR
STS 40,TRANSITIONS DET FAIL
STS 100,TRANSITIONS UNSAFE
STS 200,"UNSAFE EXCEPT R/W"
STS 400,WRITE READY UNSAFE
STS 1000,MULTIPLE HEAD SELECT
STS 2000,NO HEAD SELECT
STS 4000,INDEX ERROR
STS 10000,30 VOLT UNSAFE
STS 20000,PHASE LK OSC UNSAFE
STS 100000,AC UNSAFE
0
; DRIVE ERROR REGISTER 3
ER3STS: STS 1,PACK SPEED UNSAFE
STS 2,VELOCITY UNSAFE
STS 10,UNSAFE EXCEPT R/W
STS 40,AC LOW
STS 100,DC LOW
STS 40000,SEEK INCOMPLETE
STS 100000,OFF CYLINDER
0
; DRIVE OFFSET REGISTER
OFSSTS: STS 2000,HDR COMPARE INH
STS 4000,ECC INHIBIT
STS 10000,PDP-11 FORMAT
0
];RH
;;; T-300 version of GSTS
T300,[ ;Print status of T300 (error from last command.)
T300ST: MOVEI P,PDL
PUSH P,[DDT]
T3STS: PUSHER P,[A,B,C,D,I,K]
TYPE T,"~&T-300 and 2561 status: "
SKIPN D,DSCFLT
JRST T3STS2
TRNN D,%DFRST+%DFCQE+%DFNXM+%DFPAR
JRST T3STS1
MOVEI C,[ STS %DFRST,CONTROLLER POWER-CYCLED AND RESET
STS %DFCQE,COMMAND-QUEUE ERROR
STS %DFNXM,RQB NXM
STS %DFPAR,RQB PARITY ERROR
0 ]
MOVSS D ;TYPSTS WANTS BITS IN LEFT HALF
CALL TYPSTS
LDB A,[000200,,DSCFLT]
LSH A,16.
IOR A,DSCSTS
TYPE T,", PDP-11 error address= ~O",[A]
T3STS9: CRR
JRST GSTS3
;;; Fault code
T3STS1: CAILE D,17
JRST [ TYPE T,"~&Illegal fault code=~O",[D]
JRST T3STS9 ]
MOVE B,(D)[ [ASCIZ/FAULT CODE 0?/]
[ASCIZ/DRIVE NOT READY/]
[ASCIZ/ILLEGAL HEAD OR SECTOR/]
[ASCIZ/SEEK TIMEOUT/]
[ASCIZ/DISK STATUS BAD AFTER ON-CYLINDER (FAULT CODE 4)/]
[ASCIZ/TIME OUT WRITING SECTOR ID (FAULT CODE 5)/]
[ASCIZ/FIFO ERROR IN FORMAT WRITE (FAULT CODE 6)/]
[ASCIZ/WRITE TIMEOUT (FAULT CODE 7)/]
[ASCIZ/SEEK TIMEOUT (FAULT CODE 10)/]
[ASCIZ/HEADS NOT LOADED/]
[ASCIZ/READ TIMEOUT (FAULT CODE 12)/]
[ASCIZ/INDEX TIMEOUT (FAULT CODE 13)/]
[ASCIZ/SECTOR TIMEOUT (FAULT CODE 14)/]
[ASCIZ/FAULT CODE 15?/]
[ASCIZ/DMA TIMEOUT (FAULT CODE 16)/]
[ASCIZ/DMA TIMEOUT IN ECC (FAULT CODE 17)/] ]
HRLI B,440700
TYPE T,"~A~%",[B]
;;; Command OK, check ordinary error status
T3STS2: MOVE D,DSCSTS
MOVEI C,[ STS %DSRTR,COMMAND WAS RETRIED
STS %DSECH,UNCORRECTABLE DATA ERROR
STS %DSECC,CORRECTED DATA ERROR
STS %DSIDE,ID ERROR
STS %DSHCE,HEADER COMPARE ERROR
STS %DSPRT,WRITE-PROTECTED SECTOR
STS %DSALT,ALTERNATE-SECTOR FLAG
STS %DSOVR,OVERRUN
STS %DSSKE,SEEK ERROR
STS %DSOFL,DRIVE OFF-LINE OR FAULT
STS %DSFLT,DRIVE FAULT
STS %DSNXM,PDP11 MEMORY NXM
STS %DSPAR,PDP11 MEMORY PARITY ERROR
STS %DSSFL,SYSTEM FAULT
STS %DSWLK,DRIVE WRITE-LOCKED
0 ]
MOVSS D ;TYPSTS WANTS D IN LEFT HALF
CALL TYPSTS
TYPE T,"~&Disk command: ~O ",[DSCCMD]
MOVEI B,[ASCIZ/(UNKNOWN?)/]
CAIN A,%DMSNS
MOVEI B,[ASCIZ/(SENSE)/]
CAIN A,%DMTST
MOVEI B,[ASCIZ/(DIAGNOSTICS)/]
CAIN A,%DMREC
MOVEI B,[ASCIZ/(RECALIBRATE)/]
CAIN A,%DMSEK
MOVEI B,[ASCIZ/(SEEK)/]
CAIN A,%DMWRT
MOVEI B,[ASCIZ/(WRITE)/]
TRNE A,%DMRED
JRST [ CAIG A,%DMRED+10
MOVE B,(A)[ [ASCIZ/(READ)/]
[ASCIZ/(READ EARLY-DATA-STROBE)/]
[ASCIZ/(READ LATE-DATA-STROBE)/]
[ASCIZ/(READ POSITIVE-CYLINDER-OFFSET)/]
[ASCIZ/(READ NEGATIVE-CYLINDER-OFFSET)/]
[ASCIZ/(READ EARLY-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
[ASCIZ/(READ EARLY-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
[ASCIZ/(READ LATE-DATA-STROBE POSITIVE-CYLINDER-OFFSET)/]
[ASCIZ/(READ LATE-DATA-STROBE NEGATIVE-CYLINDER-OFFSET)/]
]-%DMRED
JRST .+1 ]
HRLI B,440700
TYPE T,"~A, Drive=~O, Cyl=~O, Head=~O, Sec=~O",[B,DSCDRV,DSCHED,DSCSEC]
JRST T3STS9
];T300P
];NTS
SUBTTL Print UNIBUS status
KS,[
;;; UBSTS - Print Unibus status register and memory map.
;;; A/ UNIBUS adaptor number
TS,UBSTS: NOP
UBSTS: PUSHER P,[A,B,C,D]
HRLZ A,A ;UNIBUS adaptor we're interested in.
HRRI A,UBASTA ;Status register for this UBA.
IORD D,A ;Read it.
TYPE T,"~&UBA Status register contents: ~12<~;0~D~>",[D]
HLRZ D,D ;Get bits in D.
MOVEI C,UBSTST ;Names for status reg bits.
CALL TYPSTS ;Print them out.
HRRI A,UBAPAG ;1st UBA PAGING RAM register there.
UBSTS1: TYPE T,"~&UBA Paging RAM:"
MOVEI C,UBPGST ;Names for bits.
MOVEI B,UBALEN ;Gonna check each paging register.
UBSTS2: IORD D,A ;Read the register.
TYPE T,"~&~7<~;0~O~> ~12<~;0~O~>~40T",[A,D]
HLRZ D,D ;Get bits in D.
CALL TYPSTS ;Print them.
AOS A ;Do next paging register.
SOJGE B,UBSTS2 ;Do entire PAGING RAM.
POPPER P,[D,C,B,A]
RET
;;; Names of bits in the UBA Paging RAM.
UBPGST: STS 100000,RAM-PARITY
STS 40000,FRC-RD-PAUSE-WR
STS 4000,DISABLE-UPPER-2
STS 2000,FAST-MODE-ENABLE
STS 1000,VALID
STS 400,PAG-RAM-PAR-VALID
0
;;; Names of bits in the UBA Status Register.
UBSTST: STS 400000,UNIBUS-ARBITRATOR-TIMEOUT
STS 200000,BAD-MEM-DATA-OR-NPR-XFER
STS 100000,KS10-BUS-PARITY-ERROR
STS 40000,NX-DEVICE
STS 4000,INT-RQ-BR6-BR7
STS 2000,INT-RQ-BR5-BR4
STS 1000,POWER-LOW
STS 200,DISABLE-XFER-OR-UNCORRECTABLE-DATA
0
];KS
SUBTTL RESET a disk drive
;;; RESET and recalibrate the disk drive in I.
NTS,[
PH,[
RESET: MOVE T,QTRAN(I) ;Get physical drive number.
T300,[ CAIL I,T300P ;Is this is a T-300
JRST T3RST ] ; use the T300 rtns of course.
SKIPL DRIVE(T) ;Drive thought to be offline?
JRST [ SETZM QACT(I) ; Yes, mark it as down.
RET ]
PUSHER P,[A,B]
CALL RHQCLR
RHQCMD %HMRDP ;Readin Preset.
JRST RESETL
RHQSET %HROFS,[0] ;No offset, 18 bits, ECC on, HCI off.
JRST RESETL
RHQSET %HRWC,[0] ;Reset Word Count register.
JRST RESETL
RHQGET %HRTYP ;Get drive type
JRST RESETL
TRZ A,4000 ; Ignore DRQ bit
IFN RP06P, CAIE A,20022
IFN RP07P, CAIE A,20042
IFN RM80P, CAIE A,20026
IFN RM03P,[
.ERR Determine drive type for RM02
; and change CAI below to be CAIN
CAIE A,20024 ; RM03
CAI A,20023 ; RM02 also acceptable
CAIA
] ; RM03P
JRST [ TYPE T,"~&Unit ~O has unexpected type: ~O",[I,A]
JRST RESETL ]
RHQCMD %HMACK ;Acknowledge pack.
JRST RESETL
RHQGET %HRSTS ;Get drive status register.
JRST RESETL
TRNN A,%HSMOL ;Medium online?
JRST [ SETZM QACT(I)
ERR
TYPE T,"~&Drive ~O offline",[I]
JRST RESETL ]
RHQCMD %HMREC ;Recalibrate drive.
JRST RESETL
MOVEI B,80000. ;A little over 1/2 sec.
RESET1: RHQGET %HRSTS ;Check drive status.
JRST RESETL ; Drive vanished?
TRNE A,%HSERR ;Got error recalibrating?
JRST RESETL
TRC A,%HSVV+%HSMOL+%HXRDY ;Valid, Online, and Ready?
TRCE A,%HSVV+%HSMOL+%HXRDY ;Now is the time for all good bits...
SOJG B,RESET1 ;Wait for a little more.
JUMPG B,RESET5 ;Winning.
RESETL: SETZM QACT(I) ;Here when drive is losing.
SKIPE GOGOX ;If in automatic mode
JRST RESET9 ; GOGO mode will check for right packs mounted.
HRRZ A,QTRAN(I)
TYPE T,"~2&Disk ~O (unit ~O) is losing.",[I,A]
RHQGET %HRCS2
JRST RESETL
TRNE A,%HYNED
TYPE T,"~&Non-existant drive."
RHQGET %HRCS1
JRST RESETL
TRNE A,%HXMCP
TYPE T,"~&Register Access Error"
CALL GSTS
JRST RESET9
RESET5: SKIPE NOISE
TYPE T,"~&RESET: Disk ~O online and recalibrated.",[I]
SH,[
RESET6: SKIPE MARKF ;Pack online.
JRST RESET9 ; But not formatted, so punt.
;;; A formatted disk pack is online.
;;; Read pack number from Sector Header
;;; (This really only has to read two words, but CStacy thought he was
;;; reading in the TUT when he wrote it...)
MOVE A,[2,,CYLPAG] ;Two pages starting in CYLBUF.
CALL QUBMAP ;Map it.
RHQSET %HRBA,[0] ;Reset UNIBUS address.
JRST RESETL
RHQSET %HRCYL,[TUTCYL] ;We desire the TUT cylinder.
JRST RESETL
RHQSET %HRADR,[0] ;We desired track 0.
JRST RESETL
RHQSET %HRWC,[-4000] ;One ITS block.
JRST RESETL
RHQCMD %HMRHD ;Read headers and data.
JRST RESETL ; Lossage.
CALL QWAIT ;Wait for completion.
JRST RESETL
HRRZ A,CYLBUF+1 ;ITS pack number from sector header.
HLRZ B,CYLBUF+1 ;Get drive serial # formatted on.
MOVEM A,PKNUM(I) ;Remember it.
SKIPE NOISE
TYPE T,"~&Pack ~D. is online. (Formatted by drive ~D.)",[A,B]
];SH
RESET9: POPPER P,[B,A]
RET
];PH
];NTS
NTS,[
DC,[
RECAL: CONO DC0,DCCSET+DCDENB
MOVE T,QTRAN(I)
SKIPL DRIVE(T) ;SKIP IF DRIVE NOT KNOWN TO BE DEAD ALREADY
JRST [ SETZM QACT(I)
RET]
DPB T,[DUNFLD DRST]
DPB T,[DUNFLD STOSTS]
DATAO DC0,[DJMP STOSTS]
CONSZ DC0,DSSACT
JRST .-1
MOVE T,STATUS
TDNN T,[DDSONL] ;ON LINE
JRST OFFL1
DATAO DC0,DRST
CONSO DC0,DSSATT
JRST .-1
CONSO DC1,20 ;OFF LINE OR MULTIPLE SELECT
RET
OFFL1: SETZM QACT(I)
SKIPE GOGOX
RET ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
PUSH P,A
HRRZ A,QTRAN(I)
SETZM DRIVE(A)
TYPE T,"~&Drive off line #~D.",[A]
POP P,A
RET
];DC
RP,[
RESET: PUSH P,A
CONSZ DPC,BUSY
JRST .-1
DATAO DPC,[DEASEC 776]
DPB I,[DUNFLD DRST]
DATAO DPC,DRST
RESET0: DATAI DPC,T
TLNE T,20
JRST RESET1
SKIPE GOGOX
JRST RESET9 ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
TYPE T,"~&OFF LINE #~D.",[I]
JRST RESET9
RESET1: TLNN T,4
JRST RESET2
SKIPE GOGOX
JRST RESET9 ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
TYPE T,"~&NO SUCH DRIVE #~D.",[I]
JRST RESET9
RESET2: TRNN T,776
JRST RESET0
DATAO DPC,[DEASEC 776]
JRST POPAJ
RESET9: SETZM QACT(I) ;THIS DRIVE LOST
JRST POPAJ
DRST: DRCALC
];RP
DC,[
RESET: CALL RECAL
MOVE T,QTRAN(I) ;GET PACK ID FROM HARDWARE
DPB T,[DUNFLD GPKID]
MOVEI T,TUTCYL
SKIPGE QTRAN(I)
ADDI T,NCYLS+XCYLS
DPB T,[DCYL GPKID]
CONO DC0,DCCSET+DCDENB
DATAO DC0,[DJMP GPKID]
CONSZ DC0,DSSACT
JRST .-1
LDB T,[DPKID RPKID]
MOVEM T,PKNUM(I)
RET
DRST: DSPC+DSRCAL+DSWINF+DUNENB
GPKID: DSPC+DSCRHD+DSWNUL+DUNENB+TUTCYL_11.+TUTSRF_6+TUTSEC
DCOPY RPKID(37774)
DHLT
];DC
RH,[
RESET: MOVE T,QTRAN(I) ;GET PHYS DRIVE
T300,[
CAIL I,T300P
JRST T3RST
];T300P
SKIPL DRIVE(T)
JRST [ SETZM QACT(I) ;DRIVE ALREADY KNOWN TO BE DOWN
RET ]
PUSH P,A
MOVE A,[%HRDCL,,%HMCLR] ;CLEAR THE DRIVE
CALL RHSET
JRST RESETL ;HMM, NO DRIVE
MOVE A,[%HRDCL,,%HMRDP] ;I SAID, "CLEAR THE DRIVE"!
CALL RHSET
JRST RESETL
MOVE A,[%HROFS,,0] ;CLEAR THE FRIGGING DRIVE!!!
CALL RHSET
JRST RESETL
MOVSI A,%HRTYP ;GET DRIVE TYPE
CALL RHGET
JRST RESETL ;??
TRNE A,140000
JRST RESETL ;TAPE?
TRNN A,020000
JRST RESETL ;FIXED HEADS?
MOVE A,[%HRDCL,,%HMACK] ;PACK ACKNOWLEDGE
CALL RHSET
JRST RESETL
MOVSI A,%HRSTS
CALL RHGET
JRST RESETL
TRNN A,%HSMOL
JRST RESET4 ;PACK NOT MOUNTED
MOVE A,[%HRDCL,,%HMREC] ;RECALIBRATE
CALL RHSET
JRST RESETL
MOVEI B,80000. ;A LITTLE OVER 1/2 SEC
RESET0: MOVSI A,%HRSTS ;GET STATUS
CALL RHGET
JRST RESETL ;DRIVE VANISHED?
TRNE A,%HSERR
JRST RESETL ;GOT ERROR RECALIBRATING?
TRC A,%HSVV+%HSMOL+%HSRDY ;CHECK FOR GOOD BITS
TRCE A,%HSVV+%HSMOL+%HSRDY
SOJG B,RESET0 ;BITS NOT ALL ON, WAIT MORE
JUMPG B,RESET5 ;WON.
;TIMED OUT, FALL INTO RESETL
RESETL: SETZM QACT(I) ;LOST
SKIPE GOGOX
JRST POPAJ ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
CONSZ DSK,%HIDRE
JRST RESET1
CONSZ DSK,%HIILC
JRST RESET2
TYPE T,"~&MISC ERROR DRIVE #"
MOVEI A,GSTS ;CALL GSTS BEFORE RETURNING
EXCH A,(P)
PUSH P,A
JRST RESET3
RESET2: TYPE T,"~&ILC OR RAE DRIVE #"
JRST RESET3
RESET1: TYPE T,"~&DRIVE NOT PRESENT #"
RESET3: HRRZ A,QTRAN(I)
TYPE T,"~D.",[A]
JRST POPAJ
RESET4: SETZM QACT(I)
SKIPE GOGOX
JRST POPAJ ;IN GOGO MODE, WILL CHECK FOR RIGHT PACKS MOUNTED
TYPE T,"~&DRIVE OFF LINE #"
JRST RESET3
RESET5: SKIPE MARKF
JRST POPAJ ;PACK NOT FORMATTED YET
MOVSI A,%HRCYL
HRRI A,TUTCYL
CALL RHSET
JRST RESETL
MOVSI A,%HRADR
CALL RHSET
JRST RESETL
MOVE A,[-2_4,,SLVIOWD-1]
MOVEM A,SLVICWA
SETZM SLVICWA+1
KL,[ SWPUO 0
CONSZ 200000
JRST .-1
]
MOVE A,[%HRCTL,,SLVICWA_6+%HMRHD]
CALL RHSET
JRST RESETL
CONSO DSK,%HIDONE
JRST .-1
CONSZ DSK,%HIERR
JRST RESETL
HRRZ A,SLVIOWD+1 ;GET I.T.S. PACK NUMBER
MOVEM A,PKNUM(I)
JRST POPAJ
];RH
T300,[
T3RST: PUSH P,D
MOVEI D,%DMSNS ;FIRST, SENSE STATUS (RECALIBRATE HANGS IF
CALL T3CMD ; DRIVE OFF LINE, AND TIMEOUT LEAVES 11 WEDGED)
JUMPL T,T3RSTL ;TIMEOUT, 11 MUST BE DOWN
TDNE T,[%DFRST,,%DSOFL+%DSSFL]
JRST T3RSTL ;DRIVE OFF-LINE, LEAVE IT ALONE
MOVEI D,%DMREC ;SEND A RECALIBRATE
CALL T3CMD
JUMPN T,T3RSTL ;JUMP IF ERROR
SETOM PKNUM(I) ;PACK NUMBER NOT GOTTEN FROM HARDWARE!
POP P,D
RET
T3RSTL: SETZM QACT(I) ;OFF LINE
POP P,D
SKIPN GOGOX
JRST T3STS
RET
];T300
];NTS
TS,[
RESET: PUSH P,A
HRRZ A,QTRAN(I)
SKIPL DRIVE(A)
JRST OFFL2
CAML I,NQS
JRST OFFL2
HRRZ A,SQACT ;SYSTEM QACT TABLE
ADD A,I
MOVSS A
HRRI A,A
.GETLOC A, ;COPY SYSTEMS QACT
SKIPE A ;0 MEANS ON-LINE TO ITS
JRST OFFLIN
POP P,A
RET
OFFLIN: TYPE T,"~&Drive off line #"
HRRZ A,QTRAN(I)
SETZM DRIVE(A)
TYPE T,"~D.",[A]
OFFL2: SETZM QACT(I)
POP P,A
RET
JRST POPAJ
];TS
SUBTTL RH-11 and RH-10 Pack Formatting
NTS,[
RHPH,[
MARK: JSR INIT ;Reset the world.
SETZM CERRS
KL,[ SWPUA ;Turn the cache off.
CONSZ 200000
JRST .-1
CONI PAG,A
TRZ A,600000
CONO PAG,(A) ];KL
MARK1: TYPE T,"~&Format pack on unit #"
CALL NTYI ;Read unit number.
JRST MARK1
CAIL A,NUNITS ;Does unit possibly exist?
JRST [ TYPE T,"There aren't that many disk units here"
JRST MARK1 ]
MOVE I,A ;Unit in I.
MOVEM I,TOU ;Remember, it's the disk to hack.
SETOM MARKF ;Say pack not formatted yet.
CALL RESET ;Recalibrate drive.
PH, CALL RHQCLR ;Clear ctrlr errors.
SETZM MARKF
ASKYN "~&Are you sure you want to format pack on drive # ~O",[I]
PUNT ; Allow user to abort.
TYPE T,"~&Pack no ?"
CALL DTYI ;Read desired pack number.
MOVEM A,PKNUM(I) ;Remember it.
MOVE B,A
RH, RHQGET %HRSER
PH, RHQGET %HRSER ;Read drive serial number.
JRST RHMKER ; Eh?
TYPE T,"~&Pack ~D., Drive #~O is serial #~D.",[B,I,A]
SH,[
HRLZ D,A ;Keyword has (3.1-4.7) the serial
TLZ D,600000 ;number of drive we formatted on,
HRR D,PKNUM(I) ;second key is ITS pack number.
];SH
SETZB A,B ;A is offset, B is disk addr.
RHFMP1: MOVEM B,CYLBUF(A) ;Write Disk Address into each sector.
IFN RM80P,[
MOVSI C,140000 ; Say that the sector is OK.
HLLM C,CYLBUF(A) ; (The documentation is not clear...)
] ;RM80P
SH, MOVEM D,CYLBUF+1(A) ;Write key into each sector.
ADDI A,HSECTOR-SECTOR ;Advance to first data word.
SETZB C,E ;Fill sector with worst case pattern.
RHFMP2: MOVE T,RHWC(E) ;Get pattern.
MOVEM T,CYLBUF(A) ;Stuff into buffer.
AOS E ;Count pattern words stuffed.
CAIL E,RHWCL ;Got them all?
MOVEI E,0 ; Yes, start pattern over.
AOS A ;Next word.
CAIGE C,SECTOR-1 ;128 words (1 sector) filled?
AOJA C,RHFMP2 ; No, keep filling.
CAIE B,NSECS-1 ;All sectors in track filled?
AOJA B,RHFMP1 ; No, do next sector.
CAIE A,HSECTOR*NSECS ;Ensure right amount of cruft here.
LOSE "~&Filled ~D. words for track formatting pattern.",[A]
RHFM10:
PH,[ HRLZI A,1+<HSECTOR*NSECS>/PG$SIZ ;# PDP10 pages.
HRRI A,CYLPAG ;Use CYLBUF.
CALL QUBMAP ;Map it in.
];PH
;; Now copy the pattern into each track on the disk.
MOVEI J,NCYLS+XCYLS ;Format sectors in ALL cylinders.
TYPE T,"~&Begin formatting ~D. cylinders....",[J]
RHFM20: SOJL J,RHFM50
MOVEI K,NHEDS ;K counts tracks.
RHFM30: SOJL K,RHFM20 ;On end-of-cyl, do next cyl.
PH,[ RHQSET %HRBA,[0] ;Reset UNIBUS address.
JRST RHMKER ; Eh?
];PH
MOVEI B,NSECS ;Adjust the header disk addresses.
MOVEI C,0 ;Sector counts already in format.
RHFM40: DPB J,[221200,,CYLBUF(C)] ;Say which cylinder this is.
DPB K,[100500,,CYLBUF(C)] ;Say which track this is.
ADDI C,HSECTOR ;Find beginning of next sector header.
SOJG B,RHFM40 ;Update all the headers.
RH,[ MOVSI A,%HRADR ;Set up address in drive.
DPB K,[$HATRK A] ;Track from K.
CALL RHSET ;Set it.
JRST RHMKER ; Eh?
MOVSI A,%HRCYL ;Leave cylinder number in RH10 "DIB" lights.
HRR A,J ;Cylinder from J.
CALL RHSET ;Set it.
JRST RHMKER ; Eh?
SETZM SLVICWA+1
MOVSI A,%HRCTL ;Set up program.
RHFMT: HRRI A,%HMWHD ;Command is Write Headers And Data.
MOVEI B,SLVICWA ;Ptr to channel program
DPB B,[$HCICWA A] ;with sizes and address.
CALL RHSET ;Write a track.
JRST RHMKER
CONSO DSK,%HIDONE ;Done yet?
JRST .-1 ; Wait for completion.
CONSZ DSK,%HIERR ;Anything go wrong?
JRST RHMKER ; Foo!
JRST RHFM30 ;OK, do next track.
];RH
PH,[ MOVSI A,%HRADR ;Move to desired track.
DPB K,[$HATRK A] ;Whole track (from its 0 sector) each xfer.
CALL RHSET
JRST RHMKER
MOVSI A,%HRWC ;Gonna do entire track, plus header words.
HRR A,[-2*<HSECTOR*NSECS>]
MOVEM A,RHIOWC ;-# UNIBUS wds to xfer (in each track).
CALL RHSET
JRST RHMKER
MOVSI A,%HRCYL ;Move to desired cylinder.
HRR A,J
CALL RHSET
JRST RHMKER
RHFMT:
IFN RP07P,[
MOVE A,[%HROFS,,100000] ; Must ask permission of RP07...
CALL RHSET
JRST RHMKER
]
RHQCMD %HMWHD ;Write Headers and Data.
JRST RHMKER
CALL QWAIT ;Wait for completion.
JRST RHMKER
JRST RHFM30
];PH
RHFM50: TYPE T,"Hardware formatting complete."
ASKYN "~&Verify pack?"
JRST RHFMTX
RHFVFY: TYPE T,"~&Verification begins."
MOVEI J,NCYLS+XCYLS-1
RHFM51: MOVEI A,CYLBUF
SKIPE NOISE
TYPE T,"~&Verifying cylinder ~D.",[J]
CALL READCY
JUMPG T,RHFM60
TYPE T,"~2&Cylinder ~O in error.",[J]
SKIPE NOISE
CALL GSTS
ASKYN "~&Verify this cylinder?"
JRST RHFM70
;;; Verify data. Relies on sector size being a multiple of RHWCL.
RHFM60: SETZB A,E
RHFM65: MOVE B,CYLBUF(A)
CAME B,RHWC(E)
CALL [ PUSHER P,[A,B,C]
MOVE C,RHWC(E)
TYPE T,"~&Word ~O Cyl ~O Correct= ~O (~S), Actual= ~O (~S)",[A,J,C,C,B,B]
POPPER P,[C,B,A]
RET ]
ADDI E,1
CAIL E,RHWCL
MOVEI E,0
CAIGE A,SECTOR*NSECS
AOJA A,RHFM65
RHFM70: SOJGE J,RHFM51
SKIPN A,CERRS ;Any corrected errors?
JRST RHFMTX ; If so, report them.
TYPE T,"~&~D ECC-corrected errors during verification.",[CERRS]
RHFMTX: CRR
JRST MARK69 ;Hardware formatted, do software part.
RHMKER: TYPE T,"~&Disk Error!"
CALL GSTS
PUNT
IFN RP06P\RP07P,[
RHWC: ;; RP06 worst case pattern
;; (Where did CStacy get this from?)
;; Use this for RP07 too? Who knows? What the heck!
555555555753
666666765555
333372666666
573333333333
555555555753
666666765555
333372666666
573333333333
RHWCL==.-RHWC
] ;IFN RP06P\RP07P
IFN RM03P\RM80P,[
RHWC: ;; RM03 worst case pattern
;; I got this from T20's FORMAT.MAC which also uses this pattern
;; for RP04/5/6's. Probably they didn't know if this was a good
;; test of an RM03 (or RM80) either. What the heck.
726666,,666676
555555,,555753
333333,,337266
666666,,765555
555557,,533333
333372,,666666
667655,,555555
573333,,333333
RHWCL==.-RHWC
] ;IFN RM03P\RM80P
RH,[
RHWC: ;; RP04 10-mode worst case pattern
726666666676
555555555753
333333337266
666666765555
555557533333
333372666666
667655555555
573333333333
RHWCL==.-RHWC
];RH
];RHPH
];NTS
SUBTTL DC-10 Pack Formatting
NTS,[
DC,[
MARK: JSR INIT
TYPE T,"~&Format pack on unit #"
CALL NTYI ;Read unit number.
JRST MARK1
CAIL A,NUNITS ;Does unit possibly exist?
JRST [ TYPE T,"There aren't that many disk units here"
JRST MARK1 ]
HRRZ TT,QTRAN(A)
CONO DC1,(TT) ;Setup drive # for latency timer.
MOVEM A,TOU
MOVE I,A
CALL RECAL ;Recalibrate drive.
CONSO DC1,DFUNSF\DOFFL
JRST MARK1
ASKYN "~&Are you sure you want to format pack on drive # ~O?",[I]
PUNT ; Allow user to abort.
MARK1: MOVE A,[DSPC+DSCWIM+DSWIDX+DSWNUL]
MOVEM A,CYLBUF
MOVEI D,CYLBUF+1
CALL RDLAT ;Read latency timer.
JUMPE A,.-1
MARK1A: CONI DC1,A
CONI DC1,C
LDB A,[DSLAT A]
LDB C,[DSLAT C]
CAME A,C
JRST MARK1A
JUMPN A,[MOVE B,A
JRST MARK1A]
IFN 0,[ ;THIS HARDWARE HAS BEEN BROKEN FOR YEARS
PUSH P,B
MOVE A,B
IDIVI A,10. ;NO. OF MILLISECONDS
PUSH P,B
CALL TDPT
MOVEI A,".
CALL TYO
POP P,A
ADDI A,"0
CALL TYO
TYPE MILLISECONDS ROTATION TIME
CRR
POP P,B
CAIGE B,254. ;LIKELY JUST NO INDEX ON THIS PACK
JRST MARK1B
TYPE TOO DAMN LONG TO BE CREDIBLE, USING 24.5 MS.
CRR
];IFN 0
MOVEI B,245.
MARK1B: IMULI B,PG$DEC ;Convert to number of bits/track.
IDIVI B,36. ;# words per sector.
AOJ B,
MOVEM B,MAXT'
SETZ A,
CALL STOBLK ;Enough ones to wipe out this track.
MOVE J,MAXT
IDIVI J,NSECS
CAIL K,NSECS/2
AOJ J, ;Inter-sector gap length.
SUBI J,3+3+7+3011 ;Header code+header data+"ones"+block+checksum.
MOVEI Q,NSECS
MARK1C: MOVEI B,(D)
HRLI B,HBLK ;Setup COPYS for header preamble,data,postamble.
ADDI D,3
BLT B,-1(D)
MOVNI B,-NSECS(Q)
IMULI B,3
ADDI B,DHEDR
HRRM B,-2(D) ;Point copy to this sectors encoded data.
MOVEI B,103. ;103 blocks of 10 zeros (encoded)
MOVE A,[QCOPY EZERS,15.,]
CALL STBLK
SOJLE Q,MARK1D
MOVE B,J ;Enough ones to fill out remaining part of sector.
CALL STOBLK
JRST MARK1C
;;; Setup stuff for possibly writing READIN block.
MARK1D: MOVE A,[QCOPY EONES,3,]
MOVEM A,(D)
AOJ D,
MOVSI A,(DOPR+DOHXFR)
MOVEM A,(D)
MOVEM D,RIWP'
ADDI D,2
MOVE B,J
SUBI B,3+3+7+LRIBLK*3/2+3 ;Header+LRIBLK+Checksum.
LSH B,-1
SUBI B,3*3
CALL STOBLK
MOVEI B,(D)
HRLI B,WRTRI
ADDI D,5
BLT B,-1(D)
MOVSI A,(DJMP) ;Patch JUMP around RIBLK code, will be clobbered for block 0 only.
ADDI A,(D)
MOVE B,RIWP
MOVEM A,1(B)
MOVEI B,(D)
MOVEM B,ENDP'
AOS ENDP
HRLI B,RCBLK
ADDI D,5
BLT B,-1(D)
MOVEI B,-3(D) ;Patch AOJN .-1 address.
HRRM B,-2(D)
TYPE T,"~&Pack no ?"
CALL DTYI ;Read desired pack number.
MOVE I,TOU
MOVEM A,PKNUM(I)
MOVE I,[440300,,RIHEDR] ;Encode READIN header.
CALL ENCI
MOVEI I,RIHED0
CALL HCOMP
MOVEI J,<NBLKS+XBLKS>/NSECS-1
MOVEM J,TRKN'
;;; WRITE IMAGE COMMAND - (START AT SECTOR PULSE)
;;; COPY <ENCODED ONES> ;ENOUGH TO WIPE OUT FULL TRACK
;;; (THEN FOR EACH SECTOR):
;HEADER PREAMBLE
; ONES FOLLWED BY SINGLE ZERO
; 8 BYTES OF 10101
; TWO 28 BIT HEADER WORDS
; A SERIES OF ONES FOLLWED BY 01
;ENCODED ZEROS FOR DATA BLOCK (2004) WORDS + 2 WORDS CHECKSUM
;ENOUGH ENCODED ONES TO FILL OUT REST OF SECTOR (EXCEPT ON LAST SECTOR)
;AFTER LAST SECTOR
;A FEW ONES
; NORMALLY: FOR BLOCK 0:
;RIWP: HANG FOR END OF TRANSFER WRITE ONES
; JUMP AROUND WRITE READIN WRITE ONES
; READIN HEADER PREAMBLE
; READIN HEADER
; READIN HEADER POSTAMBLE
; READIN BLOCK
; ONES TO PAD OUT REST OF TRACK
; DALU SETUP CONTROL COUNTER
;ENDP: READ COMPARE COMMAND
; COPY 4 WORDS ZEROS
; AOJN CC,.-1
; HALT .
MARK2: MOVEI K,5
MOVEM K,NTRYS'
SETZM DHED0
CAIL J,NBLKS/NSECS
JRST MARK2C
MOVE I,TOU
MOVE A,PKNUM(I)
DPB A,[DPKID DHED0] ;PACK ID FOR HEADER
DPB A,[DPKID @ENDP] ;PACK ID FOR READ-COMPARE COMMAND
JUMPN J,MARK2C
MOVE B,RIWP
MOVE A,[QCOPY EONES,3,]
MOVEM A,(B)
MOVEM A,1(B)
MARK2C: IDIVI J,NHEDS
PUSH P,J
MOVE W,TOU
SKIPGE QTRAN(W)
ADDI J,NCYLS+XCYLS ;OFFSET IF DOUBLE SIZE PHYSICAL PACK
IRP A,,[CYLBUF,@ENDP,DHED0] ;SETUP INITIAL WRITE-IMAGE COMMAND
DPB J,[DCYL A] ; " READ-COMPARE COMMAND
DPB K,[DSURF A] ; " HEADER WORD
TERMIN
POP P,J ;VIRTUAL CYLINDER #
MOVEI W,0
DPB W,[DHNXAD DHED1]
MOVEI W,1 ;END OF TRACK
CAIN K,NHEDS-1
MOVEI W,2 ;END OF CYLINDER
CAIE J,NCYLS-1
CAIN J,NCYLS+XCYLS-1
TRO W,1 ;END OF DISK
MOVE I,[440300,,DHEDR]
CALL ENCI
MOVEI I,DHED0
MOVEI Q,NSECS
MARK2B: CAIN Q,1 ;PUT IN INCREMENT CODE
DPB W,[DHNXAD DHED1]
CALL HCOMP ;ENCODE HEADERS
AOS DHED0
SOJG Q,MARK2B
MARK2A: CONO DC0,DCCSET\DCDENB
DATAO DC0,[DJMP CYLBUF]
MOVE A,[DWLUP,,14]
BLT A,16
JRST 14 ;WAIT IN AC'S FOR DISC, THEN FALL THRU
MARK2D: CONSO DC0,DSSERR
JRST MARK4
CONSZ DC1,DCPERR\DNXM\DDOBSY
JRST MARK3A
CONSZ DC1,DPROT
JRST MARK3B
CONSZ DC1,DOFFL\DFUNSF
JRST MARK3C
CONSO DC1,DWTHER\DCKSER\DOVRRN\DRCER\DRLNER
JRST MARK3D
MTROV: SOSLE NTRYS
JRST MARK2A
CONSZ DC1,DOVRRN
JRST MARK3A
LOSE "Disk Bad"
DWLUP: CONSZ DC0,DSSACT
JRST 14
JRST MARK2D
MARK3A: LOSE "MACHINE LOSSAGE"
MARK3B: LOSE "NOT WRT ENABLED"
MARK3C: LOSE "DRIVE LOSSAGE"
MARK3D: LOSE "CONTROLLER LOSSAGE"
MARK4: SOSL J,TRKN
JRST MARK2
HCOMP: SETOM HPAR'
MOVEI J,(I)
HRLI J,-2
HCOMP1: MOVEI B,14.
MOVE A,(J)
XORM A,HPAR
LSH A,-2
SOJG B,.-2
AOBJN J,HCOMP1
MOVE B,(I)
CALL ENCH
MOVE B,HPAR
ANDI B,3
LSH B,20.
XORB B,1(I)
CALL ENCH
MOVSI B,770000
HCOMP2: TDNN B,DSKBP
RET
CALL ENCDO
JRST HCOMP2
ENCO: SKIPA A,C1
ENCZ: MOVEI A,0
ENC: ANDI A,1
HRRZ T,ENCS'
JRST @ENCT(T)
ENCT: ENC1
ENC2
ENC1
ENCZ2
ENCDO: SKIPA A,[3]
ENCDZ: MOVEI A,0
ENCD: ANDI A,3
HRRZ T,ENCS
JRST @ENCDT(T)
ENCDT: ENC2A
[HALT .]
ENCZ2A
[HALT .]
ENC1: HRLM A,ENCS
ENC1A: AOS ENCS
RET
ENC2: ROT A,-1
HLR A,ENCS
ROT A,2
JRST ENC2B
ENC2A: LSH A,1
AOS ENCS
ENC2B: JUMPE A,ENC1A
C1: TRO A,1
IDPB A,DSKBP'
ENC3: SETZM ENCS
RET
ENCZ2: ROT A,-1
HLR A,ENCS
JRST .+2
ENCZ2A: ROT A,-1
ASH A,2
TRO A,2
IDPB A,DSKBP
ROT A,2
TRO A,5
IDPB A,DSKBP
JRST ENC3
ENCH: LSH B,36.-28.
SKIPA C,[14.]
ENCW: MOVEI C,18.
LSHC A,2
CALL ENCD
SOJG C,.-2
RET
ENCI: MOVEM I,DSKBP
SETZM ENCS
RET
RDLAT: CONI DC1,A ;READ LATENCY TIMER INTO A
LDB A,[DSLAT A]
RDLAT2: MOVEM A,T
CONI DC1,A
LDB A,[DSLAT A]
CAME A,T
JRST RDLAT2
RET
STBLK: MOVEM A,(D) ;STORE C(A) IN B WORDS AT D
SOJLE B,[AOJA D,CPOPJ]
HRLI D,1(D)
ADDI B,1(D)
MOVS D,D
EXCH B,D
BLT B,-1(D)
RET
STOBLK: MOVE A,[QCOPY EONES,LOBLK,]
IDIVI B,LOBLK
JUMPE B,STOBL3 ;LESS THAN ONE BLOCK NEEDED??
JUMPE C,STOBL2
CAIL C,3
JRST STOBL2
SOJ B,
ADDI C,LOBLK
STOBL2: CALL STBLK
STOBL3: CAIGE C,3
MOVEI C,3
MOVNI C,(C)
DPB C,[DCWC A]
MOVEM A,(D)
AOJA D,CPOPJ
HBLK: QCOPY PREAMB,3, ;NORMAL HEADER
QCOPY .,3,
QCOPY POSTMB,7,
WRTRI: QCOPY PREAMB,3, ;READIN HEADER, DATA BLOCK
QCOPY RIHEDR,3,
QCOPY POSTMB,7,
QCOPY EZERS,<LRIBLK*3/2+3>,
QCOPY EONES,3,
RCBLK: DALU+DLCC+DLLB -401*NSECS(3) ;READ COMPARE "LOOP" FOR DATA WORDS
DRCC
QCOPY ZERS,4
DJMP+DAOJNC .
DHLT
LOBLK==60
DHED0: 0
DHED1: -2004&37777
DHEDR: BLOCK 3*NSECS
RIHED0: 0
RIHED1: -LRIBLK&37777
RIHEDR: BLOCK 3
EZERS: REPEAT LRIBLK*3/2+3,252525252525
EONES: REPEAT LOBLK+3,-1
PREAMB: -1 ;ONES
-26 ;ONES...0.1010
655326553265 ;1.10101.10101.10101.10101.10101.10101.10101
POSTMB: REPEAT 6,-1 ;ONES...01
-3
ZERS: BLOCK 4
];DC
];NTS
SUBTTL RP-10 Pack Formatting
NTS,[
RP,[
MARK: JSR INIT
KL,[ SWPUA ;Turn the cache off.
CONSZ 200000
JRST .-1
CONI PAG,A
TRZ A,600000
CONO PAG,(A) ];KL
TYPE T,"~&Format pack on unit #"
CALL NTYI
JRST MARK
CAIL A,NUNITS
JRST MARK
MOVE I,A
MOVEM I,TOU
SETOM MARKF
CALL RESET
SETZM MARKF
MOVSI A,(DNOOPC) ;Determine type of drive.
DPB I,[DUNFLD A]
DATAO DPC,A
DATAI DPC,A
MOVEI B,"2
MOVEI C,NCYLS+XCYLS
TRNN A,2000
JRST .+3
MOVEI B,"3
MOVEI C,MCYLS+XCYLS
MOVEM C,LAST
TLNE A,1
LOSE "~&Write Header Lockout switch is on"
ASKYN "~&Are you sure you want to format pack on RP0~C#~O",[B,I]
PUNT
TYPE T,"~&Pack No ="
CALL DTYI
MOVEM A,PKNUM(I)
SETZB A,B ;Generate template track.
RPFMP1: MOVEI T,31. ;Sync zone of 30 zero words.
SETZM CYLBUF(A)
AOS A
SOJG T,.-2
AOS CYLBUF-1(A) ;And one word containing 1 in bit 35.
MOVEM B,CYLBUF(A) ;Then address word.
REPEAT 4,SETZM CYLBUF+1+.RPCNT(A) ;Then addr parity word and 3 zero words sync.
ADDI A,5
MOVE T,RPWC ;Then 128 data words of worst case pattern.
MOVEM T,CYLBUF(A)
MOVSI T,CYLBUF(A)
HRRI T,CYLBUF+1(A)
BLT T,CYLBUF+177(A)
ADDI A,200
CAIGE B,NSECS-1 ;Do next sector.
AOJA B,RPFMP1
CAIE A,244*NSECS
HALT . ;Wrong amount of cruft generated?
MOVE A,[-244*NSECS,,CYLBUF-1] ;Set up IOWD.
MOVEM A,SLVIOWD
SETZM SLVIOWD+1
MOVEI A,SLVIOWD
MOVEM A,SLVICWA
JRST RPFMT0 ;GO FORMAT
RPMKER: TYPE DISK ERROR
X CRR
CALL GSTS
JRST DDT
RPFMT0: MOVE J,LAST ;HIGHEST CYLINDER # + 1
RPFMT1: SOJL J,RPFMT4 ;LOOP ON CYLINDERS
MOVEI K,NHEDS
RPFMT2: SOJL K,RPFMT1 ;LOOP ON SURFACES
MOVEI B,NSECS ;ADJUST THE HEADER WORDS
MOVEI C,0
RPFMT3: DPB J,[121100,,CYLBUF+37(C)]
DPB K,[050500,,CYLBUF+37(C)]
MOVE D,CYLBUF+37(C) ;COMPUTE HEADER PARITY WORD
MOVEI T,36.
MOVSI TT,(SETZ) ;ODD PARITY
RPFMTP: TRNE D,1
TLC TT,(SETZ)
ROT D,1
SOJG T,RPFMTP
MOVEM TT,CYLBUF+40(C)
ADDI C,244
SOJG B,RPFMT3
MOVSI A,300000 ;WRITE FORMAT
ADDI A,SLVICWA
DPB J,[DCYL A]
ROT J,-8 ;EXTRA BIT FOR RP03
DPB J,[DCYLXB A]
ROT J,8
DPB K,[DSURF A]
DPB I,[DUNFLD A]
MOVEM J,RPIOCY
CALL SEEK
JRST RPMKER
DATAO DPC,A
CONSO DPC,DONE
JRST .-1
CONSZ DPC,ALLER
JRST RPMKER
JRST RPFMT2
RPFMT4: TYPE T,"~&Formatting complete, verification begins."
SOS J,LAST
RPFMT5: MOVEI A,CYLBUF
CALL READCY
JUMPGE T,RPFMT6
TYPE T,"~&Cylinder ~O doesn't read -- giving up on it.",[J]
CALL GSTS
CRR
JRST RPFMT9
RPFMT6: SETZB A,E ;VERIFY DATA.
MOVE D,RPWC
LSH D,1 ;CONTROL DROPS ONE BIT DURING WRITE FORMAT
RPFMT7: MOVE B,CYLBUF(A)
CAME B,D
CALL RPFMT8
CAIGE A,200*NSECS
AOJA A,RPFMT7
RPFMT9: SOJGE J,RPFMT5
CRR
JRST MARK69 ;Hardware formatted, do software
RPFMT8: PUSH P,A
TYPE T,"~&Word ~O of Cylinder ~O Correct ~O Actual ~O",[A,J,RPWC,B]
JRST POPAJ
RPWC: 714533,,462556 ;Worst case pattern.
];RP
];NTS
SUBTTL Pack Formatting Part 2 - Initialize MFD and TUT
;;; Args: TOU and PKNUM+n
NTS,[
MARK69: MOVE I,TOU ;Set disk unit.
CALL MFDINN ;Init the MFD.
TYPE T,"~&Swapping Alloc? "
CALL OTYI
CALL TUTINI ;Init TUT.
MOVE A,PKNUM(I) ;Get pack number.
MOVEM A,TUT+QPKNUM
TYPE T,"~&Pack #~D. ID?",[A]
CALL 6TYI
MOVEM B,TUT+QPAKID
MOVEI A,MFD ;MFD in buffer.
MOVE J,MFDBK ;Going to disk.
CALL WRITT ;Write it.
JUMPL T,WRERR
MOVE A,TUT+QSWAPA ;Finish setting up TUT.
CAMGE A,NUDS ;Set free space pointer.
MOVE A,NUDS
ADDI A,NBLKSC-1 ;In case QSWAPA not on cylinder boundary.
IDIVI A,NBLKSC
IMULI A,NBLKSC
MOVEM A,TUT+QTUTP
MOVEI A,TUT
CALL WRTUT ;Write the TUT out.
JUMPL T,WRERR
PUNT
];NTS
SUBTTL Initialize Master File Directory (MFD)
MFDINN: SETZM MFD
MOVE A,[MFD,,MFD+1]
BLT A,MFD+1777
MOVE A,MFDCHK
MOVEM A,MFD+MDCHK
MOVE A,NUDS
MOVEM A,MFD+MDNUDS
MOVEI A,PG$SIZ
MOVEM A,MFD+MDNAMP
RET
SUBTTL Initialize Track Usage Table (TUT)
;;; TUTINI - Initialize the TUT
;;; I/ unit number
;;; A/ swapping alloc
TUTINI: SETZM TUT
MOVE B,[TUT,,TUT+1]
BLT B,TUT+<2000*MXTUTB>-1
MOVEM A,TUT+QSWAPA
MOVE K,A
CAMGE K,NUDS
MOVE K,NUDS ;K has base of file area.
MOVEI J,NBLKS ;Determine how many blocks this drive.
RP,[ MOVSI A,(DNOOPC)
DPB I,[DUNFLD A] ;Select drive.
DATAO DPC,A
DATAI DPC,A
TRNE A,2000
MOVEI J,MBLKS ;RP03 HAS MORE BLOCKS
];RP
T300,[
CAIL I,T300P
MOVEI J,NBLKS1
];T300P
MOVEM J,TUT+QLASTB ;LAST REGULAR BLOCK IS LAST TUT'ED
T300,[
MOVEI A,<2000*NTUTBL-LTIBLK>*TUTEPW
CAIL I,T300P
MOVEI A,<2000*NTUTB1-LTIBLK>*TUTEPW
SUB J,A
];T300P
.ELSE SUBI J,<2000*NTUTBL-LTIBLK>*TUTEPW ;Subtract max number of TUTable blocks.
CAMLE J,K ;Make sure there is room for all of file area.
LOSE "~&SALV'TUTINI:Not enough room for file area."
SKIPGE J
MOVEI J,0
MOVEM J,TUT+QFRSTB
MOVEI A,TUT
TUTFIL: MOVEI K,TUTLK ;ENTER HERE FROM SALV1, A -> TUT
MOVSI D,440000+TUTBYT_6
ADDI D,LTIBLK(A)
MOVE B,NUDS
SUB B,QFRSTB(A)
JUMPLE B,TUTI1A
TUTI1: IDPB K,D ;Mark out user dir area.
SOJG B,TUTI1
TUTI1A: MOVEI B,(A)
MOVSI D,-LSBTAB
TUTI2: SKIPGE J,SBTAB(D)
JRST TUTI3 ;Not really there.
CALL TUTPNT
MOVEI K,TUTLK
DPB K,J ;Mark out block.
TUTI3: AOBJN D,TUTI2
MOVE D,NTBL(I) ;Mark out TUT (size varies.)
TUTI4: MOVE J,MFDBK
SUB J,D
CALL TUTPNT
MOVEI K,TUTLK
DPB K,J
SOJG D,TUTI4
RET
;;; SPKID - SET PACK ID IN TUT
SPKID: JSR INIT
CAIA
SPKID0: CRR
TYPE T,"~&Set pack id on unit #"
CALL NTYI
JRST SPKID0
CAIL A,NUNITS
JRST SPKID0
CRR
MOVE I,A
CALL RESET
MOVEI A,TUT
CALL RDTUT
JUMPL T,ZAPLUZ
TYPE T,"Pack Number= ~D.",[TUT+QPKNUM]
TYPE T,"~&Change id from ~S to? ",[TUT+QPAKID]
CALL 6TYI
JUMPE B,ZAPLUZ
MOVEM B,TUT+QPAKID
MOVEI A,TUT
CALL WRTUT
JUMPL T,ZAPLUZ
PUNT
;;; SECOND - SET SECONDARY PACK NAME (KEPT IN TUT)
SECOND: JSR INIT
CAIA
SECND0: CRR
TYPE T,"~&Set secondary pack name of pack on unit #"
CALL NTYI
JRST SECND0
CAIL A,NUNITS
JRST SECND0
CRR
MOVE I,A
CALL RESET
MOVEI A,TUT
CALL RDTUT
JUMPL T,ZAPLUZ
TYPE T,"Pack Number= ~D. ID= ~S",[TUT+QPKNUM,TUT+QPAKID]
SKIPN T,TUT+QTRSRV
JRST SECND1
TYPE T,"~&Change secondary pack name from ~S: to? ",[TUT+QTRSRV]
JRST SECND2
SECND1: TYPE T,"~&Set secondary pack name to be? "
SECND2: CALL 6TYI
JUMPE B,ZAPLUZ
MOVEM B,TUT+QTRSRV
MOVEI A,TUT
CALL WRTUT
JUMPL T,ZAPLUZ
PUNT
KS,[
;;; FESET - Set pointer to front end filesystem for KS10'S 8080 console
;;; For an explanation of the procedure for creating and installing a new
;;; FE filesystem, see the comments in the KSFEDR program.
FESET: JSR INIT
FESET1: TYPE T,"~&Set FE filesystem directory pointer on the pack on unit #"
CALL NTYI
JRST FESET1
MOVE I,A
TYPE T,"~&Directory address: "
CALL OTYI
SETZM FDBUF
MOVE TT,[FDBUF,,FDBUF+1]
BLT TT,FDBUF+177
MOVSI TT,(SIXBIT /HOM/)
MOVEM TT,FDBUF+0
MOVEM A,FDBUF+103
MOVE TT,[FDBUF,,FDBUF+200]
BLT TT,FDBUF+1777
MOVEI J,0
MOVEI A,FDBUF
CALL WRITE
SKIPGE T
TYPE T,"Error writing first 'HOM' block."
MOVEI J,1
MOVEI A,FDBUF
CALL WRITE
SKIPGE T
TYPE T,"Error writing second 'HOM' block."
PUNT
];KS
;;; TUTPNT - Access the TUT
;;; J/ block number
;;; B/ ptr to TUT
;;;
;;; Clobbers K. Never skips.
;;; Returns byte pointer in J (0 if block not TUT'ed)
;;;
;;; TUTPNN - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO NEW TUT ADDR
;;; TUTPNO - SAME BUT CALL WITH DISK NUMBER IN I, CLOBBERS B TO OLD TUT ADDR
TUTPNN: SKIPA B,QNTUTO(I)
TUTPNO: MOVE B,QOTUTO(I)
TUTPNT: CAMGE J,QLASTB(B)
CAMGE J,QFRSTB(B)
TDZA J,J
CAIA
RET ;Block not TUT'ed, return J=0.
SKIPGE QPKNUM(B)
LOSE "~&Old format TUT?"
SUB J,QFRSTB(B)
IDIVI J,TUTEPW
HLL J,QTTBL(K)
ADDI J,LTIBLK(B)
RET
SUBTTL Read & Write TUT
;;; WRTUT and RDTUT.
;;; I/ unit
;;; A/ core buffer
;;; Never skips; returns T negative if failure.
NTS,[
WRTUT: MOVE J,MFDBK
SUB J,NTBL(I)
WRTUT0: CALL WRITE
JUMPL T,CPOPJ
ADDI A,2000
ADDI J,1
CAMGE J,MFDBK
JRST WRTUT0
RET
];NTS
NTS,[
RDTUT: MOVE J,MFDBK
SUB J,NTBL(I)
RDTUT0: CALL READ
JUMPL T,CPOPJ
ADDI A,2000
ADDI J,1
CAMGE J,MFDBK
JRST RDTUT0
RET
];NTS
TS,[
WRTUT: JRST SUCCESS
RDTUT: MOVE T,NTBL(I) ;Size of TUT on this drive.
MOVE J,[SQUOZE 0,QTUTO] ;Find absolute location in ITS.
.EVAL J,
.LOSE
PUSHER P,[A,I]
ADD J,I
MOVSS J
HRRI J,J
.GETLOC J,
HRRZS J
LSH J,-10.
MOVN I,T
HRL J,I
RDTUT1: .CALL [ SETZ
'CORBLK
MOVEI 210000 ;Read only
MOVEI -1 ;Into Self
MOVEI TUTPAG/2000
MOVEI 400000 ;From System
SETZI (J) ]
.LOSE %LSSYS
MOVSI I,TUTPAG
HRRI I,(A)
BLT I,1777(A) ;Copy in a block of TUT.
ADDI A,2000
AOBJN J,RDTUT1
POPPER P,[I,A]
SKIPGE QPKNUM(A)
.VALUE [ASCIZ ":TUT in old format?"]
SKIPN QLASTB(A)
.VALUE [ASCIZ ":TUT in older format?"]
JRST SUCCESS
];TS
SUBTTL Reassign Pack#s and Fix UFDs
NTS,[
REMAPP: REPEAT 40, -1 ;Index by pack #.
;LH:new pack #, RH: disk addr offset
REMAP: JSR INIT
TYPE T,"Remap the copy of the UFDs on unit # "
CALL NTYI
CAIL A,NUNITS
JRST [ TYPE T,"~&There aren't that many disk units here"
JRST REMAP ]
MOVE I,A
MOVEI A,MFD ;Get MFD
MOVE J,MFDBK
CALL READ
JUMPL T,ACTUE3
MOVE Q,MFD+MDNAMP
REMAP1: CAIL Q,2000 ;NEXT UFD
PUNT
SKIPN B,MFD+MNUNAM(Q)
JRST REMAP9
MOVEM B,USRNAM
MOVE J,Q
SUBI J,2000
IDIVI J,LMNBLK
ADD J,NUDS ;UFD BLOCK NUMBER
MOVEI A,OUSRD
CALL READ
JUMPL T,CPERR
CAME B,OUSRD+UDNAME
JRST CPERR
MOVE K,OUSRD+UDNAMP
REMAP2: CAIL K,2000 ;NEXT FILE
JRST REMAP6
MOVSI C,UNLINK
TDNE C,UNRNDM+OUSRD(K)
JRST REMAP5 ;DON'T MANGLE LINKS
LDB C,[UNDSCP UNRNDM+OUSRD(K)]
IDIVI C,UFDBPW
HLL C,QBTBLI(D)
ADDI C,UDDESC+OUSRD ;C HAS DESC POINTER
LDB D,[UNPKN UNRNDM+OUSRD(K)] ;D HAS PK #
SKIPGE A,REMAPP(D) ;Get mapping.
HALT . ; Loser forgot to patch it in.
HLRZ D,A ;Get new pack #
DPB D,[UNPKN UNRNDM+OUSRD(K)] ;CHANGE IT
HRRE D,A ;D HAS BLOCK # OFFSET
REMAP3: MOVE E,C
ILDB A,C ;GET DESC
JUMPE A,REMAP5 ;EOF
CAIG A,UDWPH
JRST REMAP3 ;DOESN'T DEPEND ON ABS DISK ADDRESSES
ANDI A,37 ;MASK OUT LOAD-ADDR-BIT
REPEAT NXLBYT,[
LSH A,UFDBYT
ILDB B,C
ADD A,B
]
ADD A,D ;RELOCATE THE ADDRESS
REPEAT 6,NOP ;PATCH AREA
MOVE C,E ;GET BACK B.P. TO START OF LOAD-ADDR DESCRIPTOR
MOVE E,[<UFDBYT*NXLBYT+UFDBYT>_36+UFDBYT_30+A]
REPEAT NXLBYT+1,[
ILDB B,E
IFE .RPCNT, ADDI B,40
IDPB B,C
]
JRST REMAP3
REMAP5: ADDI K,LUNBLK
JRST REMAP2
REMAP6: MOVEI A,OUSRD
CALL WRITE
JUMPL T,WRERR
REMAP9: ADDI Q,LMNBLK
JRST REMAP1
];NTS
SUBTTL Zero Dir Blocks, Write Empty TUT & MFD
NTS,[
ZAP: JSR INIT
TYPE T,"~&Init dirs on unit # "
CALL NTYI
JRST ZAP
CAIL A,NUNITS ;Does unit possibly exist?
JRST [ TYPE T,"~&There aren't that many disk units here"
JRST ZAP ]
MOVEM A,TOU ;Remember To unit.
MOVE I,A
SH, CALL RESET ;If hardware pack #, just reset
.ELSE,[ TYPE T,"~&Pack No?" ;If no pack # in hardware,
CALL DTYI ;Get it from human.
MOVEM A,PKNUM(I) ;Remember pack number.
CALL RESET ;Then reset (should leave PKNUM alone)
];NOT SH
MOVE A,[WXWDS-1,,WXWDS] ;Use "extra words" buffer.
BLT A,WXWDS+3 ;Zap it.
SETZM MFD ;MFD needs zapping too.
MOVE A,[MFD,,MFD+1]
BLT A,MFD+1777
MOVN J,NUDS ;Get AOBJN ptr to UFD blocks.
HRLZ J,J
KL, ADD J,[2,,2] ;Protect KLDCP.
KS, ADD J,[2,,2] ;Protect 8080 'HOM' sectors.
MOVEI A,MFD ;Empty MFD.
ZAPL: CALL WRITE ;Write it out.
JUMPL T,[ TYPE T,"~&Lost."
PUNT ]
AOBJN J,ZAPL ;Zap all UFDs too.
DC,[ CONO DC0,DCCSET+DCDENB
DATAO DC0,[DJMP DZAP]
CONSZ DC0,DSSACT
JUMPA .-1
CONSO DC0,DSSERR
];DC
JRST MARK69 ;Finish formatting pack.
DC,[
DZAP: DWRITE ;Zero the Read-In block.
DCSKIP (-LRIBLK_2&37774)
DHLT
];DC
];NTS
SUBTTL Reconstruct MFD From UFDS
NTS,[
;;; MFDR - Reconstruct MFD by getting names from UFD'S
IMNFLG: 0 ;MFD inited flag.
MFDR: ACINIT
TYPE T,"~&Reconstruct MFD from unit #"
CALL NTYI ;Get unit number.
JRST MFDR
CRR
MOVE I,A
CALL MFDINN ;Make a blank MFD.
SETOM IMNFLG
MOVEI J,0
MFDR1: MOVEI A,TUT
CALL READ
JUMPL T,MFDRL
MOVE B,TUT+UDESCP ;Look like legit UFD?
TLNE B,-1
JRST MRUFDL ;Should be fs pntr
CAIL B,<2000.-11.>*6
JRST MRUFDL
MOVE B,TUT+UDNAMP
SKIPE TUT+UDNAME ;User name?
TLNE B,-1
JRST MRUFDL ;Pntr to beg of name area.
MOVEI B,(J) ;Convert block no to MFD index.
SUB B,NUDS
LSH B,1
ADDI B,2000
MOVE C,TUT+UDNAME ;User name.
MOVEM C,MFD(B)
AOSN IMNFLG
MOVEM B,MFD+MDNAMP
JRST MRUFDW
MFDRL: HALT .+1
MRUFDL: NOP
MRUFDW: ADDI J,1
CAMGE J,NUDS
JRST MFDR1
ASKYN "~&Write"
PUNT
MFDWR: MOVEI A,MFD
MOVE J,MFDBK
CALL WRITE
PUNT
];NTS
SUBTTL Read & Type Out Headers (DC-10 only)
NTS,[
DC,[ ;FOR NOW, DC10 ONLY
RDHDHD==20 ;2WORDS PER SEC, MANY SECS
RDHEAD: JSR INIT ;READ ALL HEADERS ON A TRACK
TYPE T,"~&Unit ="
CALL NTYI
CAIL A,NUNITS
JRST [ TYPE T,"There aren't that many disk units here"
JRST RDHEAD ]
MOVEM A,TOU
MOVE I,A
CALL RESET
RDHD1: TYPE T,"~&Cyl="
CALL NTYI
CAIL A,NCYLS+XCYLS
JRST [ TYPE T,"~&Guess again"
JRST RDHD1 ]
SKIPGE QTRAN(I)
ADDI A,NCYLS+XCYLS
DPB A,[DCYL READHD]
TYPE T,"Surf="
CALL NTYI
SETZ A,
CAIL A,NHEDS
JRST [ TYPE T,"~&Guess again"
JRST RDHD1 ]
DPB A,[DSURF READHD]
DATAO DC0,[DJMP READHD]
CONSZ DC0,DSSACT
JRST .-1
CONSZ DC0,DSSERR
JRST [ TYPE T,"ERROR---"
CALRET GETSTS]
SETOM SECT0'
SETOM FIRST'
SETZ T,
RDHD2: MOVE D,HEADBF(T)
TLZ D,777000
CAMN D,SECT0
JRST RDHD1 ;GONE AROUND ONCE
AOSN FIRST
MOVEM D,SECT0
LDB A,[DPKID HEADBF(T)]
TYPE T,"PKID=~O,",[A]
MOVE D,HEADBF(T)
CALL TYPLOC
CRR
MOVE A,HEADBF+1(T)
TLNE A,1000 ;INDIRECT BIT OF HEADER
JRST [ TYPE T,"@"
MOVE D,HEADBF+1(T)
CALL TYPLOC
JRST RDHD6]
MOVN A,HEADBF+1(T)
LDB A,[1600,,A] ;LENGTH FIELD
TYPE T,"LENGTH=~O",[A]
LDB A,[270200,,HEADBF+1(T)]
JUMPE A,RDHD3 ;ANY NEXT-ADDRESS CODE?
HRRO B,NXTADR(A) ;Yes, get string.
TYPE T,"~A",[B] ;Print it.
RDHD3: MOVE A,HEADBF+1(T)
TLNE A,200
JRST [ TYPE T,",WRITE PROTECT,"
JRST .+1]
RDHD6: SETO C, ;PARITY
HRLI T,-2
RDHD4: MOVEI D,14.
MOVE A,HEADBF(T)
XORM A,C
LSH A,-2
SOJG D,.-2
AOBJN T,RDHD4
TRNN C,3 ;BOTH ODD?
JRST RDHD5
TYPE T,",BAD PARITY!!"
RDHD5: CRR
CAIL T,RDHDHD*NSECS
JRST RDHD1
JRST RDHD2
READHD: DSPC+DSWIDX+DSWNUL+DSCRHD ;WAIT FOR INDEX, THENREAD HEADERS
QCOPY HEADBF,RDHDHD*NSECS
DHLT
HEADBF: BLOCK RDHDHD*NSECS
NXTADR: 0
[ASCIZ /,END-OF-TRACK/]
[ASCIZ /,END-OF-CYLINDER/]
[ASCIZ /,END-OF-DISC/]
TYPLOC: PUSHER P,[A,B,C]
LDB A,[DCYL D]
LDB B,[DSURF D]
LDB C,[DSECT D]
TYPE T,"Cyl=~O, Surf=~O, Sect=~O",[A,B,C]
POPPER P,[C,B,A]
];DC
];NTS
SUBTTL Copy Block To Block
NTS,[
COPY: JSR INIT
TYPE T,"~&Copy block from unit #"
CALL NTYI
JRST COPY
CAIL A,NUNITS
JRST COPY
MOVEM A,FROM
MOVE I,A
CALL RESET
CP1: CRR
TYPE T,"~&Block #"
CALL OTYI
CAIL A,TBLKS
JRST CP1
MOVEM A,FMBLK
CP2: CRR
TYPE T,"~&onto unit #"
CALL NTYI
JRST CP2
CAIL A,NUNITS
JRST CP2
MOVEM A,TOU
MOVE I,A
CALL RESET
CP3: TYPE T,"Block #"
CALL OTYI
CAIL A,TBLKS
JRST CP3
MOVEM A,TOBLK
MOVEI A,TUT
MOVE J,FMBLK
MOVE I,FROM
CALL READ
JUMPL T,CPERR
COPYB: MOVEI A,TUT ;HANDY PLACE FOR A BREAKPOINT
MOVE J,TOBLK
CALL WRITT
PUNT
];NTS
SUBTTL Copy Directories from Drive to Drive
NTS,[
UCOP: JSR INIT
TYPE T,"~&Copy directories"
CALL DUP1
MOVEI A,D0
MOVE J,MFDBK
CALL READFN
CALL WRITT
MOVEI Q,2000
UCOPL: SUBI Q,LMNBLK
CAMGE Q,D0+MDNAMP
JRST DDT
SKIPN B,D0(Q)
JRST UCOPL
HRREI J,-2000(Q) ;Convert MFD index to block #.
ASH J,-1
ADD J,NUDS
MOVEI A,OUSRD
CALL READFN
CAME B,OUSRD+UDNAME
HALT .
CALL WRITT
JUMPL T,WRERR
JRST UCOPL
READFN: SKIPA I,FROM
READT: MOVE I,TOU
CALL READ
READC: JUMPL T,[HALT .]
RET
];NTS
SUBTTL Copy Entire Pack
NTS,[
DUP: JSR INIT
SETZM USRDS'
SETZM USWRTS'
SETZM DUPRER
SETZM DUPWER
RH, SETZM CERRS
TYPE T,"Duplicate disk"
CALL DUP1
MOVE I,FROM
DC, MOVE A,QTRAN(I)
DC, DPB A,[DUNFLD CYLRIR]
SH,[ MOVE A,PKNUM(I)
MOVE I,TOU
CAME A,PKNUM(I)
JRST DUPLUZ
];SH
.ELSE, MOVE I,TOU
DC, MOVE A,QTRAN(I)
DC, DPB A,[DUNFLD CYLRIW]
MOVEI J,NCYLS+XCYLS-1 ;Determine how many cylinders this drive.
RP,[ MOVSI A,(DNOOPC)
DPB I,[DUNFLD A] ;Select destination drive.
DATAO DPC,A
DATAI DPC,B
MOVE I,FROM
DPB I,[DUNFLD A] ;Select source drive.
DATAO DPC,A
DATAI DPC,A
XOR A,B
TRNE A,2000
LOSE "~&Can't copy RP02 to RP03 or vice versa."
TRNE B,2000
MOVEI J,MCYLS+XCYLS-1 ;Drives are RP03s, more cylinders to copy.
];RP
T300,[
CAIL I,T300P
JRST T3DUP ;Have to do it the slow way.
MOVE I,FROM
CAIL I,T300P
LOSE "~&Can only go T-300 to T-300."
];T300P
MOVEI A,CYLBUF
DLUP: MOVE I,FROM
CALL READCY
JUMPL T,DLUP1 ;Lost, try block at a time.
MOVE I,TOU
CALL WRITCY
JUMPL T,DLUP1
DLUP2: SOJGE J,DLUP
DC, MOVEI T,CYLRIR ;Copy read-in block.
DC, CALL RW0
RH,[ SKIPN A,CERRS
PUNT
TYPE T,"~&~D. ECC corrected errors.",[A]
PUNT
]
.ELSE PUNT
DUPLUZ: LOSE "~&Pack # differs.~%"
PUNT
DUP1A: CRR
DUP1: TYPE T,"~&From unit #"
CALL NTYI
JRST DUP1A
CAIL A,NUNITS
JRST DUP1A
MOVE I,A
CALL RESET
;;; DUP2 - read TOU
;;; A/ FROM unit
;;; Resets the FROM disk.
;;; Sets up TOU, smashing A. Never skips.
DUP2: MOVEM A,FROM
TO: CRR
TYPE T,"~&onto unit #"
CALL NTYI
JRST TO
CAIL A,NUNITS
JRST TO
MOVEM A,TOU
ASKYN "~&Copy from unit #~D onto unit #~D, OK",[FROM,TOU]
PUNT
MOVE I,TOU
CALL RESET
RET
T300,[
T3DUP: MOVE I,FROM
CAIGE I,T300P
LOSE "~&Can only go T-300 to T-300."
TYPE T,"~&This will take a while..."
MOVEI J,NBLKS1+XBLKS1-1
T3DUP1: MOVEI A,CYLBUF
MOVE I,FROM
CALL READ
JUMPL T,CPERR
MOVE I,TOU
CALL WRITE
JUMPL T,WRERR
SOJGE J,T3DUP1
PUNT
];T300P
IFE RH10P,[ ;Block at a time.
DLUP1: PUSH P,J
IMULI J,NBLKSC
SETZM DLUPT
DLUP3: MOVE I,FROM
MOVEI A,CYLBUF
CALL READ
JUMPL T,DLUPE1
MOVE I,[RXWDS,,WXWDS]
DLUPEW: BLT I,WXWDS+4-1
CALL WRITT
JUMPL T,DLUPE2
DLUPEX: AOS TT,DLUPT
CAIGE TT,NBLKSC
AOJA J,DLUP3
POP P,J
JRST DLUP2
]
RH,[ ;SECTOR AT A TIME ON RP04 SO GET EXTRA SECTORS
DLUP1: MOVEI T,NHEDS*NSECS
MOVEM T,DLUPT
DLUP3: SOS W,DLUPT ;NEXT SECTOR (GOING BACKWARDS THROUGH CYLINDER)
IDIVI W,NSECS ;TRACK IN W, SECTOR IN U
LSH W,8
IOR W,K
HRL W,J ;NOW W HAS DISK ADDRESS
MOVEM W,RHPGA
MOVE K,[-200,,CYLBUF-1]
MOVEM K,RHIOW
MOVE I,FROM
MOVEI TT,%HMRED
MOVEM TT,RHCMD
CALL RW1
JUMPL T,DLUPE1
DLUPEW: MOVE I,TOU
MOVEI TT,%HMWRT
MOVEM TT,RHCMD
CALL RW1
JUMPL T,DLUPE2
DLUPEX: SKIPE DLUPT
JRST DLUP3
JRST DLUP2
];RH
DLUPT: 0
DLUPE1: AOS DUPRER
SKIPE HCRASH
JRST DLUPE4 ;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
TYPE T,"~&Read error on block #"
CALL DLUPE3
DLUPE4: SETZM CYLBUF ;COULDN'T READ THE BLOCK, SUBSTITUTE ALL ZEROS
MOVE A,[CYLBUF,,CYLBUF+1]
BLT A,CYLBUF+2000-1
MOVE I,[DLUPE5,,WXWDS] ;WITH SPECIAL EXTRA WORDS
JRST DLUPEW ;RESUME DLUP AT WRITE
DLUPE3: TYPE T,"~D-",[I]
IFE RH10P, MOVE A,J
IFN RH10P,[
HLRZ A,RHPGA ;CYLINDER
IMULI A,NBLKSC
LDB W,[101000,,RHPGA] ;HEAD
IMULI W,NSECS
LDB K,[001000,,RHPGA] ;SECTOR
ADD W,U
IDIVI W,SECBLK
ADD A,W ;INACCURATE IF UNUSED SECTOR AT END OF CYLINDER
];RH10P
TYPE T,"~D~%",[A]
CALRET GSTS ;HARDWARE STATUS
DLUPE2: AOS DUPWER
SKIPE HCRASH
JRST DLUPEX ;SPEED IS OF THE ESSENCE, DON'T TYPE ANYTHING
TYPE T,"~&Write error on block #"
CALL DLUPE3
JRST DLUPEX
;SUITABLE EXTRA WORDS FOR BLOCKS THAT COULDN'T BE READ
DLUPE5: 0 ;WORD COUNT=2000, LAST BLOCK=0
SIXBIT /??????/ ;DUMMY DIRECTORY
SIXBIT /(DISK)/
SIXBIT/LOSSAG/
];NTS
TS,DUP: RET
SUBTTL Test and Unlock Some Blocks
NTS,[
UNLOCK: JSR INIT
TYPE T,"~&Unlock blocks on unit #"
CALL NTYI
JRST UNLOCK
CAIL A,NUNITS
JRST UNLOCK
MOVEM A,FROM
MOVE I,A
CALL RESET
UNLK1: TYPE T,"~&Block #"
CALL DTYI
CALL UNLOCB
NOP
JRST UNLK1 ;Use ^Z to get out.
;;; UNBLOB - Unlock a block
;;; A/ block number
;;; FROM/ disk unit
UNLOCB: PUSHER P,[J,K,Q,D,B]
MOVE J,A
MOVEM J,FMBLK
SETZM CYLBUF ;ZERO OUT IN CASE CAN'T READ
MOVE A,[CYLBUF,,CYLBUF+1]
BLT A,CYLBUF+4000-1
MOVE I,FROM
MOVEI A,CYLBUF
CALL READ
JUMPGE T,UNLK2
TYPE T,"~&Read Error~%"
CALL GSTS
ASKYN "~&Proceed"
JRST UNLOCX
UNLK2: MOVE A,[RXWDS,,WXWDS]
BLT A,WXWDS+4-1
MOVEI A,CYLBUF
CALL WRITE
JUMPL T,WRERR
MOVEI A,CYLBUF+2000
CALL READ
JUMPL T,[ TYPE T,"~&Read-back error"
CALL GSTS
JRST UNLOCX]
MOVSI T,-2000
UNLK3: MOVE TT,CYLBUF(T)
CAME TT,CYLBUF+2000(T)
JRST [ TYPE T,"~&Read-back compare error"
JRST UNLOCX]
AOBJN T,UNLK3
MOVEI A,TUT
CALL RDTUT
JUMPL T,CPERR
MOVE J,FMBLK
MOVEI B,TUT
CALL TUTPNT
JUMPE J,[ TYPE T,"~&Can't access TUT"
JRST UNLOCX ]
MOVEI B,1 ;Safest - next salvage will correct it.
DPB B,J
MOVEI A,TUT
X WRTUT
JUMPL T,WRERR
AOS -5(P) ;Winning skip return
UNLOCX: POPPER P,[B,D,Q,K,J]
RET
];NTS
SUBTTL Simple Disk Tests
NTS,[
;;; DSKTST - Writes a single block, reads it back, and checks
;;; that it's the same.
DSKTST: JSR INIT
SETOM HCRASH ;DON'T DO ERROR RETRY
TYPE T,"~&Test unit #"
CALL NTYI
JRST DSKTST
CAIL A,NUNITS
JRST DSKTST
MOVE I,A
ASKYN "~&Got a scratch pack on unit #~D.?",[I]
LOSE "~&Silly loser!"
DSKTS0: CALL RESET
MOVEI J,NBLKSC*15. ;Randomly use cylinder 15.
MOVSI A,-PG$SIZ
MOVEI B,1 ;First part of pattern is floating 1s.
DSKT0A: MOVEM B,D0(A)
LSH B,1
SKIPE B
AOBJN A,DSKT0A
HRROI B,-2 ;Next is floating 0s.
DSKT0B: MOVEM B,D0(A)
JUMPGE B,DSKT0C
LSH B,1
AOS B
AOBJN A,DSKT0B
DSKT0C: MOVEM A,D0(A) ;The rest is an address pattern.
AOBJN A,DSKT0C
MOVEI A,D0
CALL WRITE
JUMPL T,WRERR
DSKTS1: MOVEI A,D1
CALL READ
CALL TYIPSE
MOVSI B,-PG$SIZ
DSKT1A: MOVE A,D1(B)
CAMN A,D0(B)
DSKTS2: AOBJN B,DSKT1A
JUMP [ ;; Change to JUMPA for no typeout.
LIGHTUP [0]
JUMPGE B,DSKTS1
MOVE A,B
XOR A,CYLBUF(B)
LIGHTUP A
JRST DSKTS2 ]
JUMPGE B,[ JUMPGE T,DSKTS1
CALL GSTS
JRST DSKTS1 ]
HRRZ A,B
TYPE T,"~6<~;0~D~>/ ",[A]
MOVE A,D0(B)
MOVE A,D1(B)
TYPE T,"~H ",[A]
MOVE A,D0(B)
XOR A,D1(B)
TYPE T,"~H~%",[A]
JRST DSKTS2
;;; SEKTST - Loops over all heads, and optionally loops over different
;;; length seeks. It doesn't write, but is a test of seeking and searching.
;;; SETOM HCRASH if you want to do no error retries on read/search errors
;;; (but seek incompletes will always be retried.)
SEKTST: JSR INIT
TYPE T,"~&Seek test unit #"
CALL NTYI
JRST SEKTST
CAIL A,NUNITS
JRST SEKTST
MOVE I,A
CALL RESET
SETZM SEKINC
MOVEI A,10.*NBLKSC
ASKYN "~&Always do full length seeks"
CAIA
MOVEM A,SEKINC' ;If no, do decreasing length seeks.
SEKTS0:
RP,[ MOVSI A,(DNOOPC) ;Determine how many cylinders this drive
DPB I,[DUNFLD A]
DATAO DPC,A
DATAI DPC,B
MOVEI A,<NCYLS-1>*NBLKSC ;RP02.
TRNE B,2000
MOVEI A,<MCYLS-1>*NBLKSC ] ;RP03.
.ELSE MOVEI A,<NCYLS-1>*NBLKSC ;RP04/6.
T300,[ CAIL I,T300P
MOVEI A,<NCYLS1-1>*NBLKC1 ] ;T-300.
MOVEM A,SEKCY2'
SETZM SEKCY1'
SEKTS1: SETZM SEKHDN' ;Reset head.
SEKTS2: MOVE J,SEKCY1 ;Block address of outer cylinder.
ADD J,SEKHDN ;Select a block on the desired head.
MOVEI A,CYLBUF
CALL READ ;Read it
SKIPGE T
SEKTS3: CALL GSTS
MOVE J,SEKCY2 ;Block address of inner cylinder.
ADD J,SEKHDN ;Select same head.
MOVEI A,CYLBUF
CALL READ ;Read it.
SKIPGE T
XCT SEKTS3
CALL TYIPSE
MOVEI J,NSECS/SECBLK ;Advance to next head.
ADDB J,SEKHDN
CAIGE J,NBLKSC ;Touched all heads?
JRST SEKTS2 ; No.
MOVN B,SEKINC ;Yes, change cylinders.
ADDB B,SEKCY2
MOVE C,SEKINC
ADDB C,SEKCY1
CAMG C,B
JRST SEKTS1
JRST SEKTS0 ;Recycle.
];NTS
TS,DSKTST: NOP ? RET
TS,SEKTST: NOP ? RET
SUBTTL Mag Tape routines
NTS,[
;;; Tape variables
TMDCP: 0 ;-1 iff TM10B unit.
ITAPE: 0 ; -1 => tape is rewound
MAGBFP: 0 ;Bp to tape buffer.
MTRYS: 0 ;Tape operation retry count.
MAGHD: 0
EOFCNT: 0 ;Count of EOFs. (Nothing seems to look at this.)
EOFLG: 0 ;EOF seen. (Used by MREAD internally.)
EOTFLG: 0 ;EOT seen. (Not used anywhere???)
EOUF: 0 ; This is the EOF flag for callers of MREAD.
SHORTL: 0 ; The TM10 version of MREAD uses this internally. The
; TM03 version maintains it, but never looks at it, so
; it might even be doing it wrong...
LNKFLG: 0 ;-1 iff reloading a link
LNKNM1: 0 ;Link FN1
LNKNM2: 0 ;Link FN2
LNKSNM: 0 ;Link SNAME
;;; Tapeset info block.
THBLK: -LTHBLK,,0
THTPN: 0 ;Tape #,,reel # in this DUMP
THDATE: 0 ;Tape creation date
THTYPE: 0 ;Tape type: 0=>Random >0 => Full <0 => Incr
LTHBLK==.-THBLK
;;; File header block.
MHBLK: -LMHBLK,,0
MHSNM: 0 ;SNAME
MHFN1: 0 ;FN1
MHFN2: 0 ;FN2
LMHBKZ==.-MHBLK ; Header must be at least this long
MHPKN: 0 ;Link Flag,,Pack #
MHDATE: 0 ;Creation Date
; Next two added 7/15/89 by Alan
MHRDAT: 0 ;Reference Date, Author Index, Byte Size, Byte Count
MHLEN: 0 ;Length in words
LMHBLK==.-MHBLK ; Header must be no longer than this
TM10,[
;;; TM10A (IO Bus) & TM10B (Data Channel) Macro Tape Subsystems.
MTC==340 ;Mag tape channel for functions
MTS==344 ;Mag tape channel for stopping and status
;;; Shifts for fields in CONO MTC,
UNITNO==15.
PARITY==14.
CDUMP==13.
FUNC==9.
DENSTY==6.
800BPI==2
MAGCOM=5_<UNITNO>+1_<PARITY>+800BPI_<DENSTY>+1_<CDUMP>
;;; Functions
NOOP1=0_<FUNC>+MAGCOM ;Clear interrupt flags
NOOP2=10_<FUNC>+MAGCOM ;Interrupt when transport idle
REWIND=1_<FUNC>+MAGCOM ;Rewind
REED=2_<FUNC>+MAGCOM ;Read
SPACR=7_<FUNC>+MAGCOM ;Space reverse
;;; Flags
;;; Note: TM10B has DATA PIA (CONI MTC, 1.1-1.3) stuck at 7
JOBDON==100
DATREQ==1
EOFF==10000
EOTF==4000
;;; REW - Rewind the tape
REW: SETZM EOFCNT ;No EOFs seen.
SETZM MAGBFP
SETZM SHORTL
CONO MTC,NOOP1 ;Clear interrrupt flags
CONO MTC,REWIND ;Initiate rewind
CONSO MTS,JOBDON ;Wait for rewind to begin
JRST .-1
CONO MTC,NOOP2 ;Set job done when transport idle
CONSO MTS,JOBDON ;Wait for job done
JRST .-1
SETOM ITAPE ;Say tape rewound.
RET ;Rewind done.
;;; READ - Read from the tape.
MREAD: MOVEI T,0
PUSHER P,[B] ;Do not smash ACs.
MREAD7: SKIPGE B,MAGBFP
JRST [ HLRE C,B
CAMG B,A
HLRE C,A
HRLZS B
HRR B,A
MOVNS C
HRLS C
ADDI C,-1(A)
BLT B,(C)
HLRS C
ADD A,C
ADDM C,MAGBFP
ADDI T,(C)
JUMPGE A,MREADZ
JRST MREAD7 ]
SKIPN EOFLG ;EOF seen?
JRST MREAD1 ; No, go read.
SETZM EOFLG ;Complete.
SETOM EOUF
MREADZ: POPPER P,[B]
RET
MREAD1: MOVEI B,10. ;Retry ten times.
MOVEM B,MTRYS ;Remember count.
MERR2: MOVE B,[-2000,,MAGBUF] ;Set up Bp.
MOVEM B,MAGBFP ;Remember it.
SETZM SLVIOWD
CONO MTC,NOOP1 ;Clear flags.
SKIPE TMDCP
JRST [ KA, MOVE B,[-2000,,MAGBUF-1]
KL, MOVE B,[-2000_4,,MAGBUF-1]
MOVEM B,SLVIOWD ;Store channel program.
SETZM SLVICWA+1
SETZM SLVIOWD+1
DATAO MTS,[SLVICWA]
KL,[ SWPUA ;Unload the cache.
CONSZ 200000
JRST .-1 ]
JRST .+1 ]
CONO MTC,REED ;Issue read command.
MREAD2: CONSO MTS,DATREQ+EOFF+JOBDON+EOTF
JRST .-1 ;Wait for next request.
DELAY US,20. ;Wait a little longer.
CONI MTS,C ;Read tape state.
TRNE C,EOTF ;End of tape encountered?
JRST MREOT ; Yes, handle it.
TRNN C,JOBDON ;Job done?
JRST [ TRNE C,DATREQ ; No.
SKIPE TMDCP ; Data request (yes if TM10B)?
JRST MREAD2 ; No, keep waiting.
DATAI MTC,(B) ; Read request.
SKIPE SHORTL
HALT .
AOBJN B,MREAD2 ; Keep trying.
JRST MREAD4 ]
TRNN C,EOFF ;End of file?
JRST MREAD6 ; No.
AOS EOFCNT ;Count end of file.
SETOM EOFLG ;Say we saw it.
SETZM SHORTL
CAIA
MREAD6: SETOM SHORTL
SKIPN TMDCP ;Data channel tape?
JRST [ HLLZS B ; No. Get buffer ptr
MOVNS B ; # wds xfered.
ADDM B,MAGBFP ; Update ptr.
JRST MREAD4 ]
HRRZ B,SLVICWA+1 ;Else must wait for Channel response.
JUMPE B,.-1
MOVNI B,1-MAGBUF(B) ;Get updated buffer ptr from channel.
SKIPE EOFLG ;If EOF seen
MOVSI B,0 ; No words were read.
HRLM B,MAGBFP ;Else store back buffer ptr.
JRST MREAD4 ;Go see if done now.
MREAD4: CONO MTS,1 ;Stope the tape.
CONSO MTS,JOBDON ;Done?
JRST .-1 ; Keep waiting.
CONSZ MTS,440000 ;Xfer hung or illegal operation?
HALT MERR ; Yes, halt.
MREAD8: CONSO MTS,20600 ;Error bits on?
JRST MREAD7 ; No, keep trucking.
MERR: SOSG MTRYS ;Exhausted yet?
JRST [ AOS FERRS ; Count an error
JRST MREAD7 ] ; But ignore it.
SETZM SLVIOWD ;Else clear tape program.
KL,[ SWPUO 0 ;Unload page zero from cache.
CONSZ 200000
JRST .-1
];KL
CONO MTC,NOOP1 ;Clear interrupt flags.
CONO MTC,SPACR ;Backup the tape.
SKIPN TMDCP ;If IO Bus tape device
JRST [ CONSO MTS,DATREQ ;Wait for tape.
JRST .-1
DATAO MTC,
JRST .+1 ]
CONO MTS,1 ;Stop the tape.
CONSO MTS,JOBDON ;Wait for it.
JRST .-1
JRST MERR2 ;Continue on our way.
MREOT: CONO MTS,1 ;Stop tape if still moving.
CONO MTC,NOOP1 ;Clear interrupt flags.
TYPE LPT,"~&EOT" ;Announce end of tape.
PUNT ;Dump back into DDT
];TM10
TM03,[
;;; KS10/RH11/TM03 tape support
.INSRT SYSTEM;TM03S >
;Default tape device
IFNDEF TMBTC,TMBTC==0 ;TM03 number on RH
IFNDEF TMBTS,TMBTS==0 ;Slave number on TM03
;TMCCLR - Reset controller and formatter
;TMFCLR - Reset formatter only
;
TMCCLR: MOVEI B,%TM2CC ;Controller reset bit
IOWRI B,%TMCS2 ;Clear controller logic
MOVEI B,TMBTC ;Get appropriate TM03 to boot from
IOWRI B,%TMCS2 ;Reselect TM03
TMFCLR: MOVEI B,TMBTS ;Get slave used for booting
IOWRI B,%TMTC ;Make sure this slave is selected
MOVEI C,10. ;Try 10 times to clear drive
TMFC.1: MOVEI B,%TMCLR ;Clear formatter
IOWRI B,%TMCS1 ;Do it
IORDI B,%TMFS ;Get status
TRNN B,%TMSES ;Still have error
JRST TMFC.2 ;No, OK
SOJG C,TMFC.1 ;Retry up to 10 times
LOSE "~&Tape controller won't clear"
TMFC.2: RET
;;; REW - Reset the controller and drive, rewind the tape
REW: SETZM EOFCNT ;No EOFs seen.
SETZM MAGBFP
SETZM SHORTL
CALL TMCCLR ;Reset tape
IORDI B,%TMFS
TRNE B,%TMSOL ;On line?
JRST REW.0
TYPE T,"~&Tape Offline"
PUNT
REW.0: MOVEI B,%TMREW
IOWRI B,%TMCS1 ;Start rewind operation
REW.1: IORDI B,%TMCS1
TRNE B,%TM1GO ;Still executing command?
JRST REW.1 ;Yah.
REW.2: IORDI B,%TMFS ;Get formatter status
TRNE B,%TMSPP ;Still rewinding?
JRST REW.2 ;Wait.
TRNE B,%TMSES ;Error?
LOSE "~&Tape error on rewind."
TRNN B,%TMSBT ;Not BOT?
LOSE "~&Tape not at BOT after rewind?"
SETOM ITAPE ;Say tape rewound.
RET ;Rewind done.
;;; READ - Read from the tape.
;
;Call with A/ -count,,address
;Return A/ Updated pointer, T/ total read
IUTPG==1 ;First unibus page (UBA I) to map tape buffers
IF2,IFN MAGBUF&1777,.FATAL MAGBUF must be on a page boundary.
MREAD: MOVEI T,0
PUSHER P,[B,C,D,E] ;Do not smash ACs.
MREADL: SKIPGE B,MAGBFP ;Have any data buffered already?
JRST [ HLRE C,B ;Yes. Get -count of words to move.
CAMG B,A ;Use # of words left in MAGBUF, unless caller..
HLRE C,A ; asked for less, use caller's request size.
HRLZS B ;Build BLT ptr. Source is current pos in MAGBUF
HRR B,A ;Get destination address from argument
MOVNS C ;Get positive count
HRLS C ;Save count safely in LH of C
ADDI C,-1(A) ;RH of C gets last address to move
BLT B,(C) ;Do it
HLRS C ;Get count back - C == count,,count
ADD A,C ;Adjust argument pointer
ADDM C,MAGBFP ;Adjust MAGBUF pointer
ADDI T,(C) ;Count total words moved
JUMPGE A,MREADZ ;Got enough data? Exit if so.
JRST MREADL ] ;Need more, go back and read it.
SKIPN EOFLG ;No buffered data. EOF seen?
JRST MREAD1 ; No, go read.
SETZM EOFLG ;Complete.
SETOM EOUF
MREADZ: POPPER P,[E,D,C,B]
RET
;Here to read a tape record into MAGBUF
;
MREAD1: MOVEI B,10. ;Retry ten times.
MOVEM B,MTRYS ;Remember count.
MERR2: MOVE B,[0,,MAGBUF] ;Set up BP - no data yet
MOVEM B,MAGBFP ;Remember it.
IORDI B,%TMFS ;Get current formatter status
TRNN B,%TMSES\%TMSSC ;Showing error or slave status change?
JRST MREAD2
MOVEI B,%TM1TE
IOWRI B,%TMCS1 ;Clear RH11 errors and...
CALL TMFCLR ; reset formatter at slightest provocation
MREAD2: MOVEI B,<%TMD16_8.>+<%TMFCD_4.>+TMBTS
IOWRI B,%TMTC ;Tell TM03
MOVEI B,%TMNOP ;You may need this to set status values
IOWRI B,%TMCS1 ; but I'm not really sure
IORDI B,%TMCS1
TRNE B,%TM1GO ;Wait till done
JRST .-2
IORDI B,%TMFS ;Get status
TRNE B,%TMSOL ;On line?
TRNN B,%TMSFR ;Formatter ready?
LOSE "~&Tape offline or controller not ready"
MOVEI B,-2000*2 ;2000 words * 2 gives unibus word count
IOWRI B,%TMWC ;Set UB WC. Only 16 bits, MOVEI above OK
SETZ B, ;Set FC to zero
IOWRI B,%TMFC ;Maybe the controller does this for you?
MOVEI B,MAGBUF/PG$SIZ ;Get ITS page to transfer to
LSH B,1 ;Convert ITS pg # to DEC pg #
TRO B,%UQVAL
IOWRI B,UBAPAG+IUTPG_1 ;Set up first half of UBA mapping
TRO B,1 ;Next DEC page number
IOWRI B,UBAPAG+IUTPG_1+1;Set second half of UBA mapping
MOVEI B,IUTPG_14 ;Unibus address for DMA
IOWRI B,%TMBA ;Tell controller
CLRCSH ;All that work for one lousy page.
MOVEI B,%TMRDF ;Read forward
IOWRI B,%TMCS1 ;Start controller
IORDI B,%TMCS1 ;Get RH status
TRNE B,%TM1GO ;Wait till command is finished
JRST .-2
TRNE B,%TM1MP ;Massbus control channel parity error?
LOSE "~&Fatal MASSBUS control error on tape read"
IORDI C,%TMFS ;Get formatter status
TRZE C,%TMSET ;EOT?
JRST MREOT
TRNN B,%TM1TE ;Masbus transfer error?
TRNE C,%TMSES ; or formatter error of some kind?
JRST MRERR ;Yep, go handle error
;+++ Need UBA herror check.
MREAD3: TRNE C,%TMSTM ;Read a tape mark?
JRST [ AOS EOFCNT ;Yes. Count EOFs
SETOM EOFLG ;Note EOF
SETZM SHORTL
JRST MREAD4 ]
SETOM SHORTL
IORDI D,%TMFC ;Get record size in tape frames
ADDI D,4 ;Round up to PDP10 words.
IDIVI D,5 ;Get record size in PDP10 words
MOVNS D ;Get -count
HRLM D,MAGBFP ;Update available word count in ptr.
MREAD4: JRST MREADL ;Back to main read loop
;B/CS1 C/FS
MRERR: SOSG MTRYS ;Exhausted yet?
JRST MRERRQ
IORDI D,%TMERR ;Get formatter error register
TRNE D,%TMERM\%TMEUS\%TMEFS\%TMEIR\%TMEIF\%TMEMC\%TMECT\%TMENX
JRST MRERRF ;Fatal errors
TRNN C,%TMSOL ;On line?
JRST MRERRF ;This isn't so good either
TRZ D,%TMEFC\%TMENG ;Ignore NSG, Frame count error
TRNE C,%TMSPE ;Phase encoded (1600BPI) mode?
TRZ D,%TMECE\%TMECS ;If so, ignore errors hardware already fixed
TRZN D,%TMECE\%TMECS\%TMEFC\%TMENG\%TMEFL\%TMEMD\%TMEIC ;Retryable?
JRST MRERR1 ;Nothing retrying will help, just use it
TRNE C,%TMSTM ;Tape mark?
JRST MRERR2 ;Yes, no point in retrying
JRST MRRT ;OK, go retry read
;Formatter seems happy. Check channel status before returning
MRERR1: TRNE D,177777 ;Sanity check. Shouldn't be any errors left
JRST MRERRF
TRNE B,%TM1TE ;Transfer error?
TRNE C,%TMSES ;And not formatter error?
CAIA
JRST MRERRF ;Just lose for now
MRERR2: JRST MREAD3
;Fukt
MRERRQ: AOS FERRS ; Count an error
TYPE T,"~&Irrecoverable tape data error."
ASKYN "~&Continue, using bad data?"
MRERRF: LOSE "~&Quit, fatal tape error"
JRST MREADL
;Retry tape read
;
MRRT: MOVEI B,%TM1TE ;Reset RH errors
IOWRI B,%TMCS1
CALL TMFCLR ;Clear and reset TM03
SETO B,
IOWRI B,%TMFC ;1 record
MOVEI B,%TMSPR ;Space backwards command
IOWRI B,%TMCS1 ;Do it
MRRT.1: IORDI B,%TMCS1
TRNE B,%TM1MP ;Massbus gone
JRST MRERRF
TRNE %TM1GO ;Done?
JRST MRRT.1 ;Wait
JRST MERR2 ;Continue on our way.
;EOT. Clear tape system
MREOT: CALL TMCCLR ;Reset everything.
TYPE LPT,"~&EOT" ;Announce end of tape.
PUNT ;Dump back into DDT
];TM03
];NTS
SUBTTL Load From Mag Tape
NTS,[
TMXX,[
TRAN: CALL REW ;Rewind the tape.
TRAN1: JSR INIT ;Reset the world.
CRR
MOVEI I,0 ;Start with lowest disk.
CALL RSTALL
MOVEI A,5 ;Use tape unit 5 for reading.
; (KS code ignores this apparently)
CALL DUP2 ;Go get disk unit to load onto.
MOVEI A,TUT ;We want the TUT in core.
MOVE I,TOU
CALL RDTUT ;Read in disk's TUT.
JUMPL T,READC ; Aeuuagh.
MOVEI A,MFD ;We want the MFD in core.
MOVE J,MFDBK
CALL READT ;Read MFD from disk.
TNAML: CALL MAGOP ;Start reading the tape.
JRST MREOT ; punt when end of tape.
MOVE A,MHFN1 ;Don't reload directories!
MOVE B,MHFN2
CAMN A,[SIXBIT/.FILE./] ;Magic file names of UFDs.
CAME B,[SIXBIT/(DIR)/]
CAIA
JRST TIGNF
CAMN A,[SIXBIT/M.F.D./] ;Magic file names of MFD.
CAME B,[SIXBIT/(FILE)/]
CAIA
JRST TIGNF
TYPE LPT,"~&~S;~S ~S ",[MHSNM,MHFN1,MHFN2]
SETZM FERRS ;No errors reloading yet.
MOVE B,MHSNM
MOVE A,MFD+MDNAMP
SETZM IBLK
TMLKP: CAIL A,2000
JRST TNEWU ;New UFD.
SKIPN C,MFD+MNUNAM(A)
JRST [ MOVEM A,IBLK
JRST TMLKL ]
CAMN B,C
JRST TOLDU ;Old UFD.
TMLKL: ADDI A,LMNBLK
JRST TMLKP
TOLDU: HRREI J,-2000(A) ;Convert MFD index to block #.
ASH J,-1
ADD J,NUDS
MOVEM J,UFDTA
MOVEI A,NUSRD
CALL READT ;Read UFD from disk.
CAME B,NUSRD+UDNAME ;Should read the right amount.
HALT . ; else losing big.
JRST TOLDUR
TNEWU: MOVE A,[NUSRD,,NUSRD+1] ;Make an empty UFD in core.
SETZM NUSRD
BLT A,NUSRD+1777 ;Zap.
MOVEM B,NUSRD+UDNAME ;Store UFD name.
MOVEI A,2000
MOVEM A,NUSRD+UDNAMP ;Initial name are ptr.
SKIPN A,IBLK
JRST [ MOVNI A,LMNBLK
ADDB A,MFD+MDNAMP
JRST .+1 ]
MOVEM B,MFD+MNUNAM(A) ;Now insert UFD into the MFD.
HRREI J,-2000(A) ;Convert MFD index to block #.
ASH J,-1
ADD J,NUDS
MOVEM J,UFDTA
TOLDUR: MOVE B,MHFN1 ; UFD (new or old) is now in core.
MOVE C,MHFN2 ;See if the file is already extant.
MOVE A,NUSRD+UDNAMP ;Get name area ptr.
SETZM IBLK ;Starting with block zero.
TULKP: CAIL A,2000 ; Loop looking for file.
JRST TNEWF ; If you get to the end, file is new.
MOVSI T,UNCDEL ;Else check old file status.
TDNE T,NUSRD+UNRNDM(A) ;Delete when closed?
JRST TULKD
SKIPN T,NUSRD+UNFN1(A)
JRST TULKZ
CAME B,T ;FN1 on tape the same?
JRST TULKL ; No, keep searching for file.
CAMN C,NUSRD+UNFN2(A) ;If tape FN2 the same
JRST TOLDF ; we have found an old file.
TULKL: ADDI A,LUNBLK ;Else try next file.
JRST TULKP ;Keep looking.
TULKZ: SKIPN NUSRD+UNFN2(A)
TULKD: MOVEM A,IBLK ; IBLK: index of empty space in UFD
JRST TULKL ;Keep looking.
TOLDF: TYPE LPT,"exists~%"
TIGNF: CALL IGFIL
JRST TNAML
IGFIL2: MOVE A,[-2000,,FDBUF] ;Ignore block.
CALL MREAD ;Read next from tape.
IGFIL: SKIPN EOUF
JRST IGFIL2
SETZM EOUF
RET
TNEWF: SKIPE A,IBLK
JRST TNEWCK
MOVNI A,LUNBLK
ADDB A,NUSRD+UDNAMP
TNEWCR: MOVE T,NUSRD+UDESCP
IDIVI T,6
CAIL T,-UDDESC(A)
HALT .
MOVEM B,NUSRD+UNFN1(A)
MOVEM C,NUSRD+UNFN2(A)
DC, MOVEM B,WXWDS+XWFN1
DC, MOVEM C,WXWDS+XWFN2
MOVE B,NUSRD+UDNAME
DC, MOVEM B,WXWDS+XWSYSN
DC, SETZM WXWDS+XWBWC
SETZI B,
SKIPE LNKFLG
MOVSI B,UNLINK
MOVEM B,NUSRD+UNRNDM(A)
MOVE B,NUSRD+UDESCP
DPB B,[UNDSCP NUSRD+UNRNDM(A)]
MOVE B,MHDATE
MOVEM B,NUSRD+UNDATE(A) ; Set creation date
MOVE B,MHRDAT ; Reference date and byte info from tape
TRO B,777000 ; Unknown author
MOVEM B,NUSRD+UNREF(A)
MOVE B,TUT+QPKNUM
DPB B,[UNPKN NUSRD+UNRNDM(A)]
MOVEI A,NUSRD+UNRNDM(A)
HRLI A,(UNWRDC)
MOVEM A,TRNDEP ;DPB WC OF LAST BLOCK LATER
SETZM CBYT
SETZM OBLKS
SETZM IBLK
SETZM LBLK
SKIPE LNKFLG
JRST TRNLNK ;JUMP IF APPENDING LINK
TBLKL:
TBLKL1: MOVE A,[-2000,,FDBUF]
CALL MAGRD
JUMPE T,TBLKL2
DC, DPB T,[XWAWC WXWDS+XWBWC]
DPB T,TRNDEP ;STORE WORD COUNT IN DIRECTORY
MOVE T,LBLK
DC, DPB T,[XWBLK WXWDS+XWBWC]
AOS IBLK
CALL WRBLK
TBLKL2: SKIPN EOUF
JRST TBLKL
SETZM EOUF
JRST TBDON
TNEWCK: SKIPN NUSRD+UNFN1(A)
SKIPE NUSRD+UNFN2(A)
HALT .
JRST TNEWCR
TBDON: MOVEI D,NUSRD
CALL EBYT
MOVEI J,UDWPH
SKIPN LBLK
CALL BYDEP
TBDON1: MOVEI J,0
MOVEI D,NUSRD
CALL BYDEP
TMDON: MOVE J,[WXWDS,,WXWDS+1]
SETZM WXWDS
BLT J,WXWDS+3
MOVE A,TUT+QTUTP
IDIVI A,NBLKSC
IMULI A,NBLKSC
MOVEM A,TUT+QTUTP
MOVEI A,TUT
MOVE I,TOU
CALL WRTUT
MOVEI I,0
TMDON2: SKIPL QACT(I)
JRST TMDON1
MOVE J,MFDBK
MOVEI A,MFD
CALL WRITE
MOVE J,UFDTA
MOVEI A,NUSRD
CALL WRITE
TMDON1: CAIGE I,NUNITS-1
AOJA I,TMDON2
SKIPN FERRS
TYPE LPT,"OK~%"
JRST TNAML
TRNLNK: MOVE A,LNKSNM
CALL TRNLK1
MOVE A,LNKNM1
CALL TRNLK1
MOVE A,LNKNM2
CALL TRNLK1
JRST TBDON1
TRNLK1: MOVE K,A
MOVEI A,6
TRNLK2: MOVEI J,0
LSHC J,6
JUMPE J,TRNLK4
CAIE J,':
CAIN J,';
JRST [ PUSH P,J
MOVEI J,':
MOVEI D,NUSRD
CALL BYDEP
POP P,J
JRST .+1 ]
MOVEI D,NUSRD
CALL BYDEP
SOJG A,TRNLK2
RET
TRNLK4: MOVEI J,';
MOVEI D,NUSRD
JRST BYDEP
WRBLK: MOVE J,TUT+QTUTP
AOS TUT+QTUTP
CAML J,TUT+QLASTB
JRST WRLUZ
MOVEM J,LBLK
SETZM TUTLUZ
MOVEI B,TUT
CALL TUTPNT
LDB B,J
JUMPN B,WRBLK
MOVEI B,1
DPB B,J
MOVE J,LBLK
MOVEI A,FDBUF
CALL WRITT
SUB J,OBLKS
ADDM J,OBLKS
MOVEI D,NUSRD
CAIN J,1
JRST WRBC
CALL EBYT
CAIG J,UDWPH-UDTKMX
JRST WRBS
MOVE J,OBLKS
LSHC J,-NXLBYT*6
MOVEI U,NXLBYT+1
ADDI J,UDWPH+1
MOVEI D,NUSRD
WRBL: CALL BYDEP
LSHC J,6
SOJG U,WRBL
RET
WRLUZ: SETCMB J,TUTLUZ
JUMPE J,[ LOSE "~&Disk Full" ]
MOVE J,TUT+QSWAPA
CAMGE J,TUT+QFRSTB
MOVE J,TUT+QFRSTB
MOVEM J,TUT+QTUTP
JRST WRBLK
MAGOP: AOSE ITAPE
JRST MTR1
HRROI A,MAGHD
CALL MREAD
JUMPE T,MBDTHD ; EOT?
MOVE A,MAGHD
TRNE A,-1
JRST MBDTHD ; Bad tape header
CAMGE A,[-LTHBLK,,]
JRST MBDTHD ; Tape header too long
ADD A,[1,,THBLK+1]
CALL MREAD
JUMPL A,MBDTHD ; Tape header isn't all there
HLRZ A,THTPN
TYPE T,"~&Tape #~D",[A]
MTR1: HRROI A,MAGHD
CALL MREAD
JUMPE T,CPOPJ ;EOF
MOVE A,MAGHD
TRNE A,-1
JRST MBADHD ; Bad header
CAMGE A,[-LMHBLK,,0]
JRST MBADHD ; Header too long
CAMLE A,[-LMHBKZ,,0]
JRST MBADHD ; Header too short
SETZM MHPKN ; Default to pack 0
SETOM MHDATE ; Unknown creation date
HRROI T,777000 ; Unknown reference date and author
MOVEM T,MHRDAT ; 36. bit bytes
SETOM MHLEN ; Unknown length
ADD A,[1,,MHBLK+1]
CALL MREAD
JUMPL A,MBADHD ; Header isn't all there
MOVNS MHLEN ; For MAGRD (see below...)
SETZM LNKFLG
HLRZ B,MHPKN
JUMPE B,POPJ1 ;NOT A LINK
SETOM LNKFLG
MOVE A,[-3,,LNKNM1] ;READ LINK INFO
CALL MAGRD
CAIE T,3
JRST MBDLNK
AOS (P) ; Skip return
JRST IGFIL ; after throwing away any extra words
MBDLNK: TYPE LPT,"~&Bad Link~%"
CALL IGFIL
JRST MTR1
MBADHD: TYPE LPT,"~&Bad Header~%"
CALL IGFIL
JRST MTR1
MBDTHD: LOSE "Bad tape header"
];TMXX
];NTS
; Like MREAD, but respect length in MHLEN.
; MAGOP sets MHLEN to 1 if the length is implicit, else it sets it to
; minus the number of words that are -supposed- to follow on the tape.
; Extra words must be discarded. EOUF must be maintained. A and T must
; be corrected.
MAGRD: SKIPLE MHLEN
JRST MREAD ; Length is implicit on the tape.
CALL MREAD
ADDM T,MHLEN
SKIPLE MHLEN ; Words to be discarded?
JRST MAGRD1 ; Go flush 'em
SKIPE EOUF ; If EOF seen
SKIPL MHLEN ; and still expecting more data...
RET
TYPE LPT,"~&File ~S;~S ~S too short on tape -- ~
it will be truncated.~%",[MHSNM,MHFN1,MHFN2]
RET
.VECTOR MGARB(LMGARB==:40) ; A place to read garbage into
MAGRD1: SUB T,MHLEN ; Correct T
HRLS MHLEN
SUB A,MHLEN ; Correct A
SETZM MHLEN ; Just for consistency...
MAGRD2: SKIPE EOUF ; So, was that EOF?
RET ; Yes, return
PUSHER P,[A,T]
MOVE A,[-LMGARB,,MGARB]
CALL MREAD ; No, keep reading until it happens
POPPER P,[T,A]
JRST MAGRD2
SUBTTL Create User Directory
NEWUFD: JSR INIT
MOVE I,MDSK ;Reset the MFD "master" disk.
CALL RESET
MOVEI A,MFD ;MFD lives here in core.
MOVE J,MFDBK ;Here on the disk.
CALL READ ;Read MFD into core.
JUMPL T,ACTUE3
TYPE T,"~&User? "
CALL 6TYI ;B gets sixbit new UFD name.
MOVEI C,NUSRD ;Will build UFD here in core.
CALL UFDLUK ;Find UFD on disk.
CAIA
LOSE "~&~S - User File Directory Already Exists.",[B]
MOVE T,[NUSRD,,NUSRD+1] ;Make an empty UFD in core.
SETZM NUSRD
BLT T,NUSRD+1777 ;Zap.
MOVEM B,NUSRD+UDNAME ;Put UFD name into UFD.
MOVEI Q,2000 ;Initialize UFD's name area ptr.
MOVEM Q,NUSRD+UDNAMP
MOVE Q,MFD+MDNAMP ;Search the MFD for a free slot.
NEWUF1: CAIL Q,2000 ;Search for a free slot.
JRST NEWUF3
SKIPE MFD+MNUNAM(Q) ;Occupied?
JRST [ ADDI Q,LMNBLK ; Yes, try next slot.
JRST NEWUF1 ] ; Loop for all names.
CALL UFDADR
JRST NEWUF2
NEWUF3: MOVE Q,MFD+MDNAMP
SUBI Q,LMNBLK
CALL UFDADR
MOVEM Q,MFD+MDNAMP
NEWUF2: MOVEM B,MFD+MNUNAM(Q) ;Insert UFD into MFD here.
AOS MFD+MDNUM ; What the heck...
MOVE C,J ; C: remember UFD block number
MOVEI I,0
NEWUF8: SKIPN QACT(I)
JRST NEWUF9
MOVE J,C
MOVEI A,NUSRD
CALL WRITE
MOVE J,MFDBK
MOVEI A,MFD
CALL WRITE
NEWUF9: CAIGE I,NUNITS-1
AOJA I,NEWUF8
PUNT
;;; Convert MFD offset in Q into UFD block number in J.
UFDADR: HRREI J,-2000(Q)
ASH J,-1
ADD J,NUDS
KA, SKIPGE J ; Ensure UFD fits.
KL, CAIGE J,2 ; On KL and KS avoid magic 'HOM' sectors.
KS, CAIGE J,2
LOSE "~&M.F.D. FULL"
RET
SUBTTL Additional Randomness
;;; UFDLUK - Lookup up a UFD.
;;; A/ ptr to MFD already in core
;;; B/ UFD in sixbit
;;; C/ ptr to read in UFD
;;; UDSK/ disk to get UFDs from.
;;;
;;; Skips if UFD found; Errs if directory garbaged or disk problems.
;;; Non-skip means UFD does not exist.
;;; Returns D/ MFD index and DBLK/ UFD block
UFDLUK: PUSHER P,[A,B,C,I,Q]
MOVE A,MFD+MDCHK ;Get check word.
CAME A,MFDCHK ;OK?
LOSE "~&MFD check word garbaged"
MOVE A,MFD+MDNUDS ;Check NUDSLs.
CAME A,NUDS
LOSE "~&Wrong NUDSL: ~D.",[A]
MOVE Q,MFD+MDNAMP ;First UFD from MFD name area.
ADDI Q,MFD ;De-relativized.
SETZ D, ;MFD index of user directory.
UFDL10: CAIL Q,MFD+2000 ;If past name area
JRST UFDL90 ; UFD not found
CAMN B,MNUNAM(Q) ;When we find the UFD
JRST UFDL20 ; go hack it.
ADDI Q,LMNBLK ;Check next name in MFD.
AOS D
JRST UFDL10 ;Loop for all names.
UFDL20: HRREI J,-MFD-2000(Q)
ASH J,-1
ADD J,NUDS
MOVEM J,DBLK ;Remember directory block.
MOVE I,UDSK ;UFDs come from this disk.
SKIPN QACT(I) ;If the disk is not active
LOSE "~&UFD disk ~D not active",[I]
MOVE A,C ;Going into here.
MOVEM B,USRNAM ;Remember who we're hacking.
CALL READ ;Read the UFD.
JUMPL T,[LOSE "~&UFD Read Error"]
MOVE A,(C)UDNAME ;All disks should have same UFD here.
CAME A,B
LOSE "~&UFD on disk unit ~D is ~S, not ~S.",[I,A,B]
AOS -5(P)
UFDL90: POPPER P,[Q,I,C,B,A]
RET
;;; FILLUK - Look Up File in UFD
;;; A/ ptr to UFD in core
;;; B/ FN1
;;; C/ FN2
;;;
;;; Looks for the best slot in the UFD for the named file.
;;; Non-skip means file does not exist and the UFD is full.
;;; Returns in Q/ core ptr into UFD name area.
FILLUK: MOVE Q,UDNAMP(A)
ADDI Q,(A) ;Get absolute UFD name area ptr.
SETZI TT, ; TT: best slot so far or 0 if none.
FILLU1: CAIL Q,2000(A) ;If past name area
JRST FILLU3 ; Search failed.
MOVSI T,UNCDEL ;Check file status.
TDNE T,UNRNDM(Q) ;Delete when closed?
MOVEM Q,TT ; Possible slot to use.
SKIPN UNFN1(Q) ;There is an FN1.
JRST [ SKIPN UNFN2(Q) ; Is there an FN2?
MOVEM Q,TT ; No, but bogus slots are possibilities.
JRST FILLU2 ] ;Keep checking files.
CAME B,UNFN1(Q) ;FN1 matches
JRST FILLU2
CAMN C,UNFN2(Q) ;FN2 matches also!
JRST POPJ1 ; We found it, so skip.
FILLU2: ADDI Q,LUNBLK ;Else try next file.
JRST FILLU1 ;Keep looking.
FILLU3: SKIPE Q,TT ; Found one?
JRST POPJ1 ; Yes: skip return it.
MOVE Q,UDNAMP(A)
SUBI Q,LUNBLK ; Q: new candidate
MOVE T,UDESCP(A)
IDIVI T,UFDBPW
CAIL T,-UDDESC-7(Q) ; Plenty of room between descriptors and names?
RET ; Nope: don't skip
MOVEM Q,UDNAMP(A) ; OK, allocate it
ADDI Q,(A) ; and return pointer to entry
JRST POPJ1
;;; QFOWRT - Open a file for writing
;;; A/ FN1
;;; B/ FN2
;;; C/ Pointer to UFD
;;; I/ disk unit (TUT must be set up)
;;; Q/ UFD name area core ptr to file
QFOWRT: MOVEM A,UNFN1(Q) ;Set FN1.
MOVEM B,UNFN2(Q) ;Set FN2.
SETZM UNRNDM(Q)
SETOM UNDATE(Q) ; Unknown creation date
HRROI TT,777000 ; Unknown reference date
MOVEM TT,UNREF(Q) ; Unknown author, 36. bit bytes
MOVE TT,UDESCP(C) ; Get descriptor pointer from UDF
DPB TT,[UNDSCP+UNRNDM(Q)] ; Store it.
MOVE TT,TUT+QPKNUM ;Get pack number from TUT.
DPB TT,[UNPKN+UNRNDM(Q)] ;Set file pack #.
MOVEI TT,UNRNDM(Q) ;Make BP to word count last block (mod 2000).
HRLI TT,(UNWRDC)
MOVEM TT,TRNDEP ; Save it for later.
RET
TRNDEP: 0
CBYT: 0
OBLKS: 0
IBLK: 0
TUTLUZ: 0
;;; QFWRBK - Write a Block to Disk
;;; D/ core ptr to UFD
;;; Writes FDBUF onto next free block and updates the TUT.
;;; Smashes J.
;;; Skips unless disk full.
QFWRBK: PUSHER P,[A,B,J,U]
QFWRB1: MOVE J,TUT+QTUTP ;Get free space pointer.
AOS TUT+QTUTP ;Gobble a block.
CAML J,TUT+QLASTB ;If we are at the last block
JRST [ SETCMB J,TUTLUZ
JUMPE J,QFWRB9
MOVE J,TUT+QSWAPA
CAMGE J,TUT+QFRSTB
MOVE J,TUT+QFRSTB
MOVEM J,TUT+QTUTP
JRST QFWRB1 ]
MOVEM J,LBLK ;Else use this block.
SETZM TUTLUZ ;TUT not lost.
MOVEI B,TUT
CALL TUTPNT ;Get Bp into TUT.
LDB B,J ;Get usage count of block.
JUMPN B,QFWRB1 ;Should be free.
MOVEI B,1 ;Say block gobbled once.
DPB B,J
MOVE J,LBLK ;Get block to write.
MOVEI A,FDBUF ;Data from buffer.
CALL WRITT ;Write it out.
SUB J,OBLKS ;Count block output.
ADDM J,OBLKS
CAIN J,1 ;Update count and pointers in UFD.
JRST [ CALL WRBC
JRST QFWRB8 ]
CALL EBYT
CAIG J,UDWPH-UDTKMX
JRST [ CALL WRBS
JRST QFWRB8 ]
MOVE J,OBLKS
LSHC J,-NXLBYT*6
MOVEI U,NXLBYT+1
ADDI J,UDWPH+1
QFWRB2: CALL BYDEP
LSHC J,6
SOJG U,QFWRB2
QFWRB8: AOS -4(P)
QFWRB9: POPPER P,[K,J,B,A]
RET
;;; QFWDON - Finish File Output
;;; Completes update of UFD, updates and writes out TUT.
;;; Writes new MFD and UFD on each active disk.
;;;
;;; D/ core ptr to UFD.
;;; Skips on success.
QFWDON: PUSHER P,[A,B,J,I]
CALL EBYT ;Finish updating UFD.
MOVEI J,UDWPH
SKIPN LBLK
CALL BYDEP
QFWDO1: MOVEI J,0
CALL BYDEP
MOVE J,[WXWDS,,WXWDS+1] ;Zap the extra words.
SETZM WXWDS
BLT J,WXWDS+3
MOVE A,TUT+QTUTP ;Get free pointer.
IDIVI A,NBLKSC
IMULI A,NBLKSC
MOVEM A,TUT+QTUTP
MOVEI A,TUT
MOVE I,TOU
CALL WRTUT ;Update TUT to disk.
MOVEI I,0 ;Gonna write new directories to all disks.
QFWDO2: SKIPN QACT(I) ;This disk online?
JRST QFWDO3 ; no,
MOVE J,MFDBK
MOVEI A,MFD
CALL WRITE ;Write out MFD.
MOVE J,DBLK
MOVE A,D
CALL WRITE ;Write out UFD.
QFWDO3: CAIGE I,NUNITS-1 ;Loop for all units.
AOJA I,QFWDO2
SKIPN FERRS ;If no errors
AOS -4(P) ; Skipwin.
POPPER P,[I,J,B,A]
RET
;;; WRBS, BYDEP, WRBC, EBYT - File pointer hackery.
;;; D/ Pointer to UFD
;;; J/ byte to hack into it
;;; Smashes args and CBYT!
WRBS: ADDI J,UDTKMX-1 ;Hack take-n codes.
BYDEP: MOVE T,UDESCP(D) ;Get ptr to desc area.
AOS UDESCP(D) ;Advance it.
IDIVI T,UFDBYT ;Find # UFD bytes in.
ADDI T,UDDESC ;Compute new desc area byte.
CAML T,UDNAMP(D) ;See if desc in range.
LOSE "~&UFD descriptors won't fit."
ADD T,D
HLL T,QBTBL(TT) ;Make bp to desc.
DPB J,T ;Update the UFD.
RET
WRBC: AOS J,CBYT
CAIGE J,UDTKMX
RET
EBYT: PUSH P,J
SKIPN J,CBYT
JRST POPJJ
CALL BYDEP
SETZM CBYT
POPJJ: POP P,J
RET
SUBTTL Chaosnet File Downloading
NTS,[
KS,[
IFN CHAOSP,[
RFBLK:: ;; Remote filenames
RFDEV: SIXBIT /DSK/
RFFN1: SIXBIT /.BAR./
RFFN2: SIXBIT /(BAZ)/
RFSNM: SIXBIT /FOO/
LFBLK:: ;; Local filenames
LFDEV: SIXBIT /DSK/
LFFN1: 0
LFFN2: 0
LFSNM: SIXBIT /FOO/
;;; CTRAN - Chaosnet Transport Files Onto Disk
CTRAN: JSR INIT ;Reset the world.
TYPE T,"~&Remote filename:"
MOVEI B,RFBLK
CALL RFNAME
MOVE TT,RFFN1
MOVEM TT,LFFN1
MOVE TT,RFFN2
MOVEM TT,LFFN2
TYPE T,"~&Local filename:"
MOVEI B,LFBLK
CALL RFNAME ;Get filename.
MOVSI TT,(SIXBIT /DSK/)
CAME TT,LFDEV
EBDFN: LOSE "~&Bad local filename: ~F",[B]
MOVSI TT,(SIXBIT />/)
CAME TT,LFFN1
CAMN TT,LFFN2
JRST EBDFN
MOVSI TT,(SIXBIT /</)
CAME TT,LFFN1
CAMN TT,LFFN2
JRST EBDFN
MOVE A,CRHOST ;Announce the server network host.
TYPE T,"~&Copy from host #~O onto unit #",[A]
CALL NTYI ;Get the disk unit.
MOVE I,A
CAIL I,NUNITS ;Make sure disk exists.
LOSE "~&No such disk."
SKIPN QACT(I) ;Make sure it is active.
LOSE "~&Disk not active."
MOVEM I,TOU ;Remember it's TO disk.
CALL RESET ;Reset the disk.
MOVEI A,TUT
CALL RDTUT ;Read in TUT.
JUMPL T,ACTUE1
MOVEI A,MFD
MOVE J,MFDBK
CALL READ ;Read in MFD.
JUMPL T,ACTUE3
MOVE B,LFSNM
MOVEI C,OUSRD
CALL UFDLUK ;Find and read in UFD.
LOSE "~&~S - Non-Existant Directory",[B]
MOVE B,LFFN1
MOVE C,LFFN2
MOVEI A,OUSRD
CALL FILLUK ;Search for file name slot.
LOSE "~&~S - Directory Full",[LFSNM]
MOVE A,LFFN1
MOVE B,LFFN2
MOVEI C,OUSRD
MOVE I,TOU
CALL QFOWRT ;Open file for writing, E has disk ptr.
MOVE A,RFDEV
MOVE B,RFSNM
MOVE C,RFFN1
MOVE D,RFFN2
CALL CHOPEN ;Open file over MINI36 Chaosnet conn.
SETZM CBYT
SETZM IBLK ;No blocks input yet.
SETZM OBLKS ;No blocks output yet.
SETZM LBLK ;Not hacking any block yet.
CTRA10: MOVE B,[-PG$SIZ,,FDBUF]
MOVE A,B ;AOBJN to file data buffer.
CALL CHREAD ;Read in over Chaosnet.
SUB A,B ;Find how much xfrd.
HLRZ A,A ;# wds in A.
JUMPE A,CTRA20
DPB A,TRNDEP ;Count words in UFD.
AOS IBLK ;Count an input block.
MOVEI D,OUSRD ;UFD to update.
CALL QFWRBK ;Write out file block, update UFD ptrs.
LOSE "~&Disk Full"
CAIN A,PG$SIZ ;If xfered whole block
JRST CTRA10 ;Get another block.
CTRA20: MOVEI D,OUSRD ;UFD to update.
CALL QFWDON ;Finally update UFD, MFD, and TUT.
TYPE T,"~&~D disk errors.",[FERRS]
TYPE T,"~&Done."
PUNT
;;; Chaosnet hardware and software definitions.
.INSRT SYSTEM;KSNET
.INSRT SYSTEM;CHSDEF
IF2, INFORM Chaosnet User ,\LHOST , MINI36 Server at ,\RHOST ,\GWHOST
.VECTOR CHFNM(4) ;Name of file to download.
CLHOST: LHOST ;Local host number (for patching)
CRHOST: RHOST ;Remote host number (for patching)
CGWHOS: GWHOST ;Gateway host number (for patching)
XPKT: BLOCK %CPMXW ;Transmit packet buffer
RPKT: BLOCK %CPMXW+2 ;Receive packet buffer
FRNADR: <.BYTE 16. ? RHOST ? 0> ;Foreign host and index
LCLADR: <.BYTE 16. ? LHOST ? 5> ;Local host and index
XMTNUM: 0 ;Last packet out
RCVNUM: 0 ;Last packet in
CHRBYP: 0 ;Byte pointer to available data
CHRBYC: 0 ;Count of available 16-bit bytes
;;; Open connection, file name in A-D (DEV, SNM, FN1, FN2)
CHOPEN: MOVE T,[A,,CHFNM] ;Save sixbit file name
BLT T,CHFNM+3
MOVE T,CLHOST ;Initialize
DPB T,[242000,,LCLADR]
MOVE T,CRHOST
DPB T,[242000,,FRNADR]
LDB T,[042000,,LCLADR] ;Uniquize
ADDI T,1
TRNN T,177777
ADDI T,1
DPB T,[042000,,LCLADR]
SETZM XMTNUM ;Start with packet 1
SETZM CHRBYC ;No data available yet
MOVEI A,%CORFC
MOVEI C,6
CALL INIPKT
MOVE A,[440700,,[ASCII/IMIN63/]] ;Contact name byte swapped
HRLI B,440800
ILDB T,A
IDPB T,B
SOJG C,.-2
CHOPN1: CALL CHSIO0 ;Transmit this packet and get a response
CAIE A,%COOPN ;Look for an OPN response
JRST CHOPN1 ;Ignore anything else
MOVE T,%CPKS+RPKT ;Save foreign address
MOVEM T,FRNADR
LDB T,[$CPKPN RPKT] ;Save packet number
MOVEM T,RCVNUM
CHOPN2: CALL CHOSTS ;Tell him our window size
CALL CHSXMT
MOVEI A,%CODWD ;Send file name desired
MOVEI C,24.
CALL INIPKT
MOVE A,[441400,,CHFNM] ;Send those 12-bit bytes
MOVEI C,12.
ILDB T,A
IDPB T,B
SOJG C,.-2
CALL CHSIO0 ;Transmit this packet and get a response
CAIN A,%COSTS ;Wait until a STS comes back
RET
SOS XMTNUM ;Send file name with same pkt# as before
JRST CHOPN2 ;Try again, maybe our STS was lost
;;; Get data from connection
;;; A is aobjn pointer to buffer to fill in, it gets advanced
;;; This is like .IOT on a .BII channel in ITS.
CHREAD: PUSH P,B
PUSH P,C
CHRD1: JUMPGE A,CHRD6 ;Buffer filled, we're done
SKIPE C,CHRBYC ;Data left from last time?
JRST CHRD3 ;Yes, use it
PUSH P,A ;No, need another packet
CHRD2: CALL CHSIO
CAIE A,%CODWD ;Data?
JRST [ CAIE A,%COEOF ;Not data
LOSE "Connection dead? Bad packet received, opcode ~O",[A]
JRST CHRD5 ] ;End of file
JUMPE C,CHRD2 ;Packet empty
MOVEM B,CHRBYP
MOVEM C,CHRBYC
CALL CHOSTS ;Acknowledge what we just received
POP P,A
JRST CHRD1
CHRD3: HLRO T,A ;Get space left in buffer
MOVNS T
IMULI T,3 ;12-bit bytes
CAMLE C,T
MOVE C,T ;C is number of bytes to do
MOVE B,A ;Where to store
HRLI B,441400
MOVN T,C
ADDM T,CHRBYC ;Number of bytes left for next time
MOVE T,C
IDIVI T,3 ;Words!
HRL T,T
ADD A,T ;Advance AOBJN pointer
CHRD4: ILDB T,CHRBYP ;Copy bytes into caller's buffer
IDPB T,B
SOJG C,CHRD4
JRST CHRD1 ;Okay, now what
CHRD5: POP P,A
CHRD6: POP P,C
POP P,B
RET
;;; Initialize packet, opcode in A, length in C
;;; Returns with B byte pointer to 16-bit data
INIPKT: SETZM XPKT
MOVE T,[XPKT,,XPKT+1] ;Make sure all unused bits cleared
BLT T,XPKT+%CPMXW-1
DPB A,[$CPKOP XPKT] ;Fill in packet header
DPB C,[$CPKNB XPKT]
MOVE T,FRNADR
MOVEM T,%CPKD+XPKT
MOVE T,LCLADR
MOVEM T,%CPKS+XPKT
AOS T,XMTNUM ;Next packet out
DPB T,[$CPKPN XPKT]
MOVE T,RCVNUM ;Acknowledge last packet in
DPB T,[$CPKAN XPKT]
MOVE B,[442000,,%CPKDT+XPKT]
RET
;;; Send STS packet
CHOSTS: MOVEI A,%COSTS ;Acknowledge that
MOVEI C,4
SOS XMTNUM ;Doesn't count
CALL INIPKT
MOVE T,RCVNUM ;Receipt
IDPB T,B
MOVEI T,1 ;Window size
IDPB T,B
RET
;;; Keep transmitting packet in XPKT until valid packet
;;; returned in RPKT. A opcode, B byte pointer, C byte count
;;; 16-bit bytes
CHSIO: CALL CHSIO0
CAIE A,%COSNS ;Ignore SNS and STS
CAIN A,%COSTS
JRST CHSIO
MOVE T,%CPKS+RPKT ;Make sure packet is from right source
CAME T,FRNADR
JRST CHSIO ;Nope, try again
LDB T,[$CPKPN RPKT] ;Make sure it's right number
SUBI T,1
ANDI T,177777
CAME T,RCVNUM ;Should be 1 + last packet in
JRST CHSIO
LDB T,[$CPKPN RPKT] ;Save packet number
MOVEM T,RCVNUM
RET
CHSIO0: CALL CHSXMT ;Transmit packet
CALL CHSRCV ;Receive a packet
JRST CHSIO0 ;Time out, try retransmitting
MOVE T,%CPKD+RPKT ;Make sure packet is for me
CAME T,LCLADR
JRST CHSIO0 ;Nope, try again
RET
;;; Receive packet into RPKT
;;; Skip if actual packet received
;;; Decode it into A,B,C
CHSRCV: MOVEI A,50000. ;1/2 second delay
CHSRC0: MOVEI T,%CARCL ;Enable receiver
IOWR T,[CAICSR]
CHSRC1: IORD T,[CAICSR] ;Check for received packet
TRNN T,%CARDN
SOJG A,CHSRC1 ;Nothing received yet
JUMPE A,CPOPJ ;Timed out
TRNE T,%CAERR
JRST CHSRC0 ;CRC error, try again
MOVE B,[442000,,RPKT]
IORD C,[CAIRBC] ;Number of bits in packet - 1
ADDI C,1 ; including the three extra hardware words
ASH C,-4 ;16-bit word count
CAIL C,<%CPMXW*2>+3
MOVEI C,<%CPMXW*2>+3 ;Paranoia
CHSRC2: IORD T,[CAIRBF] ;Copy out the packet
IDPB T,B
SOJG C,CHSRC2
IORD T,[CAICSR]
TRNE T,%CAERR ;Make sure it came out of RAM okay
JRST CHSRC0 ;Garbage, try again
IORD T,[CAIRBC] ;Make sure counter didn't spazz
CAIE T,7777
JRST CHSRC0
LDB A,[$CPKOP RPKT]
LDB C,[$CPKNB RPKT]
ASH C,-1
MOVE B,[442000,,%CPKDT+RPKT]
AOS (P)
RET
;;; Transmit packet in XPKT
CHSXMT: PUSH P,B
PUSH P,C
MOVEI T,%CATDN ;Reset transmitter
IOWR T,[CAICSR]
MOVE B,[442000,,XPKT]
LDB C,[$CPKNB XPKT]
ADDI C,<%CPKDT*4>+1
ASH C,-1 ;Number of 16-bit words
CHSXM1: ILDB T,B
IOWR T,[CAIWBF]
SOJG C,CHSXM1
MOVE T,CGWHOST ;Hardware destination
IOWR T,[CAIWBF]
IORD T,[CAIXMT] ;Start transmission
MOVEI B,50000. ;Wait up to 1/2 second for xmt done
CHSXM2: IORD T,[CAICSR]
TRNN T,%CATDN
SOJG B,CHSXM2
POP P,C ;Return regardless of whether it worked
POP P,B
RET
];IFN CHAOSP
];KS
];NTS
SUBTTL Storage
LOC <<.+PG$SIZ-1>/PG$SIZ>*PG$SIZ ;Round up to page boundary
PAT:
PATCH: BLOCK 400
PDL: BLOCK PDLLEN
VERSHN: .FNAM2
GOGOX: 0 ;-1 Automatic mode
NOQUES: 0 ;-1 Ask no questions (only effective in GOGOX mode)
NOISE: 0 ;-1 Make extra noise mode, -2 make even more noise!
HCRASH: 0 ;-1 if operating on a crashed pack (do things quickly)
MARKF: 0 ;Set when marking a pack (mounted pack has no file system)
ACTIVE: 0 ;-1 if already have reset drives
CKFLSW: 0 ;-1 if should check all files for clobbered blocks
MDSK: 0 ;Disk to get MFD from
UDSK: 0 ;Disk to get UFD's from
FROM: 0 ;Unit to read from
TOU: 0 ;Unit to write to
LBLK: 0 ;Disk block number to hack
FMBLK: 0 ;From block
TOBLK: 0 ;To block
DC,BLK: 0 ;Last block read or written from
FERRS: 0 ;Transfer error count
CERRS: 0 ;Errors corrected by ECC logic
DUPRER: 0 ;DUP read error count
DUPWER: 0 ;DUP write error count
HARDER: 0 ;-1 iff had disk hardware error.
UBSTSP: 0 ;Controls whether UBSTS prints invalid UNIBUS maps.
UFDSEE: 0 ;Need to print funny looking UFD
XWDSEE: 0 ;-1 iff haven't typed "extra" words yet
MFDWRT: 0 ;-1 if MFD has changed
TUTDFR: 0 ;-1 if TUT has changed
FILEER: 0 ;Error in file
UFDLOS: 0 ;Some garbage in UFD
GARBF: 0 ;Garbage in Free Area
EXGARB: 0 ;Extra garbage in UFD
BADFIL: 0 ;Blocks in file with retrieval errors
SHARED: 0 ;Count of nasty ole' shared blocks.
TUTCHG: BLOCK TUTMAX*TUTMAX ;Summary of TUT differences.
USRNAM: 0 ;M.F.D. usr name
LUFDS: 0
LASTQ: 0 ;Storage place for Q
DBLK: 0 ;Storage for directory block number
LFILES: 0 ;# files in directory
FILEPK: 0 ;Pack file is on
FUNIT: 0 ;Unit file is on, -1 if pack not mounted
NOTUT: 0 ;TUT not active for this file
ADRSET: 0 ;File address set
LSTBLK: 0 ;Last block storage
LAST: 0 ;Last file in UFD
UFDTA: 0 ;UFD disk block #.
MFDCHK: SIXBIT /M.F.D./
;;; QBTBLI is a table of pre-computed byte pointers into the UFD descriptor words.
.SEE UFDBYT
QBTBLI: 440600,,
QBTBL: 360600,,
300600,,
220600,,
140600,,
60600,,
600,,
NUDS: NTS,[NUDSL]+0 ;Number of User Directory blockS
SBTAB: -1 ;Special block table.
-1 ;(For Patching)
-1
-1
MFDBK: MFDBLK ;Special reserved blks.
;;; TUT used to be here, but no longer
LSBTAB==.-SBTAB
;;; NTBL is an array indexed by unit giving the number of
;;; blocks in the TUT on that unit.
NTBL:
IFE T300P, REPEAT NUNITS, NTUTBL
IFN T300P,[
REPEAT T300P, NTUTBL
REPEAT NUNITS-T300P, NTUTB1
];T300P
RXWDS: BLOCK 4 ;The extra words
0 ;For BLT.
WXWDS: BLOCK 4
;;; Physical/Virtual unit translation hack.
;;; Index the table with a virtual unit number to get the physical unit.
;;; RH of entry is physical drive.
;;; "4.9 means second half
;;; (No longer does anything, now that Memowrecks have been
;;; flushed, but keep around in case ever needed again.)"
.SEE QCNVT
QTRAN: DC,[ 0 ? 1 ? 2 ? 3 ? 4 ? 5 ? 6 ? 7 ]
.ELSE REPEAT NDRIVE, .RPCNT
IFN .-QTRAN-NUNITS,.ERR BARF AT QTRAN!!
QTTBLI: REPEAT 36./TUTBYT+1, 440000+TUTBYT_6-TUTBYT_12.*.RPCNT,,
QTTBL=QTTBLI+1
TS,[
NQS: 0 ;System's number of drives
SQACT: 0 ;Location of QACT in ITS
];TS
NBLKS-1 ;SNBLKS-1
SNBLKS: NBLKS ;System NBLKS (init'ed in TS)
DRIVE: REPEAT NDRIVE,-1 ;-1 if drive on line
QACT: REPEAT NUNITS,-1 ;-1 if unit active .SEE ACTUN
QPKN: REPEAT NUNITS,-1 ;Pack # according to TUT .SEE FINDPK
PKNUM: BLOCK NUNITS ;Pack # according to hardware
DC,[
RPKID: 0
]
CONS==.
CONSTANTS
VARS==.
VARIABLES
IF2, .CRLF
IF2, SAYSIZ .-VARS,variables
IF2, SAYSIZ VARS-CONS,constants
LOC <<.+PG$SIZ-1>/PG$SIZ>*PG$SIZ ;Round up to page boundary
IF2, INFORM Buffers begin at ,\.
IRP A,,[OTUT,NTUT]
Q!A!O: REPEAT NUNITS,CONC A,\.RPCNT,
TERMIN
CYLBUF==:<.+1777>&776000
CYLPAG==:CYLBUF/PG$SIZ
LOC CYLBUF
OUSRD: BLOCK 2000 ;Old UFD
NUSRD: BLOCK 2000 ;New UFD
FDBUF: BLOCK 2000 ;File block buffer
MFD: BLOCK 2000 ;MFD
MAGBUF: BLOCK 2000 ;Magtape buffer
IRPS A,,OTUT NTUT ;Old and New TUTs for each unit:
REPEAT NUNITS,CONC A,\.RPCNT,: BLOCK 2000*MXTUTB
TERMIN
D0==OTUT0
IFDEF OTUT1,D1==OTUT1
.ELSE D1: BLOCK 2000*MXTUTB
TUT=NTUT0
DC, CYLSIZ=NBLKSC*2004
RH, CYLSIZ=SECTOR*NHEDS*NSECS
PH, CYLSIZ=NBLKSC*2000
RP, CYLSIZ=NBLKSC*2000
NTS,IFL .-CYLBUF-CYLSIZ,LOC CYLBUF+CYLSIZ
THEEND:
;For KA10s (R.I.P.) we must fit in 128K to avoid hitting possible holes.
;For KL10 there can never be holes in the low 256K anyway.
;For KS10s we will never run the machine with less than 512K anyway.
IF2,[ ;; Last gasps...
INFORM Start addr = ,\SA , Highest addr used = ,\THEEND
SAYSIZ .-SA,words long
IFG THEEND-400000, .ERR Note: Salvager is too moby for 128K
;;; This MUST be last! Since it makes the symbols in question useless
;;; except for use in DDT:
KL, PAG=<BLKO PAG,>-<BLKO>
KS,[
IRP DEV,,[PAG,.RD.,.WR.]
.TEM.==<BLKO DEV,>-<BLKO>
EXPUNGE DEV
DEV=:.TEM.
TERMIN
] ;KS
] ;IF2
CONSTANTS ;Flush out these guys before following
VARIABLES ;error check...
IFN .-THEEND, .FATAL Cruft after THEEND
END DDT ;Start manually Salvager from DDT.
;ITS knows about "SA" and starts there.
;;; Local Modes:
;;; Comment Column: 32
;;; Fill Column: 72
;;; End:
Reference in New Issue View Git Blame Copy Permalink