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