.TITLE CARDS .SBTTL MACRO CALLS ; .MCALL QIOW$C,QIO$C,ALUN$C,QIO$ .MCALL FSRSZ$,FDBDF$,FDAT$A,FDBK$A,FDOP$R,OPEN$W,OPEN$R .MCALL PUT$,GET$,CLOSE$ .MCALL EXIT$S ; ; .LIST .NLIST BEX .ENABL LC ; ; THIS PROGRAM IS TO READ THE MAG TAPE, SPACE OUT THE INFORMATION AND ; WRITE OUT THE INFORMATION TO A DISK FILE ; ; THE FILE NAME QUERIED FOR IN THE PROGRAM WILL CAUSE THAT FILE TO ; BE OPENED AND READ FOR THE FOLLOWING INFORMATION: (BY LINES) ; 1 - FILE NAME WHERE THE DATA FROM THE MAG TAPE IS TO BE PLACED ; 2 - SECOND LINE WILL CONTAIN THE DEFAULT PUNCTUATION, I.E. THE PERIODS ; 3 - CONTAINS THE NUMBER OF CHARACTERS TO PRINT OUT TO THE FILE (1-80.) ; 4 - FOURTH LINE CONTAINS THE STARTING LOCATION WHERE THE CHARACTERS ARE ; TO BE MOVED FROM (1-80.) ; 5 - CONTAINS THE LOCATION IN THE OUTPUT BUFFER (1-132.) ; 6 - CONTAINS THE NUMBER OF CHARACTERS TO TRANSFER FROM THE INPUT BUFFER ; TO THE OUTPUT BUFFER (1-40.) ; .SBTTL SETUP FDB'S ; ; SETUP THE FDB FOR THE FILES ; FSRSZ$ 1 ;SET UP FSR'S FILE1: FDBDF$ ;DEFINE FDB FOR FILE1 - DATA FILE FOR FDBK$A ,,,,FIL1IO ;FOR INFO ; FILE2: FDBDF$ ;DEFINE FDB FOR FILE2 - OUTPUT FILE FDAT$A R.VAR,FD.CR ; ; .SBTTL MAINLINE CODE YRKTWN: NOP ; ; ; ATTACH AND REWIND THE MAG TAPE UNIT ; TAPE=2 ALUN$C TAPE,MT,0 QIO$C IO.ATT,TAPE,,,MTSTAT QIO$C IO.RWD,TAPE,,,MTSTAT ; NOP ; TI=3 ALUN$C TI,TI,0 QIO$C IO.ATT,TI,1,,TISTAT ; ; FILL OUTBUF WITH BLANKS ; MOV #" ,R0 MOV #66.,R1 MOV #OUTBUF,R2 10$: MOV R0,(R2)+ SOB R1,10$ ; ; LET'S GET THE BALL ROLLING, FIND OUT THE NAME OF THE FILE WHERE THIS ; FILE IS SUPPOSED TO GO ; QIOW$C IO.RPR,TI,1,,TISTAT,, MOV TISTAT+2,INLEN1 ;MOVE NUMBER OF CHARS IN TO BUFFER ; ; THIS FILE IS WHERE THE INFORMATION FOR READING THE MAG TAPE COMES FROM ; FDOP$R #FILE1,#1,#FILNM1 ;RUN TIME FDOP$ OPEN$R #FILE1,,,,#80.,IOERR ; ; GET THE FILENAME ABOUT WHERE TO PUT THE TAPE DATA ; GET$ #FILE1,#FILEN2,,IOERR MOV F.BKST(R0),INLEN2 ; ; GET THE DEFAULT PUNCTUATION ; GET$ ,#OUTBUF,,IOERR ; ; GET THE NUMBER OF CHARACTERS TO PRINT TO THE OUTPUT FILE ; FIRST STEP: CLEAR WITH BLANKS ; MOV #" ,INBUF MOV #" ,INBUF+2 MOV #" ,INBUF+4 GET$ ,#INBUF,,IOERR MOV #INBUF,R0 CALL $CDTB CMP R1,#132. ;MAXIMUM NUMBER OF CHARACTERS EXCEEDED? BLE OKIE ;SOUNDS GOOD TO ME ; ; I CAN'T PRINT THAT MANY CHARACTERS TO A FILE ; QIOW$C IO.WLB,TI,1,,,, EXIT$S ; OKIE: MOV R1,OUTLEN ; ; GET THE "FROM" LOCATIONS ; MOV #FRMBUF,R3 MOV #80.,MAX MOV #INBUF,CONVRT DEC CONVRT JSR PC,INTERP ; ; GET THE "TO" LOCATIONS ; MOV #TOBUF,R3 MOV #133.,MAX MOV #OUTBUF,CONVRT DEC CONVRT JSR PC,INTERP ; ; GET THE QUANTITY DESIRED TO MOVE ; MOV #QUABUF,R3 MOV #40.,MAX CLR CONVRT JSR PC,INTERP ; CLOSE$ #FILE1 ; ; Number of files to space before reading the tape ; QIOW$C IO.RPR,TI,1,,,, CMPB #'N,RESPN BEQ DOUREW QIO$C IO.SPF,TAPE,,,,,<001> ;Skip one file mark ; ; ; DO YOU WANT TO REWIND THE TAPE WHEN FINISHED ; DOUREW: CLR REWIND QIOW$C IO.RPR,TI,1,,,, CMPB RESPN,#'N BEQ 10$ INC REWIND 10$: NOP ; ; IS THE TAPE EBCDIC? FIND OUT? ; CLR CONVRT QIOW$C IO.RPR,TI,1,,,, CMPB RESPN,#'N BEQ 10$ INC CONVRT 10$: NOP ; ; NOW IS THE TIME TO OPEN THE OUTPUT FILE THAT WAS GIVEN IN THE FIRST RECORD ; OF FILE1. ; FDOP$R #FILE2,#1,#FILNM2 ;RUN TIME FDOP$ OPEN$W #FILE2,,,,#INBUF ; ; GET ONE BUFFER OF INFORMATION FROM THE MAG TAPE AND LET ; ME KNOW IF IT IS CORRECT ; QIOW$C IO.RLB,TAPE,1,,MTSTAT,, JSR PC,REDO QIO$C IO.WLB,TI,,,,, QIOW$C IO.RPR,TI,1,,,, CMPB RESPN,#'Y BEQ DOKIE BR MTERR ; ; GET MAG-TAPE BUFFER OF INFORMATION ; ONCE: NOP QIOW$C IO.RLB,TAPE,1,,MTSTAT,, TSTB MTSTAT BLE MTERR ; ; EVERYTHING IS HUNKY DORY & PEACHY KEEN ; JSR PC,REDO DOKIE: MOV OUTLEN,R1 PUT$ #FILE2,#OUTBUF,R1 ;WRITE OUT THE OUTPUT RECORD 20$: JMP ONCE ; MTERR: CMPB #IE.EOF,MTSTAT ;WAS THE PROBLEM EOF BEQ WHOA ;THAT'S NO PROBLEM, EXIT ; ; SOMETHING ELSE ; DESCRIBE IT ; MOV #PRBDSC,R0 MOVB MTSTAT,R1 JSR PC,PDESC ; MOVB MTSTAT+1,R1 JSR PC,PDESC ; MOVB MTSTAT,R1 JSR PC,PDESC ; QIOW$C IO.WVB,TI,1,,TISTAT,, ; WHOA: NOP ; REWIND AND DETACH THE TAPE DRIVE ; ; SHOULD THE MAG-TAPE BE REWOUND BEFORE EXITING, CHECK WITH RESPN ; CMPB RESPN,#'N BEQ DETAPE QIOW$C IO.RWD,TAPE,1,,MTSTAT DETAPE: NOP QIOW$C IO.DET,TAPE,1,,MTSTAT ; ; CLOSE DISK FILE ; CLOSE$ #FILE2 ; EXIT$S ; IOERR: MOV R0,R3 MOV #PRBDSC,R0 ; ; LOW BYTE ; MOVB F.ERR(R3),R1 JSR PC,PDESC ; ; HIGH BYTE ; MOVB F.ERR+1(R3),R1 JSR PC,PDESC ; ; WHOLE WORD ; MOV F.ERR(R3),R1 JSR PC,PDESC ; QIOW$C IO.WLB,TI,1,,,, BR WHOA ; ; .PAGE .SBTTL DATA ; ; ; STATUS BLOCK AREAS AND TEMPORARY DATA LOCATIONS ; MAX: .BLKW 1 MTSTAT: .BLKW 2. TISTAT: .BLKW 2. FIL1IO: .BLKW 2. REWIND: .BLKW 1. CONVRT: .BLKW 1. ;CONVERT - CLEARED IF DATA IS ASCII, ELSE CONVERT ;FROM EBCDIC (SOMETHING LIKE THAT??) ;USED AS A TEMPORARY STORAGE FOR OFFSET ADDRESSES ;ALSO USED IN PDESC ( A SUBROUTINE) FOR ;TEMPORARY STORAGE ; ; TERMINAL I/O ; INBUF: .BLKB 134. .EVEN RESPN: .ASCII / / .EVEN OUTBUF: .BLKB 132. .EVEN OUTLEN: .BLKW 1 ; ; BUFFER AREAS ; FRMBUF: .BLKW 40. TOBUF: .BLKW 40. QUABUF: .BLKW 40. ; ; SET UP FOR FORTRAN SUBROUTINE CALLING SEQUENCE ; TRANS: .WORD 2,INBUF,NUMCHR NUMCHR: .WORD 134. ; ; ; FILE NAME BLOCKS ******* ; ; FILE NAME BLOCK FOR FILE 1 ; FILNM1: .WORD 0,0,0,0 ;DEFAULT DEVICE AND UIC INLEN1: .BLKW 1 .WORD FILEN1 FILEN1: .BLKB 16. .EVEN ; ; FILE NAME BLOCK FOR FILE 2 ; FILNM2: .WORD 0,0,0,0 ;DEFAULT DEVICE AND UIC INLEN2: .BLKW 1 .WORD FILEN2 FILEN2: .BLKB 16. .EVEN ; ; PROMPT MESSAGES ; TI1=. NAMPLZ: .ASCII /Name of file to retrieve data about storing information:/ TILEN1=.-TI1 .EVEN TI1=. TOMANY: .ASCII /You are trying to print out too many/ .ASCII / characters to the/<12><15>/output file. The/ .ASCII / limit is 132./ TILEN2=.-TI1 .EVEN TI1=. REWPLZ: .ASCII /Should the tape be rewound before exiting:/ TILEN3=.-TI1 .EVEN TI1=. EBCONV: .ASCII /Convert EBCDIC to ASCII:/ TILEN4=.-TI1 .EVEN OKFINE: .ASCII /Is the output (above) okay:/ TILEN5=.-OKFINE .EVEN SKPFLE: .ASCII /Skip One file?/ TILEN6=.-SKPFLE ; ; PROBLEM DESCRIPTION AREA ; PROBLM: .ASCII <12><15>/ Tape has problems, rewinding tape and exiting / .BYTE 12,15 PRBDSC: .ASCII / / NPROB=.-PROBLM .EVEN ; .PAGE .SBTTL SUBROUTINES ; ; THIS SUBROUTINE IS TO INTERPRET THE NUMBERS GIVEN IN THE FILE ; AND TRANSFORM THEM INTO SOMETHING SCARLET CAN USE, I.E. DECREMENT EACH ; BY ONE TO TAKE INTO ACCOUNT THE ZERO OFFSET LOCATION ; INTERP: NOP GET$ #FILE1,#INBUF,,IOERR MOV F.BKST(R0),R1 MOV #INBUF,R2 ADD R1,R2 MOVB #'.,(R2) CLR R2 MOV #INBUF,R0 INTNEX: CMPB #'.,R2 BEQ INTFIN CALL $CDTB CMP #1,R1 BHI INTNEX CMP MAX,R1 BLO INTNEX ADD CONVRT,R1 MOV R1,(R3)+ BR INTNEX INTFIN: RTS PC ;FINISHED IN THIS SUBROUTINE ; ; THIS ROUTINE IS TO CONVERT THE NUMBER IN R1 TO DECIMAL AND ; OCTAL FOR PRINTING INTO THE OUTPUT LINE. LOCATION SPECIED BY R0 ; PDESC: MOV R1,CONVRT CLR R2 CALL $CBDSG MOVB #'.,(R0)+ MOVB #' ,(R0)+ MOV CONVRT,R1 CLR R2 CALL $CBOMG MOVB #' ,(R0)+ MOVB #' ,(R0)+ MOVB #' ,(R0)+ RTS PC ; ; THIS SUBROUTINE IS TO RE-ARRANGE THE INPUT BUFFER TO HOW ; THE OUTPUT BUFFER WILL LOOK ; REDO: TST CONVRT BEQ 10$ MOV #TRANS,R5 JSR PC,EBCASC 10$: CLR R0 20$: MOV FRMBUF(R0),R1 BEQ REDONE MOV TOBUF(R0),R2 MOV QUABUF(R0),R3 INC R0 INC R0 30$: MOVB (R1)+,(R2)+ SOB R3,30$ BR 20$ REDONE: RTS PC ; .END YRKTWN