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