ARK
  15
.HOWTOLST
.IOERR006
.PCK@@002
.SIXPK001
ARCHIV003
ARK@@@JOB
DEARCH008
DRK@@@JOB
GNAMES006
NOFPP@PRM
ORDER@007
SAVE@@011
TF1@@@SRC
TF2@@@SRC
UN.PCK002
[\].
.HOWTOLST
 
 

 
 
                            INTRODUCTION
 
             THE ROUTINES IN THIS PACKAGE ARE THE COMPONENTS
        OF TWO TDV FUNCTIONS WHOSE PURPOSE IS TO PERFORM THE
        ARCHIVING  AND THE DE-ARCHIVING OF IOPS ASCII FILES.
        THE ARCHIVE PROCESS COMBINES ALL OF THE ASCII  FILES
        IN  A  DISK  UFD (UP TO 150 MAX) INTO A SINGLE ASCII
        FILE, USUALLY ON DECTAPE. THE DE-ARCHIVE PROCESS  IS
        THE  REVERSE  OF  THE ARCHIVE PROCESS, INPUTTING THE
        SINGLE ARCHIVE FILE, AND SPLITTING IT  UP  INTO  THE
        ORIGINAL SEPARATE FILES.
 
             THE   SUPPLIED   PROGRAMS  ARE  THE  DE-ARCHIVE
        PROGRAM 'DEARCH 008' AND SUPPORTING ROUTINES '.IOERR
        006', '.PCK 002', 'UN.PCK 002' AND '.SIXPK 002',  AS
        WELL  AS  A  MULTIACCESS  BATCH  FILE  'DRK  JOB' TO
        ASSEMBLE AND TASK BUILD 'DRK... TSK', THE DE-ARCHIVE
        TASK. THE ARCHIVE  ROUTINES  'ARCHIV  003',  'GNAMES
        006', 'ORDER 007', 'SAVE 011', THE MULTIACCESS BATCH
        FILE  'ARK JOB', A TEST ROUTINE TO GENERATE 150 TEST
        FILES,  PLUS  THE  AFOREMENTIONED   DE-ARCHIVE   AND
        SUPPORTING  PROGRAMS  ARE  SUPPLIED  IN ARCHIVE FILE
        FORMAT, AND CAN BE RETRIEVED AFTER 'DRK...' HAS BEEN
        INSTALLED.
 
             IT SHOULD BE NOTED THAT THE BATCH FILES  EXPECT
        TO  FIND  THE  SOURCE FILES ON RK1<ARK>, AND MUST BE
        EDITED IF THEY ARE TO BE USED WITH A DIFFERENT  DISK
        AND/OR UFD.
 
             THESE  ROUTINES  HAVE  BEEN  DEVELOPED ON AN RK
        BASED SYSTEM WITH BOTH XVM/RSX V1A AND  MULTIACCESS.
        THEY  SHOULD  ALSO  RUN  ON  RF AND RP BASED SYSTEMS
        WITHOUT ALTERATION, BUT THIS HAS NOT BEEN CONFIRMED.
 
                        ASSEMBLY PARAMETERS
 
             ASSEMBLY PARAMETERS ARE NOT  REQUIRED  FOR  THE
        DE-ARCHIVE  PROGRAM.  THE  ARCHIVE ROUTINES HAVE TWO
        ASSEMBLY PARAMETERS. 'NOMAC' MUST BE DEFINED FOR USE
        WITH A NON-MULTIACCESS SYSTEM, AND 'NOFPP'  MUST  BE
        DEFINED  IF THE FP15 FLOATING POINT PROCESSOR IS NOT
        AVAILABLE.
 
 
 
 
 
 
 
 
 
 
 
 
 
 

 
 
 
 
 

 
 
                             LUN USAGE
 
             THESE  TASKS  MAKE  USE  OF  STANDARD  RSX  LUN
        CONVENTIONS. LUN 15 IS ASSOCIATED WITH A UFD ON DISK
        AND CONTAINS THE INDIVIDUAL FILES FOR ARCHIVING, AND
        RECEIVES THE INDIVIDUAL FILES WHEN DE-ARCHIVING. LUN
        17,  ALSO  ASSOCIATED WITH DISK, IS USED ONLY DURING
        THE ARCHIVE PROCESS AND RECEIVES  A  TEMPORARY  FILE
        CONTAINING THE LIST OF FILES TO BE ARCHIVED. LUN 19,
        USUALLY ASSOCIATED WITH DECTAPE, RECEIVES THE SINGLE
        FILE  DURING ARCHIVING, AND SUPPLIES THE SINGLE FILE
        DURING DE-ARCHIVING.
 
                         PROGRAM OPERATION
 
             IN BRIEF, THE ARCHIVE TASK GETS  THE  NAMES  OF
        THE  ASCII  FILES  (150  MAX), ARRANGES THE NAMES IN
        ALPHABETICAL ORDER, SAVES THESE FILES  IN  A  SINGLE
        FILE,  THEN IF (AND ONLY IF) THE SINGLE FILE (ON LUN
        19) HAS BEEN STORED WITHOUT ERROR ON A FILE-ORIENTED
        DEVICE, DELETES  THE  ORIGINAL  FILES.  THE  MAXIMUM
        NUMBER  OF FILES HAS ARBITRARILY BEEN SET AT 150 AND
        CAN EASILY BE ALTERED BY CHANGING PARAMETER 'NFILES'
        IN PROGRAM 'ORDER'.
 
             THE NAME OF THE ARCHIVE FILE PRODUCED ON LUN 19
        IS THE CURRENT DATE (DDMMYY) AS  DETERMINED  BY  THE
        'DATE'  SYSTEM  DIRECTIVE,  AND THE EXTENSION IS THE
        UIC ASSOCIATED WITH THE UFD ON LUN 15.
 
             THE ARCHIVED FILE CONTAINS THE UIC, THE  NUMBER
        OF FILES ARCHIVED, AND A LIST OF THE FILES ARCHIVED,
        FOLLOWED  BY  THE FILES THEMSELVES. THIS INFORMATION
        IS  ALSO  SUPPLIED  IN   FILE   'NAMES   ...'   WHEN
        DE-ARCHIVING.
 
                                USE
 
             THE  TWO  TASKS  ARE  INTENDED  TO  OPERATE  AS
        STANDARD TDV FUNCTION TASKS. TO  ARCHIVE  THE  ASCII
        FILES ON LUN 15:
 
 
                  TDV>ARK
 
 
        TO DE-ARCHIVE THE FILES ARCHIVED FROM DISK UFD <ARK>
        ON SEPTEMBER 5, 1978:
 
 
                  TDV>DRK 05SE78 ARK
 
 
 
 
 
 

 
 
 
[\].
.IOERR006
	.TITLE	.IOERR
/
/   1 AUG 78 (006; PDH) MUST USE SIGNED SHIFT
/   1 AUG 78 (005; PDH) REVAMP TO USE '.PCK' AND TO ANNOUNCE 6-DIGIT
/			VALUE WHEN EV .GT. 777
/  25 OCT 77 (004; PDH) CHANGE FROM 'MCR=3' TO 'TTY=4' FOR MULTIACCESS
/  14 JUL 77 (003; PDH) ANNOUNCE CALLING ADDRESS ALSO
/  21 APR 77 - PAUL HENDERSON
/
/  THIS ROUTINE, CALLABLE ONLY FROM ASSEMBLY LANGUAGE PROGRAMS, IS
/  USED TO OUTPUT THE NAME OF THE  TASK  AND THE OCTAL VALUE OF AN
/  I/O ERROR, AND THE ADDRESS FROM WHICH IT IS CALLED.   THIS IS A
/  FATAL ERROR ANNOUNCEMENT,  AS THE ROUTINE EXITS AFTER THE ERROR
/  ANNOUNCEMENT.
/
/  CALLING SEQUENCE:
/
/	LAC	EV
/	JMS*	.IOERR		/ NECESSARY TO ESTABLISH CALLING ADDRESS
/
ECLA=641000		/ EAE CLEAR AC INSTRUCTION
	.DEC
TTY=4			/ LUN ON WHICH ERROR MESSAGE IS ISSUED
	.OCT
/
	.GLOBL	.IOERR
	.GLOBL	PCK.IN,.PCK					/(005)
/
.IOERR	NOP
	DAC	VALUE		/ SAVE BAD EVENT VARIABLE	/(005)
	CAL	TSKNAM		/ GET NAME OF CALLING TASK	/(005)
	LAW	-6						/(005)
	DAC	COUNT		/ ASSUME NON-STANDARD VALUE	/(005)
	LAC	(ERRB						/(005)
	JMS*	PCK.IN		/ SET UP PACKING ROUTINE	/(005)
	LAC	VALUE		/ RETRIEVE EVENT VARIABLE	/(005)
	SMA!TCA			/ PROBABLY NEGATIVE ON ENTRY,
	TCA			/ BUT MAY NOT BE.  MAKE POSITIVE.
	CLQ!LRSS 11		/ SHIFT BAD EV TO UPPER HALF OF CLEARED MQ /(006)
	SZA							/(005)
	JMP	STRANGE		/ EV .GT. 777 - STRANGE THINGS	/(005)
	LAW	-3		/ NORMALLY, BAD EV'S ARE 3 DIGITS /(005)
	DAC	COUNT						/(005)
	LACQ			/ GET 3-DIGIT VALUE FROM MQ	/(005)
	DAC	VALUE		/ AND PLACE IT IN CORRECT PLACE	/(005)
 
	.EJECT
STRANGE	JMS	OCT2AS		/ CONVERT OCTAL 'VALUE' TO ASCII /(005)
	LAW	40
	JMS*	.PCK		/ FOLLOW EV WITH SPACE		/(005)
 
	LAC	.IOERR		/ GET CALLING ADDRESS
	SAD	(NOP		/ IF ENTERED BY 'JMS',
	JMP	ENDADR		/ CALLING ADDRESS IS UNAVAILABLE /(005)
	ALS	3						/(005)
	DAC	VALUE		/ SAVE 15-BIT ADDRESS		/(005)
	LAW	-5						/(005)
	DAC	COUNT		/ 5 DIGITS			/(005)
	JMS	OCT2AS		/ PACK THEM UP			/(005)
ENDADR	LAW	15		/ FINISH WITH CARRIAGE RETURN	/(005)
	JMS*	.PCK						/(005)
 
	.EJECT
/  WE HAVE NOW PACKED UP THE EVENT VARIABLE AND CALLING ADDRESS.  GET
/  THE TASK NAME AND PREPARE IT FOR OUTPUT.
 
	LAC	(TASKNM						/(005)
	JMS*	PCK.IN		/ SET UP PACKING ROUTINE AGAIN	/(005)
	LAC	TSKNAM+2					/(005)
	LMQ			/ PUT 1ST CHARACTER IN MQ	/(005)
	JMS	SIXTO7		/ CONVERT TO 7-BITS AND STORE	/(005)
	LAC	TSKNAM+2					/(005)
	LRS	14		/ 2ND CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+2					/(005)
	LRS	6		/ 3RD CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LMQ			/ 4TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LRS	14		/ 5TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LRS	6		/ 6TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
 
/  MESSAGE BUFFER HAS BEEN PREPARED.  ANNOUNCE IT ON TTY.
 
ENDNAME	CAL	WRERR		/ ANNOUNCE ERROR		/(005)
	CAL	WAITFR		/ WAIT FOR IT
	CAL	(10		/ THEN EXIT
 
	.EJECT
/  SUBROUTINE TO CONVERT 'COUNT' DIGITS FROM 'VALUE' TO ASCII AND
/  PACK THEM, USING ROUTINE '.PCK'.
/    BEFORE CALLING, THE NUMBER OF DIGITS MUST BE SPECIFIED (2'S COMP)
/  IN 'COUNT', AND THE '.PCK' ROUTINE MUST HAVE BEEN SET UP.
 
OCT2AS	XX							/(005)
OCT2.1	LAC	VALUE						/(005)
	LMQ			/ PUT NEW VALUE IN MQ		/(005)
	ECLA!LLS 3		/ SHIFT IN NEXT OCTAL DIGIT	/(005)
	DAC	EV		/ SAVE TEMPORARILY		/(005)
	LACQ							/(005)
	DAC	VALUE		/ SAVE NEW VALUE		/(005)
	LAC	EV		/ RETRIEVE DIGIT		/(005)
	XOR	(60						/(005)
	JMS*	.PCK		/ PACK ASCII CHARACTER		/(005)
	ISZ	COUNT						/(005)
	JMP	OCT2.1		/ PACK ANOTHER IF NOT DONE	/(005)
	JMP*	OCT2AS						/(005)
 
 
/  SUBROUTINE TO EXTRACT A 6-BIT CHARACTER FROM THE MQ AND CONVERT IT
/  TO A 7-BIT IMAGE ASCII CHARACTER IN THE AC.
 
SIXTO7	XX
	ECLA!LLS 1		/ SHIFT IN HIGH-ORDER BIT OF CHARACTER
	SNA
	XOR	(2		/ CONVERT FROM 6- TO 7-BIT, AS APPROPRIATE
	LLS	5		/ SHIFT IN REST OF CHARACTER
	SAD	(100		/ '@' MEANS END OF TASK NAME
	JMP	ENDNAME
	JMS*	.PCK		/ PACK THE CHARACTER		/(005)
	JMP*	SIXTO7
 
	.EJECT
ERRL	EL-.*400+2;EV
	.ASCII	'***'
TASKNM	0; 0
	.ASCII	<0><0><0>': I/O ERROR '
ERRB	.BLOCK	6;EL=.;VALUE					/(006)
TSKNAM	25;COUNT 0;	.BLOCK 2
WRERR	2700;	EV;	TTY; 2; ERRL
WAITFR	20;	EV
	.END
[\].
.PCK@@002
	.TITLE	.PCK
/
/  26 JUN 78 (002; PDH) DEBUG
/  26 JUN 78 - PAUL HENDERSON
/
/  ROUTINE TO PACK CHARACTERS, AS THEY ARE SUPPLIED, INTO 5/7
/  ASCII.  IF A LINE TERMINATOR (CR OR ALT MODE) IS ENCOUNTERED
/  THIS FACT IS NOTED IN THE INFORMATION RETURNED.
/
/  *** NOTE ***  THE ROUTINE MUST BE SET UP BY THE APPROPRIATE
/		CALL TO 'PCK.IN', OR DISASTER MAY BE PERPETRATED!
/
/  CALLING SEQUENCES:
/
/  1) TO INITIALIZE -
/
/	LAC	(ADDRESS OF BUFFER TO RECEIVE PACKED CHARACTERS
/	JMS*	PCK.IN
/	(RETURN)
/
/  2) TO PACK A CHARACTER -
/
/	LAC	CHARACTER
/	JMS*	.PCK
/	(RETURN)		/ LINK = 1 IF TERMINATOR SINCE LAST SETUP
/				/ AC = NUMBER OF WORDS PACKED
/				/ MQ = NUMBER OF CHARACTERS PACKED
 
INC=ISZ			/ INCREMENT A POSITIVE COUNTER
IDX=ISZ			/ INDEX A POINTER
SET=ISZ			/ SET A FLAG NON-ZERO
 
	.GLOBL	PCK.IN
 
PCK.IN	XX
	DAC	WPNT		/ SAVE LINE BUFFER ADDRESS IN WORKING POINTER
	LAC	(..1
	DAC	SWING		/ SET UP PACKING ROUTINE
	DZM	TERMIN		/ CLEAR 'LINE TERMINATOR PACKED' FLAG
	DZM	CCOUNT		/ ZERO CHARACTER COUNTER
	DZM	WCOUNT		/ AND WORD COUNTER
	JMP*	PCK.IN
 
WPNT;TERMIN;CCOUNT;WCOUNT
	.EJECT
	.GLOBL	.PCK
 
.PCK	XX
	AND	(177		/ ENSURE 7 BITS ONLY
	SAD	(15
	SKP
	SAD	(175
	SET	TERMIN		/ SET FLAG IF CR OR ALT MODE
	JMP*	SWING		/ PACK THE CHARACTER
 
SWING	..1
	INC	CCOUNT		/ INCREMENT CHARACTER COUNTER
	LAC	TERMIN		/ IF WE HAVE PACKED A LINE TERMINATOR
	SZA!CLL		/ SET LINK
	STL
	LAC	CCOUNT		/ EXIT WITH CHARACTER COUNT IN MQ
	LMQ
	LAC	WCOUNT		/ WORD COUNT IN AC, AND
	JMP*	.PCK		/ LINE TERMINATOR FLAG IN LINK.
 
..1	INC	WCOUNT		/ INCREMENT WORD COUNTER
	ALSS	13
	DAC*	WPNT
	JMS	SWING
 
..2	ALSS	4
	XOR*	WPNT
	DAC*	WPNT
	JMS	SWING
 
..3	CLQ!LRSS 3
	XOR*	WPNT
	DAC*	WPNT
	IDX	WPNT		/ INDEXTO NEXT WORD
	INC	WCOUNT		/ COUNT THE WORD
	LACQ			/ RETRIEVE FINAL 3 BITS OF 3RD CHARACTER
	DAC*	WPNT
	JMS	SWING
 
..4	ALSS	10
	XOR*	WPNT
	DAC*	WPNT
	JMS	SWING
 
..5	CLL!RAL
	XOR*	WPNT
	DAC*	WPNT
	IDX	WPNT		/ INDEX POINTER FOR NEXT PAIR, BUT
	JMS	SWING		/ WORD COUNTER WILL BE INCREMENTED ONLY
	JMP	..1		/ IF ANOTHER CHARACTER IS PACKED.
 
	.END
[\].
.SIXPK001
	.TITLE	.SIXPK
/
/  23 JUN 78 - PAUL HENDERSON
/
/  THIS ROUTINE CONSTRUCTS A .SIXBT FILE NAME AND EXTENSION AS
/  CHARACTERS ARE SUPPLIED, ONE CHARACTER PER CALL.  THE CONVENTION
/  USED IS THAT CHARACTERS ARE PACKED, THREE PER WORD, IN THE
/  FILE NAME AND EXTENSION.  ALL NON-SPACE CHARACTERS AFTER A
/  SPACE GO IN THE EXTENSION, EVEN IF THE FILE NAME IS NOT
/  COMPLETELY FILLED, OR IF THERE HAVE BEEN MORE THAN SIX
/  CHARACTERS.  ALL CHARACTERS AFTER THE NINTH (IF NO SPACE)
/  OR AFTER THE THIRD EXTENSION CHARACTER ARE IGNORED, AS ARE
/  ALL CHARACTERS INCLUDING AND AFTER A LINE TERMINATOR.
/     THE ROUTINE MUST BE INITIALIZED BY A CALL TO 'SIX.IN',
/  WHICH ALSO ZEROS THE 3-WORD FILE NAME BUFFER.
/
/  CALLING SEQUENCES:
/
/ 1) TO INITIALIZE -
/
/	LAC	(ADDRESS OF 3-WORD FILE NAME BUFFER
/	JMS*	SIX.IN
/	(RETURN)
/
/ 2) TO PACK CHARACTERS -
/
/	LAC	CHARACTER
/	JMS*	.SIXPK
/	(RETURN)
/
X10=10
SET=ISZ			/ SET A FLAG NON-ZERO
	.GLOBL	SIX.IN
/
SIX.IN	XX
	DAC	KPNT		/ KEEP ORIGINAL POINTER
	DAC	WPNT		/ WORKING POINTER GETS ALTERED
	DAC*	(X10
	DZM*	WPNT
	DZM*	X10		/ ZERO THE 3-WORD BLOCK
	DZM*	X10
	LAC	(FIRSTC
	DAC	SWING		/ SET UP THE BRANCH ADDRESSES
	LAC	(FNAME2
	DAC	SELECT
	DZM	TERMIN		/ CLEAR 'LINE TERMINATOR FOUND'
	JMP*	SIX.IN
/
KPNT;WPNT;TERMIN 1
	.EJECT
	.GLOBL	.SIXPK
/
.SIXPK	XX
	AND	(177		/ ENSURE WE HAVE ONLY 7 BITS
	SAD	(15		/ IF (CARRIAGE RETURN
	SKP
	SAD	(175		/ 	OR ALT MODE)
	JMP	CRALT		/    IGNORE ALL CHARACTERS UNTIL
				/    AFTER NEXT 'SIX.IN';
	SAD	(40		/ ELSEIF (SPACE)
	JMP	EXT		/    CHARACTERS GO IN EXTENSION
	AAC	-140
	SMA			/ IF (LOWER CASE)
	AAC	-40		/    CONVERT TO UPPER CASE
	AAC	140
	AND	(77		/ CHOP TO 6 BITS
	JMP*	SWING		/ THEN PROCESS CHARACTERS IN TURN
/\
SWING	OVRFLOW			/ IGNORE CHARACTERS UNLESS SET UP
	JMP*	.SIXPK
/
CRALT	SET	TERMIN		/ SET 'LINE TERMINATOR FOUND' FLAG
	JMP	OVRFLOW		/ THEN IGNORE CHARACTERS
/
NXT	JMS	SWING		/ ESTABLISH CORRECT BRANCH ADDRESS
/
FIRSTC	ALSS	14
	DAC*	WPNT		/ STORE FIRST CHARACTER
	JMS	SWING
/
	ALSS	6
	XOR*	WPNT		/ INCLUDE WITH 1ST CHAR
	DAC*	WPNT		/ AND STORE FIRST 2 CHARACTERS
	JMS	SWING
/
	XOR*	WPNT
	DAC*	WPNT		/ WORD NOW FULL.
	JMP*	SELECT		/ SELECT NEXT STAGE IN PROCESSING
/
	.EJECT
SELECT	OVRFLOW			/ IGNORE IF NOT SET UP
	JMP	NXT		/ SET UP WORD PACKER FOR
				/ ANOTHER 3 CHARACTERS
FNAME2	LAC	KPNT
	IAC			/ POINT TO SECOND WORD OF BLOCK
	DAC	WPNT
	JMS	SELECT
/
EXT	LAC	TERMIN		/ MUST CHECK BECAUSE A SPACE AFTER
	SZA			/ A LINE TERMINATOR COULD WREAK HAVOC
	JMP	OVRFLOW
	LAC	KPNT
	AAC	2
	DAC	WPNT		/ SELECT 3RD WORD (EXTENSION)
	JMS	SELECT
/
OVRFLOW	JMS	SWING		/ RETURN WITHOUT PROCESSING
	JMP	OVRFLOW		/ OVERFLOW CHARACTERS
	.END
[\].
ARCHIV003
	.TITLE	ARCHIVE
/
/  15 SEP 78 (003; PDH) RETRO-FIT FOR NON-MULTIACCESS USE
/   8 SEP 78 (002; PDH) ADD SOME INSTRUCTIONS FOR ASSEMBLY PARAMETERS
/  15 AUG 77 - PAUL HENDERSON
/
/  MAINLINE TO INVOKE THE PROGRAM SEGMENTS TO PERFORM THE ARCHIVING OF
/  ALL OF THE ASCII FILES (150 MAX) IN A PARTICULAR UFD, THEN DELETE
/  THESE FILES FROM THE UFD.
/
/  DEFAULT ASSEMBLY (NO PARAMETERS) PRODUCES PROGRAM SEGMENTS FOR A
/  TASK TO RUN UNDER MULTIACCESS (XVM/RSX V1B), USING THE FP15
/  FLOATING POINT PROCESSOR.  TO ASSEMBLE FOR XVM/RSX V1A, THE SYMBOL
/NOMAC=1	MUST BE DEFINED.  TO ASSEMBLE FOR USE WITHOUT FP15,
/NOFPP=1	MUST BE DEFINED.
 
	.GLOBL	GNAMES,ORDER,SAVE
 
ARCHIVE	CAL	XFRCMD		/ NEEDED ONLY TO MAKE A		/(003)
	CAL	WAITFR		/ NON-MULTIACCESS SYSTEM HAPPY	/(003)
 
	JMS*	GNAMES		/ GET NAMES OF ASCII FILES
	JMS*	ORDER		/ ARRANGE THEM IN ALPHABETIC ORDER
	JMS*	SAVE		/ SAVE THEM IN THE 'ARCHIVE' FILE,
				/ THEN DELETE THEM.
	LAC	EV						/(003)
	SAD	(2		/ CARRIAGE RETURN?		/(003)
	CAL	REQTDV		/ ONLY NECESSARY IF NOT M.ACC.	/(003)
	CAL	(10		/ THEN EXIT
 
WAITFR	20;	EV;EV						/(003)
XFRCMD	37;	EV;	LINE; 6					/(003)
REQTDV	01; 0;	.SIXBT	'TDV...' ; 0				/(003)
LINE	.BLOCK	6						/(003)
	.END	ARCHIVE
[\].
ARK@@@JOB
$JOB 73 T=5 UFD=RK1<ARK>
$MSG 'ARK' JOB TO ASSEMBLE AND TASK BUILD 'ARK...'
$MAC ERB_.IOERR 006,.PCK 002
$MAC ERB_ARCHIV 003
$MAC ERB_GNAMES 006
$MAC BERP_NOFPP PRM,ORDER 007
$MAC BERP_NOFPP PRM,SAVE 011
$TKB
NRM
 }
ARK...
 }
350
 }
TDV(10000)
 }
ARCHIV,.IOERR,.PCK
 }
GNAMES:ORDER:SAVE
 }
 }
 
$END
[\].
DEARCH008
	.TITLE	DEARCH
/
/  15 SEP 78 (008; PDH) RETRO-FIT TO NON-MULTIACCESS TASK
/  12 SEP 78 (007; PDH) OOPS!  WE FORGOT 1ST CHARACTER OF NAME.
/  12 SEP 78 (006; PDH) CONVERT TO NEW SYSTEM ROUTINES 'UN.PCK' & '.SIXPK'
/  20 OCT 77 (005; PDH) CONVERT TO TDV FUNCION FOR MULTIACCESS
/   1 SEP 77 (004; PDH) CREATE 'NAMES ...' FILE ON INPUT
/  26 AUG 77 - PAUL HENDERSON
/
/  PROGRAM TO DE-ARCHIVE AN ARCHIVED FILE -- IE. READ IT AND PRODUCE
/  SEPARATE DISK FILES.  IT WILL ALSO PRODUCE FILE 'NAMES ...' WHICH IS
/  A LIST OF ALL FILES DE-ARCHIVED.
 
	.DEC
TTO=13			/ ERROR MESSAGE OUTPUT
DK=15			/ DISK LUN (OUTPUT FILES)
DT=19			/ DECTAPE INPUT ARCHIVED FILE
	.OCT
X10=10
IDX=ISZ
 
	.GLOBL	.IOERR
	.GLOBL	UNP.IN,UN.PCK,SIX.IN,.SIXPK			/(006)
 
DEARCH	CAL	XFRCMD		/ GET TDV COMMAND LINE
	JMS	WTFOR
	DAC	TERMIN		/ SAVE TERMINATOR TYPE		/(008)
	LAC	(LINE+2
	JMS*	UNP.IN		/ INITIALIZE THE UNPACK		/(006)
	LAC	(DTNAME						/(006)
	JMS*	SIX.IN		/ AND FILE NAME PACK ROUTINES	/(006)
	LAC	(IMAGE+1					/(006)
	DAC*	(X10		/ POINTER FOR START OF FILE NAME
	LAC	EOFCODE+1
	DAC	LINE+21		/ ENSURE THAT THERE IS A CARRIAGE RETURN
 
CK4SP	JMS*	UN.PCK		/ UNPACK A CHARACTER		/(006)
	JMP	ERR1		/ LINE TERMINATOR; NO FILE NAME	/(006)
	SAD	(40		/ IS IT A SPACE?
	JMP	SPFND
	JMP	CK4SP
 
SPFND	JMS*	UN.PCK						/(006)
	JMP	ERR1		/ LINE TERMINATOR TOO EARLY	/(006)
	SAD	(40
	JMP	SPFND		/ FLUSH OUT ALL SPACES
	JMP	SVCHR		/ 1ST NON-SPACE CHAR IN AC	/(007)
 
	.EJECT
GETCHR	JMS*	UN.PCK		/ UNPACK FILE NAME CHARACTER	/(006)
	JMP	OPENIF		/ STOP AT END OF LINE		/(006)
SVCHR	DAC*	X10		/ SAVE IN CASE NEEDED LATER	/(007)
	JMS*	.SIXPK		/ PACK UP IN .SIXBT		/(006)
	JMP	GETCHR						/(006)
 
OPENIF	CAL	SEEK		/ OPEN INPUT FILE ON DECTAPE	/(006)
	CAL	WAITFR
	LAC	EV
	SMA
	JMP	FOUND		/ FILE FOUND.  PROCEED HAPPILY
	SAD	(-13
	JMP	ERR2		/ FILE NOT FOUND ERROR
	JMS*	.IOERR		/ OTHER FATAL ERROR
 
ERR1	CAL	WRER1		/ 'NO INPUT FILE NAME SUPPLIED'
	JMP	EXIT
 
ERR2	DZM*	X10		/ ENSURE EVEN COUNT & NO GARBAGE /(006)
	LAC	(IMAGE-1					/(006)
	TCA							/(006)
	TAD*	(X10		/ CALCULATE CORRECT HEADER	/(006)
	ALSS	10						/(006)
	XOR	(3		/ IMAGE ASCII MODE		/(006)
	DAC	IMAGE		/ STORE HEADER			/(006)
	CAL	WRER2A		/ 'FILE '			/(006)
	CAL	WRER2B		/ (FILE NAME AND EXTENSION)
	CAL	WRER2C		/ ' NOT FOUND'
EXIT	JMS	WTFOR		/ WAIT FOR MESSAGE TO BE PRINTED
	LAC	TERMIN		/ DETERMINE <CR> OR <ALT> FOR	/(008)
	SAD	(2		/ NON-MULTIACCESS COMPATIBILITY	/(008)
	CAL	REQTDV		/ IT WAS <CR>			/(008)
	CAL	(10		/ THEN EXIT
 
	.EJECT
FOUND	CAL	ENTERN		/ OPEN OUTPUT FILE 'NAMES ...'
	JMS	WTFOR
	JMP	RDLOOP		/ THEN DUMP FIRST PART OF INPUT INTO IT
 
GETNAM	JMS	READ		/ READ FILE NAME
	JMP	.-1		/ IGNORE '[\].' IF FOUND HERE!
	LAC	(LINE+2						/(006)
	JMS*	UNP.IN		/ INITIALIZE UNPACK		/(006)
	LAC	(NAME		/ AND FILE NAME ROUTINES	/(006)
	JMS*	SIX.IN						/(006)
 
PCKNAM	JMS*	UN.PCK		/ UNPACK A CHARACTER		/(006)
	JMP	OPENOF		/ OPEN OUTPUT FILE WHEN READY	/(006)
	JMS*	.SIXPK		/ PACK THE CHARACTER		/(006)
	JMP	PCKNAM
 
OPENOF	CAL	ENTER		/ OPEN OUTPUT FILE ON DISK	/(006)
	JMS	WTFOR
 
RDLOOP	JMS	READ		/ READ LINE OF INPUT FILE
	JMP	ENDFIL		/ '[\].' SIGNIFIES INTERNAL END-OF-FILE
	CAL	WRITE
	JMS	WTFOR
	JMP	RDLOOP
 
ENDFIL	CAL	CLOSDK		/ CLOSE DISK FILE
	JMS	WTFOR
	JMP	GETNAM		/ GO PROCESS NEXT NAME (OR EOF)
 
	.EJECT
/  SUBROUTINE TO READ A RECORD FROM THE DECTAPE INPUT FILE, CHECKING
/  FOR END OF FILE DATA MODE AND INTERNAL END-OF-FILE '[\].'
 
/  CALLING SEQUENCE:
 
/	JMS	READ		/ READ RECORD INTO 'LINE'
/	(RETURN IF '[\].')
/	(NORMAL RETURN)
 
/  WHEN PHYSICAL END OF FILE IS DETECTED, THE PROGRAM ANNOUNCES
/  ITS COMPLETION AND EXITS.
 
READ	XX
	CAL	RDTAPE		/ READ RECORD FROM DECTAPE LUN
	JMS	WTFOR
	LAC	LINE
	AND	(7
	SAD	(5		/ CHECK FOR PHYSICAL END-OF-FILE
	JMP	FINIS
	LAC	LINE+2
	SAD	EOFCODE		/ CHECK FOR '[\].', THE INTERNAL
	SKP			/ END-OF-FILE CODE
	JMP	NOTEOF
	LAC	LINE+3
	SAD	EOFCODE+1
	SKP			/ '[\].' FOUND.  DON'T INDEX RETURN POINTER
NOTEOF	IDX	READ		/ NOT EOF.  INDEX TO NORMAL RETURN.
	JMP*	READ
 
/  PHYSICAL END-OF-FILE HAS BEEN DETECTED ON DECTAPE.
 
FINIS	CAL	CLOSDT		/ CLOSE DECTAPE FILE JUST TO BE TIDY
	JMS	WTFOR
	CAL	WRFINI		/ 'DE-ARCHIVING COMPLETE'
	JMS	WTFOR
	CAL	(10
 
/  SUBROUTINE TO WAIT FOR EVENT VARIABLE
 
WTFOR	XX
	LAC	EV		/ PERFORM QUICK CHECK SO WE
	SNA
	CAL	WAITFR		/ ONLY WAIT WHEN NECESSARY
	LAC	EV
	SPA
	JMS*	.IOERR		/ COMPLAIN ABOUT BAD EV
	JMP*	WTFOR
 
	.EJECT
/  CAL PARAMETER BLOCKS , CONSTANTS, AND VARIABLES
 
WAITFR	20;	EV
XFRCMD	37;	EV;	LINE; 22
REQTDV	01; 0;	.SIXBT	'TDV...' ; 0;TERMIN			/(008)
WRER1	2700;	EV;	TTO; 2; E1MSG
WRER2A	2700;	0; 	TTO; 2; E2AMSG
WRER2B	2700;	0;	TTO; 3; IMAGE
WRER2C	2700;	EV;	TTO; 2; E2CMSG
SEEK	3200;	EV;	DT;DTNAME .BLOCK 3
ENTERN	3300;	EV;	DK; .SIXBT 'NAMES@...'
ENTER	3300;	EV;	DK;NAME   .BLOCK 3
WRITE	2700;	EV;	DK; 2; LINE
	.EJECT
CLOSDK	3400;	EV;	DK
CLOSDT	3400;	EV;	DT
RDTAPE	2600;	EV;	DT; 2; LINE; 100
WRFINI	2700;	EV;	TTO; 2; FINI
E1MSG	E1-.*400+2;EV; .ASCII 'NO FILE NAME SUPPLIED'<15> ;E1=.
E2AMSG	E2A-.*400+2; 0; .ASCII 'FILE '<175> ;E2A=.
TENS=DT/12	/ GAME TO ALLOW ASSEMBLER GENERATION OF DT LUN
UNITS=TENS*12*777777+DT
 
E2CMSG	E2C-.*400+2; 0; .ASCII ' NOT FOUND ON L'
	.ASCII	'UN ' ; .LOC .-1
	60+TENS*200+60+UNITS*2
	.ASCII	<15> ;E2C=.
FINI	FI-.*400+2; 0; .ASCII 'DE-ARCHIVING COMPLETE'<15> ;FI=.
EOFCODE	.ASCII	'[\].'<15>
LINE	.BLOCK	100
IMAGE=LINE+22
	.END	DEARCH
[\].
DRK@@@JOB
$JOB 73 T=5 UFD=RK1<ARK>
$MSG 'DRK' JOB TO ASSEMBLE AND TASK BUILD 'DRK...'
$MAC ERB_.IOERR 006,.PCK 002,UN.PCK 002,.SIXPK 001
$MAC ERB_DEARCH 008
$TKB
NRM
 }
DRK...
 }
350
 }
TDV(10000)
 }
DEARCH,.PCK,.IOERR,UN.PCK,.SIXPK
 }
 }
 
$END
[\].
GNAMES006
	.TITLE	GNAMES
/
/  20 OCT 77 (005; PDH) CONVERT TO MULTIACCESS TDV FUNCTION
/   1 SEP 77 (004; PDH) DELETE 'NAMES ...' BEFORE WE START
/  15 AUG 77 - PAUL HENDERSON
/
/  PROGRAM SEGMENT TO GET THE NAMES OF ALL ASCII FILES IN THE UFD
/  ASSOCIATED WITH LUN 15, AND STORE THE NAMES IN 5/7 ASCII IN
/  FILE 'NAMES ...' ON LUN 17.  THIS FILE WILL BE PROCESSED BY
/  LATER STEPS IN THE TASK.
/
/  IF THE TASK IS TO RUN ON A NON-MULTIACCESS SYSTEM, THE PARAMETER
/NOMAC=1	/ MUST BE DEFINED.
/
	.DEC
TTY=13
ILUN=15
OLUN=17
	.OCT
MA.LOF=222	/ .SCOM LOCATION CONTAINING CURRENT MULTIACCESS LUN OFFSET
LUFD1=304	/ .SCOM LOCATION CONTAINING POINTER TO LUN-UFD TABLE
ECLA=641000
IDX=ISZ	/ INDEX POINTER, SKIP NEVER EXPECTED
/
	.GLOBL	GNAMES,.IOERR
/
	.EJECT
GNAMES	XX
	.IFUND	NOMAC
	LAC	(MA.LOF
	DAC	SPYADR
	CAL	SPY
	LAC	SPYCON		/ ADDING CURRENT MULTIACCESS LUN OFFSET
	TAD	(ILUN		/ TO VIRTUAL LUN
	DAC	ABSLUN		/ GIVES ABSOLUTE (REAL) LUN VALUE
	.ENDC
	LAC	(LUFD1
	DAC	SPYADR
	CAL	SPY		/ GET POINTER TO LUN-UFD TABLE
	LAW	-1
	TAD	SPYCON
	TAD	ABSLUN		/ CALCULATE POINTER TO CORRECT UFD ENTRY
	DAC	SPYADR
	CAL	SPY		/ GET UIC ASSOCIATED WITH LUN 'ILUN'
/
CKOLUN	LAC	(OLUN		/ MAKE SURE WE HAVE FILE-ORIENTED
	DAC	HINF+2		/ SECONDARY DEVICE
	CAL	HINF
	JMS	WTFOR
	AND	(040000		/ SELECT 'DIRECTORY-ORIENTED' BIT
	SZA
	JMP	CKILUN
	CAL	WRNODR		/ 'LUN "OLUN" NOT FILE-ORIENTED'
ABEND	JMS	WTFOR		/ WAIT UNTIL MESSAGE IS FINISHED
	CAL	(10		/ THEN EXIT
/
	.EJECT
CKILUN	LAC	(ILUN
	DAC	HINF+2		/ MUST HINF CORRECT LUN
	CAL	HINF
	JMS	WTFOR
	LAC	EV
	ALSS	11		/ FROM THE INFORMATION RETURNED BY HINF,
	AND	(700000		/ EXTRACT THE PHYSICAL UNIT NUMBER
	DAC	UNIT
	LAC	EV
	AND	(77		/ EXTRACT DEVICE TYPE
	DAC	DKTYPE		/ PUT IT IN 'GET' CPB
	SAD	(2
	JMP	RK		/ RF
	SAD	(3
	JMP	RP		/ RP
	SAD	(24
	JMP	RK		/ RK
/
	CAL	WRNODK		/ 'DEVICE ON LUN "ILUN" IS NOT A DISK'
	JMP	ABEND
/
RP	LAC	(47040		/ START BLOCK OF MFD ON RP DISK
	SKP
RK	LAC	(1777		/ START BLOCK ON RF & RK
GETMFD	JMS	BLK2PL		/ CONVERT BLOCK NUMBERS TO PLATTER, ETC
	LAC	(374		/ AND FETCH IT INTO CORE
	PAL			/ DON'T SEARCH PAST END OF BLOCK
	CLX
MFD1	LAC	BUFFER,X	/ SEARCH MFD FOR DESIRED UFD ENTRY
	SAD	UIC
	JMP	UICFND
	AXS	4		/ INDEX TO NEXT MFD ENTRY
	JMP	MFD1
	LAC	ENDBLK		/ END OF MFD BLOCK - UIC NOT FOUND
	SMA			/ IS THERE ANOTHER MFD BLOCK?
	JMP	GETMFD		/ YES.  FETCH IT AND CONTINUE SEARCH
/
NOUFD	LAW	-33		/ ILLEGAL UIC
	JMS*	.IOERR
/
	.EJECT
UICFND	LAC	BUFFER+1,X	/ POINT TO UFD START BLOCK
	SPA
	JMP	NOUFD		/ NO UFD, ALTHOUGH ENTRY IS IN MFD
	DAC	UFD
	CAL	DELETE		/ DELETE 'NAMES ...' BEFORE WE START
	CAL	WAITFR		/ DON'T BE UPSET IF IT IS ABSENT.
	CAL	ENTER		/ OPEN OUTPUT FILE 'NAMES ...'
	JMS	WTFOR
/
	LAC	UIC		/ BEGIN THE 'NAMES ...' FILE WITH THE UIC
	JMS	THREEC
	XOR	(15*2		/ END WITH CARRIAGE RETURN
	DAC	OLINE+3
	CAL	WRNAME
	JMS	WTFOR
/
	LAC	UFD
/
GETUFD	JMS	BLK2PL		/ FETCH FIRST BLOCK OF UFD
	LAC	(400
	PAL
	CLX
MOVE	LAC	BUFFER,X	/ BECAUSE WE NEED TO USE SUBROUTINE 'BLK2PL'
	DAC	UFD,X		/ LATER, WE MUST EMPTY 'BUFFER'
	AXS	1
	JMP	MOVE
	DZM	XR		/ BEGIN WITH ZERO INDEX REGISTER
	CLX
/
	.EJECT
UFD1	LAC	UFD,X		/ IS THERE A FILE NAME?
	SNA
	JMP	NXTFIL
	LAC	UFD+4,X		/ IS IT SEQUENTIAL OR RANDOM ACCESS?
	SPA
	JMP	NXTFIL		/ RANDOM ACCESS NOT PROCESSED
	LAC	UFD+3,X		/ GET NUMBER OF FIRST BLOCK OF FILE
	SPA
	JMP	NXTFIL		/ TRUNCATED FILES ARE NOT PROCESSED
	JMS	BLK2PL		/ GET FIRST BLOCK
	LAC	BUFFER
	SPA
	JMP	NXTFIL		/ ILLEGAL WORD PAIR COUNT!!
	AND	(777		/ INCLUDE DATA VALIDITY BITS WITH MODE
	SAD	(2
	SKP
	JMP	NXTFIL		/ NOT PURE ASCII
	LAC	XR		/ RESTORE XR LOST DURING 'GET'
	PAX
	LAC	UFD,X		/ GET FIRST 3 CHARACTERS OF FILE NAME
	JMS	THREEC		/ PACK INTO ASCII IN OUTPUT BUFFER
	LAC	UFD+1,X		/ GET CHARACTERS 4-6 OF FILE NAME
	LMQ
	JMS	SIXTO7
	ALSS	10
	XOR	OLINE+3
	DAC	OLINE+3		/ 4TH CHARACTER
	JMS	SIXTO7
	RCL
	XOR	OLINE+3
	DAC	OLINE+3		/ 5TH CHARACTER
	JMS	SIXTO7
	ALSS	13
	DAC	OLINE+4		/ 6TH CHARACTER
/
	.EJECT
	LAC	UFD+2,X		/ GET EXTENSION (CHARACTERS 7-9)
	LMQ
	JMS	SIXTO7
	ALSS	4
	XOR	OLINE+4
	DAC	OLINE+4		/ 7TH CHARACTER
	JMS	SIXTO7
	LRSS	3		/ 8TH CHARACTER STRADDLES 2 WORDS
	XOR	OLINE+4
	DAC	OLINE+4
	ECLA!LLSS 3
	ALSS	17
	DAC	OLINE+5		/ SECOND HALF OF 8TH CHARACTER
	JMS	SIXTO7
	ALSS	10
	XOR	OLINE+5		/ 9TH CHARACTER
	XOR	(15*2		/ CARRIAGE RETURN IS 10TH CHARACTER
	DAC	OLINE+5
	CAL	WRNAME		/ WRITE OUT THE FILE NAME
	JMS	WTFOR
/
NXTFIL	LAC	(370
	PAL
	LAC	XR
	PAX			/ RESTORE XR LOST DURING I/O
	AAC	10
	DAC	XR		/ UPDATE VALUE FOR NEXT TIME
	AXS	10
	JMP	UFD1		/ PROCESS NEXT NAME IN THIS UFD BLOCK
	LAC	UFD+377
	SMA			/ END OF CURRENT UFD BLOCK.  IS THERE ANOTHER?
	JMP	GETUFD		/ YES.  FETCH AND PROCESS IT.
/
	CAL	CLOSE		/ CLOSE SECONDARY OUTPUT FILE
	JMS	WTFOR
	JMP*	GNAMES		/ THEN RETURN TO MAINLINE.
/
	.EJECT
THREEC	XX
	LMQ			/ PREPARE TO PACK 3 CHARACTERS
	JMS	SIXTO7		/ FETCH A CHARACTER CONVERTED TO 7-BITS
	ALSS	13
	DAC	OLINE+2		/ STORE FIRST CHARACTER
	JMS	SIXTO7
	ALSS	4
	XOR	OLINE+2		/ BLEND IN 2ND CHARACTER
	DAC	OLINE+2
	JMS	SIXTO7
	CLQ!LRSS 3		/ 3RD CHARACTER STRADDLES 2 WORDS
	XOR	OLINE+2
	DAC	OLINE+2
	LACQ
	DAC	OLINE+3
	JMP*	THREEC
/
/  SUBROUTINE TO EXTRACT A 6-BIT CHARACTER FROM THE MQ AND
/  CONVERT IT TO A 7-BIT CHARACTER IN THE AC.
/
SIXTO7	XX
	ECLA!LLS 1		/ SHIFT IN HIGH-ORDER BIT OF CHARACTER
	SNA
	XOR	(2		/ CONVERT FROM 6- TO 7-BIT, AS APPROPRIATE
	LLS	5		/ SHIFT IN REST OF CHARACTER
	JMP*	SIXTO7		/ RETURN WITH CHARACTER IN AC
/
/  SUBROUTINE TO CONVERT BLOCK NUMBERS TO PLATTER NUMBERS AND
/  READ THE BLOCK INTO CORE
/
BLK2PL	XX
	LMQ
	ECLA!LLSS 10
	XOR	UNIT		/ MUST INCLUDE PHYSICAL UNIT NUMBER
	DAC	CTRLTB		/ PUT UNIT & PLATTER # IN CONTROL TABLE
	LACQ
	DAC	DKADDR		/ PUT DISK ADDRESS IN CONTROL TABLE
	CAL	GETDK		/ FETCH THE BLOCK
	JMS	WTFOR
	JMP*	BLK2PL
/
WTFOR	XX
	CAL	WAITFR
	LAC	EV
	SMA
	JMP*	WTFOR
	LAC	WTFOR		/ ESTABLISH CORRECT ADDRESS
	DAC*	.IOERR		/ WHEN ANNOUNCING ERROR.
	IDX	.IOERR		/ STEP PAST ENTRY POINT
	LAC	EV
	JMP*	.IOERR		/ ANNOUNCE TERMINAL ERROR
/
	.EJECT
ABSLUN	ILUN		/ CHANGED TO REAL LUN FOR LUN MAPPING
XR;SPY	31;	0;SPYADR;SPYCON;UIC=SPYCON
XFRCMD	37;	EV;	BUFFER; 100
WAITFR	20;	EV
BUFFER	.BLOCK	377;ENDBLK
UFD	.BLOCK	400
HINF	3600;	EV;	XX
GETDK	13000;	EV;	1; CTRLTB;DKTYPE
CTRLTB;DKADDR;	BUFFER;	400
DELETE	3500;	EV;	ILUN; .SIXBT 'NAMES@...'
ENTER	3300;	EV;	OLUN; .SIXBT 'NAMES@...'
WRNAME	2700;	EV;	OLUN; 2; OLINE
CLOSE	3400;	EV;	OLUN
OLINE	3002;	0;	.BLOCK 4
WRNODK	2700;	EV;	TTY; 2; MSG6
WRNODR	2700;	EV;	TTY; 2; MSG3
TENS=OLUN/12
UNITS=TENS*12*777777+OLUN
/
MSG3	M3-.*400+2;EV; .ASCII 'LUN '
	60+TENS*200+60+UNITS*20; 0
	.ASCII	' NOT FILE-ORIENTED'<15> ;M3=.
TENS=ILUN/12
UNITS=TENS*12*777777+ILUN
/
MSG6	M6-.*400+2;UNIT; .ASCII 'DEVICE ON LUN '
	60+TENS*200+60+UNITS*20; 0
	.ASCII	' IS NOT A DISK'<15> ;M6=.
	.END
[\].
NOFPP@PRM
	.TITLE	NOFPP
/
/  11 SEP 78 - PAUL HENDERSON
/
/  PARAMETER FILE FOR ASSEMBLY OF THE 'ARK' PROGRAM MODULES WHEN
/  ASSEMBLING FOR NO FLOATING POINT PROCESSOR.
/
NOFPP=1
	.EOT
[\].
ORDER@007
	.TITLE	ORDER
/
/   8 SEP 78 (007; PDH) CONDITIONALIZE FOR NON-FP15 USE
/  20 OCT 77 (006; PDH) CHANGE TTY TO LUN 13
/  22 AUG 77 (005; PDH) CHANGE TO 150 FILES
/  17 AUG 77 (004; PDH) FIX BIG IN SORTING ALGORITHM (COMPARE)
/  17 AUG 77 (003; PDH) TRY TO PROGRAM AROUND FPP INVALID REMAINDER PROBLEM
/  16 AUG 77 - PAUL HENDERSON
/
/  PROGRAM SEGMENT TO READ THE 'NAMES ...' FILE, RE-ORDER IT IN
/  ALPHABETIC ORDER, AND RE-WRITE IT, PRECEEDED BY THE UIC AND
/  COUNT OF THE NUMBER OF FILES.
/
/  TO ASSEMBLE FOR NON-FLOATING POINT USE, THE SYMBOL		/(007)
/NOFPP=1	MUST BE DEFINED.				/(007)
 
	.IFUND	NOFPP						/(007)
FPP=1;	.ENDC							/(007)
	.DEC
TTY=13
DK=17
NFILES=150			/ NUMBER OF FILES WE CAN PROCESS.
	.OCT
I=400000			/ FPP INDIRECT ADDRESSING
ESB=710500
IRS=711000
IMP=711400
IDV=712000
ILD=713000
ELD=713100
IST=713600
UNSWQ=715270
BZA=716601
BMA=716602
BPA=716604
IDX=ISZ
INC=ISZ
 
	.EJECT
	.GLOBL	ORDER,.IOERR
/
ORDER	XX
	CAL	SEEK		/ OPEN FILE 'NAMES ...' FOR INPUT
	JMS	WTFOR
	CAL	READ		/ READ THE 'UIC' RECORD
	JMS	WTFOR
	LAC	LINE+2
	DAC	UIC		/ SAVE IT FOR LATER OUTPUT
	LAC	LINE+3
	DAC	UIC+1
	DZM	INDEX		/ INITIALIZE FILE COUNTER,
	LAC	(BUF
	DAC	BUFPT		/ BUFFER POINTER,
	LAW	-NFILES
	DAC	COUNT		/ AND BUFFER OVERFLOW COUNTER
/
	.EJECT
RDNAME	CAL	READ		/ READ A FILE NAME RECORD
	JMS	WTFOR
	LAC	LINE
	AND	(7
	SAD	(5
	JMP	SORT		/ SORT THE NAMES WHEN ALL HAVE BEEN READ
/
	LAC	(4		/ EACH FILE NAME IS STORED IN ASCII (4 WDS)
	PAL
	CLX
/
MOVE	LAC	LINE+2,X	/ MOVE THE ASCII LINE FROM THE INPUT BUFFER
	DAC*	BUFPT		/ TO THE SORTING BUFFER
	IDX	BUFPT
	AXS	1
	JMP	MOVE
	INC	INDEX		/ COUNT THE FILE NAME
	ISZ	COUNT		/ MAKE SURE THE BUFFER DOES NOT OVERFLOW
	JMP	RDNAME
/
	.EJECT
SORT	CAL	CLOSE		/ CLOSE INPUT FILE
	JMS	WTFOR
	LAC	INDEX
	SNA
	JMP	NOFILES		/ THERE MUST BE AT LEAST ONE FILE
/
AGN	LAC	INDEX
	TCA
	DAC	COUNT
	DAC	SORTED		/ SET SORTED = .TRUE.
	CLX
	ISZ	COUNT
	SKP
	JMP	DONE		/ A SINGLE ITEM CANNOT BE SORTED
/
LOOP	JMS	COMPARE		/ COMPARE FIRST WORDS OF ASCII FILE NAME
	LAC	BUF+0,X
	LAC	BUF+4,X
/
	JMS	COMPARE		/ COMPARE SECOND WORDS
	LAC	BUF+1,X
	LAC	BUF+5,X
/
	JMS	COMPARE		/ COMPARE THIRD WORDS
	LAC	BUF+2,X
	LAC	BUF+6,X
/
	JMS	COMPARE		/ COMPARE FOURTH WORDS
	LAC	BUF+3,X
	LAC	BUF+7,X
	JMP	NEXT		/ THESE FILE NAMES ARE IN ORDER. CHECK NEXT ONES
/
	.EJECT
/  SUBROUTINE TO COMPARE THE VALUES INDICATED BY THE ARGUMENTS.  IF THE
/  SECOND ARGUMENT IS LOWER IN ALPHABETIC SEQUENCE THAN THE FIRST ONE,
/  THE TWO SETS OF VALUES WILL BE SWAPPED.  IF THE SECOND IS HIGHER,
/  THEN THE NEXT TWO SETS WILL BE COMPARED.  THE SUBROUTINE RETURNS
/  ONLY IF THE TWO VALUES ARE EQUAL.
/
/  CALLING SEQUENCE:
/
/	JMS	COMPARE
/	LAC	FIRST ARG
/	LAC	SECOND ARG	/ (RETURNS HERE IF EQUAL)
/
COMPARE	XX
	XCT*	COMPARE		/ GET FIRST ARGUMENT
	IDX	COMPARE
	.IFDEF	NOFPP						/(007)
	CLL!RAR			/ TO SIMPLIFY THE COMPARISON,	/(007)
	DAC	F1		/ ENSURE THAT BOTH QUANTITIES	/(007)
	CLA!RAL			/ ARE POSITIVE.  SAVE OVERFLOW	/(007)
	.ENDC			/ BIT IN NEXT LOCATION		/(007)
	DAC	F1+1		/ AND STORE IT FOR FPP USE
	XCT*	COMPARE		/ GET SECOND ONE
	.IFDEF	NOFPP						/(007)
	CLL!RAR			/ SAME PROCESS HERE AS ABOVE	/(007)
	DAC	F2						/(007)
	CLA!RAL							/(007)
	.ENDC							/(007)
	DAC	F2+1
	.IFDEF	FPP						/(007)
	ELD;	F1
	ESB;	F2
	BZA;	RETURN
	BPA;	SWAP		/ IF 2ND 'LESS' THAN FIRST, SWAP THEM.
	JMP	NEXT		/ 2ND 'GREATER' THAN FIRST.  OK.
	.ENDC							/(007)
	.EJECT
	.IFDEF	NOFPP						/(007)
	LAC	F2						/(007)
	TCA							/(007)
	TAD	F1		/ 'F1 - F2'			/(007)
	SNA							/(007)
	JMP	CBIT17		/ EQUAL.  CHECK BIT 17		/(007)
	SMA							/(007)
	JMP	SWAP		/ F2 .LT. F1; SWAP THEM		/(007)
	JMP	NEXT		/ F2 .GT. F1; ORDER IS OK	/(007)
 
CBIT17	LAC	F2+1		/ CHECK BIT 17 OF ARGUMENTS	/(007)
	TCA							/(007)
	TAD	F1+1						/(007)
	SPA			/ SAME CHECKS, DIFFERENT ORDER	/(007)
	JMP	NEXT		/ F2 .GT. F1; ORDER IS OK	/(007)
	SZA							/(007)
	JMP	SWAP		/ F2 .LT. F1; SWAP THEM		/(007)
	.ENDC							/(007)
RETURN	JMP*	COMPARE		/ RETURN IF EQUAL
/
F1	0; 0
F2	0; 0
TEMP=COMPARE
/
	.EJECT
SWAP	DZM	SORTED		/ INDICATE BUFFER NOT SORTED
/
	LAC	BUF,X
	DAC	TEMP
	LAC	BUF+4,X		/ THE FILE NAME IN THE NTH BUFFER POSITION
	DAC	BUF,X		/ HAS A HIGHER ALPHABETIC SEQUENCE THAN
	LAC	TEMP		/ THAN THE NAME IN THE (N+1)TH BUFFER
	DAC	BUF+4,X		/ POSITION.  EXCHANGE THEM.
/
	LAC	BUF+1,X		/ THIS IS KNOWN AS A BUBBLE SORT.
	DAC	TEMP
	LAC	BUF+5,X
	DAC	BUF+1,X
	LAC	TEMP
	DAC	BUF+5,X
/
	LAC	BUF+2,X
	DAC	TEMP
	LAC	BUF+6,X
	DAC	BUF+2,X
	LAC	TEMP
	DAC	BUF+6,X
/
	LAC	BUF+3,X
	DAC	TEMP
	LAC	BUF+7,X
	DAC	BUF+3,X
	LAC	TEMP
	DAC	BUF+7,X
/
NEXT	AXR	4
	ISZ	COUNT
	JMP	LOOP
	LAC	SORTED		/ END OF LOOP.  ARE THE NAMES SORTED?
	SNA
	JMP	AGN		/ NO.  DO THE LOOP AGAIN.
/
	.EJECT
/  FILE NAMES HAVE BEEN ARRANGED IN ALPHABETIC ORDER.  CONVERT THE VALUE
/  IN 'INDEX' TO DECIMAL, AND WRITE OUT THE ORDERED FILE NAMES, PRECEEDED
/  BY THE UIC AND FILE NAME COUNT.
/
DONE	CAL	ENTER		/ OPEN OUTPUT FILE
	LAC	UIC
	DAC	LINE+2		/ MOVE SAVED UIC TO OUTPUT LINE BUFFER
	LAC	UIC+1
	DAC	LINE+3
	LAC	(2002		/ HEADER FOR UIC AND FILE COUNT
	DAC	LINE
	JMS	WTFOR
	CAL	WRITE
	JMS	WTFOR
/
	LAW	-4
	DAC	COUNT		/ CONVERT 4 DIGITS TO DECIMAL
	LAC	(20
	DAC	LEAD0		/ SET LEADING ZERO FLAG
	LAC	(DIVISR
	DAC	FPADR1
	LAC	(ANS		/ INITIALIZE ADDRESSES FOR FPP
	DAC	FPADR2
	.IFDEF	FPP						/(007)
	ILD;	INDEX		/ BEGIN WITH THE 'INDEX' VALUE
	IST;	TEMP		/*** SAVE FOR LATER COMPARISON
/
CONVRT	IDV;FPADR1
	IST;FPADR2		/ QUOTIENT IS NEXT CONVERTED DIGIT
/***	UNSWQ;	0		/ REMAINDER IS NEXT DIVIDEND
	IMP;	I+FPADR1	/*** PROGRAM AROUND INVALID REMAINDER
	IRS;	TEMP
	IST;	TEMP		/*** END OF THIS FUDGE
	.ENDC							/(007)
	.EJECT
	.IFDEF	NOFPP						/(007)
	LAC	INDEX		/ MOVE VALUE TO			/(007)
	DAC	TEMP		/ TEMPORARY LOCATION		/(007)
CONVRT	LAC*	FPADR1		/ GET NEXT DIVISOR		/(007)
	DAC	DVISOR						/(007)
	LAC	TEMP		/ DO A DIVISION		/(007)
	CLL							/(007)
	IDIV							/(007)
DVISOR	XX							/(007)
	DAC	TEMP		/ SAVE REMAINDER		/(007)
	LACQ							/(007)
	DAC*	FPADR2		/ STORE ANOTHER ANSWER DIGIT	/(007)
	.ENDC							/(007)
	IDX	FPADR1		/ POINT TO NEXT DIVISOR
	IDX	FPADR2
	ISZ	COUNT
	JMP	CONVRT
/
	.EJECT
	LAC	ANS		/ NOW PACK UP THE CONVERTED ASCII
	JMS	CVRT
	CLQ!LRSS 7
	LAC	ANS+1
	JMS	CVRT
	ALSS	4
	EAE	2000		/ MQ <= AC!MQ
	LAC	ANS+2
	JMS	CVRT
	RCR; RCR; RCR		/ SHIFT OUT NUMERICAL PART
	OMQ
	DAC	LINE+2		/ STORE 2-1/2 CHARACTERS IN LINE BUFFER
	LAC	ANS+2
	CLQ!LRSS 3		/ PLACE NUMERICAL PART IN MQ
	LAC	ANS+3
	XOR	(60		/ LAST DIGIT NEVER LEADING ZERO
	ALSS	10
	OMQ
	XOR	(15*2		/ END WITH CARRIAGE RETURN
	DAC	LINE+3
	CAL	WRITE		/ WRITE OUT FILES COUNT
	JMS	WTFOR
/
	LAC	(3002		/ CORRECT HEADER FOR FILE NAMES
	DAC	LINE
	LAC	INDEX
	TCA
	DAC	COUNT
	LAC	(BUF
	DAC	BUFPT
/
	.EJECT
NEXTL	LAC	(4		/ 4 ASCII WORDS PER FILE NAME
	PAL
	CLX
MOVE2	LAC*	BUFPT		/ MOVE 4 WORDS FROM SORTING BUFFER
	IDX	BUFPT
	DAC	LINE+2,X	/ TO LINE BUFFER
	AXS	1
	JMP	MOVE2
	CAL	WRITE		/ THEN OUTPUT THE FILE NAME
	JMS	WTFOR
	ISZ	COUNT
	JMP	NEXTL
	CAL	CLOSE		/ CLOSE OUTPUT FILE WHEN COMPLETE
	JMS	WTFOR
	JMP*	ORDER
/
/  SUBROUTINE TO CONVERT A BINARY VALUE TO A SINGLE IMAGE ASCII
/  CHARACTER, CONVERTING LEADING ZEROS TO SPACES.
/
CVRT	XX
	SZA
	DZM	LEAD0		/ CLEAR LEADING ZERO FLAG IF NON-ZERO VALUE
	SNA
	XOR	LEAD0		/ THIS WILL CONVERT '0' TO ' '
	XOR	(60		/ CONVERT TO ASCII
	JMP*	CVRT
/
NOFILES	CAL	WRNOFL		/ 'NO FILE NAMES TO PROCESS'
	JMS	WTFOR
	CAL	(10
/
/  SUBROUTINE TO WAIT FOR AN EVENT VARIABLE
/
WTFOR	XX
	LAC	EV
	SNA
	CAL	WAITFR		/ WAIT ONLY IF EV=0
	LAC	EV
	SMA
	JMP*	WTFOR
	LAC	WTFOR		/ ESTABLISH CORRECT ADDRESS
	DAC*	.IOERR		/ WHEN ANNOUNCING ERROR.
	IDX	.IOERR		/ STEP PAST ENTRY POINT
	LAC	EV
	JMP*	.IOERR		/ ANNOUNCE TERMINAL ERROR
/
	.EJECT
/  CAL PARAMETER BLOCKS AND VARIABLES
/
WAITFR	20;	EV
SEEK	3200;	EV;	DK; .SIXBT 'NAMES@...'
READ	2600;	EV;	DK; 2; LINE; 6
CLOSE	3400;	EV;	DK
ENTER	3300;	EV;	DK; .SIXBT 'NAMES@...'
WRITE	2700;	EV;	DK; 2; LINE
WRNOFL	2700;	EV;	TTY; 2; NFLNMS
NFLNMS	NF-.*400+2;EV; .ASCII 'NO FILE NAMES TO PROCESS'<15> ;NF=.
	.EJECT
UIC	.BLOCK	2
LINE	.BLOCK	6
BUF	.BLOCK	NFILES*4
BUFPT;INDEX;COUNT;SORTED;LEAD0
	.IFDEF	NOFPP						/(007)
FPADR1;FPADR2;	.ENDC						/(007)
	.DEC
DIVISR	1000;	100;	10;	1; .OCT
ANS	.BLOCK	4
	.END
[\].
SAVE@@011
	.TITLE	SAVE
/
/  11 SEP 78 (011; PDH) CONDITIONALIZE FOR NON-FP15 USE
/   2 AUG 78 (010; PDH) WAIT 5 SECONDS IF NODE COUNT IS LOW (<8)
/   2 AUG 78 (009; PDH) IT RUNS OUT OF NODES ANYWAY.  FIND OUT WHY.
/   1 AUG 78 (008; PDH) TRY TO PREVENT POOL OF EMPTY NODES FROM EXHAUSTING
/  20 OCT 77 (007; PDH) DON'T DELETE FILES IF 'DT' DEVICE NOT FILE-ORIENTED
/   8 SEP 77 (006; PDH) GENERATE CORRECT 8'S & 9'S IN 'OCTDEC'
/   1 SEP 77 (005; PDH) IGNORE 'FILE ALREADY OPEN' ERRORS
/  22 AUG 77 (004; PDH) DELETE THE SPECIFIED FILES AFTER ARCHIVING
/  22 AUG 77 (003; PDH) CONVERT OCTAL DATE TO DECIMAL; INCLUDE FILE NAME
/			WITH INDIVIDUAL FILES
/  22 AUG 77 (002; PDH) EXORCISE SOME BUGS
/  17 AUG 77 - PAUL HENDERSON
/
/  PROGRAM SEGMENT TO READ THE 'NAMES ...' FILE, PRODUCE THE
/  ARCHIVE FILE ON DECTAPE, THEN DELETE THE FILES FROM DISK.
 
/  TO ASSEMBLE FOR NON-FLOATING POINT USE, THE SYMBOL		/(011)
/NOFPP=1	/ MUST BE DEFINED.				/(011)
 
	.IFUND	NOFPP						/(011)
FPP=1;	.ENDC							/(011)
	.DEC
TTY=13
DKF=15				/ DISK LUN CONTAINING FILES
DKN=17				/ DISK LUN CONTAINING 'NAMES ...' FILE
DT=19				/ DECTAPE LUN RECEIVES ARCHIVE FILE
	.OCT
POOL=240		/ LISTHEAD OF POOL OF EMPTY NODES	/(008)
I=400000
IDX=ISZ
ECLA=641000
IRS=711000
IMP=711400
IDV=712000
ILD=713000
IST=713600
UNSWQ=715270
 
	.EJECT
	.GLOBL	SAVE,.IOERR
 
SAVE	XX
	LAC	(SKP		/ 'SKP' WHEN SAVING FILES
	DAC	SVTEST		/ 'NOP' WHEN DELETING
	LAC	(3200
	DAC	SEEKFL		/ ENSURE 'SEEK' CPB
	CAL	SEEKNM		/ OPEN 'NAMES ...' FILE FOR INPUT
	LAC	(DKN
	DAC	READFL+2	/ READ 'NAMES' FILE VIA 'FILES' CPB
	JMS	WTFOR
	CAL	READFL		/ READ UIC
	JMS	WTFOR
	LAC	FLINE+2
	DAC	NLINE+2		/ MOVE UIC TO PLACE EXPECTED BY 'SEVTO6'
	LAC	FLINE+3
	DAC	NLINE+3
	JMS	SEVTO6		/ CONVERT FROM 5/7 ASCII IN 'NLINE'
	LAC	NAME.1		/ TO 6-BIT IN 'NAME.1'
	DAC	DT.EXT		/ HAVE EXTENSION FOR ARCHIVED FILE
/
	.EJECT
	CAL	DATE
	LAC	DATE+3		/ GET DAY OF MONTH
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL
	LLSS	11		/ SHIFT TO CORRECT PLACE
	DAC	DT.NM1
/
	LAC	DATE+4		/ GET YEAR
	JMS	OCTDEC		/ CONVERT TO .SIXBT DECIMAL
	LRSS	11		/ YEAR NOW LEFT JUSTIFIED IN MQ
/
	LAC	DATE+2		/ GET MONTH
	PAX
	LAC	MONTHS-1,X	/ GET 2-CHARACTER MONTH DESIGNATOR
	LRSS	6		/ INCLUDE 1 CHARACTER WITH OTHERS IN MQ
	XOR	DT.NM1		/ AND OTHER WITH PREVIOUS EFFORT
	DAC	DT.NM1
	LACQ
	DAC	DT.NM2		/ OUTPUT FILE NAME NOW COMPLETELY READY
/
	CAL	ENTER		/ OPEN OUTPUT FILE ON DECTAPE
	JMS	WTFOR
	CAL	WRITE		/ WRITE OUT THE 'UIC' LINE
	JMS	WTFOR
/
	JMS	TRANSF		/ MOVE THE REST OF THE 'NAMES' FILE
	CAL	CLOSEN		/ THEN CLOSE THE 'NAMES' FILE
	JMS	WTFOR
/
	LAC	(DKF		/ NOW POINT CPB AT 'FILES' LUN
	DAC	READFL+2
DLE1	CAL	SEEKNM		/ OPEN 'NAMES' FILE AGAIN
	JMS	WTFOR
	CAL	READNM		/ READ 'UIC' TO BYPASS IT
	JMS	WTFOR
	CAL	READNM		/ BYPASS FILE COUNT
	JMS	WTFOR
/
	.EJECT
TLOOP	CAL	READNM		/ READ NEXT FILE NAME
	JMS	WTFOR
	LAC	NLINE
	AND	(7
	SAD	(5
	JMP	FINISH
	XCT	SVTEST
	SKP
	CAL	WRNAME		/ INCLUDE FILE NAME IN ARCHIVE FILE
	JMS	SEVTO6		/ CONVERT FROM .ASCII TO .SIXBT
 
/  NOW WE MUST ENSURE THAT THE SYSTEM HAS ENOUGH SMALL NODES TO
/  CARRY ON, IN CASE 'DELETE' TENDS TO EXHAUST THE SUPPLY.  WE
/  MAKE THE ASSUMPTION THAT 8 NODES ARE ENOUGH.  THIS ROUTINE
/  REMAINS IN A LOOP UNTIL THERE ARE MORE THAN 8 NODES IN THE POOL.
 
	JMP	LM8		/ REQUEST 'NODCNT' IF		/(008)
 
NONODE	CAL	RQNDCT		/ NOT ENOUGH SMALL NODES	/(009)
WT5SEC	CAL	MK5S		/ THEN DELAY FOR 5 SECONDS	/(010)
	CAL	WAITFR						/(010)
	LAC	EV		/ MUST HAVE GOOD EV BEFORE	/(010)
	SPA			/ WE ATTEMPT TO PROCEED		/(010)
	JMP	WT5SEC						/(010)
 
LM8	LAW	-10		/ MUST BE AT LEAST 8 NODES IN	/(009)
	DAC	COUNT		/ POOL OF EMPTY NODES		/(008)
	LAC	(POOL		/ BEFORE WE PROCEED		/(008)
 
CNTNODE	DAC	SPYADR						/(008)
	CAL	SPY		/ FOLLOW LISTHEADS, COUNTING NODES /(008)
	LAC	SPYCON		/ GET FORWARD POINTER		/(008)
	SAD	(POOL		/ END OF POOL ALREADY?		/(008)
	JMP	NONODE		/ YES.  ATTEMPT TO COMPLAIN	/(008)
	ISZ	COUNT						/(008)
	JMP	CNTNODE						/(008)
 
	CAL	SEEKFL		/ OPEN THE FILE TO BE TRANSFERRED
	JMS	WTFOR		/	(OR DELETE IT)
	XCT	SVTEST
	JMP	TLOOP		/ NO TRANSFER OR CLOSE WHEN DELETING
	JMS	TRANSF		/ MOVE IT
	CAL	CLOSEF		/ CLOSE THE INPUT FILE
	JMS	WTFOR
	JMP	TLOOP		/ PROCESS THE NEXT FILE
 
	.EJECT
FINISH	CAL	CLOSEN		/ CLOSE 'NAMES' FILE
	JMS	WTFOR
	XCT	SVTEST
	JMP	EXIT		/ DELETION OF FILES COMPLETE
	CAL	CLOSDT		/ CLOSE DECTAPE FILE
	JMS	WTFOR
	CAL	WRMSG1		/ ANNOUNCE ARCHIVING COMPLETE
	CAL	HINF
	JMS	WTFOR		/ DON'T DELETE FILES
	AND	(040000		/ IF OUTPUT (DT) DEVICE IS
	SNA
	JMP	NODLET		/ NOT FILE-ORIENTED
/
	DZM	NOT		/ ERASE 'NOT' PART OF
	DZM	NOT+1		/ 'FILES NOT DELETED' MESSAGE
	LAC	(NOP
	DAC	SVTEST		/ CLEAR 'SAVE' TEST
	LAC	(3500		/ CHANGE THE 'SEEK' TO 'DELETE'
	DAC	SEEKFL
	JMP	DLE1		/ THEN DELETE ALL OF THE SPECIFIED FILES
/
NODLET	CAL	WRNODR		/ 'DEVICE ON LUN "DT" IS NOT FILE-ORIENTED'
/
EXIT	CAL	DLENAM		/ DELETE THE 'NAMES ...' FILE
	JMS	WTFOR
	CAL	WRMSG2		/ 'FILES (NOT) DELETED'
	JMS	WTFOR
	JMP*	SAVE		/ THEN RETURN TO CALLING PROGRAM
/
	.EJECT
/  SUBROUTINE TO CONVERT FROM .ASCII IN 'NLINE' TO .SIXBT IN THE
/  CPB USED FOR SEEKING THE FILE TO BE ARCHIVED
/
SEVTO6	XX
	LAC	NLINE+2		/ GET FIRST WORD OF .ASCII
	LMQ
	ECLA!LLSS 10		/ SHIFT IN FIRST CHARACTER + 1 BIT OF 2ND
	RAR			/ THROW 7TH BIT AWAY
	LLSS	7		/ 2ND + 1 BIT OF 3RD
	RAR			/ THROW AWAY THE BIT
	LLSS	3		/ MSB OF 1ST CHAR NOW LOST; 1/2 OF 3RD FETCHED
	DAC	NAME.1
/
	LAC	NLINE+3
	LMQ
	LAC	NAME.1
	LLSS	3		/ OTHER 1/2 OF 3RD
	DAC	NAME.1		/ FIRST 3 CHARACTERS NOW READY
	LLSS	10		/ 4TH CHARACTER
	RAR
	LLSS	6		/ 5TH
	DAC	NAME.2
	LAC	NLINE+4
	LMQ
	ECLA!LLSS 1
	LAC	NAME.2
	LLSS	6		/ 6TH
	DAC	NAME.2
/
	ECLA!LLSS 10		/ 7TH
	RAR
	LLSS	3		/ 1/2 OF 8TH
	DAC	EXT
	LAC	NLINE+5
	LMQ
	LAC	EXT
	LLSS	4		/ 2ND 1/2 OF 8TH
	RAR
	LLSS	6		/ 9TH
	DAC	EXT		/ EXTENSION NOW READY
	JMP*	SEVTO6
/
	.EJECT
/  SUBROUTINE TO CONVERT AN OCTAL (BINARY) NUMBER TO DECIMAL, SELECT THE
/  TWO LEAST SIGNIFICANT DIGITS, AND PLACE THEM IN THE AC & MQ
/  SO THAT SHIFTING LEFT BY 3 PLACES THEM IN THE AC (.SIXBT CODE).
/
/  CALLING SEQUENCE:
/
/	LAC	BINVAL
/	JMS	OCTDEC
/	(RETURN)		/ .SIXBT VALUES IN AC, MQ
/
OCTDEC	XX
	DAC	TRANSF
	LAW	-4
	DAC	WTFOR		/ CONVERT 4 DIGITS
	LAC	(DIVISR
	DAC	FPADR1
	LAC	(ANS
	DAC	FPADR2
	.IFDEF	FPP						/(011)
	ILD;	TRANSF
CONVRT	IDV;FPADR1
	IST;FPADR2		/ QUOTIENT IS NEXT CONVERTED DIGIT
/***	UNSWQ;	0		/ REMAINDER IS NEXT DIVIDEND
	IMP;	I+FPADR1	/*** PROGRAM AROUND HARDWARE FAULT
	IRS;	TRANSF		/***
	IST;	TRANSF		/*** END OF FUDGE
	.ENDC							/(011)
	.IFDEF	NOFPP						/(011)
CONVRT	LAC*	FPADR1						/(011)
	DAC	DVISOR		/ GET NEXT DIVISOR		/(011)
	LAC	TRANSF						/(011)
	CLL							/(011)
	IDIV							/(011)
DVISOR	XX							/(011)
	DAC	TRANSF		/ SAVE REMAINDER		/(011)
	LACQ							/(011)
	DAC*	FPADR2		/ SAVE PRODUCT (ANSWER DIGIT)	/(011)
	.ENDC							/(011)
	IDX	FPADR1		/ POINT TO NEXT DIVISOR
	IDX	FPADR2
	ISZ	WTFOR
	JMP	CONVRT
 
	.EJECT
	LAC	ANS+3		/ GET LEAST SIGNIFICANT ANSWER DIGIT
	XOR	(60		/ CONVERT TO .SIXBT ASCII
	CLQ!LRSS 6		/ SHIFT INTO MQ
	LAC	ANS+2		/ GET OTHER DESIRED DIGIT
	XOR	(60		/ CONVERT IT TO .SIXBT ASCII
	LLSS	3
	JMP*	OCTDEC		/ LEAVE WITH ANSWER IN AC, MQ
 
	.IFDEF	NOFPP						/(011)
FPADR1;FPADR2;	.ENDC						/(011)
	.DEC
DIVISR	1000;	100;	10;	1
ANS	.BLOCK	4;	.OCT
	.EJECT
/  SUBROUTINE TO TRANSFER A FILE FROM 'DKF' TO 'DT'
/
TRANSF	XX
TR1	CAL	READFL		/ READ A RECORD
	JMS	WTFOR
	LAC	FLINE
	AND	(7
	SAD	(5		/ CHECK FOR END OF FILE
	JMP	ENDFILE
	CAL	WRITE		/ WRITE IT TO DECTAPE
	JMS	WTFOR
	JMP	TR1
/
ENDFILE	CAL	WREOF		/ '[\].'
	JMS	WTFOR
	JMP*	TRANSF
/
/  SUBROUTINE TO WAIT FOR EVENT VARIABLE, AND COMPLAIN IF NOT OK.
/
WTFOR	XX
	LAC	EV		/ PERFORM QUICK CHECK
	SNA
	CAL	WAITFR		/ ONLY WAIT WHEN NECESSARY
	LAC	EV
	SPA
	SAD	(-54		/ OPEN FILE IS PROBABLY A BATCH JOB
	JMP*	WTFOR
	SAD	(-6
	JMP*	WTFOR		/ IGNORE UNIMPLEMENTED FUNCTIONS
	LAC	WTFOR		/ ESTABLISH CORRECT ADDRESS
	DAC*	.IOERR		/ WHEN ANNOUNCING ERROR.
	IDX	.IOERR		/ STEP PAST ENTRY POINT
	LAC	EV
	JMP*	.IOERR		/ ANNOUNCE TERMINAL ERROR
/
	.EJECT
/  CAL PARAMETER BLOCKS AND BUFFER SPACE
/
SPY	31;	0;SPYADR;SPYCON					/(008)
RQNDCT	01;	0; .SIXBT 'NODCNT' ; 0				/(008)
MK5S	13;	EV; 5; 2	/ MARK TIME FOR 5 SECONDS	/(010)
WAITFR	20;	EV
DATE	24;	0; .BLOCK 6
HINF	3600;	EV;	DT
SEEKNM	3200;	EV;	DKN; .SIXBT 'NAMES@...'
SEEKFL	3200;	EV;	DKF;NAME.1;NAME.2;EXT
READNM	2600;	EV;	DKN; 2; NLINE; 6
READFL	2600;	EV;	DKF; 2; FLINE; 70
CLOSEN	3400;	EV;	DKN
CLOSEF	3400;	EV;	DKF
CLOSDT	3400;	EV;	DT
ENTER	3300;	EV;	DT;DT.NM1;DT.NM2;DT.EXT
WRNAME	2700;	0;	DT; 2; NLINE
WRITE	2700;	EV;	DT; 2; FLINE
WREOF	2700;	EV;	DT; 2; EOF
WRMSG1	2700;	0;	TTY; 2; MSG1
WRMSG2	2700;	EV;	TTY; 2; MSG2
WRNODR	2700;	0;	TTY; 2; NODIR
DLENAM	3500;	EV;	DKN; .SIXBT 'NAMES@...'
EOF	2002; 0; .ASCII '[\].'<15>
MSG1	M1-.*400+2;EV; .ASCII '*** ARCHIVING FINISHED ***'<15> ;M1=.
MSG2	M2-.*400+2;RQFLAG
	.ASCII	'***   FILES '
NOT	.ASCII	'NOT'		/ THIS IS USUALLY ZEROED BEFORE OUTPUT
	.ASCII	' DELETED   ***'<15> ;M2=.
TENS=DT/12
UNITS=TENS*12*777777+DT
/
NODIR	ND-.*400+2;COUNT					/(008)
	.ASCII	'LUN '
	60+TENS*200+60+UNITS*20; 0
	.ASCII	' NOT FILE-ORIENTED'<15> ;ND=.
SVTEST	NOP
NLINE	.BLOCK	6
FLINE	.BLOCK	70
MONTHS	.SIXBT	'@JA'
	.SIXBT	'@FE'
	.SIXBT	'@MR'
	.SIXBT	'@AP'
	.SIXBT	'@MY'
	.SIXBT	'@JN'
	.SIXBT	'@JL'
	.SIXBT	'@AU'
	.SIXBT	'@SE'
	.SIXBT	'@OC'
	.SIXBT	'@NV'
	.SIXBT	'@DC'
/
	.END
[\].
TF1@@@SRC
C     .TITLE TF1
C
C   1 AUG 78 - PAUL HENDERSON, UNIVERSITY OF WATERLOO
C
C  WATRAN PROGRAM TO CREATE 150 SOURCE FILES TO DEBUG THE 'ARK'
C  TASK WHEN IT IS SUPPOSED TO BE COUNTING SMALL NODES.
C
      INTEGER DK/27/,TT/4/
      INTEGER INDEX/1/
      CHARACTER*9 FNAME
C
   1  WRITE (TT,*) ' *** TDV>ASS 27 RK1<SCR>'
      PAUSE 1
      WRITE (TT,*) ' PROGRAM IS NOW EXECUTING'
C
      DO 3 INDEX=1,150
      WRITE (FNAME,99) INDEX
      CALL OPEN (DK,FNAME)
      DO 2 K=1,40
      WRITE (DK,98)
   2  CONTINUE
      CALL CLOSE (DK)
   3  CONTINUE
      STOP 1
  99  FORMAT ('A000  DAT',T1,I4)
  98  FORMAT (' 1',T80,'XX')
      END
[\].
TF2@@@SRC
C     .TITLE TF2
C
C  12 SEP 78 (002; PDH) CONVERT FROM WATRAN TO DEC FORTRAN
C   1 AUG 78 - PAUL HENDERSON, UNIVERSITY OF WATERLOO
C
C  FORTRAN PROGRAM TO CREATE 150 SOURCE FILES TO DEBUG THE 'ARK'
C  TASK WHEN IT IS SUPPOSED TO BE COUNTING SMALL NODES.
C
      INTEGER DK,TT
      INTEGER INDEX
      INTEGER HUNDS, TENS, ONES
      REAL FNAME(1)
      DATA DK/27/,TT/4/
C
   1  WRITE (TT,299)
      PAUSE 1
      WRITE (TT,298)
C
      DO 3 INDEX=1,150
      HUNDS = INDEX/100
      TENS  = (INDEX - HUNDS*100)/10
      ONES  = INDEX - HUNDS*100 - TENS*10
      ENCODE (5,FNAME,99) HUNDS, TENS, ONES
      CALL ENTER (DK,FNAME(1),'DAT')
      DO 2 K=1,40
      WRITE (DK,98)
   2  CONTINUE
      CALL CLOSE (DK)
   3  CONTINUE
      STOP 1
  99  FORMAT ('A',3I1,' ')
  98  FORMAT (' 1',T80,'XX')
 299  FORMAT (' *** TDV>ASS 27 RK1<SCR>')
 298  FORMAT (' PROGRAM IS NOW EXECUTING')
      END
[\].
UN.PCK002
	.TITLE	UN.PCK
/
/   4 JUL 78 (002; PDH) ADD ENTRIES 'UNP.SV' & 'UNP.RS'
/  23 JUN 78 - PAUL HENDERSON
/
/  ROUTINE TO UNPACK CHARACTERS, ONE AT A TIME.  NO CHECK IS MADE
/  TO DETERMINE IF A LINE TERMINATOR HAS ALREADY BEEN PROCESSED
/  SINCE THE LAST INITIALIZATION CALL.
/
/  CALLING SEQUENCES:
/
/  1) TO INITIALIZE -
/
/	LAC	(ADDRESS OF CHARACTERS TO BE UNPACKED
/	JMS*	UNP.IN
/	(RETURN)
/
/  2) TO UNPACK A CHARACTER -
/
/	JMS*	UN.PCK		/ RETURNS WITH CHARACTER IN AC
/	(RETURN IF LINE TERMINATOR)
/	(NORMAL RETURN)
/
/  3) TO SAVE CURRENT STATUS -
/
/	JMS*	UNP.SV
/	ADDRESS OF 2-WORD SAVE-RESTORE BUFFER
/	(RETURN)
/
/  4) TO RESTORE A PREVIOUS STATUS -
/
/	JMS*	UNP.RS
/	ADDRESS OF 2-WORD SAVE-RESTORE BUFFER
/	(RETURN)
 
IDX=ISZ			/ INDEX A POINTER (NEVER SKIPS)
 
	.EJECT
	.GLOBL	UNP.IN
 
UNP.IN	XX
	DAC	BUFADR		/ SAVE POINTER TO INPUT BUFFER ADDRESS
	LAC	(FIRSTC
	DAC	SWING		/ SET UP BRANCH ADDRESS
	JMP*	UNP.IN
 
BUFADR
 
	.GLOBL	UNP.SV						/(002)
 
UNP.SV	XX							/(002)
	LAC*	UNP.SV		/ FETCH SAVE AREA ADDRESS	/(002)
	IDX	UNP.SV		/ INDEX TO RETURN ADDRESS	/(002)
	DAC	UNP.IN		/ HANDY LOCATION FOR POINTER	/(002)
	LAC	BUFADR						/(002)
	DAC*	UNP.IN		/ SAVE LINE BUFFER ADDRESS	/(002)
	IDX	UNP.IN						/(002)
	LAC	SWING						/(002)
	DAC*	UNP.IN		/ SAVE 'SWING' ADDRESS		/(002)
	JMP*	UNP.SV						/(002)
 
 
	.GLOBL	UNP.RS						/(002)
 
UNP.RS	XX							/(002)
	LAC*	UNP.RS		/ GET SAVE AREA ADDRESS		/(002)
	IDX	UNP.RS						/(002)
	DAC	UNP.IN		/ HANDY LOCATION FOR POINTER	/(002)
	LAC*	UNP.IN						/(002)
	IDX	UNP.IN						/(002)
	DAC	BUFADR		/ RESTORE LINE BUFFER ADDRESS	/(002)
	LAC*	UNP.IN						/(002)
	DAC	SWING						/(002)
	JMP*	UNP.RS						/(002)
 
	.EJECT
	.GLOBL	UN.PCK
 
UN.PCK	XX
	LAC*	BUFADR		/ GET WORD TO BE PROCESSED
	JMP*	SWING		/ GO PROCESS IT
 
SWING	FIRSTC
	AND	(177		/ CHOP TO 7 BIT CHARACTER
	SAD	(15		/ CHECK FOR CARRIAGE RETURN
	SKP
	SAD	(175		/ AND FOR ALT MODE
	JMP*	UN.PCK		/ LINE TERMINATOR EXIT
	IDX	UN.PCK		/ INDEX TO NORMAL EXIT
	JMP*	UN.PCK
 
FIRSTC	LRS	13
	JMS	SWING
 
..2	LRS	4
	JMS	SWING
 
..3	DAC	SWING		/ HANDY PLACE FOR TEMPORARY STORAGE
	IDX	BUFADR		/ INDEX TO 2ND WORD OF PAIR
	LAC*	BUFADR
	LMQ
	LAC	SWING		/ RETRIEVE FRONT OF SPLIT CHARACTER
	LLS	3		/ UNSPLIT IT
	JMS	SWING
 
..4	LRS	10
	JMS	SWING
 
..5	IDX	BUFADR		/ INDEX TO NEXT WORD PAIR
	RAR
	JMS	SWING
	JMP	FIRSTC
	.END
[\].