/ WPCRE - CREATE A FILE / 021 EMcD 12-Apr-85 Allow dead seq in file name create / 020 WCE 11-JUL-83 PROVIDE FOR DOCUMENT NAMES ABOVE 999 / 019 WCE 23-JUN-83 ADD GET-DENSITY CHECK TO CUPCSZ ROUTINE / 018 HLP 18-APR-83 MOVE CUBS TO END OF MODULE FOR WPCUT / 017 HLP 15-DEC-82 CONDITIONALIZE SO QUBLK FOR WPCUT / 016 GJP 14-DEC-82 CHANGE CHECK FOR BAD HOME BLOCK / TO CHECK FOR ALLOC BLOCK INSTEAD / OF COS 310 COUNT / 015 GJP 11-NOV-82 REMOVED FIX #9, MAINTAIN INDEX ORDER / 014 GJP 08-OCT-82 FIX CREATE 201 DOCS BUG / 013 GJP 04-OCT-82 ADDED CHECK FOR BAD HOME BLOCK / 0012 SBB 22-JUN-82 KEEP ANGLE BRACKETS OUT OF FILENAMES / 011 GDH 30-MAR-82 (ANOTHER) BUG FIX FOR 0009. ALLOW > / 4096 CHARS IN INDEX FILE. / 0010 GDH 10-MAR-82 BUG FIX FOR 0009 (DONT CNT NULLS). / 0009 GDH 23-FEB-82 ADDED CODE TO MAINTAIN INDEX ORDER / (AT LEAST FOR LISTING PURPOSES) / FOR CPYFIL. / 0008 GDH 08-FEB-82 ADDED "READ ERROR DETECTION". / 0007 GDH 13-OCT-81 REMOVED INDEX UNLOCK (CAUSE IT'S / NOW NEVER LOCKED!) / 0006 AJF 06-OCT-81 REMOVE DOC LOCK ON CREATE / 0005 GDH 26-AUG-81 WPFILS CALLING SEQ CHANGES. / 0004 TT 07-JUL-81 REMOVED SUPERFLUOUS CONDITIONALS / 0003 AJF 02-FEB-81 CONDITIONALIZED FOR WPSTPR, SORT/PARSR / 0002 DM,JM 15-SEPT-80 MERGED SCANDI AND EUROPE/ENGLISH / 0001 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 3XX EPS 14-AUG-79 CHANGES FOR FOREIGN LANGUAGES / III.D KEE 29-MAR-78 CHANGES FOR WT78 FILE NUMBER / REPRESENTATION IN PARTICULAR, / HAVE MENU DO ANY CREATE /ADRCRT - THIS SUBROUTINE OVERSEES THE CREATION OF A DOCUMENT, /INCLUDING ANY ENTRY INTO THE INDEX DOCUMENT. /TO CALL FROM ANOTHER FIELD - /CDFMYF /CDFBUF (MUST BE RUN IN BUFFER FIELD) /JMS I (ADRCRT (SHOULD BE A LOCATION WITH THE ADDRESS OF THIS CREATE /IN THE FIELD THAT THE CALL IS MADE FROM) /ERROR (IN CASE OR ERROR, CONTROL RETURNS HERE) /NORMAL /TO CALL FROM BUFFER FIELD - /JMS ADRCRT /ERROR (ERROR RETURN) /NORMAL /UPON ENTRY - /AC IRRELEVANT /MENU AREA ARRAY 'FNAMSP' CONTAINS THE ASCII DOCUMENT NAME OR NUMBER, /ONE CHARACTER PER WORD, ENDING WITH A ZERO /MENU AREA 'MNDRV' CONTAINS THE DRIVE NUMBER /FOR MULTI-TERMINAL 8 SYSTEMS, THE DRIVE INDEX DOCUMENT HAS BEEN /LOCKED (EVEN IF NO DOCUMENT 1, IT HAS BEEN LOCKED ANYWAY - /THIS ENSURES THAT ONLY ONE CREATE AT A TIME HAPPENS ON A GIVEN DRIVE) /** THERE IS NO CURRENT 'RDFIL' ACTIVITY ** /NORMAL RETURN - /THE DOCUMENT HAS BEEN CREATED AND ANY INDEX ENTRY MADE /AC, 'CUPFNO' = FILE NUMBER OF CREATED DOCUMENT (WITH DRIVE NUMBER IN /BITS 0-3) /ERROR RETURN - /AC = 0, 'CUPFNO' = 0 /WHEN ASSEMBLED WITH 'ADRASM' DEFINED, ERROR MESSAGES HAVE DISPLAYED /OTHERWISE, NO USER DISPLAYS HAVE BEEN DONE /IN EITHER CASE - /T1, T2 HAVE BEEN CLOBBERED /FOR MULTI TERMINAL 8 SYSTEMS, ALL DOCUMENTS HAVE BEEN UNLOCKED /THE 'RDFIL' BUFFER HAS BEEN CLOBBERED /TO ACCOMPLISH THIS, THE FOLLOWING STEPS ARE TAKEN - /IF A FLOPPY CREATE, ENSURE THAT THERE IS ENOUGH ROOM. /IF CREATE BY NUMBER, VALIDATE THE NUMBER AND CREATE THE DOCUMENT /IF BY NAME, FIND THE FIRST UNUSED DOCUMENT NUMBER, CREATE A DOCUMENT /WITH THAT NUMBER, IF NECESSARY, CREATE DOCUMENT 1 (THE INDEX DOCUMENT), /AND THEN ADD THE NAME TO THE INDEX DOCUMENT. /THE DOCUMENT NUMBER THAT WAS CREATED IS RETURNED IN THE AC /**** NOTES TO THOSE WHO CHANGE THIS CODE: /AN ATTEMPT WAS MADE TO KEEP THE BULK OF THE UNUSED SPACE ON THE FIRST /PAGE SO THAT IT CAN BE USED BY THE MAIN ROUTINE. OTHER PROGRAMS /USE THIS SPACE. /THERE IS 1 FUNNY ASSEMBLY OPTION SPECIFIC TO THIS ROUTINE /(AS OPPOSED TO SYSTEM-WIDE) /ADRASM WHEN DEFINED, NO ERROR MESSAGES ARE DISPLAYED AFTER AN ERROR. CIFSCR= CIFMNU /FIELD WHERE THE VERSION OF SCROLL USED /BY CREATE LIVES CUPFNM= 7400 /USE RDFIL BUFFER FOR THIS SCRATCH AREA CUPBF0= CUPFNM+STRLEN /START OF SCRATCH AREA FOR NUMBER CONVERSION /FIRST WORD CONTAINS NEG LENGTH OF THE AREA CUPBUF= CUPBF0+1 /THE REST. /MUST BE STRLEN AVAILABLE WORDS AFTER THIS CUPEND= CUPBUF+STRLEN /THE LAST LOCATION OF THE SCRATCH AREA ADRCRT, XX CLA RDF TAD CIDF0 /MAKE CROSS FIELD CALLABLE DCA ADRCX2 CDFMNU /GET THE MENU CONSTANTS FOR THE CREATE TAD I (FNAMSP) /LOCATION OF NAME DCA CUPFNS AC7777 /ADR WILL BE USED BY INDEX REGISTER /A012 TAD CUPFNS /GET POINTER AGAIN /A012 JMS BRKTST /TEST FOR ANGLE BRACKETS IN FILENAME /A012 TAD I (MUBUF+MNDRV) CDFMYF DCA CUPDRV TAD CUPDRV BSW RTL CLL /BUILD DRIVE NUMBER WITH INDEX DOC NUMBER IAC DCA CUPD1 JMS CUPCSZ /SEE IF ROOM JMS CUPERR /M020 JMS CUCOPY CUPFNS, 0 CDFMNU CUPFNM CDFMYF STRLEN TAD (CUPFNM) /INITALIZE THE POINTER DCA T1 TAD (-STRLEN) /SET UP LENGTH OF NUMBER SCRATCH AREA /M020 DCA CUPBF0 CIFMNU JMS I NXACAL T1 CUPBUF-1 JMS CUPERR /M020 CIFMNU JMS I CVDCAL /SEE IF THE TOKEN IS A FILE NUMBER CUPBUF JMP CUPNAM /IF NOT TRY A NAME DCA CUPFNO /ELSE IT IS A DOCUMENT NUMBER TAD CUPFNO SNA /ZERO FILE NUMBER? JMP CUPOOR /YES, ERROR. CLL /MAKE SURE THAT LINK IS CLEAR /A020 TAD (-1750) /CHECK FOR A NUMBER LARGER THAN 999 /A020 SZL CLA /LINK WILL BE CLEAR IF NUMBER IN RANGE /A020 JMP CUPNAM /USE LARGE NUMBER AS DOCUMENT NAME /A020 TAD CUPFNO /NOW CHECK FOR 201-999 RANGE /A020 TAD (-MAXDOC) SMA CLA /GREATER THAN MAX? JMP CUPOOR /YES, ERROR. ADRCNT, JMS CUPMFN /PLACE FILE NUMBER IN AC AND 'CUPFNO'. /A020 JMS CUPCRF /CREATE THE FILE /A020 JMS CUPERR /ERROR /A020 /NORMAL RETURN. /A020 ADRCRX, ISZ ADRCRT /A020 ADRCR2, /A020 ADRXXX, CLA /A020 TAD CUPFNO /PICK UP RETURN PARAMETER /A020 ADRCX2, XX /A020 JMP I ADRCRT /A020 /ERROR ENCOUNTERED - ISSUE MESSAGE AND RETURN CUPERR, XX /SAVE WHERE ERROR DETECTED /A020 AC7776 /GENERAL UNABLE TO CREATE MESSAGE /M020 CUPOON, IAC /TOO MANY DOCUMENTS CUPOOR, IAC /CREATE BY NUMBER OUT OF RANGE IFNDEF ADRASM < CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF CIFMNU JMS I MNUCAL DLMPP2 > /END IFNDEF ADRASM IFDEF ADRASM < /A003 IFZERO ADRASM < /A003 CDFMYF /A012 DCA ERSTAT /STORE ERROR TYPE IN VARIABLE FOR WPSTP /A003 JMP ADRCR2 /EXIT /A003 >> /END IFDEF ADRSAM ZERO DEFINED BY WPSTPR /A003 CLA DCA CUPFNO JMP ADRCR2 CUPDRV, 0 CUPFNO, 0 /FILE NUMBER FOR DOCUMENT (W/DRIVE NUMBER SET) CUPD1, 0 /FILE NUMBER FOR INDEX DOCUMENT (W/DRIVE NUMBER) /CUPMFN - MAKE FILE NAME FROM DOCUMENT NUMBER AND DRIVE NUMBER /UPON ENTRY - /AC ZERO /CUPFNO CONTAINS DOCUMENT NUMBER /CUPDRV CONTAINS DRIVE NUMBER /TO CALL - /JMS CUPMFN /WHEN DONE - /AC CONTAINS FILE NUMBER /CURFNO CONTAINS FILE NUMBER CUPMFN, XX TAD CUPDRV /MAKE CORRECT SIGN BSW RTL CLL TAD CUPFNO DCA CUPFNO TAD CUPFNO JMP I CUPMFN IFDEF GERSTLE < /A015 IFDEF CPYFIL < /A011 CUPCPY, XX /ROUTINE TO INDEX INTO INDEX FILE /A011 DCA CUPSC2 /USE THIS TEMP. /A009 CUPSH3, JMS CUPSHG /GET A CHARACTER. /A009 SNA /SKIP IF NOT E-O-F. /A009 JMP CUPSH4 /WE SHOULDN'T EVER GET HERE, BUT... /A009 CIFFIO FILEIO XPUTST /COPY CHAR BACK OUT. /A009 ISZ CUPSC2 /1 LESS CHAR TO COPY OUT. /A009 JMP CUPSH3 /DO ANOTHER ONE (UNLESS DONE). /A009 CLA /RETURN CLEAN AC. /A011 JMP I CUPCPY /RETURN TO CALLER. /A011 CUPSC2, 0 /TEMP /A011 > /END IFDEF CPYFIL /A011 > /END IFDEF GERSTLE /A015 IFDEF GERSTLE < /A015 IFDEF CPYFIL < /**** WARNING **** BRKTST IS DUPLICATED HERE /AND AFTER CUCOPY BECAUSE CPYFIL HAS ROOM /HERE AND OTHER MODULES HAVE ROOM THERE /A012 BRKTST, XX /TEST FOR ANGLE BRACKETS /A012 DCA X0 /ENTERED WITH ADR IN AC /A012 BRKRPT, TAD I X0 /GET A CHAR FROM FILENAME /A012 SNA /A ZERO WORD TERMINATES STRNG /A012 JMP I BRKTST /EXIT /A012 TAD (-76 /COMPLIMENT OF RIGHT ANGLE /A012 SNA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 IAC /TEST FOR LEFT ANGLE BRACKET ALSO /A012 IAC /A012 SNA CLA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 JMP BRKRPT /KEEP LOOKING TILL DONE /A012 > /END IFDEF CPYFIL /A012 > /END IFDEF GERSTLE /A015 /A020 - QUEUE BLOCK MOVED HERE FOR SPACE REASONS IFNDEF WPCUT < /A017 QUBLK, DSKQUE 0 0 QUQBLK, 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 /RXSEC SECTOR > /END IFNDEF WPCUT X=. /FIRST FREE LOCATION ON THIS PAGE /A019 /-------------------- PAGE CUPNAM, CLA /GET A FREE NUMBER TAD (RXBDIR) /DIR BLOCK DCA QUQBLK+RXQBLK TAD (RXERD+4000 DCA QUQBLK+RXQFNC TAD (CUB1 DCA QUQBLK+RXQBAD JMS QURX /GET DIR BLOCK INTO MEMORY /(BUF FIELD AND ADDRESS ALREADY IN /Q-BLK FROM 'CUPCSZ') SPA CLA JMS CUPERR /ERROR IN DISK /M020 TAD CUB1+6 /GET ALLOC FROM BLOCK JUST READ /C016 JMS CKHMBL /GO MAKE SURE THE BLOCK IS A HOME BLOCK /A013 TAD CUB1+11 /GET MAX NUMBER OF FILES DCA T2 /SAVE AS NEGATIVE MAX TAD (CUB1+13 /GET ADDR OF FIRST ONE DCA T1 /SAVE DCA CUPFNO /INIT COUNT WHICH WILL GIVE US NUMBER ISZ T2 /START WITH SECOND DOC (NOT INDEX DOC) /A014 CUPGF1, ISZ CUPFNO /INCR COUNT TAD I T1 /GET FIRST BLOCK PTR SNA CLA JMP CUPGTN /ZERO - GOT A FREE ONE ISZ T1 /NEXT WORD ISZ T2 /ANY MORE? JMP CUPGF1 /YES JMP CUPOON /OUT OF NUMBERS CUPGTN, ISZ CUPFNO JMS CUPMFN /MAKE FILE NAME, LEAVE IT IN AC JMS CUPCRF /CREATE THE FILE JMS CUPERR /COULDN'T /M020 CUPL1A, TAD CUPD1 /OPEN INDEX (AC ZERO AT THIS POINT) MQL CIFFIO FILEIO XDSKIN /OPEN FOR UPDATE SNA CLA JMP CUPSH1 /GOT IT - SKIP OVER HEADER, RULER, STUFF TAD CUPD1 JMS CUPCRF JMS CUPERR /M020 JMP CUPL1A CUPSH1, JMS CUPSH2 /GET OVER THE RULERS AND OTHER JUNK IFDEF GERSTLE < /A015 IFDEF CPYFIL < /A011 TAD CUPCHI /SEE IF ANY HI PRECISION COPY TO BE DON /A011 SNA JMP CUPSH6 /JMP IF NO. CHECK LO PRECISION PART. /A011 CIA DCA CUPSC1 /SAVE TEMP COUNTER. /A011 CUPSH5, JMS CUPCPY /DO 4096 COPIES. /A011 ISZ CUPSC1 /SEE IF DONE YET. /A011 JMP CUPSH5 /JMP IF NOT YET. /A011 CUPSH6, TAD CUPCLO /GET # OF CHARS TO BE BOPPED OVER. /A009 SNA /SKIP IF WE'VE GOT SOME TO DO. /A009 JMP CUPSH4 /JMP IF THIS IS THE 1ST TIME THRU. /A009 CIA /MAKE A NEGATIVE COUNT. /A009 JMS CUPCPY /INDEX INTO INDEX FILE. /M011 CUPSH4, /HERE WHEN POSITIONED TO AFTER LAST /A009 /ENTERED FILE NAME. /A009 > /LIFYPC FEDFI /A011 > /END IFDEF GERSTLE /A015 TAD CUPFNO /ISOLATE DRIVE AND FILE NUMBERS FOR MESSAGE AND P377 DCA CUPSC1 CIFMNU JMS I IOACAL /OUTPUT NUMBER AND STUFF CUPOTD /TO DOCUMENT CUPOST CUPOS1 CUPFNM CUPOS3 CUPSC1, 0 CUPOS3 CUPCL1, /COPY REST OF FILE JMS CUPSHG /GET CHAR (& CHECK FOR ERR) /M0009 SNA JMP CUPCLS /DONE CIFFIO FILEIO XPUTST JMP CUPCL1 CUPCLS, CIFFIO FILEIO XDSKCL /CLOSE INDEX JMP ADRCRX IFDEF GERSTLE < /A015 IFDEF CPYFIL < /A011 CUPCHI, 0 /DOUBLE PRECISION COUNT (HI WORD) OF # /A011 /OF CHARS INTO INDEX OF LAST ENTERED /A011 /FILENAME. /A011 CUPCLO, 0 /COUNT OF CHARS INTO INDEX OF LAST ENTERED /FILE NAME (LO WORD). /A009 > /LIFYPC FEDFI /A011 > /END IFDEF GERSTLE /A015 /CUCOPY - ROUTINE TO COPY BLOCK OF MEMORY /JMS CUCOPY /ADDR OF FROM /CDF FROM FIELD /ADDR OF TO /CDF TO FIELD /NUMBER OF WORDS TO COPY /RETURN, AC = 0 CUCOPY, XX AC7777 /GET FIRST ADDR - 1 FOR INDEX REGISTER TAD I CUCOPY ISZ CUCOPY DCA X0 TAD I CUCOPY /AND FIELD ISZ CUCOPY DCA CUCPY0 /SAVE FOR LATER USE AC7777 /DO SAME FOR TO VALUES TAD I CUCOPY ISZ CUCOPY DCA X1 TAD I CUCOPY ISZ CUCOPY DCA CUCPY1 TAD I CUCOPY ISZ CUCOPY /GET COUNT CIA /MAKE ISZ COUNT DCA CUCPYC /AND SAVE FOR USE CUCPYL, CUCPY0, .-. /A CDF FOR FIRST FIELD TAD I X0 /GET WORD CUCPY1, .-. /A CDF FOR THE RECEIVING FIELD DCA I X1 /STORE WORD ISZ CUCPYC /DONE? JMP CUCPYL /NO - DO NEXT WORD CDFMYF /YES - BACK TO OUR FIELD JMP I CUCOPY /RETURN TO CALLER CUCPYC, 0 IFNDEF CPYFIL < /****WARNING** WOULD OVERFLOW PAGE. SEE CUPSC2+1 /A012 /TO DUPLICATE ANY CHANGES HERE /A012 BRKTST, XX /TEST FOR ANGLE BRACKETS /A012 DCA X0 /ENTERED WITH ADR IN AC /A012 BRKRPT, TAD I X0 /GET A CHAR FROM FILENAME /A012 SNA /A ZERO WORD TERMINATES STRNG /A012 JMP I BRKTST /EXIT /A012 TAD (-76 /COMPLIMENT OF RIGHT ANGLE /A012 SNA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 IAC /TEST FOR LEFT ANGLE BRACKET ALSO /A012 IAC /A012 SNA CLA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 JMP BRKRPT /KEEP LOOKING TILL DONE /A012 > /END IFNDEF CPYFIL /A012 IFNDEF GERSTLE < /A015 IFDEF CPYFIL < /A015 BRKTST, XX /TEST FOR ANGLE BRACKETS /A012 DCA X0 /ENTERED WITH ADR IN AC /A012 BRKRPT, TAD I X0 /GET A CHAR FROM FILENAME /A012 SNA /A ZERO WORD TERMINATES STRNG /A012 JMP I BRKTST /EXIT /A012 TAD (-76 /COMPLIMENT OF RIGHT ANGLE /A012 SNA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 IAC /TEST FOR LEFT ANGLE BRACKET ALSO /A012 IAC /A012 SNA CLA /SKIP IF IT'S NOT AN ANGLE /A012 JMS CUPERR /GENERAL ERROR EXIT /M020 JMP BRKRPT /KEEP LOOKING TILL DONE /A012 > /END IFDEF CPYFIL /A015 > /END IFNDEF GERSTLE /A015 X=. /FIRST FREE LOCATION ON THIS PAGE /A019 /-------------------- PAGE CUPCSZ, XX /CHECK DRIVE DENSITY & FREE SPACE ROUTINE CLA TAD CUPDRV JMS CUPDRS /SET THE DRIVE TAD (4000+RXEDN) /GET DENSITY OF DISKETTE /A019 DCA QUQBLK+RXQFNC /STORE COMMAND IN Q-BLOCK /A019 JMS QURX /GO DO THE COMMAND /A019 SPA CLA /AC WILL BE NEGATIVE ON ERROR /A019 JMP CUPCSE /GO REPORT "UNABLE TO CREATE" ERROR /A019 TAD (4000+RXESP) /GET SPACE LEFT ON DISKETTE DCA QUQBLK+RXQFNC JMS QURX SPA CLA JMP CUPCSE /ERROR TAD (-10 /NEED AT LEAST 8 TAD QUQBLK+RXQSPC SMA CLA /ENOUGH ROOM? ISZ CUPCSZ /YES, SKIP ERROR RETURN FROM SUBROUTINE. CUPCSE, JMP I CUPCSZ /DONE - ALL OKAY /CUPDRS -- SET CORRECT DRIVE FOR RXHAN CUPDRS, XX AND (17) DCA QUQBLK+RXQDRV RDF TAD CDF0 DCA QUQBLK+RXQBFD JMP I CUPDRS CUPOTD, XX MQL RDF TAD CIDF0 DCA CUPODR MQA CDFMYF SNA /SKIP IF LEGIMATE CHAR. /A010 JMP CUPODR /IF NULL THEN DON'T OUTPUT IT. /A010 CIFFIO FILEIO XPUTST IFDEF GERSTLE < /A015 IFDEF CPYFIL < /ENABLE INDEX ORDER ONLY FOR CPYFIL /A009 ISZ CUPCLO /KEEP TRACK WHERE END OF FILENAME IS /A009 SKP /SKIP IF NO OVERFLOW. /A011 ISZ CUPCHI /ACCOUNT FOR IDIOTS WHO DO MORE THAN /A011 /4096 CHARS OF FILE NAMES /A011 NOP /(SHOULDN'T NEED THIS BUT IT'S HERE /A011 /FOR SAFTEY'S SAKE). /A011 > /LIFYPC FEDFI /A009 > /END IFDEF GERSTLE /A015 CUPODR, 0 JMP I CUPOTD /A020 - CKHMBL ROUTINE MOVED HERE FOR SPACE REASONS /*********************************************************************** /THIS CODE WILL CHECK TO SEE IF THE BLOCK AT CUB1 JUST READ IS /A013 /A HOME BLOCK. IF NOT A HOME BLOCK, IT RETURNS AND ERROR. /A013 /*********************************************************************** CKHMBL, XX /A013 TAD (7401) /CHECK FOR ALLOC BLOCK /C01 /A013 SZA CLA /IF COSCNT, THEN ITS OK /A013 JMS CUPERR /NOT A HOME BLOCK /M020 TAD CUB1+1 /GET HOME BLOCK ID /A013 AND (6077) /STRIP OFF VERSION NBR /A013 CIA /SET FOR COMPARE /A013 TAD (30) /HOME BLOCK CODE /A013 SZA CLA /A013 JMS CUPERR /NOT A HOME BLOCK /M020 JMP I CKHMBL /ITS A HOME BLOCK (I HOPE!!!!!!) /A013 /CUPCRF - CREATE FILE SUBROUTINE /TAD FILENO (WITH DRIVE NUMBER IN BITS 0-3) /JMS CUPCRF /ERROR RETURN /NORMAL RETURN /UPON RETURN, AC IS ZERO. CUPCRF, XX DCA CUPCRN /SAVE FILENO TAD CUPCRN AND P377 DCA QUQBLK+RXQFNO /SAVE IN QUEUE BLOCK TAD CUPCRN BSW RTR JMS CUPDRS /SET DRIVE TAD (RXEAL /ALLOC A BLOCK FOR THE HEADER DCA QUQBLK+RXQFNC JMS QURX CLA CDFSYS /GET TIME INFO TAD I (PAKDAT) CDFMYF DCA CUPCRB+6 CDFSYS TAD I (YEAR) CDFMYF DCA CUPCRB+7 TAD QUQBLK+RXQFNO /SET FILE NUMBER INFO DCA CUPCRB+13 TAD (RXEWT+2000 /WRITE OUT HEADER BLOCK DCA QUQBLK+RXQFNC TAD (CUPCRB) DCA QUQBLK+RXQBAD JMS QURX CLA TAD (RXESF /SET AS FIRST BLOCK OF FILE DCA QUQBLK+RXQFNC JMS QURX CLA ISZ CUPCRF JMP I CUPCRF /RETURN OK CUPCRN, 0 /QURX - QUEUE TO RXHAN QURX, XX CIFSYS ENQUE QUBLK QURX1, CIFSYS JWAIT CLA TAD QUQBLK+RXQCOD SNA JMP QURX1 JMP I QURX X=. /FIRST FREE LOCATION ON THIS PAG /A019 /-------------------- PAGE CUPSH2, XX /SKIP OVER INITIALIZATION STUFF /IN INDEX DOCUMENT (LIKE INITIAL RULER, /ANY PRINT CONTROLS, ETC.) CUPSHD, JMS CUPSHG /GET CHAR /M008 TAD (-16 /RULER START? SNA JMP CUPSRL /YES TAD (16-1014 /PRINTER COMMAND? SNA JMP CUPSPC /YES TAD (1014 /GET IT BACK CIFFIO FILEIO XPUTET /PUT IT BACK JMP I CUPSH2 /DONE CUPSR1, IAC CUPSRL, TAD (16 /SKIP RULER - OUTPUT TO STX CIFFIO FILEIO XPUTST JMS CUPSHG /GET ANOTHER CHARACTER. /M008 SNA JMP CUPDRL /DONE (EOF) TAD (-17 SZA JMP CUPSR1 /END OF RULER CUPDRL, TAD (17) CIFFIO FILEIO XPUTST JMP CUPSHD /TRY SOME MORE CUPSP1, TAD (400 CUPSPC, TAD (1014 /SKIP OVER PRINTER CONTROL CIFFIO FILEIO XPUTST JMS CUPSHG /GET ANOTHER CHARACTER /M008 SNA JMP CUPDPC TAD (-1414 SZA JMP CUPSP1 CUPDPC, TAD (1414 CIFFIO FILEIO XPUTST JMP CUPSHD CUPSHG, XX /RETURN ADDRESS. /A008 CIFFIO FILEIO XGETET /GET A CHARACTER. /A008 SMA /SKIP IF "READ ERROR". /A008 JMP I CUPSHG /RETURN CHAR TO CALLER. /A008 CUPER1, CIFFIO FILEIO XDSKCL /CLOSE FILE /M012 JMS CUPERR /REPORT "READ ERROR" TO CALLER. /M020 CUPCRB, COSCNT 0010 /FLAGS 0 0 /HEADER EXTENTIONS 50 /COUNT OF INFO WORDS 0 /COUNT OF BLOCKS IN FILE 0 0 /CREATE DAY,,MONTH;YEAR 0 0 /MODIFIED DAY,,MONTH;YEAR 0 /TIMES EDITED 0 /FILE NUMBER ZBLOCK 40 /OTHER INFO 0 /ZERO'TH PTR 0 /LAST PTR TMPA=. *CUPCRB+21 IFDEF FRENCH <0101> IFDEF DUTCH <0201> IFDEF ENGCAN <0301> IFDEF CANADA <0301> IFDEF GERMAN <0401> IFDEF NORWAY <0501> IFDEF SWEDSH <0601> IFDEF DANISH <0701> *TMPA /STRINGS FOR INDEX DOCUMENT ENTRIES CUPOST, TEXT '^AN>^B^A#>^D^A>' / Use ^B to output dead string /M021 /BRACKETS - IT SERVES NO OTHER FUNCTION CUPOS1, 12 7 74 0 CUPOS3, 74 0 X=. /FIRST FREE LOCATION ON THIS PAGE /A019 /-------------------- PAGE IFDEF WPCUT < /A018 CUB1=. /THIS BUFFER DOES NOT CLOBBER SCROLL /A018 CUB2=.+400 /BUT THIS BUFFER CANNOT BE USED AT /A018 /THE SAME TIME AS SCROLL /A018 > /A018 X=. /REMEMBER ASSEMBLY POINTER /A020 *CUPFNM /USE RDFIL BUFFER FOR SCRATCH AREA /A020 CUPFNM, ZBLOCK STRLEN /BUFFER TO HOLD THE FILE NAME STRING /A020 CUPBF0, -STRLEN /SCRATCH AREA FOR NUMBER CONVERSION - /A020 /FIRST WORD HAS NEG LENGTH OF THE AREA /A020 CUPBUF, ZBLOCK STRLEN /AVAILABLE SPACE MUST BE STRLEN WORDS /A020 CUPEND, 0 /THE LAST LOCATION OF SCRATCH AREA /A020 *X /RESET POINTER FOR OTHER MODULES /A020