TITLE	SYSPRG
	ENTRY	SYSPRG

;ALL AC'S DESTROYED & OPEN CHANNELS IGNORED
;DUE TO THE FACT THAT THE PROGRAM IS NEVER GOING BACK TO COBOL

SYSPRG:	MOVE	1,-1(16)	;GET NUMBER OF ARGS
	AOBJP	1,DORUN		;ONLY ONE ARG JUST DO RUN
	MOVE	15,1(16)	;GET TEMP CORE ARG
	HRRZ	1,1(15)		;GET SIZE
	MOVE	3,(15)		;GET BYTE POINTER
	TLNE	3,100		;SIX OR SEVEN BIT STRING?
	SKIPA	4,[5]		;SEVEN DIVIDE BY 7 TO GET SIZE
	MOVEI	4,6		;OR SIX IF SIXBIT.
	IDIVI	1,(4)		;COMPUTE SIZE IN WORDS
	MOVNI	1,1(1)		;CHANGE SIGN
	HRLI	1,(1)		;PUT IN LEFT HALF OF WORD
	HRRI	1,-1(3)		;GET STARTING ADDRESS -1
	MOVSI	(SIXBIT /NXT/)	;NAME FILE NXT
	MOVSI	3,3		;CODE 3 @0 WRITE FILE
	TMPCOR	3,		;WRITE FILE IN CORE
	JRST	DSKIT		;ERROR. PUT ON DSK
DORUN:	MOVE	1,(16)		;GET CALL ARG
	HRRZ	2,1(1)		;GET SIZE OF FIELD
	MOVE	1,(1)		;GET POINTER
	CAILE	2,6		;SIZE GREATER THEN 6
	MOVEI	2,6		;YES ONLY USE THE FIRST 6
	MOVE	3,[GETH,,140]	;SET BLT WORD
	BLT	3,GETE		;BLT RUN ROUTINE INTO LOW SEG
	MOVE	3,[POINT 6,NAME];SET POINTER FOR BYTE TRANSFER
	ILDB	4,1		;GET A CHARACTER
	TLNE	1,100		;SIXBIT ARG?
	SUBI	4,40		;NO CONVERT TO SIXBIT
	IDPB	4,3		;PUT CHARACTER IN NAME
	SOJG	2,.-4		; LOOP
	JRST	140		;GO REDUCE CORE AND DO RUN UUO
DSKIT:	OPEN	SPC		;INIT DSK 
	HALT	.		;FORGET IT
	PJOB	2,		;GET JOB #
	SETZ	4,		;CLEAR AC
	IDIVI	2,12		;DIVIDE BY 10
	ORI	3,20		;CONVERT TO 6BIT
	LSHC	3,-6		;SHIFT TO NEXT AC
	TLNN	4,77		;3 CHARS?
	JRST	.-4		;NO LOOP
	HLLM	4,FNAME		;JOB # IN L.H.
	MOVEI	'NXT'		;TMP NAME
	HRRM	FNAME		;IN RH.
	MOVSI	'TMP'		;TEMP EXT.
	MOVEM	FNAME+1		;INTO NXT LOC
	SETZ	2,		;CLEAR COMMAND LIST END
	ENTER	FNAME		;PUT ON DSK
	HALT	.		;2 TIME LOSER. GIVE UP.
	OUTPUT	1		;DUMP MODE OUTPUT
	CLOSE			;CLOSE IT
	RELEAS			;& RELEASE
	JRST	DORUN		;GO DO RUN
GETH:	MOVE	1,[2000,,2000]	;SET UP TO REDUCE CORE ARG
	PHASE	141
	CORE	1,		;REDUCE CORE TO 1K
	HALT	.		;HALT IF ERROR
	MOVEI	1,RUNTAB	;RUN TABLE ADDRESS IN AC1
	RUN	1,		;RUN THE NEXT PROGRAM
	HALT	.		;HALT IF ERROR
RUNTAB:	SIXBIT	/SYS/		;USE DEVICE SYS TO LOAD FROM
NAME:	BLOCK	1		;FILE NAME
	BLOCK	1		;EXT
	BLOCK	1		;ALWAYS 0
	BLOCK	1		;USE DEFULT DIRECTORY PATH
GETE:	BLOCK	1		;END OF LOW SEG PHASE
	DEPHASE
SPC:	17			;IMAGE DUMP MODE
	SIXBIT	/DSK/		;DEVICE DSK
	0			;NO BUFFER
FNAME:	0
	0
	0
	0
	END