Directory of image this file is from
This file as a plain text file
//// FORTRAN II UNIT I/O ROUTINES / / JOHN VAN ESSEN - FEB 9, 1978 / / 18-OCT-81 JVE CLOSB BUG ZEROED UPPER FOUR BITS / OF LAST WORD IF ODD NUMBER OF WORDS. / 04-DEC-81 JVE ADD CKIO CALL TO CHAIN ROUTINE / / 05-MAY-82 JVE MOVED CHAIN ROUTINE TO SEPARATE FILE SO / REST OF UNITIO CODE NOT NEEDED FOR CHAIN. / //// //// SUBROUTINE CALLS / / CALL OPENI (IUNIT,DNAME,FNAME,EXTEN) / / OPENS EXISTING FILE FOR READ OPERATIONS / BLANKS IN NAMES ARE CONVERTED TO ZEROES / / CALL OPENO (IUNIT,DNAME,FNAME,EXTEN) / / ENTERS TENTATIVE FILE FOR WRITE OPERATIONS / BLANKS IN NAMES ARE CONVERTED TO ZEROES / / CALL RESET (IUNIT,ICODE) / / 'ICODE' INDICATES WHAT OPERATIONS ARE TO / BE ALLOWED ON THE FILE. / / -1 = DELETE LAST FILE OPENED FOR UNIT / 0 = KEEP OLD CONDITIONS / 1 = WRITE ONLY / 2 = READ ONLY / 3 = READ AND WRITE / (THE CURRENT BLOCK IS ALWAYS PRE-READ / INTO THE BUFFER BEFORE ANY WRITES ARE / DONE INTO THE BUFFER. THE BUFFER IS ALWAYS / WRITTEN BACK OUT WHEN IT EXPIRES (REACHES / THE END). PARTIAL WRITES CAN BE ACHIEVED / USING THIS CODE) / / THE BLOCK COUNTERS ARE RESET, SO ACCESS BEGINS / AT THE START OF THE FILE. / / CALL READB (IUNIT,LENTH,FWA) / / READ BINARY WORDS FROM FILE. / / CALL WRITB (IUNIT,LENTH,FWA) / / WRITE BINARY WORDS TO FILE. / / CALL CLOSE (IUNIT) / / CLOSES A FILE IN CHARACTER MODE. / IF THE FILE IS A WRITE-ONLY FILE, AT LEAST 1 / CONTROL Z IS WRITTEN TO THE FILE, AND THE REST / OF THE BUFFER IS PADDED WITH CONTROL Z'S. / IF THE FILE IS WRITE-ENABLED, THE BUFFER IS / WRITTEN TO THE CURRENT BLOCK ON THE FILE. / IF THE FILE IS TENTATIVE, IT IS MADE PERMANENT. / / CALL CLOSB (IUNIT) / / CLOSES A FILE IN BINARY MODE. / IF THE FILE IS A WRITE-ONLY FILE, AND IF BUFFER / IS NEITHER EMPTY OR FULL, IT IS ZERO FILLED. / IF THE FILE IS WRITE-ENABLED, THE BUFFER IS / WRITTEN TO THE CURRENT BLOCK ON THE FILE. / IF THE FILE IS TENTATIVE, IT IS MADE PERMANENT. / / IVAL = IOHST (IUNIT) / / RETURNS STATUS OF UNIT (PTG VALUE). / / -1 = UNIT IS NOT DEFINED OR ALLOCATED. / 0 = NO FILE OPENED ON UNIT, / OR ERROR OCCURRED ON A PREVIOUS OPERATION. / +X = LAST OPERATION WAS O.K. / / POSSIBLE ERRORS / -------- ------ / DEVICE DOES NOT EXIST / CAN'T LOAD HANDLER / FILE NOT FOUND / CAN'T ENTER TENTATIVE FILE / DEVICE I/O ERROR / ATTEMPT TO READ PAST END-OF-FILE / ATTEMPT TO WRITE PAST END-OF-FILE / CAN'T CLOSE TENTATIVE FILE / ATTEMPT TO ACCESS FILE AFTER CLOSE / WITHOUT INTERVENING RESET / INVALID CODE IN RESET CALL / //// ABSYM CDF0 6201 ABSYM CIF0 6202 ABSYM ACPOS1 7301 ABSYM ACPOS2 7305 ABSYM ACPOS3 7325 ABSYM ACPOS4 7307 ABSYM ACNEG1 7340 ABSYM ACNEG2 7344 ABSYM ACNEG3 7346 ABSYM AC2000 7332 ABSYM AC4000 7330 ABSYM AC6000 7333 ///// FIELD 0 LOCATIONS ABSYM X6 16 ABSYM X7 17 ABSYM CDFUS 34 ABSYM UNITNO 115 ABSYM UBASE 116 ABSYM IFLAG 116 ABSYM IPTG 117 ABSYM XUSR 74 ABSYM XREADU 75 ABSYM XWRITU 76 ABSYM UTABLE 77 OPDEF ANDI 0400 OPDEF TADI 1400 OPDEF INCI 2400 OPDEF DCAI 3400 OPDEF JMSI 4400 OPDEF JMPI 5400 ENTRY OPENI ENTRY OPENO ENTRY CLOSE ENTRY CLOSB ENTRY READB ENTRY WRITB ENTRY RESET ENTRY IOHST LAP
OPENI, 0;0 /===> CALL OPENI(IUNIT,DEV,FNAME,EXTEN) JMS SETUP 5117 JMP ERR3 /ERROR RETURN JMS OPENX /SET DEV,FILE,EXT, CALL USR 0002 /USRLKP 4000 /READ-ONLY, EXISTING FILE CH, OPENO, 0;0 /===> CALL OPENO(IUNIT,DEV,FNAME,EXTEN) JMS SETUP 1717 JMP ERR3 /ERROR RETURN JMS OPENX /SET DEV,FILE,EXT, CALL USR 0003 /USRENT 2004 /WRITE-ONLY, USRCLS FOR TENTATIVE FILE CLTEMP, CLOSB, 0;0 /===> CALL CLOSB(IUNIT) JMS SETUP 1717 JMP ERR0 /ERROR RETURN JMP CLOSX CLOSE, 0;0 /===> CALL CLOSE(IUNIT) JMS SETUP 1717 JMP ERR0 /ERROR RETURN TAD (232 /CONTROL Z FILL CLOSX, DCA CH /SAVE FILLER TADI IPTG SNA CLA JMP RTRN /IF PTG=0, FORGET ABOUT CLOSING AC6000 ANDI IFLAG RAL SNA /SKIP IF WRITE=YES JMP CLOS40 /IF NO WRITES, NO CLOSE SZL CLA /SKIP IF WRITE ONLY JMP CLOS30 /NO PADS IF READ AND WRITE ACNEG1 TADI IPTG SNA CLA JMP CLOS35 /JUST OPENED - MUST BE DELETING TAD CH /CHECK TYPE OF FILL SNA CLA JMP CLOS20 /BINARY CLOSE - CHECK BUFFER FIRST CLOS10, TAD CH CIF0 JMS I XWRITU /PAD A CHARACTER JMP PTG0 JMP HARD CLOS20, TAD CH SNA CLA JMS CHPTGS /ADJUST PTG IF BINARY CLOSE CDF0 TADI IPTG /IS BUFFER FULL YET? TAD (-6 /PTG WILL BE 6 IF SO SZA CLA /SKIP IF FULL JMP CLOS10 /PAD SOME MORE CLOS30, TAD (7 DCAI IPTG /SET PTG TO FLUSH CIF0 JMS I XWRITU /FLUSH BUFFER JMP PTG0 JMP HARD CLOS35, CDF0 TADI IFLAG /SAVE R/W BITS DELET1, /ENTRY FROM RESET(IUNIT,-1) FOR DELETES DCA CLTEMP TAD CLTEMP /CHECK CLOSE CODE AND (17 SNA JMP CLOS40 /NO CLOSE - DISABLE FURTHER ACCESS DCAI IFLAG /ONLY ALLOW USR CODE IN IFLAG ACPOS2 /PREPARE TO COMPUTE FINAL FILE SIZE TAD UBASE DCA X7 /UBLKS-1 TAD X7 DCA X6 TADI X6 /SIZE OF HOLE TADI X6 /-SIZE OF REMAINDER DCAI X7 /=SIZE OF FILE CIF0 FOOL1, /TRICK SABR INTO GENERATING A CDF JMS I XUSR /CLOSE TENTATIVE FILE / DELETE OLD FILE JMP PTG0 JMP HARD CLOS40, CDF0 TAD CLTEMP AND (7760 /REMOVE CLOSE CODE DCAI IFLAG TAD (11 JMP PTGX /SET PTG TO O.K., NO MORE OPS PAGE IOER, 5117;0522 /"IOER" OR IPER,IQER,IUER,OOER,OPER,OQER,OUER P, IOHST, 0;0 /===> IVAL = IOHST(IUNIT) JMS SETUP 5117 JMP IOHST1 /UNIT UNDEFINED TADI IPTG /LOAD PTG JMP RTRN /FOR FUNCTION RESULT IOHST1, ACNEG1 RTRN, RETRN IOHST ADDR, READB, 0;0 /===> CALL READB(IUNIT,LENGTH,BUFF) JMS SETUP 5117 JMP ERR2 /ERROR RETURN JMS SETBIO /SET LENTH, FWA READ1, CIF0 JMS I XREADU /READ FROM UNIT JMP PTG0 JMP HARD DCACDF, DCA I ADDR ISZ ADDR NOP /PROTECT SKIP JMP CHKPTG /SKIP 3RD CHAR, CHECK COUNT. CTR, WRITB, 0;0 /===> CALL WRITB(IUNIT,LENGTH,BUFF) JMS SETUP 1717 JMP ERR2 /ERROR RETURN JMS SETBIO /SET LENTH, FWA WRIT1, JMS TADPAR /GET WORD FROM BUFFER CIF0 JMS I XWRITU /WRITE TO FILE JMP PTG0 JMP HARD CHKPTG, CDF0 TADI IPTG TAD (-5 SNA INCI IPTG /IF WAS PTG5, BUMP TO PTG6 IAC SZA CLA JMP CHKPX ACPOS2 /IF WAS PTG4, SET TO PTG2 DCAI IPTG JMP CHKPX CHPTGS, 0 /CALLED FROM CLOSE/CLOSB TAD CHPTGS DCA SETBIO DCA CTR JMP CHKPTG SETBIO, 0 /SET LENTH, FWA FOR BINARY I/O TADI IPTG /CHECK STATUS SNA CLA /SKIP IF ACTIVE JMP SOFT /ERROR - NOT ACTIVE JMS SETPAR /MOVE TO LENTH JMS TADPAR CMA DCA CTR JMS SETPAR /SET UP FOR BUFFER ADDRESS TAD TADCDF DCA DCACDF CHKPX, ISZ CTR JMPI SETBIO /RETURN FOR MORE CHARACTERS JMP RTRN /EXIT IF DONE SETUP, 0 /SET COMMON RETURN, VALIDATE UNIT PARAM /DATA FIELD = 0 AT ALL RETURNS ACNEG3 TAD SETUP DCA PTR TADI SETUP /INIT ERROR MESSAGE DCA IOER INC SETUP TADI PTR DCA P INC PTR TADI PTR DCA P# TAD P DCA SETCDF JMS SETPAR JMS TADPAR /UNIT PARAMETER DCA UNITNO TAD UTABLE /GET BASE OF UNIT TABLE TAD UNITNO DCA UBASE CDF0 TADI UBASE SNA JMPI SETUP /ERROR RETURN IF UNIT NOT DEFINED DCA UBASE /UBASE IS BASE OF PACKET ACPOS1 TAD UBASE DCA IPTG TAD UNITNO SMA SZA /1-8 IS VALID TAD (3767 SPA SNA CLA JMPI SETUP /ERROR RETURN FOR INVALID UNIT INC SETUP JMPI SETUP /NORMAL RETURN PTR, SETPAR, 0 /SET NEXT PARAMETER SETCDF, HLT TADI P# DCA TADCDF INC P# TADI P# DCA ADDR INC P# SETXIT, JMP I SETPAR TADPAR, 0 /GET NEXT WORD OF PARAMETER TADCDF, TAD I ADDR FOOL3, ISZ ADDR NOP /PROTECT SKIPS JMP I TADPAR PAGE
MOVPAR, 0 /MOVE PARAMETER, ZERO OUT BLANKS DCA MOVCTR JMS SETPAR MOV10, JMS TADPAR DCA MOVTMP TAD MOVTMP AND (3737 /GET BOTTOM 5 BITS OF CHARS TAD (3737 /TOP BIT IS SET IF BOTTOM NOT 0 AND (4040 /ISOLATE TOP BITS TAD (3737 /FILL IN REMAINDER OF CHAR MASK AND MOVTMP /CHANGE ANY 40'S TO 00'S CDF0 DCAI X7 ISZ MOVCTR JMP MOV10 MOVXIT, JMP I MOVPAR UFBAM1, 2 /OFFSET-1 TO BLOCK COUNTS MOVCTR, RESET, 0 /===> CALL RESET(IUNIT,ICODE) MOVTMP, 0 JMS SETUP 5117 JMP RESETX /ERROR RETURN JMS SETPAR CDF0 AC6000 /LEAVE THINGS ALONE IF R/W NOT ENABLED ANDI IFLAG SNA CLA JMP PTG0 /FORGET IT JMS TADPAR /LOAD CODE CDF0 SNA JMP RESET1 /JMP IF TO LEAVE FLAGS ALONE SPA JMP DELET /POSSIBLE DELETE AND (3 /KEEP ONLY LOWER BITS CLL RTR /SHIFT TO UPPER TWO BITS RAR DCA RESET /SAVE IN TEMP TADI IFLAG AND (1777 /OPEN HOLE TAD RESET /INSERT NEW READ/WRITE FLAGS RESET5, CDF0 DCAI IFLAG RESET1, TAD UFBAM1 TAD IFLAG /ADDRESS-1 OF BLOCK COUNTS DCA X7 TADI X7 /LOAD +BLKS CIA DCAI X7 /RESET UBLREM PTG1, ACPOS1 /AND SET PTG TO 1 TO START I/O. PTGX, PTG0, CDF0 DCAI IPTG JMP RTRN RESETX, JMS SETPAR /SKIP CODE PARA TAD (2225 /"RUER" JMP EREXIT DELET, IAC SZA CLA JMP RESETX /LESS THAN -1? WHAT'S HE DOING? TAD UFBAM1 TAD IFLAG /ADDRESS-1 OF BLOCK COUNTS DCA X7 DCAI X7 /OBLITERATE BLOCK COUNTS DCAI X7 ACPOS4 /IFLAG VALUE - USR CLOSE CODE JMP DELET1 /JUMP INTO CLOSE CODE SOFT, AC4000 AND IOER /GET READ BIT SNA CLL CML RTR /IF NOT READ, SET WRITE BIT CDF0 ANDI IFLAG /TEST R/W BITS SNA CLA JMP OER /WAS NOT OPEN ERROR JMP QER ERR3, JMS SETPAR /SKIP 3 PARAMETERS ERR2, JMS SETPAR /SKIP 2 PARAMETERS ERR1, JMS SETPAR /SKIP 1 PARAMETER ERR0, UER, TAD (4 QER, IAC HARD, IAC OER, TAD IOER AND (3777 /GET RID OF READ/WRITE BIT EREXIT, DCA IOER ERCALL, CALL 1,ERROR ARG IOER HLT /JUST IN CASE UHPARM, 11 /OFFSET TO DEVICE NAME-1 IN UPP OPENX, 0 /SET DEVICE, FILENAME, EXTENSION TAD UBASE TAD UHPARM DCA X7 /SET ADDR-1 OF DEVICE NAME ACNEG2 /TWO WORDS OF DEVICE JMS MOVPAR ACNEG3 /THREE WORDS OF FILE NAME JMS MOVPAR ACNEG1 /ONE WORD OF EXTENSION JMS MOVPAR TAD I OPENX /LOAD USR CALL CODE CDF0 DCAI IFLAG /SET INTO UPP FLAG WORD CIF0 FOOL2, JMS I XUSR /CALL USR TO LOOKUP OR ENTER JMP PTG0 JMP HARD INC OPENX /BUMP TO FLAG VALUE TAD I OPENX /LOAD JMP RESET5 PAGE END