Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50160/goof.mac
There are no other files named goof.mac in the archive.
TITLE GOOF A DECTAPE CATASTROPHY RECOVERY ROUTINE
SUBTTL BY: BUREN W. HOFFMAN
GOOFVR==2
;****** CHANNELS
DTIN==0 ;DECTAPE INPUT
DTOT==1 ;OUTPUT FOR COMPLETE FILES
DFOT==2 ;OUTPUT FOR FRAGMENT FILES
LPT==3 ;OUTPUT FOR DECTAPE BLOCK MAP
;****** ACCUMULATORS
FLAG=0
A=1
B=2
C=3
D=4
AC1=5
AC2=6
AC3=7
CHR=10
W=11
X=12
Y=13
Z=14
BLN=15
PNT=16
COUNT=17
;****** FLAGS
PRINT==1 ;FLAG FOR SECOND PASS THRU PRINT ROUTINE
FRAGNO==2 ;NO FRAGMENT FILES TO BE WRITTEN
LISTNO==4 ;NO BLOCK MAP LISTING TO BE WRITTEN
NEWDIR==10 ;WRITE NEW DIR. INSTEAD OF COMPLETE FILES.
EXTERN JOBFF
REENTR==124
JOBVER==137
LOC REENTR
EXP RESTRT
RELOC
LOC JOBVER
EXP GOOFVR
RELOC
PAGE
DVINI: Z
MOVE AC1,DVLIST ;NAME OF LIST DEVICE
CALLI AC1,4 ;GET THE DEVICE CHARS.
TLNN AC1,1 ;CAN IT OUTPUT ?
TLOA FLAG,LISTNO ;NO, NO MAP
CAIA ;YES
JRST DVIN-1 ;GO CHECK NEXT DEVICE
INIT LPT,1 ;ASCII MODE TO LISTING DEVICE
DVLIST: SIXBIT /LIST/
XWD LBUF,0
JRST .-6 ;SET NOLIST FLAG
MOVEI AC1,LPBUF ;OUTPUT BUFFER
MOVEM AC1,JOBFF
OUTBUF LPT,1 ;ESTABLISH BUFFER
INIT DTIN,117 ;NON-STD. DUMP MODE
DVIN: SIXBIT /GOOFIN/
Z
JRST LOGMSG ;THIS IS A NO-NO
MOVE AC1,DVOUT
CALLI AC1,4 ;GET DEVICE CHARACTERISTICS
JUMPE AC1,DVANO ;DEFINED DEVICE ?
DEVCMP: INIT DTOT,14 ;YES, TRY BINARY OUTPUT
DVOUT: SIXBIT /GOOFA/
XWD OBUF,0
CAIA
JRST .+3 ;OK
DVANO: TLO FLAG,NEWDIR ;TURN ON NEWDIR FLAG
JRST .+4
MOVEI AC1,NDIR
MOVEM AC1,JOBFF
OUTBUF DTOT,2 ;ESTAB. TWO OUTPUT BUFFERS
DEVFRG: INIT DFOT,14 ;DEVICE FOR FRAGMENT OUTPUT
DVOUTF: SIXBIT /GOOFX/
XWD FBUF,0
TLO FLAG,FRAGNO ;NO FRAGMENT FILES TO BE WRITTEN
JRST @DVINI ;RETURN
PAGE
;************ GOOF STARTS HERE
GOOF: CALLI 0 ;RESET ALL I/O
TTCALL 3,MSGLGA ;TYPE INSTRUCTIONS
MOVEI AC1,202017 ;INITIALIZE EXTENSION COUNTER
MOVEM AC1,EXTNSN ;AND SAVE
;************ RE-ENTER HERE FROM REENTR
STRRT1: JSR TIMIN ;SET UP START TIMES
TTCALL 3,MSGLOG ;TYPE OTHER INSTR.
MOVEI FLAG,0 ;START WITH VIRGIN FLAG
JSR DVINI ;INIT ALL THE DEVICES
MOVE AC1,[XWD LNKWRD,LNKWRD+1]
SETOM LNKWRD ;INITIALIZE LNKWRD ARRAY TO ALL ONES
BLT AC1,LNKWRD+1101
MOVE AC1,[XWD FILEN,FILEN+1]
SETZM FILEN ;INITIALIZE FILEN ARRAY TO ALL ZEROES
BLT AC1,FILEN+77
JRST STRRT ;NOW START TO WORK
;************THE MESSAGES MSGLGA AND MSGLOG XLISTED BELOW
XLIST
MSGLOG: ASCIZ /
TYPE A CARRIAGE RETURN WHEN READY TO START,
OR AN M<CR> IF READING BLOCKS MANUALLY.
*/
MSGLGA: ASCIZ /
ASSUMED LOGICAL ASSIGNMENTS --
INPUT DEVICE = GOOFIN
OUTPUT DEVICE = GOOFA (FOR COMPLETE FILES)
OUTPUT DEVICE = GOOFX (FOR FRAGMENT FILES)
LISTING DEVICE = LIST
NOTE:
1) IF GOOFX UNDEFINED, NO FRAGMENT FILES WRITTEN.
2) IF LIST UNDEFINED, NO DECTAPE BLOCK MAP WRITTEN.
3) FOR MANUAL CHAINING, ONLY GOOFIN AND GOOFA USED.
4) IF GOOFA UNDEFINED, A NEW DIR. WRITTEN ON GOOFIN.
5) IF ADDITIONAL OUTPUT DEVICES (EG. DECTAPES) ARE
NEEDED TO WRITE THE OUTPUT FILES, THE PROGRAM WILL
REQUEST THEM AS NEEDED. IF ALREADY ASSIGNED,
THE PROGRAM WILL PROCEED.
THE EXTRA OUTPUT DEVICES CAN BE DEFINED BEFORE
RUNTIME.
FOR OUTPUT OF COMPLETE FILES, THE ADDITIONAL
DEVICES ARE GOOFB,GOOFC,GOOFD,...
FOR FRAGMENT FILES, GOOFY,GOOFZ
/
LIST
PAGE
;************ START TALKING TO USER HERE
STRRT: TTCALL 4,CHR ;GET INPUT FROM TTY
CAIN CHR,15 ; <CR> ?
JRST GOGO ;YES, GO READ THE DECTAPE
CAIN CHR,"M" ; (M) ?
JRST MANUAL ;YES, GO DO MANUAL INPUT
TTCALL 3,[ASCIZ /?/] ;SOME ERROR ?
TTCALL 11,0 ;FLUSH INPUT BUFFER
JRST STRRT ;AND ASK AGAIN
GOGO: MOVE BLN,[XWD -1077,3] ;IGNORE BLOCKS 0,1,& 2
USETAG: HRRZ AC1,BLN ;THIS BLOCK NEXT
CAIN AC1,144 ;IS IT THE DIRECTORY BLOCK ?
JRST NONOFD ;YES, IGNORE IT
MOVEI COUNT,10 ;UP TO EIGHT READ TRIES
USETI DTIN,(BLN) ;SET TO READ BLOCK
INPUT DTIN,INIOWD ;INPUT THE BLOCK
STATZ DTIN,740000 ;OK ?
JSP A,HELPME ;NO, GET HELP
CAIA ;YES
JRST NONOFD ;CAN'T READ IT
LDB AC1,[POINT 10,DTAB,27] ;ORIGIN BLOCK
CAIG AC1,1101 ;DON'T USE IF >1101
SKIPN AC1 ;OR ZERO
JRST NONOFD
MOVEM AC1,LNKWRD(BLN) ;SAVE THE ORIGIN INFO.
MOVE AC3,DTAB ;GET THE LINKAGE INFO
HLLM AC3,LNKWRD(BLN) ;AND SAVE
MOVE AC2,[XWD -200,FILEN] ;NOW SCAN FILEN
RSCN: SKIPN (AC2) ;END OF SCAN ?
JRST NOFND ;YES, ENTER THE NEW ORIGIN
CAMN AC1,(AC2) ;THIS ORIGIN ALREADY ENTERED ?
JRST NONOFD ;YES
NOTEQ: AOBJN AC2,RSCN ;IS FILEN ARRAY FULL ?
JRST TOOMCH ;YES
NOFND: MOVEM AC1,(AC2) ;SAVE THE INFO IN FILEN
NONOFD: AOBJN BLN,USETAG ;MORE BLOCKS TO READ ?
TLZ FLAG,PRINT ;NO, SET THE PRINT FLAG
PAGE
RDDONA: TLNE FLAG,LISTNO ;WRITE A LISTING ?
JRST RDDN0 ;NO
MOVSI W,-200 ;200 ENTRIES IN FILEN
SETZM ORCNT# ;INITIALIZE REFERENCE COUNTER
SKIPN A,FILEN(W) ;END OF FILEN ARRAY ?
JRST RDDONE ;YES
MOVSI BLN,-1102 ;1102 ENTRIES MAX IN LNKWRD
HRRZ B,LNKWRD(BLN) ;PICK UP ORIGIN REFERENCE
CAMN A,B ;IS IT EQUAL TO THIS ONE ?
AOS ORCNT ;YES, INCREMENT COUNTER
AOBJN BLN,.-3 ;THRU THE LNKWRD ARRAY ?
HRLZ A,ORCNT ;YES, STORE THE REFERENCE COUNT
HLLM A,FILEN(W) ;IN THE FILEN ARRAY
AOBJN W,RDDONA+3 ;THRU WITH FILEN ARRAY ?
RDDONE: TLNE FLAG,LISTNO ;YES, WRITE LIST FILE ?
JRST RDDN0 ;NO
MOVE A,[SIXBIT /GOOF/]
MOVSI B,(SIXBIT /DTA/)
SETZB C,D
ENTER LPT,A ;ENTER THE FILE
JRST RDDN0 ;? ERROR
JRST REGPRT ;FIRST PASS LISTING
RDDUN: MOVEI CHR,14 ;NEW PAGE
JSR PUTCHR
MOVE AC1,[POINT 7,MSG3] ;SECOND PASS HDG.
JRST RDDN2 ;GO DO IT
REGPRT: MOVE AC1,[POINT 7,MSG1] ;THIS HDG FOR FIRST PASS
JSR PTSTRG ;WRITE IT
MOVSI AC1,-200 ;200 ENTRIES MAX IN FILEN
HRRI AC1,FILEN ;ADDR OF FILEN
MOVEI BLN,0 ;SET UP A BLOCK COUNTER
REGPR1: SKIPN (AC1) ;END OF FILEN ARRAY ?
JRST REGPR2 ;YES
JSR LPRNT ;PRINT TEXT ASSOC. WITH (AC1)
MOVEI A,MXREF
HRLI A,440700
ILDB CHR,A ;GET A BYTE
JUMPE CHR,.+3 ;NULL BYTE ?
JSR PUTCHR ;NO, WRITE IT
JRST .-3 ;GET NEXT BYTE
MOVEI D,^D12 ;12 XREF'S PER LINE
MOVEI CHR,11 ;HORIZ. TAB
JSR PUTCHR ;TWO TIMES
JSR PUTCHR
HRRZ A,(AC1) ;ORIGIN BLOCK
MOVSI B,-1102 ;1102 LNKWRD ENTRIES
NXXRF: HRRZ C,LNKWRD(B) ;ORIGIN REF. FOR THIS LNKWRD
CAME C,A ;ARE THEY EQUAL ?
JRST NDXRF ;NO, TRY NEXT LNKWRD
MOVE PNT,[POINT 3,B,17] ;YES, SO PRINT
SOJGE D,NXHWD ;12 WORDS PRINTED ?
MOVEI CHR,15 ;YES, END OF LINE
JSR PUTCHR
MOVEI CHR,12 ;LINE FEED
JSR PUTCHR
MOVEI CHR,11 ;HORIZ. TAB
JSR PUTCHR ;TWO TIMES
JSR PUTCHR
MOVEI D,^D11 ;RE-INITIALIZE REF. COUNT
NXHWD: JSR HWD ;PRINT THE REFERENCE
MOVEI CHR,11 ;HORIZ. TAB
JSR PUTCHR ;PRINT IT
NDXRF: AOBJN B,NXXRF ;MORE ENTRIES IN LNKWRD ?
MOVEI CHR,15 ;NO, CARRIAGE RETURN
JSR PUTCHR
MOVEI CHR,12 ;LINE FEED
JSR PUTCHR ;TWICE
JSR PUTCHR
AOBJN AC1,REGPR1 ;MORE FILEN ENTRIES ?
REGPR2: MOVE AC1,[POINT 7,MSG2] ;NO, NEXT OUTPUT NOW
RDDN2: JSR PTSTRG
MOVSI AC1,-1102 ;1102 ENTRIES IN LNKWRD
HRRI AC1,LNKWRD ;ADDR OF LNKWRD
MOVEI BLN,0 ;BLOCK COUNTER
JSR LPRNT ;PRINT THE BLOCK NO. AND POINTERS
AOBJN AC1,.-1 ;MORE TO PRINT ?
NOMAP2: TLNE FLAG,PRINT ;NO, FIRST PRINT PASS ?
JRST FINIS2 ;NO, REALLY DONE.
PAGE
RDDN0: MOVSI W,-200 ;200 ENTRIES MAX. IN FILEN
TLNE FLAG,NEWDIR ;WRITING NEW DIRECTORY ?
JSR DIRINI ;YES, INITIALIZE
RDDN1: SKIPN FILEN(W) ;END OF FILEN ARRAY ?
JRST RDFRAG ;YES, GO WRITE FRAGS.
HRRZ X,FILEN(W) ;FIRST BLOCK OF FILE
MOVE Y,X
RDDAG: HRRZ AC1,LNKWRD(Y) ;ORIGIN
HLRZ Y,LNKWRD(Y) ;NEXT BLOCK
ANDI Y,1777 ;LOW ORDER 10 BITS ONLY
CAMN AC1,X ;SAME ORIGIN ?
JRST .+3 ;YES
AOBJN W,RDDN1 ;NO, GET NEXT ORIGIN
JRST RDFRAG ;DONE SO READ FRAGMENTS
SKIPE Y ;END OF FILE ?
JRST RDDAG ;NO, SEARCH ON FURTHER
GOODUN: MOVSI A,(SIXBIT /DTC/) ;SET THE FILENAME
JSR EXTADJ ;AND GET THE NEXT EXTENSION
TLNE FLAG,NEWDIR ;WRITING NEW DIRECTORY ?
JRST DTENTR ;YES, GO MAKE ENTRY
GOODNX: SETZB C,D ;NO, GO AHEAD AND ENTER FILE
ENTER DTOT,A
JRST DIRFUL ;NEED NEXT TAPE
SETOM FILEN(W) ;FLAG AS USED
GOODN1: MOVEI COUNT,10 ;UP TO 10 RE-TRIES TO READ
USETI DTIN,(X) ;SETUP FOR THIS BLOCK
INPUT DTIN,INIOWD ;READ THE BLOCK
STATZ DTIN,740000 ;OK ?
JSP A,HELPME ;NO, GET HELP
CAIA ;YES
JRST GOODEF ;CAN'T READ IT, SO EOF
HLRZ Y,LNKWRD(X) ;NEXT BLOCK NUMBER
ANDI Y,1777 ;LOW ORDER 10 BITS ONLY
SETOM LNKWRD(X) ;FLAG AS USED
MOVE X,Y
MOVE AC2,[XWD -177,DTAB+1]
MOVE CHR,(AC2) ;PICK UP A WORD FROM BLOCK
JSR PUT ;AND WRITE ON OUTPUT DEVICE
AOBJN AC2,.-2 ;MORE WORDS ?
SKIPE X ;EOF ?
JRST GOODN1 ;NO, READ MORE
GOODEF: CLOSE DTOT,0 ;YES, CLOSE THE FILE
AOBJN W,RDDN1 ;MORE ENTRIES IN FILEN ?
PAGE
RDFRAG: TLNE FLAG,NEWDIR ;NO, WRITING NEW DIRECTORY ?
JSR DIROUT ;YES, FINISH IT
TLNE FLAG,FRAGNO ;WRITE FRAG FILES ?
JRST FINISH ;NO
MOVEI W,NDIR
MOVEM W,JOBFF
OUTBUF DFOT,2 ;ESTABLISH TWO OUTPUT BUFFERS
MOVSI W,-200 ;200 MAX. ENTRIES IN FILEN
RDFRG1: SKIPN FILEN(W) ;MORE ENTRIES ?
JRST FINISH ;NO
SKIPG FILEN(W) ;ALREADY USED ?
JRST RDFRG3 ;YES
HRRZ X,FILEN(W) ;GET ORIGIN BLOCK
MOVE AC3,X ;ORIGIN
HRRZ AC2,LNKWRD(X) ;GET CORRES. ORIGIN FROM LNKWRD
CAME AC2,X ;ARE THEY SAME ?
JRST RDFRG3 ;NO
MOVSI A,(SIXBIT /DTF/) ;SET THE FILENAME
JSR EXTADJ ;AND GET THE NEXT EXTENSION
RDFRGX: SETZB C,D
ENTER DFOT,A ;ENTER THE NEW FILE
JRST FRGFUL ;NEED NEXT TAPE
RDFRG2: MOVEI COUNT,10
USETI DTIN,(X) ;SET UP TO INPUT THIS BLOCK
INPUT DTIN,INIOWD ;INPUT THE BLOCK
STATZ DTIN,740000 ;OK ?
JSP A,HELPME ;NO
CAIA
JRST FRAGEF ;CAN'T READ SO EOF
HRRZ Y,LNKWRD(X) ;ORIGIN OF THIS NEXT BLOCK
MOVE CHR,X
HLRZ X,LNKWRD(X) ;NEXT BLOCK
ANDI X,1777 ;LOW ORDER 10 BITS ONLY
SETOM LNKWRD(CHR) ;FLAG AS USED
MOVE AC2,[XWD -177,DTAB+1]
MOVE CHR,(AC2) ;GET AN INPUT WORD
JSR PUTF ;WRITE THE WORD
AOBJN AC2,.-2 ;MORE WORDS FOR THIS BLOCK ?
CAMN Y,AC3 ;NO, NEXT BLOCK SAME ORIGIN ?
JRST RDFRG2 ;YES, GET IT
FRAGEF: CLOSE DFOT,0 ;EOF FOR THIS FRAGMENT
RDFRG3: AOBJN W,RDFRG1 ;MORE FILEN ENTRIES ?
PAGE
FINISH: TLO FLAG,PRINT ;TURN ON PASS2 PRINT FLAG
TLNN FLAG,LISTNO ;MAKE AN OUTPUT LISTING ?
JRST RDDUN ;YES, GO DO IT
FINIS2: RELEAS DTIN,0
RELEAS DTOT,0
RELEAS DFOT,0
RELEAS LPT,0
CALLI A,22 ;GET TIME NOW
SUB A,RELTIM# ;ELAPSED TIME
JSR TIMPRT ;PRINT THE TIME
ASCIZ /ELAPSED REAL TIME /
MOVE A,[XWD -1,4] ;GET RUNNING TIME (CPU)
CALLI A,41
HALT
SUB A,CPUTIM# ;ELAPSED CPU TIME
JSR TIMPRT ;PRINT THE TIME
ASCIZ /ELAPSED CPU TIME /
CALLI 12 ;EXIT
DTENTR: MOVEM A,DTAB+^D83(D) ;ENTER THE FILENAME
HRR B,DIRDAT# ;GET THE DATE
MOVEM B,DTAB+^D105(D) ;ENTER EXT AND DATE
SETOM FILEN(W) ;FLAG AS USED
ADDI D,1 ;INCREMENT FILE COUNT
DTNTRD: HRRZ B,X ;BLOCK NUMBER
IDIVI B,7 ;SEVEN SLOTS PER WORD
DPB D,POINTR(C) ;DEPOSIT THE FILE NUMBER IN SLOT
HLRZ Y,LNKWRD(X) ;NEXT BLOCK
SETOM LNKWRD(X) ;FLAG AS USED
MOVE X,Y
ANDI X,1777 ;LOW ORDER 10 BITS ONLY
SKIPE X ;EOF ?
JRST DTNTRD ;NO
AOBJN W,RDDN1 ;YES, MORE FILES ?
JRST RDFRAG ;NO, CHECK ON FRAGMENTS
DIROUT: Z
MOVEI COUNT,10
USETO DTIN,144 ;SETUP TO OUTPUT THE NEW DIR.
OUTPUT DTIN,INIOWD ;OUTPUT THE DIRECTORY
STATZ DTIN,740000 ;OK ?
JSP A,HELPME ;NO, GET HELP
JRST @DIROUT ;DONE, RETURN
HALT ;ERROR
DIRINI: Z
MOVE AC1,[XWD DTAB,DTAB+1]
SETZM DTAB
BLT AC1,DTAB+177 ;ZERO OUT DTAB
MOVEI AC1,36
DPB AC1,[POINT 5,DTAB+^D21,4] ;LABEL DIR. SLOT
CALLI AC1,14 ;GET TODAY'S DATE
MOVEM AC1,DIRDAT ;AND SAVE FOR LATER
MOVEI D,0 ;INITIALIZE FILE COUNT
JRST @DIRINI ;RETURN
POINTR:
POINT 5,DTAB(B),4
POINT 5,DTAB(B),9
POINT 5,DTAB(B),14
POINT 5,DTAB(B),19
POINT 5,DTAB(B),24
POINT 5,DTAB(B),29
POINT 5,DTAB(B),34
TIMPRT: Z
MOVE AC1,TIMPRT ;ADDRESS OF MESSAGE
HRLI AC1,440700 ;BUILT BYTE POINTER TO MSG
ILDB CHR,AC1 ;GET A BYTE OF MSG
JUMPE CHR,.+3 ;TERMINATE ON NULL CHARACTER
TTCALL 1,CHR ;WRITE THE CHARACTER
JRST .-3 ;GET NEXT BYTE
ADDI AC1,1 ;INCREMENT FOR RETURN ADDRESS
HRRM AC1,TIMPRT
IDIVI A,^D3600*^D60 ;HOURS IN A
IDIVI B,^D3600 ;MINUTES IN B
IDIVI C,^D60 ;SECONDS IN C
MOVE AC1,A
JSR DECPRT ;PRINT HOURS
TTCALL 3,[ASCIZ /:/]
MOVE AC1,B
JSR DECPRT ;PRINT MINUTES
TTCALL 3,[ASCIZ /:/]
MOVE AC1,C
JSR DECPRT ;PRINT SECONDS
TTCALL 3,[ASCIZ /./]
IMULI D,^D10
IDIVI D,6
JSR DECPRT ;PRINT SEC/100
TTCALL 3,[ASCIZ /
/]
JRST @TIMPRT ;RETURN
PTSTRG: Z
ILDB CHR,AC1 ;GET A BYTE
JUMPE CHR,@PTSTRG ;TERMINATE ON NULL CHAR.
JSR PUTCHR ;WRITE THE BYTE
JRST .-3 ;GO GET NEXT BYTE
DECPRT: Z
IDIVI AC1,^D10
MOVEI CHR,60(AC1)
TTCALL 1,CHR ;TYPE TENS
MOVEI CHR,60(AC2)
TTCALL 1,CHR ;TYPE UNITS
JRST @DECPRT
TIMIN: Z
CALLI AC1,22 ;GET TIME OF DAY IN JIFFIES
MOVEM AC1,RELTIM ;AND SAVE
MOVE AC1,[XWD -1,4]
CALLI AC1,41 ;GET CPU RUN TIME IN JIFFIES
HALT
MOVEM AC1,CPUTIM ;AND SAVE
JRST @TIMIN ;AND RETURN
LPRNT: Z
TLNN FLAG,PRINT ;SECOND PASS ?
JRST LPRNTA ;NO
SKIPL (AC1) ;USED BLOCK ?
JRST LPRNTA ;NO, WRITE IT
ADDI BLN,1 ;INCREMENT BLOCK COUNT
JRST @LPRNT ;RETURN
LPRNTA: MOVE PNT,[POINT 3,BLN,23]
ILDB CHR,PNT ;PICK UP AN OCTAL DIGIT
ADDI CHR,60 ;CONVERT TO ASCII
JSR PUTCHR ;AND WRITE IT
TLNE PNT,770000 ;END OF WORD ?
JRST .-4 ;NO, DO MORE
ADDI BLN,1 ;INCREMENT BLOCK COUNT
MOVEI CHR,40 ;BLANK
JSR PUTCHR
JSR PUTCHR
MOVE PNT,[POINT 3,(AC1)] ;POINTER TO LNKWRD ENTRY
JSR HWD ;WRITE THE HALFWORD
MOVEI CHR,40 ;BLANK
JSR PUTCHR
JSR HWD ;WRITE THE SECOND HALFWORD
MOVEI CHR,15 ;CARRIAGE RETURN
JSR PUTCHR
MOVEI CHR,12 ;LINE FEED
JSR PUTCHR
JRST @LPRNT ;RETURN
HELPME: SOJGE COUNT,-4(A) ;REREAD COUNT LEFT ?
JRST 1(A) ;NO
PUT: Z ;PUT,PUTF, AND PUTCHR ARE BUFFERED OUTPUT ROUTINES.
SOSG OBUF+2
JRST .+3
IDPB CHR,OBUF+1
JRST @PUT
OUT DTOT,0
JRST .-3
HALT
PUTF: Z
SOSG FBUF+2
JRST .+3
IDPB CHR,FBUF+1
JRST @PUTF
OUT DFOT,0
JRST .-3
HALT
PUTCHR: Z
SOSG LBUF+2
JRST .+3
IDPB CHR,LBUF+1
JRST @PUTCHR
OUT LPT,0
JRST .-3
HALT
HWD: Z
MOVEI AC3,6 ;6 DIGITS PER HALF-WORD
ILDB CHR,PNT ;GET A DIGIT
ADDI CHR,60 ;CONVERT TO ASCII
JSR PUTCHR ;WRITE THE CHARACTER
SOJG AC3,.-3 ;MORE DIGITS ?
JRST @HWD ;NO, RETURN
PAGE
;************ HERE FOR MANUAL CHAINING OF FILES
MANUAL: MOVSI A,(SIXBIT /DTM/) ;SET THE FILENAME
JSR EXTADJ ;AND GET NEXT EXTENSION
SETZB C,D
ENTER DTOT,A ;ENTER THE NEW FILE
JRST TAPFUL ;ERROR
MANENT: TTCALL 11,0 ;FLUSH TTY INPUT BUFFER
TTCALL 3,[ASCIZ /BLOCK NO. ? /]
MANREN: SETZB AC1,AC2 ;INITIALIZE AC1 & AC2
MANBLK: TTCALL 4,AC2 ;GET A CHARACTER
CAIE AC2,15 ;CARRIAGE RETURN ?
CAIN AC2,175 ;NO, ALTMODE ?
JRST MANEBK ;COMPLETE BLOCK NUMBER, PROCESS IT
CAIN AC2,"," ;COMMA ?
JRST MANEBK ;YES, PROCESS IT
SUBI AC2,60 ;CONVERT TO BINARY
SKIPL AC2 ;IS IT A LEGAL OCTAL NUMBER
CAILE AC2,7
JRST MANERR ;ILLEGAL NUMBER
ROT AC2,-3 ;GET THE DIGIT INTO HIGH END OF AC2
LSHC AC1,3 ;SHIFT INTO AC1
JRST MANBLK ;GO GET NEXT DIGIT
MANEBK: CAILE AC1,1101 ;IS NUMBER >1101 ?
JRST MANERR ;YES
SKIPN AC1 ;IS IT >0 ?
JRST MANEOF ;NO, EOF
MOVEI COUNT,10
USETI DTIN,(AC1) ;SET UP TO INPUT THE BLOCK
INPUT DTIN,INIOWD ;GET THE BLOCK
STATZ DTIN,740000 ;OK ?
JSP A,HELPME ;NO, GET HELP
CAIA
JRST MRDERR ;CAN'T READ IT
MOVE AC1,[XWD -177,DTAB+1]
MOVE CHR,(AC1) ;PICK UP A WORD
JSR PUT ;AND WRITE IT
AOBJN AC1,.-2 ;MORE TO XFER
CAIN AC2,"," ;NO, COMMA DELIMETER ?
JRST MANREN ;YES, GET NEXT NUMBER
JRST MANENT ;NO, ASK FOR ANOTHER BLOCK NO.
MANEOF: CLOSE DTOT,0 ;CLOSE THE OUTPUT FILE
TTCALL 11,0 ;FLUSH THE INPUT BUFFER
TTCALL 3,[ASCIZ /ANOTHER FILE ? (Y OR <C.R.>) /]
TTCALL 4,CHR ;GET ANSWER
CAIN CHR,"Y" ;IS IT YES ?
JRST MANUAL ;YES, GO DO IT
CALLI 12 ;NO, EXIT
MRDERR: TTCALL 3,[ASCIZ /? READ ERROR
/]
CAIA
MANERR: TTCALL 3,[ASCIZ /?
/]
TTCALL 3,[ASCIZ /ERROR OCCURRED BEFORE
/]
TTCALL 4,CHR
CAIE CHR,15
CAIN CHR,175
JRST .+3
TTCALL 1,CHR
JRST .-5
TTCALL 3,[ASCIZ /
/]
JRST MANENT
TAPFUL: TTCALL 3,[ASCIZ /
OUTPUT DEVICE ENTER FAILURE
** PROBABLY FULL DIRECTORY **
/]
CALLI 12
NOMAP: TTCALL 3,[ASCIZ /CAN'T INIT LOGICAL DEVICE LIST
SO NO BLOCK MAPS PRODUCED.
/]
TLO FLAG,LISTNO
JRST NOMAP2
TOOMCH: TTCALL 3,[ASCIZ /
TOO MANY FRAGMENTS
/]
CALLI 12
LOGMSG: TTCALL 3,[ASCIZ /
? ? ASSIGN THE LOGICAL DEVICES AND RESTART ? ?
/]
CALLI 12
EXTADJ: Z
AOS B,EXTNSN ;INCREMENT THE EXTENSION COUNTER
TRZN B,10 ;DIGIT OVERFLOW ?
JRST EXTA1 ;NO
ADDI B,100 ;YES, EFFECT THE CARRY
TRZN B,1000 ;DIGIT OVERFLOW ?
JRST EXTA1 ;NO
ADDI B,10000 ;YES, MAKE THIS CARRY
EXTA1: MOVEM B,EXTNSN ;SAVE THE UPDATED COUNTER
HRLZS B ;PUT EXT IN LEFT HALF
JRST @EXTADJ ;AND RETURN
EXTNSN: Z
DIRFUL: MOVEI AC2,100 ;TO INCREMENT LAST LETTER OF DEV NAME
ADDB AC2,DVOUT ;DO IT
MOVEI CHR,DVOUT
HRRZ AC1,DEVCMP ;DATA MODE
MOVE AC3,DEVCMP+2 ;RING-HEADER
OPEN DTOT,AC1 ;RE-INIT THE DEVICE & CHANNEL
JSR NEWDEV ;NEED ANOTHER OUTPUT DEVICE
MOVEI AC1,NDIR
MOVEM AC1,JOBFF
OUTBUF DTOT,2
JRST GOODNX
FRGFUL: MOVEI AC2,100 ;TO INCREMENT DEVICE NAME
ADDB AC2,DVOUTF
MOVEI CHR,DVOUTF
HRRZ AC1,DEVFRG
MOVE AC3,DEVFRG+2
OPEN DFOT,AC1
JSR NEWDEV ;NEED NEXT DEVICE
MOVEI AC1,NDIR
MOVEM AC1,JOBFF
OUTBUF DFOT,2
JRST RDFRGX
NEWDEV: Z
TTCALL 3,[ASCIZ /
NEED NEW OUTPUT DEVICE WITH LOGICAL NAME OF /]
HRLI CHR,440600
ILDB AC1,CHR
JUMPE AC1,.+4
ADDI AC1,40
TTCALL 1,AC1
JRST .-4
TTCALL 3,[ASCIZ /
ASSIGN THE DEVICE, AND THEN TYPE CONTINUE
/]
CALLI 1,12 ;EXIT
MOVE AC1,NEWDEV
SUBI AC1,5
JRST (AC1)
;************ THE FOLLOWING MESSAGES XLISTED HERE
; MXREF
; MSG1
; MSG2
; MSG3
;
XLIST
MXREF: ASCIZ /*******************
/
MSG1: ASCIZ /
FILE ORIGINS
FILE REF ORIGIN [& CROSS REFERENCE]
....................
/
MSG2: ASCIZ /
BLOCK POINTER CONTENTS
BLOK NEXT,ORIGIN
..................
/
MSG3: ASCIZ /
UNUSED BLOCKS
BLOK NEXT,ORIGIN
..................
/
LIST
PAGE
INIOWD: IOWD 200,DTAB
Z
DTAB: BLOCK 200
FILEN: BLOCK 200
NDIR: BLOCK 203
NFDIR: BLOCK 203
LNKWRD: BLOCK 1102
OBUF: BLOCK 3
FBUF: BLOCK 3
LBUF: BLOCK 3
LPBUF: BLOCK 203
XLIST
LIT
LIST
RESTRT: CALLI 0
JRST STRRT1
THEEND: END GOOF