diff --git a/src/kshack/nsalv.260 b/src/kshack/nsalv.260 new file mode 100755 index 00000000..eb26634f --- /dev/null +++ b/src/kshack/nsalv.260 @@ -0,0 +1,8788 @@ +; -*- 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 , - 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,MC,[ + ;;; 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 + ];MC + + 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,MCKL,[ + ;;; 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(-_2&37774)!TERMIN +];DC + + + +;;; Instructions + +CALL= ;Procedure call. +X== ;(Old name for it.) +RET= ;Return. +CALRET==:JRST ;Tail-recursive call. +KA, NOP= +.ELSE NOP= +NTS, HALT= ;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, + 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 + CAMN 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+ ;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 _-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+-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: -,,-1 +;;; RHPGA: ,, +;;; 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+/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*] + 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,/NSECS-1 + MOVEM J,TRKN' + + +;;; WRITE IMAGE COMMAND - (START AT SECTOR PULSE) +;;; COPY ;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,, + 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,[_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,*NBLKSC ;RP02. + TRNE B,2000 + MOVEI A,*NBLKSC ] ;RP03. +.ELSE MOVEI A,*NBLKSC ;RP04/6. +T300,[ CAIL I,T300P + MOVEI A,*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_+1_+800BPI_+1_ + +;;; Functions + +NOOP1=0_+MAGCOM ;Clear interrupt flags +NOOP2=10_+MAGCOM ;Interrupt when transport idle +REWIND=1_+MAGCOM ;Rewind +REED=2_+MAGCOM ;Read +SPACR=7_+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 / ;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. +;;; 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=- +KS,[ +IRP DEV,,[PAG,.RD.,.WR.] +.TEM.==- +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: