/UMOUNT PS/8 COMPIL-LEVEL SUBROUTINE

/JOHN R. COVERT
/SCHOOL OF INFORMATION AND COMPUTER SCIENCE
/GEORGIA INSTITUTE OF TECHNOLOGY
/ATLANTA, GEORGIA 30332

/MODIFIED 5/5/73 TO DO ALL INPUT LOOKUPS BEFORE IO...
/ALSO KEEP USR IN CORE (REQUIRES SMALLER BUFFER)

/MODIFIED 5/6/73 TO DO OUTPUT ENTERS AND CLOSES FIRST, IF THE
/COMMAND .FILE RD ... OR .FILE FD... IS USED.
/NOTE: SHOULD SOMETHING TERMINATE THE MOVE
/THE FILES MENTIONED WILL APPEAR TO BE ON THE OUTPUT DEVICE,
/BUT ONLY GARBAGE WILL BE THERE...

	BLKLEN=13	/USE UPPER PART OF FIELD 1
	BUFADR=2000	/ABOVE THE USR
	FILTAB=5000	/PLENTY OF ROOM FOR 3 WORD ENTRIES
	OFLTAB=7000	/CAN HAVE ONLY 240 FILES IN A DIRECTORY

	INPUT=1 	/ADDRESS OF INPUT HANDLER
	OUTPUT=2	/OUTPUT
	QINH=3		/INPUT DEVICE NUM
	QOUTH=4 	/OUTPUT
	STRLXR=5	/WHERE THE FILENAMES BEGIN IN COMMAND LINE

	GNAME=30
	X1=15
	X2=16		/FOR MY OWN USE - FILTAB POINTER
	X3=17		/OFLTAB POINTER
	LXR=14
	NM1=31
	NAME=NM1
	DEVHND=35
	SYSTEM=25
	TEMP1=21
	TMP1=24
	TM1=23
	TEMP2=22
	HANDLA=27	/SPECIFIES CONTROL WORD FOR HANDLER
	SPDATE=70	/IN FIELD 1

/THE FOLLOWING DEFINES ARE TO COMPIL.SV ROUTINES

	CMPR=600
	PRNM=621
	PCH=641
	PRMG=701
	DVNM=716
	LDHN=725


	*2000
START,	JMP I (7605	/RUN IS ILLEGAL
	TAD (7607	/SET UP FOR SYS IN CASE FILE COMMAND
	DCA OUTPUT	/COPY PUTS OUT HAND ADD IN OUTPUT
	TAD NM1 	/NOW TO SEE IF COPY COMMAND
	TAD (-0317	/"CO"
	SNA CLA 	/SKIP IF FILE COMMAND
	JMP COPYC	/IS COPY COMMAND
	JMS I GNAME	/NOW GET "F","FD","R",OR "RD"
	JMP I (7605
	TAD NM1
	DCA START	/STORE IT
COMMON, TAD (FILTAB-1	/SET UP TABLE FOR FILE INFO ENTRIES
	DCA X2		/INPUT ST ADR, LENG, DATE

	TAD (4001	/ALLOW A TWO PAGE HANDLER AT LOC 4000
	DCA HANDLA
	/
	JMS I (LDHN	/GET A HANDLER
	JMP I (7605
	DCA TEMP1
	TAD LXR 	/GET LOCATION WHERE FILE NAMES BEGIN
	DCA STRLXR	/AND SAVE IT SO WE CAN USE IT LATER
	JMS NOTRCK	/CHECK FOR DUMP TO SYS OR LOAD FROM SYS
	TAD START	/LOOK AT COMMAND TYPE
	AND (77 	/SECOND CHAR
	SNA		/IF WE DONT HAVE SPECIAL MODE
	JMP CACMPR	/THEN GO ON, OTHERWISE, 2ND CHAR
	TAD (-4 	/MUST BE A "D"
	SZA CLA
	JMP MILLFN	/WAS NOT, DIE...
	DCA I (HLDOFF	/IF HLDOFF IS ZERO, WE DO ALL ENTERS FIRST
	TAD (OFLTAB-1	/OUTPUT FILE TABLE MUST BE INITIALIZED
	DCA X3
CACMPR, TAD START
	AND (7700
	JMS I (CMPR
	-2200;	RLOAD
	-0600;	FRMDSK
	-2000;	COPY
	0
MILLFN, ISZ START+1	/SKIP IF COPY COMMAND
	SKP
	JMP CACMPR	/ALLOW A "Y" - COPY CHECKS STUFF
	TAD START	/GET READY TO TELL HIM
	DCA NM1 	/THAT HIS FUNTION WAS ILLEGAL
	DCA NM1+1
	JMS I (ERROR
	  ILLFUN
	JMP I (7605
NOTRCK, 0		/CHECK TO SEE WE GO FROM ONE DEV TO ANOTHER
	TAD DEVHND
	CIA
	TAD OUTPUT
	SZA CLA
	JMP I NOTRCK	/NOT SAME DEV!
	JMS I (ERROR
	  ILLDEV
	JMP I (7605

RLOAD,	TAD (7607	/FILE R - RECALL
	DCA OUTPUT
	CLA CLL IAC
	DCA QOUTH
COPY,	TAD DEVHND
	DCA INPUT
	TAD TEMP1
	DCA QINH
	JMP I (NEXFIN	/GO GET THE INPUT FILES

FRMDSK, TAD DEVHND	/FILE F - FROM SYS TO SOMEWHERE ELSE
	DCA OUTPUT
	TAD (7607
	DCA INPUT
	TAD TEMP1
	DCA QOUTH
	IAC
	DCA QINH
	JMP I (NEXFIN	/GET INPUT FILES

/SET UP FOR COPY BY FOOLING OUTPUT
/THE COMMAND SYNTAX IS:
/		.COPY ODEV:=IDEV:NAME1,NAM2,,,,...
/		.COPD ODEV:=IDEV:NM1,....	/FOR FAST COPY

COPYC,	STA
	DCA START+1	/SIGNAL COPY
	TAD NM1+1	/THIS IS TO PICK UP FAST COPY
	DCA START	/"COPD" FLAGGED BY THE "D"
	TAD (4401	/PUT ODEV HANDLER HERE
	DCA HANDLA	/FOR LDHN ROUTINE
	JMS I (LDHN	/LOAD IT
	JMP I (7605	/NONE SPECIFIED - WE REQUIRE IT
	DCA QOUTH	/STASH NUMBER
	TAD DEVHND	/PICK UP ENTRY POINT
	DCA OUTPUT	/STICK IN APPROPRIATE PLACE
	STA		/NOW BACK UP LXR FOR "="
	TAD LXR
	DCA LXR 	/IS RESET TO TERMINATOR
	TAD I LXR	/PICK UP CHAR
	JMS I (CMPR	/THIS IS SO ":" ALLOWED
	  -240;.-3	/IGNORE SPECES
	  -":; .+3	/":" NOT REQUIRED BUT O.K.
	   0
	STA		/COME HERE IF NOT ":", NOT SPACE
	TAD LXR 	/MIGHT HAVE BEEN "=", ETC.
	DCA LXR 	/SO RESET LXR
	TAD I LXR
	JMS I (CMPR	/ALLOW ALL KINDS OF SEPARATORS
	  -"=;COMMON
	  -" ;COMMON
	  -"<;COMMON
	   0
	JMP BADCHAR



	PAGE
NEXFIN, JMS I GNAME	/GET NEXT FILE NAME TO LOOKUP
	JMP SETFOT	/NO MORE, GO TO DO THE WORK
SETUP4, TAD (NAME	/TELL LOOKUP THE NAME
	DCA NAMEIN
	TAD QINH	/DEVICE NUMBER OF INPUT HANDLER
	CIF 10
	JMS I SYSTEM
	2		/LOOKUP
NAMEIN, 0
INLENG, 0
	JMP I (ERB3	/FILE NOT FOUND
	TAD NAMEIN	/THIS IS STARTING BLOCK NUMBER
	DCA I X2	/PUT IN FILTAB
	TAD INLENG	/GET LENGTH IN BLOCKS
	DCA I X2
	CDF 10
	TAD I (17		/GET CREA DATE
	TAD I (1404
	DCA TM1
	TAD I TM1
	CDF 0
	DCA I X2		/STORE IN FILTAB
	TAD HLDOFF	/CHECK TO SEE IF WE ARE DOING ENTERS NOW
	SZA CLA
	JMP NEXFIN	/NO, GO FIND OUT ABOUT NEXT FILE
	TAD (NAME
	DCA NAMEOU	/SET LOCATION SO WE CAN DO ENTER WITH NAME
	CDF 10
	TAD I TM1	/GET THE DATE FOR ENTER
	JMS TRUENT	/ENTER
	TAD NAMEOU	/GET OUTPUT STARTING BLOCK
	DCA I X3	/PUT IN TABLE
	TAD INLENG	/GET LENGTH FOR OUTPUT
	CIA
	DCA I (CLENGT	/STORE
	JMS I (TRUCLO	/CLOSE
	JMP NEXFIN	/GO GET NEXT

SETFOT, TAD (FILTAB-1	/SET UP TO DO THE WORK
	DCA X2		/SET FILTAB POINTER
	TAD (OFLTAB-1	/OFLTAB POINTER
	DCA X3
	TAD STRLXR	/SET COMMAND LINE POINTER
	DCA LXR

NXTFOT, JMS I GNAME	/GET NAME OF NEXT INPUT FILE
	JMP I (7605	/NO MORE - WE ARE DONE
	TAD I X2	/START BLOCK
	SNA		/IF ZERO, THEN LOOKUP HAD FAILED
	JMP NXTFOT	/SO GO HANDLE NEXT FILE
	DCA NAMEIN	/THIS IS AS GOOD AS ANYPLACE
	TAD I X2	/GET LENGTH, AND STORE IT BACK AS
	DCA INLENG	/MIGHT AS WELL
	TAD HLDOFF	/CHECK TO SEE IF ENTERS ALREADY DONE
	SZA CLA
	JMP HOF1	/HAS NOT BEEN DONE, HANDLE IT
	ISZ X2		/HAS BEEN, SET UP AS THOUGH WE WERE DOING IT
	TAD I X3	/GET OUTPUT BLOCK NUMBER
	DCA NAMEOU	/PUT IT WHERE IT BELONGS
	JMP I (MOVFIL	/AND MOV THE FILE
HOF1,	TAD (NAME	/ADDRESS OF NAME
	DCA NAMEOU	/FOR ENTER ROUTINE
	TAD I X2	/WE ARE GOING TO DO IT
	JMS TRUENT	/MAKE ENTRY
	JMP I (MOVFIL	/AND MOVE IT
TRUENT, 0		/ENTER SUBROUTINE, MUST HAVE DATE IN AC
	CDF 10
	DCA I (SPDATE	/STORE IT FOR ENTER
	CDF 0
	TAD INLENG	/SEE IF WE CAN SPECIFY THE LENGTH!
	CIA
	AND (7400	/MUST BE LESS THAN 256 OCTAL
	SZA CLA
	JMP GEQ256	/WAS TOO BIG
	TAD INLENG
	CLL CIA;RTL;RTL /MOVE TO LEFT
GEQ256, TAD QOUTH
	CIF 10
	JMS I SYSTEM
	3		/ENTER OUTPUT FILE
NAMEOU, 0
FLEN,	0
	JMP ERA3	/ERROR
	CLA STL
	TAD INLENG
	CIA
	TAD FLEN
	SZA SNL CLA	/THIS TEST IS ONLY FOR FILES GEQ 256 BLOCKS
	JMP ERB1	/ALL OTHERS WILL PASS
	JMP I TRUENT	/RETURN
/
HLDOFF, 1		/IF 1, WE WAIT AND DO ENTERS LATER
/
	PAGE
MOVFIL, CLA
	DCA CLENGT
LOOP,	TAD I (NAMEIN
	TAD CLENGT
	DCA IBLOK
	TAD I (NAMEOU
	TAD CLENGT
	DCA OBLOK
	STL
	TAD INLENG
	TAD (BLKLEN
	SNL		/SKIP IF LENGTH LEFT > BLKLEN
	JMP LASTIO	/OTHERWISE DO LASTIO
	DCA INLENG
	TAD FLEN
	TAD (BLKLEN
	DCA FLEN
	JMS I INPUT	/READ
	BLKLEN 200+10	/FIELD 1
	BUFADR
IBLOK,	0
	JMP ERB2	/READ ERR
	JMS I OUTPUT	/WRITE
	BLKLEN 200+4010
	BUFADR
OBLOK,	0
	JMP ERA4	/WRITE ERROR
	TAD CLENGT
	TAD (BLKLEN
	DCA CLENGT
	JMP LOOP
LSLEN,	0
LASTIO, CLA CLL
	TAD INLENG
	SNA		/WERE WE ALREADY DONE?
	JMP CLOSE	/YES
	CIA STL 	/NOTE: CONVENIENT PLACE TO SET LINK!
	DCA LSLEN	/NUMBER OF BLOCKS LEFT TO READ
	TAD LSLEN
	CLL RTR;RTR;RTR
	TAD (10 	/FIELD 1
	DCA LSILEN
	TAD LSILEN
	TAD (4000
	DCA LSOLEN
	TAD IBLOK
	DCA LSIBLK
	TAD OBLOK
	DCA LSOBLK
	JMS I INPUT	/READ
LSILEN, 0
	BUFADR
LSIBLK, 0
	JMP ERB2	/ERR READING
	JMS I OUTPUT
LSOLEN, 0
	BUFADR
LSOBLK, 0
	JMP ERA4	/WRITE ERR
	CLA
	TAD CLENGT
	TAD LSLEN
	DCA CLENGT
CLOSE,	TAD I (HLDOFF
	SZA CLA 	/DID WE NAIT
	JMS TRUCLO	/YES, SO CLOSE NOW
	JMP I (NXTFOT	/DONE, GET NEXT FILE

TRUCLO, 0		/CLOSE SUBROUTINE
	CIF 10		/DONE
	TAD QOUTH	/GET OUT PUT DEVICE CODE
	JMS I SYSTEM
	4		/CLOSE OUTPUT FILE
	NAME		/POINTER
CLENGT, 0	/CORRECT LENGTH
	JMP ERA6	/ERROR WHILE CLOSING, SHOULD NEVER HAPPEN
	CLA CLL
	JMP I TRUCLO	/RETURN

/
	PAGE

ERROR,	0		/SET UP TO CALL COMPILE'S ERROR
	TAD (215	/PRINTING ROUTINE
	JMS I (PCH
	TAD (212
	JMS I (PCH
	TAD I ERROR
	DCA .+3
	ISZ ERROR
	JMS I (PRMG
	0
	JMS I (PRNM
	JMP I ERROR
BADCHAR,JMS I (ERROR
	  BADCHR
	JMP I (7605

ERA3,	JMS ERROR
	  ZENTER
	JMP ENERRX	/FINISH UP THE TWO ENTER ERRORS
ERA4,	JMS ERROR
	  ZWRER
	JMP I (7605
ERA6,	JMS ERROR
	  ZCLOSE
	JMP I (7605
ERB1,	JMS ERROR
	  ZNOROM
ENERRX, TAD I (HLDOFF	/CHECK TO SEE WHO CALLED US
	SZA CLA
	JMP I (NXTFOT	/WAS HELD OFF, FOT CALLED US
	CLA CLL CMA RTL /CALLED FROM FIN, NEED TO BACK UP
	TAD X2		/AND ZERO OUT INPUT, SO WE SKIP
	DCA X2		/THIS FILE NEXT TIME AROUND
	DCA I X2	/ZERO THE ENTRY
	JMP I (NEXFIN	/AND GO TO NEXT FILE
ERB2,	JMS ERROR
	  ZREAD
	JMP I (NXTFOT
ERB3,	JMS ERROR
	  ZNOFIL
	DCA I X2	/SET A ZERO FOR THE WORKING ROUTINE
	JMP I (NEXFIN

ZENTER, TEXT /%ERROR ENTERING /
ZWRER,	TEXT /?WRITE ERROR /
ZCLOSE, TEXT /?CLOSE ERROR /
ZNOROM, TEXT /%NO ROOM FOR FILE /
ZREAD,	TEXT /%ERROR READING /
ZNOFIL, TEXT /%NO FILE /
ILLFUN, TEXT /?ILLEGAL FUNC /
ILLDEV, TEXT /?ILLEGAL DEVICE /
BADCHR, TEXT /?ILLEGAL SYNTAX/
	$