; -*- 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,MCKS,[ ;;; The new Mail Computer KS10. KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP06P==1 ;RP06 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI) TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;Has Unibus Chaosnet board LHOST==3131 ;Local chaos host address (MC) RHOST==3130 ;Remote chaos host (AI) GWHOST==RHOST ];MCKS IFCE MCHN,ML,[ ;;; The Math Lab KS10. KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP06P==1 ;RP06 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI) TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;Has Unibus Chaosnet board LHOST==3133 ;Local chaos host address (ML) RHOST==3130 ;Remote chaos host (AI) GWHOST==RHOST ];ML IFCE MCHN,MD,[ ;;; The Mostly Development KS10. KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RM80P==1 ;RM80 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI) TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;Has Unibus Chaosnet board LHOST==3132 ;Local chaos host address (MD) RHOST==3130 ;Remote chaos host (AI) GWHOST==RHOST ];MD IFCE MCHN,SI,[ ;;; Stacken ITS KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP06P==1 ;RP06 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI) TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) ];SI IFCE MCHN,FU,[ ;;; Australian KS10 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP06P==1 ;RP06 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 (For mounting the pack on AI) TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) ];FU IFCE MCHN,PM,[ ;;; MRC'S PandaMonium KS10 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RM03P==1 ;RM03 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) ];PM IFCE MCHN,DX,[ ;;; DigeX's KS10 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RM03P==1 ;RM02/3 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) ];DX IFCE MCHN,KSRP06,[ ;;; Generic KS10 with one RP06 and one TM03 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP06P==1 ;RP06 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;May well have Unibus Chaosnet board LHOST==3130 ;Local chaos host address (AI, can be patched) RHOST==3131 ;Remote chaos host (MC, can be patched) GWHOST==RHOST ];KSRP06 IFCE MCHN,KSRP07,[ ;;; Generic KS10 with one RP07 and one TM03 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RP07P==1 ;RP07 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;May well have Unibus Chaosnet board LHOST==3130 ;Local chaos host address (AI, can be patched) RHOST==3131 ;Remote chaos host (MC, can be patched) GWHOST==RHOST ];KSRP07 IFCE MCHN,KSRM03,[ ;;; Generic KS10 with one RM03 and one TM03 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RM03P==1 ;RM03 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;May well have Unibus Chaosnet board LHOST==3130 ;Local chaos host address (AI, can be patched) RHOST==3131 ;Remote chaos host (MC, can be patched) GWHOST==RHOST ];KSRM03 IFCE MCHN,KSRM80,[ ;;; Generic KS10 with one RM80 and one TM03 KS10P==1 NDRIVE==1 ;# physical units NUNITS==1 ;# virtual units FIRSPK==0 ;First pack that must be mounted in GOGO mode. LASTPK==0 ;Last GOGO pack (only 1 disk on the machine!) NUDSL==500. RM80P==1 ;RM80 on RH11 UNIBUS controller. TM03P==1 ;Tape on a TM03/RH11 TCMXH==120. ;DECwriter. LIGHTS==0 ;There aren't any (sob!) CHAOSP==1 ;May well have Unibus Chaosnet board LHOST==3130 ;Local chaos host address (AI, can be patched) RHOST==3131 ;Remote chaos host (MC, can be patched) GWHOST==RHOST ];KSRM80 IFCE MCHN,MC,[ ;;; The Macsyma Consortium machine. KL10P==1 SA=105*2000 ; MC-KL system is big, need to push SALV higher. FIRSPK==0 LASTPK==1 NUDSL==500. RH10P==1 ;RP04 on RH10 MASSBUS controller. T300P==3 ;UNIT 3 IS FIRST T-300 UNIT TM10P==1 ;TM10 Tape code TCMXH=100. ;LA36 LIGHTS==500 ;KL-UDGE NDRIVE==6 ;8 DOESN'T FIT IN 128K NUNITS==6 ];MCKL IFCE MCHN,MLKA,[ ;;; The original Mathlab machine (R.I.P.) KA10P==1 FIRSPK==2 LASTPK==3 NUDSL==250. RP10P==1 TCMXH=55. LIGHTS==4 ;PI NLPTP=464 ];MLKA IFCE MCHN,DM,[ ;;; The Dynamod machine (R.I.P.) KA10P==1 FIRSPK==17. LASTPK==21. NUDSL==200. RP10P==1 TTLPTP==100 TCMXH=55. LIGHTS==4 ;PI NLPTP=464 ];DM IFCE MCHN,AIKA,[ ;;; The original ITS machine (R.I.P.) KA10P==1 FIRSPK==1 LASTPK==5 NUDSL==440. DC10P==1 TCMXH=55. LIGHTS==4 ;PI NLPTP=464 ];AIKA IFCE MCHN,ITS,ITS==1 IFCE MCHN,TS,ITS==1 IFNDEF ITS,ITS==0 IFN ITS,[ ITS==1 ;Timesharing version. KL10P==1 ;Pretend to be KL10 I suppose. TM10P==0 ;Don't bother with tape code. FIRSPK==0 LASTPK==5 TCMXH=79. LIGHTS==0 NUDSL==500. TTYI==1 ;TTY typein channel TTYO==2 ;TTY typeout channel LPTC==3 ;LPT channel ;Busted NLPTP==1 ;Pretend to have LPT QIN==4 ;Disk input channel ];TS IFNDEF FIRSPK, .FATAL Unknown machine "MCHN" TERMIN IFNDEF NUDSL, .FATAL Number of UFDs undeffd IFNDEF LIGHTS, .FATAL Lights undeffd DEFINE TS IFN ITS!TERMIN DEFINE NTS IFE ITS!TERMIN IFNDEZ "Processor type",KA10P,KL10P,KS10P IFNDEF T300P,T300P==0 IFNDEZ "Disk/control types",DC10P,RP10P,RH10P,RP06P,RP07P,RM03P,RM80P,ITS ;;; Select at most one kind of tape subsystem. IFNDEF TM03P,TM03P==0 IFNDEF TM10P,TM10P==0 NTS, IFG TM10P+TM03P-1,.FATAL Too many tape controller types selected. TS, IFN TM03P+TM10P,.ERR Tape code in timesharing SALV? IFN TM03P, IFE KS10P, .FATAL TM03 Tapes only supported on KS10. IFN TM10P, IFN KS10P, .FATAL TM10 on KS10? IFNDEF CHAOSP, CHAOSP==0 DEFINE KA IFN KA10P!TERMIN DEFINE KL IFN KL10P!TERMIN DEFINE KS IFN KS10P!TERMIN DEFINE KLKS ;Code common to KL and KS machines. IFN KS10P+KL10P!TERMIN DEFINE KAKL ;Code common to KL and KA machines. IFN KA10P+KL10P!TERMIN DEFINE DC ;Calcomp on Systems Concepts controller. IFN DC10P!TERMIN DEFINE RP ;RP03 on DEC controller. IFN RP10P!TERMIN DEFINE RH ;RP04 on RH10 MASSBUSS controller. IFN RH10P!TERMIN RH11P==RP06P+RP07P+RM03P+RM80P ; "PH" stands for phucked, I guess... DEFINE PH ;RP06 or RP07 or RM03 or RM80 on RH11 UNIBUS controller. IFN RH11P!TERMIN DEFINE RHPH ;Code common to RH10 and RH11. IFN RH10P+RH11P!TERMIN DEFINE DCRH ;Code common to DC10 and RH10. IFN DC10P+RH10P!TERMIN DEFINE SH ;Code common to drives with pack # in Sector Header IFN DC10P+RH10P+RP06P!TERMIN DEFINE T300 ;Trident T300 on PDP11 "controller". IFN T300P!TERMIN DEFINE TM10 ;TM10A or TM10B tape subsystem. IFN TM10P!TERMIN DEFINE TM03 ;TM03 on RH11 IFN TM03P!TERMIN DEFINE TMXX ;Any tape IFN TM10P+TM03P!TERMIN ;;; Lineprinter definition. IFNDEF OLPTP, OLPTP==0 IFNDEF NLPTP, NLPTP==0 IFNDEF TTLPTP, TTLPTP==0 DEFINE LPT IFN OLPTP+NLPTP+TTLPTP!TERMIN DEFINE OLPT IFN OLPTP!TERMIN DEFINE NLPT IFN NLPTP!TERMIN DEFINE TLPT IFN TTLPTP!TERMIN ];IF1 ;;; Unless the "virtual drive" hack is being used, default the number ;;; of disk drives to the maximum possible and find out at run time how ;;; many there really are on-line with the right packs. IFNDEF NDRIVE, NDRIVE==8 ;# physical units IFNDEF NUNITS, NUNITS==8 ;# virtual units SA=100*2000 ;Our starting address. NTS,DDT=MEMSIZ-4000 ;Well-known address of Exec DDT. .YSTGW ; OK, now you can output stuff LOC SA ;Code begins assembling here. JRST GOGO ;Make easy to start from ITS. SALVRT: 0 ;System may JSR here. JRST SALVAG ;;; Device definitions. IF2,[ KA, INFORM KA-10 processor KL, INFORM KL-10 processor KS, INFORM KS-10 processor TS INFORM Runs under time-sharing (fake KL) OLPT, INFORM Old LPT Interface NLPT, INFORM New LPT Interface TLPT, INFORM LPT on MTY line number ,\TTLPTP&77 TM03, INFORM TM03/TUxx on RH11 TM10, INFORM TM10A/B Magtape on IO Bus or Data Channel ];IF2 KA,[ APR==0 ;Processor. PI==4 ;Interrupt system. TTY==120 ;TTY. PTP==100 ;Paper tape. MTY==400 ;Scanner. ;;; Disk channel program words. DEFSYM SLVICWA=20 DEFSYM SLVIOWD=22 ];KA KS,[ ;Include KS10 defs EPT==:0 ; This MUST be the same as in ITS itself! HSB==:500 .INSRT SYSTEM;KSDEFS PIOFF==: 000400 ; Turn off PI system PICLR==: 010000 ; Clear PI system APRCHN==:3 ; APR channel. ];KS KL,[ APR==0 ;Processor. PI==4 ;Interrupt system. PAG==10 ;Pager. T300, DLB==60 ;DL-10 .ALSO DLC==64 ;;; Include KL10 defs (DTE, DL10, etc). .INSRT SYSTEM;EPT > ..D010==0 ;;; Set up addr for the "DDT" KLDCP command. ZZ==. LOC EPTDDT JRST DDT ;FOR 'DDT' COMMAND IN KLDCP LOC ZZ ;;; Tell DDT about cache intructions. SWPIA=701440,,0 SWPUO=701740,,0 SWPIO=701640,,0 SWPUA=701540,,0 ];KL ;;; DL10 communications area in non-encached low core. ;;; Actual storage layout defined in ITS and in T300 defs. T300, DL10AR==500 IF2,[ DC, INFORM Systems Concepts disk control RP, INFORM RP03 on RP10 control RH, INFORM RP04 on RH10 MASSBUS control IFN RP06P, INFORM RP06 on RH11 UNIBUS control IFN RP07P, INFORM RP07 on RH11 UNIBUS control IFN RM03P, INFORM RM03 or RM02 on RH11 UNIBUS control IFN RM80P, INFORM RM80 on RH11 UNIBUS control T300, INFORM T-300 disk on PDP-11 control ORADIX==10 RADIX 10. INFORM Number of disk drives = ,\NDRIVES ;INFORM Number of virtual units = ,\NUNITS RADIX ORADIX ];IF2 ;;; Disk physical parameters. DC, .INSRT SYSTEM;DC10 RP, .INSRT SYSTEM;RP10 RH, .INSRT SYSTEM;RH10 PH, .INSRT SYSTEM;RH11 IFN RP06P, .INSRT SYSTEM;RP06 IFN RP07P, .INSRT SYSTEM;RP07 IFN RM03P, .INSRT SYSTEM;RM03 IFN RM80P, .INSRT SYSTEM;RM80 TS, NTUTBL==4 ;Maximum number of blocks per TUT on any ITS RHPH,[ SECTOR==128. ;Disk sector size in PDP10 words. SH, HSECTOR==:SECTOR+2 ; Two word header if pack # stored there .ELSE,[ IFN RP07P, HSECTOR==:SECTOR+4 ; RP07 has lots of sector header bits.... .ELSE, HSECTOR==:SECTOR+1 ; Else just one word ] ];RHPH ;;; File system parameters. .INSRT SYSTEM;FSDEFS > ;;; Maybe T-300s too. T300, .INSRT SYSTEM;T300 > T300, MXTUTB==NTUTB1 ;MAXIMUM OF NTUTBL AND NTUTB1 .ELSE MXTUTB==NTUTBL IF2,[ TS,[ ;;; Fake ITS file system definitions. NBLKS==10000. ;Fake TBLKS==10000. ;Fake MFDBLK==-1 ;JUST TO AVOID UNDEF SYM ERROR, VALUE NEVER USED ; TUTBLK==-1 ;.. TUTPAG==600000 ;Read TUT by mapping in absolute page NBLKSC==47 ;Fake blks/cyl ];TS ];IF2 DC,[ DEFINE QCOPY A,B DCOPY A(-_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 CAME A,QTRAN(B) AOBJN B,.-1 JUMPGE B,CPOPJ ; Not found, don't skip MOVEI B,(B) ; Found, extract virtual unit number JRST POPJ1 ; and skip ;;; FINDPK - Find unit pack is mounted on. ;;; (QPKN must be set up.) ;;; Takes in C the pack number and returns in C the unit number. ;;; Returns -1 if pack not mounted. FINDPK: PUSH P,B MOVEI B,NUNITS-1 ;This many units. FINDP1: CAMN C,QPKN(B) ;This pack? JRST [ HRRZ C,B ; Yes, get unit #. JRST FINDP9 ] ; Return it in C. SOJGE B,FINDP1 ;Else keep looking. SETOM C ;When bored, fail. FINDP9: POP P,B RET DBG,[ ;;; Zap the buffer in A, length in C. BUFZAP: SETZM (A) HRLI T,(A) HRRI T,1(A) ADDI C,-1(A) BLT T,(C) PUNT ];DBG ;;; Include ALAN's winning FORMAT package. Yow! DEFINE TYPE S,&STRING&,ARGS CALL [ CALL FMTIN ZZZ==-1 IRP ARG,,[ARGS] PUSH P,ARG ZZZ==.IRPCNT TERMIN HRROI A,[ASCII STRING] MOVEI B,.LENGTH STRING MOVNI C,ZZZ+1 CALRET FORMAT"FORMAT ] TERMIN FMTIN: PUSH P,A PUSH P,B PUSH P,C PUSH P,[FMTOUT] JRST @-4(P) FMTOUT: POP P,C POP P,B POP P,A POP P,(P) RET ;;; LOSE dumps us into DDT. DEFINE LOSE &STRING&,ARGS CALL [ TYPE T,STRING,[ARGS] BARF ] TERMIN ;;; If FORMAT runs into problems it should LOSE to! EQUALS FORMAT"FMTERR,LOSE ;;; QLOSE does a GSTS before going to DDT. DEFINE QLOSE &STRING&,ARGS JRST [ TYPE T,STRING,[ARGS] CALL GSTS BARF ] TERMIN ;;; ASKYN uses format to query for a Y or N response. DEFINE ASKYN &STRING&,ARGS CALL [ TYPE T,STRING,[ARGS] JRST YORNP ] TERMIN $$IERR==1 ;Handle errors ourselves. $$PFN==0 ;Don't bother $$ERRS==0 ;No ERR: device available $$ENGL==0 ;English numbers feature $$ITAB==1 $$UTAB==0 NTS, $$ITS==0 ;Nothing above us NTS, $$PCODE==0 ;No ^P handler in OUTSTR TS, $$ITS==1 ;(unless under timesharing) TS, $$PCODE==1 .INSRT SYSENG;FORMAT ;;; CRR outputs just a carriage return. ;;; LPRCRR of course does it on the LPT. ;;; LPRTAB tabs on the LPT. CRR=:CALL . $CRR: TYPE T,"~%" RET LPRCRR=:CALL . $LPCRR: TYPE LPT,"~%" RET LPRTAB=:CALL . $LPTAB: TYPE LPT," " RET ;;; OUTSTR - Outputs a string on the system console ;;; This is called by the FORMAT package. ;;; A/ byte ptr ;;; B/ count of chars TS,[ OUTSTR: SYSCAL SIOT,[MOVEI TTYO ? A ? B] ;Type out a string. .LOSE %LSSYS RET ];TS NTS,[ OUTSTR: JUMPE B,CPOPJ ILDB T,A ;Get a charater CAIN T,^M ;Dig ^M (but not ^H or others.) JRST [ CALL TYO SETZM CTYXH ; Zero the pos. JRST OUTST6 ] MOVE T,CTYXH ;Else count the char. CAIL T,TCMXH ;If we are going to overrun JRST [ MOVEI T,^M ; CR CALL TYO MOVEI T,^J ; LF CALL TYO SETZM CTYXH ; Zero the pos. JRST .+1] LDB T,A ; Restore T CALL TYO ;Type it out. OUTST6: SOJG B,OUTSTR ;Loop for B chars. RET ;Does not skip. ];NTS ;;; GETPOS reads our horizontal cursor position for FORMAT. NTS,[ GETPOS: MOVE A,CTYXH RET ];NTS TS,[ GETPOS: SYSCAL RCPOS,[MOVEI TTYO ? MOVEM A] MOVEI A,-1 HRRE A,A RET ];TS ;;; TYO types character on the console TTY. ;;; T/ char to type ;;; Bashes no ACs; Never skips. LINPOS:: CTYXH: 0 ;CTY horizontal cursor position. TYO: TS, .IOT TTYO,A NTS,[ AOS CTYXH ; Track horizontal position. KA,[ CONSZ TTY,20 JRST .-1 DATAO TTY,A ];KA KL,[ PUSH P,T ANDI T,177 CALL DTEXIO POP P,T ];KL KS,[ PUSH P,T ANDI T,177 ;ASCII only. IORI T,400 ;Set CTY-char-pending MOVEM T,8CTYOT ;Store in comm area CONO 80INT\APRCHN SKIPE 8CTYOT ;Wait for completion JRST .-1 POP P,T ];KS ];NTS RET ;;; TYI - Read character from console TTY. ;;; Skip returns with char in T, else fails. TYI: TS, .IOT TTYI,T NTS,[ KA,[ CONSO TTY,40 RET DATAI TTY,T ];KA KL,[ MOVEI T,3400 ;DDT mode input req CALL DTEXIO JUMPE T,CPOPJ ];KL KS,[ SKIPN T,8CTYIN ;Chars stored here by 8080. RET SETZM 8CTYIN ;Remember to clear it. ];KS ANDI T,177 ;ASCIIfy. CALL TYO ;Echo it. ];NTS CAIE T,^C ; General punting feature... CAIN T,^Z PUNT JRST POPJ1 ;;; DTE20 Communication Routine ...( copied from DEC "SUBRTN" program.) KL,[ DTEXIO: SETZM DTEFLG MOVEM T,DTECMD SETZM DTEF11 CONO DTE,%DBL11 SKIPN DTEFLG JRST .-1 SETZM DTEFLG MOVE T,DTEF11 RET ];KL ;;; TYIPSE - Return to DDT if character typed. TYIPSE: TS,[ .LISTEN T, JUMPE T,CPOPJ ];TS CALL TYI RET PUNT ;;; NTYI reads a digit into A and should skip. NTYI: CALL TYI JRST NTYI MOVE A,T CAIL A,"0 CAILE A,"9 RET SUBI A,"0 JRST POPJ1 ;;; DTYI reads a decimal number into A. ;;; OTYI reads an octal number into A. ;;; Never skips. DTYI: PUSH P,B MOVEI B,0 DTYI1: CALL NTYI JRST DTYI2 IMULI B,10. ADD B,A JRST DTYI1 DTYI2: MOVE A,B POP P,B RET OTYI: PUSH P,B MOVEI B,0 OTYI1: CALL NTYI JRST DTYI2 LSH B,3 ADD B,A JRST OTYI1 ;;; 6TYI - Sixbit input into B and don't skip. 6TYI: PUSHER P,[A,C] MOVE C,[440600,,B] MOVEI B,0 6TYL: CALL TYI JRST 6TYL MOVE A,T CAIN A,^M JRST 6TYI9 TRZN A,100 TRCA A,40 ; Sixbitify character TRO A,40 JUMPLE A,6TYI9 TLNE C,77^4 IDPB A,C JRST 6TYL 6TYI9: POPPER P,[C,A] RET ;;; Y or N querying. ;;; Returns for negative, skips for affirmative. ;;; Groks Y,N in either case, and SPACE,RUBOUT. YORNP: TYPE T," (Y or N) " CALL TYI JRST .-1 CAIN T,177 JRST CPOPJ CAIN T,40 JRST POPJ1 CAIN T,"Y JRST POPJ1 CAIN T,"N JRST CPOPJ CAIN T,"y JRST POPJ1 CAIN T,"n JRST CPOPJ TYPE T,"" JRST YORNP ;;; RFNAME - Read File Names ;;; Prompts with the default and reads new filename. ;;; Sets up filename block in B RFN"$$RFN==:1 RFN"$$RUC==:1 .INSRT DSK:SYSENG;RFN RUC: CALL TYI JRST RUC MOVE A,T CAIL A,"a CAILE A,"z RET SUBI A,"a-"A RET RSIXTP: CAIE A,177 CAIN A,33 AOS (P) RET RFNAME: PUSHER P,[A,C,D,E] RFNM1: TYPE T,"~& ~F ",B CALL RFN"RFN CAIE A,177 CAIN A,33 JRST RFNM1 POPPER P,[E,D,C,A] RET SUBTTL Crufty LPT routines NOLPT: 0 ;-1 for no LPT LPBUST: 0 ;-1 LPT is busted don't keep asking ;;; UPLPT - Up your LPT! UPLPT: LPT,[ .ERR If you want to use the LPT, you'll have to fix this code. SKIPE LPBUST ;If known to be busted JRST UPLP9 ; flush this noise. SKIPE NOLPT ;If no LPT wanted JRST UPLP9 ; don't bother loser again. SETOM NOLPT ;Assume no LPT wanted. SETOM LPFRST' ;Find out what user wants. ASKYN "Want LPT" CAIA TS,[ JRST [ASKYN "~&Want LPT output to DSK?" CALRET [ SYSCAL OPEN,[%CLBIT,,.UAO %CLIMM,,LPTC [SIXBIT /LPT/]] .LOSE %LSFIL SETZM NOLPT SETZM LPBUST RET ] SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LPTC [SIXBIT /DSK/] [SIXBIT /NSALV/] [SIXBIT /OUTPUT/]] .LOSE %LSFIL RET ] ];TS LPTUP2: NTS, LOSE "~&Only REAL programmers use line printers." ];LPT UPLP9: RET SUBTTL Misc. POPJ1: AOS (P) CPOPJ: RET POPBAJ: POP P,B POPAJ: POP P,A RET POPBJ: POP P,B POPJ P, POPTJ: POP P,T RET CONTIN: ASKYN " Continue" RET JRST POPJ1 UUOHLT: KA, 0 ;KA10 JSRs here. LOSE "~&UUO in Salvager??" KL, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[PFOPC,EPTPFW] KS, SALVPF: LOSE "~&Page failure in Salvager. PC=~H PFW=~H",[EPTPFO,EPTPFW] ERRDDT: TYPE T,"~&*** ERROR *** THE SYSTEM MAY NOT BE BROUGHT UP" ERRDD1: SETZM SALVRT ;Can't return to system. TODDT: TYPE T,"~2&" ;Get us to a fresh line please. SKIPE SALVRT ;If invoked from another system JRST @SALVRT ; jump back into it. TYPE T,"DDT" SKIPN DDT ;Something where DDT should be? HALT . ; No. JRST DDT ;Yes - imagine it is DDT and jump into it. ZAPLUZ: LOSE "Lossage." ;Quick and losing way to DDT. TS,[ DDT: .BREAK 16,100000 JRST DDT ];TS SUBTTL Main Program ;;; Vector Of Mysteries (in case up creek without symbol table) GOGO: JRST [ JSR INIT ? JRST GOGO2 ] SALVAG: JRST [ JSR INIT SETOM NOQUES ;If started by BEG$G in ITS, be fast JRST GOGO2 ] ;(no routine typeout) CHKR: JRST CHKR0 NOP LPBUST ;-> LPT BUSTED FLAG NOP NOQUES ;-> NO QUESTIONS FLAG NOP GOODUN ;-> ONLY RTN THAT KNOWS WHICH ARE "RIGHT" PACKS NOP GETSTS ;-> ROUTINE TO TYPEOUT CURRENT DISK STATUS NOP DSKTST ;-> SIMPLE READ/WRITE TEST NOP SEKTST ;-> SIMPLE SEEK TEST (READ ONLY) NOP DUP ;-> DISK COPYING ROUTINE NOP HCRASH ;-> AS FAST AS POSSIBLE FLAG INIT: 0 ACINIT TS,[ .CLOSE TTYI, ;If under timesharing, open TTY. .CLOSE TTYO, SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]] .LOSE %LSFIL SYSCAL OPEN,[%CLBIT,,.UAO+%TJDIS ? %CLIMM,,TTYO ? [SIXBIT /TTY/]] .LOSE %LSFIL ];TS NTS,[ KA,[ CONO 675550 ;Reset APR CONO PI,710000 ;Reset PI MOVE TT,[JSR UUOHLT] ;Halt on UUOs. SKIPN 41 MOVEM TT,41 MOVEI A,SA ;Ensure all necessary memory is present. INIT0: MOVE B,(A) CONSZ 10000 LOSE "~%NXM in Salvager memory" ADDI A,2000 CAIGE A,THEEND JRST INIT0 ];KA KS,[ CLRCSH ;Clear the cache. WRPI PICLR\PIOFF ;Turn off interrupts. WRHSB [HSB] ;Set up the halt status block. WREBR 400000+ ;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. ;;; Index the table with a virtual unit number to get the physical unit. ;;; RH of entry is physical drive. ;;; "4.9 means second half ;;; (No longer does anything, now that Memowrecks have been ;;; flushed, but keep around in case ever needed again.)" .SEE QCNVT QTRAN: DC,[ 0 ? 1 ? 2 ? 3 ? 4 ? 5 ? 6 ? 7 ] .ELSE REPEAT NDRIVE, .RPCNT IFN .-QTRAN-NUNITS,.ERR BARF AT QTRAN!! QTTBLI: REPEAT 36./TUTBYT+1, 440000+TUTBYT_6-TUTBYT_12.*.RPCNT,, QTTBL=QTTBLI+1 TS,[ NQS: 0 ;System's number of drives SQACT: 0 ;Location of QACT in ITS ];TS NBLKS-1 ;SNBLKS-1 SNBLKS: NBLKS ;System NBLKS (init'ed in TS) DRIVE: REPEAT NDRIVE,-1 ;-1 if drive on line QACT: REPEAT NUNITS,-1 ;-1 if unit active .SEE ACTUN QPKN: REPEAT NUNITS,-1 ;Pack # according to TUT .SEE FINDPK PKNUM: BLOCK NUNITS ;Pack # according to hardware DC,[ RPKID: 0 ] CONS==. CONSTANTS VARS==. VARIABLES IF2, .CRLF IF2, SAYSIZ .-VARS,variables IF2, SAYSIZ VARS-CONS,constants LOC <<.+PG$SIZ-1>/PG$SIZ>*PG$SIZ ;Round up to page boundary IF2, INFORM Buffers begin at ,\. IRP A,,[OTUT,NTUT] Q!A!O: REPEAT NUNITS,CONC A,\.RPCNT, TERMIN CYLBUF==:<.+1777>&776000 CYLPAG==:CYLBUF/PG$SIZ LOC CYLBUF OUSRD: BLOCK 2000 ;Old UFD NUSRD: BLOCK 2000 ;New UFD FDBUF: BLOCK 2000 ;File block buffer MFD: BLOCK 2000 ;MFD MAGBUF: BLOCK 2000 ;Magtape buffer IRPS A,,OTUT NTUT ;Old and New TUTs for each unit: REPEAT NUNITS,CONC A,\.RPCNT,: BLOCK 2000*MXTUTB TERMIN D0==OTUT0 IFDEF OTUT1,D1==OTUT1 .ELSE D1: BLOCK 2000*MXTUTB TUT=NTUT0 DC, CYLSIZ=NBLKSC*2004 RH, CYLSIZ=SECTOR*NHEDS*NSECS PH, CYLSIZ=NBLKSC*2000 RP, CYLSIZ=NBLKSC*2000 NTS,IFL .-CYLBUF-CYLSIZ,LOC CYLBUF+CYLSIZ THEEND: ;For KA10s (R.I.P.) we must fit in 128K to avoid hitting possible holes. ;For KL10 there can never be holes in the low 256K anyway. ;For KS10s we will never run the machine with less than 512K anyway. IF2,[ ;; Last gasps... INFORM Start addr = ,\SA , Highest addr used = ,\THEEND SAYSIZ .-SA,words long IFG THEEND-400000, .ERR Note: Salvager is too moby for 128K ;;; This MUST be last! Since it makes the symbols in question useless ;;; except for use in DDT: KL, PAG=- 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: