File F1115.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/EXTENDED COMMANDS FOR PS/8 -
	XLIST

/RUNS WITH PS8.002.II.2 OR LATER
/STRUCTURE IS VERY RIGID-

/**UPDATE**
/10/25/73	DEW
/	CODING FOR PUTTING PAL12 INTO THE COMPILE
/COMMAND ADDED.  ALSO MADE GTL A CONDITIONAL ASSEMBLY.
/NOTE THAT CURRENTLY BOTH PAL12 AND GTL ARE NOT COMPATIBLE
/AS THE PAGE LACKS 2 LOCATIONS.  TO INSERT BOTH MERELY
/MAKE THE MESSAGE AT COMPXX 4 CHARACTERS SHORTER.

/8/7/73 	DEW
/	ADDITION OF SQUASH AND "HD".
/	REQUIRED MOVING THE EDIT AND CREATE PROCESSOR
/	OUT TO THE END OF COMPIL.  WE ARE GETTING TOO
/	MANY COMMANDS.

/7/25/73	DEW
/	ADDITION OF THE RECOVERABLE "ZERO" COMMAND
/	NOW THAT WE HAVE A PARAMETER BLOCK.

/6/29/73	DEW
/	ADDITION OF HELP AND LIST COMMANDS TO SYSTEM

/5/21/73	JRC
/	ADDITION OF FORTRAN IV CODE - SET FORTIV=1 IN A
/	DEFINITION FILE - .FT COMPILES GO TO F4, EXECUTE
/	COMMAND RUNS .LD FILE
/	.F2 CALLS OS/8 FORTRAN FOR THOSE WHO NEED BOTH ON SYS

/5/9/73 	DEW
/	ALLOW  C TO STOP ERROR PRINTOUTS.

/4/10/73	DEW
/	HAVE COMPLETED REVISION OF COMPILE TO IMPLEMENT
/	DEFAULTS TO DSK AND THE EXTENDED TECO COMMAND.
/	THE TECO COMMAND NOW HAS A "/E" OPTION WHICH WILL
/	EXECUTE THE FIRST PAGE OF THE INPUT FILE AS A TECO
/	MACRO.	THE EFFECTIVE TECO MACRO TO START IS
/		EBXXXX$YHXAMA$$
/	  OR	EWXXX$ERXXXX$YHXAMA$$
/	THE FIRST PAGE OF THE INPUT FILE MUST CONSIST OF
/	LESS THAN APPROX 1000 CHARACTERS OR THERE WILL BE A
/	Q-REGISTER OVERFLOW.  NO CHECKING IS MADE FOR THIS
/	CONDITION.

/	THE COMPILE COMMAND NOW ACCEPTS MULTIPLE INPUT
/	FILES SEPARATED BY COMMAS: THE DEFAULT EXTENSION
/	(AFTER THE FIRST WHICH IS .PA) IS THE FIRST SPECIFIED
/	EXTENSION: AND A NULL NAME EXTENSION MAY BE INPUT
/	FOR THE FIRST INPUT FILE TO OVERRIDE THE DEFAULT
/	.PA OR IF THE FILES HAVE FUNNY EXTENSIONS.

/	CAREFUL ATTENTION MUST BE PAID TO THE PAGE IN CORE
/	CONTAINING THE "CHAI" SUBROUTINE AS THERE IS SOME
/	FUNNY BUSINESS THAT GOES ON TO GET MORE SUBROUTINE
/	ROOM.  SEE THE COMMENTS ON THAT PAGE.

/	A FEW NEW SUBROUTINES EXIST "GDSKDN", "GTDEV", AND
/	"GSWITCH" FOR UTILITY.	THEY ARE PART  OF THE FUNNY
/	BUSINESS MENTIONED IN THE ABOVE PARAGRAPH.

/	THE .SUBMIT COMMAND IS WORKING WHICH SUBMITS
/	A FILE TO HASP.  I SOON EXPECT TO ALLOW INPUTTING
/	FILES TO HASP ON DEVICES OTHER THAN SYS.  THE INITIAL-
/	IZATION CODE IN HASP WILL BE CHANGED TO COPY
/	SUCH FILES INTO A FILE ON THE SYSTEM CALLED HASPTM.BT.

/4/4/73 DEW
/	ATTEMPTING TO FIX UP THE COMPILE COMMAND
/	TO ALLOW MULTIPLE INPUT FILENAMES AND
/	A NULL NAME CONSTRUCT (.EX) TO SPECIFY
/	THE PROCESSOR.	SYNTAX:
/	  .CO <BIN OVER=><.EX,><DEV:>NAME1,NAME2 <OPT></OP>
/	WHERE <.EX> IS OVERRIDING PROCESSOR CALL EXT.


/4/3/73 DEW
/	COMPLETE REDO OF THE TECO AND MAKE COMMAND TO ALLOW
/	DEFAULT DEVICE DSK, DEVICES OTHER THAN SYS: AND
/	A DIFFERENT OUTPUT DEVICE THAN INPUT.  THE NEW
/	CONSTRUCTION IS
/		.TECO <DEV:>NAME<.EX><=DEV2>
/		.MAKE <DEV:>NAME<.EX>
/	WHERE DEFAULT DEV:=DSK
/		<DEV:>NAME<.EX> = INPUT FILE
/		DEV2:NAME<.EX> = OUTPUT FILE

/3/8/73 	D.E.W.
/	ADDITIONS TO IMPLEMENT "FOCAL" COMMAND.
/	MAY BE DELETED BY DEFINING FOCAL=0
/7/6/72
/	CORRECTED TO KEEP FROM DESTROYING IMAGE
/	WHEN NO DEVICE HANDLER LOADED
	IFNDEF FORTIV <FORTIV=0>
	IFNDEF GTL <GTL=0>


	IFNDEF FOCAL <FOCAL=1>

/THE FOLLOWING DEFINES ARE DEPENDENT UPON THE MONITOR
	GNAME=30
	LXR=14
	X1=15
	NM1=31
	NM2=NM1+1
	NM3=NM2+1
	NM4=NM3+1
	SYSTEM=25
	DEVHND=35
	TEMP1=21
	TEMP2=22
	TM1=23
	TMP1=24

	K7605=0110	/CURRENTLY A LITERAL * * * WILL CHANGE!
	KJSBIT=170	/DITTO

	HANDLA=27	/WAS POINTER TO ROUTINE NO LONGER IN CORE

	UDNAME=7741

	IFNZRO CMPR-600 <+=CMPR>
	IFNZRO PRNM-621 <+=PRNM>
	IFNZRO PCH-641 <+=PCH>
	IFNZRO PRMG-701 <+=PRMG>
	IFNZRO DVNM-716 <+=DVNM>
	IFNZRO LDHN-725 <+=LDHN>

/	ABSOLUTE LOCATIONS IN UMOUNT

/ORIGINAL LOAD CALLS FIRST FOUR PAGES INTO LOCS 0600-1577
/THE REST IS UP TO THIS PROGRAM.
/HOWEVER, PAGE AT 0200 CONTAINS SOME ROUTINES USED
/AND PAGE AT 1600 CONTAINS THE LINE BUFFER
	*0	/FOR THE LOADER

	NOPUNCH;*600;ENPUNCH
	THISPAGE=.

CMPR,	0		/COMPARE DISPATCH ROUTINE
	DCA CMPRTM	/STORE ACC ARG
	TAD I CMPR
	ISZ CMPR
	SNA
	JMP CMPREX	/END OF DISPATCH TABLE
	TAD CMPRTM
	SNA CLA
	JMP CMPRND	/GOT A MATCH
	ISZ CMPR
	JMP CMPR+2	/KEEP LOOKING
CMPRND, TAD I CMPR	/GET JUMP ADDRESS
	DCA CMPRTM
	JMP I CMPRTM	/GO TO IT
CMPREX, CLA CLL
	JMP I CMPR
CMPRTM, 0

PRNM,	0
	TAD NM1
	JMS PRWD
	TAD NM2
	JMS PRWD
	TAD NM3
	JMS PRWD
	TAD NM4
	SNA CLA
	JMP I PRNM
	TAD K256
	JMS PCH
	TAD NM4
	JMS PRWD
	JMP I PRNM
	JMS PCHAR
PCH,	0
	TLS
	TSF
	JMP .-1
	JMP SHUTUP
KMCTRZ, 100-"C
K77,	77
K100,	100
K240,	240
KM40,	-40
K256,	256
PCHAR,	0
	AND K77
	SNA
	JMP I PCHAR
	TAD KM40
	SPA
	TAD K100
	TAD K240
	JMS PCH
	JMP I PCHAR
PRWD,	0
	DCA PRWDTM
	TAD PRWDTM
	RTR;RTR;RTR
	JMS PCHAR
	TAD PRWDTM
	JMS PCHAR
	JMP I PRWD
PRWDTM, 0


PRMG,
PMSG,	0
	CLA CLL
	TAD I PMSG
	ISZ PMSG
	DCA CMPRTM	/MESSAGE LOC
PRMGLP, TAD I CMPRTM
	JMS PRWD
	TAD I CMPRTM
	AND K77 /LAST HALF ZERO?
	SNA CLA
	JMP I PRMG	/END OF MESSAGE
	ISZ CMPRTM
	JMP PRMGLP

DVNM,	0
	CLA STL RTL
	STL RTL 	/SHOULD GIVE ME A TWELVE
	DCA ASNM-1
	TAD DVNM
	DCA LDHN
	JMP LDHNE2
LDHN,	0
	CLA IAC
	DCA ASNM-1
LDHNE2, JMS I GNAME
	JMP I LDHN
	ISZ LDHN
	CLA CLL
	TAD NM1
	DCA ASNM
	TAD NM2
	DCA ASNM+1
	TAD HANDLA
	DCA ASNM+2
	CIF 10
	JMS I SYSTEM
	1
ASNM,	0;0;0
	JMP NODEV
	TAD ASNM+2
	DCA DEVHND
	TAD ASNM+1
	JMP I LDHN
NODEV,	JMS PRNM
	JMS PMSG
		NEXIST
	JMP I K7605
NEXIST, TEXT / DOES NOT EXIST/

/CHECK FOR CONTROL-C

SHUTUP, CLA CLL
	KRS	/PICK UP KEYBOARD
	TAD KMCTRZ
	SNA CLA
	KSF		/MUST ALSO HAVE HAD FLAG...
	JMP I PCH	/RETURN FROM TYPE ROUTINE
	JMP I K7605

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
/NOTE!!!!
/THIS PAGE IS EXTREEMLY VOLATITLE AND GETS
/OVERLAYED WHEN "GTOLAY" IS CALLED.  THE
/STRUCTURE OF THE PAGE AT BLOCK "SUBBLK" IS
/VERY RIGID, AS WELL AS THIS BLOCK.  IF ADDITIONS
/ARE MADE TO THIS PAGE MAKE THEM AFTER THE
/INDICATED COMMENT.

	*200	/FOR THE LOADER

	NOPUNCH;	*1000;	ENPUNCH
	THISPAGE=.

SBLOCK, NOP
	JMP I KKLUTZ	/DONT ALLOW A RUN OR A CHAIN
START,	DCA SBLOCK	/THIS IS WHERE WE COME IN!
	JMP I .+1
	CONTU

/NOTE THAT THIS ROUTINE IS OVERLAYED WITH
/ANOTHER COPY WHENEVER A GTOLAY IS CALLED.

CHAI,	0
	DCA .+5 	/***
	IAC		/SYS
	CIF 10
	JMS I SYSTEM
	2
	0		/***
	0
	JMP I CHAI
	CLA IAC 	/KEEP CHAIN FROM ZAPPING THE USR
	DCA I KJSBIT
	TAD .-5
	DCA .+4
	CIF 10
	JMS I SYSTEM
	6
	0

KKLUTZ, 7605

/THIS IS THE CONTINUATION OF "GTOLAY"
/IS OVERLAYED BY REST OF ROUTINE.

GTOCON, JMS I SHNDLR
	 0100		/OVERLAY MYSELF
	 1000		/NOTE THAT 1200 MIGHT GET INTO TROUBLE
GTOL1,	 SUBBLK 	/THE REAL BLOCK GETS PUT IN HERE
	JMP .		/BAD TROUBLE
COMBCK=.		/WE WILL RETURN HERE

/THE .FOCAL <DEV:>NAME<;COMMANDS>
/COMMAND

FOCLF,	JMS GTOLAY	/GET THE OVERLAY
	 0200		/1 BLOCK
	 1200
	BLKFOC
	FOCXXX

/.DELETE NAME1,NAME2,....
	DELETE=REMOVE
REMOVE, JMS GTOLAY
	0200
	1200
	BLKDEL
	REMPRO		/STARTING ADDR WITHIN PROCESSOR

RENAME, JMS GTOLAY
	0200
	1200
	BLKDEL
	RENPRO

/MAKE AND TECO DO NOT PRESERVE CORE - BUT
/NEITHER WOULD .R TECO.

MAKE,	ISZ TECENT
TECO,	JMS GTOLAY
	0200
	2000
	BLKTEC
TECENT, TECOXX

	1404		/.LD FOR EXECUTE COMMAND
EXECUT, TAD .-1 	/SET UP EXTENSION FOR EXECUTE COMMAND
COMPIL, DCA 0		/STORE EXTENSION
	JMS GTOLAY	/GET THE COMPILE/EXECUTE OVERLAY
	0400		/4 PAGES
	2000		/UP THERE
	BLKCOM
	COMPRO

UMOUNT, TAD FLUMOU
	JMS CHAI
	JMP I NXCMND
FLUMOU, .+1;FILENAM UMOUNT.SV

NXCMND, NOCMND
/THE .SUBMIT COMMAND (SUBMITTS TO HASP)

SUBMIX, JMS GTOLAY
	  0200
	  1200
	  BLKSUB
	  SUBMIT


/GET AN OVERLAY AS PER CALL.
/NOTE THAT THIS ROUTINE MAY ONLY BE
/CALLED ONCE SINCE THIS PAGE ENDS UP
/GETTING OVERLAYED BY THE GTOLAY ROUTINE
/NOTE THAT THE PAGE 0 LOCATIONS NM1 TO NM4
/ARE USED.

GTOLAY, 0
	TAD I GTOLAY
	DCA NM1 	/SAVE SOME ARGS
	ISZ GTOLAY
	TAD I GTOLAY
	DCA NM2
	ISZ GTOLAY
	TAD I GTOLAY	/THIS IS BLOCK WITHIN THIS FILE
	TAD SBLOCK	/OFFSET (PASSED FROM MONITOR)
	DCA NM3 	/STASH FOR CONTINUATION
	ISZ GTOLAY
	TAD I GTOLAY	/WHERE TO GO
	DCA NM4 	/AND WHERE TO GO
	TAD SBLOCK	/TO REMEMBER FOR LATER
	DCA TM1 	/TEMP STORAGE FOR SBLOCK
	TAD SBLOCK	/NOW TO FIGURE OUT WHERE
	TAD .+3 	/SUBBLK IS
	DCA GTOL1	/AND STICK IN CALL
	JMP GTOCONT	/CONTINUE AS A RESULT OF
	SUBBLK		/RIGIDITY
SHNDLR, 7607

/COPY AND COMPILE

COXX,	TAD NM2
	SNA		/IF ZERO, WE KNOW
	JMP COMPIL	/THAT IT WAS .CO (COMPILE)
			/OTHERWISE WE MUST TEST
	AND KP7700
	JMS I CPCMPR	/TEST...
	-1500;	COMPIL
	-2000;	UMOUNT	/COPY
	0
	JMP I .+1	/ILLEGAL COMMAND
	 NOCMND

CPCMPR, CMPR
KP7700, 7700

FLDIR0, FILENAME DIRECT.SV

LISTX,	ISZ HELPY
HELPXX, JMS GTOLAY
	  0200
	  1200
	  BLKHLP
HELPY,	  HELP


/THE DIRECT COMMAND

DIRECT, TAD FLDIR
	JMS CHAI
	JMP I .+1
	  NOCMND

FLDIR,	FLDIR0

ZZERO,	JMS GTOLAY
	  0200
	  2000
	  BLKZERO
	  ZERO

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
	*400	/ONLY FOR LOADER

	NOPUNCH;	*1200;	ENPUNCH
	THISPAGE=.


CONTU,	TAD CM7001	/SET UP USUAL LOC FOR A ONE PAGE HANDLER
	DCA HANDLA
	CIF 10
	JMS I SYSTEM
	13		/DELETE TENTATIVE FILES!
	TAD CM1577	/RESET LXR
	DCA LXR
	TSF
	JMP .-1
	JMS I GNAME
	JMP 1		/NO WAY!!
	TAD NM1
	JMS I CMCMPR
	-0123;	ASSIGN
	-0405;	DEXXXX
	-2205;	REXXXX
	-2325;	SUBMIX
	-0411;	DIRECT
	-0317;	COXX
IFNZRO FORTIV <
	-0530;	EXECUT
	>
	-0322;	CREATX
	-0504;	EDITX
	-1005;	HELPXX
	-1411;	LISTX
	-1501;	MAKE
	-2405;	TECO
	-0611;	UMOUNT	/FILE
IFNZRO FOCAL <
	-0617;	FOCLF	/FOCAL>
	-3205;	ZZERO
	-2321;	SQUASH
	-1004;	SQUASH	 /HOW'S THE DEVICE
	0
NOCMND, JMS I CMPRNM
	JMS I CMPRMG
		BDCOMG
	JMP I K7605
BDCOMG, TEXT / - ILLEGAL COMMAND/
CMPRNM, PRNM
CMPRMG, PRMG
CM7001, 7001
CM1577, 1577
CMCMPR, CMPR

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
		*600	/FOR THE LOADER

	NOPUNCH;*1400;ENPUNCH
	THISPAGE=.

DEXXXX, TAD NM2 	/GET SECOND LETTERS
	SNA
	JMP DEAS	/00 IS ABREVIATION FOR DEASSIGN
	AND K7700	/WE HAVE 3CHR ABBR
	JMS I KCMPR
	-0100;	DEAS
	-1400;	DELETE
	0
	JMP I KNOCMND

REXXXX, TAD NM2
	AND K7700	/FOR 3CHR ABBR
	JMS I KCMPR
	-1600;	RENAME
	0
	JMP I KNOCMND

ASSIGN, JMS I KADVNM
	JMP AUTOAS	/NO ARG, GO TO AUTOAS
	TAD KUDORG	/ONE LESS THAN BEGINNING OF
			/USER DEVICE NAME TABLE
	DCA TM1
	JMS I GNAME
	JMP I K7605
	TAD NM2
	SNA SPA
	CML
	TAD NM1
	SNL SMA
	TAD K4000
STONAM, CDF 10
	DCA I TM1
	CDF 0
	JMP I K7605
AUTOAS, TAD NMAUTO
	JMS I KCCHAI
	JMP I K7605
NMAUTO, .+1;FILENAM AUTOAS.SV


DEAS,	JMS I KADVNM	/SEE IF THERE IS AN ARG
	JMP DEASAL	/NO, GET THEM ALL
	TAD KUDORG
	DCA TM1 	/GET THE ONE TO DEASSIGN
	JMP STONAM	/AND ZAP IT
DEASAL, TAD KUDORG	/SETUP
	DCA X1
	TAD KM17
	DCA TM1
	CDF 10
	DCA I X1	/ZERO THEM
	ISZ TM1
	JMP .-2
	CDF 0
	JMP I K7605

EDITX,	JMS I KGTOLAY
	  0100
	  1400
	  EDBLK
	  EDIT		/OR CREATE

	CREATE
CREATX, TAD .-1
	DCA EDITX+4
	JMP EDITX

SQUASH, TAD SQUASP
	JMS I KCCHAI
	JMP I K7605

SQUASP, .+1;FILENAM SQUASH.SV

KNOCMN, NOCMND
KGTOLA, GTOLAY
K7700,	7700
KCMPR,	CMPR
KADVNM, DVNM
KCCHAI, CHAI
KUDORG, UDNAME-1
KM17,	-17
K4000,	4000

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
		*1000	/ONLY FOR LOADER

	NOPUNCH;*1200;ENPUNCH
	THISPAGE=.
	BLKDEL=3	/THIS IS BLOCK 3

/REMOVE PROCESSOR

KCPRNM, PRNM
KCLDHN, LDHN
KCCMPR, CMPR
KCPCH,	PCH
KCPRMG, PRMG
PBADAR, BADARG
PNODLM, NODLM
PDUPRN, DUPRN
PNDELM, NODLMG
RENPP4, RENP4
PNORNF, NORNF
KTOOFW, TOOFEW
KRMCOM, -",
RMQCOM, 7754
KMQEQL, -"=
KC215,	215
KC212,	212
KMQCLN, -":
PCORSV, CORESV		/REQUIRED EXIT TO SAVE CORE!
REGDSK, GDSKDN
REGDEV, GTDEV

REMPRO, JMS I REGDSK	/GET DEVICE NUMBER FOR DSK
	DCA DEVNUM	/AND SET DEFAULT TO DKS
	JMS I REGDEV	/GET A DEVICE NAME
	JMP I K7605	/NO MORE NAMES
	JMP RMVFL	/WAS FILENAME: GO REMOVE IT
	DCA DEVNUM	/NEW DEVICE NUMBER
	TAD NM1
	DCA DEVSTO
	TAD NM2
	DCA DEVSTO+1
	JMS I GNAME	/NOW FETCH NAME
	JMP I K7605	/NO NAME MUST BE DONE
	TAD LXR 	/SAVE END OF NAME IN TM1
	DCA TM1

RMVFL,	TAD I TM1	/ONE MOR CHECK
	SZA		/MUST BE EITHER EOL
	TAD KRMCOM	/OR A COMMA
	SZA CLA
	JMP RMISCM	/NO
	TAD DEVNUM
	CIF 10
	JMS I SYSTEM
	4		/FUNC CODE FOR DELETE
	NM1		/THE NAME IS THERE
	0		/MEANS DELETE
	JMP NOFILE
	JMP REMPRO+2	/OK, TRY ANOTHER ONE

NOFILE, JMS CRLF
	JMS I KCPRNM
	JMS I KCPRMG
		NTRMV
	JMS I KCPRMG
		NTNMG
	JMP REMPRO+2

RMISCM, TAD RMQCOM
	DCA I PNDELM
	JMP I PNODLM

CRLF,	0
	TAD KC215
	JMS I KCPCH
	TAD KC212
	JMS I KCPCH
	JMP I CRLF
NTNMG,	 4016;1724;4017;1640	/' NOT ON '
DEVSTO, DEVICE DSK	/INITIALLY
	0
DEVNUM, 2		/DSK INITIALLY



/RENAME PROCESSOR

RENPRO, JMS I REGDSK	/SET DEFAULT TO DSK
	DCA DEVNUM	/INITIALLY
	JMS CRLF	/AND GENERATE CRLF
	JMS I REGDEV	/GO LOOK FOR A DEVICE
	JMP I PCORSV	/NO MORE ARGS
	JMP RENP2	/WAS FILENAME
	DCA DEVNUM	/WAS DEVICE NAME
	TAD NM1
	DCA DEVSTO	/SAVE DEVICE NAME
	TAD NM2 	/FOR MESSAGE
	DCA DEVSTO+1
	JMS I GNAME
	JMP I PCORSV	/NO MORE ARGS
	TAD LXR
	DCA TM1

RENP2,	CLA CLL
	TAD NM1
	SNA
	JMP I PBADAR	/THIS WOULD LOUSE UP A DIRECTORY!
	DCA NEWNM1
	TAD NM2
	DCA NEWNM2
	TAD NM3
	DCA NEWNM3
	TAD NM4
	DCA NEWNM4

	TAD I TM1	/SET IN LUKCLN
	TAD KMQEQL
	SZA CLA
	JMP I PNODLM	/NO EQUAL SIGN
	JMS I GNAME	/GET OLD FILE NAME
	JMP I KTOOFW

	CLA
	TAD DEVNUM	/FIRST CHECK FOR DUP
	CIF 10
	JMS I SYSTEM
	2
RENU1,	NEWNM1
	0
	CLA CMA 	/GOOD (WE DONT WANT DUP
			/BAD, BUT HOLD OFF ON THE MESSAGE
	DCA DUPFIL	/WE WOULD RATHER HAVE A 'NO FILE' MESSAGE
	TAD DEVNUM
	CIF 10
	JMS I SYSTEM	/NOW LOOK UP THE OLD FILE
	2
RENU2,	NM1
	0
	JMP I PNORNF	/NO FILE
	ISZ DUPFIL	/WILL SKIP IF NO DUP
	JMP I PDUPRN
/			/WE CAN MAKE THE CHANGE!
	JMP I RENPP4
DUPFIL, 0


NEWNM1=63
NEWNM2=64
NEWNM3=65
NEWNM4=66

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
		*1200	/ONLY FOR LOADER
	NOPUNCH
	*1400;	ENPUNCH
	THISPAGE=.

KEPRNM, PRNM
KEPRMG, PRMG
RENU1P, RENU1
RENU2P, RENU2
RENREE, RENPRO+2
RENNN1, NEWNM1
RENNN2, NM1
KREN7,	7
KREN17, 17
KR1404, 1404

RENP4,	CLA CLL CMA RTL
	RAL		/-5
	CDF 10
	TAD I KREN17
	TAD I KR1404	/FORM POINTER
	DCA X1
	TAD NEWNM1
	DCA I X1	/MOVE NEW NAME IN
	TAD NEWNM2
	DCA I X1
	TAD NEWNM3
	DCA I X1
	TAD NEWNM4
	DCA I X1
	TAD I KREN7
	AND KREN7
	DCA .+5
	CDF 0
	JMS I DEVHND
	4210		/WRITE DIRECTORY
	1400
	0
	JMP LOCKRN
	JMS I KEPRNM
	JMS I KEPRMG
		RNCHMG
	JMP RENSUP
BADARG, JMS I KEPRMG
		BADAGM
	JMS I KEPRNM
NODLM,	JMS I KEPRMG
		NODLMG
	JMS I KEPRNM
	JMP CORESV
TOOFEW, JMS I KEPRMG
		TOOFWM
	JMP CORESV
DUPRN,	JMS I KEPRNM
	JMS I KEPRMG
		NOTRNM
	JMS I KEPRMG
		DUPRNM
	JMP RENSUP

NORNF,	JMS I KEPRNM
	JMS I KEPRMG
		NOTRNM
	JMS I KEPRMG
		NTNMG
	JMP RENSUP
LOCKRN, CLA
	JMS I KEPRNM
	JMS I KEPRMG
		NOTRNM
	JMS I KEPRMG
		DEVSTO
	JMS I KEPRMG
		LOCKMG
	JMP RENSUP


RENSUP, TAD RENNN1
	DCA I RENU1P
	TAD RENNN2
	DCA I RENU2P
	JMP I RENREE


/THIS EXIT MAKES SURE CORE AT 10000-11777 IS
/NOT WIPED OUT WHEN MONITOR COMES BACK IN.
CORESV, CLA CMA 	/GENERATE -1
	CDF 10		/PUT IT IN FIELD 1
	DCA I KQ7700	/TO SAY THAT USR IS ALREADY IN
	CDF CIF 0
	JMP I K7605	/BEFORE WE RETURN TO THE MONITOR
KQ7700, 7700

TOOFWM, TEXT /TOO FEW ARGS/
NOTRNM, TEXT / NOT RENAMED /
LOCKMG, TEXT / IS LOCKED/
RNCHMG, TEXT / RENAMED/
BADAGM, TEXT /BAD ARG /
NODLMG, TEXT /?= AFTER /
DUPRNM, TEXT /- DUP NAME/
NTRMV,	TEXT / NOT REMOVED,/

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
/NOTE!!!!
/THIS PAGE IS WHAT OVERLAYS THE STUFF
/AT 1000.  THE STRUCTURE AT THE BEGINNING
/OF THE PAGE IS EXTREEMLY RIGID.  SO WATCH IT!!!

	SUBBLK=4
	*1400
	NOPUNCH;*1000;ENPUNCH
	THISPAGE=.

	SBLOCK
ZBLOCK 4	/SO CHAI STARTS AT THE RIGHT PLACE

/NOTE THAT THIS IDENTICALLY OVERLAYS THE
/OTHER COPY OF CHAI.  THE CONDITIONAL
/ASSEMBLIES ON THIS PAGE CHECK THIS.
	IFNZRO .-CHAI <+=CHAI>

	0
	DCA .+5 	/***
	IAC		/SYS
	CIF 10
	JMS I SYSTEM
	2
	0		/***
	0
	JMP I CHAI
	CLA IAC 	/KEEP CHAIN FROM ZAPPING THE USR
	DCA I KJSBIT
	TAD .-5
	DCA .+4
	CIF 10
	JMS I SYSTEM
	6
	0
	7605
/NOW TO FINISH UP GTOLAY
/THE APPROPRIATE CONSTANTS ARE IN NM1
/THROUGH NM4
	IFNZRO .-GTOCON <+=GTOCON>
	TAD NM1
	DCA GTOLY1
	TAD NM2
	DCA GTOLY1+1
	SKP
	IFNZRO .-COMBCK <+=COMBCK>
	JMP GTOCON
	TAD NM3
	DCA GTOLY1+2
	TAD TM1 	/GET SAVED SBLOCK
	DCA SBLOCK	/AND RESTORE
	JMS I GTOLY2
GTOLY1,  0;0;0
GTOLY2, 7607		/USE FOR POINTER
	JMP I NM4


/GET DEVICE NUMBER FOR DEVICE "DSK"
/NOTE THIS WAS ADDED LATE IN THE GAME
/SO SOME ROOM CAN BE SAVED IN SEVERAL
/OF THE EXTENDED COMMANDS
/CALL:	JMS GDSKDN
/	  RETURN	/DEVICE # IN AC

GDSKDN, 0
	TAD HANDLA	/WHERE HANDLER WILL GO (NORM 1200)
	DCA .+6 	/STICK IN USR CALL
	CIF 10
	JMS I SYSTEM
	 1		/DO AN INQUIRE
GDSKD1,  DEVICE DSK
	 0
	JMP GDSKD2
	TAD GDSKD1+2	/ENTRY POINT
	DCA DEVHND	/SENT ENTRY FOR RENAME
	TAD GDSKD1+1	/DEVICE NUMBER
	JMP I GDSKDN
GDSKD2, CLA IAC 	/MUST BE TWO PAGER (USE SYS)
	JMP I GDSKDN

/THIS ROUTINE IS TO GET A DEVICE NUMBER AS
/SPECIFIED BY THE INPUT LINE - IF IT EXISTS.
/ONCE AGAIN SOME OF THE FOLLOWING COMMANDS
/MAY BE SHORTENED BY USING THIS ROUTINE WHENEVER
/SOMEONE HAS THE TIME OR INCLINATION.  THIS ROUTINE
/WAS WRITTEN TO SHORTEN THE EDIT AND CREATE COMMAND
/CODING.  THIS SUBROUTINE HAS MULTIPLE RETURNS DEPENDING ON
/THE CONTENTS OF THE LINE.  IS CALLED WHEN THE CONSTRUCTION
/<DEV:> IS EXPECTED IN THE COMMAND LINE.  TMP1 IS LEFT SET
/TO LXR AT CALL OF THIS ROUTINE AND LXR IS SET AS
/AT END OF "JMS GNAME".  TM1 IS LEFT SET TO TERM CHAR FROM GNAME.
/CALL:	JMS GTDEV	/OR EQUIVALENT
/	  RET1	/AC=0; NO NAME (GNAME RETNED TO CALL+1)
/	  RET2	/WAS NOT DEV NAME (WAS FILENAME)
/	  RET3	/WAS DEV. NAME; AC=DEV # (HANDLER IS LOADED)
		/HANDLER LOADED ACCORDING TO EDLDHN ROUTINE.

GTDEV,	0
	TAD LXR 	/SAVE START OF LINE
	DCA TMP1	/IN TMP1 AS PROMISED (NEED TO ANYWAY)
	JMS I GNAME	/SCAN IT FOR A NAME
	JMP I GTDEV	/RET1: NO NAME
	ISZ GTDEV	/POINT TO RET2
	TAD LXR 	/NOW SAVE LINE POINTER
	DCA TM1 	/AS PROMISED IN TM1 (NEED TO ANYWAY)
	TAD I TM1	/PICK UP TERMINATING CHAR
	TAD GTMCOL	/-":
	SZA CLA 	/SKIP IF DEVICE NAME GIVEN
	JMP I GTDEV	/NOPE-SO TAKE RET2
	TAD TMP1	/RESET THE LINE SCANNER
	DCA LXR 	/FOR LDHN
	ISZ GTDEV	/POINT TO RET3
	JMS I GTLDHN	/AND LOAD THE DEVICE HANDLER
GTMCOL, -":		/WE ARE IN TROUBLE(ALSO A HLT)
	JMP I GTDEV
GTLDHN, LDHN

/GET A SWITCH (OPTION) - SEARCH FOR
/AN "/OPT" AND RETURN THE OPT CHARACTER.

GSWITC, 0
	TAD I LXR
	SNA		/SKIP IF NOT DONE WITH LINE
	JMP I GSWITC	/DONE WITH LINE: RET TO CALL+1
	TAD GSMSLA
	SZA CLA 	/SKIP IF A SLASH
	JMP GSWITC+1	/KEEP LOOKING
	ISZ GSWITC	/RETURN TO CALL+2
	TAD I LXR	/GET THE SWITCH CHAR
	JMP I GSWITC
GSMSLA, -"/


	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>

/FOCAL COMMANDS

	BLKFOC=4

	*1600;NOPUNCH
	*1400;ENPUNCH
	THISPAGE=.

/THE FILENAME IS CHECKED FOR EXISTENCE AND
/A "PROGRAM RUN,.......... " IS EXECUTED FROM
/THE FILE NAMED FOCFPS.SV.

FOCMCL, -":
IFNZRO FOCAL <

FOCXXX, TAD LXR
	DCA TMP1	/SAVE LINE POINTER
	CIF 10		/LOAD DSK, FOR DEFAULT DEV
	JMS I SYSTEM	/IN CASE DEVICE NUMBERS CHANGE
	 1		/WITH BUILD
	 DEVICE DSK
FOCCDV=.-1
	 1200		/MAY WAIST A LITTLE TIME
	HLT		/A TWO PAGE HANDLER
	JMS I GNAME	/MAKE NAME
	JMP FOCQUIT	/NO NAME=JUST CALL FOCFPS
	TAD LXR 	/NEED TO CHECK FOR ":"
	DCA TM1 	/TEMPORORY
	TAD I TM1	/PICK UP NEXT
	TAD FOCMCLN
	SZA CLA 	/SKIP IF COLON
	JMP FOCDEF	/GO TO DEFAULT DEV.
	TAD TMP1	/NO:RESTORE TEXT POINTER
	DCA LXR 	/AS WE NEED TO CHANGE DEVICE
	JMS I FOCDHN	/MAKE DEV N.
	HLT		/CAN'T HAPPEN!
	DCA FOCCDV	/THE DEVICE
	JMS I GNAME	/NOW GET THE FILENAME
	JMP I K7605
FOCDEF, TAD I LXR	/NOW TO CHECK IF ANY COMMANDS
	SZA CLA 	/SKIP IF NO COMMANDS
	ISZ FOFIN	/DON'T PUT IN "DO ALL"
	TAD TMP1	/RESTORE LINE POINTER
	DCA LXR 	/AGAIN
	TAD FOPSP	/PUT IN P SPACE
	DCA I FOCPNT
	ISZ FOCPNT
	TAD FOCRC	/"R,"
	DCA I FOCPNT
	ISZ FOCPNT
FOCLOP, DCA TM1
	TAD I LXR	/MOVE DATA TO 6400 UP
	SNA		/SKIP IF NOT DONE
	JMP FOCDN	/GOT IT ALL
	AND FOC77		/STRIPPED ASCII (NORMALS ONLY)
	CLL RTL;RTL;RTL /WANT PACKED ASCII
	DCA TM1 	/STASH
	TAD I LXR	/NEXT
	AND FOC77
	SNA
	JMP FOCDN	/GOT IT ALL
	TAD TM1 	/OTHER HALF
	DCA I FOCPNT	/PUT IN 6400 UP - FIELD 0
	ISZ FOCPNT
	JMP FOCLOP	/CONTINUE
FOCDN,	TAD TM1 	/MAY BE 1 LEFT OVER
	SNA		/SKIP IF YES
	JMP .+4
	TAD FO40	/COMPLETE WITH SPACE
	DCA I FOCPNT	/AND STASH
	ISZ FOCPNT	/NEXT LOCATION
	ISZ FOFIN	/END OF LINE STUFF
	TAD I FOFIN	/PICK UP NEXT CHAR
	ISZ FOCNT	/LESS THAN 5 WORDS
	JMP .-5 	/CONTINUE
	CLA CLL 	/DONE

	/NOW TO CHECK FOR EXISTENCE OF FILE
	TAD NM4 	/DEFAULT EXT. IS .FL
	SNA
	TAD FOCFL	/PICK UP "FL" EXTENTION
	DCA NM4 	/TO MAKE CORRECT DEFAULT
	TAD  FOCCDV	/DEVICE NUMBER
	CIF 10
	JMS I SYSTEM	/GO LOOK IT UP
	 2
	 NM1
	 0
	JMP FODFL	/LOOKUP FAILED
FOCCH,	TAD FOCFPS	/PICK UP CHAIN NAME
	JMS I FOCHAI
	JMS I FOPRMG	/NO FILE FOCFPS.SV
	 NOFOCF
	JMP I K7605	/BACK TO MONITOR

FODFL,	JMS I FOPRMG	/NO FILE ON DEVICE
	  FOCNFL
	JMS I FOCRNM	/GIVE NAME
	JMP I K7605	/RETURN TO MONITOR

FOCDHN, LDHN
FOPSP,	"P&77 100+40
FOCRC,	"R&77 100+54
FOFIN,	.;TEXT	;D;EX ?M
FOCNT,	-5
FOCPNT, 6400
FOCHAI, CHAI
FOPRMG, PRMG
FOCRNM, PRNM
FO40,	40
FOC77,	77
FOCFL,	0614
FOCFPS, .+1;FILENAME FOCFPS.SV
NOFOCF, TEXT /?FOCFPS.SV/
FOCNFL, TEXT /?NO FILE /
	"Q&77 100+73
FOCQUI, TAD .-1 	/PICK UP Q;
	DCA I FOCPNT	/PUT IN TEXT BUFFER
	JMP FOCCH
>
	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
	XLIST
/COMPILE COMMAND

	*2000		/SINCE THIS REALLY GOES HERE
	BLKCOM=5
			/AND FOR THE NEXT FOUR PAGES
			/WE CAN BE LAZY AND USE LITERALS, ETC

COMPRO, JMS I (GDSKDN	/GET DISK DEVICE NUMBER
	DCA COMPV	/SET DEFAULT DEVICE
	TAD 0		/CHECK FOR DIFFERENT DEFAULT EXTENSION
	SNA		/OF ZERO, IT IS .PA
	TAD (2001	/SET DEFAULT EXTENSION
	DCA COMPRO

COMPRX, JMS I (GTDEV	/GET DEVICE IF ANY
	JMP I K7605	/NO INPUT
	JMP COMP1	/IS NAME
	DCA COMPV	/SAVE DEVICE NUMBER
	TAD COMPV
	DCA COMPVB	/BINARY DEFAULT IS DIFERENT
	JMP COMPRX	/GOT DEVICE, NOW GET NAME
COMP1,	TAD I TM1
	TAD (-"=
	SNA CLA
	JMP COMPBN	/SPECIAL BINARY SPECIFIED
	TAD NM4 	/EXTENSION ON INPUT
	SNA
	TAD COMPRO	/DEFAULT EXTENSION FORCED
	DCA NM4
	TAD NM4
COMP5,	DCA COMPRO	/NOTE!! CHANGED AFTER FIRST INPUT
	CLA CLL
	DCA .-2 	/BY THIS INSTRUCTION RIGHT HERE
	TAD NM1 	/ALLOW ONLY EXTENTION 1ST INPUT
	SNA CLA 	/IS IT NULL NAME?
	JMP COMPRX	/YES
	TAD (JMP COMP4
	DCA COMP5	/NOTE CHANGES INSTRUCTION!!
	JMS I (COMMOV
	4
	NM1
	COMFIL		/STORE INPUT NAME!
COMP4,	CLA CLL 	/WHEN COME FROM COMP5
	TAD (NM1
	DCA COMPSB	/GETS SHEFAZED EACH TIME AROUND
	TAD COMPV
	CIF 10
	JMS I SYSTEM	/LOOKUP FILE
	2
COMPSB, NM1
	0
	JMP COMP3	/LOOKUP FAILED
	TAD COMPV	/PICK UP DEVICE
	DCA I COMPNT	/STASH IN CD AREA
	ISZ COMPNT	/POINT TO FILE INFO
	TAD COMPSB	/PICK UP STARTING BLOCK
	DCA I COMPNT	/STICK IN AREA FOR CD
	ISZ COMPNT
	TAD I TM1	/GET TERM CHAR
	TAD (-",
	SNA CLA 	/A COMMA?
	JMP COMPRX	/YES: GO GET MORE
	JMP I (COMPOP
COMP3,	JMS I (PRMG
		COMPNF
	JMS I (PRNM
	JMP I K7605

COMPBN, TAD COMPVB	/WE HAVE A BINARY SPECIFICATION!
	DCA I (COMPBF	/DEVICE
	CLA STL RTL	/WILL WORK ON 8-FAMILY
	DCA COMPV	/RESET DEFAULT TO DSK
	JMS I (COMMOV
	4
	NM1
	COMPBF+1
	JMP COMPRX	/NOW GET THE INPUT

COMPNT, COMIDV
COMPV,	0	/DSK IS DEFAULT FOR INPUT
COMPVB, 1	/SYS IS DEFAULT FOR BINARY
	IFZERO FORTIV < 	/ONLY HAVE SABR COMMAND IF NOT FORTIV
SABRXX, FILENAME SABRC.SV
SABRTM, FILENAME FORTRL.TM
	>
FORT2,	FILENAME FORT.SV
	IFNZRO FORTIV < 	/ONLY HAVE EXECUTE IF HAVE FORTIV
FRTSSV, FILENAME FRTS.SV
FORT4,	FILENAME F4.SV
RALFSV, FILENAME RALF.SV
	>
PAL8XX, FILENAME PAL8.SV
PAL12X, FILENAME PAL12.SV

	PAGE
	XLIST
COMPOP, CLA CMA
	TAD LXR 	/BUMP BACK!
	DCA LXR

COMOP1, JMS COMGCH	/THESE ARE THE COMMAND OPTIONS
	DCA TM1
	TAD TM1
	JMS I (CMPR
	-"/;	COMOP2
	-"L;	COMLIS
	-"N;	COMNBN
	0
	JMS I (PRMG
		NIMPL
	JMP COMPCH
COMNBN, DCA COMBFG
	JMP COMOP1
COMBFG, -1
COMLIS, TAD I (COMPBF	/DEFAULT FOR LISTING IS THE SAME
	SNA		/AS FOR BIN
	TAD I (COMIDV	/IF NO BIN, THEN SAME AS INPUT
	DCA I (COMPLF
	JMS I (COMMOV	/NO MOVE NAME IN
	3		/BUT NOT EXTENSION
	COMFIL
	COMPLF+1
	JMS COMGCH
	TAD (-"=
	SZA CLA
	JMP COMLI2	/NOT EQL, GO ON
	JMS I (DVNM	/= SIGN MEANS DIFFERENT DEVICE FOR LIST
	JMP I K7605	/HE DIDNT SPECIFY A DEVICE AFTER HIS =
	DCA I (COMPLF	/NO NEW FILE NAME MAY BE SPECIFIED
	TAD LXR
	DCA T
	TAD I T
	TAD (-":	/CLEAR A COLON, IF HE PUT ONE
	SNA		/SKIP IF NOT COLON
	TAD I LXR	/BUMP IF COLON (NEXT INSTR IS CLA!)
COMLI2, CLA CMA
	TAD LXR
	DCA LXR 	/FOR GETTING NEXT CHAR
	JMP COMOP1	/GO BACK FOR MORE
COMGCH, 0
	CLA
	TAD I LXR
	SNA
	JMP COMOP9
	TAD (-";	/FOR NO NAME WITH PRE-COMPILE
	SNA		/OPTS=IGNORE ;
	JMP COMGCH+2	/IGNORE THE ;
	TAD (-240+";	/NOW CHECK FOR LEADING SPACES
	SNA		/SKP IF NOT
	JMP COMGCH+2	/IGNORE SPACE
	TAD (240	/NOT SPACE, FIX BACK
	JMP I COMGCH

T,	0
TT,	0

COMOP2, JMS COMGCH
	DCA TM1 	/SHOULD BE AN OPTION
	TAD (CMPARM-1
	DCA T
	TAD TM1 	/CHECK TO SEE IF A-Z,0-9
	TAD (-"9-1
	CLL
	TAD ("9+1-"0
	SZL
	JMP COMOKO	/0-9 OK
	TAD ("0-"Z-1
	CLL CML
	TAD ("Z-"A+1
	SNL
	JMP COMOKO	/A-Z OK
	JMS I (PRMG
		ILLOPT
COMPCH, TAD TM1
	JMS I (PCH
	JMP I K7605

COMOKO, SZL
	TAD (32
	TAD (-14
	ISZ T
	SMA
	JMP .-3
	DCA TT
	CLL CML
	RAL
	ISZ TT
	JMP .-2
	DCA TT
	TAD TT
	CMA
	AND I T
	TAD TT
	DCA I T
	JMP COMOP2	/GET ANOTHER ONE!

COMOP9, CLA CLL
	TAD I LXR
	TAD (-244
	SZA CLA
	JMP COMPOX
	TAD I (CMPARM-1
	RAL
	CLL CML RAR
	DCA I (CMPARM-1
COMPOX, JMP I (COMPGO

PAGE
COMPGO, TAD I (COMPRO	/EXTENSION ON INPUT!
	JMS I (CMPR
	-2001;	PAL8X
	IFZERO GTL <	/PAL12 WON'T FIT WITH GTL
	-6162;	PAL8X-1 /PAL12>
	IFNZRO FORTIV < 	/THIS ALLOWS FORTRAN IV AND RALF
	-2201;	RALFX
	-1404;	FRTSX
	-0662;	FORT2X		/.F2 CALLS NORMAL FORTRAN WHEN NEEDED
	>
	IFZERO FORTIV <
	-2302;	SABRX		/SABR ONLY ALLOWED WHEN NO FORT IV ON SYS
	>
	-0624;	FORTX		/GO THERE FOR PROPER FORTRAN
	IFNZRO GTL <
	-0123;	GTLX>
	0
COMNPR, JMS I (PRMG
		COMPXX
	TAD I (COMPRO
	JMS I (PRWD
	JMP I K7605
COMBIN, 0
	ISZ I (COMBFG	/SKIP IF "N" PRE-COM OPT NOT SET
	JMP I COMBIN
	TAD I (COMPBF
	SZA CLA
	JMP I COMBIN	/IF SOMETHING IS THERE, DO NOTHING
	TAD I (CMPARM
	AND (41
	SZA CLA
	JMP I COMBIN	/EITHER /L OR /G SPECIFIED, DO NOTHING
	CLA IAC
	DCA I (COMPBF	/SET DEVICE
	JMS I (COMMOV
	3		/DONT MOVE EXTENSION!
	COMFIL		/FILE REMEMBERED HERE
	COMPBF+1
	JMP I COMBIN
	IFNZRO GTL <
GTLX,	JMS COMBIN
	TAD I (COMPBF
	SZA CLA
	JMP GTLX2	/A FILE IS ALREADY THERE
	JMS I (COMMOV	/WE MUST PUT A FILE THERE
	4
	MCPBTM
	COMPBF+1
	CLA IAC
	DCA I (COMPBF
GTLX2,	TAD I (COMPBF+4
	SNA
	TAD (0102	/.AB PUT IN HERE
	DCA I (COMPBF+4
	TAD I (COMIDV+1 /MOVE SOURCE OVER
	DCA I (COMIDV+3
	TAD I (COMPSB+1
	CLL RTL;RTL
	AND (7760
	IAC
	DCA I (COMIDV+2
	CIF 10
	CLA IAC
	JMS I SYSTEM
	2
GTLSB,	GTLXX
	0
	JMP COMNPR
	TAD GTLSB
	DCA I (COMIDV+1 /SET SB OF COMPILER
	TAD (MCPXX
	JMP COMCHN
	>
	IFZERO FORTIV <
SABRX,	JMS COMBIN
	TAD I (CMPARM
	AND (41
	SNA CLA
	JMP SABRX2	/NO /L OR /G
	TAD I (COMPBF	/ON SABR WE HAVE TO HAVE BINARY
	SZA CLA 	/FOR THE /L OR /G
	JMP SABRX2	/SOMETHING IS ALREADY THERE
	STL RTL
	DCA I (COMPBF	/DEVICE SYS
	JMS I (COMMOV
	4
	SABRTM		/TEMPORARY FILE FOR REL CODE
	COMPBF+1
SABRX2, TAD (SABRXX
	JMP COMCHN
	>
	IFNZRO FORTIV <
FRTSX,	TAD (FRTSSV
	JMP COMCHN
RALFX,	JMS COMBIN
	TAD (RALFSV
	JMP COMCHN
	>
FORTX,	JMS COMBIN	/HANDLE BINARY
	IFNZRO FORTIV < TAD (FORT4 >
	IFZERO FORTIV < TAD (FORT2 >
	JMP COMCHN
IFNZRO FORTIV < 	/TO ALLOW .F2 TO CALL OS/8 FORTRAN
FORT2X, JMS COMBIN	/HANDLE BINARY
	TAD (FORT2
	JMP COMCHN
	>
PAL8XY, PAL8XX
	IFZERO GTL <
	PAL12X
	ISZ .+2>
PAL8X,	JMS COMBIN	/HANDLE BINARY
	TAD PAL8XY
	JMP COMCHN
COMCHT, 0
COMCHN, DCA COMCHT
	JMS I (COMCDU
	TAD COMCHT
	JMS I (CHAI
	JMP COMNPR	/NO FILE TO CHAIN TO
COMPXX, TEXT /?NO PROCESSOR FOR ./

	PAGE

COMPBF, ZBLOCK 5	/BINARY OUTPUT
COMPLF, ZBLOCK 5	/LISTING
	ZBLOCK 5	/3RD OUTPUT
COMIDV, 1;ZBLOCK 23	/INPUT FILES
CMPARM, ZBLOCK 4	/3 OPT WDS + LOW ORDER NUM
COMFIL, ZBLOCK 4	/FOR STORING INPUT NAME!
COMCDU, 0
	CLA CLL 	/MOVE CD IMAGE UP TO CDAREA
	TAD (COMPBF-1
	DCA X1
	X2=X1+1
	TAD (7577
	DCA X2
	TAD (-47
	DCA TM1
COMCDL, CLA
	TAD I X1
	CDF 10
	DCA I X2
	CDF 0
	ISZ TM1
	JMP COMCDL
	JMP I COMCDU
COMMV1, 0
COMMV2, 0
COMMV3, 0
COMMOV, 0	/JMS COMMOV;COUNT;FROM;TO
	CLA CLL
	TAD I COMMOV
	CMA
	DCA COMMV1
	ISZ COMMOV
	TAD I COMMOV
	DCA COMMV2
	ISZ COMMOV
	TAD I COMMOV
	DCA COMMV3
	ISZ COMMOV
COMMVL, ISZ COMMV1
	SKP
	JMP I COMMOV
	TAD I COMMV2
	DCA I COMMV3
	ISZ COMMV2
	ISZ COMMV3
	JMP COMMVL
COMPNF, TEXT '?NO FILE '
NIMPL,	TEXT '?ILLEGAL PRE-COMPILE OPTION '
ILLOPT, TEXT '?ILLEGAL CD OPTION '
	IFNZRO GTL <
MCPXX,	FILENAME MCP.SV
GTLXX,	FILENAME GTL.AB
MCPBTM, FILENAME MCPBIN.TM>

PAGE
/TECO COMMANDS - MAKE AND TECO
	FIELD 1 /THIS KEEPS US FROM HAVING PE ERRORS
	FIELD 0
	*3000	/FOR THE LOADER
	NOPUNCH;*2000;ENPUNCH
	THISPAGE=.
	BLKTEC= 7
/NEW AS OF 4/3/73
/TECO.SV REQUIRES A PATCH TO MAKE ALL
/OF THIS STUFF WORK.
/	.GE SYS TECO
/	.ODT
/	0042/3700 1000
/	0053/3717 1070
/	2575/3717 1070
/	 C
/	.SA SYS TECO

/THE CURRENT IMPLEMENTATION IS:

/		.TECO <IDEV:>NAME<.EX><=ODEV:></E>
/		.MAKE <IDEV:>NAME<.EX>

/	DEFAULTS	IDEV:=DSK
/			ODEV:=IDEV:
/			.EX  =.PA
/	THE OUTPUT FILENAME IS ALWAYS THE SAME AS
/	THE INPUT FILENAME.  AN EDIT BACKUP IS ONLY
/	EXECUTED IF THERE IS NO "=" CONSTRUCT. AND
/	THE /E SWITCH WILL CAUSE EXECUTION OF THE
/	FIRST PAGE OF THE INPUT FILE AS A TECO MACRO.
/	THE CONSTRUCT FOR /E IS:  HXA MA$$


	/TECO AND MAKE
TEGDEV, GTDEV
TEGDSK, GDSKDN
TECDEV, 2	/DEFAULT IS "DSK"
TECHRY, "Y
TEMAK,	-2		/BECOMES -1 IF TECO
TECOXX, ISZ TEMAK	/IS TECO
	JMS I TEGDSK	/DETERMINE AND LOAD "DSK"
	DCA TECDEV	/SET DEFAULT TO DSK
	JMS I TEGDEV	/GO FETCH DEVICE IF THERE
	 JMP I K7605	/BAD ARGS
	 JMP TEDEFA	/WAS NOT A DEVICE NAME
	DCA TECDEV	/SET NEW DEVICE NUMBER
	JMS I GNAME	/NOW THE FILENAME
	JMP I K7605	/BAD NAME
	JMP .+3
TEDEFA, TAD TMP1	/FIX UP TM1 TO POINT TO
	DCA TM1 	/START OF FILENAME (SEE TELUK)
	TAD LXR 	/SAVE POINTER TO END OF INFILE
	DCA TECOXX	/A GOOD TEMP
	TAD NM4 	/PICK UP EXT.
	SZA CLA 	/SKIP IF EXTENTION SPECIFIED
	DCA TECEXT	/CLEAR EXTENTION(DEFAULT)
	TAD TECHRE	/ALL COMMANDS START WITH "E"
	TEPUT		/PUT IN COMMAND Q REG
	ISZ TEMAK	/SKIP IF TECO COMMAND
	JMP TEMAKE	/GO DO A MAKE COMMAND.


	/IS TECO

	TAD TMP1	/RESET LXR
	DCA LXR 	/FOR SWITCH SCAN
	JMS I TEGSWI	/GO GET SOME SWITCHES
	JMP .+4 	/NO SWITCHES
	TAD TEMNE1	/ONLY /E ALLOWED
	SNA CLA 	/SKIP IF NOT /E
	TAD TEMACR	/DEF EXT WILL BE ".TE"
	DCA TEGSWI
	TAD TECOXX	/AND RESET LXR
	DCA LXR
	TAD I TECOXX	/= CONSTRUCT IS ALLOWED
	TAD TECMEQ	/TO SEE IF "="
	SZA CLA 	/SKIP IF NEW OUTDEV
	JMP TECOEB	/NOPE: DO EBXXXXX
	JMS I GNAME	/GET  ODEV: NA
	JMP I K7605
	TAD NM1
	DCA TEODVN
	TAD NM2 	/TRANSFER NAME FOR INQUIRE
	DCA TEODVN+1
	CIF 10
	JMS I SYSTEM
	  12		/INQUIRE
TEODVN, 0;0;0
	JMP I TENODEV	/DEVICE DOESN'T EXIST
	TAD LXR 	/WE ARE ALLOWING NO COLON
	DCA TEMAK	/SO PUT ONE IN IF NOT THERE
	TAD TECOLN
	DCA I TEMAK
	DCA I LXR	/INDICATE CURRENT END OF LINE
	TAD TECHRW	/EWXXXXXX
	TEPUT
	DCA I TECOXX	/GET RID OF THAT =
	TAD TECOXX	/START OF ODEV:
	TEMOVE		/STICK IN TECO COMMAND BUFF
	TAD TM1 	/NOW: SAME NAME AS INFILE
	TEMOVE
	TAD TECEXT	/IS THERE A DEFAULT EXT?
	SZA		/SKIP IF NO
	JMS I TECEXP	/PUT IN THE EXTENSION
	TAD TEC33	/END WITH AN ALTMODE
	TEPUT
	TAD TECHRE	/NOW FOR AN "ER"
	TEPUT
	TAD TECHRR	/TO MAKE A EWXXXXXX$ERXXXXXX$
	SKP

TECOEB, TAD TECHRB	/AN EBXXXXX
	TEPUT
	DCA I TECOXX
	TAD TMP1	/MOVE IN ALL THAT STUFF
	TEMOVE
	TAD TECEXT	/DEFAULT EXT?
	SZA		/SKIP IF ALREADY HAVE ONE
	JMS I TECEXP	/NO: PUT IN .PA
	TAD TEC33	/END WITH ALTM
	TEPUT
	TAD TECHRY	/AND YANK IN THE FIRST PAGE
	TEPUT
	TELOOK		/LOOK UP THE FILE
	JMP TENOF	/FILE DOESN'T EXIST
	JMP I .+1
	TEEXEC		/TO CHECK FOR SWITCH

TEGSWI, GSWITCH
TEMNE1, -"E

TEMAKE, TAD TECHRW	/EWXXXXX
	TEPUT
	DCA I TECOXX	/NO = CONSTRUCT ALLOWED
	TAD TMP1	/NOW MOVE THE LINE IN
	TEMOVE		/INCLUDING DEVICE
	DCA TEGSWI	/DEF EXT IS .PA
	TAD TECEXT
	SZA		/PUT IN DEFAULT EXT IF NECESSARY
	JMS I TECEXP
	TELOOK		/MAKE SURE NO DUPE NAME
	JMP I TECGOP	/GOOD: NO DUPE NAME
	JMS I TEPRMG
	  TEDUPM
	JMS I TEPRNM	/ALSO PRINT THE FILE NAME
	JMP I K7605
TENOF,	JMS I TEPRMG
	  TENMG
	JMP .-4

TEPRNM, PRNM
TEPRMG, PRMG
TECGOP, TECOGO
TEPUT=	JMS I .;TEPUTX
TELOOK= JMS I .;TELUK
TEMOVE= JMS I .;TEMOVX
TECHRE, "E
TECHRW, "W
TECHRB, "B
TECHRR, "R
TECOLN, ":
TEC33,	33
TECMEQ, -"=
TENODE, NODEV
TECEXT, ".
TEMCLN, -":
TECEXP, TECEXX
TEMACR, 0404	/"P+4="T AND "A+4="E
		/ISN'T THAT NICE

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
/CONTINUING THE TECO AND MAKE COMMAND
/SOME SUBROUTINES

	*3200	/FOR THE LOADER
	NOPUNCH;*2200;ENPUNCH
	THISPAGE=.

TEPUTX, 0
	AND TE177	/NO PARITY FOR TECO
	CDF 10
	RTL CLL;RTL	/GOES INTO 12000 UP
	DCA I TECOPT
	TAD I TECOPT
	ISZ TECOPT
	RTL;RTL 	/4-BITS
	DCA I TECOPT
	ISZ TECOPT
	CDF 0
	ISZ TECNT	/COUNT THE WORDS
	JMP I TEPUTX

/MOVE A LINE IN UP TO A 0

TEMOVX, 0
	DCA LXR 	/AC CONTAINED LINE POINTER
	TAD I LXR
	SNA
	JMP I TEMOVX
	TAD TEMSPC	/WE WILL NOT ALLOW SPACES
	SNA
	JMP TEMOVX+2	/IGNORE IT
	TAD TECHSP	/ADD SPACE BACK IN
	JMS TEPUTX	/STICK IN Q REG
	JMP TEMOVX+2

TELUK,	0
	TAD TM1 	/POINTS TO BEGINNING OF NAME
	DCA LXR 	/NEED TO DO NEW LOOKUP AS
	JMS I GNAME	/A RESULT OF DEVICE FORMATION
	  HLT		/CAN'T HAPPEN
	TAD NM4 	/DO DEFAULT EXT AGAIN
	SZA
	JMP .+3
	TAD I TEEXEC-1	/EXT=.TE OR .PA
	TAD TECPA2
	DCA NM4
	TAD I TEDEVP	/PICK UP DEVICE NUMBER
	CIF 10
	JMS I SYSTEM
	 2
	 NM1
	 0
	JMP I TELUK
	ISZ TELUK
	JMP I TELUK

TECEXX, 0
	JMS TEPUTX	/STICK IN THE "."
	TAD TECHRP	/AND THE "P"
	TAD I TEEXEC-1	/AR A "T"
	JMS TEPUTX
	TAD TECHRA	/AND FINALLY AN "A"
	TAD I TEEXEC-1	/OR AN "E"
	JMS TEPUTX
	JMP I TECEXX

	TEC33X-1
	TEGSWI
TEEXEC, TAD I .-1	/PICK UP SWITCH IF ANY
	SNA CLA 	/SKIP IF /E
	JMP TECOGO	/NOPE...
	CDF 10		/THIS CODE IS TO CHANGE AN
	TAD TE2400	/EB INTO A ER IN CASE OF TECO
	DCA I TE2002	/COMMAND - NOTE WILL NOT EFFECT
	CDF 0		/AN EW IF THE = CONSTRUCT USED.
			/DEPENDS ON THE FACT THAT THE ASCII
			/"B"=102 AND "R"=122 SO LOW ORDER
			/4 BITS UNEFFECTED.
	TAD TEEXEC-2	/NOW MOVE IN THE CHARACTERS
	JMS TEMOVX	/$HXAMA
TECOGO, TAD TEC33X
	JMS TEPUTX
	TAD TEC33X
	JMS TEPUTX	/TWO ALTMS
	CDF 10		/NOW FILL UP TO 7600
	DCA I TECOPT	/WITH 0'S
	ISZ TECOPT
	ISZ TECNT
	JMP .-3
	CDF 0
	TAD TECOSV
	JMS I TECHAI	/GO TO TECO
	JMS I TEPRMX	/NO TECO.SV
	 NOTECO
	JMP I K7605

TEPRMX, PRMG
TECHAI, CHAI
TECOSV, XTECOSV
TECPA2, 2001		/.PA
TEDEVP, TECDEV
TE2400, 2400
TE2002, 2002
TEMSPC, -240
TECHRP, "P
TECHSP, 240
TE177,	177
TECOPT, 2000	/POINTER TO Q-REG COMMAND BUFF.
TECNT,	-5600	/FOR FILL TO 7600

TEC33X, 33;"H;"X
TECHRA, "A;"M;"A;0
NOTECO, TEXT  ?TECO.SV NOT AVAILABLE
XTECOS, FILENAME TECO.SV
TEDUPM, TEXT  ?DUP NAME
TENMG,	TEXT  ?NO FILE

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
/THE SUBMIT A FILE TO HASP
/ROUTINE  .SUBMIT <DEV:>FILNAME<.EX>

*3400;NOPUNCH;*1200;ENPUNCH
	THISPAGE=.
	BLKSUB=10

/DEFAULT EXTENTION IS .BT
/DEFAULT DEVICE IS SYS: UNTIL WE FIX
/UP HASP TO PUT FILES INTO HASPTM.BT

SUBMIT, CLA IAC 	/JMS I SBGDSK FOR DEFAULT=DSK
	DCA SBDEV
	JMS I SBGDEV	/GO DECODE A DEVICE NAME IF THERE
	 JMP I K7605	/NO ARGUMENT=FLUSH
	 JMP SBDEFL	/NO DEVICE NAME=USED DEFAULT
	 DCA SBDEV	/SET NEW DEVICE NUMBER
	JMS I GNAME	/NOW GET A NAME
	JMP I K7605	/DEV WITH NO NAME??
SBDEFL, TAD NM4 	/PICK UP EXT.
	SNA		/SKIP IF SPECIFIED
	TAD SBEXBT	/DEFAULT IS .BT
	DCA NM4 	/DO SET EXTENTION
	TAD SBDEV	/PICK UP DEVICE
	CIF 10
	JMS I SYSTEM	/AND LOOK UP FILENAME
	  2
SUBMT1,   NM1
	  0
	JMP SBNFIL	/LOOKUP FIAILED
	TAD SUBMT1+1	/LENGTH
	RTL;RTL 	/OVER TO SIMULATE CD
	AND SB7760
	TAD SBDEV	/AND DEVICE NUMBER
	CDF 10		/SETUP INPUT AREA
	DCA I SB7617
	TAD SUBMT1
	DCA I SB7620
	DCA I SB7621
	DCA I SB7600	/NO OUTPUT FILES
	CDF 0
	TAD SBHASP
	JMS I SBCHAI
	JMS I SBPRMG	/HASP DOESN'T EXITS
	  NOHASP
	JMP I K7605
SBNFIL, JMS I SBPRMG
	  SBNMG
	JMS I SBPRNM
	JMP I K7605

SBNMG,	TEXT /?NO FILE /
NOHASP, TEXT /?HASP.SV NOT AVAILABLE/
SBHASP, .+1;FILENAME HASP.SV

SB7617, 7617
SB7620, 7620
SB7621, 7621
SB7600, 7600
SB7760, 7760
SBGDSK, GDSKDN
SBGDEV, GTDEV
SBDEV,	1	/DEVICE NUMBER
SBCHAI, CHAI
SBPRMG, PRMG
SBPRNM, PRNM
SBEXBT, 0224
HLNOHL, TEXT  HELP.HL
HLBADO, TEXT  FILE STR. OUT DEVICE ILLEGAL

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
*3600;NOPUNCH;*1400;ENPUNCH
	THISPAGE=.

	BLKHLP=10
	DCB=7760	/ADD OF DCB TABLE IN MONITOR

/ADDITIONS TO COMPILE TO IMPLEMENT THE LIST AND HELP
/COMMANDS.  SYNTAX:
/	LIST  DEV: NAME .EX ,....
/		DEFAULTS DEV:=DSK
/			 .EX=LS
/LISTS THE SPECIFIED FILES ON LPT IF IT EXISTS
/IF NOT THEN ON DEVICE TTY:

/	HELP  NAME
/THIS COMMAND OUTPUTS THE FILE NAME.HL FROM SYS TO
/THE TTY:.  IF	NAME  IS NOT SPECIFIED THEN THE
/FILE SYS:HELP.HL WILL BE PRINTED.


HELP,	JMP HELPX
LIST,	JMS I HLGDSK	/GET DSK DEV #
	DCA HLDEV	/SET DEFAULT DEV.
	TAD HL1423	/DEFAULT IS LS
	DCA HLEXT	/SET EXTENTION
	CIF 10		/NOW TO CHECK FOR LPT
	JMS I SYSTEM
	  1		/LOAD A HANDLER
HLLPT,	  DEVICE LPT
	  6401		/ALLOW 2 PAGES
	JMP HLTTY	/NOT THERE CHK USE TTY
	TAD .-2 	/PICK UP ENTRY
	DCA HLOUTD	/SET OUT HANDLER ENTRY
	TAD .-5 	/DEVICE NUMBER
	JMP HLSTRT+1	/USE COMMON CODE

HELPX,	STA
	DCA LIST	/INDICATE HELP COMMAND
	TAD HL1014	/DEFAULT EXTENSION IS .HL
	DCA HLEXT	/SO SET IT
	CIF 10		/DEFAULT IN DEV=HL
	JMS I SYSTEM
	  1		/LOAD HL
	  DEVICE HL
	  7001
	JMP HLTTY	/DOESN'T EXIST
	TAD .-2
	DCA DEVHND	/SAVE HANDLER ADDRESS
	TAD .-5 	/GET DEV NUMBER
	DCA HLDEV	/TO SET DEF DEV.
HLTTY,	CIF 10		/LOAD TTY HANDLER
	JMS I SYSTEM
	  1
	  DEVICE TTY
HLOUTD,   6400
	JMP I K7605	/WHAT NO TTY??

HLSTRT, TAD HLOUTD-1	/OUT DEV NUMBER
	TAD HLDCB	/POINT INTO DCB TABLE
	DCA HLOUTD-1	/A TEMP
	CDF 10
	TAD I HLOUTD-1	/PICK UP DCB ENTRY
	CDF 0
	SPA CLA 	/SKIP IF NOT FILE STRUCTURED
	JMP HLOBAD	/BAD OUTDEV.
HLCOMM, DCA HLB 	/INIT OUT DEV. EACH TIME
	JMS I HLGDEV	/DECODE DEVICE NAME IF ANY
	JMP HLPHLP	/SHOULD BE HELP.HL
	JMP HLDEFL	/USE DEFAULT DEV
	DCA HLDEV	/USE THIS DEVICE
	JMS I GNAME	/AND THE FILENAME
	JMP I K7605	/DEV WITH NO NAME??
HLDEFL, TAD NM4 	/SEE IF EXT SPECIFIED
	SNA		/SKIP IF YES
	TAD HLEXT	/USE DEFAULT
	DCA NM4 	/FOR CORRECT EXTENSION
	DCA LIST	/NO HELP.HL'S
	TAD HLNM1	/RESET POINTER
HLL1,	DCA HLLOOK	/FOR LOOKUP
	TAD HLDEV	/NOW LOOK UP THE FILE
	CIF 10
	JMS I SYSTEM	/LOOKUP
	  2
HLLOOK,   NM1		/POINT TO NAME
	  0		/FILLED BY -LENGTH
	JMP HLNFIL	/NO FILE
	TAD HLLOOK	/PICK UP START BLOCK
	DCA HLBLOCK	/SET FOR HANDLER
HLLOOP, JMS I DEVHND	/READ 1 BLOCK SINCE
	  0200		/TTYS AND LPTS ARE SLOW
	  4000
HLBLOC,   0
	JMP HL7605
	JMS I HLOUTD	/OUTPUT IT
	  4200
	  4000
HLB,	  0
	JMP HL7605	/HANDLER ERROR
	ISZ HLBLOCK	/NEXT BLOCK
	ISZ HLB 	/NO INIT ANY MORE
	ISZ HLLOOK+1	/DONE?
	JMP HLLOOP	/CONTINUE
	JMP HLCOMM	/KEEP PROCESSING

HLPHLP, ISZ LIST	/HELP WITH NO ARGS?
	JMP I K7605	/NOPE
	TAD HLHLP	/YEP - OUTPUT HELP.HL
	JMP HLL1	/GO DO IT

/FILE DOES NOT EXIST

HLNFIL, JMS I HLPRMG	/NO FILE THERE
	  SBNMG
	TAD NM1
	SNA CLA
	JMP .+4
	JMS I HLPRNM	/AND PRINT THE NAME
	DCA LIST	/NO HELP.HL
	JMP HLCOMM	/CONTINUE WITH NEXT NAME
	JMS I HLPRMG
	  HLNOHL
	JMP I K7605

HL1423, 1423
HLEXT,	0
HLGDSK, GDSKDN
HLDEV,	1
HL1014, 1014
HLGDEV, GTDEV
HLNM1,	NM1
HLHLP,	.+1;FILENAME HELP.HL
HLPRMG, PRMG
HLPRNM, PRNM
HLDCB,	DCB-1	/DEPENDS ON USR TABLES.


HL7605, CLA CLL 	/ERRORS HAVE AC NONZERO
	JMP I K7605

HLOBAD, JMS I HLPRMG	/OUT DEVICE FILE STRUCTURED.
	  HLBADO
	JMP I K7605

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
/ZERO DECSYSTEM-8 DEVICES

*4000;NOPUNCH;*2000;ENPUNCH
	THISPAGE=.
	BLKZERO=11

/THIS IS A MONITOR LEVEL COMMAND
/TO ZERO DEVICE DIRECTORY'S IN AN INTELEGENT
/WAY USING THE PARAMETER BLOCK 6.

/FILE LENGTHS AND START OF FILE STORAGE
/IS OBTAINED FROM THE PARAMETER BLOCK.	IF THE
/PARAMETER BLOCK IS NOT PRESENT THEN THIS
/PROGRAM WILL NOT WORK.  PRINTING OUT AN ERROR MESSAGE.
/ALSO SOME RECOVERY IS AVAILABLE FOR THE
/CASES WHERE THE USER HAS BLOWN IT.  NOTE THAT
/THE RECOVERY WILL NOT COMPLETELY WORK IF THE
/DIRECTORY HAS EXTENDED INTO BLOCK 5.
/RECOVERY IS ONLY FROM A COCKPIT ERROR "ZERO" COMMAND.

/SYNTAX:	.ZERO DEV:  /R
/WHERE "DEV:" IS ZEROED AND /R MEANS RESTORE
/THE DIRECTORY FROM BEFORE THE LAST "ZERO"


ZERO,	TAD LXR 	/SAVE LINE SCANNER
	DCA ZERO	/FOR OPTIONS
	JMS I ZELDHN	/LOAD A HANDLER
	JMP SYNTAX	/DEVICE MUST BE SPECIFIED.
	CLA CLL 	/DON'T NEED DEV #
	JMS I DEVHND	/READ ALL THE STUFF
	 1410		/BLOCKS 1-6
	 2000		/INTO FIELD 1
	 0001		/STARTING AT 2000
	JMP HNDERR	/HANDLER ERROR
	TAD ZERO	/RESTORE LXR
	DCA LXR
	JMS I ZGSWITCH	/GET A SWITCH IF ANY
	JMP NOSWIT	/NO /R SWITCH
	TAD ZEMR	/RESTORE OLD DIR
	SNA CLA 	/SKIP IF NOT VALID OPTION
	JMP SLASHR	/GO PROCESS IT
	JMP .-5 	/LOOK FOR MORE

NOSWIT, CDF 10		/NOW TO CHECK FOR PARAMETER BLOCK
	TAD I ZE4400	/PICK UP SIGNAL WORDS
	TAD ZM0427	/SHOULD BE "DW"
	SZA CLA 	/SKIP IF OK
	JMP NOPARAM	/NO PARAMETER BLOCK
	TAD I ZE4401	/SHOULD BE "JC"
	TAD ZM1203	/AS SECOND SIGNAL
	SZA CLA 	/SKIP IF OK
	JMP NOPARAM	/NO PARAMETER BLOCK
	TAD I ZE4402	/SHOULD BE -1
	IAC
	SZA CLA 	/SKIP IF PARAMETER BLOCK PRESENT
	JMP NOPARAM
	TAD I ZE4404	/CHECK FOR NO ZERO ALLOWED
	IAC		/SHOULD BE NON-ZERO FOR ALLOWED
	SNA CLA 	/SKIP IF ZEROABLE
	JMP NOZERO
	CDF 0
	TAD ZERO	/RESTORE LXR
	DCA LXR
OPTNUM, CLA CLL
	JMS I ZGSWITCH	/LOOK FOR NEUMERIC OPTION
	JMP ZEREND	/NONE (SO USE DEFAULT)
	TAD ZEM9
	SMA		/SKIP IF POSSIBLE
	JMP OPTNUM	/NO
	TAD ZE9M0
	SPA		/SKIP IF NEUMERIC
	JMP OPTNUM	/NO
	CIA		/WANT A NEG #
	DCA NWASTE	/SET NUMBER OF WASTE WORDS
ZEREND, CDF 10		/LET'S CHECK FOR STANDARD START
	TAD I ZP4410	/OF A NON-SYSTEM DEVICE
	TAD ZEM7	/SINCE THEY START AT BLOCK 7
	SNA CLA 	/SKIP IF POSSIBLE SYSTEM PRESENT
	DCA I ZE4407	/CLEAR SYSTEM PRESENT FLAG
	CDF 0		/NOW GET READY TO
	JMS I ZWRZERO	/DO IT.
	JMP I K7605

ZE4407, 4407
ZP4410, 4410
ZEM7,	-7
ZWRZER, WRZERO
NWASTE, -1
ZELDHN, LDHN
ZEMR,	-"R
ZE4400, 4400
ZE4401, 4401
ZE4402, 4402
ZE4404, 4404
ZM1203, -1203
ZM0427, -0427
ZEM9,	-"9
ZE9M0,	"9-"0
ZE2007, 2007
ZEPRMG, PRMG
ZEPRNM, PRNM

/RESTORE THE OLD DIRECTORY
SLASHR, CDF 10
	ISZ I ZE2007	/HAS DIR CHANGED SINCE LAST ZERO?
	JMP SLRERR	/YES.
	CDF 0
	JMS I DEVHND	/WRITE OLD BACK
	 5010		/4 BLOCKS BACK
	 2400		/AS SAVED BEFORE
	 0001		/IN RESTORE ATTEMP
	JMP HNDERR
	JMP I K7605	/DONE.


/SYNTAX ERROR

SYNTAX, JMS I ZEPRMG
	  SYNERR
	JMP I K7605	/AND ERROR RETURN

HNDERR, JMS I ZEPRMG
	  HNDLRR
	JMP I K7605

NOPARA, CDF 0
	JMS I ZEPRMG
	  PARBKE
	JMS I ZEPRNM
	JMP I K7605

NOZERO, CDF 0
	JMS I ZEPRMG
	 ZERONO
	JMS I ZEPRNM
	JMP I K7605

SLRERR, CDF 0
	JMS I ZEPRMG
	 ERRSLR
	JMP I K7605

ZGSWIT, GSWITCH

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
*4200;NOPUNCH;*2200;ENPUNCH
	THISPAGE=.

HNDLRR, TEXT  HANDLER ERROR
SYNERR, TEXT  ?DEVICE MUST BE SPECIFIED
PARBKE, TEXT  NO PARAMETER BLOCK ON
ZERONO, TEXT  NO "ZERO" ALLOWED ON
ERRSLR, TEXT  DIRECTORY HAS CHANGED SINCE LAST ZERO NO /R ALLOWED

/WRITE THE ZERO DIRECTORY
WRZERO, 0
	CLA CLL 	/PROBABLY NOT NEEDED
	TAD I ZNWASTE	/#WAIST WORDS
	DCA ZFIST+4	/STASH
	CDF 10
	TAD I ZE4410	/PICK UP START OF FILE STORAGE
	DCA ZFIST+1	/FILE ORIGIN
	STA
	DCA ZFIST	/1 FILE
	TAD I ZE4403	/PICK UP LENGTH
	TAD ZFIST+1	/ADJUST FOR FILE START
	DCA ZFIST+6	/STICK IN A BIG EMPTY
	DCA I ZE4002	/NO SEG 5 (OR 6)
	CDF 0
	JMS I DEVHND	/AND WRITE
	  4200		/THE ZERO BLOCK OUT
	  ZFIST
	  0001
	JMP ZHNDERR	/OR SOMETHING
	JMS I DEVHND	/NOW COPY 4 BLOCKS OF OLD DIR
	 5011		/FOR RESTORE
	 2000		/OPTION
	 0002		/BLOCKS 2-5
			/LEAVE THE PARAMETER BLOCK ALONE
	JMP ZHNDERR	/OR SOMETHING
	JMS I DEVHND	/AND NEW PARAMETER BLOCK
	 4210		/SINCE SYSTEM PRESENT PARAMETER
	 4400		/MAY HAVE CHANGED WITH THIS
	 0006		/ZERO
	JMP ZHNDERR	/OR SOMETHING
	JMP I WRZERO

/THE BLOCK HEADER

ZFIST,	ZBLOCK 7
	-1		/FOR RESTORE CHECK

ZE4410, 4410
ZNWAST, NWASTE
ZE4403, 4403
ZE4002, 4002
ZHNDER, HNDERR

	/TO GUARD AGAINST THIS PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
	*4400		/FOR THE LOADER
	NOPUNCH;*1400;ENPUNCH
	THISPAGE=.
	EDBLK=12

	IFNDEF KVEDIT <KVEDIT=0>

EDMCLN, -":
EDLDHN, LDHN
EDCRDV, 0
EDFLG,	7777
CREATE, CLA
	DCA EDFLG	/INDICATES WE ARE A CREATE
	CDF 10
	DCA I K7617
	CDF 0
EDIT,	JMS I EDGDSK
	DCA EDCRDV	/DEFAULT IS DSK
	JMS I EDGTDV	/CALL GTDEV ROUTINE
	JMP I K7605	/NO ARGS AT ALL
	JMP EDDEFA	/IS FILENAME
	DCA EDCRDV	/DEVICE SPECIFIED
	JMS I GNAME	/NOW GET THE FILENAME
	JMP I K7605
EDDEFA, TAD EDCRDV	/BEGIN TO SETUP OUTPUT AREA
	CDF 10
	DCA I K7600
	TAD NM1
	DCA I K7601
	TAD NM2
	DCA I K7602
	TAD NM3
	DCA I K7603
	TAD NM4
	SNA
	TAD KDPA	/FORCE .PA EXTENSION
	DCA NM4
	TAD NM4
	DCA I K7604
	CDF 0
	CIF 10
	TAD EDCRDV	/LOOKUP THE FILE
	JMS I SYSTEM
	2
EDSB,	NM1
	0
	JMP NEDFL	/LOOKUP FAILED, MIGHT SHOULD HAVE
	ISZ EDFLG	/LOOKUP WAS SUCCESSFUL
	JMP CRDUP	/BUT THIS WAS CREATE - SO...
	TAD LXR 	/WE ARE ALLOWED "=" CONSTRUCT
	DCA CREATE	/WITH THE ".ED" COMMAND
	TAD I CREATE
	TAD EDMEQ	/IS THERE AN "="
	SNA CLA 	/SKIP IF NO:
	JMS I EDLDHN	/GO LOOK UP THE HANDLER (SKIPS)
	TAD EDCRDV
	CDF 10
	DCA I K7600	/NEW OUT DEV IF NEC.
	TAD EDCRDV	/GOOD LOOKUP UNDER EDIT COMMAND
	DCA I K7617
	TAD EDSB
	DCA I K7620
	DCA I K7621	/INPUT SIDE SET UP
	CDF 0
EDCRGO, IFNZRO KVEDIT <
	JMS I GNAME
	TAD KVED >
	TAD EDITOR
	JMS I PDCHAI
	JMS I PDPRMG
		NOEDT
	JMP I K7605
CRDUP,	JMS I PDPRMG
		EDDUPM	/DUP FILE UNDER CREATE
	JMS I PDPRNM
	JMP I K7605
NEDFL,	ISZ EDFLG	/WE COME HERE IF LOOKUP FAILS
	JMP EDCRGO	/BUT IT WAS CREATE, SO WE ARE OK
	JMS I PDPRMG
		EDNMG
	JMS I PDPRNM
	JMP I K7605
EDMEQ,	-"=
EDGTDV, GTDEV
EDGDSK, GDSKDN
K7617,	7617
K7620,	7620
K7621,	7621
K7600,	7600
K7601,	7601
K7602,	7602
K7603,	7603
K7604,	7604
KDPA,	2001	/.PA
PDCHAI, CHAI
PDNOCM, NOCMND
PDPRNM, PRNM
PDPRMG, PRMG
EDDUPM, TEXT /?DUP NAME /
EDNMG,	TEXT /?NO FILE /
	IFZERO KVEDIT <
NOEDT,	TEXT /?EDITOR NOT AVAILABLE/
	>
	IFNZRO KVEDIT <
NOEDT,	TEXT /?EDITOR MISSING/
	>
EDITOR, .+1;FILENAME EDIT.SV
	IFNZRO KVEDIT <
KVED,	.-EDITOR;FILENAME KVEDIT.SV >

	/TO GUARD AGAINST PAGE OVERFLOW
	IFNZRO .-1&7600-THISPAGE <+=.>
	*4600
	0
/************************************
/	EXPAND COMPILE HERE
/************************************
	$$$$$$$$$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search