/SHSAVE.PA
/PROGRAM TO GENERATE SHORT SAVE FILES FOR STANDARD PROGRAMS
/THE GENERATED PROGRAMS ACT LIKE A SORT OF CHAIN
/TO THE PROGRAM OF THE SAME NAME ON DSK0:
/
/DEFINITIONS
SHNDLR=7607
STFLD=7744
STADDR=7745
JSBITS=7746
MREAD=7757
MSWITC=7764
MSTCDF=7772
MSTADR=7775
/
/WRITTEN BY ED SMALLENBURG
/	AUGUST 1975
/MODIFIED BY JAN VERBURG
/MODIFIED BY M.P.VAN OS 27-MAR-79
/	SEPTEMBER 1975
/
/COMMAND DECODER OPTIONS:
/FILENAMES CAN BE SPECIFIED (MAX 1 AS OUTPUT FILE,
/	AND 5 AS INPUT FILE, DEFAULT EXT. .SV)
/	/S	STANDARD PROGRAMS
/	/P	PAL8 PGMS
/	/B	BASIC PGMS
/	/F	FORTRAN 2 PGMS
/	/4	FORTRAN 4 PGMS
IFDEF FYSIOLOGY <
/	/K	KV08 EDITOR
/	/M	MF8E EDITOR >
/	/A	ALL ABOVE PROGRAMS
/	/L	LIST (LIKE FOTP)
/	/Q	QUERY (LIKE FOTP)
/	/N	DON'T GIVE A MESSAGE IF NOT FOUND
/
NUMBER=7600-CCBUF-4%2
		/MAX # OF ENTRIES ALLOWED IN .SV-FILE


*20
DEVNO,	0	/DSK0 DEV #
OPTAL,	0	/OPTIONS A-L
OPTMX,	0	/OPTIONS M-X
OPTY9,	0	/OPTIER TO LISTS
HNDLR,	0	/HSK0:
CNT1,	0	/TEMPORARYMES,	ZBLOCK 6^4
	0	/ENDT,	SKP CLA		/STARTING ADDRESS
	 CLA IAC	/CHAIN ENTRY POINT
	6254		/SKIP ON MULTI8
	 JMP I [ERROR0	/ONLY IN THE BACKGROUND
	SZA CLA
	 JMP NOCD	/MUST BE CHAIN
CALLCD,	CIF 10
	JMS 200
	 5		/CALL CD
	 5200		/SPEES
NOCD,	DCA ARG2
	CIFQUIRE
ARG1,	 6003		/DEVOMES DEVICE NR.
ARG3,	 I [ERROR1	/DEVICE NOT IN CORE
	TAD ARG3
	DCA I [HANDLER+OFSET	/SET ENTRY
	TAD ARG3
	DCA HNDLR
	TAD ARG2	/DEVICE NUMBER
	DCA DEVNO
	CDF 10
	TAD I [7643	/OPTIONS A-L
	DCA OPTAL
	TAD I [7644
	DCA OPTMX
	TAD I [7645
	DCA OPTY9
	CDF 0
IFDEF FYSIOLOGY <
	JMS I [EDIT	/WICH EDITOR >
	TAD OPTMX
	AND [200	/OPTION Q ?
	SZA CLA
	 JMP YOPTQ	/Y
	TAD OPTAL	/N
	RAR
	SZL CLA		/OPTION L ?
	 TAD I [OPTL	/Y
	DCA I [OPTQ
YOPTQ,	TAD OPTMX
	RAL
	SMA CLA		/OPTION N ?
	 JMP .+3
	TAD [R2&177+5200/JMP R2
	DCA I [OPTN
	TAD OPTAL	/OPTION A ?
	SMA CLA
	 JMP EXE	/NO
	CLA CMA		/Y
	DCA OPTAL	/SET ALL OPTIONS
	CLA CMA
	DCA OPTMX
	CLA CMA
	DCA OPTY9
EXE,	TAD [DCA NAMES-1/FIRST WE DO THE FILES, WHICH ARE
	DCA DCANAM	/MENTIONED AS INPUT FILES.
	TAD [-6		/THAT IS, WE HAVE TO GET THEM IN
	DCA CNT1	/THIS FIELD, ELIMINATING THE DEVICE-
	TAD [7600	/WORD IN BETWEEN.
	DCA 10		/USE AUTOINDEX
	CDF 10
NAMLP,	TAD [-4
	DCA CNT2
DCALP,	ISZ DCANAM
	TAD I 10	/DATAFIELD 	/DIRECT, NO WORRY ABOUT DCALP	/LOOP
	TAD DCANANAM
	TAD [TAD-DCA
	DCA
	SNA
	 TAD [2326	/SV
DCANA1,	 HLT	/DCA NAMES+3
	ISZ 10
	ISZ CNT1
	 JMP NAMLP	/LOOP
	CDF 0
	TAD NAMES
	SNA CLA		/OUTPUT FILENAME ?
	 TAD [4		/NO, MAYBE INPUT
	TAD [NAMES
	JMS I [EXE2	/DO THE NAMES, IF NOMX
	AND [40		//S
	SZA I [EXE2	/DO STANDARD PRO[400	//P
	SZA CLA
	 TA	TAD OPTAL
	RTL		//B
	SZL CLA
	 TAD [BLIST
	JMS I [EXE2
	TAD OPTMX
	AND [4000	/ /M (ACREL)
	SZA CLA
	 TAD [MCLIST
	JMS I [EXE2
	TAD OPTAL
	AND [200		/ /E (EXPOGRAPH)
	SZA CLA
	 TAD [EXLIST
	JMS I [EXE2
	CDF 10
	TAD I [7642
	CDF 0
	SMA CLA		/ALTMODE SET ?
	 JMP CALLCD	/NO
	JMP I [7600	/READY

PAGE
EXE2,
IFNDEF FYSIOLOGY <HLT	/SETUP FILES >
IFDEF FYSIOLOGY <JIEDIT >
	SNA
	JMP I EXE2	/NO FILES
EXE2L,	DCA POINT	/SET POINTER
	TAD I POINT	/MORE FILES ?
	SNA CLA		/Y
	JMP I EXE2	/N
OPTQ,	JMS QUERY	/ASK YES OR NO
	SKP		/Y RETURN
	JMP .+3		/NO RETURN
	JMS LOOKUP	/LOOKUP FILE
	JMS WRITE	/WRITE AWAY
R2,	TAD [4		/UPDATE POINTER
	TAD POINT
	JMP EXE2L	/NEXT FILE

LOOKUP,	HLT		/LOOKUP FILE
	TAD POINT
	DCA NAM
	TAD DEVNO
	CIF 10
	JMS I [200
	 2		/LOOKUP
NAM,	 0
	 0		/LENGTH
OPTN,	JMP I [ERROR2	/NOT FOUND
	CLA IAC
	TAD NAM
	DCA I [STBL+OFSET /SET BLOCK#
	TAD NAM
	DCA NAM1
	JMS I HNDLR	/READ CORE CONTROL BLOCK OF
	 300		/TRUE FILE CBUF		/DING IS EASIER INLSO READ FIRST WORD OF FPUT ERROR, MUST BE SERIO
	TAD [NUMBER	/TEST # OF ENTRIES IN .SV-FILE
	SNL CLA
	 JMP I [ERROR7	/TOO MUCH
	TAD I [CCCBUF+3	/JSW
	DCA I [JSW1+OFSET
	TAD I [CCCBUF+5
	AND [70
	TAD [CDF
	DCA I [MTEST+OFSET /BUILD IN TEST TO CHECK FILE
CK WORD
	CIA
	DCA I [MOMPARE
	JMP I LOOKUP
ILE
	TAD POINT
	DCA NAON SYS:
	CIF 10
	JMS I [200
	 3		/ENTER
NAM2,	 0		/BECOMES STBL
	 0
	 JMP I [ERROR3	/NO ROOM
	TAD NAM2
	DCA SBL		/SET BLOCK
	JMS I [SHNDLR
	 4300		/3 PAGES FIELD 0
	 CONTNT
SBL,	 0
	 JMP I [ERROR4	/OUTPUT ERROR
	TAD POINT
	DCA NAM3
	CLA IAC
	CIF 10
	JMS I [200
	 4		/CLOSE
NAM3,	 0
	 2		/2 BLOCKS
	 JMP I [ERROR5	/CLOSE ERROR
	JMP I WRITE	/RETURN

QUERY,	HLT		/ASK Y OR N
	JMS I [PRNAM	/PRINT NAME
	TAD ["?
	JMS I [TYP
	JMS I [LISN
	DCA T1
	JMS I [CRLF
	TAD T1
	TAD [-"Y
	SZA CLA
	 ISZ QUERY
	JMP I QUERY	/RETURN

OPTL,	JMS LIST	/PRINT NAME
LIST,	HLT		/WILL REPLACE QUERY, IF /L
	JMS I [PRNAM
	JMS I [CRLF
	JMP I LIST

T1,	0

PAGE
IFDEF FYSIOLOGY <
EDIT,	HLT		/SETUP EDIT
	TAD OPTAL
	RTR		/KVEDIT ?
	SZL CLA		/N
	JMP KVEDIT	/Y
	TAD OPTMX
	SMA CLA		/MFEDIT ?
	 TAD [EDITSV-MFL/N
MFEDIT,	TAD [MFL-KVL
KVEDIT,	TAD [KVL
	DCA POINT
	JMS I [LOOKUP
	TAD [EDITSV
	DCA POINT
	JMS I [WRITE
JIEDIT,	JMP I EDIT	/RETURN

KVL,	FILENLENA EDITMF.V3
	0
EDIT>
CRLF,	HLT
	TAD [215JMS TYP
	JMP I CRLF

SF
	 JMP .-1
	JMP I TYP

LISN,	HLT
	KSF
	 JMP .-1
	KRB
	DCA T2
	TAD T2
	JMS TYP
	TAD T2
	TAD [-203	/CTRL/C ?
	SNA CLA
	 JMP I [7600
	TAD T2
	JMP I LISN

T2,
PRNAM,	HLT		/PRINT NAME
	TAD POINT
	DCA T4
	JMS PR2
	JMS PR2
	JMS PR2
	TAD [".
	JMS TYP
	JMS PR2
	JMP I PRNAM	/RETURN
PR2,	HLT
	TAD I T4
	RTR
	RTR
	RTR
	JMS PR3
	TAD I T4
	JMS PR3
	ISZ T4
	JMP I PR2

PR3,	HLT
	AND [77
	SZA
	TAD [240
	AND [77
	TAD [240
	JMS TYP
	JMP I PR3

T4,
PRSTR,	HLT
	TAD I PRSTR
	SNA CLA
	JMP I PRSTR
	JMS PR2
	JMP PRSTR+1

PAGE
CONTNT,	RELOC 7000
	7777	/1 SEGMENT
	6203	/STARTING FIELD
	7400	/STARTING ADDRESS
JSW1,	6000	/JSW-BITS
	7400	/LOADING ADDRESS
	0100	/1 PAGE FIELD O
	RELOC

ERROR0,	JMS I [PRSTR
	TEXT *ONLY IN THE BACKGROUND OF TOPS8*
	0
	JMP I [7600

ERROR1,	JMS I [PRSTR
	TEXT *DSK0 NOT CORE RES.*
	0
	JMP I [7600

ERROR2,	JMS I [PRNAM
	JMS I [PRSTR
	TEXT * NOT FOUND*
	0
	JMP ERCRLF
ERROR3,	JMS I [PRSTR
	*
	0
ERRNAM,	JMS I [PR
	JMP I [R2

ERROR4,	PUT ERROR, SKIPPING *
	,	JMS I [PRSTR
	TEXT *CLOSE ERROR, SKIPPING *
	0
	JMP ERRNAM
ERROR6,	JMS I [PRSTR
	TEXT *ERROR READING CCB OF *
	0
	JMS I [PRNAM
	JMP I [7600

ERROR7,	JMS I [PRNAM
	JMS I [PRSTR
	TEXT * HAS TOO MUCH ENTR
PAGE
SLIST,	FILENA FAMS
	FILENA DIRECT.SV	/ILENA PIP.SV		/
	FILENAT.SV		/
	FILENA HELP.SV		/
	FILENA SHSAVE.SV	/
	ZBLOCK 1		/ END OF STANDARD LIST

EXLIST,	FILENA INFO.SV		/ EXPOGRAPH PROGRAMS
	FILENA IMAGE.SV		/
	FILENA TIME.SV	/
	FILENA CHEC.SV		/
	FILENA TIME.SV		/
	FILENA LABLE.SV		/
	FILENA BTC.SV		/
	ZBLOCK 1		/ END OF EX LIST

MCLIST,	FILENA MACREL.SV	/ MACREL LIST
	FILENA MACERR.SV	/
	FILENA MACOVR.SV	/
	FILENA LOADER.SV	/
	FILENA KREF.SV		/
	FILENA LINK.SV		/
	FILENA LOADER.SV	/
	ZBLOCK 1		/ END MACREL LIST

BLIST,	FILENA BRTS.SV		/ BASIC PROGRAMS
	FILENA BASIC.SV		/
	FILENA BCOMP.SV		/
	FILENA BLOAD.SV		/
	ZBLOCK 1		/ END OF BASIC LIST

PLIST,	FILENA PAL8.SV		/ PAL8 PROGRAMS
	FILENA ABSLDR.SV	/
	FILENA CREF.SV		/
	FILENA BITMAP.SV	/
	ZBLOCK 1		/ END OF PAL8 LIST

	PAGE
IFNZRO .-400-CONTNT <LOCERR, XERROR>
OFSET=.-7400

RELOC 7400
/THIS ROUTINE CHAINS TO THE PROGRAM ON DSK0:
/THE BLOCKNUMBER IS AT MCHREC
/IF THERE WAS A CHAIN TO THIS PROGRAM
/THE PROGRAM WILL BE STARTED AT STARTING D+1		/STARTING ADDRESS, C		/CHAINED TO
	6254		/ERR	/ONLY IN THE BACKGROF+2	/STARTING ADDRESS (+1 IF CHAINED)
	DCA I CMSTADR	/TO PAGE 7600
	TAD STBL
	DCA MCHREC	/FOR REENTRANCY
	TAD CCBUF
	DCA CCTEM	/FOR REENTRANCY
	TAD CCBUF+1
	DCA I CSTFLD	/STARTING FIELD (FOR .ST)
	TAD CCBUF+2NG ADDRESS (IDEM)
	TAD CJSBITS
	TAD CCBUF+1	/XOCK
	DCA I CMSTCDF
	TA000,	TAD MCHFJM	/USE THIS AS A CONSTANT
	DCA I CMSWITC
MCHN1,	ISZ CCTEM
	 JMP MCHN2	/NOT THE LAST TRANSFER
	TAD I MCHT1	/THE LAST TRANSFER IS NOT DONE
	DCA I MREAD2	/HERE, BECAUSE IT COULD OVERLAY
	ISZ MCHT1	/THIS PAGE, AND WE WOULDN'T HAVE
	TAD I MCHT1	/THE OPPORTUNITY TO JUMP ANYWHERE
	DCA I MREAD1	/SO WE USE THE DEDICATED PIECE
	TAD MCHREC	/OF PROGRAM FROM 07577 ON.
	DCA I MREAD3
	TAD HANDLER	/ADDRESS OF DSK0: HANDLER
	DCA I MREADM1
	JMP I CMREAD	/THERE WE GO
MCHN2,	TAD I MCHT1
	DCA MCHADR	/SET COMMAND TO READ NEXT SEGMENT
	ISZ MCHT1
	TAD I MCHT1
	DCA MCHCTL
	JMS I HANDLER
MCHCTL,	 0		/1 RECORD IN FLD 0
MCHADR,	 0
MCHREC,	 0
	 JMP CHERR	/ERROR READING SEGMENT
MTEST,	HLT		/CDF TO FIELD OF FIRST ENTRY
	TAD I MCHADR
	CDF 0
	TAD MCHECK	/TEST IF WORD IS STILL THE SAME
	SZA CLA
	 JMP CHERR	/NO, RUN SHSAVE AGAIN !
	TAD CJMP
	DCA MTEST	/ONCE ONLY CODING !
MCHBMP,	TAD MCHCTL
	TAD M100	/CONVERT PAGES TO BLOCKS
	CLL RTL
	AND .+1		/AND (7000, 
	RTL
	IAC		/NOW # OF AC
	TAD MCHREC
	DCA MCCHN1	/LOOP ON NUMBER OF M,	MSTCDF&177+5200	/"JMP MSTCDF"

CHERR,
C7600,	7600	/CLA
	TAD C1000	/NOT EXACTLY 1000, WHO CARES ?
	DCA I CJSBITS	/SET NON-RESTARTABLE
CHTADC,	TAD CHARS
	SPA
	 JMP I C7600	/LAST CHAR: TO MONITOR
	TLS
	TSFNOT IN THE BG.
M100,	77IP
	ISZ CHTADC	/NEXT CH	"S;"H;".;"S;"V;" ;"E;"RLD	/FIRST WORD AFTER CHARS MUST BE NEG.
CSTADDR,STADDR
CJSBITS,JSBITS
MREADM1,MREAD-1
CMREAD,	MREAD
MREAD2,	MREAD+2
MREAD3,	MREAD+3
CMSWITC,MSWITC
CMSTCDF,MSTCDF
CMSTADR,MSTADR
CCBUF4,	CCBUF+4
CJMP,	JMP MCHBMP
HANDLER,0	/DSK0 FAKE HANDLER ENTRY POINT
CCTEM,	0
STBL,	0
MCHECK,	0

CCBUF=.

RELOC

CCCBUF=.



$$$$$$$$