1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-16 08:24:38 +00:00
PDP-10.its/src/syseng/dump.445
Lars Brinkhoff 24805a659d Add new ITS named "KL", which is a KA10 with RH10.
The reason for this confusion is that it is intended in the future to
become a KL10.
2019-06-28 18:10:43 +02:00

8744 lines
189 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

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

;-*- Mode:MIDAS -*-
TITLE DUMPER
.SYMTAB 11657.,5000. ;be-bip be-beh
SUBTTL AC, DIRECTORY DEFINITIONS
ZR=0
A=1
B=2
C=3
D=4
E=5
N=6
SYM=7
TER=10
RTAPE"T=SYM
RTAPE"TT=TER
NETWRK"T=SYM
NETWRK"TT=TER
U=11
V=12
W=13
X=14
USRUFD=15
P=17
IF1,[
PRINTX /WHICH MACHINE? /
.TTYMAC A
.TTYFLG==.TTYFLG+1
PRINTX/A
/
.TTYFLG==.TTYFLG-1
;When using this macro, also check the WRONG flag if you really care
DEFINE MCOND B
<IFSN A,B,[1]>,TERMIN
MCHN==SIXBIT/A/
TERMIN
]
NEWCOD==1 ; Assume a KS unless otherwise informed
IFE MCOND MX, NEWCOD==0 ;Use old code on MX KL only (running old ITS)
IFE MCOND KA, NEWCOD==0 ;Use old code on KA and KL too
IFE MCOND KL, NEWCOD==0
DEFINE SYSCAL OP,ARGS
.CALL [SETZ ? SIXBIT/OP/ ? ARGS ((SETZ))]
TERMIN
;GET DEFINITION OF SYMBOLS FOR DIRECTORY FORMAT
.INSRT SYSTEM;FSDEFS >
;THESE PARAMETERS CONTROL THE 'SYSENG; MACRO TAPES' FILE.
;DON'T CHANGE THESE IF YOU'RE NOT RJL
;AND EVEN THEN YOU SHOULD BE CAREFUL
MAXTAP==3000. ;MAXIMUM TAPE NUMBER +1
IFE MCOND AI, MAXTAP==4000. ;EVEN THOUGH I'M NOT RJL
IFE MCOND MX, MAXTAP==5000. ; I'm not RJL either... -Alan
TPINFL==10. ;NUMBER OF WORDS OF INFO PER TAPE
SUBTTL I/O CHANNEL, UUO DEFINITIONS
MFDCH==1 ;MASTER FILE DIRECTORY INPUT
UFDCH==2 ;FILE DIRECTORY INPUT
DSKIN==3 ;DISK INPUT
MAGOUT==4 ;MAG TAPE OUTPUT
TYIC==5 ;TTY INPUT
TYOC==6 ;TTY OUTPUT
DSKOUT==7 ;DISK OUTPUT
MAGIN==10 ;MAG TAPE INPUT
LPTCH==11 ;LPT OR TPL OUTPUT
ERRC==12 ;ERR DEVICE INPUT
STATC==13 ;TAPE STATUS STORED ON DISK
SAVET==14 ;SAVED TAPE FILE NAMES
SNPLCH==15 .SEE SNPLACE
RTAPE"RSICH==16
RTAPE"RSOCH==17
LPDL==100 ;LENGTH OF PDL
LPAT==1000 ;LENGTH OF PATCH AREA
BUFSIZ==5
PAGSIZ==2000
RPCNT==0
UUOTAB: ;THIS TABLE GENERATED BY FOLLOWING IRP
IRP X,,[PSIS,PDPT,POCT,PERR,PASC,SIXTYP,OPEN]
RPCNT==RPCNT+1
IRPS Y,,X
Y=RPCNT_33
.ISTOP
TERMIN
LOC UUOTAB+RPCNT-1
A!X
TERMIN
LUUOTB==RPCNT
IFG LUUOTB-37,.ERR TOO MANY UUOS DEFINED
;PRINT A FIXED STRING ON LPT (IF LPTSW) OR ON TTY
DEFINE PRINT ARG
PASC [ASCIZ \ARG\]
TERMIN
;PRINT A STRING THEN ERR OUT
DEFINE DIE ARG
PERR [ASCIZ /ARG/]
TERMIN
;PRINT SOME FILE NAMES
DEFINE PRTFNS
PRINT _
PSIS SNAME
PRINT [;]
PSIS FN1
PSIS FN2
TERMIN
SUBTTL MISCELLANEOUS VARIABLES
ZZ==.
LOC 41
JSR UUOH
JSR INT
LOC ZZ
TYIPD: 0 ;DEPTH IN IO-PUSHES ON TYIC
DISPLY: 0 ;0 => HARD COPY, 1 => SCREEN
PRNAM1: .FNAM1 ;PROGRAM NAME
PRNAM2: .FNAM2 ;PROGRAM VERSION NUMBER
WRONG: 1 ;0 => ON RIGHT MACHINE, -1 => ON WRONG MACHINE
GARBAG: 0 ;READ INTO HERE TO IGNORE
ERRPDP: 0 ;PDL LEVEL AT ADMP4
CTRLG: 0 ;0 NORMAL, -1 DEFER CONTROL-G, +1 DEFERRED CONTROL-G PENDING
MYNAME: 0 ;ORIGINAL SNAME
USNM: SIXBIT /FIRST/ ;CURRENT SNAME
LUSNM: 0 ;LAST USER NAME DUMP COMPLETED FOR
FUSNM: 0 ;FIRST USER NAME ON TAPE
RFDATE: 0 ;REFERENCE DATE
UNRNDW: 0 ;UNRNDM WORD FROM RRDATE SYSTEM CALL
NTAPES: -1 ;NUMBER OF REEL IN CURRENT DUMP, -1==> WE DON'T KNOW THIS PARAMETER
FDATE: 0 ;CREATION DATE OF FILE
AUTHOR: 0 ;AUTHOR OF FILE
BLOCKS: 0 ;BLOCKS IN UDIR
QUOTA: 0 ;QUOTA OF UDIR
OFINDF: 0 ;-1 IF DOING AN OFIND, 0 OTHERWISE
TEST1: TDNN B,(A) ;SORT TEST 1
TEST2: TDNE B,(C) ;SORT TEST 2
UFDDAT: -1 ;DATE OF UFD INPUT
MFDDAT: -1 ;DATE OF MFD INPUT
DMPMFD: 0 ;DUMP MFD IF -1
DMPUFD: 0 ;DUMP UFD IF -1
DMPDIR: 0 ;OR OF DMPUFD AND DMPMFD
DMPLNK: 0 ;-1 => DUMP LINKS
RELOSW: 0 ;-1 IF DOING A RELOAD
;CAUSES DUMPBIT, REAPBIT, AUTHOR, AND REFDATE OF LOADED
; FILE TO BE RESTORED FROM TAPE COPY OF UFD. ALSO,
; CAUSES TAPE UFDS TO BE READ, LINKS TO BE RESTORED,
; DUMPBIT, REAPBIT, AUTHOR, REFDATE TO BE RESTORED,
; AND CAUSES OLD FILES ON DISK BUT NOT ON TAPE-UFD
; TO BE DELETE, THUS RESTORING THE FILE SYSTEM COMPLETELY.
PDIRSW: 0 ;-1 => PRINT DIRECTORY FROM TAP AT MAGOP1.
MRGSW: 0 ;-1 => MERGE (I.E. NEVER LOAD OVER ANY EXISTING FILE)
;0 => BASE ON VARIOUS OTHER CRITERIA.
CAREF: 0 ;-1 DONT OVERWRITE FILES WHICH HAVEN'T BEEN DUMPED
LOSRSW: 0 ;-1 SORRY MODE, ALWAYS WRITE OVER EXISTING COPIES IN LOAD
;0 => DON'T WRITE OVER FILES WITH NEWER DATE. (ASK FIRST)
NOASK: 0 ;-1 => DON'T ASK QUESTIONS
APPENF: -1 ;-1 => NO FILES DUMPED FOR CURRENT USER YET
LDPACK: -1 ;NON-NEGATIVE => PACK# OF SINGLE PACK BEING RELOADED, IGNORE
;FILES ON OTHER PACKS, DELETE NEW FILES ON THIS PACK SINCE
.SEE DIRUPN ;NOT REALLY THERE (SEE DIRUPN)
.SEE DIRU2 ;ALSO
;IF YOU USE THE LDPACK FEATURE, USE THE 'RELOAD L SORRY'
; COMMAND OR YOU WILL BE SORRY.
BBPACK: -1 ;LIKE LDPACK, BUT DOESNT MUNGE DISK DIRECTORIES BECUZ WE ASSUME
;THEY ARE CORRECT. DOESNT DELETE ANYTHING.
DEADPK: -1 ;Non-negative => Number of pack lost in head crash that
; left the rest of the filesystem OK. Files referenced on
; this pack from existing UFD's need to be restored.
CRDIR: 0 ;-1 TO CREATE DIRECTORIES WHEN LOADING FILES FROM TAPE
FILN: 0 ;FILE NUMBER IN FIND (I.E. SEQUENCE NUMBER ON TAPE)
FLNI: -1 ;-1 FIRST TIME THRU FNG (NEED TO OPEN FILE DIRECTORY)
;SETOM THIS WHEN CHANGING THE SNAME.
GFRFQ: -1 ;FIRST TIME FLAG FOR QUOTA PRINTOUT
FCDMAP: 0 ;-1 => MEANS WE HAVE MAPPED IN CORE PAGES FOR BUFFER
.SEE FCDMP
MFDIN: -1 ;-1 FIRST TIME THRU M.F.D. (NEED TO OPEN M.F.D.)
ITAPE: -1 ;-1 IF JUST REWOUND (NEED TO READ/WRITE TAPE-HEADER)
TAPTYP: 0 ;1 LOCAL, -1 REMOTE, -2 REMOTE AND MOUNTED, 0 NOT DECIDED YET
TAPHST: BLOCK 2 ;ASCIZ HOST FOR REMOTE TAPE
TAPDRV: BLOCK 2 ;ASCIZ DRIVE NAME
TAPDIR: BLOCK 2 ;ASCIZ READ, WRITE, OR BOTH
RMTUSR: BLOCK 2 ;ASCIZ REMOTE USER NAME
RMTPSW: BLOCK 2 ;ASCIZ REMOTE PASSWORD
TAPEF: 0 ;HOLDS TAPE STATUS (IFN NEWCOD,[ .STATUS ] .ELSE CONI 344,)
IFE NEWCOD,[
TF%BOT==100000 ;BEGINNING OF TAPE
TF%EOT==4000 ;PHYSICAL END OF TAPE
TF%EOF==10000 ;END OF FILE SEEN
TF%RDY==40 ;DRIVE ONLINE AND NOT BUSY
];IFE NEWCOD
IFN NEWCOD,[
TF%BOT==4000 ;BEGINNING OF TAPE
TF%EOT==10000 ;PHYSICAL END OF TAPE
TF%EOF==200000 ;END OF FILE SEEN
;--- This is wrong, JTW seems to have misunderstood this bit in the old code
;--- really need a drive on-line indication
;--- but OPEN returns an error if it's not on-line
TF%RDY==100000 ;DRIVE ONLINE AND NOT BUSY
];IFN NEWCOD
LFDIR: 0 ; STORAGE FOR LAST FILE POINTER (IN FIND)
TFIL: BLOCK LUNBLK ; TEMPORARY STORAGE FOR FILE SORT IN FIND
MTCMD: 0 ;STORAGE FOR .MTAPE
MAGOPN: 0 ; 0=> MAGOUT NOT OPEN,-1=> OPEN
GTSYNF: 0 ; GETSYL NEGITIVE FLAG
GTSYCC: 0 ;GETSYL NUMBER OF CHARACTERS
LNKFLG: 0 ;-1=>DUMPING OR LOADING A LINK
DMPMOD: 0 ;-1 DUMPING, 0 RETRIEVING
TCOPYF: 0 ;-1 => COPYING TAPES
OTAPE: 0 ;OUTPUT VERSION OF ITAPE, IN TCOPY
DPACK: 0 ;PACK TO DUMP OR -1 IF ALL
INCREM: 0 ;-1 DUMP INCREMENTAL, 0 ALL FILES
FULLDMP:0 ;-1 FULL DUMP, 0 SPECIFIC FILES
MICFLG: 0 ;-1 MICROTAPE, 0 DISK [NOTHING SETS THIS] *******
LPTSW: 0 ;-1 LPT OR TPL OUTPUT ON, 0 OUTPUTTING TO TTY
EOTFLG: 0 ;-1 WHEN HIT EOT ON READ, RESET BY REWIND [NOTHING LOOKS AT THIS] *******
EXPERM: 0 ;-1 WHEN ONLY EXPERIMENTING => .DMPCH NOT SET, BYPASS LCHECK
CKIDMP: 0 ;0=> CHECK INCREMENTAL DUMPS (SET TO -1 BY 'NO' OPTION)
REAPSW: 0 ;-1 IF A REAP TO BE DONE AFTER DUMP
NFTDMP: 0 ;NUMBER OF FILES THIS DUMP OR THIS TAPE, WHICHEVER IS SMALLER.
CDMFL: 0 ;-1 CONTINUE A FULL DUMP FROM GIVEN USER, 0 ORDINARY DUMP
LSTWHL: 0 ;-1 LIST WHILE DOING DUMP OR LOAD
CHKFLG: 0 ;-1 CHECK OPERATION, 0 DUMP/LOAD
DECIDF: 0 ;-1 DECIDE WHICH TAPES TO USE [NOTHING LOOKS AT THIS] *******
DATEF: 0 ;-1 DUMP ONLY FILES WITH CREATION DATES GREATER THAN OR EQUAL TO DATE
DATESF: 0 ;-1 DUMP ONLY FILES BETWEEN TWO DATES
DATE: 0 ;STORAGE FOR ABOVE
DATE1: 0 ;STORAGE FOR UPPER BOUND IF THERE IS ONE
ARCHVF: 0 ;-1 CALL THIS AN ARCHIVE
DEVICE: 0 ;DEVICE IF SPECIFIED [THIS IS NEVER USED] *******
SUPERC: 0 ;-1 TO SUPPRESS DATA ERROR MESSAGES (USED BY CHECK)
BASE: 10. ;OUTPUT BASE IN DPT/DOT ROUTINE
FLENTH: 0 ;FILE LENGTH
RDERR: 0 ;-1 => READ DATA ERROR OCCURRED
PHYEOT: 0 ;-1 => PHYSICAL END OF TAPE
;TABLE OF "SECONDARY" DISKS.
;THESE ARE THE SAME AS IN ITS
NQS==10
QPKID: BLOCK NQS ;PACK NUMBER
QRESRV: BLOCK NQS ;PACK NAME OR RESERVED FLAG
;BIT MASK FOR THE PACK NUMBERS OF SECONDARY DISKS
SECMSK: 0 ;SET UP AT SETSCM
PRIMSK: 0 ;THE PRIMARY DISKS
;WORDS USED BY CHECKER
ERRCNT: 0 ;ERRORS ENCOUNTERED THIS FILE ON TAPE IN
ERRDSK: 0 ;ERRORS ENCOUNTERED THIS FILE IN DISK IN
PNTALL: 0 ;-1 TO PRINT ALL FILES AS THEY GO
ERRALL: 0 ;SET IF ANY ERRORS HAPPENED
NEWCHR: 0 ;DUMP CHARACTER FOR THIS FILE
WRDONG: 0 ;COUNT OF BAD WORDS
LNTCNT: 0 ;DIFFERENCE IN LENGTH OF TWO FILES
ALLWRD: 0 ;TOTAL WORDS ON THIS REEL SO-FAR
LENGTH: 0 ;NUMBER OF FILE SPECS TYPED IN BY USER AND NOT
; SATISFIED YET. ALSO LENGTH OF TAPE FILE IN FNDCON.
EOFF: 0 ;EOF FLAG FOR TAPE FILES ON DISK. USED IN AFIND COMMAND
DIRIDX: 0 ;POINTER TO FILE DIRECTORY BUFFER(FDIRBF)
BARROW: 0 ;BACK-ARROW FLAG
ACLODF: 0 ;-1 => GOT TO EXECU VIA ACLOAD, DON'T ASK FOR FILES
TTYST1: 0 ;TTY VARS
TTYST2: 0
TTYSTS: 0
DKMFDP: 0 .SEE DKAUTH ; -1 If DSKMFD is in
DKUFDP: 0 .SEE DKLOOK ; SIXBIT of DSKUFD currently in
DKBLK: 0 .SEE DKBLKF ; Saved name block pointer for DKBLKF
LLIST==200. ;NUMBER OF FILE SPECS ALLOWED
IRP Y,,[TO,FM]
IRP X,,[DEV,SNM,FN1,FN2]
Y!!X: BLOCK LLIST
TERMIN
TERMIN
FMDUMP: BLOCK LLIST ;-1 => THIS SPEC SATISFIED AT LEAST ONCE.
IRP X,,[DEV,SNM,FN1,FN2]
TIN!X: 0 ;HOLDS SPECS FOR FILGET
TERMIN
IRP X,,[DEV,SNM,FN1,FN2]
TYN!X: 0 ;HOLDS SPECS FOR FILGET
TERMIN
DAYTIM: 0 ;HOLDS CREATION DATE AND TIME OF FILE DURING FIND COMMAND
PSNAM: 0 ;SNAME TO BE PRINTED BY FIND COMMAND
PFF1: 0 ;FILE NAME TO BE PRINTED BY FIND COMMAND
PFF2: 0 ;..
WRDCNT: 0 ;COUNT OF WORDS IN FILE
SAVAOB: 0 ;AOB OF FIRST BAD WORD
INTAC: BLOCK 20 ;SAVED ACS DURING INTERRUPT
GREATF: -1 ;0 ==> > FILE HACKED DURING DUMP
THBLK: -LTHBLK,,0 ;TAPE-HEADER-BLOCK
THTPN: -1 ;TAPE NUMBER,,NUMBER OF REEL IN THIS DUMP, -1==> WE DON'T YET KNOW THIS PARAMETER
THDATE: 0 ;TAPE CREATION DATE (SIXBIT)
THTYPE: 0 ;0 RANDOM, >0 FULL DUMP, <0 INCREMENTAL DUMP
LTHBLK==.-THBLK
LTHTPN: -1 ;LAST THTPN
HBLK: -LHBLK,,0 ;FILE-HEADER-BLOCK
HSNM: 0 ;SYS NAME
HFN1: 0 ;FN1
HFN2: 0 ;FN2
LHBLKZ==.-HBLK ; Must be at least this long
HPKN: 0 ;LINK FLAG,,PACK NUMBER (SAME INFO AS 3RD VALUE FROM
; FILBLK, BUT IN A DIFFERENT FORMAT)
HDATE: 0 ;CREATION DATE AND TIME OF FILE ON DISK (DISK-FORMAT) (4TH
; VALUE FROM FILBLK)
; Next two added 7/14/89 by Alan
HRDATE: 0 ;REFERENCE DATE, AUTHOR INDEX, BYTE SIZE AND BYTE COUNT
; (5TH VALUE FROM FILBLK)
HLEN: 0 ;LENGTH OF FILE IN WORDS (FROM FILLEN)
LHBLK==.-HBLK ; Must not be longer than this
HFNL: 0
STAPST: ;BLOCK OF DATA STORED ON DISK FOR TAPE STATUS (IN SYSENG;MACRO TAPES)
STAPEN: 0 ;TAPE NUMBER,,REEL NUMBER
STDATE: 0 ;DATE TAPE LAST WRITTEN
STYPE: 0 ;TYPE OF DATA LAST WRITTEN AS THTYPE ABOVE
SFUSNM: 0 ;FIRST USER ON THIS TAPE
SLUSNM: 0 ;LAST USER ON THIS TAPE
SUSER: 0 ;UNAME OF PERSON WHO DUMPED THIS TAPE
SDONE: 0 ;ZERO IF DUMP NOT COMPLETED,-1 REGULAR, 1 ARCHIVE
BLOCK TPINFL+.-STAPST
INTERR: SIXBIT /DEVICE/ ;USED FOR DISK ERROR ANALYSIS
SIXBIT /RANDOM/
SIXBIT /FILE/
SIXBIT /LOSER/
SUBTTL OPEN-BLOCKS, .CALL BLOCKS
LPTO: SIXBIT / !LPT/ ;OUTPUT TO LPT (AND TPL ETC.)
SIXBIT /WALL/
SIXBIT />/
0
0 ;LEAVE THESE HERE !!!!
MAGI: 26,,(SIXBIT /MT0/) ; BLOCK IMAGE, DON'T FLUSH TO EOF ON CLOSE
SIXBIT /MACRO/
SIXBIT /IN/
0
0 ;LEAVE ALONE
MAGO: SIXBIT / 'MT0/ ;OUTPUT TO MAG-TAPE
SIXBIT /MACRO/
SIXBIT /OUT/
0
0
MFO: (SIXBIT /DSK/) ;MASTER FILE DIRECTORY IN
SIXBIT /M.F.D./
SIXBIT /(FILE)/
0
0
FNO: SIXBIT / &DSK/ ;FILE DIRECTORY IN
SIXBIT /.FILE./
SIXBIT /(DIR)/
0
0
CRUFD: SIXBIT / DSK/
SIXBIT /..NEW./
SIXBIT /(UDIR)/
TRNI: SIXBIT / &DSK/ ;INPUT FROM DISK
FN1: 0 ;FILE NAME 1
FN2: 0 ;FILE NAME 2
SNAME: 0
0 ;HERE IN CASE OF .FDELE TRNI
;***** ***** KEEP THESE NEXT 6 LOCATIONS TOGETHER FOR LINK INFO *****
LNKBLK: 200000,,(SIXBIT /DSK/)
0
0
LNKNM1: 0 ; LINK FN1
LNKNM2: 0 ;LINK FN2
PACKN: 0 ;PACK NUMBER OR SNAME IN LINK IF LEFT HALF NON ZERO
;****** ***** *****
CPYO: SIXBIT / #DSK/ ;OUTPUT TO DISK
LFN1: 0
LFN2: 0
0
0
ERROP: 0,,(SIXBIT/ERR/)
1
0
0
0
SPLACE: SIXBIT /SYSENG/ ;PLACE TO STORE MACRO TAPES
STATOP: SIXBIT / DSK/ ;FILE TO SAVE TAPE DATA IN
SIXBIT /MACRO/
SIXBIT /TAPES/
0
0
USRDEL: 0 ;FOR .FDELE
0
0
NPLACE: SIXBIT /.TAPE0/ ;TAPE DIRECTORY DIRECTORY, OR 0 IF HAVEN'T DECIDED YET
NSVOP: SIXBIT / 'DSK/
SIXBIT /TAPE/
NSVTPN: 0
0 ;FOR .FDELE
0
0
TDIRN: 0 ;CURRENT INDEX IN TDIRTB
SNBUF: BLOCK UDNAMP+1 ;USED TO GET UDNAMP TO ESTIMATE DIR FULLNESS
SNTRY: SETZ
SIXBIT /OPEN/
3000,,E
MOVEI SNPLCH
[SIXBIT/DSK/]
[SIXBIT/TAPE/]
SNTRYN
SETZ TDIRTB(A)
SNTRYN: 0
RUSN: 0 ;NAMES USED IN SINGLE FILE RESTORE
RFN1: 0
RFN2: 0
0
0
CUSN: 0 ;CURRENT USER NAME USED WHEN LSTWHL IS ON
RDATE: SETZ
SIXBIT /RFDATE/
[DSKIN]
SETZ FDATE(2000)
RQDATE: SETZ
SIXBIT /RQDATE/
SETZM HDATE
SDATE: SETZ
SIXBIT /SFDATE/
[DSKOUT]
SETZ FDATE
SRDT: SETZ
SIXBIT /SRDATE/
[DSKOUT]
SETZ RFDATE
FILLEN: SETZ
SIXBIT /FILLEN/
[DSKIN]
SETZM LENGTH
FILBLK: SETZ
SIXBIT /FILBLK/
[DSKIN]
2000,,0
2000,,0
2000,,0
2000,,FDATE
SETZM RFDATE
SRFDAT: SETZ
SIXBIT /SRDATE/
[DSKIN]
SETZ RFDATE
CLBIT: SETZ
SIXBIT /SDMPBT/
[STATC]
SETZ [0]
RESRDT: SETZ ;RESTORE REF DATE
SIXBIT /RESRDT/
SETZ [DSKIN]
RRDATE: SETZ
SIXBIT /FILBLK/
1000,,DSKIN
2000,,0
2000,,0
2000,,UNRNDW
2000,,0
402000,,RFDATE
CREFDT: SETZ ;COPY REF DATE INTO FDATE
SIXBIT /SFDATE/
[DSKIN]
SETZ RFDATE
RHDATS: SETZ
SIXBIT /FILBLK/
MOVEI DSKIN
MOVEM 0 ; FN1
MOVEM 0 ; FN2
MOVEM 0 ; RND
MOVEM HDATE
SETZM HRDATE
RHLEN: SETZ
SIXBIT /FILLEN/
MOVEI DSKIN
SETZM HLEN
TTYGET: SETZ
SIXBIT /TTYGET/
MOVEI TYOC
MOVEM TTYST1
MOVEM TTYST2
SETZM TTYSTS
TTYSET: SETZ
SIXBIT /TTYSET/
MOVEI TYOC
TTYST1
TTYST2
SETZ TTYSTS
TRRDFO: SETZ ;OPEN BLOCK FOR INDIRECT COMMAND FILES FROM DISK
SIXBIT /OPEN/
1000,,TYIC
TINDEV
TINFN1
TINFN2
SETZ TINSNM
SUBTTL UUO HANDLER
UUOH: 0
PUSH P,40
PUSH P,UUOH ;FOR RECURSIVE UUOS
PUSH P,A
PUSH P,B
PUSH P,C
LDB C,[330600,,40] ;OP CODE
CAILE C,0
CAILE C,LUUOTB
.VALUE ;ILLEGAL UUO
PUSHJ P,@UUOTAB-1(C)
CAIA ;REGULAR RETURN
JRST SKPRET ;SKIP RETURN
POP P,C
POP P,B
POP P,A
POP P,UUOH
POP P,40
JRST 2,@UUOH
SKPRET: POP P,C
POP P,B
POP P,A
POP P,UUOH
POP P,40
AOS UUOH
JRST 2,@UUOH
;MTAPE UUO. AC IS OPERATION, E IS SUBCOMMAND.
;THIS IS NEVER USED, TAKES THE WRONG ARGUMENTS, AND DOESN'T
;WORK SINCE IT USES THE 'MTAPE' SYMBOLIC SYSTEM CALL,
;WHICH DOES NOT EXIST!! *******
;
;AMTAPE: PUSH P,40 ;PUSH OF 40 IS SUPERFLUOUS *******
; OPEN MAGIN,MAGI
; JRST RET
; POP P,40
; LDB A,[270400,,40] ; SPACE, DO SOMETHING ELSE, OR SET MODE(S)
; HRRZ B,40 ;SUBCOMMAND
; .CALL TAPBLC
; .LOSE 1000
; POPJ P,
;
;TAPBLC: SETZ
; XWD SIXBIT / MTA/,SIXBIT / PE/ ;SO NMTAPE WILL NOT FIND THIS
; [MAGIN]
; A
; SETZ B
;PSIS UUO. PRINT A SPACE THEN A SIX CHARACTER SIXBIT WORD.
APSIS: PUSHJ P,TYOS
;SIXTYP UUO. PRINT A SIX CHARACTER SIXBIT WORD.
ASIXTYP:MOVE B,@40
JRST SIXTYO
;DPT UUO. PRINT A DECIMAL NUMBER RIGHT-JUSTIFIED IN 6 COLUMNS.
;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS!
APDPT: MOVE C,-1(P) ;PRINT DECIMAL NUMBER
MOVE A,@40
PUSHJ P,ADJUS
JRST DPT
ADJUS: PUSH P,A ;'FIXED' FORMAT HACK
MOVM B,A
SKIPN B
MOVEI B,1
MOVEI C,10000.
SKIPGE A
IDIVI C,10. ;FOR THE MINUS SIGN
ADJUS1: PUSHJ P,TYOS
CAML B,C
JRST POPAJ
IMULI B,10.
JRST ADJUS1
;POCT UUO. PRINT SIGNED OCTAL NUMBER, PRECEDED BY SPACE.
;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS!
APOCT: MOVE C,-1(P) ;PRINT OCTAL NUMBER
PUSHJ P,TYOS
MOVE A,@40
JRST DOT
;PERR UUO. MAINLY FOR DIE MACRO.
APERR: SETZM LPTSW ;SURELY THESE SHOULD NOT GO INTO WALLPAPER FILE
PUSHJ P,APASC ;PRINT ASCII AND DIE
JRST ERR
;OPEN UUO. LIKE .OPEN, BUT IF IT FAILS GIVES MESSAGE ON TTY.
AOPEN: MOVEI A,<.OPEN_-27.>
MOVE B,40
DPB A,[331100,,B]
MOVSI C,10 ;DO NOT SET REFERENCE DATE ON DSKIN
LDB A,[270400,,B]
CAIN A,DSKIN
IORM C,@40
SETZM A
XCT B
SETOM A
LDB B,[270400,,B]
CAIN B,DSKIN
ANDCAM C,@40
SKIPN A
JRST POPJ1 ;SUCCEEDED
PUSH P,LPTSW
SETZM LPTSW ;TYPE ERROR MESSAGE ON TTY
PUSH P,40
HRRZ B,UUOH
SOS B
POCT B ;PC OF OFFENDING OPEN
POP P,A
.SUSET [.RSNAM,,B]
PUSHJ P,TELL
POP P,LPTSW
POPJ P,
;ALSO CALLED FROM INT4 (DISK DATA ERROR)
TELL: PSIS (A)
PRINT :
PSIS 1(A)
PSIS 2(A)
PSIS B
PASC [ASCIZ /;/]
PUSHJ P,OPINFL
JRST CRR
OPINFL: PUSH P,A ;ANALYZE IOC ERROR
.OPEN ERRC,ERROP
.VALUE ;LOSING COMPLETELY!
MOVEI A,40 ;SPACE
ERRLOP: PUSHJ P,TYO
.IOT ERRC,A
CAIL A,40
JRST ERRLOP
.CLOSE ERRC,
PUSHJ P,CRR
POPAJ: POP P,A
POPJ P,
;PASC UUO. MAINLY FOR PRINT MACRO.
APASC: MOVE B,40 ;PRINT ASCIZ STRING
HRLI B,440700
PRINL5: ILDB A,B
JUMPE A,CPOPJ
CAIN A,^Q ;CONTROL-Q TURNS OFF UNDERSCORE MISFEATURE
JRST [ ILDB A,B ? PUSHJ P,TYO ? JRST PRINL5 ]
CAIN A,"_ ;UNDERSCORE GETS MAPPED INTO CR-LF
JRST [ PUSHJ P,CRR ? JRST PRINL5 ]
PUSHJ P,TYO
JRST PRINL5
SIXTYO: MOVE C,[440600,,B] ;TYPE 6 SIXBIT CHARACTERS
SIXTY1: ILDB A,C
ADDI A,40
PUSHJ P,TYO
TLNE C,770000
JRST SIXTY1
POPJ P,
DOT: SKIPA B,[8]
DPT: MOVEI B,10.
MOVEM B,BASE
JUMPL A,NDPT
DPT1: IDIV A,BASE ;DECIMAL OUTPUT ROUTINE
HRLM B,(P)
SKIPE A
PUSHJ P,DPT1
HLRZ A,(P)
ADDI A,"0
JRST TYO
NDPT: PUSH P,A
MOVEI A,"-
PUSHJ P,TYO
POP P,A
MOVNS A
JRST DPT1
SUBTTL FNG - GET NEXT FILE
;FNG GETS THE NEXT FILE, MAPPING OVER THE WHOLE WORLD BUT EXCLUDING
; SOME FILES ON BASIS OF DATE, ETC.
;RETURNS FILE NAME AND ATTRIBUTES IN A FEW MILLION VARIABLES,
; WHICH SHOULD BE LISTED HERE.
;CLOBBERS JUST ABOUT ALL THE ACS.
;THIS ISN'T THE ENTRY, JUMPS HERE IF CAN'T READ UFD.
FUNCT: .STATUS UFDCH,A
LDB A,[220600,,A] ;OPEN-LOSS CODE
CAIN A,20
POPJ P, ;DIRECTORY DOESN'T EXIST, FAIL.
PUSH P,LPTSW
SETZM LPTSW
PSIS CHNTAB+UFDCH ;MAY JUST BE 'DEVICE NOT AVAILABLE'
PUSHJ P,OPINFL
PUSHJ P,CRR
POP P,LPTSW
MOVEI A,150.
.SLEEP A,
JRST FNG8
;ENTRY.
FNG: AOSE FLNI ;PUT ONE FILE NAME AND PACK # IN FN1,FN2,PACKN
JRST NEXFLN ;NOT THE FIRST TIME
FNG8: .OPEN UFDCH,FNO
JRST FUNCT ;MAYBE TOO MUCH DISK ACTIVITY
MOVE A,[-2000,,FDIRBF]
.IOT UFDCH,A
.CLOSE UFDCH,
SKIPN GFRFLG
JRST FNG1
HRRZ A,FDIRBF+UDBLKS
MOVEM A,BLOCKS
HLRZ A,FDIRBF+UDBLKS
MOVEM A,QUOTA
SKIPE GFREVR
JRST FNG1
HLRZ A,FDIRBF+UDALLO
JUMPE A,FNG1
MOVEI B,1
LSH B,(A) ;BIT FOR PACK ALLOCATED TO
TDNN B,SECMSK ;ALLOCATED TO SECONDARY DOESN'T COUNT
SKIPE GFRALO ;DON'T REAP ALLOCATED DIRS?
JRST FNG1 ; REAP THE SUCKERS!
POPJ P, ;ALLOCATED, DON'T REAP
FNG1: MOVE A,FDIRBF+UDNAMP
MOVEM A,DIRIDX
ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA
MOVE C,A
GETNM: CAILE A,FDIRBF+1777-4
JRST OUTENT ;END OF NAME AREA
SKIPN W,(A)
JRST NEXENT ;EMPTY SLOT [SHOULDN'T HAPPEN!]
MOVE B,UNRNDM(A)
SKIPN GFRFLG
JRST GETNM2
SKIPE GFREVR
JRST GETNM1
TLNN B,UNREAP ;DON'T REAP FILES WITH REAP BIT ON
TLNN B,UNDUMP ;DON'T REAP FILES NOT YET DUMPED
JRST NEXENT
PUSH P,A
LDB A,[UNPKN B]
MOVEI D,1
LSH D,(A) ;BIT FOR PACK IT'S ON
POP P,A
TDNN D,GFRPNM
JRST NEXENT ;DON'T REAP OFF THIS DISK
GETNM2: TLNN B,UNLINK
JRST GETNM1
SKIPN DMPLNK
JRST NEXENT
GETNM1: SKIPL INCREM
SKIPGE DATEF
CAIA
JRST IGNORQ
TLNE B,UNLINK ; LINK
JRST NEXENT ; DON'T INCREMENTAL DUMP LINKS
SKIPGE DATEF
JRST IGNORQ
TLNE B,UNDUMP ;FILE-DUMPED BIT
JRST NEXENT
MOVE D,3(A)
CAMN D,[-1]
PUSHJ P,SM1DT ;MINUS 1 DATE, CHANGE INTO TODAY.
IGNORQ: TLNE B,UNIGFL
JRST NEXENT ;FILE IS EITHER OPEN FOR WRITING OR SOME FLAVOR OF BEING DELETED
MOVE D,DATE
SKIPGE DATEF
CAMG D,3(A) ;IF DATE SPECIFIED, DISREGARD IF CREATION
CAIA ; DATE IS BEFORE SPECIFIED DATE
JRST NEXENT
MOVE D,DATE1
SKIPGE DATESF
CAMLE D,3(A) ;IF DATES SPECIFIED, DISREGARD IF CREATION
CAIA ; DATE IS AFTER SPECIFIED DATE
JRST NEXENT
TLNE B,UNLINK
JRST GETLNK
MOVEM W,(C) ;FIRST NAME
MOVE W,1(A)
MOVEM W,1(C)
LDB W,[UNPKN B]
MOVEM W,2(C) ;PACK #
MOVE W,3(A)
MOVEM W,3(C)
HLRZ W,4(A) ;REFERENCE DATE
SKIPN W
MOVEI W,177777
ANDI W,177777
SKIPE GFRCRE ;GET CREATION DATE INSTEAD OFF REFERENCE DATE.
HLRZ W,3(A)
MOVSM W,4(C)
SKIPN GFRFLG
JRST FNGOK
PUSHJ P,LNTH
JUMPE B,NEXENT ;ZERO-LENGTH FILES DON'T GET REAPED
MOVE B,(C)
CAME B,[SIXBIT/-READ-/]
JRST FNGOK
MOVE B,1(C)
CAME B,[SIXBIT/-THIS-/] ;THESE FILES WORTH KEEPING AROUND
FNGOK: ADDI C,LUNBLK ;ACCEPT THIS FILE INTO THE LIST
NEXENT: ADDI A,5
JRST GETNM
SM1DT: MOVEI D,.BII ;FILE SEEN WITH -1 CREATION DATE,
HRLM D,TRNI ; AND NOT DUMPED YET. FIX.
MOVE D,(A)
MOVEM D,FN1
MOVE D,1(A)
MOVEM D,FN2
.OPEN DSKIN,TRNI
POPJ P,
.CALL RRDATE ;READ REF DATE (= NOW SINCE JUST OPENED!!)
SKIPA
.CALL CREFDT ;COPY INTO CREATION DATE
JFCL
.CLOSE DSKIN,
POPJ P,
;HACKED ALL ENTRIES, NOW SORT
OUTENT: MOVEM C,LFDIR
SETZM (C) ;ZERO ENTRY MEANS END OF DIRECTORY
SETZM 1(C)
SETZM 4(C)
MOVE A,DIRIDX
ADDI A,FDIRBF
MOVEI D,LUNBLK
MOVEI N,0 ;USUALLY BY FN1
SKIPE GFRFLG
SKIPN GFRQUO
JRST OUTEN1
MOVEI N,4 ;SORT BY REFDATE IF GFR AND QUOTA
PUSHJ P,SORT
MOVE A,DIRIDX
ADDI A,FDIRBF
MOVEI N,3
MOVE C,A
OUTEN2: SKIPN B,4(A)
JRST OUTLUP
OUTEN3: ADDI C,LUNBLK
CAMN B,4(C)
JRST OUTEN3
PUSHJ P,SORT
JRST OUTEN2
OUTEN1: PUSHJ P,SORT
MOVE A,DIRIDX
ADDI A,FDIRBF
MOVEI N,1 ;SORT BY FN2 WITHIN EQUAL FN1
MOVE C,A
BLUP: SKIPN B,(A)
JRST OUTLUP
BLUP1: ADDI C,LUNBLK
CAMN B,(C)
JRST BLUP1
PUSHJ P,SORT
JRST BLUP
OUTLUP: ;ESCAPE FROM ABOVE SORTING. DROP INTO NEXFLN.
;HERE TO EXTRACT A FILE FROM THIS MUNGED DIRECTORY.
NEXFLN: SETZM RFDATE
MOVE A,DIRIDX
SKIPN B,FDIRBF(A)
POPJ P, ;NO MORE FILES
MOVEM B,FN1
MOVE B,FDIRBF+1(A)
MOVEM B,FN2
MOVE B,FDIRBF+2(A)
MOVEM B,PACKN
MOVE B,FDIRBF+3(A)
MOVEM B,LNKNM1
SKIPE GFRFLG
MOVEM B,FLENTH
MOVE B,FDIRBF+4(A)
MOVEM B,LNKNM2
ADDI A,LUNBLK
MOVEM A,DIRIDX
SETZM LNKFLG
HLRZ A,PACKN
SKIPE A
SETOM LNKFLG
SKIPN LNKFLG
MOVEM B,RFDATE
POPJ1: AOS (P)
CPOPJ: POPJ P,
GETLNK: MOVEM W,(C) ;FIRST NAME
MOVE W,1(A)
MOVEM W,1(C)
LDB B,[UNDSCP+UNRNDM(A)] ;GET FIRST BYTE INDEX
PUSH P,B+1
IDIVI B,UFDBYT
ADDI B,FDIRBF+UDDESC
MOVNI N,-6(C)
IMULI N,6
HRLI N,60200 ;ASSUMING B=2 !!!
ROT N,30.
POP P,B+1
PUSHJ P,GETLSL
CAMN W,[SIXBIT /BACKUP/] ; DON'T BACKUP LINKS TO THE BACKUP DIRECTORY
JRST NEXENT
SKIPN W
SETOM W ;IN CASE OF ZERO SNAME
MOVEM W,2(C) ; SNAME
PUSHJ P,GETLSL
MOVEM W,3(C) ; LINK FN1
PUSHJ P,GETLSL
MOVEM W,4(C)
ADDI C,LUNBLK
JRST NEXENT
;GETLSL GET LINK SYLLABLE. 6 BIT CHARACTERS. AT MOST 6 TO A WORD RETURNED IN W
; NEXT CHARACTER QUOTED BY : DELIMITER IS ; OR ZERO CHARACTER
GETLSL: PUSH P,A
PUSH P,C
PUSH P,D
MOVEI D,6 ;AT MOST 6 CHARACTERS
MOVE C,[440600,,W]
SETZM W
GETLS1: ILDB A,N
CAIE A,0
CAIN A,'; ; END?
JRST GETLS2
CAIN A,': ; QUOTE NEXT CHAR
ILDB A,N
IDPB A,C ; STORE CHARACTER
SOJG D,GETLS1
GETLS2: POP P,D
POP P,C
POP P,A
POPJ P,
LNTH: LDB D,[UNDSCP+B]
SETZM B
IDIVI D,6
HLL D,QBTBLI(E)
ADDI D,UDDESC+FDIRBF
PUSHJ P,LN1
MOVEM B,3(C)
POPJ P,
LN1: ILDB E,D
SKIPN E
POPJ P,
CAILE E,UDTKMX
JRST LN2
ADD B,E
JRST LN1
LN2: CAIGE E,UDWPH
AOJA B,LN1
CAIN E,UDWPH
JRST LN1
REPEAT 2, IBP D
AOJA B,LN1
QBTBLI: 440600,,
360600,,
300600,,
220600,,
140600,,
060600,,
000600,,
;THE FOLLOWING ROUTINE READS IN AND ALPHABETIZES THE MASTER FILE
;DIRECTORY OF THE DISK USING THE ASSUMED NAME M.F.D. (FILE).
;THE DIRECTORY IS READ IN WITH BLOCK IMAGE MODE INPUT INTO MFDLST,
;AND IS ASSUMED TO BE COMPLETELY CONTAINED IN 2000 OCTAL LOCATIONS.
;THE FIRST ENTRY IS ASSUMED TO BE IN LOCATION MFDLST+N, WHERE N IS THE CONTENTS OF MFDLST+1.
;EVERY ENTRY IS ASSUMED TO TAKE TWO LOCATIONS WITH THE NAME TO BE ALPHABETIZED IN THE FIRST
;LOCATION OF THE TWO.
; THE FINAL ALPHABETIZED LIST IS ONE WORD ENTRIES STARTING AT MFDLST.
;NEXT MFD ENTRY (FOR FNG)
MFDN: SETOM APPENF
AOS A,MFDIN
MOVE A,MFDLST(A)
JUMPE A,CPOPJ
MOVEM A,USNM
JRST POPJ1
;READ IN MFD
INMFD: MOVEI A,.BII
HRLM A,MFO
OPEN STATC,MFO
.VALUE ;HOW CAN WE POSSIBLY WIN WITHOUT MFD?
MOVE A,[-2000,,MFDLST]
.IOT STATC,A
.CLOSE STATC,
MOVEI B,0 ;FIRST, COPY IT DOWN INTO CONTIG WORDS
MOVE A,MFDLST+MDNAMP ;LOCATION OF FIRST ENTRY
NEXUFD: SKIPN C,MFDLST(A)
JRST GOON
MOVEM C,MFDLST(B)
ADDI B,1
GOON: ADDI A,2
CAIGE A,2000
JRST NEXUFD
SETZM MFDLST(B) ;MARK END
MOVEI A,MFDLST ;NOW SORT IT
MOVEI C,MFDLST(B)
MOVEI N,0
MOVEI D,1
JRST SORT
SUBTTL SORT ROUTINE
;THIS ROUTINE SORTS A BLOCK OF CORE LOGICALLY (NOT ARITHMETICALLY)
;ARGUMENTS:
;A POINTS TO FIRST ENTRY
;C POINTS TO LOCATION AFTER LAST ENTRY
;N HOLDS ADDRESS OF KEY WORD RELATIVE TO BEGINNING OF BLOCK
;D HOLDS NUMBER OF WORDS TO BE MOVED TOGETHER
;THE METHOD IS RADIX EXCHANGE
;BORROWED FROM SYSENG;PRUFD >
SORTDN: MOVE [TDNE B,(A)]
MOVEM TEST1
MOVE [TDNN B,(C)]
MOVEM TEST2
JRST SORTI
SORT: MOVE [TDNN B,(A)]
MOVEM TEST1
MOVE [TDNE B,(C)]
MOVEM TEST2
SORTI: MOVSI B,(SETZ)
SORT1: HRLM C,(P) ;SAVE UPPER BOUND
MOVN W,D
ADD W,C
CAML A,W
JRST SORT7 ;ONE OR ZERO ENTRIES
PUSH P,A ;SAVE LOWER BOUND
SORT3: ADD A,N
XCT TEST1 ;BIT SET IN LOWER ENTRY?
JRST SORT5 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
SUB A,N
SUB C,D
ADD C,N
XCT TEST2 ;BIT CLEAR IN UPPER ENTRY?
JRST SORT8 ;NO, CHECK FOR END, DECREMENT C, AND TRY AGAIN
SUB C,N
IMUL D,[-1,,] ;MAKE AOBJN POINTER
SHUFFL: ADDI A,(D)
ADDI C,(D)
MOVE W,(A)
EXCH W,(C)
MOVEM W,(A)
SUBI A,(D)
SUBI C,(D)
AOBJN D,SHUFFL
SORT4: ADD A,D ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
SORT2: CAME A,C ;ANY MORE ENTRIES LEFT?
JRST SORT3 ;YES, GO PROCESS THEM
;A AND C NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
ROT B,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT
JUMPL B,SORT6 ;JUMP IF NO MORE KEY TO SORT ON
PUSHJ P,SORT1 ;SORT BOTTOM PART OF TABLE
HLRZ C,(P) ;RESTORE UPPER BOUND (SORT1 CLOBBERED A TO MIDDLE)
PUSHJ P,SORT1 ;SORT TOP PART OF TABLE
SORT6: ROT B,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER B"
SORT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED
POPJ P,
SORT5: SUB A,N
JRST SORT4
SORT8: SUB C,N
JRST SORT2
SUBTTL PROGRAM STARTS HERE
START: SKIPN MYNAME ;DON'T CHANGE IF NOT JUST LOADED
.SUSET [.RSNAME,,MYNAME]
.SUSET [.SSNAM,,MYNAME]
.SUSET [.ROPTION,,A]
TLO A,%OPOPC ;STORE PROPER PC ON INTERRUPTS
.SUSET [.SOPTION,,A]
.OPEN TYOC,[%TJDIS+.UAO,,(SIXBIT /TTY/)]
.LOSE 1400
MOVEI P,PDL
.CORE CORSIZ
JRST .-1
.SUSET [.SMASK,,[%PIIOC+%PITYI]] ;ALLOW IOC, TYPEIN
;COPY QPKID AND QRESRV ARRAYS OUT OF ITS
MOVE C,[SQUOZE 0,NQS]
.EVAL C,
.LOSE
MOVE A,[SQUOZE 0,QPKID]
.EVAL A,
.LOSE
MOVSS A
HRRI A,QPKID
MOVE B,C
.GETLOC A,
ADD A,[1,,1]
SOJG B,.-2
MOVE A,[SQUOZE 0,QRESRV]
.EVAL A,
JRST NORSRV
MOVSS A
HRRI A,QRESRV
.GETLOC A,
ADD A,[1,,1]
SOJG C,.-2
NORSRV: ;SET UP SECMSK TO BE ALL THE PACKS THAT ARE ON-LINE AND RESERVED
SETZM SECMSK
SETZM PRIMSK ;AND PRIMSK THE ON-LINE NON-RESERVED PACKS
MOVSI C,-10
SETSCM: MOVEI A,1
SKIPGE QPKID(C)
JRST SETSC1 ;NOT ON-LINE
LSH A,@QPKID(C)
SKIPE QRESRV(C)
IORM A,SECMSK
SKIPN QRESRV(C)
IORM A,PRIMSK
SETSC1: AOBJN C,SETSCM
PUSHJ P,INMFD
.OPEN TYIC,[10,,(SIXBIT /TTY/)] ;DDT MODE
.LOSE 1400
.CALL TTYGET ;TRY TO TURN ON **MORE** PROCESSING
JFCL
MOVSI C,%TSMOR
ANDCAM C,TTYSTS
.CALL TTYSET
JFCL
.STATUS TYOC,A
LDB A,[300,,A]
MOVEM A,DISPLY
SOS DISPLY ;0==> PAPER 1==> SCREEN
;PRINT _ ;CRLF
;PUSHJ P,FORMF ;CLEAR SCREEN IF DISPLAY
SIXTYP PRNAM1
PRINT .
SIXTYP PRNAM2
PUSHJ P,CRR
SETOM ITAPE ;Assume tape is / will be rewound
SETOM MFDDAT
SETOM UFDDAT
SKIPGE TAPTYP
SETOM TAPTYP ;Dismount remote tape
SKIPG WRONG ;Else SETIT will make local/remote decision
JRST MLP
SETZM WRONG ;See if on right machine (first time only)
.CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ]
.VALUE
CAMN A,[MCHN]
JRST MLP
PRINT *** WRONG VERSION OF DUMP--ASSEMBLED FOR
PSIS [MCHN]
PRINT BUT RUNNING ON
PSIS A
PRINT ***_*** CERTAIN TAPE OPERATIONS WON'T BE ALLOWED ***
SETOM WRONG
;JRST MLP ;drops through
SUBTTL MAIN COMMAND LOOP
RET: ;FAILURE RETURN FROM VARIOUS COMMANDS
MLP: .CORE CORSIZ
JRST .-1 ;NO CORE
SETZM CTRLG
SETZM ACLODF
SETZM GFRFLG
SETZM GFRCRE
SETZM EOTFLG
SETZM USRDEL
SETZM DATEF
SETZM DATESF
SETZM RELOSW
SETZM PDIRSW
SETZM DMPDIR
SETZM DMPUFD
SETZM DMPMFD
SETZM DMPLNK
SETZM DFINDF
MOVEI P,PDL
CLEARM LPTSW
.CLOSE SAVET,
MOVNI A,1
SKIPE LPTBFC
PUSHJ P,LPTTYO ;EMPTY THE LPT BUFFER
.CLOSE LPTCH,
.RESET MAGIN, ;ASSUMING MTAPE USES MAGIN AS ITS CHANNEL
.CLOSE MAGIN, ;BEGINNING AND ERROR RESTART
.CLOSE MAGOUT,
SETZM MAGOPN
SETZM LNKFLG
.IOPDL ;FLUSH ANY PUSHED DSKIN, ETC.
.CALL TTYSET ;TURN ECHOING BACK ON, IF OFF
JFCL
PROMPT: PUSHJ P,CRR
MOVEI A,"_
PUSHJ P,TYO ;PROMPT THE LOSER
PUSHJ P,TYI
CAIN A,"?
JRST AHELP
PUSHJ P,GETSL1 ;READ THE COMMAND
JRST PROMPT
JUMPE SYM,RET ;JUST A CR OR FF, REPROMPT
CLEARM SUPERC
CLEARM DMPMOD
CLEARM CHKFLG
CLEARM TCOPYF
MOVSI B,-NCOMS
CAME SYM,COMT(B) ;SEARCH THE COMMAND TABLE
AOBJN B,.-1
MOVEI C,0 ;USED IN SOME COMMANDS AS DEFAULT
JUMPL B,MLP1 ;NOT REASONABLE COMMAND ?
ERR: PRINT ?
JRST MLP
FORMF: SKIPG DISPLY
POPJ P,
PASC [ASCIZ /C/]
POPJ P,
MLP1: SKIPGE COMDTB(B) ;NOT ALL COMMANDS USE THE TAPE DRIVE
PUSHJ P,SETITN ;SETIT, and show who used it last.
PUSHJ P,@COMDTB(B) ;DO COMMAND
JRST RET
AHELP: PASC COMHLP ;GIVE COMMAND NAMES AND DESCRIPTION
JRST MLP
; MOVSI D,-NCOMS ;LIST COMMANDS
; PUSHJ P,CRR
;HELP1: PSIS COMT(D)
; PUSHJ P,CRR
; AOBJN D,HELP1
; JRST MLP
SUBTTL COMMAND LOOK-UP TABLES
;NOTE IF YOU CHANGE THIS, CHANGE COMDTB AND COMHLP (ALSO ON THIS PAGE)
COMT: SIXBIT /LOCAL/ ;USE LOCAL TAPE DRIVE
SIXBIT /REMOTE/ ;USE REMOTE TAPE DRIVE
SIXBIT /TAPED/ ;GENERATE TAPE DIRECTORY FROM MOUNTED TAPE
SIXBIT /FIND/ ;FIND WHAT TAPE PARTICULAR FILE IS ON
SIXBIT /OFIND/ ;FIND COMMAND USING A TAPE FOR INFO
SIXBIT /DFIND/ ;FIND COMMAND FOR A DECEASED ITS.
SIXBIT /DUMP/ ;DUMP FILES
SIXBIT /LOAD/ ;LOAD FILES
SIXBIT /RELOAD/ ;LOAD FILES, MODIFY DIRECTORY FROM TAPE COPY
SIXBIT /CLOAD/ ;CONTINUE PREVIOUS LOAD OPERATION
SIXBIT /CDUMP/ ;CONTINUE FULL DUMP
SIXBIT /REWIND/ ;REWIND MAG TAPE
SIXBIT /UNLOAD/ ;REWIND/UNLOAD
SIXBIT /FLAP/ ;REWIND/UNLOAD
SIXBIT /EOT/ ;GO TO END OF TAPE
SIXBIT /LIST/ ;LIST FILES ON TAPE
SIXBIT /MFD/ ;LIST OUT MFD
SIXBIT /LISTF/ ;LIST OUT FILE DIRECTORY
SIXBIT /HELP/ ;TYPE OUT COMMANDS
SIXBIT /SPACE/ ;SPACE FORWARD N FILES
SIXBIT /LSPACE/ ;SPACE FORWARD AND LIST FILES
SIXBIT /CHECK/ ;CHECK FILES
SIXBIT /LCHECK/ ;CHECK FILES AND LIST THEM
SIXBIT /TAPES/ ;LIST ALL SAVED TAPE INFO
SIXBIT /TAPE/ ;LIST SAVED INFO ABOUT ONE TAPE
SIXBIT /TAPSET/ ;SET TAPE INFO FOR ONE TAPE
SIXBIT /TLIST/ ;LIST FILES ON A TAPE(AS STORED ON DISK)
SIXBIT /GFR/ ;GRIM FILE REAPER
SIXBIT /QUIT/ ; REWIND AND KILL
SIXBIT /ICHECK/
SIXBIT /ERRSTS/ ;TAPE CONTROL STATUS AS OF LAST ERROR
SIXBIT /ALLOC/ ;SET/GET DIRECTORY ALLOCATION
SIXBIT /LSTALC/ ;LIST ALL ALLOCATED DIRECTORIES
SIXBIT /PTDIR/ ;PRINT DIRECTORIES FROM TAPE
NCOMS==.-COMT
COMHLP: ASCIZ\
LOCAL Use local tape drive on this machine
REMOTE Use remote tape drive over the Chaos network
FIND Find what tape a particular file is on
OFIND FIND command using a tape for info
DFIND FIND command for a deceased ITS
DUMP Dump files
LOAD Load files
RELOAD Load files, modify directory from tape copy
CLOAD Continue previous LOAD/RELOAD operation
CDUMP Continue full dump
REWIND Rewind mag tape
UNLOAD Rewind/unload
EOT Go to end of tape
SPACE Space forward n files
LSPACE Space forward and list files, hit <space> after each
LIST List files on tape
MFD List MFD from disk
LISTF List a file directory from disk
HELP Type out commands
CHECK Check files on tape against disk
LCHECK Check files and list them
ICHECK Check files on incremental dump, update dump-check bits
TAPED Generate tape directory from mounted tape
TAPES List all saved tape info
TAPE List saved info about one tape
TAPSET Set tape info for one tape
TLIST List files on a tape (from tape directory stored on disk)
GFR Grim File Reaper (Don't use this, please)
QUIT return to DDT
ERRSTS Print tape control status as of last error
ALLOC Examine or change directory allocation
LSTALC List all directories with allocations
PTDIR Print directories from tape
\
COMDTB: ALOCAL ;SETZ MEANS THAT COMMAND USES THE TAPE DRIVE
AREMOTE
ATAPED
AFIND
SETZ OFIND
DFIND
SETZ DUMP
SETZ LOAD
SETZ RELOAD
SETZ ACLOAD
SETZ ACDUMP
ARWND
AUNLD
AUNLD
AEOT
SETZ ALIST
AMFD
ALISTF
AHELP
SETZ ASPACE
SETZ ALSPACE
SETZ ACHECK
SETZ ALCHEC
ATAPES
ATAPE
TAPSET
ATLIST
AGFR
AQUIT
AICHEC
ERRSTS
DALLOC
LSTALC
SETZ APTDIR
IFN .-COMDTB-NCOMS, .ERR COMDTB NOT SAME LENGTH AS COMT
SUBTTL TTY I/O
TYI: .IOT TYIC,A ;TTY IN
JUMPL A,TYICC1 ;EOF ON INDIRECT FILE
CAIN A,^C ;IGNORE GARBAGE CHARS
JRST TYI
CAIN A,^G
JRST TYI
CAIL A,"a ;UPPER CASE LOWER CASE LETTERS
CAILE A,"z
CAIA
SUBI A,40
SKIPE TYIPD
JRST TYIDSK
CAIE A,15
POPJ P,
PUSHJ P,CAR ;CR ECHOS AS CRLF
MOVEI A,15
POPJ P,
TYIDSK: CAIN A,12
JRST TYI ;IGNORE LINE FEEDS IN DISK INPUT
JRST TYO ;ECHO STUFF ON TTY
TYICC1: SKIPG TYIPD
POPJ P,
SOS TYIPD ;AT END OF INDIRECT FILE
.IOPOP TYIC,
JRST TYI
;RETURN CARRIAGE
CRR: MOVEI A,15
CAR: PUSHJ P,TYO
MOVEI A,12
JRST TYO
;TTY/LPT/TPL OUT
TYO: SKIPGE LPTSW
JRST LPTTYO
TYO1: .IOT TYOC,A
POPJ P,
LPTBUF: BLOCK 40
LPTBEP: 010700,,.-1
LPTBBP: 440700,,LPTBUF
LPTBFP: 440700,,LPTBUF
LPTBFC: 0
LPTTYO: PUSH P,B
JUMPL A,LPTTO1
IDPB A,LPTBFP
AOS LPTBFC
CAIN A,^J
JRST LPTTO1
MOVE B,LPTBFP
CAME B,LPTBEP
JRST POPBJ
LPTTO1: MOVE B,LPTBBP
MOVEM B,LPTBFP
.CALL [ SETZ
SIXBIT /SIOT/
MOVEI LPTCH
MOVE B
SETZ LPTBFC ]
.LOSE 1000
SETZM LPTBFC
POPBJ: POP P,B
POPJ P,
TYOS: PUSH P,A
MOVEI A,40 ;OUTPUT SPACE
PUSHJ P,TYO
JRST POPAJ
SUBTTL SYLLABLE INPUT
;THE FOLLOWING ROUTINE INPUTS A SYLLABLE.
;THE SYLLABLE ENDS UP AS SIXBIT IN SYM.
;IF IT IS COMPOSED OF DIGITS, THEY ARE COMPILED INTO A DECIMAL NUMBER
;AND STORED IN N.
;CARRIAGE RETURN, LINEFEED, SEMI-COLON, COLON, BACKARROW, AND ALTMODE END THE
;SYLLABLE BUT ARE NOT PART OF IT. THE TERMINATOR IS PUT IN TER.
;NON-SIXBIT CHARACTERS CAUSE GETSYL TO PRINT ?? AND WAIT FOR THE
;ENTIRE SYLLABLE AGAIN. SINGLE CHARACTER RUBOUT WORKS,
;BUT IF YOU RUBOUT BEYOND THE FIRST CHARACTER, GETSYL RETURNS WITHOUT
;SKIPPING. SUCCESSFUL RETURN IS A SKIP RETURN. ^Q MAY BE USED TO ENTER
;A TERMINATOR AS SIXBIT SUCH AS SEMI-COLON, OR COLON.
;RUBBED OUT CHARACTERS ARE ECHOED.
GETSYL: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE,
SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG
MOVE B,[440600,,SYM]
GETCH: PUSHJ P,TYI
SKCHAR: CAIN A,177
JRST RUBOUT
CAIE A,"_ ;BACK-ARROW
CAIN A,33 ;ALTMODE
JRST OUTSYL
CAIE A,15 ;CARRIAGE RETURN
CAIN A,12 ;LINEFEED
JRST OUTSYL
CAIE A,"; ;SEMI-COLON
CAIN A,": ;COLON
JRST OUTSYL
CAIN A,40 ;SPACE
JRST OUTSYL
CAIN A,^L ;SO USER CAN CLEAR SCREEN
JRST GETSFF
CAIN A,^Q
JRST QUOTE
CAIGE A,40
JRST OUTSYL ;ANY RANDOM CONTROL TERMINATES
CAIN A,"-
SETCMM GTSYNF
NUMQ: CAIGE A,40
JRST CHERR
CAIL A,"0
CAILE A,"9
JRST NONUM
IMULI N,10.
ADDI N,-"0(A)
NONUM: SUBI A,40
TLNE B,770000
IDPB A,B
AOS GTSYCC
JRST GETCH
QUOTE: PUSHJ P,TYI
CAIE A,177
JRST NUMQ ;RUB OUT QUOTE RATHER THAN QUOTING RUBOUT
.CALL [ SETZ ? 'CNSGET ? MOVEI TYOC
REPEAT 4,[ MOVEM A ? ] SETZM A ] ;GET TTYOPT
MOVEI A,0
TLNE A,%TOOVR
TLNE A,%TOERS
JRST [ PRINT XX
JRST GETCH ]
PRINT ^Q
JRST GETCH
GETSFF: SKIPN GTSYCC
JRST OUTSYL ;NOTHING TYPED, TERMINATE
PUSH P,N ;OTHERWISE, RE-ECHO
MOVE N,[440600,,SYM]
SETZM GTSYCC ;NOTE TRUNCATES TO AT MOST 6 CHARS
GETSF1: ILDB A,N
ADDI A,40
AOS GTSYCC
PUSHJ P,TYO
CAME N,B
JRST GETSF1
POP P,N
JRST GETCH
RUBOUT: SKIPN GTSYCC
JRST RUB1
LDB A,B
ADDI A,40
PUSH P,C
.CALL [ SETZ ? 'CNSGET ? MOVEI TYOC
REPEAT 4,[ MOVEM C ? ] SETZM C ] ;GET TTYOPT
MOVEI C,0
TLNE C,%TOOVR
TLNE C,%TOERS
JRST [ PUSH P,A
MOVEI A,^P
PUSHJ P,TYO
MOVEI A,"X
PUSHJ P,TYO
POP P,A
JRST RUB0 ]
PUSHJ P,TYO
RUB0: POP P,C
CAIL A,"0
CAILE A,"9
JRST NOUNM
SUBI N,-"0(A)
PUSH P,SYM
IDIVI N,10.
POP P,SYM ;DIVISION CLOBBERS SYM
NOUNM: SOS A,GTSYCC
CAIL A,6
JRST GETCH
SETZ A,
DPB A,B
ADD B,[60000,,]
JRST GETCH
RUB1: PRINT ??
PUSHJ P,TYOS
POPJ P,
CHERR: PRINT ??
PUSHJ P,TYOS
JRST GETSYL
OUTSYL: MOVEM A,TER
AOSN GTSYNF
MOVNS N
JRST POPJ1
GETSL1: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE,
SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG
MOVE B,[440600,,SYM]
JRST SKCHAR
SUBTTL INTERRUPT ROUTINE
INT: 0
0
PUSH P,A
MOVE A,INT
TRZE A,%PITYI
JRST TYILK ;CHARACTER TYPED
POP P,A
INTGO: MOVEM 17,INTAC+17
MOVEI 17,INTAC
BLT 17,INTAC+16 ;SAVE ACS
MOVE 17,INTAC+17
PUSH P,LPTSW
SETZM LPTSW ;TYPE IOCER MESSAGE ON TTY NOT LPT
MOVE A,INT
TRNN A,%PIIOC
JRST RNDINT ;NOT TTY OR IOC
.SUSET [.RBCHN,,A] ;IOCER, GET CHANNEL
CAIN A,MAGIN
JRST INT1
CAIN A,DSKIN
JRST INT3
CAIN A,DSKOUT
JRST INT5
CAIE A,RTAPE"RSICH
CAIN A,RTAPE"RSOCH
JRST [ SKIPGE TAPTYP
SETOM TAPTYP ;REMOTE TAPE CONNECTION BROKEN
JRST .+1 ]
CAIE A,MAGOUT ;NOT MACRO-TAPE INPUT
JRST NTMGTP ;NOT MACRO TAPE OUTPUT EITHER !
SKIPN DMPMOD
JRST NTDMMP ;NOT DUMPING ON MACRO-TAPE
.STATUS MAGOUT,A
LDB A,[330600,,A] ;IOCER FIELD
CAIE A,9
JRST NTNDOF ;NOT END OF TAPE
NTNDO1: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE !
SKIPGE FULLDMP
JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB
PRINT _PHYSICAL END OF TAPE
.DISMISS [ERR]
RNDINT: PRINT _INTERRUPT
POCT A
.DISMIS [ERR]
NTMGTP: PRINT _INTERRUPT ON CHANNEL
POCT A
PSIS CHNTAB(A) ;TYPE DEVICE AND DIRECTION
.DISMIS [NAUGHT]
NTDMMP: PRINT _INTERRUPT MAG TAPE OUT WHEN NOT DUMPING
.DISMIS [NAUGHT]
NTNDOF: PUSH P,A
PUSHJ P,ERRSTS ;PRINT MAGTAPE ERROR STATUS
POP P,A
PRINT _INTERRUPT
POCT A
PRINT MAG TAPE OUT .. SIMULATING E-O-T ..
JRST NTNDO1
CHNTAB: SIXBIT /RANDOM/
SIXBIT /MFD IN/
SIXBIT /DRC IN/
SIXBIT /DSK IN/
SIXBIT /MAGOUT/
SIXBIT /TTY IN/
SIXBIT /TTYOUT/
SIXBIT /DSKOUT/
SIXBIT /MAG IN/
SIXBIT /LPTOUT/
SIXBIT /ERR IN/
SIXBIT /STATUS/
SIXBIT /SAVET/
SIXBIT /SNPLCH/
SIXBIT /RMT IN/
SIXBIT /RMTOUT/
;IOCER ON DISK OUTPUT, MOST LIKELY DEVICE OR DIRECTORY FULL
;LET DDT HANDLE IT.
INT5: MOVE A,INT+1 ;SAVE PC
MOVEM A,IOCPC'
JSP A,INTX1 ;DISMISS AND COME BACK
;PASS THE ERROR TO DDT
.CALL [SETZ ? SIXBIT/LOSE/ ? MOVEI <1+.LZ %PIIOC> ? SETZ IOCPC]
.VALUE
;DISK INPUT ERROR
INT3: .STATUS DSKIN,A
LDB A,[330600,,A] ;IOCER FIELD
CAIN A,3
JRST INT4 ;JUMP IF IRRECOV DATA ERROR
PRINT INTERRUPT
POCT A
PRINT DISK IN
.DISMIS [NAUGHT]
INT4: SKIPN SUPERC
PRINT DATA ERROR DISK IN_
AOS ERRDSK
SETOM ERRALL
HRRZ C,INT+1
POCT C ;PC OF LOSING INSTRUCTION
MOVE A,[DSKIN,,INTERR]
.RCHST A,
MOVEI A,INTERR
MOVE B,INTERR+3
PUSHJ P,TELL
AOS INT+1 ;ABANDON THE .IOT THAT LOST
JRST INTX
TYILK: MOVEM A,INT ; DON'T DROP OTHER INTERRUPTS!
TYILK1: MOVEI A,TYIC ;CHARACTER TYPED
.ITYIC A,
JRST POPEN
CAIE A,^G
JRST TYILK1
.RESET TYOC,
SKIPN A,CTRLG ;SKIP IF DEFERRED
.DISMIS [ERR] ;DEATH TO CURRENT OPERATION
MOVNM A,CTRLG ;SET IT POSITIVE TO FLAG DEFERRED
JUMPL A,TYILK1 ;JUMP IF ^G TYPED FOR THE FIRST TIME
SKIPGE TAPTYP ;^G WHILE DEFERRED, KILL REMOTE TAPE CONNECTION
SETOM TAPTYP
.DISMIS [ERR]
CTRLGX: AOSG CTRLG
POPJ P, ;NO ^G HAPPENED WHILE DEFERRED
JRST ERR
POPEN: POP P,A
SKIPE INT ; Any more pending?
JRST INTGO ; Yes, go do 'em
.DISMIS INT+1 ; No, all done
NAUGHT: PUSHJ P,OPINFL
JRST ERR
;Can only get here for local tape drive
INT1: PUSH P,TAPTYP ;Select local drive if in TCOPY
MOVEI A,1
MOVEM A,TAPTYP
PUSHJ P,ERRSTS ;PRINT MAG TAPE ERROR STATUS
.STATUS MAGIN,A ;INTERUPT ON MAG TAPE INPUT
LDB A,[330600,,A] ;IOCER FIELD
CAIN A,3
JRST INT2 ;NON RECOV DATA ERR
POP P,TAPTYP
CAIN A,9
SKIPE TCOPYF
JRST INT1B ;PHYSICAL EOT OR TCOPYING
SKIPE DMPMOD ;IF DOING A DUMP, MUST BE A COMPARE
JRST INT1A
PRINT _INTERRUPT
POCT A
PRINT MAG TAPE IN
.DISMIS [NAUGHT]
;--- This is preposterously bogus, but fortunately is never reached
;--- since ICHECK+5 doesn't check last directory on reel
INT1A: POP P,LPTSW
.DISMIS [ICKEOT]
INT1B: SETOM RDERR
SETOM PHYEOT
PRINT PHYSICAL END OF INPUT TAPE_
AOS INT+1 ;CAUSE .IOT TO RETURN WITHOUT READING
JRST INTX
INT2: AOS ERRCNT
SETOM ERRALL
PUSHJ P,TAPN
PSIS HSNM
PSIS HFN1
PSIS HFN2
PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._
PUSHJ P,OPINFL
SETOM RDERR
IFN NEWCOD, .STATUS MAGIN,B
.CLOSE MAGIN,
IFE NEWCOD, CONI 344,B
TRNE B,TF%EOF ;EOF?
JRST INT2X ;YES
.OPEN MAGIN,MAGI ;NO, SKIP TO EOF
JFCL
AOS INT+1 ;SKIP OVER THE .IOT THAT LOST, NOTE THAT
PUSHJ P,FILSKP ; 'RDERR' HAS BEEN SET, HOPEFULLY WE WERE
INT2X: POP P,TAPTYP ; IN 'MAGREAD' WHEN THE ERROR OCCURRED.
JRST INTX
SUBTTL MAG TAPE STATUS DECODER
ERRSTS: SKIPGE TAPTYP
JRST RTAPE"PRSTS ;Print remote tape status
PRINT _MAG TAPE STATUS
MOVE A,[SQUOZE 0,MGEMTC]
.EVAL A,
.LOSE
MOVSS A
HRRI A,A
.GETLOC A, ;A GETS CONI MTC, AT TIME OF ERROR
IFE NEWCOD,[
LDB B,[110400,,A] ;FUNCTION
PASC @(B)[[ASCIZ/NO-OP/] ;0
[ASCIZ/REWIND/]
[ASCIZ/READ/]
[ASCIZ/READ-COMPARE/]
[ASCIZ/WRITE/]
[ASCIZ/WRITE-EOF/]
[ASCIZ/SPACE-FWD/]
[ASCIZ/SPACE-REV/]
[ASCIZ/AWAIT-UNIT-READY/] ;10
[ASCIZ/UNLOAD/]
[ASCIZ/READ-MULTI-RECORD/]
[ASCIZ/READ-COMPARE-MULTI-RECORD/]
[ASCIZ/ERASE-THEN-WRITE/]
[ASCIZ/ERASE/]
[ASCIZ/SPACE-FILE-FWD/]
[ASCIZ/SPACE-FILE-REV/]]
LDB B,[060200,,A]
PSIS (B)[SIXBIT/200BPI556BPI800BPI???BPI/]
LDB B,[160100,,A]
SIXTYP (B)[SIXBIT/ ODD EVEN /]
PRINT PAR
LDB B,[150100,,A]
SKIPN B
PRINT IBM MODE
PRINT _
SETCM D,A
ANDI D,7 ;= 0 IF DATA CHANNEL
MOVE A,[SQUOZE 0,MGEMTS]
.EVAL A,
.LOSE
MOVSS A
HRRI A,A
.GETLOC A, ;A GETS CONI MTS, AT TIME OF ERROR
SKIPE D
TLZ A,170 ;CLEAR CHANNEL STATUS IF NO CHANNEL
MOVSI B,-LMTSTB/2
ERRST1: TDNE A,MTSTAB(B)
PASC @MTSTAB+1(B)
AOS B
AOBJN B,ERRST1
POPJ P,
MTSTAB: 10 ? [ASCIZ/WRITE-LOCK /]
200 ? [ASCIZ/BAD-TAPE /]
400 ? [ASCIZ/DATA-LATE /]
2000 ? [ASCIZ/READ-COMPARE-ERROR /]
4000 ? [ASCIZ/END-OF-TAPE /]
10000 ? [ASCIZ/END-OF-FILE /]
20000 ? [ASCIZ/TAPE-PARITY-ERROR /]
40000 ? [ASCIZ/ILLEGAL-COMMAND /]
100000 ? [ASCIZ/BEGINNING-OF-TAPE /]
200000 ? [ASCIZ/REWINDING /]
400000 ? [ASCIZ/UNIT-HUNG /]
20,, ? [ASCIZ/CHANNEL-DATA-PARITY-ERROR /]
40,, ? [ASCIZ/CHANNEL-NXM-ERROR /]
100,, ? [ASCIZ/CHANNEL-CONTROL-WORD-PARITY-ERROR /]
LMTSTB==.-MTSTAB
];IFE NEWCOD
.ELSE [;--- JTW missed this routine
DIE TM03 error status decode routine needs to be written
];IFN NEWCOD
SUBTTL DIRECTORY ALLOCATION COMMAND
DALLOC: PRINT [ DIR=]
PUSHJ P,GETSYL
POPJ P,
.CALL [ SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH]
[SIXBIT/DSK/] ? [SIXBIT/.FILE./] ? [SIXBIT/(DIR)/] ? SETZ SYM]
JRST OPINFL
MOVE A,[-2000,,UFDBUF]
.IOT UFDCH,A
.CLOSE UFDCH,
HLRZ A,UFDBUF+UDBLKS
JUMPE A,[ PRINT [_NO QUOTA]
JRST DALLC1 ]
PRINT [_QUOTA=]
PDPT A
DALLC1: PRINT [, USED=]
HRRZ A,UFDBUF+UDBLKS
PDPT A
SKIPN UFDBUF+UDALLO
JRST [ PRINT [, NO ALLOCATION]
JRST DALLC2 ]
PRINT [, ALLOCATED TO PACK ]
HLRZ A,UFDBUF+UDALLO
PDPT A
HRRZ A,UFDBUF+UDALLO
JUMPE A,DALLC2
PRINT [, BLKS=]
PDPT A
DALLC2: PRINT [_CHANGE ALLOCATION?]
DALLC3: PUSHJ P,TYI
MOVE D,A
PUSHJ P,CRR
CAIE D,"N
CAIN D,"Y
JRST DALLC4
PRINT [(Y or N) ]
JRST DALLC3
DALLC4: CAIE D,"Y
POPJ P,
.SUSET [.SSNAME,,UFDBUF+UDNAME]
MOVE A,UFDBUF+UDNAMP
CAIN A,2000
JRST [ MOVSI B,'FOO ;DIR EMPTY, MAKE DUMMY FILE
MOVEM B,FN1
MOVEM B,FN2
MOVEI B,.UIO
HRLM B,TRNI
OPEN DSKIN,TRNI
POPJ P,
PUSHJ P,DALLC5
.FDELE TRNI
JFCL
POPJ P, ]
MOVE B,UFDBUF+UNFN1(A)
MOVEM B,FN1
MOVE B,UFDBUF+UNFN2(A)
MOVEM B,FN2
DALLC5: MOVEI B,.BII+30 ;DON'T SET REF DATE, DON'T CHASE LINKS
HRLM B,TRNI
OPEN DSKIN,TRNI
POPJ P,
PRINT [NEW QUOTA=]
PUSHJ P,GETSYL
POPJ P,
MOVE W,N
PRINT [_NEW ALLOCATED PACK=]
PUSHJ P,GETSYL
POPJ P,
HRLZ X,N
PRINT [_NEW ALLOCATED #BLOCKS=]
PUSHJ P,GETSYL
POPJ P,
HRR X,N
.CALL [ SETZ ? 'DIRSIZ ? MOVEI DSKIN ? MOVE W ? SETZ X ]
JRST OPINFL
PRINT [_DONE]
POPJ P,
;COMMAND TO LIST ALL DIRECTORY ALLOCATIONS
LSTALC: PUSHJ P,DEVGET
SETOM MFDIN
MOVEI A,.BII
HRLM A,FNO
LSTAL1: PUSHJ P,MFDN
POPJ P,
.SUSET [.SSNAME,,USNM]
OPEN UFDCH,FNO
POPJ P,
MOVE A,[-2000,,UFDBUF]
.IOT UFDCH,A
.CLOSE UFDCH,
HLRZ A,UFDBUF+UDBLKS ;QUOTA
SKIPN UFDBUF+UDALLO
JUMPE A,LSTAL1 ;SKIP THIS IF NOTHING INTERESTING
SIXTYP USNM
JUMPE A,LSTAL2
PRINT [ QUOTA=]
PDPT A
LSTAL2: SKIPN UFDBUF+UDALLO
JRST LSTAL3
PRINT [ ALLOCATED TO PACK #]
HLRZ A,UFDBUF+UDALLO
PDPT A
HRRZ A,UFDBUF+UDALLO
JUMPE A,LSTAL3
PRINT [, ALLOCATION=]
PDPT A
LSTAL3: PRINT [, BLOCKS USED=]
HRRZ A,UFDBUF+UDBLKS
PDPT A
PUSHJ P,CRR
JRST LSTAL1
SUBTTL END OF TAPE ROUTINE
FOOB: MOVE P,ERRPDP ;POPJ P, will return from ADMP3
POP P,A ;Remove that return PC from pdl
MOVEM P,INTAC+P
SKIPL LSTWHL
JRST FOOB1
MOVEI A,^L
SKIPE LPTSW
PUSHJ P,TYO ;PAGE THROW ON LPT BETWEEN REELS
FOOB1: PUSH P,LPTSW
SETZM LPTSW
SKIPL TAPTYP
.CLOSE MAGOUT,
SKIPG TAPTYP
PUSHJ P,RTAPE"BUFRST
SETZM MAGOPN
SKIPN EXPERM
SKIPN INCREM
JRST FOOE ;JUMP IF NOT TO CHECK
SKIPE CKIDMP
JRST FOOE ;..
PRINT _REWINDING
IFE MCOND DM,[
MOVE B,NFTDMP
SOS B
MOVN N,NFTDMP
CAMN B,ITAPE ;IF NOT EQUAL, THEN IT IS NOT THE WHOLE TAPE
JRST FOOB1A
PUSHJ P,ASPAC1
SKIPA
]
FOOB1A: PUSHJ P,ARWND
PRINT _CHECKING INCREMENTAL DUMP_
PUSH P,USNM
PUSHJ P,ICHECK
POP P,USNM
.SUSET [.SSNAM,,USNM]
SETZM NFTDMP
FOOE: PUSHJ P,ARWND ;REWIND IT
PUSHJ P,GESELL ;GIVE AWAY BEGINNING AND LAST USER ON THIS REEL
.RESET TYIC,
FOOD: PRINT _MOUNT NEW TAPE THEN TYPE OK.
PUSHJ P,GETSYL
JRST .-1
MOVE A,SYM
CAMN A,[SIXBIT /OK/]
JRST FOOC
CAMN A,[SIXBIT /STOP/]
JRST MAYBE
JRST FOOD
FOOC: PUSHJ P,ARWND
AOS NTAPES
MOVE A,USNM
CAME A,FUSNM ;SEE IF ONE DIR FILLED UP THE WHOLE REEL
JRST FOOF
SIXTYP A
PRINT [ DIRECTORY FILLS WHOLE REEL, CONTINUING ONTO ANOTHER REEL._]
SOS FLNI ;DO MOST RECENT FILE AGAIN
MOVEI A,ADMP2
JRST INTX1
FOOF: MOVEM A,FUSNM
SKIPGE FULLDMP
SETOM DMPMFD ;DUMP THE MFD AGAIN AT START OF NEXT REEL
SKIPGE FULLDMP
SETOM DMPDIR ;REDO SAME DIRECTORY AGAIN
SETOM APPENF ;SO USER UFD WILL BE OPENED
MOVEI A,DMPAGN ;RESTART LOCATION FOR NEXT REEL
INTX1: HRRZM A,INT+1
INTX: POP P,LPTSW
MOVSI 17,INTAC
BLT 17,17 ;RESTORE ACS
.DISMIS INT+1
MAYBE: PRINT GIVE UP ?
PUSHJ P,TYI
CAIE A,"Y
JRST FOOD
JRST MLP ;HE REALLY WANTS TO STOP DUMPING NOW
GESELL: SETOM SDONE
MOVEI A,1
SKIPE ARCHVF
MOVEM A,SDONE
PUSHJ P,SINFO
PRINT REEL
PDPT NTAPES ;OUTPUT REEL NUMBER AND USER SPAN ON THIS REEL
PRINT FIRST USER =
PSIS FUSNM
PRINT LAST USER =
PSIS LUSNM
JRST CRR
SUBTTL LOAD, RELOAD, DUMP, CDUMP COMMANDS
RELOAD: PRINT THIS WILL SMASH YOUR DIRECTORY.
PUSHJ P,CHECK
SETOM RELOSW ;RELOAD DISKS FROM TAPE
JRST LOAD
ACDUMP: SETOM CDMFL ;CONTINUE FULL DUMP
SKIPA
DUMP: CLEARM CDMFL
SETOM DMPMOD ;GENERALISED DUMP
SKIPA
LOAD: CLEARM DMPMOD ;GENERALISED LOAD
MOVSI A,-NFIGS ;CLEAR OPTIONS
CLEARM @FIGTB2(A)
AOBJN A,.-1
CLEARM MICFLG
CLEARM CUSN
SETOM DPACK
MOVEI A,1
MOVEM A,THTYPE
CAIN TER,15
JRST EXECU ;NO SWITCHES FORTH COMING
LOOP: PUSHJ P,TYI
CAIN A,"?
JRST FIGLST ;GIVE INFO ON OPTIONS AVAILABLE
PUSHJ P,GETSL1
POPJ P, ;OVER-RUBOUT, FLUSH
PUSHJ P,SPACET ;PROCESS OPTION
CAIN TER,15
JRST EXECU
JRST LOOP
SPACET: JUMPE SYM,CPOPJ
MOVSI A,-NFIGS
CAMN SYM,FIGTB1(A)
JRST SPASED
AOBJN A,.-2
SUB P,[1,,1] ;UNKNOW OPTION, BARF
PRINT ?
PSIS SYM
PUSHJ P,TYOS
PRINT IGNORED
PUSHJ P,TYOS
JRST LOOP ;BUT DON'T GIVE UP ENTIRELY
SPASED: SETOM @FIGTB2(A) ;SET FLAG FOR OPTION SPECIFIED
POPJ P,
FIGLST: PASC FIGHLP ;LIST OPTIONS AND DESCRIPTIONS
JRST LOOP
;CONTINUE LOADING WITH SAME OPTIONS COMMAND
ACLOAD: .SEE FLUSH ;AS IT STANDS, THIS CAN'T WORK!!
DIE SORRY THIS COMMAND DOESN'T WORK
MOVE A,CLOADF ;RESTORE OPTIONS
MOVEM A,DMPMOD
JUMPL A,[DIE [LAST OPERATION WAS DUMP]]
MOVE A,CLOADF+1
MOVEM A,RELOSW
MOVE A,CLOADF+2
MOVEM A,LENGTH
MOVSI A,-NFIGS
MOVEI B,3
ACLOD1: MOVE C,CLOADF(B)
MOVEM C,@FIGTB2(A)
ADDI B,1
AOBJN A,ACLOD1
SETOM ACLODF
JRST EXECU ;GO EXECUTE IT
;NOTE IF UPDATE THIS, UPDATE FIGTB2 AND FIGHLP (ALSO ON THIS PAGE)
FIGTB1: SIXBIT /INCREM/
SIXBIT /I/
SIXBIT /MERGE/
SIXBIT /M/
SIXBIT /FULL/
SIXBIT /F/
SIXBIT /CARE/
SIXBIT /C/
SIXBIT /EXPERI/
SIXBIT /E/
SIXBIT /LIST/
SIXBIT /L/
SIXBIT /SORRY/
SIXBIT /S/
SIXBIT /NOASK/
SIXBIT /DECIDE/
SIXBIT /D/
SIXBIT /DATE/
SIXBIT /DATES/
SIXBIT /ARCHIV/
SIXBIT /A/
SIXBIT /REAP/
SIXBIT /R/
SIXBIT /NO/
SIXBIT /LINKS/
SIXBIT /CRDIR/
NFIGS==.-FIGTB1
FIGHLP: ASCIZ\
INCREM, I Do an Incremental dump
FULL, F Do a Complete dump
LIST, L Generate a listing of files loaded or dumped
MERGE, M Don't load over existing file with the same name
CARE, C Don't load over files not yet backed up
EXPERI, E Don't set has-been-backed-up bits
SORRY, S Go ahead and load over files with newer creation dates
NOASK Don't ask whether a file should be loaded over, assume "no"
DATE Dump only files with creation date greater or equal specified
DATES Dump only files with creation date between two dates specified
ARCHIV, A Declare this dump tape to be Archival.
REAP, R Do a reap after dumping (don't use this, please)
DECIDE, D (Supposedly controls tape number assignment)
NO Don't check incremental dump (one pass instead of two)
LINKS Dump links as well as files
CRDIR Create directories that files are being loaded into
OPTIONS: \
FIGTB2: INCREM
INCREM
MRGSW
MRGSW
FULLDMP
FULLDMP
CAREF
CAREF
EXPERM
EXPERM
LSTWHL
LSTWHL
LOSRSW
LOSRSW
NOASK
DECIDF
DECIDF
DATEF
DATESF
ARCHVF
ARCHVF
REAPSW
REAPSW
CKIDMP
DMPLNK
CRDIR
IFN .-FIGTB2-NFIGS, .ERR FIGTB2 NOT SAME LENGTH AS FIGTB1
;NOTE: ABOVE LOCATIONS ARE MUNGED OVER BY EXECU AND
;THEN SET TO DIFFERENT VALUES THAN JUST WHETHER THE
;USER GAVE THE SWITCH OR NOT, IN SOME CASES.
;BEGIN EXECUTION OF LOAD OR DUMP OPERATION.
;FIRST STEP IS TO CLEAN UP OPTIONS AND ASK FOR ADDITIONAL INFO.
EXECU: MOVE A,DMPMOD ;SAVE CRUFT FOR 'CLOAD' COMMAND
MOVEM A,CLOADF
MOVE A,RELOSW
MOVEM A,CLOADF+1
MOVSI A,-NFIGS
MOVEI B,3
EXECU0: MOVE C,@FIGTB2(A)
MOVEM C,CLOADF(B)
ADDI B,1
AOBJN A,EXECU0
;Make sure the tape is not positioned in the middle of a file
;Also decide whether the first thing read/written should be a tape header
MOVE A,TAPEF ;Tape status left by SETIT
TRNN A,TF%BOT
JRST [ PUSHJ P,SPRF ;Space reverse file
PUSHJ P,SETIT1 ;Get status again
TRNE A,TF%BOT
JRST .+1 ;That moved it to beginning of tape
PUSHJ P,SPFF ;Get to beginning of next file
JRST .+2 ]
SETOM THTPN ;At front of tape, we don't know the number
SKIPE REAPSW
PUSHJ P,REAPCK
SETZM NPLACE
SKIPGE DATESF
SETOM DATEF
SETZM NFTDMP
SKIPGE CDMFL
SETOM FULLDMP ;CDUMP IS A FULL ONE
CLEARM PACKN
SKIPE MICFLG
CLEARM INCREM ;NO INCREMENTAL DUMPS FROM DEC-TAPE
SETZM THTYPE ;DEFAULT TO RANDOM TYPE OF TAPE
; Removed by Alan 11/17/86, who didn't think it was a feature.
; SKIPGE DATEF
; SETOM FULLDMP ;DATES SPECIFIED => DUMP ALL
SKIPGE FULLDMP
SETOM EXPERM ;IF DUMPING ALL, DON'T SET DMPCHK BIT!
SKIPGE DATESF
SKIPE ACLODF
CAIA
PUSHJ P,GETUDT ;GET UPPER DATE
SKIPGE DATEF
SKIPE ACLODF
CAIA
PUSHJ P,GETLDT ;GET LOWER DATE
SKIPGE FULLDMP
AOS THTYPE
SKIPGE INCREM
SOS THTYPE
SKIPGE A,INCREM
SETOM FULLDMP ;AN INCREMENTAL DUMP IS ALWAYS A FULL ONE
SKIPN ACLODF
JRST [ SKIPGE DMPMOD
SKIPL FULLDMP
PUSHJ P,FILGET ;GET FILE NAMES OF FILES TO DUMP OR LOAD
JRST .+1 ]
SKIPE LSTWHL
SKIPE ACLODF
CAIA
PUSHJ P,DEVGET ;GET LISTING DEVICE
SETZM ACLODF
.SUSET [.SSNAME,,USNM]
SKIPN DMPMOD
JRST RETRV0 ;LOAD
SKIPL CDMFL
SKIPE ITAPE
CAIA
CLEARM NTAPES ;COMMAND WAS DUMP ONLY DO THIS IF NOT CDUMP AND TAPE IS REWOUND
SETOM MFDIN
SETOM FLNI
SKIPE CDMFL
JRST EXECU1
SKIPL FULLDMP
JRST ADUMP2 ;SINGLE FILE DUMP
SETOM DMPMFD ;STARTING FULL OR INCREMENTAL DUMP, SO
SETOM DMPDIR ;DUMP THE MFD AT THE FRONT AND DUMP
JRST ADMP1 ;EACH UFD THAT HAS CHANGED.
REAPCK: PUSHJ P,CRR
PRINT YOU SPECIFIED REAP
PUSHJ P,CHECK
POPJ P,
GETUDT: PRINT LATEST DAY -
PUSHJ P,GETDAT
MOVE A,DATE
HLLOM A,DATE1
POPJ P,
GETLDT: PRINT EARLIEST DAY -
JRST GETDAT
SUBTTL CONTINUING A COMPLETE DUMP, GET TAPE AND MFD BACK INTO PHASE
;TAPE FILE MISSING, DO REEL OVER
EXECU2: PRINT _MAY I REWIND AND RESTART THIS REEL ??
PUSHJ P,CHECK2
PUSHJ P,ARWND
PRINT ON THE LAST REEL_
EXECU1: SKIPGE ITAPE ;REWOUND ???
JRST SETFNG ;YES
PUSHJ P,TAPEMB
PUSHJ P,SNPLAC
MOVEI A,.BII
HRLM A,NSVOP
OPEN SAVET,NSVOP ;GET .TAPEn; TAPE nnn FILE
JRST EXECU2
MOVE B,[-LTHBLK-1,,BUF] ;FIND OUT LAST USER DUMPED
.IOT SAVET,B
SETOM A
EXECU3: MOVE B,[-2000,,BUF]
EXECU4: SKIPL A
JRST LOOKSM
.IOT SAVET,B
HLLZS B
SKIPGE B
SETZM A
MOVE C,[-2000,,BUF]
SUB C,B
SETOM D
EXECU5: CAME D,(C)
AOBJN C,EXECU5
HLRE B,C
SKIPN B
JRST EXECU3 ;COUNT RAN OUT
AOJE B,EXECU6 ;ON BLOCK BOUNDRY?
AOBJN C,.+1
MOVE B,(C)
MOVEM B,USNM
JRST EXECU5
EXECU6: HRROI B,USNM
.IOT SAVET,B
MOVE B,[-1777,,BUF+1]
SETZM BUF
JRST EXECU4
LOOKSM: PUSHJ P,SPRF ;BACK OVER TWO FILES
PUSHJ P,SPRF
PUSHJ P,SETIT1 ;Get tape status
TRNN A,TF%BOT ;Unless BOT,
PUSHJ P,SPFF ; Forward one file
PUSHJ P,SETIT
SKIPGE ITAPE ;DID WE BACK UP TO BEGINING OF TAPE ???
JRST SETFNG ;YES
PUSHJ P,MAGOP ;READ HEADER FOR DIRECTORY NAME
.VALUE ;EOT AFTER BACKSPACING ?????
MOVE A,USNM ;IS DIRECTORY NAME OF FILE ON TAPE THE SAME
CAME A,HSNM ; AS THE ONE WE ARE LOOKING FOR ???
JRST LOOKSM ;NO
PUSHJ P,FILSKP ;YES, FLUSH TO END OF THIS FILE
MOVE B,USNM ;I.E. END OF LAST DIRECTORY DUMPED ON TAPE
JRST KSUSER
SETFNG: PUSH P,LPTSW
SETZM LPTSW
PRINT WHAT WAS THE LAST DIRECTORY DUMPED ?
POP P,LPTSW
PUSHJ P,GETSYL
JRST SETFNG
MOVE B,SYM
;HAVING FOUND WHAT DIRECTORY TO CONTINUE DUMPING WITH, ADVANCE
;MFD TO THERE, THEN JOIN REGULAR DUMP CODE
KSUSER: PUSHJ P,MFDN
DIE NO SUCH DIRECTORY
CAME B,USNM
JRST KSUSER
JRST ADMP1 ;GOT IT, START THE DUMP
SUBTTL DUMPING FROM USER-GIVEN FILE LIST
;RUNS THROUGH ALL FILES IN WORLD, IF THEY MATCH DUMP 'EM
ADUMP2: SETZM STYPE
SETOM MFDIN
NXUFD: PUSHJ P,MFDN ;GET SNAM INTO USNM
JRST DUNG ;NO MORE SNAMES LEFT
MOVN W,LENGTH
HRLZS W ;MAKE AOBJN POINTER TO FILE SPEC LIST
SNMCHK: SKIPN A,FMSNM(W)
JRST UGLY ;ANY SNAME MATCHES, INVESTIGATE
CAMN A,USNM
JRST UGLY ;SOME SNAME MATCHES, INVESTIGATE
AOBJN W,SNMCHK ;CONTINUE CHECKING
JRST NXUFD ;NO MATCH POSSIBLE
;SNAME MATCHES, RUN THROUGH ALL FILES ON THIS DIRECTORY
UGLY: MOVEI V,0
SETOM GREATF ;FOR > AND < FILE HACKERY
.SUSET [.SSNAM,,USNM]
SETOM FLNI
NXFIL: PUSHJ P,FNG
JRST EODIRK ;NO MORE FILES IN THIS DIRECTORY
MOVN W,LENGTH
HRLZS W ;AOBJN POINTER TO FILE SPECS LIST
MOVS A,FMDEV(W)
HRLI A,.BII
MOVEM A,TRNI
CMCON: SKIPN D,FMSNM(W)
JRST CMFN1
CAME D,USNM
JRST NXCOM
CMFN1: SKIPN D,FMFN1(W)
JRST CMFN2
CAME D,[SIXBIT /</]
CAMN D,[SIXBIT />/]
CAIA
JRST RCMFN1
SKIPN LNKFLG
MOVEM D,FN1
SETZM GREATF
JRST CMFN2
;SNAME AND FN1 SEEM TO MATCH, THINK ABOUT FN2
RCMFN1: CAME D,FN1
JRST NXCOM
CMFN2: SKIPE D,FMFN2(W)
CAMN D,FN2
JRST DUMPIT
CAME D,[SIXBIT /</]
CAMN D,[SIXBIT />/]
CAIA
JRST NXCOM
SKIPN LNKFLG ;'>' AND '<' FILES DON'T GET OPENED FOR LINKS
MOVEM D,FN2
SETZM GREATF ;WE FOUND A < OR >
JRST DUMPIT
NXCOM: AOBJN W,CMCON
JRST NXFIL
;END OF DIRECTORY
EODIRK: PUSHJ P,FILAPP
SKIPGE APPENF ;ANY FILES DUMPED FOR THIS USER ???
JRST NXUFD
EODIR3: MOVN W,LENGTH ;YES, MAYBE REMOVE SOME SPECS
HRLZS W
EODIR2: CAMN A,USNM ;IS THIS ENTRY ONE FOR USER JUST DUMPED ?
JRST REMOVE ;YES
EODIR1: AOBJN W,EODIR2 ;NO
JRST NXUFD
REMOVE: SKIPN FMDUMP(W)
JRST EODIR1 ;DON'T REMOVE SPEC IF NOTHING EVER MATCHED IT
PUSHJ P,FLUSH ;DELETE SPEC
POPJ P, ;NO MORE SPECS LEFT
ADD W,[1,,]
JRST EODIR2
;OK, DUMP THE FILE
DUMPIT: SKIPE LNKFLG
JRST AWRITE
.SUSET [.SSNAM,,USNM] ;IF NOT LINK, SEE IF ALREADY DUMPED
OPEN DSKIN,TRNI
JRST NXCOM ;JUST CONTINUE
MOVE A,[DSKIN,,TRNI]
PUSH P,TRNI
.RCHST A,
POP P,TRNI
MOVEI A,0
MOVE B,FN1
MOVE C,FN2
LOOP69: CAML A,V
JRST APPEND
CAME B,BIF(A)
JRST LUP691
CAMN C,BIF+1(A)
JRST EODIR3
LUP691: ADDI A,2
JRST LOOP69
APPEND: MOVEM B,BIF(A)
MOVEM C,BIF+1(A)
ADDI V,2
JRST AWRITE
;ACTUALLY WRITE OUT THE FILE.
AWRITE: PUSHJ P,ADMP3
SETOM FMDUMP(W) ;MARK THIS ARG AS HAVING BEEN SATISFIED AT LEAST ONCE
SKIPN FMSNM(W)
JRST NXCOM ;DON'T DELETE ENTRY IF ANY "*" IN IT
SKIPE FMFN1(W)
SKIPN FMFN2(W)
JRST NXCOM
PUSHJ P,FLUSH
POPJ P,
ADD W,[1,,]
SOJA W,NXCOM
;DONE DUMPING, SEE IF ANY SPECS WEREN'T SATISFIED.
DUNG: MOVN W,LENGTH
HRLZS W
REMOV2: SKIPN FMSNM(W)
JRST REMOV1 ;"*;"
SKIPE FMFN1(W) ;"* *"
SKIPN FMFN2(W)
JRST REMOV1
REMOV3: AOBJN W,REMOV2
PRINT _NOT DUMPED:_
MOVN W,LENGTH
HRLZS W
NOREM1: IRP X,,[SNM,FN1,FN2]
SKIPN A,FM!X(W)
MOVSI A,(SIXBIT /*/)
PSIS A
IFSE X,SNM,[PASC [ASCIZ /;/]]
TERMIN
PUSHJ P,CRR
AOBJN W,NOREM1
POPJ P,
REMOV1: SKIPL FMDUMP(W) ;WAS ANYTHING DUMPED FOR THIS SPEC ??
JRST REMOV3 ;NO
PUSHJ P,FLUSH
POPJ P,
ADD W,[1,,]
JRST REMOV2
SUBTTL DUMPING ALL FILES (FULL OR INCREMENTAL)
ADMP1: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF DON'T HAVE YET
PUSHJ P,MFDN ;READ A LOSER NAME FROM M.F.D.
JRST RAT ;DONE
SKIPE LSTWHL ;LIST ?
PUSHJ P,LDMUT1
ADMPL1: MOVE A,USNM
SKIPGE ITAPE
MOVEM A,FUSNM ;FIRST LOSER DUMPED
.SUSET [.SSNAM,,A] ;SO FNG READS THE CORRECT DIRECTORY
;COME HERE OUT OF END-OF-REEL INTERRUPT
DMPAGN: SETOM FLNI ;RESTART ON NEW REEL
SKIPL FULLDMP
POPJ P, ;THIS PROBABLY RETURNS FROM ADMP3
;IN THE CASE OF A GFR OR FILE BY FILE
;DUMP THAT USES UP THE REEL. CLEARLY
;THE WRONG THING TO DO, BUT CLOSE.
SETOM DMPUFD
SETOM DMPDIR
.SUSET [.SSNAM,,USNM]
PUSHJ P,ADMP4 ;DUMP THE DIR AND RETURN
;THIS IS WHERE COMPLETE AND INCREMENTAL DUMPS LOOP
ADMP2: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF NEEDED
.SUSET [.SSNAM,,USNM]
PUSHJ P,FNG ;READ ANOTHER FILE NAME
JRST FULNMF ;NO MORE
MOVE A,PACKN
SKIPL DPACK ;RIGHT PACK ?
CAMN A,DPACK
PUSHJ P,ADMP3 ;YES, OR ANY WILL DO, CALL DUMPER
JRST ADMP2 ;NOT RIGHT PACK
FULNMF: PUSHJ P,FILAPP ;END OF THIS DIRECTORY, FINISH
JRST ADMP1 ;AND GO BACK FOR MORE
;PRINT LISTING LINE WHEN STARTING A NEW UFD
LDMUT1: PUSHJ P,CRR
PUSHJ P,TAPN ;PRINT SEQUENCE NUMBER
PSIS USNM ;PRINT DIRECTORY NAME
PUSH P,LPTSW
SETZM LPTSW
PUSHJ P,CRR
PSIS USNM ;PRINT JUST DIRECTORY NAME ON CONSOLE
POP P,LPTSW
POPJ P,
;INCREMENT FILE SEQUENCE NUMBER AND PRINT IT
TAPN: MOVE D,ITAPE
AOS D
PDPT D
POPJ P,
;DUMP A FILE (FROM EITHER TYPE OF DUMP)
;THIS IS A SUBROUTINE. CALL WITH SNAME SET UP AND NAME IN FN1, FN2
ADMP3: SKIPE LNKFLG
JRST ADMP4
OPEN DSKIN,TRNI ;OPEN DISK INPUT
POPJ P, ;FILE DOESN'T SEEM TO EXIST AFTER ALL
.CALL [ SETZ ? 'FILLEN ? MOVEI DSKIN ? SETZM A] ;A GETS NUMBER OF WORDS IN FILE
.LOSE %LSFIL
CAMGE A,[2500.*2000] ; :BUG MUDDLE BEFORE DECREASING THIS CONSTANT!
JRST ADMP4 ;FILE NOT TOO BIG
PUSH P,LPTSW
SETZM LPTSW
PRINT _
.SUSET [.RSNAME,,A]
PSIS A
PRINT [;]
PSIS FN1
PSIS FN2
PRINT [ - FILE IS TOO DAMNED BIG, ]
;SKIPN GFRFLG ;IF DOING GFR, DUMP ANYWAY, USER CAN QUIT OUT AND DELETE
SKIPGE FULLDMP ; THE FILE IF THAT BECOMES NECESSARY.
JRST [ ;IF DOING INCREMENTAL OR FULL, DON'T DUMP IT
PRINT [NOT DUMPED._]
POP P,LPTSW
POPJ P, ]
PRINT [IT MAY NOT FIT ON TAPE, WILL TRY ANYWAY._]
POP P,LPTSW
ADMP4: MOVEM P,ERRPDP ;SAVE STUFF IN CASE OF REMOTE TAPE ERROR
MOVEM 16,INTAC+16
MOVEM 17,INTAC+17
MOVEI 16,INTAC
BLT 16,INTAC+15
MOVE 16,INTAC+16
PUSHJ P,TAPEMB
AOSE APPENF ;SKIP IF FIRST FILE THIS DIRECTORY
JRST ADMP5
PUSHJ P,SNPLAC
SETZM USRUFD
ADMP5:
IFE MCOND DM,[
SKIPGE ITAPE
PUSHJ P,EXTPCK ; TAPE ALREADY EXIST?
]
.SUSET [.SSNAM,,USNM] ;SO .OPEN DSKIN, LOOKS ON THE CORRECT DIRECTORY
SKIPE MAGOPN ; OPEN YET?
JRST ADMP7 ; YES
SETOM MAGOPN
SKIPL TAPTYP
JRST ADMP6 ;Local tape
PUSHJ P,RMTSTS ;Make sure it's mounted (this also
TRNE A,TF%RDY ; drains queued status)
JRST ADMP7
DIE OUTPUT TAPE NOT MOUNTED
ADMP6: OPEN MAGOUT,MAGO ;OPEN MAG TAPE OUTPUT
JRST RET
ADMP7: SETOM EOTFLG
AOSE ITAPE ;BEGINNING OF TAPE ?
JRST LP2A ;NO
PUSH P,LPTSW
SETZM LPTSW
PUSHJ P,GINFO
SKIPG SDONE
JRST LP2B
PRINT THAT'S AN ARCHIV TAPE.
PUSHJ P,CHECK ;ALREADY DELETED THE TAPE FILE FOR IT???
LP2B: MOVSI A,-1 ;TEST TAPE # BUT NOT REEL #
SKIPE SDONE
TDNN A,STAPEN ;CHECK FOR REUSE OF RECENT TAPE
JRST LP2BB ;THAT WASN'T ABORTED, AND NOT TAPE0
MOVE A,STDATE
PUSHJ P,SBDTTN ;CONVERT TAPE DATE TO NUMBER OF DAYS
MOVE B,A
.RDATE A, ;CURRENT DATE
PUSHJ P,SBDTTN
ADDI B,30.
CAMLE A,B
JRST LP2BB
PRINT THAT TAPE IS LESS THAN 30 DAYS OLD
PUSHJ P,CHECK
LP2BB: POP P,LPTSW
SETZM NSVTPN+1 ;BOT, START A NEW .TAPEn; TAPE nnn FILE
.SUSET [.SSNAM,,NPLACE]
.FDELE NSVOP ;SO WE DON'T APPEND TO ANY OLD ONE
JFCL
.SUSET [.SSNAM,,USNM]
SETZM SDONE
AOSE A,NTAPES ;IS THIS THE FIRST RUN FOR THIS LOADING?
SOS A,NTAPES ;NO. WE WEREN'T SUPPOSED TO TOUCH NTAPES
HRRM A,THTPN ;REEL NUMBER IN CURRENT DUMP
PUSHJ P,SINFO
.RDATE A,
MOVEM A,THDATE
;.SUSET [.RSNAM,,E] ;doesn't seem to get used.
JRST LP2C
EXTPCK: .SUSET [.SSNAM,,NPLACE]
HLRZ A,NSVOP
HRRZS NSVOP .SEE .UAI
.OPEN DSKOUT,NSVOP
JRST EXTPK1
HRLM A,NSVOP
PUSH P,LPTSW
SETZM LPTSW
PRINT YOU ARE NOT AT THE END OF TAPE.
PUSHJ P,CRR
PRINT YOU WILL DESTROY USEFUL DATA!
POP P,LPTSW
JRST CHECK
EXTPK1: HRLM A,NSVOP
POPJ P,
;COMPLETE OR INCREMENTAL DUMP IS, UH, COMPLETE.
;NOTE SIMILARITY OF THIS CODE TO 'FOOB'
RAT: PUSH P,LPTSW ;REPORT THE CRUD TO TTY
SETZM LPTSW
PUSHJ P,GESELL ;SAY WHAT USERS ON THIS REEL
PUSHJ P,CLSOUT ;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE
SKIPE INCREM
SKIPE CKIDMP
JRST RAT2
SKIPE EXPERM
JRST RAT2
;MUST CHECK, AND SET DUMPCHECK BITS
SETOM LUSNM ;SO WE WILL GET LAST USER
PRINT _REWINDING
IFE MCOND DM,[
MOVN N,NFTDMP ;[SOMEONE SHOULD DOCUMENT THIS]
MOVE B,NFTDMP
SOS B
CAMN B,ITAPE ;IF EQUAL, THEN IT IS THE WHOLE TAPE
JRST RAT1
PUSHJ P,ASPAC1
SKIPA
]
RAT1: PUSHJ P,ARWND
PRINT _CHECKING INCREMENTAL DUMP
PUSHJ P,ICHECK
PUSHJ P,ARWND
RAT2: POP P,LPTSW
SKIPN REAPSW ;DO REAP IF ASKED
JRST RET
JRST INCGFR
;CONVERT SIXBIT DATE IN A TO NUMBER OF DAYS IN A
SBDTTN: CAMN A,[-1]
POPJ P,
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
MOVE B,[440600,,A]
PUSHJ P,SBDTN1 ;YEARS
IMULI C,12.*31. ;EL CHEAPO!
MOVE D,C
PUSHJ P,SBDTN1 ;MONTHS
IMULI C,31.
ADD D,C
PUSHJ P,SBDTN1 ;DAYS
ADD D,C
MOVE A,D
POP P,E
POP P,D
POP P,C
POP P,B
POPJ P,
;GET TWO SIXBIT CHARS AND CONVERT TO NUMBER IN C
SBDTN1: ILDB E,B
SUBI E,"0
ILDB C,B
SUBI C,"0
IMULI E,10.
ADD C,E
POPJ P,
;HERE'S THE ROUTINE THAT ACTUALLY, FINALLY, WRITES ON THE TAPE.
;HERE IF NEED A TAPE HEADER FIRST (WE'RE AT FRONT OF TAPE)
LP2C: MOVE A,[THBLK,,LISTBF] ;LISTBF IS BUFFER FOR OUTPUT TO
ADD A,USRUFD ;THE .TAPEn; TAPE nnn FILE
BLT A,LISTBF+LTHBLK-1(USRUFD)
MOVE A,[-3,,0]
ADDI USRUFD,LTHBLK
MOVEM A,LISTBF(USRUFD)
AOS USRUFD
MOVE A,[-LTHBLK,,THBLK] ;OUTPUT TAPE-HEADER
PUSHJ P,MAGWRI
;HERE IF NOT AT FRONT OF TAPE
LP2A: AOSN DMPDIR
JRST DIRDMP ;DON'T DUMP A FILE, DUMP A DIR INSTEAD.
PUSHJ P,DFHBLK ; Set defaults in file header
MOVE A,USNM ;SET UP FILE HEADER
MOVEM A,HSNM
MOVE A,FN1
MOVEM A,HFN1
MOVE A,FN2
MOVEM A,HFN2
MOVE A,PACKN
MOVEM A,HPKN
MOVE A,[SETZ]
MOVEM A,HDATE ;CREATION DATE OF LINK IS 400000,,0
MOVEI A,3
MOVEM A,HLEN ; Length of link is always 3
SKIPE LNKFLG
JRST LP3A
.CALL RHDATS
PUSHJ P,DFHDTS ; So the dates are unknown
SKIPE A,RFDATE ; Except if we are about to set the date
HLLM A,HRDATE ; below, then use that.
.CALL RHLEN
SETOM HLEN ; So the length is unknown
LP3A: MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER
PUSHJ P,MAGWRI
MOVE A,HBLK+2
MOVEM A,LISTBF(USRUFD)
MOVE A,HBLK+3
MOVEM A,LISTBF+1(USRUFD)
MOVE A,HBLK+5
MOVEM A,LISTBF+2(USRUFD)
ADDI USRUFD,3
SKIPE LSTWHL
PUSHJ P,LOUSY ;GENERATE LISTING LINE
JFCL
SKIPE LNKFLG
JRST LP4A
SKIPN RFDATE
JRST LP
.CALL SRFDAT
JFCL
LP: MOVE A,[-2000,,BUF] ;OUTPUT THE FILE
.IOT DSKIN,A
HRLOI B,-BUF-1(A)
EQVI B,BUF ;AOBJN POINTER TO STUFF ACTUALLY READ
SKIPGE A
.CLOSE DSKIN,
JUMPGE B,LP1
EXCH A,B
PUSHJ P,MAGWRI
JUMPGE B,LP ;MORE TO DO ?
LP1: SKIPN CKIDMP
JRST LP1A
SKIPN MICFLG ;DON'T BOTHER CHECKING, SET DUMPCHECK
SKIPE EXPERM ;BITS NOW.
JRST LP1A
OPEN DSKIN,TRNI ;RE-OPEN SINCE CLOSED BY EOF
JRST LP1A
.CALL SRFDAT
JFCL
MOVE A,[400000,,DSKIN]
.DMPCH A, ;SET DUMP CHARACTER SO WONT BE
.CLOSE DSKIN, ; INCREMENTALLY DUMPED AGAIN.
LP1A: PUSHJ P,AEOF ;WRITE EOF MARK ON TAPE
MOVE A,USNM
MOVEM A,LUSNM ;LAST LOSER DUMPED
AOS NFTDMP
POPJ P, ;RETURN FROM ADMP3
LP4A: MOVE A,[-3,,LNKNM1] ;DUMP A LINK AS A 3 WORD FILE
PUSHJ P,MAGWRI ; LKNM1,LKNM2,SNAM
JRST LP1A
;HERE IF DUMPING A DIRECTORY RATHER THAN A FILE
DIRDMP: .IOPUSH DSKIN, ;PROTECT FILE ALREADY OPEN MAYBE
AOSN DMPMFD
PUSHJ P,MFDDMP
AOSN DMPUFD
PUSHJ P,UFDDMP
.IOPOP DSKIN,
SKIPL FULLDMP
JRST LP2A ;NOT A FULL DUMP, GO BACK
POPJ P, ;RETURN TO ADMP2
MFDDMP: HRRI A,.BII
HRLM A,MFO
.OPEN DSKIN,MFO
POPJ P,
MOVE A,[-2000,,MFDBUF]
.IOT DSKIN,A
PUSHJ P,DFHBLK ; Set defaults in HBLK
MOVE A,USNM
MOVEM A,HSNM
MOVE A,MFO+1
MOVEM A,HFN1
MOVE A,MFO+2
MOVEM A,HFN2
.CALL RQDATE
JFCL
MOVEI A,2000 ; MFD is always 2000 words long
MOVEM A,HLEN
MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER
PUSHJ P,MAGWRI
MOVE A,HBLK+2
MOVEM A,LISTBF(USRUFD)
MOVE A,HBLK+3
MOVEM A,LISTBF+1(USRUFD)
MOVE A,HBLK+5
MOVEM A,LISTBF+2(USRUFD)
ADDI USRUFD,3
SKIPE LSTWHL
PUSHJ P,LOUSY
JFCL
AOS ITAPE
MOVE A,[-2000,,MFDBUF]
PUSHJ P,MAGWRI
PUSHJ P,AEOF
AOS NFTDMP
POPJ P,
UFDDMP: HRRI A,.BII
HRLM A,FNO
.OPEN DSKIN,FNO
POPJ P,
MOVE A,[-2000,,UFDBUF]
.IOT DSKIN,A
PUSHJ P,DFHBLK ; Set defaults in HBLK
MOVE A,USNM
MOVEM A,HSNM
MOVE A,FNO+1
MOVEM A,HFN1
MOVE A,FNO+2
MOVEM A,HFN2
.CALL RQDATE
JFCL
MOVE A,UDESCP+UFDBUF ; Calculate how many words we're actually
ADDI A,5 ; going to dump out below.
IDIVI A,6
ADDI A,UDDESC+2000
SUB A,UDNAMP+UFDBUF
MOVEM A,HLEN
MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER
PUSHJ P,MAGWRI
MOVE A,HBLK+2
MOVEM A,LISTBF(USRUFD)
MOVE A,HBLK+3
MOVEM A,LISTBF+1(USRUFD)
MOVE A,HBLK+5
MOVEM A,LISTBF+2(USRUFD)
ADDI USRUFD,3
SKIPE LSTWHL
PUSHJ P,LOUSY
JFCL
MOVE A,UDESCP+UFDBUF ;PACK DIRECTORY BY NOT DUMPING FREE AREA
ADDI A,5
IDIVI A,6 ;ROUND UP TO NEXT HIGHER WORD
ADDI A,UDDESC ;DUMP HEADER AREA TOO
MOVNS A
HRLS A
HRRI A,UFDBUF ;DUMP OUT DESC AREA
PUSHJ P,MAGWRI
MOVE A,UDNAMP+UFDBUF
SUBI A,2000
HRLS A
HRR A,UDNAMP+UFDBUF
ADDI A,UFDBUF ;DUMP OUT NAME AREA
PUSHJ P,MAGWRI
PUSHJ P,AEOF
AOS NFTDMP
POPJ P,
;CALL HERE AFTER DUMPING ALL THE FILES IN A SINGLE DIRECTORY
;UPDATE .TAPEn; TAPE nnn FILE (TAPE DIRECTORY)
FILAPP: SKIPGE APPENF
POPJ P, ;NOTHING WAS DUMPED FOR THIS USER
MOVEI A,.BII
HRLM A,NSVOP
.SUSET [.SSNAM,,NPLACE]
.OPEN SAVET,NSVOP
JRST KARILY ;FIRST TIME THROUGH
PUSHJ P,ACCESS
MOVEI A,100007 ;WRITE-OVER MODE
HRLM A,NSVOP
FILAP0: OPEN SAVET,NSVOP
JRST [ PUSH P,LPTSW
SETZM LPTSW
PRINT [TYPE ANY CHARACTER TO TRY AGAIN] ;MAYBE SOMEONE HAS IT OPEN
PUSHJ P,TYI
PUSHJ P,CRR
POP P,LPTSW
JRST FILAP0 ] ;KEEP TRYING UNTIL IT WORKS, DON'T PUNT THE WHOLE DUMP
.ACCESS SAVET,B ;WE'RE ABOUT TO APPEND "USER" UFD" ONTO "TAPE XXX"
FILAP1: MOVE A,[-1,,[0]]
.IOT SAVET,A ;CREATE SNAME ENTRY
HRROI A,USNM
.IOT SAVET,A
FLY: MOVNS USRUFD
HRLS USRUFD
HRRI USRUFD,LISTBF
.IOT SAVET,USRUFD
.CLOSE SAVET,
POPJ P,
;GOTTA CREATE THE TAPE DIRECTORY
KARILY: MOVEI A,.BIO
HRLM A,NSVOP
OPEN SAVET,NSVOP
JRST RET
MOVE A,[-LTHBLK-1,,LISTBF] ;PUT HEADER
.IOT SAVET,A
MOVE A,[-1,,[0]] ;THEN PUT CHANGE-SNAME TO THIS DIR
.IOT SAVET,A
HRROI A,USNM
.IOT SAVET,A
SUBI USRUFD,LTHBLK+1 ;THEN DUMP OUT THIS DIR'S INFO
MOVNS USRUFD
HRLS USRUFD
HRRI USRUFD,LISTBF+LTHBLK+1
.IOT SAVET,USRUFD
.CLOSE SAVET,
POPJ P,
ACCESS: MOVEI B,0 ;ACCUMULATED ACCESS POINTER
MORCRF: MOVE A,[-2000,,BUF] ;THIS ROUTINE ACCESSES TO THE END OF THE FILE
.IOT SAVET,A ;THIS READING ONLY TO GET POINTER
HLRE C,A
ADDI B,2000(C) ;INCREMENT ACCESS POINTER
JUMPGE A,MORCRF ;CONTINUE READING
POPJ P,
;DETERMINE INTELLIGENTLY WHETHER OR NOT TO ASK FOR
;TAPE AND REEL NUMBER
;AND ASK WHAT IS NECESSARY
TAPEMB: SKIPL THTPN
JRST ADMPK1 ;WE ALREADY KNOW WHAT TAPE THIS IS
ADMPK: PUSHJ P,TAPGET
MOVEM SYM,NSVTPN
SKIPGE CDMFL ;DON'T ASK REEL # FOR NOT CDUMP
SKIPL NTAPES ;DON'T ASK REEL # IF YOU KNOW IT
JRST ADMPK1 ;WE ALREADY KNOW WHAT REEL THIS IS
PUSH P,LPTSW
SETZM LPTSW
PRINT REEL =
POP P,LPTSW
PUSHJ P,GETSYL
JRST .-1
HRRM N,THTPN
MOVEM N,NTAPES
ADMPK1: POPJ P,
SUBTTL DUMP A FILE TO THE FILECOMPUTER
;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP AND NAME IN FN1, FN2
FCDMP: SKIPE LNKFLG ;IF INPUT FILE IS A LINK
POPJ P, ;DONT BOTHER WITH IT HERE.
.CALL [ SETZ ? SIXBIT/OPEN/ ? [.UIO,,DSKIN]
GFRDEV ? FN1 ? FN2 ? 400000,,SNAME] ;TRY TO OPEN INPUT FILE.
POPJ P, ;OH,WELL.
FCDMP0: .CALL [ SETZ ? SIXBIT/OPEN/ ;PROBE FOR DIRECTORY ON FC:
[.UAI,,DSKOUT]
[SIXBIT /FC/]
[SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
400000,,SNAME]
JRST [ .CLOSE DSKOUT
PUSHJ P,CFCDIR ;IF MISSING, TRY TO CREATE IT.
PUSHJ P,FCDDLS ; UMMM, GEE. IT DIDNT WORK?
JRST FCDMP1] ; YOW! NOW WE CAN HAVE FUN!
.CLOSE DSKOUT
FCDMP1: .CALL [ SETZ ? SIXBIT/OPEN/ ;OPEN OUTPUT FILE.
[.UIO,,DSKOUT]
[SIXBIT /FC/] ? FN1 ? FN2 ? 400000,,SNAME]
JRST FCDLOS
PUSHJ P,FCDMP4 ;GET PAGES FOR THE BUFFER.
FCDMPI: MOVE U,[444400,,BUFFER] ;SETUP FOR FULL WORD TRANSFERS.
MOVEI W,BUFSIZ*PAGSIZ
.CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,W]
.LOSE %LSFIL
MOVEI V,BUFSIZ*PAGSIZ
SUB V,W ;HOW MUCH MORE TO GO?
JUMPE V,FCDMPZ
MOVE U,[444400,,BUFFER]
MOVEI W,BUFSIZ*PAGSIZ
.CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,V]
.LOSE %LSFIL
JRST FCDMPI
FCDMPZ: .CLOSE DSKOUT, ;CLEAN UP WHEN DONE.
FCDMP3: .CLOSE DSKIN,
POPJ P,
FCDMP4: SKIPE FCDMAP ;IF WE ALREADY GOT SOME BUFFER PAGES
POPJ P, ;DONT GET 'EM TWICE!
MOVE X,[-BUFSIZ,,<BUFFER+PAGSIZ-1>/PAGSIZ]
.CALL [ SETZ ? SIXBIT/CORBLK/
%CLIMM,,%CBNDR\%CBNDW
%CLIMM,,%JSELF
X
400000+%CLIMM,,%JSNEW]
.LOSE %LSSYS
SETOM FCDMAP
POPJ P,
FCDDLS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY.
SETZM LPTSW
PRINT [FILECOMPUTER DIRECTORY CREATION FAILED - MAYBE FC IS DOWN?]
POP P,LPTSW
POPJ P, ;AND PUNT OUT.
FCDLOS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY.
SETZM LPTSW
PRTFNS
PRINT [NOT COPIED TO FILECOMPUTER.]
POP P,LPTSW
POPJ P, ;AND PUNT OUT.
SUBTTL CREATE A USER DIRECTORY ON THE FC: FILECOMPUTER DEVICE
;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP.
;SKIPS IF SUCCESSFUL.
CFCDIR: .CALL [ SETZ ? SIXBIT/OPEN/
[.UIO,,DSKOUT]
[SIXBIT/FC/]
[SIXBIT /..NEW./]
[SIXBIT /(UDIR)/]
SNAME
400000+%CLERR,,X ]
JFCL
CAIN X,%ENSFL ;IF WE GOT AN FNF ERROR
AOS (P) ;WE WON.
POPJ P, ;OTHERWISE WE LOSE SOMEHOW
SUBTTL GRIM FILE REAPER
;FIRST, PROCESS OPTIONS LIKE 'LOOP'
AGFR: SETOM THTPN
MOVSI A,-NGFRSW
SKIPGE GFRTB2(A)
CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT
AOBJN A,.-2
SETZM GFRPNM ;START WITH NO PACKS TO REAP OFF OF
SETZM GFRDEV ;DEFAULT IS TO WRITE TO TAPE
CAIN TER,15
JRST RET ;NO OPTIONS? DO NOTHING.
GFRLP1: PUSHJ P,TYI
CAIN A,"?
JRST GFRPHL ;GIVE INFO ON OPTIONS AVAILABLE
PUSHJ P,GETSL1
POPJ P, ;OVER-RUBOUT? DO NOTHING.
PUSHJ P,GFRSPT
CAIN TER,15
JRST GFREXC
JRST GFRLP1
GFRSPT: JUMPE SYM,CPOPJ
MOVSI A,-NGFRSW
CAMN SYM,GFRTB1(A)
JRST GFRSPD
AOBJN A,.-2
SUB P,[1,,1] ;BAD OPTION, IGNORE
PRINT ?
PSIS SYM
PUSHJ P,TYOS
PRINT IGNORED
PUSHJ P,TYOS
JRST GFRLP1
GFRSPD: CAMN SYM,[SIXBIT /FC/]
JRST FCNONE
GFRSPX: XCT GFRTB2(A) ;DO OPTION AS SPECIFIED
POPJ P,
GFRPHL: PASC GFRHLP ;GIVE OPTIONS AND DESCRIPTION
JRST GFRLP1
; COME HERE TO SEE IF THIS MACHINE HAS A FILECOMPUTER.
; THIS IS SORT OF BOGUS, BUT I DIDNT WANT TO CONDITIONALIZE THE SOURCE.
FCNONE: .CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ]
.LOSE %LSSYS
CAMN A,[SIXBIT \AIKA\] ;IF WE ARE ON THE AI-KA MACHINE
JRST GFRSPX ;WE CAN DO FILECOMPUTER THINGS.
PUSH P,LPTSW ;ELSE COMPLAIN.
SETZM LPTSW
PRINT [THIS MACHINE DOESN'T HAVE A FILECOMPUTER - IGNORING FC OPTION.]
POP P,LPTSW
POPJ P,
;IF YOU UPDATE THIS TABLE, ALSO UPDATE GFRTB2 AND GFRHLP (ALSO ON THIS PAGE)
GFRTB1: SIXBIT /H/ ;HISTOGRAM
SIXBIT /L/ ;LIST
SIXBIT /DUMP/ ;DUMP
SIXBIT /DELETE/ ;DELETE
SIXBIT /DATE/ ;ENTER DATE
SIXBIT /BLOCKS/ ;GET X BLOCKS
SIXBIT /EVERY/ ;ALLOW NO SPECIAL DIRECTORIES
SIXBIT /CREATE/ ;USE CREATION DATE INSTEAD OF REF DATE
SIXBIT /QUOTA/ ;ENFORCE QUOTA
SIXBIT /ALLOC/ ;REAP ALLOCATED DIRS TOO
SIXBIT /FROM/ ;FROM DEVICE
SIXBIT /TO/ ;TO DEVICE
SIXBIT /ONLY/ ;ONLY FROM SPECIFIED DEVICE
SIXBIT /DISK/ ;DUMP TO SECONDARY DISK INSTEAD OF TAPE
SIXBIT /SECOND/ ;REAP SECONDARY DISK ALSO
SIXBIT /FC/ ;REAP TO BOTH FC DEVICE AND TO TAPE
NGFRSW==.-GFRTB1
GFRHLP: ASCIZ\
H MAKE HISTOGRAM OF BLOCKS FREED VERSUS DATE
L LIST HISTOGRAM AND/OR FILES REAPED
DUMP DUMP REAPED FILES ONTO TAPE
DELETE DELETE REAPED FILES (AFTER DUMPING)
TO dev DUMP TO DISK DEVICE dev (E.G. SECOND) INSTEAD OF TAPE
DATE ENTER DATE OF OLDEST FILE TO RETAIN
BLOCKS ENTER NUMBER OF BLOCKS TO BE OBTAINED
CREATE USE CREATION DATE INSTEAD OF REFERENCE DATE
QUOTA ENFORCE DIRECTORY QUOTAS
ALLOC REAP ALLOCATED DIRS TOO
EVERY ALLOW NO SPECIAL DIRECTORIES (DON'T USE THIS, PLEASE!)
FROM dev REAP OFF OF DEVICE dev (E.G. SECOND) AS WELL AS MAIN DISK.
ONLY REAP ONLY FROM SPECIFIED DEVICE, NOT MAIN DISK.
DISK DUMP TO SECONDARY DISK INSTEAD OF TAPE
(THIS IS AN OBSOLETE FORM FOR "TO SECOND")
SECOND REAP SECONDARY DISK ALSO
(THIS IS AN OBSOLETE FORM FOR "FROM SECOND")
FC REAP FILES ONTO BOTH TAPE AND THE FILECOMPUTER.
_GFR \
GFRTB2: SETOM GFRHSW
SETOM GFRLST
SETOM GFRDMS
SETOM GFRDES
SETOM GFRDAS
SETOM GFRBLS
SETOM GFREVR
SETOM GFRCRE
SETOM GFRQUO
SETOM GFRALO
PUSHJ P,GFPFRM
PUSHJ P,GFPTO
SETOM GFRONL
PUSHJ P,GFPDSK
PUSHJ P,GFPSEC
SETOM FCREAP
IFN .-GFRTB2-NGFRSW, .ERR GFRTB2 DISAGREES WITH GFRTB1
GFRHSW: 0 ;HISTOGRAM SWITCH
GFRDMS: 0 ;DUMP SWITCH
GFRDES: 0 ;DELETE SWITCH
GFRDAS: 0 ;DATE SWITCH
GFRBLS: 0 ;BLOCKS SWITCH
GFRLST: 0 ;LIST SWITCH
GFRNBK: 0 ;NUMBER OF BLOCKS DESIRED
GFRNBG: 0 ;NUMBER OF BLOCKS GOTTEN
GFREVR: 0 ;NO SPECIAL DIR SWITCH (BE CAREFUL WITH THIS!!!!)
GFRCRE: 0 ;CREATION DATE SWITCH
GFRQUO: 0 ;HACK QUOTA
GFRALO: 0 ;REAP ALLOCATED DIRS TOO
GFRDEV: 0 ;DEVICE WRITING TO (0 MEANS TAPE)
GFRPNM: 0 ;PACK NUMBER MASK (1 MEANS OK TO REAP FROM)
GFRONL: 0 ;ONLY FROM SPECIFIED DEVICE, NOT PRIMARY PACKS
GFRJST: 0 ;DISCRIMINATE AGAINST CERTAIN DIRECTORIES
FCREAP: 0 ;FC DEVICE SWITCH
GFPDSK: MOVE SYM,['SECOND]
PUSHJ P,GFPDV1
GFPTO: PUSHJ P,GFPDEV
MOVEM SYM,GFRDEV
POPJ P,
GFPSEC: MOVE SYM,['SECOND]
PUSHJ P,GFPDV1
GFPFRM: PUSHJ P,GFPDEV
IORM B,GFRPNM
POPJ P,
;RETURN WITH SIXBIT DEVICE IN SYM AND BIT MASK OF PACK NUMBERS IN B
GFPDEV: PRINT [DEVICE=]
PUSHJ P,GETSYL
JRST RET
CAIA
GFPDV1: AOS (P)
MOVEI B,0
MOVSI A,-NQS
GFPDV2: CAME SYM,QRESRV(A)
AOBJN A,.-1
JUMPGE A,GFPDV3
MOVEI C,1
LSH C,@QPKID(A)
IOR B,C
AOBJN A,GFPDV2
GFPDV3: JUMPN B,CPOPJ
PASC [ASCIZ/? NO SUCH PACK MOUNTED/]
JRST RET
;ENTRY FROM MAIN DUMP TO ALSO DO A REAP
INCGFR: SETOM GFRFLG
MOVSI A,-NGFRSW
SKIPGE GFRTB2(A) ;CLEAR ALL ARGUMENTS EXCEPT GFRQUO AND LIST IF WAS SET
CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT
AOBJN A,.-2
MOVSI A,-NFIGS
CLEARM @FIGTB2(A)
AOBJN A,.-1
SETOM GFRQUO
SETOM GFRDMS ;SET DUMP SWITCH
SETOM GFRDES ;SET DELETE SWITCH
SETOM MFDIN
SKIPE LSTWHL
SETOM GFRLST
JRST GFREX1
;GFR'S VERSION OF 'EXECU' - MASSAGE OPTIONS AND INITIALIZE
GFREXC: MOVE A,PRIMSK ;ALSO REAP FROM PRIMARY PACKS
SKIPN GFRONL
IORM A,GFRPNM
SKIPN GFRPNM
DIE WHAT PACKS DO YOU WANT ME TO REAP FROM
SKIPE GFRDAS
CLEARM GFRBLS ;CAN'T DO BOTH DATES AND BLOCKS
SKIPN GFRDEV ;REAPING TO SECONDARY DISK
JRST GFRXC1
SETZM GFRDES
SETZM GFRDMS
GFRXC1: SKIPE GFRDES
PUSHJ P,GFRDCK ;DELETE CHECK
SKIPE GFRBLS
PUSHJ P,GFRGNB ;GET NUMBER OF BLOCKS
SETZM GFRNBG
SKIPE GFRDAS
PUSHJ P,GETDAT ;GET DATES
SKIPE GFRLST
PUSHJ P,DEVGET ;GET LISTING DEVICE
.SUSET [.SSNAME,,USNM]
SKIPE GFRHSW
PUSHJ P,GFRPHI ;COMPUTE HISTOGRAM, MAYBE PRINT IT
SKIPE GFRBLS
PUSHJ P,GFRGBD ;GET DATE ASSOCIATED WITH NEEDED NUMBER OF BLOCKS
SKIPN GFRDAS
SKIPE GFRBLS
JRST GFREX6
SKIPN GFRQUO
JRST RET ;NO ACTUAL REAPING TO BE DONE, PROBABLY
; JUST WANTED TO SEE HISTOGRAM
;*DROPS IN
GFREX6: SKIPE GFRDMS ;IF DUMPING,
PUSHJ P,MBOCF ;GET TO BEGINNING OF CURRENT FILE ON TAPE.
SETOM GFRFLG
SETOM MFDIN
JRST GFREX1
MBOCF: PUSHJ P,SPRF ;BEGINNING OF CURRENT FILE
PUSHJ P,SETIT1 ;Get tape status
TRNN A,TF%BOT ;Unless BOT,
PUSHJ P,SPFF ; Forward one file
PUSHJ P,SETIT
POPJ P,
GETDAT: PRINT ENTER DATE (YY/MM/DD)
PUSHJ P,GETDT
CAIGE N,100.
CAIGE N,1.
JRST GETDAT ;BAD YEAR
DPB N,[330700,,DATE]
PUSHJ P,GETDT
CAIGE N,13.
CAIGE N,1.
JRST GETDAT ;BAD MONTH
DPB N,[270400,,DATE]
PUSHJ P,GETSYL
JRST GETDAT ;OVER RUBOUT ON DAY
CAIGE N,32.
CAIGE N,1.
JRST GETDAT ;BAD DAY
DPB N,[220500,,DATE]
POPJ P,
GETDT: SETZM N ;GET SYLLABLE OF DATE
GETDT1: PUSHJ P,TYI
CAIN A,40 ;SPACE
POPJ P,
CAIN A,177 ;CAN'T HACK RUBOUT, START OVER
JRST [ SUB P,[1,,1] ? JRST GETDAT ]
CAIN A,"/
POPJ P, ;SLASH TERMINATES DATE SYLLABLES
SUBI A,"0
IMULI N,10.
ADD N,A
JRST GETDT1
GFRGBD: SKIPN GFRHSW ;COMPUTE WHAT DATE TO REAP BACK TO
PUSHJ P,GFRHIS ; TO GET DESIRED NUMBER OF BLOCKS
MOVE B,[-LGFRBLK,,GFRBLK]
GFRBD1: HLRZ A,(B)
CAML A,GFRNBK
JRST GFRBD2
AOBJN B,GFRBD1
PRINT YOU ASKED FOR THE WHOLE DISK
JRST RET
GFRBD2: HRRZS B
PUSHJ P,CRR
PUSHJ P,GFROFI
MOVEM A,DATE
PRINT DATE FOR GFR IS
PUSHJ P,GFRPDT
PUSHJ P,CRR
POPJ P,
GFRGNB: PRINT NUMBER OF BLOCKS DESIRED ?
PUSHJ P,GETSYL
JRST GFRGNB
JUMPL N,GFRGNB
MOVEM N,GFRNBK
POPJ P,
;LOOP OVER ALL FILES
GFREX1: PUSHJ P,MFDN ;GET NEXT DIRECTORY
JRST GFRFIN ;DONE
PUSHJ P,GFRUCK ;SEE IF SPECIAL DIRECTORY THAT
JRST GFREX1 ; SHOULDN'T GET REAPED
.SUSET [.SSNAM,,USNM]
SETOM GFRFQ
SETOM FLNI
GFREX2: SKIPN GFRBLS ;IF USER SAID BLOCKS, STOP WHEN GOT THAT MANY
JRST GFRX2A
MOVE A,GFRNBG
CAML A,GFRNBK
JRST GFRFIN
GFRX2A: PUSHJ P,FNG ;GET NEXT FILE IN THIS DIRECTORY
JRST GFREX3 ; SORTED BY DECREASING DESIRE TO REAP.
SKIPN GFRQUO ;IF ENFORCING QUOTAS,
JRST GFREX4
MOVE A,BLOCKS ;SEE IF OVER QUOTA
CAMG A,QUOTA
JRST GFREX3
AOSE GFRFQ
JRST GFREX5
SKIPN GFRLST
JRST GFREX5
PUSHJ P,CRR
PUSHJ P,CRR
PSIS USNM
PUSHJ P,TYOS
PRINT QUOTA =
PUSHJ P,TYOS
PDPT QUOTA
PUSHJ P,TYOS
PRINT BLOCKS =
PUSHJ P,TYOS
PDPT BLOCKS
PUSHJ P,CRR
JRST GFREX5
GFREX4: SKIPN A,RFDATE
JRST GFREX2
CAMLE A,DATE
JRST GFREX2
JRST GFREX5
;END OF DIRECTORY
GFREX3: SKIPE GFRDMS
PUSHJ P,FILAPP ;APPEND USERUFD FILE
JRST GFREX1
;'DELETE' OPTION GIVEN, SEE IF SHE REALLY MEANS IT
GFRDCK: PRINT YOU SPECIFIED DELETE,
PUSHJ P,CHECK
SKIPE GFRDMS
POPJ P,
PRINT YOU DID NOT SPECIFY DUMP,
PUSHJ P,CHECK
PRINT WHAT TAPE DID YOU DUMP THESE FILES ON?
PUSHJ P,TAPGET
POPJ P,
;GENERATE LISTING LINE FOR FILE BEING REAPED.
GFRLIS: PUSHJ P,CRR
PSIS USNM
PUSHJ P,TYOS
PSIS FN1
PUSHJ P,TYOS
PSIS FN2
PUSHJ P,TYOS
MOVE A,RFDATE
PUSHJ P,GFRPDT
PUSHJ P,TYOS
PDPT FLENTH
POPJ P,
GFRFIN: SKIPE GFRDMS ;IF DELETING,
PUSHJ P,GESELL ;UPDATE SYSENG;MACRO TAPES.
GFRNUT: SETZM LPTSW
PUSHJ P,CRR
MOVE A,GFRNBG
PUSHJ P,DPT
PRINT [ BLOCKS REAPED.]
JRST RET
;THIS ONE IS GETTING REAPED
GFREX5: MOVE A,BLOCKS ;COMPUTE BLOCKS SAVED
SUB A,FLENTH
MOVEM A,BLOCKS
SKIPE GFRLST
PUSHJ P,GFRLIS ;LIST
SKIPE GFRDMS
PUSHJ P,ADMP3 ;DUMP ONTO TAPE
SKIPE FCREAP ;MAYBE DUMP ONTO FC DEVICE ALSO
PUSHJ P,FCDMP
SKIPE GFRDES
PUSHJ P,GFRDEL ; THEN DELETE THE FILE.
SKIPN GFRDEV
JRST GFREX2
HRLZI A,.BII ;DUMP ONTO SECONDARY DISK
HLLM A,TRNI
OPEN DSKIN,TRNI
JRST GFREX2 ;FILE BEEN DELETED
.CALL [ SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT]
GFRDEV ? [SIXBIT/_DUMP_/] ? SETZ ['OUTPUT]]
JRST [ PUSH P,LPTSW
SETZM LPTSW
PRINT [CAN'T OUTPUT TO ]
PSIS GFRDEV
PRINT [: ]
.SUSET [.RSNAME,,A]
PSIS A
PRINT [; _DUMP_ OUTPUT - ]
PUSHJ P,OPINFL
PUSHJ P,CRR
POP P,LPTSW
.CLOSE DSKIN,
JRST GFREX2 ]
.CALL RDATE
JFCL
.CALL SDATE
JFCL
.CALL RRDATE
JFCL
.CALL SRDT
JFCL
LDB A,[230100,,UNRNDW]
.CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A]
JFCL
LDB A,[430100,,UNRNDW]
.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A]
JFCL
.CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM A]
JFCL
.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A]
JFCL
GFRDS1: MOVE A,[-2000,,BUF] ;HAVING GOT NEW FILE READY, COPY OVER
.IOT DSKIN,A
HRLOI B,-BUF-1(A)
EQVI B,BUF
SKIPGE B
.IOT DSKOUT,B
JUMPGE A,GFRDS1
.CLOSE DSKIN,
.CALL [ SETZ ? 'RENMWO ? MOVEI DSKOUT ? FN1 ? SETZ FN2 ]
JRST [ PUSH P,LPTSW
SETZM LPTSW
PRINT [CAN'T RENMWO ]
PSIS GFRDEV
PRINT [: ]
.SUSET [.RSNAME,,A]
PSIS A
PRINT [; ]
PSIS FN1
PRINT [ ]
PSIS FN2
PRINT [ - ]
PUSHJ P,OPINFL
PUSHJ P,CRR
POP P,LPTSW
JRST .+1 ]
.CLOSE DSKOUT,
MOVE A,FLENTH
ADDM A,GFRNBG
JRST GFREX2
;DELETE REAPED FILE BY REPLACING IT WITH A LINK TO BACKUP; TAPE nnn
GFRDEL: MOVE A,FN1
MOVEM A,GFRLNK+1
MOVE A,FN2
MOVEM A,GFRLNK+2
MOVSI A,.BII
HLLM A,TRNI
OPEN DSKIN,TRNI ;OPEN FILE BEING DELETED (TO GET CREATION DATE)
POPJ P,
.CALL RDATE ;FDATE GETS CREATION DATE
.LOSE %LSFIL
.CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM AUTHOR]
SETZM AUTHOR
.CALL [ SETZ ? 'DELEWO ? SETZI DSKIN ]
.LOSE %LSFIL
.CLOSE DSKIN, ;OLD FILE VANISHES
MOVE A,FLENTH
ADDM A,GFRNBG
OPEN DSKOUT,GFRLNK ;MAKE THE LINK
POPJ P, ;FOO, SHOULDN'T GET DIR FULL
MOVSI A,20+.BII ;OPEN UP THE LINK AGAIN
HLLM A,TRNI
OPEN DSKOUT,TRNI
POPJ P, ;FOO?
.CALL SDATE ;SET CREATION DATE TO FDATE
.LOSE %LSFIL
.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ AUTHOR]
JFCL ;ALSO TRY TO PRESERVE AUTHOR
.CLOSE DSKOUT,
POPJ P,
GFRLNK: 200000,,(SIXBIT/DSK/) ;OPEN COMMAND 2 = MLINK
0 ;FN1
0 ;FN2
SIXBIT /TAPE/
0 ;TAPE NUMBER FROM TAPGET
SIXBIT /BACKUP/ ;SNAME FOR LINK
;COMPUTE HISTOGRAM OF DATE VERSUS NUMBER OF BLOCKS SAVED
;IF FILES OLDER THAN THAT ARE REAPED.
GFRPHI: PUSHJ P,GFRHIS ;COMPUTE IT
SKIPE GFRLST
PUSHJ P,GFRHP ;IF 'LIST' SPECIFIED, PRINT IT OUT
POPJ P,
GFRHIS: .RDATE A,
SETOM MFDIN
SETOM GFRFLG
SETZM CURDAT
LDB B,[000600,,A] ;LOW DIGIT OF DAY
SUBI B,20
LDB C,[060600,,A] ;HIGH DIGIT OF DAY
SUBI C,20
IMULI C,10.
ADD C,B
DPB C,[220500,,CURDAT] ;STORE DAY IN DAY FIELD OF DISK-DATE WORD
LDB B,[140600,,A] ;SAME WITH MONTH
SUBI B,20
LDB C,[220600,,A]
SUBI C,20
IMULI C,10.
ADD C,B
DPB C,[270400,,CURDAT]
LDB B,[300600,,A] ;SAME WITH YEAR
SUBI B,20
LDB C, [360600,,A]
SUBI C,20
IMULI C,10.
ADD C,B
DPB C,[330700,,CURDAT] ;NOW HAVE CURRENT TIME IN DISK FORMAT
MOVE A,CURDAT ;[I DON'T KNOW WHAT'S WRONG WITH *******
SUBI C,GFRYRS ; THE RQDATE SYSTEM CALL] *******
DPB C,[330700,,A]
MOVEM A,OLDDAT ;OLDEST FILE DATE IS GFRYRS YEARS AGO *******
SETZM GFRBLK
MOVE A,[GFRBLK,,GFRBLK+1]
BLT A,GFRBLK+LGFRBLK-1
GFR1: PUSHJ P,MFDN ;READ A DIRECTORY
JRST GFRF
PUSHJ P,GFRUCK ;SEE IF THIS DIRECTORY SHOULD NOT BE REEPED
JRST GFR1
.SUSET [.SSNAM,,USNM]
SETOM FLNI
GFR2: PUSHJ P,FNG ;READ A FILE
JRST GFR1
SKIPE LNKFLG ;DO NOTHING FOR LINKS
JRST GFR2
SKIPN A,RFDATE ;DON'T COUNT FILES WITHOUT REFERENCE DATES
JRST GFR2
CAMG A,OLDDAT ;IF OLDER THAN GFRYRS, USE OLDDAT
MOVE A,OLDDAT
PUSHJ P,GFROFS ;COMPUTE OFFSET
MOVE B,FLENTH
ADDM B,GFRBLK(A) ;INCREMENT COUNT OF BLOCKS ON THAT DATE
JRST GFR2 ;NEXT FILE
;HISTOGRAM ALL DONE
GFRF: SETZM GFRFLG
SETZM A
MOVEI B,GFRBLK
GFRTOT: ADD A,(B)
HRLM A,(B) ;RH INCREMENT, LH RUNNING SUM
AOS B
CAIG B,GFRBLK+LGFRBLK-1
JRST GFRTOT
POPJ P,
;GIVEN A DATE IN A, COMPUTE NUMBER OF DAYS SINCE DATE IN OLDDAT
GFROFS: SETZM B
LDB C,[330700,,OLDDAT] ;SUBTRACT YEARS
LDB D,[330700,,A]
SUB D,C
IMULI D,12.*31. ;APPARENTLY THERE ARE 372 DAYS PER YEAR
MOVE B,D ; AT LEAST IF EACH MONTH HAS 31 DAYS
LDB C,[270400,,OLDDAT] ;SUBTRACT MONTHS
LDB D,[270400,,A]
SUB D,C
IMULI D,31.
ADD B,D
LDB C,[220500,,OLDDAT] ;SUBTRACT DAYS
LDB D,[220500,,A]
SUB D,C
ADD B,D
MOVE A,B
CAILE A,LGFRBLK-2 ;DON'T GET FAKED OUT BY FILES
MOVEI A,LGFRBLK-2 ; BROUGHT BACK FROM THE FUTURE
POPJ P,
;PRINT GFR HISTOGRAM
GFRHP: MOVEI B,GFRBLK
GFRHPT: HRRZ A,(B)
SKIPN A
JRST GFRHP1
PUSHJ P,CRR
PUSHJ P,GFROFI ;OFFSET BACK TO DATE
PUSHJ P,GFRPDT ;PRINT DATE
PASC [ASCIZ / /]
HRRZ A,(B)
PDPT A ;PRINT INCREMENT IN BLOCKS
HLRZ A,(B)
PDPT A ;PRINT TOTAL BLOCKS
GFRHP1: AOS B
CAIG B,GFRBLK+LGFRBLK-1
JRST GFRHPT
POPJ P,
;PRINT DATE IN A
GFRPDT: PUSH P,B
PUSH P,A
LDB B,[270400,,A] ;MONTH
PSIS MONTH(B)
PUSHJ P,TYOS
LDB A,[220500,,A] ;DAY
CAIGE A,10.
PUSHJ P,TYOS
PUSHJ P,DPT
PASC [ASCIZ /, /]
POP P,A
LDB A,[330700,,A] ;YEAR
ADDI A,1900.
PUSHJ P,DPT
POP P,B
POPJ P,
;CONVERT GFRBLK POINTER IN B BACK FROM OFFSET INTO DATE
;SOMEONE SHOULD DOCUMENT THIS PURE MAGIC
;OK, here is the explanation:
; The date of GFRBLK+0 is stored in OLDDAT. If we pretend that every
; month has 31. days, then GFRBLK+<n> would have the date C(OLDDAT)+<n>.
; (Where <n> is measured in days, and date arithmetic is done appropriately.)
; Thus, some locations in GFRBLK correspond to impossible dates such as
; February 30. For some reason, people never create files on those dates...
GFROFI: LDB C,[330700,,OLDDAT] ; C: old-year
LDB D,[270400,,OLDDAT] ; D: old-month
LDB E,[220500,,OLDDAT] ; E: old-day
PUSH P,B
SUBI B,GFRBLK
MOVE A,B
IDIVI A,12.*31. ; A: years, B: remainder
ADD C,A
MOVE A,B
IDIVI A,31. ; A: months (0 - 11.), B: days (0 - 31.)
ADD D,A
ADD E,B
CAILE E,31.
AOS D
CAILE E,31.
SUBI E,31.
CAILE D,12.
AOS C
CAILE D,12.
SUBI D,12.
CAILE D,12.
AOS C
CAILE D,12.
SUBI D,12.
POP P,B
SETZM A
DPB C,[330700,,A]
DPB D,[270400,,A]
DPB E,[220500,,A]
POPJ P,
GFRFLG: 0 ;MAGIC ARGUMENT TO FNG
CURDAT: 0 ;CURRENT DISK-FORMAT DATE
OLDDAT: 0 ;BASE DISK-FORMAT DATE FOR GFRBLK
GFRYRS==:2 ; 2 year histogram
LGFRBLK==:<GFRYRS*12.*31.>+1 ;1 ENTRY FOR EACH DAY, 1 EXTRA AT END FOR TOTAL
GFRBLK: BLOCK LGFRBLK
MONTH: 0
SIXBIT /JAN/
SIXBIT /FEB/
SIXBIT /MAR/
SIXBIT /APR/
SIXBIT /MAY/
SIXBIT /JUN/
SIXBIT /JUL/
SIXBIT /AUG/
SIXBIT /SEP/
SIXBIT /OCT/
SIXBIT /NOV/
SIXBIT /DEC/
;GFRUCK - Skip if it's OK to reap this directory
GFRUCK:
; Very grim procedure.
SKIPE GFREVR ;Are we reaping all directories?
JRST POPJ1 ; Yes - reap 'em all.
; Discriminatory reap procedures.
SKIPN GFRJST ;If we are not being discriminatory
JRST GFRUC2 ; follow normal procedures.
MOVSI A,-NBADDY ;Number of discriminated against dirs.
GFRUC1: CAMN B,BADDY(A) ;Is this dir a baddy?
JRST POPJ1 ; Yes - it should be reaped.
AOBJN A,GFRUC1
POPJ P, ;No, a normal dir. Don't reap it.
; Nondiscriminatory reap procedure.
GFRUC2: HLRZ A,USNM
CAIE A,(SIXBIT /SYS/) ;Never reap system dirs
CAIN A,(SIXBIT /LIB/) ;Never reap libraries.
POPJ P,
MOVE B,USNM ;Don't reap the DUMP database!
MOVSI A,-NTDIR
GFRUC3: CAMN B,TDIRTB(A)
POPJ P,
AOBJN A,GFRUC3
SKIPE WRONG
DIE Cannot GFR because this version of DUMP is for the wrong machine
MOVSI A,-NSDIR ;Check list of specially protected dirs.
GFRUC4: CAMN B,SDIR(A) ;Is this dir in the list?
POPJ P, ; Yes, do not reap it.
AOBJN A,GFRUC4
JRST POPJ1 ;Not in the list - reap it.
SUBTTL SPECIALLY PROTECTED DIRS TO BE HAND REAPED ONLY
SDIR: SIXBIT /./
SIXBIT /.BULK./
SIXBIT /.INFO./
SIXBIT /.MAIL./
SIXBIT /.TECO./
SIXBIT /ACOUNT/
SIXBIT /BACKUP/
SIXBIT /C/
SIXBIT /DEVICE/
SIXBIT /EMACS/
SIXBIT /EMACS1/
SIXBIT /FONTS/
SIXBIT /FONTS1/
SIXBIT /INFO/
SIXBIT /INQUIR/
SIXBIT /LISP/
SIXBIT /MAINT/
IFE MCOND AI,[
SIXBIT /COMLAP/
SIXBIT /DECSYS/
SIXBIT /KLDCP/
SIXBIT /KSC/
SIXBIT /KSHACK/
SIXBIT /L/
SIXBIT /LSPMAI/
SIXBIT /MIDAS/
SIXBIT /SAIL/
SIXBIT /UCODE/
;Macsyma-related directories:
;(should be moved to the ML list when it comes up)
;Well, its up now, but perhaps we have decided to leave Macsyma on AI?
SIXBIT /ALJABR/
SIXBIT /DEMO/
SIXBIT /LMMAXQ/
SIXBIT /MACDOC/
SIXBIT /MACSYM/
SIXBIT /MAXDOC/
SIXBIT /MAXDMP/
SIXBIT /MAXERR/
SIXBIT /MAXER1/
SIXBIT /MAXTUL/
SIXBIT /MAXOUT/
SIXBIT /MUNFAS/
SIXBIT /SHARE/
SIXBIT /SHARE1/
SIXBIT /SHARE2/
SIXBIT /SHAREM/
]
IFE MCOND MC,[ ; (The KS)
SIXBIT /ANBB/
SIXBIT /DUPSYS/
SIXBIT /KSC/
SIXBIT /LSPMAI/
]
IFE MCOND MX,[ ; (The KL)
SIXBIT /.DOVR./
SIXBIT /.KLFE./
SIXBIT /KLDCP/
SIXBIT /KSC/
SIXBIT /L/
SIXBIT /MIDAS/
SIXBIT /UCODE/
;Macsyma-related directories:
SIXBIT /ALJABR/
SIXBIT /DEMO/
SIXBIT /LMMAXQ/
SIXBIT /MACDOC/
SIXBIT /MACSYM/
SIXBIT /MAXDOC/
SIXBIT /MAXDMP/
SIXBIT /MAXERR/
SIXBIT /MAXER1/
SIXBIT /MAXTUL/
SIXBIT /MAXOUT/
SIXBIT /MUNFAS/
SIXBIT /SHARE/
SIXBIT /SHARE1/
SIXBIT /SHARE2/
SIXBIT /SHAREM/
]
IFE MCOND DM,[
SIXBIT /%SYS/
SIXBIT /.BATCH/
SIXBIT /COMDAT/
SIXBIT /COMMUD/
SIXBIT /COMPIL/
SIXBIT /COMSAV/
SIXBIT /CPROG/
SIXBIT /FONTS2/
SIXBIT /MADMAN/
SIXBIT /MBPROG/
SIXBIT /MPROG/
SIXBIT /MPROG1/
SIXBIT /MPROG2/
SIXBIT /MUDBUG/
SIXBIT /MUDDLE/
SIXBIT /MUDMAN/
SIXBIT /MUDSAV/
SIXBIT /MUDSYS/
SIXBIT /NCOMPI/
SIXBIT /NETDOC/
SIXBIT /R/
SIXBIT /READER/
SIXBIT /XFONT/
]
IFE MCOND AIKA,[
SIXBIT /CNVR/
SIXBIT /COMLAP/
SIXBIT /L/
SIXBIT /LMCONS/
SIXBIT /LMDOC/
SIXBIT /MIDAS/
SIXBIT /PUB/
SIXBIT /SAIL/
SIXBIT /VIS/
SIXBIT /WP/
]
NSDIR==.-SDIR
SUBTTL DIRS TO BE DISCRIMINATORILY REAPED
BADDY:
SIXBIT /FOOBAR/
NBADDY==.-BADDY
SUBTTL FILE NAME READER
;THE FOLLOWING ROUTINE GOBBLES INPUT LINES
;FROM THE TTY AND INTERPRETS THEM AS STANDARD MIDAS OR COPY INPUT
;LINES. EX. TODEV:TOSNM;TOFN1 TOFN2_FMDEV:FMSNM;FMFN1 FMFN2(CR)
;THE ROUTINE KEEPS TYPING FILE= AND WAITS FOR ANOTHER LINE
;UNTIL AN ALTMODE A LONELY CR IS TYPED. ALL THE TODEV'S ARE STORED IN A LIST
;CALLED TODEV:. ALL THE FMFN1'S ARE STORED ON A LIST CALLED FMFN1:
;ETC. THERE ARE EIGHT LISTS IN ALL. AN UNSPECIFIED ARGUMENT IN THE
;LINE IS GIVEN THE VALUE OF THE DEFAULT FOR
;THAT SPEC. A SPECIFIED ARG BECOMES THE DEFAULT FOR THAT SPEC.
;IF THE _ IS OMMITTED, ALL ARGS ARE FM ARGS.
;INITIAL DEFAULT FOR FM NAMES IS DSK:<MSNAME>;* *
;THE ROUTINE EXITS IF THE LAST INPUT LINE OF FM NAMES
;EVALUATES TO *;* *
;TO NAMES UNSPECIFIED IN A LINE ARE SET
;TO FM NAMES OF THE SAME CORRESPONDING TYPE(DEV,SNM,FN1,FN2)
FILGET: MOVSI D,-LLIST ;NUMBER OF ENTRIES ALLOWED
SETZM FMDUMP(D)
AOBJN D,.-1
MOVSI D,-LLIST
CAIA
ONEFIL: MOVSI D,-1 ;ENTRY FOR ONLY ONE SPEC TO BE READ
MOVSI X,(SIXBIT /DSK/) ;DEFAULT FOR DEV
MOVE U,MYNAME ;DEFAULT FOR SNAME
MOVE V,[SIXBIT /*/] ;FIRST FILE NAME DEFAULT
MOVE W,V ;SECOND FILE NAME DEFAULT
IRP X,,[TO,FM]
IRP Y,,[DEV,SNM,FN1,FN2]
SETZM !X!!Y
MOVE A,[!X!!Y,,!X!!Y+1]
BLT A,!X!!Y+LLIST-1
TERMIN
TERMIN
TRAGEN: PRINT FILE=
SETZM TINDEV
MOVE A,[TINDEV,,TINSNM]
BLT A,TINFN2 ;SO UNSPECIFIEDS WILL BE 0
SETOM BARROW ;SAYS NO BACK-ARROW TYPED YET
PUSHJ P,TYI
CAIE A,33
CAIN A,15
JRST TIDONE ;LONELY CR
PUSHJ P,GETSL1 ;READ A SYLLABLE BUT FIRST CHARACTER ALREADY READ
JRST TRAGEN ;ENTIRE SYLLABLE RUBBED OUT
JRST OVER
TGET: PUSHJ P,GETSYL
JRST TRAGEN
OVER: CAIN TER,":
JRST TDEV
CAIN TER,";
JRST TSNM
CAIN TER,40
JUMPE SYM,TGET
CAIN TER,^F
JUMPE SYM,TRRDF ;INDIRECT AND READ FILE TO GET FILE NAMES
CAIE TER,33
CAIN TER,15
JUMPE SYM,ENDLIN
CAIN TER,"_
JUMPE SYM,BASET
SKIPN TINFN1
JRST TFN1
SKIPE TINFN2
MOVEI TER,40 ;MORE THAN TWO FILE NAMES
SKIPE TINFN2
JRST TOMANY
MOVEM SYM,TINFN2
JRST TFNC
TFN1: MOVEM SYM,TINFN1
JRST TFNC
TFNC: CAIN TER,40
JRST TGET
CAIN TER,"_
JRST BASET
CAIN TER,^F
JRST TRRDF ;INDIRECT TO READ FILE
ENDLIN: AOS BARROW ;NO BACKARROW IMPLIES ONLY FM NAMES
AOS BARROW
PUSHJ P,DACIT
IRP X,,[DEV,SNM,FN1,FN2]
SKIPN A,TO!X(D)
JRST Z!X
CAME A,[SIXBIT /*/]
JRST NZ!X
Z!X: MOVE A,FM!X(D)
MOVEM A,TO!X(D)
NZ!X:
TERMIN
AOBJN D,.+1
MOVEI A,0
CAMN A,TYNSNM
CAME A,TYNFN1
JRST NOCOM
CAMN A,TYNFN2
JRST TIDONE ;CAN'T ASK FOR MORE THAN THE UNIVERSE !
NOCOM: CAIN TER,33
JRST TIDONE ;ALTMODE MEANS NO MORE LINES TO BE TYPED
JUMPL D,TRAGEN
JRST NOMORE ;FILE SPEC BUFFER FULL
TRRDF: MOVSI A,'DSK
SKIPN TINDEV
MOVEM A,TINDEV
MOVE A,MYNAME
SKIPN TINSNM
MOVEM A,TINSNM
AOS TYIPD ;DEPTH IN IOPUSHES ON TYIC
.IOPUSH TYIC,
.CALL TRRDFO
JRST TRRDFL
JRST TRAGEN ;CONTINUE PROCESSING FILE SPECS (FROM DISK NOW)
TRRDFL: PRINT [INDIRECT FILE ERROR; ]
PUSHJ P,OPINFL
SOS TYIPD
.IOPOP TYIC,
JRST TRAGEN
BASET: PUSHJ P,DACIT
AOSE BARROW
JRST TOMANY
SETZM TINDEV
MOVE A,[TINDEV,,TINSNM]
SETZM TINDEV
BLT A,TINFN2
JRST TGET
NOMORE: CAIN D,1
JRST TIDONE ;DON'T SAY FILE IF ONLY ONE LINE WAS ASKED FOR
PRINT FILE=
PUSHJ P,TYI ;PRETEND TO WANT ONE MORE, BUT BARF IF ONE GIVEN
CAIE A,15
JRST TOOMCH
TIDONE: HRRZM D,LENGTH
SKIPN LENGTH
JRST MLP ;NO ENTRIES
JRST CRR
;APPLY DEFAULTS TO THE TYPED-IN FILE NAME
DEFINE INITFD AC,DES
SKIPN E,TYN!DES
MOVEM AC,TYN!DES ;SET UNSPECIFIED ARG TO DEFAULT
CAIE E,0
MOVE AC,E ;SET DEFAULT TO SPECIFIED ARG
CAMN AC,[SIXBIT /*/]
SETZM TYN!DES ;ASTERISKS MATCH TO ANYTHING
CAME AC,[SIXBIT / */]
JRST NOAST!AC
MOVE E,[SIXBIT /*/]
MOVEM E,TYN!DES ;SPACE * GETS CHANGED TO A REAL ASTERISK
NOAST!AC:
TERMIN
DACIT: MOVSI B,-4
MOVE A,[TINDEV,,TYNDEV]
BLT A,TYNFN2
SKIPG BARROW
JRST ENDLUP
IRP K,,[X,U,V,W]B,,[DEV,SNM,FN1,FN2]
INITFD K,B
TERMIN
MOVSI C,(SIXBIT /DSK/)
SKIPE A,TYNDEV
CAMN A,[SIXBIT /*/]
MOVEM C,TYNDEV
ENDLUP: MOVE A,TYNDEV(B)
SKIPL BARROW
PUSHJ P,FMLST
SKIPGE BARROW
PUSHJ P,TOLST
AOBJN B,ENDLUP
POPJ P,
TOOMCH: PRINT _NO MORE ENTRIES ALLOWED.
QUES: PRINT SHALL I CONTINUE?
.RESET TYIC,
PUSHJ P,TYI
CAIN A,"Y
JRST TIDONE
CAIN A,"N
JRST MLP
PRINT _TYPE Y FOR YES OR N FOR QUIT._
JRST QUES
;I HAVE NO IDEA WHETHER THESE DO ANYTHING *******
IRP X,,[TO,FM]
X!LST: MOVEI C,LLIST
IMULI C,(B)
ADDI C,X!DEV(D)
MOVEM A,(C)
POPJ P,
TERMIN
IRP X,,[DEV,SNM]
T!X: SKIPE TIN!X
JRST TOMANY
MOVEM SYM,TIN!X
JRST TGET
TERMIN
TOMANY: PRINT UNACCEPTABLE WITH
CAIN TER,"_
JRST NOTWO
CAIE TER,":
CAIN TER,";
JRST NOTWO
PUSHJ P,TYOS
PRINT THREE FILE NAMES!
MOVEI TER,0
CAIA
NOTWO: PUSHJ P,TYOS
CAIE TER,":
CAIN TER,";
PRINT TWO
CAIN TER,"_
PRINT TWO
CAIE TER,0
PUSHJ P,TYOS
CAIN TER,";
PRINT SNAMES!
CAIN TER,":
PRINT DEVICES!
CAIN TER,"_
PRINT BACKARROWS!
PUSHJ P,CRR
JRST TRAGEN
SUBTTL MAGIC ROUTINES TO CALL FROM DDT
;WHO KNOWS WHAT THIS DOES?
TRAN: SETOM MFDIN
TRAN1: PUSHJ P,MFDN
.VALUE
SETOM FLNI
.SUSET [.SSNAM,,USNM]
TRAN2: PUSHJ P,FNG
JRST TRAN1
.OPEN DSKIN,TRNI
JRST TRAN2
SKIPE LNKFLG
JRST TRAN2
.CALL RDATE
JFCL
SKIPG FDATE
JRST TRAN2
MOVE A,FDATE
TLO A,110000
CAML A,TOMDAT
SUB A,[2000,,0]
MOVEM A,FDATE
.CALL SFDAT1
JFCL
JRST TRAN2
TOMDAT: 0
SFDAT1: SETZ
SIXBIT /SFDATE/
[DSKIN]
SETZ FDATE
;CONVERT FROM OLD .TAPEn; TAPE nnn FILE FORMAT TO NEW (1975?)
CONV: MOVE A,TDIRTB
MOVEM A,USNM
SETOM FLNI
.SUSET [.SSNAME,,USNM]
CONV1: PUSHJ P,FNG
.VALUE
MOVEI A,.BII
HRLM A,TRNI
OPEN DSKIN,TRNI
.VALUE
MOVEI B,.BIO
HRLM B,TRNI
OPEN DSKOUT,TRNI
.VALUE
HRLM A,TRNI
.CALL RDATE
SETOM FDATE
.CALL SDATE
JFCL
.CALL SRDT1
JFCL
SETOM USNM
MOVE A,[-5,,BUF]
.IOT DSKIN,A
MOVE A,[-3,,0]
MOVEM A,BUF+4
MOVE A,[-5,,BUF]
.IOT DSKOUT,A
CONV2: MOVE A,[-5,,BUF]
.IOT DSKIN,A
JUMPL A,CONV3
MOVE A,BUF
CAME A,USNM
PUSHJ P,CONV4
MOVE A,[-2,,BUF+1]
.IOT DSKOUT,A
HRROI A,BUF+4
.IOT DSKOUT,A
JRST CONV2
CONV3: .CLOSE DSKOUT,
.CLOSE DSKIN,
JRST CONV1
CONV4: MOVEM A,USNM
HRROI A,[0]
.IOT DSKOUT,A
HRROI A,USNM
.IOT DSKOUT,A
POPJ P,
SRDT1: SETZ
SIXBIT /SRDATE/
[DSKOUT]
SETZ RFDATE
;ORDMFD$G WILL RUN THRU ALL THE .TAPE. FILES, AND PRODUCE A LIST
; OF DIRECTORIES WHICH HAVE EVER BEEN DUMPED
; (THIS IS A FILE OF SIXBIT, UNORDERED)
ORDM1: -40000,,SBUF ;POINT TO A BUFFER
ORDM2: -40000,,SBUF ;POINT TO CURRENT END
ORDIR: 0 ;NAME OF A TAPE DIR
ORDIRS: 0 ;NAME OF SAVED DIR
DIRFLG: 0 ;FLAG SAYS THAT NEXT IS A DIR
ORDMFD: .CORE CORSZB
JRST .-1
MOVE A,[-40000,,SBUF]
MOVEM A,ORDM1
MOVEM A,ORDM2
.SUSET [.RSNAM,,ORDIRS]
SETOM TDIRN
OM0: AOS A,TDIRN
CAIGE A,NTDIR
JRST [ MOVE A,TDIRTB(A)
MOVEM A,ORDIR
PUSHJ P,OM1
JRST OM0 ]
.SUSET [.SSNAM,,ORDIRS] ;RESET SNAM
OPEN DSKOUT,[SIXBIT / &DSKDMPMFD>/]
.VALUE
MOVE A,ORDM1
SUB A,ORDM2 ;# WDS IN BUF
MOVSS A
HRRI A,ORDM1
.IOT DSKOUT,A
.CLOSE DSKOUT,
.VALUE [ASCIZ /TAPES.SCANNED.FOR.MFD/]
OM1: SETOM FLNI ;ROUTINE TO SCAN A .TAPE DIR
.SUSET [.SSNAM,,A]
OM1A: PUSHJ P,FNG
POPJ P, ;END OF DIR
PUSHJ P,OM2
JRST OM1A
OM2: SETOM EOFF ;ROUTINE TO SCAN A .TAPE FILE
OPEN DSKIN,TRNI
.VALUE
MOVEI B,0
JSR GWD
CAME A,[-4,,] ;GOOD HEADER
.VALUE
JSR GWD ;TAPE#
JSR GWD ;DATE
JSR GWD ;FLAGS
JFCL ;JUMPGE A,CPOPJ IF ONLY INCR WANTED
JSR GWD ;ANOTHER RANDOM
CAME A,[-3,,] ;MORE GOOD HEADER
.VALUE
JSR GWD ;SHOULD BE FOR A DIR NAME HERE
CAME A,DIRFLG
.VALUE
OM2B: JSR GWD ;GET DIR NAME
PUSHJ P,OMFD ;INSERT NAME IN LIST
OM2C: JSR GWD ;GET FN1 OR FLAG
CAMN A,DIRFLG
JRST OM2B ;A DIR
JSR GWD ;WAS FN1, GET FN2
JSR GWD ;DATE
JRST OM2C
OMFD: MOVE C,ORDM2 ;PUT A WORD IN LIST (IF UNIQUE)
MOVEM A,(C)
MOVE C,ORDM1 ;SEARCH
CAME A,(C)
AOBJN C,.-1
CAME C,ORDM2 ;SKIP IF REACHED END OF LIST
POPJ P, ;NOT A NEW NAME
AOBJP C,[.VALUE] ;REACHED END???
MOVEM C,ORDM2 ;BUMP POINTER NOW
POPJ P,
;WHO KNOWS WHAT THIS DOES?
ORFIND: .CORE CORSZB
JRST .-1
SETOM MFDIN
OF1: PUSHJ P,MFDN
.VALUE
MOVEM A,SCRDIR+2
.SUSET [.SSNAM,, [SIXBIT /TAPSCR/]]
OPEN DSKOUT,SCRDIR
.VALUE
SETOM TDIRN
OF1A: AOS A,TDIRN
CAIL A,NTDIR
JRST OF1 ;LOOP FOR ANOTHER NAME
MOVE A,TDIRTB(A)
MOVEM A,ORDIR
PUSHJ P,OF2
JRST OF1A
SCRDIR: 7,,446353
SIXBIT /TAPE/
0
OF2: SETOM FLNI
.SUSET [.SSNAM,,A]
OF3: PUSHJ P,FNG
POPJ P,
SETOM EOFF
OPEN DSKIN,TRNI
.VALUE
MOVE A,[-5,,BUF]
.IOT DSKIN,A
SKIPL BUF+3
JRST OF3 ;NOT INCREMENTAL
PUSHJ P,OF4
JRST OF3
OF4: MOVEI B,0
MOVE A,TRNI+2
MOVEM A,DATA+3
JSR GWD
OF7: PUSHJ P,OF5
POPJ P,
JSR GWD
OF6: MOVEM A,DATA
JSR GWD
MOVEM A,DATA+1
JSR GWD
MOVEM A,DATA+2
MOVE A,[-4,,DATA]
.IOT DSKOUT,A
JSR GWD
SKIPN A
JRST OF7
JRST OF6
DATA: BLOCK 4
OF5: JSR GWD
CAMN A,USNM
JRST POPJ1
JRST OF8
OF9: JSR GWD
JSR GWD
OF8: JSR GWD
SKIPN A
JRST OF5
JRST OF9
;WHO KNOWS WHAT THIS DOES?
OFSORT: .CORE CORSZB
JRST .-1
SETOM FLNI
.SUSET [.SSNAM,,[SIXBIT /TAPSCR/]]
OFS1: PUSHJ P,FNG
.VALUE
MOVE A,[-40000,,SBUF]
MOVEI B,.BII
HRLM B,TRNI
OPEN DSKIN,TRNI
.VALUE
.IOT DSKIN,A
SKIPL A
.VALUE
MOVEM A,SORTAS
HRRZ C,A
HRRZI A,SBUF
MOVEI D,4
MOVEI N,0
SETZM (C)
PUSHJ P,SORT
MOVEI A,SBUF
MOVEI N,1
MOVE C,A
OFS2: SKIPN B,(A)
JRST OFS4
OFS3: ADDI C,4
CAMN B,(C)
JRST OFS3
PUSHJ P,SORT
JRST OFS2
OFS4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE
HRLM A,TRNI
.CLOSE DSKIN,
OPEN DSKOUT,TRNI
.VALUE
.ACCESS DSKOUT,[0]
MOVE A,[-40000,,SBUF]
HLLZ B,SORTAS
SUB A,B
.IOT DSKOUT,A
.CLOSE DSKOUT,
JRST OFS1
OUTNAM: .CORE CORSZB
JRST .-1
MOVE B,[440600,,A]
MOVSI C,-6
OUTNM1: ILDB D,B
ADDI D,40
PUSHJ P,OUTASC
AOBJN C,OUTNM1
POPJ P,
OUTNUM: MOVE B,[440600,,A]
MOVSI C,-3
OUTNU1: ILDB D,B
ADDI D,40
PUSHJ P,OUTASC
AOBJN C,OUTNM1
POPJ P,
OUTDAT: MOVE B,[270400,,A]
MOVEI D,"0
LDB C,B
CAIL C,10.
MOVEI D,"1
PUSHJ P,OUTASC
CAIL C,10.
SUBI C,10.
ADDI C,"0
MOVE D,C
PUSHJ P,OUTASC
MOVEI D,"/
PUSHJ P,OUTASC
MOVE B,[220500,,A]
LDB B,B
IDIVI B,10.
ADDI B,"0
MOVE D,B
PUSHJ P,OUTASC
ADDI C,"0
MOVE D,C
PUSHJ P,OUTASC
MOVEI D,"/
PUSHJ P,OUTASC
MOVE B,[330700,,A]
LDB B,B
CAIGE B,72.
ADDI B,72.
IDIVI B,10.
ADDI B,"0
MOVE D,B
PUSHJ P,OUTASC
ADDI C,"0
MOVE D,C
PUSHJ P,OUTASC
POPJ P,
OUTCR: MOVEI D,15
PUSHJ P,OUTASC
MOVEI D,12
JRST OUTASC
OUTSPC: MOVEI D,"
JRST OUTASC
OUT4SP: MOVEI D,"
MOVSI B,-4
PUSHJ P,OUTASC
AOBJN B,.-1
POPJ P,
OUTASC: MOVE U,ASCBP
CAMN U,[010700,,BUF+2000-1]
PUSHJ P,OUTBLK
IDPB D,ASCBP
POPJ P,
OUTBLK: MOVE U,[-2000,,BUF]
.IOT DSKOUT,U
MOVE U,[440700,,BUF]
MOVEM U,ASCBP
POPJ P,
ASCBP: 440700,,BUF
CONASC: .CORE CORSZB
JRST .-1
SETOM FLNI
CONAS1: .SUSET [.SSNAM,,[SIXBIT /TAPSCR/]]
PUSHJ P,FNG
.VALUE
MOVEI A,.BII
HRLM A,TRNI
OPEN DSKIN,TRNI
.VALUE
.SUSET [.SSNAM,,[SIXBIT /TAPASC/]]
MOVEI A,.BIO
HRLM A,TRNI
OPEN DSKOUT,TRNI
.VALUE
MOVE A,[440700,,BUF]
MOVEM A,ASCBP
MOVE A,[-40000,,SBUF]
.IOT DSKIN,A
MOVEM A,SORTAS
HRRZS A
SUBI A,SBUF
IDIVI A,4
MOVEM A,NUMENT
MOVEI X,SBUF
CONAS2: MOVE A,NUMENT
ADDI A,3
IDIVI A,4
SETZM FUDGE+2
SETZM FUDGE+3
CAILE A,57
JRST CONAS6
MOVEI C,4
CAIN B,0
MOVEM C,FUDGE+2
CAIN B,1
MOVEM C,FUDGE+3
MOVEI C,8
CAIN B,0
MOVEM C,FUDGE+3
CONAS6: CAIL A,57.
MOVEI A,57.
MOVEM A,LINPAG
CONAS3: MOVNI V,(A)
HRLZS V
CONAS4: MOVSI W,-4
CONAS5: MOVE E,LINPAG
IMULI E,4
IMULI E,(W)
ADD E,X
SUB E,FUDGE(W)
MOVE A,(E)
PUSHJ P,OUTNAM
PUSHJ P,OUTSPC
MOVE A,(E)1
PUSHJ P,OUTNAM
PUSHJ P,OUTSPC
MOVE A,(E)2
PUSHJ P,OUTDAT
PUSHJ P,OUTSPC
MOVE A,(E)3
PUSHJ P,OUTNUM
CAME W,[-1,,3]
PUSHJ P,OUT4SP
CAMN W,[-1,,3]
PUSHJ P,OUTCR
SOSN NUMENT
JRST ASCEOF
AOBJN W,CONAS5
ADDI X,4
AOBJN V,CONAS4
MOVEI D,^L
PUSHJ P,OUTASC
MOVE D,LINPAG
IMULI D,12.
ADD X,D
JRST CONAS2
FUDGE: 0
0
0
0
ASCEOF: MOVEI D,3
ASCEF1: PUSHJ P,OUTASC
HLRZ A,ASCBP
CAIE A,10700
JRST ASCEF1
HRRZ A,ASCBP
ADDI A,1
SUBI A,BUF
MOVNS A
HRLZS A
HRRI A,BUF
.IOT DSKOUT,A
.CLOSE DSKOUT,
JRST CONAS1
NUMENT: 0
LINPAG: 0
LNKBL: 200000,,446353
BLOCK 4
SIXBIT /TAPASC/
LNKSNM: SIXBIT /.LPTR./
OFMLNK: SETOM FLNI
.SUSET [.SSNAM,,[SIXBIT /TAPASC/]]
ML1: PUSHJ P,FNG
.VALUE
.SUSET [.SSNAM,,LNKSNM]
MOVE A,FN1
MOVEM A,LNKBL+1
MOVEM A,LNKBL+3
MOVE A,FN2
MOVEM A,LNKBL+2
MOVEM A,LNKBL+4
.OPEN DSKIN,LNKBL
.VALUE
JRST ML1
;CHECK FOR CLOBBERED FILES (CONTAIN 'CLBWRD')
CHECCL: .CORE CORSZB
JRST .-1
SETOM MFDIN
PUSHJ P,DEVGET
CHECL1: PUSHJ P,MFDN
JRST RET
SETOM FLNI
.SUSET [.SSNAM,,USNM]
CHSNM: PUSHJ P,FNG
JRST CHECL1
SKIPE LNKFLG
JRST CHSNM
HRRI A,.BII
HRLM A,TRNI
OPEN DSKIN,TRNI
JRST CHSNM
CHSNM1: MOVE A,[-40000,,SORTAS]
.IOT DSKIN,A
PUSH P,A
HLLZS A
MOVE B,[-40000,,0]
SUB B,A
HRRI B,SORTAS
MOVE C,CLBWRD
CHSNM4: MOVE D,(B)
TLZ D,770000
CAME C,D
JRST CHSNM2
CHSNM3: POP P,A
JUMPL B,CLBFL
JUMPGE A,CHSNM1
.CLOSE DSKIN,
JRST CHSNM
CHSNM2: ADD B,[1777,,1777]
AOBJN B,CHSNM4
JRST CHSNM3
CLBFL: PSIS USNM
PSIS FN1
PSIS FN2
PDPT PACKN
.CALL RDATE
JFCL
MOVE A,FDATE
MOVEM A,DAYTIM
PASC [ASCIZ / /]
PUSHJ P,PFDATE
.CLOSE DSKIN,
PUSHJ P,CRR
JRST CHSNM
CLBWRD: 600,,3 ;USUAL WORD FILES GET CLOBBERED WITH
;MORE CHECKING FOR CLOBBERED FILES
DIRSO: SIXBIT / &DSKWALL BIN /
FBLK: .CORE CORSZB
JRST .-1
.SUSET [.SSNAM,, [SIXBIT /SEC/]]
.OPEN 15,DIRSO
.VALUE
PUSHJ P,DEVGET
FBLK1: PUSHJ P,SFNG
.VALUE
FBLK5: .OPEN UFDCH,FNO
.VALUE
MOVE A,[-2000,,FDIRBF]
.IOT UFDCH,A
MOVEI A,.BII
HRLM A,TRNI
OPEN DSKIN,TRNI
JRST FBLK1
MOVNI A,3
MOVEM A,BLKOFS
FBLK2: MOVE A,[-6000,,SORTAS]
.IOT DSKIN,A
AOS BLKOFS
AOS BLKOFS
AOS BLKOFS
PUSH P,A
HLLZS A
MOVE B,[-6000,,0]
SUB B,A
HRRI B,SORTAS
MOVE C,CLBWRD
FBLK3: CAMN C,(B)
JRST FBLK4
ADD B,[1777,,1777]
AOBJN B,FBLK3
POP P,A
JUMPGE A,FBLK2
.CLOSE DSKIN,
JRST FBLK1
SFNG: MOVE A,[-1,,USNM]
.IOT 15,A
JUMPL A,CPOPJ
SKIPN USNM
POPJ P,
.SUSET [.SSNAM,,USNM]
MOVE A,[-2,,FN1]
.IOT 15,A
JRST POPJ1
FBLK4: POP P,A
PUSHJ P,CRR
PSIS USNM
PSIS FN1
PSIS FN2
HRRZS B
SUBI B,SORTAS
IDIVI B,2000
ADD B,BLKOFS
PUSHJ P,DELBLK
PUSHJ P,FTRK
PDPT A
JRST FBLK5
DELBLK: PUSH P,B
IMULI B,2000
MOVEI C,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT
HRLM C,TRNI
.OPEN DSKIN,TRNI
.VALUE
.ACCESS DSKIN,B
SETZM BUF ;CLOBBER WITH ZERO
MOVE C,[BUF,,BUF+1]
BLT C,BUF+1777
MOVE C,[-2000,,BUF]
.IOT DSKIN,C
.CLOSE DSKIN,
POP P,B
MOVEI C,.BII
HRLM C,TRNI
POPJ P,
FTRK: MOVE A,FDIRBF+1
MOVEI A,FDIRBF(A)
FTRK1: MOVE C,(A)
CAME C,FN1
JRST FTRK3
MOVE C,1(A)
CAME C,FN2
JRST FTRK3
LDB C,[150500,,2(A)]
PDPT C
LDB C,[UNDSCP +2(A)]
IDIVI C,6
MOVE D,BTB(D)
ADDI D,FDIRBF+11.(C)
SETOM A
FTRK2: ILDB C,D
TRZE C,40
JRST FTRKL
CAILE C,12.
JRST FTRKS
FTRKN: AOS A
SOSGE B
POPJ P,
SOSLE C
JRST FTRKN
JRST FTRK2
FTRKS: SUBI C,11.
ADD A,C
SOSGE B
POPJ P,
JRST FTRK2
FTRKL: TRZ C,20
SETZM A
DPB C,[140600,,A]
ILDB C,D
DPB C,[60600,,A]
ILDB C,D
DPB C,[600,,A]
SOSGE B
POPJ P,
JRST FTRK2
BLKOFS: 0
BTB: 440600,,
360600,,
300600,,
220600,,
140600,,
060600,,
FTRK3: ADDI A,5
CAIGE A,FDIRBF+1777
JRST FTRK1
SETOM A
POPJ P,
;FIND PROBLEMS WITH CONVERTING TO NEW (1975?) .TAPEn; TAPE nnn FILE FORMAT
FNDCON: .CORE CORSZB
JRST .-1
MOVSI V,-NTDIR
FNDCO1: MOVE B,TDIRTB(V)
SETOM FLNI
.SUSET [.SSNAM,,B]
FNDCO2: PUSHJ P,FNG
JRST FNDCO3
MOVEI B,.BII
HRLM B,TRNI
OPEN DSKIN,TRNI
JRST FNDCO2
.CALL FILLEN
.VALUE
SKIPN A,LENGTH
JRST FNDCO2
.CALL FILBLK
.VALUE
MOVNS A
HRLS A
HRRI A,SBUF
.IOT DSKIN,A
MOVSI B,-10.
FNDCOX: SETZM (A)
AOS A
AOBJN B,FNDCOX
MOVE A,SBUF
CAME A,[-4,,0]
JRST FNDCO2 ;NOT A GOOD TAPE
MOVEI C,5 ;C WILL BE A POINTER INTO TAPE
FCLOOP: CAML C,LENGTH
JRST FNDCO4
MOVE A,SBUF(C)
CAME A,[-1]
JRST FCL1 ;REGULAR FILE
MOVE A,SBUF+4(C) ;DATE OF NEXT FILE IF SNAME CHANGE
CAMN A,[-1]
JRST FCL3
LSH A,-27.
CAIG A,2 ;OLD DATE
JRST FCL3
CAIL A,71.
CAILE A,76.
JRST FCL2
FCL3: SETZM SBUF(C)
ADDI C,2
JRST FCLOOP
FCL1: ADDI C,3
JRST FCLOOP
FCL2: MOVE A,SBUF+1(C)
PSIS A
JRST FCL1
FNDCO3: AOBJN V,FNDCO1
JRST RET
FNDCO4: .CLOSE DSKIN,
MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE
HRLM A,TRNI
OPEN DSKOUT,TRNI
.VALUE
.CALL SDATE
.VALUE
.CALL SRDT
.VALUE
MOVN A,LENGTH
HRLS A
HRRI A,SBUF
.IOT DSKOUT,A
.CLOSE DSKOUT,
JRST FNDCO2
;CONVERT OLD SYSENG;MACRO TAPES FORMAT TO NEW
TFCONV: .SUSET [.SSNAME,,SPLACE]
MOVEI A,.BII
HRLM A,STATOP
OPEN DSKIN,STATOP
JRST RET
MOVEI A,.BIO
HRLM A,STATOP
OPEN DSKOUT,STATOP
JRST RET
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
MOVEI B,MAXTAP
TFCNV1: MOVE A,[-10.,,BUF] ; Currently TPINFL=10. (1/17/86)
.IOT DSKIN,A
JUMPL A,TFCNV2
MOVE A,[-TPINFL,,BUF]
.IOT DSKOUT,A
SOJG B,TFCNV1
TFCNV2: SETZM BUF
TFCNV3: MOVE A,[-TPINFL,,BUF]
.IOT DSKOUT,A
SOJG B,TFCNV3
.CLOSE DSKIN,
.CLOSE DSKOUT,
.BREAK 16,
SUBTTL 'FIND', 'OFIND', and 'DFIND' COMMANDS
;CODE TO FIND FILES BASED ON DSK:.TAPEX; DIRECTORIES REWRITTEN 12/8/77 BY PDL
; TO READ ALL DIRECTORIES AND SORT TAPE FILES BY CREATION DATE BEFORE
; SEARCHING. MOST RECENTLY DUMPED FILES ARE THEREFORE SEEN FIRST.
; DEDDEV, DDIRTB, NDDIR
DFIND: PRINT [ _FILES FOR ]
SIXTYP DEDITS
PRINT [ WHICH ARE STORED ON ]
SIXTYP DEDDEV
PRINT _
SETZM OFINDF ;SAY WE ARE CHECKING FROM DISK.
SETOM DFINDF ;SAY THIS IS FOR A DECEASED ITS.
JRST AFIND1
OFIND: SETOM OFINDF ;DO A FIND FROM A TAPE INSTEAD OF .TAPEn
SKIPA ;THE TAPE CONTAINS .TAPEn; TAPE nnn FILES,
; NOT USER FILES!
AFIND: SETZM OFINDF ;DOING A REGULAR FIND
SETZM DFINDF ;FROM A LIVE ITS
AFIND1: MOVSI A,-NFIGS
CLEARM @FIGTB2(A)
AOBJN A,.-1
PUSHJ P,FILGET ;WHAT SHOULD I FIND?
PUSHJ P,DEVGET ;WHERE SHOULD I LIST THEM?
SKIPE OFINDF
JRST FLOOP1
;HERE FIND FROM DISK
.CORE CORSZB
JRST .-1
MOVEI C,SBUF ;HUGE BUFFER AT END OF CORE
MOVSI V,-NTDIR ;ONCE FOR EACH TAPE DIRECTORY POSSIBLY ON DISK
SKIPE DFINDF ;IF THIS IS FOR A DECEASED ITS
MOVSI V,-NDDIR ; USE DIFFERENT DIRECTORIES.
FLOOP: SKIPE DFINDF
JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH
DEDDEV ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
DDIRTB(V)]
JRST NEXDIR
JRST FLSNRF]
SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH
[SIXBIT /DSK/] ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
TDIRTB(V)]
JRST NEXDIR ;DIR PROBABLY DOESNT EXIST
FLSNRF: MOVE A,[-2000,,FDIRBF]
.IOT UFDCH,A ;SNARF DIR
.CLOSE A,
MOVE A,FDIRBF+UDNAMP ;PROCESS THE DIR, MAKING A LIST OF TAPE FILES IN SBUF
ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA
FINDNM: CAILE A,FDIRBF+1777-4
JRST NEXDIR ;END OF NAME AREA
SKIPE W,(A) ;EMPTY SLOT
CAME W,[SIXBIT /TAPE/] ;KEEP ONLY "TAPE XXX" FILES
JRST FNDNEX
MOVE B,UNRNDM(A)
TLNN B,UNLINK ;IGNORE FILES IN USE AND OTHER CHIMERAS
TLNE B,UNIGFL
JRST FNDNEX ; FILE IS LINK, OPEN FOR WRITING OR BEING DELETED
MOVEM W,(C) ;FIRST NAME
MOVE W,1(A)
MOVEM W,1(C) ;SECOND NAME
MOVE W,TDIRTB(V)
MOVEM W,2(C) ;TAPE DIR NAME (FOR USE IN OPEN LATER)
MOVE W,3(A)
MOVEM W,3(C) ;CREATION DATE
HLRZ W,4(A) ;REFERENCE DATE (NOT REALLY USED IN FIND)
SKIPN W
MOVEI W,177777
ANDI W,177777
MOVSM W,4(C)
ADDI C,LUNBLK ;MOVE TO NEXT NAME ENTRY IN OUTPUT BUFFER
FNDNEX: ADDI A,5 ;MOVE TO NEXT ENTRY IN DIRECTORY
JRST FINDNM
NEXDIR: AOBJN V,FLOOP ;MOVE TO NEXT DIR IN .TAPE* LIST
MOVEM C,LFDIR ;LAST ENTRY ADDED TO LIST
;NOW SORT ACCUMULATED FILE POINTERS BY CREATION DATE
MOVEI A,SBUF ;SORT BETWEEN SBUF AND C(LFDIR)
MOVEI N,3 ; THIRD ELEMENT IS SORT KEY (CDATE)
MOVEI D,LUNBLK ; ENTRIES ARE NAME PTRS
PUSHJ P,SORTDN ; SORT IN DESCENDING ORDER
MOVEI A,SBUF
MOVEM A,DIRIDX ;POINTER TO TAPE FILE WE ARE WORKING ON
NEXFL1: PUSHJ P,NEXTAP ;SET UP FILE OPEN BLOCK
JRST CRR ; NO MORE TAPES TO LOOK AT
PUSHJ P,NEXFL3 ;PROCESS TAPE FILE
JRST NEXFL1
NEXTAP: MOVE A,DIRIDX ;ROUTINE TO SET UP OPEN BLOCK FOR TAPE FILE SEARCH
SKIPN B,(A)
POPJ P, ;NO MORE FILES
MOVEM B,FN1
MOVE B,1(A)
MOVEM B,FN2
MOVE B,2(A)
.SUSET [.SSNAM,,B]
ADDI A,LUNBLK
MOVEM A,DIRIDX
AOS (P)
POPJ P,
;FIND FROM TAPE FILES DUMPED TO MAG TAPE
; USES SAME SEARCHING CODE ONCE FILE IS "OPEN", BUT IS OTHERWISE
; COMPLETELY SEPARATE FROM REGULAR FIND COMMAND
FLOOP1: PUSHJ P,MAGOP ;READ TAPE
JRST FLOOP2
MOVE A,HFN1
MOVEM A,FN1
MOVE A,HFN2
MOVEM A,FN2
PUSHJ P,NEXFL5 ;PROCESS THIS FILE NAME
PUSHJ P,FILSKP ;SKIP FILE
JRST FLOOP1
FLOOP2: PUSHJ P,ARWND ;REWIND TAPE AND EXIT
JRST CRR
;HERE FOR EACH TAPE DIRECTORY ON DISK OR TAPE
NEXFL3: SKIPE DFINDF
JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,DSKIN
DEDDEV ? FN1 ? FN2 ? SNAME]
JRST RET
JRST NEXFL5 ]
OPEN DSKIN,TRNI ;OPEN TAPE DIRECTORY
JRST RET
NEXFL5: SETOM EOFF
MOVEI B,0 ;SO THAT GWD WILL .IOT IMMEDIATELY THE FIRST TIME THROUGH
JSR GWDF
MOVE C,A
JSR GWDF
AOBJN C,.-1 ;SKIP TAPE HEADER
MOVE C,A
SETZM FILN
COMPR: JSR GWDF
SKIPN A
JRST FNDSSN
AOS FILN
MOVEM A,PFF1
JSR GWDF
MOVEM A,PFF2
ADD C,[2,,2] ;WE JUST READ TWO WORDS
MOVE W,LENGTH
IMUL W,[-1,,]
COMCON: SKIPN D,FMSNM(W)
JRST COMFN1 ;ZERO MATCHES TO ANYTHING
CAME D,PSNAM
JRST NEXCOM ;NO MATCH
COMFN1: SKIPN D,FMFN1(W)
JRST COMFN2
CAME D,PFF1
JRST NEXCOM
COMFN2: SKIPE D,FMFN2(W)
CAMN D,PFF2
JRST MATCH
NEXCOM: AOBJN W,COMCON
NEXNAM: JUMPGE C,INITC ;ALREADY CORRECT PLACE
JSR GWDF
AOBJN C,.-1 ;GET TO BEGINNING OF NEXT ENTRY
INITC: IMUL C,[-1,,]
JRST COMPR
FNDSSN: JSR GWDF
MOVEM A,PSNAM
JRST COMPR
;HERE WHEN THE FILE NAME MATCHES, LIST THIS ONE.
MATCH: JSR GWDF ;READ DATE AND TIME
PUSH P,B
MOVEM A,DAYTIM
ADD C,[1,,1]
PUSHJ P,CRR
PSIS FN1
PSIS FN2
PSIS PSNAM
PSIS PFF1
PSIS PFF2
PDPT FILN
PASC [ASCIZ / /]
PUSHJ P,PFDATE
POP P,B
JRST NEXNAM
PFDATE: MOVE A,DAYTIM ;PRINTS CONTENTS OF DAYTIM AS FILE CREATION DATE AND TIME
AOJE A,NODATE
CAMN A,[SETZ]
JRST LDATE
LDB A,[270400,,DAYTIM] ;CREATION DATE AND TIME
PUSHJ P,DPT ;PRINT MONTH
PASC [ASCIZ \/\]
LDB A,[220500,,DAYTIM]
PUSHJ P,DPT ;PRINT DAY
PASC [ASCIZ \/\]
LDB A,[330700,,DAYTIM]
ADDI A,1900.
PUSHJ P,DPT
HRRZ A,DAYTIM ; TIME
PASC [ASCIZ / /]
IDIVI A,60.*60.*2 ;HALF SECONDS IN AN HOUR
PUSHJ P,DDPA ;PRINT HOURS
PRINT :
MOVE A,B
IDIVI A,60.*2 ;HALF SECONDS IN A MINUTE
PUSHJ P,DDPA ;PRINT MINUTES
PRINT :
MOVE A,B
IDIVI A,2 ;HALF SECONDS IN A SECOND
PUSHJ P,DDPA ;PRINT SECONDS
CAIE B,0 ;RG MEMORIAL (?) HALF SECOND OF SILENCE
PRINT .5
POPJ P,
NODATE: PRINT -
POPJ P,
LDATE: PRINT L
POPJ P,
DDPA: CAIGE A,10. ;SHOULD WE PRINT A '0' AS IN 4:07?
PRINT 0
PUSH P,B
PUSHJ P,DPT
POP P,B
POPJ P,
GWD: 0
GWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT
AOBJN B,[JRST @GWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER)
SKIPL EOFF
JRST CPOPJ ;END OF FILE, RETURN FROM CALLER!!!!
MOVE B,[-2000,,BUF]
.IOT DSKIN,B
SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN
MOVNS B
HRLS B
HRRI B,BUF
CAME B,[-2000-1,,BUF] ;FULL BUFFER?
AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE
JRST GWD1 ;NOW GET THE WORD
GWDF: 0 ;FOR FIND, GWD FROM DISK OR TAPE
SKIPN OFINDF
JRST GWDFD
GWDFM: JSR MGWD
JRST @GWDF
GWDFD: JSR GWD
JRST @GWDF
MGWD: 0
MGWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT
AOBJN B,[JRST @MGWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER)
SKIPL EOFF
JRST CPOPJ ;END OF FILE
MOVE A,[-2000,,BUF]
PUSHJ P,MAGREAD
JRST FILSKP ;ERROR, SKIP TO END OF FILE AND CONTINUE
MOVE B,A
SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN
MOVNS B
HRLS B
HRRI B,BUF
CAME B,[-2000-1,,BUF] ;FULL BUFFER?
AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE
JRST MGWD1 ;NOW GET THE WORD
SUBTTL MISCELLANEOUS MAGTAPE OPERATIONS
;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE
CLSOUT: SKIPL TAPTYP
JRST [ .CLOSE MAGOUT, ;CLOSE TAPE OUTPUT
POPJ P, ]
PUSHJ P,RMTEOF ;Write a second EOF mark
SETOM CTRLG ;Defer ^G
PUSHJ P,RTAPE"FINISH ;Make sure all output was completed
JRST RMTWER ;Tape error
JRST CTRLGX ;Don't close RTAPE server yet
;WRITE EOF,MAGOUT ASUMED OPEN
AEOF: SKIPGE TAPTYP
JRST RMTEOF
MOVEI A,5
MOVEM A,MTCMD
MOVE A,[MAGOUT,,MTCMD]
.MTAPE A,
JRST NAUGHT
POPJ P,
RMTEOF: SETOM CTRLG
PUSHJ P,RTAPE"WRTFM ;Write file mark
JRST CTRLGX
;SPACE TO LOGICAL END OF TAPE
AEOT: MOVEI A,10
PUSHJ P,TAPOPR
SETOM EOTFLG
SETOM UFDDAT
SETOM MFDDAT
CLEARM ITAPE
POPJ P,
;SPACE REVERSE FILE
SPRF: MOVE A,[-1,,7]
JRST TAPOPR
;SPACE FORWARD FILE
SPFF: MOVEI A,7
JRST TAPOPR
;REWIND
ARWND: SKIPA B,[1] ;SKIPS THROUGH
;REWIND THEN UNLOAD
AUNLD: MOVEI B,2
SETOM ITAPE
SETOM UFDDAT
SETOM MFDDAT
SKIPL A,THTPN
MOVEM A,LTHTPN
SETOM THTPN
MOVE A,B
PUSHJ P,TAPOPR
CLEARM EOTFLG
POPJ P,
;PERFORM A TAPE OPERATION, COMMAND CODE IN A
TAPOPR: SKIPGE TAPTYP
JRST RMTOPR
LCLOPR: OPEN MAGIN,MAGI
JRST RET
MOVEM A,MTCMD
MOVE A,[MAGIN,,MTCMD]
.MTAPE A,
JRST NAUGHT
.CLOSE MAGIN,
POPJ P,
;This just initiates the operation
;Call SETIT1 if you want to know if it worked
RMTOPR: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,A
PUSHJ P,SETIT1 ;Terminate any pending read-ahead
POP P,A
SETOM CTRLG
XCT RMTDIS(A)
POP P,D
POP P,C
POP P,B
JRST CTRLGX
RMTDIS: .VALUE
PUSHJ P,RTAPE"REWIND
PUSHJ P,RTAPE"UNLOAD
REPEAT 4,.VALUE
PUSHJ P,[ HLRE B,A ;7 space file
JRST RTAPE"SKPFL0 ]
PUSHJ P,[ MOVSI B,20000 ;10 space to eot
JRST RTAPE"SKPFL0 ]
;ROUTINE TO DETERMINE WHETHER USER IS SURE
CHECK: PUSH P,LPTSW
SETZM LPTSW
PUSHJ P,CRR
PRINT ARE YOU SURE ?
CHECK2: PUSHJ P,TYI
CAIE A,"Y
JRST ERR
PUSHJ P,CRR
POP P,LPTSW
POPJ P,
;Show who used tape drive last. Put this on .TAPE0. That's ok,
;since FIND ignores files that aren't "TAPE XXX."
SETITN: .suset [.runame,,a]
.rdate d,
.call [setz
sixbit /MLINK/
[sixbit /DSK/]
[sixbit /LAST/]
[sixbit /USE/]
[sixbit /.TAPE0/]
COMT(B) ;which command
D ;when
SETZ A] ;who
jfcl
;Drops in.
;SET ITAPE ROUTINE
;Call here first time tape is used
SETIT: SKIPE TAPTYP ;Do we know what type of drive to use?
JRST SETIT0 ;Yes
.OPEN MAGIN,MAGI ;No, see if there is a local drive
JRST [ .SUSET [.RIOS+MAGIN,,A]
LDB A,[220600,,A]
CAIE A,%ENSDV
JRST .+1
SETOM TAPTYP ;Use remote drive
JRST SETIT0 ]
AOS TAPTYP ;Default is local drive if it exists
SETIT0: PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF
TRNN A,TF%BOT ;Check for BOT
POPJ P, ;No
SETOM ITAPE ;Yes, at BOT
SETOM UFDDAT
SETOM MFDDAT
POPJ P,
SETIT1: SKIPGE A,TAPTYP ;Remote tape?
JRST SETIT2 ;Yes
SETIT4: OPEN MAGIN,MAGI ;WAIT FOR ALL TAPE ACTIVITY TO STOP
JRST RET ;BARF
IFN NEWCOD, .STATUS MAGIN,TAPEF
.CLOSE MAGIN,
IFE NEWCOD, CONI 344,TAPEF ;READ MAG TAPE STATUS
MOVE A,TAPEF
POPJ P,
;Mount remote tape if not already mounted
SETIT2: PUSHJ P,RTAPE"RDRST ;Reset read and write buffers, stop readahead
AOJL A,RMTSTS ;Jump if already mounted
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,N
PUSH P,SYM
PUSH P,TER
SKIPE TAPHST ;Host known yet?
JRST SETIT3
PRINT TAPE SERVER HOST=
PUSHJ P,GETSYL
JRST ERR
PUSH P,SYM
PRINT DRIVE=
PUSHJ P,GETSYL
JRST ERR
MOVE B,[440700,,TAPDRV]
PUSHJ P,SIXTO7
POP P,SYM
MOVE B,[440700,,TAPHST]
PUSHJ P,SIXTO7
PRINT [READ-ONLY? ] ;HT server insists
PUSHJ P,TYI
MOVE SYM,[ASCII/BOTH/]
CAIN A,"Y
MOVE SYM,[ASCII/READ/]
MOVEM SYM,TAPDIR
PUSHJ P,CRR
SETIT3: MOVEI A,TAPHST
MOVEI B,CORSZB_10.
MOVEI C,TAPDRV
MOVEI D,TAPDIR
SETOM CTRLG
PUSHJ P,RTAPE"OPEN
JRST [ SETZM LPTSW
PRINT [Remote mount failed: ]
PASC RTAPE"STATUS ;Just the string is enough
SETZM TAPHST ;Don't save host if failed to connect
JRST MLP ]
;Develop tape status in A and TAPEF
RMTST1: MOVE B,RTAPE"STSFLG
MOVEI A,TF%RDY
TRNE B,RTAPE"F%BOT
TRO A,TF%BOT
TRNE B,RTAPE"F%EOT
TRO A,TF%EOT
TRNE B,RTAPE"F%EOF
TRO A,TF%EOF
TRNN B,RTAPE"F%OFFL
TRNN B,RTAPE"F%MNT
TRZ A,TF%RDY
MOVEM A,TAPEF
SETOM TAPTYP ;If not mounted, forget about this server
TRNE A,TF%RDY
SOS TAPTYP ;Mounted
TRNE B,RTAPE"F%STRG
JRST [ PUSH P,LPTSW
SETZM LPTSW
PRINT Remote tape status=
PASC RTAPE"STATUS
PUSHJ P,CRR
POP P,LPTSW
JRST .+1 ]
POP P,TER
POP P,SYM
POP P,N
POP P,E
POP P,D
POP P,C
POP P,B
JRST CTRLGX
;Tape already mounted, check status
;Develop tape status in A and TAPEF
RMTSTS: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,N
PUSH P,SYM
PUSH P,TER
SETOM CTRLG
PUSHJ P,RTAPE"PROBE
JRST RMTST1
;Remote login routine
RMTLGN: SKIPN RMTUSR ;First try own name and no password
JRST [ .SUSET [.RXUNAME,,SYM]
MOVE B,[440700,,RMTUSR]
PUSHJ P,SIXTO7
JRST .+1 ]
RMTLG1: MOVEI A,RMTUSR
MOVEI B,RMTPSW
PUSHJ P,RTAPE"LOGIN
CAIA
POPJ P,
PRINT [_REMOTE LOGIN AS ]
PASC RMTUSR
PRINT [ FAILED: ]
PASC RTAPE"STATUS
PUSHJ P,CRR
PASC TAPHST
PRINT [ USER ID=]
PUSHJ P,GETSYL
JRST MLP
MOVE B,[440700,,RMTUSR]
SKIPE SYM ;DON'T CHANGE USER ID IF BLANK INPUT
PUSHJ P,SIXTO7
MOVE A,TTYST1 ;TURN ECHOING OFF
ANDCM A,[<%TGPIE+%TGMPE>*010101010101]
MOVE B,TTYST2
ANDCM B,[<%TGPIE+%TGMPE>*010101010101]
.CALL [ SETZ ? 'TTYSET ? MOVEI TYIC ? A ? B ? SETZ TTYSTS ]
JFCL
PRINT PASSWORD=
PUSHJ P,GETSYL
JRST MLP
.CALL TTYSET ;TURN ECHOING BACK ON
JFCL
MOVE B,[440700,,RMTPSW]
PUSHJ P,SIXTO7
JRST RMTLG1
SIXTO7: MOVEI N,0 ;Sixbit in SYM to ASCIZ, BP in B
LSHC N,6
ADDI N,40
IDPB N,B
JUMPN SYM,SIXTO7
IDPB SYM,B
POPJ P,
;Commands to specify tape drive to use
AREMOTE:SKIPA A,[-1]
ALOCAL: MOVEI A,1
MOVEM A,TAPTYP
.CLOSE RTAPE"RSICH, ;Dispose of possible remote server
.CLOSE RTAPE"RSOCH,
SETZM TAPHST ;Force ask for host again
PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF
SKIPGE TAPTYP
PRINT [REMOTE ]
SKIPLE TAPTYP
PRINT [LOCAL ]
PRINT TAPE
TRNE A,TF%BOT ;Check for BOT
JRST ALOCL1
PRINT [ NOT REWOUND]
TRNN A,TF%RDY ;Check for offline
JRST ALOCL2 ;If offline, leave ITAPE alone so quit works
SETZM ITAPE
POPJ P,
ALOCL1: PRINT [ REWOUND]
SETOM ITAPE
SETOM UFDDAT
SETOM MFDDAT
POPJ P,
ALOCL2: PRINT [ AND NOT ON-LINE]
POPJ P,
;COMMAND TO SPACE TAPE, LISTING FILES, AND WAITING FOR A SPACE
; AFTER EACH
ALSPACE:PUSHJ P,CRR
PUSHJ P,TYOS
ASPAC2: PUSHJ P,LAST
POPJ P,
PUSHJ P,TYI
CAIN A,177
POPJ P,
JRST ASPAC2
;COMMAND TO SPACE TAPE FORWARD OR BACKWARD 'N' FILES
ASPACE: SETZM N
CAIN TER,15
JRST ASPAC1
PUSHJ P,GETSYL
POPJ P,
ASPAC1: MOVEI A,7
ADDM N,ITAPE
SKIPGE ITAPE
SETOM ITAPE
SKIPGE N
SOS N ;SPACE REVERSE
HRL A,N
PUSHJ P,TAPOPR
PUSHJ P,SETIT1 ;Await completion and get tape status
TRNN A,TF%BOT ;Unless BOT,
SKIPL N ;SPACING BACKWARD?
POPJ P,
JRST SPFF ;NOW SPACE FILE FORWARD
SUBTTL GET TAPE NUMBER, LISTING DEVICE
TAPGET: PUSH P,LPTSW
TAPGT1: SETZM LPTSW
PRINT TAPE NO=
PUSHJ P,GETSYL
JRST TAPGT1
JUMPL N,TAPGT1
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
CAIL N,MAXTAP
JRST TAPGT1
POP P,LPTSW
HRLM N,THTPN
SETZM NPLACE
MOVEM SYM,NSVTPN
MOVEM SYM,GFRLNK+4
SKIPN LPTSW
JRST SNPLAC
PRINT TAPE NO =
PDPT N
PASC [ASCIZ / /]
.RDATE A,
MOVEM A,THDATE
PRINT CREATION DATE
PSIS THDATE
PASC [ASCIZ / /]
PRINT DUMPED BY
.SUSET [.RXUNAME,,A]
PSIS A
JRST SNPLAC ;DECIDE WHERE TO PUT .TAPEn FILE
ATPLA: HRRZ A,LPTO
CAIN A,(SIXBIT /TPL/)
JRST NAUGHT
PRINT CHANGED TO TPL_
MOVEI SYM,(SIXBIT /TPL/)
JRST SETOU1
DEVGET: PRINT LIST DEV =
SETOUT: PUSHJ P,GETSYL ;READ DEVICE TO BE USED FOR LISTING STUFF ON
JRST DEVGET
HLRZS SYM
SKIPN SYM
MOVEI SYM,'TTY ;RESPONSE OF CR MEANS TTY
CAIN SYM,'TTY
POPJ P,
SETOU1: HRRM SYM,LPTO
.SUSET [.SSNAM,,MYNAME] ;WRITE ON USER'S WORKING DIR
OPEN LPTCH,LPTO ;LIST FILES ON TAPE
JRST ATPLA
SETOM LPTSW ;SET LPT SWITCH ON
POPJ P,
SUBTTL DECIDE WHERE TO PUT .TAPEn; TAPE nnn FILE
;THIS IS A TABLE OF THE NAMES OF ALL THE TAPE DIRECTORIES
TDIRTB: REPEAT 10., <SIXBIT/.TAPE0/>+.RPCNT
REPEAT 26., <SIXBIT/.TAPEA/>+.RPCNT
NTDIR==.-TDIRTB
;HERE IS A SORT OF KLUDGE TO EXAMINE THE TAPE DIRECTORIES OF A
;DECEASED ITS (IN THIS CASE, AI.) RESTORE ALL THE TAPE
;DIRECTORIES TO SOME MACHINE, UNDER THE NAMES %TAPEn;.
DFINDF: 0 ;-1 => LOOKING ON DECEASED MACHINE'S TAPE DIRS.
DEDDEV: SIXBIT /DM/ ;MACHINE WHERE %TAPEn DIRS ARE STORED.
DEDITS: SIXBIT /AI/ ;WHICH MACHINE'S TAPE DIRS THEY WERE.
DDIRTB: REPEAT 10., <SIXBIT/%TAPE0/>+.RPCNT
REPEAT 26., <SIXBIT/%TAPEA/>+.RPCNT
NDDIR==.-TDIRTB
SNPLAC: SKIPN NPLACE ;IF ALREADY KNOW, DON'T MAKE INFINITE SYSTEM CALLS
JRST SNPL0
.SUSET [.SSNAME,,NPLACE]
POPJ P,
SNPL0: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
HLRZ A,THTPN
MOVE D,NSVTPN
CAIE A,-1
JRST SNPL00
HLRZ A,LTHTPN
MOVE C,[440600,,D]
MOVEI D,0
PUSHJ P,SIXNUM
SNPL00: MOVEM D,SNTRYN
SETOB B,C ;B NAME OF LEAST FULL DIR, C SPACE LEFT IN IT
MOVSI A,-NTDIR
SNPL1: .CALL SNTRY ;IS TAPE IN THIS DIR?
JRST [ CAIN E,4
JRST SNPL3 ;NO
CAIN E,20
JRST SNPL2 ;NON-EXISTENT DIRECTORY
PRINT ERROR ACCESSING TAPE DIR -
PUSHJ P,OPINFL
JRST SNPL3 ]
MOVE B,TDIRTB(A)
JRST SNPL4 ;YES, LEAVE IN SAME DIR
SNPL3: MOVE E,TDIRTB(A) ;READ DIR TO SEE HOW FULL IT IS
.SUSET [.SSNAME,,E]
.OPEN SNPLCH,FNO
.LOSE %LSFIL
MOVE D,[-UDNAMP-1,,SNBUF]
.IOT SNPLCH,D
CAML C,SNBUF+UDNAMP
JRST SNPL3A
MOVE C,SNBUF+UDNAMP ;THIS DIR LESS FULL
MOVE B,TDIRTB(A)
SNPL3A: AOBJN A,SNPL1 ;TRY NEXT DIR
SNPL2: CAIL C,460
JRST SNPL4 ;THIS ONE HAS ENOUGH SPACE
JUMPL A,SNPL2A
SETZM LPTSW
DIE ALL TAPE DIRECTORIES FULL
SNPL2A: MOVE E,TDIRTB(A)
.SUSET [.SSNAME,,E]
.OPEN SNPLCH,CRUFD ;BEST DIR IS GROSSLY FULL, CREATE A NEW ONE
JFCL
.SUSET [.RIOS+SNPLCH,,C]
LDB C,[220600,,C]
CAIE C,4 ;ERROR CODE BETTER BE FILE NOT FOUND!
JRST [ SETZM LPTSW
DIE [NO FREE UFD SLOTS, CANNOT CREATE ANOTHER TAPE DIRECTORY, GET HELP]
]
MOVE B,TDIRTB(A)
SNPL4: MOVEM B,NPLACE ;USE THIS DIR
.SUSET [.SSNAME,,NPLACE]
.CLOSE SNPLCH,
POP P,E
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
SUBTTL TAPE LISTING COMMANDS
;QUIT COMMAND
AQUIT: .BREAK 16,160000
;LIST CONTENTS OF A TAPE BY USING .TAPEn FILE
ATLIST: PUSHJ P,DEVGET
PUSHJ P,TAPGET
PUSHJ P,SNPLAC ;FIND WHICH TAPE DIR TO USE
MOVEI A,.BII
HRLM A,NSVOP
.OPEN SAVET,NSVOP
CAIA
JRST ATLST4
PRINT NOT FOUND
JRST RET
ATLST4: SETZM ITAPE
MOVE A,[-1,,B]
.IOT SAVET,A
ADD B,[1,,THBLK+1]
.IOT SAVET,B
PUSHJ P,PTHEAD
MOVE A,[-1,,GARBAG]
.IOT SAVET,A
ATLST1: HRROI A,B
.IOT SAVET,A
JUMPL A,ATLST2
SKIPN B
JRST ATLST3
MOVEM B,HBLK+2
HRROI A,HBLK+3
.IOT SAVET,A
JUMPL A,ATLST2
HRROI A,HBLK+5
.IOT SAVET,A
JUMPL A,ATLST2
PUSHJ P,LOUSY
JFCL
AOS ITAPE
JRST ATLST1
ATLST2: SETOM ITAPE
SETOM MFDDAT
SETOM UFDDAT
.CLOSE SAVET,
POPJ P,
ATLST3: HRROI A,HBLK+1
.IOT SAVET,A
JRST ATLST1
APTDIR: SETOM PDIRSW ;PRINT DIRECTORIES FROM TAPE.
PUSHJ P,DEVGET
PUSHJ P,APTD1
POPJ P,
JRST .-2
APTD1: PUSHJ P,MAGOP
POPJ P,
PUSHJ P,FILSKP
AOS (P)
POPJ P,
ALIST: PUSHJ P,DEVGET ;LIST FILES ON MACRO-TAPE
PUSHJ P,LAST
POPJ P,
JRST .-2
LAST: PUSHJ P,LOUSE
POPJ P,
PUSHJ P,FILSKP ;FLUSH REST OF FILE (PITY WE HAVE TO READ ALL THIS CRUFT)
AOS (P)
POPJ P,
;SAVE STUFF ABOUT THIS TAPE IN SYSENG; MACRO TAPES FILE
SINFO: IRPS X,,[THTPN THTYPE FUSNM LUSNM]Y,,[STAPEN STYPE SFUSNM SLUSNM]
MOVE A,X
MOVEM A,Y
TERMIN
MOVE A,THTPN
CAME A,[-1]
JRST SINFO5
MOVE A,LTHTPN
MOVEM A,STAPEN
SINFO5: .RDATE A,
MOVEM A,STDATE
SINFO1: .SUSET [.RUNAME,,SUSER]
.SUSET [.SSNAM,,SPLACE]
SINFO4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE
HRLM A,STATOP
.OPEN STATC,STATOP
JRST SINFO2
.CALL CLBIT ;ZERO DUMPCHECK BIT
JFCL
HLRZ A,STAPEN
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
CAIL A,MAXTAP
DIE [TAPE NUMBER TOO LARGE, YOU LOSE]
IMULI A,TPINFL ;ACCESS TAPE INFO BLOCK
.ACCESS STATC,A
MOVE A,[-TPINFL,,STAPST]
.IOT STATC,A
.CLOSE STATC,
.SUSET [.SSNAM,,USNM]
POPJ P,
SINFO2: MOVEI A,.BIO ;MACRO TAPES DOESN'T EXIST, CREATE IT
HRLM A,STATOP
OPEN STATC,STATOP
JRST RET
SETZM BUF
MOVE A,[BUF,,BUF+1]
BLT A,BUF+TPINFL-1
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
MOVEI B,MAXTAP
SINFO3: MOVE A,[-TPINFL,,BUF]
.IOT STATC,A
SOJG B,SINFO3
.CLOSE STATC,
JRST SINFO4
;GET INFO ON A TAPE OUT OF SYSENG; MACRO TAPES FILE
GINFO: MOVEI B,.BII
HRLM B,STATOP
.SUSET [.SSNAM,,SPLACE]
.OPEN STATC,STATOP
JRST GINFO1
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
CAIL N,MAXTAP
DIE [TAPE NUMBER TOO LARGE, YOU LOSE]
IMULI N,TPINFL
.ACCESS STATC,N
MOVE A,[-TPINFL,,STAPST]
.IOT STATC,A
.CLOSE STATC,
GINFO2: .SUSET [.SSNAM,,USNM]
POPJ P,
GINFO1: SETZM STAPST
MOVE A,[STAPST,,STAPST+1]
BLT A,STAPST+TPINFL-1
JRST GINFO2
;COMMAND TO LIST ALL KNOWN TAPES
ATAPES: PUSHJ P,DEVGET
.SUSET [.SSNAM,,SPLACE]
MOVEI A,.BII
HRLM A,STATOP
OPEN STATC,STATOP
JRST RET
MOVEI U,0
TAPES1: MOVE A,[-TPINFL,,STAPST]
.IOT STATC,A
SKIPE STAPEN
PUSHJ P,LINFO
ADDI U,1
SKIPE WRONG
DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
CAIGE U,MAXTAP
JRST TAPES1
.CLOSE STATC,
JRST CRR
;COMMAND TO LIST A SINGLE TAPE
ATAPE: PUSHJ P,TAPGET
PUSHJ P,GINFO
PUSHJ P,LINFO
JRST CRR
;LIST OUT MACRO TAPES INFO
LINFO: HLRZ A,STAPEN
JUMPE A,NOINFO
PDPT A
PSIS STDATE
SKIPN STYPE
PRINT NORM
SKIPGE STYPE
PRINT INCR
SKIPLE STYPE
PRINT FULL
PSIS SUSER
SKIPN SDONE
PRINT ABRT
SKIPLE SDONE
PRINT ARCH
SKIPGE SDONE
PRINT DUMP
HRRZ A,STAPEN
PDPT A
PRINT
PSIS SFUSNM
PSIS SLUSNM
JRST CRR
NOINFO: PRINT NO INFORMATION
JRST CRR
;CREATE TAPE DIRECTORY ON DISK FROM MOUNTED TAPE
ATAPED: PUSHJ P,ARWND
PUSHJ P,MAGOP
POPJ P,
MOVE A,THTPN
MOVEM A,LTHTPN
SETOM THTPN ;KNOWN NUMERICALLY, NOT SYMBOLICALLY
SETZM NPLACE
PUSHJ P,SNPLAC ;FIND TAPE DIRECTORY IF ON-LINE ALREADY
MOVEI A,.BII ;OTHERWISE DECIDE WHERE TO PUT IT
HRLM A,NSVOP
.OPEN SAVET,NSVOP
JRST ATAPD3
PRINT _DIRECTORY ALREADY EXISTS._
PUSHJ P,CHECK
ATAPD3: MOVEI A,.BIO
HRLM A,NSVOP
OPEN SAVET,NSVOP
JRST RET
MOVE A,[-LTHBLK,,THBLK] ;STORE TAPE HEADER
.IOT SAVET,A
HRROI A,[-3,,0]
.IOT SAVET,A
SETOM USNM
DLUP: PUSHJ P,FILSKP ;SKIP THIS TAPE FILE
PUSHJ P,MAGOP ;GET NEXT
POPJ P, ;EOT
MOVE B,USNM
CAME B,HBLK+1 ;NEW S NAME?
PUSHJ P,DLUPSN ;YES.
MOVE A,[-2,,HBLK+2] ;FILE NAMES
.IOT SAVET,A
MOVE A,[-1,,HBLK+5] ;DATE
.IOT SAVET,A
JRST DLUP
DLUPSN: MOVE A,HBLK+1 ;SWITCH S NAMES
MOVEM A,USNM
HRROI A,[0] ;0 FN FLAGS SNAME CHANGE
.IOT SAVET,A
HRROI A,USNM
.IOT SAVET,A
POPJ P,
;COMMAND TO CHANGE STORED INFO ABOUT A TAPE
TAPSET: PUSHJ P,TAPGET ;GET TAPE NUMBER
MOVE U,N
PUSHJ P,GINFO
PUSHJ P,LINFO
HRLM U,STAPEN
LWREQ: PRINT LAST WRITTEN=
PUSHJ P,GETSYL
JRST LWREQ
CAIN A,33
JRST TAPST1
SKIPE SYM
MOVEM SYM,STDATE
PRINT TYPE=
PUSHJ P,TYI
MOVEI C,1
CAIN A,33
JRST TAPST1
CAIN A,"F
MOVEM C,STYPE
CAIN A,"R
SETZM STYPE
CAIN A,"I
SETOM STYPE
PRINT _ARCHIV?
PUSHJ P,TYI
CAIN A,"Y
MOVEM C,SDONE
CAIN A,"N
SETOM SDONE
SKIPN STYPE
JRST TAPST1
RNFULU: PRINT _REEL NO FIRST USER LAST USER
BACK: PUSHJ P,GETSYL
JRST RNFULU
CAIN A,33
JRST TAPST1
MOVEM SYM,W
SKIPE SYM
HRRM N,STAPEN
BACK1: PUSHJ P,GETSYL
JRST UNDO1
CAIN A,33
JRST TAPST1
SKIPE SYM
MOVEM SYM,SFUSNM
PUSHJ P,GETSYL
JRST UNDO2
SKIPE SYM
MOVEM SYM,SLUSNM
TAPST1: PUSHJ P,CHECK
JRST SINFO1
UNDO1: PSIS W
PUSHJ P,TYOS
JRST BACK
UNDO2: PSIS SYM
PUSHJ P,TYOS
JRST BACK1
;MORE LISTING COMMANDS AND SUBROUTINES
LOUSE: PUSHJ P,MAGOP ;OPEN TAPE AND READ HEADER
JRST ENDMAG ;END OF TAPE
LOUSY: PUSHJ P,CRR
PUSHJ P,TAPN
PSIS HSNM
PSIS HFN1 ;OUTPUT FILE NAME
PSIS HFN2
SKIPE LNKFLG
PUSHJ P,LDMUT5
SKIPE LNKFLG
JRST NOPP
SKIPL HPKN
PDPT HPKN ;OUTPUT PACK NUMBER
NOPP: SIXTYP [SIXBIT/ /]
MOVE A,HDATE
MOVEM A,DAYTIM
SKIPN LNKFLG
PUSHJ P,PFDATE
AOS (P)
POPJ P,
ENDMAG: PRINT _ REEL =
HRRZ A,THTPN
PDPT A ;OUTPUT REEL NUMBER
JRST CRR
;COMMAND TO LIST THE MFD
AMFD: PUSHJ P,DEVGET
SETOM MFDIN
AMFD1: PUSHJ P,MFDN
POPJ P,
PSIS USNM
PUSHJ P,CRR
JRST AMFD1
;COMMAND TO LIST A DIRECTORY
ALISTF: SETOM FLNI
CLEARM MICFLG
MOVEI A,(SIXBIT /DSK/)
HRRM A,FNO
GETDIR: PRINT DIRECTORY=
PUSHJ P,GETSYL
JRST GETDIR
CAIN TER,15
PUSHJ P,CRR
CAIN TER,":
HLRM SYM,FNO
MOVEM SYM,USNM
CAIE TER,":
.SUSET [.SSNAM,,USNM]
PUSHJ P,DEVGET ;WHERE TO LIST IT TO
ALISTK: PUSHJ P,FNG
JRST CRR
PUSHJ P,CRR
PSIS FN1
PSIS FN2
SKIPN MICFLG
PDPT PACKN
JRST ALISTK
;LISTING ROUTINES
;LIST LINK INFO
LDMUT5: PSIS [SIXBIT /L/]
PSIS PACKN ; SYSNM
PSIS LNKNM1
PSIS LNKNM2
POPJ P,
;WHEN LOADING, LIST SNAMES AS ENCOUNTERED
LDMUT4: MOVE A,HSNM
CAMN A,CUSN
POPJ P, ;SAME NAME
PUSHJ P,TAPN
MOVEM A,CUSN ;NEW NAME
PSIS CUSN
JRST CRR
;LIST A FILE THAT'S ACTUALLY BEING LOADED
LDMUT3: PUSHJ P,TAPN
PSIS HFN1
PSIS HFN2
SKIPE LNKFLG
PUSHJ P,LDMUT5
SKIPN LNKFLG
PDPT HPKN
JRST CRR
SUBTTL RETRIEVAL ROUTINES (LOAD, RELOAD)
RETRV0: SKIPL LDPACK
SKIPE LOSRSW
JRST RETRV
PRINT LDPACK FEATURE ISN'T GOING TO WORK UNLESS YOU RELOAD IN SORRY MODE
JRST ERR
SFRETR: PUSHJ P,FILSKP ;FLUSH CURRENT FILE, THEN DROP INTO RETRV
;ENTER HERE FROM EXECU FOR LOAD AND RELOAD COMMANDS
RETRV: PUSHJ P,MAGOP ;OPEN TAPE
POPJ P, ;END OF TAPE
SKIPL A,LDPACK
JRST [ CAME A,HPKN ;ON SINGLE PACK BEING RELOADED?
JRST SFRETR ;NO, SKIP IT
JRST .+1 ]
SKIPL A,BBPACK
JRST [ CAME A,HPKN ;ON SINGLE PACK BEING BROUGHT BACK?
JRST SFRETR ;NO, SKIP IT.
JRST .+1 ]
SKIPE LSTWHL ;LIST?
PUSHJ P,LDMUT4
MOVN W,LENGTH ;SEE IF THIS IS ONE OF THE FILES
HRLZS W ;THAT WE WERE ASKED TO LOAD.
COMCN2: SKIPN D,FMSNM(W)
JRST CM2FN1
CAME D,HSNM
JRST NEXCM2
CM2FN1: SKIPN D,FMFN1(W)
JRST CM2FN2
CAME D,HFN1
JRST NEXCM2
CM2FN2: SKIPE D,FMFN2(W)
CAMN D,HFN2
JRST RETRVF
NEXCM2: AOBJN W,COMCN2
JRST SFRETR ;IT'S NOT, FLUSH IT
;CURRENT TAPE FILE MATCHES SPECS OF FILES TO BE LOADED
RETRVF: IRP X,,[FN1,FN2] ;STORE FILE NAMES INTO 'CPYO' OPEN BLOCK
SKIPE A,TO!X(W)
MOVEM A,L!X
MOVE A,H!X
SKIPN TO!X(W)
MOVEM A,L!X
TERMIN
MOVEI A,(SIXBIT /DSK/)
SKIPN TODEV(W)
HRRM A,CPYO ;UNSPECIFIED DESTINATION FOR LOADS IS DISK
SKIPE A,TODEV(W)
HLRM A,CPYO ;SPECIFIED DESTINATION
SKIPN A,TOSNM(W)
MOVE A,HSNM ;UNSPECIFIED SNAME IS THE ONE READ FROM TAPE
.SUSET [.SSNAM,,A] ;SET SNAME FOR MERGE TEST
MOVEI B,36 ;BLOCK IMAGE INPUT, DON'T TOUCH REFDATE,
HRLM B,CPYO ; AND DON'T CHASE LINKS
SKIPGE DEADPK ;If DEADPK being restored
JRST CHMRG
MOVE B,LFN1 ; SNAME still in A...
MOVE C,LFN2
PUSHJ P,DKLOOK ; Look up file on disk
JRST SFRETR ; No longer around, skip it
MOVEM A,DKBLK ; Save this for later...
MOVE B,UNRNDM(A)
LDB C,[UNPKN B]
TLNN B,UNLINK
CAME C,DEADPK
JRST SFRETR ; Link, or wrong pack, skip it
MOVEI D,[ASCIZ\file on tape is a link.\]
SKIPE LNKFLG
JRST NORETR ; What kind of a tape is he using?
MOVE B,UNDATE(A)
CAMN B,HDATE
JRST OKRETR ; Dates match, go read it!
MOVEI D,[ASCIZ\file on disk has a different creation date.\]
JRST NORETR
;CHECK FOR MERGE MODE
CHMRG: SKIPL MRGSW
JRST CHCARE
.OPEN DSKOUT,CPYO ;MERGE. DON'T LOAD IF FILE EXISTS.
JRST OKRETR ;FILE DOESNT EXIST
MOVEI D,[ASCIZ\file already exists on disk.\]
JRST NORETR ;FILE EXISTS, DON'T FILE ON TOP OF.
;IF NOT IN MERGE MODE, SEE IF FILE EXISTS ON DISK AND
; ISN'T DUMPED YET AND WE'RE BEING CAREFUL. IF SO, DON'T CLOBBER IT.
CHCARE: SKIPE CAREF
SKIPE MICFLG
JRST CHRECN ;IF NOT BEING CAREFUL, LOAD OVER
.OPEN DSKOUT,CPYO
JRST OKRETR ;IF DOESNT EXIST, LOAD OVER
MOVEI A,DSKOUT
.DMPCH A, ;OTHERWISE, SEE IF DUMPED
JUMPN A,CHRECN ;YES WAS DUMPED, OK TO LOAD OVER
MOVEI D,[ASCIZ\file exists on disk and has not been backed up.\]
JRST NORETR
;CHECK FOR OVER-WRITING MORE RECENT FILE
CHRECN: SKIPE LOSRSW
JRST OKRETR ;DON'T CHECK IF SORRY MODE
MOVEI A,36 ;BLOCK IMAGE INPUT, DON'T SET REF DATE,
HRLM A,CPYO ; AND DON'T CHASE LINKS
.OPEN DSKOUT,CPYO
JRST OKRETR ;FILE DOES NOT EXIST, NO OVERWRITE PROBLEMS
.CALL [ SETZ ? 'FILBLK ? MOVEI DSKOUT ;GET FILE INFO
MOVEM D ? MOVEM D ? MOVEM D ;D GETS UNRNDM BITS
SETZM A ] ;A GETS CREATION DATE
.LOSE %LSFIL
TLNN D,UNLINK ;DON'T WORRY ABOUT LINKS, OR FILES
CAMG A,HDATE ;WITH OLDER CREATION DATE THAN THAT ON TAPE
JRST OKRETR
MOVEI D,[ASCIZ\a newer file with same name exists on disk.\]
JRST NORETR
;FILE SPECS SAY TO RETRIEVE THIS FILE, BUT OTHER OPTIONS SUCH
;AS MERGE SAY NOT TO. D -> ASCIZ STRING FOR WHY THIS SHOULDN'T
;BE RETRIEVED. IF 'NOASK' WAS NOT SPECIFIED, CONSULT
;USER, OTHERWISE SKIP IT.
;W -> CURRENT RETRIEVAL FILE, CPYO (LFN1, LFN2) HAS ACTUAL FILE WRITING TO.
NORETR: SKIPE NOASK
JRST SFRETR ;YES, JUST FLUSH IT QUIETLY
PUSH P,LPTSW
SETZM LPTSW
PRINT _File
.SUSET [.RSNAME,,A]
PSIS A
PRINT [;]
PSIS LFN1
PSIS LFN2
PRINT [ not getting retrieved because ]
PASC (D)
PRINT [_Do you want to retrieve it anyway? ]
NORET1: PUSHJ P,TYI
MOVE D,A
PUSHJ P,CRR
CAIE D,"N
CAIN D,"Y
JRST NORET2
PRINT [(Y or N) ]
JRST NORET1
NORET2: POP P,LPTSW
CAIE D,"Y
JRST SFRETR ;NO, FLUSH IT
JRST OKRETR ;YES, LOAD IT
;SKIP AN INPUT FILE
FILSKP: SKIPGE TAPTYP
JRST [ SETOM CTRLG
PUSHJ P,RTAPE"SKPFIL
JRST CTRLGX ]
PUSH P,A
PUSH P,B
MOVEI A,7
MOVE B,[MAGIN,,A]
.MTAPE B, ; SKIP TO EOF
JFCL
.CLOSE MAGIN,
POP P,B
POP P,A
POPJ P,
;OK, WE'VE DECIDED TO RELOAD IT.
OKRETR: SKIPE LNKFLG
JRST RETRLK ;GO RELOAD LINK
MOVE A,HSNM ;DIR LOADING ONTO
CAMN A,[SIXBIT/.KLFE./]
JRST [ PRINT [ATTEMPT TO CLOBBER KL10 FRONT END DIRECTORY, FILE BEING SKIPPED_]
JRST SFRETR ]
MOVE B,HFN1
CAMN A,[SIXBIT /./]
CAME B,[SIXBIT /.FEFS./]
SKIPA
JRST [ PRINT [ATTEMPT TO CLOBBER KS10 FRONT END FILESYSTEM, FILE BEING SKIPPED_]
JRST SFRETR ]
SKIPE A,TODEV(W) ;GET DEVICE TO WRITE TO
JRST OKRET0 ;EXPLICITLY SPECIFIED USE IT, OTHERWISE CHOOSE
MOVE B,HPKN ;IF RELOADING, AND FILE WAS FROM SECONDARY
MOVSI A,-NQS ; DISK, PUT IT BACK THERE
CAME B,QPKID(A)
AOBJN A,.-1
JUMPGE A,OKRET9
SKIPE A,QRESRV(A)
CAMN A,[-1]
JRST OKRET9
SKIPL RELOSW
OKRET9: MOVSI A,'DSK
OKRET0: SKIPE CRDIR
.OPEN CRUFD ;CREATE DIRECTORY IF NON-EXISTENT
JFCL
.CALL [SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT]
A ? [SIXBIT/_DUMP_/] ? SETZ [SIXBIT/OUTPUT/]]
.LOSE 1400 ;MIGHT AS WELL LET DDT HANDLE IT
SKIPE LSTWHL
PUSHJ P,LDMUT3 ;LIST THIS FILE
SETZM HFNL
HLRZ A,HSNM
CAIN A,'LCF
PUSHJ P,ISLCF
MOVE A,HDATE
SKIPGE RELOSW ;IF NOT RELOADING,
JRST OKRET1
SKIPE A
CAMN A,[-1]
PUSHJ P,ALD5 ;MAKE CREATION DATE FROM TAPE DATE
OKRET1: MOVEM A,FDATE
.CALL SDATE
JFCL ;IT DOESN'T MATTER WEATHER YOU WIN OR LOSE, ITS HOW YOU PLAY THE GAME.
OKRET2: MOVE A,[-2000,,BUF]
PUSHJ P,MAGRDL ;READ A BUFFER LOAD FULL
JRST RETRFN ;ERROR
HRLOI B,-BUF-1(A)
EQVI B,BUF
SKIPE HFNL
PUSHJ P,HFNLX
SKIPGE B
.IOT DSKOUT,B ;OUTPUT IT TO DISK
JUMPGE A,OKRET2 ;JUMP UNLESS EOF
PUSHJ P,FILSKP ;EOF, BE SURE.
SKIPN THTYPE
JRST OKRET3 ;RANDOM TAPE, DON'T CLEAR NOT-DUMPED INDIC.
.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZI 1]
.LOSE 1000
OKRET3: SKIPGE RELOSW
PUSHJ P,RELOAF ;IF WE ARE RELOADING, SET DUMPBIT,REAPBIT ,AUTHOR, REF DATE
SKIPL DEADPK
PUSHJ P,DKBLKF ; Restore attributes from saved file block
.CALL [SETZ ? 'RENMWO ? MOVEI DSKOUT ? LFN1 ? SETZ LFN2]
.LOSE 1000
;FILE HAS BEEN LOADED, REMOVED FROM LOAD SPECS
RETRFN: .CLOSE DSKOUT,
SKIPE FMSNM(W)
SKIPN FMFN1(W)
JRST RETRV ;WAS "*"=> DON'T FLUSH ENTRY
SKIPN FMFN2(W)
JRST RETRV
PUSHJ P,FLUSH
POPJ P, ;NOTHING MORE TO DO
JRST RETRV
ISLCF: HLRZ A,HFN1
CAIE A,'ACT
CAIN A,'DUN
SETOM HFNL
POPJ P,
HFNLX: PUSH P,B ;DONT COMPROMISE, RANDOMIZE!
PUSH P,A
HFNLXL: MOVE A,(B)
TSC A,1(B)
MOVEM A,(B)
AOBJN B,HFNLXL
POP P,A
POP P,B
POPJ P,
;FLUSH ENTRY OF FILE THAT WAS JUST DUMPED, OR LOADED
;SKIP RETURN IF ANY MORE FILES TO BE DONE
FLUSH: SOSN B,LENGTH
POPJ P, ;NOTHING MORE TO DO
SUBI B,1
HRLI A,FMDUMP+1(W) ;BLT DOWN ENTRIES ABOVE IT
HRRI A,FMDUMP(W)
BLT A,FMDUMP(B)
IRP X,,[FM,TO]
IRP Y,,[DEV,SNM,FN1,FN2]
HRLI A,!X!!Y+1(W)
HRRI A,!X!!Y(W)
BLT A,!X!!Y(B)
TERMIN
TERMIN
JRST POPJ1
; Restoring dead pack: set author, reference date, and reap bit from disk
; copy of UFD.
DKBLKF: MOVE C,DKBLK
LDB A,[UNAUTH UNREF(C)]
PUSHJ P,DKAUTH
.CALL [ SETZ ? SIXBIT /SAUTH/ ? MOVEI DSKOUT ? SETZ A ]
JFCL
HLLZ A,UNREF(C)
.CALL [ SETZ ? SIXBIT /SRDATE/ ? MOVEI DSKOUT ? SETZ A ]
JFCL
MOVE A,UNRNDM(C)
TLNE A,UNREAP
.CALL [ SETZ ? SIXBIT /SREAPB/ ? MOVEI DSKOUT ? SETZI 1 ]
JFCL
POPJ P,
;RELOADING, SET MISCELLANEOUS FILE ATTRIBUTES FROM TAPE COPY OF UFD
RELOAF: SKIPGE UFDDAT
POPJ P, ;NO UFD IN CORE
MOVE A,HSNM
CAME A,UFDBUF+UDNAME
POPJ P, ;WRONG NAME
MOVE C,UDNAMP+UFDBUF
ADDI C,UFDBUF
MOVE A,HFN1
SKIPA B,HFN2
RELOF1: ADDI C,LUNBLK
CAIL C,UFDBUF+2000
POPJ P, ;NOT FOUND
CAMN A,UNFN1(C)
CAME B,UNFN2(C)
JRST RELOF1
MOVE A,HDATE
CAME A,UNDATE(C)
POPJ P, ;SAME NAMES, DIFFERENT CREATION DATE
RELOF2: LDB A,[.BP (UNREAP),UNRNDM(C)]
.CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A]
JFCL
LDB A,[.BP (UNDUMP),UNRNDM(C)]
.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A]
JFCL
HLLZ A,UNREF(C)
.CALL [SETZ ? 'SRDATE ? 1000,,DSKOUT ? SETZ A]
JFCL
LDB A,[UNAUTH+UNREF(C)]
PUSHJ P,GEAUTH
POPJ P,
.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A]
JFCL
POPJ P,
;MAKE A A CREATION DATE FROM TAPE DATE
ALD5: SETZM A
PUSH P,B
PUSH P,C
LDB B,[300400,,THDATE]
LDB C,[360400,,THDATE]
IMULI C,10.
ADD B,C
DPB B,[330700,,A]
LDB B,[140400,,THDATE]
LDB C,[220400,,THDATE]
IMULI C,10.
ADD B,C
DPB B,[270400,,A]
LDB B,[000400,,THDATE]
LDB C,[060400,,THDATE]
IMULI C,10.
ADD B,C
DPB B,[220500,,A]
POP P,C
POP P,B
POPJ P,
;RELOAD A LINK
RETRLK: SKIPE LSTWHL
PUSHJ P,LDMUT3
.SUSET [.SSNAM,,HSNM]
SKIPE CRDIR
.OPEN CRUFD
JFCL
MOVE A,LFN1
MOVEM A,LNKBLK+1
MOVE A,LFN2
MOVEM A,LNKBLK+2
.OPEN DSKOUT,LNKBLK
.LOSE 1400 ;SHOULD SUCCEED, LET DDT HANDLE IT.
PUSHJ P,FILSKP ;FLUSH TO EOF
SKIPL RELOSW ;IF RELOADING,
JRST RETRFN ; WILL HAVE TO RESTORE MISC CRUFT
MOVEI A,36 ;DON'T CHASE LINKS, DON'T SET REFD,
HRLM A,CPYO ; BLOCK IMAGE INPUT (REOPEN THE LINK)
.OPEN DSKOUT,CPYO
.LOSE 1400 ;WE JUST PUT IT THERE!!
PUSHJ P,RELOAF
JRST RETRFN
SUBTTL 'OPEN' A MAGTAPE FILE FOR INPUT
; DFHBLK: Set all defaults in HBLK
; DFHDTS: Default dates in HBLK
DFHBLK: SETZM HBLK+1
MOVE A,[HBLK+1,,HBLK+2]
BLT A,HBLK+LHBLK-1
SETOM HLEN ; Unknown length
DFHDTS: SETOM HDATE ; Unknown creation date
HRROI A,777000 ; Unknown reference date
MOVEM A,HRDATE ; Unknown author, 36. bit bytes
POPJ P,
MAGOT: PSIS CHNTAB+MAGIN ;LOST
PUSHJ P,OPINFL
PUSHJ P,CRR
MOVEI A,150. ;WAIT FOR SOMEONE TO FIX TAPE DRIVE
.SLEEP A, ;DROP THROUGH
;ENTER HERE, NON-SKIP IF EOT.
MAGOP: PUSHJ P,DFHBLK ; Set defaults in HBLK
SKIPGE TAPTYP ;SKIP IF USING LOCAL DRIVE
JRST MAGOP0 ;REMOTE DRIVE STAYS OPEN I GUESS
.OPEN MAGIN,MAGI ;OPEN MAG TAPE INPUT (READ HEADERS)
JRST MAGOT ;WAIT FOR HIM TO MOUNT TAPE OR REWIND
MAGOP0: CLEARM ERRCNT ;RESET ERR COUNT FOR THIS FILE
AOSE ITAPE ;SKIP IF BEGINNING OF TAPE
JRST ART2 ; ALSO INCREMENTS FILE SEQUENCE NUMBER
PUSH P,A
SKIPGE TAPTYP
PUSHJ P,RMTSTS ;DRAIN QUEUED STATUS
POP P,A
SETZM THTYPE
SETOM THDATE
HRROI A,B
PUSHJ P,MAGREAD ;READ AOBJN WORD INTO B
JRST MAGOP ;ERROR, TRY NEXT FILE
TRNE B,-1
JSP D,BDHD ;BAD TAPE-HEADER - AOBJN WORD HAS NON-ZERO RIGHT HALF
CAMGE B,[-LTHBLK,,]
JSP D,BDHD ;BAD TAPE-HEADER - FIRST RECORD TOO LONG
ADD B,[1,,THBLK+1]
MOVE A,B
PUSHJ P,MAGREAD ;READ TAPE HEADER
JRST MAGOP ;ERROR, TRY NEXT FILE
HLRZ A,THTPN ;CHECK TAPE NUMBER
JUMPN A,ART3 ;IF NON-ZERO THEN IT IS VALID
PRINT [TAPE NUMBER ON TAPE IS 0, REAL TAPE NUMBER/NAME=]
PUSHJ P,GETSYL
JRST .-2 ;SOME SORT OF ERROR, REPROMPT
MOVEM SYM,NSVTPN
HRLM N,THTPN
ART3: PUSHJ P,PTHEAD ;TELL USER WHAT TAPE THIS CLAIMS TO BE
;HERE IF THIS WASN'T THE BEGINNING OF THE TAPE
ART2: HRROI A,B
PUSHJ P,MAGREAD ;READ ANOTHER WORD, SHOULD BE FILE HEADER AOBJN WD
JRST MAGOP
JUMPL A,EOTISH ;EOT
TRNE B,-1
JSP D,BDHD ;BAD FILE-HEADER - AOBJN WORD NON-ZERO RIGHT HALF
CAMGE B,[-LHBLK,,]
JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO LONG
CAMLE B,[-LHBLKZ,,]
JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO SHORT
ADD B,[1,,HBLK+1]
MOVE A,B
PUSHJ P,MAGREAD ;READ USER NAME, FILE NAMES AND PACK NUMBER
JRST MAGOP
SKIPGE A
JSP D,BDHD1 ;BAD FILE-HEADER - NOT ALL THERE
SETZM LNKFLG
HLRZ B,HPKN
SKIPN B ;LINK? (BITS ON IN LH OF PACK NUMBER)
JRST MAGOP1
MOVE A,[-3,,LNKNM1] ;YES, READ NAMES LINKED TO
PUSHJ P,MAGRDL
JRST MAGOP
SKIPGE A
JSP D,BDHD1 ;BAD FILE-HEADER - LINK NOT ALL THERE
SETOM LNKFLG
AOS (P) ;TAKE SUCCESS RETURN
POPJ P,
EOTISH: PRINT E-O-T
SETOM EOTFLG
SKIPL TAPTYP ;SKIP IF REMOTE TAPE
.CLOSE MAGIN,
POPJ P,
.SCALAR MGRDLF ; Flag for MAGRDL
; Like MAGREAD, but respect length in HLEN.
MAGRDL: SKIPGE HLEN
JRST MAGREAD ; Length is implicit on old tapes
PUSH P,A
SETZM MGRDLF
PUSHJ P,MAGREAD
SETOM MGRDLF
EXCH B,(P)
MOVEI B,(B)
SUBI B,(A) ; B: minus # words read
ADDB B,HLEN ; Adjust HLEN
JUMPLE B,MAGRDJ ; HLEN exhausted
JUMPL A,MAGRDN ; EOF but HLEN promises more...
MAGRDX: POP P,B
SKIPN MGRDLF
AOS (P)
POPJ P,
.VECTOR MGARB(LMGARB==:40)
MAGRDJ: JUMPL A,MAGRDK ; Already at EOF?
PUSH P,A
MAGRDH: SKIPE MGRDLF ; Errors?
JRST MAGRDE ; Yes: Nothing to do
MOVE A,[-LMGARB,,MGARB] ; No: Read extra garbage
PUSHJ P,MAGREAD
SETOM MGRDLF
JUMPGE A,MAGRDH ; No EOF yet? Keep reading.
MAGRDE: POP P,A
MAGRDK: SETZM HLEN ; Nothing left
MOVN B,B ; Adjust caller's ptr
HRLI B,(B)
SUB A,B
JRST MAGRDX
MAGRDN: SETOM MGRDLF
SETOM RDERR
SETOM ERRALL
AOS ERRCNT
PUSH P,LPTSW
SETZM LPTSW
PRINT _DATA ON TAPE TOO SHORT_
PUSHJ P,TAPN
PSIS HSNM
PSIS HFN1
PSIS HFN2
PRINT LENGTH ERROR TAPE IN ..FILE BEING SKIPPED.._
POP P,LPTSW
JRST MAGRDX
;DO .IOT MAGIN,A AND SKIP IF NO DATA ERROR
;FILE MARK SIGNALLED BY NOT COUNTING OUT THE AOBJN POINTER
MAGREA: SETZM RDERR
SETZM PHYEOT
SKIPGE TAPTYP
JRST RMTREA
.IOT MAGIN,A
SKIPN RDERR
AOS (P)
POPJ P,
RMTREA: PUSH P,B
CAMN A,[-1,,B]
HRROI A,(P)
TRNN A,-20
DIE Program error--RMTREAD can't read into AC's
SETOM CTRLG
PUSHJ P,RTAPE"READ
JRST RMTRER ;Tape error
POP P,B
AOS (P)
JRST CTRLGX
;Remote read error, code similar to INT1 and INT2
RMTRER: PUSHJ P,CTRLGX
PUSH P,A
PUSH P,D
PUSH P,LPTSW ;Error messages on TTY
SETZM LPTSW
PRINT _TAPE READ ERROR_
PUSHJ P,RTAPE"PRSTS
MOVE A,RTAPE"STSFLG ;Classify error
TRNE A,RTAPE"F%NLI+RTAPE"F%OFFL+RTAPE"F%EOT
JRST ERR ;Non-data error
AOS ERRCNT ;Non-recoverable data error
SETOM ERRALL
PUSHJ P,TAPN
PSIS HSNM
PSIS HFN1
PSIS HFN2
PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._
TRNN A,RTAPE"F%EOF
PUSHJ P,FILSKP ;If not already at EOF, skip file
SETOM RDERR
POP P,LPTSW
POP P,D
POP P,B
POP P,A
POPJ P,
;WRITE BLOCK (NOT RECORD) TO TAPE, AOBJN POINTER IN A
MAGWRI: SKIPGE TAPTYP
JRST [ SETOM CTRLG ;Remote drive
PUSHJ P,RTAPE"WRITE
JRST CTRLGX ]
.IOT MAGOUT,A ;Local drive
POPJ P,
;Come here if write error on remote drive
;during RTAPE"WRITE, RTAPE"FORCE, or RTAPE"WRTFM
;Stack level unpredictable, but not at interrupt level
;All writes pass through ADMP4, which saves state so we can restore it
RMTWER: PUSHJ P,CTRLGX
PUSH P,LPTSW ;Error messages on TTY
SETZM LPTSW
MOVE A,RTAPE"STSFLG
TRNE A,RTAPE"F%EOT
JRST RMTEOT
PRINT _TAPE WRITE ERROR_
PUSHJ P,RTAPE"PRSTS
PRINT _SIMULATING E-O-T ..
RMTEOT: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE !
SKIPGE FULLDMP
JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB
DIE _PHYSICAL END OF TAPE
;BAD HEADER, SKIP FILE
BDHD: MOVE A,[-3,,HSNM]
PUSHJ P,MAGREAD
JRST MAGOP ;ERROR
BDHD1: PRINT _BAD HEADER
PSIS HSNM ;TRY TO TYPE STUFF PAST LOSING HEADER
PSIS HFN1
PSIS HFN2
PUSHJ P,CRR
PUSHJ P,FILSKP ;FLUSH CURRENT FILE
JRST MAGOP
;MAGOP, NOT A LINK
MAGOP1: MOVE A,HFN1
MOVE B,HFN2
CAMN A,[SIXBIT /M.F.D./]
CAME B,[SIXBIT /(FILE)/]
SKIPA
JRST MAGOP2 ;READ IN COPY OF MFD
CAMN A,[SIXBIT /.FILE./]
CAME B,[SIXBIT /(DIR)/]
JRST POPJ1 ;AN ORDINARY FILE, TAKE SUCCESS RETURN
;READ IN UFD FROM TAPE
SETZM UFDBUF
MOVE A,[UFDBUF,,UFDBUF+1]
BLT A,UFDBUF+1777
MOVE A,[-UDDESC,,UFDBUF] ;GET HEADER AREA
PUSHJ P,MAGRDL
JRST MAGOP ;ERROR, FLUSH
MOVE A,UFDBUF+UDESCP ;COMPUTE SIZE OF DESCRIPTOR AREA
ADDI A,5
IDIVI A,6
MOVNS A
HRLS A
HRRI A,UFDBUF+UDDESC
PUSHJ P,MAGRDL ;READ IN DESCRIPTOR AREA
JRST MAGOP ;ERROR, FLUSH
MOVE A,UDNAMP+UFDBUF ;COMPUTE SIZE OF NAME AREA
SUBI A,2000
HRLS A
HRR A,UDNAMP+UFDBUF
ADDI A,UFDBUF
PUSHJ P,MAGRDL ;READ IN NAME AREA
JRST MAGOP ;ERROR, FLUSH
MOVE A,HDATE
MOVEM A,UFDDAT
SKIPGE RELOSW ;IF RELOADING,
PUSHJ P,MAGOP3 ; UPDATE DISK DIRECTORY FROM TAPE
SKIPGE PDIRSW
PUSHJ P,PTUFD ;PRINT UFD FROM TAPE
HRRZ A,(P)
CAIN A,RLDRD0+1 ;RELOAD RDATES FROM THIS DIR
PUSHJ P,RLDRD1
PUSHJ P,FILSKP ;DONE WITH THIS FILE
JRST MAGOP ;TRY TO OPEN A REAL FILE
PTUFD: PUSH P,C
PUSH P,B
PUSH P,A
PUSH P,W
PUSH P,N
MOVE C,UFDBUF+UDNAMP
ADDI C,UFDBUF
PTUFD1: CAIL C,UFDBUF+2000
JRST [ POP P,N
POP P,W
POP P,A
POP P,B
POP P,C
POPJ P,]
SKIPE (C)
SKIPN 1(C)
JRST PTUFD2
PUSHJ P,CRR
MOVE B,UNRNDM(C)
TLNE B,UNLINK
PASC [ASCIZ /L /]
PSIS (C)
PSIS 1(C)
TLNE B,UNLINK
JRST [ PASC [ASCIZ /=>/]
LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX
PUSH P,B+1
IDIVI B,UFDBYT
ADDI B,UFDBUF+UDDESC
MOVNI N,-6(B+1)
IMULI N,6
HRLI N,60200 ;ASSUMING B=2 !!!
ROT N,30.
POP P,B+1
PUSHJ P,GETLSL
PSIS W ;SNAME
PASC [ASCIZ /;/]
PUSHJ P,GETLSL
PSIS W ;LINK FN1
PUSHJ P,GETLSL
PSIS W
JRST .+1]
PTUFD2: ADDI C,LUNBLK
JRST PTUFD1
;"RELOAD" A DIRECTORY IF IT MATCHES AGAINST THE FILE SPEC LIST
MAGOP3: MOVN A,LENGTH
HRLZS A
MAGOP4: SKIPE B,FMSNM(A)
CAMN B,HSNM
JRST DIRUPD
AOBJN A,MAGOP4
POPJ P,
;READ IN MFD FROM TAPE
MAGOP2: MOVE A,[-2000,,MFDBUF]
PUSHJ P,MAGRDL
JRST MAGOP ;ERROR, FLUSH
MOVE A,HDATE
MOVEM A,MFDDAT
PUSHJ P,FILSKP ;DONE WITH THIS FILE
;GO THROUGH ALL DIRECTORIES IN DISK MFD BUT NOT IN TAPE MFD.
;FOR EACH, SEE IF IT CONTAINS NO 'NEW' FILES. IF SO, OFFER
;TO DELETE IT. ONLY DO THIS WHEN RELOADING, OF COURSE.
SKIPL RELOSW
JRST MAGOP
.CALL [SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH]
[SIXBIT/DSK/] ? [SIXBIT/M.F.D./] ? SETZ [SIXBIT/(FILE)/]]
.LOSE 1400
MOVE A,[-2000,,BUF]
.IOT UFDCH,A
.CLOSE UFDCH,
SKIPA E,BUF+MDNAMP ;POINTS AT DISK MFD
MFDUP3: ADDI E,LMNBLK
CAIL E,2000
JRST MAGOP ;DONE ALL OF DISK MFD
SKIPN A,BUF(E) ;NAME OF A DISK DIR
JRST MFDUP3
MOVE D,MFDBUF+MDNAMP ;POINTS AT TAPE MFD
MFDUP2: CAIL D,2000
JRST MFDUP4 ;DIR EXISTS ON DISK BUT NOT ON TAPE
CAMN A,MFDBUF(D)
JRST MFDUP3 ;OK, DIR EXISTS ON BOTH
ADDI D,LMNBLK
JRST MFDUP2
MFDUP4: .SUSET [.SSNAME,,A] ;THIS DIR IS CANDIDATE FOR DELETION
MOVEI A,.BII
HRLM A,FNO
.OPEN UFDCH,FNO
.LOSE 1400
MOVE A,[-2000,,BIF]
.IOT UFDCH,A
.CLOSE UFDCH,
MOVE B,BIF+UDNAMP
CAIL B,2000
JRST MFDUP3 ;Directory already empty, ignore
CAIA
MFDUP5: ADDI B,LUNBLK
CAIL B,2000
JRST MFDUP6
MOVE C,UNDATE+BIF(B)
CAMLE C,MFDDAT
JRST MFDUP3 ;NEW FILE, PRESERVE THE DIR
HLLZ C,UNREF+BIF(B)
CAMLE C,MFDDAT
JRST MFDUP3 ;OLD FILE, BUT NEWLY REFERENCED
JRST MFDUP5
MFDUP6: PUSH P,LPTSW
SETZM LPTSW
PRINT _Directory
PSIS BIF+UDNAME
PRINT [ exists on disk but not tape and contains only old files.]
PRINT [_Shall I delete it? ]
PUSHJ P,GETSYL
PUSHJ P,CRR
POP P,LPTSW
CAMN SYM,[SIXBIT/NO/]
JRST MFDUP3
CAME SYM,[SIXBIT/YES/]
JRST MFDUP6
SKIPA B,BIF+UDNAMP
MFDUP7: ADDI B,LUNBLK
CAIL B,2000
JRST MFDUP3
.CALL [SETZ ? 'DELETE ? [SIXBIT/DSK/]
BIF+UNFN1(B) ? SETZ BIF+UNFN2(B)]
.LOSE 1400
JRST MFDUP7
SUBTTL UPDATE DISK DIRECTORY FROM TAPE (RELOAD)
DIRUPD: .SUSET [.SSNAM,,UFDBUF+UDNAME]
MOVEI A,.BII
HRLM A,FNO
.OPEN UFDCH,FNO
CAIA
JRST DIRU0
.SUSET [.RIOS+UFDCH,,A] ;DIR SEEMS NOT TO EXIST
LDB A,[220600,,A]
CAIE A,20 ;NO SUCH DIRECTORY ERROR CODE
.LOSE ;HMM, NEED HUMAN ASSISTANCE
SKIPE CRDIR
JRST DIRUCR
PUSH P,LPTSW
SETZM LPTSW
PRINT _DIRECTORY
PSIS UFDBUF+UDNAME
PRINT [ DOES NOT EXIST ON DISK, SHALL I CREATE IT? ]
PUSHJ P,TYI
MOVE D,A
PUSHJ P,CRR
POP P,LPTSW
CAIE D,"Y
POPJ P, ;NOT CREATING IT, GIVE UP
DIRUCR: .OPEN UFDCH,CRUFD
JFCL ;SHOULD GET FNF
JRST DIRUPD ;NOW TRY AGAIN
DIRU0: MOVE A,[-2000,,BIF] ;READ DISK COPY INTO COMPARE BUFFER
.IOT UFDCH,A
.CLOSE UFDCH,
MOVE B,BIF+UDNAMP
ADDI B,BIF ;B POINTS TO NAME AREA ON DISK COPY
MOVEI A,.BII+30 ;DON'T CHASE LINKS BIT, DON'T SET RDATE BIT.
HRLM A,TRNI ;DROPS THROUGH
;HERE WE LOOP OVER ALL FILES ON DISK ON THIS DIRECTORY. FOR EACH ONE,
;IF IT IS NOT ON THE TAPE THEN (UNLESS IT IS NEW) WE DELETE IT.
;IF IT IS ON THE TAPE, AND THE TAPE COPY IS NEWER, WE DELETE THE
;DISK FILE TO TRY AND AVOID GETTING DEVICE/DIRECTORY FULL WHEN WE
;TRY AND LOAD IT LATER ON. IF IT SEEMS TO BE THE SAME VERSION
;ON TAPE AND ON DISK, WE UPDATE THE MISCELLANEOUS ATTRIBUTES.
;NOTE THAT THIS LOOP APPLIES TO LINKS AS WELL AS FILES.
DIRUPL: CAIL B,BIF+2000
JRST DIRU5 ;PROCESSED WHOLE DIRECTORY
MOVE D,(B)
MOVE E,1(B)
MOVEM D,FN1
MOVEM E,FN2
MOVE A,UNDATE(B)
CAMLE A,UFDDAT ;DISK FILE NEWER THAN TAPE, LEAVE IT ALONE
JRST DIRUPN
HLLZ A,UNREF(B)
CAMLE A,UFDDAT ;OLD FILE, BUT RECENTLY REFERENCED,
JRST DIRU8 ; SO LEAVE IT ALONE
MOVE C,UFDBUF+UDNAMP
ADDI C,UFDBUF ;C POINTS TO NAME AREA ON TAPE COPY
DIRU1: CAIL C,UFDBUF+2000 ;FIND TAPE COPY IF IT EXISTS
JRST DIRU4
CAMN D,(C)
CAME E,1(C)
JRST DIRU2
SKIPL LDPACK ;DON'T MESS OVER NOW, IF WILL BE RELOADING
JRST DIRU8 ;TAPE COPY IN SORRY MODE ANYWAY.
MOVE A,UNDATE(B)
CAME A,UNDATE(C)
JRST DIRU4A ;SAME NAMES, DIFFERENT CREATION DATE, DELETE IT
JRST DIRU3
DIRU2: ADDI C,LUNBLK
JRST DIRU1
;FILE DOES NOT EXIST ON TAPE, OR WILL BE LOADED OVER.
;DELETE IT EITHER BECAUSE BEING FLUSHED OR TO MAKE ENOUGH ROOM
;ON DISK AND IN DIR TO ALLOW IT TO BE RELOADED.
DIRU4: SKIPN LSTWHL
JRST DIRU4A
PRINT [DELETE] ;MAKE LISTING LINE FOR FILE REALLY BEING
PSIS UFDBUF+UDNAME ;DELETED (I.E. NOT JUST BEING LOADED OVER)
PSIS FN1
PSIS FN2
PUSHJ P,CRR
DIRU4A: .FDELE TRNI ;DELETE IT FROM DISK
JFCL
JRST DIRU8
;SAME NAMES, SAME CREATION DATE. RESTORE OTHER CRUFT.
;WORKS EVEN FOR LINKS SINCE DON'T CHASE LINKS BITS IS SET
DIRU3: SETO E, ;FLAG NOT OPENED YET
HLLZ A,UNREF(B)
HLLZ D,UNREF(C)
CAME A,D
PUSHJ P,DIRURF ;UPDATE REF DATE
LDB A,[UNAUTH+UNREF(B)]
LDB D,[UNAUTH+UNREF(C)]
CAME A,D
PUSHJ P,DIRUAU ;UPDATE AUTHOR
LDB A,[430100,,UNRNDM(B)]
LDB D,[430100,,UNRNDM(C)]
CAME A,D
PUSHJ P,DIRUDB ;UPDATE REAPBIT
LDB A,[230100,,UNRNDM(B)]
LDB D,[230100,,UNRNDM(C)]
CAME A,D
PUSHJ P,DIRURB ;UPDATE REAP BIT
.CLOSE DSKIN,
DIRU8: ADDI B,LUNBLK
JRST DIRUPL
;FOUND FILE ON DISK NEWER THAN TAPE.
DIRUPN: LDB A,[UNPKN+UNRNDM(B)]
CAME A,LDPACK
JRST DIRU8 ;LEAVE IT
LDB A,[UNLNKB+UNRNDM(B)]
JUMPN A,DIRU8 ;LINK IS OK
JRST DIRU4 ;REALLY GONE, DELETE IT
;GET AUTHOR SIXBIT GIVEN MAGIC NUMBER IN DIRECTORY
GEAUTH: SKIPGE MFDDAT ;INDEX IN A, RETURN MFD ENTRY IN A
POPJ P, ;MFD NOT IN CORE, CAN'T LOOK IT UP
PUSH P,B
MOVE B,MDNUDS+MFDBUF
SUB A,B
LSH A,1
MOVE A,MFDBUF+2000(A)
POP P,B
AOS (P)
POPJ P,
;FILE NOT ALREADY OPEN, OPEN SO CAN UPDATE STUFF
DIROPF: OPEN DSKIN,TRNI
JRST POP1J
POPJ P,
POP1J: SUB P,[1,,1]
POPJ P,
;UPDATE DUMPCHECK BIT
DIRUDB: AOSN E
PUSHJ P,DIROPF
.CALL DIRSDB
JFCL
POPJ P,
DIRURB: AOSN E
PUSHJ P,DIROPF
.CALL DIRSRB
JFCL
POPJ P,
DIRURF: AOSN E
PUSHJ P,DIROPF
.CALL DIRSRF
JFCL
POPJ P,
DIRUAU: MOVE A,D
PUSHJ P,GEAUTH
POPJ P,
AOSN E
PUSHJ P,DIROPF
.CALL DIRSAU
JFCL
POPJ P,
DIRSAU: SETZ
SIXBIT /SAUTH/
1000,,DSKIN
SETZ A
DIRSDB: SETZ
SIXBIT /SDMPBT/
1000,,DSKIN
SETZ D
DIRSRB: SETZ
SIXBIT /SREAPB/
1000,,DSKIN
SETZ D
DIRSRF: SETZ
SIXBIT /SRDATE/
1000,,DSKIN
SETZ D
;SCAN ALL FILES IN TAPE UFD AND MAKE ANY REQUIRED LINKS.
;THE REASON THIS HAS TO BE DONE IS THAT LINKS ARE NOT
;PUT ON INCREMENTAL DUMPS.
;NOTE THAT IF ANY FILE WITH THE SAME NAME EXISTS, DON'T MAKE
; THE LINK SINCE THE FILE WAS LESS WORTHY IT WOULD
; HAVE BEEN DELETED AT DIRU4.
DIRU5: MOVE C,UFDBUF+UDNAMP ;SCAN NAME AREA OF TAPE DIRECTORY
CAIL C,2000
JRST DIRU7 ;EMPTY
ADDI C,UFDBUF
DIRU6: MOVE V,UNRNDM(C)
TLNE V,UNLINK
PUSHJ P,DIRMLK ;MAKE A LINK
ADDI C,LUNBLK
CAIGE C,UFDBUF+2000
JRST DIRU6
DIRU7: MOVEI A,.BII ;TURN OFF RANDOM BITS IN TRNI
HRLM A,TRNI
.CLOSE DSKOUT,
POPJ P, ;DIRUPD ALL DONE
DIRMLK: MOVE W,UNFN1(C)
MOVEM W,LNKBLK+1 ;FIRST NAME
MOVEM W,FN1
MOVE W,UNFN2(C)
MOVEM W,LNKBLK+2
MOVEM W,FN2
MOVEI A,30+.BII ;DON'T CHASE LINKS, DON'T SET REF DATE
HRLM A,TRNI
.OPEN DSKIN,TRNI ;SEE IF IT EXISTS (EVEN A LINK)
CAIA
POPJ P, ;YES, DON'T CLOBBER IT
LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX
PUSH P,B+1
IDIVI B,UFDBYT
ADDI B,UFDBUF+UDDESC
MOVNI N,-6(B+1)
IMULI N,6
HRLI N,60200 ;ASSUMING B=2 !!!
ROT N,30.
POP P,B+1
PUSHJ P,GETLSL
SKIPN W
SETOM W ;IN CASE OF ZERO SNAME (?)
MOVEM W,LNKBLK+5 ; SNAME
PUSHJ P,GETLSL
MOVEM W,LNKBLK+3 ; LINK FN1
PUSHJ P,GETLSL
MOVEM W,LNKBLK+4
;; POP P,B Good joke flushed by Alan 12/22/87
.OPEN DSKOUT,LNKBLK ;MAKE THE LINK
.LOSE 1400 ;HMM, NOT SUPPOSED TO HAVE TROUBLE
.CALL [SETZ ? 'SFDATE ? MOVEI DSKOUT ? SETZ UNDATE(C)]
JFCL
JRST RELOF2 ;UPDATE MISC ATTRIBUTES
SUBTTL PRINT TAPE HEADER
PTHEAD: PRINT TAPE NO
HLRZ A,THTPN
PDPT A
SKIPE A ;DON'T CONVERT IF TAPE NUMBER IS ZERO
MOVE C,[440600,,NSVTPN]
PUSHJ P,SIXNUM
PRINT CREATION DATE
PSIS THDATE
PUSHJ P,CRR
SKIPN THTYPE
POPJ P,
PRINT REEL NO
HRRZ B,THTPN
PDPT B
SKIPGE THTYPE
PRINT OF INCREMENTAL DUMP
SETZM NPLACE
PUSHJ P,SNPLAC
SKIPLE THTYPE
PRINT OF FULL DUMP
JRST CRR
SIXNUM: IDIVI A,12 ;CREATES SIXBIT FILE NAME FROM CONTENTS OF A
PUSH P,B ;C INITIALLY SHOULD CONTAIN 440600,,LOC
CAIE A,0
PUSHJ P,SIXNUM
POP P,A
ADDI A,20
IDPB A,C
POPJ P,
SUBTTL CHECKING OF DUMP TAPES, SETTING HAS-BEEN-DUMPED BITS
;ENTER HERE FROM END OF TAPE DURING AN INCREMENTAL DUMP
ICHECK: PUSHJ P,MAGOP
JRST ICKEOT
.SUSET [.SSNAM,,HSNM]
MOVE A,HSNM
CAMN A,LUSNM
JRST ICKEOT ;DON'T CHECK LAST USER (SO I DUMP CONTINUES ON NEXT TAPE WITH FULL USER)
MOVE A,HFN1
MOVEM A,FN1
MOVE A,HFN2
MOVEM A,FN2
MOVEI A,10+.BII ;DON'T SET RDATE BIT
HRLM A,TRNI
.OPEN DSKIN,TRNI
JRST ICK1
.CALL RDATE
JFCL
MOVE A,FDATE
CAME A,HDATE
JRST ICK1 ;BEEN CHANGED SINCE
MOVE A,[ICKLP,,D] ;RUN LOOP IN ACS IF NOT KL10
BLT A,D+ICKLPL-1
SETZ A,
BLT A,0
JUMPN A,ICK2 ;JUMP IF KL10
HRRI TER,D ;CLOSE LOOP
ICK2: MOVE A,[-2000,,BUF]
.IOT DSKIN,A
PUSH P,A
MOVE A,[-2000,,BIF]
PUSHJ P,MAGRDL
JRST ICKER2 ;ERROR
MOVE B,A
POP P,A
SUBI B,BIF-BUF
CAME A,B
JRST ICKERR
CAMN A,[-2000,,BUF]
JRST ICK4
PUSH P,A
HLLZ B,A
MOVE A,[-2000,,BUF]
SUB A,B
JRST (TER) ;TO CHECKING LOOP IN ACS OR CACHE
ICK3: POP P,A
SKIPL A
JRST ICK2 ;GET ANOTHER BLOCK
ICK4: MOVE A,[400000,,DSKIN]
.DMPCH A,
MOVE A,HSNM
CAME A,[SIXBIT /VANISH/]
JRST ICK1
.FDELE TRNI
JFCL
ICK1: .CLOSE DSKIN,
PUSHJ P,FILSKP
JRST ICHECK
ICKLP: MOVE B,(A) ;D
MOVE C,BIF-BUF(A) ;E
CAME B,C ;N
JRST ICKER1 ;SYM
AOBJN A,ICKLP ;TER (RH MODIFIED TO D IF PUT INTO ACS)
JRST ICK3 ;U
ICKLPL==.-ICKLP
ICKER1: POP P,A
ICKERR: JRST ICK1
ICKER2: POP P,A
.CLOSE DSKIN,
JRST ICHECK
ICKEOT: POPJ P,
;LCHECK COMMAND
ALCHEC: SETOM PNTALL
JRST ACHEK1
;ICHECK COMMAND
AICHEC: PUSHJ P,ICHECK
JRST RET
;CHECK COMMAND
ACHECK: CLEARM PNTALL
ACHEK1: SETOM SUPERC ;SUPPRESS DATA ERROR COMMENTS
CLEARM MICFLG
SETOM CHKFLG
.CORE CORSIZ+1
JRST .-1
PUSHJ P,DEVGET ;CRUDE FILE CHECKER
CLEARM ALLWRD ;RESET TOTAL NUMBER OF WORDS FOR THIS REEL
SKIPN MICFLG
MOVEI A,(SIXBIT /DSK/)
HRRM A,TRNI
ACHUCK: PUSHJ P,MAGOP ;OPEN NEXT TAPE FILE
JRST ACHIND ;END-OF-TAPE
.SUSET [.SSNAME,,HSNM]
MOVE A,HFN1
MOVEM A,FN1
MOVE A,HFN2
MOVEM A,FN2
CLEARM WRDCNT
CLEARM LNTCNT
CLEARM WRDONG
CLEARM ERRALL
CLEARM ERRCNT ;RESET # OF TAPE IOCS
CLEARM ERRDSK ;RESET # OF DISK IOCS
SKIPE LNKFLG
JRST ACHUF3
MOVEI A,10+.BII ;DON'T SET RDATE BIT
HRLM A,TRNI
.OPEN DSKIN,TRNI
JRST DSKOPL
SETOM NEWCHR
SKIPE MICFLG
JRST ACHUF1
MOVEI A,DSKIN
.DMPCH A,
MOVEM A,NEWCHR
ACHUF1: MOVE A,[-2000,,BUF]
.IOT DSKIN,A
HRLOI B,-BUF-1(A)
EQVI B,BUF ;AOBJN POINTER 1
SKIPGE A
.CLOSE DSKIN,
PUSH P,A
MOVE A,[-2000,,BIF]
PUSHJ P,MAGRDL
JRST ACHUF4
MOVE C,A
POP P,A
HRLOI D,-BIF-1(C)
EQVI D,BIF ;AOBJN POINTER 2
SKIPL A
SKIPGE C
PUSHJ P,FILSKP
PUSHJ P,COMPAR ;COMPARE THE TWO BUFFERS
HRRZI D,-BIF(C)
ADDM D,WRDCNT
SKIPL A
JUMPGE C,ACHUF1 ;MORE TO COME
JRST ACHUF2
;LOSSAGE
ACHUF2: SKIPN PNTALL
SKIPE ERRALL
SKIPA
JRST CHKT5
PUSHJ P,LOUSZ
CHKT6: PDPT WRDCNT
PRINT WORD
SOSE WRDCNT
PRINT S
SKIPN WRDCNT
PRINT
CHKT5: SKIPN WRDONG
JRST CHKT4
PDPT WRDONG
PRINT BAD WORD
SOSE WRDONG
PRINT S
SKIPN WRDONG
PRINT
PRINT AT
PDPT SAVAOB
.CLOSE DSKIN,
CHKT4: MOVE A,WRDCNT
ADDM A,ALLWRD
SKIPN V,LNTCNT
JRST CHKT7
MOVM W,V
PDPT W
SKIPL V
PRINT LONGER
SKIPG V
PRINT SHORTER
PRINT ON DISK
CHKT7: SKIPN ERRCNT
JRST CHKTA
PDPT ERRCNT
PRINT *TAPE IOC
SOSE ERRCNT
PRINT S
SKIPN ERRCNT
PRINT
PRINT *
CHKTA: SKIPN ERRDSK
JRST CHKTB
PDPT ERRDSK
PRINT *DISK IOC
SOSE ERRDSK
PRINT S
SKIPN ERRDSK
PRINT
PRINT *
CHKTB: SKIPN PNTALL
SKIPE ERRALL
PRINT !
JRST ACHUCK
ACHUF3: PUSHJ P,FILSKP
JRST ACHUF2
ACHUF4: POP P,A
JRST ACHUF2
LOUSZ: PUSHJ P,LOUSY
JFCL
SKIPE MICFLG
POPJ P,
SKIPN NEWCHR
PRINT NEW
SKIPE NEWCHR
PRINT
POPJ P,
DSKOPL: PUSHJ P,LOUSY
JFCL
PUSHJ P,OPINFL
SETOM ERRALL
PUSHJ P,CHKT3 ;FLUSH TAPE FILE
JRST CHKT6
CHKT3: PUSH P,A
MOVE A,[-2000,,BIF]
PUSHJ P,MAGRDL
JRST POPAJ
MOVE C,A
POP P,A
HRRZI D,-BIF(C)
ADDM D,WRDCNT
JUMPGE C,CHKT3
PUSHJ P,FILSKP
POPJ P,
ACHIND: .CORE CORSIZ
JRST .-1
.CLOSE DSKIN,
.CLOSE MAGIN,
PRINT _ REEL =
HRRZ A,THTPN
PDPT A
PRINT HAS
PDPT ALLWRD
PRINT WORDS__
POPJ P,
COMPAR: MOVE U,B
MOVE V,D
MOVE W,U
XOR W,V
TLNE W,-1
JRST DSKUNC
COMPA0: JUMPGE U,CPOPJ
JUMPGE V,CPOPJ
COMPA1: MOVE W,(U)
CAME W,(V)
JRST WRNWRD
COMPA2: AOBJN U,.+2
POPJ P,
AOBJN V,COMPA1
POPJ P,
WRNWRD: SKIPN WRDONG ;FIRST LOSSAGE ?
PUSHJ P,WRNWR1
AOS WRDONG
JRST COMPA2
WRNWR1: HRRZ W,U
SUBI W,BUF
ADD W,WRDCNT
MOVEM W,SAVAOB
POPJ P,
DSKUNC: HLRES U
HLRES V
SUB V,U
ADDM V,LNTCNT
SETOM ERRALL
MOVE U,B
MOVE V,D
JRST COMPA0
SUBTTL RESTORE REFERENCE DATES
;START NORMALLY, THEN ^Z AND START AGAIN HERE
;DON'T TRY TO USE THIS DUMP JOB FOR ANYTHING ELSE!
RLDRDT: PRINT RESTORE REFERENCE DATES FROM TAPE WHEN CURRENT RDATE IS -
PUSHJ P,GETDAT
HLLZS DATE
MOVEI A,%DONRF+%DONLK+.UAI
HRLM A,TRNI
RLDRD0: PUSHJ P,MAGOP ;OPEN TAPE
JRST MLP ;END OF TAPE
PUSHJ P,FILSKP ;ADVANCE TO NEXT FILE
JRST RLDRD0
;CALLED BY MAGOP IF DIRECTORY SEEN
RLDRD1: .SUSET [.SSNAME,,UFDBUF+UDNAME]
PUSHJ P,CRR
PSIS UFDBUF+UDNAME
SKIPA U,UFDBUF+UDNAMP
RLDRD2: ADDI U,LUNBLK
CAILE U,1777-4
POPJ P, ;END OF NAME AREA
MOVE A,UFDBUF+UNFN1(U)
MOVEM A,FN1
MOVE A,UFDBUF+UNFN2(U)
MOVEM A,FN2
OPEN DSKIN,TRNI ;OPEN DISK INPUT
JRST RLDRD2 ;FILE DOESN'T SEEM TO EXIST ANY MORE
.CALL RRDATE
.LOSE %LSFIL
HLLZ A,RFDATE
CAME A,DATE
JRST RLDRD3
.CALL [ SETZ ? 'SRDATE ? MOVEI DSKIN ? SETZ UFDBUF+UNREF(U)]
.LOSE %LSFIL
RLDRD3: .CLOSE DSKIN,
JRST RLDRD2
SUBTTL LOCAL TO REMOTE TAPE COPY
;START NORMALLY, GIVE REMOTE COMMAND, THEN ^Z AND START AGAIN HERE
TCOPY: MOVE A,TAPTYP
AOJL A,.+2
DIE You must use the REMOTE command to specify tape server host first
PRINT _Mount input tape on local drive and blank output tape on remote drive.
SETZM DMPMOD
SETOM TCOPYF
SETOM OTAPE ;Start of output tape
TCOPY0: PRINT [_Type OK when ready. ]
PUSHJ P,GETSYL
JRST .-1
TCOPY1: SETOM ITAPE ;Start of input tape
PUSHJ P,RMTSTS ;Make sure it's mounted (this also
TRNN A,TF%RDY ; drains queued status)
DIE OUTPUT TAPE NOT MOUNTED
PUSHJ P,SETIT4 ;Get status of local drive
TRNE A,TF%BOT
JRST TCOPY3
PRINT [_Rewind input tape? ]
PUSHJ P,YESNO
JRST TCOPY3
MOVEI A,1
PUSHJ P,LCLOPR
TCOPY3: PUSHJ P,DFHBLK ; Set defaults in HBLK
;; Start copying a file
SETOM EOFF
OPEN MAGIN,MAGI
JRST NAUGHT
TCOPY4: SETZM RDERR
SETZM PHYEOT
MOVE C,[-2000,,BUF] ;Copy next block of file
.IOT MAGIN,C
SKIPE RDERR
JRST TCOPY9 ;File cannot be read
PUSH P,C ;Save post-input aobjn pointer
MOVEI B,BUF ;Pointer to next header input
HRLOI A,-BUF-1(C)
EQVI A,BUF ;Aobjn pointer for output
AOSE EOFF ;See if first record in file
JRST TCOPY6 ;No, this is the middle of a file
CAMN C,[-2000,,BUF]
JRST TCOPY7 ;Logical end of tape
AOSE ITAPE ;See if first file on tape
JRST TCOPY5
MOVE D,(B) ;First word on tape
TRNN D,-1 ;Skip if bad header
CAMGE D,[-LTHBLK,,] ;Skip if good header
JRST TCOPY5
MOVSI C,1(B) ;Save tape header
HRRI C,THBLK+1
BLT C,THBLK+LTHBLK-1
HLRO C,D
MOVN C,C ;Number of words in tape header
ADDI B,(C) ;Advance over tape header
HRL C,C
AOSE OTAPE ;See if first file on output tape
ADD A,C ;No, skip over tape header on output
TCOPY5: MOVE D,(B) ;File header
TRNN D,-1 ;Skip if bad header
CAMGE D,[-LHBLK,,] ;Skip if good header
JRST TCOPY6
CAMLE D,[-LHBLKZ,,] ;Skip if good header
JRST TCOPY6
MOVSI B,1(B) ;Save file header for error messages
HRRI B,HBLK+1
BLT B,HBLK+LHBLK-1
TCOPY6: JUMPGE A,TCOP6A ;Jump if empty record
PUSHJ P,MAGWRI
AOS OTAPE ;Something has been written
TCOP6A: POP P,C ;Recover post-input aobjn pointer
JUMPGE C,TCOPY4 ;Jump unless EOF
PUSHJ P,AEOF ;Write EOF mark on tape
JRST TCOPY3 ;Copy next file
;Physical end of tape reached
TCOP7A: AOSE EOFF ;See if first record in file
PUSHJ P,AEOF ;No, close off that partial file
TCOPY7: PRINT _End of tape._
MOVEI A,2 ;Rewind and unload the input tape
PUSHJ P,LCLOPR
PRINT [Copy another tape onto same output tape? ]
PUSHJ P,YESNO
JRST TCOPY8
PRINT _Mount next input tape on local drive.
JRST TCOPY0
TCOPY8: PUSHJ P,CLSOUT ;Write logical EOT
PUSHJ P,AUNLD ;Then unload the output tape
JRST TCOPY
;File cannot be read -- system won't let us see the bad data either
TCOPY9: SKIPE PHYEOT
JRST TCOP7A
AOSE EOFF ;See if first record in file
JRST TCOP9A ;No
AOS ITAPE ;For file header that could not be read
AOSE OTAPE ;See if first file on output tape
JRST TCOPY3 ;No, don't copy this file at all
SETZM THTPN ;Write dummy header since real header
SETZM THDATE ;could not be read
SETZM THTYPE
MOVE A,[-LTHBLK,,THBLK]
PUSHJ P,MAGWRI
JRST TCOPY3 ;Don't copy file, just tape header
TCOP9A: SETZM BUF ;Substitute one block of nulls for rest of file
MOVE A,[BUF,,BUF+1]
BLT A,BUF+1777
MOVE A,[-2000,,BUF]
PUSHJ P,MAGWRI
PUSHJ P,AEOF ;Write EOF mark on tape
JRST TCOPY3 ;Copy next file
;Skip if YES
PRINT [ Please type YES or NO: ]
YESNO: PUSHJ P,GETSYL
JRST YESNO-1
CAMN SYM,[SIXBIT/YES/]
AOSA (P)
CAMN SYM,[SIXBIT/NO/]
POPJ P,
JRST YESNO-1
SUBTTL REMOTE TAPE SUPPORT
$$CHAOS==1
$$HOSTNM==1
$$SYMLOOK==1
$$HSTMAP==1
$$CONNECT==1
.INSRT SYSNET;NETWRK >
NETWRK"DEBUG: 0 ;NETWRK wants this for some reason
.BEGIN RTAPE ;Remote Tape Package
comment \ --- stuff remaining to do
Problems convincing old server to disconnect from drive sometimes.
Attempts to create new server say drive is still busy (using HT).
Unix (Hermes) appears to have a wonderful bug where if you write
a tape, rewind it, read a bunch, and then lose the network connection,
it writes two eof marks wherever the tape happened to be positioned.
Thanks a lot.
Hermes drive tries really hard to screw you by setting the density
to 6250, even though I tell it in the mount command to use 1600.
When you mount the tape the drive's 1600 light is lit, but then
when you walk away it switches to 6250. Try making sure the
"sys sel" light is not on.
VMS (Pygmalion) doesn't allow writing short records and also gives
an error status at logical end of tape.
CORE DUMP MODE IN ITS SERVER DUE TO BLOCK SIZE PROBLEMS ??
DUMP never seems to want to call CLOSE
Should fix ILDB/IDPB loop in SIOKT to use KLH unaligned byte move
which I think can be found in SYSENG;FSCOPY
Perhaps this can be finessed by knowing what the alignment of the
system's buffers probably is and aligning my own buffer correspondingly.
Or just do my own packetizing, this will never run over TCP
The old code certainly spent essentially all its time at SIOKS3
So I put in my own packetizing for output and the speed is slow but
no longer pitifull. I fixed my byte copying routine, the next
culprit is data reformatting in the Chaosnet interrupt routines.
WRTFM should not need to force a packet out to the network,
but that's how my modularity is right now.
\
DEFINE PUSHAE AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN
DEFINE POPAE AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN
DEFINE PRTERR REASON
DIE [Remote-Tape protocol error--REASON]
TERMIN
;Remote Tape Protocol Definitions
;User to Server Opcodes
RT%LGI==1 ;Login username password
RT%MNT==2 ;Mount direction reelid drive blocksize density norewind
RT%PRB==3 ;Probe uid (2 bytes)
RT%RD==4 ;Read n-records (ascii decimal); no arg means read continuous
RT%WRT==5 ;Record
RT%RWD==6 ;Rewind
RT%SYN==7 ;Rewind-sync
RT%UNL==8 ;Rewind-unload
RT%SPF==9 ;Space-file n-files (ascii decimal)
RT%SPR==10. ;Space-record n-records (ascii decimal)
RT%WFM==12. ;Write-file-mark
RT%CLS==13. ;Close
;Server to User Opcodes
RT%LGR==33. ;Login-response code message-string
RT%DTA==34. ;Read-data
RT%RFM==35. ;Read-file-mark
RT%STS==36. ;Status
;Storage for decoded status, second word of each is byte length
STSVER: 1 ? 1 ;Protocol version number
STSUID: 0 ? 2 ;Probe unique ID, 0 if unsolicited
STSNRD: 0 ? 3 ;Number of records read
STSNSK: 0 ? 3 ;Number of objects skipped (?)
STSNWD: 0 ? 3 ;Number of writes discarded
STSLOP: 0 ? 1 ;Last non-probe opcode received
STSDEN: 0 ? 2 ;Density in bits per inch
STSRTR: 0 ? 2 ;Retries (?)
STSDRV: BLOCK 4 ;Asciz drive name
STSFLG: 0 ;Word of flag bits
F%SOL==1 ;Solicited flag
F%BOT==2 ;Beginning of tape
F%EOT==4 ;Past end of tape
F%EOF==10 ;EOF encountered in read
F%NLI==20 ;Not logged in error
F%MNT==40 ;Mounted
F%STRG==100 ;Explanatory string follows status
F%HER==200 ;Hard error encountered
F%SER==400 ;Soft error encountered
F%OFFL==1000 ;Offline
F%NREC==2000 ;Non-record-oriented device
STATUS: BLOCK 20 ;Most recent explanatory string, asciz
UIDG: 0 ;Unique ID generator
RDAHD: 0 ;0 idle, 1 reading, -1 stopped with exception,
; -2 stopped at file mark
MXRECW==2000 ;Maximum record length in words
MXRECB==MXRECW*5 ;Maximum record length in bytes
BUFFER: BLOCK <MXRECB+19.+3>/4 ;Can hold biggest record (32-bit words)
BUFCNT: 0 ;Number of 32-bit words sitting in buffer
BUFPNT: 0 ;Number of words already taken out
RESBUF: BLOCK 4 ;Residue of record (36-bit words)
RESBFC: 0 ;Number of 36-bit words in RESBUF
RESBFP: 0 ;Number of words already taken out
MXSTSB==200
STSBUF: BLOCK MXSTSB/4 ;Buffer for status records
;Probe for status of remote drive
;Clobbers all registers, returns flags in D
PROBE: PUSHJ P,SPROBE ;Send probe command
PROBE7: PUSHJ P,LISTEN ;Read a response, waiting if necessary
PUSHJ P,PROBE0
MOVE T,UIDG ;Verify that it isn't stale
CAME T,STSUID
JRST PROBE7 ;Try again
POPJ P, ;OK
SPROBE: AOS D,UIDG ;Get a unique ID
DPB D,[341000,,STSBUF] ;Send it LSB first
LSH D,-8
DPB D,[241000,,STSBUF]
MOVEI A,RT%PRB
MOVE B,[440800,,STSBUF]
MOVEI C,2
JRST RSXMTF
;Listen for status, read it and skip return if there is any
LISTEN: .CALL [ SETZ ? 'WHYINT ? MOVEI RSICH ? MOVEM T ? MOVEM T ? SETZM T ]
.LOSE %LSFIL
TLNN T,-1 ;Network input available?
POPJ P, ;No, exit
MOVE B,[440800,,STSBUF]
MOVEI C,MXSTSB
PUSHJ P,RSRCV ;Yes, read it into status buffer
CAIE A,RT%STS
JRST LISTEN ;Ignore any input other than Status
AOS (P) ;Skip return
JRST PROBE1
;Read a status record
PROBE0: MOVE B,[440800,,STSBUF]
MOVEI C,MXSTSB
PUSHJ P,RSRCV ;Should be status, response or unsolicited
CAIE A,RT%STS
JRST PROBE0 ;Something else, discard it
;Process a status record already received
PROBE1: MOVEI A,STSVER ;Read status into here
PROBE2: MOVE T,1(A) ;Number of bytes in this field
SETZB D,(A) ;Accumulate field here, least significant first
PROBE3: ILDB TT,B
LSH TT,(D)
ADDI D,8
IORM TT,(A)
SOJG T,PROBE3
ADDI A,2
CAIE A,STSDRV
JRST PROBE2
ILDB T,B ;Number of valid characters in drive name
MOVEI D,16. ;Number of allocated characters in drive name
HRLI A,440700
PROBE4: ILDB TT,B
SOSGE T
MOVEI A,0
IDPB TT,A
SOJG D,PROBE4
IDPB D,A ;Ensure asciz termination
ILDB D,B ;First byte of flags
ILDB T,B ;Second byte of flags
LSH T,8
IOR D,TT ;Leave flags in D for caller
MOVEM D,STSFLG
SUBI C,36. ;Number of bytes of status
SKIPGE C
PRTERR status record too short
TRNN D,F%STRG ;Explanatory string follows?
JRST PROBE6
MOVE A,[440700,,STATUS] ;Yes, swallow it
PROBE5: ILDB T,B
PROB5A: CAME A,[100700,,STATUS+20]
IDPB T,A
CAIN T,215
JRST [ MOVEI T,12 ? JRST PROB5A ]
SOJG C,PROBE5
IDPB C,A
IFN 0,[ ;temporary code not needed any more I think
PUSH P,LPTSW
SETZM LPTSW
PRINT _REMOTE TAPE STATUS=
PASC STATUS
PRINT _
POP P,LPTSW
];IFN 0
PROBE6: MOVE A,STSVER
CAIE A,1
PRTERR wrong protocol version number
POPJ P, ;Done reading status, flags in D
;Print remote tape status most recently read
PRSTS: PUSH P,A
PRINT Remote tape status=
PASC STATUS
SKIPE STATUS
PUSHJ P,CRR
MOVE A,STSFLG
TRNE A,F%BOT
PRINT [BOT ]
TRNE A,F%EOT
PRINT [EOT ]
TRNE A,F%EOF
PRINT [EOF ]
TRNE A,F%NLI
PRINT [Not-logged-in ]
TRNN A,F%MNT
PRINT [Not-mounted ]
TRNE A,F%HER
PRINT [Hard-error ]
TRNE A,F%SER
PRINT [Soft-error ]
TRNE A,F%OFFL
PRINT [Offline ]
POP P,A
POPJ P,
;Random tape operations, none wait for completion
UNLOAD: SKIPA A,[RT%UNL]
REWIND: MOVEI A,RT%RWD
RSXMT0: MOVEI C,0
MOVE B,[440800,,BUFFER] ;SIOT checks bp even though count is 0
JRST RSXMTF
CLOSE: SKIPA A,[RT%CLS]
WRTFM: MOVEI A,RT%WFM ;write file mark
PUSHJ P,FORCE ;first force buffered output
JRST RSXMT0
SKPREC: SKIPA A,[RT%SPR] ;B has signed number of records/files to skip
SKPFL0: MOVEI A,RT%SPF
MOVE T,B
MOVE B,[440800,,BUFFER]
MOVEI C,0
PUSHJ P,CMDN0
MOVE B,[440800,,BUFFER]
PUSHJ P,RSXMTF
POPJ P,
CMDN0: JUMPGE T,CMDN1
MOVNS T
MOVEI TT,"-
IDPB TT,B
ADDI C,1
CMDN1: IDIVI T,10.
PUSH P,TT
SKIPE T
PUSHJ P,CMDN1
POP P,TT
ADDI TT,"0
IDPB TT,B
AOJA C,CPOPJ
;wait for completion of pending I/O
;skip return unless tape error
FINISH: PUSHAE P,[A,B,C,D,E]
PUSHJ P,PROBE ;By the time this answers, should be done
TRNN D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error?
AOS -5(P) ;No, take skip return
POPAE P,[E,D,C,B,A]
POPJ P,
;Read data in core-dump mode into buffer addressed by aobjn pointer in A
;A is advanced
;Skip return unless tape error
;File mark signalled by not fully counting-out A
;Record boundaries are invisible at this level
READ: PUSHAE P,[B,C,D,E,T,TT]
READ0: SKIPN RESBFC ;Collect residue if any is present
JRST READ1
AOS B,RESBFP
MOVE T,RESBUF-1(B)
MOVEM T,(A)
CAML B,RESBFC
SETZM RESBFC ;Residue exhausted
AOBJN A,READ0
JRST READ8 ;No more data required
READ1: SKIPN C,BUFCNT ;Have a buffered record?
JRST READ6 ;No, get one
SUB C,BUFPNT ;Number of words not yet read
IDIVI C,5 ;Number of 4-word blocks available
MOVE B,BUFPNT
HLRE T,A
MOVN T,T
LSH T,-2 ;Number of complete 4-word blocks wanted
CAMLE C,T
MOVE C,T ;Number of 4-word blocks to do
JUMPE C,READ2 ;Jump if no bulk conversion possible
PUSHJ P,RDCNV ;Copy data, advance A and B
JUMPGE A,READ8 ;Destination buffer exhausted
JRST READ1 ;Get more data
READ2: PUSH P,A ;Fill residue buffer
MOVEI A,RESBUF
SETZM RESBFP
MOVE C,BUFCNT
SUB C,BUFPNT
LSH C,2 ;Number of bytes available
IDIVI C,5 ;Convert to words
CAILE C,4 ;At most 4 words residue
MOVEI C,4
MOVEM C,RESBFC
MOVEI C,1 ;Translate one 4-word block
PUSHJ P,RDCNV
POP P,A
JRST READ0 ;Collect residue
READ6: SKIPGE T,RDAHD ;Read-ahead stopped due to exception?
JRST [ AOJL T,READ8 ;EOF simply terminates the data
JRST READ9 ] ;Anything else takes failure return
PUSH P,A
JUMPG T,READ7 ;Jump if read-ahead already in progress
MOVEI A,RT%RD ;Initiate read-ahead
PUSHJ P,RSXMT0
AOS RDAHD
READ7: SETZM BUFPNT
PUSHJ P,RSRCVB ;Receive next record from server
MOVE T,A ;Opcode of record received
POP P,A ;Recover aobjn pointer
CAIN T,RT%DTA
JRST [ ADDI C,3
LSH C,-2 ;Number of words, rounded up
MOVEM C,BUFCNT ;Buffer now contains data
JRST READ1 ]
CAIN T,RT%STS
JRST [ SETZM RDAHD ;Read-ahead has terminated
PUSH P,A
PUSHJ P,PROBE1 ;Swallow the status record B points to
POP P,A
TRNE D,F%NLI+F%HER+F%OFFL ;Serious error?
SETOM RDAHD ;Yes, note exception has occurred
JRST READ6 ] ;Consider current status again
CAIE T,RT%RFM
PRTERR [record type other than data, read-file-mark, or status]
SETCMM RDAHD ;Filemark read, set RDAHD to -2
READ8: AOS -6(P) ;Success return
READ9: POPAE P,[TT,T,E,D,C,B]
POPJ P,
;Translate from 32-bit words to 36-bit words
;A - destination aobjn pointer
;B - source index in BUFFER
;C - number of 4-word blocks
;Arguments get advanced, T,TT are clobbered
RDCNV: DMOVE T,BUFFER(B) ;First two 32-bit words
LSH T,-4 ;Right-align first four bytes
LSH TT,4 ;Flush 4 bits out of fifth byte
LSHC T,4 ;First 36-bit word
MOVEM T,(A)
LSH TT,-12. ;Right-align bytes 6-8
MOVE T,BUFFER+2(B) ;Third 32-bit word
ROTC T,8 ;TT has bytes 6-9 right-aligned
LSH T,4 ;Flush 4 bits out of 10th byte
ROTC T,4 ;Second 36-bit word in TT
MOVEM TT,1(A)
ROT T,16. ;Right align bytes 11-12
MOVE TT,BUFFER+3(B) ;Fourth 32-bit word
LSHC T,16. ;T has bytes 11-14 right aligned
LSH TT,4 ;Flush 4 bits out of 15th byte
ROTC T,4 ;Third 36-bit word in T
MOVEM T,2(A)
LSHC T,8 ;Right align byte 16
MOVE TT,BUFFER+4(B) ;Bytes 17-20
ROTC T,-12. ;Right align bytes 17-19 in TT
LSH T,4 ;Flush 4 bits out of 20th byte
ROTC T,4 ;Fourth 36-bit word in TT
MOVEM TT,3(A)
ADD A,[4,,4]
ADDI B,5
SOJG C,RDCNV
MOVEM B,BUFPNT
CAML B,BUFCNT
SETZM BUFCNT ;Source buffer exhausted
POPJ P,
;Terminate read-ahead
;--- Doesn't try to count records/files read ahead
;--- Unclear who is supposed to call this in that case
STOP: SKIPLE RDAHD
PUSHJ P,PROBE ;This should stop it
SETZM RDAHD
POPJ P,
;Skip rest of file, interacting properly with read-ahead
SKPFIL: PUSHAE P,[A,B,C,D,T,TT]
SKIPGE B,RDAHD
AOJL B,SKPFL9 ;Pass by file mark already read
JUMPLE B,SKPFL8 ;Send space-file command to drive
;Readahead in progress. Server may have already read up to file mark,
;but not past it. Send a probe so server shuts down, then swallow
;remaining readahead.
PUSHJ P,RDSTOP
JRST SKPFL9 ;File-mark seen
SKPFL8: MOVEI B,1 ;Space one file
PUSHJ P,SKPFL0 ;File mark not seen in readahead, so space-file
SKPFL9: SETZM RDAHD ;No matter what path we take, read-ahead is off
POPAE P,[TT,T,D,C,B,A]
POPJ P,
RDRST: PUSHAE P,[A,B,C,D,T,TT]
SKIPLE RDAHD
PUSHJ P,RDSTOP
SETZM RDAHD
PUSHJ P,BUFRST
JRST SKPFL9
;Reset buffers
BUFRST: SETZM BUFCNT
SETZM RESBFC
POPJ P,
;Send a probe so server shuts down, then swallow remaining readahead.
;Skip return unless file mark seen during swallowed readahead.
RDSTOP: PUSHJ P,SPROBE ;Tell server to stop
PUSHJ P,BUFRST ;Flush partially read input record
PUSH P,[0] ;Initialize file-mark-seen flag
RDSTP1: PUSHJ P,RSRCVB ;Receive next record from server
CAIN A,RT%DTA
JRST RDSTP1 ;Ignore data records
CAIN A,RT%RFM
JRST [ SETOM (P) ;File mark seen
JRST RDSTP1 ]
CAIE A,RT%STS
PRTERR [record type other than data, read-file-mark, or status]
PUSHJ P,PROBE1 ;Swallow status record
MOVE T,UIDG ;Verify that it isn't stale
CAME T,STSUID
JRST RDSTP1 ;Another status should be incoming
SKIPN (P)
AOS -1(P) ;No file-mark seen
SETZM RDAHD ;Read-ahead has been terminated
JRST POP1J
;WRITE -- write core-dump mode data, AOBJN pointer in A
;Record boundaries are invisible at this level
;Aobjn pointer in A is advanced
;Clobbers no registers
;Abnormal exit: tape error jumps to RMTWER
WRITE: PUSHAE P,[B,C,D,E,T,TT]
SKIPN C,RESBFC ;If there is residue, append to it
JRST WRITE2
WRITE1: MOVE T,(A) ;Copy into RESBUF until it is full or
MOVEM T,RESBUF(C) ; aobjn pointer counts out
AOS C,RESBFC
CAIGE C,4
AOBJN A,WRITE1
JUMPGE A,WRITE9 ;Did not fill up residue buffer
AOBJN A,.+1 ;Filled residue buffer, adjust aobjn pointer
PUSH P,A
MOVEI A,RESBUF ;Send off the residue
MOVEI C,1
PUSHJ P,WRICNV
SETZM RESBFC
CAIL B,MXRECB/4 ;If buffer is now full,
PUSHJ P,FORCE1 ; send off that record
POP P,A ;Recover aobjn pointer
WRITE2: HLRE C,A ;Minus count of words remaining
MOVN C,C ;Positive count
TRZ C,3 ;Round down to multiple of 4 words
JUMPE C,WRITE7 ;Jump if only a residue remains
MOVE T,BUFCNT
IDIVI T,5 ;Number of 4-word blocks already in buffer
LSH T,2
ADD T,C
CAILE T,MXRECW
SUBI C,-MXRECW(T) ;Whole transfer cannot be accomodated
HRL C,C ;Number of words to do in both halves
PUSH P,A ;Save and advance aobjn pointer
ADDM C,(P)
HRRZ C,C ;Compute number of 4-word blocks to do
LSH C,-2
PUSHJ P,WRICNV ;Convert that much
CAIL B,MXRECB/4 ;If buffer is now full,
PUSHJ P,FORCE1 ; send off that record
POP P,A ;Recover aobjn pointer
JUMPL A,WRITE2 ;Jump if there is more to do
WRITE7: JUMPGE A,WRITE9 ;Not even a residue remains
WRITE8: MOVE T,(A) ;Copy residue into buffer
MOVEM T,RESBUF(C)
AOS C,RESBFC
AOBJN A,WRITE8
WRITE9: POPAE P,[TT,T,E,D,C,B]
POPJ P,
;FORCE -- force buffered output, if any, as a short record
;Clobbers no registers
;Abnormal exit: tape error jumps to RMTWER
FORCE: PUSHAE P,[A,B,C,D,E,T,TT]
SKIPN BUFCNT
SKIPE RESBFC
PUSHJ P,FORCE1
POPAE P,[TT,T,E,D,C,B,A]
POPJ P,
FORCE1: PUSHJ P,LISTEN ;Any status incoming?
JRST FORCE2 ;No
TRNE D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error?
JRST RMTWER ;Yes, exit
FORCE2: MOVE C,BUFCNT
LSH C,2 ;Convert word count to byte count
SKIPN E,RESBFC
JRST FORCE3 ;Jump if no residue
PUSH P,C
MOVE A,[.BYTE 7 ? 3 ? 3 ? 3 ? 3 ? 3]
CAIGE E,2 ;Pad residue with ^Cs
MOVEM A,RESBUF+1
CAIGE E,3
MOVEM A,RESBUF+2
CAIGE E,4
MOVEM A,RESBUF+3
MOVEI A,RESBUF ;Include the residue
MOVEI C,1
PUSHJ P,WRICNV
POP P,C ;Residue doesn't count as 4 full words
IMULI E,5 ;5 bytes for each word of residue
ADD C,E
SETZM RESBFC
FORCE3: MOVEI A,RT%WRT
MOVE B,[440800,,BUFFER]
;If the tape server on PYG (VMS) worked, you would need
;this in order to be able to use it
IFN 0,[
CAIGE C,16 ;God damn bag chomping VMS barfs if record
MOVEI C,16 ; is shorter than this
];IFN 0
PUSHJ P,RSXMT ;Send off this record
SETZM BUFCNT
POPJ P,
;Convert from 36-bit form to 32-bit form
;A - address of 36-bit data
;C - number of 4-word blocks to do
;Returns new value of BUFCNT in C
;Bashes A,B,C,D,T,TT
WRICNV: MOVE B,BUFCNT ;Append 32-bit words to buffer
WRICN1: DMOVE T,(A) ;First two 36-bit words
MOVEM T,BUFFER(B) ;First 4 bytes
ROTC T,-8 ;5th byte to high end of TT
TLZ TT,600000 ;Book says these bits are zero
MOVEM TT,BUFFER+1(B) ;Second four bytes
EXCH T,TT
LSHC T,4 ;9th byte to low end of T
LSH TT,-4 ;10th byte to high end of TT
MOVE D,T ;Copy bits 30-31 of second 36-bit word
ANDI D,3
ROT D,-4
IOR TT,D
LSHC T,8 ;9th and 10 bytes in T
MOVE TT,2(A) ;Third 36-bit word
LSHC T,20. ;9th-12th bytes left-aligned in T
MOVEM T,BUFFER+2(B)
LSHC T,12. ;13th, 14th bytes to low end of T
LSH TT,-4 ;15th byte to high end of TT
MOVE D,T ;Copy bits 30-31 of third 36-bit word
ANDI D,3
ROT D,-4
IOR TT,D
LSHC T,8 ;13th-15th bytes in T
MOVE TT,3(A) ;Fourth 36-bit word
LSHC T,12. ;13th-16th bytes left-aligned in T
MOVEM T,BUFFER+3(B)
LSHC T,20. ;17th-19th bytes to low end of T
LSH TT,-4 ;20th byte to high end of TT
MOVE D,T ;Copy bits 30-31 of fourth 36-bit word
ANDI D,3
ROT D,-4
IOR TT,D
LSHC T,12. ;17th-20th bytes left-aligned in T
MOVEM T,BUFFER+4(B)
ADDI A,4 ;Advance to next block of words
ADDI B,5
SOJG C,WRICN1
MOVEM B,BUFCNT
POPJ P,
;Open remote tape connection and mount tape
;A - asciz host name (0 to listen)
;B - address at which to map host table
;C - remote drive name in asciz
;D - direction in asciz (READ, WRITE, or BOTH)
;reel name assumed not to matter, I'll always use "ITS" as the reel ID
;Skip return if successful, otherwise tape is not mounted and status
;buffer contains the details. OZ sets F%HER but HT just returns a string.
OPEN: PUSH P,C
PUSH P,D
SETZM STSFLG
SETZM STATUS
MOVEI C,[ASCIZ/RTAPE/]
PUSHJ P,RSOPEN
JRST OPEN7 ;Failed
OPEN1: MOVE B,[440800,,BUFFER] ;Build mount command
MOVNI C,1 ;Remove final space by starting with -1
MOVE A,(P) ;Direction
PUSHJ P,SOUT
MOVEI A,[ASCIZ/ITS/] ;Reel
PUSHJ P,SOUT
MOVE A,-1(P) ;Drive
PUSHJ P,SOUT
MOVEI A,RECLEN ;Maximum record length (decimal)
PUSHJ P,SOUT
MOVEI A,[ASCIZ/1600/] ;Density
PUSHJ P,SOUT
MOVEI A,[ASCIZ/NOREWIND/] ;Don't be gratuitous
PUSHJ P,SOUT
MOVEI A,RT%MNT ;Send mount command
MOVE B,[440800,,BUFFER]
PUSHJ P,RSXMTF
PUSHJ P,PROBE ;Did it work?
TRNE D,F%MNT
JRST POP2J1 ;Yes
TRNE D,F%NLI
JRST [ PUSHJ P,RMTLGN ;Login please
JRST OPEN1 ] ;And try again
JRST POP2J ;Failed
OPEN7: MOVSI B,-17 ;Copy reason for failure into STATUS string
OPEN8: MOVE T,(A)
ADDI A,1
MOVEM T,STATUS(B)
TRNE T,177_1
AOBJN B,OPEN8
JRST POP2J
DEFINE FOO A
ASCIZ/A/
TERMIN
RADIX 10.
RECLEN: FOO \MXRECB
RADIX 8
EXPUNGE FOO
;A - ASCIZ user name
;B - ASCIZ password
;Skip return if success, otherwise STATUS has the string
LOGIN: PUSHAE P,[A,B,C]
MOVE B,[440800,,BUFFER] ;Build login command
MOVNI C,1 ;Remove final space by starting with -1
MOVE A,-2(P) ;User name
PUSHJ P,SOUT
MOVE A,-1(P) ;Password
SKIPE (A)
PUSHJ P,SOUT
MOVEI A,RT%LGI ;Send login command
MOVE B,[440800,,BUFFER]
PUSHJ P,RSXMTF
MOVE B,[440800,,STATUS] ;Receive response
MOVEI C,100
PUSHJ P,RSRCV
CAIE A,RT%LGR
PRTERR wrong record type in response to login
JUMPE C,LOGIN9 ;Success return if count is zero
MOVE A,[440700,,STATUS] ;Convert 8 bit to asciz
LOGIN2: ILDB T,B
IDPB T,A
SOJG C,LOGIN2
IDPB C,A
SOS -3(P)
LOGIN9: AOS -3(P)
POPAE P,[C,B,A]
POPJ P,
POP2J1: AOS -2(P)
POP2J: SUB P,[2,,2]
CPOPJ: POPJ P,
SOUT: TLNN A,-1
HRLI A,440700
SOUT1: ILDB T,A
JUMPE T,SOUT2
IDPB T,B
AOJA C,SOUT1
SOUT2: MOVEI T,40
IDPB T,B
AOJA C,CPOPJ
;Record-Stream support
;Open a record stream to a Chaosnet host, and initialize it
;RSICH, RSOCH - input and output channels
;A - asciz host name (0 to listen)
;B - address at which to map host table
;C - asciz contact name
;Clobbers all ACs
;If successful, skip return
;If failure, A has asciz failure reason
RSOPEN: PUSH P,C
JUMPE A,RSOPN1
PUSH P,A
LDB A,[121000,,B] ;Page number
MOVEI B,RSICH
PUSHJ P,NETWRK"HSTMAP ;--- Someday use DQ device instead?
JRST [ MOVEI A,[ASCIZ/Cannot map network host table/]
JRST POP2J ]
POP P,A ;Host name
PUSHJ P,NETWRK"HSTLOOK
JRST [ MOVEI A,[ASCIZ/Host not found in host table/]
JRST POP1J ]
PUSHJ P,NETWRK"HSTUNMAP
JFCL
RSOPN1: POP P,C ;Contact name
MOVEI D,15. ;Window size
MOVE B,A ;Host number or 0
MOVEI A,RSICH ;Channel pair
JUMPE B,RSOPN2 ;Jump if listen
PUSHJ P,NETWRK"CHACON
JRST [ MOVEI A,[ASCIZ/Cannot connect to remote tape server/]
POPJ P, ]
JRST RSOPN3
RSOPN2: PUSHJ P,NETWRK"CHALSN
.LOGOUT 1, ;Nobody home
RSOPN3: MOVE T,[440700,,[ASCII/RECORD STREAM VERSION 1/]]
MOVEI TT,.LENGTH/RECORD STREAM VERSION 1/
.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? T ? SETZ TT ]
.LOSE %LSFIL
.IOT RSOCH,[215]
.NETS RSOCH,
MOVE A,[440700,,[ASCII/RECORD STREAM VERSION 1/]]
MOVEI B,.LENGTH/RECORD STREAM VERSION 1/
SETZM PKTRBC
RSINI1: PUSHJ P,RSRBTI
ILDB TT,A
SKIPN TT
MOVEI TT,215
CAME T,TT
PRTERR wrong record-stream identification text
SOJGE B,RSINI1
SETZM PKTXBC
MOVE T,[440800,,PKTXBF+NETWRK"%CPKDT]
MOVEM T,PKTXBP
JRST POPJ1 ;Success return
;--- Experiment to avoid hideously slow SIOKS3
PKTXBF: BLOCK NETWRK"%CPMXW ;Packet transmit buffer
PKTXBP: 0 ;Byte pointer to PKTXBF
PKTXBC: 0 ;Byte count (valid bytes in packet)
PKTRBF: BLOCK NETWRK"%CPMXW ;Packet receive buffer
PKTRBP: 0 ;Byte pointer to PKTRBF
PKTRBC: 0 ;Byte count
;Transmit record and force output
RSXMTF: PUSHJ P,RSXMT
RSXSND: PUSH P,A
MOVE A,PKTXBC
LSH A,4
TLO A,(SETZ)
MOVEM A,PKTXBF
.CALL [ SETZ ? 'PKTIOT ? MOVEI RSOCH ? SETZI PKTXBF ]
.LOSE %LSSYS
SETZM PKTXBC
MOVE A,[440800,,PKTXBF+NETWRK"%CPKDT]
MOVEM A,PKTXBP
POP P,A
POPJ P,
;Output byte from T, low volume
RSXBTO: AOS TT,PKTXBC
CAIG TT,NETWRK"%CPMXC
JRST [ IDPB T,PKTXBP
POPJ P, ]
SOS PKTXBC
PUSHJ P,RSXSND
JRST RSXBTO
;Input byte to T, low volume
PUSHJ P,RSRRCV
RSRBTI: SOSGE PKTRBC
JRST .-2
ILDB T,PKTRBP
POPJ P,
;Receive next packet into PKTRBF
RSRRCV: .CALL [ SETZ ? 'PKTIOT ? MOVEI RSICH ? SETZI PKTRBF ]
.LOSE %LSSYS
MOVE T,[440800,,PKTRBF+NETWRK"%CPKDT]
MOVEM T,PKTRBP
LDB T,[NETWRK"$CPKNB+PKTRBF]
MOVEM T,PKTRBC
SKIPGE PKTRBF ;Skip if non-data packet
POPJ P,
LDB T,[NETWRK"$CPKOP+PKTRBF]
; CAIN T,NETWRK"%COEOF ; Ignore EOFs fucking Unix sends...
; JRST RSRRCV
; Doesn't do any good if it also closes the channel... $%!$#^%!$%!!
;A little bit of useful non-modularity (knows we're inside DUMP)
SETZM LPTSW
PRINT _Non-data packet received:
POCT T
PRINT [ ]
CAIN T,NETWRK"%COCLS
PRINT [(CLS) ]
CAIN T,NETWRK"%COLOS
PRINT [(LOS) ]
RSRRC1: SOSGE PKTRBC
JRST ERR
ILDB T,PKTRBP
.IOT TYOC,T
JRST RSRRC1
;Transmit a record
;RSOCH - network output channel
;A - opcode
;B - 8-bit byte pointer to buffer containing record
;C - number of bytes in record
;Bashes A,B,C,T,TT
RSXMT: MOVE T,A ;Send opcode byte
PUSHJ P,RSXBTO
CAIGE C,1_15. ;Long count?
JRST RSXMT1
MOVEI T,200
PUSHJ P,RSXBTO
LDB T,[301000,,C]
PUSHJ P,RSXBTO
LDB T,[201000,,C]
PUSHJ P,RSXBTO
RSXMT1: LDB T,[101000,,C] ;Send high byte of count
PUSHJ P,RSXBTO
MOVE T,C ;Send low byte of count
PUSHJ P,RSXBTO
RSXMT2: JUMPLE C,CPOPJ
MOVEI T,NETWRK"%CPMXC
SUB T,PKTXBC ;Space remaining in buffer
CAMLE T,C
MOVE T,C
JUMPLE T,[ PUSHJ P,RSXSND ;Make space and try again
JRST RSXMT2 ]
ADDM T,PKTXBC ;Send this many
SUB C,T
PUSH P,C
MOVE A,PKTXBP
MOVE C,T
PUSHJ P,SCOPY ;Copy into buffer
MOVEM A,PKTXBP
POP P,C
JRST RSXMT2
;Copy string of 8-bit bytes
;Byte instructions are hideously slow on KS10
;A - destination byte pointer
;B - source byte pointer
;C - number of bytes
;Bashes T,TT; advances arguments
SCOPY: JUMPLE C,CPOPJ ;Return if nothing left to do
TLNN A,300000 ;Skip if destination not word-aligned
CAIGE C,8 ;If fewer than two words, use slow loop
JRST SCOPY1 ;Copy one byte and try again
IBP A ;Point to first actual byte
IBP B
MOVE T,C
LSH T,-2 ;Number of words to do
ANDI C,3 ;Number of bytes left over
CAMGE B,[341000,,0] ;Skip if source is word-aligned
JRST SCOPY2
HRLZ TT,B ;Both aligned, use BLT
HRR TT,A
ADD A,T
ADD B,T
BLT TT,-1(A)
JRST SCOPY4 ;Take care of residue, if any
SCOPY1: ILDB T,B
IDPB T,A
SOJA C,SCOPY
SCOPY2: PUSHAE P,[D,E]
LDB D,[360600,,B] ;Byte position of source
MOVEI TT,34 ;Compute left shift required to align it
SUB TT,D
SCOPY3: DMOVE D,(B)
LSH D,-4 ;Squeeze out extra bits
LSHC D,4(TT) ;Align source to destination
MOVEM D,(A)
ADDI A,1
ADDI B,1
SOJG T,SCOPY3
POPAE P,[E,D]
SCOPY4: ADD A,[100000,,] ;Undo IBP
ADD B,[100000,,] ;..
JRST SCOPY ;Take care of residue, if any
IFN 0,[
;Transmit record and force output
RSXMTF: PUSHJ P,RSXMT
.NETS RSOCH,
POPJ P,
;Transmit a record
;RSOCH - network output channel
;A - opcode
;B - 8-bit byte pointer to buffer containing record
;C - number of bytes in record
RSXMT: .IOT RSOCH,A ;Send opcode byte
CAIGE C,1_15. ;Long count?
JRST RSXMT1
.IOT RSOCH,[200]
LDB T,[301000,,C]
.IOT RSOCH,T
LDB T,[201000,,C]
.IOT RSOCH,T
RSXMT1: LDB T,[101000,,C] ;Send high byte of count
.IOT RSOCH,T
.IOT RSOCH,C ;Send low byte of count
.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? B ? SETZ C ]
.LOSE %LSFIL
POPJ P,
];IFN 0
;Receive a record into buffer
RSRCVB: MOVE B,[440800,,BUFFER]
MOVEI C,MXRECB ;fall into RSRCV
;Receive a record
;RSICH - network input channel
;A - opcode is returned here
;B - 8-bit byte pointer to buffer in which record is returned
;C - input: number of bytes in buffer, output: number of bytes in record
RSRCV: PUSHJ P,RSRBTI ;Await record and receive the opcode
PUSH P,T ;Save opcode
PUSH P,C ;Save buffer size
PUSHJ P,RSRBTI ;High byte of count
MOVE C,T
MOVEI TT,1 ;Normally one additional byte
TRNE C,200
JRST [ MOVEI TT,4 ;Long count
MOVEI C,0
JRST .+1 ]
RSRCV0: LSH C,8
PUSHJ P,RSRBTI
IOR C,T
SOJG TT,RSRCV0
CAMLE C,(P)
PRTERR Record-stream input buffer overflow--record too long
MOVEM B,(P) ;Save buffer pointer
PUSH P,C ;Save record length
SKIPA A,B ;Destination
RSRCV1: PUSHJ P,RSRRCV ;Get another packet
MOVE B,PKTRBP ;Source
PUSH P,C ;Save remaining record length
CAMLE C,PKTRBC
MOVE C,PKTRBC ;Only part of record is in this packet
MOVN T,C
ADDM T,PKTRBC ;Use up source and destination buffers
ADDM T,(P)
PUSHJ P,SCOPY ;Copy into caller's buffer
MOVEM B,PKTRBP
POP P,C ;Number of bytes still needed
JUMPG C,RSRCV1
POP P,C ;Overall record length
POP P,B ;Original buffer pointer
POP P,A ;Opcode
POPJ P,
IFN 0,[
RSRCV: .IOT RSICH,A ;Await record and receive the opcode
PUSH P,C ;Save buffer size
.IOT RSICH,C ;High byte of count
MOVEI TT,1 ;Normally one additional byte
TRNE C,200
JRST [ MOVEI TT,4 ;Long count
MOVEI C,0
JRST .+1 ]
RSRCV0: LSH C,8
.IOT RSICH,T
IOR C,T
SOJG TT,RSRCV0
CAMLE C,(P)
PRTERR Record-stream input buffer overflow--record too long
MOVEM B,(P) ;Save buffer pointer
MOVE T,C
.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSICH ? B ? SETZ T]
.LOSE %LSFIL
POP P,B
POPJ P,
];IFN 0
.END RTAPE
SUBTTL DKAUTH, DKLOOK
; Call with magic number in A, returns with SIXBIT of author in A. Author
; is looked up in the -local- MFD, so that better be what you want.
DKAUTH: PUSH P,B
SKIPN DKMFDP
JRST DKAUT1
DKAUT2: MOVE B,MDNUDS+DSKMFD
SUB A,B
LSH A,1
SKIPGE A
SKIPA A,DSKMFD+2000(A)
SETZI A, ; 0 if no author
POP P,B
POPJ P,
DKAUT1: .IOPUSH DSKIN,
.CALL [ SETZ ? SIXBIT /OPEN/
[.BII,,DSKIN]
[SIXBIT /DSK/]
[SIXBIT /M.F.D./]
SETZ [SIXBIT /(FILE)/]]
.LOSE %LSFIL
MOVE B,[-2000,,DSKMFD]
.IOT DSKIN,B
SKIPGE B
.LOSE
SETOM DKMFDP
.IOPOP DSKIN,
JRST DKAUT2
; Call with directory name in A, first name in B, second name in C, returns
; with pointer to name block in A. Fails to skip if file or directory not
; found. Uses the local filesystem, so that better be what you want.
DKLOOK: PUSH P,D
CAMN A,DKUFDP
JRST DKLOK1
.IOPUSH DSKIN,
.CALL [ SETZ ? SIXBIT /OPEN/
[.BII,,DSKIN]
[SIXBIT /DSK/]
[SIXBIT /.FILE./]
[SIXBIT /(DIR)/]
SETZ A ]
JRST [ .IOPOP DSKIN, ? JRST POPDJ ]
MOVE D,[-2000,,DSKUFD]
.IOT DSKIN,D
SKIPGE D
.LOSE
MOVEM A,DKUFDP
.IOPOP DSKIN,
DKLOK1: MOVE A,DSKUFD+UDNAMP
ADDI A,DSKUFD-LUNBLK
DKLOK2: ADDI A,LUNBLK
CAIL A,DSKUFD+2000
JRST POPDJ
CAMN B,UNFN1(A)
CAME C,UNFN2(A)
JRST DKLOK2
MOVE D,UNRNDM(A)
TLNE D,UNIGFL
JRST DKLOK2
POPDJ1: AOS -1(P)
POPDJ: POP P,D
POPJ P,
SUBTTL BUFFERS
CONSTANTS
VARIABLES
PATCH:
PAT: BLOCK LPAT
PDL: BLOCK LPDL
CLOADF: ;SAVE SWITCHES FOR 'CLOAD' COMMAND
-1 ;SAVE DMPMOD HERE
0 ;SAVE RELOSW HERE
0 ;SAVE LENGTH HERE
BLOCK NFIGS ;SAVE @FIGTB2(n) HERE
MFDLST: BLOCK 1000 ;MUST BE IN THIS ORDER
BUF: BLOCK 2000 ;NORMAL BUFFER
DSKUFD: BLOCK 2000 .SEE DKLOOK ;UFD ON DISK
DSKMFD: BLOCK 2000 .SEE DKAUTH ;MFD ON DISK
UFDBUF: BLOCK 2000 ;STORAGE FOR INCOMING AND OUTGOING UFDS
MFDBUF: BLOCK 2000 ;STORAGE FOR TAPES COPY OF MFD
FDIRBF: BLOCK 2000+10 ;FOR FNG+POSSIBLE OVERFLOW
LISTBF: BLOCK 600. ;3 WORDS MAX 190. FILES, LISTING BUFFER
BIF: BLOCK 2000 ;COMPARE BUFFER
CORSIZ==<.+1777>_-10.
SORTAS: 0
SBUF: ;FOR ORDMFD (SCOTT CUTLER MEMORIAL BUFFER)
CORSZB==<.+40000+1777>_-10.
BUFFER: 0 .SEE FCDMP
END START