Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 3128 on 8/27/80 at 11:58 AM by MAYBERRY                       
TITLE RERUN V13

	SEARCH COPYRT
	SALL


COPYRIGHT (C) 1973, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


;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
	SEARCH UUOSYM
IFN TOPS20,<SEARCH MONSYM,MACSYM>
IFE TOPS20,<SEARCH MACTEN>

	.COPYRIGHT		;Put standard copyright statement in REL file

TWOSEG	HI.ORG
SALL

RRNEDT==7	;EDIT LEVEL
RRNMJR==13	;MAJOR RELEASE VERSION
RRNMNR==0	;MAINTENANCE VERSION OF A MAJOR VERSION
RRNWHO==0	;WHO LAST EDITED (0= DEC)

RRNVER==BYTE(3)RRNWHO(9)RRNMJR(6)RRNMNR(18)RRNEDT

LOC	137	;.JBVER
EXP	RRNVER
RELOC	HI.ORG

; EDIT 7 FIX RETURN TO TOPS-20 RELOCATIBLE LIBOL

; 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.

IO==17	;CHANNEL NUMBER FOR I/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
I12==12
AC12=12
AC13=13
AC14=14
FLG1=14
AC15=15
AC16=16
I16=AC16
PP=17

; FOLLOWING AC DEFINITIONS MUST STAY AS IS FOR TOPS-20 JSYS ARGS

T1==1
T2==2
T3==3
T4==4


EXTERN	.JBFF,.JBDA,.JBREL,.JBREN,.JBDDT,.JB41,.JBSYM,.JBSA,.JBAPR,.JBVER,.JBHRL

PERFLG==	1,,0	;PERIOD FLAG IN COMMAND SCANNER

	; BIT DEF'S FOR FLG, LEFT HALF

DDMASC==400000	;DEVICE DATA MODE IS ASCII
DDMSIX==200000	;DEVICE DATA MODE IS SIXBIT
DDMEBC==100000	;DEVICE DATA MODE IS EBCDIC
DDMBIN==40000	;DEVICE DATA MODE IS BINARY
OPNIN==20000	;FILE IS OPEN FOR INPUT
OPNOUT==10000	;FILE IS OPEN FOR OUTPUT
OPNIO==30000	; FILE IS OPEN FOR I-O
IOFIL==4000	; FILE IS AN INPUT/OUTPUT FILE
ATEND==2000	;AN "EOF" WAS SEEN
CONNEC==1000	;DEVICE & CORE DATA MODES DIFFER
NOTPRS==400	;OPTIONAL FILE NOT PRESENT
RRUNER==200	;RERUN DUMP AT END-OF-REEL
RRUNRC==100	;RERUN DUMP VIA RECORD-COUNT
CDMASC==40	;CORE DATA MODE IS ASCII
CDMSIX==20	;CORE DATA MODE IS SIXBIT
CDMEBC==10	;CORE DATA MODE IS EBCDIC
IDXFIL==4	;ACCESS MODE IS INDEX-SEQUENTIAL
SEQFIL==2	;ACCESS MODE IS SEQUENTIAL
RANFIL==1	;ACCESS MODE IS RANDOM

	;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET.

VLREBC==400000	;VARIABLE LENGTH EBCDIC RECORDS
FILOPT==200000	;FILE IS OPTIONAL
NONSTD==100000	;LABELS ARE NON-STANDARD
STNDRD==40000	;LABELS ARE STANDARD
MSTNDR==20000	;STANDARD BUT MONITOR DOES LABEL PROCESSING
MTNOLB==10000	;MOUNTR HANDLING LABELS,BUT NO LABELING


	; FLAG BITS IN D.RFLG RIGHT HALF

SASCII==1	; REQUEST FOR STANDARD ASCII, IN D.RFLG
RDDREV==2	; OPEN REVERSED ACTIVE 
EXTOPN==100	; =1 IF FILE WAS OPENED EXTEND
INDASC==1000	; =1 IF MTA STD ASCII NEEDS INDUSTRY-COMP MODE (TM03 TROUBLE)



	;COMPT. UUO FUNCTIONS
CMPJFN==10	;GET JFN FROM CHANNEL NUMBER

; NOTE FOLLOWING MUST BE CHANGED IF COMPILER CHANGES STARTING CODE
GETSGL==4	; LOCATION OF MOVEI 16,%LIT00 INSTRUCTION WTR TO START ADDRESS
GETSGA==2	; LOCATION OF GETSEG INSTRUCTION WRT TO START ADDRESS
SELARG==1	; LOCATION OF SELOTS ARG BLOCK WRT TO START ADDRESS


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

	;LINK COMMANDS
	;/SYMSEG:HIGH,SYS:DDT/SEG:HIGH,RERUN/LOCAL,/G

	EXTERN	DDT
WEN:	SETZ	AC0,	;TURN ON THE WRITE ENABLE BIT
	SETUWP	AC0,	;  SO DDT IS USEFUL
	HALT	.
	JRST	DDT
>

	$COPYRIGHT		;Put standard copyright statement into EXE file
ST:	RESET			;RESET
IFN TOPS20,<			;<;CROCK TO MAKE ANGLE BRACKETS BALLANCE
	HRROI	T1,[ASCIZ /RERUN>
/]
	PSOUT			;TELL USER WHO WE ARE
	CALLI			;BRING IN PA1050 UNTIL VERSION 13
>
	SETZ	AC0,		;SET TO WRITE ENABLE
	SETUWP	AC0,		;DOIT
	JRST	[OUTSTR [ASCIZ /?RRNSUF SETUWP UUO failed for RERUN hi-seg/]
		EXIT]		;EXIT
	HRLI	PP,-20		;LENGTH
	HRR	PP,.JBFF	;PD LIST
	ADDI	PP,100
	HRRZ	AC0,PP		; MAKE SURE THERE IS ENOUGH CORE
	CAMG	AC0,.JBREL	; IS THERE?
	JRST	ST1		; YES
	CORE	AC0,		; CORE UUO
	 JRST	GETCO1		; FAILED

ST1:
IFE TOPS20,<
	MOVE	AC10,[%CNVER]	;CONFIG TABLE
	GETTAB	AC10,
	  SETZ	AC10,		;MUST BE VERY OLD
	LDB	AC10,[POINT 5,AC10,23]	;MONITOR VERSION NO.
	CAIN	AC10,7		;TEST FOR 7.00 SERIES MONITOR
	SETOM	M7.00		;SET FLAG IF TRUE
	SETZ	FLG,		;INIT FLG REG
	PUSHJ	PP,GETFN	;SETUP LOOKUP BLOCK AC3-6
	MOVEM	AC3,GSBLK+1	;FILENAME FOR GETSEG & SETNAM
	MOVE	AC1,[7,,FBLK]	;FILOP. ARG BLOCK
	FILOP.	AC1,
	  JRST	FERROR		;ERROR
	SETZ	AC4,		;IOWD TERMINATOR
	MOVE	AC3,.JBFF
	HRLI	AC3,-2		;TWO WORDS FOR TOPS10
	IN	IO,AC3		;READ IT
	  SKIPA	AC2,1(AC3)	;(.JBFF)+1/	[TEMP.],,(.JBREL)
INERR:	JRST	[OUTSTR	[ASCIZ /?RRNCIE Input error from checkpoint file./]
		 EXIT]		;EXIT
	MOVE	AC4,2(AC3)
	MOVEM	AC4,CBLVER	;SAVE VERSION # (0 BEFORE V12)
>
IFN TOPS20,<
	PUSHJ	PP,GETFS	;READ FILE SPEC, GET JFN FOR FILE
	HRRZ	T1,CHKJFN
	MOVX	T2,17B9+OF%RD
	OPENF
	  JRST	LASTER		;ERROR
	HRRZ	T1,CHKJFN
	MOVEI	T2,IOWD1	;READ 3 WORDS
	DUMPI
	  JRST	INERR		;ERROR
	MOVE	AC2,SVJBRL	;.JBREL
>
	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
IFE TOPS20,<
	HRL	AC3,AC3
	HRRI	AC3,.JBDA-1
	SETZ	AC4,		;TERMINATOR
	IN	IO,AC3		;THE LOW SEGMENT
	  CAIA			;  SAVED "JDA" STARTS AT (.JBFF)
	JRST	INERR		;ERROR
>
IFN TOPS20,<
	HRLM	AC3,IOWD2+1	;STORE REAL LENGTH IN I/O WORD
	HRRZ	T1,CHKJFN
	MOVEI	T2,IOWD2	;POINT TO IOWD
	DUMPI
	  JRST	INERR
	MOVE	AC2,SVJBRL	;RESTORE .JBREL WORD
>
	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
IFE TOPS20,<
	RELEASE	IO,		;DONE WITH CHECKPOINT FILE NOW
>
IFN TOPS20,<
	HRRZ	T1,CHKJFN
	CLOSF
	  JRST	LASTER		;ERROR
	SKIPN	T2,SAVSTR	;GET THE STRING
	JRST	SCAN		;MUST BE V11 OR EARLIER
	MOVX	T1,GJ%OLD+GJ%SHT	;SHORT GTJFN
	GTJFN
	  JRST	GETHS		;NOT AVAILABLE, ASK USER
GOTHS:	HRLI	T1,.FHSLF	;THIS PROCESS
	TRO	T1,GT%ADR	;CHECK ADDRESS LIMITS
	MOVE	T2,[400,,577]	;ALL OF HIGH SEGMENT EXCEPT OTS
	GET
	JRST	SCAN		;OK

GETHS:	HRROI	T1,[ASCIZ /Type file spec of save file
*/]
	PSOUT
	MOVEI	T1,EXEARG	;ARG BLOCK FOR LONG GTJFN
	SETZ	T2,		;NO ASCII STRING
	GTJFN			;GET A JFN FOR .EXE FILE
	  JRST	LASTER		;ERROR
	JRST	GOTHS		;NOW TRY AGAIN

EXEARG:	GJ%OLD
	.PRIIN,,.PRIOU
	0
	0
	0
	[ASCIZ /EXE/]
	0
	0
	0

INERR:	HRROI	T1,[ASCIZ /?RRNCIE Input error from checkpoint file./]
	PSOUT
LASTER:	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	SETZB	T3,T4
	ERSTR
	  JFCL
	  JFCL
	HALTF
	EXIT		;EXIT

GETFS:	HRROI	T1,[ASCIZ /Type checkpoint file name
*/]
	PSOUT
	MOVEI	T1,CHKARG	;ARG BLOCK FOR LONG GTJFN
	SETZ	T2,		;NO ASCII STRING
	GTJFN			;GET A JFN FOR CHECKPOINT FILE
	  JRST	LASTER		;ERROR
	HRRZM	T1,CHKJFN	;SAVE JFN
	HRROI	T1,AFNAME	;CONVENIENT PLACE TO STORE FILE NAME
	HRRZ	T2,CHKJFN
	MOVX	T3,1B8		;FILE NAME ONLY
	JFNS
	DMOVE	AC1,[POINT 7,AFNAME
		POINT	6,GSBLK+1]
	MOVEI	AC4,6		;FIRST SIX CHARS ONLY
	SETZM	GSBLK+1		;CLEAN OUT ANY JUNK
GETFS1:	ILDB	C,AC1
	JUMPE	C,RET.1
	SUBI	C," "		;TURN INTO SIXBIT
	IDPB	C,AC2
	SOJGE	AC4,GETFS1
	POPJ	PP,

CHKARG:	GJ%OLD
	.PRIIN,,.PRIOU
	0
	0
	0
	[ASCIZ /CKP/]
	0
	0
	0
>

	;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,SCHN		;SET THE CHANNEL NUMBER
	TLNE	FLG,IDXFIL	; AN ISAM FILE??
	JRST	SCNISM		; YES, GO SET IT UP
	PUSHJ	PP,CCHR		;CHECK THE DEVICE CHARACTERISTICS
	PUSHJ	PP,SBH		;SAVE THE BUFFER HEADERS
	PUSHJ	PP,IDEV		;INIT THE DEVICE
SCAN3:	TLNE	FLG,IOFIL!RANFIL	;IO FILE?
	JRST	PUDSK		;POSITION UNBUFFERED DSK, IO FILE
	TXNE	AC15,DV.MTA	;MAG-TAPE?
	JRST	PMTA		;YES, POSITION MTA
	TXNE	AC15,DV.DSK	;DSK?
	JRST	PDSK		;POSITION BUFFERED DSK FILE
	PUSHJ	PP,RBH		;MUST BE TTY OR LPT
	JRST	SCAN1

	; OPEN AND SETUP ISAM IDX AND IDA FILES
	; FOR ISAM FILES ON TOPS10 THE IDX AND IDA DEVICE NAMES ARE
	; SAVED IN THE LOWSEG (ADDRESSED BY D.RD) TO BE AVAILABLE TO 
	; RERUN

	; FIRST THE IDX FILE

SCNISM:	MOVE	AC15,D.RD(I16)	; GET IDX DEV NAM (-20) OR ADDR OF SAME (-10)
IFE TOPS20,<
	MOVE	AC15,(AC15)	; TOPS10, GET DEVICE NAME SAVED IN LOW SEG
>
	PUSHJ	PP,ISMDEV	; CHECK DEVICE AND PUT NAME IN OPN/LKP/ETR BLK
	 JRST	SCNISM		; WRONG DEVICE, TRY AGAIN
	HLRZ	I12,D.BL(I16)	; GET BUFFER LOCATION
	MOVE	AC0,ICHAN(I12)	; GET IDX CHANNEL NUMBER
	PUSHJ	PP,SCHN1	; GO SET UP FOR IDX UUO'S
	MOVEI	AC0,.IODMP	; DUMP MODE
	HRRM	AC0,OBLK	; SETUP OPEN BLOCK
IFE TOPS20,<
	PUSHJ	PP,OPNCKP	; SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
	SETZM	OBLK+2 
	XCT	UOPEN
	  JRST	IDEV1		; OPEN ERROR

	; NOW LOOKUP AND POSSIBLY ENTER ON IDX FILE

	PUSHJ	PP,LKENTR	; DO IT, IDX IS "NORMAL CASE"

	; NOW CHECK AND SETUP IDA FILE

	PUSHJ	PP,SCHN		; GO SET UP FOR IDA UUO'S
	MOVEI	AC0,.IODMP	; DUMP MODE
	HRRM	AC0,OBLK	; SETUP OPEN BLOCK
IFE TOPS20,<
	PUSHJ	PP,OPNCKP	; SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>

IDADEV:

IFE TOPS20,<
	MOVE	AC15,D.RD(I16)	; GET ADDR OF SAVED DEVICE NAMES
>

IFN TOPS20,<
	MOVE	AC15,F.WDNM(I16) ; GET ADDR OF DEVICE NAME LIST
>
	MOVE	AC15,1(AC15)	; GET NAME OF IDA DEVICE
	PUSHJ	PP,ISMDEV	; CHECK IDA DEVICE FOR DSK
	 JRST	IDADEV		; WRONG, TRY AGAIN

	; NOW OPEN IDA FILE

IDAOPN:	SETZM	OBLK+2
	XCT	UOPEN
	  JRST	IDEV1		; OPEN ERROR


	; NOW DO LOOKUP/ENTER FOR IDA FILE

	HLRZ	I12,D.BL(I16)	; GET BUFFER LOCATION
	MOVE	AC2,[POINT 6,DFILNM(I12)] ; GET PTR TO IDA FILE NAME
	PUSHJ	PP,SLEBK0	; GET IDA LKP/ENT BLK SETUP
	XCT	ULOOK		; LOOKUP
	  JRST	LKER		; ERROR RET
	TLNN	FLG,OPNOUT	; SKIP IF OPEN FOR OUTPUT
	JRST	SCAN1		; OK, RETURN TO FILTAB SCAN LOOP
	HLRZ	I12,D.BL(I16)	; GET BUFFER LOCATION
	MOVE	AC2,[POINT 6,DFILNM(I12)] ; GET PTR TO IDA FILE NAME
	PUSHJ	PP,SLEBK0	; GET IDA LKP/ENT BLK SETUP
	XCT	UENTR		; ENTER
	  JRST	ENER		; ERROR
	JRST	SCAN1		; OK, RETURN TO FILTAB SCAN LOOP

	; ISMDEV ASSUMES DEVICE NAME IN AC15 (SIXBIT)
	; THE ROUTINE CHECKS IT TO BE ASSIGNED AND A DSK
	; SKIP RETURN IF ALL OK
	; NON-SKIP RETURN IF MUST REASSIGN AND TRY AGAIN

ISMDEV:	MOVEM	AC15,OBLK+1	; PUT DEVICE NAME INTO UUO BLK
	DEVCHR	AC15,		; GET DEVICE CHARACTERISTICS
	JUMPE	AC15,ISNDV	; JUMP IF DEVICE IS NOT ASSIGNED	
	TXNE	AC15,DV.DSK	; SKIP IF DEVICE NOT STILL A DSK
	JRST	RET.2		; OK, GO OPEN IT
ISNDV:	TXO	AC15,DV.DSK	; INDICATE WANT DSK
	JRST	ASSD		; GO GIVE ASSIGN MESSAGE AND TRY AGAIN



	; OPNCKP SETS CHECKPOINT OUTPUT MODE FOR TOPS10 OPEN, WHEN INDICATED

IFE TOPS20,<
OPNCKP:	SKIPN	M7.00		; IS IT 7.00 OR LATER?
	POPJ	PP,		; NO
	LDB	AC1,F.BCKP	; IS RIB UPDATE REQUIRED
	JUMPE	AC1,RET.1	; NO
	MOVX	AC1,UU.RRC	; OPEN RIB UPDATE FUNCTION
	IORM	AC1,OBLK	; YES, SET IT
	POPJ	PP,
>

	;RESTORE THE CHECKPOINT FILE JOBDATA AREA

GSEG:	CLRBFI			;CLEAR TTY BUFFER -- SELOTS NO LONGER DOES	[EDIT#1]
	MOVE	T1,GSBLK+1	;CKP FILENAME
IFE TOPS20,<
	SETNAM	T1,		;SETNAM UUO
>
IFN TOPS20,<
	SETNM			;SETNAM JSYS
>
	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)
	SETDDT	AC1,		;SETDDT UUO
	MOVE	AC1,.JBSYM(AC2)
	MOVEM	AC1,.JBSYM
	MOVE	AC1,.JBAPR(AC2)
	MOVEM	AC1,.JBAPR
	MOVX	AC1,AP.POV!AP.ILM!AP.NXM
	APRENB	AC1,		;APRENB UUO
	MOVE	AC1,.JBVER(AC2)
	MOVEM	AC1,.JBVER
	SKIPN	CBLVER		;TEST FOR V12
	JRST	GSEG11		;NO, V11 OR EARLIER
IFE TOPS20,<
	HRRZI	AC1,GSBLK	;IN CASE WE'RE REENTRANT [EDIT#7]

>
IFN TOPS20,<
	MOVE	T4,SAVSTR	; GET HIGH SEG BYT PTR FOR REENT LIBOL  [EDIT#7]
>
	HRRZ	AC2,START.	;FIND "JSP 16,COBST."
	CAIL	AC2,ST		; DISPATCHING BELOW RERUN??
	 JRST	NOHIGH		; NO,BAD RELOCATABLE LIBOL CASE
	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 IF THE LOCATION OF THE START CODE FOR THE COBOL PROGRAM
	; IS WITHIN THE RERUN CODE, IE THE PROGRAM HIGHSEG HAS NOT
	; BEEN LOADED BELOW RERUN (USUALLY A SLASH-R TOPS10 CASE)

NOHIGH:	OUTSTR	[ASCIZ %
?RRNHSI The program high segment is inaccessable to RERUN. Recompile without "/R" switch.
%]
	PUSHJ	PP,CLSFIL
	EXIT			;EXIT

;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
	CORE	16,		;FROM HIGH SEGMENT
	  HALT	.		;CAN NEVER HAPPEN
GS.GET:!GETSEG	AC1,		;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,D.OBH(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
	TXO	AC1,BF.VBR	;NEVER REFERENCED
	MOVEM	AC1,D.OBH(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
	TXZ	AC2,BF.VBR	;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,D.OBH(I16)	;  POINT TO NEXT BUF
	MOVEM	AC1,BHSAV+1	;SAVE IT
	MOVE	AC1,D.OBH(I16)	;MAKE NEXT BUFFER
	MOVEM	AC1,BHSAV	;  BECOME THE CURRENT BUFFER

	;RESTORE THE BUFFER HEADERS
RBH1:	HRLI	AC0,BHSAV	;FROM
	HRRI	AC0,D.OBH(I16)	;TO
	BLT	AC0,D.IBC(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)
	TXZ	AC3,BF.VBR	;CLEAR BUF-USE-BIT
	MOVEM	AC3,(AC2)	;SAVE IT
	CAIE	AC1,(AC3)	;PREVIOUS BUFFER?
	JRST	RBH3		;NO
	HRLI	AC2,(BF.VBR)	;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]
SCHN1:	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:	OUTSTR	[ASCIZ/
?RRNFOZ Cannot RERUN with file OPEN on channel 0/]	; [4]

	EXIT			; 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
	DEVCHR	AC1,		;DEVCHR UUO
	JUMPE	AC1,ASSD	;ASSIGN DEVICE MESSAGE
	TDZ	AC1,[XWD 434000,-1] ;CLEAR UNWANTED BITS
	TXNN	AC1,DV.AVL	;AVAILABLE?
	JRST	ASSD1		; NO, GIVE MESSAGE AND TRY AGAIN
	TDZ	AC1,AC15	;OK?
	JUMPN	AC1,ASSD1	; NO, GIVE MESSAGE AND TRY AGAIN
	POPJ	PP,

ASSD1:	PUSHJ	PP,ASSD		; GO GIVE MESSAGE
	JRST	CCHR		; GO TRY AGAIN



	;INIT THE DEVICE WITH AN OPEN UUO

IDEV:	SKIPGE	FLG
	TDZA	AC6,AC6		;ASCII MODE
	MOVEI	AC6,.IOBIN	;BINARY MODE
	TLNE	FLG,IOFIL!RANFIL
	MOVEI	AC6,.IODMP	;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:	OUTSTR	[ASCIZ /
?RRNOFF OPEN failed for/]
	PUSHJ	PP,SDN		;DEVICE DEV
	EXIT	1,		;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,D.OE(I16)	;NUMBER OF OUTPUTS
	TLNN	AC1,-1		; IF GREATER THAN 777777
	CAILE	AC1,-11		;  OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		;YES USE FILOP. TYPE USETO
	 XCT	USETO
	PUSHJ	PP,RBH		;RESTORE THE BUFFER HEADER
	JRST	SCAN1		;NEXT DEVICE

PDSKI:	MOVE	AC1,D.IE(16)	;NUMBER OF INPUTS
	TLNN	AC1,-1		; IF GREATER THAN 777777
	CAILE	AC1,-11		;  OR BETWEEN 777770 AND 777777
	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,LKENTR	; LOOKUP AND ENTER
	MOVE	AC1,D.CBN(I16)	; BLOCK NUMBER FOR USETO
	JUMPE	AC1,PUDSK1	; SKIP SUB IF ZERO, POSITION TO 1ST BLK
	SUBI	AC1,1		; SUB HERE SINCE USETO: INCREMENTS BY 1
	TLNN	AC1,-1		; IF GREATER THAN 777777
	CAILE	AC1,-11		;  OR BETWEEN 777770 AND 777777
	PUSHJ	PP,FUSO		; YES USE FILOP. TYPE USETO
PUDSK1:	 XCT	USETO
	JRST	SCAN1		;NEXT


	; LOOKUP THE FILE, IF OPEN FOR OUTPUT ALSO DO ENTER

LKENTR:	PUSHJ	PP,SLEBK	;SETUP LOOKUP BLK
	XCT	ULOOK		;LOOKUP
	  JRST	LKER		;ERROR RET
	TLNN	FLG,OPNOUT!RANFIL ; SKIP IF OUTPUT,RANDOM
	POPJ	PP,		; OTHERWISE RETURN
	PUSHJ	PP,SLEBK	;ENTER BLK
	XCT	UENTR		;ENTER
	  JRST	ENER		;ERROR
	POPJ	PP,		; RETURN, ALL OK


	;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
IFN TOPS20,<
	PUSHJ	PP,MTASTS	; GET MTA STATUS INFO INTO TMP.BK
	 JRST	MTSTER		; ERROR CAN'T GET MTA STATUS
>
	PUSHJ	PP,SETDEN	; SET TAPE DENSITY (THS CAL MUST BE BFR SETHRD)
	 JRST	DENERR		; ERROR, CAN'T SET DENISTY
	PUSHJ	PP,SETHRD	; SET PROPER HARDWARE DATA MODE
	 JRST	HRDERR		; ERROR, CAN'T SET DATA MODE
	JRST	SCAN1		;...NEXT FILE
	
IFN TOPS20,<

; MTASTS	ROUTINE TO READ MTA STATUS INTO TMP.BK ON TOPS20
;
; ARG		AC16 ADDRESSES MTA FILE TAB
;
; RETURNS	+1 IF ERROR
;		+2 IF OK, STATUS INFO IN TMP.BK
; USES		AC0-AC3,TMP.BK


MTASTS:	LDB	AC2,DTCN.	; GET MTA'S CHANNEL NUMBER
	PUSHJ	PP,GETJFN	; GET JFN IN AC1
	 POPJ	PP,		; ERROR RETURN
	MOVEI	AC2,.MODDM+1	; LENGTH OF ARG BLOCK
	MOVEM	AC2,MTASTF	; SET BLOCK LENGTH
	SOJE	AC2,MTSTSA	; LOOP ILL ARG BLOCK CLEAR
	SETZM	MTASTF(AC2)	; CLEAR ARG WORD
	JRST	.-2		; LOOP
MTSTSA:	MOVEI	AC2,.MOSTA	; GET TAPE STATUS FUNCTION
	MOVEI	AC3,MTASTF	; ADDR OF ARG BLOCK
	MTOPR			; DO IT
	 ERJMP	RET.1		; IF ERROR EXIT ASSUMING IND-ASC
	JRST	RET.2		; GOOD RETURN , STATUS IN MTASTF

>; END IFN TOPS20

; SETHRD	ROUTINE TO SET HARDWARE DATA MODE
;
; ARG		AC16 ADDRESSES FILTAB, ASSUMES MTASTS HAS LEFT STATUS INFO
;		IN MTASTF FOR TOPS20
;
; RETURNS	+1 IF ERROR
;		+2 IF OK
; USES		AC0-AC3

	; CHECK FOR RECORDING MODE

SETHRD:	HRRZ	AC1,D.RFLG(I16)	; GET STANDARD ASCII FLAG
	TRNN	AC1,SASCII	; STD-ASCII REQUEST?
	JRST	STHRD1		; NO
	TRNE	AC1,INDASC	; YES,IND-ASCII?
	JRST	STHRD2		; YES
	PUSHJ	PP,STDASC	; NO, SET STD-ASCII
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN


	; CHECK FOR EBCDIC TAPE

STHRD1:	TLNN	FLG,DDMEBC	; RECORDING MODE EBCDIC?
	JRST	RET.2		; NO,DEFAULT OK, GOOD RETURN
STHRD2:	PUSHJ	PP,INDCMP	; YES, SET INDUSTRY COMPATIBLE MODE
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN

	; HERE TO SET INDUSTRY COMPATIBLE MODE

INDCMP:	; FIRST CHECK FOR PROPER MODE SUPPORT
	; ON TOPS20 CHECK MODE SUPPORT IN STATUS BLOCK

IFN TOPS20,<
	MOVE	AC2,MTASTF+.MODDM ; GET DATA MODES WORD (SET IN SETDEN)
	TXNN	AC2,SJ%CM8	; IS IND-COMPT SUPPORTED?
	 POPJ	PP,		; NO,ERROR RETURN
>; END IFN TOPS20

	; ON TOPS10 CHECK FOR 9 TRACK TAPE

IFE TOPS20,<
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	MTCHR.	AC1,		; GET CHARACTERISTICS
	 SETZ	AC1,		; ERROR RET - ASSUME 9TRK
	TRNE	AC1,MT.7TR	; 9 TRACKS?
	JRST	RET.2		; NO, 7 TRACK, ALLOW DEFAULT-NON-IND-CMPT
>; END IFE TOPS20

	; OK, SET INDUSTRY COMPATIBLE MODE

	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC2,.TFM8B	; INDUSTRY-COMPATIBLE MODE
	PUSHJ	PP,TAPMOD		; GO SET IT
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN

	; SET STD-ASCII HARDWARE DATA MODE

STDASC:
	; FIRST CHECK FOR PROPER MODE SUPPORT
	; ON TOPS20 CHECK MODE SUPPORT IN STATUS BLOCK

IFN TOPS20,<
	MOVE	AC2,MTASTF+.MODDM ; GET DATA MODES WORD (SET IN SETDEN)
	TXNE	AC2,SJ%CMA	; IS STD-ASCII SUPPORTED?
	 POPJ	PP,		; NO,ERROR RETURN
>; END IFN TOPS20

	; ON TOPS10 CHECK CONTROLLER TYPE

IFE TOPS20,<
	HRLZI	AC3,2		; LENGTH ,, ADDR
	MOVEI	AC0,.TFKTP	; FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; GET CONTROLER TYPE
	 POPJ	PP,		; ERROR, BAD RETURN
	CAIE	AC3,.TFKTX	; TX01 CONTROLLER (TU70/TU71)?
	CAIN	AC3,.TFKTM	;  OR TM02(TU16/TU45)
	JRST	PMTA4		; YES
	CAIE	AC3,.TFKD2	; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
	POPJ	PP,		; ERROR - WRONG TYPE, BAD RETURN

>; END IFE TOPDS20

PMTA4:	MOVEI	AC2,.TFM7B	; STANDARD ASCII MODE
	PUSHJ	PP,TAPMOD	; GO SET IT
	 POPJ	PP,		; ERROR, BAD RETURN
	JRST	RET.2		; OK, GOOD RETURN


; SETDEN	ROUTINE TO CHECK AND SET TAPE DENSITY
;
; ARG		AC16 ADDRESSES FILTAB, ASSUMES MTASTS HAS LEFT STATUS INFO
;		IN MTASTF FOR TOPS20
;
; RETURNS:	+1 IF ERROR
;		+2 IF OK, DENSITY IS SET
; USES		AC1-AC3

SETDEN:	LDB	AC3,F.BDNS	; GET DENSITY REQUESTED
	JUMPE	AC3,RET.2	; CORRECT RETURN IF DEFAULT USED

IFE TOPS20,<

	; DO TAPOP TO CHECK POSSIBLE TAPE DENSITIES
	HRLZI	AC2,2		; 2 ARGS START AT AC0
	MOVEI	AC0,.TFPDN	; FUNCTION TO READ POSSIBLE DENSITY
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC2,		; READ POSSIBLE DENSITY
	 POPJ	PP,		; ERROR, GIVE ERROR RETURN

>;END IFE TOPS20

IFN TOPS20,<

	MOVE	AC2,MTASTF+.MODDN ; GET DENSITY CODES
	LDB	AC3,F.BDNS	; GET DENSITY REQUESTED
	
>;END IFN TOPS20

	XCT	DENTAB-1(AC3)	; TEST PROPER BIT
	 POPJ	PP,		; ERROR, DENSITY NOT POSSIBLE
				; SKIP RETURN, DENSITY POSSIBLE



	; HERE IF DENSITY IS POSSIBLE, SET IT

	MOVE	AC2,AC3		; REQUESTED DENSITY
	HRLZI	AC3,3		; LENGTH,,ADR
	MOVEI	AC0,.TFSET+.TFDEN	; SET DENSITY FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; SET IT
	 POPJ	PP,		; ERROR, RETURN SUCH

	;NOW GET/CHECK DENSITY
	HRLZI	AC3,2		; LEN,,ADR
	MOVEI	AC0,.TFDEN	; GET DENSITY FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; GET DENSITY
	 POPJ	PP,		; ERROR, RETURN SUCH
	CAME	AC2,AC3		; CHECK IT
	 POPJ	PP,		; ERROR, RETURN SUCH
	JRST	RET.2		; OK, ITS SET RIGHT GIVE OK RETURN

IFE TOPS20,<

	; TABLE TO TEST RESULTS OF .TFPDN TAPOP

DENTAB:	TXNN	AC2,TF.DN1	; TEST IF 200 BPI
	TXNN	AC2,TF.DN2	; 	  556 BPI
	TXNN	AC2,TF.DN3	; 	  800 BPI
	TXNN	AC2,TF.DN4	; 	 1600 BPI
	TXNN	AC2,TF.DN5	; 	 6250 BPI

>;END IFE TOPS20

IFN TOPS20,<

	; DENTAB IS TABLE OF TESTS FOR .MOSTA MTOPR (AC0 HAS CODE RETURNED)

DENTAB:	TXNN	AC2,SJ%CP2	; TEST IF 200 BPI
	TXNN	AC2,SJ%CP5	; 	  556 BPI
	TXNN	AC2,SJ%CP8	; 	  800 BPI
	TXNN	AC2,SJ%C16	; 	 1600 BPI
	TXNN	AC2,SJ%C62	; 	 6250 BPI



; GETJFN	ROUTINE TO GET JFN FROM PA1050 USING COMPT. UUO
;
; ARGS		AC2=CHAN NUMBER
;
; RETURNS	NON-SKIP	ERROR RETURN
;		SKIP		OK, AC1=JFN
;
; USES		AC1,AC2
;

GETJFN:	HRLZ	AC2,AC2		;GET CHAN NUM IN LEFT,AS ARG TO COMPT.
	HRRI	AC2,CMPJFN	;SET COMPT. FUNCTION NUM FOR CHAN TO JFN
	MOVE	AC1,[1,,2]	;INDICATE 1 ARG IN ADDR 2
	COMPT.	AC1,		;GET JFN ************* 
	 POPJ	PP,		; ERROR RETURN
	JRST	RET.2		; OK, RETURN

>;END IFN TOPS20


; TAPMOD	ROUTINE TO SET TAPE HARDWARE DATA MODE
;
; ARG		AC2=DAT-MODE CODE TO BE SET
; USES		AC0-AC3
; RETURNS	+1	ERROR
;		+2	OK

TAPMOD:	HRLZI	AC3,3		; LENGTH ,, ADDR
	MOVEI	AC0,.TFSET+.TFMOD	; FUNCTION
	LDB	AC1,DTCN.	; GET MTA'S CHANNEL NUMBER
	TAPOP.	AC3,		; CHANGE MODE
	 POPJ	PP,		; ERROR - RETURN +1
	JRST	RET.2		; OK, SKIP RETURN






	;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK

SLEBK:	MOVE	AC2,F.WVID(16)	;BP TO VALUE OF ID
SLEBK0:	MOVE	AC1,[POINT 6,LEBLK]
	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
	HRRZ	AC1,F.RPPN(I16)	;GET ADR OF PP
	JUMPE	AC1,RET.1	;EXIT IF NONE SPECIFIED
	MOVE	LEBLK+3,(AC1)	;INSERT IN LOOKUP BLOCK
	CAIGE	AC1,ST		;ERROR IF IN HISEG
	POPJ	PP,

SLEBK5:	OUTSTR	[ASCIZ %
?RRNIDI VALUE-OF-ID or USER-NUMBER is inaccessable. Recompile without
	"/R" switch, or use "DATA-NAME" and not a "literal" as object
	of "VALUE-OF-ID" or "USER-NUMBER" clause.
%]
	PUSHJ	PP,CLSFIL
	EXIT			;EXIT

	;CLOSE ALL FILES, BUT DONT SUPERCEDE

CLSFIL:	MOVE	AC1,[CLOSE 1,CL.RST]
CLSFI1:	XCT	AC1
	ADD	AC1,[Z 1,,0]
	SKIPGE	AC1,[CLOSE 17,CL.RST]
	JRST	CLSFI1
	POPJ	PP,

	;LOOKUP/ENTER ERROR MESSAGES

ENER:	OUTSTR	[ASCIZ /
?RRNEFF ENTER failed for file /]
	SKIPA
LKER:	OUTSTR	[ASCIZ /
?RRNLFF LOOKUP failed for file /]
	MOVE	AC1,[POINT 6,LEBLK]
	MOVEI	AC4,6		;6 CHAR NAME
	PUSHJ	PP,SOUT		;SIXBIT OUT
	OUTSTR	[ASCIZ /./]
	MOVE	AC1,[POINT 6,LEBLK+1]
	MOVEI	AC4,3		;3 CHAR EXT
	PUSHJ	PP,SOUT
	HRRZ	AC1,LEBLK+1	;PICKUP THE ERROR BITS
	CAILE	AC1,MAXERR
	MOVEI	AC1,MAXERR
	OUTSTR	@LEMSG(AC1)	;COMPLAIN
	PUSHJ	PP,CLSFIL	;CLOSE FILES WITH NO SUPERCEEDING
	EXIT	1,		;EXIT, WAIT FOR CONT
	JRST	SCAN3		;START OVER AGAIN

IFE TOPS20,<
FERROR:	OUTSTR	[ASCIZ /?RRNCFL Checkpoint file LOOKUP failed/]
	HRRZ	AC1,AC4
	CAILE	AC1,MAXERR
	MOVEI	AC1,MAXERR
	OUTSTR	@LEMSG(AC1)
	EXIT	
>

	; HERE FOR MTA DENSITY-DATA MODE ERRORS

MTSTER:	OUTSTR	[ASCIZ "
?RRNSTS unable to get MTA status info for"]
	PUSHJ	PP,SDN		; TYPE DEVICE NAME
	EXIT

DENERR:	OUTSTR	[ASCIZ "
?RRNDEN unable to get/set required density for"]
	PUSHJ	PP,SDN		; TYPE DEVICE NAME
	EXIT

HRDERR:	OUTSTR	[ASCIZ "
?RRNHRD unable to set required hardware data mode for"]
	PUSHJ	PP,SDN		; TYPE DEVICE NAME
	EXIT

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

LEMSG:	[ASCIZ	/ (0) file not found/]
	[ASCIZ	/ (1) UFD does not exist/]
IFN TOPS20,<
	[ASCIZ	/ (2) protection failure/]
>
IFE TOPS20,<
	[ASCIZ	/ (2) protection failure or DTA directory full/]
>
	[ASCIZ	/ (3) file being modified/]
	[ASCIZ	/ (4) already existing file name/]
	[ASCIZ	/ (5) illegal sequence of UUOs/]
	[ASCIZ	. (6) device or UFD/RIB data error.]
	[ASCIZ	/ (7) not a save file/]
	[ASCIZ	/ (10) not enough core/]
	[ASCIZ	/ (11) device not available/]
	[ASCIZ	/ (12) no such device/]
	[ASCIZ	/ (13) GETSEG requires two relocation registers/]
	[ASCIZ	/ (14) quota exceeded or no room on file structure/]
	[ASCIZ	/ (15) write-locked file structure/]
	[ASCIZ	/ (16) not enough monitor table space/]
	[ASCIZ	/ (17) partial allocation only/]
	[ASCIZ	/ (20) allocated block not free/]
	[ASCIZ	/ (21) can't supersede a directory/]
	[ASCIZ	/ (22) can't delete a non-empty directory/]
	[ASCIZ	/ (23) SFD not found/]
	[ASCIZ 	/ (24) search list empty/]
	[ASCIZ	/ (25) SFD nest level too deep/]
	[ASCIZ	/ (26) no-create for all search list/]
	[ASCIZ	/ (27) segment not on swap space/]
	[ASCIZ	/ (30) can't update file/]
	[ASCIZ	/ (31) low seg overlaps hi seg/]
	[ASCIZ	/ (32) not logged in/]
	[ASCIZ	/ (33) file still has outstanding locks set/]
	[ASCIZ	/ (34) bad .EXE file directory/]
	[ASCIZ	/ (35) bad extension for .EXE file/]
	[ASCIZ	/ (36) .EXE directory too big/]
	[ASCIZ	/ (37) TSK - exceeded network capacity/]
	[ASCIZ	/ (40) TSK - task not available/]
	[ASCIZ	/ (41) TSK - undefined network node/]

	[ASCIZ	/ (?)/]
MAXERR==.-LEMSG-1		;ONE MORE THAN MAX. ERROR DEFINED AS YET

	;FAILED DEVCHR TEST, ASSIGN DEVICE LOGICAL NAME

ASSD:
IFE TOPS20,<
	OUTSTR	[ASCIZ /
Assign /]
>
IFN TOPS20,<
	HRROI	T1,[ASCIZ /
Define /]
	PSOUT
	PUSHJ	PP,SDN1		;TELL USER LOGICAL NAME
	HRROI	T1,[ASCIZ /: (as) /]
	PSOUT
>
	TXNE	AC15,DV.DSK
	MOVEI	AC1,[ASCIZ /DSK: /]
	TXNE	AC15,DV.LPT
	MOVEI	AC1,[ASCIZ /LPT: /]
IFE TOPS20,<
	TXNE	AC15,DV.DTA
	MOVEI	AC1,[ASCIZ /DTA: /]
>
	TXNE	AC15,DV.MTA
	MOVEI	AC1,[ASCIZ /MTA: /]
	TXNE	AC15,DV.TTY
	MOVEI	AC1,[ASCIZ /TTY: /]
	TXC	AC15,DV.DSK+DV.MTA	;TEST FOR NUL
	TXCN	AC15,DV.DSK+DV.MTA
	MOVEI	AC1,[ASCIZ /NUL: /]
	OUTSTR	(AC1)
IFE TOPS20,<
	PUSHJ	PP,SDN1		;TELL USER LOGICAL NAME
>
	OUTSTR	[ASCIZ /
Type continue when done
/]
	EXIT	1,		;EXIT, WAIT FOR CONT
	POPJ	PP,		;TRY AGAIN

	;TYPE OUT THE DEVICE NAME

SDN:	OUTSTR	[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
	ILDB	C,AC1
	CAIE	C,0		;TERMINATE ON SPACE
	SOJGE	AC4,SOUT	;  OR ELEVENTH CHAR
	JRST	OBUF		;AND POPJ

IFE TOPS20,<
IC:	OUTSTR	[ASCIZ /?RRNILC Illegal character, /]
GETFN0:	CLRBFI			;CLEAR THE BUFFER
GETFN:	OUTSTR	[ASCIZ /Type checkpoint file name
*/]
	MOVE	AC1,[POINT 6,AC3]
	MOVEI	AC0,6		;6 FILENAME CHARS
	HRLZI	AC4,'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:	TXOE	FLG,PERFLG	;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:	INCHRS	C
	INCHWL	C
	POPJ	PP,
>

O6BT:	ADDI	C,40		;CONVERT TO ASCII
	IDPB	C,OBP		;CHAR TO BUFFER
	SOSLE	OBC		;IS BUFFER FULL?
	POPJ	PP,		;NO, RETURN
OBUF:	SETZ	C,		;YES
	IDPB	C,OBP		;TERMINATE IT
	OUTSTR	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,

	;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	[OUTSTR	[ASCIZ /?RRNFIF Unable to position data file, USETI (FILOP.) failed./]
		EXIT]		;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	[OUTSTR	[ASCIZ /?RRNFOF Unable to position data file, USETO (FILOP.) failed./]
		EXIT]		;EXIT
RET.2:	AOS	(PP)		;SKIP EXIT
RET.1:	POPJ	PP,


GETCOR:	CORE	AC0,		;CORE UUO
	  CAIA			;ERROR RET
	POPJ	PP,		;NORM RET
GETCO1:	OUTSTR	[ASCIZ /?RRNNEC Insuficient core./]
	EXIT			;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:	OUTPUT		;DUMMY OUTPUT
OBLK:	BLOCK	3	;FOR OPEN UUO
LUUO== .-4		;LAST UUO		[EDIT#3]

	;ARG BLOCKS FOR FILOP. TYPE USETI/O
FUSIA:	EXP	.FOUSI	;FUNCTION = USETI
	0
FUSOA:	EXP	.FOUSO	;FUNCTION = USETI
	0

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.

SVJBRL:	BLOCK	1	;.JBREL FROM CHECKPOINT FILE
CBLVER:	BLOCK	1	;VERSION NO. OF FILE
IFN TOPS20,<
SAVSTR:	BLOCK	1	;POINTER TO JFN STRING FOR SAVE FILE
>

IFN TOPS20,<		;TOPS-20 SPECIFIC DATA


MTASTF:	EXP	.MODDM+1	; LENGTH OF ARG BLOCK
	BLOCK	.MODDM		; ARG BLOCK FOR MTA STATUS MTOPR.
CHKJFN:	BLOCK	1	;JFN OF CHECKPOINT FILE
AFNAME:	BLOCK	8	;FILE NAME IN ASCIZ
IOWD1:	IOWD	3,SVJBRL
	0
IOWD2:	IOWD	175,.JBDA	;READ REST OF TOPS-10 128 WORD BLOCK
	IOWD	1,.JBDA		;REAL I/O WORD
	0
>

IFE TOPS20,<		;TOPS-10 SPECIFIC DATA

M7.00:	BLOCK	1	; FLAG TO INDICATE TOPS-10 VERSION 7.00
FBLK:	IO,,.FORED	;FILOP. READ FUNCTION
	EXP	.IODMP
	SIXBIT	/DSK/
	0
	0
	EXP	AC3
	0

F.BCKP:	F%BCKP		; CHECKPOINT ISAM FLAG
>

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

END.:	END	ST