Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/bcd.mac
There are 2 other files named bcd.mac in the archive. Click here to see a list.
;THIS PROGRAM WAS WRITTEN AT WESTERN MICHIGAN UNIVERSITY
TITLE BCD TAPE CONVERSION PROGRAM
SUBTTL WESTERN MICHIGAN UNIVERSITY COMPUTER CENTER
SEARCH UUOSYM
VBCD==03
VEDIT==24
VMINOR==00
VWHO=4
JOBVER=137
LOC JOBVER
BYTE (3)VWHO(9)VBCD(6)VMINOR(18)VEDIT
RELOC
;ACCUMULATOR DEFINITIONS
F=0 ;FLAGS
A=1
B=2
C=3
D=4
OPNT=6
CNT=7
LINPNT=10
CHR=11
RCNT=14
MATCH=15
P=17
; I/O CHANNELS
ICH==16
OCH==17
SCH==15
DEFINE TEXT (A),<
XLIST
ASCIZ@A@
LIST
>
;LH FLAG BITS
DMPFLG==400000 ;DUMP MODE FLAG - MUST BE SIGN BIT
IGNORE==200000 ;IGNORE ERROR FLAG
ASW==100000 ;LINE BLOCK SWITCH
NSW==40000 ;PROCESS N RECORDS ONLY
WSW==20000 ;REWIND TAPE
SOMESW==10000 ;SOME VALID SWITCH TYPED AFTER /
NUM==4000 ;NUMBER SEEN IN INPUT ROUTINE
NEGS==2000 ;NEGATIVE SIGN SEEN
PLUS==1000 ;PLUS SIGN SEEN
DSW==200 ;TAPE DUMP
OSW==100 ;OCTAL TAPE DUMP ALSO
SSW==40 ;USE ASCII SPACE(40 OCTAL) WHEN TRANSLATING EBCDIC(0)
PSW==20 ;POSITION INPUT TAPE
BSW==10 ;CHANGE INPUT BLOCKING
EOFSEN==1 ;EOF SEEN ON SPECIAL CHR SET OPTION
;RH FLAG BITS
NOSWTH==400000 ;1 IF SWITCHES NOT ALLOWED IN GTSPEC
UNBLKD==200000 ;1 IF TAPE IS NOT BLOCKED
SNGBUF==100000 ;1 IF SINGLE TAPE BUFFER
DINFLG==40000 ;1 IF MUST DO DUMP INPUT BECAUSE OF RECORD SIZE
;MISC. MEMORY LOCS.
LINCNT: 0
PAGCNT: 0
CNTFLG: 0
RECS: 0
TAPLEG: BLOCK 1
TAPDEN: BLOCK 1
TAPBLK: BLOCK 4
SUBTTL STARTUP AND DIALOGUE
START: JFCL ;BEWARE CCL START
RESET
OUTSTR [ASCIZ/
WMU - TAPE CONVERSION PROGRAM
/]
MOVE P,[IOWD 40,PDL]
SETZ F, ;CLEAR ALL FLAGS
MOVSI A,'BCD'
DEVCHR A,
JUMPE A,NTAVL ;BCD DOESN'T EXIST
TLNN A,(1B13) ;IS BCD A MAGTAPE
JRST NOTAPE ;NO
; MOVSI A,'BCD' ;CALL USAGE
; CALLI A,-2 ;DO IT
JFCL ;IGNORE IT
SETZM TAPDEN ;ASSUME 800 BPI/NO TAPOPS.
MOVEI A,.TFPDN ;FIND LEGAL DENSITIES
MOVEM A,TAPBLK
MOVSI A,'BCD' ;FOR DEVICE BCD
MOVEM A,TAPBLK+1
MOVEI A,.TFD80
MOVEM A,TAPDEN
MOVE A,[XWD 3,TAPBLK]
TAPOP. A,
JRST GETCNV ;WON'T TELL. MUST BE 800
MOVEM A,TAPLEG ;SAVE LEGAL DENSITIES
TRNN A,TF.DN4!TF.DN5 ;1600 OR 6250 POSSIBLE?
JRST GETCNV ;NO. FORCE 800
GETDEN: OUTSTR [ASCIZ/Tape density: /]
PUSHJ P,IN ;GET DENSITY
CAIGE A,^D800 ;800 OR MORE?
JRST ILLDEN ;NO. ILLEGAL
SETZ B, ;ASSUME NOT LEGAL
CAIN A,^D800
MOVEI B,.TFD80
CAIN A,^D1600
MOVEI B,.TFD16
CAIN A,^D6250
MOVEI B,.TFD62
JUMPE B,ILLDEN ;ILLEGAL IF NONE OF ABOVE
MOVEM B,TAPDEN ;STORE DESIRED DENSITY
MOVEI A,1
LSH A,-1(B) ;POSITION BIT
TDNN A,TAPLEG ;IS IT LEGAL ON THIS DRIVE?
JRST BADDEN ;NO. SAY SO
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
MOVE C,CNVLIM(B) ;GET LIMIT FOR CONVERSION TYPE
JUMPE C,SPCSET ;JUMP IF USER DIALOGUE REQUIRED
GOTCNV: MOVEM C,CNVMAX# ;STORE IT
CAIE A,"D"
JRST ASKBLK
TRZ F,SNGBUF!UNBLKD!DINFLG ;NOT SINGLE BUFFER OR UNBLOCKED NOW
TLO F,DMPFLG ;SET DUMP FLAG
OUTSTR DMPWRN
MOVEI A,1
JRST ASKBK1 ;GO STORE BLOCKING FACTOR
SPCSET: OUTSTR [ASCIZ/
NAME OF CONVERSION TABLE FILE? /]
TRO F,NOSWTH ;NO SWITCHES ALLOWED
SETZM DEV
SETZM NAME
SETZM EXT
SETZM EXT+1
SETZM EXT+2
PUSHJ P,GTSPEC ;GET THE FILE NAME
OUTSTR LIT11 ;NUMBER OF CHRS IN SET
PUSHJ P,IN
SUBI A,1 ;HIGHEST LEGAL VALUE
CAILE A,^D255 ;> MAX LIMIT?
JRST [OUTSTR [ASCIZ/
?BCDMSX - Max size of character set exceeded/]
EXIT]
CAIG A,0 ;POSITIVE?
MOVEI A,^D255 ;NO - ASSUME MAX
MOVEM A,CNVMAX ;STORE IT
PUSHJ P,SPCINS ;GET NEW CHR SET(NO RETRN IF ERROR
ASKBLK: TRZ F,SNGBUF!UNBLKD!DINFLG ;NOT SINGLE BUFFER OR UNBLOCKED NOW
JUMPL F,ASKREC ;NOT BLOCKING IF DUMPING
OUTSTR LIT1 ;ASK ABOUT BLOCKING FACTOR
PUSHJ P,IN
JUMPG A,ASKBK1 ;MUST BE POSITIVE
JUMPE A,WHTSIZ ;USER WANTS SIZE SNOOPED OUT
OUTSTR BADNEG ;COMPLAIN
JRST ASKBLK ;AND TRY AGAIN
ASKBK1: MOVEM A,BLKFAC
JUMPL F,ASKREC ;DUMP TAPES ARE BLOCKED
CAIN A,1 ;UNBLOCKED?
TRO F,UNBLKD ;YES.
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
MOVEM A,BUFN ;# OF CHARS IN 1 BUFFER = RECSIZ*BLKFAC
MOVEM A,BUFSIZ
JUMPL F,GETBUF ;DUMP MODE?
ADDI A,3
IDIVI A,4
MOVEM A,BUFSIZ ;# OF WORDS IN BUFFER IS AN EVEN MULTIPLE OF 4
GETBUF: ADDI A,3+^D10 ;ACTUAL SIZE OF BUFFER REQUIRED
MOVEM A,BUFWDS# ;STORE IT
CAILE A,^D4096 ;MORE THAN FOUR K?
TRO F,DINFLG ;YES. CAN NOT DO BUFFERED IO
MOVEI B,^D3000 ;USE ABOUT THREE K BUFFERS
EXCH A,B
IDIV A,B
SKIPE B
ADDI A,1 ;OR ONE IF THATS BIGGER
MOVEM A,MBUFN# ;STORE NUMBER
TRNN F,DINFLG ;DUMP INPUT?
JRST SETBUF ;NO
MOVE A,BUFSIZ ;GET BUFFER SIZE AGAIN
ADDI A,^D10 ;TOTAL WORDS REQUIRED TO INPUT
MOVN A,A ;NEGATE
HRLM A,DIOWD ;BUILD IOWD
TRNE F,UNBLKD ;UNBLOCKED TAPE?
JRST SETBUF ;YES. ANY LINE BLOCKING WILL BE DIFFERENT WAY
;THIS IS FOR COMPUTATION OF NULL FILL FOR END OF WORD IF LINE-BLOCKED
MOVE A,RECSIZ
ADDI A,2
IDIVI A,5
SUBI B,5
ADDI A,1 ;GET NUMBER OF WORDS FOR RECORD
IMULI A,5 ;NOW NUMBER OF CHARACTERS INCLUDING FILL
MOVEM A,ARECSZ# ;ACTUAL RECSIZ = RECSIZ+<CRLF>+NULLFILL
CAIG A,^D640 ;NUMBER OF CHARACTER PER DISK BLOCK
JRST SETBUF ;OK IF RECORD .LE.
TLZ F,ASW ;BAD. CAN'T LINE BLOCK
OUTSTR [ASCIZ/%BCDCLB Cannot line block output. record too long.
/]
; END OF LINE-BLOCK STUFF
SETBUF: MOVE A,BUFWDS ;GET SIZE OF A BUFFER
IMUL A,MBUFN ;TIMES NUMBER
ADDI A,BUF1 ;PLUS BASE ADDRESS
MOVE B,A
CAMGE A,.JBREL## ;DO WE NEED MORE CORE
JRST OK ;NO
CORE A, ;YES GET IT
JRST .+2 ;TRY LESS BUFFERS
JRST OK ;ALL OK
SOSG MBUFN ;IS LESS BUFFERS LEGAL?
JRST NOCORE ;NO. NOT ENOUGH FOR EVEN ONE
JRST SETBUF ;YES. TRY ONE LESS
OK: HRRM B,.JBFF## ;SAVE NEW TOP TWICE
MOVE A,MBUFN ;ACTUAL NUMBER OF BUFFERS
CAIG A,1 ; GREATER THAN ONE?
TRO F,SNGBUF ;NO. SINGLE BUFFERED
PUSHJ P,TINIT ;INITIALIZE TAPE
POSIT: OUTSTR LIT3 ;ASK ABOUT REWIND
PUSHJ P,YESNO ;SKIP UNLESS 'Y'
PUSHJ P,REWIND
OUTSTR LIT4 ;ASK ABOUT FILE POSITION
PUSHJ P,IN
JUMPGE A,SKF
PUSHJ P,BACKSP
AOJLE A,.-1 ;MUST DO N+1 BACKSPACE COMMANDS
STATO ICH,1B24 ;AT LOAD POINT?
;IF NOT, MUST DO ONE SKIP FILE
PUSHJ P,SKIPFL
SKF: SOJG A,.-1
ASKNAM: OUTSTR [ASCIZ\
Output ? \]
TLZ F,IGNORE!ASW!NSW!WSW!DSW!OSW!SSW!PSW!BSW ;TURN OFF IGNORE, SWITCHES
TRZ F,NOSWTH ;SWITCHES ALLOWED
SETZM EBCTAB ;PRESET NULL AT EBCTAB+0
PUSHJ P,GTSPEC ;GET FILE SPECS
MOVE B,NAME
CAMN B,[SIXBIT/FINISH/]
EXIT
TLZE F,BSW ;/B/P IS /B SINCE FALLS TO /P
JRST ASKBLK ;GO REDO BLOCKING
TLZE F,PSW ;REWIND TAPE(/P)
JRST POSIT ;YES. DO IT
OINIT: TLNE F,DMPFLG ;DUMPING?
TLZ F,DSW!OSW!SSW!ASW ;YES. CLEAR INCOMPATIBLE SWITCHES
MOVEI A," " ;ASCII SPACE
TLZE F,SSW ;SPACE TO REPLACE NULL IN EBCDIC(0)?
MOVEM A,EBCTAB ;YES
MOVEI A,1 ;ASCII LINE
TLNE F,DMPFLG
MOVEI A,10 ;IMAGE MODE
MOVE B,DEV
MOVSI C,OB ;OUTPUT ONLY
OPEN OCH,A ;OPEN OUTPUT DEVICE
JRST NODSK
ENTER OCH,OUTFIL ;SET UP FILENAME IF ANY
JRST NOROOM
MOVEI B,OCH ;SET UP B FOR DEVCHR
DEVCHR B, ;DO IT
TLNE B,(1B13) ;IS IT A MAGTAPE FOR OUTPUT
TLNN F,WSW ;YES, DO THEY WANT REWIND(/W)
SKIPA ;NO, NO, NO
MTREW. OCH, ;YES, YES, YES
MTWAT. OCH, ;MUST WAIT
SETZM LNGCNT# ;CLEAR NUMBER OF OVERSIZE RECORDS
SETZM SMLCNT# ;CLEAR NUMBER OF SHORT RECORDS
SETZB RCNT,ILLCNT# ;ZERO RECORD COUNT AND ILLEGAL CHAR COUNT
SETZM PHYCNT# ;ZERO NUMBER OF PHYSICAL RECORDS READ
HRLOI B,377777
MOVEM B,NCNT ;MAKE NCNT A HUGE NUMBER
TLNN F,DSW ;TAPE DUMP?
JRST RNREC ;NO
OUTSTR [ASCIZ/
OCTAL DUMP ALSO? /]
PUSHJ P,YESNO ;SKIP UNLESS 'Y'
TLO F,OSW ;SET OCTAL DUMP SWTCH
RNREC: TLNN F,NSW ;IS NSW SET(/D DOES IMPLICIT /N)
JRST RDREC2 ;NO
RDREC0: OUTSTR [ASCIZ/
# Records ? /]
PUSHJ P,IN ;GET # OF RECORDS TO PROCESS
TLNE F,DSW ;TAPE DUMP?
JUMPLE A,RDREC2 ;YES , 0<= MEANS ALL OF TAPE
JUMPG A,RDREC1 ;MUST BE POSITIVE
OUTSTR BADNEG ;COMPLAIN
JRST RDREC0 ;AND TRY AGAIN
RDREC1: MOVEM A,NCNT ;STASH IN NCNT
RDREC2: TLNN F,DSW ;TAPE DUMP?
JRST LOOP ;NO
MOVEI A,PHD1 ;PRINT 1ST HEADER
PUSHJ P,PSTRIN
MOVE A,BLKFAC ;PRINT BLOCKING FACTOR
PUSHJ P,PDEC
MOVEI A,PHD2
PUSHJ P,PSTRIN
MOVE A,RECSIZ ;PRINT RECORD SIZE
PUSHJ P,PDEC
PUSHJ P,PCRLFX
MOVEI A,PHD3 ;RECORD HEADER
PUSHJ P,PSTRIN
PUSHJ P,PCRLFX
MOVEI A,^D45 ;# OF LINES PER PAGE
MOVEM A,PAGCNT ;INIT COUNTER
MOVEI A,^D100 ;# OF CHARACTERS PER LINE
MOVEM A,LINCNT ;INIT COUNTER
SETZM RECS ;SET RECORD COUNTER
SETOM CNTFLG ;FORCE FIRST LABEL
TLNN F,OSW ;OCTAL DUMP?
JRST LOOP ;NO
MOVE OPNT,NOPNT ;POINTER TO OCBUF
SUBTTL FILE READ AND CONVERT
LOOP: TLNN 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.
/]
TLNN F,DSW ;TAPE DUMP?
JRST CLOSIT ;NO
SOSL PAGCNT ;YES, DECRIMENT COUNTER, PAGE FULL?
PUSHJ P,PTAIL1 ;YES, LAST PAGE
CLOSIT: CLOSE OCH,0
GETSTS ICH,A ;GET TAPE STATUS,MODE,ETC.
ANDI A,617 ;RETAIN DENSITY,MODE
SETSTS ICH,(A) ;CLEAR OTHER BITS
JRST ASKNAM ;DO IT AGAIN
LOOP1: MOVE CNT,RECSIZ ;SET UP CHAR COUNT
LOOP1A: PUSHJ P,GETCHR ;GET A CHAR
JUMPL F,CNVRT ;JUST MOVE WORD IF DUMPING
TLNE F,OSW ;OCTAL DUMP?
IDPB MATCH,OPNT ;YES, STORE A BYTE
CAMG MATCH,CNVMAX ;MAKE SURE VALID CHARACTER
JUMPGE MATCH,CNVRT ;IT IS LEGAL IF POSITIVE. GO AHEAD
SKIPG ILLCNT ;FIRST ILLEGAL CHARACTER?
OUTSTR ILLCHR ;YES. SAY SO
MOVEI CHR,"\" ;CHARACTER FOR ILLEGALS
AOSA ILLCNT ;COUNT ILLEGAL CHARACTERS
CNVRT: 0 ;TO BE FILLED BY PROPER TRANSLATER INSTRUCTION
TLNN F,DSW ;TAPE DUMP?
JRST OUTPIT ;NO
MOVE A,LINCNT ;GET LINE SIZE
CAIN A,^D100 ;BEGINING OF LINE?
PUSHJ P,RECNUM ;YES, GET PROPER MARGIN SPACING
CAIGE CHR,40 ;PRINTABLE CHARACTER?
MOVEI CHR,"\" ;NO, SUBSTITUTE BACKSLASH
OUTPIT: PUSHJ P,PUTCHR ;PUT A CHAR
TLNN F,DSW ;TAPE DUMP?
JRST RWLUP ;NO
SOSG LINCNT ;DECRIMENT CHARACTER COUNTER, LINE FULL?
PUSHJ P,LINBRK ;YES
RWLUP: SOJG CNT,LOOP1A ;IF NOT DONE WITH RECORD JUMP BACK
CRLF: AOJ RCNT, ;ADD 1 TO RECORD COUNT
JUMPL F,LOOP ;DONT IF DUMP MODE
PUSHJ P,PCRLFX ;PUT OUT CRLF
TLNE F,OSW ;OCTAL DUMP?
PUSHJ P,OCDUMP ;YES
TLNN F,DSW ;DUMP TAPE?
JRST LBFILL ;NO
SETOM CNTFLG ;START NEXT LINE WITH "RECORD #"
MOVEI A,^D100 ;START COUNTING NEW LINE
MOVEM A,LINCNT
SOSG PAGCNT ;INRC. COUNTER, PAGE FULL?
PUSHJ P,PTAIL ;YES
LBFILL: TLNN F,ASW ;IS IT LINE-BLOCKED (/A)
JRST LOOP ;NO, DO ANOTHER RECORD
SETZ CHR, ;YES, DO FILLERS
MOVSI A,760000 ;MASK TO TEST POINTER
LBFIL1: TDNN A,OB+1 ;ALREADY EXACT WORD?
JRST LBFIL2 ;YES.
PUSHJ P,PUTCHR ;NO. NULL FILL
JRST LBFIL1 ;UNTIL WORD FULL
LBFIL2: TRNN F,UNBLKD ;UNBLOCKED TAPE?
JRST LOOP ;YES. GETNEW WILL CHECK FOR FIT
MOVE A,OB+2 ;NO. WILL ANOTHER RECORD FIT?
CAMGE A,ARECSZ ;...?
CRLFX: SETZM OB+2 ;NO. MAKE PUTCHR USE NEXT BUFFER
JRST LOOP
SUBTTL I/O SUBROUTINES
GETSML: MOVE CNT,IBUF+2 ;HERE IF SINGLE BLOCKED SHORT RECORDS
JUMPL F,GETCHR ;NOT LINE BLOCKED IF DUMP
TLNN F,ASW ;LINE BLOCKING?
JRST GETCHR ;NO. GO AHEAD
MOVEI A,2(CNT) ;GET LINE SIZE
CAMLE A,OB+2 ;WILL IT FIT?
SETZM OB+2 ;NO. DO BEST CAN
GETCHR: SOSGE IBUF+2 ;ANY MORE CHARACTERS?
JRST GETNEW ;NO. GET A BUFFER
ILDB MATCH,IBUF+1 ;YES GET IT AND GET BACK
POPJ P,0
GETNEW: TRNE F,DINFLG ;DOING DUMP MODE INPUT?
JRST GETNWD ;YES. DIFFERENT
IN ICH, ;NOW INPUT
JRST GETNWA ;OK
JRST CHKSTA ;ERROR?, FIND OUT WHY
GETNWD: IN ICH,DIOWD ;DO THE DUMP MODE INPUT
JRST .+2 ;OK. CALC BUFFER SIZE
JRST CHKSTA ;ERROR?, FIND OUT WHY
GTNWD0: MOVEI A,ICH ;FIND RECORD SIZE IN MONITOR
MTCHR. A, ;...
HRLZ A,BUFSIZ ;WON'T TELL. ASSUME OK
HLRZ CHR,A ;GET WORD COUNT
JUMPL F,GTNWD2 ;DUMP OUTPUT?
IMULI CHR,4 ;NO. CHARACTERS
LDB A,[POINT 3,A,29];GET CHARACTERS IN LAST WORD
CAIGE A,4 ;BEWARE PRE-603 BUG
JRST GTNWD1 ;OK
TRCE A,5 ;FIX UP BUG
TRCE A,5
TRC A,5
GTNWD1: ADD A,CHR ;GET TOTAL CHARACTERS
MOVEM A,IBUF+2 ;STORE
MOVE A,[POINT 8,BUF1+1,35]
MOVEM A,IBUF+1 ;SIMULATE BUFFERED MODE
JRST GETNWA ;CONTINUE
GTNWD2: TRNE A,7B29 ;ANY CHARS IN LAST WORD?
ADDI CHR,1 ;YES. ADD ONE TO WORDS
MOVEM CHR,IBUF+2 ;STORE WORDS
MOVE A,[POINT 36,BUF1+1,35]
MOVEM A,IBUF+1 ;SIMULATE BUFFERED MODE
GETNWA: AOS PHYCNT ;ONE MORE PHYSICAL RECORD
SKIPE SHORT# ;WAS LAST RECORD SHORT?
JRST SHORTR ;YES. SHOULD HAVE GOTTEN EOF
GETNW1: JUMPL F,GTNW1B ;SKIP SOME IF DUMP
TRNN F,SNGBUF ;SINGLE BUFFERED?
JRST GTNW1B ;NO. MTCHR. WOULD TELL ABOUT WRONG BUFFER
MOVEI A,ICH ;GET ACTUAL CHARACTER COUNT FROM TAPSER
MTCHR. A, ;IF POSSIBLE
JRST GTNW1B ;OH WELL
HLRZ CHR,A ;GET WORD COUNT
IMULI CHR,4 ;MAKE CHARACTERS
LDB A,[POINT 3,A,29];CHARACTERS IN FINAL WORD
CAIGE A,4 ;BEWARE PRE 603 MONITOR BUG
JRST GTNW1A ;OK. GO AHEAD
TRCE A,5 ;FIX MONITR BUG
TRCE A,5
TRC A,5
GTNW1A: ADD A,CHR ;TOTAL CHARACTERS
MOVEM A,IBUF+2 ;STORE AS BUFFER COUNT
GTNW1B: MOVE A,IBUF+2 ;GET NUMBER OF CHARACTERS
CAMN A,BUFN ;CORRECT NUMBER OF CHARACTERS?
JRST GETCHR ;YES. OK
JUMPL F,GETNW0 ;SKIP SOME IF DUMP
ADDI A,3 ;ROUND
ASH A,-2 ;NUMBER OF WORDS
GETNW0: CAMN A,BUFSIZ ;PROPER NUMBER?
JRST GETNW2 ;YES. SET NUMBER OF CHARACTERS
CAML A,BUFSIZ ;SHORT RECORD?
JRST LNGERR ;NO. MODERATELY LONG
TRNE F,UNBLKD ;UNBLOCKED TAPE?
JRST GETSML ;YES. SUPPORT VARIABLE LENGTH RECORDS,
;AND RECORD .LT. SPECIFIED WITHOUT COMPLAINT
MOVE A,IBUF+2 ;CALCULATE NUMBER OF CHARACTERS CAN PROCESS
MOVEM A,LASBLK# ;REMEMBER SIZE OF LAST BUFFER
JUMPL F,[ ;USE WHAT IS THERE IF DUMPING
SETOM SHORT ;SET SHORT FLAG
JRST GETSML ;AND USE ACTUAL RECORD SIZE
]
IDIV A,RECSIZ
CAIG A,0 ;ANY RECORDS AT ALL?
MOVEI A,1 ;STRANGE. MUST BE ONE.
IMUL A,RECSIZ
SETOM SHORT# ;SET SHORT RECORD FLAG
JRST GETNW3
GETNW2: MOVE A,BUFN ;SET BUFFER COUNT TO RECORD LENGTH
GETNW3: MOVEM A,IBUF+2
JRST GETCHR ;AND GO RETURN A CHARACTER
OCDUMP: MOVE A,PAGCNT
CAIGE A,5 ;ROOM FOR 3 LINES OF OCTAL?
PUSHJ P,PTAIL ;NO
MOVEI 5,3 ;3 ROWS OF OCTAL DIGITS
MOVE D,[POINT 3,A,26] ;FOR SPLITTING 3 DIGIT #S
OC1: MOVEI A,PHD4 ;MARGIN SPACING
PUSHJ P,PSTRIN
MOVEI C,^D100 ;MAX LINE LENGTH
SUB C,LINCNT ;C IS # OF A IN LINE
MOVE OPNT,NOPNT ;POINTER TO LINE
IBP D ;SET FOR DESIRED A
OC2: SOJL C,OC3
ILDB A,OPNT ;GET #(3DIGITS)
LDB CHR,D ;GET DESIRED SINGLE DIGIT
ADDI CHR,"0" ;MAKE IT ASCII
PUSHJ P,PUTCHR ;OUTPUT IT
JRST OC2
OC3: PUSHJ P,PCRLFX ;PUT OUT CRLF
SOS PAGCNT
SOJG 5,OC1 ;DIGITS PER LINE
PUSHJ P,PCRLFX ;PUT OUT CRLF
SOS PAGCNT
PUSHJ P,PCRLFX ;PUT OUT CRLF
SOSG PAGCNT
PUSHJ P,PTAIL
MOVE OPNT,NOPNT ;RESET BYTE POINTER
POPJ P,
CHKSTA: STATO ICH,20000 ;IS IT EOF
JRST DERR ;NO SOME ERROR
SKIPE SMLCNT ;ANY SHORT RECORDS?
SKIPN SHORT ;YES. IS THIS ONE?
JRST .+2 ;NO. OK
AOS SMLCNT ;YES. COUNT THIS ONE
SETZM SHORT
TLNN F,DSW ;DUMP TAPE?
JRST CLOSIU ;NO
SOSL PAGCNT ;YES,INCR. PAGCNT, PAGE FULL?
PUSHJ P,PTAIL1 ;YES, LAST PAGE
CLOSIU: CLOSE ICH,0
CLOSE OCH,0 ;YES, TELL USER AND GET OUT
OUTSTR LIT5
JUMPG RCNT,CHKST1 ;WERE ANY RECORDS PROCESSED
OUTSTR NORECS ;NO TELL USER
JRST CHKST3 ;AND GO TO NEXT FILE
CHKST1: OUTSTR [BYTE (7)15,12] ;START NEW LINE
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
MOVE A,LNGCNT
CAMN A,PHYCNT ;PRINT "ALL" IF SAME
OUTSTR [ASCIZ/All/] ;ALL
OUTSTR OVRSIZ ;AND ASSOCIATED MESSAGE
CHKST2: SKIPG A,SMLCNT ;GET COUNT OF SHORT RECORDS
JRST CHKST3 ;NONE
CAME A,PHYCNT ;ONLY PRINT NUMBER IF DIFFERENT
PUSHJ P,DECPRT ;PRINT THE COUNT
MOVE A,SMLCNT
CAMN A,PHYCNT ;PRINT "ALL" IF SAME
OUTSTR [ASCIZ/All/]
OUTSTR SMLSIZ ;AND ASSOCIATED MESSAGE
CHKST3: SKIPG A,ILLCNT ;GET COUNT OF ILLEGAL CHARACTERS
JRST CHKST4 ;NONE
PUSHJ P,DECPRT ;PRINT THE COUNT
OUTSTR TOTILL ;AND ASSOCIATED MESSAGE
CHKST4: POP P,(P) ;RESTORE LIST
PUSHJ P,TINIT
JRST ASKNAM
LNGERR: SKIPE LNGCNT ;FIRST LONG RECORD?
JRST LNGER3 ;NO
JUMPG RCNT,LNGER1 ;YES. FIRST RECORD?
OUTSTR FRTOBG ;YES. TELL ABOUT ERROR
JRST LNGER2 ;GO AHEAD
LNGER1: OUTSTR TOOBIG ;TELL ABOUT BIG RECORD
LNGER2: OUTSTR CHGBLK ;WANT TO CHANGE BLOCKING?
PUSHJ P,YESNO ;???
JRST ASKBLK ;YES. DO IT
LNGER3: AOS LNGCNT ;COUNT LONG RECORDS
STATO ICH,40000 ;BLOCK TOO LARGE ERROR?
JRST LNGER4 ;NO. MINOR OVERFLOW
GETSTS ICH,A ;CLEAR BLOCK TOO LARGE
TRZ A,40000 ;...
TRO A,100 ;SKIP ERROR RETRY
SETSTS ICH,(A) ;SET STATUS BACK
LNGER4: JRST GETNW2 ;GO AHEAD (SET NUMBER OF CHARACTERS)
SHORTR: SETZM SHORT ;FORGET THAT PREVIOUS RECORD WAS SHORT
SKIPE SMLCNT# ;FIRST SHORT RECORD?
JRST SHORT3 ;NO
CAML RCNT,BLKFAC ;ON FIRST RECORD?
JRST SHORT1 ;NO.
OUTSTR FRTOSM ;YES. TELL ABOUT ERROR
JRST SHORT2 ;GO AHEAD
SHORT1: OUTSTR TOOSML ;TELL ABOUT SMALL RECORD
SHORT2: OUTSTR ACTBLK ;ACTUAL BLOCK SIZE IS
MOVE A,LASBLK ;N CHARACTERS
PUSHJ P,DECPRT
MOVEI A,CHARS ;CHARACTERS
JUMPGE F,.+2 ;DUMPING?
MOVEI A,WORDS ;YES. WORDS
OUTSTR (A)
OUTSTR CHGBLK ;WANT TO CHANGE BLOCKING?
PUSHJ P,YESNO ;???
JRST ASKBLK ;YES. DO IT
SHORT3: AOS SMLCNT ;COUNT SHORT RECORDS
JRST GETNW1 ;GO ON WITH RECORD
DERR: STATZ ICH,1B25 ;PHYSICAL END OF TAPE?
JRST FNDEOT ;YES
STATZ ICH,700000 ;ANY REAL ERRORS?
JRST DERR1 ;YES. DON'T TREAT AS LONG RECORD
STATZ ICH,40000 ;BLOCK TOO LARGE?
JRST LNGERR ;YES
DERR1: TLNE F,IGNORE ;IGNORE ERRORS?
JRST RESETS ;YES
OUTSTR LIT7A ;TELL ABOUT ERROR
GETSTS ICH,A ;GET STATUS
PUSHJ P,OCTPRT ;AND PRINT THAT TOO
OUTSTR LIT7B ;ASK ABOUT SKIPPING BLOCK
PUSHJ P,GETLIN
ILDB A,LINPNT
CAIN A,"C" ;IS IT A C
JRST RESETS ;YES
CAIE A,"I" ;IS IT AN I
EXIT ;NO, EXIT
TLO F,IGNORE
RESETS: GETSTS ICH,A ;YES, SET STATUS BACK AND CONTINUE
TRZ A,700000
TLNE F,IGNORE ;IF IGNORE ERROR FLAG ON
TRO A,100 ;SET IONRCK
SETSTS ICH,(A)
STATZ ICH,40000 ;ALSO BLOCK TO LARGE?
JRST LNGERR ;YES. GIVE THAT ERROR TOO
TRNE F,DINFLG ;DUMP INPUT ?
JRST GTNWD0 ;YES
JRST GETNWA ;NO
FNDEOT: OUTSTR ATEOT ;SAY AT END OF TAPE
EXIT ;EXIT
PUTCHR: SOSG OB+2 ;STANDARD DEC OUTPUT PROCEDURE
JRST PUTBUF
PUTNXT: IDPB CHR,OB+1
POPJ P,0
PUTBUF: OUT OCH,0
JRST PUTNXT
OUTSTR LIT8 ;TELL USER ABOUT ERROR ON OUTPUT
GETSTS OCH,A ;GET THE STATUS BITS
PUSHJ P,OCTPRT ;TELL HIM ABOUT THEM
OUTSTR [BYTE (7) ")",15,12]
EXIT
PSTRIN: MOVE B,[POINT 7,(A)] ;POINTER TO SUBJECT STRING
PSTRI1: ILDB CHR,B ;GET CHR
JUMPE CHR,CPOPJ ;NUL?
PUSHJ P,PUTCHR ;NO, PRINT IT
JRST PSTRI1 ;GO FOR ANOTHER
PDEC: IDIVI A,^D10 ;BREAKING DOWN DEC. NUMBER FOR PRINTING
PUSH P,B ;STORE A+1
CAIE A,0 ;MORE?
PUSHJ P,PDEC ;BREAK OFF ANOTHER DIGIT
POP P,CHR ;GET A DIGIT
ADDI CHR,"0" ;ASCII IT
PUSHJ P,PUTCHR ;PUBLISH IT
POPJ P, ;GET ANOTHER OR RETURN
PTAIL: MOVEI A,^D40 ;# OF LINES PER PAGE
MOVEM A,PAGCNT ;SET COUNTER
MOVEI A,PHD3 ;PAGE TRAILER
PUSHJ P,PSTRIN ;PRINT IT
MOVEI CHR,14 ;FORM FEED
PUSHJ P,PUTCHR
PTAIL1: MOVEI A,PHD3 ;PAGE HEADER
PUSHJ P,PSTRIN ;PUBLISH IT
PCRLFX: MOVEI CHR,15 ;CR
PUSHJ P,PUTCHR
MOVEI CHR,12 ;LF
JRST PUTCHR
LINBRK: PUSHJ P,PCRLFX ;PUT OUT CRLF
SOSG PAGCNT ;DECR. PAGE COUNTER, PAGE FULL?
PUSHJ P,PTAIL ;YES
TLNE F,OSW ;OCTAL DUMP?
PUSHJ P,OCDUMP ;YES
MOVEI A,^D100 ;# OF CHR PER LINE
MOVEM A,LINCNT ;SET COUNTER
POPJ P,
RECNUM: PUSH P,CHR
AOSE CNTFLG ;SKIP IF AT RECORD START
JRST RECNU1 ;NOT AT RECORD START
MOVEI A,PHD5 ;RECORD # LABEL
PUSHJ P,PSTRIN
AOS RECS
MOVE A,RECS
PUSHJ P,PDEC ;PUBLISH # OF RECORDS
MOVEI CHR,11 ;TAB
PUSHJ P,PUTCHR
MOVEI CHR,40 ;SPACE
PUSHJ P,PUTCHR
CHPOPJ: POP P,CHR
POPJ P,
RECNU1: MOVEI A,PHD4 ;MARGIN SPACING
PUSHJ P,PSTRIN
JRST CHPOPJ
;THIS ROUTINE BUILDS A DECIMAL # FROM TTY:
IN: SETZ A,
TLZ F,NUM!NEGS ;CLEAR FLAGS
PUSHJ P,GETLIN
LOOPA: ILDB B,LINPNT
JUMPE B,ENDNUM
CAIN B,"-"
JRST [TLNN F,PLUS!NUM ;ALREADY GOT PART OF NUMBER?
TLOE F,NEGS ;SET FLAG AND ERROR IF TWICE
JRST ERRORB ;GIVE ERROR. BAD ORDER
JRST LOOPA ]
CAIN B,"+" ;PLUS SIGN TYPED?
JRST [TLNE F,NEGS!NUM ;ALREADY GOT 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
TLO F,NUM ;NUMBER SEEN
IMULI A,^D10
ADDI A,-60(B)
JRST LOOPA
ENDNUM: TLNE F,NEGS ;NEGATIVE?
MOVN A,A ;YES. CHANGE SIGN
TLNE F,NUM ;ANY NUMBER TYPED
POPJ P,
ERRORB: OUTSTR [ASCIZ\
?BCDBNT 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: SETZ B,
IDPB B,LINPNT
MOVE LINPNT,[POINT 7,LIN]
POPJ P,
REWIND: MTREW. ICH, ;REWIND TAPE
JRST MTWAIT ;WAIT AND INVALIDATE BUFFERS
BACKSP: MTBSF. ICH, ;BACKSPACE TAPE
JRST MTWAIT ;WAIT AND INVALIDATE BUFFERS
SKIPFL: MTSKF. ICH, ;SKIP FILE
MTWAIT: MTWAT. ICH,
PUSH P,A ;SAVE COUNT
PUSHJ P,NEWBUF ;AND INVALIDATE BUFFERS
POP P,A ;RESTORE COUNT
POPJ P, ;RETURN
TINIT: MOVSI B,'BCD' ;OPEN DEVICE BCD
MOVEI C,IBUF ;FOR INPUT
MOVEI A,14 ;IN BINARY MODE
TRNE F,DINFLG ;DUMP FLAG?
MOVEI A,17 ;YES. USE DUMP MODE
SKIPN TAPDEN ;TAPOPS?
TRO A,<.TFD80>B28 ;NO. 800 IN OPEN
OPEN ICH,A ;DO OPEN
JRST NTAVL
MTIND. ICH, ;INDUSTRY COMPATIBLE
SKIPG A,TAPDEN ;TAPOPS?
JRST NEWBUF ;NO. DONE
MOVEM A,TAPBLK+2 ;YES. SET DENSITY
MOVEI A,ICH ;SET UP TAPOP.
MOVEM A,TAPBLK+1
MOVEI A,.TFDEN+1000
MOVEM A,TAPBLK
MOVE A,[XWD 3,TAPBLK]
TAPOP. A,
JRST ERRDEN ;OOPS?
NEWBUF: MOVE A,[XWD 400000,BUF1+1] ;SET UP BUFFER RING
MOVEM A,IBUF
MOVE A,[POINT 8,0,35]
TLNE F,DMPFLG ;DUMP TYPE?
MOVE A,[POINT 36,0,35]
MOVEM A,IBUF+1
MOVE A,MBUFN ;GET NUMBER OF BUFFERS
MOVE B,BUFWDS ;GET WORDS PER BUFFER
SUBI B,2 ;DATA WORDS PLUS ONE
HRLZ B,B ;IN LEFT
HRR B,BUFWDS ;POINT RH AT NEXT
ADDI B,BUF1+1 ;...
MOVEI C,BUF1 ;POINT C AT FIRST BUFFER
NEWBF1: SETZM (C) ;CLEAR FIRST WORD
MOVEM B,1(C) ;SET SECOND WORD
SOJLE A,NEWBF2 ;IF LAST BUFFER, DON'T INCREMENT
ADD B,BUFWDS ;MOVE TO NEXT BUFFER
ADD C,BUFWDS ;...
JRST NEWBF1 ;SET NEXT BUFFER
NEWBF2: MOVEI B,BUF1+1 ;MAKE LAST BUFFER POINT TO FIRST
HRRM B,1(C) ;...
POPJ P,
; SUBROUTINE TO SNOOP OUT SIZE OF BLOCK
WHTSIZ: MOVSI B,'BCD' ;OPEN DEVICE BCD
MOVEI C,IBUF ;FOR INPUT
MOVEI A,117 ;USE DUMP MODE/NO ERROR RETRY
SKIPN TAPDEN ;TAPOPS?
TRO A,<.TFD80>B28 ;NO. 800 IN OPEN
OPEN ICH,A ;DO OPEN
JRST NTAVL
MTIND. ICH, ;INDUSTRY COMPATIBLE
SKIPG A,TAPDEN ;TAPOPS?
JRST WHTSZI ;NO. DONE
MOVEM A,TAPBLK+2 ;YES. SET DENSITY
MOVEI A,ICH ;SET UP TAPOP.
MOVEM A,TAPBLK+1
MOVEI A,.TFDEN+1000
MOVEM A,TAPBLK
MOVE A,[XWD 3,TAPBLK]
TAPOP. A,
JRST ERRDEN ;OOPS?
WHTSZI: MOVEI A,3*^D1024 ;ASSUME UNDER THREE K
WHTSZ0: MOVE B,A
ADDI B,BUF1+3 ;GET ENOUGH CORE
CAMG B,.JBREL##
JRST WHTSZ1 ;GO IT
CORE B,
JRST WHTSZE ;CAN'T. OH WELL
WHTSZ1: MOVN B,A ;SET IOWD
HRLM B,DIOWD
SETOM BUF1+3 ;MAKE BUFFER -1 INCASE NO MTCHR.
MOVE B,[XWD BUF1+3,BUF1+4]
BLT B,BUF1+2(A)
IN ICH,DIOWD ;GET THE BUFFER
JRST WHTSZ2 ;OK
GETSTS ICH,B ;GET ERROR STATUS
MTBSR. ICH, ;BACK UP
MTWAT. ICH, ;WAIT FOR IT
TRNE B,40000 ;BLOCK TOO LARGE?
TRNE B,722000 ;MAYBE. HOW ABOUT EOT, EOF, ERRORS?
JRST WHTSZE ;GIVE ERROR.
JRST WHSZM2 ;JUST BLOCK TOO LARGE. TRY LARGER BUFFER
WHTSZ2: MTBSR. ICH, ;BACK OVER RECORD
MTWAT. ICH, ;WAIT FOR IT
MOVEI B,ICH ;GET CHARACTER COUNT FROM MONITOR
MTCHR. B,
JRST WHTSZM ;DO IT THE HARD WAY
HLRZ C,B
TRNE B,7B29 ;ANY CHARACTERS OVER?
ADDI C,1 ;YES. COUNT
CAMGE C,A ;DID WE HAVE ENOUGH CORE TO READ THAT?
JRST WHTSZ3 ;YES. KNOW SIZE
WHSZM2: ADDI A,^D1024 ;DON'T KNOW FOR SURE YET
JRST WHTSZ0 ;TRY A LARGER BUFFER
WHTSZ3: HLRZ A,B ;NOW CALCULATE REAL CHARACTER COUNT
IMULI A,4 ;NOT WORD COUNT
LDB B,[POINT 3,B,29];EXTRA CHARACTERS
CAIGE B,4 ;BEWARE PRE 603 BUG
JRST WHTSZ4 ;OK
TRCE B,5
TRCE B,5
TRC B,5
WHTSZ4: ADD A,B
WHTSZ5: OUTSTR [ASCIZ/The length of the current record is /]
PUSHJ P,DECPRT ;N
OUTSTR CHARS ;CHARACTERS
WHTSZR: RELEAS ICH,
MOVEI A,BUF1
CORE A, ;SHRINK CORE
JFCL ;DON'T CARE
JRST ASKBLK
WHTSZE: OUTSTR [ASCIZ/?BCDCDS Cannot determine size of current record.
/]
JRST WHTSZR ;RETURN
WHTSZM: MOVNI B,1 ;SEE WHICH WORDS GOT READ
MOVE C,A ;WORDS TO LOOK AT
CAME B,BUF1+2(C) ;MATCH?
JRST WHSZM1 ;NO. FOUND DATA
SOJG C,.-2 ;KEEP LOOKING
SETZ A, ;ZERO LENGTH BUFFER?
JRST WHTSZ5 ;SAY SO
WHSZM1: CAMN A,C ;FILLED WHOLE BLOCK?
JRST WHSZM2 ;YES. TRY A BIGGER ONE
MOVE A,C ;NO. CALCULATE APPROXIMATE CHARACTERS
IMULI A,4
JRST WHTSZ5 ;AND PRINT IT
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
RADPR1: 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,RADPR1 ;GONE TO ZERO?
PUSHJ P,OCTPRT ;GET NEXT DIGIT
JRST RADPR1 ;PRINT THE DIGIT
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
;THIS ROUTINE READS A FILE SPECIFICATION FROM
;THE TELETYPE INCLUDING SWITCHES IF NOSWTH=0
GTSPEC: SETZM NAME
SETZM DEV
SETZB D,EXT
SETZM EXT+1
SETZM EXT+2
PUSHJ P,GETLIN
LOOPB1: MOVEI A,6
MOVE C,[POINT 6,BUF1]
SETZM BUF1
SKIPE DEV ;HAVE WE ALREADY GOT DEVICE
JRST GETNAM ;YES, DONT DO NEXT
ILDB B,LINPNT ;GET FIRST CHARACTER
JUMPN B,GTNAM1 ;CHECK FOR NUL INPUT
EXIT ;YES, EXIT
GETNAM: ILDB B,LINPNT ;GET A CHARACTER
GTNAM1: CAIN B,":" ;IS IT A COLON
JRST GOTDEV ;YES WE GOT A DEVICE
CAIN B,"/" ;IS IT A SLASH
JRST GOTSW ;YES, MUST BE A SWITCH
SKIPE B ;NULL IS EOL CHAR
CAIN B,"." ;STARTING EXT?
JRST GOTFIL ;YES
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
SOJA A,GETNAM
GOTDEV: SKIPE DEV ;DO WE HAVE A DEVICE ALREADY
JRST BADNAM ;YES, KILL
MOVE B,BUF1
JUMPE B,BADNAM ;INSIST ON VALID DEVICE
MOVEM B,DEV ;STASH DEVICE
JRST LOOPB1
GOTSW: TRZE F,NOSWTH ;SWITCHES ALLOWED?
JRST BADSW ;NO
TLZ F,SOMESW ;HAVEN'T SEEN THE SWITCH YET
ILDB B,LINPNT
CAIN B,"W" ;IS IT W
TLO F,WSW!SOMESW ;YES SET WSW
CAIN B,"A" ;IS IT A
TLO F,ASW!SOMESW ;YES SET ASW
CAIN B,"N" ;IS IT N
TLO F,NSW!SOMESW ;YES SET NCNT SWITCH
CAIN B,"P" ;IS IT A P
TLO F,PSW!SOMESW ;SET POSITION TAPE
CAIN B,"B" ;RESET BLOCKING FACTOR?
TLO F,BSW!SOMESW ;YES
CAIN B,"S" ;IS IT S
TLO F,SSW!SOMESW ;SET SSW
CAIN B,"D" ;IS IT A D
TLO F,DSW!NSW!SOMESW ;YES SET DSW AND NSW
TLZN F,SOMESW ;DID HE TYPE A VALID SWITCH?
JRST BADSW ;NO
GOTSWX: ILDB B,LINPNT ;GET NEXT CHARACTER
CAIN B,"/" ;ANOTHER SWITCH?
JRST GOTSW ;YES. THAT'S OK
JUMPN B,BADNAM ;TO ENSURE HE DOESN'T EMBED THE SWITCH
TLNE F,PSW!BSW ;/P AND /B ARE ACTION SWITCHES. NO NAME NEEDED
POPJ P, ;NO JUST RETURN
JRST GTNAM1
BADSW: OUTSTR BADSWM ;BAD SWITCH MESSAGE
OUTCHR B
OUTSTR BDSWM1 ;REST OF BAD SWITCH MESSAGE
JRST GOTSWX ;EXIT SWITCH ROUTINE
GOTFIL: SKIPN B ;I CANT EXPLAIN HOW THIS ROUTINE WORKS
SKIPN NAME ;BUT IT DOES
JRST .+2
JRST ENDNAM
SKIPE NAME
JRST BADNAM
MOVE C,BUF1
MOVEM C,NAME
SETZM BUF1
JUMPE B,ENDNAM
MOVEI A,3
MOVE C,[POINT 6,EXT]
JUMPN D,BADNAM ;SECOND EXT ILLEGAL
SOJA D,GETNAM
ENDNAM: SKIPN B,DEV ;DO WE HAVE A DEVICE
MOVSI B,'DSK' ;NO, DEFAULT TO DSK
MOVEM B,DEV
CAMN B,[SIXBIT/NUL/] ;IS IT NUL: DEVICE?
POPJ P, ;YES, SKIP REST
DEVCHR B,
TLNN B,(1B15) ;DOES IT HAVE A DIRECTORY
POPJ P, ;NO
SKIPN NAME ;YES, DID WE GET ONE
JRST BADNAM ;NO, KILL
POPJ P,
;THIS ROUTINE READS A SPECIAL CHARACTER SET
;WITH SINGLE SPACES,COMMAS OR CRLFS AS SEPARATORS
SPCINS: MOVEI B,1 ;ASCII LINE
MOVE C,DEV ;INPUT DEVICE
MOVEI D,SBF ;INPUT BUFFER
OPEN SCH,B
JRST [OUTSTR [ASCIZ/
?BCDCID - Can't init DSK/]
EXIT]
LOOKUP SCH,NAME
JRST [OUTSTR [ASCIZ/
?BCDXNF - Special character set file not found/]
EXIT]
SETZ D, ;TABLE INDEX
SPCIN0: PUSHJ P,SNUMIN ;GET AN OCTAL NUMBER
CAIL C,0 ;WAS A NUMBER ASSEMBLED?
MOVEM C,SPCTAB(D) ;YES - STORE IT
TLZE F,EOFSEN ;EOF?
POPJ P, ;YES
CAMGE D,A ;DATA SET TOO LARGE?
JUMPL C,SPCIN0 ;DON'T INCR IF NO CHR ASSEMBLED
AOJA D,SPCIN0 ;NO
OUTSTR [ASCIZ/
?BCDMCX - More character codes from file than specified
in dialogue/]
EXIT
SNUMIN: SETO C, ;SET TO ZERO WHEN 1ST DIGIT ENCOUNTERED
SNUMI0: SOSGE SBF+2
JRST SNUMGT
SNUMI1: ILDB B,SBF+1
JUMPE B,SNUMI0 ;NO NULLS
CAIE B," " ;BLANK?
CAIN B,"," ;COMMA?
POPJ P,
CAIN B,15 ;<CR>?
JRST SNUMI0 ;YES
CAIN B,12 ;<LF>
POPJ P, ;YES
CAIL B,"0" ;ILL CHR?
CAILE B,"7" ;ILL CHR?
JRST [OUTSTR LIT12
OUTCHR B
OUTSTR [ASCIZ/)/]
EXIT]
SUBI B,"0" ;NO - MAKE IT OCTAL DIGIT
CAIGE C,0 ;SEEN ANY DIGITS PREVIOUSLY?
SETZ C, ;NO - START NUMBER ASSEMBLY
IMULI C,^D8
ADD C,B ;ASSEMBLE THE NUMBER
JRST SNUMI0
SNUMGT: IN SCH,
JRST SNUMI1
STATZ SCH,740000 ;ERROR OR EOF?
JRST [OUTSTR [ASCIZ/
?BCDEOX - Error on input from conversion table file/]
EXIT]
TLO F,EOFSEN ;EOF
POPJ P,
SUBTTL ERROR AND OTHER MESSAGES
NOCORE: OUTSTR [ASCIZ/
? BCDICA Insufficient core available. Cannot convert tape.
/]
EXIT
BADNAM: CLRBFI
OUTSTR [ASCIZ\
?BCDOSI Output specification is illegal! Try again.
\]
JRST ASKNAM ;TRY IT AGAIN
NOTAPE: OUTSTR [ASCIZ\
?BCDDBM Device BCD must be a magtape!
\]
EXIT
NTAVL: OUTSTR LIT6
EXIT
NODSK: OUTSTR LIT9
EXIT
NOROOM: OUTSTR LIT10
EXIT
CNVERR: OUTSTR LIT13
CLRBFI
JRST GETCNV
DMPWRN: TEXT <
DUMP mode output is in the form of a binary file.
To print the file use the /PRINT:OCTAL switch.
>
LIT0: TEXT <
Input code ? >
LIT1: TEXT <
Physical blocking factor ? >
LIT2: TEXT <
Logical record size ? >
LIT3: TEXT <
Rewind tape (Y or N) ? >
LIT4: TEXT <
Relative file position ? >
LIT5: TEXT <
End of file.
>
NORECS: TEXT <
%BCDNRP No records processed.
>
LIT6: TEXT <
?BCDDNA Device BCD is not available or not assigned.
>
LIT7A: TEXT <
%BCDIDE Input data error (>
LIT7B: TEXT <)
Type C to continue, X to exit, I to ignore errors ? >
LIT8: TEXT <
?BCDEOO Error on output (>
LIT9: TEXT <
?BCDONA Output device is not available or not assigned.
>
LIT10: TEXT <
?BCDNRF No room for file on output device.
>
LIT11: TEXT <
NUMBER OF CHARACTERS IN CHARACTER SET?(DECIMAL) >
LIT12: TEXT <
?BCDICX - Illegal character in conversion table file(>
LIT13: TEXT <
?BCDICC Invalid conversion code! Options are:
EBCDIC, UCLABCD, BCDIC, ASCII, CDCBCD, GEBCD, DUMP, or SPECIAL.
SPECIAL requires file, with each character represented
as an octal number, sepArated by spaces, commas or <CRLF>.
>
RECPRC: TEXT < records were processed.
>
ILLCHR: TEXT <
% BCDICE Illegal characters encountered. Being replaced by \
>
TOTILL: TEXT < illegal characters were encountered.
>
BADNEG: TEXT <?BCDNMP - Number must be positive.
>
ATEOT: TEXT <
?BCDEOT End of tape encountered.
>
YORN: TEXT < Please respond Y or N : >
BADSWM: TEXT <%BCDURS Unrecognized switch ">
BDSWM1: TEXT <" ignored
>
FRTOBG: TEXT <
?BCDFRT First physical record too long - blocking factor and/or
logical record size probably wrong
>
TOOBIG: TEXT <
?BCDRTL Physical record too long.
>
OVRSIZ: TEXT < physical records were longer than specified.
>
FRTOSM: TEXT <
?BCDFRS First physical record too short - blocking factor and/or
logical record size probably wrong
>
TOOSML: TEXT <
?BCDRTS Physical record too short.
>
SMLSIZ: TEXT < physical records were shorter than specified.
>
ILLDEN: OUTSTR [ASCIZ/?BCDIDS Illegal density specified.
/]
JRST GETDEN
BADDEN: OUTSTR [ASCIZ/?BCDDCR Drive cannot read at that density.
/]
JRST GETDEN
ERRDEN: OUTSTR [ASCIZ/?BCDSDF Set density failed.
/]
EXIT
CHGBLK: TEXT <
Do you want to change the blocking factor or logical record size? >
actblk: TEXT <The actual physical block size is >
CHARS: TEXT < characters.
>
WORDS: TEXT < words.
>
PHD1: TEXT < ASCII DUMP --- PHYSICAL BLOCKING FACTOR=>
PHD2: TEXT < LOGICAL RECORD SIZE=>
PHD3: TEXT <
----------------------------------------------------------------------------------------------------
1111111111222222222233333333334444444444555555555566666666667777777777888888888899999999990
1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
----------------------------------------------------------------------------------------------------
>
PHD4: TEXT < >
PHD5: TEXT < RECORD >
SUBTTL EBCDIC CONVERSION
EBCTAB: ;OCTAL DECIMAL
EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15 ;0-15 0-13
EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40 ;16-34 14-28
EXP 40,40,40,40,40,34,40,40,12,27,33,40 ;35-50 29-40
EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40 ;51-66 41-54
EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40 ;67-104 55-68
EXP 40,40,40,40,40,"[",".","<","(","+","^","&",40,40,40 ;105-123 69-83
EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/" ;124-141 84-97
EXP 40,40,40,40,40,40,40,40,40,",","%","_",">","?" ;142-157 98-111
EXP 40,40,40,40,40,40,40,40,40,40,":","#","@","'" ;160-175 112-125
EXP "=",42,40,141,142,143,144,145,146,147,150,151 ;176-211 126-137
EXP 40,40,40,40,40,40,40,152,153,154,155,156,157 ;212-226 138-150
EXP 160,161,162,40,40,40,40,40,40,40,40,163,164 ;227-243 151-163
EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40 ;244-261 164-177
EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?" ;262-300 178-192
EXP "A","B","C","D","E","F","G","H","I",40,40 ;301-313 193-203
EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R" ;314-331 204-217
EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351 218-233
EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371 234-249
EXP 40,40,40,40,40,40 ;372-377 250-255
SUBTTL UCLABCD CONVERSION
UCLTAB: ;OCTAL DECIMAL
EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15 ;0-15 0-13
EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40 ;16-34 14-28
EXP 40,40,40,40,40,34,40,40,12,27,33,40 ;35-50 29-40
EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40 ;51-66 41-54
EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40 ;67-104 55-68
EXP 40,40,40,40,40,"[",".",")","(","+","^","+",40,40,40 ;105-123 69-83
EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/" ;124-141 84-97
EXP 40,40,40,40,40,40,40,40,40,",","(","_",">","?" ;142-157 98-111
EXP 40,40,40,40,40,40,40,40,40,40,":","=","'","'" ;160-175 112-125
EXP "=",42,40,141,142,143,144,145,146,147,150,151 ;176-211 126-137
EXP 40,40,40,40,40,40,40,152,153,154,155,156,157 ;212-226 138-150
EXP 160,161,162,40,40,40,40,40,40,40,40,163,164 ;227-243 151-163
EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40 ;244-261 164-177
EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?" ;262-300 178-192
EXP "A","B","C","D","E","F","G","H","I",40,40 ;301-313 193-203
EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R" ;314-331 204-217
EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351 218-233
EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371 234-249
EXP 40,40,40,40,40,40 ;372-377 250-255
SUBTTL GEBCD CONVERSION
;SYMBOLS NOT FOUND BELOW ^,\
GETAB: ;OCTAL DECIMAL
EXP "0","1","2","3","4","5","6","7","8","9" ;0-11 0-9
EXP "\","#","@",":",">","?"," " ;12-20 10-16
EXP "A","B","C","D","E","F","G","H","I" ;21-31 17-25
EXP "&",".","\","(","<","\","\" ;32-40 26-32
EXP "J","K","L","M","N","O","P","Q","R" ;41-51 33-41
EXP "-","$","*",")",";","'","+","/" ;52-61 42-49
EXP "S","T","U","V","W","X","Y","Z" ;62-71 50-57
EXP "_",",","%","=",42,"!" ;72-77 58-63
SUBTTL BCD CONVERSION
BCDTAB: ;OCTAL DECIMAL
EXP 0,"1","2","3","4","5","6","7","8","9","0" ;0-12 0-10
EXP "=","'",":",">",42," ","/" ;13-21 11-17
EXP "S","T","U","V","W","X","Y","Z" ;22-31 18-25
EXP "#",",","(","&","\","_","-" ;32-40 26-32
EXP "J","K","L","M","N","O","P","Q","R" ;41-51 33-41
EXP "!","$","*","]",";","@","+" ;52-60 42-48
EXP "A","B","C","D","E","F","G","H","I" ;61-71 49-57
EXP "?",".",")","[","<","%" ;72-77 58-63
SUBTTL CDCBCD CONVERSION
CDCTAB: ;OCTAL DECIMAL
EXP ":","1","2","3","4","5","6","7","8","9","0" ;0-12 0-10
EXP "=","\","\","%","["," ","/" ;13-21 11-17
EXP "S","T","U","V","W","X","Y","Z" ;22-31 18-25
EXP "]",",","(","\","\","\","-" ;32-40 26-32
EXP "J","K","L","M","N","O","P","Q","R" ;41-51 33-41
EXP "\","$","*","^","\",">","+" ;52-60 42-48
EXP "A","B","C","D","E","F","G","H","I" ;61-71 49-57
EXP "<",".",")","\","\",";" ;72-77 58-63
SUBTTL DATA LOCATIONS
LIN: BLOCK 20
PDL: BLOCK 40
CNVTAB: EXP "E","U","G","B","A","C","D","S"
CNVNUM==.-CNVTAB
CNVLST: MOVE CHR,EBCTAB(MATCH) ;EBCDIC TO ASCII
MOVE CHR,UCLTAB(MATCH) ;UCLABCD 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
MOVE CHR,MATCH ;BINARY TO BINARY
MOVE CHR,SPCTAB(MATCH) ;SPECIAL TO ASCII
CNVLIM: DEC 255,255,63,63,127,63,255,0 ;MAXIMUM LEGAL CHARACTER FOR CONVERSION TYPE
SPCTAB: BLOCK ^D256
SBF: BLOCK 3
OUTFIL:
NAME: Z
EXT: Z
Z
Z
DEV: Z
NCNT: 0
DIOWD: IOWD 0,BUF1+3 ;DUMP I/O WORD
0
IBUF: BLOCK 3
OB: BLOCK 3
BUFN: Z
BUFSIZ: Z
BLKFAC: Z
RECSIZ: Z
NOPNT: POINT 9,OCBUF
OCBUF: BLOCK ^D25
XLIST ;LIT XLISTED
LIT
LIST
VAR
BUF1: Z
END START