.
. 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