Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - rerun.mac
There are 21 other files named rerun.mac in the archive. Click here to see a list.
; UPD ID= 1607 on 1/2/79 at 4:23 PM by N:<NIXON>
TITLE RERUN V12A



;COPYRIGHT (C) 1973, 1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	SEARCH FTDEFS		; FILE TABLE DEFINITIONS
	%%FTDF==:%%FTDF		; CAUSE ERROR IF DEFINITIONS CHANGE
	SEARCH	LBLPRM,COMUNI
IFN TOPS20,<SEARCH MONSYM>
MLON
TWOSEG	HI.ORG

VERSION==1201	;VERSION
EDIT==6


LOC	137	;.JBVER
XWD	VERSION,EDIT
RELOC	HI.ORG

; EDIT 6 MAKE COMPATIBLE WITH VERSION COBOL-68 V12 (NO SELOTS)

; EDIT 5 CHANGED TO TAKE ADVANTAGE OF NEW 603 FILOP. TO ALLOW DIRECT
;	ADDRESSING OF FILES LARGER THAN 2**18-1
; EDIT 4 CHANGED LOCATION OF GETSEG CALL BECAUSE OF COMPILER CHANGE 
;	IN COBOLG AND PURE. ALSO ADDED ERROR MESSAGE WHICH SHOWS THAT
;	A FILE OPEN ON CHANNEL 0 LOSES BECAUSE OF GETSEG'S
;EDIT 3		FIXES VARIOUS MONITOR PROBLEMS WITH RERUN,
;FOR EXAMPLE ILLEGAL DATA MODE
;EDIT 2		TTY BUFFER IS NOT SETUP BEFORE IT IS USED  --  AC4 IS NOT SETUP FOR SDN WHEN CALLED FROM IDEV1 [EDIT#2]
;EDIT 1		A.  THE CALLING SEQUENCE FOR SELOTS IS WRONG,
;		B.  SELOTS DOES A CALLI RESET I.E. RELEASES ALL IO CHANNELS THAT RERUN JUST SETUP.
	FILOP.==CALLI 155	;FOR USETI/O

AC0=0
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
FLG=7
AC10=10
AC11=11
LEBLK=11
C=10
AC12=12
AC13=13
AC14=14
FLG1=14
AC15=15
AC16=16
I16=AC16
PP=17
EXTERN	.JBFF,.JBDA,.JBREL,.JBREN,.JBDDT,.JB41,.JBSYM,.JBSA,.JBAPR,.JBVER,.JBHRL

NONSTD==	100000	;NONSTANDARD LABELS
STNDRD==	40000	;STANDARD LABELS
OPNIN==		20000	;FILE IS OPEN FOR INPUT
OPNOUT==	10000	;FILE IS OPEN FOR OUTPUT
OPNIO==		4000	;FILE IS OPEN FOR INPUT/OUTPUT
RANFIL==	1	;A RANDOM ACCESS FILE
; NOTE FOLLOWING MUST BE CHANGED IF COMPILER CHANGES STARTING CODE
GETSGA==2	; LOCATION OF GETSEG INSTRUCTION WRT TO START ADDRESS
GETSGL==4	; LOCATION OF MOVEI 16,%LIT00 INSTRUCTION WTR TO START ADDRESS
SELARG==1	; LOACTION OF SELOTS ARG BLOCK WRT TOSTART ADDRESS


IFNDEF	DDTFLG,<DDTFLG==0>
	IFN	DDTFLG,<
LOC	124	;.JBREN
EXP	WEN
RELOC

	;LOADER SW FOR DDT = /1H/D/-H/1BRERUN$ - THEN TO
	;RUN WITH DDT DO   .GET RERUN
	;                  .ST 140
	;LINK COMMANDS
	;/SYMSEG:HIGH,SYS:DDT/SEG:HIGH,RERUN/LOCAL,/G
	EXTERN	DDT
WEN:	SETZ		;TURN ON THE WRITE ENABLE BIT
	CALLI	36	;  SO DDT IS USEFUL
	HALT	.
	JRST	DDT
>
ST:	CALLI			;RESET
	SETZ	AC0,		;SET TO WRITE ENABLE
	CALLI	AC0,36		;DOIT
	JRST	[TTCALL 3,[ASCIZ /? SETUWP UUO FAILED FOR RERUN HI-SEG/]
		CALLI	12]	;EXIT
	HRLI	PP,-20		;LENGTH
	HRR	PP,.JBFF	;PD LIST
	ADDI	PP,100		;
	HRRZ	AC0,PP		; MAKE SURE THERE IS ENOUGH CORE
	CAML	AC0,.JBREL	; IS THERE?
	JRST	ST1		; YES
	CALLI	AC0,11		; CORE UUO
	 JRST	GETCO1		; FAILED

ST1:	INIT	17,17		;INIT THE CHECKPOINT DEVICE
	SIXBIT	/DSK/		;
	Z			;NO HEADERS
	JRST	[TTCALL 3,[ASCIZ /? CANNOT INIT CHECKPOINT DEVICE/]
		 CALLI	12]	;EXIT
	SETZ	FLG,		;INIT FLG REG
	PUSHJ	PP,GETFN	;SETUP LOOKUP BLOCK AC3-6
	MOVEM	AC3,GSBLK+1	;FILENAME FOR GETSEG
	LOOKUP	17,AC3
	JRST	[TTCALL	3,[ASCIZ /? CHECKPOINT FILE LOOKUP FAILED/]
		MOVEI	AC1,17
		AND	AC1,AC4
		TTCALL	3,@LEMSG(AC1)
		CALLI	12]	;EXIT

	SETZ	AC4,		;IOWD TERMINATOR
	MOVE	AC3,.JBFF
IFE TOPS20,<
	HRLI	AC3,-2		;TWO WORDS FOR TOPS10
>
IFN TOPS20,<
	HRLI	AC3,-3		;THREE WORDS FOR TOPS-20
>
	IN	17,AC3		;READ IT
	SKIPA	AC2,1(AC3)	;(.JBFF)+1/	[TEMP.],,(.JBREL)
INERR:	JRST	[TTCALL 3,[ASCIZ /? INPUT ERROR FROM CHECKPOINT FILE./]
		 CALLI 12]	;EXIT
	MOVE	AC4,2(AC3)
	MOVEM	AC4,CBLVER	;SAVE VERSION # (0 BEFORE V12)
IFN TOPS20,<
	MOVE	AC4,3(AC3)	;GET JFN STRING
	MOVEM	AC4,SAVSTR	;SAVE UNTIL LOW SEG READ
>
	HRRZ	AC0,AC2		;.JBREL
	CAML	AC0,.JBREL	;SKIP ATTEMPT TO SHRINK CORE
	PUSHJ	PP,GETCOR	;MAKE ROOM FOR THE CHECKPOINT FILE
	MOVNI	AC3,-140(AC2)	;NEGATE THE LENGTH - .JBDA
	HRL	AC3,AC3		;
	HRRI	AC3,.JBDA-1
	SETZ	AC4,		;TERMINATOR
	IN	17,AC3		;THE LOW SEGMENT
	SKIPA			;  SAVED "JDA" STARTS AT (.JBFF)
	JRST	INERR		;ERROR
	HLRZM	AC2,AC4		;ADR FOR TEMP.
	MOVE	AC0,2(AC4)	;(TEMP.2)=[START.]
	MOVEM	AC0,START.	;SAVE IT
	MOVE	PP,1(AC4)	;(TEMP.1)=PP SAVE
	MOVE	AC4,(AC4)	;FILES.
	HLRM	AC4,.JBFF	;
	HRRZM	AC4,FILES	;FILE TABLE POINTER
IFN TOPS20,<
GOTHS:	SKIPN	2,SAVSTR	;GET THE STRING
	JRST	SCAN		;MUST BE V11 OR EARLIER
	HRLZI	1,(1B2+1B17)	;SHORT GTJFN
	GTJFN
	  JRST	GETHS		;NOT AVAILABLE, ASK USER
	HRLI	1,400000	;THIS PROCESS
	TRO	1,GT%ADR	;CHECK ADDRESS LIMITS
	MOVE	2,[400,,577]	;ALL OF HIGH SEGMENT EXCEPT OTS
	GET
	JRST	SCAN		;OK

GETHS:	HRROI	1,[ASCIZ /TYPE FILE SPEC OF SAVE FILE
/]
	PSOUT
	MOVE	1,SAVSTR
	MOVEI	2,20*5
	SETZ	3,
	RDTTY			;ACCEPT FILE SPEC
	  JRST	GETHS		;ERROR
	JRST	GOTHS		;NOW TRY AGAIN
>
	;SCAN THE FILE-TABLES FOR OPEN FILES

SCAN:	SKIPA	AC16,FILES	;FIRST FILE-TABLE
SCAN1:	HRRZ	AC16,F.RNFT(I16) ;NEXT FILE-TABLE
	JUMPE	AC16,GSEG	;NO MORE FILES, EXIT
	MOVE	FLG,F.WFLG(I16)	;SET FLAG REGISTER
	MOVE	FLG1,D.F1(I16)	;  AND FLAG1
	TLNN	FLG,OPNIN!OPNOUT ;FILE OPEN?
	JRST	SCAN1		;NO
	MOVE	AC15,D.DC(I16)	;DEVICE CHARACTERISTICS
	PUSHJ	PP,SBH		;SAVE THE BUFFER HEADERS
	PUSHJ	PP,SCHN		;SET THE CHANNEL NUMBER
	PUSHJ	PP,CCHR		;CHECK THE DEVICE CHARACTERISTICS
	PUSHJ	PP,IDEV		;INIT THE DEVICE
SCAN3:	TLNE	FLG,OPNIO!RANFIL	;IO FILE?
	JRST	PUDSK		;POSITION UNBUFFERED DSK, IO FILE
	TLNE	AC15,20		;MAG-TAPE?
	JRST	PMTA		;YES, POSITION MTA
	TLNE	AC15,200000	;DSK?
	JRST	PDSK		;POSITION BUFFERED DSK FILE
	PUSHJ	PP,RBH		;MUST BE TTY OR LPT
	JRST	SCAN1

	;RESTORE THE CHECKPOINT FILE JOBDATA AREA

GSEG:	TTCALL	11,		;CLEAR TTY BUFFER -- SELOTS NO LONGER DOES	[EDIT#1]
	MOVE	AC2,GSBLK+1	;CKP FILENAME
	CALLI	AC2,43		;SETNAM UUO
	MOVE	AC2,.JBFF	;INDEX TO CKP JDA
	POP	PP,.JBFF	; RESTORE TO ORIGINAL STATE
	MOVE	AC1,.JBSA(AC2)	;
	MOVEM	AC1,.JBSA	;
	MOVE	AC1,.JB41(AC2)	;
	MOVEM	AC1,.JB41	;
	MOVE	AC1,.JBDDT(AC2)	;
	CALLI	AC1,2		;SETDDT UUO
	MOVE	AC1,.JBSYM(AC2)	;
	MOVEM	AC1,.JBSYM	;
	MOVE	AC1,.JBAPR(AC2)	;
	MOVEM	AC1,.JBAPR	;
	MOVEI	AC1,230000	;
	CALLI	AC1,16		;APRENB UUO
	MOVE	AC1,.JBVER(AC2)	;
	MOVEM	AC1,.JBVER	;
	SKIPN	CBLVER		;TEST FOR V12
	JRST	GSEG11		;NO, V11 OR EARLIER
	HRRZI	AC1,GSBLK	;IN CASE WE'RE REENTRANT
	HRRZ	AC2,START.	;FIND "JSP 16,COBST."
	MOVE	AC3,(AC2)	; TO GET THE ADDRESS OF COBST.
	CAMN	AC3,[JFCL]	;IS FIRST INSTRUCTION OF PROGRAM "JFCL"?
	 MOVE	AC3,1(AC2)	;YES, THEN NEXT INSTRUCTION WILL BE THE JSP
	JRST	1(AC3)		;DISPATCH
;HERE FOR V11 OR EARLIER

GSEG11:	MOVEM	PP,(AC2)	;SAVE PP
	HRRI	AC3,1(AC2)	;TO	(.JBFF)+1
	HRLI	AC3,GSEGCD	;FROM
	BLT	AC3,GS.LEN(AC2)	;DOIT					[EDIT#1]
	HRLZI	AC1,(SIXBIT /DSK/)
	MOVEM	AC1,GSBLK	;CKP FILE'S DEVICE
	HRRZI	AC1,GSBLK	;INIT AC1 FOR GETSEG UUO
	HRRZ	AC3,START.	;STARTING ADR OF COBOL PROG.
	MOVE	AC4,GETSGA(AC3)	;GETSEG UUO IF NON-REENT COB-PROG [4]
	CAME	AC4,GSEGCD+GS.GET-GS.Z	;SKIP IF NON-REENT, AC4 = TO GETSEG
	JRST	GS.Z(AC2)		;DO THE GETSEG AND EXIT
	HRLI	AC1,GETSGL(AC3)	;SHARABLE  [4]
	HRRI	AC1,GS.S1(AC2)	;  SO SETUP THE CALLING			[EDIT#1]
	BLT	AC1,GS.S2(AC2)	;  SEQUENCE FOR "SELOTS"
	MOVEI	AC1,2		;SKIP OVER "CALLI RESET" IN SELOTS	[EDIT#1]
	ADDM	AC1,GS.S2(AC2)	;  SO MAKE THE JSP GO TO 400010+2	[EDIT#1]
	HRRZ	AC1,SELARG(AC3)	;GO GETSEG SELOTS [4]
		;SELARG(AC3) POINTS TO SELOTS GETSEG ARGUMENT BLOCK
		;SELARG IS A COMPILER DETERMINED CONSTANT
	JRST	GS.Z(AC2)		;

	;THE FOLLOWING CODE IS BLTED TO LOWSEG FREE CORE AND EXECUTED THERE
GSEGCD:	PHASE	1
GS.Z:!	MOVSI	16,1		;GET RID OF RERUN
	CALLI	16,11		;FROM HIGH SEGMENT
	  HALT	.		;CAN NEVER HAPPEN
GS.GET:!CALLI	AC1,40		;GETSEG PROGRM.HGH OR SELOTS
	  HALT			;LET MONITOR PRINT MESSAGE
GS.S1:!	JFCL			;SAVE SOME SPACE FOR
GS.S2:!	JFCL			;  SELOTS CALLING SEQUENCE
	MOVE	AC2,.JBFF	;
	MOVE	PP,(AC2)	;RESTORE PP
	POP	PP,AC0		;
	POP	PP,AC1		;
	POP	PP,AC2		;
	POP	PP,AC3		;
	POP	PP,AC4		;
	POP	PP,AC5		;
	POP	PP,AC6		;
	POP	PP,AC7		;FLG
	POP	PP,AC10		;
	POP	PP,AC11		;C
	POP	PP,AC12		;
	POP	PP,AC13		;
	POP	PP,AC14		;
	POP	PP,AC15		;
	POP	PP,AC16		;
	POPJ	PP,		;ANSWERS TO CKP FILE PUSHJ PP,RRDMP

GS.LEN:!
	DEPHASE
	;SAVE THE BUFFER HEADERS
SBH:	HRLI	AC0,-11(I16)	;FROM
	HRRI	AC0,BHSAV	;TO
	BLT	AC0,BHSAV+5
	POPJ	PP,

	;RESTORE THE BUFFER HEADERS AND DO A DUMMY OUTPUT
RBH:	TLNN	FLG,OPNOUT	;SKIP IF OUTPUT FILE
	JRST	RBH2		;INPUT
	PUSHJ	PP,RBH1		;RESTORE HEADERS
	HRRZ	AC1,BHSAV	;CURRENT BUFFER
	HRRZ	AC1,(AC1)	;NEXT BUF
	TLO	AC1,400000	;NEVER REFERENCED
	MOVEM	AC1,-11(I16)	;
	XCT	OUT		;DUMMY OUTPUT

	;MOVE CURRENT BUFFER TO NEXT BUFFER
	HRR	AC2,BHSAV	;CURRENT BUF
	HRLI	AC1,1(AC2)	;FROM
	ADDI	AC1,1		;TO
	HLRZ	AC2,(AC2)	;SIZE
	ADDI	AC2,-1(AC1)	;UNTIL
	TRZ	AC2,400000	;TURN OFF NEVER REFFED BIT
	BLT	AC1,(AC2)	;DOIT!

	;MODIFY THE SAVED BUFFER HEADER TO POINT TO NEXT BUFFER IN THE RING
	MOVE	AC1,BHSAV+1	;OUTPUT BYTE POINTER
	HRRZ	AC2,BHSAV	;CURRENT BUFFER
	SUB	AC1,AC2		;ADJ BPTR TO
	ADD	AC1,-11(I16)	;  POINT TO NEXT BUF
	MOVEM	AC1,BHSAV+1	;SAVE IT
	MOVE	AC1,-11(I16)	;MAKE NEXT BUFFER
	MOVEM	AC1,BHSAV	;  BECOME THE CURRENT BUFFER

	;RESTORE THE BUFFER HEADERS
RBH1:	HRLI	AC0,BHSAV	;FROM
	HRRI	AC0,-11(I16)	;TO
	BLT	AC0,-4(I16)
	POPJ	PP,

	;SO WE DONT GET ADR-CHECK OR EXTRA BUFFERS
RBH2:	HRRZ	AC1,BHSAV+3	;ADR OF CURRENT BUFFER
	SKIPA	AC2,AC1		;DUPLICATE
RBH3:	MOVE	AC2,AC3		;NEXT BUFFER
	MOVE	AC3,(AC2)		;
	TLZ	AC3,400000	;CLEAR BUF-USE-BIT
	MOVEM	AC3,(AC2)	;SAVE IT
	CAIE	AC1,(AC3)	;PREVIOUS BUFFER?
	JRST	RBH3		;NO
	HRLI	AC2,400000	;SET NEVER REFERENCED BIT
	MOVEM	AC2,BHSAV+3	;POINT AT PREVIOUS BUFFER
	JRST	RBH1		;
	;SET THE CHANNEL NUMBER

SCHN:	LDB	AC0,DTCN.	;CHAN FROM FILE-TABLE
	JUMPE	AC0,SCHNER	; CANNOT HAVE CHANNEL 0 OPEN [4]
	MOVEI	AC1,LUUO	;LAST UUO
	MOVE	AC2,[POINT 4,FUUO,12] ;FIRST UUO
	DPB	AC0,AC2		;
	CAIE	AC1,(AC2)	;EXIT IF LUUO
	AOJA	AC2,.-2		;ELSE LOOP
	POPJ	PP,
SCHNER:	TTCALL	3,[ASCIZ/
? CANNOT RERUN WITH FILE OPEN ON CHANNEL 0/]	; [4]

	CALLI	12		; EXIT [4]

	;CHECK DEVICE CHARACTERISTICS MAKE SURE ITS THE SAME TYPE

CCHR:	MOVE	AC1,D.RD(I16)	;DEVICE NAME
	MOVEM	AC1,OBLK+1	;SAVE IT FOR THE OPEN
	CALLI	AC1,4		;DEVCHR UUO
	JUMPE	AC1,ASSD	;ASSIGN DEVICE MESSAGE
	TDZ	AC1,[XWD 434000,-1] ;CLEAR UNWANTED BITS
	TLNN	AC1,40		;AVAILABLE?
	JRST	ASSD		;NO, MESSAGE
	TDZ	AC1,AC15	;OK?
	JUMPN	AC1,ASSD	;NO, MESSAGE
	POPJ	PP,

	;INIT THE DEVICE WITH AN OPEN UUO

IDEV:	SKIPGE	FLG
	TDZA	AC6,AC6		;ASCII MODE
	MOVEI	AC6,14		;BINARY MODE
	TLNE	FLG,OPNIO!RANFIL	;
	MOVEI	AC6,17		;DUMP MODE
	HRRM	AC6,OBLK	;
	HRLI	AC6,D.OBH(I16)	;OUTPUT HEADER
	HRRI	AC6,D.IBH(I16)	;INPUT HEADER
	MOVEM	AC6,OBLK+2	;
	XCT	UOPEN
	JRST	IDEV1		;OPEN ERROR
	POPJ	PP,

IDEV1:	TTCALL	3,[ASCIZ /
? OPEN FAILED FOR/]
	PUSHJ	PP,SDN		;DEVICE DEV
	CALLI	1,12		;EXIT, WAIT FOR CONT
	JRST	IDEV		;SHOULD NOT HAPPEN
	;POSITION THE BUFFERED DSK FILE

PDSK:	PUSHJ	PP,SLEBK	;SETUP LOOKUP/ENTER BLOCK
	XCT	ULOOK		;LOOKUP
	JRST	LKER		;LOOKUP ERROR
	TLNN	FLG,OPNOUT	;
	JRST	PDSKI		;INPUT
	PUSHJ	PP,SLEBK	;SET LOOKUP/ENTER BLOCK
	XCT	UENTR		;ENTER
	JRST	ENER		;ENTER ERROR
	MOVE	AC1,-21(I16)	;NUMBER OF OUTPUTS
	TLNE	AC1,-1		;BLOCK # LARGER THAN 18 BITS?
	PUSHJ	PP,FUSO		;YES USE FILOP. TYPE USETO
	 XCT	USETO		;
	PUSHJ	PP,RBH		;RESTORE THE BUFFER HEADER
	JRST	SCAN1		;NEXT DEVICE

PDSKI:	MOVE	AC1,-22(16)	;NUMBER OF INPUTS
	TLNE	AC1,-1		;BLOCK # LARGER THAN 18 BITS?
	PUSHJ	PP,FUSI		;YES USE FILOP. TYPE USETI
	 XCT	USETI		;
	PUSHJ	PP,RBH		;RESTORE BUFFER HEADERS
	JRST	SCAN1		;NEXT

	;POSITION UNBUFFERED DSK

PUDSK:	PUSHJ	PP,SLEBK	;SETUP LOOKUP BLK
	XCT	ULOOK		;LOOKUP
	JRST	LKER		;ERROR RET
	PUSHJ	PP,SLEBK	;ENTER BLK
	XCT	UENTR		;ENTER
	JRST	ENER		;ERROR
	MOVE	AC1,-16(I16)	;BLOCK NUMBER FOR USETO
	SUBI	AC1,1		;NOT BLOCK +1
	TLNE	AC1,-1		;BLOCK # LARGER THAN 18 BITS?
	PUSHJ	PP,FUSO		;YES USE FILOP. TYPE USETO
	 XCT	USETO		;
	JRST	SCAN1		;NEXT

	;POSITION MAGNETIC-TAPE

PMTA:	XCT	MREW		;REWIND
	XCT	MWAIT		;SO FOLLOWING MADVR WILL WORK *%$&!!
	LDB	AC1,F.BPMT	;FILE POSITION ON TAPE
	SOJLE	AC1,PMTA1	;JUMP IF BEG OF FIRST FILE
	TLNE	FLG1,NONSTD!STNDRD ;
	IMULI	AC1,2		;ACCOUNT FOR LABELS
	XCT	MADVF		;ADVANCE TO BEG OF CURRENT FILE
	SOJG	AC1,.-1		;
PMTA1:	TLNN	FLG,OPNOUT	;SKIP IF OPEN FOR OUTPUT
	SKIPA	AC1,D.IE(I16)	;NUMBER OF INPUT RECORDS
	MOVE	AC1,D.OE(I16)	;NUMBER OF OUTPUT RECORDS
	JUMPE	AC1,PMTA2	;JUMP, OPENED BUT NOT READ OR WRITTEN
	XCT	MADVR		;ADVANCE TO NEXT REC
	SOJG	AC1,.-1		;
PMTA2:	PUSHJ	PP,RBH		;RESTORE BUFFER HEADERS
	XCT	MWAIT		;WAIT FOR POSITIONING
	JRST	SCAN1		;...NEXT FILE
	;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK

SLEBK:	MOVE	AC1,[POINT 6,LEBLK]
	MOVE	AC2,F.WVID(16)	;BP TO VALUE OF ID
	HRRZ	AC4,AC2		;ADDRESS
	CAIL	AC4,ST		;IN HIGH SEG?
	JRST	SLEBK5		;YES, MESS
	MOVEI	AC4,11		;11 CHARS
SLEBK1:	ILDB	C,AC2		;
	TLNE	AC2,100		;
	SUBI	C,40		;CONVERT TO SIXBIT
	IDPB	C,AC1		;
	SOJN	AC4,SLEBK1	;
	SETZM	LEBLK+3		;PROJ,PROG
	LDB	AC1,F.BCVR	;COMPILER VERSION NUMBER
	CAIGE	AC1,3		;VERSION 3 OR GREATER?
POPJ:	POPJ	PP,		;NO, SO NO PROJ,,PROG NUMBER
	HRRZ	AC1,F.RPPN(I16)	;GET ADR OF PP
	JUMPE	AC1,POPJ	;EXIT IF NONE SPECIFIED
	MOVE	LEBLK+3,(AC1)	;INSERT IN LOOKUP BLOCK
	CAIGE	AC1,ST		;ERROR IF IN HISEG
	POPJ	PP,

SLEBK5:	TTCALL	3,[ASCIZ %
? VALUE-OF-ID OR USER-NUMBER IS INACCESSABLE.
? RECOMPILE WITHOUT "/R" SWITCH, OR USE "DATA-NAME" & NOT A "LITERAL" AS
?	OBJECT OF "VALUE-OF-ID" OR "USER-NUMBER" CLAUSE.
%]
	PUSHJ	PP,CLSFIL
	CALLI	12		;EXIT

	;CLOSE ALL FILES, BUT DONT SUPERCEDE

CLSFIL:	MOVE	AC1,[CLOSE 1,40]
CLSFI1:	XCT	AC1
	ADD	AC1,[40,,0]
	SKIPGE	AC1,[CLOSE 17,40]
	JRST	CLSFI1
	POPJ	PP,

	;LOOKUP/ENTER ERROR MESSAGES

ENER:	TTCALL	3,[ASCIZ /
? ENTER FAILED FOR FILE /]
	SKIPA
LKER:	TTCALL	3,[ASCIZ /
? LOOKUP FAILED FOR FILE /]
	MOVE	AC1,[POINT 6,LEBLK]
	MOVEI	AC4,6		;6 CHAR NAME
	PUSHJ	PP,SOUT		;SIXBIT OUT
	TTCALL	3,[ASCIZ /./]
	MOVE	AC1,[POINT 6,LEBLK+1]
	MOVEI	AC4,3		;3 CHAR EXT
	PUSHJ	PP,SOUT		;
	HRRZ	AC1,LEBLK+1	;PICKUP THE ERROR BITS
	ANDI	AC1,17		;CLEAR OTHER BITS
	TTCALL	3,LEMSG(AC1)	;COMPLAIN
	PUSHJ	PP,CLSFIL	;CLOSE FILES WITH NO SUPERCEEDING
	CALLI	1,12		;EXIT, WAIT FOR CONT
	JRST	SCAN3		;START OVER AGAIN

	;LOOKUP, ENTER, RENAME, RUN, AND GETSEG ERROR MESSAGES

LEMSG:	[ASCIZ	/ FILE NOT FOUND/]
	[ASCIZ	/ UFD DOES NOT EXIST/]
	[ASCIZ	/ PROTECTION FAILURE OR DTA DIRECTORY FULL/]
	[ASCIZ	/ FILE BEING MODIFIED/]
	[ASCIZ	/RNAM/]
	[ASCIZ	/RNAM/]
	[ASCIZ	. DEVICE OR UFD/RIB DATA ERROR.]
	[ASCIZ	/ NOT A SAVED FILE/]
	[ASCIZ	/ NOT ENOUGH CORE/]
	[ASCIZ	/ DEVICE NOT AVAILABLE/]
	[ASCIZ	/ NO SUCH DEVICE/]
	[ASCIZ	/ GETSEG REQUIRES TWO RELOCATION REGISTERS/]
	[ASCIZ	/ QUOTA EXCEEDED OR NO ROOM ON FILE STRUCTURE/]
	[ASCIZ	/ WRITE LOCKED FILE STRUCTURE/]
	[ASCIZ	/ NOT ENOUGH MONITOR TABLE SPACE/]
	[ASCIZ	/ PARTIAL ALLOCATION ONLY/]
	[ASCIZ	/ ALLOCATED BLOCK NOT FREE/]
	;FAILED DEVCHR TEST, ASSIGN DEVICE LOGICAL NAME

ASSD:	TTCALL	3,[ASCIZ /
ASSIGN /]
	TLNE	AC15,200000
	MOVE	AC1,[ASCIZ /DSK /]
	TLNE	AC15,40000
	MOVE	AC1,[ASCIZ /LPT /]
	TLNE	AC15,100
	MOVE	AC1,[ASCIZ /DTA /]
	TLNE	AC15,20
	MOVE	AC1,[ASCIZ /MTA /]
	TLNE	AC15,10
	MOVE	AC1,[ASCIZ /TTY /]
	TTCALL	3,AC1
;		MOVEI	AC4,6		;				[EDIT#2]
	PUSHJ	PP,SDN1		;TELL USER LOGICAL NAME
	PUSHJ	PP,OCRLF
	TTCALL	3,[ASCIZ /TYPE CONTINUE WHEN DONE
/]
	CALLI	1,12		;EXIT, WAIT FOR CONT
	JRST	CCHR		;TRY AGAIN

	;TYPE OUT THE DEVICE NAME

SDN:	TTCALL	3,[ASCIZ / DEVICE /]
SDN1:	MOVEI	AC4,6		;ALLOW 6 CHARS IN LOGICAL NAME		[EDIT#2]
	PUSHJ	PP,OBUF1	;INITIALIZE TTY POINTERS		[EDIT#2]
	MOVE	AC3,D.RD(I16)	;LOGICAL DEVICE NAME
	SKIPA	AC1,[POINT 6,AC3]
SOUT:	PUSHJ	PP,O6BT		;OUTPUT A SIXBIT CHAR
SOUT1:	ILDB	C,AC1
	CAIE	C,0		;TERMINATE ON SPACE
	SOJGE	AC4,SOUT	;  OR ELEVENTH CHAR
	JRST	OBUF		;AND POPJ
IC:	TTCALL	3,[ASCIZ /? ILLEGAL CHARACTER, /]
GETFN0:	TTCALL	11,0		;CLEAR THE BUFFER
GETFN:	TTCALL	3,[ASCIZ /TYPE CHECKPOINT FILE NAME
/]
	MOVE	AC1,[POINT 6,AC3]
	MOVEI	AC0,6		;6 FILENAME CHARS
	HRLZI	AC4,(SIXBIT /CKP/)	;CKP IS DEFAULT EXT
	SETZ	AC3,		;CLEAR THE LOOKUP BLK
	SETZB	AC5,AC6		;

GETFN1:	PUSHJ	PP,GETC		;CHAR TO C
	CAIL	C,12		;"LF"
	CAILE	C,15		;"CR"
	SKIPA
	JRST	LT		;LINE TERMINATOR
	CAIN	C,56		;"."
	JRST	PD		;PERIOD
	CAIL	C,60		;"0"
	CAILE	C,172		;LOWER-CASE "Z"
	JRST	IC		;ILLEGAL CHARACTER
	CAIL	C,141		;L-C "A"
	SUBI	C,40		;L-C TO U-C
	CAILE	C,132		;"Z"
	JRST	IC		;
	SUBI	C,40		;ASCII TO SIXBIT
	JUMPE	AC0,GETFN1	;ONLY FIRST SIX/THREE CHARS ARE REAL
	IDPB	C,AC1		;C TO LOOKUP BLK
	SOJA	AC0,GETFN1	;LOOP

PD:	TLOE	FLG,1		;PERIOD FLAG
	JRST	IC		;ONLY ONE "."
	SETZ	AC4,		;REAL EXT COMING, ZERO THE DEFAULT
	MOVEI	AC0,3		;3 REAL EXTENSION CHARS
	MOVE	AC1,[POINT 6,AC4]
	JRST	GETFN1		;
LT:	JUMPE	AC3,GETFN0	;NULL NAME?
	POPJ	PP,


GETC:	TTCALL	2,C		;
	TTCALL	4,C		;
	POPJ	PP,

O6BT:	ADDI	C,40		;CONVERT TO ASCII
OCHR:	IDPB	C,OBP		;CHAR TO BUFFER
	SOSLE	OBC		;IS BUFFER FULL?
	POPJ	PP,		;NO, RETURN
OBUF:	SETZ	C,		;YES
	IDPB	C,OBP		;TERMINATE IT
	TTCALL	3,OBF		;OUTPUT IT
OBUF1:	MOVE	C,[POINT 7,OBF]	;INITIALIZE
	MOVEM	C,OBP		;BYTE POINTER
	MOVEI	C,^D132		;CHARS/LINE
	MOVEM	C,OBC		;BYTE COUNT
	POPJ	PP,

OCRLF:	TTCALL	3,[ASCIZ /
/]
	POPJ	PP,

	;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETI
FUSI:	LDB	AC0,DTCN.	; GET DATA FILE'S CHANNEL
	HRLM	AC0,FUSIA	; SET IT IN THE ARG-BLOCK
	MOVEM	AC1,FUSIA+1	; SETUP THE BLOCK-NUMBER
	MOVE	AC0,[2,,FUSIA]	; POINT AT ARG-BLOCK
	FILOP.	AC0,		; DO THE USETI
	 JRST[	TTCALL 3,[ASCIZ /? UNABLE TO POSITION DATA FILE, USETI (FILOP.) FAILED./]
		CALLI 12	];EXIT
	JRST	RET.2		; DONE

	;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETO
FUSO:	LDB	AC0,DTCN.	; GET DATA FILE'S CHANNEL
	HRLM	AC0,FUSOA	; SET IT IN THE ARG-BLOCK
	MOVEM	AC1,FUSOA+1	; SETUP THE BLOCK-NUMBER
	MOVE	AC0,[2,,FUSOA]	; POINT AT ARG-BLOCK
	FILOP.	AC0,		; DO THE USETO
	 JRST[	TTCALL 3,[ASCIZ /? UNABLE TO POSITION DATA FILE, USETO (FILOP.) FAILED./]
		CALLI 12	];EXIT
RET.2:	AOS	(PP)		;SKIP EXIT
	POPJ	PP,

GETCOR:	CALLI	AC0,11		;CORE UUO
	 SKIPA			;ERROR RET
	POPJ	PP,		;NORM RET
GETCO1:	TTCALL	3,[ASCIZ /? INSUFICIENT CORE./]
	CALLI	12		;EXIT


FUUO:		;FIRST UUO
MWAIT:	MTAPE	0,0	;WAIT
MREW:	MTAPE	0,1	;REWIND
MADVR:	MTAPE	0,6	;ADVANCE RECORD
MADVF:	MTAPE	0,16	;ADVANCE FILE

UOPEN:	OPEN	OBLK	;
ULOOK:	LOOKUP	LEBLK	;
UENTR:	ENTER	LEBLK	;
USETI:	USETI	1(AC1)	;
USETO:	USETO	1(AC1)	;
OUT:	OUT		;DUMMY OUTPUT
OBLK:	BLOCK	3	;FOR OPEN UUO
;** EDIT 3 CHANGED 1 INSTRUCTION
LUUO== .-4		;LAST UUO		[EDIT#3]

	;ARG BLOCKS FOR FILOP. TYPE USETI/O
FUSIA:	EXP	11	;FUNCTION = USETI
	Z
FUSOA:	EXP	12	;FUNCTION = USETI
	Z

BHSAV:	BLOCK	6	;SAVE AREA FOR BUFFER HEADERS
OBC:	BLOCK	1	;TTY BYTE COUNT
OBP:	BLOCK	1	;TTY BYTE POINTER
OBF:	BLOCK	^D27	;TTY OUTPUT BUFFER
GSBLK:	BLOCK	6	;FOR GETSEG UUO
FILES:	BLOCK	1	;POINTER TO FIRST FILE TABLE
START.:	BLOCK	1	;(OLD .JBSA) SAVED HERE I.E. START.
CBLVER:	BLOCK	1	;VERSION NO. OF FILE
IFN TOPS20,<
SAVSTR:	BLOCK	1	;POINTER TO JFN STRING FOR SAVE FILE
>
PAT:	BLOCK	10

DTCN.:	POINT 4,D.CN(I16),15	; IO CHANNEL FOR THIS FILE
F.BCVR:	F%BCVR		; COMPILER'S VERSION NUMBER
F.BPMT:	F%BPMT		; FILES'S POSITION ON MAG-TAPE

END.:	END	ST