Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0131/libman.mac
There are 2 other files named libman.mac in the archive. Click here to see a list.
SUBTTL B. SCHREIBER - U OF I HIGH ENERGY PHYSICS GROUP
SEARCH JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC .XTABM
SALL
;LIBMAN VERSION
LIBVER==3 ;MAJOR VERSION
LIBEDT==21 ;EDIT LEVEL
LIBMIN==0 ;MINOR VERSION
LIBWHO==0 ;WHO?
DEFINE CTITLE (WORD1,TEXT,MAJVER,VEREDT)
<WORD1 'TEXT'MAJVER(VEREDT)>
CTITLE (TITLE,<LIBMAN -- LIBRARY FILE MANIPULATION PROGRAM %>,\LIBVER,\LIBEDT)
LOC .JBVER
%%LIBM==:VRSN. (LIB)
EXP %%LIBM
;SHOW UNIVERSAL VERSION NUMBERS
%%JOBD==:%%JOBD ;JOBDAT
%%UUOS==:%%UUOS ;UUOSYM
%%MACT==:%%MACT ;MACTEN
%%SCNM==:%%SCNM ;SCNMAC
;REQUEST REST OF LOADING
.REQUE REL:ALCOR
.REQUE REL:SCN7B
.REQUE REL:WLD7A
.REQUE REL:HELPER
SUBTTL REVISION HISTORY / SUGGESTIONS / KNOWN BUGS
COMMENT $ REVISION HISTORY
1(1) BIRTH
2(2) 12/12/76 ADD DVERSION COMMAND TO SET VERSION OF DISK FILES
(NOT IN LIBRARY). IMPLEMENT SUPERSEDE TOTALLY.
2(3) 12/13/76 ADD SOME INFORMATIVE TYPEOUT SO USER KNOWS WHAT
WE ARE DOING. BREAK UP LISTING SOME.
2(4) 12/15/76 ADD MISSING JRST CPTYEN AFTER LOOKUP IN CPYTYF
3(5) 12/16/76 IMPLEMENT LSUPERSEDE AND DSUPERSEDE TO ALLOW
DIFFERENT SUPERSEDE OPTIONS FOR COPY AND REPLACE.
IMPLEMENT FILDIR COMMAND WHICH RUNS DIRECT TO
GET A DISK DIRECTORY AND RERUNS LIBMAN. WRITE
NNNLRL.TMP TO REMEMBER LIBMAN LIBRARY FROM LAST
USE COMMAND (ONLY USE COMMAND!)
3(6) 12/22/76 FIX FEW BUGS. DISREGARD /SUPERSEDE CHECKING IF
UNIVERSAL DATE/TIME IS 0 (I.E. CONVERTED FROM
UFLIP FORMAT WITH LIBCVT)
3(7) 12/26/76 ADD SUPPORT FOR /BEFORE/SINCE/ABEFORE/SINCE
IN ADD COMMAND (TO SELECTIVELY LIBRARY FILES)
3(10) 12/26/76 CHECK TO MAKE SURE WE ARE NOT ADDING A LIBRARY
TO ITSELF IN ADD COMMAND (I.E. SO ADD *.* WILL
NOT ADD THE LIBRARY ITSELF)
3(11) 12/27/76 ADD REMEMBER VERB. SPEED UP ADDING FILES SOMEWHAT
(ESP. IF FILE NOT FOUND)
3(12) 1/3/77 MAKE "COPY A,B,C" WORK. FIX USAGE OF .RBTIM IN A FEW
CASES.
3(13) 1/3/77 FIXUP IN CASE "FILDIR 'NOT'*.TMP". SCAN WAS CHANGING
GUIDE WORDS TO META-CHARACTERS. I MUST RESET THEM.
3(14) 1/9/77 MAKE /NOREMEMBER THE DEFAULT. TEACH FILDIR HOW
TO REMEMBER LIBRARY IF NEEDED. MESSAGE USER ABOUT
FILES NOT COPIED/REPLACED WITH INFO ON WHY.
3(15) 1/10/77 IMPLEMENT /BUFFER:N. GET VERBOSITY BITS AND SUPPORT
THEM IN ERROR HANDLER (AT LEAST /MESS:PREFIX)
3(16) 1/14/77 FIX MINOR BUG INTRODUCED IN COPY COMMAND. CHANGE
NO FILES COPIED/REPLACED MESSAGE TO "NO FILES FOUND
TO MATCH FS,FS,FS"
3(17) 1/14/77 COUNT # FILES REJECTED FOR ONE REASON OR ANOTHER
AND DON'T GIVE NO FILES FOUND TO MATCH MESSAGE IF
FILES FOUND BUT REJECTED
3(20) 1/14/77 FILDIR WAS NOT WRITING TMPFILE ALL THE TIME.
3(21) 1/17/77 USE TLBVP A LITTLE MORE. ON FILDIR COMMAND, BLT
SOME CODE TO LOWSEG, RELEASE HISEG BEFORE TRYING
THE RUN COMMAND
$
COMMENT $ SUGGESTIONS
1) INCLUDE VERSION IN REQUIREMENTS FOR A MATCH
$
COMMENT $ KNOWN BUGS
$
SUBTTL ASSEMBLY / ACCUMULATOR DEFINITIONS
ND LN$PDL,^D200 ;PDL SIZE
ND MX$DIR,^D32 ;# ENTRIES IN PRIMARY DIRECTORY BLOCK
LN$DRB==2*MX$DIR ;SIZE OF PRIMARY DIRECTORY BLOCK
ND MY$NAM,'LIBMAN' ;MY NAME
INTERN MY$PFX ;MAKE IT VISIBLE
ND MY$PFX,'LIB' ;MY MESSAGE PREFIX
ND DF$EXT,'LIB' ;DEFAULT LIBRARY EXTENSION
ND DF$BUF,^D6 ;DEFAULT # BUFFERS = 6
ND FT$DDT,0 ;NON-ZERO FOR DEBUGGING (DDT COMMAND)
;DEFINE THE ACCUMULATORS
DEFINE AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>
ZZ==0
AC$ (F) ;FLAGS
AC$ (T1) ;T1-4 ARE TEMPORARY
AC$ (T2)
AC$ (T3)
AC$ (T4)
AC$ (P1) ;P1-4 ARE PERMANENT--MUST BE PRESERVED
AC$ (P2)
AC$ (P3)
AC$ (P4)
AC$ (B) ;CURRENT BLOCK IN LIBRARY
AC$ (L) ;PTR TO INPUT FDB LINKED LIST
N==P3 ;NUMBER/WORD FROM SCAN
C==P4 ;CHARACTER FROM SCAN
P=17 ;PUSHDOWN LIST PTR
SUBTTL FLAG DEFINITIONS
;FLAGS IN LH OF F
DEFINE FLAG$ (FLG)
<FL$'FLG==ZZ
ZZ==ZZ_-1
FL$'FLG==FL$'FLG>
ZZ==(1B0)
FLAG$ (LIB) ;ON WHEN A "USE" OR "CREAT" COMMAND GIVEN
FLAG$ (CRE) ;ON IF "CREATE"
FLAG$ (TYP) ;ON IF TYPE, OFF IF COPY
FLAG$ (RDO) ;READ ONLY
FLAG$ (ONE) ;ON IF "ONEOUT", OFF IF "COPY" OR "TYPE"
FLAG$ (OFG) ;ON IF OUTPUT FILE GIVEN (SET/CLEARED BY CKOFDB)
;I/O CHANNELS
;0 ;NEVER USED BY ME
LIBC==1 ;LIBRARY CHANNEL
INPC==2 ;INPUT
OUTC==3 ;OUTPUT
ILIB==4 ;LIBRARY INPUT CHANNEL FOR USE WITH DELETE AND REPLACE
TMPC==5 ;ONE-SHOT TEMPORARY USES
;OPDEFINES
OPDEF CALL [PUSHJ P,] ;SUBROUTINE CALL
OPDEF JUMPU [JUMPL F,] ;JUMP IF "USE/CREATE" GIVEN
OPDEF JUMPNU [JUMPGE F,] ;JUMP IF NO "USE/CREATE" GIVEN
;OTHER BITS AND STUFF
ATSIGN==(1B13) ;FOR OPENIO
SUBTTL ERROR MACRO DEFINITIONS
;ERROR. ($FLGS,$PFX,$MSG)
;
;$FLGS IS THE COMBINITATION OF THE FOLLOWING BITS:
EF$ERR==0 ;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
EF$FTL==400 ;FATAL ERROR--ABORT AND RESTART
EF$WRN==200 ;WARNING MESSAGE--CONTINUE
EF$INF==100 ;INFORMATIVE MESSAGE--CONTINUE
EF$NCR==40 ;NO FREE CRLF AFTER MESSAGE
DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>
ZZ==0 ;TYPE CODES ARE FROM 1-37
ETYP (DEC) ;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT) ;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX) ;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN) ;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR) ;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL) ;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP (LEB) ;T1 PTS TO 3 WD OPEN BLOCK AND T2 PTS TO LOOKUP BLOCK
EF$MAX==ZZ ;MAX ERROR TYPE
IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>
;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF
NOOP== (CAI) ;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP
DEFINE ERROR. ($FLGS,$PFX,$MSG)
<CALL EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ]
IFN $FLGS&EF$NCR,<JRST X$$'$PFX>]
>
;FATAL. FLGS,PFX,MSG
DEFINE FATAL. ($FLGS,$PFX,$MSG)
<ERROR. (EF$FTL!$FLGS,$PFX,$MSG)>
;WARN. FLGS,PFX,MSG
DEFINE WARN. ($FLGS,$PFX,$MSG)
<ERROR. (EF$WRN!$FLGS,$PFX,$MSG)>
;INFO. FLGS,PFX,MSG
DEFINE INFO. ($FLGS,$PFX,$MSG)
<ERROR. (EF$INF!$FLGS,$PFX,$MSG)>
;STOPX$ STOPS THE PROGRAM QUICKLY WITH A HALT <CODE>
DEFINE STOPX$
<HALT STOP$N
STOP$N==STOP$N+1>
SUBTTL OTHER MACRO DEFINITIONS
;SAVE$ SAVES DATA ON THE STACK
DEFINE SAVE$ (X)
<XLIST
IRP X,<PUSH P,X>
LIST>
;RESTR$ RESTORES DATA FROM THE STACK
DEFINE RESTR$ (X)
<XLIST
IRP X,<POP P,X>
LIST>
;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE
DEFINE U ($NAME,$WORDS<1>)
<$NAME: BLOCK $WORDS>
;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG
DEFINE STRNG$ (S)
<MOVEI T1,[ASCIZ \S\]
CALL .TSTRG##>
;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY
DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>
;JUMPCR (LOC) JUMPS TO LOC IF CREATE COMMAND
DEFINE JUMPCR (LOC)
<TLNE F,FL$CRE
JRST LOC>
;JUMPNC (LOC) JUMPS TO LOC IF NOT CREATE COMMAND
DEFINE JUMPNC (LOC)
<TLNN F,FL$CRE
JRST LOC>
;JMPRDO (LOC) JUMPS TO LOC IF READ ONLY
DEFINE JMPRDO (LOC)
<TLNE F,FL$RDO
JRST LOC>
SUBTTL MAIN-LINE PROGRAM
TWOSEG
RELOC 400000
STOP$N==0 ;INITIALIZE THE FATAL COUNTER
LIBMAN: TDZA T1,T1 ;FLAG NORMAL START
MOVEI T1,1 ;FLAG CCL START
MOVEM T1,OFFSET ;SAVE FOR SCAN
STORE 17,0,16,0 ;CLEAR ACS
STORE 17,FW$ZER,LW$ZER,0 ;AND CORE WHICH SHOULD BE CLEARED
STORE T1,SCN$FO,SCN$LO,-1 ;SET SWITCHES TO DEFAULTS
RESET ;STOP EXTERNAL I/O WHICH MAY BE IN PROGRESS
SKIPA P,.+1 ;SETUP PDL
INIPDP: IOWD LN$PDL,PDLIST
CALL .RECOR## ;RESET CORE ALLOCATION
MOVE T1,ISCNBL ;GET ISCAN BLOCK
CALL .ISCAN## ;INITIALIZE THE COMMAND SCANNER
MOVEM T1,ISCNVL ;REMEMBER WHAT ISCAN RETURNS
SKIPN OFFSET ;CCL ENTRY?
SKIPE TLDVER ;OR ALREADY TOLD VERSION?
JRST LIBM.0 ;ONE OR THE OTHER
STRNG$ <LIBMAN %> ;NO--DO IT NOW
MOVE T1,.JBVER
CALL .TVERW##
CALL .TCRLF##
SETOM TLDVER ;SO WE ONLY TELL VERSION ONE TIME
RESTRT:
LIBM.0: SKIPE FLTMPC ;HAVE WE ALREADY TRIED TO READ NNNLRL.TMP?
JRST LIBM.1 ;YES--JUST GO CALL .VSCAN
SETOM FLTMPC ;NO--FLAG DOING IT TO PREVENT A LOOP
OPEN TMPC,[EXP .IODMP,'DSK ',0] ;GET DISK IN DUMP MODE
JRST LIBM.1 ;FAILED--GIVE UP
CALL MAKCCL ;GET CCL NAME
HRRI T1,'LRL' ;LIBMAN REMEMBER LIBRARY
MOVSI T2,'TMP' ;COMPLEETE NAME
SETZB T3,T4
LOOKUP TMPC,T1 ;SEE IF IT LIVES
JRST LIBM0A ;NO--QUIT
CALL $GTFDB ;GET AN FDB TO READ INTO
MOVEM T1,LIBFDB ;REMEMBER IT FOR ASECOND
HRLI T1,-.FXLEN ;FORM IOWD
HRRI T1,-1(T1) ;...
SETZ T2, ;END OF I/O LIST
INPUT TMPC,T1 ;READ FDB
STATZ TMPC,IO.ERR!IO.EOF ;WE SHOULD NOT SEE THESE FLAGS
JRST LIBM0A ;WE DID--ASSUME JUNK
CLOSE TMPC,
MOVE T1,LIBFDB ;RESET T1 TO POINT TO FDB FOR OPENIO
CALL OPENIO ;SEE IF FILE LIVES
CAI LIBC,0(.IOBIN) ;...
JRST LIBM0A ;NO--QUIT NOW
TLO F,FL$LIB ;YES--FLAG WE HAVE A LIBRARY
LIBM0A: RELEASE TMPC, ;FREE UP CHANNELS
RELEASE LIBC, ;IN CASE THEY WERE OPEN
LIBM.1: MOVE T1,VSCNBL ;GET ARG BLOCK FOR .VSCAN
CALL .VSCAN## ;DO THE WORK
CALL .MONRT## ;EXIT TO MONITOR
JRST RESTRT ;GO RESTART
SUBTTL ARGUMENT BLOCKS FOR ISCAN AND VSCAN
ISCNBL: XWD 5, .+1
IOWD N$CMDS,CMDLST
XWD OFFSET,MY$PFX
EXP 0
EXP 0
XWD DOPRMP,0
;ARG BLOCK FOR .VSCAN
VSCNBL: XWD 7, .+1
IOWD VSWTL,VSWTN
XWD VSWTD,VSWTM
XWD 0,VSWTP
EXP -1
EXP 0
EXP 0
EXP 0
;SCAN CALLS HERE TO PROMPT -- T1 NEGATIVE IF CONTINUATION
DOPRMP: SKIPL T1 ;FIRST?
SKIPA T1,PRMPTM ;YES--LOAD UP MESSAGE
MOVSI T1,'# ' ;NO--LOAD UP CONTINUATION
PJRST .TSIXN## ;GO TYPE IT
PRMPTM: XWD MY$PFX,'> '
CMDLST: EXP MY$NAM
N$CMDS==.-CMDLST
;HERE FOR DDT COMMAND IF DEBUGGING
IFN FT$DDT,<$DDT:
SKIPN T1,.JBDDT ;PICK UP/CHECK IF DDT IS LOADED
FATAL. 0,DNL,<DDT NOT LOADED> ;FATAL ONLY SO SCAN WILL CLEAN UP
AOS (P) ;OK--SET TO SKIP BACK
PUSH P,T1 ;SAVE DDT ADDRESS ON PDL
CALL .TCRLF## ;NEW LINE
STRNG$ <DDT> ;ANNOUNCE HIMSELF
POPJ P, ;RETURN TO DDT
DX=: POPJ P, ;DX$X WILL GET BACK TO COMMAND MODE
>;END IFN FT$DDT
SUBTTL SWITCH TABLE
DEFINE SWTCHS,<
SP *ADD,,$ADD,,
SP BUFFER,S.BUFR,.SWDEC##,BUF,FS.NUE
SP CREATE,,$CREAT,,
SP *COPY,,$COPY,,
IFN FT$DDT,<SP DDT,,$DDT,,>
SP DELETE,,$DELET,,
SP DIRECT,,$DIREC,,
SL DSUPER,S.DSUP,SUP,SUPOLD,FS.NUE
SP DVERSI,,$DVERS,,
SP FILDIR,,$FILDIR,,
SL LSUPER,S.LSUP,SUP,SUPOLD,FS.NUE
SP *ONEOUT,,$ONEOU,,
SP READ,,$READ,,
SN REMEMB,S.REML,FS.NUE
SP RENAME,,$RENAM,,
SP *REPLAC,,$REPLAC,,
SL *SUPERS,S.SUPR,SUP,SUPOLD,FS.NUE
SP *TYPE,,$TYPE,,
SP *USE,,$USE,,
>
DM (BUF,^D100,DF$BUF,DF$BUF)
KEYS (SUP,<ALWAYS,OLDER,NEVER>)
ND SUPDEF,SUPOLD ;DEFAULT IN CASE NO /SUPERSEDE
DOSCAN (VSWT)
SUBTTL PROCESS ADD COMMAND
$ADD: JUMPNU E$$NUC ;MUST HAVE USE OR CREATE
JMPRDO E$$IRO ;ILLEGAL IF READ ONLY
CALL .SAVE1## ;PRESERVE P1
AOS (P) ;SET TO SKIP BACK SO SCAN DOESN'T STORE
CALL $GTLST ;READ FILE LIST
JRST E$$NFS ;DID'NT GIVE ONE
MOVE P1,L ;REMEMBER WHERE IT IS
CALL $GTDIR ;READ DIRECTORY
SETZM FILCNT ;CLEAR COUNT OF FILES ADDED
SETZM NOFILR ;CLEAR COUNT OF FILES REJECTED
STRNG$ <FILES ADDED TO LIBRARY:
>
ADDL.L: SETZM WLDPTR ;CLEAR WILD'S TEMP PTR
ADDL.0: HRRZM P1,WLDFIR ;STORE PTR FOR WILD
MOVE T1,LKWLDB ;GET ARG FOR .LKWLD
CALL .LKWLD## ;GET A FILE TO ADD
JRST ADDL.5 ;NOT ANY MORE THIS FDB
MOVE T1,DSKLKP+.RBNAM;GET FILENAME
HLLZ T2,DSKLKP+.RBEXT;AND EXTENSION
MOVE T3,LIBFDB ;GET LIBRARY FDB ADDRESS
HLLZ T4,.FXEXT(T3) ;GET LIBRARY EXTENSION
CAMN T1,.FXNAM(T3) ;SEE IF FILENAMES
CAME T2,T4 ;AND EXTENSIONS ARE THE SAME
SKIPA ;NO--OK TO POSSIBLY ADD TO LIBRARY
JRST ADDL.0 ;YES--DON'T ADD LIBRARY TO ITSELF
CALL IFNDIR ;SEE IF ALREADY IN DIR
JRST ADDL.A ;NO--OK TO ADD IT
SETO T1, ;ALREADY THERE--SEE IF WE SHOULD BITCH
MOVEI T2,-1 ;MASK FOR EXT
XOR T1,.FXNMM(P1) ;SEE IF WILD FILENAME
TDCE T1,[EXP -1] ;...
JRST ADDL.0 ;FILENAME WAS WILD--DON'T COMPLAIN
XOR T2,.FXEXT(P1) ;CHECK EXTENCION
TRCE T2,-1 ;...
JRST ADDL.0 ;EXT WAS WILD--OK
AOS NOFILR ;COUNT A FILE AS REJECTED
MOVEI T1,DSKOPN ;POINT AT OPEN BLOCK
MOVEI T2,DSKLKP ;AND LOOKUP BLOCK
WARN. EF$LEB!EF$NCR,FAL,<FILE ALREADY IN LIBRARY - >
STRNG$ < - IGNORING
>
X$$FAL: JRST ADDL.0 ;GET NEXT
;HERE WHEN WILD SAYS NO MORE FILES TO BE FOUND FROM THIS FDB
ADDL.5: HRRZ P1,-1(P1) ;CHAIN TO NEXT FDB
JUMPN P1,ADDL.L ;JUMP IF MORE TO COME
SKIPN FILCNT ;DONE--SEE IF WE DID ANYTHING
CALL WRNOFM ;NO--TELL NO FILES MATCH
MOVE T1,L ;NO--COPY LST ADDR
PJRST GIVLST ;GO FREE IT UP AND RETURN
LKWLDB: XWD 5,.+1 ;ARG PTR FOR .LKWLD
XWD WLDFIR,0 ;LOC HAVING FIRST WORD OF SPECS, 0
XWD DSKOPN,DSKLKP ;OPEN BLOCK,LOOKUP BLOCK
XWD .FXLEN,.RBTIM+1 ;SIZE OF SCAN BLOCK,SIZE OF LOOKUP BLOCK
XWD 0,WLDPTR ;CHANNEL+FLAGS,PTR FOR WILD COMMUNICATION
EXP 0 ;ROUTINE TO NOTIFY AT END OF DIR
X$$NFM=$POPJ ;JUST RETURN IF /MESSAGE:PREFIX
WRNOFM: SKIPE NOFILR ;DON'T MESSAGE IF FILES WERE REJECTED
POPJ P, ;REJECTED FILES--HE ALREADY KNOWS
WARN. EF$NCR,NFM,<NO FILES FOUND TO MATCH >
CALL $TYIOL ;TYPE THE LIST
PJRST .TCRLF## ;NEW LINE AND EXIT
;HERE TO ADD FILE TO LIBRARY
ADDL.A: CALL DSKOPI ;OPEN DISK FILE FOR INPUT
JRST ADDL.X ;FILE NOT FOUND--CLOSE OUT AND GET NEXT FILE
CALL .CHKTM## ;CHECK /BEFORE/SINCE/ABEFORE/ASINCE
JRST ADDL.X ;LOSE--CLOSE OUT AND GET NEXT FILE
CALL GETNBF ;GET # BUFFERS FOR DSK INPUT
MOVE T2,[XWD OPNBLK,IBHR] ;...
CALL .ALCBF##
SETZ T1, ;FLAG WE WANT TO APPEND TO LIBRARY
CALL OLIBUP ;OPEN LIBRARY IN APPEND MODE
HRLI P1,(B) ;REMEMBER FIRST BLOCK FOR FILE
PUSH P,DSKLKP+.RBPPN ;SAVE ORIGINAL PPN AND THEN
MOVE T1,.MYPPN## ; PUT MY PPN INTO LKPBLK
MOVEM T1,DSKLKP+.RBPPN;BEFORE WE COPY IT TO LIBRARY
MOVSI T1,DSKLKP-1 ;SETUP SO WE CAN COPY DSKLKP TO LIB
HRR T1,OBHR+.BFPTR ;...
AOBJP T1,.+1 ;OFF BY ONE IN BOTH HALFS
MOVEI T2,.RBTIM+1(T1) ;SET END OF BLT (REST OF BLOCK WILL BE 0'S)
CALL DCPY.1 ;COPY LKPBLK AND THEN FILE
POP P,DSKLKP+.RBPPN ;RESTORE ORIGINAL PPN
;HERE AT END OF ADDITION
CALL OLBCLS ;CLOSE LIB
CALL DSKICL ;AND INPUT FILE
MOVE T1,DSKLKP+.RBNAM;GET FILENAME
HLLZ T2,DSKLKP+.RBEXT;AND EXTENSION
HLRZ B,P1 ;GET FIRST BLOCK IN FILE BACK
CALL AD2DIR ;ADD TO INCORE DIRECTORY
TLZ F,FL$CRE ;LIBRARY EXISTS--CLEAR CREATE FLAG
AOS FILCNT ;COUNT A FILE AS DONE
MOVEI T1,DSKOPN ;POINT TO OPEN BLOCK
MOVEI T2,DSKLKP ;AND LOOKUP BLOCK
CALL .TOLEB## ;TYPE NAME TO USER
CALL .TCRLF##
JRST ADDL.0 ;GO ADD MORE FILES
ADDL.X: CALL DSKICL ;CLOSE OUT DISK FILE
JRST ADDL.0 ;GO GET NEXT THING
;CALL HERE TO DO THE MAJOR COPY LOOP
DOCOPY: CALL XCTIO ;GET A BLOCK
IN INPC, ;XCT'D FROM DOWN BELOW
POPJ P, ;END OF FILE
HRLZ T1,IBHR+.BFPTR ;GET BUFFER ADDRESSES
HRR T1,OBHR+.BFPTR ;...
AOBJP T1,.+1 ;OFF BY ONE
MOVEI T2,200(T1) ;SET END OF BLT
DCPY.1: BLT T1,-1(T2) ;ZIP THE BLOCK OVER
MOVEI T1,200 ;UPDATE OUTPUT STUFF
ADDM T1,OBHR+.BFPTR ;...
SETZM OBHR+.BFCTR
CALL XCTIO ;WRITE BLOCK TO LIB
OUT LIBC, ;...
STOPX$ ;***TEMP
AOJA B,DOCOPY ;COUNT BLOCKS INTO LIBRARY
E$$IRO: FATAL. 0,IRO,<ILLEGAL COMMAND FOR READ-ONLY LIBRARY>
SUBTTL PROCESS COPY/TYPE COMMANDS
$COPY: TLZA F,FL$TYP ;FLAG COPY NOT TYPE
$TYPE: TLO F,FL$TYP ;FLAG TYPE
JUMPNU E$$NUC ;JUMP IF NO USE COMMAND
JUMPNC CTYP.0 ;JUMP IF NOT CREATE
E$$LIE: FATAL. 0,LIE,<LIBRARY IS EMPTY> ;NOTHING TO DO
CTYP.0: CALL .SAVE1## ;SAVE P1
AOS (P) ;SET TO SKIP BACK
TLZ F,FL$ONE ;FLAG COPY/TYPE AND NOT ONEOUT
CALL $GTIOL ;GET I/O LIST
JRST E$$NFS ;NEED A LIST THO
MOVEI T1,OPNTTO ;ASSUME TYPING
TLNN F,FL$TYP ;ARE WE TYPEING?
MOVEI T1,CKOFDB ;NO--DO DIFFERENTLY
CALL (T1) ;CALL THE RIGHT ROUTINE
CALL $GTDIR ;CREATE IN-CORE DIRECTORY
MOVEI T1,6 ;USE SIX INPUT BUFFERS
CALL OLIBIN ;OPEN THE LIBRARY
JRST [FATAL. (0,CFL,<CAN'T FIND LIBRARY>) ;???
PJRST CTYP.X] ;CLEAN UP AND EXIT
SETZM FILCNT ;CLEAR FILE COUNT
SETZM NOFILR ;CLEAR REJECTED FILE COUNT
MOVEI T1,[ASCIZ/FILES COPIED FROM LIBRARY:
/]
TLNN F,FL$TYP ;UNLESS WE ARE TYPING
CALL .TSTRG## ; THEN TELL USER THE FILES WE COPIED
CALL $MKLST ;MAKE THE LST
CALL CPYTYF ;(THIS INSTR IS XCT'D BY $MKLST--COROUTINE)
SKIPN FILCNT ;FIND ANY FILES?
CALL WRNOFM ;TELL NO FILES MATCHED
CTYP.X: CALL GIVIOL ;GIVE OUTFDB AND INPUT LIST BACK
TLZE F,FL$TYP ;WERE WE JUST TYPEING
CALL CLSTTO ;YES--CLOSE OUTPUT
PJRST ILBCLS ;GO CLOSE LIBRARY AND RETURN
;COROUTINE CALLED BY $MKLST TO DO THE WORK
;CALLED WITH P3=PTR TO EXT OF FILE IN INCORE DIRECTORY
;AND P4=PTR TO INPUT FDB WHICH MATCHES IT
CPYTYF: CALL .SAVE2## ;PRESERVE P1-2
HRRZM P4,IFDBAD ;SAVE FOR .SCWLD
TLNE F,FL$TYP!FL$ONE ;ARE WE TYPING OR "ONEOUTING"?
JRST CPTF.3 ;YES--SKIP SOME
HRLZ T1,OUTFDB ;BLOT OUTFDB TO KNOWN LOC
TLNN F,FL$OFG ;SEE IF OUTPUT FILE GIVEN
HRLZ T1,P4 ;NO--USE INPUT FDB THAT MATCHES
HRRI T1,OFDB
BLT T1,OFDB+.FXLEN-1
CPTF.3: HRRZ T1,IBHR+.BFADR ;SETUP TO CLEAR USE BITS
CALL CLRUSE ;DO IT
WAIT LIBC, ;XCT'D BY CLRUSE
HRRZ B,(P3) ;GET BLOCK # OF LKPBLK IN FILE
USETI LIBC,(B) ;SET TO READ IT
CALL XCTIO ;READ IT
IN LIBC, ;XCT'D BY XCTIO
JRST CPYIFL ;INCORRECTLY FORMATTED LIB
HRRZ T1,IBHR+.BFPTR ;GET THE LKPBLK ADDR
MOVSI T1,1(T1) ;+1 AND TO LH
HLRZ P1,T1 ;REMEMBER ADDRESS FOR LATER
MOVEI T2,.RBTIM ;THIS SHOULD BE IN .RBCNT
CAME T2,.RBCNT(P1) ;MAKE SURE IT IS
JRST CPYIFL ;NO--GO DIE
TLNE F,FL$TYP ;ARE WE TYPEING?
JRST CPTF.4 ;YES--NO NEED TO CALL .SCWLD
TLNE F,FL$ONE ;IS THIS A "ONEOUT"?
JRST CPTF.5 ;YES--OUTPUT FILE IS ALREADY OPEN
HRRI T1,LKPBLK ;SET IN WHERE IT GOES TO
BLT T1,LKPBLK+.RBTIM ;ZIP IT OVER
MOVSI T1,'DSK' ;JUST USE DSK FOR NOW
MOVEM T1,OPNBLK+.OPDEV;
MOVE T1,SCWABL ;SETUP FOR .SCWLD
CALL .SCWLD## ;DO SECONDARY WILDCARDING
POPJ P, ;MESSAGE ALREADY ISSUED--JUST RETURN
MOVE T1,DSKOPN+.OPDEV;GET THE DEVICE NAME
DEVCHR T1, ;GET CHARACTERISTICS
TXNN T1,DV.M13 ;CAN IT DO BINARY MODE I/O?
JRST CPYN13 ;NO--GO DIE OUT
LDB T1,[POINTR(.RBPRV(P1),RB.MOD)] ;GET MODE OF FILE
MOVEM T1,DSKOPN+.OPMOD;SET THE MODE
MOVSI T1,OBHR ;AND THE BUFFER HEADER
MOVEM T1,DSKOPN+.OPBUF;...
OPEN OUTC,DSKOPN ;OPEN THE CHANNEL
PJRST E.SCO## ;REPORT OPEN ERROR
HRRZ T1,.RBEXT(P1) ;GET GOOD BITS
HRRM T1,DSKLKP+.RBEXT;AND SET IN ENTER BLOCK
MOVE T1,.RBPRV(P1) ;GET PRIV WORDS
TLZ T1,777000 ;CLEAR PROT SINCE .SCWLD SETS IT UP
IORM T1,DSKLKP+.RBPRV;SO JUST SET EVERYTHING ELSE
MOVE T1,.RBSPL(P1) ;COPY REST OF ARGS WE CAN SET
MOVEM T1,DSKLKP+.RBSPL
MOVE T1,.RBALC(P1)
MOVEM T1,DSKLKP+.RBALC;
;***DON'T SET .RBEST DUE TO MON BUG
;IF .RBEST .GT. .RBALC!!!***
MOVE T1,.RBNCA(P1) ;NON-PRIV CUST ARG
MOVEM T1,DSKLKP+.RBNCA;IN CASE ANYONE USES IT
MOVE T1,.RBVER(P1) ;DON'T FORGET THE VERSION
SKIPN DSKLKP+.RBVER ;BUT DON'T OVERWRITE IF SPECIFIED IN COMMAND
MOVEM T1,DSKLKP+.RBVER;...
SKIPG T2,S.DSUP ;PICKUP DSUPERSEDE SWITCH IF GIVEN
MOVE T2,S.SUPR ;ELSE USE THE /SUPERSEDE VALUE
SKIPG T2 ;SEE IF WE GOT A /SUPERSEDE VALUE
MOVEI T2,SUPDEF ;NO--USE THE DEFAULT
SKIPE .RBTIM(P1) ;IS CREATION DATE/TIME ZERO? (IE FROM UFLIP)
CAIN T2,SUPALW ;WAS IT /SUPERSEDE:ALWAYS?
JRST CPTYEN ;YES--FORGET THE DATE CHECKS
MOVE T1,[XWD DSKOPN,TMPOPN] ;NO--MUST CHECK IF FILE ALREADY LIVES
BLT T1,TMPXEN ;SO MAKE A DESTROYABLE COPY
OPEN TMPC,TMPOPN ;OPEN THE DEVICE
JRST CPTYEN ;??? JUST IGNORE THE WHOLE THING
LOOKUP TMPC,TMPLKP ;SEE IF FILE ALREADY LIVES
JRST CPTLER ;DOESN'T OR SOME ERROR--CHECK IT OUT
CPTYCS: CAIN T2,SUPNEV ;IT LIVES--WAS IT /SUPERSEDE:NEVER
PJRST WRNFNC ;YES--TELL USER OF /SUPERSEDE FAILURE
MOVE T1,TMPLKP+.RBTIM;NO--GET INTERNAL CREATION TIME
CAML T1,.RBTIM(P1) ;MUST BE OLDER THAN ONE IN LIBRARY
PJRST WRNFNC ;NO--SAME COPY OR NEWER--IGNORE IT
CPTYEN: ENTER OUTC,DSKLKP ;WRITE THE FILE
PJRST E.SCL## ;REPORT ENTER ERROR
SETSTS OUTC,.IOBIN ;BACK TO BUFFERED BINARY
MOVEI T1,.IOBIN ;SET IN OPEN BLOCK ALSO
HRRM T1,DSKOPN+.OPMOD;FOR .ALCBF
CALL GETNBF ;GET CORRECT # BUFFERS
MOVE T2,[XWD DSKOPN,OBHR] ;FOR .ALCBF
CALL .ALCBF## ;ALLOCATE BUFFERS FOR OUTPUT
OUTPUT OUTC, ;DUMMY OUTPUT TO GET HEADER RIGHT
JRST CPTF.5 ;SKIP TTY CODE
CPTF.4: MOVEI T1,"[" ;TELL WHAT FILE WE ARE TYPEING
CALL .TCHAR## ;...
MOVEI T1,[EXP .IODMP,'DSK ',0];SETUP FAKE OPEN BLOCK
MOVEI T2,(P1) ;POINT TO THE LKPBLK IN THE BUFFER
CALL .TOLEB## ;TYPE OPEN LOOKUP BLOCK
STRNG$ <]
> ;CLOSE IT OUT
CPTF.5: MOVE P1,.RBSIZ(P1) ;GET SIZE OF FILE IN WORDS
ADDI P1,177 ;ROUND UP
LSHC P1,-7 ;GET BLOCKS, SAVE REMAINDER WORDS
LSH P2,-35 ;GET REMAINDER WORDS - 1
AOJ P2, ;NOW HAVE CORRECT # WORDS FOR LAST BLOCK
AOJ B, ;INC B TO NEXT BLOCK
;COPY THE FILE FROM THE LIBRARY OUT TO WHATEVER
CPTF.6: SOJL P1,CPTF.X ;WATCH FOR THE END
CALL XCTIO ;READ NEXT LIB RECORD
IN LIBC, ;XCT'D
JRST [CALL DSKOCL ;??? CLOSE DISK FILE
JRST CPYIFL] ;AND GO DIE
SKIPN P1 ;SKIP IF NOT LAST BLOCK
MOVEM P2,IBHR+.BFCTR ;YES--SET TO ONLY DO SO MANY WORDS
MOVE T1,IBHR+.BFCTR ;GET SIZE OF BUFFER DATA
CPTF.8: MOVE T2,OBHR+.BFCTR ;AND SIZE OF OUTPUT BUFFER
TLNE F,FL$TYP ;ARE WE TYPEING?
IDIVI T2,5 ;YES--CVT CHARS TO WORDS
CAMLE T1,T2 ;ROOM FOR ALL?
MOVE T1,T2 ;NO--MOVE WHAT WE CAN
MOVN T2,T1 ;GET - WORDS
ADDM T2,IBHR+.BFCTR ;UPDATE INPUT COUNTER
TLNE F,FL$TYP ;TYPEING?
IMULI T2,5 ;YES--BACK TO CHARACTERS
ADDM T2,OBHR+.BFCTR ;UPDATE OUTPUT COUNTER
HRLZ T2,IBHR+.BFPTR ;GET INPUT POINTER
HRR T2,OBHR+.BFPTR ;AND OUTPUT
AOBJP T2,.+1 ;OFF BY ONE
ADDM T1,IBHR+.BFPTR ;UPDATE INPUT PTR
ADDB T1,OBHR+.BFPTR ;AND OUTPUT AND GET END ADR OF BLT
BLT T2,(T1) ;MOVE THE DATA
TLNE F,FL$ONE ;IF THIS IS "ONEOUT"
SKIPG OBHR+.BFCTR ;YES--SEE IF LAST BUFFER IS FULL BUFFER
SKIPA ;NOT ONEOUT OR LAST BUFFER IS FULL
JUMPE P1,CPTF.X ;ONEOUT AND LAST BUFFER--THEN DON'T OUTPUT IT
;SO WE DON'T FILL BLOCK WITH ZEROS
CALL XCTIO ;WRITE THE BUFFER
OUT OUTC, ;XCT'D
STOPX$ ;***FULL??
SKIPLE T1,IBHR+.BFCTR ;ANY MORE IN THIS INPUT BUFFER?
JRST CPTF.8 ;YES--GO GET IT
AOJA B,CPTF.6 ;NO--INC BLOCK COUNTER AND GET NEXT BLOCK
CPTF.X: TLNE F,FL$TYP!FL$ONE ;UNLESS WE ARE TYPEING OR ONEOUTING
JRST CPTFX2 ;YES--SKIP AHEAD SOME
MOVE T1,-1(P3) ;GET FILE NAME
CALL .TSIXN## ;TYPE IT OUT
CALL .TDOT ;AND A DOT
HLLZ T1,(P3) ;GRAB THE EXTENSION
HRRI T1,'=> ' ;FORM RH TOO
CALL .TSIXN## ;TYPE IT OUT
MOVEI T1,DSKOPN ;GET OPEN BLOCK ADDR
MOVEI T2,DSKLKP ;AND LOOKUP BLOCK
CALL $TLBVP ;TYPE LOOKUP BLOCK, VERSION AND PROTECTION
CALL .TCRLF## ;NEW LINE NOW
CALL DSKOCL ;CLOSE OUTPUT
CPTFX2: AOS FILCNT ;COUNT A FILE AS DONE
POPJ P, ;ALL DONE
;HERE IF CAN'T DO BINARY I/O
CPYN13: MOVEI T1,OPNBLK ;GET OPEN BLOCK
MOVEI T2,DSKLKP ;AND LOOKUP BLOCK
ERROR. EF$LEB,CDB,<CAN'T DO BINARY I/O TO >
POPJ P, ;JUST RETURN
;HERE WHEN FILE IN BAD FORMAT
CPYIFL: CALL CTYP.X ;CLEAN UP
PJRST E$$IFL ;REPORT BAD FORMAT
;ARG BLOCK FOR .SCWLD
SCWABL: XWD 4,.+1
XWD IFDBAD,[OFDB] ;SCAN FILE SPEC
XWD OPNBLK,DSKOPN ;OPEN BLOCK
XWD LKPBLK,DSKLKP ;LOOKUP/ENTER BLOCK
XWD [0],.RBTIM+1 ;DEFAULT OUTPUT EXT,,LENGTH OF ENTER BLOCK
;HERE WHEN LOOKUP FOR CHECKING /SUPERSEDE FAILS
CPTLER: RELEASE TMPC, ;CLOSE THE CONNECTION
HRRZ T1,TMPLKP+.RBEXT;GET FAIL CODE
JUMPE T1,CPTYEN ;IF FILE NOT FOUND THEN GO AHEAD
JRST CPTYCS ;ELSE GO CHECK DATE/TIME STUFF
;HERE TO REPORT A FILE NOT COPIED--T2 HAS SUPXXX
WRNFNC: AOS NOFILR ;COUNT A FILE AS REJECTED
SAVE$ T2 ;SAVE T2
MOVEI T1,TMPOPN ;POINT AT OPEN BLOCK
MOVEI T2,TMPLKP ;AND LOOKUP BLOCK
WARN. EF$NCR!EF$LEB,FNC,<FILE NOT COPIED: >
MOVE T2,(P) ;GET SUPXXX
CALL TSUPSW ;TYPE /SUPERSEDE:XXXXX
X$$FNC: POP P,T2 ;KEEP THE STACK STRAIGHT
;HERE TO RELEASE CHANNELS AND RETURN BECAUSE SUPERSEDE TEST FAILED
CPTOLD: RELEASE TMPC, ;CLOSE TEMP CHANNEL
RELEASE OUTC, ;AND OUTPUT
POPJ P, ;RETURN
;TYPE /SUPERSEDE:XXXXX
;ENTER WITH SUPXXX IN T2
TSUPSW: STRNG$ </SUPERSEDE:>
MOVE T1,SUP.T-1(T2) ;GET SIXBIT REPRESENTATION OF IT
CALL .TSIXN## ;TYPE IT
PJRST .TCRLF## ;AND NEW LINE EXIT
SUBTTL PROCESS DELETE COMMAND
$DELET: TLZA F,FL$TYP ;FLAG DELETE
$REPLA: TLO F,FL$TYP ;RATHER THAN A REPLACE
JUMPNU E$$NUC ;NEED A USE COMMAND
JUMPCR E$$LIE ;AND NOT CREATE
JMPRDO E$$IRO ;AND CERTAINLY NOT READ ONLY
CALL .SAVE2## ;OK--ITS COOL--SAVE REGISTERS
AOS (P) ;AND SET TO SKIP SO SCAN DOESN'T WIPE FLAGS
CALL $GTLST ;GET A FILE LIST
JRST E$$NFS ;MUST HAVE A LIST
CALL $GTDIR ;CREATE INCORE DIR IF NOT DONE ALREADY
SETZM FILCNT ;CLEAR FILE COUNT
SETZM NOFILR ;CLEAR # FILES REJECTED
CALL $MKLST ;MAKE THE LIST OF FILES TO DELETE/REPLACE
CALL RDLSUB ;XCT'D BY $MKLST
SKIPE FILCNT ;DID WE GET A LST
JRST DLRP.2 ;YES
CALL WRNOFM ;NO FILES MATCHED
PJRST GIVIOL ;GIVE I/O LISTS AND RETURN
DLRP.2: MOVE T1,LIBFDB ;GET THE LIBRARY FOR INPUT
CALL OPENIO ;...
CAI ILIB,LBHR(.IOBIN)
JRST DLRPNL ;NO LIBRARY!!!
CALL GETNBF ;GET BUFFER COUNT
MOVE T2,[XWD OPNBLK,LBHR]
CALL .ALCBF##
MOVE T1,LIBFDB ;SET TO REWRITE LIBRARY
CALL OPENIO
CAI LIBC,@OBHR(.IOBIN) ;OPEN FOR OUTPUT
JFCL ;SHOULD ALWAYS CPOPJ2 FOR WRITING
CALL GETNBF ;GET BUFFER COUNT
MOVE T2,[XWD OPNBLK,OBHR]
CALL .ALCBF##
OUTPUT LIBC, ;DO A DUMMY OUTPUT
MOVEI B,1 ;INIT BLOCK COUNTER
STRNG$ <FILES > ;SETUP HEADER
MOVEI T1,[ASCIZ/DELETED/]
TLNE F,FL$TYP ;SEE IF DELETING OR REPLACING
MOVEI T1,[ASCIZ/REPLACED/]
CALL .TSTRG##
STRNG$ <:
>
;NOW LOOP OVER THE INPUT LIBRARY AND DELETE OR REPLACE AS NEEDED
DLRP.4: CALL XCTIO ;GET A LKPBLK FROM INPUT DIR
IN ILIB, ;XCT'D
JRST DLRPDN ;EOF--WE ARE DONE
MOVE P1,LBHR+.BFPTR ;ADDRESS THE BUFFER
AOJ P1,
MOVE T1,.RBCNT(P1) ;GET THE COUNT
CAIE T1,.RBTIM ;MUST BE THIS
JRST DLRIFL ;OR WE HAVE A BAD LIBRARY
MOVE P2,.RBSIZ(P1) ;GET FILE SIZE IN WORDS
ADDI P2,177 ;ROUND UP
LSH P2,-7 ;P2=# BLOCKS NEEDED TO HOLD FILE
MOVE T1,.RBNAM(P1) ;GET FILENAME
HLLZ T2,.RBEXT(P1) ;AND EXTENSION
MOVE T3,LSTPTR ;THIS IS WHERE THE LST IS
CALL IFNLST ;SEE IF THIS FILE IS DESTINED TO BE DELETED
JRST DLRP.8 ;NO--JUST COPY TO NEW LIBRARY
TLNN F,FL$TYP ;ARE WE REPLACING OR DELETING?
JRST DLRP.7 ;DELETING--JUST SKIP TO NEXT LKPBLK
HRLZ T1,(T3) ;GET FDB POINTER
HRRI T1,OFDB ;AND WHERE TO STORE IT
BLT T1,OFDB+.FXLEN-1;MAKE A COPY WE CAN SCRIBBLE ON
MOVE T1,.RBNAM(P1) ;GET THE FILENAME
MOVEM T1,OFDB+.FXNAM ;SET IN FDB
HLLZ T2,.FXEXT(P1) ;AND THE XTENSION
HLLOM T2,OFDB+.FXEXT ;SET IT AND MASK
SETOM OFDB+.FXNMM ;SET FILENAME MASK TO ALL ONES
MOVEI T1,OFDB ;POINT AT FDB FOR OPENIO
CALL OPENIO ;OPEN FILE FOR READING
CAI INPC,IBHR(.IOBIN)
JRST DLRP.8 ;??? IT DISSAPPEARED
SKIPG T2,S.LSUP ;PICKUP/CHECK LSUPERSEDE ARG IF GIVEN...
MOVE T2,S.SUPR ;GET SUPERSEDE ARGUMENT
SKIPG T2 ;DID WE GET A /SUPERSEDE?
MOVEI T2,SUPDEF ;NO--SUPPLY THE DEFAULT
SKIPE .RBTIM(P1) ;WAS CREATE DATE 0 (IE FROM UFLIP)?
CAIN T2,SUPALW ;/SUPERSEDE:ALWAYS?
JRST DLRP.6 ;YES--GO DO IT
MOVE T1,LKPBLK+.RBTIM;NO--GET DISK FILE CREATION DATE/TIME
CAMLE T1,.RBTIM(P1) ;SEE IF NEWER THAN ONE IN LIBRARY
JRST DLRP.6 ;YES--GO REPLACE IT
PUSH P,T2 ;NO--SAVE SUPXXX
MOVEI T1,OPNBLK ;POINT AT OPEN BLOCK
MOVEI T2,LKPBLK
AOS NOFILR ;COUNT A REJECTED FILE
WARN. EF$NCR!EF$LEB,FNR,<FILE NOT REPLACED: >
MOVE T2,(P) ;GET /SUPERSEDE VALUE
CALL TSUPSW ;TYPE /SUPERSEDE:XXX AND NEW LINE
X$$FNR: POP P,T2 ;KEEP STACK STRAIGHT
JRST DLRP8A ;GO IGNORE THIS FILE
DLRP.6: CALL GETNBF ;FIND # BUFFERS TO SETUP
MOVE T2,[XWD OPNBLK,IBHR] ;...
CALL .ALCBF##
MOVSI T1,LKPBLK-1
HRR T1,OBHR+.BFPTR ;COPY LKPBLK TO NEW LIBRARY
AOBJP T1,.+1 ;...
MOVEI T2,.RBTIM+1(T1) ;SET END OF BLT
HRLI P1,(B) ;SAVE OLD B
CALL DCPY.1 ;REPLACE THE FILE
CALL DSKICL ;CLOSE OUT DISK INPUT FILE
HLRZ B,P1 ;GET B BACK
DLRP.7: MOVE T1,.RBNAM(P1) ;GET FILENAME WE ARE DELETING OR REPLACING
CALL .TSIXN##
CALL .TDOT
HLLZ T1,.RBEXT(P1)
CALL .TSIXN##
CALL .TCRLF##
HRRZ T1,LBHR+.BFADR ;SETUP TO CLEAR USE BITS
CALL CLRUSE
WAIT ILIB, ;XCT'D
ADDI B,1(P2) ;ADVANCE TO NEXT LKPBLK
USETI ILIB,(B) ;...
JRST DLRP.4 ;GO HANDLE NEXT LIBRARY ENTRY
;HERE TO JUST COPY FROM INPUT LIBRARY TO OUTPUT LIBRARY
DLRP8A: RELEASE INPC, ;CLOSE OUT INPUT CHANNEL
DLRP.8: MOVSI T1,-1(P1) ;SETUP BLT
AOJA P2,DLRP10 ;COUNT LKPBLK AND GO DO IT
DLRP.9: CALL XCTIO ;GET NEXT BLOCK FOR THIS FILE IN LIB
IN ILIB, ;XCT'D
JRST DLRIFL ;SNH
HRLZ T1,LBHR+.BFPTR ;BEGIN CTL WORD
DLRP10: HRR T1,OBHR+.BFPTR
AOBJP T1,.+1
MOVEI T2,200(T1) ;END OF BLT
BLT T1,-1(T2) ;MOVE IT
MOVE T1,OBHR+.BFCTR ;GET THE COUNT
ADDM T1,OBHR+.BFPTR ;ADJUST PTR
SETZM OBHR+.BFCTR ;AND COUNTER
CALL XCTIO ;WRITE THE BLOCK
OUT LIBC, ;TO NEW LIBRARY
STOPX$ ;SNH
ADDI B,1 ;MOVE TO NEXT BLOCK
SOJG P2,DLRP.9 ;GO IF WE NEED TO COPY MORE
JRST DLRP.4 ;NO--ALL DONE
;HERE WHEN WE ARE ALL DONE
DLRPDN: CALL OLBCLS ;CLOSE OUTPUT LIBRARY
DLRPD0: RELEASE ILIB, ;CLOSE INPUT
MOVEI T1,LBHR ;SETUP TO FREE BUFFERS
CALL TSTBHR ;FREE BUFFERS
CALL ZAPDIR ;ZERO INCORE DIR SO WE WILL REREAD IT
MOVE T1,LSTPTR ;FREE LST
CALL GIVLST
SETZM LSTPTR ;MAKE SURE NO MORE
PJRST GIVIOL ;GIVE BACK I/O LISTS AND EXIT
;HERE IF BAD FORMAT IN INPUT LIBRARY
DLRIFL: RELEASE LIBC, ;MAKE ALL THE WORK DISSAPPEAR
CALL OLBCL2 ;FREE BUFFERS
CALL DLRPD0 ;CLOSE INPUT
PJRST E$$IFL ;REPORT BAD FORMAT
DLRPNL: STOPX$ ;NO LIBRARY????
;COROUTINE TO SETUP LST FOR DELETE AND REPLACE
RDLSUB: TLNN F,FL$TYP ;ARE WE REPLACING?
JRST RDLS.2 ;NO--JUST ENTER INTO LST
MOVSI T1,(P4) ;SETUP TO COPY FDB
HRRI T1,OFDB ;TO SOMEWHERE WE CAN WRITE ON IT
BLT T1,OFDB+.FXLEN-1;ZIP
MOVE T1,-1(P3) ;GET FILENAME
MOVEM T1,OFDB+.FXNAM
SETOM OFDB+.FXNMM ;SET SO STOPN DOESN'T COMPLAIN
HLLZ T1,(P3) ;GET EXTENSION
HLLOM T1,OFDB+.FXEXT
MOVSI T1,.FXLEN ;CONVERT TO LKPBLK
HRRI T1,OFDB ;...
MOVEI T2,OPNBLK
MOVE T3,[XWD .RBTIM+1,LKPBLK]
CALL .STOPN## ;CONVERT THEM
STOPX$ ;SNH
MOVEI T1,.IODMP ;MIGHT AS WELL
MOVEM T1,OPNBLK+.OPMOD
SETZM OPNBLK+.OPBUF ;NO BUFFERS
OPEN INPC,OPNBLK ;GET THE DEVICE
JRST RDLSOE ;CAN'T OPEN IT!
MOVEI T1,.RBTIM
MOVEM T1,LKPBLK+.RBCNT;SET COUNT
LOOKUP INPC,LKPBLK ;FIND THE FILE
JRST RDLSLE ;CAN'T
RELEASE INPC, ;DONE FOR NOW
RDLS.2: MOVE T1,-1(P3) ;GET THE FILENAME
HLLZ T2,(P3) ;AND THE EXTENSION
MOVEI T3,LSTPTR ;AND THE LIST TO ADD IT TO
MOVE B,P4 ;SET FDB ADDR IN RH OF EXT WORD
CALL AD2LST ;ADD INTO LST
AOS FILCNT ;COUNT FILE
POPJ P, ;RETURN FOR NEXT FILE
RDLSOE: MOVEI T1,OFDB ;POINT AT FDB
WARN. EF$FIL,DOE,<DEVICE OPEN ERROR ON >
AOS NOFILR ;COUNT A REJECTED FILE
POPJ P,
RDLSLE: RELEASE INPC, ;CLOSE CHAN
AOS NOFILR ;COUNT REJECTED FILE
MOVEI T1,OPNBLK
MOVEI T2,LKPBLK
X$$RLE=$POPJ ;JUST RETURN IF /MESSAGE:PREFIX
WARN. EF$LEB!EF$NCR,RLE,<REPLACE LOOKUP ERROR ON >
STRNG$ < - >
HRRZ T1,LKPBLK+.RBEXT;GET CODE
MOVE T3,LKPBLK+.RBPRV;AND PRIV BITS
CALL .LKERR## ;REPORT WHY
PJRST .TCRLF## ;NEW LINE AND EXIT
SUBTTL PROCESS DIRECT COMMAND
$DIREC:
JUMPNU E$$NUC ;MUST HAVE A USE COMMAND
JUMPCR E$$LIE ;ERROR IF CREATE
CALL .SAVE2## ;SAVE REGS
AOS (P) ;SET TO SKIP BACK SO SCAN DOESN'T STORE
CALL $GTIOL ;GET I/O LIST
CALL SETDFD ;SETUP A WILD DUMMY IF NONE GIVEN
TLO F,FL$TYP ;ASSUME TYPING DIRECTORY ON TTY
SKIPN T1,OUTFDB ;WAS OUTPUT SPECIFIED?
JRST LDIR.0 ;NO--WE ARE TYPING
TLZ F,FL$TYP ;YES--FLAG WE ARE LISTING DIRECTORY TO FILE
HRLOI T2,'DIR' ;SETUP DEFAULT EXTENSION
MOVX T3,FX.NUL ;GET NULL EXTENSION BIT
TDNE T3,.FXMOD(T1) ;WAS AN EXTENSION SPECIFIED?
MOVEM T2,.FXEXT(T1) ;NO--USE DEFAULT
CALL OPENIO ;OPEN DISK FILE FOR DIRECTORY
CAI OUTC,@OBHR(.IOASC) ;
JFCL ;OPENIO RETURNS +2
CALL GETNBF ;SETUP # BUFFERS
MOVE T2,[XWD OPNBLK,OBHR];...
CALL .ALCBF## ;ALLOCATE BUFFERS FOR OUTPUT
MOVEI T1,CHROUT ;NO--SETUP CHARACTER OUTPUT ROUTINE
CALL .TYOCH## ;...
SAVE$ T1 ;REMEMBER WHATEVER WAS THERE BEFORE
LDIR.0: STRNG$ <DIRECTORY OF >
MOVE T1,LIBFDB ;TELL LIBRARY NAME
CALL .TFBLK##
STRNG$ < BY LIBMAN %>
MOVE T1,.JBVER ;IDENTIFY MYSELF
CALL .TVERW##
TLNE F,FL$TYP ;OUTPUTTING TO TTY?
JRST LDIR0A ;YES--DON'T OVERFLOW THE LINE
STRNG$ < ON > ;AN EXTRA ADDED BONUS..
CALL .TDATN## ;TELL THE DATE AND TIME
STRNG$ < AT >
CALL .TTIMN##
LDIR0A: CALL .TCRLF##
CALL .TCRLF## ;A COUPLE OF LINES
SETZB P2,FILCNT ;CLEAR FILE COUNT (P2 = TOTAL # BLOCKS)
MOVEI T1,1 ;USE ONE BUFFER AND..
CALL OLIBIN ;OPEN LIB FOR INPUT
PJRST DIRDUN ;?? CAN'T
MOVEI B,1 ;B=BLOCK COUNTER FOR USETI
LDIR.1: CALL XCTIO ;READ LIB BLK
IN LIBC,
PJRST DIRDUN ;EOF--CLEAN UP AND RETURN
HRRZ P1,IBHR+.BFPTR ;POINT AT LKPBLK IN BUFFER
AOJ P1, ;...
MOVE T1,.RBCNT(P1) ;GET THE COUNT
CAIE T1,.RBTIM ;MUST BE THIS
JRST E$$IFL ;**BAD LIBRARY FORMAT
MOVE T1,.RBNAM(P1) ;SEE IF THIS ONE IN LIST TO DO
HLLZ T2,.RBEXT(P1)
CALL MKLS.F ;LOOK THROUGH INPUT FDBS
JRST LDIR.X ;NO--ADVANCE TO NEXT FILE
AOS FILCNT ;GOT ONE--COUNT FOR SUMMARY LINE
MOVE T1,.RBNAM(P1) ;GET FILENAME
CALL .TSIXN## ;OUTPUT IT
CALL .TTABC## ;TAB BETWEEN THE TWO
HLLZ T1,.RBEXT(P1) ;EXTENSION
CALL .TSIXN##
CALL .TTABC## ;AND A TAB
MOVE T1,.RBSIZ(P1) ;GET FILE SIZE
ADDI T1,177 ;ROUND UP
LSH T1,-7 ;CVT TO BLOKS
ADD P2,T1 ;ACCUMULATE TOTAL BLOCKS
CALL .TDECW## ;TYPE IT
CALL .TTABC## ;SPACE OVER
LDB T1,[POINTR(.RBPRV(P1),RB.PRV)] ;GET PROT
CALL .TPRIV ;SEND IT
CALL .TTABC## ;ANOTHER TAB
LDB T1,[POINTR(.RBPRV(P1),RB.CRD)] ;GET LOW 12 CREATE BITS
LDB T2,[POINTR(.RBEXT(P1),RB.CRX)] ;AND HIGH 3
LSH T2,WID(RB.CRD) ;POSITION HIGH BITS
TRO T1,(T2) ;FORM 15 BIT DATE
CALL .TDATE## ;OUTPUT IT
SKIPN .RBVER(P1) ;IS THERE A VERSION?
JRST LDIR.9 ;NO
CALL .TTABC## ;YES--MAKE ROOM FOR IT
MOVE T1,.RBVER(P1) ;GET THE VERSION
CALL .TVERW## ;OUTPUT IT
LDIR.9: CALL .TCRLF## ;NEW LINE
LDIR.X: MOVE T1,.RBSIZ(P1) ;GET SIZE OF FILE
SUBI T1,1 ;WORDS-1 SO EVEN BLOCKS WORK RIGHT
LSH T1,-7 ;CVT TO BLKS-1
ADDI B,2(T1) ;POSITION TO READ (POSSIBLE) NEXT LKPBLK
USETI LIBC,(B) ;...
JRST LDIR.1 ;GO DO IT
;HERE WHEN DONE WITH DIRECTORY
DIRDUN: CALL ILBCLS ;CLOSE OUT LIBRARY
CALL GIVIOL ;GIVE BACK I/O LISTS
SKIPG FILCNT ;DID WE FIND ANY FILES?
JRST DIRD.2 ;NO--SKIP THE MESSAGE
STRNG$ <
TOTAL OF >
MOVE T1,P2 ;GET TOTAL # OF BLOCKS
CALL .TDECW##
STRNG$ < BLOCKS IN >
MOVE T1,FILCNT
CALL .TDECW##
MOVEI T1,[ASCIZ/ FILE/] ;START PART OF FILES MESSAGE
CALL .TSTRG##
MOVEI T1,"S" ;SET IF MULTIPLE FILES
SOSE FILCNT
CALL .TCHAR## ;MULTIPLE FILES--TYPE AN S
CALL .TCRLF##
DIRD.2: TLZE F,FL$TYP ;WERE WE TYPEING OR LISTING
POPJ P, ;TYPEING--WE ARE DONE
CALL DSKOCL ;LISTING--CLOSE DISK FILE
RESTR$ T1 ;GET OLD SCAN TYPEOUT
PJRST .TYOCH## ;RESTORE AND RETURN
;SETDFD -- SETUP DUMMY FDB WITH *.* IN IT
SETDFD: CALL $GTFDB ;GET AN FDB
MOVE L,T1 ;POSITION PTR
MOVSI T1,'* ' ;SETUP *.*
HLLZM T1,.FXNAM(L)
HLLZM T1,.FXEXT(L) ;
POPJ P,
SUBTTL PROCESS DVERSION COMMAND (CHANGE DISK FILE VERSIONS)
$DVERS: CALL .SAVE2## ;PRESERVE P1-2
AOS (P) ;SO SCAN DOESN'T WIPE REGISTER ZERO
CALL $GTLST ;GET LIST OF DISK FILES
JRST E$$NFS ;MUST GOTTA HAVE A FILE LIST
MOVE P1,L ;MAKE A DESTRUCTIBLE COPY OF LIST
SETZB P2,NOFILR ;CLEAR COUNT OF FILES RENAMED AND REJECTED
STRNG$ <DISK FILES RENAMED:
>
DVER.2: SETZM WLDPTR ;CLEAR TEMP STORE
DVER.4: HRRZM P1,WLDFIR ;SET PTR FOR .LKWLD
MOVE T1,LKWLDB ;SETUP FOR .LKWLD
CALL .LKWLD## ;FIND NEXT FILE TO RENAME
JRST DVER.6 ;WILD SAYS NO MORE
OPEN INPC,DSKOPN ;OPEN THE DEVICE
JRST DVROPE ;CAN'T--IGNORE THIS ONE
LOOKUP INPC,DSKLKP ;FIND THE FILE
JRST DVRLKE ;CAN'T
MOVE T1,.FXVER(P1) ;GET /VERSION
CAME T1,[EXP -1] ;SEE IF SPECIFIED
MOVEM T1,DSKLKP+.RBVER;YES--SET FOR RENAME
LDB T1,[POINTR(.FXMOD(P1),FX.PRO)] ;GET /PROTECTION
SKIPE T1 ;SEE IF SPECIFIED
DPB T1,[POINTR(DSKLKP+.RBPRV,RB.PRV)] ;YES--SET FOR RENAME
RENAME INPC,DSKLKP ;RENAME THE FILE
JRST DVRNME ;TELL OF FAILURE
MOVEI T1,DSKOPN ;SETUP TO TYPE FILE SPEC
MOVEI T2,DSKLKP
CALL $TLBVP ;TYPE LOOKUP BLOCK, VERSION AND PROTECTION
CALL .TCRLF## ;KEEP LISTING PRETTY
ADDI P2,1 ;COUNT FILE AS DONE
DVER.5: RELEASE INPC, ;CLOSE CHANNEL
JRST DVER.4 ;GET NEXT FILE
;WILD SAYS NO MORE IN THIS FDB
DVER.6: HRRZ P1,-1(P1) ;LINK TO NEXT FDB
JUMPN P1,DVER.2 ;GO IF MORE
SKIPN P2 ;DID WE DO ANYTHING?
CALL WRNOFM ;TELL IF DIDN'T FIND ANYTHING
MOVE T1,L ;GIVE UP FDB LIST
PJRST GIVLST ;AND RETURN
;DVERSION ERRORS
DVROPE: CALL E.DFO## ;REPORT OPEN ERROR ON DEVICE
AOS NOFILR ;COUNT REJECTED FILE
JRST DVER.5 ;GET NEXT FILE TO DO
DVRLKE: CALL E.DFL## ;REPORT LOOKUP ERROR
AOS NOFILR ;COUNT REJECTED FILE
JRST DVER.5 ;GET NEXT FILE
DVRNME: WARN. EF$NCR,FRE,<FILE RENAME ERROR ON >
MOVEI T1,DSKOPN ;SET TO TYPE OUT FILE.EXT
MOVEI T2,DSKLKP ;...
CALL .TOLEB## ;TYPE FILE NAME
CALL .TSPAC## ;SEND A SPACE
HRRZ T1,DSKLKP+.RBEXT;GET CODE
MOVE T3,DSKLKP+.RBPRV;AND PROT BITS
CALL .LKERR## ;TELL THE FAILURE
CALL .TCRLF## ;NEW LINE
X$$FRE: AOS NOFILR ;COUNT REJECTED FILE
JRST DVER.5 ;NEXT FILE
SUBTTL FILDIR COMMAND -- GET A DISK DIRECTORY
$FILDIR:CALL .SAVE2## ;PROTECT REGISTERS
STORE T1,DIRECT,DIRECT+LN$DRB-1,0 ;CLEAR BUFFER
MOVE T1,[ASCIZ/TTY:=/] ;OUTPUT WILL BE TO TTY
MOVEM T1,DIRECT ;START THE TMPFILE
MOVEI T1,[IDPB T1,P1 ;SETUP ROUTINE FOR SCAN TYPEOUT
POPJ P,] ;FOR TYPING META-SYMBOLS
CALL .TYOCH## ;SETUP NOW
SAVE$ T1 ;REMEMBER OLD ROUTINE
MOVE P1,[POINT 7,DIRECT+1] ;SETUP TO STORE CHARACTERS
JUMPLE C,FILD.2 ;JUMP IF AT EOL ALREADY
FILD.0: CALL .TIAUC## ;ELSE GET A CHARACTER
JUMPLE C,FILD.2 ;JUMP IF EOL
CAIGE C,4000 ;SEE IF GUIDE WORD
JRST FILD.1 ;NO--JUST STORE IN BUFFER
MOVE T1,C ;YES--POSITION
CALL .TFCHR## ;TYPE GUIDE WORD INTO BUFFER
JRST FILD.0 ;GO GET NEXT THING
FILD.1: IDPB C,P1 ;NO--STORE IN TMPFILE BUFFER
JRST FILD.0 ;LOOP TO EOL
;HERE AT END OF COMMAND LINE
FILD.2: JSP T2,RUNSTR ;ADD REST OF MESSAGE + CRLF
ASCIZ ./RUN:LIBMAN/RUNOFF:0
.
RESTR$ T1 ;GET OLD SCAN TYPEOUT BACK
CALL .TYOCH## ;AND SETUP NOW
OPEN TMPC,[EXP .IODMP,'DSK ',0] ;GET THE DISK IN DUMP MODE
JRST E$$CWT ;CAN'T??
CALL MAKCCL ;MAKE NNNLIB
HRRI T1,'DIR' ;ONLY WE WANT DIR HERE
MOVSI T2,'TMP' ;NNNDIR.TMP
SETZB T3,T4 ;WITH DEFAULT EVERYTHING
ENTER TMPC,T1 ;WRITE THE FILE
JRST E$$CWT ;CAN'T SAY WE DIDN'T TRY!
MOVEI T1,DIRECT ;BEGIN TO FORM IOWD
SUBI T1,1(P1) ;THIS GETS NEGATIVE # WORDS TO WRITE
HRLZS T1 ;TO LH
HRRI T1,DIRECT-1 ;IOWD IS COMPLETE
SETZ T2, ;TERMINATE I/O LIST
OUTPUT TMPC,T1 ;WRITE THE TMPFILE NOW
CLOSE TMPC, ;CLOSE CHANNEL
STATZ TMPC,IO.ERR ;CHECK FOR ERRORS
JRST E$$CWT ;SO NEAR AND YET SO FAR
RELEASE TMPC, ;FREE UP CHANNEL
SKIPE LIBFDB ;DO WE HAVE A LIBRARY FDB?
SKIPLE S.REML ;YES AND WAS IT /NOREMEMBER?
SKIPA ;NO LIBRARY FDB OR /REMEMBER
CALL SAVF.0 ;NEED TO REMEMBER LIBRARY FDB
MOVE T1,[XWD FW$RNL,DIRECT] ;SETUP TO BLT CODE TO LOWSEG
BLT T1,DIRECT+LN$RNL;MOVE IT ALL
JRST DIRECT ;GO DO THE RUN
FW$RNL: ;CODE BLT'D TO LOWSEG STARTS HERE
MOVSI T1,1 ;SETUP TO REMOVE HIGH SEGMENT
CORE T1, ;TELL MON
JFCL ; (IGNORE ERROR)
SKIPA T3,DIRECT+.-FW$RNL+1 ;SETUP PGM NAME TO RUN
SIXBIT /DIRECT/
RNLRUN==.-FW$RNL
SETZB T4,P1 ;CLEAR REST OF BLOCK
SETZB P2,P3 ;...
MOVSI T1,1 ;RUN AT CCL ENTRY
HRRI T1,T2 ;POINT AT ARGBLOCK
MOVSI T2,'SYS' ;SETUP DEVICE
RUN T1, ;GO TO OTHER PROGRAM
AOSE DIRECT+RUNFLG ;CAN'T FIND IT--SEE IF DIRECT OR LIBMAN
EXIT ;LIBMAN!!!--JUST EXIT
SKIPA T3,DIRECT+.-FW$RNL+1 ;DIRECT--LOAD UP TO RUN LIBMAN
SIXBIT /LIBMAN/
JRST DIRECT+RNLRUN
RUNFLG==.-FW$RNL ;OFFSET FOR FLAG
EXP -1 ;WILL GET SET TO 0 IN LOWSEG IF CAN'T FIND DIRECT
LN$RNL==.-FW$RNL
;HERE IF WE CAN'T WRITE TMPFILE
E$$CWT: ERROR. EF$ERR,CWT,<CAN'T WRITE TMPFILE FOR DIRECT>
RELEASE TMPC, ;NEVER KNOW WHERE WE WERE IN PROCESS
JRST $POPJ1 ;SKIP BACK SO SCAN DOESN'T ZAP FLAG REGISTER
;RUNSTR -- SET STRING INTO BUFFER
;CALL: MOVE P1,BYTPTR
; JSP T2,RUNSTR
; ASCIZ /MES/
RUNSTR: HRLI T2,(POINT 7) ;MAKE A PTR
RUNS.0: ILDB T1,T2 ;GET NEXT CHAR
JUMPE T1,1(T2) ;RETURN IF END
IDPB T1,P1 ;NO--STORE IN BUFFER
JRST RUNS.0 ;AND LOOP
;MAKCCL -- RETURN NNNLIB IN T1
;CALL: CALL MAKCCL
; *HERE WITH NNNLIB IN T1*
MAKCCL: SKIPE T1,CCLNAM ;DO WE HAVE IT ALREADY?
POPJ P, ;YES--GIVE IT TO THEM
PJOB T1, ;NO--MAKE IT NOW
CALL .MKPJN##
HRLZ T1,T1 ;POSITION NNN TO LH
HRRI T1,MY$PFX ;ADD IN THE PREFIX
MOVEM T1,CCLNAM ;SAVE IN CASE WE NEED IT AGAIN
POPJ P, ;RETURN
SUBTTL PROCESS ONEOUT COMMAND
$ONEOU:
JUMPNU E$$NUC ;NEED A LIBRARY
JUMPCR E$$LIE ;WHICH ALREADY EXISTS
CALL .SAVE2## ;PRESERVE P1-2
AOS (P) ;SKIP BACK
TLO F,FL$ONE ;FLAG THIS IS ONEOUT COMMAND
TLZ F,FL$TYP ;AND NOT TYPE (COULD HAVE BEEN ON)
CALL $GTIOL ;GET THE I/O LIST
JRST E$$NFS ;NO FILES SPECIFIED
CALL CKOFDB ;MAKE SURE WE HAVE AN OUTPUT SPEC
MOVE T2,.FXDEV(T1) ;SEE WHAT THE THING IS
DEVCHR T2,
TRNN T2,DV.M13 ;CAN IT DO BINARY I/O?
JRST ONECDB ;NO--QUIT BEFORE ILL DATA MODE
CALL $GTDIR ;MAKE SURE WE HAVE AN INCORE DIR
CALL GETNBF ;SETUP # BUFFERS
MOVSS T1 ;POSITION
CALL OLIBIN ;OPEN IT
JRST [ERROR. (EF$ERR,CFL,<CAN'T FIND LIBRARY>) ;???
PJRST ONEO.X] ;CLEAN UP AND GET OUT
MOVE T1,OUTFDB ;SETUP TO OPEN OUTPUT FILE
CALL OPENIO ;DO IT NOW
CAI OUTC,@OBHR(.IOBIN) ;IN BINARY, OK?
JFCL ;OPENIO RETURNS CPOPJ2
CALL GETNBF ;SETUP # BUFFERS
MOVE T2,[XWD OPNBLK,OBHR] ;
CALL .ALCBF## ;ALLOCATE THE BUFFERS
OUTPUT OUTC, ;DO A DUMMY OUTPUT TO SETUP OBHR
SETZM FILCNT ;CLEAR THE COUNT
SETZM NOFILR ;CLEAR REJECTED FILE COUNT
CALL $MKLST ;DO THE THING ON EACH FILE IN LIST
CALL CPYTYF ;XCT'D BY $MKLST
SKIPN FILCNT ;DO ANYTHING?
CALL WRNOFM ;NO FILES MATCH
ONEO.X: CALL GIVIOL ;GIVE BACK LISTS
CALL DSKOCL ;CLOSE OUTPUT FILE
PJRST ILBCLS ;CLOSE LIB AND RETURN
ONECDB: ERROR. EF$FIL,CDB,<CAN'T DO BINARY I/O TO >
PJRST GIVIOL ;EXIT
SUBTTL PROCESS RENAME COMMAND
$RENAM:
JUMPNU E$$NUC ;JUMP IF NO USE COMMAND
JMPRDO E$$IRO ;CAN'T DO THIS IF READ ONLY
JUMPCR E$$LIE ;MUST HAVE A FILE IN THE LIBRARY!
CALL .SAVE1## ;PRESERVE REGS
AOS (P) ;SET TO SKIP SO SCAN DOESN'T STORE
CALL $GTIOL ;GET I/O LIST
JRST E$$NFS ;NULL LIST
JUMPE L,E$$NFS ;NEED INPUT SIDE
CALL CKOFDB ;MAKE SURE OUTPUT FDB IS PRESENT
CALL $GTDIR ;ENSURE WE HAVE A DIRECTORY IN CORE
SETO T1, ;FLAG TO UPDATE, NOT APPEND
CALL OLIBUP ;...
SETZM FILCNT ;CLEAR FLAG OF FILES DONE
SETZM NOFILR ;CLEAR COUNT OF REJECTED FILES
STRNG$ <FILES RENAMED:
>
CALL $MKLST ;WHIP THROUGH THE DIR AND CHANGE THE FILES
CALL RENSUB ;BY EXECUTING THIS INSTR
CALL OLBCLS ;ALL DONE--CLOSE OUT THE LIBRARY
MOVEI T1,IBHR ;WE SHOULD FREE UP INPUT BUFFER ALSO
CALL TSTBHR ;...
SKIPN FILCNT ;SEE IF WE DID ANYTHING
CALL WRNOFM ;NO FILES MATCHED
PJRST GIVIOL ;FREE I/O FDBS AND RETURN
;ROUTINE CALLED BY $MKLST FOR EACH ITEM IN DICT THAT MATCHES INPUT
;SPEC.
RENSUB: CALL .SAVE2## ;PRESERVE P1-2
MOVE T4,OUTFDB ;POINT T4 AT OUTPUT FDB
HRRZ B,(P3) ;GET BLOCK # OF LKPBLK IN FILE
USETI LIBC,(B) ;SET TO READ IT
CALL XCTIO ;READ THE LKPBLK
IN LIBC,
POPJ P, ;QUIT EARLY IF BAD (SHOULD HAVE BEEN CAUGHT)
HRRZ P1,IBHR+.BFPTR ;GET INPUT BUFFER PTR
MOVSI T1,(P1) ;BEGIN TO FORM BLT WORD AT SAME TIME
AOJ P1, ;NOW POINT AT LKPBLK
HRR T1,OBHR+.BFPTR ;WORK ON CTL WORD SOME MORE
AOBJP T1,.+1 ;...
HRRZ P2,T1 ;POINT AT OUTPUT BUFFER
MOVEI T2,177(T1) ;SETUP TO COPY LKPBLK TO OUTPUT BUFFER
BLT T1,(T2) ;THERE IT GOES
MOVE T3,.RBNAM(P1) ;GET INPUT NAME
TDZ T3,.FXNMM(T4) ;CLEAR WHAT WAS SPECIFIED IN OUTPUT
MOVE T2,.FXNAM(T4) ;GET OUTPUT NAME
AND T2,.FXNMM(T4) ;ELIMINATE WILD CARDS
XOR T3,T2 ;MAKE NEW FILENAME
MOVEM T3,.RBNAM(P2) ;STORE IN NEW LKPBLK
HLLZ T3,.RBEXT(P1) ;GET INPUT EXTENSION
MOVE T2,.FXEXT(T4) ;AND GET OUTPUT EXTENSION,,MASK
TLZ T3,(T2) ;CLEAR WHAT SHOULD BE CLEARED
MOVSS T2 ;SWAP HALVES
HLRZ T1,T2 ;GET EXT MASK
ANDI T2,(T1) ;ELIMINATE WILD CARDS
TLO T3,(T2) ;AND SET WHAT SHOULD BE SET
MOVX T1,FX.NUL ;GET THE NULL EXTENSION FLAG
TDNE T1,.FXMOD(T4) ;SEE IF EXPLICITLY NULL EXTENSION
SETZ T3, ;YES--MAKE IT SO
HLLM T3,.FXEXT(P2) ;IMPROVE OUTPUT LKPBLK
MOVE T1,.RBNAM(P2) ;GET FILENAME WE WILL USE
HLLZ T2,.RBEXT(P2) ;AND EXTENSION
CALL IFNDIR ;SEE IF IN DIRECTORY
JRST RENPRO ;NOT IN DIR
CAIE T3,(P3) ;THERE--ARE WE RENAMING TO SELF?
JRST E$$RFE ;NO--RENAME FILE ALREADY EXISTS
RENPRO: MOVE T1,.RBNAM(P2) ;OK--UPDATE INCORE DIR
MOVEM T1,-1(P3) ;...
HLLZ T1,.RBEXT(P2) ;...
HLLM T1,(P3) ;...
MOVE T4,OUTFDB ;RESET T4 TO POINT AT OUTFDB
LDB T1,[POINTR(.FXMOD(T4),FX.PRO)] ;GET /PROT VALUE
SKIPE T1 ;UNLESS NOT GIVEN
DPB T1,[POINTR(.RBPRV(P2),RB.PRV)] ;AND SET IN
RENVER: MOVE T1,.FXVER(T4) ;GET /VERSION FROM OUTPUT FDB
CAME T1,[EXP -1] ;WAS IT DEFAULT?
MOVEM T1,.RBVER(P2) ;NO--SET IN LKPBLK
PUSH P,.RBVER(P2) ;SAVE NEW VERSION ON PDL
PUSH P,.RBPRV(P2) ;AND NEW PRIV WORD
PUSH P,.RBEXT(P2) ;SAVE NEW EXT ON PDL
PUSH P,.RBNAM(P2) ;AND NEW FILENAME ALSO
MOVE T1,OBHR+.BFCTR ;GET THE COUNTER
SETZM OBHR+.BFCTR ;AND ZERO IT
ADDM T1,OBHR+.BFPTR ;AND UPDATE PTR SO MON WILL WRITE BUF
USETO LIBC,(B) ;PREPARE TO WRITE THE BLOCK
CALL XCTIO ;WRITE THE NEW LKPBLK TO LIBRARY
OUT LIBC, ;XCT'D
STOPX$ ;***
AOS FILCNT ;COUNT THE THING AS DONE
MOVE T1,.RBNAM(P1) ;GET OLD NAME
CALL .TSIXN## ;TYPE IT
CALL .TDOT
HLLZ T1,.RBEXT(P1) ;GET EXTENSION
CALL .TSIXN##
LDB T1,[POINTR(.RBPRV(P1),RB.PRV)] ;GET PROT BITS
CALL $TPROT ;TYPE /PROTECT:OOO
MOVE T1,.RBVER(P1) ;GET VERSION
CALL $TVRSN ;TYPE /VERSION:V
MOVSI T1,'=> ' ;POINT TO NEW NAME
CALL .TSIXN##
POP P,T1 ;GET NEW NAME BACK
CALL .TSIXN##
CALL .TDOT
POP P,T1 ;GET EXTENSION BACK
HLLZS T1 ;CLEAR ANY RH STUFF
CALL .TSIXN##
POP P,T1 ;GET PRIV WORD BACK
LDB T1,[POINTR(T1,RB.PRV)] ;GET PRIV BITS
CALL $TPROT ;TYPE /PROT
POP P,T1 ;GET VERSION BACK
CALL $TVRSN ;AND TYPE IT
CALL .TCRLF## ;NEW LINE
POPJ P, ;RETURN TO GET NEXT FILE
E$$RFE: WARN. EF$SIX!EF$NCR,RFE,<RENAME FILE EXISTS - >
MOVEI T1,"." ;GET A DOT
CALL .TCHAR##
HLLZ T1,T2 ;AND EXTENSION
CALL .TSIXN## ;SEND IT
STRNG$ < - IGNORING
>
X$$RFE: AOS NOFILR ;COUNT REJECTED FILE
POPJ P,
SUBTTL PROCESS USE COMMAND
$READ: TLO F,FL$TYP!FL$RDO ;FLAG USE AND READ ONLY
JRST USE.0 ;SKIP AHEAD
$CREATE:TLZA F,FL$TYP ;FLAG CREATE
$USE: TLO F,FL$TYP ;FLAG USE
TLZ F,FL$RDO ;NOT READ-ONLY
USE.0: CALL CRUCLN ;CLEAN UP FROM LAST LIB
JUMPLE C,E$$NFS ;NEED A SPEC
CALL .SAVE2## ;PRESERVE REGS
AOS (P) ;SKIP BACK SO SCAN DOESN'T STORE
CALL $GTSPC ;GET A FILE SPEC FOR LIB FILE
E$$NFS: FATAL. 0,NFS,<NO FILE SPECIFIED IN COMMAND>
MOVEM T1,LIBFDB ;REMEMBER WHERE IT IS
HRLOI T2,DF$EXT ;IN CASE NO EXT TYPED
SKIPN .FXEXT(T1) ;WAS ONE SPECIFIED?
MOVEM T2,.FXEXT(T1) ;NO--USE THIS ONE
MOVE T2,.FXDEV(T1) ;GET DEV NAME
DEVCHR T2, ;SEE WHAT IT IS
TLNN T2,(DV.DSK) ;MUST BE DISK
; TLNE F,FL$RDO ;UNLESS READ ONLY
; SKIPA ;DISK OR READ ONLY ON NON-DISK
JRST E$$BDL ;**BAD DEV FOR LIBRARY
CALL OPENIO ;OPEN LIB TO SEE IF IT LIVES
CAI LIBC,0(.IOBIN) ;DON'T BOTHER WITH BUFFERS
JRST CRECHK ;NOT THERE--ONLY COMPLAIN IF NOT CREATE
MOVE T1,LIBFDB ;IT LIVES--SETUP IN CASE CREATE AND NOT USE
TLNN F,FL$TYP ;CREATE?
WARN. EF$FIL,LAE,<LIBRARY ALREADY EXISTS >
TLOA F,FL$LIB ;FLAG WE HAVE A LIBRARY
USE.1: TLO F,FL$LIB!FL$CRE ;FLAG LIBRARY BEING CREATED
TLNE F,FL$RDO ;IS THIS READ ONLY?
POPJ P, ;YES--DON'T CHECK WRITE PRIVS
MOVSI T2,.ACWRI ;CHECK PRIVS TO SEE IF WE CAN WRITE LIB
LDB T1,[POINTR(LKPBLK+.RBPRV,RB.PRV)] ;GET PROT OF FILE
SKIPN T1 ;GET A PROT?
MOVEI T1,155 ;NO--USE THIS
OR T2,T1 ;FOR CHKACC
MOVE T3,LKPBLK+.RBPPN;PPN WHERE FILE WAS FOUND
MOVE T4,.MYPPN## ;AND MY PPN
MOVEI T1,T2 ;POINT FOR TONY
CHKACC T1, ;SEE WHAT THE SCOOP IS
JRST SAVFDU ;ASSUME OK IF NOT IMPLEMENTED
JUMPE T1,SAVFDU ;JUMP IF CAN WRITE IT
E$$CWL: MOVE T1,LIBFDB ;CAN'T--GET FDB ADDR
ERROR. EF$ERR!EF$FIL,CWL,<CAN'T WRITE LIBRARY >
PJRST CRUCLN ;CLEAN UP AND RETURN
;HERE TO SAVE LIBFDB ON DISK IF USE OR CREATE COMMAND
SAVFDU: SKIPG S.REML ;ARE WE TO REMEMBER LIBRARY?
POPJ P, ;NO--SAID SPECIFICALLY NOREMEMBER
SAVF.0: OPEN TMPC,[EXP .IODMP,'DSK ',0] ;GET DISK IN DUMP MODE
POPJ P, ;GIVE UP EARLY IF CAN'T
CALL MAKCCL ;GET NNNLIB
HRRI T1,'LRL' ;LIBMAN REMEMBER LIBRARY FILE
MOVSI T2,'TMP' ;EXT
SETZB T3,T4 ;CLEAR REST
ENTER TMPC,T1 ;PREPARE TO WRT
JRST SAVF.X ;CAN'T--GO QUIT
MOVSI T1,-.FXLEN ;START IOWD
HRR T1,LIBFDB ;COMPLETE IT
HRRI T1,-1(T1) ;IOWDS GO TO N,,LOC-1
SETZ T2, ;TERMINATE I/O LIST
OUTPUT TMPC,T1 ;WRITE THE FDB OUT
CLOSE TMPC, ;CLOSE FILE
SAVF.X: RELEASE TMPC, ;FREE CHANNEL
POPJ P, ;DONE
;HERE IF FILE NOT FOUND
CRECHK: TLNN F,FL$TYP ;SEE IF CREATE OR USE
JRST USE.1 ;CREATE--DON'T MOAN
MOVE T1,LIBFDB ;GET FDB
TLNE F,FL$RDO ;IS THIS READ ONLY?
JRST [HRLZ P1,LIBFDB ;YES--SETUP
PJRST LKENER] ;AND GO DIE
WARN. EF$FIL,CRE,<FILE NOT FOUND - ASSUME CREATING >
JRST USE.1 ;GO SEE IF WE CAN WRITE IT
E$$BDL: ERROR. EF$ERR,BDL,<BAD DEVICE FOR LIBRARY OR NOT READING>
; PJRST CRUCLN ;CLEAN UP AND RETURN
;CRUCLN -- CLEAN UP FROM LAST LIBRARY
CRUCLN: TLZ F,FL$LIB!FL$CRE ;ZERO THE FLAGS THAT A LIB EXISTS
SKIPE T1,LIBFDB ;WAS THERE AN FDB?
CALL .DECOR## ;YES--MAKE IT GO AWAY
SETZM LIBFDB ;MAKE SURE NOT THERE ANY MORE
ZAPDIR: SKIPE T1,DIRPTR ;WAS THERE A DIRECTORY?
CALL GIVLST ;YES--GIVE IT UP
SETZM DIRPTR ;NOT ANYMORE
POPJ P, ;DONE
SUBTTL SUBROUTINES--READ LIBRARY FILE AND CREATE INCORE DIRECTORY
;$GTDIR -- CREATE IN-CORE DIRECTORY
;CALL: CALL $GTDIR
; *ONLY RETURN--DIR SETUP IF POSSIBLE*
$GTDIR: JUMPCR $POPJ ;JUMP IF CREATE
SKIPE DIRPTR ;ALREADY HAVE A DIR?
POPJ P, ;YES--DON'T READ IT AGAIN
CALL .SAVE3##
MOVEI T1,1 ;USE ONE BUFFER
CALL OLIBIN ;OPEN LIB FOR INPUT
POPJ P, ;NO LIB--NO DIR
CALL GDIR.8 ;INITIALIZE
MOVEI P2,.RBTIM ;FOR CHECKING LIBRARY CORRECTNESS
MOVEI B,1 ;B IS THE BLOCK PTR FOR USETIS
GDIR.0: CALL XCTIO ;READ BLOCK
IN LIBC,
JRST GDIR.9 ;DONE
MOVE P3,IBHR+.BFPTR ;POINT TO DIR IN BUFFER (LOOKUP BLOCK)
AOJ P3, ;REALLY POINT AT IT
CAME P2,.RBCNT(P3) ;IS THIS REALLY A RIB?
JRST E$$IFL ;NO--GO DIE
GDIR.1: AOBJP P1,GDIR.5 ;NEXT ENTRY IN DIR BLOCK--JUMP IF FULL
MOVE T1,.RBNAM(P3) ;GET FILENXME
MOVEM T1,(P1) ;STORE IT
AOBJP P1,.+1 ;ADVANCE
HLLZ T1,.RBEXT(P3) ;GET EXTENSION
HRRI T1,(B) ;SET BLOCK # IN RH
MOVEM T1,(P1) ;STORE IN DIR
MOVE T1,.RBSIZ(P3) ;FILE SIZE IN WORDS
SUBI T1,1 ;SO ALL WILL BE WELL
LSH T1,-7 ;CONVERT TO BLOCKS-1
ADDI B,2(T1) ;POSITION TO NEXT LKPBLK IN LIBRARY
USETI LIBC,(B) ;...
JRST GDIR.0 ;GO READ NEXT FILE IN LIBRARY
;HERE WHEN WE NEED ANOTHER BLOCK--THIS ONE IS FULL
GDIR.5: CALL GDIR.6 ;GET IT
JRST GDIR.1 ;CONTINUE
;HERE IF LIBRARY IS NOT REALLY A LIBRARY
E$$IFL: CALL CRUCLN ;ENSURE NO LIBRARY
CALL ILBCLS ;CLOSE OUT NON-LIBRARY FILE
MOVE T1,B ;GET BLOCK #
FATAL. EF$DEC,IFL,<INCORRECTLY FORMATTED LIBRARY AT BLOCK >
;CALL HERE TO COPY DIRECT OUT TO CORE BLOCKS
GDIR.6: MOVEI T1,LN$DRB ;SIZE OF BLOCK
CALL .ALCOR## ;GET IT
MOVSI T2,DIRECT ;FORM CTL WORD
HRRI T2,(T1) ;...
BLT T2,LN$DRB-1(T1) ;ZIP DIR OUT TO IT
MOVEI T2,DIRPTR ;SETUP TO LINK
CALL LNKATN ;DO THE LINKING
GDIR.8: STORE T1,DIRECT,DIRECT+LN$DRB-1,0 ;ZERO DIRECT
MOVSI P1,-LN$DRB ;FORM AOBJ WORD
HRRI P1,DIRECT-1 ;...
POPJ P,
;HERE WHEN WE HAVE READ THE WHOLE LIBRARY
GDIR.9: CALL ILBCLS ;CLOSE OUT LIBRARY
SKIPN DIRECT ;ANY NAMES LEFT OVER HERE?
POPJ P, ;NO--ALL DONE
PJRST GDIR.6 ;YES--COPY OUT AND RETURN
;OLIBIN -- OPEN LIB FOR INPUT
;CALL: MOVEI T1,<# BUFFERS>
; CALL OLIBIN
; *FILE NOT FOUND*
; *ALL IS WELL, BUFFERS SET UP*
OLIBIN: SAVE$ T1 ;REMEMBER # BUFFERS
MOVE T1,LIBFDB ;GET PTR TO FDB
CALL OPENIO ;LOOKUP DIR
CAI LIBC,IBHR(.IOBIN) ;
PJRST TPOPJ ;NO LIB--NO DIR
RESTR$ T1 ;GET # BUFFERS BACK
MOVSI T1,(T1) ;SETUP # BUFFERS, DEFAULT SIZE
MOVE T2,[XWD OPNBLK,IBHR] ;
AOS (P) ;SET TO SKIP BACK
PJRST .ALCBF## ;ALLOCATE BUFFERS AND RETURN
SUBTTL SUBROUTINES--MAKE LST FROM FILE LIST AND LIBRARY DIRECTORY
;$MKLST -- MAKE LST FROM USER'S LIST (INPUT) AND LIBRARY DIRECTORY
;CALL: MOVEI L,<FDBLST--USER'S LIST>
; CALL $MKLST
; **ADDRESS OF ROUTINE TO CALL FOR EACH ITEM IN LST (I.E. COROUTINE)**
; *RETURN*
;THE COROUTINE WILL BE CALLED WITH P3=PTR TO ENTRY IN INCORE DIR (EXT WORD)
; P4=PTR TO FDB WHICH MATCHES DIR ENTRY
;THE COROUTINE MUST NOT DESTROY P1-3; THE COROUTINE MAY USE P4
$MKLST: MOVE T1,0(P) ;REMEMBER WHERE INSTR IS
CALL .SAVE4## ;PRESERVE ACS
AOS 0(P) ;SETUP TO SKIP BACK OVER INSTR AT END
MOVE P1,T1 ;POINT AT LIST
SKIPN P2,DIRPTR ;GET DIR PTR
JRST E$$LDE ;WHAT CAN YOU DO IF NO DIR?
MKLS.0: MOVEI P3,-1(P2) ;POINT AT THE DIR BLK
HRLI P3,-LN$DRB ;...
MKLS.1: AOBJP P3,MKLS.3 ;JUMP IF DONE WITH DIR BLK
MOVE T1,(P3) ;NO--GET A FILENAME
AOBJP P3,.+1 ;INC TO EXT
HLLZ T2,(P3) ;AND PICK IT UP
SKIPN T1 ;SEE IF NULL
JUMPE T2,MKLS.1 ;YES--GET NEXT ENTRY (MAY HAVE BEEN DELETED)
CALL MKLS.F ;LOOK THRU FDBS FOR A MATCH
JRST MKLS.1 ;NONE HERE
MOVE P4,T4 ;POSITION FDB ADDR
PUSHJ P,@(P1) ;CALL THE COROUTINE
JRST MKLS.1 ;GET MORE LST ENTRIES
E$$LDE: ERROR. EF$ERR,LDE,<LIBRARY DIR EMPTY>
POPJ P,
;HERE AT END OF A DIR BLK
MKLS.3: HRRZ P2,-1(P2) ;LINK TO NEXT
JUMPN P2,MKLS.0 ;GO IF MORE DIRS
POPJ P, ;NO--ALL DONE
;CALL HERE WITH FNAM.EXT IN T1.T2 AND L POINTING AT FDB CHAIN
;RETURN $POPJ1 IF WIN WITH T4 PTING AT FDB WHICH MATCHES
;RETURN $POPJ IF LOOSE
MKLS.F: SKIPN T1 ;DEFEND AGAINST DELETED FILES
JUMPE T2,$POPJ ;..
SAVE$ <T1,T2> ;SAVE FNAM.EXT
MOVE T4,L ;GET PTR TO FDBS
MLSF.0: MOVE T2,-1(P) ;GET FILENAME
HLLZ T3,0(P) ;AND EXTENSION
XOR T2,.FXNAM(T4) ;COMPARE NAMES
XOR T3,.FXEXT(T4) ;AND EXTENSION + PICK UP EXT MASK
TDNN T2,.FXNMM(T4) ;CHECK NAME WITH MASK
TLNE T3,(T3) ;AND EXTENSION
SKIPA T4,-1(T4) ;FAIL--ADVANCE TO NEXT FDB
JRST [RESTR$ <T2,T1> ;WIN--RESTORE REGS
JRST $POPJ1] ;AND SKIP BACK
HRRZS T4 ;CLEAR WORD COUNT
JUMPN T4,MLSF.0 ;JUMP IF MORE FDBS
RESTR$ <T2,T1> ;NO--RESTORE FILE.EXT
POPJ P, ;FAIL BACK
;$TPROT -- TYPE /PROTECT:OOO
;CALL: MOVE T1,<PROT BITS>
; CALL $TPROT
;ACS:T1-4
$TPROT: PUSH P,T1 ;SAVE PROT
STRNG$ </PROTECT:>
POP P,T2 ;GET PROT BACK
PJRST TPRIV0 ;GO TYPE PROTECTION AND RETURN
;$TVRSN -- TYPE /VESION:V
;CALL: MOVE T1,<VERSION>
; CALL $TVRSN
;WILL TYPE ONLY IF NON-ZERO
$TVRSN: JUMPE T1,$POPJ ;DON'T BOTHER IF ZERO
PUSH P,T1 ;SAVE VERSION
STRNG$ </VERSION:>
POP P,T1 ;GET IT AGAIN
PJRST .TVERW## ;TYPE AND RETRN
SUBTTL SUBROUTINES--SEE IF FILE IS IN LIBRARY
;IFNDIR -- SEE IF FILE IS IN LIBRARY
;CALL: MOVE T1,FILNAM
; MOVE T2,EXTNSN
; CALL IFNDIR
; *NOT THERE*
; *THERE--T3 POINTS AT EXTENSION OF ENTRY*
;ACS: T1-2 INTACT; USES T3-4
;
;IFNLST -- SEE IF FILE IS IN A LIST
;CALL: MOVE T1,FILNAM
; MOVE T2,EXTNSN
; MOVE T3,<LIST HEAD ADDR>
; CALL IFNLST
; *NOT IN LST*
; *IN LST--T3 POINTS AT EXTENSION OF ENTRY*
IFNDIR: SKIPN T3,DIRPTR ;IS THERE A DIR?
POPJ P, ;NO DIR--NOT IN FILE THEN
IFNLST: CALL .SAVE2## ;PRESERVE
SKIPN P1,T3 ;COPY LST ADDR
POPJ P, ;NO LST--CAN'T BE IN IT
IFND.0: MOVEI P2,(P1) ;POINT AT DIR
HRLI P2,-LN$DRB ;GET AN AOBJ WORD
IFND.1: SKIPN T3,(P2) ;CHECK END/PICK UP FILENAME
JRST IFND.2 ;COULD BE A DELETED FILE
HLLZ T4,1(P2) ;PICKUP EXTENSION (IGNORE RH)
CAMN T1,T3 ;FILENAMES THE SAME?
CAME T2,T4 ;AND EXTENSIONS ALSO?
SKIPA ;NOT THE SAME
JRST [MOVEI T3,1(P2);YES--POSITION
JRST $POPJ1] ;AND SKIP BACK
IFND.2: AOBJP P2,.+1 ;INC BY TWOS
AOBJN P2,IFND.1 ;GO IF MORE IN THIS BLOCK
HRRZ P1,-1(P1) ;NO--LINK TO NEXT DIR BLOCK
JUMPN P1,IFND.0 ;JUMP IF MORE
POPJ P, ;NO--NOT IN DIR
;CKOFDB -- SEE IF OUTFDB SETUP AND DO SO IF NOT
;CALL: SETUP L,OUTFDB AS APPROPRIATE
; CALL CKOFDB
; *RETURN--OUTFDB SETUP--T1 PTS AT OUTFDB ALSO*
;ACS: T1-2
CKOFDB: SKIPE T1,OUTFDB ;SEE IF ALREADY SET UP
TLOA F,FL$OFG ;YES--FLAG AND SKIP
TLZA F,FL$OFG ;NO--FLAG AND SKIP
POPJ P, ;ALREADY SETUP--RETURN NOW
MOVEI T1,.FXLEN ;NO--GET CORE
CALL .ALCOR## ;
MOVSI T2,(L) ;COPY INPUT SPEC FOR OUTPUT
HRRI T2,(T1) ;....
BLT T2,.FXLEN-1(T1) ;MOVE SPEC OVER
MOVEM T1,OUTFDB ;SETUP OUTFDB
POPJ P, ;RETURN
;AD2DIR -- ADD FILE TO INCORE DIRECTORY
;CALL: MOVE T1,FILNAM
; MOVE T2,EXTNSN
; MOVEI B,<BLK # IN LIB>
; CALL AD2DIR
;ACS: T1-4
;AD2LST -- ADD FILE TO A LIST
;CALL: MOVE T1,FILNAM
; MOVE T2,EXTNSN
; MOVEI T3,<LIST HEAD ADDR>
; HRRZ B,<INFO FOR RH OF EXTENSION WORD>
; CALL AD2LST
AD2DIR: MOVEI T3,DIRPTR ;POINT AT DIR LST
AD2LST: CALL .SAVE2## ;PRESERVE
SKIPN P1,(T3) ;IS THERE A LST?
JRST AD2D.3 ;NO--GO START IT
AD2D.0: HRRZ P2,-1(P1) ;GET LINK TO NEXT DIR BLK OR 0
JUMPN P2,AD2D.2 ;IF THERE IS ONE THEN SAVE SOME TIME
MOVEI P2,(P1) ;GET PTR
HRLI P2,-LN$DRB ;FORM AOBJ PTR
AD2D.1: SKIPN (P2) ;END OF DIR?
JRST AD2D.4 ;YES--GO PLUNK IN NAME
AOBJP P2,.+1 ;BUMP PTR
AOBJN P2,AD2D.1 ;BY TWOS
AD2D.2: HRRZ P1,-1(P1) ;MOVE TO NEXT DIR BLK
JUMPN P1,AD2D.0 ;CHECK IT OUT
;HERE WHEN WE MUST GET ANOTHER BLOCK
AD2D.3: SAVE$ <T2,T1> ;SAVE FILENAME.EXT
MOVEI T1,LN$DRB ;SIZE OF BLOCK
CALL .ALCOR## ;ALLOCATE A BLOCK
RESTR$ <(T1)> ;PUT NAME IN
RESTR$ <1(T1)> ;AND EXTENSION
HRRM B,1(T1) ;SET BLOCK # IN ALSO
MOVEI T2,(T3) ;SETUP
PJRST LNKATN ;AND LINK AT END OF LIST
;HERE WHEN WE FOUND A FREE SLOT IN THIS DIR BLOCK
AD2D.4: MOVEM T1,(P2) ;STORE FILENAME
MOVEM T2,1(P2) ;AND EXTENSION
HRRM B,1(P2) ;SET BLOCK # IN
POPJ P, ;DONE
SUBTTL SUBROUTINES--GET A FILE LIST
;$GTLST -- GET A FILE LIST INTO CORE BLOCKS
;CALL: CALL $GTLST
; *RETURN IF NO FILES PRESENT*
; *RETURN WITH L POINTING AT FDB CHAIN*
$GTLST: PJUMPLE C,$POPJ ;JUMP IF AT EOL
SETZ L, ;CLEAR LIST
GLST.0: CALL $GTSPC ;GET A SPEC
PJRST [PJUMPN L,$POPJ1 ;NO MORE--POPJ1 IF GOT AT LEAST ONE
POPJ P,] ;NO--RETURN CPOPJ
GLST.1: MOVEI T2,L ;POINT T2 AT THE LIST HEAD
CALL LNKATN ;LINK THIS BLOCK AT END OF LIST
JUMPG C,GLST.0 ;JUMP IF MORE FILES POSSIBLE
JUMPN L,$POPJ1 ;JUMP IF WE FOUND A SPEC
POPJ P, ;ELSE POPJ BACK
;$GTIOL -- GET I/O LIST -- OUTPUT AND INPUT
;CALL: CALL $GTIOL
; *RETURN--NO FILESPECS PRESENT*
; *RETURN--OUTFDB IS 0 OR POINTS AT FDB, L POINTS AT INPUT FDBS*
$GTIOL: PJUMPLE C,$POPJ ;JUMP IF AT EOL
SKIPE T1,OUTFDB ;IF THERE IS AN FDB
CALL .DECOR## ;FREE IT UP
SETZB L,OUTFDB ;ZERO A FEW THINGYS
CALL $GTSPC ;READ ONE SPECIFCATION
POPJ P, ;WEREN'T ANY
CAIE C,"=" ;WAS THIS OUTPUT SPEC?
JRST GLST.1 ;NO--DO INPUT
MOVEM T1,OUTFDB ;YES--STORE IT THERE
JRST GLST.0 ;GO DO INPUT
;$GTSPC -- READ ONE ONE FILE SPEC INTO CORE
;CALL: CALL $GTSPC
; *NO FILE GIVEN*
; *RETURN, FDB ADDR IN T1*
$GTSPC: CALL .FILIN## ;READ THE SPEC
SKIPN F.NAM## ;CHECK FOR NULL SPEC
SKIPE F.NAM##-1 ;THIS IS REALLY F.DEV
AOSA (P) ;GOT SOMETHING--SET TO SKIP BACK
POPJ P, ;NO WE DIDN'T
CALL $GTFDB ;GET AN FDB
SAVE$ T1 ;SAVE ADDRESS
MOVEI T2,.FXLEN ;AND SIZE FOR .GTSPC
CALL .GTSPC## ;COPY SPEC OVER
POP P,T1 ;GET ADDRESS BACK
SKIPG .FXFLM(T1) ;WAS FILE MAX LENGTH SET?
SETOM .FXFLM(T1) ;NO--MAKE IT -1 SO .CHKTM IS HAPPY
POPJ P, ;SKIP BACK
;LNKATN -- LINK A BLOCK AT THE END OF A LINKED LIST
;CALL: MOVEI T1,<NEW BLOCK ADDR--1ST WORD (NOT LINK WORD)>
; MOVEI T2,<LIST HEAD ADDR>
; CALL LNKATN
; *RETURN, NO ACS WIPED*
LNKATN: SKIPN (T2) ;IS THERE A LIST?
JRST [MOVEM T1,(T2) ;NO--START IT NOW
JRST MRKEND] ;BE SURE THE NEW BLOCK IS THE END OF THE LIST
CALL .SAVE2## ;NEED TWO REGISTERS
MOVE P1,(T2) ;COPY LIST ADDRESS
MOVE P2,P1 ;REMEMBER FROM WHENCE WE CAME
HRRZ P1,-1(P1) ;LOOKY FOR THE END
JUMPN P1,.-2 ;HAVE TO GET THERE EVENTUALLY
HRRM T1,-1(P2) ;PUT THIS ONE ON THE END
MRKEND: HLLZS -1(T1) ;MAKE SURE THIS IS REALLY THE END
POPJ P, ;DONE
;GIVLST -- GIVE BACK A LIST OF LINKED BLOCKS
;CALL: MOVEI T1,<ADDR OF FIRST BLK>
; CALL GIVLST
GIVLST: JUMPE T1,$POPJ ;JUMP IF NULL LIST
CALL .SAVE1## ;NO--SAVE P1
MOVE P1,T1 ;COPY PTR
GIVL.0: HRRZ T1,P1 ;COPY ADDR
HRRZ P1,-1(P1) ;CHAIN TO POSSIBLE NEXT BLOK
CALL .DECOR## ;FREE A BLOCK
JUMPN P1,GIVL.0 ;JUMP IF MORE
POPJ P, ;DONE
;$EATLN -- SKIP TO EOL
$EATLN: JUMPLE C,$POPJ ;GO IF DONE
CALL .TIAUC## ;NO--NEXT CHARACTER
JRST $EATLN ;CHECK IT OUT
;GIVIOL -- GIVE BACK OUTFDB AND FDB CHAIN THAT L POINTS AT
GIVIOL: SKIPE T1,OUTFDB ;DO WE HAVE AN FDB?
CALL .DECOR## ;YES--BUT NOW WE DON'T
SETZM OUTFDB
SKIPN T1,L ;IS THERE AN INPUT LIST?
POPJ P, ;NO--RETURN
SETZ L, ;YES--MAKE SURE NOT ANY MORE
PJRST GIVLST ;AND FREE IT UP AND RETURN
;$GTFDB -- GET AN FDB
;CALL: CALL $GTFDB
; *T1 PTS AT FDB*
;USE THIS SO .FXFLM GETS SET TO -1 AND .CHKTM IS HAPPY
$GTFDB: MOVEI T1,.FXLEN ;SIZE OF BLOCK TO GET
CALL .ALCOR## ;GET FROM CORE GIVER
SETOM .FXFLM(T1) ;ONES TO THE SIZE IN CASE NOT GIVEN
POPJ P, ;BACK WITH FDB ADDR IN T1
;TYPE FDB LIST POINTED TO BY L
$TYIOL: JUMPE L,$POPJ ;SKIP EMPTY LISTS
CALL .SAVE1## ;GET P1 FREE
HRRZ P1,L ;GET A COPY OF L
TYIO.2: MOVE T1,P1 ;POINT AT SCAN BLOCK
CALL .TFBLK## ;TYPE ONE
HRRZ P1,-1(P1) ;CHAIN TO (POSSIBLE) NEXT
JUMPE P1,$POPJ ;JUMP IF ALL DONE
MOVEI T1,"," ;NO--GET A COMMA
CALL .TCHAR## ;TYPE IT
JRST TYIO.2 ;GO TYPE THE NAME NOW
SUBTTL OPEN LIBRARY IN UPDATE MODE
;OLIBUP -- OPEN LIBRARY IN UPDATE MODE
;CALL: MOVEI T1,FLGVAL ;T1=0 TO APPEND, T1=-1 TO UPDATE
; CALL OLIBUP
OLIBUP: CALL .SAVE1## ;PRESERVE P1
MOVS P1,LIBFDB ;IN CASE OF CATASTROPHIC ERROR
HLR P1,T1 ;REMEMBER THE FLAG VALUE
MOVSI T1,.FXLEN ;SETUP FOR .STOPB
HRR T1,LIBFDB ;...
MOVEI T2,OPNBLK ;...
MOVE T3,[XWD .RBTIM+1,LKPBLK]
CALL .STOPN## ;FORM OPEN/LOOKUP BLOCKS
JRST WLDERR ;NO WILDCARDING OF LIBS
MOVEI T1,.RBTIM ;SET SIZE
MOVEM T1,LKPBLK+.RBCNT;FOR MON
MOVEI T1,.IOBIN ;BINARY
MOVEM T1,OPNBLK+.OPMOD
MOVSI T1,OBHR ;FOR OUTPUT
TRNE P1,-1 ;SEE IF UPDATING
HRRI T1,IBHR ;YES--NEED INPUT BUFFER HEADER ALSO
MOVEM T1,OPNBLK+.OPBUF
OPEN LIBC,OPNBLK ;OPEN THE CHAN
JRST OPENER ;CANT
SETO T1, ;T1=-1 UNLESS CREATING FILE
LOOKUP LIBC,LKPBLK ;FIND THE FILE
JRST [HRRZ T1,LKPBLK+.RBEXT ;CAN'T--GET FAIL CODE
JUMPN T1,LKENER ;ALL ARE FATAL EXCEPT FILE NOT FOUND
JRST .+1] ;DO THE ENTER NOW
ENTER LIBC,LKPBLK ;ENTER TO DO UPDATE
JRST E$$CWL ;**CAN'T WRITE LIB
HRLES P1 ;GET FLAG OUT TO FULL WORD NOW
JUMPL P1,LIBUPE ;JUMP IF UPDATE NOT APPEND
SKIPE T1 ;DON'T USETI IF JUST CREATING THE FILE
USETI LIBC,-1 ;THIS APPENDS
MOVE P1,T1 ;COPY CREATE/APPEND FLAG
CALL GETNBF ;# BUFFERS
MOVE T2,[XWD OPNBLK,OBHR] ;
CALL .ALCBF## ;ALLOCATE BUFFERS
OUTPUT LIBC, ;DUMMY OUTPUT
SKIPE T2,P1 ;GET FILE SIZE OR 0 IF JUST CREATING
MOVE T2,LKPBLK+.RBSIZ;IT EXISTS--GET SIZE
LSH T2,-7 ;CONVT TO BLOCKS
MOVEI B,1(T2) ;SETUP B TO WHERE WE WILL APPEND
POPJ P, ;ALL DONE
LIBUPE: SKIPN T1 ;FILE MUST EXIST
STOPX$ ;OR THERE IS A BUG
MOVSI T1,1 ;USE ONE BUFFER
MOVE T2,[XWD OPNBLK,OBHR] ;FOR OUTPUT
CALL .ALCBF## ;...
OUTPUT LIBC, ;DUMMY OUTPUT
MOVSI T1,1 ;AND ONE FOR INPUT TOO
MOVE T2,[XWD OPNBLK,IBHR]
PJRST .ALCBF## ;ALLOCATE INPUT BUFFERS AND RETURN
;HERE TO CLOSE LIB WHICH WAS OPENED FOR OUTPUT
OLBCLS: CLOSE LIBC, ;CLOSE CHAN
GETSTS LIBC,T1 ;CHECK FOR CLOSE ERRORS
TRNE T1,IO.ERR ;WERE THERE ANY?
WARN. EF$OCT,ECL,<I/O ERROR CLOSING LIBRARY - >
RELEASE LIBC, ;GIVE IT ALL UP
OLBCL2:MOVEI T1,OBHR ;GET BHR ADDR
;HERE TO FREE BUFFERS -- T1 POINTS AT FIRST WORD OF BUFFER HEADER
TSTBHR: SKIPN .BFADR(T1) ;BUFFERS USED?
POPJ P, ;NO--ALL DONE
SAVE$ T1 ;YES--REMEMBER ADDR
CALL .FREBF## ;FREE BUFFERS
RESTR$ T1 ;GET PTR BACK
SETZM .BFADR(T1) ;CLEAR IT OUT
SETZM .BFPTR(T1)
SETZM .BFCTR(T1)
POPJ P,
;HERE TO OPEN DISK FOR INPUT -- STUFF SETUP BY WILD
;CPOPJ IF NOT FOUND--CPOPJ1 IF OK
DSKOPI: JSP T2,$SAVE3 ;SAVE P1-3
MOVE P2,[Z INPC,IBHR(.IOBIN)] ;ARG FOR OPENIO
DSKIO0: CALL ZERLKP ;ZERO ANY OLD LKPBLK STUFF
MOVE T1,[XWD DSKBGN,IOXBGN] ;BLT STUFF TO OPNBLK/LKPBLK
BLT T1,IOXEND
MOVE T1,WLDFIR ;POINT TO SCAN BLOCK
MOVE T2,OPNBLK+.OPDEV;GET THE DEVICE
DEVCHR T2, ;SEE IF IT CAN
TRNN T2,DV.M13 ;DO BINARY I/O
JRST [ERROR. (EF$ERR!EF$FIL,CDB,<CAN'T DO BINARY I/O TO >)
POPJ P,] ;NO--SO DON'T TRY IT
CALL FNDFIL ;LOOKUP/ENTER THE FILE
JRST DSKIOF ;OPEN FAILURE
JRST DSKIOF ;LOOKUP/ENTER FAILURE
MOVS T1,[XWD DSKBGN,IOXBGN] ;SETUP TO COPY LKPBLK TO DSKLKP
BLT T1,DSKLKP+.RBTIM ;IN CASE ANYONE EXPECTS IT TO BE THERE
JRST $POPJ1 ;CPOPJ1 BACK
DSKIOF: MOVEI T1,LKPBLK ;POINT AT LKPBLK
MOVEI T2,.RBTIM ;THE SIZE OF THE BLOCK
MOVE T3,WLDFIR ;AND THE SCAN SPEC INVOLVED
PJRST E.LKEN## ;REPORT ERROR AND RETURN CPOPJ
REPEAT 0,<
;HERE TO OPEN DISK FOR OUTPUT -- STUFF SETUP BY WILD
;ALWAYS CPOPJ BACK
DSKOPO: JSP T2,$SAVE3 ;SAVE P1-3
MOVE P2,[Z OUTC,@OBHR(.IOBIN)]
PJRST DSKIO0 ;JOINT INPUT
>;END REPEAT 0
;HERE TO CLOSE DSK INPUT
DSKICL: CLOSE INPC,
RELEASE INPC,
MOVEI T1,IBHR
PJRST TSTBHR ;FREE BUFFERS
;HERE TO CLOSE DSK OUTPUT
DSKOCL: CLOSE OUTC,
RELEASE OUTC,
MOVEI T1,OBHR
PJRST TSTBHR
;HERE TO CLOSE LIBRARY INPUT
ILBCLS: CLOSE LIBC,
RELEASE LIBC,
MOVEI T1,IBHR
PJRST TSTBHR ;GIVE BUFFERS AND RETURN
;CHROUT -- SEND CHARACTER IN T1 TO OUTPUT FILE (ASCII MODE)
CHROUT: SOSG OBHR+.BFCTR ;ROOM IN DA BUFFER?
JRST CHRBFO ;NO--DUMP A BUFFER
CHRO.1: IDPB T1,OBHR+.BFPTR ;STORE THE CHARACTER
POPJ P,
CHRBFO: CALL XCTIO ;DUMP A BUFFER
OUT OUTC, ;...
STOPX$ ;***
JRST CHRO.1 ;GO STORE THE CHARACTER
SUBTTL TTY OUTPUT OPEN/CLOSE ROUTINES
;CALL HERE TO OPEN TTY IN BUFFERED OUTPUT ONLY
OPNTTO: MOVEI T1,.IOASC ;MODE
TXO T1,UU.PHS ;PHYSICAL TTY PLEASE
MOVEM T1,OPNBLK+.OPMOD;...
MOVSI T1,'TTY' ;THE DEVICE
MOVEM T1,OPNBLK+.OPDEV
MOVSI T1,OBHR ;BUFFER HEADER
MOVEM T1,OPNBLK+.OPBUF
OPEN OUTC,OPNBLK ;OPEN THE TTY FOR OUTPUT
STOPX$ ;SHOULD NEVER GET HERE!
MOVSI T1,6 ;USE LOTS OF BUFFERS
MOVE T2,[XWD OPNBLK,OBHR]
CALL .ALCBF## ;ALLOCATE BUFFERS
OUTPUT OUTC, ;DUMMY OUTPUT
POPJ P,
CLSTTO=DSKOCL ;CAN USE SAME ROUTINE AS DISK
SUBTTL OPEN I/O CHANNELS
;OPENIO
;CALL: MOVEI T1,<FDB ADDR>
; CALL OPENIO
; CAI CHANNEL,BUFADR ;@ IF OUTPUT, (MODE)
; *FILE NOT FOUND ON LOOKUP* ;ABORT IF OPEN OR ENTER FAILS
; *ALL IS WELL*
OPENIO: HRL T1,0(P) ;REMEMBER CALLER
JSP T2,$SAVE3 ;PRESERVE REGISTERS
MOVS P1,T1 ;COPY ARGUMENTS
MOVE P2,(P1) ;GET REST OF THEM
CALL ZERLKP ;CLEAR LKPBLK
MOVSI T1,.FXLEN ;SETUP FOR .STOPB
HLR T1,P1 ;...
MOVEI T2,OPNBLK ;
MOVE T3,[XWD .RBTIM+1,LKPBLK] ;
CALL .STOPN## ;CONVERT TO OPEN/LOOKUP BLOCKS
JRST WLDERR ;NO WILDCARDING!
CALL FNDFIL ;LOOKUP/ENTER THE FILE
JRST OPENER ;CAN'T OPEN DEVICE
SKIPA T1,LKPBLK+.RBEXT ;CAN'T FIND/WRITE--GET CODE AND SKIP
JRST $POPJ2 ;OK--SKIP 2
TLNN P2,ATSIGN ;IF WRITING
TRNE T1,-1 ;OR OTHER THAN FILE NOT FOUND
JRST LKENER ;GO BARF
POPJ P, ;NO--FILE NOT FOUND ON LOOKUP--RETURN CPOPJ
$POPJ2: AOS (P) ;SKIP 2
$POPJ1: AOS (P) ;SKIP 1
$POPJ: POPJ P, ;SKIP 0
;$SAVE3 -- SAVE P1-3 WITH ALLOWANCE FOR DOUBLE SKIP RETURNS
$SAVE3: SAVE$ <P1,P2,P3> ;SAVE P1-3 ON PDL
PUSHJ P,(T2) ;CALL THE ROUTINE
JRST $RET3 ;NO SKIP BACK
SKIPA ;ONE SKIP BACK
AOS -3(P) ;TWO SKIPS BACK
AOS -3(P) ;AND ANOTHER
$RET3: RESTR$ <P3,P2,P1> ;GET REGISTERS BACK
POPJ P, ;SKIP ONCE, TWICE, OR NOT AT ALL
;CALL HERE TO ZERO LKPBLK
ZERLKP: STORE T1,LKPBLK,LKPBLK+.RBTIM,0
POPJ P, ;THAT WAS EASY
;FNDFIL -- DO OPEN-LOOKUP/ENTER ON FILE
;CALL: OPNBLK/LKPBLK SETUP
; MOVE P2,<Z CHAN,@BHDR(MODE)> ;@ IF WRITING
; CALL FNDFIL
; *OPEN FAILED*
; *LOOKUP/ENTER FAILED*
; *OK*
;ACS:T1,P3
FNDFIL: MOVEI T1,.RBTIM ;SETUP COUNT
MOVEM T1,LKPBLK+.RBCNT
LDB T1,[POINT 4,P2,17] ;GET MODE
MOVEM T1,OPNBLK ;STORE IN OPEN BLOCK
HRRZ T1,P2 ;BUFFER HEADER ADDRESS
TLNE P2,ATSIGN ;READ OR WRITE?
MOVSS T1 ;WRITING, POSITON FOR IT
MOVEM T1,OPNBLK+.OPBUF;STORE
LDB P3,[POINT 4,P2,12] ;GET I/O CHANNEL
LSH P3,5 ;POSITION
MOVSS P3 ;IN CHANNEL POSITION
MOVE T1,[OPEN OPNBLK];FORM INSTR
OR T1,P3 ;FINISH
XCT T1 ;TRY TO OPEN DEVICE
POPJ P, ;CAN'T--QUIT NOW
MOVE T1,P3 ;REGET I/O CHANNEL
TLNE P2,ATSIGN ;READ/WRITE?
TLOA T1,(ENTER) ;WRITE
TLO T1,(LOOKUP) ;READ
HRRI T1,LKPBLK ;COMPLETE INSTR
XCT T1 ;FIND/WRITE THE FILE
JRST $POPJ1 ;CAN'T--SKIP 1
JRST $POPJ2 ;ALL IS WELL--SKIP 2
;GETNBF -- GET VALUE OF /BUFFER
;CALL: CALL GETNBF
; *T1=#BUFFERS,,0*
GETNBF: SKIPG T1,S.BUFR
MOVEI T1,DF$BUF ;NO--USE DEFAULT
MOVEM T1,S.BUFR ;SET FOR LATER
MOVSI T1,(T1) ;MOVE TO LH AND ZERO RH
POPJ P, ;RETURN
;OPENIO ERRORS
OPENER: HLRZ T1,P1 ;COPY FDB ADDR
FATAL. EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >
WLDERR: HLRZ T1,P1 ;GET FDB
FATAL. EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >
LKENER: HRRZ T1,LKPBLK+.RBEXT;GET FAIL CODE
ERROR. EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
STRNG$ <) FILE >
HLRZ T1,P1
CALL .TFBLK## ;TYPE SCAN BLOCK
CALL .TCRLF## ;NEW LINE
X$$LER: JRST ERRFTL ;GO DIE
;.TPRIV -- TYPE PRIV WORD IN T1
;CALL: MOVE T1,9BIT PRIV WORD
; CALL .TPRIV
.TPRIV: MOVE T2,T1 ;POSITION PROT
MOVEI T1,"<" ;GET AN ANGLE BRACKET
CALL .TCHAR## ;SEND IT
CALL TPRIV0 ;TYPE PROTECTION
MOVEI T1,">" ;CLOSE PROTECTION
PJRST .TCHAR## ;AND RETURN
;HERE WITH T2 CONTAINING PROT IN LOW ORDER 9 BITS TO TYPE
TPRIV0: ANDI T2,777 ;TRIM TO PROT
ROT T2,-^D9 ;POSITION
MOVEI T3,3 ;SET TO TYPE 3 DIGITS
TPRVLP: SETZ T1, ;CLEAR JUNK
LSHC T1,3 ;GET AN OCTAL DIGIT
MOVEI T1,"0"(T1) ;MAKE IT ASCII
CALL .TCHAR## ;SEND THE CHARACTER
SOJG T3,TPRVLP ;DO ALL 3
POPJ P, ;DONE
;CLRUSE -- CLEAR USE BITS
;CALL: HRRZ T1,BHDR+.BFADR ;**THIS INSTR USED BY THIS ROUTINE
; CALL CLRUSE
; WAIT CHAN, ;XCT'D FIRST
; *USE BITS CLEARED*
CLRUSE: XCT @0(P) ;WAIT FOR IDLENESS
MOVSI T3,(BF.IOU) ;THE BIT TO CLEAR
HRRZ T2,T1 ;COPY ADDR
CLRU.1: ANDCAM T3,0(T2) ;CLEAR ONE
HRRZ T2,(T2) ;CHAIN TO NEXT
CAME T1,T2 ;THIS IS DONENESS
JRST CLRU.1 ;NOT YET
MOVSI T3,(BF.VBR) ;MAKE IT A VIRGIN RING
MOVE T2,(P) ;GET RETURN
IORM T3,@-2(T2) ;SET VIRGIN BIT INTO BUFFER HEADER
JRST $POPJ1 ;SKIP INSTR ON WAY BACK
;HERE WITH T1 PTS TO OPEN BLOCK
;T2 PTS AT LOOKUP BLOCK
;WILL TYPE FILESPEC/VERSION/PROT
$TLBVP: PUSH P,T2 ;SAVE LOOKUP BLOCK ADDRESS
CALL .TOLEB## ;TYPE THE FILE SPEC
MOVE T1,(P) ;GET LOOKUP BLOCK ADDRESS
LDB T1,[POINTR(.RBPRV(T1),RB.PRV)] ;GET PRIV BITS
CALL $TPROT ;TYPE /PROTECT:P
POP P,T1 ;GET LOOKUP BLOCK ADDRESS
MOVE T1,.RBVER(T1) ;GET THE VERSION
PJRST $TVRSN ;TYPE AND RETURN
SUBTTL XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING
;XCTIO
;CALL: CALL XCTIO
; <INSTR TO XCT> ;IN/OUT UUO
; *EOF/EOT RETURN*
; *NORMAL RETURN*
XCTIO: XCT @0(P) ;DO THE INSTR
JRST $POPJ2 ;OK--SKIP 2 AND RETURN
SAVE$ T1 ;OOPS--SAVE T1
MOVE T1,@-1(P) ;GET INSTR WE FAILED ON
AOS -1(P) ;SKIP INSTR ON WAY BACK
AND T1,[17B12] ;ERROR--GET THE CHANNEL
OR T1,[GETSTS T2] ;GET ERRROR BITS
XCT T1
TRNE T2,IO.EOF!IO.EOT;END OF SOMETHING?
JRST TPOPJ ;YES
EXCH T1,T2 ;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
HRR T2,T1 ;PUT BITS IN THE INSTR
SAVE$ T2 ;SAVE I/O INSTR A SEC
WARN. EF$OCT,IOE,<I/O ERROR - STATUS=>
RESTR$ T1 ;GET INSTR BACK
TRZ T1,IO.ERR ;CLEAR ERROR BITS
TLZ T1,002000 ;GETSTS BECOMES SETSTS
XCT T1
TPOPJ1: RESTR$ T1 ;GET T1 AGAIN
AOSA (P)
TPOPJ: RESTR$ T1
POPJ P,
SUBTTL ERROR HANDLER
;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERR$ MACRO
EHNDLR: CALL SAVACS ;SAVE THE ACS
MOVE P1,@0(P) ;GET FLAGS AND ADDRESSES
SKIPN @.TYOCH## ;IS SCAN TTCALLING?
JRST [SETZM ERRTYX ;YES--CLEAR FLAG
JRST EHND.0] ;AND SKIP ON
SETZ T1, ;NO--SO MAKE IT
CALL .TYOCH## ;TELL SCAN
MOVEM T1,ERRTYX ;REMEMBER/SET FLAG
EHND.0: MOVEI T1,"?" ;ASSUME AN ERROR
TLNE P1,EF$WRN ;CHECK WARNING
MOVEI T1,"%" ;YES
TLNE P1,EF$INF ;IF BOTH OFF NOW THEN INFO
MOVEI T1,"[" ;GOOD THING WE CHECKED
CALL .TCHAR## ;OUTPUT THE START OF MESSAGE
MOVSI T1,MY$PFX ;SET UP MY PREFIX
HLR T1,(P1) ;GET MESSAGE PREFIX
CALL .TSIXN## ;OUTPUT THE PREFIXES
CALL .VERBO## ;GET MESSAGE BITS
TXNN T1,JWW.FL ;SEE IF FIRST LINE
JRST EHNDSH ;NO--FINISH SHORTLY
CALL .TSPAC## ;AND A SPACE
HRRZ T1,(P1) ;GET STRING ADDRESS
CALL .TSTRG## ;SEND IT
MOVE T1,SAVAC+T1 ;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
MOVE T2,SAVAC+T2 ;AND ORIGINAL T2 IN CASE .TOLEB REQUESTED
LDB T3,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
CAILE T3,EF$MAX ;CHECK LEGAL
MOVEI T3,0 ;NOOOP
CALL @ERRTAB(T3) ;CALL THE ROUTINE
TLNE P1,EF$NCR ;IF NO CRLF THEN DON'T CLOSE INFO
JRST EHND.1 ;NO--DON'T CHECK
MOVEI T1,"]" ;PREPARE TO CLOSE INFO
TLNE P1,EF$INF ;CHECK FOR INFO
CALL .TCHAR## ;SEND INFO CLOSE
TLNN P1,EF$NCR ;NO CARRIAGE RETURN?
CALL .TCRLF## ;YES--SEND ONE
EHND.1: SKIPN T1,ERRTYX ;DID WE RESET SCAN?
JRST EHND.2 ;NO
CALL .TYOCH## ;AND RESTORE IT
SETZM ERRTYX ;CLEAR FLAG
EHND.2: TLNE P1,EF$FTL ;NOW CHECK FATAL
JRST ERRFTL ;YES--GO DIE
PJRST RESACS ;RESTORE ACS AND RETURN
;HERE IF /MESSAGE:PREFIX ONLY
EHNDSH: TLNE P1,EF$FTL ;IS THIS FATAL?
JRST ERRFTL ;YES--GO DIE
CALL .TCRLF## ;NEW LINE
TLNN P1,EF$NCR ;SEE IF /NOCRLF FROM ERROR MACRO
JRST RESACS ;NO--JUST GO RETURN
MOVE T1,1(P1) ;YES--GET X$$PFX ADDRESS
HRRM T1,(P) ;SET FOR RETURN TO THERE
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
; CALL RESACS
; *ACS RESTORED FROM SAVAC*
RESACS: MOVEM 17,SAVAC+17 ;SAVE 17 TO RESTORE INTO IT
MOVSI 17,SAVAC
BLT 17,17 ;REGISTERS ARE RESTORED
POPJ P, ;RETURN
ERRTAB: .POPJ## ;CODE 0 -- NO ACTION
.TDECW## ;CODE 1 -- TYPE T1 IN DECIMAL
.TOCTW## ;CODE 2 -- TYPE T1 IN OCTAL
.TSIXN## ;CODE 3 -- TYPE T1 IN SIXBIT
.TPPNW## ;CODE 4 -- TYPE T1 AS PPN
.TSTRG## ;CODE 5 -- T1 POINTS TO ASCIZ STRING
.TFBLK## ;CODE 6 -- T1 POINTS AT FDB
.TOLEB## ;CODE 7 -- T1 POINTS AT OPEN BLOCK
; -- T2 POINTS AT LOOKUP BLOCK
;HERE TO DIE--
ERRFTL: CALL .CLRBF## ;EAT ANY TYPEAHEAD OR WHATEVER
SAVE$ .JBFF ;SAVE JBFF OVER RESET
RESET ;KILL ALL FILES
RESTR$ .JBFF ;GET JOBFF BACK
MOVE P,INIPDP ;RESET PDL
PJRST .FMSGE## ;GO FINISH UP
;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
; *ACS SAVED IN SAVAC* BEWARE!!
SAVACS: MOVEM 17,SAVAC+17 ;SAVE ONE
MOVEI 17,SAVAC
BLT 17,SAVAC+16
MOVE 17,SAVAC+17
POPJ P, ;ACS ARE SAVED
E$$NUC: FATAL. 0,NUC,<NO 'USE' OR 'CREATE' COMMAND>
;.TDOT -- TYPE A DOT
.TDOT: MOVEI T1,"." ;GET ONE
PJRST .TCHAR## ;AND TYPE IT
SUBTTL STORAGE
RELOC 0 ;STORAGE ALL IN LOW SEGMENT
;STORAGE THAT REMAINS BETWEEN RUNS
U (ISCNVL) ;VALUE FROM .ISCAN
U (TLDVER) ;-1 WHEN TYPED VERSION TO TTY
U (OFFSET) ;STARTING OFFSET
U (FLTMPC) ;FLAG THAT WE HAVE TRIED TO READ NNNLRL.TMP
FW$ZER==. ;FIRST WORD ZEROED
U (CCLNAM) ;NNNLIB
U (PDLIST,LN$PDL) ;PUSHDOWN LIST
U (SAVAC,20) ;SAVE ACS HERE
U (DIRPTR) ;PTR TO DIR BLOCKS
U (LSTPTR) ;PTR TO LST BLOCKS
U (OUTFDB) ;PTR TO FDB FOR OUTPUT SPEC
U (LIBFDB) ;PTR TO LIB FDB
U (DIRECT,LN$DRB) ;INTERMEDIATE DIRECT BLOCK
U (WLDFIR) ;PTR TO FDB FOR .LKWLD
U (WLDPTR) ;.LKWLD STORES CURRENT FDB HERE
U (FILCNT) ;COUNT OF FILES PROCESSED
U (NOFILR) ;COUNT OF FILES REJECTED FOR ONE REASON OR ANOTHER
U (IFDBAD) ;ADDR OF INPUT FDB
U (OFDB,.FXLEN) ;OUTPUT FDB FOR .SCWLD
;**DO NOT SEPARATE
U (DSKOPN,3) ;OPEN BLOCK FOR DISK
DSKBGN=DSKOPN ;FOR A BLT
U (DSKLKP,.RBTIM+1) ;DISK LOOKUP BLOCK
U (OPNBLK,3) ;OPEN BLOCK
IOXBGN=OPNBLK ;FOR A BLT
U (LKPBLK,.RBTIM+1) ;LOOKUP/ENTER BLOCK
IOXEND=.-1 ;END OF BLT
U (TMPOPN,3) ;TEMP OPEN BLOCK
U (TMPLKP,.RBTIM+1) ;TEMP LOOKUP/ENTER BLOCK
TMPXEN==.-1 ;END OF BLT FOR TEMP BLOCK
;**END DO NOT SEPARATE
U (ERRTYX) ;FLAG FOR EHNDLR
U (IBHR,3) ;INPUT BUFFER HEADER
U (OBHR,3) ;OUTPUT BUFFER HEADER
U (LBHR,3) ;LIBRARY BUFFER HEADER
SCN$FZ==. ;FIRST WORD ZEROED AT CLRANS
SCN$LZ==.-1 ;LAST WORD ZEROED AT CLRANS
SCN$FO==. ;FIRST WORD MINUS ONNED AT CLRANS
U (S.BUFR) ;/BUFFER:N ARG
U (S.DSUP) ;/DSUPERSEDE ARG
U (S.LSUP) ;/LSUPERSEDE ARG
U (S.SUPR) ;/SUPERSEDE ARG
U (S.REML) ;/REMEMBER ARG
SCN$LO==.-1 ;LAST WORD ONNED AT CLRANS
LW$ZER==.-1 ;LAST WORD ZEROED AT STARTUP
RELOC ;LITERALS GO IN HIGHSEGMENT
XLIST ;FORCE OUT LITERALS
LIT
LIST
LIBEND::END LIBMAN