File FTRANS.

Directory of image this file is from
This file as a plain text file


/FTRANS - TRANSFERS FILES COMPLETE / /MAIN PROGRAM / OCTAL START, GOSUB ;INITAL LOOP, PRINT 20 ;TEXT '__ANY CHANGES? ' CLEARW ;CHANGE YESNO ;INPUTS INCREM ;CHANGE INPUTS, PRINT 10 ;TEXT '_MORE? ' YESNO ;FINAL CLEAR STORE ;OUTDET FILL ;0 ;INDET ;20 PRINT 21 ;TEXT '__INPUT DEVICE = ' TYPTEX ;INDET ;4 PRINT 15 ;TEXT '^FILE NAME = ' TYPTEX ;INDET+2 ;6 PRINT 15 ;TEXT '^EXTENSION = ' TYPTEX ;INDET+5 ;2 OUTIN, PRINT 21 ;TEXT '_OUTPUT DEVICE = ' TYPTEX ;OUTDET ;4 GOIFZO ;INCHK ;CHANGE PRINT 20 ;TEXT '^INDEX LENGTH = ' TYPIN 10 PRINTU ;MASK ;5 STORE1 ;OUTDET+2 FLENT, PRINT 17 ;TEXT '^FILE LENGTH = ' TYPIN 10 PRINTU ;MASK ;5 STORE1 ;LENGTH DECIMAL SUBTIM ;3241 OCTAL GOIF ;INCHK ;INCHK PRINT 33 ;TEXT '^TOO MANY: MAXIMUM IS 3241!' GOTO ;OUTIN INCHK, PRINT 12 ;TEXT '_CORRECT? ' YESNO ;INPUTS / /THE INPUT FILE IS NOW OPENED AND TRANSFER PARAMETERS SET UP / MOVE ;INDET ;.+3 ;6 OPEN ;DEVICE ;FILENAME . ;IFIA MOVE1-1 ;IFIA+3 ;IILEN GOIF ;.+2 ;OPENER GOIFZO ;.+4 ;CHANGE GOTO ;SETVAR LOAD1-1 ;IFIA+10 SIGN1 NEGATE STORE1 ;LENGTH LOAD1 ;IILEN /CHECK FOR RUBBISH SUBT1 ;LENGTH GOIF ;.+2 ;.+3 CLEARW ;IILEN MOVE1 ;IILEN ;OUTDET+2 SETVAR, MOVE-1 ;IFIA+1 ;IISB ;1 LOAD1 ;IISB ADD1 ;IILEN STORE1 ;IFSB LOAD1-1 ;IFIA+10 SIGN1 ADD1 ;LENGTH GOIF ;.+2 ;OUTLES STORE1 ;EXTRAF LOAD1 ;IILEN SUBT1 ;OUTDET+2 SIGN1 NEGATE STORE1 ;EXTRAI LOAD1-1 ;IFIA+10 SIGN1 NEGATE SUBT1 ;IILEN STORE1 ;IFLEN GOTO ;JMPSUB OUTLES, CLEARW ;EXTRAF CLEARW ;EXTRAI LOAD1 ;OUTDET+2 STORE1 ;IILEN LOAD1 ;LENGTH GOTO ;OUTLES-6 JMPSUB, LOAD1 ;OUTDET+2 STORE1 ;OILEN LOAD1 ;LENGTH SUBT1 ;OILEN STORE1 ;OFLEN GOPAL ;TRANSF / /TEST FOR ANY ERRORS IN FILE TRANSFER / PRINT 2 ;TEXT '__' GOIFZO ;TRNSOK ;ERRSW PRNMES, PRINT 23 ;TEXT 'FILE TRANSFER ERROR' LOAD1 ;ERRSW PRINTU ;MASK ;4 PRINTC 2 ;TAB SUBTIM ;1 STORX1 MULTX1 22 PRINTX ;EMTAB ;43 PRINT 2 ;TEXT '__' GOTO ;INPUTS
/ /TO HERE IF TRANSFER IS CORRECT / TRNSOK, MOVE ;OUTDET ;.+7 ;2 MOVE ;INDET+2 ;.+5 ;4 OPEN ;DEVICE ;FILENAME . ;OFIA GOIF ;.+2 ;OOUTER FILL-10 ;-1 ;XAREA ;400 LOAD1 ;EXTRAI GOIF ;TESTEF ;.+1 LOAD2-1 ;OFIA ADD1 ;IILEN STORE2 ;ABSWTM LOAD2 ;ABSWTM EXINWT, WRITAB GOIF ;.+2 ;WRITER ADDIM ;1 DECGOZ ;TESTEF ;EXTRAI GOTO ;EXINWT TESTEF, LOAD1 ;EXTRAF GOIF ;CLSOUT ;.+1 LOAD1-1 ;OFIA STORE1 ;ABSWTM LOAD1-1 ;OFIA+1 ADD1-1 ;OFIA+3 ADD1 ;IFLEN STORE1 ;ABSWTM+1 LOAD2 ;ABSWTM EXFIWT, WRITAB GOIF ;.+2 ;WRITER ADDIM ;1 DECGOZ ;CLSOUT ;EXTRAF GOTO ;EXFIWT CLSOUT, MOVE ;INDET+2 ;.+3 ;4 CLOSE ;FILENAME . ;OFIA GOIF ;.+2 ;COUTER PRINTX ;PRNMES+1 ;5 PRINTX ;INDET+2 ;6 PRINTC 1 ;". PRINTX ;INDET+5 ;2 PRINT 17 ;TEXT ' NOW EXISTS ON ' PRINTX ;OUTDET ;4 GOTO ;INPUTS / /PROGRAM ENDS HERE / FINAL, PRINT 14 ;TEXT '_FINISHED? ' YESNO ;LOOP PRINT 13 ;TEXT '_END OF JOB' EXIT / /TO HERE IF FILE OPENING ERROR / OPENER, PRINT 31 ;TEXT '_ERROR OPENING INPUT FILE' GOTO ;INPUTS /RASBOL SYSTEM DATE ROUTINE DECIMAL RSDATE, 0;0 LOAD1 ;4022 /7666 ANDIM ;248 /370 SHIFTR 3 MULTIM ;100 STORE2 ;RSDTEMP LOAD1 ;4022 SHIFTR 8 ADD2 ;RSDTEMP MULTIM ;100 STORE2 ;RSDTEMP LOAD1 ;4022 ANDIM ;7 ADDIM ;70 ADD2 ;RSDTEMP GOTO ;RSDATE RSDATP, 0;0 GOSUB ;RSDATE PRINTU ;RSDMSK ;10 GOTO ;RSDATP RSDMSK,TEXT ' / / -' RSDTEMP, 0;0 OCTAL / /INITIALISE ROUTINE / INITAL, 0;0 FILL 10 ;-1 ;BUFFER ;400 PRINT 31 ;TEXT '_^^FILE TRANSFER PROGRAM^' GOSUB ;RSDATE PRINTU ;DMASK ;12 GOTO ;INITAL / /CONSTANTS AND LITERALS / EMTAB, TEXT 'INPUT DEVICE NOT IN CURRENT SYSTEM ' TEXT 'OUTPUT DEVICE NOT IN CURRENT SYSTEM' TEXT 'CANNOT FETCH OUTPUT DEVICE HANDLER ' TEXT 'NO ROOM FOR TEMPORARY OUTPUT FILE ' TEXT 'NEW OUTPUT FILE NOT REQUIRED LENGTH' TEXT 'WRITE ERROR WHEN COPYING FILE INDEX' TEXT 'READ ERROR WHILE TRANSFERRING FILE ' TEXT 'WRITE ERROR WHILE TRANSFERRING FILE' TEXT 'CANNOT CLOSE OUTPUT FILE CORRECTLY ' TEXT 'DIRECTORY ERROR LOOKING UP NEW FILE' TEXT 'NO ROOM FOR DATA WORDS IN DIRECTORY' TEXT 'WRITE ERROR COPYING DIRECTORY BLOCK' OOUTER, PRINT 42 ;TEXT '_ERROR OPENING SEMI-PERMANENT FILE' COMEXT, PRINT 57 ;TEXT '_OUTPUT FILE MUST BE DELETED USING PIP OR RFDEL' EXIT WRITER, PRINT 70 ;TEXT '_ERROR WRITING HIGH VALUES TO EXTRA INDEX OR FILE BLOCKS' GOTO ;COMEXT COUTER, PRINT 46 ;TEXT '_ERROR CLOSING SEMI-PERMANENT FILE' GOTO ;COMEXT / / CHANGE, 0 ABSWTM, 0;0 / /LITERALS / MASK, TEXT ' 0-' DMASK, TEXT ' / / ' /
/ /THIS PAL SUBROUTINE MAKES USE OF THE OS/8 USER SERVICE /ROUTINE TO SET UP THE NEW FILE ON THE DEVICE SELECTED /BY THE USER AND THEN TRANSFERS THE OLD FILE TO THE NEW / *6200 STRANS, 0 CLA CLL RDF TAD (CDI 0 DCA TSEXIT / /RESET TABLES / CDI 10 JMS I (200 13 /RESET 0 /SAVE TENTATIVE FILES / /GET INPUT HANDLER / TAD INDET /DEVICE NAME - INPUT DCA TS01 TAD INDET+1 DCA TS02 TAD (6601 /HANDLER ADDRESS - INPUT DCA TS03 CDI 10 JMS I (200 1 /FETCH TS01, 0 /NAME 1 TS02, 0 /NAME 2 - DEVICE NO. TS03, 0 /HAND. ADD. - ENTRY JMP ERR01 / /CHECK FOR OUTPUT HANDLER / TAD OUTDET /DEVICE NAME - OUTPUT DCA TS04 TAD OUTDET+1 DCA TS05 CDI 10 JMS I (200 12 /INQUIRE TS04, 0 /NAME 1 TS05, 0 /NAME 2 - DEVICE NO. TS06, 0 /ENTRY POINT INDICATOR JMP ERR02 CLA CLL TAD TS06 /GET INDICATOR SZA CLA /HANDLER LOADED? JMP TSCONT /YES...CONTINUE / /GET OUTPUT HANDLER / TAD (7201 /HANDLER ADDRESS - OUTPUT DCA TS07 TAD TS05 /GET DEVICE NUMBER CDI 10 JMS I (200 1 /FETCH TS07, 0 /HAND. ADD. - ENTRY JMP ERR03 / /CREATE AND OPEN OUTPUT FILE / CLA CLL TAD TS07 /GET ENTRY POINT JMP .+2 TSCONT, TAD TS06 /GET ENTRY POINT DCA OUTENT /STORE IT TAD (INDET+2 /FILE NAME ADDRESS DCA TS08 TAD TS05 /GET DEVICE NUMBER CDI 10 JMS I (200 3 /ENTER TS08, 0 /NAME POINTER - START BLOCK TS09, 0 /CREATED LENGTH JMP ERR04 / /CHECK FOR ROOM / CLA CLL TAD I (LENGTH TAD TS09 SZL SNA CLA SKP CLA JMP ERR05 /NO...ERROR / /SET UP OUTPUT PARAMETERS / TAD TS08 DCA OISB TAD TS08 TAD OILEN DCA OFSB / /TO SECOND PART OF ROUTINE / JMP TSNEXT / /THIS SUBROUTINE READS A BLOCK FROM THE /INPUT FILE AND WRITES IT TO THE OUTPUT / TRANSB, 0 CLA CLL CDF 10 CIF 0 JMS I INENT /TO INPUT HANDLER 210 /INPUT ONE BLOCK BUFFER /TO HERE... TBSIB, 0 /...FROM HERE JMP ERR07 CLA CLL CDF 10 CIF 0 JMS I OUTENT /TO OUTPUT HANDLER 4210 /OUTPUT ONE BLOCK BUFFER /FROM HERE... TBSOB, 0 /...TO HERE JMP ERR08 JMP I TRANSB /RETURN / /CONSTANTS / OUTENT, 0 TSKNT, 0 INENT=TS03 / /THIS IS THE ACTUAL EXIT FROM THE SUBROUTINE / TSEXIT, 0 /RESET CALLING FIELD JMP I STRANS /RETURN TO CALLING SUBROUTINE / /CONSTANTS / INDET, ZBLOCK 6 OUTDET, 0;0;0 / / /THIS IS THE SECOND HALF OF THE PAL /SUBROUTINE WHICH TRANSFERS FILES / /FIRST TRANSFER INDEX AND COPY OLD FILE / *6400 TSNEXT, CLA CLL TAD IILEN /GET INDEX LENGTH SNA /IS IT 0? JMP TSTDS /YES...TO TRANSFER DATA CIA /NO...SET AS COUNTER DCA TSTKNT TAD IISB /SET BLOCK NUMBER - INPUT DCA TBSIB TAD OISB /SET BLOCK NUMBER - OUTPUT DCA TBSOB TSTIND, JMS TRANSB /COPY BLOCK ISZ TBSIB /INPUT BLOCK + 1 ISZ TBSOB /OUTPUT BLOCK + 1 ISZ TSTKNT /COUNT + 1 JMP TSTIND /BACK IF MORE TSTDS, CLA CLL TAD IFSB /GET INPUT START BLOCK DCA TBSIB /SET AS INPUT BLOCK TAD OFSB /GET OUTPUT START BLOCK DCA TBSOB /SET AS OUTPUT BLOCK TAD IFLEN /GET INPUT FILE LENGTH CIA DCA TSTKNT /SET AS COUNTER TSTDAT, JMS TRANSB /COPY BLOCK ISZ TBSIB /INPUT BLOCK + 1 ISZ TBSOB /OUTPUT BLOCK + 1 ISZ TSTKNT /COUNT + 1 JMP TSTDAT /BACK IF MORE / /OUTPUT FILE IS NOW CLOSED AND MADE PERMANENT / CLA CLL TAD TS05 /OUTPUT DEVICE NUMBER CDI 10 JMS I (200 4 /CLOSE TSNMAD, INDET+2 /FILE NAME POINTER LENGTH, 0 /NUMBER OF BLOCKS JMP ERR09 / /LOOKUP NEW FILE / CLA CLL TAD TSNMAD /FILE NAME ADDRESS DCA TS11 TAD TS05 /DEVICE NUMBER CDI 10 JMS I (200 2 /LOOKUP TS11, 0 /NAME POINTER TSTKNT, 0 JMP ERR10
/ /ADDITIONAL INFORMATION WORDS ARE NOW /WRITTEN TO THE NEW DIRECTORY ENTRY / CLA CLL TAD I (1404 /FETCH NO. OF A.I.W. DCA TSPT1 CLA CLL CML IAC RTL /SET 6 TAD TSPT1 /ADD NUMBER SMA SZA CLA / < 6? JMP ERR11 /YES...ERROR CLA CLL CMA /NO...SET -1 TAD TSPT1 /ADD NUMBER TAD I (17 /ADD POINTER JMS I (TSWAIW /TO SET UP AND WRITE / /THE PAL SUBROUTINE NOW RETURNS TO THE MAIN PROGRAM / JMP TSNLEX /TO ROUTINE EXIT / /TRANSFER ROUTINE ERROR EXITS / ERR12, ISZ ERRSW ERR11, ISZ ERRSW ERR10, ISZ ERRSW ERR09, ISZ ERRSW ERR08, ISZ ERRSW ERR07, ISZ ERRSW ERR06, ISZ ERRSW ERR05, ISZ ERRSW ERR04, ISZ ERRSW ERR03, ISZ ERRSW ERR02, ISZ ERRSW ERR01, ISZ ERRSW / /NORMAL EXIT / TSNLEX, CLA CLL / /RESET TABLES - FORCES MICRO TO GET ITS OWN HANDLERS / CDI 10 JMS I (200 13 /RESET 0 /SAVE TENTATIVE FILES / /USE BIG HAMMER TO RESET DEVICE HANDLER /SPACE AVAILABLE SWITCH IN MICRO PROGRAM / CLA CLL CMA RTL /SET -3 DCA I (7522 /STORE IN SWITCH CLA CLL / /DISMISS OS/8 USR / CDI 10 JMS I (200 11 /USROUT JMP TSEXIT /TO EXIT / /CONSTANTS AND WORK AREAS / TSPT1=TSTKNT EXTRAF, 0 EXTRAI, 0 IISB, 0 IFSB, 0 IILEN, 0 IFLEN, 0 OISB, 0 OFSB, 0 OILEN, 0 OFLEN, 0 ERRSW, 0 / / /BLOCK AREA FOR DATA TRANSFER / FIELD 1 *7000 BUFFER, ZBLOCK 400 / /THIS ROUTINE SETS UP THE ADDITIONAL /INFORMATION WORDS FOR THE NEW FILE *6600 / TSWAIW, 0 DCA 10 /STORE POINTER (DATE - 1) TAD TSIWOA /OLD WORDS ADD. (F.U.B. - 1) DCA 11 TAD I TSIWSD /GET DATE DCA I 10 TAD I TSIWIL /NEW INDEX LENGTH DCA I 10 TAD TSIWM4 /SET LOOP COUNT DCA TSIWKT TSIWLP, CDF 0 TAD I 11 /FETCH OLD WORD CDF 10 DCA I 10 /STORE AS NEW ISZ TSIWKT /COUNT + 1 JMP TSIWLP /BACK IF MORE / /DIRECTORY SEGMENT IS NOW REWRITTEN / TAD 7 /GET KEY WORD AND TSIW7 /EXTRACT SEGMENT NUMBER DCA TSIWSN CIF 0 JMS I 51 /TO OUTPUT HANDLER 4210 /WRITE SEGMENT 1400 /FROM HERE... TSIWSN, 0 /...TO HERE JMP .+2 JMP I TSWAIW /RETURN JMP I TSIWER /ERROR RETURN / /CONSTANTS / TSIWOA, IFIA+3 TSIWSD, 7666 TSIWIL, OUTDET+2 TSIWM4, -4 TSIWKT, 0 TSIW7, 7 TSIWER, ERR12
/ /THESE ARE THE FILE INFORMATION AREAS FOR THE PROGRAM / FIELD 0 *6200 IFIA, ZBLOCK 11 /INPUT FILE OFIA, ZBLOCK 11 /OUTPUT FILE / /THE FILE TRANSFER SUBROUTINE STARTS HERE / TRANSF, 0 / /FIRST FETCH USER SERVICE ROUTINE / CDF 0 CIF 10 JMS I (7700 10 /USRIN CDF 0 CIF 10 JMS I (STRANS / /AND ENDS HERE / CDI 0 JMP I TRANSF / $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search