Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
fast.mac
There are 5 other files named fast.mac in the archive. Click here to see a list.
;FAST.MAC, IMPLEMENTS MOVE AND DUP COMMANDS
SUBTTL D BURT APR 11,75 FOR SCAN VER 7(541)
;ASSEMBLES WITH MACTEN,UUOSYM, LOCAL SEGMENT CONTROL (HILOW.MAC), SCAN MACROS
SEARCH MACTEN,UUOSYM,HILOW,SCNMAC
;LOADS WITH SCAN, WILD, HELPER
.TEXT /REL:SCN7C,REL:WLD7A,REL:HELPER/ ; [40]
;[COMMENT TO ORIGINAL VERSION, SEE REVISION HISTORY]
;THIS ROUTINE IS A TEST VERSION OF A COMMAND SCANNER FOR FAST.MAC
;A FAST DISK FILE MOVER. IT MAY EVOLVE INTO FAST OR BE REWRITTEN
;DEPENDING ON THE GENERAL CLEANLINESS IT ENDS UP WITH. SOLE FUNCTION
;AT THIS TIME IS GET GET FAMILAR WITH SCAN/WILD CALL AND PARAMETER
;CONVENTIONS
; PLACED IN PRODUCTION 7 MAY,75 AS SEEMED VALID FOR SOME
; TASKS EVEN IF NOT REALLY NICE CODE. IF REWRITE OCCURS,
; WILDCARDING NEEDS MUCH ATTENTION, AND ADDITIONAL ADVANTAGE
; COULD BE TAKEN OF SCAN/WILD/HELPER ROUTINES
;VERSION INFO
FSTVER==1 ;MAJOR VERSION
FSTMIN==0 ;NO MINOR
FSTEDT==41 ;EDIT LEVEL
FSTWHO==2 ;NON-DEC CUSP
;[21] GENERATE TITLE
TITLE. FAST - FAST DISK TO DISK COPY UTILITY,FST
;[21] AND VERSION WORD
.JBVER==137
LOC .JBVER
VRSN. FST
; ESTABLISH SEGMENT CONTROL BEFORE ANY RELOC CODE
$HILOW
$LOW
BEGINL: ;[25]START OF LOW SEG (RELOCATABLE FOR DIE)
$HIGH
BEGINH: ;[25]START OF HIGH SEC (RELOCATABLE FOR DIE)
SUBTTL CONTENTS
;DEFINITIONS 1
; CONTENTS 2
; EDITS AND OBJECTIVES 3
; AC DEFINITIONS 4
; OPDEFS AND MACROS 5
; DIE 5
; TYPE$ 5
; SCAN INTERFACE 9
; FLAGS 10
; PARAMETERS 11
;MAJOR MODULES 12
; START 12
; INITL 13
; INSPLP 14
; DOWILD 15
; FASTMV 16
;MINOR MODULES 17
; FOR INITL 17
; CHKSTR 17
; FOR INSPLP 18
; SETISP 18
; FOR DOWILD 19
; OPNLKP 19
; SETOSP 19
; OPNENT 20
; CHKIDN 20
; DELFIL 21
; SETEXT 21
; INFORM 22
; FOR FASTMV 23
; CMPMOV 23
; RESETI 24
; RESETO 25
; CALLED BY SCAN 26
; ALLIN 26
; ALLOUT 26
; MISCELLANEOUS 27
; CLRFLG 27
; GETCOR 27
; IMPLEMENT TYPE$ 28
; DIE 31
;STORAGE 32
SUBTTL EDITS AND OBJECTIVES
;[REVISION HISTORY]
;1 INITIAL EDIT LEVEL
;2 7 MAY,75/DVB
; ADDED HELPER CALL IN .TSCAN ARG BLOCK (%TSCAN),
; ALSO STANDARD VERSION INFO
;3 28 JAN,75/DVB(AT STC)
; PRESERVE PROT, CREA, ETC IN COPY, ALSO ALLOW
; MULTIPLE INPUT CALLS IN ONE OF FOLLOWING FORMATS-
; 1) *.*=A,B,C
; 2) =A,B,C (IMPLIES 1 ACTUALLY)
; ALSO INCLUDES DYNAMIC BUFFERS SINCE CORE ROUTINES NEEDED ANYWAY.
;4 4 FEB,75/DVB
; MINOR CLEANUP OF SLOPPY CODE. ERROR ROUTINES (PARTULARLY DISK ERRORS)
; NEED MUCH WORK WHEN I AM IN THE MOOD.
;5 2 MARCH,76/DVB
; FIXED BUG CAUSING MISSING EXTENTIONS (BAD CONDITION TEST FOR HAKSPC)
; AND ALTERED LOGIC OF SPEC HACKING. NEW DEFINITION IS
; OUTPUT FILE.EXT MAY BE OMMITTED IF IT IS IDENTICAL TO INPUT.
;6 9 JUN,76/DVB (BUG 1)
; CORRECTED SETZ DNSPCT IN INITL TO SETZM. WAS CAUSING IMMEDIATE
; RETURN FROM INSPLP IF NEW COMMAND HAD FEWER SPECS
; THAN LAST, ONLY PARTIAL COMPLETION OTHERWISE
;7 11 JUN,76/DVB
; ADDED SEGMENT CONTROL (USING HILOW) AND FORMALIZED BUG/EDIT
; LISTS. ALL EDITS ARE INDEXED TO OBJECTIVES AND VICE VERSA
; WHERE OBJECTIVES SHOW PROBLEM AND EDIT LIST CAN SHOW HOW FIXED.
;10 13 JUN,76/DVB (BUG 11)
; FIXED ALOCIN TO ALLOCATE INLEN, NOT INLEN+2. VERY TRANSPARENT
; TO EVERYONE.
;11 13 JUN,76/DVB (BUG 4 AND 10)
; ADD CLRFLG ROUTINE TO RESET ALLOCATION, INPUT SPEC COUNT WHENEVER
; .TSCAN RESTARTS
;12 13 JUN,76/DVB (BUG 13)
; MAKE %LOKUP AND %ENTER LENGTH EXTLEN+1, NOT EXTLEN
;13 13 JUN,76/DVB (PARTIAL FOR BUG 6)
; MAKE SETEXT SMART ENOUGH NOT TO WRITE OVER DATA PUT IN ENTER
; BLOCK BY SCAN SO SWITCHES FOR /VER, /ESTIMATE ETC WORK
;14 13 JUN,76/DVB (BUG 2,3 AND 14)
; ADDED NEW DEFAULTERS SETISP, SETOSP. SETISP ASSUMES EVERYTHING
; MISSING IS WILD (EXCEPT FOR REAL NULL EXT, IE .) AND SETOSP
; ASSUMES ANYTHING MISSING SHOULD COME FROM INPUT. THIS MEANS
; MANY THINGS ARE EASY, BUT YOU HAVE TO WATCH IT IF YOU WANT
; TO USE POWER OF CANONICAL FORM DEFAULTING TO HAVE NOTHING
; MISSING IN OUTPUT OR IT COMES FROM INPUT
;15 13 JUN,76/DVB (BUG 5(PARTIAL) AND 6)
; ADDED LOCAL SWITCHES. FIRST BATCH HAS ONLY /OKERR, /NOOKERR
; AND /INFORM. /NOOKERR SAYS STOP ON I/O ERRORS (DEFAULT)
; /OKERR SAYS KEEP GOING BUT GIVE MESSAGE. ALLOWS COPY OF FILES
; WITH A BAD BLOCK OR TWO
; /INFORM:KEYWD TYPES EACH FILE IN ONE OF THREE FLAVORS
; NONE IS INITIAL VALUE, NO TYPEOUT
; FAST IS DEFAULT FOR /INFORM, TYPES NAME.EXT
; SLOW TYPES NAME.EXT[PATH]=STR:NAME.EXT[PATH],SIZE IN BLOCKS
;16 13 JUN,76/DVB (BUG 15)
; ADDED CHKIDN TO SEE IF IDENTICAL SPECS IN AND OUT, ABORT IF SO
;17 13 JUN,76/DVB (BUG 12)
; ADDED CCL ENTRY AND SUPPORT FOR TWO RESCAN COMMANDS
; .MOVE OSPEC=ISPEC/SW,ISPEC/SW
; .HOLD ISPEC/SW,ISPEC/SW
; MOVE IS FAST WITH RESCAN CAPABILITY
; HOLD IS IDENTICAL EXCEPT OUTPUT SPEC DEFAULTS TO WRK:=
; ALSO HOLD DEFAULTS TO /INFORM:FAST
;20 14 JUN,76/DVB (BUG 17)
; TEST FOR NULL FILE IN FASTMV AND RETURN IF SO,
; ALSO BE SURE FILES CLOSE ON ALL BRANCHES THAT DONT RESTART
;21 14 JUN,76/DVB (BUG 20)
; INCORPORATED TITLE. IN MACTEN (LOCAL ONLY)
;22 16 JUN,76/DVB (BUG 23)
; FIX CHKIDN TO DO RESET CHANNEL INSTEAD OF CLOSE SO DONT
; SUPERCEDE FILES WITH ZERO LENGTH VERSION.
;23 17 JUN,76/DVB (BUG 7)
; QUOTA FOR SYSTEM UFD'S IS 377777,777777. MAKE SPECIAL TEST.
;24 22 JUN,76/DVB (BUG 32)
; ANOTHER STAB AT EDIT 16,22. USE CLOSE WITH NEW COPY DISCARDED
; RATHER THAN OLD (CL.RST) AS RESDV. SAYS HE IS UNIMPLEMENTED.
;25 6 JUNE,76/DVB (BUG 5, ALSO EDIT 5)
; ADDED TYPE$ MACRO AND TYPER ROUTINE FOR IMPROVED ERROR
; MESSAGE CAPABILITY. CONVERTED MOST ERRORS TO NEW CALL
;26 6 JUNE,76/DVB (BUG 26)
; REWORKED START AND INTERNAL RESTART CODE. ISCAN ONLY CALLED ONCE
; UNLESS USERS ^C START'S. REINITIALIZE INTERNALLY BY CALLING
; RESTRT
;27 6 JUNE,76/DVB (PARTIAL BUG 26 AND 22)
; ADDED 'DUPLICATE' AS RESCAN COMMAND. PERFORMS FUNCTION 'MOVE'
; USED TO. MOVE IS NOW 'MOVE AND DELETE' AS THIS SEEMS MORE NATURAL
; ADDED FLAGS MOV,DUP AND HLD, RESEQUENCED TESTS TO FIX BUG 22
; AND ADDED /MODE SWITCH SO CAN MOVE OR HOLD WITHOUT CCL MODE
;30 9 JUL,76/DVB (BUG 16)
; CHECK FOR UFD ON HOLD STR BEFORE SETTING UP FIRST SPEC.
; SEQUENCE IS 1)OPEN STR 2)GET PATH FOR STR 3)LOOKUP UFD FOR
; DEFAULT PPN ON STR. IF ALL WINS WE ASSUME WE CAN GO.
;31 9 JUL,76/DVB (BUG 33)
; WILD REPORTS ENTER FAILURE AS THOUGH WERE IN E+4 BUT IS REALLY
; IN E+3 SO MOVE IT FIRST
;32 10 JULY,76/DVB (BUG 34)
; CLEAN UP AND REORGANIZE CODE INTO GENERALLY 1 PAGE ROUTINES
; NO FUNCTIONAL CHANGES BUT BETTER TEST FOR ALLOWING FOR FIRST
; RIB IN CMPMOV AND BETTER MESSAGE IF NOT ENOUGH CORE FOR BUFFER
; ADDED OPNLKP, OPNENT, CMPMOV, RESETI, RESETO, CHANGED GETCOR
; ARGS AND MOVED MINOR MODULES TO APPROPRIATE SECTIONS
;33 10 JULY,76/DVB (BUG 27)
; ADDED CALL TO .CHKTM TO VERIFY /BEFORE,/AFTER
;34 11 JULY,76/DVB (BUG 35)
; ADDED $P TO CDF MESSAGE TO SHOW DIRECTORY OF FILE
; ALSO ADD PPN TO /I:F IFF PPN IS NOT OURS
;35 28-JUL-76/RWS (BUG 36)
; FIX FAST INFORM BUG
;36 17-NOV-76/DVB (BUG 37)
; INCREASE BUFFER SIZE SINCE BIG BUFFERS ARE FASTER THAN CLUSTER
; SIZE ONES (BUT NEVER LESS THAN 1 CLUSTER)
;37 17-NOV-76/DVB (BUG 37)
; CORRECT POINTER AT OFILLS
;40 4-MAR-77/RWS (BUG 43)
; CHANGE THE DEFAULT ON THE INFORM SWITCH TO BE SLOW WHEN NO
; MODIFIER IS GIVEN AND USE SCAN %7C, WHICH ALLOWS PROTECTION
; CODES OF THE FORM <NNN>
;[END REVISION HISTORY]
PAGE ;SO CAN APPEND TO WORK BOTH EDITS AND OBJECTIVES
;[REVISION OBJECTIVES (UNIMPLEMENTED WHEN PRECEDED BY *)]
;1 28 APR,76/DVB (EDIT 6)
; CONSTRUCT WRK:=WRK: WINS ONCE, NEVER TRANSFERS DATA
; AFTER THAT BUT NO ERROR MESSAGE!
;2 6 JUNE,76/DVB (EDIT 14)
; OLD CONSTRUCT STR:=STR: FAILS, STR:=STR:*.* OK
; THIS WILL BREAK OLD CTL FILES
;3 7 JUNE,76/DVB (EDIT 14)
; CONSTRUCT WRK:=MASTER FAILS, SHOULD IMPLY MASTER.* LIKE
; DIRECT DOES. USE MASTER. FOR NULL EXT
;4 10 JUNE,76/DVB (EDIT 11)
; CONSTRUCT WRK:=FILE.A WHEN FILE.A IS ON DSKB AND SEARCH
; LIST IS DSKB,WRK COPIES FILE TO WRK, THEN SUPERCEEDES IT
; THERE! I MAY NOT HAVE ALL THE INFO YET.
;5 10 JUNE,75/DVB (EDIT 6 PARTIAL, ALSO EDIT 25)
; ERROR MESSAGES NEED CLEANUP, IN SOME CASES MUCH MORE DETAIL (SUCH
; AS I/O ERRORS. MIGHT WANT TO USE (OR OVERHAUL) $MSG LIKE EBCOPY.
;6 10 JUNE,76/DVB (EDIT 13, 15)
; NEED LOCAL SWITCHES (FOR "IGNORE I/O ERROR, ETC) AND IMPLEMENT
; SOME STANDARD ONES WE IGNORE (/PROTECT ETC.)
;7 10 JUNE,76/DVB (EDIT 23)
; NEED BETTER TESTING FOR QUOTA/SPACE. CANNOT MOVE INTO UFD CREATED
; BY CREDIR OR SYSTEM UFD ON STR NOT MOUNTED FOR JOB
;10 13 JUNE,76/DVB (EDIT 11)
; FOUND PROBLEM IN BUG 4, ACTUALLY CAUSED BY HAVING ALOCKT AND/OR
; INSPCT WRONG IF SCAN GETS ERROR AND LOOPS IN .TSCAN WITHOUT COMMING
; BACK TO US TO CLEAR THEM. ERROR DEPENDS ON WHERE BAD SWITCH SEEN
;11 13 JUN,76/DVB (EDIT 10)
; CORRECT ALLOCATION FOR SPECS TO INLEN, NOT INLEN+2 (WHO KNOWS WHY)
;12 13 JUN,76/DVB (EDIT 17)
; ALLOW RESCAN, ETC SO CAN MAKE MONITOR COMMAND
;13 13 JUN,76/DVB (EDIT 11)
; NOTICED THAT BLOCK FOR LOOKUPS AND ENTERS 1 TO SMALL, USING
; EXTLEN BUT NEEDS OFFSET FOR WORD ZERO (COULD RESULT IN
; BAD .ISCAN CALL OR FUNNY DEFAULT EXTENTION)
;14 13 JUN,76/DVB (EDIT 14)
; IN ADDITION TO BUGS 2 AND 3, STR1:.EX1=STR:.EXT SHOULD BEHAVE LIKE
; DIRECT ALONG WITH ALL OTHER PERMUTATIONS OF THIS PARTICULAR GAME.
;15 6 SEPT,76/DVB
; USE CONTNS TECO MACRO TO BUILD CURRENT TABLE OF CONTENTS AND
; MAKE IT POSSIBLE TO KEEP IT THAT WAY.
;16 6 SEPT,76/DVB
; WHEN NOT ENOUGH SPACE IN QUOTA OR FREE, INPUT STRUCTURE IS NAMED,
; NOT OUTPUT STRUCTURE WITH SPACE PROBLEM.
; LEADS ME TO A NEW DEFINTION OF DEFAULTING.
; FIRST: ALL MISSING INPUT SPECS ARE REPLACED BY *
; THEN: ALL MISSING OUTPUT SPECS ARE REPLACED BY CORRESPONDING INPUT
; IF THIS RESULTS IN ILLEGAL WILDCARDING I PROBABLY DONT WANT TO DO
; IT ANYWAY
;15 JUN 13,76/DVB (EDIT 16)
; BUG 4 IS REAL, IF NO STR ON OUTPUT WILD WILL SCAN SEARCH LIST
; AND FIND FILES WE JUST PUT THERE. ONLY CURE I CAN SEE IS
; DEFENSIVE CODE TO SEE IF INSPEC AND OUTSPEC ARE IDENTICAL
;16 14 JUL,76/DVB (EDIT 30, IMPLIED MOUNT REJECTED)
; IN HOLD, IF WRK NOT MOUNTED, USER GETS TRASHY ERRORS. SHOULD TEST
; SEARCH LIST, IF NOT THERE MOUNT IT AS PASSIVE DEVICE OR PROVIDE CLEAN ERROR
;17 14 JUL,76/DVB (EDIT 20)
; DIE ON INTERNAL ERROR TRANSFERING A NULL FILE (IE, 0 WORDS).
; FASTMV CREATES AN IOLIST WITH A ZERO WORD COUNT AND SYSTEM
; GETS ADDRESS CHECK (UNLESS PATH. FAILS FIRST).
;20 14 JUN,76/DVB (EDIT 21)
; USE TITLE. MACRO SINCE IT IS NOW IN MACTEN AND GENERATES NICE
; TITLES WITH VERSION NUMBERS IN THEM.
;*21 14 JUN,76.DVB
; .HOLD CANNOT USE ANY OUTPUT SWITCHES LIKE /VER, /ERSUP, ETC.
; ERROR ILLEGAL OUTPUT SWITCH ON AN INPUT FILE OR SOMETHING
;22 14 JUN,76/DVB (EDIT 27)
; /INFORM:SLOW OR /I:NONE CANNOT BE GIVEN ON A .HOLD. THE
; USER SWITCH IS IGNORED AND A /I:F IS ALWAYS DONE
;23 16 JUN,76/DVB (EDIT 22)
; EDIT 16 CORRECTLY LOCATES ATTEMPT TO SUPERCEDE FILE WITH ITSELF
; AND ABORTS. UNFORTUNATLY IT CLOSES FILE THAT HAS BEEN ENTERED SO
; LEAVES OUTPUT FILE ZERO BLOCKS.
;24 21 JUN,76/DVB (EDIT 26)
; ERRORS THAT ABORT FAST ALWAYS RETURN TO NON-CCL MODE (BECAUSE
; THEY DO INTERNAL RESET) IRSPECTIVE OF ENTRY TYPE. IN FACT, ENTIRE
; RE-INITIALIZATION IS PRETTY MESSY CODE.
;25 21 JUN,76/DVB (SUPERCEEDED BY BUG 32)
; CAN GET TO INTERNAL ERROR IF NO DISK SPACE. POSSIBLE ENTER FAILS
; OR SOMETHING UNEXPECTED LIKE THAT.
;26 21 JUN,76/DVB (PARTIAL EDIT 27)
; REX SUGGESTS 'MOVE AND DELETE' MODE (FROM DSKCPY BY BANKS).
; ALSO ABILITY TO MODIFY EXTENDED PARAMETERS WITHOUT MOVING FILE
; MIGHT BE NICE (FOR SET VERSION, POSSIBLY OTHERS).
;27 21 JUN,76/DVB (EDIT 33)
; NEED /BEFORE/SINCE CAPABILITY SO CAN CONVIENTLY MOVE BACK
; ONLY DATA THAT WAS CHANGED AFTER BEING STASHED AWAY.
; PERHAPS A 'MERGE' MODE THAT PUTS LATEST OF TWO SETS OF FILES
; TOGETHER IN ONE PLACE AND DELETES OLDER ONE
;30 21 JUN,76/DVB (RETRACTED)
; OBSERVED 30 BLOCK ALLOCATIONS OCCURING IN A MOVE WITH DDBDPY.
; BETTER VERIFY THAT .RBEST IS BEING SET UP CORRECTLY. (COULD
; HAVE BEEN PARTIAL ALLOCATION BUT I DONT THINK SO).
; WAS ACTUALLY SETTING .RBEST BUT MONITOR DOESNT USE IT (6 JUN,76)
;*31 21 JUN,76
; OBSERVED THAT I WAS ABLE TO SUPERCEDE A FILE ON DSKB (WHERE
; DSK=DSKB,FENCE) WITH FILE.EXT/VER:N=DSKB:FILE.EXT! WHAT HAPPENED IN
; PATH UUO??? SHOULD FIND THIS BUG THEN FIX IT SO IF SWITCH IS
; GIVEN THAT REQUIRES COPY WE GO AHEAD AND DO IT ANYWAY (SEE BUG 26 ALSO)
;32 22 JUN,76/DVB (EDIT 24)
; RESDV. UUO FAILING (WAS WORKING EARLIER?). CLOSE CHN,CL.RST
; SHOULD HAVE SAME EFFECT. BAD CODE DID NOT ALLOW FOR ERROR
; RETURN ON RESDV. AND OLD SUPERCEED AFTER MOVE WAS BACK,
; THIS TIME ENDING WITH AN IO.BKT AFTER SUPERCEED?
;33 9 JULY,76/DVB (EDIT 31)
; GET GARBAGE' FROM LOOKUP/ENTER FAILURES. NUMBER OF ERROR
; IS VERY WRONG
;34 10 JULY,76/DVB (EDIT 32)
; LISTING IS GETTING VERY DISORGANIZED
;35 11 JULY,76/DVB (EDIT 34)
; DELETE FAILURE SHOULD ALSO TYPE PPN AS MAY NOT BE IN USERS DIRECTORY
;36 28-JUL-76/RWS (EDIT 35)
; /INFORM:FAST WAS OUTPUTTING THE FAST BLOCK INCORRECTLY; THE
; POINTER TO THE PATH BLOCK WAS BEING OUTPUT INSTEAD OF THE
; PATH ITSELF
;37 17-NOV-76/DVB (EDIT 36)
; SIMPLE DUMP MODE I/O PROGRAM RUNS TWO TO SIX TIMES FASTER
; (IN TERMS OF BLOCKS MOVED/SECOND CLOCK TIME ANYWAY, NO CPU CHANGE)
; WITH 10K'ISH BUFFERS THAN WITH TYPICAL CLUSTER SIZE ONES (.7
; TO 1.4K). AMAZINGLY ENOUGH, SO DOES FAST, SO TRADE CORE FOR
; SPEED SINCE THAT IS NAME OF GAME IN THIS PROGRAM
;40 17-NOV-76/DVB (EDIT 37)
; REPORT WRONG STRUCTURE (IE, INPUT, NOT OUTPUT) WHEN NOT
; ENOUGH QUOTA TO MOVE A FILE.
;*41 17-NOV-76/DVB
; INCORRECT HANDLING OF SFD'S. GENERALLY MOVE ONLY FIRST FILE
; OF SFD AND QUIT WHEN FROM AND TO AN SFD (WORKS OK FROM SFD TO
; UFD AND VICE VERSA)
;*42 17-NOV-76/DVB
; ON SOME OCCASIONS WE QUIT AFTER FIRST BLOCK OF UFD IF IT HAS MORE
; THAN 1 BLOCK (IE, ONLY DO FIRST 63 FILES). DETAILS UNKNOWN!
;43 4-MAR-77/RWS
; CHANGE THE DEFAULT INFORM TO SLOW IF NO MODIFIER ON THE SWITCH
;[END REVISION OBJECTIVES]
SUBTTL DEFINITIONS
;AC'S
;SCAN COMPATIBLE
F==0 ;FLAGS
T1==1 ;TEMPORARY
T2==2
T3==3
T4==4
P1==5 ;PERMENANT
P2==6
P3==7
P4==10
P==17 ;STACK
SUBTTL OPDEFS AND MACROS
;[25]USED IN PLACE OF HALTS
OPDEF DIE [PUSHJ P,BUG] ;CALL HANDLER FOR GRACEFUL CRASH
;[25]TYPEOUT MACRO SIMILAR TO THAT IN EBCOPY BUT A BIT MORE FLEXIBLE
;
;WILL INSERT ONE OR MORE VARIABLE STRINGS IN A FIXED TEXT STRING OUTPUT
;TO THE TTY WITH CONTROL OVER VERBO PREFIXES AND CONTINUATIONS
;SUBSTITUTION FORMATS INCLUDE TYPING A LOCATION IN OCTAL, DECIMAL,
;SIXBIT, SIXBIT (LEFT HALF ONLY), ASCIZ STRING, OR PPN.
;
;TYPE$ MACRO IS CALLED WITH
; TYPE$ (HEADER,PFX,SUBS,<TEXT>,TRAILER,SCHR,RETURN)
; WHERE:
; HEADER A CODE FOR THE TYPE OF HEADER TO BE SUPPLIED;
; N NOTHING SPECIAL PRECEDES (IE, THIS IS A CONTINUATION)
; F FATAL, ? PRECEDES
; W WARNING, % PRECEDES
; I INFORMATION, [ PRECEDES
; NOTE, F,W, AND I REQUIRE MESSAGE PREFIX AND WILL
; OUTPUT 6 CHR ERROR IDENTIFIER (3 PROGRAM 3 ERROR)
; T TAB PRECEDES
; PFX A UNIQUE THREE LETTER PREFIX FOR THIS ERROR (VERIFIED UNIQUE)
; REQUIRED FOR F, W, AND I, MUST NOT BE PRESENT FOR OTHERS
; SUBS TYPE OF SUSBTITUTION TO BE DONE;
; $N NONE
; $O TYPE T1 IN OCTAL
; $D TYPE T1 IN DECIMAL
; $S TYPE T1 IN SIXBIT
; $A ASCIZ POINTED BY T1
; $L TYPE T1 IN SIXBIT (LEFT HALF ONLY)
; $P TYPE T1 AS A PPN
; $I INDIRECT VIA T1, T1 CONTAINS COUNT,,ADDRESS
; WHERE COUNT IS THE NUMBER OF SUBSTITUTIONS AND
; ADDRESS POINTS TO ARG LIST FOR SUBSTITUTIONS
; OF 1 WORD EACH, FORMAT IS CODE IN HIGH 9 BITS AND
; ADDRESS IN LOW 24 (E EVALUATED), MAY BE GENERATED WITH
; SUBS @ADDRESS(INDEX)
; SINCE SUBSTITUTION CODES ARE OPDEFED.
; <TEXT> TEXT(IN BRACKETS IF ANY COMMAS OR NON-SIXBIT CHRS),
; ALL OCCURANCES OF + IN TEXT WILL CAUSE SUBSTITUTION.
; IF MORE +'S THAN SUBSTITUTION ARGUMENTS, LAST ONE
; REPEATS. IF LESS, EXCESS ARE IGNORED. DONT USE
; BACKSLASH IN TEXT AS IS DELIMITER FOR SIXBIT IN MACRO.
; TRAILER TYPE OF ENDING STRING, CRLF OR NONE, <CR> ASSUMED
; IF MISSING (NORMALY)
; SCHR CHR TO USE AS DELIMITER INSTEAD OF + IN TEXT STRING
; RETURN POP OR END FOR POPJ BACK (PAST CALL) OR EXIT, POPJ ASSUMED
; IF MISSING (NORMALLY)
;CONTINUED NEXT PAGE
;FROM PREV PAGE
;
;EXAMPLE OF ONE SUBSTITUTION
; MOVE T1,[SIXBIT/STR/]
; TYPE$ (F,NSL,$O,<STRUCTURE + IS NOT IN SEARCH LIST>)
;
;EXAMPLE OF MULTIPLE SUBSTITUTIONS
; MOVE T1,[2,,LIST] ;SET UP FOR CALL
; TYPE (F,CFF,$I,<CANNOT FIND FILE +.+>)
;LIST: $S [SIXBIT/FILE/]
; $L [SIXBIT/EXT/]
;
;EXAMPLE OF CONTINUATION
; MOVE T1,CURSTR
; TYPE$ (I,SLL,$S,<SPACE ON + IS LESS THAN >,NONE)
; MOVE T1,FRESPC
; IDIV T1,BLKSIZ
; TYPE$ (N,,$D,<LIMIT OF + AVAILABLE>)
;
;EXAMPLE OF CATASTROPHIC ERROR WITH IMMEDIATE EXIT
; TYPE$ (F,IAE,$N,<INTERNAL ABORT CONDITION ENCOUNTERED>,,,END)
;EXAMPLE OF USER DELIMITER
; MOVE T1,[2,,LIST]
; TYPE$ (N,,$I,<CORE ?+? PAGES>,,?)
;LIST: $D [LOWPGS]
; $D [HIPGS]
;MACRO VERIFIES:
; HEADER ARGUMENT IS VALID (IE, F,I,W,N)
; IF PFX REQUIRED (F,W,I) THAT IT IS UNIQUE. ALSO DEFINES $$$'PFX
; AT CURRENT LOCATION FOR CREF. NO TEST OF PFX IF NOT REQUIRED.
; SUBSTITUTION CODE IS VALID ($A,$S,ECT)
; TRAILER IS ASSUMED <CRLF> UNLESS 'NONE' IS STATED, NO OTHER TEST.
; RETURN IS ASSUMED POPJ UNLESS 'END' IS STATED, NO OTHER TEST.
;CONTINUED NEXT PAGE
;FROM PREV PAGE
;BASIC MACRO (SELECTS CALL TO VERSION WITH OR WITHOUT PFX)
DEFINE TYPE$ (HEADER,PFX,SUBS,TEXT,TRAILER,SCHR,RETURN),<
.XCREF
TYPE$.==-1
IFIDN <HEADER> <F>,<TYPE$H (HEADER,PFX,SUBS,<TEXT>,TRAILER,SCHR,RETURN)
TYPE$.==0>
IFIDN <HEADER> <W>,<TYPE$H (HEADER,PFX,SUBS,<TEXT>,TRAILER,SCHR,RETURN)
TYPE$.==0>
IFIDN <HEADER> <I>,<TYPE$H (HEADER,PFX,SUBS,<TEXT>,TRAILER,SCHR,RETURN)
TYPE$.==0>
IFL TYPE$.,<TYPE$C (HEADER,SUBS,<TEXT>,TRAILER,SCHR,RETURN)>
.CREF
> ;END TYPE$
;CALLED FROM TYPE$ IF NO PREFIX NEEDED (NORMALLY CONTINUATION)
;GENERATES CALL TO HANDLER AND 1ST AND 2ND ARG WORDS
DEFINE TYPE$C (HEADER,SUBS,TEXT,TRAILER,SCHR,RETURN),<
PUSHJ P,TYPER
TYPE$1 (RETURN,TRAILER,HEADER)
TYPE$2 (SUBS,SCHR,<TEXT>)
> ;END TYPE$C
;CALLED FROM TYPE$ IF PREFIX NEEDED (IE, FATAL, WARNING OR INFO)
;FIRST CHECKS THAT PFX IS IN FACT UNIUQE, THEN
;GENERATES CALL TO HANDLER AND 1ST AND 2ND ARG WORDS
DEFINE TYPE$H (HEADER,PFX,SUBS,TEXT,TRAILER,SCHR,RETURN),<
IF1,<IFDEF $$$'PFX,<PRINTX ? PFX USED IN TWO ERROR MESSAGES>>
.CREF
$$$'PFX==.
.XCREF
PUSHJ P,TYPER
TYPE$1 (RETURN,TRAILER,HEADER,PFX)
TYPE$2 (SUBS,SCHR,<TEXT>)
> ;END TYPE$H
;FROM PREV PAGE
;CALLED FROM TYPE$H OR TYPE$C TO GENERATE FIRST ARG WORD
;FIRST WORD OF CALL, FORMAT
; BITS CONTENTS
; 0-8 CAIA SO CAN SKIP IN SKIP OUT (FAKE 1 WORD CALL)
; 9-12 CODE FOR HEADER 0=NONE, 1=FATAL, 2=WARN, 3=INFORM
; 4=TAB
; 13 ALWAYS Z
; 14-15 CODE FOR RETURN 0=POPJ, 1=EXIT IMMEDIATLY
; 16-17 CODE FOR TRAILER 0=CRLF, 1=NONE
; 18-35 SIXBIT/PFX/ (0 FOR HEADER NONE)
DEFINE TYPE$1 (RETN,TRAIL,HEAD,PFX),<
TYPE$R==-1
IFIDN <RETN> <>,<TYPE$R==0>
IFIDN <RETN> <POP>,<TYPE$R==0>
IFIDN <RETN> <END>,<TYPE$R==1>
IFL TYPE$R,<PRINTX ?ERROR PFX ILLEGAL RETURN CODE>
TYPE$T==-1
IFIDN <TRAIL> <>,<TYPE$T==0>
IFIDN <TRAIL> <CRLF>,<TYPE$T==0>
IFIDN <TRAIL> <NONE>,<TYPE$T==1>
IFL TYPE$T,<PRINTX ?ERROR PFX ILLEGAL TRAILER CODE>
TYPE$L==-1
IFIDN <HEAD> <N>,<TYPE$L==0>
IFIDN <HEAD> <F>,<TYPE$L==1>
IFIDN <HEAD> <W>,<TYPE$L==2>
IFIDN <HEAD> <I>,<TYPE$L==3>
IFIDN <HEAD> <T>,<TYPE$L==4>
IFL TYPE$L,<PRINTX ? ERROR PFX ILLEGAL HEADER CODE>
XWD 304B26!<TYPE$L&17>B30!<TYPE$T&3>B33!<TYPE$R&3>B35,(SIXBIT/PFX/)
> ;END TYPE$1
;CALLED FROM TYPE$C AND TYPE$H TO GENERATE SECOND WORD OF ARGS
;SECOND WORD OF CALL
;FORMAT BIT CONTENTS
; 0-8 CODE FOR TYPE OF SUBSTITUTION
; 0=NONE ($N) (NO SUBS CALL IS MADE, +'S ARE TYPED)
; 1=OCTAL ($O)
; 2=DECIMAL($D)
; 3=SIXBIT($S)
; 4=ASCIZ($A)
; 5=SIXBIT($L) (LEFT HALF ONLY)
; 100=INDIRECT(I) (T1 POINTS TO BLOCK 1 WORD/SUBSTITUTION)
; 9-10 UNUSED
; 11-17 ASCII CHR FOR SUBSTITUTION
; 18-35 ADDRESS OF ASCIZ/TEXT/
DEFINE TYPE$2 (SUBS,SCHR,TEXT),<
TYPE$X=="SCHR"
TYPE$Y==<SUBS>_<-^D27>
TYPE$Z==[ASCIZ\TEXT\]
XWD <BYTE (18)0(9)TYPE$Y(2)0(7)TYPE$X>,TYPE$Z
> ;END TYPE$2
;OPDEFS FOR CODES TO SUBSTITUTION TYPES
OPDEF $N [Z]
OPDEF $O [1B8]
OPDEF $D [2B8]
OPDEF $S [3B8]
OPDEF $A [4B8]
OPDEF $L [5B8]
OPDEF $P [6B8]
OPDEF $I [100B8]
SUBTTL SCAN INTERFACE
[15];LOCAL SCAN SWITCHES
;NOTE THAT /TYPE, /ERROR ASSUME LAST VALUE SEEN IN COMMAND
;STRING AND APPLY FOR ALL OF THAT COMMAND AND UNTIL CHANGED
DEFINE SWTCHS,<
;; PROCEED ON ERROR SWITCH, INITALLY OFF, TURN OFF WITH NOOKERR
SN OKERR,LS.ERR,FS.NCM
;; INFORM LEVEL, INITIAL NONE, DEFAULT SLOW [40]
SL INFORM,LS.INF,INF,INFSLO,FS.NCM
;; [27]/MODE SO CAN GET MOVE AND HOLD WITHOUT CCL
SL MODE,LS.MOD,MOD,MODDUP,FS.NCM
> ;END SWTCHS
; DEFINE KEYS
KEYS (INF,<NONE,FAST,SLOW>)
KEYS (MOD,<HOLD,MOVE,DUPLICATE>) ;[27]
;GENERATE SWITCH TABLES
DOSCAN(FAST)
SUBTTL FLAGS
;[27]FLAGS IN LEFT HALF OF F, SET/RESET AT TOP LEVEL
FT.DUP==1B1 ;DUP MODE IN EFFECT
FT.MOV==1B2 ;MOVE MODE IN EFFECT
FT.HLD==1B3 ;HOLD MODE IN EFFECT
FT.HDR==1B4 ;HEADER IS TYPED
SUBTTL PARAMETERS
;PARAMETERS
INLEN==32 ;INPUT STRING ARG BLOCK LENGTH FOR SCAN
OUTLEN==32 ;OUTPUT STRING ARG BLOCK LENGTH FOR SCAN
LKWLEN=5 ;LENGTH OF .LKWLD ARG BLOCK
SCWLEN==4 ;LENGTH OF .SCWLD ARG BLOCK
EXTLEN==.RBEST ;LENGTH OF EXTENDED LOOKUP/ENTER BLOCKS
DEVLEN==6 ;LENGTH OF DSKCHR ARG BLOCK
WLDCHN==10 ;CHANNEL FOR WILD TO USE IN ITS TRICKS
SPCCNT==^D30 ;MAX NUMBER OF INPUT SPECS IN ONE LINE (A=B,C,D)
PDLEN==100 ;STACK LENGTH (60 IS NOT ENOUGH)
MINBLK==^D40 ;[36]MINIMUM BLOCKS TO TRANSFER IN ONE BUFFER
ICH==1 ;INPUT CHANNEL
OCH==2 ;OUTPUT CHANNEL
HLDSTR==SIXBIT/WRK/ ;OUTPUT STR IF /HOLD
SUBTTL MAJOR MODULES
;PUT CODE IN HIGH SEGMENT
$HIGH
;[26]INITIAL START
;[26]CCLFLG IS LOADED -1, SOSA ON NORMAL ENTRY, SETZM ON CCL ENTRY
;IF USER ^C START'S, WE WILL ALWAYS COME BACK NON-CCL MODE (CCLFLG < 0)
START:: SOSA CCLFLG ;[17][26]NORMAL START, DECREMENT CCLFLG
SETZM CCLFLG ;[17][26]CCL START, ZERO FLAG
RESET ;CLEAR WORLD
MOVE T1,.JBFF ;GET START OF FREE SPACE
SKIPN SAVFF ;FIRST START?
MOVEM T1,SAVFF ;SET TO STARTING VALUE
JRST STRT01 ;[26]AND MOVE ON
;HERE AFTER FATAL ERROR TO RESET WHOLE WORLD OR EXIT IF CCL[26]
RESTRT: SKIPL CCLFLG ;[26]ARE WE CCL?
JRST QUIT ;[26]YES, GIVE UP
STRT01: SETZ F, ;[27]CLEAR ALL FLAGS
SETOM LF.ERR ;[15]SET INITIAL (NONE SEEN) VALUES..
SETOM LF.INF ;[15]FOR SWITCHES
SETOM LS.MOD ;[27]..
MOVE P,[IOWD PDLEN,PDL] ;SET UP PDL
MOVE T1,RSCLST ;[17]GET RESCAN LIST READY
SKIPGE CCLFLG ;[17][26]ARE WE CCL MODE?
SETZ T1, ;[17]NO, VANILLA
MOVEM T1,%ISCAN ;[17]SAVE WHATEVER TURNED UP
MOVE T1,[5,,%ISCAN] ;NOW SCAN CALL
PUSHJ P,.ISCAN## ;INITIALIZE
SKIPGE CCLFLG ;ARE WE IN CCL MODE?
JRST STRT02 ;[27]NO, DEAL WITH THAT
AOJ T1, ;[27]YES,INC ISCAN MODE TO AGREE WITH /MODE
MOVEM T1,LS.MOD ;[27]SAVE MODE FROM ISCAN
JRST INITL ;GO START UP SPECS
STRT02: TXO F,FT.DUP ;[27]SET UP DEFAULT MODE
JRST INITL ;[27]AND GO START UP
;[26]HERE TO START A LINE OF INPUT
INITL: MOVE T1,SAVFF ;RESET .JBFF TO
MOVEM T1,.JBFF ;WHAT WE STARTED WITH
TXZ F,FT.HDR ;[17,27]NO HEADER YET
SETZM DNSPCT ;[6]HAVENT DONE ANY INPUT SPECS YET
MOVE T1,[XWD 10,%TSCAN]
PUSHJ P,.TSCAN## ;AND CALL TRADITIONAL SCANNER
SKIPGE T2,LS.MOD ;[27]GET MODE IF SET
JRST INIT01 ;[27]NO, MOVE ON
MOVSI T1,(1B4) ;[27]GET A 1 BIT IN FT.HLD-1
ROT T1,(T2) ;[27]PLACE THE BIT FOR PROPER MODE
TXZ F,FT.DUP!FT.MOV!FT.HLD ;[27]CLEAR OLD MODE ..
IOR F,T1 ;[27]AND MAKE THAT OUR MODE
INIT01: MOVEI T1,INFFAS ;[17]DEFAULT FAST INFO MODE
SKIPL LS.INF ;[15]DID USER SET /INFORM?
MOVE T1,LS.INF ;[27]YES, USE IT
MOVEM T1,LF.INF ;[15]STORE RESULT IN PERMENANT FLAG
SKIPL T1,LS.ERR ;[15]GET CURRENT ERROR SWITCH IF SET
MOVEM T1,LF.ERR ;[15]ONE GIVEN
SETOM LS.MOD ;[27]CLEAR MODE FOR NEXT PASS
TXNE F,FT.HLD ;[30]IF WE ARE IN HOLD MODE
PUSHJ P,CHKSTR ;[30]VERIFY STR IS MOUNTED (SKIP IF NOT)
PUSHJ P,INSPLP ;GO PROCESS THE SPECS
SKIPGE CCLFLG ;[17][26]IF NOT CCL,
JRST INITL ;LOOP FOR NEXT REQUEST
QUIT: RESET ;[17][26]CREAM ALL I/O SO WE CAN
EXIT 1, ;[17]EXIT WITHOUT MESSAGE
;HERE TO LOOP OVER A LINE OF INPUT
;NOTE THAT THIS MAY BE UP TO SPCCNT INPUT SPECIFICATIONS WITH AN UNKNOWN
;NUMBER OF WILD FILES FOR EACH.
INSPLP: AOS T1,DNSPCT ;COUNT ONE WE ARE ABOUT TO DO
CAMLE T1,INSPCT ;DONE?
POPJ P, ;DONE, RETURN FOR NEXT USER LINE
HRL T1,SPCLST-1(T1) ;GET POINTER TO SPEC BLOCK
HRRI T1,INSPEC ;POINT TO CONSTANT LOCS AND
BLT T1,INSPEC+INLEN-1 ;COPY IN ARGS
PUSHJ P,SETISP ;[14]FILL IN HOLES IN INPUT SPEC
SETZM LKWP3 ;CLEAR POINTER TO ALREADY SCANNED LIST
PUSHJ P,DOWILD ;DO ALL WILDCARDS FOR THIS SPEC
JRST INSPLP ;AND TRY AGAIN
;HERE TO PROCESS ALL (POSSIBLLY WILD) FILES THAT MATCH THIS INSPEC
;[25]CORRECTED ALL LABELS TO BE SEQUENTIAL
DOWILD: TXNN F,FT.HLD ;[17][27]ARE WE IN "HOLD" MODE
JRST DOWI01 ;[17]NO, VANILLA THINGS THEN
MOVSI T1,(SIXBIT/WRK/) ;[17]YES, FAKE OUTPUT STR
MOVEM T1,OUTBLK+.FXDEV ;[17]..
DOWI01: MOVE T1,[LKWLEN,,%LKWLD] ;SET UP CALL
PUSHJ P,.LKWLD## ;CALL WILD CARD LOOKUP
POPJ P, ;DONE ALL FILES THAT MATCH
AOJN T2,DOWI04 ;[25]INPUT NOT DISK DEVICE
MOVEM T1,INPDVC ;SAVE THE DEVCHR WORD
PUSHJ P,OPNLKP ;[32]GO DO OPEN/LOOKUP ON INPUT
JRST DOWI03 ;[32]INPUT ERROR, TRY NEXT FILE
PUSHJ P,.CHKTM## ;[33]LET WILD CHECK /BEFORE/SINCE
JRST DOWI03 ;[33]DOESN'T APPLY, TRY NEXT
MOVE T1,[OUTBLK,,OUTSPE] ;[14]COPY IN OUTPUT SPEC
BLT T1,OUTSPE+OUTLEN-1 ;[14](FRESH COPY CAUSE MAY HAVE BEEN HACKED)
PUSHJ P,SETOSP ;[14]HACK THE OUTPUT SPEC IF NECESSARY
MOVE T1,[SCWLEN,%SCWLD] ;CALL .SCWLD TO SET UP
PUSHJ P,.SCWLD## ;OUTPUT
JRST DOWI03 ;TRY NEXT
AOJN T2,DOWI05 ;[25]OUTPUT NOT TO DISK
MOVEM T1,OUTDVC ;SAVE OUTPUT DEVCHR WORD
PUSHJ P,SETEXT ;SET UP EXTENDED ARGS
PUSHJ P,OPNENT ;[32]DO OPEN/ENTER ON OUTPUT
JRST DOWI03 ;[32]ERROR, TRY NEXT FILE
MOVE T1,%OPENI+1 ;[16]GET INPUT STR
CAME T1,%OPENO+1 ;[16]SAME AS OUTPUT?
JRST DOWI02 ;[16]NO, COMMON SAFE CASE
PUSHJ P,CHKIDN ;[16]YES, BE SURE NOT IDENTICAL FILE
JRST DOWI02 ;[16]NOT SAME, PRESS ON
CLOSE ICH, ;[16]SAME, FORGET IT
CLOSE OCH,CL.RST ;[24]CLOSE WITH NEW COPY DISCARDED
JRST DOWI03 ;[16]TRY NEXT FILE
DOWI02: SKIPL LF.INF ;[15]DID A /INFORM SWITCH GET SET
PUSHJ P,INFORM ;[15]YES, CALL INFORMER
PUSHJ P,FASTMV ;DO MOVE
JRST DOWI03 ;[32]ERROR IN MOVE OR SETUP, FILES CLOSED
CLOSE OCH, ;NICE!, NICE!
TXNE F,FT.MOV ;[27]ARE WE IN MOVE MODE?
PUSHJ P,DELFIL ;[27]YES, DELETE FILE NOW
CLOSE ICH, ;[20]CLOSE HIM TOO
;HERE AT END OF LOOP ON EACH WILD RETURN
DOWI03: JRST DOWILD ;[14]GOT THAT ONE
[25,32];HERE WHEN INPUT IS NOT A DISK DEVICE, TRY NEXT FILE
DOWI04: MOVE T1,%OPENI+1 ;GET INPUT DEVICE NAME
TYPE$ (F,IND,$S,<INPUT DEVICE +: IS NOT A DISK>)
JRST DOWI03 ;TRY NEXT ONE
;[25,32]HERE WHEN OUTPUT IS NOT A DISK DEVICE, QUIT
DOWI05: MOVE T1,%OPENO+1 ;GET OUTPUT STR NAME
TYPE$ (F,OND,$S,<OUTPUT DEVICE +: IS NOT A DISK>)
SETZM INSPCT ;BLOW OFF SPEC COUNT SO WE QUIT
POPJ P, ;AND RETURN FROM DOWILD
;HERE TO SET UP AND DO THE MOVE ON THE DEVICE
FASTMV: SKIPG %LOKUP+.RBSIZ ;[32]GET FILE SIZE IN WORDS
JRST .POPJ1 ;[20,32]NOTHING THERE, JUST RETURN
PUSH P,.JBFF ;[32]SAVE .JBFF TO START SO CAN REALLOCATE
PUSHJ P,CMPMOV ;[32]COMPUTE MOVE PARAMETERS
JRST FAST05 ;[32]ERROR IN PARAMETERS, ABORT
;[32] HERE AFTER SETUP WITH:
; WRDCLS: SIZE OF CLUSTER IN WORDS, SMALLER OF INPUT OR OUTPUT STR(WAS INPCLS[32])
; BLKCLS: SIZE OF CLUSTER IN BLOCKS, SMALLER OF TWO AS ABOVE
; IOLIST: XWD Z,,BUFFER AS ALLOCATED BY GETCOR
; XFERS: COUNT OF TRANSFERS, ZERO NOW
; T2/WRDCLS LESS 200 (ALLOWING FOR FIRST RIB)
; T3/SIZE OF FILE IN WORDS(WAS T4[32])
FAST01: CAML T2,T3 ;MORE THAN 1 CLUSTER LEFT
MOVE T2,T3 ;NO, USE ACTUAL SIZE
SUB T3,T2 ;SUBTRACT THIS BUFFER
MOVNI T2,(T2) ;NEGATE AND
HRLM T2,ILIST ;PUT IN IO LIST
IN ICH,ILIST ;GET A BUFFER
CAIA ;SKIP IS ERROR
JRST FAST06 ;[15,32]INPUT I/O ERROR
FAST02: OUT OCH,ILIST ;AND WRITE IT
CAIA ;NON-SKIP NORMALLY
JRST FAST10 ;[15,32]OUTPUT I/O ERROR
FAST03: MOVE T2,WRDCLS ;RESET XFER SIZE
AOS XFERS ;[15]COUNT TRANSFERS
JUMPN T3,FAST01 ;[32]GET NEXT IF ANY LEFT
FAST04: POP P,.JBFF ;[32]RESTORE .JBFF AND
JRST CPOPJ1 ;[32]GIVE GOOD RETURN
;[32]HERE IF ABORT DURING SETUP
FAST05: POP P,.JBFF ;RESTORE .JBFF FOR NEXT FILE
CLOSE OCH,CL.RST ;DISCARD OUTPUT FILE
CLOSE ICH, ;CLOSE INPUT
POPJ P, ;AND ERROR RETURN
;[15,32]HERE IF INPUT I/O ERROR
FAST06: GETSTS ICH,T1 ;GET STATUS
TRNE T1,20000 ;EOF?
JRST FAST02 ;YES, DO LAST WRITE
SKIPLE LF.ERR ;ARE WE IGNORING ERRORS?
JRST FAST07 ;NO TRY RECOVERY
TYPE$ (F,IER,$O,<INPUT ERROR, STATUS = +, /OKERR TO IGNORE>);[25]
JRST RESTRT ;[26]KISS OF DEATH
FAST07: PUSHJ P,RESETI ;[32]RESET INPUT
JRST FAST02 ;AND BACK FOR NEXT
;[15,32]HERE IF OUTPUT I/O ERROR
FAST10: GETSTS OCH,T1 ;GET STATUS
SKIPLE LF.ERR ;ARE WE IGNORING ERRORS?
JRST FAST11 ;NO, TRY TO RECOVER
TYPE$ (F,OER,$O,<OUTPUT ERROR, STATUS = +, /OKERR TO IGNORE>);[25]
JRST RESTRT ;[26]KISS OF DEATH
FAST11: PUSHJ P,RESETO ;[32]RESET OUTPUT AND MESSAGE
JRST FAST03 ;AND CARRY ON
SUBTTL MINOR MODULES
;SUBROUTINES FOR INITL
;[30]HERE TO SEE IF STR IS MOUNTED FOR /HOLD
CHKSTR: MOVEI T1,.IODMP ;USE DUMP MODE AND AVOID HEADERS
MOVEM T1,%OPENI ;..
MOVE T1,[HLDSTR] ;SET UP STR NAME
MOVEM T1,%OPENI+1 ;..
MOVEM T1,%IPATH ;ALSO FOR PATH IF NEEDED
SETZM %OPENI+2 ;NO IBUF/OBUF
OPEN ICH,%OPENI ;TRY TO OPEN STR
JRST CHKS02 ;LOST IT ALREADY
MOVE T1,[10,,%IPATH] ;SET UP FOR INPUT
PATH. T1, ;PATH
JRST CHKS02 ;SO MUCH FOR THAT
MOVEI T1,3 ;SET COUNT OF ENTER ARGS
MOVEM T1,%LOKUP ;..
MOVE T1,%IPATH+2 ;GET DEFAULT PPN FOR WRK:
MOVEM T1,%LOKUP+.RBNAM ;AS FILE NAME
MOVE T1,[1,,1] ;PPN IS MFD
MOVEM T1,%LOKUP+.RBPPN ;..
MOVSI T1,(SIXBIT/UFD/) ;EXTENTION UFD
MOVEM T1,%LOKUP+.RBEXT
LOOKUP ICH,%LOKUP ;TRY FOR THE UFD
JRST CHKS02 ;NO LUCK
CHKS01: MOVEI T1,ICH ;SET UP CHANNEL NO
RESDV. T1, ;AND RELEASE IT
JFCL ;OK, OK
POPJ P, ;BACK CONVINCED UFD IS THERE
CHKS02: MOVE T1,[HLDSTR] ;SET UP FOR ERROR
TYPE$ (F,SMM,$S,<STRUCTURE +: MUST BE MOUNTED FOR HOLD>)
AOS (P) ;SET FOR SKIP RETURN IF ERROR
JRST CHKS01 ;RELEASE CHANNEL IF NECESSARY
;SUBROUTINES FOR INSPLP
;[14]SUBROUTINE TO FILL IN HOLES IN INPUT SPEC WITH WILD CARDS ALWAYS
SETISP: MOVSI T1,120000 ;GET A SIXBIT "*" READY
MOVE T2,[FX.NUL] ;AND NULL EXT BIT
SKIPE INSPEC+.FXNAM ;NAME MISSING
JRST SETI01 ;NO, PRESS ON
MOVEM T1,INSPEC+.FXNAM ;YES, PUT IN THE *
SETZM INSPEC+.FXNMM ;ZERO MASK IN THIS CASE
TDNN T2,INSPEC+.FXMOD ;IS NULL EXT ON (NO EXT EITHER?)
JRST SETI02 ;NO, HE DID SOMETHING EXPLICIT
TDZ T2,INSPEC+.FXMOD ;YES, ASSUME .* AND TURN IT OFF
MOVEM T1,INSPEC+.FXEXT ;MAKE IT SO
JRST SETI02 ;PRESS ON
SETI01: TDNN T2,INSPEC+.FXMOD ;IS NULL EXT ON?
JRST SETI02 ;NO, HE TYPED WHAT HE WANTS THEN
MOVEM T1,INSPEC+.FXEXT ;YES, MAKE IT ".*"
TDZ T2,INSPEC+.FXMOD ;AND TURN IT OFF
SETI02: ;DO DIRECTORY TOO LATER
POPJ P, ;ALL DONE
;SUBROUTINES FOR DOWILD
;[32]SUBROUTINE TO OPEN AND LOOKUP INPUT FILE
OPNLKP: MOVEI T1,17 ;WE WILL BE IN DUMP MODE
HRRM T1,%OPENI
SETZM %OPENI+2 ;NO BUFFERS
OPEN ICH,%OPENI ;DO OPEN INPUT
JRST OPNL01 ;LOST, DEAL WITH ERROR
LOOKUP ICH,%LOKUP ;AND LOOKUP
JRST OPNL02 ;ERROR AGAIN
JRST CPOPJ1 ;WON, GOOD RETURN
OPNL01: PUSHJ P,E.DFO## ;CALL OPEN ERROR ROUTINE IN SCAN
POPJ P, ;AND ERROR RETURN
OPNL02: MOVE T1,%LOKUP+.RBEXT ;[31]MOVE ERROR CODE
MOVEM T1,.RBPRV ;[31]TO WHERE SCAN THINKS IT IS
PUSHJ P,E.DFL## ;SCAN LOOKUP ERROR (ON INSPEC)
POPJ P, ;GIVE ERROR RETURN
;[14]SUBROUTINE TO HACK OUTPUT SPEC TO AGREE WITH INPUT
SETOSP: MOVE T2,[FX.NUL] ;GET NULL EXT TEST READY
SKIPE OUTSPE+.FXNAM ;NAME MISSING
JRST SETO01 ;NO, CHECK EXT
MOVE T1,INSPEC+.FXNAM ;YES, GET INPUT NAME AND
MOVEM T1,OUTSPE+.FXNAM ;STUFF IT IN
MOVE T1,INSPEC+.FXNMM ;MASK ALSO
MOVEM T1,OUTSPE+.FXNMM ;..
TXNN F,FT.HLD ;[17][27]DONT TEST IN HOLD MODE
TDNE T2,OUTSPE+.FXMOD ;IS NULL EXT ON (NO EXT EITHER?)
CAIA ;[17]NULL EXT (OR HOLD MODE)
JRST SETO02 ;NO, HE DID SOMETHING EXPLICIT
MOVE T1,INSPEC+.FXEXT ;SHOULD AGREE WITH INPUT THEN
MOVEM T1,OUTSPE+.FXEXT ;MAKE IT SO
TDNE T2,INSPEC+.FXMOD ;IF INPUT HAS NULL EXT
TDOA T2,OUTSPE+.FXMOD ;SO SHOULD WE
TDZ T2,OUTSPE+.FXMOD ;ELSE WE SHOULDN'T
JRST SETO02 ;PRESS ON
SETO01: TDNN T2,INSPEC+.FXMOD ;IS NULL EXT ON?
JRST SETO02 ;NO, HE TYPED WHAT HE WANTS THEN
MOVE T1,INSPEC+.FXEXT ;GET WHATEVER INPUT IS USING
MOVEM T1,OUTSPE+.FXEXT ;..
TDNE T2,INSPEC+.FXMOD ;INCLUDING
TDOA T2,OUTSPE+.FXMOD ;NOTHING AT ALL
TDZ T2,OUTSPE+.FXMOD ;OR WHATEVER
SETO02: ;DO DIRECTORY TOO LATER
POPJ P, ;ALL DONE
; STILL IN SUBROUTINES FOR DOWILD
;[32]SUBROUTINE TO OPEN AND ENTER OUTPUT FILE
OPNENT: MOVEI T1,17 ;DUMP MODE
HRRM T1,%OPENO
OPEN OCH,%OPENO ;TRY AND OPEN
JRST OPNE01 ;LOST, REPORT ERROR
ENTER OCH,%ENTER
JRST OPNE02 ;FAILED ENTER...
JRST CPOPJ1 ;WON, GOOD RETURN
;HERE IF OPEN FAILED ON OUTPUT
OPNE01: PUSHJ P,E.SCO## ;LET SCAN DO THE WORK TYPING
POPJ P, ;AND ERROR RETURN
OPNE02: MOVE T1,%ENTER+.RBEXT ;[31]MOVE ENTER ERROR
MOVEM T1,%ENTER+.RBPRV ;[31]FOR SCAN
PUSHJ P,E.SCL## ;WILD LOOKUP/ENTER ERROR
;BASED ON .SCWLD CALL
POPJ P, ;AND ERROR RETURN
;[16]HERE TO VERIFY WE ARENT JUST OVERWRITING THE SAME FILE
CHKIDN: MOVE T1,%LOKUP+.RBNAM ;GET FILE NAME IN
CAME T1,%ENTER+.RBNAM ;COMPARE TO OUT
POPJ P, ;DIFFERENT, WE ARE OK
HLRZ T1,%LOKUP+.RBEXT ;GET EXTENTION
HLRZ T2,%ENTER+.RBEXT ;FOR BOTH
CAIE T1,(T2) ;SAME AGAIN?
POPJ P, ;NO
;LOOKS BLACK, CHECK PATHS TO BE SURE
MOVEI T1,ICH
MOVEM T1,%IPATH ;[TW] RESET CHAN NO IN PATH BLOCK
MOVE T1,[10,,%IPATH] ;SET UP FOR INPUT
PATH. T1, ;PATH
DIE ;[25]CANT FAIL!
MOVEI T1,OCH
MOVEM T1,%OPATH ;[TW]
MOVE T1,[10,,%OPATH] ;AND OUTPUT
PATH. T1,
DIE ;[25]AGAIN
MOVE T2,[-6,,2] ;SET UP AOBJN FOR SCAN(PAST CHN & FLAGS)
CHKI01: MOVE T1,%IPATH(T2) ;GET AN ARG
CAME T1,%OPATH(T2) ;SAME?
POPJ P, ;NO, QUIT
AOBJN T2,CHKI01 ;YES, LOOK AT NEXT
CPOPJ1: AOS (P) ;SAME FILE, GIVE ERROR RETURN
POPJ P,
; STILL IN SUBROUTINES FOR DOWILD
;[27]ROUTINE TO DELETE FILE ON INPUT CHANNEL
DELFIL: MOVE T1,%LOKUP+.RBNAM ;GET FILE
MOVEM T1,DELAR1 ;AND SAVE IN CASE ERROR
MOVE T1,%LOKUP+.RBEXT ;GET EXT
MOVEM T1,DELAR2 ;..
MOVE T1,%LOKUP+.RBPPN ;..
MOVEM T1,DELAR3 ;..
SETZM %LOKUP+.RBNAM ;ZAP NAME..
SETZM %LOKUP+.RBEXT ;..EXTENTION..
SETZM %LOKUP+.RBPPN ;..AND PPN
RENAME ICH,%LOKUP ;DO THE RENAME
CAIA ;WHOOPS
POPJ P, ;DONE, RETURN
MOVE T1,[4,,DELLST] ;SET UP POINT TO LIST
TYPE$ (W,CDF,$I,<CANT DELETE FILE +:+.++>)
POPJ P,
;HOLD LIST AND VALUES FOR ERROR CDF
DELLST: $S %OPENI+1 ;POINT TO DEVICE,
$S DELAR1 ;AND SAVED FILE...
$L DELAR2 ;..EXT
$P DELAR3 ;AND PPN
$LOW ;ARGS IN LOW SEG
DELAR1: Z ;HOLD FILE DURING DELETE
DELAR2: Z ;HOLD EXT
DELAR3: Z ;HOLD PPN
$HIGH ;BACK TO HIGH SEG
;[3]HERE TO MOVE EXTENDED LOOKUP ARGS FROM INPUT TO OUTPUT LOOKUP BLOCK
SETEXT: HRRZ T1,%LOKUP+.RBEXT ;GET HIGH ORDER DATE
TRZ T1,077777 ;CLOBBER ACCESS SO GET TODAY
HRRM T1,%ENTER+.RBEXT ;AND STORE
MOVE T1,%LOKUP+.RBPRV ;[13]GET PRIV WORD (PROTECTION REALLY)
LDB T2,[POINT 9,%ENTER+.RBPRV,8] ;[13]GET USER PROTECTION
MOVEM T1,%ENTER+.RBPRV ;[13]PUT IN OLD VALUE
SKIPE T2 ;[13]BUT IF USER GAVE NEW PROT
DPB T2,[POINT 9,%ENTER+.RBPRV,8] ;[13]PUT IT BACK
MOVE T1,%LOKUP+.RBSIZ ;[13]GET SIZE IN WORDS
LSH T1,-7 ;[13]CONVERT TO BLOCKS
AOJ T1, ;[13]+1 FOR PROBABLE REMAINDER
SKIPN %ENTER+.RBEST ;[13]USER ESTIMATE?
MOVEM T1,%ENTER+.RBEST ;[13]NO, USE ACTUAL SIZE
MOVE T1,%LOKUP+.RBVER ;[13]GET OLD VERSION
SKIPN %ENTER+.RBVER ;[13]USER VERSION?
MOVEM T1,%ENTER+.RBVER ;[13]NO, USER OLD ONE IF ANY
POPJ P, ;DONE
; STILL IN SUBROUTINES FOR DOWILD
;[15]HERE IF /INFORM HAS BEEN GIVEN (MOVED IN [32])
INFORM: MOVE T1,LF.INF ;GET INFORM LEVEL
CAIN T1,INFNON ;IF IT IS "NONE"
POPJ P, ;FORGET IT
TXNE F,FT.HDR ;[17,27]FIRST TIME THUR?
JRST INFO01 ;[17]NO, JUST DO FILE
MOVEI T1,[ASCIZ/HOLD/] ;[17]ASSUME HOLD MODE
TXNE F,FT.DUP ;[27]IF DUP OR MOVE..
MOVEI T1,[ASCIZ/DUP/]
TXNE F,FT.MOV ;[27]..CORRECT ASSUMPTION
MOVEI T1,[ASCIZ/MOVE/]
TYPE$ (N,,$A,<+:>,NONE) ;[17][25]SEND IT AWAY
TXO F,FT.HDR ;[17,27]REMEMBER LEADIN DONE
MOVE T1,LF.INF ;[27]REGET INFORM LEVEL
CAIN T1,INFSLO ;[27]IF SLOW WE SHOULD...
PUSHJ P,.TCRLF ;[27]FINISH OFF LINE HERE
INFO01: CAIE T1,INFFAS ;[27]FAST?
JRST INFO02 ;[17]NO, MUST BE SLOW
MOVE T1,[3,,IFILLS] ;[25,27]SET UP LIST POINTER
TYPE$ (T,,$I,<+:+.+>,NONE) ;[25,34]
MOVEI T1,%LOKUP+.RBPPN ;[35]GET THE POINTER TO PPN BLOCK
PUSHJ P,.TDIRB## ;[35]GO TYPE THE PATH
PJRST .TCRLF ;[34]END HERE
INFO02: MOVEI T1,%OPENO ;SET UP OPEN AND
MOVEI T2,%ENTER ;ENTER BLOCK
PUSHJ P,.TOLEB## ;SEND THAT
MOVEI T1,"=" ;[25]GET DELIMITER
PUSHJ P,.TCHAR ;[25]SEND IT
PUSH P,%OPENI+1 ;SAVE THE GENERIC DEVICE NAME
MOVEI T1,ICH ;SO WE CAN
DEVNAM T1, ;GET THE PHYSICAL NAME
DIE ;[25]???
MOVEM T1,%OPENI+1 ;FAKE OUT SCAN
MOVEI T1,%OPENI ;REDO FOR INPUT SIDE
MOVEI T2,%LOKUP ;..
PUSHJ P,.TOLEB ;..
POP P,%OPENI+1 ;PUT OPEN BLOCK BACK TOGETHER
TYPE$ (N,,$N,<, >,NONE) ;[25]
MOVE T1,%LOKUP+.RBSIZ ;GET SIZE
TRZE T1,177 ;EVEN?
ADDI T1,200 ;NO, TAKE TO NEXT BIGGEST
PUSHJ P,.TBLOK## ;FOR SIZE
PUSHJ P,.TCRLF ;[25]FINISH OFF LINE
POPJ P, ;DONE
;[27]ARG LIST FOR INFORM:F
IFILLS: $S %OPENI+1 ;STR NAME
$S %LOKUP+.RBNAM ;FILE NAME
$L %LOKUP+.RBEXT ;FILE EXT
;SUBROUTINES FOR FASTMV
;[32]HERE TO COMPUTE MOVE PARAMETERS
;[32]THIS WAS INLINE CODE IN FASTMV
CMPMOV: ;GET STR CHARACTERISTICS
MOVE T1,%OPENI+1 ;INPUT DEVICE NAME
MOVEM T1,%DVCHR ;IN DEVCHR BLOCK
MOVE T1,[DEVLEN,,%DVCHR] ;FOR THE
DSKCHR T1, ;DSKCHR UUO
DIE ;[25]ALREADY VERIFIED AS DSK!
LDB T1,[POINT 9,%DVCHR+.DCUCH,8] ;GET BLOCKS/CLUSTER
MOVEM T1,INPCLS ;SAVE CLUSTER SIZE
MOVE T1,%OPENO+1 ;OUTPUT DEVICE NAME
MOVEM T1,%DVCHR ;IN DEVCHR BLOCK
MOVE T1,[DEVLEN,,%DVCHR] ;FOR THE
DSKCHR T1, ;DSKCHR UUO
DIE ;[25]ALREADY VERIFIED AS DSK
LDB T1,[POINT 9,%DVCHR+.DCUCH,8] ;GET BLOCKS/CLUSTER
MOVEM T1,OUTCLS ;SAVE OUTPUT CLUSTER SIZE
;COMPUTE OUTPUT FILE SIZE
MOVE T1,%LOKUP+.RBSIZ ;GET FILE SIZE IN WORDS
IDIVI T1,200 ;AS BLOCKS
SKIPE T2 ;REMAINDER
AOJ T1, ;YES, ROUND UP
ADDI T1,2 ;FOR RIBS
PUSH P,T1 ;SAVE THIS A SEC
IDIV T1,OUTCLS ;DIVIDE BY CLUSTER SIZE
POP P,T1 ;GET BACK SIZE
ADDI T1,(T2) ;MAKE EVEN CLUSTER
;CHECK AGAINST QUOTA
MOVE T2,%DVCHR+.DCUFT ;GET QUOTA
CAME T2,[377777,777777] ;[23]CREDIR OR SYSTEM UFD?
CAMN T2,[400000,,0] ;OR UNKNOWN QUOTA
JRST CMPM01 ;TRY ANYWAY
CAMLE T1,T2 ;NEED MORE THAN QUOTA?
JRST CMPM02 ;COMPLAIN
CAMLE T1,%DVCHR+.DCFCT ;LESS THAN TOTAL FCFS
JRST CMPM03
CMPM01: ;FILE WILL FIT, SET UP XFER PARMS
MOVE T1,INPCLS ;GET THE INPUT CLUSTER (BLOCKS)
CAMLE T1,OUTCLS ;SAME FOR BOTH STRS?
MOVE T1,OUTCLS ;NO, USE SMALLER
CAIGE T1,MINBLK ;[36]IF LESS THAN MIN BLOCKS/XFR
MOVEI T1,MINBLK ;[36]USE MINIMUM INSTEAD
MOVEM T1,BLKCLS ;[15]SAVE BLOCKS/CLUSTER
IMULI T1,200 ;NOW WORDS
MOVEM T1,WRDCLS ;SAVE AS WORDS/CLUSTER
PUSHJ P,GETCOR ;TRY AND ALLOCATE BUFFER FOR CLUSTER
JRST CMPM04 ;LOST, REPORT ERROR
SOJ T2, ;MAKE IOWD OF ADDRESS AND
HRRM T2,ILIST ;PUT IN IO LIST
MOVE T3,%LOKUP+.RBSIZ ;SIZE OF FILE IN WORDS FOR FASTMV
MOVE T4,WRDCLS ;GET CLUSTER SIZE IN WORDS
MOVE T2,T4 ;ASSUME SIZE FIRST XFER SAME
SUBI T4,200 ;SIZE OF FIRST CLUSTER (LESS RIB)
CAMLE T3,T4 ;IS FILE MORE THAN 1 CLUSTER?
SUBI T2,200 ;YES, ADJUST SIZE OF FIRST ONE THEN
;HAVE FILE SIZE WRDS IN T3, FIRST XFER IN T2
JRST CPOPJ1 ;SKIP RETURN FOR OK
;STILL IN CMPMOV
;[32]HERE IF QUOTA TO SMALL ON OUTPUT FOR FILE
;[32]WAS NOQOTA
CMPM02: TYPE$ (F,QTS,$N,<QUOTA TOO SMALL ON >,NONE);[25]
SKIPA ;FALL INTO ...
;[32]HERE IF FREE SPACE TO SMALL ON OUTPUT
;[32]WAS NOFREE
CMPM03: TYPE$ (F,FTS,$N,<FREE SPACE TOO SMALL ON >,NONE);[25]
MOVE T1,[3,,OFILLS] ;[25]SET UP LIST FOR STR:FILE.EXT
TYPE$ (N,,$I,<+: FOR +.+>);[25]
POPJ P, ;ERROR RETURN
;[32]HERE IF CANNOT ALLOCATE CORE FOR BUFFER
;[32]WAS NOFREE
CMPM04: PUSH P,T1 ;SAVE REQUEST
MOVE T1,.JBFF ;[25]GET FIRST FREE
IDIVI T1,1000 ;[25]MAKE PAGES
SKIPE T2 ;[25]REMAINDER?
AOJ T1, ;[25]YES, UP ONE
TYPE$ (F,CAB,$D,<CANNOT ALLOCATE BUFFER, +P CORE USED, >,NONE)
POP P,T2 ;[32]RESTORE REQUEST
IDIVI T2,1000 ;[32]MAKE PAGES
SKIPE T3 ;[32]ANY REMAINDER?
AOJ T2, ;[32]YES, ROUND UP
ADDI T1,(T2) ;[32]NOW TOTAL REQUIRED
TYPE$ (N,,$D,<+ REQUIRED>)
JRST RESTRT ;[16]RESTART
;[25]ARG LIST FOR QTS, FTS ERRORS
OFILLS: $S %OPENO+1 ;[36]STR NAME
$S %ENTER+2 ;FILE NAME
$L %ENTER+3 ;FILE EXT
;[32]HERE ON INPUT ERROR TO TYPE MESSAGE AND RESET STATUS
;[32]WAS LYING AROUND NEAR MOVLOP
RESETI: MOVEM T1,IOERA1 ;[25]SAVE STATUS FIRST ARG SLOT
MOVE T1,XFERS ;GET COUNT MOVED
IMUL T1,BLKCLS ;CONVER TO BLOCKS
MOVEM T1,IOERA2 ;[25]SAVE IN ARG 2
AOS IOERA2 ;[25]BUT MAKE INTO FIRST MOVED
ADD T1,BLKCLS ;NOW UPPER LIMIT
MOVEM T1,IOERA3 ;[25]SAVE AS THIRD ARG
MOVE T1,[3,,IOERA0] ;[25]SET UP LIST TO ARGS
TYPE$ (W,IES,$I,<INPUT ERROR: STATUS=+, BLOCK +-+, CONTINUING>);[25]
MOVE T1,IOERA1 ;[25]GET BACK STATUS
TRZ T1,740000 ;CLEAR ALL ERROR BITS
SETSTS ICH,(T1) ;AND RESET STATUS
POPJ P,
; STILL IN FASTMV SUBROUTINES
;[32]HERE TO TYPE MESSAGE AND RESET OUTPUT STATUS ON ERROR RECOVERY
;[32]WAS LYING AROUND NEAR FASTMV
RESETO: MOVEM T1,IOERA1 ;[25]SAVE STATUS FIRST ARG SLOT
MOVE T1,XFERS ;GET COUNT MOVED
IMUL T1,BLKCLS ;CONVER TO BLOCKS
MOVEM T1,IOERA2 ;[25]SAVE IN ARG 2
AOS IOERA2 ;[25]BUT MAKE INTO FIRST MOVED
ADD T1,BLKCLS ;NOW UPPER LIMIT
MOVEM T1,IOERA3 ;[25]SAVE AS THIRD ARG
MOVE T1,[3,,IOERA0] ;[25]SET UP LIST TO ARGS
TYPE$ (W,OES,$I,<OUTPUT ERROR: STATUS=+, BLOCK +-+, CONTINUING>);[25]
MOVE T1,IOERA1 ;[25]GET BACK STATUS
TRZ T1,740000 ;CLEAR ALL ERROR BITS
SETSTS OCH,(T1) ;AND RESET STATUS
POPJ P, ;BACK TO TRY NEXT
;[25]ARGS FOR IES, OES MESSAGES
;LIST THAT DEFINES SUBSTITUTION AND ARG LOCATION IS FIXED, LEAVE HI
IOERA0: $O IOERA1 ;OCTAL STATUS IN IOERA1
$D IOERA2 ;DECIMAL BLOCKS A2 AND A3
$D IOERA3
;BUT DATA MUST BE LOW SEG
$LOW
IOERA1: Z ;FOR STATUS
IOERA2: Z ;FOR FIRST BLOCK
IOERA3: Z ;FOR LAST BLOCK
$HIGH
;[32]SUBROUTINES CALLED FROM SCAN, NOT US
;[3]SUBROUTINE TO ALLOCATE BLOCKS FOR INPUT SPECS (32 WORD CHUNKS)
;RETURNS T1=ADDRESSS, T2=LENGTH, NO RETURN ON ERROR (LIKE NO CORE)
;[32]CHANGED ARGS TO COMFORM TO GETCOR CHANGE
ALLIN: MOVEI T1,INLEN ;[10,32]AMOUNT WE NEED
PUSHJ P,GETCOR ;SET IT UP
DIE ;[32]DIRE STRAIGHTS IF CANT GET A FEW WORDS
AOS T1,INSPCT ;[32]GET NEW COUNT
CAIL T1,SPCCNT ;[32]ARE WE OVER MAX?
JRST ALLI01 ;[25]YES, COMPLAIN
MOVEM T2,SPCLST-1(T1) ;[32]SAVE POINTER TO SPEC AND
MOVE T1,T2 ;[32]SET UP ADDRESS FOR SCAN
MOVEI T2,INLEN ;[10,32]RESTORE LENGTH
POPJ P, ;AND RETURN HAPPY
ALLI01: MOVEI T1,SPCCNT ;[32]GET MAX ALLOWED
TYPE$ (F,TIS,$D,<TOO MANY INPUT SPECS, ONLY + ALLOWED>);[25]
JRST RESTRT ;[26]SEE IF SHOULD GIVE HIM ANOTHER CHANCE
;SUBROUTINE TO ALLOCATE OUTSPEC BLOCK FOR SCAN
;ONLY 1 CALL ALLOWED
ALLOUT: SKIPE ALOTCK ;FIRST CALL?
JRST ALLO01 ;[25]NO, ABORT
SETOM ALOTCK ;REMEMBER CALL
MOVEI T1,OUTBLK
MOVEI T2,OUTLEN
CPOPJ: POPJ P,
ALLO01: TYPE$ (F,OSA,$N,<ONLY ONE OUTPUT SPEC ALLOWED>);[25]
JRST RESTRT ;[26,25]
;[32]MISCELLANEOUS UTILITY ROUTINES
;[11]SUBROUTINE TO CLEAR INSPCT AND ALOTCK WHENEVER .TSCAN STARTS SCANNING
CLRFLG: SETZM ALOTCK ;CLEAR ALLOCATED OUTPUT SPEC
SETZM INSPCT ;ZERO INPUT SPEC COUNT
SETOM LS.ERR ;[15]CLEAR /INFORM AND
SETOM LS.INF ;[15]/INFORM SO SCAN ALOWS NEW VALUES
POPJ P, ;BACK TO SCAN
;[3]SUBROUTINE TO ALLOCATE CORE
;[32]CALLING CONVENTION REVERSED IN THIS EDIT
;CALL WITH T1=WORDS REQUIRED, SKIP RETURNS WITH T1 UNCHANGED
;AND T2=STARTING ADDRESS IF SUCESSFULL, NON-SKIP IF LOSES.
GETCOR: MOVE T2,T1 ;[32]GET REQUEST IN T2
HRRZ T1,.JBFF ;[32]FIRST FREE
ADDI T1,-1(T2) ;[32]NEW HIGHEST USED
CAMG T1,.JBREL ;NEED MORE?
JRST GETC01 ;NO, THIS IS ENOUGH
PUSH P,T1 ;SAVE THIS SO
CORE T1, ;ASK FOR MORE
JRST GETC02 ;[32]LOST, SET UP ERROR RETURN
POP P,T1 ;OK, GET BACK ADDRESS
GETC01: EXCH T1,.JBFF ;SAVE NEW HIGHEST USED AND
;GET USERS FIRST LOC
AOS .JBFF ;NOW NEW FIRST FREE
EXCH T1,T2 ;[32]PUT REQUEST BACK IN 1,ADDRESS IN 2
JRST .POPJ1## ;BACK HAPPY
GETC02: POP P,(P) ;[32]DISCARD NEW ADDRESS
EXCH T1,T2 ;[32]RESTORE REQUEST
POPJ P, ;[32]AND ERROR RETURN
;ROUTINE TO IMPLEMENT TYPE$ CALLS
;CALL WAS
; MOVE T1,[VALUE]
;OR MOVE T1,[COUNT,,LIST]
; PUSHJ P,TYPER
; BYTE (9)CAIA(4)HEADER(1)Z(2)RETN,TRAILER(18)SIXBIT/PFX/
; BYTE (9)SUBS(2)0(7)SCHR(18)ADDRESS
;LIST: SUBS ADDRESS
; SUBS ADDRESS ;COUNT TIMES
$LOW ;GO TO LOW SEG AND DEFINE STORAGE FOR ARGS AND AC'S
TYPBLK: BLOCK 17 ;HOLDS ALL AC'S BUT P
TYPAR1: Z ;HOLDS FIRST ARG
TYPAR2: Z ;HOLDS SECOND ARG
INFFLG: Z ;FLAG FOR CLOSING ] AT END -1 IF TRUE
TYPADD: Z ;HOLDS ADDRESS OF ASCIZ STRING
TYPCNT: Z ;COUNT OF INDIRECT ARGUMENTS
TYPOUT: Z ;PUT ADDRESS OF TYPEOUT ROUTINE HERE ELSE OUTCHR
$HIGH ;BACK FOR CODE
TYPER: MOVEM 0,TYPBLK ;SAVE AC 0
MOVE 0,[1,,TYPBLK+1] ;THEN BLT ALL AC'S...
BLT 0,TYPBLK+16 ;..BUT P INTO SAVE AREA
MOVE T1,[IOWD 3,TYPAR1] ;MAKE POINTER TO ARG SAVE AREA
PUSH T1,@(P) ;SAVE FIRST ARG
AOS (P) ;POINT TO SECOND ARG
PUSH T1,@(P) ;AND PUT IT IN TOO
AOS (P) ;SET UP FOR NORMAL RETURN
HLLZ P2,TYPAR1 ;GET BASIC CODES
LSH P2,^D9 ;IGNORE THE CAIA
SETZ P1, ;AND CLEAR GARBAGE
LSHC P1,4 ;PICK UP HEADER CODE
JUMPE P1,TYPE01 ;NO VERBO THINGS
MOVE T1,MSGCHR-1(P1) ;GET LEADIN CHR
PUSHJ P,.TCHAR ;CALL THE CHRACTER OUTPUTTER
CAIN P1,4 ;IF NOT TAB ONLY
JRST TYPE01 ;IT IS, QUIT HERE
SETZM INFFLG ;CLEAR INFO ONLY FLAG FOR END
CAIN P1,3 ;IS IT INFO?
SETOM INFFLG ;YES, REMEMBER IT FOR END THEN
HRLZI T1,(SIXBIT/FST/) ;SET UP PROGRAM ID
HRR T1,TYPAR1 ;AND ERROR CODE IN CALL+1
PUSHJ P,.TSIXN ;TYPE THE SIXBIT
PUSHJ P,.TTABC ;AND A TAB
;CONTINUED NEXT PAGE (AT TYPE01)
;HERE WITH PREFIX TYPED AS REQUESTED, SET UP FOR SUBSTITUTION
TYPE01: MOVE P2,TYPAR2 ;GET CALL + 2
HRRZI P3,(P2) ;GET ADDRESS OF TEXT
HRLI P3,440700 ;TURN INTO BYTE POINTER
MOVEM P3,TYPADD ;SAVE POINTER TO TEXT STRING
HLRZ P4,P2 ;GET OTHER HALF READY
TRZ P4,777600 ;ZAP ALL BUT SUBS CHR
SKIPN P4 ;WAS THERE ONE?
MOVEI P4,"+" ;NO, USE + THEN
LSH P2,-^D27 ;SHIFT DOWN TO SUBS CODE
SETZM TYPCNT ;ASSUME NOT INDIRECT
CAIN P2,100 ;IS IT INDIRECT?
JRST TYPE02 ;YES, SPECIAL CASE
MOVEI P3,TYPBLK+1 ;NO, ARG IS IN SAVED T1 THEN
JRST TYPE03 ;ALL SET FOR SUBS
TYPE02: MOVE P1,TYPBLK+1 ;ARG BLOCK IS POINTED BY SAVED T1 THEN
HLRZM P1,TYPCNT ;COUNT OF ARGS NON-ZERO (FLAGS INDIRECT
HRRZ P1,P1 ;CREAM IN ARG TO GTSBWD
PUSHJ P,GTSBWD ;SET UP FIRST ARGUMENT
TYPE03: PUSHJ P,TYPTXT ;TYPE TEXT WITH SUBSTITUTION
MOVE P2,TYPAR1 ;REGET BASIC CODES
LSH P2,^D14 ;OVER TO TRAILER CODE
SETZM P1 ;CLEAR DESTINATION
LSHC P1,2 ;SHIFT IN TRAILER CODE
JUMPN P1,TYPE04 ;IF NON-ZERO NO TRAILER
MOVEI T1,"]" ;ASSUME NEED CLOSE FOR "INFO"
SKIPE INFFLG ;RIGHT?
PUSHJ P,.TCHAR ;RIGHT!
PUSHJ P,.TCRLF ;AND FINSH WITH CRLF
TYPE04: SETZM P1 ;CLEAR DESTINATION AGAIN
LSHC P1,2 ;GET RETURN CODE
SKIPE P1 ;NON-ZERO?
EXIT ;YES, DISASTER EXIT
MOVE 16,[TYPBLK,,0] ;SET UP TO
BLT 16,16 ;RESTORE AC'S
POPJ P, ;AND BACK TO CALLER
;TABLE OF LEADIN CHARACTERS
;REFERENCE WITH MSGCHR-1
MSGCHR: "?" ;1=FATAL
"%" ;2=WARNING
"[" ;3=INFO
" " ;4=TAB (BUT NO VERBO MSG)
;SUBROUTINES FOR TYPER
;SUBROUTINE TO PICK UP SUBS CODE AND ADDRESS
;CAUTION, CALL+2 IS SPECIAL FORMAT, DONT USE HERE AS SCHR IS IN INDEX
;CALLED WITH ADDRESS OF CODE IN P1
;RETURNS CODE IN P2, ADDRESS (E) IN P3, INCREMENTS P1
GTSBWD: PUSH P,P1 ;SAVE P1 IN CASE INDIRECT ADDRESS
MOVE P2,(P1) ;GET SUBS WORD
LSH P2,-^D27 ;SHIFT DOWN TO OP CODE ONLY
GTSB01: MOVE P3,(P1) ;GET ADDRESS
TLZ P3,777710 ;LESS AC AND OP CODE
TLNN P3,17 ;IS THERE AN INDEX?
JRST GTSB02 ;NO, PRESS ON
HLRZ T1,P3 ;YES, GET IT
TRZ T1,20 ;BE SURE INDIRECT IS OFF
HRRZ T1,TYPBLK(T1) ;GET OLD AC CONTENTS (RH)
ADDI P3,(T1) ;AND ADD INDEX
GTSB02: TLZN P3,20 ;INDIRECT?
JRST GTSB03 ;NO, DONE
MOVEI P1,(P3) ;YES, START AGAIN
JRST GTSB01 ;..
GTSB03: CAIGE P3,P ;ARG IN AC'S?
ADDI P3,TYPBLK ;THEN REALLY IN SAVE AREA
POP P,P1 ;RESTORE P1
SOSLE TYPCNT ;DECREMENT INDIRECT ARG COUNT
AOJ P1, ;IF ANY LEFT STEP TO NEXT WORD
POPJ P, ;AND RETURN
;SUBROUTINE TO TYPE ASCIZ TEXT STRING CALLING FOR SUBSTITUTION
;ROUTINE (TYPE IN P2, ADDRESS OF VALUE IN P3) WHENVER THE SUBS CHR
;(IN P4) IS SEEN IN THE TEXT
TYPTXT: ILDB T1,TYPADD ;GET A BYTE
SKIPN T1 ;NULL?
POPJ P, ;YES, DONE
CAIN T1,(P4) ;IS IT THE SUBSTITUTION CHR?
JRST TYPT01 ;YES, TYPE SUBSTITUTION INSTEAD
PUSHJ P,.TCHAR ;NO, TYPE THE CHR
JRST TYPTXT ;AND BACK FOR NEXT
TYPT01: SKIPLE P2 ;ARG IS NON-ZERO AND
CAILE P2,TDSPLN ;LESS THAN MAX?
JRST TYPT03 ;NO, IGNORE SUBSTITUTION THEN
MOVE T1,(P3) ;YES, GET ARGUMENT AND
PUSHJ P,@TYPDSP-1(P2) ;CALL ROUTINE
TYPT02: SKIPLE TYPCNT ;ARE WE INDIRECT?
PUSHJ P,GTSBWD ;YES, SET UP NEXT POINTER
JRST TYPTXT ;THEN NEXT CHR
TYPT03: PUSHJ P,.TCHAR ;SEND THE + AND
JRST TYPT02 ;CHECK FOR INDIRECT TO INC ARG
;DISPATCH TABLE TO SUBSTITUTION TYPER ROUTINES
TYPDSP: .TOCTW ;(1)OCTAL TYPER
.TDECW ;(2)DECIMAL TYPER
.TSIXN ;(3)SIXBIT TYPER
.TSTRG ;(4)TYPE ASCIZ STRING (ADDRESS IN P3)
TYPSIL ;(5)TYPE SIXBIT (LEFT HALF ONLY)
.TPPNW ;(6)TYPE PPN FORMAT
TDSPLN==.-TYPDSP ;LENGTH OF DISPATCH TABLE
;SPECIAL ROUTINES CALLED ABOVE
TYPSIL: TRZ T1,-1 ;CLOBBER RIGHT HALF
PJRST .TSIXN ;AND TYPE WHATS LEFT
;DEFINE TYPEOUT ROUTINES
;EXTERN TYPEOUT ROUTINES IN SCAN
EXTERN .TCRLF,.TPPNW,.TRBRK,.TSIXN,.TXWDW,.TDECW,.TOCTW,.TRDXW
EXTERN .TSTRG, .TSPAC,.TTABC,.TCOMA,.TCOLN,.TASTR,.TCHAR
;HERE TO GIVE UP (CALLED FROM DIE)
;RELOC ADDRESS AND TYPE MESSAGE
;CALL PUSHJ P,BUG
; NEVER RETURN
BUG: MOVE T1,(P) ;GET ADDRESS+1 OF FAILURE
MOVEI T1,-1(T1) ;CREAM APR FLAGS AND ADJUST ADDRESS
MOVEI T2,BEGINH ;ASSUME HIGH SEG FAILURE
CAIG T1,400000 ;HI SEG?
MOVEI T2,BEGINL ;NO, LOW SEG RELOCATION THEN
SUBI T1,(T2) ;SUBTRACT CORRECT RELOC
TYPE$ (F,PLE,$O,<PROGRAM LOGIC ERROR, REPORT ERROR + TO SYSTEMS>,,,END)
SUBTTL STORAGE
;STORAGE
;IN LOW SEGMENT
$LOW
PDL: BLOCK PDLEN
SAVFF: Z ;HOLD INITIAL .JBFF
ALOTCK: Z ;FLAG FOR MULTIPLE ALLOUT CALLS
LKWP1: INSPEC ;HOLD FIRST WORD OF FIRST SCANNER FILE SPEC
LKWP2: INSPEC ;HOLDS FIRST WORD OF LAST SCANNER FILE SPEC
LKWP3: Z ;HOLDS POINTER TO FILE SPEC
SPCLST: BLOCK SPCCNT ;HOLDS INPUT SPEC POINTERS
INSPCT: Z ;COUNT INPUT SPECS SEEN
DNSPCT: Z ;COUNT INPUT SPECS DONE
ILIST: Z ;INPUT DUMP MODE LIST
Z
INPCLS: Z ;INPUT CLUSTER SIZE
OUTCLS: Z ;OUTPUT CLUSTER SIZE
LS.ERR: -1 ;[15]VALUE OF /OKERR FOR SCAN
LS.INF: -1 ;[15]VALUE OF /INFORM FOR SCAN
LS.MOD: -1 ;[27]VALUE OF /MODE FROM SCAN
LF.ERR: -1 ;[15]/OKERR WE PRESERVE OVER CALLS
LF.INF: -1 ;[15]/INFORM WE PRESERVE OVER CALLS
%LKWLD: LKWP1,,LKWP2 ;WORD FOR INSPEC PTR, FOR LAST USED PTR
%OPENI,,%LOKUP ;ADDRESS OF OPEN,, LOOKUP
INLEN,,EXTLEN
WLDCHN,,LKWP3 ;CHANNEL FOR WILD FOR DATA
CPOPJ ;ROUTINE TO CALL AT END OF DIRECTORY
;THESE ARE KLUGES NEEDED TO MAKE .SCWLD UNDERSTAND US
PISP: INSPEC
POSP: OUTSPE
;HOLD THE DEVCHR'S RETURNED TO US
INPDVC: Z
OUTDVC: Z
;COUNT XFERS IN MOVLOP
XFERS: Z ;[15]FOR ERROR MESSAGES
WRDCLS: Z ;[32]SIZE OF CLUSTER IN WORDS
BLKCLS: Z ;[15]SIZE OF CLUSTER IN BLOCKS TO CONVERT XFERS
;ARG LIST FOR CONVERTING SCAN BLOCKS
%SCWLD: PISP,,POSP
%OPENI,,%OPENO
%LOKUP,,%ENTER
%EXT,,EXTLEN
%IPATH: ICH ;[16]PATH FOR ICH IN CHKIDN
BLOCK 7
%OPATH: OCH ;[16]PATH FOR OCH IN CHKIDN
BLOCK 7
%OPENO: BLOCK 3
%ENTER: BLOCK EXTLEN+1 ;[12]EXTENDED ENTER BLOCK
%EXT: 0,,-1 ;NO DEFAULT EXTENSION
%OPENI: BLOCK 3
%LOKUP: BLOCK EXTLEN+1 ;[12]ENTENDED LOOKUP BLOCK
CCLFLG: -1 ;[17][26]-1 OR LESS IF NOT CCL, Z IFF CCL
RSCLST: IOWD 3,COMTAB ;[17,27]IOWD TO COMMAND LIST
COMTAB: SIXBIT/HOLD/ ;[17]COMMANDS WE RECOGNIZE
SIXBIT/MOVE/ ;..
SIXBIT/DUPLIC/ ;[27]..
%ISCAN: Z ;[17]SLOT FOR RSCLST OR Z(IF NOT CCL)
SIXBIT/FST/ ;[17]OUR NAME IN CCL FILES
BLOCK 3 ;[17]NOTHING ELSE OF INTREST
%TSCAN: IOWD FASTL,FASTN ;[15]USER SWITCTH TABLE
XWD FASTD,FASTM ;[15]..
XWD Z,FASTP ;[15]..
-1 ;INDICATES USE JOB NAME FOR HLP:JOB.HLP ON /H
XWD CLRFLG,Z ;[11]ROUTINE TO CLEAR ANSWERS (ALL,,FILE)
XWD ALLIN,ALLOUT ;SUBS TO ALLOCATE INPUT AND OUTPUT
BLOCK 3
SCWP1: INSPEC ;POINTER WORD TO INSPEC
SCWP2: OUTSPE ;POINTER TO OUTSPE
INSPEC: BLOCK INLEN ;
OUTBLK: BLOCK OUTLEN ;BLOCK FOR ACTUAL SPEC
OUTSPE: BLOCK OUTLEN ;[14]BLOCK FOR POSSIBLY HACKED VERSION
%DVCHR: BLOCK DEVLEN ;DSKCHR ARG BLOCK
END START ;[26]