Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50171/cusper.mac
There are no other files named cusper.mac in the archive.
TITLE	CUSPER ('CUSP-NAME', 'CMD-FILE', 'DEV', PROJ, PROG)
	XALL
;	CUSPER LOADS THE CUSP 'CUSP-NAME' FROM DEVICE SYS
;	DESTROYING CURRENT PROGRAM AND BEGINS EXECUTION.
;
;	'CUSP-NAME' IS ASCII NAME, MAX OF 5 LETTERS, NO EXTENT.
;	IF THE CUSP IS NOT FOUND ON DEVICE SYS, AN ATTEMPT IS MADE
;	TO RUN A CORE IMAGE FILE WITH THIS NAME FROM THE USERS DSK AREA.
;
;	OPTIONAL ARGUMENTS:
;	'CMD-FILE':  IF THIS ARGUMENT IS PRESENT AND 'DEV' IS
;	NOT 'PRG', THE FILE WITH ASCII NAME SPECIFIED BY THIS
;	ARGUMENT AND AN EXTENT OF 'DAT' IS COPIED AND RENAMED
;	NNNXXX.TMP WHERE NNN IS THE USER'S JOB NUMBER AND
;	XXX IS EITHER THE FIRST THREE LETTERS OF THE CUSP NAME 
;	OR A NAME TAKEN FROM THE EXCEPTION TABLE BELOW.
;	IF DEV = 'PRG', THEN THIS ARGUMENT IS TAKEN AS A LITERAL
;	WHICH IS TO CONSTITUTE THE COMMAND FILE.  IN THIS CASE,
;	THE FIRST CHARACTER OF THE STRING IS TAKEN AS THE DELIMITER.
;	THE SECOND OCCURRENCE OF THE DELIMITER CHARACTER TERMINATES
;	THE STRING.  THE DELIMITERS THEMSELVES ARE NOT CoPIED INTO THE
;	COMMAND FILE.  THE CUSP BEING RUN IS STARTED WITH AN
;	OFFSET OF 1, SUGGESTING THAT IT TAKE ITS COMMANDS FROM THE
;	COMMAND FILE.  NOTE:  FORTRAN CUSPS CANNOT ACCEPT COMMAND
;	FILES.
;	IF THIS ARGUMENT IS NOT PRESENT, THE CUSP TAKES ITS COMMAND
;	FROM THE TTY.
;	WHEN THE COMMAND FILE IS COPIED ALL FORM FEED CHARACTERS ARE
;	DELETED.  IF THE COMMAND FILE IS FOR CCL, A "CR" IS TAKEN TO
;	MEAN END OF FILE.  THE "CR" IS DELETED AND REPLACED WITH A
;	"DELETE" CHARACTER.
;
;	DEV:  IF THIS ARGUMENT IS PRESENT, IT SPECIFIES THE ASCII
;	NAME OF THE DEVICE ON WHICH FILE 'CMD-FILE' IS TO BE  FOUND.
;	LOGICAL NAMES MAY BE USED HERE.  IF THIS ARGUMENT IS NOT
;	PRESENT, THE DEVICE IS ASSUMED TO BE DSK.  IF THE DEVICE
;	IS 'PRG', THE FILE IS TAKEN FROM CORE AS DESCRIBED ABOVE.
;	DESCRIBED ABOVE.
;
;	PROJ,PROG:  IF PRESENT, THESE ARGUMENTS SPECIFY THE
;	DIRECTORY ON THE DEVICE CONTAINING FILE CMD-FILE.
;	OTHERWISE CURRENT USER'S DIRECTORY IS SEARCHED.
;
;	IF AN OPTIONAL ARGUMENT IS PRESENT, ALL PRECEDING OPTIONAL
;	ARGUMENTS MUST BE PRESENT.
;
;	IF 'CUSP-NAME' IS 'CCL', THE REQUEST WILL BE INTERPRETED
;	AS A CONCISE COMMAND LANGUAGE REQUEST.  IN THIS CASE
;	THE CCL COMMAND DECODER, COMPIL, IS LOADED AND THE COMMAND
;	FILE IS RENAMED NNNSVC.TMP TO FIT THE CCL CONVENTION.
;
;	ASSEMBLY INSTRUCTIONS:
;		IF SYSTEM IN USE DOES NOT HAVE TMPCOR UUO DEFINED,
;		SET TEMPC =0, OTHERWISE NO CHANGES ARE NECESSARY.
;
;	KIM PECK - BROOKINGS - 2/70 REVISED 5/70
;
;
;	ENTRY TO PROGRAM BY
;	JSA	16,CUSPER
;	JUMP	ARG1
;	...
;	JUMP	ARGN
;
	IFNDEF TEMPC <TEMPC==1	;ASSUME TMPCOR UUO AVAILABLE>
	INTERN	CUSPER
	ENTRY	CUSPER
	PAGE
;
	AC=16
	AC1=1
	AC2=2
	AC3=3
	AC4=4
	CCL=6
	TEMCAL=7
	ADREG=12
	STRING=13
	PRG=17
;
	CR==15			;CARRIAGE RETURN
	LF==12			;LINE FEED
	FF==14			;FORM FEED
	DELET==177		;RUBOUT
;	EXCEPTION TABLE- THESE CUSPS DON'T FOLLOW THE PRESCRIBED
;	RULES FOR NAMING THEIR TMP FILES - SPECIAL FIX IS APPLIED.
CUSPTA:	SIXBIT	"F40   "	;FORTRAN COMPILER
	SIXBIT	"LINED "	;LINED AND TECO USE SAME EXCEPTION
	SIXBIT	"TECO  "
	SIXBIT	"CCL   "	;COMPIL IS THE WORST OF ALL!
CFILE:	SIXBIT	"   FOR"	;FORTRAN'S CMD FILE
	SIXBIT	"   EDT"	;FOR TECO
	SIXBIT	"   EDT"	;ISN'T THIS SILLY?
	SIXBIT	"   SVC"
	EXCEPT==CFILE-CUSPTA	;LENGTH OF EXCEPTION TABLE
;
	PAGE
CUSPER:	0
;CLOSE AND RELEASE ALL POSSIBLE FORTRAN CHANNELS TO AVOID
;POSSIBLE UNFINISHED USER BUSINESS.
	RELEASE	1,
	RELEASE	2,
	RELEASE	3,
	RELEASE	4,
	RELEASE	5,
	RELEASE	6,
	RELEASE	7,
	RELEASE	10,
	RELEASE	11,
	RELEASE	12,
	RELEASE	13,
	RELEASE	14,
	RELEASE	15,
	RELEASE	16,
	RELEASE	17,
	SETZB	CCL,PRG		;SET FLAG TO NO CCL, NO PRG
;
	DEFINE CONV76	(ACS,DEST,%SHIFT); CNVRT 5 ASCII CHAR TO SIXBIT
			;ACS IS SOURCE LOCATION
			;DEST IS WHERE RESULT TO GO
<	MOVEI	ACS+1,^D5	;SET UP CHARACTER COUNT
	SETZM	DEST		;CLEAR DESTINATION WORD
%SHIFT:	LSHC	ACS-1,7		;MOVE IN NEXT CHARACTER
	ADDI	ACS-1,40	;MAKE INTO SIXBIT (ASSUMING UPPER CASE)
	IDPB	ACS-1,[POINT  6,DEST,-1]	;STORE CHAR
	SOJG	ACS+1,%SHIFT  	; ARE WE DONE?
	;YES>
;
	PAGE
;	GET CUSP-NAME AND CONVERT TO SIXBIT
	MOVE	AC2,@(AC)	;CUSP-NAME
	CONV76	AC2,CUSPNA	;CONVERT TO SIXBIT
	AOJ	AC,		;INCREMENT ARG LIST POINTER
	LDB	AC1,JUMP	;GET OP CODE IN STACK
	CAIE	AC1,320		;IS IT A JUMP?
	JRST	INCR		;NO - GO RUN
	MOVE	AC2,@(AC)	;YES - GET THE ARG
	CONV76	AC2,CMD		;CONVERT TO SIXBIT
	AOS	RUNSTO		;INCREMENT RUN START ADDR
FINDEV:	AOJ	AC,		;IS THER A DEVICE SPECIFIED
	LDB	AC1,JUMP	;GET OP CODE
	CAIE	AC1,320		;JUMP?
	JRST	COPY		;NO - WE CAN COPY
	MOVE	AC2,@(AC)	;YES - FIND THE DEV
	CAME	AC2,[ASCII "PRG  "]	;IS IT PRG PSEUDO-DEV?
	JRST	ORDFIL		;NO
	SETO	PRG,		;YES
	HRRZ	STRING, -1(AC)	;SAVE LITERAL ADDRESS FOR INPUT BYTE PTR
	JRST	ISPPN
ORDFIL:	CONV76	AC2,DEV		;CONVERT TO SIXBIT
ISPPN:	AOJ	AC,		;IS THERE A PPN
	LDB	AC1,JUMP
	CAIE	AC1,320
	JRST	COPY		;NO - GO COPY
	HRLZ	AC2,@(AC)	;YES - GET PROJ#
	AOJ	AC,		;AND PROG #
	HRR	AC2,@(AC)
	MOVEM	AC2,PPN		;STORE PPN IN LOOKUP
;
	PAGE
;NOW COPY COMMAND FILE AND RENAME NNNXXX.TMP
COPY:	CALLI	AC2,30		;PJOB - GET JOB NUMBER
	MOVEI	AC,3		;INITIALIZE DIGIT COUNTER
LOPE:	IDIVI	AC2,12		;GET RIGHT END DIGIT TO AC3
	ADDI	AC2+1,"0"-40	;MAKE INTO SIXBIT
	LSHC	AC2+1,-6
	SOJG	AC,LOPE		;GET THREE DIGITS
	MOVEI	AC,EXCEPT-1	;SET UP LENGTH OF TABLE FOR EXCEPTIONS
	MOVE	AC3,CUSPNA	;GET CUSP NAME FOR EXCEPTION CKING
LUKUP:	CAMN	AC3,CUSPTA(AC)	;IS THIS NAME IN TABLE?
	JRST	ONWARD		;YES- CHANGE TMP FILE NAME
	SOJGE	AC,LUKUP	;NO - IS TABLE EXHAUSTED?
	HLRZ	AC2,AC3		;THEN USE ORIGINAL NAME
	JRST	TMPZAP		;YES - BUILD CMD FILE NAME
ONWARD:	HRRZ	AC2,CFILE(AC)	;REPLACEMENT NAME
	CAMN	AC3,[SIXBIT "CCL   "]	;IS IT CCL PSEUDO-CUSP?
	SETO	CCL,		;YES - SET FLAG
TMPZAP:
IFN TEMPC <HRLM	AC2,TBLOCK	;FILL IN TMP FILE NAME
	MOVE	TEMCAL,[XWD 2,TBLOCK]
	CALLI	TEMCAL,44	;READ AND DELETE OLD IN CORE FILE
	JFCL			;ERROR - IGNORE
>
	HLLM	AC2+2,AC2	;ADD JOB NUMBER
	MOVEM	AC2,OUTFIL	;STORE IN ENTER SEQUENCE
	INIT	2,0		;OUTPUT MODE=ASCII
	SIXBIT	/DSK/		;OUTPUT FILE ON DSK
	XWD	OBUF,0		;OUTPUT FILE ONLY
	JRST	EROU		;ERROR - SHOULD NEVER OCCUR
	ENTER	2,OUTFIL	;SELECT OUTPUT FILE
	JRST	OUTER		;ERROR
	JUMPE	PRG,DEV-1	;DO NOT INIT INPUT IF IN CORE FILE
	MOVEI	ADREG,CORE	;SET UP FOR IN-CORE READ
	MOVEI	AC,^D5000	;ALLOW 5000 CHAR CMD FILE
	HRLI	STRING,440700	;COMPLETE INPUT BYTE POINTER
	ILDB	AC4,STRING	;FIRST CHAR IS THE DELIMITER
CORE:	ILDB	AC3,STRING	;GET A BYTE FROM IN-CORE
	CAMN	AC3,AC4		;IS THIS THE DELIMITER?
	JRST	INEOF+1		;DONE
TSTF:	SOJG	AC,PUTOUT	;STASH CHAR FOR OUTPUT UNLESS TOO BIG
	TTCALL	3,MES8		;CMD-FILE TOO LONG-PROBABLY FORGOT
	JRST	QUIT		;			DELIMITER
	INIT	1,0		;INPUT MODE IS ASCII
DEV:	SIXBIT	/DSK/		;ASSUME CMD-FILE ON DSK UNLESS CHANGED
	XWD	0,IBUF		;INPUT FILE
	JRST	ERIN		;FOR ERROR
	LOOKUP	1,CMD		;SELECT INPUT FILE
	JRST	NOFILE		;ERROR
;	COPYING ROUTINE
;	GET A CHARACTER
	MOVEI	ADREG,COPYFI	;INITIALIZED OUTPUT RETURN
COPYFI:	SOSG	IBUF+2		;DECREMENT BYTE COUNT
	JRST	GETBUF		;EMPTY BUFFER OR FIRST CALL
GETCH:	ILDB	AC3,IBUF+1	;GET NEXT CHAR
	JUMPE	AC3,COPYFI	;IGNORE NULL CHARACTERS
	CAIN	AC3,FF		;IS IT FF CHAR?
	JRST	COPYFI		;YES -DELETE IT
	JUMPE	CCL,PUTOUT	;IS IT CCL REQUEST?
	CAIE	AC3,CR		;IS IT CR?
	JRST	PUTOUT		;NO - PUT OUT CHAR
	JRST	INEOF		;YES - CCL END OF FILE
GETBUF:	IN	1,		;GET BUFFER REFILL
	JRST	GETCH		;GO GET CHAR ON SUCCESSFUL FILL
	STATZ	1,740000	;ERROR OR EOF, WHICH?
	JRST	INPERR		;ERROR
	JRST	INEOF		;END OF FILE
;
;	PUT OUT A CHAR
PUTOUT:	SOSG	OBUF+2		;INCREMENT BYTE COUNT
	JRST	PUTBUF		;BUFFER FULL OR FIRST CALL
PUTNXT:	IDPB	AC3,OBUF+1	;MOVE CHAR TO OUTPUT BUF
	JRST	(ADREG)		;GO GET ANOTHER FROM SOMEWHERE
PUTBUF:	OUT	2,		;EMPTY THE BUFFER
	JRST	PUTNXT		;NORMAL RETURN
	JRST	OUTERR		;OUTPUT ERROR
	;	END OF FILE PROCESSING
INEOF:	CLOSE	1,		;CLOSE INPUT FILE
	JUMPE	CCL,OUTCLS	;IF NOT CCL NO DELETE CHAR
	MOVEI	ADREG,OUTCLS	;ALTER OUTPUT RTNE RETURN
TAIL:	MOVEI	AC3,DELET	;TERMINATE FILE WITH RUBOUT
	JRST	PUTOUT		;GO OUTPUT A CHAR
OUTCLS:	CLOSE	2,		;CLOSE OUTPUT FILE
	RELEASE	1,		;GET RID OF DEVICES
	RELEASE 2,
	PAGE
	;SET UP THE RUN UUO
INCR:	JUMPE	CCL,RUNRUN	;IS THIS CCL REQUEST
	MOVE	AC,[SIXBIT /COMPIL/]	;YES -GET RID OF PSEUDO-NAME
	MOVEM	AC,CUSPNA
RUNRUN:	SETZM	RUNFL#		;INITIALIZE NO ERROR FLAG
	CALLI	2,10		;WAIT FOR I/O TO BE DONE
	CALLI	0,		;RESET EVERYTHING
RUNSTO:	MOVSI	AC,0
	HRRI	AC,ARGBLK	;LOCATION OF ARGUMENT BLOCK
	CALLI	AC,35		;RUN UUO
	SKIPE	RUNFL		;RUN FAILED - QUIT IF SECOND ERROR
	JRST	ERRORR		;IS SECOND ERROR
	HRLZI	AC2,(SIXBIT/DSK/)	;TRY TO RUN FROM USERS AREA
	MOVEM	AC2,ARGBLK	;MAKE DEVICE USERS DISK
	SETOM	RUNFL		;SET SECOND TRY
	JRST	RUNRUN+1	;MAKE SECOND ATTEMPT
;
	PAGE
;	ERROR MESSAGES
OUTERR:OUTER:ERIN:EROU:	TTCALL	3,MES1	;ERROR IN CMD-FILE COPY
QUIT:	CALLI	0,12		;END JOB - QUIT
MES1:	ASCIZ	"
ERROR IN COPYING CMD-FILE"
NOFILE:	TTCALL	3,MES3		;CMD-FILE DOES NOT EXIST
	JRST	QUIT
MES3:	ASCIZ	"
COMMAND FILE NOT FOUND"
INPERR:	TTCALL	3,MES5
	JRST	QUIT
MES5:	ASCIZ	"
COMMAND FILE UNREADABLE"
ERRORR:	TTCALL	3,MES7		;RUN UUO FAILED
	JRST	QUIT
MES7:	ASCIZ	"
CUSP NOT FOUND"
MES8:	ASCIZ	"
COMMAND FILE FROM PRG TOO LONG"
CMD:	SIXBIT	/***/		;FILLED IN ABOVE - INPUT FILE
	SIXBIT	/DAT/		;DAT EXTENT
	0
PPN:	XWD	0,0		;PPN IS CURRENT USER UNLESS CHANGED
OUTFIL:	SIXBIT	/***/		;FILLED IN ABOVE - OUTPUT FILE
	SIXBIT	/TMP/		;STANDARD EXTENT
	0
	0			;CURRENT PPN
IBUF:	BLOCK	3		;SPACE FOR INPUT BUFFER HEADER
OBUF:	BLOCK	3		;SPACE FOR OUTPUT BUFFER HEADER
;
ARGBLK:	SIXBIT/SYS/
CUSPNA:	Z			;FILLED IN BY NAME DECODER ABOVE
	Z			;NULL EXTENT
	Z
	Z
ENDBLK:	Z
IFN TEMPC <TBLOCK:	XWD .-.,0	;FILLED IN ABOVE
	IOWD	0,0			;NO BUFFERS WANTED
>
JUMP:	POINT	9,(AC),8
	END
*U*