. . OUTPUT PROCESS . . OPTIONS: . <NONE> IGNORE EOF MARKS. INCREMENT IBMSAD . 'D' WRITE AT IBMSAD OF INPUT BLOCK, CONVERTING IF NECESSARY . 'G' TAPE => MASS / MASS => TAPE COMPATIBLE FORMAT . 'M' TAPE => TAPE. WRITE EOF MARK FOR EOF STATUS . . . (C) Copyright 1972-1978 John Walker . . This software is in the public domain . AXR$ DEFUNCT$ FANG PURE CODE . . FORMAT OF SCATTER GATHER BUFFER . SGAX1 EQUF 0 ACW1: 2,$+2 SGAX2 EQUF 1 ACW2: USER BUFFER ACW SGTRK EQUF 2 TRACK NUMBER / ADDRESS FOR WAD sgcksm equf 3,,h1 checksum total of block sgbseq equf 3,,h2 block sequence number SGL EQU 4 LENGTH OF S/G BUFFER . . LX,U X9,<OUTPUT FCT> . LX,U X10,<INPUT FCT> . LMJ A2,OUTPUT . <RETURN> . OUTPUT* FORK WRITESU START WRITE PROCESS AT SETUP POINT J 0,A2 RETURN . WRITESU LA,U A0,W$ GET WRITE FUNCTION SA A0,IOFUNC,X9 PUT WRITE FUNCTION IN PACKET LR,U R14 CLEAR PROTECT WORK BUFFER ADDRESS LA A0,IOFDT,X9 LOAD FDT ADDRESS OF OUTPUT FILE TNZ FDPROT,A0 IS PROTECTION MODE ON ? J NOPRSU NO. SKIP BUFFER ALLOCATION BGET PROTL ALLOCATE A CRYPTOGRAPHIC WORK BUFFER LR,U R14,,A0 SAVE WORK BUFFER ADDRESS NOPRSU la,u a12 clear block sequence counter LA A14,IOOPT,X9 LOAD OUTPUT OPTION TNZ IOMASS,X9 IS OUTPUT FILE TAPE ? TE,U A14,'G' YES. IS 'G' MODE SET ? J NOTG NO. DON'T DO SPECIAL S/G SETUP BGET SGL ALLOCATE A SCATTER GATHER BUFFER LXI,U A0,2 FORM ACW ACW SA A0,IOACW,X9 PUT ACW ACW INTO PACKET AU,U A0,SGTRK A1 = ACCESS WORD FOR FIRST 2 WORDS SA A1,SGAX1,A0 PUT IN FIRST ACCESS WORD LOCATION LA,U A1,GW$ LOAD GATHER WRITE FUNCTION SA A1,IOFUNC,X9 PUT IT INTO THE PACKET NOTG . . WRITEPR GET IOBB,X10 GET A BUFFER FROM THE SOURCE FCT TZ IBSTAT,A1 WAS COMPLETION CODE NORMAL ? J WABN NO. INVESTIGATE OPTIONS JE A14,'G',GMW 'G' OPTION MODE ? LA A0,IOFDT,X9 GET FDT ADDRESS TNZ FDPROT,A0 IS PROTECTION DESIRED FOR THIS FILE ? J NOUPRM NO. SKIP DATA ENCODING LR R1,IBLEN,A1 LOAD BLOCK LENGTH LX,U X1,IBDATA,A1 GET DATA BUFFER ADDRESS LX X5,R14 LOAD WORK BUFFER ADDRESS LX,U X3,,A1 SAVE BLOCK BUFFER ADDRESS DL A0,FDCRYK,A0 LOAD KEY FOR DATA LMJ X2,ENCIPHER ENCODE THE DATA IN THE BLOCK LA,U A1,,X3 RESTORE BLOCK BUFFER ADDRESS NOUPRM . JE A14,'D',DMW DUPLICATE ADDRESS MODE ? WACWS LA,U A2,IBDATA,A1 GET DATA BUFFER START POINTER LXI A2,IBLEN,A1 LOAD LENGTH TO WRITE SA A2,IOACW,X9 PUT INTO ACCESS WORD WRIDIT IOW$ IOPKT,X9 FIRE UP WRITE OPERATION WRISTK TZ IOSTATUS,X9 DID WRITE COMPLETE NORMALLY ? J WERROR NO. WRITING ERROR EOTDUN TNZ IOMASS,X9 MASS STORAGE OUTPUT ? J WTERM NO. DON'T FIDDLE WITH ADDRESS LA A4,IOXFER,X9 LOAD WORDS TRANSFERRED TZ IOWAD,X9 WORD ADDRESSABLE ? J WADADD YES. DON'T CONVERT TO SECTORS DSL A4,36 RIGHT JUSTIFY IN 72 BITS AA,U A5,27 ADD FOR COVERED DIVIDE DI,U A4,28 GET LENGTH IN SECTORS WADADD AA A4,IODRAD,X9 INCREMENT ADDRESS SA A4,IODRAD,X9 UPDATE ADDRESS FOR NEXT TIME LA A0,IOFDT,X9 GET FDT POINTER SA A4,FDIPLC,A0 PUT DYNAMIC ADDRESS IN PACKET WTERM LA A2,IBLAST,A1 LOAD THE 'LAST BLOCK' FLAG BRELP A1 RELEASE THE BLOCK BUFFER JZ A2,WRITEPR LOOP AROUND IF NOT THE LAST BLOCK JNE A14,'G',GOCON 'G' OPTION MODE ? TZ IOMASS,X9 IS OUTPUT FILE TAPE ? J GOCON NO. SKIP TAPE CLOSING BRELP IOACW,X9,H2 RELEASE SCATTER GATHER BUFFER LA,U A0,WEF$ GET WRITE EOF MARK FUNCTION SA A0,IOFUNC,X9 PUT IN PACKET IOW$ IOPKT,X9 WRITE EOF MARK ON TAPE TZ IOSTATUS,X9 DID IT COMPLETE O.K. ? J WTRMER NO. WRITE TERMINATION ERROR GOCON . ENDWRT V IOBB+QL,X9 V THE COMPLETION QUEUE TZ IOMASS,X9 IS OUTPUT MASS STORAGE ? TZ IOOPT,X9 YES. ANY OPTIONS SPECIFIED ? J ADSNOS NO. DON'T TOUCH ADDRESS LA A0,CDOPTS,X8 LOAD OPTIONS TOP,U A0,OPTION('R') DON'T CHANGE ADDRESS ? TEP,U A0,OPTION('S') OR ADDRESS SPECIFIED ? J ADSNOS YES. DON'T CHANGE ADDRESS LA A0,IODRAD,X9 LOAD CURRENT ADDRESS LA A1,IOFDT,X9 LOAD FDT ADDRESS SA A0,FDMSAD,A1 PUT ADDRESS IN FDT ADSNOS LA A0,R14 LOAD PROTECT WORK BUFFER ADDRESS TZ A0 DID WE ENCODE DATA IN THIS FILE ? BRELP A0 YES. RELEASE THE WORK BUFFER EXIT . TERMINATE THE WRITER ACTIVITY . . 'G' OPTION HANDLER . GMW TZ IOMASS,X9 IS OUTPUT TAPE ? J GOMER NO. OUTPUT IS MASS STORAGE TP IBMSAD,A1 SPECIAL WRITE HEADER CALL ? J GOMEX YES. FUDGE A LITTLE BIT LA,U A2,IBDATA,A1 LOAD ADDRESS OF BLOCK DATA LXI A2,IBLEN,A1 GET THE DATA ACCESS WORD LA,H2 A3,IOACW,X9 GET ADDRESS OF SCATTER GATHER BUFFER SA A2,SGAX2,A3 PUT DATA ACCESS WORD IN BUFFER LA A2,IBMSAD,A1 LOAD ADDRESS THIS WAS READ FROM SA A2,SGTRK,A3 SAVE ADDRESS IF FIRST 2 WORDS BUFFER sa a12,sgbseq,a3 set block sequence in header aa,u a12,1 increment block number la,u a0,ibdata,a1 load data address aa a0,(1,0) get increment to checksum buffer la,u a4,0 clear checksum total lr r1,iblen,a1 load total length to sum j $+2 enter the checksum loop aa a4,,*a0 sum all words in block jgd r1,$-1 loop until all are done sa a4,a0 save checksum total ssl a4,18 shift to combine halves ah a4,a0 combine two halves of total sa a4,sgcksm,a3 set checksum for block LA A0,IOFDT,X9 LOAD FDT ADDRESS FOR OUTPUT FILE TNZ FDPROT,A0 IS PROTECTION INVOKED FOR THIS FILE " J WRIDIT WRITE THE BUFFER TO TAPE LR R1,IBLEN,A1 LOAD LENGTH OF DATA IN BLOCK LX,U X1,IBDATA,A1 LOAD DATA START ADDRESS LX X5,R14 LOAD WORK BUFFER ADDRESS LX,U X3,,A1 SAVE BLOCK BUFFER ADDRESS DL A0,FDCRYK,A0 LOAD KEY FOR THE FILE LMJ X2,ENCIPHER ENCIPHER THE DATA LA,U A1,,X3 RECOVER THE BLOCK POINTER J WRIDIT WRITE THE DATA ON THE TAPE . . . This code writes the @COPY,G file label block to the tape. . gomex dl a4,cghsentl,a1 load @COPY,G sentinel words LA,H2 A3,IOACW,X9 LOCATE SCATTER GATHER BUFFER ds a4,sgtrk,a3 set sentinel in header words LA,U a2,cghqual,a1 GET START OF FILE INFO BUFFER LXI,U A2,28-2 LOAD LENGTH OF FILE ITEM + FILL SA A2,SGAX2,A3 SET UP DATA ACCESS WORD J WRIDIT WRITE THE SENTINEL BLOCK . . INPUT TAPE / OUTPUT MASS STORAGE . GOMER LA A2,IBDATA,A1 LOAD MASS STORAGE ADDRESS SA A2,IODRAD,X9 PUT ADDRESS IN PACKET LA A0,IOFDT,X9 GET FDT ADDRESS SA A2,FDIPLC,A0 PUT DYNAMIC ADDRESS IN PACKET LA,U A2,IBDATA,A1 LOAD ADDRESS OF DATA IN BUFFER LXI A2,IBLEN,A1 LOAD LENGTH READ IN AH A2,(-2,2) BUILD ACCESS WORD SA A2,IOACW,X9 PUT ACCESS WORD IN PACKET LMJ X11,ADRCON CONVERT ADDRESS TO/FROM W.A.D. J WRIDIT WRITE BLOCK TO FILE . . 'D' OPTION HANDLER . DMW LA A0,IBMSAD,A1 LOAD ADDRESS OF INPUT BLOCK SA A0,IODRAD,X9 PUT IN I/O PACKET LA A2,IOFDT,X9 LOAD FDT ADDRESS SA A0,FDIPLC,A2 PUT ADDRESS IN PACKET LMJ X11,ADRCON CONVERT ADDRESS IF REQUIRED J WACWS GO AND SET UP ACCESS WORD . WERROR SA A1,A13 SAVE THE BUFFER ADDRESS TZ IOMASS,X9 MASS STORAGE FILE ? J NOTEOT YES. END OF TAPE STATUS VERY UNLIKELY LA A1,IOSTATUS,X9 LOAD I/O STATUS te,u a1,2 is this end of reel status ? j noteot no. this is a real error la a11,ioacw,x9 yes. load original access word lmj x11,eotwrt write end of reel sentinel j noteot1 error. treat as normal error sa a11,ioacw,x9 done. restore original access word J EOTOK ON NEW REEL. CONTINUE . noteot1 sa a11,ioacw,x9 restore original access word NOTEOT . LMJ X11,IOSEDT EDIT I/O STATUS ZAP . ROADBLOCK THE FILES INVOLVED LA A1,A13 RESTORE BLOCK BUFFER ADDRESS LA A2,IBLAST,A1 LOAD LAST BLOCK FLAG BRELP A1 RELEASE THE BUFFER JNZ A2,ENDWRT TERMINATE IF LAST ONE BISMARCK LA A0,R14 LOAD PROTECT WORK BUFFER ADDRESS TZ A0 IS PROTECT BUFFER ALLOCATED ? BRELP A0 YES. RELEASE IT SNONZ CDCEASE,X8 STOP INPUT PROCESS ON OUTPUT ERROR J SINKI OTHERWISE DISCARD THE BUFFERS . EOTOK LA A1,A13 RESTORE BLOCK BUFFER ADDRESS J EOTDUN TREAT AS NORMAL COMPLETION ON TAPE . . HANDLE ABNORMAL READ STATUS . WABN LA A0,IBSTAT,A1 LOAD STATUS FROM READ TNE,U A0,STERM SOFTWARE TERMINATION ? J WTERM YES. IGNORE THIS BLOCK TE,U A0,1 IS IT EOF ? J ABNNE NO. CHECK OTHER POSSIBLE STATUS VALUES . . EOF ENCOUNTERED. PROCESS ACCORDING TO OPTIONS . JE A14,'G',WTERM TERMINATE IF 'G' OPTION JE A14,'D',WTERM IGNORE FUNNY EOF FROM MASS STORAGE JNE A14,'M',WTERM 'M' OPTION IS ONLY ONE TO COPY EOF . . 'M' OPTION HANDLER . LA,U A0,WEF$ LOAD WRITE EOF FUNCTION SA A0,IOFUNC,X9 SET FUNCTION IN PACKET IOW$ IOPKT,X9 WRITE EOF MARK ON OUTPUT TAPE LA,U A0,W$ RESTORE ORIGINAL FUNCTION SA A0,IOFUNC,X9 PUT IT IN THE PACKET LA,U A0,IOPKT,X9 RESTORE PACKET ADDRESS FOR STATUS CHECK J WRISTK CHECK THE I/O STATUS . . ABNORMAL STATUS ON BLOCK TO BE WRITTEN . ABNNE J WTERM . . WRITE TERMINATION ERROR . WTRMER LMJ X11,IOSEDT EDIT STATUS . ** CHECK EOR, ETC. ** ZAP . WIPE OUT THIS OPERATION J BISMARCK SINK IT . . ADDRESS CONVERSION . ADRCON LA A0,IOWAD,X9 LOAD WAD FLAG OF OUTPUT TNE A0,IOWAD,X10 COMPARE WITH WAD ATTRIBUTE OF INPUT J 0,X11 SAME. NO CONVERSION NEEDED LA A0,IODRAD,X9 LOAD MASS STORAGE ADDRESS LSSL A0,12 SHIFT OFF IRRELEVANT BITS SSL A0,12 RIGHT JUSTIFY TNZ IOWAD,X9 OUTPUT FILE WAD ? J ACWIN NO. INPUT IS WAD FORMAT MSI,U A0,28 CONVERT SECTOR ADDRESS TO WORDS ADRST SA A0,IODRAD,X9 STORE ADDRESS IN PACKET LA A2,IOFDT,X9 LOAD FDT ADDRESS SA A0,FDIPLC,A2 PUT CURRENT ADDRESS FOR STATUS J 0,X11 RETURN TO CALL . ACWIN SA A1,A13 SAVE THE BUFFER ADDRESS DSL A0,36 RIGHT JUSTIFY ADDRESS DI,U A0,28 CONVERT WORDS TO SECTORS LA A1,A13 RESTORE THE BUFFER ADDRESS . ** POSSIBLY CHECK FOR EVEN SECTOR BOUNDS ** J ADRST STORE OUT MODIFIED ADDRESS END