Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0131/libcvt.mac
There are 2 other files named libcvt.mac in the archive. Click here to see a list.
TITLE	LIBCVT -- CONVERT UFLIP LIBRARIES TO LIBMAN LIBRARIES
SUBTTL	B. SCHREIBER - U OF I HEPG
SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIRECT	.XTABM
SALL

.REQUE	REL:ALCOR
.REQUI	REL:HELPER
.REQUE	REL:WLD7A
.REQUE	REL:SCN7B
SUBTTL	DIRECTIVES

ND LN$PDL,200	;PUSH DOWN LIST LENGTH

F=0
T1=1
T2=2
T3=3
T4=4
P1=5
P2=6
P3=7
P4=10
P=17
	N=P3
	C=P4

INPC==1
OUTC==2
ATSIGN==(1B13)

OPDEF	CALL	[PUSHJ	P,]
SUBTTL	ERROR MACRO DEFINITIONS

;ERR$	($FLGS,$PFX,$MSG)
;
;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:

	EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
	EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
	EF$WRN==200	;WARNING MESSAGE--CONTINUE
	EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
	EF$NCR==40	;NO FREE CRLF AFTER MESSAGE

DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>

ZZ==0		;TYPE CODES ARE FROM 1-37

ETYP (DEC)	;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT)	;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX)	;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN)	;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR)	;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL)	;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP (HEX)	;TYPE T1 IN HEXADECIMAL AT END OF MESSAGE
	EF$MAX==ZZ	;MAX ERROR TYPE

IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>

;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF

NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP

DEFINE	ERR$	($FLGS,$PFX,$MSG)
<CALL	EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ] ]
>

;WARN$	FLGS,PFX,MSG

DEFINE	WARN$	($FLGS,$PFX,$MSG)
<ERR$	EF$WRN!$FLGS,$PFX,$MSG>

;INFO$	FLGS,PFX,MSG

DEFINE	INFO$	($FLGS,$PFX,$MSG)
<ERR$	EF$INF!$FLGS,$PFX,$MSG>
;SAVE$ SAVES DATA ON THE STACK

DEFINE	SAVE$	(X)
<XLIST
IRP X,<PUSH P,X>
LIST>

;RESTR$ RESTORES DATA FROM THE STACK

DEFINE	RESTR$	(X)
<XLIST
IRP X,<POP P,X>
LIST>

;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE

DEFINE	U ($NAME,$WORDS<1>)
<$NAME:	BLOCK	$WORDS>

;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG

DEFINE STRNG$ (S)
<MOVEI	T1,[ASCIZ \S\]
CALL	.TSTRG##>

;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY

DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>
SUBTTL	MAIN PROGRAM

TWOSEG
RELOC	400000
LIBCVT:	JFCL		;NO CCL ENTRY
	RESET		;STOP I/O
	MOVE	P,[IOWD LN$PDL,PDLIST] ;SETUP PDL
	CALL	.RECOR##	;RESET CORE
	STRNG$	<LIBCVT -- CONVERT UFLIP LIBRARIES TO LIBMAN LIBRARIES
>
	STRNG$	<TYPE FILENAME WHEN PROMPT APPEARS (MAY USE WILDCARDS)
>

GETLIB:	CLRBFI			;EAT ANY TYPEAHEAD
	SETZ	T1,		;CLEAR FOR .ISCAN
	CALL	.ISCAN##	;INIT SCAN
	SETZ	T1,		;NO BLOCK AT ALL
	CALL	.PSCAN##	;INIT PARTIAL SCANNER
	 JFCL			;IGNORE SKIP
	STRNG$	<UFLIP FILES (SEPARATE BY COMMAS--MAY USE WILD CARDS)
*>
GETFIL:	CALL	.FILIN##	;READ A FILE SPEC
	 MOVEI	T1,.FXLEN	;GET ROOM FOR IT
	CALL	.ALCOR##
	PUSH	P,T1		;SAVE A SECOND
	MOVEI	T2,.FXLEN	;SIZE OF THE THING
	CALL	.GTSPC##	;COPY SPEC OVER
	POP	P,T1		;GET ADDR
	HRLOI	T2,'UFL'	;IN CASE DEFAULT EXT NEEDED
	SKIPN	.FXEXT(T1)	;CHECK
	MOVEM	T2,.FXEXT(T1)	;...
	MOVEI	T2,SPCLST	;LINK INTO LIST
	CALL	LNKATN		;...
	JUMPG	C,GETFIL	;GET ALL FILES

	CALL	DOFILS		;CONVERT ALL THE FILES
	JRST	LIBCVT		;GO AGAIN
SUBTTL	DOFILS

DOFILS:	CALL	.SAVE4##	;PRESERVE REGISTERS
	STRNG$	<
FILES CONVERTED:
>
	MOVE	P1,SPCLST	;POINT FOR WILD

DOFL.0:	SETZM	WLDPTR		;CLEAR TEMP STORE
DOFL.1:	HRRZM	P1,WLDFIR	;TELL WHERE SPEC IS
	MOVE	T1,LKWLDB
	CALL	.LKWLD##	;FIND ONE
	 JRST	DOFL.9		;NO MORE HERE
	MOVEI	T1,.IOBIN	;SET MODE
	MOVEM	T1,OPNBLK+.OPMOD
	MOVEI	T1,IBHR
	HRRZM	T1,OPNBLK+.OPBUF
	OPEN	INPC,OPNBLK	;OPEN THE DEVICE
	 JRST	[CALL	E.DFO##	;REPORT ERROR
		JRST	DOFL.1]	;GO AGAIN
	MOVE	T1,[XWD LKPBLK,DSKLKP]
	BLT	T1,DSKLKP+.RBTIM-1
	LOOKUP	INPC,LKPBLK
	JRST	[CALL	E.DFL##	;REPORTERROR
		JRST	DOFL.1]
	MOVSI	T1,'LIB'	;CHANGE EXT
	HLLZM	T1,DSKLKP+.RBEXT
	MOVEI	T1,.IOBIN
	MOVEM	T1,DSKOPN+.OPMOD
	MOVE	T1,OPNBLK+.OPDEV
	MOVEM	T1,DSKOPN+.OPDEV
	MOVSI	T1,OBHR
	MOVEM	T1,DSKOPN+.OPBUF
	OPEN	OUTC,DSKOPN
	JRST	[ERR$	(EF$ERR,ODE,<OUTPUT DEVICE OPEN ERROR>)
		JRST	DOFL.1]
	SETZM	DSKLKP+.RBPPN	;WRITE TO DEFAULT DIR
	ENTER	OUTC,DSKLKP
	 JRST	[ERR$	(EF$ERR,OEE,<OUTPUT ENTER ERROR>)
		JRST	DOFL.1]
	MOVSI	T1,6
	MOVE	T2,[XWD OPNBLK,IBHR]
	CALL	.ALCBF##
	MOVSI	T1,6
	MOVE	T2,[XWD DSKOPN,OBHR]
	CALL	.ALCBF##
	OUTPUT	OUTC,		;DUMMY OUTPUT

;***COPY THE FILE--AND CONVERT IT
FNDFIL:	CALL	XCTIO
	IN	INPC,		;XCTD
	 JRST	FILDUN		;ALL DONE
	MOVE	P2,IBHR+.BFPTR	;GET BUFFER PTR
	MOVE	T1,.RBCNT+1(P2)	;GET COUNT
	CAIE	T1,32		;A UFLIP RIB BLOCK?
	 JRST	FNDFIL		;NO--MUST FIND A RIB
	HRLZ	T1,IBHR+.BFPTR	;YES--COPY FILE
	HRR	T1,OBHR+.BFPTR
	AOBJP	T1,.+1
	MOVEI	T2,177(T1)	;END OF BLT
	MOVEI	T3,(T1)		;REMEMBER WHERE .RBCNT IS
	BLT	T1,(T2)		;...
	MOVEI	T1,.RBTIM	;SET CORRECT COUNT
	MOVEM	T1,(T3)		;...
	MOVE	T1,OBHR+.BFCTR	;GET BUFFER COUNT
	SETZM	OBHR+.BFCTR	;CLEAR IT
	ADDM	T1,OBHR+.BFPTR	;UPDATE THE PTR
	CALL	XCTIO
	 OUT	OUTC,
	  HALT	.		;SNH
	MOVE	P2,.RBSIZ+1(P2)	;GET FILE SIZE
	ADDI	P2,177		;ROUND UP
	LSH	P2,-7		;CVT TO BLOCKS
CPYFIL:	CALL	XCTIO
	 IN	INPC,
	  HALT
	HRLZ	T1,IBHR+.BFPTR
	HRR	T1,OBHR+.BFPTR
	AOBJP	T1,.+1
	MOVEI	T2,177(T1)
	BLT	T1,(T2)
	MOVE	T1,OBHR+.BFCTR
	SETZM	OBHR+.BFCTR
	ADDM	T1,OBHR+.BFPTR
	CALL	XCTIO
	 OUT	OUTC,
	  HALT
	SOJG	P2,CPYFIL
	JRST	FNDFIL

FILDUN:	CLOSE	OUTC,
	RELEASE	OUTC,
	CLOSE	INPC,
	RELEASE	INPC,
	MOVEI	T1,IBHR
	CALL	.FREBF##
	MOVEI	T1,OBHR
	CALL	.FREBF##
	MOVE	T1,LKPBLK+.RBNAM
	CALL	.TSIXN##
	MOVEI	T1,"."
	CALL	.TCHAR##
	HLLZ	T1,LKPBLK+.RBEXT
	CALL	.TSIXN##
	MOVEI	T1,[ASCIZ/=>/]
	CALL	.TSTRG##
	MOVE	T1,DSKLKP+.RBNAM
	CALL	.TSIXN##
	MOVEI	T1,"."
	CALL	.TCHAR##
	HLLZ	T1,DSKLKP+.RBEXT
	CALL	.TSIXN##
	CALL	.TCRLF##
	JRST	DOFL.1

LKWLDB:	XWD	5,.+1
	XWD	WLDFIR,0
	XWD	OPNBLK,LKPBLK
	XWD	.FXLEN,.RBTIM+1
	XWD	0,WLDPTR
	EXP	0

DOFL.9:	HRRZ	P1,-1(P1)	;GO TO NEXT
	JUMPN	P1,DOFL.0	;GO IF MORE
	POPJ	P,		;DONE
SUBTTL	OTHER STUFF

LNKATN:	SKIPN	(T2)	;LIST THERE?
	JRST	[MOVEM	T1,(T2) ;NO--START IT
		JRST	MRKEND]
	CALL	.SAVE2##
	MOVE	P1,(T2)		;HEAD OF LIST
	MOVE	P2,P1		;COPY IT
	HRRZ	P1,-1(P1)	;LINK TO NEXT
	JUMPN	P1,.-2		;TILL WE GET TO END
	HRRM	T1,-1(P2)	;LINK INTO LIST
MRKEND:	HLLZS	-1(T1)		;MAKE SURE REALLY END
	POPJ	P,

XCTIO:	XCT	@0(P)		;DO THE IN/OUT
	 JRST	$POPJ2		;OK--SKIP 2
	MOVE	T1,@0(P)
	CALL	.SAVE2##
	MOVE	P1,T1
	AND	T1,[17B12]
	OR	T1,[GETSTS P2]
	XCT	T1
	TRNE	P2,IO.EOF!IO.EOT
	 JRST	.POPJ1##	;EO?
	MOVE	T1,P2		;COPY CODE
	WARN$	EF$OCT,IOE,<I/O ERROR STATUS=>
	TRZ	P2,IO.ERR
	TLZ	P1,002000	;NOW A SETSTS
	TRO	P1,P2		;SET IN
	XCT	P1
$POPJ2:	AOS	(P)
	JRST	.POPJ1##
SUBTTL	ERROR HANDLER

;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERR$ MACRO

EHNDLR:	CALL	SAVACS		;SAVE THE ACS
	MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
	MOVEI	T1,"?"		;ASSUME AN ERROR
	TLNE	P1,EF$WRN	;CHECK WARNING
	MOVEI	T1,"%"		;YES
	TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
	MOVEI	T1,"["		;GOOD THING WE CHECKED
	CALL	.TCHAR##	;OUTPUT THE START OF MESSAGE
	MOVSI	T1,'CVT'	;MY PREFIX
	HLR	T1,(P1)		;GET MESSAGE PREFIX
	CALL	.TSIXN##	;OUTPUT THE PREFIXES
	CALL	.TSPAC##	;AND A SPACE
	HRRZ	T1,(P1)		;GET STRING ADDRESS
	CALL	.TSTRG##	;SEND IT
	MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
	LDB	T2,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
	CAILE	T2,EF$MAX	;CHECK LEGAL
	 MOVEI	T2,0		;NOOOP
	CALL	@ERRTAB(T2)	;CALL THE ROUTINE
	TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
	 JRST	EHND.1		;NO--DON'T CHECK
	MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
	TLNE	P1,EF$INF	;CHECK FOR INFO
	CALL	.TCHAR##	;SEND INFO CLOSE
	TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
	CALL	.TCRLF##	;YES--SEND ONE
EHND.1:
EHND.2:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
	 JRST	ERRFTL		;YES--GO DIE
	;FALL INTO RESACS
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
;	CALL	RESACS
;	*ACS RESTORED FROM SAVAC*

RESACS:	MOVEM	17,SAVAC+17
	MOVSI	17,SAVAC
	BLT	17,17		;REGISTERS ARE RESTORED
	POPJ	P,		;RETURN

ERRTAB:	.POPJ##			;CODE 0 -- NO ACTION
	.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
	.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
	.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
	.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
	.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
	.TFBLK##		;CODE 6 -- T1 POINTS AT FDB
	.THEXW			;CODE 7 -- TYPE T1 IN HEXADECIMAL

;HERE TO DIE--

ERRFTL:	RESET			;KILL ALL FILES
	JRST	LIBCVT		;GO AGAIN

;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
;	*ACS SAVED IN SAVAC*	BEWARE!!

SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16
	MOVE	17,SAVAC+17
	POPJ	P,		;ACS ARE SAVED

;.THEXW -- TYPE CONTENTS OF T1 IN HEX
;CALL:	MOVE	T1,<WORD>
;	CALL	.THEXW
;USES T1-4

.THEXW:	MOVEI	T3,^D16		;GET HEX RADIX INTO T3
	PJRST	.TRDXW##	;LET SCAN TYPE IT

;TYSLSH -- TYPE A SLASH THROUGH .TCHAR

TYSLSH:	MOVEI	T1,"/"
	PJRST	.TCHAR##	;DONE
SUBTTL	STORAGE

RELOC	0
FW$ZER:
PDLIST:	BLOCK	LN$PDL
IBHR:	BLOCK	3
OBHR:	BLOCK	3
WLDFIR:	BLOCK	1
WLDPTR:	BLOCK	1
SAVAC:	BLOCK	20
OPNBLK:	BLOCK	3
LKPBLK:	BLOCK	.RBTIM
ERRTYX:	BLOCK	1
DSKOPN:	BLOCK	3
DSKLKP:	BLOCK	.RBTIM
SPCLST:	BLOCK	1

	RELOC		;LITS IN HIGHSEG
	XLIST		;LISTS
	LIT
	LIST
	END	LIBCVT