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) CTITLE (TITLE,,\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) 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) 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==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, ;$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) ,[''$PFX'',,[ASCIZ @$MSG@ ] IFN $FLGS&EF$NCR,] > ;FATAL. FLGS,PFX,MSG DEFINE FATAL. ($FLGS,$PFX,$MSG) ;WARN. FLGS,PFX,MSG DEFINE WARN. ($FLGS,$PFX,$MSG) ;INFO. FLGS,PFX,MSG DEFINE INFO. ($FLGS,$PFX,$MSG) ;STOPX$ STOPS THE PROGRAM QUICKLY WITH A HALT DEFINE STOPX$ SUBTTL OTHER MACRO DEFINITIONS ;SAVE$ SAVES DATA ON THE STACK DEFINE SAVE$ (X) LIST> ;RESTR$ RESTORES DATA FROM THE STACK DEFINE RESTR$ (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) ;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY DEFINE ASCIZ$ (S) ;JUMPCR (LOC) JUMPS TO LOC IF CREATE COMMAND DEFINE JUMPCR (LOC) ;JUMPNC (LOC) JUMPS TO LOC IF NOT CREATE COMMAND DEFINE JUMPNC (LOC) ;JMPRDO (LOC) JUMPS TO LOC IF READ ONLY DEFINE JMPRDO (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$ ;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, ;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$ ;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 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,) 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$ 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, 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, 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, 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, ;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,) ;??? 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, 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, 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$ 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$ ;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, 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, 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, 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$ 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$ 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, 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, 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,) ;??? 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, 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$ 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, 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, 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, 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, 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, JRST USE.1 ;GO SEE IF WE CAN WRITE IT E$$BDL: ERROR. EF$ERR,BDL, ; 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, ;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, ; 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, 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$ ;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$ ;WIN--RESTORE REGS JRST $POPJ1] ;AND SKIP BACK HRRZS T4 ;CLEAR WORD COUNT JUMPN T4,MLSF.0 ;JUMP IF MORE FDBS RESTR$ ;NO--RESTORE FILE.EXT POPJ P, ;FAIL BACK ;$TPROT -- TYPE /PROTECT:OOO ;CALL: MOVE T1, ; CALL $TPROT ;ACS:T1-4 $TPROT: PUSH P,T1 ;SAVE PROT STRNG$ POP P,T2 ;GET PROT BACK PJRST TPRIV0 ;GO TYPE PROTECTION AND RETURN ;$TVRSN -- TYPE /VESION:V ;CALL: MOVE T1, ; CALL $TVRSN ;WILL TYPE ONLY IF NON-ZERO $TVRSN: JUMPE T1,$POPJ ;DON'T BOTHER IF ZERO PUSH P,T1 ;SAVE VERSION STRNG$ 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, ; 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, ; CALL AD2DIR ;ACS: T1-4 ;AD2LST -- ADD FILE TO A LIST ;CALL: MOVE T1,FILNAM ; MOVE T2,EXTNSN ; MOVEI T3, ; HRRZ B, ; 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$ ;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, ; MOVEI T2, ; 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, ; 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, 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,) 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, ; 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$ ;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$ ;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, ;@ 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, WLDERR: HLRZ T1,P1 ;GET FDB FATAL. EF$FIL,WFI, LKENER: HRRZ T1,LKPBLK+.RBEXT;GET FAIL CODE ERROR. EF$ERR!EF$OCT!EF$NCR,LER, 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 ; ;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, 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, ;.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