github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-11 02:29:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/fast/fast.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1458 lines
53 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;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:SCAN,REL:WILD,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 AND VERSION
.JBVER==137
LOC .JBVER
VRSN. FST
TITLE. (FST,FAST,<FAST DISK TO DISK COPY UTILITY>)
; 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]
Reference in New Issue View Git Blame Copy Permalink