Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/wbcd/wbcd.mac
There are 2 other files named wbcd.mac in the archive. Click here to see a list.
TITLE WBCD TAPE CONVERSION PROGRAM
SUBTTL RUSS BARR - WESTERN MICHIGAN UNIV
SEARCH UUOSYM
;THE ORIGINAL VERSION OF THIS PROGRAM WAS A MODIFICATION
;OF BCD.MAC. BCD.MAC WAS WRITTEN BY CHUCK LANE - WMU.
;LOAD INSTRUCTIONS:
;SHARABLE VERSION
; .LOA WBCD,USESUB
; .SSA WBCD
; .PRO<166>WBCD.SHR
; OR
;NON-SHARABLE VERSION
; .MA PURE.MAC
; PURE==0
; EX$$
; .LOA WBCD=PURE+WBCD,USAGE
; .SAV WBCD
; .PRO<166>WBCD.SAV
IFNDEF PURE,<PURE==1> ;REENTRENT VERSION IF PURE#0
IFN PURE,<TWOSEG>
VWBCD==04
VEDIT==02
VMINOR==02 ;SHARABLE VERSION(4-JUN-76)
VWHO=4
JOBVER=137
LOC JOBVER
BYTE (3)VWHO(9)VWBCD(6)VMINOR(18)VEDIT
RELOC
;ACCUMULATOR DEFINITIONS
F=0 ;FLAGS
A=1
B=2
C=3
D=4
E=5
CNVRT=6 ;MUST BE PRESERVED(CONVERSION INSTRUCTION)
CNT=7
LINPNT=10
CHR=11
FPNT=12
INCNT=13
RCNT=14
MATCH=15
P=17
; I/O CHANNELS
ICH==16
OCH==17
UCH==15
SUBTTL FLAG DEFINITIONS
;FLAG BITS(LH)
COMSEN==200 ;COMMA SEPARATES FILE SPECS
; FLAG BITS(RH)
IGNORE==200000 ;IGNORE ERROR FLAG
NUM==4000 ;NUMBER SEEN IN INPUT ROUTINE
NEGS==2000 ;NEGATIVE SIGN SEEN
PLUS==1000 ;PLUS SIGN SEEN
WLDFLG==400 ;WILD SYMBOL '*' OR '?' SEEN
;FLAG BITS (RH - USED ONLY IN GETNAM)
NSW==40000 ;PROCESS N RECORDS ONLY
WSW==20000 ;REWIND TAPE
SOMESW==10000 ;SOME VALID SWITCH TYPED AFTER /
BSW==200 ;TO TRANSFER BINARY FILE EXTENSIONS WITH WILD
STRSET==100 ;SINGLE STR WILD SEARCH
XDEV==40
XSLASH==20
XDOT==10
EXTSEN==4
FILSEN==2
DEVSEN==1
TAPLEG: BLOCK 1
TAPDEN: BLOCK 1
TAPBLK: BLOCK 4
SUBTTL STARTUP AND DIALOGUE
IFN PURE,<RELOC 400000>
START: PORTAL .+2 ;BEWARE CCL START
PORTAL .+1
RESET
OUTSTR [ASCIZ/
WMU - FILE TO TAPE TRANSLATION PROGRAM
/]
MOVE P,[IOWD 40,PDL]
MOVEI 16,[EXP [ASCII/WBCD /]]
; PUSHJ P,USAGEB##
MOVE A,[SIXBIT/WBCD /]
DEVCHR A,
JUMPE A,NTAVL ;BCD DOESN'T EXIST
TLNN A,(1B13) ;IS BCD A MAGTAPE
JRST NOTAPE ;NO
GETPPN A, ;GET TRUE PPN
JFCL ;WORRY ABOUT SKIP RETURNS
MOVEM A,PPNSAV# ;NO FANCY-PATHS
SETZ F, ;CLEAR ALL FLAGS
MOVEI A,5 ;SET UP LOW SEG
MOVEM A,UFDFIL
MOVE A,[1,,1]
MOVEM A,UFDPPN
HRLZI A,'UFD'
MOVEM A,SLFPPN+1 ; LOW SEG SET UP.
MOVEI A,16
MOVEM A,STRBLK
SETZM STRBLK+2
SETZM TAPDEN ;ASSUME 800 BPI/NO TAPOPS.
MOVEI A,.TFPDN ;SET UP FOR TAPOP.
MOVEM A,TAPBLK
MOVE A,[SIXBIT/WBCD/]
MOVEM A,TAPBLK+1
MOVEI A,.TFD80
MOVEM A,TAPDEN
MOVE A,[XWD 3,TAPBLK]
TAPOP. A, ;GET LEGAL DENSITIES
JRST GETCNV ;ASSUME NO TAPOPS.
MOVEM A,TAPLEG ;SAVE LEGAL DENSITIES
TRNN A,TF.DN4!TF.DN5 ;ANY GREATER THAN 800 POSSIBLE?
JRST GETCNV ;NO. DON'T ASK
GETDEN: OUTSTR [ASCIZ/Tape density: /]
PUSHJ P,IN ;GET DENSITY
CAIGE A,^D800 ;AT LEAST 800?
JRST ILLDEN ;NO. ILLEGAL
SETZ B, ;ASSUME ILLEGAL
CAIN A,^D800
MOVEI B,.TFD80
CAIN A,^D1600
MOVEI B,.TFD16
CAIN A,^D6250
MOVEI B,.TFD62
JUMPE B,ILLDEN ;ILLEGAL?
MOVEM B,TAPDEN ;STORE DESIRED DENSITY
MOVEI A,1
LSH A,-1(B) ;POSITION BIT
TDNN A,TAPLEG ;IS IT LEGAL
JRST BADDEN ;NO.
GETCNV: OUTSTR LIT0 ;ASK FOR INPUT CODE
PUSHJ P,GETLIN
ILDB A,LINPNT
SKIPN A
MOVEI A,"E" ;ASSUME EBCDIC
MOVSI B,-CNVNUM ;NEGATIVE NUMBER OF CONVERSIONS
CAME A,CNVTAB(B) ;MATCH?
AOBJN B,.-1 ;NO. LOOK AT NEXT
JUMPGE B,CNVERR ;GIVE ERROR IF NONE MATCHES
MOVE C,CNVLST(B) ;GET THE RIGHT CONVERT INST.
MOVEM C,CNVRT ;SAVE IT
ASKBLK: OUTSTR LIT1 ;ASK ABOUT BLOCKING FACTOR
PUSHJ P,IN
JUMPG A,ASKBK1 ;MUST BE POSITIVE
OUTSTR BADNEG ;COMPLAIN
JRST ASKBLK ;AND TRY AGAIN
ASKBK1: MOVEM A,BLKFAC
ASKREC: OUTSTR LIT2 ;ASK ABOUT RECORD SIZE
PUSHJ P,IN
JUMPG A,ASKRC1 ;MUST BE POSITIVE
OUTSTR BADNEG ;COMPLAIN
JRST ASKREC ;AND TRY AGAIN
ASKRC1: MOVEM A,RECSIZ
IMUL A,BLKFAC
ADDI A,3
IDIVI A,4
MOVEM A,BUFSIZ ;# OF WORDS IN BUFFER IS AN EVEN MULTIPLE OF 4
MOVEI A,BUF1 ;GET LOCATION OF BUFFER
ADD A,BUFSIZ ;ADD SIZE OF BUFFER
MOVE B,A
CAMGE A,.JBREL## ;DO WE NEED MORE CORE
JRST OK ;NO
CORE A, ;YES GET IT
JRST NOCORE ;GIVE ERROR IF CANT GET ENOUGH SPACE
OK: HRRM B,.JBFF## ;SAVE NEW TOP TWICE
HRRM B,JBFFSV#
SOJ B,
MOVEM B,HIGHDT ;HIGHEST DATA LOCATION
MOVN B,BUFSIZ ;-# OF WORDS IN BUFFER
HRLI B,BUF1-1
MOVSM B,OUTLST ;SETUP IOWD
SETZM OUTLST+1
PUSHJ P,TINIT ;INITIALIZE TAPE
POSIT: OUTSTR LIT3 ;ASK ABOUT REWIND
PUSHJ P,YESNO ;SKIP UNLESS 'Y'
MTREW. OCH,
MTWAT. OCH,
OUTSTR LIT4 ;ASK ABOUT FILE POSITION
PUSHJ P,IN
JUMPGE A,SKF
MTBSF. OCH,
MTWAT. OCH,
AOJLE A,.-2 ;MUST DO N+1 BACKSPACE COMMANDS
STATO OCH,1B24 ;AT LOAD POINT?
;IF NOT, MUST DO ONE SKIP FILE
MTSKF. OCH,
MTWAT. OCH,
SKF: SOJG A,.-2
SUBTTL "INPUT?" DIALOGUE
ASKNAM: TLZE F,COMSEN ;NOSKIP AND CLEAR IF COMMA SEEN
JRST ASKCOM ;COMMA SEEN
OUTSTR [ASCIZ/
INPUT? /]
PUSHJ P,GETLIN ;GET NEW LINE
ASKCOM: SETZM NAME
SETZM DEV
SETZB B,EXT
SETZM EXT+1
SETZM EXT+2
HLLZS F ;CLEAR THE GETNAM(RH) SWITCHES
SETOM MASK
SETOM MASK+1
HLLZS MASK+1
GETWRD: SETZM BUF1 ;CLEAN HOUSE
SETOM BUF1+1
MOVEI A,6
MOVE C,[POINT 6,BUF1] ;ASSEMBLE A WORD HERE
MOVE E,[POINT 6,BUF1+1] ;ASSEMBLE MASK HERE
GETNAM: ILDB B,LINPNT ;LINPNT SETUP BY GETLIN
JUMPE B,GTNAME ;JUMP ON EOL(0)
CAIE B,"/" ;SLASH?
CAIN B,"," ;COMMA?
CAIA ;SKIP ON EITHER
JRST GTNAMF ;NEITHER
GTNAME: TRNN F,XSLASH ;XSLASH SET?
JRST GTNAMB ;NO
JRST GTNAMJ ;YES
GTNAMF: CAIE B,"." ;PERIOD?
JRST GTNAMG ;NO
TRON F,XDOT ;XDOT SET?
JRST GTNAMC ;NO
JRST BADNAM ;YES
GTNAMG: CAIE B,":" ;COLON?
JRST GTNAMH ;NO
TRNN F,XDEV ;YES, XDEV SET?
JRST GTNAMD ;NO
JRST BADNAM ;YES, DOUBLE DEV ILLEG.
GTNAMH: CAIE B,"*" ;WILD SYMBOL
JRST GTNAM2 ;NO
JUMPLE A,GETNAM ;LEGAL BUT NO MORE ROOM
TRO F,WLDFLG ;NO REMEMBER WE'RE WILD
SETZ B, ;SET CHR TO ZERO
IDPB B,C ;DEPOS IN BUF1
IDPB B,E ;DEPOS IN MASK
SOJG A,.-2 ;FINISH OUT THE WORD
JRST GETNAM
GTNAM2: CAIE B,"?" ;WILD SYMBOL?
JRST GTNAM3 ;NO
JUMPLE A,GETNAM ;LEGAL CHR BUT NO MORE ROOM
TRO F,WLDFLG ;NO, REMEMBER WE'RE WILD
SETZ B, ;SET CHR TO ZERO
IDPB B,C ;DEPOS IN BUF1
IDPB B,E ;DEPOS IN MASK
SOJA A,GETNAM ;DECR AND GET NEXT CHR
GTNAM3: CAIL B,"0"
CAILE B,"Z" ;CHECK LEGAL NAME
JRST BADNAM
CAILE B,"9"
CAIL B,"A"
JRST .+2
JRST BADNAM
JUMPLE A,GETNAM ;SKIP IF ALREADY GOT LEGAL NUMBER
TRC B,40
IDPB B,C ;NO, DEPOSIT IT
IBP E ;DON'T DISTURB THE MASK
SOJA A,GETNAM
;HERE IF IT LOOKS LIKE A FILE OR EXT
GTNAMB: TRNE F,XDOT ;SKIP IF DOT NOT SEEN BEFORE
JRST GTNAMI ;SEEN BEFORE
;HERE IF IT ONLY LOOKS LIKE A FILE
GTNAMC: TROE F,FILSEN ;SKIP IF FILE NOT SEEN BEFORE AND SET THE BIT
JRST BADNAM ;FILE SEEN, DOUBLE FILE ILLEG.
MOVE A,BUF1 ;GET NAME
MOVEM A,NAME ;STORE IT
MOVE A,BUF1+1 ;GET NAME MASK
MOVEM A,MASK ;STORE IT
CAIE B,"." ;DOT GOT US HERE?
JRST GTNAMM ;NO
JRST GETWRD
GTNAMI: TROE F,EXTSEN ;SKIP IF EXT NOT SEEN BEFORE AND SET THE BIT
JRST BADNAM ;DOUBLE EXT ILLEG.
MOVE A,BUF1 ;GET EXT
MOVEM A,EXT ;STORE IT
HLLZ A,BUF1+1 ;GET EXT MASK
MOVEM A,MASK+1 ;STORE IT
GTNAMM: CAIE B,"/" ;SLASH GOT US HERE?
JRST GTNAMN ;NO
JRST GTNAMK ;YES
;SWITCH HANDLER
GTNAMJ: CAIE A,5 ;CHR COUNT=1?
JRST BADNAM ;NO - SINGLE CHR SWITCHES ONLY
LDB A,[POINT 6,BUF1,5] ;RIGHT JUST THE 6BIT CHR
TRZ F,SOMESW ;FLAG SAYS WE SAY A SWITCH IF SET
CAIN A,'B' ;IS IT B?
TRO F,BSW!SOMESW ;YES
CAIN A,'W' ;IS IT W?
TRO F,WSW!SOMESW ;YES
CAIN A,'N' ;IS IT N?
TRO F,NSW!SOMESW ;YES
CAIN A,'P' ;IS IT P?
JRST POSIT ;YES, GO TO POSITION TAPE
CAIN A,'H' ;IS IT H?
JRST [OUTSTR HLPMES
JRST ASKNAM]
TRZN F,SOMESW ;DID WE SEE A VALID SWITCH?
JRST BADNAM ;NO
GTNAMN: JUMPE B,GTNAMZ ;JUMP ON EOL
CAIE B,"," ;COMMA GOT US HERE?
GTNAMK: TROA F,XSLASH ;NO,MUST BE SLASH,SET ITS BIT AND SKIP
TLOA F,COMSEN ;YES,SET ITS BIT AND SKIP
JRST GETWRD ;MORE TO DO
JRST GTNAMZ ;DONE FOR NOW
;DEVICE HANDLER
GTNAMD: TRZE F,FILSEN!EXTSEN!XSLASH ;OUT OF ORDER DEV?
JRST BADNAM ;YES
TROE F,DEVSEN ;SKIP IF DEV NOT SEEN BEFORE AND SET ITS BIT
JRST BADNAM ;DOUBLE DEV ILLEG.
MOVE A,BUF1 ;GET DEV
MOVEM A,DEV ;STORE IT
JRST GETWRD
;HERE WHEN END OF SPEC IS ENCOUNTERED
GTNAMZ: MOVE B,NAME ;GET NAME
CAMN B,[SIXBIT/FINISH/]
EXIT
SKIPN B,DEV ;DO WE HAVE A DEVICE
MOVSI B,'DSK' ;NO, DEFAULT TO DSK
MOVEM B,DEV
TRNN F,WLDFLG ;WILD SET?
JRST OINIT ;NO
DEVPPN B,
JRST [OUTSTR [ASCIZ/
?NO SUCH DEVICE
/]
JRST BADNAM]
CAME B,PPNSAV ;SAME?
JRST [OUTSTR [ASCIZ/
?WILD CARD FILENAMES MUST BE FROM A DISK IN YOUR OWN AREA.
/]
JRST BADNAM] ;NO
MOVEM B,SLFPPN ;UFD LOOKUP BLOCK
MOVE B,DEV
CAME B,[SIXBIT/NUL/]
CAMN B,[SIXBIT/ALL/]
JRST [OUTSTR [ASCIZ/
?DEVICE NOT ALLOWED WITH WILDCARD
/]
JRST BADNAM]
MOVE C,[5,,DEV] ;FOR DSKCHR
DSKCHR C,
JRST [OUTSTR [ASCIZ/
?WILD CARD FROM NON-DISK IS ILLEGAL
/]
JRST BADNAM]
TLNE C,4 ;FILE STRUCTURE OR GENERIC NAME?
JRST [OUTSTR [ASCIZ/
?ILLEGAL FILE STRUCTURE NAME
/]
JRST BADNAM] ;NO
TLNE C,2 ;GENERIC NAME?
TRO F,STRSET ;NO - DON'T DO WILD DEVICE
MOVE B,NAME ;GET WILDIZED NAME
MOVEM B,WILD ;STORE IT
MOVE B,EXT ;SAME FOR EXT
MOVEM B,WILD+1
MOVE B,DEV+4 ;IN CASE OF STRSET
TRNE F,STRSET ;ONLY ONE STR?
JRST STRONC ;YES
SETOM STRLOC ;-1 TO GET 1ST STR.
SUBTTL STRUCTURE SEARCH
STRLUP: TRZE F,STRSET ;ONE STRUCTURE ONLY?(CLEAR STRSET ALSO)
JRST ASKNAM ;THIS SPEC DONE
MOVEI B,STRLOC ;ADR OF INFO BLOCK
JOBSTR B, ;GET NEXT STR
JRST [OUTSTR [ASCIZ/
?JOBSTR ERROR/]
HALT .]
MOVE B,STRLOC ;GET STR NAME
JUMPE B,ASKNAM ;JUMP IF AT FENCE
STRONC: MOVEM B,STRUFD
MOVEM B,STRDEV
OUTSTR [ASCIZ/
/]
PUSHJ P,PDVNAM ;PRINT DEVICE IN B
OUTSTR [ASCIZ/:
/]
RELEAS UCH,
OPEN UCH,STRBLK
JRST [OUTSTR [ASCIZ/
?CANT INIT UFD
/]
JRST STRLUP]
LOOKUP UCH,UFDFIL
JRST [OUTSTR [ASCIZ/
?CANT LOOKUP UFD
/]
JRST STRLUP]
MOREUF: INPUT UCH,UFDLST
STATZ UCH,740000 ;ERROR?
JRST [OUTSTR [ASCIZ/
?ERROR READING UFD
/]
JRST STRLUP] ;YES
STATZ UCH,20000 ;EOF IN UFD?
JRST STRLUP ;YES, GET ANOTHER
SETZM UFLNUM#
SETZ D,
JRST MOREF1
SUBTTL UFD SEARCH
SRHDIR: TRNN F,WLDFLG ;WILD SET?
JRST ASKNAM ;NO, GO BACK TO DIALOGUE
MOREFL: MOVE D,UFLNUM ;YES, GET POINTER INTO UFD BLOCK
ADDI D,2 ;POINT TO NEXT FILE
CAILE D,177 ;END OF BLOCK?
JRST MOREUF ;YES, GET NEXT BLOCK
MOVEM D,UFLNUM ;IT COULD BE A WHILE BEFORE WE GET BACK
MOREF1: MOVE A,UFDBLK(D) ;GET FILE NAME
JUMPE A,MOREFL ;JUMP ON NUL FILENAME
MOVEM A,NAME ;FOR OINIT
AND A,MASK ;WILD MASK
CAME A,WILD ;MATCH?
JRST MOREFL ;NO
MOVE A,UFDBLK(D) ;GET NAME BACK
HLLZ B,UFDBLK+1(D) ;GET EXT
MOVE C,MASK+1 ;GET EXT MASK
MOVEM B,EXT ;FOR OINIT
AND B,MASK+1 ;WILD MASK
CAME B,WILD+1 ;MATCH?
JRST MOREFL ;NO
MOVE B,EXT ;GET BACK EXT
CAMN C,[-1,,0] ;ANY WILD CHRS?
JRST NOWILE ;NOT IN EXT
TRNE F,BSW ;ARE WE TRANSFERING BIN EXT WITH WILD?
JRST NOWILE ;YES, DON'T DISCRIMINATE
MOVEI C,BINSIZ ;SIZE OF LIST OF BINARY EXTENSIONS
BINLUP: CAMN B,BINLST(C) ;BIN TYPE EXT?
JRST [PUSHJ P,NAMEOU ;BIN BUT TELL HIM FILENAME ANYWAY
OUTSTR [ASCIZ/ - NOT TRANSFERED, EXTENSION SIGNIFIES BINARY FILE.
/]
JRST MOREFL]
SOJGE C,BINLUP
NOWILE: PUSHJ P,NAMEOU ;PRINT THE FILE NAME
SUBTTL FILE LOOKUP/POINTER SETUP
OINIT: MOVE B,JBFFSV ;RECOVER BUFFER SPACE
MOVEM B,.JBFF##
MOVEI A,1 ;ASCII LINE
TRNE F,WLDFLG ;UFD OPEN?
JRST .+3 ;YES
MOVE B,DEV
CAIA
MOVE B,STRDEV ;NAME OF STUCTURE NOW BEING READ
HRRZI C,IB ;INPUT ONLY
MOVE D,PPNSAV ;DON'T ALLOW FANCY-PATHS
MOVEM D,NAME+3 ; IN LOOKUP
OPEN ICH,A ;OPEN INPUT DEVICE
JRST NODSK
LOOKUP ICH,INFIL ;SET UP FILENAME IF ANY
JRST NOFIND
MOVEI B,OCH ;SET UP B FOR DEVCHR
DEVCHR B, ;DO IT
TLNE B,(1B13) ;IS IT A MAGTAPE FOR OUTPUT
TRZN F,WSW ;YES, DO THEY WANT REWIND(/W) (ONCE ONLY)
SKIPA ;NO, NO, NO
MTREW. OCH, ;YES, YES, YES
MTWAT. OCH, ;MUST WAIT
SETZB RCNT,LNGCNT# ;ZERO REC CNT AND NUM OF OVRSIZ REC
SETZM PHYCNT# ;ZERO NUMBER OF PHYSICAL RECORDS READ
HRLOI B,377777
MOVEM B,NCNT ;MAKE NCNT A HUGE NUMBER
TRNN F,NSW ;IS NSW SET
JRST RDREC2 ;NO
RDREC0: OUTSTR [ASCIZ/
# Records ? /]
PUSHJ P,IN ;GET # OF RECORDS TO PROCESS
JUMPG A,RDREC1 ;MUST BE POSITIVE
OUTSTR BADNEG ;COMPLAIN
JRST RDREC0 ;AND TRY AGAIN
RDREC1: MOVEM A,NCNT ;STASH IN NCNT
RDREC2: PUSHJ P,PNIT ;SETUP POINTERS AND COUNTERS FOR BUFFER
SUBTTL FILE READ AND CONVERT
LOOP: TRNN F,NSW ;IS NSW SET
JRST LOOP1 ;NO
CAMGE RCNT,NCNT ;IS RECORD-COUNT => # REQUESTED
JRST LOOP1 ;NO, KEEP ON TRUCKIN'
OUTSTR [BYTE (7)15,12]
MOVE A,NCNT ;GET THE NUMBER
PUSHJ P,DECPRT ;PRINT IT
OUTSTR [ASCIZ/ records processed.
/]
CAME INCNT,BLKFAC ;EMPTY BUFFER?
PUSHJ P,OUPART ;NO - WRITE PARTIAL BLOCK
CLOSE OCH,0
CLOSE ICH,0
PUSHJ P,TINIT ;INITIALIZE TAPE AGAIN
JRST SRHDIR ;DO IT AGAIN
LOOP1: MOVE CNT,RECSIZ ;SET LINE COUNT
LOOP1A: PUSHJ P,INCHR ;GET CHR
JUMPE MATCH,LOOP1A ;FOR NOW
CAIN MATCH,15 ;CR?
JRST LOOP1A ;YES,IGNORIT
CAIN MATCH,12 ;PREMATURE END OF RECORD?
JRST FILL ;YES
XCT CNVRT ;EXECUTE THE CONVERSION INSTRUCTION
IDPB CHR,FPNT ;STORE CHR IN OUTPUT BUFFER
SOJG CNT,LOOP1A ;JUMP IF RECORD NOT FULL
AOJ RCNT, ;#OF TOTAL RECORDS READ
PUSHJ P,INCHR ;GET RID OF CRLF
CAIN MATCH,15 ;CR?
PUSHJ P,INCHR ;YES, GET RID OF LF
CAIE MATCH,12 ;LF?
JRST RCDERR ;NO, MUST BE TOO LOG RECORD
MOREL: SOJG INCNT,LOOP1 ;JUMP IF BLOCK NOT FULL
PUSHJ P,OUTING
JRST LOOP
FILL: AOJ RCNT, ;#OF TOTAL RECORDS READ
MOVEI MATCH,40 ;FILL CHR IS A BLANK
XCT CNVRT ;TRANSLATE
JRST FILL2
FILL1: IDPB CHR,FPNT ;DEPOSIT FILL CHR
FILL2: SOJGE CNT,FILL1 ;DECR COUNT, JUMP IF MORE FILL CHR NEEDED
JRST MOREL ;NO MORE FILL FOR THIS RECORD
RCDERR: AOS LNGCNT ;COUNT LONG RECORDS
GTNWOK: PUSHJ P,INCHR ;CLEAN OUT REST OF TOO LONG LINE
CAIE MATCH,12 ;LF?
JRST GTNWOK ;NO, GET ANOTHER
MOVE CNT,RECSIZ ;SETUP LINE COUNT
JRST MOREL ;GO BACK
;END OF MAIN READ/CONVERT LOOP
SUBTTL I/O SUBROUTINES
INCHR: SOSGE IB+2
JRST GETBF
ILDB MATCH,IB+1
POPJ P,
GETBF: IN ICH,
JRST INCHR
STATO ICH,20000 ;IS IT EOF
JRST INERR ;NO SOME ERROR
CLOSE ICH,0
CAME INCNT,BLKFAC ;EMPTY BUFFER
PUSHJ P,OUPART ;NO - WRITE PARTIAL BLOCK
CLOSE OCH,0 ;YES, TELL USER AND GET OUT
OUTSTR [BYTE (7)9] ;TAB
MOVE A,RCNT ;GET NUMBER OF RECORDS PROCESSED
PUSHJ P,DECPRT ;PRINT THE NUMBER
OUTSTR RECPRC ;AND ASSOCIATED MESSAGE
SKIPG A,LNGCNT ;ANY OVERSIZE RECORDS?
JRST CHKST2 ;NO
CAME A,PHYCNT ;ONLY PRINT NUMBER IF DIFFERENT
PUSHJ P,DECPRT ;PRINT NUMBER
CAMN A,PHYCNT ;PRINT "ALL" IF SAME
OUTSTR [ASCIZ/All/] ;ALL
OUTSTR OVRSIZ ;AND ASSOCIATED MESSAGE
CHKST2: OUTSTR [BYTE (7)15,12]
POP P,(P) ;RESTORE LIST
PUSHJ P,TINIT
JRST SRHDIR
OUPART: MOVE A,BLKFAC ;GET BLOCKING FACTOR
SUB A,INCNT ;MINUS RECORDS REMAINING
IMUL A,RECSIZ ;NUMBER OF CHARACTERS IN RECORD
ADDI A,3 ;ROUND AND GET WORDS
ASH A,-2
JUMPLE A,CPOPJ ;QUIT IF EMPTY
MOVN A,A ;NEGATE
HRLZ A,A ;BUILD IOWD
HRR A,OUTLST
MOVEM A,PARLST ;STORE IT
SETZM PARLST+1 ;END IT
OUTPUT OCH,PARLST ;PUT IT OUT
JRST OUTIN1 ;CHECK IT
OUTING: OUTPUT OCH,OUTLST ;OUTPUT THE BUFFER
;A.M. 99.30.1-1 RRB 9-OCT-78
OUTIN1: STATZ OCH,742000 ;ERROR
PUSHJ P,DERR ;HANDLE ERROR
PNIT: SETZM BUF1 ;CLEAR OUTPUT BUFFER
MOVE A,BWD ;BUF1,,BUF1+1
BLT A,@HIGHDT ;CLEAR THE BUFFER
MOVE FPNT,NFPNT ;BYTE POINTER FOR BUFFER
MOVE INCNT,BLKFAC ;RECORD COUNT
POPJ P, ;GET BACK
NAMEOU: MOVEI E,6
NAMEO1: LDB C,[POINT 6,A,5]
ADDI C,40 ;MAKE IT ASCII
OUTCHR C ;PRINT IT
LSH A,6 ;PRESENT NEXT CHR
SOJG E,NAMEO1
OUTCHR ["."]
MOVEI E,3
NAMEO2: LDB C,[POINT 6,B,5]
ADDI C,40 ;MAKE IT ASCII
OUTCHR C ;PRINT IT
LSH B,6 ;PRESENT NEXT CHR
SOJG E,NAMEO2
POPJ P,
PDVNAM: MOVEI E,6
PDVNA1: LDB C,[POINT 6,B,5]
CAIN C,0 ;NO IMBEDDED BLANKS OCCUR
POPJ P, ;MUST BE END OF DEV
ADDI C,40 ;MAKE IT ASCII
OUTCHR C ;PRINT IT
LSH B,6 ;PRESENT NEXT CHR
SOJG E,PDVNA1
POPJ P,
DERR: STATZ OCH,1B25 ;PHYSICAL END OF TAPE?
JRST FNDEOT ;YES
TRNE F,IGNORE ;IGNORE ERRORS?
JRST RESETS ;YES
OUTSTR LIT7A ;TELL ABOUT ERROR
GETSTS OCH,A ;GET STATUS
PUSHJ P,OCTPRT ;AND PRINT THAT TOO
OUTSTR LIT7B ;ASK ABOUT SKIPPING BLOCK
PUSHJ P,GETLIN
ILDB A,LINPNT
CAIN A,"X" ;IS IT A X
EXIT ;YES, EXIT
CAIN A,"C" ;IS IT A C
JRST RESETS ;YES
CAIE A,"I" ;IS IT AN I
EXIT ;NO, EXIT
TRO F,IGNORE
RESETS: GETSTS OCH,A ;YES, SET STATUS BACK AND CONTINUE
TRZ A,740000
TRO F,IGNORE ;IF IGNORE ERROR FLAG ON
TRO A,100 ;SET IONRCK
SETSTS OCH,(A)
POPJ P, ;GET BACK
FNDEOT: OUTSTR ATEOT ;SAY AT END OF TAPE
EXIT ;EXIT
INERR: OUTSTR LIT8 ;TELL USER ABOUT ERROR ON INPUT
GETSTS ICH,A ;GET STATUS BITS
PUSHJ P,OCTPRT ;TELL HIM ABOUT THEM
OUTSTR [BYTE (7) ")",15,12]
EXIT
;THIS ROUTINE BUILDS A BASE10 # FROM TTY:
IN: SETZ A,
TRZ NUM!NEGS ;CLEAR FLAGS
PUSHJ P,GETLIN
LOOPA: ILDB B,LINPNT
JUMPE B,ENDNUM
CAIN B,"-"
JRST [TLNN F,PLUS!NUM ;ALREADY GOT SIGN OR PART OF NUMBER?
TLOE F,NEGS ;SET FLAG AND ERROR IF SEEN OTHER SIGN
JRST ERRORB ;GIVE ERROR. BAD ORDER
JRST LOOPA ]
CAIN B,"+" ;PLUS SIGN TYPED?
JRST [TLNE F,NEGS!NUM ;ALREADY GOT SIGN OR PART OF NUMBER?
TLOE F,PLUS ;SAY PLUS SEEN AND ERROR IF TWICE
JRST ERRORB ;ERROR
JRST LOOPA ]
CAIL B,"0"
CAILE B,"9"
JRST ERRORB
TRO F,NUM ;NUMBER SEEN
IMULI A,^D10
ADDI A,-60(B)
JRST LOOPA
ENDNUM: TRNE F,NEGS ;NEGATIVE?
MOVN A,A ;YES. CHANGE SIGN
TRNE F,NUM ;ANY NUMBER TYPED
POPJ P,
ERRORB: OUTSTR [ASCIZ\
?WBCBNT Bad number. Try again!
\]
CLRBFI
JRST IN
;THIS ROUTINE GATHERS A LINE IN FROM TTY:
;SUPPRESSING ALL BLANKS AND FINISHING WITH A NULL
GETLIN: MOVE LINPNT,[POINT 7,LIN]
GETC: INCHWL B
CAIE B," "
CAIN B,15
JRST GETC ;THROW AWAY <CR> AND SPACES
CAIN B,177 ;RUBOUT?
JRST GETC ;IGNORE
CAIL B,140 ;LOWER CASE?
SUBI B,40 ;YES. MAKE IT UPPER
CAIN B,32 ;CONTROL-Z?
EXIT ;YES. JUST EXIT
CAIE B,33 ;ALTMODE?
CAIN B,12 ;OR LINE FEED?
JRST ENDLIN
IDPB B,LINPNT
JRST GETC
ENDLIN: CAMN LINPNT,[POINT 7,LIN] ;BLANK LINE?
EXIT ;YES - EXIT
SETZ B,
IDPB B,LINPNT
MOVE LINPNT,[POINT 7,LIN]
POPJ P,
TINIT: MOVE B,[SIXBIT/WBCD/]
SETZ C,
MOVEI A,17 ;DUMP MODE
SKIPN TAPDEN ;TAPOPS?
TRO A,<.TFD80>B28 ;MAKE IT 800 BPI IN OPEN
OPEN OCH,A ;OPEN TAPE FOR OUTPUT
JRST NTAVL
MTIND. OCH, ;INDUSTRY COMPATIBLE
SKIPG A,TAPDEN ;TAPOPS?
POPJ P, ;NO. DONE
MOVEM A,TAPBLK+2 ;SET UP FOR SET DENSITY
MOVEI A,OCH
MOVEM A,TAPBLK+1
MOVEI A,.TFDEN+1000
MOVEM A,TAPBLK
MOVE A,[XWD 3,TAPBLK]
TAPOP. A, ;SET DENSITY
JRST ERRDEN ;OOPS?
POPJ P,
DECPRT: JUMPGE A,DECPRL ;POSITIVE NUMBER?
OUTCHR ["-"] ;NO. PRINT - SIGN
MOVM A,A
DECPRL: IDIVI A,^D10 ;GET A DIGIT
HRLM B,(P) ;STORE IT
JUMPE A,.+2 ;NUMBER GONE TO ZERO?
PUSHJ P,DECPRL ;NO. GET ANOTHER
HLRZ A,(P) ;GET FIRST DIGIT TO PRINT
ADDI A,"0" ;CONVERT TO ASCII
OUTCHR A ;PRINT IT
POPJ P, ;RETURN
OCTPRT: SETZ B, ;CLEAR WORD TWO
LSHC A,-3 ;GET DIGIT
ROT B,3 ;RIGHT JUSTIFIED
HRLM B,(P) ;STORE IT
JUMPE A,.+2 ;GONE TO ZERO?
PUSHJ P,OCTPRT ;GET NEXT DIGIT
HLRZ A,(P) ;GET DIGIT TO PRINT
ADDI A,"0" ;CONVERT TO ASCII
OUTCHR A ;PRINT IT
POPJ P, ;RETURN
ASKYN: OUTSTR YORN ;INSIST ON PROPER RESPONSE
YESNO: PUSHJ P,GETLIN ;GET A LINE
ILDB B,LINPNT ;GET FIRST CHARACTER
JUMPE B,CPOPJ1 ;CARRIAGE RETURN IS NO
CAIE B,"Y" ;OTHERWISE, MUST BE Y
CAIN B,"N" ;OR N
CAIA ;FINE
JRST ASKYN ;NEITHER
CAIE B,"Y" ;NOW DECIDE WHICH
CPOPJ1: AOS (P) ;NO
CPOPJ: POPJ P, ;YES
SUBTTL ERROR AND OTHER MESSAGES
NOCORE: OUTSTR [ASCIZ/
? WBCICA Insufficient core available. Cannot WRITE tape.
/]
EXIT
BADNAM: CLRBFI
OUTSTR [ASCIZ\
?WBCISI Input specification is illegal! Try again.(/H for help)
\]
SETZ F,
JRST ASKNAM ;TRY IT AGAIN
NOTAPE: OUTSTR [ASCIZ\
?WBCDBM Device BCD must be a magtape!
\]
EXIT
NTAVL: OUTSTR LIT6
EXIT
NODSK: OUTSTR LIT9
EXIT
NOFIND: OUTSTR LIT10
HLLZS F
JRST SRHDIR
CNVERR: OUTSTR [ASCIZ/
?WBCICC Invalid conversion code!
EBCDIC, BCDIC, ASCII, CDCBCD, or GEBCD are valid.
/]
CLRBFI
JRST GETCNV
ILLDEN: OUTSTR [ASCIZ/?WBCIDS Illegal density specified.
/]
JRST GETDEN
BADDEN: OUTSTR [ASCIZ/?WBCDCR Drive cannot write at that density.
/]
JRST GETDEN
ERRDEN: OUTSTR [ASCIZ/?WBCSDF Set density failed.
/]
EXIT
SUBTTL LITERAL STORAGE
LIT0: ASCIZ/
Output code ? /
LIT1: ASCIZ/
Physical blocking factor ? /
LIT2: ASCIZ/
Logical record size ? /
LIT3: ASCIZ/
Rewind tape (Y or N) ? /
LIT4: ASCIZ/
Relative file position ? /
LIT6: ASCIZ/
?WBCDNA Device WBCD is not available or not assigned.
/
LIT7A: ASCIZ/
%WBCODE Output data error (/
LIT7B: ASCIZ/)
Type C to continue, X to exit, I to ignore errors ? /
LIT8: ASCIZ/
?WBCEOI Error on input (/
LIT9: ASCIZ/
?WBCONA Output device is not available or not assigned.
/
LIT10: ASCIZ/
?WBCFNF File not found!
/
RECPRC: ASCIZ/ records. /
BADNEG: ASCIZ/?WBCNMP Number must be positive.
/
ATEOT: ASCIZ/
?WBCEOT End of tape encountered.
/
YORN: ASCIZ/ Please respond Y or N : /
FRTOBG: ASCIZ\
?WBCFRT First physical record too long - blocking factor and/or
logical record size probably wrong
\
TOOBIG: ASCIZ\
?WBCRTL Physical record too long.
\
OVRSIZ: ASCIZ/ Longer than specified. /
HLPMES: ASCIZ\
REPSPONSES TO INPUT? ARE SIMILAR TO THOSE IN SYSTEM PROGRAMS.
FOR EXAMPLE:
DSKB:FILE.EXT/N
F?LE*.??T
MTA1:/W
TAPE:/N/W
/P
ETC.
AVAILABLE SWITCHES:
/B USING WILD EXTENSION
/N TO SPECIFY # OF RECORDS TO TRANSFER(LATER IN DIALOGUE)
/P TO POSITION THE OUTPUT MAGTAPE(INPUT? IS REASKED)
/W REWIND INPUT(IF MTA)
\
SUBTTL EBCDIC CONVERSION TABLE
EBCTAB: EXP 0,1,2,3,67,55,56,57,26,5,45,13,14,15
EXP 16,17,20,21,22,100,74,75,62,46,30,31,77
EXP 47,42,100,65,100,100,132,177,173,133,154,120,175
EXP 115,135,134,116,153,140,113,141,360,361,362,363,364
EXP 365,366,367,370,371,172,136,114,176,156,157,174
EXP 301,302,303,304,305,306,307,310,311
EXP 321,322,323,324,325,326,327,330,331
EXP 342,343,344,345,346,347,350,351
EXP 112,137,340,117,155,100
EXP 301,302,303,304,305,306,307,310,311
EXP 321,322,323,324,325,326,327,330,331
EXP 342,343,344,345,346,347,350,351
EXP 100,100,100,100,100
SUBTTL GEBCD CONVERSION TABLE
GETAB:
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 20,77,76,13,53,74,32,57,35,55,54,60,73,52,33,61 ;32-47
EXP 0,1,2,3,4,5,6,7,10,11,15,56,36,75,16,17 ;48-63
EXP 14,21,22,23,24,25,26,27,30,31,41,42,43,44,45,46 ;64-79
EXP 47,50,51,62,63,64,65,66,67,70,71,100,12,100,100,72 ;80-95
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
SUBTTL BCD CONVERSION TABLE
BCDTAB:EXP 0,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 20,52,17,32,53,77,35,14,34,74,54,60,33,40,73,21 ;32-47
EXP 12,1,2,3,4,5,6,7,10,11,15,56,76,13,16,72 ;48-63
EXP 57,61,62,63,64,65,66,67,70,71,41,42,43,44,45,46 ;64-79
EXP 47,50,51,22,23,24,25,26,27,30,31,75,36,55,100,37 ;80-95
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
SUBTTL CDCBCD CONVERSION TABLE
CDCTAB:EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 20,100,100,100,53,16,100,100,34,74,54,60,33,40,73,21 ;32-47
EXP 12,1,2,3,4,5,6,7,10,11,0,77,72,13,57,100 ;48-63
EXP 100,61,62,63,64,65,66,67,70,71,41,42,43,44,45,46 ;64-79
EXP 47,50,51,22,23,24,25,26,27,30,31,17,14,32,55,100 ;80-95
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP 100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
SUBTTL DATA LOCATIONS
CNVTAB: EXP "E","G","B","A","C"
CNVNUM==.-CNVTAB
CNVLST: MOVE CHR,EBCTAB(MATCH) ;EBCDIC TO ASCII
MOVE CHR,GETAB(MATCH) ;GEBCD TO ASCII
MOVE CHR,BCDTAB(MATCH) ;BCD TO ASCII
MOVE CHR,MATCH ;ASCII TO ASCII
MOVE CHR,CDCTAB(MATCH) ;CDCBCD TO ASCII
NFPNT: POINT 8,BUF1
BWD: XWD BUF1,BUF1+1
BINLST: SIXBIT/ABS AWT BAC BIN BUG CAL CHN CKP /
SIXBIT/CRF DAE DMP DRW EXE HGH LOW MIM /
SIXBIT/MSB OVL OVR PLO QUE QUF REL RIM /
SIXBIT/RMT RTB SAV SFD SHR SVE SYM SYS /
SIXBIT/TMP UFD VMX XOR XPN /
BINSIZ==.-BINLST-1
UFDLST: IOWD 200,UFDBLK
Z
XLIST ;LIT FOLLOWS
LIT
LIST
SUBTTL WRITABLE DATA STORAGE
IFN PURE,<RELOC>
XLIST
VAR
LIST
;VAR XLISTED
LIN: BLOCK 20
PDL: BLOCK 40
INFIL:
NAME: BLOCK 4
EXT=NAME+1
DEV: BLOCK 5
NCNT: BLOCK 1
HIGHDT: BLOCK 1 ;HIGHEST ACTUAL DATA LOCATION
IB: BLOCK 3
BUFSIZ: BLOCK 1
BLKFAC: BLOCK 1
RECSIZ: BLOCK 1
MASK: BLOCK 2
WILD: BLOCK 2
STRDEV: BLOCK 1
STRLOC: BLOCK 3
UFDFIL: BLOCK 6
UFDPPN=UFDFIL+1
SLFPPN=UFDFIL+2
UFDBLK: BLOCK 200
STRBLK: BLOCK 3
STRUFD=STRBLK+1
OUTLST: BLOCK 2
PARLST: BLOCK 2
BUF1: BLOCK 1 ;BUFFER AREA(DYNAMIC)
END START