/ FILE: LOAD01.PA / / ** -0- ** BOOTSTRAP WRITE-OUT ROUTINE. **** / / ********* EDIT HISTORY ******** / /008 WJY 06-FEB-84 DECmate I compatability /007 WCE 05-SEP-83 Added WINNIE conditional to correct load / problem with new WPSYSA module. /006 WCE 03-SEP-83 Change RZ IOT's to standard RX IOT's /005 WCE 20-JUL-83 Remove occurances of RETURN as an instruction /004 DFB 01-FEB-82 Reset interleave for dd to 3 /003 DFB 28-JAN-82 Set interleave for dd to 2 /002 DFB 14-DEC-81 Comment only for LDSTRT address / AFTER ANY ASSEMBLY--PLEASE NOTE FOLLOWING / LDSTRT should be equal to wpaddr / else change labels in RXPRDF. /001 DFB 10-NOV-81 INSTALL. / ** -0- ** LOCAL SYMBOLIC DEFINITIONS **** /--------------------------------------------------------------------- / /************************ LOCAL SYMBOLIC DEFINITIONS ***************** / /--------------------------------------------------------------------- LOADPT= 200 / EFFECTIVE LOADER ADDRESS. EJECT / ** -1- ** BOOTSTRAP WRITE-OUT ROUTINE **** /--------------------------------------------------------------------- / /************************ BOOTSTRAP WRITE ROUTINE ******************** / /--------------------------------------------------------------------- FIELD 0 PAGE 0 *200 JMP LOADBT / *LOADPT PAGE 10 /--------------------------------------------------------------------- / /************************ BUILD CORRECT "FILL SILO" COMMAND ********** / /--------------------------------------------------------------------- LOADBT, CLA RXIINI /INIT DISK /M006 RXISDN /DONE? /M006 JMP .-1 /NO TAD LDCON /LOAD 1 CONSTANT RXILCD /LOAD COMMAND READ STATUS UNIT #1/M006 RXISDN /DONE? /M006 JMP .-1 /NO RXIXDR /READ STATUS /M006 RXISER /CLEAR ERROR IF SET /M006 NOP DCA L1STAT /SAVE STATUS TAD L1STAT RTL;RAL /MOVE DENSITY TO BIT AC3 AND LDMASK /MASK DENSITY BIT DCA LDCMND / ......"FILL SILO",... TAD LDCMND TAD L2CON /SET COMMAND WITH UNIT#1 DCA L2CMND TAD L1ADDR / SET/RESET,... DCA LDBFFR / ...START ADDRESS. JMS LDFILL /FILL SILO CLA IAC DCA LDSECT /SET SECTOR = 1 JMS LDWRIT /WRITE 1ST SECT 1ST TRACK JMP LOAD02 /NORMAL RETURN JMP LOADBT /ERROR RETURN / THIS PROCESS IS VALID ONLY FOR CONTROLLER 0, UNIT 1. / /--------------------------------------------------------------------- LOAD02, CLA CLL IAC / INITIALIZE SECTOR #,... DCA LDSECT / ...TO UNITY. TAD L2ADDR /SET BOOT WRITE ADDRESS DCA LDBFFR SIZE= .-LOAD02 /--------------------------------------------------------------------- / /************************ DETERMINE NO. SECTORS TO WRITE ************* / /--------------------------------------------------------------------- AC7776 / SET INITIAL COUNT,... DCA LDSCTR / ...TO -2 (SD) -1 (DD). TAD LDCMND / ADJUST,... SZA CLA / ...FOR,... CLA CLL IAC / ......A DOUBLE,... TAD LDSCTR / .........DENSITY DISKETTE,... DCA LDSCTR / ............AND SAVE. /--------------------------------------------------------------------- / /************************ CALCULATE PHYSICAL SECTOR ****************** / /--------------------------------------------------------------------- LDINIT, AC0003 / INITIALISE SECTOR,... TAD LDSECT / ...COUNT,... DCA LDSECT / ......TO 4 (I.E. SD DEFAULT ). TAD LDCMND / ADJUST,... SZA CLA / ...FOR DOUBLE,... CLA CLL CMA CML / ......DENSITY,... TAD LDSECT / .........DISKETTE,... DCA LDSECT / ............OPERATIONS. JMS LDFILL /FILL SILO JMS LDWRIT /WRITE JMP LDNXT /NORMAL RETURN JMP LOAD02 /ERROR RETURN /--------------------------------------------------------------------- / /************************ COMPLETION PROCESSOR *********************** / /--------------------------------------------------------------------- LDNXT, ISZ LDSCTR / YES - ALL SECTORS WRITTEN ? JMP LDINIT / NO - CONTINUE WITH SUBSEQUENT SECTORS. RXIINI /M006 JMP I LDEXIT / YES - EXIT LOAD PROCESSOR TO OS8. /--------------------------------------------------------------------- / /************************ SILO LOAD ROUTINE ************************** / /--------------------------------------------------------------------- LDFILL, 0 CLA TAD L2CMND /LOAD COMMAND RXILCD /EXECUTE /M006 L1MORE, CLA CLL / ENSURE REGISTER CLEAR. CDFPRT / SECONDARY BOOT GOES TO FIELD 1/M006 TAD I LDBFFR / LOAD A DATUM,... CDFSYS / ...RESTORE THIS DATA FIELD,.../M006 ISZ LDBFFR / ......UPDATE ADDRESS IN SECOND BOOT. JMS LDXFER / .........TRANSFER THE DATUM,... JMP L1MORE /.......TRANSFER RETURN JMP LDFLXT /DONE EXIT JMP LOADBT /ERROR EXIT LDFLXT, CLA CMA TAD LDBFFR DCA LDBFFR /RESET -1 FOR NEXT SECTOR JMP I LDFILL /EXIT /------------------------------------------------------------------- / /************************PHYSICAL I/O PRIMITIVE************************ / /---------------------------------------------------------------------- LDWRIT, 0 CLA CLL IAC RTL / BUILD A "WRITE SECTOR",... TAD L2CMND / COMMAND,... RXILCD / AND TRANSMIT TO CONTROLLER. /M006 TAD LDSECT /LOAD SECTOR JMS LDXFER / ..."SECTOR 1",... JMP LDWRT1 /...TR RETURN JMP LDWRTE /DONE = ERROR RETURN JMP LDWRTE /ERROR RETURN LDWRT1, CLA CLL IAC JMS LDXFER / ......"TRACK 1. JMP LDWRT2 /TR DONE JMP LDWRTE /DONE SET=ERROR JMP LDWRTE /ERROR RET LDWRT2, JMS LDXFER /CHECK DONE JMP LDWRTE /TR = ERROR JMP I LDWRIT /DONE = NORMAL RETURN JMP LDWRTE /ERROR RETURN LDWRTE, ISZ LDWRIT /SET ERROR RETURN JMP I LDWRIT /M005 /--------------------------------------------------------------------- / /************************ DATA TRANSFER PRIMITIVE ******************** / /--------------------------------------------------------------------- LDXFER, 0 / ENTRY POINT TO "LDXFER". LDXRDY, RXISTR / CONTROLLER READY ? /M006 JMP LDCKDN /NO CHECK DONE RXIXDR / YES - TRANSFER A DATUM,... /M006 JMP I LDXFER / ...THEN RETURN TO CALLER. /M005 LDCKDN, RXISDN /OP COMPLETE? /M006 JMP LDXRDY /NO-CHECK AGAIN ISZ LDXFER /YES SET RETURN RXISER /ANY ERRORS /M006 JMP I LDXFER /NO RETURN DONE /M005 CLA /YES TRY AGAIN TAD L1ADDR /RESET START ADDRESS DCA LDBFFR ISZ LDXFER /SET ERROR RETURN JMP I LDXFER /ERROR RETURN /M005 /--------------------------------------------------------------------- / /************************ LOCAL DATA AREA **************************** / /--------------------------------------------------------------------- L1EXIT, 7605 / ...VIA THE RE-ENTRY ADDRESS. LDCMND, 0 / LOCAL STORAGE FOR COMMAND WORD. L2CMND, 0 /STORAGE FOR COMMAND WORD WITH UNIT #1 LDBFFR, 2 / LOAD ADDRESS OF SECONDARY BOOTSTRAP./M006 L1ADDR, 2 / BACKUP ADDRESS OF START ADDRESS. L2ADDR, W2BOOT /ADDRESS OF 2ND BOOT AREA L1STAT, 0 /STATUS READ LDCON, 12 /READ STATUS UNIT 0 L2CON, 0 /UNIT 1 CONSTANT LDMASK, 400 / MASK FOR COMMAND. LDSECT, 1 / INITIAL VALUE FOR PHYSICAL SECTOR #. LDSCTR, 0 / SECTOR COUNT. LDTIMR, 0 / SECONDARY TIMER WORD. LDEXIT, 7605 / RE-ENTRY ADDRESS FOR OS8. SIZE= .-LDCMND / FILE: BOOT01.PA XLIST / ** -0- ** DOCUMENTATION **** /********************************************************************* / / / THIS BOOTSTRAP CODE IS THE PRIMARY BOOT WHICH IS BROUGHT INTO / MEMORY BY THE INITIAL HARDWARE BOOT FUNCTION. THE SEQUENCE OF / BOOTING A WPS SYSTEM IS GENERALLY AS FOLLOWS: / / 1. THE HARDWARE BOOT PROCESS IS INITIATED BY PUSHING / THE START BUTTON OR BY DEPRESSING A CTRL-SETUP-2. / / 2. THAT PROCESS BRINGS INTO MEMORY A ROM-BASED BOOT / WHICH IS LOADED INTO LOCATIONS 0016 THRU 0061 OF / FIELD ZERO, AND INITIATED AT LOCN 0016. / / 3. THIS HARDWARE BOOT WILL BRING INTO MEMORY TRACK-1, / SECTOR-1 OF THE RX DEVICE DISKETTE WHETHER THAT / DISKETTE IS DOUBLE DENSITY OR SINGLE DENSITY. IN THE / CASE OF SINGLE DENSITY, THIS CONSTITUTES A 64(DECIMAL) / WORD TRANSFER; DOUBLE DENSITY = 128(DECIMAL) WORDS. / / 4. THIS TRACK1, SECTOR1 DATA IS READ INTO MEMORY / BEGINNING AT LOCATION 0002. OBVIOUSLY, THIS WILL / FORCE THE READ-IN PROCESS TO -OVERLAY- THE BOOTSTRAP / WHICH IS READING THE DATA IN. THIS PRESENTS SOME / INTERESTING CHALLENGES. THERE ARE TWO -CRITICAL / OVERLAY AREAS- IN THE THEN RUNNING BOOTSTRAP WHICH / MUST BE OVERLAID WITH COPIES OF THEMSELVES WITH / CERTAIN VERY LIMITED EXCEPTIONS. LOCN 0035, THE / LAST WORD OF THE 1ST CRITICAL OVERLAY AREA, IS THE / ENTRY POINT TO THE SECONDARY BOOT PROCEDURE. THUS, / WHEN THE TRACK1, SECTOR1 READ-IN IS COMPLETE, CONTROL / ENDS AT LOCN 0035 WHICH MAY HAVE BEEN OVERLAID BY A / JUMP TO THE START OF THE NEXT LEVEL BOOT, OR MAY BE / AN INSTRUCTION OF THE NEXT LEVEL BOOT. / / 5. IN THE CASE OF THE WPS-278 V2.0 SECOND LEVEL BOOT, / THERE IS A NECESSITY TO BE ABLE TO BOOT FROM EITHER / A SINGLE DENSITY OR A DOUBLE DENSITY DEVICE. SINCE THE / INITIAL HARDWARE BOOT HAS MADE THE DETERMINATION OF THE / DENSITY OF THE BOOT-DEVICE AND LEFT IT ENCODED AT LOCN / 0060, THE WPS BOOTSTRAP DOES NOT WISH TO DESTROY THAT / PIECE OF DATA. / / *** IMPORTANT PIECE OF UNDERSTANDING *** / / TO ALLOW PRESERVATION OF THIS VALUE, A TECHNIQUE IS / USED WHICH OPENS A HOLE IN THE DATA BEING BROUGHT IN / AND LAID INTO MEMORY. AS WE SAID, THE BOOT PROCESS IS / OVERLAYING ITSELF AS IT GOES. NOTICE THAT THE INSTRUCTION / AT LOCN 0050 IN THE HARDWARE BOOT IS THE ONE WHICH PUTS / THE INCOMING DATA INTO MEMORY. AT SOME POINT IN TIME, THIS / /********************************************************************* XLIST XLIST EJECT / ** -0- ** DOCUMENTATION, CON'T. **** /********************************************************************* / / 'DCA' WILL ACTUALLY LAY AN INSTRUCTION ON TOP OF ITSELF. / THE INSTRUCTION THAT COMES IN AT THAT TIME IS A 'DCA 0061'. / AS SOON AS THIS INSTR IS LAID DOWN, IT IS INCREMENTED BY THE / INSTRUCTION 'ISZ 0050' WHICH APPEARS IN LOCN 0051 SO THAT / THE FINAL 'DCA' FOR THE NEXT WORD TO COME FROM THE DISKETTE / WILL BE DEPOSITED IN LOCN 0062, THUS BYPASSING THE VARIABLE / WE WISH TO SAVE. / / 6. FOR THE ABOVE REASON, THE SECOND HALF OF THE PRIMARY BOOT / IS ASSEMBLED AS THOUGH IT WERE TO BE LOADED AT LOCN 0062 / RATHER THAN A STRAIGHT CONTINUATION AT LOCN 0051 AS ONE MIGHT / OTHERWISE EXPECT. / / D.E.C. STANDARD BOOTSTRAPS FOR FLEXIBLE DISKETTES / MUST RESIDE ON THE DISKETTE STARTING / WITH TRACK #1, SECTOR #1. / ALL BOOTSTRAPS MUST BE WRITTEN TO THE SYSTEM DISKETTE / IN "12 BIT MODE", I.E. ONE PDP8 12 BIT WORD / WILL OCCUPY TWO SEQUENTIAL EIGHT(8) BIT BYTES / ON THE DISKETTE, THE FIRST CONSISITING OF THE / LOW ORDER EIGHT BITS OF THE WORD (BITS 4-11) / AND THE SECOND CONSISTING OF BITS 0-3 OF THE / WORD PRECEEDED BY FOUR LEADING ZERO BITS. / WHEN USING A SINGLE DENSITY DISKETTE, ONE SECTOR WILL / CONTAIN 64(10), 100(8) PDP8 12 BIT WORDS. / WHEN USING A DOUBLE DENSITY DISKETTE, ONE SECTOR WILL / CONTAIN 128(10), 200(8) PDP8 12 BIT WORDS. / / THUS, IN ORDER TO BE ABLE TO BOOT BOTH TYPES OF DISKETTE, / TWO EFFECTIVE BOOTSTRAPS MUST BE EMPLOYED. / / 1.) THE PRIMARY BOOTSTRAP IS READ INTO CORE / BY THE HARDWARE BOOTSTRAP, / / 2.) WHEN THE PRIMARY BOOTSTRAP EXECUTES, IT / READS IN THE SECONDARY BOOTSTRAP, / / 3.) WHEN THE SECONDARY BOOTSTRAP EXECUTES, IT / READS IN THE SYSTEM BOOTSTRAP, WHICH / LOADS THE CRITICAL PARTS OF THE SYSTEM, / AND STARTS IT. / / THE FOLLOWING CHART SHOWS WHERE THE THE VARIOUS PIECES / OF THE VARIOUS BOOTSTRAPS RESIDE ON THE / DISKETTE. / / CONTINUED / /********************************************************************* XLIST XLIST EJECT / ** -0- ** DOCUMENTATION, CON'T. **** /********************************************************************* / / CONTINUED / / / BOOTSTRAP TYPE TRACK SECTOR(S) / __________________________________________________ / / HARDWARE (PROM) NONE NONE / / PRIMARY (SD) 1 1 (FULL) / (DD) 1 1 (FIRST HALF ONLY) / / SECONDARY (SD) 1 4,7 (BOTH FULL) / (DD) 1 3 (FULL) / / SYSTEM ---- - - / / /********************************************************************* XLIST XLIST EJECT / ** -0- ** MODEL PRIMARY BOOTSTRAP **** /----------------------------------------------------------------------------------- / / THE FOLLOWING IS A LISTING OF THE PRIMARY HARDWARE BOOTSTRAP / FOR THE RX01/RX02. NOTA BENE - THIS BOOTSTRAP WILL ATTEMPT TO / BOOT EITHER DRIVE 0 OR DRIVE 1. / / / 0002 *SCNDBT / START ADDRESS OF SECONDARY BOOT. / /--------------------------------------------------------------------- / / / /************************ SECONDARY BOOTSTRAP ENTRY POINT ************ / / / /--------------------------------------------------------------------- / 0016 *BOOT1 / START ADDRESS OF PRIMARY BOOT. / /--------------------------------------------------------------------- / / / /************************ PRIMARY BOOTSTRAP ************************** / / / /--------------------------------------------------------------------- /00016 6007 RZBOOT, CAF / INIT. BUS.-CPU. /00017 5033 JMP RZBOO3 / INITIATE THE BOOT PROCESS. /00020 1061 RZBOO1, TAD RZBOO0 / BUILD COMMAND. /00021 1046 TAD RZBOO4 / SET,... /00022 0060 AND RZBOO9 / ...UNIT AND,... /00023 3061 DCA RZBOO0 / ......DENSITY. /00024 7327 CLA CLL CML IAC RTL / BUILD A "READ SECTOR",... /00025 1061 TAD RZBOO0 / ...COMMAND. /00026 6751 RXILCD / SEND COMMAND TO CONTROLLER. /00027 7301 CLA CLL IAC / SET TO,... /00030 4053 JMS RZBOO7 / ...READ SECTOR 1,... /00031 4053 JMS RZBOO7 / ......TRACK 1. /00032 7004 RZBOO2, RAL / BUILD AN "EMPTY SILO" COMMAND. / /--------------------------------------------------------------------- / / / /************************ CRITICAL OVERLAY AREA 1 ******************** / / / /--------------------------------------------------------------------- / /********************************************************************* /00033 6755 RZBOO3, RXISDN / DONE ? /M006 /00034 5054 JMP RZBOO8 / NO - WAIT FOR READY FIRST. /00035 6754 RXISER / YES - CORRECT DENSITY CHOSEN ? / /********************************************************************* / /--------------------------------------------------------------------- / / / /************************ END CRITICAL OVERLAY AREA 1 **************** / / / /--------------------------------------------------------------------- / / CONTINUED NEXT PAGE / /------------------------------------------------------------------------------------ XLIST XLIST /------------------------------------------------------------------------------------ / / CONTINUED / / /00036 7450 SNA / NO - TRY ALTERNATIVE DRIVE/DENSITY. /00037 5020 JMP RZBOO1 / YES - TRANSFER A DATUM. /00040 1061 TAD RZBOO0 / ISSUE THE,... /00041 6751 RXILCD / ...EMPTY SILO COMMAND. /M006 /00042 1061 TAD RZBOO0 / ESTABLISH,... /00043 0046 AND RZBOO4 / ...LINKAGE TO,... /00044 1032 TAD RZBOO2 / ......THE SECONDARY,... /00045 3060 DCA RZBOO9 / .........BOOT. /00046 0360 RZBOO4, 0360 / - "MAGIC" CONSTANT - / /--------------------------------------------------------------------- / / / /************************ CRITICAL OVERLAY AREA 2 ******************** / / / /--------------------------------------------------------------------- / /********************************************************************* /00047 4053 RZBOO5, JMS RZBOO7 / TRANSFER A DATUM,... /00050 3002 RZBOO6, DCA SCNDBT / ...AND INSERT IT IN-LINE. /00051 2050 ISZ RZBOO6 / INCREMENT THE "BUFFER" POINTER. /00052 5047 JMP RZBOO5 / ...AND CONTINUE READING IN SECONDARY BOOT. /00053 0000 RZBOO7, 0 / ### ENTRY POINT TO "READ" SUBROUTINE. ### /00054 6753 RZBOO8, RXISTR / CONTROLLER READY ? /M006 /00055 5033 JMP RZBOO3 / NO - CHECK FOR DONE/CORRECT DENSITY. /00056 6752 RXIXDR / YES - LOAD A DATUM,... /M006 /00057 5453 JMP I RZBOO7 / ...AND RETURN TO CALLER. /M005 /00060 0420 RZBOO9, 0420 / LINKAGE WITH SECONDARY BOOT. /00061 0020 RZBOO0, 0020 / LINKAGE WITH ALTERNATE SECONDARY BOOT. / /********************************************************************* / /--------------------------------------------------------------------- / / / /************************ END CRITICAL OVERLAY AREA 2 **************** / / / /--------------------------------------------------------------------- / / / END OF PRIMARY BOOTSTRAP / /----------------------------------------------------------------------------------- XLIST EJECT / ** -0- ** SYMBOLIC DEFINITIONS **** /--------------------------------------------------------------------- / /************************ SPECIAL SYMBOLIC DEFINITIONS *************** / /--------------------------------------------------------------------- HACK= " -1 / DEFINITION OF THE "[H]ALF [A]SCII" [C]HARACTER [K]ONSTANT. PRBOOT= 2 / LOAD POINT FOR THE PRIMARY BOOTSTRAP. BOOT02= PRBOOT+60 / LOAD POINT FOR THE REMAINING PRIMARY BOOT. EJECT / ** -1- ** PRIMARY "WPS" BOOTSTRAP **** FIELD 1 / PRIMARY BOOTSTRAP IS ASSEMBLED IN FIELD 1. PAGE 0 *PRBOOT / LOAD ADDRESS FOR PRIMARY BOOT. /--------------------------------------------------------------------- / /************************ PRIMARY BOOTSTRAP HEADER ******************* / /--------------------------------------------------------------------- HLT /STRT ADDR OVERLAYED IN DD MODE BTRXID, "#-HACK^100+" -HACK / ...PRIMARY BTTRAK, "W-HACK^100+"P-HACK / ......BOOTSTRAP BTLSEC, "D-HACK^100+"I-HACK / .........HEADER BTSECT, "S-HACK^100+"K-HACK / ............PRECEEDS BTSCTR, "/-HACK^100+"[-HACK / ...............ACTUAL " -HACK^100+" -HACK / ..................BOOTSTRAP. 0 0 /--------------------------------------------------------------------- / /************************ SPARE AUTO-INDEX AREA ********************** / /--------------------------------------------------------------------- /D008 IFDEF WINNIE .lt. /A007 BTTBUF, RXDLDP-201 /M007 BTBFRA, RXDLDP-201 /M007 BTBFRB, RXDLDP-201 /M007 /D008 .gt. / END IFDEF WINNIE /A007 /D008 IFNDEF WINNIE .lt. /A007 /D008BTTBUF, RXDLDP-1 /D008BTBFRA, RXDLDP-1 /D008BTBFRB, RXDLDP-1 /D008 .gt. / END IFNDEF WINNIE /A007 BTBFFR, 377 /C003 MSK422, 422 /MASK FOR DENSITY,UNIT#,READ CODE /M003 /-------------------------------------------------------------------- / /************************ SPARE MEMORY AREA ************************** / /--------------------------------------------------------------------- BTCMND, 22 /BITS=DD,UNIT#,READ MSK24, 2400 /ADD TO BTCMND TO ALTERNATELY SET UNIT & DENSITY BTINC, JMP BTPTCH /ONE TIME JMP. ON SUCCESFUL READ ISZ BTXFER /SET DONE RETURN JMP I BTXFER /RETURN /--------------------------------------------------------------------- / /************************ "EMPTY SILO" OPERATION ********************* / /--------------------------------------------------------------------- BTMORE, DCA I BTBFFR / DEPOSIT DATUM IN CORE. BTEMPT, JMS BTXFER / TRANSFER A DATUM FROM SILO. JMP BTMORE / NOT DONE - REPEAT FOR ENTIRE SECTOR. /--------------------------------------------------------------------- / /************************ OPERATION COMPLETION PROCESSOR ************* / /--------------------------------------------------------------------- BTDONE, ISZ BTSCTR / DONE - ALL SECTORS READ ? JMP BTNEXT / NO - READ NEXT. JMP I BTSCND / YES - ENTER SYSTEM BOOTSTRAP CODE. /--------------------------------------------------------------------- / /************************ CRITICAL OVERLAY AREA 1 ******************** / /--------------------------------------------------------------------- BTBOO3, RXISDN / DONE ? /M006 JMP BTBOO8 / NO - WAIT FOR READY FIRST. /--------------------------------------------------------------------- / /************************ TRANSFER PRIMITIVE PART 2 - DONE *********** / /--------------------------------------------------------------------- CLA CLL / INSURE AC CLEAR FOR DONE RETURN RXISER /ERROR? /M006 JMP BTINC /NO INC RET SKP /IS ERROR BTPTCH, DCA BTINC /CLEAR JMP ON SUCCESSFUL DONE /D002 TAD MSK360 TAD MSK24 /ALTERNATE 24 & 2400 /A002 BSW /A002 DCA MSK24 /A002 TAD MSK24 /GET IT /A002 JMP BTREAD / JUMP OVER CRITICAL AREA 2 /--------------------------------------------------------------------- / /************************ CRITICAL OVERLAY AREA 2 ******************** / /--------------------------------------------------------------------- BTBOO5, JMS BTBOO7 / TRANSFER A DATUM BTBOO6, DCA BOOT02-1 / ...AND INSERT IT IN-LINE. BTOVLY=. /--------------------------------------------------------------------- / /************************ DATA TRANSFER PRIMITIVE ******************** / /--------------------------------------------------------------------- *BOOT02-7 BTXFER, / ENTRY POINT TO "BTXFER". BTBOO7, / ### ENTRY POINT TO "READ" SUBROUTINE. ### *BOOT02-6 BTBOO8, / CONTROLLER READY ? / RXISTR / CONTROLLER READY TO TRANSFER DATA ? /M006 / JMP BTBOO3 / NO - WAIT FOR IT. / RXIXDR / YES - TRANSFER A DATUM. /M006 / JMP I BTXFER / RETURN TO CALLER. /M005 /--------------------------------------------------------------------- *BOOT02-2 BTUNIT, / HARDWARE BOOTSTRAP COMMAND WORD. BTBOO9, / LINKAGE WITH SECONDARY BOOT. *BOOT02-1 BTBOO0, / LINKAGE WITH ALTERNATE SECONDARY BOOT. /--------------------------------------------------------------------- / /************************ END CRITICAL OVERLAY AREA 2 **************** / /--------------------------------------------------------------------- EJECT *BTOVLY RELOC BOOT02 /--------------------------------------------------------------------- / /************************ SET THE CORRECT SECTOR COUNT *************** / /--------------------------------------------------------------------- BTREAD, TAD BTCMND AND MSK422 /KEEP DENSITY,UNIT# AND READ CODE DCA BTCMND / ......DENSITY BIT IN COMMAND WORD TAD BTCMND / LOAD THE COMMAND RTL / ...AND ISOLATE RTL / ......DENSITY BIT IN THE LINK CLA CMA RAL / .........THEN BUILD DCA BTSCTR / ............THE CORRECT SECTOR COUNT. /--------------------------------------------------------------------- / /************************ CALCULATE CORRECT BASE SECTOR ************** / /--------------------------------------------------------------------- IAC / CALCULATE THE PROPER (SD OR DD)/D003/C004 /D004 TAD BTSCTR /SET FOR INTERLEAVE /A003 /D004 CMA /0 FOR DD 1 FOR SD /A003 DCA BTSECT / ......PHYSICAL SECTOR NUMBER. /--------------------------------------------------------------------- / /************************ PHYSICAL "READ" OPERATION ****************** / /--------------------------------------------------------------------- BTNEXT, AC0004 / SET THE PHYSICAL I/O BIT TAD BTCMND / ...AND SUBMIT COMMAND TO CONTROLLER. RXILCD /M006 AC0003 / LOAD SECTOR # TO READ TAD BTSECT / ...INCREMENT IT BY INTERLEAVE JMS BTXFER / ......SUBMIT IT TO CONTROLLER DCA BTSECT / .........AND SAVE IT AGAIN CLA CLL IAC / LOAD "BOOT" TRACK NUMBER,... JMS BTXFER / ...AND SUBMIT IT TO CONTROLLER ALSO. JMS BTXFER / WAIT FOR CONTROLLER "DONE" BTSCND, /LOC 400 = DD BIT USED TO SAVE SPACE/A003 BTDENS, 400 /D003 BTSCND, 200 / (SPARE) ADDRESS OF SECONDARY BOOT /--------------------------------------------------------------------- / /************************ LOGICAL "READ" OPERATION ******************* / /--------------------------------------------------------------------- TAD BTCMND / GET "EMPTY SILO" COMMAND RXILCD / ...AND SUBMIT IT TO CONTROLLER. /M006 JMP BTEMPT / GO EMPTY THE SILO / SPARE= 100-.+BTREAD-BTOVLY+PRBOOT RELOC / BACK TO ORIGINAL ORIGIN. EJECT / ** -0- ** SYMBOLIC DEFINITIONS **** /--------------------------------------------------------------------- / /************************ SPECIAL SYMBOLIC DEFINITIONS *************** / /--------------------------------------------------------------------- EJECT / ** -1- ** SECONDARY BOOTSTRAP **** FIELD 1 / BOOT IS ASSEMBLED IN FIELD 1. PAGE 2 / USE SCND PAGE OF FIELD. /--------------------------------------------------------------------- / /************************ PATCH TRANSFER ROUTINE FOR SECONDARY ******* / /--------------------------------------------------------------------- W2BOOT, AC0001 / JMS TTY /TYPE A=GOT IN THIS FAR TAD BTHALT / PUT A HALT INSTRUCTION AT THE END DCA BTPTCH / ...OF THE ERROR BRANCH AC0002 / JMS TTY /B=UNIT 0 OK /--------------------------------------------------------------------- / /************************ DETERMINE DISKETTE DENSITY ***************** / /--------------------------------------------------------------------- TAD BTCMND / LOAD COMMAND FROM PRIMARY BOOT. RTL / ISOLATE "SD"/"DD" RTL / ...IN REGISTER AS "0" OR "1" CLA RAL / ......AND SAVE IT. DCA BTRXID /--------------------------------------------------------------------- / /**************** DETERMINE WHETHER RX01/RX02 DRIVE ****************** / /--------------------------------------------------------------------- TAD PRX02 /DO A REQUEST FOR STATUS TAD BTCMND /ADD DENSITY RXILCD / ... /M006 RXISDN /M006 JMP .-1 / WAIT FOR DONE. RXIXDR / GET STATUS RESPONSE. /M006 AND PRX02 / ISOLATE THE RX02 BIT. SNA CLA / SKIP IF RX02 (RX28 DRIVE). DCA BTLCM2 / ZAP THE RX02 LCD 2ND XFR COMMAND. /--------------------------------------------------------------------- / /************************ ADJUST MODE (8B/12B) TO DENSITY ************ / /--------------------------------------------------------------------- /D003 TAD BTCMND / GET COMPLEMENT OF DENSITY BIT /D003 TAD BTDENS / ...FROM COMMAND WORD. /D003 AND BTDENS /D003 CLL RTR / ROTATE IT INTO 8/12 BIT OF TAD BTRXID /0=DD 1=SD /A003 SNA CLA /IS DD? /A003 IAC BSW /NO SET 8 BIT MODE /A003 TAD BTCMND / ...COMMAND WORD. DCA BTCMND /--------------------------------------------------------------------- / /************************ CALCULATE LOGICAL SECTOR NUMBER ************ / /--------------------------------------------------------------------- TAD BTRXID / LOAD THE DENSITY PARAMETER SNA CLA / ......DOUBLE DENSITY ? TAD BTBLKN / NO - MAKE IT 3*BLOCK NUM TAD BTBLKN / YES - MAKE IT 2*BLOCK NUM TAD BTBLKN DCA BTLSEC / ......AND SAVE IT. /// CDF DRVFLD EJECT / ** -1- ** RX01/RX02 SECTOR READ PROCESSOR **** /--------------------------------------------------------------------- / /************************ RX01/RX02 PROCESS DISPATCHER *************** / /--------------------------------------------------------------------- NXTBLK, TAD BTRXID / "DD" OPERATION ? SZA CLA JMP BTDBLD / YES - SKIP THE "UNPACK" PROCESS /--------------------------------------------------------------------- / /************************ SD - UNPACK FIRST SECTOR OF BLOCK ********** / /--------------------------------------------------------------------- JMS BTPHYS / EFFECT A "READ SECTOR" OPERATION. JMP BTUNPK / ENTER UNPACKING LOOP DXUNPK, MQL / SAVE DATA BYTE MQA / UNPACK FIRST NYBBLE RTR / ...ALIGN TO HO END BSW AND DXNMSK / ......ISOLATE HIGH 4 BITS DCA I BTTBUF / .........AND PUT IT AWAY MQA / UNPACK SECOND NYBBLE RTL / ...ALIGN TO HO END BSW AND DXNMSK / ......ISOLATE HIGH 4 BITS DCA I BTTBUF / .........AND PUT IT AWAY BTUNPK, JMS BTXFER / GET DATA BYTE FROM SECTOR JMP DXUNPK / (TR) ...AND GO UNPACK IT /--------------------------------------------------------------------- / /************************ READ 2 SECTORS, SD OR DD ******************* / /--------------------------------------------------------------------- BTDBLD, AC7776 / (DN) SET SECTOR COUNT DCA BTSCTR DYNEXT, JMS BTPHYS / EFFECT A "READ SECTOR" OPERATION. SKP / ENTER THE "MERGE" LOOP DYREAD, DCA I BTBFRB / SAVE WORD IN BUFFER. TAD I BTBFRA / LOAD CURRENT CONTENTS OF BUFFER. JMS BTXFER / LOAD A DATUM. /#(8 BIT MODE => INCLUSIVE OR INTO BITS 4-11) /#(12 BIT MODE => JAM XFER BITS 0-11) JMP DYREAD / (TR) CONTINUE FETCHING DATA CLA CMA /-1 TAD BTBFRA /RESET PTR TO LAST CHAR DCA BTBFRA /RESTORE ISZ BTSCTR / (DN) ALL SECTORS PROCESSED ? JMP DYNEXT / NO - PROCESS NEXT. /--------------------------------------------------------------------- / /************************ COMPLETION PROCESSOR *********************** / /--------------------------------------------------------------------- ISZ BTBCTR / YES - ALL BLOCKS PROCESSED ? JMP NXTBLK / NO - DO ANOTHER BLOCK. AC0003 / JMS TTY /C=LOADER GOT IN OK /-------------------------------------------------------------------- / /***************** CHECK DEVICE NO ************************************ / /---------------------------------------------------------------------- TAD BTCMND AND MSK20 /MASK OUT UNIT NO SZA CLA /0=UNIT 0 DOCSKP=. /RXPRDF LDNOP SHOULD BE EQUAL THIS ADDRESS/A018 JMP I PRTMSG /NOT UNIT 0 /// CIF DRVFLD JMP I WPSTRT / YES - START SYSTEM. /-------------------------------------------------------------------- / /*********** OUTPUT 1 CHAR ****************************************** / /----------------------------------------------------------------------- TTY, 0 TAD P100 / MAKE ASCII. TLS TSF /WAIT TILL DONE JMP .-1 CLA JMP I TTY /RETURN /-------------------------------------------------------------------- / /****************** WRONG UNIT*************************************** / PRINT ERROR MSG /---------------------------------------------------------------------- PRTMSG, DCSTRT /START ADDRESS OF MESSAGE /A002 /D002DRIVE1, TAD AY /D002 JMS TTY /// CMA /-1 IN AC /D002 JMP . EJECT / ** -1- ** PHYSICAL I/O AND "EMPTY" COMMAND ROUTINE **** /--------------------------------------------------------------------- / /**************** ROUTINE TO EFFECT A "READ SECTOR" OPERATION ******** / /--------------------------------------------------------------------- BTPHYS, 0 /--------------------------------------------------------------------- / /************************* CALCULATE PHYSICAL & TRACK SECTOR ********* / /--------------------------------------------------------------------- DCA BTTRAK / INITIALISE TRACK #. TAD BTLSEC / LOAD THE LOGICAL SECTOR #. BTDIV1, ISZ BTTRAK / INCREMENT THE TRACK #. DCA BTSECT / SAVE THE SECTOR #,... TAD BTSECT / ...THEN RETREIVE IT. TAD BTDVSR / "SUBTRACT" THE # OF SECTORS/TRACK. SMA / OVERFLOW ? JMP BTDIV1 / NO - CONTINUE. CLA CLL / YES - ENSURE REGISTER CLEAR /--------------------------------------------------------------------- / /************************ INTERLEAVE SECTORS ************************* / /--------------------------------------------------------------------- /D004 TAD BTRXID /DD? /A003 /D004 SNA CLA /YES 2*MQ /A003 TAD BTSECT / BUILD 3*Q. TAD BTSECT / TAD BTSECT BTDIV2, DCA BTSECT / SAVE "PHYSICAL" SECTOR #. TAD BTSECT / RETREIVE "PHYSICAL" SECTOR #. /D004 TAD BTRXID / ADJUST MODULUS FOR DENSITY TYPE. TAD BTDVSR / "SUBTRACT" # SECTORS/TRACK. P100, SMA / OVERFLOW ? JMP BTDIV2 / NO - REPEAT UNTIL OVERFLOW. ISZ BTSECT / YES - INCR TO BUILD CORRECT PHYSICAL SECTOR. /--------------------------------------------------------------------- / /************************ EMIT PHYSICAL I/O COMMANDS ***************** / /--------------------------------------------------------------------- AC0004 / SET "PHYSICAL" BIT JMS BTLCMD TAD BTSECT / () GET PHYSICAL SECTOR JMS BTXFER / () ...AND SEND IT CLA / (TR) "RXIXDR" DOESN'T CLEAR AC TAD BTTRAK / (DN) GET PHYSICAL TRACK JMS BTXFER / ...AND SEND IT JMS BTXFER / (TR) WAIT FOR CONTROLLER DONE DXNMSK, 7400 / (DN) (TR) (SPARE) /--------------------------------------------------------------------- / /************************ EMIT LOGICAL I/O COMMAND ******************* / /--------------------------------------------------------------------- JMS BTLCMD /--------------------------------------------------------------------- ISZ BTLSEC / BUMP LOGICAL SECTOR FOR NEXT TIME JMP I BTPHYS / EXIT FROM PHYSICAL I/O ROUTINE /-------------------------------------------------------------------- / /********************EMIT COMMAND PRIMITIVE*************************** / /---------------------------------------------------------------------- BTLCMD, 0 TAD BTCMND RXILCD /M006 TAD BTRXID SNA CLA BTLCM2, JMS BTXFER CLA JMP I BTLCMD /--------------------------------------------------------------------- / /************************ LOCAL STORAGE DECLARATIONS ***************** / /--------------------------------------------------------------------- BTDVSR, -32 / LOCAL STORAGE FOR THE TRACK/SECTOR CONSTANT. BTBLKN, 3 BTBCTR, -DSRXLD / LOCAL STORAGE FOR THE BLOCK COUNTER. MSK20, 20 /UNIT MASK /D002AY, "Y&77 BTHALT, HLT / THIS WILL PATCH BTPTCH /M002 WPADDR=.-200 /THIS ADDRESS SHOULD BE = LDSTRT IN RXPRDF/M004 WPSTRT, RXDRIN / ENTRY POINT TODRIVER SYSTEM INIT LOAD /M004 /D002P12, 12 /REQUEST FOR STATUS PRX02, 10 /RX02 BIT IN STATUS RESPONSE /M002 PAGE /--------------------------------------------------------------------- / /************************ END-OF-FILE ******************************** / /--------------------------------------------------------------------- $ / END-OF-FILE.   /DSKHND DATE = 03/23/84 CURRENT EDIT / / / 052 KMD 26-Sep-85 Add Dutch & Spanish Xlations / 051 Mart 20-aug-85 fix ITALIAN edit bugs / 050 MART 24-APR-85 change dskhnd to call v25st on warm boot / 049 EMcD 04-Mar-85 Add read in/kick start V2.5 into life / 048 EMcD 27-Feb-85 Add DECDEV switch / 047 DFB 20-DEC-84 Fix to display date/time after error(dev 0=HD) / 046 DFB 31-AUG-84 Fix to pass unit number to verify on restart / 045 DFB 18-AUG-84 Fix to error retry for multiblock load / 044 DFB 08-AUG-84 Fix to read verify 12 bit logical / 043 HLP 23-MAR-84 Change load table for new system init / 042 DFB 21-FEB-84 Add get status code / 041 WJY 06-FEB-84 Addl. fix for DEC I compatability / 040 DFB 17-JAN-84 DEF fix for DEC I compatability / 039 DFB 12-JAN-84 Fix for load4 / 038 HLP 20-DEC-83 Change read-in address for printer / 037 DFB 02-DEC-83 Add update to winnie function / 036 DFB 29-NOV-83 Fix to read multiple blks on winnie / 035 DFB 01-NOV-83 Set to handle mount system vol / 034 DFB 16-SEPT-83 Set to return error if winnie not mounted /VERSION 033 ******************** / / 033 WCE 3-SEP-83 Changed RZ IOT's to RX IOT's and changed / FIELD instructions to standard instructions / 032 DFB 07-19-83 /WINNIE ADDITIONS / Jswap for winnie defined as RDOSWQ in WPF1 / FROM DSKHND VER31 / 031 DFB 04-08-83 /Update defs for DI,DII functionality / 030 DFB 12-DEC-82 /Update condor defs for DI,DII assy / 029 DFB 02-DEC-82 Stop Gold Halt exit during getdns / 028 DFB 16-NOV-82 Fix to allow JSWAP chnge externally / RDOSWP defined in WPF1.. overlayed by jswap in / WPCU2.after proper initialization of system / Jswap must overlay RDOSWP / / 027 DFB 10-NOV-82 Set drive 0 to 4 for load / conditional load4=1 / 026 DFB 22-OCT-82 Return after 1st write if RX50 write protect. / And do JSWAP if done not set on read/write / AND error return if Gold halt pressed during / error process / 025 DFB 15-AUG-82 Fix bug in physio 12 bit verify / 024 DFB 23-AUG-82 Set up to handle RX01 and RX02 / 023 DFB 03-AUG-82 Seek trk 0 instead of init(err. retry) / Delete skew code (determined not necessary) / 022 DFB 19-JUL-82 Set GET DEN to time out(ret err5) / Add seek tr 79 rx50 error logic / Add offset 2 code (skew=1 to install) / 021 DFB 15-JUL-82 Delete sel error return / 020 DFB 12-JUL-82 FIX TO SEL DEVICE ON ERR RETRY / 019 DFB 10-MAY-82 Verify Rx50 and rx50 startup fixes / 018 DFB 16-APR-82 Verify Rx50 and rx50 startup fixes / /*****COPIED FROM DSKHND.PA VERSION 17 28-FEB-82*************** / 017 GDH 28-FEB-82 Modified startup "read in" code. / 016 DFB 23-FEB-82 Set hndlr to rewrite then read when error / is detected during verify / 015 DFB 16-FEB-82 Add verify read after write / 014 DFB 04-FEB-82 Set error retry to init heads / 013 DFB 01-FEB-82 Double density interleave of 3 / 012 DFB 27-JAN-82 Double density interleave of 2 / 011 DFB 13-JAN-82 Allow 8bit phys i/o for dd / 010 DFB 06-JAN-82 Fix to return status in ret code / 009 DFB 28-DEC-81 Fix blk 6 1st loc=7401 for DOC diskette / 008 DFB 14-DEC-81 Add doc disk message / / *******if DMESS changes location other than 6400 / *******DCSTRT in RXPRDF MUST CHANGE ACCORDINGLY / 007 DFB 02-DEC-81 Fix to error hndler / 006 DFB 25-NOV-81 Fix to handle 2 RX02's / 005 DFB 18-NOV-81 Fix error hndler init on retry / 004 DFB 17-NOV-81 Fix to handle errs during boot / 003 GDH 13-NOV-81 Bug fix for Get Density on / 002 GDH 11-09-81 FIXED FOR RX01. / 001 DFB 10-29-81 /***************************************************************** / COPYRIGHT (C) 1977 BY / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP TO THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT / NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL / EQUIPMENT CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY / OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / / /******************************************************************* / / / THE FOLLOWING CODE IS USED TO WRITE THE RX02 HANDLER TO / DISC. IT IS REPEATED IN BOTH MODULES TO ALLOW FOR A SEPARATION / OF THESE MODULES AT A LATER DATE. OBVIOUSLY WHEN DOING SO / THE PARAMETERS (DLRXLD, LFRXLD AND STRT ADDR.) WOULD HAVE TO BE REPLACED / WITH THE CORRECT BLOCK NUMBERS,LENGTH AND STARTING ADDRESS. / / /********************************************************************* EJECT FIELD 0 *200 JMP I .+3 /WRITE BLOCK JMP I .+1 7600 RXLOAD *RXLDLS RXEWT /WRITE CODE 0 /DEVICE NUM RXQBLK /#BLOCKS . /LIST PNTR-1 DLRXLD /BLOCK NUM RXDLDP-200 /START ADDRESS(COMP FOR 1/2 BLK)/XXXDFB IFNDEF DECDEV < CDFMNU /FIELD NO /M048 /M033 > IFDEF DECDEV < CDF 50 /A048 > -DSRXLD /BLOCK COUNT 0 /END BLOCK /********************************************************************* /******************************************************************* /******************************************************************* /******************************************************************* / / /---------------- THE COMMENTS IN THIS PROGRAM ARE NOT------------- /----------------- AS ACCURATE AS ONE WOULD------------ /----------------- LIKE. WHEN THE COMMENTS ARE UPDATED------------ /------------------- THIS PARAGRAPH WILL BE DELETED ------------- / /********************************************************************* /********************************************************************* /********************************************************************* /********************************************************************* / / THE DIVISOR FOR THE INTERLEAVE ALGORITHM MUST BE / MODIFIED TO "25" FOR A DOUBLE DENSITY INTERLEAVE OPERATION, / BUT MUST REMAIN "26" FOR A SINGLE DENSITY OPERATION. THE / REASON BEHIND THIS LIES IN THE THEORY OF NUMBERS. / THE INTERLEAVE FACTOR AND THE NUMBER OF TRACKS PER / SECTOR MUST BE RELATIVELY PRIME, WHICH "2" AND "26" ARE NOT. / HOWEVER, FOR FOR A SINGLE DENSITY OPERATION THEY ARE RELATIVELY / PRIME, AS "3" AND "26" ALWAYS ARE. / HENCE, THE "DIVISOR" FOR THE INTERLEAVE OPERATION, AND / ONLY FOR THAT PARTICULAR OPERATION MUST BE MODIFIED TO "25" / DOUBLE DENSITY OPERATIONS, AND MUST REMAIN "26" FOR ALL SINGLE / DENSITY OPERATIONS. THIS IS ACCOMPLISHED, BY THE FOLLOWING / MECHANISM. / / -26 + ( +1 ) = -25, FOR DOUBLE DENSITY OPERATIONS. / -26 + ( 0 ) = -26, FOR SINGLE DENSITY OPERATIONS. / / THE FACTOR OF "0" OR "1" IS THE DISKETTE DENSITY PARAMETER / "RZDENS", OR "BTRXID" IN THE BOOTSTRAPS, WHICH IS RETURNED / AS A "0" FOR A SINGLE DENSITY DISKETTE, AND AS A "1" FOR A / DOUBLE DENSITY DISKETTE. / SCHEMATICALLY, THE ALGORITHM PROCEEDS AS FOLLOWS. / / SINGLE DENSITY DOUBLE DENSITY / 0>=N>=25 / / 3N (A.) 2N / Q(1)=3N(MOD 26.) (B.) Q(2)=2N(MOD 25.) / S(1)=Q(1) + 1 (C.) S(2)=Q(2) + 1 / / (A.) CALCULATE 2*SECTOR NUMBER WITHIN THE TRACK / I.E. THE RESIDUE FROM THE DIVIDE. / / USING THE DENSITY PARAMETER, SD=0/DD=1, / BUILD 2*SECTOR NUMBER + SECTOR NUMBER / FOR A SINGLE DENSITY DISKETTE, OR / SIMPLY 2*SECTOR NUMBER + 0 FOR A DOUBLE / DENSITY DISKETTE. / / (B.) CALCULATE THE PHYSICAL SECTOR NUMBER MINUS ONE BASED / ON THE CORRECT MODULUS. / / I.E. K*SECTOR NUMBER - 26 + DENSITY PARAMETER (SD=0/DD=1) / AND CONTINUE ADDING " - 26 + DENSITY PARAMETER" / TO THE RESULT WHILE IT REAMAINS POSITIVE. / / (C.) FOR EITHER DENSITY ADD "1" TO THE FINAL RESULT TO / OBTAIN THE CORRECT PHYSICAL SECTOR NUMBER. / / /********************************************************************* EJECT / ** -1- ** PAGE 1 DOCUMENTATION **** /********************************************************************* / / PAGE 1 / /********************************************************************* / / PAGE 1 OF THE DRIVER CONTAINS, AND IN THE PROPER ORDER, / THE FOLLOWING ROUTINES, AND DATA AREAS. / / A. THE ENTRY POINT TO THE DRIVER. / / B. THE "DPB" ( I.E. DEVICE PARAMETER BLOCK ) TRANSFER / ROUTINE. / / C. THE CONTROLLER SELECT CODE. / / D. THE IOT MODIFICATION PROCESSOR. / / E. THE DISKETTE DENSITY DETERMINATION. / / F. THE BUILD OF THE CONTROLLER COMMAND. / / G. THE INITIALISATION/RE-TRY PROCESSOR. / / H. THE READ/WRITE PROCESSOR/DISPATCHER. / / I. THE PAGE 1 DATA AREAS. / /********************************************************************* / IFNDEF DECDEV < FIELD 2 /FOR WRITE DISK ONLY > IFDEF DECDEV < FIELD 5 > / FIELD 00 /ACTUAL LOAD FIELD *RXDLDP /LOAD ADDRESS FOR DRIVER. / / /--------------------------------------------------------------------- / /************************ ENTRY POINT TO RX01/RX02 DEVICE DRIVER ***** / / ARGUMENTS ARE ACCESSED BY A "PASCAL-LIKE" CASE STATEMENT, / AS IMPLEMENTED IN PDP-8 ASSEMBLY LANGUAGE, AS INDICATED / IN THE PREAMBLE TO THIS DRIVER. / /--------------------------------------------------------------------- / /A015 / VERIFY BIT = BIT 1 /A015 / /A015 / WHEN SET IN RZXDIR ON INPUT /A015 / LOGICAL WRITE=READ AFTER WRITE (DONT EMPTY SILO)/A015 / LOGICAL READ(12BIT) =READ AND COMPARE SILO TO BUFFER /A015 / PHYSICAL READ=READ AND COMPARE SILO TO BUFFER /A015 / /---------------------------------------------------------------/A015 RX2SYS, 0 / ENTRY POINT TO "RX2SYS". DCA RZEXIT /SET RETURN FIELD(IN ACC UPON ENTRY) TAD RZCDF0 / BUILD PROPER "CDF",... RDF / ...TO KNOW WHICH DATA FIELD,... DCA RZCCDF / ......DRIVER WAS CALLED FROM. JMS RZARGS / LOAD TABLE HEAD. RZACNT, RZDRIV-RZARGS / COUNT OF # OF ARGUMENTS PASSED. RZCTLR, / * LOCAL STORAGE FOR THE CONTROLLER #. RZDRIV, 0 / LOCAL STORAGE FOR DRIVE # ( 0-3 ). PYSECT, / SECTOR NO FOR PHYSICAL I/O RZBLKN, 0 / LOCAL STORAGE FOR START BLOCK # ON DISKETTE. RZBCDF, 0 / LOCAL STORAGE FOR "CDF" OF BUFFER FIELD. RZBPTR, 0 / LOCAL STORAGE FOR BUFFER ADDRESS WITHIN FIELD. RZBCTR, 0 / LOCAL STORAGE FOR # OF BLOCKS TO TRANSFER. PYTRAK, 0 /TRACK NO FOR PHYSICAL IO RZXDIR, 0 / LOCAL STORAGE FOR TRANSFER DIRECTION. RZUNIT, / * LOCAL STORAGE FOR UNIT #. RZARGS, 0 / ENTRY POINT TO "RXARGS". TAD RZACNT / LOAD COUNT OF ,... DCA RZACTR / ...NUMBER OF ARGUMENTS PASSED. RZARG1, ISZ RZARGS / UPDATE POINTER TO ADDR. OF NEXT LOCAL ARG. RZCCDF, CDFSYS / * "CDF" TO CALLER FIELD. /M033 TAD I RX2SYS / LOAD ARGUMENT,... CDFSYS / ENSURE LOCAL DATA FIELD. /M033 ISZ RX2SYS / ...UPDATE TO ADDRESS OF NEXT ARGUMENT,... DCA I RZARGS / ......STORE ARGUMENT LOCALLY,... ISZ RZACTR / ALL ARGUMENTS PASSED ? JMP RZARG1 / NO - RETREIVE NEXT. /--------------------------------------------------------------------- / /************************ INITIALISE/SET RETRY PARAMETERS ************ / /--------------------------------------------------------------------- TAD RZRTCT / LOAD THE RE-TRY COUNT,... DCA RZECTR / ...AND SAVE IT. /--------------------------------------------------------------------- / /************************ SELECT SPECIFIED CONTROLLER **************** / /--------------------------------------------------------------------- /--------------------------------------------------------------------- / FOR DECMATE I / / RZDRIV = 0,1 SEL DRIVE 0 UNIT 0,1 / RZDRIV = 2,3 SEL DRIVE 1 UNIT 0,1 / / / FOR DECMATE II / / / RZDRIV = 0,1 SEL DRIVE 0 UNIT 0,1 HEAD 0 / RZDRIV = 4,5 SEL DRIVE 0 UNIT 0,1 HEAD 1 / RZDRIV = 2,3 SEL DRIVE 1 UNIT 0,1 HEAD 0 / RZDRIV = 6,7 SEL DRIVE 1 UNIT 0,1 HEAD 1 / /-------------------------------------------------------------------- IFDEF WINNIE < TAD RZXDIR /FUNCTION CODE /A032 SPA /=PHYIO? /A032 /M036 CMA /YES /A032 /M036 RAR /WINNIE BIT IN LINK /A032 /M036 SZL /=WINNIE? /A032 /M036 JMP ISAWIN /TAG SPEAKS FOR ITSELF /A036 /D036 JMS WINCHK /CHECKS FOR WINNIE RETRNS IF NOT/A032 CLA /NOT CLEAR ON RETURN /A032 > /END IFDEF WINNIE /A032 IFDEF CONDOR < IFNDEF LOAD4 < CLA CLL IAC RTL /=4 DEVICE PAIR BIT /A019 AND RZDRIV /GET DRIVE > /END IFNDEF LOAD4 /A027 IFDEF LOAD4 < JMS SET4 /SET UP DRIVE 4 /A027 > /END IFDEF LOAD4 /A027 CLL RTR /SET PAIR BIT(11) /A019 RTR /A019 DCA RZPAIR /SAVE > /A018 CLA CLL CML IAC RAL / YES - 0003 = MASK FOR DRIVE NUMBER. AND RZDRIV / MASK OFF DRIVE NUMBER. RAR / MQL /SAVE UNIT RTR;BSW /SHIFT INTO POS DCA RZUNIT CLA SWP /GET CTRLR IFDEF CONDOR < TAD RZPAIR /ADD PAIR BIT(11) /A019 > /END IFDEF CONDOR /A030 DCA RZSLDV /SAVE PAIR TO BE SELECTED /A020 JMS SELCMD /SET SELECT /A018 /D036 CLA /A006 JMS RZSETB /RESET CDF'S SIZE= .-RX2SYS / /************************ PHYSICAL I/O SET UP AND CALL***************** / /**************** PHYSICAL I/O READS/WRITES ONLY ONE ************ /************* CALL IN RZXDIR IS COMPLEMENT OF READ/WRITE ********* /**************** FOR PHYSICAL I/O ******************** /******************* SECTOR FOR EACH CALL *************** / /----------------------------------------------------------------------- RZBYPS, TAD RZXDIR IFDEF CONDOR < SPA /IS LOGIO? /A025 CMA /NO=PHYSIO COMPL. /A025 AND (1000 /M025 DCA RZ50SW /SET RZ50X SWITCH. 0=NO 1=YES /M025 TAD RZXDIR /C025 > /A018 /M025 SPA /IS PHYSICAL I/O? JMP PHYSIO /YES EJECT / ** -1- ** MORE INITIALIZATION **** /--------------------------------------------------------------------- / /************************ BUILD CONTROLLER COMMAND ******************* / /--------------------------------------------------------------------- LOGIO, DCA RZPAT1 /SAVE FULL COMMAND JMS DVSET /SET DISK VERIFY SW /A015 TAD RZPAT1 AND MSK37 /CLEAR ALL BUT FUNCTION BITS DCA RZXDIR /RESET TAD RZPAT1 AND MSK400 /GET DENSITY BIT SZA CLA /IS SD? IAC /NO. IT IS DD DCA RZDENS /SET DENSITY FLAG 0=SD 1=DD TAD RZ50SW /IS IT RX50 SZA CLA JMP LOGIOA /YES CLEAR MODE SW TAD RZDENS SNA CLA /IF SD SET MODE BIT = 100 CLA IAC BSW /....ELSE IS DD MODE BIT = 000 LOGIOA, DCA RZMODE TAD RZPAT1 /GET FULL CMND AND MSK400 /GET DENSITY BIT TAD RZXDIR /GET CMND AND CONTINUE TAD RZMODE /MODE BIT 5=0 12BIT MODE =1 8BIT MODE TAD RZUNIT / YES - LOAD IN UNIT CODE,... TAD RZHEAD /ADD HEAD BIT FOR X50 DCA RZCMND / ......AND SAVE IT. DCA RZPHSW /CLR PHYS/LOG IO SW 0=LOGIO /--------------------------------------------------------------------- / /************************ CALCULATE LOGICAL SECTOR NUMBER ************ / /--------------------------------------------------------------------- TAD RZ50SW SZA CLA /IS IT RX50? JMP RZINT3 /INTERLEAVE BY 2 IF 50 TAD RZDENS / LOAD THE DENSITY SPECIFIER. SNA CLA / DOUBLE DENSITY ? TAD RZBLKN / NO - MAKE IT *3. RZINT2, TAD RZBLKN / YES - MAKE IT,... RZINT3, TAD RZBLKN / ...ONLY *2. DCA RZLSEC / ......AND SAVE IT. / / RZRTRY, JMS BLKSET /SET BLOCK CNT /c045 TAD RZLSEC / BACK UP THE "LOGICAL" SECTOR #,... DCA RZCSEC / ...AND [RE-]SET THE CURRENT SECT. #. TAD RZBPTR / GET THE CURRENT BUFFER POINTER,... DCA RZBFFR / ...AND SAVE IT FOR A RETRY. JMS RZDIVD / CALCULATE FIRST TRACK/SECTOR VALUES. JMS RZNEXT RZEXIT, CIFSYS /RETURN TOO CALLER /M033 RZ2RET, JMP I RX2SYS /RETURN TO CALLER /D032RZCDIF, CIFSYS /USED TO SET RETURN /M033 MSK37, 37 /MASK MSK400, 400 /DENSITY BIT MASK RZACTR, /A015 RZPAT1, 0 /TEMP STORE /A015 RZ50SW, 0 /0=RX01 OR RX02-- NOT 0=RX50 RZHEAD, 0 /HEAD SIDE IFDEF CONDOR < RZPAIR, 0 /PAIR BIT(11) 1 = 2 RX50 OR RX50 +RX02 /A019 > SIZE= .-LOGIO / / ** -1- ** PAGE 1 DATA AREA **** /--------------------------------------------------------------------- / /************************ OFF-PAGE POINTERS, DATA, ETC. ************** / /--------------------------------------------------------------------- RZCSEC, 0 / * CURRENT SECTOR NUMBER. / RZCDF0, CDFSYS / "CDF 0" INSTRUCTION. /M033 / RZRTCT, -10 / POINTER TO RETRY COUNT. RZLSEC, 0 /LOGICAL SECTOR RZECTR, 0 /ERROR COUNT WORD RZPHSW, 0 /PHYSICAL I/O SW 0=LOGIO 1=PHYS RZDENS, 0 /DENSITY SW /M036 SIZE= .-RZCSEC SPARE= .+177&7600-. PAGE EJECT / ** -2- ** PAGE 2 DOCUMENTATION **** /********************************************************************* / / PAGE 2 / /********************************************************************* / / THIS PAGE OF THE DRIVER CONTAINS ALL OF THE I/O FUNCTIONS / AND CONTROLLER I/O COMMAND PROCESSORS, AND CONCOMMITANT / DATA AREAS. / / A. THE 8 BIT MODE/SINGLE DENSITY, SECTOR 1, DATA / PACKING ROUTINE. / / B. THE 8 BIT MODE/SINGLE DENSITY, SECTOR 1, DATA / UNPACKING ROUTINE. / / C. COMBINED MODE/DUAL DENSITY, READ PRIMITIVE. / / D. COMBINED MODE/DUAL DENSITY, WRITE PRIMITIVE. / / E. THE PHYSICAL I/O CONTROLLER PRIMITIVE. / / F. THE CONTROLLER COMMAND PRIMITIVES. / / G. THE CONTROLLER "DONE"/"ERROR" PROCESSOR PRIMITIVES. / / H. THE PAGE 2 DATA AREA. / /********************************************************************* / ** -2- ** PACKING ALGORITHM **** /********************************************************************* / / THE ROUTINE "DXPACK" PERFORMS A TRANSFORMATION OF A / BLOCK (I.E. 256(10)) OF TWELVE BIT WORDS INTO THREE / 128(10) SECTORS OF 8 BIT BYTES SCHEMATICALLY INDICATED / BY THE FOLLOWING DIAGRAM. / / THE ROUTINE "DXUNPK" REVERSES THIS PACKING ALGORITHM. / / / NOTA BENE - Nx,y INDICATES NIBBLE(BITS 0-3) OF PAGE "x", WORD "y". / WHILE / Bx,y INDICATES BYTE(BITS 4-11) OF PAGE "x", WORD "y". / / !<--------12------->! / !<--4->!<----8----->! / ! N0,0 ! B0,0 ! / ! N0,1 ! B0,1 ! / ! N0,2 ! B0,2 ! / ! N0,3 ! B0,3 ! / . / . / . / ETC. / . / . / . / !N1,127! B1,127 ! / / / / IS TRANSFORMED INTO / / / / ! SECTOR "1" ! ! SECTOR "2" ! ! SECTOR "3" ! / !<-----8----->! !<----8----->! !<----8----->! / ! N0,1 ! N0,0 ! ! B0,0 ! ! B1,0 ! / ! N0,3 ! N0,2 ! ! B0,1 ! ! B1,1 ! / ! N0,5 ! N0,4 ! ! B0,2 ! ! B1,2 ! / ! N0,7 ! N0,6 ! ! B0,3 ! ! B1,3 ! / . . . / . . . / . . . / ETC. + ETC. + ETC. / . . . / . . . / . . . / !N1,127!N1,126! ! B0,127 ! ! B1,127 ! / /********************************************************************* EJECT / ** -2- ** RX01 SECTOR PACKING ROUTINE **** /--------------------------------------------------------------------- / /************************ RX01 SECTOR PACKING ROUTINE **************** / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- DXPACK, 0 / ENTRY POINT TO "DXPACK". JMS RZLCMD / INITIATE A "FILL SILO" OPERATION. DXPAK1, CLA CLL / ENSURE REGISTER CLEAR, "XDR" DOESN'T. RZ1SET, CDFSYS /M033 TAD I RZBTMP / LOAD A DATUM,... AND DXNMSK / ...AND ISOLATE THE HIGH ORDER 4 BITS. ISZ RZBTMP / UPDATE BUFFER ADDRESS TO NEXT DATUM. DXNMSK, 7400 / (NOP)- JUST IN CASE THE "ISZ" SKIPS. -/M033 CLL RTR / ALIGN BITS AGAINST HOB BOUNDARY,... RTR MQL / ...AND SAVE TEMPORARILY. TAD I RZBTMP / LOAD NEXT SEQUENTIAL DATUM,... CDFSYS /RESET /M033 AND DXNMSK / ...AND ISOLATE HIGH ORDER 4 BITS. ISZ RZBTMP / UPDATE BUFFER ADDRESS TO NEXT DATUM. NOP / - JUST IN CASE THE "ISZ" SKIPS. BSW / ALIGN BITS ON LOB BOUNDARY,... CLL RTR / ...COMPLETE BUILD OF 8 BIT BYTE,... MQA / ......BY COMPLETING ALIGNMENT,... JMS I R2XFER / .........THEN TRANSFER TO SILO. JMP DXPAK1 / - REPEAT PROCESS. JMP RZEPRO /ERROR RETURN JMS RZPHYS JMS DYWRIT / DONE - LET "DYWRIT" FINISH IT OFF. JMP I DXPACK / RETURN TO CALLER. SIZE= .-DXPACK EJECT / ** -2- ** RX01 UNPACKING ROUTINE **** /--------------------------------------------------------------------- / /************************ RX01 UNPACKING ROUTINE ********************* / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- DXUNPK, 0 / ENTRY POINT TO "DXUNPK". JMS RZPHYS / EFFECT A "READ SECTOR" OPERATION. JMS RZLCMD / INITIATE AN "EMPTY SILO" OPERATION,... DXUPK1, JMS I R2XFER / TRANSFER A DATUM,... JMP DXCONT /TRANSFER JMP RZEPRO /ERROR RET JMP DXDONE /DONE RETURN DXCONT, AND DXK377 / ...AND ENSURE HIGH ORDER NIBBLE = 0. CLL RTL / ALIGN NIBBLES ONTO BYTE BOUNDARY. MQL / SAVE. MQA / RETREIVE. AND DXBMSK / ISOLATE HIGH ORDER NIBBLE,... CLL RTL / ...COMPLETE ALIGNMENT,... RZ2SET, CDFSYS /M033 DCA I RZBTMP / ......AND INSERT INTO BUFFER. ISZ RZBTMP / UPDATE POINTER TO NEXT BUFFER ADDRESS. DXK377, 0377 / - JUST IN CASE THE "ISZ" SKIPS. / ( == "AND 377 ). MQA / RETREIVE DATUM. AND DXPC77 / ISOLATE NEXT SEQUENTIAL NIBBLE,... BSW / ...ISOLATE INTO HIGH ORDER BYTE,... DCA I RZBTMP / ......THEN INSERT INTO BUFFER. CDFSYS /RESET /M033 ISZ RZBTMP / UPDATE POINTER TO NEXT BUFFER ADDRESS. DXPC77, 0077 / - JUST IN CASE THE "ISZ" SKIPS. / ( == "AND 77 ). JMP DXUPK1 / NO - REPEAT. DXDONE, JMS DYREAD / YES - LET "DYREAD" FINISH IT OFF. JMP I DXUNPK / RETURN TO CALLER. SIZE= .-DXUNPK EJECT / ** -2- ** READ PRIMITIVE **** /--------------------------------------------------------------------- / /************************ READ PRIMITIVE ***************************** / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / / THE FOLLOWING ROUTINE UTILISES A PROPERTY OF THE / RX28 SUBSYSTEM THAT IS MODE DEPENDENT. / / IN 12 BIT MODE: / ALL TRANSFERS TO THE AC FROM THE / INTERFACE REGISTER ARE 12 BIT JAM / TRANSFERS. / / IN 8 BIT MODE: / ALL TRANSFERS TO THE AC FROM THE / INTERFACE REGISTER ARE LOCICAL "OR'S" / INTO BITS 4-11 OF THE AC. / / THUS, IN 12 BIT MODE, THE DATA IN THE AC, ACCESSED / BY THE "TAD I RZBFFR", ARE OVER-WRITTEN BY THE / TRANSFER. IN 8 BIT MODE, HOWEVER, THE DATA TRANSFERRED / IS "OR"ED INTO THE DATA ALREADY IN THE AC ( USUALLY / THE HIGH ORDER FOUR(4) BITS OF A PACKED WORD). / / HENCE, THIS FUNCTION MAY BE EMPLOYED AS A "READ" / PRIMITIVE. / / /--------------------------------------------------------------------- DYREAD, 0 / ENTRY POINT TO "DYREAD". DYRD01, JMS RZPHYS / EXECUTE A "READ SECTOR" OPERATION. JMS RZLCMD / INITIATE "EMPTY SILO" OPERATION. DYRD02, TAD RZXVFY /VERIFY MODE? /A024 SZA /A024 JMP RZ3SET /YES /A024 TAD RZPHSW /PHYSICAL IO SW RZ3SET, CDFSYS /M033 SNA CLA CLL /IF SET DONT ADD CONTENTS OF BUFFER TAD I RZBFFR / LOAD CONTENTS OF BUFFER. CDFSYS /RESET /M033 JMS I R2XFER / LOAD A DATUM. /#(12 BIT MODE = JAM XFER BITS 0-11) /#( 8 BIT MODE = "OR" OF BITS 4-11.) JMP DYCONT /TRDONE JMP RZEPRO /ERROR RETURN JMP DYDONE /DONE RETURN DYCONT, RZ4SET, CDFSYS /M033 /__________________________________________________________/A015 / / VERIFY DISKETTE /A015 / MUST BE LOCATED IN SAME PAGE AREA AS CALLING SUBROUTINE /A015 / ELSE CDF'S AND/OR SECOND BUFFER POINTER NEEDED /A015 / / VERIFY MODE COMPARES BUFFER TO SILO /A015 / RZVJMP, JMP RZXNOV /NOT VERIFY MODE=JMP..NOP=VFY MODE/A015 CIA /A015 TAD I RZBFFR /CHECK AGAINST BUFFER /A015 SNA CLA /A015 JMP DVFCNT /OK CONTINUE /A015 CDFSYS /RESET TO DRIVE FIELD /M033 RZXLOP, CLA /WILL NOT RESET 10 TIMES /A015 JMS I R2XFER /WAIT UNTILL DONE TO CLEAR FLAGS/A015 JMP RZXLOP /TR TRY AGN /A015 JMP RZEPRO /IS ERROR /C024 JMP RZEPRO /IS ERROR /C024 RZXNOV, /A015 DCA I RZBFFR /STORE /A015 DVFCNT, CDFSYS /RESET /M033 / ISZ RZBFFR / UPDATE BUFFER ADDRESS - WRAP ? DXBMSK, SMA CLA / - JUST IN CASE THE "ISZ" SKIPS - / ( == 7700 & WILL NEVER SKIP!!!) JMP DYRD02 / CHECK FOR OPERATION DONE. DYDONE, ISZ RZSCTR / YES - ALL SECTORS PROCESSED ? JMP DYRD01 / NO - PROCESS NEXT. JMP I DYREAD / YES - RETURN TO CHECK FOR END OF REQUEST. /M032 RZVSKP, JMP RZXNOV /VERIFY SKIP INSTRUCTION /A015 SIZE= .-DYREAD EJECT / ** -2- ** WRITE PRIMITIVE **** /--------------------------------------------------------------------- / /************************ WRITE PRIMITIVE **************************** / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- DYWRIT, 0 / ENTRY POINT TO "DYWRIT". DYWRT1, JMS RZLCMD / INITIATE A "FILL SILO" COMMAND. DYWRT0, CLA CLL / RZ5SET, CDFSYS /M033 TAD I RZBFFR /UPDATE BUFFER ADDR CDFSYS /RESET /M033 JMS I R2XFER /TRANSMIT JMP DYCNT1 /TRANSMIT RETURN JMP RZEPRO /ERROR RETURN JMP DYDNE /DONE RETTURN DYCNT1, ISZ RZBFFR NOP /NECESSARY WHEN REACH END OF FLD JMP DYWRT0 /NEXT DYDNE, JMS RZPHYS / YES - EXECUTE A "WRITE SECTOR" OPERATION. ISZ RZSCTR / ALL SECTORS PROCESSED ? JMP DYWRT1 / NO - DO NEXT. JMP I DYWRIT / YES - RETURN TO CHECK FOR END OF REQUEST. /M032 SIZE= .-DYWRIT / /M032 /CHECK FOR PHYSICAL IO /M032 / RETURN+1 IF SWITCH=1 /M032 / CHKPHY, 0 /M032 CLA /M032 TAD RZPHSW /PHYS IO? /M012 /M032 SZA CLA /A012 /M032 ISZ CHKPHY /A012 /M032 JMP I CHKPHY /A012 /M032 /***************************************************** EJECT / /____________________________________________________________/A015 / FOLLOWING MAY NOT BE NECESSARY TO RESET TO WRITE UPON EXIT/A015 / TO BE RECHECKED ?A015 /_______________________________________________________________/A015 DVSETW, 0 CLA CLL CMA RTL /7775 /A015 AND RZCMND /CLEAR READ BIT /A015 DCA RZCMND /A015 JMP I DVSETW /A015 / / RZXVFY, 0 /VERIFY MODE SWITCH /A015 / ** -2- ** PAGE 2 DATA AREA **** /--------------------------------------------------------------------- / /************************ OFF-PAGE POINTERS, DATA, ETC. ************** / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- RZCMND, 0 / * CONTROLLER COMMAND WORD. RZBFFR, 0 / * RUNNING BUFFER ADDRESS. RZBTMP, 0 / * TEMPORARY BUFFER POINTER. RZTRAK, 0 / * THE PHYSICAL TRACK NUMBER. RZSECT, 0 / * THE PHYSICAL SECTOR NUMBER. RZSCTR, 0 / * SECTOR COUNTER. / / R2XFER, RZXFER /POINTER TO "RZXFER ROUTINE SIZE= .-RZCMND SPARE= .+177&7600-. PAGE EJECT /-------------------------------------------------------------------- / /************************ PHYSICAL I/O SET UP AND CALL***************** / /**************** PHYSICAL I/O READS/WRITES ONLY ONE ************ /************* CALL IN RZXDIR IS COMPLEMENT OF READ/WRITE ********* /**************** FOR PHYSICAL I/O ******************** /******************* SECTOR FOR EACH CALL *************** / /----------------------------------------------------------------------- PHYSIO, CMA / DCA RZXDIR /RESET CALL /D032 IAC /PHYSICAL IO SW FOR DVSET /A015 JMS DVSET /SET VERIFY SW /A015 CLA CLL IAC BSW /100 AND RZXDIR /MASK COMPUTED MODE BIT DCA RZMODE /SET MODE CALLED FOR TAD RZUNIT /ADD UNIT NO TAD RZHEAD /HEAD 0/1 FOR RX50 TAD RZXDIR AND KON536 /MASK OUT COMMAND BITS DCA RZCMND / SAVE COMMAND /PHYSIO DENSITY BIT USED ONLY AS SW /IN LDCMND ROUTINE TAD RZXDIR /GET MODE TO RESET DENSITY SW AND (400 /DENSITY BIT /A011 SZA CLA /CHECK DENSITY /A011 IAC /IS DBLE DEN /A011 DCA RZDENS /... SET ACTUAL DENSITY FOR THIS DSKETTE TAD PYTRAK DCA RZTRAK /SET TRACK TAD PYSECT DCA RZSECT /SET SECTOR RZPHIO, /M025 CLA IAC /RETRY I/O ERR /C016 /C025 DCA RZPHSW /SET PHYSICAL IO SW=-1 TAD RZBPTR /BUFFER POINTER /M025 DCA RZBFFR /RESET /M025 CMA /-1 /M016 DCA RZSCTR /SET TO READ ONLY 1 SECTOR /M016 TAD RZCMND JMS RZXJMP /SET JMP TO FUNCTION RZWRIT /FUNCTION 0=WRITE RZREAD / 2=READ RZFRMT / 4=FORMAT DSKETTE RZLDEN / 6=GET DENSITY RZEXT / 10=IGNORE RZDSTY / 12=READ ERROR STATUS TRCON, /SPACE WARS /M011 RZXJMP, 0 CLL RAR / /2 AND KON7 TAD RZXJMP /GET ADDR DCA RZXJMP /SAVE LOC TAD I RZXJMP DCA RZXJMP JMP I RZXJMP /EXEC RZFRMT, TAD KYWORD /KEYWORD TO SET DENS RZDSTY, DCA TRCON /111 FOR TRNSFER 0 FOR DONE RZFUNC, AC0004 /EXECUTE PHYSICAL IO FUNCTION /M033 JMS RZLCMD /D019 JMP RZERR1 /ERR TAD TRCON SKP /SET FOR TRNSFER CLA /SET FOR DONE RETURN JMS RZXFER /READ STATUS JMP .-2 /CHECK DONE JMP RZERR6 /ERR RET JMP I R3RET /DONE RETURN RZREAD, JMS DYREAD /GO READ IT JMP I R3RET /EXIT RZWRIT, JMS DYWRIT /WRITE IT JMP I R3RET /EXIT RZLDEN, JMS RZIDEN /GET DENSITY RZEXT, JMP I R3RET /EXIT R3RET, RZEXIT /DONE RET EJECT / ** -1- ** RX01/RX02 PROCESS DISPATCHER **** /--------------------------------------------------------------------- / /************************ RX01/RX02 PROCESS DISPATCHER *************** / / THIS IS THE MAIN I/O PROCESSOR - ALL I/O LOOPS THROUGH THIS / ROUTINE. / / THE FOLLOWING DISPATCH ROUTINE IS BASED UPON AN INDEX, A SUM / CALCULATED FROM THE DENSITY FUNCTION, AND THE I/O FUNCTION / AS FOLLOWS: / / SD DD / RZDENS 0 1 / / WRITE READ / RZXDIR 0 2 / / THEREFORE, / / "INDEX" 0 => SINGLE DENSITY/WRITE. / 1 => DOUBLE DENSITY/WRITE. / 2 => SINGLE DENSITY/READ. / 3 => DOUBLE DENSITY/READ. / /--------------------------------------------------------------------- RZNEXT, 0 RZNXTA, TAD RZBFFR / SET/RE-SET TEMPORARY BUFFER,... DCA RZBTMP / ...POINTER FOR PACK/UNPACK ROUTINES. TAD RZ50SW SNA CLA /IS IT RX50? TAD (-1 /NO INTERLEAVE 2 TAD (-1 /YES INTERLEAVE 1 DCA RZSCTR / ...SECTOR COUNT,... TAD RZXVFY /CHECK VERIFY MODE /A015 SZA CLA /A015 CLA CLL IAC RTL /=4 ADD TO TABLE FOR VERIFY MODE/A015 RZNXTB, TAD RZDENS / LOAD THE DENSITY CODE,... TAD RZXDIR / ...AND BUILD DISPATCH CODE. JMS RZDISP / LOAD THE TABLE HEAD. DXPACK / SD/8 BIT WRITE. DYWRIT / DD/12 BIT WRITE. DXUNPK / SD/8 BIT READ. DYREAD / DD/12 BIT READ. DVPACK /8BIT SD WRITE WITH VERIFY /A015 DVWRIT /12BIT DD WRITE WITH VERIFY /A015 RZVERF /8BIT SD READ VERIFY(NOT ALLWD LOGIO) /A015 DVREAD /12BIT DD READ VERIFY(ALLWD LOGIO)/A015/C024 RZDISP, 0 / TABLE ENTRY ADDRESS/DISPATCH ADDRESS. TAD RZDISP / BUILD,... DCA RZDISP / ...DISPATCH,... TAD I RZDISP / ......ADDRESS,... DCA RZDISP / .........THEN,... JMS I RZDISP / .................AND DISPATCH. ISZ RZBCNT / REQUEST COMPLETE ? /C045 JMP RZNXTA / NO - DO ANOTHER BLOCK. JMP I RZNEXT / ...AND EXIT DRIVER. /M032 SIZE= .-RZNEXT /SPACE WARS MOVE VERSION 034 / DVSETR, 0 CLA CLL IAC RAL /=2 /A015 /M034 TAD RZCMND /ADD /A015 /M034 DCA RZCMND /RESET /A015 /M034 JMP I DVSETR /A015 /M034 / EJECT KYWORD, 111 /KEYWORD TO FORMAT DENSITY /M032 KON536, 536 /MASK 9 BIT =HEAD/SCND SIDE RX50 KON7, 7 SPARE= .+177&7600-. PAGE EJECT / ** -2- ** PHYSICAL I/O PRIMITIVE **** /--------------------------------------------------------------------- / /************************ PHYSICAL I/O PRIMITIVE ********************* / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- RZPHYS, 0 / ENTRY POINT TO "RZPHYS". AC0004 / SET IN THE "PHYSICAL I/O" BIT,... /M033 JMS RZLCMD / ...AND TRANSMIT COMMAND TO CONTROLLER. TAD RZSECT / LOAD THE PHYSICAL SECTOR,... JMS RZXFER / ...AND TRANSMIT IT. JMP RZCNT1 /TR DONE RETURN JMP RZEPRO /ERROR RETURN JMP RZERR3 /SHOULD NOT GET DONE RETURN RZCNT1, CLA CLL / ENSURE REGISTER CLEAR, "XDR" DOESN'T. TAD RZTRAK / LOAD THE PHYSICAL TRACK,... JMS RZXFER / ...AND TRANSMIT IT TOO. JMP RZCNT2 /TR RETURN JMP RZEPRO /ERROR RETURN JMP RZERR3 /SHOULD NOT GET DONE YET RZCNT2, JMS CHKPHY /CHECK PHYSIO SKIP ONE IF TRUE /A012 JMS RZDIVD /THEN CALCULATE THE NEXT TRACK AND SECTOR./M012 JMS RDNSWP /DO SWAP IF DONE /A026 /DONE RETURN CDFSYS / RESTORE OUR DATA FIELD,... /M033 JMP I RZPHYS / YES - RETURN TO CALLER. /M032 SIZE= .-RZPHYS EJECT / ** -2- ** CONTROLLER PRIMITIVES **** /--------------------------------------------------------------------- / /************************ CONTROLLER FUNCTION PRIMITIVE ************** / /!!!!!!!!!!!!!!!!!!!!!!!! NOTA BENE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /!!!!!!!!!!!!!!!!!!!!!!!! END NOTE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / /--------------------------------------------------------------------- RZLCMD, 0 / ENTRY POINT TO "RZPHYS". TAD RZCMND / LOAD THE COMMAND,... RZIO01, RXILCD / SUBMIT COMMAND, OR FIRST BYTE OF, /M033 / TO CONTROLLER,... TAD RZMODE / ...8 BIT MODE OPERATION ?,... SNA CLA JMP INCRET /NO 12 BIT TAD RZDENS /SET 2ND HALF OF WORD FOR LCD /A011 RZLCM2, JMS RZXFER / .........YES - SEND OUT SECOND BYTE,... JMP INCRET /NORMAL RETURN JMP RZERR1 /ERROR RETURN /C019 JMP RZERR1 /DONE RETURN=ERROR /C019 INCRET, /C019 CLA /CLEAR FOR 8 BIT DD TRNSFER JMP I RZLCMD / /M032 /*****RZLCM3 MUST BE LOCATED ON SAME PAGE AS RZLCM2 /A024 RZLCM3, JMS RZXFER /CONSTANT USED TO OVERLAY RZLCM2 /A024 /****************** /A024 /--------------------------------------------------------------------- / /************************ CONTROLLER READY PRIMITIVE ***************** / / THE DATA FIELD OF THIS ROUTINE IS THE SPECIFIED BUFFER FIELD. / /************************ CONTROLLER DATA TRANSFER PRIMITIVE ********* / /************************ OPERATION COMPLETE/ERROR PROCESSOR ********* / /--------------------------------------------------------------------- RZXFER, 0 /ENTRY POINT RZXRDY, /RZXRDY USED TO CHECK ASSEM REF ERRS(TEMP) RZIO02, RXISTR /TRANS READY? /M033 JMP RZDONE /NO CHECK DONE RZIO03, RXIXDR /YES TRANSFER /M033 JMP I RZXFER /TRANSFER COMPLETE RETURN /M032 RZDONE, /RZDONE TEMP TO CHECK REFERENCES RZIO04, RXISDN /OP COMPLETE /M033 JMP RZXRDY /NO CHECK TRANSFER RZIO05, RXISER /ANY ERROR /M033 JMP RZNOER //NO JMS RZTMPE / ERROR ROUTINE JMP RZERXT /YES RZNOER, CLA /A007 ISZ RZXFER /SET DONE RETURN RZERXT, ISZ RZXFER /SET ERROR RETURN JMP I RZXFER /M032 RZTMPE, 0 / ERROR ROUTINE CLA /A011 RXIXDR /GET STATUS /M033 AND M377 DCA RZSTAT /TO RZSTAT (FOR RZIDEN). /M003 TAD RZCMND /GET DEVICE NO AND KON20 TAD KON16 /ERR STATUS CODE RXILCD /TRNSFER /M033 RXISDN /M033 JMP .-1 RXIXDR /M033 AND M377 DCA RZERST /SET ERROR STATUS JMP I RZTMPE / KON20, 20 KON16, 16 RZMODE, 0 /MODE SW: 0=12(DD) BIT MODE 1=8(SD) BIT MODE / M377, 377 EJECT / ** -3- ** PAGE 3 DOCUMENTATION **** /********************************************************************* / / PAGE 3 / /********************************************************************* / / THE FOLLOWING PAGE CONTAINS ALL OF THE UTILITY ROUTINES / USED BY THE PAGE 1, AND PAGE 2 ROUTINES, PLUS THE ASSOCIATED / DATA AREAS. / / A. THE ERROR PROCESSOR. / / B. THE EXTERNAL/INTERNAL DENSITY DETERMINATION ROUTINES. / / C. THE TRACK,SECTOR AND INTERLEAVE ROUTINES. / / [D. THE OPTIONAL I/O WAIT ROUTINE-USED ONLY IF ALL ELSE FAILS.] / / E. THE PAGE 3 DATA AREA. / /********************************************************************* / ** -3- ** ERROR PROCESSOR **** /--------------------------------------------------------------------- / /************************ PROCESSES ERRORS/RE-TRY ******************** / /--------------------------------------------------------------------- RZEPRO, IFDEF CONDOR < JMS CKWPRO /CHECK IF WRITE PROTECT ERROR /A026 JMP RZERR2 /YES IT IS(DON'T) RETRY 10 TIMES/A026 > /END ENDIF CONDOR /A026 TAD I R2BPTR / ......AND THE,... DCA I R2BFFR / .........BUFFER ADDRESS. JMS RZINCR /CHECK INIT COUNT /M016 TAD RZXVFY /IS VERIFY MODE /A016 SZA CLA /A016 JMP RZERR8 /YES. /A016 TAD RZPHSW /IS PHYSIO? /A007 SZA CLA /A007 JMP RZERR6 /YES /A007 RZXPRC, TAD I R2CSEC / RE-SET THE OFFENDING,... DCA I R2LSEC / ...SECTOR NUMBER,... ISZ I R2ECTR / RETRY COUNT EXHAUSTED ? JMP I R2RTRY / NO - RE-TRY THIS OPERATION. JMP RZERR2 /PROCESS ERROR 2 / / RZERR8, TAD RZPHSW /IT IS VERIFY MODE BUTIS PHYSIO?/A016 SNA CLA /C044 /D044 JMP RZERR7 /YES /A016 /D044 JMS DVSETW /NO IT'S LOGIO WRITE WITH VERIFY/A016 JMP RZXPRC /....AFTER SETTING TOWRITE CONT../A016 / RZERR7, TAD RZCMND /CHECK COMMAND LAST PERFORMED /A016 AND KON16 SNA CLA /0=WRITE 2 =READ.... /A016 JMP RZERRR /WAS WRITE(WOULD BE FLUKE IF OCCURED)/A016 JMS DVSETW /SET TO WRITE /A016 CMA /A016 DCA RZSCTR /SET SECTOR COUNT /A016 JMS DYWRIT /WRITE IT /A016 RZERRR, JMS DVSETR /SET READ /A016 JMP RZERR6 /DO IT /A016 SIZE= .-RZEPRO EJECT / ** -2- ** PAGE 2 DATA AREA **** /--------------------------------------------------------------------- / /************************ OFF-PAGE POINTERS, DATA, ETC. ************** / /--------------------------------------------------------------------- RZERST, 0 / * ERROR-STATUS WORD. / / R2EXIT, RZEXIT / LINK TO EXIT CODE. / R2RTRY, RZRTRY / POINTER TO "RZRTRY". R2CSEC, RZCSEC / POINTER TO "RZCSEC". R2BPTR, RZBPTR / POINTER TO "RZBPTR". R2BFFR, RZBFFR / POINTER TO "RZBFFR". R2ECTR, RZECTR / POINTER TO "RZECTR". R2LSEC, RZLSEC /POINTER TO "RZLSEC" / /m 050 this routine moved here in V2.5 / / THIS ROUTINE ENTERED FOR 12 BIT LOGICAL READ AND VERIFY /M027 / DVREAD, 0 /M032 JMS DYREAD /READ AND COMPARE SILO /M032 JMP I DVREAD /M032 / / END SPACE WARS SPARE= .+177&7600-. PAGE EJECT / / /************************ INTERNAL CALL DENSITY PROCESSOR ************ / /--------------------------------------------------------------------- RZIDEN, 0 / ENTRY POINT TO "RZIDEN". IFDEF WINNIE < JMP CHKWIN /CHECK WINNIE(SPACE WARS CLUGE) /A032 > /END IFDEF WINNIE /A032 /.....NOT A WINNIE RETURN /A032 / NOWINI, DCA I R3CMND /CLEAR COMMAND TEMP DCA I R3MODE /ENSURE 12 BIT MODE FOR LOAD STATUS CMND TAD I R3UNIT /UNIT NO TAD CON12 /101X BIN READ STATUS JMS RZLCMD /EX CMMND /# "SINGLE DENSITY" /# "12 BIT MODE" / ...OPERATION. DCA RZDLCT /SET DELAY COUNT /A022 TAD KONDLY /DELAY CONSTANT 7421(SNL) /A023 DCA RZDLC2 /OUTSIDE LOOP=-APPROX 240 DEC /A023 JMP RZDELY /*********************** RZIO10, RXISDN /DONE FLAG SET? /M033 JMP RZDELY /INC TIMEOUT /A022 RZIO11, RXISER /IS THERE ANY ERROR /M033 JMP RZDNOK /NO DONE IS OK /A022 JMS RZTMPE /READ ERROR STATUS /A022 JMP RZPASS /GET STATUS /A022 RZDNOK, /A022 RZIO07, RXIXDR /READ STATUS /M033 DCA RZSTAT /SAVE STAT TEMP RZPASS, TAD RZSTAT AND (377 /CLEAR UNUSED BITS DCA RZSTAT TAD (200 /DEVICE READY? AND RZSTAT SNA CLA /IS READY? JMP RZERR5 /NO CLA IAC BSW /100=RX50 BIT /A023 AND RZSTAT / /C023 SNA CLA /IS IT A 50 JMP NOTA50 CLA CLL IAC RAL /=2 /A024 JMS RZSETX /SET TYPE /A024 TAD RZSTAT AND (1000 /2ND HEAD AVAILABLE SZA CLA IAC /SET DENS TO 3 TAD (2 /2=RX50 ONE SIDE 3=RX50 2 SIDES JMP RZSETF /SET DENSITY NOTA50, TAD RZSTAT / GET STATUS /A002 AND (10) / ISOLATE THE RX02 BIT. /A002 JMS RZSETX /SET UP FOR RX02/RX01 /A024 TAD RZSTAT /GET STATUS AND (40 /MASK DENSITY BIT SZA CLA /IS IT READY? IAC /DD RZSETF, DCA I R3DENS /SET DENSITY 0=SD 1=DD /............3=RX50 ONE SIDE /............4=RX50 TWO SIDE RZCNT3, TAD I R3DENS /GET WORKING DENSITY JMP I RZIDEN / - RETURN. /M032 RZSTAT, 0 /SAVE STATUS JUST READ /.....BIT 6 = DENSITY(0=SD) CON12, 12 RZDLCT, 0 /DELAY COUNT INITIALIZED TO 0 TO APPROX 18.4 MSEC/C022 RZDLC2, 0 /OUTSIDE LOOP (-240 APPROX.) =5SEC TOTAL/A023 SIZE= .-RZIDEN EJECT / ** -3- ** TRACK, SECTOR AND INTERLEAVE **** /--------------------------------------------------------------------- / /************************ TRACK/SECTOR-INTERLEAVE PROCESSOR ********** / / THE FOLLOWING ROUTINE IS A "ONE'S COMPLEMENT" DIVIDE / ROUTINE. / / THE QUOTIENT IS RETURNED AS THE ONE'S COMPLEMENT / OF THE TRUE QOUTIENT, WHILE THE REMAINDER IS RETURNED / AS A POSITIVE NUMBER, GREATER OR EQUAL TO ZERO, AND LESS / THAN THE DIVISOR. / / THE MAXIMUM NUMBER OF ITERATIONS THAT MAY BE EXECUTED FOR / TRACK/SECTOR CALCULATIONS IS TEN(10) DECIMAL. THUS, THE / MAXIMUM TIME THAT MAY BE SPENT WITHIN THE DIVIDE ROUTINE / PROPER FOR THE MAXIMUM BLOCK COUNT (<=1001(10)) IS ABOUT / 1.2 MILLISECONDS, FOR ALL OTHER SUCH CALCULATIONS, / PROPORTIONATELY LESS. / / ADJUSTMMENT OF THE TRACK NUMBER, IN THE ROUTINE, "RZINTL" / TO THE RANGE OF 1<=TRACK<=77, IS ACCOMPLISHED BY A "CIA" / INSTRUCTION, SIMULTANEOUSLY 1'S ORIGINING THE TRACK, AND / BUILDING A POSITIVE NUMBER. FOR A TRUE DIVIDE THE QUOTIENT / MUST BE MADE POSITIVE BY MEANS OF A "CMA" INSTRUCTION. / /--------------------------------------------------------------------- RZDIVD, 0 / ENTRY POINT TO "RZDIVD". CLA MQL / INIT. THE RESIDUE,... TAD RZ50SW /RX50 SW SNA CLA /IS IT SET TAD RZ02DV /DIVISOR FOR RX01/RX02 TAD RZ50DV /DIVISOR FOR RX50 DCA RZDVSR /SET IT UP(10 SECTORS FOR 50__26 FOR 01/02) CMA CLL CML / ...AND THE QUOTIENT,... DCA I R3TRAK / ......(THE PHYSICAL TRACK ~). TAD I R3LSEC / LOAD THE LOGICAL SECTOR #. SNA / LOGICAL SECTOR = 0 ? JMP RZINTL / YES - JUST INTERLEAVE. RZDIV0, RAL / NO - NORMALISE,... KONDLY, SNL / ...THE LOGICAL SECTOR,... /C023 JMP RZDIV0 / ......NUMBER. RZDIV1, DCA I R3SECT / SAVE THE CALCULATED PHYSICAL SECTOR. MQA / LOAD RESIDUE. RAL / SHIFT,... MQL / ...AND SAVE. MQA / RETREIVE RESIDUE. TAD RZDVSR / "SUBTRACT" DIVISOR (# SECTORS/TRACK). SMA / OVERFLOW ? MQL / NO - SAVE VALUE. CLA CML / YES - CLEAR REGISTER, FIX LINK. TAD I R3TRAK / RETREIVE QUOTIENT. RAL / SHIFT AND,... DCA I R3TRAK / ...SAVE. TAD I R3SECT / RETREIVE SECTOR,... CLL RAL / ...AND SHIFT. SZA / DONE ? JMP RZDIV1 / NO - REPEAT. / YES - TIME TO INTERLEAVE. SIZE= .-RZDIVD /--------------------------------------------------------------------- / /************************ INTERLEAVE SECTORS ************************* / /--------------------------------------------------------------------- RZINTL, MQA / RETREIVE QUOTIENT. CLL RAL / BUILD 2*Q. DCA I R3SECT / SAVE 2*Q. TAD RZ50SW / GET DENSITY INDICATOR (0=SD,1=DD). SNA CLA /RX50 INTERLEAVE 2 ELSE 3 MQA / NO - LOAD "Q". TAD I R3SECT / YES - BUILD CORRECT INTERLEAVE FACTOR. RZDIV2, DCA I R3SECT / SAVE "PHYSICAL" SECTOR #. TAD RZ50SW /A018 SZA CLA /IS A 50? /A018 TAD I R3DENS /.YES. ADJUST MODULUS FOR DENSITY TYPE/M018 TAD I R3SECT / RETREIVE "PHYSICAL" SECTOR #. TAD RZDVSR / "SUBTRACT" # SECTORS/TRACK. SMA SZA / OVERFLOW ? JMP RZDIV2 / NO - REPEAT UNTIL OVERFLOW. ISZ I R3SECT / YES - ADD 1 TO BUILD CORRECT PHYSICAL SECTOR. CLA TAD I R3TRAK / LOAD THE PHYSICAL TRACK #,... CIA / ...ADJUST TO RANGE 1<=TRK<=77.,... DCA I R3TRAK / ......AND SAVE IT FOR CALLS. ISZ I R3LSEC / UPDATE LOGICAL SECTOR. JMP I RZDIVD / RETURN TO CALLER. /M032 SIZE= .-RZINTL EJECT / ** -3- ** PAGE 3 DATA AREA **** /--------------------------------------------------------------------- / /************************ OFF-PAGE POINTERS, DATA, ETC. ************** / /--------------------------------------------------------------------- / RZDVSR, 0 / TRACK/SECTOR DIVISOR. RZ02DV, -20 /DIVISOR FOR RX01/2=-(20+12) RZ50DV, -12 /DIVISOR FOR RX50=10 DEC. / / R3DENS, RZDENS / POINTER TO "RZDENS". R3TRAK, RZTRAK / POINTER TO "RZTRAK". R3SECT, RZSECT / POINTER TO "RZSECT". R3LSEC, RZLSEC / POINTER TO "RZLSEC". R3UNIT, RZUNIT / POINTER TO "RZUNIT". R3CMND, RZCMND / POINTER TO "RXCMND". R3MODE, RZMODE /POINTER TO "RZMODE" SIZE= .-RZDVSR SPARE= .+177&7600-. PAGE EJECT /************************************************************/A026 / / THIS ROUTINE SET UP TO CHECK DONE. IT RETURNS IF DONE SET /A026 / IF ERROR OR TRANSFER FLAG SET GOES TO APPROP. ERROR ROUTINE/A026 / / RDOSWP defined in WPF1 overlayed by WPCU2 after / initialization done. allows swaping of tasks / pending read/write done being set / If error on RDOSWP ... WPF1 must change / to = address in dskhnd.... currently=6412 / / /************************************************************/A026 RDNSWP, 0 /A026 RNOSWP, RXISTR /TRNSFER READY /M033 JMP RNOXDR /NO CHECK DONE /C028 RXIXDR /CLEAR IT /M033 JMP RZERR4 /TRANSFER READY ILLEGAL /A026 RNOXDR, RXISDN /DONE? /M033 JMP RDOSWP /A032 / / /D032ROVSWP, JMP RNOSWP /CHECK TRANSFER /C028 RXISER /ERROR? /M033 JMP I RDNSWP /A026 JMP RZEPRO /PROCESS ERROR /A026 RDOSWP, CLA /OVERLAYED WITH JSWAP /C028 JMP RNOSWP /A032 /*********************************************************/A018 / / THIS ROUTINE SELECTS THE DEVICE PAIR AS SPECIFIED IN AC /A018 / IF DONE IS SET IT RETURNS ...CALL+1 / ELSE AFTER TIMEOUT / INITIALIZES DISKETTES AND TAKES ERROR RETURN / ...WITH 5777 IN AC... BIT 0=ERROR / BITS 1,2,3 =101 FOR DENSITY DEVICE NOT/A018 / .......................READY / BITS 4-11 =377 UNIQUE ERROR CODE /A018 / ..............FOR LATER USE /A018 /************************************************************/A018 SELCMD, 0 TAD RZSLDV /GET PAIR /M022 RXI00A, RXISEL /SELECT DRIVE PAIR /M033 RXISEL /SELECT DRIVE PAIR(in case drves 6-7) /M033 CLA /SET COUNT /M022 /SET UP TRANSFER FOR LOAD COMMAND. 0 FOR RX01 / SECOND TRANSFER JMS RZXFER FOR RX02(RX50) /A024 / / TAD RZDRIV /GET DRIVE # /A024 AND KON07 /MASK IT /A024 TAD TBLPTR /TABLE POINTER /A024 DCA USEPTR /SET IT UP /A024 TAD I USEPTR /GET SWITCH CODE /A024 SZA CLA /IS RX01 OR RX02(50) TYPE /A024 TAD RZLCM3 /GET JMS RZXFER FRO RX02(50) /A024 DCA RZLCM2 /SET CODE OR 0 /A024 / RXI00B, /M022 SELRPT, /M022 RXISDN /DONE /M033 NOP /M022 JMP I SELCMD /RETURN /M022 RZSLDV, 0 /DEVICE PAIR SELECTED /M022 /---------------------------------------------------------------/A016 / IF RX50 THIS ROUTINE WILL INIT DISK PRIOR TO RETRY /A022 / THEN WILL SEEK TO TR 079 TILL ERRCOUNT IS EXHAUSTED /A022 /---------------------------------------------------------------/A016 RZINCR, 0 /DO INIT AFTER 5 RETRIES /A005 JMS RZSEEK /CHECK TIME TO SEEK 079 /A022 JMP I RZINCR /RETURN W/O INIT /A022 RZIO06, RXIINI /INIT DSK /M033 RZIO00, RXISDN /WAIT DONE /M033 JMP .-1 JMS SELCMD /SELECT PAIR /A020 JMP I RZINCR /RET RZSEEK, 0 JMS RZCHKH /CHECK HALT /A026 TAD RZ50SW /IS RX50? /A022 SNA CLA /A022 JMP RZSEK1 /NO SET RETURN +1 /A022 TAD RZECTR /ERROR COUNT /A023 TAD KON10 /1ST TIME /A023 SNA /A023 JMP RZSEK1 /YES INITIALIZE /A023 TAD MIN4 /A023 SMA CLA /G.T. THAN 4 TIMES /A023 TAD KON79 /YES SEEK TRACK 79 /A023 DCA RZSEKT /IF NO SEEK TRACK 0 /A023 TAD RZCMND /LOAD COMMAND /A022 AND KON20 /MASK DRIVE BIT /A022 TAD KON406 /DENSITY AND READ /A022 RXILCD /LOAD COMMAND /M033 CLA IAC /=1 (SECTOR) /A022 RXISTR /TRANSFER READY? /M033 JMP .-1 /NO /A022 RXIXDR /YES --TRANSFER /M033 CLA /CLEAR SECTOR /A023 TAD RZSEKT /GET TRACK NO /C023 RXISTR /TRANSFER READY? /M033 JMP .-1 /NO /A022 RXIXDR /YES --TRANSFER /M033 RXISDN /DONE? /M033 JMP .-1 /NO /A022 RXISER /ERR? /M033 JMP RZSEK2 /NO /A022 RZSEK1, ISZ RZSEEK /YES INIT ANYWAY /A022 RZSEK2, CLA /A022 JMP I RZSEEK /A022 / / / SET CODE FOR RX01 OR RX02(50) TYPE DEVICE /A024 / 0=RX01 10=RX02 2=RX50 /A024 RZSETX, 0 /A024 MQL /SAVE CODE /A024 TAD RZDRIV /GET DRIVE /A024 AND KON07 /MASK NUMBER /A024 TAD TBLPTR /GET POINTER TO TABLE +OFFSET /A024 DCA USEPTR /USER POINTER /A024 MQA /GET SWITCH /A024 DCA I USEPTR /STORE IT /A024 JMP I RZSETX /A024 / / / THIS ROUTINE IS CALLED DURING THE ERROR RETRY PROCESS /A026 / IS CHECKS TO SEE IF THE DEVICE IS AN RX50 IN WRITE /A026 / PROTECT MODE. /A026 / CKWPRO, 0 /A026 TAD RZ50SW /IS A 50 /A026 SNA CLA /A026 JMP CHKRET /NO RETURN /A026 TAD RZCMND /GET FUNCTION CODE READ /A026 AND KON12 /IS=WRITE /A026 SZA CLA /A026 JMP CHKRET /NO EXIT /A026 TAD RZSTAT /GET STATUS /A026 AND KON10 /WRITE BIT /A026 SNA CLA /IS WRITE PROTECT /A026 CHKRET, ISZ CKWPRO /NO /A026 JMP I CKWPRO /RET /A026 / / / USEPTR, 0 /USED TO SAVE POINTER TO CURRENT DEVICE /A024 TBLPTR, DEVTBL /POINTER TO DEVICE TABLE /A024 / TABLE USED TO SAVE DEVICE TYPE 0=RX01 10=RX02/RX50 /A024 / ALLOWS MIX OF RX01,RX02 AND RX50'S /A024 DEVTBL, 0;0;0;0;0;0;0;0 /A024 IFDEF WINNIE < 0;0 /A032 > /END IFDEF WINNIE /A032 KON406, 406 /A022 KON79, 117 /79. /C023 KON12, 12 /A026 KON10, 10 /A023 KON07, 7 /DRIVE NUMBER MASK /A024 MIN4, -4 /A023 RZSEKT, 0 /TRACK NO. /A023 / m050 the following is moved here to get it out of the startup / m050 feild which is now overwritten by the 8 bit fallback routine IFDEF WINNIE < /RDGTST ROUTINE GETS STATUS OF LAST BLOCK READ /A042 / AND RETURNS IN WORD 1 BIT 5--1IF PHYSICAL CYLNDER 0 /A042 / BIT 6--IF WRITE FAULT LAST DSK OP /A042 / BIT 7--IF SELECTED UNIT DEFINED /A052 / BIT 8--UNDEFINED /A042 / BIT 9--IF SEEK COMPLETE /A042 / BIT10--IF UNIT 1 SELECTED /A042 / BIT11--IF UNIT 0 SELECTED /A042 / / WORD 2 =CYLINDER NUMBER /A042 / WORD 4 =SECTOR NUMBER /A042 / WORD 5 =CONTROLLER VERSION NUMBER /A042 / RDGTST, /A042 DCA RDEFSW /SET EMPTY SW /A042 TAD (WINSTA /GET STATUS FUNCTION CODE /A042 JMP RDRZXT /DO IT /A042 > /END IFDEF WINNIE /A042 PAGE EJECT / /FOLLOWING CODE MOVED HERE TO PUT AT MORE STABLE LOCATION FOR DATE/TIME /AS THE LAST LOCATION IS REFERENCED AS LOCATION THAT UNIT NUMBER IS /PASSED TO VERIFY ON ERROR AND FORCED RESTART. / /*******MOVED VER 046 ***** / / / / /GETTIM SAVTIM USED ONLY DURING STARTUP / Reference in WPF1 to SVFVFY=6600 SVFVFY=6600 /REFERENCED IN WPF1 /A046 / /CMNDBF USED FOR WINNIE / GETTIM, /LOCATION WHERE TIME IS STORED SAVTIM, / " " " " " CMNDBF=. /COMMAND BUFFER /A032 WRD1=CMNDBF /1ST WORD /A032 WRD2=WRD1+1 /2ND WORD /A032 WRD3=WRD2+1 /3RD WORD /A032 0;0;0;0;0;0;0;0;0;0;0;0 TIMLNT, SAVTIM+1+2-. /LENGTH OF TIME FIELD /A032/C046 /C047 /......LAST LOCATION NOW USED TO PASS PARAMETER /......FROM ACP TO VERIFY DURING WARM START /D046 7401 /THIS LOC=7401 NECESSARY FOR BLOCK 6 ON DOC DISKETTE /D046 0 /--------------------------------------------------------------------- / /************************ SET BUFFER DATA FIELD ********************** / /--------------------------------------------------------------------- RZSETB, 0 RZSETD, JMS RZSETA /SET ALL CDFS FOR BUFFER REFERENCES RZSETS, RZ1SET RZ2SET RZ3SET RZ4SET RZ5SET 0 /END TABLE /A032 JMP I RZSETB /RET /A032 / RZSETA, 0 RZSETL, TAD I RZSETA /GET MEMBER IN LIST SNA /END TABLE? /A032 JMP RZSETC /A032 DCA RZSETT /TEMP STORE TAD RZBCDF /BUFFER CDF POINTER DCA I RZSETT /STORE ISZ RZSETA /A032 JMP RZSETL /NO RZSETC, ISZ RZSETA /A032 JMP I RZSETA /A032 RZSETT, 0 /TEMP STOREAGE SIZE=.-RZSETB / /-------------------------------------------------------------------- / / THIS ROUTINE SETS THE VERIFY SW /A015 / AC=0 LOGIO UPON ENTRY ELSE PHYSIO /A015 / FOR LOGIO JMP IS STORED IN RZVJMP /A015 / FOR READ PHYSIO NOP IS STORED IN RZVJMP /A015 / FOR OTHER PHYSIO JMP IS STORED IN RZVJMP /A015 / /_______________________________________________________________/A015 DVSET, 0 /A015 /D032 MQL /SAVE SW /A015 CLA CLL CML RTR /=2000 /A015 AND RZXDIR /MASK VERIFY BIT /A015 DCA RZXVFY /SET VERIFY SWITCH /A015 CLA CLL CML RTR /2000 /A015 CMA /SET TO CLEAR SWITCH IN RZXDIR /A015 AND RZXDIR /A015 DCA RZXDIR /A015 TAD RZXVFY /A015 SNA CLA /VERIFY MODE? /A015 JMP DVSNOP /SET NOP /A015 TAD RZXDIR /GET CMND /A015 AND (16 /MASK FNCTION BITS /A015 CIA /A015 TAD (2 /READ FUNCTION CODE /A015 SZA CLA /IS READ? /A015 JMP DVSNOP /NO /A015 TAD (NOP /A015 SKP /STORE /A015 DVSNOP, TAD RZVSKP /SKIP VERIFY /A015 DCA RZVJMP /SET IT /A015 JMP I DVSET /A015 /********************************************************************* / /--------------------ERROR ROUTINES------------------------------------- /----------------THESE ROUTINES HANDLE ALL I/O ERRORS------------------- /---------------- WHEN CALLED THE AC CONTAINS THE ERROR----------------- /-----------------STATUS REGISTER, WHILE THE MQ CONTAINS THE------------ /-----------------GENERAL STATUS REGISTER. ERROR ROUTINES--------------- /----------------- 1 THRU 6 SET THE H/O BIT(BIT0) TO 1------------------ /----------------- AND SETS BITS 1-3 TO 001--110 FOR ------------------- /----------------- ERRORS 1-6 RESPECTIVELY.----------------------------- / /*********************************************************************** RZERR6, ISZ RZECTR /INCR ERROR STATUS JMP RZPHIO /RETRY 10 TIMES PHYSICAL I/O ISZ RZSAV1 /BITS 9-11 =6-PHYS IO ERROR RZERR5, ISZ RZSAV1 /BITS 9-11 =5-NOT READY RZERR4, ISZ RZSAV1 /BITS 9-11 =4-ILLEGAL TR RZERR3, ISZ RZSAV1 /BITS 9-11 =3-ILLEGAL DONE RZERR2, ISZ RZSAV1 /BITS 9-11 =2-ERROR RET RZERR1, ISZ RZSAV1 /BITS 9-11 =1ERR LD CMND CLA RZERR0, /M029 TAD RZSAV1 BSW /SET BITS1-3 = 000 THRU 110 CLL RTL TAD RZSTAT /GET STATUS IN L/O BITS 5-11 /C010 TAD RZ4000 /ERROR BIT DCA RZSAV2 /SAVE TEMP DCA RZSAV1 /CLEAR COUNT FOR NEXT TIME TAD RZSAV2 /GET ERR CODE JMP RZEXIT /EXIT RETURN RZ4000, 4000 RZSAV1, 0 RZSAV2, 0 EJECT /***************************************************** / CHECK FOR GOLD HALT DURING ERROR RETRY/A026 /M032 / IF SET RETURN RZERR0 WITH NO MORE RETRIES/A026 / /************************************************************** /A026 RZCHKH, 0 /A026 /M032 CDFSYS /A026 /M032 TAD I HLTFLG /GET HALT FLAG /A026 /M032 CDFSYS /A026 /M032 /M033 SNA CLA /IS SET? /A026 /M032 JMP I RZCHKH /NO...NORMAL RETURN /A026 /M032 /YES ERROR RETURN WITH 4000 BITS IN ACC AND REG STATUS IN L/O 8 BITS/A026 JMP RZERR0 /A026 /M032 / / / RZDELY, ISZ RZDLCT /DONE? /A022/M032 JMP RZIO10 /NO CHECK DONE FLAG /A022/M032 ISZ RZDLC2 /OUTSIDE LOOP TOTAL APPROX 5 SEC/A023/M032 JMP RZIO10 /NO CHECK DONE FLAG /A023/M032 JMP RZERR5 /TIME OUT ERR. DEVICE NO PRESENT/A022/M032 /*************************************************************** / /------------ SET UP POINTERS AND FIELD CDF'S / BOTH FIELDS= FIELD 0 / /**************************************************************** SETMOV, 0 /SET UP MOVE PARAMS TAD I SETMOV ISZ SETMOV DCA INBUF /FROM FIELD PTR TAD I SETMOV ISZ SETMOV DCA OUTBUF /TO FIELD PTR TAD TIMLNT /LENGTH OF TIME FIELD /A032 DCA MOVCNT /COUNTER /D032MOVDAT, 0 /MOVE DATA FROM ONE FIELD TO ANOTHER INCDF, /M032 TAD I INBUF /M032 DCA I OUTBUF /M032 ISZ INBUF /M032 ISZ OUTBUF /SET TO NEXT WORD /M032 ISZ MOVCNT /DONE? /M032 JMP INCDF /NO /M032 /D032 JMP I MOVDAT /YES /D032 JMS MOVDAT /MOVE DATA JMP I SETMOV / / INBUF, 0 /INPUT BUFFER ADDR OUTBUF, 0 /OUTPUT " " MOVCNT, 0 /WORD COUNT /SPACE WARS MOVE VERSION 034 / / /--------------------------------------------------------------------/A015/M034 / / RZVERF USED ONLY IF VERIFY BIT ADVERSILY SET /A015 /M034 / DURING LOGIO READ /A015 /M034 / MAY BE ABLE TO DELETE THIS ROUTINE /_____________________________________________________________________/A015/M034 RZVERF, 0 /NECESSARY BECAUSE OF WAY CMNDS EXEC.. DCA RZXVFY /CLEAR IF SET /A015 /M034 JMP I RZERR2 /ERROR ILLEGAL CODE EXIT DRIVER./M032/C034 / PAGE EJECT DMESS, 7401 /THIS LOC=7401 NECESSARY FOR BLOCK 6 ON DOC DISKETTE CLA;TAD I DMESSP /OUTPUT MESSAGE BSW /A034 JMS PRINTM TAD I DMESSP /SAME WORD /A034 JMS PRINTM /PRINT L/O BYTE /A034 ISZ DMESSP /A034 JMP DMESS /NEXT /A034 / PRINTM, 0 /A034 AND K77 /A034 SNA /END OF TABLE? /A034 JMP . /YES /A034 BSW /A034 SMA /SPECIAL CHAR /A034 IAC /A034 BSW /A034 TAD M77 /A034 SNA /A034 TAD K44 /A034 TAD K77 /A034 TLS /A034 PRINTN, TSF /A034 JMP PRINTN /A034 CLA /A034 JMP I PRINTM /A034 K77, 77 /A034 M77, -77 /A034 K44, 33-77 /A034 /************************************************************ / THE FOLLOWING IS THE RESULT OF THE OLD / SPACE WARS GAME /************************************************************** / / IFDEF WINNIE < / / /ENTRIES IN DRIVE TABLE = / 0 = SINGLE DENSITY OR NO ENTRY /A034 / 400 = DOUBLE DENSITY RX02 /A034 / 1400 = -------------- RX50 /A034 / 4000 = WINNIE DEVICE /A034 / 4001 = MOUNTED WINNIE /A034 / CHKWIN, CLA IAC / /A032 RDNOOP /CHECK WINNIE ON LINE /A032 SZA CLA /0=WINNIE ON LINE /A032 JMP NOWINI /NO /A032 YSWINI, TAD DENDV0 /ADDRESS OF DEV 0 IN ACP DEV TABLE /A034 TAD RZDRIV /OFFSET FOR DRIVE DCA DVPACK /TEMP LOCATION /A034 CDFACP /ACP FIELD /A034 TAD I DVPACK /GET CODE /A034 CDFDSK /DRIVER FIELD /A034 RAL /WINNIE BIT TO LINK /A034 SNL /IS WINNIE DEVICE? /A034 JMP NOWNCL /NOT A WINNIE /A034 SNA CLA /IS WINNIE MOUNTED /A034 JMP RZERR2 /NO--SET DENSITY ERROR /A034 CLA CLL IAC RTL /4=WINNIE REFERENCE /A032 JMP RZSETF /SET DENSITY /A032 NOWNCL, CLA /A034 JMP NOWINI /NOT A WINNIE /A034 > /END IFDEF WINNIE /A032 / /------------------------------------------------------------/A015 / /A015 / VERIFY ROUTINES ...CALLED WITH BIT 1 SET DURING /A015 / LOGICAL WRITE AND PHYSICAL READ /A015 / / PHYSICAL READ WITH VERIFY=COMPARE BUFFER TO SILO/A015 / (SHOULD ONLY BE USED AFTER PHYSICAL WRITE /A015 / LOGICAL WRITE WITH VERIFY=READ AFTER WRITE /A015 / WITHOUT SILO EMPTY /A015 / LOGICAL READ 12 BIT MODE =READ COMPARES BUFFER /A024 / TO SILO /A024 / /---------------------------------------------------------------/A015 / DVPACK, 0 /VERIFY LOGG WRITE 8 BIT MODE /A015 JMS DXPACK /WRITE /A015 CLA CLL CMA RTL /-3 /A015 JMS DVVFY /READ NO EMPTY SILO /A015 JMP I DVPACK /RETURN /A015 / DVVFY, 0 /A015 DCA DVBCTR /SET SECTOR COUNT /A015 TAD RZCSEC /SET LOG SECTOR /A015 DCA RZLSEC /A015 JMS DVSETR /SET READ LOGICAL SECTOR AND COMMAND/A015 JMS RZDIVD /SET SECTOR FOR I/O /A015 DVVFY2, JMS RZPHYS /DO IT /A015 ISZ DVBCTR /DONE? /A015 JMP DVVFY2 /NO /A015 JMS DVSETW /RESET CMND FOR WRITE /A015 JMP I DVVFY /A015 DVBCTR, 0 /SAVE TEMP SECTORR COUNT /A015 / DVWRIT, 0 /WRITE 12 BIT WITH VERIFY/A015 JMS DYWRIT /WRITE IT /A015 TAD RZ50SW /RX50 SET? /A018 SNA CLA /A018 TAD M1 /-1 /A018 TAD M1 /-1....-1 RX50 -2 RX01/2/A018 JMS DVVFY /A015 JMP I DVWRIT /A015 M1, -1 /CONST /A018 /******************************************************************/M032/M036 /----------------- CHECK ZERO BLK COUNT FOR LOGIO-------------------/M032/M036 /----------------- SET -1 IF TRUE-----------------------------/M032/M036 /*****************************************************************/M032/M036 BLKSET, 0 /A036 TAD RZBCTR /LOG IO = BLOCK COUNT/M032/M036 SNA /=0 /M032/M036 CMA /YES SET NEG /M032/M036 DCA RZBCNT /RESET /M032/M036/C045 /******SPACE WARS MOVE*****TO LOAD LO BLOCK NUM FOR WINNIE /A037 IFDEF WINNIE < TAD RZBLKN /GET BLOCK NUMBER /M037 DCA LOBLK /SAVE L/O /M037 > /END IFDEF WINNIE /A037 JMP I BLKSET /A036 RZBCNT, 0 /#BLOCKS TO BE PROCESSED /A045 /--------------------------------------------------------------------- / / END SPACE WARS /************************************************************ / / SET4 USED TO SET ALL REFERENCES TO 0 AS DRIVE 4 / IFDEF LOAD4 < SET4, 0 /A027 TAD RZDRIV /GET DRIVE NO SNA /IS=0 /A027 CLA CLL IAC RTL /YES SET TO 4 /A027 DCA RZDRIV /A027 CLA CLL IAC RTL /SET 4 /A027 AND RZDRIV /MASK PAIR /A027 JMP I SET4 /RETURN /A027 DMESSP, .+1 /A039 TEXT /?[2J?[5H SYS DSK IN DRV 0 AND RSTRT./ /A039 > /END IFDEF LOAD4 /A027 IFNDEF LOAD4 < DMESSP, .+1 /D034 200 /D034 ESC; "[; "H /D034 ESC; "[; "J /D034 LF;LF;LF;LF;LF /DOWN FIVE LINES IFDEF ENGLSH < TEXT /![[2J![[5HPUT SYSTEM DISKETTE IN DRIVE 0 AND RESTART/ /M051C045 > IFDEF SPANISH < TEXT /![[2J![[5HCOLOQUE EL SISTEMA DSK EN UNIDAD 0 Y ARRAN./ /M051C045 > IFDEF ITALIAN < TEXT /![[2J![[5H INSERIRE IL DISCO SISTEMA E RIPARTIRE./> IFDEF FRENCH < TEXT /?[2J?5H PLACE SYSTEM DISKETTE IN DRIVE 0 AND RESTART./ /C037 > IFDEF GERMAN < TEXT /?[2J?5H MIT SYSTEM DISKETTE IM LINKEN LAUFWERK STARTEN./ /C037 > IFDEF DUTCH < TEXT /?[2J?5H ZET SYSTEEMDISKETTE IN 0 EN OPNIEUW./ /C037 > /D037 0 / 0 SIGNIFIES END OF MESSAGE TO OUTPUT > /END IFNDEF LOAD4 /A039 PAGE EJECT IFNDEF WINNIE < ZBLOCK 400 > / LEAVE 2 PGS OF FILLER FOR NON-WINNIE /A041 / IFDEF WINNIE < / /COMMAND CODES WINMNT=CLA /0=MOUNT VOLUME WINSTB=CLA CLL IAC /1=SET BLOCK WINFIL=CLA CLL IAC RAL /2=FILL BUFFER WINWRT=CLA CLL CML IAC RAL /3=WRITE WINRD=CLA CLL IAC RTL /4=READ WINDIS=5 /5=DISMOUNT VOLUME WINUPD=CLA CLL CML IAC RTL /6=UPDATE VOLUME WINEMT=25 /EMPTY BUFFER WINSTA=26 /26=READ STATUS WINERS=27 /27=READ ERROR STATUS WINVOL=30 /30=GET VOLUME DATA WINDIR=33 /33=GET VOLUME DIRECTORY / / TRANSFER COMMAND + 1 FOR DONE FOR COUNTS / SETCNT=4 /SET BLOCK COUNT DISCNT=2 /DISMOUNT COUNT MNTCNT=12 /MOUNT COUNT /************************************************************ RDNOSW, 0 RDSC /SPACE SAVER TO HERE /A032 RNOSW, RDSR /TRNSFER READY JMP RNOXD /NO CHECK DONE JMP TRNERR /TRANSFER READY ILLEGAL RNOXD, RDSD /DONE? JMP RDOSWQ /A032 / RDSE /ERROR? JMP I RDNOSW /A026 JMP TRNERR /PROCESS ERROR RDOSWQ, CLA /OVERLAYED WITH JSWAP JMP RNOSW /A032 /********************************************************* / / /COMES HERE IF A WINNIE / ISAWIN, CLL RAL /RESET WITHOUT WINNIE BIT /A032 DCA RZXDIR /A032 JMS BLKSET /SET BLK CNT /A036 JMS DVSET /SET VERIFY BIT /A032 TAD RZBPTR DCA RDBUFO /SET BUFFER POINTER / CLA IAC BSW /100=MODE SW /A032 AND RZXDIR /A032 DCA RDMODE /SET MODE SW /A032 RDONXT, /A036 JMS RZSETA /M037 RD1SET /M037 RD2SET /M037 RD3SET RD4SET /M037 /D037 RD5SET 0 /TERMINATOR /M037 TAD RZXDIR /A032 JMS RZXJMP /JMP SUB /A032 RDWRIT /-2=WRITE A BLK /A032 RDREAD /-4=READ /A032 RDMNT /-6=MOUNT VOLUME RDSMNT /-10DISMOUNT VOLUME RDVOL /-12=GET VOLUME DATA RDDIR /-14=GET VOLUME DIRECTORY RDUPD /-16=UPDATE VOLUME /A037 RDGTST /-20=GET STATUS /A042 / / /WRITE A RECORD / RDWRIT, JMS WINSET /SET UP BLOCK AND STRT PARAMS ADDR CLA IAC DCA RDEFSW /SET FILL SW WINFIL /SET UP FILL BUF CMND JMS RDCMPT /FILL BUFFER WINWRT /SET UP WRITE JMS RDNOSW /CHECK DONE AND SWAP IF NOT /A032 TAD RZXVFY /VERIFY MODE? SNA CLA /SKIP TO RDREAD JMP RDRD1 /XIT /C036 / / /READ A RECORD / TAD RZBPTR DCA RDBUFO /SET BUFFER POINTER RDREAD, /M036 JMS WINSET /SET UP BLOCK WINRD /SET UP READ CMND JMS RDNOSW /CHECK DONE AND SWAP IF NOT /A032 DCA RDEFSW /CLEAR EMPTY SW TAD (WINEMT /SET UP EMPTY BUFFER JMS RDCMPT /FILL OR EMPTY SILO /A032 RDRD1, ISZ LOBLK /NEXT BLOCK /A036 ISZ RZBCNT /DONE? /A036 /C045 JMP RDONXT /NO DO NEXT /A036 JMP RZEXIT /YES EXIT /A036 / /************************************************************ / /READ DENSITY FOR WINNIE RETURNS -1 FOR DEVICES / 0-15 // /RDDEN, / CLA CLL IAC RTL /4RETURN 4 FOR DEV 0-15 WHEN WINNIE ON LINE / JMP RZEXIT /EXIT / / /RD LOAD FUNCTION / /RDLDCMND, 0 / TAD RDCMND /GET COMMAND / RDSC /SEND COMMAND / JMS RDXFER /CHECK DONE,TR RDY, ERROR? / JMP I RDLDCMND /TR READY RET / ISZ RDLDCMND /DONE RET / ISZ RDLDCMND /ERROR RET / JMP I RDLDCMND /RET / / / /RDXFER USED TO CHECK AND RETURN / CALL+1 = TR READY / CALL+2 = DONE / CALL+3 = ERROR / RDXFER, 0 RDXFRA, RDSR /SKIP TR READY SKP JMP I RDXFER /TR READY RDSD /SKIP IF DONE FLAG SET JMP RDXFRA /CHECK TR READY ISZ RDXFER /SET RET RDSE /SKIP ERROR JMP I RDXFER /DONE RET ISZ RDXFER /SET ERROR RET JMP I RDXFER / / /SET COMMAND / /WINCMD, 0 / TAD I WINCMD /GET CODE / ISZ WINCMD /SET RETURN / DCA RDCMND / TAD RDCMND / RDSC /SEND COMMAND / JMP I WINCMD / /MOUNT COMMAND / MOUNT VOLUME COMMAND / MOUNTS THE VOLUME REFERENCED IN RZBPTR IN DATA FIELD / REFERENCED BY RXBCDF TO DRIVE IN RZDRIV / RDMNT, JMS MOVPAR /MOVE PARAMETERS TO DRIVE FIELD TAD (-MNTCNT /WORD COUNT JMS SVSPCE /SET UP /A032 TAD WRD1 TAD (300 /ALLOW READ WRITE BITS (5&6) DCA WRD1 /INTO TABLE WINMNT /MOUNT COMMAND JMP RDTRLP /TRANSFER LOOP THEN EXIT / /DISMOUNT COMMAND / DISMOUNT VOLUME ASSOC WITH DRIVE # IN RXDRIV / RDSMNT, CLA CLL CMA RAL /-2 DISMNT COUNT JMS SVSPCE /SET UP /A032 TAD (WINDIS /DISMOUNT CODE RDTRLP, JMS TRLOOP /TRANSFER JMP RZEXIT /XIT / SVSPCE, 0 DCA RDCNT TAD (CMNDBF DCA WINPTR /SET IT TAD WINFLD DCA RD1SET /SET UP FIELD PTR TAD RZDRIV /GET DRIVE # AND (37 /L/O 4 BITS /C035 DCA WRD1 JMP I SVSPCE / /READ VOLUME DATA / RDVOL, JMS WINSET /SET BLOCK DEFAULTS TO BLOCK IN RZBLKN DCA RDEFSW /SET EMPTY SW TAD (WINVOL /COMMAND JMP RDRZXT /EMPTY AND EXIT PAGE EJECT / /UPDATE VOLUME DATA / RDUPD, /UPDATE VOLUME DATA /A037 CLA CMA /-1 /A037 DCA RDEFSW /SET SW /A037 WINUPD /6=CMND CODE /A037 JMP RDRZXT /DO IT /A037 / / /READ DISK DIRECTORIES / RDDIR, DCA RDEFSW /SET EMPTY SW TAD (WINDIR /READ DIR COMMAND RDRZXT, JMS RDCMPT /EMPTY OR FILL JMP RZEXIT / /MOVE PARAMETERS FROM DATA FIELD IN RZBCDF TO WIN FIELD / MOVPAR, 0 TAD (-10 /COUNT DCA RDCNT TAD RZBPTR DCA MVPTR2 /BUFFER POINTER TAD (CMNDBF+1 DCA MVPTR3 RD4SET, CDFSYS /M033 TAD I MVPTR2 CDFSYS /M033 DCA I MVPTR3 ISZ MVPTR2 ISZ MVPTR3 ISZ RDCNT JMP RD4SET /NOT DONE JMP I MOVPAR /DONE MVPTR2, 0 MVPTR3, 0 / / / / /SET BLOCK FUNCTION / WINSET, 0 TAD (-4 JMS SVSPCE /SET UP /A032 TAD LOBLK /LO ORDER DCA WRD2 TAD HOBLK /HI ORDER BLOCK NO DCA WRD3 WINSTB /SET BLOCK CMND JMS TRLOOP /TRANSFER JMP I WINSET / WINFLD, CDFSYS /M033 / /EMPTY BUFFER COMMAND SET UP / / / /TRLOOP WILL SEND REMAINING TRANSFERS BASED ON RDCNT TRLOOP, 0 RDSC /SEND IT TRNCHK, JMS RDXFER /CHECK DONE JMP TRANOK /TR RDY ISZ RDCNT /IS DONE--WAS LAST TR? JMP TRNERR /TRANSFER ERROR JMP I TRLOOP /OK TRANOK, RD1SET, CDFSYS /M033 TAD I WINPTR /GET WORD TO BE TRANSFERED CDFSYS /M033 RDTD /TRANSFER IT ISZ WINPTR ISZ RDCNT JMP TRNCHK /MORE TO TRANS JMP TRNERR /PREMATURE END / / /EMPTY BUFFER ROUTINE / AFTER READ / /******DON'T FORGET CDF'S********* / RDCMPT, 0 TAD RDMODE /8 OR 12 BIT MODE RDSC /SEND IT RDCNXA, JMS RDXFER JMP RDCNXT /NEXT CHAR JMP I RDCMPT /DONE JMP RDERROR RDCNXT, TAD RDEFSW /EMPTY OR FILL BUFFER SW SPA JMP RDCUPT /UPDATE SPECIAL CASE SNA CLA JMP RDDNXT /EMPTY JMS RDADDC /ADD CHAR FROM RDBUF0 /C037 RDTD /SEND DATA JMP RDCCNT /CONTINUE RDDNXT, TAD RZXVFY /VERIFY SW SNA CLA /VERIFY MODE? JMP RDENXT /NO EMPTY SILO RDTD /READ CHAR CIA /TWO'S COMP. JMS RDADDC /ADD CHAR FROM RDBUF0 /C037 SNA CLA /COMPARE = JMP RDCCNT /YES JMP TRNERR /NO****MUST SET TO CLEAR ALL TR FLAGS***** RDENXT, RDTD /RECIEVE DATA RD2SET, CDFSYS /M033 DCA I RDBUFO /GET CHAR CDFSYS RDCCNT, ISZ RDBUFO NOP /FOR WRAP AROUND BUFFER JMP RDCNXA /FOR FIELD LOOP RDCUPT, CLA IAC DCA RDEFSW /SWITCH ONLY TO TRANSFER DEVICE NUM TAD RZDRIV AND (17 RDTD /TRANSFER DEV NUM JMP RDCNXA /CONTINUE / / / RDADDC, 0 /ADD CHAR FROM RDBUF0 /A037 RD3SET, CDFSYS /M033 TAD I RDBUFO /GET CHAR CDFSYS /M033 JMP I RDADDC /RET /A037 / / RDEFSW, 0 /EMPTY/FILL SW / /FILL BUFFER ROUTINE / BEFORE WRITE / /******DON'T FORGET CDF'S********* / /RDFMPT, 0 / TAD RZBPTR /REALLY NEED THIS???? / DCA RDBUFO /RDFNXA, / JMS RDXFER / JMP RDFNXT /NEXT CHAR / JMP I RDFMPT / JMP RDERROR /RDFNXT, /RD3SET, CDFSYS /M033 / TAD I RDBUFO /GET CHAR / CDFSYS /M033 / RDTD /SEND DATA / ISZ RDBUFO / JMP RDFNXA / /RDDSTY, / JMS WINCMD / WINSTA /GET STATUS / RDTD /GET IT / JMP RZEXIT /EXIT / / / /RDERROR/WRTERROR / /RDERROR, /WRTERROR, / JMS WINCMD / WINSTA /GET ERROR STATUS / RDTD /GET IT / TAD (4000 /ADD ERROR BIT / JMP RZEXIT / /TRANSFER ERROR= DONE OR TR FLAG OUT OF SEQ /*****MUST GET ALL 4 WORDS****CHANGE WINSTA / RDERROR, WRTERROR, TRNERR, CLA CLL CMA RAL /-2 WORD COUNT+1 DCA RDCNT TAD (CMNDBF /PNTR DCA WINPTR TAD WINFLD /FIELD DCA RD1SET TAD (WINERS /GET STATUS JMS TRLOOP /GET STATUS TAD WRD1 /GET IT TAD (6000 /2 H/O BITS FOR RD ERROR SYTATUS NOTATION JMP RZEXIT / / RETRY RESET /CAN BE DELETED FOR ROOM.. NOT USED CURRENTLY.. TO BE USED IF WANT INCREASE / IN RETRY COUNT. NOT REALLY NECESSARY / / /WINRTR, 0 / CLA CLL CMA RAL /-2 / DCA RDCNT / TAD (13 / DCA RDCMND /SET COMMAND / TAD (10 / DCA WRD1 / JMP I WINRTR / HOBLK, 0 /STOREAGE OF THE H/O BLK FOR I/O LOBLK, 0 /STOREAGE OF THE L/O BLK FOR I/O WINPTR, 0 /TEMP POINTER AREA RDMODE, 0 /MODE BIT FOR WINNIE I/O RDBUFO, 0 /POINTER TO BUFFER AREA FOR WINNIE RDCNT, 0 /TRANSFER COUNT / moved here in edit /a050 DENDV0, 5601 /ADDRESS OF DENSITY SW FOR DRIVE0 (ACPLDP+1) /M033 /RDCMND, 0 /COMMAND PAGE > /END IFDEF WINNIE /A032 EJECT /***********************************************************************/a050 / WARNING ---- /a050 / V25STB defines the address of the table STBLK in WPF1 /a050 / Do not change this code without checking that this still holds/a050 / If you do change it then reassemble WPRINT as it modifies/a050 / the table. Messy isn't IT!!!! /a050 /***********************************************************************/a050 /****************************************************************** / / / THIS CODE IS USED TO LOAD FIELDS 0,1,2 / THEN MOVES PAGE 0 FIELD 2 TO PAGE 0 / THIS FIELD / IT CALLED BY THE BOOT ROUTINE IN BLOCK 0 / / IT CALLS THE RX02 HANDLER TO EXECUTE TO APPROPRIATE / IO INSTRUCTIONS THE JMPS TO 7600 IN FIELD 0 / WHICH IS THE START ADDRESS FOR THE SYSTEM / /********************************************************************* / /***************************************************************** / /------------- CHECK SEE IF WE SAVE CURRENT TIME------------------- / /******************************************************************* STLOAD, /D034 7401 /NEEDED AT BEGINNING OF BLOCK 6 /A015 DCA BTLOC /SAVE SYSTEM0 TYPE /A032 TAD STPTR /GET LIST PNTR /M032 DCA X0 /INDEX PTR /M032 TAD RDRPT /INIT JMP FOR RESTART /C028 /C032 DCA RDOSWP /SET IT /C028 /M032 IFDEF WINNIE < TAD RDRPT /INIT JMP FOR RESTART FOR WINNIE /A032 DCA RDOSWQ /SET IT /A032 > /END IFDEF WINNIE /A034 TAD TIMESW /FIRST TIME SNA CLA JMP FIRSTM /YES JMS SETMOV /SETUP MOVE AND SAVE TIME CLOCK+2 /START ADDRESS OF CLOCK /C047 SAVTIM+2 /LOCATION TO BE SAVED IN /C047 JMP STSLOP /LOAD USING DRV 0 AS PREV. DEFINED/c050 /A032 FIRSTM, TAD BTLOC /CODE 0 =RX01/RX02/RX50 4001=WININIE /A034 /....PASSED TO LOAD FROM BOOT /A034 CDFFIO /ACP FIELD /A034 DCA I DENDVA0 /NIT TABLEADDRESS OF DRIVE 0 CODE IN TABLE/A034 CDFDSK /MY FIELD /A034 TAD BTLOC /A034 SMA CLA /DRIVE 0=WINNIE? /A034 JMP FIRSTN /NO /A034 IAC /SET WINNIE BIT /A034 JMP SETCMD /SET READ /A034 FIRSTN, TAD M7 /M7=ONES COMP OF 6=GET DEN PHYSIO DCA STCMND JMS RDWTIO /DO I/O GET DENS. 0=SD 1=DD DCA SVDEN /SAVE DENSITY CLA CLL IAC RAL /2 AND SVDEN SNA CLA /=RX50 JMP PASS50 /NO TAD K1400 /YES JMP SETCMD PASS50, TAD SVDEN /GET DEN SZA CLA /DD? TAD K400 /DD SET CODE TO -400 DD/READ 12 BIT LOGIO SETCMD, TAD K2 /SD SET CODE TO READ 8 BIT LOG /M018 DCA STCMND /SAVE CMND /M018 STSLOP, /a050 JMS RDWTIO / First time through load V25 startup JMS I (V25ST) / and do it STLOOP, TAD I X0 /GET START BLOCK NO SNA JMP STDONE /DONE DCA STBLK /SAVE TAD I X0 /CDF BUFFER FLD DCA STFLD TAD I X0 /BUFFER ADDRESS DCA STLOC TAD I X0 /NEG BLOCK COUNT DCA STCNT JMS RDWTIO /READ CLA TAD INCSAV /GET PTR /C032 DCA X0 /SET JMP STLOOP /NEXT BLOCK RDWTIO, 0 /CALLS HNDLER TO LOAD BFFRS RDRPT, CLA TAD X0 DCA INCSAV /SAVE FOR LOAD /C032 TAD RETFLD /SET RETURN FLD IN AC JMS RX2SYS /CALL DRIVER 0 /DRIVE # /***********************************************************************/a050 / WARNING ---- /a050 / V25STB defines the address of the table STBLK in WPF1 /a050 / Do not change this code without checking that this still holds/a050 / If you do change it then reassemble WPRINT as it modifies/a050 / the table. Messy isn't IT!!!! /a050 /***********************************************************************/a050 V25STB, /a050 STBLK, DLCMPS /START BLOCK# STFLD, CDFSYS /CDF BUFFER FLD STLOC, V25ST /BUFFER START ADDRESS STCNT, -DSCMPS /NEG BLK CNT 0 /TRACK NO PHYSIO STCMND, 2 /RXREAD "READ" FUNCTION CODE SPA /ERRORS? JMP RDRPT /YES REREAD BLOCK JMP I RDWTIO /RETURN STPTR, STLIST-1 /PTR TO LIST-1 /________________________________________________________________ / /**************** LOAD SYSTEM FIELD 0, 0-4777 **************** / /________________________________________________________________ STLIST, /START OF PARAM LIST SET IN BLKS OF 4 /ENDING WHEN STRT BLK# = 0 AND IN /THE FOLLOWING ORDER DLFD0A /START BLOCK ON DISKETTE CDFSYS /"CDF" OF BUFFER FLD /M033 0 /BUFFER ADDRESS -DSFD0A /NEG BLK COUNT /D040 IFNDEF WINNIE < /D040/________________________________________________________________ /D040/ /D040/**************** LOAD SYSTEM FIELD 0, 7000-7777 ************* /D040/ /D040/________________________________________________________________ /D040 DLFD0B /START BLOCK ON DISKETTE /D040 CDFSYS /"CDF" OF BUFFER FLD /M033 /D040 7000 /BUFFER ADDRESS /D040 -DSFD0B /NEG BLK COUNT /D040 > /END IFNDEF WINNIE /AXXXDFB /________________________________________________________________ / /**************** LOAD SYSTEM FIELD 1, 0-7000 **************** / /________________________________________________________________ DLFD1 /START BLOCK ON DISKETTE CDFPRT /"CDF" OF BUFFER FLD /M033 PRBOTM /ADDRESS /A043 /D043 PRTOPP /ADDRESS /C038 -DSFD1 /NEG BLK COUNT /________________________________________________________________ / /**************** LOAD SYSTEM FIELD 2, 0-4777 ************* / /________________________________________________________________ DLFD2 /START BLOCK ON DISKETTE CDFMNU /"CDF" OF BUFFER FLD /M033 0 /BUFFER ADDRESS -DSFD2 /NEG BLK COUNT /----------------------------------------------------------------- / /****************** LOAD WPSFIL FIELD 7, 0-6777 ******************** / /------------------------------------------------------------------- /D049 DLFD7 /START BLOCK NO. /D049 CDFFIO /CDF BUFFER FIELD /M033 /D049 0 /BUFFER ADDRESS /D049 -DSFD7 /NEG BLK COUNT(20) /________________________________________________________________ ENDLST, 0 //END OF LIST /__-------------------------------------------------------- /---------------------------------------------------------------- / /******************* MOVE PAGE 0, FIELD 2 ************************** /******************* TO PAGE 0, FIELD 7 ************************** / /___________________________________________________________________ / /------------- RESTORE TIME TO FLD 0---------------------------- / STDONE, TAD BTLOC /A034 SPA /WINNIE? /A034 JMP STDNE2 /YES RESTORE NOW THAT TABLE IS LOADED /A034 CLA /A034 STDNE1, /A018 TAD STCMND /GET READ COMMAND /A018 AND K1400 /1400 DENSITY, RX50 /A018/C032/C034 STDNE2, /A032 CDFFIO /A034 DCA I DENDVA0 /SET SYSTEM DRIVE DENSITY IN ACP FOR LOGIO CDFSYS /MYFLD /M033 /WHILE WAITING DONE /A026 STDNE3, TAD TIMESW SNA CLA JMP SKIPIT DCA STTYPE /SET WARM STARTUP(IGNORE SET TIME) JMS SETMOV /RESTORE TIME GETTIM+2 /ADDR OF TIME /C047 CLOCK+2 /ADDR TO BE STORED /C047 SKP SKIPIT, ISZ TIMESW /SET SKIP SW CDISYS /SET TO START /M033 JMP I .+1 /START WPS 201 / / / EJECT TIMESW, 0 /FIRST TIME SW SYHDLR, RX2SYS /RX02HNDLER SVDEN, /SAVE DENSITY***CAUTION***/M026 INCSAV, 0 /SAVE /A032 K1400, 1400 K400, 400 K2, 2 M7, -7 /INES COMP OF 6=GET DENS CMND BTLOC, 0 /SYSTEM 0 DEVICE TYPE- 0=RX01/02 1=RX50 4000=RD50 DENDVA0,5601 / address of density switch for drive0 /a050 / also defined at DENDV0 in above page /a050 / modified from /m033 so that this page is redundant /a050 / after initialisation /a050 RETFLD, CIFSYS /SET RETURN THIS FLD /M033 /********************************************************************** / Be WARNED IF YOU USE THIS SPACE / You ca be overwritten at any minite by the print initialisation / which follows /********************************************************************* /a050 PAGE LF=12 /LINE FEED CR=15 /CARRIAGE RETURN EJECT / END-OF-FILE.   /DSKACP CURRENT EDIT DATE = 12/08/83 / / 035 KMD 26-Sep-85 Spanish & Dutch Xlations / 034 EMcD 11-Sep-85 Add Nordic translations / conditionalised / 033 MART 30-apr-85 Restore Startup code before execute / / ----------- all below are V2.0 mods or earlier ---------------- / / 032 DFB 21-DEC-84 FIX ALLOC BUG / 031 DFB 12-DEC-84 Fix conflict where / WPFILS and ACP use X0 / 030 DFB 17-OCT-84 Allow add. retries if error / 029 DFB 10-SEP-84 Pass unit # to VERIFY on warm start / 028 DFB 19-AUG-84 Pass unit # to VERIFY on warm start / 027 DFB 18-AUG-84 Fix to set warm start on error / 026 DFB 09-AUG-84 Fix=don't write alloc block on / .... err and force Gold Menu to verify / 025 DFB 13-MAR-84 Fix to reboot winnie after error halt / 024 DFB 21-FEB-84 Fix to winnie-clear den table / dev 1 only if sys dev rx / 023 DFB 17-JAN-84 Fix Winnie ifdefs for non winnie compatability / 022 DFB 08-DEC-83 Add winnie update function / 021 DFB 01-NOV-83 Add boot sys vol function / 020 DFB 27-SEP-83 FIXES TO WINNIE / 019 DFB 23-SEP-83 WINNIE SUPPORT / 018 WCE 03-SEP-83 Changed FIELD instructions to / standard instructions / 017 DFB 15-JUN-83 WINNIE SUPPORT / 016 DFB 07-JAN-82 Fix to write out dir/alloc blk if / return not specified for error / 015 MJS 16-JUN-82 Bugfix within 'acallo' to set the / contents of 'rxqblk'=0 if no more / blocks to allocate / 014 DFB 28-APR-82 Rx50 changes/,condor switches added / /********COPIED FROM DSKACP VER 13**** WITH RX50 ADDED************ / 013 DFB 05-APR-82 Clr err cd for write dir/alloc blk / 012 DFB 26-MAR-82 Prevent alloc block from being / written after each alloc/dealloc / 011 DFB 16-MAR-82 Set #free blocks return in spc / /created err in version 10 / 010 DFB 06-MAR-82 Set return error on get den / .......and fix return err code on get free blk / 009 DFB 01-MAR-82 Print "write" correctly for I/O err msge / 008 GDH 28-FEB-82 Changed assemble field to 2 so / that DSKACP can be written out / with WPFILS. / 007 DFB 26-FEB-82 Fix to allow gold menu after err. / 006 DFB 18-FEB-82 Fix to allow verify after write / logical and physical / 005 DFB 21-DEC-81 Fix to print corrrect drive # / on error / 004 DFB 18-DEC-81 Fix to return error code / 003 GDH 12-NOV-81 Bug fix to return the # of free / blocks on an rxeal call. / 002 DFB 11-11-81 Add error hndler/gold menu ret. / 001 DFB 10-29-81 /******************************************************************** / COPYRIGHT (C) 1983 BY / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP TO THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT / NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL / EQUIPMENT CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY / OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / / /******************************************************************* / / / THE FOLLOWING CODE IS USED TO WRITE THE ACP AND RX02 HANDLER TO / DISC. IT IS REPEATED IN BOTH MODULES TO ALLOW FOR A SEPARATION / OF THESE MODULES AT A LATER DATE. OBVIOUSLY WHEN DOING SO / THE PARAMETERS (DLRXLD, LFRXLD AND STRT ADDR.) WOULD HAVE TO BE REPLACED / WITH THE CORRECT BLOCK NUMBERS,LENGTH AND STARTING ADDRESS. / / /********************************************************************* /008 DSKACP is not written out with (and read in with) WPFILS which /008 loads from 0 to 5600 (field 7 at run time). DSKACP loads into /008 5600 to 7000 (field 7 at run time). Both modules assemble into /008 field 2 for write-out purposes. /D008; FIELD 0 /D008; *200 /D008; JMP I .+3 /WRITE BLOCK /D008; JMP I .+1 /EXIT /D008; 7600 /D008; RXLOAD /D008; /D008; *RXLDLS /D008; RXEWT /WRITE CODE /D008; 0 /DEVICE NUM /D008; RXQBLK /#BLOCKS /D008; . /LIST PNTR-1 /D008; DLACLD /BLOCK NUM /D008; ACPLDP /START ADDRESS OF ACP /D008; CDF FIELD4 /FIELD FOR WRITE IS 4 /D008; -DSACLD /BLOCK COUNT /D008; 0 /END BLOCK /********************************************************************* EJECT / **** ANCILLARY CONTROL PROCESSOR FOR WPS. **** /********************************************************************* / / DEVICE ANCILLARY CONTROL PROCESSOR / / CALLING SEQUENCE: / / AFTER PLACING THE PROPER PARAMETERS IN THE Q-BLOCK / EXECUTE THE FOLLOWING INSTRUCTIONS: / CIFSYS / CHANGE TO SYSTEM FIELD / ENQUE / ENQUEUE THE Q-BLOCK / ADDRESS OF Q-BLOCK / WAIT, CIFSYS / CHANGE TO SYSTEM FIELD AGAIN / JWAIT / WAIT FOR I-O COMPLETION / TAD Q-BLOCK+RXQCOD / IS CODE STILL 0? / SNA / IF NOT 0, THEN DONE / JMP WAIT / GO WAIT S'MORE / OTHERWISE CONTINUE PROCESSING - YOU'VE GOT WHAT YOU / ASKED FOR OR YOU'VE GOT AN ERROR PASSED BACK TO YOU. / ### / / PARAMETERS PASSED AND RETURNED: / / THE Q-BLOCK IS THE AREA IN WHICH THE USER PASSES THE INFORMATION / THAT THE ACP NEEDS IN ORDER TO PROCESS HIS REQUEST. THE Q-BLOCK / IS BIGGER THAN IT NEEDS TO BE FOR THIS APPLICATION AND THEREFORE / THERE ARE WORDS IN IT THAT ARE NOT USED BY THE ACP AND WILL BE / IGNORED HERE. THERE ARE A SET OF POINTERS THAT EXIST IN THE / PREFIX FILE WHICH CAN BE USED TO POINT TO THE VARIOUS WORDS / OF THE Q-BLOCK, AND THEY ARE DEFINED BELOW: / / POINTER MEANING / RXQCOD STATUS CODE / RXQFNC FUNCTION CODE (TELLS ACP WHAT TO DO) / RXQFNO FILE NUMBER TO BE PROCESSED / RXQSPC SPACE ON DISKETTE (RETURN ONLY) / RXQDRV DRIVE NUMBER / RXQBLK BLOCK NUMBER PASSED OR RETURNED / RXQBAD BUFFER ADDRESS / RXQBFD CDF TO BUFFER FIELD / RXQTRK TRACK OR NUMBER OF BLOCKS TO TRANSFER / RXQSEC SECTOR NUMBER / / / THE TABLE BELOW TELLS WHAT SHOULD BE PASSED (N FOR NEEDED), WHAT / WILL BE RETURNED (R), AND WHAT IS NOT USED (-) FOR EACH OF THE / FUNCTIONS. THE FUNCTION CODES ARE GIVEN UNDER THE HEADING 'FNC' / AND MUST BE PASSED AS SHOWN (IN OCTAL). THE RETURN CODE IS / ALWAYS RETURNED BY THE ACP AS SHOWN UNDER THE HEADING 'COD'. / IN GENERAL, THE HEADINGS ARE OBTAINED BY DROPPING THE 'RXQ' FROM / THE POINTER MNEMONICS. THE NUMBERS ABOVE THE HEADINGS REFER / (IN OCTAL) TO THE RELATIVE POSITION IN THE Q-BLOCK OF THE / PARAMETER AND ARE THE VALUES OF THE POINTER MNEMONICS, I.E. / RXQCOD = 0, RXQFNC = 1, ETC. / / / / OFFSETS TO WORDS IN Q-BLOCK. THESE MUST BE PREFIXED BY RXQ / FUNCTION 0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 / DESCRIPTION COD FNC DN1 DN2 FNO ID1 SPC CTL DRV BLK RS1 BAD BFD TRK SEC /REWRITE DIR/ALOC BLK R 0 - - - - - - N - - - - - - /READ PHYSICAL 8BIT R 1 - - - - - - N N - N N N N /WRIT PHYSICAL 8BIT R 2 - - - - - - N N - N N N N /READ LOGICAL R 3 - - - - - - N N - N N - - /WRITE LOGICAL R 4 - - - - - - N N - N N - - /ALLOCATE A BLOCK R 5 - - - - - - N R - - - - - /DEALLOCATE A BLOCK R 6 - - - - - - N N - - - - - /GET HDR BLOCK R 7 - - N - - - N R - - - - - /SET HEADER BLOCK R 10 - - N - - - N N - - - - - /GET # FREE BLOCKS R 11 - - - - R - N - - - - - - /GET DENSITY R 12 - - - - R - N - - - - - - /READ PHYSICAL 12BIT R 13 - - - - - - N N - N N N N /WRIT PHYSICAL 12BIT R 14 - - - - - - N N - N N N N /FORMAT SD R 15 - - - - - - N - - - - - - /FORMAT DD R 16 - - - - - - N - - - - - - /MOUNT VOLUME R 17 - - - - - - N - - N N - - /DISMOUNT VOLUME R 20 - - - - - - N - - - - - - /GET VOLUME DATA R 21 - - - - - - N N - N N - - /GET DIRECTORY DATA R 22 - - - - - - N - - N N - - /MOUNT BOOT VOLUME R 23 - - - - - - N - - N N - - /UPDATE VOLUME DIR R 24 - - - - - - N - - N N - - /READ STATUS REG R 25 - - - - - - N - - N N - - / / / ERRORS REPORTED: / / THE ACP WILL RETURN ERROR STATUS IN THE USER'S Q-BLOCK / AT RXQCOD, I.E. THE FIRST WORD OF THE Q-BLOCK. AT FIRST, / THIS WORD IS SET TO ZERO, INDICATING THAT THE DRIVER IS / STILL PROCESSING THE REQUEST PREVIOUSLY MADE. THIS IS / NECESSARY BECAUSE THIS TASK OPERATES ASYNCHRONOUSLY. / WHEN I/O IS COMPLETE, EITHER THE BLOCK WAS GOTTEN OR AN / ERROR HAS OCCURRED. IF THE BLOCK WAS GOTTEN, THEN A +1 / IS PUT IN THE Q-BLOCK AT RXQCOD. IF AN ERROR HAS OCCURRED, / THEN EITHER A -1, -2 OR -3 ARE PUT IN THE Q-BLOCK AT RXQCOD. / A -1 MEANS A 'SOFT' ERROR HAS OCCURRED (CYCLIC REDUNDANCY) / A -2 MEANS A DENSITY CHANGE HAS OCCURRED (SHOULDN'T HAPPEN) / A -3 MEANS A 'HARD' ERROR I.E. DOOR OPEN, DRIVE PROBLEM ETC. / ### / / /D018 QUEFIL=CIF FIELD0 ACPBUF=INTBUF /INTERNAL BUFFER /********************************************************************* FIELD 2 /FOR WRITE DISK ONLY / FIELD 7 /ACTUAL LOAD FIELD *5600 /ACPLDP /LOAD ADDRESS FOR ACP /M018 ACENTR, JMP ACPSYS / DRIVER ENTRY POINT. /*********DENSYS MUST BE LOCATED AT ACPLDP+1*********** /************AS REFERENCED BY ACPDV0 ********************** DENSYS, /POINTER TO SYSTEM DRIVE DENSITY /------------------------------------------------------------- / /************** UNIT DENSITY TABLE ************************** /**************BIT 3 CONTAINS 0=SD************************** /************** 400=DD************************** /************** 1400=RX50************************ /************** 0001=WINNIE********************** / /------------------------------------------------------------- DRVDEN, IFDEF WINNIE < 0 /SYSTEM DRIVE IF WINNIE /A017 > /END IFDEF WINNIE IFDEF CONDOR < 0 /UNIT 1 DRIVE 0 SIDE 0 DEVICE# 0 0 /UNIT 1 DRIVE 1 SIDE 0 DEVICE# 1 0 /UNIT 2 DRIVE 0 SIDE 0 DEVICE# 2 0 /UNIT 2 DRIVE 1 SIDE 0 DEVICE# 3 0 /UNIT 1 DRIVE 0 SIDE 1 DEVICE# 4 0 /UNIT 1 DRIVE 1 SIDE 1 DEVICE# 5 0 /UNIT 2 DRIVE 0 SIDE 1 DEVICE# 6 0 /UNIT 2 DRIVE 1 SIDE 1 DEVICE# 7 0 /RX50 DEV 9 FOR VER 2.0 /A024 > /A014 / IFNDEF CONDOR < 0 /CONTROL 5 UNIT 1 0 / 5 UNIT 2 0 / 6 UNIT 1 0 / 6 UNIT 2 > /A014 / / **** PRIMARY CONTROL LOOP**** /--------------------------------------------------------------------- / / THE FOLLOWING ROUTINE IS THE MAIN PROCESSING LOOP. / WHENEVER THERE IS WORK FOR A HANDLER TO DO IT IS / ENTERED AND THE SPECIFIED OPERATION EXECUTED, ELSE / THE HANDLER IS RELEASED. / THIS ROUTINE WILL ALSO PUT A VALUE OF ZERO IN THE USER'S Q-BLOCK / TO INDICATE THAT I/O IS IN PROGRESS. WHEN I/O IS COMPLETE, EITHER / A PLUS 1 (GOOD RETURN) OR A NEGATIVE NUMBER (SOME ERROR) IS PUT / INTO THIS LOCATION TO SIGNAL THE USER WHAT HAPPENED. / THE ERROR VALUES ARE PASSED BACK HERE BY THE DRIVER. / /--------------------------------------------------------------------- ACEXIT, CIFSYS /M018 JEXIT / EXIT UNTIL AWAKENED. ACPSYS, CIFSYS /CIF QUEUE FIELD /M018 DEQUE / ANY REQUEST IN,... DSKQUE / ...IN THE DISK QUEUE ? JMP ACEXIT / NO - LET OTHERS RUN. DCA ACQCDF / YES - SAVE THE "CDF" INSTRUCTION. CDFSYS / CHANGE TO FIELD 0 /M018 TAD I RX0PTR /POINTER TO INDEX CDFFIO /CHANGE BACK TO MY FIELD /M018 IAC / X0 POINTS TO THE ONE BEFORE DCA ACQADR / SAVE USER'S Q-BLOCK ADDRESS /D026 DCA ACPALS /CLEAR ACP ALLOC WRITE SW /A016 DCA ACSAVE /CLEAR ERR RET /A013 IFDEF WINNIE < DCA WINISW /A017 > /END IFDEF WINNIE JMS ACPUTQ / SIGNAL USER I/O IN PROGRESS RXQCOD / LOCATION IN Q-BLOCK TO PUT CODE JMS ACPARG / CALL THE GET PARAM RTNE JMS SETPTR /SET DENSITY ADDRESS PTR TAD ACPFCT /LOAD FUNCTION CODE /A024 JMS ACPFUN / CALL THE FUNCTION PROCESSOR. TAD ACSAVE / GET RETURN CODE PASSED BY DRIVER SMA CLA / IF NEG FALL THRU /C030 JMP ACPOR0 / GO PROCESS NORMAL RETURN TAD ACPSVF /GET FUNCTION CODE /A017 SMA CLA /REQUEST ERROR RET? /A017 JMP NORETN /NO /A017 TAD ACSAVE /RETURN ERROR IN COD /M030 JMS ACPUTQ / GO PUT VALUE INTO USER'S Q-BLOCK/M030 RXQSPC / OFFSET TO PUT INTO Q-BLOCK /M030 TAD ACSAVE /RETURN ERROR IN COD /A004 JMP ACPPTQ / GO PUT RETURN CODE INTO Q-BLOCK ACPOR0, / IF POSITIVE, THEN RETURN INFO /D011 JMS ACPUTQ / GO PUT INFO INTO Q-BLOCK /D011 RXQSPC / OFFSET TO INFO RETURN IN Q-BLOCK ACZERO, AC0001 / SIGNAL GOOD RETURN ACPPTQ, JMS ACPUTQ / PUT CODE INTO Q-BLOCK RXQCOD / OFFSET TO CODE IN Q-BLOCK CDFSYS /SET SIGNAL FIELD /M018 DCA I SIGPTR /"SIGNAL" WAKE UP "JWAIT". CDFFIO / RESET /M018 JMP ACPSYS / LOOK FOR MORE TO DO. IFDEF WINNIE < WINISW, 0 /WINNIE SW=-#devices STORED ON WINNIE /A017 > /END IFDEF WINNIE ACQADR, 0 / HOLDS ADDRESS OF Q-BLOCK RX0PTR, X0 /POINTER TO INDEX IN OTHER FIELD SIGPTR, 3 /LOCATION OF SIGNAL / **** ROUTINE TO GET PARAMETERS PASSED BY CALLER**** /--------------------------------------------------------------------- / / THIS ROUTINE GETS THE PARAMETERS PASSED TO THE ACP / BY THE CALLER AND SAVES THOSE PARAMETERS IN THIS MODULE / FOR FUTURE USE IN CALLING THE DRIVER / /---------------------------------------------------------------------- ACPARG, 0 / RETURN ADDRESS TAD (ACPFNC-ACPGTQ) / LOAD NEGATIVE ELEMENT COUNT FOR LOOP CONTROL DCA ACPACT / SAVE NEGATIVE ARGUMENT COUNT. JMS ACPGTQ / LOAD POINTER TO Q-BLOCK ELEMENT OFFSETS ACPFNC, RXQFNC / OFFSET TO FUNCTION CODE (CALLER'S) RXQFNO / OFFSET TO FILE NUMBER RXQBAD / OFFSET TO BUFFER ADDRESS RXQBFD / OFFSET TO THE BUFFER FIELD RXQDRV / OFFSET TO DRIVE NUMBER RXQBLK / OFFSET TO STARTING BLOCK NUMBER RXQRS1 / OFFSET TO TRANSFER BLOCK COUNT RXQTRK / TRACK NO FOR PHYSICAL IO RXQSEC /ADDRESS OF SECTRO TOBE PROCESSED ACPGTQ, 0 / POINTER INTO Q-BLOCK OFFSET TABLE JMS ACPSVQ / LOAD POINTER TO TABLE OF LOCAL ADRESSES ACPFCT / ADDRESS FOR FUNCTION CODE (IN THIS MODULE) ACPFNO / ADDRESS FOR FILE NUMBER ACBADR / ADDRESS FOR BUFFER ADDRESS ACBFLD / ADDRESS FOR BUFFER FIELD ACUNIT / ADDRESS FOR DRIVE NUMBER ACBLKN / ADDRESS FOR STARTING BLOCK NUMBER RXDCNT / ADDRESS FOR TRANSFER BLOCK COUNT ACTRAK /ADDR OF TRACK TO BE PROCESSED ACSECT /ADDRESS OF SECTOR TO BE PROCESSED ACPSVQ, 0 / POINTER TO ADDRESSES OF SAVE AREAS IN THIS MODULE ACPSV1, TAD I ACPSVQ / LOAD ADDRESS OF SAVE AREA THIS MODULE DCA RXDDPB / ...AND SAVE IT. ISZ ACPSVQ / UPDATE POINTER TO NEXT SAVE AREA ADDRESS TAD I ACPGTQ / LOAD OFFSET OF ELEMENT IN Q-BLOCK TAD ACQADR / ... ADD IN ADDRESS OF Q-BLOCK,... DCA ACPPAR / ......AND SAVE IT. ISZ ACPGTQ / UPDATE POINTER INTO Q-BLOCK OFFSET TABLE. ACQCDF, CDFSYS / REACH INTO QUEUE FIELD,... /M018 TAD I ACPPAR / ...LOAD PARAMETER,... CDFFIO / ......CHANGE BACK TO CURRENT FIELD,.../M018 DCA I RXDDPB / .... AND PUT PARAMETER INTO THIS MODULE ISZ ACPACT / ALL ARGUMENTS PROCESSED? JMP ACPSV1 / NO - PROCESS NEXT ARG CLA CLL CML RTR /=2000 VERIFY BIT /A006 AND ACPFCT /ISOLATE VERIFY BIT /A006 DCA ACPVFY /SAVE /A006 TAD ACPFCT /GET FUNCTION CODE DCA ACPSVF /SAVE H/O BITS WITH F.C. TAD ACPFCT /GET FUNCTION CODE AND M377 /MASK OUT OLD FUNCTION BITS DCA ACPFCT /RESET JMP I ACPARG / ALL DONE - GOBACK / / /IO SETS UP SECTOR FOR PHYSICAL I/O FOR NON WINNIE /FOR WINNIE --PHYSIO USED ONLY FOR 8 OR 12 BIT READ BUT USES / --BLOCK NUMBER NOT TRACK SECTOR / /FOLLOWING ADDED ************** VERSION 019 *********** ACPIOL, 0 TAD ACXDIR /FUNCTION CODE SPA /IS =PHYSIO CMA /YES--SET POS CLL RAR /L/O BIT SET= WINNIE SZL CLA /IS IT WINNIE? JMP I ACPIOL /YES TAD ACSECT /NO--SET SECTOR FOR DSKHND DCA ACPSCT /=ACBLKN JMP I ACPIOL / / ACPACT, 0 / POINTER TO Q-BLOCK OFFSETS (FOR LOOP CONTROL) ACPPAR, 0 / ADDRESS OF Q-BLOCK PARAMETER (FOR INDIRECT USE) RXDDPB, 0 / INDIRECT ADDRESS FOR PARAM ADDRESSES ACPFCT, 0 / AREA TO SAVE FUNCTION PASSED BY USER ACPFNO, 0 / AREA TO SAVE FILE NUMBER ACSECT, 0 /AREA TO SAVE SECTOR ACPSVF, 0 /SAVE INPUT FUNCTION CODE M377, 377 /MASK PAGE / / ****ROUTINE TO ALLOCATE A BLOCK ON A DISKETTE**** /--------------------------------------------------------------------- / / THIS ROUTINE WILL READ IN THE ALLOCATION BLOCK, FIND THE FIRST / FREE BLOCK ON THE DISKETTE, MARK IT AS BEING IN USE (BIT OFF), / AND RETURN THE BLOCK NUMBER TO THE USER IN HIS Q-BLOCK. / THE ALLOCATION BLOCK IS THEN RE-WRITTEN TO THE DISKETTE. / /--------------------------------------------------------------------- /ACALLO - ALLOCATE A BLOCK ACALLO, 0 JMS ACUPIN / GO GET ALLOCATION BLOCK RXBALC / TELL ACUPIN WE WANT ALLOCATION BLOCK / GET NUMBER OF ALLOCATED WORDS TAD ACPBUF+4 DCA ACDAL5 / SAVE FOR COUNTING TAD (ACPBUF+5-1) / GET ADDR OF FIRST WORD DCA ACDAL7 / SAVE IT JMS ACPUTQ / SET A ZERO INTO 'RXQBLK' /a015 RXQBLK / /a015 ACDAL2, ISZ ACDAL5 / ANY MORE TO CHECK? SKP JMP I ACALLO / NO - OUT OF ROOM - FATAL ERROR ISZ ACDAL7 TAD I ACDAL7 / GET NEXT WORD SNA CLA / ANY FREE BLOCKS (1 BITS)? JMP ACDAL2 / NO - TRY NEXT WORD TAD ACDAL7 TAD (-ACPBUF-5) CLL RTL / AND MULT BY 8 CLL RAL DCA ACDAL5 / SAVE AS UPDATED COUNT TAD (ACBCON-1 / GET ADDR OF BIT MASK CONSTANTS DCA ACDFR3 / SAVE /C031 ACDAL3, ISZ ACDFR3 /INC TST BIT POINTER /A032 ISZ ACDAL5 / INCR COUNT OF BLOCK THAT IS FREE TAD I ACDAL7 / GET ALLOC INFO WORD AND I ACDFR3 / TEST THE BIT /C031 SNA JMP ACDAL3 / NOT ON - TRY NEXT BIT CMA / TURN ONLY THAT BIT OFF AND I ACDAL7 / IN ALLOC INFO WORD DCA I ACDAL7 / AND SAVE IT AC7777 / DECR COUNT TAD ACDAL5 / AND THAT'S THE BLOCK NUMBER JMS ACPUTQ / SAVE FOR USER RXQBLK AC7777 / DECR COUNT OF FREE TAD ACPBUF+3 DCA ACPBUF+3 /D012 JMS ACUPOT / GO PUT OUT UPDATED ALLOCATION BLOCK/M003 JMS ACDSP1 / SET FREE BLOCK COUNT IN QBLK /M003 JMS ACSETF /SET UPDATE SW /A012 JMP I ACALLO / RETURN ACDAL7, 0 / ****ROUTINE TO FREE UP A BLOCK ON A DISKETTE**** /-------------------------------------------------------------------- / / THIS ROUTINE WILL DE-ALLOCATE A BLOCK ON THE DISKETTE. / THE ROUTINE READS IN THE ALLOCATION BLOCK, TURNS ON THE / IN-USE BIT FOR THE BLOCK NUMBER PASSED TO IT BY THE / USER, INCREMENTS THE NUMBER OF FREE BLOCKS ON THE DISKETTE / UPDATES THAT VALUE IN THE ALLOCATION BLOCK, AND THEN / RE-WRITES THE ALLOCATION BLOCK BACK OUT ON THE DISKETTE. / /-------------------------------------------------------------------- ACDEAL, 0 TAD ACBLKN / GET BLOCK NUMBER TO DEALLOCATE DCA ACDFR3 / SAVE IT TO FREE UP AC JMS ACUPIN / GO GET ALLOCATION BLOCK RXBALC / TELL ACUPIN WE WANT ALLOCATION BLOCK TAD ACDFR3 / GET BLOCK NUMBER CLL RAR / DIV BY 8 TO GET WORD OFFSET CLL RAR CLL RAR TAD (ACPBUF+5) / MAKE INTO ADDR IN ALLOC INFO BLOCK IN MEMORY DCA ACDFR4 / SAVE TAD ACDFR3 / GET BLOCK NUMBER AGAIN AND (7) / GET LOW ORDER BITS - BIT OFFSET TO CLEAR TAD (ACBCON) / ADD TABLE ADDR DCA ACDFR3 / SAVE AS ADDR OF MASK WORD TAD I ACDFR3 / GET MASK WORD MQL / SAVE FOR "OR" TAD I ACDFR4 / ADD ALLOC WORD - THIS TURNS ON PROPER BIT MQA / BY "OR"ING WITH MASK WORD DCA I ACDFR4 / SAVE UPDATED WORD IN MEMORY ISZ ACPBUF+3 / INCR COUNT OF FREE BLOCKS JMS ACDSP1 / COPY COUNT TO QBLK /D012 JMS ACUPOT / GO PUT OUT THE ALLOCATION BLOCK JMS ACSETF /A012 JMP I ACDEAL / DONE - RETURN TO CALLER ACDFR3, 0 SVBLKN, /SAVE FIRST BLOCK NUMBER /M022 ACDAL5, /USE FOR ALLOCATE-NO CONFLICT WITH DEALLOCATE /M031 ACDFR4, 0 / ****ROUTINE TO SET THE FIRST BLOCK NUMBER OF A FILE**** /------------------------------------------------------------------ / / THIS ROUTINE WILL SET THE FIRST BLOCK (THE HEADER BLOCK) / OF A FILE. THE FILE NUMBER AND THE BLOCK NUMBER MUST / BE PASSED TO IT IN THE USER'S Q-BLOCK. / THE ROUTINE WILL READ IN THE DIRECTORY BLOCK (HOME BLOCK), / AND STUFF THE BLOCK NUMBER PASSED TO IT IN THE Q-BLOCK / INTO THE HOME BLOCK'S LIST OF POINTERS TO THE HEADER BLOCKS. / THE FILE NUMBER PASSED TO IT IN THE USER'S Q-BLOCK IS / USED TO FIND THE LOCATION IN THE HOME BLOCK TO STUFF THE / FIRST BLOCK NUMBER. THE HOME BLOCK IS THEN RE-WRITTEN TO / THE DISKETTE. / THE ENTRY POINT ADDRESS OF THIS ROUTINE IS USED BY 'ACBGET' ROUTINE / TO PUT ADDRESSES INTO IT FOR INDIRECT USE WHEN THIS ROUTINE IS NOT / BEING USED / /------------------------------------------------------------------- /ACBSET - SET BLOCKNO OF FIRST BLOCK OF FILE ACBGID, / LOCATION FOR INDIRECT ADDRESS FOR ACBGET ROUTINE ACBSET, 0 TAD ACBLKN DCA SVBLKN /SAVE TEMP JMS ACRDIR / GO GET DIRECTORY BLOCK /C024 TAD ACPFNO / GET FILE NUMBER TAD (ACPBUF+RXPDRI / ADD TO START OF DIR IN MEMORY DCA ACBSID / AND SAVE TO BE INDIRECTED THROUGH TAD SVBLKN / GET BLOCK NUMBER TO SET IT TO DCA I ACBSID / AND SET IT JMS ACSETF /SET UPDATE SW /A012 JMS ACUPOT / GO RE-WRITE DIRECTORY BLOCK JMP I ACBSET / AND RETURN / ****ROUTINE TO GET AND RETURN THE FIRST BLOCK NUMBER OF A FILE**** /--------------------------------------------------------------------------- / / THIS ROUTINE WILL GET AND RETURN THE FIRST BLOCK OF A FILE (THE / HEADER BLOCK NUMBER). THE USER MUST PASS THE FILE NUMBER TO IT / IN THE Q-BLOCK. THE ROUTINE WILL RETURN THE FIRST BLOCK NUMBER / OF THE FILE IN THE Q-BLOCK. THE ROUTINE READS THE DIRECTORY BLOCK / (I.E. THE HOME BLOCK), AND USES THE FILE NUMBER PASSED TO IT TO / FIND THE FIRST BLOCK NUMBER, STUFFS THAT NUMBER INTO THE USER'S / Q-BLOCK, AND THEN RETURNS. / THE ENTRY POINT ADDRESS OF THIS ROUTINE IS USED AS A LOCATION TO PUT / ADDRESSES FOR INDIRECT USE BY THE 'ACBSET' ROUTINE WHEN THIS ROUTINE / IS NOT IN USE. / /-------------------------------------------------------------------------- /ACBGET - GET BLOCK NO OF FIRST BLOCK OF FILE ACBSID, / LOCATION FOR INDIRECT ADDRESSES FOR ACBSET ROUTINE ACBGET, 0 JMS ACRDIR / GO GET DIRECTORY BLOCK /C024 TAD ACPFNO / GET FILE NUMBER TAD (ACPBUF+RXPDRI / ADD TO START OF DIR IN MEMORY DCA ACBGID / SAVE TAD I ACBGID / GET BLOCK NUMBER JMS ACPUTQ / AND PUT WHERE CALLER CAN GET IT RXQBLK / TELL ACPUTQ WHERE TO RETURN BLOCK # IN Q-BLOCK JMP I ACBGET / RETURN SIZE=.-ACBGET / /*****SPACE WARS MOVE AND SPLIT***** VER 017 /A017 FUNTBL, ACPDIR / ACPR08 / READ PHYSICAL FUNCTION 8BIT. ACPW08 / WRITE PHYSICAL FUNCTION 8BIT. ACREAD / READ LOGICAL. ACWRIT / WRITE LOGICAL. ACALLO / ALLOCATE A BLOCK. ACDEAL / DE-ALLOCATE A BLOCK. ACBGET / GET 1ST BLK. # OF 1ST BLK. OF FILE. ACBSET / SET 1ST BLK. # OF 1ST BLK. OF FILE. ACFREE / GET # OF FREE BLOCKS ON ACPICE. RZTYPE / GET DENSITY AND SET FOR SPECIFIED UNIT ACPR12 /READ PHYSICAL FUNCTION 12BIT. ACPW12 /WRIT PHYSICAL FUNCTION 12BIT. ACFMTS /FORMAT SD DISKETTE ACFMTD /FORMAT DD IFDEF WINNIE < ACMNT /MOUNT VOLUME /A017 ACDMNT /DISMOUNT VOLUME /A017 ACGETV /GET VOLUME DATA /A017 ACGETD /GET DIRECTORY DATA /A017 ACMNTS / MOUNT SYSTEM VOLUME /A017/C021 ACUPDD /UPDATE DIRECTORY /A022 ACGETS /GET STATUS /A024 > /END IFDEF WINNIE /A023 /*****MOVED TO HERE SPACE WARS WHEN WINNIE CODE ADDED VER. 017 ****** SPARE=.+177&7600-. PAGE / / / / *****ROUTINE TO READ HOME AND ALLOCATION BLOCKS**** / /---------------------------------------------------------------------- / / THIS ROUTINE IS USED INTERNALLY BY THE ACP ONLY. / IT SETS UP THE PROPER CALLING SEQUENCE FOR THE DRIVER / IN ORDER TO READ THE ALLOCATION OR HOME (DIRECTORY) BLOCK / INTO AN INTERNAL BUFFER. / IT IS ALSO USED IN PHYSICAL READS AND WRITES. / /---------------------------------------------------------------------- / / THIS ROUTINE CHECKS TO SEE IF BLOCK IS ALREADY IN MEMORY /A012 / IF NOT IT CALLS ACUPOT TO WRITE OUT IF NECESSARY /A012 / THEN READS IT IN. /A012 /----------------------------------------------------------------------- / ACUPIN - READ IN BLOCK INTO ACPBUF / JMS ACUPIN / BLOCK NUMBER TO BE READ / RETURN POINT ACUPIN, 0 TAD I ACUPIN / GET BLOCK NUMBER TO BE READ CIA /CHECK IS LAST BLOCK READ /A012 TAD LSTBLK /A012 SZA CLA /A012 JMP ACPIC /NO /A012 TAD ACUNIT /SAME DRIVE /A012 CIA TAD LSTDRV /LAST DRIVE READ FROM /A012 SNA CLA /A012 JMP ACPRT2 /YES BLOCK ALREADY IN BUFFER /A012 ACPIC, JMS ACUPOT /CHECK SEE IF BUFFER SHOULD BE WRITTEN OUT/A012 TAD I ACUPIN /BLK READ /A012 DCA ACBLKN / PASS BLOCK NO TO DRIVER IN CALL LIST TAD (ACPBUF) / GET ADDRESS OF INTERNAL BUFFER DCA ACBADR /PUT INTERNAL BUFFER ADDRESS INTO DRIVER CALL LIST TAD ACDFLD / GET CDF OF THIS FIELD DCA ACBFLD / PUT CDF OF THIS FIELD INTO DRIVER CALL LIST AC7777 / SET UP TRANSFER COUNT DCA RXDCNT / PUT TRANSFER COUNT INTO DRIVER CALL LIST JMS ACREAD / GO DO A READ OPERATION TAD ACSAVE /READ ERROR? /A012 SPA CLA /A012 JMP ACPRET /IGNORE REST AND RETURN FROM FUNCTION CODE/A012 TAD I ACUPIN /BLK READ /A012 DCA LSTBLK /SAVE /A012 TAD ACUNIT /UNIT TO BE READ /A012 DCA LSTDRV /LAST DRIVE READ /A012 ACPRT2, ISZ ACUPIN / BUMP UP RETURN ADDRESS JMP I ACUPIN / DONE / ACDFLD, CDFFIO /CDF ACP FIELD /M018 / ****ROUTINE TO WRITE OUT THE ALLOCATION OR HOME BLOCKS**** /------------------------------------------------------------------- / / THIS ROUTINE IS USED INTERNALLY BY THE ACP ONLY. / THE ROUTINE WILL WRITE OUT AN ALLOCATION OR HOME (DIRECTORY) / BLOCK THAT WAS PREVIOUSLY GOTTEN AND UPDATED. / IT IS ALSO USED IN PHYSICAL WRITES. /------------------------------------------------------------------- /ACUPOT - WRITE OUT ACPBUF ONTO DEVICE ACUPOT, 0 TAD ACUPDT /GET UPDATE MODE SW /A012 SNA CLA /IS IT SET /A012 JMP I ACUPOT /NO /A012 /D012 CLA CLL / CLEAR AC. TAD ACBLKN /SAVE BLOCK NUM TEMP /A012 DCA SVBLK1 /A012 TAD ACUNIT /SAVE DRIVE NO TEMP /A012 DCA SVUNI1 /A012 TAD LSTBLK /GET BLOCK NUM TO BE WRITTEN /A012 DCA ACBLKN /SET IT /A012 TAD LSTDRV /GET DRIVE BLOCK CAME FROM /A012 DCA ACUNIT /A012 TAD (ACPBUF) / GET ADDRESS OF INTERNAL BUFFER DCA ACBADR / PUT IT INTO DRIVER CALL LIST TAD ACDFLD / GET CDF TO THIS FIELD DCA ACBFLD / PUT IT INTO DRIVER CALL LIST AC7777 / SET UP TRANSFER COUNT DCA RXDCNT / PUT TRANSFER COUNT INTO DRIVER ALL LIST JMS SETPTR /SET DENSITY IN CASE DEV DIF. /A012 TAD ACPVFY /SAVE VERIFY SW..MAY NOT BE NEC /A012 DCA SAVVFY /...... /A012 CLA CLL CML RTR /2000=VERIFY BIT /A012 DCA ACPVFY /SET IT /A012 JMS ACWRIT / GO WRITE OUT THE BLOCK TAD SVBLK1 /GET BLK NUM /A012 DCA ACBLKN /RESET /A012 TAD SVUNI1 /DRIVE NUM /A012 DCA ACUNIT /RESET /A012 TAD SAVVFY /RESTORE VFY SW /A012 DCA ACPVFY /A012 TAD ACSAVE /CHECK ERROR /A012 SPA CLA /IS IT ERR? /A012 JMP ACPRET /YES EXIT /A012 DCA ACUPDT /CLEAR MODE SW FLAG USED TO DETERMINE/A012 /...WHETHER TO WRITE OUT BUFFER OR NOT/A012 /A012 JMS SETPTR /RESET DENSITY /A012 JMP I ACUPOT / DONE SVUNI1, 0 /TEMP SAVE WHILE DIR/ALLOC BLK WRITTEN /A012 SVBLK1, 0 /TEMP SAVE DRIVE /A012 SAVVFY, 0 /SAVE VERIFY SW /A012 / ****ROUTINE TO PUT VALUES INTO USER'S Q-BLOCK**** / /------------------------------------------------------------- / / THIS ROUTINE WILL PUT VALUES FROM THE AC INTO THE / Q-BLOCK THE USER PASSES TO THIS MODULE. / / CALLING SEQUENCE: / JMS ACPUTQ / OFFSET TO THE ENTRY IN QUEUE / RETURN POINT / VALUE MUST BE PASSED IN AC. / /------------------------------------------------------------- ACPUTQ, 0 DCA ACSAV1 / SAVE VALUE PASSED TO FREE AC /C010 TAD ACQADR / GET QUEUE BLOCK ADDRESS TAD I ACPUTQ / ADD IN THE OFFSET TO ELEMENT ISZ ACPUTQ / BUMP UP TO RETURN POINT DCA ACPTQ2 / STUFF ADDRESS FOR INDIRECT USE TAD ACQCDF / GET CDF INSTRUCTION OF Q-BLOCK FIELD DCA .+2 / STORE IT TO EXECUTE NEXT INSTRUCTION TAD ACSAV1 / GET VALUE PASSED*IS IN DIFF PAGE**CAUTION/C010 CDFSYS / CDF INSTRUCTION LOCATION /M018 DCA I ACPTQ2 / STUFF VALUE INTO Q-BLOCK CDFFIO / CDF BACK TO THIS FIELD /M018 JMP I ACPUTQ / RETURN TO CALLER ACPTQ2, 0 ACSAV1, 0 /SAVE TEMP /A010 / ****ROUTINE TO GET NUMBER OF FREE BLOCKS ON DISKETTE**** /------------------------------------------------------------------- / / THIS ROUTINE WILL READ IN THE ALLOCATION BLOCK, GET / THE NUMBER OF FREE BLOCKS ON THE DISKETTE AND PASS / THAT NUMBER BACK TO THE USER'S Q-BLOCK / /------------------------------------------------------------------- ACFREE, /SERVICE "# FREE BLOCKS" COMMAND 0 JMS ACUPIN / GO GET ALLOCATION BLOCK /C024 RXBALC / TELL ACUPIN WE WANT ALLOCATION BLOCK /C024 JMS ACDSP1 / COPY # TO QBLK JMP I ACFREE / RETURN /---------------- / /GET DIRECTORY BLOCK-----SPACE WARS MOVE----VER 024----- / ACRDIR, 0 /A024 JMS ACUPIN / GO GET DIRECTORY BLOCK /M024 RXBDIR / TELL ACUPIN WE WANT DIRECTORY BLOCK JMP I ACRDIR /A024 /--------------------------------------------------------------------- / / THE FOLLOWING SUBROUTINE DETERMINES THE FUNCTION TO BE / PERFORMED BY THE SPECIFIED DEVICE AND DISPATCHES TO THE / ROUTINE THAT SETS UP THE PARAMETERS AND CALLS THE / DRIVER. / /--------------------------------------------------------------------- ACPFUN, 0 / ENTRY POINT TO FUNCTION PROCESSOR. /D024 TAD ACPFCT / LOAD THE FUNCTION CODE /D017 JMS ACFNCT / ......AND THE TABLE HEAD. TAD ACFNCT / BUILD ADDRESS,... DCA ACPUTQ / ...OF CORRECT PROCESSOR,... TAD I ACPUTQ DCA ACPUTQ JMS I ACPUTQ / ......AND GO DO FUNCTION,... ACPRET, JMP I ACPFUN / RETURN TO CALLER. /C012 ACFNCT, FUNTBL /PTR TO FUNCTION TABLE /A017 /D024ACJTMP, 0 /TEMP /A017 SIZE=.-ACPFUN / /******SPACE WARS MOVE VER 024 ******* / LSTBLK, 0 /BLOCK CONTAINED IN ACP BUFFER /A012 LSTDRV, 0 /DRIVE BLOCK READ FROM /A012 /------------------------------------------------------------------- / THESE ARE THE BIT MASK CONSTANTS USED BY THE ALLOCATE AND / DE-ALLOCATE ROUTINES TO TURN THE IN-USE BITS ON OR OFF. / AN 'ON' IN-USE BIT MEANS THAT THE BLOCK IT REFERS TO IS / AVAILABLE FOR ALLOCATION (THIS IS PERVERSE---I KNOW, BUT...). / AN 'OFF' IN-USE BIT MEANS THAT THE BLOCK IT REFERS TO IS IN USE. / /--------------------------------------------------------------------- /ACBCON - BIT MASK CONSTANTS FOR ACALLO AND ACFREE ACBCON, 200 100 040 020 010 004 002 001 PAGE EJECT PGTOP=. / TOP OF THE PAGE /A035 /------------------------------------------------------------- / / THIS ROUTINE MOVES THE NUMBER OF FREE BLOCKS FROM THE / ALLOCATION BLOCK TO THE USER'S Q-BLOCK. / /--------------------------------------------------------------- ACDSP1, / COPY # FREE BLOCKS TO QBLK 0 TAD ACPBUF+3 / FROM ALLOC BLOCK JMS ACPUTQ / GO PUT VALUE INTO USER'S Q-BLOCK RXQSPC / TELL ACPUTQ WHERE IN Q-BLOCK VALUE MUST GO JMP I ACDSP1 / RETURN / **** ROUTINES TO PROCESS READ, WRITE. **** /--------------------------------------------------------------------- / / THE FOLLOWING ROUTINES PROCESS THE READ AND WRITE / FUNCTIONS. / /--------------------------------------------------------------------- ACREAD, 0 / ENTRY POINT TO "ACREAD". AC0002 / SET THE "READ" FUNCTION,... JMS ACWRIT / ...AND CALL THE COMMON IO ROUTINE. JMP I ACREAD / RETURN TO CALLER. / / / ACWRIT, 0 / ENTRY POINT TO 'ACWRIT' JMS DENADD /ADD DENSITY BIT TO IO OPERATION(AC) TAD ACPVFY /ILLEGAL FOR READ LOGICAL BUT IGNORED IN HNDLER/A006 DCA ACXDIR / PUT OPERATION INTO DRIVER CALL LIST JMS ACPIOC / GO DO THE I/O JMP I ACWRIT / RETURN TO CALLER. / ACPVFY, 0 /VERIFY BIT ILLEG.FOR READ LOGICALAND WRITE PHYSICAL BUT/A006 /......IGNORED IN HNDLER. /A006 /_____________________________________________________________________ / / PHYSICAL I/O ROUTINES / / ACPR08 READ 8 BIT MODE / ACPW08 WRITE 8 BIT MODE / ACPR12 READ 12 BIT MODE / ACPW12 WRITE 12 BIT MODE / / RXQTRK CONTAINS PHYSICAL TRACK TO BE READ / RXQSEC CONTAINS PHYSICAL SECTOR TO BE READ / / / ONLY 1 SECTOR TO BE PROCESSED AT THIS TIME / / /________________________________________________________________________ / ACPR08, 0 CLA CLL CML RTL /READ CODE = 2 TAD ACPVFY /VERIFY SW /A006 JMS ACPW08 /ADD MODE BIT AND COMPLEMENT JMP I ACPR08 /EXIT / / ACPW08, 0 TAD ACP100 /8 BIT MODE JMS DENADD /ADD DENSITY BIT TO CMND CMA /SET PHYSICAL I/O FUNCTION DCA ACXDIR /SAVE JMS ACPIOL /GET TRACK AND SECTOR JMS ACPIOC /CALL HNDLER JMP I ACPW08 /RETURN / ACP100, 100 /SD MODE BIT RZFMTD, 4 /FORMAT DISK FUNCTION CODE RZDDBT, 400 /DOUBLE DENSITY BIT / ACPR12, 0 CLA CLL CML RTL /2=READ CODE TAD ACPVFY /VERIFY BIT /A006 JMS ACPW12 /ADD MODE AND SET PHYSICAL FUNCTION JMP I ACPR12 /EXIT / ACPW12, 0 JMS DENADD /ADD DENSITY BIT TO CMND CMA DCA ACXDIR /SAVE JMS ACPIOL /GET TRACK AND SECTOR JMS ACPIOC /DO FUNCTION JMP I ACPW12 /EXIT / / /D019ACPIOL, 0 /D019 TAD ACSECT /D019 DCA ACPSCT /SAVEIN BLK NM /D019 JMP I ACPIOL / /ACFMTS FORMAT DISKETTE SD / ACFMTS, 0 CLA IAC BSW /=100 JMS ACFMTE /COMPL AND DO IT JMS SETPTR /SET DENSITY PTR DCA I DENADR /SAVE DENSITY /C042 JMP I ACFMTS /RETURN / /ACFMTD FORMAT DD / ACFMTD, 0 TAD RZDDBT /DOUBLE DENSITY JMS ACFMTE /COMPL AND DO IT JMS SETPTR /SET DD PTR CLA CLL CML RTR /SET BIT 3=1 DD RTR DCA I DENADR /SAVE DENSITY /C042 JMP I ACFMTD / ACFMTE, 0 TAD RZFMTD /ADD FUNCTION CODE CMA DCA ACXDIR /STORE FUNCTION JMS ACPIOC /DO IT JMP I ACFMTE /EXIT / /-------------------------------------------------------------- / /************** ADD DENSITY TO CURRENT CODE IN AC************** / /-------------------------------------------------------------- DENADD, 0 TAD I DENADR AND K3777 /CLEAR WINNIE MOUNTED BIT IF SET /A020 JMP I DENADD /IS HERE BECAUSE OF FULL PAGES K3777, 3777 / /-------------------------------------------------------------- / /*************** SETS THE DENSITY POINTER TO CURRENT UNIT****** / /-------------------------------------------------------------- SETPTR, 0 TAD ACUNIT /GET CURRENT UNIT NO TAD TBLPTR /ADD ADDRESS POINTER DCA DENADR /SAVE POINTER TAD DENADR /SET 2ND PTR ON DIF PAGE /A019 DCA DENPT2 /A019 JMP I SETPTR / TBLPTR, DRVDEN /POINTER TO TABLE DENADR, 0 /ADDRESS OF CURRENT UNIT DENSITY /------------------------------------------------------------------------ / / THIS CODE IS TO MAKE THE ACP COMPATIBLE WITH EXISTING CODE FOR / BASE LEVEL 1.1 ONLY. THE FORCE DIRECTORY BLOCK OUT ROUTINE / WAS NECESSARY BECAUSE THE RX HANDLER WOULD UPDATE THE / DIRECTORY/ALLOCATION BLOCKS WITHOUT WRITING THEM OUT EACH TIME / IT CHANGED THEM. IF THIS ROUTINE WASN'T CALLED, THERE WAS A DANGER / THAT THE CHANGED BLOCK WOULD NOT GET WRITTEN OUT. / THIS ROUTINE WILL GO AWAY FOR OTHER BASE LEVELS. / /-------------------------------------------------------------------------- ACPDIR, 0 / ENSURE THAT DIR/ALLOC BLOCK IS WRITTEN OUT JMS ACUPOT /WRITE OUT BLOCK IF NECESSARY /A012 DCA LSTBLK /CLEAR LAST BLOCK READ /A012 JMP I ACPDIR / GO BACK /______________________________________________________________________ / SET MODE SWITCH 1=BUFFER CONTAINS BLOCK # READ / AND DRIVE READ FROM... / KEPT IN LSTDRV, LSTBLK / /_______________________________________________________________________ ACSETF, 0 /SET MODE SW CLA CLL IAC /1 /A012 DCA ACUPDT /A012 JMP I ACSETF /RETURN /A012 / / ACUPDT, 0 /STOREAGE AREA FOR BUFFER MODE SW /A012 / /*******SPACE WARS MOVE VER 028 ******** / MSGCMD, TEXT /^P!E^P^S!D^S^S^P^S^P^S!D^P^S^P^S/ /C030 MSGRD, IFDEF ENGLSH /M030 IFDEF SPANISH IFDEF DUTCH IFDEF ITALIAN IFDEF V30NOR /A034 MSGWRT, IFDEF ENGLSH IFDEF SPANISH IFDEF DUTCH IFDEF ITALIAN /M030 IFDEF V30NOR /A034 / /*******SPACE WARS MOVE VER 024 ******** / DRVTBL, 0000 /0=SD /A017 0400 /1=DD /A017 1400 /2=RX50 SINGLE SIDE /A017 1400 /3=RX50 DBLE SIDED /A017 WINCOD, 4001 /4=WINNIE /A017 /--------------- PAGE IFNZRO .-PGTOP-200 /A035 EJECT /------------------------------------------------------------------------- / / THE ROUTINE BELOW WILL GET THE DENSITY OF THE DISKETTE OF THE / DRIVE PASSED TO IT BY THE USER IN THE Q-BLOCK / / / RETURNS 0=SD RX01/RX02 / 1=DD RX02 / 2=RX50 SINGLE SIDED / 3=RX50 DOUBLE SIDED / 4=WINNIE /A017 /----------------------------------------------------------------------- / RZTYPE, 0 / GET DENSITY OF DISK DRIVE CLA CLL CML IAC RTL /6 = READ STATUS CMA /PHYS I/O DCA ACXDIR /SET CODE JMS ACPIOC /DO IT TAD ACSAVE /GET RETURN CODE SPA CLA /IS IT ERROR? /C010 JMP I RZTYPE /YES DON'T SET DENSITY TAD ACSAVE /A010 TAD DRTPTR /DRIVE TYPE TABLE PTR /A017 DCA DRVTMP /TMP PTR /A017 TAD I DRVTMP /GET VALUE /A017 SETDNA, DCA I DENPT2 /SET TO CURRENT UNIT TAD ACSAVE /GET DENSITY /A011 JMS ACPUTQ /PUT INT SPC AT THIS POINT /A011 RXQSPC /A011 JMP I RZTYPE / GO BACK TO CALLER DENPT2, 0 /TEMP ADDR PTR DRTPTR, DRVTBL /PNTR TO DRIVER TYPE TABLE /A017 DRVTMP, 0 /TEMP POINTER /A017 /-------------------- / **** COMMON I/O REQUEST ROUTINE **** /--------------------------------------------------------------------- / / THE FOLLOWING ROUTINE IS THE COMMON I/O ROUTINE, DOING / REQUESTS AS REQUIRED BY THE Q-BLOCK ENTRIES, OR / INTERNAL ANCILLARY CONTROL PROCESSOR FUNCTIONS. / THE CALLING SEQUENCE IS: / JMS ACPIOC / THE USER MUST INITIALIZE THE CONSTANTS IMMEDIATELY / FOLLOWING THE JMS I DRIVER INSTRUCTION BEFORE ENTERING / THIS ROUTINE. (SEE BELOW). / /--------------------------------------------------------------------- ACPIOC, 0 / ENTRY POINT TO "ACPIOC". ACPCNT, /A017 TAD RETFLD /SET RETURN FLD IN AC CIFSYS /SET TO DRIVER FLD /M018 CALLDR, JMS I DRIVER / .........AND CALL DRIVER. ACUNIT, 0 / DEVICE UNIT NUMBER. ACPSCT, /SECTOR NO FOR PHYSICAL I/O ACBLKN, 0 / STARTING BLOCK NUMBER. ACBFLD, 0 / BUFFER FIELD "CDF". ACBADR, 0 / BUFFER FIELD ADDRESS. RXDCNT, 0 / DEVICE BLOCK COUNT TO TRANSFER. ACTRAK, 0 /TRACK NO PHYSICAL IO ACXDIR, 0 / CODE FOR READ/WRITE (R=2,W=0) SYSRET, /A017 DCA ACSAVE / SAVE THE AC JUST RETURNED JMP I ACPIOC / GO BACK TO CALLER ACSAVE, 0 / SPOT TO SAVE RETURN CODE DRIVER, RX2SYS / ADDRESS OF DEVICE HANDLER RETFLD, CDIFIO /RETURN FLD /M018 RX2SYS=RXDLDP /DRIVER START SIZE=.-ACPIOC EJECT / /THE FOLLOWING IS CODE TO ADDRESS THE WINNIE /A017 / IFDEF WINNIE < MNTVOL=6 /6=MOUNT VOLUME DMTVOL=10 /10=DISMOUNT VOLUME GTVOL=12 /12=GET VOLUME DATA RDDIR=14 /14=READ DIR DATA VOLUPD=16 /16=UPDATE VOLUME DATA GTDEVS=20 /20=GET DEVICE STATUS /A024 / /MOUNT WINNIE VOLUME-- / UNIT NUMBER IN ACUNIT / VOLUME NAME POINTER IN ACBADR / VOLUME NAME FLD IN ACBFLD / ACMNT, 0 CLA IAC /CHECK IF DEVICE MOUNTED /C022 AND I DENPT2 / /C022 SZA CLA /A022 JMP I ACMNT /IS MOUNTED RETURN /A019 JMS ACCHKV /YES MOUNT IT -MNTVOL /MOUNT VOLUME COMMAND WITH WINNIE BIT<11> TAD ACSAVE /ERROR? /A020 SPA CLA /A020 JMP I ACMNT /YES /A020 TAD WINCOD /NO (4001) /A020 DCA I DENPT2 /SET MOUNTED WINNIE CODE IN TABLE /A020 JMP I ACMNT /RETURN / / / /DISMOUNT COMMAND / UNIT NUMBER IN ACUNIT / ACDMNT, 0 CLA IAC /CHECK IF DEVICE MOUNTED /C022 AND I DENPT2 / /C022 SNA CLA /C022 JMP ACDMTE /NOT MOUNTED JMS ACCHKV /IS MOUNTED -DMTVOL /DISMOUNT COMMAND WITH WINNIE BIT<11> TAD ACSAVE /A020 SPA CLA /ERROR? /A020 JMP I ACDMNT /YES EXIT /A020 TAD DRVDEN /DEV 0 DEN CODE /A024 SPA CLA /IS 0=WINNIE /A024 JMP ACDMNV /YES /A024 CLA CMA /-1 TAD ACUNIT /DRIVE # SZA CLA /=DRIVE 1? ACDMNV, /A024 CLA CLL CML RAR /NO RESET WINNIE BIT(4000) DCA I DENPT2 /CLEAR MOUNT BIT JMP I ACDMNT /RETURN / ACDMTE, /C022 CLA CMA /-1 /A022 DCA ACSAVE /SET ERROR RET /A022 JMP I ACDMNT /RET / / /GET VOLUME DATA / UNIT NUMBER IN ACUNIT / ACGETV, 0 JMS ACCHKV /CHECK VOL AND EXEC COMMAND -GTVOL /GET VOLUME DATA CMND WITH WINNIE BIT<11> JMP I ACGETV / /GET DIRECTORY DATA / ACGETD, 0 JMS ACCHKV /CHECK VOL AND EXEC COMMAND -RDDIR /GET DIRECTORY DATA CMND WITH WINNIE BIT<11> JMP I ACGETD / ACUPDD, 0 /UPDATE VOLUME JMS ACCHKV /CHECK VOLUME AND UPDATE COMMAND /A022 -VOLUPD /UPDATE VOLUME /A022 JMP I ACUPDD /RET /A022 /D022 CHKMNT, 0 /CHECK VOLUME MOUNTED /D022 CLA IAC /CHECK IF DEVICE MOUNTED /D022 AND I DENPT2 / /D022 SZA CLA /D022 ISZ CHKMNT /MOUNTED /D022 JMP I CHKMNT /NOT MOUNTED / ACCHKV, 0 TAD I ACCHKV /GET COMMAND DCA ACXDIR /SET IT JMS ACPIOC /DO IT ACCHKX, ISZ ACCHKV JMP I ACCHKV /RET / /D022 ACSETE, 0 /D022 CLA CMA /-1 /D022 DCA ACSAVE /SET ERROR RET /D022 JMP I ACSETE / > /END ENDIF WINNIE /A017 / EJECT / / / /MOUNT SYSTEM BOOTABLE VOLUME / IFDEF WINNIE < ACMNTS, 0 TAD (20 /SET UNIT 0 START UP VOLUME BIT /A021 DCA ACUNIT /SET IT /A021 JMS ACMNT /DO IT /A021 JMP I ACMNTS /RET /A021 / / /RDGTST ROUTINE GETS STATUS OF LAST BLOCK READ /A024 / AND RETURNS IN WORD 1 BIT 5--1IF PHYSICAL CYLNDER 0 /A024 / BIT 6--IF WRITE FAULT LAST DSK OP /A024 / BIT 7--IF SELECTED UNIT DEFINED /A052 / BIT 8--UNDEFINED /A024 / BIT 9--IF SEEK COMPLETE /A024 / BIT10--IF UNIT 1 SELECTED /A024 / BIT11--IF UNIT 0 SELECTED /A024 / / WORD 2 =CYLINDER NUMBER /A024 / WORD 3 =HEAD NUMBER /A024 / WORD 4 =SECTOR NUMBER /A024 / WORD 5 =CONTROLLER VERSION NUMBER /A024 / ACGETS, 0 /A024 JMS ACCHKV /CHECK VOLUME AND EXEC CMND /A024 -GTDEVS /GET DEVICE STATUS /A024 JMP I ACGETS /RET /A024 > /END IFDEF WINNIE /A023 / NORETN, /A017 /M017 TAD ACUPDT /UPDATE SW(HOME OR ALLOC BLK) /A026 SNA CLA /HOME OR ALLOC BLOCK TO BE UPDATED?/A026 JMP NORET1 /NO...SET TO VERIFY DEVICE WITH ERROR/A026 TAD (LSTDRV /POINTER TO DRIVE NEEDING UPDATE/A026 SKP /A026 NORET1, TAD (ACUNIT /POINTER TO UNIT WITH ERROR /A026 DCA PTR7 /SET POINTER /A026 TAD ACXDIR /GET COMMAND /A026 SPA /IS IT PHYSICAL I/O /A026 CMA /YES -SET COMMAND BITS /A026 AND CON2 /MASK READ/WRITE /A026 SNA CLA /0=WRITE 2=READ /A026 JMP NORET3 /=WRITE /A026 TAD (MSGRD /POINTER TO READ /A026 SKP /A026 NORET3, TAD (MSGWRT /POINTER TO WRITE /A026 JMP NORET5 /CONTINUE NEXT PAGE /A026 CON2, 2 /A026 /-------------------- PAGE EJECT /***************************************************************** / /------------------ ACP ERROR HANDLER ---------------------------- /----------THIS ROUTINE CHECKS THE ERROR CODES-------------------- /----------PRINTS THE APPROPRIATE MSGS, THEN---------------------- /----------RETURNS TO THE CALLING PROGRAM IF THE ----------------- /----------BIT 0 OF THE FUNCTION CODE WAS SET--------------------- /----------ELSE IT SETS THE RETURN CODE TO 0---------------------- /----------TO PREVENT ANY MORE CALLS TO THE I/O------------------- /----------THIS ROUTINE MAY BE REPLACED BY A CALL----------------- /----------TO THE LOAD ROUTINE IN THE HANDLER -------------------- /---------- TO REBOOT THE SYSTEM TO GET BACK TO------------------- /---------- MAIN MENU. THIS IS BECAUSE MAIN--------------------- /---------- MENU CODE MAY NOT BE IN CORE WHEN I/O----------------- /------------ IS CALLED. ---------------------- / / /---------- IF ERROR PROCESSING DOES NOT CHANGE------------------- /---------- SIGNIFICANTLY FROM CURRENT STATUS ------------------- /----------- THEN THIS ROUTINE CAN HANDLE ALL ------------------- /----------- ERRORS THE SAME. IE...NO NEED FOR------------------- /----------- BITS 1-3 TO REPRESENT ERR TYPES. ------------------- /----------- CHANGES TO HANDLER COULD ALSO BE -------------------- /----------- MADE.............................-------------------- /***************************************************************** NORET5, /A017 /C026 DCA PTR4 /SET IT /A026 CIFMNU /A026 JMS I IOACAL /PRINT MESSAGE /A026 0 /A026 PTR0, MSGCMD /MESSAGE COMMAND STRING /A026 0000 /A026 1015 /LINE 10- COL 15 /C027 PTR1, MSGA /"ERROR ON UNIT #" /A026 PTR2, ACUNIT /UNIT # /A026 PTR3, MSGB /"WHILE TRYING TO " /A026 PTR4, MSGRD /READ-WRITE /A026 1215 /LINE 12- COL 15 /C027 MSGRTR /"CR TO RETRY." /A030 1415 /LINE 14- COL 15 /A030 PTR6, MSGC /"OR PRESS GOLD MENU TO VERIFY UNIT # /C030 PTR7, ACUNIT /UNIT NUMBER /A026 1725 /LINE 17- COL 25 /C030 MSGD /" WARNING /A026 2220 /LINE 22- COL 15 /C030 MSGE /FAILURE TO VERIFY WILL CAUSE DOC ERRS /A026 /d033 JMP GETGLD /GET GOLD HALT GETGLD, CIFSYS XLTIN JMP GETGLD /WAIT TAD (-EDNWLN) /IS IT CRET? /A030 SNA /A030 JMP ACPCNT /YES RETRY FUNCTION /A030 TAD (EDNWLN-EDMENU) /IS IT GOLD MENU? SZA CLA JMP GETGLD /NO CDFSYS /SET TO SYSTEM FIELD /A027 TAD I WRMSTR /GET DATE TO SAVE FOR WARM RESTART /C027 CMA / /C027 DCA I WRMSTR /SAVE IT /C027 JMS I BHOOK / jump to the blastr via BHOOK in WPFILS/a033 -FALBEN / replace startup from panel mem /a033 IOF /TURN OFF INT. FOR CALL TO WPSYS /A007 CLA CLL CML RAR /4000 /A028 CDFFIO /RESET MYFIELD /A029 TAD I PTR7 /UNIT NUMBER /C029 /d033 CDFSYS /SET TO HANDLER FIELD /A028 CDISYS /SET TO DRIVER FIELD /m033 /M018 DCA I VFYPTR /SAVE IT /A028 JMP I DRVPTR /START UP SYSTEM DRVPTR, RXDRIN+1 /START OF DRIVER LOAD-IGNORE BOOT CODE(ALREADY SET)/C025 WRMSTR, DAMNTH /SWITCH TO SET TYPE START 0=COLD 1=WARM /A027 VFYPTR, SVFVFY-CLOCK+RANDOM /SET POINTER TO LAST LOC IN STRING/A028 BHOOK, FBHOOK / link to real BHOOK in WPFILS see WPF1 /a033 / SET ERROR DRIVE NO INTO TEXT STRING /----------------AFTER AN ERROR WITH NO RET SET/A016 / / MSGA, IFDEF ENGLSH /C027 IFDEF SPANISH /C027 IFDEF DUTCH /C027 IFDEF ITALIAN IFDEF V30NOR /A034 MSGB, IFDEF ENGLSH /A026 IFDEF SPANISH IFDEF DUTCH IFDEF ITALIAN IFDEF V30NOR /A034 MSGC, IFDEF ENGLSH /C027 IFDEF SPANISH /C027 IFDEF DUTCH IFDEF ITALIAN IFDEF V30NOR /A034 MSGRTR, IFDEF ENGLSH /A030 IFDEF SPANISH IFDEF DUTCH IFDEF ITALIAN IFDEF V30NOR /A034 MSGD, IFDEF ENGLSH /A026 IFDEF SPANISH IFDEF DUTCH IFDEF ITALIAN / IFDEF V30NOR /A034 MSGE, IFDEF ENGLSH < TEXT /&FAILURE TO VERIFY WILL LEAD TO CORRUPTED DOCUMENTS/> /A026 IFDEF SPANISH < TEXT /&EL FRASCO DE LA VERIFICACI\SN = CORRUPCI\SN DE DOCS/> IFDEF DUTCH < TEXT /&NON-VERIFICATIE LEIDT TOT VERMINKTE DOCS./> /A026 IFDEF ITALIAN < TEXT /&ERRORE IN VERIFICA SIGNIFICA DOCUMENTI PERSI/ > IFDEF V30NOR < TEXT '&UTEN VERIFISERING BLIR DOK. \XDELAGT' > /A046 / PAGE INTBUF, 0 /INTERNAL BUFFER THIS PAGE / EJECT /THIS CODE WAS DELETED IN VERSION 026.... BUT TO SHOW WHAT CODE WAS /AND TO MAKE NEW CODE LEGIBLE THE CODE IS SHOWN AS FOLLOWS.. /D026/ /D026/FOLLOWING CODE DUE TO SPACE WARS***VER 017****** /D026/ /D026/ /D026ACSETD, 0 /D026 TAD ACUNIT /GET DRIVE # /D005 SZA CLA /IS IT DRIVE 0? /D005 IAC /NO IT IS DRIVE 1 /D026 TAD ACDRVC /ADD DRIVE CONSTANT /D026 DCA ACDRVT /SET DRIVE TEXT /D026 TAD ACXDIR /GET FUNCTION CODE /D026 SPA /PHYSIO? /D026 CMA /YES SET LOG /D026 AND CON2 /CHECK READ BIT /D017 SNA CLA /IS IT READ? /D017 CLA CLL IAC RTL /NO SET 4 /C009 /D026 CLL RTL /IF READ SET TO 4 ELSEIS= 0 /A017 /D026 TAD ACPRPT /YES GET READ POINTER****+3 =WRT PTR /D026 DCA X5 /SET AOUT INDEX /D026 TAD ACPIPT /PTR TO I/O CONSTANT /D026 DCA X4 /SET /D026 TAD I X5 /GET 1ST OF 3 WORDS /D026 DCA I X4 /SET /D026 TAD I X5 /D026 DCA I X4 /D026 TAD I X5 /D026 DCA I X4 /D026 JMP I ACSETD /RET /D026ACPRPT, ACRDCN-1 /PTR TO READ CONST /D026ACPIPT, ACDRIO-1 /PTR TO I/O CONST. /D026CON2, 2 /D026NORETN, /A017 /D026 JMS ACSETD /SET DRIVE NO IN TEXT /D026 TAD ACPALS /GET ACP ALLOC SW /A016 /D026 SZA CLA /WAS ERROR ON WRITE ALLOC/DIR /A016 /D026 JMP WRALER /YES ERROR ON WRITE ALLOC/DIR /A016 /D026 ISZ ACPALS /NO.. TRY TO WRITE ALLOC/DIR BLK/A016 /D026 JMS ACPDIR /A016 /D026WRALER, /A016 /D026 /D026 IOF /TURN OF INTERUPTS FOR PRINT..JWAIT SHOULD RESET /D026 TAD (MSG0 /ADDRESS CLEAR SCREENAND ERROR MSG /D026 JMS TTY /PRINT /D026 TAD (ACCRLF-1 /D026 JMS TTY /CR LF /D026 TAD (MSG1 /D026 JMS TTY /D026ACPALS, 0 /WRITE ALLOC/DIR SW. SET WHEN TRYING TO WRITE /A016 /D026TTY, 0 /D026 DCA X5 /D026ACNXT, CLA CLL CMA RAL /-2 /D026 DCA ACTMP2 /D026 TAD I X5 /GET WORD /D026 DCA ACTMP3 /D026 TAD ACTMP3 /GET WORD /D026ACLOOP, AND M7700 /D026 JMS ACCHCK /CHECK CHAR /D026 JMP ACSKIP /IS 77...GET NEXT CHAR /D026 JMP ACPRNT /PRINT CHAR AS IS /D026 SNA /D026 JMP I TTY /RETURN /D026 TAD NEG40 /SET TO ASCII /D026 SPA /D026 TAD CON100 /D026 TAD CON40 /D026ACPRNT, TLS /PRINT /D026 TSF /D026 JMP .-1 /WAIT DONE /D026ACSKIP, CLA /D026 TAD ACTMP3 /D026 BSW /D026 ISZ ACTMP2 /DONE TWICE /D026 JMP ACLOOP /NO /D026 JMP ACNXT /YES NEXT CHAR /D026/ /D026/ THIS ROUTINE DETERMINES WHETHER THE CHAR TO BE DISPLAYED IS A /D026/ 77 OR NOT. IF A 77 IS DETECTED IT IS IGNORED AND A SWITCH IS /D026/ SET TO PRINT THE NEXT CHAR IN THE BUFFER. IF UPON ENTRY THE SW /D026/ IS SET THE SW IS CLEARED AND RETURN IS MADE TO THE CALL+2 (PRINT) /D026/ IF NOT 77 AND NOT SW SET RETURN IS MADE TO CALL+3 TO CONTINUE /D026/ /D026ACCHCK, 0 /D026 DCA ACSVCH /SAVE AC /D026 TAD ACISSW /SKIP SWITCH SET TO PRINT AS IS /D026 SZA CLA /D026 JMP ACASIS /PRINT AS IS /D026 TAD ACSVCH /D026 TAD CON100 /WAS CHAR=77 /D026 SZA CLA /D026 JMP ACCONT /NO CONTINUE /D026 ISZ ACISSW /YES SET SW /D026 JMP I ACCHCK /RETURN CALL+1(SKIP-GET NEXT) /D026ACCONT, ISZ ACCHCK /SET RETURN = CALL+3 /D026ACASIS, ISZ ACCHCK /SET RETURN +2 PRINT CHAR AS IS /D026 DCA ACISSW /CLEAR SW /D026 TAD ACSVCH /GET CHAR /D026 BSW /D026 JMP I ACCHCK /RET /D026ACISSW, 0 /SW TO DETERMINE IF LAST CHAR WAS 77 /D026ACSVCH, 0 /SAVE CHAR WHILE PROCESSING /D026CON100, 100 / /D026/ ALL ERRORS PRINT SAME MESSAGES AT THIS TIME /D026/ BUT HOOKS ARE IN THERE TO PRINT DIFFERENT MESSAGES /D026/ WHEN DESIRED....... IF ONLY ONE MESSAGE /D026/ WILL BE ON FINAL VERSION CLEAN UP CAN SAVE CODE TO DO THIS /D026/ IN ORDER TO MODIFY MIDDLE OF TEXT MESSAGE /D026/ THIS MODULE IS ASSEMBLED WITH THE /F OPTION /D026/ TO ELIMINATE A 6 BIT 0 PLACED AT END OF EACH /D026/ TEXT STATEMENT......THIS IS ONLY TEMPORARY /D026/ A SUBROUTINE WILL BE WRITTEN TO PRINT SEVERAT LINES /D026/ OF TEXT THUS ELIMINATING THE NEED FOR THIS OPTION /D026// /D026MSG0=.-1 /D026/ ?=77 [=33 ?[[J=CLEAR SCREEN ?[[H=SET HOME POSITION /D026/ /D026/ TEXT /?[[J?[[M/ IS IN OCTAL TO AVOID 0 CHAR AFTER TEXT FOR 1 MSG. /D026 7733 /?[ /D026 3310 /[H /D026 7733 /?[ /D026 3312 /[J /D026ACDRVT=MSGA+12 /PTR TO DRIVE # /D026 ACDRIO=.-4 /TO OVERLAY FUNCTION /D026/ TEXT /BLOCK NO. / /D026/ACBKNO, TEXT /----/ /D026ACCRLF, 7712 /CARRIAGE RET /D026 7715 /LINE FEED /D026 0 /TERMINATOR /D026MSG1=.-1 /D026/D024ACEND, 0 /END TEXT /D026MSG2=MSG0 /D026MSG3=MSG0 /D026M7700, 7700 /D026NEG40, -40 /D026CON40, 40 /D026/D024ACTMP0, 0 /D026/D024ACTMP1, 0 /PTR TO PRINT STRING /D026ACTMP2, 0 /CHARACTER COUNT /D026ACTMP3, 0 /WORD TO BE PROCESSED /D026/D024AC3400, 3400 /D026/D024ACERSV, 0 /SAVE ERROR BITS IN L/O BITS /D026ACDRVC, 4060 /DRIVE CONSTANT=" 0"   /WPSYS - Standalone WPS operating system & handlers / /170 EMcD 24-Sep-85 Dutch Keyboard (conditional) /169 KMD 13-Sep-85 Spanish KB (conditional) /168 EMcD 12-Sep-85 Allow UDK key as single stroke if we / are in SETUP (allows use of DO key) /167 EMcD 26_aug-85 Add Insert-Overstrike Key and move UDK key /166 EMcD 19-Aug-85 Swedish/Norwegian Keyboard layout (conditional) /165 EMcD 13-Jul-85 FAo keyboard layout (conditional) /164 RCME 11-Jul-85 Allow 8 bit GOLD things /163 EMcD 25-Jun-85 Mask chars from Panel to 7 bit for Date on / start up /162 RCME 31-May-85 Move Print Screen job start /161 MART 04-MAY-85 Add fallback for 8 bit chars on LQP02s /160 RCME 01-FEB-85 Convert to 8 bit in and out. /--------------------------- Mods below refer to V2.0 and earlier-------- /159 TCW 05-NOV-84 Add support for EIA pin 23, speed select /158 DFB 19-SEP-84 Fix to add drives 8,9 when WPS = strtup vol /157 TCW 03-SEP-84 Extend Break Time for Integral Modem (2 sec.) /156 TCW 22-AUG-84 Add ck for Integral Modem enabled /155 GDH 2-AUG-84 Added VT52 GOLD:HALT detection. /154 TCW 16-JUL-84 Change in position of Break Time bits /153 JAC 09-JUL-84 Fix problems left over from /152 /152 AH 09-JUL-84 Change/add esc def for (hypen & columm) /151 TCW 05-JUL-84 Correct modem control bits 10 & 11 /150 AH 03-JUL-84 Change tech char from F14 to F11 key /149 JAC 02-JUL-84 Changes to U1STPT /148 JAC 02-JUL-84 100 UDK Integration /147 JFS 26-JUN-84 die if not DMII or DMIII /146 DFB 22-JUN-84 Set time if boot from hard disk /145 JFS 20-JUN-84 limit RXONLN to 2 for DMIII /144 WJY 14-MAY-84 Differentiate between XPU and APU. /143 AIB 14-MAY-84 ADD PARSING OF EDTC (FOR LABONTE) /142 HLP 25-APR-84 Add D2XONF double xon flag for printer /141 DFB 18-APR-84 Date/Time fix for WPS boot other winnie systems /140 HLP 07-APR-84 Include Joan Silverston's DM III & IV changes /139 HLP 05-APR-84 Open a hole for another page of code /138 HLP 26-MAR-84 Move PTC7R0 to printer field /137 AH 21-MAR-84 Add code for column key /136 HLP 20-MAR-84 Fix hang when change comm baud rate while / printing to DD HOST /135 HLP 08-MAR-84 Restructure Patch Code to handle small LPOBUF / Moved Printer Handler inline with WPSYS / Deleted SQWAIT from Printer Handler / Moved TSTFUL from WPRINT to WPSYS / Moved PCMWT0 from resident to patch code / Replace SQSV with X0 in SQRES /134 HLP 02-MAR-84 Fix Print Buffer Wrap Pointer Clobbered / (Famous Ford / printer drops mucho chrs prblm) /133 WJY 29-FEB-84 Fix DMI Hangup function /132 DFB 23-FEB-84 Set DSKACP drive table to WINNIE(drv1) RX50(8,9) /131 DFB 14-JAN-84 Dismount vol 0 for rx50 (firmware mounts it on boot) /130 WJY 16-FEB-84 DECmate I compatability + Discard nulls sent to / the printer. /129 DFB 04-JAN-84 Fix to allow Function Key input from Master Menu /128 BCR 28-DEC-83 Moved INITONCE to WPCU2 /127 HLP 15-DEC-83 Call which resets printer handler also sets XON /126 DFB 13-DEC-83 Fix bug in command str passed from Master Menu /125 DFB 21-NOV-83 Fix date passing from Master Menu /124 DFB 21-NOV-83 Fix APU check /123 BCR 18-NOV-83 Add H2OU code 7401 = BREAK /122 DFB 16-NOV-83 Set date or cmnd if called from Master Menu /121 DFB 03-NOV-83 Fix to finnish when no winnie on system /120 DFB 28-OCT-83 Fix to set firmware type /119 EH 25-OCT-83 Set bit 5 in RXTYPE if APU board present /118 DFB 24-OCT-83 Set firmware bit in RXTYPE (40) bit 6 /117 DFB 28-SEP-83 Fix to acp device table /116 GDH 23-SEP-83 Changed initial delay time for host initialization. /115 DFB 15-SEP-83 Initialize dskacp device table for winnie /114 HLP 13-SEP-83 Make Serial Printer Handler a fixed part of WPSYS / Delete Separtely loadable Printer Handlers / Add reset capability to printer handler / Move drive sizing routine from null handler / to buffer area since null handler deleted /113 WCE 07-SEP-83 REINSTALLED GOLD-S BECAUSE PRODUCT MANAGEMENT / WANT'S IT ENABLED /112 PMM 06-SEP-83 ADD CURSOR KEYS AND NONBREAKING SPACE /111 GDH 11-JUL-83 Changed HOST INIT to only check bit 11 of / MNXONF for XON/XOF enable. /110 DFB 07-JUL-83 Compressed to set 2 pages for dskhnd /109 EPS 09-JUN-83 FIXED GOLD-S WHICH "BROKE" IN 107 (SHOULD / NOT BE ENABLED FOR CONDOR) /108 GDH 9-MAY-83 Large Host Input buffer support. / also, EZLINK temp & MT host silo code. /107 WCE 19-APR-83 Fix CMONLN code to make Communications work /106 HLP 13-APR-83 Fix DM-II initialization problem near DM1 /105 HLP 02-MAR-83 Added JMP H2INPT near TSTHSI for non CONDOR / Restore 8 bit mask in LPOCHR /104 HLP 17-FEB-83 Change LPONLN to CMONLN (LPONLN moved to / printer field) / Deconditionalize clock iot code / (standardize on what was CONDORized) /103 HLP 16-FEB-83 Make code which handles printer input do XON/XOF / and stuff everything else into a buffer. / State parser moved to printer code /-------------19-JAN-83-------SUBMITTED TO SDC DECmate-II V1.0.0----------- / THE VERSION SUBMITTED DID NOT CONTAIN EDIT101 BUT DID CONTAIN / EDIT 102 /--------------------------------------------------------------------------- /102 HLP 14-JAN-83 Make ESC-[?10-anything be a drafter printer / so will respond to both LA50 and LA100PC /101 MJS 23-DEC-82 -only "moved code around" allowing for a / clean DECmate I or DECmate I assembly / from the same WPSYS.PA / /100 HLP 20-DEC-82 Fix LQP02 SE parser--not recognizing / E[?2xn type reports / /099 HLP 12-DEC-82 Change error code for LQPSE CANCEL to 25 / /098 HLP 10-DEC-82 Fix state parser for LQP02 status reports: / to wait until terminator is received / to check for validity of digits received / to report no error status only when / E[?20;30n is received / /097 HLP 03-DEC-82 Change TIMOUT function to be a 12 bit value / that SYS upcounts once per second. Now / anybody can use it! / /096 MJS 1-DEC-82 -forgot to close a condor conditional / /095 MJS 24-NOV-82 -fixed "U1TSTLIST" (added esc seq cnt attribute) / /094 DFB 11-DFB-82 Fixed hangup when system drive = drive 4 / Replaced init deleted ver. 77 / added sel for drives 6 & 7 / /093 EPS 28-OCT-82 FIXED HALT FLAG NOT BEING CLEARED BUG / /092 MJS 22-OCT-82 -modified the timing loop for rx sizing / within "RXPOLL" call from within "PTC7R0" / /091 MJS 18-OCT-82 -modified "u1inpt" / -and redefined the code for the "SETUP" key / from "ESC [ 1 4 ~" to "ESC [ 1 3 ~" / -and redefined the code for the "BREAK" key / from "ESC [ 1 3 ~" to "ESC [ 1 5 ~" / /090 MJS 05-OCT-82 -added "PRINT SCREEN" recog to interrupt level / parsing at "u1inpt" and rewrote "U1INPT" parser / -and deleted "PRINT SCREEN" recog from "SRCHTB" / -and changed mask "P377" to "P177" / at "lpoch1" cause only 7-bit ascii to the / printers (else the LA50 would barf) / -and added terminal characteristic init / at system initialization at "INITONCE" / (issues RST "ESC c" to terminal) / /089 MJS 7-OCT-82 -modified hanging up the modem scenerio / at "H2ORST" so it doesn't issue an "XON" / -and corrected the mask of "P77" to "(17)" / at "DOBRK" cause break time was incorrect / /088 MJS 6-OCT-82 -added "EDDO" recognition to "srchtb" / /087 MJS 28-SEP-82 -added "PRINT SCREEN" recog to "SRCHTB" / /086 MJS 23-SEP-82 -added "SETUP" recoginition to "SRCHTB", / -and properly clear comm chip after error / /085 BS/MJS 07-SEP-82 -added la150 recognition in "SQPINP" / /084 MJS 07-SEP-82 -added "ARROW" keypad functionality / /083 MJS 25-AUG-82 -fixed host (comm) irq-error handling / -fixed hyphen-push/pull broken this time / by the firmware...( "pp" redefined to 34) / -changed flavor of "DTR" (negative logic) / that means 0 sets and 1 clears / -fixed "SRCH" to beep invalid key strokes, and / ("GOLD..GOLD" treated as 1 "GOLD") / ("ESC....ESC" treated as 1 "ESC") / -redefined "NODEF" = 4400 (from 4000) / because "MENU" does an "AND 3777" to make the / value positive / (cause a neg # means a menu command) / /082 MJS 20-AUG-82 added 'find', 'insert here', and 'remove' into / "SRCH" table...added "JMS HANGUP" into "XH2INI" / /081 MJS 19-AUG-82 fixed 'hyphen-pull' broken by edit '078' / /080 HLP 18-AUG-82 ALLOW LQP02 TO RECOVER FROM ASF ERRORS / /079 MJS/HLP 12-aug-82 changed "SQREST" to make cross field callable / AND to clear the printer buffer / /078 MJS 3-AUG-82 -added code to 'hang-up' the modem / (drop DTR for approx 2 seconds)... / -and added keys to "SRCH"... / -and broke-up "XH2INI" for space. / /077 EPS 15-JUL-82 FIXED HANG AT 'NORX78' / (when sizing drives 4,5,6,7) / /076 EPS 08-JUL-82 CORRECTED CLOCK TEST WITHIN 'CONT' (patches) / /075 MJS 29-JUN-82 CONDOR communications / /075T MJS 20-may-82 Temporary delay for prototype condor at / subroutine 'rxpoll' / /074 MJS 10-MAY-82 Modified and added DECmate II clock IOT's / /073 MJS 5-MAY-82 Modified 'WPEDTB' table (cond for CONDOR) / And rewrote 'SRCH' incl cond for CONDOR / /072 MJS 25-APR-82 Modified RX50/RX02 POLLING within 'PTC7R0' / /071 MJS 20-APR-82 Programmably slowed UDK execution / (conditionalized on DEMO only) / (UDK0 contains the 'delay' value) / / THE ABOVE REVISIONS ARE FOR DECMATE II (CONDOR) / The edit history below is for DECmate I /070 GDH 29-MAR-82 Fixed secondary port error detect (and port / hang condition). /069 GDH 01-MAR-82 Fixed LP input interrupt handler to handle / incoming input when handler not loaded. /068 GDH 26-FEB-82 Re-ordered interrupt chain to put printer input / 'rupts at a higher priority than kb output. /067 GDH 25-JAN-82 LA100 "who-are-you" support. /066 GDH 20-JAN-82 Eliminate possible race conditions enabling / host interrupts. /065 GDH 20-JAN-82 Bug fix for detecting Host line errors. /064 GDH 30-DEC-81 H2INIT to clear pending input host buffer. /063 GDH 08-DEC-81 Fix LQP02 state logic to cleanly detect asf / status (30 through 39). /062 GDH 03-DEC-81 Fix LQP02 sheet feeder detect logic. /061 GDH 03-DEC-81 Ignore sheet-feeded OK status. /060 AJF 02-DEC-81 Added explanation of LPONLN values /059 GDH 01-DEC-81 Added lqp handler code to do restore at / interrupt level. /058 DFB 25-NOV-81 Clear intermittent transfer flag request / during test for number of RX devices /057 GDH 24-NOV-81 Added TIMOUT variable for printer timeout / requirements. /056 GDH 21-NOV-81 Changes to SQEOT to not start FLABUZ. / Other changes (in printer) to start FLABUZ / upon reciept of error status. /055 GDH 20-NOV-81 Changes serial handler to do status request / when it sees the EOT (4) error code. /054 AJF 18-NOV-81 MADE SQRES NOT MONITOR XOFF FLAG AND BUFFER /053 GDH 17-NOV-81 RX02 Double Density support in startup. /052 GDH 10-NOV-81 Added "warm start" enhancements. /051 GDH 10-NOV-81 RX01/RX02 detection & 2drive/4drive cleanup. /050 GDH 03-NOV-81 Bug fix to zero out 1st location of LPT buffer. /049 GDH 27-OCT-81 Moved RXHAN write-out code loader. /048 GDH 26-OCT-81 Removed RXHAN from interrupt chain. /047 GDH 26-OCT-81 Made GOLD-S another GOLD-SEARCH. /046 GDH 18-OCT-81 Bug fix. don't eat up duplicate udk keys!!! /045 GDH 18-OCT-81 Distinguishmentation between function key / escape sequences and user entered escape seqs. / Cleanup of Patch code for 278 clock interrupts. /044 GDH 16-OCT-81 Implementation of 3rd TM option (DWORD). /043 GDH 6-Oct-81 Added Host error checking. /042 GDH 2-Oct-81 Moved Host initialization to WPSYS. /041 GDH 28-Sep-81 Implemented "Break Key" recognition & / implementation. /040 GDH 21-Sep-81 Host line support for primary/secondary port. / Fixed the losing of cursor keypad mode. /039 GDH 18-Sep-81 Fine tuning of auto repeat xon/xof support. /038 AJF 10-SEP-81 Removed extraneous send restore code from / sqrest and made sqwait cross field callable /037 AJF 06-SEP-81 Set com port to data terminal ready and set / to recieve /036 AJF/RS 03-SEP-81 Removed le=8 line printer interface, added / multi printer input handler, new entry points / after SQREST /035 DIM 3-SEPT-81 Fix French Gold-Halt /034 GDH 29-Aug-81 Eliminated User 2 code. / Added Terminal auto xon/xof support for / better auto-repeat handling. /033 TT 07-JUL-81 Removed superfluous conditionals / ABOVE REVISIONS ARE FOR DECMATE I VERSION 2.0 /032 GR 11-MAY-81 Inserted missing ESCAPE seq code from 78,19 /031 JM 27-MAR-81 Conditionalized power fail stuff for / IFNDEF VT278 /030 JM 24-MAR-81 Changed SQREST for WS80 to send for status / from the SQPSE as well as send a restore /027 DSS 17-MAR-81 ADDED CALL TO NEW POWER FAIL AND RECOVERY / CODE FOR WS80 LOCATED IN PRINTER FIELD. /026 JM 20-FEB-81 Changes for WS78 /025 JM 20-FEB-81 Deleted an extra definition of X0006 /024 JM 20-FEB-81 Added missing closing bracket for WS102 conditional /023 DAO 8-FEB-81 Changed Serial Printer handler to not set the / done flag just because it was XOFFED. /022 DAO 16-JAN-81 Deleted Power low check from interupt chain of / VT278 (since hardware does not support it) and / changed order of checking interupts in 278 so / COMM line is checked before keyboard and / screen. This change improved speed of CX / transmission (still limited to 4800 to screen) /0021 reg/DAO 7-JAN-81 Modified the way comm option and SQ1 are / detected to get rid of illegal micro instr /0020 LDB 16-DEC-80 Disable printer 'rupts at start-up and change / order of U1 trans./receive test /0017 LDB 14-DEC-80 Remove U2 from system & change conditionals / to test for no. of floppies correctly. / Also check if comm. is present. /016 LDB 5-DEC-80 Turn off vectored 'rupts and other unsupported / devices (modem control & comm port 1) /015 DAO 10-DEC-10 Isolated the restore and send for status / routines for the LQPSE /014 DAO 9-DEC-80 Fixed SQRES to not conflict with printer / handler when outputing ESCAPE sequences /013 DAO 4-DEC-80 NOT USED /012 DAO 2-DEC-80 Changed SQREST to be used to send for status / from the SQPSE as well as send a restore /011 DAO 21-N0V-80 Added check for EOT as input from LQPSE in the / Case of a VT278. This check will also have to / be added in routine CHKCAN for the WS80 /0010 LDB 10-Nov-80 Fix problem with RTF instr. not turning on / interrupts /009 DA0 6-NOV-80 Add to Match Table for Editor Input definition / for GOLD CMND. (GOLD [) /008 JRF 6-NOV-80 Make corrections to Match Table for Editor / Input (SRCHTB) & Editor Command Matcher (SRCH) /007 JRF 21-OCT-80 Add call to the routine that checks for / KBD buffer full & misc. additions. /006 DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES FOR ANSI MODE /0005 DAO 5-OCT-80 Deleted disabling of LA180P for 278 during / interupt handling /0004 DIM 23-SEPT-80 Merge with x3.5 /0003 DM,JM 15-SEPT-80 MERGED SCANDI AND EUROPE/ENGLISH /0002 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN /0001 GLT 9-Apr-80 Fixed bug in German character map table /3.4 JLZ 6-MAY-80 FIXED #RX CODE TO SET DONE FLAG /3.3 JLZ 18-FEB-80 /FIXED # OF RX INIT CODE FOR RX02 /3XX EPS 14-AUG-79 MODIFIED FOR FOREIGN LANGUAGES /3X LDB 3-MAY-78 TRY TO FIX FLOPPY CHECK FOR WT /QA3.3 MB 13-APR-78 PUT IN KL8A MADE BY BLT TO WS202 SYSTEM /III.C-2 MB 1-APR-78 PUT IN SYSTEM OPTIONS /III.C MB 27-MAR-78 PUT IN THE DP2 HANDLER FOR WS78 ONLY /III.1-1 LDB 2/28/78 CHANGE RXONLN BACK TO 4 (DEFAULT VALUE) /2.7A-1 LDB 1/28/78 FIX RXONLN FOR WT78 /2.7A KEE 12/6/77 MAKE XON/XOF A RUNTIME OPTION /2.7-1 RLT 11/18/77 DELETE 8E CHECK FOR WS200 /2.5-2 RLT 11/9/77 CHANGE MISSED INTERRUPT CATCHER /2.5-1 RLT 11/7/77 ADD TWIN-TRACK TEST CODE TO PRINTER /2.P-3 RLT 9/23/77 ADD RXONLN CHECKING /2.P-2 RLT 9/22/77 ELIM U2/H2ONLN, ADD H2 CHECKING /2.P-1 RLT 9/21/77 ELIM INTPWR, ADD INT DISABLE INSTS /2.N-2 RLT 9/20/77 ADDED PRINTER CONFIG CHECKS /2.N-1 RLT 9/14/77 ADDED UDKPRT LOGIC /2.K-1 RLT 8/31/77 WS78 CHECKS FOR EPI /2.F-1 RLT 8/4/77 COMBINED WPS-8, VT78 SOURCES / THSFLD= 0 CDFMYF= CDF THSFLD U1DXOF= 1 / WANT XON-XOF PROCESSING H2DXOF= 1 / |---------------| / |PAGE 0 CONTENTS| / |---------------| *1 JMP I .+1 / INTERRUPT CATCHER INTRPT 0 / JOB SCAN FLAG (0=ON) TSTXXX / INTERRUPT CHAIN INTPC, INTXIT, GOJOB / INTERRUPT EXIT AND PWRFAIL SAVED PC JMP I .-1 / (USED TO SET INTXIT CONTENTS VIA JMS) PWRJMP, POWRUP / PTR TO POWER START LOCN *10 / |---------------| / |INDEX REGISTERS| / |---------------| *TTYIN&177 / |------------| / |SYSTEM CALLS| - common cross field callable / |------------| U1ICHR / "TTYIN" / get 1 character from the keyboard U1OCHR / "TTYOU" / output 1 character to the screen U1XLAT / "XLTIN" / translate 7-bit char into EDITOR values U1HLTF / "TAD I HLTFLG"/ (when "U1HLTF" not 0 means GOLD Halt) UD1OPS / "UDKOPS" / H2ICHR / "HS2IN" / get 1 character from the comm line H2OCHR / "HS2OU" / put 1 character onto the comm line LPOCHR / "LPTOU" / output 1 character to the printer XENQUE / "ENQUE" / XDEQUE / "DEQUE" / XJWAIT / "JWAIT" / XJSWAP / "JSWAP" / XJSTRT / "JSTRT" / XJEXIT / "JEXIT" / SYFORK / "FRKINT" / FRKNXT / "FRKXIT" / FRKCHN, 0 / "FRKCHN" / XH2INI / "H2INIT" / INIT HOST LINE (communications device)/A042 LPICHR / "LPTIN" / receive a character from the printer /A103 / |----------------| / |USEFUL CONSTANTS| / |----------------| *CDF0 CDF 0 / "CDF0" / CIF CDF 0/ "CIDF0" / 177 / "P177" / 377 / "P377" / 77 / "P77" / 7700 / "P7700" / 3777 / "P3777" / 0 / |-----| / |CLOCK| / |-----| *CLOCK 0 / INTERRUPT COUNTER / (used by "NULJOB" for "CLKSVC") ZBLOCK 4 / TENTHS, SECONDS, MINUTES, HOURS DAMNTH, 0 MONTH, 0 YEAR, 0 DAYEAR, 0 DAWEEK, 0 PAKDAT, 0 RANDOM, 0 / RANDOM (BY NULJOB) XGETRT /"getrtf" / / LPONLN MOVED TO PRINTER FIELD AND REDEFINED /A104 CMONLN, 0 / COMMUNICATIONS HARWARE DETECTED FLAG /A104 CMADSX, 0 / LOCK WORD FOR COMMUNICATIONS / THE VALUES ARE: 0 = FREE; 1 = AX; 2 = DX; / 3 = PRINTER; 4= CX(STANDARD); 5 = DX(MAGCARD) RXONLN, 4 / #RX UNITS (sized and on-line) INTAC, NULJSB / SAVED AC AT INTERRUPT INTLK, 200 /SAVED FIELDS, LINK AT INTERRUPT /A0010 /(START WITH 'RUPTS ENABLED - BIT 4 ON) /A0010 INTMP1, 0 / TEMP FOR INTERRUPT PROCESSING U1HLTF, 0 RXTYPE, 0 / RXTYPE = 0 FOR RX01 OR 1 FOR RX02 /A050 STTYPE, 0 / STTYPE = 0 FOR COLD START, /A051 / 1 FOR WARM START. SET BY DSKHND. /A051 TIMOUT, 0 /A051 / A VALUE WHICH IS INCREMENTED /SEC /C097 EZLNTM, 0 / SAVED MNCXTM VALUE FOR CX (EZLINK) /A108 PRT8FB, 7600 / address of routine to deal with fallback /a161 /*********************************************************************** /****** LOCATIONS ON THIS PAGE AFTER HERE ARE CURRENTLY AVAILABLE FOR /A050 /****** USE BUT SHOULD BE USED SPARINGLY. THE ABOVE LOCATIONS ARE /A050 /****** DEFINED IN "WPF1" FOR SYSTEM WIDE REFERENCES. /A050 /*********************************************************************** INTMP2, 0 / 0nn,n00,0,0 / ERROR STATUS FOR HOST LINE SET HERE. /A043 BREAKF, 0 / BREAK FLAG -- = 0 MEANS IDLE /A041 / < 0 MEANS START BREAK /A041 / > 0 MEANS DOING BREAK; WAITING FOR BT /A041 TACHAR,0 / save char here while testing for 8 bit LQP02 chr output/a161 LPTRSV, 0 / save retun address of LPTOU /a161 LPTFSV, 0 / save the return field of LPTOU /a161 SRCHCA, 0 / CHARACTER BEING SEARCHED FOR. ALSO / VALUE TO RETURN TO CALLER IF MATCH WAS / FOUND FOR COMPLETE INPUT SEQUENCE. / (for each modifier) SRCHU1, 0 / (modifier built here) TSTIMT, 0 / TEMP STORAGE FOR INTEGRAL MODEM TEST /A159 P200, 200 / a constant /a161 / Moved here on Edit 163 for space reasons /M163 / O_R_D_E_R I_M_P_O_R_T_A_N_T / Moved here in edit 155 to make room/M155 RPTON, ESC;"[&177;"?&177;"8&177;";&177;"1&177;"h&177;0 RPTOFF, ESC;"[&177;"?&177;"8&177;"l&177;0 /A040 / E_N_D O_R_D_E_R I_M_P_O_R_T_A_N_T /-------- / / N O T E ...... / / The address of STUACF below is known by WPSYS and WPSETU ,so /A168 / if you move it here , CHANGE IT IN WPF1 also !!!! /A168 STUACF, 0 / Setup active flag /A168 STUCHR, 0 / Char saved when SETUP active /A168 / |-----------------------------------------------------------------| / | CLOCK IOT differences between DECmate I and DECmate II (condor) | / |-----------------------------------------------------------------| / | D E C m a t e I | / |-----------------------------------------------------------------| / / CMOD 6130 (AC) = 0 set interupt mode "vector/ |--------------------------------------------------------- (AC) = 0 disable clock for irq's / (AC) = 1 enable clock for irq's / / CLCL 6136 CLEAR CLOCK FLAG / / CLSK 6137 SKIP ON CLOCK FLAG (clear if set) / / |-----------------------------------------------------------------| / | D E C m a t e II | / |-----------------------------------------------------------------| / / 6130 SET CLOCK FLAG / / 6131 SKIP ON CLOCK FLAG (clear if set) / / 6132 NOP / 6133 NOP / 6134 NOP / / 6135 SAME AS DECMATE I / / 6136 NOP / 6137 NOP / / NOTE: that the "interrupt mode" on DECmate II is always "normal" / because there is NO "vectored" interrupts. / |-----------------------------------------------------------------| / INPUT/OUTPUT IOT'S FOR DEVICE "H2" C O M M U N I C A T I O N S / IFNDEF CONDOR < / --------------------------------------------- /A081 WRTP0= 6362 / WRITE PORT 0 /A037 WRTP1= 6366 / WRITE PORT 1 /A040 > / END IFNDEF CONDOR ----------------------------------- /A081 RACD= 6367 / RESET COMMUNICATIONS DEVICE /A037 / / 'input' / H2KCF= IOTH2I / SET PORT 0 RECIEVE FLAG H2KSF= H2KCF+1 / SKIP ON PORT 0 RECIEVE FLAG (AND CLEAR IT) H2KCC= H2KSF+1 / clear AC H2KRS= H2KCC+2 / H2KIE= H2KRS+1 / LOAD PORT 0 RECIEVE INTERRUPT ENABLE H2KRB= H2KIE+1 / READ PORT 0 COMM DEVICE (data in) PRB0= H2KRB / READ PORT 0 COMM DEVICE (data in) /A041 / / 'output' / H2TFL= IOTH2O / SET PORT 0 TRANSMIT FLAG H2TSF= H2TFL+1 / SKIP ON PORT 0 TRANSMIT FLAG (and clear it) H2TCF= H2TSF+1 / nop H2TCP= H2TCF+2 / H2TSK= H2TCP+1 / LOAD PORT 0 TRANSMIT INTERRUPT ENABLE H2TLS= H2TSK+1 / WRITE PORT 0 COMM DEVICE (data out) PTB0= H2TLS / WRITE PORT 0 COMM DEVICE (data out) /A041 / IFNDEF CONDOR < / -------------------------------------------- /A081 OPKSF= 6341 / SKIP ON PORT 1 RECIEVE FLAG /A041 OPTSF= 6351 / SKIP ON PORT 1 TRANSMIT FLAG /A041 OPRIE= 6345 / LOAD COMM PORT (1) RECEIVE ENABLE /A016 OPSIE= 6355 / LOAD COMM PORT (1) TRANSMIT ENABLE /A016 > / END IFNDEF CONDOR ----------------------------------- /A081 MCIE= 6365 / MODEM CONTROL IRQ ENABLE (WITH AC11=1) /A016 /---------------- PAGE THSJOB, 0 / CURRENT JOB PTR / TO FOLLOW INTERRUPT CHAIN SEE LABEL INTCHAIN, /A135 DOINTR, / RETURN ADDR FROM INTERRUPT CHAIN (IF ALL FAIL) START, JMP I XJSWAP / BOOT-UP SYSTEM / DECmate I clock IOT definitions CLKENB= 6135 / CLOCK ENABLE IOT /M045 CLKCLF= 6136 / 8A CLOCK CLEAR IOT /M045 CLKSKP= 6137 / CLOCK SKIP IOT /M045 CMOD= 6130 / VECTORED INTERRUPT ENABLE IOT /A016 / DECmate II (condor) clock IOT definitions CLKENB= 6135 /ac11: / Enable (AC11:1)/disable (AC11:0) clock /\clkclf= / none CLKSK2= 6131 / Skip next if clock flag=1 (then clear it) CLKSET= 6130 / Set clock flag /\cmod= / none XCLKSKP,CLKSKP /-DECmate I IOT- / IS INTERRUPT FOR CLOCK TIC? GOINTR / NO, SO START INTERUPT CHAIN CLKCLF /NOP (DECmate II)/ YES, CLEAR FLAG IF 8A /M045 ISZ CLKINT / ++++ JMP DISMS1 / BUMP TICS/TENTH TAD CLKINT+1 / ++++ DCA CLKINT / RESET FOR A NEW TENTH AC7777 / ++++ TAD CLOCK DCA CLOCK / UPDATE CLOCK COUNTER JMP DISMIS+1 / AND EXIT / / *** ---------------------------------------- *** / *** ORDER OF NEXT FEW LOCATIONS IS IMPORTANT *** / *** ---------------------------------------- *** / JMP PWRUP2 INTMQ, 5252 / 2FULL DECKS TSTLST, SRQ / HERE ON UNKNOWN INTERRUPT JMP DISMS1 / JUST EXIT IF NO INTERRUPT REQUEST ANY MORE JMP I DOINTR / ELSE RETURN TO CALLER GOPOWR, JMP I PWRJMP / |-------------------| / |interupt entry here| / |-------------------| INTRPT, / HERE ON INTERRUPT DCA INTAC / SAVE AC GTF / ++++ DCA INTLK / AND DF,LINK, ETC. JMS DOINTR / ENTER INTERRUPT CHAIN JMS DOINTR / !!MISSED IT, TRY AGAIN!! / !!!! TWICE IS ONCE TOO MANY -- CLEAR ALL !!!! / |--------------------------------| / | entry here from an UNKNOWN irq | / |--------------------------------| PWRFL1, TAD 0 / ++++ DCA INTPC / SET UP FOR POWER UP JMP TO 0 MQA / ++++ DCA INTMQ / SAVE MQ FOR POWER FAIL / CODE WAS REMOVED HERE WHICH LOOPED UNTIL THE AC LOW FLAG CLEARED /D027 / BY ITSELF INDICATING THAT AC POWER HAS BEEN RESTORED. /D027 CAF / CLEAR ALL HARDWARE FLAGS PWRUP1, POWRUP, TAD INTPC / ++++ DCA 0 / RESTORE PC TO LOC 0 TAD INTMQ / ++++ MQL / RESTORE MQ IFNZRO INTCHN-4 AC0003 / ++++ DCA IX0 / INIT FOR INTERRUPT CHAIN CHASING / DISABLE SOME INTERRUPTS... /Modem control and comm. port1 are disabled in HOST2 power up code /cause we're out of room here - LDB /Also serial printer port is disabled in the null printer handler for the /same reason - LDB AC0001 / ++++ CLKENB / START CLOCK (AGAIN) IFNDEF CONDOR < / --------------------------------------------- /A074 AC4000 /BIT 0 TO TURN OFF VECTORED INTERRUPTS /A016 CMOD /A016 > /END IFNDEF CONDOR (DECmate II only has 'normal' interrupts) /A074 JMS INTXIT / POINT INTXIT HERE FOR TIME BEING AC7775 / ++++ TAD I IX0 / ++++ DCA IX0 / GET NEXT IN CHAIN JMP I IX0 / AND EXECUTE HIM / IF NOT TSTLST, HE'LL COME BACK VIA INTXIT / OTHERWISE, WE GET A JUMP TO PWRUP2 PWRUP2, JMS INTXIT / TO RESTORE PROPER INTXIT / AND COMPLETE THE RECOVERY FROM POWER LOW / |----------------------------| / |return from interupt service| - (of a known irq) / |----------------------------| DISMIS, CLA CLL / JUST IN CASE.... SIGNAL / SET THE "SOMETHING HAPPENED" FLAG DISMS1, TAD INTLK / ++++ RTF / ++++ CLA / RESTORE FIELDS, LINK, ETC. TAD INTAC / AND AC JMP I 0 / RETURN FROM INTERRUPT / CLKINT, -1 / COUNTS TICS PER TENTH -12 / 8A TICS PER .1 SECOND XJSWAP, PATCHT / CALLED TO AVOID CPU HOGGING DCA JWAC TAD XJSWAP DCA XJWAIT / MAKE BELIEVE HE CALLED JWAIT SIGNAL JMP XJW1 / XJWAIT, XX / CALLED TO WAIT FOR EXT. EVENT DCA JWAC XJW1, JMS XJSAVE / SAVE JOB STATUS TAD THSJOB DCA PRVJOB TAD I PRVJOB / GET NEXT JOB PTR GOJOB, DCA THSJOB / MAKE IT CURRENT TAD THSJOB / THEN RESTORE HIS STUFF DCA X0 TAD I X0 / DF-LINK CLL RAR TAD CIDF0 DCA JWAC TAD I X0 / ++++ MQL / MQ TAD I X0 / ++++ DCA XJWAIT / RETURN ADDR TAD I X0 / AC JWAC, 0 / (SAVE LOC AND CIF-CDF INST) JMP I XJWAIT / GO TO IT!!! / PRVJOB, 0 / PREVIOUS JOB / XJSAVE, XX / ROUTINE TO SAVE JOB STATUS TAD THSJOB / FIND JOB STATUS SAVE AREA DCA X0 RDF / ++++ RAL / SAVE DATA FIELD AND LINK CDF THSFLD / CHANGE TO OUR FIELD DCA I X0 / SAVE DF-LINK MQA / ++++ DCA I X0 / SAVE MQ TAD XJWAIT / ++++ DCA I X0 / SAVE RETURN ADDR TAD JWAC / ++++ DCA I X0 / SAVE AC JMP I XJSAVE XJEXIT, XX / CALLED TO DE-COUPLE CURRENT JOB DCA JWAC / SAVE AC TAD XJEXIT / ++++ DCA XJWAIT / MAKE LIKE JWAIT JMS XJSAVE / SAVE JOB STATUS FOR RESTART LATER TAD I THSJOB / THEN CLIP US OUT OF CHAIN DCA I PRVJOB DCA I THSJOB / CLEAR OUR CHAIN PTR, TO SHOW NON-ACTIVE SIGNAL / MAYBE SOMEONE'S WAITING JMP GOJOB-1 / THEN GO DO NEXT JOB JKX1= XJSWAP / TEMP 1 / XJSTRT, NULJOB / CALLED TO ENTER NEW JOB IN CHAIN DCA XJS2 / SAVE JSB PTR GETRTF / ++++ DCA XJX1 / GET RTN FIELD SIGNAL TAD I XJS2 / LOOK AT JSB CHAIN PTR SZA CLA / ++++ JMP XJX1 / JUST QUIT IF NON-ZERO TAD I THSJOB / MOVE OUR CHAIN TO HIS DCA I XJS2 TAD XJS2 / ++++ DCA I THSJOB / AND CHAIN US TO HIM XJX1, CIF CDF .-. / RESTORE USER FIELD JMP I XJSTRT / THEN RETURN XJS2= JKX1 / TEMP 1 / XGETRT, XX / RTNS CIFCDF INST IN AC DCA X0 / SAVE AC FOR CALLER RDF / GET DATA FIELD TAD CIDF0 / MAKE CIF-CDF INST CDF THSFLD / MAKE EVERYTHING KOSHER JMP I XGETRT / AND RETURN /------------------ PAGE / ------------ / | NULL JOB | / ------------ NULJOB, CLA CMA / ++++ DCA INTFLG / CLEAR SIGNAL FLAG JWAIT / TRY ALL JOBS NULLP3, TAD CLOCK / ++++ SZA CLA / ++++ JMS CLKSRV / UPDATE CLOCK IF NECESSARY IFDEF CONDOR < / ---------------------------------------------- /A081 /D128 ISZ INITH2FLAG / /a078 /D128 JMP .+3 / /a090 /D128 JMS INITONCE / INITIALIZE ONCE AT POWER-UP /a090 /D128 DCA .-3 / /a090 JMS TSTPS / (TEST FOR "print screen" flag) /a090 > / END IFDEF CONDOR ------------------------------------ /A081 TAD INTFLG / ++++ SNA CLA / ++++ JMP NULJOB / LOOP ON SIGNAL ISZ RANDOM / ++++ JMP NULLP3 / WAIT LOOP TIL COUNT EXHAUSTED /d078 CLA MQA / ++++ /d078 CLL RAL / ++++ /d078 SZL / ++++ /d078 IAC / ++++ /d078 MQL / ROTATE MQ JMP NULLP3 / AND RESTART LOOP /D128 IFDEF CONDOR < / ---------------------------------------------- /A081 /D128INITH2FLAG, 5400 / changed from 7764 /M116 /D128 > / END IFDEF CONDOR ------------------------------------ /A081 XENQUE, XX / CALLED TO QUEUE A FUNCTION / / CIF 0 / ENQUE;QBLK / WHERE: / QBLK, QNAME;X;X;Z;...DATA... / / ZIS SET 0 BY ENQUE, NZ WHEN DONE / AC7777 / ++++ TAD I XENQUE / GET QBLK-1 DCA X0 ISZ XENQUE / BUMP TO RTN ADDR RDF / ++++ TAD CDF0 / GET DATA FIELD DCA XENCDF TAD CDF0 / ++++ DCA XENCDX / INIT Q SEARCH DF TAD I X0 / GET QHDR PTR DCA T1 TAD T1 XENQ1, DCA X1 XENCDX, CDF .-. / QSEARCH DF TAD I X1 / GET NEXT DF SNA / ++++ JMP XENQ2 / END OF Q, IF 0 DCA XENCDX / ELSE KEEP CHAINING TAD I X1 JMP XENQ1 / XENQ2, AC7777 / ++++ TAD X1 / ++++ DCA X1 / RESTORE INDEX TAD XENCDF / ++++ DCA I X1 / CHAIN NEW ONE TO END OF Q TAD X0 / ++++ DCA I X1 XENCDF, CDF .-. / NEW QBLK DF DCA I X0 / CLEAR CHAIN FIELDS OF NEW ONE DCA I X0 DCA I X0 / CLEAR DONE FLAG CDF 0 TAD I T1 / ++++ JSTRT / START UP SERVER AC0002 / ++++ TAD XENCDF / CONSTRUCT CIF INSTRUCTION DCA .+1 .-. / RETURN TO CALLER'S FIELD JMP I XENQUE XDEQUE, XX / CALLED BY Q SERVER / / DEQUE;QNAME / / RETURNS AC=0 IF NOTHING IN Q / ELSE, AC=CDF (QBLK FIELD) / AND X0=QBLK-1 (I.E., WORD BEFORE DONE FLAG) / CLA / ++++ TAD I XDEQUE / GET QHDR PTR GETRTF / ++++ DCA XDEQX / GET RETURN FIELD ISZ XDEQUE / BUMP TO RTN ADDR TAD I X0 / GET FIRST CDF SNA / ++++ JMP XDEQX / OUT QUICK IF NOTHING THERE DCA XDQCDF AC7777 / ++++ TAD X0 / ++++ DCA X1 / SET WRITE PTR TAD I X0 / ++++ DCA X0 / AND READ PTR JMS XDEQLX / ++++ JMS XDEQLX / "UNWIND" ONE ENTRY TAD XDQCDF / RETURN QBLK CDF IN AC ISZ XDEQUE / BUMP RTN ADDR FOR SUCCESS XDEQX, CIF CDF .-. JMP I XDEQUE / XDEQLX, XX / SUBROUTINE TO COPY FROM QBLK TO FIELD 0 XDQCDF, CDF .-. TAD I X0 CDF THSFLD DCA I X1 JMP I XDEQLX / / INPUT/OUTPUT ROUTINES FOR DEVICE "U1" / IOT DEFNS / U1KCF=IOTU1I U1KSF=U1KCF+1 U1KCC=U1KSF+1 U1KRS=U1KCC+2 U1KIE=U1KRS+1 U1KRB=U1KIE+1 / U1TFL=IOTU1O U1TSF=U1TFL+1 U1TCF=U1TSF+1 U1TCP=U1TCF+2 U1TSK=U1TCP+1 U1TLS=U1TSK+1 / / IFDEF FRENCH / ALLOW UPPER-CASE GOLD-HALT IF FRENCH /D035 IFDEF FRENCH / ALLOW UPPER-CASE GOLT-HALT IF FRENCH /A035 / IFDEF ENGLSH IFDEF ITALIAN IFDEF ITALIAN /ALLOW UPPER-CASE GOLD-HALT IF ITALIAN IFDEF ENGCAN IFDEF FRENCH IFDEF FRENCH /ALLOW UPPER-CASE GOLD-HALT IF FRENCH /A035 IFDEF DUTCH IFDEF GERMAN IFDEF V30FAO /A165 IFDEF V30FAO /A165 IFDEF SPANISH /A169 IFDEF SPANISH /A169 IFDEF V30SWE /A166 IFDEF V30SWE /A166 IFDEF V30NOR IFDEF V30NOR / U1ICHR, XX GETRTF / ++++ DCA U1ICHX / GET RETURN FIELD TAD U1ICNT / ANYTHING THERE? SNA CLA / ++++ JMP U1ICX / RETURN 0 IF NOTR TAD I U1IGET / GET CHAR SPA / ++++ DCA U1IGET / WRAP IF NEC. CIF 0 AC7777 / ++++ TAD U1ICNT / ++++ DCA U1ICNT TAD I U1IGET ISZ U1IGET / BUMP PTR ISZ U1ICHR / BUMP RETURN ADDRESS. JMP U1ICHX / EXIT /A034 U1ICX, JMS U1ARON / TURN AUTO-REPEAT BACK ON. /A034 U1ICHX, CIF CDF .-. / MAP CALLER FIELD. JMP I U1ICHR / RETURN TOO CALLER / U1IGET, U1IBUF U1ICNT, 0 / / THIS ROUTINE CHECKS WHETHER ITS ARGUMENT IS AN XON OR XOF. / IF AN XOF, IT MAKES A REGULAR RETURN WITH AC=1. / IF AN XON, IT MAKES A REGULAR RETURN WITH AC=0. / OTHERWISE, IT MAKES A SKIP RETURN WITH AC CLEARED. / / AC = INPUT CHARACTER / JMS CHKXNF / AC=1 (XOF), AC=0 (XON) / AC=0 (CHARACTER WASN'T XOF OR XON) / IFNDEF FORIN < / ----------------------------------------------- CHKXNF, XX / TAD INTMP1 / GET THE CHARACTER AND P377 / STRIP ANY MODE BITS /M160 / TAD (-XOF) / IS IT AN XOF? SNA JMP CHKXN1 / YES--JUMP TO HANDLE IT TAD (XOF-XON) / IS IT AN XON? SZA CLA ISZ CHKXNF / NO--MAKE A SKIP RETURN JMP I CHKXNF / YES--MAKE A REGULAR RETURN WITH AC=0 / CHKXN1, AC0001 / RETURN ONE TO SIGNAL XOF JMP I CHKXNF > / END IFNDEF FORIN ---------------------------------- / U1BREAK moved here to create space for TST8BT to expand. /a164 U1BREAK,/ B_R_E_A_K / /a090 /d101 JMS H2OBRK / /a090 /d101 TAD BREAKF / /A041 /a101 SZA CLA / /A041 /a101 JMP U1ENDOFLIST / (already breaking) /a101 AC7777 / SET BREAK FLAG! /A041 /a101 DCA BREAKF / ... /A041 /a101 JMS H2OTFL / WAKE UP HOST (IF NOT ALREAD) /A041 /a101 JMP U1ENDOFLIST / /a090 /------------------- PAGE / U1OCHR, XX GETRTF / ++++ DCA U1OCHX / GET RETURN FIELD TAD X0 / RESTORE AC AND P377 DCA I U1OPUT TAD U1OCNT / TEST FOR FULL TAD (-U1OSIZ) SNA CLA / ++++ JMP U1OFUL / JUMP IF SO U1OCH1, CIF 0 / DELAY RUPTS ISZ U1OCNT TAD U1BFLG / OUTPUT ALREADY RUNNING? SNA CLA / ++++ U1TFL / FORCE READY IF NOT ISZ U1OPUT / BUMP PTR TAD I U1OPUT / WRAP IF NEC. SPA / ++++ DCA U1OPUT ISZ U1OCHR / BUMP RTN ADDR FOR SUCCESS SKP CLA / CLEAR AC U1OFUL, TAD I U1OPUT / RETURN AC=CHAR TO SHOW FULL U1OCHX, CIF CDF .-. JMP I U1OCHR / U1OPUT, U1OBUF U1OCNT, 0 U1BFLG, 0 U1CTLS, DCA U1CTQF / clear "STOP" flag here U1CTLB, TAD U1BFLG / SNA CLA / U1TFL / EXINTR / EXIT U1CTQF, 0 / STOP FLAG / --------------------------------------------------------- / / -------- DEVICE "KB INPUT" INTERRUPT CHAIN ENTRY -------- /M0068 /m090 / --------------------------------------------------------- / / /-----(O_R_D_E_R important)-----/ JMP U1PWRF / POWER RESUMED ENTRY TSTUIN / INTERRRUPT CHAIN LINK TSTKBI, U1KSF / TEST THE INPUT FLAG /M0020 JMP I TSTKBI-1 / NO INPUT -- CONTINUE CHAIN. /M0068 /\jmp U1INPT / INPUT FLAG IS SET--GO GET CHAR. /A0020 /----(E_N_D order important)----/ / U1INPT, U1KRB / U1ISTO, AND P377; DCA INTMP1 / ISOLATE ONLY 8 BITS /M160 /A041 JMS CHKXNF; JMP U1CTLS / / Compare the 7-bit ascii keyboard (U1) character /a090 / to the list of "ESC" sequences in the "U1ESCLIST" /a090 /a090 TAD INTMP1 / 8-bit ascii from keyboard /M160 /a090 TAD (-ESC) / /a090 SNA CLA / /a090 JMP U1ESCSTART / "ESC" found (start of sequence)/a090 /m091 U1TSTLIST, / /a090 TAD U1ESCPOINTER / /a091 SNA CLA / /a091 JMP U1NOMATCH / /a091 /M093 TAD I U1ESCPOINTER / /a090 SNA / /a090 JMP U1NOMATCH / NO MATCHES - END OF "U1ESCLIST"/a090 /m091 CMA IAC / /a090 /m091 TAD INTMP1 / /a090 TAD SEQATTRIBUTE / N000 /a095 SNA CLA / /a090 JMP U1ESCMATCH / MATCHed 1 char of an "ESC" list /a090 / NO match / /a090 TAD I U1ESCPOINTER / /a090 ISZ U1ESCPOINTER / (ultimately moves over "jmp" /a095 SMA CLA / /a090 JMP .-3 / loop / until "JMP" within list found /a090 JMP U1TSTLIST / TRY NEXT "ESC" LIST /a090 / M_A_T_C_H_E_D at least 1 character of the "ESC" list /a090 / /a090 U1ESCMATCH, / /a090 ISZ U1ESCPOINTER / move over character that matched... /a090 TAD I U1ESCPOINTER / ...to test the next entry of the list /a090 SPA CLA / skip next if more yet to come in /a090 JMP I U1ESCPOINTER / EXECUTE functionality (of ESC) /a090 TAD (1000) / /a095 TAD SEQATTRIBUTE / /a095 JMP U1PUT / (save the keyboard character) /a090 U1HALT, / H_A_L_T / /a090 AC7777 / /a090 JMP U1ENDOFLIST / /a090 IFDEF CONDOR < / ---------------------------------------------- /A090 U1PS, / P_R_I_N_T S_C_R_E_E_N/ /a090 CDFMNU /---------------------/ /a090 ISZ I (PRNTSCREEN) / FLAG (shouldn't overflow) /a090 CDFMYF /---------------------/ /a090 > / END IFDEF CONDOR ------------------------------------ /A090 U1ENDOFLIST, / /a090 / /a090 / ENTER with the ac=0 or 7777 / /a090 / (to clear or set halt flag) / /a090 / /a090 U1NOMATCH, / /a091 DCA U1HLTF / (any keyboard char clear the halt flag/a090 SKP CLA / /a091 U1ESCSTART, / /a091 TAD (U1ESCLIST) / /a090 DCA U1ESCPOINTER / /a090 U1PUT, / DCA SEQATTRIBUTE / 0, 1000, 2000, 3000 /a095 TAD U1ICNT / CHECK FOR FULL JMS TSTFUL / DO TSTFUL ROUTINE /C135 1 / CALLER NUMBER /A007 JMS U1STUF / STUFF CHAR IN BUFFER. CHECK FOR /A045 / PANEL MEMORY ESC SEQ. (CHAR WILL BE /A045 / READY ALREADY.) /A045 JMP U1INPT / GET NEXT CHAR. /A045 EXINTR / EXIT U1ESCPOINTER, / /a090 ZBLOCK 1 / 0 means not processing ESC sequence /m091 SEQATTRIBUTE, ZBLOCK 1 / 0, 1000, 2000, 3000 /a095 / U1 out I_N_T_E_R_R_U_P_T level service / TSTU1A, DCA U1OGET / HERE FOR WRAP TSTU1O, AC0001 / ++++ DCA U1BFLG / JUST IN CASE... U1OCK1, TAD I U1ONOF / SETTING AUTO-REPEAT ON/OFF? /A034 SZA; JMP U1OXOF / JMP IF YES. /A034 TAD U1OCNT / ANYTHING MORE TO DO? SNA CLA / ++++ JMP TSTU1C / JUMP IF NOT TAD U1CTQF / STOP FLAG? SZA CLA / ++++ JMP TSTU1C / JUMP IF SO TAD I U1OGET / GET CHARACTER SPA / ++++ JMP TSTU1A / WRAP IF NECESSARY JMS U1OCHK / CHECK FOR ESC SEQ OR TERMINATOR, ETC. /A034 U1TLS / PRINT IT AC7777 / ++++ TAD U1OCNT / ++++ DCA U1OCNT / ISZ U1OGET / AND PTR EXINTR / THEN EXIT U1OGET, U1OBUF / U1MASK, IFDEF FRENCH <175> IFNDEF FRENCH <177> U1OXOF, U1TLS / PRINT IT /A034 ISZ U1ONOF / BUMP FOR NEXT TIME. /A034 EXINTR / RETURN TO CALLER. /A034 /A034 U1ONOF, RPTON / TURN AUTO-REPEAT ON/OFF. /A034 PAGE / U1BREAK, moved this edit to ceate space for TST8BT to expand /a164 U1ESCLIST,/ O_R_D_E_R I_M_P_O_R_T_A_N_T /a090 / /a090 IFDEF CONDOR < / ---------------------------------------------- /a075 / CONDOR "print screen" is "ESC [ 1 2 ~"/a090 133+0 / [ /a090 61+1000 / 1 /a090 /m095 62+2000 / 2 /a090 /m095 176+3000 / ~ (tilde) /a090 /m095 JMP U1PS / STOPPER /a090 / CONDOR "break" is "ESC [ 1 5 ~" /m091 /\133+0 / [ /\61+1000 / 1 65+2000 / 5 /m091 /m095 176+3000 / ~ (tilde) /m095 JMP U1BREAK / STOPPER > / END IFDEF CONDOR ------------------------------------ /A075 / HALT defines as "ESC O P halt" 117+0 / O /m095 120+1000 / P /m095 HALT+2000 / /M035 /m095 JMP U1HALT / /M006 /m090 120+0 / VT52 GOLD:HALT defined as ESC P halt /A155 HALT+1000 / ... /A155 JMP U1HALT / /A155 IFNDEF CONDOR < / --------------------------------------------- /A075 / BREAK KEY DEFN IS "ESC O T" /A041 /\117+0 / O /M095 124+1000 / T /M095 JMP U1BREAK / STOPPER /A041 > / END IFNDEF CONDOR ----------------------------------- /A075 0 / "ESC" list terminator /a091 / E_N_D O_R_D_E_R I_M_P_O_R_T_A_N_T /\/\/\/\/\ IFDEF FRENCH < / ---------------------------------------------- /A035 HALT1 /A035 0 /A035 1 /A035 1 /A035 > / END IFDEF FRENCH ------------------------------------ /M090 TM1= "=&177 TM2= 76 / CLOSE ANGLE BRACKET. TMBA= "A&177 TMBZ= "Z&177 TMLA= "a&177 TMLZ= "z&177 U1OCHK, XX / CHECK FOR ENTERING/TERMINATING ESC SEQ. DCA U1OTMP / SAVE CHARACTER TO OUTPUT. TAD U1OTMP / GET CHARACTER BACK. TAD (-ESC / ARE WE OUTPUTTING AN ESCAPE? SNA CLA;JMP U1ESC1 / JMP IF YES. LAST ESC SEQ (IF ANY) TERMINATED. TAD U1ESC / ARE WE IN THE MIDDLE OF AN ESC SEQ? SNA CLA;JMP U1ESC2 / JMP IF NO. LAST ESC IS TERMINATED. TAD U1OTMP / GET CHAR TO OUTPUT BACK. WE ARE IN THE MIDDLE / OF AN ESC SEQ SO CHECK FOR TERMINATORS. / TERMINATORS INCLUDE =,CLS ANG BRKT,A-Z,a-z. TAD (-TM1) / CHECK FOR TERMINATOR. SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TM2+TM1) SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TMBA+TM2) SPA;JMP U1NTRM / JMP IF NOT TERMINATOR. TAD (-TMBZ+TMBA) SPA SNA;JMP U1OTRM / JMP IF TERMINATOR. TAD (-TMLA+TMBZ) SPA;JMP U1NTRM / JMP IF NOT TERMINATOR. TAD (-TMLZ+TMLA) SMA SZA;JMP U1NTRM / JMP IF NOT TERM. U1OTRM, CLA / TERMINATOR SEEN. CLEAR "IN-ESC-SEQ" FLG, OUTPUT. DCA U1ESC / CLEAR FLAG. U1NTRM, CLA / TERMINATOR NOT SEEN. JUST OUTPUT CHARACTER. TAD U1OTMP / ... JMP I U1OCHK / RETURN TO CALLER. / / TSTU1C moved from here this edit to make space for TST8BT /a164 U1ESC1, AC0001 / SAY THAT WE ARE IN THE MIDDLE OF AN ESC SEQ. DCA U1ESC / ... U1ESC2, TAD U1OFLG / ARE WE TO SET AUTO REPEAT ON/OFF? SNA;JMP U1NTRM / NO. JUST OUTPUT CHARACTER. U1ESC3, SMA CLA;TAD (RPTON-RPTOFF) / + ==]- TURN AUTO-REPEAT ON. TAD (RPTOFF) / - ==]- TURN AUTO-REPEAT OFF. DCA U1ONOF / SET AUTO-REPEAT STRG POINTER. TAD U1OFLG / SAVE FLAG TO SAY WHAT WE JUST SWITCHED TO. DCA U1OLFG / SAVE AS "LAST FLAG". DCA U1OFLG / SAY NO PENDING FLAGS. JMP U1OCK1 / START OUTPUTTING STRING. U1OTMP, 0 / TEMP TO HOLD CHARACTER. U1OFLG, 0 / - ==]- TURN AR OFF. + ==]- TURN AR ON. 0 NADA U1OLFG, 1 / SAVED COPY OF U1OFLG. WILL EITHER BE 1 OR -1. U1ESC, 0 / 0 MEANS NOT IN ESC SEQ. NE 0 MEANS IN ESC SEQ / enter with the (AC) = 0 U1ARON, XX / ROUTINE TO TURN SET FLAGS TO CAUSE AR TO / BE TURNED ON (IF NOT ALREADY). IOF / MUST BE CALLED WITH INTERRUPTS ON!!! /d101 CLA / GET STATE OF LAST ESC SEQ SENT. /d101 TAD U1OLFG / ... SMA CLA / IF - THEN LAST SENT WAS OFF. JMP U1AONX / IF + THEN LAST SENT WAS ON AND WE ARE DONE. AC0001 / SET OFLG TO + TO INDICATE THAT AR IS TO BE DCA U1OFLG / ENABLED. TAD U1BFLG / OUTPUT GOING? SNA CLA / SKIP IF YES. U1TFL / START OUTPUT GOING. U1AONX, ION / RE-ENABLE INTERRUPTS. JMP I U1ARON / RETURN TO CALLER. / enter with the (AC) = 0 U1AROF, XX / ROUTINE TO SET FLAGS TO CAUSE AR TO BE TURNED / OFF (IF NOT ALREADY). IOF / MUST BE CALLED WITH INTERRUPTS ON!!! /d101 CLA / GET STATE OF LAST ESC SEQ. /d101 TAD U1OLFG / ... SPA CLA / IF + (WILL NEVER BE 0) THEN LAST SENT WAS ON. JMP U1AOFX / IF - THEN LAST SENT WAS OFF AND WE ARE DONE. AC7777 / SET OFLG TO - TO INDICATE THAT AR IS TO BE DCA U1OFLG / DISABLED. TAD U1BFLG / OUTPUT GOING? SNA CLA / SKIP IF YES. U1TFL / START OUTPUT GOING. U1AOFX, ION / RE-ENABLE INTERRUPTS. JMP I U1AROF / ... /Routine to trap 8 bit characters put here as no room in SRCH page. /a160 TST8BT, XX / Routine to trap non-GOLD & -ESC 8 bits/a160 DCA SRCHCA / Save the character to test /a160 TAD SRCHU1 / Check to see if GOLD or ESC current /a160 SZA CLA / If so, 8-bit search required /m164 JMP IUTST / and check for U-^ and I-" /a164 TAD SRCHCA / Get character to test /a160 AND (200) / Is it 8 bit? /a160 SNA CLA / If so return normally /a160 TST8OK, ISZ TST8BT / Else make skip return /a160 TST8EX, TAD SRCHCA / Return with preserved accumulator /a160 JMP I TST8BT / Make return /a160 IUTST, TAD SRCHCA / Get the character back /A164 TAD (-333) / Is it a U-circumflex? /a164 SZA / .... /A164 TAD (333-317) / Is it an I-umlaut? /a164 SZA CLA / .... /A164 JMP TST8OK / No, skip exit /a164 DCA SRCHU1 / Yes, therefore can not be modified as /a164 / will cause confusion with GOLD-ALT KEY/a164 JMP TST8EX /a164 /------------------ PAGE / Subroutine to get 1 character from the host input ring buffer / CALL: HS2IN; RETURN (AC)=0 if buffer empty; else RETURN (AC)=char H2ICHR, XX GETRTF / ++++ DCA H2ICHX / GET RETURN FIELD TAD H2ICNT / ANYTHING THERE? SNA CLA / ++++ JMP H2ICHX / RETURN 0 IF NOTR CDFBF1, CDF THSFLD / Map buffer field (patched at run-time)/A108 TAD I H2IGET / GET CHAR CDF THSFLD / Back to this field. /A108 SPA / ++++ DCA H2IGET / WRAP IF NEC. CIF 0 / HOLD INTERRUPTS AC7777 / ++++ TAD H2ICNT / REDUCE COUNT DCA H2ICNT AC7775 / ++++ TAD H2ICNT / ++++ SZA CLA / ++++ JMP CDFBF2 / XON NEEDED? /M108 TAD (XON) / ++++ DCA H2OXOF / DO IT IOF / TURN INTERRUPTS OFF. /A041 JMS H2OTFL / WAKE OUTPUT SIDE ION / ENABLE INTERRUPTS AGAIN. /A041 CDFBF2, CDF THSFLD / Map buffer field. /A108 TAD I H2IGET / GET CHAR ISZ H2IGET / BUMP PTR ISZ H2ICHR / BUMP RTN ADDR H2ICHX, CIF CDF .-. / Map return field. JMP I H2ICHR / RETURN / H2IGET, H2IBUF /pointer/ host input buffer (increments as buffer fills) H2ICNT, 0 /counter/ # of char's within buffer (zero means empty) / / OUTPUT 1 CHARACTER over the communications line / (enter with the contents of the AC to the character to output) / IF the AC is negative then the buffers are reset ("JMP H2ORST") / 7401 = BREAK and 7402 = HANGUP are special cases /A123 / / TAD (n); CIFSYS; HS2OU; RETURN WITH AC=CHAR MEANS BUFFER FULL; RETURN AC=0 OK / H2OCHR, XX GETRTF / GET THE RETURN FIELD DCA H2OCHX / AND SAVE IT TAD DTRTIMER / CHECK FOR HANGUP OR /A123 TAD BREAKF / BREAK IN PROGRESS /A123 SZA CLA / (CAN'T BE BOTH, SO LINK IGNORED) /A123 JMP H2OBSY / YES, GO RETURN USER'S CODE TO HIM /A123 H2INLN, TAD X0 / RESTORE AC (saved at 'getrtf') SPA / ++++ JMP H2ORST / JUMP IF RESET CALL AND P377 DCA I H2OPUT TAD H2OCNT / TEST FOR BUFFER FULL TAD (-H2OSIZ) SNA CLA / ++++ JMP H2OFUL / JUMP CAUSE BUFFER IS FULL ISZ H2OCNT / BUMP FILL COUNT ISZ H2OPUT / BUMP PTR H2OOKY, IOF / TURN INTERRUPTS OFF /A041 JMS H2OTFL / (the interrupts must be 'OFF' within "H2OTFL") ION / ENABLE INTERRUPTS AGAIN /A041 TAD I H2OPUT / WRAP IF NEC. SPA / ++++ DCA H2OPUT H2OOKX, ISZ H2OCHR / BUMP RTN ADDR FOR SUCCESS SKP CLA / CLEAR AC H2OFUL, TAD I H2OPUT / RETURN AC=CHAR TO SHOW FULL H2OCHX, CIF CDF .-. JMP I H2OCHR H2OBSY, TAD X0 / RETURN FULL AC TO CALLER /A123 JMP H2OCHX /A123 / PART OF H2ORST, ROUTINE TO RESET COMM OUTPUT /A136 H2RSET, /A123 AC7775 / ++++ TAD H2ICNT / SET TO (RE)SEND XON SPA SNA CLA / ++++ TAD (XON) DCA H2OXOF DCA H2OXON DCA H2OCNT / CLEAR FILL COUNT DCA H2CTQF / CLEAR STOP FLAG TAD H2OPUT / ++++ DCA H2OGET / REALIGN BUF PTRS JMP H2OOKY / TAKE OK RETURN / H2OPUT, H2OBUF /pointer/HOST OUTPUT BUFFER (increments as buffer fills) H2OCNT, 0 /counter/increments representing # of char's in buffer H2BFLG, 0 /flag / =1 means 'OUTPUT' going / *** ---------------------------- *** / *** INTERRUPT LEVEL CODE FOLLOWS *** - HOST (comm) input / *** ---------------------------- *** H2INPT, / JMP here for comm reciever service IFNDEF CONDOR < JMS USIOT > / DECMATE I ROUTINE /A075 H2KRB / IOT / transfer into ac:4-11 char from device IFDEF CONDOR < / ---------------------------------------------- /A075 AND P377 /mask / (cause ac0-3 is junk when condor) > / END IFDEF CONDOR ------------------------------------ /A075 DCA INTMP1 / SAVE THE INPUT CHAR DCA INTMP2 / CLEAR ERROR STATUS. /A043 JMS H2ECHK /break? / BREAK if any errors!! /A043 IFDEF CONDOR < / ---------------------------------------------- /A075 TAD (70) / DISMISS THE COMM INTERRUPT LDREG / CR0A / CLA / > / END IFDEF CONDOR ------------------------------------ /A075 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SWSYS1, NOP / THIS INSTRUCTION IS ALTERED AT RUN TIME - IT / IS EITHER A 'NOP' OR A 'JMP SYSLOC', DEPENDING / WHETHER XON/XOF'S ARE TO BE INTERCEPTED / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JMS CHKXNF / ++++ JMP H2CTLS SYSLOC, TAD H2ICNT / GET COUNTER JMS TSTFUL / DO TSTFUL ROUTINE /C135 0 / CALLER NUMBER /A007 TAD INTMP2 / ADD IN ERROR BITS (3400) /A065 CDFBF3, CDF THSFLD / Map buffer field (patched on the fly)./A108 DCA I H2IPUT / STORE CHAR IN BUF ISZ H2ICNT / BUMP COUNTER ISZ H2IPUT / BUMP PTR TAD I H2IPUT / DO WRAP IF NECESSARY CDF THSFLD / Back to this field. /A108 SPA / ++++ DCA H2IPUT CLA / Clean up incase we exit. /A108 ISZ IX1 / set to -1 in "TSTFUL" if almost full JMP H2IEXIT / EXIT TAD (XOF) / SEND XOF IF ALMOST FULL DCA H2OXOF JMP H2CTLB H2CTLS, DCA H2CTQF / CLEAR STOP FLAG H2CTLB, TAD H2BFLG / RESTART OUTPUT SNA CLA H2OJMS, JMS TSTH2O JMP H2IEXIT / Exit interrupt. /A108 H2CTQF, 0 / STOP FLAG H2IPUT, H2IBUF /pointer/ address increments as characters come in H2OXOF, XON / / H2OXON, -XON / / /------------------ PAGE H2OTFL, XX TAD H2BFLG SNA CLA / SKIP IF ALREADY GOING. /M041 JMS TSTH2O JMP I H2OTFL / *** ---------------------------- *** / *** INTERRUPT LEVEL CODE FOLLOWS *** / *** ---------------------------- *** TSTH2A, DCA H2OGET / HERE FOR WRAP SKP TSTH2O, XX AC0001 / ++++ DCA H2BFLG TAD BREAKF / ARE WE TO DO A BREAK? /A041 SPA CLA / SKIP IF NO. /A041 JMP DOBRK / START THE BREAK GOING... /A041 TAD H2OXOF / ++++ TAD H2OXON / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| SWSYS2, SZA CLA / THIS IS PATCHED AT RUN TIME - IT IS / EITHER 'SZA CLA' (WHEN XON/XOF IS TO BE SENT) / OR 'SKP CLA' / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| / |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| JMP H2OXXF TAD H2OCNT / ANYTHING MORE TO DO? SNA CLA / ++++ JMP TSTH2C / JUMP IF NOT TAD H2CTQF / STOP FLAG? SZA CLA / ++++ JMP TSTH2C / JUMP IF SO TAD I H2OGET / GET CHARACTER SPA / ++++ JMP TSTH2A / WRAP IF NECESSARY IFNDEF CONDOR < / --------------------------------------------- /A075 TAD (400) / TELL SCD TO WRITE!!! JMS USIOT > / END IFNDEF CONDOR ----------------------------------- /A075 H2TLS / PRINT IT AC7777 / ++++ TAD H2OCNT / ++++ DCA H2OCNT / DECR COUNTER ISZ H2OGET / AND BUMP PTR JMP I TSTH2O H2OXXF, TAD H2OXOF IFNDEF CONDOR < / --------------------------------------------- /A075 TAD (400) / TELL SCD TO WRITE!!! JMS USIOT > / END IFNDEF CONDOR ----------------------------------- /A075 H2TLS / SEND XON OR XOF CLA TAD H2OXOF CIA DCA H2OXON / SAVE FOR LATER COMPARE JMP I TSTH2O / TSTH2C, DCA H2BFLG / CLEAR BUSY JMP I TSTH2O H2PWRF, JMS H2OFF / TURN H2 INTERRUPTS OFF. /M042 IFNDEF CONDOR < / --------------------------------------------- /A075 JMS H2ONN / ENABLE SELECTED H2 PORT. /M042 JMP H2OJMS > / END IFNDEF CONDOR ----------------------------------- /A075 IFDEF CONDOR < EXINTR > /A075 H2OGET, H2OBUF / /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ / DOBRK, AC0001 / SET "BREAK GOING" FLAG FOR "CLKSRV" /A041 DCA BREAKF / (WAS -1; STORE 1). /A041 TAD (CLOCK+1) / SET UP PTR TO CURRENT TIME. /A041 DCA CLKPT / ... /A041 TAD (TIMER) / SET UP PTR TO TIME TO STOP BREAK. /A041 DCA TIMEPT / ... /A041 TAD (CLKLIM) / SET UP PTR TO TIMER LIMITS. /A041 DCA LIMPT / ... /A041 TAD (-4) / SET UP LOOP COUNTR (10THS,SEC,MIN,HR) /A041 DCA LOOPCT / ... /A041 / /A041 JMS GETBTM / GET THE BREAK TIME /A157 DOBRK1, TAD I CLKPT / ADD IN THE CURRENT TIME. /A041 DCA I TIMEPT / SAVE THE STOP TIME. /A041 DCA OVFLOW / RESET OVERFLOW AMOUNT. /A041 DOBRK2, TAD I TIMEPT / GET IT BACK. /A041 TAD I LIMPT / SEE IF OVER THE INCREMENTAL TIME LIMIT/A041 SPA / SKIP IF YES. THE XTRA AMNT IS IN AC. /A041 JMP DOBRK3 / JMP IF TIME INCR IS OK. /A041 DCA I TIMEPT / SAVE NEW TIME. /A041 ISZ OVFLOW / SAVE OVERFLOW AMNT. /A041 JMP DOBRK2 / SEE IF STILL OVER. /A041 / /A041 DOBRK3, CLA / GET OVERFLOW AMOUNT (TO ADD IN TO /A041 TAD OVFLOW / THE NEXT THINGIE). /A041 ISZ TIMEPT / INCREMENT POINTERS FOR NEXT THINGIE. /A041 ISZ CLKPT / ... /A041 ISZ LIMPT / ..... /A041 ISZ LOOPCT / FINALLY THE LOOP COUNTER. /A041 JMP DOBRK1 / PROCESS NEXT TIME PIECE. /A041 / /A041 CLA / SET COMMAND REGISTER. /A041 TAD (10) / break / SET IT FOR A BREAK. /A041 JMS DOBIOT / DO THE BREAK IOT STUFF. /A041 JMP I TSTH2O / RETURN TO CALLER. BREAK IS GOING!!! /A041 / Subroutine to check for errors from the HOST (framing, overrun, parity) H2ECHK, XX / CHECK FOR ERROR ON INPUT LINE. /A043 IFDEF CONDOR < / ---------------------------------------------- /A075 /\cdf 0 /---[a] reg select--/ AC4000 / 'READ'/ IAC / status register #1 SELREG / IOT / SETUP CR0 CLA / RDREG / EXECUTE 'read' status register #1 /\and (377) / CLL RAR / (before RAR, bit5: FE, bit6: OVR, bit7: PE) > / END IFDEF CONDOR ------------------------------------ /A075 IFNDEF CONDOR < / --------------------------------------------- /A075 CLA / READ "SCD: INTERNAL STATUS REGISTER" /M065 TAD (1000) / ... /M065 JMS USIOT; PRB0 > / END IFNDEF CONDOR ----------------------------------- /A075 AND (70) / ISOLATE THE ERROR BITS. /A043 SNA / SKIP IF ERROR OCCURED. /A043 JMP I H2ECHK / RETURN (ZERO AC) IF NO ERROR. /A043 CLL RAR; BSW / PACK ERROR BITS INTO AC:3400 /A043 DCA INTMP2 / SAVE. /A043 TAD BREAKF / BREAK IN PROGRESS? /A065 SMA SZA CLA / SKIP IF <= 0 (BREAK NOT IN PROGRESS) /A065 TAD (10) / break / SET BREAK FLAG IF CURRENTLY BREAKING. /A065 JMS DOBIOT / WRITE COMMAND REGISTER. /A065 JMP I H2ECHK / RETURN TO CALLER. /A043 CLKPT, 0 / PTR TO CLOCK+1 TABLE /A041 TIMEPT, 0 / PTR TO TIMER TABLE. /A041 LIMPT, 0 / PTR TO CLKLIM TABLE. /A041 LOOPCT, 0 / LOOP COUNTER (4) /A041 OVFLOW, 0 / COUNTER OF # OF NEXT THINGIES (0-2) /A041 /THE CONTENTS OF THE AC AT ENTRY INTO "H2OCHR" WAS MINUS... / / 7777 means reset buffer only / 7401 means initiate a BREAK, then reset buffer /A123 / 7402 means HANG UP THE MODEM, then reset buffer /A083 / H2ORST, /A136 / THE FOLLOWING CODE WAS ADDED BECAUSE WE ALLOW THE USER TO CHANGE /A136 / THE BAUD RATE WHILE THE PRINTER IS USING THE HOST PORT (DD HOST) /A136 / WITHOUT THIS CODE THE IOT RESETTING THE BAUD RATE WOULD HALT FURTHER /A136 / HARDWARE INTERRUPTS THAT THE SOFTWARE EXPECTED, AND THE SYSTEM /A136 / WOULD HANG IN THE TIGHT LOOP NEAR H2BWT /A136 IFDEF CONDOR < /A136 IAC /SEE IF AC WAS 7777--RESET BUFFER ONLY /A136 SZA CLA / /A136 JMP H2BWT /NO, GO CHECK FOR HANGUP OR DTR /A136 IOF /TURN OFF INTERRUPTS WHILE WE DO THIS! /A136 DCA H2BFLG /RESET THE INTERRUPT EXPECTED FLAG /A136 > /END IFDEF CONDOR /A136 JMP H2RSET /GO RESET BUFFER, ETC /A136 /------------------ / / / Moved here on Edit 163 for space reasons /M163 / and later on edit 167 /M167 / / DISABLE communications (H2) IRQ's / H2OFF, XX / TURN OFF H2 INTERRUPTS. CLA / DISABLE all comm interrupts /M040 MCIE / MODEM CONTROL IRQ /A016 H2KIE / reciever irq H2TSK / transmitter irq IFNDEF CONDOR < / --------------------------------------------- /A075 OPRIE / OTHER PORT (USUALLY 1) RECEIVE /A016 OPSIE / OTHER PORT (USUALLY 1) TRANSMIT /A016 > / END IFNDEF CONDOR ----------------------------------- /A075 JMP I H2OFF / RETURN TO CALLER. /A042 PAGE / THIS IS THE SERIAL LINE PRINTER HANDLER FOR THE WS78 AND VT278. IT HANDLES / DOCUMENT DESTINATIONS DP2, SQ1, AND SQ2. / / THE IOTS / D2KSF2=6321 / SKIP ON INPUT PORT FLAG, CLEAR IF SET D2KIE2=6325 / SET/CLEAR INPUT PORT INTERRUPT ENABLE FROM AC11 D2KRB2=6326 / TRANSFER INPUT PORT TO AC(4:11) AND ENABLE INTERRUPTS / D2SPF2=6330 / SET PRINTER FLAG D2TSF2=6331 / SKIP ON PRINTER FLAG, CLEAR IF SET D2TPC2=6334 / TRANSFTER AC(4:11) TO PRINTER; DON'T ENABLE INTERRUPT D2TSK2=6335 / SET/CLEAR PRINTER INTERRUPT ENABLE FROM AC11 D2TLS2=6336 / TRANSFER AC(4:11) TO PRINTER; ENABLE INTERRUPTS / //////////////////////////////////////////////////////////////////////////// //// NOTE!! DO NOT MOVE ANY OF THE SYMBOLS FROM LPTYPE TO SQREST //////// //// WITHOUT CHANGING THE DEFINITION IN WPF1.PA!!! //////// //////////////////////////////////////////////////////////////////////////// / D2XONF IS ZERO IFF AN XON IS RECEIVED FROM THE PRINTER AND /A142 / IT IS ALREADY X'ED ON /A142 D2XONF, 1 / PRINTER DOUBLE XON FLAG /A142 LPDNFG, 1 / THE DONE FLAG (POSITIVE MEANS DONE) LPPWR, EXINTR / THE POWER FAILURE LINK LPICHN, TSTLON / THE NEXT ENTRY IN THE INTERRUPT CHAIN TSTLPO, D2TSF2 / CHECK OUTPUT FLAG. /M068 JMP I TSTLPO-1 / NO -- CONTINUE CHAIN. /M068 JMP D2CK7 / YES -- JMP TO HANDLE OUTPUT. /M068 HBCNT, D2OCNT / THIS IS A POINTER TO THE BUFFER COUNTER USED IN THIS / HANDLER. THERE IS A SIMILAR ENTRY IN THE SAME RELATIVE / POSITION IN ALL THE PRINTER HANDLERS. IT IS USED TO / ENABLE CHECKING ON THE PROGRESS OF THE HANDLERS. LPOCHR, XX JMP LPOCH1 / JUMP TO REAL ROUTINE /A011 SQREST, XX / ENTRY POINT TO SEND RESTORE TO SERIAL /A011 / PRINTER JMP SQRES / JUMP TO REAL ROUTINE /A011 D2CTQF, 0 / VARIABLE TO XON/OFF PRINTER /A036 D2GOIN, 0 / 0 WHEN NO OUTPUT INTERRUPTS PENDING. /A055 / 1 WHEN OUTPUT INTERRUPTS PENDING. /A055 LPOCH1, GETRTF / GET THE RETURN FIELD /M011 DCA D2OCHX / AND SAVE IT TAD X0 / RECOVER THE CHARACTER SPA / /A114 JMP D2ORST / IF CHR IS NEGATIVE, RESET HANDLER /A114 / THE AC NOW CONTAINS THE CHARACTER WHICH SHOULD BE OUTPUT. AND P377 / /A105 DCA TACHAR / save the character /a161 JMP TEST8B / go test for 8 bits output /a161 D2CONT, /a161 SNA / IF NOT NULL CONTINUE /A130 JMP D2OSUC / ELSE IGNORE AND TAKE SUCESS RETURN /A130 DCA I D2OPUT / WRITE INTO THE OUTPUT BUFFER TAD D2OCNT / COMPARE THE NUMBER OF CHARACTERS NOW STORED TAD NLPOSZ / WITH THE MAXIMUM SIZE / IF THE AC IS NOW ZERO, THE OUTPUTCBEFFER IS FULL. SNA CLA JMP D2OFUL / JUMP TO HANDLE A FULL BUFFER CIF 0 / TURN OFF INTERRUPTS BRIEFLY ISZ D2OCNT / INCREMENT THE BUFFER COUNT ISZ D2OPUT / INCREMENT THE BUFFER POINTER / IF THE OUTPUT HANDLER PART IS NOT ALREADY RUNNING, START IT UP. TAD LPDNFG / CHECK THE DONE FLAG--IS THE HANDLER RUNNING? SNA CLA JMP D2OCH2 / YES--SKIP THE START UP DCA LPDNFG / CLEAR THE DONE FLAG AC0001 / SAY THAT SQP IS GOING. /A055 DCA D2GOIN / ... /A055 D2SPF2 / FORCE OUTPUT TO BEGIN / NOW, IF THE POINTER NOW POINTS TO THE END OF THE BUFFER, RESET THE POINTER / TO THE BEGINNING. THE END OF THE BUFFER IS MARKED BY THE ADDRESS OF THE / BEGINNING OF THE BUFFER. D2OCH2, TAD I D2OPUT / GET THE WORD POINTED TO IN THE BUFFER SPA DCA D2OPUT / IT WAS THE END OF BUFFER FLAG--USE TO RESET / THE BUFFER POINTER D2OSUC, ISZ LPOCHR / MAKE A SKIP RETURN TO SHOW SUCCESS SKP CLA / CLEAR THE AC AND RETURN D2OFUL, TAD I D2OPUT / THE OUTPUT BUFFER WAS FULL--RETURN THE CHAR / TO SHOW FAILURE D2OCHX, CIF CDF .-. / CHANGE BACK TO THE FIELD OF THE CALLER JMP I LPOCHR / AND RETURN D2ORST, / RESET THE HANDLER /A114 AC0001 / CLEAR AC AND SET TO 1 /A114 CIFSYS / HOLD INTERRUPTS FOR A MOMENT /A114 DCA LPDNFG / SET DONE FLAG /A114 DCA D2CTQF / INSURE XON STATE /A127 DCA D2OCNT / CLEAR COUNT /A114 / WE MUST CAREFULLY ASSURE THAT THE PUT AND GET POINTERS ARE MADE EQUAL /A134 / HOWEVER, THE ORDER WE DO THIS IS IMPORTANT. WE MUST COPY THE PUT /A134 / POINTER TO THE GET POINTER, AND NOT VISA VERSA, ELSE WE CAUSE A BUG /A134 / IF WE TRY TO RESET THE HANDLER AT THE TIME THE PUT POINTER IS POINTING/A134 / TO THE BUFFER WRAP POINTER! (WE MADE THIS MISTAKE ONCE. IT CAUSES /A134 / BURSTS OF CHARACTERS TO BE MISSING AND NOT TRANSMITTED TO THE PRINTER /A134 TAD D2OPUT / GET THE PUT POINTER /A134 DCA D2OGET / MAKE GET POINTER THE SAME /A134 JMP D2OCHX / AND EXIT W/O SKIP RTN /A114 D2CK3, DCA D2OGET / WRAP POINTER TO BEGINNING OF BUFFER D2CK7, TAD I D2STAT / ARE WE PROCESSING A STATUS REQUEST? /A055 SZA;JMP D2CK8 / JMP IF YES. CONTINUE TO OUTPUT IT. /A055 TAD D2OCNT / CHECK FOR SOMETHING TO OUTPUT SNA CLA / ++++ JMP D2CK2 / NO TAD D2CTQF / SZA CLA / AM I XOFFED? JMP D2CK9 / DO XOF EXITTING. /A055 TAD I D2OGET / NO, GET CHARACTER SPA / ++++ JMP D2CK3 / IS IS REALLY A POINTER D2TLS2 / SEND AC7777 / ++++ TAD D2OCNT / ++++ DCA D2OCNT / DECRAMENT COUNTER ISZ D2OGET / MOVE POINTER EXINTR D2CK2, AC0001 DCA LPDNFG / SET TO DONE D2CK9, DCA D2GOIN / SAY NOT GOING NO MORE. /A055 EXINTR D2CK8, ISZ D2STAT / POINT TO NEXT STATUS CHAR FOR NXT TIME/A055 D2TLS2 / OUTPUT THIS STATUS CHARACTER. /A055 EXINTR / EXIT 'RUPTS. /A055 /D2CTQF, 0 /DEFINED ABOVE /D036 ICHKXN, CHKXNF NLPOSZ, -LPOSIZ D2OGET, LPOBUF D2OPUT, LPOBUF D2OCNT, 0 D2STAT, / PTR TO STATUS SEQ TO OUTPUT (IF ANY). /A055 ESCXX+2 / MUST POINT TO A PERMANENT ZERO /A103 /THE PURPOSE OF THIS ROUTINE IS TO TRANSMIT EITHER A RESTORE /OR A REQUEST FOR STATUS TO THE SERIAL LQP. IT DOES NOT USE /THE HANDLER, BECAUSE THESE REQUESTS MUST RECEIVE PRIORITY OVER WHATEVER /IS WAITING TO BE TRANSMITTED. /THE FIRST THING IT DOES IS DISABLE PRINTER INTERRUPTS. THIS ENABLES US /TO TELL WHEN THE CHARACTER HAS BEEN TRANSMITTED WITHOUT WORRYING ABOUT /THE DONE FLAG BEING CLEARED BY THE HANDLER. /WHEN TRANSMITTING A RESTORE, THE HANDLER IS FIRST XOFFED. WHEN THE LQP /COMPLETES RESTORATION, IT WILL XON THE HANDLER. IN THIS WAY, WE CAN BE SURE /NO CHARACTERS ARE TRANSMITTED DURING THE RESTORATION. / ELIMINATE POSSIBLE CORRUPTION OF D2GOIN BY KEEPING /A079 / INTERRUPTS OFF UNTIL EXIT. /A079 / ADDED CODE TO CLEAR BUFFER IF A RESTORE /A079 SQRES, GETRTF / THIS SAVES 1 WORD & DOES SAME JOB /A130 DCA SQRESX / AND SAVE IN EXIT SECTION /A079 TAD X0 / RECOVER THE SELECTION FLAG /C135 CDISYS / HOLD INTERRUPTS & MAP OUR FIELD. /A059 TAD ("0&177) / MAKE "0", "6", OR "c". /A059 DCA ESCXX+1 / SAVE. /A059 TAD (ESCXX / SET UP FOR A STATUS REQUEST. /A059 DCA D2STAT / SET POINTER... /A059 TAD X0 / RESTORE? /A059 /C135 SNA CLA / SKIP IF YES. /A059 JMP SQRES1 / JMP IF STATUS REQUEST. WE'RE DONE. /A059 AC0001 / SET XOF FLAG. /A059 DCA D2CTQF / (RESTORE IMPLIES XOF IMPLICITLY) /A059 TAD D2OPUT / CLEAR THE PRINT BUFFER /A079 DCA D2OGET / BY RESETTING THE POINTERS /A079 DCA D2OCNT / AND THE COUNT /A079 / (INTERRUPTS ARE OFF DUE TO CDISYS ABOVE /A079 SQRES1, CDISYS / STILL HOLD OFF INTERRUPTS /A079 TAD D2GOIN / IS SQP GOING? /A059 SNA CLA;D2SPF2 / START IT UP IF NOT GOING. /A059 AC0001 / SAY SQP IS GOING. /A059 DCA D2GOIN / ... /A059 SQRESX, XX / CHANGE BACK TO CALLER'S FIELD /C079 JMP I SQREST / AND RETURN /D135 SQSV, 0000 / STORES CHARACTER ON ENTRY /A036 /C135 ESCXX, ESC;0;0 / BUFFER FOR CHARACTERS OUTPUT VIA SQREST / SEPARATE FROM LPOBUF BECAUSE HANDLER / MUST BE BYPASSED IN CASE XOF OR FULL BUFFER BRKOFF, XX / /A041 /a101 JMS DOBIOT / SET COMMAND REG WITH NO BREAK./A041 /a101 DCA BREAKF / TURN BREAK FLAG OFF. /A041 /a101 DCA H2BFLG / TURN OFF "HOST BUSY" FLAG. /A041 /a101 IOF / DISABLE INTERRUPTS. /A041 /a101 JMS H2OTFL / START UP HOST OUTPUT SIDE. /A041 /a101 ION / ENABLE INTERRUPTS. /A041 /a101 JMP I BRKOFF / RETURN TO CALLER. /A041 /a101 /------------------ PAGE /FUNCTIONAL DESCRIPTION: / TSTFUL PREVENTS UNWANTED CHARACTERS FROM BEING INSERTED INTO A / DOCUMENT DUE TO INPUT FROM A KEYBOARD OR HOST AFTER THE INPUT / BUFFER HAS BECOME OR IS NEAR FULL. FOR EXAMPLE - IF THE BUFFER / HAS ONLY TWO EMPTY LOCATIONS AND A THREE CHARACTER ESC SEQ IS / TYPED BEFORE THE BUFFER HAS EMPTIED ENOUGH TO ACCOMMODATE IT, / THE ESC SEQ IS IGNORED THUS PREVENTING PARTS OF IT FROM BEING / INCLUDED IN THE DOCUMENT AS TEXT. / / TSTFUL PSEUDO-CODE / / SAVE CURRENT BUFFER COUNT / GET CALLER NUMBER FROM PARAM AT CALL+1 / IF PARAM <> HOST / THEN / DEVELOP ADDRESS OF OVERFLOW COUNT BUFFER / IF CHARACTER EQ ESC / THEN / CLEAR KBD'S OVERFLOW COUNT / IF WITHIN 2 CHARACTERS FROM END OF BUFFER / THEN / SETUP AND SAVE 3 CHARACTER DELAY / IF EXTENDED OVERFLOW FROM ESC SEQ IN PROGRESS / THEN / UPDATE OVERFLOW COUNT / EXIT ROUTINE / IF CHARACTER BUFFER FULL / THEN / EXIT ROUTINE / SETUP XON/XOF COUNT / BUFFER CHARACTER FOR RETURN / UPDATE RETURN ADDRESS / RETURN WITH CHARACTER TO CALLER / /EXIT ROUTINE / EXIT INTERRUPT WITHOUT CHARACTER / /CALLING SEQUENCE: TAD XXXCNT /GET BUFFER COUNT / CIFPRT /CIF TO PRINTER FIELD / DTSTFL /DO TSTFUL ROUTINE / 0,1, OR 2 /CALLER NUMBER / / TSTFUL IS CALLED FROM WPSYS AS ABOVE. / /INPUT PARAMETER: AC = BUFFER COUNT / / / /IMPLICIT INPUT: TSTFUL, P177, BUFCNT, OVCLST, INTMP1 (FLD. 0) / / TEMPT / / / /OUTPUT PARAMETERS: IF EXIT THROUGH TSTO21 (OK, ROOM IN BUFFER), THE/ / AC WILL CONTAIN THE CURRENT INPUT CHARACTER. IF EXIT THROUGH / / EITHER TSTF15 OR TSTF20 (NO ROOM IN BUFFER), AC WILL EQL 0. / / / /IMPLICIT OUTPUT: BUFCNT,TEMPT,IX1 (FLD. 0) / / / /COMPLETION CODES: NONE / / / /SIDE EFFECTS: / / 1) IF LOCATION OF TSTFUL IS CHANGED WPF1.PA'S DEFINITION OF / / TSTFUL MUST BE CHANGED ALSO. / / 2) THIS ROUTINE IS RUN WHILE IN THE INTERRUPT SKIP CHAIN. / / 3) IF KBD OR HOST BUFF TOO FULL TO ACCEPT INPUT, CHARACTERS ARE / / IGNORED. / / 4) THERE IS NO CHECKING DONE TO DETERMINE WHETHER INCOMING ESC / / SEQ IS 2 OR 3 CHARACTERS OR A SEQUENCE OF 4 CHARACTERS / (EX: G-HALT, G-RUL ... ETC.). ROUTINE DEFAULTS TO 4. / THUS IF BUFFER IS FULL THE NUMBER OF INCOMING CHARACTERS / SET IN THE OVERFLOW COUNT WILL BE DISREGARDED UNTIL THAT / COUNT EQUALS 0. EACH TIME AN ESC CHAR. IS DETECTED THE / OVERFLOW COUNT IS RESET BEFORE PROCEEDING. THIS IS NOT A / FOOL PROOF METHOD SINCE DIFFERENT COMBINATIONS OF GOLD-??? / (EX: G-ADV, G-BKP ... ETC.) MAY BE PARTIALLY INSERTED INTO / THE BUFFER AND OTHER PARTS REJECTED DUE TO LACK OF SPACE. / TO CORRECT THIS WE NEED A SMART TSTFUL. / 5) IN WPSYS.PA A CONDITIONALIZED NOP WAS PLACED IN THE SAME PAGE / AS SWSYS2 WHICH IS DEFINED IN WPF1.PA. THIS WAS DONE TO / AVOID CONDITIONALIZING SWSYS2 DEFINITION IN WPF1.PA. /***********************************************************************/ / / / TSTFUL--ROUTINE TO TEST IF WE ARE GETTING CLOSE TO FILLING / / THE COMMUNICATIONS INPUT BUFFER. IF SO, WE MIGHT / / HAVE TO TAKE SPECIAL ACTION / / / / TSTFUL IS CALLED FROM WPCU3 AND WPSYS / / / / TWO LOCATIONS IN THIS ROUTINE ARE PATCHED DEPENDING ON THE / / SIZE AND LOCATION OF THE COMMUNICATIONS BUFFER, WHICH CHANGES / / WHEN WE ENTER AND LEAVE COMMUNICATIONS. THESE LOCATIONS ARE / / DEFINED IN WPF1 AND PATCHED BY WPCU3: / / H2IMAX AND H2XOFP / / / /***********************************************************************/ ESCSIZ=3 /DEFAULT NUMBER OF CHARS. IN ESC. SEQ. /Entry point for TSTFUL is at the top of the page so that the /location will not change if the routine is changed. The location is /defined in WPF1.PA and if the location changes the definition in WPF1.PA /must change also. TSTFUL, XX DCA BUFCNT /SAVE BUFFER COUNT TO TEST TAD I TSTFUL /GET CALLER NUMBER PARAM AT CALL+1 SNA /SKP IF PARAM <> HOST JMP TSTO21 TAD (OVCLST) /DEVELOP ADDR OF OVERFLOW COUNT DCA TEMPT TAD I (INTMP1) /GET CHARACTER /D135 CDFMYF /CDF TO MY FIELD AND P377 /CHARACTER EQL ESC ? /M160 TAD (-ESC) SZA CLA /SKP: IF SO JMP TSTF10 DCA I TEMPT / reset overflow count TAD (-U1ISIZ-1+ESCSIZ)/WITHIN 2 CHARS. FROM BUFFER END ? TAD BUFCNT SPA CLA /SKP: IF SO JMP TSTF10 AC0004 /SET UP 4 CHAR DELAY - this may be a / four char. esc. string. ex: G - HALT DCA I TEMPT TSTF10, TAD I TEMPT /OVERFLOW FROM ESC SEQ IN PROG? SZA /SKP: IF NOT JMP TSTF15 /YES TAD (-U1ISIZ) / See if KB buffer full. JMP TSTO22 / ... TSTO21, TAD BUFCNT / See if time to send XOF yet. TAD H2XOFP / If so then set IX1 to "-1" so that / the host will get xoffed. DCA I (IX1) / TAD H2IMAX /IS BUFFER FULL? TSTO22, TAD BUFCNT SNA CLA /SKP: IF NOT JMP TSTF20 /YES - IGNORE CHAR ISZ TSTFUL /UPDATE RETURN ADDRESS TAD I (INTMP1) /RESTORE OK CHAR TO AC JMP I TSTFUL /RETURN - NOT FULL TSTF15, TAD (-1) /DECREMENT OVERFLOW COUNT DCA I TEMPT /UPDATE OVERFLOW COUNT TSTF20, TAD I (INTXIT) / get interrupt return address DCA TEMPT / save it for next JMP I JMP I TEMPT / exit interrupt without character H2IMAX, -H2ISIZ / Negative of Max Buffer Size. H2XOFP, -21 / -21 for sm buffer, -2001 for lg buffe BUFCNT, 0 / HOLDS BUFFER COUNT PASSED BY CALLER TEMPT, 0 /POINTER TO KBD BUFFER OVERFLOW COUNT / and also used as pointer for exit / interrupt. OVCLST, ZBLOCK 3 /OVCLST - HOST OVERFLOW COUNT /OVCLST+1 - KBD1 OVERFLOW COUNT /OVCLST+2 - KBD2 OVERFLOW COUNT / AT THIS POINT, WE KNOW THAT THE INTERRUPT THAT WE HAVE /A069 / INTERCEPTED WAS BECAUSE THE PRINTER WANTED TO SUPPLY AN /A069 / INPUT CHARACTER. /A069 / /A069 D2CKIO, D2KRB2 / READ INPUT /A069 DCA INTMP1 / SAVE IN A TEMPORARY /A069 JMS CHKXNF / SEE IF THE INPUT IS AN XON OR XOF /A069 JMP D2CK1 / YES--JUMP TO HANDLE IT /A069 TAD INTMP1 / RECOVER THE CHARACTER /A069 DCA I LPIPUT / AND SAVE IN BUFFER / THE SQPINP ROUTINE WAS DELETED AND THE FOLLOWING CODE ADDED REV103 ISZ LPIPUT / BUMP BUFFER POINTER TAD I LPIPUT / AND SEE IF NEED WRAP SPA DCA LPIPUT / YES, RESET POINTER CLA / NO TAD LPIPUT / SEE IF BUFFER IS FULL CIA TAD LPIGET / IF SO POINTERS WILL MATCH ISZ LPICNT / NOTIFY LPICHR THAT WE HAVE A BOGIE SZA CLA / SKIP IF FULL EXINTR / ALL OK, DISAPPEAR! / AT THIS POINT THE LPIBUF HAS OVERFLOWED DCA LPICNT / RESET THE COUNT / WE WANT TO DETECT IF THE BUFFER IS BIG ENOUGH / FOR DEVELOPMENT PURPOSES WE WILL INCLUDE A HALT HERE / SO WE CAN SEE IF WE EVER HIT IT / RESETTING THE COUNT SHOULD EFFECTIVELY CLEAR THE BUFFER / SINCE THE POINTERS ARE ALREADY KNOWN TO BE EQUAL IFDEF DEVEL NOP EXINTR / NOW WE MAY VANISH LPICHR, XX GETRTF / ++++ DCA LPICHX / GET RETURN FIELD TAD LPICNT / ANYTHING THERE? SNA CLA / ++++ JMP LPICHX / RETURN 0 IF NOTR TAD I LPIGET / GET CHAR SPA / ++++ DCA LPIGET / WRAP IF NEC. CIF 0 AC7777 / ++++ TAD LPICNT / ++++ DCA LPICNT TAD I LPIGET ISZ LPIGET / BUMP PTR ISZ LPICHR / BUMP RETURN ADDRESS. LPICHX, CIF CDF .-. / MAP CALLER FIELD. JMP I LPICHR / RETURN TOO CALLER / LPIPUT, LPIBUF LPIGET, LPIBUF LPICNT, 0 / THE INPUT CHARACTER WAS A XOF (AC=1) OR AN XON (AC=0). /A069 /A069 D2CK1, / XON OR XOF FROM PRINTER RECEIVED /A142 SZA / SEE WHICH /A142 JMP D2CK1A / XOFF, JUST GO SET IT /A142 TAD D2CTQF / XON, JUST COPY CURRENT XON/OFF FLAG /A142 DCA D2XONF / TO DOUBLE FLAG /A142 D2CK1A, /A142 DCA D2CTQF / SET THE STOP FLAG /A069 TAD D2GOIN / IS THE HANDLER BUSY? /A069 SNA CLA / SKIP IF YES. /A069 D2SPF2 / START PRINTER GOING. /A069 AC0001 / SAY PRINTER IS GOING. /A069 DCA D2GOIN / ... /A069 EXINTR / EXIT THE INTERRUPT /A069 / IFDEF CONDOR < / ---------------------------------------------- /A090 / test for "print screen" / when the contents of "PRNTSCREEN" = 0 then no print screen requested / when the contents of "PRNTSCREEN" = 4xxx then a print screen in process / when the contents of "PRNTSCREEN" = 1 then a print screen is requested TSTPS, XX / CDFMNU/---------------------/ TAD I (PRNTSCREEN) / FLAG CDFMYF/---------------------/ SPA SNA CLA / JMP I TSTPS / TAD (PSJOB) / JSTRT / START the "print screen" job / NOTE that "prntscreen" job will "dca PRNTSCREEN" and execute a "JEXIT" JMP I TSTPS / PSJOB, 0 / pointer to next "job status block" 40 / field (#2 times two) + link = 0 0 / mq PRNTSCREEN+2 / the address of the Print Screen job /m162 0 / ac > / END IFDEF CONDOR ------------------------------------ /A090 / INITONCE CODE FORMERLY AT THIS LOCATION HAS MOVED /A128 / TO WPCU2 TO AVOID A COMM INITIALIZATION RACE CONDITION. /A128 / ITS FUNCTION IS NOW PERFORMED BETWEEN LOCATIONS /A128 / CUDXIT AND CUDLUP IN THAT ROUTINE. /A128 / (END OF M112) / /---------------------- PAGE / *** ------------------------------------- *** / *** WPEDTB - MATCH TABLE FOR EDITOR INPUT *** / *** ------------------------------------- *** /THIS TABLE IS COMPATIBLE WITH VT-278 GENERATED ANSI ESCAPE SEQUENCES /THIS TABLE IS USED BY "SRCH" TO MATCH ESCAPE SEQUENCES WITH THEIR MEANINGS. / (THE MEANINGS ARE INTEGER CODES) /AN ESCAPE SEQUENCE IS VARIABLE LENGTH. ALL EXCEPT THE LAST /CHARACTER OF A SEQUENCE IS CALLED A MODIFIER. AS MODIFIERS ARE IDENTIFIED /IN THIS TABLE BY "SRCH", THE MODIFIER NUMBER IS BUILT UP. /FOLLOWING ARE THE MODIFIER SEQUENCES: / 1) ESC ESCAPE 200 / 2) ESC O ALTERNATE KEYPAD 400 / 2b/6) ESC [ pp ~ (CONDOR) alternate keypad 1400 /a073 / 2c) ESC [ p ~ /a078 / 3) ESC O P GOLD KEY 600 / 4) ESC O P ESC GOLD KEY ESCAPE 1000 / 5) ESC O P ESC O GOLD KEY ALTERNATE KEYPAD 1200 / 6b/7) ESC O P ESC [ pp ~ (CONDOR) GOLD key alt keypad 1600 /a073 / 6c) ESC O P ESC [ p ~ /A112 /FOR EXAMPLE, PRESSING GOLD MENU TRANSMITS "ESC O P M" /GOLD MENU IS ENCODED IN THIS TABLE AS 600 + M (THE VALUE OF GOLD KEY PLUS /THE VALUE OF M. FOUR PASSES THROUGH THIS TABLE WOULD BE MADE BY "SRCH" /TO MATCH GOLD MENU--THREE TO BUILD UP THE MODIFIER, AND ONE TO MATCH /THE M. /THE TABLE IS DIVIDED INTO SECTIONS--ONE FOR EACH MODIFIER. /200 IS SUBTRACTED FROM THE MODIFIER VALUE BEFORE THE ASCII VALUE /IS ADDED IN ASSEMBLING THE TABLE BECAUSE THE ASSEMBLER USES 8-BIT /ASCII VALUES WHICH ARE 200 LARGER THAN THE 7-BITS TRANSMITTED BY /M008 /THE VT-100. /THIS TABLE WAS DERIVED FROM THE ORIGINAL VERSION. IT IS DESIGNED /SPECIFICALLY FOR THE VT-100, SO THE CONDITIONAL PARTS WERE ELIMINATED. /IN ADDITION, THIS TABLE SUPPORTS VT-100 IN ANSI MODE. /M008 /NOTE: /AS IN THE ORIGINAL VERSION, ALL TABLE ENTRIES MUST BE IN ORDER FROM /LOWEST TO HIGHEST, AS "SRCH" DEPENDS ON THIS PROPERTY. EACH ENTRY IS /FOLLOWED BY ITS INTEGER CODE. /MODIFIERS: EDESC1=400 / (1) /ESCAPE /M164 EDESC2=600 / (2) /ALTERNATE KEYPAD USED /M164 EDESC3=1000 / (3) /GOLD KEY /M164 EDESC4=1200 / (4) /GOLD KEY, THEN ESCAPE /M164 EDESC5=1400 / (5) /GOLD KEY, THEN ALTERATE KEYPAD /M164 IFDEF CONDOR < / ---------------------------------------------- /A073 /Entire section below (modifier definitions) superseded by cursor /A112 / keypad stuff -- routine SRCH and the search table rewritten to /A112 / handle sequences of the form "ESC [ p ~" OR "ESC [ pp ~" /A112 / / --------------------------------------------------------------- / | Note that if the modifier is '4nnn', the entire sequence is | /A112 / | in except for the trailing tilde. To compress the table, | /A112 / | the modifier is of the form 4000 + (-translated code) | /A112 / --------------------------------------------------------------- EDESC6=1600 / CONDOR alt keypad ESC [ /M164/A112 EDES61=2000 / ESC [ 1 /M164/A112 EDES62=2200 / ESC [ 2 /M164/A112 EDES63=2400 / ESC [ 3 /M164/A112 EDESC7=2600 / GOLD CONDOR alt keypad ESC [ /M164/A112 EDES71=3000 / ESC [ 1 /M164/A112 EDES72=3200 / ESC [ 2 /M164/A112 EDES73=3400 / ESC [ 3 /M164/A112 NOFUNC=3600 /A112 > / END IFDEF CONDOR ------------------------------------ /A073 /THIS SECTION PRODUCES MATCHES WITH NO MODIFIERS. SRCHTB, 1; EDPWFL / POWER-FAIL FLAG FROM TTYIN IFNDEF CONDOR < 10; EDHYPS> / HYPHEN PUSH /M073 11; EDTAB / TAB IFNDEF CONDOR < 12; EDRBWD> / RUBOUT WORD /M073 15; EDNWLN / NEW LINE IFDEF CONDOR < 30; EDRBWD> / RUB WORD /A073 33; EDESC1 / (1) / ESCAPE 177; EDRBCH / RUBOUT CHAR /THIS SECTION IDENTIFIES SEQUENCES MODIFIED BY ESC. / All these tables have been modified this edit to accept 8 bit /a164 / characters /a164 SX=EDESC1-200 SX+233; EDESC1 / (1*) / ESC ESC (treated as one "ESC") /m083 SX+"O; EDESC2 / (2) / ALTERNATE KEYPAD IFDEF CONDOR < SX+"[;EDESC6 > / (6) / (CONDOR) alt keypad /A073 NODEF= 4400 /M101 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED ON THE ALTERNATE KEYPAD. /40 IS ADDED SO THE DEFAULT EXPECTATION WILL BE LOWER CASE LETTERS. /WHERE UPPER CASE IS EXPECTED, THE 40 IS SUBTRACED OFF. SX=EDESC2-200+40 / Following section has been updated for real cursor keypad /A112 / functions. "ARROWS" is no longer needed /A112 / SX+"A-40; EDUPAR / CURSOR UP /A112 SX+"B-40; EDDNAR / CURSOR DOWN /A112 IFDEF CONDOR < / ---------------------------------------------- /A130 IFDEF LFTRGT < / --- (RIGHT/LEFT CURSOR DIFFERENT FUNCTION) --- /A112 SX+"C-40; EDRARO / CURSOR RIGHT /A112 SX+"D-40; EDLARO / CURSOR LEFT /A112 > / END IFDEF LFTRGT ------------------------------------ /A112 IFNDEF LFTRGT < / --- (RIGHT/LEFT CURSOR = ADVANCE/BACKUP) ---- /A112 SX+"C-40; EDADVN / CURSOR RIGHT (same as ADVANCE) /A112 SX+"D-40; EDBKUP / CURSOR LEFT (same as BACKUP) /A112 > / END IFNDEF LFTRGT ----------------------------------- /A112 > / END IFDEF CONDOR ------------------------------------ /A078 IFNDEF CONDOR < SX+"C-40;EDSWAP / SWAP (UPPER CASE) /M130 SX+"D-40;EDHELP > / HELP /A130 SX+"M-40;EDENTR / NE KEY (UPPER CASE) SX+"P-40;EDESC3 / (3) / GOLD KEY (UPPER CASE) SX+"Q-40;EDPAGE / DEFINE PAGE (UPPER CASE) SX+"R-40;EDDLTW / DELETE WORD (UPPER CASE) SX+"S-40;EDDLTC / DELETE CHAR (UPPER CASE) IFNDEF CONDOR < / --------------------------------------------- /A073 / the OT (break key) ignored here / because it is serviced by the keyboard handler SX+"T-40;0 / OT (Break Key) /A041 > / END IFNDEF CONDOR ----------------------------------- /A073 SX+"L; EDPSTE / PASTE SX+"M; EDSCUT / CUT SX+"N; EDSLCT / SELECT SX+"P; EDADVN / ADVANCE SX+"Q; EDBKUP / BACKUP SX+"R; EDLINE / LINE SX+"S; EDUPPR / UPPER CASE SX+"T; EDWORD / WORD SX+"U; EDPARA / PARAGRAPH SX+"V; EDBOLD / BOLD SX+"W; EDSENT / SENTENCE SX+"X; EDTABP / TAB POSITION SX+"Y; EDUNDL / UNDERLINE /THIS SECTION IDENTIFIES SEQUENCES PRECEEDED BY PRESSING GOLD. SX=EDESC3-200 IFDEF ENGLSH < IFNDEF V30FAO < /A165 IFNDEF ENGCAN < / ENGLISH DEFINITIONS ARE DEFAULT (if foreign language not defined) IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDREPL / REPLACE SX+",; EDFIND / FIND SX+"-; EDHYP1 / PRINTING BREAK HYPHEN SX+".; EDSRCH / CONTINUE SEARCH SX+"/; EDCONT / CONTINUE SEARCH AND SELECT SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+"=; EDDICT / DICTIONARY SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+333; EDPCMD / COMMAND (LEFT SQUARE BRACKET - VT100) /A009 SX+334; EDTIME / DATE AND TIME SX+337; EDHYP2 / INVISIBLE HYPHEN SX+340; 0 / HALT (serviced by keyboard handler) SX+373; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFNDEF ENGCAN /M008 > /END IFNDEF V30FAO /A165 > /END IFDEF ENGLSH /M008 /END OF ENGLISH SPECIAL CHARACTERS TRANSLATION /THESE ARE THE ITALIAN GOLD-KEY CHARACTERS IFDEF ITALIAN < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"); EDHYP1 / PRINTING BREAK HYPHEN SX+"*; EDTIME / DATE AND TIME SX+"-; EDDICT / DICTIONARY SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+":; EDSRCH / CONTINUE SEARCH SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"=; EDPCMD / COMMAND SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > /END IFDEF ITALIAN /M008 / THIS COMPLETES THE ITALIAN GOLD KEY FUNCTIONS /THESE ARE THE FAO GOLD-KEY CHARACTERS IFDEF V30FAO < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDHYP1 / PRINTING BREAK HYPHEN SX+"+; EDDICT / ABBREV SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+"`; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF FAO /M008 /THESE ARE THE SPANISH GOLD-KEY CHARACTERS /A169 IFDEF SPANISH < IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDHYP1 / PRINTING BREAK HYPHEN SX+"+; EDDICT / ABBREV SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+"`; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF SPANISH /A169 IFDEF DUTCH < /A170 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDREPL / REPLACE SX+",; EDFIND / FIND SX+"-; EDHYP1 / PRINTING BREAK HYPHEN SX+".; EDSRCH / CONTINUE SEARCH SX+"/; EDCONT / CONTINUE SEARCH AND SELECT SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 SX+"=; EDDICT / DICTIONARY SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+333; EDPCMD / COMMAND (LEFT SQUARE BRACKET - VT100) /A009 SX+334; EDTIME / DATE AND TIME SX+337; EDHYP2 / INVISIBLE HYPHEN SX+340; 0 / HALT (serviced by keyboard handler) SX+373; EDPCMD / COMMAND SX+377; EDRBLN / RUBOUT LINE > /END IFDEF DUTCH IFDEF V30SWE < /A166 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDTIME / DATE & TIME SX+"+; EDHYP1 / PRINT HYPHEN SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > IFDEF V30NOR < /A166 IFNDEF CONDOR < SX+210;EDHYPL> / HYPHEN PULL /M073 SX+211; EDINTB / TAB CENTER IFNDEF CONDOR < SX+212;EDRBSE> / RUBOUT SENTENCE /M073 SX+215; EDCRET / CURSOR RETURN IFDEF CONDOR < SX+230;EDRBSE> / RUB SENTENCE /A073 SX+233; EDESC4 / (4) / GOLD, THEN ESC SX+" ; EDRQSP / NONBREAKING SPACE /A112 SX+"'; EDTIME / DATE & TIME SX+"+; EDHYP1 / PRINT HYPHEN SX+",; EDFIND / FIND SX+"-; EDCONT / CONTINUE SEARCH AND SELECT SX+".; EDSRCH / CONTINUE SEARCH SX+"0; EDUDK0 / USER DEFINED KEYS: SX+"1; EDUDK1 / #1 SX+"2; EDUDK2 / #2 SX+"3; EDUDK3 / #3 SX+"4; EDUDK4 / #4 SX+"5; EDUDK5 / #5 SX+"6; EDUDK6 / #6 SX+"7; EDUDK7 / #7 SX+"8; EDUDK8 / #8 SX+"9; EDUDK9 / #9 / SX+":; EDSRCH / CONTINUE SEARCH / SX+";; EDFIND / FIND SX+274; 0 / HALT (serviced by keyboard handler) SX+"?; EDHYP2 / Invisible Print Hyphen SX+"A; EDSUBS / SUBSCRIPT SX+"B; EDBOTM / BOTTOM SX+"C; EDCENT / CENTER SX+"D; EDDEAD / DEAD KEY SX+"F; EDFILE / FILE DOCUMENT SX+"G; EDDCMT / GET DOCUMENT SX+"L; EDGETC / GET PARAGRAPH SX+"M; EDMENU / MENU SX+"N; EDNPAG / NEW PAGE SX+"P; EDPMRK / PAGE MARKER SX+"Q; EDSUPS / SUPERSCRIPT SX+"R; EDRULR / RULER /D113 IFNDEF CONDOR < /A109 SX+"S; EDFIND / GOLD-SEARCH /A047 /D113 > /A109 SX+"T; EDTOP / TOP SX+"V; EDVIEW / VIEW SX+377; EDRBLN / RUBOUT LINE > /THIS SECTION IDENTIFIES THE SEQUENCE PRECEDED BY GOLD, ESC. /AND GOLD-8 BIT CHARACTERS, WHICH WILL NEVER CLASH WITH GOLD-ESC AS /U-CIRCUMFLEX (EQUIV TO GOLD-ESC-[) AND I-UMLAUT (EQUIV TO GOLD-ESC-O) /HAVE BEEN TRAPPED OUT IN 'TST8BT' AND CAN NOT BE USED AS GOLD-command /KEYS. (THIS IS OK AS THEY DO NOT OCCUR ON ANY NATIONALITIES KEYBOARD) SX=EDESC4-200 IFDEF ITALIAN < SX+260; EDHYP2 / INVISIBLE HYPHEN (8-bit degree) > SX+"O; EDESC5 / (5) / GOLD, THEN ALTERNATE KEYPAD IFDEF CONDOR < SX+"[;EDESC7 > / (7) GOLD key alternate key pad /A073 IFDEF V30FAO < SX+321; EDREPL / Replace (8-bit N~) /A165 SX+347; EDTIME / Date and time (8 bit c cedilla) /A165 SX+361; EDREPL / Replace (8 bit n~) /A165 > IFDEF SPANISH < SX+321; EDREPL / Replace (8-bit N~) /A169 SX+347; EDTIME / Date and time (8 bit c cedilla) /A169 SX+361; EDREPL / Replace (8 bit n~) /A169 > IFDEF ITALIAN < SX+354; EDPCMD / COMMAND (8-bit i-grave) /A009 SX+362; EDCONT / CONTINUE SEARCH AND SELECT (8-bit o-grave) SX+371; EDREPL / REPLACE (8-bit u-grave) > IFDEF V30SWE < SX+344; EDREPL / REPLACE (A UMLAUT) /A166 SX+345; EDPCMD / COMMAND (A RING) /A166 SX+374; EDDICT / ABBREV (U UMLAUT) /A166 > IFDEF V30NOR < SX+345; EDPCMD / COMMAND (A RING) /A166 SX+346; EDREPL / REPLACE (AE Ligature) /A166 SX+370; EDDICT / ABBREV (U UMLAUT) /A166 > /THIS SECTION IDENTIFIES SEQUENCES PRECEDED BY GOLD, ALT KEYPAD. SX=EDESC5-200+40 IFDEF CONDOR < / ---------------------------------------------- /A082 SX+"A-40; EDGBKP / GOLD CURSOR UP = GOLD BACKUP /A112 SX+"B-40; EDGADV / GOLD CURSOR DOWN = GOLD ADVANCE /A112 SX+"C-40; EDGRAR / GOLD CURSOR RIGHT (END OF LINE) /A112 SX+"D-40; EDGLAR / GOLD CURSOR LEFT (BEGIN OF LINE) /A112 SX+"M-40;EDSWAP / SWAP /A073 SX+"P-40;EDESC3 / (3*) / GOLD...GOLD (treated as one "GOLD") /M083 > / END IFDEF CONDOR ------------------------------------ /A082 IFNDEF CONDOR < / --------------------------------------------- /A130 SX+"A-40; EDPRSC / GOLD CURSOR UP = PREVIOUS SCREEN /A130 SX+"B-40; EDNXSC / GOLD CURSOR DOWN = NEXT SCREEN /A130 SX+"D-40; EDDO / GOLD CURSOR LEFT = DO /A130 > / END IFNDEF CONDOR ----------------------------------- /A130 SX+"Q-40;EDGPGE / GOLD DEFINE PAGE (UPPER CASE) SX+"R-40;EDUDLT / UNDELETE (UPPER CASE) SX+"S-40;EDUDLT / UNDELETE (UPPER CASE) SX+"L; EDGPST / GOLD PASTE SX+"M; EDGCUT / GOLD CUT SX+"P; EDGADV / GOLD ADVANCE SX+"Q; EDGBKP / GOLD BACKUP / GOLD LINE IS NOT A LEGAL FUNCTION. IT'S DEFINED HERE TO PREVENT /A008 / THE EDITOR COMMAND MATCHER FROM INTERPRETING "ESC O P ESC O r" /A008 / AS "ESC O P ESC O R" (UNDELETE). GOLD LINE WILL ADVANCE THE /A008 / CURSOR TO THE BEGINNING OF THE NEXT LINE (SAME AS LINE). /A008 SX+"R; EDLINE / GOLD LINE /A008 SX+"S; EDLOWR / LOWER CASE SX+"V; EDUBLD / UNBOLD SX+"X; EDCOLM / NEW KEY FOR COLUMM (GOLD TABPOS) /A152 SX+"Y; EDUUDL / REMOVE UNDERLINE / This entire section redone for the cursor keypad application /A112 IFDEF CONDOR < / ------------------------------------------ /A112 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED ON CONDOR ALTERNATE KEYPAD /A112 SX=EDESC6-200 /ESC [ p ~ or ESC [ pp ~ /A112 SX+"1; EDES61 /A112 SX+"2; EDES62 /A112 SX+"3; EDES63 /A112 SX+"4; 4000-EDSLCT /p=4 SELECT /A112 SX+"5; 4000-EDPRSC /p=5 PREV SCREEN /A112 SX+"6; 4000-EDNXSC /p=6 NEXT SCREEN /A112 SX+"A; EDUPAR /CURSOR UP /A112 SX+"B; EDDNAR /CURSOR DOWN /A112 IFDEF LFTRGT < / -- (RIGHT/LEFT CURSOR DIFFERENT FUNCTION) -- /A112 SX+"C; EDRARO /CURSOR RIGHT /A112 SX+"D; EDLARO /CURSOR LEFT /A112 > / END IFDEF LFTRGT ------------------------------------ /A112 IFNDEF LFTRGT < / --- (RIGHT/LEFT CURSOR = ADVANCE/BACKUP) --- /A112 SX+"C; EDADVN /CURSOR RIGHT = ADVANCE /A112 SX+"D; EDBKUP /CURSOR LEFT = BACKUP /A112 > /END IFNDEF LFTRGT /A112 SX=EDES61-200 /A112 SX+"2; 4000 /pp=12 PRINT SCREEN (ignore) /A112 SX+"3; 4000-EDSETUP /pp=13 SETUP /A112 SX+"5; 4000 /pp=15 BREAK (ignore) /A112 SX+"~; EDFIND /p=1 FIND /A112 SX=EDES62-200 /A112 IFDEF CONDOR < /A143 SX+"3; 4000-EDTC /pp=23 TECH CHAR (F11 [ESC]) /C150 /A143 SX+"4; 4000-EDHYPS /pp=24 NEW HYPEN-PUSH (F12) /A152 SX+"5; 4000-EDRBWD /pp=25 NEW RUB-WORD (F13) /A152 > /END IFDEF CONDOR /A143 SX+"6; 4000-EDINOV /pp=26 UDK KEY (F14) Now INsert-Overstrike / key /M167 /A148 SX+"8; 4000-EDHELP /pp=28 HELP /A112 SX+"9; 4000-EDUDKY /pp=29 DO- Now UDK key /A167 /A112 SX+"~; EDPSTE /p=2 INSERT = PASTE /A112 SX=EDES63-200 /A112 /D152 SX+"3; 4000-EDCOLM /PP=33 COLUMN KEY /A137 SX+"4; 4000-EDHYPS /pp=34 HYPHEN PUSH /A112 SX+"~; EDSCUT /p=3 REMOVE = CUT /A112 /THIS SECTION IDENTIFIES SEQUENCES PRODUCED BY GOLD CONDOR ALT KEYPAD /A112 / NOTE: NOFUNC modifier is necessary so that the search routine /A112 / will eat the final tilde and then return an invalid code. /A112 / Without this, the invalid code is detected before the tilde /A112 / comes in and the tilde is then taken as the next (valid) /A112 / character. /A112 SX=EDESC7-200 / GOLD ESC [ p ~ or GOLD ESC [ pp ~ /A112 SX+"1; NOFUNC /p=1 GOLD FIND (NO FUNCTION) /A112 /D153 SX+"2; 4000-EDGPST /p=2 GOLD INSERT = GOLD PASTE /A112 SX+"2; EDES72 /GET PAST ESC [ 2 /A153 SX+"3; EDES73 /A112 SX+"4; NOFUNC /p=4 GOLD SELECT (NO FUNCTION) /A112 SX+"5; NOFUNC /p=5 GOLD PREV SCREEN (NO FUNCTION) /A112 SX+"6; NOFUNC /p=6 GOLD NEXT SCREEN (NO FUNCTION) /A112 SX+"A; EDGBKP /GOLD CURSOR UP = GOLD BACKUP /A112 SX+"B; EDGADV /GOLD CURSOR DOWN = GOLD ADVANCE /A112 SX+"C; EDGRAR /GOLD CURSOR RIGHT = END OF LINE /A112 SX+"D; EDGLAR /GOLD CURSOR LEFT = BEGIN OF LINE /A112 SX=EDES72-200 /A152 SX+"4; 4000-EDHYPL / NEW HYPEN-PULL (GOLD F12) G $ [ 2 4 ~ /C153 SX+"5; 4000-EDRBSE / NEW RUB-SENTENCE (GOLD F13) G $[25~ /C153 SX+"~; EDGPST / ESC [ 2 ~ /A153 SX=EDES73-200 /A112 SX+"4; 4000-EDHYPL /pp=34 GOLD HYPHEN PULL /A112 SX+"~; EDGCUT /p=3 GOLD REMOVE = GOLD CUT /A112 > / END IFDEF CONDOR ------------------------------------ /A073 7777 / **** END OF TABLE TERMINATOR **** /---------------- / PAGE / Allow underflow from next page /D152 MN1FLD= 20 U1XLAT, XX GETRTF / ++++ DCA U1XCHX /"ARROWS" superseded by cursor keypad application / U1XLA1, DCA U1XLT2 /[A0034] INIT TO NO CHAR. U1XLA2, TAD U1HLTF / GET HALT FLAG /D148 CDF MN1FLD / CALL A ROUTINE TO RETURN A CHAR JMS GETUDK / FROM THE CURRENT UDK IF ONE IS ACTIVE JMP U1XLA3 / NO UDK ACTIVE /D148 CDF MN1FLD / CHECK TO SEE IF CHAR /D148 JMS CHKUDK / IS ANOTHER UDK ? CIFMNU /A148 JMS I CHKUDX /A148 SKP / NO, JUST RETURN CHAR. (INHIBIT MAY /M046 / HAVE BEEN SET) /M046 JMP U1XLA2 / YES, GET CHAR FROM NEW UDK DCA U1XLT2 / SAVE CHAR. /A046 JMP U1XLA8 / TAKE SUCCESS RETURN. /A046 / U1XLA3, CDFSYS / BACK TO HOME FIELD U1XLAA, /A122 PCMRDJ=JMP PCMDAT /SET JMP FOR OVERLAY FROM HERE /A122 NOP /GET DATE FROM PAN MEM IF WINNIE FIRMWARE/A122 TTYIN / ++++ JMP U1XLA9 / GET NEXT CHAR FROM KEYBOARD U1XLAB, /122 AND P377 /M160 JMS SRCH / ++++ SPA / ++++ JMP U1XLA4 / CHECK FOR UDK KEY IF SPECIAL TAD (-40) / ++++ SPA / ++++ JMP U1XLA3 / IGNORE IF CNTL TAD (40) JMP U1XLA5 / PROCESS GOTTEN CHARACTER BELOW. /A046 /A046 U1XLA4, /C148 /D148 CDF MN1FLD / CHECK TO SEE IF CHAR /A046 /D148 JMS CHKUDK / IS ANOTHER UDK ? /A046 /D148 SKP / NO, JUST RETURN CHAR. (INHIBIT MAY /A046 /D148 / HAVE BEEN SET) /A046 /D148 JMP U1XLA2 / YES, GET CHAR FROM NEW UDK /A046 DCA STUCHR / First save the char /A168 TAD STUACF / Is he running SETUP ? /A168 SZA CLA / /A168 JMP KYUDST / yes ,and he hit UDK so trap it /A168 TAD STUCHR / No , get char back /A168 CIFMNU /A148 JMS I CHKUDY /A148 JMP U1XLA5 /A148 JMP U1XLA2 /A148 JMP U1XLA3 /A148 KYUDST, TAD STUCHR / Allow UDK on its own /A168 U1XLA5, CDFSYS / /a084 DCA U1XLT2 /[[A034] SAVE CURRENT CHAR TO RETURN. TAD U1XLT2 / GET CHAR. SMA;JMP U1XLA7 / JMP IF AUTO-REPEAT ALLOWABLE. CIA / TAD U1XLT1 / IS IT THE SAME AS THE LAST CHAR? SZA CLA / SKIP IF YES. JMP U1XLA7 / JMP TO TURN AR ON -- CHARS ARE DIFFERENT. TAD U1XLT2 / GET CHAR. TAD (-EDNWLN) / IS IT ? SNA CLA;JMP U1XLA7 / JMP IF YES. DON'T AUTO XOF. / HERE TO TURN AR OFF -- CHARS ARE THE SAME. TAD U1DUMP /[[A039] ARE WE IN DUMP MODE YET? SPA;JMP U1XLA6 / JMP IF NOT YET. PASS 1ST REPEATED CHAR. SZA CLA;JMP U1XLA1 / JMP IF IN DUMP MODE. JMS U1AROF / CALL ROUTINE TO DISABLE AR. (JMS with AC=0) TAD U1XLT2 / GET CHAR TO BE RETURNED. TAD (-EDADVN) / IS IT ADV CHAR? SNA CLA;AC7775 / IF ADV SET COUNT TO -2 U1XLA6, IAC;SNA;IAC /[[A039] IF GOES TO 0 THEN SET TO 1. / [A039]] PASS THIS 1 TO USER BUT IGNORE NEXT. / ELSE SET COUNT TO 1 (DUP/DUMP COUNT). JMP U1XLA8 / MERGE BELOW TO EXIT. U1XLA7, / CLA / /a101 JMS U1ARON / CALL ROUTINE TO ENABLE AR. (JMS with AC=0) U1XLA8, ISZ U1XLAT / TAKE SUCCESS EXIT. U1XLA9, DCA U1DUMP / SET DUMP MODE FLAG. TAD U1XLT2 / GET CHAR TO RETURN. DCA U1XLT1 / SAVE FOR NEXT TIME. TAD U1XLT1 / [A034]] RETURN CHARACTER. /"ARROWS" superseded by cursor keypad application / U1XCHX, CIF CDF JMP I U1XLAT / U1XLT1, 0 /A034 TEMP. U1XLT2, 0 /A034 ANOTHER TEMP. U1DUMP, 0 /A039 -1 = PASS CHAR TO USER & GO TO 1. /A039 1 = IGNORE CHAR UNTIL CHAR CHANGES. /A039 0 = PASS CHAR TO USER. CHKUDX, CHKUXX /A148 CHKUDY, CHKUYY /A148 /\/\/\/\/\ U1PWRF, DCA U1CTQF / CLEAR STOP FLAG AC0003 U1KIE / MUST RE-ENABLE EACH INTERRUPT INDIVIDUALLY U1TSK / FOR VT-278. U1TFL / AND SET OUTPUT FLAG AC0001 / ++++ JMP U1ISTO / RETURN SOH FOR POWER UP SIGNAL / /A148 / XH2PT2 HAS BEEN MOVED FROM HERE TO THE VACUUM CREATED /A148 / BY H.PREBLE IN EDIT #139 /A148 / /A148 / / GET DATE FROM PANEL MEMORY /122 / PCMDAT, /122 ISZ PCMRD1 /INC PTR /122 JMS PCMRD /READ CHAR FROM P.M. /122 JMP U1XLAB /IS A CHAR /122 TAD (NOP /BUFFER M.T. /122 DCA U1XLAA /OVERLAY TO CONTINUE /122 JMP U1XLAA /CONTINUE /122 / MOVED HERE ON EDIT # 151 /A151 / / lower "DTR" for "n" seconds / ENTER WITH THE (AC) = NEGATIVE NUMBER OF SECONDS HANGUP, XX / / DCA DTRTIMER/ -# / (of seconds to wait) /D151 AC0010 / /D156 TAD (0013) / DROP DTR & KEEP 10 & 11 RESET /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 TAD (0010) / THIS BIT WILL DROP DTR /A156 IFNDEF CONDOR < / DMI HAS THE REVERSE SENSE OF DMII /A133 / IN SETTING "DTR" (& "RTS") /A133 CLL RAL / AC=XXXXXXX10XXX SETS "RTS" & RESETS "DTR"/A133 JMS WRTCTL / GO PREP IOT FOR ACTIVE PORT /A133 > / END IFNDEF CONDOR /A133 H2DTR / / 'hang-up' the modem JMP I HANGUP / EXIT / AC NOT EQUAL ZERO / TSTU1C moved here for space reasons this edit /a164 TSTU1C, TAD U1OFLG / ARE WE TO CHANGE AR SETTING? /A034 SZA; JMP U1ESC3 / JMP IF YES. EXIT (& CLEAR BUSY) IF NO./A034 DCA U1BFLG / CLEAR BUSY EXINTR / AND EXIT / X=. PAGE UD1OPS, XX / THIS ROUTINE IS CALLED WITH THE AC= ACTION DESIRED / CIFSYS / UDKOPS / RETURN (AC=0) / THE ONLY ACTIONS IMPLEMENTED ARE / AC=0 UDK'S ACTIVE / AC#0 UDK'S INHIBITED / GETRTF / ++++ DCA UD1CHX CDF MN1FLD JMS UDOPSB UD1CHX, .-. JMP I UD1OPS / UDOPSB, XX DCA I (UDKPTR) / CLEAR UDK STACK TAD X0 / GET OP WORD SZA / ++++ AC7777 / DO ENABLE OR DISABLE DCA I (UDKINH) JMP I UDOPSB / AND RETURN CLKSRV, XX / SERVICE CLOCK TICK CIF 0 / INHIBIT INTERRUPTS TAD LPDNFG / WHILE WE DO PRINTER TIME OUT SMA CLA / ++++ JMP CLKT4 / IF NECESSARY ISZ LPDNFG / ++++ JMP CLKT4 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!! D E F I N E D WITHIN W P F 1 . P A !!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! CLKOP, NOP / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!! D E F I N E D WITHIN W P F 1 . P A !!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! AC0001 / ++++ DCA LPDNFG CLKT4, CDF 20 / ++++ ISZ I (CLKCHG) / ++++ NOP CDF 50 / ++++ ISZ I (CLKCHG) / ++++ NOP CDF 0 TAD (CLOCK+1) / ++++ DCA T1 TAD (CLKLIM-1) / ++++ DCA X0 ISZ TENTHS / KEEP TRACK OF # OF TENTHS OF SEC GONE BYE/A057 JMP CLKT2 / JMP IF NOT ANOTHER SECOND. /A057 JMS TSTDTRTIMER / (are we in the process of hanging up?)/a078 TAD CLKLIM / RESET TO 10 TENTHS (PER SECOND). /A057 DCA TENTHS / ... /A057 ISZ TIMOUT / INCREMENT THE TIME OUT VARIABLE/051/057/097 NOP / NEEDED WITH ISZ TIMOUT /A097 CLKT2, TAD I X0 CLKT1, ISZ I T1 TAD I T1 SZA CLA / ++++ JMP CLKT0 DCA I T1 ISZ T1 TAD I X0 SZA / ++++ JMP CLKT1 / UPDATE ALL COUNTERS / WE GET HERE ON MIDNIGHT. ISZ DAYEAR / BUMP DAY OF YEAR AC0003 / ++++ AND YEAR / CHECK FOR NEW YEAR SNA CLA / ++++ CMA TAD (-D365) TAD DAYEAR / NEW YEAR? SPA SNA / ++++ JMP YEAROK DCA DAYEAR / IF SO, UPDATE DAY ISZ YEAR / AND YEAR YEAROK, JMS FIXDAT TAD BREAKF / IS BREAK GOING? /A041 SMA SZA CLA / SKIP IF NO. /A041 JMS BRKOFF / TURN BREAK OFF. /A041 CLKT0, ISZ CLOCK / ++++ JMP CLKSRV+1 TAD BREAKF / IS BREAK GOING? /A041 SPA SNA CLA / SKIP IF YES. SEE IF TIME TO TURN OFF. /A041 JMP CLKDON / BREAK NOT GOING SO JUST EXIT. /A041 TAD (TIMER+3) / PTR TO BREAK "STOP TIME". /A041 DCA CT1 / /A041 TAD (CLOCK+1+3) / PTR TO CURRENT TIME. /A041 DCA CT2 / /A041 TAD (-4) / LOOP COUNTER. /A041 DCA T1 / /A041 CLKCK1, TAD I CT1 / GET "STOP TIME" TIME PIECE. /A041 CIA / COMPUTE -"STOP TIME" /A041 TAD I CT2 / COMPUTE "CURRENT TIME"-"STOP TIME" /A041 SZA / SKIP IF TIME THE SAME. TRY NEXT THING./A041 JMP CLKCK2 / SEE IF "BREAK TIME" IS UP. /A041 AC7777 / MOVE ON TO THE NEXT TIME PIECE. /A041 TAD CT1 / STARTING AT THE MOST SIGNIFICANT /A041 DCA CT1 / PIECE AND MOVING TO THE LEAST SIGNIF/A041 AC7777 / ICANT PIECE. /A041 TAD CT2 / /A041 DCA CT2 / /A041 ISZ T1 / LOOP COUNTER. /A041 JMP CLKCK1 / TRY NEXT PIECE. /A041 JMP CLKDON / WE ARE DONE. SO EXIT TO CALLEE /A041 CLKCK2, SMA CLA / SKIP IF "BREAK TIME" NOT UP YET. I.E. /A041 / SKIP IF "CURRENT TIME"-"STOP TIME" < 0 /A041 / IE SKIP IF "CURRENT TIME" < "STOP TIME" /A041 JMS BRKOFF / TURN BREAK OFF. /A041 CLKDON, JMP I CLKSRV / CT1, 0 / TEMP POINTER. /A041 CT2, 0 / TEMP POINTER. /A041 TENTHS, -1 / then -12 / # OF TENTHS LEFT IN CURRENT SECOND. /A057 CLKLIM, -12 / ++++ -74 / seconds / ++++ -74 / minutes / ++++ -30 / hours / ++++ 0 / CLOCK COUNTER LIMITS TIMER, ZBLOCK 4 / "BREAK TIME" "STOP TIME" TIME /A041 / /FOLLOWING MOVED HERE VER..122 / / ---------------------------------------------------------- / / -------- DEVICE "KB OUTPUT" INTERRUPT CHAIN ENTRY -------- /M0068 / ---------------------------------------------------------- / / /M0068 /-----(O_R_D_E_R important)-----/ EXINTR / POWER RESUME ENTRY /A0068 TSTUON / INTERRUPT CHAIN LINK /A0068 TSTKBO, U1TSF / TEST THE OUTPUT FLAG /M0020 JMP I TSTKBO-1 / NO OUTPUT--CONTINUE THE 'RUPT CHAIN /M0020 JMP TSTU1O / OUTPUT FLAG IS SET--JUMP TO HANDLE IT /M0020 /----(E_N_D order important)----/ / / IFDEF FORIN < / THESE SUBS. ARE PUT HERE 'CAUSE OF ROOM CHKXNF, XX / CHECK FOR XON/XOF TAD INTMP1 / ++++ AND P377 / STRIP GARBAGE /M160 TAD (-XOF) / XOF? SNA / ++++ JMP CHKXN1 / JUMP IF SO TAD (XOF-XON) / XON? SZA CLA / ++++ ISZ CHKXNF / SKIP IF SO JMP I CHKXNF CHKXN1, AC0001 / ++++ JMP I CHKXNF / > / END IFDEF FORIN /------------------ PAGE SYFORK, XX / CALLED BY "FRKINT" CLA TAD I SYFORK SZA CLA / ++++ EXINTR / JUST EXIT IF ALREADY QUEUED TAD FRKCHN SNA / ++++ JMP DOFORK / JUMP IF THIS IS FIRST IN CHAIN DCA I SYFORK / ELSE TACK THIS ONE ON THE FRONT TAD SYFORK DCA FRKCHN EXINTR / AND EXIT FRKNXT, / JUMPED TO BY "FRKXIT" IOF / ++++ CLA / ENSURE CLEANLINESS TAD FRKCHN DCA SYFORK TAD I SYFORK / GET NEXT IN CHAIN JMP DOFRK1 / AND DO IT / DOFORK, TAD INTAC / ++++ DCA ASTAC / COPY ALL INT'RPT SAVE STUFF TAD 0 / ++++ DCA ASTPC TAD INTLK / ++++ DCA ASTFL MQA / ++++ DCA ASTMQ TAD (FRKEND) / SET OUR CLEANUP PROCESS DOFRK1, DCA FRKCHN / AS NEXT IN CHAIN DCA I SYFORK / SHOW THIS ONE NO LONGER IN QUEUE ISZ SYFORK / BUMP TO ENTRY POINT JMP I SYFORK / AND ENTER ROUTINE WITH RUPTS OFF FRKEND, 0 / DUMMY CHAIN LINK FOR CLEANUP ROUTINE TAD ASTFL / ++++ RTF / ++++ CLA / RESTORE ALL SAVED STUFF TAD ASTMQ / ++++ MQL SIGNAL / SET WAKEUP FLAG (LIKE DISMIS) TAD ASTAC JMP I ASTPC / AND RETURN TO MAIN LINE WITH RUPTS ON / ASTAC, .-. / SAVED AC ASTMQ, .-. / SAVED MQ ASTFL, .-. / SAVED FIELDS AND LINK BIT ASTPC, .-. / SAVED PC (RETURN POINT) / FIXDAT, XX AC0003 / CHECK FOR LEAP YEAR AND YEAR SNA CLA / ++++ IAC TAD (D28) / SET LENGTH OF FEB. DCA FEBDAY DCA MONTH / COMPUTE MONTH OF YEAR TAD (DAPERM-1) DCA T1 TAD DAYEAR CIA ISZ MONTH ISZ T1 TAD I T1 SPA / ++++ JMP .-4 CIA TAD I T1 DCA DAMNTH / AND DAY OF MONTH AC7777 TAD YEAR / NOW DO DAY OF WEEK CLL RAR CLL RAR TAD YEAR TAD DAYEAR TAD (-7) SMA / ++++ JMP .-2 TAD (10) DCA DAWEEK / 1=SUNDAY, 7=SATURDAY TAD DAMNTH BSW / ++++ TAD MONTH DCA PAKDAT JMP I FIXDAT DECIMAL D365=365 D28=28 DAPERM, 31 / JAN FEBDAY, 28 / 29 / FEB 31 / MAR 30 / APR 31 / MAY 30 / JUN 31 / JUL 31 / AUG 30 / SEP 31 / OCT 30 / NOV 31 / DEC OCTAL / ENABLE communications (H2) IRQ's H2ONN, XX / ENABLE SELECTED PORT INTERRUPTS. /A042 JMS H2ECHK /break? / issue BREAK if comm errors /A066 AC0003 / ENABLE SOME 'RUPTS. /A041 IFNDEF CONDOR < JMS USIOT > /A075 H2KIE / ENABLE RECIEVER INTERRUPTS. /A066 IFNDEF CONDOR < JMS USIOT > /A075 H2TSK / ENABLE TRANSMITTER INTERRUPTS. /A066 CLA / clear the accumulator JMP I H2ONN / exit / RETURN TO CALLER (with the ac=0) /A042 IFDEF CONDOR < /A130 / /READ CHAR FROM PANEL MEM.... /....THIS ROUTINE IS SET AT LOAD TIME... IS EXECUTED DURING START UP /.....WHEN FIRST END OF BUFFER IS READ(NULL) CALL TO ROUTINE WILL BE NOOPED / PCMADR=7732 /ADDRESS OF P.M. DATE /A122 PCMSTR=7600 /START OF PANEL MEM DATA /A122 PCMCMD=PCMSTR+10 /ADDRESS OF P.M.CMND STR /A122 PCMRD, 0 /A122 CLA /A129 PRQ3 /A122 5006 /IOT READ P.M..50XY.. X=OUTPUT FIELD Y=INPUT FIELD /A122 PCMRD1, PCMSTR-1 / LOCATION IN INPUT FIELD TO BE READ /A122 /C126 /C146 PCMRD2 / LOCATION TO PUT RESULTS /A122 -1 /- NO CHARS TO BE READ /A122 -1 /TERMINATOR /A122 TAD PCMRD2 /GET CHAR /A122 AND P177 / Strip down to 7 bits /A163 SZA /END OF BUFFER /A122 /C125 JMP I PCMRD /A122 ISZ PCMRD /YES /A122 /M125 TTYIN /IGNORE POWER FAIL STRTUP /A125 NOP /A125 CLA /A125 JMP I PCMRD /RET /A125 PCMRD2, 0 /CHAR JUST READ /A122 > /END IFDEF CONDOR /A130 / /------------------ PAGE / WPSRCH - EDITOR COMMAND MATCHER --- rewritten for '073' incl CONDOR cond's SRCH, XX / CALLED WITH (AC) = 7-BIT CHAR TO MATCH JMS TST8BT / Test for 8 bit non-modded character /a160 JMP I SRCH / Return with 8 bit char if non mod /a160 / Otherwise, if 7 bit or modded then... /a160 IFDEF CONDOR < / ---------------------------------------------- /A073 /This section rewritten for expanded table /A112 ISZ TILDEFLAG /LOOKING FOR A TILDE? /A112 JMP SRCH1 /(NO) /A112 TAD (-176) /YES, DO WE HAVE ONE? /A112 SZA CLA /A112 JMP SRCH3 /(NO, PROCESS A NON-MATCH) /A112 TAD SRCHU1 /YES, GET THE MODIFIER /A112 TAD (-4000) /STRIP THE 4000 /A112 CIA /NEGATE TO FORM XLATED CODE /A112 JMP SRCH4A /GO PROCESS A MATCH /A112 > / END IFDEF CONDOR ------------------------------------ /A073 SRCH1, /A112 DCA SRCHCA / 7-bit / SAVE CHAR IFDEF CONDOR < /A112 DCA TILDEFLAG > /RESET THE TILDE FLAG /A112 SKP /A112 SRCHRE, /A112 DCA SRCHU1 / CLEAR FOR NEXT MODIFIER BUILD /A112 AC7777 / -1 / DCA SRCHT2 / t2=0 / CLEAR FLAG FOR FIRST TIME THROUGH SRCH0, / drop / OR ENTER WITH (AC) = -40 /a083 TAD SRCHCA / 7-bit / STORE THE CHARACTER RECEIVED IN TEMP / IF THERE IS NO MATCH ON THE FIRST PASS THROUGH / THE TABLE THE CHARACTER SRCHCA IS MADE UPPER CASE / AND THE TABLE IS SEARCHED AGAIN. DCA SRCHT1 / t1 / TAD SRCHT1 / t1 / SNA / ++++ JMP I SRCH / ac=0 / IGNORE NULLS TAD SRCHU1 / CLL CIA /negate / SET FOR COMPARE (note link really=0 here) DCA SRCHT3 / TAD (SRCHTB-2) / WITH TABLE DCA SRCHX2 / X2 / SRCH2, ISZ SRCHX2 / +1 / TAD I SRCHX2 / GET NEXT TABLE ENTRY TAD SRCHT3 /-value / COMPARE SNA / ++++ JMP SRCH4 / match / JUMP CAUSE THEY MATCHED SNL CLA / ++++ JMP SRCH2 / loop / CONTINUE binary SEARCHING (still LOW) / The entire 'srchtb' has been searched w/o a match / IF this is pass I / THEN make the character (within 'srcht1') UPPER case and search again, / IF this is pass II / THEN there is no match to make (so exit) ISZ SRCHT2 / JMP SRCH3 / PASS 2 (no match) /m083 TAD SRCHCA / MAKE SEARCH CHARACTER UPPER CASE / make character within 'SRCHCA' upper case (or "jmp srch3" if already u/c) TAD (-140) / SPA SNA CLA / /a083 JMP SRCH3 / jmp / (7-BIT CHAR WAS UPPER CASE AT ENTRY) /a083 TAD (-40) / /a083 JMP SRCH0 / loop / pass II / SEARCHED THE ENTIRE TABLE WITHOUT A MATCH /a083 / /a083 / IF the contents of program location "SRCHU1" = 0 /a083 / THEN no modifier was in the process of being built /a083 / /a083 / (EXIT-because this is a legal key stroke), but /a083 / /a083 / IF the contents of "SRCHU1" are NOT = 0 /a083 / THEN a modifier was being built /a083 / when the entire table was searched w/o a match /a083 / /a083 / (EXIT-to beep the illegal key stroke) /a083 / /a083 / *** BUT BEFORE EXITING... *** /a083 / /a083 / NOTE!!!! The following comment did not seem to have anything whatever /A112 / to do with what the code was actually doing. In fact what we /A112 / want to do is check for an ESC. If we got no match, but now /A112 / have an ESC, we want to resynch the entire sequence on the ESC /A112 / SRCH3, TAD SRCHU1 /mod / get the modifier (or 0) /a083 SNA CLA / / skip next if modifier was being built /a083 JMP SRCH5 /to EXIT/ o.k. (one key stroke) /a083 TAD SRCHT1 /GET THE CHARACTER /A112 TAD (-33) /WAS IT AN ESCAPE? /A112 SNA CLA /(NO) /A112 JMP SRCHRE /YES, GO RESYNCH /A112 TAD (NODEF) /-value / this neg val will cause a "beep" /a083 DCA SRCHCA /"nodef"/ /a083 JMP SRCH5 / /(jmp cause not DECmate II "modifier") /a083 / MATCHED AN ENTRY IN THE TABLE SRCH4, TAD I SRCHX2 / GET MATCHED VALUE /This section rewritten to provide a new way of knowing when we /A112 / must look for a trailing tilde as well as handle escape /A112 / sequences of the forms ESC [ p ~ OR ESC [ pp ~ /A112 / /If the modifier value is negative, it is either the final translated /A112 / code or the end of a condor sequence that merely needs a final /A112 / tilde /A112 /If the value is 4xxx, it is a condor sequence and the modifier value /A112 / equals minus the translated code + 4000 /A112 /NOTE: This assumes, therefore, that the set of translated codes is /A112 / always at least 6000 /A112 SRCH4A, DCA SRCHCA /STORE MATCHED VALUE /A112 TAD SRCHCA /A112 IFDEF CONDOR < / ------------------------------------ /A112 SMA /A112 JMP SRCH5 /+ OR 0 -- GO STORE AS MODIFIER /A112 CLL RAL /WHICH TYPE NEGATIVE IS IT? /A112 SPA CLA /A112 JMP SRCH5 /(TRANSLATED CODE) /A112 AC7777 /CONDOR SEQ, SET TILDE FLAG /A112 DCA TILDEFLAG /A112 TAD SRCHCA /GET VALUE TO STORE AS MODIFIER /A112 > /END IFDEF CONDOR > / ------------------------------------ /A112 IFNDEF CONDOR < /A112 SPA /A112 CLA > /A112 SRCH5, DCA SRCHU1 /0; mod / CLEAR for next 'jms srch'; or BUILD mod TAD SRCHU1 / xfer vector:: (1), (2), (2b/6), ... SNA CLA / (else = 0 if translated ok) TAD SRCHCA / ?? / 8-bit char at entry or translated (neg) value/M160 JMP I SRCH / exit / / 'SRCHT1' contains the character in 'SRCHCA' / (if first time thru the table) / ELSE it contains the UPPER case of that character / (because it is the 2nd time thru the table) SRCHT1= T1 / (pass I-same as 'srchca'; pass II-UPPER case) SRCHT2= T2 / 1ST, 2ND TIME THRU SEARCH TABLE FLAG SRCHT3= T3 / NEGATIVE value of MODIFIER to match SRCHX2= X2 / POINTER TO SEARCH TABLE IFDEF CONDOR < / ---------------------------------------------- /A073 TILDEFLAG, ZBLOCK 1 / = 1 MEANS WAITING FOR 'tilde' > / END IFDEF CONDOR ------------------------------------ /A073 / HOST #2 (communications initialization) / (this routine was divided into 2 parts to get space for edit "078") /a078 XH2INI, XX / ENTRY POINT. /A042 GETRTF / GET RETURN FIELD (and "CDF 0") /A042 DCA XH2XIT / SET RETURN CDI. /A042 / Communications (host) is only initialized if (CMONLN) is nonzero /C104 / enabling the execution of DECmate II software on a DECmate I /a078 / FOR DEVELOPMENT PURPOSES /a078 TAD CMONLN / /C104 SNA CLA / /a078 JMP XH2XIT / ...SAYS THERE IS NO COMM... /a078 JMS H2OFF / TURN H2 INTERRUPTS OFF. /A042 IFNDEF CONDOR < / --------------------------------------------- /A075 CDFMNU / DETERMINE WHICH PORT IS SELECTED. /A042 TAD I (MUBUF+MNPRTB) / CDFMYF RTR RTR AND (1) DCA SWPORT / SAVE PORT SELECT. TAD SWPORT / SEE WHICH PORT IS SELECTED. /A042 SNA CLA > / END IFNDEF CONDOR ----------------------------------- /A075 TAD (MNPRIM-MNSECN) / IF 0 THEN PRIMARY (MNPRIM) /A042 TAD (MUBUF+MNSECN) / COMPUTE ADDRESS OF PORT CHARACTERISTICS/A042 DCA H2INT1 / WORD. SAVE IT. /A042 CDFMNU / MAP MENU FIELD. /A042 TAD I H2INT1 / GET PORT CHARACTERISTICS WORD. /A042 DCA H2INT1 / SAVE. /A042 AC0001 / CHeck XON/XOF bit of MNXONF. /A111 AND I (MUBUF+MNXONF) / "xon"/"xof" /M111 CDFMYF / /A042 KSZACLA,SZA CLA / ZERO MEANS SET JMP KSZ1 / /M111 TAD (NOP) DCA I (SWSYS1) TAD KSZACLA / /A083 JMP KSZ2 /M111 KSZ1, TAD (SYSLOC&177+JMP+200) /M111 DCA I (SWSYS1) TAD (SKP CLA) KSZ2, DCA I (SWSYS2) /M111 / -------------------------------------------------------------------- /a078 JMP XH2PT2 / /a078 / -------------------------------------------------------------------- /a078 /m083 / + + + + jmp here from within "XH2PT2" + + + + /m083 /m083 XH2XIT, XX / EXIT CID. JMP I XH2INI / RETURN TO CALLER. H2INT1, ZBLOCK 1 / TEMP / DDD DPP SSB BBB /(D)- data,(P)- parity,(S)- stop bits,(B)- baud / ------------------------- / | null job STATUS BLOCK | / ------------------------- NULJSB, . / NULJOB STATUS BLOCK 0 / FIELD 0, LINK 0 37 / MQ XJSTRT+1 / PC PRJOB / AC /----------------------- PAGE / CUSM - SETS THE VALUES FOR THE MENU TO BE DISPLAYED / THE VALUES FOR THE 278 COMM LINES (HOST LINES) CHARACTERISTICS ARE / PACKED (BY WPCU4) INTO MNPRIM/MNSECN FOR THE PRIMARY/SECONDARY PORT / LINES. THE VALUES ARE PACKED IN SUCH A WAY THAT PACKING AND UNPACKING / CAN BE DONE IN AN EFFICIENT MANNER. MNPRTB CONTAINS INFO PERTAINING / TO THE PRINTER BAUD RATE, BREAK-TIME, PORT SELECTION, AND CX TERMINAL / MODE. A BREAKDONW OF THESE PACKINGS FOLLOWS: / / FORMAT FOR "MNPRIM/MNSECN": / / BITS INFORMATION / / 11 - 8 THE CHARACTER SIZE ONLY COUNTING THE BITS IN THE / CHARACTER NOT PARITY OR STOP BITS / / 7,6 PARITY / / 5,4 STOP BITS / / 3-0 /BAUD / / FORMAT FOR "MNPRTB": / / 0-2 TERMINAL MODE (0=VT52, 1=VT278, 2=DECWORD52) /A044 / / 3-6 BREAK TIME (.1 TO 1.5 SECS. IN TENTHS OF A SECOND). / / / / 7 PORT SELECT (0=PRIMARY, 1=ALTERNATE) / / 8-11 PRINTER BAUD RATE. / / ********************************************************** / / LIMITS - VALUES THAT ARE CHECKED FOR IN THE MENU / / CHARACTER SIZE - CAN BE FROM 5 - 8 / / PARITY - 2 = NO PARITY, 1 = ODD, 0 = EVEN / / STOP BITS - 1 OR 2 NOTE: IF SET FOR 5 FOR CHARACTER SIZE AND 1 FOR STOP / IT WILL AUTOMATICALLY SET FOR 1.5 STOP BITS / / AND BAUD: / / VALUE BAUD / 0 50 / 1 75 / 2 110 / 3 134.5 (MAGCARD) / 4 150 / 5 300 (DEFAULT) / 6 600 / 7 1200 / 10 1800 / 11 2000 / 12 2400 / 13 3600 / 14 4800 / 15 7200 / 16 9600 / 17 19200 / IFNDEF CONDOR < / --------------------------------------------- /A075 /.SBTTL USIOT - CREATES THE IOTS FOR USRPTI/O / / CALL: JMS USIOT; IOT / / (where 'IOT' is the IOT minus the device code to execute) USIOT, XX DCA USIOT1 / STORE THE AC TAD SWPORT TAD (H2IOTB) / GET THE DEVICE CODE FOR PORT SPECIFIED DCA USIOT2 TAD I USIOT AND (7017) / GET IOT TAD I USIOT2 / ADD DEVICE CODE DCA I USIOT TAD USIOT1 / RESTORE AC JMP I USIOT / done USIOT1, 0 / holds the AC at entry USIOT2, 0 / pointer to 'PORT' 0 or 1 device code SWPORT, 0 / PORT select (bit 11:0 - port 0, 11:1 - port 1) H2IOTB, IOTH2I&760 / PORT 0 IOT'S. IOTH2A&760 / PORT 1 IOT'S. / Enter with (AC) = 10 means issue 'BREAK' DOBIOT, XX / /A041 TAD (3425) / SET COMMAND REGISTER / 3400 = WRITE COMMAND REGISTER. / BITS (4-5) = NORMAL OPERATING MODE (0). / BIT (6) IS NOT USER & SET TO 0. / BIT (7) IS RESET ERROR (SET). / BIT (8) IS FORCE BREAK (see AC at entry). / BIT (9) IS RECIEVE CONTROL (SET). / BIT (10) IS NOT USED (AND NOT SET). / BIT (11) IS TRANSMIT CONTROL (SET). JMS USIOT;PTB0 / WRITE THE COMMAND REGISTER. /A041 CLA / /A041 JMS USIOT;PRB0 / PREFORM DUMMY READ. /A041 CLA / /A041 JMP I DOBIOT / /A041 > / END IFNDEF CONDOR ----------------------------------- /A130 / IF the contents of program location "dtrtimer" is negative / THEN we are in the process of "hanging-up" the modem / / (the negative number within "dtrtimer" represents the time / in "seconds" that DTR will be kept low) / TSTDTRTIMER, XX / TAD DTRTIMER / SNA CLA / JMP I TSTDTRTIMER / EXIT ISZ DTRTIMER / JMP I TSTDTRTIMER / EXIT /d083 AC0010 / 10 / IFNDEF CONDOR < / DMI HAS THE REVERSE SENSE OF DMII /A133 AC0003 / IN SETTING "DTR" (& "RTS") /A133 R3L / AC=XXXXXXX11XXX SETS "RTS" & "DTR" /A133 JMS WRTCTL / GO PREP IOT FOR ACTIVE PORT /A133 > / END IFNDEF CONDOR /A133 IFDEF CONDOR < / KEEP BITS 10 & 11 FALSE ON DM II /A151 /D156 AC0003 / /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 > / END IFDEF CONDOR /A151 H2DTR / / set DTR (completes modem 'hang-up') CLA / JMP I TSTDTRTIMER / EXIT DTRTIMER,ZBLOCK 1 / IFNDEF CONDOR < /A133 WRTCTL, XX / SET UP "WRITE CONTROL REG." IOT FOR /A133 / APPROPRIATE DMI PORT /A133 DCA USIOT1 / SAVE AC (USE SAME TEMP AS USIOT) /A133 TAD SWPORT / GET ACTIVE PORT /A133 RTL / PUT INTO PROPER POSITION FOR IOT /A133 MQL / & SAVE IN MQ /A133 TAD I WRTCTL / GET IOT /A133 AND (7773) / MASK OUT PORT SELECT BIT /A133 MQA / & IOR WITH SAVED PORT SELECT /A133 DCA I WRTCTL / PUT IOT BACK /A133 TAD USIOT1 / RESTORE AC /A133 JMP I WRTCTL / & RETURN TO EXECUTE IOT /A133 > / END IFNDEF CONDOR /A133 IFNDEF CONDOR < / --------------------------------------------- /A130 / CUSVL - SETS THE COM LINES ON THE 78 FOR THE VALUES SET BY THE USER / / / THIS ROUTINE SETS THE BAUD, PARITY, DATA, AND STOP BITS FOR THE VT278. / TWO REGISTERS MUST BE WRITTEN: MODE REGISTER 1 AND MODE REGISTER 2. / / THE BIT ASSIGNMENTS FOR MODE 1 ARE: / / 4-5 STOP BITS (00=INVALID, 01=1, 10=1.5, 11=2) / 6-7 PARITY (00=NONE, 01=ODD, 10=NONE, 11=EVEN) / 8-9 DATA BITS (00=5, 01=6, 10=7, 11=8) / / 10-11 MUST BE "01" TO SPECIFY ASYCHRONOUS TRANSMISSION / / THE BIT ASSIGNMENTS FOR MODE 2 ARE: / / 4-5 NOT USED / 6-7 11 TO INDICATE INTERNAL CLOCKING / 8-11 BAUD RATE SELECTION (NORMAL PROGRESSION FROM 50 TO 192000) / / 0-3 MUST BE "0101" IN ORDER TO LOAD THE MODE REGISTERS. THE / REGISTERS ARE ACCESSED SEQUENTIALLY. H2DTR=6362 /(AC)=0 SET DTR, (AC)=10 DROP DTR /A130 CUSVL, XX / |----------| / |RESET PORT| / |----------| CLL CLA / TAD SWPORT RTR / SET AC00 TO SWPORT. RACD / PORT initialize / |-----------------| / |COMPUTE STOP BITS| - (00) invalid; (01) is 1 stop bit; (10) is 1.5; (11) is 2 / |-----------------| CLA / START W/ NOTHING! /A043 TAD SLUAS / GET THE NUMBER OF STOP BITS / WANT TO CHANGE 01--01, 10--11 CLL RAR / GET RID OF THE LEAST BIT STL RAL / CHANGE IT TO A 1, GET BACK INTO AC RTL / MOVE THE BITS FURTHER INTO THE AC / |-------------------| / |COMPUTE PARITY BITS| - (00) is no parity; (01) is odd; (11) is even / |-------------------| TAD SLUAP / GET THE ENCODING OF THE PARITY BIT / THE CONVENTION IS NONE=10, EVEN=01, ODD=00 / FOR THE VT278, NONE=10, EVEN=11, ODD=01 RTR / GET LOW BIT IN AC0 SPA STL / IF AC0=1, (EVEN PARITY), SET THE LINK SNL / IF LINK=0 (ODD PARITY) MAKE AC0=1 TAD (4000) RTL / GET BACK INTO THE AC RTL / MOVE THE BITS FURTHER INTO THE AC / |-----------------| / |COMPUTE DATA BITS| - (00) is 5 bit char's; (01) is 6; (10) is 7; (11) is 8 / |-----------------| TAD SLUAD / GET THE DATA BITS (character length) TAD (-5) / SCALE THEM DOWN CLL RTL / GET INTO AC8-9 TAD (2401) / ADD IN CONSTANT BITS / 2400 = SCD: MODE REGISTER 1/2 (WRITE). / AC ALREADY CONTAINS MODE SETTINGS FOR / STOP BITS (4-5), PARITY (6-7), AND / DATA BITS (8-9). BITS 10-11 ARE SET TO / 01 FOR ASYN 1 X RATE. JMS USIOT; PTB0 / SEND THE WORD. / |-----------------| / |COMPUTE BAUD RATE| / |-----------------| / 0000 - 50 / 0001 - 75 / 0010 - 110 / 0011 - 134.5 / 0100 - 150 / 0101 - 300 / 0110 - 600 / 0111 - 1200 / 1000 - 1800 / 1001 - 2000 / 1010 - 2400 / 1011 - 3600 / 1100 - 4800 / 1101 - 7200 / 1110 - 9600 / 1111 - 19200 TAD SLUAB / GET THE BAUD RATE TAD (2460) / ADD IN THE CONSTANT BITS / 2400 = SCD:7; 11 is 8 MODE REGISTER 1/2 (WRITE). / BITS 4-5 ARE NOT USED. 6-7 (60) IS / SET FOR INTERNAL TRANSMITTER/RECIEVER / CLOCK. 8-11 IS THE BAUD RATE SELECTION / IN THE AC ALREADY. JMS USIOT; PTB0 / SEND THE WORD. > / END IFNDEF CONDOR ----------------------------------- /A075 / ** CONDITIONAL REMOVED FROM TSTDTRTIMER AND THE CODE ** /A130 / ** MOVED TO B4 DMI'S CUSVL ROUTINE TO ALLOW A CLEAN ** /A130 / ** FALL THROUGH OF THE DMI CUSVL ROUTINE. ** /A130 IFDEF CONDOR < / ---------------------------------------------- /M130 / (AC) at entry = 10 means issue break DOBT1, ZBLOCK 1 / temp / LOCAL TEMP FOR SUBROUTINE "DOBIOT" /m083 DOBIOT, XX / CLL RAL / move / to bit 7 DCA DOBT1 / temp / local temporary /d086 TAD (20) / TAD (60) / /a086 /\cdf 0 /----[a] reg sel----/ LDREG / CR0A / CLA / reset ERROR flags and STATUS registers / --------------------------------------------------------------- / |CR5A| 4 5 6 7 8 9 10 11| TRANSMITTER ENABLE/DISABLE | / | | 0 0 0 0| | / |------------------------------|------------------------------| / | |0 0| | | | 5 bits (or less) | / | |0 1| | | | 7 bits | / | |1 0| | | | 6 bits | / | |1 1| | | | 8 bits | / | |----|--|--| | | / | | | 1| | | BREAK | / | |----|--|--| | | / | | | | 1| | ENABLE transmitter IRQ | / --------------------------------------------------------------- TAD (5) / SELREG / CIA / -5 / (SCALE) TAD SLUAD / TRANSMIT DATA BITS (same as reciever) BSW / CLL RAR / (into bits 5 and 6) TAD (10) / ENABLE transmit irq's TAD DOBT1 / 20? / (BIT 7 = 1 MEANS ISSUE 'BREAK') / |-------------------------| / |WRITE control register #5| / |-------------------------| LDREG / WRITE control register #5 CLA / JMP I DOBIOT / exit / done / COMMUNICATIONS INITIALIZATION / ENTER WITH THE CONTENTS OF THE AC = 0; AND / ENTER WITH THE DATA FIELD = FIELD 0 CUSVL, XX / ENTER WITH THE CONTENTS OF THE AC CLEAR / the DECmate II communications chip / ---- M U S T B E s e t u p T H I S W A Y----- / eachtime any parameter is modified SELREG= 6366 / (AC) = REGISTER NUMBER TO SELECT LDREG= 6366 / (AC) = VALUE TO LOAD INTO REGISTER RDREG= 6366 / (AC) GETS CONTENTS OF REGISTER H2DTR= 6362 / (AC) = 03 LOWER "DTR"; (AC) = 13 SET "DTR" H2BAUD= 6363 / (AC) IS THE BAUD RATE TO SET / first of all at the time this chip was chosen / it was the only one to contain all the 'neet stuff' / (async/sync; modem control, etc) that 'they' wanted / (you know who they are) therefore this chip is in / CT and RAINBOW as well as DECmate II. / / secondly it is a JAPanneessee chip which means / that the technical specification was originally written / in that language and somewhere in the translation / new meanings (misinterperations of the translator--probably / one of those "technical" writers) were born / consequently a big fuss was made because the chip didn't / work as the spec documented. / / THEREFORE at the time the communications code / was written (late in the project) there was no / time to "experiment" with different register / setup sequences...so that's the way it is. / / YOU'LL SEE IT IS A "BEAR" TO PROGRAM / / (IOT 6366 does not clear the AC) / / (the code "AC0013; 6362" hangs-up the modem) RACD / RESET / (this is a chip reset) / -------------------------------------------------- / |CR0A| | not used| crc | command | reg select | / | | 0 | 1 2 3 | 4 5 | 6 7 8 | 9 10 11 | / -------------------------------------------------- /\ cdf 0 /--- [A] REG SELECT---/ TAD (30) / reset / LDREG /channel/ (this is a channel A reset) CDF 10/--- [B] REG SELECT---/ / reset / (NOTE that the ac still = 30) LDREG /channel/ (this is a channel B reset) /\cla / / ------ / |CR2A| / ------ CDF 0 /--- [A] REG SELECT---/ AC0002 / CR2A / SELREG / select/ /\cla / /\tad (20) / fixed / TAD (16) / fixed / 2 + 16 = 20 LDREG / load / / ------ / |CR2B| / ------ CDF 10/--- [B] REG SELECT---/ AC0002 / CR2B / SELREG / select/ CLA / 0 / LDREG / load / / --------------------------------------------------------------- / |CR4A| 4 5 6 7 8 9 10 11| MODE AND PARITY SELECTIONS | / | | 0 1 0 0 | | / | |-------------------------|------------------------------| / | | |0 0| | ILLEGAL stop bit definition | / | | |0 1| | 1 stop bit | / | | |1 0| | 1.5 stop bits | / | | |1 1| | 2 stop bits | / | | |----|-------|------------------------------| / | | | x 0 | NO parity | / | | | 0 1 | ODD parity | / | | | 1 1 | EVEN parity | / --------------------------------------------------------------- CDF 0 /--- [a] REG SELECT---/ AC0004 / CR4A / SELREG / select/ AC0002 / AND SLUAS / USER DEFINED STOP BITS IAC / CLL RTL / TAD SLUAP / USER DEFINED PARITY TAD (100) / fixed / LDREG / load / / ------ / |CR1A| - interrupt enables/disables / ------ /\cdf 0 /--- [A] REG SELECT---/ AC0001 / CR1A / SELREG / select/ /\tad (26) /fixed / MUST NOT CHANGE TAD (25) / fixed / 1 + 25 = 26 LDREG / load / / ----- / |CR1B| / ----- CDF 10/--- [B] REG SELECT---/ AC0001 / CR1B / SELREG / select/ /\tad (26) / fixed / TAD (25) / fixed / 1 + 25 = 26 LDREG / load / / --------------------------------------------------------------- / |CR3A| 4 5 6 7 8 9 10 11| reciever enables/disables | / | | 0 0 0 0 0 | | / | |-------------------------|------------------------------| / | | 0 0| | | 5 bits (or less) | / | | 0 1| | | 7 bits | / | | 1 0| | | 6 bits | / | | 1 1| | | 8 bits | / | | | 1| ENABLE reciever | / --------------------------------------------------------------- CDF 0 /--- [A] REG SELECT---/ AC0003 / CR3A / SELREG / select/ /\tad (-5) / (scale) TAD (-10) / / +3 -10 = -5 TAD SLUAD / USER DEFINED DATA BITS BSW / IAC /enable / reciever irq LDREG / load / /D151 CLA / /D156 AC0003 / RESET BITS 10 & 11 /A151 JMS TSTIMB / CK FOR INTEGRAL MODEM ENABLED /A156 /--\ / --------------------------------------------------------------- /--\ / |CR5A| 4 5 6 7 8 9 10 11| TRANSMITTER ENABLE/DISABLE | /--\ / | | 0 0 0 0| | /--\ / |------------------------------|------------------------------| /--\ / | |0 0| | | | 5 bits (or less) | /--\ / | |0 1| | | | 7 bits | /--\ / | |1 0| | | | 6 bits | /--\ / | |1 1| | | | 8 bits | /--\ / | |----|--|--| | | /--\ / | | | 1| | | BREAK | /--\ / | |----|--|--| | | /--\ / | | | | 1| | ENABLE transmitter IRQ | /--\ / --------------------------------------------------------------- /--\ /\cdf 0 /--- [A] REG SELECT---/ /--\ TAD (5) / CR5A / /--\ SELREG / select/ /--\ CLA / /--\ TAD CR5VAL / /--\ LDREG / load / /--\ CLA / H2DTR / SELECT INTERNAL CLOCK & ASSERT "DTR" CLA / TAD SLUAB / USER DEFINED BAUD RATE H2BAUD / /\ cla / / |---------------------------------------------------| / |THE COMM CHIP IS NOW READY FOR TRANSMIT AND RECIEVE| / |---------------------------------------------------| > / END IFDEF CONDOR ------------------------------------ /A075 / -------------------------------------------------------------------- / | c a u t i o n d r o p f r o m a b o v e | / -------------------------------------------------------------------- CLA; JMS DOBIOT / SET COMMAND REGISTER. AC7777 / clear... CIFSYS / input buffer... HS2OU / of any previous... NOP / garbage...(AND ISSUE XON) CIFSYS / clear input buffer /A064 HS2IN / OF PENDING CHARACTERS /A064 SKP CLA / SKIP WHEN ALL MT. (that's empty) /A064 JMP .-3 / GO GET THE NEXT ONE (& TOSS IT OFF). /A064 JMP I CUSVL / exit / SLUAD, 0 / 000 000 00d ddd / DATA bits SLUAP, 0 / 000 000 000 0pp / PARITY SLUAS, 0 / 000 000 000 0ss / STOP bits SLUAB, 0 / 000 000 00b bbb / BAUD rate H2IEXIT, / /A108 IFNDEF CONDOR < /A108 JMS USIOT > / Map following IOT. /A108 H2KSF / See if pending input interrupt. /A108 EXINTR / Exit if no; end of interrupt service JMP H2IMRG / Merge below to continue MTing input silo/A108 / DUE TO SPACE REASONS THAT ONLY DEVELOPERS CAN KNOW, THE FOLLOWING / LOCATIONS FORMERLY LOCATED ON THE SAME PAGE AS THE "H2" INTERRUPT / HANDLER HAS BEEN MOVED TO IT'S NEW LOCATION HERE. DONE AS PART OF (068). / /************************************************************************* /**** /**** /**** INTERRUPT CHAIN ENTRY /**** /**** /**** /************************************************************************* / /M0068 / DEVICE "HOST INPUT" INTERRUPT CHAIN ENTRY. /M0068 / /M0068 JMP H2PWRF / POWER RESUMED ENTRY TSTHIN / INTERRRUPT CHAIN LINK /M0068 TSTHSI, / TEST INPUT FLAG IFNDEF CONDOR < JMS USIOT > / DECMATE-I PROCESSING ROUTINE /A075 H2KSF / TEST INPUT FLAG JMP I TSTHSI-1 / NO INPUT -- CONTINUE CHAIN /M0068 H2IMRG, / Merge point for Host Input Exit. /A108 IFNDEF CONDOR < JMP H2INPT > / DECMATE-I PROCESSING ROUTINE /A105 IFDEF CONDOR < / ---------------------------------------------- /A075 / / the communications chip used for DECmate II has only one IRQ flag / which could either mean: a. HARDWARE ERROR, b. TRANSMITTER INTERRUPT / c. RECIEVER INTERRUPT, d. PARITY, FRAMING, OR OVERRUN ERRORS CDF 10/--- [B] REG SELECT---/ TAD (4002) / SR2B / status register 2b SELREG / select/ CLA / RDREG / GET THE CONTENTS OF STATUS REGISTER 2B AND (7) / / the value of the AC is defined as follows: / 0 - hardware malfunction / 1 - hardware malfunction / 2 - hardware malfunction / 3 - hardware malfunction / 4 - transmitter buffer empty / 5 - hardware malfunction / 6 - receive data available / 7 - hardware malfunction or parity, overrun or framing errors CDF 0 /--- [A] REG SELECT---/ /\DCA H2BSTATUS / /\TAD H2BSTATUS / TAD (-4) / transmitter irq ? /a083 SZA CLA / skip means transmitter irq /a083 JMP H2INPT / receiver irq---or hardware malfunction/a083 H2TFL / 6310 / SET THE 'DUMMY' TRANSMITTER FLAG JMP I TSTHSI-1 / service the xmit irq later in chain /\H2BSTATUS,ZBLOCK 1 / > / END IFDEF CONDOR ------------------------------------ /A075 PAGE / DEVICE "HOST OUTPUT" INTERRUPT CHAIN ENTRY. /M068 / EXINTR / POWER RESUME ENTRY POINT. /M068 TSTHON / INTERRUPT CHAIN LINK /M068 TSTHSO, / TEST OUTPUT FLAG (dummy flag if CONDOR) IFNDEF CONDOR < JMS USIOTZ >/ DECMATE-I proc routine /A075 H2TSF / TEST OUTPUT FLAG JMP I TSTHSO-1 / No Output -- Continue chain /M068 IFDEF CONDOR < /------------------------------------------------/A075 / dismiss the transmitter interrupt, and / issue 'end of interrupt' command / /\cdf 0 /---[a] reg select----/ TAD (50) / LDREG / CR0A / DISMISS THE TRANSMIT INTERRUPT TAD (20) / (70) / LDREG / CR0A / ISSUE THE END OF INTERRUPT COMMAND CLA / > / END IFDEF CONDOR ------------------------------------ /A075 JMP H2OJMS / OUTPUT -- JUMP TO HANDLE IT. / /A0068 / *** DEVICE "LP INPUT" INTERRUPT CHAIN ENTRY. /A0068 / /A0068 EXINTR / POWER RESUME ENTRY POINT. /A0068 TSTLIN / INTERRUPT CHAIN LINK. /A0068 TSTLPI, D2KSF2 / TEST LP INPUT FLAG. /A0068 JMP I TSTLPI-1 / NO INPUT -- CONTINUE CHAIN /A0068 JMP D2CKIO / GO SERVICE LINE PRINTER INPUT /A103 /**** /**** END INTERRUPT CHAIN ENTRY /**** /************************************************************************* / POINTER AND STACK PUT HERE SO LOACATIONS MAY NOT MOVE. /A148 / THEY ARE REFERENCED IN CHKUDK, CHUDK0 IN WP2CMF /A148 / ADDRESSES ARE IN WPF1 /A148 /A148 U1STPT, 0 / POINTER TO STACK /A148 U1STCK, ZBLOCK 12 / STACK /A148 /A148 CTTYIN, 0 / USED BY UDK CODE FROM FIELD 2 /A148 / ADDRESS DEFINED IN WPF1 /A148 CLA /A148 TTYIN /A148 JMP .-2 /A148 AND P377 /A148 JMS SRCH /A148 CDIMNU /A148 JMP I CTTYIN /A148 GETUDK, /A148 XX /A148 SZA CLA / TEST HALT FLAG /A148 /D149 JMS GETUD9 / FLAG SET, EXIT /A148 /D149 JMP I GETUDK / EXIT /A149 JMP GETUD6 / CLEAR STACK POINTER ON GOLD HALT /A149 CDFMNU /A148 TAD I (UDKINH / TEST INHIBIT FLAG /A148 CDFSYS /A148 SZA CLA /A148 /D149 JMS GETUD9 / INHIBIT SET, EXIT /A148 JMP I GETUDK /A149 GETUD1, /A148 /D149 TAD U1STPT / GET LOCATION IN STACK TO ACCESS /A148 /D149 SNA /A148 /D149 JMS GETUD9 / STACK EMPTY, EXIT /A148 /D149 TAD (U1STCK-1 /A148 /D149 DCA GT1 / ACTUAL CORE ADDRESS IN STACK /A148 JMS GETUD3 / COMPUTE ADDRESS /A149 GETUD4, / HERE AFTER END OF UDK AND READ /A149 ISZ I GT1 / BUMP ADDRESS OF UDK IN STACK /A148 TAD I GT1 / GET ADDRESS OF UDK CHARACTER /A148 AND P377 / SAVE WORD PART /A148 SNA CLA /A148 JMS GETUD5 / END OF BUFFER, NEED READ /A148 TAD I GT1 / OK TO GET THIS CHARACTTER /A148 AND P377 /A148 TAD (CUDBUF / CONSTRUCT ACTUAL CORE ADDRESS /A148 DCA GT2 /A148 CDFMNU /A148 TAD I GT2 /A148 CDFSYS /A148 SNA /A148 JMP GETUD2 / FOUND END OF UDK /A148 ISZ GETUDK / HAVE CHARACTER, BUMP RETURN /A148 /D149 JMS GETUD9 /A148 JMP I GETUDK /A149 GETUD2, / CLEAR POINTER IN STACK /A148 / DECREMENT POINTER TO STACK, TRY AGAIN /A148 DCA I GT1 /A148 CMA /A148 TAD U1STPT /A148 DCA U1STPT /A148 /D149 JMP GETUD1 /A148 JMS GETUD3 / SET UP POINTER FOR NEXT ACCESS /A149 JMS GETUD5 / READ NEW BUFFER /A149 JMP GETUD4 / GET FROM NEW BUFFER /A149 /A148 GETUD5, / READ NEXT BLOCK /A148 0 /A148 TAD I GT1 / GET ADDRESS /A148 AND (7400 / KEEP BLOCK PART /A148 BSW / MOVE TO BITS 8-11 /A148 CLL RTR /A148 / IAC / BUMP TO NEXT BLOCK /D148 /D149 DCA GT2 / KEEP FOR UPDATE OF STACK /A148 /D149 TAD GT2 /A148 TAD (DLUDKS+1 / CONSTRUCT BLOCK TO READ (CHANGE +1) /C148 CIFMNU /A148 JMS I CHRRDX / READ THE DISK /A148 /D149 TAD GT2 / UPDATE STACK WITH CURRENT BLOCK /A148 /D149 BSW /A148 /D149 CLL RTL /A148 /D149 DCA I GT1 / AND PUT IN STACK /A148 JMP I GETUD5 /A148 /D149 GETUD9, / ALL PURPOSE EXIT /A148 /D149 0 /A148 /D149 NOP /A148 /D149 JMP I GETUDK /A148 /A148 GT1, 0 /A148 GT2, 0 /A148 CHRRDX, CHRUDX / REFERENCE IN WPF1 /A148 / ************ ADD ADAM *********** GETUD3, 0 TAD U1STPT / POINTER TO STACK SNA / ANYTHING IN STACK? JMP I GETUDK / NO, EXIT TAD (U1STCK-1 / POINTER + ADDRESS OF STACK DCA GT1 / PLACE IN STACK TO GET FROM JMP I GETUD3 GETUD6, DCA U1STPT / CLEAR STACK POINTER BEFORE EXIT ON HALT JMP I GETUDK / ********** END ADD ADAM ******* / U1STUF - CHECKS THE CHARACTER TO PUT INTO THE TERMINAL INPUT / RING BUFFER. IF IT IS AN ESCAPE, THEN A CHECK IS MADE FOR / THE ESISTANCE OF ANOTHER CHARACTER (THE ANSI INTRODUCER). / IF SUCH A CHARACTER EXISTS THEN THE ESCAPE MUST BE PART OF / A FUNCTION KEY ESCAPE SEQUENCE. IF IT IS NOT PART OF A / FUNCTION KEY ESCAPE SEQUENCE, THE ESCAPE IS FLAGGED WITH / THE 200 BIT SET. IF IT IS THEN A RETURN IS MADE TO ALSO / GET THE NEXT CHARACTER. / U1STUF, XX /A045 TAD (-ESC) / IS THIS CHARACTER AN ESC CHAR? /A045 SNA / SKIP IF NO. /A045 JMP U1IST3 / JMP TO CHECK OUT THE ESCAPE. /A045 SKP / DON'T SET 200 BIT IF NOT AN ESC. /A045 U1IST1, TAD (200) / SET 200 FOR ESC THATS USER ENTERED. /A045 TAD (ESC) / GET CHARACTER BACK. /A045 CLL / SAY NO CHARACTER FOLLOWS. /A045 U1IST2, DCA I U1IPUT / SAVE CHARACTER IN RING BUFFER. /A045 ISZ U1ICNT / 1 MORE CHARACTER IN BUFFER. /A045 ISZ U1IPUT / INC THE STUFF POINTER. /A045 TAD I U1IPUT / ARE WE AT THE END OF THE BUFFER? /A045 SPA / SKIP IF NO. /A045 DCA U1IPUT / RESET PTR TO START OF BUFFER. /A045 SNL CLA / SKIP IF FUNCTION ESCAPE. /A045 ISZ U1STUF / FOR NON-FUNCTION ESC WE WANT SKIP RETN/A045 JMP I U1STUF / RETURN TO CALLER. /A045 /A045 U1IST3, U1KSF / IS THERE ANOTHER CHARACTER PENDING? /A045 JMP U1IST1 / JMP IF NO. THIS ESCAPE IS USER ENTERED/A045 TAD (ESC) / RETURN REGULAR ESCAPE! /A045 STL / SET LINK FOR FUNCTION ESCAPE. /A045 JMP U1IST2 / STUFF CHAR & GET NEXT ONE. /A045 U1IPUT, U1IBUF PAGE /M148 / THIS CODE IS PART OF H2OCHR. IT IS HERE FOR /A123 / REASONS OF SPACE. /A123 / THE CALLER SENT THE AC<0. CHECK FOR BREAK OR DTR /A123 / CODES AND START APPROPRIATE ACTION, OR GO BACK TO /A123 / RESET THE BUFFER. /A123 /D136 H2ORST, CLA /A123 H2BWT, TAD H2BFLG / WAIT UNTIL LINE IS NOT BUSY /A123 SZA CLA /A123 JMP H2BWT / GO WAIT SOME MORE /A123 TAD X0 / OK, LINE FREE. RESTORE AC & TEST FUNCTION /A123 TAD (-7402 / HANGUP THE MODEM? /A123 SNA /A123 JMP H2HANG / YES /A123 IAC / START A BREAK? /A123 SZA CLA /A123 JMP H2RSET / NO. RESET THE BUFFER /A123 AC7777 / FLAG TO START BREAK /A123 DCA BREAKF /A123 JMS H2OTFL / WAKE UP THE HOST /A123 JMP H2OOKX / TAKE SUCCESS RETURN /A123 H2HANG, AC7775 / 3 SECONDS. /A123 JMS HANGUP / DROP DTR /A123 JMP H2OOKX / TAKE SUCCESS RETURN /A123 / /------------------ /D148 PAGE /MOVED TO ABOVE H2BWT TO MAKE ROOM / FOLLOWING IS MOVED HERE TO MAKE ROOM ELSEWHERE /M148 ~31 LINES / "JMP" to here from within "XH2INI" /a078 / (because of lack of pdp memory) /a078 XH2PT2, TAD (SLUAD-1) / GET ADDRESS OF ENTITIES WORDS /A042 DCA X0 / SAVE. /A042 TAD H2INT1 BSW / ++++ RTR AND (17) DCA I X0 / SLUAD / DATA BITS. TAD H2INT1 BSW AND (3) DCA I X0 / SLUAP / PARITY. TAD H2INT1 RTR / ++++ RTR AND (3) DCA I X0 / SLUAS / STOP BITS. TAD H2INT1 / AND SEPARATE THEM FOR DISPLAY/MODIFY AND (17) DCA I X0 / SLUAB / BAUD RATE. / * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /m083 JMS CUSVL / iots / SET THE VALUES (into the comm chip) /m083 / * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /m083 IOF / (cause "JMS H2ONN" wants it that way) /m083 JMS H2ONN / /m083 ION / /m083 /m083 / reutrn from "h2onn" with the accumulator = 0 /m083 /m083 JMP XH2XIT / /m083 /END M148 ~31 LINES / INTCHAIN, /A135 / |-----------------------| / |FIX UP INTERRUPT CHAINS| / |-----------------------| / /The following equates determine the order of the interrupt chain. However, /power low (which is checked first) and the clock (checked second) are not /affected by these equates. So, to change the order of any but power low or /clock, simply change the following equates. To change order of power low or /the clock, you must go into the code. The power low checking is done (after /saving AC, DF, LINK etc.) at location START and is followed by the check for /clock interrupt. / / -------- -------- / --------(SEE 'TSTHSI' IFDEF CONDOR) -------- / -------- -------- / /The following three equates were changed to put checking of COMM PORT in /front of the keyboard and screen. This had the effect of greatly improving /CX capabilities on the VT278. There is still a limitation when using the /HOST TO SCREEN (HS) option in CX of only going to 4800 baud. 19200 baud /is ok otherwise. / /The equates below were re-arranged as of (068) to put the printer /A068 /input at a higher priority than the kb output. /A068 TSTLPO=TSTLPT / THIS RESOLVES THE FORWARD REFERENCE BELOW*** /A068 TSTXXX=TSTHSI / First check host input /M068 TSTHIN=TSTLPI / Then check LP input /M068 TSTLIN=TSTKBI / Then KB input, then /M068 TSTUIN=TSTHSO / check host output (SEE 'TSTHSI' IF-DEF CONDOR)/M075 TSTHON=TSTKBO / Then check KB output /M068 TSTUON=TSTLPO / Then check LP output /M068 TSTLON=TSTLST / Then handle unrecognized interrupt GETBTM, XX / RETURNS BREAK TIME /A157 JMS TSTIM1 / FIRST TEST FOR INTEGRAL MODEM ENABLED /A157 JMP SETBT2 / ENABLED - GO SET TO (2 sec.) /A157 / DISABLED - CONTINUE /A157 CDFMNU / GET BREAK TIME FROM MENU LOCATION. /A041 TAD I (MUBUF+MNPRTB) / BREAK TIME IS BITS 3-6 /M154 CDFMYF / BACK TO US. /A041 RAL / SHIFT OVER 1 POSITION /A154 BSW / ISOLATE THE BT. /A041 AND (17) / /a089 JMP I GETBTM / RETURN VALUE /A157 SETBT2, TAD (20) / SET BREAK TIME TO (2 sec.) /A157 JMP I GETBTM / RETURN THE 2 sec. VALUE /A157 TSTIMB, XX / SET INTEGRAL MODEM BIT IF ENABLES & PRESENT /A156 / CALLED BY - HANGUP, TSTDTR, & CUSVL /A156 JMS TSTIM1 / GO DO THE TEST /A157 AC4000 / ENABLED - SET BIT 0 TO ENABLE INTEGRAL MODEM /A157 TAD (0003) / ENABLED RET. - KEEP BITS 10 & 11 SET /A157 DCA TSTIMT / SAVE IN TEMP /A159 TAD SLUAB / PICK UP BAUD RATE /A159 TAD (-7 / TEST FOR HIGH OR LOW SPEED /A159 SMA CLA / SKIP IF LOW SPEED, LESS THAN 1200 BAUD /A159 JMP TSTIMC / JMP IF HIGH SPEED, 1200 OR GREATER /A159 AC0004 / SET TO LOW SPEED /A159 TSTIMC, TAD TSTIMT / PICK UP BITS FROM TEMP /A159 JMP I TSTIMB / RETURN /A157 TSTIM1, XX / TEST FOR INTERGAL MODEM ENABLED & PRESENT /A157 CLA / /A157 CDFMNU / /A156 TAD I (MUBUF+MNFMAT) / /A156 CDFMYF / /A156 AND (MNFM4X / /A156 SZA CLA / SKIP IF NOT ENABLED /A156 JMP TSTIM2 / ENABLED - CK IF PRESENT /A157 ISZ TSTIM1 / SKIP RETURN /A157 JMP I TSTIM1 / /A157 TSTIM2, TAD (4003) / ISSUE AN ENABLE /A157 H2DTR / /A157 CLA / AC MUST BE CLEARED /A157 LAS / READ BITS /A157 AND (4000) / MASK MODEM BIT /A157 SNA CLA / /A157 JMP I TSTIM1 / BIT <0> = 0 - PRESENT, TAKE NON-SKIP RETURN /A157 AC0003 / BIT <0> = 1 - NOT PRESENT - DISABLE /A157 H2DTR / /A157 CLA / MUST BE CLEARED /A157 ISZ TSTIM1 / TAKE SKIP RETURN /A157 JMP I TSTIM1 / /A157 /Routine to trap 8 bit chars on output /a161 /Calls a routine that now resides where the startup code in DSKHND /a161 / used to be to deal with the 8 bit char /a161 / RETURNS with the ac =0 if the fallback has been sent /a161 / ac = char if no fallback required /a161 TEST8B, TAD TACHAR / get the char /a161 AND P200 / test the 8bit bit set /a161 SZA CLA / skip if we dont have an 8 bit char /a161 JMP TEST83 / yes an 8bit /a161 TEST81, TAD TACHAR / get the char back /a161 TEST82, JMP D2CONT / continue LPTOU /a161 / The next piece of code calls a test for an LQPO2 if it has one then /a161 / lots of 7 bit chars cold be sent as fallback for th present 8 bit char/a161 / Therefore we have to save the original RETURN address and FIELDS /a161 / in order to replace them and return to the right place /a161 / No 8 bit chars can or will be sent as Fallback chars so this code /a161 / will only be run once for each 8 bit char /a161 TEST83, TAD LPOCHR / get LPTOUs return address /a161 DCA LPTRSV / save it /a161 TAD D2OCHX / get the return field /a161 DCA LPTFSV / save it /a161 TAD TACHAR / get the char /a161 JMS I PRT8FB / (7600 call PRT8FB /a161 DCA TACHAR / save the char returned /a161 TAD LPTRSV / get the old return address /a161 DCA LPOCHR / put it back /a161 TAD LPTFSV / get the return feild /a161 DCA D2OCHX / put it back /a161 JMP TEST81 / return /a161 /----------------------- PAGE / NOW FOLLOW THE JOB STATUS BLOCKS /A139 / FIRST IS THE DSKQUE AND RXJOB BLOCK /A139 / NEXT IS THE PRINTER JOB BLOCK PRJOB /A139 / NEXT ARE OTHER JOB BLOCKS USED BY CX, ETC /A139 DSKQUE, / DEFINED IN WPF1 /A139 RXJOB / ++++ 0 / ++++ 0 / DSKQUE HEADER / ZBLOCK NJSBS^5 / ALLOCATE XTRA JSB'S / THE FOLLOWWNG IS THE FINAL CLEANUP CODE WHICH RUNS WHEN THE SYSTEM / IS LOADED. IT IS DESIGNED TO BE THE MINIMUM AMOUNT OF CODE WHICH ENDS / UP RESIDENT. MUCH OF THE INITIALIZATION CODE WHICH RUNS AT BOOT TIME / IS RESIDENT IN THE VARIOUS WPSYS BUFFERS. AFTER THAT CODE IS EXECUTED, / WPSYS MUST CLEAN ITSELF UP. THIS INVOLVES CLEARING ALL THE BUFFERS / AND INSTALLING THE WRAP POINTERS AT THE END OF EACH BUFFER (THIS IS / DONE BY CODE AT PATCHM. PATCHN, DCA I PATCHA / CLEAR PATCH CODE ISZ PATCHA ISZ PATCHA+1 / ++++ JMP PATCHN JMP I PWRJMP / NOW REALLY START UP SYSTEM / PATCHA, PATCHT / LOC TO START CLEARING / THIS IS WHERE THE BUFFERS BEGIN. THE FIRST LOCATION OF LPOBUF / DOUBLES AS AN ISZ COUNTER WHICH WILL CLEAR ITSELF AS THE ABOVE CODE / RUNS, AND THEREFOR CAN BECOME PART OF LPOBUF / THE BUFFER SIZES ARE DEFINED IN WPF1 / THE BUFFERS ARE LOCATED AS FOLLOWS: (X= ARE DEFINED IN WPF1) X=LPOBUF /PRINTER OUTPUT BUFFER U1IBUF=LPOBUF+LPOSIZ+2 U1OBUF=U1IBUF+U1ISIZ+2 X=H2IBUF /HOST INPUT BUFFER H2OBUF=H2IBUF+H2ISIZ+2 LPIBUF=H2OBUF+H2OSIZ+2 /A103 X=PRFVBF /PRINTER FIELD VARIABLE SAVE BUFFER /A139 ENDBUF=PRFVBF+PRFVSZ /C139 / RXHAN OCCUPIES THE SPACE BETWEEN RXDLDP AND 7777 /A110 XTRBUF=RXDLDP-ENDBUF-1 /A110 IFZERO XTRBUF+4000&4000 /A110 LPOBUF, PATCHT-PATCHZ-1 / LENGTH TO CLEAR /----------------------------------------------------------------- / THIS SECTION OF INITIALIZATION CODE RESIDES IN LPOBUF / IT CLEARS FROM THE END OF ITSELF (THEREFORE IT MAY NOT USE LINKS / OR LITERALS) TO RXDLDP, AND INSTALLS ALL THE BUFFER WRAP POINTERS / THE BUFFER IN WHICH IT RESIDES (LPOBUF) MUST BE LARGER THAN THIS / SECTION OF CODE PATCHT, CIFPRT / PTC7R0 NOW IN PRINTER FIELD /A138 / LEAVE DATA FIELD SET TO SYS /A138 JMS I (PTC7R0 / DO THE DRIVE SIZING /A114 JMS COMINI / INITIALIZE COMM /A135 PATCHU, /A114 DCA I PATCHB / CLEAR BUFFER CORE AREA ("PATCHZ" THRU RXDLDP) ISZ PATCHB / ++++ ISZ PATCHD /A110 JMP PATCHU /LOOP /A110 /C114 TAD PATCHS / ++++ DCA X0 / SET END PTRS JMS I XPATCM / DO PATCHES JMP PATCHN / GO CLEAR OUT THIS CODE /A135 PATCHB, PATCHZ PATCHD, PATCHZ-RXDLDP XPATCM, PATCHM PATCHM, XX / /M090 TAD I X0 / GET LOC TO BE PATCHED SNA / ++++ JMP I PATCHM / QUIT IF 0 DCA T1 TAD I X0 / ++++ DCA I T1 / MOVE NEW CONTENTS TO LOC JMP PATCHM+1 / AND LOOP FOR MORE / PATCHS, . LPOBUF+LPOSIZ+1 / ++++ LPOBUF / BUFFER END PTR PATCHS U1IBUF+U1ISIZ+1 / ++++ U1IBUF U1OBUF+U1OSIZ+1 / ++++ U1OBUF H2IBUF+H2ISIZ+1 / ++++ H2IBUF H2OBUF+H2OSIZ+1 / ++++ H2OBUF LPIBUF+LPISIZ+1 / ++++ /A103 LPIBUF /A103 0 / END OF END PTR PATCHS / / IFZERO .-LPOBUF-LPOSIZ-1&4000 / PATCHZ, / START OF BUFFER AREA TO BE CLEARED /------------------------- PAGE COMINI, XX /A135 / THIS SECTION DETERMINES IF COM IS PRESENT /C104 / AND SETS UP THE CMONLN FLAG /C104 / IF COM IS PRESENT ON A DECMATE-I THEN /C104 / REQUEST TO SEND AND DATA TERMINAL READY ARE ACTIVATED /C104 IFNDEF CONDOR < / -------------------------------------------- /A075 CLA OSR / BIT 11=0 SAYS COMM PRESENT /M021 CMA / MAKE POSITIVE /A036 AND X0001 / MASK OFF ALL BITS EXCEPT COM /A036 DCA CMONLN / SET CMONLN /C104 TAD CMONLN / GET IT BACK TO TEST /C104 SNA CLA / SEE IF COM IS PRESENT /A037 JMP I COMINI / IF NOT RETURN /C135 TAD X0030 / SET REQUEST TO SEND AND TERMINAL READY/A037 WRTP0 / WRITE PORT ZERO CLA RACD / RESET COMMUNICATIONS DEVICE /A037 CLA / /A040 TAD X0030 / SET REQUEST TO SEND AND TERMINAL READY/A040 WRTP1 / FOR PORT 1. /A040 AC4000 /A040 RACD / RESET COMMUNICATIONS DEVICE FOR PORT 1/A040 CLA / CLEAR THIS 4000 OUT! /A107 JMP I COMINI / RETURN /A135 X0001, 1 / X0030, 30 / > / END IFNDEF CONDOR --------------------------------- /A075 IFDEF CONDOR < / ------------------------------------------- /A107 AC0001 / IN DECMATE-II DCA CMONLN / COMMUNICATIONS HARDWARE ALWAYS PRESENT / --------------------------------------------- / | DEVELOPMENT requirements for DECmate II:: | / --------------------------------------------- / / IF the hardware system at boot-up time is a DECmate I / THEN the clock IOT within program location 'XCLKSKP' is o.k. / BUT the comm hardware is disabled cause DM-2 has different IOT's / / IF the hardware system at boot-up time is a DECmate II / Then set a new clock IOT within program 'XCLKSKP' / / (because as of 10-may-82 an RX01 is the only drive on PDP-11/70 'arson') / (available to 'write out' new systems) / AC4000 / (set interupt mode 'NORMAL' if DEcmate I) CLKSET / CMOD / SET clock flag (or if DECmate I then 'CMOD') DM2IOT, CLKSK2 / SKIP / if DEcmate II clock flag=1 (from 'clkset') JMP DM1 / WE ARE RUNNING ON A DECMATE-I / WE ARE RUNNING ON THE DECMATE-II FAMILY / FIRST WE PATCH THE CORRECT CLOCK SKIP IOT CLA / (cause AC=4000) TAD DM2IOT / iot / get the DEcmate II clock 'skip' IOT DCA I (XCLKSKP / and reset program location 'XCLKSKP' /m076 / NOW WE DETERMINE IF WE ARE RUNNING ON A DECMATE II OR III /A147 / TO DO THIS WE EXAMINE A LOCATION IN PANEL MEMORY /A140 / THEN OR ONE OF THE FOLLOWING CONSTANTS INTO RXTYPE /A140 / 0400 DECMATE II /A140 / 2000 DECMATE III /A140 / 1000 DECMATE IV (SHOULD NEVER? HAPPEN) /A147 /At this point RXONLN must have been set; i.e. CONINI called after PT7CRO /A145 PRQ3 /FETCH SYSTEM TYPE (II, IV OR III) /A140 CDFMYF&10+5001 /PANEL FIELD 1 TO MYFLD /A140 0021 /FROM PANEL LOC 0021 /A140 T1 /TO T1 /A140 -1 /1 WORD /A140 -1 /A140 CDFSYS /A147 CLA /A147 TAD T1 /EXAMINE ACTUAL TYPE /A140 SMA /SKIP IF LT 0 (NOT DMII) /A140 JMP DM300 /DONE IF DMII /A140 CLL RTL /LOOK AT BIT1 /A147 SNL /NO LINK IF DMIII /A147 JMP DM200 /A147 HLT /!HALT! /A147 JMP .-1 /NOT DMII OR DMIII /A147 DM200, /A147 AC0002 /DMIII ONLY HAS 2 DRIVES /A145 DCA RXONLN /A145 AC2000 /LOAD CODE FOR DMIII /A147 COMIN1, TAD RXTYPE /OR CODE INTO TYPE SETUP WORD /A140 DCA RXTYPE /A140 JMP I COMINI / RETURN /A135 DM1, CLA /CAUSE AC=4000 /A078 DCA CMONLN /DM-II SOFTWARE ON A DM-I HAS NO COM /A107 DM300, CLA /NEEDED IF ENTER FROM ABOVE /A140 TAD (0400) /LOAD CODE FOR DECMATE-II /A140 JMP COMIN1 /GO OR INTO RXTYPE & EXIT /A140 > / END IFDEF CONDOR ----------------------------------- /A107 /--------------------- PAGE PRQ3=6236 THSFLD=1 CDFMYF=THSFLD^10+CDF CIFMYF=THSFLD^10+CIF FIELD THSFLD / PRINTER FIELD /A138 *PRBOTM / OVERLAY BUFFER AREA /A138 PTC7R0, XX / THIS SUBROUTINE DETERMINES WHAT KINDS OF DISK DEVICES ARE PRESENT / AT BOOT TIME. IT IS ONCE ONLY CODE. IT IS CALLED FROM WPSYS / BUT IS HERE BECAUSE OF WPSYS WRITEOUT SPACE PROBLEMS / IN THE MOVE HERE, ALL FORMER DIRECT REFERENCES TO RXONLN AND /A138 / RXTYPE CHANGED TO I (RX---- INDIRECT REFERENCES. THE ASSUMPTION /A138 / IS MADE THROUGHOUT THIS SUBROUTINE THAT THE DATA FIELD REMAINS AT /A138 / CDFSYS UNLESS THE CODE SPECIFICALLY INDICATES OTHERWISE /A138 / T H E R E F O R E . . . /A138 / THERE SHOULD BE NO OFF PAGE REFERENCES TO VARIABLES IN THESE /A138 / ROUTINES * * * * * * * * * * * * * * * * * * * * * * * * * * * /A138 IFNDEF CONDOR < / --------------------------------------------- /A072 / THIS SUBROUTINE SETS RXONLN TO THE NUMBER OF RX DRIVES WHICH ARE ON / LINE--EITHER 0, 2, OR 4. SINCE WE BOOTED OFF DRIVE 0, THERE /M050 / MUST BE AT LEAST 2 SO WE JUST TEST FOR THE PRESENCE OF 4. /A050 CLA;6750 / SELECT DRIVE 0 (BOOT DRIVE). /A050 6755;NOP / CLEAR DRIVE 0 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 0 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 0 TRANSFER FLAG /A050 CLA / /A050 PTC7R1, TAD (12) / READ DEVICE STATUS (12 BIT MODE). /A050 6751 / ... /A050 6755;JMP .-1 / WAIT FOR DONE (WE BOOTED SO IT MUST /A050 / HAPPEN SOONER OR LATER!!!) /A050 6754 / CHECK ERROR FLAG. SKIP IF ERR FLG SET./A053 JMP PTC7R2 / NO ERROR. READ STATUS BELOW. /A053 CLA / TRY DOUBLE DENSITY READ. /A053 TAD (400) / ... /A053 JMP PTC7R1 / .... /A053 /A053 PTC7R2, 6752 / READ STATUS REGISTER FROM CONTROLLER. /A050 AND (10) / ISOLATE THE RX01(RX8E)/RX02(RX28) BIT./A050 SZA CLA / SKIP IF RX01 (RX8E) /A050 IAC / SET RXTYPE TO 1 FOR RX02(RX28). /A050 DCA I (RXTYPE / .... /A050 / /A050 AC0001 JMS PTC7R3 / SEE IF THE SECOND UNIT IS ON LINE / DONE FLAG WILL BE SET IF IT IS AC0002 / THE FIRST PAIR IS ALWAYS ON LINE 6755 / SKIP IF THE DONE FLAG WAS SET SKP / THE DONE FLAG WASN'T SET AC0004 / THERE ARE TWO PAIRS ON LINE DCA I (RXONLN / SAVE THE VALUE 6755;NOP / CLEAR DRIVE 1 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 1 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 1 TRANSFER FLAG /A050 CLA / SELECT THE FIRST PAIR AGAIN. /A050 JMS PTC7R3 / WILL SET DONE FLAG / /***********THE FOLLOWING IS TEMPORARY**********(BUT IT WORKS)*** / THE FOLLOWING CODE(6757 INITIALIZE) IS HERE BECAUSE IT / APPEARS THAT WHEN THE SELECT CODE IS ISSUED TO A PAIR NOT / CONNECTED SOME UNSPECIFIED RESULTS OCCUR. INIT DOES CLEAR / CLEAR THE PROBLEMS...I AM STILL CHECKING THE WHY'S AND WILL / DELETE THIS CODE WHEN IT IS CLEAR. 6755;NOP / CLEAR DRIVE 0 DONE FLAG /A050 6754;NOP / CLEAR DRIVE 0 ERROR FLAG /A050 6753;NOP / CLEAR DRIVE 0 TRANSFER FLAG /C050 6752 / CLEAR REQUEST /A058 CLA /SET FOR RETURN /A058 6757 /INIT DISK /A058 6755 /DONE? /A058 JMP .-1 /NO. /A058 CDISYS / CHANGE TO SYSTEM FIELD /A138 JMP I PTC7R0 / RETURN / THIS SUBROUTINE CLEARS THE DONE, ERROR, AND TRANSFER FLAGS OF THE RX / UNIT SPECIFIED IN THE AC UPON CALL. IT THEN CAUSES THE DONE FLAG TO / BE SET IF THE UNIT IS ON LINE. PTC7R3, XX 6750 / SELECT THE PROPER UNIT 6755;NOP / CLEAR DONE FLAG 6754;NOP / CLEAR ERROR FLAG 6753;NOP / CLEAR TRANSFER FLAG TAD DELAY DCA T1 / SET DELAY LOOP COUNT / WE NOW DETERMINE WHETHER THE SELECTED UNIT IS ACTUALLY ON LINE. TO DO / THIS, WE ISSUE A READ ERROR CODE FUNCTION (16). IF THE UNIT IS ON / LINE, IT WILL RESPOND BY SETTING THE DONE FLAG. THIS FLAG IS TESTED / TO DETERMINE IF THE UNIT IS ON LINE. TAD (16) / LOAD READ ERROR CODE COMMAND (12 BIT MODE). 6751 ISZ T1 JMP .-1 / WAIT FOR THINGS TO SETTLE DOWN / CAN'T SIMPLY TEST THE FLAG TO TELL IF THE / COMMAND IS THROUGH, SINCE WE DON'T KNOW IF / THERE IS ACTUALLY A UNIT ON LINE. JMP I PTC7R3 / RETURN--THE FLAG IS SET IF THE UNIT IS ON LINE DELAY, -20 / THE DELAY COUNT > / END IFNDEF CONDOR ----------------------------------- /A072 IFDEF CONDOR < / ---------------------------------------------- /A072 / This subroutine sets the contents of RXONLN / to the correct number of RX drives which are on line / (either to 2, 4, 6, or 8) / AND this subroutine sets the contents of RXTYPE / (specifically bits 10 and 11) / (bit 11=1 means drive 0 is an 8 inch diskette) / (bit 10 = 1 means drive 4 is an RX02) / The RX SELect IOT 67x0 (previously documented as a NOP) / AND this subroutine determines the type of APU board / attached, if any / with the contents of the AC (bits 0 and 11) / is used to determine which drive 'pairs' on-line / (NOTE that 'x' means don't care when external RX02 adapter is OUT) /------------------------------------------------------------------------------- / AC bits: RX02 adapter ACTION / (0) (11) (Select an RX50 or RX02 pair) /------------------------------------------------------------------------------- / x 0 out drive pair #1 (drives 0, 1) / x 1 out drive pair #2 (drives 2, 3) /------------------------------------------------------------------------------- / 0 0 in RX50 drive pair #1 (drives 0, 1) / 0 1 in RX50 drive pair #2 (drives 2, 3) / 1 0 in RX02 drive pair #1 (drives 4, 5) / 1 1 in RX02 drive pair #2 (drives 6, 7) /------------------------------------------------------------------------------- / NOTE that since this code is being executed / we must have booted from drive 0 / therefore there is at least 1 drive pair (2 drives) on-line / RX50 or RX02 drive pair #1 (drives 0, 1) must be on-line / (cause we booted up) / THEREFORE issue a 'READ STATUS REGISTER' function code / (to determine the 'size' of the diskette in drive 0) IFDEF WINNIE < DCA I (RXONLN /CLEAR NUM PAIRS ON LINE /A132 JMS WNINIT /INIT WINNIE /A115 JMP PTC7R1 /NOT A WINNIE CONTINUE /A115 /D122 TAD WNOPTN /A115 DCA I (RXTYPE /SET IT /A115 AC0004 /SET # DRIVES=8 /A110 TAD I (RXONLN / #=10 IF 0=WINNIE /A132 DCA I (RXONLN /A110 JMP NORX78 > /END IFDEF WINNIE /A115 PTC7R1, ISZ I (RXONLN / Drive pair (drives 0, 1) must be on-line /C132 PTC7RA, AC0000; 6750 / SEL / firstly, 'select' drive pair 6755; NOP / SDN / (remember that 'SEL' sets done for protocol) JMS P7STAT /GET STATUS***SPACE WARS*** /A132 SZA CLA / skip next if drive 0 is RX50 AC0001 / DCA I (RXTYPE / (bit 11 - 1 means drive 0 is an RX01 or RX02) / POLL RX50 or RX02 drive pair #2 (drives 2, 3) AC0001 / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SZA CLA / Skip next if DONE flag set in "RXPOLL"/a092 JMS RXINIT / INIT / issue INIT cause drive pair NOT on-line ISZ I (RXONLN / +1 / RX50 or RX02 Drive pair (drives 2, 3) on-line /\ jmp .+1 / / CONTINUE polling for RX02 drive pair #1 (drives 4, 5) AC4000 / / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SZA CLA / Skip next if DONE flag set in "RXPOLL"/a092 JMP NORX78 / exit / prepare to exit cause drive pair NOT on-line / A drive pair is selected / BUT it could be drives 0, 1 or drives 4, 5 / (IF the RX02 adapter is 'IN' then drives 4, 5 are on-line) LAS / read the hardware register AND (4) /bit 9 / M140, /A138 SZA CLA / skip next if RX02 adapter is 'IN' (bit 9 = 0) JMP NORX78 / jump cause RX02 adapter is 'OUT' (bit 9 = 1) AC0003 / / (close any holes and make it look like) DCA I (RXONLN / (drives 0, 1, 2, 3, 4, 5 are on-line) / READ the status register / to determine if drive 4 is an RX02 or not JMS P7STAT /GET STATUS***SPACE WARS*** /A132 SNA CLA / skip next if drive 4 is an RX02 JMP POLL67 / jump cause drive 4 is an RX50 TAD T1 / T1 / get back the status AND (10) /bit 8 / CLL RTR /bit 10 / BIT 10 = 1 means RX02; 10 = 0 means RX01 TAD I (RXTYPE / DCA I (RXTYPE / / POLL for RX02 drive pair #2 (drives 6, 7) POLL67, TAD (4001) / JMS RXPOLL / poll / poll the drive pairs defined by AC: 0, 11 SNA CLA / SKIP BUMP OF DRIVE PAIR IF NOT THERE /C138 ISZ I (RXONLN / +1 / RX02 Drive pair #2 (drives 6, 7) is on-line / a 'JMP NORX78' means the RX78 controller was OUT, or / RX02 drive pair #1 (drives 4, 5) is NOT on-line / (therefore an RX02 drive pair #2 (drives 6, 7) can't exist) NORX78, AC0000; JMS RXPOLL / REselect controller of drives 0,1,2,3 /a077 CLA / /a092 JMS RXINIT; NOP / INIT / issue RX INIT to 'clean up' things /A094 TAD I (RXONLN / get the number of 'drive pairs' on-line CLL RAL / x2 / 'times' 2 gets the number of drives on-line DCA I (RXONLN / IFDEF CONDOR < JMS FRMCHK /SET FIRMWARE BIT(40) IN RZTYPE IF WINNIE/A118 JMS APUCHK /CHECK FOR APU BOARD /M138 > /END IFDEF CONDOR /A118 CDISYS / CHANGE TO SYSTEM FIELD /A138 JMP I PTC7R0 / exit / / P7STAT, XX /GET STATUS /A132 TAD (12); 6751 / LCD / 'read status register' function code 6755; JMP .-1 / SDN / (wait for 'done' flag--up to 120ms) 6752 / XDR / 'transfer data register' (gets status into AC) DCA T1 / temp / save the status TAD T1 / AND (140) / 5; 6 / BITS 5&6 both = 1 means RX50 drives TAD M140 / USE A SZA CLA FOR (-140) /C138 JMP I P7STAT /RET WITH ACC=0 IF RX50 DEVICE /A132 / This subroutine is called to select a drive pair as defined / with the contents of AC bits 0 and 11 / IF the drive pair polled is on-line / then the DONE flag will be set / E_X_I_T with the contents of the AC = 0 means the DONE flag was set /a092 / /a092 / E_X_I_T with the contents of the AC = 7777 means the done flag was NOT/a092 / RXPOLL, XX / Enter with the contents of the AC live 6750 / SEL / Issue SELECT DRIVE PAIR iot 6750 / SEL / 2nd time needed for drvs 6&7 /A094 / NOTE: that IOT 6750 does set the DONE flag / BUT this is not the 'done' we want / (CAUSE this 'done' only acknowledges the 'SEL' IOT as to protocol) 6755; NOP / SDN / Skip next if DONE flag is set (then clear) 6754; NOP / SER / Skip next if ERROR flag is set (then clear) 6753; NOP / STR / Skip next if TRANSFER REQ flag set (clear it) TAD (12) / 1010 / Execute 'READ STATUS REG' fc (5) /a092 6751 / LCD / (sets DONE flag if selected pair is on-line) TAD (7600) / delay / /a092 DCA T1 / set delay loop count (to wait for done) RXLOOP, / /a092 ISZ T2; JMP RXLOOP / wait the specified DELAY for done /a075t 6755 / SDN / SKIP next if done flag set /a092 SKP CLA / /a092 JMP I RXPOLL / EXIT / with the (AC) = 0 means DONE FLAG SET /a092 ISZ T1; JMP RXLOOP / wait the specified DELAY for done /a075t AC7777 / -1 / /a092 JMP I RXPOLL / exit / with (AC) = -1 means NO done flag /a092 > / END IFDEF CONDOR ------------------------------------ /A072 / RXINIT IS USED FOR BOTH CONDOR AND NONCONDOR / Subroutine to issue the RX INIT iot / because if a drive pair was polled that was not on-line / the DONE flag will never set RXINIT, XX / 6757 / INIT / issue the RX INIT iot 6755; JMP .-1 / SDN / WAIT for the DONE flag to set ISZ RXINIT / +1 to the EXIT address JMP I RXINIT / exit / IFDEF CONDOR < PCMWT0, XX /A125 PRQ3 /A122 CDFMYF&70%10+4060 /40XY X=OUTPUT FLD Y=INPUT FLD /C138 /D146 FRMTYP /LOC TO GET DATA /A122 PCMWT1, /M146 IDSTRT /LOC TO GET DATA /A122 /C146 PCMSTR /WRITE LOC IN P.M. /A122 /C146 IDSTRT-IDEND /-#CHARS TO MOVE /A122 /C146 -1 /TERMINATOR /A122 /D146 ISZ PCMWT1 /SET TO NEXT LOC /A122 JMP I PCMWT0 /RET /A125 APUCHK, XX / ROUTINE TO CHECK FOR APU BOARD /A138 / ASSUMES LINK IS CLEAR ON ENTRY /A144 LAS / READ SWITCH REGISTER AND (10) / LOOK AT THIS BIT SNA CLA / SKIP IF APU/XPU NOT PRESENT /m144 STL IAC / SET 1 IN AC TO REQUEST SET OF OUTPUT /A144 / DATA AVAIL FLAG IN XPU, LINK WILL BE /A144 / "APU/XPU PRESENT" BIT /A144 6170 / AC=1 , SET "SODAV" FLAG IN XPU /A144 6171 / TEST & CLR " " , SKIP IF SET /A144 CLA / CLEAR THE "XPU" BIT FROM AC /A144 RAL / ROTATE THE "XPU" AND "APU/XPU PRESENT"/A144 / BITS INTO AC10 & AC11 /A144 BSW / AND BYTE SWAP THEM INTO AC4 & AC5 /A144 / (MNRX7X & MNRX6X) /A144 /d144 TAD (MNRX6X) / APU BOARD PRESENT, SET THIS BIT TAD I (RXTYPE / AND UPDATE WORD IN WPSYS DCA I (RXTYPE / JMP I APUCHK / RETURN > / END IFDEF CONDOR /-------------------- PAGE IFDEF CONDOR < /**********FOLLOWING CODE ADDE FOR WINNIE VERSION 115**** / /Setup drive table in DSKACP for winchhester devices / / 4000 = WINNIE DEVICE------4001 = WINNIE DEVICE MOUNTED / RXTYPE----BIT <7> =DRIVE 0 = WINNIE ------------MNRX2X / --BIT <8> =DRIVE 1 = MOUNTED WINNIE-----MNRX3X / --BIT <9> =WINNIE ON LINE --------------MNRX4X GTVOL=12 DMTVOL=10 /DISMOUNT CODE FOR DIRECT CALL /A131 WNINIT, 0 CLA IAC /CHECK FOR WINNIE RDNOOP /IF WINNIE CLEAR AC SZA CLA JMP I WNINIT /RETURN JMS RXPOLL /SEE IF RX50 ON LINE /A132 SNA CLA /0=YES /C158 JMP WNINT2 /RX01,2 ON LINE /A158 JMS RXINIT /CLEAR IF NOT /C158 CLA /SKIPPED /C132 AC4000 /SET TO SEL /A158 JMS RXPOLL /ARE THEY THERE? /A158 SZA CLA /0=YES /A158 JMS RXINIT /CLEAR IF NOT /A132 WNINT2, /A158 ISZ I (RXONLN /INC DRIVE PAIR IF ON LINE(RXINIT SKIPS)/A132 ISZ WNINIT /SET WINNIE RET CDFACP /A131 TAD I (RXSTRT+1) /DRIVE 0 /C132 CDFSYS /A131 SMA CLA /0=RX50 H/O BIT =WINNIE /A131 JMS WININ1 /DISMOUNT 0 FIRST TIME THRU/A131 WINSTF, CAM /IGNORE ERROR CODE(MOUNTED WINNIE CHK /C132 TAD (-GTVOL /GET VOLUME /A131 DCA WINFNC /SET CODE /A131 JMP WINNXT /NEXT /A131 WINGTV, /A131 JMS WININ1 /NEXT /A131 SMA CLA /RETURN... - = ERROR IAC /DRIVE IS MOUNTED TAD (4000 /WINNIE CDFACP /ACP FIELD DCA I T1 /SET IT IN TABLE /C132 CDFSYS /THIS FIELD WINNXT, /A131 ISZ WINCUR /INC DRIVE # ISZ WINNUM /DONE? JMP WINGTV /NO--DO NEXT / SET RXTYPE FOR WINNIE CLA CLL IAC / BIT 1 SET /A132 /MOUNTED BIT CDFACP /ACP FIELD AND I (RXSTRT+1) /POINTER TO SYS DRIVE /C132 CDFSYS DCA FRMTYP /SAVE OPTION BIT FOR DRIVE 0..1=WINNIE /C122 TAD FRMTYP /A132 SZA /IS DRIVE 0=WINNIE /A132 JMP WININ2 /YES...LET DRIVE 1 STAY WINNIE /A132 DCA I (RXONLN /CLEAR COUNT FOR RX50 BOOT /A132 ISZ (RXSTRT+1) /SET POINTER TO DRIVE 1 /C132 CDFACP TAD I (RXSTRT+1) /C132 RAR /BIT 1=MOUNTED IF SET SNL CLA /IS IT MOUNTED? DCA I (RXSTRT+1) /NOT MOUNTED CLEAR WINNIE BIT..VER 1.5 /C132 CDFSYS TAD FRMTYP /GET OPTION /C122 WININ2, /A132 RTL /LINK BIT=DRIVE 1 MOUNTED AS WINNIE IAC /SET FOR WINNIE ON LINE RTL /SET INTO BITS <8,9,10> /D122 DCA WNOPTN /SET IT JMP I WNINIT /RETURN /USED TO DISMOUNT 0 IF RX50 THEN CHECK DEVICES FOR MOUNT/A131 WININ1, XX /DISMOUNT 0 IF RX50 THEN CHECK DEVICES FOR MOUNT/C131 TAD WINCUR /CURRENT DRIVE # TAD (RXSTRT+1) /ADD TO DRIVE 0 PTR /C132 DCA T1 /POINTER TO CURRENT DRIVE IN TBLE /C132 TAD (CIFMYF) /RETURN FIELD /C138 CDFMYF /A138 CIFDSK /DRIVE FIELD JMS I (RXDLDP /DIRECT CALL TO HANDLER WINCUR, WNSTRT /CURRENT DRIVE # 0 /START BLOCK # MUST BE VALID N0 CDFMYF /THIS FIELD WINBUF /BUFFER TO STORE VOL IF READ(24 DEC WRDS) 0 /BLK COUNT 0 /TRACK NO WINFNC, /A131 -DMTVOL /READ VOL FNC CODE IN HNDLER FORMAT CDFSYS /C138 JMP I WININ1 /RET /A131 / /THIS ROUTINE CHECKS FOR WINNIE DEVICE.. IF ON LINE CHECKS FIRMWARE TYPE /SETS BIT (6)--[40] IF WINNIE FIRMWARE-THIS TO ALLOW RETURN TO MASTER MENU / FRMCHK, XX /A118 TAD I (RXTYPE /A118 RAR /L/O BIT =RX01/02 =SYSTEM /A118 SZL CLA /A118 JMP I FRMCHK /IGNORE /A118 SETPRQ, /BOOT WINNIE OR RX50D /A118 PRQ3 /GET FIRMWARE STATUS WORD /A118 CDFMYF&70+5001 /50XY X=RECEIVING FIELD IN MAIN MEMORY /C138 / Y=SOURCE FIELD IN PANEL MEMORY /C138 0 /ADDRESS IN P. MEM /A118 FRMTYP /ADDRESS TO STORE.FIRMWARE TYPE /A118 -1 /# WORDS TO GET /A118 -1 /TERMINATOR /A118 CLA IAC /1 /A118 /C121 TAD FRMTYP /TYPE 0=RX50 -1=WINNIE /A118 SZA CLA /IS WINNIE FIRMWARE? /A118/C0121/C122 JMP I FRMCHK /NO, RETURN /C138 JMS FRMCHL /CHECK IF BOOT FROM MASTER MENU /A141 TAD (MNRX5X /SET WINNIE FIRMWARE BIT FOR WINNIE BOOT/A141 TAD I (RXTYPE /ADD OPTION BITS /A118 DCA I (RXTYPE /SET IT /A118 /D138 APUCHK MADE SEPARATE ROUTINE AGAIN /A138 JMP I FRMCHK /RETURN /A118 FRMTYP, 0 /A118 /M130 /LOAD PANEL MEMORY TO USER MEMORY / PCMRD0, 0 /ROUTINE TO GET CHAR FROM P.M. /A122 PRQ3 /A122 CDFMYF&70+5006 /50XY X=OUTPUT FIELD Y=INPUT FIELD /A122 /C138 PCMRD3, PCMSTR /READ DATE LOC IN P.M. /C141 IDSTRT /LOC TO PUT DATA /A122 /C146 IDSTRT-IDEND /-#CHARS TO MOVE /A122 /C146 -1 /TERMINATOR /A122 /D146 ISZ PCMRD3 /SET TO NEXT LOC /A122 /D146 TAD FRMTYP /A122 JMP I PCMRD0 /A122 WINMAX=10 /MAX NUM DRIVES=8 WNSTRT=0 /START WINNIE DRIVE NUMBER WINNUM, WNSTRT-WINMAX /NUMBER DEVICES TO CHECK PAGE /A141 > /END IFDEF CONDOR /A118 / ****** DECmate I code moved here for space reasons ******* /A130 / CONDOR does not have enough space here for /A130 / them both to assemble here /A130 IFNDEF CONDOR < /A130 /READ CHAR FROM PANEL MEM.... /....THIS ROUTINE IS SET AT LOAD TIME... IS EXECUTED DURING START UP /.....WHEN FIRST END OF BUFFER IS READ(NULL) CALL TO ROUTINE WILL BE NOOPED / PCMADR=7732 /ADDRESS OF P.M. DATE /A122 PCMSTR=7600 /START OF PANEL MEM DATA /A122 PCMCMD=PCMSTR+10 /ADDRESS OF P.M.CMND STR /A122 PCMRD, 0 /A122 CLA /A129 PRQ3 /A122 CDFMYF&70+5006 /50XY X=OUTPUT FIELD Y=INPUT FIELD /A122 /C138 PCMRD1, PCMSTR / LOCATION IN INPUT FIELD TO BE READ /A122 /C126 PCMRD2 / LOCATION TO PUT RESULTS /A122 -1 /- NO CHARS TO BE READ /A122 -1 /TERMINATOR /A122 TAD PCMRD2 /GET CHAR /A122 SZA /END OF BUFFER /A122 /C125 JMP I PCMRD /A122 ISZ PCMRD /YES /A122 /M125 CDFMYF /A138 CIFSYS /A138 TTYIN /IGNORE POWER FAIL STRTUP /A125 NOP /A125 CLA /A125 CDFSYS /A138 JMP I PCMRD /RET /A125 PCMRD2, 0 /CHAR JUST READ /A122 > /END IFNDEF CONDOR /A130 / ******* End of MOVE of non-CONDOR code edit 130 ******** /A130 IFDEF CONDOR < /A138 /D146 PCMSET, XX /A122 /D146 CLA IAC /SET UP BUFFER FOR POWER FAIL CHK(USED TO INIT SYSTEM /A125 /D146 CDFMYF / /A141 /D146 DCA FRMTYP /A125 /D146 CDFSYS / /A141 /D146 PCMSTA, JMS PCMRD0 /READ 1 CHAR FROM P.M. /A122 /D146 SNA CLA /END OF DATE? /A122 /D146 JMP I PCMSET /YES /A122 /C126 /D146 JMS PCMWT0 /MOVE TO P.M. /A125 /D146 JMP PCMSTA /NEXT /A122 FRMCHL, 0 /A141 JMS PCMRD0 /M146 FRMCHM, /NEXT /A141 /M146 CDFMYF / /A141 TAD I CMDPTR /POINTER TO COMMAND LIST /A141 TAD I IDPNTR /TO START OF STRING /A146 CDFSYS / /A141 SZA CLA /IS IN STRING? /A141 JMP FRMCHX /NOT CALLED FROM MASTER MENU(WPS-cmd) /A141 /.......DO NOT GET DATE/COMMAND STRING /A141 ISZ IDPNTR /INC PNTR /A146 ISZ CMDPTR /NEXT LETTER /A141 ISZ CMDCNT /COMMAND LENGTH COUNTER(-7 IF WHOLE CMND)/A141 JMP FRMCHM /LOOP-NEXT CHAR /A141 /D146 TAD (PCMADR /LOAD DATE ADDRESS /A141 /D146 CDFMYF / /A141 /D146 DCA PCMRD3 /SET IT /A141 /D146 CDFSYS / /A141 TAD (PCMRDJ) /JMS TO PCMREAD /A122 DCA U1XLAA /SET IT UP /A122 /D146 JMS PCMSET /MOVE DATE IN P.M. /A122 JMS SETDAT /MOVE AND SET DATE AND TIME /A146 FRMCHX, JMP I FRMCHL /RETURN /A141 / SETDAT, 0 /MOVE TIME AND DATE INTO STRING AND WRITE TO P.M. /A146 CDFMYF /A146 TAD (-7531 /SIGNATURE=VER 2 MENU /A146 TAD IDSIGN /GET SIGNATURE THIS SYSTEM /A146 SZA CLA /IS THIS OLDER VERSION MASTER MENU /A146 JMP SETD0 /NO-- /A146 TAD (PRESTR /SET WRITE OUT ADDRESS /A146 DCA PCMWT1 /A146 TAD (PRESTR-IDSTRT /NO SET UP TO STORE DATE AND TIME /A146 SETD0, /A146 TAD (IDSTRT-1 /OR SET TO MOVE DATE ONLY /A146 DCA X4 /A146 TAD (IDDATE-1 /TIME ADDRESS /A146 DCA X3 /A146 SETD1, TAD I X3 /A146 SNA /END DATE STRING /A146 JMP SETD2 /YES /A146 DCA I X4 /SET IT /A146 JMP SETD1 /NEXT /A146 SETD2, TAD (" &377 /SPACE /A146 DCA I X4 /A146 TAD (-7531 /IS TIME IN HTIS VERSION /A146 TAD IDSIGN /GET SIGNATURE /A146 SZA CLA /IS TIME AVAILABLE /A146 JMP SETD4 /NO /A146 TAD (IDTOFD-1 /TIME OF DAY /A146 DCA X3 /INPUT POINTER /A146 SETD3, TAD I X3 /MOVE TIME /A146 DCA I X4 /A146 ISZ IDCNT /DONE MOVING HH:MM /A146 JMP SETD3 /NO /A146 TAD (15 /C.R. FORCE DATE TIME /A146 DCA I X4 /SET IT /A146 SETD4, /A146 JMS PCMWT0 /WRITE IT BACK TO PANEL MEMORY /A146 CDFSYS /A146 JMP I SETDAT /A146 / IDCNT, -5 /COUNT HH:DD /A146 CMDCNT, CMDLST-CMDLSE /-7 WOULD CHECK (WPS-cmd) -3 CHECKS(WPS)/A141 IDPNTR, IDSTRT /START OF STRING /A146 CMDPTR, CMDLST /PTR TO COMMAND LIST /A141 CMDLST, -"W+200 / /A141 -"P+200 /A141 -"S+200 /A141 -"_+200 /A141 -"c+200 /A141 -"m+200 /A141 -"d+200 /A141 CMDLSE=. /END LIST ENTRY /A141 /----------------------- PAGE *PTC7R0-200 /ADDRESS OF BUFFER IN THIS FIELD /C146 WINBUF, / OF 24 DECIMAL LOCS FOR VOLUME DATA /C146 PRESTR, ZBLOCK 6 /NEW START LOC /A146 IDSTRT, ZBLOCK 7 /LOC 0-6 /WPS-CMD /A146 NULL1, 0 /LOC 7 /TERMINATOR /A146 BINLEN, 0 /LOC 8 /LENGTH OF COMMAND SRTING /A146 CMNDTXT,ZBLOCK 120 /LOC 9-88 /COMMAND STRING /A146 NULL2, 0 /LOC 88 /CMND STRING TERMINATOR /A146 IDDATE, ZBLOCK 10 /LOC 90-97 /DATE MM/DD/YY(ALWAYS) /A146 NULL3, 0 /LOC 98 /DATE TERMINATOR /A146 IDSIGN, 0 /LOC 99 /SIGNATURE /A146 IDVERS, 0 /LOC 100 /MASTER MENU VERSION NUM/A146 IDDOFW, ZBLOCK 11 /LOC 101-109 /DAY OF WEEK(SUNDAY-SATURDAY) /A146 NULL4, 0 /LOC 110 /TERMINATOR /A146 IDTOFD, ZBLOCK 10 /LOC 111-118 /TIME OF DAY HH:MM:SS /A146 IDLWCLK, 0 /LOC 119 /CLOCK LOW /A146 IDHICLK, 0 /LOC 120 /CLOCK HIGH /A146 IDDFMT, 0 /LOC 121 /DATE FORMAT 0=INVALID /A146 / 1=MM/DD/YY /A146 / 2=YY/MM/DD /A146 / 3=DD/MM/YY /A146 IDEND=. /END OF STRING /A146 > / END IFDEF CONDOR /A138 / WPFILS -- FILE I-O ROUTINES / / 048 MART 30-APRL-85 ADDED FIELD 7 BLASTR HOOK / / --------- Following edits V2.0 and earlier / / 047 WCE 25-MAY-84 Removed old STATLN definitions / 046 WCE 23-JAN-84 Move RPTEM1 to page where used / 045 WJY 17-NOV-83 Read first header block back into core / after getting all the extensions. / 044 WJY 29-OCT-83 Added logic to check if the correct / header block is already in core before / requesting it to be read from disk. / This request occurs in a RESTORE FILE / POINTERS call and caused problems for / GOTO-RULER. / 043 WCE 31-AUG-83 Add conditionals for status line in the / editor to only get one block when / needed so that block count will go up / by one instead of three so that users / will not complain about counting. / 042 DMB 29-AUG-83 Added function calls for GOTO-RULER / (also useful for GOTO-PAGE) / 041 WCE 19-JUL-83 Modify symbol names for new prefix file / 040 EH 06-JUL-83 Ignore GTP extensions on read only file / 039 WCE 11-MAY-83 Make OPEN for OVERWRITE free up space / 038 EH 18-JAN-83 Clear RPSPLT between each block / 037 EH 16-DEC-82 Clear RPMODE prior to building desc. / word if writing thru ETX buffer / 036 GJP/EH 09-DEC-82 Set hdr ptr to 1 on read-file re-init. / 035 WJD 09-DEC-82 remove 034 attempt at power-lost fixes / code was altogether deleted / 034 WJD 19-NOV-82 1200 baud & power-lost fixes / 033 WJD 19-NOV-82 Writeout alloc. block during close / for SORT bugfix / 032 EH 30-JUL-82 Modify parallel GTP structure / 031 EH 24-JUN-82 Write alloc. blk. after alloc. req. / 030 WJD/EH 30-MAR-82 Process print controls / 029 WJD 23-MAR-82 G-T-P link verification / 028 GDH 18-MAR-82 "SQUISHED TEXT" bug & general cleanup. / 027 EH 16-MAR-82 Fix uppercase bug / 026 EH 22-FEB-82 OH-015 PUT page counters fix. See also / WPEDIT '144'. (DM-387) / 025 WJD 15-FEB-82 DM-316 (GOTO PAGE rel.) / 024 WJD 10-FEB-82 Extn. blks. erroneously deallocated during OPEN / 023 WJD 08-FEB-82 GOTO-PAGE header deallocation / 022 GJP 04-FEB-82 Correct header deallocation problem / 021 EH 27-JAN-82 Correct mode in descriptor word / 020 EH 27-JAN-82 Fix relative paging around end of ext. / 019 WJD 15-JAN-82 OPEN was corrupting descriptor block / 018 WJD 07-JAN-82 STX/ETX buffer page-counters installed for REL GOTO PAGE / 017 EH 31-DEC-81 Save mode when writing through STX / Fixed problem assoc.with backup through / hdr blocks ptrs. / 016 WJD 21-DEC-81 REMOVED GOTO PAGE MATH RECOGNTION / 015 GJP 15-DEC-81 WPFILS BUG DEALOCATING ASSIGNED BLOCKS / 014 WJD 14-DEC-81 GOTO structure support of >2 extensions / 013 EH/WJD 14-DEC-81 Inform editor of new block just read into ETX buffer / 012 EH 11-DEC-81 Save mode of first char. in a block / 0011 GDH/DFB 09-DEC-81 Fix to initialize block pntr(go to page) / 010 JRF 08-DEC-81 Removed temporary CMD 9 equate in / ESCTAB table. / 009 WJD 04-DEC-81 Support offset PAGE positioning / 008 WJD 03-DEC-81 Fix GOTO PAGE extension blocks problem / 007 JRF 23-NOV-81 Modify ESCTAB and SPCTAB tables for / handling of MATH area start and / end characters. / 0006 GDH 12-NOV-81 Bug fix to TBO overwrite 0 length files. / 0004 GDH 2-OCT-81 RPG to ignore GET DENSITY function. / 002 WJD 25-OCT-81 Added V2 GOTO PAGE support routines / 0001 GDH 26-AUG-81 Moved WPFILS to field 7. / X3.5 JLZ 26-JUN-80 MODIFIED PRINTER'S FILE READER TO / SUPPORT ENHANCED HEADERS/FOOTERS / TT 07-JUL-81 Removed superfluous conditionals / III.B MB 1-APR-78 PUT IN SYSTEM OPTIONS / III-1 KEE 2/27/78 ADD WT'S 'TD' COMMAND / 2.7A-1 LDB 1/6/78 MODIFY FOR WT-78 7-BIT / 2.5-1 LDB 11/11/77 MAKE IT HARDER TO CLOSE UNOPENED FILES / 2.4D+ RTL 10/17/77 FILE SIZE BUG IN ALOC / 2.Q-1 RLT 9/24/77 BUG IN R2OPEN FOR WT78 / 2.P LDB 9/19/77 PUT IN SIXBIT CALLS FOR MAIN'S VERIFY / 2.N RLT 9/14/77 ADD UDKPRT STUFF / 2.J KEE 8/26/77 ADD 4-FLOPPY SUPPORT / 2.G-1 MSB 8/9/77 GET IT FROM THE 78 PACK / / USE "PAL WPFILS PTR. TO ETX OR STX MODE WORD ISZ GETMOD MQA SMA SZA / ++++ JMP GETMD1 / NORMAL ASCII SNA / ++++ JMP I GETMOD IAC SNA / ++++ ISZ T1 / ADJUST T1 IF SHIFT-UNSHIFT CHANGE TAD (MODTAB) / ++++ DCA T2 / GET PTR TAD I T2 SPA / ++++ JMP I GETMOD / RETURN QUICK IF ERROR CMA AND I T1 SNL / ++++ TAD I T2 DCA I T1 / SET NEW MODE JMP I GETMOD GETMD1, TAD I T1 / ADD MODE FLAGS ISZ T1 /BUMP TO SHIFT MODE SZL / ++++ TAD I T1 / AND UNSHIFT /PAGE-MARKERS LEAVING SCROLL BUFFER(GET) GOING INTO THE EDIT BUFFER /A018 DCA T2 /SAVE THE CURRENT 12-BIT CHAR. /A018 TAD T2 /REFRESH THE AC /A018 TAD NWPAGE / IS IT A NEW-PAGE MARKER? /M032 SZA / SKIP IF: NEW-PAGE MARKER /M032 TAD PAGEMK / IS IT A PAGE-MARKER? /M032 SZA CLA / SKIP IF: PAGE-MARKER /A018 JMP RPCTEX / JUMP IF: NEITHER /A018 ISZ T1 / BUMP TO APPRO. PAGE-COUNTER /A018 AC7777 / PAGE-MARKER LEAVING SCROLL BUFFER /A018 TAD I T1 / DECR. PAGE-COUNTER ACCORDINGLY /A018 DCA I T1 / UPDATE THE PAGE-COUNTER /A018 RPCTEX, TAD T2 / RETURN THE CURRENT 12-BIT CHAR. /A018 JMP I GETMOD -1 / ERROR 2000 1400 1000 400 200 MODTAB=. 40 /--------------- PAGE PUTSTX, XX / PUT 12-BIT TO STX /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 /Save the current 12-bit char. going into either the ETX or /M039 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 NXTSTX, JMS SAVSTX / SAVE THE CURRENT STX MODE. /A028 JMS PUTMOD / ++++ STXMOD JMS XLTCOS DCA STXSV1 /PASS THE CHAR. /A002 JMS PUTSTC TAD CHRHLD / RESCAN OR DONE (0) SZA / SKIP IF BOTH BYTES DONE JMP NXTSTX /DO LAST BYTE OF WORD /A026 JMP I PUTSTX CUR12BIT, 0 /CURRENT "12-BIT" CHAR. /A026 PUTETX, XX / PUT 12-BIT TO ETX /D039 JMS RPSAV12 /GO SAVE CURRENT 12 BIT CHAR. /A026 /Save the current 12-bit char. going into either the ETX or /M039 /STX scroll buffer for later (PUTBYT) PAGE-MARK counting... /M039 DCA CUR12BIT /MAKE A COPY OF 12-BIT CHAR. /M039 TAD CUR12BIT /TO BE USED AFTER XLATION /M039 /SECONDARY ENTRY FOR NEXT BYTE /A026 NXTETX, JMS SAVETX / SAVE CURRENT ETX MODE SETTINGS. /A028 JMS PUTMOD / ++++ ETXMOD CML / ++++ JMS XLTCOS DCA STXSV1 /PASS THE CHAR. /A002 JMS PUTETC TAD CHRHLD / ++++ SZA / ++++ JMP NXTETX /DO LAST BYTE OF WORD /A026 JMP I PUTETX PUTMOD, XX / CHECK FOR MODE CHANGES MQL / CURRENT 12-BIT CHAR. INTO MQ MQA / BACK INTO AC DCA CHRHLD / SAVE FOR RESCAN TAD I PUTMOD / ADDR. OF CURRENT MODE WORD DCA T1 / T1 = PTR TO MODE WORD ISZ PUTMOD /BUMP TO RETURN ADDR MQA / AC = CURRENT 12 BIT CHAR AND (3600) / ISOLATE MODE BITS CIA / ++++ TAD I T1 / CHECK FOR ANY CHANGES SNA / SKIP IF MODE CHANGE JMP PUTMD1 / IF NONE, CHECK CASE DCA T2 / SAVE DIFFERENCE TAD (MSKTAB-1) / ++++ DCA T3 / GET SEARCH PTR TAD T2 / ++++ BSW / GET DIFFERENCE RTR / ++++ ISZ T3 / ++++ SMA SNL / ++++ JMP .-3 / FIND FIRST CHANGE CLA CLL CML TAD I T1 / ++++ AND I T3 / NEED TO CLEAR MODE? SZA / ++++ JMP PUTMD2 / JUMP IF SO MQA / ++++ AND I T3 / MUST NEED TO SET, THEN CML PUTMD2, MQL / ++++ MQA CMA / ++++ AND I T1 / ++++ SNL / ++++ MQA / SET-CLEAR DCA I T1 / STORE NEW MODE TAD (TAB-1) / ++++ DCA X1 / GET TAB PTR MQA TAD I X1 / ++++ SZA / ++++ JMP .-2 / FIND CHANGE PATTERN TAD X1 / ++++ TAD (-TABND-1) / COMPTE CHANGE NUMBER JMP I PUTMOD PUTMD1, MQA / ++++ AND P100 SNA CLA / ++++ JMP PUTMD3 / JUMP IF NOT ALPHA ISZ T1 / GET PTR TO UNSHIFT CODE MQA / ++++ AND (40) / GET UNSHIFT BIT CIA / ++++ TAD I T1 / COMPARE WITH STORED VAL CLL SNA CLA / ++++ JMP PUTMD4 / JUMP IF SAME MQA / ++++ AND (40) / GET NEW BIT SZA / ++++ CML / SET LINK ACCORDINGLY DCA I T1 / STORE NEW BIT CMA / RETURN -1 CODE JMP I PUTMOD PUTMD3, CLL CML PUTMD4, DCA CHRHLD / ++++ MQA / CLEAR RESCAN, RETURN CHAR JMP I PUTMOD CHRHLD, .-. TAB, -2000 2000-1400 1400-1000 1000-400 400-200 TABND=. MSKTAB, 200 1400 2000 RDINI2, XX BSW / ++++ RTR AND T17 / ISOLATE AND SAVE DRIVE NUMBER DCA RDFQBK+RXQDRV TAD (CDFBUF) / get cdf to buffer field. /A028 DCA RDFQBK+RXQBFD / AND BUFFER FIELD JMP I RDINI2 /--------------- PAGE XLTCOS, XX SPA / ++++ JMP XLTCO1 / JUMP IF MODE CHANGE AND P177 TAD M100 / CHECK ALPHA SMA / ++++ JMP XLTCO2 / JUMP IF ALPHA TAD (100-37) / ADJUST FOR COS SZA SMA / ++++ JMP I XLTCOS / RETURN IF OK TAD (37-17) / ++++ SMA SZA / ++++ JMP XLTCO3 / JUMP IF ILLEGAL TAD (17-7) / ++++ /D002/A016 SPA / ++++ JMP XLTCO3 TAD (SPCTAB) / ELSE GET XLAT PTR JMP XLTCO4 / AND XLATE XLTCO3, CLA JMP I XLTCOS XLTCO1, CMA RAL TAD (-MAXCOS) / ++++ SMA / ++++ CLA TAD (MAXCOS+COSTAB) XLTCO4, DCA T1 / CONVERT TO PTR TAD I T1 JMP I XLTCOS XLTCO2, AND (37) / ++++ TAD (-33) SMA / ++++ TAD (7722-133+37) / XLAT RESERVED CHARS TAD (133-37) / ADJUST JMP I XLTCOS / make sure that there is room in this block for a 2-char. / ESC seq; it is no longer acceptable to split an ESC seq. / between 2 blocks because of the random access used by V2 / GOTO PAGE. / if this is an ESC seq. and there is only 1 byte available in / the text buffer, send a null to fill up the buffer and cause / a write to disk. then put the 2-char. ESC seq. in the next / block. in this way, GOTO PAGE will never access a block con- / taining 1/2 of an ESC seq. PUTETC, XX /ENTER W/CHAR. IN STXSV1 TAD SCEPTR /GET THE ETX-BUFFER-CHAR. PTR. /A002 SZA CLA /SKIP IF THIS WILL BE THE LAST BYTE /A002 JMP RPETCX /ROOM FOR 2-CHAR. ESC SEQ. /A002 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 AND P7700 /GET SET FOR /A002 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 SNA CLA /SKIP IF NOT ESC SEQ /M007 JMS PUTET1 /GO SEND NULL AS LAST BYTE /A002 RPETCX, /A002 JMS SAVETX / SET EXTSAV TO CURRENT MODE SETTINGS. /A028 TAD STXSV1 AND P77 / ++++ SZA / ++++ JMS PUTET1 TAD STXSV1 / ++++ BSW / ++++ AND P77 / ++++ SZA / ++++ JMS PUTET1 JMP I PUTETC PUTSTC, XX /ENTER W/CHAR. IN STXSV1 TAD STXSAV / ++++ SZA / ++++ JMS PUTST1 / same 2-char. ESC seq. check done here... AC0001 /AC => 1 /A002 TAD SCTPTR /ADVANCE STX BUFFER CHAR. POINTER /A002 TAD (-SCHCNT /COMPARE TO MAX. # OF BYTES /A002 SZA CLA /SKIP IF THIS CHAR. WILL FILL BUFFER /A002 JMP RPSTCX /ROOM FOR A 2-CHAR. ESC SEQ. /A002 TAD STXSV1 /GET THE CURRENT 12-BIT WORD /A002 AND P7700 /GET SET FOR /A002 TAD M7700 /COMPARE TO ESC SEQ. CHAR. /A002 SNA CLA /SKIP IF NOT ESC SEQ /M007 JMS PUTST1 /GO SEND NULL AS LAST BYTE /A002 RPSTCX, TAD STXSV1 /A002 BSW / ++++ AND P77 / ++++ SZA / ++++ JMS PUTST1 TAD STXSV1 / ++++ AND P77 / ++++ DCA STXSAV JMP I PUTSTC GETETC, XX JMS GETET1 TAD (-77) / ++++ SZA / ++++ JMP GETETA JMS GETET1 TAD P7700 SKP GETETA, TAD P77 JMP I GETETC GETSTC, XX TAD STXSAV / ++++ SNA / ++++ JMS GETST1 DCA STXSV1 JMS GETST1 TAD (-77) / ++++ SNA / ++++ JMP GETSA1 TAD P77 / ++++ DCA STXSAV JMP GETSA2 GETSA1, DCA STXSAV TAD P7700 GETSA2, TAD STXSV1 JMP I GETSTC STXSAV, 0 STXSV1, .-. STXMOD, 0 / STX MODES 0 /SHIFT FLAG 0 /STX BUFFER PAGE-COUNTER /A018 STXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 /OUT THROUGH STX BUFFER /A030 /--------------- PAGE / SCINI - INIT FOR FILENO IN AC SCHCNT=774 / #CHARS IN DATA BLOCK / 774 = 508 DEC. / DECIMAL: 254 12-BIT CHARS = 508 6-BIT CHARS. BOFSET= 2 / OFFSET TO FIRST CHAR. WORD IN BLOCK SCBKOF=52 / OFFSET TO BLOCK PTRS IN 1ST HEADER SCINI, XX DCA T1 TAD T1 AND P377 / ISOLATE DOCUMENT NUMBER DCA SCQBLK+RXQFNO / STORE FILE # TAD T1 BSW / ++++ RTR / POSITION DRIVE NUMBER AND T17 /(17) GETS DRIVE FLAGS /M025 DCA SCQBLK+RXQDRV / SET DRIVE FLAGS JMS SCQRX / GO GET DENSITY TO ESTAB DENSITY OF DRIVE RXEDN+4000 0 JMS SCQRX RXEGF / ++++ 0 TAD SCQBLK+RXQBLK / PICK UP BLOCK NUMBER SNA / ++++ JMP SCIER1 / WE DID GET ONE? DCA SCHDRB / SAVE AS HEADER BLOCK NUMBER TAD (SCHDRB) / ++++ DCA SCHDBN / READ FIRST HEADER JMS SCGTWR CDFBUF / GET FILE SIZE TAD I (SCHDR+5) DCA SCFILZ TAD SCFILZ / ++++ TAD M310 /GREATER THAN 210 PTRS.? /A025 SMA CLA / ++++ TAD I (SCHDR+2) CDFMYF DCA SCHDRB+1 CDFBUF TAD I (SCHDR+3) CDFMYF DCA SCHDRB+2 JMS SCFLZB / GO SET UP TOP AND BOTTOM POINTERS /A003 CDFBUF TAD I (SCHDR+1) MQL / ++++ AC2000 / ++++ MQA / OPEN FOR UPDATE DCA I (SCHDR+1) AC0001 TAD I (SCHDR+12) / INCR TIME EDITED SMA / ++++ DCA I (SCHDR+12) / DON'T INCR PAST 2047 CLA DCA I (SCHDR+SCBKOF+2) / CLEAR "DATA BLK 0" PTR CDFMYF AC0001 / ++++ JMS SCGTWR / WRITE OUT HEADER JMS GTHDRS / GO GET HEADER EXTENSIONS INTO MEMEORY /A003 SCBFCB / POINT TO THE HDR CONTROL BLOCK /A003 JMP SCINX / TAKE OK RETURN SCIER1, IAC SCINX, JMP I SCINI / DONE / SCWEB - WRITE END BLOCK SCWEB, 0 JMS SCTPBT / GO SEE IF BOTTOM = TOP +1 /A003 JMS SCALOC / YES - ALLOCATE A BLOCK BETWEEN THEM JMS SCBUFI / GO INITIATE BUFFER AREA FOR COS 310 COMPATIBILITY SCEB / INIT BUF HDR FOR COS JMS SCBOTP / GO DECREMENT BOTTOM /A003 -1 / BY 1 /A003 JMS SCGETR / GET BLOCK NUMBER SCBOT - 1 POINTS TO SCBTH / BOTTOM HEADER POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 JMS SCQRX / WRITE END BUFFER TO THAT BLOCK RXEWT+2000 / ++++ SCEB CLA / MAKE SURE OF CLEAR AC /A037 DCA RPMODE / CLEAR MODE WORD /A037 JMS TORPDSBD / WRITE GTP TEXT BLK /A032 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 JMP I SCWEB / RETURN / SCWTB - WRITE TOP BLOCK SCWTB, 0 JMS SCTPBT / CHECK IF A BLOCK IS 'TWEEN TOP AND BOTTOM/A003 JMS SCALOC / NO - SO ALLOC ONE TO GO THERE JMS SCBUFI / GO INIT BUFFER AREA FOR COS 310 COMPATIBILITY SCTB / INIT BUF HDR FOR COS JMS SCTOPP / GO INCREMENT TOP POINTERS /A003 1 / UP BY 1 /A003 JMS SCGETR / GET THAT BLOCKNO SCTPH / TOP HEADER POINTER /A003 SCTOP / TOP HEADER WORD POINTER /A003 JMS SCQRX / WRITE TOP BUFFER THERE RXEWT+2000 / ++++ SCTB JMS TORPDSBD / WRITE GTP TEXT BLK /A032 DCA PAGLIM / CLEAR PAGE LIMIT FLAG /A032 JMP I SCWTB / DONE SCBUFI, XX / INTIALIZE 1ST TWO WORDS IN BUFFER /A003 AC7777 / MINUS 1 TO AC /A003 TAD I SCBUFI / GET BUFFER ADDRESS - 1 (FOR INDEXING) /A003 DCA X0 / PUT ADDRESS INTO AUTO INDEXING AREA /A003 TAD (COSCNT) / GET COS COMPATIBLE CHARACTER /A003 CDFBUF / CHANGE TO BUFFER FIELD /A003 DCA I X0 / STUFF COS 310 STUFF IN BUFFER /A003 DCA I X0 / ZERO SECOND BYTE OF BUFFER /A003 CDFMYF / BACK TO THIS FIELD /A003 ISZ SCBUFI / BUMP UP TO RETURN /A003 JMP I SCBUFI / RETURN /A003 /--------------- PAGE /D047 IFNDEF STATLN < /A043 /D047 / SCALOC - ALLOCATE 3 BLOCKS BETWEEN TOP AND BOTTOM /D047 SCALOC, XX /D047 AC7775 / GET MINUS THREE FOR LOOP CONTROL /D047 DCA SCALCT / SET TO ALLOC 3 /D047 > / END IFNDEF STATLN /A043 /D047 IFDEF STATLN < /A043 / SCALOC - ALLOCATE 1 BLOCK BETWEEN TOP AND BOTTOM /A043 SCALOC, XX /A043 AC7777 / GET MINUS ONE FOR LOOP CONTROL /A043 DCA SCALCT / SET TO ALLOC 1 /A043 /D047 > / END IFDEF STATLN /A043 TAD SCBTH / GET BOTTOM HEADER POINTER /A003 DCA SCBTHS / SAVE BOTTOM HEADER POINTER /A003 TAD SCBOT / GET BOTTOM /A003 DCA SCBOTS / SAVE BOTTOM HEADER WORD POINTER /A003 DCA SCALC / INIT COUNT /A003 JMP SCALCD / GO INCREMENT AND GET BLOCK NBR /A003 SCALC1, JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1 / BY ONE /A003 SCALCD, ISZ SCALC / INREMENT THE COUNTER /A003 JMS SCGETR / GET BLOCK NUMBER SCBTH SCBOT SZA CLA / IS IT END OF FILE? JMP SCALC1 / NO - LOOK AT NEXT ONE TAD SCALC / GET COUNT OF HOW MANY BLOCKS 'TILL END CIA / MAKE NEGATIVE FOR ISZ LOOP DCA SCALC / SAVE /D047 IFDEF STATLN < /A043 AC0001 / SET UP TO BUMP FILE BY ONE BLOCK /A043 /D047 > / END IFDEF STATLN /A043 /D047 IFNDEF STATLN < /A043 /D047 AC0003 / SET UP TO BUMP FILE BY THREE BLOCKS /D047 > / END IFNDEF STATLN /A043 TAD SCFILZ / COMPUTE NEW FILE SIZE DCA SCFILZ JMS SCALC2 / GO MOVE TAIL END OF FILE 1 BLOCKS OVER/M047 TAD SCBTHS / GET BOTTOM HDR PTR UPON ENTRY /A003 DCA SCBTH / PUT IT BACK INTO BOT HDR PTR /A003 TAD SCBOTS / GET BOTTOM HDR WORD PTR /A003 DCA SCBOT / BACK INTO BOT HDR WORD PTR /A003 SCALC3, JMS RPALLOCATE / SUBROUTINE TO ALOC A BLOCK /A030 JMS SCPUTR / SAVE IN B SCBTH / BOTOM HDR POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 JMS SCBOTP / INCR BOTTOM 1 / BY 1 /A003 ISZ SCALCT / ++++ JMP SCALC3 / LOOP FOR ALL JMP I SCALOC / DONE SCBTHS, 0 / TO SAVE HEADER POINTER /A003 SCBOTS, 0 / TO SAVE HEADER WORD POINTER /A003 SCALC, 0 SCALB, 0 SCALCT, .-. DSKINI, 0 / DSKINI - TOP LEVEL INIT ROUTINE - FILENO IN AC DCA SCOPTN DCA RPMODE /GOTO-PAGE-BUILT TEXT BLOCK MODE /M019 JMS CLPTRS /CLEAR BOTH HDR-BLK-PTR TABLES /A024 MQA JMS SCINI / DO INIT OF HDR BLOCK SZA / ++++ JMP DSKIN1 / JUMP IF ERROR DCA SCTPTR TAD (SCHCNT-1) DCA SCEPTR JMS SCQRX / GET # FREE BLOCKS RXESP / ++++ SCHDR JMS SCSPC / PUT IN HDR FOR CALLER DCA STXSAV / INIT LOOK-AHEAD DCA STXMOD / ++++ DCA STXMOD+1 DCA ETXMOD / ++++ DCA ETXMOD+1 / INIT MODES DCA HLDMOD / INIT AT OPEN /A030 DCA RPPCTLFL / INIT AT OPEN TIME /A030 DSKIN1, JMP I DSKINI / DONE SCFNO, 0 SCIST=10 / SCSPC MOVED HERE FOR SPACE, EDIT # 045 /A045 SCSPC, 0 / PUT # FREE BLOCKS IN HDR TAD SCQBLK+RXQSPC / FROM Q BLOCK DCA SCFSPC JMP I SCSPC / SCREB - READ END BLOCK SCREB, 0 JMS SCGETR / GET BLOCK NUMBER BOTTOM POINTS TO SCBTH / BOTTOM HEADER POINTER /A003 SCBOT / BOTTOM HEADER WORD POINTER /A003 SNA / IS BLOCK ZERO? JMP I SCREB / YES - EOF - NON-SKIP RETURN JMS SCQRX / DO A READ OF IT RXERD / ++++ SCEB JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 JMS SCBOTP / GO INCREMENT BOTTOM POINTERS /A003 1 / BY 1 /A003 ISZ SCREB / SKIP RETURN JMP I SCREB JMP I SCRTB / NON-SKIP RETURN / SCRTB - READ TOP BLOCK SCRTB, 0 DCA GTFLG / ON ENTRY AC = (-) /A030 / SET FLAG TO MINUS TO INDICATE A GETSTX/A030 JMS SCGETR / GET BLOCK NUMBER SCTPH / TOP HEADER POINTER /A003 SCTOP / TOP HEADER WORD POINTER /A003 SNA / ZERO BLOCK IS EOF JMP NOBLK / MUST NOW CLEAR GTFLG WHEN NO MORE TOP /A030 / BLK. ELSE A GETETX WOULD TRIGGER A /A030 / SET-UP OF HLDMOD /A030 JMS SCQRX / READ INTO TOP BLOCK BUFFER RXERD / ++++ SCTB JMS RPRD1 / GO READ GTP TEXT BLOCK /A032 JMS SCTOPP / DECR TOP POINTER -1 / AMOUNT TO DECREMENT BY /A003 ISZ SCRTB / SKIP RETURN NOBLK, DCA GTFLG / CLEAR FLAG SO GETETX WON'T SET-UP /A030 / AND CORRUPT HLDMOD /A030 JMP I SCRTB /--------------- PAGE / SOME UTILITIES SCGETR, XX / GET A WORD FROM OUT OF THE HEADERS /A003 CLA TAD SCGETR / GET ADDR OF ADDRESS OF HEADER PTRS /A003 JMS SCGETX / GO GET THE WORD OUT OF THE HEADERS /A003 JMS RPGETR / GET WORD OUT OF RPPGDS ALSO /A002 CDFBUF / CHANGE TO THE BUFFER FIELD (WHERE HEADER IS) /A003 TAD I SCGTR1 / GET THE WORD FROM THE HEADER /A003 CDFMYF / BACK TO THIS FIELD /A003 ISZ SCGETR / BUMP PAST THE HDR PTR ADR /A003 ISZ SCGETR / BUMP UP TO THE RETURN ADDR /A003 JMP I SCGETR / GO BACK TO CALLER /A003 SCPUTR, XX / ROUTINE TO PUT A WORD INTO THE HEADERS /A003 DCA SCPTR1 / SAVE THE WORD TO PUT INTO THE HEADER /A003 TAD SCPUTR / GET ADDR OF THE HDR PTR ADDR'S /A003 JMS SCGETX / GO GET THE HEADER /A003 TAD SCPTR1 / GET THE WORD TO PUT INTO THE HEADER /A003 CDFBUF / CHANGE TO BUF FIELD (WHERE HEADER IS) /A003 DCA I SCGTR1 / PUT THE WORD INTO THE HEADER /A003 CDFMYF / BACK TO THIS FIELD /A003 JMS RPPUTR /PUT WORD INTO RPPGDS ALSO /A002 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 ISZ SCPUTR / BUMP PAST PARAMS PASSED /A003 AC0001 / SIGNAL THAT HEADER IS MODIFIED /A003 DCA SCHDMD / PUT SIGNAL INTO HDR CTL BLOCK /A003 JMP I SCPUTR / GO BACK /A003 SCGETX, XX / ROUTINE TO SET UP FOR HEADER READ /A003 DCA SCGTR1 / SAVE ADDR OF PTR ADDRESSES /A003 TAD I SCGTR1 / GET THE HDR PTR /A003 DCA SCGTR2 / SAVE THE HDR PTR /A003 ISZ SCGTR1 / BUMP UP TO PT TO HDR WORD PTR /A003 TAD I SCGTR1 / GET HDR WORD PTR /A003 DCA SCGTR1 / SAVE IT FOR LATER USE /A003 JMS SCOFST / GO SEE IF HEADER IS IN CORE /A003 SCBFCB / HEADER CONTROL BLOCK /A003 JMP I SCGETX / RETURN /A003 SCPTR1, .-. SCGTR1, .-. / TO SAVE HDR WORD POINTER /A003 SCGTR2, 0 / TO SAVE HDR POINTER /A003 / DSKCLS - TOP LEVEL CLOSE ROUTINE DSKCLS, 0 AC0100 / FORCE STXMOD=ETXMOD TAD ETXMOD+1 / ++++ TAD ETXMOD / MODES + SHIFT JMS PUTSTX / ++++ JMS GETSTX / ++++ CLA / THE LOGIC BELOW USED TO MOVE THE ETX BUFFER TO THE STX BUFFER WITH /A028 / OVERFLOW GOING OUT TO THE DISK & THEN NULL OUT THE REMAINDER OF THE /A028 / STX BUFFER & WRITE IT OUT TOO. THIS CODE WORKS FINE BUT WILL NOT /A028 / MAINTAIN THE EXTMOD MODE SETTINGS (SINCE EVERYTHING IS DONE IN 6-BIT /A028 / RATHER THAN 12 BIT MODE COPY). AS A RESULT, THE GOTO PAGE DESCRIPTOR /A028 / WORD WOULD NOT BE CORRECT IF AND SHIFT/ESCAPE CODES MOVED FROM THE /A028 / ETX BUFFER INTO THE STX BUFFER (PROBABILITY OF > 99.9 %). THEREFORE /A028 / THE LOGIC NOW WORKS AS FOLLOWS. IF THERE IS ENOUGH ROOM IN THE STX /A028 / BUFFER TO ACCOMODATE THE TEXT IN THE ETX BUFFER, THE PRIOR LOGIC IS /A028 / INVOKED. IF NOT THEN BOTH BUFFERS AR WRITTEN OUT ESSENCIALLY AS IS /A028 / (THE BUFFER IS NULLED OUT TO THE START/END OF BUFFER AS APPROPRIATE). /A028 TAD STXSAV / SEE IF A "SAVE CHAR" EXISTS. /A028 SZA CLA / SKIP IF NO. /A028 AC0001 / YES. COUNT IT. /A028 TAD SCEPTR / ADD # OF CHARS IN STX MINUS 1. /A028 TAD SCTPTR / ADD # OF CHARS IN ETX MINUS 1. /A028 TAD (-SCHCNT+1) / COMPARE TO MAX # OF CHARS IN BLOCK PLUS/A028 SMA CLA / BAIS. AC WILL BE <0 IF ALL CHARS FIT /A028 / OR FILL BUFFER UP EXACTLY. /A028 JMP DSKCL2 / CANNOT FIT. WRITE BUFFERS AS IS. /A028 DSKCL1, / MOVE ALL CHARS IN ETX BUF TO STX BUF TAD SCEPTR / SEE IF ALL DONE TAD (-SCHCNT+1) SNA CLA JMP DSKCL2 / ALL DONE MOVING JMS GETET1 / GET 1 BYTE DCA STXSV1 /SUPPLY THE CHAR. /A002 JMS PUTSTC / AND MOVE IT (WITH OVERFLOW TO DISK) JMP DSKCL1 / TRY ANOTHER CHAR DSKCL2, TAD STXSAV / FLUSH LOOK-AHEAD, IF ANY SZA DSKCL3, JMS PUTST1 / PAD WITH NULLS TO FILL TAD SCTPTR / IS BUFFER EMPTY (MEANING ALL OUTPUT?) SZA CLA / ++++ JMP DSKCL3 / LOOP IF NOT DSKCL4, TAD SCEPTR / GET ETX COUNT OF CHARS. /A028 TAD (-SCHCNT+1) / WHEN BUFFER TOTALLY FULL WE'RE DONE. /A028 SNA CLA / SKIP IF NOT FULL YET. /A028 JMP DSKCL5 / FULL. DONE. /A028 JMS PUTET1 / NULL BALANCE OF ETX BUFFER. /A028 JMP DSKCL4 / LOOP UNTIL EXT BUFFER "MT"S /A028 DSKCL5, JMS SCCLS / CLOSE AT THE BLOCK LEVEL / SET MODIFIED DATE-TIME IN HEADER CDFSYS TAD I (CLOCK+4) / HOUR BSW / ++++ TAD I (CLOCK+3) / MINUTE CDFBUF DCA I (SCHDR+14) CDFSYS TAD I (PAKDAT) / DAY/MONTH CDFBUF DCA I (SCHDR+10) CDFSYS TAD I (YEAR) / YEAR CDFBUF DCA I (SCHDR+11) CDFMYF / BACK TO THIS FIELD AC0001 JMS SCGTWR / WRITE OUT HEADER JMS WRITEOUT / WRITE THE ALLOCATION BLOCK /A033 JMP I DSKCLS / ALL DONE - RETURN TO CALLER DSKCLC, XX / VERY, VERY TOP LEVEL CLOSE ROUTINE / CHECKS TO MAKE SURE A FILE WAS OPEN BEFORE IT / CALLS THE REAL CLOSE ROUTINE CLA TAD SCQBLK+RXQFNO / SEE IF FILE NO. IS NON-ZERO SNA CLA / IF ZERO JUST RETURN JMP I DSKCLC JMS DSKCLS / CALL REAL CLOSE DCA SCQBLK+RXQFNO / CLEAR FILE NO. JMP I DSKCLC / RETURN /--------------- PAGE / START AT BOTTOM OF STX-BUFFER AND WORK TOWARDS TOP GETST1, XX / GET 1 BYTE FROM STX AC7777 / ++++ TAD SCTPTR / BACKUP PTR SMA / ++++ JMP GETSX1 / JUMP IF STILL OK JMS SCRTB / GET A NEW TOP BLOCK JMP GETSX2 / NO MORE BLOCKS AVAILABLE TAD RPPTR1 /CURRENT V2 DESC. WORD /A018 AND (37 /SAVE # OF PAGES IN THIS BLK /A018 DCA STXMOD+2 /INIT. STX BUFFER PAGE-COUNTER /A018 TAD (SCHCNT-1) / REINIT PTR GETSX1, DCA SCTPTR TAD SCTPTR JMS GETBYT / ++++ SCTB+BOFSET SNA / ++++ JMP GETST1+1 / IGNORE NULLS GETSX2, JMP I GETST1 / RETURN / START AT TOP OF STX BUFFER AND WORK DOWN PUTST1, XX / PUT 1 BYTE TO STX PUTST2, MQL TAD (STXMOD+2 /POINTER TO STX BUFFER PAGE-COUNTER /A018 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 TAD SCTPTR JMS PUTBYT / ++++ SCTB+BOFSET ISZ SCTPTR / BUMP CHAR PTR TAD SCTPTR / ++++ TAD (-SCHCNT) / STILL IN RANGE? SZA CLA / ++++ JMP PUTSX1 / JUMP IF SO JMS SCWTB / ELSE OUTPUT FULL BLOCK CLA /IO RESULT /A018 TAD STXHLD / SET HLDSTX TO BE THE MODE OF THE 1ST /A028 DCA HLDMOD / CHAR OF NEW (LAST OF OLD) BUFFER. /A028 DCA SCTPTR /CLEAR BUFFER-BYTE POINTER /A018 DCA STXMOD+2 /AND STX PAGE-COUNTER /A018 PUTSX1, TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 / RANGE /A032 JMP PUTST2 / PAD REST OF BLK WITH NULLS /A032 JMP I PUTST1 / AND RETURN / START AT TOP OF ETX BUFFER AND WORK DOWN GETET1, XX / GET 1 BYTE FROM ETX CLA / ++++ TAD SCEPTR TAD (-SCHCNT+1) / STILL IN RANGE? SZA CLA / ++++ JMP GETEX1 / JUMP IF SO JMS SCREB / ++++ JMP GETEX2 / ELSE REFILL BUFFER TAD RPPTR1 /CURRENT DESC. WORD /A018 AND (37 /# OF PAGES ONLY /A018 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 DCA SCEPTR / RESET PTR SKP / (SKIP ISZ INST) GETEX1, ISZ SCEPTR / BUMP CHAR PTR TAD SCEPTR JMS GETBYT / ++++ SCEB+BOFSET SNA / ++++ JMP GETET1+1 / IGNORE NULLS GETEX2, JMP I GETET1 / AND RETURN / START AT BOTTOM OF ETX BUFFER AND WORK BACK PUTET1, XX / PUT 1 BYTE TO ETX PUTET2, MQL TAD (ETXMOD+2 /ADDR. OF ETX BUFFER PAGE-COUNTER /A018 DCA T3 /IDENTIFIES PAGE-COUNTER TO PUTBYT /A018 TAD SCEPTR JMS PUTBYT / ++++ SCEB+BOFSET AC7777 / ++++ TAD SCEPTR / STILL IN RANGE? SMA / ++++ JMP PUTEX1 / JUMP IF SO JMS SCWEB / ELSE OUTPUT FULL BUFFER CLA / /A018 DCA ETXMOD+2 /INIT. ETX BUFFER PAGE-COUNTER /A018 TAD (SCHCNT-1) / AND REINIT PTR PUTEX1, DCA SCEPTR / UPDATE PTR TAD PAGLIM / SEE IF PAGE LIMIT FLAG IS SET /A032 SZA CLA / SKIP IF: # OF PAGES IN BLK. WITHIN /A032 / RANGE /A032 JMP PUTET2 / PAD REST OF BLK WITH NULLS /A032 JMP I PUTET1 / AND RETURN GETBYT, XX CLL RAR TAD I GETBYT DCA GETBY1 ISZ GETBYT CDFBUF TAD I GETBY1 CDFMYF SNL / ++++ BSW AND P77 JMP I GETBYT PUTBYT, XX CLL RAR TAD I PUTBYT DCA PUTBY1 ISZ PUTBYT CDFBUF TAD I PUTBY1 SNL / ++++ BSW AND P7700 MQA SNL / ++++ BSW DCA I PUTBY1 CDFMYF TAD CUR12BIT /CURRENT 12-BIT CHAR. /M026 SNA /SKIP IF 1ST BYTE BEING STORED /A018 JMP RPPUTX /CURRENT 12-BIT CHAR. ALREADY COUNTED /A018 JMS CHKPAG / CHECK FOR PAGE/NEW-PAGE MARKER. /M028 RPPUTX, DCA CUR12BIT /CLEAR FOR 2ND BYTE (IF ONE) /A026 JMP I PUTBYT GETBY1=PUTBYT PUTBY1=GETBYT /--------------- PAGE /******************************************************************* /A003 / / THIS ROUTINE CLOSES THE DOCUMENT AFTER AN EDIT SESSION. /A003 / IT WILL FREE UP ALL UNUSED BLOCKS THAT HAVE BEEN ALLOCATED TO IT/A003 / AND IT WILL "SQUISH" THE DOCUMENT SO THAT ALL ITS BLOCKS ARE /A003 / CONTIGUOUS IN THE "HI ORDER" POSTION OF ITS HEADER BLOCKS /A003 / IT WILL ALSO FREE UP ALL UNUSED HEADER BLOCKS AND UPDATE THE /A003 / HEADER BLOCKS THEMSELVES (THE IN-USE BIT TURNED OFF, THE DATES /A003 / AND TIMES OF THE CLOSE PUT INTO THE HEADERS, ETC) /A003 / /A003 /***********************************************************************/A003 SCCLS, 0 / SCCLS - CLOSE HEADER BLOCK JMS SCBOTP / DECREMENT BOTTOM-OF-DOCUMENT PTRS /A003 -1 / THIS POINTS TO THE LAST UNUSED BLOCK /A003 TAD SCBOT / NOW WE SAVE THE BOTTOM-OF DOC POINTERS/A003 DCA SCBTSV / SO THAT WE CAN KNOW WHEN TO STOP /A003 TAD SCBTH / FREEING UP BLOCKS /A003 DCA SCBHSV /A003 JMS SCBOTP / REPOSITION BOT-OF-DOC PTRS TO POINT TO/A003 1 / NEXT BLOCK OF DOCUMENT /A003 JMS SCREQ / GO SEE IF THERE ARE ANY BLOCKS TO FREE/A003 SMA CLA / IF YES, GO DO IT /A003 JMP SCCLS7 / IF NONE, NO FREEING, NO SQUISHING /A003 JMS SAVTOP / GO SAVE TOP POINTERS /A003 SCCLS1, JMS SCTOPP / GO INCREMENT TOP-OF-DOC POINTERS /A003 1 / POSITION TO GET BLK TO FREE OR SQUISH /A003 AC7777 / GET A MINUS 1 TO DECREMENT WITH /A003 TAD SCFILZ / DECREMENT THE FILE SIZE BY ONE /A003 DCA SCFILZ / STORE IT FOR NEXT TIME /A003 JMS SCGETR / GO GET BLOCK NUMBER TO FREE UP /A003 SCTPH /A003 SCTOP /A003 JMS SCQRX / GO FREE THE BLOCK JUST GOTTEN /A003 RXEFR /A003 0 /A003 JMS SCREQ / GO SEE IF WE'RE DONE FREEING UP BLOCKS/A003 SZA CLA / IF ZERO, WE'RE DONE /A003 JMP SCCLS1 / OF NPOT ZERO, GO FREE UP ANOTHER /A003 JMS GETTOP / GO GET TOP POINTERS PREV SAVED /A003 SCCLS2, JMS SCTOPP / GO INCREMENT TOP PTRS /A003 1 /A003 JMS SCGETR / GO GET A BLOCK TO SQUISH /A003 SCBTH /A003 SCBOT /A003 SNA / CHECK IF DONE /A003 JMP SCCLS6 / 0 BLOCK NUMBER INDICATES EOF /A003 JMS SCPUTR / GO PUT BLK NBR AT TOP-OF-DOC /A003 SCTPH / IN OREDER TO SQUISH THE FILE /A003 SCTOP /A003 JMS SCBOTP / GO INCREMENT BOTTOM-OF-DOCUMENT PTRS /A003 1 /A003 JMP SCCLS2 / GO INCREMENT TOP-OF-DOC PTRS (CONT) /A003 / ALL DONE SQUISHING/FREEING /A003 SCCLS6, AC7777 / END OF RPPGDS DESCRIPTORS /A002 DCA RPPTR1 / FOR WRITE TO RPPGDS /A002 JMS SCPUTR / GO PUT OUT THE 0-BLOCK NBR INDICATING /A003 SCTPH / END OF FILE /A003 SCTOP /A003 SCCLS7, JMS SCCLSE / GO FREE UP EXCESS HDR BLOCKS /A003 TAD SCFILZ / GET FILE SIZE TO PUT INTO HEADER /A003 JMS SCPUTR / GO PUT THE FILE SIZE INTO HEADER 1 /A003 ONE / INDICATE HEADER ONE /A003 THREE / INDICATE THE 5TH WORD OF HEADER /A003 JMS SCGETR / GO GET THE IN-USE BIT FROM 1ST HEADER /A003 ONE / INDICATE 1ST HEADER /A003 MONE / INDIC 0TH WORD (WHERE IN-USE BIT IS) /A003 AND (1777) / TURN OFF IN-USE BIT /A003 JMS SCPUTR / GO PUT THE IN-USE BIT BACK IN HDR /A003 ONE / INDICATE 1ST HEADER /A003 MONE / INDICATE 0TH WORD (WHERE IN-USE BIT IS)/A003 JMP I SCCLS / DONE /***********************************************************************/A003 / /A003 / THIS ROUTINE WILL DETERMINE IF THE TOP-OF-DOCUMENT POINTERS /A003 / ARE EQUAL TO BOTTOM-OF-DOCUMENT POINTERS THAT WERE IN EFFECT /A003 / AT THE END OF THE EDIT SESSION. THIS ENABLES THE CLOSE ROUTINES /A003 / TO DETERMINE WHEN TO STOP DEALLOCATING BLOCKS THAT HAVE BEEN /A003 / ALLOCATED TO THE DOCUMENT AND THAT ARE NOT NEEDED. A MINUS 1 /A003 / PASSED IN THE AC INDICATES 'NOT EQUAL' AND A 0 IN THE AC MEANS /A003 / THAT THEY ARE. IF EQUAL, THEN IT MEANS NO MORE BLOCKS SHOULD BE /A003 / DEALLOCATED. /A003 / /A003 /***********************************************************************/A003 SCREQ, XX /A003 TAD SCTPH / GET TOP HDR WORD PTR /A003 CIA / SET IT UP FOR COMPARE /A003 TAD SCBHSV / GET SAVED BOT HDR PTR /A003 SZA CLA / IF EQUAL, GO CHECK HDR WORD PTRS /A003 JMP SCNEQ / GO INDICATE NOT EQUAL AND RETURN /A003 TAD SCTOP / GET TOP-OF-DOC HDR WORD PTR /A003 CIA / SET IT UP TO COMPARE /A003 TAD SCBTSV / COMP TO SAVED HDR WORD PTR /A003 SNA CLA / IF NOT EQUAL, SO INDIC AND RETURN /A003 JMP I SCREQ / IF EQUAL, AC 0 AND RETURN /A003 SCNEQ, AC7777 / MINUS 1 TO SC=UNEQUAL CONDITION /A003 JMP I SCREQ / GO BACK /A003 SCBHSV, 0 / AREA TO SAVE BOT HDR PTR /A003 SCBTSV, 0 / AREA TO SAVE BOT HDR WORD PTR /A003 SCHDR=HDRBUF SCEB=ETXBUF SCTB=STXBUF SCQRX, 0 DCA SCQBLK+RXQBLK / SET BLOCK NUMBER TAD (CDFBUF) / get CDF to buffer field. /A028 DCA SCQBLK+RXQBFD / AND BUFFER FIELD TAD I SCQRX / ++++ DCA SCQBLK+RXQFNC / AND FUNCTION ISZ SCQRX TAD I SCQRX / ++++ DCA SCQBLK+RXQBAD / AND BUF PTR ISZ SCQRX CIFSYS / ++++ ENQUE / ++++ SCQUBL / QUEUE Q-BLOCK SCQRX1, CIFSYS / ++++ JWAIT / WAIT FOR EVENT TAD SCQBLK+RXQCOD / ARE WE DONE? SNA JMP SCQRX1 / NO SMA / ++++ CLA / RETURN - IF ERROR; 0 OTHERWISE JMP I SCQRX / YES SCQUBL, DSKQUE / ++++ 0 / ++++ 0 SCQBLK, 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 / ++++ 0 ETXMOD, 0 / ETX MODES 0 /SHIFT FLAG 0 /ETX BUFFER PAGE-COUNTER /A018 ETXDES, 0 /DESCRIPTOR WORD FOR BLK BEING WRITTEN /A030 /THROUGH ETX BUFFER /A030 /--------------- PAGE / RDFIL HEADER CONTROL AREA RDBFCB, PSTBUF / PASTE BUFFER RDHDBN, 0 / PTR TO BLK # IN PASTE BUFFER / THIS POINTER POINTS TO ONE OF THE FOLLOWING SEVENTEEN BLOCK NUMBERS / DEPENDING ON WHICH BLOCK NUMBER IS IN THE PASTE BUFFER RDHDRB, 0 / FIRST HEADER BLOCK NUMBER 0 / SECOND HEADER BLOCK NUMBER 0 / THIRD HEADER BLOCK NUMBER 0 / FOURTH HEADER BLOCK NUMBER 0 / FIFTH HEADER BLOCK NUMBER 0 / SIXTH HEADER BLOCK NUMBER 0 / SEVENTH HEADER BLOCK NUMBER 0 / EIGHTH HEADER BLOCK NUMBER 0 / NINTH HEADER BLOCK NUMBER 0 / TENTH HEADER BLOCK NUMBER 0 / ELEVENTH HEADER BLOCK NUMBER 0 / TWELFTH HEADER BLOCK NUMBER 0 / THIRTEENTH HEADER BLOCK NUMBER 0 / FOURTEENTH HEADER BLOCK NUMBER 0 / FIFTEENTH HEADER BLOCK NUMBER 0 / SIXTEENTH HEADER BLOCK NUMBER 0 / SEVENTEENTH HEADER BBLOCK NUMBER 0 / HEADER BLOCK #'S, THEN 0 0 / MOD FLAG (ALWAYS 0) RDGETR, XX TAD RDHDBN / CHECK TO SEE IF FIRST HEADER IN CORE /A003 SNA CLA / IF ZERO, ITS NOT IN CORE /A003 JMP RDGTHD / GO GET 1ST HEADER INTO CORE /A003 JMS TOGETR / GET ADDR OF PTR TO HDR IN CORE /A030 CIA / SWITCH IT FOR COMPARE /A003 TAD RDHDBN / IS IT THE SAME (IS HDR IN CORE?) /A003 SZA CLA / IF YES, GO GET WORD PTR /A003 JMP RDCKHD / OTHERWISE GO GET HEADER INTO CORE /A003 RDRET, ISZ RDGETR / BUMP UP TO POINT TO HDR WORD PTR /A003 TAD I RDGETR / GET ADDR OF HEADER WORD PTR /A003 DCA RDGET1 / STORE IT FOR INDIRECT USE /A003 TAD I RDGET1 / GET THE HEADER WORD POINTER /A003 TAD (PSTBUF+2) / GET ADDRESS OF BUFFER + 2 /A003 DCA RDGET1 CDFBUF TAD I RDGET1 CDFMYF JMP RDEXI2 / NEW EXIT POINT /A030 RDGET1=T1 / GET NEXT HEADER INTO CORE /A003 RDGTHD, JMS TOGETR / GET HDR POINTER, ADD IN BASE ADDR /A030 DCA RDHDBN / PUT ADDR OF HDR IN CORE /A003 RDGTXR, TAD I RDHDBN / DO IO SNA / ++++ JMP RDGTXZ JMS RDFIO RXERD+4000 SMA CLA / ++++ JMP RDRET / GOT HEADER, GO BACK /A003 DCA I RDHDBN / ELSE CLEAR BLOCK # RDGTXZ, DCA RDHDBN / AND LOADED FLAG RDEXIT, ISZ RDGETR / BUMP UP TO RETURN /A003 RDEXI2, ISZ RDGETR / EXIT FROM ABOVE ALSO /A030 JMP I RDGETR / AND RETURN 0 RDCKHD, JMS TOGETR / GET HDR PTR PLUS ADD OF HDR CTL AREA /A030 DCA RDGET1 / STORE ADDR OF HDR BLOCK NBR /A003 TAD I RDGET1 / GET HDR BLOCK NBR /A003 SNA CLA / IS THERE ONE THERE?? /A003 JMP RDEXIT / NO, GO GET OUT /A003 JMP RDGTHD / GO GET HEADER INTO CORE /A003 GTHDRS, XX / ROUTINE TO GET HEADER BLOCK EXTENSIONS TAD I GTHDRS / GET ADDRESS OF HDR CTL AREA /A003 DCA PTR1 / STORE IT TO INDIRECT THRU /A003 TAD I PTR1 / GET BUFFER ADDRESS /A003 TAD THREE / POINT TO THIRD HDR BLK AREA /A003 DCA PTR1 / STORE ADDR 3RD HDR BLK /A003 CDFBUF /A003 TAD I PTR1 / GET 3RD HDR BLOCK NBR /A003 CDFMYF /A003 SNA CLA / IF NO THIRD HDR, GO BACK /A003 JMP GTGOBK / RETURN /A003 TAD I GTHDRS / GET ADR OF HDR CONTROL AREA TAD FOUR / BUMP TO THIRD HDR BLK NBR /M014 DCA X0 / PUT ADR FOR AUTOINDEXING TAD (RPBFCB /TOP OF RPPGDS BLOCK-LIST /A014 TAD FOUR /PTR ABOVE 4TH ENTRY /A104 DCA X1 /SAVE FOR STORE LATER /A104 TAD T360 / GET WORD WHERE EXTENSIONS ARE DCA PTR1 / PUT IT IN CALLING SEQUENCE TAD M16 / GET LOOP CONTROL (NBR OF POSS HDRS) /A003 DCA PTR2 / PUT IT SOMEWHERE FOR ISZ /A003 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /M045 CIA / COPLEMENT FOR COMAPRE /A003 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A003 SNA CLA / IF NOT READ ONLY, DO SCROLL READ /A003 /D045 JMP RDGTHR / GO READ READ ONLY HEADERS /A003 /D045 JMS SCGETR / GO GET HEADER BLOCK NBR TAD (RDGETR-SCGETR) / GET OFFSET OF READ-ONLY FROM THE SCRL /A045 / READ ROUTINE /A045 TAD (SCGETR) / ADD ADDRESS OF SCRL READ ROUTINE /A045 DCA XGETR / & STORE THE ADDRESS OF THE APPROPRIATE/A045 / SUBROUTINE FOR LATER USE GETHDR, JMS I XGETR / GO GET HEADER BLOCK NBR /A045 THREE / THIRD HEADER WHERE BLK NBRS ARE PTR1 / POINTER TO WHERE BLK NBRS ARE GTHDCK, SNA / IF NON-ZERO, THE BLOCK NBR IS PRESENT /A003 JMP GTRESH / IF ZERO BLK NBR, THEN ALL DONE /M045 / GO GET THE FIRST HDR BACK INTO CORE/A045 DCA I X0 / PUT BLK NBR INTO HDR CTL /A003 TAD I GTHDRS / GET ADDR OF HDR CTL BLK /A040 CIA / COPLEMENT FOR COMAPRE /A040 TAD (RDBFCB) / ADD IN READ FILE HDR CTL BLK /A040 SNA CLA / SKIP IF: SCROLL READ /A040 JMP GTHDC1 / READ ONLY FILE, IGNORE GTP /A040 / TAD RPPTR1 /RPPGDS WORD READ /A014 DCA I X1 /PUT IN RPPGDS BLOCK-LIST ALSO /A014 GTHDC1, ISZ PTR1 / POINT TO NEXT HDR BLK NBR /A003 ISZ PTR2 / ARE WE ALL DONE? /A003 JMP GETHDR / NO- GO GET IT IF ITS THERE GTRESH, / READ THE FIRST HEADER BLOCK BACK INTO /A045 / CORE BEFORE EXITING /A045 JMS I XGETR / /A045 ONE / WE WANT THE 1ST HDR BLOCK /A045 ONE / ANY WORD WILL DO, ONE IS AS GOOD AS ANY/A045 CLA / JUST CLEAR THE RETURN /A045 GTGOBK, ISZ GTHDRS / BUMP TO RETURN ADDR /A003 JMP I GTHDRS / RETURN /A003 / FOLLOWING CODE NO LONGER REQUIRED /A045 /D045 / GET HEADERS FOR READ ONLY FILES /A003 /D045RDGTHR, JMS RDGETR / GO GET THE HEADERS /A003 /D045 THREE / POINT TO THIRD HEADER /A003 /D045 PTR1 / HEADER WORD POINTER /A003 /D045 JMP GTHDCK / GO SEE IF MORE TO DO /A003 PTR1, 0 / PONTER TO WHERE THE HDR BLK NBRS ARE /A003 PTR2, 0 / COUNTER FOR LOOP CONTROL /A003 XGETR=T2 / AREA TO SAVE ADDRESS OF THE APPROP. /A045 / GET ROUTINE /A045 TOGETR, XX /A030 TAD I RDGETR / GET ADDR OF THE HDR PTR /A030 DCA RDGET1 / STORE IT FOR INDIRECT USE /A030 TAD I RDGET1 / GET THE HDR POINTER /A030 TAD (RDHDBN) / GET ADDR OF PTR TO HDR IN CORE /A030 JMP I TOGETR / RETURN TO CALLER /A030 /D045SCSPC, 0 / PUT # FREE BLOCKS IN HDR /D045 TAD SCQBLK+RXQSPC / FROM Q BLOCK /D045 DCA SCFSPC /D045 JMP I SCSPC /--------------- PAGE SCOFST, XX / ROUTINE TO SEE IF HEADER IS IN CORE /A003 TAD SCGTR2 / GET HEADER POINTER /A003 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 TAD I SCOFST / GET HEADER CONTROL BLOCK ADDR /A003 DCA SCOFS1 / SAVE IT /A003 TAD I SCOFS1 / GET BUFFER ADDR /A003 DCA SCOFS1 / SAVE BUFFER ADDR /A003 AC0001 / 1 FOR ADDING /A003 TAD I SCOFST / POINT TO IN-CORE HEADER BLOCK NUMBER /A003 DCA SCOFS2 / STORE FOR FUTURE USE /A003 TAD (24) / GET DISPL TO MOD FLAG IN HDR CTL BLOCK /A003 TAD I SCOFST / ADD IN ADDR OF HDR CTL BLOCK /A003 DCA SCOFS3 / SAVE FOR FUTURE USE /A003 ISZ SCOFST / BUMP TO RETURN ADDRESS /A003 TAD I SCOFS2 / GET ADDRESS OF IN-CORE HDR BLOCK NBR /A003 CIA / CHANGE FOR COMPARE /A003 TAD SCOFS2 / ADD IN IN-CORE ADDRESS /A003 TAD I SCOFS4 / ADD IN HDR PTR /A003 SZA CLA / IS HEADER IN CORE /A003 JMP SCCHGE / IF NOT, GO READ IN NEW ONE /A003 JMP SCEND / GO ADD IN WORD POINTER AND RETURN /A003 SCCHGE, AC7777 / MINUS 1 TO AC FOR CHECKING MOD FLAG /A003 TAD I SCOFS3 / ADD IN VALUE OF MOD FLAG (1 MEANS MODIFIED) /A003 SZA CLA / HAS IT BEEN MODIFIED? /A003 JMP SCRDIN / NO, DON'T HAVE TO WRITE IT OUT/GO READ IN /A003 AC0001 / SIGNAL A WRITE OPERATION /A003 JMS SCGTWR / GO WRITE OUT THE HEADER /A003 SCRDIN, TAD SCOFS2 / GET ADDR OF IN-CORE HDR BLOCK NBR PTR /A003 TAD I SCOFS4 / ADD IN HDR PTR (AC POINTS TO NEW HDR) /A003 DCA I SCOFS2 / PUT THIS ADDR INTO HDR CTL BLOCK /A003 JMS SCGTWR / GO READ IN NEW HEADER INTO BUFFER /A003 SCEND, TAD SCGTR1 / GET ADDR OF THE HDR WORD PTR /A003 DCA SCOFS4 / STORE IT FOR INDIRECT USE /A003 TAD I SCOFS4 / GET HDR WORD POINTER /A003 TAD (SCHDR+2) / GET BUFFER ADDR +2 PAST COS STUFF /A003 DCA SCGTR1 / PUT ADDR INTO INDIRECT FIELD /A003 JMP I SCOFST / RETURN /A003 SCOFS1, 0 / AREA TO HOLD THE BUFFER ADDRESS /A003 SCOFS2, 0 / AREA TO HOLD THE HDR BLOCK NBR ADDRESS /A003 SCOFS3, 0 / ARE TO HOLD THE MOD FLAG ADDRESS /A003 SCOFS4, 0 / AREA TO HOLD HDR POINTER /A003 / SCROLL HEADER BUFFER CONTROL AREA SCBFCB, SCHDR / SCROLL HEADER BUFFER ADDRESS SCHDBN, 0 / POINTS TO HDR BLK NBR THAT'S IN CORE / THE ABOVE POINTER IS AN ADDR TO ONE OF THE BLK NBRS BELOW SCHDRB, 0 / FIRST HEADER BLOCK NUMBER 0 / SECOND HEADER BLOCK NUMBER 0 / THIRD HEADER BLOCK NUMBER 0 / FOURTH HEADER BLOCK NUMBER 0 / FIFTH HEADER BLOCK NUMBER 0 / SIXTH HEADER BLOCK NUMBER 0 / SEVENTH HEADER BLOCK NUMBER 0 / EIGHT HEADER BLOCK NUMBER 0 / NINTH HEADER BLOCK NUMBER 0 / TENTH HEADER BLOCK NUMBER 0 / ELEVENTH HEADER BLOCK NUMBER 0 / TWELFTH HEADER BLOCK NUMBER 0 / THIRTEENTH HEADER BLOCK NUMBER 0 / FOURTEENTH HEADER BLOCK NUMBER 0 / FIFTEENTH HEADER BLOCK NUMBER 0 / SIXTEENTH HEADER BLOCK NUMBER 0 / SEVENTEENTH HEADER BLOCK NUMBER 0 / BLK #S, THEN 0 SCHDMD, 0 / MOD FLAG INDICATES HDR IN CORE'S BEEN MODIFIED SCGTWR, XX / IO ROUTINE FOR SCHDR SNA CLA / ++++ JMP SCGTRD / JUMP IF READ TAD I SCHDBN / GET BLOCK # JMS SCQRX RXEWT+2000 / ++++ SCHDR / DO WRITE JMS RPWRT / WRITE GTP HDR BLK /A032 DCA SCHDMD / CLEAR MOD FLAG JMP I SCGTWR / RETURN SCGTRD, TAD I SCHDBN / GET BLOCK # SNA / ++++ JMP SCGTAL / ALLOCATE HEADER IF ZERO JMS SCQRX RXERD / ++++ SCHDR / READ BLOCK SCGTEX, JMS RPREA1 / READ GTP BLOCK /M034 /A032 JMP I SCGTWR / RETURN SCGTAL, JMS SCQRX /ALLOC. A BLOCK FOR HDR/EXTN /M014 RXEAL / ++++ 0 / ALLOCATE BLOCK TAD SCQBLK+RXQBLK DCA I SCHDBN / STORE BLOCK # JMS SCBUFI / ++++ SCHDR / INIT FIRST WORDS / NOTE: THE ROUTINE 'SCBUFI', WHICH INITIATES BUFFER AREAS FOR /A015 / COS 310 COMPATIBILITY, ALSO SETS UP THE INDEX REGISTER 'X0" /A015 / TO POINT TO THE AREA BEING INITIALIZED. THIS INDEX REGISTER /A015 / IS ALSO USED BY THE SUBSEQUENT ROUTINE 'CLRBUF' TO CLEAR OUT /A015 / THE HEADER BUFFERS. THE ROUTINE 'CLRBUF' DEPENDS ON INDEX /A015 / REGISTER 'X0' BEING THUS INITIALIZED. /A015 TAD M376 / GET NEG OF COUNT OF CHARACTERS IN BUFFER /A015 DCA T1 / PUT IT WHERE 'CLRBUF' CAN GET AT IT /A015 JMS CLRBUF / GO CLEAR OUT REMAINDER OF HEADER BUFFER AREA /A015 JMP SCGTEX / DO SAME FOR GTP /A034 SAVTOP, XX / ROUTINE TO SAVE TOP POINTERS /A003 TAD SCTPH / GET TOP HEADER POINTER /A003 DCA SAVTPH / SAVE IT /A003 TAD SCTOP / GET TOP HEADER WORD POINTER /A003 DCA SVTOP / SAVE IT /A003 JMP I SAVTOP / GO BACK /A003 GETTOP, XX / ROUTINE TO GET BACK TOP POINTERS /A003 TAD SAVTPH / GET SAVED TOP POINTERS /A003 DCA SCTPH / RESTORE IT /A003 TAD SVTOP / GET SAVE HDR WORD PTTR /A003 DCA SCTOP / RESTORE IT /A003 JMP I GETTOP / GO BACK /A003 SAVTPH, 0 /A003 SVTOP, 0 /A003 RPEXTR, 0 /-1 => MUST ALLOC. A BLOCK FOR /A014 / RPPGDS EXTN., AFTER WRITTING OUT THE CURRENT ONE /A014 /************************************************************************* / / THIS ROUTINE CLEARS OUT THE BUFFER AREA WHEN WE ARE SETTING A015 / IT UP FOR USE AS A NEW BUFFER AREA. A015 / A015 /************************************************************************** CLRBUF, /A015 XX /A015 CDFBUF /A015 CLRBF1, DCA I X0 / X0= ADDRES OF BUFFER AREA, SET UP BY SCBUFI /A015 / AC= COS COMPATIBLE CHARACTER SET UUP BY SCBUFI/A015 ISZ T1 / T1= COUNT OF CHARCTERS (START -377 OCTAL) /A015 JMP CLRBF1 / GO CLEAR NEXT WORD OUT TIL END /A015 CDFMYF /A015 JMP I CLRBUF / RETURN, ALL DONE /A015 /--------------- PAGE /************************************************************************* / / SCAD16 WILL ADD OCTAL 16 TO THE DISPLACEMENT IF THE POINTERS / PASSED TO IT POINT TO THE HEADER EXTENSION BLOCK POINTERS / THAT EXIST ON THE THIRD HEADER. THIS ENABLES THE USER TO / PREVENT THEM FROM BEING USED AS DOCUMENT BLOCK POINTERS. / /*************************************************************************** SCAD16, XX / CHECK TO SEE IF 3RD HEADER CLA / CLEAR THE AC TAD I SCAD16 / GET ADDR OF HEADER POINTER DCA SCAD4 / STORE IT FOR INDIRECT USE ISZ SCAD16 / BUMP UP TO GET HEADER WORD PTR /A003 TAD I SCAD16 / GET HDR WORD PTR ADDR /A003 DCA SCAD7 / STORE IT FOR INDIRECT USE /A003 ISZ SCAD16 / BUMP UP TO DISPLACEMENT /A003 TAD I SCAD4 / GET HEADER POINTER TAD M3 / CHECK TO SEE IF IT'S THE 3RD SMA / IF NOT, GO SEE IF ITS THE 4TH JMP SCAD5 / GO SEE IF IT'S THE 4TH JMP SCAD1 / IF LESS, GET OUT IT'S O.K. SCAD5, SZA CLA / IF ITS THE 3RD, GO SEE IF ADD NEEDED JMP SCAD6 / GO SEE IF IT'S THE FOURTH TAD I SCAD7 / GET THE HDR WORD PTR TAD I SCAD16 / ADD DISPLACEMENT TO HDR WORD PTR TAD M360 / DOES IT POINT TO A HDR BLK NBR? SMA CLA / IF MINUS, THEN IT'S O.K. GET OUT JMP SCAD8 / GO SEE IF IT'S ZERO OR PLUS JMP SCAD1 / GO GET OUT SCAD8, / IF GREATER THAN 0 GO ADD OCTAL 16 TAD I SCAD16 / GET DISPLACEMENT TAD T16 / ADD OCTAL 16 (DECIMAL 14) DCA I SCAD16 / PUT DISPLACEMENT JMP SCAD1 / GO GET OUT SCAD6, TAD I SCAD4 / GET HEADER POINTER TAD M4 / CHECK IF IT'S THE 4TH SZA CLA / PROCESS IT IF IT IS JMP SCAD1 / GO GET OUT TAD I SCAD7 / GET HDR WORD PTR TAD I SCAD16 / GET THE DISPLACEMENT SMA CLA / DID IT GO NEGATIVE? /C017 JMP SCAD1 / GET OUT TAD I SCAD16 / GET DISPLACEMENT TAD M16 / TAKE AWAY OCTAL 16 (TO GO OVER HDR BLK NBRS) DCA I SCAD16 / PUT IT INTO CALL LIST SCAD1, ISZ SCAD16 / BUMP UP TO RETURN ADDR CLA / CLEAR AC BEFORE RETURNING /A003 JMP I SCAD16 / GO BACK SCAD4, 0 / FOR IDIRECTING TO HEADER POINTER /A003 SCAD7, 0 / FOR INDIRECTING TO HDR WORD POINTER /A003 /***************************************************************************** / / SCINC WILL INCREASE THE DOCUMENT BLOCK NUMBER POINTER BY AN AMOUNT / PASSED TO IT. THIS AMOUNT CAN BE ANY INTEGRAL VALUE EITHER NEGATIVE / OR POSITIVE. THE CALLING SEQUENCE IS: / JMS SCINC / PTR1 / HEADER POINTER / PTR2 / HEADER WORD POINTER / DISP / DISPLACEMENT (-1, 1, 2 ETC) / RETURN POINT / PTR1 IS THE HEADER POINTER. IT POINTS TO A HEADER (FROM 1 TO 17 DEC) / WHICH THE POINTER CURRENTLY POINTS TO. / PTR2 IS THE HEADER WORD POINTER WHICH POINTS TO THE PARTICULAR WORD / WITHIN THE HEADER BLOCK POINTED TO BY PTR1, AT WHICH THIS POINTER / PAIR CURRENTLY POINTS TO. / DISP IS AN INTEGER BY WHICH THE USER WISHES TO INCREMENT OR DECREMENT / THE POINTER PAIRS. /****************************************************************************** SCINC, XX / INCREMENT/DECREMENT POINTER CLA / CLEAR AC TAD I SCINC / GET ADDR OF HEADER POINTER DCA SCINC1 / STORE IT FOR INDIRECT USE ISZ SCINC / BUMP UP TO POINT TO HDRR WORD PTR TAD I SCINC / GET ADR OF HDR WORD PTR DCA SCINC2 / STORE IT FOR INDIRECT USE ISZ SCINC / BUMP UP TO DISPLACEMENT TAD I SCINC2 / GET HDDR WORD PTR TAD I SCINC / ADD IN DISPLACEMENT ISZ SCINC / BUMP UP TO RETURN ADDR SMA / IF MINUS THEN IT CROSSED HEADERS JMP SCINCX / GO CHECK FURTHER IF + TAD T376 / ADD IN LENGTH OF HEADER DCA I SCINC2 / UPDATE HDR WORD POINTER AC7777 / -1 TO AC TO DECREMENT HDR NBR TAD I SCINC1 / DECREMENT HDR POINTER DCA I SCINC1 / RETURN IT JMP I SCINC / GO BACK SCINCX, SNA / IF PLUS, THEN IT MAY HAVE CROSSED HEADERS /A017 JMP SCINCY / GO UPDATE HDR WORD POINTER ONLY IF 0 TAD M376 / SUBTRACT OUT LENGTH OF HEADER SPA / HAS IT CROSSED THE HEADER? JMP SCINCZ / NO, GO ADD BACK 376 AND GET OUT DCA I SCINC2 / YES, THEN UPDATE THE HDR WORD PTR ISZ I SCINC1 / BUMP UP HDR PTR JMP I SCINC / RETURN SCINCZ, TAD T376 / ADD BACK 376 WHEN -/0 SCINCY, DCA I SCINC2 / UPDATE HDR WORD PTR JMP I SCINC / RETURN SCINC1, 0 / WORD TO INDIRECT TO HDR POINTER SCINC2, 0 / WORD TO INDIRECT TO HDR WORD PTR /*********************************************************************/A003 / / THIS ROUTINE WILL INCREMENT OR DECREMENT THE POINTER PAIRS /A003 / FOR THE BOTTOM PAIR OF DOCUMENT POINTERS. THESE POINTER PAIRS /A003 / POINT TO DOCUMENT BLOCK NUMBERS THAT RESIDE IN THE HEADER /A003 / BLOCK(S) OF THE DOCUMENT. THE FIRST POINTER OF THE POINTER /A003 / PAIR POINTS TO THE HEADER BLOCK THAT CONTAINS THE BLOCK NUMBER /A003 / POINTED TO BY THE POINTER PAIR. THE SECOND POINTER OF THE /A003 / POINTER PAIR POINTS TO THE WORD WITHIN THE HEADER BLOCK THAT /A003 / THE POINTER PAIR IS POINTING TO. THERE ARE CURRENTLY 17 POSSIBLE/A003 / HEADER BLOCKS THAT CAN BELONG TO A DOCUMENT. THE FIRST THREE /A003 / HEADERS CAN POTENTIALLY HOLD UP TO 701 DOCUMENT BLOCK NUMBERS. /A003 / THE FIRST HEADER BLOCK CAN HOLD UP TO 211 DOCUMENT BLOCK /A003 / NUMBERS. THE SECOND HEADER BLOCK CAN CONTAIN UP TO 254 DOCUMENT /A003 / NUMBERS. THE THIRD HEADER BLOCK CAN CONTAIN UP TO 240 DOCUMENT /A003 / BLOCK NUMBERS. ALL FURTHER HEADER BLOCKS CAN CONTAIN 254 /A003 / DOCUMENT BLOCK NUMBERS. DOCUMENT BLOCK NUMBERS BEGIN AT WORD /A003 / 44 OF THE FIRST HEADER BLOCK, CONTINUE ON THE SECOND HEADER /A003 / BLOCK BEGINNING AT WORD THREE AND PROCEEDING TO THE END OF THE /A003 / BLOCK, THEN CONTINUE ONTO THE THIRD HEADER BLOCK BEGINNING ON /A003 / ITS THIRD WORD AND PROCEEDING TO THE 240TH WORD OF THE BLOCK /A003 / THEN PROCEED TO THE 3RD WORD OF THE FOURTH HEADER BLOCK. /A003 / THE FIRST 43 WORDS OF THE FIRST HEADER BLOCK CONTAIN OTHER /A003 / INFORMATION ABOUT THE DOCUMENT INCLUDING BLOCK POINTERS TO THE /A003 / SECOND AND THIRD HEADER BLOCKS. THE THIRD HEADER BLOCK HAS /A003 / BLOCK POINTERS TO THE 4TH THRU 17TH BLOCKS OF THE DOCUMENT IN /A003 / ITS 241ST THRU ITS 254TH WORD. THE FIRST 2 WORDS OF EACH BLOCK /A003 / ARE INITIALIZED FOR COS 310 COMPATIBILITY. /A003 / /***********************************************************************/A003 SCBOTP, XX /A003 CLA / CLEAR OUT AC /A003 TAD I SCBOTP / GET DIPLACEMENT /A003 DCA BDISP / PUT DISPLACEMENT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF WE MUST ADD 16(OCTAL) /A003 SCBTH / PTR TO HEADER POINTER /A003 SCBOT / PTR TO HDR WORD POINTER /A003 BDISP, 0 / SPOT TO PASS DISPLACEMENT /A003 TAD BDISP / GET NEW DISPLACEMENT /A003 DCA BDISP2 / PUT IT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 SCBTH / HEADDER POINTER /A003 SCBOT / HEADER WORD POINTER /A003 BDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 ISZ SCBOTP / BUMP TO RETURN ADDR /A003 JMP I SCBOTP / RETURN /A003 SCTOPP, XX / INCREMENT TOP POINTERS /A003 CLA / CLEAR AC /A003 TAD I SCTOPP / GET DISPLACEMENT /A003 DCA TDISP / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO ADD 16(OCTAL) IF NEEDED /A003 SCTPH / HEADER POINTER /A003 SCTOP / HEADER WORD POINTER /A003 TDISP, 0 / PLACE FOR DISPLACEMENT /A003 TAD TDISP / GET NEW DISPLACEMENT /A003 DCA TDISP2 / PUT IT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT PTR BY DISPLACEMENT /A003 SCTPH / HEADER POINTER /A003 SCTOP / HEADER WORD POINTER /A003 TDISP2, 0 / DISPLACEMENT TO INCREMENT BY /A003 ISZ SCTOPP / BUMP UP TO RETURN ADDR /A003 JMP I SCTOPP / RETURN /A003 / during the OPEN process, clear the header block ptrs. left / from the previous document, or else hdr. blocks belonging / to a previous document may be de-allocated during the OPEN / of the current document.... /A024 CLPTRS, 0 /SAVE CALLER'S RETURN ADDR. /A024 TAD (SCBFCB /ADDR. OF START OF DOC. BLOCK-PTR TABLE /A024 DCA X1 /POINTS AT TABLE ENTRY TO CLEAR /A024 TAD (RPBFCB /ADDR. OF START OF GOTO PAGE BLOCK-PTR TABLE /A024 DCA X2 /POINTS AT TABLE ENTRY TO CLEAR /A024 BLKINT, DCA I X1 /CLEAR A HDR-BLK-PTR /A024 DCA I X2 /SAME WITH PARRELLEL GOTO PAGE STRUCTURE /A024 TAD (-SCHDMD /ADDR. AT END OF TABLE TAD X1 /COMPARE TO LOC. JUST CLEARED /A024 SZA CLA /SKIP IF BOTH TABLES CLEARED /A024 JMP BLKINT /JUMP TO CLEAR ANOTHER ENTRY /A024 JMP I CLPTRS /EXIT WITH BOTH TABLES EMPTY /--------------- PAGE SCTPBT, XX / ROUTINE TO DETERMINE IF BOTTOM = /A003 AC7777 / GET ONE INTO AC /A003 DCA SCBT3 / PUT IT INTO CALLING LIST /A003 TAD SCBOT / TOP + 1. GET BOT HDR PTR /A003 DCA SCBOTT / PUT IT IN CALL LIST /A003 TAD SCBTH / GET BOTTOM HDR PTR /A003 DCA SCBTHT / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF NEDDS ADD 16(OCTAL) /A003 SCBT1, SCBTHT / HDR POINTER /A003 SCBT2, SCBOTT / HDR WORD POINTER /A003 SCBT3, 1 / INCREMENT BOTTOM BY 1 /A003 TAD SCBT3 / GET INCREMENTED INCRMENT AMT /A003 DCA SCBT6 / PUT INTO INCREMENT CALL LIST /A003 JMS SCINC / GO INCREMENT IT /A003 SCBT4, SCBTHT / HEADER POINTER /A003 SCBT5, SCBOTT / HEADER WORD POINTER /A003 SCBT6, 0 / INCREMENT AMOUNT /A003 TAD SCBTHT / GET INCR'TED HDR PTR /A003 CIA / COMPLEMENT AND INCREMENT IT /A003 TAD SCTPH / ARE BOTTOM AND TOP EQUAL /A003 SZA / IF YES GO SEE IF WORD PTRS EQUAL /A003 JMP SCTB2 / ELSE, NOT EQUAL, 2 ISZ'S AND RETURN /A003 TAD SCBOTT / GET HDR WORD PTR OF BOTTOM /A003 CIA / COMP AND INC IT FOR SUBTRACT /A003 TAD SCTOP / GET TOP HDR WORD PTR AND ADD IT IN /A003 SNA / IF NOT EQUAL, 2 ISZ'S AND OUT /A003 JMP SCTB1 / IF EQUAL, GO ALLOCATE 1 ISZ AND OUT /A003 SCTB2, ISZ SCTPBT / NORMAL RETURN - NO ALLOCATE /A003 SCTB1, / ALLOCATE RETURN /A003 JMP I SCTPBT / RETURN /A003 / THIS ROUTINE WILL MOVE A FILE OVER BY THREE BLOCK NUMBERS /A003 / SO THAT THE EDIT CAN CONTINUE TO ADD TEXT TO THE FILE /A003 SCALC2, XX / RETURN ADDRESS /A003 TAD SCBTH / GET HDR POINTER /A003 DCA SCBTHT / PUT HDR PTR TO NEW PTR /A003 TAD SCBOT / GET BOTTOM HDR WORD PTR /A003 DCA SCBOTT / PUT IT INTO NEW HDR WORD PTR /A003 /D047 IFDEF STATLN < /A043 JMS SCBOTP / GO BUMP UP POINTERS BY ONE /A043 1 / NUMBER TO BUMP UP BY /A043 /D047 > / END IFNDEF STATLN /A043 /D047 IFNDEF STATLN < /A043 /D047 JMS SCBOTP / GO BUMP UP POINTERS BY THREE /A003 /D047 3 / NUMBER TO BUMP UP BY /A003 /D047 > / END IFNDEF STATLN /A043 SCALCX, JMS SCGETR / GO GET BLOCK - 1 /M047 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 JMS SCPUTR / GO PUT THE BLOCK GOTTEN TO BL +3 /A003 SCBTH / HDR PTR /A003 SCBOT / HDR WORD PTR /A003 JMS SCBOTP / GO DECREMENT POINTERS /A003 -1 / AMOUNT TO DECREMENT BY /A003 AC7777 / MINUS 1 TO AC /A003 DCA SCALCY / PUT DEC VALUE IN CALL LIST /A003 JMS SCAD16 / GO SEE IF WE NEED TO ADD 16(IN 3RD HDR/A003 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 SCALCY, 0 TAD SCALCY / GET DISPLACEMENT /A003 DCA SCALCZ / PUT IT IN CALL LIST /A003 JMS SCINC / GO INCREMENT IT /A003 SCBTHT / HDR PTR /A003 SCBOTT / HDR WORD PTR /A003 SCALCZ, 0 / DISPLACEMENT AMOUNT /A003 ISZ SCALC / ARE WE DONE? /A003 JMP SCALCX / NO GO DO IT AGAIN /A003 JMP I SCALC2 / GO BACK /A003 /SCBTHT, 0 / TO SAVE POINTERS /D022 /SCBOTT, 0 / TO SAVE POINTERS /D022 /*********************************************************************/A003 / /A003 / THIS ROUTINE WILL FREE UP BLOCK NUMBERS THAT HAVE BEEN ASSIGNED /A003 / TO THE DOCUMENT AS HEADER EXTENSIONS. THEN IT WILL UPDATE THE /A003 / HEADERS SO THAT THEY HAVE ONLY HEADERS THAT ARE USED /A003 / /A003 /***********************************************************************/A003 SCCLSE, XX / ROUTINE TO FREE UP UNUSED HEADER BLOCKS /A003 JMS PSTBOT /GO POSITION TO BOTTON OF DOC. TAD SCHDBN / GET TO HEADER BLOCK NUMBER POINTER /A003 DCA X1 / PUT IT INTO INDEX 1 /A003 TAD SCHDBN / GET HEADER BLOCK NMBR PTR (FOR CLEARINGSCBOTT /A003 DCA X2 / PUT CLEARER INTO INDEX 2 /A003 SCCLSF, TAD I X1 / GET BLOCK NUMBER TO FREE UP /A003 SNA / IF IT ISN'T 0, THEN FREE IT /A003 JMP SCCLSG / IF ZERO, THEN GO SEE IF DONE /A003 JMS SCQRX / GO FREE UP THE BLOCK NUMBER /A003 RXEFR /A003 0 /A003 AC7777 / -1 /M032 DCA RPEXTR / SET TO INDICATE FREE-ING HDR BLK /M032 JMS RPFRBK / GO FREE GTP HDR BLOCK /A032 DCA I X2 / CLEAR OUT HDR CONTROL BLOCK /A003 SCCLSG, / SET UP TO SEE IF DONE /A003 TAD (SCHDMD-2) / GET ADDR OF LAST ENTRY IN TABLE /A003 CIA / MAKE IT ZERO /A003 TAD X1 / GET ADDR INDEX 1 POINTS TO /A003 SZA CLA / RESULT ZERO IF DONE /A003 JMP SCCLSF / LOOP AROUND TO NEXT ONE /A003 / NOW WE MUST UPDATE THE HEADERS WITH THE NEW BLOCK NUMBERS /A003 TAD (SCHDRB) / GET ADD OF HEADER BLOCK NBR TABLE /A003 DCA X1 / PUT IT INTO INDEX 1 /A003 TAD T360 / HEADER WORD POINTER FOR 3RD HDR BLOCK /M014 DCA SCCLSC / PUTIT HERE TO ISZ IT /A003 TAD M16 / NUMBER OF HEDR EXTENSION /M014 DCA SCCLST / PUT IT HERE TO ISZ THRU /A003 TAD RPHDRB+1 /RPPGDS 2ND HDR /A014 DCA RPPTR1 /SUPPLT FOR RPPGDS SCPUTR /A014 TAD I X1 / GET THE BLOCK NUMBER 2ND HDR /A003 JMS SCPUTR / GO PUT IT INTO HDR 1 /A003 ONE / INDICATE HEADER 1 /A003 ZERO / INDICATE WORD 2 OF THE HEADER /A003 TAD RPHDRB+2 /RPPGDS 3RD HDR /A014 DCA RPPTR1 /SUPPY FOR RPPGDS SCPUTR /A014 TAD I X1 / GET 3RD HDR BLOCK NBR /A003 JMS SCPUTR / GO PUT IT INTO HEADER /A003 ONE /A003 ONE /A003 TAD SCHDRB+2 / GET THE THIRD HEADER BLOCK NUMBER /A022 SNA CLA / HAS IT BEEN DEALLOCATED? /A022 JMP I SCCLSE / YES, THEN WE'RE ALL DONE /A022 SCCLSH, / LOOP TO DO 3RD HEADER EXTENSION HDR BLOCK NBRS /A003 JMS RPEXTN /GET RPPGDS EXTN. BLK # INTO RPPTR1 /A014 TAD I X1 / GET THE 4TH, 5TH, 6TH, ETC HDDR BLCK NBR /A003 JMS SCPUTR / GO PUT IT INTO THE 361TH, 362TH, 363RD /A003 THREE / ETC, WORD OF HEADER 3 /A003 SCCLSC / HDDR WORD PTR /A003 ISZ SCCLSC / INCREMENT THE HDR WORD POINTER /A003 ISZ SCCLST / INCREMENT LOOP CONTROL /A003 JMP SCCLSH / GO DO IT AGAIN AND AGAIN 'TIL DONE /A003 SCCEXT, JMP I SCCLSE / ALL DONE, RETURN /A003 SCCLST=SCBOTTS / USED FOR LOOP CONTROL /A003 SCCLSC=SCBTHT / USED AS HDR WORD PTR FOR HDR EXTENS /A003 /--------------- PAGE /***********************************************************************/A003 / / THIS ROUTINE POSITIONS THE HEADER POINTERS IN ORDER TO READ THE /A003 / FILES DURING EDITING. THESE POINTERS ARE INITIALIZED THE WAY /A003 / THE USER WANTS TO EDIT THE FILE. IF HE WANTS TO REPLACE THE /A003 / THE ENTIRE DOCUMENT HE PASSES A MINUS 1 IN SCOPTN. IN THIS CASE /A003 / THE TOP POINTERS WILL POINT TO THE FIRST BLOCK NUMBER OF THE /A003 / FILE AND THE BOTTOM POINTERS WILL POINT TO THE BOTTOM (LAST) /A003 / BLOCK NUMBER OF THE FILE. IF THE USER WISHES TO APPEND TO THE /A003 / EXISTING DOCUMENT, THEN THE TOP POINTERS WILL POINT TO THE LAST /A003 / BLOCK NUMBER OF THE FILE, AND THE BOTTOM POINTERS WILL POINT TO /A003 / THE NEXT BLOCK NUMBER (WHICH IS EMPTY). TO DO THIS, THE USER /A003 / PASSES A PLU 1 IN SCOPTN. IF SCOPTN CONTAINS A ZERO, THEN /A003 / NORMAL PRCESSING IS INDICATED, AND THE TOP POINTERS POINT TO /A003 / THE FIRST BLOCK NUMBER OF THE FILE AND THE BOTTOM POINTER POINTS/A003 / TO THE SECOND BLOCK NUMBER OF THE FILE. /A003 / /***********************************************************************/A003 SCFLZB, XX / RETURN ADDRESS /A003 TAD SCOPTN / IS THIS A NORMAL EDIT RUN? /A003 SNA CLA / IF IT IS, GO PROCESS NORMAL /A003 JMP SCFLNR / GO PROCESS NORMAL EDIT SESSION /A003 TAD SCFILZ / GET FILE SIZE /A003 SMA / HOW BIG IS IT? IS IT > 2048? /A003 JMP SCFLZ / IF < 2048, THEN DON'T SPLIT IT UP /A003 TAD P3777 / IF > 2048, TAKE OUT 2047 /A003 DCA SCFLZ2 / STORE REMAINDER FOR SEC LOOP CTL /A003 TAD P3777 / GET LOOP CONTROL FIRST LOOP /A003 DCA SCFLZ1 / STORE IT FOR LOOP CTL /A003 JMP SCFLZO / GO FIND END OF DOCUMENT /A003 SCFLNR, / PROCESS NOROMAL EDIT /A003 TAD (SCBKOF) / DIPLACEMNT TO 1ST BLOCK NBR IN 1ST HDR/A003 DCA SCTOP / PUT IT INTO TOP POINTER PAIR /A003 TAD SCTOP / GET SAME FOR BOTTOM POINTER /A003 DCA SCBOT / INITIALIZE BOTTOM POINTER /A003 IAC / GET A ONE INTO AC /A003 DCA SCTPH / TOP HDR PTR TO POINT TO 1ST HEADER /A003 IAC / 1 TO AC /A003 DCA SCBTH / BOT HDR PTR SAM AS TOP /A003 JMP SCFLOT / GO ADD ONE TO BOTTOM, AND GET OUT /A003 SCFLZ, DCA SCFLZ1 / ONLY ONE LOOP FOR SHORT FILES /A003 DCA SCFLZ2 / SECOND LOOP CTL= 0 /A003 SCFLZO, TAD (SCBKOF) / DISP TO 1ST BLK NBR IN 1ST HDR /A003 DCA SCTOP / PUT IT IN TOP POINTER /A003 IAC / GET A 1 /A003 DCA SCTPH / TO HDR POINTER /A003 TAD SCFLZ1 / GET 1ST LOOP CTL /A003 SNA / SKIP IF THERE IS A FILE SIZE. /A006 JMP SCFLX / IF FILE SIZE IS 0 THEN WE ARE DONE!!! /A006 CIA / MAKE IT MINUS /A003 DCA SCFLZ1 / STORE IT AGAIN /A003 SCFLZF, JMS SCTOPP / TOP OF 1ST LOOP, GO ADD 1 TO IT /A003 1 /A003 ISZ SCFLZ1 / 1ST LOOP CONTROL INCREMENT /A003 JMP SCFLZF / GO DO I T AGAIN /A003 TAD SCFLZ2 / GET SECOND LOOP CTL /A003 SNA / BYPASS IF ZERO /A003 JMP SCFLX / IF ZERO, BYPASS 2ND LOOP /A003 CIA / MAKE NEGATIVE FOR ISZ /A003 DCA SCFLZ2 / STORE FOR USE /A003 SCFLZT, JMS SCTOPP / TOP OF 2ND LOOP, GO ADD 1 TO TOP PTRS /A003 1 /A003 ISZ SCFLZ2 / IF ZERO, THEN WE'RE ALL DONE /A003 JMP SCFLZT / GO ADD ANOTHER 1 IF NOT ZERO /A003 SCFLX, TAD SCTOP / GET TOP HDR WORD POINTER /A003 DCA SCBOT / PUT IT INTO BOTTOM PTR /A003 TAD SCTPH / GET TOP HDR PTR /A003 DCA SCBTH / PUT IT INTO BOTTOM HDR PTR /A003 TAD SCOPTN / GET OPTIONS PASSED /A003 SMA CLA / IF NEGATIVE, THE RESET TOP /A003 JMP SCFLOT / IF NOT, GO BUMP UP BOTTOM PTRS /A003 TAD (SCBKOF) / MAKE TOP POINT TO FIRST BLK NBR /A003 DCA SCTOP / TOP HEADER WORD POINTER /A003 IAC / GET A 1 /A003 DCA SCTPH / TOP HEADER POINTER TO POINT TO 1ST /A003 SCFLOT, JMS SCBOTP / GO INCREMENT BOTTOM BY ONE /A003 1 /A003 JMP I SCFLZB / RETURN /A003 SCFLZ1, 0 / SPOT FOR ISZ LOOP CONTROL (1ST) /A003 SCFLZ2, 0 / SPOT FOR ISZ LOOP CONTROL (2ND) /A003 0 / THIS ROUTINE WILL GET ALL THE HEADERS FOR A READ ONLY FILE /A003 RDGTHS, XX /A003 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 ONE / INDICATE 1ST HEADER /A003 ZERO / INDICATE 1ST HDR EXTENSION /A003 DCA RDHDRB+1 / PUT IT INTO HDR CTL BLOCK /A003 JMS RDGETR / GO GET 2ND HEADER EXTENSION /A003 ONE / 1ST HDR AGAIN /A003 ONE / INDCATE 2ND HDR EXT /A003 DCA RDHDRB+2 / PUT IT INTO HDR CTL BLOCK /A003 JMS RDGETR / GO GET FILE SIZE /A003 ONE / 1ST HEADER AGAIN /A003 THREE / INDICATE FILE SIZE /A003 DCA RDFSIZ / PUT IT WHERE OTHERS CAN GET IT /A003 JMS GTHDRS / GO GET REMAINING HEADERS /A003 RDBFCB / INDICATE READ-ONLY HDR CTL BLOCK /A003 JMP I RDGTHS / GOBACK /A003 / THIS ROUTINE WILL INCREMENT THE HEADER POINTERS FOR READ-ONLY /A003 RDINC, XX /A003 AC0001 / INDICATE SIZE OF INCREMNET /A003 DCA RDINC1 / PUT IT INTO CALL LIST /A003 JMS SCAD16 / GO SEE IF YOU NEED ADD 16 (OCTAL) /A003 RDHDRP / READ-ONLY HDR POINTER /A003 RDPTRS / READ-ONLY HDR WORD PTR /A003 RDINC1, 0 / AMOUNT TO INCREMENT BY /A003 TAD RDINC1 / GET AMOUNT TO INCREMENT BY /A003 DCA RDINC2 / PUT AMOUNT INTO CALL LIST /A003 JMS SCINC / GO INCREMENT THE POINTERS /A003 RDHDRP / READ-ONLY HDR PTR /A003 RDPTRS / READ-ONLY HDR WORD PTR /A003 RDINC2, 0 / AMOUNT TO INCREMENT BY /A003 JMP I RDINC / RETURN /A003 / THIS ROUTINE WILL SEARCH FOR THE BOTTOM OF THE DOCUMENT. / IT IS USED TO MAKE SURE THAT THE HEADER POINTER IN THE SCROLL / HEADER CONTROL BLOCK IS POINTING TO THE LAST HEADER BLOCK / IN THE FILE SO THAT THE DE-ALLOCATION ROUTINE WON'T DE-ALLOCATE / ANY HEADERS THAT BELONG TO THE FILE... PSTBOT, 0 /SAVE CALLER'S RETURN ADDR. AC0001 / /A032 DCA SCBTH /START WITH 1ST HEADER /A032 TAD (SCBKOF /STARTING HEADER WORD POINTER DCA SCBOT /INTO 'BOTTOM' POINTER PSTBO1, JMS SCBOTP /GO INCREMENTT THE POINTERS 1 JMS SCGETR /GO GET A BLOCK NUMBER SCBTH SCBOT SZA CLA /SKIP IF END OF BLOCK-LIST POINTERS JMP PSTBO1 /LOOP UNTIL EOF FOUND JMP I PSTBOT /EXIT:AT END OF FILE /--------------- PAGE /***********************************************************************/a048 / WARNING do not move this routine without changing WPf1 to reflect the / address change /****************************************************************** /a048 * FBHOOK /4000 /a048 /******************************************************************** / BHOOK Hook to panel page blaster /******************************************************************** /a048 BHOOK, 0 / hook return address /a048 DCA BLACSV / save accumulator /a048 RDF / read the data field /a048 TAD CDF0 / make a cdf instruction /a048 DCA BHKEXI / save for return /a048 CDFMYF / set to hooks field /a048 TAD I BHOOK / get the table entry /a048 MQL / push into MQ /a048 TAD BLACSV / get the ac /a048 ISZ BHOOK / increment the return address /a048 CIFMNU / blaster is in the menu field /a048 IOF / turn the interrupts off before.. /a048 JMS I BLASTH / Calling blaster /a048 ISZ BHOOK / skip return exit /a048 BHKEXI, 0 / CDF instruction /a048 JMP I BHOOK / return /a048 BLASTH, BLASTR / blastr address (get from WPF1) /a048 BLACSV, 0 / ac save /a048 RPPGDS=7400 /V2.0 GOTO PAGE BUFFER AREA IN FIELD 2 / if the block just allocated and initialized was the 2nd /A014 / EXTENSION block, then words 362 to 377 must be set to 0. /A014 / these words are new V2 extension block pointers, not text /A014 / block pointers..... /A014 RPCKV2, JMS RPBFIN /SET ALL BUFFER WORDS TO -1 /M031 /EXCEPT 0 (-255), 1 (70), 2&3 (0) /M031 TAD RPHDBN /PTR. TO BLOCK JUST ALLOCATED /A014 CIA /FOR COMPARE TO /A014 TAD (RPHDRB+2 /2ND EXTENSION BLOCK /A014 SZA CLA /SKIP IF SPECIAL V2 EXTENSION BLOCK /A014 JMP RPV2EX /IGNORE ALL OTHERS /A014 TAD (RPPGDS+361 /PTR. TO WORD PRIOR TO 1ST /A014 /V2 EXTN BLOCK PTR WITHIN 3RD HDR. /A014 DCA X3 /INTO AUTO-INDEX REG. /A014 RPLPV2, CDFRPB /RPPGDS BUFFER FIELD /A014 DCA I X3 /INIT. V2 EXTN. POINTER /A014 CDFMYF /BACK FROM RPPGDS FIELD /A014 TAD X3 /POINTER TO WORD JUST INIT'D. /A014 CIA /FOR COMPARE TO /A014 TAD (RPPGDS+377 /END OF RPPGDS BUFFER /A014 SZA CLA /SKIP IF INITIALIZATION DONE /A014 JMP RPLPV2 /JUMP TO INIT. ANOTHER WORD /A014 / NEW RETURN TO WITHIN RPREAD /A031 RPV2EX, JMP REEDXT /RETURN TO CALLER /A031 RPEXTN, 0 /GET RPPGDS EXTN. BLK #'S 4-16 /A012 TAD (SCHDRB /TOP OF DOC. HDR. BLOCK-LIST /A012 CIA /FOR COMPARE TO /A012 TAD X1 /PTR. TO NEXT HDR. EXTN. PTR. /A012 TAD (RPHDRB /FIND PTR TO CORRESPONDING RPPGDS PTR /A012 DCA X2 /FOR INDIRECT /A012 TAD I X2 /GET RPPGDS EXTN BLK # /A012 DCA RPPTR1 /FOR RPPGDS PART OF SCPUTR /A102 JMP I RPEXTN /RETURN FOR SCPUTR OF HDR EXTN /A012 RPALOC, 0 /CALLER'S RETURN ADDR. /A014 TAD RPALOC /CALLER'S RETURN ADDR. /A014 DCA RPREA1 /USING PREVIOUS DESIGN /A032 JMP RPRDEX /USE CURRENT LOGIC /A014 / AC = 0 ON ENTRY /A032 RPFRBK, 0 /CALLERS RETURN ADDRESSS /A022 TAD (SCHDBN /HDR BLK TO BE RELEASED /A022 CIA /MAK NEG FOR OFFSET /A022 TAD X1 /OFFSET INTO SCHDBN /A022 TAD (RPHDBN /GET SAME OFFSET INTO RPHDBN /A022 DCA RPFRB2 /SAVE /A022 TAD I RPFRB2 /SUPPLY BLOCK # TO BE FREED /A022 JMS RPDSFR /AC = BLK # (AC=0 ON RETURN) /A022 DCA I RPFRB2 /CLEAR POINTER FROM TABLE /A022 /LEAVE DEALLOCATE FLAG ON TO SIGNIFY CLOSE-OPERATION WHEN /READING 1ST GOTO-PAGE HEADER BLOCK /A023 RPFRB1, JMP I RPFRBK /RETURN /A022 RPFRB2, 0 /POINTER TO BLOCK TO BE FREED /A022 / here when writing to ETX buffer and PRINT-CONTROL char. recognized / on entry, AC = RPMODE word... CHKETX, SNA CLA /SKIP IF END-CONTROL /A030 JMP DOSTRT /GO PROCESS START-CONTROL /A030 TAD (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 AND I T3 /IN THE CURRENT DESCRIPTOR /A030 TAD P100 /NOW SET 'IN CONTROL-AREA'FLAG /A030 DCA I T3 /WITHIN THE CURRENT DESCRIPTOR WORD /A030 JMP TODSBDEX /GO SET OUR OWN PRINT-CONTROL-FLAG /A030 /This routine is entered when it's determined that a PUT to the STX / buffer has occurred. more specifically, a print control char is / being put - 030 CHKSTX, TAD (200 /CHECK TO SEE IF THIS PRINT CONTROL /A030 AND RPMODE /IS AN END PRINT CONTROL /A030 SNA CLA /SKIP IF: END PRINT CONTROL /A030 TODSBDEX,AC0100 /PRINT CONTROL WAS A START. SET /A030 /FLAG TO INDICATE WITHIN CONTROL AREA /A030 DCA RPPCTLFL /UPDATE CONTROL AREA FLAG /A030 /Here when writing to STX buffer. check flag, if on: have already / processed a print control char in the buffer - stop / if off: process this print control char as it is the first print / control char in the STX buffer CHKST1, TAD SOMFLG / CHECK THE STATE OF FLAG /A030 SZA CLA / SKIP IF: NOT ON /A030 JMP DSBDEX / HAVE BEEN THROUGH ONCE, EXIT /A030 CHKST2, TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 AND (7677 /CLEAR 'IN CONTROL-AREA' FLAG /A030 DCA I T3 /UPDATE CURRENT DESCRIPTOR WORD /A030 /come here if writing print control char to STX buffer (and is the first / print control char in the buffer). set bit5 in the descriptor to be / the opposite state as that of the print-control area flag. CHKST3, TAD RPPCTLFL /PRINT-CONTROL AREA FLAG /A030 CMA /OPPOSITE STATE /A030 AND P100 /SAVE FLAG ONLY /A030 TAD I T3 /MERGE WITH DESC. WORD /A030 DCA I T3 /UPDATE DESC. WORD /A030 AC0001 /SET FLAG TO INDICATE THAT /A030 DCA SOMFLG /A PRINT CONTROL CHAR WAS /A030 /PROCESSED WITHIN THIS BUFFER /A030 JMP DSBDEX /RETURN /A030 /The following routine entered when writing to ETX buffer and a / start print control char is encountered DOSTRT, TAD (7677 /MASK OUT BIT 5 IN THE DESCRIPTOR /A030 AND I T3 /WORD /A030 DCA I T3 /UPDATE THE DESCRIPTOR WORD /A030 DCA RPPCTLFL /CLEAR THE PRINT CONTROL AREA FLAG /A030 /TO INDICATE NOT IN A CONTROL AREA /A030 JMP DSBDEX /RETURN /A030 / This subroutine checks to see if the character just PUT was a / Page Marker of New Page. If so, increment T3, then check to / make sure that no more than 36 Pages/New Pages are in the / buffer. Only 5 bits are designated as page counters in the / GTP descriptor word, if the number of pages overflows 5 bits, / the entire descriptor word could be ruined / CHKPAG, XX / SUBROUTINE TO CHECK FOR PAGE/NEW-PAGE /A028 TAD NWPAGE /IS IT A NEW PAGE? /A018 SZA /SKIP IF SO /A018 TAD PAGEMK /IS IT A PAGE MARKER? /A018 SNA CLA / SKIP IF: NEITHER /A032 ISZ I T3 / ACCOUNT FOR PAGE IN SCROLL BUFFER /A032 TAD I T3 / GET # OF PAGES IN SCROLL BUFFER /A032 TAD (-36 / COMPARE TO MAX. # OF ALLOWABLE PGS. /A032 SNA CLA / SKIP IF: WITHIN LIMITS /A032 AC0001 / AT MAX. SET FLAG IN ORDER TO PAD BUF /A032 DCA PAGLIM / 0 = WITHIN RANGE /A032 / 1 = AT MAXIMUM /A032 JMP I CHKPAG / RETURN TO CALLER. /A028 /--------------- PAGE / here after WPFILS requested a read io / get the "scroll" buffer address used for the read io / / IF this is not the main document header block, then go read / the parrellel 'extension' block / ELSE read the RPPGDS link word in the main document header / block / / IF the link word is empty, then this document never had a RPPGDS / block allocated to it. Go allocate one and attach it to the / main document header block / ELSE verify that the RPPGDS block linked to this document / is a valid up-to-date reflection of the text block content / /******************************************************************* /A039 /******************************************************************* /A039 /******************************************************************* /A039 /**** **** /A039 /**** NOTE **** /A039 /**** **** /A039 /**** THIS ROUTINE COUNTS ON THE FACT THAT THE DISK OPEN **** /A039 /**** COMMAND IS THE FIRST ENTRY IN THE XFLDTB TABLE **** /A039 /**** **** /A039 /******************************************************************* /A039 /******************************************************************* /A039 /******************************************************************* /A039 RPREA1, XX /SAVE CALLERS RETURN ADDRESS /A032 TAD XFILT3 /GET POINTER TO WPFILS ACTIVE FUNCTION /M039 CIA /NEGATE IT FOR FOLLOWING COMPARE /A039 TAD XFLDTB /COMPARE TO ADDRESS AT 'OPEN' COMMAND /M039 SZA CLA /SKIP IF DOING 'OPEN' /A034 JMP RPRDEX /SKIP VERIFICATION /A034 TAD SCQBLK+RXQBLK /DOC. HDR. BLOCK # JUST READ /M012 CIA /FOR COMPARISION TAD SCHDRB /BLK# OF DOC. MAIN HEADER /A034 SZA CLA /SKIP IF MAIN HEADER JMP RPRDEX /GO READ PARALLEL RPPGDS EXTN. BLOCK / (could be OPENing this document for the first time....) CDFBUF /CHANGE TO SCROLL BUFFER FIELD TAD I (SCHDR+1 /2ND WORD OF DOC. HEADER /A029 CLL RAR /TEST STATE OF BIT11 /A029 SZL CLL /SKIP IF NO G-T-P BLOCK /A029 JMP RPRDDS /GO READ THE PARELLEL RPPGDS MAIN BLOCK CML RAL /GET READY TO /A029 DCA I (SCHDR+1 /SET BIT11 (NOW HAVE A G-T-P BLOCK) /A029 / this document was never used with a V2 WPS, thus, it has no / RPPGDS block / allocate a block for the main RPPGDS descriptor block / account for this allocation in SPCSPF / link the RPPGDS block to the doc. header block by storing / the RPPGDS block # in the 43rd (dec.) word of the header block / update "main RPPGDS" block # storage word with the block # returned / from the allocation request / update "current RPPGDS" block pointer with the pointer to the / "main RPPGDS" block # storage word JMS RPALLOCATE /GO ALLOCATE A BLOCK FOR G-T-P /M029 CDFBUF /CHANGE TO BUFFER FIELD DCA I (SCHDR+53 /LINK RPPGDS TO DOC. HEADER TAD I (SCHDR+53 /GET OUR BLK# BACK CDFMYF /BACK TO THIS FIELD DCA RPHDRB /COPY IN RPPGDS BLOCK TABLE JMS WRITEOUT /WRITE OUT THE ALLOCATION BLK. /A031 RPMAIN, TAD (RPHDRB /ADDR. OF MAIN RPPGDS BLOCK RPRD2, /ENTER HERE TO SET RPHDBN /M030 DCA RPHDBN /IS NOW THE ACTIVE RPPGDS BLOCK / a block has been allocated either for the main RPPGDS block, / or one of its' extensions. / initialize the RPPGDS scroll buffer (7400) to reflect this new / block. / the content of this buffer will be written when the associated / doc. header block is written. JMP RPCKV2 /IS THIS 2ND EXTN. BLOCK? /M031 RPRDND, /END OF READ; RPPGDS CONTAINS NEW BLOCK REEDXT, JMP I RPREA1 /RETURN TO CALLER /M032 / this document has a V2.n RPPGDS linked to it; meaning that it / it has been OPENed by a V2.n WPS system... / / read the RPPGDS block into its scroll buffer (7400) and verify / that it contains up-to-date text block desciptors. / / IF AC = 0 after RPRDIT (verification) RPPGDS descriptors can be use / ELSE RPPGDS does not contain up-to-date text block descriptors. / Deallocate any RPPGDS extension blocks and initialize / the main RPPGDS block. RPRDDS, /AC = NEW MAIN DESC. BLK. # /M019 CLA /CLEAR AC HERE TO /A029 TAD I (SCHDR+53 /GET G-T-P BLOCK # /A029 JMS RPRDIT /READ/VERIFY IT MQL /SAVE VERIFY RESULT /A019 TAD NEWBLK /GET THE NEW DESC. BLK. # /A019 DCA RPHDRB /PUT IT IN BLOCK-TABLE /A019 RPEXT, /GOOD BLOCK; MAKE IT THE 'CURRENT' ONE /WRITE-BEFORE-READ FLAG IS SET TAD (RPHDRB /ADDR OF MAIN RPPGDS BLK. IN BLOCK TABLE/M011 DCA RPHDBN /MAKE MAIN RPPGDS BLOCK THE CURRENT BLOCK/M011 / OPENING..... / supply RPPGDS extension block numbers, if any... CDFRPB /RPPGDS BUFFER FIELD TAD I (RPPGDS+2 /1ST EXTN. BLOCK # OR 0 CDFMYF /BACK TO THIS FIELD DCA RPHDRB+1 /INTO OUR CONTROL TABLE CDFRPB /RPPGDS BUFFER FIELD TAD I (RPPGDS+3 /2ND EXTN. BLOCK # OR 0 CDFMYF /BACK TO THIS FIELD DCA RPHDRB+2 /INTO OUR CONTROL TABLE MQA /REPLACE RESULT OF VERIFY(RPRDIT) /A019/M031 SNA CLA /SKIP IF ITS CORRUPTED /M031 JMP REEDXT /GOOD MAIN-GTP BLK; EXIT /A032 JMS RPDSCR /DE-ALLOC. RPPGDS EXTN, IF ANY /M031 JMP RPMAIN /RE-INIT. MAIN RPPGDS BLOCK/ /M031 / a document header extension block has been read. / / identify which extension and determine if the RPPGDS block / has a parrellel extension available. / / if not, allocate a block for an extension and initialize the / the RPPGDS scroll buffer to reflect the new block. / link the new extension to the RPPGDS block table and make the / new extension the "active" block. / / if extension already present, read it into the RPPGDS scroll buffer RPRDEX, /HERE WHEN THE PARALLEL BLOCK IS AN EXTN. TAD SCHDBN /PTR. INTO DOC. HDR. BUFFER CONTROL AREA TAD (-SCHDRB /MINUS THE START OF THE CONTROL AREA TAD (RPHDRB /PLUS THE START OF THE RPPGDS CONTROL AREA DCA EXTNOF /= PTR. TO PARRELLEL RPPGDS BLOCK # TAD I EXTNOF /GET THE BLOCK # OF THE PARRELLEL RPPGDS BLOCK SNA /SKIP IF THERE IS A BLOCK # AVAILABLE JMP RPALEX /AC => 0; NO BLOCK AVAILABLE JMS RPRDIT /AC => BLK #; READ THE BLOCK SNA CLA /SKIP IF RPPGDS BLOCK CORRUPTED JMP RPXEX /EXIT:PARRELLEL RPPGDS BLOCK IN BUFFER (7400) TAD I EXTNOF /SUPPLY THE BLOCK # JMS RPDSFR /DE-ALLOCATED THE CORRUPTED BLOCK / Here to allocate a block for the RPPGDS. / Put the block # returned (allocated) into the appropriate / RPPGDS block table entry and make this block the "current" / current block. / Go and initialize our scroll buffer (7400) to reflect a new / unused block. RPALEX, JMS RPALLOCATE /GO ALLOCATE AN EXTN. BLOCK /A029 DCA I EXTNOF /PUT IT IN RPPGDS BLK TABLE AT EXTN. ENTRY / A BLOCK WAS JUST ALLOCATED, SO WRITE-OUT THE ALLOCATION BLOCK /A031 JMS WRITEOUT /WRITE-OUT THE ALLOCATION BLOCK /A031 / supply the link to the 1st and 2nd extension blocks now... JMS RPWRTH /WRITE OUT CURRENT GTP BLK /A034 RPLNK, TAD EXTNOF /POINTER TO CURRENT TABLE ENTRY /A034 JMP RPRD2 /INIT. RPPGDS EXTN. BLOCK IMAGE RPXEX, TAD EXTNOF /CONTROL TABLE ENTRY POINTER DCA RPHDBN /MAKE THIS EXTN. THE CURRENT BLOCK JMP REEDXT /EXIT:EXTN. IN BUFFER /A032 RPALLOCATE, XX /GET A BLOCK FOR THIS DOC. /A029 JMS RPQRX /INTERNAL REQ. TO ALLOC. A BLOCK /A029 RXEAL /FC5=ALOOCATE A BLOCK /A029 0 /NO BUFFER NECESSARY /A029 JMS SCSPC /UPDATE # OF FREE BLOCK ON DISKETTE /A029 /SPCSPF IN PAGE 0 TAD SCQBLK+RXQBLK /GET THE BLK# JUST ALLOC. /A029 JMP I RPALLOCATE /RETURN WITH AC = BLOCK # /A029 /--------------- PAGE / here after a block has been written. / / IF THE BLOCK JUST WRITTEN WAS THE DOC. HEADER BLOCK (CLOSE), / WRITE THE MAIN RPPGDS BLOCK AFTER INITIALIZING APPROPRIATE / IDENTIFICATION WORDS / / ASSUMPTION: IF THE DOC. HEADER BLOCK WAS IN THE SCROLL BUFFER / THEN THE PARALLEL RPPGDS BLOCK WAS CO-RESIDENT / RPWRTH, XX /A034 TAD RPWRTH /GET CALLER'S RETURN ADDR. /A034 DCA RPWRT /USE IT FOR THIS RETURN /A034 JMP RPWRTO /NOW GO WRITE BLOCK /A034 RPWRT, XX /A032 TAD SCQBLK+RXQBLK /BLK# JUST WRITTEN CIA /FOR COMPARE TO TAD I (SCHDRB /DOC. HDR. BLK. # SZA CLA /SKIP WITH MAIN HDR. BLK. JMP RPWRTO /GO DO PARALLEL EXTENSION BLK / before writting the MAIN RPPGDS block, update the identifiaction / words... CDFBUF /BUFFER FIELD TAD I (SCHDR+5 /# OF BLKS. ALLOCATED TO THIS DOC. CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+5 /UPDATE NEW DATA STRUCTURE CDFBUF TAD I (SCHDR+10 /DAY-MONTH OF LAST EDIT CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+10 /SAME HERE CDFBUF TAD I (SCHDR+11 /LAST 2 DIGITS OF YESR CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+11 /SAME HERE CDFBUF TAD I (SCHDR+12 /START TIME OF LAST EDIT CDFRPB /OUR BUFFER FIELD DCA I (RPPGDS+12 /SAME HERE CDFMYF /BACK TO OUR FIELD / now write out the buffer to update the RPPGDS MAIN block... / write the "current" block to disk after clearing its' modified bit RPWRTO, /WRITE THE RPPGDS BLOCK TO DISK TAD I RPHDBN /GET THE RPPGDS BLOCK # JMS RPQRX /WRITE OUT A RPPGDS BLOCK RXEWT+2000 /FC 4 = WRITE/VERIFY RPPGDS /BLOCK IMAGE FROM THIS BUFFER JMP I RPWRT /EXIT:PARALLEL RPPGDS BLK WRITTEN /A032 / a descriptor word has been built (RPDSBD) depicting the / positioning information contained within the text block / just written to disk... / if the scroll buffer just used was the STX buffer, then / use SCTOP for offset into RPPGDS for descriptor word location / else use SCBOT for offset RPDSWD, /UPDATE RPPGDS 0 /SAVE CALLERS RETURN ADDR. TAD SCQBLK+RXQBAD /BUFFER JUST USED FOR IO TAD (-SCTB /COMPARE TO TOP (STX) SZA CLA /SKIP IF STX TO USE SCTOP AC0001 /WANT SCBOT FOR BOTTOM (ETX) TAD (SCTOP-1 /POINT TO BLOCK OFFSET DCA X3 /INIT. TO BLOCK OFFSET JMS RPDSW1 /GET MODE OF CHARACTER /A017 TAD I X3 /GET THE CURRENT BLOCK OFFSET A1, TAD M376 /MINUS # OF WORDS IN A BLOCK (254) SMA /SKIP WITH DESCRIPTOR PTR -400 JMP A1 /BIG DOC., REPEAT TAD T400 /CONVERT TO POSITIVE WORD OFFSET /AC = OFFSET TO BLOCK JUST WRITTEN TAD (RPPGDS /PLUS START OF OUR SCROLL BUFFER DCA DESCOF /DESCOF => PTR TO APPRO. DESCRIPTOR TAD I T3 /GET CURRENT DESCRIPTOR WORD /A030 CDFRPB /GET TO OUR BUFFER FIELD DCA I DESCOF /UPDATE DESCRIPTOR WORD IN SCROLL BUFFER CDFMYF /BACK TO OUR FIELD DCA I T3 /CLEAR DESC. SAVE AREA FOR NEXT /A030 JMP I RPDSWD /EXIT: BUFFER UPDATED; WRITE OUT / OUR BUFFER WHEN PARELLEL DOC. HDR. BLK. GET'S WRITTEN OUT DESCOF, 0 /RPPGDS BUFFER DESCRIPTOR WORD OFFSET /RPPGDS SCROLL HEADER BUFFER CONTROL AREA: RPBFCB, RPPGDS /SCROLL BUFFER ADDRESS IN FIELD 2 RPHDBN, 0 /POINTER TO CURRENT RPPGDS BLOCK IN THE BUFFER : /THE POINTER IS ADDR. OF ONE OF THE FOLLOWING RPHDRB, 0 /FIRST HEADER BLOCK NUMBER 0 /SECOND 0 /THIRD 0 /SO ON TO THE 17TH 0 0 0 0 0 0 0 0 0 0 0 0 0 0 RPHMD, 0 /TERMINATOR /M007 WRITEOUT, XX /SAVE CALLERS RETURN ADDRESS /A031 JMS RPQRX /WRITE THE ALLOCATION BLOCK /A031 RXERT /FC 0 /A031 0 /DUMMY BUFFER ADDRESS /A031 JMP I WRITEOUT /RETURN TO CALLER /A031 CKSAME, XX /ROUTINE TO CHECK TO SEE IF THE DOCUMENT/A044 /HEADER BLOCK TO BE RESTORED DURING A /A044 /RESTORE SYSTEM FILE POINTERS CALL IS /A044 /ALREADY IN CORE /A044 DCA T1 /SAVE THE ONE WE WANT /A044 TAD T1 /GET IT BACK AND /A044 CIA /NEGATE IT /A044 TAD SCHDBN /ADD IN THE ONE WE HAVE ALREADY /A044 SNA CLA /SKIP IF THEY ARE DIFFERENT /A044 ISZ CKSAME /ELSE TAKE THE SKIP RETURN TO BYPASS /A044 / ..THE UNNECESSARY READ /A044 TAD T1 /GET THE HDR BLK # WE WANT BACK /A044 DCA SCHDBN /& PUT IT IN AS THE CURRENT /A044 JMP I CKSAME /RETURN TO CALLER /A044 /--------------- PAGE / here to make a request for IO... / RPQRX, 0 /INTERNAL CALLER'S RETURN ADDR. CDFMYF /HERE FOR ROOM /A029 DCA SCQBLK+RXQBLK /BLOCK #, IF THERE IS ONE TAD (CDFRPB) / GET RPPGDS BUFFER FIELD. /M028 DCA SCQBLK+RXQBFD /SUPPLY FIELD TAD I RPQRX /GET FUNCTION CODE DCA SCQBLK+RXQFNC /SUPPLY FUNCTION CODE ISZ RPQRX /BUMP TO GET BUFFER ADDR. TAD I RPQRX /GET RPPGDS BUFFER ADDR. DCA SCQBLK+RXQBAD /SUPPLY BUFFER ADDR. ISZ RPQRX /BUMP TO RETURN ADDR. CIFSYS ENQUE SCQUBL RPQRX1, CIFSYS JWAIT TAD SCQBLK+RXQCOD SNA JMP RPQRX1 SMA CLA JMP I RPQRX /EXIT:IO COMPLETED / here only after a block has been allocated to RPPGDS / initialize the RPPGDS "scroll" buffer (7400) words to -1 / initialize the first two words to imitate a standard WPS / "fixed" block. / word 0 = -255 entries in this block / word 1 = 0070 (ID code ) / / clear the extension block pointers (words 2&3) RPBFIN, 0 /RETURN ADDR TO CALLER TAD (RPPGDS-1 /START ADDR. -1 DCA X3 /INIT. AUTO INDEX REG. TO RPPGDS BUFFER TAD (COSCNT /-255 VALUE FOR 1ST WORD CDFRPB /GET TO OUR BUFFER FIELD DCA I X3 /SET 1ST WORD TO -255 TAD (0070 /OUR UNIQUE ID CODE DCA I X3 /INTO 2ND WORD DCA I X3 /AND CLEAR THE EXTENSION BLOCK DCA I X3 /POINTERS TAD (7404 /NEG. 252 WORD COUNTER DCA RPTEM1 /RPTEM1 => NEG. WORD COUNTER B, AC7777 /AC => -1 DCA I X3 /ADVANCE PTR. AND THEN SET A WORD TO -1 ISZ RPTEM1 /SKIP IF ALL RPPGDS BUFFER WORDS INIT'D. JMP B /NOT DONE, SO LOOP... CDFMYF /BACK TO THIS FIELD JMP I RPBFIN /EXIT: RPPGDS SCROLL BUFFER INIT'D TO -1 /EXCEPT WORD 0 (-255) AND WORD 1 (0070) /AND 2&3 (0) RPTEM1, 0 /TEMP. MUST BE ON THIS PAGE /M046 / here to free a block pertaining to a corrupted RPPGDS / ON ENTRY: AC = BLOCK # TO FREE RPDSFR, 0 /SAVE RETURN TO CALLER JMS RPQRX /INTERNAL REQ. TO FREE A BLOCK RXEFR /FC 6 = FREE A BLOCK 0 /DUMMY CLA /INSURE A CLEARED AC JMP I RPDSFR /EXIT: BLOCK HAS BEEN FREED / here to clear all extension blocks associated with a corrupted MAIN / RPPGDS... RPDSCR, 0 /RETURN ADDR. TAD (RPHDRB /START WITH THE 1ST EXTN. BLOCK DCA X3 /X3 => PTR. TO BLOCK TO BE FREED TAD X3 / DCA X4 /X4 => PTR. TO TABLE ENTRY THAT CONTAINED FREED BLK. RPFRDS, TAD I X3 /GET BLOCK # TO BE FREED SNA /SKIP IF THERE IS ONE JMP RPENDS /DO UNTIL PHYSICAL END OF TABLE JMS RPDSFR /GO FREE A BLOCK DCA I X4 /TAKE BLOCK OUT OF TABLE RPENDS, TAD X3 /NEXT ENTRY TO GET BLOCK # FROM IAC / /A007 TAD (-RPHMD /TEST PHYSICAL END AND NOT NULL /ENTRY IN CASE ENTIRE TABLE FILLED AND RPHMD /WORD NOT NULL... SZA CLA /SKIP IF ALL BLOCKS FREED JMP RPFRDS /GO DO ANOTHER ENTRY JMP I RPDSCR /EXIT:RPPGDS AND ALL EXTENSIONS FREED / during the CLOSE procedure, perform the same housekeeping / on the RPPGDS blocks that is done to the DOC. HEADER blocks... RPGETR, 0 /CALLER'S RETURN ADDR. TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD CDFRPB /GET THE RPPGDS DATA FIELD TAD I RPGTR1 /GET OUR PARRELLEL WORD CDFMYF /BACK TO THIS FIELD DCA RPPTR1 /AND SAVE IT FOR PUT LATER... JMP I RPGETR /EXIT:RPPGDS WORD ALSO AVAILABLE RPPUTR, 0 /CALLER'S RETURN ADDR. TAD SCGTR1 /DOC. HDR. BLK. SCROLL BUFFER ADDR. AND P377 /STRIP HDR. BUFFER ADDR., LEAVING WORD OFFSET TAD (RPPGDS /ADD THIS WORD OFFSET TO OUR BUFFER ADDR. DCA RPGTR1 /RESULTING IN A POINTER TO THE PARRELLEL WORD TAD RPPTR1 /GET RPPGDS WORD SAVED DURING GET CDFRPB /RPPGDS SCROLL BUFFER FIELD DCA I RPGTR1 /PUT WORD IN PARRELLEL RPPGDS LOCATION CDFMYF /BACK TO THIS FIELD JMP I RPPUTR /EXIT:PARRELLEL RPPGDS WORD UPDATED RPGTR1, 0 /POINTER TO PARRELLEL RPPGDS WORD RPPTR1, 0 /PUT RPPGDS CHAR. HERE;GET RPPGDS CHAR. FROM HERE SPCTAB, /12 BIT SPECIALS TO 6-BIT TRANSLATION TABLE 7727 /LINE MODIFIED (CMD 6) 7707 /ENTER COMPOSITE (CMD &) 7706 /TAB (CMD %) 7713 /END OF LINE (CMD *) 7721 /A016 7714 /END OF PAGE (CMD +) 7710 /EXIT COMPOSITE (CMD ') 7730 /START OF A RULER (CMD 7) 7731 /END OF A RULER (CMD 8) COSTAB, /12-BIT MODES INTO 6-BIT TRANSLATION TABLE 74 /SHIFT 76 /UNSHIFT 7703 /EXIT BOLD (CMD ") 7702 /ENTER BOLD (CMD !) 7705 /EXIT UNDERLINE (CMD $) 7704 /ENTER UNDERLINE (CMD #) 7716 /EXIT SUPERSCRIPT (CMD -) 7715 /ENTER SUPERSCRIPT (CMD ,) 7720 /EXIT SUBSCRIPT (CMD /) 7717 /ENTER SUBSCRIPT (CMD .) 7712 /EXIT AUX. (CMD )) 7711 /ENTER AUX. (CMD () MAXCOS=.-COSTAB /# OF MODES 0 /END OF TABLE / /A042 / WPFILS FUNCTION TO SET SCTOP,SCTPH /A042 / DOES NO DISK I/O /A042 / /A042 RRSCTP, XX /A042 DCA SCTOP /A042 MQA /A042 DCA SCTPH /A042 JMP I RRSCTP /A042 /--------------- PAGE / read the RPPGDS block into our scroll buffer (7400) / then determine if the descriptor words reflect an up-to-date / text block content... / / ON ENTRY: AC => BLK # OF RPPGDS / ON EXIT : AC => 0 WHEN RPPGDS OK / AC => NOT 0 WHEN RPPGDS CORRUPTED RPRDIT, 0 /CALLER'S RETURN ADDR. CDFMYF /A032 DCA NEWBLK /SAVE BLOCK # TO BE READ /A019 TAD RPHDBN /GET PTR. TO BLOCK # THAT IS CURRENTLY ACTIVE SNA / IS IT ZERO? /A011 JMP RPDORD / YES, DON'T WRITE OUT OLD HEADER /A011 DCA TMPPTR /FOR INDIRECT THRU THIS PAGE TAD I TMPPTR /GET THE BLOCK # CIA /FOR COMPARE /A007 TAD NEWBLK /ALREADY IN BUFFER? /A007/M019 SNA CLA /SKIP IF NOT /A007 JMP I RPRDIT /RETURN IF SO /A007 TAD I TMPPTR /ACTIVE BLOCK # /A007 JMS RPQRX /GO WRITE IT TO DISK RXEWT+2000 /WRITE AND VERIFY F.C. RPPGDS /ADDR. OF BUFFER CLA RPDORD, TAD NEWBLK /REPLACE BLOCK # TO BE READ /M019 JMS RPQRX /"INTERNAL" REQUEST TO READ RPPGDS BLOCK RXERD /FC 3 = READ LOG. BLOCK RPPGDS /PTR TO OUR SCROLL BUFFER / BEGIN THE VERIFICATION PROCESS: / / if this document was OPENed by a V2.n WPS then the 2nd word / of this block should contain the unique ID code of 0070 / else this block used for other than RPPGDS descriptor words TAD (-0070 /NEG. RPPGDS ID CODE CDFRPB /SCROLL BUFFER DF TAD I (RPPGDS+1 /COMPARE TO 2ND WORD OF RPPGDS BLOCK CDFMYF /BACK TO THIS FIELD SZA /SKIP IF THIS IS THE RPPGDS BLOCK JMP I RPRDIT /AC => NOT 0 ERROR RETURN / if the # of blocks allocated to this document is the same for / both the doc. header block and the RPPGDS block, then this / RPPGDS block ok / else this document was used on a system that did not contain / V2.n GOTO PAGE software. / The RPPGDS descriptor words are not the most current / reflection of the text blocks within this document. TAD NEWBLK /GTP BLK # JUST READ /A034 CIA /FOR COMPARES /A034 TAD RPHDBN /MAIN GTP BLK# OR 0 FOR OPENING DOC. /A034 SZA /SKIP TO VERIFY MAIN GTP BLK /A034 TAD NEWBLK /SEE IF RPHDBN WAS 0 FOR OPENING /A034 SZA CLA /SKIP TO VERIFY MAIN GTP BLK /A034 JMP I RPRDIT /DON'T VERIFY EXTENSIONS CDFBUF /SCROLL BUFFER DF TAD I (SCHDR+5 /# OF BLOCK ALLOCATED TO THIS DOC. CIA /MAKE NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+5 /COMPARE TO ITS RPPGDS COUNTER-PART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF # OF BLOCK THE SAME JMP I RPRDIT /ERROR EXIT: AC NOT = 0 / if the DAY-MONTH-YEAR of both the doc. header block and the / RPPGDS block match, then this document CLOSED by a V2.n / system. / else this document used by a system not containing V2.n / GOTO PAGE software. CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+10 /DAY-MONTH CIA /MAKE NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+10 /GET COUNTERPART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF A MATCH JMP I RPRDIT /ERROR EXIT:AC NOT = 0 CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+11 /LAST 2 DIGITS OF YEAR VALUE CIA /CONVERT TO NEG. FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+11 /GET COUNTERPART CDFMYF /BACK TO THIS FIELD SZA /SKIP IF YEAR VALUES AGREE JMP I RPRDIT /ERROR EXIT: AC NOT = 0 / 4) IF THIS DOC. WAS OPENED BY A V2.0 OR LATER WPS / THEN THE START TIME OF THE LAST EDIT CYCLE SHOULD BE / THE SAME IN BOTH BLOCKS... CDFBUF /SCROLL BUFFER FIELD TAD I (SCHDR+12 /START TIME OF LAST EDIT CIA /NEG. VALUE FOR COMPARE CDFRPB /OUR BUFFER FIELD TAD I (RPPGDS+12 /GET THE COUNTERPART CDFMYF /BACK TO THIS FIELD JMP I RPRDIT /EXIT W/AC CONTAINING RESULT / here after a TEXT block has been written to diskette. / locate the scroll buffer used and read its contents, looking / for repositioning information and mode. RPSPLT, 0 /NEG. = "SPLIT" ESC SEQ. / POS. = NORMAL 2 CHAR. SEQ. /I.E., 1277 1250 7713 3377 1477 RPENDB, 0 /BUFFER CHAR. COUNTER RPDSBD, 0 /SAVE CALLERS' RETURN ADDR. AC0001 / /A030 DCA TMPPTR /FIRST-TIME THRU ETX FLAG /A030 DCA SOMFLG /CLEAR FIRST-TIME THRU STX FLAG /A030 TAD M376 /SET UP A NEG. 254 WORD COUNTER /M021 DCA RPENDB /TO END DESCRIPTOR WORD BUILD TAD T3 / DESC. BEING USED /A030 TAD (-ETXDES /IS IT ETX? /A030 SZA CLA /SKIP TO PROCESS ETX BUFFER CHARS. TAD T400 /BUMP TO PROCESS STX BUFFER CHARS. TAD (SCEB+BOFSET-1 /INIT. BUFFER WORD POINTER DCA X3 /TO WORD IMMEDIATELY BEFORE 1ST WORD DSBDST, TAD RPSPLT /GET "SPLIT" ESC SEQ. FLAG AND P7700 /GET THE ESC CHAR. TAD M7700 /COMPARE TO ESC CODE /M021 SZA CLA /SKIP TO PROCESS "SPLIT" ESC JMP DSBDWD /JUMP TO PROCESS NORMAL WORD CDFBUF /SCROLL BUFFER FIELD TAD I X3 /GET THE CURRENT BUFFER WORD CDFMYF /BACK TO OUR FIELD BSW /USE BITS 6-11 FOR "SPLIT" FLAG DCA RPSPLT /UPDATE FLAG AND MAKE A COPY OF CURRENT WORD TAD RPSPLT /GET THE CURRENT BUFFER WORD AND P77 /OUR SECOND HALF OF ESC SEQ. TAD P7700 /SUPPLY THE ESC. CHAR. /M021 JMP DOESC+1 /GO PROCESS ESC SEQ. IN AC /M021 DSBDWD, CDFBUF /SCROLL BUFFER FIELD TAD I X3 /GET THE CURRENT BUFFER WORD CDFMYF /BACK TO THIS FIELD MQL /SAVE WORD IN MQ /A021 ACL /RESTORE CHAR /A021 AND P7700 /GET THE ESC CHAR /A021 TAD M7700 /COMPARE TO ESC CODE /A021 SNA /SKIP IF NORMAL /M021 JMP DOESC /GO PROCESS ESC SEQ. IN AC ACL /RESTORE CHAR /A021 BSW /LOOKING FOR "SPLIT" ESC SEQ. DCA RPSPLT /IF ESC CHAR., FLAG IS NOW NEG. DSBDEX, ISZ RPENDB /BUMP BUFFER CHAR. COUNTER JMP DSBDST /READ ANOTHER BUFFER WORD JMS RPDSWD /PUT CURRENT DESCRIPTOR WORD IN RPPGDS DCA RPSPLT /CLEAR SPLIT FLAG FOR EACH BLOCK /A038 JMP I RPDSBD /AND EXIT: THIS TEXT BLOCK HAS A NEW DESCRIPTOR WORD TMPPTR, 0 /POINTER ON THIS PAGE TO ACCESS BLOCK CONTROL TABLE /--------------- PAGE RPMODE, 0 /BUILD OUR OWN MODE BYTE RPPCTLFL, 0 /PRINT-CONTROL STATE FLAG /A030 TORPDSBD, XX /INIT. DESC. WORD AND BIT 5 /A030 ISZ T3 /BUMP TO STX/ETX DESC. WORD /A030 TAD RPPCTLFL/CONTENTS OF PRINT-CONTROL FLAG /A030 DCA I T3 /INIT. APPROPRIATE DESC WORD /A030 JMS RPDSBD /IDENTIFY/RECORD PERTINENT ESC /A030 JMP I TORPDSBD/CONTINUE PUT PROCESS /A030 / RPDESC bit assigmnents: /M012 / / 0 1 2 3 4 5 6 7 8 9 10 11 / R J S U B C U P P P P P / A S / / when bit 'ON': / R = a RULER starts in this block / J = Justify / S = Superscript / U = Underscore / B = Bold / S & U = Subscript / CA = (Print) Control Area / US = Unshift / P = total number of PAGES in this block / / determine if this ESC sequence has to be reflected in our text / block descriptor word. / / ON ENTRY: AC contains full 2-char. ESC Sequence... DOESC, ACL /GET THE CURRENT BUFFER WORD BACK /A021 CIA /MAKE POSITIVE FOR COMPARES TAD (7730 /COMPARE TO START OF RULER SNA /SKIP IF NOT START OF RULER JMP RPSTRL /GO INDICATE THAT THIS BLOCK HAS A RULER TAD (7720-7730 /EXIT SUBSCRIPT MODE? /A016 SNA /SKIP IF NOT JMP RPEXSB /GO CLEAR SUBSCRIPT MODE /M030 TAD (7717-7720 /ENTER SUBSCRIPT MODE? SNA /SKIP IF NOT JMP RPENSB /GO SET SUBSCRIPT MODE /M030 TAD (7716-7717 /EXIT SUPERSCRIPT MODE? SNA /SKIP IF NOT JMP RPEXSU /GO CLEAR SUPERSCRIPT MODE TAD (7715-7716 /ENTER SUPERSCRIPT MODE? SNA /SKIP IF NOT JMP RPENSU /GO SET SUPERSCRIPT MODE TAD (7714-7715 /COMPARE TO END PAGE SEQUENCE SNA /SKIP IF NOT JMP RPPGMK /FLAG PAGE MARK IN DESCRIPTOR / now check for MODE.... TAD (7712-7714 /EXIT AUX. MODE? SNA /SKIP IF NOT JMP RPEXAU /GO CLEAR AUX. BIT TAD (7711-7712 /ENTER AUX. MODE? SNA CLA /SKIP IF NOT JMP RPENAU /GO SET AUX. BIT JMP DSBDEX /EXIT: / ESC. sequence was end of page. This type of sequence with MODE / equal NONE represents a NEW PAGE MARK, or, this sequence with / AUX. set represents a PAGE MARKER; any other mode is not applicable. RPPGMK, TAD (1200 /TEST SUPER/SUB SCRIPT /M030 AND RPMODE /IN CURRENT MODE /M030 SZA CLA /SKIP IF NEITHER (PAGE MARK) /M030 JMP CHCNTL /JUMP IF PRINT CONTROL INFO /M030 ISZ I T3 /REFLECT PAGE MARKER /M030 JMP DSBDEX /RETURN TO NORMAL PUT PROCESS /M030 CHCNTL, TAD TMPPTR /TEST FIRST-TIME THRU ETX FLAG /A030 SNA CLA /SKIP IF 1ST TIME THRU /A030 JMP DSBDEX /CONTINUE PUT PROCESS /A030 TAD T3 /POINTER TO CURRENT DESC. WORD /A030 TAD (-ETXDES /COMPARE TO ETX /A030 SZA CLA /SKIP IF ETX BUFFER /A030 JMP CHKSTX / PROCESS STX /A030 DCA TMPPTR /CLEAR FIRST TIME THRU FLAG /A030 AC0001 / /A030 DCA SOMFLG /FORCE ETX EXIT /A030 TAD (200 /END PRINT-CONTROL MASK /A030 AND RPMODE /TEST CURRENT MODE /A030 JMP CHKETX /CONTINUE TO PROCESS ETX OFF PAGE /A030 RPSTRL, TAD P3777 /MAKE SURE RULER PRESENT BIT OFF AND I T3 /BEFORE WE SET IT /M030 TAD (4000 /SET RULER IN THIS BLOCK BIT DCA I T3 /UPDATE DESCRIPTOR WORD /M030 JMP DSBDEX /EXIT: RETURN TO NORMAL PUT-PROCESS / ESC sequence was EXIT SUPER/SUBSCRIPT mode.... /A012 RPEXSU, TAD (6777 /CLEAR SUPER-SCRIPT (1000) /C030 AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER SUPER/SUBSCRIPT mode.... /A012 RPENSU, TAD (6777 /MAKE SURE SUPER-SCRIPT BIT OFF /C030 AND RPMODE /BEFORE WE SET IT TAD (1000 /SET SUPER/SUBSCRIPT MODE BIT JMP MODEXT / ESC sequence was EXIT AUX. mode... RPEXAU, TAD (5777 /CLEAR AUX. MODE BIT (2000) AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER AUX. mode... RPENAU, TAD (5777 /MAKE SURE AUX. MODE-ON BIT IS OFF AND RPMODE /BEFORE WE SET IT TAD (2000 /SET AUX. MODE BIT JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was EXIT BOLD mode... RPEXSB, TAD (7577 /CLEAR SUB-SCRIPT MODE BIT (0200) /M030 AND RPMODE /SAVE OTHER MODE BITS JMP MODEXT /GO UPDATE MODE AND EXIT / ESC sequence was ENTER BOLD mode... RPENSB, TAD (7577 /MAKE SURE SUB-SCRIPT MODE BIT OFF /M030 AND RPMODE /BEFORE WE SET IT TAD (200 /SET BOLD MODE MODEXT, DCA RPMODE /UPDATE OUR MODE WORD JMP DSBDEX /AND RETURN TO CONTINUE RPTRS1, XX DCA SCTOP /BACK FOR EDITOR TAD EDHDR /PREVIOUS ACTIVE HEADER BLOCK DCA SCTPH /INTO TOP HEADER POINTER TAD EDHDR1 /GET ORIGINAL 'BOTTOM' HDR ID DCA SCBTH /BACK FOR EDITOR TAD EDSCBK /GET HDR BLK # THAT'S IN CORE JMS CKSAME /SEE IF WE NEED TO READ (NORMAL RETURN) /A044 /OR DO WE ALREADY HAVE (SKIP) /A044 / ... THE CORRECT DOCUMENT HEADER BLOCK IN CORE /A044 /D044 DCA SCHDBN /BACK FOR EDITOR /note -- don't save and restore the current rppgds block in the buffer JMS SCGTWR JMP I RPTRS1 /RETURN EDHDR1, 0 /USED TO SAVE/RESTORE SCBTH HDR ID EDSCBK, 0 /USED TO SAVE/RESTORE HDR BLK # THAT'S IN CORE / /A042 / /A042 / SUBR RPTPDS -- Rapid Paging get ToP goto-page DeScriptor word /A042 / /A042 / Gets GOTO-PAGE descriptor word of block currently defined by /A042 / top pointers SCTOP,SCTPH. /A042 / Probably reads appropriate GOTO-PAGE header block if it's not /A042 / currently loaded in the RPPGDS buffer. /A042 / /A042 / CALL: /A042 / JMS RPTPDS / GET TOP DESCRIPTOR WORD /A042 / / AC = GOTO-PAGE DESCRIPTOR WORD (?FOR BLK IN STX BUFFER?) /A042 / /A042 / /A042 RPTPDS, XX /A042 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK SCTPH SCTOP AC0002 /IGNORE DOC. HEADER STUFF /AC := 2 TO GET PAST COS WORDS 1&2 TAD (RPPGDS /OUR BUFFER STARTS HERE TAD SCTOP /PLUS THE PARELLEL DOC HEADER OFFSET DCA T1 /SAVE EXTRA WORD /A007 CDFRPB /GET OUR BUFFER FIELD TAD I T1 / /A007 CDFMYF /BACK TO THIS FIELD /WITH DESCRIPTOR WORD IN AC.... JMP I RPTPDS /EXIT /A042 /--------------- PAGE / / This code was developed for the exclusive use of the V2 / GOTO PAGE enhancement; it provides for 7 seperate functions: / / 1) when AC = -1: Increment top ptrs; Get top G-T-P descriptor word / / permits the reading of successive "descriptor words" / and passes back the current descriptor word within / the AC for the caller (EDITOR). The main advantage / of employing this method is the automatic loading / of sequential doc. header extension blocks and their / parallel RPPGDS extension blocks. / / 2) when AC = -2: Save SYSTEM FILE POINTERS / / Saves FILE SYSTEM POINTERS (current position within / GOTO-PAGE header structure), then / sets current position to ---TOP--- for function AC=-1. / If file position is to restored (function AC=-4), then / do not attempt to scroll to/from disk until / after calling function AC=-4. / / Value returned to EDITOR: / / AC= the current number of pages / contained within the STX buffer. This count will / be used to calculate the current page being editted. / / 3) when AC = -3: Get original and current top pointers / / Value supplied on entry: / / MQ= Pointer to 2-word save area for current SCTOP & SCTPH / / Values returned to the EDITOR: / / AC= the original value of SCTOP (saved by func AC=-2) / (to be used to calculate the current PAGE being edited) / MQ= the original HDR. ID # (saved by func AC=-2) / CDFLP;@entry MQ = current value of SCTPH / CDFLP;@entry MQ = current value of SCTOP / / 4) when AC = -4: Restore SYSTEM FILE POINTERS / / the calculation of the total number of PAGES within / this document has been completed. Before returning / to resume the edit session, return the FILE SYSTEM POINTERS / to those values saved at the start of the total PAGE / calculation. It is possible that the HEADER scroll buffer / and the RPPGDS scroll buffer got overlaid with / successive extension blocks necessary to count all / pages within the document. Furthurmore, SCTOP and SCBOT / were bumped to read successive descriptor words. / / 5) when AC = -5: Get current bottom pointers / / Values returned to the EDITOR: / / AC= current contents of SCBOT / (so that a determination can be made as to when the / current block has been read.) / MQ= current contents of SCBTH / / 6) when AC = -6: Get top G-T-P descriptor word; Increment top ptrs / / Value supplied on entry: / / AC= signed increment for top pointers / (+- # of blocks to move; may=0) / / Value returned to EDITOR: / / AC= value of GOTO-PAGE descriptor word for block / originally pointed to by top pointers (before / they were incremented) / / 7) when AC = positive #: Random-Access OPEN for scrolling / / Values supplied on entry: / / AC= new SCBOT (header word pointer (offset into hdr blk)) / MQ= new SCBTH (header block id number) / / Initializes the TOP and BOTTOM pointer pairs / for random access of text blocks. / The entry AC&MQ together specify which document block / to open at. After this function, ADVPTR will get characters / starting at the beginning of the opened block; / BAKPTR will get characters starting at the end of the / previous block. / (This function is used for several purposes. Example: / positions the pointer pairs at the block in the / document containing the desired page to reposition / to.) / RPINIT, 0 /CALLER'S RETURN ADDRESS SPA /SKIP TO SET UP FOR RANDOM READ JMP RPDSCP /JUMP TO TEST FURTHUR / / RANDOM ACCESS OPEN / DCA SCBOT /HDR WORD PTR INTO BOTTOM WORD PTR MQA /GET THE HEADER # DCA SCBTH /PUT IN BOTTOM HEADER PTR / THE BOTTOM POINTERS ARE NOW SET FOR RANDOM READ TAD SCBOT /BOTTOM HDR WORD POINTER DCA SCTOP /NOW BECOMES THE TOP POINTER TAD SCBTH /GET THE BOTTOM HEADER POINTER DCA SCTPH /INTO TOP HEADER NUMBER JMS SCTOPP /GO DECR. TOP PTRS BY 1 -1 /DECR. FACTOR / DEPICT AN EMPTY TEXT BUFFER... DCA SCTPTR /CLEAR STX BUFFER CHAR. POINTER TAD (SCHCNT-1 /MAX. # OF BUFFER BYTES DCA SCEPTR /SET EXT BUFFER CHAR. POINTER AT MAX. / WHEN THE EDITOR REQUESTS A READ OF A CHAR. (LODCHR) FROM / AN INITIALIZED EDIT BUFFER, WPFILS WILL BE CALLED TO SUPPLY / A CHAR. FROM THE ETX BUFFER. THE POINTER SET ABOVE WILL / RESULT IN READING A BLOCK FROM DISK INTO THE ETX BUFFER. AC0001 /SET Go To page FLaG TO /A012 DCA GTFLG /INDICATE A GO-TO-PAGE REQUEST /A012 JMP RPINEX /EXIT:POINTERS ALL SET FOR RANDOM READ GTFLG, 0 /SET TO INDICATE A GO-TO-PAGE REQUEST /A012 RPDSCP, TAD ONE /SKIP TO READ DESCRIPTOR /M025 SZA / JMP RPCNT /JUMP TO TEST FURTHUR / / the AC was -1...... / JMS SCTOPP /CLEARS AC, THEN INCR. TOP POINTER 1 /BY 1 /D042 JMS SCGETR /READ AN ENTRY FROM THE DOC. HEADER BLOCK /D042 SCTPH /D042 SCTOP /D042 /D042 AC0002 /IGNORE DOC. HEADER STUFF /D042 /AC := 2 TO GET PAST COS WORDS 1&2 /D042 TAD (RPPGDS /OUR BUFFER STARTS HERE /D042 TAD SCTOP /PLUS THE PARRELLE DOC HEADER OFFSET /D042 DCA T1 /SAVE EXTRA WORD /A007 /D042 /D042 CDFRPB /GET OUR BUFFER FIELD /D042 TAD I T1 / /A007 /D042 CDFMYF /BACK TO THIS FIELD /D042 /WITH DESCRIPTOR WORD IN AC.... JMS RPTPDS /GET TOP GOTO-PAGE DESCRIPTOR WORD /A042 JMP RPINEX /EXIT RPCNT, TAD ONE /TEST FOR # OF PAGES IN STX BUFFER /M025 SZA /SKIP TO PASS THE # OF PAGES IN THE STX BUFFER JMP RPTOP /MAY BE REQUEST FOR ORIGONAL SCTOP & HDR ID# / / AC was -2..... / TAD SCTOP /SAVE POINTER TO CURRENT TOP BLOCK DCA EDTOPS /AT START OF TOTAL PAGE CALCULATION /M041 TAD SCBOT /AND CURRENT BOTTOM BLOCK POINTER DCA EDBOTS /M041 TAD SCTPH /SAVE CURRENT 'TOP' HDR ID /A020 DCA EDHDR /A020 TAD SCBTH /SAVE CURRENT 'BOTTOM' HDR ID /A020 DCA EDHDR1 /A020 TAD SCHDBN /SAVE CURRENT HDR BLK # THAT'S IN CORE /A020 DCA EDSCBK /A020 / set-up to enable read of successive descriptor words, /A009 / starting with the 1st descriptor of the 1st RPPGDS block.. /A009 TAD (52 / /A009 DCA SCTOP /INIT'D VALUE /A009 TAD (53 / /A009 DCA SCBOT /INIT'D VALUE /A009 AC0001 / /A009 DCA SCTPH /1ST HEADER BLOCK ID # /A009 TAD STXMOD+2 /SUPPLY THE # OF PAGE IN STX BUFFER /A018 JMP RPINEX /EXIT / THE FOLLOWING BLOCK IS ALL SCRAMBLED, SO I'M JUST DELETING IT /A042 / AND REWRITING IT (RATHER THAN ATTEMPTING TO MODIFY IT IN PLACE) /A042 /D042 / the EDITOR wants to know when a new block has been read; /A013 /D042 / so that it knows it has written the previous block into /A013 /D042 / the edit buffer.... /A013 /D042 / AC was - 5....... /D042 /D042 RPBOT, TAD SCBOT /AC = CURRENT SCBOT /A013 /D042 JMP RPINEX /RETURN TO CALLER /A013 /D042 /D042 RPPTRS, TAD TWO /TEST FOR SCBOT CONTENTS /A013/M025 /D042 SNA CLA /SKIP IF NOT /A013 /D042 JMP RPBOT /JUMP TO SUPPLY SCBOT /A013 /D042 /D042 /AC was -4....... /D042 /D042 TAD EDBOTS /GET ORIG. SCBOT /M041 /D042 DCA SCBOT /BACK FOR EDITOR /D042 TAD EDTOPS /SAVED SCTOP /M041 /D042 JMS RPTRS1 / /D042 /D042 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER RPTOP, IAC /INCR. MINUS AC /A042 SZA /SKIP IF EDITOR REQUEST FOR SCTOP /A042 JMP RPPTRS /JUMP IF NOT /A042 /A042 / /A042 / AC was -3....... /A042 / /A042 / ON ENTRY: MQ = pointer to caller's save area to /A042 / pass the current SCTOP and HDR ID # /A042 / /A042 / ON EXIT: MQ = HDR ID # at START of relative page /A042 / request /A042 / /A042 / AC = SCTOP at START of relative page /A042 / request /A042 / /A042 / The CURRENT SCTOP and HDR ID # (SCTPH) /A042 / are in the caller's data field /A042 /A042 /D042 TAD SCTOP /CURRENT TOP POINTER /A042 /D042 SWP /MQ = CURRENT TOP /A042 ACL /AC = POINTER TO CALLERS SAVE AREA /A042 DCA X0 /PTR TO SAVE AREA INTO X0 /A042 TAD SCTPH /CURRENT HDR ID # /A042 CDFLP /FIELD 5 /A042 DCA I X0 /SAVE CURRENT HDR ID # /A042 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A042 RRAER1, IFNZRO SCTOP&7600 < ? > /SCTOP MUST BE ON PAGE 0 /A042 /OTHERWISE A CDFMYF IS NEEDED HERE /A042 TAD SCTOP /RETRIEVE CURRENT TOP POINTER /A042 DCA I X0 /TO SAVE FOR COMPARE /A042 CDFMYF /FIELD 7 /A042 /A042 TAD EDHDR /ORIG. HEADER ID # /A042 MQL /INTO THE MQ /A042 TAD EDTOPS /ORIG. SCTOP /A042 JMP RPINEX /RETURN TO CALLER /A042 /A042 RPPTRS, TAD TWO /A042 / /A042 / AC=+1 == AC WAS -4 /A042 / AC=0 == AC WAS -5 /A042 / AC=-1 == AC WAS -6 /A042 / /A042 SNA /A042 JMP RPBOT /AC WAS = -5 /A042 SPA CLA /A042 JMP RPDSIN /AC WAS = -6 /A042 / /A042 /AC was -4....... /A042 / /A042 TAD EDBOTS /GET ORIG. SCBOT /A042 DCA SCBOT /BACK FOR EDITOR /A042 TAD EDTOPS /SAVED SCTOP /A042 JMS RPTRS1 / /A042 /A042 RPINEX, JMP I RPINIT /EXIT: RETURN TO CALLER /A042 /A042 / /A042 / AC was -5 ... /A042 / /A042 / the EDITOR wants to know when a new block has been read; /A042 / so that it knows it has written the previous block into /A042 / the edit buffer.... /A042 / /A042 RPBOT, TAD SCBTH /MQ = CURRENT SCBTH /A042 MQL /A042 TAD SCBOT /AC = CURRENT SCBOT /A042 JMP RPINEX /RETURN TO CALLER /A042 /A042 / /A042 / AC WAS = -6 ... /A042 / /A042 / READ GOTO-PAGE DESCRIPTOR WORD DEFINED BY SCTOP,SCTPH; /A042 / THEN INCREMENT SCTOP,SCTPH BY CONTENTS OF MQ AT ENTRY. /A042 / /A042 RPDSIN, ACL /GET INCREMENT FOR SCTOP,SCTPH /A042 DCA RPTPIN /SAVE POST INCREMENT FOR SCTOP,SCTPH /A042 JMS RPTPDS /GET G-T-P TOP DESCRIPTOR WORD /A042 DCA RPTPDS /SAVE DESCRIPTOR WORD /A042 JMS SCTOPP /INCREMENT TOP POINTERS (SCTOP,SCTPH) /A042 RPTPIN, .-. / AMOUNT TO INCREMENT (-1,0, OR +1) /A042 TAD RPTPDS / GET ORIGINAL G-T-P DESCRIPTOR WORD /A042 JMP RPINEX /EXIT /A042 / if Go To page request FLaG is NOT set / then / return to caller / else / reset GTFLG / get pointer to appropriate descriptor / get the descriptor / retrieve the mode of the first character in the block / save in: ETXMOD / ETXMOD+1 / STXMOD / STXMOD+1 / / RPRD1, XX TAD GTFLG /GET THE GOTO PAGE REQUEST FLAG SNA /SKIP IF G-T-P REQUEST /M030 JMP RPRDEN /EXIT SPA CLA /SKIP IF GETTING ETX /A030 JMP RPCLHLD /JUMP IF GETTING STX /A030 TAD (3600 /MASK TO EXTRACT MODE BITS AND RPPTR1 /MASK WITH CURRENT DESC WORD /M030 DCA ETXMOD /STORE FOR LATER USE TAD ETXMOD /RETRIEVE MODE DCA STXMOD /FOR USE WHEN SCROLLING UP TAD T40 /MASK TO EXTRACT SHIFT/UNSHIFT BIT AND RPPTR1 /AC = SHIFT/UNSHIFT /M030 DCA ETXMOD+1 /SAVE TAD ETXMOD+1 /RETRIEVE DCA STXMOD+1 /AND SAVE FOR SCROLL UP AC0100 /MASK FOR ACTIVE-CONTROL AREA /A030 AND RPPTR1 /TO CURRENT DESC. WORD /A030 DCA RPPCTLFL /UPDATE FLAG ACCORDING TO BLOCK READ /A030 RPCLHLD,TAD (3640 /MASK TO EXTRACT MODE /A030 AND RPPTR1 /FROM CURRENT DESC. /A030 DCA HLDMOD /FOR NEXT STX BLOCK TO BE WRITTEN /A030 DCA GTFLG /CLEAR G-T-P ACTIVE FLAG /A030 RPRDEN, JMP I RPRD1 /RETURN TO CALLER /D030 RPRD3, .-. /TEMP. /D030 RPRD4, .-. /TEMP. / THIS BLOCK IS NEEDLESSLY AND CONFUSINGLY OUT OF SEQUENCE, /A042 / AND IT ALSO WASTES WORDS, SO I'M REWRITING IT AND MOVING IT /A042 / TO WHERE IT LOGICALLY BELONGS (WHY WASN'T IT THERE TO BEGIN WITH??) /A042 /D042 RPTOP, TAD ONE /INCR. MINUS AC /M025 /D042 SZA /SKIP IF EDITOR REQUEST FOR SCTOP /D042 JMP RPPTRS /JUMP IF NOT /D042 /D042 / AC was -3....... /D042 /D042 / ON ENTRY: MQ = pointer to caller's save area to /D042 / pass the current SCTOP and HDR ID # /D042 / /D042 / ON EXIT: MQ = HDR ID # at START of relative page /D042 / request /D042 / /D042 / AC = SCTOP at START of relative page /D042 / request /D042 / /D042 / The CURRENT SCTOP and HDR ID # (SCTPH) /D042 / are in the caller's data field /D042 /D042 TAD SCTOP /CURRENT TOP POINTER /A026 /D042 SWP /MQ = CURRENT TOP /A030 /D042 /AC = POINTER TO CALLERS SAVE AREA /A030 /D042 DCA X0 /PTR TO SAVE AREA INTO X0 /D042 TAD SCTPH /CURRENT HDR ID # /A026 /D042 CDFLP /FIELD 5 /A026 /D042 DCA I X0 /SAVE CURRENT HDR ID # /A026 /D042 ACL /RETRIEVE CURRENT TOP POINTER /A026 /D042 DCA I X0 /TO SAVE FOR COMPARE /A026 /D042 CDFMYF /FIELD 7 /A026 /D042 /D042 TAD EDHDR /ORIG. HEADER ID # /A009 /D042 MQL /INTO THE MQ /A009 /D042 TAD EDTOPS /ORIG. SCTOP /M041 /D042 JMP RPINEX /RETURN TO CALLER /A009 /--------------- PAGE   / WPEDIT 3.XX / / ******** EDIT HISTORY ******** / 258 KMD 23-Sep-85 Add Spanish Xlations and Page size check / 257 KMD 17-Sep-85 Add Sveeedish translation IFDEFs / 256 KMD 16-Sep-85 Add Norwegen (?) ifdefs. / MAKE SURE !!!!! / That you don't push the area of NWRUL buffer / up by a page by having translations that are / slightly too long .. Great fun.. / / / 255 KMD 13-Sep-85 Add Spanish technical changes (not xlations) / 254 EMcD 26-Aug-85 Add Insert-Overstrike mode / 253 EMcD 19-Aug-85 Conditionalise Swedish Ruler store /recall / 252 Mart 15-aug-85 add DUTCH / 251 KMD 02-AUG-85 Allow international radix characters / 250 EMcD 13-Jul-85 Put in FAO keyboard for Ruler store/recall / 249 RCME 03-Jul-85 Fix bug in LP and spell caused by 247 / 248 RCME 01-Jul-85 Define new table to take 8-bit characters / in ruler definitions / 247 RCME 24-Jun-85 Allow MCS currency symbols / 246 EMcD 07-jun-85 Fix write out of WPHOLE / 245 EMcD 22-may-85 Move PGECHO out to Panel to make some room / 244 EMcD 22-May-85 More Hyphenation code for 8 bit / 243 EMcD 21-May-85 Write out one more block of blasts / 242 EMcD 06-May-85 Expand write-out code for WPHOLE because / of extra block for Blast for 8 bit GOLD SWAP / 241 EMcD 23-Apr-85 Allow trans of 8 bit input only for / KB input chars / 240 rcme 22-Apr-85 Added load information for merge overlay hole / 239 Mart 19-mar-85 moved CMPRUL,CLRRULR to WPHOLE added ESIMCH / 238 Mart 11-mar-85 added blaster hook and made space by removing / part of the ruler buffer copy to panel mem / / *********** mods below are V2.0 and earlier / / 237 WCE 20-DEC-84 Fix PUTSCH to output attributes across screens / 236 WCE 12-NOV-84 Editor MATH changes for spaces in tab fields / 235 WCE 12-OCT-84 Change Status Line for Column Cursor display / 234 WCE 24-SEP-84 Change to Tech Character overlay call / 233 EJL 23-AUG-84 CALLAR checks menu code is swapped out before / JMS into field 2 / Fix reset of ruler during window change / 232 WCE 21-AUG-84 Fix to EDITOR MATH error handling during SWAP / 231 WJY 21-AUG-84 Fix to caller routine to clear skip return flag / 230 WCE 20-AUG-84 Change to file open for Personal Dict and Spell / 229 WJY 09-AUG-84 Return to main menu when the SPELL overlay INITSP / is unable to open a file. / 228 WCE 07-AUG-84 CHANGED GETLIN TO FIX PROBLEM WITH TIME DISPLAY / 227 EJL 07-AUG-84 Change FMSWAP calls to CALLAR and remove FMSWAP / Added stacking of 10 levels to CALLAR / 226 BC 26-JUL-84 Delete SPLTFL, use WIDNAR flag for 80/132 / 225 WCE 24-JUL-84 Added REGION indicator to Status Line display / 224 WCE 16-JUL-84 Changes for BRITISH pound sign / 223 BC 16-JUL-84 Added manual screen width choice / 222 BC 09-JUL-84 Deleted routine PPCALL from editor (not needed) / 221 WCE 28-JUN-84 Fix to COPY-DOC then EDIT crashing system / 220 WCE 27-JUN-84 Various bug fixes to EDITOR / 219 EJL 25-JUN-84 Expand ruler from 158 to 238 / 218 GDC 05-JUN-84 Field 2 routines using own callaroutine. / 217 GDC 05-JUN-84 Moved CENTER to field 2. / 216 DKR 01-JUN-84 Test MNSTAT for Ruler Display ON/OFF. Added / @RULOFF' to pt to Case-Table for Ruler Display / 215 DKR 29-MAY-84 Gold:Tab changes for key trapping / removed code associated with @tab center' / 214 BC 22-MAY-84 Add PPCALL (=CALLAROUTINE) to 2nd overlay / for Post Proc. calls to Edit subrs; add SB's / footnote fixes to INITSP. / 213 GDC 14-MAY-84 Added handling for second overlay area. / 212 WCE 11-MAY-84 Remove all occurrances of USERNO / 211 EJL 08-MAY-84 Add hooks for technical character / 210 WCE 02-MAY-84 Moved Resident Overlay from WPEDOV to WPEDIT / 209 GDC 29-APR-84 Moved LINDNT to field 2. / 208 GDC 23-APR-84 Moved FNTABSTOP and TBJUST to field 2. / 207 GDC 12-APR-84 Moved CHKMAR into field 2 freeing space in / editor root. / 206 GDC 24-MAR-84 Space saving mods / 205 AH 21-MAR-84 Add code for COLUMN CUT / 204 WCE 14-MAR-84 Change startup point from EIFIX to EINEXA to / correct a problem with blocks used display / 203 GDH 2-MAR-84 Fix SELECT bug with line exactly R-MARG long. / 202 WJY 29-FEB-84 Fix top of document display when DMI document / is opened in wide screen mode / 201 WJY 24-FEB-84 Fix DMI wide screen bug caused by removing DMI / specific code / 200 WJY 07-FEB-84 DECmate I compatability. / 199 EH 21-DEC-83 Fix for CHKMAR, handling tabs on wrapped lines / 198 GDH 20-DEC-83 Unconditionalized the math checks. / 197 EH 20-DEC-83 Moved the 5 ruler words on page 0 so as not to / get cleared at INITialization. (for GTR) / 196 GDH 13-DEC-83 Changed DSPRUL to accomodate status line changes. / 195 WJD 31-OCT-83 Remove GOLD_HALT from GTP & GOLD_BOTTOM / and change GOLD_BOTTOM logic to GTP logic / 194 WCE 27-OCT-83 REMOVED ALL PREVIOUS EDIT HISTORIES FOR / NEW VERSION 1.5 SOURCES FIELD 0 / FIELD WHERE RXHAN IS LOCATED *200 / START ADDRESS USED BY OS8 "GO" COMMAND JMP I .+3 / LOCATION USED TO START UP RXHAN JMP I .+1 / LOCATION USED TO RETURN TO OS8 MONITOR 7605 / ADDRESS OF OS8 MONITOR RETURN POINT RXLOAD / ADDRESS OF START LOCATION FOR RXHAN *RXLDLS / ADDRESS WITHIN RXHAN TO OVERLAY RXEWT / WRITE FUNCTION CODE 0 RXQBLK / ADDRESS OF QUEUE BLOCK TO USE . / ADDRESS OF TABLE OF DISK COMMANDS DLSTAT ; 400;CDF 0;-DSSTAT / SWAP AREA CODE & STATUS LINE DLOEDT ; 0;CDF 10;-DSOEDT / MAIN EDITOR DL3EDT ; 200;CDF 20;-DS3EDT / MORE EDITOR RESIDENT CODE DL4EDT ;1600;CDF 20;-DS4EDT / EDITOR MATH CODE, ONLY LOADED / IN WHEN NOT IN LIST PROCESSING DLBLED ;HOLEPG ;CDF 60 ;-DSBLED/ load out editor blastr holes DLBEOV ;HOLEOV ;CDF 50 ;-DSBEOV/ Load out Extra Blast holes /a242 DLEHL2 ;HOLEOV ;CDF 60 ;-DSEHL2/ Load out one more hole block/M245/A243 0 / WPEDIT - EDITOR JOB ECMTH1= 06 / START OF MATH CODE ECMTH2= 206 / END OF MATH CODE RECBUF= 10 / Start of RECord_BUFfer in buffer field / (for List Processing) HDRBUF= 6000 / START OF EDIT FILE HEADER BUFFER HDRFSZ= 5 / # BLOCKS IN THIS FILE HDRPSZ= 15 / #LINES PER PAGE ETXBUF= HDRBUF+400 / ETX BUFFER STXBUF= ETXBUF+400 / STX BUFFER PSTEBF= STXBUF+400 / PASTE BUFFER PRTBUF= HDRBUF / MERGE-TO-PRINTER BUFFER PRTSIZ= STXBUF-PRTBUF / " " SIZE BUFEND= HDRBUF / END OF EDIT BUFFER +1 BASKET= PSTEBF / WASTEBASKET BASKSZ= 400 / WASTEBASKET CAPACITY PSTEBG= DLCUTB / FIRST PASTE BLOCK PSTEND= PSTEBG+36 / LAST PASTE BLOCK +1 CR= 15 LF= 12 WIDTH= 204 / WIDTH OF SCREEN COLLIM= 360 / M219 Display ruler out to 240 / RULSV2 displays out to 240 / RLADV1, RLINE1 limits advance to 238 HAFRUL= COLLIM-1%2 / A219 Limit ruler to 238 COLM80= 117 / 80TH COLUMN POINTER COLM81= COLM80+1 / A219 NPTRS= 30 / NUMBER OF SCREEN LINES AVAILABLE ON TERMINAL CURPOS= 46 / CURRENT HORIZ POSITION ON SCREEN LOWLIM= 47 / SCREEN'S CURRENT LOW LIMIT, / EITHER 0 OR 27 DECIMAL /*************************************************************************** /**** PAGE ZERO LOCATIONS USED BY STATUS LINE DISPLAY ROUTINE **** /*************************************************************************** CDFMYF= CDFMNU *170 LINFLG, 0 / LOCATION FOR STATUS DISPLAY MODE FLAG LINRUL, 0 / LOCATION FOR RULER DETECTED FLAG LINDIF, 0 / LOCATION FOR STATUS DIFFERENT FLAG LINPGL, 0 / LOCATION FOR CURRENT LOW ORDER PAGE NUMBER LINPGH, 0 / LOCATION FOR CURRENT HIGH ORDER PAGE NUMBER LINNUM, 0 / LOCATION FOR CURRENT LINE NUMBER LINUSD, 0 / LOCATION FOR NUMBER OF BLOCKS USED LINFRE, 0 / LOCATION FOR NUMBER OF BLOCKS FREE X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE RELOC / RESET RELOCATION MECHANISM OF ASSEMBLER *400 / SET LOCATION COUNT TO FREE AREA IN FIELD 0 RELOC SWPBEG / LOCATION FOR STATUS LINE CODE TO RUN DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** TRANSFER VECTOR ENTRY POINTS FOR EDITOR SWAP AREA ROUTINES **** /*************************************************************************** CALLN1, XX / ENTRY POINT FOR ROUTINE NUMBER 1 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS LINDSP / GO UPDATE STATUS LINE INFORMATION JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN2, XX / ENTRY POINT FOR ROUTINE NUMBER 2 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS LINCHK / GO CHECK FOR STATUS VALUE CHANGES JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN3, XX / ENTRY POINT FOR ROUTINE NUMBER 3 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS LINSDN / GO HANDLE SCROLL DOWN EVENT JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN4, XX / ENTRY POINT FOR ROUTINE NUMBER 4 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS LINSUP / GO HANDLE SCROLL UP EVENT JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN5, XX / ENTRY POINT FOR ROUTINE NUMBER 5 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS LINCOL / SPECIAL CHECK FOR STATUS VALUE CHANGES /C235 JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN6, XX / ENTRY POINT FOR ROUTINE NUMBER 6 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN7, XX / ENTRY POINT FOR ROUTINE NUMBER 7 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN8, XX / ENTRY POINT FOR ROUTINE NUMBER 8 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN9, XX / ENTRY POINT FOR ROUTINE NUMBER 9 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE /*************************************************************************** /**** SET UP RETURN FIELD AND ADDRESS FOR CALLN# ROUTINES **** /*************************************************************************** CALSUB, XX / ROUTINE TO SET UP RETURN FIELD AND ADDRESS DCA LINFLG / SAVE CONTENTS OF ACCUMULATOR IN FLAG WORD RDF / READ CALLERS DATA FIELD TAD CIDF0 / MAKE CDF-CIF INSTRUCTION BACK TO CALLER DCA CALXIT / STORE FOR RETURN TO CALLER CDFMYF / SET DATA FIELD BACK TO MY FIELD AC7776 / SET UP TO SUBTRACT A VALUE OF TWO TAD CALSUB / MAKE POINTER TO VECTOR ENTRY POINT DCA T2 / STORE FOR USE IN AN INDIRECT LOOKUP TAD I T2 / PICK UP CALLERS RETURN ADDRESS DCA CALRTN / STORE ADDRESS FOR LATER RETURN TO CALLER JMP I CALSUB / GO TRANSFER TO SPECIALIZED ROUTINES CALXIT, XX / LOCATION FOR CDF-CIF INSTRUCTION TO CALLER JMP I CALRTN / RETURN BACK TO CALLER CALRTN, XX / LOCATION FOR CALLERS RETURN ADDRESS X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** THE CODE ASSEMBLED HERE IS USED BY THE EDITOR FOR STATUS LINE **** /*************************************************************************** LINCOL, XX / SPECIAL CHECK FOR STATUS VALUE CHANGES /A235 TAD I (MUBUF+MNSTAT) / PICK UP THE NUMBER OF STATUS LINES /A235 SNA CLA / ARE WE DISPLAYING STATUS INFORMATION /A235 JMP I LINCOL / NO, RETURN TO CALLER /A235 CDFEDT / CHANGE TO EDIT FIELD /A235 TAD I (GSRF) / PICK UP THE GLOBAL SEARCH FLAG /A235 CDFMYF / RESET BACK TO THIS FIELD /A235 SZA CLA / ARE WE DOING A GLOBAL SEARCH & REPLACE/A235 JMP LINPOS / YES, GO UPDATE COLUMN INFORMATION /A235 JMS LINCHK / GO CHECK FOR STATUS VALUE CHANGES /A235 AC7775 / SET UP FOR A COUNT OF THREE /A235 DCA T2 / STORE IN COUNTER REGISTER /A235 LINLOP, CIFSYS / CHANGE TO SYSTEM FIELD /A235 JWAIT / WAIT FOR A SIGNIFICANT EVENT /A235 CIFSYS / CHANGE TO SYSTEM FIELD /A235 XLTIN / GET A CHARACTER FROM KEYBOARD BUFFER /A235 JMP LINNCH / NO CHARACTERS AVAILABLE, SKIP AROUND /A235 ISZ CALRTN / GOT ONE, BUMP RETURN ADDRESS /A235 JMP I LINCOL / RETURN TO CALLER /A235 LINNCH, ISZ T2 / INCREMENT THE COUNTER /A235 JMP LINLOP / NOT DONE, GO WAIT SOME MORE /A235 LINPOS, TAD LINCUR / PICK UP THE LAST DISPLAYED POSITION /A235 DCA T2 / SAVE FOR LATER COMPARE /A235 CDFEDT / CHANGE TO EDIT FIELD /A235 TAD I (CURSOR) / PICK UP THE CURRENT CURSOR POSITION /A235 CDFMYF / RESET BACK TO THIS FIELD /A235 IAC / BUMP TO REAL VALUE /A235 DCA LINCUR / SAVE THE VALUE FOR DISPLAY /A235 TAD LINCUR / PICK UP THE COLUMN POSITION /A235 CIA / MAKE IT NEGATIVE /A235 TAD T2 / COMBINE WITH PREVIOUS VALUE /A235 SNA CLA / ARE THEY THE SAME ? /A235 JMP I LINCOL / YES, DON'T REDISPLAY, RETURN TO CALLER/A235 JMS I IOACAL / CALL IOA TO DISPLAY THE VALUE /A235 0 / USE DEFAULT IOA OUTPUT ROUTINE /A235 LINST1 / CONTROL STRING TO DISPLAY VALUE /A235 24 / SCREEN POSITION /A235 LINREV / SELECT REVERSE VIDEO IF SPECIFIED /A235 LINCUR, XX / LOCATION FOR CURRENT CURSOR POSITION /A235 JMP I LINCOL / RETURN TO CALLER /A235 LINCLR, XX / ROUTINE TO CLEAR SCREEN AND SET VALUES JMS I IOACAL / CALL IOA TO CLEAR THE SCREEN 0 / USE DEFAULT IOA OUTPUT ROUTINE LINST2 / CLEAR SCREEN AND SCROLL AREA /C235 TAD LINTXT / GET POINTER TO CURRENT TEXT SIZE CIFFIO / CHANGE TO FILE SYSTEM FIELD FILEIO / CALL FILE SYSTEM TO GET HEADER VALUE XHDRGT / GET VALUE FROM HEADER FUNCTION WORD DCA LINSIZ / STORE VALUE OF CURRENT TEXT SIZE CDFFIO / CHANGE TO FILE SYSTEM FIELD TAD I (SCFSPC) / GET NUMBER OF BLOCKS LEFT ON DISK CDFMYF / CHANGE BACK TO MENU FIELD DCA T3 / SAVE NUMBER OF FREE BLOCKS IN TMP / THE VALUE STORED IN LINFRE IS USED AS A FLAG TO INDICATE THAT THE MID SCREEN / DOCUMENT HEADER INFORMATION SHOULD BE DISPLAYED ON THE SCREEN. IF THE VALUE / OF LINFRE IS ZERO, IT INDICATES THAT THE NUMBER OF FREE BLOCKS REMAINING ON / THE DISKETTE HAS NOT BEEN UPDATED WHICH HAPPENS AT DOCUMENT OPEN TIME AND / THAT THE MID SCREEN DATA IS REQUIRED. / / THERE IS A CASE WHERE LINFRE HAS NOT BEEN UPDATED AND THE MID SCREEN / INFORMATION IS NOT WANTED. WHEN THIS HAPPENS, THE VLAUE OF THE OPERATION / FLAG WORD STORED IN LINFLG IS A THREE WHICH MEANS THAT ONLY A CLEAR SCREEN / IS DESIRED. A VALID TEST IS MADE BY COMBINING THE VALUES OF BOTH WORDS. TAD LINFLG / GET FLAG WORD FOR CURRENT OPERATION TAD LINFRE / GET LAST VALUE OF BLOCKS FREE SNA CLA / HAS IT BEEN INITIALIZED AND LINFLG=0 JMP LINMID / NO, GO DISPLAY MIDDLE LINES OF SCREEN TAD T3 / GET CURRENT BLOCKS FREE CIA / NEGATE VALUE FOR CHECK TAD LINFRE / COMBINE WITH LAST VALUE OF BLOCKS FREE TAD LINUSD / ADD RESIDUE TO NUMBER OF BLOCKS USED DCA LINUSD / STORE UPDATED NUMBER OF BLOCKS USED JMP LINSET / GO STORE CURRENT VALUE OF BLOCKS FREE LINMID, JMS I IOACAL / CALL IOA TO DISPLAY MID SCREEN DATA 0 / USE DEFAULT IOA OUTPUT ROUTINE LINST3 / CONTROL STRING FOR TEXT DISPLAY IFDEF CONDOR < 710 > / LOCATION FOR DOCUMENT NAME /C202 IFNDEF CONDOR < 310 > / COMPROMISE VALUE, WORKS IN BOTH /A202 / WIDE SCREEN & NORMAL MODES FOR DMI /A202 MUBUF+MNDRV / MENU LOCATION FOR DRIVE NUMBER MUBUF+MNDOCN / MENU LOCATION FOR DOC NUMBER MUBUF+MNFNAM / MENU LOCATION FOR DOC NAME IFDEF CONDOR < 1110 > / LOCATION FOR FIRST SCREEN LINE /C202 IFNDEF CONDOR < 510 > / COMPROMISE VALUE, WORKS IN BOTH /A202 / WIDE SCREEN & NORMAL MODES FOR DMI /A202 LINUSD / LOCATION FOR BLOCKS USED VALUE IFDEF CONDOR < 1310 > / LOCATION FOR SECOND SCREEN LINE /C202 IFNDEF CONDOR < 710 > / COMPROMISE VALUE, WORKS IN BOTH /A202 / WIDE SCREEN & NORMAL MODES FOR DMI /A202 T3 / LOCATION FOR BLOCKS FREE VALUE IFDEF CONDOR < 1510 > / LOCATION FOR THIRD SCREEN LINE /C202 IFNDEF CONDOR < 1110 > / COMPROMISE VALUE, WORKS IN BOTH /A202 / WIDE SCREEN & NORMAL MODES FOR DMI /A202 LINSIZ / LOCATION FOR CURRENT TEXT SIZE VALUE LINSET, TAD T3 / GET CURRENT NUMBER OF BLOCKS FREE DCA LINFRE / STORE UPDATED NUMBER OF BLOCKS FREE AC7775 / SET UP FOR A DECREMENT TAD I (MUBUF+MNSTAT) / PICK UP NUMBER OF STATUS LINES SMA CLA / CHECK FOR A ONE OR TWO LINE TOP AREA IAC / BUMP UP TO A TWO LINE AREA TAD LINTWO / SET UP FOR A ONE OR TWO LINE TOP AREA DCA LINAD1 / STORE FOR USE WITH IOA CALL AC7776 / SET UP FOR A DECREMENT TAD I (MUBUF+MNSTAT) / PICK UP NUMBER OF STATUS LINES SPA CLA / CHECK FOR A RULER LINE AREA IAC / NO RULER, BUMP UP TO FULL SCREEN TAD ("3) / SET UP RULER AREA IF SPECIFIED DCA LINAD2 / STORE FOR USE WITH IOA CALL DCA LINCUR / CLEAR COLUMN POSITION FOR REDISPLAY /A235 JMP I LINCLR / RETURN BACK TO CALLER LINTXT, 15-2 / POINTER TO HEADER CURRENT TEXT SIZE LINSTE, TEXT '!Y' / RESTORE CURSOR ATTRIBUTES LINSTF, TEXT '![(&^S^A![[?6H' / SELECT LANGUAGE & RELITIVE MODE /C235 / ESC [ ? 6 h / SELECT RELITIVE ORIGIN MODE /C235 LINSTG, ESC; "[ / START SELECTION OF SCROLL REGION /C224 LINAD1, "2; "; / FIRST ROW OF SCROLL REGION 2 OR 3 LINTWO, "2 LINAD2, "3; "r / LAST ROW OF SCROLL REGION AT 23 OR 24 0 / ASCII STRING TERMINATOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** THE CODE ASSEMBLED HERE IS USED BY THE EDITOR FOR STATUS LINE **** /*************************************************************************** / LINDSP ROUTINE IS USED TO DISPLAY THE STATUS LINE INFORMATION IN THE EDITOR / / THE STATUS LINE AREA CONSISTS OF ONE OR TWO OR THREE LINES AS FOLLOWS: / LINE 1 = TOP LINE OF SCREEN - CURRENT PAGE NUMBER, CURRENT LINE NUMBER, / DRIVE NUMBER, DOCUMENT NUMBER AND DOCUMENT NAME BEING EDITED / LINE 2 = (IF SPECIFIED) A GRAPHICS BAR UNDER LINE ONE / LINE 24 = (IF SPECIFIED) CURRENT RULER IN EFFECT FOR EDITING / / PRIOR TO ENTRY, THE VALUE CONTAINED IN MNSTAT DETERMINES TYPE OF STATUS / DISPLAYED AS FOLLOWS: / / MNSTAT = 0 NO STATUS DISPLAYED WHILE EDITING / MNSTAT = 1 REVERSE VIDEO TOP STATUS LINE ONLY / MNSTAT = 2 REVERSE VIDEO TOP STATUS LINE AND CURRENT RULER / MNSTAT = 3 TOP STATUS LINE WITH GRAPHICS BAR AND CURRENT RULER / / UPON ENTRY, THE VALUE CONTAINED IN THE AC DETERMINES FUNCTION AS FOLLOWS: / / AC = 0 CLEAR THE SCREEN AND DISPLAY COMPLETE STATUS AREA / DEFINE SCROLLING REGION AND SET RELITIVE SCREEN ADDRESSING / AC = 1 UPDATE DISPLAY OF TOP STATUS LINE ONLY / AC = 2 UPDATE DISPLAY OF BOTTOM STATUS LINE ONLY (DISPLAY RULER) / AC = 3 CLEAR THE SCREEN AND RESET SCROLLING AREA TO FULL SCREEN LINDSP, XX / DISPLAY STATUS LINE ROUTINE TAD LINFLG / GET STATUS DISPLAY MODE FLAG SZA / CHECK FOR DISPLAY ALL MODE TAD LINM3 / NO, CHECK FOR SCREEN CLEAR & RESET SNA CLA / WAS SCREEN CLEAR & RESET REQUESTED JMS LINCLR / YES, GO CLEAR SCREEN AND SET VALUES TAD I (MUBUF+MNSTAT) / PICK UP NUMBER OF STATUS LINES SNA / CHECK TO SEE IF STATUS AREA IS ACTIVE JMP LINXIT / NO, STATUS IS NOT ACTIVE, RETURN TO CALLER TAD LINM3 / DECREMENT THE COUNT SMA CLA / CHECK FOR TOP LINE TO BE REVERSE VIDEO AC0004 / NO REVERSE VIDEO, BUMP ADDRESS TO NULL POINT TAD (LINST5) / PICK UP ADDRESS OF REVERSE VIDEO STRING DCA LINREV / STORE FOR USE WITH IOA CALLS TAD LINFLG / GET STATUS DISPLAY MODE FLAG SZA CLA / CHECK FOR DISPLAY ALL MODE JMP LINTOP / NO, GO CHECK FOR TOP LINE JMS I IOACAL / CALL IOA TO DISPLAY TOP REVERSE VIDEO LINE 0 / USE DEFAULT IOA DISPLAY ROUTINE LINST4 / DISPLAY REVERSE VIDEO AREA AND DOC NAME 0 / SCREEN POSITION FOR REVERSE SPACE LINREV / SELECT REVERSE VIDEO IF SPECIFIED LINST6 / DISPLAY 27 REVERSE SPACE CHARACTERS LINST6 / DISPLAY 27 REVERSE SPACE CHARACTERS LINST6 / DISPLAY 27 REVERSE SPACE CHARACTERS LINST6 / DISPLAY 27 REVERSE SPACE CHARACTERS LINST6 / DISPLAY 27 REVERSE SPACE CHARACTERS 41 / SCREEN POSITION FOR DOCUMENT NAME/C254/C235 MUBUF+MNDRV / MENU LOCATION FOR DRIVE NUMBER MUBUF+MNDOCN / MENU LOCATION FOR DOC NUMBER MUBUF+MNFNAM / MENU LOCATION FOR DOC NAME LINTOP, TAD LINFLG / GET STATUS DISPLAY MODE FLAG SZA / CHECK FOR DISPLAY ALL MODE TAD LINM1 / NO, CHECK FOR TOP LINE SZA CLA / IS IT JUST THE TOP LINE JMP LINBOT / NO, GO CHECK FOR BOTTOM LINE DCA LINDIF / CLEAR STATUS DIFFERENT FLAG JMS I IOACAL / CALL IOA TO START DISPLAY OF TOP LINE 0 / USE DEFAULT IOA OUTPUT ROUTINE LINST7 / SAVE CURSOR, SET ABSOLUTE, DISPLAY PAGE /C235 0 / SCREEN POSITION FOR PAGE LINREV / SELECT REVERSE VIDEO IF SPECIFIED TAD LINPGH / GET VALUE OF HIGH ORDER PAGE NUMBER SNA CLA / DO WE HAVE A THOUSAND PAGES ? JMP LINLOW / NO, JUST PUT UP LOW ORDER PAGE NUMBER JMS I IOACAL / CALL IOA TO DISPLAY THOUSANDS NUMBER 0 / USE DEFAULT IOA OUTPUT ROUTINE LINST9 / THOUSANDS NUMBER CONTROL STRING LINPGH / HIGH ORDER PAGE NUMBER LINPGL / LOW ORDER PAGE NUMBER JMP LINLIN / CONTINUE WITH LINE DISPLAY LINLOW, JMS I IOACAL / CALL IOA TO DISPLAY LOW PAGE NUMBER 0 / USE DEFAULT IOA OUTPUT ROUTINE LINSTA / HUNDREDS CONTROL STRING AND LINE NUMBER LINPGL / LOW ORDER PAGE NUMBER LINLIN, JMS INOVDP / Go display Insert-Overstrike /A254 JMS I IOACAL / CALL IOA TO START THE LINE DISPLAY 0 / USE DEFAULT IOA OUTPUT ROUTINE LINSTB / CONTROL STRING FOR LINE DISPLAY 11 / SCREEN POSITION FOR LINE /C235 TAD LINNUM / PICK UP THE CURRENT LINE NUMBER SNA CLA / IS THE LINE NUMBER DEFINED ? JMP LINUKN / NO, GO PUT UP "N/A" MESSAGE JMS I IOACAL / CALL IOA TO DISPLAY LINE NUMBER 0 / USE DEFAULT IOA OUTPUT ROUTINE LINSTC / DISPLAY LINE NUMBER LINNUM / POINTER TO CURRENT LINE NUMBER 21 / SCREEN POSITION FOR COLUMN POSITION /C235 JMP LINBOT / GO CHECK FOR BOTTOM LINE LINUKN, JMS I IOACAL / CALL IOA TO DISPLAY "N/A" MESSAGE 0 / USE DEFAULT IOA OUTPUT ROUTINE LINSTD / DISPLAY "N/A" LINBOT, TAD LINFLG / GET STATUS DISPLAY MODE FLAG SZA / CHECK FOR DISPLAY ALL MODE TAD LINM2 / NO, CHECK FOR BOTTOM LINE RULER SNA CLA / WAS BOTTOM LINE RULER REQUESTED TAD I (MUBUF+MNSTAT) / YES, PICK UP NUMBER OF STATUS LINES TAD LINM2 / DECREMENT THE COUNT SPA CLA / WAS BOTTOM LINE RULER SPECIFIED JMP LINSAM / NO, GO CHECK IF SETUP IS NEEDED DCA LINRUL / CLEAR RULER DETECTED FLAG JMS I IOACAL / CALL IOA TO DISPLAY BOTTOM LINE 0 / USE DEFAULT IOA OUTPUT ROUTINE LINST8 / SAVE CURSOR & SET ABSOLUTE ADDRESSING /C235 CDFEDT / CHNAGE TO EDIT FIELD TAD (NPTRS) / PICK UP VALUE FOR MAXIMUM SCREEN LINES DCA I (SCRNLN) / STORE MAX VALUE FOR PCUR ROUTINE /D220 CDFMYF / CHANGE BACK TO THIS FIELD /D220 CIFEDT / SET UP TO GO TO THE EDITOR FIELD /D220 JMS I (CALLAR) / CALL A ROUTINE IN THE EDITOR /D220 DSPCUR / ROUTINE TO DISPLAY THE CURRENT RULER /M196 /D220 CDFBUF / DATA FIELD TO USE FOR ROUTINE CDIEDT / SET UP TO GO TO THE EDITOR FIELD /A220 JMS I (DSPCUR) / ROUTINE TO DISPLAY THE CURRENT RULER /A220 JMS I IOACAL / CALL IOA TO FINISH DISPLAY OF BOTTOM LINE 0 / USE DEFAULT IOA OUTPUT ROUTINE LINSTE / RESTORE CURSOR ATTRIBUTES LINSAM, TAD LINFLG / GET STATUS DISPLAY MODE FLAG SZA CLA / CHECK FOR DISPLAY ALL MODE JMP LINXIT / NOT ZERO, MUST BE ALL DONE TAD I (MUBUF+MNSTAT) / PICK UP NUMBER OF STATUS LINES TAD LINM3 / DECREMENT COUNT OF NUMBER OF LINES SMA CLA / CHECK FOR ONLY ONE TOP LINE JMS LINBAR / NO, GO PUT UP GRAPHICS LINE JMS I IOACAL / CALL IOA TO SET UP SCROLL AREA AND MODE 0 / USE DEFAULT IOA DISPLAY ROUTINE LINSTF / CONTROL STRING TO SET AREA AND MODE /C224 MNLANG+MUBUF / POINTER TO LANGUAGE WORD /A224 LINSTG / SET SCROLL AREA, RELITIVE MODE /C224 LINXIT, TAD I (MUBUF+MNSTAT) / PICK UP NUMBER OF STATUS LINES CIA / NEGATE THE VALUE FOR A SUBTRACT TAD (NPTRS) / PICK UP VALUE FOR MAXIMUM SCREEN LINES CDFEDT / CHANGE TO EDIT FIELD DCA I (SCRNLN) / STORE NUMBER OF LINES IN SCROLL AREA CDFMYF / RESET BACK TO THIS FIELD JMP I LINDSP / RETURN TO CALLER LINREV, 0 / POINTER TO REVERSE VIDEO STRING LINSIZ, 0 / LOCATION FOR CURRENT TEXT SIZE LINM1, -1 / VALUE TO CHECK FOR TOP LINE LINM2, -2 / VALUE TO CHECK FOR BOTTOM LINE LINM3, -3 / VALUE TO CHECK FOR SCREEN RESET X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED TRANTP=. / TOP OF TRANSLATIONS /A258 LINST1, TEXT '!X^P!A^D !Y' / CONTROL STRING FOR COLUMN NUMBER /C235 LINST2, TEXT '![[?6L![[2&J![[R' / SEQUENCES DESCRIBED BELOW /C235 / ESC [ ? 6 l / SET ABSOLUTE ADDRESSING MODE /C235 / ESC [ 2 J / ERASE ENTIRE SCREEN /C235 / ESC [ r / CLEAR SCROLLING REGION /C235 LINST3, IFDEF ENGLSH < TEXT '^P&DOCUMENT: (!D.!D) !A '; *.-1 TEXT '^P&BLOCKS USED: !D '; *.-1 TEXT '^P&BLOCKS REMAINING: !D '; *.-1 TEXT '^P&TEXT SIZE: !D LINES' > IFDEF V30NOR < TEXT '^P&DOKUMENT: (!D.!D) !A '; *.-1 TEXT '^P&BRUKTE BLKR: !D '; *.-1 TEXT '^P&LEDIGE BLKR: !D '; *.-1 TEXT '^P&TEKSTSTR.: !D LINJER' > IFDEF V30SWE < TEXT '^P&DOKUMENT: (!D.!D) !A '; *.-1 TEXT '^P&ANV\DNDA BLK: !D '; *.-1 TEXT '^P&LEDIGA BLK: !D '; *.-1 TEXT '^P&TEXTSTORLEK.: !D RADER' > IFDEF SPANISH < /NB: NEEDS XLATING/A255 TEXT '^P&DOC.: (!D.!D) !A '; *.-1 TEXT '^P&BLQS USADOS: !D'; *.-1 TEXT '^P&BLQS SIN USAR: !D'; *.-1 TEXT '^P&TATA\QO DEL TEXTOS: !D L\MNS' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO: (!D.!D) !A '; *.-1 TEXT '^P&BLOCCHI USATI: !D '; *.-1 TEXT '^P&BLOCCHI LIBERI: !D '; *.-1 TEXT '^P&DIMENSIONE: !D RIGHE' > IFDEF DUTCH < TEXT '^P&DOC: (!D.!D) !A'; *.-1 TEXT '^P&GEBRUIKTE BLOKKEN: !D '; *.-1 TEXT '^P&VRIJE BLOKKEN: !D '; *.-1 TEXT '^P®ELS / PAGINA: !D LINES' > LINST4, IFNDEF V30NOR < IFNDEF V30SWE < TEXT '!X^P!A^S^S^S^S^S^P&DOC: (!D.!D) !A!Y' /C235 > > IFDEF V30NOR < TEXT '!X^P!A^S^S^S^S^S^P&DOK: (!D.!D) !A!Y' /C235 > IFDEF V30SWE < TEXT '!X^P!A^S^S^S^S^S^P&DOK: (!D.!D) !A!Y' /C235 > LINST5, ESC; "[; "7; "m / SELECT REVERSE VIDEO 0 / ASCII STRING TERMINATOR LINST6, TEXT ' ' / GRAPHICS BAR CHARACTER LINST7, TEXT '!X^P!A&P: ' / SAVE CURSOR, SET ABSOLUTE, DISPLAY PAGE /C235 LINST8, TEXT '!X' / SAVE CURSOR, SET ABSOLUTE /C235 LINST9, TEXT '!D!3D' LINSTA, TEXT '!D' LINSTB, IFDEF ENGLSH IFDEF V30NOR IFDEF V30SWE IFDEF SPANISH /A255 IFDEF ITALIAN IFDEF DUTCH LINSTC, IFDEF ENGLSH /C235 IFDEF V30NOR /C235 IFDEF V30SWE /C235 IFDEF SPANISH /A255 IFDEF ITALIAN /C235 IFDEF DUTCH /C235 IFDEF ENGLSH / LINE NUMBER NOT AVAILABLE /C235 IFDEF V30NOR / LINE NUMBER NOT AVAILABLE /C235 IFDEF V30SWE / LINE NUMBER NOT AVAILABLE /C235 IFDEF SPANISH / LINE NUMBER NOT AVAILABLE/A255 IFDEF DUTCH / LINE NUMBER NOT AVAILABLE /C235 X=. / INDICATE FIRST FREE LOCATION ON PAGE XTRLIN=200-.-TRANTP /-------------------- PAGE IFNZRO .-TRANTP-200 /A258 DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** EDITOR HOOKS FOR STATUS LINE DISPLAY **** /*************************************************************************** / CHECK STATUS CHANGE CALLED FROM THE HALT TEST ROUTINE IN LP FIELD AND BY / THE GET CHARACTER ROUTINE IN MGOVLY. / / THIS ROUTINE CHECKS TO SEE IF ANY OF THE DISPLAY / LOCATIONS OF THE STATUS LINE HAVE CHANGED SINCE / LAST CHECKED AND IF SO WILL DISPLAY THE NEW VALUES. LINCHK, XX / CHECK FOR STATUS VALUE CHANGE TAD LINDIF / PICK UP THE STATUS DIFFERENT FLAG SNA CLA / HAS THE TOP LINE OF STATUS CHANGED ? JMP LINCK1 / NO, GO UPDATE PRINTER STATUS AND TIME AC0001 / SET UP TO DISPLAY THE TOP STATUS LINE DCA LINFLG / STORE IN STATUS DISPLAY MODE FLAG JMS LINDSP / GO DISPLAY A NEW TOP STATUS LINE LINCK1, TAD LINRUL / PICK UP THE RULER DETECTED FLAG SNA CLA / HAS A RULER BEEN DETECTED ? JMP I LINCHK / NO, GO RETURN TO CALLER AC0002 / YES, DISPLAY THE BOTTOM STATUS LINE DCA LINFLG / STORE IN STATUS DISPLAY MODE FLAG JMS LINDSP / GO DISPLAY THE NEW RULER JMP I LINCHK / RETURN TO CALLER /*************************************************************************** /**** HANDLE SCROLL DOWN AND SCROLL UP EVENTS FOR STATUS LINE DISPLAY **** /*************************************************************************** LINSDN, XX / HANDLE SCROLL DOWN EVENT JMS LINTST / GO CHECK FOR SPECIAL CHRACTER JMP LINDNP / NEW PAGE OR PAGE MARKER DETECTED JMP LINDNR / RULER DETECTED - CHECK FOR TOP OF DOCUMENT JMP I LINSDN / IGNORE LINE - RETURN TO CALLER AC7777 / SET UP TO DECREMENT THE COUNT TAD LINNUM / COMBINE WITH CURRENT LINE COUNT DCA LINNUM / STORE NEW LINE COUNT JMP LINDNX / DONE WITH LINE, GO SET STATUS CHANGED FLAG LINDNP, AC7777 / SET UP TO DECREMENT THE COUNT TAD LINPGL / COMBINE WITH CURRENT LOW ORDER PAGE COUNT SMA / DID WE GO NEGATIVE ? JMP LINDNL / NO, THEN GO STORE NEW LOW ORDER PAGE NUMBER AC7777 / SET UP TO DECREMENT THE COUNT TAD LINPGH / COMBINE WITH CURRENT HIGH ORDER PAGE COUNT DCA LINPGH / STORE NEW HIGH ORDER PAGE COUNT TAD (1747) / PICK UP RESET VALUE OF 999 LINDNL, DCA LINPGL / STORE NEW LOW ORDER PAGE COUNT LINDNS, DCA LINNUM / MAKE LINE NUMBER "UNKNOWN" LINDNX, AC0001 / DONE WITH PAGE DCA LINDIF / SET STATUS CHANGED FLAG JMP I LINSDN / RETURN TO CALLER LINDNR, CDFEDT / CHANGE TO EDITOR DATA FIELD TAD I (PTRBLK+NPTRS-3)/ GET POINTER TO THIRD FROM LAST LINE CDFMYF / RESET BACK TO THIS FIELD SZA CLA / IS THIS THE TOP OF DOCUMENT JMP I LINSDN / NO, IGNORE RULER - RETURN TO CALLER AC0001 / YES, SET UP TO INITIALIZE THE COUNT JMP LINDNS / GO SET LINE NUMBER TO FIRST LINE LINSUP, XX / HANDLE SCROLL UP EVENT JMS LINTST / GO CHECK FOR SPECIAL CHRACTER JMP LINUPP / NEW PAGE OR PAGE MARKER DETECTED JMP I LINSUP / IGNORE RULER - RETURN TO CALLER JMP I LINSUP / IGNORE LINE - RETURN TO CALLER AC0001 / SET UP TO INCREMENT THE COUNT TAD LINNUM / COMBINE WITH CURRENT LINE COUNT DCA LINNUM / STORE NEW LINE COUNT JMP LINUPX / DONE WITH LINE, GO SET STATUS CHANGED FLAG LINUPP, TAD LINPGL / PICK UP CURRENT LOW ORDER PAGE NUMBER TAD (-1747) / COMBINE WITH NEGATIVE 999 PAGE COUNT SPA CLA / ARE WE AT LOW ORDER PAGE NUMBER 999 JMP LINUPL / GO INCREMENT LOW ORDER PAGE COUNT AC0001 / SET UP TO INCREMENT THE COUNT TAD LINPGH / COMBINE WITH CURRENT HIGH ORDER PAGE COUNT DCA LINPGH / STORE NEW HIGH ORDER PAGE COUNT JMP LINUPH / GO CLEAR LOW ORDER PAGE COUNT LINUPL, AC0001 / SET UP TO INCREMENT THE COUNT TAD LINPGL / COMBINE WITH CURRENT LOW ORDER PAGE COUNT LINUPH, DCA LINPGL / STORE NEW LOW ORDER PAGE COUNT AC0001 / SET UP TO INITIALIZE THE COUNT DCA LINNUM / SET LINE NUMBER TO FIRST LINE LINUPX, AC0001 / DONE WITH PAGE DCA LINDIF / SET STATUS CHANGED FLAG JMP I LINSUP / RETURN TO CALLER /*************************************************************************** /**** SUBROUTINE TO TEST VALUES FOR SPECIAL CHARACTERS **** /*************************************************************************** / THIS SUBROUTINE IS THE HEART OF THE STATUS LINE PAGE AND LINE NUMBER CHECK. / IT WORKS ON THE BASIS OF DETERMINING WHAT CHARACTER IS AT THE START OF THE / NEXT TO LAST LINE ON THE SCREEN BEFORE A SCROLL DOWN OPERATION AND AFTER A / SCROLL UP OPERATION. / / THIS ROUTINE WILL GENERATE MULTIPLE EXIT RETURNS BASED ON THE VALUE OF THE / CHARACTER AT THE START OF THE NEXT TO LAST LINE AND THE VALUE OF THE CONTROL / BLOCK FLAG AND ON THE VALUE OF THE LINE NUMBER AS FOLLOWS: / THE FIRST RETURN WILL BE THE DETECTION OF A VALID PAGE INDICATOR / THIS MEANS THAT IT IS TIME TO INCREMENT OR DECREMENT THE PAGE NUMBER / / THE SECOND RETURN WILL INDICATE THAT A START OF RULER HAS BEEN FOUND / / THE THIRD RETURN WILL INDICATE THAT THE CURRENT LINE SHOULD BE / IGNORED AND NOT COUNTED / / THE FOURTH RETURN WILL INDICATE THAT THE LINE IS A PRINTABLE LINE AND / THAT THE LINE NUMBER SHOULD BE INCREMENTED OR DECREMENTED LINTST, XX / TEST FOR SPECIAL CHARACTERS CDFEDT / CHANGE TO EDITOR DATA FIELD TAD I (PTRBLK+NPTRS-2)/ POINTER TO START OF NEXT TO LAST LINE DCA T1 / STORE POINTER INTO BUFFER FIELD CDFBUF / CHANGE TO BUFFER FIELD TAD I T1 / GET CHARACTER TO BE TESTED CDFMYF / RESET BACK TO THIS FIELD TAD (-ECPMRK) / CHECK FOR A PAGE MARKER SZA / SKIP IF THERE IS A MATCH TAD (ECPMRK-ECNWPG) / CHECK FOR A NEW PAGE SNA / SKIP IF THERE IS NO MATCH JMP I LINTST / PAGE DETECTED, TAKE FIRST RETURN ISZ LINTST / BUMP RETURN UP TO NEXT EXIT POINT TAD (ECNWPG-ECSTRL) / CHECK FOR A START OF RULLER SZA / IS THIS THE START OF A RULER ? JMP LINTS1 / NO, CONTINUE WITH THE TEST AC0001 / YES, THIS IS A RULER DCA LINRUL / SET RULER DETECTED FLAG JMP I LINTST / RULER DETECTED, TAKE SECOND RETURN LINTS1, ISZ LINTST / BUMP RETURN UP TO NEXT EXIT POINT TAD (ECSTRL-ECPCT1) / CHECK FOR A START CONTROL SZA / SKIP IF THERE IS A MATCH TAD (ECPCT1-ECPCT2) / CHECK FOR AN END CONTROL SZA CLA / SKIP IF THERE IS A MATCH TAD LINNUM / CHECK IF LINE NUMBER IS DEFINED SNA CLA / SKIP IF CONDITIONS VALID SO FAR JMP I LINTST / IGNORE LINE, TAKE THIRD RETURN CDFEDT / CHANGE TO EDITOR DATA FIELD TAD I (PCTLFL) / PICK UP VALUE FOR CONTROL BLOCK FLAG CDFMYF / RESET BACK TO THIS FIELD SNA CLA / IF SET THEN TAKE IGNORE LINE RETURN ISZ LINTST / BUMP RETURN UP TO COUNT THE LINE RETURN JMP I LINTST / RETURN BACK TO CALLER / Moved here for space reasons IFDEF ITALIAN < LINSTD, TEXT '&N/&D &C:!Y'>/ LINE NUMBER NOT AVAILABLE /C235 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED LINBAR, XX / ROUTINE TO PUT UP THE SECOND STATUS LINE JMS I IOACAL / CALL IOA TO DISPLAY GRAPHICS LINE 0 / USE DEFAULT IOA DISPLAY ROUTINE LINSTX / DISPLAY GRAPHICS LINE /C235 100 / SCREEN POSITION FOR GRAPHICS LINE LINSTY / DISPLAY 27 GRAPHIC LINE CHARACTERS /C235 LINSTY / DISPLAY 27 GRAPHIC LINE CHARACTERS /C235 LINSTY / DISPLAY 27 GRAPHIC LINE CHARACTERS /C235 LINSTY / DISPLAY 27 GRAPHIC LINE CHARACTERS /C235 LINSTY / DISPLAY 27 GRAPHIC LINE CHARACTERS /C235 JMP I LINBAR / ALL DONE, RETURN TO CALLER / / This routine displays OVRSTK if the user toggles the /A254 / Insert-Overstrike Key into Overstrike /A254 / INOVDP, XX /A254 CLA / Just in case /A254 CDFEDT / Point to Edit Field /A254 TAD I (INSOVF) / Get Insert-Overstrike Flag /A254 CDFMYF / Point back here /A254 SNA CLA / 0 for Ins , 1 for Over /A254 JMP INCLR / Clear screen /A254 INDPOV, JMS I IOACAL / Call display /A254 0 / default /A254 OVTOVS / Text for OVRSTK /A254 31 / Col Pos /A254 JMP I INOVDP / Bi Bi /A254 INCLR, JMS I IOACAL / Call display /A254 0 / default /A254 OVTCLR / Clear message /A254 31 / Col Pos /A254 JMP I INOVDP / Bi Bi /A254 OVTCLR, TEXT '^P ' /A254 OVTOVS, TEXT '^P![[1M&OVRSTK![[22M' /A254 LINSTX, TEXT '^P!CN^S^S^S^S^S!CO' / SEQUENCE DESCRIBED BELOW /C235 / ESC ( 0 / SELECT GRAPHICS CHARACTER SET /C235 LINSTY, TEXT 'QQQQQQQQQQQQQQQQQQQQQQQQQQQ' / GRAPHICS LINE CHARACTER /C235 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED / /A207 /++ /A207 / CALSWAP CALL_A_ROUTINE IN EDITOR SWAP AREA /A207 / /A207 /FUNTIONAL DESCRIPTION: CALSWAP /A207 / /A207 / THIS ROUTINE CAN BE USED TO CALL ANY SUBROUTINE IN THE EDITOR SWAP /A207 / AREA FROM ANY FIELD IN THE SYSTEM AS LONG AS THE EDITOR SWAP AREA /A207 / SUBROUTINE MAKES ONLY A NORMAL OR SKIP RETURN. /A207 / /A207 /CALLING SEQUENCE: CIFMNU (DF = CALLER FIELD) /A207 / JMS CALSWAP /A207 / CALLED ROUTINE RESIDING IN EDITOR SWAP AREA /A207 / DATA FIELD TO SET FOR CALLED ROUTINE /A207 / /A207 /INPUT PARAMETERS: AC = VALUE (IF ANY) NEEDED FOR CALLED ROUTINE /A207 / /A207 /IMPLICIT INPUT: CIDF0, CALSW1, T1, CALSWAP /A207 / /A207 /OUTPUT PARAMETERS: AC = OUTPUT OF CALLED ROUTINE /A207 / MQ = OUTPUT OF CALLED ROUTINE /A207 / DATA AND INSTRUCTION FIELD = CALLING FIELD /A207 / /A207 /IMPLICIT OUTPUT: CALSW1, T1, CALSW2 /A207 / /A207 /COMPLETION CODE: NONE /A207 / /A207 /SIDE EFFECTS: 1) CALSWAP USES T1 /A207 / /A207 /-- /A207 / /A207 CALSWAP,XX / CALL_A_ROUTINE IN EDITOR SWAP AREA /A207 MQL / HOLD VALUE IN AC /A207 RDF / SET UP RETURN CIF CDF INSTRUCTION /A207 TAD (CDF CIF 0) /A207 DCA CALSW1 / SAVE INSTRUCTION /A207 TAD I CALSWAP / GET ADDRESS OF ROUTINE TO JMS TOO /A207 DCA T1 / SAVE IT /A207 ISZ CALSWAP / BUMP RETURN FOR NEXT PARAMETER /A207 TAD I CALSWAP / GET CDF INSTRUCTION /A207 DCA CALSW2 / SAVE IT /A207 ISZ CALSWAP / BUMP RETURN /A207 CALSW2, .-. / HOLDS CIF CDF INSTRUCTION /A207 SWP / RESTORE TO AC CALLING VALUE /A207 JMS I T1 / JMS TO ROUTINE SPECIFIED AT CALLER+1 /A207 SKP / NONSKIP RETURN /A207 ISZ CALSWAP / SKIP RETURN - BUMP RETURN POINTER /A207 CALSW1, .-. / RETURN CIF CDF INSTRUCTION PLACED HERE/A207 JMP I CALSWAP / RETURN TO CALLER /A207 / /A207 / /A207 / /A207 / EFSCLU SCROLL SCREEN UP /A207 / /A207 EFSCLU, XX /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 SCRLUP /A207 CDFBUF /A207 CDFEDT /A207 JMP I EFSCLU /A207 / EFSECO CALL SCECHO IN EDITOR FIELD /A207 / /A207 EFSECO, XX /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 SCECHO /A207 CDFEDT /A207 CDFEDT /A207 JMP I EFSECO /A207 / EFINSR INSERT CHAR IN TEXT BUFFER /A207 / /A207 EFINSR, XX / INSERT CHAR IN TEXT BUFFER /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 INSERT /A207 CDFBUF /A207 CDFEDT /A207 JMP I EFINSR /A207 / EFSLMD SET LINE MODIFIED /A207 / /A207 EFSLMD, XX / SET LINE MODIFIED /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 SETLMD /A207 CDFEDT /A207 CDFEDT /A207 JMP I EFSLMD /A207 / EFBZZR RING THE KEYBOARD BELL /A207 / /A207 EFBZZR, XX / RING THE BELL /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 BUZZER /A207 CDFEDT /A207 CDFEDT /A207 JMP I EFBZZR /A207 / EFADSP ADVANCE ONE PRINT SPACE IN TEXT BUFFER RETURNING CHAR /A207 / /A207 EFADSP, XX / CALL BKPSPC IN EDIT FIELD /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 ESASPC / ROUTINE TO BE CALLED /A207 CDFBUF / SET BUFFER FIELD /A207 SKP / NONSKIP RETURN /A207 ISZ EFADSP / SKIP RETURN /A207 CDFEDT /A207 JMP I EFADSP / RETURN TO CALLER /A207 / EFBKSP BACKUP ONE PRINT SPACE IN TEXT BUFFER RETURNING CHAR /A207 / /A207 EFBKSP, XX / CALL BKPSPC IN EDIT FIELD /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 ESBSPC / ROUTINE TO BE CALLED /A207 CDFBUF / SET BUFFER FIELD /A207 SKP / NONSKIP RETURN /A207 ISZ EFBKSP / SKIP RETURN /A207 CDFEDT /A207 JMP I EFBKSP / RETURN TO CALLER /A207 / EFLDCH GET CURRENT CHAR FROM TEXT BUFFER /A207 / /A207 EFLDCH, XX / CALL LODCHR IN EDT FIELD /A207 CDFMNU /A207 CIFEDT /A207 JMS I (FMSWAP) /A207 LODCHR / ROUTINE TO BE CALLED /A207 CDFEDT / CALL WITH EDITOR DATA FIELD SET /A207 SKP / NONSKIP RETURN /A207 ISZ EFLDCH / SKIP RETURN /A207 CDFEDT /A207 JMP I EFLDCH / RETURN TO CALLER /A207 / EFSSPT SET SPLIT SCREEN FLAG IF NECESSARY /A207 / /A207 EFSSPT, XX / SET SCREEN NEEDS TO BE SET FLAG /A207 CDFEDT / FROM MENU FIELD /A207 /D226 TAD I (SPLTFL) / GET SLPIT FLAG /A207 /D226 SNA /A207 AC7777 / SET TO NEEDS SPLIT /A207 DCA I (SPLTFL) /A207 /D226 CDFEDT /A207 JMP I EFSSPT /A207 / EFCKAL CHECK FOR PRINTING ASCII CHAR /A207 / /A207 EFCKAL, XX / CHKALP IN MENU FIELD /A207 MQL / SAVE AC IN MQ /A207 MQA /A207 AND P177 / STRIP BITS /A207 TAD (-ECSPC) / GREATER THAN SPACE? /A207 SMA SZA /A207 ISZ EFCKAL / YES, OK CODE /A207 CLA MQA / RESTORE AC /A207 CDFEDT /A207 JMP I EFCKAL / RETURN /A207 EFRSLN, XX /A208 CDFMNU /A208 CIFEDT /A208 JMS I (FMSWAP) /A208 RSTRLN /A208 CDFEDT /A208 JMP I EFRSLN /A208 EFADPT, XX /A208 CDFMNU /A208 CIFEDT /A208 JMS I (FMSWAP) /A208 ESAPTR /A208 CDFBUF /A208 SKP /A208 ISZ EFADPT /A208 JMP I EFADPT /A208 X= . PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /A207 EFCKMR, XX / CHK RIGHT MARGIN /A207 DCA CHKMRF / CLEAR HYPHEN FLAG /A207 CDFEDT /A207 TAD I (CURSOR) /A207 TAD (-COLLIM+1) / LIMIT TO SCREEN WIDTH /A207 SMA /A207 JMP CHKMR5 /A207 TAD (COLLIM-COLM81) /M219 SZA CLA /A207 JMP CHKMR1 /A207 TAD I (RGTMAR) /A207 /D226 CLL / CLEAR LINK BEFORE CHECK /A226 TAD (-COLM80) /M219 SMA CLA /A207 JMS EFSSPT / SPLIT SCREEN IF APPROPRIATE /A207 TAD I (SPLTFL) /A207 SNA CLA /A207 JMP CHKMR5 /A207 CHKMR1, TAD I (LINMOD) /A207 SNA CLA /A207 JMP CHKMR9 / NO CHECK IF NO MOD FLAG /A207 TAD I (CURSOR) /A207 CIA /A207 TAD I (RGTMAR) / LIMIT TO RIGHT MARGIN /A207 SMA CLA /A207 JMP CHKMR9 / RETURN IF OK /A207 JMS EFLDCH /JMS LODCHR /A207 JMP CHKMR9 /A207 AND P177 / OR IF ONLY BLANKS OUTSIDE MARGIN /A207 TAD (-ECSPC) /A207 SNA /A207 JMP CHKMR9 /A207 TAD (ECSPC-ECTAB) /A207 SNA CLA /A207 JMP CHKMR4 / DO NOW IF TAB /A207 CHKMR5, CLA /A207 TAD I (CURSOR) /A207 CIA /A207 DCA CHKMRT / SET MOVE LIMIT /A207 CHKMR2, JMS EFBKSP / BKPSPC /A207 JMP CHKMR3 / LOOK FOR BLANK /A207 JMS EFCKAL / JMS CHKALP /A207 JMP CHKMR6 / CHECK FOR HYPHEN POINT /A207 AND (7177) / MASK OUT BOLD AND UNDERLINE BITS /A207 TAD (-ECPHYP) /A207 SNA CLA /A207 JMP CHKMR3 /A207 CLA MQA /A207 AND (2000) /A207 SNA CLA /A207 JMP CHKMR7 /A207 CHKM2A, TAD I (CURSOR) /M244 /A207 TAD CHKMRT /A207 SNA CLA /A207 JMP CHKMR7 / NOT TOO CLOSE /A207 TAD (ECHYLN-ECWWLN) /A207 DCA CHKMRF / SET HYPHEN FLAG /A207 JMP CHKMR3 /A207 CHKMR7, ISZ CHKMRT /A207 JMP CHKMR2 /A207 AC7777 /A207 DCA CHKMRT / HERE IF O.W.L. /A207 TAD I (CURSOR) /A207 TAD CHKMRT /A207 CHKMR3, CMA /A207 DCA CHKMRS / -# TO SKIP BEFORE BREAKING /A207 AC0001 /A207 TAD I (CURSOR) /A207 TAD CHKMRT /A207 TAD CHKMRS /A207 DCA CHKMRT / # TO ADVANCE AFTER BREAKING /A207 JMS EFADSP /ADVSPC /A207 NOP /A207 CLA / GO BACK TO WHERE WE WERE /A207 ISZ CHKMRS /A207 JMP .-4 /A207 TAD CHKMRT /A207 CHKMR4, CMA /A207 DCA CHKMRT / ...IN FORM FOR ISZ LOOP /A207 TAD I (CURSOR) /A207 TAD CHKMRT /A207 IAC /A207 DCA I (CURSOR) / FIX CURSOR /A207 TAD I (CURSOR) /A207 CMA /A207 TAD I (NWHMAR-NWRUL+CURUL) /A207 SMA CLA /A207 JMS EFBZZR /JMS BUZZER / BEEP ON VIOLATION /A207 JMS EFSLMD /SLNMOD /A207 TAD CHKMRF / GET HYPHEN FLAG /A207 TAD (ECWWLN) / +NEW LINE CODE /A207 JMS EFINSR /JMS INSERT /A207 JMS EFSCLU /JMS SCRLUP /A207 JMP CHKMRX /A207 JMS EFSECO /JMS SCECHO /A207 CHKMRX, ISZ CHKMRT /A207 JMP .-2 / GET BACK TO ORIGINAL POSITION /A207 SKP /A207 CHKMR9, ISZ EFCKMR / TAKE SKIP RETURN IF NO WRAPPING DONE /A207 JMP I EFCKMR / THEN RETURN TO CALLER /A207 CHKMRF, 0 /A207 CHKMRS, 0 /A207 CHKMRT, 0 /A207 X= . PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /A207 / /A207 / THIS ROUTINE BELONGS WITH THE CHKMAR ROUTINE, IF ANY ROOM EVER /A207 / SHOWS UP ON THAT PAGE, THIS SHOULD BE MOVED WITH IT. /A207 / /A207 CHKMR6, AND (7177) / ELIM BOLD-UNDL BITS /A207 TAD (-ECSPC) / HARD SPACE? /A207 SNA /M199/A207 JMP CHKMR3 / PROCESS SPACE /A207 TAD (ECSPC-ECTAB) / TAB STOPPER? /A199/A207 SNA /M244 /A207 JMP CHKMR8 / PROCESS TAB /A199/A207 JMP CHKTCC /M244 /A207 CHK8MR, CDFMNU / BACK TO MY FIELD /A199/A207 AC7777 / BUMP POS COUNTER FOR THE SOFT SPACE/A199/A207 TAD CHKMRT / ... /A199/A207 DCA CHKMRT / ... /A199/A207 CHKMR8, JMS EFADSP / SCAN THE SOFT SPACES TO THE END/A199/A207 NOP / /A199/A207 AND (7177) / THE TAB STOP. /A199/A207 TAD (-ECJSPC) / ... /A199/A207 SNA CLA / /A199/A207 JMP CHK8MR / JMP WHILE IN THE TAB. /A199/A207 JMS EFBKSP / BACK UP TO THE PRIOR CHAR. /A199/A207 NOP / /A199/A207 CLA / ... /A199/A207 JMP CHKMR3 / MERGE BELOW /A199/A207 / EFCASE A SUBROUTINE TO PERFORM CASE STYLE CHECKING / / CALL: / / JMS EFCASE / TABLE-1 (ADDRESS OF THE TABLE TO COMPARE AGAINST) / (ON NO MATCH RETURNS HERE) / / AC ==> (VALUE TO COMPARE AGAINST) / / THE COMPARE TABLE HAS THE FORMAT OF: / / VALUE;ADDRESS / VALUE 1 AND ADDRESS TO JUMP TO ON MATCH / VALUE;ADDRESS / VALUE 2 AND ADDRESS TO JUMP TO ON MATCH / ... / ETC. / 0 / TABLE TERMINATOR / / NOTE: THIS SUBROUTINE DESTROYS THE CONTENTS OF AUTO INDEX / REGISTERS 6 AND 7 / CASTMP=IX0 / AUTO INDEX REGISTER 6 X7=IX1 / AUTO INDEX REGISTER 7 EFCASE, XX / ENTRY TO CASE SUBROUTINE DCA CASTMP / SAVE AC FOR COMPARES RDF / SAVE DATA FIELD TAD (CDF 0) / ADD TO CDF TO FIELD 0 DCA EFCS02 / AND PUT FOR RETURN CDFMNU / SET TO MYFIELD TAD I EFCASE / GET THE TABLE ADDRESS DCA X7 / SAVE IN AUTO INDEX REGISTER / / THIS IS THE CHECK LOOP FOR CASE MATCHING / EFCS01, TAD I X7 / GET VALUE SNA / TERMINATOR? JMP EFCSEX / YES TAKE DEFAULT RETURN CIA / NEGATE THE OPERAND TAD CASTMP / COMPARE SNA CLA / MATCHED? JMP EFCSMT / YES! GO TO MATCH EXIT ISZ X7 / SKIP JUMP VECTOR JMP EFCS01 / TRY THE NEXT VALUE / / END OF LOOP / EFCSMT, TAD I X7 / GET RETURN ADDRESS DCA EFCASE / STORE FOR RETURN SKP / DON'T INCREMENT EFCSEX, ISZ EFCASE / SKIP TABLE VECTOR EFCS02, CDFMYF / RESET DATA FIELD JMP I EFCASE / AND GO HOME EFLDNT, XX / INDENT TO LEFT MARGIN EFLDN1, JMS EFBKPT / CHECK LINE ENDING JMP LINDN4 CDFEDT AND P177 / MASK MODE BITS TAD (-ECNWLN) / IS CHAR. = NEW LINE? SZA CLA / SKIP IF: SO JMP EFLDN1 TAD I (CURPTR) / GET CHARACTER BACK DCA T1 CDFBUF TAD I T1 JMS EFCASE / CHECK FOR EOL MARK MATCH CTB001-1 / TABLE ADDRESS FOR CASE / / ECWWLN; LINDN5 / WORD WRAP EOL / ECHYLN; LINDN5 / HYPHENATION EOL / ECPGRF; LINDN3 / PARAGRAPH MARK / ECSLPT; LINDN8 / SELECT POINT / 0 / INDICATE END OF TABLE JMP LINDN4 / OR NORMAL (NOT SELECT ETC...) LINDN8, DCA LINDN2 / FIND CURSOR, IF SELECT POINT LINDN7, JMS EFBKSP JMP LINDN6 AND P177 JMS EFCASE / COMPARE TO EOL MARKS CTB002-1 / TABLE ADDRESS FOR CASE / ECNWLN; LINDN6 / NEWLINE / ECNWPG; LINDN6 / NEW PAGE / ECNDRL; LINDN6 / END RULER / 0 / INDICATE END OF TABLE ISZ LINDN2 JMP LINDN7 LINDN3, CDFEDT TAD I (PGFMAR) / THEN SET PROPER INDENT JMP LINDN9 LINDN4, CDFEDT TAD I (LFTMAR) JMP LINDN9 LINDN5, CDFEDT TAD I (WRPMAR) LINDN9, DCA LINDN2 / INTO LINDN2 LINDN6, CDFEDT TAD I (LINE23) DCA I (CURPTR) / RESTORE TEXT PTR TAD LINDN2 / SEE IF INDENT COUNT IS BEYOND /A203 CIA / THE RIGHT MARGIN. /A203 TAD I (RGTMAR) / IF SO, THEN CHANGE INDENT TO /A203 SPA CLA / INDENT ONLY TO THE LEFT MARGIN. /A203 JMP LINDN4 / ... /A203 LINDN1, CDFEDT TAD LINDN2 CIA TAD I (CURSOR) SMA CLA JMP I EFLDNT / RETURN IF DONE TAD (ECJSPC) JMS EFINSR / ELSE INSERT JSPACE JMS EFSECO / ...ECHO IT JMP LINDN1 / AND LOOP FOR MORE LINDN2, .-. CTB001, ECWWLN; LINDN5 / WORD WRAP EOL ECHYLN; LINDN5 / HYPHENATION EOL ECPGRF; LINDN3 / PARAGRAPH MARK ECSLPT; LINDN8 / SELECT POINT 0 / INDICATE END OF TABLE X= . PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED /A208 / /A208 /FIND_NEXT_TAB_STOP: /A208 / /A208 /ENTER: AC = LINE POSITION /A208 /EXIT: AC = TAB_CLASS /A208 / MQ = POSITION OF TAB IN RULER /A208 / /A208 /PSEUDO CODE: /A208 / SAVE POSITION IN LINE /A208 / /A208 / REPEAT /A208 / INCREMENT SAVED_LINE_POSITION /A208 / GET SAVED_LINE_POSITION + 1 /A208 / CALL EFGTBY (GET RULER SETTING FOR THIS POSITION) /A208 / CALL EFGTBY (SEE WHAT CLASS) /A208 / UNTIL [RULER TAB DETECTED] /A208 / /A208 / SAVE TAB_CLASS IN MQ /A208 / GET POSITION OF TAB IN RULER /A208 / RETURN WITH TAB_CLASS IN AC, POSITION OF TAB IN MQ /A208 / /A208 FNTABSTOP, / FIND_NEXT_TAB_STOP /A208 XX /A208 DCA FNTAB2 / SAVE POSITION ON LINE /A208 FNTAB1, ISZ FNTAB2 / INCREMENT POSITION /A208 NOP / ALLOW LEFT-MARGIN LOOKUP /A208 AC0001 / GET SAVED_LINE_POSITION + 1 /A208 TAD FNTAB2 /A208 JMS EFGTBY /A208 CURUL / GET RULER SETTING OF THIS POSITON /A208 JMS EFGTBY /A208 TBSTR / GET CLASS OF SETTING /A208 SNA / SKIP IF: TAB SETTING /A208 JMP FNTAB1 / NEXT POSITION /A208 MQL / HOLD CLASS IN MQ /A208 TAD FNTAB2 / GET POSITION OF TAB_SETTING /A208 SWP / PUT POSITION IN MQ AND CLASS IN AC /A208 JMP I FNTABSTOP / RETURN /A208 / /A208 / /A208 / /A208 / THIS ROUTINE ORIGIONALLY WAS SET UP TO REFRESH ONLY WHAT NEEDED TO BE /A208 / REFRESHED. DUE TO THE HIGH NUMBER OF EXCEPTION CASES & THE LACK OF SPACE/A208 / TO TEST FOR EACH EXCEPTION, THE ENTIRE LINE WILL BE REPAINTED WHENEVER A/A208 / TAB CHARACTER IS SEEN. /A208 / /A208 EFTJST, XX / JUSTIFY NEXT TAB STOP /A208 CDFEDT /A208 TAD I (RGTMAR) / GET RIGHT MARGIN /A208 CIA / NEGATE IT /A208 TAD I (CURSOR) / GET CURSOR POSITION /A208 SMA CLA / SKIP IF: CURSOR POSITIONED PREVIOUS /A208 / TO THE RIGHT MARGIN /A208 JMP I EFTJST / NOTHING TO DO IF AT RIGHT MARGIN /A208 TAD I (CURPTR) / SAVE POINTER /A208 DCA TBECH3 /A208 TAD I (CURSOR) / INIT TAB SEARCH COUNTER /A208 JMS FNTABSTOP / JMS TO FIND_NEXT_TAB_STOP /A208 / RETURN WITH AC = TAB_CLASS /A208 / MQ = TAB_SET POSITION /A208 / IN RULER /A208 TAD (-2) /A208 DCA TBECH2 / SAVE CLASS /A208 SWP / GET DISTANCE FROM SAVED CURSOR POSIT. /A208 / TO THIS TAB STOP /A208 CIA / NEGATE IT /A208 TAD I (CURSOR) /A208 DCA TBECH1 /A208 TAD TBECH2 / TEST CLASS OF TAB /A208 SPA CLA / SKIP IF: NOT NORMAL TAB /A208 JMP TBECHB / JUMP IF NORMAL TAB /A208 TBECHC, JMS EFADSP /A208 JMP TBECHB / SEARCH FOR TERMINATOR /A208 CDFEDT /A208 TAD (-ECCMRK) / IGNORE MARKER /A208 SNA CLA /A208 JMP TBECHC / IGNORE MARKER. GET NEXT CHAR. /A208 TBECHX, TAD TBECH2 / TEST CLASS /A208 SNA CLA /A208 JMP TBECHD / JUMP IF RIGHT-ADJUSTED TAB /A208 CDFEDT /A208 TAD I (CURPTR) / ELSE CHECK FOR DECIMAL TERMINATOR /A208 DCA T1 /A208 CDFBUF /A208 TAD I T1 /A208 AND P177 /A208 IFDEF PERDEC < /A208 TAD (-".+200) /A208 SZA /A208 TAD (".-")) /A208 > / END IFDEF PERDEC /A208 IFDEF COLDEC < /A208 TAD (-":+200) /A208 SZA /A208 TAD (":-")) /A208 > / END IFDEF COLDEC /A208 IFDEF COMDEC < /A208 TAD (-",+200) /A208 SZA /A208 TAD (",-")) /A208 > / END IFDEF COMDEC /A208 SNA CLA /A208 JMP TBECHB / JUMP IF GOT ONE /A208 TBECHD, CDFEDT /A208 TAD I (CURPTR) / CHECK FOR RIGHT-ADJUST TAB TERMINATOR /A208 DCA T1 /A208 CDFBUF /A208 TAD I T1 /A208 AND P177 / STRIP MODE BITS /A208 TAD (-ECSTOV) / CHARACTER = "START_DEAD_KEY_SEQ."? /A208 SZA / SKIP IF: SO /A208 TAD (ECSTOV-ECSPC) /A208 SPA CLA /A208 JMP TBECHB / JUMP IF GOT ONE /A208 ISZ TBECH1 /A208 JMP TBECHC / LOOP IF WE CAN /A208 JMP TBECHE / ELSE NOTHING TO DO /A208 TBECHB, TAD TBECH2 / WAS THIS A DECIMAL TAB OR NORMAL TAB? /A208 SZA CLA / SKIP IF: NORMAL TAB /A208 ISZ TBECH1 / REDUCE DISTANCE CNT BY 1 FOR DECIMAL TAB/A208 NOP /A208 TBECHE, JMS EFRSLN / SET REFRESH FLAGS FOR ENTIRE LINE. /A208 TBECHF, CDFEDT /A208 TAD TBECH3 /A208 DCA I (CURPTR) / RESTORE PTR /A208 TAD TBECH1 / GET DISTANCE COUNT /A208 SMA CLA / SKIP IF: JUSTIFYING SPACES NEEDED /A208 JMP I EFTJST / RETURN IF NO SPACES NEEDED /A208 TBECHG, JMS EFADPT /A208 NOP / ELSE INSERT THEM /A208 CLA /A208 TAD (ECJSPC) / GET "JUSTIFY_SPACE" CHARACTER /A208 JMS EFINSR / INSERT IT /A208 ISZ TBECH1 / BUMP COUNT /A208 JMP TBECHG / MORE 'JUSTIFY_SPACES" TO INSERT /A208 JMP TBECHF / RETURN AFTER RESTORING CURPTR /A208 / /A208 / TEMPS: /A208 FNTAB2, / SAVED_LINE_POSITION (USED BY /A208 / FNTABSTOP ROUTINE) /A208 TBECH1, .-. / LOADED WITH CURSOR POSITION /A208 TBECH2, .-. / LOADED WITH CLASS OF RULER SETTING /A208 TBECH3, .-. / LOADED WITH CURPTR /A208 / EFBKPT BACKUP CURPTR / / EFBKPT, XX CDFMNU CIFEDT JMS I (FMSWAP) ESBPTR CDFBUF SKP ISZ EFBKPT CDFBUF JMP I EFBKPT CTB002, ECNWLN; LINDN6 / NEWLINE ECNWPG; LINDN6 / NEW PAGE ECNDRL; LINDN6 / END RULER 0 / INDICATE END OF TABLE X= . PAGE DSKBLK=.-SWPBEG%400+DLSTAT / DISK BLOCK WHERE PAGE IS LOADED EFGTBY, XX / TAD INDEX - JMS EFGTBY - SPTR /A208 / RETURNS BYTE /A208 TAD (-1) /A208 CLL RAR /A208 CDFMNU /A208 TAD I EFGTBY / GET PTR /A208 DCA T1 /A208 CDFEDT /A208 TAD I T1 / GET WORD /A208 SNL /A208 BSW / GET BYTE /A208 AND P77 / ISOLATE IT /A208 ISZ EFGTBY /A208 JMP I EFGTBY / AND RETURN /A208 / / CROSS FIELD CALLS FOR FIELD 3 / EFPOUT, XX / call putout routine CDFMYF CIFEDT JMS I (FMSWAP) EDOCHR CDFEDT JMP I EFPOUT / CALLING SEQUENCE / / CDIMNU / JMS I (TCCHK) / RETURN + 0 = REGULAR DEAD KEY SEQEUENCE / RETURN + 1 = REQUIRED SPACE / RETURN + 2 = F6 FUNCTION / / THE INTERNAL DEAD KEY SEQUENCE FOR A TECHNICAL CHARACTER IS AS FOLLOWS: / / SD SP GS CH ED / / SD = START DEAD INDICATOR / SP = SPACE / GS = GRAPHICS SET G1 - G3 (OCTAL CODE 61-63) / TC = TECHNICAL CHARACTER / ED = END DEAD INDICATOR / WHEN CALLED THE START DEAD INDICATOR HAS ALREADY BEEN FOUND / TCCHK has been modified as of edit 244. /M244 / The purpose is to allow TCCHK to perform the same function /M244 / but split it into two routines /M244 / 1. Checks the dead key as above /M244 / (this to run only in field 2) /M244 / 2. Displays the tech char if found /M244 / /M244 / The purpose is to allow other routines to access TCCHK or /M244 / something similar /M244 / / TCCHK, XX / Set up to call TCCHR /M244 JMS TCCHR / Call scan routine /A244 JMP TCDED / Ordinary dead /A244 JMP TCREQ / Required space /A244 / /A244 / Must be tech so print it /A244 / /A244 TAD TCTEMP / WE PAST ALL THE CHECK POINTS DISPLAY THE TC AND (3) / START BY ACTIVATING THE PROPER CHARACTER SET SNA / EXCEPTION, TEST FOR GRAPHICS SET SELECTION 0 JMP TCTEC / NOT ALLOWED, DISPLAY IT AS A NORMAL DEAD/M244 TAD (JMP TCJMP) / BUILD JUMP TO PROPER SET GRAPHICS DISPLAY CODE DCA .+1 TCJMP, XX JMP TCGS1 / GO SET GRAPHICS SET 1 JMP TCGS2 / GO SET GRAPHICS SET 2 TAD (ESC) / SET GRAPHICS SET 3 JMS EFPOUT TAD (157) / TAD A SMALL o JMS EFPOUT JMP TCCONT TCGS1, TAD (16) / SET GRAPHICS SET 1 JMS EFPOUT JMP TCCONT TCGS2, TAD (ESC) / SET GRAPHICS SET 2 JMS EFPOUT TAD (156) / TAD A SMALL n JMS EFPOUT / FALL INTO NEXT ROUTINE TCCONT, TAD TCTMP1 / DISPLAY CHARACTER IN PROPER TECHNICAL CHAR SET JMS EFPOUT TAD (17) / RESET GRAPHICS TO DEFAULT SET JMS EFPOUT CDFEDT DCA I (PUTSC6) / TELLS VIEW CODE IT WAS NOT A REQUIRES SPACE CDFMYF TCTEC, ISZ TCCHK /A244 TCREQ, ISZ TCCHK /A244 TCDED, CDIEDT / Change back to Edit field /A244 JMP I TCCHK / Return /A244 / / This is a stripped down version of TCCHK that only checks /M244 / the dead key and does the skip return stuff /M244 TCCHR, XX CLL CLA / DEAD KEY ALREADY DETECTED BY CALLING ROUTINE JMS EFADPT / CHECK IF NEXT CHARACTER IS A SPACE NOP CDFEDT DCA I (PUTSC6) / STORE HERE TAD I (PUTSC6) / GET CHARACTER BACK CDFMYF AND P177 / MASK OUT ATTRIBIUTE BITS TAD (-ECSPC) / CHECK FOR SPACE SZA CLA JMP TCEX0 / NORMAL DEAD KEY SEQUENCE JMS EFADPT / CHECK NEXT CHARACTER NOP DCA TCTEMP / IF TC STORE GRAPHICS SET INDICATOR TAD TCTEMP / IF THIS CHARACTER IS A SPACE THEN EXIT AND P177 / JUST TO BE SURE BUT SHOULD NOT NEED IT TAD (-ECSPC) / IS SECOND CHARACTER A SPACE SNA CLA JMP TCEX1 / YES, WE HAVE A REAL REQUIRED SPACE EXIT IFNDEF CONDOR < JMP TCEX0 > / NO, EXIT IF DM1 - IT HAS NO TEC. CHARS JMS EFADPT / GET NEXT CHARACTER NOP / WHICH IS THE TECHNICAL CHARACTER DCA TCTMP1 / AND STORE IT JMS EFADPT / TEST FOR END DEAD INDICATOR TO MAKE NOP / SURE THE USER IS NOT PLAYING GAMES WITH TAD (-ECNDOV) / US. THAT IS A TC IS NOT DEADED WITH A SZA CLA / NORMAL CHARACTER. BAD TECHNICAL CHARACTER JMP TCEX0 / OUTPUT A HASH CHARACTER TCEX2, ISZ TCCHR / RETURN + 2 = TECHNICAL CHAR SET /M244 TCEX1, ISZ TCCHR / RETURN + 1 = REQUIRED SPACE /M244 / RETURN + 0 = NORMAL DEAD KEY TCEX0, JMS TCBKUP / Backup to start dead /M244 /d244 CDIEDT CDFEDT / Map to Edit field /M244 JMP I TCCHR / RETURN TO CALLER /M244 TCTEMP, 0 / HOLDS GRAPHICS SELECTION CHARACTER TCTMP1, 0 / HOLDS TECHNICAL CHARACTER / / This is a cross field callable version of TCCHR from Editor / TCCHX, XX /A244 JMS TCCHR / Call TCCHX to scan dead /A244 JMP TCRDED / Normal dead /A244 JMP TCRREQ / required space /A244 ISZ TCCHX / Bump return for tech /A244 TCRREQ, ISZ TCCHX / /A244 TCRDED, CIFEDT / Back to Editor /A244 JMP I TCCHX / And return /A244 / / This routine is a refugee from the CHKMR2 code since there is /A244 / no rrom there /A244 / It checks for hyphenation on a tech dead to allow hyphenation /A244 / on 8 bit /A244 CHKTCC, TAD (ECTAB-ECSTOV) / Is it a start dead ? /A244 SZA CLA / /A244 JMP CHKMR7 / No.. so rejoin code /A244 JMS TCCHR / Scan for tech dead /A244 JMP CHKMR7 / no .. ordinary /A244 JMP CHKMR7 / Required space /A244 TAD TCTMP1 / Get char /A244 AND (2000) / Is it hyphenated ? /A244 SNA CLA / /A244 JMP CHKMR7 / No /A244 JMP CHKM2A / Yes /A244 X=. /-------------- PAGE EFCNTR, CDFEDT /A217 TAD I (LINE23) /A217 DCA I (CURPTR) / FIND CURRENT INDENT /A217 DCA LNECHA /A217 JMS EFLDCH /A217 NOP / BY COUNTING JUSTIFY SPACES /A217 LNECH2, TAD (-ECJSPC) /A217 SZA CLA /A217 JMP LNECH6 /A217 ISZ LNECHA /A217 JMS EFADPT /A217 NOP /A217 JMP LNECH2 /A217 LNECH6, CDFEDT /A217 TAD I (CENMAR) /A217 CIA /A217 TAD I (CURSOR) / COMPUTE -#SPACES /A217 TAD LNECHA /A217 SMA /A217 JMP LNECH3 / JUMP IF NONE /A217 CLL CML RAR /A217 DCA LNECHA /A217 TAD LNECHA /A217 TAD I (RGTMAR) /A217 CIA /A217 TAD I (CURSOR) /A217 SPA SNA /A217 JMP LNECH4 /A217 TAD LNECHA /A217 SMA /A217 JMP LNECH3 /A217 DCA LNECHA /A217 LNECH4, CLA /A217 TAD (ECJSPC) /A217 JMS EFINSR /A217 ISZ LNECHA /A217 JMP .-3 / DO SPACES /A217 LNECH3, CLA /A217 CIFEDT /A217 CDFBUF /A217 JMP CNTREX /A217 LNECHA, .-. /A217 / / CALPSH (CALLAR PUSH) / Edit number 227 for whole routine /A227 / / This routine takes the address and data field of the routine / who called CALLAR, and pushes the values onto the stack. / / Note: If the stack overflows the routine will halt with AC = 0 / CALPSH, 0 / Push CALL A ROUTINE ADDRESS ONTO THE STACK ISZ CALPTR / Update stack pointer TAD I CALPTR / Have we exceed the stack table length SNA CLA JMP CALERR / YES!! Hit a stack boundry CRASH SOFTWARE CDFEDT / No TAD I (CALLAR) / Get calling routines address CDFMYF DCA I CALPTR / And push it onto the stack ISZ CALPTR / Update stack pointer CDFEDT TAD I (CALFLD) / Get INSTRUCTION field of calling routine CDFMYF DCA I CALPTR / And push it onto the stack CDIEDT JMP I CALPSH / Return / / CALPOP (CALLAR POP) / Edit number 227 for whole routine /A227 / / This routine will restore CALLAR's return with the last / CDI and ADDRESS on the stack. / / Note: If a return is attemped without an address / the routine will halt with AC = 1. / CALPOP, 0 / POP A CALL A ROUTINE ADDRESS OFF OF THE STACK TAD I CALPTR / Do we have an address to pop SNA JMP CALERR+1 / NO!! Crash the software CDFEDT / Yes DCA I (CALFLD) / Store return field CDFMYF CLA CMA / Backup stack pointer TAD CALPTR DCA CALPTR TAD I CALPTR / Get return address CDFEDT TAD I (CALSKP) / Add skip return offset DCA I (CALLAR) / Store return address CLA CMA / Back stack pointer TAD CALPTR DCA CALPTR CDIEDT JMP I CALPOP / Return CALERR, SKP CLA / Exceeded end of stack boundry AC0001 / Exceeded top of stack boundry HLT / STOP - Don't let the user go any further JMP .-1 / Just in case they try to proceede CALPTR, CALSTK / Pointer into stack CALSTK, 0000 / Top of stack boundry 7777;7777 / A stack for ten cross field calls 7777;7777 / Any non zero value will do. 7777;7777 7777;7777 7777;7777 7777;7777 7777;7777 7777;7777 7777;7777 7777;7777 0000 / End of stack boundry / / This routine belongs to TCCHK etc. but.. there's no room there /M244 / Backing up pointer to start dead was made a routine /M244 / TCBKUP, XX TCBKLP, JMS EFBKPT / LEAVE POINTER AT BEGINNING OF DEAD KEY SEQUENCE NOP TAD (-ECSTOV) SZA CLA JMP TCBKLP JMP I TCBKUP X=. /-------------- PAGE NWRUL, ZBLOCK HAFRUL / Allocate workspace 0000 / buffer terminator / THE FOLLOWING LOCATIONS WITH THE EXCEPTION OF NWDT, HOLD THE POSITION / NUMBER WITHIN THE RULER OF THE SETTINGS SPECIFIED. FOR EXAMPLE, A / RULER OF L1, R5 WOULD SET NMLMAR = 1 AND NWRMAR = 5. AFTER RULER / MODIFICATION THESE PARAMETERS ARE TRANSFERED ALONG WITH NWRUL TO CURUL. RLSTOR, NWLMAR, 0 / NEW LEFT MARGIN MARKER NWRMAR, 0 / NEW RIGHT MARGIN MARKER NWWMAR, 0 / NEW WORD WRAP INDENT MARKER NWPMAR, 0 / NEW PARAGRAPH INDENT MARKER NWCMAR, 0 / NEW CENTERING POINT MARKER NWHMAR, 0 / NEW HYPHENATION ZONE MARKER NWDT, 0 / NEW DECIMAL TABS - NUMBER OF DECIMAL TABS / IN THE RULER. NWRLND=. / End of ruler marker PAGE SWPEND, / DEFINE END OF SWAP AREA CODE SO / THAT REMANING AREA CAN BE CLEARED RELOC / RESET RELOCATION MECHANISM OF ASSEMBLER /*************************************************************************** /**** PAGE ZERO DEFINITIONS FOR MAIN EDITOR IN FIELD 3 **** /*************************************************************************** FIELD 1 / EDITOR LOADS HERE BUT RUNS IN FIELD THREE *100 CDFMYF= CDFEDT / DEFINE CDF INSTRUCTION FOR EDIT FIELD ZZCASE= JMS I . / CASE STYLE COMPARISONS (SIMILAR TO GDCASE / SWITCH IN "C" ) HLTTST= JMS I . / TEST HALT FLAG SET BY GOLD HALT USHLTS GETINP= JMS I . / CALL SYS TO GET CHARACTER FROM KEYBOARD EDICHR PUTOUT= JMS I . / PUT CHARACTER TO DISPLAY EDOCHR MODSET= JMS I . / SET OR CLEAR EDIT MODES ESMODE INSCHR= JMS I . / INSERT CHARACTER INTO TEXT BUFFER ESICHR /M241 /m239 ADVPTR= JMS I . / ADVANCE CURPTR TO NEXT NON-NULL CHAR IN FILE ESAPTR BKPPTR= JMS I . / BACKUP CURPTR TO NEXT NON-NULL CHAR IN FILE ESBPTR CHKPTR= JMS I . / CHECK CHARACTER IN TEXT BUFFER FOR: ESATST / NULL - ETX - STX STATUS TSTSLT= JMS I . / TEST FOR SELECT MODE ACTIVE ESLCTS ADVCHR= JMS I . / ADVANCE CURPTR A SPECIFIED COUNT OF NON-NULL ESACHR / CHARACTERS IN TEXT BUFFER / (NEVERS SCROLLS TO/FROM DISK) CURMOV= JMS I . / MOVE CURSOR FORWARD OF BACKWARD FOR A ESMVCR / SPECIFIED NUMBER OF CHARACTERS SLNMOD= JMS I . / SET LINE MODIFIED FLAGS (NOT IN BUFFER) SETLMD PUTESC= JMS I . / SEND ESCAPE SEQUENCES TO DISPLAY ESPTES XLTUPR= JMS I . / TRANSLATE LOWER CASE TO UPPER CASE ESXLUP ADVSPC= JMS I . / ADVANCE CURPTR A SCREEN CHARACTER WIDTH ESASPC BKPSPC= JMS I . / BACKUP CURPTR A SCREEN CHARACTER WIDTH ESBSPC PUTETX= JMS I . / PUT CHARACTER TO DISK AT END OF FILE ESPUTE PUTSTX= JMS I . / PUT CHARACTER TO DISK AT START OF FILE ESPUTS OVLJMP= JMS I . / CALL IN OVERLAY CODE AND EXECUTE OVJUMP SINZRO, / START OF INITED-TO-ZERO CONTROL WORDS RLRMOD, 0 / RULER MOD FLAG GETTRM, 0 / INPUT TERMINATOR RLPOSN= GETTRM / CURRENT RULER POSITION GETLEN, 0 / INPUT LENGTH SLCTDR, 0 / SELECT DIRECTION PSTBLK, 0 / CURRENT PASTE BLOCK PSTPTR, 0 / CURRENT PASTE BUFFER PTR BASKCT, 0 / CURRENT WASTEBASKET COUNT EDMODE, 0 / CURRENT EDIT MODES - / 0 = ADVANCE UNIT / 1 = BACKUP UNIT / 2 = BOLD UNIT / 3 = UNDERLINE UNIT / 4 = REMOVE BOLD UNIT / 5 = REMOVE UNDERLINE UNIT / 6 = CASE UNIT (UPPER/LOWER CASE) / 10 = SEARCH MODE / 20 = SELECT MODE GRAMUN, 0 / CURRENT GRAMMATICAL UNIT / 0 = CHARACTER, 1 = LINE, 2 = WORD, / 3 = SENTENCE, 4 = TAB POSITION, / 5 = PARAGRAPH, 6 = PAGE CURPTR, 0 / CURRENT LOC IN TEXT BUFFER CURSOR, 0 / CURRENT SCREEN COLUMN SCRLCT, 0 / SCREEN LAG - NUMBER OF LINES LEFT TO SCROLL SCRNFL, 0 / "WHOLE SCREEN" SCROLL FLAG / 0 = NO NEED TO SCROLL WHOLE SCREEN, / 2000 = SCROLL WHOLE SCREEN SCRLFL, 0 / SCROLL FLAG FOR BKP/ADV PCTLFL, 0 / PRINT CONTROL FLAG / 0 = NOT IN START CONTROL BLOCK, / -1 = IN START CONTROL BLOCK SPACNG, 0 / CURRENT HALF-SPACING (2-4) CURLIN, 0 / CURRENT SETCUR LINE (REL TO BOTTOM OF SCREEN) SCRLCU, 0 / NON-ZERO IF SCREEN NEEDS MODIFICATION SCRLIN, 0 / EARLIEST LINE OF SCREEN NEEDING MODIFICATION REJCNT, 0 / USED TO COUNT MODS TIL REJUST TIME REJFLG, 0 / SET TO -1 IF REJUST NEEDED LINMOD, 0 / "LINE MODIFIED" FLAG WORD ECHFLG, 0 / "ALWAYS ECHO" FLAG SRCDIR, 0 / SEARCH DIRECTION, ALSO USED BY GO-TO-PAGE MRGRSF, 0 / MERGE RESYNC FLAG CPYFNO= MRGRSF / IS CHARACTER AT LEAST A "0" ? CASBIT= CPYFNO / BIT SET FOR UP/LOW/BOLD/UNDL GETPSF= CASBIT / GET PST EOF FLG MRGPT1, 0 / MERGE TEMP PTR GLDPSF= MRGPT1 / "EXACT PASTE FLAG" RLDIRN= MRGPT1 / GOLD RULER DIRECTION (0-FORW; -1 REV) MRGPT2, 0 / MERGE TEMP PTR NINZRO= .-SINZRO / LENGTH OF INITED TO ZERO CTL WORDS /D226 SPLTFL, 0 / -1= SCREEN NEEDS TO BE SPLIT /D226 / 0 = SCREEN DOES NOT NEED TO BE SPLIT (WIDE) /D226 / 1 = SCREEN IS SPLIT (WIDE) /---------- / / O R D E R I M P O R T A N T / / These next 5 words have been moved beyond the page 0 / locations that are cleared during initialization. / /---------- LFTMAR, 0 / CURRENT LEFT MARGIN RGTMAR, 0 / CURRENT RIGHT MARGIN WRPMAR, 0 / CURRENT WORD WRAP MARGIN PGFMAR, 0 / CURRENT PARAGRAPH INDENT MARGIN CENMAR, 0 / CURRENT CENTER, *2 /---------- / / E N D O R D E R I M P O R T A N T / /---------- BUFBEG, 0 / PTR TO START OF EDIT BUFFER BUFSIZ, 0 / SIZE OF EDIT BUFFER FORMNO, 0 / MERGE FORM FILE NUMBER FILENO, 0 / EDIT FILE NUMBER FILOPT, 0 / EDIT OPTION (-1 RPLAC, 0 NORMAL) LINE23, 0 / LINE23 PTR SPCCHK, 0 / -# BLKS MIN BEFORE COMPLAINT GSRF, 0 / GLOBAL SEARCH AND REPLACE FLAG CURTMP, 0 / TEMP CURSOR STORAGE FOR VIEW MODE CHRATR, 0 / ATTRIBUTE OF CHAR GOING THRU BLKBOX SCRNLN, 0 / NUMBER OF LINES IN SCROLL AREA WIDNAR, WIDTH-COLM81 / 0 = WIDE, 64 (52 DEC) = NARROW SCREEN /A226 IFDEF FORIN < POINT1, 0 / POINTER FOR TABLE SCAN FOR FOREIGN CHARACTERS POINT2= X3 / TEMP STORAGE CHAR1= X4 / ALSO TEMP STORAGE > / END IFDEF FORIN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** START OF MAIN EDITOR CODE **** /*************************************************************************** EDITOR, XX JMP EDIOP1 EDMERG, XX / MERGE ENTRY /D221 RDF / GENERATE RETURN CIF CDF INSTRUCTION /D221 TAD CIDF0 /D221 DCA EDEXI3 CDFMYF / CHANGE DATA FIELD TO THIS FIELD /A221 DCA I EDITOV / CLEAR OVERLAY NUMBER TO FORCE LOAD /A221 OVLJMP;OVMRG1 / FIRST OVERLAY EDITOV, OVLAY1 / LOCATION OF OVERLAY AREA /A221 EDIOP1, CDFMYF / CHANGE DATA FIELD TO THIS FIELD /A221 CLA / DUMMY INSTRUCTION TO TAKE UP ROOM /A221 DCA I EDITOV / CLEAR OVERLAY NUMBER TO FORCE LOAD /A221 /D221 RDF / GENERATE RETURN CIF CDF INSTRUCTION /D221 TAD CIDF0 /D221 DCA EDEXI3 OVLJMP;OVINI1 / INIT FOR NORMAL EDIT REEDIT, OVLJMP;OVINIT / DO INIT OVERLAY JMP EINEXA / CONTINUE 'NORMAL' EDIT /M204 EIFILE, OVLJMP;OVXITF / DO EXIT OVERLAY JMP EDEXI3 / NORMAL EXIT / MUST BE HERE BECAUSE OF A CALL FROM MN1 UPON FINISHING USING THE SYSTEM EDCLPB, XX / CLEAR CUT/PASTE BUFFER /D221 RDF /D221 TAD CIDF0 /D221 DCA EDEXI4 CDFMYF / CHANGE DATA FIELD TO THIS FIELD /A221 CLA / DUMMY INSTRUCTION TO TAKE UP ROOM /A221 DCA I EDITOV / CLEAR OVERLAY NUMBER TO FORCE LOAD /A221 OVLJMP;OVCLPB EDEXI4, CDIMNU / SET DATA & INSTRUCTION FIELDS TO MENU /M221 JMP I EDCLPB / RETURN TO MAIN MENU EDEXI3, CDIMNU / SET DATA & INSTRUCTION FIELDS TO MENU /M221 JMP I EDITOR / RETURN TO MAIN MENU OLDHR, 0 / HOURS AT START OF EDIT OLDMIN, 0 / MINUTES AT START OF EDIT EITOP, OVLJMP;OVEXIT / CLOSE THE DOCUMENT JMP REEDIT / NOW RESUME 'NORMAL' EDIT FROM TOP LINDNT, XX / INDENT TO LEFT MARGIN CIFMNU CDFEDT JMS I (CALSWA) EFLDNT CDFEDT JMP I LINDNT / /++ / CALLAROUTINE CALL_A_ROUTINE / /FUNCTIONAL DESCRIPTION: CALLAROUTINE / / This routine can be used to call any subroutine in the editor from any / field in the system as long as the editor subroutine makes only a normal / or skip return. / /CALLING SEQUENCE: CIFEDT (DF = CALLER FIELD) / JMS CALLAR / Rouitne in field 3 to be called / Data field to set for called routine / /INPUT PARAMETERS: LINK, AC, MQ can equal any value that may be required / by the routine being called / / MQ = value (if any) needed for called routine / /IMPLICIT INPUT: CIDF0, CALLA1, T1, CALLAROUTINE / /OUTPUT PARAMETERS: LINK, AC, MQ = Output values set by called routine / Data and Instruction field = Calling field / /IMPLICIT OUTPUT: CALLA1, T1, CALLA2 / / FMSWAP, / Rewrite of CALL_A_ROUTINE /M227 CALLAR, XX / CALL_A_ROUTINE DCA CALSAC / Store value of AC RDF / Get field of calling routine TAD CIDF0 / and build a CIF CDF return DCA CALFLD / Store the return field call TAD I CALLAR / Get address of routine to be called DCA CALADD / store it ISZ CALLAR TAD I CALLAR / Get data field to set DCA CALCDF / store it ISZ CALLAR / Set up return address DCA CALSKP / Init skip return pointer CDFMNU / Set field to menu swap area /A233 TAD I (CALLN1+2) / This is a test to see if CALPSH, /A233 TAD (-NOP) / CALPOP rouitines are indeed in memory /A233 SZA CLA / /A233 JMP .+3 /A233 HLT / CALPSH, CALPOP are not loaded /A233 JMP .-1 / crash system!!! /A233 CDIMNU JMS I (CALPSH) / Push the information onto the stack TAD CALSAC / Restore the AC CALCDF, XX / CDF for routine being called JMS I CALADD / Call the routine SKP ISZ CALSKP DCA CALSAC / Store value of AC CDIMNU JMS I (CALPOP) DCA CALSKP / Clear flag for next return /A231 TAD CALSAC / Restore AC CALFLD, XX / CAlling field CID return JMP I CALLAR / Return to routine CALADD, 0 / CALLING ADD OF FIELD 3 ROUTINE CALSKP, 0 / ZERO = RETURN AT CALL+1, 1=CALL +2 CALSAC, 0 / STORE AC TEMP REG / This routine origionally was set up to refresh only what needed to be / refreshed. due to the high number of exception cases & the lack of space / to test for each exception, the entire line will be repainted whenever a / tab character is seen. / TBJUST, XX / JUSTIFY NEXT TAB STOP /A208 CDFEDT /A208 CIFMNU /A208 JMS I (CALSWA) /A208 EFTJST /A208 CDFEDT /A208 JMP I TBJUST /A208 BEEPER, XX JMS BUZZER CIFSYS / CLEAR UDK STACK UDKOPS JMP I BEEPER BUZZER, XX AC0006 IAC / SET AC TO 7 (saves 1 location) PUTOUT JMP I BUZZER BLDBIT= CASBIT BLDUNT, TAD (200) / SET... NBDUNT, DCA BLDBIT / ...OR CLEAR BOLDING OVLJMP;OVBOLD CHKMAR, XX / CHK RIGHT MARGIN /A207 CDFEDT / CALL IN MENU FIELD /A207 CIFMNU /A207 JMS I (CALSWA) /A207 EFCKMR /A207 CDFEDT /A207 SKP / NON-SKIP RETURN /A207 ISZ CHKMAR / SKIP RETURN /A207 CDFBUF JMP I CHKMAR /A207 EDOCHR, XX CDFMYF DCA HLDCHR / SAVE CHAR TO BE OUTPUT TAD HLDCHR / RESTORE CHAR AND (3600) / MASK OFF ATTRIBUTE BITS DCA CHRATR / AND SAVE FOR FUTURE REFERENCE TAD HLDCHR / RESTORE CHAR TO CONTINUE / BLKBOX WHICH HANDLES CHARACTERS TO BE DISPLAYED ON THE VT100 RESIDES / IN FIELD 1. GO THERE TO DISPLAY THIS CHARACTER. CIFPRT / "BLACKBOX" IN PRINTER FIELD (1) JMS I (BLKBOX) JMP I EDOCHR HLDCHR, 0 / TEMP STORAGE FOR BLKBOX ROUTINE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE /********************** )/ RESTORE CHAR TO CONTINUE / BLKBOX WHICH HANDLE /**** START OF RESIDENT OVERLAY AREA **** /**** THIS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED OVLAYM, / THIS SYMBOL IS USED BY L.P. AND SPELL / *** ENTRY POINTS FOR UNIMPLEMENTED OPERATIONS *** /d215 EITABC, / ** NOT IMPLEMENTED YET ** EIBAD, JMS BEEPER / NOTIFY USER OF ERROR EIFXT2, /A168 EIFIX, CLA / MAKE SURE WE ARE ON A LEGAL CHARACTER EIFIX1, CURMOV NOP / IGNORE TOP OR BOTTOM OF DOCUMENT MODSET /M168 EDTMOD / RESET MODES EINEXT, / GET INPUT CHARACTER CDFMYF / CHANGE BACK TO MY DATA FIELD CLA DCA ECHFLG / CLEAR ECHO MODE GSKILN, CIFSYS / REPLACED WITH A "SKIP" BY G.S.R. CODE XLTIN IFDEF DEMO < *.-2 NOP NOP > / END 'IFDEF DEMO' EINEXA, SKP CLA / XLTIN RETURN WITH NO CHARACTER /M168 JMP EINEXB / XLTIN RETURN WITH CHARACTER IN AC DCA ECHFLG / CLEAR ECHO MODE /A168 CURMOV NOP JMS TSTLIM JMS FXSCRL CDFMYF / NEEDED WHEN BACKING UP INTO A LONG LINE /A236 CIFMNU / CHANGE TO MENU FIELD FOR STATUS CHECK JMS I (CALLN5) / GO CHECK IF STATUS VALUES HAVE CHANGED /C235 GETINP / GO WAIT FOR USER TO ENTER A CHARACTER IFNDEF FORIN < EINEXB, SMA JMP OVSCHK /M254 > / END IFNDEF FORIN IFDEF FORIN < EINEXB, DCA CHAR1 OVLJMP ACCENT EINEXC, > / END IFDEF FORIN /*************************************************************************** /**** CAUTION - RESIDENT OVERLAY AREA **** /**** THIS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** EINEXD, MQL / TUCK THE CHAR ACL TAD (-EDUPAR) / CHECK FOR UP AND DOWN ARROW SNA JMP EINEXM TAD (EDUPAR-EDDNAR) SNA CLA JMP EINEXM AC7777 DCA REMCUR / NEITHER, SET "REMCUR" TO -1 EINEXM, ACL / GET CHARACTER BACK CMA TAD (-EDXVLN) / TEST FOR OK SMA JMP EIBAD TAD (EDXVEC+EDXVLN) / MAKE POINTER TO TRANSFER VECTOR TABLE DCA T1 / STORE FOR INDIRECT PICKUP CDFLP / CHANGE TO FIELD WHERE TABLE LOCATED TAD I T1 / PICK UP ROUTINE ADDRESS CDFMYF / CHANGE BACK TO THIS FIELD DCA T1 / STORE FOR INDIRECT JUMP TO ROUTINE JMP I T1 / TRANSFER TO ROUTINEE REQUESTED /*************************************************************************** /**** CAUTION - RESIDENT OVERLAY AREA **** /**** THIS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** / GOTO PAGE entrance for emulating ADVANCE PAGE.... RPGETUNT,XX / ADVANCE A PAGE CLA / CHAR. PASSED BY LODCHR TAD RPGETUNT / RETURN (A) AND ARG. PTR. DCA GETUNT / FOR NORMAL PROCESS JMP GETRPT / FOR NON-CONTINUOUS ECHO /=========================================================================== /==== THIS IS A CO-ROUTINE TYPE SUBROUTINE ==== /=========================================================================== GETUNT, XX / CO-ROUTINE ENTRY POINT AC0001 / SET FOR CONTINUOUS ECHO GETRPT, DCA ECHFLG / GOTO PAGE NON-CONTINUOUS ECHO DCA OVSFLG / CLEAR OVERSTRIKE FLAG (DEAD KEY) JMS LODCHR / LOAD FIRST AVAILABLE CHARACTER JMP GETUNZ / END OF FILE - AC=0 JMS CHKUNT / AC = CHARACTER OR BUFFER CODE GETUNX, XX / CHKUNT CO-ROUTINE RETURN POINT SMA SZA / CHECK FOR VALID CHARACTER JMP GETUNY / YES, GO HANDLE IT GETUNQ, SMA CLA / WAS THIS A SPECIAL CHARACTER TAD I CURPTR / YES, NOT DONE, GET CHARACTER BACK GETUNZ, JMS I GETUNT / GETUNT CO-ROUTINE RETURN POINT SZA / IS A CHARACTER BEING RETURNED ? DCA I CURPTR / YES, STORE IT IN THE BUFFER TAD OVSFLG / GET THE OVERSTRIKE FLAG (DEAD KEY) SZA / IS IT SET ? JMP GETUNO / YES, GO HANDLE DEAD KEY SEQUENCE TAD I CURPTR / NO, GET THE CURRENT CHARACTER TAD (-ECSTOV) / COMBINE THIS WITH START OF DEAD KEY CODE SNA CLA / IS THIS THE START OF DEAD KEY SEQUENCE ? JMP GETUNP / YES, GO HANDLE IT GETUNY, AC0001 / NO, SET UP TO MOVE TO NEXT CHARACTER CURMOV / GO DO THE MOVE JMP GETUNZ / END OF FILE, GO HANDLE IT JMS LODCHR / PICK UP THE NEXT AVAILABLE CHARACTER JMP GETUNZ / END OF FILE, GO HANDLE IT JMP I GETUNX / RETURN TO CHKUNT /*************************************************************************** /**** CAUTION - RESIDENT OVERLAY AREA **** /**** THIS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** GETUNP, ISZ OVSFLG / SET OVERSTRIKE FLAG (DEAD KEY) GETUNO, SPA CLA / CHECK VALUE OF FLAG JMP GETUNR / JUMP IF END OF OVERSTRIKE ADVPTR / ADVANCE TO NEXT BUFFER CHARACTER JMP GETUNZ / END OF FILE, GO HANDLE IT TAD (-ECNDOV) / COMBINE WITH END OF DEAD KEY CODE SZA CLA / IS THIS THE END OF THE DEAD KEY SEQUENCE ? JMP GETUNQ / NO, GO AND GET THE CHARACTER BACK AC7777 / YES, THIS IS THE END OF THE DEAD KEY DCA OVSFLG / SET END FLAG JMP GETUNQ / GO AND GET THE CHARACTER BACK GETUNR, DCA OVSFLG / SHOW OVERSTRIKE DONE (DEAD KEY) ADVPTR / MOVE TO NEXT BUFFER CHARACTER NOP / GET PAST END CODE BKPSPC NOP / BACK UP TO BEGINNING JMP GETUNY / NOW REALLY ADVANCE OVER IT OVSFLG, .-. /*************************************************************************** /**** CAUTION - RESIDENT OVERLAY AREA **** /**** THIS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** / / A REQUEST FOR V2 GOTO-PAGE, GOLD:BOTTOM, OR GOTO-RULER / IS BEING PROCESSED. / / NOTE: 'OVEXIT' AND 'OVINIT' ARE CALLED AS SUBROUTINES, AND SO / MUST NOT USE ANY ADDITIONAL OVERLAYS (I.E., MUST NOT USE 'OVLJMP') / RPTOP, OVLJMP;OVEXIT / AC => 0, GO CLOSE DOC AND RETURN HERE OVLJMP;OVINIT / REOPEN DOCUMENT, THEREBY FILLING THE / APPROPIATE BUFFERS WITH THE DOCUMENT / HEADER BLOCK AND RPPGDS BLOCK / PREVENT DISPLAY OF DOCUMENT HDR INFO / WHEN REPAINTING SCREEN CDFFIO / CHANGE TO FILE SYSTEM FIELD TAD I (SCFSPC) / GET NUMBER OF BLOCKS LEFT ON DISK CDFMYF / BACK TO THIS FIELD JMS MNUPUT / STORE VALUE FOR USE BY STATUS LINE LINFRE-MUBUF / LOCATION IN FIELD 2 FOR BLOCKS FREE OVLJMP;OVRRP2 / GO PERFORM THE GOTO-PAGE, GOLD:BOTTOM, / OR GOTO-RULER REQUEST EIHELP, OVLJMP;OVHELP / HELP COMMANDS EIINTB, OVLJMP;OVGLTB / GOLD:TAB (INDENT TABS) /A215 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** END OF RESIDENT OVERLAY AREA **** /**** PREVIOUS AREA IS OVERLAYED BY LIST PROCESSING AND SPELL **** /*************************************************************************** DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED EIRBSE, IAC / RUB OUT SENTENCE EIRBWD, IAC / RUB OUT WORD EIRBLN, IAC / RUB OUT LINE EIRBCH, / RUB OUT CHARACTER DCA GRAMUN / SET UNIT TYPE TAD (ECTMRK) / INSERT MARKER JMS INSERT JMS BACKUN / BACK UP ONE UNIT JMS BEEPER TAD (CNTMOD) JMP DELUNT / USE DELETE CODE CNTUN1, JMS CHKUNR CNTUNT, TAD (-ECTMRK) SZA CLA JMP CNTUN1 DCA I CURPTR JMS SCRNMD / SHOW SCREEN MODIFIED JMP LSTUNT / QUIT WUEN MARK FOUND GOTMRK, IAC SLXMOD, IAC EIENTR, IAC EIPAGE, IAC EIPARA, IAC EITABP, IAC EISENT, IAC EIWORD, IAC EILINE, IAC EICHAR, DCA GRAMUN / SET UNIT TYPE JMS SETUNT TAD EDMODE / GET CURRENT MODE AND (MVMASK) TAD (JMP I MVJTAB) / GET JUMP TO RIGHT ROUTINE DCA .+1 JMP I .-. MVJTAB, ADVUNT / ADVANCE BKPMOD= .-MVJTAB BKPUNT / BACK UP BLDMOD= .-MVJTAB BLDUNT / BOLD UDLMOD= .-MVJTAB UDLUNT / UNDER LINE NBDMOD= .-MVJTAB NBDUNT / REMOVE BOLD NUDMOD= .-MVJTAB NUDUNT / REMOVE UNDER LINE CASMOD= .-MVJTAB CASUNT / UPPER/LOWER CASE MVMASK= 7 SETUNT, XX / SET UNIT TAD GRAMUN TAD (JMP I MVCTAB) / MAKE JUMP OUT OF UNIT CODE DCA MVCODE / AND STORE IT DCA SCRLFL / CLEAR SCROLL FLAG JMP I SETUNT CHKUNR, XX / USED FOR OFF-PAGE CALLS JMS I CHKUNT JMP I CHKUNR CHKUNH, XX / SAME AS CHKUNR, BUT TEST HALT FLAG HLTTST AC7777 / RETURN "DONE" IF SET CDFBUF JMS I CHKUNT JMP I CHKUNH CHKUNT, XX MVCODE, JMP I .-. SETBNT, XX / SET FOR BACKUP TAD (MVBTAB-MVCTAB) JMS SETUNT JMP I SETBNT MVBTAB, CHRBNT LINBNT WRDBNT SNTBNT TABBNT PARUNT PAGBNT FLDBNT MVCTAB, CHRUNT LINUNT WRDUNT SNTUNT TABUNT PARUNT PAGUNT FLDUNT SLCTMD= .-MVCTAB / "SELECT" TYPE CODE SLTUNT CNTMOD= .-MVCTAB / "COUNT" TYPE CODE CNTUNT ECFIEL= 76 / CODE FOR FIELD DELIMITER (RIGHT ANGLE) FLDBN1, JMS CHKUNR FLDBNT, AND P177 TAD (-ECFIEL) SNA CLA JMP FLDBN1 FLDBN2, JMS CHKUNH FLDUNT, AND P177 TAD (-ECFIEL) SZA CLA JMP FLDBN2 FLDUN3, AC0001 JMS CHKUNH AND P177 TAD (-ECFIEL) SNA CLA JMP FLDUN3 JMP LSTUNT LINUN1, JMS CHKUNR LINUNT, LINBNT, CLA TAD SCRLFL SNA JMP LINUN1 LINUN2, SMA JMP LSTUNT CHRUNT, SPA CLA TABUN2, AC0001 JMS CHKUNR / RETURN CODE TO CO-ROUTINE CALLER LSTUNT, CHRBNT, AC7777 / SET DONE CODE JMP LSTUNT-1 / GO RETURN CODE TO CALLER SLTUN1, JMS CHKUNR / MAKE CALL TO CHKUNT SLTUNT, JMS ESLCTD / CHECK FOR SELECT MARK AND DELETE IT JMP SLTUN1 / NOT FOUND, GO CHECK NEXT CHARACTER DCA EDMODE / FOUND, CLEAR THE EDIT MODE FLAG JMP LSTUNT / GO RETURN DONE CODE TO CALLER RPCUBK, 0 / Rapid Paging CUrrent BlocK id # X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED WRDUN1, JMS CHKUNR WRDBNT, JMS WRDTST SNA CLA JMP WRDUN1 WRDUN2, JMS CHKUNR WRDUNT, JMS WRDTST SZA CLA JMP WRDUN2 WRDUN3, AC0001 JMS CHKUNR JMS WRDTST SNA CLA JMP WRDUN3 JMP LSTUNT WRDTST, XX JMS PARCHK SZA TAD (ECNWPG-40) SZA TAD (40-ECTAB) JMP I WRDTST SNTUNX, XX SKP SNTUN1, JMS CHKUNR JMS WRDTST SNA CLA JMP SNTUN1 SNTUN3, JMS CHKUNH JMS PARCHK SZA TAD (ECNWPG-".+200) SZA TAD (".-"!) SZA TAD ("!-"?) SZA CLA JMP SNTUN3 JMP I SNTUNX SNTBNT, JMS SNTUNX JMP WRDUN3 SNTUNT, JMS SNTUNX JMP WRDUN3+1 TABUNT, AND P177 / MASK OFF ATTRIBUTES TAD (-ECTAB) SNA CLA JMP TABUN2 TAD SCRLFL SZA JMP LINUN2 TABBNT, CLA JMS CHKUNR JMP TABUNT PARUN0, JMS CHKUNR PARUNT, JMS PARCHK SNA CLA JMP PARUN0 PARUN1, JMS CHKUNH MQL MQA TAD (-ECPGRF) SNA CLA JMP PARUN2 / STOP QUICK ON GRAF MARKER MQA JMS PARCHK SZA CLA JMP PARUN1 JMS CHKUNR JMS PARCHK SZA CLA JMP PARUN1 PARUN2, AC0001 JMS CHKUNR JMS PARCHK SNA CLA JMP PARUN2 JMP LSTUNT PARCHK, XX AND P177 TAD (-ECNWLN) SZA TAD (ECNWLN-ECNWPG) JMP I PARCHK PAGBN1, JMS CHKUNR PAGBNT, JMS WRDTST SNA CLA JMP PAGBN1 PAGUN1, JMS CHKUNH PAGUNT, TAD (-ECNWPG) SZA TAD (ECNWPG-ECPMRK) SZA CLA JMP PAGUN1 JMP WRDUN3 / IF AC= SELECT POINT / THEN BUMP RETURN ADDRESS / SET THE LINE MODIFIED FLAG / DELETE SELECT POINT FROM BUFFER / DELETE ALL CHARACTERS FOLLOWING IT UNTIL THE NEXT CHARACTER WHICH / IS NOT A JUSTIFIED SPACE OR A LINE MODIFIED CHARACTER OR A RULER / MODIFIED CHARACTER. / IF A RULER MODIFIED CHARACTER IS FOUND SET THE RULER MODIFIED FLAG ESLCTD, XX TAD (-ECSLPT) / IF AC=SELECT POINT SZA CLA / JMP I ESLCTD / ISZ ESLCTD / THEN BUMP RETURN ADDRESS SLNMOD / SET LINE MODIFIED FLAG SLTUN2, DCA I CURPTR / LOOP, DELETE CHAR SLTUN4, JMS LODCHR / GET_CHAR (FROM EDIT BUFFER) JMP I ESLCTD / EXIT IF END OF FILE TAD (-ECJSPC) / EXIT IF CHAR .NE. (JUSTIFIED SPACE SNA CLA / JMP SLTUN2 / JMS CHKLMD / OR RULER MOD OR LINE MOD) JMP I ESLCTD / (RETURNS HERE IF NOT A 'MODIFIED' CHAR) JMP SLTUN4 / END_LOOP X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED ESMODE, XX / SET EDIT MODE CDFMYF AC7777 TAD I ESMODE / GET ARG PTR DCA X0 TAD EDMODE / GET MODE AND I X0 / CLEAR SOME,... TAD I X0 / ...AND SET SOME DCA EDMODE ISZ ESMODE / BUMP TO RTN ADR JMP I ESMODE / AND RETURN / ESAPTR ADVANCE CURPTR 1 CHARACTER / / THIS ROUTINE WILL ADVANCE TO THE NEXT NON-NULL CHARACTER AFTER / THE CURRENT POSITION. IT UPDATES CURPTR TO POINT TO THIS / CHARACTER. IF THE CURRENT CHAR POINTED TO IS A NULL THEN THE / FIRST NON-NULL CHARACTER IS RETURNED. IF THE CHAR CURRENTLY / POINTED TO IS NOT NULL THEN THE NEXT NON-NULL CHAR IS RETURNED. / / CALL: / / ADVPTR / CALLED THROUGH PAGE ZERO / / / ESAPTR, XX / ENTRY POINT TO ESAPTR CLA / GET CHARACTER AT CURRENT POSITION CHKPTR / RETURN AC < 0 IF ETX IN BUFFER / AC = 0 IF NULL CHAR / AC > 0 IF OK CHARACTER SPA / ETX IN BUFFER? JMP ESAPT2 / YES, GO GET CHAR FROM DISK SZA CLA / NULL? AC0001 / NOT NULL ADVANCE 1 CHAR ADVCHR / ADVANCE TO NEXT NON-NULL CHARACTER SPA / REAL CHARACTER (NOT ETX)? JMP ESAPT2 / ETX FOUND, GO EXPAND ESAPT1, ISZ ESAPTR / INCREMENT FOR SKIP RETURN SKP / SKIP OVER CLEAR FOR NON-SKIP RETURN ESAPT4, CLA / NON-SKIP RETURN SO CLEAR AC JMP I ESAPTR / BYE-BYE ESAPT2, JMS ESGETE / GET NEXT CHARACTER FROM DISK SPA SNA / LEGAL CHARACTER? JMP ESAPT4 / NO TAKE NON-SKIP RETURN. ETX IN FILE! DCA I CURPTR / PLACE CHARACTER IN BUFFER. OVERWRITING / ETX MARK AC0001 / MOVE FORWARD ONE CHARACTER CHKPTR / RETURN AC <= 0 THEN OK TO INSERT ETX MARK / AC > 0 THEN MUST SAVE CHAR FIRST SPA SNA CLA / OK TO OVERWRITE? JMP ESAPT3 / YES, GO SHOVE IT IN. TAD I CURPTR / GET CHARACTER TO WRITE TO DISK PUTSTX / PUT CHARACTER OUT TO DISK ESAPT3, TAD (ECETX) / RESTORE OVERWRITTEN ETX MARKER DCA I CURPTR AC7777 / BACKUP TO CHARACTER RETRIEVED FROM DISK CHKPTR JMP ESAPT1 / AND TAKE SKIP RETURN / ESBPTR BACKUP CURPTR 1 CHARACTER / / THIS ROUTINE WILL BACKUP TO THE NEXT NON-NULL CHARACTER BEFORE / THE CURRENT POSITION. IT UPDATES CURPTR TO POINT CHARACTER. / IF THE CURRENT CHARACTER POINTED TO IS A NULL THEN THE FIRST / NON-NULL CHARACTER BEFORE THE CURRENT POSITION IS RETURNED. / / CALL: / / BKPPTR / CALL THROUGH PAGE ZERO LINK / / / ESBPTR, XX / ENTRY POINT ESBPT1, AC7777 / BACKUP ONE CHARACTER CHKPTR / RETURN AC < 0 IF STX IN BUFFER / AC = 0 IF NULL / AC > 0 IF LEGAL CHAR SMA SZA / LEGAL CHARACTER? JMP ESBPT3 / YES GO TAKE SUCCESSFUL EXIT SMA CLA / STX IN BUFFER? JMP ESBPT1 / NO, NULL SO LOOP TILL NON-NULL JMS ESGETS / GET CHARACTER FROM DISK SPA SNA / LEGAL CHAR? JMP ESBPT4 / STX IN FILE GO EXIT DCA I CURPTR / PUT CHARACTER IN TEXT BUFFER AC7777 / BACKUP A CHARACTER CHKPTR / RETURN AC <= 0 THEN OK TO INSERT STX / AC > 0 THEN PUT CHAR TO DISK SPA SNA CLA / MUST SAVE CHARACTER? JMP ESBPT2 / NO CAN OVERWRITE TAD I CURPTR / GET CHARACTER FROM BUFFER AND PUTETX / WRITE TO DISK ESBPT2, TAD (ECETX) / INSERT START OF TEXT MARK DCA I CURPTR / INTO BUFFER AC0001 / REPOSITION OVER CHARACTER BACKED UP TO CHKPTR ESBPT3, ISZ ESBPTR / SUCCEEDED SO SKIP RETURN JMP I ESBPTR / BYE BYE ESBPT4, AC0001 / REPOSITION OVER FIRST CHARACTER IN FILE CHKPTR CLA / CLEAR AC SINCE NOT FOUND JMP I ESBPTR / AND TAKE FAILURE RETURN EIPGRF, TAD (ECPGRF-ECNWLN) / Paragraph marker. EINWLN, TAD (ECNWLN-ECENLN) / Offset to GOLD:CENTER DCA T2 / save for overlay. OVLJMP;OVNWLN / Process new-line (check for CENTERED). TAD T2 / Get return code. EICENT, TAD (ECENLN-ECTAB) EITAB, TAD (ECTAB-ECPHYP) EIHYP1, TAD (ECPHYP) EINSRT, EIFXT1, JMS CHKSPC / CHECK FOR SPACE BEFORE INSERTING ANYTHING CDFBUF / LET'S PUT THIS IN THE RIGHT FIELD, NOW JMS ESIMCH / INSERT IT /M241 JMP EIFXT2 SWTHMA, XX / "MA" SWTHMA ROUTINE CDFMNU / CHANGE TO MENU DATA FIELD SNA CLA / WANT TO SAVE THE "MA" SWITCH? JMP SWTHM1 / NO: THEN RESTORE "MA" ORIGINAL STATE TAD I (MUBUF+MNMATH) / YES: THEN GET THE "MA" PRESENT SETTING DCA STORMA / SAVE IT FOR AFTER G-T-P OR GOLD-BOT DONE DCA I (MUBUF+MNMATH) / SHUT SWITCH TO DEACTIVATE MATH FOR NOW JMP SWTHM2 / GO SET UP TO RETURN TO CALLER SWTHM1, TAD STORMA / GET BACK THE ORIGINAL "MA" SETTING DCA I (MUBUF+MNMATH) / RESTORE THE "MA" SWITCH SETTING SWTHM2, CDIEDT / CHANGE BACK TO EDITOR DATA FIELD JMP I SWTHMA / RETURN TO CALLER STORMA, 0 / HOLDS ORIGINAL SETTING OF MA SWITCH HDRPUT, XX / JMS HDRPUT - HDROFST (AC=VALUE) CDFMYF MQL AC7776 TAD I HDRPUT ISZ HDRPUT CIFFIO FILEIO XHDRPT JMP I HDRPUT / SVSLCR SAVE SELECT CURSOR POSITION /A209 / /A209 / THIS ROUTINE IS USED FOR RECTANGULAR CUT AND PASTE TO GIVE /A209 / ONE OF THE COLUMN DELIMITER BOUNDARIES /A209 / /A209 / CALL: /A209 / /A209 / JMS SVSLCR /A209 / /A209 / /A209 / N O T E ! ! ! /A209 / ------------- /A209 / /A209 / THE LOCATION SLCRPT MUST REMAIN ON THE /A209 / SAME PAGE AS THE SVSLCR CODE. IF IT IS /A209 / MOVED TO A DIFFERENT PAGE (OTHER THAN ZERO) /A209 / THIS ROUTINE WILL NOT WORK!!!! /A209 / /A209 / /A209 SVSLCR, XX /ENTRY POINT /A209 TAD CURSOR /GET CURRENT CURSOR POSITION /A209 DCA SLCRPT /SAVE SELECT CURSOR POSITION /A209 JMP I SVSLCR /RETURN /A209 SLCRPT, ZBLOCK 1 /SELECT CURSOR POSITION SAVE LOCATION /A209 CTB009, ECSLPT; SCRTM1 / SELECT POINT ECPCT2; SCRTM2 / END CONTROL ECPCT1; SCRTM4 / START CONTROL 0 / INDICATE END OF TABLE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED IFDEF CONDOR < DM1ADJ= 0 > / SCREEN LINE ADJUSTMENT FOR DECMATE 2 /A226 IFNDEF CONDOR < DM1ADJ= -12 > / SCREEN LINE ADJUSTMENT FOR DECMATE 1 /A226 / REPOSITION CURSOR BY SENDING ESCAPE SEQUENCE: / [ CURLIN ; CURSOR H PCUR, XX DCA CURPOS / SAVE THE AC / PUT OUT THE CONTROL STRING INTRODUCER. PUTESC / OUTPUT AN ESCAPE CHARACTER TO SCREEN "[-200 / FOLLOWED BY THE "[" CHARACTER / PUT OUT THE FIRST DIGIT STRING. TAD WIDNAR / GET THE WIDE-NARROW FLAG /C226 SNA CLA / IN SPLIT SCREEN MODE ? /C226 TAD (DM1ADJ) / YES, MAKE SCREEN ADJUSTMENT FOR DMI /C226 TAD CURLIN / NO, COMBINE WITH CURRENT LINE COUNT TAD SCRNLN / ADD SIZE OF SCROLL AREA CIFMNU / INVOKE THE OUTDIG ROUTINE TO OUTPUT THE JMS OUTDIG / LINE POSITION IN BASE 10 ARGUMENTS. TAD (";-200) / INSERT A SEMI-COLON BETWEEN ARGUMENTS PUTOUT / PUT OUT THE SECOND DIGIT STRING. TAD CURPOS / GET THE CURSOR POSITION SPA / IF DESIRED POSITION IS LEFT OF SCREEN CLA / THEN DO COLUMN 1 / FOR SOME REASON, THIS ARGUMENT IS ONE TOO SMALL. HENCE, / IN VT-278 MODE WE INCREMENT BEFORE CALLING OUTDIG IAC / INCREMENT THE COLUMN NUMBER CIFMNU / INVOKE THE OUTDIG ROUTINE TO OUTPUT THE JMS OUTDIG / COLUMN POSITION IN BASE 10 ARGUMENTS. TAD ("H-200) / PUT OUT THE ENDING H PUTOUT JMP I PCUR / RETURN / TEST LIMITS FOR 132 COLUMN MODE OF VT100 TSTLIM, XX /D226 TAD SPLTFL / IN SPLIT SCREEN MODE? /D226 SNA CLA / SKIP IF YES. /D226 JMP TSTLMB / JMP TO RETAIN/SET 80 COL MODE. TAD WIDNAR / GET OFFSET FOR WIDE/NARROW (0 OR 52) /A223 TAD (-WIDTH) / ADD NEGATIVE SCREEN WIDTH = -132 OR -80 DCA SCNSZ / STORE FOR SCREEN SIZE CHECK /A223 TAD WIDNAR / GET OFFSET AGAIN (0 OR 52) /A223 SZA / /A223 TAD (4) / FIX MARGIN TEST OFFSET (0 OR 56) /A223 TAD (-COLLIM-2+WIDTH) /-242+132=-110 (+0 OR 56 = -110 OR -54) /M223 DCA MARG / STORE AS MARGIN CHECKER /A223 TAD CURSOR / TAD MARG / /A223 SPA SNA CLA / IS CURSOR IN LEFTMOST PART OF SCREEN? JMP TSTLMA / JMP IF YES. SET LOWLIM. TSTLMD, TAD CURSOR /A223 TAD SCNSZ /A223 SPA / IS CURSOR IN RIGHT PART OF SCREEN? /M223 JMP TSTLME / NO, /M226 TAD LOWLIM / YES; WITHIN BOUNDS OF THIS SCREEN? /A223 SPA CLA /A223 JMP TSTLME / MAYBE /A223 TAD MARG / NO, ADJUST LOW LIMIT BY SCREEN MARGIN /A223 TSTLMF, TAD LOWLIM /A223 DCA LOWLIM /A223 JMS CLSSET / INITIALIZE SCROLL POINTERS FOR STATUS JMP TSTLMD / RE-CHECK FOR NEXT SCREEN /A223 TSTLME, CLA /A226 TAD CURSOR / DID WE BACKUP PAST LOW LIMIT OF SCREEN?/A223 TAD LOWLIM / /A223 SMA CLA /A223 JMP TSTLMX / NO /A223 TAD MARG / YES, ADJUST LOW LIMIT DOWN BY MARGIN /A223 CIA JMP TSTLMF / /A223 TSTLMA, TAD LOWLIM / YES. /A223 SZA CLA / IS LOWLIM SET TO LEFT? /A223 JMS CLSSET / NO, INIT SCROLL POINTERS FOR STATUS /A223 TSTLMB, DCA LOWLIM / RESET LOWLIM FOR 80 COL RESET. TSTLMX, JMP I TSTLIM SCNSZ, -COLM81 / SCREEN SIZE (-132 OR -80), INIT:NARROW/A223 CENTER, XX / CENTER LINE CIFMNU / CALL IN MENU FIELD /M217 JMP EFCNTR /M217 CNTREX, JMP I CENTER / RETURN /M217 /KEEP NEXT TWO LINES TOGETHER!!! /A223 MARG, / MARGIN CHECK SIZE FOR WIDE/NARROW /A223 LNECHT, XX / ECHO HYPHEN OR SELECT POINT TAD (-ECHYLN) / compare with hyphen character SNA / Is it a hyphen? JMP LNECH1 / yes, so print hyphen character TAD (ECHYLN-ECSLPT) / no, is it a select point? SZA CLA JMP I LNECHT / no, return to caller / Here if character is a select point JMS PUTSPC / yes, display select point in EXGSLC / special graphics mode then return JMP I LNECHT / / Here if character is a hyphen LNECH1, TAD CHRATR / GET ATTRIBUTE OF PREVIOUS CHAR TO / APPEND W/HYPHEN TAD (55) PUTOUT / DO HYPHEN JMP I LNECHT SCRLTX, XX / REFRESH CURRENT CURSOR LINE TAD (PTRBLK+NPTRS-1) DCA SCRLT1 TAD CURPTR DCA SCRLT2 / SAVE CURPTR TAD CURSOR DCA SCRLT3 / AND CURSOR DCA CURPOS / RESET CHAR COUNTER TO START OF LINE. TAD I SCRLT1 / GET LINE PTR SNA JMP SCRLTY / CHECK FOR STX MSG IF 0 DCA CURPTR JMS PUTLIN TAD SCRLT2 DCA CURPTR / RESTORE TAD SCRLT3 DCA CURSOR JMP SCRLTZ / AND RETURN SCRLTY, ISZ SCRLT1 TAD I SCRLT1 / TEST ONE AFTER THE NULL SZA CLA TAD (STXMSG) JMS PGMSG / OUTPUT --TOP-- OR BLANKS SCRLTZ, JMP I SCRLTX / AND RETURN SCRLT1, 0 SCRLT2, 0 SCRLT3, 0 EISUBS, AC7776 EISUPS, DCA CASBIT OVLJMP;OVSUPS X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED EIDLTW, AC0002 / SET GRAMMATICAL UNIT FOR WORD DELETION EIDLTC, / SET GRAMMATICAL UNIT FOR CHARACTER DELETION DELUNT, DCA GRAMUN OVLJMP;OVDLTE / JUMP TO DELETE OVERLAY CHKRPC, XX / CHECK FOR ECSTRL (START OF RULER), / ECPCT1 (START CONTROL), / ECPCT2 (END CONTROL) / RTN 1 IF ECSTRL / RTN 2, AC=0 IF REDUNDANT PCTL / RTN 2, AC=INPUT IF OK MQL MQA /D206 TAD (-ECSTRL) /D206 SZA /D206 ISZ CHKRPC / BUMP RTN ADDR IF NOT RLR START /D206 TAD (ECSTRL-ECPCT2) /D206 SNA /D206 JMP CHKRP2 / JUMP IF END PRINT CNTRL /D206 TAD (ECPCT2-ECPCT1) /D206 SZA ZZCASE /A206 CTB015-1 /A206 / ECSTRL; CHKRP1 / START RULER /A206 / ECPCT2; CHKRP2 / END CONTROL /A206 / ECPCT1; CHKRP3 / START CONTROL /A206 / 0 /A206 ISZ CHKRPC /A206 JMP CHKRP1 / JUMP IF NOT PRINT CNTRL CHKRP3, AC0001 / CHECK FOR REDUNDANT CONTROL /M206 CHKRP2, ISZ CHKRPC / SET TO SKIP RETURN /A206 TAD PCTLFL SZA / SKIP IF REDUNDANT CHKRP1, CLA MQA / ELSE RETURN INPUT JMP I CHKRPC CTB015, ECSTRL; CHKRP1 / START RULER /A206 ECPCT2; CHKRP2 / END CONTROL /A206 ECPCT1; CHKRP3 / START CONTROL /A206 0 /A206 PTDASH, XX / OUTPUT ARG2 A TOTAL OF ARG1 TIMES CDFMYF TAD I PTDASH DCA PTDSH1 PTDSHA, TAD ("-&177) PUTOUT ISZ PTDSH1 JMP PTDSHA ISZ PTDASH JMP I PTDASH PTDSH1, .-. MNUGET, XX / JMS MNUGET - MNOFST - RETURNS VALUE IN AC CDFMYF TAD I MNUGET / GET OFFSET ISZ MNUGET TAD MNUCAL+1 / ADD BASE DCA T1 CDFMNU TAD I T1 / GET VALUE CDFMYF JMP I MNUGET / AND RETURN MNUPUT, XX / JMS MNUPUT - MNOFST / EXPECTS VALUE IN AC DCA T2 / SAVE VALUE CDFMYF TAD I MNUPUT / GET OFFSET ISZ MNUPUT TAD MNUCAL+1 / ADD BASE DCA T1 CDFMNU TAD T2 DCA I T1 / STORE VALUE CDFMYF JMP I MNUPUT / AND RETURN SCRLPX, XX / SET UP AUTO-INDEX REGISTERS FOR SCRLUP TAD (PTRBLK) / GET POINTER TO POINTER BLOCK DCA X0 / STORE IN AUTO-INDEX REGISTER TAD (PTRBLK-1) / GET POINTER TO POINTER BLOCK -1 DCA X1 / STORE IN AUTO-INDEX REGISTER TAD (-NPTRS+1) / PICK UP ONE LESS LINE COUNT DCA X2 / STORE VALUE IN COUNTER JMP I SCRLPX / RETURN BACK TO SCRLUP ROUTINE / THIS ROUTINE WILL BACK UP TO THE NEXT CHARACTER. IF THE CHARACTER IS / AN END DEAD KEY SEQUENCE CODE THEN IT WILL BACK UP UNTIL IF FINDS THE / START DEAD KEY SEQUENCE AND RETURN THAT CHARACTER. / IT TAKES A SKIP RETURN UNLESS IT FINDS THE START_OF_TEXT IN WHICH CASE / IT TAKES A REGULAR RETURN / DATA FIELD MUST BE SET TO BUFFER FIELD (CDFBUF) ESBSPC, XX / BACK UP CHARACTER (BKPSPC) ESBSP3, BKPPTR JMP I ESBSPC / BACK UP TO FIRST NON_NULL CHARACTER TAD (-ECNDOV) / IF CHAR = END_DEAD_KEY_SEQUENCE SZA CLA / THEN JMP ESBSP2 / REPEAT ESBSP1, BKPPTR JMP I ESBSPC / BACK UP TO FIRST NON_NULL TAD (-ECSTOV) / SZA CLA / JMP ESBSP1 / UNTIL CHAR = START_DEAD_KEY_SEQUENCE ESBSP2, TAD I CURPTR / GET CHAR AGAIN ISZ ESBSPC / BUMP RETURN ADDRESS JMP I ESBSPC / RETURN / THIS ROUTINE ADVANCES TO THE NEXT CHARACTER WHICH TAKES A SPACE ON THE SCREEN / THEREFOR IT WILL RETURN THE FIRST CHARACTER OF A DEAD KEY SEQUENCE BUT NOT / ANY CHARACTER FOLLOWING IN THAT SEQUENCE. ESASPC, XX / ADVANCE SPACE (ADVSPC) CLA / CLEAR AC CHKPTR / GET CURRENT CHARACTER SMA JMP ESASP1 / USE LODCHR ONLY IF MIGHT BE ETX ADVPTR / ETX IN BUFFER GET NEXT CHAR FROM FILE JMP I ESASPC / ESASP1, TAD (-ECSTOV) / IF LAST CHARACTER RETURNED FROM THIS ROUTINE / WAS START OF DEAD KEY SEQUENCE SZA CLA / THEN SKIP OVER ALL REMAIN CHARS IN SEQUENCE JMP ESASP3 / / REPEAT ESASP2, ADVPTR JMP I ESASPC / GET PART OF COMPOSITE CHARACTER TAD (-ECNDOV) / SZA CLA / JMP ESASP2 / UNTIL CHAR = END OF DEAD KEY SEQUENCE / REPEAT ESASP3, ADVPTR JMP I ESASPC / GET CHARACTER ISZ ESASPC / BUMP RETURN ADDRESS JMP I ESASPC / RETURN TO CALLER WITH CHAR IN AC SCHMOD= 10 / SEARCH MODE FLAG SLTMOD= 20 / SELECT MODE FLAG EDTMOD, SCHMOD!SLTMOD / CLEAR SEARCH AND SELECT MODE BITS 0 / DON'T SET ANY MODE BITS SETCUR, XX TAD LOWLIM TAD CURSOR JMS PCUR JMP I SETCUR / THE FOLLOWING IS USED BY V2 GOTO PAGE OVERLAYS... CURPG1, 1 / EDIT BUFFER PAGE # (UNITS,TENS,HUNDREDS) / THE FOLLOWING ROUTINE IS CALLED BY BOTH SCRLUP AND SCRLDN. IT / COUNTS THE NUMBER OF LINES SCROLLED (CNSCRL) FOR THE PREV/NEXT / SCREEN ROUTINES (DOES NOT ADJUST PAST 0) / ENTER: AC = SCROLL DIRECTION (+=UP, -=DOWN) / / WHEN IT IS DONE COUNTING, THE ROUTINE GETS THE SCROLL DIRECTION / BACK AND CALLS ROUTINE SCRADJ (NOTE THAT CALLS TO THIS ROUTINE / REPLACED CALLS TO ROUTINE SCRADJ IN THE TWO SCROLLING MODULES) SCRAD0, XX DCA T1 / SAVE THE SCROLL DIRECTION TAD CNSCRL / GET THE COUNTER SZA / IF IT'S 0, KEEP IT THERE TAD T1 / INCREMENT OR DECREMENT DCA CNSCRL / AND STORE IT BACK TAD T1 / GET SCROLL DIRECTION BACK JMS SCRADJ / GO WHERE WE HEADED IN THE 1ST PLACE JMP I SCRAD0 / AND THEN BACK TO WHERE WE CAME FROM CNSCRL, .-. / THE COUNTER / / GOTO-RULER VARIABLE / RRDIR, .-. / DIRECTION WE ARE MOVING TO RULER: / 1 = ADVANCING / -1 = BACKING UP / 0 = NOT DOING GOTO-RULER EIGADV, OVLJMP;OVGADV / GOLD ADVANCE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED INSERT, XX / INSERT (AC) IN BUFFER DCA ESICH1 / SAVE CHAR TAD CURPTR DCA ESICH2 / AND CURPTR DCA ESICH3 / INIT CNTR ESICHA, CHKPTR / CHECK CURPTR SNA SPA CLA JMP ESICHX / JUMP ON ETX OR NULL TAD ESICH1 MQL / GET INSERT TAD I CURPTR / GET CURRENT CHAR ESICHE, SWP / SWAP THEM DCA I CURPTR / STORE INSERT ISZ ESICH3 / BUMP CNTR ISZ CURPTR / AND CURRENT PTR TAD I CURPTR / GET NEXT CHAR SMA SZA JMP ESICHE / LOOP IF NOT SPECIAL CLA MQA DCA ESICH1 / SAVE NEXT INSERT JMP ESICHA / AND LOOP ESICHX, TAD I CURPTR / NULL? SNA CLA JMP ESICHB / JUMP IF SO CLA CLL TAD (-400) TAD ESICH3 SZL CLA JMP ESICHZ / JUMP IF NEAR STX TAD ESICH1 / GET INSERT ESICHK, DCA I CURPTR / STORE OVER ETX AC0001 CHKPTR / ADVANCE CURPTR SPA SNA CLA JMP ESICHY / JUMP ON NULL OR ETX TAD I CURPTR / ELSE OUTPUT IT PUTSTX ESICHY, TAD (ECETX) JMP ESICHC ESICHZ, TAD (-100) DCA ESICH3 / SET LOOP COUNT TAD CURPTR DCA ESICH4 / SAVE ETX CURPTR TAD ESICH1 / GET INSERT ESICHF, PUTETX / PUT IT OUT AC7777 CHKPTR / BACKUP CLA TAD I CURPTR / GET CAR TO CPY ISZ ESICH3 JMP ESICHF / PUT IT OUT TIL COUNT DONE ESICHG, MQL / ELSE SAVE TAD CURPTR DCA ESICH1 / WHILE WE SWAP CURPTRS TAD ESICH4 DCA CURPTR ESICHJ, AC7777 CHKPTR CLA MQA DCA I CURPTR / THEN MOVE IT TAD ESICH1 CIA TAD ESICH2 / DONE WITH COPY? SNA CLA JMP ESICHH / JUMP IF SO TAD CURPTR DCA ESICH4 / ELSE SWAP CURPTRS AGAIN TAD ESICH1 DCA CURPTR AC7777 CHKPTR CLA TAD I CURPTR / GET NEXT FOR COPY JMP ESICHG / AND LOOP ESICHH, CLA MQL / SET ZERO FOR CLEAR LOOP TAD CURPTR CIA TAD ESICH2 / MORE TO CLEAR? SZA CLA JMP ESICHJ / JUMP IF SO ADVCHR CLA / ELSE FIX @CURPTR JMP ESICHI / AND RETURN ESICHB, TAD ESICH1 / GET INSERT ESICHC, DCA I CURPTR / STORE IT ESICHD, TAD ESICH2 DCA CURPTR / RESTORE CURPTR ESICHI, JMP I INSERT / AND RETURN ESICH1, 0 ESICH2, 0 ESICH3, 0 ESICH4, 0 CLSCRN, XX / CLEAR SCREEN CIFMNU / CHANGE TO MENU FIELD JMS I (CALLN1) / GO PUT UP STATUS LINE DISPLAY JMS CLSSET / INITIALIZE SCROLL VALUES JMP I CLSCRN / RETURN TO CALLER CLSSET, XX / INITIALIZE SCROLL VALUES AC2000 DCA SCRNFL / SET SCREEN FLAG AC2000 DCA SCRLCT / AND BIG COUNT JMP I CLSSET / RETURN TO CALLER / PUTSPC PSEUDO CODE / / set terminal to special graphics mode / get character at call+1 / display character / reset terminal to USASCII mode / return to caller PUTSPC, XX / OUTPUT ARG IN GRAPHIC MODE PUTESC "(+3600 "0-200 TAD I PUTSPC PUTOUT JMS MNUGET / PICK UP CURRENT LANGUAGE WORD /A224 MNLANG / LOCATION FOR LANGUAGE WORD /A224 SMA / SKIP IF A NUMBER CODE /A224 IAC / CONVERT TO UPPER CASE ASCII /A224 BSW / PUT BITS INTO PROPER ORDER /A224 DCA PUTLNG / STORE IN LINE FOR PUTESC ROUTINE /A224 PUTESC "(+3600 PUTLNG, "0 / OVERLAYED WITH LANGUAGE CODE VALUE /A224 /D224 IFDEF ENGLSH < /D224 IFNDEF ENGCAN < /D224 "B-200 /D224 > / END IFNDEF ENGCAN /D224 IFDEF ENGCAN < /D224 "3-200 /D224 > / END IFDEF ENGCAN /D224 > / END IFDEF ENGLSH /D224 IFDEF CANADA < /D224 "3-200 /D224 > / END IFDEF CANADA /D224 IFDEF FRENCH < /D224 "R-200 /D224 > / END IFDEF FRENCH /D224 IFDEF DUTCH < /D224 "4-200 /D224 > / END IFDEF DUTCH ISZ PUTSPC JMP I PUTSPC IFDEF FORIN < / SUBROUTINE GETENT GETS THE ENTRY EN TABLE1 OR TABLE2 POINTED AT BY / POINT1 INTO THE AC GETENT, XX CDFPRT / CHANGE TO PRINTER FIELD TAD I POINT1 / GET TABLE ENTRY CDFMYF / RETURN TO THIS FIELD JMP I GETENT / RETURN TO CALLER > / END IFDEF FORIN EIDICT, OVLJMP;OVABRV / ENTRY POINT FOR "GOLD-ABBRV" X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED BKPUNT, JMS BACKUN / BACK UP A UNIT JMP EIBAD / ERROR, CAN'T BACKUP PAST TOP OF FILE JMP EINEXT / FIX UP SCREEN AND GET NEXT CHARACTER BACKUN, XX JMS SAVLMD / SAVE MOD FLAGS AC7777 CURMOV JMP BKPUNV / ERROR IF AT STX ISZ BACKUN JMS SETBNT / SET BACKUP MODE TAD I CURPTR / GET CHAR JMS CHKUNT / CHECK FOR END OF UNIT BKPUNZ, .-. SZA JMP BKPUNX / JUMP IF LAST AC7777 CURMOV JMP BKPUNV / BACKUP, JUMP IF AT STX BKPUNW, TAD I CURPTR / RE-GET CHARACTER JMP I BKPUNZ / AND LOOP BKPUNX, SPA CLA BKPUNY, JMP I BACKUN / JUMP IF FINAL AC0001 CURMOV JMP BKPUNY / DO AN ADVANCE JMP BKPUNW / AND LOOP BKPUNV, CURMOV NOP JMP BKPUNY / FIX CURSOR AT STX, AND RETURN ADVUNT, JMS LODCHR / ADVANCE UNIT JMP EIBAD JMS GETUNT / CHECK FOR END OF UNIT ADVUNW, .-. SZA CLA JMP I ADVUNW JMP EINEXT SAVLMD, XX / SAVE LINE MODIFIED TAD LINMOD SNA JMP I SAVLMD / JUST RETURN IF NO FLAG NEEDED JMS INSERT / ELSE INSERT FLAG DCA LINMOD / CLEAR LINE MODIFIED FLAG DCA RLRMOD / CLEAR RULER MODIFIED FLAG DCA REJFLG / CLEAR REJUSTIFIED FLAG JMP I SAVLMD / RETURN SETLMD, XX / SET "LINE MODIFIED" FLAG CLA TAD RLRMOD SNA TAD (ECMDFL) / GET "LINE_MODIFIED_FLAG" DCA LINMOD AC7777 DCA REJFLG / SET REJUSTIFY FLAG JMS SCRNMD / SET SCREEN MODIFIED FLAG JMP I SETLMD SCRNMD, XX / SET SCREEN MODIFIED FLAG TAD SCRLCT CIA TAD SCRLIN SNA JMP SETLME SPA CLA JMP I SCRNMD TAD SCRLCT DCA SCRLIN JMP SETLMF SETLME, TAD SCRLCU SNA JMP SETLMF TAD CURSOR SMA CLA JMP I SCRNMD SETLMF, TAD CURSOR CMA DCA SCRLCU JMP I SCRNMD SCRADJ, XX DCA SCRLFL / SET SCROLL FLAG CDFMYF CIFSYS JSWAP / DON'T HOG CPU TAD SCRNFL SZA CLA JMP I SCRADJ / JUST RETURN IF SCREEN FLAG SET TAD SCRLFL TAD SCRLCT DCA SCRLCT / ELSE ADJUST SCROLL COUNT AC2000 TAD SCRLCT SPA CLA AC2000 DCA SCRNFL / SET SCREEN FLAG - IF TOO BIG JMP I SCRADJ / AND RETURN SCRNSZ, XX / RETURN SCREEN SIZE TAD SPLTFL / PICK UP THE SPLIT-FLAG SNA CLA / ARE WE IN WIDE SCREEN MODE (132 COL) TAD SCRNLN / NO, USE VALUE OF FULL SCROLL REGION SNA / SKIP IF WE JUST GOT A VALUE TAD WIDSIZ / YES, USE VALUE OF SMALLER AREA JMP I SCRNSZ / RETURN TO CALLER WIDSIZ, 10 / M219 Default 132 col size is 8 lines. SPLTFL, 0 / 0 = 24 LINES OF SCREEN; -1 = 8 LINES. /A226 SCECHO, XX ISZ CURSOR ADVSPC NOP CLA JMP I SCECHO CHKREJ, XX / CALL REJUST IF IT'S TIME TO DO SO JMS SCECHO / BUMP PTR AND CURSOR ISZ REJCNT JMP I CHKREJ JMS REJUST JMP I CHKREJ REMCUR, 7777 / "REMEMBERED" CURSOR POSITION FOR UP / AND DOWN ARROW EIGCUT, OVLJMP;OVGCUT / CUT OVERLAY EIPSTE, OVLJMP;OVPSTE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED REJUST, XX / REJUSTIFY IF NECESSARY ISZ REJFLG JMP REJUSZ TAD (ECCMRK) JMS INSERT / MARK CURRENT POSITION JMS JCLEAN / CLEAR OLD JUSTIFY CODES REJUSX, TAD LINE23 DCA CURPTR / GET TO BEGINNING OF LINE DCA CURSOR DCA REJCP1 / CLEAR POSITION FLAG JMS JCLEAN / CLEAR OLD JUSTIF CODES JMS CHKLMR / ADJUST LEFT MARGIN AC7777 DCA REJCP3 / CLEAR TAB FLAG JMS LODCHR JMP REJUSK / CHECK NEXT CHAR REJUSY, TAD (-ECCMRK) SNA CLA JMP REJUSA / FOR MARKER TAD I CURPTR AND P177 ZZCASE / COMPARE AGAINST RULER PAGE NWLN TAB CTB005-1 / TABLE ADDRESS FOR CASE / ECSTRL; REJUSC / START OF RULER / ECNWPG; REJUSC / PAGE / ECNWLN; REJUSD / NEW LINE / ECTAB; REJS99 / TAB / 0 / INDICATE END OF TABLE JMP REJUSQ REJS99, DCA REJCP3 / SET TAB FLAG JMS TBJUST / JUSTIFY IT REJUSQ, TAD CURSOR / CIA TAD RGTMAR SMA CLA JMP REJUSF / JUMP IF OK TAD REJCP1 / GOT BACK TO MARKED POSITION YET? SZA CLA JMP REJUSK / JUMP IF SO REJUSF, JMS CHKMAR JMP REJUSX / CHECK MARGIN, JUMP IF WRAPPED ISZ CURSOR / NORMAL CHAR, BUMP PTRS REJUSJ, ADVSPC JMP REJUSK JMP REJUSY / AND LOOP FOR MORE CHECKING REJUSA, TAD CURPTR DCA REJCP1 / SAVE MARKER POSITION TAD CURSOR DCA REJCP2 JMP REJUSJ REJUSB, TAD REJCP1 / END OF LINE, SNA CLA JMP REJUSL / SCROLL, OR REJUSK, TAD REJCP1 DCA CURPTR / QUIT TAD REJCP2 DCA CURSOR CDFBUF REJUSM, DCA I CURPTR / ERASE MARKER ADVCHR CLA / GET OFF NULL WE JUST CREATED /D206 REJUSZ, JMS REJUX2 / RESET FLAGS REJUSZ, DCA REJFLG / CLEAR REJUST FLAG TAD RGTMAR CIA TAD CURSOR / RESET LIMIT COUNT TAD (12) SMA CLA TAD (-12) / (MIN OF 10.) DCA REJCNT JMP I REJUST / AND RETURN REJUSC, TAD CURSOR SNA CLA JMP REJUSE / JUST SCROLL UP IF AT LEFT EDGE OF SCREEN TAD (ECWWLN) JMS INSERT / ELSE INSERT WRAPPER REJUSE, TAD REJCP1 / PAGE OR RULER SZA CLA JMP REJUSK / QUIT IF GOT TO MARKER ALREADY REJUSL, JMS SCRLUP / START NEW LINE JMP REJUSX REJUSD, TAD I CURPTR / NWLN, CHECK FOR CENTER TAD (-ECENLN) SNA CLA / JUMP IF NOT. ISZ REJCP3 JMP REJUSB / JUMP IF WE'VE HAD TABS JMS CENTER / ELSE CENTER THE LINE TAD LINE23 DCA CURPTR / THEN REFIND MARKER (IF PRESENT) DCA CURSOR SLNMOD / SET LINE (SCREEN) MODIFIED FLAG. JMS LODCHR NOP REJUSN, TAD (-ECCMRK) SNA JMP REJUSM / JUMP IF MARKER TAD (ECCMRK-ECENLN) SNA CLA JMP REJUSL / JUMP IF END OF LINE ISZ CURSOR ADVSPC NOP JMP REJUSN / LOOP TIL WE FIND ONE OF THEM REJCP1, .-. REJCP2, .-. REJCP3, .-. EISLCT, TSTSLT / SELECT JMP ESLCT1 / JUMP IF NOT SELECTED ALREADY UNSLCT, MODSET / UNSELECT EDTMOD / SET ADVANCE MODE JMP SLXMOD / THE FOLLOWING IS USED BY V2 GOTO PAGE OVERLAYS... CURPG2, 0 / EDIT BUFFER PAGE # (THOUSANDS - MAX. 9) EIFIND, OVLJMP;XXFIND EIRQSP, OVLJMP;OVRQSP / GO INSERT "REQUIRED SPACE" X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED CTB005, ECSTRL; REJUSC / START OF RULER ECNWPG; REJUSC / PAGE ECNWLN; REJUSD / NEW LINE ECTAB; REJS99 / TAB 0 / INDICATE END OF TABLE ESMVCR, XX / MOVE CURSOR / ENTER WITH OFFSET IN AC SPA JMP ESMVCL / JUMP IF MOVE LEFT CMA DCA ESMVC1 / SAVE -COUNT-1 JMP ESMVCQ ESMVCC, JMS LODCHR JMP ESMVLZ AND P177 / STRIP MODE BITS ZZCASE / COMPARE AGAINST TABLE CTB008-1 / TABLE ADDRESS FOR CASE / ECNWPG; ESMVCD / NEW PAGE / ECNWLN; ESMVCB / NEW LINE / ECMDFL; ESMVCG / LINE MODIFIED / ECSTRL; ESMVCZ / START RULER / 0 / INDICATE END OF TABLE JMP ESMVCU / SKIP IF: SO ESMVCZ, TAD CURSOR SZA CLA JMP ESMVCE JMS ADVRUL JMP ESMVCA BKPPTR / CANCEL ADVPTR IN SCRLUP BELOW NOP SKP CLA / MERGE BELOW. ESMVCK, TAD CURSOR / Are we at the beginning of the line? SNA CLA / Skip if no. JMP ESMVCB / Yes! handle page character as line ender SLNMOD / Set line as modified (so REJUST runs) JMS REJUST / put soft return infront of page marker TAD RLRMOD / reset "line modified" flag for DCA LINMOD / justification of line following NEW PAGE. JMS SCRLUP / scroll line infrontof page marker up. ESMVCB, TAD RLRMOD DCA LINMOD / CLEAR MOD FLAG ESMVCT, JMS SCRLUP ESMVCQ, JMS REJUST ESMVCA, JMS LODCHR JMP ESMVX2 JMP ESMVX1 / MAY HAVE TO MODIFY TO HANDLE REDUNDANT BEGIN MATH AREA OR END MATH AREA ESMVCD, TAD I CURPTR / CHECK PRINT CONTROL JMS SCRLTM / TEST TO SEE IF CHAR IS SPECIAL CODE NOP / CHAR WAS NORMAL JMP ESMVCK / CHAR WAS SELECT MARKER / CHAR WAS START OR END PRINT CONTROL / +1 IF START, 0 IF END CIA / TAD PCTLFL / -1 IF START, 0 IF END SZA CLA JMP ESMVCK DCA I CURPTR / DELETE CONTROL IF REDUNDANT JMS SCRNMD / AND SET SCREEN MOD FLAG JMP ESMVCA ESMVCE, TAD (ECWWLN) JMS INSERT JMP ESMVCT ESMVCG, JMS CHKLMD NOP JMP ESMVCQ ESMVCU, JMS CHKMAR JMS REJUST / CHECK MARGIN ESMVCV, ISZ CURSOR ADVSPC JMP ESMVX2 ESMVX1, JMS CHKCHR JMP ESMVCC / DON'T LAND ON FUNNY CODE ESMVX2, ISZ ESMVC1 JMP ESMVCC ESMVLX, ISZ ESMVCR / BUMP FOR OK RETURN ESMVLZ, JMP I ESMVCR / AND RETURN ESMVC1, 0 CTB008, ECNWPG; ESMVCD / NEW PAGE ECNWLN; ESMVCB / NEW LINE ECMDFL; ESMVCG / LINE MODIFIED ECSTRL; ESMVCZ / START RULER 0 / INDICATE END OF TABLE CHKLMR, XX / CHECK FOR LEFT MARGIN JMS LODCHR JMP LMRCH1 TAD (-ECCMRK) / SKIP JUSTIF MARKER SNA CLA JMP LMRCH3 TAD I CURPTR LMRCH4, AND P177 TAD (-ECSTRL) SZA / IF NOT AT RULER TAD (ECSTRL-ECNWPG) / OR NEW PAGE SZA CLA JMP LMRCH1 / THEN CHECK INDENT TAD LINE23 DCA CURPTR / ELSE RESTORE CURPTR JMP I CHKLMR / AND RETURN LMRCH1, JMS LINDNT / DO PROPER INDENT LMRCH2, JMP I CHKLMR / RETURN LMRCH3, ADVPTR JMP LMRCH1 JMP LMRCH4 / GO BACK TO CHECK FOR PAGE/RULER EIUDLT, OVLJMP;OVUDLT / UNDELETE OVERLAY EIHYPL, OVLJMP;OVHYPL / HYPHEN PULL / TAKE 1ST RETURN IF SET, 2ND RETURN IF NOT SET USHLTS, XX CIFLP JMS I (XHLTST) / DO HALT TEST IN LP FIELD RPCUOF, 0 / Rapid Paging CUrrent descriptor OFfset X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED / MOVE CURSOR ROUTINE JUMPS HERE IF MOVING LEFT ESMVCL, DCA ESMVC2 / ESMVC2 = -NUMBER OF LOCATIONS TO MOVE ESMVLA, / REPEAT BKPSPC JMP ESMVLZ / GET NEXT CHAR TO LEFT AND P177 / STRIP MODE BITS TAD (-ECNWPG) SZA / IF CHAR = NEW_PAGE TAD (ECNWPG-ECNWLN) SZA / OR NEW_LINE TAD (ECNWLN-ECNDRL) SNA / OR END_RULER JMP ESMVLR / THEN SCROLL SCREEN DOWN ESMVLB, AC7777 / ELSE TAD CURSOR / DCA CURSOR / CURSOR := CURSOR - 1 ESMVLC, TAD I CURPTR / GET CHAR AGAIN JMS CHKCHR JMP ESMVLA / IF NOT A SPECIAL CHARACTER ISZ ESMVC2 JMP ESMVLA / THEN INCREMENT ESMVC2 JMP ESMVLX / UNTIL ESMVC2=0 ESMVLR, JMS SCRLDN JMP ESMVLC ESMVC2, 0 / NUMBER OF CURSOR POSITIONS TO MOVE BACK / PSUEDO_CODE FOR SCRLUM / / CASE AC =: / START_PRINT_CONTROL: PCTLFL=-1 / END_PRINT_CONTROL: PCTLFL=0 / SELECT_POINT: SLCTDR=0 / AC=0 SCRLUM, XX / CHANGE MODES FOR SCROLL UP /*** SCRLUM IS USED AS A VARIABLE (PUTSC6) /*** BY PUTSCH BELOW TO SAVE A WORD JMS SCRLTM / TEST FOR MODE CHANGE JMP I SCRLUM / RETURN IF NONE JMP SCRLU1 / JUMP IF SELECT POINT DCA PCTLFL / HERE IF PRINT CONTROL JMP I SCRLUM / RETURN SCRLU1, DCA SLCTDR / HERE IF SELECT POINT JMS SVSLCR / SAVE CURSOR POSITION /A209 JMP I SCRLUM / RETURN / PSUEDO_CODE FOR SCRLTM / / CASE AC =: / SELECT POINT: AC=0 INCREMENT RETURN ADDRESS BY 1 / START_PRINT_CONTROL: AC=-1 INCREMENT RETURN ADDRESS BY 2 / END_PRINT_CONTROL: AC=0 INCREMENT RETURN ADDRESS BY 2 / OTHERS: AC=0 / SCRLTM, XX / TEST FOR MODE CHANGE CHARACTER ZZCASE / COMPARE AGAINST SELECT AND CONTROL CTB009-1 / TABLE ADDRESS FOR CASE / ECSLPT; SCRTM1 / SELECT POINT / ECPCT2; SCRTM2 / END CONTROL / ECPCT1; SCRTM4 / START CONTROL / 0 / INDICATE END OF TABLE JMP SCRTM3 / TAKE NORMAL RTN IF NONE OF ABOVE SCRTM4, AC7777 / TAKE 2ND SKIP RTN IF STRT PRINT CONTROL SCRTM2, ISZ SCRLTM SCRTM1, ISZ SCRLTM SCRTM3, JMP I SCRLTM CLMPLL, ZBLOCK 1 / COLUMN MANIPULATION LOWER LIMIT /A209 CLMPUL, ZBLOCK 1 / " " UPPER " /A209 PSBFOF, ZBLOCK 1 / COLUMN MANIP. PASTE BUF. OVFLOW FLAG /A209 CLCTSW, ZBLOCK 1 / " " CUT/GOLD CUT SWITCH /A209 / / THE FOLLOWING IS USED BY V2 GOTO PAGE OVERLAYS ... / /D223 RPBKID, 0 / RAPID PAGINATION BLOCK ID # / / / SUBR PUTSCH -- PUT CHARACTER TO SCREEN / / CHARACTER PASSED TO PUTSCH IN AC / / PSUEDO-CODE FOR PUTSCH: / / SAVE CHAR. IN TEMP. LOCATION; / GET CHAR. BACK; / / ( CHECK SCREEN LIMITS ) / IF WIDE SCREEN MODE THEN / IF CURPOS < LEFT MARGIN OR CURPOS > RIGHT MARGIN THEN / EXIT; ( DON'T DISPLAY "CLIPPED" CHAR ) / / ( CHECK FOR OVERSTRIKE SEQUENCE ) / IF CHAR = "START OVERSTRIKE SEQUENCE" THEN / ( CHECK FOR "REQUIRED SPACE" ) / GET NEXT CHAR; / BACKUP CURPTR TO "START OVERSTRIKE SEQ" SO CURMOV WILL / SKIP REST OF SEQUENCE; / IF NEXT CHAR = SPACE THEN / ( "OVERSTRIKE SEQUENCE" IS REALLY A "REQUIRED SPACE" ) / DISPLAY A SPACE WITH PROPER ATTRIBUTES; / ELSE / ( THIS IS A REAL "OVERSTRIKE SEQUENCE", NOT A "REQ. SPACE" ) / DISPLAY A GRAPHICS BLOTCH TO STAND FOR THE OVERSTRIKE SEQ.; / ELSE ( NOT OVERSTRIKE ) / RESTORE CHAR.; / PUTOUT TO DISPLAY; / / EXIT. ( RETURN TO CALLER HAVING DISPLAYED CHAR ) / / PUTSCH, XX / OUTPUT CHAR DCA PUTSC6 / SAVE CHARACTER TO RESTORE LATER /D226 TAD SPLTFL / SPLIT (WIDE) SCREEN MODE? /D226 SNA CLA /D226 JMP PUTPA1 / NO, JUST DO IT NORMAL TAD CURPOS / GET CURRENT CURSOR POSITION TAD LOWLIM / COMBINE WITH LOW LIMIT OF SCREEN DISPLAY SMA / ARE WE BEFORE CURRENT LOW LIMIT /C237 JMP PUTPA1 / NO, GO CHECK IF WE ARE ABOVE IT /C237 CLA CLL / YES, CLEAR TRASH FROM THE ACCUMULATOR /A237 TAD PUTSC6 / GET CURRENT CHARACTER /A237 AND (1600) / MASK OFF THE ATTRIBUTE BITS /A237 JMP PUTSC4 / GO OUTPUT THE CHARACTER ATTRIBUTES /A237 PUTPA1, CDFMYF / RESET BACK TO THIS FIELD /C237 TAD SCNSZ / COMBINE RESULT WITH SCREEN SIZE /M223 /D237 CDFBUF /A223 SMA CLA / ARE WE PAST LAST COLUMN ? JMP PUTPA2 / YES, IGNORE THE CHARACTER TAD PUTSC6 / GET CHAR BACK /C237 /D237 SNA / SKIP IF CHAR. /D237 JMP PUTSC0 / IGNORE NULLS. AND P177 / MASK OFF ATTRIBUTES TAD (-ECSTOV) / SPECIAL PROCESSING FOR OVERSTRIKE IFDEF FORIN < SNA CLA JMP DEAD / FOUND FOREIGN OVERSTRIKE > / END IFDEF FORIN IFNDEF FORIN < SZA CLA / AT OVERSTRIKE SEQUENCE? (DEAD KEY) JMP PUTSC8 / NO: GO OUTPUT CHARACTER (PUTSC6) CDIMNU / YES: CHANGE TO MENU FIELD /A211 JMS I (TCCHK) / GO CHECK FOR DEAD KEY TYPE /A211 JMP PUTSC2 / NORMAL DEAD KEY /A211 JMP PUTSC8 / REQUIRED SPACE /A211 JMP PUTPA2 / TECHNICAL CHARACTER /A211 /D211 ADVPTR / YES: CHECK FOR "REQUIRED SPACE" /D211 NOP / BAD EDIT BUFFER CONTENTS /D211 DCA PUTSC6 / SAVE POSSIBLE ECSPC WITH ATTRIBUTES /D211 BKPPTR / RESTORE CURPTR TO ECSTOV /D211 NOP / BUG-SHOULD NEVER HAPPEN /D211 CLA /D211 TAD PUTSC6 / GET 2ND CHAR IN OVERSTRIKE SEQUENCE /D211 AND P177 / (IGNORE ATTRIBUTES) /D211 TAD (-ECSPC) / IS IT A SPACE? /D211 SZA CLA /D211 JMP PUTSC2 / NO-NOT A "REQUIRED SPACE": OUTPUT BLOB > / END IFNDEF FORIN PUTSC8, TAD PUTSC6 / RESTORE CHAR PUTSC4, PUTOUT / DISPLAY CHAR ON SCREEN JMP PUTPA2 / CONTINUE BELOW /A211 PUTSC2, JMS PUTSPC EXGOVS / SPECIAL CODE FOR OVERSTRIKE /D211 JMP I PUTSCH PUTPA2, CLL CLA PUTSC0, CDFMYF ISZ CURPOS JMP I PUTSCH PUTSC6= SCRLUM / TEMP. CHAR STORAGE FOR PUTSCH / ALSO USED BY OVVWB1 (GOLD:VIEW) X=.&7600 / X=FIRST LOC OF CURRENT PAGE PUTAER, IFNZRO SCRLUM&7600-X < ? > / ERROR: PUTSC6 NOT ON CURRENT PAGE SCRFSH, XX / REFRESH NON-SCROLLED LINES TAD SCRLCU / DOES SCREEN NEED MODIFICATION? SNA CLA / SKIP IF: SO JMP I SCRFSH / RETURN SCRFS1, TAD SCRLIN / GET EARLIEST LINE NEEDING MODIFICATION SMA SZA CLA JMP I SCRFSH TAD SCRLCU / Get posn in last line to get refreshed. SZA CMA / If 0 the start-of-line. If < 0 then DCA CURSOR / posn is CMA of SCRLCU. refresh from there JMS SCRNSZ / GET SCREEN SIZE TAD SCRLIN / ADD EARLIEST LINE NEEDING MODIFICATION SPA SNA CLA JMP SCRFS2 TAD SCRLIN / GET EARLIEST LINE NEEDING MODIFICATION DCA CURLIN / SET CURRENT LINE JMS SETCUR / posn cursor baised by LOWLIM. TAD SCRLCT / GET SCREEN LAG SPA CLA / If reverse scroll, then bais to bottom / of screen. CIA / NEGATE IT TAD SCRLIN / ADD EARLIEST LINE NEEDING MODIFICATION JMS SCRLTX SCRFS2, ISZ SCRLIN NOP DCA SCRLCU / Reset posn within next line to start at. DCA CURSOR / (incase SCRLIN now = 1). JMP SCRFS1 EIDEAD, OVLJMP;OVDEAD / GOLD DEAD EIGBKP, OVLJMP;OVGBKP / GOLD BACKUP EITC, OVLJMP ;OVTCHR / TECHNICAL CHARACTER /M234 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED SCRLDN, XX / SCROLL DOWN CDFMYF / RESET DATA FIELD TO THIS FIELD CIFMNU / SET INSTRUCTION FIELD TO MENU FIELD JMS CALLN3 / HANDLE SCROLL DOWN FOR STATUS LINE AC7777 JMS SCRAD0 / ADJUST SCROLL TAD FORMNO / IF NOT IN LIST PROCESSING SZA CLA / JMP SCRLD1 / CDILP / THEN GO FIDDLE WITH THE MATH FLAGS JMS SCRMTH / SCRLD1, TAD LINE23 DCA CURPTR JMS SAVLMD CDFMYF JMS SCRNSZ / GET SCREEN SIZE (IN LINES) CIA DCA X0 / STORE AS COUNT TO DO TAD X0 TAD (PTRBLK-1+NPTRS) DCA T1 / STORE FIRST PTR-1 AC0002 / SET UP FOR AN INCREMENT OF TWO TAD T1 / COMBINE WITH VALUE OF PTR-1 DCA SCRLDF / SAVE PTR TO OLD TOP PTR MQL / FOR MOVING PTRS SCRLDA, ISZ T1 TAD I T1 / SWAP A PAIR SWP DCA I T1 ISZ X0 JMP SCRLDA / AND LOOP TIL ALL DONE TAD I T1 DCA LINE23 TAD I SCRLDF / GET OLD TOP PTR SZA / SKIP W/O A POINTER JMP .+3 / JUMP WITH A POINTER ISZ SCRLDF / ADVANCE TO NEXT ENTRY JMP .-4 / REPEAT UNTIL POINTER DCA CURPTR / ELSE START BACK SEARCH FROM THERE BKPSPC JMP SCRLDG / JUMP IF NO MORE AND P177 TAD (-ECNWPG) SNA CLA JMP SCRLDE SCRLDB, BKPSPC JMP SCRLDE / JUMP IF STX AND P177 ZZCASE / COMPARE AGAINST TABLE CTB010-1 / TABLE ADDRESS FOR CASE / ECNWLN; SCRLDC / NEW LINE / ECNWPG; SCRLDC / NEW PAGE / ECSTRL; SCRLDE / START RULER / ECNDRL; SCRLDC / END RULER / 0 / INDICATE END OF TABLE JMP SCRLDB / LOOP IF NOT SCRLDC, ADVPTR JMP EIBAD CLA SCRLDE, CDFMYF AC7777 TAD SCRLDF DCA SCRLDF / SET TOP PTR PTR TAD CURPTR DCA I SCRLDF / SET NEW TOP SCRLDG, TAD LINE23 DCA CURPTR DCA CURSOR CDFBUF TAD I CURPTR / GET_CHAR SCRLDD, AND P177 / LOOP, STRIP MODE BITS ZZCASE / COMPARE AGAINST TABLE CTB011-1 / TABLE ADDRESS FOR CASE / ECNWLN; SCRLDL / NEW LINE / ECNWPG; SCRLDL / NEW PAGE / ECSTRL; SCRLDS / START RULER / 0 / INDICATE END OF TABLE ISZ CURSOR / THEN INCREMENT CURSOR ADVSPC JMP EIBAD / ADVANCE TO NEXT CHARACTER JMP SCRLDD / END_LOOP / CASE CURRENT_CHARACTER =: / SELECT_POINT: SLCTDR=1 / START_PRINT_CONTROL: PCTLFL=0 / END_PRINT_CONTROL: PCTLFL=-1 SCRLDL, TAD I CURPTR / GET CURRENT CHARACTER JMS SCRLTM / CHECK AC FOR SPECTIAL CHARACTER JMP SCRLDX / NO SPECIAL CHARACTER JMP SCRLDP / AC WAS A SELECT POINT CMA / AC WAS START_CONTROL OR END_CONTROL / -1 = END_CONTROL: 0 = START_CONTROL DCA PCTLFL / 0 = END_CONTROL: -1 = START_CONTROL JMP SCRLDX SCRLDS, TAD CURSOR SZA CLA JMP SCRLDX / IF THIS IS RULER LINE, JMS SETRUL ESADRL / RESET TO OLD RULER JMS COPRUL CDFBUF TAD LINE23 DCA CURPTR / RESET CURPTR JMP SCRLDX SCRLDP, AC0001 / CURRENT CHAR WAS SELECT POINT SO SET FLAG DCA SLCTDR / INDICATING SELECT POINT IS BELOW US SCRLDX, JMP I SCRLDN / RETURN TO CALLER SCRLDF, .-. CTB010, ECNWLN; SCRLDC / NEW LINE ECNWPG; SCRLDC / NEW PAGE ECSTRL; SCRLDE / START RULER ECNDRL; SCRLDC / END RULER 0 / INDICATE END OF TABLE CTB011, ECNWLN; SCRLDL / NEW LINE ECNWPG; SCRLDL / NEW PAGE ECSTRL; SCRLDS / START RULER 0 / INDICATE END OF TABLE SETSPT, XX / SET SCREEN-NEEDS-TO-BE-SPLIT FLAG /D226 TAD SPLTFL /D226 SNA AC7777 DCA SPLTFL JMP I SETSPT EISCUT, OVLJMP;OVSCUT / ENTRY POINT FOR STRAIGHT CUT RPMTBK, 0 / Rapid Paging MaTh BlocK begin offset /M226 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED FXSCRL, XX / UNDO SCREEN LAG CDFMYF TAD CURSOR / SAVE CURSOR POSN 'TILL LATER. DCA FXSCT1 / ... DCA CURSOR / REINIT TO START OF LINE. TAD WIDEFL / TEST NEED TO GO WIDE FLAG /M226 SMA CLA JMP FXSCRF / JUMP IF NOT SET DCA WIDEFL / RESET IT TO NOT NEEDED /M226 JMS SET132 / MAKE SCREEN WIDER TAD FORMNO SNA CLA / CAN'T DO WHOLE SCREEN IF MERGING!! JMP FXSCRE / AND REFRESH WHOLE SCREEN FXSCRF, TAD SCRNFL SZA CLA JMP FXSCRE / JUMP IF WHOLE SCREEN NEEDED TAD SCRLCT / TEST LAG SNA JMP FXSCRK / JUST SET CURSOR IF NO LAG SPA JMP FXSCRD / JUMP IF SCROLL DOWN NEEDED CIA JMS FXSCRA / TEST FOR TOO MUCH JMS SCRFSH FXSCRI, JMS NWLN FXSCRJ, AC0001 TAD FXSCT2 JMS SCRLTX / DO ONE LINE ISZ FXSCT2 JMP FXSCRB / LOOP FOR ALL FXSCRC, DCA CURLIN TAD FXSCT1 / Restore cursor posn. DCA CURSOR / ... TAD SCRLCT / forward scroll? SPA CLA / skip if yes. JMP FXSCX1 / If no then do DCA to current posn. TAD CURPOS / Get current cursor posn on the screen. CIA / Compare to TAD CURSOR / where we want to be. SNA CLA / Skip if not there. JMP FXSCX2 / Already there so ignore. TAD CURSOR / Are we aiming for col 1? SZA CLA / skip if yes. JMP FXSCX1 / JMP if no to do DCA to correct posn. TAD (CR) / to to get to col 1 of this line. PUTOUT / ... DCA CURPOS / reset cursor posn. JMP FXSCX2 / merge below to clean up & exit. FXSCX1, JMS SETCUR / posn cursor to desired colm. FXSCX2, DCA SCRLCT / RESET LAG DCA SCRNFL / AND SCREEN FLAG DCA SCRLCU / AND REFRESH FLAGS DCA SCRLIN JMP I FXSCRL / AND THEN RETURN FXSCRD, JMS FXSCRA / CHECK FOR TOO MUCH JMS SCRNSZ / SET TO TOP CIA IAC DCA CURLIN FXSCRH, PUTESC "[&177+4000 "H&177 / Cursor home. PUTESC "M&177 / SCROLL DOWN TAD SPLTFL / wide screen mode? SZA CLA / Skip if no. we's already at line. JMS PCUR / Reposn to start of current line. TAD FXSCT2 CMA TAD CURLIN JMS SCRLTX / DO ONE LINE ISZ FXSCT2 JMP FXSCRH / LOOP FOR ALL TAD SCRLCT / FIX REFRESH FLAG CIA TAD SCRLIN DCA SCRLIN FXSCRK, JMS SCRFSH / FIX UP LINES NOT SCROLLED JMP FXSCRC / AND FIX CURSOR AND RETURN FXSCRA, XX DCA FXSCT2 / SAVE COUNT JMS SCRNSZ / GET SCREEN SIZE TAD FXSCT2 / -COUNT SPA CLA JMP FXSCRE / JUMP IF TOO MUCH TAD SCRLCU SNA CLA JMP I FXSCRA JMS SCRNSZ TAD SCRLIN SMA CLA JMP I FXSCRA / RETURN IF OK FXSCRE, JMS CLSCRN / FOR WHOLE SCREEN, CLEAR IT JMS SCRNSZ / SET FULL COUNT CIA DCA FXSCT2 DCA SCRLCT / USE REAL SCREEN POSITION FXSCRB, TAD SCRLCT SZA CLA JMP FXSCRI / IF REALLY SCROLLING, USE BOTTOM LINE AC0001 TAD FXSCT2 / ELSE USE REAL LINE DCA CURLIN / Set line # to refresh. JMS PCUR / Posn to physical start of line. JMP FXSCRJ FXSCT1, 0 FXSCT2, 0 CHKALP, XX / SET MQ AND CHECK FOR OVER 40 MQL MQA AND P177 TAD (-40) SMA SZA ISZ CHKALP / SKIP RETURN IF OK CLA MQA / RESTORE CODE JMP I CHKALP / AND RETURN TO CALLER WIDEFL, 0 / FLAG TO KNOW WHEN TO GO TO WIDE SCREEN MODE / -1=NEED TO GO 132 COL., 0=NOT NEEDED /A226 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED SCRLUP, XX / SCROLL UP CDILP / CHANGE CONTROL TO LP FIELD TO CHK ON MATH JMS CKCTRL / GO PROCESS LATEST LINE SCROLLED UP TAD SCRLCT SMA CLA / IF SCROLLING UP (NOT DOWN) TAD ECHFLG / THEN SZA CLA / IF ECHOING JMS FXSCRL / THEN UPDATE SCREEN SCRLP1, AC0001 JMS SCRAD0 / INCREMENT SCROLL COUNT ADVPTR / ADVANCE NOP / RETURNS HERE IF END OF TEXT FOUND CLA / NORMALLY RETURNS HERE WITH CHAR IN AC CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD JMS SCRLPX / GO SET UP AUTO-INDEX REGISTERS TAD I X0 DCA I X1 ISZ X2 JMP .-3 TAD CURPTR DCA LINE23 TAD LINE23 DCA I X1 BKPPTR JMP SCRLUB / BACK UP OVER NEWLINE JMS SCRLUM / DO MODE CHANGE, IF NEC. SCRLUB, TAD LINE23 DCA CURPTR / RESTORE CURPTR /D203; TAD CURSOR / SAVE THE CURSOR POS FOR LATER /D203; DCA CURTMP / SELECT MIGHT WANT IT! DCA CURSOR TAD LINMOD SZA CLA SLNMOD / RESET MOD FLAG, IF NECESSARY CDFMYF / RESET DATA FIELD TO THIS FIELD CIFMNU / SET INSTRUCTION FIELD TO MENU FIELD JMS CALLN4 / HANDLE SCROLL UP FOR STATUS LINE CDFBUF / RESET TO BUFFER FIELD JMP I SCRLUP / AND THEN RETURN TO CALLER / THIS ROUTINE GETS RID OF ALL JUSTIFYING CHARACTERS (JUSTIFIED SPACES WORD / WRAPS ETC.) UP TO THE RIGHT MARGIN OR THE FIRST LINE_ENDING CHARACTER, / WHICHEVER COMES FIRST (I THINK THATS WHAT IT DOES ANYWAY) JCLEAN, XX TAD CURPTR DCA JCLEAY / SAVE CURPTR TAD RGTMAR / GET THE COLUMN # OF THE RIGHT MARGIN TAD (-COLM80) / M219 SMA CLA / IF RIGHT_MARGIN GREATER THAN 79 TAD (-COLLIM+COLM81) / THEN JCLEAX= -238 /M219 TAD (-COLM81) / ELSE JCLEAX= -80 /M219 DCA JCLEAX / (* STORE TO USE AS LOOP COUNTER *) JCLEA6, JMS LODCHR / GET CHARACTER JMP JCLEA2 / RETURNS HERE IF END_OF_TEXT (ETX) FOUND JMP .+3 JCLEA1, ADVSPC JMP JCLEA2 / RETURNS HERE IN END_OF_TEXT AND P177 / ELIMINATE IMPOSSIBLES, FOR SPEED TAD (-40) SMA SZA CLA / IF CHARACTER IS PRINTABLE JMP JCLEA4 / THEN GO INCREMENT LOOP COUNTER TAD I CURPTR JMS ESJTST SZA TAD JCLGCT / CHECK FOR PAGE MARKER IF NOT / GOLD CUTTING SNA CLA JMP JCLEA3 / JUMP IF GOT A JUSTIFYING CODE TAD I CURPTR / ELSE CHECK FOR LINE ENDING CHARACTER AND P177 TAD (-ECNWLN) SZA TAD (ECNWLN-ECNWPG) SZA TAD (ECNWPG-ECSTRL) SNA JMP JCLEA2 / JUMP IF A LINE ENDING CHARACTERONE SPA CLA JMS CHKLMD /HECK FOR RULER OR LINE MODIFIED CHAR SKP / RETURNS HERE IF NONE FOUND JMP JCLEA6 / RETURNS HERE OF ONE FOUND JCLEA4, ISZ JCLEAX / INCREMENT LOOP COUNTER JMP JCLEA1 / LOOP BACK IF NOT AT RIGHT END OF RULER / HERE IF CHAR IS: / ECNWLN 0012 NEW LINE / OR ECPGRF 1012 END PARAGRAPH / OR ECENLN 1412 CENTERED LINE / OR ECSLPT 3412 SELECT POINT / OR ECPCT1 1014 START CONTROL / OR ECPCT2 1414 END CONTROL / OR ECLTRL 0016 RULER START / OR IF AT END_OF_TEXT / OR IF AT RIGHTMOST MARGIN (EITHER 80 OR 160) JCLEA2, TAD JCLEAY DCA CURPTR JMP I JCLEAN / RETURN / HERE IF CHAR IS: / ECJSPC 2040 JUSTIFIED SPACE / OR ECWWLN 2012 WRAPPED LINE / OR ECHYLN 2412 WRAPPED LINE WITH HYPHEN / OR ECPMRK 2014 PAGE MARKER JCLEA3, DCA I CURPTR / DELETE JUSTIF CODE JMP JCLEA6 / AND LOOP FOR MORE JCLEAX, 0 / LOOP COUNTER INITIALIZED TO -160 FOR / WIDE RULERS OR -80 FOR REGULAR RULERS JCLEAY, 0 JCLGCT, JTSTOF-ECPMRK / OFFSET FOR DELETING PAGE MARKER / IF NOT IN GOLD CUT MODE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED / PSUEDO_CODE FOR ESLCTS / / IF ALREADY IN SELECT MODE / THEN / IF SELECT POINT IS ABOVE US / THEN / INSERT "ECSLPT" INTO TEXT / BACK UP TO SELECT MARK AND DELETE IT / SET LINE_MODIFIED FLAG / / INCREMENT RETURN ADDRESS / ESLCTS, XX / TEST SELECT MODE TAD ESLMOD+1 / ALREADY IN SELECT MODE? AND EDMODE SNA CLA / SKIP IF: SO JMP I ESLCTS / JUST RETURN IF NOT IN SELECT TAD SLCTDR / TEST DIRECTION SZA CLA / SKIP IF: FORWARD JMP ESLCT6 / JMP IF SELECTING BACKWARDS TAD (ECSLPT) JMS INSERT / ELSE INSERT OUR STOPPER JMS SVSLCR / SAVE CURSOR POSITION /A209 ESLCT4, AC7777 / LOOP CURMOV / BACKUP CURSOR JMP UNSLCT / EXIT IF START OF DOCUMENT FOUND TAD I CURPTR / GET NEXT CHAR JMS ESLCTD / IF CHAR NOT EQUAL SELECT POINT JMP ESLCT4 / THEN GOTO ESLCT4: / ELSE ESLCT6, ISZ ESLCTS / TAKE SKIP RETURN JMP I ESLCTS ESLMOD, 0 SLTMOD EINXSC, OVLJMP;OVNXSC / NEXT SCREEN / THE FOLLOWING IS USED BY V2 GOTO PAGE OVERLAYS... RPBOTF, 0 / V2 GOLD BOTTOM FLAG /M226 / - = V2 GOLD BOTTOM REQUEST / 0 = V2 GOTO PAGE REQUEST X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED EIPCMD, TAD PCTLFL / START AND END CONTROL SNA CLA TAD (ECPCT1-ECPCT2) / INSERT NON-REDUNDANT CONTROL MARKER TAD (ECPCT2-ECNWPG) EINPAG, TAD (ECNWPG-ECPMRK) / NEW PAGE EIPMRK, TAD (ECPMRK) / PAGE MARKER MQL DCA CURSOR TAD LINE23 DCA CURPTR MQA JMP EIFXT1 / AND JUMP TO INSERT ESGETE, XX / GET FROM ETX JMS I ESGETX MGPTC1, XGETET / OR XRDFNC IF FORM JMP I ESGETE ESGETS, XX / GET FROM STX MGPTC2, JMS I ESGETX / OR SKP CLA IF FORM XGETST JMP I ESGETS ESPUTE, XX / PUT TO ETX MGPTC3, JMS I ESGETX / OR SKP CLA IF FORM XPUTET JMP I ESPUTE ESPUTS, XX / PUT TO STX MGPTC4, JMS I ESGETX / OR JMP I ESPUTX IF NO FILE XPUTST ESPUTY, JMP I ESPUTS ESGETX, DSKCAL ESPUTX, PUTST3 ESICHR, XX / INSERT CHAR AND ECHO JMS INSERT / INSERT INTO DOCUMENT AC0001 DCA ECHFLG / SET ECHO MODE SLNMOD / SET MODIFIED FLAG TAD I CURPTR / HANDLE NW PAGE AND NW LINE SPECIALLY DCA ESITMP / save character. TAD ESITMP / get back. AND P177 ZZCASE / COMPARE AGAINST TABLE CTB012-1 / TABLE ADDRESS FOR CASE / ECNWPG; ESINPG / NEW PAGE / ECNWLN; ESINP2 / NEW LINE / ECSTOV; ESINP1 / START DEAD KEY / ECNDOV; ESINP5 / END DEAD KEY / 0 / INDICATE END OF TABLE TAD ESINOV SNA CLA JMP ESINP7 BKPPTR NOP / CONTINUE OVERSTRIKE MODE TAD (-ECNDOV) / IF POSSIBLE SZA CLA JMP ESINP6 DCA I CURPTR ADVPTR NOP ESINP1, ADVPTR NOP CLA TAD (ECNDOV) JMS INSERT / START OVERSTRIKE MODE ADVPTR NOP AC0001 DCA ESINOV JMP I ESICHR ESINP2, JMS REJUST JMP ESINP4 ESINPG, TAD CURSOR / INSERT NEW LINE BEFORE NEW PAGE, IF NEC. SNA CLA JMP ESINP4 JMS REJUST TAD ESITMP / soft page marker? TAD (-ECPMRK) / ... SZA CLA / skip if yes. rejust deleted it. JMP ESNP3A / Hard PM so all is ok. /M220 TAD (ECPMRK) JMS INSERT / Insert soft page marker back!!! TAD (ECWWLN) JMS INSERT / INSERT SOFT RETURN JUST PRIOR TO NPM. JMP ESINP3 / MERGE BELOW TO PROPERLY SCROLL /A220 ESNP3A, TAD CURSOR / ARE WE AT START OF LINE NOW ? /A220 SZA CLA / SKIP IF YES. MUST HAVE BEEN LM NOT=0 /A220 ESINP3, JMS SCRLUP ESINP4, JMS SCRLUP JMP I ESICHR ESINP5, DCA I CURPTR / LEAVE OVERSTIKE MODE ISZ CURSOR DCA ESINOV JMP I ESICHR ESINP6, DCA ESINOV / CANCEL OVERSTIKE MODE ADVPTR NOP CLA ESINP7, JMS CHKREJ JMP I ESICHR / AND RETURN ESINOV, .-. ESITMP, 0 CTB012, ECNWPG; ESINPG / NEW PAGE ECNWLN; ESINP2 / NEW LINE ECSTOV; ESINP1 / START DEAD KEY ECNDOV; ESINP5 / END DEAD KEY 0 / INDICATE END OF TABLE / ESPTES IS REWRITTEN TO DEAL WITH THE NEW, LONGER ESCAPE SEQUENCES. / IF THERE ARE TWO CHARACTERS TO FOLLOW THE ESC, THE FIRST CHARACTER / HAS ITS 0 BIT SET. THIS VERSION TESTS FOR THAT AND FOLLOWS THROUGH. ESPTES,XX / PUT ESCAPE SEQUENCE TAD (ESC) AND P3777 / MASK OUT BIT 0. DOES NO HARM TO ESC. PUTOUT TAD I ESPTES / GET THE FIRST ARGUMENT. ISZ ESPTES / INCREMENT RETURN LOCATION. SPA / SKIP IF NOT ANOTHER ARGUMENT. JMP .-5 / RUN THROUGH THE CYCLE AGAIN IF THERE IS. PUTOUT JMP I ESPTES / RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED /++ / FUNCTIONAL DESCRIPTION: CHKSPC / / CHECKS FOR SPACE LEFT ON A DISK AND INFORMS USER IF IT IS LESS / THAN THE MINIMUM CUTOFF VALUE (SPECIFIED IN SPCCHK) / / CHKSPC PSEUDO CODE: / / GET NUMBER OF FREE BLOCKS LEFT ON DISK / IF (BELOW MINIMUM CUTOFF VALUE) / EXIT - INFORM USER AND WAIT FOR KB INPUT / RETURN TO CALLER / / CALLING SEQUENCE: JMS CHKSPC / / INPUT PARAMETERS: NONE / / IMPLICIT INPUTS: ACSAVE, SCFSPC, SPCCHK / / OUTPUT PARAMETERS: NONE / / IMPLICIT OUTPUT: ACSAVE, SPCCHK / / COMPLETION CODE: NONE / / SIDE EFFECTS: THIS ROUTINE ONLY INFORMS YOU THAT YOU'RE / RUNNING OUT OF SPACE ON THE DISK. IT WILL NOT / PREVENT YOU FROM GOING BEYOND THE LIMIT AND / POSSIBLY WIPING OUT YOUR DISK. / /-- / CHKSPC, XX / CHECK DISKETTE ROOM DCA ACSAVE / SAVE AC IN TEMP LOCATION CDFFIO TAD I (SCFSPC) / GET NUMBER OF BLOCKS LEFT CDFMYF / COMPARE WITH CUTOFF POINT VALUE DCA T1 TAD T1 TAD SPCCHK SMA CLA / IS THERE ROOM ? JMP ACRSTR / YES / ???? DCA SPCCHK / CLEAR SPCCHK (ONE WARNING IS ENOUGH) TAD T1 / CHECK FOR HARD LIMIT TAD (-14) SMA SZA CLA JMP DOWTCH AC7777 DCA BLKALM JMP WARN DOWTCH, TAD BLWTCH / WATCH FOR NEXT USE OF A BLOCK SNA JMP NEWTCH CIA TAD T1 SMA CLA JMP ACRSTR NEWTCH, TAD T1 DCA BLWTCH WARN, OVLJMP;OVSPCE / PUT OUT MESSAGE AND RETURN TO EINEXT ACRSTR, TAD ACSAVE / RESTORE AC JMP I CHKSPC ACSAVE, 0 / TEMP SAVE LOCATION FOR AC SAVING BLWTCH, 0 / FOR KEEPING TRACK OF BLOCK USAGE BLKALM, 0 / ALARM FOR HARD LIMIT / LODCHR GET FIRST AVAILABLE CHARACTER / / THIS ROUTINE RETURNS THE FIRST AVAILABLE CHARACTER AT OR AFTER / THE POSITION POINTED TO BY CURPTR. / / CALL: / / JMS LODCHR / / / LODCHR, XX CLA CHKPTR SZA SMA JMP LODEXI ADVPTR JMP I LODCHR / TAKE 1ST RET IF ETX FOUND LODEXI, ISZ LODCHR JMP I LODCHR USCMPR, XX / COMPARE AC&177 WITH MQ, / USING MQ AS U/L MATCH / LEAVES AC 0, MQ UNCHANGED AND P177 / MASK CHAR CIA DCA USCMP1 / SAVE FOR COMPARE MQA TAD USCMP1 / COMPARE AS IS SNA CLA JMP USCMP2 / JUMP IF EQUAL MQA XLTUPR / MAKE MATCH CHAR UPPER CASE TAD USCMP1 / COMPARE AGAIN SNA CLA USCMP2, ISZ USCMPR / BUMP RETURN FOR MATCH JMP I USCMPR / NO BUMP FOR NO MATCH USCMP1= X0 / TEMP ESXLUP, XX / XLAT AC TO UPPER CASE TAD (-173) SMA JMP ESXLUA TAD (173-141) SMA TAD (-40) TAD (141-173) ESXLUA, TAD (173) JMP I ESXLUP / NOW THAT TABLE2 HAS BEEN MOVED TO THE PRINTER, WE HAVE ROOM TO PUT / ALL THE FORIN DEAD KEY CODE TOGETHER, RIGHT HERE. SOME MODIFICATIONS / WERE MADE TO ACCESS THE TABLES IN THE PRINTER FIELD. IFDEF FORIN < / HERE IF DEAD KEY SEQUENCE DEAD, TAD CURPTR / GET CURRENT POINTER DCA POINT2 / SAVE ADVPTR / ADVANCE CURSOR AND RETURN CHARACTER NOP / CAN'T RETURN HERE MQL / PUT CHAR IN MQ MQA / REPLACE INTO AC AND (7600) / GET MODE BITS DCA ESXLUP / TEMP STORAGE SWP / SWAP WITH MQ TO GET CHAR BACK AND P177 / MASK DCA CHAR1 / SAVE TAD (TABLE1-1) JMS SEARCH / SEARCH FOR CHARACTER IN TABLE1 JMP NOTACC / NOT FOUND, RESTORE CURSOR POINTER JMS GETENT / GET FLAG BITS DCA CHAR1 / SAVE ADVPTR / ADVANCE POINTER AND RETURN CHARACTER NOP / CAN'T RETURN HERE AND P177 / MASK TAD CHAR1 / COMBINE WITH FLAG BITS DCA CHAR1 / SAVE TAD (TABLE2-1) JMS SEARCH / LOOK FOR COMBINED CHAR. IN TABLE2 JMP NOTACC / NOT FOUND JMS GETENT SPA CLA / SPECIAL? JMP DEADSP / YES, HANDLE DIFFERENTLY TAD (16) / FOUND PUTOUT / OUTPUT SHIFT OUT JMS GETENT TAD ESXLUP / ADD MODE BITS PUTOUT / OUTPUT THE NEW CHARACTER DEAD1, TAD POINT2 DCA CURPTR / RESTORE CURSOR POINTER TAD (17) JMP PUTSC4 / OUTPUT SHIFT IN DEADSP, TAD POINT2 DCA CURPTR / RESET CURPTR JMS GETENT / GET CHARACTER JMP PUTSC4 / OUTPUT IT / HERE WHEN NO MATCH ON FL SPECIAL CHAR NOTACC, TAD POINT2 DCA CURPTR / RESTORE CURSOR POINTER JMP PUTSC2 / OUTPUT A BLOB > / END IFDEF FORIN RPBIN2, 0 / BINARY THOUSANDS CLSBEG, ZBLOCK 1 / COLUMN STRIP PARAMETERS CLSEND, ZBLOCK 1 EIREPL, OVLJMP;OVREPL / REPLACE EIUPAR, OVLJMP;OVUPAR / UP ARROW EIDNAR, OVLJMP;OVDNAR / DOWN ARROW ESATST, XX / TEST @CURPTR / RETURN 0 IF NULL, -1 IF ETX/STX, + OTHERWISE / ENTER WITH AC = OFFSET CDFBUF / GET TO CORRECT FIELD TAD CURPTR / ADD PTR TO OFFSET ESATS1, DCA CURPTR / UPDATE PTR TAD I CURPTR / GET CURRENT CHAR SMA JMP I ESATST / RETURN IF NOT SPECIAL IAC SNA JMP ESATS2 / JUMP IF BUFBEG IAC SNA JMP ESATS3 / JUMP IF BUFEND IAC CMA JMP I ESATST / RETURN -1 IF STX/ETX, + OTHERWISE ESATS2, AC7775 TAD BUFSIZ / GO TO BUFEND-2 ESATS3, IAC TAD BUFBEG / GO TO BUFBEG+1 JMP ESATS1 / UPDATE PTR AND TRY AGAIN /PGECHO is called with AC = page character, / 0014 = new page / 1014 = start print control / 1414 = end print control / 2014 = (soft) page marker PGECHO, XX / PRINT MESSAGE /D245 AND P7700 / ISOLATE HI BYTE /D245 BSW / MOVE TO LO BYTE /D245 CLL RTR / MAP TO 0,2,3,4 /D245 SNA /D245 IAC / MAP TO 1,2,3,4 /D245 TAD (PGMTBL-1) / INDEX INTO TABLE OF TEXT POINTERS /D245 DCA PGTEMP / SAVE PTR OF TEXT POINTERS /D245 CDFMYF / MAP OUR FIELD /D245 TAD I PGTEMP / GET TEXT POINTER JMS BHOOK / Call Blaster BPGECO / JMS PGMSG / PRINT MESSAGE JMP I PGECHO / RETURN /D245PGTEMP= T3 /D245PGMTBL, PGMSG1 / "new page" /D245 PGMSG3 / "START PRINT CONTROL /D245 PGMSG4 / "END PRINT CONTROL /D245 PGMSG2 / "PAGE MARKER" EIINOV, OVLJMP / Go into Overlay /A254 OVINOF / To switch Inset-Overstrike On-Off /A254 / / Check if we are in Overstrike mode , if not return to EINSRT /A254 / otherwise call the Overstrike Overlay /A254 / OVSCHK, DCA INCHTM / First save the char /A254 TAD INSOVF / Now check the flag /A254 SNA CLA / Are we in Overstrike /A254 JMP OVRSCH / No , restore char and insert it /A254 OVLJMP / Yes, /A254 OVINCH / So call the overlay /A254 OVRSCH, TAD INCHTM / Get char back /A254 JMP EINSRT / and insert it as normal /A254 INSOVF, 0 / Insert-Overstrike flag /A254 INCHTM, 0 / temp for char just entered /A254 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED ESACHR, XX / ADVANCE PTR TO NON-NULL ADVCL1, CHKPTR SZA JMP I ESACHR / JUST RETURN IF THERE ALREADY TAD CURPTR DCA T1 / ELSE SET OUR SCAN PTRS TAD T1 DCA T2 TAD (-50) DCA T3 / AND LIMIT COUNT DCA ADVCLT ADVCL8, ISZ ADVCLT ADVCL2, ISZ T1 / ADVANCE PEEK PTR TAD I T1 SNA JMP ADVCL8 / LOOP TIL NON-NULL SMA JMP ADVCL3 / JUMP IF NORMAL TEXT TAD (3) / ELSE CHECK FOR ETX SNA JMP ADVCL4 / JUMP IF ETX SPA CLA JMP ADVCL5 / JUMP IF NOT BUFEND TAD BUFBEG / ELSE RESET TO BUFBEG DCA T1 JMP ADVCL2 / AND CONTINUE LOOKING ADVCL5, TAD I T1 ADVCL3, DCA I T2 DCA I T1 AC7775 TAD ADVCLT SPA SNA CLA JMP ADVCL1 ADVCL7, ISZ T2 / BUMP COPY PTR TAD I T2 / CHECK FOR BUFEND SZA CLA JMP ADVCL6 / JUMP IF SO ISZ T3 JMP ADVCL2 / LOOP IF LIMIT NOT REACHED JMP ADVCL1 / ELSE RETURN ADVCL6, TAD BUFBEG / RESET TO BUFBEG DCA T2 JMP ADVCL7 / AND CONTINUE ADVCL4, AC7775 DCA I T2 / COPY ETX JMP ADVCL1 / AND RETURN ADVCLT, .-. RSTRLN, XX / RESTORE 23RD LINE TAD CURSOR DCA RSTRT2 DCA CURSOR JMS SCRNMD TAD RSTRT2 DCA CURSOR JMP I RSTRLN / THEN RETURN RSTRT2, 0 PROMPT, XX / CLEAR LINE AND PROMPT CLA JMS RSTRLN / SET MOD FLAG JMS PCUR / RESET TO BEGINNING OF LINE CDFMYF TAD I PROMPT DCA PROSTR / GET STRING PTR ISZ PROMPT TAD LOWLIM / RE-SET CURPOS TO START OF LINE!!! CIA / SO THAT PROMPT ISN'T TRUNCATED ON DCA CURPOS / RIGHT SIDE OF SCREEN. JMS PUTMSG / WRITE MESSAGE PROSTR, .-. JMP I PROMPT GETLIN, XX / GET USER INPUT (CR ENDS) DCA PRICNT / GET INITIAL FILL COUNT JMS CLREOL / Erase to end of line TAD I GETLIN DCA PRISTR / SET BUFFER PTR ISZ GETLIN / BUMP TO RETURN ADDR PROMP2, TAD PRICNT / LOAD FLAG WORD /D228 SNA CMA / INSURE IT'S NONZERO CIFMNU JMS I INACAL / READ A LINE PRISTR, EIGES3-1 / INTO BUFFER SKP TAD (EDNWLN) / SET TERMINATOR FOR NORMAL RTN DCA GETTRM SWP DCA PRICNT / SAVE FILL COUNT TAD GETTRM / TEST TERMINATOR FOR... ZZCASE / COMPARE AGAINST TABLE CTB013-1 / TABLE ADDRESS FOR CASE / EDRULR; RRGOTO / GOLD:RULER KEYS / EDPAGE; RPGOTO / PAGE KEY / EDNWLN; PRIST1 / RETURN KEY / EDADVN; PRIST1 / ADVANCE KEY / EDBKUP; PRIST1 / BACKUP KEY / EDSRCH; PRIST1 / SEARCH KEY / EDCONT; PRIST1 / CONTINUE SEARCH KEY / 0 / INDICATE END OF TABLE JMS BEEPER / ELSE ERROR JMP PROMP2 RRGOTO, OVLJMP / INITIATE GOTO-RULER (RAPID RULER) OVGSGR / ("GOLD:SEARCH GOLD:RULER" COMMAND) RPGOTO, OVLJMP;OVRPPG / INITIATE GOTO-PAGE (RAPID PAGING) PRIST1, JMP I GETLIN CTB013, EDRULR; RRGOTO / GOLD:RULER KEYS EDPAGE; RPGOTO / PAGE KEY EDNWLN; PRIST1 / RETURN KEY EDADVN; PRIST1 / ADVANCE KEY EDBKUP; PRIST1 / BACKUP KEY EDSRCH; PRIST1 / SEARCH KEY EDCONT; PRIST1 / CONTINUE SEARCH KEY 0 / INDICATE END OF TABLE PRICNT= GETLEN / Use the New Line escape sequence if in ANSI mode NWLN, XX PUTESC / Put out an escape sequence "E-200 / ESC E JMP I NWLN CLREOL, XX PUTESC / Put out an escape sequence "[+4000-200 / subtract 200 to convert to sixbit ascii / and add 4000 to signify continue "K-200 JMP I CLREOL X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED PUTLNZ, 0 / THE COLUMN THAT THE CURSOR IS IN PUTLNX, 0 / TEMP POINTER TO CHARACTER IN DOCUMENT PUTLIN, XX / PUT LINE ON SCREEN TAD CURPTR DCA PUTLNX / SAVE CURPTR JMS LODCHR JMP PUTLNW / GET FIRST CHAR PUTLN2, AND P177 / STRIP MODE BITS ZZCASE / COMPARE AGAINST TABLE CTB014-1 / TABLE ADDRESS FOR CASE / ECSTRL; PUTLNR / START RULER / ECNWPG; PUTLNP / NEW PAGE / ECNWLN; PUTLNL / NEW LINE / ECTAB; PUTLNB / TAB / ECMDFL; PUTLN1 / LINE MODIFIED / 0 / INDICATE END OF TABLE JMP PUTLN4 PUTLN1, ADVSPC JMP PUTLNW JMP PUTLN2 PUTLNR, TAD CURPOS / Ignore unjustified ruler. SNA CLA / ... JMS DSPRLN / display ruler line. PUTLNU, PUTLNV, PUTLN3, CLA TAD PUTLNX DCA CURPTR / RESTORE CURPTR JMP I PUTLIN PUTLNP, TAD CURPOS SZA CLA JMP PUTLNU / Ignore unjustified page mrkr. TAD I CURPTR JMS PGECHO JMP PUTLN3 PUTLNL, TAD I CURPTR PUTLNW, JMS LNECHT / Print hyphen or select point if needed PUTESC "[&177+4000 "K&177 / do erase to End Of Line. JMP PUTLNV PUTLNB, TAD I CURPTR / RESTORE TAB CHAR AND (3600) / TO GET IT'S ATTRIBUTE MRGSPC, TAD (ECSPC) / AND MERGE WITH A SPACE JMP PUTLN6 PUTLN4, TAD I CURPTR TAD (-ECJSPC) / IF CHAR IS NOT A SOFT SPACE SZA CLA / THEN JMP PUT4 / RESTORE CHAR TO OUTPUT / ELSE TAD CHRATR / GET ATTRIBUTE OF TAB JMP MRGSPC / TO MERGE WITH A SPACE PUT4, TAD I CURPTR / RESTORE CHAR PUTLN6, MQL / save char temporarily. TAD CURPOS / Get current character posn in line. CIA / compare to 1st printable posn. TAD CURSOR / which is (CURSOR). SPA SNA CLA / skip if char to the left of "cursor". MQA / get printable character back. JMS PUTSCH TAD WIDNAR / wide screen? /M226 SNA CLA / skip if narrow. /M226 TAD (-WIDTH+COLM81) / M219 compute "-wide" width. TAD (-COLM81) / M219 compute "-narrow" width. TAD CURPOS / Get current cursor posn. TAD LOWLIM / Now see if within screen width. / AC is now >= 0 if outside screen width SPA CLA / skip if bbeyond threshold. JMP PUTLN1 / Loop to do more. JMP PUTLN3 / end of line encountered. / / +++ IN THIS CASE-TABLE THE ENTRY FOR 'START RULER' COULD /A216 / DYNAMICALLY BE CHANGED DURING EDITOR EXECUTION. THE REASON; /A216 / TURN RULER DISPLAY ON OR OFF DEPENDING ON EDITOR STATUS WORD /A216 / (MNSTAT): /A216 / /A216 / 0 OR 1 RULER DISPLAY ON GOTO @PUTLNR' /A216 / 2 OR 3 RULER DISPLAY OFF GOTO @PUTLN3' /A216 / /A216 / IN PLACE OF THE RULER, THE USER WILL SEE A BLANK LINE, WHICH THE/A216 / USER CANNOT PLACE THE CURSOR ON. /A216 / /A216 / THIS DYNAMIC CHANGE OCCURS ONLY WHEN THE EDITOR IS LOADED (FIRST/A216 / TIME) AND WHENEVER THE EDITOR-MENU IS CALLED. /A216 CTB014, ECSTRL /C216 RULOFF, PUTLNR / START RULER /C216 ECNWPG; PUTLNP / NEW PAGE ECNWLN; PUTLNL / NEW LINE ECTAB; PUTLNB / TAB ECMDFL; PUTLN1 / LINE MODIFIED 0 / INDICATE END OF TABLE PGMSG, XX / ENTER WITH AC = ADDRESS OF MESSAGE SNA / JMP PGMSGB DCA PGMSGX / SAVE MESSAGE ADDRESS FOR DISPLAY TAD WIDNAR / FORCED NARROW? /M223 SNA CLA / SKIP IF NARROW. /M223 TAD (-20) / XTRA SPACING FOR 132 COL MODE. JMS PTDASH -40 JMS PUTMSG PGMSGX, 0 / ADDRESS OF MESSAGE TO BE DISPLAYED CDFMYF /A223 TAD WIDNAR / FORCED NARROW? /M223 SNA CLA / SKIP IF NARROW. /M223 TAD P7700 / xtra spacing for 132 col mode. JMS PTDASH -53 AC7777 / reset CURPOS so that FXSCRL will DCA CURPOS / reposition the cursor. PGMSGB, JMP I PGMSG / PSUEDO_CODE: / BEGIN CHKLMD / IF CHAR = 'LINE_MODIFIED' OR 'RULER_MODIFIED' / THEN / IF CHAR = 'RULER_MODIFIED' / THEN SET RULER_MODIFIED_FLAG / / DELETE CHAR / SET LINE_MODIFIED_FLAG / BUMP RETURN ADDRESS / END CHKLMD CHKLMD, XX / CHECK FOR MODIFIED FLAGS TAD I CURPTR / GET CHARACTER TAD (-ECMDFL) / CHARACTER = "LINE_MODIFIED_FALG"? SNA / SKIP IF: NOT JMP CHKLMA TAD (ECMDFL-ECRMFL) / CHARACTER = "RULER_MODIFIED_FLAG"? SZA CLA / SKIP IF: SO JMP I CHKLMD / RETURN IF NOT MOD FLAG TAD (ECRMFL) / SET RULER MODIFIED FLAG DCA RLRMOD CHKLMA, DCA I CURPTR / DELETE FLAG SLNMOD / SET INDICATOR ISZ CHKLMD / BUMP RETURN JMP I CHKLMD / RETURN EISRCH, OVLJMP;OVSRCH / SEARCH OVERLAY CASUNT, OVLJMP;OVCASE / CASE UNIT (UPPER/LOWER CASE) EIHYPS, OVLJMP;OVHYPS / HYPHEN PUSH OVERLAY X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED EDICHR, XX CDFMYF JMS GSRCK / SEE IF GLOBAL SEARCH IS ON JMP EDICH1 EDICH2, CIFSYS JWAIT EDICH1, CIFPRT JMS I (FLABUZ) / SOUND BUZZER AND TOGGLE LED'S / IF THEIR IS A PRINTER ERROR CIFSYS XLTIN JMP EDICH2 EDICH3, JMP I EDICHR DSKCAL, XX / CALL FIELD 0 DISKIO ROUTINES DCA T1 CDFMYF TAD I DSKCAL DCA .+4 TAD T1 CIFFIO FILEIO .-. ISZ DSKCAL CDFBUF JMP I DSKCAL PSTIO, XX / PASTE_I/O - READ & WRITE PASTE BUF. DCA .+4 / SET FUNCTION CODE TAD PSTBLK CDFBUF JMS SYSIO .-. PSTEBF / DO I/O JMS SETPST / RESET PTRS JMP I PSTIO / AND RETURN SYSIO, XX / DO SYS IO DCA PSQBLK+RXQBLK / SET BLOCK NUMBER RDF TAD CDF0 / GET BUFFER FIELD DCA PSQBLK+RXQBFD / STORE IN QBLK CDFMYF TAD I SYSIO DCA PSQBLK+RXQFNC / AND FUNCTION CODE ISZ SYSIO TAD I SYSIO DCA PSQBLK+RXQBAD / AND BUFFER ADDRESS /D212 TAD USERNO /D212 CLL RAL / GET DRIVE NUMBER DCA PSQBLK+RXQDRV / SET DRIVE NUMBER TO ZERO IN QUEUE BLOCK ISZ SYSIO CIFSYS ENQUE PQBLK / QUEUE Q-BLOCK SYSIO1, CIFSYS JWAIT / WAIT FOR EVENT TAD PSQBLK+RXQCOD / ARE WE DONE? SNA CLA JMP SYSIO1 / NO JMP I SYSIO / AND RETURN PQBLK, DSKQUE; 0; 0 PSQBLK, 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; PSTEBF; CDFBUF; 0; 0 / OVJUMP JUMP TO OVERLAY IN OVERLAY AREA 1 / / OVJUMP, XX CDFMYF TAD I OVJUMP DCA T1 TAD (OVLAY1) DCA OVLOA2 TAD (TAD (DLOEDO-1) ) DCA OVLOA4 JMP OVJMCM OVJRTN, ISZ OVJUMP JMP I OVJUMP / OV2JMP JUMP TO OVERLAY IN OVERLAY AREA 2 / / OV2JMP, XX CDFMYF TAD I OV2JMP DCA T1 TAD (OVLAY2) DCA OVLOA2 TAD (TAD (DLOEDO-1+37) ) DCA OVLOA4 JMP OVJMCM OV2JRT, ISZ OV2JMP JMP I OV2JMP OVJMCM, TAD I OVLOA2 / READ LOCATION 7400 FOR OVERLAY NUMBER CIA / NEGATE THE VALUE TAD T1 / COMPARE WITH CURRENT REQUEST NUMBER AND (7600) / MASK OFF ADDRESS BITS SNA CLA / IS OVERLAY IN MEMORY ? JMP OVLOA1 / JUMP IF SAME OVLOA3, TAD T1 / PICK UP OVERLAY REQUEST NUMBER BSW / MOVE TO LOW ORDER BITS AND P77 / MASK OFF OVERLAY NUMBER CLL RAR / DIVIDE NUMBER BY TWO OVLOA4, TAD (DLOEDO-1) / CONVERT TO BLOCK NUMBER JMS SYSIO RXERD / READ IT IN OVLOA2, OVLAY1 / TO OVERLAY AREA OVLOA1, TAD T1 AND P177 / GET DESIRED ADDRESS TAD OVLOA2 / RELOCATE IT TO OVERLAY AREA DCA T1 / STORE FOR CALLER JMP I T1 RPMTRL, 0 / Rapid Paging MaTh RuLer offset / THIS LINE (AND ANY LIKE IT) MAY APPEAR AT THE END OF ANY PAGE / THAT THERE IS ROOM (TWO WORDS PER LINE) EIRULR, OVLJMP;OVRULR / GOLD RULER X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED RDNXNJ, XX / RDNXCH, NO JUST CODES JMS DSKCAL XRDFNC SNA SPA JMP RDNXN1 / JUMP IF ERR OR EOF JMS ESJCHK SZA TAD (JCHKOF-ECPMRK) SNA JMP RDNXNJ+1 TAD (ECPMRK) ISZ RDNXNJ JMP I RDNXNJ RDNXN1, CLA / TREAT ERR JUST LIKE EOF JMP I RDNXNJ COPRUL, XX / COPY NWRUL BUFFER TO CURUL BUFFER JMS CPYBUF -RULSIZ CDFMNU / M219 NWRUL-1 CDFMYF CURUL-1 CDFMNU / A219 TAD NWLMAR JMS GETBYT NWRUL / DETERMINE SPACING CLL RAR JMS GETBYT XLMAR DCA SPACNG CDFMNU / A219 / the following is a blaster call to a panel memory subroutine to /a238 / create space in this page for the panel hole blaster (rather /a238 / cannibalistic but there it is anyway) /a238 JMS BHOOK / off to the hook /a238 BLRUL0 / subroutines blaster table entry /a238 / contains all the information /a238 / required to run the folling deleted /a238 / code from panel memory routines /a238 /d238 AC7777 /d238 TAD NWLMAR /d238 DCA LFTMAR /d238 AC7777 /d238 TAD NWRMAR /d238 DCA RGTMAR /d238 AC7777 /d238 TAD NWWMAR /d238 SPA /d238 TAD NWLMAR /d238 DCA WRPMAR /d238 AC7777 /d238 TAD NWPMAR /d238 SPA /d238 TAD NWLMAR /d238 DCA PGFMAR /d238 AC7777 /d238 TAD NWCMAR /d238 CLL RAL /d238 SMA /d238 JMP .+4 /d238 AC0001 /d238 TAD LFTMAR /d238 TAD RGTMAR /d238 DCA CENMAR /d238 CDFMNU Qu. why did we need this anyway?? / A219 JMP I COPRUL INSRUL, XX / INSTALL RULER TAD (ECSTRL) JMS INSRL1 JMS MAKRUL CURUL INSRL1 TAD (ECMDRL) JMS INSRL1 JMS MAKRUL NWRUL INSRL1 TAD (ECNDRL) JMS INSRL1 JMP I INSRUL INSRL1, XX JMS INSERT AC0001 CHKPTR CLA CDFMYF JMP I INSRL1 RLGETS, XX / TAD RULR - JMS RLGETS JMS RLGETX DCA RLGET1 JMS CPYBUF -RULSIZ CDFBUF RLGET1, .-. CDFMNU / M219 NWRUL-1 JMP I RLGETS RLGETX, XX / TAD RULR - JMS RLGETX / RETURNS ADDR-1 CLL RAR TAD (DLRLRE) / GET BLOCK DCA PSTBLK RTL BSW / 0 OR 200 DCA RLGET1 TAD (RXERD) JMS PSTIO / READ TO PSTEBF CDFMYF TAD RLGET1 TAD PSTPTR / RETURN ADDR-1 JMP I RLGETX SETPST, XX / RESET PAST BUFFER PTRS TAD (PSTEBF) DCA PSTPTR DCA BASKCT / SHOW EMPTY WASTEBASKET CDFBUF / RESET FIELD JMP I SETPST /******************************************************************** / BHOOK Hook to panel page blaster /******************************************************************** /a238 BHOOK, 0 / hook return address /a238 DCA BLACSV / save accumulator /a238 RDF / read the data field /a238 TAD CDF0 / make a cdf instruction /a238 DCA BHKEXI / save for return /a238 CDFMYF / set to hooks field /a238 TAD I BHOOK / get the table entry /a238 MQL / push into MQ /a238 TAD BLACSV / get the ac /a238 ISZ BHOOK / increment the return address /a238 CIFMNU / blaster is in the menu field /a238 IOF / turn the interrupts off before.. /a238 JMS I BLASTH / Calling blaster /a238 ISZ BHOOK / skip return exit /a238 BHKEXI, 0 / CDF instruction /a238 JMP I BHOOK / return /a238 BLASTH, BLASTR / blastr address (get from WPF1) /a238 BLACSV, 0 / ac save /a238 / / Moved here on edit 241 for space reasons /M241 / EIBOTM, OVLJMP;OVRBOT / V2 "FAST" GOLD BOTTOM / / / Moved here on edit 245 for space reasons /M245 UDLBIT= BLDBIT UDLUNT, TAD (400) / SET... NUDUNT, DCA UDLBIT / ...OR CLEAR UNDERLINING OVLJMP;OVUNDL EIGPST, OVLJMP;OVGPST X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED /a239 the following two subroutines CMPRUL and CLRRULR now call the BLASTR /a239 see WPHOLE / / SUBR CMPRUL -- / COMPARES CURRENT RULER (CURUL) TO NEW RULER (NWRUL). / CHECKS FOR RULER CHANGES. / / CALL: / CLA / AC MUST = 0 / / DF DOESN'T MATTER / JMS CMPRUL / COMPARE NWRUL TO CURUL / JMP RULSAM / RULERS ARE THE SAME, AC=0 / JMP RULDIF / RULERS ARE DIFFERENT, AC=0 / CMPRUL, XX JMS BHOOK / call CMPRLH through the BLASTR /a239 CMPRLE / BLASTR table entry /a239 SKP / normal return keep it normal /a239 ISZ CMPRUL / skip return from BHOOK and now from here /a239 JMP I CMPRUL / RETURN /a239 /d239 TAD (NWRUL-1) / GET PNTR TO NEW RULER /d239 DCA X0 /2239 TAD (CURUL-1) / GET PNTR TO OLD RULER /d239 DCA X1 /d239 TAD (-RULSIZ) /d239 DCA T1 /d239CMPRL1, CDFMNU / A219 /d239 TAD I X0 /d239 CIA / COMPARE NEW TO OLD /d239 CDFMYF / A219 /d239 TAD I X1 /d239 SZA CLA /d239 JMP CMPRL2 /d239 ISZ T1 /d239 JMP CMPRL1 / NOT SIGNIFICANT, DO NEXT /d239 SKP /d239CMPRL2, ISZ CMPRUL /d239 JMP I CMPRUL CLRULR, XX / CLEAR RULER JMS BHOOK / Call CLRLRH thru the BLASTR /a239 CLRLRE / BLASTR table entry /a239 JMP I CLRULR /a239 /d239 CDFMNU /d239 TAD (NWRUL-1) /d239 DCA X0 /d239 TAD (-HAFRUL) /d239 DCA T1 /d239 TAD (101) /d239 DCA I X0 /d239 ISZ T1 /d239 JMP .-3 /d239 TAD (-10) /d239 DCA T1 /d239 DCA I X0 /d239 ISZ T1 /d239 JMP .-2 /d239 CDFMYF /d239 JMP I CLRULR /a239 THE above two routines removed to WPHOLE /***********************************************************************/a239 /a239 INSERT CHAR into text buffer allowing for 8 bit data /***********************************************************************/a239 ESIMCH, XX / subroutine return address /a239 DCA ET1 / save the char /a239 TAD ET1 / get it back /a239 AND (200) / check for 8 bit data /a239 SNA CLA / skip if 8 bit /a239 JMP NEXPC / deal with the char normally /a239 SLNMOD / set line modified flag /a239 TAD (ESTRING-1) / get the start of the standard dead str/a239 DCA X1 / save in an index register /a239 ELOOP, RDF / read the data field /a239 TAD CDF0 / make a CDF instruction /a239 DCA ESCDF / put it where you can use it /a239 CDFMYF / get this field to access ESTRING /a239 TAD I X1 / use the index register to get'dead str/a239 ESCDF, 0 / restore the data field /a239 AND P177 / dead strings are all 7 bits /a239 SNA / test for end of string /a239 JMP I ESIMCH / RETURN on END of dead string /a239 JMS ESICHR / INSERT CHAR INTO TEXT BUFFER /a239 JMP ELOOP / get next dead str char /a239 NEXPC, TAD ET1 / get the char back /a239 JMS ESICHR / INSERT CHAR INTO TEXT BUFFER /a239 JMP I ESIMCH / RETURN /a239 ESTRING,10 / start of dead /a239 " / space /a239 "2 / 2 multinational char precedence /a239 ET1, 0 / save char temp and 8 bit char position/a239 15 / END OF DEAD /a239 0 / string terminator /a239 /***********************************************************************/a239 MAKRUL, XX / MAKE RULER / JMS MAKRUL - RULR - OUTRTN / GENS ESCS FOR RULR THRU OUTRTN CDFMYF TAD I MAKRUL DCA MAKRLA ISZ MAKRUL TAD I MAKRUL DCA MAKRLB / SAVE RULR AND OUTRTN PTRS ISZ MAKRUL DCA DSPRL1 / CLEAR POSITION MAKRL1, ISZ DSPRL1 / BUMP TO NEXT POSITION TAD DSPRL1 JMS GETBYT MAKRLA, .-. SNA JMP I MAKRUL / RETURN WHEN DONE TAD (-1) SNA JMP MAKRL1 / IGNORE NULS TAD (100) DCA MAKRLC / SAVE VAL CODE TAD DSPRL1 RTR RTR / GEN DSPRL1 AND (17) SNA JMP .+3 TAD (60) JMS I MAKRLB / 1ST HEX DIGIT TAD DSPRL1 AND (17) TAD (60) JMS I MAKRLB / 2ND HEX DIGIT TAD MAKRLC JMS I MAKRLB / VAL CODE CDFMYF JMP MAKRL1 / LOOP FOR MORE MAKRLB, .-. MAKRLC, .-. DSPRUL, XX / DISPLAY RULER JMS PCUR / POSITION CURSOR TAD I DSPRUL / Get agument of which ruler to display./A196 DCA DSPRLR / Save it. /A196 ISZ DSPRUL / Bump to return address. /A196 DSPRLA, AC0001 / Compute posn into string = cursor posn/A196 TAD CURPOS / ... /A196 JMS GETBYT DSPRLR, NWRUL SNA JMP I DSPRUL JMS GETBYT OKSTR / XLAT TO REAL CHAR BSW SMA IAC BSW / CONVERTS SIXBIT TO ASCII JMS PUTSCH JMP DSPRLA / RETURN IF NOT DSPRL1, .-. DSPRLN, XX TAD NORUPD / SKIP RULER UPDATE IF IN RULER MODE SNA CLA JMS ESNWRL /D233 DCA NORUPD JMS DSPRUL NWRUL / Display the NEW ruler. /A196 JMP I DSPRLN / NORUPD must be on same page as DSPRLN/A196 NORUPD, 0 / FLAG FOR NO RULER CHANGE IN FXSCRL DSPCUR, XX / Routine to display CURUL. Called by /A196 JMS DSPRUL / status line. /A196 CURUL / ... /A196 CDIMNU / SET UP TO RETURN BACK TO MENU FIELD /A220 JMP I DSPCUR / Return to caller. /A196 EIGRAR, OVLJMP;OVGRAR / GOLD RIGHT ARROW EIGLAR, OVLJMP;OVGLAR / GOLD LEFT ARROW EISWAP, OVLJMP;OVSWAP / SWAP OVERLAY X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED / NOTE: THE GOTO-RULER CODE IN 'OVRRGO' RELIES ON THE FACT THAT / 'SETRUL' IS CALLED WHENEVER 'CURMOV' ADVANCES OR BACKS UP OVER / A RULER. WHEN 'OVRRSC' SCROLLS TO A RULER, IT CLEARS ENTRY POINT / 'SETRUL', THEN CALLS 'CURMOV' UNTIL 'SETRUL' IS NONZERO, / INDICATING 'CURMOV' HAS PASSED OVER A RULER. SETRUL, XX / JMS SETRUL - INRTN / SETS UP NWRUL CDFMYF TAD I SETRUL DCA SETRLA ISZ SETRUL JMS CLRULR / CLEAR NEW RULER SETRLB, DCA RLPOSN JMS I SETRLA AND P177 TAD P7700 / SAME AS (-100) ONLY ITS ON PAGE 0 SMA JMP SETRL3 / CHECK FOR PARMS TAD (100-60) SPA JMP SETRL1 MQL TAD RLPOSN / SAVE PRM, GET POSITION CLL RTL RTL MQA / RLPOSN*16+PRM JMP SETRLB / JUMP TO STORE, GET NEXT SETRL1, CLA / RETURN TO CALLER W/ ZEROED AC SETRL3, SNA JMP I SETRUL / JUMP IF NOT VAL IAC JMS UPDRUL JMP SETRLB SETRLA, .-. /++ / UPDRUL UPDATE_RULER / / FUNCTIONAL DESCRIPTION: UPDRUL / / UPDATING OF RULER (IN NWRUL), LOCATIONS CONTAINING RULER POSITION / VALUES (RLSTOR THRU NWHMAR), AND DECIMAL TAB COUNT BUFFER (NWDT). / / UPDRUL PSEUDO CODE: / COMMENTS: 1) RULER_SETTING_TYPE - EACH RULER CHARACTER (L, R, T, / ...ETC.) HAS A UNIQUE TYPE ASSIGNED TO IT. (SEE CHART / AT NWRUL) / 2) STORAGE_OFFSET_VALUE - EACH RULER CHARACTER HAS A / STORAGE OFFSET VALUE (SEE XLSTR) ASSOCIATED WITH IT / THAT IS USED FOR OFFSETTING FROM RLSTOR TO STORE THE / POSITION OF THE RULER SETTING IN THE RULER OR IN THE / CASE OF DECIMAL TABS, THE NUMBER OF THEM IN THE RULER. / BEGIN / SAVE NEW RULER_SETTING_TYPE / IF [NEW RULER_SETTING_TYPE IS VALID (1-16)] / | GET STORAGE_OFFSET_VALUE FOR NEW RULER_SETTING_TYPE (XLSTR TABLE) / | SAVE IT / | GET OLD RULER_SETTING_TYPE FOR RULER POSITION WE'RE AT / | GET OLD RULER SETTING STORAGE_OFFSET_VALUE / | IF [OLD RULER SETTING STORAGE_OFFSET_VALUE = DECIMAL TAB STORAGE_OFFSET_VALUE] / | | SET DECIMAL TAB COUNT = DECIMAL TAB COUNT - 1 / | ELSE / | IF [POSITION VALUE STORED FOR OLD RULER SETTING NEEDS CLEARING] / | CLEAR POSITION VALUE FOR OLD RULER SETTING / | / | IF [POSITION VALUE FOR NEW RULER_SETTING_TYPE NEEDS UPDATING] / | | SET POINTER FOR SAVING POSITION VALUE OF NEW RULER SETTING / | | IF [NEW RULER_SETTING_TYPE = DECIMAL TAB] / | | | SET DECIMAL TAB COUNT = DECIMAL TAB COUNT + 1 / | | ELSE / | | IF [OLD RULER_SETTING_TYPE NEEDS MODIFICATION] / | | SET POSITION OF OLD RULER SETTING IN RULER TO NO SETTING / | | STORE NEW RULER_SETTING_TYPE POSITION / | SET [NEW RULER SETTING IN RULER] / | / RETURN / / CALLING SEQUENCE: JMS UPDRUL / / INPUT PARAMETERS: RLPOSN = CURRENT POSITION IN RULER / AC = NEW RULER_SETTING_TYPE / / IMPLICIT INPUT: RLTYP, RLNSTR (T3), RLPOSN, NWDT, T2 / / OUTPUT PARAMETERS: NONE / / IMPLICIT OUTPUT: RLTYP, RLNSTR (T3), NWDT, T2 / / COMPLETION CODE: NONE / / SIDE EFFECTS: NONE / /-- RLNSTR= T3 UPDRUL, XX / UPDATE RULER DCA RLTYP / SAVE NEW RULER_SETTING_TYPE CDFMYF TAD RLTYP / GET THE TYPE OF SETTING TAD (-17) / IS IT A VALID SETTING? SMA CLA / SKIP IF: SO JMP I UPDRUL / IGNORE ILLEGAL SETTING TAD RLTYP / GET STORAGE_OFFSET_VALUE FOR NEW / RULER_SETTING_TYPE (XLSTR TABLE) JMS GETBYT XLSTR DCA RLNSTR / SAVE IT TAD RLPOSN / GET OLD RULER_SETTING_TYPE FOR / RULER POSITION WE'RE AT JMS GETBYT NWRUL JMS GETBYT XLSTR / GET OLD RULER SETTING STORAGE_OFFSET_- / VALUE TAD (RLSTOR-1-NWDT) / WAS OLD RULER SETTING STORAGE_OFFSET_- / VALUE THAT OF A DECIMAL TAB? CDFMNU / A219 SZA / SKIP IF: SO JMP UPDRLC / CONTINUE ON. NO SPECIAL PROCESSING. AC7777 / SET DECIMAL TAB COUNT = DECIMAL TAB / COUNT - 1 TAD NWDT DCA NWDT JMP UPDRLF / SKIP OVER CLEARING OLD OFFSET UPDRLC, TAD (NWDT+1-RLSTOR) / LOCATION HOLDING POSITION VALUE FOR / OLD RULER SETTING NEED CLEARING? SNA / SKIP IF: NEED TO CLEAR OLD STORAGE / OFFSET JMP UPDRLF TAD (RLSTOR-1) / CLEAR LOCATION HOLDING POSITION VALUE DCA T2 / FOR OLD RULER SETTING DCA I T2 UPDRLF, TAD RLNSTR / DOES THE POSITION VALUE FOR THE NEW / RULER_SETTING_TYPE NEED UPDATING? SNA / SKIP IF: NEED TO UPDATE JMP UPDRLA TAD (RLSTOR-1) / SET POINTER FOR SAVING POSITION VALUE / OF NEW RULER SETTING DCA T2 UPDRLD, AC7776 / NEW RULER SETTING A DECIMAL TAB? TAD RLTYP SZA CLA / SKIP IF: SO JMP UPDRLE / GO CLEAR OLD POSITION ISZ I T2 / SET DECIMAL TAB COUNT = DECIMAL TAB / COUNT + 1 JMP UPDRLA / BYPASS CLEARING OUT OLD POSITION UPDRLE, TAD I T2 / DOES OLD RULER_SETTING_TYPE NEED / MODIFICATION?   SNA / SKIP IF: YES JMP UPDRLB / JUST SET NEW POSITION MQL / HOLD POSITION ON LINE OF OLD RULER / SETTING IAC / SET AC = NO_SETTING RULER_SETTING_TYPE JMS PUTBYT / PUT THIS NO_SETTING CHARACTER IN RULER NWRUL UPDRLB, CDFMNU TAD RLPOSN / STORE NEW RULER_SETTING_TYPE'S POSITION DCA I T2 UPDRLA, TAD RLPOSN / SET NEW RULER SETTING IN RULER MQL / HOLD IT'S POSITION IN RULER TAD RLTYP / GET TYPE OF SETTING JMS PUTBYT / PUT IT IN NWRUL NWRUL JMP I UPDRUL / RETURN RLTYP, .-. / / / CHKCHR, XX / CHECK AC FOR SPECIAL CHARACTER JMS ESJCHK / RETURN FROM THIS SUBROUTINE WITH / AC = 0 IF CHARACTER WAS JUSTIFY_SPACE, / WRAPPED_LINE, WRAPPED_LINE_WITH_HYPHEN, / LINE_MODIFIED_FLAG, OR RULER_MODIFIED_FLAG. / IF NOT THEN AC = CHARACTER - RULER_ / MODIFIED_FLAG SZA / SKIP IF: CHARACTER IS ONE OF THOSE LISTED / ABOVE. TAD (JCHKOF-ECSTRL) / CHARACTER = "START_OF_RULER"? SZA CLA / SKIP IF: SO ISZ CHKCHR / BUMP RETURN. NONE OF SPECIAL CHARACTERS / LISTED HERE! JMP I CHKCHR / RETURN ESJCHK, XX / CHECK FOR LINE OR RULER MODIFIED FLAG JMS ESJTST / RETURN FROM ESJTST WITH AC = 0 IF CHAR. / WAS A JUSTIFY_SPACE, WRAPPED_LINE, OR / WRAPPED_LINE_WITH_HYPHEN. IF NOT THEN / AC = CHARACTER - ECHYLN SZA / SKIP IF: CHARACTER DETECTED DURING / ESJTST WAS A JUSTIFY_SPACE, WRAPPED_ / LINE, OR WRAPPED_LINE_WITH_HYPHEN TAD (JTSTOF-ECMDFL) / CHARACTER = "LINE_MODIFIED_FLAG"? SZA / SKIP IF: SO TAD (ECMDFL-ECRMFL) / SUBTRACT "RULER_MODIFIED_FLAG" CHAR. JMP I ESJCHK JCHKOF= ECRMFL / AC OFFSET ON RETURN, IF NON-ZERO ESJTST, XX / CHECK FOR JUSTIFY_SPACE, WORD_WRAP OR / WRAPPED_LINE_WITH_HYPHEN TAD (-ECJSPC) / CHARACTER = "JUSTIFY_SPACE"? SZA / SKIP IF: SO TAD (ECJSPC-ECWWLN) / CHARACTER = "WRAPPED_LINE"? SZA / SKIP IF: SO TAD (ECWWLN-ECHYLN) / SUBTRACT "WRAPPED_LINE_WITH_HYPHEN" CHAR. JMP I ESJTST / RETURN JTSTOF= ECHYLN EIPWFL, PUTESC / SET APPLICATION KEY-PAD MODE "=-200 JMS CLSSET / CLEAR SCROLL VALUES FOR STATUS DISPLAY JMP EINEXT / AND WAIT FOR NEXT EDIT CMD / SINCE THE ACCENTED CHARACTER TABLES HAVE BEEN MOVED TO THE PRINTER / SEARCH HAS BEEN MODIFIED TO LOOK IN THE PRINTER IFDEF FORIN < / SEARCH FOR ENTRY IN TABLE1 OR TABLE2 SEARCH, XX DCA POINT1 / SAVE TABLE ADDRESS CDFPRT / SET TO PRINTER FIELD ISZ POINT1 / BUMP POINTER TAD I POINT1 / GET CONTENTS ISZ POINT1 / BUMP AGAIN SNA / END OF TABLE? JMP SRCHEX / YES, TAKE 1ST EXIT TAD CHAR1 / COMPARE AGAINST CHAR. DESIRED SZA CLA / SAME? JMP SEARCH+3 / NO ISZ SEARCH / YES, TAKE 2ND EXIT SRCHEX, CDFMYF / CHANGE BACK TO THIS FIELD JMP I SEARCH > / END IFDEF FORIN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED PUTMSG, XX / OUTPUT MESSAGE TO SCREEN TAD I PUTMSG / GET ADDRESS OF MESSAGE TO OUTPUT ISZ PUTMSG / INCREMENT RETURN ADDRESS CDILP / SET DATA AN INSTRUCTION FIELD TO LP FIELD JMS PUTLP / CALL ROUTIN IN LIST PROCESSING FIELD JMP I PUTMSG / RETURN TO CALLER GETBYT, XX / TAD INDEX - JMS GETBYT - SPTR CDFMYF / A219 RETURNS BYTE TAD (-1) CLL RAR DCA T1 / A219 TAD I GETBYT / GET PTR JMS NRTST / A219 TAD T1 / A219 DCA T1 TAD I T1 / GET WORD SNL BSW / GET BYTE AND P77 / ISOLATE IT ISZ GETBYT CDFMYF / A219 JMP I GETBYT / AND RETURN PUTBYT, XX / TAD INDEX - MQL - TAD CHAR - JMS PUTBYT - SPTR CDFMYF / A219 SETS STRING(INDEX)=CHAR AND P77 / ISOLATE CHAR SWP TAD (-1) CLL RAR DCA T1 / A219 TAD I PUTBYT / GET PTR JMS NRTST / A219 TAD T1 / A219 DCA T1 TAD I T1 / GET WORD SNL BSW / GET BYTE AND P7700 / ISOLATE MQA / INSERT CHAR SNL BSW DCA I T1 / PUT IT BACK IN STRING ISZ PUTBYT CDFMYF / A219 JMP I PUTBYT / RETURN CPYBUF, XX / JMS COPY - -CNT - CDFA - A-1 - CDF B - B-1 CDFMYF TAD CPYBUF CIFLP JMS I (XFCOPY) / AND GO DO IT IN LP FIELD DLTRLR, XX / DELETE RULER CDFBUF DCA I CURPTR ADVPTR JMP I DLTRLR TAD (-ECNDRL) SZA CLA JMP .-5 DCA I CURPTR JMP I DLTRLR ADVRUL, XX / ADVANCE RULER TAD CURPTR DCA ADVRL1 / SAVE CURPTR ADVRLA, JMS ESNWRL / COLLECT NEW RULER INFO TAD ADVRL1 DCA CURPTR JMS DLTRLR / DELETE RULER ADVPTR / ADVANCE TO NEXT CODE JMP ADVRLB TAD (-ECSTRL) SNA CLA JMP ADVRLA / LOOP IF STILL IN RULERS ADVRLB, JMS CMPRUL JMP ADVRLC / COMPARE WITH OLD RULER JMS INSRUL / INSERT IF NOT A NULL CHANGE JMS COPRUL / AND MAKE IT THE NEW CURRENT RULER ISZ ADVRUL / BUMP TO NON-NULL RETURN TAD RGTMAR / WIDE RULER? TAD (-COLM80) SMA CLA JMS SETSPT / SET SPLIT SCREEN IF SO ADVRLC, DCA RLRMOD / CLEAR RULER CHANGE FLAG JMS SCRNMD / LET SCREEN REFRESH JMP I ADVRUL / AND RETURN ADVRL1, .-. / TEMP ESNWRL, XX / SET NEW RULER ADVPTR JMP I ESNWRL TAD (-ECMDRL) SZA CLA JMP .-4 / GET TO MIDDLE JMS SETRUL ESADRL / SET NWRUL CDFBUF / RESET FIELD JMP I ESNWRL ESADRL, XX ADVPTR NOP CDFMYF JMP I ESADRL / GLOBAL SEARCH FLAG CHECK ROUTINE / THIS ROUTINE IS BRANCHED TO FROM THE EDITORS INPUT CHAR WAIT LOOP / AT SYMBOL "EDICHR" TO SEE IF THE GLOBAL SEARCH FLAG (GSRF) IS SET / IF IT IS SET, WE CALL IN THE REPLACE OVERLAY TO CONTINUE THE OPERATION / THE SEARCH AND SELECT OVERLAY WILL COME HERE WHEN THE DESIRED TEXT / STRING IS FOUND IN THE DOCUMENT. THIS ROUTINE WILL THEN CALL IN THE / REPLACE OVERLAY, WHICH THEN CALLS IN THE SEARCH AND SELECT OVERLAY TO / CONTINUE. REACHING THE END OF THE DOCUMENT OR A GOLD+HALT WILL / TERMINATE THE PROCESS. GSRCK, XX TAD GSRF / GET THE GLOBAL SEARCH AND REPLACE FLAG SNA CLA / IS IT SET? JMP I GSRCK / NO, RETURN TO CALLER! OVLJMP;OVREPL / YES, CALL IN THE REPLACE OVERLAY /++ / RLEQTE RULER_EQUATE / / FUNTIONAL DESCRIPTION: RLEQTE / / COPY CURRENT RULER BUFFER (CURUL) TO NEW RULER BUFFER (NWRUL). / / RLEQTE PSEUDO CODE: / / BEGIN / | CALL CPYBUF / | RETURN / END / / CALLING SEQUENCE: JMS RLEQTE / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: NONE / OUTPUT PARAMETERS: NONE / IMPLICIT OUTPUT: NONE / COMPLETION CODE: NONE / SIDE EFFECTS: NONE / /-- RLEQTE, XX / RULER_EQUATE JMS CPYBUF -RULSIZ / COUNT CDFMYF / FIELD TO COPY FROM CURUL-1 / STARTING ADDRESS TO COPY FROM CDFMNU / FIELD TO COPY TOO NWRUL-1 / STARTING ADDRESS TO COPY TOO JMP I RLEQTE / RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.%400+DLOEDT / DISK BLOCK WHERE PAGE IS LOADED IFDEF PERDEC < / OK STRING - ACCEPTABLE RULER CHARACTERS OKSTR, 5556 / dash, period > / END IFDEF PERDEC IFDEF COLDEC < OKSTR, 5572 / dash, colon > / END IFDEF COLDEC IFDEF COMDEC < OKSTR, 5554 / dash, comma > / END IFDEF COMDEC / The following stings comprise the table of acceptable 7 bit characters / for ruler definitions. Where an 8 bit character is required, an entry / should be made here of an appropriate composable 7 bit character, such / as the ones shown on the key beside the 8 bit (eg. e-accute and # on the / Italian keyboard). The six bit representation of the 8 bit character / should be put in the appropriate corresponding place in EIGHTC. IFDEF ENGLSH < 7624 / closing angle bracket, T TEXT /LRDJWPCNHF/ > / END IFDEF ENGLSH IFDEF V30NOR < 7624 / closing angle bracket, T TEXT /VUDJIASNOF/ > / END IFDEF V30NOR IFDEF V30SWE < 7617 / closing angle bracket, O TEXT /VHYRISCZAX/ > / END IFDEF V30SWE IFDEF ITALIAN < 7624 / closing angle bracket, T TEXT /SDEGIPCNLM/ > / END IFDEF ITALIAN IFDEF SPANISH < /A255 7624 / closing angle bracket, T / " TEXT /SNDAIPCLGM/ / " > / END IFDEF SPANISH /A255 IFDEF FRENCH < 7624 / closing angle bracket, T TEXT "GDIJAPCHZF" > / END IFDEF FRENCH IFDEF GERMAN < 7624 / closing angle bracket, T TEXT /LRDJWPCNHF/ > / END IFDEF GERMAN IFDEF DUTCH < 7624 / closing angle bracket, T TEXT /LRDUIACNKF/ > / END IFDEF DUTCH IFDEF CANADA < 7624 / closing angle bracket, T TEXT /LRDJWPCNHF/ > / END IFDEF CANADA IFDEF NORWAY < 7624 / closing angle bracket, "T" TEXT "VHDJIASMOF" > / END IFDEF NORWAY IFDEF SWEDSH < 7624 / closing angle bracket, "T" TEXT "VHDJISCMAF" > / END IFDEF SWEDSH IFDEF DANISH < 7624 / closing angle bracket, "T" TEXT "VHDJIACMOF" > / END IFDEF DANISH *.-1 IFDEF ENGLSH < IFNDEF V30SWE < IFNDEF V30FAO < TEXT /=0123456789)!"#$%^&*(/ > > IFDEF V30FAO < TEXT '+0123456789=!"#$%&/()' /Keyboard layout for FAO/A250 > > / END IFDEF ENGLSH IFDEF V30NOR < TEXT '+0123456789=!"#$%&/()' /Keyboard layout for NORWAY/A254 > IFDEF V30SWE < TEXT '+0123456789=!"#$%&/()' /Keyboard layout for SVEEDON > IFDEF SPANISH < /A255 TEXT '+0123456789=!"#$%&/()' /Keyboard layout for SPN/ " > /A255 IFDEF ITALIAN < TEXT /-0123456789]\#"'(_7^[/ /NOTE: several of these can not be /obtained on an italian keyboard /except by a compose sequence /as they correspond to MCS chars /See eightc table for corresponding > /allowable MCS chars IFDEF FRENCH < TEXT :=0123456789#&["'(]?!\: > / END IFDEF FRENCH IFDEF GERMAN < TEXT :+0123456789=!"#$%&/(): > / END IFDEF GERMAN IFDEF DUTCH < TEXT :=0123456789"]\#$%!&(): > / END IFDEF DUTCH IFDEF CANADA < TEXT :=0123456789)!"/$%?&*(: > / END IFDEF CANADA IFDEF SCANDI < TEXT :+0123456789=!"#$%&/(): > / END IFDEF SCANDI TBSTR, 003;201;002;002;101;0;0 / EACH BYTE IN THIS TABLE CORRESPONDS / TO A RULER SETTING (SEE COMMENTS AT / NWRUL). EACH BYTE HERE TELLS US THE / CLASS OF RULER SETTING. XLSTR, 7;0;102;102;304;501;601 / EACH BYTE IN THIS TABLE CORRESPONDS / TO A RULER SETTING. (SEE COMMENTS AT / NWRUL). EACH BYTE TELLS US THE / OFFSET FROM LOCATION RLSTOR-1 TO / STORE THE POSITION OF THE RULER / SETTING UNDER CONSIDERATION. XLMAR, 002;400;003;100 / TYPE OF LEFT MARGIN PTRBLK, ZBLOCK NPTRS / SCREEN PTRS EIGES4, -63 / MAX LENGTH OF SEARCH PHRASE ZBLOCK 63 / 50 CHAR SEARCH BUFF / NWRUL IS LAODED WITH CURRENT RULER (CURUL BUFFER) PREVIOUS TO MODIFICATION / (GOLD-RULER). IT'S FORMAT IS AS FOLLOWS: EACH WORD IS DIVIDED INTO / 2 BYTES, EACH BYTE CONTAINING THE RULER SETTING FOR IT'S / CORRESPONDING POSITION IN THE RULER. PLEASE NOTE THAT WPS USES / OTHER CHARACTERS TO REPRESENT THE VARIOUS SETTINGS THAT MAY APPEAR / IN A RULER. THEY ARE NOT THE SAME CHARACTERS THAT APPEAR IN THE / RULER ON THE SCREEN. / / TYPE CLASS RULER SYMBOL / CHAR. VALUE IN NWRUL (TBSTR) MEANING SHOWN ON SCREEN / ----- ----- ------- ------- ------- --------------- / SPACE 41 1 0 NO SETTING _ / A 42 2 3 DECIMAL TAB STOP . / B 43 3 2 RIGHT-JUST. TAB STOP "RIGHT ANGLE BRACKET" / C 44 4 1 NORMAL (LEFT-JUST.) TAB T / D 45 5 0 LEFT MARGIN, SINGLE SPACED L / E 46 6 2 RIGHT MARGIN, RAGGED R / F 47 7 0 LEFT MARGIN, DOUBLE SPACED D / G 50 10 2 RIGHT MARGIN, JUSTIFIED J / H 51 11 1 WORD WRAPPED INDENT W / I 52 12 1 PARAGRAPH INDENT P / J 53 13 0 CENTERING POINT C / K 54 14 0 LEFT MARGIN, SPACE-AND-A-HALF N / L 55 15 0 HYPHENATION ZONE H / M 56 16 0 LEFT MARGIN, HALF-SPACE F / / CURUL - CURRENT_RULER / CURUL HOLDS THE SETTINGS OF THE CURRENT RULER WE ARE EDITING UNDER. / CURUL IS THE SAME FORMAT AS NWRUL DESCRIBED ABOVE. RULSIZ= NWRLND-NWRUL CURUL, ZBLOCK RULSIZ GSRPRV, 0 / PREVIOUS GLOBAL SEARCH FLAG WIDPRV, 0 / PREVIOUS WIDE SCREEN FLAG NOMOVE, 0 / FLAG FOR SEARCH MODE OPERATIONS RPRLHN, 0 / Rapid Paging Ruler Header block Number / RULER DISPLAY TEXT LITERALS RLSTR2, TEXT /....:....:/ RLSTR4, TEXT / / EIPRSC, OVLJMP;OVPRSC / PREV SCREEN X=. /-------------------- PAGE NRTST, 0 / Test if value is address of new ruler buffer TAD (-NWRUL) / If it is, set field to menu buffer swap area SNA CDFMNU TAD (NWRUL) CML / Restore link to original value JMP I NRTST / return to caller EIBKUP, IAC EIADVN, DCA MOVMOD+1 / SET MODE FLAG (FORWARD/BACKWARD) SIMCHR, MODSET MOVMOD / PUT MODE JMP EICHAR / SIMULATE CHAR BUTTON MOVMOD, SCHMOD!SLTMOD .-. EILOWR, TAD (40) / CASE LOWER EIUPPR, / CASE UPPER DCA CASBIT / SET UP/LOW SWITCH IAC EIUUDL, IAC / REMOVE UNDERLINE EIUBLD, IAC / REMOVE BOLD EIUNDL, IAC / UNDERLINE EIBOLD, / BOLD TAD (BLDMOD) DCA MOVMOD+1 / SAVE FUNCTION TYPE TSTSLT JMP SIMCHR / SIMULATE CHAR BUTTON IF NOT IN SELECT MODE / ELSE RETURN HERE WITH / CURRENT CHAR = START OF SELECT MODSET MOVMOD JMP SLXMOD ESLCT1, TAD (ECTMRK) / INSERT POSITION MARKER JMS INSERT DOSLCT, TAD (ECSLPT) / INSERT SELECT BREAK CHAR JMS INSERT JMS SVSLCR / SAVE CURSOR POSITION /A209 MODSET ESLMOD / SET SELECT MODE JMS SCRNMD AC0001 DCA ECHFLG AC0001 / GOLD S&R BUG FIX TAD SCRLCT / ARE WE ON A NEW LINE ie NEG SCRL CNT SPA CLA / SKIP IF NO. EVERYTHING IS STILL COOL JMS REJUST / IF YES WE MUST REJUSTIFY JMS SCRLUP JMS SCRNMD JMS LINDNT JMP GOTMRK / GDCASE A SUBROUTINE TO PERFORM CASE STYLE CHECKING / / CALL: / / ZZCASE (HAS A PAGE ZERO LINK) / TABLE-1 (ADDRESS OF THE TABLE TO COMPARE AGAINST) / (ON NO MATCH RETURNS HERE) / / AC ==> (VALUE TO COMPARE AGAINST) / / THE COMPARE TABLE HAS THE FORMAT OF: / / VALUE;ADDRESS / VALUE 1 AND ADDRESS TO JUMP TO ON MATCH / VALUE;ADDRESS / VALUE 2 AND ADDRESS TO JUMP TO ON MATCH / ... / ETC. / 0 / TABLE TERMINATOR / / NOTE: THIS SUBROUTINE DESTROYS THE CONTENTS OF AUTO INDEX / REGISTERS 6 AND 7 / CASTMP=IX0 / AUTO INDEX REGISTER 6 X7=IX1 / AUTO INDEX REGISTER 7 GDCASE, XX / ENTRY TO CASE SUBROUTINE DCA CASTMP / SAVE AC FOR COMPARES RDF / SAVE DATA FIELD TAD CDF0 / ADD TO CDF TO FIELD 0 DCA CASE02 / AND PUT FOR RETURN CDFMYF / SET TO MYFIELD TAD I GDCASE / GET THE TABLE ADDRESS DCA X7 / SAVE IN AUTO INDEX REGISTER / / THIS IS THE CHECK LOOP FOR CASE MATCHING / CASE01, TAD I X7 / GET VALUE SNA / TERMINATOR? JMP CASEXI / YES TAKE DEFAULT RETURN CIA / NEGATE THE OPERAND TAD CASTMP / COMPARE SNA CLA / MATCHED? JMP CASMAT / YES! GO TO MATCH EXIT ISZ X7 / SKIP JUMP VECTOR JMP CASE01 / TRY THE NEXT VALUE / / END OF LOOP / CASMAT, TAD I X7 / GET RETURN ADDRESS DCA GDCASE / STORE FOR RETURN SKP / DON'T INCREMENT CASEXI, ISZ GDCASE / SKIP TABLE VECTOR CASE02, CDFMYF / RESET DATA FIELD JMP I GDCASE / AND GO HOME HDRGET, XX / JMS HDRGET - HDROFST CDFMYF AC7776 TAD I HDRGET ISZ HDRGET CIFFIO FILEIO XHDRGT JMP I HDRGET EICONT, OVLJMP;OVCONT / ENTRY POINT FOR CONT SEARCH & SLCT EIVIEW, OVLJMP;OVVIEW / GOLD VIEW EIGPGE, OVLJMP;OVGPGE EITIME, OVLJMP;OVTIME EIGETC, OVLJMP;OVGETC EIDCMT, OVLJMP;OVDCMT / GOLD GET_DOC EIMENU, OVLJMP;OVMENU / ENTRY POINT FOR EDITOR MENU EIHYP2, OVLJMP;OVHYP2 IFDEF CONDOR < EITX, OVLJMP;OVTC / TECHNICAL CHARACTER OVERLAY /A211 EICLKY, OVLJMP;OVCLKY / COLUMN CUT /A205 > / END IFDEF CONDOR IFDEF LFTRGT < EILARO, OVLJMP;OVLARO / LEFT ARROW EIRARO, OVLJMP;OVRARO / RIGHT ARROW > / END IFDEF LFTRGT RPPRRL, 0 / Rapid Paging PRevious Ruler block ID# /M201 RPPG0, 0 / Minus = gone over TOP-DOC /M201 RPBIN1, 0 / BINARY UNITS,TENS,HUNDREDS / PATCH TO PUTSCH FOR HORIZ SCROLLING CHARPT= . / PUTPAT MERGED INTO PUTSCH / ROUTINES TO GO IN AND OUT OF 132-COLUMN DISPLAY MODE / This routine puts terminal in 80 column mode / AC UNIMPORTANT ON ENTRY / DATA FIELD NOT IMPORTANT ON ENTRY BUT SET TO THIS FIELD ON EXIT CLR132, XX AC0004 / PUT AN OFFSET IN AC SO SET132 JMS SET132 / WILL ACTUALLY CLEAR 132 COLUMN MODE JMP I CLR132 / RETURN / This routine puts terminal in 132 column mode if ac=0 or 80 / column mode if ac= "l-"h (4) / DATA FIELD NOT IMPORTANT ON ENTRY BUT SET TO THIS FIELD ON EXIT / Modified for manual screen width choice to check the force wide/narrow /M223 / flag (WIDNAR). SET132 is called with AC=0 to set wide, or with AC=4 /M223 / from CLR132 to set narrow. By adding the WIDNAR flag (0=wide, 64=nar.) /M223 / we get four possible values of AC: 0, 4, 64, or 70. 0 means wide, so /M223 / we call LP132 with 0 AC. AC=70 was a call from CLR132 to go narrow, /M223 / and WIDNAR=64 says we're forced narrow, so call LP132 with AC=4 to /M223 / go to 80 column mode. AC=64 was a call to SET132, but WIDNAR says /M223 / we're forced narrow, so call LP132 with AC=4 to stay in 80 column. /M223 / AC=4 is a call from CLR132 to go narrow, which we allow even though /M223 / WIDNAR says force wide. This is for cases like GOLD:TOP which goes /M223 / to narrow mode for messages, or GOLD:MENU for the editor menu. The /M223 / basic rule is to stay in narrow mode ALWAYS, unless SET132 is called /M223 / and the force wide (WIDNAR=0) flag is set. /M223 SET132, XX CDFMYF /A223 TAD WIDNAR / GET WIDE/NARROW FLAG /A223 SZA /A223 AC0004 / NARROW, OR CLR132 CALL: FORCE 80 COL. /A223 CDILP / REAL ROUTINE IN IN LP FIELD WHERE JMS I (LP132) / THERE'S MORE ROOM JMP I SET132 / RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE / *7000 / OVERLAY AREA 2 LOCATION IFNZRO .-7000 OV2NUM= 0 / INITIALIZE OVERLAY TWO COUNTER OVLAY2, OV2NUM / STORE OVERLAY NUMBER AS FIRST LOCATION /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** CDISPL= CDIMTH / DEFINE CHANGE FIELD INSTRUCTION TO SPELL NLINES= 11 / NUMBER OF LINES WITHIN SCROLLING REGION INITSP, XX / Entry point of initialization code. RDF / Get return field. TAD CIDF0 / ... DCA INITXT / save return CIF CDF instruction. CDFEDT / Map current (editor) field. TAD (NLINES) / Set edit screen size to 9 lines. DCA SCRNLN / ... TAD (NLINES) / Set wide screen size too. DCA WIDSIZ / ... TAD (SINZRO-1) / Get start of editor stuff to zap. DCA X0 / ... TAD (-NINZRO) / Get size of initialization area. JMS ZAP / Initial the area to zero. DCA BUFBEG / Initialize editor buffer pointers. TAD (BUFEND) / ++++ DCA BUFSIZ / .... / / INITIALIZE EDIT BUFFER / *** / AC7777 / SET POINTER TO BUFFER_BEGIN - 1 DCA X0 CDFBUF TAD (ECBFBG) / GET BUFFER BEGIN CODE DCA I X0 / INSTALL AT TOP OF BUFFER TAD (ECSTX) / GET START OF TEXT CODE DCA I X0 / INSTALL IN NEXT BUFFER LOCATION TAD (ECETX) / GET END OF TEXT CODE DCA I X0 / INSTALL IN NEXT BUFFER LOCATION TAD X0 / SET CURPTR TO POINT AT ETX CHAR. THAT / WAS JUST INSTALLED DCA CURPTR / ... / / CLEAR THE REST OF THE BUFFER / TAD (4-BUFEND) / Compute negative counter of # of words to clear. JMS ZAP / Zero out the rest of the buffer. TAD (ECBFND) / INSTALL BUFFER_END CHARACTER DCA I X0 /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** / INITIALIZE EDIT PTRBLK (POINTER_BLOCK) TABLE / CDFEDT TAD (PTRBLK-1) / ++++ DCA X0 TAD (-NPTRS+1) / ++++ JMS ZAP / Zero area out. TAD CURPTR / Set last loc in PTRBLK = CURPTR. DCA I X0 / TAD CURPTR / Initialize LINE 23 pointer. DCA LINE23 / ... DCA CURSOR / Init cursor posn. DCA LOWLIM / and screen bais. TAD (-12) /TO TEST FOR POSTPROCESSOR /A214 CDFMNU / Get file # from menu field. TAD I (MUBUF+MNTMP6) /SET TO 12 FOR FOOTNOTING /A214 SNA CLA /SKIP TO CONTINUE WITH SPELL /A214 JMP PPOPEN /OPEN FOOTNOTING FILES RETURN AT PPORET /A214 TAD I (MUBUF+MNUTFN) / Pick up UTILITY file number to open /M230 CDFEDT / Back to our field. MQL / WPFILS wants file # in MQ. CIFFIO;FILEIO;XDSKIN / Open input file. /d229 SPA;NOP;CLA / ... SZA CLA / Skip if file was opened /A229 AC7777 / ERROR - file could not be opened /A229 PPORET, IAC / AC=1 if open ok, =0 if failed /A229 DCA OPNFIL / Save file open flag /A229 TAD OPNFIL / See if file(s) opened ok /A229 SNA CLA / Skip if open sucessful /A229 JMP INITXT / else just return /A229 CDFSYS / Save start time. /M229 TAD I (CLOCK+3) / (minutes), MQL / save in MQ. TAD I (CLOCK+4) / (hours), CDFEDT / Save these for the editor. DCA OLDHR / ... MQA / get minutes back. DCA OLDMIN / .... AC0001 / Set ECHO flag so that we keep screen uptodate. DCA ECHFLG / ... JMS CLRULR / Finally, initialize the ruler area. JMS COPRUL / and copy default ruler in. JMS LODCHR / Get 1st character of file. JMP INITRL / Insert initial ruler if file is empty. TAD (-ECSTRL) / Is the 1st character "start of ruler"? SNA CLA / Skip if no. Insert default ruler. JMP INITDN / 1st char is "start of ruler" so exit. INITRL, CDFEDT / ... JMS RLGETS / Get default ruler (ruler 0). JMS INSRUL / Insert it. TAD (ECRMFL) / Insert "ruler modified" flag. JMS INSRL1 / ... TAD LINE23 / Reset CURPTR to start of newly inserted ruler. DCA CURPTR / ... INITDN, JMS CLSSET / Init ptrs to that 1st time FXSCRL is called, / CLRSCN gets called. INITXT, XX / Back to Speller. /d229 ISZ OPNFIL / Say that file is now open. JMP I INITSP / Return to caller. PPOPEN, CDFMYF /DONT FORGET WHERE YOU ARE /A214 CIFMTH /FLD 6 IS FOR FOOTING BESIDES MATH/SPEL /A214 JMS I (BUFEND) /AIMING FOR 6000 /A214 JMP PPORET /RETURN IN LINE AFTER OPENS /A214 /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** ZAP, XX / routine to zero out a portion of memory. DCA T1 / Save negative count. ZAP1, DCA I X0 / Zero out next location. ISZ T1 / ++++ JMP .-2 JMP I ZAP / Return when done. OPNFIL, 0 / 0 UNTIL FILE HAS BEEN OPENED X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** GETCH, XX / entry point. CDFBUF / Map data field to buffer field. CURMOV / ... SKP / Handle EOF condition below. JMS LODCHR / Get character to check. SKP / non-skip return if E-O-F. ISZ GETCH / skip return if not E-O-F. CDISPL / Return CIF CDF to spell checker field. JMP I GETCH / return to caller. CLOSEF, XX / This routine closes the correct file. RDF / Get caller's field. TAD CIDF0 / Make return CDI instruction. DCA CLOSEX / Save for the return trip. CDFEDT / Map our field. JMS SAVLMD / Save line modified flag. / SKP CLA / Scan 'til end of text buffer. CLOSE1, AC0001 / ... CHKPTR / .... SMA CLA / Skip if at end of buffer. JMP CLOSE1 / Jmp if not. CLOSE2, AC7777 / Copy from end of the buffer CHKPTR / (1st see if another character) SPA CLA / (skip if yes). JMP CLOSE3 / (Jmp if no. time to exit). TAD I CURPTR / Get last character in buffer. JMS DSKCAL;XPUTET / and put it out to the file. JMP CLOSE2 / Loop until buffer emptied to the file. /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** CLOSE3, CDFSYS TAD I (CLOCK+3) / ++++ DCA CLSMIN / CURRENT MINUTES TAD I (CLOCK+4) / CURRENT HOUR CDFEDT JMS CVTMIN / ++++ DCA CLSMN2 TAD OLDMIN / ++++ DCA CLSMIN / INITIAL MINUTES TAD OLDHR / INITIAL HOURS JMS CVTMIN CIA TAD CLSMN2 / CURRENT TIME - INITIAL TIME SPA / ++++ TAD (30^74) / IF NEGATIVE, THE CLOCK ROLLED OVER.. / ADD 60 * 24 = MINUTES IN A DAY DCA CLSMN2 TAD (15) / ++++ CIFFIO / ++++ FILEIO / ++++ XHDRGT / GET OLD TOTAL TIME CLL / DONE TO CHECK FOR OVERFLOW IN NEXT ADD TAD CLSMN2 / NEW TOTAL TIME SZL / SKIP IF TIME < 68:15 AC7777 / TIME WAS RESET, SET TO MAX MQL / ++++ TAD (15) CIFFIO / ++++ FILEIO / ++++ XHDRPT / STORE NEW TOTAL TIME TAD CLSMN2 MQL / ++++ TAD (14) CIFFIO / ++++ FILEIO / ++++ XHDRPT / SAVE TIME THIS EDIT TAD WIDNAR / FORCED WIDE? /A223 SNA CLA / /A223 JMP CLOSE4 / JMP IF YES, LEAVE CURRENT SIZES /A223 TAD (30) / Set screen size back to max. DCA SCRNLN / ... JMS CLR132 / Back to 80 col mode. CLOSE4, AC0003 / Clear screen & region. /M223 CIFMNU / ... JMS I (CALLN1) / .... JMS PROMPT / display "filing being completed. MSGF / ... JMS DSKCAL / and close the file. XDSKCL / ... CLOSEX, XX / Map field to return to. JMP I CLOSEF / Return to caller. /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** CVTMIN, XX / SUBROUTINE TO CONVERT HOURS AND MINUTES TO MINUTES SNA / ++++ JMP CVTMN2 / IF ZERO AC (NO HOURS), JUMP CIA / ++++ DCA CLSHR / CVTMN1 CONTROL CVTMN1, TAD (74) ISZ CLSHR / ++++ JMP CVTMN1 CVTMN2, TAD CLSMIN / ADD MINUTES-FROM-HOURS TO MINUTES JMP I CVTMIN / CLSMN2, 0 / TEMP., ALWAYS CONTAINS MINUTES CLSMIN, 0 / MINUTES FOR CVTMIN CLSHR, 0 / NEG OF HOURS IN CVTMIN /*************************************************************************** /**** C A U T I O N **** /**** THIS OVERLAY PAGE IS USED BY DECSPELL AND MUST RESIDE HERE **** /*************************************************************************** /D222 / PPCALL POST PROCESSOR CALL_A_ROUTINE /A214 X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE *7400 / OVERLAY AREA 1 LOCATION OVRNUM= 0 / INITIALIZE OVERLAY ONE COUNTER OVLAY1, OVRNUM / STORE OVERLAY NUMBER AS FIRST LOCATION X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE / THIS FIELD IS USED FOR EDITOR MATH AND GO-TO-PAGE FIELD 2 CDFMYF=CDFLP *200 RELOC 6400 / THIS CODE WILL LOAD INTO THE TOP OF FIELD 5... / THIS IS AN EXTENSION OF THE EDITOR RESIDENT... IT CONTAINS THE SUPERKEY / VECTOR TABLE, AND THE COPY ROUTINE... / IT WAS DEVISED IN ORDER TO PREVIDE MORE SPACE IN THE RESIDENT PORTION OF THE / EDITOR FIELD SO THAT THE MATH INTERFACE, AND GOTO PAGE CODE CAN BE RESIDENT DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED / IF doing a GOTO PAGE request ignore the GOLD-HALT / ELSE process the GOLD-HALT / TEST FIELD 0 HALT FLAG (SET BY TYPING GOLD+HALT) / TAKE 1ST RETURN IF SET, 2ND RETURN IF NOT SET XHLTST, XX CDFEDT / CHANGE TO EDIT FIELD DCA T1 / SAVE AC TAD I (USHLTS) / RETRIEVE CALLER'S ADDRESS DCA XHLTST / MAKE IT RETURN ADDR TAD RPACTIVE / GET GOTO PAGE FLAG SZA CLA / SKIP IF GOTO PAGE NOT ACTIVE JMP RPIGNORE / JUMP TO IGNORE GOLD-HALT CDFMNU / CHANGE TO MENU FIELD TAD I (LINDIF) / PICK UP STATUS CHANGE FLAG SNA CLA / DID THE STATUS CHANGE ? JMP XHLTS1 / NO, SKIP AROUND THE STATUS UPDATE CDFMYF / YES, CHANGE BACK TO THIS FIELD CIFMNU / CHANGE TO MENU FIELD FOR CHECK JMS I (CALLN2) / GO CHECK FOR STATUS VALUE CHANGE XHLTS1, CDFSYS / CHANGE TO SYSTEM FIELD TAD I HLTFLG / PICK UP THE VALUE FOR THE HALT FLAG SNA CLA / IS THE HALT FLAG SET ? RPIGNORE, / GOTO PAGE EXIT POINT ISZ XHLTST / YES, SET UP TO TAKE SKIP RETURN TAD T1 CDIEDT / CHANGE BACK TO EDIT FIELD JMP I XHLTST RPACTIVE, .-. / IF NEG., GOTO PAGE ACTIVE / POS. MEANS NO GOTO PAGE / THIS IS THE ONLY ENTRY 'A105' YOU'LL SEE / BECAUSE IT IS TO SIGNIFY THE CORRECTION OF THIS SUBROUTINE / USED BY GOTO PAGE FOR COMPUTING THE 'CURRENT' PAGE / (SINCE THIS ROUTINE DIDN'T WORK BEFORE IT NOW IS CONSIDERED / NEW CODE) /************************************************** / / START GOTO PAGE FIND CURRENT EDIT PAGE OF ALL DOC. PAGES... / /************************************************* CDFILS= CDF 70 / 'WPFILS' IS IN FIELD 7 / ENTER HERE FROM A JMS WITHIN 'OVMENU' / CALCULATE THE CURRENT PAGE THE USER IS EDITING / AND THE TOTAL NUMBER OF PAGES WITHIN THE DOCUMENT / TO SATISFY THE 'XXX' AND 'YYY' VALUES WITHIN / THE FOLLOWING EDITOR MENU DISPLAY / / 'YOU ARE CURRENTLY EDITING PAGE XXX OF YYY PAGES' / X3 - IS USED AS A TEMPORARY REGISTER (NON AUTO-INDEX MODE) / / X4 - IS USED AS A TEMPORARY HOLDING REGISTER (FOR 'ISZ'S). / RPPMENU,XX / BEGIN COUNTING CURRENT/TOTAL PAGES DCA RPPAC / SAVE THE accumulator AT ENTRY / THE FIRST FEW WORDS OF THE EDIT BUFFER ARE ALWAYS / WORD 1 - 7777 / WORD 2 - 7775 STX (IF REALLY START OF TEXT - ELSE REAL TEXT) / WORD 3 - 0016 START OF RULER (IF WORD 2 IS STX) / WORD 4 - ???? TEXT CDFEDT AC7777 / INITIALIZE FLAG DCA RPSTART / TO SIGNIFY 2ND TIME AT EXT TAD I (CURPTR) / CURRENT LOC. IN EDIT BUFFER DCA RPPCURPTR / START SEARCH BACK FROM HERE CDFLP AC7776 / -2 MEANS GET THE 'PAGE COUNT' JMS RPPCAL / (THAT MEANS THE NUMBER OF PAGES) XRPRD / WITHIN THE 'STX' BUFFER TAD (-1750) /-1000. DCA RPPLSPAGE / START WITH ZERO PAGE COUNT (NEGATIVE NOTATION) DCA RPPMSPAGE /\ JMP .+1 / CALCULATE THE 'CURRENT PAGE' / BY SUMMING THE PAGE COUNT WITHIN EACH DATA DESCRIPTOR WORD / UNTIL THE DATA DESCRIPTOR OFFSET IS EQUAL TO THE OFFSET WITHIN 'SCTOP' / THEN READ EACH CHARACTER OF THE EDIT BUFFER / FOR ANY TYPE OF PAGE MARK / UNTIL THE POSITION WITHIN THE EDIT BUFFER / IS THE SAME AS THE ADDRESS WITHIN 'CURPTR' JMS RPPXMENU DCA RPMNT2 RAL / 0, 1 TAD RPPMSPAGE DCA RPMNT1 / IF THE CONTENTS OF THE ac AT ENTRY IS negative / THEN ALSO SET THE CONTENTS OF / CURPG1 WITH THE CONTENTS OF RPMNT2, AND / CURPG2 WITH THE CONTENTS OF RPMNT1 TAD RPPAC / GET BACK AC AT ENTRY SNA CLA / SKIP NEXT IF not 'GOLD M' JMP RPPMN2 / USER REQUEST FOR 'GOLD M' CDFEDT TAD RPMNT2 DCA I (CURPG1) TAD RPMNT1 DCA I (CURPG2) JMP RPREPL / REPLACE FILE SYS POINTERS, THEN EXIT / CALCULATE THE 'TOTAL PAGE' COUNT OF THE DOCUMENT / BY SUMMING THE PAGE COUNT FROM OUR PRESENT POSITION / WITHIN THE EDIT BUFFER UNTIL 'ETX' / THEN SUMMING THE PAGE COUNT WITHIN EACH REMAINING DATA DESCRIPTOR WORD / UNTIL A [0] TERMINATOR SIGNIFYING OUT OF DESCRIPTOR BLOCKS / OR UNTIL A [-1] TERMINATOR SIGNIFYING LAST DESCRIPTOR WORD RPPMN2, JMS RPPXMENU DCA RPMNT7 RAL / 0, 1 TAD RPPMSPAGE DCA RPMNT6 RPREPL, TAD (-4) / AC => - 4 TO REPLACE FILE SYSTEM POINTERS JMS RPPCAL / TO WHERE THEY WERE AT START OF TOTAL PAGE CALCULATION XRPRD / TO ENABLE RESUMMING THE EDIT CYCLE CDIEDT JMP I RPPMENU / EXIT RPPAC, ZBLOCK 1 / HOLDS THE AC AT ENTRY INTO 'RPPMENU' RPMNT2, ZBLOCK 1 / LOW RPMNT1, ZBLOCK 1 / HIGH RPMNT7, ZBLOCK 1 / LOW RPMNT6, ZBLOCK 1 / HIGH RPPSCTOP, / DATA DESCRIPTOR BLOCK SAME AS WITHIN 'SCTOP' RPPNOGDS, / EXAUSTED ALL DATA DESCRIPTOR BLOCKS RPPXCHARACTER, AC7777 / BACK-UP EDIT BUFFER PTR TAD RPPCURPTR / CURRENT LOC. PTR. SNA / SKIP IF NOT TOP OF BUFFER TAD (5777) / RESUME AT BOTTOM IF AT TOP DCA RPPCURPTR / UPDATE CURRENT LOC. PTR. CDFBUF / EDIT BUFFER FIELD TAD I RPPCURPTR / GET CHAR. FROM EDIT BUFFER CDFLP / BACK TO THIS FIELD TAD (-ECSTX) / TOP OR BOTTOM ID? SNA / SKIP IF NEITHER JMP RPPETX / SEE WHERE WE ARE TAD (ECSTX-ECNWPG) / IS IT NEW PAGE MARK? SZA / SKIP IF PAGE IN BUFFER TAD (ECNWPG-ECPMRK) SZA CLA / SKIP NEXT IF PAGE MARK JMP RPPXCHARACTER / NEITHER TYPE OF PAGE MARK / ANY TYPE OF PAGE MARK WAS FOUND / UPDATE 'RPPLSPAGE' AND 'RPPMSPAGE' AC0001 JMS RPPINCPAGECOUNT / GO ACCOUNT FOR PAGE IN BUFFER JMP RPPXCHARACTER / DO UNTIL STX MARKER FOUND RPSTART, ZBLOCK 1 / INDICATE # OF TIMES AROUND EDIT BUFFER RPPCURPTR, ZBLOCK 1 / OUR CURPTR / EACH CHARACTER FROM THE TOP OF THE EDIT BUFFER / STARTING AT THE ADDRESS WITHIN 'BUFBEG' / UNTIL THE ADDRESS WITHIN 'CURPTR' / HAS BEEN EXAMINED FOR EITHER TYPE OF PAGE MARK / PROGRAM LOCATIONS 'RPPMSPAGE' AND 'RPPLSPAGE' HAVE BEEN UPDATED ACCORDINGLY / BUT IF THE SUM OF THE CONTENTS OF THOSE TWO LOCATIONS IS ZERO / THEN SET 'RPPLSPAGE' EQUIVALENT TO 1 SIGNIFYING PAGE #1 RPPATCURPTR, / AT THE CURRENT POINTER OF THE EDIT BUFFER DCA RPPCURPTR RPPETX, / MAYBE AT TOP OR BOTTOM OF ED. BUF. CDFEDT / EDITOR FIELD TAD I (CURPTR) / ORIG. CURPTR AT START OF SEARCH CDFLP / BACK TO THIS FIELD CIA / FOR COMPARE TO OUR OWN TAD RPPCURPTR / EDIT BUFFER POINTER SNA CLA / SKIP IF BACKED-UP TO STX JMP ETXTST / SEE IF BACKUP TO ETX ATEND, / DONE SEARCHING THRU EDIT BUFFER AC0001 / 'CLL' / TAD (1750) TAD RPPLSPAGE SZA CLL JMP JMPIRPPXMENU / AT EXIT (AC) COULD = 0 AND (L) COULD = 1 / ELSE (AC) IS NOT ZERO AND (L) IS = 0 ETXTST, / ETX RECOGNIZED WITHIN BUFFER TAD RPSTART / IF FLAG IS MINUS SMA CLA / THEN WE STARTED AT ETX MARK JMP ATEND / ELSE, WE WENT THRU ENTIRE BUFFER-DONE DCA RPSTART / ETX WILL BE READ AGAIN, SO GET READY JMP RPPXCHARACTER / 1ST CHAR READ WAS ETX, SO CONTINUE MSG132, TEXT"^A" / MESSAGE USED FOR 132/80 COLOMN MODE SWITCH X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED RPPXMENU, XX RPPXDESCRIPTOR, AC7777 / ... [-1] MEANS... JMS RPPCAL / ... GET A 'RPPGDS' ... XRPRD / ... (DESCRIPTOR) WORD ... DCA RPGDSHOLD / ... AND TEMPORARILY SAVE IT ... / NOTE THAT FOR COS-310 COMPATABILITY / THE CONTENTS OF 'SCTOP' ARE ALWAYS [2] LESS / (WPFILS AUTOMATICALLY ADJUSTS FOR THIS) TAD (CURID-1) / GET ADDRESS OF CURRENT BLK ID MQL / TO SEND IN THE MQ AC7775 / -3 MEANS GET THE CONTENTS JMS RPPCAL / OF PROGRAM LOCATION 'SCTOP' XRPRD / & THE MQ = HEADER EXTENSION NUMBER / / AT THE 'START' OF THE REPOSITIONING REQUEST. PLUS PUT THE / 'CURRENT' VALUE OF SCTOP AND THE HDR EXTN # INTO CURID AND CURTOP... / SWP / INTERCHANGE MQ WITH AC CIA / NEGATE THE HEADER EXTENSION NUMBER TAD CURID / COMPARE IT WITH OUR CURRENT HDR ID SZA CLA / SKIP IF SCTOP IN THIS BLK JMP RPPVALUE / INCLUDE THIS DESC. THEN MQA / GET THE OFFSET INTO THE HEADER INTO THE AC / the contents of the AC contains the contents of program location 'SCTOP' / at start of relative paging request... / CIA TAD CURTOP / CURRENT SCTOP SPA SNA CLA / SKIP IF AT SCTOP JMP RPPVALUE / INCLUDE THIS DESC. THEN JMP RPPSCTOP / JMP TO COUNT THE NUMBER OF PAGES / WITHIN THE EDIT BUFFER STARTING / AT 'BUFBEG' UNTIL THE ADDRESS / WITHIN 'CURPTR' / NOTE: CURID & CURTOP MUST REMAIN TOGETHER & IN THAT ORDER CURID, .-. / CURrent blk ID # CURTOP, .-. / CURrent scTOP pointer RPGDSHOLD,ZBLOCK 1 JMPIRPPXMENU, JMP I RPPXMENU / 'RPPCAL' WAS COPIED AFTER 'DSKCAL' / (BECAUSE A 'JMS DSKCAL' FROM 'FIELD 5') / (WOULD BE AN INSTANT TRIP TO THE FUNNY FARM) RPPCAL, XX CDFLP / THIS DATA FIELD DCA T1 / SAVE AC TAD I RPPCAL / GET VECTOR ISZ RPPCAL DCA .+4 / SAVE VECTOR TAD T1 / GET BACK AC CIFFIO FILEIO .-. / the VECTOR CDFLP JMP I RPPCAL / EXIT RPPVALUE, TAD RPGDSHOLD / GET BACK THE 'DESCRIPTOR' WORD CMA SNA JMP RPPNOGDS / [-1] DESCRIPTOR WORD TERMINATOR FOUND CMA AND (37) / BITS 7-11 IS THE PAGE COUNT JMS RPPINCPAGECOUNT JMP RPPXDESCRIPTOR / SUBROUTINE TO INCREMENT VALUES WITHIN 'RPPLSPAGE' AND 'RPPMSPAGE' / ENTER WITH THE CONTENTS OF THE AC / EQUIVALENT TO THE 'NUMBER OF PAGES' / TO INCREMENT RPPINCPAGECOUNT, XX CLL TAD RPPLSPAGE / CURRENT PAGE + # OF PAGES IN THIS BLOCK SZL ISZ RPPMSPAGE SZL TAD (-1750) DCA RPPLSPAGE / UPDATE CURRENT PAGE NUMBER JMP I RPPINCPAGECOUNT RPPLSPAGE, -1750 /1-1000 / CURRENT PAGE NUMBER (NEGATIVE NOTATION) RPPMSPAGE, 0 / 1000-9000 (POSITIVE NOTATION) /*************************************************** / / END GOTO PAGE FIND CURRENT EDIT PAGE OF ALL DOC. PAGES... / /*************************************************** / / / SUBR RPXHLT PSUEDO-CODE: / / take out GOLD_HALT support for both GTP and GOLD_HALT... /A195 / / Determine if the user has requested a halt via the GOLD:HALT / key during a GOTO PAGE request; / If so, then / RPBOTF := -1; ( turn this into a GOLD:Bottom ) / jump to RPRULE; ( never returns to caller ) / else / ( user did not press GOLD:HALT ) / accumulate # of pages in document so far (in CURPG1); / compare current page # with desired page # ... / exit ... / ( the structure of RPXHLT is fuzzy because it's not / a piece of modular code that performs a distinct / function--it was made into a subroutine merely / as a device to move code to CDFLP. ) / / / CALL: / / CLA / AC MUST = 0 / / DF DOESN'T MATTER / CIFLP / JMS RPXHLT / JMP NXTDES / NOT AT DESIRED PAGE. / / (GO READ NEXT GOTO-PAGE DESCRIPTOR / / WORD AND TRY AGAIN) / / CURPG1= CURRENT PAGE # ACCUMULATED BY / / SCANNING GOTO-PAGE DESCRIPTOR WORDS / ... / AT OR PAST DESIRED PAGE (ACCORDING TO / / COMPARISON OF UNITS, TENS, AND / / HUNDREDS -- STILL NEED TO COMPARE / / THOUSANDS IN CURPG2) / / CURPG1= -# OF PAGE MARKS TO READ, / / STARTING AT CURRENT BLOCK, / / TO REACH DESIRED PAGE. / / AC= DESIRED PAGE # (THOUSANDS) / / = RPBIN2. / ... /RPXRULE,... / 'RPXHLT' JUMPS HERE (TO TAG RPXRULE) / / IF USER PRESSED GOLD:HALT. / / RPXHLT, 0 / MAY BE OVERLAID BELOW IF HALT REQUESTED /D195 CDFSYS / TO SYS FIELD TO /D195 TAD I HLTFLG / GET HALT FLAG /D195 SNA CLA / SKIP IF HALT SELECTED /D195 JMP WOHLTX / JUMP IF HALT NOT SELECTED /D195 CDFLP / BACK TO THIS FIELD /D195 TAD (RPXRULE) / ADDR. TO CONCLUDE GOTO PAGE AT /D195 DCA RPXHLT / NEW RETURN ADDR. /D195 CDFEDT / EDITOR'S DF /D195 AC7777 / AC = > -1 /D195 DCA I (RPBOTF) / SET V2 GOLD BOTTOM REQUEST /D195 JMP WIHLTX / LEAVE AC => 0 ON RETURN / if desired LO page-indication found within this GTP descriptor word / then load contents of 'THOUSANDS' word and resume at / RETURN+1 for furthur HO desired-page testing / else desired page not found so RETURN+0 to resume / by reading the next GTP descriptor word. /A195 WOHLTX, CDFEDT / EDITOR'S DF TAD I (SRCDIR) / PASS ALONG THE CURRENT DESCRIPTOR WORD AND (37) / BITS 7-11 FOR # OF PAGES IN THIS BLOCK TAD I (CURPG1) / CURRENT PAGE # + # OF PAGES IN THIS BLK DCA I (CURPG1) / UPDATE CURRENT PAGE NUMBER TAD I (RPBIN1) / GET DESIRED PAGE # CIA / FOR COMPARE TO TAD I (CURPG1) / ACCUMULATED # OF PAGES FOUND SPA / SKIP IF PAGE IN THIS BLK JMP WIHLTX / RETURN+0 TO RPDESC FOR NEXT DESC. CIA / NEG. REMAINDER OF PAGE-MARKS DCA I (CURPG1) / MAKE A COPY TAD I (SRCDIR) / CURRENT DESC. WORD CONTENTS AND (37) / # OF PAGES ONLY TAD I (CURPG1) / MINUS THOSE BEYOND OUR PAGE CIA / = # OF PAGE-MARKS TO READ TO PAGE DCA I (CURPG1) / SUPPLY FOR NEXT OVERLAY TAD I (RPBIN2) / LOOK AT THE THOUSANDS # ISZ RPXHLT / RETURN+1 TO CONTINUE W/THOUS. WIHLTX, CDIEDT / EDITOR'S DF AND IF JMP I RPXHLT / RETURN: TRYPGE IF NOT HALTED / RPRULE IF HALTED / just reported the page-not-found error. / get set to paint the screen with the last available page / as recorded by the descriptors. RPERRE, CDFEDT / EDITOR DF TAD I (CURPG1) / TOTAL # OF PAGES COUNTED BEFORE -1 DCA I (RPBIN1) / BECOMES THE NEW DESIRED PAGE DCA I (RPBIN2) AC7777 / F.C. TO READ DESC. JMS RPPCAL XRPRD / GTP ENTRY POINT CDFEDT / BACK TO EDITOR DF DCA I (SRCDIR) / SUPPLY NEW DESCRIPTOR WORD TAD I (SRCDIR) / GET A COPY OF IT DCA T1 / TO WORK WITH TAD T1 CMA / -1 FLAGS A V1 DOC. BEING USED FOR THE 1ST TIME SZA CLA / SKIP IF V1 DOC. JMP RPERPG / JUMP IF A PAGE AVAILABLE, MAYBE DCA I (CURPG1) / INDICATE TOP OF DOCUMENT CDIEDT / DF AND IF TO EDITOR TO RESUME EDIT CYCLE JMP RPRULE / GO POSITION TO TOP OF DOC. RPERPG, TAD T1 / GET THE DESCRIPTOR WORD BACK AND (37) / GET ITS' PAGE COUNT IN THIS BLOCK CIA TAD I (CURPG1) / ALREADY COUNTED THEM EARLIER BEFORE -1 FOUND DCA I (CURPG1) / PRETEND NEVER SAW THEM CDIEDT / DF AND IF TO EDITOR TO RESUME EDIT CYCLE JMP TRYPGE / FIND PAGE WITHIN THIS BLOCK /****************************************************** / END OF GOTO PAGE IN FIELD 5 /****************************************************** / PUTLP Routine moved here this edit for space elsewhere /a247 / ROUTINE TO OUTPUT A MESSAGE TO THE SCREEN, ADDRESS OF MESSAGE IS / IN AC ON ENTRY PUTLP, XX DCA PTLP1 / SET UP ADDRESS CIFMNU JMS I IOACAL / CALL I/O ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE PTLP1, XX / ADDRESS OF TEXT STRING TO OUTPUT CDIEDT / SET BACK TO EDITOR FIELD JMP I PUTLP / RETURN / EXERR1 Moved here this edit to gather space together /a247 / EXTRACTNUMBER ERROR HANDLER EXERR1, TAD (EREXTR) / GET ERROR NUMBER JMS RESCURPTR / FIRST RESTORE CURPTR THEN.... JMS EDERR-1 / GO TO ERROR REPORTER. WON'T RETURN SAVTP, .-. / SAVED_TAB_POSITION - HOLDS TAB_POSITION / OF CURRENT DECIMAL TAB FIELD. USED / BY BOTH EDERR AND GETDTF ROUTINES. / MUST FOLLOW JMS TO EDERR-1 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED / EDITOR MATH CODE GOES HERE / THIS IS EDITOR MATH CODE USED TO EVALUATE THE MATH CONTROL BLOCKS WHILE IN / THE EDITOR. THIS CODE IS ACTIVATED BY THE DISCOVERY OF A CONTROL BLOCK CHAR / IN THE TEXT THAT IS BEING EDITED. / THE FOLLOWING ROUTINE SERVES AS THE ENTRY POINT TO THE EDITOR MATH / CONTROL BLOCK PROCESSING CODE FROM THE EDITOR "SCRLUP" ROUTINE. / EACH TIME A LINE IS SCROLLED UP A CALL IS MADE HERE TO CHECK THE LINE / WHETHER IT IS IN A CONTROL BLOCK AND IF THE CONTROL BLOCK IS MATH. / PROCESSING IS DONE ACCORDINGLY. / **** WARNING ****!! "INCTLB" IS EQUATED TO 7000 WHILE / CKCTRL" IS EQUATED TO 7001 IN M.PA, THEREFORE DO / NOT MOVE "INCTLB" OR "CKCTRL" FROM THEIR PRESENT POSITIONS / UNLESS CHANGING M.PA ALSO INCTLB, 0 /"IN CONTROL BLOCK" FLAG, SET TO 1 IF NOT IN A CONTROL /BLOCK, AND 0 IF IN CTRL BLOCK. THIS FLAG HAS TO STAY /IN THIS POSITION BECAUSE IT IS DEFINED AS SUCH IN /WPF1.PA. THIS IS TO ALLOW IT TO BE INITIALIZED FROM /THE MATH FIELD AT THE SAME TIME THE EDITOR CODE IS /INITIALIZED. REF. "WPEDOV.PA" / ***** CAUTION ***** / CKCTRL ROUTINE IS FILLED WITH CDF AND CIF INSTRUCTIONS. IF YOU / ADD, MODIFY, MOVE, OR DELETE CODE CHECK FIELDS ARE PROPERLY SET! CKCTRL, XX CLA / CLEAR AC /D198; IFDEF UNBUND < /RUN CHECK TO SEE IF UNBUNDLING IS DEFINED AND IF IT IS THEN /SEE IF MATH IS ACTIVATED / *** CAUTION *** / THE HAVMTH ROUTINE RESIDES IN AN AREA OF FIELD 5 THAT IS / SHARED BY LIST PROCESSING AND THE EDITOR. HAVMTH IS NOT / RESIDENT WHEN RUNNING LIST PROCESSING! THUS THE FOLLOWING / TEST MUST FOLLOW THE TEST ABOVE SO THAT IF WE ARE RUNNING / LIST PROCESSING WE WILL NOT CALL HAVMTH AND CRASH! JMS HAVMTH / IF THE MATH FEATURE IS NOT ACTIVATED JMP BKEDIT / THEN JUST RETURN TO THE EDITOR /D198; > / END IFDEF UNBUND / YES: SEE WHAT TYPE OF MATH IS WANTED (I.E. LP OR EDITOR MATH / THIS IS NECESSARY BECAUSE LP ALSO MAKES USE OF THE EDITOR / (SEE NOTES FOR HAVMTH CHECK BELOW BEFORE TOUCHING THIS ROUTINE!!) CDFMTH / SET TO MATH DATA FIELD TAD I (MTHTYP) / GET "MATH TYPE" FLAG SNA CLA / IS IT EDITOR MATH THAT IS WANTED? JMP BKEDIT / NO: THEN JUST RETURN TO LP USE OF THE EDITOR / CHECK FOR ENTERING OR LEAVING A MATH AREA / CHECK TO SEE IF IN BACKUP MODE CDFEDT / GET EDITOR DATA FIELD AC7777 / IF EDMODE = 1 (IN BACKUP MODE) TAD I (EDMODE) SNA CLA JMP BKEDIT / THEN RETURN TO EDITOR / CHECK TO SEE IF "MA" SWITCH IS SET TO "YES" CDFMNU / CHANGE TO MENU DATA FIELD TAD I (MUBUF+MNMATH) / GET "MA" FLAG CDFMYF / RETURN TO THIS DATA FIELD SNA CLA / IS "MA" SET TO "YES"? JMP BKEDIT / NO: RETURN TO EDITOR / YES: CHECK WITH EDITOR TO SEE IF IN SELECT MODE JMS CKSCLT / IF IN SELECT MODE THEN SHUT MATH OFF AND / RETURN TO THE EDITOR DIRECTLY FROM "CKSCLT" CDFMYF AC7777 / OFFSET FOR SETTING OF CURPTR JMS STCURPTR / SET CURPTR FOR READING OF LINE / CHECK TO SEE IF THIS IS A RULER LINE. IF SO DON'T DO MATH. CKCTRT, JMS CKCTR1 / GO SEE IF THE LINE IS A RULER -1 / VALUE TO AND WITH CHARACTER READ -ECSTRL / NEG. VALUE OF CHARACTER TO MATCH / IF MATCH GOTO BKEDI3 FROM CKCTR1 ROUTINE. / IF NO MATCH WE RETURN HERE. / GO RUN CHECK ON PRESENT POSITION RELATIVE TO ANY CONTROL BLOCK JMP CKCTR6 / CHECK CONTROL BLOCK STATUS / IF NOT IN A BLOCK THEN RUN A CHECK TO SEE IF JUST STARTING ONE CKCTR2, JMS CKCTRS / ARE WE JUST STARTING A CONTROL BLOCK? JMP CKCTR3 / NO: RESET FLAG & CHECK EXTRACTION ROUTINE JMS STLOC1 / YES: IS "START CTRL" CHAR ON PREVIOUS LINE? JMP CKCTR4 / YES: GO PROCESS 1ST LINE OF BLOCK CKCTR3, AC0001 / NO: GET ONE IN THE AC DCA INCTLB / SET "IN CTRL BLOCK" FLAG = FALSE JMS MASTTS / IS "MA" SET TO YES, AND ARE WE IN MATH AREA? JMP BKEDI3 / NO: RESET CURPTR & RETURN TO EDITOR JMS CKCTR1 / SEE IF NEW PAGE, PAGE MARKER, START OR END / PRINT CONTROL. 0177 / VALUE TO AND WITH CHAR. READ -ECNWPG / NEG. VALUE OF CHARACTER TO MATCH / IF MATCH GOTO BKEDI3 FROM CKCTR1 ROUTINE. / IF NO MATCH WE RETURN HERE. JMP EXTRACTNUMBER / DO EDITOR MATH ON THIS LINE / THIS IS FIRST TIME CTRL BLOCK IS ACCESSED, SINCE JUST STARTING / BLOCK THEN INITIALIZE VALUES BEFORE START PROCESSING OF BLOCK CKCTR4, DCA MTHCTL / SET "IN MATH CTRL BLOCK" FLAG = FALSE DCA INCTLB / SET "IN CONTROL BLOCK" FLAG = TRUE DCA VALID / SET "VALID LINE FOUND" FLAG = TRUE CDFMTH / CHANGE DATA FIELD REGISTER TO MATH FIELD AC0001 / GET 1 IN THE AC DCA I (MTHSND) / SET EDIT MATH SECOND LINE FLAG = FALSE DCA I (FSTLNE) / SET "CONTROL BLOCK FIRST LINE" FLAG = TRUE CDFLP / RESET TO THIS DATA FIELD SETRTN, CIFMTH / CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN1 / INITIALIZE INPUT LINE BUFFER PTR TO START OF BUFFER / SET UP TO PROCESS LATEST SCROLLED UP LINE SCRLLN, AC0001 / NO: CONTINUE PROCESS PRESENT LINE DCA LINEND / SET "LINE END" = FALSE (END SCROLLED LINE NOT FOUND) DCA BGNLNE / SET "START OF NEW SCROLLED LINE" FLAG = TRUE / PUT CHAR FROM SCROLLED UP LINE INTO THE LINEBUFFER PRSCHR, TAD LINEND / GET THE "LINE END" FLAG SNA CLA / IS IT THE END OF THE SCROLLED UP LINE BEING READ IN? JMP CHLINE / YES: GO SEE IF LINE ENDS WITH A HARD RETURN JMS READNEXTCHARACTER JMP BKEDIT / ETX RETURN. TAD CRLMB / CHARACTER = LINE_END? TAD (-ECNWLN) / ADD NEGATIVE OF "NEW LINE" CHAR SZA / IS IT A "NEW LINE" CHAR? TAD (ECNWLN-ECNWPG) / NO: GET "NEW PAGE/PAGE MARKER" CHAR VAL SNA CLA / IS THE CHAR A "NEW PAGE" OR "PAGE MARKER"? DCA LINEND / YES: SET LINE_END = TRUE JMS CHKCH1 / NO: PROCESS CHAR JUST READ IN FROM SCROLLED UP LINE TAD CRWMB / GET CHARACTER READ DCA CHROVR / SAVE IT IN LOCATION AFTER THE CALL TO MATH FLD CIFMTH / SET PROGRAM CONTROL TO MATH FLD JMS RTRN2 / GO PUT INPUT CHAR INTO INPUT LINE BUFFER CHROVR, 0 / CONTAINS INPUT CHAR TO PASS TO "RTRN2" IN MATH FLD JMP EDERR1 / SKIP RTN HERE IF MATH FIELD INPUT LINE / BUFFER OVERFLOW WITHIN THE CONTEXT OF A MATH CONTROL / BLOCK, OR LINES IN THE BLOCK AFTER AN "END" CTRL WORD / THE AC CONTAINS THE PASSED ERROR NUMBER NTMATH, JMP BKEDTX / DOUBLE SKIP RTN HERE FROM "RTRN2" IF INPUT LINE / BUFFER OVERFLOW AND NOT A MATH CONTROL BLOCK. / PROCEED TO IGNORE THE CTRL BLOCK CAUSE NOT MATH JMP PRSCHR / TRIPLE SKIP RETURN HERE FROM "RTRN2" IF INPUT CHAR / PLACED INTO INPUT LINE BUFFER WITHOUT AN OVERFLOW. / GET THE NEXT CHAR TO READ IN / ROUTINE TO CHECK FOR HARD RETURN AT END OF SCROLLED UP LINE CHLINE, TAD CRWMB / GET LAST CHARACTER TAD (-ECNWLN) / ADD TO IT NEGATIVE OF HARD RETURN SZA / WAS THE LAST CHAR ON THE LINE A HARD RETURN JMP NOTVLD / NO: THEN SET "VALID LINE FOUND" = FALSE / AND GO BACK TO EDITOR FOR NEXT SCROLLED LINE DCA VALID / YES: SET "VALID LINE FOUND" = TRUE / AND PROCESS VALID LINE WITHIN CONTROL BLOCK CIFMTH / GO TO MATH FIELD JMS RTRN3 / PROCESS STRING OF CHARS PLACED IN LINEBUFFER JMP SETRT1 / NORMAL RTRN FORM "RTRN3", INIT LINEBUFFER & GO BACK JMP EDERR1 / SKIP RTRN TO PROCESS MATH CTRL BLCK ERR NXMATH, JMP BKEDTX / DOUBLE SKIP RTN TO PROCESS ERROR BUT NOT MATH BLK / IF VALID LINE NOT FOUND NOTVLD, DCA VALID / SET "VALID LINE FOUND" = FALSE JMP BKEDI3 / GO RESTORE CURPTR AND THEN RETURN TO EDITOR SETRT1, CDFMTH / CHANGE TO MATH DATA FIELD TAD I (MTHWRK) / GET "EDITOR MATH WORK AREA" FLAG CDFLP / RETURN TO LP DATA FIELD SZA CLA / ARE WE IN AN EDITOR MATH WORK AREA? JMP SETRT2 / NO: SET UP TO PROCESS NEXT LINE / YES: THEN HAVE TO STOP HERE TO ASK IF IN CTRL BLOCK. / IF "INCTLB" = FALSE THEN MEANS HAVE REACHED END OF A MATH AREA / WHERE THE "1414" END OF BLOCK CHAR HAS TO BE USED AS A LINE / TERMINATOR IN ORDER TO PROCESS PREVIOUS INPUT WHICH REMAINS / AN INVALID LINE UNTIL A VALID TERMINATOR IS FOUND. THE END OF / BLOCK CHAR IS CONVERTED TO A "HARD RETURN" TO MAKE PREVIOUS / LINE VALID. HOWEVER NOW HAVE THE PROBLEM OF HAVING TO PROCESS / THIS LINE AFTER HAVING REACHED THE END OF A MATH BLOCK. THUS / ONE DOES NOT WANT TO SET "IN MATH CTRL BLOCK" FLAG = TRUE IF / THIS IS THE CASE, BECAUSE END OF THE MATH BLOCK HAS BEEN / REACHED AND "MTHCTL" SHOULD BE FALSE. THEREFORE A CHECK IS / PUT IN HERE TO SEE IF THE ABOVE CASE HAS BEEN ENCOUNTERED. / IF SO, THEN THE "MTHCTL" IS SET UP TO BE LEFT FALSE. FOR REF. / SEE "CHKCH1" - CHECK FOR & PROCESS END OF CTRL BLOCK CHAR TAD INCTLB / GET "IN CTRL BLOCK" FLAG SNA CLA / ARE WE STILL IN THE MATH CTRL BLOCK? AC0001 / YES: GET 1 TO SET "MTHCTL" = TRUE DCA MTHCTL / NO: THEN LEAVE IT SET TO FALSE SETRT2, CIFMTH / CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN1 / INITIALIZE INPUT LINE BUFFER PTR TO START OF BUFFER / AND RETURN TO EDITOR BKEDI3, JMS RESCURPTR / RESTORE CURPTR BKEDIT, CDIEDT / CDI INSTRUCTION HERE TO RETURN TO EDITOR JMP I CKCTRL / RETURN TO CALLER IN WPEDIT "SCRLUP" ROUTINE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED / ******** WARNING - "MTHCTL" DEFINED IN M.PA AS AT LOC 7200 ******* / IF "MTHCTL" IS MOVED THEN IT MUST BE REDEFINED IN THAT PREFIX MODULE / IT IS REFERENCED BY "RUNCHK" RTN IN MATH MODULE *7200 MTHCTL, 0 / "IN MATH CTRL BLOCK" FLAG, 0=FALSE, 1=TRUE / ******** WARNING - "RTNMTH" DEFINED IN M.PA AS AT LOC 7201 ****** *7201 RTNMTH, JMP BKEDI3 / ENTRY POINT BACK HERE FROM MATH MODULE, JUMP / HERE FROM "RUNCHK" IN TMATH.PA! GO RESTORE / "CURPTR" BEFORE RETURNING TO THE EDITOR / ***** WARNING ***** "ZROTBL" IS DEFINED IN "M.PA" AS AT 7205 **** / ***** DO NOT MOVE THIS SUBRTN WITHOUT ALSO CHANGING "M.PA" **** / SUBRTN CALLED FROM "SETCTL" RTN IN THE MATH FIELD, IT IS USED TO INITIALIZE / THE "DCHAR" AND "TCHAR" TABLES WHICH HOLD THE POINTERS TO THE VALUES OF THE / ":Dnn" AND ":Tnn" SYMBOLS ENCOUNTERED WHEN PARSING AN EDITOR MATH CTRL BLOCK /++ / ZERO_TABLES / / FUNTIONAL DESCRIPTION: ZROTBL / / THIS ROUTINE IS USED TO ZERO BOTH THE DCHAR AND TCHAR TABLES OR / ONLY THE DCHAR TABLE BASED ON VALUE IN THE AC UPON ENTRY. / / CALLING SEQUENCE: DF MUST = CALLER'S FIELD / CIFLP / JMS ZROTBL / / INPUT PARAMETERS: AC = 0 ---> ZERO BOTH DCHAR AND TCHAR TABLES / AC <> 0 ---> ZERO DCHAR TABLE ONLY / / IMPLICIT INPUT: T1 / OUTPUT PARAMETERS: NONE / IMPLICIT OUTPUT: X5, X4, T1 / COMPLETION CODE: NONE / / SIDE EFFECTS: 1) *CAUTION* - MQ HOLDS FLAG THOUGHOUT ROUTINE. / /-- *7205 ZROTBL, XX MQL / SAVE ENTRY FLAG = 0 - CLR D & TCHAR TABLES / 1 - CLR DCHAR TABLE ONLY RDF / SET UP RETURN CDIF INSTRUCTION TAD CIDF0 DCA ZROTB2 / SAVE IT CDFLP / SET TO FIELD OF DCHAR & TCHAR TABLE TAD (-DCHARL) / SET TABLE LENGTH COUNT DCA T1 TAD (DCHAR-1) / SET DCHAR TABLE ADDRESS DCA X5 TAD (TCHAR-1) / SET TCHAR TABLE ADDRESS DCA X4 ZROTB1, DCA I X5 / CLEAR DCHAR TABLE LOCATION MQA / CLEAR TCHAR TABLE LOCATION? SNA CLA / SKIP IF: NOT DCA I X4 / CLEAR TCHAR TABLE LOCATION ISZ T1 / FINISHED? JMP ZROTB1 / NO - CLEAR NEXT LOCATION ZROTB2, .-. / RETURN CDIF INSTRUCTION JMP I ZROTBL / RETURN / COME HERE TO PROCESS LATEST CHAR READ IN FROM SCROLLED UP LINE CHKCH1, XX / CHECK FOR & PROCESS "END OF CTRL" BLOCK CHAR TAD CRWMB / GET CHARACTER READ WITH MODE BITS TAD (-ECPCT2) / ADD TO IT NEGATIVE OF "END CTRL" CHAR SZA CLA / IS IT THE END OF THE MATH CTRL BLOCK? JMP CKRULE / NO: SKIP DOWN TO CONTINUE TO CHECK CHAR AC0001 / YES: SET THE AC TO 1 DCA INCTLB / SET "IN CONTROL BLOCK" FLAG = FALSE DCA MTHCTL / SET "IN MATH CONTROL BLOCK" FLAG = FALSE CDFMTH / CHANGE TO MATH DATA FIELD TAD I (MTHSND) / GET "SECOND LINE" FLAG CDFMYF / RETURN TO THIS DATA FIELD SMA CLA / WAS AN "END" COMMAND JUST PROCESSED BEFORE / FINDING THIS "END CTRL BLOCK" MARKER? JMP CKVALD / NO: CONTINUE REGULAR PROCESSING CDFMTH / YES: CHANGE TO MATH DATA FIELD AC0001 / GET 1 INTO THE AC DCA I (MTHWRK) / SET TO "NOT START OF MATH WORK AREA" CDFMYF / RETURN TO THIS DATA FIELD CKVALD, TAD VALID / GET VALID LINE FLAG SNA CLA / WAS THE LAST LINE VALID? JMP BKEDI3 / YES: GO RESET "CURPTR" & RETURN TO EDITOR TAD (ECNWLN) / NO: GET "NEW LINE" CHAR DCA CRWMB / REPLACE "END OF BLOCK" CHAR WITH "NEW LINE" CHAR / DONE BECAUSE "LEXIC" RTN WILL NOT HANDLE EOB CHAR / AS A VALID LINE TERMINATOR JMP CNTPR3 / GO SET "START OF LINE" = FALSE & RTRN TO PROCESS LINE / CHECK TO SEE IF THE LINE IS A RULER /CKRULE, TAD SAVCHR / PUT CHAR JUST READ IN INTO THE AC / TAD (-ECSTRL) / ADD TO IT NEGATIVE OF START OF RULER / SNA CLA / IS IT THE START OF A RULER? / JMP BKEDIT / YES: THEN IGNORE PRESENT LINE WITH RULER / / ON IT, GO BACK TO EDITOR & WAIT FOR / / NEXT SCROLLED UP LINE / / NO: THEN CONTINUE TO CHECK FOR OTHER POSSIBILITIES CKRULE, NOP /**** TEMP TO SEE IF NEED RULER CHECK CODE / SCREEN OUT LEADING SPECIAL CHARACTERS IF START OF VALID LINE FSTCHR, TAD VALID / GET "VALID LINE" FLAG SZA CLA / WAS THE LAST LINE VALID? JMP CNTPRS / NO: CONTINUE TO PROCESS CHARACTER TAD BGNLNE / YES: SEE IF START OF SCROLLED LINE SZA CLA / IS IT THE START OF A SCROLLED UP LINE JMP CNTPRS / NO: CONTINUE TO PROCESS CHAR TAD CRLMB / YES: GET CHARACTER TAD (-41) / GET NEGATIVE OF UPPER LIMIT OF SPECIAL CHARACTERS SMA CLA / IS IT A SPECIAL CHAR? JMP CNTPRS / NO: CONTINUE TO PROCESS CHARACTER TAD LINEND / YES: GET "LINE END" FLAG SNA CLA / IS IT THE END OF THE LINE? JMP BKEDI3 / YES: GO BACK TO EDITOR & WAIT FOR NEXT LINE JMP PRSCHR / NO: DUMP CHAR & GO READ IN NEXT CHAR FROM LINE / SCREEN OUT NULLS, JUSTIFIED SPACES & BOTH TYPES OF SOFT RETURNS / FROM ANYWHERE THEY OCCUR IN THE LINE - AS THE CASE MAY PERMIT CNTPRS, TAD CRWMB / GET CHARACTER READ WITH MODE BITS SZA / SKIP IF: CHARACTER = NULL TAD (-ECWWLN) / CHARACTER = SOFT_RETURN? SZA / SKIP IF: SO TAD (ECWWLN-ECJSPC) / CHARACTER = SOFT_SPACE? SZA / SKIP IF: SO TAD (ECJSPC-ECHYLN) / CHARACTER = SOFT_RETURN_WITH_HYPHEN? SNA CLA / SKIP IF: NOT JMP PRSCHR / YES: DUMP IT & GO GET NEXT CHAR FROM LINE / NO: THEN MUST BE A REGULAR CHAR - PROCESS AS SUCH CNTPR3, AC0001 / GET 1 IN THE AC DCA BGNLNE / SET "START OF NEW LINE" FLAG = FALSE CNTPR1, JMP I CHKCH1 / RETURN TO CALLER / THE FOLLLOWING ARE VALUES USED BY THE EDITOR MATH CONTROL BLOCK EVALUATION CODE BGNLNE, 0 / "START OF NEW SCROLLED LINE" FLAG / (NOTE A SCROLLED LINE IS COMPOSED OF THE FIRST LINE / UP FROM THE BOTTOM OF THE SCREEN) LINEND, 0 / 'LINE END" FLAG (I.E. END OF SCROLLED UP LINE) HLDPTR, 0 / HOLDS PTR TO "START" CTRL BLOCK CHAR POSITION PTR VALID, 0 / "VALID LINE FOUND" FLAG, = 0 IF TRUE & NOT 0 IF FALSE / (NOTE A VALID LINE IS COMPOSED OF ANY NUMBER OF / SCROLLED UP LINES THE END OF WHICH IS TERMINATED / BY A HARD RETURN) BKEDT1, AC0001 / SET AC TO 1 DCA INCTLB / SET "IN CONTROL BLOCK" FLAG =FALSE JMP BKEDI3 / RESTORE CURPTR AND THEN RETURN TO EDITOR BKDTX1, JMS SCRINI / IF ERROR FOUND IN BLOCK WHICH IS NOT MATH THAN / REINIT AS IF HAVE BACKED UP IN MATH BLOCK. / THIS SHOULD INSURE TRAPPING OUT ANY POSSIBILITY / OF LEAVING THE MATH MODULE (I.E. THE LINE- / BUFFER, ETC.) IN A WRONG STATE, THUS PRECLUDING / THE CHANGE OF LETTING SUCH THINGS AS A / COMMAND SEQUENCE LIKE "BEG(HR)IN" PASS BY / UNDETECTED BY THE CTRL BLOCK CODE BKEDTX, CLA / CLEAR ANY ERROR NUMBERS PASSED BACK FROM MATH DCA MTHCTL / SET "IN MATH CTRL BLOCK" FLAG = FALSE JMP BKEDI3 / RESTORE CURPTR AND THEN RETURN TO EDITOR / routine backs up the descriptor block list until it finds a ruler, at / which point it JMP's to BACK3 to set up RPMTRL and RPRLHN for the / loading of the ruler. this code is executed on a Gold Bottom request / / enter with RPCUOF pointing at the block that we will start our 10 block / scroll at. must adjust RPCUOF back 1 block before checking for a ruler. BACK1, XX / SAVE CALLERS RETURN ADDRESS BACK2, AC7777 / ADJUST BACK 1 JMS AJUST / ADJUST RPCUOF CDFEDT / FIELD 5 ON RETURN TAD I (RPCUBK) / IDENTIFY WHICH HDR BLK MQL / CONTAINS OUR CURRENT POSITION AC7776 / -2 TAD I (RPCUOF) / OFFSET TO BLK-2 OF OUR CURRENT POSITION JMS RPPCAL / REQUEST SCBOT AND SCTOP BE SET UP XRPRD / ENTRY POINT FOR V2 GOTO PAGE RANDOM BLK READ CDFEDT / FIELD 4 ON RETURN AC7777 / -1 JMS RPPCAL / REQUEST TO READ CURRENT DESCRIPTOR WORD XRPRD / ENTRY POINT CDFEDT / DESCRIPTOR WORD IN AC ON RETURN - FIELD 4 ON RETURN AND (4000) / DOES THE BLK CONTAIN A RULER?? SZA CLA / SKIP IF NO RULER FOUND JMP BACK3 / RULER FOUND JMP BACK2 / GO BACK ANOTHER BLK BACK4, JMP I BACK1 / RETURN.... X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED EDXVEC, / SPECIAL KEYBOARD XFER VECTOR EIPWFL / POWER FAIL DETECTED EIRBCH / RUB CHARACTER EIRBWD / RUB WORD EINWLN / RETURN EIPCMD / GOLD: COMMAND EIPGRF / GOLD: PARAGRAPH MARKER EITAB / TAB /D215 EITABC / GOLD: TAB CENTER EIINTB / GOLD: TAB (INDENT TAB) /A215 EIFILE / GOLD: FILE EIMENU / GOLD: MENU EICONT / GOLD: CONTINUE SEARCH & SELECT EIRBLN / GOLD: RUB LINE EIRBSE / GOLD: RUB SENTENCE EIDLTC / DELETE CHARACTER EIDLTW / DELETE WORD EIWORD / WORD EISENT / SENTENCE EILINE / LINE EITABP / TAB POSITION EIENTR / < > (ENTER KEY) EIPAGE / PAGE EIPARA / PARAGRAPH EIADVN / ADVANCE EIBKUP / BACK-UP EIGADV / GOLD: ADVANCE EIGBKP / GOLD: BACK-UP EIBOLD / BOLD EISLCT / SELECT EIUPPR / UPPER CASE EIUNDL / UNDERLINE EISCUT / CUT EISWAP / SWAP EIPSTE / PASTE EIUDLT / GOLD: DELETE (EITHER CHARACTER OR WORD) EIUBLD / GOLD: BOLD EILOWR / GOLD: UPPERCASE EIUUDL / GOLD: UNDERLINE EIHYPS / HYPHEN PUSH EIHYPL / GOLD: HYPHEN PULL EIHYP1 / GOLD: PRINTING BREAK HYPHEN EIHYP2 / GOLD: INVISIBLE HYPHEN (SHIFT PRINT HYPHEN) EIDEAD / GOLD: DEAD KEY EIDICT / GOLD: ABBREVIATION EIGETC / GOLD: LIBRARY EIDCMT / GOLD: GET DOCUMENT EITOP / GOLD: TOP DOCUMENT EIBOTM / GOLD: BOTTOM DOCUMENT EIFIND / GOLD: SEARCH EISRCH / GOLD: CONTINUE SEARCH EINPAG / GOLD: NEW PAGE EIPMRK / GOLD: PAGE MARKER EIRULR / GOLD: RULER EICENT / GOLD: CENTER EIGCUT / GOLD: CUT EIGPST / GOLD: PASTE EIGPGE / GOLD: PAGE EIREPL / GOLD: REPLACE EISUBS / GOLD: SUBSCRIPT EISUPS / GOLD: SUPERSCRIPT EIVIEW / GOLD: VIEW EITIME / GOLD: DATE & TIME EITC / TECHNICAL CHARACTER EIHELP / HELP COMMAND KEY EIPRSC / PREV SCREEN EINXSC / NEXT SCREEN EIUPAR / UP ARROW EIDNAR / DOWN ARROW IFDEF CONDOR < /M200 IFDEF LFTRGT < EIRARO / RIGHT ARROW EILARO / LEFT ARROW > / END IFDEF LFTRGT IFNDEF LFTRGT < EIBAD EIBAD > / END IFNDEF LFTRGT EIGRAR / GOLD: RIGHT ARROW EIGLAR / GOLD: LEFT ARROW > / END IFDIF CONDOR EIRQSP / GOLD: SPACE (REQUIRED SPACE) IFDEF CONDOR < /A205 EICLKY / COLUMN CUT /A205 > / END IFDEF CONDOR /A205 EIINOV / INSERT-OVERSTRIKE /A254 EDXVLN= .-EDXVEC / THIS IS THE COPY ROUTINE, MODIFIED FOR CROSS-FIELD CALLS... / IT LENDS ITSELF TO BEING MOVED, BECAUSE THE CALL CONTAINS THE / APPROPRIATE CDF INSTRUCTIONS TO MAKE IT UNIVERSAL XFCOPY, XX / JMS COPY - -CNT - CDFA - A-1 - CDF B - B-1 DCA COPTMP TAD I COPTMP DCA T1 / GET CNT TAD COPTMP DCA X0 TAD I X0 DCA COPY1 / CDF A TAD I X0 DCA X1 / A TAD I X0 DCA COPY2 / CDF B TAD I X0 DCA X2 / B RDF TAD CIDF0 / CONSTANT FOR CDF-CIF INSTRUCTION DCA COPXIT COPY1, .-. / CDF TAD I X1 COPY2, .-. / CDF DCA I X2 ISZ T1 JMP COPY1 CDFMYF COPXIT, .-. JMP I X0 / RETURN COPTMP, 0 / TEMP FOR COPY ROUTINE / ROUTINE CALLED FROM SCRLDN ROUTINE IN THE EDITOR, IT IS USED AS /FOLLOWS: / /IF MA=YES & IN MATH AREA / THEN IF IN CONTROL BLOCK / THEN SET "MTHWRK" = FALSE / SET "INCTLB" = FALSE / ELSE RETURN / ENDIF / ELSE RETURN / ENDIF SCRMTH, XX /D198; IFDEF UNBUND < JMS HAVMTH / IF MATH FEATURE NO ACTIVATED JMP SCREX / THEN JUST RETURN TO EDITOR /D198; > / END IFDEF UNBUND CDFEDT / YES: CHANGE TO EDITOR DATA FIELD TAD I (PCTLFL) / GET IN CONTROL BLOCK FLAG CDFMYF / RETURN TO THIS DATA FIELD SMA CLA / ARE WE IN A CONTROL BLOCK? JMP SCREX / NO: JUST RETURN JMS SCRINI / YES: GO SHUT MATH DOWN SCREX, CDIEDT / RETURN TO SCROLL DOWN ROUTINE JMP I SCRMTH / RETURN TO CALLER IN "SCRLDN" /D198; IFDEF UNBUND < / This routine does a skip return if the math feature is activated and / a regular return if not HAVMTH, XX CDFMNU / SET TO MENU DATA FIELD TAD I (MUBUF+MNOPTC) / GET ACTIVE FEATURES CONTROL WORD CDFMYF / RETURN TO DATA THIS FIELD AND (MABIT) / GET ACTIVATED MATH FEATURES CONTROL WORD SZA CLA / IF THE MATH FEATURE IS ACTIVATED ISZ HAVMTH / THEN BUMP THE RETURN ADDRESS JMP I HAVMTH / RETURN TO CALLER /D198; > / END IFDEF UNBUND X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-6400%400+DL3EDT / DISK BLOCK WHERE PAGE IS LOADED / THIS ROUTINE WILL EITHER SET OR CLEAR 132 COLUMN MODE / MUST BE CALLED WITH "l-"h IN AC TO CLEAR OR 0 IN AC TO SET / DATA AND INSTRUCTION FIELD MUST BE SET TO LP FIELD (CDILP) AND IT / ALWAYS RETURNS WITH DATA FIELD IN EDITOR FIELD / CAN ONLY BE CALLED FOR EDITOR FIELD LP132, XX TAD ("H+40) / SET UP TO EITHER SET OR CLEAR DCA SETCLR / 132 COLUMN MODE IFNDEF ITALIAN < TAD SETCLR / See if same as last time. CIA / ... TAD SETSAV / .... SNA CLA / skip if not the same. we must do it. JMP LPXIT / same, so exit. > TAD SETCLR / Get new value. DCA SETSAV / save it for next check. CIFMNU JMS I IOACAL / CALL I/O ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE MSG132 / ADDRESS OF TEXT STRING TO OUTPUT S132MS / ADDRESS OF STRING ARGUMENT LPXIT, CDIEDT / SET BACK TO EDITOR FIELD JMP I LP132 / RETURN /MSG132, TEXT "^A" / !A MEANS USE FOLLOWING ARGUMENT AS ADDRESS / OF ASCII STRING TO OUTPUT S132MS, ESC / esc "[ / [ "? / ? "3 / 3 SETCLR, 0 / h TO SET OR l TO CLEAR ESC / ESC "[ / [ "? / ? "1 / 1 "H+40 / h 0 / END OF ESCAPE SEQUENCE SETSAV, "L+40 / we start out in 80 col mode. / PUTLP Routine moved this edit to gather space here /a247 / ROUTINE TO OUTPUT A MESSAGE TO THE SCREEN, ADDRESS OF MESSAGE IS / IN AC ON ENTRY /d247 PUTLP, XX /d247 DCA PTLP1 / SET UP ADDRESS /d247 CIFMNU /d247 JMS I IOACAL / CALL I/O ROUTINE /d247 0 / USE DEFAULT OUTPUT ROUTINE /d247 PTLP1, XX / ADDRESS OF TEXT STRING TO OUTPUT /d247 CDIEDT / SET BACK TO EDITOR FIELD /d247 JMP I PUTLP / RETURN / USE IOA !& CALL TO CAPITILIAZE WORDS STXMSG, IFDEF ENGLSH < TEXT " !&TOP " > IFDEF V30NOR < TEXT " !&TOPP " > IFDEF V30SWE < TEXT " !&B\VRJAN " > IFDEF SPANISH < TEXT "&SUPERIOR" > /A255 IFDEF ITALIAN < TEXT "!&INIZIO" > IFDEF FRENCH < TEXT " &HAUT " > IFDEF GERMAN < TEXT " &ANFANG " > IFDEF DUTCH < TEXT " &BEGIN " > IFDEF CANADA < TEXT " &HAUT " > IFDEF NORWAY < TEXT " &TOPP " > IFDEF SWEDSH < TEXT " &TOPP " > IFDEF DANISH < TEXT " &TOP " > PGMSG1, IFDEF ENGLSH < TEXT " !&NEW !&PAGE " > IFDEF V30NOR < TEXT " !&NY !&SIDE " > IFDEF V30SWE < TEXT " !&NY !&SIDA " > IFDEF SPANISH < TEXT "&P\AGINA &NUEVA" > /A255 IFDEF ITALIAN < TEXT "!&NUOVA !&PAGINA" > IFDEF CANADA < TEXT " &NOUV. &PAGE " > IFDEF FRENCH < TEXT " &NOUV. &PAGE " > IFDEF GERMAN < TEXT " &NEUE &SEITE " > IFDEF DUTCH < TEXT " &NIEUWE &PAGINA " > IFDEF NORWAY < TEXT " &NY &SIDE " > IFDEF SWEDSH < TEXT " &NY &SIDA " > IFDEF DANISH < TEXT " &NY &SIDE " > PGMSG2, IFDEF ENGLSH < TEXT " !&PAGE !&MARKER " > IFDEF V30NOR < TEXT " !&SIDEMERKE " > IFDEF V30SWE < TEXT " !&SIDMARKERING " > IFDEF SPANISH < TEXT "&MARCADOR DE &P\AGIN" > /A255 IFDEF ITALIAN < TEXT "!&INDICATORE !&PAGINA" > IFDEF CANADA < TEXT " &CHANG. &PAGE "> IFDEF FRENCH < TEXT " &CHGT &PAGE " > IFDEF GERMAN < TEXT " &SEITEN &MARKE " > IFDEF DUTCH < TEXT " &PAGINA-&MARKERING "> IFDEF NORWAY < TEXT " &SIDEMARKERING " > IFDEF SWEDSH < TEXT " &SIDMARKERING " > IFDEF DANISH < TEXT " &SIDEMARKERING " > PGMSG3, IFDEF ENGLSH < TEXT " !&START !&CONTROL " > IFDEF V30NOR < TEXT " !&KONTROLL !&BEGYNN " > IFDEF V30SWE < TEXT " &START KONTROLL" > IFDEF SPANISH < TEXT "&INICIO &CONTROL" > /A255 IFDEF ITALIAN < TEXT "!&INIZIO !&CONTROLLO" > IFDEF CANADA < TEXT " &CMDE &DEBUT &IMPRESSION " > IFDEF FRENCH < TEXT " &CDE &DEBUT &IMPRESSION " > IFDEF GERMAN < TEXT " &START &DRUCKAUSGABE " > IFDEF DUTCH < TEXT " !&BEGIN !&OPDRACHT " > IFDEF NORWAY < TEXT " &START &UTSKRIFTSKONTROLL " > IFDEF SWEDSH < TEXT " &START &UTSKRIFTSKONTROLL " > IFDEF DANISH < TEXT " &START &UDSKRIFTSKONTROL " > PGMSG4, IFDEF ENGLSH < TEXT " !&END !&CONTROL " > IFDEF V30NOR < TEXT " !&KONTROLL !&SLUTT " > IFDEF V30SWE < TEXT " &SLUTT KONTROLL " > IFDEF SPANISH < TEXT "&FIN &CONTROL" > /A255 IFDEF ITALIAN < TEXT "!&FINE !&CONTROLLO" > IFDEF CANADA < TEXT " &CMDE &FIN &IMPRESSION " > IFDEF FRENCH < TEXT " &CDE &FIN &IMPRESSION " > IFDEF GERMAN < TEXT " &ENDE &DRUCKAUSGABE " > IFDEF DUTCH < TEXT " !&EINDE !&OPDRACHT " > IFDEF NORWAY < TEXT " &SLUTT &UTSKRIFTSKONTROLL " > IFDEF SWEDSH < TEXT " &SLUT &UTSKRIFTSKONTROLL " > IFDEF DANISH < TEXT " &SLUT &UDSKRIFTSKONTROL " > MSGF, IFDEF ENGLSH < TEXT "--!&DOCUMENT !&FILING !&BEING !&COMPLETED--" > IFDEF V30NOR < TEXT "--!&DOKUMENT !&ARKIVERES--" > IFDEF V30SWE < TEXT "--&AVSLUTA--" > IFDEF SPANISH < TEXT "--&SE &HA &COMPLETADO &EL &ARCHIVO &DEL &DOC.--" > /A255 IFDEF ITALIAN < TEXT "--!&ARCHIVIAZIONE !&DOCUMENTO !&IN !&CORSO--" > IFDEF CANADA < TEXT "--&CLASSEMENT &DU &DOCUMENT &EN &COURS--" > IFDEF FRENCH < TEXT "--&CLASSEMENT &DU &DOCUMENT--" > IFDEF DUTCH < TEXT "--!&DOCUMENT !&WORDT !&OPGESLAGEN--" > IFDEF GERMAN < TEXT "--&DATEI &WIRD &ARCHIVIERT--" > IFDEF NORWAY < TEXT "-- &DOKUMENTET &LAGRES --" > IFDEF SWEDSH < TEXT "-- &DOKUMENTET &LAGRAS --" > IFDEF DANISH < TEXT "-- &DOKUMENT &LAGRES --" > /**************************************************************************** / SVNTO8 SeVeN TO eight bit routine. Takes characters from the /a247 / edit buffer using READNEXTCHARACTER and checks for dead /a247 / key sequences representing multinational characters. /a247 / These it converts to eight bits. /a247 /**************************************************************************** SVNTO8, XX / Start of SeVeN TO eight bit convertion/a247 JMS READNEXTCHAR / Read the next character from the buf /a247 JMP EREXIT / If ETX found, exit /a247 TAD DEADKEY / Check for dead key sequence introducer/a247 SNA CLA / Is this a dead key we are reading? /a247 JMP NOT8 / No, just do non-error skip return /a247 JMS READNEXTCHAR / Read the next character from the buf /a247 JMP EREXIT / If ETX found, exit /a247 TAD CRLMB / Get the char without mode bits /a247 TAD (-ECSPC) / Test for multinational identifier /a247 SZA CLA / Is this a space? /a247 JMP NO8NXC / No, therefore skip user dead key /a247 JMS READNEXTCHAR / Read the next character from the buf /a247 JMP EREXIT / If ETX found, exit /a247 JMS READNEXTCHAR / Read the next character from the buf /a247 JMP EREXIT / If ETX found, exit /a247 TAD CRLMB / Get the seven bit representation /a247 TAD (200) / Add the eigth bit /a247 DCA CRLMB / Restore the character /a247 NO8NXC, JMS ADUNIT / Advance a character without reseting /a247 / CRLMB /a247 JMP EREXIT / If ETX, exit /a247 TAD (-ECNDOV) / Check for the end of the dead key /a247 SZA CLA / Is the current character an End Dead? /a247 JMP NO8NXC / No, get the next character /a247 NOT8, DCA DEADKEY / Zero the dead key flag /a247 ISZ SVNTO8 / Skip return if ETX not encountered /a247 EREXIT, JMP I SVNTO8 / Return /a247 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE RELOC RELOC 200 / CODE EXECUTED AT LOCATION 200 IN FIELD 5 DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / This space is reserved for editor math or any other editor code / that is GUARENTEED NOT TO BE USED WHILE IN LIST PROCESSING / It is loaded into field five (CDFLP) by the editor overlay which / initializes for a normal edit session (as opposed to using the / editor for list processing. / There are 12 pages of code available here. It is limited only by / the location of the BCDASC routine which currently resides at 5400 / therefor this space can be expanded. To change the amount of of code / assembled here (hence the number of blocks allocated on the system / diskette to hold the code) it is only necessary to change the value / of DS4EDT in WPDL.PA. This constant is equal to the number of / blocks of code (2 pages per block) / THE FOLLOWING TABLES ARE USED IN CONJUNCTION WITH THE ":Dnn" and ":Tnn" / SYMBOLS WHICH CAN BE ENTERED INTO THE SYMBOL TABLE WHILE IN EDITOR MATH / THERE IS A ":Dnn" TABLE - "DCHAR", AND A ":Tnn" TABLE - "TCHAR" / THE ENTRY OF THESE SYMBOL NAMES IN THE SYMBOL TABLE IS JOINED BY A / COINCIDENTAL ENTRY OF THE POINTER TO THAT SYMBOL NAME VALUE ( IN THE / SYMBOL TABLE) BEING PUT IN THE APPROPRIATE TABLE HERE. / BOTH DCHAR AND TCHAR AS WELL AS THEIR LENGTHS ARE DEFINED IN WPF1! DCHAR, ZBLOCK DCHARL TCHAR, ZBLOCK TCHARL / CALLED FROM "CKCTRL" RTN CHECKS IF MATH CTRL BLOCK ERR PASSED BACK FROM / MATH MODULE WAS ENCOUNTERED WHILE IN EDITOR MATH WORK AREA. IF IT WAS / NOT THEN THE LINE IS IGNORED, IF IT WAS THEN THE ERROR IS REPORTED AS / AS AN EDITOR MATH ERROR EDERR1, MQL / HOLD ERROR NUMBER CDFMTH / CHANGE TO MATH DATA FIELD TAD I (MTHWRK) / GET "EDITOR MATH WORK AREA" FLAG CDFLP / RETURN TO LP DATA FIELD SZA CLA / ARE WE IN AN EDITOR MATH WORK AREA? JMP BKDTX1 / NO: IGNORE LINE, REINIT & RETURN TO EDIT JMS SCRINI / YES: RE-INIT TO SHUT EDITOR MATH DOWN BECAUSE / AN ERROR WAS ENCOUNTERED IN A MATH CTRL BLOCK MQA / RESTORE ERROR NUMBER TO AC JMS RESCURPTR / RESTORE CURPTR JMP EDERR / GO TO ERROR CODE TO REPORT ERROR / CODE TO RUN CHECK ON PRESENT EDIT MATH CONTROL BLOCK STATUS, CALLED / AS PART OF IN-LINE CODE FROM "CKCTRL" CKCTR6, TAD INCTLB / GET "IN CTRL BLOCK" FLAG SZA CLA / ARE WE ALREADY IN A BLOCK? JMP CKCTR2 / NO: SEE IF JUST STARTING BLOCK TAD MTHCTL / YES: GET "IN MATH CTRL BLOCK" FLAG SZA CLA / ARE WE IN A MATH CTRL BLOCK? JMP SCRLLN / YES: THEN GO PROCESS LINE CDFMTH / NO: THEN CHANGE TO MATH DATA FIELD TAD I (MTHWRK) / GET "EDIT MATH WORK AREA" FLAG CDFLP / RETURN TO LP DATA FIELD SNA CLA / ARE WE IN EDITOR MATH WORK AREA? JMP CKCTRZ / YES: GO SEE IF STILL IN BLOCK CDFMTH / NO: THEN CHANGE TO MATH DATA FIELD TAD I (MTHSND) / GET EDITOR MATH "SECOND LINE" FLAG CDFLP / RETURN TO LP DATA FIELD SZA CLA / IS THE SECOND LINE NEXT TO BE PROCESSED? JMP CKCTRZ / NO: GO SEE IF STILL IN BLOCK JMP SCRLLN / YES: GO PROCESS LINE CKCTRZ, JMS READNEXTCHARACTER / GET 1ST CHAR ON THE LINE NOP / ETX RETURN, SHOULD NEVER HIT HERE TAD CRWMB / PUT CHAR WITH MODE BITS INTO AC TAD (-ECPCT2) / ADD NEGATIVE OF "END CONTROL BLOCK" CHAR SNA CLA / REACHED THE END OF THE NON-MATH CONTROL BLOCK? JMP BKEDT1 / YES: SET "INCTLB"=FALSE & RTRN TO EDITOR JMP BKEDI3 / NO : IGNORE LINE CAUSE NOT EDIT MATH X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / EXTRACTNUMBER ROUTINE ALONG WITH ALL ASSOCIATED SUBROUTIINES ARE / CLASSIFIED AS IN EDIT HISTORY!! / /++ / EXTRACTNUMBER EXTRACT_NUMBER / / FUNTIONAL DESCRIPTION: EXTRACTNUMBER / / EXTRACT_NUMBER ROUTINE PERFORMS THE EXTRACTION OF NUMBERS FROM A LINE / OF TEXT WITHIN A DOCUMENT FOR THE PURPOSE OF PERFORMING EDITOR MATH. / IT ALSO CALLS MATH EXECUTION AND MATH INSERT_DELETE ROUTINES AS NEEDED. / / CALLING SEQUENCE: JMP EXTRACTNUMBER / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: GLOBAL: MTHWRK, NWDT, MTHTOT, CURPTR, LNEPC, TABFLAGS, / TABPOSITION, CRLMB, CRWMB, DTABCOUNT, T1 / LOCAL: SEIRF / / OUTPUT PARAMETERS: NONE / / IMPLICIT OUTPUT: GLOBAL: DTABCOUNT, LNEPC, CURPTR, T1, LTABPOSITION, / CRWMB / LOCAL: SEIRF, EXTRA4 / / COMPLETION CODE: AC = 0 / / SIDE EFFECTS: 1) IF INSDEL (INSERT_DELETE) ROUTINE IS NOT CALLED / CURPTR IS SET TO VALUE IT WAS ON ENTRY TO / EXTRACTNUMBER ROUTINE. / /-- EXTRACTNUMBER, CDFMTH / ARE WE IN A MATH_WORK AREA? TAD I (MTHWRK) SZA CLA / SKIP IF: SO JMP BKEDI3 / RETURN TO EDITOR - DON'T DO MATH CDFEDT / DOES CURRENT RULER CONTAIN DECIMAL TABS? TAD I (CURUL+NWDT-NWRUL) SNA CLA / SKIP IF: SO JMP BKEDI4 / RETURN TO EDITOR - DON'T DO MATH / CHECK FOR PROPER LINE TERMINATION BEFORE DOING MATH. IF LINE IS NOT / TERMINATED BY HARD RETURN OR CHARACTERS EXCEED RIGHT MARGIN THEN DO / NOT PERFORM MATH ON THIS LINE!! TAD I (CURUL+NWRMAR-NWRUL) / SET LNEPC = -(RIGHT_MARGIN + 1) CDFMYF EXTR15, CMA / ALSO USED SET LNEPC = -1 FROM BELOW DCA LNEPC / SAVE IT EXTRA6, JMS READNEXTCHAR / READ A CHARACTER JMP BKEDI4 / ETX RETURN - SHOULD NEVER READ TAD CRLMB / GET CHARACTER READ TAD (-ECNWLN) / CHAR. = LINE_ENDING CHARACTER? SNA CLA / SKIP IF: NOT JMP EXTR14 / CHECK FOR SPECIAL LINE_END CHAR. ISZ LNEPC / BUMP -RIGHT_MARGIN COUNT JMP EXTRA6 / HAVE NOT EXCEEDED RIGHT MARGIN! TAD CRLMB / CHECK FOR SPACES BEYOND RIGHT MAR. TAD (-ECSPC) SNA CLA / SKIP IF: NOT A SPACE JMP EXTR15 / RESET LNEPC = -1 AND CONTINUE JMP BKEDI4 / RIGHT_MARGIN LIMIT EXCEEDED!! / RETURN TO EDITOR. EXTR14, TAD CRWMB / CHAR. = SPECIAL_LINE_ENDING? / (I.E.:WRAPPED_LINE,PARA._MARK...ETC.) AND (3000) SZA CLA / SKIP IF: NOT - LINE OK TO PROCESS! JMP BKEDI4 / SKIP LINE: RTRN TO EDIT. RESTORE / "TOTAL" FLAG & CURPTR ON THE WAY JMS RESCURPTR / RESTORE OLD CURPTR AC7777 / RESET CURPTR TO PROCESS MATH LINE JMS STCURPTR DCA DTABCOUNT / INITIALIZE DECIMAL_TAB_COUNT CDFMTH / CHECK IF IN MATH TOTAL AREA TAD I (MTHTOT) CDFMYF SZA CLA / SKIP IF: NOT JMP EXTRA7 JMS IDCST / INITIALIZE_DECIMAL_CHARACTER_SYMBOL_TABLE AC0001 / INITIALIZE SKIP_EXECUTION_AND_ / INSERTION_ROUTINE_FLAG = TRUE DCA SEIRF DCA LTABPOSITION / INITIALIZE LAST_TAB_POSITION AC7777 / INIT. LINE_POSITION_COUNTER = LEFT_- / MARGIN - 1 DCA LNEPC EXTRA1, DCA CRWMB / INITIALIZE CHARACTER_READ_WITH_MODE_BITS EXTRA2, JMS READTABORLINEEND/ READ_TAB_OR_LINE_END JMP EXTRA9 / END_OF_LINE , ETX TAD TABFLAGS / IS TAB TYPE = DECIMAL ALIGN TAB? SNA CLA / SKIP IF: SO JMP EXTRA3 TAD DTABCOUNT / ADD DECIMAL_TAB_COUNT + DCHAR TAD (DCHAR) / CHECK TO SEE IF THERES A MATCH IN DCA T1 / DCHAR TABLE FOR THIS POSITION OF THE TAD I T1 / DECIMAL TAB. IF THERE IS IT MEANS / FIELD NEEDED FOR MATH COMPUTATIONS. SNA / SKIP IF: FIELD NEEDED FOR MATH COMPUTATIONS JMP EXTRA1 / NO MATCH - CLEAR CRWMB BEFORE READ NEXT CHAR. DCA EXTRA4 / SAVE POINTER INTO SYMBOL TABLE JMS GETDTF / JMS GET_DECIMAL_TAB_FIELD JMP EXTRA2 / UNDEFINED FIELD RETURN / CONVERT ASCII STRING TO BCD NUMBER EXTRA5, CIFMTH JMS ASCBCD / CALL ASCBCD ROUTINE ENASBF / ADDRESS OF ASCII STRING TO BE CONVERTED EXTRA4, .-. / ADDRESS IN SYMBOL TABLE WHERE BCD / NUMBER WILL BE PLACED SKP / ASCBCD ERROR RETURN (AC = ERROR NUMBER) JMP EXTR11 / NO ERROR - KEEP ON TRUCKIN!! / CHECK IF ERROR CAUSED BY "*UN.DEF*" OR "*OVR.FLO*" STRING BEING SUBMITTED / TO ASCBCD ROUTINE. IF SO THEN SET SKIP_EXECUTION_AND_INSERTION_ROUTINE_FLAG / = FALSE AND LABEL FIELD AS UNDEFINED IN SYMBOL TABLE (EXTR13). CLA CLL JMS CSNF / SEE IF FIELD THAT CAUSED ERROR WAS EITHER / "*UN.DEF*" OR "*OVR.FLO*" STRING JMP EXERR1 / ERROR NOT CAUSED BY EITHER "*UN.DEF*" / OR "*OVR.FLO*" STRING SO REPORT IT! EXTR11, DCA SEIRF / SET SKIP_EXECUTION_AND_INSERTION_ / ROUTINE_FLAG = FALSE JMP EXTRA2 / GET NEXT DECIMAL FIELD / POSITION CURPTR TO CHARACTER - 1 POSITION OF RULER TAB SETTING EXTRA3, TAD TABPOSITION CIA TAD LNEPC DCA TCCNTR / SAVE RESULT IN TEMPORARY_CHARACTER_COUNTER EXTR10, ISZ TCCNTR / INCREMENT COUNTER SKP / COUNT NOT YET EXHAUSTED - KEEP GOING JMP EXTRA1 / CURPTR NOW REPOSITIONED ISZ LNEPC / INCREMENT LINE POSITION COUNTER JMS READNEXTCHARACTER NOP / ETX RETURN - SHOULD NEVER SEE ETX!! JMP EXTR10 EXTRA9, TAD SEIRF / CHECK SKIP_EXECUTION_AND_INSERTION_- / ROUTINE_FLAG SZA CLA / SKIP IF: FALSE JMP BKEDI3 / BACK TO EDITOR, RESTORE CURPTR ON WAY EXTRA8, CIFMTH JMS EXECUTION / DO MATH EXECUTION ROUTINE SZA / WAS AN ERROR RETURNED FROM THE EXECUTION CODE? JMP EDERR / YES: GO PASS ERROR # TO ERROR REPORTING RTN TAD (DCHAR-TCHAR) / NO: SET AC = DCHAR FOR CALL TO INSERTION EXTRA7, TAD (TCHAR) / SET AC = TCHAR FOR CALL TO INSERTION JMS INSDEL / DO MATH INSERTION_DELETION ROUTINE EXTR13, CLA CLL CDFMTH DCA I (MTHTOT) / CLEAR MTHTOT FLAG / DIDN'T BOTHER TO ADJUST FIELD HERE / SINCE BKEDIT DOES FIELD ADJUSTMENTS JMP BKEDIT SEIRF, .-. / SKIP_EXECUTION_AND_INSERTION_ROUTINE_FLAG / 0 = DON'T SKIP / 1 = SKIP DTABCOUNT, .-. / COUNT OF DECIMAL_TABS X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /++ / INITIALIZE_DCHAR_SYMBOL_TABLE / / FUNTIONAL DESCRIPTION: IDCST / / USING THE DCHAR TABLE ENTRYS AS POINTERS INTO THE MATH SYMBOL TABLE / INITIALIZE EACH SYMBOL TABLE FIELD TO UNDEFINED. / / CALLING SEQUENCE: JMS IDCST / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: T3, X5 / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: X5, T3, T2 / / COMPLETION CODE: NONE / SIDE EFFECTS: NONE / /-- / IDCST, XX / INITIALIZE_DECIMAL_CHARACTER_SYMBOL_TABLE TAD (DCHAR-1) / GET STARTING ADDRESS OF DCHAR TABLE - 1 DCA X5 / STORE IT TAD (-DCHARL) / SET COUNTER = -DCHARL - 1 /C236 /D236 CMA DCA T3 / SAVE RESULT FOR COUNTER IDCST1, TAD I X5 / GET NEXT DCHAR TABLE ENTRY /C236 SNA / SKIP IF: CONTAINS POINTER INTO SYM. TABLE JMP IDCST2 / NO POINTER - GO TO NEXT ENTRY /C236 DCA T2 / SAVE POINTER INTO SYM. TABLE AC2000 / SET UNDEF FLAG IN FIRST LOCATION CDFMTH DCA I T2 CDFMYF / DONE /D236 JMP IDCST1 IDCST2, ISZ T3 / PAST END OF DCHAR TABLE? /D236 SKP / NO JMP IDCST1 / NO - INIT. FOR NEXT DCHAR TABLE ENTRY JMP I IDCST / YES - INIT COMPLETE SO RETURN /C236 /++ / GET_DECIMAL_TAB_FIELD / / FUNTIONAL DESCRIPTION: GETDTF / / REMOVE A FIELD OF TEXT THAT HAS BEEN TABBED TO A DECIMAL TAB / RULER SETTING WITHIN A DOCUMENT, CHECKING FOR PROPER ALIGNMENT TO / THE DECIMAL TAB RULER SETTING AS FIELD IS READ. / / CALLING SEQUENCE: JMS GETDTF / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: GLOBAL: TABPOSITION, LNEPC, TABFLAGS, CRLMB, SAVTP / LOCAL: GETD11, DFDONEF, FLDNE / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: GLOBAL: LNEPC, SAVTP / LOCAL: FLDNE, DFDONEF, GETDT1, GETD11, GETDTF / / COMPLETION CODE: 1) RETURN CALLER+1 IF EMPTY FIELD / RETURN CALLER+2 IF FIELD NOT EMPTY AND ALIGNED / TO THE DECIMAL TAB SETTING. / / SIDE EFFECTS: 1) IF AN ERROR CONDITION OCCURS THEN EXIT GETDTF / VIA ERROR HANDLER. / /-- / ENASBF= TOKVAL / EXTRACT_NUMBER_ASCII_STRING_BUFFER ENASBS= MAXTOK / EXTRACT_NUMBER_ASCII_STRING_BUFFER_SIZE GETDTF, XX DCA FLDNE / INITIALIZE FIELD_NOT_EMPTY_FLAG = FALSE DCA DFDONEF / INITIALIZE DECIMAL_FIELD_DONE_FLAG = FALSE TAD (ENASBF-1) / INITIALIZE POINTER TO EXTRACT_NUMBER_ASCII_- / STRING_BUFFER DCA GETDT1 TAD (ENASBS) / INITIALIZE COUNTER FOR OUTPUT BUFFER CIA DCA GETDT2 TAD TABPOSITION / SET SAVED_TAB_POSITON = TAB_POSITION - 1 DCA SAVTP GETDT3, ISZ LNEPC / INCREMENT LINE POSITION COUNTER JMS SVNTO8 / /m247 JMP GETDT9 / ETX RETURN TAD SAVTP / SET FLAG TO SHOW LINE_POINTER_COUNTER / RELATIVE POSITION TO SAVED_TAB_POSITION CIA TAD LNEPC / IF RESULT < 0 - PRE_TAB / = 0 - AT TAB / " " > 0 - POST_TAB DCA GETD11 / SAVE RESULT IN TEMP. TAD GETD11 / LINE_POSITION_COUNTER => SAVED_TABPOSITION? SPA CLA / SKIP IF: SO JMP GETDT8 / LINE_POSITION_COUNTER < SAVED_TABPOSITION AC7777 / CALL FINDTP TO SEARCH FOR TAB FROM / CURRENT LINE POSITION - 1 JMS FINDTP / FIND_TAB_POSITION LNEPC AC4000 / IS LINE_POSITION AT DECIMAL TAB RULER / SETTING? AND TABFLAGS SZA CLA / SKIP IF: NOT JMS IDTABCOUNT / INCREMENT DECIMAL_TAB_COUNT GETDT8, TAD CRLMB / GET CHARACTER_READ_LESS_MODE_BITS TAD (-41) / SPECIAL CHARACTER? SMA / SKIP IF:SO JMP GETDT4 TAD (41-ECSTOV) / CHARACTER_READ_LESS_MODE_BITS = START_- / DEAD_KEY SEQUENCE? SNA / SKIP IF: NOT JMP GETDT4 TAD (ECSTOV-ECTAB) / CHARACTER_READ_LESS_MODE_BITS = TAB? SZA / SKIP IF: SO TAD (ECTAB-ECNWLN) / CHARACTER_READ_LESS_MODE_BITS = LINE_- / ENDING CHARACTER? SNA / SKIP IF: NOT JMP GETDT9 / SET DECIMAL_FIELD_DONE_FLAG = TRUE GETDT7, TAD (ECNWLN-ECSPC) / CHARACTER_READ_LESS_MODE_BITS = SPACE? SZA CLA / SKIP IF: SO JMP GETDT3 / IGNORE AND GET NEXT CHARACTER TAD GETD11 / ARE WE POSITIONED AT TAB? SNA / SKIP IF: NOT JMP EXERR1 / *** ERROR *** SPACE AT TAB POSITION SMA CLA / SKIP IF: POSITIONED PRE_TAB JMP GETDT9 / MUST BE POSITIONED POST_TAB TAD FLDNE / IS THIS A LEADING SPACE? SNA CLA / SKIP IF: NOT JMP GETDT3 / IGNORE IT JMP GETDT6 /d247 GETD12, ISZ DFDONEF / SET DECIMAL_FIELD_DONE_FLAG = TRUE /d247 JMP GETDT6 GETDT4, TAD (41-")+200) / IS CHARACTER = ")"? SZA / SKIP IF: SO /D251 TAD (")-".) / IS CHARACTER = "."? TAD RADCHR / IS CHARACTER = RADIX POINT /A251 SNA CLA / SKIP IF: NOT JMP GETD13 / DON'T CHECK IF LEGAL CHAR. AT TAB_POSITION TAD GETD11 / LINE_POSITION_COUNTER = SAVED_TAB POSITION? SNA CLA / SKIP IF: NOT JMP EXERR1 / *** ERROR *** ILLEGAL CHAR. AT DTP GETD13, ISZ FLDNE / SET FIELD_NOT_EMPTY_FLAG = TRUE GETDT6, /d247 CLA ISZ GETDT2 / BUMP OUTPUT_BUFFER_COUNTER SKP / ROOM IN OUTPUT_BUFFER FOR CHARACTER. GETDT9, ISZ DFDONEF / SET DECIMAL_FIELD_DONE_FLAG = TRUE ISZ GETDT1 / INCREMENT OUTPUT_BUFFER_POINTER TAD DFDONEF / DECIMAL_FIELD_DONE_FLAG = TRUE ? SNA CLA / SKIP IF: SO TAD CRLMB / PUT CHARACTER INTO OUTPUT_BUFFER CDFMTH DCA I GETDT1 CDFMYF TAD DFDONEF / DECIMAL_FIELD_DONE_FLAG = TRUE ? SNA CLA / SKIP IF: SO JMP GETDT3 / BACK FOR THE NEXT CHARACTER TAD FLDNE / CHECK FIELD_NOT_EMPTY_FLAG SZA CLA / SKIP IF: TRUE ISZ GETDTF / BUMP RETURN GETDT5, JMP I GETDTF / RETURN GETDT1, .-. / TEMP. - HOLDS POINTER INTO OUTPUT BUFFER GETDT2, .-. / TEMP. - HOLDS COUNTER FOR OUTPUT BUFFER GETD11, .-. / TEMP. - HOLDS RELATIVE LINE POSITION / INDICATOR FLDNE, .-. / FIELD_NOT_EMPTY_FLAG / 0: FIELD EMPTY / 1: FIELD CONTAINS VALID CHARACTERS DFDONEF, / DECIMAL_FIELD_DONE_FLAG .-. / 0: NOT FINISHED READING DECIMAL FIELD / 1: FINISHED READING DECIMAL FIELD RADCHR, /A251 IFDEF PERDEC< /A251 ")-". / RADIX = . /A251 > /A251 IFDEF COLDEC< /A251 ")-": / RADIX = : /A251 > /A251 IFDEF COMDEC< /A251 ")-", / RADIX = , /A251 > /A251 / EXERR1 moved this edit to gather space in one place /a247 / EXTRACTNUMBER ERROR HANDLER /d247 EXERR1, TAD (EREXTR) / GET ERROR NUMBER /d247 JMS RESCURPTR / FIRST RESTORE CURPTR THEN.... /d247 JMS EDERR-1 / GO TO ERROR REPORTER. WON'T RETURN /d247 SAVTP, .-. / SAVED_TAB_POSITION - HOLDS TAB_POSITION /d247 / OF CURRENT DECIMAL TAB FIELD. USED /d247 / BY BOTH EDERR AND GETDTF ROUTINES. /d247 / MUST FOLLOW JMS TO EDERR-1 / CALFXS Moved here this edit to gather space in one place /a247 / CALLS EDITOR FXSCRL ROUTINE CALFXS, XX CLA / CLEAR AC CDFEDT / IF THE SCREEN LAG COUNT IS NEGATIVE TAD I (SCRLCT) / CDFMYF / SNA CLA / THEN CALL FXSCRL TO UPDATE SCREEN JMP I CALFXS / CIFEDT / SET TO EDITORS INSTRUCTION FIELD JMS CALLAR / ALL PURPOSE ROUTINE TO CALL ANY / EDITOR ROUTINE FXSCRL / ADDRESS OF ROUTINE IN EDITOR CDFBUF / DATA FIELD FOR ROUTINE TO USE JMP I CALFXS / RETURN TO CALLER X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /++ / CHECK_SPECIAL_NUMBER_FIELD CSNF / / FUNTIONAL DESCRIPTION: CSNF / / CHECK IF ASCII STRING CONTAINED WITHIN ENASBF IS EITHER / "*OVR.FLO*" OR "*UN.DEF*". / / CALLING SEQUENCE: JMS CSNF / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: LOCAL: ASTPTR (X5), ASP (X4), ENASBP (T2) / / OUTPUT PARAMETERS: AC AND MQ = 0 / / IMPLICIT OUTPUT: LOCAL: ASTPTR (X5), ASP (X4), ENASBP (T2), CSNF / / COMPLETION CODE: 1) RETURN CALLER+1 IF NO MATCH / RETURN CALLER+2 IF MATCH / / SIDE EFFECTS: 1) NOTE: ASTPTR=X5, ASP=X4, ENASBP=T2 / 2) OFTEXT AND UDTEXT STRINGS RESIDE IN BCDASC / ROUTINE AND ARE DEFINED IN WPF1. /-- ASTPTR= X5 ASP= X4 ENASBP= T2 CSNF, XX TAD (AST-1) / SET ASCII_STRING_TABLE_POINTER = ASCII_- / STRING_TABLE - 1 DCA ASTPTR CSNF1, TAD I ASTPTR / INCREMENT ASCII_STRING_TABLE_POINTER AND / GET ASCII_STRING_TABLE ENTRY SNA / SKIP IF: NOT END OF TABLE JMP CSNF5 / NO MATCH. DO NONSKIP RETURN DCA ASP / SET ASCII_STRING_POINTER = ASCII_STRING_- / TABLE ENTRY TAD (ENASBF-1) / SET EXTRACT_NUMBER_ASCII_STRING_BUFFER_- / POINTER = EXTRACT_NUMBER_ASCII_BUFFER - 1 DCA ENASBP CSNF2, ISZ ENASBP / INC. EXTRACT_NUMBER_ASCII_STRING_BUFFER_POINTER TAD I ASP / INC. ASCII_STRING_POINTER AND GET CHARACTER SZA / SKIP IF: END OF STRING JMP CSNF4 / GO CHECK FOR MATCH CDFMTH / CHECK IF END OF EXTRACT_NUMBER_ASCII_BUFFER / STRING TAD I ENASBP CDFMYF SZA CLA / SKIP IF: SO - ASCII STRINGS MATCHED!! JMP CSNF1 / NO MATCH - TRY NEXT ASCII STRING ISZ CSNF / INCREMENT RETURN POINTER FOR MATCH RETURN JMP CSNF5 / DO RETURN CSNF4, CIA / DOES CHAR. FROM ASCII STRING MATCH CHAR. / FROM EXTRACT_NUMBER_ASCII_BUFFER? CDFMTH TAD I ENASBP CDFMYF SNA CLA / SKIP IF: NOT JMP CSNF2 / MATCH - SEE IF NEXT CHAR. MATCHES JMP CSNF1 / NO MATCH - GO TRY NEXT ASCII STRING CSNF5, JMP I CSNF / RETURN AST, OFTEXT-1 / ADDRESS OF *OVR.FLO* TEXT - 1 UDTEXT-1 / ADDRESS OF *UN.DEF* TEXT - 1 0 / AST TABLE TERMINATOR /++ / FIND_TAB_POSITION FINDTP / / FUNTIONAL DESCRIPTION: FINDTP / / USING THE LINE POSITION POINTED TO AT CALL+1 PLUS OFFSET IN AC, / FIND THE NEXT TAB SETTING IN THE RULER. STORE ITS CLASS THEN / SET FLAGS TO INDICATE IF IT WAS A DECIMAL ALIGN TAB AND IF LINE / POSITION SPECIFIED UPON CALL DIRECTLY CORRESPONDS TO TAB SETTING / POSITION IN RULER. / / CALLING SEQUENCE: CALL: JMS FINDTP / CALL+1: POINTER TO ADDRESS OF LINE POSITION / / INPUT PARAMETERS: AC = OFFSET TO BE ADDED TO LINE POSITION / / IMPLICIT INPUT: GLOBAL: TABPOSITION, TABFLAGS / LOCAL: FINDT2, T3 / / OUTPUT PARAMETERS: AC = TAB CLASS / MQ = POSITION OF TAB IN RULER / / IMPLICIT OUTPUT: GLOBAL: TABPOSITION, TABFLAGS / LOCAL: FINDT2, T3 / / COMPLETION CODE: NONE / SIDE EFFECTS: NONE / /-- FINDTP, XX DCA T1 / SAVE ENTRY OFFSET TAD I FINDTP / GET ADRESS OF POSITION COUNT DCA T2 / SAVE ADDRESS TAD T1 / RESTORE OFFSET TAD I T2 / ADD POSITION COUNT CIFMNU / GET DECIMAL CLASS AND POSITION /M208 JMS CALSWAP / CALL_A_ROUTINE IN EDITOR SWAP AREA /M208 FNTABSTOP / FIND_NEXT_TAB_STOP ROUTINE CDFEDT / DATA FIELD FOR ROUTINE DCA T3 / STORE TAB CLASS SWP / GET POSITION IN AC DCA TABPOSITION / STORE POSITION DCA TABFLAGS / CLEAR TAB_FLAGS TAD T3 / RESTORE TAB_CLASS TO AC TAD (-3) / CHECK FOR CLASS = DECIMAL TAB SZA CLA / SKIP IF:DECIMAL TAB JMP FINDT3 / NOT DECIMAL TAB ISZ TABFLAGS / SET BIT11 = DECIMAL TAB DETECTED TAD TABPOSITION / GET DECIMAL TAB POSITION CIA TAD I T2 / ADD POSITION COUNT SNA CLA / SKIP IF: DIRECTLY ALIGNED TO DECIMAL / TAB AC4000 / SET BIT1 = CHARACTER DIRECTLY ALIGNED / WITH DECIMAL TAB IN RULER TAD TABFLAGS / ADD CURRENT TAB_FLAGS DCA TABFLAGS / SAVE UPDATED TAB_FLAGS FINDT3, ISZ FINDTP / BUMP RETURN POINTER JMP I FINDTP / RETURN /++ / READ_NEXT_CHARACTER READNEXTCHARACTER / FUNTIONAL DESCRIPTION: READNEXTCHARACTER / / BUMP LINE_POSITION_COUNTER AND READ THE NEXT CHARACTER. / / CALLING SEQUENCE: JMS READNEXTCHARACTER / ETX RETURN / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: GLOBAL: CRWMB / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: GLOBAL: CRWMB, CRLMB / LOCAL: READNEXTCHARACTER / / COMPLETION CODE: 1) ETX CHARACTER RETURN TO CALLER+1. ALL OTHER / CHARACTERS RETURN CALLER+2. / / SIDE EFFECTS: NONE / /-- READNEXTCHARACTER, XX JMS ADUNIT / Advance one unit, returning characters/m247 / from within deadkeys, if required /m247 SKP / ETX RETURN ISZ READNEXTCHARACTER / BUMP RETURN POINTER DCA CRWMB / SAVE CHARACTER_READ_WITH_MODE_BITS TAD CRWMB / Get it back /a247 TAD (-ECSTOV) / Test for the start of a dead key /a247 SNA CLA / Is this a dead key sequence? /a247 ISZ DEADKEY / Yes, tickle the deadkey flag. /a247 TAD CRWMB / GET IT BACK AND P177 / STRIP MODE BITS DCA CRLMB / SAVE CHARACTER_READ_LESS_MODE_BITS JMP I READNEXTCHARACTER / RETURN /++ / READ_TAB_OR_LINE_END READTABORLINEEND / / FUNTIONAL DESCRIPTION: READTABORLINEEND / / THIS SUBROUTINE WILL CONTINUE TO READ CHARACTERS FROM A DOCUMENT / CURRENTLY BEING EDITED UNTIL ONE OF THREE CONDITIONS ARE MET: 1) READING / OF A TAB CHARACTER, 2) READING OF A LINE ENDING CHARACTER, OR 3) ETX / CHARACTER IS ENCOUNTED. IF A TAB IS READ THEN A SKIP RETURN IS MADE / TO THE CALLER. LINE ENDING AND ETX WILL RESULT IN A RETURN TO CALLER+1. / / CALLING SEQUENCE: JMS READTABORLINEEND / LINE_END OR ETX RETURN / TAB RETURN / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: GLOBAL: LNEPC, CRLMB, TABFLAGS / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: LOCAL: LNEPC, READTABORLINEEND / / COMPLETION CODE: 1) RETURN TO CALLER+1 IF LINE_END CHAR. OR ETX CHAR. / WAS ENCOUNTED DURING READ. / 2) RETURN TO CALLER+2 IF TAB CHAR. ENCOUNTED DURING / READ. / / SIDE EFFECTS: 1) LNEPC SET TO CHARACTER POSITION AT RETURN TIME. / 2) A CHECK IS PERFORMED AFTER THE READING OF EACH / CHARACTER TO TEST IF ITS DIRECTLY ALIGNED WITH / A DECIMAL TAB RULER SETTING. IF SO THEN / DTABCOUNT IS INCREMENTED. IF THE CHARACTER / IS AN ECTAB THEN AN ADDITIONAL CALL IS MADE / TO FINDTP SO THAT TABPOSITION, AND TABFLAGS / WILL REFLECT THE RULER SETTING ECTAB IS / ASSOCIATED WITH. / /-- READTABORLINEEND, XX TAD CRWMB / HAS CHARACTER BEEN READ ALREADY? SZA CLA / SKIP IF: SO JMP READT4 / PROCESS CHARACTER READT1, ISZ LNEPC / INCREMENT LINE POSITION COUNTER NOP / ALLOW FOR LNEPC = -1 JMS READNEXTCHARACTER / READ_NEXT_CHARACTER JMP READT2 / ETX RETURN AC7777 / CALL FINDTP TO SEARCH FOR TAB FROM / CURRENT LINE POSITION - 1 JMS FINDTP / FIND_TAB_POSITION LNEPC TAD TABFLAGS / CURRENT POSITION DIRECTLY ALIGNED WITH / A DECIMAL TAB? SPA CLA / SKIP IF: NOT JMS IDTABCOUNT / YES - INCREMENT DECIMAL TAB COUNT READT4, TAD CRLMB / GET CHARACTER_READ_LESS_MODE_BITS TAD (-ECTAB) / IS CHARACTER = TAB? SZA / SKIP IF: SO JMP READT3 ISZ READTABORLINEEND/ INCREMENT RETURN POINTER / ADJUST TABFLAGS AND TABPOSITION FOR THIS TAB JMS FINDTP / CALL FIND_TAB_POSITION LNEPC / LINE_POSITION_COUNTER JMP READT2 READT3, TAD (ECTAB-ECNWLN) / IS CHARACTER = NEW_LINE? SZA CLA / SKIP IF: SO JMP READT1 / NO - GO FOR NEXT CHARACTER READT2, JMP I READTABORLINEEND/ RETURN / SET CURPTR /++ / STCURPTR / / FUNTIONAL DESCRIPTION: SET_CURPTR / / SAVE CURRENT VALUE OF CURPTR. ADD OFFSET IN AC ON ENTRY WITH / CURRENT VALUE OF LINE23 TO PROVIDE NEW CURPTR VALUE. TO RESTORE / OLD CURPTR CALL RESCURPTR ROUTINE. / / CALLING SEQUENCE: JMS STCURPTR / / INPUT PARAMETERS: AC = OFFSET TO BE ADDED TO CURRENT VALUE OF LINE23 / / IMPLICIT INPUT: GLOBAL: CURPTR, LINE23 / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: GLOBAL: SAVCP, CURPTR / / COMPLETION CODE: NONE / SIDE EFFECTS: NONE / /-- STCURPTR, XX MQL / HOLD ONTO OFFSET CDFEDT TAD I (CURPTR) / SAVE CURPTR VALUE DCA SAVCP SWP / RESTORE OFFSET AND INITIALIZE POINTER / FOR READING LINE TAD I (LINE23) DCA I (CURPTR) CDFMYF JMP I STCURPTR / RETURN / RESTORE CURPTR RESCURPTR, XX MQL / SAVE VALUE IN AC TAD SAVCP / RESTORE CURPTR CDFEDT DCA I (CURPTR) CDFMYF SWP / RETORE AC JMP I RESCURPTR / RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / ENTIRE INSDEL ROUTINE /************************************************************************ / / / INSDEL / / / / EDITS MATH TEXT, DELETING PREVIOUS RESULTS & INSERTING / / NEW RESULTS AFTER HAVING DETERMINED THAT THESE FIT / / WITHOUT OVERLAPPING ANY OTHER FIELDS / / / /***********************************************************************/ / This routine is divided into four phases: scanning a line of text / preparing tables about the contents of the line, comparing the space / available on the line to the requirements determined by the results / to be inserted into the line, deleting any text in result fields from / previous passes, and inserting math results which are known to fit / into the slots which have been prepared for them. /***********************************************************************/ / / / PHASE 1 SCAN TEXT LINE PREPARING TABLE FLDDIM / / / /***********************************************************************/ / NUMEROUS CORRECTIONS AND REARRANGING OF CODE WERE MADE AS / PART OF THE INITIAL DEBUGGING OF INSDEL. THESE ARE TOO NUMEROUS / AND TOO FAR-REACHING TO BE WORTH LISTING INDIVIDUALLY. INSDEL, XX DCA DTABPR / SAVE DCHAR OR TCHAR POINTER JMS CLRZER / CLEAR TABLE AREAS FLDDIM -5^MXTABS+3 DCA FLDCNT / CLEAR FIELD COUNT TAD (FLDDIM) / INITIALIZE TABLE POINTER DCA REG1 JMS EDITINIT / INITIALIZE EDIT CURSOR POINTER DCA CHARCNT / OTHER VALUES DCA BEGFLD / LEFT BOUNDARY OF A FIELD DCA ENDFLD / RIGHT BOUNDARY OF A FIELD IAC DCA PCP / CURRENT COLUMN POSITION OF LINE DCA XPCP / EXTRA SPACES, SOFT (OR BETWEEN FLDS) DCA DTABN / COUNT OF DEC. TAB POSITIONS DCA FLAGS / THESE VALUES RETURNED BY GETTAB ISZ FLDCNT / DETERMINE CASE PH14, JMS NXCASE / GET NEXT CODE & RETURN ACCORDING TO CASE JMP PH15 / ALPHANUMERIC JMP PH141 / SPACE JMP PH17 / NEW LINE JMP PH16 / TAB JMP PH17 / OWN CODE JMP PH15 / DEAD KEY / CASE: SPACE OR SOFT SPACE PH141, TAD FLAGS / IF DTAB RESULT FIELD SMA CLA JMP PH142 TAD CHARCNT / THEN IF FIELD.CHAR.COUNT # 0 SNA CLA JMP PH142 TAD PCP / END PREVIOUS FIELD DCA ENDFLD JMS FLDSTRT / START NEW FIELD WITHOUT TAB. DCA FLAGS / CLEAR FLAGS & TABPCP,SINCE DCA TABPCP / NEW FIELD DOES NOT CORRESPOND DCA CHARCNT / TO ANY TAB POSITION. ISZ PCP / EXTRA INCR AFTER ALPHANUMERICS PH142, ISZ XPCP / INCR EXTRA SPACE COUNTER JMP PH14 / CASE: ALPHANUMERIC PH15, JMS INSEXTR / PCP=PCP+XPCP I.E. ADD EXTRA SPACES TO PCP DCA XPCP / CLEAR EXTRA SPACES COUNTER TAD CHARCNT / FIND OUT IF THIS ALPHANUMERIC BEGINS A FIELD SZA CLA JMP PH151 TAD PCP DCA BEGFLD / SET NEW BEGINNING OF FIELD SKP PH151, ISZ PCP / INCR PRINT CHARACTER POSITION ISZ CHARCNT / INCR CHAR. COUNT JMP PH14 / CASE: TAB CODE PH16, TAD CHARCNT / IF FIELD.CHAR.COUNT = 0 SZA CLA JMP PH161 JMS INSEXTR / PCP=PCP+XPCP I.E. ADD EXTRA SPACES TO PCP DCA XPCP TAD PCP / SET FIELD BEGINNING ADDRESS DCA BEGFLD AC7777 TAD FLDCNT / IF BEGINNING OF LINE, THEN DO NOT START SNA CLA / A FIELD ON A BLANK TAB JMP PH162 PH161, AC2000 / IF RIGHT-JUSTIFIED FIELD, THEN AND TABPCP / DO NOT ELIMINATE ANY TRAILING SZA CLA / SPACES. TAD XPCP TAD PCP / COMPLETE PREVIOUS FLDDIM ENTRY DCA ENDFLD JMS FLDSTRT / AND START NEXT ONE JMS INSEXTR / PCP=PCP+XPCP I.E. ADD EXTRA SPACES TO PCP TAD XPCP / CHECK FOR ZONE TO SWEEP AFTER! LAST FIELD SNA CLA /C236 JMP PH162 JMP PH162 / *** T E M P O R A R Y F I X FOR MATH BUG /A236 / *** DISABLE SWEEPING ZONE FOR TABS BECAUSE /A236 / *** IT DOES NOT WORK RIGHT AND CAN CAUSE A /A236 / *** SYSTEM HALT FROM RECURSIVE CALLS TO REJUST/A236 TAD PCP / YES! SWEEP THIS ZONE FOR TABS. IAC / BUMP END COUNT BY ONE /C236 MQL / IT BEGINS AT END OF LAST FIELD & TAD ENDFLD / ENDS AFTER EXTRA SPACES FOLLOWING JMS TABCHK / THIS FIELD. PH162, DCA XPCP ISZ PCP / INCREMENT POSITION COUNTER TAD PCP / GET NEXT TAB POSITION TO BEGIN FIELD JMS GETTAB SZA ISZ DTABN / COUNT DTAB POSITION, IF ANY DCA FLAGS / THESE VALUES RETURNED BY GETTAB ACL DCA TABPCP TAD CHARCNT / IF FIELD IS BLANK SZA CLA / THEN DO NOT DO EXTRA INCREMENT ISZ PCP / OF PCP. EXTRA IS REQUIRED SINCE ISZ FLDCNT / FIRST ALPHANUMERIC OF EACH FIELD DCA CHARCNT / IS NOT COUNTED IN ORDER TO RETARD JMP PH14 / PCP. / CASE: CR OR WORD-WRAP CODE PH17, AC2000 / IF RIGHT-JUSTIFIED FIELD, THEN AND TABPCP / DO NOT ELIMINATE ANY TRAILING SZA CLA / SPACES. TAD XPCP TAD PCP / UPDATE POSITION, PCP DCA PCP JMS INSFEND / GO END CURRENT FIELD, IF ANY AC7777 TAD RIGHTM / SAVE RIGHT MARGIN IN MQ FOR TAB CHECK BELOW MQL AC2000 / THEN IF LINE ENDS WITH A WORD-WRAP AND CRWMB SNA CLA JMP PH171 TAD ENDFLD IAC / THEN SET ABSOLUTE MARGIN AT SKP / THE END OF THAT FIELD PH171, TAD RIGHTM / SET ABSOLUTE MARGIN=RIGHT MARGIN DCA ABSOLM TAD ENDFLD / CREATE ENTRIES IN FLDDIM FOR ALL TAB IAC JMS TABCHK / POINTS TO THE RIGHT OF THE CR JMP PHASE2 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /***********************************************************************/ / / /PHASE 2 DETERMINE IF RESULTS FIT INTO AVAILABLE SPACE / / / /***********************************************************************/ / Phase 2 matches the entries in FLDDIM is order to assure that there / are no overlaps. The ending location of each field is matched against / the beginning location of the next field. The latter must always be / a greater number if there is no overlapping. If two fields do overlap, / then the program will determine if one or both of the fields are / result fields and take an error exit appropriate to the case. PHASE2, DCA REG4 / CLEAR REG4 SO THAT FIRST MATCH WORKS TAD (FLDDIM-5) / INITIALIZE LIST POINTER DCA REG1 PH21, JMS GETFLDS / GET NEXT ENTRY FROM FLDDIM TO MATCH AGAINST NEWCON JMP PHASE3 / END LIST RETURN, EXIT TO NEXT PHASE JMS INSBLANK / CHECK FOR TAB-ONLY ENTRY CLA /A236 /D236 AC7777 / NOT TAB-ONLY RETURN: DECR BEGFLD TAD BEGFLD / TAB-ONLY RETURN SPA SNA / DO NOT LET BEGFLD BECOME <= 0 IAC DCA BEGFLD / SAVE RETURNED LEFT BOUNDARY TAD REG4 / MATCH RIGHT BOUNDARY OF PREVIOUS FIELD CIA / AGAINST LEFT BOUNDARY OF UPCOMING TAD BEGFLD / FIELD SPA SNA CLA / RIGHT BOUNDARY MUST BE GREATER, JMP FLDERR / OTHERWISE, ERROR JMS SETFEND / ESTABLISH END OF THIS FIELD FOR NXT LOOP AC7777 / TAB-ONLY RETURN-DECR ENDFLD TAD ENDFLD / AND STORE VALUE IN REG4 DCA REG4 TAD ENDFLD / CHECK CURRENT ENDFLD AGAINST LINE END CIA TAD ABSOLM / DO NOT EXCEED ABSOLUTE END OF LINE SPA CLA JMP FLDERR JMP PH21 /***********************************************************************/ / ERROR EXIT / /***********************************************************************/ FLDERR, JMS RESCURPTR / RESET CURSOR TO VALUE PRIOR TO MATH TAD (FLDER1) / SETUP POINTER TO STORE ERROR DATA IN DCA REG3 / CALLING SEQUENCE DCA FLDER2 DCA FLDER4 TAD (-5) / GET POINTER TO PREVIOUS ITEM IN FLDDIM TAD REG1 DCA REG2 / AND PUT IT INTO REG2 TAD REG2 / MAKE SURE DO NOT BACK UP BEYOND TABLE TAD (-FLDDIM) / BEGINNING SPA CLA JMP FLDERA TAD I REG2 SMA / WAS THE PREVIOUS FIELD A RESULT FIELD? JMP FLDERA JMS GETRES / GET BCD RESULT POINTER DCA FLDER3 / AND PUT IT INTO CALLING SEQ. ISZ REG2 AC7777 TAD I REG2 / GET TAB PCP & PUT THIS AND P377 / INTO CALLING SEQ. DCA FLDER1 ISZ REG3 FLDERA, CLA TAD I REG1 / IS THE CURRENT FIELD A RESULT FIELD? SMA JMP FLDERB / IF YES, THEN JMS GETRES / AND PUT IT INTO CALLING SEQ. MQL ISZ REG1 / GET TAB PCP & PUT THIS AC7777 TAD I REG1 / INTO CALLING SEQ. AND P377 DCA I REG3 ACL / RECOVER SAVED POINTER ISZ REG3 / INCR TO NEXT SLOT ISZ REG3 DCA I REG3 / PUT POINTER INTO PARAM LIST FLDERB, CLA TAD REG3 / SET ERROR CODE TO ERNOSP IF ONLY ONE TAD (-FLDER3) / RESULT FIELD TO BE DISPLAYED SPA SNA CLA / OR TO ERNSP2 IF TWO RESULT JMP FLDERC / FIELDS TO BE DISPLAYED. TAD (ERNSP2) SKP FLDERC, TAD (ERNOSP) JMS EDERR-1 / EXIT TO ERROR WITH ERNOSP ERROR CODE FLDER1, XX / PCP OF DTAB OF 1ST OVERLAPPING FIELD FLDER2, XX / 0 OR PCP OF DTAB OF 2ND OVERLAPPING FIELD FLDER3, XX / POINTER TO BCD RESULTS, CONTENTS OF 1ST FIELD FLDER4, XX / 0 OR PTR TO BCD RESULTS, CONTENTS OF 2ND FIELD / NOTE: NO RETURN IS MADE FROM ABOVE "JMS" WHEN ERROR IS CALLED!!! / "JMS" WAS USED INSTEAD OF "JMP" IN ORDER TO PASS ADDRESS OF THE / PCP'S & POINTERS. /************************************************************************/ / NORMAL (NON-ERROR) EXIT / /************************************************************************/ INSEXIT,JMS CALREJ / CALLED EDITOR REJUSTIFY ROUTINE TAD INSDEL / SET UP TO EXIT DCA T1 JMP I T1 / EXIT /******************************SUBROUTINE*******************************/ / This routine will set up and call the editor rejustify routine CALREJ, XX CDFEDT AC7777 DCA I (REJFLG) / SET EDITOR REJUSTIFY CONDITION CDFMYF CIFEDT JMS CALLAR / CALL EDITOR REJUSTIFY REJUST / ADDRESS OF ROUTINE IN EDITOR CDFBUF / DATA FIELD FOR REJUST TO USE CLA CLL JMP I CALREJ / RETURN TO CALLER /******************************SUBROUTINE*******************************/ / ROUTINE USED BY PHASE1 (SCAN OF DATA) TO DETERMINE THE CONDITIONS AT THE / END OF TEXT LINE (FINDING CR) INSFEND,XX TAD CHARCNT / IF FIELD.CHAR.COUNT # 0 SNA CLA JMP INSF1 TAD PCP / THEN COMPLETE FLDDIM ENTRY JMP INSF2 INSF1, AC7777 / IF 0, THEN LOOK FOR EMPTY LINE TAD FLDCNT / I.E. CR ONLY SNA CLA JMP I INSFEND / IF SO, THEN EXIT TAD TABPCP / ELSE CREATE BLANK TAB ENTRY AND P377 DCA BEGFLD / SET BEGFLD=ENDFLD=TABPCP TAD BEGFLD INSF2, DCA ENDFLD JMS FLDSTRT / UNDATE FLDDIM TABLE JMP I INSFEND /******************************SUBROUTINE*******************************/ X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /***********************************************************************/ / / / PHASE 3 DELETE ANY TEXT FOUND IN RESULT FIELDS / / / /***********************************************************************/ PHASE3, JMS EDITINIT / INITIALIZE EDIT CURSOR POINTER TAD (FLDDIM-5) / INITIALIZE TABLE TWO POINTER & DCA REG1 / COL.POSITION COUNTER IAC / INITIALIZE PCP TO 1 DCA PCP DCA REG3 / CLEAR TAB FLAG PH31, JMS GETFLDS / GET NEXT ENTRY: FLAGS TABPCP BEGFLD ENDFLD OLDCON NOP / DO NOT EXIT UNTIL LINE END CODE FOUND / DETERMINE CASE PH32, JMS NXCASE / GET NEXT CODE & RETURN ACCORDING TO CASE JMP PH321 / ALPHANUMERIC JMP PH322 / SPACE JMP PH324 / NEW LINE JMP PH323 / TAB JMP PH323 / OWN CODE JMP PH321 / DEAD KEY / CASE: ALPHANUMERIC PH321, TAD BEGFLD / TEST FOR POSITION ON LINE CIA / EITHER STARTING A NEW FIELD TAD PCP / OR CONTINUING A FIELD SMA SZA CLA JMP PH3211 TAD REG3 / STARTING A FIELD - CHECK FOR TAB SZA CLA JMP PH3210 TAD (ECMTH1+400) / IF THERE IS NO TAB, THEN INSERT JMS INSFORCE / OWN FIELD MARKER JMP PH3212 PH3210, TAD FLAGS / CHECK FOR PREVIOUS RESULT FIELD SMA CLA JMP PH3212 JMS DELCODE / DELETE CODE FROM EDIT BUFFER ACL / GET ATTRIBUTES SAVED BY DELCODE AND (MASKATTR) MQL / SAVE ATTRIBUTES IN MQ TAD I REG1 / GET PRESENT VALUE FROM FLDDIM MQA / & "OR" ATTRIBUTES DCA I REG1 / THEN RESTORE INTO FLDDIM. PH3211, TAD FLAGS / CHECK RESULT FIELD (DELETION) SPA CLA JMS DELCODE / YES, DELETE THIS CHARACTER PH3212, DCA REG3 / CONTINUING A FIELD - CLEAR TAB COUNTER & TAD ENDFLD / CHECK FOR POSITION ON LINE CIA / EITHER ENDING FIELD TAD PCP / OR CONTINUING A FIELD ISZ PCP / INCR POSITION ON LINE SPA CLA JMP PH32 / CONTINUING FIELD - GET NEXT CODE JMP PH31 / ENDING A FIELD - GET NEXT FIELD ENTRY / CASE: SPACE OR SOFT SPACE PH322, TAD BEGFLD / TEST FOR POSITION ON LINE CIA / EITHER LESS THAN BEGINNING A FIELD TAD PCP / OR GREATER THAN ENDING A FIELD SPA SNA CLA / OR WITHIN A FIELD: JMP PH3221 / IN EITHER OF THE FIRST TAD ENDFLD / TWO CASES - DELETE THE CIA / SPACE, OTHERWISE, TAD PCP / CONTINUE SPA SNA CLA JMP PH3222 PH3221, ISZ PCP / INCR POSITION ON LINE TAD CRWMB / IF OUTSIDE A FIELD, THEN AND (400) / DELETE SPACE UNLESS UNDERLINED SZA CLA JMP PH32 JMS DELCODE / DELETE CODE FROM EDIT BUFFER JMP PH32 PH3222, TAD ENDFLD / CHECK FOR POSITION ON LINE CIA / EITHER ENDING FIELD TAD PCP / OR CONTINUING A FIELD ISZ PCP / INCR POSITION ON LINE SPA CLA JMP PH32 / CONTINUING FIELD - GET NEXT CODE JMP PH31 / ENDING A FIELD - GET NEXT FIELD ENTRY / CASE: TAB PH323, ISZ REG3 / SET TAB FLAG ISZ PCP / & INCR POSITION ON LINE AC2000 AND FLAGS / CHECK FOR FORCED TAB SZA CLA JMP PH3232 / IF FOUND, THEN GO FORCE IT. JMS INSBLANK / CHECK FOR BLANK FIELD JMP PH32 / NON-BLANK RETURN - CONTINUE PH3231, JMS GETFLDS / ELSE GET NEXT ENTRY & OLDCON / CONTINUE TO CHECK FOR /D236 NOP JMP PH32 PH3232, JMS INSTAB / FORCED-TAB INSERTIONS JMP PH32 / NON-SKIP, DONE JMP PH3231 / SKIP, CONTINUE / CASE: NEW LINE PH324, TAD REG1 / SAVE FLDDIM POINTER DCA SVREG1 PH3241, TAD FLAGS / OTHERWISE, CHECK FOR RESULTS FIELD SPA CLA / THROUGH REST OF LIST JMP PH3242 JMS GETFLDS / GET NEXT ITEM FROM LIST OLDCON JMP PHASE4 / IF END OF LIST IS FOUND, EXIT THIS PHASE JMP PH3241 PH3242, TAD SVREG1 / IF A RESULT, THEN GO INSERT FORCED-TABS DCA REG1 / BEFORE NEW LINE CODE PH3243, JMS INSTAB / INSERT TAB JMP PHASE4 / NON-SKIP, DONE JMS GETFLDS OLDCON JMP PHASE4 JMP PH3243 SVREG1, 0 /****************************SUBROUTINE*********************************/ INSTAB, XX AC2000 / LOOK FOR BIT CALLING FOR FORCED TAB AND FLAGS SNA CLA JMP I INSTAB / NON-SKIP RETURN, DONE TAD (ECTAB) / IF FORCED TAB BIT FOUND JMS INSFORCE / THEN INSERT TAB CODE ISZ INSTAB JMP I INSTAB / SKIP RETURN, CONTINUE /****************************SUBROUTINE*********************************/ X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /***********************************************************************/ / / / PHASE 4 INSERT RESULTS IN ASCII INTO PREPARED FIELDS / / / /***********************************************************************/ PHASE4, JMS EDITINIT / INITIALIZE EDIT CURSOR POINTER TAD (FLDDIM-5) DCA REG1 DCA FLDCNT / CLEAR FIELD COUNTER CDFEDT TAD I (CURUL+NWLMAR-NWRUL) / GET VALUE OF LEFT MARGIN CDFMYF / AND SET PCP DCA PCP / DETERMINE CASE PH41, JMS NXCASE / GET NEXT CODE & RETURN ACCORDING TO CASE JMP PH411 / ALPHANUMERIC JMP PH412 / SPACE JMP PH414 / NEW LINE JMP PH413 / TAB JMP PH415 / OWN CODE JMP PH411 / DEAD KEY / CASE: ALPHANUMERIC PH411, ISZ PCP / INCR POSITION ON LINE JMP PH41 / CASE: SPACE OR SOFT SPACE PH412, ISZ PCP / INCR POSITION ON LINE JMP PH41 / CASE: TAB PH413, JMS GETFLDS / GET FLAGS, TABPCP, BEGFLD, ENDFLD NEWCON JMP INSEXIT / NON-SKIP RETURN, END OF INSERTIONS JMS INSBLANK / CHECK FOR BLANK FIELD SKP / NON-BLANK RETURN JMP PH41 / BLANK - GO GET NEXT CODE TAD BEGFLD / SET PCP=BEGINNING OF FIELD DCA PCP TAD FLAGS / CHECK FOR DTAB RESULT FIELD SMA CLA JMP PH41 TAD FLAGS / GET POINTER TO BCD RESULT JMS GETRES TAD (-1) / OFFSET POINTER RETURNED FROM GETRES DCA PH4131 / AND THEN DO BCD TO ASCII CONVERSION, JMS BCDASC PH4131, XX NUMBUF CDFMYF DCA REG3 DCA I REG3 TAD (NUMBUF) / AND FINALLY TRANSFER ASCII NUMBER DCA REG3 / FROM NUMBUF TO PH4132, TAD I REG3 / INSERTION INTO THE SNA CLA / EDIT BUFFER. JMP PH41 JMS READNEXT / MOVE CURSOR POINTER ONE PLACE RIGHT NOP TAD I REG3 / GET ASCII CODE FROM NUMBUF MQL TAD FLAGS AND (MASKATTR) / GET ATTRIBUTES, SWP / CHARACTER & JMS INSMCH / INSERT INTO EDIT BUFFER. ISZ PCP ISZ REG3 JMP PH4132 / CASE: NEW LINE PH414, JMP INSEXIT / GO TO REJUSTIFY & EXIT / CASE: OWN CODE, I.E. CODE INSERTED TO MARK NON-TAB, NON-DTAB FIELDS PH415, JMS DELCODE / DELETE ECMTH1+400 FIELD MARKER JMS GETFLDS / SET FLAGS TABPCP BEGFLD ENDFLD NEWCON JMP INSEXIT / NON-SKIP RETURN ENDS INSERTION PH4151, TAD BEGFLD / THEN INSERT SPACES, AS CIA / NEEDED TO ARRIVE AT BEGINNING TAD PCP / OF FIELD. SMA CLA JMP PH41 TAD (ECSPC) JMS INSCODE / INSERT SPACE INTO EDIT BUFFER ISZ PCP JMP PH4151 /******************************SUBROUTINE*******************************/ / GET flags tabpcp begfld (new/old dimensions) endfld (new/old dimensions) / FROM THE NEXT ENTRY IN FLDDIM GETFLDS,XX TAD I GETFLDS / GET PARAMETER IDENTIFYING TYPE OF CONTENTS DCA GETF2 ISZ GETFLDS GETF1, TAD REG1 / ADVANCE POINTER TO NEXT ENTRY IN FLDDIM TAD (5) DCA REG1 JMS GETITEM / GET NEXT LEFT & RIGHT BOUNDARIES GETF2, XX / RETURNS END LIST OR AC=LT BOUNDARY JMP I GETFLDS / MQ=RT BOUNDARY SNA JMP GETF1 / GET NEXT ENTRY IF ENTRY IS BLANK. DCA BEGFLD TAD REG1 / GET FLAGS & TAB PCP FROM SAME ENTRY DCA REG2 TAD I REG2 / GET FLAGS DCA FLAGS ISZ REG2 TAD I REG2 / GET TAB PCP DCA TABPCP ACL DCA ENDFLD / GET ENDFLD ISZ FLDCNT / INCR FIELD COUNT ISZ GETFLDS / TAKE SKIP RETURN JMP I GETFLDS /******************************SUBROUTINE*******************************/ / "CKSCLT" CHECKS TO SEE IF IN SELECT MODE AND IF SO THEN SHUTS DOWN / MATH FOR A PARTICULAR WORK AREA WHETHER IN THAT AREA OR NOT. THIS / IS CLEANER THAN TRYING TO DETERMINE IF IN SELECT MODE AND IN EDITOR / MATH WORK AREA ( WHICH MUST INCLUDE SOME WAY TO TELL IF JUST STARTING / ONE BUT NOT CONFIRMED YET, I.E. SELECT MODE HIT AT A "BEGIN" COMMAND), / AND THEN HAVING TO SHUT DOWN MATH ANYWAYS. / / IF IN "SELECT MODE" / | THEN SHUT DOWN MATH IN CASE IN WORK AREA / | RETURN TO EDITOR / | ELSE RETURN TO CALLER TO CONTINUE PROCESSING / CKSCLT, XX CDFEDT / GET EDITOR DATA FIELD TAD I (ESLMOD+1) / GET SELECT MODE FLAG AND I (EDMODE) / AND IT WITH THE EDITOR MODE CDFMYF / RETURN TO THIS DATA FIELD SNA CLA / IS THE EDITOR IN SELECT MODE? JMP I CKSCLT / NO: RETURN TO CALLER TO CONTINUE PROCESSING JMS SCRINI / YES: SHUT MATH DOWN IN CASE SELECT DONE IN / EDITOR MATH WORK AREA JMP BKEDIT / RETURN TO EDITOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /***********************************************************************/ / / / PROGRAM SUBROUTINES / / / /***********************************************************************/ /****************************SUBROUTINE*********************************/ / INITIALIZE EDIT CURSOR POINTER TO START OF LINE EDITINIT,XX CDFEDT TAD I (CURUL+NWRMAR-NWRUL) / GET RIGHT MARGIN DCA RIGHTM TAD I (CURUL+NWLMAR-NWRUL) / GET LEFT MARGIN DCA TABPCP / SAVE LEFT MARGIN SETTING AC7777 TAD I (LINE23) / GET POINTER TO BEGINNING OF LINE-1 DCA I (CURPTR) / AND INITIALIZE CURSOR POINTER CDFMYF JMP I EDITINIT /****************************SUBROUTINE*********************************/ / GETS THE NEXT TAB POSITION FROM RULER & RETURNS DATA ABOUT IT: / RETURNS MQ0=1 RIGHT MARGIN AC0=1 RESULT FIELD / MQ1=1 > OR J OR R AC6-11 DTAB NUMBER / MQ4-11 TAB PCP GETTAB, XX TAD (-1) / ADJUST PTR SINCE CURUL COUNTS FROM 0 MQL / RESET RULER POSITION POINTER GT0, ACL / AC=POSITION WITH WHICH TO START SEARCH CIFMNU /M208 JMS CALSWAP / CALL_A_ROUTINE IN EDITOR SWAP AREA /M208 FNTABSTOP / FIND NEXT TAB STOP CDFEDT AND (0003) / MAKE SURE VALUE DOES NOT EXCEED LIMIT TAD (TABCLASS) / ADD PTR TO DISPATCH TABLE DCA GT1 / SAVE IN GT1 FOR INDIRECT TAD I GT1 / GET ADDR OF TYPE ROUTINE DCA GT1 ACL / GET TAB POSITION INTO AC IAC / & INCREMENT (VALUE IS RETURNED 1 TO LEFT) MQL / & RETURN TO MQ JMP I GT1 / GOTO EXECUTE ROUTINE PER TYPE GT1, 0 TABCLASS, GT2 GT3 GT4 GT5 / TYPE 0 - L D C N H F / TYPE 1 - T W P GT2= . GT3= . JMP I GETTAB / TYPE 2 - > J R GT4, ACL CIA TAD RIGHTM / CHECK FOR RIGHT MARGIN SETTING SNA CLA AC4000 / SET FLAG FOR RIGHT MARGIN TAD (2000) / SET FLAG FOR > OR J TAB MQA MQL / MQ=TABCLASS+PCP - AC=FLAGS=0 JMP I GETTAB / EXIT / TYPE 3 - . GT5, TAD DTABN / GET NEXT DTAB NUMBER IAC JMS GETRES / GET RESULT BIT & IGNORE POINTER CLA RAR / SHIFT BITS TO COMBINE WITH PCP TAD DTABN / MQ=PCP AC0=1 & AC6-11=DTAB NO. IAC JMP I GETTAB /****************************SUBROUTINE*********************************/ / INSERT CONTENTS OF AC INTO TABLE FLDDIM AT REG1 INDIRECT + PARAMETER / REG1 ON ENTRY IS ASSUMED TO POINT TO CURRENT / ENTRY IN FLDDIM TABINS, XX DCA TREG4 / SAVE AC TAD REG1 / REG3 = FLDDIM + 2*FLDCNT + PARAMETER TAD I TABINS DCA TREG3 TAD TREG4 / RECOVER SAVED AC & DCA I TREG3 / PUT INTO TABLE. ISZ TABINS / END OF PREVIOUS FIELD JMP I TABINS TREG3, 0 TREG4, 0 /****************************SUBROUTINE*********************************/ / COPY VALUES FROM LOCATIONS flags tabpcp begfld endfld / INTO FLDDIM TABLE. ALSO, IF THE FIELD DESCRIBED IS A RESULTS FIELD, / THEN GET THE LENGTHS LEFT & RIGHT OF DECIMAL DIGIT OF THE RESULT / AND COPY INTO FLDDIM. / REG1 IS ASSUMED TO POINT TO NEXT SLOT IN FLDDDIM FLDSTRT,XX TAD FLAGS JMS TABINS / SET FIRST TABLE ITEM = FLAGS 0 TAD CHARCNT / CHECK FOR EMPTY FIELD, TAB ONLY SNA CLA TAD (1000) / IF EMPTY, THEN SET TAB ONLY BIT TAD TABPCP JMS TABINS / SET SECOND TABLE ITEM = TAB PCP 1 TAD BEGFLD JMS TABINS / SET THIRD TABLE ITEM = LEFT BOUNDARY 2 TAD ENDFLD JMS TABINS / SET FOURTH TABLE ITEM = RIGHT BOUNDARY 3 TAD FLAGS / CHECK FOR DTAB RESULT FIELD SMA CLA JMP FLDS2 TAD DTABN / IF DTAB RESULT FIELD, THEN GET LENGTHS JMS GETRES / GET POINTER TO BCD NO. FROM DCHAR/TCHAR TAD (-1) / AND ADJUST IT. DCA FLDS1 JMS BCDASC / CALL BCD TO ASCII CONVERSION FLDS1, XX / RETURNS: MQ=LEFT.RIGHT NUMBUF / LEFT=DIGITS LEFT OF DECIMAL CDFMYF / RIGHT=DEC.DIGITS INCLUDING DECIMAL ACL JMS TABINS / SET FIFTH TABLE ITEM = 0 OR RESULTS LENGTHS 4 FLDS2, TAD REG1 / INCREMENT TABLE POINTER TO NEXT ENTRY SLOT TAD (5) DCA REG1 TAD ENDFLD / SAVE RIGHT BOUNDARY OF SEARCH ZONE MQL TAD FLAGS / CHECK FOR DTAB FIELD SNA CLA JMP FLDS3 TAD TABPCP / IF DTAB FIELD, THEN SKP / BEGIN SEARCH AFTER DTAB FLDS3, TAD BEGFLD / SWEEP ZONE OF FIELD JUST CREATED FOR TAD (4000) / SKIPPED TABS - THESE MUST BE JMS TABCHK / PUT INTO LIST TO CATCH ANY RESULT JMP I FLDSTRT / DTABS UNUSABLE WITHIN ANOTHER FIELD /****************************SUBROUTINE*********************************/ / BKEDI4 Moved here this edit to gather space in one place /a247 / AN EXIT IS DONE FROM THE "EXTRACTNUMBER" ROUTINE THRU "BKEDI4" / WHEN CONDITIONS ON THE TOTAL LINE OF EDITOR MATH ARE SUCH AS TO NOT / ALLOW A PROPER PARSING OF THAT LINE BECAUSE IT IS TERMINATED BY A / SOFT RETURN OR, NOT TO ALLOW INSERTION OF THE TOTAL VALUE BECAUSE / A RULER CHANGE WITH NO DECIMAL TABS IN IT HAS BEEN INSERTED PREVIOUS / TO THE TOTAL LINE. THIS CODE TRAPS THESE CONDITIONS BY RESETTING THE / "TOTAL" FLAG TO REFLECT THE ABOVE - THUS TURNING OF TOTALS INSERTION BKEDI4, CDFMTH / CHANGE TO MATH DATA FIELD DCA I (MTHTOT) / SET "TOTAL" FLAG TO FALSE CDFMYF / RETURN TO THIS DATA FIELD JMP BKEDI3 / GO RESET CURPTR & RETURN TO THE EDITOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /****************************SUBROUTINE*********************************/ / CHECK FOR RULER-DEFINED TABS BETWEEN FIELDS & CREATE DUMMY FLDDIM ENTRIES / AC=LEFT LIMIT OF ZONE TO SWEEP / PLUS AC0=0 MEANS SWEEP IS BETWEEN FIELDS / AC0=1 MEANS SWEEP INTERIOR OF A FIELD /MQ=RIGHT LIMIT OF ZONE TO SWEEP TABCHK, XX DCA REG2 / SAVE IN ORDER TO CHECK LATER FOR TYPE TAD REG2 / OF CALL: SWEEP FIELD OR BETWEEN FIELDS DCA REG3 / SAVE LEFT LIMIT OF ZONE TO CHECK FOR TABS ACL DCA REG4 / SAVE RIGHT LIMIT OF ZONE TO CHECK FOR TABS TAB1, TAD REG3 AND P377 / GET ORIGINAL OR NEW LEFT LIMIT JMS GETTAB / SEARCH TABLE ONE FOR NEXT GREATER TAB SWP / MAKE AC=TAB POSITION,MQ=FLAGS SNA JMP I TABCHK / EXIT IF NO FURTHER TAB POINTS FOUND DCA REG3 / SAVE POSITION IF GREATER TAB POINT IS FOUND TAD REG3 AND P377 / CHECK IF THIS POSITION < RIGHT LIMIT CIA TAD REG4 SPA CLA JMP I TABCHK / NO - EXIT ACL SZA CLA ISZ DTABN / COUNT DTAB POSITION TAD REG2 / DO NOT FLAG TO FORCE TAB UNLESS RAL / CALL IS TO SWEEP BETWEEN FIELDS! ACL / GET FLAGS - RETURNED BY GETTAB ABOVE SNL TAD (2000) / SET BITS TO FORCE INSERTION OF TAB JMS TABINS / CREATE TAB POSITION ENTRY 0 / PUT FLAGS WORD INTO FLDDIM TAD REG3 JMS TABINS / PUT TABPCP WORD INTO FLDDIM 1 ACL SMA CLA / IF DTAB RESULT FIELD, THEN FILL OUT JMP TAB3 / BEGFLD TAD REG3 / ENDFLD AND P377 / NEW.DIMENSIONS JMS TABINS 2 TAD REG3 AND P377 / BEGFLD & ENDFLD = TAB POSITION JMS TABINS 3 TAD DTABN JMS GETRES / NEW.DIMENSIONS = VALUE OF MQ RETURNED TAD (-1) / BY BCDASC ROUTINE DCA TAB2 JMS BCDASC TAB2, XX NUMBUF CDFMYF ACL JMS TABINS / PUT NEW.DIMENSIONS INTO TABLE 4 AC6000 TAD I REG1 / CHECK FOR RESULT FIELD WHERE TAB SMA CLA / CANNOT BE FORCED JMP FLDERR / IF FOUND, THIS IS AN ERROR! TAB3, TAD (5) / ADVANCE TO NEXT ENTRY SLOT TAD REG1 DCA REG1 JMP TAB1 /****************************SUBROUTINE*********************************/ / ACCESS DCHAR OR TCHAR AND BCD TABLES / CALL WITH AC = REL. NO. OF DTAB TO CHECK / RETURNING AC = POINTER TO BCD RESULTS / LINK = 1 IF FIELD IS A RESULT FIELD GETRES, XX AND P77 / SUPPRESS FLAG BITS TAD (-1) / TABLE ACCESSES COUNT DTAB'S FROM 0 CLL / CLEAR LINE IN CASE OF NULL RETURN TAD DTABPR / GET ADDR OF RESULTS TABLE DCA GREG4 / SET ADDR OF ENTRY IN RESULTS TABLE TAD I GREG4 / MAKE SURE THERE IS A POINTER IN DCHAR SNA / OTHERWISE, JMP I GETRES / EXIT IF NO POINTER IN DCHAR DCA GREG3 / SAVE PTR TO DTAB VALUE CDFMTH / DTAB VALUE IN IN FIELD SIX TAD I GREG3 / GET FIRST WORD OF VALUE (FLAGS) CDFMYF AND (400) / SAVE RESULT BIT (1 IF RESULT) CLL RTL / IN LINK RTL TAD I GREG4 / RETURN POINTER IN AC JMP I GETRES GREG3, 0 GREG4, 0 /****************************SUBROUTINE*********************************/ / GET NEXT CODE FROM EDIT BUFFER AND DETERMINE CASE / RETURN IS AT RETURN + n as follows: / 0 alphanumeric / 1 space / 2 new line / 3 tab / 4 own code / 5 dead key NXCASE, XX JMS SVNTO8 / GET NEXT CODE JMP NXCR2 / ETX RETURN GOES TO NEW LINE TAD CRLMB / AC=CODE WITHOUT ATTRIBUTES TAD (-ECSPC) / MATCH AGAINST SPACE CODE SMA SZA / IS IT GREATER THAN SPACE JMP NXCR0 / IT'S GREATER: GO HANDLE ALPHANUMERIC SNA / IS IT EQUAL TO SPACE JMP NXCR1 / IT'S EQUAL: GO HANDLE SPACE TAD (ECSPC-ECTAB) / MATCH AGAINST TAB CODE SMA SZA / IS IT GREATER THAN TAB JMP NXCR2 / IT'S GREATER: GO HANDLE NEW LINE SNA / IS IT EQUAL TO TAB JMP NXCR3 / IT'S EQUAL: GO HANDLE TAB TAD (ECTAB-ECMTH1) / MATCH AGAINST OUR OWN INSERT CODE SZA CLA / IF EQUAL: THEN GO HANDLE OUR OWN CODE NXCR5, ISZ NXCASE / DEAD KEY RETURN NXCR4, ISZ NXCASE / OUR OWN CODE RETURN NXCR3, ISZ NXCASE / TAB RETURN NXCR2, ISZ NXCASE / NEW LINE RETURN NXCR1, ISZ NXCASE / SPACE RETURN NXCR0, CLA / ALPHANUMERIC RETURN - CLEAR UNWANTED VALUE JMP I NXCASE / RETURN TO CALLER /D236 NXCASE, XX /D236 JMS READNEXT / GET NEXT CODE /D236 JMP NXC1 / ETX RETURN GOES TO NEW LINE /D236 TAD CRLMB / AC=CODE WITHOUT ATTRIBUTES /D236 JMS MATCH / MATCH AGAINST SPACE /D236 ECSPC /D236 JMP I NXCASE / GREATER: ALPHANUMERIC /D236 JMP NXC1 / LESS: FUNCTION /D236 ISZ NXCASE /D236 JMP I NXCASE / EQUAL: SPACE /D236 NXC1, ISZ NXCASE /D236 ISZ NXCASE /D236 TAD CRLMB /D236 JMS MATCH / MATCH AGAINST TAB CODE /D236 ECTAB /D236 JMP I NXCASE / GREATER: NEW LINE /D236 JMP NXC2 / LESS: DEAD KEY OR OWN CODE /D236 ISZ NXCASE / EQUAL: TAB /D236 JMP I NXCASE /D236NXC2, ISZ NXCASE /D236 ISZ NXCASE /D236 TAD CRLMB /D236 TAD (-ECMTH1) / MATCH AGAINST OWN INSERT CODE /D236 SZA CLA / EQUAL: OWN INSERT CODE /D236 ISZ NXCASE / UNEQUAL: DEAD KEY /D236 JMP I NXCASE /****************************SUBROUTINE*********************************/ / CKCTRS Moved here to gather space in one place elsewhere /a247 / ROUTINE USED IN "CKCTRL" TO SEE IF IN A CONTROL BLOCK OR NOT. DOES A / SKIP RETURN IF IN BLOCK AND A NORMAL RETURN IF NOT. CKCTRS, XX CDFEDT / CHANGE OVER TO EDITOR DATA FIELD TAD I (PCTLFL) / GET CONTROL BLOCK FLAG CDFLP / BACK TO THIS DATA FIELD SPA CLA / FOUND A CONTROL BLOCK? ISZ CKCTRS / YES: SET UP SKIP RETURN JMP I CKCTRS / NO: DO NORMAL RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /****************************SUBROUTINE*********************************/ /D236 / MATCH CONTENTS OF AC TO PARAMETER CODE /D236 / CALLING SEQUENCE IS: /D236 / AC=CODE1 /D236 / JMS MATCH /D236 / CODE2 /D236 / -RETURN IF CODE1 > CODE2 /D236 / -RETURN IF CODE1 < CODE2 /D236 / -RETURN IF CODE1 = CODE2 /D236 MATCH, 0 /D236 CIA /D236 TAD I MATCH /D236 ISZ MATCH /D236 SMA /D236 ISZ MATCH /D236 SNA CLA /D236 ISZ MATCH /D236 JMP I MATCH /****************************SUBROUTINE*********************************/ / STMPDK SToMP on Dead Keys. This routine tests the character /a247 / in the edit buffer pointed to by the AC on entry. If /a247 / it is an End of Dead Key, previous characters will be /a247 / overwritten until an Start of Dead key is found. If it /a247 / is not, then just this character is overwritten. /a247 / / Calling sequence should be:- /a247 / / AC=Address of character /a247 / CDFBUF /a247 / JMS STMPDK /a247 STMPDK, XX / Stomp on poor, unsuspecting dead keys /a247 DCA DELPTR / Store the address passed in the AC /a247 TAD I DELPTR / Get the character at this address /a247 TAD (-ECNDOV) / Test for End of Dead Key character /a247 SZA CLA / Is this a Dead Key Sequence? /a247 JMP NOSTMP / No, only stomp this character /a247 FNDEND, TAD I DELPTR / Get the character again /a247 MQL / Save it /a247 DCA I DELPTR / Stomp on character in Dead Key /a247 AC7777 / Backup to previous character /a247 TAD DELPTR / /a247 DCA DELPTR / /a247 TAD I DELPTR / And get it /a247 TAD (-ECSTOV) / Test for Start of Dead character /a247 SZA CLA / Have we stomped all the Dead Key yet? /a247 JMP FNDEND / No, still got to find the Start /a247 NOSTMP, DCA I DELPTR / Delete the character (or Start Dead) /a247 JMP I STMPDK / Return /a247 DELPTR, 0 /****************************SUBROUTINE*********************************/ / GET BEGINNING & ENDING FIELD BOUNDARYS FROM FLDDIM / REG1 IS ASSUMED TO POINT TO THE NEXT / ITEM IN THE TABLE TO BE ACCESSED. / REG1 WILL NOT BE CHANGED UNLESS A DUMMY / ENTRY IS ENCOUNTERED, IN WHICH CASE REG1 / WILL BE LEFT POINTED TO THE NEXT NON-DUMMY ENTRY. GETITEM,XX TAD REG1 / GET POINTER & INITIALIZE WORKING POINTER DCA REG2 TAD I REG2 / CHECK FOR RESULT FIELD (AC0=1) SMA CLA JMP GETIT1 TAD I GETITEM / NEW OR OLD CONTENTS WANTED? SNA CLA JMP GETIT1 ISZ REG2 / GET NEW RESULT FIELD & COMPUTE BOUNDARIES TAD I REG2 / GET DTAB PCP AND P377 DCA GTREG ISZ REG2 ISZ REG2 ISZ REG2 TAD I REG2 / GET WORD: LEFT BYTE=NO. LT DIGITS AND P77 / RIGHT BYTE=NO. RT DIGITS TAD (-1) TAD GTREG / RIGHT BOUNDARY=PCP-1+NO.RT DIGITS MQL / MQ=RIGHT BOUNDARY TAD I REG2 BSW AND P77 / LEFT BOUNDARY=PCP-NO.LT DIGITS CIA TAD GTREG / AC=LEFT BOUNDRY,MQ=RIGHT BOUNDRY JMP GETIT5 / THEN EXIT GETIT1, AC2000 AND I REG2 / CHECK FOR A FORCED-TAB ENTRY SNA CLA JMP GETIT2 ISZ REG2 / IF FORCED-TAB, THEN SET BOUNDRIES TAD I REG2 AND P377 MQL ACL JMP GETIT5 GETIT2, ISZ REG2 / CHECK FOR END OF FLDDIM TAD I REG2 ISZ REG2 SZA CLA JMP GETIT3 TAD I REG2 / IF BOTH TABPCP & BEGFLD = 0, THEN SNA CLA JMP GETIT6 / EXIT, END OF FLDDIM, NON-SKIP RETURN GETIT3, TAD I REG2 / CHECK FOR DUMMY ENTRY IN FLDDIM, SKIPPED TAB SZA / POSITION,I.E. BEGFLD=0 JMP GETIT4 TAD REG1 / SKIPPED ENTRY: SETUP RETURN AC=0 & MQ=TABPCP IAC DCA REG2 TAD I REG2 / SET AC=TABPCP AND P377 MQL / SET MQ=TABPCP - AC=0 JMP GETIT5 GETIT4, MQL / NORMAL ENTRY,MQ=LEFT BOUNDARY ISZ REG2 TAD I REG2 / AC=RIGHT BOUNDARY SWP / AC=LEFT BOUNDARY, MQ=RIGHT BOUNDARY GETIT5, ISZ GETITEM / NORMAL SKIP EXIT GETIT6, ISZ GETITEM / END OF LIST NON-SKIP EXIT JMP I GETITEM GTREG, 0 /****************************SUBROUTINE*********************************/ / INSERT CODE FOUND IN AC INTO TEXT STREAM AT CURRENT CURSOR VALUE / THEN BYPASS THIS CODE PLUS THE FOLLOWING CODE / AC=CODE TO INSERT INTO EDIT BUFFER INSFORCE,XX JMS INSCODE / ECMTH1 CODE TO MARK FIELD BEGINNING JMS READNEXT / AFTER INSERT, AVOID RE-READING NOP / INSERTED CODE JMP I INSFORCE /****************************SUBROUTINE*********************************/ / INSERT CODE INTO EDIT BUFFER / AC=CODE TO INSERT INTO EDIT BUFFER INSCODE,XX CIFEDT JMS CALLAR / CALL INSERT ROUTINE INSERT CDFBUF JMP I INSCODE /****************************SUBROUTINE*********************************/ / CLEAR AN AREA TO ZEROS / / JMS CLRZER / -PTR TO START OF ZONE TO CLEAR / -NEG. OF NUMBER OF WORDS TO CLEAR CLRZER, XX TAD I CLRZER / INITIALIZE POINTER DCA REG2 ISZ CLRZER TAD I CLRZER / INITIALIZE COUNTER DCA REG1 ISZ CLRZER CLRZ1, DCA I REG2 / CLEAR ONE LOCATION ISZ REG2 / ADVANCE POINTER ISZ REG1 / LOOP UNTIL COUNTER=0 JMP CLRZ1 JMP I CLRZER /****************************SUBROUTINE*********************************/ / PCP=PCP+XPCP INSEXTR,XX TAD PCP / ADVANCE POSITION PTR PAST TAD XPCP / ANY EXTRA SPACES DCA PCP / PCP = PCP + XPCP JMP I INSEXTR /****************************SUBROUTINE*********************************/ / CHECK FOR TYPE OF FIELD & ADJUST ENDFLD ACCORDING TO CASE SETFEND,XX AC2000 AND TABPCP / IF '>' FIELD & SNA JMP SETFE1 RAR / THAT FIELD IS NOT BLANK AND TABPCP / THEN TAKE SKIP RETURN SNA CLA SKP SETFE1, JMS INSBLANK / ELSE, CHECK FOR BLANK (TAB-ONLY) FIELD ISZ SETFEND JMP I SETFEND /****************************SUBROUTINE*********************************/ X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED /****************************SUBROUTINE*********************************/ / CHECK FOR BLANK FIELD & TAKE NON-SKIP RETURN IF NOT BLANK INSBLANK,XX TAD I GETF2A / IF FIELD ACCESSED IS NEW CONTENTS TAD NEWLIT / THEN SZA CLA / DO CHECK JMP INSBL0 / FOR RESULT FIELD TAD FLAGS / FIRST CHECK FOR RESULT FIELD SPA CLA JMP I INSBLANK / IF SO, TAKE NON-BLANK RETURN INSBL0, AC2000 / ELSE, CHECK FOR FORCE-TAB BIT AND FLAGS SZA CLA JMP INSBL1 / IF SET, TAKE BLANK RETURN AC2000 / ELSE, IF BLANK BIT SET RAR / (AC2000 & RAR=2000,NO LITERAL AND TABPCP / THEN TAKE BLANK RETURN SZA CLA INSBL1, ISZ INSBLANK / IF BLANK DO SKIP RET. JMP I INSBLANK / IF NON-BLANK, RETURN GETF2A, GETF2 / MUST AVOID ASSEMBLY ADDR AT FOOT OF PAGE NEWLIT, -NEWCON / DITTO /****************************SUBROUTINE*********************************/ / INMATH Moved here this edit to gather space together elsewhere /a247 / THIS ROUTINE MAKES A SKIP RETURN IF WE ARE IN A MATH AREA OR A CONTROL / BLOCK AND A REGULAR RETURN IF NOT INMATH, XX / CLA / CDFEDT / SET TO EDITORS DATA FIELD TAD I XPCTLFL / TEST CONTROL_BLOCK FLAG / =0 IF NOT IN CONTROL BLOCK / =-1 IF IN A CONTROL BLOCK CIA / AC=0 IF IN = 1 IF NOT IN CDFMYF / / =0 IF NOT IN MATH AREA / =1 IF IN A MATH AREA ISZ INMATH / BUMP RETURN ADDRESS IF EITHER / FLAG IS SET JMP I INMATH / RETURN XPCTLFL,PCTLFL / It says above that auto links should /a247 / not be generated. Who am I to argue? /a247 /***********************************************************************/ / / / ALLOCATE TABLE AREA / / / /***********************************************************************/ / THE TABLE FLDDIM IS COMPRISED OF FIVE WORDS PER ENTRY, AS FOLLOWS: / / FLAGS BIT 0=1 INDICATES RESULT FIELD / BIT 1=1 INDICATES TAB MUST BE INSERTED / BITS 2-4 FIELD/CHARACTER ATTRIBUTES / BITS 6-11 GIVES DTAB NUMBER OF DTAB FIELDS / / TABPCP BIT 0=1 INDICATES 'R' ENTRY / BIT 1=1 INDICATES '>' 'J' OR 'R' ENTRY / BIT 2=1 INDICATES FIELD WITHOUT DATA,TAB ONLY / BITS 4-11 GIVES POSITION OF TAB / / BEGFLD BITS 0-11 GIVES POSITION OF FIELD BEGINNING, / FIRST NON-SPACE CODE IN THE FIELD / / ENDFLD BITS 0-11 GIVES POSITION OF FIELD ENDING, / LAST NON-SPACE CODE IN THE FIELD, / UNLESS THE FIELD IS RIGHT / JUSTIFIED, IN WHICH CASE SPACES / ARE COUNTED / / RESULTS BITS 0-5 NUMBER OF POSITIONS TO THE / LEFT OF THE DECIMAL POINT / BITS 6-11 NUMBER OF POSITIONS TO THE / RIGHT OF THE DECIMAL POINT / AND INCLUDING THE DECIMAL POINT / FLDDIM, ZBLOCK 5^MXTABS+3 / ALLOCATE BUFFER TO HOLD ASCII NUMBER CONVERTED FROM BCD PRIOR TO / BEING INSERTED INTO THE EDIT BUFFER! NUMBUF, ZBLOCK MXASCII+1 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / PSEUDO-CODE TO SET UP SYMBOL TABLE ENTRIES FROM EDITOR MATH TO FIT INTO / TABLES THAT HOLD POINTERS TO THE VALUES OF ":Dnn" and ":Tnn". / START PROGRAM / / GET LEAD CHAR / / IF (LEAD CHAR = "D" OR "T") AND NOT LAST CHAR / THEN SET UP CORRESPONDING TABLE FOR ENTRY / | GET NEXT CHAR / | IF NOT LAST CHAR / | THEN IF CHAR VALUE RANGE = NUMERICAL 1 TO 3 / | | THEN CALCULATE FIRST PART OF OFFSET TO TABLE / | | | GET NEXT CHAR / | | | IF LAST CHAR AND CHAR VAL RANGE = NUM 0 TO 9 / | | | THEN CALCULATE REST OF OFFSET TO TBL / | | | | PUT SYM VALUE PTR IN TABLE / | | | ENDIF / | | ENDIF / | ELSE IF CHAR VALUE RANGE = NUMERICAL 1 TO 9 / | | THEN CALCULATE OFFSET TO TABLE / | | | PUT SYM VALUE PTR IN TABLE / | | ENDIF / | ENDF / ENDIF / / RETURN TO CALLER / / END PROGRAM / / VALUES USED IN EDITOR MATH SYMBOL NAME PROCESSING CODE STRMT1, 0 / CONTAINS SYM PTR TABLE PTR TO SYM NAME PTR STRPTR, 0 / CONTAINS PTR TO SYM NAME IN SYMBOL TABLE HLDTBL, 0 / CONTAINS BASE ADDR OF TABLE TO INSERT SYM VAL PTR TBLOFS, 0 / CONTAINS OFFSET INTO TABLE WHERE TO PUT SYM VAL PTR / ROUTINE TO RUN CHECK ON SYMBOLS ADDED TO SYMBOL TABLE WHEN IN EDITOR MATH / NOTE - RETAIN MATH DATA FIELD TO SET UP POINTERS CHKNME, XX DCA STRMT1 / POINTER & SAVE IT TAD I STRMT1 / INDIRECT THRU IT TO GET PTR TO NAME IN SYM TABLE DCA STRPTR / SAVE IT / CHECK IF FIRST LETTER (AFTER THE COLON) OF THE SYM NAME IS A "T" / OR "D" ISZ STRPTR / ADVANCE START OF NAME PTR TO SKIP ":" TAD I STRPTR / GET FIRST CHAR AFTER COLON SPA / IF IT IS LAST CHAR IN NAME JMP EXTCHK / THEN EXIT (NOT A VALID COLUMN NAME) TAD (-"D+200) / GET NEGATIVE 7 BIT ASCII VALUE FOR A "D" SNA / IS THE CHAR A "D"? JMP DTAB / YES: GO SET UP FOR RIGHT TABLE IF PROCESS IT TAD ("D-"T) / NO: RESET AC AND GET NEG OF ASCII FOR "T" SZA CLA / IF CHAR NOT A "T" JMP EXTCHK / THEN EXIT (NOT A VALID COLUMN NAME) TAD (TCHAR-DCHAR) / GET START OF "T"PROCESSING TABLE DTAB, TAD (DCHAR) / GET START OF "D" PROCESSING TABLE DCA HLDTBL / INITIALIZE D OR T PROCESSING TABLE / CHECK FOR SYMBOL NAME SIZE CONCHK, ISZ STRPTR / MOVE DOWN TO NEXT CHAR IN NAME TAD I STRPTR / GET NEXT CHARACTER IN NAME SPA / IF THIS IS THE LAST CHAR JMP PRSONE / THEN GO TO HANDLE A ":Dn" NAME / PROCESS TWO DIGITS LEFT AFTER "D" OR "T" JMS RNGECK / CHECK THE RANGE ON THE DIGIT -"1+200 / PASS NEGATIVE OF LOWER LIMIT OF RANGE -"3+200 / PASS NEGATIVE OF UPPER LIMIT OF RANGE JMP EXTCHK / IF NOT IN RANGE THEN EXIT (NOT A VALID COLUMN NAME) / RETURN HERE IF IN RANGE SPECIFIED - CLL RAL / MULTIPLE IT BY 2 DCA TBLOFS / SAVE IT TAD TBLOFS / GET IT BACK CLL RTL / MULTIPLE IT BY 8 TAD TBLOFS / ADD MULTIPLICATON BY 2 DCA TBLOFS / SAVE THE NUM AS PART OF AN OFFSET TO THE TABLE ISZ STRPTR / SET PTR TO SECOND OF TWO DIGITS TAD I STRPTR / GET THE CHAR SMA / IF NOT THE LAST CHAR JMP EXTCHK / THEN EXIT (NOT A VALID COLUMN NAME) AND P177 / STIP OFF MINUS BIT (WHICH INDICATES LAST CHAR) JMS RNGECK / CHECK THE RANGE ON THE DIGIT -"0+200 / PASS NEGATIVE OF LOWER LIMIT OF RANGE -"9+200 / PASS NEGATIVE OF UPPER LIMIT OF RANGE JMP EXTCHK / RETURN HERE IF NOT IN RANGE - RETURN TO CALLER / RETURN HERE IF IN RANGE AC = 0 TO 9 TAD TBLOFS / ADD IN THE VALUE OF FIRST DIGIT * 10 JMP SAVSYM / GO INSERT PTR TO SYM NAME VALUE IN THE TABLE / PROCESS ONE DIGIT LEFT AFTER "D" OR "T" PRSONE, AND P177 / STRIP OFF SIGN BIT JMS RNGECK / CHECK THE RANGE ON THE DIGIT -"1+200 / PASS NEGATIVE OF LOWER LIMIT OF RANGE -"9+200 / PASS NEGATIVE OF UPPER LIMIT OF RANGE JMP EXTCHK / RETURN HERE IF NOT IN RANGE - RETURN TO CALLER / RETURN HERE IF IN RANGE - AC = CHAR - 60 / INSERT PTR TO SYMBOL NAME VALUE INTO THE APPROPRIATE TABLE SAVSYM, DCA TBLOFS / SAVE OFFSET INTO TABLE AC7777 / DECREMENT TABLE ADDRESS BY 1 TO ALLOW THE USE / OF THE FIRST LOC OF TBL,SINCE NEVER SEE "<:D0>" TAD HLDTBL / GET START OF TABLE TO PROCESS CHAR TAD TBLOFS / GET OFFSET TO THE TABLE DCA TBLOFS / USE IT TO SET UP A POINTER CDFLP / RETURN TO LP DATA FIELD AC0002 / SET TO MOVE PTR BY FORMAT WORD TO START OF VALUE TAD STRPTR / ADD TO IT PTR TO END OF SYM NAME DCA I TBLOFS / PLACE IT INTO THE PROPER PLACE IN THE TABLE EXTCHK, CDIMTH / SET PROGRAM CONTROL BACK TO MATH FIELD CLA JMP I CHKNME / RETURN TO CALLER IN MATH FIELD / ROUTINE TO RANGE CHECK ON A SPECIFIC CHARACTER. CALL TO THIS ROUTINE IS / SET UP AS FOLLOWS: / . / . / (CHAR TO BE CHECKED PASSED IN THE AC) / / JMS RNGECK / / (NEGATIVE OF LOWER LIMIT OF RANGE) / / (NEGATIVE OF UPPER LIMIT OF RANGE) / / RETURN HERE IF NOT IN RANGE / / RETURN HERE IF IN RANGE / / (AC HAS CHAR -60 ON EXIT WEATHER FOUND OR NOT) / . RNGCHR, 0 / CHAR PASSED IN AC RNGECK, XX / RANGE CHECK ROUTINE CDFLP / CDF TO MY FIELD DCA RNGCHR / SAVE CHAR PASSED FOR RANGE CHECK TAD I RNGECK / GET NEG OF LOW END OF RANGE TAD RNGCHR / ADD TO IT CHAR FOR CHECK SPA CLA / IS CHAR IN RANGE? JMP OUTRNG / NO: SET SKIP RETURN TO PROCESS ACCORDINGLY ISZ RNGECK / YES: SET P.C. TO PICK UP UPPER RANGE LIMIT TAD I RNGECK / GET NEG OF UPPER LIMIT INTO AC TAD RNGCHR / ADD TO IT CHAR FOR CHECK SPA SNA CLA / IS CHAR IN RANGE? OUTRNG, ISZ RNGECK / YES: SET RETURN TO PROCESS ACCORDINGLY ISZ RNGECK / NO: SET RETURN TO SKIP PROCESSING CDFMTH / CDF BACK TO MATH FIELD TAD RNGCHR / GET DIGIT BACK IN AC TAD (-60) / CHANGE FROM ASCII TO BINARY JMP I RNGECK / RETURN TO CALLER / Here on a Gold Bottom request. Gold Bottom goes to the end of the / descriptor list and then backs up 10 blocks. if the last ruler found / was below the 10 blocks, the wrong ruler will be loaded for the scroll. / this routine starts searching from this 10th block up, looking for the / first ruler. when found return to load this ruler and continue the / scroll / delete this logic from GOLD_BOTTOM... /A195 /D195RULCHK, XX / SAVE CALLERS RETURN ADDRESS /D195 TAD I (RPCUOF) / SAVE CURRENT OFFSET /D195 DCA I (RPMTBK) / FOR SCROLL AFTER FINDING RULER /D195 TAD I (RPCUBK) / ALONG WITH BLK ID # /D195 DCA I (RPBKID) /D195 JMS BACK1 / GO LOOK FOR BLK W/RULER /D195 CIFEDT / FOR RETURN TO OVERLAYS /D195 JMP I RULCHK / RETURN / routine sets up blocks for ruler load and resets blocks for scroll BACK3, TAD I (RPCUOF) / RULER FOUND AT THIS OFFSET DCA I (RPMTRL) / SET UP THE BLKS FOR THE RULER LOAD TAD I (RPCUBK) / BLK ID # DCA I (RPRLHN) TAD I (RPMTBK) / RETRIEVE LOC. FOR START OF SCROLL DCA I (RPCUOF) / CURRENT OFFSET FOR START / BLK ID IS SET UP ON RETURN LOC IN OVERLAY JMP BACK4 / RETURN / THE FOLLOWING ROUTINE IS CALLED FROM WITHIN "CKCTRL". IT IS USED TO / MAKE SURE THAT THE 1ST TIME A CONTROL BLOCK IS ENCOUNTERED, IT IS / THE FIRST LINE AFTER THE "START CONTROL" CHAR. THIS IS NECESSARY / SINCE SUCH THINGS AS A "GOLD-BOTTOM" OR "BACK-UP LINE" CAN LEAVE THE / USER IN ANY KIND OF A CONTROL BLOCK SITUATION, BUT NOT NECESSARILY ON / THE FIRST LINE OF THAT CONTROL BLOCK. IF HOWEVER THE LINE THE USER IS / LEFT ON STARTS WITH A "WPSMATH" (CR) "BEGIN" (CR), EVEN IF THERE ARE / ILLEGAL MATH CTRL BLOCK LINES PRECEEDING IT, THE CODE WILL THINK IT IS / THE BEGINNING OF A VALID EDITOR MATH WORK AREA. THIS CODE IS INSURANCE / THAT THIS WILL NOT HAPPEN. STLOC2, 0 / LOC TO HOLD ADDR TO START OF 2ND LINE FROM / THE BOTTOM OF THE SCREEN, KEEP ON SAME PAGE / WITH "STLOC1" ROUTINE STLOC1, XX CDFEDT / CHANGE TO EDITOR DATA FIELD TAD I (PTRBLK+NPTRS-2)/ PTR TO THE 2ND LINE FROM THE BOTTOM DCA STLOC2 / SAVE IT CDFBUF / CHANGE TO EDIT BUFFER DATA FIELD TAD I STLOC2 / GET THE FIRST CHAR ON THAT LINE CDFMYF / RETURN TO THIS DATA FIELD TAD (-ECPCT1) / ADD TO IT NEGATIVE OF "START CTRL" CHAR SZA CLA / IS 2ND LINE FROM BOTTOM A "START CONTROL"? ISZ STLOC1 / NO: SET SKIP RETURN TO HANDLE JMP I STLOC1 / YES: NORMAL RETURN TO CONTINUE PROCESSING / DELCODE moved here to gather space elsewhere in one place /a247 / DELETE CODE FROM EDIT BUFFER DELCODE,XX CDFEDT TAD I (CURPTR) / DELETE BY OVERWRITING CODE POINTED TO /d247 DCA DELPTR / BY CURPTR WITH A NULL CDFBUF DCA DELTEMP / Save the pointer /a247 TAD I DELTEMP / Get it back to save in the MQ register/a247 MQL / ... /a247 TAD DELTEMP / Get the address back to pass on /a247 /d247 TAD I DELPTR / GET CODE TO SAVE ATTRIBUTES JMS STMPDK / Stomp on the character pointed to /a247 /d247 MQL /d247 DCA I DELPTR CDFMYF JMP I DELCODE DELTEMP,0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED TRANTP=. / TOP OF TRANSLATIONS PAGE /A258 / THESE MESSAGES BROUGHT IN FROM THE EDITOR OVERLAYS. THEY ARE SPECIAL / IN THAT THEY ARE NEVER USED WHILE IN LIST PROCESSING. EIFND1, IFDEF ENGLSH < TEXT "!&ENTER !&PHRASE: " > IFDEF V30NOR < TEXT "!&ANGI !&UTTRYKK: " > IFDEF V30SWE < TEXT "&SKRIV FRAS: " > IFDEF SPANISH < TEXT "&TECLEE &FRASE: " > /A255 IFDEF ITALIAN IFDEF CANADA < TEXT "&TAPER &L'&EXPRESSION: " > IFDEF FRENCH < TEXT "&TAPER &L'&EXPRESSION : " > IFDEF DUTCH < TEXT "&TYP &DE &ZOEKTEKST: " > IFDEF GERMAN < TEXT "&BEGRIFF &EINGEBEN: " > IFDEF NORWAY < TEXT "&SKRIV &S\KEBEGREP: " > /L.PHI IFDEF SWEDSH < TEXT "&SKRIV &S\KBEGREPP: " > /L.U.O IFDEF DANISH < TEXT "&SKRIV &S\GEBEGREP : " > /L.PHI EIGES1, IFDEF ENGLSH < TEXT "!&ENTER !&NAME: " > IFDEF V30NOR < TEXT "!&ANGI !&NAVN: " > IFDEF V30SWE < TEXT "&SKRIV NAMN: " > IFDEF SPANISH < TEXT "&TECLEE &NOMBRE: " > /A255 IFDEF ITALIAN IFDEF CANADA < TEXT "&TAPER &LE &NOM: " > IFDEF FRENCH < TEXT "&TAPER &LE &NOM : " > IFDEF DUTCH < TEXT "&TYP &DE &NAAM: " > IFDEF GERMAN < TEXT "&NAME &EINGEBEN: " > IFDEF NORWAY < TEXT "&SKRIV &NAVN: " > IFDEF SWEDSH < TEXT "&SKRIV &NAMN: " > IFDEF DANISH EIGER2, IFDEF ENGLSH < TEXT "!&NOT !&FOUND-!&REENTER: " > IFDEF V30NOR < TEXT "!&IKKE !&FUNNET-!&LEGG INN P\E NYTT: " > IFDEF V30SWE < TEXT "&HITTAS INTE - &F\VRS\VK IGEN: " > IFDEF SPANISH < TEXT "&NO &SE &ENCUENTRA-&TECLEE OTRA VEZ: " >/A255 IFDEF ITALIAN IFDEF CANADA < TEXT "&INTROUVABLE-&REESSAYER:"> IFDEF FRENCH < TEXT "&INTROUVABLE--&REESSAYER : " >/L.A.E IFDEF DUTCH < TEXT "&NIET &AANWEZIG-&PROBEER &OPNIEUW: " > IFDEF GERMAN < TEXT "&NICHT &GEFUNDEN--&NOCH &EINMAL: " > IFDEF NORWAY < TEXT "&IKKE &FUNNET--&PR\V &IGJEN: " > /L.PHI IFDEF SWEDSH < TEXT "&FINNS &INTE--&F\RS\K &IGEN: " > /L.U.O, L.U.O IFDEF DANISH / L.PHI / FOLLOWING TEXT STATEMENTS MOVED IN FROM EDITOR OVERLAYS SINCE THEY / MUST NOW RESIDE IN FIELD 5 RANBAD, IFDEF ENGLSH < TEXT " - &UP &TO 4 &DIGITS &ALLOWED" > IFDEF V30NOR < TEXT " - &INNTIL 4 SIFFER ER TILLATT" > IFDEF V30SWE < TEXT " - &MAXIMALT 4 TECKEN \DR TILL\ETNA" > IFDEF SPANISH < TEXT " - &SE &PERMITE &HASTA 4 &D\MGITOS" > /A255 IFDEF ITALIAN < TEXT " - &MAX. 4 CIFRE" > IFDEF DUTCH < TEXT " - &MAX. 4 CIJFERS"> CHABAD, IFDEF ENGLSH < TEXT " - &NUMBERS &ONLY &PLEASE" > IFDEF V30NOR < TEXT " - &BARE TALL" > IFDEF V30SWE < TEXT " - &SKRIV ENDAST TAL" > IFDEF SPANISH < TEXT " - &S\SLO &N\ZMEROS" > /A255 IFDEF ITALIAN < TEXT " - &SOLO NUMERI" > IFDEF DUTCH < TEXT " - &GEBRUIK ALLEEN CIJFERS" > RPPME9, IFDEF ENGLSH < TEXT " - &MULTIPLE &MATH &START &BLOCKS" > IFDEF V30NOR < TEXT " - &FLERE &START-BLOKKER FOR ®NING" > IFDEF V30SWE < TEXT " - &FLERTAL &MATEMATIK &START &BLK" > IFDEF SPANISH < TEXT " - &BLOQUES &INICIO &MAT &M\ZLTIPLE" > /A255 IFDEF ITALIAN < TEXT " - &C'\H UN SECONDO COMANDO !&INIZIO NELL'AREA MATEMATICA" > IFDEF DUTCH < TEXT " - &MEERDERE !&BEGIN (REKENEN) OPDRACHTEN" > RPPRETRY, IFDEF ENGLSH < TEXT " - &PRESS !&RETURN &TO &CONTINUE" > IFDEF V30NOR < TEXT " - &TRYKK P'E !&RETUR FOR \E FORTSETTE" > IFDEF V30SWE < TEXT " - &TRYCK P\E RETUR F\VR ATT FORTS\DTTA" > IFDEF SPANISH < TEXT " - &PULSE !&RETORNO &PARA &CONTINUAR" > /A255 IFDEF ITALIAN < TEXT " - &PREMERE !&RETORNO" > IFDEF DUTCH < TEXT " - &DRUK OP !&RETURN" > EIRPG1, IFDEF ENGLSH < TEXT "&ENTER &PAGE &NUMBER:" > IFDEF V30NOR < TEXT "&ANGI SIDETALL:" > IFDEF V30SWE < TEXT "&SKRIV SIDNUMMER:" > IFDEF SPANISH < TEXT "&TECLEE &PAG. &N\ZMERO:" > /A255 IFDEF ITALIAN < TEXT "&INTRODURRE IL NUMERO DI PAGINA:" > IFDEF DUTCH < TEXT "&TYP HET PAGINA-NUMMER: " > EIRRAB, IFDEF ENGLSH < TEXT "&PRESS !&ADVANCE OR !&BACK !&UP" > IFDEF V30NOR < TEXT "&TRYKK P'E !&FREM EL. !&TILBAKE" > IFDEF V30SWE < TEXT "&TRYCK P\E FRAM\ET ELLER BAK\ET" > IFDEF SPANISH < TEXT "&PULSE !&ADELANTE O !&ATRAS" > /A255 IFDEF ITALIAN < TEXT "&PREMERE !&AVANTI O !&INDIETRO" > IFDEF DUTCH < TEXT "&DRUK OP !&VOORUIT OF !&TERUG" > X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE IFNZRO .-TRANTP-200 /A258 DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / THE FOLLOWING IS PART OF THE EDITOR MATH ERROR REPORTING CODE. / This routine places a caret ("^"), on line 6. if wide screen and / on line 16. if narrow screen, in the column which was passed / to this routine in the ac. EDRTW, / subroutine head used for temporary storage EDRCOL, XX CDFEDT TAD I (LOWLIM) / ADD LOWLIMIT TO COLUMN NUMBER TO MAKE / SURE THAT CARET CAN BE PLACED IN / POSITION PASSED TO EDRCOL. DCA EDRTX / SAVE RESULT TAD EDRTX / POSITION LESS THAN LEFT SCREEN LIMIT? SPA SNA / SKIP IF: NOT JMP EDRCO1 / EXIT (CAN'T DISPLAY CARET) TAD (-205) / POSITION GTR THAN RIGHT SCREEN LIMIT? SMA CLA / SKIP IF: NOT (OK TO DISPLAY CARET) JMP EDRCO1 / EXIT (CAN'T DISPLAY CARET) TAD (-7) / set line number DCA I (CURLIN) CDFMYF TAD EDRTX / get the column number CIFEDT / position the cursor JMS CALLAR PCUR CDFEDT TAD ("^&177) / write the caret CIFEDT JMS CALLAR EDOCHR CDFEDT EDRCO1, CLA CLL CDFMYF JMP I EDRCOL / This routine gets the next argument from EDERR's arg list, / which is a pointer to the oversize result in BCD. (The arg list / will have one or two such args.) The BCD result must be translated / into ASCII for IOA, and then displayed at the location which / was passed to this routine in the ac. EDRTX, / subroutine head used for temporary storage EDRDYR, XX DCA EDRPSN / put cursor position in IOA call ISZ EDRALP / get next argument less one TAD EDRALP DCA EDRTW AC7777 TAD I EDRTW DCA EDRBCD / put it in BCDASC call JMS BCDASC / call the conversion routine EDRBCD, .-. NUMBUF / ADDRESS TO PUT ASCII RESULTS CDFMYF DCA EDRBCD / mark the end of the ASCII string DCA I EDRBCD / with a 0 CIFMNU / call IOA to display a cursor JMS I IOACAL / position (where the result goes), 0 / and an ASCII string (the result) EDRIND EDRPSN, .-. NUMBUF / ADDRESS OF ASCII NUMBER JMP I EDRDYR / exit subr / the following was moved here from the overlays / offset ADJUSTMENT subroutine / / adjust (INCREMENT OR DECREMENT) the offset to the rppgds / and the pointer to the rppgds block / / the contents of the AC at entry = positive for forward adjustment, or / = negative for backward adjustment AJUST, XX / THE CONTENTS OF THE AC IS THE COUNT CDFEDT / CHANGE TO EDITOR FIELD SPA / SKIP NEXT IF POSITIVE MEANING ADJUST FORWARD JMP ADJBACK / ADJUST IN THE REVERSE DIRECTION / adjust in the forward direction ISZ I (RPCUOF) / ADJUST FORWARD BY 1 COUNT (ALWAYS) AC7775 / ARE WE PROCESSING THE THIRD EXT.?? TAD I (RPCUBK) SZA CLA / SKIP IF SO JMP ADJUS1 / NOT IN THE THIRD EXT. TAD I (RPCUOF) / IF WE HAVE REACHED TAD (-362) / 362 IN THE THIRD EXT., RESET SNA CLA / SKIP IF LESS THAN 362 JMP ADJUS2 / AT 362, RESET... ADJUS1, TAD I (RPCUOF) TAD (-400) / SPA CLA / JMP ADJEX3 / EXIT / gone to far forward ADJUS2, AC0002 / 2 / /\ DCA I (RPCUOF) / ISZ I (RPCUBK) / JMP ADJEX2 / EXIT / adjust in the backward direction ADJBACK,TAD I (RPCUOF) / GET POINTER VALUE BEFORE ADJUSTMENT DCA I (RPCUOF) / SAVE BACKWARD ADJUSTED VALUE TAD I (RPCUBK) / CLL RAR / SNA CLA / JMP RPPH01 / AC7776 / -2 / TAD I (RPCUOF) / SMA / JMP ADJEX1 / STILL WITHIN LIMITS OF RPPGDS BLOCK AFTER ADJUSTMENT / the contents of the AC is a negative number / which means out of the logical boundries / of the RPPGDS block after the backward adjustment DCA ADJTMP / SAVE CURRENT VALUE OF RPCUOF TAD I (RPCUBK) / ARE WE IN THE FOURTH EXT.??? TAD (-4) SNA CLA / SKIP IF NOT TAD (7762) / GET BACK TO 361 IN THIRD EXT. TAD (400) / TAD ADJTMP / RETRIEVE RPCUOF DCA I (RPCUOF) / RPCUOF IS NOW CORRECTED AC7777 / -1 / TAD I (RPCUBK) / DCA I (RPCUBK) / JMP ADJEX3 / EXIT ADJTMP, 0 / TEMP. WORKING STORAGE / special boundry testing / because the pointer adjusted / is in the 1st RPPGDS descriptor block / (which has unique limits) / / 55 - is the 'top' of the block where the 1st RPPGDS descriptor word is / 377 - is the 'bottom' of the block where the last descriptor word is RPPH01, TAD (-55) / TAD I (RPCUOF) / ADJEX1, SMA CLA / JMP ADJEX3 / EXIT - STILL WITHIN LIMITS AFTER ADJUSTMENT TAD (55) / ADJEX2, DCA I (RPCUOF) / ADJEX3, CDFLP JMP I AJUST / EXIT / ADJUS0 Moved here this edit to gather space in one place /a247 / ADJUS0, XX / SAVE RETURN ADDRESS DCA ADJTM1 / ADJUST DIRECTION IN MQ RDF / GET CALLERS (RETURN) FIELD TAD CIDF0 / MAKE A RETURN CID INSTR. DCA ADJEX4 / SAVE FOR RETURN TO CALLER TAD ADJTM1 / SUPPLY ADJUST DIRECTION JMS AJUST / DO ADJUST ADJEX4, .-. / CALLERS FIELD JMP I ADJUS0 / RETURN ADJTM1, .-. / TEMP FOR ADJUST DIRECTION X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / * * * * * * * * * * * * * * * * * / * * / * EDITOR MATH ERROR REPORTING * / * * / * * * * * * * * * * * * * * * * * / Most of the display work is done in the menu. This routine accepts / an error code and up to four parameters. It passes the error code and / the first two parameters to menu block DLMLP5, list proc & ed math / error reporting. A flag passed back by the menu processor tells this / routine whether to either just exit, or to call PELINE to show the / partially parsed formula or command appropriate to some error messages. / For two of the messages (ERNOSP and ERNSP2), this routine will not call / PELINE, but will make a display which shows results which do not fit. / calling sequence: / / for ERNOSP and ERNSP2 -- / TAD (error code) / CDFMYF / JMS EDERR-1 / pcp to the first result's tab stop / pcp to the second result's tab stop / pointer to the first oversize result / pointer to the second oversize result / / for EREXTR -- / TAD (error code) / CDFMYF / JMS EDERR-1 / pcp to the erroneous number / / for all other errors -- / TAD (error code) / JMP EDERR / pseudo-code / EDERR: proc / save ac / if in view mode then exit view mode endif / eliminate any screen lag / MNTMP4 = SPLTFL / if SPLTFL then EDRDIF = 0 else EDRDIF = #1200 endif / do / { error code passed in ac } / MNTMP5 = saved ac / { tell menu processor that we're editor math } / MNTMP1 = 1 / call MENU_INTERPRETER / { the menu process will clear the error code to show that no } / { further processing is needed } / until MNTMP5==0 here / { check to see what flavor of further processing is needed } / select MNTMP5 of / case EREXTR / call EDRCOL ( arg1 ) / case ERNOSP / call EDRDYR ( #744 ) { will use arg3 } / call EDRCOL ( arg1 ) / case ERNSP2 / call EDRDYR ( #744 ) { will use arg3 } / call EDRDYR ( #1044 ) { will use arg4 } / call EDRCOL ( arg2 ) / call EDRCOL ( arg1 ) / otherwise / call PELINE / endselect / { tell menu processor that it's being called a second time } / saved ac = 1 / enddo / fix up the screen / goto editor re-entry / / EDRCOL: proc / save ac / call PCUR ( [CURLIN=-7] saved ac ) / call EDOCHR ( '^' ) / return / / EDRDYR: proc / save ac plus EDRDIF / ac = next argument of EDERR / call BCDASC ( ac, NUMBUF ) / mark end of NUMBUF with 0 / call IOA ( 0, "^P^A", saved ac, NUMBUF ) / return / real-code EDRALP, XX / sometimes called with JMS in order to / establish an argument list pointer EDERR, DCA EDRTZ / save error code CDFEDT / view overlay?? TAD I (OVLAY1) TAD (-VIEWF1) SZA CLA JMP EDRJ1 / not view overlay TAD I (VIEWF2) / view mode?? SNA CLA JMP EDRJ1 / not view mode DCA I (VIEWF2) / exit view mode AC2000 DCA I (SCRLCT) AC2000 DCA I (SCRNFL) EDRJ1, CDFMYF / get first two arguments TAD I EDRALP DCA EDRT1 ISZ EDRALP TAD I EDRALP DCA EDRT2 CDFEDT / eliminate any screen lag AC0001 DCA I (ECHFLG) JMS CALFXS / CALL EDITORS FXSCRL ROUTINE /D232 CIFMNU / CHANGE TO MENU FIELD /D232 PGSWAP / AC=0 SAVE SWAP AREA & RELOAD MENU CODE TAD EDRTZ / get saved error code EDRRPT, CDFMNU / pass error code to menu processor DCA I (MUBUF+MNTMP5) AC0001 / signal that we're editor math DCA I (MUBUF+MNTMP1) / (list proc uses a 0) CDFMYF / call the menu processor on the "list CIFMNU / CHANGE TO MENU FIELD /M232 PGSWAP / AC=0 SAVE SWAP AREA & RELOAD MENU CODE /M232 CIFMNU / proc & ed math errors" block JMS I MNUCAL DLMLP5 AC7777 / SET AC=-1 /M232 CIFMNU / CHANGE TO MENU FIELD /M232 PGSWAP / AC=-1, SO JUST LOAD IN THE SAVE AREA /M232 CDFMNU / see if the menu process cleared the TAD I (MUBUF+MNTMP5) / error code or whatever CDFMYF SNA CLA JMP EDREND / err code cleared -- all done JMS EDRTYP / not cleared -- which error?? JMP EDROTH / other -- go call PELINE JMP EDRXTR / EREXTR -- display one caret only JMP EDRONE / ERNOSP -- display one big result JMS EDRDSP / ERNSP2 -- display two big results 2144 / screen position for display JMS EDRDYR / one result after "...results: " JMS EDRDSP / calculate correct screen position 2244 / screen position for display JMS EDRDYR / one result after "...and: " TAD EDRT2 / one caret at column arg2 JMS EDRCOL JMP EDRXTR EDRONE, JMS EDRDSP / calculate correct screen position 2142 / screen position for display JMS EDRDYR / one result after "...result: " EDRXTR, TAD EDRT1 / one caret at column arg1 JMS EDRCOL JMP EDRAGN / go call the menu proc to finish up EDROTH, JMS EDRDSP / calculate correct screen position 2200 / screen position for display / it's not one of those listed, so assume CIFMTH / it's the kind of error with something JMS PELINE / informative in the line buffer EDRAGN, AC0001 / tell the menu processor that this is JMP EDRRPT / a second call / This routine calculates the correct screen position for the error display. / / The call is as follows: / JMS EDRDSP / Calculate correct screen position / value / Position to use for no status lines / ... / Return with AC = correct location EDRDSP, XX / Calculate correct screen position CDFMNU / Switch to menu field TAD I (MUBUF+MNSTAT) / Pick up value of status line count CDFMYF / Switch back to this field BSW / Swap low order bits with high order bits CIA / Make value negative for a subtract TAD I EDRDSP / Combine with NO-STATUS-LINE value ISZ EDRDSP / Bump return address over value JMP I EDRDSP / Return to caller / This routine examines the saved error code (in EDRTZ) and takes an / alternate return depending on the specific error. / JMS+1 (normal return) -- not one of those tested for / JMS+2 (skip 1) -- EDRTZ = EREXTR / JMS+3 (skip 2) -- EDRTZ = ERNOSP / JMS+4 (skip 3) -- EDRTZ = ERNSP2 EDRTYP, XX TAD EDRTZ TAD (-EREXTR) SNA JMP EDRTR1 TAD (EREXTR-ERNOSP) SNA JMP EDRTR2 TAD (ERNOSP-ERNSP2) SZA CLA JMP I EDRTYP ISZ EDRTYP EDRTR2, ISZ EDRTYP EDRTR1, ISZ EDRTYP JMP I EDRTYP / some useful things EDRTZ, 0 / error code (passed to EDERR in ac) EDRT1, 0 / arg1 EDRT2, 0 / arg2 / come here to exit from error reporting to the editor EDREND, /D232 AC7777 / SET AC=-1 /D232 CIFMNU / CHANGE TO MENU FIELD /D232 PGSWAP / AC=-1, SO JUST LOAD IN THE SAVE AREA CDFEDT / fix up the screen TAD (-10) DCA I (SCRLCT) DCA I (CURLIN) DCA I (CURPOS) JMS CALFXS / CALL EDITORS FXSCRL ROUTINE CDFBUF / jump to the editor CIFEDT JMP EIFXT2 / some useful things EDRIND, TEXT "^P^A" X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE DSKBLK=.-200%400+DL4EDT / DISK BLOCK WHERE PAGE IS LOADED / THE FOLLOWING ROUTINE IS USED TO GET THE STATUS OF THE "MA" SWITCH, AND / INFO REGARDING WHETHER IN MATH AREA OR NOT! / / IF MA = YES / THEN IF IN MATH WORK AREA = TRUE / THEN DO SKIP RETURN / ELSE DO NORMAL RETURN / ENDIF / ELSE SET "IN MATH WORK AREA" FLAG = FALSE / SET "IN CONTROL BLOCK" FLAG = FALSE / DO NORMAL RETURN / ENDIF MASTTS, XX CDFMNU / CHANGE TO MENU DATA FIELD TAD I (MUBUF+MNMATH) / GET "MA" FLAG CDFMYF / RETURN TO THIS DATA FIELD SNA CLA / IS "MA" YES? JMP MASTT1 / NO: GO FIX FLAGS CDFMTH / YES: CHANGE TO MATH DATA FIELD TAD I (MTHWRK) / GET "IN MATH WORK AREA" FLAG CDFMYF / RETURN TO THIS DATA FIELD SNA CLA / ARE WE IN A MATH WORK AREA? ISZ MASTTS / YES: SET UP FOR A SKIP RETURN JMP I MASTTS / NO: RETURN TO CALLER / TAKE TIME HERE TO SET FOLLOWING FLAGS IN CASE "MA" IS SHUT OFF / IN THE MIDDLE OF A MATH AREA. MASTT1, AC0001 / GET 1 IN THE AC CDFMTH / CHANGE TO MATH DATA FIELD DCA I (MTHWRK) / SET IN MATH WORK AREA FLAG TO FALSE CDFMYF / RETURN TO THIS DATA FIELD AC0001 / GET 1 IN THE AC DCA INCTLB / SET "IN CONTROL BLOCK" FLAG = FALSE JMP I MASTTS / RETURN TO CALLER / THIS RTN IS CALLED FROM "SCRMTH" AND "EDERR1". IT IS USED TO SHUT / DOWN EDITOR MATH IN THE CASE OF BACKING UP INTO, IN, OR OUT OF A CTRL / BLOCK IN AN EDITOR MATH WORK AREA. ALSO IT IS USED TO SHUT IT DOWN IF / AN ERROR IS ENCOUNTERED IN AN EDITOR MATH CONTROL BLOCK SCRINI, XX / SUBRTN USED TO SHUT EDITOR MATH DOWN CDFMTH / YES: CHANGE TO MATH DATA FIELD AC0001 / GET 1 IN THE AC DCA I (MTHWRK) / SET "IN MATH WORK AREA" = FALSE DCA I (MTHTOT) / SET "MATH TOTAL" FLAG = FALSE / DONE IN CASE "TOTAL" COMMAND IS PUT IN 1ST / BLOCK OF EDITOR MATH AREA. IF PROCESS THRU 1ST / BLOCK OF MATH AREA, THEN BACK UP TO TOP OF AREA / AND RESCROLL, DEPENDING ON WHERE THE "TOTAL" / HAS BEEN PLACED RELATIVE TO THE "FORMULAS" IN / THE BLOCK, INCONSISTENCIES CAN RESULT IN THE / EXECUTION OF THE 1ST LINE OF THE TABLE / FOLLOWING THE BLOCK DCA I (FSTLNE) / SET "CONTROL BLOCK FIRST LINE" FLAG = TRUE / THIS IS DONE TO COVER THE CASE WHERE THE USER / BACKS UP IN AN EDITOR MATH AREA CTRL BLOCK / TO THE "WPSMATH" THEN SCROLLS FORWARD THEN / BACKS UP AGAIN TO THE TOP OF THE MATH AREA. / THIS FIX SHOULD ALLOW THE SYSTEM TO PROCESS / THE MATH AREA STARTING FROM THE "WPSMATH" / INSTEAD OF HAVING TO BACK UP TO BEFORE THE / START OF THE MATH AREA, THUS KEEPING IT / CONSISTENT WITH THE WAY IT ACTS IF BACKUP IS / DONE WHILE NOT IN A CTRL BLOCK. CDFMYF / RETURN TO THIS DATA FIELD AC0001 / GET 1 IN THE AC DCA INCTLB / SET "IN CONTROL BLOCK" FLAG = FALSE DCA MTHCTL / SET "IN MATH CONTROL BLOCK" = FALSE.... / ..THIS IS DONE TO COVER ANY UNFORESEEN PROBLEMS JMP I SCRINI / RETURN TO CALLER / INMATH Moved this edit to make space for INSMCH /a247 / CALFXS Moved this edit to make room for INSMCH /a247 / CKCTRS Moved this edit to make room for INSMCH /a247 / CHAR. CHECK ROUTINE / READS CHARACTER IN EDIT BUFFER POINTERED TO BY LINE23 AND CHECKS FOR / MATCH TO CHARACTER SPECIFIED AT CALLER+2. USED IN "CKCTRL". / ROUTINE WILL GO BACK TO THE EDITOR, RESTORING CURPTR ALONG THE WAY IF / THE CHARCTER READ MATCHES THE CHARACTER SPECIFIED AT CALLER+2 ELSE / IT RETURNS TO CALLER+3 IF NO MATCH. / CALL : JMS CKCTR1 / CALL+1 : VALUE TO AND CHAR. WITH (IE. - STRIP MODE BITS) / CALL+2 : -CHAR. TO MATCH CKCTR1, XX CDFEDT TAD I (LINE23) / GET POINTER TO 1ST CHAR. IN LINE DCA T1 / SAVE IN TEMP. CDFBUF TAD I T1 / GET CHARACTER CDFMYF AND I CKCTR1 / GET VALUE TO AND FROM CALLER+1 ISZ CKCTR1 / BUMP RETURN PTR. TO GET NEXT PARAM. TAD I CKCTR1 / GET NEG. VALUE OF CHAR. TO MATCH. SNA CLA / SKIP IF: NO MATCH JMP BKEDI3 / RULER LINE - SKIP MATH ISZ CKCTR1 / BUMP RETURN POINTER JMP I CKCTR1 / RTRN TO CALLER TO CONTINUE PROCESSING /++ / INCREMENT_DECIMAL_TAB_COUNT / / FUNTIONAL DESCRIPTION: IDTABCOUNT / / THE FUNCTION OF THIS ROUTINE IS TO CHECK PREVIOUS TO INCREMENTING / DTABCOUNT THAT IT HAS NOT BEEN INCREMENTED ONCE ALREADY FOR THE / CURRENT TABPOSITION. IF NOT YET INCREMENTED FOR THE CURRENT / TABPOSITION THEN INCREMENT DTABCOUNT AND SET LAST_TAB_POSITION = / -TABPOSITION FOR THE NEXT PASS THROUGH IDTABCOUNT. / / CALLING SEQUENCE: JMS IDTABCOUNT / / INPUT PARAMETERS: AC = 0 / / IMPLICIT INPUT: GLOBAL: TABPOSITION, LTABPOSITION, DTABCOUNT / / OUTPUT PARAMETERS: AC = 0 / / IMPLICIT OUTPUT: GLOBAL: LTABPOSITION, DTABCOUNT / / COMPLETION CODE: NONE / / SIDE EFFECTS: 1) LTABCOUNT INITS. IN EXTRACTNUMBER ROUTINE / /-- IDTABCOUNT, / INCREMENT_DECIMAL_TAB_COUNT XX TAD TABPOSITION / HAS DTABCOUNT ALREADY BEEN INCREMENTED / FOR THIS TAB POSITION? TAD LTABPOSITION / ADD LAST_TAB_POSITION SZA CLA / SKIP IF: SO ISZ DTABCOUNT / NO - INCREMENT DECIMAL TAB COUNT TAD TABPOSITION / SET LTABPOSITION CIA DCA LTABPOSITION JMP I IDTABCOUNT / RETURN / ADJUS0 Moved this edit to make space for ADUNIT /a247 / BKEDI4 Moved elsewhere this edit to make space for ADUNIT /a247 /**************************************************************************** / ADUNIT ADance UNIT routine is used by READNEXTCHARACTER /a247 / to aquire the next relevent character from the edit /a247 / buffer. If not in a dead key sequence, then ADVSPC /a247 / is used to get the next printable character. If a /a247 / dead key sequence is in progress, ADVPTR is used /a247 / until an End Dead is seen. On encountering the End /a247 / Dead, the dead key sequence flag is reset and /a247 / processing returns to normal. /a247 /**************************************************************************** ADUNIT, XX / Start of routine to get next unit /a247 TAD DEADKEY / Get the state of the dead key flag /a247 SZA CLA / Are we in a dead key sequence? /a247 JMP DEAD / Yes, get the next non-null file char /a247 CIFEDT / No, call the ADVSPC routine to get /a247 JMS CALLAR / the next printable character /a247 ESASPC / /a247 CDFBUF / The field of the text buffer /a247 JMP AUETXT / Jump to non-skip ETX exit /a247 JMP AUOKXT / Jump to skip return with normal char /a247 DEAD, CIFEDT / Call a routine in the editor using /a247 JMS CALLAR / the universal entry point /a247 ESAPTR / Call the Advance Pointer routine /a247 CDFBUF / with the datafield of the edit buffer /a247 JMP AUETXT / ETX found return /a247 TAD (-ECNDOV) / Test for end of dead key sequence /a247 SNA / Is this the end of the sequence? /a247 DCA DEADKEY / Yes, reset the dead key flag /a247 TAD (ECNDOV) / Recover the character /a247 AUOKXT, ISZ ADUNIT / Skip return on normal character /a247 AUETXT, JMP I ADUNIT / Return /a247 DEADKEY,0 / The Dead Key Sequence Flag /a247 /**************************************************************************** / INSMCH INSert Multinational CHaracter. This routine is used /a247 / by editor maths mainly for the task of inserting /a247 / multinational currency symbols. /a247 / / The character to insert should be passed in the AC /a247 / The attributes for the character should be passed in MQ /a247 /**************************************************************************** INSMCH, XX / Start of 8 Bit insertion routine /a247 DCA INCHAR / Save the character passed in AC /a247 SWP / Get the attribute bits /a247 DCA INSATR / Save them for now /a247 TAD INCHAR / Get the character back again /a247 AND (200) / Test the eigth bit /a247 SNA CLA / Is this a multinational character? /a247 JMP INMNXP / No, output normally /a247 TAD (ISTRING) / Yes, get the addr of std dead key seq./a247 DCA X1 / Store in index register /a247 ISZ DEADKEY / Tickle deadkey flag so READNEXT works /a247 TAD ISTRING / Get the First character of the seq. /a247 JMP INMENT / Enter the output loop /a247 INMLOOP,TAD I X1 / Get the next character in the sequence/a247 SPA / Is this the terminating character? /a247 JMP INMEXT / Yes, print it then exit /a247 AND P177 / No, so strip eigth bits off /a247 MQL / Save in the MQ register /a247 TAD INSATR / Get the attribute bits /a247 MQA / Then merge with the character code /a247 INMENT, JMS INSCODE / Insert the character in the buffer /a247 JMS READNEXT / Move edit pointer to next position /a247 NOP / (Should not reach end of file) /a247 JMP INMLOOP / And loop for next character /a247 INMNXP, TAD INCHAR / For ordinary 7 bit chars, just recall /a247 MQA / the character and add the attributes /a247 SKP / /a247 INMEXT, AND P177 / Strip the top bit from terminator /a247 JMS INSCODE / Insert the character into the buffer /a247 DCA DEADKEY / End of dead key sequence /a247 JMP I INSMCH / Return /a247 ISTRING, ECSTOV / Start of Dead Key character /a247 " / Space /a247 "2 / Multinational character set /a247 INCHAR, 0 / The required character /a247 ECNDOV+4000 / End Dead Key and terminator bit /a247 INSATR, 0 / Place to store the attribute bits /a247 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------- PAGE / RELOC CDFMYF= CDFEDT / ALL EDITOR OVERLAY CODE EXECUTES IN EDITOR FIELD /d238 NOPUNCH / TURN OFF THE BINARY PUNCH   / WPEDOV - EDITOR OVERLAYS / / /=============================================================== / / / ******* EDIT HISTORY ******* / 240 KMD 23-Sep-85 Add Spanish Xlations and page size checks / 239 KMD 17-Sep-85 Add V30 Sveeedish translation IFDEFs / 238 KMD 16-Sep-85 Add V30 NORWAY IFDEFS / 237 KMD 15-Sep-85 Move TEC8VAL routine to blaster / 236 KMD 13-Sep-85 Add Spanish technical changes / 235 EMcD 26-Aug-85 Add Insert-Overstrike Mode / 234 MART 16-AUG-85 ADD DUTCH / 233 RCME 12-Jul-85 Add new table and code to allow keys / returning 8 bit characters on mcs / keyboards to generate technical chars. / 232 RCME 01-Jul-85 Add new table for allowable 8-bit chars in / ruler definitions / 231 EMcD 15-May-85 Allow (and show) Breaking Hyphen on Gold / View for MCS chars / 230 EMcD 14-May-85 Upper/Lower casing of 8 bit chars / 229 EMcD 07-May-85 Allow Swap on Dead key chars / 228 EMcD 01-May-85 Allow Search on 8bit chars / 227 EMcD 01-May-85 Fix Bug with Swap on Bold char / 226 EMcD 30-Apr-85 Change UNDEADing to UNDEAD extended / tech and MCS deads. / 225 EMcD 26-Apr-85 Moved Gold Swap and allow allow 8 bit in / Abbrev doc. / 224 rcme 23-Apr-85 Add code and hole to merge overlay to deal / with extended field names from MATH module / containing multinational and tech characters / 223 EMcD 19-Mar-85 Allow line Drawing set for tech chars / /-------------------- All mods below refer to V2.0 and earlier -------------- / / 222 IHZ 11-JAN-84 Fix HELP MENU display for DECmate I / 221 WCE 11-JAN-84 Fix COLUMN CUT ending on spaced line / 220 WCE 17-DEC-84 Fix GOLD SEARCH not checking line length / 219 WCE 13-DEC-84 Fix GOLD VIEW problem with multiple screens / 218 WCE 10-DEC-84 Fix COLUMN STRIP RIGHT of single column / 217 WCE 01-NOV-84 Fix GOLD RULER when backing up across screens / 216 DFB 31-OCT-84 Fix COLUMN PASTE to paste on correct line / 215 WCE 30-OCT-84 Fix COLUMN PASTE pasting extra TAB characters / 214 WCE 22-OCT-84 Fix premature GOLD-HALT problem with go-to-page / 213 DFB 19-OCT-84 Fix to column strip left when at left margin / 212 EJL 16-OCT-84 Change help column values / 211 EJL 26-SEP-84 Fix to uparrow code for ruler problem / 210 WCE 24-SEP-84 Search for technical characters / Rewrote Search, GSR, Tech Character overlays / 209 WCE 20-SEP-84 Fix to List Processing for Caller Routine Call / 208 WCE 19-SEP-84 Fix to COLUMN PASTE not pasting CUT text / 207 EJL 18-SEP-84 Prevent case change on dead key sequences / 206 WCE 13-SEP-84 Fix Go-To-Page zapping search buffer text / 205 WCE 11-SEP-84 Move cursor to CUT buffer overflow point / 204 WCE 07-SEP-84 Fix for GOLD CUT not bringing rulers like CUT / 203 DFB 05-SEP-84 Fixes for Column Cut Paste BUG / 202 EJL 04-SEP-84 More fixes for arrow keys and math / 201 DFB 29-AUG-84 Fixes for Column Cut Paste / 200 GDH 29-AUG-84 Fix for Go-To-Ruler not found within buffer. / 199 WCE 28-AUG-84 Fix for Go-To-Ruler not found within buffer / 198 WCE 25-AUG-84 Fix for Global Search finding Centered Lines / 197 EJL 23-AUG-84 Fix reset of ruler during window change / 196 WCE 21-AUG-84 Fix for no error at 50 characters in GSR / 195 WCE 20-AUG-84 Fix for GSR not completting replace operation / 194 EJL 14-AUG-84 Process math on down arrow / 193 EJL 07-AUG-84 Increase speed of column paste / Fix ruler status line in ruler edit mode / 192 BC 26-JUL-84 Delete SPLTFL, use WIDNAR flag for 80/132 / 191 WCE 23-JUL-84 Fix for List Processing HALT problem / 190 WCE 16-JUL-84 Changes for BRITISH pound sign / 189 MP 16-JUL-84 Fix problem with GOLD Menu from G.S. menu / 186 BC 16-JUL-84 Add manual screen width choice / 185 WCE 10-JUL-84 Fix for HELP key crashing system / 184 EJL 09-JUL-84 Fix for storing rulers / 183 JAC 08-JUL-84 Changed size of buffer for 100 UDK'S / 182 WCE 28-JUN-84 Various bug fixes for the EDITOR / Problem redisplaying centered lines after paste / Problem with GOLD PAGE and STATUS LINE / 181 WCE 27-JUN-84 Rewrote EDITOR MENU page to fix SO-CD problem / 180 EJL 26-JUN-84 Extend ruler from 158 to 238 / 179 GDC 22-JUN-84 Column cut, paste, and strip inserted. / 178 MP 17-JUN-84 XXFIND will search for CR, TABS. / 177 DKR 01-JUN-84 Added Calls to OVRLOF (turn ruler display / on/off) in OVINIT and OVMENU. And, Erase / Line if Rulers-Off .AND. Gold:Tab makes a / new ruler / 176 DKR 29-MAY-84 Gold:Tab Code (Indent Tabs) / 175 EJL 29-MAY-84 Update Technical Character Mapping Table / 174 GDC 14-MAY-84 Changes to support second overlay area. / 173 WCE 11-MAY-84 Remove all occurances of USERNO / 172 EJL 08-MAY-84 Install Technical Character overlay / Fixed deadkey and required space / 171 WCE 02-MAY-84 Moved Resident Overlay from WPEDOV to WPEDIT / 170 WCE 26-APR-84 Fixed problem with LP and SWAP AREA / 169 AH 22-MAR-84 Added code for Column Cut / 168 WCE 13-MAR-84 Changed reset point from EIFXT2 to EIFIX / for SEARCH and CONTINUE SEARCH overlay / Changed startup point from EIFIX to EINEXA to / correct problem with blocks used display / 167 WJY 24-FEB-84 Hang up modem on finish on DMI also / 166 WJY 08-FEB-84 DECmate I compatability / 165 WCE 19-JAN-84 Made swap area smaller by two blocks / 164 EH 18-JAN-84 Removed fix #162 / 163 EH 09-JAN-84 Do Not destroy UDK's if no next ruler found / 162 EH 21-DEC-83 Fix PASTE to insert prior to centered mark / 161 GDH 14-DEC-83 Fixed View code to update status line. / 160 GDH 14-DEC-83 Changed DSPRUL calling seq. OVRULR effected. / 159 EH 08-DEC-83 Fix G-Ruler, G-Menu System Halt / 158 DMB 30-NOV-83 Misc bug fixes: (1) GTP no longer winds up / on wrong page if it passes empty pages or / if the destination new-page-marker is too / close to the start of the block; / (2) GOLD:BOT and GTP no longer set "MA NO". / 157 DMB 12-NOV-83 REWRITE SUBSTANTIAL PORTION OF GOTO-RULER / TO FIX SOME PARTICULARLY TRICKY BUGS. / EDIT HISTORY ONLY UPDATED FOR ROUTINES / NOT EXCLUSIVELY USED BY GOTO-RULER. / 156 WCE 17-NOV-83 FIX FOR L.P TO PRINTER NOT SCROLLING AND / DUPLICATE WARNINGS FOR LACK OF SPACE / 155 DMB 03-NOV-83 FIX VARIOUS GOTO-RULER BUGS / 154 WJD 31-OCT-83 MAKE GOLD_BOTTOM ACT LIKE GTP / and remove GOLD_HALT process from GTP & GOLD_BOTTOM / 153 WCE 27-OCT-83 REMOVED ALL PREVIOUS EDIT HISTORIES FOR / NEW VERSION 1.5 SOURCE FILES / WRITE OUT CODE FOR THE EDITOR OVERLAYS FIELD 0 / FIELD WHERE RXHAN IS LOCATED *200 / START ADDRESS USED BY OS8 "GO" COMMAND JMP I .+3 / LOCATION USED TO START UP RXHAN JMP I .+1 / LOCATION USED TO RETURN TO OS8 MONITOR 7605 / ADDRESS OF OS8 MONITOR RETURN POINT RXLOAD / ADDRESS OF START LOCATION FOR RXHAN *RXLDLS / ADDRESS WITHIN RXHAN TO OVERLAY RXEWT / WRITE FUNCTION CODE 0 RXQBLK / ADDRESS OF QUEUE BLOCK TO USE . / ADDRESS OF TABLE OF DISK COMMANDS DLOEDO ;0;CDF 30;-17 / FIELD ONE EDITOR OVERLAYS DLOEDO+17;0;CDF 40;-20 / FIELD TWO EDITOR OVERLAYS DLOEDO+37;0;CDF 50;-17 / FIELD THREE EDITOR OVERLAYS 0 / / MISC GLOBAL SYMBOL DEFINITIONS FOR EDITOR OVERLAYS / CDFMYF= CDFEDT / EDITOR OVERLAY CODE EXECUTES IN EDITOR FIELD IFZERO OVLAYM / INITIALIZE MERGE OVERLAY ADDRESS OVRNUM= 0 / INITIALIZE OVERLAY NUMBER COUNTER ONE IFZERO OVLAY1 / INITIALIZE OVERLAY NUMBER ONE ADDRESS OV2NUM= 0 / INITIALIZE OVERLAY NUMBER COUNTER TWO IFZERO OVLAY2 / INITIALIZE OVERLAY NUMBER TWO ADDRESS / RPPGDS (GOTO-PAGE) DESCRIPTOR WORD BIT DEFINITIONS - / BIT VALUE: / IF SET MEANS: RPRULR= 4000 / RULER PRESENT IN THIS BLOCK RPMTHB= 100 / MATH BEGINS IN THIS BLOCK RPMTHO= 100 / PAGE IS WITHIN A MATH AREA RPMTHE= 100 / MATH ENDS IN THIS BLOCK DH1BL= 55 / OFFSET INTO HEADER BLOCK # 1 / FOR FIRST BLOCK IN DOCUMENT FIELD 3 *0 /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVSTLD= .-OVLAY1+OVRNUM /LOAD THIS OVERLAY FOR STRIP JMP OVJRTN OVSTPX= .-OVLAY1+OVRNUM JMP ESSTPX /SECOND HALF OF STRIP OVMRG4= .-OVLAY1+OVRNUM / DISK FULL EXIT POINT FOR MERGE IAC OVMRG3= .-OVLAY1+OVRNUM / FINAL MERGE OVERLAY JMP XVMRG3 OVINI1= .-OVLAY1+OVRNUM / NORMAL EDIT INITIALIZE TAD (-DLSTAT) / PICK UP ADDRESS OF STATUS CODE CIFMNU / CHANGE TO MENU FIELD PGSWAP / AC=DLSTAT SO JUST READ IN STATUS CODE /D170 / INITIALIAZE THE SWAP AREA ON THE DISK BY STORING HALT INSTRUCTIONS IN /D170 / UNUSED LOCATIONS. ENTER WITH THE DATA FIELD POINTING TO THIS FIELD /D170 TAD (SWPEND) / POINTER TO FIRST MEMORY LOCATION /D170 DCA T1 / STORE IN TEMPORARY COUNTER /D170 TAD (DSSTAT^400+SWPBEG-SWPEND) / NUMBER OF WORDS TO CLEAR /D170 CIA / MAKE COUNT NEGATIVE /D170 DCA T2 / STORE NEGATIVE COUNT OF WORDS TO CLEAR /D170 CDFMNU / CHANGE TO MENU FIELD /D170 CLRLOP, TAD (7402) / PICK UP HALT INSTRUCTION /D170 DCA I T1 / STORE IN MENU FIELD /D170 ISZ T1 / BUMP COUNTER TO NEXT ADDRESS /D170 ISZ T2 / INCREMENT COUNTER - SKIP IF DONE /D170 JMP CLRLOP / NOT DONE, GO DO IT AGAIN CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE JMS MNUGET MNFNO DCA FILENO DCA FORMNO / CLEAR FORM NUMBER (USED AS FLAG TO INDICATE / NOT IN LIST PROCESSING DCA FILOPT /******************** EDITOR MATH INIT CALL **************************** / THE FOLLOWING CALL IS MADE TO THE MATH FIELD TO INITIALIZE THE MATH / MODULE CODE AND SET "MTHTYP" TO 1 IN THE MATH FIELD IN PREPARATION / FOR USING EDITOR MATH. A 1 IS PLACED IN THE AC BEFORE THE CALL TO TELL /"RTRN4" THAT IT IS TO INIT FOR EDITOR MATH NOT LIST PROCESSING MATH / NOTE THAT THIS SAME INIT CALL TAKES PLACE IN "OVEXIT" AND HERE IN /"OVINI1". AC0001 / SET THE AC = 1 CIFMTH / CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN4 / GO SET "MTHTYP" = 1; AND INIT MATH MODULE /****************** END MATH INIT CALL ***************************** CIFMNU / CALL ROUTINE IN FIELD TWO TO LOAD JMS I OLAYCL / IN THE EDITOR MATH OVERLAY 10 / NUMBER OF THE EDITOR MATH OVERLAY DCA BUFBEG TAD (BUFEND) DCA BUFSIZ /D171 JMS CPYBUF /D171 -200 /D171 CDFMYF /D171 MGOVLY-1 /D171 CDFMYF /D171 OVLAYM-1 TAD (XGETET) DCA MGPTC1 TAD (ESGETX&177+4600) DCA MGPTC2 TAD MGPTC2 DCA MGPTC3 TAD MGPTC3 DCA MGPTC4 CDFSYS TAD I (CLOCK+3) MQL / SAVE MINUTES AND HOURS AT TAD I (CLOCK+4) / START OF EDIT CDFMYF DCA OLDHR MQA DCA OLDMIN TAD (WIDTH-COLM81) / SET TO NARROW SCREEN AT STARTUP /A186 DCA WIDNAR / /A186 JMP OVJRTN XVMRG3, DCA MRGDNC / SET EXIT CONDITION CODE CURMOV NOP / FINISH WITH STYLE JMS CLR132 / REVERT TO 80-COLUMN MODE PUTESC / CLEAR SCREEN "[&177+4000 "2&177+4000 "J-200 JMS PROMPT MSGF / SHOW WE'RE ALMOST DONE AC7777 CHKPTR SMA CLA JMP .-3 / GET TO STX MRGDNA, AC0001 CHKPTR SNA JMP .-3 / IGNORE NULLS SPA CLA JMP MRGDNB / JUMP IF ETX TAD I CURPTR PUTSTX / PUT OUT REAL CHAR JMP MRGDNA / AND LOOP FOR ALL MRGDNB, TAD FILENO SZA CLA JMP MRGDNF / JUMP IF MERGE TO FILE / ELSE CLOSE PRINTER AC7777 PUTSTX / SET EOF FLAG (AND WAIT FOR PRINTER) JMP MRGDNX / THEN EXIT MRGDNF, JMS DSKCAL XDSKCL / CLOSE EDIT FILE MRGDNX, CLA CDFMYF / CHANGE DATA FIELD TO THIS FIELD /A170 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD /A170 PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE /A170 TAD MRGDNC / LOAD CONDITION CODE JMP EDEXI3 / THEN EXIT MRGDNC, .-. X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / MGOVLY MOVED TO WPEDIT RESIDENT AREA BY EDIT 171 / STRP13 SEARCH FOR NEXT LINE / / ESSTPX, CDFBUF TAD I CURPTR /FETCH FIRST CHAR JMP STRP14 STRP13, ADVSPC JMP STPEX1 STRP14, AND P177 ZZCASE STPTB3-1 / ECNWLN; STRP15 /NEWLINE COULD BE GOOD / ECNWPG; STPEX2 /NEWPAGE HERE IS NONO / ECSTRL; STPEX2 /SAME WITH RULER / ECMDFL; STRP16 /MODIFIED FLAG SKIP INC CURSOR / 0 ISZ CURSOR STRP16, JMP STRP13 /GO BACK AND CHECK NEXT CHARACTER /C218 /D218 STRP16, CURMOV /D218 JMP STPEX1 /EOF IS ACTUALLY CATASTROPHIC FAILURE /D218 JMP STRP13 /GO BACK AND CHECK NEXT CHARACTER STRP15, TAD I CURPTR /WHAT TYPE OF NEWLINE? TAD (-ECSLPT) /SELECT POINT? SNA JMP STRP17 /YES FINISH OUT TAD (ECSLPT-ECNWLN) /HARD RETURN? SZA CLA JMP STPEX1 /NOPE BAD DATA STRP22, AC0001 CURMOV JMP STPEX1 /CATO. ERROR TAD I CURPTR AND P177 TAD (-ECNWPG) SNA CLA JMP STRP20 TAD CURPTR DCA IX1 TAD LINE23 DCA CURPTR BKPPTR HLT AND P177 TAD (-ECNDRL) SNA CLA JMP STRP18 STRP23, TAD IX1 DCA CURPTR JMS OV2JMP OVSTRP / STRP18 RULER ABORT / / STRP18, TAD IX1 DCA CURPTR JMP STPEX1 / STRP20 CHECK CURRENT PAGE MARK / / STRP20, TAD I CURPTR TAD (-ECPCT1) SNA JMP STRP25 TAD (ECPCT1-ECPCT2) SNA CLA JMP STPEX1 JMP STRP22 STRP25, AC0001 CURMOV JMP STPEX1 TAD I CURPTR TAD (-ECSLPT) SNA JMP STRP17 TAD (ECSLPT-ECPCT2) SZA CLA JMP STRP25 JMP STRP22 / STPXE1 EXIT VIA STPNFG / / STPEX1, JMS OV2JMP OVSNFG / STPEX2 EXIT VIA STPEXB / / STPEX2, JMS OV2JMP OVSEXB STPTB3, ECNWLN; STRP15 /NEWLINE COULD BE GOOD ECNWPG; STPEX2 /NEWPAGE HERE IS NONO ECSTRL; STPEX2 /SAME WITH RULER ECMDFL; STRP16 /MODIFIED FLAG SKIP INC CURSOR 0 STPTB4, ECNWLN; STRP28 ECNWPG; STRP28 ECTAB; STRP28 0 STPTB5, ECNWLN; STRP12 /NO COLUMN TO STRIP ECNWPG; STPNFG /BAD DATA FORMAT ECTAB; STRP28 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 / OVERLAY NUMBER OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / CURRENT OVERLAY CONTENTS IFDEF FORIN < ACCENT= .-OVLAY1+OVRNUM JMP XCCENT > / END IFDEF FORIN OVSPCE= .-OVLAY1+OVRNUM TAD FORMNO SNA CLA JMP EISPCE OVLJMP OVMRG4 / QUIT NOW IF MERGING OVSPC2= .-OVLAY1+OVRNUM ISZ BLKALM / FORCE HARD LIMIT JMP EISPCE OVINIT= .-OVLAY1+OVRNUM / CURRENT OVERLAY TAD RPBIN1 / EXCLUSIVE GOTO PAGE FLAG SMA CLA / DONT' CLEAR SCREEN IF GOTO PAGE JMS CLR132 / REVERT TO 80 COLUMNS CDFFIO DCA I (SCFSPC) / CLEAR SPACE LEFT INDICATOR CDFMYF TAD FILENO / GET THE OUTPUT FILE NUMBER SNA / CHECK FOR LIST PROCESSING TO A PRINTER JMP INIX00 / YES, SKIP AROUND DOCUMENT RELATED ITEMS MQL TAD FILOPT / SAVE FILE #, SET NORMAL OPTION JMS DSKCAL XDSKIN / INIT FILE SZA JMP EDEXI3 / QUIT IF OPEN FAILED JMS HDRGET HDRPSZ / CHECK PAGE SIZE SZA CLA JMP .+5 / IF ZERO, JMS MNUGET MNPGSZ / GET DEFAULT PAGE SIZE JMS HDRPUT HDRPSZ / AND PUT TO HEADER JMS HDRGET / GET FILE SIZE FROM DOCUMENT HEADER HDRFSZ / POINTER TO FILE SIZE JMS MNUPUT / STORE FILE SIZE FOR STATUS LINE LINUSD-MUBUF / LOCATION FOR BLOCKS USED IN DOCUMENT JMS MNUPUT / CLEAR BLOCKS FREE FOR STATUS LINE LINFRE-MUBUF / LOCATION FOR BLOCKS FREE IN DOCUMENT JMS MNUPUT / CLEAR HIGH ORDER PAGE NUMBER LINPGH-MUBUF / HIGH ORDER PAGE NUMBER IN DOCUMENT AC0001 / SET TO A COUNT OF ONE JMS MNUPUT / STORE PAGE NUMBER FOR STATUS LINE LINPGL-MUBUF / LOW ORDER PAGE NUMBER IN DOCUMENT AC0001 / SET TO A COUNT OF ONE JMS MNUPUT / STORE LINE NUMBER FOR STATUS LINE LINNUM-MUBUF / LOCATION FOR LINE NUMBER IN DOCUMENT /D157 TAD (3777) / CLEAR DON'T-DISPLAY-MSG FLAG /D157 AND RPBIN1 / FROM UNIQUE GOTO PAGE WORD /D157 DCA RPBIN1 /D156 TAD FORMNO / GET THE FORM NUMBER /D156 SZA CLA / ARE WE MERGING (LIST PROCESSING) /D156 JMP INIX01 / YES, PICK UP MAXIMUM NUMBER OF LINES /D156 JMS MNUGET / NO, THEN SET UP FOR SCROLLING AREA /D156 MNSTAT / PICK UP NUMBER OF STATUS LINES /D156 CIA / MAKE NEGATIVE FOR SUBTRACT /D156 INIX01, TAD (NPTRS) / PICK UP MAXIMUM NUMBER OF LINES /D156 DCA SCRNLN / SAVE FOR USE BY EDITOR ROUTINES TAD (-24) / USE 20 AS CUTOFF AT ALL TIMES INIX00, DCA SPCCHK / FOR L.P. TO A PRINTER, USE A VALUE OF ZERO DCA BLKALM / CLEAR SPACE ALARM FLAG /D156 DCA BLWTCH / CLEAR FREE BLOCK WATCH WORD TAD FORMNO / GET THE FORM NUMBER /A156 SZA CLA / ARE WE MERGING (LIST PROCESSING) /A156 JMP INIX01 / YES, PICK UP MAXIMUM NUMBER OF LINES /A156 JMS MNUGET / NO, THEN SET UP FOR SCROLLING AREA /A156 MNSTAT / PICK UP NUMBER OF STATUS LINES /A156 CIA / MAKE NEGATIVE FOR SUBTRACT /A156 INIX01, TAD (NPTRS) / PICK UP MAXIMUM NUMBER OF LINES /A156 DCA SCRNLN / SAVE FOR USE BY EDITOR ROUTINES /A156 / +++ Modify RULOFF Case-Table to turn Display-Rulers ON or OFF. /a177 / /a177 / MNSTAT = 0 or 1 ... Ruler Display ON /a177 / MNSTAT = 2 or 3 ... Ruler Display OFF /a177 / /a177 JMS OV2JMP / LOAD OVERLAY 2 /a177 OVRLOF / Adjust Case-Table and Continue /a177 / INITIALIZE EDIT PAGE 0 CONTROL WORDS JMS CLRMEM / CLEAR MEMORY SINZRO-1 / FROM -NINZRO / - NUMBER OF LOCATIONS CDFEDT / CDF INSTRUCTION / INITIALIZE EDIT MATH PAGE 0 CONTROL WORDS JMS CLRMEM / CLEAR MEMORY MF5P0ET-1 / FROM -LMF5P0ET / - NUMBER OF LOCATIONS CDFLP / CDF INSTRUCTION / INITIALIZE EDIT BUFFER AC7777 / SET POINTER TO BUFFER_BEGIN - 1 TAD BUFBEG DCA X0 CDFBUF TAD (ECBFBG) / GET BUFFER BEGIN CODE DCA I X0 / INSTALL AT TOP OF BUFFER TAD (ECSTX) / GET START OF TEXT CODE DCA I X0 / INSTALL IN NEXT BUFFER LOCATION TAD (ECETX) / GET END OF TEXT CODE DCA I X0 / INSTALL IN NEXT BUFFER LOCATION TAD X0 / SET CURPTR TO POINT AT ETX CHAR. THAT / WAS JUST INSTALLED DCA CURPTR / CLEAR THE REST OF THE BUFFER TAD BUFSIZ / SET COUNTER FOR NO. OF WORDS TO CLEAR CIA TAD (4) DCA X1 DCA I X0 / CLEAR ONE LOCATION ISZ X1 / SKIP IF: FINISHED JMP .-2 / NOT FINISHED! DO THE NEXT LOCATION! TAD (ECBFND) / INSTALL BUFFER_END CHARACTER DCA I X0 / INITIALIZE SCREEN / *** / INITIALIZE EDITOR'S PTRBLK (POINTER_BLOCK) TABLE CDFMYF JMS CLRMEM / CLEAR MEMORY PTRBLK-1 / FROM INIXLN, -NPTRS+1 / - NUMBER OF LOCATIONS CDFEDT / CDF INSTRUCTION TAD CURPTR / SET LAST LOC. IN PTRBLK = CURPTR DCA I X0 TAD CURPTR / INITIALIZE LINE 23 POINTER /A157 DCA LINE23 /A157 DCA CURSOR / CLEAR CURSOR /A157 DCA LOWLIM / CLEAR LOLIM /A157 AC7777 / A180 CIFMNU PGSWAP / CLEAR CURRENT RULER IF NOT DOING GOTO-PAGE, GOLD:BOT, OR GOTO-RULER; /A157 / CLEAR "GOTO-PAGE, GOLD:BOTTOM, OR GOTO-RULER" FLAG. /A157 CLA CLL CML RAR / L,AC = 04000 /A157 TAD RPBIN1 / LINK=RPBIN1 BIT 0,AC0=-RPBIN1 BIT 0 /A157 SMA /A157 DCA RPBIN1 / CLEAR RPBIN1 BIT 0 /A157 / (CLEAR "GTP, GOLD:BOT, OR GTR" FLAG, /A157 / BUT FLAG LIVES ON IN LINK) /A157 JMP INIX04 / CONTINUE ON NEXT PAGE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /D157 INIX04, TAD CURPTR / INITIALIZE LINE 23 POINTER /D157 DCA LINE23 /D157 DCA CURSOR / CLEAR CURSOR /D157 DCA LOWLIM / CLEAR LOLIM / INHIBIT CLEARING OF CURRENT RULER FOR GOTO-RULER /A157 INIX04, SZL CLA / G-T-PAGE, GOLD:BOT OR G-T-RULER? /A157 JMP INIX05 / YES: PRESERVE CURRENT RULER /A157 JMS CLRULR / NO: CLEAR RULERS JMS COPRUL INIX05, TAD FORMNO /M157 SNA JMP .+3 JMS DSKCAL XRDFIN / INIT FORM FILE IF MERGING JMS LODCHR / GET FIRST CHARACTER JMP INIX03 / THERE WAS NONE, GO INSERT A RULER TAD (-ECSTRL) / IS IT THE START OF A RULER SNA CLA / SKIP IF: NOT JMP INIX02 / RULER FOUND, NO CHANGE NEEDED / NO RULER! INSERT ONE! INIX03, CDFMYF JMS RLGETS JMS INSRUL / ELSE INSERT RULER 0 TAD (ECRMFL) JMS INSRL1 / AND RLRMOD CODE TAD LINE23 DCA CURPTR / RESET TO START OF MEM INIX02, PUTESC / SET APPLICATION KEYPAD MODE "=-200 JMS SETCUR / GET TO BOTTOM LINE AC0003 DCA SCRLCT / INIT TO TOP TAD FORMNO / AND START UP RIGHT PROCESS SNA CLA JMP TOOVJRTN / CHECK AMOUNT OF ROOM ON DISK BEFORE / RESUME OF EDIT OR GTP / AC7777 / SET AC = -1 /A170 / CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD /A170 / PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA /A170 OVLJMP OVMRG2 / ... OR MERGE EISPCE, JMS CLR132 / MAKE SURE THE SCREEN IS IN NARROW MODE AC0003 / SET UP TO RESET SCROLL REGION CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD JMS I (CALLN1) / RESET SCROLL REGION SET ABSOLUTE MODE / CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD / PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE TAD BLKALM / CHECK FOR HARD LIMIT SZA CLA / IF NOT SET, THEN TAKE SOFT APPROCH /A156 /D156 SNA CLA /D156 JMP EISPC3 / NOT HARD, TAKE SOFT APPROACH /D156 TAD BLWTCH / SEE IF THIS IS THE FIRST WARNING /D156 SZA CLA EISPC2, AC0002 / SET-UP MENU TO FORCE EXIT EISPC3, IAC / TAKE SOFT WARNING APPROACH JMS MNUPUT MNTMP1 CDFFIO TAD I (SCFSPC) JMS MNUPUT MNTMP2 CIFMNU PGSWAP CIFMNU JMS I MNUCAL DLMEM1 /D156 TAD BLKALM / IS THIS A FORCE EXIT? /D156 SNA CLA /D156 JMP EISPC4 / NO, RETURN TO EDITOR /D156 TAD BLWTCH / COULD BE, CHECK BLWTCH /D156 SZA CLA / FIRST WARNING! DON'T FORCE FILE TAD BLKALM / IS THIS A FORCE EXIT? /A156 SZA CLA /A156 JMP EIFILE / YES! FILE THE DOCUMENT! EISPC4, AC7777 / SET AC = -1 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA TAD WIDNAR / ARE WE FORCED WIDE? /M192 SNA CLA / SKIP IF NOT /M192 JMS SET132 / YES JMS CLSSET / USE CLSCRN IN FXSCRL TO DISPLAY STATUS TAD OPNFLG / CHECK VALUE OF OPEN FLAG SNA CLA / SKIP IF: OPENING A DOCUMENT JMP EINEXT JMP OVJRTN / RESUME NORMAL EDIT OR GTP /++ / CLRMEM / FUNTIONAL DESCRIPTION: CLEAR_MEMORY / THIS ROUTINE WILL CLEAR ANY SECTION OF MEMORY AS PER PARAMETERS / SPECIFIED AT CALLER+1, 2, AND 3. / CALLING SEQUENCE: JMS CLRMEM / ADDRESS - 1 TO START CLR / -NUMBER OF LOCATIONS TO CLR / CDF INSTRUCTION / INPUT PARAMETERS: AC = 0 / IMPLICIT INPUT: X0, T1 / OUTPUT PARAMETERS: AC = 0 / IMPLICIT OUTPUT: X0, T1, CLRME1 / COMPLETION CODE: NONE / SIDE EFFECTS: NONE /-- CLRMEM, XX / CLEAR_MEMORY TAD I CLRMEM / GET ADDRESS-1 OF MEM. TO BE CLEARED DCA X0 / SAVE IT ISZ CLRMEM / BUMP RETURN POINTER TAD I CLRMEM / GET -NUMBER OF LOCATIONS TO BE CLEARED DCA T1 / SAVE IT ISZ CLRMEM / BUMP RETURN POINTER TAD I CLRMEM / GET CDF INSTRUCTION FOR MEM. TO BE CLEARED DCA CLRME1 / SAVE IT ISZ CLRMEM / BUMP RETURN POINTER CLRME1, .-. / HOLDS CDF INSTRUCTION DCA I X0 / BUMP POINTER THEN CLEAR LOCATION ISZ T1 / FINISHED? SKIP IF: SO JMP .-2 / CLEAR THE NEXT LOCATION CDFMYF / RESTORE DATA FIELD JMP I CLRMEM / RETURN / THIS ROUTINE CHECKS TO SEE HOW MUCH ROOM IS LEFT ON THE DISKETTE AT / OPEN TIME. IF THE NUMBER OF BLOCKS LEFT IS GREATER THAN THE CUTOFF / POINT (SPCCHK) RESUME. ELSE, IF THE NUMBER OF BLOCKS IS GREATER / THAN 6, THEN WARN THE USER ABOUT DISK SPACE AND RESUME. ELSE / THE NUMBER OF BLOCKS LEFT IS LESS THAN 6, DO NOT ALLOW THE USER / TO EDIT THE DOCUMENT. / THIS ENTIRE ROUTINE IS EDIT #132 TOOVJRTN, AC0001 / DCA OPNFLG / SIGNIFIES OPENING DOCUMNET CDFFIO / TAD I (SCFSPC) / GET THE # OF AVAILABLE BLOCKS CDFMYF / DCA BLWTCH / AND SAVE NUMBER OF FREE BLOCKS /M156 TAD BLWTCH / RESTORE FREE BLOCK COUNT /M156 TAD SPCCHK / COMPARE TO CUTOFF POINT SMA CLA / SKIP IF: BELOW CUTOFF POINT JMP EISPC4 / ENOUGH BLOCKS LEFT, GO PAGE SWAP AREA TAD BLWTCH / RESTORE FREE BLOCK COUNT /M156 TAD (-7) / COMPARE TO HARD LIMIT SMA CLA / SKIP IF: LESS THAN HARD LIMIT JMP EISPC3 / SOFT LIMIT, WARN USER /D156 ISZ BLWTCH ISZ BLKALM / SETTING THIS WORD TELLS EISPC2 THAT USER JMP EISPC2 / HAS REACHED HARD LIMIT, FILE THE DOCUMENT OPNFLG, 0 / IF = 1: OPEN IFDEF FORIN < / HERE TO TEST FOR ACCENTED CHARACRTERS ON INPUT XCCENT, TAD CHAR1 / GET CHARACTER BACK SPA / INPUT COMMAND? JMP EINEXC / YES, PROCESS COMAND CLA TAD (TABLE1-1) JMS SEARCH / LOOK FOR CHARACTER IN TABLE JMP ACENT1 / NOT FOUND TAD (ECSTOV) / FOUND INSCHR / INSET DEAD KEY START TAD CHAR1 INSCHR / INSERT CHARACTER ACENT0, GETINP / GET NEXT CHARACTER SMA / SPECIAL? JMP ACENT2 / NO JMS BEEPER / DCA CHAR1 /YES, SAVE CHARACTER JMP ACENT0 / ADVPTR / ADVANCE POINTER NOP / JMP EIBAD /? NOP / TAD (ECNDOV) NOP / JMS INSRL1 / STORE END OF DEAD KEY SEQUENCE NOP / TAD CHAR1 NOP / JMP EINEXC / NOW EXECUTE SPECIAL CHARACTER ACENT2, INSCHR / INSERT 2ND CHARACTER TAD (ECNDOV) SKP / INSERT DEAD KEY SEQ. END ACENT1, TAD CHAR1 / CHAR NOT FOUND IN TABLE JMP EINSRT / INSERT INTO TEXT NORMALLY > / END IFDEF FORIN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVMRG1= .-OVLAY1+OVRNUM / "MERGE" OVERLAY # 1 JMS CPYBUF / SAVE CONTENTS OF FIRST SWAP AREA BLOCK /A170 -200 / NUMBER OF WORDS TO SAVE /A170 CDFMNU / SOURCE FIELD /A170 SWPBEG-1 / SOURCE ADDRESS /A170 CDFMYF / DESTINATION FIELD /A170 OVLAYM-1 / DESTINATION ADDRESS /A170 TAD (-DLSTAT) / PICK UP ADDRESS OF STATUS CODE /A170 CIFMNU / CHANGE TO MENU FIELD /A170 PGSWAP / AC=DLSTAT SO JUST READ IN STATUS CODE /A170 JMS CPYBUF / RESTORE CONTENTS OF SWAP AREA BLOCK /A170 -200 / NUMBER OF WORDS TO SAVE /A170 CDFMYF / SOURCE FIELD /A170 OVLAYM-1 / SOURCE ADDRESS /A170 CDFMNU / DESTINATION FIELD /A170 SWPBEG-1 / DESTINATION ADDRESS /A170 TAD (7400) / PICK UP SPECIAL VALUE OF NO-OP CODE /A209 JMS MNUPUT / STORE FOR SWAP AREA LOADED CHECK /A209 CALLN1+2-MUBUF / FLAG LOCATION USED BY CALLER ROUTINE /A209 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD /A170 PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE /A170 TAD (5000) DCA BUFBEG / SET UP EDIT BUF PTRS TAD (BUFEND-5000) DCA BUFSIZ TAD EDMERG DCA EDITOR / COPY RETURN ADDR TAD (CDILP) /A191 DCA EDEXI3 / SET UP RETURN FIELD INSTRUCTION /A191 JMS MNUPUT / CLEAR EDITOR LOCK WORD SO THAT THE /A191 OLL110-MUBUF / EDITOR CODE IN MEMORY IS REFRESHED /A191 JMS CPYBUF -200 CDFMYF MGOVLY-1 CDFMYF OVLAYM-1 TAD (XRDFNC) DCA MGPTC1 / DO PATCHES TAD (SKP CLA) DCA MGPTC2 TAD (SKP CLA) DCA MGPTC3 TAD (ESGETX&177+4600) DCA MGPTC4 CDFBUF / GET ARGS AC7777 DCA X0 TAD I X0 DCA FORMNO TAD I X0 DCA FILENO TAD I X0 DCA FILOPT TAD FILENO SZA CLA JMP MRGINB / INIT PRINT IF NEC. TAD (PRTBUF-1) / GET THE STARTING LOC. OF THE DCA X0 / MERGE-TO-PRINT BUFFER TAD (-PRTSIZ+1) / AND ITS SIZE DCA T1 DCA I X0 / SO THAT ISZ T1 / WE CAN JMP .-2 / CLEAR THE BUFFER TAD (PRTBUF-1) DCA I X0 / AND SET END MARKER CDFMYF TAD (ESPUTX&177+5600) DCA MGPTC4 / RE-PATCH FOR PRINTER AC7777 / Set "printer not halted yet" flag. DCA MRGHFG / Reset "printer halted" flag. CDFPRT RIF TAD (CIF) / GET CIF TO MY FIELD DCA I (PRIRFD) / SET CALL TO OUR ROUTINE TAD (GETPRT) DCA I (PRIRAD) MRGINB, OVLJMP;OVINIT / NOW INIT REST OF WORLD X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / THIS ROUTINE RETURNS A NON-ZERO CHARACTER, UNLESS THE END OF THE FILE IS / REACHED. WHEN THE END OF THE FILE IS REACHED, THE ROUTINE CONTINUES TO / RETURN A ZERO EACH TIME IT IS INVOKED. HOWEVER, THE END OF FILE MARK IS / NEVER REMOVED, SO THE ROUTINE MUST BE "CLOSED" IF LIST PROCESSING IS TO / TERMINATE. TO DO THIS, SIMPLY CALL GETPRT WITH A NON-ZERO AC. MGOVLY, RELOC OVLAYM / DEFINE THE MERGE OVERLAY GETPRT, XX / CALLED FROM PRINTER FOR MERGE OUTPUT CDFBUF / map buffer field for final call. SZA CLA JMP GETPRZ / YES--CLOSE THINGS OFF GETPRY, CDFBUF TAD I PRGETP / GET NEXT CHAR SNA SPA JMP GETPRV / JUMP IF WRAP OR EOF GETPRZ, MQL / SAVE CHAR DCA I PRGETP / SHOW WE GOT IT CDFSYS DCA I (INTFLG) / LET EVERYBODY WAKE UP ISZ PRGETP / WHILE WE FIX PTR CLA MQA / RETRIEVE CHAR GETPRX, CIF CDFPRT / RETURN CIF JMP I GETPRT GETPRV, SNA JMP GETPRW / JUMP IF NO CHARACTERS TO BE HAD IAC SNA JMP GETPRX / RETURN IMMEDIATELY IF END OF FILE DCA PRGETP / ELSE RESET FOR WRAPPED BUFFER JMP GETPRY / AND RETRY GETPRW, CDFMYF CIFSYS JWAIT / WAIT FOR OUTPUT JMP GETPRY / THEN TRY AGAIN PRGETP, PRTBUF / PRINT BUFFER READ PTR PUTST2, HLTTST / See if GOLD:HALT has been pressed. SKP / this return if yes. Process GOLD:HALT JMP PUTST4 / This return if no. continue waiting. AC7777 / check printer status. CDFPRT / get printer status word. TAD I (PRSTTS) / ... SNA CLA / Skip if FR<> 1 (stop/ error status). JMP PUTST4 / JMP to ignore the HALT. continue WAIT TAD MRGHFG / have we halted thee spooler yet? SNA / skip if no. Do it this time. JMP PUTXIT / Ignore character. DCA I (PABORT) / set printer abort flag. unhang spooler AC0001 DCA I (PRSTOP) / set printer stop flag. AC0002 DCA I (PRACTN) / set stop action to cancel. / set flag saying that we already DCA MRGHFG / halted the spooler. PUTXIT, CDFBUF / return to calling routine. JMP ESPUTY / ... PUTST4, CDFMYF CIFSYS JWAIT PUTST1, JMS KBDCHK / CHECK FOR PRINTER COMAND CDFSYS DCA I (INTFLG) / WAKE PEOPLE UP CDFBUF TAD I PRPUTP / CHECK FOR WRAP/ FULL SMA JMP .+6 / JUMP IF NOT WRAP IAC SNA JMP PUTST2 / JUMP IF ALL DONE DCA PRPUTP JMP .-7 / ELSE RESET AND RETRY SZA CLA JMP PUTST2 / JUMP IF FULL TAD T1 DCA I PRPUTP / STORE GOOD CHAR IN BUFFER TAD T1 SPA CLA JMP PUTST3 / JUMP IF ALL DONE ISZ PRPUTP / BUMP BUFFER PTR JMP ESPUTY / RETURN PUTST3, DCA T1 / SAVE CHAR JMP PUTST1 / JOIN OUTPUT LOOP PRPUTP, PRTBUF / OUTPUT PTR TO PRINT BUFFER MRGHFG, 0 / 0 until printer is told to cancel. KBDCHK, XX / CHECK KEYBOARD FOR PRINTER COMMAND KBDCH1, CDFMYF CIFSYS TTYIN / Get char from KB: (not UDK). JMP I KBDCHK / RETURN IF NONE SPA JMP KBDCH4 / COMPLAIN IF SPECIAL AND P177 XLTUPR TAD (-"R+200) SNA JMP KBDCH5 / RESUME? TAD ("R-"N) SNA JMP KBDCH6 / NEW PAGE? TAD ("N&177) / restore origional character. TAD I HLTLST / see if part of GOLD:HALT string. ISZ HLTLST / bump string pointer. SZA CLA JMP KBDCH4 / JMP if not part of GOLD:HALT. TAD I HLTSTR / are we at the end of GOLD:HALT? SZA CLA JMP KBDCH1 / Jmp if NO. Get next input character. JMP KBDCH7 / Hit the end. reset pointer but no beep KBDCH4, JMS BEEPER KBDCH7, TAD (HLTSTR) / reset GOLD:HALT string pointer. DCA HLTLST / ... JMP KBDCH1 / COMPLAIN AND IGNORE IF ILLEGAL KBDCH5, AC0006 SKP / RESUME, KBDCH6, AC0001 / OR NEW PAGE CDFPRT DCA I (PRACTN) JMP KBDCH1 / AND CONTINUE HLTLST, HLTSTR / pointer into GOLD:HALT string. HLTSTR, -33;-117;-120;-140;0 / GOLD:HALT sequencee. X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / UTILITY OVERLAY OVDLTE= .-OVLAY1+OVRNUM JMP XVDLTE / / OVSWAP= .-OVLAY1+OVRNUM / SWAP ENTRY / / OVSWAP which used to be here has been moved to OVHELP to allow /M225 / it more room to handle MCS and give Hyphenation space to also /M225 / handle MCS. /M225 / / / OVTIME overlay has now also been moved to OVHELP to allow /M231 / Hyphenation more space for 8 bit support /M231 / OVHYPS= .-OVLAY1+OVRNUM / HYPHEN PUSH XVHYPS, DCA SCRLFL / CLEAR SCROLL FLAG XVHYPB, AC7777 CURMOV JMP EIBAD / BACK UP TO PREVIOUS LINE TAD SCRLFL SZA CLA / Skip if no. JMP XVHYPC / Jmp if yes. see where we are. AC2000 / see if there is an invisible-hyphen. AND I CURPTR / ... SNA CLA / skip if yes. JMP XVHYPV / no. go to next prev posn. /M231 XVHYB1, TAD CURSOR / save earliest hyphen posn. /A231 IAC / make bais by 1 (not 0). DCA HYPSAV / ... JMP XVHYPB / go to next prev posn. XVHYPC, TAD I CURPTR / Get current character. JMS CHKALP JMP EIHYPT / SKIP IF NOT ALPHA /M231 AND (5777) DCA I CURPTR / CLEAR BREAK FLAG EIHYPY, CLA SLNMOD DCA SCRLFL / CLEAR SCROLL FLAG AGAIN EIHYPW, AC0001 CURMOV JMP EIHYPX / SET FLAG ON NEXT TAD SCRLFL SZA CLA JMP EIHYPX / UNLESS LINE TOO LONG TAD CURSOR / OR AT RIGHT MARGIN ALREADY CIA TAD RGTMAR SPA SNA CLA JMP EIHYPZ TAD HYPSAV / Did we see an invisible hyphen? SNA / Skip if YES. See if it's within ruler. JMP XVHYPD / No. Force normal hyphenization. TAD CURSOR / Compute cursor address of seen hyphen. CIA TAD RGTMAR SMA CLA JMP EIHYPZ / JMP if within ruler setting. XVHYPD, TAD I CURPTR JMS CHKALP JMP XVHYPR / OR CHAR NOT ALPHA /M231 AC2000 MQA DCA I CURPTR EIHYPZ, AC0001 CURMOV JMP EIHYPX / THEN ADVANCE LINE TAD SCRLFL SNA CLA JMP EIHYPZ / TO SHOW NEW HYPHENATION EIHYPX, JMP EIFIX / AND GO LISTEN /C168 EIHYPT, JMS HYPLMX / Is it 8 bit /A231 JMP EIHYPY / No .. go away /A231 JMP EIHYPY / Yes .. but we are already finished /A231 XVHYPR, JMS BHOOK / Check for 8 bit /A231 MCSTHY / 8 bit char ? /A231 JMP EIHYPZ / No /A231 TAD (2000) / Put on breaking bit /A231 DCA I CURPTR / Put char away again /A231 JMS HYBKUP / Now backup /A231 JMP EIHYPZ XVHYPV, JMS BHOOK / Check for 8 bit /A231 MCSTHY / /A231 JMP XVHYPB / No /A231 CLA / /A231 TAD I CURPTR / Get full char back /A231 DCA XVTEMP / Save char /A231 JMS HYBKUP / move back /A231 CLA / Clear out Start dead /A231 TAD XVTEMP / get char back /A231 AND (2000) / is breaking bit set ? /A231 SNA CLA / /A231 JMP XVHYPB / No get out /A231 JMP XVHYB1 / Yes , set HYPSAV /A231 OVHYPL= .-OVLAY1+OVRNUM / HYPHEN PULL XVHYPL, DCA SCRLFL / CLEAR SCROLL FLAG DCA HYPSAV / init previous HYPHEN posn. AC7777 CURMOV JMP EIBAD / BACK UP TO PREVIOUS LINE TAD SCRLFL SNA CLA JMP .-5 TAD I CURPTR JMS CHKALP JMP HYPLMC / Test for Pull on MCS /M231 AND (5777) DCA I CURPTR / CLEAR BREAK FLAG HYPLFN, SLNMOD AC7776 CURMOV JMP EIBAD / TWO MORE, SO WE CAN ADVANCE JMP EIHYPY / IN COMMON CODE HYPSAV, 0 / posn (0 bais) of next invisible hyphen. HYPLMC, JMS HYPLMX / Is it 8 bit /A231 JMP EIHYPZ / No .. go away /A231 JMP HYPLFN / Yes .. we are already finished /A231 HYPLMX, XX JMS BHOOK / Is this an MCS char /A231 MCSTHY / 8 bit char in Hyphenation /A231 JMP I HYPLMX / No , ignore /A231 DCA I CURPTR / Put char back /A231 ISZ HYPLMX / Bump return for 8 bit /A231 JMS HYBKUP / Now backup to start of dead /A231 JMP I HYPLMX / And rejoin Mainline /A231 HYBKUP, XX / Backup cursor /A231 BKPPTR / Backup /A231 NOP / Shouldn't happen .. /A231 BKPPTR / And again /A231 NOP / Shouldn't happen .. /A231 BKPPTR / Last one /A231 NOP / /A231 JMP I HYBKUP / Get out /A231 XVTEMP, 0 / Temp for char /A231 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE XVDLTE, TAD (BASKET-1) DCA X5 / SET UP PTRS DCA BASKCT / AND COUNT FOR WASTEBASKET FILLING DCA PSTBLK / SHOW NO INCORE PASTE TAD CURPTR DCA DELUN1 / SAVE CURPTR JMS SETUNT / SET PROPER UNIT TYPE JMS RLEQTE / MAKE NWRUL=CURUL JMS LODCHR JMP DELUNZ / QUIT IF EOF JMS CHKUNT / CHECK FOR END OF UNIT DELNXT, XX SPA CLA JMP DELUNX / QUIT IF ALL DONE TAD I CURPTR / Get character to delete. AND P177 / isolate character bits. TAD (-LF) / compare against line terminator. SNA CLA / skip if not terminator. JMS RSTRLN / set to repaint entire line. TAD I CURPTR TAD (-ECSLPT) / CLEAR SELECT IF WE CROSS SNA JMP DELUNS TAD (ECSLPT-ECRMFL) SNA JMP DELUNM TAD (ECRMFL-ECSTRL) SNA JMP DELUNR DELUNE, TAD (ECSTRL-ECSTOV) SNA CLA JMP DELUNO TAD I CURPTR JMS ESJCHK SNA CLA JMP DELUNA DELUNP, JMS DELPUT / OTPUT TO WASTEBASKET DELUNA, DCA I CURPTR / DELETE CHAR AC0001 CHKPTR SNA JMP .-3 / GET NEXT CHAR SMA CLA JMP DELUNB / JUMP IF OK TAD I CURPTR DCA I DELUN1 / COPY ETX CODE TAD DELUN1 DCA CURPTR / RESET CURPTR DELUNC, ADVPTR JMP DELUNX / JUMP IF EOF JMP I DELNXT / ELSE TEST AGAIN DELUNB, TAD I CURPTR JMP I DELNXT DELUND, DCA I CURPTR / DELETE LAST CHAR DELUNX, TAD DELUN1 DCA CURPTR / RESET CURPTR SLNMOD TAD LINMOD JMS INSERT / SET MOD FLAG DELUNW, JMS CMPRUL JMP DELUNY / CHECK FOR RULER CHANGE JMS INSRUL DELUNY, TAD DELUN1 DCA CURPTR / RESET CURPTR (AGAIN) SLNMOD / SHOW MODS HAPPENED DELUNZ, JMP EIFIX / AND RETURN DELPUT, XX TAD BASKCT / PUT TO WASTEBASKET, IF NOT FULL TAD (-BASKSZ) SNA CLA JMP I DELPUT TAD I CURPTR DCA I X5 ISZ BASKCT JMP I DELPUT DELUNO, JMS DELPUT / OUTPUT TO WASTEBASKET DCA I CURPTR / DELETE ADVPTR JMP DELUNX TAD (-ECNDOV) / CHECK FOR END SZA CLA JMP DELUNO / LOOP IF NOT JMP DELUNP / ELSE OUTPUT AND RETURN DELUNM, TAD I CURPTR DCA RLRMOD / SAVE MOD FLAG JMP DELUNA DELUNS, DCA EDMODE / DELETE SELECT POINT JMP DELUNA DELUNR, TAD DELUN1 DCA CURPTR / RESET CURPTR JMS ESNWRL / GET NEW RULER TAD DELUN1 DCA CURPTR JMS DLTRLR / DELETE RULER JMP DELUNC DELUN1, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / CURRENT OVERLAY CONTENTS CURSAV=RPGETUNT / LOCATION ONLY USED BY GO-TO-PAGE OVCLKY= .-OVLAY1+OVRNUM / COLUMN CUT /A169 JMP COLKEY /A169 OVXRL1= .-OVLAY1+OVRNUM / CONTINUATION ENTRY POINT FOR GOLD: RULER DCA RLDIRN / SET RULER MOVEMENT DIRECTION TO FORWARD /A217 RULSVE, JMS PCUR / SET TO BOTTOM LINE IFDEF PERDEC < TAD (4056) DCA OKSTR / USE BLANKS FOR NULLS > / END IFDEF PERDEC IFDEF COLDEC < TAD (4072) DCA OKSTR / USE BLANKS FOR NULLS > / END IFDEF COLDEC IFDEF COMDEC < TAD (4054) DCA OKSTR / USE BLANKS FOR NULLS > / END IFDEF COMDEC / DISPLAY SCALE FOR RULER JMS NWLN JMS NWLN DCA RLIT1 RULSV2, ISZ RLIT1 / Display 10 - 80 TAD RLIT1 TAD (-10) SMA SZA CLA JMP RULSV3 JMS TWODEC JMP RULSV2 RULSV3, /D192 TAD SPLTFL / IN SPLIT SCREEN MODE? /D192 SZA CLA JMS RLDBLD / YES, PAINT REST OF RULER / Output ...:...: text TAD (-10) DCA RLIT1 JMS NWLN JMS PCUR RULV3A, JMS PUTMSA RLSTR2 ISZ RLIT1 JMP RULV3A JMS NWLN TAD (-4) DCA SCRLCT / SET UP FOR SCROLL RECOVERY OVLJMP / GO SET RLPOSN AND DISPLAY RULER OVDRUL / JUMP TO NEXT OVERLAY OVRULX= .-OVLAY1+OVRNUM / HERE TO "GO DOUBLE" AC7777 DCA SPLTFL / Swaped next 2 locations /M193 JMS FXMEUP / RE-PAINT THE SCREEN NOW JMS SET132 / SET 132 COL IF WIDNAR FLAG IS WIDE /M192 JMP RULSVE RLDBLD, XX JMS TWODEC TAD RLIT1 TAD (-30) ISZ RLIT1 SZA CLA JMP RLDBLD+1 TAD (-21) / SO WE GET UP TO 242 ON WIDE RULERS /M186 JMP I RLDBLD RLIT1, .-. RLIT2, .-. TWODEC, 0 / Two digit decimal print routine JMS PUTMSA / Print 7 spaces RLSTR4 DCA NUMDGT TAD RLIT1 NUM01, TAD (7766) / -10 decimal SPA JMP NUM02 ISZ NUMDGT JMP NUM01 NUM02, TAD (12) / decimal 10 DCA NUMB TAD NUMDGT / get hundreds digit and display SNA TAD (-20) / If zero convert to a space JMS NUMOUT TAD NUMB / get tens digit and display JMS NUMOUT JMS NUMOUT / units digit always 0 JMP I TWODEC NUMOUT, 0 TAD (60) JMS PUTSCH JMP I NUMOUT NUMB, 0 NUMDGT, 0 PUTMSA, XX DCA RLIT2 TAD I PUTMSA DCA PUTMA2 ISZ PUTMSA PUTMA1, ISZ RLIT2 TAD RLIT2 JMS GETBYT PUTMA2, 0 SNA JMP I PUTMSA BSW / THIS LITTLE TRICK CONVERTS SIXBIT TO ASCII SMA IAC BSW JMS PUTSCH JMP PUTMA1 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE FXMEUP, XX JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS / USE HYPHENS FOR NULLS IFDEF PERDEC < TAD (5556) DCA OKSTR > / END IFDEF PERDEC IFDEF COLDEC < TAD (5572) DCA OKSTR > / END IFDEF COLDEC IFDEF COMDEC < TAD (5554) DCA OKSTR > / END IFDEF COMDEC ISZ NORUPD / KEEP RULER FROM REVERTING JMS FXSCRL / AND RE-PAINT THE SCREEN DCA NORUPD / /A197 JMP I FXMEUP /************* FROM HERE THRU NEXT LINE OF ASTERISKS IS ALL********* /A169 COLKEY, /D201 GETINP / GET A KEYSTROKE AND DECODE COLCH1, CIFSYS /A201 JWAIT /A201 HLTTST /HAS GOLD HALT BEEN SET /A201 JMP EINEXT /YES /A201 CIFPRT /A201 JMS I (FLABUZ) / SOUND BUZZER AND TOGGLE LED'S /A201 / IF THEIR IS A PRINTER ERROR CIFSYS /A201 XLTIN /A201 JMP COLCH1 /A201 / MUST BE PASTE, CUT, GOLD:CUT, DELCHR, RUBCHR ZZCASE / TEST KEYSTROKE AGAINST TABLE COLTAB-1 / TABLE FOR CASE JMS BEEPER / NO MATCH, FOR NOW BEEP TWICE JMP EIBAD / BAD EXIT COLTAB, EDPSTE / PASTE OVCLPX / ADDRESS FOR PASTE EDSCUT / CUT OVCLCX EDGCUT / GOLD:CUT OVCGCX EDDLTC / DELCHR OVCLRX EDRBCH / RUBCHR OVCLLX / EDLINE / LINE SOLIDIFY TEXT / OVCLSD / EDPARA / PARA SOFTEN TEXT / OVCLSF 0 / END OF CASE CHECK INDICATOR / COLUMN OPERATIONS /A169 OVCLPX, OVLJMP;OVCLPS / COLUMN PASTE /A169 OVCLCX, OVLJMP;OVCLCT / COLUMN CUT /A169 OVCGCX, OVLJMP;OVCGCT / COLUMN GOLD:CUT /A169 OVCLRX, JMS OV2JMP / COLUMN DELCHR /A169 OVCLRS /A169 OVCLLX, JMS OV2JMP / COLUMN RUBCHR /A169 OVCLLS /A169 OVCLSD, JMS OV2JMP / LINE SOLIDIFY TEXT /A169 OVSLID /A169 OVCLSF, JMS OV2JMP / PARA SOFTEN TEXT /A169 OVSOFT /A169 /***************** END ADDITIONS FOR COLUMN ********************** A169 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVRBAD= .-OVLAY1+OVRNUM JMP XVRBAD OVERUL= .-OVLAY1+OVRNUM RLERUL, JMS RLEQTE / SET NEW=OLD (CANCEL MODS) OVDRUL= .-OVLAY1+OVRNUM AC0001 TAD CURSOR DCA RLPOSN / POSN=CURSOR OVPRUL= .-OVLAY1+OVRNUM RLPRUL, JMS DSPRUL / DISPLAY RULER NWRUL / display new ruler. /A160 RLGETI, JMS TSTLIM / TEST FOR SCREEN ZONE CHANGE TAD SCRNFL TAD (-2000) / DID ZONE CHANGE? SZA CLA JMP RLGET0 / NO /D192 JMS CLSCRN / CLEAR SCREEN ON ZONE CHANGE DCA SCRNFL / YES, CLEAR SCRNFL OVLJMP / THEN REDISPLAY SCREEN OVRULX /M192 RLGET0, AC7777 TAD RLPOSN TAD LOWLIM / NORMALIZE TO LEFT OF SCREEN JMS PCUR / REPOSITION CURSOR CIFMNU / CHANGE TO MENU FIELD /A217 JMS I (CALLN5) / CHECK FOR STATUS LINE CHANGES /A217 GETINP / GET NEXT INPUT CHARACTER SPA / SKIP IF: NOT A SPECIAL CHARACTER JMP RLSPCI / JUMP IF SPECIAL DCA RLCHAR / Save the character while /a232 TAD RLCHAR / a check is made for an eight bit /a232 AND (200) / character. /a232 SZA CLA / Is the character eight bit? /a232 TAD (EIGHTC / Yes, determine from eight bit table /a232 SNA / and skip the next instruction. If not /a232 TAD (OKSTR / then use ordinary table /a232 DCA SRHTBL / Save the table address to be used /a232 IFDEF ENGLSH < TAD RLCHAR / RESTORE FOR COMPARE TAD (-140) / IS THE CHAR A "@"? SZA / SKIP IF: CHAR IS "@" TAD (-36) / IS THE CHAR A "~"? SNA CLA / SKIP WITH VALID CHAR JMP RLBADI / CHAR WAS A "@" OR A "~" TAD RLCHAR / RESTORE CHAR FOR FURTHER COMPARE TAD (-140) / CONVERT CHARACTER TO 6-BIT CODE SPA TAD (40) SNA / SKIP IF: CHARACTER WAS NOT AN '@' TAD (""&77) / SUBSTITUTE A '"' IN PLACE OF '@' > / END IFDEF ENGLSH / THE SPANISH TRAP CHARACTERS ARE A COPY OF THE ENGLSH. IFDEF SPANISH < /A236 TAD RLCHAR / RESTORE FOR COMPARE TAD (-140) / IS THE CHAR A "@"? SZA / SKIP IF: CHAR IS "@" TAD (-36) / IS THE CHAR A "~"? SNA CLA / SKIP WITH VALID CHAR JMP RLBADI / CHAR WAS A "@" OR A "~" TAD RLCHAR / RESTORE CHAR FOR FURTHER COMPARE TAD (-140) / CONVERT CHARACTER TO 6-BIT CODE SPA TAD (40) SNA / SKIP IF: CHARACTER WAS NOT AN '@' TAD (""&77) / SUBSTITUTE A '"' IN PLACE OF '@' > / END IFDEF SPANISH /A236 / THE NORWAY TRAP CHARACTERS ARE A COPY OF THE ENGLSH. IFDEF V30NOR < /A238 TAD RLCHAR / RESTORE FOR COMPARE TAD (-140) / IS THE CHAR A "@"? SZA / SKIP IF: CHAR IS "@" TAD (-36) / IS THE CHAR A "~"? SNA CLA / SKIP WITH VALID CHAR JMP RLBADI / CHAR WAS A "@" OR A "~" TAD RLCHAR / RESTORE CHAR FOR FURTHER COMPARE TAD (-140) / CONVERT CHARACTER TO 6-BIT CODE SPA TAD (40) SNA / SKIP IF: CHARACTER WAS NOT AN '@' TAD (""&77) / SUBSTITUTE A '"' IN PLACE OF '@' > / END IFDEF V30NOR /A238 / THE SWEDISH TRAP CHARACTERS ARE A COPY OF THE ENGLSH. IFDEF V30SWE < /A239 TAD RLCHAR / RESTORE FOR COMPARE TAD (-140) / IS THE CHAR A "@"? SZA / SKIP IF: CHAR IS "@" TAD (-36) / IS THE CHAR A "~"? SNA CLA / SKIP WITH VALID CHAR JMP RLBADI / CHAR WAS A "@" OR A "~" TAD RLCHAR / RESTORE CHAR FOR FURTHER COMPARE TAD (-140) / CONVERT CHARACTER TO 6-BIT CODE SPA TAD (40) SNA / SKIP IF: CHARACTER WAS NOT AN '@' TAD (""&77) / SUBSTITUTE A '"' IN PLACE OF '@' > / END IFDEF V30SWE /A239 IFDEF ITALIAN < TAD RLCHAR TAD (-134) / Have we a \? SNA / Well? JMP RLBADI / Yes, well we don't want it here! TAD (134-140) / Convert to six bit SPA TAD (40) SNA / Have we an @ or an a-grave? TAD (34) / Yes, make it into a \ as six bit / can't represent @ > IFDEF DUTCH < TAD RLCHAR / RESTORE FOR COMPARE TAD (-140) / IS THE CHAR A "@"? SZA / SKIP IF: CHAR IS "@" TAD (-36) / IS THE CHAR A "~"? SNA CLA / SKIP WITH VALID CHAR JMP RLBADI / CHAR WAS A "@" OR A "~" TAD RLCHAR / RESTORE CHAR FOR FURTHER COMPARE TAD (-140) / CONVERT CHARACTER TO 6-BIT CODE SPA TAD (40) SNA / SKIP IF: CHARACTER WAS NOT AN '@' TAD (""&77) / SUBSTITUTE A '"' IN PLACE OF '@' > / END IFDEF DUTCH IFDEF FRENCH < TAD (-175) SNA TAD (77-175) TAD (175-140) SPA TAD (40) SNA TAD ("#&77) > / END IFDEF FRENCH IFDEF GERMAN < TAD (-140) SPA TAD (40) SNA TAD ("#&77) > / END IFDEF GERMAN IFDEF CANADA < TAD (-140) SPA TAD (40) SNA TAD (""&77) > / END IFDEF CANADA IFDEF SCANDI < TAD (-140) SPA TAD (40) > / END IFDEF SCANDI AND P77 / MASK UPPER BYTE CIA / GET -CHARACTER VALUE DCA T2 / SAVE VALUE DCA T3 / ZERO INDEX COUNT / SEE IF INPUT CHARACTER IS LEGAL BY CHECKING FOR A MATCH FOR IT IN / OKSTR TABLE. INDEXA, ISZ T3 / BUMP INDEX COUNT TAD T3 / GET INDEX COUNT JMS GETBYT / GET CORRESPONDING CHARACTER IN / OKSTR TABLE SRHTBL, OKSTR /m232 SNA / SKIP IF: NOT AT END OF TABLE JMP RLBADI / ERROR IF NOT FOUND TAD T2 / ADD -CHAR. VALUE TO VALUE RETURNED / FROM OKSTR TABLE. SZA CLA / SKIP IF: CHARACTER MATCHED JMP INDEXA / LOOP IF NOT EQUAL TAD T3 / RETURN INDEX TAD (-17) / ADD (NUMBER OF RULER SETTING CHARACTERS IN / OKSTR TABLE - 1) SMA / SKIP IF: INPUT CHARCTER WAS A RULER SETTING / CHARACTER ( 'L', 'R', 'D', '.' ...ETC.) JMP GETSRL / INPUT CHARACTER WAS EITHER A STORE_RULER / ('!', '@', '#' ...ETC.) OR ACCESS_STORED_ / RULER CHARACTER ('1', '2', '3' ...ETC.). / JUMP TO HANDLER. TAD (17) / RESTORE INDEX NUMBER IN AC JMS UPDRUL / UPDATE RULER JMP RLPRUL / AND DISPLAY GETSRL, SNA / SKIP IF: TABLE MATCH DID NOT OCCUR ON 17TH / BYTE OF OKSTR TABLE (CHARACTER IN 17TH / BYTE IS AN '=') JMP RLERUL / INPUT CHARACTER WAS AN '='. SO GOTO / ROUTINE THAT WILL RESET THE NEW RULER / EQUAL TO THE OLD. TAD (-13) / IS CHARACTER AN ACCESS_STORED_RULER CHAR.? SPA / SKIP IF: SO JMP GETSRX / JUMP TO GET RULER SPECIFIED BY INPUT CHAR. DCA T3 / STORE THIS RULER AS PER STORE_RULER CHAR. / SPECIFIED BY INPUT CHARACTER. OVLJMP; OVGSRL / GO STORE THE RULER /M184 GETSRX, TAD (12) JMS RLGETS CDFMNU TAD NWRMAR TAD (-COLM81) CDFMYF SPA SNA CLA JMP RLPRUL TAD SPLTFL SZA CLA JMP RLPRUL OVLJMP OVRULX / / ADVANCE TO NEXT RULER (AFTER ENTERING RULER BEING EDITED) / RLGOAD, AC0001 / INDICATE ADVANCE TO RULER JMP RLNWL / / BACKUP TO PREVIOUS RULER (AFTER ENTERING RULER BEING EDITED) / RLGOBK, AC7777 / INDICATE BACKUP TO RULER JMP RLNWL / / CANCEL ALL MODS TO RULER AND EXIT / RLQUIT, JMS RLEQTE / SET NWRUL := CURUL / / ENTER RULER BEING EDITED, AND EXIT GOLD:RULER COMMAND / RLNWL, DCA RRDIR / SET GOTO-RULER FLAG (0=NO GOTO-RULER) OVLJMP OVXRUL / RLSPCI moved to next page to make room this edit /a232 TLITAA, SPCLST-1 RLCHAR, 0 / TEMP HOLD FOR CURRENT INPUT CHAR X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE SPCLST, RLQUIT / CANCEL MODS AND QUIT -EDRULR RLNWL / EXIT WITH MODS -EDNWLN RLBKP / BACK-UP CURSOR -EDBKUP RLADV / ADVANCE CURSOR -EDADVN RLMNU / CALL UP EDITOR MENU -EDMENU RLWRD / MOVE CURSOR TO NEXT RULER MARK -EDWORD RLINE / MOVE CURSOR TO COLUMN 80 -EDLINE RLOJDL / DELETE RULER -EDDLTW / (DELETE WORD) RLERUL / UNDELETE RULER -EDUDLT / (GOLD DELETE WORD) RLGOAD / ADVANCE TO NEXT RULER -EDGADV / (GOLD:ADVANCE) RLGOBK / BACKUP TO PREVIOUS RULER -EDGBKP / (GOLD:BACKUP) 0 / END OF SPCLST RLSPCI, DCA T1 / SAVE CODE TAD TLITAA DCA X0 TAD I X0 SNA JMP RLBADI / ERROR IF NOT FOUND DCA T2 TAD I X0 TAD T1 SZA CLA JMP .-7 JMP I T2 / JUMP TO ROUTINE RLBKP, AC7777 RLADV, DCA RLDIRN / SET DIRECTION FOR FUTURE MOVES JMS RLMOV / DO MOVE OF ONE JMP RLINE2 / AND LISTEN FOR MORE RLMOV, XX TAD RLDIRN SMA CLA JMP RLADV1 / MOVE ONE IN RIGHT DIRECTION AC7777 / ELSE BACK UP TAD RLPOSN SNA JMP RLBADI DCA RLPOSN JMP I RLMOV RLADV1, TAD (-COLLIM+2) / ADVANCE CURSOR TAD RLPOSN SMA CLA JMP RLBADI /D192 TAD RLPOSN /D192 TAD (-COLM81) ISZ RLPOSN /D192 SPA CLA JMP I RLMOV /D192 TAD SPLTFL / SPLIT SCREEN MODE? /D192 SZA CLA /D192 JMP I RLMOV / RETURN IF YES! /D192 AC7777 /D192 TAD RLPOSN / ELSE SET CURSOR TO 1 LESS THAN RULER /D192 DCA CURSOR /D192 OVLJMP /D192 OVRULX /D217 RLDIRN, 0 / GOLD: RULER DIRECTION (0 FORWARD, -1 REVERSE) RLWRD, JMS RLMOV / GO ONE POSITION TAD RLPOSN JMS GETBYT NWRUL / CHECK FOR SOMETHING TAD (-1) SNA CLA JMP RLWRD / LOOP TIL WE GET IT JMP RLINE2 / THEN GO LISTEN FOR MORE RLINE, TAD RLDIRN SMA CLA JMP RLINE1 IAC / GO TO END OF LINE DCA RLPOSN JMP RLINE2 / AND RETURN FOR MORE RLINE1, TAD RLPOSN TAD (-COLM81) / SECOND LINE? SMA CLA /M192 TAD (COLLIM-COLM81-2) / ADD OFFSET IF SO TAD (COLM81) DCA RLPOSN RLINE2, AC7777 TAD RLPOSN / SET CURSOR TO 1 LESS THAN RULER POS'N DCA CURSOR JMP RLGETI XVRBAD, RLBADI, JMS BEEPER JMP RLINE2 RLMNU, JMS RLEQTE / CANCEL ANY MODS IFDEF PERDEC < TAD (5556) DCA OKSTR / RESTORE RULER DISPLAY CODES > / END IFDEF PERDEC IFDEF COLDEC < TAD (5572) DCA OKSTR / RESTORE RULER DISPLAY CODES > / END IFDEF COLDEC IFDEF COMDEC < TAD (5554) DCA OKSTR / RESTORE RULER DISPLAY CODES > / END IFDEF COMDEC DCA CURSOR TAD LINE23 DCA CURPTR /D159; CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD /D159; PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE OVLJMP OVMENU / GO TO EDITOR MENU / / TRANSFER TO "DELETE RULER" ROUTINE IN ANOTHER OVERLAY / RLOJDL, OVLJMP OVRLDL / This next string has the same purpose as OKSTR, in that it defines / acceptable characters for ruler definitions. However, whereas OKSTR / only has the definitions for correct 7 bit characters, this string / only has the definitions for correct 8 bit characters. /1........1.........1.........1.........1.........1/ EIGHTC, IFDEF ENGLSH < IFNDEF V30FAO < TEXT \ \ > IFDEF V30FAO < TEXT \ C \ > > IFDEF V30NOR < TEXT \ \ > IFDEF V30SWE < TEXT \ \ > IFDEF SPANISH < TEXT \ C \ > IFDEF ITALIAN < TEXT " \#I H G" > IFDEF DUTCH < TEXT \ \ > X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / CURRENT OVERLAY NUMBER OVABRV= .-OVLAY1+OVRNUM / GOLD ABBREVIATION ENTRY POINT JMP XVABRV OVGETC= .-OVLAY1+OVRNUM / GOLD LIBRARY ENTRY POINT JMP XVGETC OVDCM2= .-OVLAY1+OVRNUM JMP XVDCM2 / ERROR HANDLING FOR THE GET COPY, ABBREVIATION, AND LIBRARY CODE EIGETY, JMS PROMPT / PROMPT ERROR MESSAGE EIGER2 EIGER2 / "NOT FOUND" ERROR MESSAGE / GET COPY, ABREVIATION, AND LIBRARY CODE EIGETA, TAD (-EIGESL) DCA I .+2 / SET BUFFER LENGTH (OVER BRACKET) JMS GETLIN EIGES3 / GET PARA NAME TAD GETLEN SNA JMP EIGETD / NOP IF NO NAME TAD (EIGES3) DCA X2 / FIX END OF STRING JMS MNUGET MNLBRY / GET LIBRARY FILE NUM JMS EIGOPN JMP EIGETD / OPEN FOR READING JMS EIGETK JMP EIGETY EIGETB, JMS RDNXNJ JMP EIGETD / GET NEXT CHAR FROM GRAF DCA EIGTM1 DCA EIGTM2 / SAVE IT HLTTST JMP EIGETD / QUIT IF HALTED TAD EIGTM1 AND P177 TAD (-"<+200) SZA CLA JMP EIGETF / CHECK FOR END JMS RDNXNJ JMP EIGETE DCA EIGTM2 TAD EIGTM2 AND P177 TAD (-"<+200) SNA CLA JMP EIGETD / JUMP IF AT END EIGETF, TAD EIGTM1 JMS EIGETG / ELSE INSERT TAD EIGTM2 SZA JMS EIGETG JMP EIGETB / AND LOOP FOR MORE EIGETG, XX JMS CHKRPC JMP EIGETH / JUMP IF RULER JMS CHKSPC / HELPS PRREVENT DISKETTE OVERFILL SZA INSCHR / INSERT IF OK EIGETX, JMP I EIGETG EIGETH, JMS RDNXNJ JMP I EIGETG TAD (-ECMDRL) SZA CLA JMP EIGETH / GET TO MIDDLE JMS SETRUL EIGETJ / SET NWRUL JMS CMPRUL JMP I EIGETG / JUMP IF =OLD TAD CURPTR DCA EIGTM1 / SAVE PTR JMS I TLITBA / INSERT NEW RULER TAD (ECRMFL) JMS INSERT / SET MOD FLAG SLNMOD TAD EIGTM1 DCA CURPTR / RESTORE PTR CURMOV NOP / FIX UP TAD LINE23 DCA CURPTR / RESTORE CURPTR DCA CURSOR JMP I EIGETG / AND LOOP FOR NEXT INPUT EIGETE, TAD EIGTM1 INSCHR / STRANGE END #1 EIGETD, JMP I TLITBC EIGTM1, 0 / TEMPS EIGTM2, 0 TLITBA, INSRUL / ****LITERALS TO BYPASS PAL8 LIMITS*** TLITBC, EIFIX /C168 EIGESL=21 / MAX PARA NAME LENGTH EIGES2, "<-200 "<-200 ZBLOCK EIGESL+2 / BUFFER EIGES3=EIGES2+1 / BUFFER START FOR GETLIN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE EIGETJ, XX JMS RDNXNJ JMP EIGETX CDFMYF JMP I EIGETJ EIGETK, XX / SET UP FOR RDFIND CDFMYF TAD ("<-200) DCA I (EIGES3) TAD (">-200) DCA I X2 TAD (">-200) DCA I X2 DCA I X2 DCA PSTBLK DCA BASKCT JMS RDFIND EIGES2 JMP I EIGETK ISZ EIGETK / BUMP FOR SUCCESSFUL RETURN JMP I EIGETK RDFIND, XX CDFMYF / FIND STRING IN SYSFIL RDFLP1, TAD I RDFIND DCA RDFPTR / GET STRING PTR RDFLP2, JMS RDNXNJ JMP RDFXI1 / GET NEXT CHAR MQL HLTTST JMP RDFXI1 / QUIT IF HALTED CDFMYF TAD I RDFPTR / COMPARE WITH STRING SWP JMS USCMPR JMP RDFLP1 / REINIT IF NO MATCH HERE ISZ RDFPTR / BUMP STRING PTR TAD I RDFPTR / END YET? SZA CLA JMP RDFLP2 / CONTINUE MATCH IF NOT ISZ RDFIND / ELSE BUMP TO OK RETURN RDFXI1, ISZ RDFIND JMP I RDFIND / RETURN TO CALLER RDFPTR, 0 / TMP XVABRV, JMS MNUGET / CODE FOR ABRV OVERLAY MNABRV / GET ABBREV FILE NUM JMS EIGOPN JMP EIFIX / INIT ABBREV FILE /C168 JMS RDNXNJ JMP EIABRA CLA / CHECK IT TAD (EIGES3) DCA X2 / INIT STRING PTR GETINP SPA JMP EIABRA / GET 1ST CHAR JMS XVABIN / Insert it (7 or 8 bit) /A225 GETINP / Get 2nd char SPA / JMP EIABRA / And process as for 1st JMS XVABIN / Insert it /A225 JMS EIGETK JMP EIABRA / GO FIND IT JMP EIGETB / GO COPY IF FOUND EIABRA, JMP EIBAD XVGETC, JMS FXSCRL / UPDATE SCREEN JMS PROMPT EIGES1 / ASK FOR NAME JMP EIGETA / GO TO CONTINUATION ROUTINE XVDCM2, TAD CPYFNO / SECOND OVERLAY JMS EIGOPN JMP EIFIX / INIT DOCUMENT FILE /C168 EIDCMD, JMS RDNXNJ JMP EIGETD / GET A CHARACTER, EXIT IF DONE JMS EIGETG / INSERT CHARACTER HLTTST / TEST IF HALT FLAG SET JMP EIGETD / YES, DONE JMP EIDCMD / NO, GO AROUND AGAIN EIGOPN, XX / CHECK FILE, THEN OPEN FOR READING DCA CPYFNO / SAVE FILE NO TAD CPYFNO CIA / COMPARE AGAINST EDIT FILE TAD FILENO SZA CLA JMP .+3 JMS BEEPER / COMPLAIN IF SAME JMP I EIGOPN / TAKE NON-SKIP RETURN TAD CPYFNO JMS DSKCAL XRDFIN / ELSE INIT IT ISZ EIGOPN JMP I EIGOPN / AND TAKE SKIP RETURN / / Routine (blasted) to insert 7 or 8 bit (dead key) char into /A225 / EIGESL buffer /A225 / XVABIN, XX DCA XABRVC / Store 1st char /A225 TAD XABRVC / Get it back /A225 AND (200) / Is it 8 bit ? /A225 SZA CLA / /A225 JMP XABXPC / Yes, expand char /A225 TAD XABRVC / Get char back /A225 DCA I X2 / And save it /A225 JMP I XVABIN / Now exit /A225 XABXPC, TAD XABRVC / get char /A225 JMS BHOOK / Call Blaster /A225 AB8INS / /A225 JMP I XVABIN / return /A225 XABRVC, 0 / Temp for input char /A225 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 / NEW OVERLAY OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / CURRENT OVERLAY NUMBER /D185 BEGIN HELP OVERLAY........CALL CLEAR SCREEN AND SAVE MENU DATA /D185 OVHELP= .-OVLAY1+OVRNUM /D185 TAD BASKCT / GET WASTEBASKET COUNT /D185 DCA T3 / SAVE FOR HELP UNDELETE /D185 JMS EIDCMB / SAVE MENU DATA /D185 OVLJMP;OVHLP1 / START OF HELP OVERLAY /D185 END HELP OVERLAY..........RESTORE MENU DATA AND POINTERS /D185 OVHLPE= .-OVLAY1+OVRNUM /D185 JMS EIDCMC / RESET PTRS /D185 JMS EIPSWP / GO RESTORE THE SWAP AREA /A181 /D185 TAD T2 / FINISH - GET RETURN CODE /D185 SNA / IS CODE OR NULL(RET TO EDITOR) /D185 JMP EINEXT / RETURN TO NORMAL EDITOR FUNCTIONS /C168 /D185 JMP EINEXB / RETURN TO EDITOR ...WITH NEG CODE IN AC OVDCMT= .-OVLAY1+OVRNUM / GET DOCUMENT JMS EIDCMB / SAVE MENU STUFF JMS MNUPUT MNTMP1 / NO SPECIAL OPTIONS CIFMNU JMS I MNUCAL DLMEM1 / CALL MENU JMS EIDCMC / RESTORE MENU STUFF JMS EIPSWP / GO RESTORE THE SWAP AREA /A181 JMS MNUGET MNTMP3 / GET FILE NUM FROM MENU SNA JMP EIFIX / QUIT IF NULL /C168 DCA CPYFNO / ELSE SAVE FOR CHECKING OVLJMP;OVDCM2 / AND JUMP TO NEXT OVERLAY OVMENU= .-OVLAY1+OVRNUM / EDITOR MENU XVMENU, JMS EIDCMB / SAVE MENU STUFF JMS HDRGET HDRPSZ / GIVE HIM OUR PAGE SIZE JMS MNUPUT MNTMP3 /D186 CDFMYF TAD WIDNAR / GET WIDE/NARROW FLAG /A186 SZA CLA / CONVERT TO 1/0 FLAG /A186 AC0001 / NARROW (52 DEC) = 1 /A186 JMS MNUPUT / STORE WHERE MENU CAN FIND IT /A186 MNTMP8 /A186 CIFMNU JMS I MNUCAL DLMEM2 / CALL MENU DCA LOWLIM / CLEAR SO THAT TESTLIM CAN SET IT OK /A186 JMS MNUGET /A186 MNTMP8 / GET WIDE/NARROW SCREEN FLAG /A186 CLL RAR / CONVERT TO FORM EDITOR CAN USE /A186 SZL CLA / SKIP IF WIDE MODE JUST SPECIFIED /A186 TAD (WIDTH-COLM81) / NARROW = 52 DECIMAL FOR EDITOR USE /A186 DCA WIDNAR / STORE IT AWAY /A186 SNL CLA / WHAT IS IT? /A186 CMA / WIDE, SET AC=-1, PRESERVE LINK!! /A186 DCA WIDEFL / SET 'NEED TO GO TO 132 COL.' FLAG /A192 SNL / SKIP IF NARROW /A192 JMS SET132 / WIDE, GO TO 132 COLUMN MODE /A186 JMS EIDCMC / RESTORE MENU STUFF JMS MNUGET MNTMP3 / GET PAGE SIZE BACK AGAIN JMS HDRPUT HDRPSZ / PUT BACK IN HEADER JMS MNUGET MNTMP5 / WRITE SYSTEM OPTIONS PAGE IF MODIFIED SZA CLA JMS EIMSVU / +++ Modify RULOFF Case-Table to turn Display-Rulers ON or OFF. /a177 / /a177 / MNSTAT = 0 or 1 ... Ruler Display ON /a177 / MNSTAT = 2 or 3 ... Ruler Display OFF /a177 / /a177 JMS OV2JMP / LOAD OVERLAY 2 /a177 OVRLOF / Adjust Case-Table and Continue /a177 JMS MNUGET MNTMP4 / GET MNU OPTION RETURN TAD (JMP I EIMNUA) / USE TO JUMP THRU TABLE DCA .+1 JMP I EIMNUA / TAKE OPTION JUMP EIMNUA, EIMNU0 / RETURN EIMNU1 / DK EIMNU2 / NULL VALUE EIMNU3 / CONTINUE PRINTER EIMNU4 / FINISH DOCUMENT EIMNU5 / GLOBAL SEARCH AND REPLACE EIMNU6 / AUTO-PAGINATION EIMNU0, JMS EIPSWP / GO RESTORE THE SWAP AREA /A181 JMP EIFIX / RETURN TO EDITOR /C168 EIMNU4, JMS EIPSWP / GO RESTORE THE SWAP AREA /A181 JMP EIFILE / GO FILE THE DOCUMENT EIMNU2, / NULL VALUE EIMNU5, DCA PSTBLK / RESET PASTE BLOCK POINTER TO CAUSE / PASTE BLOCK TO BE RE-INITITED IN CORE OVLJMP;OVGSRP / GO TO GSR OVERLAY /C210 /D181 EIDCMA, XX /D181 CDFMNU /D181 AC7777 /D181 TAD I (FNAMSP) /D181 DCA X1 /D181 TAD (SMULOC-1) /D181 DCA X2 /D181 JMP I EIDCMA EIDCMB, XX CDFMNU / CHANGE TO MENU FIELD /A181 AC7777 / SET UP FOR A DECREMENT /A181 TAD I (FNAMSP) / PICK UP ADDRESS OF FILE NAME BUFFER /A181 DCA EDICMX / STORE SOURCE ADDRESS /A181 JMS CPYBUF / CALL SYSTEM ROUTINE TO MOVE BUFFER /A181 -STRLEN / NUMBER OF WORDS TO MOVE /A181 CDFMNU / SOURCE FIELD /A181 EDICMX, 0 / SOURCE ADDRESS /A181 CDFMYF / DESTINATION FIELD /A181 SMULOC-1 / DESTINATION ADDRESS /A181 DCA PSTBLK DCA BASKCT / CLEAR PASTE BUF FLAGS JMS CLR132 / MAKE SURE THE SCREEN IS IN NARROW MODE AC0003 / SET UP TO RESET SCROLL REGION CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD JMS I (CALLN1) / RESET SCROLL REGION SET ABSOLUTE MODE CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE JMP I EIDCMB EIDCMC, XX TAD EDICMX / PICK UP ADDRESS OF FILE NAME BUFFER /A181 DCA EDICMY / STORE SOURCE ADDRESS /A181 JMS CPYBUF / CALL SYSTEM ROUTINE TO MOVE BUFFER /A181 -STRLEN / NUMBER OF WORDS TO MOVE /A181 CDFMYF / SOURCE FIELD /A181 SMULOC-1 / SOURCE ADDRESS /A181 CDFMNU / DESTINATION FIELD /A181 EDICMY, 0 / DESTINATION ADDRESS /A181 /D192 TAD SPLTFL / CHECK FOR WIDE SCREEN /D192 SZA CLA / SKIP IF NARROW JMS SET132 / CONVERT TO 132 COLUMN MODE (IF WIDE!) JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS JMP I EIDCMC X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE EIMNU3, AC0006 / LOAD 'CONTINUE' ACTION CODE CDFPRT / GET TO PRINTER FIELD DCA I (PRACTN) / SET ACTION CODE /D173 TAD I (PRSTOP) / STOP PRINTER, /D173 SZA CLA /D173 JMP .+4 / IF NOT ALREADY STOPPED AC0001 /D173 TAD USERNO / BY SETTING OUR NUMBER DCA I (PRSTOP) / IN PRINTER STOP FLAG CDFMYF / BACK TO OUR FIELD JMP EIMNU0 / GO RETURN TO EDITOR /A173 EIMNU1, JMS CLR132 / DON'T NEED WIDE SCREEN HERE OVLJMP;OVUDKS / GO TRANSFER TO UDK OVERLAY EIMNU6, JMS EIPSWP / GO RESTORE THE SWAP AREA /A181 JMS TSTLIM / GO SET UP THE LIMITS OF DISPLAY /A186 JMS FXSCRL / GO REPAINT THE SCREEN /A186 OVLJMP;OVAPAG / JUMP TO AUTO GOLD PAGE OVERLAY EIMSVU, XX / SAVE SYSTEM OPTIONS PAGE TAD (DLSVAL) / DISK BLOCK TO READ /A181 CDFMYF / FIELD TO READ IT INTO /A181 JMS SYSIO / SYSTEM ROUTINE TO READ A DISK BLOCK /A181 RXERD / READ COMMAND CODE /A181 OVLAY2 / BUFFER TO READ IT INTO /A181 JMS CPYBUF / CALL SYSTEM ROUTINE TO MOVE BUFFER /A181 -MUSYSL / NUMBER OF WORDS TO MOVE /A181 CDFMNU / SOURCE FIELD /A181 MUSYSV-1 / SOURCE ADDRESS /A181 CDFMYF / DESTINATION FIELD /A181 OVLAY2-1 / DESTINATION ADDRESS /A181 TAD (DLSVAL) / DISK BLOCK TO WRITE /M181 CDFMYF / FIELD TO WRITE FROM /M181 JMS SYSIO / SYSTEM ROUTINE TO WRITE A DISK BLOCK /M181 RXEWT / WRITE COMMAND CODE /M181 EIMLAY, OVLAY2 / BUFFER TO WRITE FROM /M181 DCA I EIMLAY / ZAP POINTER TO SECOND OVERLAY NUMBER /M181 JMP I EIMSVU / RETURN TO CALLER /M181 SMULOC, ZBLOCK STRLEN / LOCATION TO SAVE THE FILE NAME BUFFER /D181 SMOOT, 0 / SHOWS LENGTH OF SMULOC BLOCK EIPSWP, XX / RESTORE THE SWAP AREA ROUTINE /A181 AC7777 / SET AC = -1 /A181 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD/A181 PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA /A181 JMP I EIPSWP / RETURN TO CALLER /A181 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 / NEW OVERLAY OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / CURRENT OVERLAY NUMBER OVSCUT= .-OVLAY1+OVRNUM / ENTRY POINT FOR STANDARD CUT OVERLAY JMP XVSCUT OVCLPB= .-OVLAY1+OVRNUM / ENTRY POINT FOR CLEAR CUT/ PASTE BUFFER JMP XVCLPB OVGCUT= .-OVLAY1+OVRNUM / ENTRY POINT FOR GOLD CUT OVERLAY JMP XVGCUT OVREPL= .-OVLAY1+OVRNUM / ENTRY POINT FOR GOLD REPLACE OVERLAY TSTSLT / CHECK FOR SELECT REGION /C204 JMP CLRGSR / ERROR IF NOT IN SELECT TAD (SLCTMD) / PICK UP CODE FOR SELECT COMMAND DCA GRAMUN / SET "FLAG" UNIT TYPE TAD (ESNOPC) / PICK UP NULL OUTPUT ROUTINE ADDRESS JMS CUTSUB / DELETE TO NOWHERE OVLJMP / JUMP TO DO PASTE OVPSTE CLRGSR, DCA GSRF / CLEAR GSR FLAG /C204 JMP EIBAD / ERROR IF NO SELECT / ENTRY POINT FOR GOLD CUT OVERLAY XVGCUT, TAD (ESCUTX) / PICK UP OUTPUT ROUTINE ADDRESS /A204 DCA CUTOUT / SAVE OUTPUT ROUTINE POINTER /A204 JMS ESCUTY / GO INITIALIZE POINTERS JMS SETUNT / SETUP FOR CHKUNT JMS RLEQTE / SET UP FOR RULER CHANGE CHECKING /A204 JMS CUTRUL / SAVE CURRENT RULER /A204 JMP XVGCU1 / PASTE BUFFER OVERFLOW ERROR /A204 CDFMYF / RESET BACK TO OUR FIELD DCA JCLGCT / SET FLAG TO NOT DELETE PAGE MARKER DCA SETRUL / CLEAR FLAG INDICATING RULER CROSSED /A204 JMS GETUNT / CO-ROUTINE, GET CHARACTER UNTIL SELECT GCUTNX, XX / RESTART CO-ROUTINE ENTRY POINT SNA CLA / RETURN FROM CO-ROUTINE WITH CHAR OR NULL/C204 JMP XVGCU1 / JUMP IF ALL DONE CDFMYF / RESET BACK TO OUR FIELD /A204 TAD SETRUL / GET THE RULER CROSSING FLAG /A204 SNA CLA / DID WE CROSS A RULER ? /A204 JMP XVGCU0 / NO, GO PUT CHARACTER INTO PASTE BUFFER/A204 JMS CUTRUL / YES, PUT NEW RULER INTO PASTE BUFFER /A204 JMP XVGCU1 / PASTE BUFFER OVERFLOW ERROR /A204 CDFMYF / RESET BACK TO OUR FIELD /A204 DCA SETRUL / CLEAR THE FLAG FOR NEXT TIME /A204 XVGCU0, CDFBUF / SET TO BUFFER FIELD /A204 TAD I CURPTR / PICK UP THE CURRENT CHARACTER /A204 JMS ESCUTX / STUFF IT INTO THE PASTE BUFFER JMP I GCUTNX / GO GET ANOTHER CHARACTER ISZ CURPTR / OVERFLOW, SKIP OVER CURRENT CHARACTER /A205 XVGCU1, CDFMYF / BACK TO OUR FIELD TAD GCLIT1 / RESTORE JCLEAN LITERAL DCA JCLGCT JMP ESCUT3 / PUT ONE MORE IN PSTE BUFFER GCLIT1, JTSTOF-ECPMRK / LITERAL FOR JCLEAN TO DELETE PG MRK'S / ENTRY POINT FOR STANDARD CUT OVERLAY XVSCUT, JMS ESCUTY / GO INITIALIZE POINTERS TAD (ESCUTX) / PICK UP OUTPUT ROUTINE ADDRESS JMS CUTSUB / DELETE SELECT RANGE TO PASTE BUFFER ESCUT3, ISZ ESCUT1 / CHECK FOR OVERFLOW JMP ESCUT4 / JUMP IF NORMAL TERMINATE JMS BEEPER / ELSE COMPLAIN JMP CUTMOV / KILL SELECT & BACK UP TO OVERFLOW POINT/A205 /D205 JMP UNSLCT / SCROLL TO SELECT POINT ESCUT4, CDFBUF DCA I PSTPTR / SET PASTE STOPPER TAD (RXEWT+2000) JMS PSTIO / OUTPUT LAST BUFFER JMP EINEXT / AND GO LISTEN ESCUT1, 0 / LOCATION USED FOR OVERFLOW FLAG ESCUTX, XX / ROUTINE TO PUT A CHARACTER TO PASTE BUFFER CDFBUF / SET TO BUFFER FIELD DCA I PSTPTR / STORE CHARACTER FOR OUTPUT ISZ PSTPTR / BUMP THE POINTER INTO THE PASTE BUFFER JMP I ESCUTX / RETURN IF NOT FULL TAD (RXEWT+2000) / PICK UP THE CODE FOR A DISK BLOCK WRITE JMS PSTIO / GO OUTPUT THE PASTE BUFFER BLOCK ISZ PSTBLK / BUMP THE BLOCK NUMBER TAD PSTBLK / PICK UP THE BLOCK NUMBER TAD (-PSTEND) / COMBINE WITH THE LIMIT OF BLOCKS SZA CLA / DID WE DO THE LAST PASTE BUFFER BLOCK JMP I ESCUTX / RETURN IF NOT AC7777 / SET AC TO A MINUS 1 DCA ESCUT1 / SET OVERFLOW FLAG ISZ ESCUTX / BUMP TO ABNORMAL RETURN JMP I ESCUTX / AND TAKE IT ESCUTY, XX / ROUTINE TO INITIALIZE POINTERS TSTSLT / CHECK FOR SELECT REGION JMP EIBAD / ERROR IF NOT IN SELECT TAD (PSTEBG) / PICK UP START BLOCK OF PASTE BUFFER DCA PSTBLK / SET TO BEGINNING BLOCK OF FILE JMS SETPST / SET BUFFER PTR AND COUNT DCA ESCUT1 / CLEAR OVERFLOW FLAG TAD (SLCTMD) / PICK UP CODE FOR SELECT COMMAND DCA GRAMUN / SET SELECT UNIT TYPE JMP I ESCUTY / RETURN TO CALLER / ENTRY POINT FOR "CLEAR CUT/ PASTE BUFFER" OVERLAY / WHEN READING FROM THE CUT/ PASTE BUFFER, THE PROCESS STOPS / AS SOON AS A ZERO IS READ, HENCE PUT A ZERO IN THE FIRST / WORD OF THE BUFFER, AND THE BUFFER APPEARS EMPTY XVCLPB, CLA / IF the entry into "OVJUMP" is from "F" (FINISHED using the system) / THEN "Hang-up" the modem TAD OVJUMP AND (7600) TAD (-200) SZA CLA JMP .+5 TAD (7402) CIFSYS HS2OU CLA TAD (PSTEBG) DCA PSTBLK / SET TO BEGINNING BLOCK OF FILE TAD (PSTEBF) DCA PSTPTR / RESET POINTERS CDFBUF DCA I PSTPTR / CLEAR THE FIRST WORD OF THE BUFFER TAD (RXEWT+2000) JMS PSTIO / PUT OUT BUFFER JMP OVJRTN / AND RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE CUTMOV, TAD (ECTMRK) / PICK UP POSITION MARKER /A205 JMS INSERT / INSERT MARK INTO TEXT BUFFER /A205 MODSET; EDTMOD / SET ADVANCE CHARACTER MODE /A205 JMS LODCHR / PICK UP CURRENT OR NEXT CHARACTER /A205 JMP EIFIX / ERROR, SHOULD NOT BE AT END OF FILE /A205 JMS GETUNT / CO-ROUTINE TO GET NEXT UNIT /A205 CUTXXX, .-. / RETURN POINT BACK TO CO-ROUTINE /A205 SZA CLA / DID WE FIND THE SELECT MARK /A205 JMP I CUTXXX / NO, GO CHECK NEXT CHARACTER /A205 CUTOVR, AC7777 / SET UP FOR A BACKWARD MOVE /A205 CURMOV / MOVE BACK ONE CHARACTER /A205 NOP / EOF RETURN, IMPOSSIBLE AT THIS TIME /A205 TAD I CURPTR / PICK UP THE CURRENT CHARACTER /A205 CIA / MAKE IT NEGATIVE /A205 TAD (ECTMRK) / CHECK FOR PLACEMENT MARK /A205 SZA CLA / IS THIS THE MARK WE JUST PUT IN ? /A205 JMP CUTOVR / NO, GO CHECK AGAIN /A205 DCA I CURPTR / CLEAR THE MARK FROM THE BUFFER /A205 JMP EIFIX / GO HANDLE NEXT COMMAND FROM USER /A205 CUTUN1= CUTXXX / USE FOR STORAGE LOCATION /A205 ESNOPC, XX / NULL OUTPUT ROUTINE FOR GOLD REPLACE CLA / CLEAR ARGUMENT JMP I ESNOPC / RETURN TO CALLER CUTSUB, XX / DELETE SELECTED TEXT THRU ARG-ROUTINE DCA CUTOUT / SAVE OUTPUT ROUTINE POINTER TAD CURPTR / GET CURSOR POINTER ADDRESS IN BUFFER DCA CUTUN1 / SAVE CURRENT POINTER JMS SETUNT / SET UP FOR CHKUNT JMS RLEQTE / SET UP FOR RULER CHANGE CHECKING JMS CUTRUL / SAVE CURRENT RULER JMP CUTUNX / PASTE BUFFER OVERFLOW ERROR /A204 JMS LODCHR / GET CURRENT OR NEXT CHARACTER JMP I CUTSUB / QUIT AT EOF, RETURN TO CALLER /C204 JMS CHKUNT / CO-ROUTINE CHECK FOR DONE CUTNXT, .-. SPA CLA / RETURNS -1 WHEN DONE JMP CUTUNX / QUIT IF DONE TAD I CURPTR / GET THE CURRENT CHARACTER BACK TAD (-ECSTRL) / COMBINE WITH THE START OF RULER CODE SZA / IS THIS THE START OF A RULER /C204 JMP CUTUNR / JUMP IF NO RULER TAD CUTUN1 / PICK UP SAVED BUFFER POINTER /C204 DCA CURPTR / RESTORE VALUE TO CURPTR JMS ESNWRL / COLLECT NEW RULER JMS CUTRUL / OUTPUT TO "CUTOUT" JMP CUTUNX / PASTE BUFFER OVERFLOW ERROR /A204 TAD CUTUN1 / PICK UP SAVED BUFFER POINTER DCA CURPTR / RESTORE VALUE TO CURPTR JMS DLTRLR / DELETE RULER JMP CUTUNC / CONTINUE CUTUNR, TAD (ECSTRL-ECRMFL) / COMBINE WITH RULER MODIFIED CODE /C204 SZA CLA / IS THIS RULER MODIFIED FLAG CODE /C204 JMP CUTUNM / JUMP IF NOT RULER MODIFIED FLAG TAD I CURPTR / PICK UP THE CURRENT CHARACTER /C204 DCA RLRMOD / SAVE RULER MODIFIED FLAG JMP CUTUNA / JUMP TO DELETE IT CUTUNM, TAD I CURPTR / PICK UP THE CURENT CHARACTER /C204 JMS ESJCHK / GO CHECK FOR JUSTIFIED CODES SNA CLA / IS THIS A JUSTIFIED CHARACTER CODE JMP CUTUNA / JUMP IF J-CODES TAD I CURPTR / PICK UP THE CURENT CHARACTER JMS CUTCHR / OUTPUT CHARACTER TO PASTE BUFFER CUTUNA, DCA I CURPTR / DELETE CHARACTER CUTUND, AC0001 / SET UP FOR A FORWARD MOVE /C204 CHKPTR / MOVE FORWARD AND CHECK NEXT CHARACTER SNA / IS IT A NULL CHARACTER JMP CUTUND / YES, GO GET NEXT CHARACTER /C204 SPA CLA / IS IT A BUFFER TERMINATOR CODE /C204 JMP CUTUNB / YES, GO RESET BUFFER WRAP POINTERS TAD I CURPTR / NO, PICK UP THE CURRENT CHARACTER JMP I CUTNXT / GO CHECK FOR DONE CUTUNB, TAD I CURPTR / PICK UP THE CURRENT CHARACTER /C204 DCA I CUTUN1 / COPY ETX POINTER TAD CUTUN1 DCA CURPTR / RESTORE CURPTR CUTUNC, ADVPTR / ADVANCE TO NEXT CHARACTER JMP CUTUNX / QUIT IF EOF JMP I CUTNXT / ELSE GO CHECK FOR DONE CUTCHR, XX / OUTPUT CHAR TO "CUTOUT" ROUTINE JMS I CUTOUT JMP I CUTCHR / JUST RETURN IF OK DCA I CURPTR / DELETE LAST CHAR AND QUIT IF OVERFLOW CUTUNX, TAD CUTUN1 DCA CURPTR / RESTORE PTR SLNMOD / SET LINE MODIFIED FLAG TAD LINMOD JMS INSERT / SAVE MOD FLAG JMS CMPRUL JMP CUTUNY / JUMP IF NO RULER CHANGE JMS INSRUL / ELSE INSERT LAST RULER CUTUNY, TAD CUTUN1 DCA CURPTR / RESTORE CURPTR AGAIN SLNMOD / SET LINE MODIFIED FLAG JMP I CUTSUB / RETURN TO CALLER CUTRUL, XX / OUTPUT RULER TAD (ECSTRL) / PICK UP START OF RULER CODE JMS CUTCHX / OUTPUT IT TO PASTE BUFFER JMS MAKRUL / MAKE A RULER IN THE PASTE BUFFER NWRUL / RULER TO USE FOR A PATTERN CUTCHX / OUTPUT ROUTINE TO USE TO MAKE A RULER TAD (ECNDRL) / PICK UP END OF RULER CODE JMS CUTCHX / OUTPUT IT TO PASTE BUFFER ISZ CUTRUL / BUMP TO "OK" RETURN /A204 JMP I CUTRUL / RETURN TO CALLER CUTCHX, XX / OUTPUT RULER CHARACTER TO "CUTOUT" JMS I CUTOUT JMP I CUTCHX / JUST RETURN IF OK JMP I CUTRUL / ELSE QUIT /C204 CUTOUT, .-. / LOCATION TO USE FOR CUT OPERATION /D205 CUTUN1, .-. / PLACE TO SAVE THE VALUE OF CURPTR X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVGBKP= .-OVLAY1+OVRNUM JMP GLDBKP / TRANSFER TO GOLD BACKUP ROUTINE OVGADV= .-OVLAY1+OVRNUM JMP GLDADV / TRANSFER TO GOLD ADVANCE ROUTINE / OVNWLN -- check for permature termination of a centered line. OVNWLN= .-OVLAY1+OVRNUM JMP XVNWLN OVGPST= .-OVLAY1+OVRNUM / EXACT PASTE OVERLAY AC7777 / SET EXACT PASTE FLAG / AND FALL THRU TO PASTE OVPSTE= .-OVLAY1+OVRNUM / "PASTE" OVERLAY PSTE4, DCA GLDPSF / SET (OR CLEAR) EXACT PASTE FLAG DCA GETPSF / CLEAR EOF FLAG TAD GLDPSF SZA CLA JMS I TLITCJ / SAVE RULER IF EXACT PASTE JMS SETPST / SET UP BUFFER PTRS TAD PSTBLK TAD TLITCB / NEED TO READ FIRST? SNA CLA JMP PSTE1 / JUMP IF NOT TAD (PSTEBG) DCA PSTBLK / ELSE SET IT UP PSTE3, TAD TLITCC JMS PSTIO / AND READ IT IN PSTE1, TAD I PSTPTR PSTE9, SNA JMP PSTXIT / JUMP IF DONE JMS GSRTST / IF NOT IN GSR THEN TEST FOR GOLD+HALT /M195 JMP PSTXIT / STOP IF ONE FOUND JMS CHKSPC / Check for enough space on diskette JMS I TLITCD JMP I TLITCE / JUMP IF RULER SZA / SKIP IF REDUNDANT /D164; JMS DOINSR / ELSE INSERT CHAR IN FILE /A162 INSCHR / ELSE INSERT CHAR IN FILE /M164 PSTE8, JMS I TLITCF JMP PSTE9 / LOOP FOR ALL CHARS TLITCA, EIFIX /C168 TLITCB, -PSTEBG TLITCC, RXERD TLITCD, CHKRPC TLITCE, PSTRUL TLITCF, GETPST TLITCG, 12 TLITCH, RLGETS TLITCI, PSTRLX TLITCJ, SAVCRL PSTXIT, TAD GSRF / IS THE GLOBAL SEARCH FLAG SET? SNA CLA JMP PSTEXT / -NO- DO NORMAL REPLACE EXIT. OVLJMP / -YES- CALL BACK THE SEARCH AND OVCONT / SELECT OVERLAY TO CONTINUE G.S.R PSTEXT, TAD GLDPSF / EXACT PASTE? SNA CLA JMP I TLITCA / RETURN IF NOT TAD TLITCG JMS I TLITCH / ELSE RESTORE RULER JMS I TLITCI JMP I TLITCA / AND THEN RETURN PSTRUL, CLA JMS SETRUL GETPST / GET NEW RULER FROM PASTE BUFFER TAD GETPSF SZA CLA JMP PSTXIT / JUMP IF ABNORMAL TERMINATION TAD GLDPSF SZA CLA JMS PSTRLX / INSERT RULER IF EXACT PASTE IN EFFECT JMP PSTE8 / THEN GO GET MORE PSTRLX, XX / PASTE RULER JMS CMPRUL JMP I PSTRLX / JUST RETURN IF NOT NECESSARY TAD CURPTR DCA PSTRL2 JMS INSRUL / ELSE INSERT NEW RULER TAD (207) JMS INSERT / AND RULER MOD FLAG TAD PSTRL2 DCA CURPTR / RESTORE CURPTR SLNMOD CURMOV NOP / ADVANCE OVER RULER JMP I PSTRLX / AND RETURN PSTRL2, .-. SAVCRL, XX / SAVE CURRENT RULER (AS RLR 10.) JMS CPYBUF -RULSIZ CDFMYF CURUL-1 CDFBUF PSTEBF TAD (DLRLRE+5) DCA PSTBLK TAD (RXEWT+2000) JMS PSTIO JMP I SAVCRL OVUDLT= .-OVLAY1+OVRNUM / UNDELETE ENTRY TAD BASKCT / GET WASTEBASKET COUNT SNA JMP EIFIX / IGNORE IF NULL /C168 CIA DCA UDLTM1 TAD (BASKET-1) DCA UDLTX0 / INIT BASKET PTR UDLTLP, CDFBUF / GET TO WASTEBASKET FIELD TAD I UDLTX0 / GET NEXT CHAR JMS CHKRPC CLA / CHECK FOR REDUNDANT PRINT CONTROL SZA / SKIP IF REDUNDANT JMS DOINSR / INSERT CHAR (unless redundant) ISZ UDLTM1 JMP UDLTLP / LOOP FOR ALL JMP EIFIX / RESET MODE AND GET NEXT /C168 UDLTX0=X5 UDLTM1, 0 / TEMP X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / ROUTINE TO CHECK FOR GOLD HALT IF NOT IN GLOBAL SEARCH AND REPLACE /A195 GSRTST, XX / DO HLTTST IF NOT DOING GSR /A195 DCA GSRTS2 / SAVE THE ACCUMULATOR /A195 TAD GSRF / GET THE GSR IN PROGRESS FLAG /A195 SZA CLA / ARE WE DOING A GSR OPERATION ? /A195 JMP GSRTS1 / YES, TAKE NORMAL EXIT /A195 HLTTST / CHECK THE GOLD HALT FLAG /A195 SKP / ONE FOUND, TAKE ABORT EXIT /A195 GSRTS1, ISZ GSRTST / BUMP RETURN POINTER FOR NORMAL RETURN /A195 TAD GSRTS2 / RETREIVE THE CONTENTS OF THE AC /A195 JMP I GSRTST / RETURN TO CALLER /A195 GSRTS2, 0 / LOCATION TO SAVE THE AC /A195 XVNWLN, TAD CURPTR / SAVE CURRENT TEXT POINTER. DCA JNWLNP / ... TAD T2 / SAVE T2 (FOR EINWLN). DCA NWLNT2 / ... TAD RGTMAR / COMPUTE A LOOP COUNTER. TAD (-COLM80) SMA CLA TAD (-COLLIM+COLM81) TAD (-COLM81) / ... DCA NWLNCT / SET MAX LOOP COUNTER. JMS LODCHR / GET 1ST CHAR. JMP NWLND / JMP IF NO MORE TEXT. JMP NWLNB / MERGE BELOW. NWLNA, ADVSPC / BUMP TO NEXT POSN. JMP NWLND NWLNB, AND P177 / ISOLATE LO BITS. TAD (-ECNWLN) / CHECK FOR LINE TERMINATOR. SZA CLA / SKIP IF LINE TERMINATOR. JMP NWLNC / NOT A TERMINATOR. CHECK FOR DONE. TAD I CURPTR / GET CHARACTER BACK. TAD (-ECENLN) / IS IT A "CENTER"ED MARK? SNA CLA / SKIP IF NOT /A182 JMS RSTRLN / WE MUST RE-PAINT THE LINE /A182 JMP NWLND / EXIT BELOW. /A182 /D182 SZA CLA / SKIP IF YES. WE MUST RE-PAINT THE LINE. /D182 JMP NWLND / NOPE. CONTINUE AS IS. /D182 TAD CURSOR / SAVE CURSOR. /D182 DCA NWLNCT / ... /D182 DCA CURSOR / RESET TO BEGINING OF LINE. /D182 SLNMOD / SET LINE TO BE REPAINTED FROM START. /D182 TAD NWLNCT / RESTORE CURSOR. /D182 DCA CURSOR / ... /D182 JMP NWLND / EXIT BELOW. NWLNC, ISZ NWLNCT / 1 MORE POSN CHECKED OUT. JMP NWLNA / CONTINUE TESTING. NWLND, TAD JNWLNP / RESTORE CURSOR POINTER. DCA CURPTR / ... TAD NWLNT2 / RESTORE T2 (FOR EINWLN, ETC.) DCA T2 / ... JMP OVJRTN / return to caller. NWLNT2, 0 / TEMP HOLDING PLACE FOR "T2". JNWLNP, 0 / SAVE LOCATION FOR "CURPTR". NWLNCT, 0 / TEMP COUNTER. GETPST, XX / GET NEXT CHAR FROM PST BUFFER ISZ PSTPTR / BUMP PTR JMP GETPS1 / JUMP IF OK ISZ PSTBLK / ELSE BUMP BLK TAD PSTBLK TAD (-PSTEND) / AND CHECK FOR END SNA CLA JMP GETPS2 / JUMP IF END TAD (RXERD) JMS PSTIO / ELSE READ NEXT BLOCK GETPS1, CDFBUF TAD I PSTPTR / GET NEXT CHAR SZA JMP I GETPST / RETURN IF NOT EOF GETPS2, AC7777 DCA GETPSF / ELSE SET EOF FLAG JMP I GETPST / AND RETURN DOINSR, XX / ROUTINE TO CHECK INSERTION CHAR FOR / & DCA T2 / SAVE CHAR. TAD T2 / GET IT BACK. /D164; AND P177 / MASK TO 7-BIT /A162 TAD (-ECNWLN) / SEE IF SZA / SKIP IF YES. /D164; TAD (ECNWLN-ECNWPG) / SEE IF /M162 TAD (ECNWLN-ECPGRF) / SEE IF /M164 SZA CLA / SKIP IF OR JMP DOINSA / PROCESS CHAR BELOW. OVLJMP;OVNWLN / CKECK FOR TERMINATION OF CENTERED TEXT /D164; TAD T2 / RESTORE CHAR /A162 /D164; AND P177 / MASK TO 7-BIT /A162 /D164; TAD (-ECNWPG) / SEE IF /A162 /D164; SZA CLA / SKIP IF /A162 /D164; JMP DOINSA / PROCESS CHAR BELOW /A162 /D164; DCA CURSOR / RESET CURSOR /A162 /D164; TAD LINE23 / AND /A162 /D164; DCA CURPTR / CURPTR /A162 DOINSA, TAD T2 / GET CHARACTER TO INSERT BACK. INSCHR / ELSE INSERT CHAR IN FILE JMP I DOINSR / RETURN TO CALLER. GLDBKP, AC7777 / SET UP FOR A BACKWARD MOVEMENT JMS GLDMOV / GO MOVE BACKWARD THROUGH DOCUMENT JMP EIBAD / ERROR, CAN'T BACK UP PAST TOP OF FILE JMP EIFIX / FIX UP SCREEN AND GET NEXT CHARACTER GLDADV, AC0001 / SET UP FOR A FORWARD MOVEMENT JMS GLDMOV / GO MOVE FORWARD THROUGH DOCUMENT JMP EIBAD / ERROR, CAN'T ADVANCE PAST BOTTOM JMP EIFIX / FIX UP SCREEN AND GET NEXT CHARACTER GLDMOV, XX / ROUTINE TO ADVANCE OR BACKUP IN FILE DCA GLDDIR / SAVE DIRECTION INDICATOR FOR MOVE AC0001 / SET UP TO KEEP THE SCREEN UPDATED DCA ECHFLG / TURN ON THE "ALWAYS ECHO" FLAG JMS FXSCRL / UPDATE THE SCREEN TAD GLDDIR / PICK UP MOVEMENT DIRECTION INDICATOR SPA CLA / SKIP IF DIRECTION IS FORWARD AC0001 / INDICATE A BACKUP CONDITION DCA MOVMOD+1 / SET OR CLEAR EDMODE - NEEDED FOR MODSET / PROPER EXECUTION OF EDITOR MATH MOVMOD TAD GLDDIR / PICK UP MOVEMENT DIRECTION INDICATOR CURMOV / TRY TO MOVE AT LEAST ONE POSITION JMP I GLDMOV / COULDN'T DO IT, GO REPORT THE ERROR ISZ GLDMOV / BUMP RETURN PAST ERROR RETURN GLDMV1, TAD GLDDIR / PICK UP MOVEMENT DIRECTION INDICATOR CURMOV / MOVE THE CURSOR ONE CHARACTER POSITION JMP I GLDMOV / HIT END OF DOCUMENT, ALL DONE TAD SCRLCT / PICK UP THE SCREEN LAG COUNT SPA CLA / SKIP IF SCREEN IS OK JMS FXSCRL / DON'T LET SCREEN GET BEHIND HLTTST / CHECK IF USER WANTS TO STOP JMP EIFIX / YES, THEN WE ARE ALL DONE JMP GLDMV1 / LOOP TILL STOPPED GLDDIR, 0 / LOCATION TO HOLD DIRECTION INDICATOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVCONT= .-OVLAY1+OVRNUM / THE USER TYPED "GOLD:SEARCH & SELECT" OVCON1, TSTSLT / CHECK TO SEE IF WE ARE ALREADY IN SELECT JMP OVCON2 / NOT IN SELECT, GO DO THE SEARCH CLA / IF IN 'SELECTED' POSITION AND TAD GSRF / THE USER REQUESTS 'GLOBAL SEARCH AND SNA CLA / REPLACE', LET OPERATION CONTINUE JMP EISRCL / OTHERWISE, DO UNSELECT AND SEARCH OVLJMP / CALL IN THE 'REPLACE' OVERLAY OVREPL / TO CONTINUE G.S.R. FUNCTION / FIX TO ALLOW CONT SEARCH AND SEL TO DELETE SEL MARK THEN SEARCH NEXT ARG EISRCL, DCA EDMODE / CLEAR CURRENT EDIT MODE JMP EISRCN / GO LOAD CHAR EISRCM, ADVPTR / ADVANCE POINTER JMP SLXMOD / ETX EISRCN, JMS LODCHR / GET THE NEXT CHARACTER JMP SLXMOD / ETX JMS ESLCTD / IF SELECT MARK DELETE IT JMP EISRCM / NOT A SELECT MARK GET NEXT CHARACTER /\ JMP OVCON2 / GO DO SEARCH - FALL THROUGH OVCON2, DCA SRCDIR / SET FOR SEARCHING FORWARD AC0001 DCA ECHFLG / SET FLAG TO LET SCREEN SCROLL WITH US ISZ NOMOVE / KEEP CURSOR FROM PRE-INCREMENTING AC0001 / AND SET S/ S FLAG /\ JMP EISRCG / FALL THROUGH INTO CONTINUE SEARCH OVSRCH= .-OVLAY1+OVRNUM / USER TYPED "GOLD:CONTINUE SEARCH" / ENTER HERE FROM REGULAR SEARCH EISRCG, DCA SRCSLT / RESET S/ S FLAG CDFMYF / GO-TO-PAGE USES SRCDIR AS A FLAG WORD /A206 / MAKE SURE DIRECTION VALUE IS VALID /A206 AC0002 / SET UP AC WITH VALUE OF TWO /A206 TAD SRCDIR / COMBINE WITH VALUE IN DIRECTION FLAG /A206 SZA CLA / SKIP IF BACKWARD DIRECTION SET /A206 DCA SRCDIR / SET FORWARD DIRECTION /A206 TAD I (EIGES4+1) / PICK UP FIRST CHARACTER IN SEARCH BUFFER SNA CLA / CHECK FOR ANYTHING TO SEARCH FOR JMP EIFIX / DON'T BOTHER, IF NULL /C168 JMP EISRCB / SKIP OVER BUFFER POINTER RESTORATION EISRCA, TAD EIFND4 / PICK UP SAVED BUFFER POSITION DCA CURPTR / RESTORE CURPTR EISRCB, HLTTST / GO CHECK IF USER PRESSED THE HALT KEY JMP EISRCJ / QUIT ON HALT TAD NOMOVE / DO WE MOVE CURSOR OR NOT? SZA CLA JMP EISRCQ / NO, WE DON'T AC0001 / SET UP FOR A FORWARD MOVEMENT TAD SRCDIR / COMBINE WITH REAL DIRECTION CURMOV / MOVE TO NEXT CHARACTER JMP EISRCK / STX/ETX, QUIT AT END OF BUFFER EISRCQ, CDFMYF / RESET BACK TO THIS FIELD DCA NOMOVE / CLEAR THE MOVEMENT FLAG TAD CURPTR / PICK UP THE CURRENT BUFFER POSITION DCA EIFND4 / SAVE CURPTR TAD (EIGES4+1) / PICK UP POINTER TO SEARCH STRING DCA EIFND6 / SET UP POINTER REGISTER CDFBUF / SET TO BUFFER FIELD TAD I CURPTR / GET CURRENT CHARACTER JMP EISRCD / SKIP OVER BUFFER MOVEMENT ROUTINE EISRCC, ADVPTR / MOVE POINTER ONE BUFFER POSITION /C209 /D209 ADVSPC / MOVE POINTER ONE SCREEN POSITION JMP EISRCA / ETX, QUIT AT END OF BUFFER EISRCD, JMS ESJCHK / CHECK FOR LINE OR RULER MODIFIED FLAG SNA / AC = 0 OR AC = VALID CHARACTER - JCHKOF JMP EISRCC / NO JUST CODES TAD (JCHKOF) / RESTORE TO ORIGINAL CHARACTER CDFMYF / RESET TO THIS FIELD TAD (-ECSTOV) / START OF DEAD-KEY SEQUENCE? SZA / SKIP IF YES. JMP EISRCX / TAD I EIFND6 / GET CHARACTER FROM STRING JMP EISRDK / GO HANDLE DEAD KEY SEQUENCE EISRCX, TAD (ECSTOV) / NO, RESTORE TO ORIG. CHAR MQL / PUT CHARACTER IN THE MQ TAD I EIFND6 / GET CHARACTER FROM STRING /A198 TAD (-ECNWLN) / COMPARE WITH NEW LINE CHARACTER /A198 SZA CLA / IS THIS A CARRIAGE RETURN ? /A198 JMP EISNNL / NO, THIS IS NOT A NEW LINE /A198 MQA / GET BACK THE BUFFER CHARACTER /A198 TAD (-ECNWLN) / COMPARE WITH NEW LINE CHARACTER /A198 SZA CLA / IS BUFFER CHARACTER A NEW LINE ? /A198 JMP EISRCA / NO, NO MATCH, GO RESTART THE SEARCH /A198 EISNNL, TAD I EIFND6 / PICK UP CHARACTER FROM SEARCH STRING SWP / SWAP PLACES WITH BUFFER CHARACTER JMS USCMPR / COMPARE WITH STRING BYTE JMP EISRCA / JUMP IF NO MATCH EISRCY, ISZ EIFND6 / THEY MATCH, BUMP THE STRING POINTER TAD I EIFND6 / GET THE NEXT CHARACTER SZA CLA / CHECK FOR NULL CHARACTER JMP EISRCC / NOT NULL, LOOP TILL END OF STRING TAD SRCSLT / DONE, GET THE SEARCH AND SELECT FLAG SNA CLA / IS IT SET ? JMP EISRCE / NO, SKIP AROUND ADVPTR / IF SET, PASS FINAL CHARACTER NOP / ETX RETRUN, SHOULD NOT HAPPEN CLA / THROW AWAY ANY CHARACTER CODE RETURNED TAD (ECTMRK) / PICK UP POSITION MARK JMS INSERT / MARK OUR PLACE FOR SELECT TAD EIFND4 / PICK UP SAVED BUFFER POSITION DCA CURPTR / RESTORE TO START OF STRING JMP DOSLCT / JUMP TO SELECT STRING EISRCE, TAD EIFND4 DCA CURPTR / RESTORE CURPTR EISRCF, JMP EIFIX /C168 SRCSLT, 0 / SEARCH AND SELECT FLAG EIFND4, 0 EIFND6, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE EISRCK, CDFMYF CLA DCA GSRPRV / CLEAR PREVIOUS GLOBAL SEARCH FLAG DCA NOMOVE /\ JMP EISRCJ / FALL THROUGH / HERE AFTER HALT TEST - FIELD = EDITOR EISRCJ, TAD XLTINI / RESTORE GSKILN AFTER FINISHING DCA GSKILN / A G.S.R. OPERATION JMS BUZZER / DO NOT CLEAR UDK STACK(BEEPER DOES) TAD SRCDIR / PICK UP THE SEARCH DIRECTION SNA CLA / SKIP IF NOT GOING FORWARD AC7776 / REVERSE DIRECTION DCA SRCDIR / FOR NEXT TIME DCA GSRF / CLEAR GLOBAL SEARCH FLAG JMP EIFIX / GO BACK FOR NEXT EDITOR COMMAND /C168 XLTINI, CIFSYS / INST TO PATCH UP EDITOR / DEAD KEY SEQUENCE WAS FOUND IN TEXT BUFFER. CHECK FOR TECH CHARACTER / AND REQUIRED SPACE. IF NOT, THEN RESTART THE SEARCH EISRDK, SPA / CHECK FOR A SPECIAL CHARACTER ? CMA / YES, INVERT THE CHARACTER FOR CHECK DCA EISRT1 / SAVE THE CURRENT BUFFER CHARACTER ADVPTR / MOVE TO THE NEXT CHARACTER OF SEQUENCE JMP EISRCA / ETX, GO RESTART THE SEARCH AND P177 / Strip off attributes /A228 TAD (-ECSPC) / SUBTRACT OFF THE VALUE OF A SPACE SZA CLA / WAS THIS CHARACTER A SPACE ? JMP EISRCA / NO, MUST BE A NORMAL DEAD KEY, RESTART ADVPTR / MOVE TO THE NEXT CHARACTER OF SEQUENCE JMP EISRCA / ETX, GO RESTART THE SEARCH DCA EISRT2 / SAVE THE CHARACTER JUST OBTAINED TAD EISRT2 / GET THE CHARACTER BACK AGAIN TAD (-ECSPC) / SUBTRACT OFF THE VALUE OF A SPACE SZA CLA / WAS THIS CHARACTER A SPACE ? JMP EISRTC / NO, IT MUST BE A TECHNICAL CHARACTER TAD EISRT1 / GET THE SAVED BUFFER CHARACTER SNA / CHECK FOR REQUIRED SPACE CODE JMP EISROK / YES, IT'S A MATCH TAD (-ECSPC) / CHECK FOR A NORMAL SPACE SZA CLA / CHECK FOR A MATCH JMP EISRCA / NO MATCH, GO RESTART THE SEARCH JMP EISROK / IT'S A MATCH, GO GET END OF DEAD KEY EISRTC, TAD EISRT2 / GET THE CHARACTER BACK AGAIN AND (174) / DROP OUT LOW ORDER BITS /M228 TAD (-60) / SUBTRACT OFF CHARACTER SET VALUE SZA CLA / IS THIS A TECH CHARACTER ? JMP EISRCA / NO, GO RESTART THE SEARCH TAD EISRT2 / GET THE CHARACTER BACK AGAIN AND (3) / ISOLATE THE LOW ORDER BITS DCA EISRT3 / SAVE FOR COMPARISON TAD EISRT1 / GET THE BUFFER CHARACTER R3L / POSITION CHARACTER SET BITS AND (3) / ISOLATE THE LOW ORDER BITS CIA / MAKE VALUE NEGATIVE TAD EISRT3 / COMBINE WITH SAVED BITS SZA CLA / IS THERE A MATCH ? JMP EISRCA / NO, GO RESTART THE SEARCH TAD EISRT1 / YES, GET THE SAVED BUFFER CHARACTER AND P177 / ISOLATE THE LOW ORDER BITS DCA EISRT3 / SAVE FOR COMPARISON ADVPTR / MOVE TO THE NEXT CHARACTER OF SEQUENCE JMP EISRCA / ETX, GO RESTART THE SEARCH AND P177 / Strip off attributes /A228 CIA / NEGATE THE CHARACTER TAD EISRT3 / COMBINE WITH SAVED ASCII CHARACTER SZA CLA / CHECK FOR A MATCH JMP EISRCA / NO MATCH, GO RESTART THE SEARCH EISROK, ADVPTR / MOVE TO THE NEXT CHARACTER OF SEQUENCE JMP EISRCA / ETX, GO RESTART THE SEARCH TAD (-ECNDOV) / SUBTRACT OFF VALUE OF END DEAD CHARACTER SZA CLA / IS THIS THE END OF THE DEAD KEY ? JMP EISROK / NO, GO CHECK AGAIN CDFMYF / RESET BACK TO THIS FIELD FOR NEXT CHECK JMP EISRCY / DONE, GO CHECK NEXT CHARACTER EISRT1, .-. / TEMPORARY REGISTER ONE - BUFFER CHARACTER EISRT2, .-. / TEMPORARY REGISTER TWO - TEXT CHARACTER EISRT3, .-. / TEMPORARY REGISTER THREE - MATCH VALUE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM IFDEF LFTRGT < OVRARO= .-OVLAY1+OVRNUM JMP XVRARO / RIGHT ARROW OVLARO= .-OVLAY1+OVRNUM JMP XVLARO / LEFT ARROW > OVUPAR= .-OVLAY1+OVRNUM JMP XVUPAR / UP ARROW OVDNAR= .-OVLAY1+OVRNUM JMP XVDNAR / DOWN ARROW OVGRAR= .-OVLAY1+OVRNUM JMP XVGRAR / GOLD RIGHT ARROW OVGLAR= .-OVLAY1+OVRNUM JMP XVGLAR / GOLD LEFT ARROW OVSUPS= .-OVLAY1+OVRNUM JMP XVSUPS OVHYP2= .-OVLAY1+OVRNUM JMP XVHYP2 / LCMAP defines the end of the alphabet that is to be considered for / UPPER/ lower casing commands. 133 includes "A"-"Z", and 136 / includes "A"-"Z" and the national standard characters "[","\" and "]" IFDEF SCANDI / Scandinavian: include extra characters IFNDEF SCANDI / American: use only ASCII set OVCASE= .-OVLAY1+OVRNUM / SET UPPER-LOWER CASE JMS SCRNMD / SHOW SCREEN (TO BE) MODIFIED JMS GETUNT CASNXT, XX SNA JMP EINEXT JMS BHOOK / Call Blaster /A230 MNCUCS / Case any valid char /A230 JMP GETUNY / Finished with invalid or dead /A230 JMP I CASNXT / Exit /A230 /d230 TAD (-ECSTOV) / Is it a dead key sequence /A207 /d230 SNA / No /A207 /d230 JMP GETUNY / Yes, curmov over it /A207 /d230 TAD (ECSTOV) / Restore character to original value /A207 /d230 JMS CHKALP /d230 JMP I CASNXT /d230 AND (137) / SET UPPER CASE /d230 TAD (-133) / CHECK FOR PROPER RANGE /d230 SMA /d230 JMP CASUN1 /d230 TAD (133-101) /d230 SPA /d230 JMP CASUN1 /d230 CLA MQA /d230 AND (7737) /d230 TAD CASBIT /d230 MQL /d230CASUN1, CLA MQA /d230 JMP I CASNXT OVBOLD= .-OVLAY1+OVRNUM XVBOLD, JMS SCRNMD / SET BOLD - SHOW SCREEN (TO BE) MODIFIED JMS GETUNT BLDNXT, XX SNA JMP EINEXT JMS CHKALP JMP BLDUN2 BLDUN3, AND (7577) / CLEAR THE BIT TAD BLDBIT / SO WE CAN (SET) IT BLDUN1, JMP I BLDNXT BLDUN2, AND (2177) TAD (-40) SZA TAD (40-ECTAB) / ALLOW TABS TO BE BOLDED SZA CLA JMP BLDUN1 CLA MQA JMP BLDUN3 OVUNDL= .-OVLAY1+OVRNUM XVUNDL, JMS SCRNMD / UNDERLINING - SHOW SCREEN (TO BE) MODIFIED JMS GETUNT UDLNXT, XX SNA JMP EINEXT JMS CHKALP JMP UDLUN2 RTL SPA CLA JMP UDLUN1 / IGNORE IF SUPERSCRPTED UDLUN3, CLA MQA / RESTORE CHAR AND (7377) / CLEAR THE BIT TAD UDLBIT / SO WE CAN (SET) IT UDLUN1, JMP I UDLNXT UDLUN2, AND (3177) TAD (-40) SZA TAD (40-ECTAB) SZA CLA JMP UDLUN1 JMP UDLUN3 XVSUPS, TSTSLT / SUPER-SUBSCRPT SKP CLA TAD (SLCTMD) DCA GRAMUN JMS SETUNT JMS GETUNT SUPNXT, XX SNA JMP EIFIX /C168 JMS CHKALP JMP I SUPNXT AND (2377) SWP RTL RAL SNL CLA / CLEAR IF NOT SUP-SUB SPA CLA CMA CLL / -1 IF SUB SZL IAC / +1 IF SUP TAD CASBIT / ADJUST FOR MODE IN EFFECT TAD (TAD EISUP1) / THIS INSURES A CURRENT PAGE REFERENCE / AVOIDING ANY DATA FIELD PROBLEMS DCA .+1 .-. MQA JMP I SUPNXT 1400 / SUB OF SUB 1400 / SUB OF NORMAL 0000 / SUB OF SUP (OR SUP OF SUB) EISUP1, 1000 / SUP OF NORMAL 1000 / SUP OF SUP / / We are here because the user tried to Hyphenate a char which /A231 / was not alpha , so check for 8 bit /A231 / XVHYP3, TAD (-ECNDOV) / Check if we are on a dead /A231 SZA CLA / Yes , go check it out /A231 JMP XVHYP4 / No , go on as normal /A231 JMS BHOOK / Call the Blaster again /A231 XVMNPH / Check for Mutli Nat for Hyphen /A231 JMP XVHYP4 / And exit /A231 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE XVHYP2, BKPPTR JMP I TLITDA JMS CHKALP JMP XVHYP3 / Go check for 8 bit /M231 AC2000 MQA / SET BREAK BIT DCA I CURPTR / STORE UPDATED CHAR XVHYP4, ADVPTR NOP / RESTORE CURSOR JMP EIFIX /C168 TLITDA, EIBAD / **TEMP FOR OS/ 8 LIT POOL LIMIT BYPASS /*********************************************************************** /**** LEFT AND RIGHT ARROW ROUTINES **** /*********************************************************************** IFDEF LFTRGT < / LEFT AND RIGHT CURSOR XVLARO, IAC / MOVE MODE XVRARO, JMS ARMSET / SET MOVE MODE JMS ARCURM / GO MOVE CURSOR JMP EIBAD / (STX/ETX OR SCROLL) JMP EINEXT / DIDN'T SCROLL, SUPER! > / END IFDEF LFTRGT /*********************************************************************** /**** GOLD LEFT AND RIGHT ARROW ROUTINES **** /*********************************************************************** XVGLAR, IAC / MOVE MODE XVGRAR, JMS ARMSET / SET MOVE MODE DCA ARCTMP / SAVE CURSOR DIRECTION TAD ARCTMP JMS ARCURM / MOVE CURSOR JMP EIBAD / (CAN'T, GO BUZZ) GLDARR, TAD ARCTMP JMS ARCURM / KEEP MOVING TILL WE GET JMP EINEXT / TO THE END OF THE LINE JMP GLDARR /*********************************************************************** /**** UP AND DOWN ARROW ROUTINES **** /*********************************************************************** XVUPAR, IAC / MOVE MODE XVDNAR, JMS ARMSET / SET MOVE MODE JMS UPDNAR / GO MOVE THE CURSOR JMP EINEXT / OKAY JMP EIBAD / (CAN'T) /*********************************************************************** / COMMON CODE FOR UP/DOWN ARROW / ENTER: AC = CURSOR DIRECTION (+1=ADV, -1=BKP) / EXIT: 1ST RETURN IF WE ARE SITTING ON THE FIRST OR / LAST LINE OF TEXT (CURSOR UNCHANGED) / SKIP RETURN IF WE ACTUALLY SCROLL A LINE / (CURSOR MOVED TO PROPER POSITION W/IN LINE) /*********************************************************************** UPDNAR, XX DCA ARCTMP / SAVE DIRECTION TAD REMCUR / DO WE HAVE A REMEMBERED POSITION? SMA CLA JMP UPDN0 / YES, ALL SET TAD CURSOR / NO, SAVE WHERE WE ARE NOW DCA REMCUR UPDN0, TAD ARCTMP / GOING FORWARD OR BACK? SPA CLA JMP UPDNUP / (BACK) / GOING FORWARD (DOWN ARROW) AC0001 JMS ARMVSC / FORWARD TILL WE SCROLL ISZ UPDNAR / ETX, TAKE SKIP RETURN JMS FXSCRL / FIX FOR DOWN ARROW AND MATH /A194 JMP UPDNXT / THEN GO POSITION CURSOR / GOING BACKWARD (UP ARROW) UPDNUP, JMS SAVLMD / SAVE LINE MODE IF NECESSARY AC7777 / BACK UP TILL WE SCROLL JMS ARMVSC SKP / (STX) JMP UPDNU0 ISZ UPDNAR / STX, TAKE SKIP RETURN UPDNU1, CURMOV / FIX CURSOR AT STX NOP JMP UPDNXT / GO POSITION CURSOR UPDNU0, AC7777 JMS ARMVSC / BACK UP TILL WE SCROLL AGAIN JMP UPDNU1 / (STX, GO FIX -- NO ERROR THIS TIME) AC0001 / AND FORWARD JMS ARMVSC NOP / COMMON EXIT PROCESSING FOR UP & DOWN POSITION THE CURSOR ON THE LINE UPDNXT, CLA CDFEDT TAD REMCUR / WHERE ARE WE NOW? CIA TAD CURSOR SMA CLA / (NOT THERE YET) JMP I UPDNAR / ALL DONE, RETURN CDFBUF / SET FIELD TO EDIT BUFFER /A202 TAD I CURPTR / GET CURRENT CHARACTER /A202 CDFMYF / RESET DATA FIELD /A202 AND P177 / MASK OUT CHARACER /A202 ZZCASE / TEST FOR LINE ENDER CONDITIONS /A202 UPDNX9-1 / TABLE /A202 AC0001 / NO MATCH ADVANCE CURSOR JMS ARCURM / MOVE WITHOUT LEAVING LINE /C211 UPDNX1, JMP I UPDNAR / HIT STX OR ETX JMP UPDNXT / HAVE WE REACHED THE PROPER COLUMN COUNT UPDNX9, ECNWLN; UPDNX1 / LINE ENDER CHARACTERS /A202 ECNWPG; UPDNX1 / /A202 0000 / /A202 / ARROW KEYPAD CURSOR MOVE (MOVE W/O LEAVING LINE) / ENTER: AC = CURSOR DIRECTION (+1=ADV, -1=BKP) / EXIT: AC = 0 / 1ST RETURN IF WE CAN'T MOVE ON THE LINE ARCURM, XX DCA ARCTMP / SAVE DIRECTION DCA SCRLFL / ENSURE SCROLL FLAG 0 TAD ARCTMP CURMOV / MOVE THE CURSOR JMP I ARCURM / (STX OR ETX) CLA TAD SCRLFL / DID WE SCROLL? SZA CLA JMP ARCRM0 / (YES, THAT'S A NO-NO) ISZ ARCURM / NO, GREAT! TAKE SKIP JMP I ARCURM ARCRM0, TAD ARCTMP / PROBLEM -- WE SCROLLED CIA JMS ARMVSC / UNDO THE SCROLL NOP JMP I ARCURM / TAKE FIRST RETURN / ROUTINE TO MOVE CURSOR TILL WE SCROLL / ENTER: AC = CURSOR DIRECTION (+1=ADV, -1=BKP) / EXIT: AC = 0 / 1ST RETURN - WE HIT STX OR ETX (IF STX, WE SCROLLED) / 2ND RETURN - OKAY ARMVSC, XX DCA ARCTMP / SAVE DIRECTION DCA SCRLFL / ENSURE FLAG = 0 ARMVS0, TAD ARCTMP CURMOV / MOVE THE CURSOR JMP I ARMVSC / (STX OR ETX) CLA TAD SCRLFL / DID WE SCROLL? SNA CLA JMP ARMVS0 / NO, GO AGAIN ISZ ARMVSC / YES, TAKE SKIP JMP I ARMVSC / RETURN / SET MOVE MODE FOR ARROW KEYPAD / ENTER: AC = MOVE MODE (0=ADV, 1=BKP) / EXIT: AC = CURSOR DIRECTION (+1=ADV, -1=BKP) ARMSET, XX DCA ARCTMP MODSET / SET MOVE MODE ARMODE TAD ARCTMP / NOW SET THE CURSOR DIRECTION SZA AC7776 / (BACKUP) IAC / (ADVANCE) JMP I ARMSET ARMODE, SCHMOD!SLTMOD ARCTMP, .-. / TEMP STORAGE FOR THIS PAGE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / OVERLAY TO MERGE LIST DOCUMENT / THE CHARACTER "<" IN A FORM DOCUMENT IS TREATED IN A SPECIAL WAY DEPENDING ON / WHAT FOLLOWS IT: / - SUBSTITIUTE THE TEXT OF THE NAMED FIELD IN THE / CURRENT RECORD AT THIS POINT IN THE OUTPUT. / - START THE REPETITIVE ZONE HERE, NOT AT THE TOP OF THE / FORM DOCUMENT. (PRECEDING TEXT IS THE HEADER.) / - END THE REPETITIVE ZONE HERE, NOT AT THE BOTTOM OF THE / FORM DOCUMENT. (FOLLOWING TEXT IS A TRAILER.) / - COPY THE TEXT OF THE CURRENT RECORD FROM THE LIST / DOCUMENT TO THE OUTPUT. / <> - ADVANCE TO THE NEXT RECORD IN THE LIST DOCUMENT. / << - OUTPUT A SINGLE "<" AT THIS POINT. / NO OTHER CHARACTERS IN THE FORM DOCUMENT ARE TREATED SPECIALLY. /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 / NEW OVERLAY NUMBER OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVMRG2= .-OVLAY1+OVRNUM / SECOND MERGE OVERLAY ISZ ECHFLG / SET FLAG TO LET SCREEN SCROLL WITH US ISZ MRGRSF / INIT RESYNC FLAG FOR: NO RESYNC MRGFSA, CURMOV NOP MRGFSB, JMS LODCHR / LOOKING FOR START OF FIELD JMP MRGEOF / WE HIT END OF THE FORM DOCUMENT AND P177 / STRIP MODE BITS FROM CHARACTER TAD (-"<+200) / IS CHARACTER = "<"? SZA CLA / SKIP IF: SO JMP MRGADV / JUMP IF NOT TAD CURPTR / GET POINTER TO LEFT ANGLE BRACKET DCA MRGPT2 / SAVE POINTER TO LEFT ANGLE BRACKET SLNMOD / SET LINE MODIFIED FLAG JMS JCLEAN / WE'RE GOING TO CHANGE SOMETHING ADVPTR / GET NEXT CHARACTER JMP MRGETX / WE HIT END OF TEXT AND P177 / STRIP MODE BITS TAD (-"<+200) / IS CHARACTER ANOTHER "<"? SNA / SKIP IF: NOT JMP MRGS1A / GO PROCESS A "<<" SEQUENCE TAD ("<-">) / IS CHARACTER = ">"? SNA / SKIP IF: NOT JMP MRGS2A / GO PROCESS "<>"(NULL FIELD NAME) TAD (">-"!) / IS CHARACTER = "!"? SNA CLA / SKIP IF: NOT JMP MRGS3A / GO PROCESS SPECIAL NAME (!E, !R, !S) / MATCH FIELD NAME IN FORM DOCUMENT TO A FIELD NAME FROM THE MATH / RESULT BUFFER AND THEN THE RECORD BUFFER JMS MFNIFD / MATCH FIELD NAME IN FORM DOCUMENT TO RESBUF / FIELD NAME IN MATH RESULT BUFFER CDFLP / RESBUF IS IN LIST PROCESS. FIELD / IF NO MATCH IS FOUND WE WILL RETURN / HERE FROM THE JMS SO WE CAN TRY TO / FIND A MATCH IN RECBUF. IF A MATCH / WAS FOUND IN RESBUF THEN MFNIFD / RETURNS TO MRGFSA (NOT HERE!!!!). / ALL FOR THE NEED OF SPACE. JMS MFNIFD / MATCH FIELD NAME IN FORM DOCUMENT TO RECBUF / FIELD NAME IN RECORD BUFFER CDFBUF / DF TO THE EDITOR BUFFER FIELD JMP MRGFNF / NO MATCH - FIELD NAME NOT FOUND IN / EITHER RESBUF OR RECBUF. / IF NO MATCH IS FOUND WE WILL RETURN / HERE FROM THE JMS SO WE CAN GO TO / FIELD NOT FOUND ROUTINE. IF A / MATCH WAS FOUND IN RECBUF THEN / MFNIFD RETURNS TO MRGFSA (NOT / HERE!!!!). ALL FOR THE NEED OF / SPACE. /**************************************************************************** / / The following routine has been made into a blasted routine /a224 / to make space for the multinational and technical character set /a224 / changes (see WPHOLE.PA for explanation). /a224 / /**************************************************************************** /d224 MFNIFD, XX / MATCH FIELD NAME IN FORM DOCUMENT /d224 CDFMYF / CHANGE DF TO MY FIELD /d224 TAD I MFNIFD / GET ADDRESS OF BUFFER TO MATCH /d224 DCA MRGPT1 / SAVE IT /d224 ISZ MFNIFD / BUMP RETURN /d224 TAD I MFNIFD / GET FIELD OF THAT BUFFER /d224 DCA TADIM1 / SAVE IT /d224 ISZ MFNIFD / BUMP RETURN /d224 MRGFS1, TAD MRGPT2 / POINT TO TEXT BRACKET IN FORM /d224 DCA CURPTR / RESET POINTER /d224 MRGFS2, JMS TADIMRGPT1 / GET NEXT CHAR FROM RECORD ISZ MRGPT1 / BUMP RECORD PTR /d224 SNA / SKIP IF: NOT END OF RECORD /d224 JMP I MFNIFD / FIELD NOT FOUND, END OF RECORD / RETURN TO CALLER /d224 TAD (-"<+200) / IS CHARACTER = "<"? /d224 SZA CLA / SKIP IF: SO /d224 JMP MRGFS2 / LOOP TIL FIELD START /d224 TAD (-GPBSIZ / Field found, so init max siz counter /a224 /d224 DCA T2 / to ignore end comparison if max siz /a224 /d224 / for significant field name reached /a224 /d224 MRGFS3, ADVPTR / GET NEXT FIELD VALUE CHAR. FROM TEXT /d224 JMP MRGETX / WE HIT THE END OF TEXT /d224 AND P177 / STRIP MODE BITS /d224 XLTUPR / XLAT CHAR TO UPPER CASE /d224 CIA / SET UP FOR COMPARE WITH RECORD'S /d224 DCA T1 / FIELD NAME VALUE /d224 JMS TADIMRGPT1 / GET NEXT CHAR FROM RECORD /d224 XLTUPR / XLAT TO UPPER CASE /d224 TAD T1 / COMPARE WITH CHARACTER FROM TEXT /d224 ISZ T2 / Has the max length of FN been reached?/a224 /d224 SNA CLA / NO, SKIP IF: CHARACTERS DON'T MATCH /d224 SKP CLA / Yes, or match, skip on. /a224 /d224 JMP MRGFS1 / LOOP IF NOT EQUAL /d224 JMS TADIMRGPT1 / GET NEXT RECORD CHARACTER /d224 ISZ MRGPT1 / BUMP POINTER INTO RECORD /d224 TAD (-">+200) / IS CHARACTER = ">"? /d224 SZA CLA / SKIP IF:SO /d224 JMP MRGFS3 / CHECK FOR END OF NAME /d224 TAD MRGPT2 / RESET TEXT BUFFER POINTER TO START OF /d224 DCA CURPTR / FIELD NAME WE JUST MATCHED. /d224 JMS MRGDLF / DELETE THAT FIELD NAME FROM TEXT /d224 MRGFS4, DCA MRGPT2 / SET LOOKAHEAD /d224 JMS TADIMRGPT1 / CHECK FOR END OF FIELD IN RECORD /d224 TAD (-"<+200) / IS CHARACTER = "<"? /d224 SNA CLA / SKIP IF: NOT /d224 JMP MRGFS5 / JUMP IF END OF FIELD VALUE /d224 TAD MRGPT2 / GET LOOK AHEAD CHARACTER /d224 SZA / SKIP IF: 0 /d224 INSCHR / OUTPUT LOOKAHEAD /d224 JMS TADIMRGPT1 / LOAD NEW LOOKAHEAD /d224 CLA SWP / ATTRIBUTED CHAR. COMES BACK IN THE MQ /d224 / NOW RESTORE IT TO THE AC /d224 ISZ MRGPT1 / BUMP POINTER INTO FIELD VALUE /d224 JMP MRGFS4 / LOOP TO OUTPUT NEXT FIELD VALUE CHAR. /d224 / INTO RESULT DOCUMENT /d224 /d224 MRGFS5, TAD MRGPT2 / OUTPUT LAST CHAR AT END OF FIELD /d224 TAD (-40) / WAS THIS A SPECIAL CHAR.? /d224 SPA SNA CLA / SKIP IF: NOT /d224 JMP MRGFS6 / SPECIAL CHARACTER. DO NOT INSERT /d224 TAD MRGPT2 / REGULAR CHARACTER. INSERT INTO TEXT /d224 INSCHR /d224 MRGFS6, JMP MRGFSA / BUMP RETURN FOR MATCH /**************************************************************************** / / The following routine is the replacement for the above. It /a224 / calls the blaster hook for this field to blast in the field /a224 / name search routine moved. /a224 / /**************************************************************************** MFNIFD, XX / Replacement field name search /a224 CDFMYF / Return to home data field /a224 TAD I MFNIFD / Set up the parameters passed after the/a224 DCA MRGPT1 / call, which can not be done by the /a224 ISZ MFNIFD / blasted routine, as the return addres /a224 TAD I MFNIFD / points to the blaster, not the call to/a224 DCA TADIM1 / here. /a224 ISZ MFNIFD / /a224 JMS BHOOK / Blast in the routine /a224 MFNHLR / Merge_Field_Name_HoLe_Routine /a224 JMP I MFNIFD / Return here if not found, and exit /a224 SZA CLA / Return here if found or EOF of form /a224 JMP MRGFSA / If found, continue /a224 JMP MRGETX / If EOF, deal with it /a224 / THIS ROUTINE WILL READ A CHARACTER FROM THE BUFFER SPECIFIED WHEN / MFNIFD WAS CALLED. TADIM1 IS PRIMED UPON CALL TO MFNIFD. UPON / READING A CHARACTER THE DF IS ALWAYS RETURNED TO THE EDITOR BUFFER / FIELD SINCE OTHER ROUTINES CALLED DURING OVMRG2 DEPEND ON DF SET / TO THE EDITOR BUFFER FIELD. / THE MQ IS USED TO HOLD THE ATTRIBUTED CHARACTER SO THAT WHEN / LOADING CHARACTERS FROM THE LIST DOCUMENT TO THE RESULT DOC. / ATTRIBUTES OF CHARACTERS ARE NOT DROPPED TADIMRGPT1, XX TADIM1, .-. / LOADED WITH CDF INSTRUCTION TAD I MRGPT1 / READ CHARACTER FROM RECORD MQL / LOAD THE ATTRIBUTED CHAR INTO THE MQ MQA / RESTORE THE CHAR INTO THE AC AND P177 / STRIP MODE BITS CDFBUF / SET DF TO EDITOR BUFFER FIELD JMP I TADIMRGPT1 / RETURN / MULTIPLE LEFT ANGE BRACKET SEQUENCE HANDLER ("<<...ETC.") - DELETE / ONE OF THE LEFT ANGLE BRACKETS IN THE TEXT AND IGNORE ANY THAT / IMMEDIATELY FOLLOW. WHEN THE FIRST CHARACTER THAT IS NOT A "<" IS / READ REENTER SCAN LOOP. THIS ENABLES US TO USE FIELD NAMES AS / TEXT WITHIN A DOCUMENT WITHOUT TRYING TO FIND A MATCH WITH A / FIELD NAME IN THE CURRENT RECORD. MRGS1A, DCA I CURPTR / DELETE ONE OF THE LEFT ANGLE BRACKETS TAD MRGPT2 / RESTORE POINTER TO START OF FIELD DCA CURPTR SLNMOD / SET LINE MODIFIED FLAG MRGS1B, AC0001 / ADVANCE CURSOR 1 CHARACTER CURMOV JMP MRGEOF / EOF RETURN FROM CURMOV JMS CHKSPC / CHECK DISKETTE SPACE JMS LODCHR / GET THE NEXT CHARACTER JMP MRGEOF / EOF RETURN AND P177 / STRIP MODE BITS TAD (-"<+200) / IS CHARACTER = "<"? SNA CLA / SKIP IF: NOT JMP MRGS1B / CHARACTER = "<". GET NEXT ONE JMP MRGFSB / REENTER SCAN LOOP X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / ADVANCE CURSOR ONE CHARACTER AT A TIME THROUGH RESULT DOCUMENT, / CHECKING FOR ENOUGH ROOM ON DISKETTE TO CONTINUE THROUGH THE DOC. MRGADV, AC0001 / ADVANCE CURSOR 1 CHARACTER CURMOV JMP MRGEOF / EOF RETURN FROM CURMOV JMS CHKSPC / CHECK DISKETTE SPACE JMP MRGFSB / GO CHECK NEXT CHAR / FIELD NOT FOUND (NO MATCH BETWEEN FORM DOCUMENT FIELD AND ANY OF THE / FIELDS OF THE CURRENT RECORD BEING PROCESSED). THEREFOR DELETE THIS / FIELD FROM THE RESULT DOCUMENT. MRGFNF, TAD MRGPT2 / POINT TO START OF FIELD IN RESULT DOC. DCA CURPTR JMS MRGDLF / AND DELETE THE FIELD JMP MRGFSA / THEN CONTINUE SCAN LOOP / EMPTY LEFT AND RIGHT ANGLE BRACKET HANDLER ("<>") - DELETE "<>" FROM / THE RESULT DOCUMENT AND LOAD THE NEXT RECORD TO BE PROCESSED. MRGS2A, TAD MRGPT2 / RESET POINTER TO "<" DCA CURPTR JMS MRGDLF / DELETE "<>" FROM RESULT DOCUMENT JMS MRGNXT / GET NEXT RECORD SKP / NO MORE RECORDS JMP MRGFSA / REENTER SCAN LOOP IF WE GOT ONE / ELSE SKIP TO / DELETE TO AND INCLUSIVE OF THE CONTROL SEQUENCE "" IN THE RESULT / DOCUMENT. IF "" IS NOT ENCOUNTED THEN DELETE TO END OF RESULT / DOCUMENT. MRGS2B, JMS MRGDLS / DELETE TO AND INCLUSIVE OF "+200) / WAS CHARACTER JUST DELETED A ">"? SZA CLA / SKIP IF: SO JMP .-4 / DELETE TIL END SLNMOD / SET LINE MODIFIED JMP I MRGDLF / THEN RETURN / MERGE NEXT RECORD - LOAD THE NEXT RECORD OF THE LIST DOCUMENT INTO / RECBUF. IF THERE ARE NO MORE RECORDS LEFT THEN DON'T SKIP RETURN. MRGNXT, XX / GET NEXT RECORD SLNMOD / SET LINE MODIFIED JMS FXSCRL / UPDATE SCREEN CDFMYF / CHANGE DATA FIELD MYFIELD CIFLP / CHANGE INSTRUCTION FIELD TO LP FIELD. JMS I (SELCT) / LOAD THE NEXT RECORD SNA CLA / SKIP IF: NO RECORDS LEFT ISZ MRGNXT / BUMP RETURN - WE'VE LOADED A RECORD JMP I MRGNXT / RETURN / ANALYZE THE SPECIAL FIELD NAMES (E, R, S) MRGS3A, ADVPTR / GET THE NAME JMP MRGETX / NO CHARACTERS LEFT DCA MRGPT1 / SAVE IT, WHILE TAD MRGPT2 / DELETE REST OF THE FIELD NAME DCA CURPTR JMS MRGDLF TAD MRGPT1 / GET THE NAME BACK AND P177 / STRIP THE MODE BITS XLTUPR / XLAT NAME TO UPPER CASE TAD (-"E+200) / IS THE FIELD NAME = "E"? SNA / SKIP IF: NOT JMP MRGSEA / PROCESS START OF TRAILER TAD ("E-"R) / IS THE FIELD NAME = "R"? SNA / SKIP IF: NOT JMP MRGSRA / PROCESS INSERT WHOLE RECORD TAD ("R-"S) / IS THE FIELD NAME = "S"? SNA CLA / SKIP IF: NOT DCA MRGRSF / SET RESYNC FLAG FOR: RESYNC JMP MRGFSA / NONE OF THE ABOVE - IGNORE THIS FIELD / PROCESS INSERT WHOLE RECORD - INSERT RECORD COMMAND MRGSRA, TAD (RECBUF) / INIT POINTER TO TOP OF RECORD DCA MRGPT1 MRGSRB, TAD I MRGPT1 / GET NEXT CHAR FROM RECORD SNA / SKIP IF: NOT END OF RECORD IN BUFFER JMP MRGFSA / QUIT IF NO MORE INSCHR / INSERT INTO TEXT ISZ MRGPT1 / BUMP TO NEXT CHAR JMP MRGSRB / AND LOOP FOR ALL / DELETE A PARTIAL FIELD (FIELD NAME WITH NO TERMINATING ">") MRGETX, TAD MRGPT2 / RESET POINTER TO START OF FIELD NAME DCA CURPTR JMS MRGDLF / DELETE THIS PARTIAL FIELD THEN JOIN / COMMON CODE FOR EOF PROCESSING BELOW / PROCESS START OF TRAILER MRGSEA, / LOOP BACK POINT MRGEOF, / OR EOF JMS MRGNXT / GET NEXT RECORD JMP MRGTRL / SKIP TO TRAILER IF NO MORE TAD FORMNO / REINIT FORM DOCUMENT FOR READ JMS DSKCAL XRDFIN TAD MRGRSF / IS A RESYNC NEEDED? SZA CLA / SKIP IF: SO (MRGRSF=0) JMP MRGFSA / JUMP IF NO RESYNC NEEDED MRGSEB, JMS MRGDLS / ELSE DELETE TO RESYNC POINT TAD (-"S+200) / IS THE CHAR. FOLLOWING "" JMS MRGDLF / DELETE REST OF RESYNC FIELD JMP MRGFSA / AND REENTER SCAN LOOP / DELETE UPTO AND INCLUSIVE OF THE " / END IFDEF PERDEC IFDEF COLDEC < RLXIT, TAD (5572) DCA OKSTR > / END IFDEF COLDEC IFDEF COMDEC < RLXIT, TAD (5554) DCA OKSTR > / END IFDEF COMDEC CDFMYF / PROPER FIELD /A192 TAD SPLTFL / SPLIT SCREEN? SMA CLA /M192 JMP RLXIT1 / NO, OR NO CHANGE /M192 TAD WIDPRV / WAS SCREEN WIDE BEFORE? SZA CLA JMP RLXIT2 / YES, DO NOTHING CDFMNU TAD NWRMAR / REMOVE SPLIT, IF NEC. CDFMYF TAD (-COLM80) / (I.E., IF R .LT. 80) SMA SZA CLA JMP RLXIT1 DCA SPLTFL /D192 JMS CLR132 / REVERT TO 80-COLUMN DISPLAY AND /D192 / DO FINAL EXIT STUFF. RLXIT2, JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS / / END OF PROCESSING FOR GOLD:RULER COMMAND. / THE USER HAS JUST INSERTED A NEW RULER INTO THE DOCUMENT. / / FIX UP RULERS (I.E., CONCATENATE ADJACENT RULERS, AND DELETE RULERS / THAT MAKE NO NET CHANGE) BY MOVING THE CURSOR BACK THEN FORWARD / OVER RULER(S). / / BEFORE FIXING UP RULERS TURN MATH OFF SO THAT MATH IS NOT REDUNDANT / ON THE SAME LINE. WHEN FINISHED FIXING UP LINE THEN RESTORE MATH / TO ON/OFF STATE AT ENTRY TO RLXIT1. / NOTE: IT MIGHT SEEM THAT SUBR SWTHMA WOULD BE SUITABLE FOR USE HERE. / ALTHOUGH SWTHMA WILL PREVENT REDUNDANT CALCULATIONS FROM BEING / PERFORMED WHEN MOVING FORWARD, IT WILL PERMIT MATH TO BE TURNED OFF / UNDER CERTAIN CONDITIONS (WHEN MOVING BACKWARDS IN A WPSMATH CONTROL / BLOCK??), WHICH COULD MEAN THAT A SIDE EFFECT OF CHANGING A RULER / IS TO TURN OFF MATH. WE MUST AVOID THIS, SO WE CAN'T USE SWTHMA ... RLXIT1, JMS MNUGET / GET A VALUE FROM THE MENU FIELD MNOPTC / ACTIVE FEATURES CONTROL WORD DCA RXLIT2 / SAVE IT IN TEMPORARY LOCATION TAD RXLIT2 / RESTORE ACTIVE FEATURES CONTROL WORD AND (-MABIT-1) / BUT WITH THE MATH INACTIVATED JMS MNUPUT / PUT A VALUE INTO THE MENU FIELD MNOPTC / ACTIVE FEATURES CONTROL WORD AC7777 / SETUP FOR A BACKWARD MOVE CURMOV / MOVE CURSOR BACKWARD ONE POSITION SKP CLA / IF TOP OF DOCUMENT, THEN DON'T / CURMOV FORWARD RLXIT3, AC0001 / MOVE PTR FORWARD ONE CURMOV JMP RLXIT4 / EOF. MAYBE HALT CAUSE THIS IS AN ERROR/a176 TAD I CURPTR / IS THIS CHAR THE TEMP MARKER? /a176 TAD (-ECTMRK) /a176 SZA CLA /a176 JMP RLXIT3 / NO, KEEP LOOKING /a176 TAD (ECMDFL) / YES, REPLACE IT WITH A LINE MODIFIED /a176 DCA I CURPTR /a176 RLXIT4, TAD RXLIT2 / RESTORE ACTIVE FEATURES CONTROL WORD / TO IT'S VALUE AT ENTRY TO RXLIT1 JMS MNUPUT / PUT A VALUE INTO THE MENU FIELD MNOPTC / ACTIVE FEATURES CONTROL WORD / / TERMINATE NORMAL GOLD:RULER COMMAND / TAD RRDIR / IS THIS GOTO-RULER? SNA CLA JMP EIFIX / NO (END OF NORMAL GOLD:RULER CMD): /C168 / GO LISTEN FOR NEXT EDITOR COMMAND JMS FXSCRL / GET RID OF THE EDITED RULER & SCALE OVLJMP / YES: GO DO GOTO-RULER OVRRGO X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM VIEWF1= OVRNUM / used to identify view mode overlay / HANDLE KEYBOARD INPUT FOR GOLD:VIEW COMMAND OVVWDX= .-OVLAY1+OVRNUM JMP XVVWDX / "GOLD:VIEW" COMMAND OVVIEW= .-OVLAY1+OVRNUM JMP VIEW / +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ / +++ Gold:Tab (Indent Tabs) +++ / +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ / / This Code is called from OVRULR for processing Gold:Tab. The / purpose of which is to place a @W' (word wrap) at the current / ruler position (and perhaps, generate a new ruler). / / This will make it very easy to do such things as outlines, / where you'd like to change the word wrap margin often. / / When called, a few things could happen depending on where the / cursor (CURSOR) is in the ruler. / / 1) Cursor is on the Left Margin / Clear the Ruler of the Word Wrap: / Modify or generate a ruler without a Word Wrap. / Change the old Word Wrap (if present) to a Tab. / If too many tabs exist, the old Word Wrap is changed / to a blank. / If no Word Wrap is present in the Current ruler, / then nothing happens. / / 2) Cursor is on the Right Margin / Error: / Beep the bell. Don't clear the UDK Stack. / / 3) Cursor is neither on Left or Right Margins / Add Word Wrap to the Ruler: / Modify or generate a ruler with a Word Wrap at the Cursor. / Change the old Word Wrap (if present) to a Tab. / If too many tabs exist, the old Word Wrap is changed / to a blank. / / Upon completion of this routine, OVXRUL is called which cleans / things up, and displays the newly modified or created ruler. / / OVINTB= .-OVLAY1+OVRNUM DCA RRDIR / CLEAR 'GOTO-RULER' FLAG TAD CURSOR / CHECK FOR CURSOR=RIGHT MARGIN CIA TAD RGTMAR SPA SNA CLA JMP INTB3 / RIGHT MARGIN - BEEP AND RETURN TO EDITOR INTB1, JMS WTOT / CHANGE WORD WRAP TO TAB(04) OR BLANK(01) CHGRUL, 04 / WTOT ARGUMENT TAD CURSOR / CHECK FOR CURSOR=LEFT MARGIN CIA TAD LFTMAR SNA CLA JMP INTB2 / LEFT MARGIN - ALL DONE AC0001 TAD CURSOR DCA RLPOSN / GET RULER POSTION OF CURSOR TAD WRPVAL / PUT WORD WRAP AT CURSOR IN RULER JMS UPDRUL INTB2, OVLJMP OVXRUL / RULER COMPLEATION CODE WRPVAL, 11 / INTERNAL-RULER WRAP CODE INTBAD= .-OVLAY1+OVRNUM / +++ OVERLAY CALL WHEN THE RULER HAS AN ERROR IN IT: / NAMELY TOO MANY TABS. / / IF THERE IS NO PREVIOUSLY DEFINED WORD WRAP .. WE RESTORE / THE RULER, BEEP, AND RETURN TO THE EDITOR / / IF THERE WAS A WORD WRAP DEFINED, WE MAKE IT A SPACE INSTEAD / OF A TAB (LIKE WE DO NORMALLY) / AC0001 / SET TO PUT A SPACE IN THE RULER DCA CHGRUL TAD LFTMAR CIA TAD WRPMAR SZA CLA / WAS THERE A WORD WRAP DEFINED? JMP INTB1 / YES, MAKE IT A SPACE JMS RLEQTE / NO, RESTORE NEW-RULER TO CURRENT-RULER INTB3, JMS BUZZER / BEEP (BUT DON'T CLEAR UDK STACK) JMP INTB2 / AND RETURN TO EDITOR / +++ SUBROUTINE: WTOT / / CHANGE THE WORD WRAP IN THE CURRENT RULER TO THE VALUE / SPECIFIED IN CALL+1. / / IF THERE IS NO WORD WRAP DEFINED (IE. LEFT MARGIN = WORD WRAP) / THEN NOTHING HAPPENS AND WTOT RETURNS / / CALL: JMS WTOT / XX VALUE TO CHANGE WRAP TO / (IN OUR CASE, ONLY: TAB(04) OR BLANK(01) WTOT, XX TAD LFTMAR / WORD WRAP DEFINED? CIA TAD WRPMAR SNA CLA JMP WTOT1 / NO - JUST RETURN AC0001 TAD WRPMAR DCA RLPOSN / GET PTR TO WORD WRAP IN RULER TAD I WTOT / GET RULER VALUE ARGUMENT JMS UPDRUL / CHANGE RULER WTOT1, ISZ WTOT / BUMP PTR JMP I WTOT / FOR RETURN ... / ROUTINE TO CHECK FOR KEYS USED IN GOLD VIEW /A219 VWTEST, XX / CHECK FOR GOLD VIEW KEYS /A219 TAD (-EDPRSC) / CODE FOR THE PREVIOUS SCREEN KEY /A219 SNA / DID USER PRESS PREVIOUS SCREEN KEY ? /A219 JMP VWPREV / YES, GO HANDLE IT /A219 IAC / BUMP COUNT TO NEXT VALUE /A219 SNA / DID USER PRESS NEXT SCREEN KEY ? /A219 JMP VWNEXT / YES, GO HANDLE IT /A219 TAD (EDPRSC-1-EDLINE) / CODE FOR THE LINE KEY /A219 JMP I VWTEST / RETURN TO INLINE CODE CHECK /A219 VWNEXT, TAD WIDNAR / GET THE SCREEN WIDTH FLAG /A219 SZA / DOES IT INDICATE WIDE SCREEN ? /A219 TAD (4) / NO, MAKE CORRECTION FOR NARROW SCREEN /A219 TAD (-COLLIM-2+WIDTH) / CONSTRUCT OFFSET TO NEXT SCREEN /A219 TAD LOWLIM / COMBINE WITH CURRENT SCREEN OFFSET /A219 DCA VWTEMP / SAVE NEW OFFSET VALUE /A219 TAD VWTEMP / GET NEW OFFSET VALUE BACK AGAIN /A219 TAD (WIDTH+COLM81) / COMBINE WITH OVERFLOW VALUE /A219 SPA CLA / DID WE OVERFLOW THE MAXIMUM VALUE ? /A219 JMP VWERR / YES, IGNORE IT AND GO RING THE BELL /A219 JMP VWVALU / NO, GO UPDATE NEW LOWLIM VALUE /A219 VWPREV, TAD WIDNAR / GET THE SCREEN WIDTH FLAG /A219 SZA / DOES IT INDICATE WIDE SCREEN ? /A219 TAD (4) / NO, MAKE CORRECTION FOR NARROW SCREEN /A219 TAD (-COLLIM-2+WIDTH) / CONSTRUCT OFFSET TO NEXT SCREEN /A219 CIA / NEGATE THE OFFSET VALUE /A219 TAD LOWLIM / COMBINE WITH CURRENT SCREEN OFFSET /A219 DCA VWTEMP / SAVE NEW OFFSET VALUE /A219 TAD VWTEMP / GET NEW OFFSET VALUE BACK AGAIN /A219 SMA SZA CLA / DID WE OVERFLOW THE MINIMUM VALUE ? /A219 JMP VWERR / YES, IGNORE IT AND GO RING THE BELL /A219 VWVALU, TAD VWTEMP / NO, GET NEW LOWLIM VALUE /A219 DCA LOWLIM / UPDATE LOMLIM WITH NEW OFFSET VALUE /A219 JMP VIEW / GO UPDATE THE SCREEN /A219 VWERR, JMS BUZZER / ERROR, CAN'T MOVE, RING THE BELL /A219 JMP VWADX2 / GO GET NEXT CHARACTER /A219 VWTEMP, XX / SAVE LOCATION FOR NEW LOWLIM VALUE /A219 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE XVVWDX, DCA CURLIN / CLEAR FOR PCUR ROUTINE TO POSN CURSOR /A161 CIFMNU / CHANGE TO MENU FIELD FOR STATUS CHECK /A161 JMS I (CALLN2) / GO CHECK IF STATUS VALUES HAVE CHANGED/A161 VWADX1, AC7777 DCA CURLIN / SET CURLIN BACK TO CORRECT VALUE FOR VIEW JMS SETCUR / AND CURSOR TO BE ON SCREEN VWADX2, GETINP / WAIT FOR KEYBOARD INPUT /C219 DCA VIEWCX / SAVE IT ... TAD VIEWCX /D219 TAD (-EDLINE) JMS VWTEST / GO CHECK FOR THE GOLD VIEW KEYS /A219 SNA CLA JMP VWADLN DCA VIEWF2 / clear view mode flag, then exit JMS CLSSET / CLAER SCREEN UPDATE FLAGS /A219 /D219 AC2000 /D219 DCA SCRLCT /D219 AC2000 /D219 DCA SCRNFL DCA CURLIN TAD VIEWCX / THEN GET INPUT CHAR TAD (-EDVIEW) / TREAT VIEW AS NOP/RETURN SNA CLA JMP EINEXT TAD VIEWCX / ELSE RELOAD INPUT CHAR JMP EINEXB / AND JUMP TO PROCESS IT VWADLN, DCA SCRLCT DCA SCRNFL DCA ECHFLG AC7777 / set view mode flag in case CURMOV DCA VIEWF2 / calls editor math VWADL1, AC0001 CURMOV JMP VWADL2 TAD SCRLCT SNA CLA JMP VWADL1 VWADL2, CDFMYF /D219 TAD WIDNAR / WIDE SCREEN? /M192 /D219 SNA CLA /M192 /D219 JMP VWADL4 / JUMP IF WIDE NEEDED TAD SCRLCT / DID WE MOVE? SNA JMS BEEPER / COMPLAIN IF NOT (MUST BE AT END OF FILE) SPA CLA JMP VIEW / ...JUST IN CASE... /C219 JMS SCRNSZ / CHECK FOR STILL ON SCREEN CLL RAR CIA TAD SCRLCT SMA CLA JMP VIEW / JUMP IF NOT /C219 TAD SCRLCT SNA JMP VWADL3 / JUMP IF NO MOVEMENT CIA CLL RAL DCA VIEWCX / SET -COUNT OF LINES TO SCROLL UP JMS PCUR / ERASE BOTTOM LINES JMS CLREOL / Clear to end of line JMS NWLN / CR LF JMS CLREOL / Clear to end of line TAD VIEWCX / COMPUTE NEW CURLIN TAD CURLIN DCA CURLIN JMS NWLN ISZ VIEWCX JMP .-2 / SCROLL SCREEN UPWARDS VWADL3, TAD SCRLCT / GET NEW LOOP COUNTER CMA JMP VIEWA0 /D219 VWADL4, /D192 AC0001 /D192 DCA SPLTFL / FIX SPLIT SCREEN FLAG /D219 JMS SET132 / MAKE SCREEN WIDE /D219 / FALL THRU INTO OVVIEW ... / "GOLD:VIEW" COMMAND VIEW, DCA CURLIN / CLEAR FOR PCUR ROUTINE TO POSN CURSOR /A219 JMS CLSCRN / CLEAR SCREEN, GO TO HOME POS. JMS SCRNSZ / GET SCREEN SIZE CLL RAR CIA VIEWA0, CDFMYF DCA VWX2 / -COUNT OF LINES TO DO TAD VWX2 / GET PTR TO FIRST LINE TAD (PTRBLK+NPTRS) DCA VWX1 TAD CURSOR / SAVE CURSOR POSITION DCA CURTMP DCA CURSOR TAD I VWX1 / FIND FIRST REAL LINE SZA CLA JMP VIEWA3 / QUIT QUICK IF OK VIEWA1, ISZ VWX1 / ELSE LOOP TAD I VWX1 SZA CLA JMP VIEWA2 ISZ VWX2 JMP VIEWA1 / MOVE CURSOR TO START OF TOP LINE VIEWA2, TAD VWX2 / GET LINE LOOP COUNTER STL RAL / TIMES 2 + 1 DCA CURLIN / = LINE NUMBER FOR PCUR JMS PCUR / MOVE CURSOR / DISPLAY "...----- TOP -----..." TAD (STXMSG) JMS PGMSG / ----- TOP ----- ISZ VWX2 / BETTER NOT SKIP! VIEWA3, /D219 / TEMPORARILY COPY VWX1 & VWX2 INTO SUBR ENTRY POINTS /D219 / TO TRANSFER VALUES TO NEXT OVERLAY. /D219 TAD VWX1 /D219 DCA I ADVSPC&177 /D219 TAD VWX2 /D219 DCA I BKPSPC&177 JMS OV2JMP OVVWB1 VWX1, .-. / PTR INTO PTRBLK FOR FIRST LINE / (COPIED TO VIEWX1 IN NEXT OVERLAY) VWX2, .-. / -(# OF TEXT LINES TO DISPLAY) / (COPIED TO VIEWX2 IN NEXT OVERLAY) VIEWCX, .-. VIEWF2, .-. / view mode flag (if this overlay is in) / / Code from VIEWBA which won't fit there / / It checks to see what type of Dead sequence is next in the buffer / VIEWBZ, CIFMNU / Move to Menu field /A231 JMS I (TCCHK) / Go check this dead thing /A231 JMP VIEWBA / Vanilla dead , display as text /A231 JMP VIEWSP / req space dead , go print it /A231 CDFMNU / Point to Menu field /A231 TAD TCTMP1 / get char itself /A231 JMP VIEWBB / and get back /A231 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE FIELD 4 RELOC *0 /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / EDIT EXIT PROCESSING OVUDKS= .-OVLAY1+OVRNUM / FIRST ENTRY USED ONLY AT THE VERY END JMP XVUDKS / OF AN EDIT (IE, NOT AT GOLD TOP) OVXITF= .-OVLAY1+OVRNUM IAC / 1 IN AC INDICATES FIRST ENTRY OVEXIT= .-OVLAY1+OVRNUM / EXIT OVERLAY DCA LSTPAS / IF ZERO, THIS IS NOT LAST CALL OF THIS EDIT TSTSLT / IF EDITOR IS IN SELECT MODE SKP JMS UNSLCS / THEN DELETE SELECT MARK CDFMYF / IF SELECTED, RETURN TO THIS FIELD /******************** EDITOR MATH INIT CALL **************************** / THE FOLLOWING CALL IS MADE TO THE MATH FIELD TO INITIALIZE THE MATH / MODULE CODE AND SET "MTHTYP" TO 1 IN THE MATH FIELD WHEN A GOLD TOP HAS / BEEN DONE IN A CTRL BLOCK WITHIN A EDITOR MATH WORK AREA. OTHERWISE / MATH WOULD NOT GET REINITALIZED AND EDITOR MATH ENDS UP BROKEN. A 1 IS / PLACED IN THE AC BEFORE THE CALL TO TELL "RTRN4" THAT IT IS TO INIT FOR / EDITOR MATH NOT LIST PROCESSING MATH. NOTE THAT THIS SAME INIT CALL / TAKES PLACE IN "OVINI1" AND HERE IN "OVEXIT". AC0001 / SET THE AC = 1 CIFMTH / CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN4 / GO SET "MTHTYP" = 1; AND INIT MATH MODULE /****************** END MATH INIT CALL ***************************** JMS RPCHK / IF GOTO PAGE, DON'T ALTER SCREEN IMAGE JMS SAVLMD / SAVE MOD FLAG IN TEXT / *** CLOSE FILE AND EXIT SKP CLA AC0001 CHKPTR SMA CLA JMP .-3 / GET TO ETX EDEXI1, AC7777 CHKPTR SNA JMP .-3 / COPY TO STX SPA CLA JMP EDEXI2 TAD I CURPTR JMS DSKCAL XPUTET JMP EDEXI1 EDEXI2, / NEXT, DETERMINE TIME THIS EDIT / AND NEW TOTAL EDIT TIME TAD LSTPAS SNA CLA / IF FINAL PASS, OK JMP TOLVED / ELSE DONT UPDATE TIMES, AND DON'T / INCREMENT THE VERSION NUMBER CDFSYS TAD I (CLOCK+3) DCA MIN / CURRENT MINUTES TAD I (CLOCK+4) / CURRENT HOUR CDFMYF JMS TOMIN DCA TMPMIN TAD OLDMIN DCA MIN / INITIAL MINUTES TAD OLDHR / INITIAL HOURS JMS TOMIN CIA TAD TMPMIN / CURRENT TIME - INITIAL TIME SPA TAD (30^74) / IF NEGATIVE, THE CLOCK ROLLED OVER.. / ADD 60 * 24 = MINUTES IN A DAY DCA TMPMIN TAD (15) CIFFIO FILEIO XHDRGT / GET OLD TOTAL TIME CLL / DONE TO CHECK FOR OVERFLOW IN NEXT ADD TAD TMPMIN / NEW TOTAL TIME SZL / SKIP IF TIME < 68:15 AC7777 / TIME WAS RESET, SET TO MAX MQL TAD (15) CIFFIO FILEIO XHDRPT / STORE NEW TOTAL TIME TAD TMPMIN MQL TAD (14) CIFFIO FILEIO XHDRPT / SAVE TIME THIS EDIT JMP LVED TOLVED, CDFMYF TAD (10) CIFFIO FILEIO / GET THE VERSION NUMBER (THE NUMBER XHDRGT / OF TIMES THE DOCUMENT HAS BEEN EDITED) TAD (-1) / DECREMENT THIS NUMBER BY ONE, SO THAT / GOLD TOP, GOLD BOTTOM AND GO-TO-PAGE MQL / DON'T ALTER IT TAD (10) CIFFIO FILEIO XHDRPT / REPLACE THE VERSION NUMBER LVED, JMS DSKCAL XDSKCL / AND CLOSE IT CDFMYF JMP OVJRTN / THEN RETURN TO MAIN LINE EXIT UNSLCS, XX / UNSELECT SUBROUTINE MODSET EDTMOD / SET ADVANCE MODE TAD (SLCTMD) DCA GRAMUN JMS SETUNT JMS GETUNT .-. SZA CLA JMP I .-2 JMP I UNSLCS TMPMIN, 0 / TEMP., ALWAYS CONTAINS MINUTES MIN, 0 / MINUTES FOR TOMIN HR, 0 / NEG OF HOURS IN TOMIN LSTPAS, 0 / FLAG - ZERO INDICATES ENTRY THRU OVEXIT, / OTHER WHEN ENTRY THRU OVXITF. X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE XVUDKS, JMS BFOVLY UDKOVL AC7777 / SET AC = -1 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA OVLJMP OVMENU / RETURN TO EDITOR MENU WHEN DONE UDKONM=15 / OVERLAY NUMBER FOR DK BUFONM=17 / DUMMY OVERLAY FOR BUFFLD LOCK WORD UDKOVL, -DSOUDK / -(LENGTH OF WPUDKS CODE) /M183 0 / LOCAL START LOC OF WPUDKS CODE DSOUDK-DSSEDT / -(LENGTH OF UDK BUFFER) /M183 UDKSTR / LOCNS OF BUFFLD TO WRITE OUT (READ BACK) UDKONM 200 / OVERLAY TO CALL & START ADDR IN BUFFLD BFOVLY, XX / LOAD OVERLAY INTO BUFFLD / AFTER SAVEING RELEVANT LOCATIONS / RESTORE THOSE LOCATIONS ON RETURN FROM OVERLAY TAD (RXEWT+2000) / LOAD OP CODE JMS BFSVRS / WRITE OUT BUFFLD LOCATIONS DCA BFOVT4 / SAVE OVERLAY NUMBER CIFMNU JMS I OLAYCL / LOAD OVERLAY BFOVT4, .-. ISZ BFOVT1 / BUMP ARG PTR TO ENTRY ADDR RIF TAD (CIF+10) DCA BFOVT2 / STORE CIF TO BUFFLD TAD I BFOVT1 DCA BFOVT4 / STORE ENTRY ADDR BFOVT2, .-. / ---CIF BUFFLD--- JMS I BFOVT4 / CALL OVERLAY TAD (RXERD) / RESTORE BUFFLD CONTENTS JMS BFSVRS CLA / OVERLAY NUM NOT NEEDED THIS TIME! CIFMNU JMS I OLAYCL BUFONM / CLEAR BUFFLD LOCK WORD ISZ BFOVLY / BUMP TO RETURN ADDR JMP I BFOVLY BFOVT1, .-. / TEMP BFSVRS, XX / BUFFLD SAVE-RESTORE SUBROUTINE DCA BFOVT5 / SAVE RXHAN OP-CODE (READ/ WRITE) TAD I BFOVLY / GET ARG PTR DCA BFOVT1 TAD (DLSEDT) DCA BFOVT4 / SET DISK LOCN BFOVL1, TAD I BFOVT1 / GET NEXT -COUNT SMA JMP I BFSVRS / RETURN IF NOT COUNT DCA BFOVT2 ISZ BFOVT1 TAD I BFOVT1 / GET ADDR DCA BFOVT3 ISZ BFOVT1 BFOVL2, TAD BFOVT4 / LOAD DISK BLOCK # CDFBUF JMS SYSIO BFOVT5, .-. / READ-WRITE OP-CODE BFOVT3, .-. / ADDR ISZ BFOVT4 / BUMP DISK BLOCK # TAD (400) TAD BFOVT3 DCA BFOVT3 / BUMP ADDR ISZ BFOVT2 JMP BFOVL2 / LOOP TIL COUNT COMPLETE JMP BFOVL1 / SUBROUTINE TO CONVERT HOURS AND MINUTES TO MINTUTES TOMIN, 0 SNA JMP MIN2 / IF ZERO AC (NO HOURS), JUMP CIA DCA HR / LOOP CONTROL LOOP, TAD (74) ISZ HR JMP LOOP MIN2, TAD MIN / ADD MINUTES-FROM-HOURS TO MINUTES JMP I TOMIN RPCHK, 0 / IF GOTO PAGE, LEAVE SCREEN ALONE TAD RPBIN1 / GOTO PAGE FLAG SPA CLA / SKIP IF NOT GOTO PAGE JMP RPXCHK / CONTINUE GOTO PAGE CLOSE JMS CLR132 / 80-COL. MODE CLA DCA SPLTFL / THIS MAKES FOR 24 LINES CIFMNU / CHANGE TO MENU INSTRUCTION FIELD AC0003 / SET UP FOR CLEAR SCREEN REQUEST JMS I (CALLN1) / GO TO STATUS LINE ROUTINE FOR CLEAR TAD (NPTRS) / PICK UP MAXIMUM NUMBER OF LINES DCA SCRNLN / SAVE FOR USE BY PROMPT ROUTINE JMS PROMPT /"...FILING BEING DONE" MSG MSGF / MSG POINTER RPXCHK, CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE JMP I RPCHK / RESUME CLOSE PROCESS X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVDEAD= .-OVLAY1+OVRNUM / THE USER TYPED "GOLD:DEAD" JMP XVDEAD OVRQSP= .-OVLAY1+OVRNUM / THE USER TYPED "GOLD:SPACE" JMP XVRQSP / (REQUIRED OR NONBREAKING SPACE) RPPER9= .-OVLAY1+OVRNUM JMP XPPER9 / MULTIPLE MATH 'START' BLOCKS FOUND RPPER5= .-OVLAY1+OVRNUM JMP XPPER5 / REPORT INVALID CHARACTER STRING RPPER3= .-OVLAY1+OVRNUM / JMP XPPER3 XPPER3, TAD (RANBAD) SKP XPPER5, TAD (CHABAD) / AC => ADDR. OF MSG. STRING SKP XPPER9, TAD (RPPME9) DCA RPMSG / SUPPLY FOR OUTPUT TO SCREEN JMS PUTMSG / DISPLAY AN ERROR MSG. ON THE / SAME LINE AS PAGE NUMBER MSG. RPMSG, .-. / ADDR. OF DESIRED ERROR MSG. JMS PUTMSG RPPRETRY JMS GETLIN RPBUF /C206 OVLJMP; OVRPP4 / STARTUP REPOSITIONING AGAIN... RPBUF, -1 /C206 ZBLOCK 1 /*********************************************************************** /**** PREVIOUS AND NEXT SCREEN ROUTINES **** /*********************************************************************** OVPRSC= .-OVLAY1+OVRNUM / ENTER FOR PREVIOUS SCREEN IAC OVNXSC= .-OVLAY1+OVRNUM / ENTER FOR NEXT SCREEN DCA ARTMP / AC = MOVE MODE (0=ADV, 1=BKP) MODSET ARCMOD / SET MOVE MODE AC0001 DCA GRAMUN / SET UNIT TO LINE TAD ARTMP / NOW GET MOVE MODE BACK AGAIN SNA CLA / DISPATCH TO PROPER ROUTINE JMP NXSCR1 / (NEXT SCREEN) JMS SCRNSZ / PREVIOUS SCREEN ROUTINE DCA CNSCRL / STORE SCROLL COUNT JMS BACKUN / TRY 1ST BACKUP JMP EIBAD / (CAN'T, GO BUZZ) PRVSC1, CLA CDFMYF TAD CNSCRL / DONE? SNA CLA JMP EINEXT / YES JMS BACKUN / NO, TRY BACKING UP AGAIN JMP EINEXT / (FAIL NOW IS OKAY) JMP PRVSC1 / LOOP TO TEST IF DONE NXSCR1, JMS SCRNSZ / NEXT SCREEN ROUTINE CIA / NEGATE THE SCROLL COUNT IAC / SET TO DO ONE LESS DCA CNSCRL JMS SETUNT / SET UNIT CODE JMS LODCHR / START US OFF JMP EIBAD / (CAN'T, GO BUZZ) NXSCR2, JMS GETUNT / CK FOR END OF LINE NXSCR3, .-. SZA CLA / DONE WITH LINE? JMP I NXSCR3 / NO, CONTINUE LOOKING CDFMYF TAD CNSCRL / DONE? SNA CLA JMP EINEXT / YES DCA SCRLFL / NO, ENSURE SCROLL FLAG 0 JMS LODCHR / AND GO ANOTHER LINE JMP EINEXT / (FAIL NOW IS OKAY) JMP NXSCR2 / LOOP TO GET END OF LINE ARCMOD, SCHMOD!SLTMOD ARTMP, .-. / / We got here because we entered into a tech dead thing and now we/A226 / want to get out /A226 / DEDKYX, CLA / /A226 TAD I CURPTR / get current char /A226 DEDBNX, TAD (-ECSTOV) / Are we at the start yet ? /A226 SNA CLA / /A226 JMP EIBAD / Yes ,Must have been a req space /A226 / so beep and get out /A226 BKPPTR / Not there yet so keep backing up /A226 NOP / /A226 JMP DEDBNX / Try previous one /A226 / / The compound Tech-Mcs dead has been split now back up to 2nd /A226 / 1st non-tech char in string /A226 / DEDBKP, BKPPTR / Backup /A226 NOP / Shouldn't happen /A226 SLNMOD / Set line modified /A226 AC0001 / /A226 JMP EIFIX1 / Go listen for more /A226 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / HANDLE "GOLD:DEAD" COMMAND (DEAD KEY = EDDEAD) XVDEAD, JMS LODCHR JMP EIBAD JMS CHKALP JMP DEDKYA / JUMP IF NOT ALPHA BKPPTR JMP EIBAD JMS CHKALP JMP DEDKYB / JUMP IF PREV NOT ALPHA AC7777 / SET CURSOR TO START OF DEAD- TAD CURSOR / KEY SEQUENCE. FROM HERE GETS DCA CURSOR / REFRESHED. SLNMOD / SAVE LINE POSN FOR REFRESH. TAD (ECSTOV) JMS INSRL1 / BOTH ALPHA, START OVERSTRIKE DEDKYE, ADVPTR JMP EIBAD / ADVANCE OVER BOTH ADVPTR NOP CLA TAD (ECNDOV) JMS INSRL1 / END OVERSTRIKE SLNMOD JMP EIFIX / JUMP TO LISTEN FOR MORE DEDKYA, TAD (-ECSTOV) / IS CURRENT OVERSTRIKE? SZA CLA JMP EIBAD / JUMP IF NOT ADVPTR / AND NOT A "REQUIRED SPACE"? JMP DEDKYC / (BUG) AND P177 / IGNORE ATTRIBUTES TAD (-ECSPC) SZA CLA /M172 JMP DEDKA1 /A172 /d226 BKPPTR / Restore pointer to beginning /A172 /d226 NOP / of dead key seq /A172 /d226 JMP EIBAD / NO-I MEAN YES IT'S A REQUIRED SPACE / SO USER CAN'T BREAK APART OVERSTRIKE / SEQUENCE BECAUSE, CONCEPTUALLY, IT'S JMP DEDKYH / Check if he wants to Undead a tech /A226 / NOT AN OVERSTRIKE DEDKA1, ADVPTR JMP DEDKYC / ADVANCE TO END TAD (-ECNDOV) SZA CLA JMP .-4 DCA I CURPTR / DELETE END MARKER DEDKYC, BKPPTR JMP EIBAD / BACK UP TO START TAD (-ECSTOV) SZA CLA JMP .-4 DCA I CURPTR / DELETE START SLNMOD AC0001 JMP EIFIX1 / ADVANCE CURSOR AND LISTEN / / PREVIOUS CHAR (NOW CURRENT CHAR) IS NOT PRINTABLE. / IF IT'S AN OVERSTRIKE SEQUENCE, THEN APPEND TO IT. / IF IT'S A REQUIRED SPACE OR ANYTHING ELSE, THEN USER ERROR (BEEP). / DEDKYB, TAD (-ECNDOV) / IS PREVIOUS CHAR AN OVERSTRIKE? SZA CLA JMP DEDKYG / NO: USER ERROR BKPPTR / YES: IS PREVIOUS CHAR A REQUIRED SPACE? JMP DEDKYG / (BUG - FIX CURSOR POS) AND P177 / (IGNORE ATTRIBUTES) TAD (-ECSPC) SZA CLA JMP DEDKYD / NO: APPEND TO OVERSTRIKE SEQUENCE ADVPTR / YES: USER ERROR - RESTORE CURPTR ... JMP EIBAD / (BUG) DEDKYG, ADVPTR / ... TO POSITION AT ENTRY TO XVDEAD ... JMP EIBAD / (BUG) JMP EIBAD / ... AND COMPLAIN / / AT ENTRY TO XVDEAD, THE CURSOR WAS ON A PRINTING CHARACTER, / AND A NON-REQUIRED-SPACE OVERSTRIKE SEQUENCE PRECEEDED THE CURSOR. / THUS, WE NEED TO APPEND THE PRINTING CHARACTER TO THE OVERSTRIKE / SEQUENCE. / (CURPTR IS NOW ON CHAR BEFORE ECNDOV) / DEDKYD, ADVPTR / ADVANCE CURPTR TO ECNDOV JMP EIBAD / (BUG) CLA / DELETE ECNDOV DCA I CURPTR / IN EDIT BUFFER AC0010 / Incase it is a technical re-display hash/A172 PUTOUT /A172 JMS PUTSPC /A172 EXGOVS /A172 JMP DEDKYE / GO INSERT ECNDOV AFTER PRINTING CHAR / / HANDLE "GOLD SPACE" (REQUIRED SPACE = EDRQSP) / / A "REQUIRED SPACE" IS A SPACE THAT WILL NOT BE USED AS A LINE BREAK / BY THE JUSTIFICATION ROUTINES (A NONBREAKING SPACE). / / "REQUIRED SPACE" IS IMPLEMENTED AS AN OVERSTRIKE SEQUENCE CONTAINING / TWO SPACES. THIS APPEARS IN THE EDIT BUFFER AS: / ECSTOV ECSPC ECSPC ECNDOV / (THE ECSPC CHARS MAY HAVE ATTRIBUTES SET.) / SUCH A SEQUENCE IS IMPOSSIBLE TO ENTER MANUALLY BECAUSE OVERSTRIKE / SEQUENCES MAY ONLY CONTAIN PRINTING CHARACTERS. / CONCEPTUALLY, SUCH SEQUENCES ARE HEREBY REDEFINED AS A "REQUIRED SPACE", / AND THUS MAY NOT BE MANIPULATED OR DISPLAYED AS OVERSTRIKE SEQUENCES. / / THIS ROUTINE INSERTS A "REQUIRED SPACE" INTO THE EDIT BUFFER. / XVRQSP, SLNMOD / TELL FXSCRL WE'RE MODIFYING EDIT BUFFER TAD (ECSTOV) / INSERT ECSTOV INTO EDIT BUFFER JMS INSRL1 TAD (ECSPC) / INSERT ECSPC JMS INSRL1 TAD (ECSPC) / INSERT ECSPC JMS INSRL1 TAD (ECNDOV) / INSERT ECNDOV JMS INSRL1 JMP EIFIX / DONE / / Test if user is trying to UNDEAD a tech-MCs-Linedrawing compose /A226 / seq which he has previously extended with extra chars /A226 / DEDKYH, ADVPTR / Look at char after space /A226 JMP EIBAD / Bug .. /A226 AND P177 / Strip off attributes /A226 TAD (-60) / Is it greater than 60 /A226 SPA SNA / ? /A226 JMP DEDKYX / No , back pointer up and get out /A226 TAD (60-64) / Is it less than or equal to 63 /A226 SMA SZA / /A226 JMP DEDKYX / No , Backup and get out /A226 CLA / /A226 ADVPTR / Move on to "real" char /A226 JMP EIBAD / Bug.. shouldn't happen /A226 ADVPTR / Now we should be on the End Dead /A226 JMP EIBAD / Bug.. shouldn't happen /A226 TAD (-ECNDOV) / Is it really the end of dead ? /A226 SNA CLA / /A226 JMP DEDKYX / Yes , backup and get out /A226 TAD (ECNDOV) / Put End of Dead here /A226 JMS INSRL1 / Now insert it /A226 DEDSNX, TAD (-ECNDOV) / Is it end of dead ? /A226 SNA CLA / /A226 JMP DEDKRB / Yes , go rubout End of dead /A226 ADVPTR / Try the next one /A226 JMP EIBAD / Bug.. shouldn't happen /A226 JMP DEDSNX / Try next /A226 DEDKRB, DCA I CURPTR / Rubout the end of dead /A226 JMP DEDBKP / Go back to 2nd char in dead seq /A226 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 / NEW OVERLAY NUMBER OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / MERGE TRAILER FOR LIST PROCESSING. / / THE CHARACTER "<" IN A FORM DOCUMENT TRAILER IS TREATED IN A SPECIAL WAY / DEPENDING ON WHAT FOLLOWS IT: / / - SUBSTITIUTE THE TEXT OF THE NAMED FIELD IN THE / CURRENT RECORD AT THIS POINT IN THE OUTPUT. IF A / MATCH FOR THIS FIELD IS NOT FOUND WITHIN THE CURRENT / MATH RESULT BUFFER THEN THIS FIELD IS OUTPUT JUST AS / IT APPEARS IN THE FORM DOCUMENT. / / - OUTPUT THIS FIELD AS IS. DO NOT TREAT THIS FIELD AS / THE START OF A REPETITIVE ZONE. / / - OUTPUT THIS FIELD AS IS. DO NOT TREAT THIS FIELD AS / THE END OF A REPETITIVE ZONE. / / - OUTPUT THIS FIELD AS IS. DO NOT TREAT THIS FIELD AS / A COMMAND TO COPY THE TEXT OF THE CURRENT RECORD FROM / THE LIST DOCUMENT TO THE OUTPUT. / / <> - OUTPUT THIS FIELD AS IS. DO NOT TREAT THIS FIELD AS / A COMMAND TO ADVANCE TO THE NEXT RECORD IN THE LIST / DOCUMENT. / / << - OUTPUT A SINGLE "<" AT THIS POINT. / / NO OTHER CHARACTERS IN THE FORM DOCUMENT ARE TREATED SPECIALLY. OVMRG5= .-OVLAY1+OVRNUM / FIFTH MERGE OVERLAY TMRGSA, CURMOV NOP TMRGSB, JMS LODCHR / LOOKING FOR START OF FIELD JMP TMRGDON / WE HIT END OF THE FORM DOCUMENT AND P177 / STRIP MODE BITS FROM CHARACTER TAD (-"<+200) / IS CHARACTER = "<"? SNA CLA / SKIP IF: NOT JMP TMRGS7 / START OF FIELD NAME - PROCESS IT TMRGSC, JMS TMRGADV / ADVANCE CURSOR BY ONE CHARACTER JMP TMRGSB / CONTINUE LOOKING FOR START OF FIELD TMRGS7, TAD CURPTR / GET POINTER TO LEFT ANGLE BRACKET DCA MRGPT2 / SAVE POINTER TO LEFT ANGLE BRACKET SLNMOD / SET LINE MODIFIED FLAG JMS JCLEAN / WE'RE GOING TO CHANGE SOMETHING ADVPTR / GET NEXT CHARACTER JMP TMRGDON / WE HIT END OF TEXT AND P177 / STRIP MODE BITS TAD (-"<+200) / IS CHARACTER ANOTHER "<"? SNA / SKIP IF: NOT JMP TMLLAB / GO PROCESS A "<<" SEQUENCE TAD ("<-">) / IS CHARACTER = ">"? SNA / SKIP IF: NOT JMP TMRGSA / NULL FIELD NAME - IGNORE TAD (">-"!) / IS CHARACTER = "!"? SNA CLA / SKIP IF: NOT JMP TMRGSA / SPECIAL NAME - IGNORE / MATCH TRAILER FIELD NAME IN FORM DOCUMENT TO FIELD NAME FROM MATH / RESULT BUFFER. CDFMYF / CHANGE DF TO MY FIELD JMS TMFNIF / MATCH FIELD NAME IN FORM DOCUMENT TO RESBUF / FIELD NAME IN MATH RESULT BUFFER CDFLP / RESBUF IS IN LIST PROCESS. FIELD JMP TMRGSC / NO MATCH FOUND JMP TMRGSA / MATCH - SCAN DOCUMENT FOR NEXT FN / MATCH FIELD NAME IN FORM DOCUMENT TO A FIELD NAME FROM RECORD. TMFNIF, XX / MATCH FIELD NAME IN FORM DOCUMENT TAD I TMFNIF / GET ADDRESS OF BUFFER TO MATCH DCA MRGPT1 / SAVE IT ISZ TMFNIF / BUMP RETURN TAD I TMFNIF / GET FIELD OF THAT BUFFER DCA TTADI1 / SAVE IT ISZ TMFNIF / BUMP RETURN TMRGS1, TAD MRGPT2 / POINT TO TEXT BRACKET IN FORM DCA CURPTR / RESET POINTER TMRGS2, JMS TTADIMRGPT1 / GET NEXT CHAR FROM RECORD ISZ MRGPT1 / BUMP RECORD PTR SNA / SKIP IF: NOT END OF RECORD JMP TMRGS8 / FIELD NOT FOUND, END OF RECORD TAD (-"<+200) / IS CHARACTER = "<"? SZA CLA / SKIP IF: SO JMP TMRGS2 / LOOP TIL FIELD START TMRGS3, ADVPTR / GET NEXT FIELD VALUE CHAR. FROM TEXT JMP TMRGDON / WE HIT THE END OF TEXT AND P177 / STRIP MODE BITS XLTUPR / XLAT CHAR TO UPPER CASE CIA / SET UP FOR COMPARE WITH RECORD'S DCA T1 / FIELD NAME VALUE JMS TTADIMRGPT1 / GET NEXT CHAR FROM RECORD XLTUPR / XLAT TO UPPER CASE TAD T1 / COMPARE WITH CHARACTER FROM TEXT SZA CLA / SKIP IF: CHARACTERS MATCH JMP TMRGS1 / LOOP IF NOT EQUAL JMS TTADIMRGPT1 / GET NEXT RECORD CHARACTER ISZ MRGPT1 / BUMP POINTER INTO RECORD TAD (-">+200) / IS CHARACTER = ">"? SZA CLA / SKIP IF:SO JMP TMRGS3 / CHECK FOR END OF NAME TAD MRGPT2 / RESET TEXT BUFFER POINTER TO START OF DCA CURPTR / FIELD NAME WE JUST MATCHED. JMS TMRGDLF / DELETE THAT FIELD NAME FROM TEXT TMRGS4, DCA MRGPT2 / SET LOOKAHEAD JMS TTADIMRGPT1 / CHECK FOR END OF FIELD IN RECORD TAD (-"<+200) / IS CHARACTER = "<"? SNA CLA / SKIP IF: NOT JMP TMRGS5 / JUMP IF END OF FIELD VALUE TAD MRGPT2 / GET LOOK AHEAD CHARACTER SZA / SKIP IF: 0 INSCHR / OUTPUT LOOKAHEAD JMS TTADIMRGPT1 / LOAD NEW LOOKAHEAD CLA SWP / ATTRIBUTED CHAR COMES BACK IN THE MQ / SO RESTORE IT TO THE AC ISZ MRGPT1 / BUMP POINTER INTO FIELD VALUE JMP TMRGS4 / LOOP TO OUTPUT NEXT FIELD VALUE CHAR. / INTO RESULT DOCUMENT TMRGS5, TAD MRGPT2 / OUTPUT LAST CHAR AT END OF FIELD TAD (-40) / WAS THIS A SPECIAL CHAR.? SPA SNA CLA / SKIP IF: NOT JMP TMRGS6 / SPECIAL CHARACTER. DO NOT INSERT TAD MRGPT2 / REGULAR CHARACTER. INSERT INTO TEXT INSCHR TMRGS6, ISZ TMFNIF / BUMP RETURN FOR MATCH TMRGS8, JMP I TMFNIF / RETURN / THIS ROUTINE WILL READ A CHARACTER FROM THE BUFFER SPECIFIED WHEN / MFNIFD WAS CALLED. TADIM1 IS PRIMED UPON CALL TO MFNIFD. UPON / READING A CHARACTER THE DF IS ALWAYS RETURNED TO THE EDITOR BUFFER / FIELD SINCE OTHER ROUTINES CALLED DURING OVMRG2 DEPEND ON DF SET / TO THE EDITOR BUFFER FIELD. / THE MQ IS USED TO SAVE THE CHARACTER WITH IT'S ATTRIBUTES SO THAT / ANY ATTRIBUTES IT HAS WILL BE CARRIED OVER FROM THE LIST DOCUMENT / TO THE RESULT DOCUMENT TTADIMRGPT1, XX TTADI1,.-. / LOADED WITH CDF INSTRUCTION TAD I MRGPT1 / READ CHARACTER FROM RECORD MQL / SAVE THE ATTRIBUTED CHAR IN THE MQ MQA / RESTORE CHAR TO THE AC AND P177 / STRIP MODE BITS CDFBUF / SET DF TO EDITOR BUFFER FIELD JMP I TTADIMRGPT1 / RETURN / ADVANCE CURSOR ONE CHARACTER AT A TIME THROUGH RESULT DOCUMENT, / CHECKING FOR ENOUGH ROOM ON DISKETTE TO CONTINUE THROUGH THE DOC. TMRGADV,XX AC0001 / ADVANCE CURSOR 1 CHARACTER CURMOV JMP TMRGDON / EOF RETURN FROM CURMOV JMS CHKSPC / CHECK DISKETTE SPACE JMP I TMRGADV / RETURN / MULTIPLE LEFT ANGLE BRACKET SEQUENCE HANDLER ("<<...ETC.") - DELETE A / LEFT ANGLE BRACKET FROM THIS FIELD NAME . WHEN THE FIRST CHARACTER / THAT IS NOT A "<" IS READ REENTER SCAN LOOP. TMLLAB, / TRAILER_MULTIPLE_LEFT_ANGLE_BRACKET_PROCESSOR DCA I CURPTR / DELETE A LEFT ANGLE BRACKET TAD MRGPT2 / RESTORE POINTER TO START OF FIELD DCA CURPTR SLNMOD / SET LINE MODIFIED FLAG TMLLA1, JMS TMRGADV / ADVANCE CURSOR ONE CHARACTER JMS LODCHR / GET THE NEXT CHARACTER JMP TMRGDON / EOF RETURN AND P177 / STRIP MODE BITS TAD (-"<+200) / IS CHARACTER = "<"? SNA CLA / SKIP IF: NOT JMP TMLLA1 / CHARACTER = "<". GET NEXT ONE JMP TMRGSB / REENTER SCAN LOOP X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / DELETE A CHARACTER IN THE RESULT DOCUMENT TMRGDEL,XX / DELETE CHAR SUBROUTINE JMS LODCHR / READ A CHARACTER JMP I TMRGDEL / NONE LEFT - EXIT ISZ TMRGDEL / BUMP TO OK RETURN AND P177 / STRIP MODE BITS MQL / HOLD CHARACTER IN MQ DCA I CURPTR / DELETE CHARACTER FROM TEXT MQA / RESTORE CHAR TO AC JMP I TMRGDEL / AND RETURN / DELETE A FIELD TMRGDLF,XX / DELETE FIELD SUBROUTINE JMS TMRGDEL / DELETE ONE CHARACTER OF THE FIELD JMP I TMRGDLF / QUIT IF NO MORE TAD (-">+200) / WAS CHARACTER JUST DELETED A ">"? SZA CLA / SKIP IF: SO JMP .-4 / DELETE TIL END SLNMOD / SET LINE MODIFIED JMP I TMRGDLF / THEN RETURN TMRGDON,OVLJMP / DO EXIT OVERLAY OVMRG3 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVRPP4= .-OVLAY1+OVRNUM JMP RPERR / SECONDARY ENTRY POINT AFTER / REPORTING INPUT STRING ERROR /**************************************************************** / START OF THE NEW V2 FAST FORWARD AND REVERSE (GOTO PAGE) /**************************************************************** OVRPPG= .-OVLAY1+OVRNUM / BEGINNING OF V2.0 GO-TO-PAGE RPCMMA= ",-200 / ASCII COMMA RPPLUS= "+-200 / ASCII PLUS SIGN RPMINU= "--200 / ASCII MINUS SIGN RPPRCT= "%-200 / ASCII PERCENT SIGN /D206 TMP= EIGES4+1 / BUFFER CONTIANING ASCZI CHARS. / ----------------------------------------------------------------------------- / SHARING MAIN MEMORY LOCATIONS TO CONSERVE SPACE HERE PLUS / PERMITTING ACCESS TO THESE VALUES FROM ANY V2.0 GO-TO-PAGE / OVERLAY... RPWORD= SRCDIR / FLAG WORD FOR POSITIONING INFO. / (STORED IN MAIN EDITOR MEMORY PAGE 0) ABSOL= 4000 / BIT0 ON = ABSOLUTE PAGE/BLK # / OFF = OFFSET PAGE/BLK # REVERS= 2000 / BIT1 ON = REVERSE (-) DIRECTION / OFF = FORWARD (+) DIRECTION PGMODE= 1000 / BIT2 ON = POSITION TO A PAGE / OFF = POSITION TO A BLOCK / ----------------------------------------------------------------------------- / RPINIT - Rapid Positioning INITialization / Here whenever the response to the "ENTER PHRASE:" / message was terminated via the PAGE key. / Begin the V2.0 repositioning procedure to a user / defined page or block. / RPINIT PSEUDO CODE: /begin / if the reply to the "ENTER PHRASE:" message was the / PAGE key preceeded by data, error exit back / to request the search string again / else, continue by displaying the "ENTER PAGE NUMBER:" / message and inputting the user response / / if the reply to the "ENTER PAGE NUMBER:" message was / solely the RETURN key, abort process by returning / to the Editor keyboard loop routine / else, / if the 1st char. supplied in response to the / "ENTER PAGE NUMBER:" message was the - / sign, set BIT1 on in RPWORD / else / leave BIT1 reset / set Range Factor (T1) to -1 to account for / special character in input buffer and / set buffer offset (T2) to 1 to skip first / input buffer char. / else, clear Range Factor (T1) and / start buffer offset (T2) / set BIT0 in RPWORD / / / / WITH THE PAGE KEY IN RESPONSE / TO THE "ENTER PHRASE:" MSG. TAD GETLEN / # OF CHARS (from French bug fix 112 SZA CLA / SKIP IF VALID USER RESPONSE JMP EIFIND / EXIT:USER SUPPLIED CHARS. WITH / THE PAGE KEY. ASK FOR PHRASE AGAIN. / REPEAT THE SEARCH PROCESS; NOTE / THAT THE AC MUST BE ZERO RPERR, JMS PROMPT / CLEAR SCROLL LINE THEN ASK FOR PAGE NUMBER EIRPG1 / POINTER TO "ENTER PAGE NUMBER:" JMS GETLIN / GET PAGE INFO. FROM USER EIRPG2 / POINTER TO NEG. INPUT RANGE VALUE; / OUR INPUT BUFFER ALSO STARTS IN THAT / WORD IMMEDIATELY FOLLOWING EIRPG2 / NOW SEE IF THE USER HAS DECIDED AGAINST CONTINUING THIS / POSITIONING REQUEST BY LOOKING FOR THE 'RETURN' KEY AS THE / ONLY RESPONSE TO THE "ENTER PAGE NUMBER:" MSG... TAD GETLEN / # OF CHARS. IN THE INPUT BUFFER SNA CLA / SKIP IF OTHER THAN 'RETURN' JMP EINEXT / ABORT POSITIONING REQ. / USER INPUT IS IN BUFFER AT EIRPG2+1. STRIP ALLOWABLE SPECIAL / CHARS. (+,-,%) BEFORE CONVERTING ASCII NUMERICS INTO THEIR / CUMULATIVE BINARY VALUE... DCA RPWORD / CLEAR POSITIONING FLAGS' WORD DCA T1 / INIT. 'RANGE' FACTOR DCA T2 / AND INPUT BUFFER CHAR. OFFSET TAD I (EIRPG2+1) / GET THE 1ST INPUT CHAR. TAD (-RPPLUS) / COMPARE TO + SIGN SNA / SKIP IF NOT + JMP SETSPC / LEAVE BIT 1 OFF TAD (RPPLUS-RPMINU) / COMPARE TO - SIGN SNA CLA / SKIP IF NOT + OR - JMP SETNEG / GO SET REVERSE DIRECTION FLAG TAD (ABSOL) / BIT0 ON (ABSOLUTE #, NOT OFFSET) DCA RPWORD / SET BIT0 ON IN POSITION WORD JMP PAGBLK / NOW SEE IF PAGE OR BLOCK POSITIONING SETNEG, TAD (REVERS) / BIT1 ON = REVERSE DIRECTION DCA RPWORD / OFF = FORWARD DIRECTION SETSPC, AC7777 / TAKE 1 AWAY FROM RANGE VALUE LATER DCA T1 / TO ACCOUNT FOR THE SPECIAL DIRECTION SIGN ISZ T2 / T2 => OFFSET OF 1 BEYOND 1ST CHAR. / THE ONLY OTHER ALLOWABLE SPECIAL CHAR. IS THE % SIGN (AS THE / LAST INPUT CHAR. ONLY). IF PRESENT, POSITION TO A BLOCK, ELSE / POSITION TO A PAGE PAGBLK, TAD GETLEN / # OF ACTUAL CHARS. IN BUFFER TAD (EIRPG2) / PLUS THE ADDR. OF INPUT BUFFER-1 DCA T3 / T3 => PTR. TO LAST CHAR. IN EIRPG2 TAD I T3 / GET THE LAST CHAR. FROM THE INPUT BUFFER TAD (-60) / COMPARE TO ASCII 0 SPA / SKIP IF = OR > 0 JMP RPERCH / EXIT: INVALID CHAR. TAD (-11) / COMPARE REMAINDER TO 9 SMA SZA CLA / SKIP IF CHAR. 0-9 JMP RPERCH / EXIT:INVALID CHAR. TAD (PGMODE) / BIT2 ON FOR PAGE MODE TAD RPWORD / INCLUDE IN POSITION FLAGS' WORD DCA RPWORD / UPDATE MEMORY TAD T2 / AC=> OFFSET BEYOND +/- IF PRESENT TAD (EIRPG2) / + ADDR. OF 1ST INPUT CHAR.-1 DCA X0 / INIT. AUTO-INDEX REG. TO POINT AT / FIRST NUMERIC CHAR. TAD T1 / -1 FOR +/- AND -1 FOR % TAD GETLEN / GET # OF INPUT CHARS. TAD (-3) / SEE IF MORE THAN 3 NORMAL CHARS. SMA SZA / SKIP WITH 1-3 CHARS. ONLY JMP DOTHOU / > 3 = THOUSANDS AND HUNDREDS TAD (3) / GET ORIG. RANGE VALUE CIA / MAKE INTO NEG. CHAR. CTR. DCA T3 / T3 => # OF HUNDREDS CHARS TO MOVE JMP DOHUNS / CLEAR THOUS. COUNT AND DO HUNDR. DOTHOU, CLA / AC => 0 TAD I X0 / GET THE THOUS. DIGIT DCA EIRPG3 / SUPPLY IT FOR CONVERSION /A206 DCA EIRPG3+1 / ASCIZ TERMINATOR... /A206 /D206 DCA TMP / SUPPLY IT FOR CONVERSION /D206 DCA TMP+1 / ASCIZ TERMINATOR... / If current string char. is a comma bump string pointer (X0) / beyond it to point at hundreds and account for the / presence of a special char. in string range (-1) / else string pointer (X0) is at hundreds and don't have to / account for the presence of a special char. / if total # of input chars. (GETLEN) less the presence of any / special chars. (T1&AC) is greater than 4 / then exit to report 'RANGE' error / else convert ASCII chars. (EIRPG2) to binary TAD X0 / POINTS AT CURRENT CHAR. DCA T2 / MAKE A COPY, LEAVING X0 ALONE ISZ T2 / PERFORM AUTO-INDEX TO... TAD I T2 / GET THE CHAR. AFTER THE THOU. TAD (-RPCMMA) / IS IT A COMMA? SZA CLA / SKIP TO ACCOUNT FOR COMMA JMP CKRANG / PROCESS AS IS... ISZ X0 / BUMP PTR. TO HUNDREDS CHAR. AC7777 / AC => -1 TO ACCOUNT FOR COMMA / VALIDATE THE # OF DIGITS IN STRING CKRANG, TAD GETLEN / GETLIN SUPPLIED # OF INPUT CHARS. TAD T1 / MINUS 1 FOR +/- AND -1 FOR % TAD (-4) / - MAX. # OF NUMERICS ALLOWED (9999) SMA SZA CLA / SKIP WITH VALID RANGE JMP RPERRG / ERROR:INVALID # OF NUMERICS SUPPLIED / BY THE USER AC7775 / AC => -3 DCA T3 / T3 => MOVE 3 CHARS. AFTER THOUS. MOVED JMP TOMNU / PAGE JUMP... RPERRG, OVLJMP;RPPER3 / ERROR:MORE THAN 4 NUMERICS SUPPLIED RPERCH, CLA OVLJMP;RPPER5 / ERROR:CHAR. WASN'T A VALID NUMERIC / OR ONE OF THE ALLOWABLE SPECIAL / CHARS. (+,-,% OR ,) EIRPP2, HLT / CODE NOT USED ? CLA / AC MUST BE 0 TO INFORM OVEXIT THAT / THIS IS NOT THE FINAL END OF THIS EDIT /? JMP RPTOP / GO CLOSE DOC. / THEN RE-OPEN IT, THEREBY SUPPLYING / THE MAIN HDR. BLOCK AND ITS NEW / PARELLEL RAPID PAGE DATA STRUCTURE / IN THEIR RESPECTIVE SCROLL BUFFERS EIRPG2, -6 / 6 CHAR. MAX. INPUT RANGE (+9,999) ZBLOCK 6 / START OF 6 CHAR. INPUT BUFFER EIRPG3, ZBLOCK 6 / START OF 6 CHAR. WORK BUFFER /A206 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE TOMNU, CIFMNU / CHANGE FOR MENU FLD JMS I CVDCAL / ASCIZ TO BINARY VIA CVDBN EIRPG3 / GET ASCIZ CHARS. HERE /A206 /D206 TMP / GET ASCIZ CHARS. HERE JMP RPERCH / CHAR. WASN'T 0-9 DOHUNS, DCA RPBIN2 / UPDATE BINARY # OF THOUSANDS TAD (EIRPG3-1) /A206 /D206 TAD (TMP-1) DCA X1 / X1 => MOVE TO THIS BUFFER TAD I X0 / GET INPUT CHAR. DCA I X1 / MOVE INTO TEMP. BUFFER ISZ T3 / T3 => # OF CHARS. TO MOVE JMP .-3 / LOOP IF MORE TO MOVE DCA I X1 / SUPPLY ASCIZ DELIMTER CIFMNU / CHANGE TO MENU FLD JMS I CVDCAL / ASCIZ TO BINARY VIA CVDBN EIRPG3 / GET ASCIZ CHARS. HERE /A206 /D206 TMP / GET ASCIZ CHARS. HERE JMP RPERCH / CHAR. WASN'T 0-9 DCA RPBIN1 / UPDATE BINARY # OF HUNDREDS / initialize GOTO PAGE pointers TAD (55) DCA RPCUOF / OFFSET TO 1ST DESCRIPTOR WORD IN 1ST RPPGDS BLOCK ONLY TAD (55) DCA RPMTRL / OFFSET TO DEFAULT RULER BLOCK DCA RPMTBK / NO MATH BLOCK OFFSET DCA RPPG0 / 0 = NOT OVER --TOP-- AC0001 DCA RPCUBK / START WITH 1ST RPPGDS BLOCK AC0001 DCA RPRLHN / DEFAULT RULER BLOCK IS IN 1ST RPPGDS BLOCK / RaPid POSItioning / HERE TO BEGIN THE ACTUAL REPOSITIONING TO THAT PAGE OR BLOCK / SPECIFIED BY USER INPUT. / RPPOSI PSEUDO CODE: / if RPWORD = "absolute" positioning go test block or page / else if RPWORD = "forward" direction leave RPBIN1 and RPBIN2 / as is / else convert the positive binary page value in RPBIN1 / and RPBIN2 into negative values (-) / DETERMINE WHAT THE PAGE NUMBER VALUE SUPPLIED BY THE USER WAS. / IF IT WAS AN ABOSULTE NUMBER, THEN RPBIN1 AND RPBIN2 CAN / REMAIN AS IS; OTHERWISE, THE OFFSET VALUE STORED WITHIN / RPBIN1 AND RPBIN2 MUST BE CONVERTED TO AN ABSOLUTE BLOCK / NUMBER OR PAGE NUMBER. HOWEVER, THE DISTINCTION BETWEEN PAGE / AND BLOCK POSITIONING MUST BE MADE PRIOR TO THIS CONVERSION, / SO THAT BLOCK CALCULATION DOES NOT USE CURPG1 AN CURPG2 / START THE ACTUAL REPOSITIONING... TAD RPWORD / GET POSITIONING FLAGS AND (REVERS) / TEST REVERSE (-) OFFSET FLAG SNA CLA / SKIP TO COMPLEMENT OFFSET JMP CKMODE / NOT - SO CHECK MODE TYPE TAD RPBIN2 / GET # OF THOUSANDS SUPPLIED CIA / MAKE NEGITIVE TO BACKUP DCA RPBIN2 / SAVE -THOUSANDS # TAD RPBIN1 / GET # OF HUNDREDS SUPPLIED CIA / MAKE NEGITIVE TO BACKUP DCA RPBIN1 / SAVE -HUNDREDS # / DETERMINE IF REPOSITIONING TO A PAGE OR BLOCK TO CONTINUE / OFFSET CONVERSION, IF NECESSARY... / If RPWORD = "offset" calculate absolute page # / if RPWORD = positive offset set CURPTR direction / offset (T1) to +1 / else set CURPTR direction offset (T1) to -1 / else set CURPTR direction offset (T1) to +1 CKMODE, TAD RPWORD / POSITION FLAGS SPA CLA / SKIP TO PROCESS OFFSET JMP FORDIR / JMP TO SET CURPTR OFFSET +1 AC7777 / GOTO PAGE "REQ" FLAG CDILP / DF & IF TO FIELD 5 JMS RPPMENU / GET CURRENT EDIT BUFFER PAGE VALUE / INTO CURPG1 & CURPG2 TAD CURPG2 / CURRENT THOUS. PAGE # TAD RPBIN2 / + OFFSET = DESIRED THOUSANDS # DCA RPBIN2 / ABSOLUTE THOUSANDS PAGE # TAD CURPG1 / CURRENT HUNDREDS PAGE # TAD RPBIN1 / + OFFSET = DESIRED HUNDREDS # DCA RPBIN1 / ABSOLUTE HUNDREDS PAGE # FORDIR, DCA RPBOTF / RPBOTF = 0 => DOING V2 GOTO PAGE, NOT V2 GOLD BOTTOM AC7777 TAD RPBIN1 / FORCE TO TOP OF DESIRED PAGE SMA / SKIP IF TOP-OF-PAGE NOT AVAILABLE JMP FORDR / TOP-OF-PAGE AVAILABLE DCA RPPG0 / RESULT INTO --TOP-- FLAG TAD RPBIN2 / CHECK FOR THOUSANDS SNA / SKIP IF THOUSANDS JMP FORDR / NO THOUSANDS TAD (-1) / DECREMENT BY ONE DCA RPBIN2 / AND SAVE AS NEW THOUSANDS COUNT TAD (1747) / PAGE 1000 OR 2000 OR 3000 WAS DESIRED / SO SET RPBIN1 TO 999 AND DECREMENT / RPBIN2 BY ONE TAD RPBIN1 / ADDED TO CURRENT HUNDREDS FORDR, DCA RPBIN1 / RPBIN1 = DESIRED PAGE NUMBER AC4000 / MINUS FLAG FOR GOTO PAGE INIT. TAD RPBIN1 / USE AVAIL. MEMORY WORD DCA RPBIN1 / DON'T DISPLAY FILE INFO. AT OPEN TIME... DCA CURPG1 / CLEAR PAGE MARK COUNTER TAD RPPG0 / GET --TOP-- FLAG SNA / SKIP IF AT --TOP-- OF DOC JMP OVL2 / JUMP IF NOT APPLICABLE TAD (1) / FOR INCR. OF --TOP-- FLAG SZA CLA / SKIP IF REALLY AT --TOP-- JMP OVL2 / JUMP IF BEYOND --TOP-- TAD RPWORD / WHAT TYPE OF POSITION REQ.? AND (2000) / WAS IT RELATIVE POSITIONING? SZA CLA / SKIP IF ERROR W/ ABSOLUTE PAGE0 DCA RPPG0 / CLEAR --TOP--FLAG / RPPG0 = + IF OK / RPPG0 = - IF ERROR OVL2, OVLJMP; OVPAGE / show "REPOSITIONING TO..." message... / tell the user to standby while the doc. is closed (updating / descriptor words) and then re-opened (supplies the doc. header / block and the RPPGDS block in their repective buffers) X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / GOLD:SEARCH GOLD:RULER COMMAND (GOTO-RULER) OVGSGR= .-OVLAY1+OVRNUM / PROMPT FOR "ADVANCE" OR "BACKUP" JMS PROMPT / CLEAR SCROLL LINE THEN DISPLAY PROMPT EIRRAB / PTR TO "Press ADVANCE or BACK UP" / WAIT UNTIL USER TYPES "ADVANCE" OR "BACKUP", / AND SET RRDIR ACCORDINGLY RRPRLP, GETINP / GET KEYBOARD CHAR ZZCASE / DISPATCH ADVANCE,BACKUP RRDISP-1 JMS BEEPER / NEITHER ADVANCE NOR BACKUP - ERROR JMP RRPRLP / TRY AGAIN / USER TYPED "ADVANCE" KEY RRPRAD, AC0001 / SET RRDIR:=1 TO INDICATE ADVANCE SKP / USER TYPED "BACKUP" KEY RRPRBK, AC7777 / SET RRDIR:=-1 TO INDICATE BACKUP DCA RRDIR JMS FXSCRL / GET RID OF PROMPT / (REPLACE PROMPT LINE WITH DOCMT TEXT) / START GOTO-RULER PROCESSING OVRRGO= .-OVLAY1+OVRNUM JMP XVRRGO / DISPATCH TABLE FOR GOLD:SEARCH GOLD:RULER PROMPT RRDISP, EDADVN; RRPRAD / ADVANCE EDGADV; RRPRAD / GOLD:ADVANCE EDBKUP; RRPRBK / BACKUP EDGBKP; RRPRBK / GOLD:BACKUP EDNWLN; RRABOR / RETURN (ABORT GOTO-RULER) 0 / SUBR RRGETN -- MOVE CURSOR IN TEXT BUFFER, /M157 / EXHAUSTING ETX (STX) BUFFER, / BUT STOP WHEN DISK ACTIVITY OCCURS. / AC DETERMINES DIRECTION / RROROF MUST BE SET UP WITH OFFSET OF ORIGINAL ETX (STX) BLOCK. / / CALL: / / DF = DOESN'T MATTER / TAD RRDIR / AC=DIRECTION TO MOVE: +=>FORWARD, -=>BACKWARD / JMS RRGETN / GET NEXT (OR LAST) CHARACTER / JMP ETXSTX / REACHED ETX (OR STX), AC=0 / JMP ETBSTB / NO MORE CHARS AVAILABLE WITHOUT DISK INPUT / / (ACTUALLY, THE NEXT DOCUMENT BLOCK HAS BEEN / / READ INTO THE ETX (OR STX) BUFFER, / / BUT LITTLE OF ITS DATA HAS BEEN USED YET/M157 / ... / MOVED CURSOR 1 POSITION. /M157 / / MAY HAVE MOVED CHAR FROM ETX (OR STX) / / BUFFER TO TEXT BUFFER, / / BUT DID NO DISK I/O. / / ON ALL RETURNS, DF = CDFMYF, AC=0 /M157 / RRGETN, XX CDFMYF / MAKE SURE WERE LOOKING AT OUR FIELD /A199 TAD RRDIR / AC=DIRECTION OF NEXT CHAR /A199 SMA / MOVE FORWARD OR BACKWARD? JMP RRGEFW / FORWARD / MOVING BACKWARD CURMOV JMP RRGEX1 / REACHED STX: TAKE 1ST RETURN JMS RRGTTP / GET CURRENT SCTOP,SCTPH INTO AC,MQ / CHECK WHETHER ANOTHER DOCUMENT BLOCK WAS READ INTO / THE ETX (OR STX) BUFFER. / ASSUME AC = OFFSET OF CURRENT ETX (STX) BLOCK. RRGETS, CIA / DID ANY DISK INPUT OCCUR? CDFMYF TAD RROROF / (COMPARE OFFSETS INTO HDR BLK) SNA CLA / (SKIP IF THERE WAS DISK INPUT) ISZ RRGETN / NO: TAKE 3RD (NORMAL) RETURN RRGEX2, ISZ RRGETN RRGEX1, JMP I RRGETN / MOVING FORWARD RRGEFW, CURMOV JMP RRGEX1 / REACHED ETX: TAKE 1ST RETURN TAD (-5) / AC=FUNCT # TO READ SCBOT,SCBTH JMS DSKCAL / GET AC=CURRENT SCBOT XRPRD / (&MQ=CURRENT SCBTH, NOT NEEDED) JMP RRGETS / GO CHECK FOR DISK I/O / SUBR RRGTTP -- Rapid Ruler GeT ToP ptrs sctop,sctph / / RETURNS WPFILS VARIABLES SCTOP,SCTPH IN AC,MQ. / / CALL: / / AC = DOESN'T MATTER / / DF = DOESN'T MATTER / JMS RRGTTP / GET SCTOP,SCTPH IN AC,MQ / / AC = SCTOP FROM WPFILS / / MQ = SCTPH FROM WPFILS / / DF = CDFMYF / / TEMPS USED: / CURID,CURTOP(=CURID+1) / / DUE TO THE CLUMSINESS OF THE AVAILABLE WPFILS CALLS, / A RATHER ROUNDABOUT APPROACH MUST BE USED TO GET / THE TOP POINTERS. RRGTTP, XX AC7777 TAD (CURID) / MQ=PTR TO LOCS TO RETURN CURRENT SCTOP,SCTPH MQL / (CURID IS USED AS A TEMP) AC7775 / WPFILS-GET ORIG & CUR SCTOP,SCTPH JMS DSKCAL XRPRD / (MISC GOTO-PAGE FUNCTIONS) CLA / FORGET "ORIGINAL" SCTOP CDFLP TAD I (CURID) / GET CURRENT SCTPH FROM WPFILS MQL / RETURN SCTPH IN MQ TAD I (CURTOP) / RETURN CURRENT SCTOP FROM WPFILS IN AC CDFMYF JMP I RRGTTP / EXIT / SUBR RRRFSP -- Rapid Ruler Restore File System Pointers / / (CREATED TO SAVE A LITTLE SPACE ON CALLING PAGE) RRRFSP, XX TAD (-4) JMS DSKCAL XRPRD JMP I RRRFSP / SUBR RRSVBK -- / PREPARE TO USE RANDOM-ACCESS TO JUMP TO RULER, / USING BLOCK POINTERS (SCTOP,SCTPH). / (CREATED TO SAVE SPACE ON CALLING PAGE.) / RPCUOF := EXTRA OVERSHOOT CORRECTION IF NO RULER FOUND; /A157 RRSVBK, XX CDFMYF /A157 CIA / REVERSE DIRECTION TO CANCEL OVERSHOOT /A157 DCA RPCUOF / SAVE 'HIT ETX OR STX' FLAG /A157 / (SCTOP,SCTPH HAVE OVERSHOT RULER BY AT LEAST ONE BLOCK - / CORRECT OVERSHOOT) / IF ADVANCING TO RULER, THEN / DECREMENT SCTOP,SCTPH BY 1 BLOCK; / IF BACKING UP TO RULER, THEN / (LATER ON WE WILL WANT TO OPEN BLOCK *AFTER* THE / BLOCK THAT CONTAINS THE RULER, THEN BACKUP TO RULER, / SO ADVANCE AN EXTRA BLOCK) / INCREMENT SCTOP,SCTPH BY 2 BLOCKS; / INCREMENT SCTOP,SCTPH BY RPCUOF; /A157 TAD RRDIR / ADVANCING OR BACKING UP TO RULER? SMA CLA AC7775 / ADVANCING: DECREMENT 1 BLOCK TAD (2) / BACKING UP: INCREMENT 2 BLOCKS TAD RPCUOF / CORRECT EXTRA OVERSHOOT IF REACHED /A157 / ETX OR STX /A157 MQL / MQ = BLOCK INCREMENT TO CORRECT OVERSHOOT TAD (-6) / READ DESC WORD, INC SCTOP,SCTPH BY MQ JMS DSKCAL XRPRD / CONVERT SCTOP,SCTPH TO A PHYSICAL BLOCK #. /A157 JMS RRGTTP / GET SCTTOP IN AC /A157 TAD (HDRBUF+2) / + ADDR OF DOCMT HEADER BUFFER /A157 / + SKIP OVER COS COMPATABILY WORDS /A157 DCA T1 / SAVE PTR TO CORRESPONDING PHYS BLK # /A157 CDFBUF / FIELD OF DOCUMENT HEADER BUFFER /A157 TAD I T1 / GET PHYSICAL BLOCK # /A157 / SAVE PHYSICAL BLOCK # OF BLOCK WITH RULER /A157 / (OR OF LAST BLOCK DEFINED IN GOTO-PAGE STRUCTURE) INTO RPCUBK, /A157 / TO BE USED MUCH LATER AFTER DOCUMENT HAS BEEN CLOSED (FILED OUT) /A157 / AND THE REOPENED. /A157 / NOTE: THE PHYSICAL BLOCK # IS SAVED BECAUSE SCTOP,SCTPH ARE /A157 / RELATIVE BLOCK #S. THE ACTUAL BLOCK REFERED TO BY SCTOP,SCTPH /A157 / MAY BE PUSHED DOWN OR UP WHEN THE DOCUMENT IS FILED, /A157 / RENDERING SCTOP,SCTPH INVALID, BUT THE PHYSICAL BLOCK # /A157 / WILL NOT CHANGE. /A157 CDFMYF /A157 DCA RPCUBK /A157 JMS RRRFSP / RESTORE FILE SYSTEM POINTERS JMP I RRSVBK / EXIT / CHECK BUFFER FOR ACTUAL RULER CODE. THE ABOVE CODE FOR RULER CHECK /A199 / FAILS WHEN THE BUFFER IS FULL AND ESPECIALLY WHEN CURMOVING BACKWARD /A199 RRSAVE= RRRFSP / DEFINE TEMPORARY STORAGE LOCATION /A199 RRCBUF, XX / CHECK BUFFER FOR RULER CODE /A199 TAD CURPTR / GET THE CURRENT CURSOR POSITION /A199 DCA RRSAVE / SAVE FOR LATER RESTORE /A199 RRCHK1, CDFMYF / SWITCH BACK TO THIS FIELD /A199 TAD RRDIR / GET THE DIRECTION VALUE /A199 CHKPTR / MOVE AND CHECK THE POINTER /A199 SNA / CHECK FOR A NULL CHARACTER /A199 JMP RRCHK1 / YES, IGNORE THE NULL /A199 SPA / CHECK FOR A END OF BUFFER INDICATOR /A199 JMP RRCHK2 / YES, GO HANDLE END OF BUFFER /A199 TAD (-ECNDRL) / CHECK FOR A END OF RULER CODE /A199 SZA / SKIP IF SO /A199 IAC / CHECK FOR A START OF RULER CODE /A199 SZA CLA / SKIP IF SO /A199 JMP RRCHK1 / NO MATCH, GO CHECK NEXT CHARACTER /A199 ISZ RRCBUF / BUMP RETURN ADDRESS FOR FOUND RULER /A199 RRCHK2, CLA / CLEAN UP FROM END OF BUFFER CHECK /A199 TAD RRSAVE / PICK UP ORIGINAL CURSOR POSITION /A199 DCA CURPTR / RESTORE CURSOR POINTER /A199 JMP I RRCBUF /RETURN TO CALLER /A199 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /******************************************************************* / / START GOTO-RULER PROCESSING / / / COME HERE TO GOTO THE NEXT (OR PREVIOUS) RULER. / / 'RRDIR' MUST BE SET TO INDICATE DIRECTION: / RRDIR=+1 => ADVANCE TO NEXT RULER; / RRDIR=-1 => BACKUP TO PREVIOUS RULER. / /******************************************************************* / / / / IF WE ARE ADVANCING TO NEXT RULER THEN / IF RULER MODIFIED FLAG IS SET THEN / SCROLL FORWARD TO RULER; / DONE. / ELSE (RULER MODIFIED FLAG IS NOT SET) / (PREPARE TO SCAN FORWARD THROUGH TEXT & STX BUFFERS) / GET CURRENT VALUE OF SCBOT FOR RRGETN; / XVRRGO, DCA ECHFLG / DON'T DISPLAY CURMOV'S CDFMYF / MAKE SURE WE ARE IN THIS FIELD TAD RRDIR / ARE WE ADVANCING? SPA CLA JMP RRBK / NO: MUST BE BACKING UP TAD RLRMOD / YES: IS THE RULER MODIFIED FLAG SET? SZA CLA JMP RRSC / YES AND YES: GO SCROLL TO RULER TAD (-5) / NO: GET SCBOT IN AC FOR RRGETN JMS DSKCAL XRPRD JMP RRSNEB / GO SCAN TEXT&ETX(STX) BUFFERS FOR RULER / / IF MOVING BACKWARDS, THEN / (WE MAY BE AT A RULER NOW. WE DON'T WANT TO FIND THIS / CURRENT RULER AS THE PREVIOUS RULER, SO WE MOVE THE CURSOR / BACK 1 CHAR. THE BACKUP IS HARMLESS IF THERE WAS NO / RULER PRESENT.) / MOVE CURSOR TO START OF LINE; / BACKUP CURSOR 1 CHAR; (TO SKIP OVER CURRENT RULER IF ANY) / GET SCTOP FOR RRGETN. / / THE CONVENTION IS THAT CURSOR IS "AT" A RULER IF CURSOR / IS ANYWHERE ON LINE FOLLOWING RULER. RRBK, TAD LINE23 / MOVE CURSOR TO START OF LINE /M157 DCA CURPTR DCA CURSOR AC7777 / BACKUP 1 CHAR CURMOV / SKIP OVER CURRENT RULER IF ANY JMP RRERRB / REACHED STX: NO PREVIOUS RULER JMS RRGTTP / GET SCTOP IN AC FOR RRGETN / / SCAN FORWARD (OR BACKWARD) THROUGH EDIT BUFFER SEARCHING FOR A RULER. / CONTINUE SCAN UNTIL ETX (OR STX) BUFFER IS EXHAUSTED. / RRSNEB, DCA RROROF / SAVE OFFSET OF ORIGINAL ETX(STX) BLOCK MQA DCA RRORID / SAVE HDR BLK ID # OF ORIGINAL BLOCK / CLEAR ENTRY POINT OF SUBR SETRUL, WHICH IS USED DURING RULER PROCESSING. / SETRUL'S ENTRY POINT IS USED HERE AS A FLAG / WHICH TELLS US WHEN CURMOV HAS ENCOUNTERED A RULER. CDFMYF DCA SETRUL RRSNEL, /D214 CDFSYS / CHECK FOR PENDING GOLD:HALT /D214 TAD I HLTFLG / WITHOUT UPDATING STATUS LINE (FOR SPEED) /D199 CDFMYF /D214 SZA CLA / SKIP IF NO GOLD:HALT /D214 JMP RRABOR / GOLD:HALT: ABORT GOTO-RULER /D199 TAD RRDIR / AC=DIRECTION OF NEXT CHAR JMS RRGETN / MOVE CURRSOR TO NEXT CHAR JMP RRERRT / ETX (OR STX) - NO NEXT RULER JMP RR3X / END OF EDIT & ETX (STX) BUFFERS /C199 TAD SETRUL / HAS CURSOR PASSED OVER A RULER? SNA CLA JMP RRSNEL / NO: CONTINUE SCAN FOR RULER JMP RRSCDN / YES: FOUND DESTINATION RULER / CHECK REAL BUFFER FOR RULER /A199 RR3X, TAD SETRUL / HAS CURSOR PASSED OVER A RULER? /A199 SZA CLA /A199 JMP RRSCDN / YES: FOUND DESTINATION RULER /A199 JMS RRCBUF / NO: GO CHECK BUFFER FOR RULER CODE /A199 JMP RR3 / REAL END OF BUFFER, CHECK STRUCTURE /A199 JMP RRSCLP / JUMP INTO RRSC CODE BELOW /A199 / SCROLL FORWARD (OR BACKWARD) TO NEXT RULER RRSC, AC0001 / ECHO TEXT WE SCROLL OVER DCA ECHFLG / MOVE FORWARD OR BACKWARD TO START OF NEXT RULER RRSCLP, CDFMYF / SETRUL'S ENTRY POINT IS USED AS A FLAG /A199 DCA SETRUL / INDICATES CURMOV HAS CROSSED A RULER. /A199 TAD RRDIR / PICK UP DIRECTION TO MOVE CURMOV / MOVE FORWARD OR BACKWARD JMP RRERRT / ETX OR STX /D214 TAD ECHFLG / ARE WE ECHOING CURMOV'S? /D214 SZA CLA /D214 HLTTST / YES: UPDATE STATUS LINE /D214 NOP / IGNORE HLTTST RESULT /D214 CDFSYS / CHECK FOR PENDING GOLD:HALT /D214 TAD I HLTFLG / WITHOUT UPDATING STATUS LINE(FOR SPEED) /D214 SZA CLA / SKIP IF NO GOLD:HALT REQUEST /D214 JMP RRABOR / GOLD:HALT: ABORT GOTO-RULER TAD ECHFLG / GET THE ECHO FLAG /C214 SNA CLA / ARE WE ECHOING CURMOV'S? /C214 JMP RRSC2 / NO, SKIP THE HALT TEST /C214 HLTTST / YES: UPDATE STATUS LINE & CHECK FLAG /C214 JMP RRABOR / GOLD:HALT: ABORT GOTO-RULER /C214 RRSC2, CDFMYF / DID CURMOV PASS OVER A RULER? TAD SETRUL SNA CLA / (CURMOV CALLS SETRUL TO PROCESS A RULER) JMP RRSCLP / NO: KEEP LOOKING FOR RULER / FOUND RULER. LEAVE CURSOR JUST AFTER RULER. RRSCDN, TAD RRDIR / WERE WE ADVANCING OR BACKING UP? SPA CLA / ADVANCING: DON'T MOVE CURSOR AC0001 / BACKING UP: ADVANCE CURSOR TO AFTER RULER CURMOV NOP / IMPOSSIBLE / GOTO-RULER IS DONE! (SUCCESS) JMP EIFIX / GO LISTEN FOR NEXT EDITOR CMD / NEXT RULER IS NOT IN TEXT BUFFER OR ORIGINAL ETX (OR STX) BUFFER, / THEREFORE WE MUST USE GOTO-PAGE STRUCTURE TO FIND NEXT RULER. / / FIRST, SAVE WPFILS' FILE SYSTEM POINTERS, BECAUSE / READING SUCCESSIVE GOTO-PAGE DESCRIPTOR WORDS MODIFIES THE / FILE SYSTEM POINTERS, AND AFTER SCANNING DESC WORDS FOR A RULER, / WE NEED A WAY TO RETURN TO OUR STARTING POINT IN THE DOCUMENT. / WARNING: DO NOT PERFORM ANY CURMOV, ADVCHR, ETC. THAT INVOLVES / DISK SCROLLING AFTER MODIFYING THE FILE SYSTEM POINTERS, / OR ELSE THE DOCUMENT WILL BE CORRUPTED! RR3, AC7776 / AC=-2 => SAVE FILE SYSTEM POINTERS JMS DSKCAL XRPRD CLA / FORGET # OF PAGES IN STX BUFFER / SET UP SCTOP,SCTPH TO ACCESS THE GOTO-PAGE DESCRIPTOR WORD / FOR THE BLOCK CURRENTLY LOADED IN THE ETX (OR STX) BUFFER TAD RRORID / COPY RRORID ... MQL TAD RROROF / ... AND RROROF ... JMS DSKCAL / ... TO SCTPH AND SCTOP XRSCTP / SCAN GOTO-PAGE STRUCTURE FORWARD (OR BACKWARD) UNTIL A BLOCK / CONTAINING A RULER IS FOUND. / KEEP TRACK OF THE # OF BLOCKS SKIPPED, SO WE CAN ESTIMATE / WHETHER IT'S FASTER TO SCROLL TO RULER OR JUMP TO IT. DCA RRBLCT / CLEAR # OF BLOCKS SKIPPED OVER / SCANNING FORWARD (BACKWARD): /A157 / START AT ORIGINAL SCTOP,SCTPH (SCBOT,SCBTH) DESCRIPTOR WORD, AND /A157 / INCREMENT (DECREMENT) UNTIL ETX (STX) OR RULER FOUND. /A157 RRDW, /D214 CDFSYS /A157 /D214 TAD I HLTFLG / DID USER TYPE GOLD:HALT? /A157 /D214 SZA CLA /A157 /D214 JMP RRHLT / YES: STOP WHERE YOU ARE /A157 CDFMYF /A157 TAD RRDIR / GET DIRECTION TO SCAN /A157 MQL / SET INCREMENT OR DECREMENT /A157 TAD (-6) / READ G-T-P DESC WORD, INC /A157 JMS DSKCAL / (AC=DESC WORD, -1==ETX OR STX) /A157 XRPRD /A157 CMA / REACHED ETX OR STX? /A157 SNA /A157 JMP RRFNDE / YES-NO NEXT RULER, OR GTP STRUCT /A157 / INCOMPLETE /A157 ISZ RRBLCT / NO: COUNT # OF BLOCKS SCANNED /A157 RRAER2, IFNZRO RPRULR-4000 < ? >/ PREFIX FILE CHANGED /A157 SPA CLA / DOES CURRENT BLK CONTAIN A RULER? /A157 JMP RRDW / NO: CONTINUE LOOKING FOR A RULER /A157 JMP RRFND / YES-FOUND DESTINATION RULER /A157 / REACHED ETX OR STX WHILE SCANNING TEXT & ETX (STX) BUFFERS FOR RULER / OR WHILE SCROLLING TO RULER -- / ERROR (BEEP) IF HAVEN'T FOUND RULER YET; / LEAVE CURSOR AT BOTTOM (OR TOP) OF DOCUMENT. RRERRT, CDFMYF TAD SETRUL / FOUND RULER JUST BEFORE ETX OR STX? SNA CLA / SKIP IF: YES /M163 RRERRB, JMS BUZZER / WARN USER, GET NEXT EDITOR COMMAND /M163 JMP EIFIX / YES-NO ERROR: GET NEXT EDITOR CMD /M163 / USER TYPED GOLD:HALT RRHLT, JMS RRRFSP / RESTORE FILE SYSTEM POINTERS RRABOR, JMP EIFIX / GO LISTEN FOR NEXT EDITOR COMMAND / HIT ETX (OR STX IF CORRUPT GTP STRUCT) WHILE SCANNING GTP DESC WORDS. / EITHER THERE IS NO NEXT RULER, OR THE GTP STRUCTURE IS INCOMPLETE. / PREPARE TO OPEN AT LAST KNOWN BLOCK, THEN CURMOV TO RULER OR ETX. RRFNDE, CDFMYF TAD RRDIR / AC=FLAG TO CORRECT OVERSHOOT AT ETX(STX) / RRFND: FOUND NEXT RULER USING GOTO-PAGE DESCRIPTOR WORDS. / PREPARE TO USE RANDOM-ACCESS TO JUMP TO RULER, / USING BLOCK POINTERS (SCTOP,SCTPH) SET BY SCAN LOOP ABOVE. / NO HARM DONE IF WE LATER DECIDE TO SCROLL INSTEAD. RRFND, JMS RRSVBK / ESTIMATE WHETHER RULER IS CLOSE ENOUGH TO SCROLL DIRECTLY TO IT, / OR IF IT WOULD BE FASTER TO USE GOTO-PAGE TECHNIQUES TO JUMP TO / RULER (RANDOM-ACCESS) TAD RRBLCT / IS RULER WITHIN 20 BLOCKS? TAD (-20) / (TO PULL A # OUT OF MY EAR) SPA SNA CLA JMP RRSC2 / YES: SCROLL TO THE RULER (NO ECHO) / NO: JUMP TO THE RULER / NOW ENTER COMMON CODE FOR GOTO-RULER, GOTO-PAGE, / GOLD:BOTTOM, (GOLD:TOP?,) AND FILE-DOCUMENT (GOLD:F) / / THE FOLLOWING FLAGS ARE VALID ONLY DURING AND IMMEDIATELY / FOLLOWING THIS COMMON CODE: / / 'RRDIR' IS THE FLAG THAT DISTINGUISHES GOTO-RULER FROM / GOTO-PAGE AND GOLD:BOTTOM. / RRDIR=+1 == GOTO-RULER (ADVANCING) / RRDIR=-1 == GOTO-RULER (BACKING UP) / RRDIR=0 == GOTO-PAGE OR GOLD:BOTTOM (*NOT* GOLD-RULER) / / 'RPBIN1' BIT 0 IS THE FLAG THAT DISTINGUISHES A / GOTO-PAGE, GOTO-RULER, OR GOLD:BOTTOM FROM A GOLD:F / (FILE DOCUMENT): / RPBIN1<0 == GOTO-PAGE, GOTO-RULER, OR GOLD:BOTTOM / (INHIBITS CERTAIN SCREEN MESSAGES) / RPBIN1>=0 == FILE DOCUMENT / AT EXIT FROM OVINIT, RPBIN1 BIT 0 := 1, BITS 1-11 ARE UNCHANGED. / / 'RPBOTF' IS A FLAG TO DISTINGUISH BETWEEN GOTO-PAGE & GOLD:BOTTOM / (NOT USED FOR GOTO-RULER): / RPBOTF>=0 == GOTO-PAGE / RPBOTF<0 == GOLD:BOTTOM / / / OUTLINE OF WHAT HAPPENS NEXT: / / OVRRDS DISPLAYS A MESSAGE SIMILAR TO THE GOTO-PAGE MESSAGE, / AND SETS RPBIN1:=4000 SO COMMON CODE LEAVES SCREEN ALONE; / THE COMMON CODE CALLS 2 OVERLAYS AS SUBROUTINES: / OVEXIT: / FILES THE DOCUMENT; / OVINIT: / INITIALIZES THE EDITOR (INCLUDING THE EDIT BUFFER & WPFILS); / OPENS THE DOCUMENT AT THE TOP; / THE GOTO-RULER/GOTO-PAGE/GOLD:BOTTOM OVERLAY RUNS: / OVRRP2: / JUMP TO ORIGINAL GOTO-PAGE/GOLD:BOT OVERLAY (OVRPP2) / IF NOT DOING GOTO-RULER; / OPEN THE DOCUMENT AT THE PHYSICAL BLOCK SPECIFIED BY RPCUBK; / CURMOV FORWARD OR BACKWARD TO THE NEXT RULER; AND / REPAINT THE SCREEN; / JUMP TO GET NEXT EDITOR COMMAND (DONE!). / OVLJMP / GO DISPLAY GOTO-RULER SCREEN, ETC... OVRRDS / VARIABLES RRBLCT, .-. / BLOCK COUNT WHILE SCANNING DESCRIPTOR / WORDS FOR NEXT RULER / = # OF BLOCKS FROM ETB (OR STB) TO / NEXT RULER. / OFFSET OF [[ORIGINAL BLOCK IN ETX (OR STX) BUFFER] + 1]. / THIS VALUE IS COMPARED TO CURRENT SCBOT (OR SCTOP) TO TELL / WHEN A NEW BLOCK HAS BEEN READ (THEREFORE ALL OF THE OLD / BLOCK HAS BEEN COPIED INTO THE EDIT BUFFER). / ALSO USED WHEN SCANNING GOTO-PAGE DESC WORDS FOR A RULER. RROROF, .-. / HEADER ID # OF [[ORIGINAL BLOCK IN ETX (OR STX) BUFFER] + 1]. RRORID, .-. X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVRPRL= .-OVLAY1+OVRNUM CDILP / NO ROOM HERE JMP RPERRE / GO FIX POINTERS FOR SCROLL AT EXIT TIME / / CONTINUE NORMAL GOTO-PAGE OR GOLD:BOTTOM / OVRPP2= .-OVLAY1+OVRNUM / /A157 / CLEAR CURRENT RULER (CURUL) FOR GOTO-PAGE AND GOLD:BOTTOM. /A157 / THIS IS USUALLY NOT NEEDED UNLESS DESTINATION PAGE IS IN FIRST BLOCK. /A157 / (OVINIT USED TO CLEAR CURUL, BUT NO LONGER DOES SO FOR GOTO-PAGE, /A157 / GOLD:BOTTOM, OR GOTO-RULER, FOR THE CONVENIENCE OF GOTO-RULER) /A157 / /A157 JMS CLRULR / CLEAR NWRUL /A157 JMS COPRUL / COPY NWRUL TO CURUL (CLEAR CURUL) /A157 JMP RP7777 / SETUP / Enter here to continue V2 GOTO PAGE request. / The edit buffer has been flushed; thereby updating the RPPGDS / block descriptors and closing the document. / The document has been re-opened thereby loading the HEADER block / and the RPPGDS block into the appropriate scroll buffers. / ***************************************************************** / *** *** / 'SRCDIR' HAS THE WORKING COPY OF THE RPPGDS DESCRIPTOR WORD / 'RPCUOF' HAS + OFFSET TO THE BLOCK CONTAINING THE DESIRED PAGE (END LOAD) / 'RPMTRL' HAS + OFFSET TO RULER BLOCK (LOAD RULER) / *** *** / ***************************************************************** / BEGIN LOOKING FOR DESIRED PAGE RPDESC, AC0001 / ('JMP' HERE AFTER SETUP AT 'XVRPP2') JMS ADJUST RP7777, AC7777 / RPDSCP FLAG INTO AC JMS DSKCAL / CALL WPFILS TO READ THE DESCRIPTOR WORD XRPRD / WPFILS ENTRY FOR 'RPINIT' CDFMYF / DATA FIELD SET TO 'BUFFER' AT 'DSKCAL' EXIT DCA SRCDIR / SAVE THE PRESENT RPPGDS WORD TAD SRCDIR / GET IT BACK FOR SOME TESTS CMA / -1 IS RPPGDS TERMINATOR SNA CLA / SKIP NEXT IF REAL DESCRIPTOR JMP TRYBOT / FOUND DESCRIPTOR LIST TERMINATOR / IF NOT PROCESSING V2 GOLD BOTTOM, / THEN THIS IS AN ERROR CONDITION AC4000 / RPRULR AND SRCDIR / SNA CLA / SKIP WITH A RULER IN THIS BLOCK JMP TRYPGE / JMP WITHOUT A RULER TAD RPMTRL / SAVE PREVIOUS RULER OFFSET. DCA RPMTBK / ... TAD RPRLHN / BLK. ID # OF EX-RULER DCA RPPRRL / BLK ID # FOR PREVIOUS RULER TAD RPCUOF / AC = OFFSET TO CURRENT DESCRIPTOR WORD DCA RPMTRL / THIS IS LATEST RULER BLOCK TAD RPCUBK / RPPGDS BLOCK IDENTIFIER DCA RPRLHN / SAVE UNTIL RULER LOAD REQUIRED / A78 TRYPGE, CDILP / FOR ROOM JMS RPXHLT / TEST desc. for desired page-blk. JMP RPDESC / return here if LO page not found / not honoring GOLD_HALT any longer /A154 SNA / return here if LO page found / SKIP IF USER DESIRED PAGE GREATER THAN 999 / AC = 0 IF NO 1000'S PAGE # SUPPLIED / SO WE'RE AT THE BLOCK CONTAINING THE PAGE /D154 JMP RPNOHLT / not honoring GOLD_HALT anymore JMP RPSURL / jump with blk. containing desired page /A154 TAD (-1) / TAKE AWAY A THOUSAND DCA RPBIN2 / UPDATE MEMORY THOUSAND PAGE # ISZ CURPG3 / UPDATE THOUSANDS # OF PAGES COUNTED TAD SRCDIR / TOTAL PAGES IN THIS BLOCK AND (37) / INTO THE AC TAD CURPG1 / -REMAINDER OF PAGES IN THIS BLOCK CIA / NEG COUNT OF PAGES LEFT IN BLOCK TAD (1750) / FROM 1000 = NEW HUNDREDS PAGE # DCA RPBIN1 / UPDATE MEMORY HUNDREDS PAGE # DCA CURPG1 / RESET PAGE COUNTER JMP RPDESC / CONTINUE WITH NEXT DESCRIPTOR   / here only if the -1 GTP desc. found. /A154 / if GOLD_BOTTOM flag negative then pursue GOLD_BOTTOM /A154 / else pursue PAGE_NOT_FOUND error condition /A154 / TRYBOT, TAD RPBOTF / get the GOLD_BOTTOM flag /A154 SPA CLA / skip if NOT GOLD_BOTTOM /A154 JMP TORPSURL / jump to perform a GOLD_BOTTOM /A154 TAD CURPG1 / these 2 words will contain pages /A154 TAD CURPG3 / found upto the -1 desc. word /A154 SNA CLA / if pages counted, then this is a /A154 / paginated doc. /A154 AC7776 / else, no pages so GO-TO-TOP /A154 DCA RPPG0 / will = 0 when page # too large /A154 JMP RPPGER / -2 when no pages avail. to /A154 / paint screen after err-report/A154 CURPG3, 0 /count of # of 1000's pages /A154 / user has depressed the GOLD_BOTTOM key and GTP has found the / logical end_of_file (-1 desc. word). Backup the descriptor / pointer to indirectly point at the last text block. / intialize CURPG1 to 1 for two reasons: enables correct flow / thru RPRULE with a GOLD_BOTTOM using a doc. without pages and / secondly, insures that RPADVNW reads all of the BOTTOM block into / the edit-buffer before filling PTRBLK prior to exit... TORPSURL, / -1 desc. word OK when doing GOLD_BOT /A154 AC7777 / get to GTP desc. word immediately /A154 JMS ADJUST / preceeding the -1 to find the ruler /A154 AC0001 / init.'d in order to share /A154 DCA CURPG1 / GTP exit logic JMP RPSURL / SETUP TO LOAD RULER /A157 / FOLLOWING CODE WAS MOVED IN SPACE WAR /A157 /D157 / if PAGE (or BOTTOM) & RULER are within the SAME block /D157 / then use previous RULER block (RPMTBK) in case /D157 / the ruler within the desired PAGE block is /D157 / beyond the desired PAGE /D157 / else use the latest RULER block (RPMTRL) found /D157 /D157 RPSURL, / Set-Up RuLer /D157 TAD RPCUOF / POINTS TO DESIRED PAGE or BOTTOM BLOCK /D157 CIA / FOR COMPARE TO /D157 TAD RPMTRL / LATEST RULER BLOCK POINTER /D157 SZA CLA / SKIP TO MAKE PRIOR THE LATEST RULER /D157 JMP SURLEX / JUMP TO RETAIN LATEST RULER /D157 TAD RPMTBK / RULER PRIOR TO LATEST RULER /D157 DCA RPMTRL / INSURE PRESENCE OF A RULER /D157 /D157 TAD RPPRRL / BLK ID # FOR PREVIOUS RULER /D157 DCA RPRLHN / TO BE LOADED /D157 /D157 SURLEX, TAD (-55) / OFFSET TO 1ST TEXT-BLOCK /D157 TAD RPCUOF / IF PAGE NOT IN 1ST TEXT-BLOCK /D157 SNA CLA / THEN LOAD ITS' RULER NOW /D157 JMP RPPAGE / ELSE, LOAD IT W/ PAGE or BOTTOM /D157 JMP RPRULE / GO SET-UP WPFILS SCTOP&SCBOT / the block being loaded into the EDIT buf. is pointed at by / the offset within RPMTRL; SCBOT points at this block -2 (COS). / when all chars. within this block have been moved into the / EDIT buf., WPFILS will automatically read in the next seq. / block and bump SCBOT. when SCBOT and RPMTRL no longer match / then a new block has just been read (we are done w/ current blk) RPCKBT, 0 / ChecK scBoT DCA T2 / CHAR. JUST LOADED INTO ED. BUF. TAD (-5) / F.C. TO REQ. SCBOT CONTENTS JMS DSKCAL / WPFILS WILL SUPPLY SCBOT IN AC XRPRD CDFMYF / BACK FROM BUFFER FIELD CIA / FOR COMPARE TO TAD RPMTRL / CURRENT BLOCK OFFSET SNA CLA / NO CHANGE MEANS SAME BLOCK ISZ RPCKBT / CHANGED WHEN NEXT SEQ. BLK. READ JMP I RPCKBT / RETURN + 1 = CONTINUE W/ THIS BLK. / RETURN + 0 = ENTIRE BLOCK PROCESSED / SPA / SKIP NEXT IF POSITIVE MEANING ADJUST FORWARD / JMP ADJBACK / ADJUST IN THE REVERSE DIRECTION / adjust in the forward direction / ISZ RPCUOF / ADJUST FORWARD BY 1 COUNT (ALWAYS) / CLA / TAD RPCUOF / TAD (-400) / SPA CLA / JMP I ADJUST / EXIT / gone to far forward / AC0002 / 2 /\ DCA RPCUOF / ISZ RPCUBK / JMP ADJEX2 / EXIT / adjust in the backward direction / ADJBACK,TAD RPCUOF / GET POINTER VALUE BEFORE ADJUSTMENT / DCA RPCUOF / SAVE BACKWARD ADJUSTED VALUE / TAD RPCUBK / CLL RAR / SNA CLA / JMP RPPH01 / AC7776 / -2 / TAD RPCUOF / SMA / JMP ADJEX1 / STILL WITHIN LIMITS OF RPPGDS BLOCK AFTER ADJUSTMENT / the contents of the AC is a negative number / which means out of the logical boundries / of the RPPGDS block after the backward adjustment / TAD (400) / DCA RPCUOF / RPCUOF IS NOW CORRECTED / AC7777 / -1 / TAD RPCUBK / DCA RPCUBK / JMP I ADJUST / EXIT / special boundry testing / because the pointer adjusted / is in the 1st RPPGDS descriptor block / (which has unique limits) / 55 - is the 'top' of the block where the 1st RPPGDS descriptor word is / 377 - is the 'bottom' of the block where the last descriptor word is / RPPH01, TAD (-55) / TAD RPCUOF / ADJEX1, SMA CLA / JMP I ADJUST / EXIT - STILL WITHIN LIMITS AFTER ADJUSTMENT / TAD (55) / ADJEX2, DCA RPCUOF / JMP I ADJUST / EXIT / after reporting that the desired page was not found, / backup to the previous descriptor word to get the block / containing the last available page..... SETBLK, XX / SAVE CALLERS RETURN ADDRESS TAD (-5) / F.C. TO REQ. SCBOT CONTENTS JMS DSKCAL / WPFILS WILL SUPPLY SCBOT IN AC XRPRD / GTP ENTRY POINT CDFMYF TAD (1) / INIT. RPMTRL TO BE THE DCA RPMTRL / BLK BEING LOADED AC7775 / -3 TAD RPCUBK / ARE WE IN THE 3RD EXT?? SZA CLA / SKIP IF 3RD EXT TAD (16) TAD (360) / IF IN 3RD EXT. SCBOT CANNOT BE >= 360 / ANY OTHER EXT. SCBOT CANNOT BE >= 376 CIA / MAKE NEG FOR COMPARE TAD RPMTRL / TO BLK BEING LOADED SNA CLA / SKIP W/ VALID BLOCK DCA RPMTRL / CORRECT BLOCK OFFSET JMP I SETBLK / RETURN X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / can delete all this because GOLD_BOTTOM now takes GTP path... /A154 /D157 / ENTRY TO 'RPXRULE' FROM 'TRYBOT' /D157 / A -1 RPPGDS DESCRIPTOR LIST TERMINATOR WAS FOUND /D157 / BACKUP THE LIST POINTER 10 POSITIONS /D157 / 10 POSITIONS = 1 TO GET BEFORE -1 DESCRIPTOR /D157 / 9 TO INSURE THAT THERE WILL BE ENOUGH TEXT /D157 / TO PAINT THE SCREEN /D157 /D154 RPXRULE, / was called only by TRYBOT /D154 TAD (-12) / ADJUST BACK 10 BLOCKS /D154 JMS ADJUST / ADJUST 'RPCUOF' /D154 CIFLP / FIELD 5 /D154 JMS RULCHK / CHECK TO LOAD CORRECT RULER /D154 TAD RPBKID / RESTORE BLK ID # /D154 DCA RPCUBK / FOR SCROLL... /D154 JMP RPRUL1 / IF DESIRED PAGE (OR BOT DOC) & LATEST RULER ARE WITHIN THE SAME BLOCK THEN/A157 / USE PREVIOUS RULER BLOCK (RPMTBK,RPPRRL) IN CASE /A157 / THE RULER WITHIN THE DESIRED PAGE BLOCK IS /A157 / BEYOND THE DESIRED PAGE; /A157 / ELSE (NOT WITHIN THE SAME BLOCK) /A157 / USE THE LATEST RULER BLOCK (RPMTRL,RPRLHN) FOUND. /A157 /A157 RPSURL, / Set-Up RuLer /A157 TAD RPCUOF / OFFSET OF DESIRED PAGE OR BOTTOM BLOCK/A157 CIA / FOR COMPARE TO /A157 TAD RPMTRL / LATEST RULER BLOCK OFFSET /A157 SZA CLA / SKIP IF BLOCKS MAY BE THE SAME /A157 JMP SURLEX / JUMP TO RETAIN LATEST RULER /A157 TAD RPCUBK / DO BLOCK ID #S ALSO MATCH? /A157 CIA / (COMPARE BLK ID # FOR DESIRED PAGE /A157 TAD RPRLHN / WITH BLK ID # FOR LATEST RULER) /A157 SZA CLA / SKIP IF YES:SET LATEST RUL:=PREVIOUS RUL/A157 JMP SURLEX / NO: RETAIN LATEST RULER /A157 /A157 TAD RPMTBK / RULER PRIOR TO LATEST RULER /A157 DCA RPMTRL / INSURE PRESENCE OF A RULER /A157 /A157 TAD RPPRRL / BLK ID # FOR PREVIOUS RULER /A157 DCA RPRLHN / TO BE LOADED /A157 /A157 SURLEX, TAD (-55) / OFFSET TO 1ST TEXT BLOCK /A157 TAD RPCUOF / IS PAGE OR BOTTOM IN 1ST TEXT BLOCK? /A157 SZA CLA /A157 JMP RPRULE / NO: GO LOAD IT'S RULER /A157 AC7777 / (MAYBE: CHECK BLOCK ID #S) /A157 TAD RPCUBK /A157 SNA CLA / SKIP IF NO: LOAD RULER SEPARATELY /A157 JMP RPPAGE / YES: LOAD RULER W/ PAGE OR BOTTOM /A157 / Request the initialization of WPFILS' SCTOP & SCBOT to enable / the READ of our RULER block. The contents of SCTOP & SCBOT / are used as offsets within the HEADER BLOCK BLOCK-LIST to / obtain the block # of the desired text block. They are always / a -2 away from the desired block list offset. SCGETR of WPFILS / takes the contents of SCTOP or SCBOT and adds 2 to obtain the / desired text block # from the block list. This module does not / alter the actual contents of either SCTOP or SCBOT. / Load the RULER into the edit buffer ; fill the edit ruler area (NWRUL) / with the contents of this RULER. RPRULE, TAD CURPG1 / PAGE NUMBER SNA CLA / SKIP IF VALID JMP RPPAG1 / USER SUPPLIED A PAGE VALUE / = OR < 0, OR NON-PAGINATED TAD RPRLHN / RPCUBK - IDENTIFY WHICH HEADER BLOCK CONTIANS MQL / THE RULER BLOCK OFFSET AC7776 / -2 / MAKES FOR WPFILS 'SCBOT' / / COS-310 COMPATABILITY TAD RPMTRL / RPCUOF - OFFSET TO THE BLOCK -2 / CONTAINING THE RULER JMS DSKCAL / REQUEST THAT SCBOT & SCTOP BE SETUP / FOR OUR READ XRPRD / ENTRY POINT FOR V2 GOTO PAGE / RANDOM BLOCK READ JMS RPBFIN / GO INITIALIZE THE EDIT BUFFER / the EDIT BUFFER is now logically empty. / WPFILS has been primed to start reading text blocks (SCBOT & SCTOP). / using ADVPTR because CURMOV doesn't know what to do with / an END-RULER (17) that may come before a START-RULER (16) / which is possible now with random block access employed / by GOTO-PAGE... JMS SETBLK / SET UP RPMTRL TO POINT AT THE / BLOCK TO BE LOADED RPRLSR, / START SEARCH FOR START-OF-RULER ADVPTR / READ/ LOAD 1 CHAR. NOP / ETX WILL NOT OCCUR CDFMYF / BACK TO THIS FIELD JMS RPCKBT / SEE IF ENTIRE BLOCK LOADED JMP RPPAGE / YES - ALL RULERS LOADED TAD T2 / CHAR. JUST LOADED TAD (-ECSTRL) / IS IT START-OF-RULER? SZA CLA / SKIP IF RULER FOUND JMP RPRLSR / NO RULER - KEEP LOOKING / load BOTTOM ruler just like GTP ruler /A154 /D154 TAD RPBOTF / IF THIS IS A /D154 SPA CLA / GOLD-BOTTOM REQUEST /D154 JMP TOBOTF / THEN JUMP TO CONT. IT JMS ADVRUL / LOAD RULER JUST FOUND NOP / ETX WILL NOT OCCUR JMS RPCKBT / DID IT FORCE READ OF NEW BLOCK? JMP RPPAGE / YES - ENTIRE BLOCK PROCESSED JMP RPRLSR / NO - DO UNTIL ENTIRE BLOCK READ / request the initialization of WPFILS' SCTOP & SCBOT to enable the / read of our PAGE block. / Exit to final overlay to paint the screen with the first line of / the new page in the bottom line of the screen. Set scroll pointers / with the edit buffer lines preceeding the first line of the new page. RPPAGE, JMS RPBFIN / GO INIT. THE EDIT BUFFER OVLJMP; OVRPWP / GO INIT. WPFILS'S SCTOP & SCBOT AND / TEST FOR ACTIVE CONTROL-BLOCK RPPAG1, OVLJMP; OVRPEX / LOAD PAGE INTO BUFFER;PAINT SCREEN; EXIT / can delete all this now because GOLD_BOTTOM handled like GTP /A154 / was called by RPRLSR only... /A154 /D154TOBOTF, TAD RPCUBK / HEADER BLOCK ID # /D154 CLL RAR /D154 SZA CLA / SKIP IF THIS IS 1ST HEADER BLOCK /D154 JMP BOTRLR / GO LOAD THE RULER INTO EDITOR RULER AREA /D154 TAD (-55) / 1ST TEXT BLOCK POINTER OFFSET /D154 TAD RPCUOF / COMPARE TO CURRENT BLOCK (BOTTOM OF DOC) /D154 SNA CLA / IF NOT 1ST DESCRIPTOR WORD /D154 JMP BOTEM / GO LOAD RULER / IF WE ARE IN THE FIRST BLOCK OF THE FIRST EXTENSION, LOAD THE RULER /D154BOTRLR, TAD (376) / READ IN THE NEWEST RULER /D154 CURMOV /D154 NOP /D154BOTRL1, JMS RPBFIN / CLEAN-UP EDIT BUFFER FROM RULER /D154 OVLJMP; OVRPWP / INIT. WPFIL'S SCTOP & SCBOT, / AND READ PAGE DESC. FOR PRINT CONTROL / error condition recognized.... RPPGER, TAD CURPG1 / -1 DESCRIPTOR FOUND SNA / IF NO PAGES IN THE DOCUMENT TAD CURPG3 / THEN REPORT ERROR AND SNA CLA JMP RPPAG1 / GO TO TOP OF DOCUMENT / ELSE AC2000 / ERROR RECOVERY FLAG DCA RPBOTF / FOR -1 DESC. FOUND CONDITION OVLJMP; RPPER7 / GO REPORT ERROR: RAN OUT OF / DESCRIPTOR WORDS BEFORE PAGE FOUND / INIT. THE EDIT BUFFER JUST LIKE AT OVINIT TIME... RPBFIN, XX CDFBUF AC7777 / TAKE 1 AWAY FROM THE FOLLOWING ADDR. TAD BUFBEG / START OF THE EDIT BUFFER DCA X0 / X0 = EDIT BUFFER LOC. POINTER TAD (ECBFBG) / BUFFER BEGIN WORD DCA I X0 / INTO 1ST EDIT BUFFER WORD TAD (ECSTX) / START OF TEXT WORD DCA I X0 / INTO 2ND EDIT BUFFER WORD TAD (ECETX) / END OF TEXT WORD DCA I X0 / INTO 3RD EDIT BUFFER WORD TAD BUFSIZ / # OF TOTAL BUFFER WORDS CIA / INTO A COUNTER TAD (4) / ACCOUNT FOR WORDS WE ALREADY INIT'D DCA X1 / X1 = # OF WORDS TO CLEAR TAD X0 DCA CURPTR DCA I X0 / CLEAR A BUFFER LOC. ISZ X1 / SKIP IF ENTIRE BUFFER = 0 JMP .-2 / NOT DONE CLEARING YET TAD (ECBFND) / PHYSICAL END OF BUFFER WORD DCA I X0 / INTO LAST BUFFER LOC. CDFMYF / INITIALIZE SCREEN TAD (PTRBLK-1) DCA X0 TAD (-NPTRS+1) DCA X1 DCA I X0 ISZ X1 JMP .-2 / GPT MUST USE INIT PTR BLK, DCA I X0 / UNLIKE OVINIT THAT INITS BOTTOM ENTRY TO 2 TAD CURPTR DCA LINE23 / INIT SEPARATE LINE 23 POINTER DCA CURSOR JMP I RPBFIN / RETURN TO CALLER / this routine was moved to field 5 for more room / offset ADJUSTMENT subroutine / adjust (INCREMENT OR DECREMENT) the offset to the rppgds; / and the pointer to the rppgds block / the contents of the AC at entry = positive for forward adjustment, or / = negative for backward adjustment ADJUST, XX / THE CONTENTS OF THE AC IS THE COUNT CIFLP / FOR ROOM..... JMS ADJUS0 JMP I ADJUST / RETURN TO CALLER / BOTEM called by TOBOTF only. Just deleted TOBOTF logic so this call /A154 / can also be deleted. /A154 / IF WE ARE IN THE FIRST BLOCK OF THE FIRST EXTENTION, LOAD THE RULER /D154BOTEM, OVLJMP;OVRBTM / MUST LOAD RULER, ELSE IT WON'T GET / PAINTED IF PTRBLK ISN'T FULL X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM /D155 OVRPEX= .-OVLAY1+OVRNUM /D155 JMP RPFPG / CONTINUE NORMAL GOTO PAGE /D157 OVRPWP= .-OVLAY1+OVRNUM / INIT. WPFILS;TEST FOR PRINT-CONTROL AREA /D157 JMP TORPWP / BOTEM just deleted, so this goes also /A154 /D154 OVRBTM= .-OVLAY1+OVRNUM /D154 JMP BOTRUL / LOAD RULER FOR SHORT DOC. GOLD BOTTOM OVRRP2= .-OVLAY1+OVRNUM / / COME HERE FOR GOTO-PAGE, GOLD:BOTTOM, AND GOTO-RULER. / / THE DOCUMENT HAS BEEN CLOSED, / THEN RE-OPENED, AND NOW WE FIND OURSELVES HERE. / / IF THIS IS GOTO-PAGE REQUEST, THEN / GOTO OVRPP2 TO COMPUTE WHICH BLOCK # HAS DESIRED / PAGE AND RULER(S); / IF THIS IS GOTO-RULER, THEN / WE ALREADY HAVE BLOCK # OF DESIRED RULER IN RPCUOF & RPCUBK, / SO OPEN DOCUMENT AT THAT BLOCK & POSITION CURSOR AT RULER. / TAD RRDIR / IS THIS GOTO-RULER? SZA CLA JMP RRPOS / YES OVLJMP / NO: GOTO ORIGINAL GOTO-PAGE,GOLD:BOTTOM OVRPP2 / OVERLAY (CURRENT OVERLAY DOESN'T DO / MUCH FOR GOTO-PAGE UNTIL LATER!) / OPEN DOCUMENT AT BLOCK WITH RULER (PHYSICAL BLOCK RPCUBK) / (ALSO INITIALIZES PCTLFL FROM GOTO-PAGE DESCRIPTOR WORD) RRPOS, JMS RROPP JMS MNUPUT / MAKE LINE # IN STATUS LINE = "N/A" (UNKNOWN) LINNUM-MUBUF / DONE AS EARLY AS POSSIBLE TO MAXIMIZE THE / CHANCE IT WILL BE SET TO SOMETHING USEFUL. / TURN MATH OFF BECAUSE 'RRPS' EXPECTS IT TO BE OFF AC0001 / FUNCTION TO SAVE "MA" SWITCH JMS SWTHMA / AND DEACTIVATE MATH / SET UP PTRBLK IF NECCESSARY. (MOVING CURSOR BACKWARDS (SCRLDN) / REQUIRES THAT AT LEAST LAST 2 ENTRIES IN PTRBLK BE FILLED.) TAD RRDIR / BACKING UP TO RULER? SPA CLA JMS RRPS / YES: MUST FILL PTRBLK NOW / CLEAR ENTRY POINT OF SUBROUTINE SETRUL, WHICH IS USED DURING RULER PROCESSING. / ENTRY POINT IS USED AS FLAG WHICH TELLS WHEN CURMOV HAS ENCOUNTERED A RULER. DCA SETRUL / BEGIN LOOP TO ADVANCE ( OR BACKUP) CURSOR TO RULER. / (NEXT RULER IS DESTINATION RULER.) RRJMLP, TAD RRDIR / GET DIRECTION CURMOV / MOVE CURSOR JMP RRJMET / ETX OR STX-MAYBE RULER NOT FOUND /D214 CDFSYS / IF USER PRESSED GOLD:HALT THEN ABORT /D214 TAD I HLTFLG / IS GOLD:HALT REQUEST PENDING? /D214 SZA CLA /D214 JMP RREXT / YES: ABORT LOOP CDFMYF / LOOP BACK UNTIL CURSOR HAS PASSED OVER RULER TAD SETRUL / DID CURMOV PROCESS A RULER? SNA CLA JMP RRJMLP / NO: LOOP BACK / FOUND DESTINATION RULER. IF WE WERE BACKING UP, CURSOR WILL BE / BEFORE RULER. MAKE SURE CURSOR IS JUST AFTER DESIRED RULER. TAD RRDIR / ADVANCING OR BACKING UP? SPA CLA AC0001 / BACKING UP: MOVE CURSOR AFTER RULER(DIST=1) RRJMET, CURMOV / ADVANCING: DON'T MOVE CURSOR(DIST=0) NOP / HIT ETX-THAT'S OK / CURSOR HIT ETX (OR STX). IF RULER NOT FOUND THEN BEEP TO WARN USER; / GO EXIT FROM GOTO-RULER (COMMON CODE WITH GTP, GOLD:BOT) CDFMYF TAD SETRUL / DID CURSOR PASS RULER JUST BEFORE ETX(STX)? SNA CLA JMS BUZZER / NO: BEEP TO WARN USER /M163 JMP RREXT / PREPARE TO PAINT SCREEN / CONTINUE NORMAL GOTO-PAGE OR GOLD:BOTTOM OVRPWP= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- JMS RROPR / OPEN FILE FOR SCROLLING AT RELATIVE /A157 / BLOCK DEFINED BY RPCUOF,RPCUBK /A157 / CONTINUE NORMAL GOTO-PAGE OR GOLD:BOTTOM /A155 OVRPEX= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- /A155 AC0001 / SET UP TO SHUT "MA" SWITCH & DEACTIVATE MATH JMS SWTHMA / GO SHUT OFF "MA" SWITCH & SAVE ORIGINAL / SETTING THIS KEEPS GO-TO-PAGE FUNCTION FROM / REACTIVATING MATH AS IT USES "CURMOV" IN THE / PROCESS OF POSITIONING ITSELF CORRECTLY FOR / THE RIGHT PAGE. (NOTE: "CKCTRL"CALLED BY / "SCRLUP" CALLED BY "CURMOV" THUS ACTIVATING / EDITOR MATH.) /D157 / IF GOLD-HLT IS HIT DURING G-T-P THE EXIT TO /D157 / G-T-P IS DONE VIA "EIBOT2" (I.E. GOLD-BOTTOM) /D157 / WHICH IS SET TO HANDLE A "HLTTST". / IF G-T-P OR GOLD:BOTTOM EXITS NORMALLY THEN / MATH "MA" IS RESTORED IN "RREXT" / /A158 / CONTINUE GOTO-PAGE AFTER ERROR MSG RE REQUEST FOR PAGE ABOVE --TOP--. /A158 / SKIPS "JMS SWTHMA" BECAUSE IT HAS ALREADY BEEN CALLED (WE'VE COME /A158 / THROUGH HERE BEFORE!); /A158 / WILL GO TO 'RPPTOP', THEN 'TOTOP'. /A158 / /A158 OVRPZZ= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- /A158 / SET STATUS LINE # = "N/A" (UNKNOWN). /A157 / THIS IS DONE AS EARLY AS POSSIBLE TO MAXIMIZE /A157 / THE CHANCE IT WILL BE SET TO SOMETHING MEANINGFUL. /A157 JMS MNUPUT /A157 LINNUM-MUBUF /A157 / CHECK DESTINATION PAGE "OFFSET" TAD CURPG1 / - # OF PAGES TO READ INTO BUFFER SNA CLA / SKIP IF VALID JMP RPPTOP / EITHER THIS DOC. IS NOT PAGINATED, OR / THE USER SUPPLIED A PAGE # = < 0 / start loading text into the EDIT BUFFER, / from the block containing the desired page (or end of GTP structure), / stopping when the top of the desired page (or the bottom of / the document) has been loaded... JMP RPADV2 / CHECK CHAR CURSOR IS ON /A158 / LOOP TO ADVANCE TO DESIRED PAGE (FOR GOTO-PAGE), /A158 / OR BOTTOM OF DOCUMENT (FOR GOLD:BOTTOM) /A158 RPADV1, /D214 CDFSYS / HAS USER PRESSED GOLD:HALT? /A158 /D214 TAD I HLTFLG /A158 /D214 SZA CLA /A158 /D214 JMP RREXT / YES-ABORT: LEAVE CURSOR WHERE IT IS. /A158 AC0001 / ADVANCE CURSOR TO NEXT CHARACTER /A158 RPADV2, CURMOV /A158 JMP RREXT / HIT ETX (NORMAL EXIT FOR GOLD:BOT) /A158 TAD I CURPTR / GET CURRENT CHAR /A158 AND P177 / IGNORE ATTRIBUTE BITS /A158 TAD (-ECNWPG) / IS CURRENT CHAR A NEW-PAGE-MARKER? /A158 CDFMYF /A158 SNA CLA /A158 ISZ CURPG1 / YES: IS MARKER FOR DESIRED PAGE? /A158 JMP RPADV1 / NO OR NO: LOOP BACK TO KEEP LOOKING /A158 / HANDLE CASE OF HAVING MORE THAN 4095 PAGES AFTER LOGICAL /A158 / END OF DOCUMENT (AS DETERMINED BY THE END OF THE GOTO-PAGE /A158 / DESCRIPTOR WORDS) /A158 TAD RPBOTF / IS THIS GOLD:BOTTOM? /A158 SPA CLA / SKIP IF GOTO-PAGE /A158 JMP RPADV1 / YES: ADVANCE UNTIL ETX /A158 / /A158 / FOUND DESIRED PAGE. /A158 / ADVANCE CURSOR TO NEXT PRINTABLE CHAR. /A158 / /A158 RPADV3, AC0001 / ADVANCE CURSOR /A158 CURMOV /A158 JMP RREXT / HIT ETX /A158 TAD I CURPTR / GET CURRENT CHAR /A158 JMS WRDTST / IS IT A WORD TERMINATOR? /A158 SNA CLA /A158 JMP RPADV3 / YES: LOOP TO FIND NON-TERMINATOR /A158 / NO: FOUND PRINTABLE CHARACTER /A158 /D158 / ADVANCE PAGE to desired page... /D158 /D158 RPADVUNT, / EMULATE ADVANCE PAGE /D158 AC0006 / AC => 6 FOR PAGE ID /D158 DCA GRAMUN / SUPPLY UNIT ID /D158 JMS SETUNT / SET PAGE-UNIT /D158 /D158 JMS LODCHR / LOOK FOR PAGE-MARKER /D158 JMP RREXT / ETX WILL now occur if GOLD_BOTTOM /M154 /D158 JMS RPGETUNT / SEE IF A PAGE-MARKER FOUND /D158 RPADVNW, /D158 .-. /D158 SZA CLA / RECOGNIZE PAGE-UNIT? /D158 JMP I RPADVNW / NO, KEEP SCROLLING... /D158 / CHECK GOLD:HALT AFTER EVERY PAGE /A157 /D158 / (THERE MAY BE NO PAGES! IS THIS A BUG?) /A157 /D158 CDFSYS /A157 /D158 TAD I HLTFLG / IS THERE A PENDING GOLD:HALT? /A157 /D158 SZA CLA / SKIP IF NO /A157 /D158 JMP RREXT / YES: ABORT, LEAVE CURSOR WHERE IT IS /A157 /D158 / LOOP BACK IF NOT AT DESIRED PAGE /D158 CDFMYF / FROM BUFFER FIELD /D158 ISZ CURPG1 / SKIP W/DESIRED PAGE IN BUFFER /D158 JMP RPADVUNT / JUMP TO SCROLL ANOTHER PAGE /D158 /D158 / HANDLE CASE OF HAVING MORE THAN 4095 PAGES AFTER LOGICAL /A157 /D158 / END OF DOCUMENT (AS DETERMINED BY THE END OF THE GOTO-PAGE /A157 /D158 / DESCRIPTOR WORDS) /A157 /D158 TAD RPBOTF / IS THIS GOLD:BOTTOM? /A157 /D158 SPA CLA / SKIP IF GOTO-PAGE /A157 /D158 JMP RPADVUNT / YES: ADVANCE UNTIL ETX /A157 /D157 JMP RPGBOT / can't use CURPG1 for GOLD_BOTTOM /A154 / / CURSOR IS AT DESIRED FINAL PLACE IN TEXT FOR GOTO-PAGE, GOTO-RULER / OR GOLD-BOTTOM, BUT PTRBLK MIGHT NOT BE COMPLETELY FULL. / RREXT, JMS RRPS / FILL PTRBLK IF NECESSARY & POSSIBLE /A157 AC2000 / SET FLAG THAT TELLS FXSCRL TO DCA SCRNFL / REPAINT THE ENTIRE SCREEN / THE BLOCK CONTAINING THE DESIRED PAGE, RULER, OR DOCUMENT BOTTOM / IS IN THE EDIT BUFFER, AND THE CURSOR IS POSITIONED AT THE / DESIRED ENTITY IF IT EXISTS; OTHERWISE THE CURSOR IS AT THE / BOTTOM OF THE DOCUMENT -- UNLESS THE USER PRESSED GOLD:HALT! / IN ANY EVENT, PTRBLK HAS BEEN SET UP TO PAINT THE SCREEN PROPERLY. JMS SWTHMA / GO RESTORE THE ORIGINAL "MA" SWITCH SETTING / FROM BEFORE ENTERING GTP, G:BOT, OR GTR / (SEE COMMENT AT START OF "OVRPEX" / OR "RRPOS" ROUTINES.) /D157 CDFSYS / GET TO FIELD 0 TO /D157 DCA I HLTFLG / CLEAR A POSSIBLE GOLD-HALT FLAG /D157 CDFLP / NOW TO FIELD 5 TO /D157 DCA RPACTIVE / CLEAR GTP 'ACTIVE' FLAG / GO FINISH UP SOME BUSY WORK, / CALCULATE & SET THE STATUS LINE'S PAGE NUMBER LOCATIONS, AND THEN / GO RE-PAINT THE SCREEN, CLEAR MOVEMENT AND EDIT MODES, AND / WAIT FOR NEXT EDIT COMMAND OVLJMP;OVBOTB / END OF REPOSITIONING REQUEST / / SUBR RRPS -- PTRBLK SETUP / FILLS UP PTRBLK WITH THE DESIRED SCREEN IMAGE, / AND LEAVES THE CURSOR AT THE SAME PLACE IN THE TEXT WHEN DONE. / / ENTRY CONDITIONS: / RRPS ASSUMES THE CURSOR IS IN COLUMN 0. /A157 / PTRBLK MAY BE TOTALLY EMPTY, PARTIALLY FULL, OR COMPLETELY FULL, /A157 / BUT IT MUST NOT BE GARBAGE. /A157 / MATH MUST BE TURNED OFF. /A157 / IT IS BEST IF EDITOR'S STATUS LINE'S LINE # IS INITIALIZED / (SO IF PAGE IS FOUND BY RRPS, THEN LINE # WILL BE SET). / RRPS, XX / CHECK WHETHER PTRBLK IS PRIMED FOR SCRLDN /A157 / (SCRLDN REQUIRES THAT LAST 2 PTRBLK ENTRIES BE FULL) /A157 CDFMYF /A157 TAD PTRBLK+26 / GET PTRBLK ENTRY FOR LAST LINE - 1 /A157 SZA CLA / IS PTRBLK PRIMED? /A157 JMP RRPS1 / YES-DON'T PRIME IT AGAIN /A157 / PTRBLK NOT PRIMED - SO PRIME IT FOR MOVING CURSOR BACKWARDS /A157 / SCRLDN WILL ACT STRANGE THE 1ST TIME IT'S CALLED /A157 / (IT WILL PLACE CURSOR AFTER CURRENT POSITION, NOT BEFORE), /A157 / BUT IF WE CONTINUE BACKING UP LINES (WHICH WE WILL), /A157 / THEN EVERYTHING WILL BE OK. /A157 TAD LINE23 /A157 DCA PTRBLK+26 / SET UP LAST LINE-1 IN WINDOW /A157 TAD LINE23 /A157 DCA PTRBLK+27 / SET UP LAST LINE IN WINDOW /A157 RRPS1, / PREPARE TO BACKUP A LINE /M157 AC0001 / AC:=1 FOR "LINE" UNIT MODE DCA GRAMUN / 1 = "LINE" MOVEMENT / INSERT MARKER TO REMEMBER CURRENT PLACE IN DOCUMENT TAD (ECTMRK) / POSITION MARK UNAFFECTED BY JUSTIFICATION JMS INSRL1 / INSERT POSITION MARKER /M155 / NOTE: INSRL1 LEAVES CURPTR AFTER /A155 / INSERTED CHAR. THUS RULER MODIFIED /A155 / FLAG WILL BE INSERTED AFTER ECTMRK, /A155 / ELSE THE ECTMRK MIGHT BE REJUSTIFIED! /A155 / / BACKUP A LINE UNTIL PTRBLK IS FULL OR STX IS REACHED. / /D157 RRPSLP, CLA /D157 CDFMYF /D157 TAD PTRBLK / IS PTRBLK FULL? /D157 / (COULD BE FINE TUNED FOR WIDE /D157 / SCREEN AND STATUS LINE) /D157 SZA CLA /D157 JMP RRPSFM / YES: GO FIND POSITION MARKER RRPSLP, JMS BACKUN / BACK CURSOR UP A LINE. /M157 / FOR SOME OBSCURE REASON, BACKUN / FILLS IN AN EXTRA ENTRY TOWARD THE / TOP OF PTRBLK (AND THE SCREEN) / EACH TIME IT IS CALLED. / IF THIS WERE NOT SO, THIS ROUTINE / WOULD BACKUP TO STX! (OHHHH NOOOO!) JMP RRPSGM / HIT STX: GO FIND POSITION MARKER /M158 CDFMYF TAD PTRBLK / IS PTRBLK FULL YET? SNA CLA JMP RRPSLP / NO: LOOP UNTIL IT IS /M157 / / PTRBLK IS NOW AS FULL AS IT CAN GET BY BACKING UP. / MOVE FORWARD TO POSITION MARKER (WHICH MARKS DESIRED / RULER OR PAGE). / / AS WE MOVE FORWARD TO POSITION MARKER, / PTRBLK MAY FILL UP MORE IF WE HAD REACHED STX; / REJUSTIFICATION WILL OCCUR IF NEEDED (USUALLY IT WON'T BE); / AND MATH MUST BE TURNED OFF IN CASE CURSOR PASSES OVER / A WPSMATH CONTROL BLOCK (SEE SWTHMA). / / /D158 RRPSFM, JMS LODCHR / AC=CURRENT CHAR /D158 JMP RRPSLM / AT EOT: BUG-LOST MARKER /D158 / MARKER IS PROBABLY STILL IN TEXT /D158 / SOMEWHERE-TRY SEMI GRACEFUL RECOVERY /D158 TAD (-ECTMRK) / IS CURSOR AT POSITION MARKER? /D158 SNA CLA /D158 JMP RRPSAM / YES-AT MARKER SKP CLA / Start checking w/ current char. /A200 RRPSFM, AC0001 / ADVANCE CURSOR /M158 RRPSGM, CURMOV /M158 JMP RRPSLM / AT EOT: BUG-LOST MARKER / MARKER IS PROBABLY STILL IN TEXT / SOMEWHERE-TRY SEMI GRACEFUL RECOVERY TAD I CURPTR / GET CURRENT CHAR /A158 TAD (-ECTMRK) / IS IT THE POSITION MARKER? /A158 SZA CLA /A158 JMP RRPSFM / NO: LOOP BACK TO FIND MARKER / / FOUND POSITION MARKER. / DELETE POSITION MARKER, THEN / ADVANCE TO CHAR BEING MARKED (CURSOR'S FINAL RESTING PLACE) / RRPSAM, DCA I CURPTR / DELETE POSITION MARKER ADVPTR / MOVE TO 1ST REAL CHAR ON LINE NOP / REACHED ETX-THAT'S OK / RRPSLM, CLA / FORGET CURRENT CHAR CDFMYF JMP I RRPS / EXIT RRPS! X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / here when this document has not been paginated or, if it has, / the user supplied a page # value = or < 0. / for either case, go to the top of the document and continue the edit cycle / Pseudo-OVINIT... Want to set the pointers to the top of the document. Upon / entering, the buffer contains the start of a ruler, which we want to remove. / When entering, the edit buffer looks like: 7777 When exiting: 7777 / 7775 7775 / 0016 7775 / 7775 0000 / 0000 0000 / . . / . . / . . RPPTOP, TAD RPPG0 / --TOP-- FLAG SMA CLA / SKIP IF ABSOLUTE PAGE 0 OR, / NEG. OFFSET WENT BEYOND --TOP-- JMP TOTOP / JUMP IF PAGE 1 OR, / NEG. OFFSET = CURRENT PAGE # OVLJMP;RPPER7 / REPORT ERROR AND RETURN AT OVRPEX... TOTOP, / GET TO ---TOP--- JMS RPOVIN / CLEAR EDIT BUFFER /M157 JMS RRPBIN / CLEAR PTRBLK & INIT LAST ENTRY /A157 OVLJMP / JUMP TO OVERLAY WITH ABOVE CODE OVRPTP /D157 TORPWP, JMS RROPR / OPEN DOCUMENT AT DESIRED BLOCK /D157 CDFMYF /D154 TAD RPBOTF / GET THE 'GOLD BOTTOM' FLAG /D154 SPA CLA / SKIP IF NOT GOLD BOTTOM /D154 JMP EIBOTA / JUMP IF GOLD BOTTOM /D157 JMP RPFPG / CONTINUE GOTO-PAGE and GOLD_BOTTOM /D155 / /D155 / SUBR RRRAND -- RANDOM-ACCESS OPEN /D155 / /D155 / /D155 / PSUEDO-CODE: /D155 / /D155 / CALL WPFILS TO OPEN DOCUMENT FOR SCROLLING AT DESIRED BLOCK /D155 / (DEFINED BY RPCUOF,RPCUBK); /D155 / READ GOTO-PAGE DESCRIPTOR WORD FOR THIS BLOCK (CHANGES BLOCK); /D155 / IF BIT RPMTHB IS ON THEN /D155 / PCTLFL := 1 ( INDICATE WITHIN CONTROL BLOCK ) /D155 / ELSE /D155 / PCTLFL := 0 ( INDICATE NOT WITHIN CONTROL BLOCK ) /D155 / CALL WPFILS TO OPEN DOCUMENT FOR SCROLLING AT DESIRED BLOCK /D155 / (DEFINED BY RPCUOF,RPCUBK); /D155 / /D155 / /D155 / CALL: /D155 / / IT IS ASSUMED TEXT, ETX, & STX BUFFERS ARE ALL EMPTY /D155 / / RPCUOF= OFFSET INTO DOCUMENT HEADER BLOCK FOR DESIRED BLOCK /D155 / / RPCUBK= HEADER BLOCK ID # FOR DESIRED BLOCK /D155 / CDFMYF /D155 / CLA /D155 / JMS RRRAND / RANDOM-ACCESS OPEN FOR SCROLLING /D155 / / DOCUMENT IS NOW OPEN FOR SCROLLING USING STANDARD METHODS /D155 / / (ADVPTR,BAKPTR,ETC.). /D155 / / PCTLFL IS SET UP TO INDICATE WHETHER OR NOT CURSOR IS /D155 / / IN A CONTROL BLOCK. /D155 / / AC= 0. /D155 / / DF= CDFBUF /D155 / /D155 / /D155 RRRAND, XX /D155 / /D155 / OPEN DOCUMENT AT DESIRED BLOCK /D155 / /D155 JMS RRRAOP /D155 / /D155 / READ GOTO-PAGE DESCRIPTOR WORD OF "DESIRED BLOCK" /D155 / /D155 AC7777 / SUBFUNCTION TO READ "NEXT" DESC WORD /D155 JMS DSKCAL /D155 XRPRD /D155 / /D155 / SET PCTLFL FROM GOTO-PAGE DESCRIPTOR WORD /D155 / /D155 AND (RPMTHB) / TEST "WITHIN CONTROL BLOCK" BIT /D155 SZA CLA / SKIP IF NOT IN CONTROL BLOCK /D155 AC7777 / INDICATE IN CONTROL BLOCK /D155 DCA PCTLFL /D155 / /D155 / RE-OPEN DOCUMENT AT "DESIRED BLOCK", /D155 / SINCE "READ DESC WORD" ABOVE INCREMENTED BLOCK POINTERS /D155 / /D155 JMS RRRAOP /D155 JMP I RRRAND / EXIT /D155 /D155 / /D155 / SUBR RRRAOP -- OPEN DOCUMENT AT "DESIRED BLOCK" /D155 / /D155 RRRAOP, XX /D155 CDFMYF /D155 TAD RPCUBK / HEADER BLOCK ID # /D155 MQL /D155 AC7776 / ADJUST OFFSET TO 0..375 /D155 TAD RPCUOF / OFFSET INTO HEADER FOR DESIRED BLOCK /D155 JMS DSKCAL / OPEN DOCUMENT AT THIS BLOCK /D155 XRPRD / (SPECIAL GOTO-PAGE FUNCTION) /D155 JMP I RRRAOP / EXIT / START OF "/A155" BLOCK ... /A155 / / SUBR RROPR -- RANDOM-ACCESS OPEN FILE FOR SCROLLING / AT RELATIVE BLOCK RPCUOF,RPCUBK / CLEARS TEXT BUFFER AND PTRBLK. / FIRST FILE SCROLLING OPERATION MAY BE ADVPTR OR BAKPTR. / RROPR IS USED BY GOTO-PAGE AND GOLD:BOTTOM. / / CALL: / / RPCUOF= OFFSET INTO DOCUMENT HEADER BLOCK FOR DESIRED BLOCK / / RPCUBK= HEADER BLOCK ID # FOR DESIRED BLOCK / CDFMYF / CLA / JMS RROPR / RANDOM-ACCESS OPEN AT RELATIVE BLOCK / / AC= 0 / / DF= CDFMYF / RROPR, XX TAD RPCUBK / HEADER BLOCK ID # MQL AC7776 / ADJUST OFFSET TO 0..375 TAD RPCUOF / OFFSET INTO HEADER FOR DESIRED BLOCK JMS RROPN / OPEN DOCMT AT RELATIVE BLOCK JMP I RROPR / / SUBR RROPP -- RANDOM-ACCESS OPEN FILE FOR SCROLLING / AT PHYSICAL BLOCK RPCUBK / ASSUMES FILE IS OPEN AND SCTOP,SCTPH POINT TO FIRST DOCMT BLOCK-1. /A157 / CLEARS TEXT BUFFER AND PTRBLK. / FIRST FILE SCROLLING OPERATION MAY BE ADVPTR OR BKPPTR. / RROPR IS USED BY GOTO-RULER. / / CALL: / / RPCUBK= PHYSICAL BLOCK # OF DESIRED BLOCK / CDFMYF / CLA / JMS RROPP / RANDOM-ACCESS OPEN AT PHYSICAL BLOCK / / AC= 0 / / DF= CDFMYF / RROPP, XX / /A157 / TRANSLATE PHYSICAL BLOCK # (RPCUBK) /A157 / TO RELATIVE BLOCK # (HDR BLOCK OFFSET, HDR BLK ID #) /A157 / /A157 RROPPL, / GET GTP DESC WORD FOR NEXT DOCMT BLK /A157 AC7777 / FUNCTION=INC SCTOP,SCTPH & READ DESC /A157 JMS DSKCAL /A157 XRPRD /A157 CMA / HIT ETX? /A157 SNA CLA /A157 HLT / YES-COULDN'T FIND PHYS BLK # IN DOCMT /A157 / GET CURRENT SCTOP (WPFILS MAKES THIS AWKWARD) /A157 TAD (CURID-1) / RETURN SCTOP,SCTPH AT CURID,CURID+1 /A157 MQL / (USES CURID AS A TEMP) /A157 AC7775 / FUNCTION=RETURN SAVED & CURRENT /A157 JMS DSKCAL / SCTOP,SCTPH IN AC,MQ & @(ORIG MQ) /A157 XRPRD /A157 CLA / FORGET SAVED SCTOP IF ANY /A157 CDFLP /A157 TAD I (CURID+1) / GET SCTOP (FINALLY!) /A157 / GET PHYSICAL BLOCK # CORRESPONDING TO SCTOP /A157 TAD (HDRBUF+2) / CONVERT SCTOP TO PTR INTO DOCMT HDR BLK/A157 DCA T1 / SAVE PTR TO PHYS BLK # /A157 CDFBUF / FIELD OF DOCMT HDR BLOCK BUFFER /A157 TAD I T1 / GET PHYSICAL BLOCK # /A157 / LOOP IF NOT AT DESIRED PHYSICAL BLOCK # /A157 CIA / COMPARE CURRENT PHYSICAL BLK # TO ... /A157 CDFMYF /A157 TAD RPCUBK / ... DESIRED PHYSICAL BLOCK # /A157 SZA CLA /A157 JMP RROPPL / NO MATCH: KEEP LOOKING /A157 / FOUND PHYSICAL BLOCK! /A157 / PUT RELATIVE BLOCK # IN AC,MQ FOR OPEN /A157 CDFLP / FIELD OF CURID, WHERE CURRENT SCTOP, /A157 / SCTPH WERE STORED BY WPFILS CALL ABOVE/A157 TAD I (CURID) / GET CURRENT SCTPH /A157 MQL / MQ=DOCMT HDR BLOCK ID (0..17?) /A157 TAD I (CURID+1) / GET CURRENT SCTOP=OFFSET INTO HDR BLK /A157 / RANDOM-ACCESS OPEN AT DESIRED PHYSICAL BLOCK (USING REL BLK) /A157 JMS RROPN /A157 / WPFILS HAS A BUG SUCH THAT IF BKPPTR IS FIRST FILE SCROLLING / OPERATION AFTER A RANDOM-ACCESS OPEN, THE FILE MODE (LOWER CASE, / UNDERLINE, ETC) CAN BE LOST. THIS PROBLEM IS AVOIDED / BECAUSE RROPN ALWAYS DOES AN ADVPTR FIRST. JMP I RROPP / EXIT / / SUBR RROPN -- RANDOM-ACCESS OPEN FILE FOR SCROLLING / AT BLOCK IN AC (OFFSET), MQ (HEADER ID #) / RROPN, XX / / OPEN DOCUMENT AT DESIRED BLOCK / JMS DSKCAL XRPRD / / NOTE: SCBOT,SCBTH POINT TO DESIRED BLOCK; / SCTOP,SCTPH POINT TO DESIRED BLOCK - 1. / READ GOTO-PAGE DESCRIPTOR WORD OF "DESIRED BLOCK" / AC7777 / (FUNCTION=READ "NEXT" DESC WORD) JMS DSKCAL / INC SCTOP,SCTPH TO "DESIRED BLOCK" XRPRD AC7777 / FORGET DESC WORD(WE'LL GET IT AGAIN) MQL / DEC SCTOP,SCTPH TO ORIGINAL BLOCK TAD (-6) / BUT FIRST READ GTP DESC WORD JMS DSKCAL / FOR "DESIRED BLOCK" INTO AC AGAIN XRPRD / / SET PCTLFL FROM GOTO-PAGE DESCRIPTOR WORD / AND (RPMTHB) / TEST "WITHIN CONTROL BLOCK" BIT SZA CLA / SKIP IF NOT IN CONTROL BLOCK AC7777 / INDICATE IN CONTROL BLOCK DCA PCTLFL / /A157 / ADVANCE TO START OF LINE. /A157 / (CURMOV IS CLEANER IF IT STARTS AT THE START OF A LINE. /A157 / THIS AVOIDS A COUPLE OF RATHER UNLIKELY BUGS.) /A157 / /A157 JMS RPOVIN / CLEAR EDIT BUFFER /A157 RROPLN, ADVPTR / GET NEXT CHAR FROM START OF "DESIRED BLOCK"/A157 JMP RROPX / AT ETX /A157 AND P177 / IGNORE ATTRIBUTE BITS /A157 ZZCASE / AT START OF NEW LINE? /A157 RROPTB-1 /A157 / ECSTRL; RROPX / YES /A157 / ECNWPG; RROPX / YES /A157 / ECNWLN; RROPL2 / ALMOST (NEXT CHAR IS START OF LINE) /A157 JMP RROPLN / NO: ADVANCE UNTIL START OF LINE /A157 /A157 RROPL2, ADVPTR / SKIP OVER LINE END /A157 NOP / REACHED ETX /A157 CLA / THROW OUT LINE ENDING CHAR /A157 RROPX, JMS RRPBIN / CLEAR PTRBLK & INIT LAST ENTRY /A157 JMP I RROPN / EXIT /A157 /A157 / ZZCASE JUMP TABLE /A157 RROPTB, ECSTRL; RROPX / START OF RULER /A157 ECNWPG; RROPX / NEW PAGE /A157 ECNWLN; RROPL2 / NEW LINE /A157 0 / END OF "/A155" BLOCK ... /A155 / / SUBR RPOVIN -- INITIALIZE EDIT BUFFER /M157 / / ASSUMES EDIT BUFFER STARTS AT LOC 0000 AND IS 6000(8) WORDS LONG; /M155 / THUS WILL NOT WORK WITH LIST PROCESSING. / ADDITIONAL ASSUMPTIONS COULD BE MADE WHICH WOULD / SHORTEN THE CODE EVEN MORE. / RPOVIN, XX CDFBUF / GET TO BUFFER FIELD AC7777 / POINTER TO START DCA X0 / X0 => EDIT BUFFER POINTER /D155 TAD (ECBFBG) / 7777 IFNZRO ECBFBG-7777 < ? > / PREFIX FILE CHANGED /A155 AC7777 / AC := ECBFBG /A155 DCA I X0 / 1ST LOC. /D155 TAD (ECSTX) / 7775 IFNZRO ECSTX-7775 < ? > / PREFIX FILE CHANGED /A155 AC7775 / AC := ECSTX /A155 DCA I X0 / 2ND LOC. /D155 TAD (ECETX) / 7775 IFNZRO ECETX-7775 < ? > / PREFIX FILE CHANGED /A155 AC7775 / AC := ECETX /A155 DCA I X0 / 3RD LOC. /D155 TAD BUFSIZ / SIZE OF EDIT BUFFER /D155 CIA / - # OF WORDS IN EDIT BUFFER /D155 TAD (4) / ALREADY USED THESE MANY TAD (-6000+4) / -(LENGTH OF EDIT BUFFER - 4) /A155 / (WILL FAIL DURING LIST PROCESSING) /A155 DCA X1 / X1 => # OF LOC. TO CLEAR TAD X0 / 2ND LOC. DCA CURPTR / CURPTR => PTR. AT ETX DCA I X0 / CLEAR A LOC. ISZ X1 / SKIP IF EDIT BUFFER CLEARED JMP .-2 / LOOP UNTIL CLEARED /D155 TAD (ECBFND) / 7776 IFNZRO ECBFND-7776 < ? > / PREFIX FILE CHANGED /A155 AC7776 / AC := ECBFND /A155 DCA I X0 / LAST BUFFER LOC. /D157 JMS RRPBIN / INITIALIZE PTRBLK /D157 TAD CURPTR / POINTS AT ETX /D157 DCA LINE23 / INIT. SCREEN LINE /D157 DCA CURSOR / INIT. JMP I RPOVIN / RETURN TO CALLER / called by OVRBTM which was called by BOTEM to do old GOLD_BOTTOM /A154 / don't need this anymore... /A154 /D154 BOTRUL, JMS RRPBIN / INITIALIZE PTRBLK /D154 AC0001 / finish loading the ruler /D154 CURMOV /D154 NOP / etx will never occur /D154 EIBOTA, OVLJMP;OVBOTA / GO TO NEXT OVERLAY TO FINISH UP / / SUBR RRPBIN - PTRBLK INITIALIZATION / / CLEARS PTRBLK & INITIALIZES LAST ENTRY; / INITIALIZES LINE23 & CURSOR. /A157 / ASSUMES CURPTR IS AT THE START OF A LINE. / RRPBIN, XX CDFMYF / FROM BUFFER FIELD TAD (PTRBLK-1) / START OF SCROLL POINTERS DCA X0 TAD (-NPTRS+1) / # OF POINTERS DCA X1 DCA I X0 / CLEAR A POINTER ISZ X1 / SKIP IF ALL POINTERS CLEARED JMP .-2 / LOOP UNTIL ALL CLEARED TAD CURPTR / GET PTR TO (ASSUMED) START OF LINE /M157 DCA I X0 / INIT. 1ST SCROLL POINTER TAD CURPTR / POINTS AT ETX /A157 DCA LINE23 / INIT. SCREEN LINE /A157 DCA CURSOR / INIT. /A157 JMP I RRPBIN /D157 / here to close a very small GOLD_BOTTOM window, that being the presence /D157 / of a document that contains 4095 page markers between the logical_EOF /D157 / ( -1 desc. word) and physical_EOF /D157 /D157 RPGBOT, TAD RPBOTF / get the GOLD_BOTTOM flag /A154 /D157 SMA CLA / skip if doing a GOLD_BOTTOM /A154 /D157 JMP RRPS / jump to conclude GTP /A154 /D157 AC0001 / initial for furthur scrolling /A154 /D157 DCA CURPG1 / won't come here for every page /A154 /D157 JMP RPADVUNT / scroll_until_EOF /A154 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / / DISPLAY THE GOTO-PAGE SCREEN / ("REPOSITIONING TO YOUR DESIRED PAGE...") / OVPAGE= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- JMS CLR132 / CLEAR 132 MODE ON GOLD BOTTOM CIFMNU / CHANGE TO MENU INSTRUCTION FIELD AC0003 / SET UP FOR CLEAR SCREEN REQUEST JMS I (CALLN1) / GO TO STATUS LINE ROUTINE FOR CLEAR CIFMNU / ...GOING TO 'IOA' FOR SCREEN DISPLAYS JMS I IOACAL 0 / NO SPECIAL OUTPUT ROUTINE M2PAGE / ADDR OF MESSAGE 1125 / ^P (SCREEN POSITION) M2PAG / ^S (STRING ARG="PAGE") 1437 / ^P 2700 / ^P JMP XVGOPG / / DISPLAY THE GOTO-RULER SCREEN / ("REPOSITIONING TO YOUR DESIRED RULER...") / OVRRDS= .-OVLAY1+OVRNUM / / SET UP SOME FLAGS TO DO GOTO-RULER / SEE LARGE COMMENT BLOCK SHORTLY AFTER 'RRFND1' FOR DETAILS / AC4000 / INHIBITS CLEARING OF SCREEN DCA RPBIN1 / WE ARE ABOUT TO CREATE / / DISPLAY "REPOSITIONING TO DESIRED RULER..." SCREEN / JMS CLR132 / CLEAR 132 MODE ON GOLD BOTTOM CIFMNU / CHANGE TO MENU INSTRUCTION FIELD AC0003 / SET UP FOR CLEAR SCREEN REQUEST JMS I (CALLN1) / GO TO STATUS LINE ROUTINE FOR CLEAR CIFMNU / ...GOING TO 'IOA' FOR SCREEN DISPLAYS JMS I IOACAL 0 / NO SPECIAL OUTPUT ROUTINE M2PAGE / ADDR OF MESSAGE 1125 / ^P (SCREEN POSITION) M2RUL / ^S (STRING ARG="RULER") 1437 / ^P 2700 / ^P / / GO TO COMMON CODE / JMP RPTOP / GO CLOSE DOCUMENT, OPEN AT TOP, ETC, / GOLD_BOTTOM now paints the screen and exits in the same way as /A154 / GTP does... /A154 / / FINISH GO-TO-PAGE, GOLD:BOTTOM AND GO-TO-RULER FOR STATUS LINE / OVBOTB= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- /D157 CLA /A154 /D157 DCA RPBOTF / clear doing GOLD_BOTTOM flag /A154 CDFLP / NOW TO FIELD 5 TO /A157 DCA RPACTIVE / CLEAR GTP 'ACTIVE' FLAG /A157 AC7777 / SET FLAG TO RETURN THE VALUES CDILP / SET TO FIELD FIVE FOR ROUTINE JMS RPPMENU / CALCULATE CURRENT PAGE VALUE TAD CURPG2 / PICK UP THOUSANDS COUNT OF PAGES JMS MNUPUT / STORE VALUE IN HIGH ORDER PAGE COUNT LINPGH-MUBUF / STATUS LINE HIGH ORDER PAGE NUMBER TAD CURPG1 / PICK UP HUNDREDS COUNT OF PAGES JMS MNUPUT / STORE VALUE IN LOW ORDER PAGE COUNT LINPGL-MUBUF / STATUS LINE LOW ORDER PAGE NUMBER JMP EIFIX / GO PUT UP THE SCREEN CONTENTS / / "GOLD:BOTTOM" COMMAND / OVRBOT= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- / DISPLAY THE GOLD BOTTOM SCREEN /D158 AC0001 / SET UP TO SHUT DOWN THE "MA" SWTCH /D158 JMS SWTHMA / DEACTIVATE MATH & SAVE ORIGINAL "MA". AC4000 DCA RPBIN1 AC0100 DCA RPBIN2 /D157 AC7777 /D157 DCA RPBOTF / [-1] MEANS GOLD BOTTOM REQUEST DCA RPPG0 / 0 = NOT AT ---TOP-- FLAG JMS CLR132 / CLEAR 132 MODE ON GOLD BOTTOM CIFMNU / CHANGE TO MENU INSTRUCTION FIELD AC0003 / SET UP FOR CLEAR SCREEN REQUEST JMS I (CALLN1) / GO TO STATUS LINE ROUTINE FOR CLEAR CIFMNU / ...GOING TO 'IOA' FOR SCREEN DISPLAYS JMS I IOACAL 0 / NO SPECIAL OUTPUT ROUTINE M2BOT / ADDR OF MESSAGE 1125 / ^P 1437 / ^P 2700 / ^P AC7777 / NEG RPBOTF MEANS DO GOLD:BOTTOM /A157 XVGOPG, DCA RPBOTF / POS RPBOTF MEANS DO GOTO-PAGE /A157 / initialize common GOLD:BOTTOM and GOTO-PAGE pointers DCA RRDIR / INDICATE THIS IS NOT GOTO-RULER /M157 TAD (55) DCA RPCUOF / POINTS AT 1ST DESCRIPTOR WORD TAD (55) DCA RPMTRL / DEFAULT RULER-BLOCK OFFSET DCA RPMTBK / NO MATH BLOCK AC0001 DCA RPCUBK / START WITH 1ST RPPGDS BLOCK AC0001 DCA RPRLHN / DEFAULT RULER IN 1ST RPPGDS BLOCK / DOING A GTP or GOLD_BOTTOM REQUEST, IGNORE GOLD-HALT WHILE / PREPARING THE SCREEN AND LOADING A RULER / NOTE: I DON'T THINK THIS IS NEEDED--MY BET IS THAT ALL /A157 / REFERENCES TO 'RPACTIVE' COULD BE DELETED! /A157 CDFLP / FIELD 5 FOR OUR FLAG AC7777 / WAS 0; SET TO 'ACTIVE' DCA RPACTIVE / SO GOLD-HALT GETS IGNORED BY HLTTST CDFMYF / BACK TO THIS FIELD JMP RPTOP / 'TOP' THE DOC THEN TO OVERLAY OVRRP2 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE TRANTP=. / TOP OF TRANSLATION PAGE /A240 M2BOT, IFDEF ENGLSH < TEXT '^P&REPOSITIONING TO BOTTOM OF DOCUMENT. ' / 1133 *.-1 TEXT '^P&PLEASE STAND BY.^P' / 1450 / 2700 > IFDEF V30NOR < TEXT '^P&MARK\XREN FLYTTES TIL BUNNEN AV DOKUMENTET. ' / 1133 *.-1 TEXT '^P&VENT.^P' / 1450 / 2700 > IFDEF V30SWE < TEXT '^P&FLYTTAR TILLBAKA TILL SLUTET AV DOKUMENTET. ' / 1133 *.-1 TEXT '^P&V\DNTA.^P' / 1450 / 2700 > IFDEF SPANISH < /A236 TEXT '^P&REAJUSTE DE PARTE INFERIOR DEL DOCUMENTO. ' / 1133 *.-1 TEXT '^P&ESPERE.^P' / 1450 / 2700 > /A236 IFDEF ITALIAN < TEXT '^P&REPOSIZIONAMENTO ALLA FINE DEL DOCUMENTO.^P&ATTENDERE.^P' > IFDEF DUTCH < TEXT '^P&OP WEG NAAR HET EINDE VAN HET DOCUMENT.' *.-1 TEXT '^P&EVEN GEDULD...^P' > M2PAGE, IFDEF ENGLSH < TEXT '^P&REPOSITIONING TO YOUR DESIRED ^S. ' / 1133 *.-1 TEXT '^P&PLEASE STAND BY.^P' / 1450 / 2700 > IFDEF V30NOR < TEXT '^P&MARK\XREN FLYTTES TIL ANGITT ^S. ' / 1133 *.-1 TEXT '^P&VENT^P' / 1450 / 2700 > IFDEF V30SWE < TEXT '^P&FLYTTAR TILLBAKA TILL \VNSKAD ^S. ' / 1133 *.-1 TEXT '^P&V\DNTA^P' / 1450 / 2700 > IFDEF SPANISH < /A236 TEXT '^P&REAJUSTE COMO DESEE ^S. ' / 1133 *.-1 TEXT '^P&ESPERE.^P' / 1450 / 2700 > /A236 IFDEF ITALIAN < TEXT '^PRIPOSIZIONAMENTO SUL^S.^P&ATTENDERE.^P' > IFDEF DUTCH < TEXT '^P&OP WEG NAAR DE GEWENSTE ^S.' *.-1 TEXT '^P&EVEN GEDULD...' > M2PAG, IFDEF ENGLSH < TEXT 'PAGE' > IFDEF V30NOR < TEXT 'SIDE' > IFDEF V30SWE < TEXT 'SIDA' > IFDEF SPANISH < TEXT 'P\AGINA' > /A236 IFDEF ITALIAN < TEXT 'LA PAGINA VOLUTA' > IFDEF DUTCH < TEXT 'PAGINA' > M2RUL, IFDEF ENGLSH < TEXT 'RULER' > IFDEF V30NOR < TEXT 'FORMATERINGSLINJE' > IFDEF V30SWE < TEXT 'LINJAL' > IFDEF SPANISH < TEXT 'REGLA' > /A236 IFDEF ITALIAN < TEXT ' DESCRITTORE RIGA VOLUTO' > IFDEF DUTCH < TEXT 'REGELINDELING' > X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE IFNZRO . /A240 /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM RPPER7= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- / JMP XPPER7 /D192 CDFEDT JMS CLR132 / 80 column mode for error display /A192 CIFMNU / CHANGE TO MENU INSTRUCTION FIELD AC0003 / SET UP FOR CLEAR SCREEN REQUEST JMS I (CALLN1) / GO TO STATUS LINE ROUTINE FOR CLEAR CIFMNU / ...GOING TO 'IOA' FOR SCREEN DISPLAYS JMS I IOACAL 0 MER7 0031 / ^P 0431 / ^P 1317 / ^P 1417 / ^P OVLJMP; RPER7B / 2ND HALF OF GOTO PAGE ERROR #7 / ========================================================================= / +++ CHANGES FOR EDIT HISTORY #176 FOR GOLD:TAB +++ / ========================================================================= / / Double Entry Point routine to process either / Gold:tab or Gold:ruler. / / OVRULR= .-OVLAY1+OVRNUM / Gold:Ruler /c176 VECFLG, DCA VECFLG / VECFLG="0" /a176 OVGLTB= .-OVLAY1+OVRNUM / Gold:Tab /a176 / VECFLG="DCA VECFLG" (Non-Zero) /a176 / PREPARE TO MODIFY RULER BY CONCATENATING ADJACENT RULERS, IF ANY. JMS RLCKNR / CHECK FOR NEW RULER JMP RLCONA / NO NEW RULER / THERE IS A NEW RULER. / CHECK FOR ADJACENT RULER. BKPPTR / BACKUP TO ECNDRL OF ADJ RULER, IF ANY JMP RLCONB / NO ADJACENT RULER TAD (-ECNDRL) / IS THERE AN ADJACENT RULER? SNA CLA JMP RLCONC / YES: CONCATENATE ADJACENT RULERS / THERE IS A NEW RULER, BUT NO ADJACENT RULER(S), SO / THERE IS NO INITIAL RULER CONCATENATION, AND / CURPTR IS RESTORED TO VALUE ON ENTRY TO OVRULR. RLCONB, TAD RLCURP DCA CURPTR JMP RLCONA / / +++ RLCONA was moved to the next page for space /m176 / / THERE ARE ADJACENT RULERS. / TO SIMPLIFY THE "DELETE RULER" FUNCTION WHICH MAY / BE INVOKED LATER, WE WILL NOW CONCATENATE THESE / ADJACENT RULERS (WHICH MAY BE DELETED IN THE PROCESS). / / WE WILL CONCATENATE ADJACENT RULERS BY MOVING THE CURSOR / BACK THEN FORWARD OVER THEM. WHEN WE DO THIS, / WE WILL FORGET THE CURRENT CURSOR LOCATION WITHIN / THE LINE, SINCE THERE IS A TINY CHANCE THAT THERE / ARE 50 OR MORE ADJACENT RULERS, AND THAT MOVING / OVER THEM WILL CAUSE DATA TO BE SCROLLED IN FROM / DISK OVER THE PLACE IN THE EDIT BUFFER CORRESPSN$. / / WE WILL CONCATRSOR LOCATION! / PARANOID, ISN'T IT? / / AT ANY RATE, THE CURSOR WILL BE LEFT AT THE / BEGINNING OF THE LINE. RLCONC, TAD LINE23 / MOVE TO BEGINNING OF THE LINE DCA CURPTR DCA CURSOR AC7777 / BACK UP CURSOR OVER ALL ADJACENT RULERS CURMOV SKP CLA / AT STX: GLIDE OVER RULER(S) TO 1ST TEXT CHAR AC0001 / ADVANCE CURSOR OVER ALL ADJACENT RULERS, CURMOV / AND CONCATENATE OR DELETE THEM. JMP RLCONA JMP RLCONA / / DELETE RULER COMMAND / OVRLDL= .-OVLAY1+OVRNUM / IF CURPTR IS AT A RULER, THEN / IF CURPTR IS AT THE FIRST RULER IN THE DOCUMENT, THEN / BEEP TO WARN THE USER; / ELSE (* NOT FIRST RULER *) / SET NWRUL := BACKWARD POINTING HALF OF RULER; / (*WHEN THIS RULER IS INSERTED AFTER THE EXISTING RULER, / THE RULER CLEAN-UP CODE WILL DELETE BOTH RULERS. / NOTE THAT IF THERE IS A NEW RULER, IT CANNOT HAVE AN / ADJACENT RULER, SINCE WE CAREFULLY CONCATENATED ANY / SUCH RULERS WHEN WE STARTED (AT OVRULR). / *) / RESTORE CURPTR TO VALUE AT TIME OF ENTRY TO OVRLDL; / ELSE (* NO NEW RULER *) / (* SAME AS "=" COMMAND *) / SET NWRUL := CURUL; / GOTO DISPLAY NWRUL AND ACCEPT RULER EDITING COMMAND JMS RLCKNR / CHECK FOR EXISTING RULER JMP RLOJER / NONE: SAME AS "=" BKPPTR / AT STX? JMP RLDLER / YES: AT FIRST RULER, CAN'T DELETE IT ADVPTR / NO: RESTORE CURPTR NOP / (AT ETX--THAT'S OK) CLA / FORGET ECSTRL IN AC FROM ADVPTR JMS SETRUL / SET NWRUL FROM BACKWARDS POINTING / HALF OF EXISTING RULER ESADRL / (GET RULER CHAR ROUTINE) RLDL2, TAD RLCURP / RESTORE CURPTR DCA CURPTR OVLJMP / GO DISPLAY RULER AND WAIT FOR CMD OVDRUL / THERE IS NO NEW RULER IN TEXT TO DELETE, SO / JUST AVOID INSERTING A NEW ONE. RLOJER, OVLJMP / PERFORM "=" COMMAND OVERUL / ERROR: ATTEMPT TO DELETE FIRST RULER IN DOCUMENT RLDLER, JMS BEEPER / CHASTISE USER SEVERELY JMP RLDL2 / EXIT, LEAVING THINGS AS THEY WERE / / SUBR RLCKNR -- CHECK FOR NEW RULER JUST BEFORE CURRENT LINE / / CALL: / CLA / JMS RLCKNR / CHECK FOR NEW RULER / / / JMP NORULR / NONE THERE. / / 'CURPTR' AND 'CURSOR' ARE UNCHANGED. / / / JMP RULR / FOUND NEW RULER. / / 'CURPTR' POINTS TO START OF RULER / / (ANOTHER RULER MAY IMMEDIATELY / / PRECEED 'CURPTR'). / / 'CURSOR' IS UNCHANGED. / / 'RLCURP' = VALUE OF 'CURPTR' ON / / ENTRY TO RLCKNW. / / ON ALL EXITS, AC=0, DF=CDFBUF / RLCKNR, XX / CHECK FOR NEW RULER TAD CURPTR / SAVE 'CURPTR' (STILL SAME VALUE AS BEFORE DCA RLCURP / USER HIT GOLD:RULER). / THIS IS NEEDED SO THAT IF RULER IS NOT / MODIFIED, CURSOR CAN BE RESTORED TO / WHERE IT WAS BEFORE GOLD:RULER CMD. TAD LINE23 / MOVE TO START OF LINE DCA CURPTR BKPPTR / MOVE TO END OF RULER, IF ANY JMP RLCKNB / (HIT TOP, NO RULER) TAD (-ECNDRL) / IS A RULER THERE? SNA CLA JMP RLCKNA / YES RLCKNB, TAD RLCURP / NO: RESTORE CURPTR DCA CURPTR JMP I RLCKNR / TAKE "NO NEW RULER" RETURN / THERE IS A NEW RULER. / BACKUP TO START OF NEW RULER. RLCKNA, BKPPTR HLT / BUG (BROKEN RULER--MISSING ECSTRL) TAD (-ECSTRL) / AT START OF RULER? SZA CLA JMP RLCKNA / NO: BACKUP UNTIL WE ARE / CURPTR IS AT START OF NEW RULER. (IGNORE POSSIBILITY / THAT ANOTHER NEW RULER MAY IMMEDIATELY PRECEED CURRENT / NEW RULER.) ISZ RLCKNR / TAKE "FOUND NEW RULER" RETURN JMP I RLCKNR RLCURP, 0 / VARIABLE: SAVE CURPTR / /M155 / CONTINUATION OF CODE TO GET TO ---TOP--- /M155 / /M155 OVRPTP= .-OVLAY1+OVRNUM /M155 JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS /M155 /M155 AC0001 /M155 MQL / MAIN HEADER BLOCK /M155 TAD (53) /M155 JMS DSKCAL / INITIALIZE SCTOP & SCBOT TO /M155 XRPRD / BE 52 & 53 RESPECTIVELY /M155 /M155 / INITIALIZE BUFFER AND SCREEN /M155 /M155 /D155 JMS RPOVIN / CLEAR EDIT BUFFER AND PTRBLK /M155 JMS SWTHMA / TAKE CARE OF MATH-FLAG SETTINGS /M155 /M155 CDFSYS / GET TO FIELD 0 TO /M155 DCA I HLTFLG / CLEAR A POSSIBLE GOLD-HALT FLAG /M155 CDFLP / NOW TO FIELD 5 TO /M155 DCA RPACTIVE / CLEAR GTP 'ACTIVE' FLAG /M155 CDFMYF / BACK TO THIS FIELD /M155 /M155 JMS LODCHR / GET FIRST CHAR (RULER) /M155 NOP /M155 /M155 AC0001 / SET UP FOR PAGE NUMBER ONE /M155 JMS MNUPUT / STORE LOW ORDER PAGE NUMBER /M155 LINPGL-MUBUF / STATUS LINE LOW ORDER PAGE NUMBER /M155 /M155 JMS MNUPUT / CLEAR HIGH ORDER PAGE NUMBER /M155 LINPGH-MUBUF / STATUS LINE HIGH ORDER PAGE NUMBER /M155 /M155 AC0001 / SET UP TO INDICATE FIRST LINE OF FILE /M155 JMS MNUPUT / STORE NEW LINE NUMBER /M155 LINNUM-MUBUF / LOCATION OF LINE NUMBER IN MENU FIELD /M155 /M155 AC0001 / SET UP TO INDICATE STATUS HAS CHANGED /M155 JMS MNUPUT / STORE VALUE IN STATUS CHANGE FLAG /M155 LINDIF-MUBUF / STATUS CHANGE FLAG IN MENU FIELD /M155 JMP EIFIX / FIX UP SCREEN AND GET NEXT CHARACTER /M155 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / ========================================================================= / +++ MOVED HERE PER EDIT #176 +++ / ========================================================================= / / PREPARE TO EDIT RULER. RLCONA, CDFMYF TAD SPLTFL / KEEP A COPY OF SPLTFL DCA WIDPRV JMS RLEQTE / EQUATE THIS RULER TO OLD ONE JMS FXSCRL / GET SCREEN UP TO DATE TAD CURSOR / GET CURRENT CURSOR POSN. DCA CURSAV / SAVE. / TAD VECFLG / SAVE VECFLG FOR OTHER ROUTINES /a176 JMS MNUPUT / (PUT IT IN THE MENU FIELD) /a176 MNTMP1 /a176 TAD VECFLG / HOW DID WE GET HERE /a176 SZA CLA /a176 JMP RLCOND / GOLD:TAB /a176 / OVLJMP / GOLD:RULER OVXRL1 / RLCOND, OVLJMP /a176 OVINTB /a176 MER7, (0) / GIVES PE ERROR IF XLATIONS O/F /A236 IFDEF ENGLSH < TEXT '^P-- !&GO-!&TO-!&PAGE !&ERROR -- ' / 0031 *.-1 TEXT '^P&YOUR PAGE WAS NOT FOUND. ' / 0431 *.-1 TEXT '^P&YOU MAY USE A !&GO-!&TO-!&PAGE REQUEST, BUT ONLY ' / 1317 *.-1 TEXT '^PENTER A PAGE NUMBER WITHIN THE RANGE OF PAGES ' / 1417 > IFDEF V30NOR < TEXT '^P-- &FEIL I !&G\E-!&TIL-!&SIDE -- ' / 0031 *.-1 TEXT '^P&FANT IKKE ANGITT SIDE. ' / 0431 *.-1 TEXT '^P&N\ER DU BRUKER FUNKSJONEN !&G\E-!&TIL-!&SIDE, M\E DU ' / 1317 *.-1 TEXT '^PANGI ET SIDETALL SOM FINNES I DETTE ' / 1417 > IFDEF V30SWE < TEXT '^P-- "!&G\E-!&TILL-!&SIDA"-FEL -- ' / 0031 *.-1 TEXT '^P&DEN SIDAN KUNDE INTE HITTAS ' / 0431 *.-1 TEXT '^P&DU KAN S\VKA EN SIDA MED HJ\DLP AV "!&G\E-!&TILL-!&SIDA", MEN ENDAST ' *.-1 TEXT '^POM DU SKRIVER ETT SIDNUMMER SOM INTE \VVERSKRIDER DET ANTAL SIDOR ' / 1417 > IFDEF SPANISH < /A236 TEXT '^P-- !&IR-!&A-!&ERROR !&PAGINA -- ' / 0031 *.-1 TEXT '^P&IMPOSIBLE ENCONTRAR SU P\AGINA. ' / 0431 *.-1 TEXT '^P&PUEDE USAR EL PEDIDO DE !&IR-&A-!&PAGINA, PERO S\SLO '/ 1317 *.-1 TEXT '^PTECLEE UN N\ZMERO DE P\AGINA DENTRO DEL MARGEN DE P\AGINAS ' / 1417 > /A236 IFDEF DUTCH < /A236 TEXT '^P-- !&FOUT !&BIJ !&ZOEKEN !&PAGINA -- ' / 0031 *.-1 TEXT '^P&PAGINA NIET GEVONDEN ' / 0431 *.-1 TEXT '^P&GEBRUIK ALLEEN PAGINA-NUMMERS BINNEN DE GRENZEN '/ 1317 *.-1 TEXT '^PVAN HET DOCUMENT. ' / 1417 > /A236 IFDEF ITALIAN < TEXT '^P-- !&ERRORE !&DI !&RICERCH !&PAGINA -- ' *.-1 TEXT '^P&LA PAGINA RICHIESTA NON \H STATA TROVATA. ' *.-1 TEXT '^P&\H POSSIBILE EFFETTUARE UN !&CERCA !&PAGINA SOLO ' *.-1 TEXT '^PINTRODUCENDO UN NUMERO DI PAGINA MINORE O UGUALE AL ' > X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM RPER7B= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- / JMP XPER7B RPCHKREPLY, / RETURN-KEY only valid terminator FOR INPUT /M154 CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL 0 MER7B 1517 / ^P 1717 / ^P 2017 / ^P 2700 / ^P /D154 JMS CLREOL / done, when needed, by BEEPER CIFMNU / menu-field (fix to automatic exit-problem)/A154 JMS I INACAL / get reply to PAGE NOT FOUND msg. ER7BUF / arg 1 SKP / for normal INA return TAD (EDNWLN) / for special INA return TAD (-EDNWLN) / look for RETURN key SZA CLA / skip if valid-input JMP CHKAGAIN / inform user of invalid-input JMS SET132 / SET TO 132 COL. MODE IF WIDE FLAG SET /A192 TAD RPPG0 / ---TOP-- DOC. FLAG SZA CLA / SKIP IF NOT PAGE0 PROBLEM JMP RPOVRT / JUMP IF BEYOND --TOP-- / INPUT PAGE # WAS TOO LARGE. BACKUP TO DESC. CONTAINING / LAST AVAILABLE PAGE AND GOTO IT... FIXPTR, AC7777 / BACKUP 1 DESCRIPTOR WORD CIFLP / LP FIELD JMS ADJUS0 / CHECKING RPCUOF FOR <55 OR <2 TAD RPCUBK / CURRENT HDR # MQL AC7776 / FC TO SET SCTOP AND SCBOT TAD RPCUOF / IDENTIFIES CURRENT BLOCK JMS DSKCAL / SET TO DESIRED BLOCK/ HDR # XRPRD / GTP ENTRY POINT CDFMYF AC7777 / FC TO READ A DESC. JMS DSKCAL XRPRD CDFMYF / BACK TO THIS FIELD MQL / SAVE CONTENTS OF DESC. TAD RULFLG / IF POSITIVE SPA CLA / LOOKING FOR PAGE JMP TSTRUL / ELSE LOOKING FOR RULER ACL / RETRIEVE CURRENT DESC. WRD AND (37) / SAVE # OF PAGES IN THIS BLOCK SNA CLA / SKIP IF PAGES IN THIS BLOCK JMP FIXPTR / NO PAGES, FIND LAST ONE TAD RPCUBK DCA CUBKTMP / SAVE HDR ID # FOR LAST PG TAD RPCUOF DCA CUOFTMP / AND OFFSET FOR LAST PG AC7777 DCA RULFLG / INDICATE PG FOUND, LOOK FOR VALID RULER JMP FIXPTR TSTRUL, ACL / RETRIEVE DESC. AND (4000) / RULER IN THIS DESC??? SNA CLA / SKIP W/ RULER JMP FIXPTR / BACK UP ANOTHER TAD RPCUOF / CURRENT OFFSET FOR RULER DCA RPMTRL / LATEST RULER TAD RPCUOF DCA RPMTBK / SAME AS PREVIOUS RULER TAD RPCUBK / HDR ID # FOR RULER DCA RPRLHN / LATEST RULER HDR TAD RPCUBK DCA RPPRRL / PREVIOUS RULER HDR TAD CUBKTMP DCA RPCUBK / RESTORE PAGE HDR ID # TAD CUOFTMP DCA RPCUOF / AND PAGE OFFSET TAD RPCUBK / HDR ID # MQL AC7776 / F.C. TO SET SCTOP & SCBOT TAD RPCUOF / BLK CONTAINING DESIRED PG JMS DSKCAL XRPRD / GTP ENTRY PT CDFMYF OVLJMP; OVRPRL / REPAINT SCREEN--THEN EXIT BACK TO EDITOR RULFLG, 0 / + = LOOKING FOR LAST PAGE / - = LOOKING FOR VALID RULER CUBKTMP, 0 / PAGE HDR ID # TMP STORAGE CUOFTMP, 0 / PAGE OFFSET TMP STORAGE RPOVRT, DCA RPPG0 / CLEAR ---TOP--- FLAG TO RESUME OVLJMP;OVRPZZ / RESUME EDIT AT ---TOP--- /M158 ER7BUF, -1 ZBLOCK 1 CHKAGAIN, / input wasn't RETURN key JMS BEEPER / inform the user JMP RPCHKREPLY / do until RETURN key X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE MER7B, (0) IFDEF ENGLSH < TEXT '^PCONTAINED IN THIS DOCUMENT, OR ' / 1517 *.-1 / 1717 TEXT '^P&YOU MAY USE &GOLD !&BOT !&DOCMT OR &GOLD !&ADVANCE TO UPDATE ' *.-1 TEXT '^PTHE RANGE OF PAGES FOR THIS DOCUMENT. ' / 2017 *.-1 TEXT '^P&BUT FIRST PRESS !&RETURN TO CONTINUE. ' / 2700 > IFDEF V30NOR < TEXT '^PDOKUMENTET. &DU KAN OGS\E BRUKE ' / 1517 *.-1 / 1717 TEXT '^P&GULL !&BUNN EL. &GULL !&FREM FOR \E AJOURF\XRE ' *.-1 TEXT '^PANTALL SIDER I DETTE DOKUMENTET. ' / 2017 *.-1 TEXT '^P&TRYKK P\E !&RETUR FOR \E FORTSETTE. ' / 2700 > IFDEF V30SWE < TEXT '^PSOM FINNS I DETTA DOKUMENT. &DU KAN OCKS\E ANV\DNDA GULD SLUT DOK ' / 1517 *.-1 / 1717 TEXT '^P&ELLER GULD FRAM\ET F\VR ATT \DNDRA ANTAL SIDOR I DETTA ' *.-1 TEXT '^PDOKUMENT. ' / 2017 *.-1 TEXT '^P&TRYCK F\VRST P\E RETUR F\VR ATT FORTS\DTTA ' / 2700 > IFDEF SPANISH < /A236 TEXT '^PCONTIEN ESTE DOCUMENTO, O ' / 1517 *.-1 / 1717 TEXT '^P&PUEDE USAR &DORADA !&FINAL !&DOCUMENTO O &DORADA !&ADELANTE PARA ' *.-1 TEXT 'PONER AL D\MA ' *.-1 TEXT '^PLAS P\AGINAS PARA ESTE DOCUMENTO SON. ' / 2017 *.-1 TEXT '^P&PERO PRIMERO PULSE !&RETORNO PARA CONTINUAR. ' / 2700 > /A236 IFDEF DUTCH < /A236 TEXT '^P ' / 1517 *.-1 / 1717 TEXT '^P&DEZE FUNCTIE WERKT NIET MET DOCUMENTEN ' *.-1 TEXT '^PAANGEMAAKT MET VORIGE VERSIES VAN !&WPS. ' *.-1 TEXT '^P&DRUK OP !&RETURN OM VERDER TE GAAN. ' / 2700 > /A236 IFDEF ITALIAN < TEXT '^PNUMERO DELLE PAGINE DI CUI \H COMPOSTO IL DOCUMENTO. ' *.-1 TEXT '^P&OPPURE \H POSSIBILE USARE &ORO !&FINE !&DOCUMEN OPPURE ' *.-1 TEXT '^P&ORO !&AVANTI PER AGGIORNARE LA NUMERAZIONE DELLE PAGINE. ' *.-1 TEXT /^P&PRIMA PER\R PREMERE !&RITORNO PER CONTINUARE L'OPERAZIONE./ > X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** RELOC RELOC OVLAY1 OVRNUM= OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED OVRNUM OVSSTP= .-OVLAY1+OVRNUM /SETUP COLUMN STRIP PARAMETERS JMP ESSSTP / ESCLPS COLUMNAR PASTE / / OVCLPS= .-OVLAY1+OVRNUM ESCLPS, JMS FNCLLM /FIND THE LIMITS OF THE COLUMN IN WHICH /PASTE DCA PSBFOF /CLEAR PASTE FLAG JMS SETPST TAD (-PSTEBG) /FIRST BLOCK OF PASTE BUFFER ONLY BLOCK? TAD PSTBLK JMP ESCP01 / ESCLCT COLUMNAR CUT / / OVCLCT= .-OVLAY1+OVRNUM ESCLCT, JMS SETCUT /INITIALIZE COLUMNAR CUT VARIABLES CDFMYF TAD (DCA I CURPTR) /SET FOR CUT NOT COPY JMP ESCLCX /GO JOIN COMMON CODE /A213 /D213 DCA CLCTSW /D213 OVLJMP /GO DO CUT /D213 OVDOCC / ESCLGC COLUMNAR GOLD CUT / / OVCGCT= .-OVLAY1+OVRNUM ESCLGC, JMS SETCUT /INITIALIZE COLUMNAR CUT VARIABLES CDFMYF TAD (CLA) /SET TO COPY NOT CUT ESCLCX, DCA CLCTSW /C213 OVLJMP /GO DO CUT OVDOCC / CLCTER COLUMNAR CUT ERROR PROCESSING / / CLCTER, CLA JMS BEEPER /RING DA BELL JMP UNSLCT /AND UNSELECT THE TEXT / FNCLLM FIND COLUMN LIMITS / / THIS ROUTINE WILL FIND THE UPPER AND LOWER CHARACTER POSITION / LIMITS OF A COLUMN; RELATIVE TO THE CURRENT CURSOR POSITION. / / INPUTS ARE CURPTR POINTING TO A CHARACTER OR TRAILING TAB FOR THE / DESIRED COLUMN. / FNCLLM, XX /ENTRY POINT FCLM01, BKPSPC /SEARCH BACKWARDS FOR THE BEGINNING OF THE /BEGINNING OF THE COLUMN OR FOR AN INVALID /CONDITION JMP FCLM03 /START OF FILE IS LEGAL COLUMN BOUNDARY BUT /SHOULD NEVER HAPPEN DUE TO INITIAL RULER AND P177 /STRIP THE MODE BITS FOR COMPARISONS ZZCASE /MATCH AGAINST SPECIAL CHARACTERS FCLTB1-1 / ECNWLN; FCLM04 /NEW LINE COULD BE COLUMN DELIMITER / ECNWPG; FCLM07 /NEW PAGE IS COLUMN DELIMITER / ECNDRL; FCLM06 /END RULER IS COLUMN DELIMITER / ECTAB; FCLM05 /TAB IS COLUMN DELIMITER / ECMDFL; FCLM01 /MODIFIED FLAG IS BOGUS CHAR SO SKIP / 0 AC7777 /NO MATCH SO DECREMENT CURSOR POSITION TAD CURSOR SPA /SHOULD NEVER GET BELOW POSITION ZERO JMP CLCTER /DID GO TO NEGATIVE POSITION SO ERROR DCA CURSOR /SAVE UPDATED CURSOR JMP FCLM01 /AND TRY AGAIN FCLM06, ADVSPC /POSITION BAK AT FIRST CHAR AFTER END RULER/C213 NOP CLA /ELIMINATE UNWANTED CHARACTER VALUE /A213 JMP FCLM08 /C213 FCLM04, TAD I CURPTR /CHECK THAT THE NEW LINE IS A HARD RETURN TAD (-ECNWLN) SZA CLA JMP CLCTER /NOT A CARRIAGE RETURN SO ERROR FCLM07, ADVSPC /ADVANCE OVER THE CHARACTER NOP /SHOULD NEVER HAPPEN BUT REALLY DON'T CARE AC7777 /BACKUP KEEPING PTRBLK HAPPY CURMOV HLT /HAVE ALREADY BEEN AT THIS CHAR SO NO END OF /FILE IS POSSIBLE. JMP FCLM02 FCLM05, AC7777 /dec cursor pos TAD CURSOR DCA CURSOR FCLM02, AC0001 /POSITION AT FIRST CHAR IN COLUMN FCLM08, CURMOV /SET CURSOR POSITION /C213 NOP FCLM03, CLA /MAKE SURE EVERYTHING OK TAD CURSOR /AND SEE IF THERE IS A TAB STOP HERE JMS GTRLCD DCA T2 /SAVE RULER CODE TAD T2 TAD (FCLJTB-1) /BUILD JUMP ADDRESS DCA T1 TAD I T1 DCA T1 JMP I T1 /GO DO APPROPRIATE / FCLMRJ /"-" DO RIGHT JUSTIFIED / FCLMRJ /"." DO RIGHT JUSTIFIED / FCLMRJ /">" DO RIGHT JUSTIFIED / FCLMLJ /"T" DO LEFT JUSTIFIED / FCLMLJ /"L" DO LEFT JUSTIFIED / FCLMRJ /"R" DO RIGHT JUSTIFIED / FCLMLJ /"D" DO LEFT JUSTIFIED / FCLMRJ /"J" DO RIGHT JUSTIFIED / FCLMLJ /"W" DO LEFT JUSTIFIED / FCLMLJ /"P" DO LEFT JUSTIFIED / FCLMRJ /"C" DO RIGHT JUSTIFIED / FCLMLJ /"N" DO LEFT JUSTIFIED / FCLMRJ /"H" DO RIGHT JUSTIFIED / FCLMLJ /"F" DO LEFT JUSTIFIED / FCLMLJ FIND COLUMN LIMITS FOR LEFT JUSTIFIED TAB / / BEGIN; / TEMP:=CLMPLL:=CURSOR; / WHILE( CURUL[TEMP+1] <> NOSTOP OR / CURUL[TEMP+1] <> HSTOP OR / CURUL[TEMP+1] <> CSTOP) TEMP:=TEMP+1; / CLMPUL:=TEMP; / END; / FCLMLJ, TAD CURSOR /GET CURRENT POSITION DCA CLMPLL /SAVE AS COLUMN LOWER LIMIT TAD CLMPLL /SET UP COUNTER TO FIND UPPER LIMIT DCA T1 FCLLJ1, AC0001 /EXAMINE FOLLOWING TAB STOP TAD T1 JMS GTRLCD ZZCASE /MATCH AGAINST NON-TABS FCLTB2-1 / 1; FCLLJ2 /"-" / 12; FCLLJ2 /"C" / 14; FCLLJ2 /"H" / 0 TAD T1 /SAVE UPPER LIMIT DCA CLMPUL JMP I FNCLLM /DONE! / / FCLLJ2, ISZ T1 /BUMP TO NEXT POSITION JMP FCLLJ1 /AND TRY NEXT / FCLMRJ FIND COLUMN LIMITS FOR RIGHT JUSTIFIED TAB STOP / / / BEGIN; / TEMP:=CURSOR; / WHILE( CURUL[TEMP-1] = NOSTOP OR / CURUL[TEMP-1] = CSTOP OR / CURUL[TEMP-1] = HSTOP) TEMP:=TEMP-1; / IF CURUL[TEMP-1] = RIGHT.MARGIN OR / CURUL[TEMP-1] = RIGHT.JUST.STOP THEN TEMP:=TEMP+1; / CLMPLL:=TEMP; / TEMP:=CURSOR-1; / SEEN.DECIMAL.FLAG=FALSE; / WHILE( CURUL[TEMP+1] = NOSTOP OR / CURUL[TEMP+1] = CSTOP OR / CURUL[TEMP+1] = HSTOP OR / ( CURUL[TEMP+1 = DECIMAL.STOP AND / SEEN.DECIMAL.FLAG = FALSE)) / BEGIN; / TEMP:=TEMP+1; / IF CURUL[TEMP] = DECIMAL.STOP THEN / SEEN.DECIMAL.FLAG = TRUE; / END; / CLMPUL:=TEMP; / END; / FCLMRJ, DCA FTHRU /FIRST TIME THRU FLAG TAD CURSOR /SETUP FOR BACK COUNT DCA T1 FCLRJ1, AC7777 /DECREMENT COUNT TAD T1 /AND CHECK PREVIOUS POSITION SPA /IF IT GOES BELOW ZERO THEN DEEP SHIT JMP CLCTER /ERROR, ERROR, DIVE! DIVE! DIVE! JMS GTRLCD TAD (FCLJT3-1) /BUILD PTR TO PROCESSING LOCATION DCA T2 TAD I T2 DCA T2 JMP I T2 /AND EXECUTE / FCLRJ2 /"-" / FCLRJ3 /"." / FCLRJ4 /">" / FCLRJ3 /"T" / FCLRJ3 /"L" / FCLRJ2 /"R" / FCLRJ3 /"D" / FCLRJ2 /"J" / FCLRJ3 /"W" / FCLRJ3 /"P" / FCLRJ2 /"C" / FCLRJ3 /"N" / FCLRJ2 /"H" / FCLRJ3 /"F" FCLRJ4, ISZ FTHRU JMP FCLRJ2 AC0001 /INCREMENT POSITION FCLRJ3, TAD T1 /SAVE POSITION AS LOWER LIMIT DCA CLMPLL AC7777 /STARTING FROM CURSOR POS -1 TAD CURSOR /EXAMINE FOR UPPER LIMIT DCA T1 DCA T3 /CLEAR DECIMAL POINT TAB SEEN FLAG FCLRJ5, AC0001 /EXAMINE FOLLOWING TAB STOP TAD T1 JMS GTRLCD ZZCASE /MATCH AGAINST NON-TABS FCLTB3-1 / 1; FCLRJ6 /"-" / 2; FCLRJ7 /"." / 12; FCLRJ6 /"C" / 14; FCLRJ6 /"H" / 0 FCLRJ8, AC0002 TAD T1 /SAVE UPPER LIMIT DCA CLMPUL JMP I FNCLLM /DONE! FTHRU, ZBLOCK 1 X=. /--------------------- PAGE / / FCLRJ2, AC7777 /DECREMENT POSITION AND TRY AGAIN TAD T1 DCA T1 AC7777 DCA FTHRU JMP FCLRJ1 FCLRJ7, TAD T3 /FIRST TIME THROUGH? SZA JMP FCLRJ8 /NO, FINISH UP ISZ T3 /SET FLAG FCLRJ6, ISZ T1 /BUMP TO NEXT POSITION JMP FCLRJ5 /AND TRY NEXT / GTRLCD GET RULER CODE / / THIS ROUTINE IS PASSED A VALUE CORRESPONDING TO A POSITION IN THE / CURRENTLY ACTIVE RULER. IT RETURNS THE TAB STOP TYPE CODE FOR THE / DESIGNATED POSITION. / / CALL: / / (AC := POSITION IN RULER) / JMS GTRLCD / / GTRLCD, XX /ENTRY POINT CLL RAR /DIVIDE BY TWO SAVE ODD FLAG TAD (CURUL) /BUILD PTR TO RULER CODE CDFMYF DCA GRCTMP /SAVE PTR FOR ACCESS TAD I GRCTMP /AND ACCESS RULER SNL /HIGH BYTE OR LOW? BSW /HIGH BYTE SO SWAP AND P77 /MASK CODE JMP I GTRLCD /RETURN GRCTMP, ZBLOCK 1 / SETCUT SETUP COLUMNAR CUT VARIABLES / / SETCUT, XX /ENTRY POINT TSTSLT /IN SELECT MODE? JMP EIBAD /NO, ERROR! ERROR! THAT DOES NOT COMPUTE! JMS FNCLLM /GO FIND COLUMN LIMITS TAD CLMPLL /SELECT >= LOWER LIMIT? CIA TAD SLCRPT SPA CLA JMP CLCTER /NEGATIVE NEGATIVE DIE! TAD SLCRPT /SELECT <=UPPER LIMIT? CIA TAD CLMPUL SPA CLA JMP CLCTER /NFW BADASS TAD (PSTEBG) /SET BEGINNING BLOCK NUMBER DCA PSTBLK DCA PSBFOF /CLEAR BUFFER OVERFLOW FLAG JMS SETPST /SETUP PASTE BUFFER I/O JMP I SETCUT /RETURN / ESCP01 SETUP PASTE BUFFER FOR PASTE / / ESCP01, SNA CLA JMP ESCP02 /YES TAD (PSTEBG) /SETUP PASTE BUFFER AND READ IN FIRST BLOCK DCA PSTBLK TAD (RXERD) JMS PSTIO ESCP02, JMS OV2JMP /DO THE PASTE OVDOPS / SETUP COLUMN STRIP PARAMETERS / / ESSSTP, JMS SETCUT JMP OVJRTN / COLUMNAR CUT SETUP CASE TABLES / / FCLTB1, ECNWLN; FCLM04 /NEW LINE COULD BE COLUMN DELIMITER ECNWPG; FCLM07 /NEW PAGE IS COLUMN DELIMITER ECNDRL; FCLM06 /END RULER IS COLUMN DELIMITER ECTAB; FCLM05 /TAB IS COLUMN DELIMITER ECMDFL; FCLM01 /MODIFIED FLAG IS BOGUS CHAR SO SKIP 0 FCLTB2, 1; FCLLJ2 /"-" 12; FCLLJ2 /"C" 14; FCLLJ2 /"H" 0 FCLTB3, 1; FCLRJ6 /"-" 2; FCLRJ7 /"." 12; FCLRJ6 /"C" 14; FCLRJ6 /"H" 0 / COLUMNAR CUT SETUP JUMP TABLES / / FCLJTB, FCLMRJ /"-" DO RIGHT JUSTIFIED FCLMRJ /"." DO RIGHT JUSTIFIED FCLMRJ /">" DO RIGHT JUSTIFIED FCLMLJ /"T" DO LEFT JUSTIFIED FCLMLJ /"L" DO LEFT JUSTIFIED FCLMRJ /"R" DO RIGHT JUSTIFIED FCLMLJ /"D" DO LEFT JUSTIFIED FCLMRJ /"J" DO RIGHT JUSTIFIED FCLMLJ /"W" DO LEFT JUSTIFIED FCLMLJ /"P" DO LEFT JUSTIFIED FCLMRJ /"C" DO RIGHT JUSTIFIED FCLMLJ /"N" DO LEFT JUSTIFIED FCLMRJ /"H" DO RIGHT JUSTIFIED FCLMLJ /"F" DO LEFT JUSTIFIED FCLJT3, FCLRJ2 /"-" FCLRJ3 /"." FCLRJ4 /">" FCLRJ3 /"T" FCLRJ3 /"L" FCLRJ2 /"R" FCLRJ3 /"D" FCLRJ2 /"J" FCLRJ3 /"W" FCLRJ3 /"P" FCLRJ2 /"C" FCLRJ3 /"N" FCLRJ2 /"H" FCLRJ3 /"F" PAGE RELOC /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** RELOC RELOC OVLAY1 OVRNUM= OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED OVRNUM CLCTDN= X5 TBCTFL= X4 / OVDOER DO COLUMN ERROR HANDLING / / OVDOER= .-OVLAY1+OVRNUM CCDOER, JMP DOCCER / ESDOCC DO COLUMN CUT/COPY / / OVDOCC= .-OVLAY1+OVRNUM ESDOCC, TAD CLCTSW /SET FOR CUT OR COPY DCA CONCTC /CUTTING CHARACTERS / / THE LOCATION CONCTC IS LOADED WITH A DCA I CURPTR OR / A CLA DEPENDING ON WHETHER THE TEXT IS TO BE CUT TO / THE PASTE BUFFER OR COPIED. / DCA CLCTDN /CLEAR DONE FLAG OVDCC5= .-OVLAY1+OVRNUM DOCC05, TAD (ECTMRK) /MARK THE BEGINNING OF THE COLUMN JMS INSERT DCA TBCTFL /CLEAR TAB CUT FLAG ADVPTR /SKIP OVER THE MARK JMP DOC1ER /ERROR PREMATURE EOF TAD (-ECSLPT) /IS IT A SELECT POINT AT BEGINNING OF COLUMN SZA CLA JMP DOCC24 /NO GO PROCESS ISZ CLCTDN /YES, SO MARK LAST COLUMN DCA I CURPTR /CLEAR IT OUT OF THE TEXT BUFFER BKPPTR /KILL THE MARKER HLT CLA DCA I CURPTR SLNMOD /REJUSTIFY THE LINE JMS REJUST JMP DOCC05 /AND START PROCESSING AT THE BEGINNING OF /THE COLUMN DOCC24, TAD I CURPTR JMP DOCC23 DOCC01, ADVSPC /FORWARD SPACE UNTIL AN END OF COLUMN /DELIMITER IS FOUND JMP DOCC06 /END OF FILE - TREAT AS END OF LINE /C218 DOCC23, AND P177 /STRIP MODE BITS ZZCASE /MATCH AGAINST DELIMITERS DCCTB1-1 / ECNWLN; DOCC03 /NEW LINE COULD BE / ECNWPG; DOC1ER /NEW PAGE HERE IS ERROR / ECSTRL; DOC1ER /START RULER ALWAYS ERROR / ECTAB; DOCC02 /TAB IS GOOD BOY / ECMDFL; DOCC01 /SKIP MODIFIED FLAG / 0 ISZ CURSOR /BUMP CURSOR COUNT JMP DOCC01 /AND TRY NEXT CHAR DOCC03, TAD I CURPTR /CHECK EOL CHAR TAD (-ECNWLN) /HARD RETURN BONAFIDE SNA JMP DOCC02 /GOOD BOY GO CUT TAD (ECNWLN-ECSLPT) /SELECT POINT? SZA CLA JMP DOC1ER /NOPE ERROR ERROR DCA I CURPTR /DELETE SELECT POINT DCA CURSOR /RESET POINTER /A201 ISZ CLCTDN /SET DONE FLAG JMP DOCC01 /AND FETCH NEXT CHAR DOCC02, CDFMYF TAD CURSOR /CHECK POSITION AGAINST UPPER LIMIT CIA TAD CLMPUL SPA CLA /IF CLMPUL >= CURSOR THEN OK JMP DOC1ER /ERROR YOU GRAVY SUCKING PIG JMS LODCHR /GET EOC CHAR HLT /EOF CAN'T BE HERE TAD (-ECTAB) /IF TAB DO CUT OPERATION SZA CLA JMP DOCC06 /DON'T CUT HARD RETURN JMS CUTNOT /CUT OR COPY ISZ TBCTFL /SET EOC TAB CUT FLAG DOCC06, TAD (ECTMRK) /MARK END OF COLUMN JMS INSERT DOCC09, BKPPTR /FIND BEGINNING OF COLUMN MARK HLT /CAN'T HAPPEN UNLESS TOTALLY CORRUPTED TAD (-ECTMRK) /FOUND MARKER? SZA CLA JMP DOCC09 /NO, PERSEVERE THEN TAD TBCTFL /CHECK FOR A TAB CUT? SZA CLA JMP DOCC07 /YES EVERYTHING IS HUNKY DORY DOCC19, BKPPTR /SEE IF PREVIOUS TAB TO CUT JMP DOCC08 /NO, NEVER GETS HERE ANYWAY ZZCASE DCCTB2-1 / ECTAB; DOCC20 /YES GO DO IT / ECNWLN; DOCC08 / ECNWPG; DOCC08 / ECNDRL; DOCC08 / 0 JMP DOCC19 DOCC20, JMS CUTNOT /CUT OR COPY DOCC08, ADVPTR /FIND THE MARK AGAIN HLT TAD (-ECTMRK) SZA CLA JMP DOCC08 DOCC07, DCA I CURPTR /KILL THE MARKER DOCC10, ADVPTR /GET CHARACTER HLT /NO WAY TAD (-ECTMRK) /END OF COLUMN? SNA CLA JMP DOCC11 /YES, GO FINISH UP THE COLUMN TAD I CURPTR /REFETCH CHAR DCA T1 /SAVE CHAR JMS CUTNOT /CUT OR COPY TAD T1 /GET CHAR JMS PUTPST /PUT IT TO PASTE BUFFER JMP DOCC10 /DO NEXT CHARACTER JMP DNCCOV /BUFFER OVERFLOW GO CLEAN UP /D203 OVDC11= .-OVLAY1+OVRNUM DOCC11, DCA I CURPTR /KILL END MARKER OVDC12= .-OVLAY1+OVRNUM /A203 DOCC12, TAD (ECNWLN) /PUT COLUMN MARKER IN PASTE BUFFER /C203 JMS PUTPST SKP CLA /PUT AWAY OK SKIP ERROR RETURN JMP DNCCOV /BUFFER OVERFLOW GO CLEAN UP TAD LINE23 /SETUP AND REJUSTIFY THE LINE DCA CURPTR DCA CURSOR SLNMOD JMS REJUST CLA /SEE IF THAT WAS LAST COLUMN TAD CLCTDN SZA CLA JMP DONCCT /YES, HURRAY!!!!! JMS OV2JMP OVDCEL X=. /--------------------- PAGE / DOC1ER ERROR HANDLING AFTER COLUMN FOUND / / DOC1ER, TAD LINE23 /SEARCH FOR THE MARKER TO DELETE DCA CURPTR /FROM THE BEGINNING OF THE LINE DCA CURSOR SKP /DON'T FORWARD SPACE THE FIRST TIME DOC1E1, AC0001 /SEARCH FOR MARKER CURMOV HLT /EOF BEFORE MARKER FOUND MEANS /CATASTROPHIC DOCUMENT FAILURE TAD I CURPTR TAD (-ECTMRK) /FOUND? SZA CLA JMP DOC1E1 /NO, TRY NEXT DCA I CURPTR /DELETE MARK SLNMOD /REJUSTIFY THE LINE JMS REJUST / DOCERR ERROR FINISH UP HANDLING / / DOCCER, JMS BEEPER /RIND DA BELL JMS PUTPST /CLOSE PASTE BUFFER NOP TAD (RXEWT+2000) JMS PSTIO SLNMOD TAD CLCTDN /CHECK IF SELECT FOUND SNA CLA JMP UNSLCT /NO SO GO FIND IT DCA EDMODE /CLEAR MODES JMP EIBAD /AND LEAVE / DNCCOV COLUMN CUT ABORTED DUT TO OVERFLOW HANDLING / / DNCCOV, AC0001 /SEARCH FOR SELECT POINT AND MARKER CURMOV HLT /BETTER NOT FIND EOF TAD I CURPTR TAD (-ECTMRK) /MARKER? SNA JMP DNCOV1 /YES DELETE IT TAD (ECTMRK-ECSLPT) /SELECT POINT? SZA JMP DNCCOV /NO, TRY NEXT CHAR DCA I CURPTR /DELETE SELECT MARK JMS BEEPER /SIGNAL ERROR JMP DNCCT1 /GO TERMINATE CUT DNCOV1, DCA I CURPTR /DELETE MARKER SLNMOD /REJUSTIFY LINE JMS REJUST JMP DNCCOV /SEARCH FOR SELECT POINT / DONCCT DONE COLUMN CUT HANDLING / / DONCCT, JMS PUTPST /PUT TERMINATOR BYTE INTO BUFFER NOP /IGNORE OVERFLOW TAD (RXEWT+2000) /WRITE OUT FINAL BLOCK JMS PSTIO DNCCT1, TAD LINE23 /RESET POINTERS DCA CURPTR DCA CURSOR DCA EDMODE /RESET MODE SLNMOD /REJUSTIFY LINE JMS REJUST JMP EIFIX /CONTINUE PROCESSING / PUTPST WRITE TO PASTE BUFFER / / THIS ROUTINE TAKES CHARACTERS PASSED IN THE AC AND PUTS THEM IN / THE PASTE DISK BUFFER. WHEN THE BUFFER IS FULL IT WRITES THE / BUFFER TO DISK. WHEN THE LAST ALLOCATED DISK BLOCK IS WRITTEN / IT SETS THE CUT OVERFLOW FLAG AND TAKES A SKIP RETURN. / / CALL: / / JMS PUTPST (AC := CHARACTER TO WRITEOUT) / / / / RETURNS WITH AC:=0 IN ALL CASES / PUTPST, XX /ENTRY POINT CDFBUF /SET TO BUFFER FIELD DCA I PSTPTR /PUT CHARACTER IN BUFFER ISZ PSTPTR /BUMP PTR AND CHECK FOR BLOCK FULL JMP I PUTPST /BLOCK NOT FULL SO RETURN DIRECTLY TAD (RXEWT+2000) /BLOCK I/O WRITE CODE JMS PSTIO /PERFORM WRITE TO DISK ISZ PSTBLK /INCREMENT BLOCK NO TAD PSTBLK /CHECK FOR END OF ALLOCATED BLOCKS TAD (-PSTEND) /FOR PASTE BUFFER SZA CLA /END OF ALLOCATION? JMP I PUTPST /NO, SO STRAIGHT RETURN AC7777 /EOA FOR PASTE BUFFER DCA PSBFOF /SET PASTE BUFFER OVERFLOW FLAG ISZ PUTPST /AND TAKE A SKIP RETURN JMP I PUTPST /B-B / CUTNOT CUT OR COPY A CHARACTER / / CUTNOT, XX CONCTC, HLT /THIS LOCATION HAS EITHER A DCA I CURPTR /OR A CLA WRITTEN IN UPON ENTRY. THE /DCA I CURPTR WILL CUT THE TAB. THE CLA /DOES NOTHING. JMP I CUTNOT / CASE TABLES FOR COLUMNAR CUT / / DCCTB1, ECNWLN; DOCC03 /NEW LINE COULD BE ECNWPG; DOC1ER /NEW PAGE HERE IS ERROR ECSTRL; DOC1ER /START RULER ALWAYS ERROR ECTAB; DOCC02 /TAB IS GOOD BOY ECMDFL; DOCC01 /SKIP MODIFIED FLAG 0 DCCTB2, ECTAB; DOCC20 /YES GO DO IT ECNWLN; DOCC08 ECNWPG; DOCC08 ECNDRL; DOCC08 0 X=. /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM / BEGIN HELP OVERLAY........ OVHELP= .-OVLAY1+OVRNUM JMP OVHLP1 / CALL CLEAR SCREEN AND SAVE MENU DATA /A185 / / Moved here on edit 225 for space reasons / OVSWAP= .-OVLAY1+OVRNUM JMP XVSWAP / Call Gold swap routine OVTIME= .-OVLAY1+OVRNUM JMP XVTIME /D185 OVHLP1= .-OVLAY1+OVRNUM / --OVERLAY ENTRY POINT-- / OVERLAY HELP EDIT OVHLP0, CIFMNU JMS I MNUCAL / PRINT HELP MENU DLHLP0 / BLOCK NUM ARG.. JMP HLPBKC / SKIP INC FIRST TIME AND DISPLAY HLPADV, TAD HLPSPC / GET SPACE CHAR JMS HLPDP0 / PRINT IT ISZ NOWPTR JMP HLPBKC / PRINT '*' / BACKUP POINTER HLPBAK, TAD HLPSPC / GET SPACE CHAR JMS HLPDP0 / PRINT IT CLA CMA / -1 FOR BACKUP HLPBKC, TAD NOWPTR SNA / BEG OF SCREEN JMP HLPDST / YES IS OK SPA / IS IT BEFORE 1ST COMMENT JMP HLPSTZ / YES SET TO LAST TAD HLPNMX / CHECK END (-HLPMAX) SPA / PAST LAST? HLPSTZ, TAD HLPMAX / YES RESET HLPDST, DCA NOWPTR / SET POINTER TAD HLPCSR / GET CURSOR CHAR JMS HLPDP0 / PRINT IT HLPNXT, GETINP / GET A CHAR SNA / IS=0 JMP HLPNXT / YES MAY BE NULL FROM PRINT SCREEN TAD (-EDHELP) / =HELP SNA JMP HLPHLP / IS HELP MENU 2ND LEVEL TAD (-EDADVN+EDHELP)/ ADVANCE CHAR SNA JMP HLPADV / IS ADVANCE TAD (-EDBKUP+EDADVN)/ CHECK BACKUP SNA JMP HLPBAK / IS BACKUP PTR IFDEF HELPDO < TAD (-EDDO+EDBKUP) / ****UPPER IS TEMP****IS DO IT COMMAND SNA JMP HLPDO / YES EXEC COMMAND TAD (-EDNWLN+EDDO) / IS RETURN > / END IFDEF HELPDO IFNDEF HELPDO < TAD (-EDNWLN+EDBKUP) > / END IFNDEF HELPDO SNA JMP HLPRET / RETURN TO EDIT MODE TAD (-EDMENU+EDNWLN)/ GOLD MENU? SNA CLA JMP HLPRET / RETURN TO EDIT MODE JMS BUZZER / ILLEGAL CHAR JMP HLPNXT / GET ANOTHER CHAR / SET UP LINE AND COL PRINT POSITION HLPDP0, 0 DCA HLPCHR / SAVE CHAR TO BE DISPLAYED TAD NOWPTR / GET POSITION DCA HLPTM1 / SAVE POSITION PTR DCA COLCNT / INIT COL PTR DCA HLPRW1 / INIT ROW PTR DCA COLNUM / TAB COLUMN NUMBER HLPNX1, SETLSC, JMS SETLST / CHECK LAST COLUMN SETCOL, TAD COLNUM / GET TAB COL NUMBER CLL RAL / *2 TAD COLPT1 / POINTER TO TABLE DCA COLPT2 / TEMP POINTER TAD I COLPT2 / GET 1ST CHAR ENTRY DCA HLPCL1 / SET 2ND POS(0,2,5) ISZ COLPT2 / GET 2ND ENTRY IN TABLE TAD I COLPT2 / SET L/ O=(3,7,1) DCA HLPCL2 / SET L/ O POS. PNTR TAD HLPK04 / 4=FIRST PRINT LINE TAD HLPTM1 / LINE OFFSET DCA HLPTM1 SETCLB, TAD HLPKM9 / -9 TAD HLPTM1 SPA / IS GREATER THAN 9 JMP HLPST1 / NO CONT DCA HLPTM1 / SAVE LINE # ISZ HLPRW1 / INC ROW NUMBER ASSUMES L.T.20 JMP SETCLB / REPEAT (FOR G.T. 20 HLPST1, CLA CLL CML RAR / 4000 TAD HLPRW1 TAD HLPK60 / ASCII DCA HLPRW1 / ADD ROW NUM CLA CLL CML RAR / 4000 TAD HLPK60 / ASCII TAD HLPTM1 DCA HLPRW2 / PUT COMMAND STRING PUTESC "[+4000-200 HLPRW1, "0+4000-200 / ROW TENS DIGIT HLPRW2, "1+4000-200 / ROW L/ O DIGIT ";+4000-200 / SEPARATOR "0+4000-200 / COL H/ O COLCNT, HLPCL1, "0+4000-200 / =0,3,6 HLPCL2, "3+4000-200 "H+4000-200 / CUROR POSITION HLPCHR, "0-200 / CHARACTER TO PRINT JMP I HLPDP0 / THIS ROUTINE COMPARES ARG PASSED AGAINST NOWPTR / LIKE RESULTS RETURN +1 ELSE+2 CHKSPL, 0 TAD NOWPTR / POINTER TO CODE TAD I CHKSPL / GET CODE TO COMPARE AGAINST SZA CLA / IS IT SPECIAL CODE? ISZ CHKSPL / NO SET RETURN ISZ CHKSPL JMP I CHKSPL / SET DIRECTION FOR ADV/ BACKUP LINE OR PARA SETDIR, 0 MODSET / SET IT MOVMOD JMP I SETDIR / RET IFDEF CONDOR / TOTAL NUM OF LIST IN MENU /C212 IFNDEF CONDOR /C222 NUMLPC, -17 / NUMBER LINES PER COLUMN HLPTM1, 0 / TEMP STOREAGE HLPMAX, LSTLNT / MAX NUM COMMANDS HLPNMX, -LSTLNT / NEG HLP MAX HLPSPC, " -200 / SPACE HLPCSR, "*-200 / CURSOR CHAR=* HLPK60, 60 / " HLPKM9, -12 / -9 IFDEF HELPDO < HLPPTR, HLPTBL / POINTER TO COMMAND TABLE > / END IFDEF HELPDO NOWPTR, 0 / CURRENT POSITION POINTER HLPK04, 4 / FIRST LINE OF PRINT COLNUM, 0 / TAB POSITION COLPT1, COLPT3 / POINTER TO TABLE COLPT2, 0 / TEMP POINTER POS. X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE IFDEF HELPDO < / DO COMMAND POINTED TO PY CURSOR POSITION HLPCOD, 0 / POINTER TO COMMAND LOC HLPDO, TAD NOWPTR / GET POINTER TO CURRENT COMMAND CLL RAR / DIV 2 2 ENTRIES PER WD. TAD HLPPTR / ADD START OF TABLE DCA HLPCOD / SET POINTER TO COMMAND TAD I HLPCOD / GET COMMAND CODE SNL / HI OR LO BYTE 0=HI BSW / =HI AND (77) / MASK 6 BITS SZA / 0=NO CODE TAD (7700) / REPLACE 6 BITS IN CODE DCA HLPCOD / SAVE NEW CODE JMS CHKSPL / CHECK SPECIAL CODE -BAKLIN / IS = BACKUP LINE(UP ARRW) JMP SETBKW / SET TO BACKWARD JMS CHKSPL / CHECK SPECIAL CODE -ADVLIN / IS = ADV LINE(DWN ARRW) JMP SETFWD / SET TO FORWARD JMS CHKSPL / CHECK SPECIAL CODE -NXTSCR / IS = ADVANCE PARA(NXT SCREEN) JMP SETFWD / SET TO FORWARD JMS CHKSPL / CHECK SPECIAL CODE -PRVSCR / IS = BACKUP PARA(PREV SCREEN) JMP SETBKW / SET TO FORWARD JMP SETCNT / CONTINUE SETBKW, IAC / 1=BACKUP DIRECTION SETFWD, / 0=FORWARD DIRECTION DCA MOVMOD+1 / 0=BACK 1=FWRD JMS SETDIR / SET THE DIRECTION SETCNT, TAD HLPCOD / GET THE CODE > / END IFDEF HELPDO / RETURN TO EDIT MODE HLPRET, DCA T2 / SAVE RETURN CODE TAD T3 / GET BASKET COUNT DCA BASKCT / RESET /D185 OVLJMP;OVHLPE / END HELP OVERLAY RESTORE MENU DATA AND POINTERS TAD WIDNAR / CHECK FOR WIDE SCREEN /M192 SNA CLA /M192 JMS SET132 / CONVERT TO 132 COLUMN MODE /A185 JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS /A185 AC7777 / SET AC = -1 /A185 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD/A185 PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA /A185 TAD T2 / FINISH - GET RETURN CODE /A185 SNA / IS CODE OR NULL(RET TO EDITOR) /A185 JMP EINEXT / RETURN TO NORMAL EDITOR FUNCTIONS /A185 JMP EINEXB / RETURN TO EDITOR ...WITH NEG CODE IN AC/A185 OVHLP1, TAD BASKCT / GET WASTEBASKET COUNT /A185 DCA T3 / SAVE FOR HELP UNDELETE /A185 DCA PSTBLK /A185 DCA BASKCT / CLEAR PASTE BUF FLAGS /A185 JMS CLR132 / MAKE SURE THE SCREEN IS IN NARROW MODE/A185 AC0003 / SET UP TO RESET SCROLL REGION /A185 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD/A185 JMS I (CALLN1) / RESET SCROLL REGION SET ABSOLUTE MODE /A185 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD/A185 PGSWAP / AC=0, SAVE SWAP AREA & RELOAD MENU CODE/A185 JMP OVHLP0 / START OF HELP OVERLAY HLPHLP, TAD NOWPTR / NEXT LEVEL HELP TEXT - GET ARG CDFMNU DCA I (MUBUF+MNTMP1) CDFEDT CIFMNU JMS I MNUCAL / CAL MENU DLHL01 / MENU BLOK(ARG PASSED IN MNTMP1) CDFMNU TAD I (MUBUF+MNTMP1) / ARG RET HERE(0=NEXT NOT 0=DO) CDFEDT IFNDEF HELPDO < SNA CLA / IS DISPLAY MENU? JMP OVHLP0 / YES JMP HLPRET / YES RESUME EDITING > / END END IFNDEF HELP DO IFDEF HELPDO < SNA / IS DISPLAY MENU? JMP OVHLP0 / YES SMA CLA / IS IT GOLD MENU JMP HLPRET / YES RESUME EDITING JMP HLPDO / DO FUNCTION CODE > / END IFDEF HELPDO IFDEF ENGLSH < COLPT3, "0+4000-200 / (01) "1+4000-200 "1+4000-200 / (19) "9+4000-200 "3+4000-200 / (37) /C212 "7+4000-200 /C212 "5+4000-200 / (52) /C212 "2+4000-200 /C212 "6+4000-200 / (65) /C212 "5+4000-200 /C212 > IFDEF V30SWE < COLPT3, "0+4000-200 / (01) "1+4000-200 "1+4000-200 / (19) "9+4000-200 "3+4000-200 / (37) /C212 "7+4000-200 /C212 "5+4000-200 / (52) /C212 "2+4000-200 /C212 "6+4000-200 / (65) /C212 "5+4000-200 /C212 > IFDEF V30NOR < COLPT3, "0+4000-200 / (01) "1+4000-200 "1+4000-200 / (19) "9+4000-200 "3+4000-200 / (37) /C212 "7+4000-200 /C212 "5+4000-200 / (52) /C212 "2+4000-200 /C212 "6+4000-200 / (65) /C212 "5+4000-200 /C212 > IFDEF SPANISH < COLPT3, "0+4000-200 / (01) /A236 "1+4000-200 / " "1+4000-200 / (19) / " "9+4000-200 / " "3+4000-200 / (37) / " "7+4000-200 / " "5+4000-200 / (52) / " "2+4000-200 / " "6+4000-200 / (65) / " "5+4000-200 /A236 > IFDEF ITALIAN < COLPT3, "0+4000-200 / (01) "1+4000-200 "2+4000-200 / (20) "0+4000-200 "3+4000-200 / (41) /C212 "9+4000-200 /C212 "5+4000-200 / (52) /C212 "2+4000-200 /C212 "6+4000-200 / (65) /C212 "5+4000-200 /C212 > IFDEF DUTCH < COLPT3, "0+4000-200 / (01) "1+4000-200 "1+4000-200 / (19) "9+4000-200 "3+4000-200 / (36) /C212 "6+4000-200 /C212 "5+4000-200 / (52) /C212 "2+4000-200 /C212 "6+4000-200 / (65) /C212 "5+4000-200 /C212 > SETLST, XX / CHECK LAST COLUMN TAD LNTPTR / LENGTH TABLE POINTER DCA LNTTMP / SAVE TEMP SETNXT, TAD HLPTM1 / POSITION POINTER TAD I LNTTMP / GET LNGTH SPA / L.T. THAN POINTER JMP SETEXT / YES DCA HLPTM1 / NO ISZ COLNUM / INC COL NUMBER ISZ LNTTMP / INC PTR JMP SETNXT SETEXT, CLA / SET POSITION IN COL JMP I SETLST / RET LNTPTR, LNTTBL / POINTER LNTTMP, 0 / TEMP LNTTBL, /A166 IFNDEF CONDOR < /A166 -17 / NEG LNTH COL 1 /C212 -20 / NEG LNTH COL 2 /C212 -15 / NEG LNTH COL 3 /C222 -21 / NEG LNTH COL 4 /A166 -7 / NEG LNTH COL 5 /C222 > / END IFNDEF CONDOR /A166 IFDEF CONDOR < /A166 -21 / NEG LNTH COL 1 /C212 -21 / NEG LNTH COL 2 /C212 -16 / NEG LNTH COL 3 /C212 -21 / NEG LNTH COL 4 -17 / NEG LNTH COL 5 /C212 > / END IFDEF CONDOR /A166 0 / END TABLE IFDEF HELPDO < / FOLLOWING TABLE ASSUMES ALL CODES START WITH 77XX IN H/ O 6 BITS / IT IS USED WITH 6 BITS FROM 1ST CODE STORED IN H/ O 6 BITS / AND 6 BITS FROM NEXT CODE STORED IN L/ O 6 BITS HLPTBL, / COMMAND TABLE EDDICT^100+EDGADV+100 / ABBREVIATION / GOLD ADVANCE EDGBKP^100+EDUBLD+100 / GOLD BACKUP / GOLD:BOLD EDBOTM^100+EDCENT+100 / BOTTOM / CENTER EDPCMD^100+EDSRCH+100 / COMMAND / CONT. SEARCH EDCONT^100+EDRBSE+100 / CONTINUE SEARCH & SELECT/ RUB SENTENCE EDGCUT^100+EDTIME+100 / GOLD CUT / GOLD:DATE & TIME EDDEAD^100+EDUDLT+100 / DEAD KEY / GOLD:DELETE EDFILE^100+EDDCMT+100 / FILE / GOLD:G GET DOC 0000000^100+EDHYPL+100 / NO HELP CODE RESUME EDITEDHALT / HYPHEN PULL EDGPST^100+EDGETC+100 / INSERT HERE=GOLD PASTE/ LIBRARY EDMENU^100+EDNPAG+100 / MENU / NEW PAGE EDGPGE^100+EDPMRK+100 / GOLD:PAGE / PAGE MARKER EDCRET^100+EDGPST+100 / PARAGRAPH MARKER / GOLD:PASTE EDHYP1^100+EDGCUT+100 / PRINT HYP / GOLD REMOVE= GOLD CUT EDREPL^100+EDRBLN+100 / REPLACE / RUB LINE EDRULR^100+EDHYP2+100 / RULER / INVISIBLE HYP EDFIND^100+EDFIND+100 / SEARCH / SEARCH PAGE (TEMP DO SEARCH) EDSUBS^100+EDSUPS+100 / SUBSCRIPT / SUPERSCRIPT EDSWAP^100+EDTOP+100 / SWAP / TOP EDUUDL^100+EDLOWR+100 / GOLD:UNDERLINE / GOLD:UPPERCASE EDVIEW^100+EDGBKP+100 / VIEW / UP ARROW=BACKUP LINE(**) EDGADV^100+EDGBKP+100 / DN ARROW=ADVANCE LINE(**)/ LFT ARROW=BACKUP LINE(**) EDGADV^100+EDADVN+100 / RHT ARROW=ADVANCE LINE(**) / ADVANCE EDBKUP^100+EDBOLD+100 / BACKUP / BOLD EDSCUT^100+EDDLTC+100 / CUT / DELETE CHAR EDDLTW^100+EDLINE+100 / DELTE WORD / LINE EDPAGE^100+EDPARA+100 / PAGE / PARAGRAPH EDPSTE^100+EDSLCT+100 / PASTE / SELECT EDSENT^100+EDTABP+100 / SENTENCE / TABPOSITION EDUNDL^100+EDUPPR+100 / UNDERLINE / UPPERCASE EDWORD^100+EDENTR+100 / WORD / ENTER EDFIND^100+EDHYPS+100 / FIND=GOLD SRCH / HYPH PULL(**) / FOLLOWING DEFINE USED TO DETERMINE OFFSET IN TABLE / USED TO LOCATE FUNCTIONS REQUIRING 2 CODES TO BE EXECUTED NXTSCR=.-HLPTBL^2+1 / NXT SCRN=ADV PARA L/ O BYTE EDPSTE^100+EDPARA+100 / INSERT HERE=PASTE/NEXT SCREEN=ADVANCE PARA(**) PRVSCR=.-HLPTBL^2 / PREV SCRN=BKUP PARA H/ O BYTE EDPARA^100+EDSCUT+100 / PREV SCREEN=BACKUP PARA(**)/REMOVE=CUT BAKLIN=.-HLPTBL^2+1 / UP ARROW=BK LINE L/ O BYTE EDSLCT^100+EDLINE+100 / SELECT=SEL/ UP ARROW=BACKUP LINE(**) ADVLIN=.-HLPTBL^2 / DWN ARROW=ADV LINE L/ O BYTE EDLINE^100+EDBKUP+100 / DN ARROW=ADVANCE LINE(**)/ LFT ARROW=BACKUP LINE(**) EDADVN^100+007700+100 / RHTARROW=ADVANCE LINE(**) HLPTBE, / END OF TABLE+1 > / END IFDEF HELPDO / END HELP MENU / / Moved here on edit 225 for space reasons / / Modified on edit 229 to allow Swap on dead key sequences. / XVSWAP, JMS BHOOK / Call Blaster /A229 SWPDED / To swap a dead thing /A229 JMP EIBAD / Bad Swap /A229 JMP EIFIX / Char has been inserted , wait for more/A229 EISWPA, XX / Check current char for Swap JMS LODCHR / JMP EISWBD / Bad if ETX AND P177 TAD (-ECNWLN) / Or if EOL SNA JMP EISWBD / TAD (ECNWLN-ECNWPG) / Or if PAGE SNA CLA / /M229 /D229 TAD (ECNWPG-ECSTOV) / Or if Overstruck /D229 SNA CLA JMP EISWBD ISZ EISWPA EISWBD, JMP I EISWPA / Return only if OK / OVTIME moved here on edit 231 to allow room for hyphenation of /A231 / 8 bit chars /A231 / OVTIME= .-OVLAY1+OVRNUM /TIME ENTRY XVTIME, CIFMNU JMS I TIMCAL NOP / UPDATE TIMER CDFMNU AC7777 TAD I (DATESP) / GET DATE STRING DCA OVTIMX / SAVE PTR-1 XVTIM1, CDFMNU TAD I OVTIMX / GET NEXT CHAR SNA JMP EIFIX / QUIT IF NULL INSCHR / ELSE INSERT JMP XVTIM1 / AND LOOP FOR MORE OVTIMX=X5 / STRING INDEX REGISTER X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM /*************************************************************************** /**** MOVED DURING EDIT #176 FOR GOLD:TAB STUFF **** /*************************************************************************** OVXRUL= .-OVLAY1+OVRNUM / / RULER CLEAN UP CODE / / ENTERED HERE FROM EDIT-RULER MODE AND COMPLETION OF GOLD:TAB / / "GOLD:TAB" / "GOLD:RULER" / "ENTER" / "GOLD:ADVANCE" OR "GOLD:BACKUP" / JMS CHKRUL / CHECK NEW RULER JMP RLBADX / NEW RULER IS BAD, RETURN TO RULER OR TAB TAD CURSAV / GET SAVED CURSOR POSN FROM RESIDENT DCA CURSOR / RESTORE CURSOR POSN. TAD (ECTMRK) / PUT THE TEMP MARKING IN THE DOCUMENT /a176 JMS INSERT /a176 JMS CMPRUL JMP RLEXIT / NO CHANGE IN RULER / / +++ THE RULER CHANGED. /a176 / WE JUST PUT THE MARKER IN THE EDIT BUFFER, NOW, INSERT /a176 / THE NEW RULER AND RULER-MODIFIED CODE. THEN WHEN WE /a176 / GET TO THE NEXT OVERLAY, WE WILL PLACE THE CURSOR AT THE /a176 / SCREEN LOCATION BEFORE THE GOLD:TAB OR GOLD:RULER COMMAND. /a176 / WAS ISSUED. /a176 / / Also, we are going to Erase the Current line from the screen /a177 / Because of problems with Gold:tab and Editor-Status-Word /a177 / Defined to Display the Ruler on the 24th Line (but not in /a177 / the body of the text). /a177 / /a177 PUTESC / LETS OUTPUT AN ESCAPE SEQUENCE /a177 "[&177+4000 / WHICH WILL ERASE THE CURRENT LINE /a177 "2&177+4000 /a177 "K&177 /a177 / / TAD LINE23 / MOVE EDIT BUFFER POINTER /c177 DCA CURPTR / AND SCREEN CURSOR POINTER DCA CURSOR / TO LEFT MARGIN JMS INSRUL / INSERT NEW RULER TAD (ECRMFL) DCA LINMOD / SET RULER MODIFIED FLAG JMS SAVLMD / INSERT IT TAD LINE23 / MOVE EDIT PTR TO BEFORE NEW RULER DCA CURPTR RLEXIT, OVLJMP / TRANSFER TO ANOTHER OVERLAY TO FINISH OVRLXT / / / +++ THERE IS SOME KIND OF PROBLEM WITH THE NEW-RULER /a176 / /a176 / IF WE GOT HERE FROM GOLD:RULER, IT COULD BE ANYTHING. /a176 / IF WE GOT HERE FROM GOLD:TAB, THEN WE MUST HAVE TOO MANY TABS /a176 / /a176 / WE RETURN TO THE PROPER OVERLAY BY VECTORING ON MNTMP1 IN THE /a176 / MENU FIELD. /a176 / RLBADX, JMS MNUGET /a176 MNTMP1 / GET VECTOR FLAG /a176 SZA CLA / .EQ.0 = RULER .NE.0 = TAB /a176 JMP RLBAD1 / TAB /a176 OVLJMP / RULER /a176 OVRBAD /a176 RLBAD1, OVLJMP / TAB /a176 INTBAD /a176 OVGSRL= .-OVLAY1+OVRNUM JMS CHKRUL / CHECK FOR VALID RULER JMP RLBADX / ERROR - INVALID RULER / READ THE BLOCK WHICH CONTAINS THE STORED RULER WE WANT TO /A184 / OVERWRITE AND THEN COPY THE NWRUL BUFFER INTO THAT READ BUFFER. /A184 / THE MODIFIED BUFFER IS THEN WRITTEN OUT TO THE DISK. /A184 TAD T3 / RULER VALID - PUT IT TO DISK /A184 JMS RLGETX / GO READ EDITOR RULER BLOCK /A184 DCA RLPUT1 / RETURN WITH ADDRESS - 1 OF RULER AND /A184 / SET UP FOR COPY /A184 JMS CPYBUF / COPY NWRUL TO WRITE OUT BUFFER /A184 -RULSIZ / MINUS SIZE OF NEW RULL /A184 CDFMNU / RESIDES IN MENU FIELD /A184 NWRUL-1 / AT THIS LOCATION /A184 CDFBUF / COPY TO THIS FIELD /A184 RLPUT1, .-. / AT THIS LOCATION /A184 TAD (RXEWT+2000) / GET WRITE OUT FUNCTION CODE /A184 JMS PSTIO / WRITE TO DISK /A184 OVLJMP / GOTO RULER MODIFICATION ROUTINE TO OVPRUL / DISPLAY RULER AND GET NEXT INPUT CHAR. X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------------------ PAGE / / SUBR CHKRUL -- CHECK NEW RULER TO SEE IF IT ADHERES TO THE FOLLOWING / RULES: / (1) THERE MUST BE A LEFT MARGIN; / (2) THE LEFT MARGIN, WORD WRAP INDENT MARK, PARA INDENT MARK, / AND CENTERING POINT MUST ALL BE TO THE LEFT OF THE / RIGHT MARGIN; / (3) # OF MARKERS (TABS, ETC) < (20 IF RIGHT MARGIN<80, ELSE 41); / ALSO DELETES MARKERS PAST RIGHT MARGIN. / / CALL: / TAD JUNK / AC DOESN'T MATTER / JMS CHKRUL / CHECK NEW RULER (NWRUL) / JMP RULBAD / RULER BAD (VIOLATES 1 OR MORE RULES) / JMP RULOK / RULER OK / CHKRUL, XX / CHECK NEW RULER AC0001 DCA T1 / INIT POSN CDFMNU TAD NWLMAR SNA JMP MCHK1 / ERROR IF NO L JMS MCHK TAD NWWMAR JMS MCHK TAD NWPMAR JMS MCHK TAD NWCMAR JMS MCHK TAD NWRMAR TAD (-COLM81) / NOW CHECK TOTAL SIZE OF RULER SMA CLA TAD (-25) TAD (-25) DCA RLTMP / -(MAX COUNT OF MARKS)-1 DCA MCHK RLXCH1, ISZ MCHK / BUMP POSITION TAD MCHK JMS GETBYT NWRUL / LOOK AT IT SNA JMP RLXCH2 / JUMP IF DONE TAD (-1) SNA CLA JMP RLXCH1 / IGNORE IF NOTHING THERE TAD MCHK CIA CDFMNU TAD NWRMAR SMA CLA JMP RLXCH3 / COUNT IF INSIDE MARGIN TAD MCHK MQL IAC / ELSE DELETE JMS PUTBYT NWRUL JMP RLXCH1 / COUNT MARKER AT LEFT OF RIGHT MARGIN RLXCH3, ISZ RLTMP JMP RLXCH1 / IGNORE IF OK SO FAR TAD MCHK / ELSE COMPLAIN IF TOO MANY MARKS JMP MCHK2 RLTMP, 0 / NEW RULER IS OK. TAKE OK RETURN. RLXCH2, ISZ CHKRUL RLXCH4, CDFMYF JMP I CHKRUL / / SUBR MCHK -- / ENTER WITH AC = NEW RULER SETTING. / *** THIS SUBROUTINE MAY ONLY BE CALLED FROM WITHIN SUBR CHKRUL! / MCHK MAKES SURE NEW RULER SETTING IS TO THE LEFT OF NEW RIGHT MARGIN. / IF IT IS, THEN EXIT MCHK WITH AC=0; / ELSE (BAD NEW RULER) TAKE ERROR RETURN FROM ***CHKRUL*** !! MCHK, XX DCA T1 TAD T1 CIA TAD NWRMAR SMA SZA CLA JMP I MCHK MCHK1, TAD T1 MCHK2, DCA RLPOSN JMP RLXCH4 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------------------ PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVINCH=.-OVLAY1+OVRNUM JMP INOVCH / Handle chars in Overstrike /A235 / mode /A235 OVINOF=.-OVLAY1+OVRNUM / Switch INSOV Flag On - Off /A235 INONOF, CLA / Clear Acc /A235 TAD INSOVF / Get Overstrike flag /A235 CMA / Flip bits /A235 AND (1) / Mask out everything else /A235 DCA INSOVF / Now re-store it /A235 AC0001 / Set Acc up /A235 CDFMNU / Point to Menu field /A235 DCA I XLINDIF / Set line different flag /A235 CDFMYF / and back here /A235 JMP EIFIX / Go back for more /A235 INOVCH, CDFBUF / Point to User buff /A235 TAD I CURPTR / Get next char /A235 AND P177 / Strip off attributes /A235 CDFMYF / Now back here /A235 TAD (-ECSPC) / Check if alpha /A235 SPA / /A235 JMP INONAL / Not alpha /A235 CLA / Clear out results of test /A235 CDFBUF / Point to user buffer /A235 DCA I CURPTR / And kill char /A235 CDFMYF / Now point back here /A235 TAD INCHTM / Get char just input /A235 JMP EINSRT / And wait for more /A235 INONAL, TAD (ECSPC-ECSTOV) / Is it the start of a dead seq /A235 SNA CLA / /A235 JMP INOVDED / yes , Kill it then return /A235 TAD INCHTM / No get char back /A235 JMP EINSRT / And insert it instead /A235 INOVDED,JMS INVKIL / Kill char /A235 ADVPTR / Get next /A235 NOP / /A235 TAD (-ECNDOV) / End of the dead seq ? /A235 SZA CLA / /A235 JMP INOVDED / No , keep trying /A235 JMS INVKIL / Yes , kill it /A235 TAD INCHTM / Now get back original char /A235 JMP EINSRT / And insert it /A235 / / Small routine to kill next char in user buffer /A235 / INVKIL, XX CDFBUF / Point to user buffer /A235 DCA I CURPTR / And kill char /A235 CDFMYF / Point back here /A235 JMP I INVKIL / And return /A235 XLINDIF,LINDIF / Pointer to LINDIF in Menu field/A235 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE ZBLOCK 1 / RESERVE SPACE FOR SECOND OVERLAY PAGE X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OVRNUM=OVRNUM+200 OVRBLK=OVRNUM%200+DLOEDO-1 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY1 OVRNUM OVTCHR= .-OVLAY1+OVRNUM / USER TYPED "TECHNICAL CHARACTER KEY" JMS OV2JMP / CALL REST OF ROUTINE IN OVERLAY 2 AREA OVTC / NECESSARY TO LOAD THIS OVERLAY & TABLE XXFIND= .-OVLAY1+OVRNUM / USER TYPED "GOLD:SEARCH" ISZ NOMOVE / KEEP CURSOR FROM PRE-INCREMENTING JMS FXSCRL / UPDATE SCREEN JMS PROMPT / PROMPT USER 'ENTER PHRASE:' EIFND1 JMS OV2JMP / CALL ROUTINE IN SECOND OVERLAY AREA OVAGET / ALTERNATE GETLIN ROUTINE TAD GETTRM / TEST TERMINATOR FOR... TAD (-EDRULR) / RULER CODE ? SNA / . JMP XXGOTO / USER TYPED "GOLD:SEARCH - GOLD:RULER" TAD (EDRULR-EDPAGE) / PAGE CODE ? SNA CLA / . /C206 JMP XPGOTO / USER TYPED "GOLD:SEARCH - PAGE" JMS CPYBUF / COPY INPUT AREA CONTAINING SEARCH STRING ALTLIM, -63 / NUMBER OF WORDS TO COPY /C196 CDFMNU / FIELD TO COPY FROM MUBUF+MNIBUF-1 / ADDRESS TO COPY FROM CDFMYF / FIELD TO COPY TO EIGES4 / ADDRESS TO COPY TO TAD GETTRM / TEST TERMINATOR FOR... TAD (-EDCONT) / CONTINUE SEARCH AND SELECT ? /C206 SNA / . JMP XXCONT / USER TYPED "GOLD:CONTINUE SEARCH & SELECT" TAD (EDCONT-EDBKUP) / BACKUP? SNA CLA / . AC7776 / MODIFY INDICATORS ACCORDINGLY... DCA SRCDIR / . OVLJMP; OVSRCH / CONTINUE WITH "CONTINUE SEARCH" XXGOTO, OVLJMP; OVGSGR / USER TYPED "GOLD:SEARCH - GOLD:RULER" XPGOTO, OVLJMP; OVRPPG / USER TYPED "GOLD:SEARCH - PAGE" / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / GET GLOBAL SEARCH AND REPLACE / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - OVGSRP= .-OVLAY1+OVRNUM / GLOBAL SEARCH AND REPLACE MAIN ENTRANCE JMS CLR132 / KEEP SCREEN WIDTH AT 80 TAD GSRPRV / GET PREVIOUS GLOBAL SEARCH FLAG SZA CLA / WAS THERE A PREVIOUS GLOBAL SEARCH? AC0001 / YES, ALLOW RE-START JMS GETALT / CALL MENU AND GET STRING TAD GETLEN / GET LENGTH OF INPUT STRING SZA CLA / WAS ANYTHING TYPED ? JMP GS2 / YES, GO HANDLE STRING TAD GSRPRV / NO, GET PREVIOUS GLOBAL SEARCH FLAG SZA CLA / WAS THERE A PREVIOUS GLOBAL SEARCH? JMP XVGSGO / YES, THEN GO CONTINUE IT JMS SET132 / SET TO 132 COL. IF WIDNAR=WIDE /M192 JMS GS1SWP / RESTORE THE SWAP AREA JMP EIFIX / AND RETURN TO EDITOR IF FOUND GS2, JMS CPYBUF / COPY INPUT AREA CONTAINING SEARCH STRING -63 / NUMBER OF WORDS TO COPY CDFMNU / FIELD TO COPY FROM MUBUF+MNIBUF-1 / ADDRESS TO COPY FROM CDFMYF / FIELD TO COPY TO EIGES4 / ADDRESS TO COPY TO / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / GET SUBSTITUTION SCREEN / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - AC0002 / INDICATE REPLACEMENT MENU TEXT JMS GETALT / CALL MENU AND GET STRING TAD GETTRM / GET THE TERMINATING CHARACTER TAD (-EDPSTE) / COMBINE WITH PASTE KEY VALUE SNA CLA / IS IT THE PASTE KEY ? JMP XVGSGO / YES, GO USE CURRENT PASTE BUFFER TAD (PSTEBG) / SET UP THE PARAMETERS TO RESET THE DCA PSTBLK / CUT-PASTE BLOCK HANDLING LOGIC. JMS SETPST / GO SET ADRS POINTERS JMS OV2JMP / CALL ROUTINE IN SECOND OVERLAY AREA OVFIXP / TRANSFER MENU BUFFER TO PASTE BUFFER TAD (RXEWT+2000) / SET UP THE CALL TO WRITE THE CUT-PASTE BLOCK JMS PSTIO / TO THE USER SCRATCH AREA ON THE DISK. CDFMYF / RESET BACK TO THIS FIELD XVGSGO, TAD (SKP) / PICK UP THE SKIP INSTRUCTION DCA GSKILN / STORE SO THAT GSR WILL RUN ISZ GSRPRV / SET THE PREVIOUS GSR FLAG ISZ GSRF / SET THE GSR IN PROGRESS FLAG JMS SET132 / SET TO 132 COL. IF WIDNAR=WIDE /M192 JMS GS1SWP / RESTORE THE SWAP AREA /A189 XXCONT, OVLJMP; OVCONT / GO TO CONTINUE SEARCH & SELECT OVERLAY GETALT, XX / COMMON GSR STRING INPUT ROUTINE JMS MNUPUT / TRANSFER MESSAGE CODE TO MENU TEMP MNTMP2 / USE MENU TMEP NUMBER 2 CIFMNU / CHANGE TO MENU FIELD JMS I MNUCAL / AND CALL THE MENU DLMGS1 / USE THE FIRST GSR MENU BLOCK JMS OV2JMP / CALL ROUTINE IN SECOND OVERLAY AREA OVAGET / ALTERNATE GETLIN ROUTINE TAD GETTRM / GET TERMINATING CHARACTER TAD (-EDMENU) / COMBINE WITH VALUE FOR GOLD MENU SZA CLA / WAS GOLD MENU PRESSED ? JMP I GETALT / NO, RETURN TO CALLER JMS GS1SWP / YES, GO RESTORE THE SWAP AREA OVLJMP;OVMENU / GO CALL UP THE EDITOR MENU GS1SWP, XX / SUBROUTINE TO RESTORE THE SAVE AREA JMS CLSSET / INITIALIZE SCROLL VALUES FOR STATUS AC7777 / SET AC = -1 CIFMNU / CHANGE INSTRUCTION FIELD TO MENU FIELD PGSWAP / AC=-1 SO JUST LOAD IN THE SAVE AREA JMP I GS1SWP / RETURN TO CALLER X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / Mapping table for the Technical Character Set / /** Note: If octal code of mapped character is 0 the user input will / be ignored and no technical character will be generated. / / .-- Character set selection G1, G2, G3 / | .-- 7 bit octal code of Technical Character / | | .-- 7 bit octal code of character to be mapped / | | | .-- ASCII character of octal code to be mapped / | | | | .-- Mapped Technical Character description / |/ \ | | | TCMAP, IFDEF DUTCH < 3042 / 041 ! Top left radical 2067 / 042 " Middle dot 3065 / 043 # Top right summation 3066 / 044 $ Bottom right summation 2061 / 045 % Plus minus 3044 / 046 & Top integral 3103 / 047 ' Divided by 3053 / 050 ( Top left paren 3055 / 051 ) Top right paren 3046 / 052 * Vertical connentor 3051 / 053 + Top right square bracket 1133 / 054 , Left square bracket 3050 / 055 - Bottom left square bracket 1135 / 056 . Right square bracket 3133 / 057 / Includes 3056 / 060 0 Bottom right paren 3041 / 061 1 Left radical 3126 / 062 2 Radical 3057 / 063 3 Left middle brace 3060 / 064 4 Right middle brace 3067 / 065 5 Right middle summation 3062 / 066 6 Bottom left summation 3045 / 067 7 Bottom intergral 3043 / 070 8 Horizontal connector 3054 / 071 9 Bottom left paren 3136 / 072 : Logical and 3137 / 073 ; Logical or 3074 / 074 Less than - Less than or equal 3052 / 075 = Bottom right square bracket 3076 / 076 Greater than - Greater than or equal 3132 / 077 ? Is included in 3100 / 100 @ Therefore 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 3160 / 133 [ Small pi 3075 / 134 \ Not equal 3116 / 135 ] Implies 3061 / 136 ^ Top left summation 3047 / 137 _ Top left square bracket 3064 / 140 ` Bottom vertical summation connector 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 3120 / 173 { Captial pi 3077 / 174 | Integral 3115 / 175 } If and only if 3063 / 176 ~ Top vertical summation connector 0000 / 177 Delete key is not allowed > IFDEF ENGLSH < IFNDEF V30FAO < 3042 / 041 ! Top left radical 2067 / 042 " Middle dot 3065 / 043 # Top right summation 3066 / 044 $ Bottom right summation 2061 / 045 % Plus minus 3044 / 046 & Top integral 3103 / 047 ' Divided by 3053 / 050 ( Top left paren 3055 / 051 ) Top right paren 3046 / 052 * Vertical connentor 3051 / 053 + Top right square bracket 1133 / 054 , Left square bracket 3050 / 055 - Bottom left square bracket 1135 / 056 . Right square bracket 3133 / 057 / Includes 3056 / 060 0 Bottom right paren 3041 / 061 1 Left radical 3126 / 062 2 Radical 3057 / 063 3 Left middle brace 3060 / 064 4 Right middle brace 3067 / 065 5 Right middle summation 3062 / 066 6 Bottom left summation 3045 / 067 7 Bottom intergral 3043 / 070 8 Horizontal connector 3054 / 071 9 Bottom left paren 3136 / 072 : Logical and 3137 / 073 ; Logical or 3074 / 074 Less than - Less than or equal 3052 / 075 = Bottom right square bracket 3076 / 076 Greater than - Greater than or equal 3132 / 077 ? Is included in 3100 / 100 @ Therefore 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 3160 / 133 [ Small pi 3075 / 134 \ Not equal 3116 / 135 ] Implies 3061 / 136 ^ Top left summation 3047 / 137 _ Top left square bracket 3064 / 140 ` Bottom vertical summation connector 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 3120 / 173 { Captial pi 3077 / 174 | Integral 3115 / 175 } If and only if 3063 / 176 ~ Top vertical summation connector 0000 / 177 Delete key is not allowed > IFDEF V30FAO < 3042 / 041 ! Top left radical 3100 / 042 " Therefore 0000 / 043 # ----- 3066 / 044 $ Bottom right summation 2061 / 045 % Plus minus 3061 / 046 & Top left summation 3050 / 047 ' Bottom left square bracket 3046 / 050 ( Vertical connector 3053 / 051 ) Top left paren 3115 / 052 * Iff (if and only if) 3116 / 053 + Implies 1133 / 054 , Left square bracket 3133 / 055 - Includes 1135 / 056 . Right square bracket 3044 / 057 / Top integral 3056 / 060 0 Bottom right paren 3041 / 061 1 Left radical 3126 / 062 2 Radical 3057 / 063 3 Left middle brace 3060 / 064 4 Right middle brace 3067 / 065 5 Right middle summation 3062 / 066 6 Bottom left summation 3045 / 067 7 Bottom intergral 3043 / 070 8 Horizontal connector 3054 / 071 9 Bottom left paren 1135 / 072 : Right square bracket 1133 / 073 ; Left square bracket 3074 / 074 Less than - Less than or equal 3055 / 075 = Top right paren 3076 / 076 Greater than - Greater than or equal 3047 / 077 ? Top left square bracket 0000 / 100 @ ----------- 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 0000 / 133 [ ------ 0000 / 134 \ ------ 0000 / 135 ] ------ 3120 / 136 ^ Capital Pi 3132 / 137 _ Is included in 3160 / 140 ` Small Pi 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 0000 / 173 { Captial pi 0000 / 174 | Integral 0000 / 175 } If and only if 3077 / 176 ~ Integral 0000 / 177 Delete key is not allowed > > IFDEF V30NOR < 3042 / 041 ! Top left Radical 3100 / 042 " Therefor 3065 / 043 # Top Right Summ 3066 / 044 $ Bott Right Summ 2061 / 045 % +/- 3061 / 046 & Top Left Summ 3052 / 047 ' Divide by 3046 / 050 ( Vertical Conn 3053 / 051 ) Top Left Paren 3077 / 052 * Vertical Bar 3050 / 053 + Bott left Square bracket 1133 / 054 , Left Sq Bracket 3133 / 055 - Includes 1135 / 056 . Right Sq Bracket 3044 / 057 / Top Integral 3056 / 060 0 Bott Right Paren 3041 / 061 1 Left Radical 3126 / 062 2 Radical 3057 / 063 3 Left Midd Brace 3060 / 064 4 Right Midd Brace 3067 / 065 5 Right Midd Summ 3062 / 066 6 Bott Right Summ 3045 / 067 7 Bott Integral 3043 / 070 8 Horr Conn 3054 / 071 9 Bott Left Paren 1135 / 072 : Right Sq Bracket 1133 / 073 ; Left Sq Bracket 3074 / 074 Less than - Lessthan or = 3055 / 075 = Top Right Paren 3076 / 076 G.T. Greater than Or = 3047 / 077 ? Top Left Sq Bracket 0000 / 100 @ ------- 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 0000 / 133 ] ------- 0000 / 134 \ ------- 0000 / 135 ) ------- 3115 / 136 ^ Iff 3132 / 137 _ Is included in 3051 / 140 ` Top Right Sq Bracket 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 0000 / 173 { ------- 0000 / 174 | ------- 0000 / 175 } ------- 3064 / 176 ~ Bott Vertical Summ Conn > IFDEF V30SWE < 3042 / 041 ! Top left Radical 3100 / 042 " Therefor 3065 / 043 # Top Right Summ 3066 / 044 $ Bott Right Summ 2061 / 045 % +/- 3061 / 046 & Top Left Summ 3052 / 047 ' Divide by 3046 / 050 ( Vertical Conn 3053 / 051 ) Top Left Paren 3077 / 052 * Vertical Bar 3050 / 053 + Bott left Square bracket 1133 / 054 , Left Sq Bracket 3133 / 055 - Includes 1135 / 056 . Right Sq Bracket 3044 / 057 / Top Integral 3056 / 060 0 Bott Right Paren 3041 / 061 1 Left Radical 3126 / 062 2 Radical 3057 / 063 3 Left Midd Brace 3060 / 064 4 Right Midd Brace 3067 / 065 5 Right Midd Summ 3062 / 066 6 Bott Right Summ 3045 / 067 7 Bott Integral 3043 / 070 8 Horr Conn 3054 / 071 9 Bott Left Paren 1135 / 072 : Right Sq Bracket 1133 / 073 ; Left Sq Bracket 3074 / 074 Less than - Lessthan or = 3055 / 075 = Top Right Paren 3076 / 076 G.T. Greater than Or = 3047 / 077 ? Top Left Sq Bracket 0000 / 100 @ ------- 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 0000 / 133 ] ------- 0000 / 134 \ ------- 0000 / 135 ) ------- 0000 / 136 ^ ------- 3132 / 137 _ Is included in 3051 / 140 ` Top Right Sq Bracket 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 0000 / 173 { ------- 0000 / 174 | ------- 0000 / 175 } ------- 3064 / 176 ~ Bott Vertical Summ Conn > IFDEF SPANISH < 3042 / 041 ! Top left radical 3100 / 042 " Therefore 0000 / 043 # ----- 3066 / 044 $ Bottom right summation 2061 / 045 % Plus minus 3061 / 046 & Top left summation 3050 / 047 ' Bottom left square bracket 3046 / 050 ( Vertical connector 3053 / 051 ) Top left paren 3115 / 052 * Iff (if and only if) 3116 / 053 + Implies 1133 / 054 , Left square bracket 3133 / 055 - Includes 1135 / 056 . Right square bracket 3044 / 057 / Top integral 3056 / 060 0 Bottom right paren 3041 / 061 1 Left radical 3126 / 062 2 Radical 3057 / 063 3 Left middle brace 3060 / 064 4 Right middle brace 3067 / 065 5 Right middle summation 3062 / 066 6 Bottom left summation 3045 / 067 7 Bottom intergral 3043 / 070 8 Horizontal connector 3054 / 071 9 Bottom left paren 1135 / 072 : Right square bracket 1133 / 073 ; Left square bracket 3074 / 074 Less than - Less than or equal 3055 / 075 = Top right paren 3076 / 076 Greater than - Greater than or equal 3047 / 077 ? Top left square bracket 0000 / 100 @ ----------- 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3157 / 115 M Partial derivative 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3104 / 127 W Capital delta 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3111 / 132 Z Similar or equal to 0000 / 133 [ ------ 0000 / 134 \ ------ 0000 / 135 ] ------ 3120 / 136 ^ Capital Pi 3132 / 137 _ Is included in 3160 / 140 ` Small Pi 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 2065 / 155 m Small mu 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3144 / 167 w Small delta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3172 / 172 z Small zeta 0000 / 173 { Captial pi 0000 / 174 | Integral 0000 / 175 } If and only if 3077 / 176 ~ Integral 0000 / 177 Delete key is not allowed > IFDEF ITALIAN < 3132 / 041 ! Is included in 3057 / 042 " Left middle brace 0000 / 043 # --------------- 3116 / 044 $ Implies 2067 / 045 % Middle dot 3115 / 046 & If and only if 3060 / 047 ' Right middle brace 3067 / 050 ( Right middle summation 3050 / 051 ) Bottom left square bracket 3075 / 052 * Not equal 3051 / 053 + Top right square bracket 2065 / 054 , Small mu 3052 / 055 - Bottom right square bracket 1133 / 056 . Left square bracket 1135 / 057 / Right square bracket 3055 / 060 0 Top right paren 3042 / 061 1 Top left radical 3100 / 062 2 Therefore 3065 / 063 3 Top right summation 3066 / 064 4 Bottom right summation 2061 / 065 5 Plus/minus 3061 / 066 6 Top left summation 3044 / 067 7 Top intergral 3046 / 070 8 Vertical connector 3053 / 071 9 Top left paren 1135 / 072 : Right square bracket 1133 / 073 ; Left square bracket 3074 / 074 Less than - Less than or equal 3120 / 075 = Capital Pi 3076 / 076 Greater than - Greater than or equal 3157 / 077 ? Partial derivative 0000 / 100 @ ------------ 3105 / 101 A Nabla, del 3102 / 102 B Inifinity 3121 / 103 C Capital psi 3106 / 104 D Capital phi 3173 / 105 E Left arrow 3140 / 106 F Logical not 3114 / 107 G Capital lambda 2066 / 110 H Paragraph 3174 / 111 I Upward arrow 3134 / 112 J Intersection 2047 / 113 K Section 3127 / 114 L Capital omega 3136 / 115 M Logical and 3110 / 116 N Is approximate to 3176 / 117 O Downard arrow 0000 / 120 P (Spare location rings bell to indicate error) 3107 / 121 Q Capital gamma 3112 / 122 R Capital theta 3123 / 123 S Capital sigma 3175 / 124 T Right arrow 3130 / 125 U Captial xi 3101 / 126 V Variation, proportional to 3111 / 127 W Similar or equal to 3117 / 130 X Identical to 3131 / 131 Y Capital upsilon 3104 / 132 Z Capital Delta 0000 / 133 [ -------------- 0000 / 134 \ -------------- 0000 / 135 ] -------------- 3043 / 136 ^ Horizantal Connector 3062 / 137 _ Bottom left summation 3064 / 140 ` Bottom vertical summation connector 3141 / 141 a Small alpha 3142 / 142 b Small beta 3161 / 143 c Small psi 3146 / 144 d Small phi 3145 / 145 e Small epsilon 3166 / 146 f Function 3154 / 147 g Small lambda 3150 / 150 h Small eta 3151 / 151 i Small iota 3135 / 152 j Union 3153 / 153 k Small kapa 3167 / 154 l Small omega 3137 / 155 m Logical or 3156 / 156 n Small nu 2060 / 157 o Degree 3162 / 160 p Small rho 3147 / 161 q Small gamma 3152 / 162 r Small theta 3163 / 163 s Small sigma 3164 / 164 t Small tau 3170 / 165 u Small xi 3113 / 166 v Times, cross product 3172 / 167 w Small zeta 3143 / 170 x Small chi 3171 / 171 y Small upsilon 3144 / 172 z Small delta 0000 / 173 { --------------- 0000 / 174 | --------------- 0000 / 175 } --------------- 3063 / 176 ~ Top vertical summation connector 0000 / 177 Delete key is not allowed > / E N D O F T A B L E / ROUTINE TO VALIDATE AND EXTRACT A TECH CHARACTER CODE FROM THE TABLE TECVAL, XX / VALIDATE TECH CHARACTER JMS BHOOK / HOOK to BLAST to TEC8VAL / check for 8 bit character comming in /a233 JMP TEC8CH / No skip return if char was 8 bit /A237 / Skip return if 7 bit was I/P /A237 / NEXT BIT DONE IN BLAST AS NO ROOM FOR IT HERE /A237 /D237TEC7BIT,TAD TECTMP / Get the character for translation /a233 /D237 AND P177 / MASK OFF TO 7 BIT CHARACTER /D237 TAD (-41) / SUBTRACT OFF UNUSED CODES SPA / IS CHARACTER IN LEGAL RANGE? JMP I TECVAL / NO, TAKE ERROR RETURN TAD (TCMAP) / YES, COMBINE WITH TABLE ADDRESS DCA TECTMP / STORE POINTER INTO MAP TABLE TAD I TECTMP / PICK UP MAPED TECH CHARACTER CODE SNA / IS IT A VALID CHARACTER ? JMP I TECVAL / NO, TAKE ERROR RETURN TEC8CH, / HERE IF 8 BIT I/P. /A237 SNA / AC=0 IF NOT IN 8 BIT TABLE /A237 JMP TEC8RTN / IF SO, JUST RETURN /A237 DCA TECTMP / STORE CHARACTER FOR LATER USE /m233 TAD TECTMP / BUILD GRAPHIC SET SELECTION / G1 = 61, G2 = 62, G3 = 63 R3L / SELECTION CONTAINED IN AC 0 - 2 AND (3) / MASK OFF LOW ORDER BITS TAD (60) / BUILD ASCII CHARACTER DCA TECSET / STORE ASCII CHARACTER IN LIST TAD TECTMP / GET SAVED TECH CHARACTER AND P177 / MASK FOR 7 BIT CHARACTER DCA TECMAP / STORE ASCII CHARACTER IN LIST ISZ TECVAL / BUMP TO NORMAL RETURN TEC8RTN,JMP I TECVAL / RETURN TO CALLER /m233 TECTMP, .-. / TEMPORARY LOCATION TO HOLD TECH CHARACTER TECSET, .-. / VALUE OF G SET FOR TECH CHARACTER TECMAP, .-. / VALUE OF MAPPED TECH CHARACTER X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE FIELD 5 RELOC *0 /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 / NEW OVERLAY OVRBLK=OV2NUM%200+DLOEDO+36 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM /*************************************************************************** / ALTERNATE INPUT LINE ROUTINE ENTRY POINT (RETURNS TO SEARCH OVERLAY) /*************************************************************************** OVAGET= .-OVLAY2+OV2NUM / ALTERNATE GET OVERLAY ENTRY ALTGET, JMS CLREOL / CLEAR TO END OF LINE AFTER PROMPT TEXT ALTCLR, CLA / SET UP FOR A CLEAR OPERATION DCA GETLEN / CLEAR NUMBER OF CHARACTERS IN BUFFER ALTNXT, JMS ALTCHR / GO GET CHARACTER FROM KEYBOARD DCA GETTRM / SAVE THE CHARACTER JUST ENTERED BY USER TAD GETTRM / PICK UP THE CHARACTER JUST ENTERED BY USER TAD (-40) / COMBINE WITH SPACE CODE SZA CLA / IS CHARACTER A SPACE ? /C189 JMP ALTNEG / NO, GO CHECK FOR A NEGATIVE VALUE TAD (176) / YES, PICK UP GRAPHIC DISPLAY CHARACTER DCA ALTMS2 / STORE FOR GRAPHIC DISPLAY ROUTINE JMP ALTGRA / GO DISPLAY SPACE. /C190 ALTNEG, TAD GETTRM / PICK UP THE CHARACTER JUST ENTERED BY USER SPA / CHECK FOR A REGULAR CHARACTER JMP ALTCAS / IT'S MINUS, IT'S A SPECIAL CHARACTER / DISPLAY REGULAR TEXT CHARACTER JMS ALTTST / CHECK FOR OVERFLOW /A196 TAD GETTRM / GET CHARACTER ENTERED BY THE USER JMP ALTOX2 / SKIP OVER INITIAL JWAIT INSTRUCTION ALTOX1, CIFSYS / CHANGE TO SYSTEM FIELD JWAIT / WAIT FOR SIGNIFICANT EVENT ALTOX2, JMP ALT8BF / Test for 8 bit /A228 / / Here because the char is NOT 8 bit / ALT7DP, TAD GETTRM / Get char back /A228 CIFSYS / CHANGE TO SYSTEM FIELD TTYOU / OUTPUT THE CHARACTER TO THE SCREEN JMP ALTOX1 / BUSY, GO WAIT SOME MORE JMP ALTBUF / GO STORE CHARACTER IN MENU TEXT BUFFER ALTCAS, ZZCASE / CASE CHECK CHARACTER IN AC XXFTBL-1 / CHARACTER TABLE. / EDPWFL; ALTRO / POWER FAIL CODE / EDRBCH; ALTRO / RUBOUT CHARACTER CODE / EDRBWD; ALTRW / RUB WORD CHARACTER CODE / EDNWLN; ALTCR / CARRIAGE RETURN CODE / EDTAB; ALTTAB / TAB / EDRULR; ALTXIT / GOLD:RULER KEYS / EDPAGE; ALTCHK / PAGE KEY / EDCONT; ALTXIT / CONTINUE / EDADVN; ALTXIT / ADVANCE KEY / EDBKUP; ALTXIT / BACKUP KEY / EDSRCH; ALTXIT / SEARCH KEY / EDCONT; ALTXIT / CONTINUE SEARCH KEY / EDPSTE; ALTCHK / PASTE KEY / EDDO; ALTXIT / DO KEY / EDENTR; ALTXIT / ENTER KEY / EDMENU; ALTXIT / GOLD:MENU KEY / EDRQSP; ALTRQS / GOLD:SPACE (REQUIRED SPACE) / EDTC; ALTTEC / TECHNICAL CHARACTER KEY / 0 ALTBAD, JMS BEEPER / ELSE ERROR JMP ALTNXT / AND IGNORE RETURN ALTTEC, JMS ALTCHR / GO GET A CHARACTER FROM THE USER SPA / CHECK FOR A COMMAND CODE JMP ALTCAS / YES, IGNORE TECH CHAR KEY JMS TECVAL / GO VALIDATE AND MAP TECH CHARACTER CODE JMP ALTBAD / NOT A VALID KEY, GO REPORT THE ERROR ALTFND, TAD TECTMP / PICK UP THE MAPPED TECH CHARACTER CODE CMA / MAKE IT NEGATIVE FOR SEARCH STRING DCA GETTRM / SAVE CHARACTER FOR SEARCH TAD TECMAP / GET THE MAPPED ASCII CHARACTER CODE DCA ALTMS2 / STORE FOR GRAPHIC DISPLAY ROUTINE TAD TECSET / PICK UP THE GRAPHICS SET NUMBER TAD (-62) / SUBTRACT OFF MIDDLE VALUE SZA / CHECK FOR G2 CHARACTER SET JMP ALTTC1 / NO, GO CONTINUE CHECK TAD (7400) / YES, SET DEC MULTI NATIONAL SET JMP ALTSET / GO SAVE IT & DISPLAY GRAPHIC CHARACTER ALTTC1, SPA CLA / CHECK FOR G3 CHARACTER SET JMP ALTTC2 / NO, GO SET UP FOR THE G1 SET TAD (7600) / YES, SET DEC TECHNICAL CHARACTER SET JMP ALTSET / GO SAVE IT & DISPLAY GRAPHIC CHARACTER ALTTC2, TAD ("B&77^100) / G1 SET, SET TO US ASCII CHARACTER SET JMP ALTSET / GO SAVE IT & DISPLAY GRAPHIC CHARACTER ALTRQS, TAD (166) / REQUIRED SPACE. DISPLAY GRAPHIC BOTTOM "T" DCA ALTMS2 / STORE FOR GRAPHIC DISPLAY ROUTINE AC7777 / GET EDIT BUFFER CHARACTER FOR SEARCH JMP ALTSAV / GO SAVE IT & DISPLAY GRAPHIC CHARACTER ALTTAB, TAD ("b&177) / TAB CHARACTER. DISPLAY GRAPHIC "HT" CODE DCA ALTMS2 / STORE FOR GRAPHIC DISPLAY ROUTINE TAD (ECTAB) / GET EDIT BUFFER CHARACTER FOR SEARCH JMP ALTSAV / GO SAVE IT & DISPLAY GRAPHIC CHARACTER ALTCR, TAD ("d&177) / CARRIAGE RETURN. DISPLAY GRAPHIC "CR" CODE DCA ALTMS2 / STORE FOR GRAPHIC DISPLAY ROUTINE TAD (ECNWLN) / GET EDIT BUFFER CHARACTER FOR SEARCH ALTSAV, DCA GETTRM / SAVE CHARACTER FOR SEARCH ALTGRA, TAD ("0&77^100) / PICK UP GRAPHIC CHARACTER SET SELECTION ALTSET, DCA ALTMS1 / STORE FOR CHARACTER SET SELECTION JMS ALTTST / CHECK FOR OVERFLOW /A220 JMS MNUGET / GET VALUE OF LANGUAGE WORD MNLANG / LOCATION OF LANGUAGE WORD DCA ALTMS3 / SAVE WORD FOR SCREEN OUTPUT CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL / CALL SYSTEM DISPLAY ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE ALTMSG / CONTROL STRING TO SELECT LANGUAGE ALTMS1 / POINTER TO CHARACTER SET SELECTION CODE ALTMS2 / ASCII CHARACTER TO BE OUTPUT ALTMS3 / POINTER TO COPY OF LANGUAGE WORD ALTBUF, TAD GETTRM / GET CHARACTER ENTERED BY THE USER JMS ALTST1 / SAVE CHARACTER IN MENU FIELD BUFFER ISZ GETLEN / INCREMENT THE CHARACTER COUNTER JMP ALTNXT / GO GET NEXT CHARACTER / TEST FOR OVERFLOW ALTTST, XX / CHECK FOR CHARACTER OVERFLOW AC0001 / BUMP THE COUNT FOR THIS CHARACTER TAD GETLEN / COMBINE WITH THE CHARACTER COUNT TAD ALTLIM / COMPARE AGAINST THE LIMIT SMA CLA / OVERFLOW IF POSITIVE OR ZERO JMP ALTBAD / ERROR - OVERFLOW HAS OCCURED JMP I ALTTST / RETURN TO CALLER / SEE IF OK TO DO PAGE OR PASTE EXIT. ALTCHK, TAD GETLEN / GET CURRENT LENGTH SZA CLA / ACC ZERO ? JMP ALTBAD / NO, GO BEEP THE BUZZER -- /\ JMP ALTXIT / YES, ALLOW EXIT -- ALTXIT, JMS ALTST1 / STORE ZERO IN LAST LOCATION OF BUFFER JMP OV2JRT / RETURN TO CALLER IN SEARCH OVERLAY ALTMS1, XX / CHARACTER SET SELECTION CODE ALTMS2, XX / ASCII CHARACTER TO BE OUTPUT 0 / TERMINATOR FOR ASCII STRING ALTMS3, XX / COPY OF LANGUAGE WORD FROM MENU X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------------------ PAGE / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / EXIT DISPATCH TABLE. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - XXFTBL, EDPWFL; ALTRO / POWER FAIL CODE EDRBCH; ALTRO / RUBOUT CHARACTER CODE EDRBWD; ALTRW / RUB WORD CHARACTER CODE EDNWLN; ALTCR / CARRIAGE RETURN CODE EDTAB; ALTTAB / TAB EDRULR; ALTXIT / GOLD:RULER KEYS EDPAGE; ALTCHK / PAGE KEY EDCONT; ALTXIT / CONTINUE EDADVN; ALTXIT / ADVANCE KEY EDBKUP; ALTXIT / BACKUP KEY EDSRCH; ALTXIT / SEARCH KEY EDCONT; ALTXIT / CONTINUE SEARCH KEY EDPSTE; ALTCHK / PASTE /D189 EDDO; ALTXIT / DO EDDO; ALTBAD / DO - DISABLE KEY FOR NOW /A189 EDENTR; ALTXIT / ENTER KEY /D189 EDENTR; ALTBAD / ENTER KEY - DISABLE KEY FOR NOW /A189 EDMENU; ALTXIT / GOLD:MENU KEY EDRQSP; ALTRQS / GOLD:SPACE (REQUIRED SPACE) EDTC; ALTTEC / TECHNICAL CHARACTER KEY 0 / END OF TABLE INDICATOR / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / RUBOUT. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTRO, JMS ALTROR / CALL RUBOUT ROUTINE ONCE JMP ALTNXT / GO GET NEXT CHARACTER / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / RUBOUT WORD. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTRW, JMS ALTROR / DO A RUBOUT JMS ALTGT1 / PICK UP CHARACTER FROM MENU TEXT BUFFER TAD (-40) / SUBTRACT VALUE FOR A SPACE SZA CLA / SITTING ON A BLANK? JMP ALTRW / NO - DO RUBOUT AGAIN JMP ALTNXT / YES - DONE, GO GET NEXT CHARACTER / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / DO SCREEN RUBOUT. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTROR, XX / ROUTINE TO RUBOUT A CHARACTER AC7777 / SET UP TO DECREMENT THE COUNT TAD GETLEN / GET THE COUNT OF CHARACTERS ENTERED SO FAR SPA / CHECK FOR A ZERO COUNT JMP ALTCLR / NONE, SO JUST IGNORE THE RUBOUT FUNCTION DCA GETLEN / STORE THE DECREMENTED COUNT OF CHARACTERS CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL / CALL SYSTEM DISPLAY ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE ALTRUB / CONTROL STRING TO RUBOUT FUNCTION JMP I ALTROR / RETURN TO CALLER ALTRUB, TEXT '^R' / RUBOUT BY BAKSPACE-SPACE-BACKSPACE / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / SETUP ADDRESS VECTOR INTO MENU TEXT BUFFER. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTADR, XX / ROUTINE TO SET THE BUFFER POINTER AC0001 / SET THE ACCUMULATOR TO A VALUE OF ONE TAD GETLEN / PICK UP THE CHARACTER COUNT TAD (MNIBUF-1) / ADD TO THE USER'S BUFFER ADDRESS JMP I ALTADR / RETURN TO CALLER / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / STORE CHARACTER IN THE MENU TEXT BUFFER. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTST1, XX DCA T1 / SAVE ACCUMULATOR FOR NOW. JMS ALTADR / COMPUTE CURRENT ADDRESS DCA ALTS04 / SAVE ADDRESS. TAD T1 / RESTORE ACCUMULATOR JMS MNUPUT / SAVE IN MENU BUFFER ALTS04, .-. JMP I ALTST1 / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / GET CHARACTER FROM MENU TEXT BUFFER. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTGT1, XX JMS ALTADR / COMPUTE CURRENT ADDRESS DCA ALTG04 / SAVE ADDRESS. JMS MNUGET / SAVE IN MENU BUFFER ALTG04, .-. JMP I ALTGT1 / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / GET CHARACTER FROM KEYBOARD BUFFER. / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ALTCHR, XX / GET CHARACTER FROM USER JMP ALTINP / SKIP OVER JWAIT INSTRUCTION ALTWAT, CIFSYS / CHANGE TO SYSTEM FIELD JWAIT / WAIT FOR SIGNIFICANT EVENT ALTINP, CIFSYS / CHANGE TO SYSTEM FIELD XLTIN / GET A CHARACTER FROM THE KEYBOARD JMP ALTWAT / NONE THERE, GO WAIT FOR SOME JMP I ALTCHR / RETURN TO CALLER ALTMSG, TEXT '![(&^S^A![(&^S' / CONTROL STRING FOR GRAPHICS OUTPUT ALT8BF, AND (200) / Check 8th bit /A228 SNA CLA / /A228 JMP ALT7DP / 7 bit job display and Insert it /A228 TAD (62) / Its 8 bit so must be MNC /A228 DCA TECSET / Pretend its a tech /A228 TAD GETTRM / Get char /A228 AND P177 / Strip 8th bit /A228 DCA TECMAP / Store it /A228 TAD TECMAP / Get it back /A228 TAD (2000) / Set precedence of 2 /A228 / We can now rejoin main code as if we /A228 / had found a Tech Char and set up the /A228 / things that TECVAL would do ! /A228 JMP ALTFND X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------------------ PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 / NEW OVERLAY OVRBLK=OV2NUM%200+DLOEDO+36 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM / / THIS IS A CONTINUATION OF OVVIEW. / IT IS A LOOP THAT PUTS UP THE VIEW MODE SCREEN. / OVVWB1= .-OVLAY2+OV2NUM / COPY VARIABLES FROM LAST OVERLAY TO THIS OVERLAY / FROM SUBR ENTRY POINTS USED AS TEMP VARIABLES ACROSS OVLJMP /D219 TAD I ADVSPC&177 TAD VWX1 /A219 DCA VIEWX1 /D219 TAD I BKPSPC&177 TAD VWX2 /A219 DCA VIEWX2 / TAD CURPTR / SAVE CURRENT TEXT PTR DCA VIEWCP / / DISPLAY NEXT TEXT LINE / VIEWB1, JMS VIEWAC / POSITION CURSOR AT NEXT TEXT LINE TAD I VIEWX1 DCA CURPTR / SET TO START OF LINE JMS LODCHR JMP VIEWB2 / QUIT IF EOF / / DISPLAY NEXT TEXT LINE / VIEWB3, JMS VIEWLK / LOOK UP IN SPECIAL TABLE JMP VIEWB4 / JUMP IF NORMAL (NOT IN TABLE) SNA / AC=SPECIAL GRAPHICS CHAR TO DISPLAY JMP VIEWB5 / JUMP IF IGNORE CHAR DCA VIEWTP / ELSE SAVE TYPE TAD VIEWTP / CHECK FOR PAGE-RULER RAL SMA CLA JMP VIEWB6 / JUMP IF NOT TAD VIEWX3 / PAGES AND RULERS SZA CLA JMP VIEWC1 / QUIT IF NOT WHOLE LINE TAD VIEWTP RTL SMA CLA JMP VIEWPG / JUMP IF PAGE JMS DSPRLN / ELSE DO RULER JMP VIEWC1 / AND QUIT /D190 JMS VWMODE /D190 IFDEF ENGLSH < /D190 IFNDEF ENGCAN < /D190 "B&177 / LEAVE GRAPHICS MODE /D190 > / END IFNDEF ENGCAN /D190 IFDEF ENGCAN < /D190 "3-200 /D190 > / END IFDEF ENGCAN /D190 > / END ENGLSH /D190 IFDEF CANADA < /D190 "3-200 /D190 > / END IFDEF CANADA /D190 IFDEF FRENCH < /D190 "R-200 /D190 > / END IFDEF FRENCH /D190 IFDEF DUTCH < /D190 "4-200 /D190 > / END IFDEF DUTCH VIEWB4, CDFBUF / PUT NORMAL CHAR TAD I CURPTR DCA VIEWTP / SAVE IN TEMP. TAD VIEWTP / GET BACK. AND P177 / CHECK FOR TAB CHARACTER. TAD LITV01 / ... SNA CLA / SKIP IF NOT TAB. JMP VIEWB8 / JMP TO PROCESS THE TAB CHARACTER. / / NOW CONSIDER WHAT TO DISPLAY BELOW TEXT CHAR. / IF CHAR WAS A "REQUIRED SPACE", THEN DISPLAY A "^" UNDERNEATH; / ELSE ATTRIBUTES WILL DETERMINE CHAR BELOW. / TAD VIEWTP / GET TEXT CHAR TAD (-ECSTOV) / WAS CHAR AN OVERSTRIKE SEQUENCE? SNA CLA /M231 JMP VIEWBZ / Dead , find out what type bypass test /A231 JMP VIEWBA / Not dead , display text char /A231 /d231 TAD PUTSC6 / YES: WAS IT REALLY A REQUIRED SPACE? /d231 AND P177 / (IGNORE ATTRIBUTES) /d231 TAD (-ECSPC) /d231 SZA CLA /d231 JMP VIEWBA / NOT REQ SPC , CHECK MCS / / We are here because we found a required space / VIEWSP, TAD VIEWTP / GET CHARACTER TO OUTPUT BACK. /A231 JMS PUTSCH / DISPLAY TEXT CHAR /A231 TAD ("^&177+4000) / YES: DISPLAY "^" BELOW REQUIRED SPACE JMP VIEWB9 / SHOW ATTRIBUTES (SUPERSCRIPT, SUBSCRIPT, "BREAKING", AND / REDUNDANT BOLD) BENEATH TEXT CHAR. / VIEWBA, TAD VIEWTP / GET CHARACTER TO OUTPUT BACK. /M231 JMS PUTSCH / DISPLAY TEXT CHAR /M231 JMP VIEWBC / And now attributes /M231 VIEWBB, CDFMYF / Rejoined here from VIEWBZ so change /A231 / back to buffer field /A231 DCA VIEWTP / Save char with attributes /A231 VIEWBC, TAD VIEWTP / GET CHAR BACK (FOR ATTRIBUTE BITS) RAR BSW AND (17) TAD (VIEWTD) DCA T1 TAD I T1 SNA JMP VIEWB7 / DON'T BOTHER WITH SPACES. VIEWB9, DCA ATR / AND OUTPUT IT (ON THE NEXT LINE). PUTESC / ... "[&177+4000 / "CURSOR DOWN" "B&177+4000 / ... 10+4000 / "BACK SPACE" ATR, 0+4000 / THE ATTRIBUTE OF CHARACTER (OR "^") 33+4000 / "CURSOR UP". "[&177+4000 / ... "A&177 / .... VIEWB7, JMS VIEWAD / BUMP COUNTER JMP VIEWC1 / JUMP IF DONE VIEWB5, ADVSPC JMP VIEWB2 / ELSE ADVANCE PTR JMP VIEWB3 / AND LOOP VIEWB8, TAD VIEWTP / GET THE TAB BACK (WITH ATTRIBUTES) TAD LITV02 / TRANSLATE TO GRAPHICS VIEWB2, TAD (4000+EXGETX) / ETX SYMBOL DCA VIEWTP /D190 JMS VWMODE /D190 "0-200 / ENTER GRAPHICS MODE VIEWB6, CDFMYF / /A192 PUTESC / ENTER GRAPHICS MODE /A192 "(+3600 / /A192 "0-200 / /A192 TAD VIEWTP / GET CHAR JMS PUTSCH JMS MNUGET / PICK UP CURRENT LANGUAGE WORD /A192 MNLANG / LOCATION FOR LANGUAGE WORD /A192 SMA / SKIP IF A NUMBER CODE /A192 IAC / CONVERT TO UPPER CASE ASCII /A192 BSW / PUT BITS INTO PROPER ORDER /A192 DCA VWLNG / STORE IN LINE FOR PUTESC ROUTINE /A192 PUTESC "(+3600 VWLNG, "0 / OVERLAYED WITH LANGUAGE CODE VALUE /A224 TAD VIEWTP / CHECK FOR END SMA CLA JMP VIEWB7 / JUMP IF NOT /D190 JMS VWMODE /D190 IFDEF ENGLSH < /D190 IFNDEF ENGCAN < /D190 "B-200 / LEAVE GRAPHICS MODE /D190 > / END IFNDEF ENGCAN /D190 IFDEF ENGCAN < /D190 "3-200 /D190 > / END IFDEF ENGCAN /D190 > / END IFDEF ENGLSH /D190 IFDEF CANADA < /D190 "3-200 /D190 > / END IFDEF CANADA /D190 IFDEF FRENCH < /D190 "R-200 /D190 > / END IFDEF FRENCH /D190 IFDEF DUTCH < /D190 "4-200 /D190 > / END IFDEF DUTCH VIEWC1, JMP VIEWD1 / GET FIRST CHAR LITV01, -ECTAB LITV02, EXGTAB-ECTAB-4000-EXGETX VIEWX1, 0 / -(# OF TEXT BUF LINES LEFT TO DISPLAY) VIEWX2, 0 / PTR INTO PTRBLK FOR CURRENT DISPLAY LINE VIEWX3, 0 / CURRENT COLUMN # VIEWCP, 0 / SAVED CURPTR VIEWTP, 0 / CURRENT CHARACTER BEING DISPLAYED OVRLOF= .-OVLAY2+OV2NUM JMP RLONOF /A192 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE VIEWPG, CDFBUF / GET CHAR BACK TAD I CURPTR JMS I TLITEA / PUT PROPER PAGE MARKER JMP VIEWC1 / AND QUIT TLITEA, PGECHO / **TEMP FOR OS/ 8 LIT POOL LIMIT BYPASS / / SET LOOP COUNTER AND CURLIN AND CURSOR POSITION / VIEWAC, XX CDFMYF TAD VIEWX2 / GET LINE LOOP COUNTER STL RAL / TIMES 2, +1 DCA CURLIN / =LINE NUMBER FOR PCUR DCA VIEWX3 / CLEAR CHAR LOOP COUNTER JMS PCUR / MOVE CURSOR TO START OF LINE JMP I VIEWAC / AND RETURN / / TEST LOOP COUNTER, TAKE SKIP RTN IF NOT DONE / VIEWAD, XX CDFMYF ISZ VIEWX3 / BUMP COUNTER TAD WIDNAR / WIDE SCREEN MODE? /M192 SNA CLA / SKIP IF NOT. COMPUTE MAX NARO WIDTH /M192 TAD (-WIDTH+COLM81) / COMPUTE MAX WIDE WIDTH TAD (-COLM81) / COMPUTE MAX NARO WIDTH TAD LOWLIM / Bais by start colm #. TAD VIEWX3 / SEE IF WITHIN LINE SPA CLA / SKIP IF YES. ISZ VIEWAD / SKIP RETURN WHEN DONE JMP I VIEWAD /D190 / SUBR VWMODE -- ENTER/EXIT GRAPHICS MODE. /D190 / DOES NOT OUTPUT REDUNDANT ESCAPE SEQUENCES. /D190 / CHANGED TO PUT OUT "(" BEFORE CHARACTER FOR VT-278. /D190 / /D190 / CALL: /D190 / / AC & DF DON'T MATTER /D190 / JMS VWMODE /D190 / CHAR / ASCII CODE OF CHAR TO OUTPUT /D190 / /D190 VWMODE, XX /D190 CLA /D190 CDFMYF /D190 TAD I VWMODE /D190 CIA /D190 TAD VWMOD1 /D190 SNA CLA /D190 JMP VWMOD2 /D190 TAD I VWMODE /D190 DCA VWMOD1 /D190 PUTESC /D190 "(+3600 /D190 VWMOD1, .-. /D190 VWMOD2, ISZ VWMODE /D190 JMP I VWMODE VIEWD1, CDFMYF ISZ VIEWX1 / BUMP LINE PTR ISZ VIEWX2 / AND COUNTER JMP VIEWB1 / LOOP IF MORE LINES TO DO TAD VIEWCP DCA CURPTR / ELSE RESTORE CURPTR TAD CURTMP / RESTORE CURSOR POSITION DCA CURSOR OVLJMP OVVWDX VIEWLK, XX / LOOK UP FOR SPECIALS CDFMYF AND (7777-200) / IGNORE BOLD BIT DCA T1 TAD (VIEWTB-1) DCA X0 / INIT TABLE SEARCH PTR VIEWL1, TAD I X0 SNA JMP I VIEWLK / ZERO MARKS END (NOT SPECIAL) TAD T1 / COMPARE SZA CLA JMP VIEWL1 / LOOP IF NOT EQUAL TAD (VIEWTC-VIEWTB) / ELSE GET VALUE TAD X0 DCA T1 TAD I T1 SMA SZA TAD CHRATR / ADD ATTRIBUTES TO SOFT SPACES ISZ VIEWLK / BUMP TO OK RETURN JMP I VIEWLK / AND TAKE IT VIEWTB, / LOOK UP TABLE -ECMDFL / LINE MOD FLAG -ECNWLN / NEW LINE -ECWWLN / WORD WRAP -ECHYLN / HYPH WRAP -ECPGRF / END PARA -ECENLN / CENTERED LINE -ECSLPT / SELECT POINT -ECNWPG / NEW PAGE -ECPMRK / PAGE MARKER -ECPCT1 / START PRINT CONT. -ECPCT2 / END PRINT CONT. -ECSTRL / RULER START -ECJSPC / JUSTIFY SPACE VIEWTC, 0 / *** BELONGS TO TWO TABLES: / VIEWTB: END OF TABLE / VIEWTC: VALUE FOR ECMDFL / FLAG BITS USED IN VIEWTC: / 4000=END OF LINE / 6000=PAGE / 7000=RULER 4000+EXGNLN / NEW LINE (CR) 4000+EXGWLN / WORD WRAPPED LINE (DEGREE) 4000+EXGHLN / HYPH WRAPPED (-) 4000+EXGPGF / PARA (T) 4000+EXGCEN / CENTERED LINE (+) 4000+EXGSLC / SELECT POINT (SOLID DIAMOND) 6000 6000 6000 6000 7000 EXGJSP / / VIEWTD -- ATTRIBUTE TRANSLATE TABLE / / TABLE VIEWTD IS INDEXED BY THE ATTRIBUTE FIELD OF THE / CURRENT CHAR (BITS 1-4). / VIEWTD CONTAINS THE CHARACTER THAT APPEARS DIRECTLY BELOW / EACH DOCUMENT CHARACTER IN VIEW MODE TO REVEAL THE / ATTRIBUTES OF THE DOCUMENT CHARACTER. / VIEWTD, / ATTRIBUTE TRANSLATE TABLE 0 / " " - NO ATTRIBUTE 0 / " " - BOLDED - NO SPECIAL CHAR 0 / " " - UNDERLINED - NO SPECIAL CHAR 0 / " " - BOLD & UNDERLINED - NO SPEC CHR IFNDEF FRENCH < "Q&177+40+4000 / "q" - SUPERSCRIPT "Q&177+4000 / "Q" - BOLDED SUPERSCRIPT "A&177+40+4000 / "a" - SUBSCRIPT "A&177+4000 / "A" - BOLDED SUBSCRIPT > / END IFNDEF FRENCH IFDEF FRENCH < "A+40+4000 / "a" - SUPERSCRIPT "A+4000 / "A" - BOLDED SUPERSCRIPT "Q+40+4000 / "q" - SUBSCRIPT "Q+4000 / "Q" - BOLDED SUBSCRIPT > / END IFDEF FRENCH "/&177+4000 / "/" - HYPHEN "/&177+4000 / "/" - HYPHEN & BOLDED "/&177+4000 / "/" - HYPHEN & UNDERLINED "/&177+4000 / "/" - HYPHEN, UNDERLINED, & BOLDED IFNDEF FRENCH < "Q&177+40+4000 / "q" - HYPHEN & SUPERSCRIPT "Q&177+4000 / "Q" - HYPHEN & BOLDED SUPERSCRIPT "A&177+40+4000 / "a" - HYPHEN & SUBSCRIPT "A&177+4000 / "A" - HYPHEN & BOLDED SUBSCRIPT > / END IFNDEF FRENCH IFDEF FRENCH < "A+40+4000 / "a" - HYPHEN & SUPERSCRIPT "A+4000 / "A" - HYPHEN & BOLDED SUPERSCRIPT "Q+40+4000 / "q" - HYPHEN & SUBSCRIPT "Q+4000 / "Q" - HYPHEN & BOLDED SUBSCRIPT > / END IFDEF FRENCH / +++ WE JUST GOT CALLED FROM EITHER OVINIT OR OVMENU IN OVERLAY #1 /A177 / /A177 / THIS ROUTINE IS CALLED FROM OVINIT AND OVMENU TO CHECK /A177 / THE MNSTAT (EDITOR STATUS WORD) AND MODIFY THE CASE-TABLE /A177 / AT RULOFF (IN WPEDIT) SUCH THAT RULERS ARE EITHER ON OR OFF /A177 / /A177 / MNSTAT = 0 OR 1 ... RULERS ON /A177 / MNSTAT = 2 OR 3 ... RULERS OFF /A177 / /A177 RLONOF, JMS MNUGET / GET THE EDITOR-STATUS-WORD /A177 MNSTAT /A177 TAD (-2) /A177 CLA / (FORCE RULERS TO BE ON ALL THE TIME) /D177 SPA CLA / RULERS ON OR OFF? /A177 TAD (PUTLNR-PUTLN3) / ...ON... /A177 TAD (PUTLN3) / ...OFF.. /A177 DCA RULOFF / MODIFY THE TABLE /A177 JMP OV2JRT / RETURN TO OVERLAY 2 JUMP ROUTINE /A177 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 OVRBLK=OV2NUM%200+DLOEDO+36 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM OVSLID= .-OVLAY2+OV2NUM / SOLIDIFY TEXT ENTRY JMP ESOLID OVSOFT= .-OVLAY2+OV2NUM / SOFTEN TEXT ENTRY JMP ESOFT OVDCEL= .-OVLAY2+OV2NUM / FIND NEXT SEGMENT PROCESSING DOCCEL, CDFBUF TAD I CURPTR JMP DOCC21 DOCC22, ADVPTR /FIND THE EOL MARK HLT /SHOULDN'T HAPPEN TO A DOG DOCC21, AND P177 TAD (-ECNWLN) SZA CLA JMP DOCC22 /NOT FOUND YET TAD I CURPTR /CHECK IT BETTER BE A HARD RETURN TAD (-ECNWLN) SZA CLA JMP GODOER /ERROR WRAP RETURN DOCC17, AC0001 /FORWARD TO BEGINNING OF NEXT LINE CURMOV NOP /DON'T CAR ABOUT EOF TAD CURPTR /SAVE CURRENT PTR DCA IX1 TAD LINE23 /FIND OUT WHAT PREVIOUS LINE ENDER DCA CURPTR /WAS BKPPTR HLT /CAN'T HAPPEN TAD (-ECNDRL) /END RULER? SNA CLA JMP GODOER /YES ERROR TAD IX1 /RESTORE PTR DCA CURPTR TAD I CURPTR /CHECK IF SKIPPING IS NECESSARY AND P177 /STRIP MODE BITS TAD (-ECNWPG) /SKIP PAGE MARKS CONTROL BLOCKS ETC. SNA CLA JMP DOCCPG /GO CHECK IT OUT DOCC13, CDFMYF TAD CLMPLL /CHECK FOR LOWER LIMIT OF COLUMN CIA /<=CURSOR TAD CURSOR SMA CLA JMP DOCC18 /YES GO EXECUTE DOCC14, JMS LODCHR /GET CHAR UNDER PTR HLT /CATASTROPHIC ERROR AND P177 /CHECK FOR TAB OR EOL ZZCASE DCCTB3-1 / ECTAB; DOCC15 /TAB DO LIMIT CHECK / ECNWLN; GODO11 /NEWLINE DO EMPTY COLUMN / ECMDFL; DOCC16 /MODIFIED FLAG SKIP / ECSTRL; GODOER /START RULER ERROR / ECNWPG; GODOER /NEW PAGE ERROR / 0 ISZ CURSOR /BUMP CURSOR DOCC16, ADVSPC /TRY NEXT CHARACTER HLT JMP DOCC14 DOCC15, AC0001 /FIND FIRST CHAR OF COLUMN CURMOV HLT JMP DOCC13 /GO CHECK BOUNDARIES DOCC18, OVLJMP /GO TRY NEXT COLUMN OVDOCC / DOCCPG DO PAGE AND CONTROL BLOCK HANDLING / / DOCCPG, TAD I CURPTR /GET CHARACTER AND CHECK TYPE ZZCASE DCCTB4-1 / ECNWPG; DOCC17 /NEW PAGE CHECK NEXT LINE / ECPMRK; DOCC17 /PAGE MARK GO CHECK NEXT LINE / ECPCT1; DCPG01 /CONTROL BLOCK SKIP / ECPCT2; GODOER /END CONTROL BLOCK IS ERROR / 0 HLT /SHOULD NOT BE ABLE TO GET HERE DCPG01, CDFMYF DCA SETRUL /SET FLAG TO FIND OUT IF RULER PASSED DCPG02, AC0001 /SEARCH FOR END CONTROL CURMOV HLT TAD I CURPTR /CHECK FOR END CONTROL AND SELECT POINT TAD (-ECPCT2) SNA JMP DCPG03 /END CONTROL FOUND BREAK OUT TAD (ECPCT2-ECSLPT) SZA JMP DCPG02 /NOT THIS TIME CHARLEY DCA I CURPTR /DELETE SELECT POINT SLNMOD /SET LINE MODIFIED JMS REJUST /REJUSTIFY THE LINE JMP EIFIX /DONE DCPG03, CDFMYF TAD SETRUL /RULER PASSED? SNA CLA JMP DOCC17 /NO GO DO NEXT COLUMN JMS BEEPER /DIE YOU GRAVY SUCKING PIG JMP UNSLCT / GODO11 - SELECT OR END OF LINE DETECTED GODO11, TAD I CURPTR /PICK UP THE BUFFER CHARACTER /A221 TAD (-ECNWLN) /COMPARE AGAINST END OF LINE /A221 SZA CLA /IS THIS A REAL END OF LINE /A221 JMP GODOSE /NO, GO HANDLE SELECT ERROR /A221 OVLJMP /OVERLAY TRANSFER TO DOCC11 OVDC12 /C203 / GODOSE - SELECT MARK ERROR DETECTED ON TEXT LINE /A221 GODOSE, TAD LINE23 /PICK UP BEGINNING OF LINE POINTER /A221 JMP GODOBP /GO STORE BUFFER POINTER /A221 / GODOER - ERROR CONDITION DETECTED GODOER, TAD IX1 /PICK UP THE SAVED BUFFER POINTER GODOBP, DCA CURPTR /RESET THE BUFFER POINTER /C221 OVLJMP /OVERLAY TRANSFER TO DOCCER OVDOER / COLUMNAR CUT CASE TABLES / / DCCTB3, ECTAB; DOCC15 /TAB DO LIMIT CHECK ECNWLN; GODO11 /NEWLINE DO EMPTY COLUMN ECMDFL; DOCC16 /MODIFIED FLAG SKIP ECSTRL; GODOER /START RULER ERROR ECNWPG; GODOER /NEW PAGE ERROR 0 DCCTB4, ECNWPG; DOCC17 /NEW PAGE CHECK NEXT LINE ECPMRK; DOCC17 /PAGE MARK GO CHECK NEXT LINE ECPCT1; DCPG01 /CONTROL BLOCK SKIP ECPCT2; GODOER /END CONTROL BLOCK IS ERROR 0 X=. /--------------------- PAGE / ESOLID SOLIDIFY TEXT BY REPLACINF SOFT RETURNS / / ESOLID, TSTSLT JMP EIBAD SOLID1, CDFBUF TAD I CURPTR JMP SOLID2 SOLID3, ADVSPC JMP EIBAD SOLID2, ZZCASE SLIDTB-1 / ECNWLN; SOLID4 / HARD RETURN DO NOTHING / ECPGRF; SOLID4 / PARA. MARK DO NOTHING / ECENLN; SOLID4 / CENTER DO NOTHING / ECWWLN; SOLID5 / WORD WRAP SOLIDIFY / ECHYLN; SOLID5 / HYPHEN WRAP SOLIDIFY / ECSLPT; SDSFEX / SELECT POINT DELETE AND EXIT / ECMDFL; SOLID7 / MODIFIED FLAG EXECUTE / ECRMFL; SOLID7 / DITTO / ECSTRL; SOLID4 / SKIP RULERS / ECPMRK; SOLID4 / SKIP PAGE MARKS / ECPCT1; SOLID4 / SKIP PRINT CONTROL / ECPCT2; SOLID4 / DITTO / ECNWPG; SOLID4 / SKIP NEW PAGE / 0 ISZ CURSOR / BUMP CURSOR TO REFLECT CURMOV / KEEP CURMOV HAPPY JMP EIBAD / CATASTROPHIC ERROR JMP SOLID3 / DO NEXT CHAR SOLID5, TAD (ECNWLN) / SOLIDIFY LINE ENDER DCA I CURPTR SOLID4, AC0001 CURMOV JMP EIBAD JMP SOLID1 SOLID7, CURMOV / REJUSTIFY ON FLAG JMP EIBAD JMP SOLID1 / FETCH CHAR DIRECT / ESOFT SOFTEN TEXT BY REPLACING HARD RETURNS / / ESOFT, TSTSLT JMP EIBAD CDFBUF JMP SOFT2 SOFT3, AC0001 CURMOV JMP EIBAD SOFT2, TAD I CURPTR TAD (-ECNWLN) SNA JMP SOFT5 TAD (ECNWLN-ECSLPT) SZA CLA JMP SOFT3 SDSFEX, TAD (ECMDFL) / PUT MODIFIED FLAG IN TO DCA I CURPTR / DELETE SELECT POINT DCA EDMODE / RESET EDIT MODE JMP EIFIX / GO GET NEXT COMMAND SOFT5, TAD (ECMDFL) / SOFTIFY LINE ENDER DCA I CURPTR CURMOV JMP EIBAD JMP SOFT2 / SOLIDIFY AND SOFTEN TEXT CASE TABLES / / SLIDTB, ECNWLN; SOLID4 / HARD RETURN DO NOTHING ECPGRF; SOLID4 / PARA. MARK DO NOTHING ECENLN; SOLID4 / CENTER DO NOTHING ECWWLN; SOLID5 / WORD WRAP SOLIDIFY ECHYLN; SOLID5 / HYPHEN WRAP SOLIDIFY ECSLPT; SDSFEX / SELECT POINT DELETE AND EXIT ECMDFL; SOLID7 / MODIFIED FLAG EXECUTE ECRMFL; SOLID7 / DITTO ECSTRL; SOLID4 / SKIP RULERS ECPMRK; SOLID4 / SKIP PAGE MARKS ECPCT1; SOLID4 / SKIP PRINT CONTROL ECPCT2; SOLID4 / DITTO ECNWPG; SOLID4 / SKIP NEW PAGE 0 X=. /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 / NEW OVERLAY OVRBLK=OV2NUM%200+DLOEDO-1+37 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM / DOCLPS DO COLUMN PASTE / / PASTE CHARACTERS INTO THE TEXT BUFFER UNTIL THE PASTE BUFFER IS / EMPTY, OR THE END OF A LINE SEGMENT IS REACHED, OR AN ILLEGAL / CHARACTER IS FOUND IN THE PASTE BUFFER. OVDOPS= .-OVLAY2+OV2NUM DOCLPS, CDFBUF TAD I PSTPTR /GET CHAR FROM PASTE BUFFER SNA /ZERO IS END OF PASTE BUFFER /M215 /(SHOULDN'T HAPPEN HERE) /M215 JMP EIFIX /DONE NO MORE TO PASTE /M215 DCP001, AND P177 /STRIP MODE BITS ZZCASE /COMPARE AGAINST LIST CLPTB1-1 / ECNWLN; DCP002 /END OF SEGMENT / ECNWPG; DCP003 /ILLEGAL CHAR TO PASTE DUMP TEXT / ECSTRL; DCP021 /START OF RULER, SKIP TO END OF RULER / 0 TAD I PSTPTR /RETRIEVE CHAR INSCHR /PASTE IT IN DCP017, JMS DCPGNC /GO GET NEXT CHAR JMP DCPXIT /RAN OUT OF PASTE TEXT SO QUIT /C215 SZA /ZERO IS END OF PASTE BUFFER /A215 JMP DCP001 /GO PASTE NEXT CHAR IN DCPXIT, JMS DCPEOL /DO END OF SEGMENT PROCESSING /A215 NOP /END OF BUFFER RETURN /A215 JMP EIFIX /ALL DONE, GO GET NEXT EDIT COMMAND /A215 / DCP003 DUMP PASTE TO TEXT BUFFER / / UNDER AN ERROR CONDITION THE PASTE BUFFER IS DUMPED TO THE / TEXT BUFFER WITHOUT AND FURTHER FORMATTING. DCP003, CDFBUF /CHANGE TO BUFFER FIELD /A215 TAD I PSTPTR /FETCH PASTE CHAR DCP004, SNA JMP EIFIX /END OF PASTE BUFFER TAD (-ECSTRL) /IS IT A RULER? SNA CLA JMP DCP005 /SKIP TO END OF RULER BEFORE RESUMING /PASTE TAD I PSTPTR /PASTE CHAR INTO TEXT BUFFER INSCHR DCP006, JMS DCPGNC /FETCH NEXT CHARACTER JMP EIFIX /DONE NO MORE PASTE JMP DCP004 /PROCESS NEXT CHARACTER DCP005, JMS DCPGNC /SKIP TO END OF RULER JMP EIFIX TAD (-ECNDRL) SNA CLA JMP DCP006 JMP DCP005 / DCP021 SKIP RULERS IN PASTE BUFFER DCP021, JMS DCPGNC /SKIP TO END OF RULER JMP EIFIX TAD (-ECNDRL) SNA CLA JMP DCP017 JMP DCP021 / DCPEOL END OF SEGMENT PROCESSING /C215 / / WHEN AN EOL MARK IS FOUND IN THE PASTE BUFFER THIS IS TAKEN AS / DELIMITING A SEGMENT OF COLUMN TEXT. IF THE NEXT CHARACTER AFTER / THE END OF THE SEGMENT IS A HARD RETURN THEN DON'T INSERT A / TRAILING TAB AFTER THE SEGMENT. DCPEOL, XX /DO END OF SEGMENT PROCESSING /A215 JMS LODCHR /GET NEXT CHAR FROM TEXT BUFFER JMP I DCPEOL /END OF FILE - RETURN TO CALLER /C215 TAD (-ECNWLN) SNA CLA JMP DCP007 /GO FIND THE NEXT PLACE TO PASTE TEXT TAD (ECTAB) INSCHR DCP007, SLNMOD JMS REJUST ISZ DCPEOL /BUMP RETRUN ADDRESS /A215 JMP I DCPEOL /RETURN TO CALLER /A215 / FOUND END OF SEGMENT IN PASTE BUFFER DCP002, JMS DCPEOL /GO DO END OF SEGMENT PROCESSING /C215 SKP /END OF TEXT BUFFER DETECTED /C215 JMP DCP008 /GO FIND THE NEXT LINE ENDER DCPNWL, TAD (ECNWLN) /PICK UP LINE ENDER TO FINISH COLUMN /A215 INSCHR /INSERT THE LINE ENDER /A215 SLNMOD /SET THE LINE MODIFIED FLAG /A215 JMS REJUST /FIX THE LINE /A215 JMP DCP009 /NOW TREAT END OF TEXT AS A SHORT LINE /A215 / DCP008 FIND NEXT LINE ENDER / / THE LINE FOLLOWING THE NEXT LINE ENDING IN A HARD RETURN IS THE / LINE IN WHICH TO INSERT THE NEXT COLUMN SEGMENT FROM THE PASTE / BUFFER. IF A PAGE MARK/CONTROL BLOCK IS FOUND THEN THE PAGE / MARK OR THESTART CONTROL END CONTROL PAIR IS SKIPPED AND THE / SEARCH PROCEEDS FOR THE HARD RETURN. IF A RULER OR END OF / TEXT IS FOUND PRIOR TO A LINE ENDING IN A HARD RETURN THEN / DUMP THE TEXT WITHOUT CROSSING THIS VIRTUAL BOUNDARY. IF THE / HARD RETURN IS FOUND THEN GO FIND THE CORRECT COLUMN POSITION. DCP008, TAD I CURPTR /FETCH THE NEXT CHAR FROM THE TEXT /C216 TAD (-ECNWLN) /HARD RETURN? /C216 SNA CLA JMP DCP009 /YES GO FIND COLUMN POSITION TAD I CURPTR /IS CHAR A PAGE MARK? AND P177 TAD (-ECNWPG) SNA CLA /C216 JMP DCP010 /YES, GO SKIP TO NEXT LOGICAL POSITION SKP / NOT NECESSARY TO SET THE LINE MOD /A193 DCP011, SLNMOD / FLAG AFTER EVERY CHARACTER ADVSPC /GO GET NEXT CHAR JMP DCPNWL /RAN OUT OF TEXT SO GO ADD A LINE ENDER /C215 TAD (-ECSTRL) /IS CHAR A RULER? /C216 SNA CLA /M216 JMP DCP006 /YES, GO DUMP THE REST OF TEXT /M216 CURMOV /FIXUP PTRBLK /M216 HLT /SHOULD NEVER HIT EOF HERE /M216 JMP DCP008 /TEST NEXT CHARACTER / DCP010 CHECK PAGE MARKS / / IF WHILE SEARCHING FOR THE HARD RETURN EOL A PAGE MARK, NEW / PAGE, OR START/END CONTROL IS SEEN THEN CHECK. SKIP NEW PAGE / AND PAGE MARK. SKIP TO END OF CONTROL BLOCK ON START CONTROL / AND DUMP TEXT DUE TO ERROR ON END CONTROL. DCP010, TAD I CURPTR ZZCASE CLPTB2-1 / ECNWPG; DCP011 /NEW PAGE / ECPMRK; DCP011 /PAGE MARK / ECPCT1; DCP012 /START CONTROL / ECPCT2; DCP006 /END CONTROL / 0 DCP012, AC0001 CURMOV JMP DCP006 TAD I CURPTR TAD (-ECPCT2) SNA CLA JMP DCP011 JMP DCP012 / DCP015 SKIP TO END OF CONTROL BLOCK DCP015, AC0001 /MOVE FORWARD A CHARACTER CURMOV JMP DCP006 /END OF TEXT DUMP PASTE BUFFER TAD I CURPTR /FETCH CHARACTER TAD (-ECPCT2) /END CONTROL? SNA CLA JMP DCP009 /YES GO PROCESS BEGINNING OF LINE JMP DCP015 /TRY NEXT CHARACTER / DCP013 DUMP TEXT BEFORE RULER / / IF A RULER CHANGE OCCURS DUMP THE PASTE BUFFER BEFORE THE / RULER. DCP013, TAD X5 /RESTORE THE CURSOR POSITION DCA CURPTR AC7777 /BACK UP OVER THE RULER CURMOV HLT JMP DCP006 /AND DUMP THE REST OF THE PASTE BUFFER X=. /--------------------- PAGE / DCP009 CHECK LINE FOLLOWING / / FINDING THE CORRECT COLUMN POSITION REQUIRES THAT THE LINE IN / WHICH THE HARD RETURN LINE ENDER WAS FOUND HAVE NO INTERVENING / RULERS BETWEEN IT AND THE LINE IN WHICH THE COLUMN IS TO GO. / IF THE LINE IMMEDIATELY FOLLOWING THE LINE WITH A HARD RETURN IS / A PAGE MARK OR CONTROL BLOCK THEN YOU WANT TO SKIP OVER THAT AND / GO TO THE NEXT TEXT LINE FOLLOWING SO AS TO CONFORM WITH COLUMN / CUT. DCP009, AC0001 /POSITION TO FIRST CHAR OF NEXT LINE CURMOV JMP DCPCHK /RAN OUT OF TEXT - TREAT AS SHORT LINE /C215 TAD CURPTR /SAVE CURRENT PTR POSITION DCA X5 TAD LINE23 /AND CHECK LINE ENDER IMMEDIATELY DCA CURPTR /PRECEDING BKPPTR HLT /NFW TAD (-ECNDRL) /WASN'T A RULER WAS IT? SNA CLA JMP DCP013 /BACKUP OVER IT AND DUMP THE TEXT OUT TAD X5 /RESTORE PTR DCA CURPTR TAD I CURPTR /CHECK FOR PAGE MARK OR CONTROL BLOCK ZZCASE CLPTB3-1 / ECNWPG; DCP009 /NEW PAGE SKIP TO NEXT LINE / ECPMRK; DCP009 /PAGE MARK SKIP TO NEXT LINE / ECPCT1; DCP015 /START CONTROL SKIP TO LINE AFTER END CONTROL / ECPCT2; DCP006 /END CONTROL ERROR DUMP REMAINING TEXT / 0 /\ JMP DCPCHK /NOT A BAD SITUATION GO DO COLUMN FIND /C215 / DCPCHK CHECK TO SEE IF THERE IS ANY MORE TEXT IN PASTE BUFFER /A215 DCPCHK, JMS DCPGNC /GO GET NEXT CHAR FROM PASTE BUFFER /A215 JMP EIFIX /RAN OUT OF PASTE TEXT SO QUIT /A215 SNA CLA /ZERO IS END OF PASTE BUFFER /A215 JMP EIFIX /DONE NO MORE TO PASTE /A215 /\ JMP DCP014 /FALL INTO DCP014 ROUTINE /A215 / DCP014 FIND PROPER COLUMN POSITION / / THE CURSOR POSITION IN THE LINE IS CHECKED AGAINST THE UPPER / AND LOWER LIMITS OF THE COLUMN. IF IT IS WITHIN THE RANGE / THEN THE COLUMN IS FOUND AND THE NEXT LINE SEGMENT IS PASTED / IN. OTHERWISE THE SEARCH CONTINUES FOR THE COLUMN. DCP014, CDFMYF /CHECK POSITION AGAINST LOWER LIMIT OF TAD CLMPLL /COLUMN CIA TAD CURSOR SPA CLA JMP DCP016 /MOVE FORWARD TAD CURSOR /CHECK UPPER LIMIT CIA TAD CLMPUL SMA CLA JMP DOCLPS /GO PASTE IN NEXT SEGMENT /C215 / IF THERE IS NO COLUMN BREAK IN THE APPROPRIATE POSITION THEN / THE CURSOR IS MOVE BACKED TO THE BEGINNING OF THE LINE AND THE / REST OF THE PASTE BUFFER IS DUMPED THERE. TAD LINE23 /LINE HAS NO COLUMN BREAK DCA CURPTR /DUMP PASTE BEFORE BEGINNING OF LINE DCA CURSOR CURMOV HLT /NO CAN DO CHARLIE JMP DCP003 /GO DUMP THE PASTE BUFFER /C215 / DCP016 CHECK FOR THE NEXT COLUMN DELIMITER / / DCP016, JMS LODCHR /GET CHAR UNDER PTR JMP DCP019 /END OF TEXT - TREAT AS SHORT LINE /C215 AND P177 /CHECK FOR TABS AND EOLS ZZCASE CLPTB4-1 / ECTAB; DCP018 /TAB DO LIMIT CHECK / ECNWLN; DCP019 /EOL SAYS SHORT LINE OF BAD LINE / ECMDFL; DCP020 /DON'T COUNT MODIFIED FLAGS / ECSTRL; DCP003 /GO DUMP THE REST OF PASTE ON A RULER /C215 / ECNWPG; DCP003 /SAME AS RULER FOR PAGE AND CONTROL /C215 / 0 ISZ CURSOR /UPGRADE POSITION ADVSPC /TRY OUT NEXT CHAR JMP DCP019 /END OF TEXT - TREAT AS SHORT LINE /C215 JMP DCP016 /GO CHECK NEXT DCP020, DCA I CURPTR /DELETE LINE MODIFIED FLAG SLNMOD /AND REJUSTIFY LINE JMS REJUST JMP DCP016 /GO CHECK NEXT DCP019, TAD I PSTPTR /GET CHARACTER FROM PASTE BUFFER /A215 TAD (-ECNWLN) /CHECK FOR A HARD RETURN /A215 SNA CLA /IS THIS A BLANK PASTE LINE ? /A215 JMP DCP002 /YES, GO DO END OF SEGMENT PROCESSING /A215 TAD (ECTAB) /NO, INSERT TAB TO PAD OUT LINE JMS INSERT SLNMOD DCP018, AC0001 /JUSTIFY THE DAMN TAB SO AS TO FIND CURMOV /FIRST CHAR IN COLUMN JMP DCP003 /RAN OUT OF TEXT SO DUMP PASTE BUFFER /C215 JMP DCP014 /GO CHECK COLUMN BOUNDARY / DCPGNC GET NEXT CHAR FROM PASTE BUFFER / / THIS ROUTINE RETRIEVES THE NEXT CHARACTER FROM THE PASTE BUFFER. / IF A CHARACTER IS FETCHED THEN A SKIP RETURN IS TAKEN. ON / FAILURE THE DIRECT RETURN. THE CHARACTER IS RETURNED IN THE AC. / DCPGNC, XX ISZ PSTPTR /POINT TO NEXT CHAR IN PASTE BUFFER JMP DCGNC1 /THERE IS ANOTHER CHAR IN THE CURRENT /BUFFER ISZ PSTBLK /LAST BUFFER EMPTY TRY NEXT TAD PSTBLK /WAS THAT THE LAST BLOCK AVAILABLE TAD (-PSTEND) SNA CLA JMP I DCPGNC /YES NO MORE AVAILABLE TAD (RXERD) /READ NEXT BLOCK OF PASTE BUFFER JMS PSTIO DCGNC1, CDFBUF /FETCH A CHAR TAD I PSTPTR ISZ DCPGNC /TAKE SKIP RETURN JMP I DCPGNC / COLUMN PASTE CASE TABLES / / CLPTB1, ECNWLN; DCP002 /END OF SEGMENT ECNWPG; DCP003 /ILLEGAL CHAR TO PASTE DUMP TEXT ECSTRL; DCP021 /START OF RULER, SKIP TO END OF RULER /C208 0 CLPTB2, ECNWPG; DCP011 /NEW PAGE ECPMRK; DCP011 /PAGE MARK ECPCT1; DCP012 /START CONTROL ECPCT2; DCP006 /END CONTROL 0 CLPTB3, ECNWPG; DCP009 /NEW PAGE SKIP TO NEXT LINE ECPMRK; DCP009 /PAGE MARK SKIP TO NEXT LINE ECPCT1; DCP015 /START CONTROL SKIP TO LINE AFTER END CONTROL ECPCT2; DCP006 /END CONTROL ERROR DUMP REMAINING TEXT 0 CLPTB4, ECTAB; DCP018 /TAB DO LIMIT CHECK ECNWLN; DCP019 /EOL SAYS SHORT LINE OF BAD LINE ECMDFL; DCP020 /DON'T COUNT MODIFIED FLAGS ECSTRL; DCP003 /GO DUMP THE REST OF PASTE ON A RULER /C215 ECNWPG; DCP003 /SAME AS RULER FOR PAGE AND CONTROL /C215 0 X=. /---------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 OVRBLK=OV2NUM%200+DLOEDO+36 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM OVTC= .-OVLAY2+OV2NUM / USER REQUESTED A TECHNICAL CHARACTER / BUILD A TECHNICAL CHARACTER / / FORMAT / / SD SP GS CH TC ED / / SD = START DEAD / SP = SPACE / GS = GRAPHICS SET G1 - G3 (OCTAL CODE 61 - 63) / TC = TECHNICAL CHARACTER / ED = END DEAD TCCHAR, DCA LNDSUB / Clear temp for line drawing set GETINP / GET NEXT CHARACTER SPA / -AC MEANS COMMAND KEY JMP LNDTST / Test for line drawing set /M223 JMS TECVAL / GO VALIDATE AND MAP TEC CHARACTER JMP EIBAD / BEEP USER, NOT A VALID TECHNICAL CHARACTER TCINS, SLNMOD / SET LINE MODIFIED FLAG TAD (ECSTOV) / YES. BUILD DEAD KEY SEQUENCE JMS INSRL1 / INSERT START DEAD CODE TAD (ECSPC) JMS INSRL1 / INSERT SPACE TAD TECSET / GRAPHIC SET G1 = 61, G2 = 62, G3 = 63 JMS INSRL1 / AND INSERT IT TAD TECMAP / GET MAPPED TECH CHARACTER JMS INSRL1 / AND INSERT IT TAD (ECNDOV) / INSERT END DEAD CODE JMS INSRL1 JMP EIFIX / ALL DONE. GET NEXT INPUT OVFIXP= .-OVLAY2+OV2NUM / TRANSFER MENU BUFFER TO PASTE BUFFER TAD (MUBUF+MNIBUF-1) / ADDRESS TO COPY FROM DCA X0 / SET UP POINTER ADDRESS TAD (PSTEBF-1) / ADDRESS TO COPY TO DCA X1 / SET UP POINTER ADDRESS AAFIXP, CDFMNU / FIELD TO COPY FROM TAD I X0 / PICK UP WORD FROM MENU BUFFER CDFBUF / FIELD TO COPY TO SNA / CHECK FOR THE LAST WORD TO COPY JMP XXFIXP / GO STORE A FINAL ZERO TO END PASTE BUFFER SPA / CHECK FOR A TECHNICAL CHARACTER CODE JMP CCFIXP / YES, GO HANDLE SPECIAL CODE BBFIXP, DCA I X1 / NO, STORE WORD IN PASTE BUFFER JMP AAFIXP / GO GET NEXT WORD CCFIXP, CMA / INVERT TO CORRECT FORM SZA / CHECK FOR A REQUIRED SPACE CODE JMP DDFIXP / NO, GO HANDLE TECHNICAL CHARACTER / BUILD REQUIRED SPACE IN PASTE BUFFER TAD (ECSTOV) / PICK UP START DEAD CODE DCA I X1 / STORE WORD IN PASTE BUFFER TAD (ECSPC) / PICK UP SPACE CHARACTER CODE DCA I X1 / STORE WORD IN PASTE BUFFER TAD (ECSPC) / PICK UP SPACE CHARACTER CODE JMP EEFIXP / GO STORE WORD AND FINISH SEQUENCE / BUILD TECHNICAL CHARACTER IN PASTE BUFFER DDFIXP, DCA ZZFIXP / SAVE MAPPED TECHNICAL CHARACTER TAD (ECSTOV) / PICK UP START DEAD CODE DCA I X1 / STORE WORD IN PASTE BUFFER TAD (ECSPC) / PICK UP SPACE CHARACTER CODE DCA I X1 / STORE WORD IN PASTE BUFFER TAD ZZFIXP / PICK UP SAVED TECHNICAL CHARACTER R3L / POSITION SELECTION BITS IN AC, 0 - 2 AND (3) / MASK OFF LOW ORDER BITS TAD (60) / GRAPHIC SET G1 = 61, G2 = 62, G3 = 63 DCA I X1 / STORE WORD IN PASTE BUFFER TAD ZZFIXP / GET MAPPED TECH CHARACTER AND P177 / MASK OFF 7 BIT ASCII CHARACTER EEFIXP, DCA I X1 / STORE WORD IN PASTE BUFFER TAD (ECNDOV) / PICK UP END DEAD CODE JMP BBFIXP / GO STORE WORD IN PASTE BUFFER XXFIXP, DCA I X1 / STORE ZERO IN PASTE BUFFER JMP OV2JRT / ALL DONE, RETURN TO CALLER ZZFIXP, .-. / LOCATION TO SAVE MAPPED TECHNICAL CHARACTER / THE FOLLOWING ROUTINE MOVED TO BLASTER ON EDIT 237 //////////////////////// / The following code handles 8 bit characters typed after the ALT key /a233 / as the table for TECVAR would be sparse and too large if it was just /a233 / extended to cope with 8 bits. So a table search algorithm is used /a233 / here for the few keys returning 8 bit characters on multinational /a233 / keyboards. /a233 / /TEC8VAL,DCA TECTMP / Save temprarily /a233 / TAD TECTMP / Get it back for test /a233 / AND (200) / Is this a multinational character /a233 / SNA CLA / .....? /a233 / JMP TEC7BIT / No, deal with it elsewhere /a233 / TAD TECTMP / Yes, get the char to be translated. /a233 / AND P377 / Make sure its only 8 bits /a233 / CIA / Make it negative to subtract from /a233 / DCA TECTMP / table entries. Store for later /a233 / TAD (TEC8TB-2) / Get the address of the 8 bit TEC table/a233 / DCA X0 / We know X0 is free as is reset later /a233 / / (Famous last words) /a233 /TEC8LP, ISZ X0 / Skip over TEC char /a233 / TAD I X0 / Get first 8 bit char /a233 / TAD TECTMP / Compare with the 8 bit char entered /a233 / SMA SZA / Are we still before the table entry? /a233 / JMP TEC8RTN / No, therefore not in table /a233 / SZA CLA / Same? /a233 / JMP TEC8LP / No, check rest of table /a233 / TAD I X0 / Yes, get the representative TEC char /a233 / JMP TEC8FND / and process it /a233 / / The next table is O R D E R I M P O R T A N T --------------------- / /TEC8TB, IFDEF ENGLSH < / IFDEF V30FAO < / 0241; 3063 / Upsidedown Bang = Top Vert Summ Connect / 0243; 3065 / Pound Sterling = Top right Summ / 0252; 3051 / a ordinal = Top right Sq Brkt / 0272; 3052 / o ordinal = Bot right Sq Brkt / 0277; 3064 / Upsidedown Question = Bot Vert sum Connect / 0321; 3136 / N tilde = Logical And / 0347; 3075 / c cedilla = Not Equal / 0361; 3137 / n tilde = Logical Or / > / 7777 / > / / IFDEF SPANISH < / 0241; 3063 / Upsidedown Bang = Top Vert Summ Connect / 0243; 3065 / Pound Sterling = Top right Summ / 0252; 3051 / a ordinal = Top right Sq Brkt / 0272; 3052 / o ordinal = Bot right Sq Brkt / 0277; 3064 / Upsidedown Question = Bot Vert sum Connect / 0321; 3136 / N tilde = Logical And / 0347; 3075 / c cedilla = Not Equal / 0361; 3137 / n tilde = Logical Or / 7777 / > / / IFDEF ITALIAN < / 0243; 3041 / Lira symbol = Radical / 0247; 3077 / Section symbol = Integral / 0260; 3047 / Degree symbol = Top left square bkt / 0340; 3056 / a-grave = Bottom right paren / 0347; 3054 / c-cidila = Bottom left paren / 0350; 3045 / e-grave = Bottom integral / 0351; 3126 / e-accute = Radical / 0354; 3160 / i-grave = Small pi / 0362; 3133 / o-grave = Includes / 0371; 3103 / u-grave = Divide / 7777 / > / IFDEF DUTCH < / 7777 / > / / End of -------------- O R D E R I M P O R T A N T -------------------- /D237D237D237D237D237D237D237D237D237D237D237D237D237D237D237D237D237D237D237 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE / / The next "bit" tests for line drawing characters typed from / the F11 alt char key. / / The characters are arranged to coincide with the keys on the / alternate keypad i.e. / / Sent Tab Under - - - - / Pos Line | | | / / / | | | / Word Para Bold - - - - / | | | / / / Back Line Upper | | | / Up Case - - - - / / / Horizontal line is the Advance key or Left/Right arrows / Vertical line is the Enter key or Up/Down arrows. / LNDTST, ZZCASE / Check Input command /A223 LNDTBL-1 / Against Despatch table/A223 JMP EIBAD / Not matched , Beep BiBi/A223 TLHC, ISZ LNDSUB /Top Left hand Corner /A223 TMT, ISZ LNDSUB /Top Middle T /A223 TRHC, ISZ LNDSUB /Top Right hand corner /A223 LMT, ISZ LNDSUB /Left Middle T /A223 MCRS, ISZ LNDSUB /Middle Cross /A223 RMT, ISZ LNDSUB /Right Middle T /A223 BLHC, ISZ LNDSUB /Bottom Left Hand Corner /A223 BMT, ISZ LNDSUB /Bottom Middle T /A223 BRHC, ISZ LNDSUB /Bottom Right Hand Corner /A223 VLINE, ISZ LNDSUB /Vertical Line /A223 HLINE, ISZ LNDSUB /Horizontal line /A223 CLA / /A223 TAD (LNDCHRS-1) /Address of correspoding chars /A223 TAD LNDSUB /Add offset into table /A223 DCA LNDPTR /Save as a pointer /A223 TAD I LNDPTR /Get Line drawing character /A223 DCA TECMAP /Put that away /A223 TAD (61) /Line drawing from set 1 /A223 DCA TECSET /Put that away too /A223 JMP TCINS /Rejoin main code /A223 LNDCHRS, 161 / Horiz line /q /A223 170 / Vert Line /x /A223 152 / Bottom Right Hand Corner /j /A223 166 / Bottom Middle T /v /A223 155 / Bottom Left Hand Corner /m /A223 165 / Right Hand middle T /u /A223 156 / Middle Cross /n /23 164 / left Middle T /t /A223 153 / Top Right Hand Corner /k /A223 167 / Top Middle T /w /A223 154 / Top Left Hand Corner /l /A223 LNDTBL, EDSENT; TLHC /A223 EDTABP; TMT /A223 EDUNDL; TRHC /A223 EDWORD; LMT /A223 EDPARA; MCRS /A223 EDBOLD; RMT /A223 EDBKUP; BLHC /A223 EDLINE; BMT /A223 EDUPPR; BRHC /A223 EDUPAR; VLINE /A223 EDDNAR; VLINE /A223 EDRARO; HLINE /A223 EDLARO; HLINE /A223 EDENTR; VLINE /A223 EDADVN; HLINE /A223 0 /A223 LNDPTR, 0 /Pointer to Char table /A223 LNDSUB, 0 / temp subscript for line drawing table /A223 X=. / INDICATE FIRST FREE LOCATION ON PAGE /--------------------- PAGE /*************************************************************************** /**** START OF OVERLAY **** /*************************************************************************** OV2NUM=OV2NUM+200 OVRBLK=OV2NUM%200+DLOEDO+36 / DISK BLOCK WHERE OVERLAY IS LOADED RELOC RELOC OVLAY2 OV2NUM OVSNFG= .-OVLAY2+OV2NUM JMP STPNFG OVSEXB= .-OVLAY2+OV2NUM JMP STPEXB OVCLRS= .-OVLAY2+OV2NUM /ESCLRS RIGHT STRIP FUNCTION ESCLRS, TAD SLCRPT /SAVE BEGINNING STRIP POS DCA CLCTSW OVLJMP OVSSTP /SETUP STRIP PARAMETERS CDFMYF TAD CLCTSW /SET UP BEGIN AND END POINTS DCA CLSBEG TAD CLMPUL DCA CLSEND AC7777 JMP ESCLGO /GO DO STRIP /C213 /D213 DCA CLCTSW /D213 JMP ESTRIP-1 /GO DO STRIP OVCLLS= .-OVLAY2+OV2NUM /ESCLLS LEFT STRIP FUNCTION ESCLLS, TAD SLCRPT /SAVE BEGINNING STRIP POS DCA CLCTSW OVLJMP OVSSTP /SETUP STRIP PARAMETERS CDFMYF TAD CLMPLL DCA CLSBEG TAD CLCTSW /SET UP BEGIN AND END POINTS DCA CLSEND ESCLGO, DCA CLCTSW /C213 DCA CLCTDN /FALL INTO STRIP CODE OVSTRP= .-OVLAY2+OV2NUM /ESTRIP STRIP TEXT FROM A COLUMN ESTRIP, OVLJMP OVSTLD CDFMYF TAD CLCTSW /CHECK IF LEFT STRIP SZA CLA JMP STRP05 /NO RIGHT DOES'NT NEED COL CHECK AC7777 /CHECK PREVIOUS CHAR CURMOV JMP STRPA5 /START OF FILE GO FIX UP RULER /C213 TAD I CURPTR /CHECK FOR COL DELIMITER AND P177 ZZCASE STPTB4-1 / ECNWLN; STRP28 / ECNWPG; STRP28 / ECTAB; 2TRP28 / 0 STRP29, AC0001 /FORWARD SPACE TO NEXT COLUMN CURMOV JMP STPNFG TAD I CURPTR AND P177 ZZCASE STPTB5-1 / ECNWLN; STRP12 /NO COLUMN TO STRIP / ECNWPG; STPNFG /BAD DATA FORMAT / ECTAB; STRP28 / 0 JMP STRP29 STRP28, AC0001 /FORWARD TO BEGINNING CHAR OF COLUMN STRPA5, CURMOV /HERE TO MOVE OFF START OF RULER/C213 JMP STPNFG STRP05, CDFMYF TAD CURSOR /CHECK FOR LOWER LIMIT OF STRIP CIA TAD CLSBEG SPA SNA CLA JMP STRP01 /STRIP BEGINNING FOUND CDFBUF TAD I CURPTR AND P177 ZZCASE STPTB1-1 / ECMDFL; STRP02 /MODIFIED FLAG REJUST REST / ECNWLN; STRP03 /NEWLINE CHECK CONDITIONS / ECNWPG; STPEXB /BAD MOVE CHARLIE SHOULD BE HARD /RETURN / ECSTRL; STPEXB /SO ARE RULERS AND OTHER TYRANTS / 0 ADVSPC /FORWARD SPACE ONE PRINT POS JMP STPNFG /REALLY A CATO. ERROR CAN'T HAPPEN CLA ISZ CURSOR /UP THE BODY COUNT JMP ESTRIP /AND TRY FOR A TRUE KILL / STRP01 INSERT MARKERS FOR STRIP DELIMITING / / STRP01, CDFMYF TAD CURSOR /CHECK AGAINST UPPER LIMIT CIA TAD CLSEND SPA SNA CLA JMP STPNFG /NO WAY BEYOND THE REALM CDFBUF TAD (ECTMRK) /INSERT LOWER MARKER JMS INSERT STRP04, AC7777 / CURSOR LESS ONE BECAUSE OF INSERT TAD CURSOR DCA CURSOR STRP06, ADVSPC JMP STRP07 /INSERT OTHER MARKER AND P177 ZZCASE STPTB2-1 / ECNWLN; STRP08 / ECNWPG; STPNFW / ECSTRL; STPNFW / ECTAB; STRP07 / ECMDFL; STRP06 / 0 ISZ CURSOR NOP /FIX FOR CURSOR = 0 /A213 CDFMYF TAD CURSOR CIA TAD CLSEND SMA SZA CLA JMP STRP06 / STRP07 INSERT END MARKER / / STRP07, CDFBUF TAD (ECTMRK) JMS INSERT STRP09, BKPPTR HLT TAD (-ECTMRK) SZA CLA JMP STRP09 TAD (ECMDFL) / STRP10 STRIP BETWEEN MARKERS / / STRP10, DCA I CURPTR /DELETE MARKER ADVPTR HLT TAD (-ECTMRK) /END OF STRIP? SNA CLA JMP STRP11 TAD I CURPTR JMS PUTSTP JMP STRP10 /PROCESS NEXT CHAR JMP STPNFW /PASTE BUFFER OVERFLOW X=. /-------------------------- PAGE / STRP11 PROCESS END OF STRIP / / STRP11, DCA I CURPTR /DELETE MARKER STRP12, TAD (ECNWLN) /PUT EOS IN PASTE JMS PUTSTP SKP JMP STPNFG /BUFFER OVERFLOW EXIT TAD LINE23 /RESET LINE PTRS FOR EOL SEARCH DCA CURPTR DCA CURSOR SLNMOD JMS REJUST TAD CLCTDN /CHECK IF STRIP DONE SZA CLA JMP STPGEX OVLJMP OVSTPX / STRP03 HANDLE NEWLINE IN COLUMN / / STRP03, TAD I CURPTR TAD (-ECNWLN) /END OF COLUMN AND LINE? SNA JMP STRP12 /YES TAD (ECNWLN-ECSLPT) /SELECT POINT SZA CLA JMP STPEXB /NO WRAPPED OR CENTERED IS A SCREW UP TAD (ECMDFL) /PROCESS AS MODIFIED FLAG DCA I CURPTR ISZ CLCTDN /MARK DONE / STRP02 HANDLE MODIFIED FLAG IN COLUMN / / STRP02, CURMOV JMP STPNFG JMP ESTRIP / STRP08 HANDLE NEWLINE IN COLUMN / / STRP08, TAD I CURPTR /CHECK FOR NEWLINE TAD (-ECNWLN) SNA JMP STRP07 TAD (ECNWLN-ECSLPT) /CHECK FOR SELECT POINT SZA CLA JMP STPNFW TAD (ECMDFL) DCA I CURPTR ISZ CLCTDN CURMOV JMP STPNFW BKPPTR HLT JMP STRP04 / BAD EXITS FROM STRIP / / STPNFW, TAD LINE23 /RESET PTRS TO BEGINNING OF LINE DCA CURPTR DCA CURSOR STPNF1, CURMOV /SEARCH FORWARD FOR MARKER HLT TAD I CURPTR TAD (-ECTMRK) SNA CLA JMP STPNF2 AC0001 JMP STPNF1 STPNF2, DCA I CURPTR /DELETE MARKER SLNMOD JMP STPNFG STPEXB, BKPPTR /BACKUP TO PREVIOUS LINE HLT /SEVERE CORRUPTION STPNFG, CLA TAD PSBFOF /PASTE FILLED? SNA CLA JMS PUTSTP NOP OVLJMP OVDOER STRP17, DCA I CURPTR STPGEX, DCA EDMODE JMS PUTSTP NOP JMP EIFIX / PUTSTP WRITE TO PASTE BUFFER / / THIS ROUTINE TAKES CHARACTERS PASSED IN THE AC AND PUTS THEM IN / THE PASTE DISK BUFFER. WHEN THE BUFFER IS FULL IT WRITES THE / BUFFER TO DISK. WHEN THE LAST ALLOCATED DISK BLOCK IS WRITTEN / IT SETS THE CUT OVERFLOW FLAG AND TAKES A SKIP RETURN. / / CALL: / / JMS PUTSTP (AC := CHARACTER TO WRITEOUT) / (RETURNS HERE IF OK) / (RETURNS HERE ON END OF PASTE BUFFER) / / RETURNS WITH AC:=0 IN ALL CASES / PUTSTP, XX /ENTRY POINT CDFBUF /SET TO BUFFER FIELD DCA I PSTPTR /PUT CHARACTER IN BUFFER ISZ PSTPTR /BUMP PTR AND CHECK FOR BLOCK FULL JMP I PUTSTP /BLOCK NOT FULL SO RETURN DIRECTLY TAD (RXEWT+2000) /BLOCK I/O WRITE CODE JMS PSTIO /PERFORM WRITE TO DISK ISZ PSTBLK /INCREMENT BLOCK NO TAD PSTBLK /CHECK FOR END OF ALLOCATED BLOCKS TAD (-PSTEND) /FOR PASTE BUFFER SZA CLA /END OF ALLOCATION? JMP I PUTSTP /NO, SO STRAIGHT RETURN AC7777 /EOA FOR PASTE BUFFER DCA PSBFOF /SET PASTE BUFFER OVERFLOW FLAG ISZ PUTSTP /AND TAKE A SKIP RETURN JMP I PUTSTP /B-B STPTB1, ECMDFL; STRP02 / Modified Flag rejust REST ECNWLN; STRP03 / Newline Check conditions ECNWPG; STPEXB / Bad move Charlie should be hard / return ECSTRL; STPEXB / So are rulers and other tyrants 0 STPTB2, ECNWLN; STRP08 ECNWPG; STPNFW ECSTRL; STPNFW ECTAB; STRP07 ECMDFL; STRP06 0 X=.   / .TITLE CPYDSK - COPY DISKETTE / .VERSION / / / / COPYRIGHT (C) 1983 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: CREATION DATE: / / 086 EMCD 11-SEP-85 Include Nordic translations / conditionalised / 085 DFB 08-NOV-84 FIX TO FIX BREAK IN VER83/84(NTS) / 084 DFB 02-NOV-84 Fix to copy all tracks in backup / ....(broke in ver 083) / 083 DFB 24-OCT-84 Fix copy volume(l.t. 800 blks) to flpy / 082 WCE 19-SEP-84 Change HOME block date to BUILD date / 081 DFB 18-SEP-84 Fix drive 0 check after I/O err / 080 EJL 10-SEP-84 Fix 8"<->5" not compatable error msg / 079 DFB 01-AUG-84 Fix to rewrite when err on read verify / 078 DFB 01-AUG-84 Fix to rewrite when err on read verify / 077 WJY 31-JUL-84 Don't allow "another" copy when dest is / a volume. bug WPSV2-122 / 076 DFB 22-MAR-84 Fix to init doc and systems / 8, or 9 mounted at winnie boot / 075 DFB 28-FEB-84 Allows 2000 block docs and system / 074 DFB 03-DEC-83 Add winnie system initialize / 073 WJY 17-JAN-84 Move menu code to MN1. / 072 WJY 16-JAN-84 Change to assemble in Field 2 so that / 071 HLP 03-NOV-83 Fix bug in STDBL put in on 068 and / Rewrite STDBL to handle small numbers / of blocks remaining on system disk / 070 WJY 02-NOV-83 Change to use different DSKQUE routine / to avoid inappropriate time display. / 069 WJY 12-OCT-83 Fix MC-S bug. Left out the code in edit / 67 which adds in the SECWRP parameter when / resetting the sector # after a wrap. / 068 HLP 11-OCT-83 Fix STDBL to have correct alloc blk if / DLEND># disk blocks (no blocks avail) / 067 WJY 01-OCT-83 Modified backup to use 2 full fields as / buffers. Allows a full track to be acted / on at once. / 066 WJY 30-SEP-83 DMII V1.5 WINCHESTER SUPPORT / *NOTE* A decision was made to call areas / devices instead. Since device is / already used exstensively in the / comments I left area in the comments / and only changed the TEXT statements. / 065 WCE 06-SEP-83 Added WINNIE conditional to fix load / problem with new WPSYSA module / 064 WCE 03-SEP-83 Changed RZ IOT's to standard RX IOT's / 063 WCE 31-AUG-83 Changed limit that system initialization / uses for reading end of disk so that / larger WPDL's can be used on S.D. disks / 062 WCE 07-JUL-83 Replaced occurances of SYS+value in case / statements with standard menu definitions / 061 HLP 20-JUN-83 Delete extra "and" in "Type D for document / or S for System and And Press RETURN / Writeout changes to save 3 blocks / 060 HLP 29-APR-83 Repaint entire screen after B finds / different densities so menu title changes / (ref DM-I V2.1 bug #76) /-------RELEASED FOR DECMATE-II V1.0----------- / 059 GJP 09-DEC-82 Make the message that there was an / error while trying to format appear / on the screen. It was being overwritten. / 058 HLP 15-NOV-82 Fix "for another..." function / 057 HLP 10-NOV-82 Modify CHKID to verify name and ID / Let maintenance menu title stay on / Consolidate Error messages / 056 HLP 04-NOV-82 Install Menu to check for "COPY" / Changed all JMP CPYDS1 to JMP CPYDS2 / 055 HLP 02-NOV-82 Fix display Menu.enu. after B 4 5 / 054 HLP 27-OCT-82 2nd fix to prevent elapsed time clock flash / 053 HLP 18-OCT-82 MNTMP1=6 means display no 8" system init / Added CPDFSZ code to detect different / diameter for menu on backup / 052 HLP 08-OCT-82 No elapsed time flash if no disk in drv / 051 HLP 30-SEP-82 Minor changes to TEXT26 / 050 DFB 26-SEP-82 Fix to write out track 0 / 047 HLP 15-SEP-82 Changed RX-50 Backup interleave to 3 / 046 HLP 31-AUG-82 Made free blocks use worst case pattern / 045 HLP 27-AUG-82 Generalized RXHAN error handling / Data verify RX-50 S & D only / 044 HLP 26-AUG-82 Added read verify by compare / functions for S and D / Made Allocation block generation more / general (now able to allocate by blk #) / 043 HLP 09-AUG-82 Disable UDKs during a Backup so user / can't destroy his system disk / Read Verify Boot Sectors on S / 042 HLP 23-JUL-82 Write RX50 boot header properly / Always use CDFMYF+10 for buffer field / Handle S cases (8-8,8-5,5-5,5-8) properly / 041 HLP 22-JUL-82 Allow only D init after FS or FD in CONDOR / 040 HLP 19-JUL-82 Copy track 0 on System initialization / Copy firmware only if DRVSRC is 8" / / 039 HLP 08-JUL-82 Deleted temporary routine FMTPCH / Deleted Copyfirmware part of Sys init. / (using separate boot disk with firmware) / (kept system disk smaller than doc disk) / / 038 HLP 06-JUL-82 Added temporary routine FMTPCH to patch / DM-II system disks during development / Fixup Drive not Ready msg / JMS FMTQRX in CPYIO--wrong error message / during Backup (B) / / 037 HLP 24-JUN-82 Do not allow 8" System disks to be made / if system drive is 5" / Do not copy firmware if dest drive is 8" / Copy track zero on RX-50 S or D / / 036 HLP 16-JUN-82 Fixed up exit routines and messages / Added DCA DRV in GTDKID / Deleted DCA DRV, GETDNS in CHKID / / 035 HLP 15-JUN-82 Changed to allow different number of / blocks for System, Document, and S-D / clear/verify. / On RX-50 TO RX-50 S Command, image copy / tracks 78 and 79 (firmware). / Corrected wrong track number on RX01 / last two sector writeout & vfy / Changed RX50 interleave factor to 2 / / 034 HLP 20-MAY-82 Conditionalized Piracy Protection code / Piracy Protection Can Be re-installed / by defining PIRATE (as long as / space wars do not result) / / 033 HLP 19-MAY-82 Pick up drive numbers from MN1 / Make New Backup Copy Menus / Allow S only if drive 0 is 8 inch / Allow 5 inch Backup of only D diskettes / After format an RX01 or RX02, query / S or D only if system drive is 8 inch, / otherwise assume D and ask for NAME. / Eliminated CLSCRN routine by combining / PSCR text into TEXT11 / 032 HLP 06-MAY-82 Modifications for MAY 10th announcement of Condor / Drive number selection by the following: / S & D: Use drive 2 if drive 0 / is an RX01 or RX02 / B: Drive 1 to Drive 0 / Adding Templates for both RX01/02 / and RX50 boots. Deleted RDBOOT / New STDBL Routine / Modifying BACKUP for RX50 / RX02 Interleave FACTOR changed from 4 / to 5 to make relatively prime to 26 / 031 HLP 13-APR-82 Extensive Rewrite to Eliminate All / Templates and Have only one Buffer / New Routines: RDBOOT, WRBOOT, FMTDIR, CLABUF / Deleted all Previous /D031 Lines / Moved FMTBUF to end, after text / Moved all messages to text area / Deleted all unreferenced labels / General cleanup / 030 DFB 28-MAR-82 FIX initialize doc/sys error mssge. / 029 DFB 25-MAR-82 Change format error mssge. / 028 DFB 05-MAR-82 Fix format error mssge. / 027 DFB 23-FEB-82 Set verify read during init sys and doc / 026 GDH 22-FEB-82 Moved storage of system disk id up front / so that functions other than "copy" / will back out properly. / 025 DFB 21-FEB-82 Set verify read during backup copy / And set interleave dd=4 sd=3 for bkupcpy / 024 GJP 08-FEB-82 On backup copy, won't recognize system / diskette when copying two times / 023 DFB 01-FEB-82 Reset dble dens interleave=3 / 022 DFB 28-JAN-82 Dble dens interleave=2 / 021 DFB 14-JAN-82 Do 8 bit copy for dd(image copy) / 020 DFB 11-JAN-82 FIX TO CHECK ERR CODE BEFORE NOT RDY / Delete error recovery / 019 DFB 10-JAN-82 Fix to check device ready & d / delete error msg."print r to continue" / 018 DFB/GDH 14-DEC-81 Fix to add doc. diskette message on boot / and to eliminate partial time display / during backup message display / 017 DFB 20-NOV-81 RETURN TO MAIN MENU DURING COPY ONLY / IF LAST WORD OF SYSTEM DISK ID SAME / 016 GDH 18-NOV-81 WRITE-OUT BOOT BLOCK TO DOC DISKETTE / IN 12 BIT MODE (JUST LIKE SYS DISKETTE) / 015 DFB 04-NOV-81 DBLE DENS INTERLEAVE TO 3(SAME AS SD) / 014 GJP/DFB 29-OCT-81 DBLE DENSITY CHANGES FUNCTIONS / 013 GDH 29-OCT-81 BACKUP DISKETTE MENU CHANGES. / 012 GDH 20-OCT-81 DE-IMPLEMENTED LOCK/UNLOCK CODE. / 011 TT 07-JUL-81 REMOVED SUPERFLUOUS CONDITIONALS. / 010 AJF 22-APR-81 CHANGED LEFT DRIVE TO DRIVE 0 / AND RIGHT DRIVE TO DRIVE 1 / 009 DSS 03-DEC-80 FIXED CURSOR POSITIONING IN 'TIMMSG' / WHICH MYSTERIOUSLY VANISHED IN THE / SCANDINAVIAN/EUROPEAN MERGE. / 008 DAO 28-OCT-80 CHANGED VT278 TO WRITE OUT EVERY THIRD / SECTOR IN DOCUMENT COPY ROUTINE SINCE / IT IS SO SLOW / 007 DM,JM 15-SEPT-80 MERGED SCANDI AND EUROPE/ENGLISH / 006 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 005 CMW 06-AUG-80 MADE GRAMMATICAL CHANGES FOR DUTCH / 004 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 003 CMW 05-MAY-80 ENTERED CANADA TRANSLATIONS / 002 DSS 14-APR-80 ENTERED DUTCH FIXES / 001 CMW GLT 14-JAN-80 ADD FRENCH GERMAN DUTCH CONDITIONAL CODE / / FRENCH DIACRITICAL SUBSTITUTIONS: "["=L.A.E, "]"=L.G.E; "&" NOT USED / GERMAN DIARCITICAL SUBSTITUTIONS: "["=L.U.A, "]"=L.U.U, "\"=L.U.O; "&"=U.C. / / 2.5 KEE 10/18/77 ADD UNLOCKS FOR 102 SYSTEMS / 2.G-1 MB CHANGE FOR THE MOVE OF THE INPUT BUFFER IN MENU / /-- / / .COMP CPYDSK MEDDST / PTR TO "DISKETTE" OR "VOLUME" STRING /A066 / CIFMNU JMS I IOACAL / "PLACE THE DISKETTE WHICH IS TO RECIEVE THE COPY INTO DRIVE !D." / OR "THE VOLUME NAMED..." IF WINNIE /A066 0 / DEFAULT OUTPUT ROUTINE RCVTXT, 0 / ADDRESS OF STRING /M066 1316 / CURSOR POSITION RCVID, 0 / POINTER TO DRIVE NUMBER OR VOLUME NAME/A033/A066 / IFNDEF ITALIAN < CIFMNU JMS I IOACAL / "USE A BLANK DISKETTE OR A USED DISKETTE YOU NO LONGER NEED." 0 / DEFAULT OUTPUT ROUTINE TEXT1F / ADDRESS OF STRING 1416 / CURSOR POSITION MEDDST /A066 MEDDST /A066 > / CIFMNU JMS I IOACAL / "DRIVE !D - SOURCE DRIVE - THIS DISKETTE WILL BE READ." 0 / DEFAULT OUTPUT ROUTINE TEXT1G / ADDRESS OF STRING 1704 / CURSOR POSITION DEVSRC / PTR TO "DRIVE" OR "AREA" TEXT STRING /A066 DRVSRC / POINTER TO DRIVE NUMBER /A033 IFNDEF ITALIAN < DEVSRC / /A066 > MEDSRC / PTR TO "DISKETTE" OR "VOLUME" STRING /A066 / CIFMNU JMS I IOACAL / "PLACE THE DISKETTE WHICH IS TO BE COPIED INTO DRIVE !D." / OR "THE VOLUME NAMED..." IF WINNIE /A066 0 CPYTXT, 0 /M066 2116 CPYID, 0 / POINTER TO DRIVE NUMBER OR VOLUME NAME/A033/M066 / CIFMNU JMS I IOACAL / "WHEN YOU ARE READY TYPE COPY AND PRESS RETURN" 0 TEXTG3 / GENERAL PURPOSE -- 3 SUBSTRINGS /A036 2404 TEXT1I / WHEN YOU ARE READY TYPE COPY ... /C036 / 2604 TEXT33 / "OR, " /C036 / IFNDEF ITALIAN <2610> / /C036 IFDEF ITALIAN <2604> TEXT15 / "Press Gold ... /A033 2700 / POSITION FOR CURSOR AFTER MSG /A033 / TAD (TEXT1K) / SET UP CPYCON "FOR ANOTHER COPY" /A057 DCA CPYCON / /A057 / NOW DISABLE UDKS SO USER WON'T DESTROY HIS SYSTEM DISK /A043 / Test for drive in subroutine - for space reasons /A077 /d077 TAD DRVDST / ONLY IF DESTINATION DRIVE IS DRIVE 0 /A043 /d077 SNA CLA /A043 /C075 JMS CLRUDK /DISABLE UDK IF DEST DRIVE=0 /A075 CONT3, /A043 JMS CHKCCM / SEE IF STRING "COPY" WAS ENTERED /C056 SPA CLA / SEE IF NEET TO REPAINT /A056 JMP CONT2 / YES, GO REPAINT /A056 JMS DTDEN / DETERMINE DENSITIES AND SET INTERLVE FACTOR JMP CONT / DENSITIES WERE WRONG, REPAINT /A060 JMS TIMMSG / PRINT TIME MESSAGE JMS GETTIM / INITALIZE THE TIME TAD DENSRC /SOURCE DENSITY FACTOR IN BACKUP COPY /A075 JMS DSKSZE /SIZE IT NEEDED FOR WINNIE /A074 JMS SHFDEN /SET SHIFTED DENSITY CODE /A074 JMS CKDKSZ /CHECK SRCE-DEST SIZE /A074 NOP /ERR RET IF SRC G.T. DST /A074 JMS SETPAR / SET PARAMS FOR BACKUP COPY /A021 JMS CPYTKS / GO COPY TRACKS /A035 TAD WINDST / Did we copy to a VOLUME ? /A077 SZA CLA / No: Let the user do another copy /A077 JMP CPYGMO / Yes: No point in copying again - EXIT /A077 /***********************************************************************/ / / / CPYEXT--GETTING READY TO EXIT CPYDSK / / FIRST CHECK WITH OPERATOR / / TO SEE IF "ANOTHER" IS REQUIRED / / / /***********************************************************************/ CPYEXT, JMS CPYEXA / SPACE WARS MOVE /C021 JMS WTFRRS / WAIT FOR A RESPONCE FROM THE USER JMP SCONS1 / HE TYPED RETURN, DO THE COPY AGAIN /C024 / HE TYPED GOLD MENU, GO TO CPYDS2 /A036 / CPYDS2, /A024 CPYGMO, / GOLD MENU OUT OF CPYDSK /A056 JMS CHKID / GO CHECK THE ID OF THE DISK IN DR 0 /A024 CPYDS1, XX / RETURN CIF, FILLED IN DURING EXECUTION JMP I CPYDSK /-------------------- PAGE /***********************************************************************/ / / / CPYTKS--SUBROUTINE MADE OUT OF LOOPA CODE V035 / / COPIES ENTIRE TRACKS FROM DRVSRC TO DRVDST / / READ VERIFIES WRITTEN INFO / / FIRST TRACK--FMTQBK+RXQTRK / / LAST TRACK --TRKMXK / / OTHER PARAMETERS MENTIONED IN SETPAR MUST BE SET UP / / / /-----LATER SOLUTION--SHOULD FIRMWARE TRACKS BE IGNORED WHEN /------DOING A SYSTEM INIT-----CURRENTLY IGNORES SAME----- /***********************************************************************/ CPYTKS, XX / COPY TRACKS SUBROUTINE /A035 DCA SVBLOC / CLEAR SAVED WINNIE BLOCK # /A066 /D074 AC7777 / TEST FOR MIXED MEDIA /A066 TAD WINSRC / /A066 SZA CLA /WINNIE /A074 JMP CPYTK1 /YES SKIP FIRST TRACK /ADFB /D074 AC7777 TAD WINDST / /A066 SZA CLA / WINNIE? /C074 CPYTK1, ISZ FMTQBK+RXQTRK / YES IGNORE FIRMWARE /A066 LOOPA, AC0001 / SECTOR NUMBER /A032 DCA SECTOR / INITIALIZE SECTOR NUMBER /A032 TAD CPYPSK / GET PASS COUNT KONSTANT /A032 DCA CPYCNT / AND LOAD INTO ISZ COUNTER /A032 INLOOP, /D067 JMS SECADJ / GO SEE IF MUST ADJUST SECTOR NUMBER /A032 TAD DRVSRC / GET SOURCE DRIVE NUMBER /C033 DCA FMTQBK+RXQDRV / AND STORE IT TAD CPYRD / SET THE REQUEST TO BE A PHYSICAL READ /A025 DCA FMTQBK+RXQFNC TAD SECTOR / SAVE /A025 DCA SVSECT /A025 JMS CPYIO / READ A BUFFERFULL OF SECTORS TAD DRVDST / LOAD DESTINATION DRIVE NUMBER /A033 DCA FMTQBK+RXQDRV / AND STORE IT /M025 TAD CPYWRT / REQUEST A WRITE PHYSIO OF THE DATA JUST READ JMS CPYSET / SET FNC AND WRITE /A025 CLA CLL CML RTR / 2000=VERIFY MODE /A025 TAD CPYRD / SET READ VERIFY MODE /A025 JMS CPYSET /A025 / ISZ CPYCNT / ALL PASSES COMPLETE FOR THIS TRK? /A021 JMP INLOOP / GO DO NEXT PASS /A032 / TAD SECMXK / WE HAVE DONE A "TRACK OF BLOCKS" /A066 CIA / SO BUMP UP THE BLOCK NUMBER /A066 TAD SVBLOC / AC=SAVED BLOCK # + NO. SECTOR/TRACK /A066 DCA SVBLOC / N.B.--- SECTOR=BLOCK /A066 TAD FMTQBK+RXQTRK / SEE IF ALL TRACKS WERE TRANSFERRED /M031 TAD TRKMXK / LOAD NEGATIVE MAXIMUM TRACK NUMBER /M032 SZA ISZ FMTQBK+RXQTRK / BUMP TRACK NUMBER /A032 SZA CLA / /A032 JMP LOOPA / NO, GO DO NEXT TRACK /A021 JMP I CPYTKS / RETURN /A035 /***********************************************************************/ / / / CPYSET--AC CONTAINS FUNCTION CODE ON ENTRY / / IT SETS THE CODE THEN RESETS THE SECTOR COUNT /A025 / THEN PERFORMS THAT FUNCTION ON AS MANY SECTORS THAT /A025 / IS CONTAINED IN CPYNOS /A025 / / /***********************************************************************/ CPYSET, XX /A025 DCA FMTQBK+RXQFNC / SET FUNCTION CODE /A025 TAD SVSECT / GET SAVED SECTOR NUMBER /A021 /M025 DCA SECTOR / AND DO THIS SET OF SECTORS AGAIN /A021/M025 JMS CPYIO / GO DO A PASS /A021 /M025 JMP I CPYSET / RETURN /A025 /***********************************************************************/ / / / SETPAR--SET PARAMETERS FOR BACKUP COPY: / / CPYNOS..........NUMBER OF SECTORS PER PASS / / CPYLNT..........BUFFER LENGTH / / CPYPSK..........NUMBER OF PASSES PER TRACK / / FACTOR..........SECTOR INTERLEAVE FACTOR / / FMTQBK+RXQTRK..........FIRST TRACK NUMBER / / TRKMXK..........LAST TRACK NUMBER / / SECMXK..........LAST SECTOR NUMBER FOR GTSECT / / REWRITTEN FOR TABLE STRUCTURE HLP /M032 / / SECWRP..........FACTOR ADDED TO SECTOR # AFTER A WRAP /A067 / PREVENTING REUSING A SECTOR # /A067 / NOTE: WHEN THE NUMBER OF SECTORS/TRACK AND THE INTERLEAVE HAVE /A067 / NO COMMON DIVISOR BESIDES 1 ("RELATIVE PRIMES") A WRAP /A067 / ALWAYS GIVES AN UNUSED SECTOR # SO SECWRP IS SET TO 0 /A067 / WHEN THEY ARE NOT RELATIVE PRIMES, ONE MUST BE ADDED TO /A067 / THE SECTOR # GENERATED AFTER A WRAP TO PREVENT REUSE OF /A067 / A SECTOR #, THUS SECWRP IS SET TO 1 IN THESE CASES /A067 / WHEN CHANGING THE INTERLEAVE OR ADDING A NEW DEVICE THE /A067 / APPROPRIATE ENTRY MUST BE MADE FOR THE SECWRP VALUE /A067 / / /***********************************************************************/ SETPAR, XX TAD DENSTY / DENSITY FOR COPY SAME FOR IN AND OUT R3L / MULTIPLY BY EIGHT / TABLE NOW 8 WIDE /C067 /D067 TAD DENSTY / MULTIPLY BY FIVE /D067 TAD DENSTY / MULTIPLY BY SIX /D067 TAD DENSTY / MULTIPLY BY SEVEN TAD (PARTBL-1 / ADD ADDRESS OF TABLE LESS ONE DCA X0 / SET UP INDEX REGISTER TAD I X0 / READ FIRST VALUE DCA CPYNOS / SET UP NUMBER OF SECTORS TAD I X0 / READ SECOND VALUE DCA CPYLNT / SET UP BUFFER LENGTH TAD I X0 / READ THIRD VALUE DCA CPYPSK / SET UP NUMBER OF PASSES PER TRACK TAD I X0 / READ FOURTH VALUE DCA FACTOR / SET UP INTERLEAVE FACTOR TAD I X0 / LOAD FIFTH VALUE DCA FMTQBK+RXQTRK / SAVE AS MINIMUM (FIRST) TRACK TAD I X0 / LOAD SIXTH VALUE DCA TRKMXK / LOAD AS LAST TRACK NUMBER TAD I X0 / LOAD SEVENTH VALUE DCA SECMXK / LOAD AS LAST SECTOR VALUE TAD I X0 / LOAD EIGHTH VALUE /A067 DCA SECWRP / LOAD AS SECTOR WRAP ADJUSTMENT /A067 JMP I SETPAR / EXIT / /DISABLE UDKS SO USER WON'T DESTROY SYSTEM DISK /A075 / CLRUDK, 0 /A075 TAD DRVDST / ONLY IF DESTINATION DRIVE IS DRIVE 0 /A043 SZA CLA / DO WE CONTINUE /A043 /C075 /C077 JMP I CLRUDK / ELSE : Exit routine /A077 CIFSYS / INSTRUCTION FIELD OF UDKOPS /A043 AC0001 / CODE TO DISABLE /A043 UDKOPS / CALL THE ROUTINE /A043 JMP I CLRUDK /A075 DECIMAL /TABLE CHANGE HISTORY / V035 Changed RX50 FACTOR from 7 to 2 / V066 ADDED RD50 ENTRY FOR DMII V1.5 / V067 Changed CPYNOS & CPYPSK to reflect full trk buffering / & ADD SECTOR WRAP ADJUSTMENT FACTOR ENTRY PARTBL, /CPYNOS CPYLNT CPYPSK FACTOR RXQTRK TRKMXK SECMXK SECWRP -26 ; 128 ; -1 ; 3 ; 1 ; -76 ; -26 ; 0 /RX01 -26 ; 256 ; -1 ; 5 ; 1 ; -76 ; -26 ; 0 /RX02 -10 ; 512 ; -1 ; 3 ; 0 ; -79 ; -10 ; 0 /RX50 -10 ; 512 ; -1 ; 2 ; 78; -79 ; -10 ; 1 /RX50 FIRMWARE PARTBM=.+5 /POINTER TO TRKMXK ENTRY /A074 -16 ; 512 ; -1 ; 9 ; 0 ; -49 ; -16 ; 0 /RD50 WINNIE -10 ; 512 ; -1 ; 2 ; 0 ; -0 ; -10 ; 1 /RX50 TRACK 0 OCTAL /-------------------- PAGE / THIS INITALIZES THE CONSTANTS / SCONST, TAD (TEXT1N) / SET UP CPYCON "TO RETRY INIT'Z'N /A057 DCA CPYCON / /A057 / CDFMNU / GET THE VALUE FROM MENU FOR THE CMND DCA I (CLKCHG) / CLEAR CLOCK FLAG TAD I (MUBUF+MNTMP2 / LOAD SOURCE DRIVE NUMBER /A033 DCA DRVSRC / AND SAVE IT /A033 TAD I (MUBUF+MNTMP5 / LOAD DESTINATION DRIVE NUMBER /A033 DCA DRVDST / AND SAVE IT /A033 TAD I (MUBUF+MNTMP1 / LOAD FUNCTION CODE FROM MENU /C033 /D066 CDFMYF DCA FNCODE / SAVE IT /A057 SCONS1, / RE-ENTRY POINT /A058 CDFMYF /ADFB / THE FOLLOWING 3LINES WERE MOVED FROM ABOVE /A058 JMS WINCHK / SEE IF WINNIE, (RE)SET FLAGS, ETC. /A066 DCA FMTQBK+RXQBLK / CLEAR BLOCK NUMBER /M058 DCA MIN / SET THE CLOCK /M058 DCA SEC / /M058 TAD FNCODE / RESTORE IT /A057 / THIS CODE CHECKS TO SEE WHAT ROUTINE WAS CALLED / THE COPY OR ONE OF THE INITALIZES / TAD (-6) /C053 SNA /A053 JMP FMTNOS / NO 8" SYSTEM DISK ALLOWED /A053 IAC /A053 SNA /A014 JMP FMTDBL / 5 = FORMAT DOUBLE DENSITY DISKETTE /A014 IAC /A014 SNA /A014 JMP FMTSGL / 4 = FORMAT SINGLE DENSITY DISKETTE /A014 IAC /A014 SNA / JMP FMTDSK / 3= INITALIZE DOCUMENT IAC SNA / JMP FMTSYS / 2= INITALIZE SYSTEM DISKETTE IAC SZA CLA / JMP CPYDS2 / ALL OTHERS JMP CKDFSZ / 1= REGULAR COPY /C053 FMTSGL, / FORMAT SINGLE DENSITY DISKETTE ROUTINE/A014 TAD (RXEFMS+4000) / GET FUNCTION CODE FOR SNGLE DEN FORMAT/A014 JMP FMTCLL / GO CALL THE AUX CNTL PROCESSOR /A014 FMTDBL, / FORMAT DOUBLE DENSITY DISKETTE ROUTINE/A014 CLA / CLEAR AC /A014 TAD (RXEFMD+4000) / GET FUNCTION CODE FOR DBL DEN FORMAT /A014 FMTCLL, /C028 DCA FMTCMD / SAVE FORMAT COMMAND /A028 TAD DRVDST / LOAD DESTINATION DRIVE NUMBER /C033 DCA FMTQBK+RXQDRV / SET DRIVE NUMBER IN Q-BLOCK /A032 JMS FMTDEN / GET DENSITY AND AND DRIVE READY /A028 AC7776 / LOAD MINUS TWO /A032 TAD DENSTY / SEE WHAT KIND OF DRIVE WE HAVE /A032 SNA CLA / SKIP IF NOT RX50 /A032 JMP CPYEXT / ELSE GO ABORT FORMAT /A032/C033 TAD (TEXT1L) / SET UP CPYCON "TO RETRY FORMAT" /A057 DCA CPYCON / /A057 TAD FMTCMD / RESET COMMAND /A028 DCA FMTQBK+RXQFNC / PUT IT INTO THE Q-BLOCK /A014 JMS FMTRTB /Is FORMAT PRINT 'Format in process....ect /A028 JMS FMTRXT / GO FORMAT 8 INCH DISKETTE /A014 JMP DRVPRB / ERROR--GO SEE IF DOOR WAS OPEN /A045 /IF WE HAVE DECMATE-I ALLOW TO INITIALIZE AS S OR D /A041 /IF WE HAVE DECMATE-II, ALLOW ONLY D INITIALIZATION /A041 /DETERMINE IF DECMATE-I or II BY SEEING IF SYSTEM DISK /A041 /IS 8 INCH (DM-I) or 5 INCH (DM-II) /A041 TAD DENIN /SOURCE DSK-0=RX01/02,1=RX50,2=WINNIE /C074 SZA CLA /=RX01/02? /C074 JMP FMTDCD /WINNIE DISK/ DECMATE-I: /C074 FMTASK, CLA / CHKCCM DOES NOT CLA /A056 JMS CPYASK / GO ASK WHETHER HE WANTS A SYSTEM OR /A014 / DOCUMENT DISK /A014 JMP CHKLET / GO SEE WHAT HE TYPED IN /A014 FMTDCD, AC0003 / LOAD CODE FOR DOCUMENT /A056 JMP DMNTM1 / GO JOIN CHKLET CODE /A056 FMTCMD, 0 /SAVE FORMAT COMMAND HERE /A028 GETTIM, / UPDATES LAPSED TIME CLOCK 0 CLA CDFMNU TAD I (CLKCHG) CDFMYF SPA / JMP PRTSC2 / RETURN IF NO CHANGE ISZ SEC TAD (-12) SMA / JMP .-3 CDFMNU DCA I (CLKCHG) CDFMYF TAD SEC / ELSE COMPUTE NEW TIME TAD (-74) SPA / JMP .+3 / ADJUSTING FOR MINUTE CHANGE ISZ MIN JMP .-4 TAD (74) DCA SEC / CIFMNU JMS I IOACAL / 0 / PRINT TIME WHEN IT CHANGES TEXT13 1350 MIN SEC / PRTSC2, CLA JMP I GETTIM / MIN, 0 / THE VALUE OF THE MINUTES SEC, 0 / THE TEMP VALUE THAT DETECTS A CHANGE IN TIME /-------------------- PAGE /***********************************************************************/ / / / CPYERR--PUTS OUT THE ERROR MESSAGES WHEN DIFFERENT KINDS / / OF DISKETTES ARE SPECIFIED FOR A BACKUP COPY / / CALLED FROM DTDEN. DENSTY CONTAINS DENSITY CODE OF / / DENST0 CONTAINS DENSITY OF SYSTEM DRIVE (DM-I OR DM-II) / / DESTINATION DRIVE, T1 CONTAINS DENSITY OF SOURCE DRIVE / / ROUTINE ADDED / / / MODIFIED FOR DM-I/II /V035 / / / /***********************************************************************/ CPYERR, XX / CIFMNU / JMS I IOACAL / PRINT "BACKUP ERROR MENU" / 0 TEXT17 / 0 / CURSOR POSTION 0 / TAD WINFLG / IS THIS A 'WINNIE" ?? /A066 SNA CLA / NO- PROCESS ERROR AS BEFORE /A066 JMP CPERDK / - THIS BRANCHES PAST 'WINNIE' CODE /A066 TAD WINSRC / YES- NOW IS THERE A SOURCE ERROR ?? /A066 SMA CLA / YES- GO PROCESS /A066 JMP CPERWB / NO- BRANCH TO DEST. ERROR RTNE. /A066 TAD WINSRC / WHICH TYPE OF ERROR??? /A066 /-1=NOT ASSIGNED -2=AREA TOO SMALL -3=AREA TOO LARGE /A074 JMS SETEXT /GET TEXT STRING POINTER /A066 DCA CPERWS / /A066 CIFMNU /A066 JMS I IOACAL / PRINT "SOURCE AREA IS...." /A066 0 /A066 CPERWS, 0 /A066 0705 /A066 TXTSRC /A066 DRVSRC /A066 / /A066 CPERWB, /A066 TAD WINDST / IS THERE A DESTINATION ERROR ?? /A066 SMA CLA / YES- GO PROCESS /A066 JMP CPYER2 / NO- BRANCH PAST OLD DISKETTE CODE /A066 TAD WINDST / WHICH TYPE OF ERROR??? /A066 /-1=NOT ASSIGNED -2=AREA TOO SMALL -3=AREA TOO LARGE /A074 JMS SETEXT /GET TEXT STRING POINTER /A066 DCA CPERWD / /A066 CIFMNU /A066 JMS I IOACAL / PRINT "DESTINATION AREA IS...." /A066 0 /A066 CPERWD, 0 /A066 1505 /A066 TXTDST /A066 DRVDST /A066 / /A066 JMP CPYER2 / BRANCH PAST DISKETTE CODE /A066 CPERDK, TAD DENIN /SOURCE DSK-0=RX01/02,1=RX50,2=WINNIE /C074 SNA CLA /=RX01/02? /C074 TAD (TEXT18-TEXTY / YES USE TEXT18 FOR DM-I / TAD (TEXTY / USE TEXTY FOR DM-II OR WINNIE / DCA DIFDSK / SAVE SUBSTRING POINTER / CIFMNU / JMS I IOACAL / PRINT EITHER "THE DENSITIES OF YOUR / 0 / DISKETTES ARE DIFFERENT", OR / TEXT20 / "Your diskettes are different. / 0505 / CURSOR POSTION LINE 5, COL 5 / DIFDSK, XX / SUBSTR PTR / / WE KNOW THE DENSITY CODES ARE DIFFERENT / WE WANT TO DETERMINE IF WE ARE TRYING TO COPY BETWEEN / DIFFERENT DENSITIES ON 8 INCH DRIVES. IF SO, THE SOURCE / DENSITY PLUS THE DESTINATION DENSITY WILL BE EXACTLY ONE. AC7777 / LOAD MINUS ONE / TAD DENDST / DENSITY OF DESTINATION DRIVE /C074 TAD DENSRC / DENSITY OF SOURCE DRIVE /C074 SZA CLA / SKIP IF DIAMETERS ARE EQUAL / JMP CPYDDI / DIAMETERS ARE DIFFERENT / TAD DENSRC / DENSITY OF SOURCE DRIVE--0 OR 1/C074 TAD (SDDDPT / ADD POINTER TO POINTER / DCA DENFRM TAD DENSTY / DENSTIY OF DEST. DRIVE / TAD (SDDDPT / ADD POINTER TO POINTER / CPYER1, DCA DENTO / SAVE IN COPYING TO ___ / CIFMNU / JMS I IOACAL / 0 / TEXT22 / PRINT "YOU ARE TRYING TO COPY FROM" / 1005 / LINE 10, COL 5 / DENFRM, 0 / FROM ___ DENSITY / DENTO, 0 / TO ___ DENSITY / TAD DENFRM / GET POINTER TO FROM ___ / DCA DENFR1 / AND USE AS AN ARGUMENT HERE / CIFMNU / JMS I IOACAL / PRINT "PLEASE USE A___ ... FOR..COPY / 0 / / TEXT23 / "PLEASE USE A __ ... FOR .. COPY / 1405 / LINE 14 COL 5 / DENFR1, 0 / A COPY OF DENFRM / CPYER2, /A066 CIFMNU / JMS I IOACAL / / 0 / TEXTG3 / GENERAL PURPOSE CONTROL STRING 3 / 2205 / LINE 22 COL 5 / TEXT26 / "PRESS RETURN TO CONTINUE / 2405 / LINE 24 COL 5 / TEXT33 / "OR, " / IFNDEF ITALIAN <2411> / /C051 IFDEF ITALIAN <2405> TEXT15 / "PRESS GOLD MENU TO RECALL THE / 2700 / LINE 27 COL 0--FOR OPR RESP / JMP I CPYERR / RETURN TO CALLER / SDDDPT, TEXT24 / SINGLE DENSITY / TEXT25 / DOUBLE DENSITY / S8S5PT, TEXT2B / 5 INCH / TEXT2A / 8 INCH / CPYDDI, / TRYING TO COPY FROM DIFFERENT DIAMETERS / AC0004 / A080 AND DRVSRC / SOURCE DRIVE / M080 CLL RTR / M080 TAD (S8S5PT / ADD POINTER TO POINTER / DCA DENFRM AC0004 / A080 AND DRVDST / DESTINATION DRIVE / M080 CLL RTR / M080 TAD (S8S5PT / ADD POINTER TO POINTER / JMP CPYER1 / GO PICK UP ABOVE /***********************************************************************/ / / / DSKSZE--ROUTINE WHICH LOADS THREE VARIABLES AS FOLLOWS / / DSBLKV THE NUMBER OF BLOCKS TO VERIFY AFTER A / / A SYSTEM OR DOCUMENT INITIALIZATION / / DSBLKD THE NUMBER OF BLOCKS ON A DOCUMENT DISKETTE / / DSBLKS THE NUMBER OF BLOCKS ON A SYSTEM DISKETTE / / THIS ROUTINE MODIFIED ON V035. PREVIOUS REVISIONS SET UP / / DSBLKS TO BE EITHER -632, -988, OR -784, AND DSBLKS WAS USED / / FOR ALL THREE PURPOSES / / / /***********************************************************************/ DSKSZE, 0 /A027 DCA DSKSZL /SAVE DENSITY /A075 AC0004 /A074 CIA /NEGATE /A074 TAD DSKSZL /GET IT /A075 SNA CLA /=WINNIE? /A075 JMS DSKSZF /SET SPECIAL WINNIE SIZE(MAY BE ABLE TO /A074 /......ELIMINATE RD50 ENTRY IN DSKSZT) /A074 TAD DSKSZL / GET THE DENSITY OF THE DISK /C027 /C075 TAD DSKSZL / MULTIPLE BY TWO /A035 /C075 TAD DSKSZL / MULTIPLY BY THREE /A035 /C075 TAD (DSKSZT-1 / ADD TABLE BASE /C035 DCA X1 / SAVE IN AN INDEX REGISTER /C035 TAD I X1 / READ TABLE /A035 DCA DSBLKV / /A035 TAD I X1 / READ TABLE /A035 DCA DSBLKD / /A035 TAD I X1 / READ TABLE /A035 DCA DSBLKS / /A035 JMP I DSKSZE /A027 DSKSZL, 0 /A075 /------------------ PAGE DECIMAL DSKSZT, / TABLE OF DISK BLOCKS FOR DIFFERENT MEDIA /C035 /VFY /DOC /SYS ---TYPES OF CONSTANTS /A035 /DSBLKV DSBLKD DSBLKS ---NAME OF LOCATION LOADED /A035 -632; -632; -632 / RX01 /A035 -988; -988; -988 / RX02 /A035 DSKSZU, -790; -784; -768 / RX50 /A035 -000; -000; -000 / DUMMY (RX50 DBL. SIDED) /A066 DSKSZV, -790; -784; -768 / RD50 (DMII V1.5 ONLY!!!) /A066 /.......(OVERLAYED FOR RD50 V 2.0/A074 OCTAL /***********************************************************************/M031 / / WRITE BOOT ROUTINE / WRITES BOOT FROM FMTBUF / /*********************************************************************** WRBOOT, XX / WRITE BOOTSTRAP FROM FMTBUF /A031 JMS PHYIO / WRITE BOOTSTRAP BLOCK TO DOC DISKETTE /A016 RXEW12+4000 / (IN 12 BIT MODE). /A016 JMS PHYIO / NOW READ VERIFY BOOT /A043 RXER12+6000 /A043 JMP I WRBOOT / GO HOME /A031 /********************************************************************** / /A014 / PHYIO DOES PHYSICAL IO, EITHER READING OR WRITING /A014 / THE ROUTINE IS DESIGNED TO READ AND WRITE THE BOOTSTRAP /A014 / CODE FROM A ONE DISKETTE TO ANOTHER. THE CALLING SEQUENCE IS: /A014 / JMS PHYIO /A014 / RXER12 OR RXEW12 (12 BIT) /A014 / RXEPR OR RXEPW (8 BIT) /A042 / YOU MUST SET THE DRIVE NUMBER AND THE BUFFER FIELD IN THE /A014 / Q-BLOCK BEFORE ENTERING THIS ROUTINE. THE ROUTINE WILL FIND OUT /A014 / THE DENSITY OF THE DRIVE NUMBER PASSED IN THE Q-BLOCK, AND THEN /A014 / EITHER READ INTO OR WRITE OUT FROM BUFFER "FMTBUF" /M031 / / THE BOOTSTRAP PROGRAM. /A014 / /A014 /***********************************************************************/A014 PHYIO, XX / PHYSICAL IO TO COPY BOOTSTRAP PROGRAM /A014 / ADDRESS OF READ/WRITE PARAMETER /A014 / RXER12=READ/RXEW12=WRITE /A014 JMS FMTDEN / GO GET DENSITY & INIT RXHAN /A014 TAD I PHYIO / GO GET FUNCTION CODE (READ OR WRITE) /A014 DCA FMTQBK+RXQFNC / PUT FUNCTION CODE INTO Q-BLOCK /A014 TAD (FMTBUF) / GET ADDRESS OF BUFFER /A014 DCA FMTQBK+RXQBAD / PUT IT INTO Q-BLOCK /A014 IAC / GET TRACK NUMBER=1 (WHERE BOOT IS) /A014 DCA FMTQBK+RXQTRK / PUT IT INTO Q-BLOCK /A014 IAC / GET SECTOR NUMBER=1 (WHERE BOOT IS) /A014 DCA FMTQBK+RXQSEC / PUT IT INTO Q-BLOCK /A014 DCA FMTQBK+RXQBLK / FOR WINNIE - BLOCK 0 IS BOOT /A066 ISZ PHYIO / BUMP UP TO RETURN POINT /A014 JMS FMTRXT / GO DO PHYSICAL IO /A014 JMP DRVPRB / ERROR--GO SEE IF DOOR WAS OPEN /A045 / NOTE: THE FIRST PART OF THE BOOTSTRAP PROGRAM HAS NOW EITHER BEEN /A014 / WRITTEN FROM OR READ INTO BUFFER "FMTBUF" /M031 / THE FIRST 100 (64) LOCATIONS (SINGLE DEN) /M031 / THE FIRST 200 (128) LOCATIONS (DOUBLE DEN) /M031 / (BUT ONLY THE FIRST 100 LOCS CONTAIN DATA) /M031 / THE ENTIRE 400 (256) LOCATIONS (RX50--12 BIT MODE) /A032 / THE ENTIRE 1000 (512) LOCATIONS (RX50--8 BIT MODE) /A042 AC7776 / LOAD -2 /A032 TAD DENSTY / DENSITY CODE 2=RX50 /A032 SMA CLA / SKIP IF RX01 OR RX02 /A032 JMP PHYIOX / ONLY 1 READ FOR RX50 AND WE'RE DONE /C079 TAD (FMTBUF+100) / GET ADDRESS OF SECOND BUFFER /M031 DCA FMTQBK+RXQBAD / PUT IT INTO Q-BLOCK /A014 AC0004 / GET SECTOR NBR FOR 2ND PART /M031/C004/C022 DCA FMTQBK+RXQSEC / SET SECTOR NBR IN Q-BLOCK /A014 JMS FMTRXT / GO DO THE IO /A014 JMP DRVPRB / ERROR--GO SEE IF DOOR WAS OPEN /A045 / NOTE: THE SECOND PORTION OF THE BOOTSTRAP HAS NOW BEEN READ /M031 / OR WRITTEN. /M031 / IF RX02 THE 200 WORDS OF THE SECOND HALF OVERLAY /M031 / THE BLANK PORTION OF THE FIRST HALF /M031 TAD DENSTY / 1=DOUBLE DENSITY 0=SINGLE DENSITY /A014 SZA CLA / NON-ZERO HERE MEANS IT'S DOUBLE /M031/A014 JMP PHYIOX / EXIT IF DOUBLE--WE ARE DONE /C079 TAD (7) / SGL DEN SEC NBR LST HALF 2ND PART BOOT/A014 DCA FMTQBK+RXQSEC / PUT IT INTO Q-BLOCK /A014 TAD (FMTBUF+200) / GET BUFFER ADDR LAST PORTION OF BOOT /M031 DCA FMTQBK+RXQBAD / PUT IT INTO Q-BLOCK /A014 JMS FMTRXT / GO DO THE IO /M031 JMP DRVPRB / ERROR--GO SEE IF DOOR WAS OPEN /A045 / NOTE: THE LAST THIRD OF THE RX01 BOOTSTRAP HAS NOW EITHER BEEN /A014 / WRITTEN FROM OR READ INTO THE BUFFER FIELD "FMTBUF" /A014 PHYIOX, DCA FMTQBK+RXQBAD /RESET BUFFER ADDRESS TO 0 /A079 JMP I PHYIO / ALL DONE RETURN /A014 /***********************************************************************/ / / / CHKCCM CALLS THE DLOCPM MENU PAGE (PART OF CPYDSK) / / THERE IT BRANCHES INTO TWO CHECKS: / / MNTMP3=0 MEANS TEST FOR "COPY" / / MNTMP3<>0 MEANS TEST FOR "S" OR "D" / / ROUTINE ADDED V056 / / / /***********************************************************************/ CHKCCM, XX CDFMNU DCA I (MUBUF+MNTMP3 / SAVE THE FUNCTION CODE FOR THE MENU CDFMYF CIFMNU JMS I MNUCAL / GO INTO MENU CODE DLMCPM / IN MN1 /C073 /WHEN WE RETURN, MNTMP3 WILL TELL US WHAT THE USER DID: / 0 GOLD MENU OR "NO" / 1 "COPY" / 2 "S" / 3 "D" CDFMNU TAD I (MUBUF+MNTMP3 / LOAD THE RESULT FOR OUR FRIENDLY CALLER CDFMYF SZA / SKIP IF GOLD MENU JMP I CHKCCM / AND RETURN JMP CPYGMO / GO GOLD MENU OUT OF CPYDSK FMTER, CLA JMS FMTERR / DISPLAY THE ERROR MESSAGE /D045 JMP FMTERN / RETURN NORMALLY /***********************************************************************/ / / / FMTERN--DISPLAY MESSAGE ASKING FOR GOLD MENU / / / /***********************************************************************/ FMTERN, CIFMNU JMS I IOACAL / 0 TEXTG1 / GENERAL PURPOSE--ONE SUBSTRING 2412 TEXT15 / "Press Gold ... /A033 2700 JMS WTFRGR / GO WAIT FOR GOLD RESPONSE /A056 JMP CPYDS2 / AND EXIT CPYDSK /A056 /***********************************************************************/ / / / WTFRGR--ACCEPTS ONLY GOLD MENU AND THEN EXITS CPYDSK / / / /***********************************************************************/ WTFRGR, / WAIT FOR ONLY GOLD RESPONSE / XX / /A056 WTFRG1, JMS WTFRRS / WAIT FOR A RESPONSE SKP / CARRIAGE RETURN TYPED JMP I WTFRGR / A GOLD MENU TYPED /C056 / JMS CPYWFT / HE TYPED RETURN, BLATTTTTT... JMP WTFRG1 / WAIT AGAIN / /*****SPACE WARS MOVE VER 075 ****** /A075 / CPDSET, 0 /A075 AC0002 / FORCE DENSITY TO 2 (RX50) /A066 DCA DENSTY /A066 TAD (RXMAP-1) / GET POINTER TO SECTOR TO BLOCK /A066 / TRANSLATION MAP /A066 DCA T4 / & SAVE /A066 JMP I CPDSET /RET /A075 /***********************************************************************/A014/M066 / /A014/M066 / THIS ROUTINE CHECKS TO SEE IF THE USER HAS REPLIED A "D" OR AN /A014/M066 / "S" TO AN INQUIRY AS TO WHETHER HE WANTS TO INITIALIZE THE /A014/M066 / DISKETTE HE JUST FORMATTED TO A DOCUMENT OR SYSTEM DISKETTE /A014/M066 / /A014/M066 /***********************************************************************/A014/M066 CHKLET, / CHECK REPLY D OR S /A014/M066 AC0001 / MAKE AC NON-ZERO FOR CHKCCM /A056/M066 JMS CHKCCM / SO MENU KNOWS WHAT WE WANT /A056/M066 SPA / SEE IF NEED TO REPAINT /A056/M066 JMP FMTASK / YES, GO REPAINT /A056/M066 DMNTM1, / PUT FLAG WHERE DU MENU CAN GET AT IT /A014/M066 CDFMNU / MENU FIELD /A014/M066 DCA I (MUBUF+MNTMP1) / TELL DU MENU WHAT WE'RE DOING /A014/M066 AC0001 / SET SIGNAL TO MAIN MENU THAT WE'RE DOING/A014/M066 DCA I (MUBUF+MNTMP3) / AND THEREFORE NOT TO PUT OUT THE /A014/M066 CDFMYF / MESSAGE TO PUT THE DISK IN DRIVE 1 /A014/M066 CIFMNU /A014/M066 JMS I MNUCAL / CALL DU MENU /A014/M066 DLMDU3 /A014/M066 CDFMNU /A015/M066 CLA /M066 TAD I (MUBUF+MNTMP4) / GOLD KEY SWITCH /A015/M066 CDFMYF /A015/M066 SZA CLA / RETURN DESIRED ? /A015/M066 JMP SCONST / RETURNS HERE AFTER MENU CALL...CONT /A015/M066 JMP CPYDS2 / EXIT RETURN /C056/M066 /-------------------- PAGE /***********************************************************************/ / / / FMTDSK, /INITIALIZE A DOCUMENT DISKETTE / / / /***********************************************************************/ FMTDSK, / INITIALIZE DOCUMENT DISKETTE /A032 TAD WINDST / FIRST MAKE SURE DEST. IF A WINNIE /A066 / - IS ASSIGNED & BIG ENOUGH /A066 SPA CLA / MINUS INDICATES PROBLEM /A066 JMP FMTWER / PROBLEM - GO TELL USER& GET RESPONSE /A066 JMS SHOWNM / SHOW VOLUME NAME IF WINNIE & GET RESP /A066 JMS FMTINI / GO INITIALZE DRVDST & PUT UP TIMMSG /A032 AC7777 / LOAD MINUS TWO /A032/C074 TAD DENSTY / SEE IF DSTDRV IS 8 INCH OR 5 INCH /A032 SMA SZA CLA / SKIP IF 8 INCH /A032/C066/C074 JMP FMT50W / GO DO RX50 OR WINNIE /A032 /C074 /D074 TAD (DCSTRT / GET START ADDRESS FOR A DOC DISK /A032 /D074 CDFMYF+10 / CHANGE TO BUFFER FIELD /A042 /D074 DCA I (FMTBUF+LDSTRT-12 /SAVE /A032 /D074 CDFMYF / CHANGE BACK TO THIS FIELD /A042 /D074 JMS WR50BT / GO WRITE RX50 BOOT /A042 /D074 0 / WITH DOCUMENT ID /A042 /D074 JMP FMTDCA / GO DO OTHER STUFF /A044 FMTDC8, / 8 INCH INITIALIZATION CONTINUED /D074 SMA CLA / BUT FIRST CHECK FOR WINNIE /A066 /D074 JMP FMT50W / YES IT IS- GO PROCESS /A066 TAD (DCSTRT / GET START ADDRESS FOR A DOC DISK /A032 CDFMYF+10 / CHANGE TO BUFFER FIELD /A042 DCA I (FMTBUF+LDSTRT-100 /OVERWRITE BOOT STARTING ADDR FOR MSG/C042 CDFMYF / CHANGE BACK TO THIS FIELD /A042 JMS WRBOOT / WRITE & VERIFY THE RX01/02 BOOT /A042 JMP FMTDCA / GO DO OTHER STUFF /A066 FMT50W, / WRITES RX50 OR WINNIE DOCUMENT BOOT /A066 /C074 TAD (DCSTRT) / DUPLICATE RX50 LOGIC ABOVE /A066 CDFMYF+10 / /A066 DCA I (FMTBUF+LDSTRT-12) /A066 CDFMYF / /A066 JMS WR50BT / /A066 0 / /A066 FMTDCA, /D078 TAD (RXEWT+4000 / LOAD CODE FOR LOGICAL 12 BIT WRITE /A044 /D078 JMS FMTDOC / GO DO THE WRITE PASS /A044 /D078 JMS FMTVCD / LOAD THE CODE FOR THE VERIFY PASS /A045 JMS FMTDOC / GO DO THE WRITE VERIFY PASS /C078 JMP FMTERN / GO TELL USER WE ARE DONE /A044 FMTDOC, XX / WRITE OR VERIFY DOC DISKETTE /A044 /D078 DCA CPSDFN / LOAD THE FUNCTION (WRITE OR VERIFY /A044 AC0001 / SET BLOCK # TO 1 /A016 DCA FMTQBK+RXQBLK TAD DSBLKD / NEG NO OF DOCUMENT BLOCKS /A035 DCA DSBLKC / IS NO TO CLEAR /A035 JMS CLABLK / CLEAR BLOCKS 1 TO N /M031 DCA STDBSW / SET DOC SW(0) JMS RSTBLK /RESET BLOCK COUNT AND FUNCTION /A078 TAD DSBLKD / GET NUMBER OF DOCUMENT BLOCKS /A035 CIA / POSITIVATE /A035 DCA DSBLKC / AND PASS TO STDBL /A035 JMS FMTHAB / GO DO HOME AND ALLOC BLOCKS /A045 / / NOW DO THE BOOT ERROR MESSAGE BLOCK /A044 / THE FOLLOWING LINES ARE NOT NECESSARY IF THE CAPABILITY /A037 / TO HAVE AN ERROR MESSAGE APPEAR WHEN A DOCUMENT DISKETTE IS /A037 / BOOTED IS NOT NEEDED, OR IS HANDLED BY ROMWARE OR SLUSHWARE. /A037 / BLOCK EMESBK MAY ALSO BE FREED UP IN THE ALLOCATION MAP /C044 / IF VERIFY IS CHANGED BE A LITTLE LESS CRITICAL--ALLOCATED /A044 / BLOCKS NOT BELONGING TO ANY DOCUMENT SHOULD BE IGNORED /A044 / MAP (THIS IS THE LAST HANDLER BLOCK) /C044 TAD (RXERD+4000) / SET TO READ THE LAST HANDLER BLOCK DCA FMTQBK+RXQFNC TAD (EMESBK / GET LAST HANDLER BLOCK NUMBER /C044 DCA FMTQBK+RXQBLK DCA FMTQBK+RXQDRV / SET THE DRIVE TO ZERO TAD (FMTBUF) / SET THE BUFFER DCA FMTQBK+RXQBAD JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 TAD CPSDFN / LOAD FUNCTION (WRITE OR READ/VFY) /A044 DCA FMTQBK+RXQFNC TAD DRVDST / LOAD DESTINATION DRIVE NUMBER /A032 DCA FMTQBK+RXQDRV JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 JMS FMTWN /IF VOLUME SET TO NON BOOTABLE DOC /A074 JMP I FMTDOC / RETURN /A044 / ********************************************************************* /A066 / / VOLNAM - INPUT: AC=0 SOURCE VOLUME NAME / AC.NE.0 DEST VOLUME NAME / READS THE VOLUME NAME ASCII TEXT INTO THE APPROP. / LOCATION, FROM THE QUEUE BUFFER / / ******************************************************************** /A066 VOLNAM, XX SZA CLA / SOURCE OR DESTINATION VOLUME?? TAD (RCVNAM-CPYNAM) / GET OFFSET OF RCVNAM FROM CPYNAM TAD (CPYNAM-1) / ADD IN ADDRESS OF CPYNAM -1 DCA X0 / & SAVE FOR AUTOINDEX AC7777 / SET AC=-1 TAD FMTQBK+RXQBAD / ADD IN QUEUE BLOCK BUFFER ADDR DCA X1 / & SAVE FOR AUTOINDEX AC0010 / VOLUME NAME IS 8 CHARACTERS CIA / SO WE NEED A COUNTER SET TO DCA T2 / -8, FOR LOOP CONTROL RDNMLP, CDFMYF+10 / CHANGE TO BUFFER FIELD TAD I X1 / AND GET NEXT CHAR INTO AC DCA T3 / & SAVE FOR A BIT CDFMYF / BACK TO OUR FIELD TAD (7740) / GET -(ASCII SPACE) INTO AC TAD T3 / ADD IN CHAR VALUE SZA CLA / IF CHARACTER WAS A SPACE WE WILL PUT / A TERMINATING NULL INTO OUR ASCII TEXT TAD T3 / ELSE ACCEPT CHARACTER DCA I X0 / & PUT INTO OUT TEXT STRING ISZ T2 / HAVE WE READ 8 CHARACTERS?? JMP RDNMLP / NO, GO READ NEXT CHAR JMP I VOLNAM / YES, EXIT /***********************************************************************/ / / / WR50BT--WRITE RX50 BOOTSTRAP (ADDED V042) / / THIS ROUTINE WRITES THE RX50 BOOTSTRAP WITH THE / / STANDARD RX50 HEADER. THE HEADER IS READ IN 8 BIT / / MODE BY ALL SYSTEMS. IT CANNOT BE WRITTEN IN 12 BIT / / MODE AS 4 OF THE BITS IN SUCESSIVE BYTES CAN NOT BE / / WRITTEN. THEREFORE, THE BOOT IS FIRST WRITTEN IN / / 12 BIT MODE TO WRITE THE PDP-8 PORTION. THE BOOT IS / / THEN READ BACK IN 8 BIT MODE, AND THE BOOT HEADER IS / / OVERLAYED IN THE BUFFER. THE DOCUMENT/SYSTEM PARAMETER / / IS THEN OVERLAYED AS PASSED BY THE CALLER, AND THE / / BOOT WITH HEADER IS WRITTEN OUT IN 8 BIT MODE / / / /***********************************************************************/ WR50BT, XX / JMS WRBOOT / GO WRITE & VERIFY BOOTSTRAP ON RX50 / JMS PHYIO / NOW READ IT BACK IN 8 BIT MODE / RXEPR+4000 / CODE FOR PHYSICAL READ 8 BIT / / BUFFER SIZE MUST BE 512 / JMS BLKMOV / NOW OVERLAY THE BOOT HEADER / R5BHDR-1 / SOURCE ADDRESS / FMTBUF-1 / DESTINATION ADDRESS / -R5BHSZ / NEG NUMBER OF CHRS / CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 TAD I WR50BT / PICK UP DOCUMENT/SYSTEM BYTE / ISZ WR50BT / ADJUST RETURN ADDR / CDFMYF+10 / CHANGE TO BUFFER FIELD / DCA I (FMTBUF+3 / DOCUMENT/SYSTEM BYTE LOCATION / CDFMYF / CHANGE BACK TO THIS DATA FIELD / JMS PHYIO / NOW WRITE BACK WITH THE PROPER / RXEPW+4000 / BOOT HEADER / JMS PHYIO / NOW READ-VERIFY BOOTSTRAP /A043 RXEPR+6000 / 4000=RETURN ERRORS; 6000=VERIFY /A043 JMP I WR50BT / RETURN / /RESET BLOCK COUNT AND FUNCTION CODE TO WRITE VERIFY / RSTBLK, 0 DCA FMTQBK+RXQRS1 /0=1 BLOCK /A078 TAD (RXEWT+6000 /WRITE LOGICAL AND VERIFY /A078 DCA FMTQBK+RXQFNC /SET FUNCTION /A078 JMP I RSTBLK /RETURN /A078 /---------------------- PAGE /************************************************************************** / / THIS ROUTINE GETS DENSITY / QBLK CONTAINS DRIVE TO PROCESS /M032 / ONE OF THE FOLLOWING CODES IS RETURNED /A032 / IN LOCATION DENSTY: /A032 / 0 RX01/RX02 SINGLE DENSITY /A032 / 1 RX02 DOUBLE DENSITY /A032 / 2 RX50 SINGLE SIDED /A032 / 3 RX50 DOUBLE SIDED /A032 / /************************************************************************** FMTDEN, XX TAD (RXEDN+4000) / GET GET DENSITY CODE /A014 DCA FMTQBK+RXQFNC / FUNCTION TO Q-BLOCK /A014 JMS FMTRXT / GO GET DENSITY OF DRIVE /A014 JMP DRVPRB / ERROR--GO SEE IF DOOR WAS OPEN /A045 TAD FMTQBK+RXQSPC / GET DENSITY CODE /A014 DCA DENSTY / SAVE DENSITY JMP I FMTDEN / RETURN /***********************************************************************/ / / / CHKID2--ROUTINE TO TELL OPERATOR TO RE-INSTALL THE / / ORIGINAL SYSTEM DISK (HAS SAME DISK ID) / / GOLD MENU IS ONLY LEGAL CHAR ACCEPTED / / ROUTINE ADDED V036 AS CPYINS / / ACTUALLY IS PART OF CHKID ROUTINE / / / /***********************************************************************/ CHKID2, / /A057 JMS CLRSCR / CLEAR THE SCREEN CIFMNU JMS I IOACAL 0 TEXTG1 / GENERAL PURPOSE--1 SUBSTRING 1405 TEXT3 / "REPLACE THE ORIGINAL SYSTEM DISK... 3000 JMS PPG / PRINT PRESS GOLD JMS WTFRGR / WAIT FOR ONLY GOLD MENU JMP CHKID1 / AND GO CHECK ID AGAIN /A057 /***********************************************************************/A031 / /A031 / FMTDIR SETS UP THE DIRECTORY BLOCK HEADER IN FMTBUF /A031 / IT IS CUSTOMARILY CALLED AFTER THE FMTBUF HAS BEEN CLEARED AND /A031 / COSCNT HAS ALREADY BEEN SET UP /A031 / /A031 /***********************************************************************/A031 FMTDIR, XX /A031 JMS CLBUF / CLEAR THE BUFFER /A082 TAD (INIBK) / LOC TO STORE NAME IN THIS FIELD /C042 JMS CRTNM / CONVERT THE NAME AND INSERT IT TAD (FMTBUF) /A031 DCA X1 / USE X1 TO SET UP THE BEGINNING /A031 TAD (130) / ID CODE FOR DIR BLOCK /A031 JMS FMSTF1 / SAVE IN FMTBUF+1 /C042 TAD INIBK / FIRST CHR OF NAME /A031 JMS FMSTF1 / SAVE IN FMTBUF+2 /C042 TAD INIBK+1 /A031 JMS FMSTF1 / SAVE 2ND CHR IN FMTBUF+3 /C042 TAD INIBK+2 /A031 JMS FMSTF1 / SAVE 3ND CHR IN FMTBUF+4 /C042 CDFSYS TAD I (RANDOM) / GET THE UNIQUE VALUE /A031 JMS FMSTF1 / SAVE IN FMTBUF+5 /C042 TAD P377 / GET ALLOC BLOCK NUMBER /A031 JMS FMSTF1 / SAVE IN FMTBUF+6 /C042 /=========================================================================== /==== THE WPS INSTALL PROGRAM REQUIRES THE BUILD DATE ==== /==== IN THE HOME BLOCK OF THE SYSTEM DISKETTE ==== /==== ==== /==== IF THE CURRENT DATE IS DESIRED FOR THE DOCUMENT DISKETTE ==== /==== THEN UNDELETE ALL THE /*082'S BELOW ==== /=========================================================================== /*082 TAD STDBSW / PICK UP DISKETTE TYPE /A082 /*082 SZA CLA / ARE WE MAKING A SYSTEM DISKETTE /A082 /*082 JMP FMTDAY / YES, GO DO DATE FOR SYSTEM DISK /A082 /*082 CDFSYS / NO, DO DATE FOR DOCUMENT DISK /C082 /*082 TAD I (DAMNTH) / GET THE DAY CREATED /A031 /*082 BSW / /A031 /*082 TAD I (MONTH) / /A031 /*082 JMS FMSTF1 / SAVE IN FMTBUF+7 /C042 /*082 CDFSYS / /A031 /*082 TAD I (YEAR) / /A031 /*082 JMP FMTYR / GO STORE THE YEAR VALUE /A082 FMTDAY, TAD (BLDDY^100+BLDMO) / PICK UP DAY-MONTH VALUE /A082 JMS FMSTF1 / SAVE IN FMTBUF+7 /A082 TAD (BLDYR) / PICK UP YEAR VALUE /A082 FMTYR, JMS FMSTF1 / SAVE IN FMTBUF+10 /C082 TAD NODOCS / GET NUMBER OF DOCUMENTS ALLOWED /A031 JMS FMSTF1 / SAVE IN FMTBUF+11 /C042 JMP I FMTDIR /A031 DECIMAL NODOCS, -200 /A031 OCTAL /***********************************************************************/A028 / /A028 / DISPLAYS "FORMAT IN PROGRESS, PLEASE STAND BYE." /A057 / IS CALLED ONLY WHEN FORMATTING /A057 / /A028 /***********************************************************************/A028 FMTRTB, XX /A028 CIFMNU /NO..DISPLAY 'Format in progress /A028 JMS I IOACAL /A028 0 / Please stand bye.' /A028 TEXT1M /A028 0200 /CLEAR SCREEN FROM LINE 3 /A028 1525 /A028 JMP I FMTRTB /A028 FMTRXT, XX / INPUT QUEUE ROUTINE TO RXHAN FMTRX1, CIF 0 / ENQUE / QUBLK1 / QUEUE TO RXHAN / FMTQR2, / CIF 0 / JWAIT / WAIT FOR DONE CLA TAD FMTQBK+RXQCOD SPA CLA JMP I FMTRXT / RETURN WITH NO INCREMENT IF ERROR /C045 TAD FMTQBK+RXQCOD SNA CLA / CHECK FOR DONE JMP FMTQR2 ISZ FMTRXT / SUCESSFUL OPERATION--BUMP RETURN /A045 JMP I FMTRXT / AND GO THERE /A045 / / FMTQRX, 0 / CIF 0 / ENQUE / QUBLK1 / QUEUE TO RXHAN / FMTQR1, / /A018 /C074 JMS GETTIM / SEE IF CHANGE IN TIME CIF 0 / JWAIT / WAIT FOR DONE CLA TAD FMTQBK+RXQCOD SPA CLA JMP I FMTQRX / ERROR--RETURN WITH NO INCRMENT /C045 TAD FMTQBK+RXQCOD SNA CLA / JMP FMTQR1 ISZ FMTQRX / BUMP FOR SUCESSFUL RETURN /A045 JMP I FMTQRX / DONE /FOLLOWING MOVED HERE *********** VER 074 ********** FMTVCD, XX / LOAD THE FUNCTION CODE FOR THE VERIFY PASS /A045 / AS OF THIS WRITING THE HANDLER WILL READ VERIFY / LOGICAL (CODE 6003) ON RX-50 ONLY. THEREFORE, / FOR RX01/02 WE WILL JUST CHECKSUM VERIFY (CODE 4003) AC7776 / SEE IF DESTINATION DRIVE IS RX-50 OR NOT TAD DENSTY SMA CLA / SKIP IF RX01/RX02 /C066 AC2000 / SET THE VERIFY BIT TAD (RXERD+4000 / CODE FOR LOGICAL 12 BIT, RETURN ERRORS JMP I FMTVCD / RETURN THE CORRECT VALUE /-------------------- PAGE /***********************************************************************/A032 / /A032 / CPYIO--READS OR WRITES CPYNOS SECTORS INTO THE FIELD BUFFER /M032 / THESE PARAMETERS MUST BE SET UP BEFORE ENTERING: /M032 / FMTQBK+RXQDRV DRIVE NUMBER /M032 / FMTQBK+RXQFNC FUNCTION CODE /M032 / CPYNOS NUMBER OF SECTORS TO PROCESS /M032 / /M032 /***********************************************************************/A032 CPYIO, XX DCA T2 / INITIALIZE BUFFER ADDRESS TAD CPYNOS / INITALIZE THE SECTOR COUNTER /C021 DCA T1 / SAVE IN A TEMPORARY LOCATION /C032 TAD (CDFMYF+10) / RESET BUFFER FIELD /A067 DCA FMTQBK+RXQBFD / /A067 TAD SECTOR / SAVE SECTOR IN CASE 2ND PASS NECESSRY /A021 DCA SVSECT /A021 CPYLP1, JMS GETTIM /A015 /D067 TAD T2 / INSERT THE BUFFER ADDRESS /D067 TAD CPYLNT /C021 /D067 DCA T2 / STORE NEW ADDRESS TAD T2 / NOW LOAD IN REQUEST BLOCK DCA FMTQBK+RXQBAD /D067 JMS GTSECT / GO GET THE SECTOR NUMBER /A014 TAD SECTOR / /A067 DCA FMTQBK+RXQSEC TAD FMTQBK+RXQSEC / GET BACK SECTOR # /A066 TAD T4 / ADD IN POINTER TO SECT TO BLOCK MAP /A066 DCA T3 / SAVE NEW PTR /A066 JMS CKBLNM /CHECK VALID BLOCK NUMBER /A083 /THIS CHECK TO ALLOW FOR COPYING /A083 /..VOLUME SIZES LESS THAN SIZE OF FLOPPY/A083 JMP CPYSKP /ERR RET..ILLEGAL BLK NUM. SKIP THIS BLOCK/A083 /D070 JMS FMTQRX / QUEUE THE REQUEST /A038 JMS FMTRXT / QUEUE THE REQUEST W/O CHECKING TIME /A070 / AS A TIME CHECK IS DONE AT THE BEGIN /A070 / OF THE SECTOR LOOP (CPYLP1) /A070 JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 CPYSKP, /A083 ISZ T1 / BUMP THE SECTOR COUNTER /C032 JMP CPYBMP / BUMP UP BUFFER, SECTOR ETC. /C067 TAD (CDFMYF+10) / GET ORIGINAL CDF BACK INTO Q-BLK /A067 DCA FMTQBK+RXQBFD / SO OTHER ROUTINES WILL WORK /A067 JMP I CPYIO / NOW ITS SAFE TO LEAVE /C067 CPYBMP, JMS GTSECT / GO GET THE SECTOR NUMBER /M067 CLL CLA /A067 TAD T2 / INSERT THE BUFFER ADDRESS /M067 TAD CPYLNT /C021 /M067 DCA T2 / STORE NEW ADDRESS /M067 SNL / SKIP IF WE WRAPPED THE BUFFER /A067 JMP CPYLP1 / ELSE JUST PROCESS NEXT SECTOR /A067 TAD BMPCDF / WE MUST BUMP BUFFER FIELD UP TWO /A067 TAD FMTQBK+RXQBFD / FIELDS /A067 DCA FMTQBK+RXQBFD / & SAVE IT /A067 JMP CPYLP1 / NOW WE ARE READY TO PROCESS NEXT SECTR/A067 /D067 THIS ROUTINE NO LONGER NEEDED /D067/***********************************************************************/ /D067/ / /D067/ SECADJ--ROUTINE TO ADJUST SECTOR NUMBER. / /D067/ USED BY BACKUP COPY IF INTERLEAVE FACTOR IS EVEN. / /D067/ CALLED BETWEEN PASSES. THE CURRENT SECTOR IS / /D067/ INCREMENTED IF FACTOR IS EVEN, OTHERWISE SECTOR / /D067/ IS UNCHANGED. / /D067/ THIS ROUTINE ADDED ON REVISION /A032 / /D067/ / /D067/***********************************************************************/ /D067 /D067SECADJ, XX / SECTOR ADJUST ROUTINE /D067 TAD FACTOR / GET FACTOR /D067 RAR / PUT LSB IN LINK /D067 SNL CLA / SKIP IF FACTOR IS ODD /D067 ISZ SECTOR / INCREMENT SECTOR IF FACTOR IS EVEN /D067 JMP I SECADJ / JUST RETURN IF FACTOR IS ODD /D067/ /***********************************************************************/ / / / THIS ROUTINE WILL DETERMINE THE NEXT SECTOR NUMBER FOR /A014 / PHYSICAL READS AND WRITES. BEFORE ENTERING IT YOU MUST /A014 / INITIALIZE THE SECTOR NUMBER TO 1, AND INITIALIZE THE INTERLEAVE/A014 / FACTOR TO THE CORRECT VALUE FOR A SINGLE OR DOUBLE DENSITY /A014 / DISKETTE. THE SECTOR NUMBER SHOULD BE AT LABEL "SECTOR" AND /A014 / AND THE INTERLEAVE FACTOR SHOULD GO AT LABEL "FACTOR". /A014 / / /***********************************************************************/ GTSECT, XX / GETS THE NEXT SECTOR FOR COPY IO /A014 TAD SECTOR / GET OLD SECTOR NUMBER /A014 TAD FACTOR / ADD IN INTERLEAVE FACTOR /A014 DCA SECTOR / STORE IT FOR /A014 TAD SECMXK / DETERMINE IF SECTOR NUMBER EXCEEDED /M032 TAD SECTOR / GET THE SECTOR /A014 SNA /A025 JMP GTRTN / IS AT MAX--OK /M032 SPA / SKIP IF OVER MAX /M032 /C069 JMP GTNWRP / ELSE THERE WAS NO WRAP /A069 TAD SECWRP / ADD IN WRAP ADJUSTMENT FACTOR /A069 DCA SECTOR / RESET SECTOR MOD SECMXK + ADJ. FACTOR /A032/C069 GTNWRP, CLA / CLEAR ACCUMULATOR /A032/C069 GTRTN, TAD SECTOR / GET THE SECTOR NUMBER INTO THE AC /A014 JMP I GTSECT / GO BACK /A014 /***********************************************************************/A014 / /A014 / THIS ROUTINE WILL DISPLAY THE MESSAGES THAT ARE REQUIRED TO /A014 / FIND OUT WHAT THE USER WANTS TO DO WITH HIS DISKETTE AFTER /A014 / HE HAS FORMATTED IT. IT ASKS HIM IF HE WANTS TO INITIALIZE IT /A014 / AS A SYSTEM OR DOCUMENT DISKETTE, OR IF HE JUST WANTS TO GET /A014 / OUT BY PRESSING GOLD MENU. /A014 / NOTHING IS PASSED TO IT AND IT PASSES NOTHING BACK.... /A014 / JUST CALL IT WITH A JMS //// /A014 / /A036 / REWRITTEN TO USE GENERAL PURPOSE CONTROL STRINGS /A036 / /A014 /***********************************************************************/A014 CPYASK, XX / RETURN ADDRESS /A014 TAD (0050) / ERASE DATE & TIME BUT NOT TITLE /A057 JMS CLRSCR / GO CLEAR THE SCREEN / CIFMNU / / JMS I IOACAL / / 0 / TEXTG2 / GENERAL PURPOSE CONTROL STRING 2 /C057 1205 / LINE 12 COL 5 / TEXT30 / "PLEASE SELECT HOW THIS DISKETTE... / 1405 / LINE 14 COL 5 / TEXT31 / "TYPE D FOR DOCUMENT OR S ... / 2700 / CURSON PSN FOR OPR RESPONSE / CIFMNU / / JMS I IOACAL / / 0 / TEXTG3 / GENERAL PURPOSE CONTROL STRING 3 / 1455 / LINE 14 COL 55 (CONTINUATION POINT) / TEXT35 / "AND PRESS RETURN" ("AND" WAS "THEN") /C057 2305 / LINE 23 COL 5 / TEXT33 / "OR, " / IFNDEF ITALIAN <2312> / / IFDEF ITALIAN <2305> TEXT15 / "PRESS GOLD MENU TO RECALL THE / 2700 / LINE 27 COL 0--FOR OPR RESP / JMP I CPYASK / RETURN /A014 /***********************************************************************/A014 / /A014 / DTDEN--DETERMINE IF THE DENSITIES OF THE DISKETTES /C060 / IN THE SOURCE DRIVE (DRVSRC) AND THE DESTINATION DRIVE (DRVDST) /C033 / ARE DIFFERENT. IF SO CALL ERROR ROUTINE CPYERR. /C060 / IF NOT, GIVE A SKIP RETURN /C060 / /A014 /***********************************************************************/A014 DTDEN, XX / /A014 DTDEN0, TAD DRVSRC / LOAD SOURCE DRIVE NUMBER /C033 /C035 DCA FMTQBK+RXQDRV / SET DRIVE NUMBER IN Q-BLOCK /A032 JMS FMTDEN / GET DENSITY OF THIS DRIVE TAD DENSTY / LOAD DENSITY DCA DENSRC / SAVE /C074 IFDEF PIRATE < /A034 / NOW SEE IF THE SOURCE DISKETTE IS AN RX-50 /A032 AC7776 / LOAD MINUS TWO TAD DENSRC / ADD DENSITY OF SOURCE DISKETTE/A032 /C074 SZA CLA / SKIP IF RX-50 /A032 JMP DTDEN1 / GO ON IF NOT RX-50 JMS PHYIO / GO READ BOOTSTRAP INTO FMTBUF /A032 RXER12+4000 / CODE FOR PHYSICAL READ 12 BIT MODE /A032 TAD FMTBUF+2 / GET WORD WHICH CONTAINS 'SYSTEM' BIT /A032 AND (20 / MASK OFF ALL OTHER BITS /A032 SZA CLA / SKIP IF NOT A SYSTEM DISKETTE /A032 /C075 JMP XFMT5 / GO MAKE SURE A DISK IS MOUNTED IN DR/M075 > / END IFDEF PIRATE /A034 DTDEN1, TAD DRVDST / LOAD DESTINATION DRIVE NUMBER /A033 DCA FMTQBK+RXQDRV / SET DRIVE NUMBER IN Q-BLOCK /A032 JMS FMTDEN / GET DENSITY OF DESTINATION DRIVE TAD DENSTY / LOAD DEST. DENSITY DCA DENDST /A074 TAD DENDST /DENSITY OF SOURCE DEV /A074 CIA TAD DENSRC / COMPARE TO SOURCE DENSITY /C074 SNA CLA / IF ZERO, THEN THEY ARE EQUAL /A014 /C074 JMP DTDENX / IF NOT, THEN GO ASK HIM TO CHANGE IT /C074 / / MOVED HERE ON VERSION 074 /A028 TAD WINFLG / NO DENSITY MISMATCH ON A V1.5 WINNIE! /A066 SZA CLA / NOT A WINNIE- SKIP & REPORT ERROR /A066 JMP CPDNMX / IS A WINNIE - SET UP MIXED DENS. CPY /A066 AC7777 /A074 TAD FNCODE /IS BACKUP COPY /A075 SZA CLA /A075 JMP DTDENX /NO LET SYSTEM/DOC INIT CONTINUE /A075 JMS CPYERR / DENSITY ERROR. GO ASK FOR DIFFRENT DISKETTE JMS WTFRRS / WAIT FOR THE REPLY /A014 JMP I DTDEN / HE REPLIED RETURN. LET CALLER /A060 / DECIDE WHAT TO DO. /A060 JMP CPYDS2 / HE REPILED GOLD MENU, GO DISPLAY IT /C056 CPDNMX, /C075 JMS CPDSET /SET DENSITY(SPACE WARS MOVE /A075 DTDENX, /A066 ISZ DTDEN / TAKE THE SKIP RETURN /A060 JMP I DTDEN / RETURN /A014 XFMT5, TAD (TEXT2B / " 5 INCH " /A037 DTDEN2, /M074 DCA DTDDS / SET UP SUBSTRING POINTER /A037 CIFMNU / /A032 /M074 JMS I IOACAL / GO DISPLAY /A032 0 / /A032 TEXT50 / "^SSYSTEM DISKETTES CAN NOT BE COPIED"/A032 211 / LINE 2 COL 11 /A032 DTDDS, XX / 8 INCH OR 5 INCH SUBSTRING PTR /A037 JMP FMTERN / GO ASK FOR A GOLD MENU /A032 /-------------------- PAGE ACL=7701 / MQ OP CODE: LOAD AC FROM MQ SWP=7521 / MQ OP CODE: SWAP AC AND MQ /***********************************************************************/ / / / THESE ROUTINES SET UP THE ALLOCATION BLOCKS. / / ENTER WITH STDBSW SET=0 FOR DOC DISKETT INIT / / SET=1 FOR SYSTEM DISKETTE INIT / / WITH DENSTY SET UP FOR THE DESTINATION DRIVE DRVDST / / WITH DSBLKC SET UP FOR NUMBER OF DISK BLOCKS /A035 / USES TABLE (DKSZTB) OF DISK SIZES INDEXED BY DENSTY / / THIS ROUTINE TOTALLY REWRITTEN REVISION /A032 / / / / REV071--MODIFIED SO THAT WHEN LESS THAN EIGHT BLOCKS REMAIN / / ON A SYSTEM DISK AND THE NUMBER OF AVAILABLE BLOCKS ON A / / SYSTEM DISK IS NOT 0 MOD 8 THAT THE MAP WILL BE CORRECT / / (RX02 IS ONLY MEDIA NOT HAVING 0 MOD 8 TOTAL BLOCKS) / / / /***********************************************************************/ STDBL, XX JMS CLBUF / CLEAR THE BUFFER /D035 TAD DSBLKS; CIA; DCA T1-- DSBLKC NOW SET UP IN CALLING ROUTINES /D035 TAD (FMTBUF / GET ADDRESS POINTER / DCA X2 / SAVE ADDR PTR / TAD STDBSW / GET CODE IDENTIFYING DOC (0) OR SYS (1)/ TAD (40 / ADD CODEWHICH IDENTIFIES TYPE OF DISKETTE/ CDFMYF+10 / CHANGE TO BUFFER FIELD /A042 / THIS ROUTINE DOES NOT TAD I /A042 / THEREFORE, WE MAY LEAVE THE DATA FIELD/A042 / SET TO THE BUFFER FIELD UNTIL WE EXIT /A042 DCA I X2 / SAVE IN BUFFER / TAD STDBSW / GET SYSTEM/DOCUMENT SWITCH SZA CLA / SKIP IF DOCUMENT DISKETTE TAD (-DLEND / LOAD NEG NUMBER OF BLOCKS IN SYSTEM TAD DSBLKC / ADD NUMBER OF BLOCKS ON DISK SPA / SKIP IF POSITIVE /A068 CLA / ELSE THERE ARE NONE LEFT! /A068 DCA T2 / SAVE AS NUMBER OF AVAILABLE BLOCKS TAD T2 / GET IT BACK DCA I X2 / SAVE IN BLOCK TAD T2 / GET IT BACK AGAIN DCA I X2 / SAVE IN BLOCK AGAIN / NOW SET THE BITS IN THE ALLOC BLOCK ACCORDING TO THE NUMBER OF BLOCKS / IN THE FILE SYSTEM AND CALCULATE THE #OF ALLOCATION WORDS IN THE MAP / INCLUDING A FINAL ALL ZERO TERMINATOR WORD ISZ X2 / BUMP POINTER OVER #WORDS+1 TAD X2 DCA T3 / BUT SAVE IT ALSO AC0001 / THE EXTRA COUNT DCA T4 / PREPARE TO USE T4 TO COUNT ALLOC WORDS TAD DSBLKC / GET NUMBER OF BLOCKS CIA / MAKE NEGATIVE JMP ALOST1 / COUNT BEFORE DCA /A071 ALOSTL, CLA / NEEDED BY LOOP LOGIC TAD P377 / LOAD CONSTANT DCA I X2 / SAVE IN BLOCK ISZ T4 / COUNT NUMBER OF ALLOC WORDS ACL / GET COUNT ALOST1, /A071 TAD P10 / ADD EIGHT SWP / UPDATE MQ ACL / AND THE AC SPA SNA / SEE IF POSITIVE AND NONZERO YET /C071 JMP ALOSTL / KEEP DOING FULL WORDS CIA / MAKE THE REMAINDER NEGATIVE DCA T2 TAD P377 ALOSTR, AND P177 / TURN OFF A BIT CLL RAL / SHIFT LEFT ISZ T2 / REMAINDER TIMES JMP ALOSTR SZA / IF THE REMAINDER IS NONZERO /A071 ISZ T4 / THEN COUNT ONE MORE ALLOC WORD /A071 DCA I X2 / STORE THE REMAINDER WORD ALOTSD, TAD T4 / GET THE COUNT CIA / NEGATE DCA I T3 / SAVE AT PROPER BUFFER LOCATION / NOW CLEAR THE BITS WHICH CORRESPOND TO BLOCKS ALREADY USED TAD STDBSW / SEE IF SYSTEM OR DOCUMENT SZA CLA / SKIP IF DOCUMENT JMP ALOSYS / GO DO SYSTEM CLEARS JMS ALLOBS / ALLOCATE SPECIFIC BLOCKS /A044 DCSPBK / LIST OF BLOCKS FOR A DOCUMENT DISK JMP STDBLX / DOCUMENT EXIT /C042 ALOSYS, / SYSTEM DISKETTE / THIS ROUTINE WORKS AS LONG AS / DLEND>#ALLOCBLK (255) TAD T3 / GET POINTER TO -(#WORDS+1) DCA X2 / SET UP INDEX REGISTER TAD (-DLEND / GET NEGATIVE NUMBER OF SYSTEM BLOCKS JMP ALOSY2 / /A071 ALOSY1, CLA / CLEAR AC (NECESSARY FROM LOOP POINT) DCA I X2 / CLEAR A BLOCK ACL / GET COUNT ALOSY2, /A071 TAD P10 / ADD EIGHT SWP / UPDATE MQ ACL / AND THE AC SPA SNA / SKIP IF POSITIVE AND NONZERO /C071 JMP ALOSY1 / ELSE LOOP BACK CIA / NO, NEGATE MOD 8 # BITS TO LEAVE ON DCA T1 / SAVE IN A COUNTER ALOSY3, STL RAL / SHIFT LEFT ISZ T1 / COUNT A BIT JMP ALOSY3 / LOOP FOR NEXT BIT AND I X2 / SAVE REMAINDER WORD /C068 MQL / SAVE RESULT FOR A MOMENT /A071 AC7777 / WHILE WE BACK UP THE INDEX REG /A071 TAD X2 / /A071 DCA X2 / /A071 ACL / /A071 DCA I X2 / SAVE RESULT IN MAP /A071 STDBLX, CDFMYF / CHANGE TO THIS FIELD /A042 JMP I STDBL / WE ARE DONE /***********************************************************************/ / / / ALLOBS--ALLOCATE SPECIFIC BLOCKS (ROUTINE ADDED V044) / / THE BLOCKS TO BE ALLOCATED ARE FOUND IN A LIST /C045 / THE LIST IS LOCATED BY THE POINTER AFTER THE CALL, I.E.: /C045 / CALLING SEQUENCE JMS ALLOBS / / BDBKLS / / . / / . / / BDBKLS, BDBK1 / / BDBK2 / / ETC;ETC; / / 7777 / / A MINUS ONE TERMINATES THE LIST / / / /***********************************************************************/ ALLOBS, XX / ALLOCATE SPECIFIC BLOCKS /A044 STA / LOAD MINUS ONE FOR X2 CDFMYF TAD I ALLOBS / PICK UP POINTER TO LIST CDFMYF+10 / CHANGE BACK TO BUFFER FIELD ISZ ALLOBS / ADJUST RETURN ADDRESS DCA X2 / SAVE IN INDEX REG 2 ALLOB0, TAD (FMTBUF+5 / SET UP POINTER TO START OF ALLOCATION MAP DCA T2 CDFMYF / PICK UP NEXT BLOCK NUMBER TAD I X2 CDFMYF+10 / CHANGE BACK TO BUFFER FIELD IAC SNA / SEE IF THE TERMINATOR JMP I ALLOBS / IF SO, RETURN CMA IAC / COMPLEMENT ALLOB2, / FIND CORRECT WORD IN ALLOC BLOCK TAD P10 / ADD 10 SMA / SEE IF THIS BLOCK IS IN THIS WORD JMP ALLOB3 / YES ISZ T2 / NO, BUMP POINTER JMP ALLOB2 / AND GO CHECK NEXT WORD / NOW DETERMINE BIT IN THIS WORD / AC CONTAINS THE BIT NUMBER LESS 4 TO BE CLEARED ALLOB3, CMA DCA T3 / SAVE FOR AN ISZ STA CLL / SET ALL AC BITS & CLEAR THE LINK ALLOB5, RAL / SHIFT THE MASK ISZ T3 JMP ALLOB5 AND I T2 / DO THE WORK--TURN OFF THAT BIT! DCA I T2 / AND SAVE THIS ALLOC WORD STA / DECREMENT BOTH COUNTS TAD I (FMTBUF+2 DCA I (FMTBUF+2 TAD I (FMTBUF+2 DCA I (FMTBUF+3 JMP ALLOB0 / GO DO NEXT BLOCK STDBSW, 0 / DOC/SYS DISKETTE SW 0=DOC /------------------------ PAGE /***********************************************************************/ / / / CKDFSZ--CHECK FOR DIFFERENT DIAMETERS / / USED BY BACKUP COPY. ASSUMES THE FOLLOWING: / / DRIVE NUMBERS ARE 0 TO 7 / / DRIVES 0-3 ARE 5 INCH / / DRIVES 4-7 ARE 8 INCH / / IF DRIVES ARE OF DIFFERENT DIAMETER THEN THE USER / / IS TOLD BACKUP CANNOT BE DONE / / / /***********************************************************************/ CKDFSZ, TAD WINSRC / IS EITHER A WINNIE DEVICE-0=NON WINNIE/C074 TAD WINDST / IS EITHER WINNIE DEVICE---0=NON WINNIE/A074 SZA CLA / NO- SKIP & CONTINUE WITH OLD RTNE. /A066 JMP CKWNSZ / YES- BRANCH TO WINNIE CHECKER /A066 TAD DRVSRC /A066 AND (4) TAD DRVDST AND (4) SNA CLA JMP CONT / DRIVES ARE SAME DIAMETER CKDFER, / ERROR ENTRY POINT FOR WINNIE /A066 JMS CPYERR / CALL ROUTINE WHICH DISPLAYS MESSAGE JMS WTFRRS / WAIT FOR OPR TO TYPE JMP CKDFS2 / RETURN--GO TO A MENU PAGE JMP CPYDS2 / GOLD MENU, RETURN TO MAIN MENU CKDFS2, CIFMNU JMS I MNUCAL / GO BACK TO THE MENU DLMDU8 / AND ASK FOR DRIVE NUMBERS AGAIN / /INPUT CANNOT EXCEED 2000 BLOCKS DURING BACKUP /A074 /OUTPUT CAN BE GREATER THAN INPUT ON DISK VOLUME BUT WILL END UP /A074 /...............WITH UNUSED AREAS ON OUTPUT..... /A074 / CKWNSZ, TAD WINSRC / CHECK FOR SOURCE PROBLEMS /A066 SPA CLA / .GT.= 0 NO PROBLEMS /A066 JMP CKDFER / ERROR - GO PROCESS /A066 TAD WINDST / CHECK FOR DESTINATION PROBLEMS /A066 SMA CLA / .GT.= 0 NO PROBLEMS /A066 /C074 JMP CONT /OUTPUT= O.K. CHECK SRC-DST SIZE /A074 IAC / /A074 TAD WINDST /IS IT UNNASSIGNED /A074 SZA CLA /A074 JMP CONT /NO JUST > 2000 BLOCKS CHK SRC-DST SZE /A074 AC7777 /ERROR OR > MAX BLOCKS /A074 TAD DRVDST / /A074 SZA CLA /DRIVE #1 /A074 JMP CKDFER /NO----ERROR /A074 TAD WINFLG /BITS 9=ONLINE,8=0=WINNIE,7=1=WINNIE /A074 AND (10 /BIT 8--DRIVE 0=WINNIE(VER 2.0) /A074 SZA CLA /IF DRIVE 0=WINNIE...DRIVE 1 MUST BE /A074 JMP CKDFER / ERROR - GO PROCESS /A066 JMP CONT / NO ERRORS - CONTINUE WITH COPY /A066 / ***************************************************************** /A074 / / DSKSZF----SETS UP SIZE OF VOLUME IN TABLE DSKSZT--(DSKSZU) / FOR SPECIAL CASES... / ----AFTER DEBUGGING IT MAY BE POSSIBLE TO DELETE / ----RD50 ENTRY IN TABLE AND HANDLE ALL WINNIE ENTRIES BY DSKSZU /A074 / ***************************************************************** /A074 DSKSZF, 0 /A074 TAD WINDST /A074 TAD (-2 /A074 SZA /2=G.T. 2000 L.T. 4095 BLOCKS /A074 JMP DSKSZG /IS SET TO 2000 /A074 TAD M2000 /SET TO 2000 BLOCKS /A074 JMP DSKSZJ /A074 DSKSZG, /A074 TAD (-2 /A074 SNA CLA /4=SPECIAL CASE....800 BLOCKS /A074 JMP DSKSZM /YES SPECIAL CASE /A074 TAD DSTSZE /DESTINATION SIZE(TRACKS) /A074 CLL RTL /BLOCKS=TRACKS*16 /A074 RTL /A074 CIA /NEGATE IT /A074 DSKSZJ, /A074 DCA DSKSZV /A074 /D079 AC0006 /A074 TAD DSKSZV /A074 DCA DSKSZV+1 /A074 /D079 TAD (12 /A074 TAD DSKSZV /A074 DCA DSKSZV+2 JMP DSKSZP /A074 DSKSZM, /A074 JMS BLKMOV /MOVE PARMS TO VOLUME AREA /A074 DSKSZU-1 /PNTR TO RX50 AREA(SKIPS FIRST ENTRY O.K.)/A074 /A075 DSKSZV-1 /TO VOLUME AREA /A074 -3 /COUNT /A074 CDFMYF /SOURCE FIELD /A074 CDFMYF /DEST FIELD /A074 DSKSZP, /A074 TAD DSTSZE /A074 CIA /NEGATE IT /A074 DCA PARTBM /SET IT /A074 JMP I DSKSZF /A074 DECIMAL M2000, -2000 /A075 OCTAL / /********MOVED HERE VER 074 SPACE WARS ******* / FMSTF1, XX / STUFF AT X1 (CDFMYF+10) /A042 CDFMYF+10 / CHANGE TO BUFFER DATA FIELD DCA I X1 / STUFF IT CDFMYF / CHANGE BACK TO OUR FIELD JMP I FMSTF1 / AND RETURN / /********CLRSCR MOVED HERE VER. 074 **** GUESS WHY ***** / CLRSCA, 0 /CLEAR FROM CURPSN /A074 TAD CURPSN / POSITION TO CLEAR FROM /A056 JMS CLRSCR / CLEAR THE SCREEN /M074 JMP I CLRSCA /RET /A074 /***********************************************************************/M066 / /M066 / CLRSCR--ROUTINE TO CLEAR THE SCREEN FROM A GIVEN POSITION /M066 / AC CONTAINS THE POSTION TO CLEAR THE SCREEN FROM /M066 / /M066 /***********************************************************************/M066 CLRSCR, XX / CLEAR THE SCREEN /A036/M066 DCA CLRSCP / SET THE POSITION TO CLEAR FROM /M074/M066 CIFMNU /M074 JMS I IOACAL /M074 0 /M074 PSCR /M074 CLRSCP, 0 / POSTION TO CLEAR FROM /A056/M074 JMP I CLRSCR /M074 /SETEXT...SETS TEXT STRING POINTER /A074 /ENTERS WITH NEG CODE IN AC AND RETURNS WITH POINTER IN AC /A074 /-1=NOT ASSIGNED -2=AREA TOO SMALL -3=AREA TOO LARGE /A074 / 3=VOL SIZE G.T. OR = 256 BLKS AND L.T. 800 BLOCKS / SETEXT, 0 /A074 SMA /=NEG NUM? /A074 AC7776 /NO..SPECIAL CASE(TOO SMALL) /A074 CIA /SET POS /A074 TAD TBLPTR /POINTER /A074 DCA TBLTMP /SAVE /A074 TAD I TBLTMP /GET STRING POINTER /A074 JMP I SETEXT /A074 / /CHKDST CHECKS SIZE OF DESTINATION DEVICE..... /A074 / IF DEST DEV=RX01/RX02 RETURNS NORMAL /A074 / IF DEST VOLUME IS LESS THAN 800 BLOCKS ERROR JMP /A074 / ELSE RETURNS +1 /A074 CHKDST, 0 /A074 AC7775 /-3...3 CODE = L.T. 800 BLOCKS /A074 TAD WINDST /DEST DEV /A074 SNA CLA /3 CODE? /A074 JMP FMTWER /YES....ERROR VOL TOO SMALL /A074 TAD DENOUT /=RX01/02? /A074 SZA CLA /A074 ISZ CHKDST /NO..IS = RX50 OR WINNIE /A074 JMP I CHKDST /A074 TBLTMP, 0 /A074 TBLPTR, TBLPT1-1 / /A074 TBLPT1, TEXWS1 /AREA NOT ASSIGNED /A074 TBLPT2, TEXWS2 /AREA TOO SMALL /A074 TBLPT3, TEXWS3 /AREA TOO LARGE(NOT HANDLE G.T. 4095) /A074 / /********************TABLE MOVED HERE VER 078 *** SPACE WARS ******* / DEVPTR, DEVDRV /A066 MEDDSK /C074 MEDPTR, DEVARE /C074 MEDVOL /A066 /--------------------- /A066 PAGE /A066 /***********************************************************************/A066 WINCHK, XX / /A066 DCA WINSRC /INITIALIZE..0=NON WINNIE SOURCE /A074 DCA WINDST /INITIALIZE..0=NON WINNIE DEST /A074 DCA SRCSZE /VOLUME SIZE IF WINNIE /A074 DCA DSTSZE /VOLUME SIZE IF WINNIE /A074 JMS SHFDEN /SHIFT DENSITY CODE AND SAVE /A074 DCA WINTRK /INIT TO 0 /A074 CDFSYS / /A066 TAD (34 /WINNIE MASK BITS--BIT 9=ON LINE /C074 /----------------------8=DRV0=WINNIE /A074 /----------------------7=DRV1=WINNIE /A074 AND I RXTYPR / IS WINNIE BIT SET /A066 CDFMYF / BACK TO OUR FIELD FIRST /A066 SNA / YES- SKIP & CONTINUE PROCESS /A066 /C074 JMP WINCHX / NO- JUST EXIT /A066 /D074 AC0001 / /A066 DCA WINFLG / SET WINNIE FLAG /A066 TAD DRVSRC / GET SOURCE DEVICE # /A066 JMS CKASGN / CHECK IF WINNIE AREA & IF BIG ENOUGH /A066 DCA WINSRC / SAVE RESULTS /A066 TAD WINTRK /GET BLOCK COUNT /A074 DCA SRCSZE /SAVE IT /A074 DCA WINTRK /INIT TO 0 /A074 JMS VOLNAM / GET THE SOURCE VOLUME NAME /A066 TAD DRVDST / DO SAME FOR DESTINATION DEVICE /A066 JMS CKASGN / ... /A066 DCA WINDST / ... /A066 TAD WINTRK /GET BLOCK COUNT /A074 DCA DSTSZE /SAVE SOURCE SIZE /A074 CLA IAC /DESTINATION DRIVE /C074 JMS VOLNAM / GET DESTINATION VOLUME NAME /A066 WINCHX, / EXIT RTNE, INITIALIZE SOME PTRS /A066 TAD WINSRC / IF SOURCE IS WINNIE AC-> 'AREA' TEXT /C074 SZA CLA /SET OFFSET IN TABLE /A074 AC0002 / /A074 TAD (DEVPTR-1 / LOAD PTR TO 'DRIVE' TEXT /C074 DCA X0 / /C074 TAD I X0 / /C074 DCA DEVSRC / SAVE POINTER FOR IOACAL'S /A066 TAD I X0 / /C074 DCA MEDSRC / & SAVE PTR FOR IOACAL'S /A066 TAD WINDST / ... /A066 SZA CLA /SET OFFSET IN TABLE /A074 AC0002 /A074 TAD (DEVPTR-1 / NOW REPEAT ABOVE LOGIC FOR DEST. DEV. /C074 DCA X0 / /C074 TAD I X0 / /C074 DCA DEVDST / ... /A066 TAD I X0 / /C074 DCA MEDDST / /A066 TAD (RDMAP-1) / DEFAULT TO RD50 'SECTOR' TO BLOCK /A066 DCA T4 / TRANSLATION TABLE /A066 TAD WINDST / SET UP TEXT STRING POINTERS FOR DISPLY/A066 / OF DRIVE NUMBER VS. VOLUME NAME /A066 SZA CLA /A066 TAD (WINRCV-TEXT1E) / GET OFFSET OF WINNIE PROMPT /A066 TAD (TEXT1E) / ADD IN DRIVE PROMPT /A066 DCA RCVTXT / PUT ADDRESS OF TEXT STRING INTO IOACAL/A066 / SEQUENCE /A066 TAD WINDST /A066 SZA CLA /A066 TAD (RCVNAM-DRVDST) / GET OFFSET OF VOLUME NAME FROM DRIVE #/A066 TAD (DRVDST) / ADD IN ADDRESS OF DRIVE # /A066 DCA RCVID / PUT INTO IOACAL SEQUENCE /A066 / NOW DO THE SAME FOR THE SOURCE!! /A066 TAD WINSRC / SET UP TEXT STRING POINTERS FOR DISPLY/A066 / OF DRIVE NUMBER VS. VOLUME NAME /A066 SZA CLA /A066 TAD (WINCPY-TEXT1H) / GET OFFSET OF WINNIE PROMPT /A066 TAD (TEXT1H) / ADD IN DRIVE PROMPT /A066 DCA CPYTXT / PUT ADDRESS OF TEXT STRING INTO IOACAL/A066 / SEQUENCE /A066 TAD WINSRC /A066 SZA CLA /A066 TAD (CPYNAM-DRVSRC) / GET OFFSET OF VOLUME NAME FROM DRIVE #/A066 TAD (DRVSRC) / ADD IN ADDRESS OF DRIVE # /A066 DCA CPYID / PUT INTO IOACAL SEQUENCE /A066 JMP I WINCHK / /A066 /***********************************************************************/M066 / /M066 / TIMMSG--CLEARS THE TIME COUNTER AND PRINTS /M066 / "ELAPSED TIME CLOCK 0:00" ON SCREEN /M066 / /M066 /***********************************************************************/M066 TIMMSG, XX CLA CDFMNU / CLEAR THE TIME COUNTER DCA I (CLKCHG) CDFMYF / DCA SEC / CLEAR THE SECOND COUNTER DCA MIN / AND THE MINUTES / CIFMNU JMS I IOACAL / PRINT "ELAPSED TIME CLOCK 0:00" 0 / DEFAULT OUTPUT ROUTINE TEXT12 / ADDRESS OF STRING IFNDEF ITALIAN <0050> / CURSOR POSITION TO CLEAR FROM /C057 IFDEF ITALIAN <0053> / (LEAVE MENU NAME BUT CLEAR DATE/TM /A057 / IFDEF ENGLSH < 1323 > / CURSOR POSITION FOR ENGLISH /A009 IFDEF ITALIAN < 1327 > / CURSOR POSITION FOR ITALIAN /A009 IFDEF V30NOR <1335> IFDEF V30SWE <1335> / JMP I TIMMSG / THIS IS THE ERROR MESSAGE HANDLER /M066 / /M066 / THIS ROUTINE WILL WAIT FOR A GOLD MENU OR ACR /M066 / RESPONSE FROM THE KEYBOARD. ALL OTHER CHARACTERS WILL RING THE BELL/M066 / CALLING SEQUENCE: /A036/M066 / JMS WTFRRS /A036/M066 / HERE / RETURNS HERE IF RETURN PRESSED /A036/M066 / HERE+1 / RETURNS HERE IF GOLD-MENU PRESSED /A036/M066 / V036 CODE DELETED WHICH CHECKS SYSTEM DISK ID /A036/M066 / WTFRRS, XX / WAIT FOR RIGHT RESPONSE CLA JMP WTFRL1 / SEE IF A CHARACTER IS TYPED FROM THE KEYBOARD CIF 0 / JWAIT WTFRL1, CIF 0 / XLTIN JMP .-4 / IF NOTHING TYPED THEN WAIT / TAD (-EDMENU) / CHECK FOR A GOLD MENU SNA / JMP WTFRGM TAD (EDMENU-EDNWLN) / NOW FOF A CR SNA CLA / JMP I WTFRRS / /C017 JMS CPYWFT / BELL REPLY / /D074 CLA JMP WTFRL1 WTFRGM, / GOLD MENU WAS TYPED /D036 JMP CPYEXT / NO /A017/C033 ISZ WTFRRS / SKIP RETURN /M031 JMP I WTFRRS /M031 /-------------------- PAGE /***********************************************************************/A032 FMTINI, XX / DOC & SYS INITIALIZE ROUTINE /A032 DCA DRVSRC / MAKE SURE SOURCE DRIVE IS SYSTEM /A037 / (FOR FIRMWARE, TRACK ZERO ETC) /A037 /D074 TAD DRVDST / SET AC TO DOCUMENT DRIVE NUMBER /C032 /D074 DCA FMTQBK+RXQDRV /D074 JMS FMTDEN / GO GET DENSITY OF DESTINATION DRIVE /A032 JMS DTDEN /GET DENSITY OF SOURCE AND DEST. /A074 NOP /IGNORE DIFFERENT MESSAGE /A074 JMS TIMMSG / CLR SCREEN & PUT UP TIME MESSAGE /M052 TAD DENDST /DESTINATION FACTOR IN DOC,SYS INIT /A075 JMS DSKSZE / DETERMINE DISK BLOCK VALUES /A035 JMS SHFDEN /SET DENSITY BITS /A074 JMS CPBOOT / GO COPY BOOT TO FMTBUF /A032 JMP I FMTINI / RETURN /A032 /********* CPYWFT MOVED HERE VER 074 ****************** /***********************************************************************/A032 / CPYWFT, 0 / PRINT BELL HERE TO SAVE SPACE TAD (7) / RING THE BELL IF BAD CHARACTER JMP .+3 CIF 0 / JWAIT CIF 0 / TTYOU JMP .-4 JMP I CPYWFT / RETURN / /***********************************************************************/A032 CPBOOT, XX / COPY BOOT ROUTINE /A032 JMS CLBUF / CLEAR FMTBUF /A032 AC7777 / LOAD MINUS TWO /C075 TAD DENOUT / DETERMINE IF RX50 OR NOT /C075 SZA / SKIP IF RX50 / HOLD AC FOR WINNIE CHK /A032/C066 JMP CP0102 / GO COPY RX01/02 BOOT /A032 JMS BLKMOV / GO COPY RX50 BOOT INTO FMTBUF /A032 RX50BEG-1 / SOURCE ADDRESS--FIRST SECTION /A032 FMTBUF-1 / DESTINATION ADDR /A032 -R5LOCS / NUMBER OF CHARACTERS /A032 CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 JMS BLKMOV / DO SECOND SECTION /A032 RX50MID-1 / SOURCE /A032 FMTBUF+166-1 / DESTINATION /A032 RX50MID-R5W2ND / NEG NUMBER OF CHARACTERS /A032 CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 JMS BLKMOV / DO THIRD SECTION /A032 R5W2ND-1 / SOURCE /A032 FMTBUF+361-1 / DESTINATION /A032 -5 / NEG NUMBER OF CHARACTERS /A032 CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 JMP I CPBOOT / RETURN /A032 CP0102, / COPY RX01/02 BOOT /A032 / 1ST!!- IS IT A WINNIE?? /A066 SMA CLA / NO- SKIP /A066 JMP CPWINC / YES- GO COPY RD50 BOOT /A066 JMS BLKMOV / GO COPY RX0102 BOOT INTO FMTBUF /A032 BT0102-1 / SOURCE ADDRESS--FIRST SECTION /A032 FMTBUF-1 / DESTINATION ADDR /A032 -100 / NUMBER OF CHARACTERS /A032 CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 JMS BLKMOV / DO SECOND SECTION /A032 RX01MID-1 / SOURCE /A032 FMTBUF+100-1 / DESTINATION /A032 -175 / NEG NUMBER OF CHARACTERS /A032 CDFMYF / SOURCE FIELD /A057 CDFMYF+10 / DESTINATION FIELD /A057 JMP I CPBOOT / RETURN /A032 CPWINC, / COPY RD50 BOOT INTO FMTBUF (STUB) /A074 JMS BLKMOV / GO COPY WINNIE BOOT INTO FMTBUF /A074 WINBEG-1 / SOURCE ADDRESS--FIRST SECTION /A074 FMTBUF-1 / DESTINATION ADDR /A074 -WNLOCS / NUMBER OF CHARACTERS /A074 CDFMYF / SOURCE FIELD /A074 CDFMYF+10 / DESTINATION FIELD /A074 JMP I CPBOOT /A074 /***********************************************************************/ / / / FMTERR--ERROR ROUTINE THAT HANDLES DISK I/O ERROR MESSAGES / / CPYDSK USES THE FOLLOWING FMTQBK+RXQFNC FUNCTION CODES: /A032 / RXEPR+4000 4001 READ PHYS 8-BIT /A032 / RXEPW+4000 4002 WRIT PHYS 8-BIT /A032 / RXERD+4000 4003 READ LOGL /A032 / RXEWT+4000 4004 WRIT LOGL /A032 / RXER12+4000 4013 READ PHYS 12-BIT /A032 / RXEW12+4000 4014 WRIT PHYS 12-BIT /A032 / RXEFMS+4000 4015 FORMAT SINGLE DENSITY /A032 / RXEFMD+4000 4016 FORMAT DOUBLE DENSITY /A032 / /A032 MODIFIED TO INCLUDE DETECTING ERRORS / / OCCURRING DURING CODES 4013 AND 4014 / / / /***********************************************************************/ FMTERR, XX TAD FMTQBK+RXQDRV / GET DRIVE NUMBER /A032 DCA BDDRV1 / AND PASS TO IOACAL /A032 / TAD (FNCER) / SET THE DEFAULT FUNCTION ADDRESS /C028 DCA BDFNC / IT IS SET FOR READING TAD FMTQBK+RXQFNC / SEE IF IT IS READING AND (7 / STRIP TO ONLY 3 BITS /M032 TAD (-2) / IF A 2 THEN IT IS A WRITE /M032 SNA / JMP INCONE / GO BUMP ONCE FOR WRITE /A028 TAD (-2) / CHECK FOR A LOGICAL OR PHYS-12 WRITE /M032 SNA /C028 JMP INCONE / GO BUMP ONCE FOR WRITE /A028 SPA CLA />=0 =FORMAT /A028 JMP INCZER /NO INC FOR READ /A028 ISZ BDFNC / BUMP MESSAGE POINTER /A028 INCONE, ISZ BDFNC / BUMP MESSAGE POINTER /A028 / INCZER, TAD (DEVER) / DEFAULT DEVICE ("DRIVE") /C028/C066 DCA BDDEV / /A066 TAD FNCER / IF READ THEN ERROR ON THE SOURCE DEV /A066 CIA / ELSE ERROR ON DEST! /A066 TAD BDFNC / IF BDFNC=FNCER THEN SOURCE ERROR /A066 SZA CLA / YES- SKIP /A066 JMP TSTDST / NO- ITS A DEST. ERROR /A066 TAD WINSRC / IS SOURCE A WINNIE?? /A066 SKP / /A066 TSTDST, TAD WINDST / - OR DESTINATION A WINNIE?? /A066 SZA CLA / NO- SKIP /A066 ISZ BDDEV / YES- BUMP POINTER /A066 CIFMNU / /A066 JMS I IOACAL / 0 / THE ERROR MESSAGE FMTERM 1512 / POSITION ON THE SCREEN ROW 15 COL.12 /C059 / THIS POSITION LEAVES THE ELAPSED TIME MSG ON SCRN BDDEV, 0 / THE DEVICE /A066 BDDRV1, 0 / THE DRIVE BDFNC, 0 / THE ADDRESS OF THE MESSAGE READ/WRITE / JMP I FMTERR / RETURN FNCER, REDFNC / THE ADDRESS OF THE STRING THAT SAYS READ WTFNC / THE ADDRESS OF THE WRITE MESSAGE STRING FMTFNC / THE ADDRESS OF FORMAT MESSAGE STRING /A028 DEVER, DEVDRV / " " " STRING THAT SAYS DRIVE /A066 DEVARE / " " " " " " AREA /A066 / / SHFDEN, 0 /A074 TAD DENSRC /INPUT DENSITY /A074 CLL RAR /SHIFT OUT RX02 DD BIT IF SET /A074 DCA DENIN /INPUT DENSITY 0=RX01-02,1=RX50,2=WINNIE/A074 TAD DENDST /OUTPUT DENSITY /A074 /C075 CLL RAR /SHIFT OUT RX02 DD BIT IF SET /A074 DCA DENOUT /OUTPUT DENSITY 0=RX01-02,1=RX50,2=WINNIE/A074 JMP I SHFDEN /A074 / DENIN, 0 /INPUT DENSITY 0=RX01-02 1=RX50 2=WINNIE/A074 DENOUT, 0 /OUTPUT DENSITY 0=RX01-02 1=RX50 2=WINNIE/A074 / / /****** FOLLOWING DELETED VER 074 ******* /***********************************************************************/ / / / SKIFS5--SKIP IF DISK IS 5 OR WINNIE INCH / / SKIFD5-- " / / TYPICALLY USED AT RUN TIME TO DETERMINE IF / / RUNNING ON A DECMATE-I or DECMATE-II / /CALL = JMS SKIFS5 / / DENST0/DENSTY /POINTER TO DENSITY OF DISK CHKED/ / RET8 /RETURN IF 8" DRIVE / / RET50 /RET IF RX50 / / RETWIN /RET IF WINNIE / / / /***********************************************************************/ /D074SKIFD5, / /D074SKIFS5, XX /D074 TAD I SKIFS5 /POINTER TO DENSITY CODE /A074 /D074 DCA SKIFST /A074 /D074 ISZ SKIFS5 /RET /A074 /D074 AC7776 / LOAD MINUS TWO /D074 TAD I SKIFST /GET DENSITY /A074 /D074 SNA / SKIP IF RX01/RX02 WINNIE /C074 /D074 JMP ISAX50 /A074 /D074 SPA CLA /=WINNIE? /A052 /D074 JMP I SKIFS5 /NO.. =8" RX01/RX02 /A074 /D074 ISZ SKIFS5 / ELSE BUMP RETURN ADDRESS FOR WINNIE /A074 /D074ISAX50, ISZ SKIFS5 /WINNIE /A074 /D074 JMP I SKIFS5 / AND RETURN /D074SKIFST, 0 /TEMP /A074 /---------------------- /A066 PAGE /A066 /***********************************************************************/A032 / BLKMOV, XX / BLOCK MOVE ROUTINE /A032 / ADDED GENERAL CROSS FIELD ABILITY /A057 TAD I BLKMOV / GET SOURCE OPERAND / DCA X1 / ISZ BLKMOV / TAD I BLKMOV / GET DESTINATION ADDRESS / DCA X2 / ISZ BLKMOV TAD I BLKMOV / GET NUMBER OF WORDS TO MOVE / DCA T1 / ISZ BLKMOV TAD I BLKMOV / GET SOURCE FIELD /A057 DCA BLKMV1 / AND STUFF IT /A057 ISZ BLKMOV / /A057 TAD I BLKMOV / GET DESTINATION FIELD /A057 DCA BLKMV2 / AND STUFF IT /A057 ISZ BLKMOV / /A057 BLKMV1, XX / CDF SOURCE FIELD /C057 TAD I X1 / DO THE WORK / BLKMV2, XX / CDF DEST FIELD /C057 DCA I X2 / ISZ T1 / JMP BLKMV1 / CDFMYF / RESTORE OUR FIELD /A057 JMP I BLKMOV / RETURN / /***********************************************************************/A019 / /A019 / CONTROL IS PASSED HERE FROM FMTQRT WHENEVER THE DRIVE /C038 / DOES NOT HAVE A /C038 / DISKETTE READY TO BE READ IN THE DRIVE. THIS ROUTINE DISPLAYS /A019 / AN ERROR MESSAGE ASKING THE USER TO INSERT A DISKETTE OR /A019 / TO PRES GOLD MENU TO RETURM TO MAIN MENU /A019 / /A019 /***********************************************************************/A019 DRVPRB, /A019 TAD FMTQBK+RXQSPC / GET THE ERROR RETURN CODE /A019 AND (2400 / IF ERROR CODE BITS 1-3 =5 NOT READY ERROR/C020/C028 CIA / NEG /A028 TAD (2400 /A028 SZA CLA / 0=DRIVE NOT READY ON GET DEN/A019 /C028 JMP CPYER / MUST BE SOME OTHEER ERROR, GO GIVE MESSAGE /A019 JMS DRVERR / GO DISPLAY THE MESSAGES /A019 JMS WTFRRS / GO SEE WHAT HE TYPED IN /A019 JMP FMTRTA / HE TYPED RETURN (PUT A DISKETTE IN) /C028 JMP CPYDS2 / HE TYPED GOLD MENU /A019 CPYER, JMS FMTERR /A019 JMP CPYEXT / EXIT LIKE IT WAS COMPLETE /A019 FMTRTA, /CONTROL RETURNS HERE AFTER OPERATOR INSERTS DISKETTE /M031 /(AFTER HE FORGOT TO PUT ONE IN) /A031 / THE FOLLOWING LINE WAS CAUSING "ELAPSED TIME CLOCK 0:00" /A054 / TO FLASH ON THE SCREEN IF BOTH DOORS WERE LEFT OPEN, /A054 / TYPE COPY,...YOU NEED A DISK IN DRIVE (SOURCE), /A054 / CLOSE DOOR (SOURCE), HIT RETURN, SEE THE FLASH... /A054 / REPLACED BY "YOU NEED A DISK IN DRIVE (DEST) /A054 / ...CARL GERSTLE BUG #132 PRIORITY 5 (COSMETIC) /A054 /D054 JMS TIMMSG / GO ERASE SCREEN AND PUT TIME MESSAGE OUT /A019 JMP FMTRX1 / GO TRY TO READ AGAIN /C028 / THIS IS THE LIST OF BLOCKS TO ALLOCATE ON A DOCUMENT DISK /M066 DCSPBK, 0 / WPS LOADER /M066 1 / OS8-DIRECTORY BLOCK /M066 DLDIR / HOME BLOCK /M066 EMESBK / ERROR MESSAGE BLOCK /M066 DLALOC / ALLOCATION BLOCK /M066 7777 / TERMINATOR /M066 /***********************************************************************/A031/M066 / CLBUF, XX / ROUTINE TO WRITE COSCNT IN BEGINNING /A031/M066 / OF FMTBUF AND CLEAR THE REST /A031/M066 TAD (-400) / SET THE COUNTER FOR THE BUFFER /M066 DCA T1 /M066 TAD (FMTBUF-1) / SET THE ADDRESS OF THE BUFFER /M066 DCA X2 /M066 TAD COSKNT / GET COS310 CONSTANT /A031/M066 CDFMYF+10 / CHANGE TO BUFFER FIELD /A042/M066 CLALUP, DCA I X2 / CLEAR THE NEXT LOCATION /M066 ISZ T1 / INCREMENT THE COUNTER /M066 JMP CLALUP /M066 CDFMYF / CHANGE TO THIS FIELD /A042/M066 JMP I CLBUF /M066 /***********************************************************************//M066 / //M066 / WCBUF--WORST CASE BUFFER (ADDED V046) //M066 / ROUTINE TO FILL THE BUFFER WITH THE WORST CASE //M066 / PATTERN FOR THE DATA RECOVERY FROM THE DISK //M066 / THE MODULATION TECHNIQUE IS MFM (WD1793 F.D.C) //M066 / THE WORST CASE PATTERN IS THE FOLLOWING TRIO OF BITS //M066 / REPEATED AD INFINITUM: 001 //M066 / FOR NOW WE WRITE IN 12 BIT MODE SO LETS JUST USE //M066 / THE 12 BIT PATTERN (5111) //M066 / //M066 /***********************************************************************//M066 WCBUF, XX /M066 TAD (FMTBUF-1) / SET THE ADDRESS OF THE BUFFER /M066/M078 DCA X2 /M066/M078 TAD (-20 /SET TO DO FIELD CLEAR /A078 DCA WCOUNT /SET UP COUNT /A078 WCBUF1, TAD M377 / SET THE COUNTER /C078 DCA T1 /CLEAR FIELD /M066 /C078 TAD COSKNT / GET COS310 CONSTANT /M066 CDFMYF+10 / CHANGE TO BUFFER FIELD /M066 DCA I X2 / WRITE COSCNT INT LOC 0, 0000 IN LOC 1 /M066 WCBUF2, DCA I X2 / PUT IN BUFFER /M066 TAD (5111) / LOAD QUASI WORST PATTERN /M066 ISZ T1 / INCREMENT THE COUNTER /M066 JMP WCBUF2 / NOT DONE YET /M066 CLA / GET RID OF LAST PATTERN WORD /M079 ISZ WCOUNT /FIELD DONE /A078 JMP WCBUF1 /SET NEXT /A078 CDFMYF / DONE, CHANGE BACK TO OUR FIELD /M066 JMP I WCBUF /M066 WCOUNT, -20 /NUM BLOCKS IN FIELD /A078 /***********************************************************************//M066 / //M066 / FMTNOS--TELL USER THAT 8" SYSTEM DISKS CANNOT BE MADE //M066 / AND THAT HE MUST HIT RETURN TO RETURN TO THE //M066 / MAINTENANCE MENU //M066 / //M066 /***********************************************************************//M066 FMTNOS, /A053/M066 CIFMNU /M066 JMS I IOACAL /M066 0 /M066 TEXT50 /_S SYSTEM DISKETTES CANNOT BE MADE /M066 211 /M066 TEXT2A /8 INCH (SUSBSTRING) /M066 CIFMNU JMS I IOACAL /M066 0 /M066 TEXTG1 /_P_S_P /M066 1012 /POSITION /M066 TEXT26 /PRESS RETURN TO CONTINUE /M066 2700 /POSITION AFTER /M066 FMTNO1, JMS WTFRRS /WAIT FOR OPR TO TYPE JMP FMTNO2 /RETURN--GO RETURN TO A MENU PAGE /M066 JMP FMTNO1 /GOLD-MENU, MAKE HE/SHE TYPE RETURN /M066 FMTNO2, CIFMNU /M066 JMS I MNUCAL /RETURN TO MENU PAGE /M066 DLMDU1 /START AGAIN WITH MAINTENANCE MENU /M066 CPYNAM, ZBLOCK 11 / ASCII STRING CONTAINING SOURCE VOLUME NAME/A066 RCVNAM, ZBLOCK 11 / SAME AS ABOVE FOR DESTINATION /A066 / PUT HERE FOR SPACE REASONS /A066 /*************MOVED HERE SPACE REASONS VER 074 ********************/M074 /D078BLKADJ, XX / ADJUST BLOCK NUMBER /A044 / IF BLOCK NUMBER IS DLALOC (ALLOCATION BLOCK) /A044 / THEN SKIP IT (OTHERWISE WHEN WE VERIFY IT /A044 / WON'T MATCH THE SYSTEM DISK /A044 /D078 TAD FMTQBK+RXQBLK / GET THE BLOCK NUMBER /D078 TAD M377 /D078 SNA /D078 ISZ FMTQBK+RXQBLK / SKIP ALLOCATION BLOCK /D078 SNA CLA /D078 ISZ FMTSYC / COUNT THIS BLOCK /D078 JMP I BLKADJ / RETURN /--------------- PAGE /***********************************************************************/ / / / FMTSYS -- INITIALIZE SYSTEM DISKETTE / / THIS ROUTINE IS DESIGNED TO INITIALIZE / / SYSTEM DISKETTES FOR THE FOLLOWING CASES. / / THERE IS NO CONDITIONALIZED CODE SO THAT THE ROUTINE / / WILL RUN ON EITHER DM-I or DM-II DEPENDING WHAT IS / / DETERMINED AT RUN TIME ABOUT THE SYSTEM AND DESTINATION / / DISKETTES / / / / CASES: 8" TO 8" DECmate-I RX01/RX02 / / 5" to 5" DECmate-II RX50 / / 8" to 5" DECmate-II development--first 5" disk / / 5" to 8" DECmate-II not permitted / / / /***********************************************************************/ FMTSYS, / INITIALIZE SYSTEM DISKETTE /A032 JMS FMTINI / GO JMS TIMMSG & COPY BOOT TO FMTBUF /A032 / 8 INCH SYSTEM DISKETTES CANNOT BE MADE/A037 / FROM 5 INCH SYSTEM DISKETTES /A037 TAD DENIN /C074 SNA CLA /=RX01/02? /C082 JMP FMTSD8 / SYSTEM DISK IS 8" /A037 IFDEF PIRATE < / IF SYSTEM DRIVE IS 5" /A034 JMP XFMT5 / GO TELL OPR NO COPY CAN BE MADE /A032 > / END IFDEF PIRATE /A034 JMS CHKDST /CHECK DEST..IF L.T. 800 BLOCKS =ERROR /A074 /RETURNS HERE IF RX01/02 ELSE RET+1 /A074 JMP XFMT8 /NO FORMAT FROM 5 TO 8 /C074 FMTD50, /WINNIE OR RX50 /A074 FMTDD5, / 5" DESTINATION DISK--WRITE BOOT /A042 JMS WR50BT / GO WRITE RX50 BOOT /A042 1 / WITH DOC/SYSTEM SET TO SYSTEM /A042 DCA DRVSRC / SOURCE DRIVE IS SYSTEM DRIVE /A035 TAD DENIN /INPUT DEN /C074 SNA /=RX01/02? /C082 JMP FMTSY1 / IF 8 TO 5 DON'T COPY 0, 78, OR 79 /A044 CLL RAR /A074 SZA CLA /RX50? /A074 JMP FMTSD7 / NO -WINNIE SOURCE RET /A074 TAD DENOUT /A074 CLL RAR /A074 SZA CLA /RX50? /A074 JMP FMTSD7 / NO -WINNIE SOURCE RET /A074 / COPY FIRMARE:: /A035 AC0003 / COPY RX50 FIRMWARE /A035 DCA DENSTY / INDEX 4TH LINE OF TABLE PARTBL /A035 JMS SETPAR / SET PARAMETERS /A035 JMS CPYTKS / COPY THESE TWO TRACKS /A035 / COPY TRACK ZERO (SETUP, ETC.) /A044 ISZ DENSTY / INDEX TRACK ZERO IN SETPAR TABLE/A037 /C074 / MAKE IT 5 AS 4 IS USED BY WINNIE/A066 /C074 ISZ DENSTY /(THE 6TH LINE IN TABLE PARTBL)/A037/C066/C074 JMS SETPAR / SET UP PARAMETERS /A050 JMS CPYTKS / COPY TRACK ZERO /A037 FMTSD7, /A074 JMS FMTDEN / RESTORE DENSITY TO DENSITY OF DRVDST /A037 JMP FMTSY1 / AND CONTINUE BELOW /A042 FMTSD8, / SYSTEM DISK IS 8" /A042 TAD DENOUT /OUTPUT DEN /A074 SZA CLA /=RX01/02? /A082 JMP FMTDD5 / DESTINATION DISK IS 5" OR WINNIE /A042 FMTSD9, /A074 JMS WRBOOT / WRITE 8" BOOTSTRAP /A042 / FMTSY1, /C078 JMS FMTSY / GO DO THE WRITE PASS /A044 /D078 JMS FMTVCD / GO LOAD THE CODE FOR THE VERIFY PASS /A045 /D078 JMS FMTSY / GO DO THE VERIFY PASS /A044 TAD (200 /BOOTABLE WINNIE BIT /A074 JMS FMTWN /IF WINNIE--SET VOLUME TO BOOTABLE /A074 JMP FMTERN / GO TELL USER WE ARE DONE /A044 FMTSY, XX / WRITE OR READ/VERIFY SYSTEM DISKETTE /A044 /D078 DCA CPSDFN / LOAD THE FUNCTION (WRITE OR VERIFY /A044 AC0003 / DCA RXQBLK+FMTQBK / START WITH BLOCK 3 TAD (-7 /SET FIRST PROCESS TO ALLIGN ON TRACK BNDRY/A078 DCA FMTQBK+RXQRS1 /A078 FMTSY2, TAD (-10 /SET ERROR RETRY COUNT /A078 DCA FMTCNT /RETRY COUNT /A078 FMTSY3, /C074 /C078 TAD (RXERD+4000 / READ BLOCKS DCA FMTQBK+RXQFNC DCA FMTQBK+RXQDRV / SET TO SYSTEM DRIVE /D078 DCA FMTSYC / CLEAR COUNTER DCA FMTQBK+RXQBAD / SET BUFFER ADDRESS /C078 TAD (-DLSEND /LAST SYSTEM BLOCK TO BE COPPIED /A078 JMS FMTSET /SET BLOCK COUNT /A078 JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 /D078 ISZ FMTQBK+RXQBLK / BUMP BLOCK NUMBER /D078 ISZ FMTSYC / AND COUNTER /D078 JMS BLKADJ / GO SEE IF MUST ADJUST BLOCK NO. /A044 /D078 TAD FMTQBK+RXQBLK / TEST FOR END /D078 TAD (-DLSEND) / /M063 /D078 SNA CLA / /D078 JMP FMTSY4 / JUMP IF SO /D078 TAD FMTQBK+RXQBAD / ADJUST BUFFER ADDRESS /D078 TAD (400) /D078 SZA / /D078 JMP FMTSY3 / LOOP IF NOT YET TIME FOR WRITE FMTSY4, TAD (RXEWT+4000 / LOAD CODE FOR LOGICAL BIT WRITE /A078 DCA FMTQBK+RXQFNC TAD DRVDST / SET TO DESTINATION DRIVE /C032 DCA FMTQBK+RXQDRV /D078 TAD FMTSYC / SET LOOP COUNTER /D078 CIA /D078 DCA FMTSYC /D078 TAD FMTSYC / ADJUST BLOCK NUMBER /D078 TAD FMTQBK+RXQBLK /D078 DCA FMTQBK+RXQBLK /D078 DCA FMTQBK+RXQBAD / INIT BUFFER ADDRESS FMTSY5, JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 / / /D078 TAD FMTQBK+RXQBAD / ADJUST BUFFER ADDRESS /D078 TAD (400) /D078 DCA FMTQBK+RXQBAD / /D078 ISZ FMTQBK+RXQBLK / INCR BLOCK NUMBER /D078 JMS BLKADJ / GO SEE IF MUST ADJUST BLOCK NUMBER /A044 /D078 ISZ FMTSYC / TEST LOOP COUNTER /D078 JMP FMTSY5 / LOOP IF MORE TO WRITE / JMS FMTVCD / GO LOAD THE CODE FOR THE VERIFY PASS /A078 DCA FMTQBK+RXQFNC /SET READ OR READ VERIFY COMMAND /A078 JMS FMTQRX /DO IT /A078 SKP /ERROR CHECK RETRY COUNT /A078 JMP FMTSY6 /CONT /A078 FMTRTR, /RETRY ROUTINE /A078 ISZ FMTCNT /DONE? /A078 JMP FMTSY3 /NO--RETRY READ INPUT /A078 JMP FMTER /CAN'T GET PAST ERROR /A078 FMTSY6, TAD FMTQBK+RXQRS1 /GET NUM BLOCKS READ /A078 CIA /SET POS /A078 TAD FMTQBK+RXQBLK /START BLOCK NUMBER /A078 DCA FMTQBK+RXQBLK /SET NEXT BLOCK NUMBER /A078 TAD (-DLSEND /LAST BLOCK TO BE COPIED /A078 TAD FMTQBK+RXQBLK /LAST READ /A078 SPA CLA /IS IT END? /A078 JMP FMTSY3 /NO /A078 / TAD DSBLKS / NEG NO OF SYSTEM BLOCKS /A035 DCA DSBLKC / IS NO OF LAST BLOCK TO CLEAR /A035 JMS CLABLK / CLEAR REMAINING BLOCKS / JMS RSTBLK /RESET BLK CNT AND FNC CODE TO WRITE VFY/A078 AC0001 / DCA FMTQBK+RXQBLK / WRITE BLOCK ONE JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 / AC0001 / SET AC TO INDICATE SYSTEM DISKETTE /M031 DCA STDBSW / AND WRITE IN THIS FLAG LOCATION /M031 TAD DSBLKS / GET NEG NO SYS BLKS /A035 CIA / POSITIVATE /A035 DCA DSBLKC / PASS TO STDBL /A035 JMS FMTHAB / GO DO DIRECTORY AND ALLOC BLOCKS /A045 JMP I FMTSY / RETURN /C044 XFMT8, TAD (TEXT2A / 8 INCH SUBSTRING POINTER /A037 /D074 DCA DTDDS / SET IT FOR FOR THE MESSAGE /A037 JMP DTDEN2 / GO PUT OUT THE MESSAGE /A037 FMTCNT, -10 /RETRY COUNT /A078 FMTSYC, 0 /-------------------- PAGE / THIS WILL CLEAR THE BUFFER FOR THE RXHAN REQUEST AND THEN IT WILL / CLEAR THE REMAINING BLOCKS ON THE DISKETTE BEING WRITTEN / CLABLK, XX JMS WCBUF / WRITE THE WORST CASE PATTERN /C046 /D078 TAD CPSDFN / LOAD FUNCTION (WRITE OR READ/VFY) /A044 CLALP1, /C078 TAD (-10 /RETRY COUNT /A078 DCA CLACNT /SET IT /A078 CLALP2, TAD (RXEWT+4000 /READ COMMAND /A078 DCA FMTQBK+RXQFNC / SET IT AS THE Q-BLOCK FUNCTION CODE /A031 /D078 TAD (FMTBUF) / PUT IT BACK TO ORIGINAL BUFFER /D078 DCA FMTQBK+RXQBAD / TAD DSBLKC /LAST BLOCK AVAILABLE /A078 JMS FMTSET /SET BLOCK COUNT /A078 JMS FMTQRX / DO THE NEXT BLOCK JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 /D078 ISZ FMTQBK+RXQBLK / INCREMENT THE BLOCK NUMBER /D078 AC7776 / LOAD MINUS DLDIR /A044 /D078 TAD FMTQBK+RXQBLK / ADD BLOCK NUMBER /A044 /D078 SNA / SKIP THE HOME BLOCK /A044 /D078 ISZ FMTQBK+RXQBLK / BY GIVING AN EXTRA INCREMENT /A044 /D078 TAD (-EMESBK+DLDIR / SEE IF LOADER MESSAGE BLOCK /A044 /D078 SNA / IF SO, SKIP IT /A044 /D078 ISZ FMTQBK+RXQBLK / BY GIVING AN EXTRA INCREMENT /A044 /D078 TAD (-DLALOC+EMESBK / THE ALLOC BLOCK /A044 /D078 SNA CLA / SKIP IT ALSO /A044 /D078 ISZ FMTQBK+RXQBLK / BY GIVING AN EXTRA INCREMENT /A044 JMS FMTVCD /GET READ READ VERIFY CODE /A078 DCA FMTQBK+RXQFNC /SET FUNCTION CODE /A078 JMS FMTQRX /DO IT /A078 SKP /IS AN ERROR /A078 JMP CLALP3 /CONT /A078 CLARTY, /RETRY /A078 ISZ CLACNT /A078 JMP CLALP2 /NOT DONE /A078 JMP FMTER /CAN'T DO IT /A078 CLALP3, /A078 TAD FMTQBK+RXQRS1 /LAST BLOCK START /A078 CIA /POS /A078 TAD FMTQBK+RXQBLK /START BLK NUMBER /A078 DCA FMTQBK+RXQBLK /SET NEXT BLOCK /A078 TAD DSBLKC / NEG NO DSK BLOCKS TO CLEAR /A027 /C035 TAD FMTQBK+RXQBLK / SEE IF IT HAS REACHED ITS MAX SPA CLA /C078 JMP CLALP1 TAD DENSTY / CHECK DENSITY SZA CLA / IS SINGLE DENSITY? JMP I CLABLK / NO IS DOUBLE DENSITY. DONE... / TAD (RXEPW+4000) / WRITE OUT THE LAST TWO SECTORS DCA FMTQBK+RXQFNC / USING PHYSICAL WRITE TAD (25) / SET THE SECTOR DCA FMTQBK+RXQSEC DECIMAL /A035 TRKCMT, / THE CONSTANT IN THE FOLLOWING STATEMENT APPEARS TO HAVE BEEN /A035 / INCORRECTLY SPECIFIED FROM THE TIME THIS CODE WAS WRITTEN /A035 / ORIGINALLY, THE STATEMENT WAS TAD (114) OCTAL. /A035 / THE PURPOSE OF THIS CODE APPEARS TO BE TO COMPLETE THE /A035 / INITIALIZATION OF THE TRACK WHICH CONTAINS THE LAST BLOCK, /A035 / BLOCK 632. THIS BLOCK RESIDES ON TRACK 1+IP(3*632/26) /A035 / WHERE IP MEANS INTEGER PART. SINCE 3*632/26 IS 72.92+ /A035 / THE TRACK WHICH CONTAINS THE LAST BLOCK IS TRACK 73 /A035 / TRACKS 0,74,75, AND 76 ARE NOT USED ON RX01 DISKETTES /A035 TAD (73) / LOAD TRACK NO OF LAST BLOCK /C035 OCTAL /A035 DCA FMTQBK+RXQTRK / SET THE TRACK NUMBER /M032 JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 TAD (30) / GET THE LAST SECTOR WRITTEN DCA FMTQBK+RXQSEC JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 TAD (RXEWT+4000) / RESET THE FUNCTION DCA FMTQBK+RXQFNC / TO LOGICAL WRITE DCA FMTQBK+RXQBLK / CLEAR THE BLOCK COUNTER JMP I CLABLK CLACNT, -10 /ERROR RETRY COUNT /A078 CPYEXA, XX /A021 CIFMNU JMS I IOACAL / 0 TEXT11 / PRESS RETURN (THIS MSG CONTINUES BELOW) 1600 / POSITION CODE FOR CLEAR /C059 /A043 2012 / POSITION CODE FOR "PRESS RETURN" CPYCON, XX / ADDRESS OF MSG: / "FOR ANOTHER COPY" OR / "TO RETRY FORMAT" OR / "TO RETRY INITIALIZATION" AC7777 / MINUS COPY CODE /A057 TAD FNCODE / GET ORIGINAL FUNCTION CODE /A057 SZA CLA /A029 JMP CPYCN1 / IF NOT COPY BYPASS /A029 JMS DRVTST / SKIP IF EITHER DRIVE IS DRIVE 0 /A033 JMP CPYCN2 / NEITHER DRIVE IS DRIVE 0 /A033 CIFMNU / TELL USER THAT WE'RE DONE JMS I IOACAL / PRINT /C036 0 / DEFAULT OUTPUT ROUTINE TEXTG2 / GENERAL PURPOSE--2 SUBSTRINGS /A036 2212 / CURSOR POSITION TEXT33 / "OR, " /A036 2216 / /A036 TEXT3 / "REPLACE THE ORIGINAL ... /C036 3000 / FINAL CURSOR PSN /A036 JMP CPYCN1 / GO PRINT GOLD WITHOUT "OR" /A033 CPYCN2, CIFMNU /A033 JMS I IOACAL 0 TEXTG2 / GENERAL PURPOSE--2 SUBSTRINGS /C036 2412 TEXT33 / "OR, " /A036 IFNDEF ITALIAN <2416> IFDEF ITALIAN <2412> TEXT15 / "Press Gold ... /A033 2700 /A036 JMP I CPYEXA / RETURN /A055 / CPYCN1, /A029 JMS PPG / PRINT PRESS GOLD /A036 JMP I CPYEXA / RETURN /A021 PPG, XX / PRINT PRESS GOLD /A036 CIFMNU JMS I IOACAL 0 TEXTG1 / GENERAL PURPOSE--1 SUBSTRING /C036 2412 TEXT15 / "Press Gold ... /A033 2700 / JMP I PPG / RETURN /A036 /***********************************************************************/A031 / / GTDKID GETS THE DISK ID OF THE SYSTEM DISK / THE ID IS THE THREE NAME WORDS AND THE "RANDOM" WORD /A057 / IT IS USED TO INSURE THAT THE SAME SYSTEM DISK IS REINSERTED / IN CASES WHERE IT MUST BE REMOVED, C.F. BACKUP COPY / /*********************************************************************** GTDKID, XX /A017 DCA GTDKIA / SAVE BUFFER ADDRESS /A057 DCA FMTQBK+RXQDRV / SET TO DRIVE 0 /A031 JMS FMTDEN / GET DENSITY OF DRIVE 0 /A033 /D074 TAD DENSTY / AND SAVE IT /A033 /D074 DCA DENST0 / FOR LATER USE /A033 TAD (DLDIR) / DIR BLOCK /A017 DCA FMTQBK+RXQBLK /A017 TAD (RXERD+4000) /A017 DCA FMTQBK+RXQFNC / FUNCTION CODE /A017 TAD (FMTBUF) / BUFFER /A017 DCA FMTQBK+RXQBAD / ADDR /A017 JMS FMTRXT / READ /A017 JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 JMS BLKMOV / COPY INTO IDBUF /A057 FMTBUF+2-1 / SOURCE ADDRESS /A057 GTDKIA, XX / DESTINATION ADDRESS /A057 -4 / SIZE /A057 CDFMYF+10 / SOURCE FIELD /A057 CDFMYF / DESTINATION FIELD /A057 JMP I GTDKID / RETURN /A017 /-------------------- PAGE /***********************************************************************/ / / / CHKID--CHECK TO MAKE SURE ORIGINAL SYSTEM DISKETTE IS INSTALLED / / BEFORE WE RETURN TO MENU. ALSO INSURE THAT UDK'S ARE / / ENABLED AGAIN / / / / WHEN CPYDSK IS CALLED, THE NAME AND DISK "RANDOM" ID / / ARE READ INTO IDBUF0-3. BEFORE CPYDSK IS EXITED, / / THE NAME AND "RANDOM" ID FOR THE DISK IN DRIVE 0 / / ARE READ INTO IDBUF4-7. THIS ROUTINE CHECKS TO MAKE / / SURE THAT BOTH BLOCKS MATCH / / / / IF NO MATCH IS FOUND, THE OPERATOR IS ASKED TO INSERT / / THE ORIGINAL SYSTEM DISKETTE. THE ROUTINE IS NOT / / EXITED UNTIL THE NAME AND "RANDOM" ID MATCH / / / / BEFORE EXITING UDK'S ARE ENABLED AGAIN / / / /***********************************************************************/ CHKID, XX / CHECK ORIGINAL SYSTEM DISKETTE / CHKID1, TAD (CDFMYF+10 /RESET ID READ FIELD /A081 DCA FMTQBK+RXQBFD /A081 TAD (IDBUF+4-1 / LOAD COMPARE BUFFER INDEX /A057 JMS GTDKID / GO READ NAME & ID /C057 TAD (-4 / /A057 DCA T1 / SET UP COUNTER /A057 TAD (IDBUF-1 / /A057 DCA X1 / SET UP SOURCE INDEX /A057 TAD (IDBUF+4-1 / /A057 DCA X2 / SET UP COMPARE INDEX /A057 CHKIDL, TAD I X1 / READ OLD WORD /A057 CIA / TAD I X2 / COMPARE WITH NEW WORD SZA CLA / JMP CHKID2 / NO, GO ASK FOR ORIGINAL /A056 ISZ T1 / SEE IF LAST WORD /A057 JMP CHKIDL / NO, LOOP BACK /A057 CIFSYS / /A057 UDKOPS / ENABLE UDK'S AGAIN /A057 JMP I CHKID / RETURN /A024 / / / CRTNM / THIS CREATES A 3 WORD BUFFER THAT CONTAINS THE DISKETTE NAME / IT TAKES 6 ASCII CHARACTERS ANS PACKS THEM INTO 3 2-CHARACTER / 6-BIT WORDS / CALLING SEQUENCE: / TAD (PTR TO BUF ADDR TO STORE NAME) / JMS CRTNM / / CRTNM, XX DCA CRNMPT / SAVE BUF PTR DCA INIBK / CLEAR THE BUFFER FOR THE 6-CHAR NAME DCA INIBK+1 DCA INIBK+2 CDFMNU / CHECK FOR NO NAME TYPED IN TAD (MNIBUF) / THE INPUT BUFFER OFSET FROM MUBUF TAD I (MNUCAL+1) / GET THE ADDRESS OF MUBUF DCA CPYMN1 TAD I CPYMN1 CDFMYF / MAKE A CDF FOR THIS FIELD SNA CLA / JMP INLP2D / IF NO NAME SET DEFAULT NAME / AC7777 / LOAD MINUS ONE /C056 TAD CPYMN1 / TO GENERATE THE ADDRESS FOR X1 /C056 / DCA X1 DCA INBYTE / CLEAR COUNTER TAD (-6) / SET THE LOOP COUNTER DCA INLP1 TAD (INIBK-1) / GET THE STARTING ADDRESS OF THE BUFFER / THAT IT WILL BE STORED DCA INWDAR INLUP1, CDFMNU / GET THE CHARACTER (ASCII) TAD I X1 CDFMYF / MAKE A CDF FOR THIS FIELD / SNA / JMP INLPE1 / IF ZERO THEN END OF STRING JMS ININXT / INSERT THE CHAR. ISZ INLP1 / INCREMENT THE LOOP COUNTER JMP INLUP1 JMP INLP1D INLPE1, TAD (BLANK) / PAD THE REMAINING WITH BLANKS JMS ININXT / PLACE IT IN THE BUFFER ISZ INLP1 JMP INLPE1 INLP1D, TAD INIBK / SET THE NAME DCA I CRNMPT / IN THE BUFFER FOR BLOCK 0 ISZ CRNMPT /NEXT TAD INIBK+1 DCA I CRNMPT ISZ CRNMPT TAD INIBK+2 DCA I CRNMPT / JMP I CRTNM / CRNMPT, 0 / PTR TO BUFFER INLP2D, TAD (7061) / THIS IS WP DCA INIBK TAD (4552) / DI DCA INIBK+1 TAD (6454) / SK DCA INIBK+2 JMP INLP1D / INWDAR, 0 INLP1, 0 CPYMN1, 0 INIBK, ZBLOCK 3 / / THIS WILL PUT A CHARACTER THAT IS IN ASCII INTO THE PACKED STRING IN / COS-310 FORMAT. / ININXT, XX TAD (-140) / SPA / TAD (40) / MAKE ALL UPPER CASE TAD (100-OFFSET) / CONVERT TO 6 BIT SPA SNA / JMP I ININXT / IF IT IS A CHARACTER <40 SKIP IT AND P77 / GET ONLY 6 BITS MQL ISZ INBYTE / SEE IF IT IS THE FISRT OR SECOND BYTE TAD INBYTE CLL RAR SNL CLA / JMP ININXA / SECOND BYTE MQA ISZ INWDAR / INCREMENT THE ADDRESS BSW / SET FOR TOP BYTE TAD I INWDAR DCA I INWDAR JMP I ININXT / RETURN / ININXA, MQA TAD I INWDAR DCA I INWDAR JMP I ININXT / INBYTE, 0 / /GETSZE--GET NUMBER BLOCKS FOR VOLUME OR RX50 /FOR RX50 NUMBER OF BLOCKS =790 /FOR WINNIE VOLUME = NUMBER OF BLOCKS * (16) / GETSZE, 0 /A074 SNA /0=RX50 /A074 JMP GETSZ1 /IS AN RX50 /A074 CLL RTL /*4 /A074 CLL RTL /*4 /A074 SKP /A074 DECIMAL GETSZ1, TAD (800 /NUMBER BLOCKS AVAILABLE ON RX50/A074 /C075 OCTAL JMP I GETSZE /A074 /-------------------- PAGE /***********************************************************************A019 / A019 / THIS ROUTINE PRINTS A MESSAGE WHEN THE DRIVE IS NOT READY A019 / TELLING THE USER WHICH DRIVE IS NOT READY AND ASKING HIM A019 / TO PRESS GOLD MENU TO RETURN TO MAIN MENU FOR ANOTHER TRY A019 / A019 /***********************************************************************A019 DRVERR, XX CIFMNU /A019 JMS I IOACAL / "YOU NEED A DISKETTE IN DRIVE X" /A019 0 /A019 TEXT34 /A019 0050 / CLEAR FROM DATE & TIME /C057 1515 / CHANGED POINTER & DELETED SPACES /C033 FMTQBK+RXQDRV / DRIVE NUMBER NOT READY /C038 CIFMNU /A019 JMS I IOACAL /A019 0 /A019 TEXT36 / "INSERT A DISKETTE IN THE DRIVE" /A019 1715 / CURSOR LOCATION /A019 /C038 CIFMNU JMS I IOACAL / 0 TEXTG3 / GENERAL PURPOSE -- 3 SUBSTRINGS /A036 2115 /C038 TEXT35 / "AND PRESS RETURN /A036 / 2604 TEXT33 / "OR, " /C036 / IFNDEF ITALIAN <2610> / /C036 IFDEF ITALIAN <2604> TEXT15 / "Press Gold ... /A033 2700 / POSITION FOR CURSOR AFTER MSG /A033 / JMP I DRVERR /A019 / ********************************************************************* /A066 / / WININI - DISPLAYS THE VOLUME NAME THE USER IS ABOUT TO / INITIALIZE, ASKS FOR A RETURN TO CONTINUE OR / A GOLD MENU TO RETURN TO MAIN MENU W/O INITIALIZ / / ********************************************************************* /A066 WININI, XX CIFMNU JMS I IOACAL 0 WINITX / "THE VOLUME NAMED ????? WILL BE INITI.." 0050 / CLEAR FROM DATE TIME DISPLAY 1505 RCVNAM / THE VOLUME NAME (ASCII STRING) CIFMNU JMS I IOACAL 0 TEXTG3 2404 TEXT26 / "PRESS RETURN TO CONTINUE" 2604 TEXT33 / "OR, " IFNDEF ITALIAN <2610> IFDEF ITALIAN <2604> TEXT15 / "PRESS GOLD MENU TO RETURN..." 2700 JMP I WININI SHOWNM, XX TAD WINDST / NOW TELL USER THE NAME OF THE VOLUME /A066 / TO BE INITIALIZED & ALLOW EXIT /A066 SNA CLA / SKIP IF WINNIE /A066 JMP FMTDGO / ITS A DISKETTE- BYPASS /A066 JMS WININI / DISPLAY MESSAGE /A066 JMS WTFRRS / WAIT FOR ANSWER /A066 JMP FMTDGO / RETURN ENTERED- INITIALIZE IT /A066 JMP CPYDS2 / GOLD MENU- QUIT W/O INITIALIZING /A066 FMTDGO, JMP I SHOWNM /A066 / ********************************************************************* /A066 / /A066 / FMTWER-- TELL USER THAT A V1.5 WINNIE AREA DOES NOT HAVE /A066 / A VOLUME MOUNTED OR IS TOO SMALL FOR DOCUMENT INIT /A066 / /A066 / /A066 / ********************************************************************* /A066 FMTWER, TAD (0060) / CLEAR FROM TIME DISPLAY ON /A066 JMS CLRSCR /A066 TAD WINDST / WHICH TYPE OF ERROR??? /A066 /C074 /-1=VOL. NOT ASSIGNED -2=AREA TOO SMALL -3=AREA TOO LARGE. G.T. 4095 /A074 JMS SETEXT /GET TEXT STRING POINTER /A074 DCA FMTWTX / /A066 CIFMNU /A066 JMS I IOACAL / PRINT "DESTINATION AREA IS...." /A066 0 /A066 FMTWTX, 0 /A066 1505 /A066 TXTDST /A066 DRVDST /A066 / JMS FMTWTY /MADE INTO SUBRTN /A074 JMP CPYDS2 / " GOLD MENU- BACK TO MAIN MENU /C074 JMP CKDFS2 / ENTERED CR - GO BACK TO ASK FOR DRV # /C074 / FMTWTY, 0 /A074 CIFMNU /A066 JMS I IOACAL / /A066 0 /A066 TEXTG3 / GENERAL PURPOSE CONTROL STRING 3 /A066 2205 / LINE 22 COL 5 /A066 TEXT26 / "PRESS RETURN TO CONTINUE /A066 2405 / LINE 24 COL 5 /A066 TEXT33 / "OR, " /A066 IFNDEF ITALIAN <2411> / /A066 IFDEF ITALIAN <2405> TEXT15 / "PRESS GOLD MENU TO RECALL THE /A066 2700 / LINE 27 COL 0--FOR OPR RESP /A066 / JMS WTFRRS / WAIT FOR REPLY /A066 ISZ FMTWTY / ENTERED CR - GO BACK TO ASK FOR DRV # /C074 JMP I FMTWTY / " GOLD MENU- BACK TO MAIN MENU /C074 /********************************************************************/A074 /FOLLOWING MAKES SURE THAT THE SYSTEM VOLUME ON THE WINNIE IS BOOTABLE /A074 / AND THAT DOC VOLUME IS NOT /A074 / /***********************************************************************/A074 FMTWN, XX /A074 DCA BOOTBT /SAVE BOOTABLE WINNIE BIT /A074 AC7776 /A074 TAD DENSTY /A074 SPA SNA CLA /WINNIE /A074 JMP I FMTWN /NO EXIT. /A074 TAD DRVDST /DESTINATION DRIVE /A074 DCA FMTQBK+RXQDRV / PUT DRIVE # IN Q-BLK /A066 /M076 JMS FMTGTV /GET VOLUME DATA DEST DRIVE /C074 JMP FMTER /ERROR /A074 CDFMYF+10 /BUFFER FIELD /A074 TAD I BOOTLC /LOCATION OF BOOT BIT /A074 AND (7577 /CLEAR BOOT BIT /A074 TAD BOOTBT /SET BOOTABLE BIT /A074 DCA I BOOTLC /A074 CDFMYF /A074 TAD (RDEUPD /A074 DCA FMTQBK+RXQFNC /UPDATE VOLUME DATA /A074 JMS FMTRXT /A074 JMP FMTER /A074 JMP I FMTWN /RET /A074 BOOTLC, 21 /LOCATION OF BOOT WORD /A074 BOOTBT, 200 /BOOT BIT /A074 / /GET VOLUME DATA /A074 / FMTGTV, 0 /A074 TAD (RDEGTV+4000) / SET Q-BLK FOR GET VOLUME DATA CALL /A066 DCA FMTQBK+RXQFNC /A066 DCA FMTQBK+RXQBLK / BE SURE VALID BLOCK # (0 ALWAYS IS) /A066 JMS FMTRXT / QUEUE REQUEST W/O CHECKING TIME /A070 SKP /IS AN ERROR /A074 ISZ FMTGTV /NORMAL RET /A074 JMP I FMTGTV /A074 /-------------------- PAGE /D056 ERRMES, /D056 TEXT '^P &TYPING "!A" HAS NO MEANING HERE, PLEASE RETYPE.^P' / THESE ARE THE CONSTANTS AND ADDRESSES USED BY THE ERROR MESSAGE. / / FNCER, / REDFNC /THE ADDRESS OF THE STRING THAT SAYS READ / WTFNC /THE ADDRESS OF THE WRITE MESSAGE STRING / FMTFNC /THE ADDRESS OF THE FORMAT MESSAGE STRING /A028 / WTFNC, IFDEF ENGLSH < TEXT 'WRITE' > IFDEF ITALIAN < TEXT "SCRITTURA" > IFDEF V30NOR < TEXT "SKRIVE" > /A086 IFDEF V30SWE < TEXT 'SKRIV'> / REDFNC, IFDEF ENGLSH < TEXT 'READ' > IFDEF ITALIAN < TEXT "LETTURA" > IFDEF V30NOR < TEXT "LESE" > /A086 IFDEF V30SWE < TEXT 'L\DS'> / FMTFNC, IFDEF ENGLSH < TEXT 'FORMAT' > /**************************************************************/A028 / FOLLOWING MESSAGES MUST BE CHANGED TO REFLECT FORMAT /A028 /******************************************************************/A028 IFDEF ITALIAN < TEXT "FORMATO" > IFDEF V30NOR < TEXT 'FORMATERE'> /A086 IFDEF V30SWE < TEXT 'FORMATERA'> / /-------------------- / / COMMANDS / /D056 COPYST, IFDEF ENGLSH < TEXT 'COPY' > /D056 IFDEF CANADA < TEXT "COPIE" > /D056 IFDEF FRENCH < TEXT "COPIE" > /D056 IFDEF DUTCH < TEXT "KOPIE" > /D056 IFDEF GERMAN < TEXT "COPY" > /D056 IFDEF NORWAY < TEXT "KOPI" > /D056 IFDEF SWEDSH < TEXT "KOPI" > /D056 IFDEF DANISH < TEXT "KOPI" > /D056/ /D056 NOST, IFDEF ENGLSH < TEXT 'NO' > /D056 IFDEF CANADA < TEXT "NON" > /D056 IFDEF FRENCH < TEXT "NON" > /D056 IFDEF DUTCH < TEXT "NEE" > /D056 IFDEF GERMAN < TEXT "NEIN" > /D056 IFDEF NORWAY < TEXT "NEI" > /D056 IFDEF SWEDSH < TEXT "NEJ" > /D056 IFDEF DANISH < TEXT "NEJ" > /D056/ /D056 IFDEF CANADA < TEXT "POUR CONTINUER" > /D056 IFDEF FRENCH < TEXT "POUR CONTINUER" > /D056 IFDEF DUTCH < TEXT "VOOR VERVOLG" > /D056 IFDEF GERMAN < TEXT "FORTS." > /D056 IFDEF NORWAY < TEXT "FORTS" > /D056 IFDEF SWEDSH < TEXT "FORTS" > /D056 IFDEF DANISH < TEXT "FORTS" > / / MESSAGES / IFDEF ENGLSH < TEXT1A, TEXT '^P!E -- &B&A&C&K&U&P &M&E&N&U --' /C066 TEXT1B, TEXT '^P&REMOVE THE SYSTEM DISKETTE FROM DRIVE 0.' TEXT1C, TEXT '^P&PLACE THE DISKETTE(S) INTO THE FOLLOWING DRIVE(S):' /C066 TEXT1D, / THIS TEXT MUST BE AN EVEN NUMBER OF CHARACTERS FOR /A033 / FOR ALL TRANSLATIONS. THE NEXT TEXT STATEMENT IS /A033 / DESIGNED TO BE A CONTINUATION OF THIS TEXT BY /A033 / REORIGINING TO OVERLAY THE FULL ZERO WORD TERMINATOR *.-1 /A033 TEXT '^P&!S !D - &D&E&S&T&I&N&A&T&I&O&N !S - &THIS !S ' /C033/C066 *.-1 /THE FOLLOWING TEXT IS A CONTINUATION OF THE ABOVE TEXT /A033 TEXT 'WILL BE &O&V&E&R&W&R&I&T&T&E&N.' /C033 TEXT1E, TEXT '^P&PLACE THE DISKETTE WHICH IS TO &R&E&C&E&I&V&E THE COPY INTO DRIVE !D.' /C033 TEXT1F, TEXT '^P&USE A BLANK !S OR A USED !S YOU NO LONGER NEED.' TEXT1G, TEXT '^P&!S !D - &S&O&U&R&C&E !S - &THIS !S WILL BE &R&E&A&D.' /C033/C066 TEXT1H, TEXT '^P&PLACE THE DISKETTE WHICH IS TO BE &C&O&P&I&E&D INTO DRIVE !D.' /C033 TEXT1I, / DELETED POSITION COMMAND /C036 TEXT '&WHEN YOU ARE READY TYPE &C&O&P&Y AND &PRESS &R&E&T&U&R&N.' DEVDRV, TEXT 'DRIVE' / /A066 DEVARE, TEXT 'DEVICE' / /A066 MEDDSK, TEXT 'DISKETTE' / /A066 MEDVOL, TEXT 'VOLUME' / /A066 > IFDEF ITALIAN < TEXT1A, TEXT '^P!E -- !&SALVATAGGIO --' /C066 TEXT1B, TEXT "^P&TOGLIERE IL !&SISTEMA DALL'UNIT\A 0." TEXT1C, TEXT '^P&INSERIRE I DISCHETTI NELLE SEGUENTI UNIT\A:' /C066 TEXT1D, / THIS TEXT MUST BE AN EVEN NUMBER OF CHARACTERS FOR /A033 / FOR ALL TRANSLATIONS. THE NEXT TEXT STATEMENT IS /A033 / DESIGNED TO BE A CONTINUATION OF THIS TEXT BY /A033 / REORIGINING TO OVERLAY THE FULL ZERO WORD TERMINATOR *.-1 /A033 TEXT '^P&!S !D - !&COPIA - &QUESTO !S ' /C033/C066 *.-1 /THE FOLLOWING TEXT IS A CONTINUATION OF THE ABOVE TEXT /A033 TEXT 'VIENE !&SOVRASCRITTO.' /C033 TEXT1E, TEXT "^P&INSERIRE IL SUPPORTO !&COPIA NELL'UNIT\A !D." /C033 TEXT1F, /TEXT '^P&USE A BLANK !S OR A USED !S YOU NO LONGER NEED.' TEXT1G, TEXT '^P&!S !D - !&ORIGINALE - &QUESTO !S VIENE !&LETTO.' /C033/C066 TEXT1H, TEXT "^P&INSERIRE IL SUPPORTO !&ORIGINALE NELL'UNIT\A !D." /C033 TEXT1I, / DELETED POSITION COMMAND /C036 TEXT '&INTRODURRE !&COPIA E &PREMERE !&RITRNO.' DEVDRV, TEXT 'UNIT\A' / /A066 DEVARE, TEXT 'UNIT\A' / /A066 MEDDSK, TEXT 'SUPPORTO' / /A066 MEDVOL, TEXT 'SUPPORTO' / /A066 > IFDEF V30NOR < /A086 TEXT1A, TEXT '^P!E -- !&KOPERING --' /A086 TEXT1B, TEXT '^P&TA SYSTEMDISKETTEN UA AV STASJON 0.' /A086 TEXT1C, TEXT '^P&SETT DISKETTEN(E) INN I F\XLGENDE STASJON(ER):' /A086 TEXT1D, TEXT '^P&!S !D - !&MOTTAGER-!S - !S HER VIL BLI !&OVERSKREVET.' /A086 TEXT1E, TEXT '^P&DISKETTEN DU SKAL KOPIERE !&TIL, SETTES I STASJON !D.' /A086 TEXT1F, TEXT '^P&BRUKEN NY !S EL. EN GAMMEL !S DU IKKE TRENGER.' /A086 TEXT1G, TEXT '^P&!S !D - !&AVSENDER-!S - &DISKETTEN HER VIL BLI !&LEST.'/A086 TEXT1H, TEXT '^P&DISKETTEN DU SKAL KOPIERE !&FRA, SETTES I STASJON !D.' /A086 TEXT1I, TEXT '&N\ER DETTE ER GJORT, SKRIV !&KOPI OG TRYKK P\E !&RETUR.' /A086 DEVDRV, TEXT 'STASJON' /A086 DEVARE, TEXT 'ENHET' /A086 MEDDSK, TEXT 'DISKETT' /A086 MEDVOL, TEXT 'OMR\EDE' /A086 > IFDEF V30SWE < TEXT1A, TEXT '^P!E -- &S\DKERHETSKOPIERING --' /C066 TEXT1B, TEXT '^P&TA UT SYSTEMDISKETTEN I ENHET 0.' TEXT1C, TEXT '^P&S\TT DISKETT(ER) I F\VLJANDE ENHET(ER):' /C066 TEXT1D, / THIS TEXT MUST BE AN EVEN NUMBER OF CHARACTERS FOR /A033 / FOR ALL TRANSLATIONS. THE NEXT TEXT STATEMENT IS /A033 / DESIGNED TO BE A CONTINUATION OF THIS TEXT BY /A033 / REORIGINING TO OVERLAY THE FULL ZERO WORD TERMINATOR *.-1 /A033 TEXT '^P&!S !D - &DISKETTKOPIA !S - &DENNA !S ' /C033/C066 *.-1 /THE FOLLOWING TEXT IS A CONTINUATION OF THE ABOVE TEXT /A033 TEXT 'KOMMER ATT SKRIVAS \VVER. ' /C033 TEXT1E, TEXT '^P&S\DTT I DISKETTEN, SOM SKA TA EMDT KOPIAN, I ENHET !D.' /C033 TEXT1F, TEXT '^P&ANV\DND EN TOM !S ELLER EN ANV\DND !S SOM DU INTE L\DNGRE BEH\VVER.' TEXT1G, TEXT '^P&!S !D - &ORIGINAL!S - &DENNA !S KOMMER ATT L\DSAS.' /C033/C066 TEXT1H, TEXT '^P&S\DTT I ORIGINALDISKETTEN I ENHET !D.' /C033 TEXT1I, / DELETED POSITION COMMAND /C036 TEXT '&N\DR DU \DR KLAR, SKRIV KOPIERA OCH TRYCK P\E RETUR.' DEVDRV, TEXT 'ENHET' / /A066 DEVARE, TEXT 'ENHET' / /A066 MEDDSK, TEXT 'DISKETT' / /A066 MEDVOL, TEXT 'VOLYM' / /A066 > / END IFDEF V30SWE / TEXT3, /A010 /V036 CHANGED TO A SUBSTRING BY REMOVING ^P&O&R /A036 /V036 ADDED WORD "ORIGINAL" /A036 IFDEF ENGLSH < TEXT '&REPLACE THE ORIGINAL SYSTEM DISKETTE IN DRIVE 0 AND'>/A010/C036 IFDEF ITALIAN < TEXT "&INSERIRE IL DISCO SISTEMA NELL'UNIT\A 0 E"> IFDEF V30NOR < TEXT '&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0 OG'> /A086 IFDEF V30SWE < TEXT '&BYT UT ORIGINALSYSTEMDISKETTEN I ENHET 0 OCH'> / TEXT11, IFDEF ENGLSH < TEXT '^P!E^P&PRESS &R&E&T&U&R&N ^S'> /C028/C033/C057 IFDEF ITALIAN < TEXT '^P!E^P&PREMERE !&RITORNO ^S'> IFDEF V30NOR < TEXT '^P!E^PTRYKK P\E !&RETUR ^S'> /A086 IFDEF V30SWE < TEXT '^P!E^PTRYCK P\E RETUR ^S'> TEXT1K, IFDEF ENGLSH < TEXT 'FOR ANOTHER COPY' > /C028 IFDEF ITALIAN < TEXT "PER UN'ALTRA COPIA"> IFDEF V30NOR < TEXT 'FOR \E F\E EN KOPI TIL'> /A086 IFDEF V30SWE < TEXT 'F\VR ATT KOPIERA'> TEXT1L, IFDEF ENGLSH < TEXT 'TO RETRY FORMAT' > /C028 IFDEF ITALIAN < TEXT 'PER RIPROVARE : FORMATO NON CORRETTO'> IFDEF V30NOR < TEXT 'FOR \E FORMATERE P\E NYTT'> /A086 IFDEF V30SWE < TEXT 'F\VR ATT FORMATERA IGEN'> / TEXT1M, IFDEF ENGLSH < TEXT '^P!E^P&FORMAT IN PROGRESS - &PLEASE STAND BY.'> /A028 IFDEF ITALIAN < TEXT "^P!E^P&FORMATTAMENTO IN CORSO - &PREGO ATTENDERE..."> IFDEF V30NOR < TEXT '^P!E^P&FORMTERING P\EG\ER. &VENT...'> /A086 IFDEF V30SWE < TEXT '^P!E^P&FORMATERING P\EG\ER - &V\DNTA'> / TEXT1N, IFDEF ENGLSH < TEXT 'TO RETRY INITIALIZATION, OR' > /A030 IFDEF ITALIAN < TEXT "PER RIPROVARE : INIZIALIZZAZIONE NON CORRETTA"> IFDEF V30NOR < TEXT 'FOR \E KLARGJ\XRE P\E NYTT EL.'> /A086 IFDEF V30SWE < TEXT 'F\VR ATT INITIERA IGEN, ELLER'> / TEXT12, IFDEF ENGLSH < TEXT '^P!E ^P&E&L&A&P&S&E&D &T&I&M&E &C&L&O&C&K 0:00' > / / THE "0:00" HAS BEEN REMOVED FROM THE FOREIGN TRANSLATIONS BECAUSE IT IS NOT / ACTUALLY NEEDED AS THE "0:00" IS NEVER ON THE SCREEN FOR MORE THAN A SECOND / AND "0:00" IS PRINTED ANYWAY BY THE TIME ROUTINE. / IFDEF ITALIAN < TEXT "^P!E^P!&TEMPO !&IMPIEGATO"> IFDEF V30NOR < TEXT '^P!E ^P!&MEDG\ETT !&TID'> /A086 IFDEF V30SWE < TEXT '^P!E ^PANV\DND TID: 0:00'> / TEXT13, TEXT '^P!D:!2D' TEXT15, IFDEF ENGLSH < TEXT '&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' /C033 > /A SUBSTRING--HAS NO INTERNAL PARAMETERS /A033 IFDEF ITALIAN < TEXT "&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE."> IFDEF V30NOR < TEXT '&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYN.'> /A086 IFDEF V30SWE < TEXT '&ANV\DND GULD MENY F\VR ATT \ETERG\E TILL HUVUDMENYN'> / FMTERM, IFDEF ENGLSH < TEXT '^P!E&ERROR ON !S ^D WHILE TRYING TO !S' /C066 > IFDEF ITALIAN < TEXT "^P!E&ERRORE SULL'!S ^D IN !S"> IFDEF V30NOR < TEXT '^P!E&FEIL P\E !S ^D VED FORS\XK P\E \E !S'>/A086 IFDEF V30SWE < TEXT '^P!E&FEL P\E !S ^D VID !S'> IFDEF ENGLSH < TEXT17, TEXT '^P!E-- &B&A&C&K&U&P &E&R&R&O&R &M&E&N&U --' /A014 TEXT18, TEXT '&THE DENSITITES OF Y' /SUBSTRING OF TEXT20 (DM-I) /A034 TEXT20, TEXT '^P^SOUR DISKETTES ARE DIFFERENT.' /A014 TEXT22, TEXT '^P&YOU ARE TRYING TO COPY FROM!S TO!S.' /A014 /C033 /C034 TEXT23, TEXT '^P&PLEASE USE A!S DISKETTE FOR THE COPY.' /A014 /C033 /C034 TEXT24, TEXT ' SINGLE DENSITY' /C033 TEXT25, TEXT ' DOUBLE DENSITY' /C033 TEXT2A, TEXT ' 8 INCH' /A033 TEXT2B, TEXT ' 5 INCH' /A033 TEXTY, TEXT '&Y' / DM-II SUBSTR FOR TEXT20 /A034 TEXT26, TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE' /A014 /C051 TEXWS1, TEXT '^P!E&THERE IS NO VOLUME ASSIGNED TO ^S DEVICE !D' /C074 TEXWS2, TEXT '^P!E&VOLUME ASSIGNED TO ^S DEVICE !D IS TOO SMALL' /C074 TEXWS3, TEXT '^P!E&VOLUME ASSIGNED TO ^S DEVICE !D IS TOO LARGE' /C074 TXTSRC, TEXT 'SOURCE' /A066 TXTDST, TEXT 'DESTINATION' /A066 WINRCV, TEXT '^P&THE VOLUME NAMED ^A WILL &R&E&C&E&I&V&E THE COPY' /A066 WINCPY, TEXT '^P&THE VOLUME NAMED ^A WILL BE &C&O&P&I&E&D' /A066 WINITX, TEXT '^P!E^P!E&THE VOLUME NAMED ^A WILL BE INITIALIZED' /A066 /D057 TEXT27, TEXT '-- &F&O&R&M&A&T &D&I&S&K&E&T&T&E --' /A014 TEXT30, TEXT '&PLEASE SELECT HOW THIS DISKETTE WILL BE INITIALIZED.' /A014 TEXT31, TEXT '&TYPE &D FOR DOCUMENT OR &S FOR SYSTEM ' /A014 /C061 /D057 TEXT32, TEXT 'THEN &PRESS &R&E&T&U&R&N' /A014 TEXT33, TEXT '&O&R, ' /A014 TEXT34, TEXT '^P!E^P!E&YOU NEED A DISKETTE IN DRIVE !D' /A019 /C038 TEXT35, TEXT '&AND &PRESS &R&E&T&U&R&N' /A019 TEXT36, TEXT '^P!E&INSERT A DISKETTE IN THE DRIVE' /A019 /D057 TEXT40, TEXT '^P!E---- &B&A&C&K&U&P &D&I&S&K&E&T&T&E ----' /A019 TEXT50, TEXT '^P!E^S &SYSTEM &DISKETTES CAN NOT BE MADE' /A032 /C037 > IFDEF ITALIAN < TEXT17, TEXT '^P!E-- !&SALVATAGGIO - !&ERRORE --' /A014 TEXT18, TEXT '&LA DENSIT\A DEI' /SUBSTRING OF TEXT20 (DM-I) /A034 TEXT20, TEXT "^P^SDISCHETTI E' DIFFERENTE." /A014 TEXT22, TEXT '^P&IMPOSSIBILE COPIARE DA!S A!S.' /A014 /C033 /C034 TEXT23, TEXT '^P&USARE UN DISCHETTO A!S.' /A014 /C033 /C034 TEXT24, TEXT ' SINGOLA DENSIT\A' /C033 TEXT25, TEXT ' DOPPIA DENSIT\A' /C033 TEXT2A, TEXT ' 8 INCH' /A033 TEXT2B, TEXT ' 5 INCH' /A033 TEXTY, TEXT ' ' / DM-II SUBSTR FOR TEXT20 /A034 TEXT26, TEXT '&PREMERE !&RITORNO PER CONTINUARE' /A014 /C051 TEXWS1, TEXT '^P!E&NON CI SONO^SARCHIVI DOCUMENTI DEFINITI COME UNIT\A !D' /C074 TEXWS2, TEXT '^P!E&ARCHIVIO DOCUMENTI DEFINITO^SCOME UNIT\A !D TROPPO PICCOLO' /C074 TEXWS3, TEXT '^P!E&ARCHIVIO DOCUMENTI DEFINITO^SCOME UNIT\A !D TROPPO GRANDE' /C074 TXTSRC, TEXT ' ' /A066 TXTDST, TEXT ' ' /A066 WINRCV, TEXT '^P&ARCHIVIO DOCUMENTI !&COPIA ^A' /A066 WINCPY, TEXT '^P&ARCHIVIO DOCUMENTI !&ORIGINALE ^A' /A066 WINITX, TEXT "^P!E^P!E&L'ARCHIVIO DOCUMENTI ^A VIENE INIZIALIZZATO" /A066 /D057 TEXT27, TEXT '-- !&FORMATO !&DISCHETTO --' /A014 TEXT30, TEXT '&SCEGLIERE COME INIZIALIZZARE IL DISCHETTO.' /A014 TEXT31, TEXT '&INTRODURRE &D PER DISCO DOCUMENTI O &S PER DISCO SISTEMA ' /A014 /C061 /D057 TEXT32, TEXT 'E PREMERE !&RITORNO' /A014 TEXT33, TEXT '&OPPURE, ' /A014 TEXT34, TEXT "^P!E^P!E&NECESSITA UN DISCHETTO NELL'UNIT\A !D" /A019 /C038 TEXT35, TEXT 'E PREMERE !&RITORNO' /A019 TEXT36, TEXT "^P!E&INSERIRE UN DISCHETTO NELL'UNIT\A" /A019 /D057 TEXT40, TEXT '^P!E---- &B&A&C&K&U&P &D&I&S&K&E&T&T&E ----' /A019 TEXT50, TEXT '^P!E&IMPOSSIBILE CREARE UN &DISCO &SISTEMA^S' /A032 /C037 > IFDEF V30NOR < /A086 TEXT17, TEXT '^P!E-- !&FEIL !&VED !&SIKKERHETSKOPIERING --' /A086 TEXT18, TEXT '&DISKETTE HAR' /SUBSTRING OF TEXT20 (DM-I) /A086 TEXT20, TEXT '^P^S&FORSKJELLIG TETTHET' /A086 TEXT22, TEXT '^P&DU FORS\XKER \E KOPIERE FRA!S TIL !S.' /A086 TEXT23, TEXT '^P&BRUK EN!S DISKETT TIL KOPIEN.' /A086 TEXT24, TEXT ' ENKEL TETTHET' /A086 TEXT25, TEXT ' DOBBEL TETTHET' /A086 TEXT2A, TEXT ' 8 TOMMERS' /A086 TEXT2B, TEXT ' 5 TOMMERS' /A086 TEXTY, TEXT ' ' / DM-II SUBSTR FOR TEXT20 /A086 TEXT26, TEXT '&TRYKK P\E !&RETUR FOR \E FORTSETTE' /A086 TEXWS1, TEXT '^P!E&DET ER IKKE TILDELT NOE OMR\EDE P\E ^SENHET !D' /A086 TEXWS2, TEXT '^P!E&OMR\EDE TILDELT P\E ^SENHET !D ER FOR LITE' /A086 TEXWS3, TEXT '^P!E&OMR\EDE TILDELT P\E ^SENHET !D ER FOR STORT' /A086 TXTSRC, TEXT 'AVSENDER-' /A086 TXTDST, TEXT 'MOTTAGER-' /A086 WINRCV, TEXT '^P&DU KOPIERER !&TIL OMR\EDET KALT ^A' /A086 WINCPY, TEXT '^P&DU KOPIERER !&FRA OMR\EDET KALT ^A' /A086 WINITX, TEXT '^P!E^P!E&OMR\EDET KALT ^A VIL BLI KLARGJORT' /A086 /D057 TEXT27, TEXT '-- &F&O&R&M&A&T &D&I&S&K&E&T&T&E --' /A086 TEXT30, TEXT '&ANJI HVA DISKETTEN SKAL KLARGJ\XRES TIL.' /A086 TEXT31, TEXT '&SKRIV &D FOR DOKUMENT EL. &S FOR SYSTEM' /A086 /D057 TEXT32, TEXT 'THEN &PRESS &R&E&T&U&R&N' /A086 TEXT33, TEXT 'EL., ' /A086 TEXT34, TEXT '^P!E^P!E&DET M\E ST\E EN DISKETT I STASJON !D' /A086 TEXT35, TEXT '&OG TRYKK P\E !&RETUR' /A086 TEXT36, TEXT '^P!E&SETT EN DISKETT I STASJONEN' /A086 /D057 TEXT40, TEXT '^P!E---- &B&A&C&K&U&P &D&I&S&K&E&T&T&E ----' /A086 TEXT50, TEXT '^P!E^S&DU KAN IKKE LAGE SYSTEMDISKETTER' /A086 > IFDEF V30SWE < TEXT17, TEXT '^P!E-- &S\DKERHETSKPIERINGSFEL --' /A014 TEXT18, TEXT '&DENSITETEN P\E D' /SUBSTRING OF TEXT20 (DM-I) /A034 TEXT20, TEXT '^P^SINA DISKETTER \ER OLIKA.' /A014 TEXT22, TEXT '^P&DU F\VRS\VKER KOPIERA FR\EN !S TILL !S.' /A014 /C033 /C034 TEXT23, TEXT '^P&ANV\DEND EN !SDISKETT F\VR KOPIERINGEN.' /A014 /C033 /C034 TEXT24, TEXT ' ENKEL DENSITET' /C033 TEXT25, TEXT ' DUBBEL DENSITET' /C033 TEXT2A, TEXT ' 8 TUM' /A033 TEXT2B, TEXT ' 5 TUM' /A033 TEXTY, TEXT '&J' / DM-II SUBSTR FOR TEXT20 /A034 TEXT26, TEXT '&TRYCK P\E RETUR F\VR ATT FORTS\DTTA' /A014 /C051 TEXWS1, TEXT '^P!E&DET FINNS INGEN VOLYM TILLDELAD F\VR ATT ^S ENHET !D' /C074 TEXWS2, TEXT '^P!E&VOLYM TILLDELAD F\VR ATT ^S ENHET !D \DR F\VR LITEN' /C074 TEXWS3, TEXT '^P!E&VOLYM TILLDELAD F\VR ATT ^S ENHET !D \DR F\VR STOR' /C074 TXTSRC, TEXT 'ORIGINAL' /A066 TXTDST, TEXT 'KOPIA' /A066 WINRCV, TEXT '^P&VOLYMEN ^A KOMMER ATT TA EMOT KOPIAN' /A066 WINCPY, TEXT '^P&VOLYMEN ^A KOMMER ATT KOPIERAS' /A066 WINITX, TEXT '^P!E^P!E&VOLYMEN ^A KOMMER ATT INITIERAS' /A066 /D057 TEXT27, TEXT '-- &F&O&R&M&A&T &D&I&S&K&E&T&T&E --' /A014 TEXT30, TEXT '&V\DLJ HUR DENNA DISKETT SKA INITIERAS' /A014 TEXT31, TEXT '&SKRIV D F\VR DOKUMENT ELLER S F\VR SYSTEM ' /A014 /C061 TEXT33, TEXT '' /A014 TEXT34, TEXT '^P!E^P!E&DU BEH\VER EN DISKETT I ENHET !D' /A019 /C038 TEXT35, TEXT 'OCH TRYCK P\E RETUR' /A019 TEXT36, TEXT '^P!E&S\DTT I EN DISKETT I ENHET' /A019 /D057 TEXT40, TEXT '^P!E---- &B&A&C&K&U&P &D&I&S&K&E&T&T&E ----' /A019 TEXT50, TEXT '^P!E^S &DU KAN INTE SKAPA SYSTEMDISKETTER' /A032 /C037 > / END IFDEF V30SWE TEXTG1, TEXT '^P^S^P' / GENERAL 1 SUBSTRING CONTROL STRING /A036 TEXTG2, TEXT '^P^S^P^S^P' / GENERAL PURPOSE--2 SUBSTRINGS /A036 TEXTG3, TEXT '^P^S^P^S^P^S^P' / GENERAL 3 SUBSRING CONTROL STRING /A036 PSCR, TEXT '^P!E' /CLEAR SCREEN /M036 TEXTDK, IFDEF ENGLSH < TEXT /^P &SOURCE !S IS SHORTER THAN DESTINATION !S BY !D BLOCKS./ > IFDEF ITALIAN < TEXT /^P !S &ORIGINALE HA !D BLOCCHI IN MENO DEL !S &COPIA./ > IFDEF V30NOR < TEXT /^P &AVSENDERIS !S ER !D BLOKKER MINDRE ENN MOTTAGER !S./ > /A086 IFDEF V30SWE < TEXT /^P &ANTAL F\DRRE BLOCK I ORIGINALET !S, JFR MED KOPIAN !S: !D./ > / END IFDEF V30SWE /-------------------- /***********************************************************************/A032 / /A032 / RX01/RX02 BOOT BLOCK TEMPLATE /A032 / TAKEN FROM LOADB7.PA VERSION 004 01-FEB-82 074 /A032 / STRIPPED ALL BEFORE "HACK= " /A032 / THEN STRIPPED ALL COMMENT LINES /A032 / APPROPRIATELY DELETED *ORG STATEMENTS /A032 / AND ADDED RELOC STATEMENTS /A032 / REDEFINED DUPLICATE LABELS WHICH CAUSED PROBLEMS /A032 / /A032 /***********************************************************************/A032 HACK= " -1 / DEFINITION OF THE "[H]ALF [A]SCII" [C]HARACTER [K]ONSTANT. WPBOOT= 2 / LOAD POINT FOR THE PRIMARY BOOTSTRAP. BOOT02= WPBOOT+60 / LOAD POINT FOR THE REMAINING PRIMARY BOOT. BT0102, /BOOT TEMPLATE RX01/RX02 /A032 RELOC WPBOOT / ASSEMBLE AS THO AT WPBOOT /A032 HLT /STRT ADDR OVERLAYED IN DD MODE BTRXID, "#-HACK^100+" -HACK / ...PRIMARY BTTRAK, "W-HACK^100+"P-HACK / ......BOOTSTRAP BTLSEC, "D-HACK^100+"I-HACK / .........HEADER BTSECT, "S-HACK^100+"K-HACK / ............PRECEEDS BTSCTR, "/-HACK^100+"[-HACK / ...............ACTUAL " -HACK^100+" -HACK / ..................BOOTSTRAP. 0 0 /D074 IFDEF WINNIE L.T. /A065 BTTBUF, RXDLDP-201 /M065 BTBFRA, RXDLDP-201 /M065 BTBFRB, RXDLDP-201 /M065 /D074 G.T. / END IFDEF WINNIE /A065 /D074 IFNDEF WINNIE L.T. /A065 /D074BTTBUF, RXDLDP-1 /D074BTBFRA, RXDLDP-1 /D074BTBFRB, RXDLDP-1 /D074 G.T. / END IFNDEF WINNIE /A065 BTBFFR, 377 MSK422, 422 /MASK FOR DENSITY,UNIT#,READ CODE BTCMND, 22 /BITS=DD,UNIT#,READ MSK24, 2400 /ADD TO BTCMND TO ALTERNATELY SET UNIT & DENSITY BTINC, JMP BTPTCH /ONE TIME JMP. ON SUCCESFUL READ ISZ BTXFER /SET DONE RETURN JMP I BTXFER /RETURN BTMORE, DCA I BTBFFR / DEPOSIT DATUM IN CORE. BTEMPT, JMS BTXFER / TRANSFER A DATUM FROM SILO. JMP BTMORE / NOT DONE - REPEAT FOR ENTIRE SECTOR. ISZ BTSCTR / DONE - ALL SECTORS READ ? JMP BTNEXT / NO - READ NEXT. JMP I BTSCND / YES - ENTER SYSTEM BOOTSTRAP CODE. RXISDN / DONE ? /M064 JMP BTBOO8 / NO - WAIT FOR READY FIRST. CLA CLL / INSURE AC CLEAR FOR DONE RETURN RXISER /ERROR? /M064 JMP BTINC /NO INC RET SKP /IS ERROR BTPTCH, DCA BTINC /CLEAR JMP ON SUCCESSFUL DONE TAD MSK24 /ALTERNATE 24 & 2400 BSW DCA MSK24 TAD MSK24 /GET IT JMP BTREAD / JUMP OVER CRITICAL AREA 2 JMS BTBOO7 / TRANSFER A DATUM DCA BOOT02-1 / ...AND INSERT IT IN-LINE. RELOC / END OF SECTION /A032 RELOC BOOT02-7 /A032 BTXFER, / ENTRY POINT TO "BTXFER". BTBOO7, / ### ENTRY POINT TO "READ" SUBROUTINE. ### RELOC / END OF SECTION /A032 RELOC BOOT02-6 /A032 BTBOO8, / CONTROLLER READY ? RELOC / END OF SECTION /A032 RELOC BOOT02-2 /A032 RELOC / END OF SECTION /A032 RELOC BOOT02-1 /A032 RELOC / END OF SECTION /A032 RELOC BOOT02 BTREAD, TAD BTCMND AND MSK422 /KEEP DENSITY,UNIT# AND READ CODE DCA BTCMND / ......DENSITY BIT IN COMMAND WORD TAD BTCMND / LOAD THE COMMAND RTL / ...AND ISOLATE RTL / ......DENSITY BIT IN THE LINK CLA CMA RAL / .........THEN BUILD DCA BTSCTR / ............THE CORRECT SECTOR COUNT. IAC / CALCULATE THE PROPER (SD OR DD) DCA BTSECT / ......PHYSICAL SECTOR NUMBER. BTNEXT, AC0004 / SET THE PHYSICAL I/O BIT TAD BTCMND / ...AND SUBMIT COMMAND TO CONTROLLER. RXILCD /M064 AC0003 / LOAD SECTOR # TO READ TAD BTSECT / ...INCREMENT IT BY INTERLEAVE JMS BTXFER / ......SUBMIT IT TO CONTROLLER DCA BTSECT / .........AND SAVE IT AGAIN CLA CLL IAC / LOAD "BOOT" TRACK NUMBER,... JMS BTXFER / ...AND SUBMIT IT TO CONTROLLER ALSO. JMS BTXFER / WAIT FOR CONTROLLER "DONE" BTSCND, /LOC 400 = DD BIT USED TO SAVE SPACE 400 TAD BTCMND / GET "EMPTY SILO" COMMAND RXILCD / ...AND SUBMIT IT TO CONTROLLER. /M064 JMP BTEMPT / GO EMPTY THE SILO 0 / ADD THIS LINE TO ALL TEMPLATES /A032 / BECAUSE AN EXTRA LOCATION GETS /A032 / WRITTEN ON THE IMAGE ON THE FLOPPY /A032 / RELOC / BACK TO ORIGINAL ORIGIN. RX01MID, / LABEL FOR BLKMOV /A032 RELOC 0400 / THIS STUFF GOES AT 0400 /A032 AC0001 / JMS TTY /TYPE A=GOT IN THIS FAR TAD BTHALT / PUT A HALT INSTRUCTION AT THE END DCA BTPTCH / ...OF THE ERROR BRANCH AC0002 / JMS TTY /B=UNIT 0 OK TAD BTCMND / LOAD COMMAND FROM PRIMARY BOOT. RTL / ISOLATE "SD"/"DD" RTL / ...IN REGISTER AS "0" OR "1" CLA RAL / ......AND SAVE IT. DCA BTRXID TAD PRX02 /DO A REQUEST FOR STATUS TAD BTCMND /ADD DENSITY RXILCD / ... /M064 RXISDN /M064 JMP .-1 / WAIT FOR DONE. RXIXDR / GET STATUS RESPONSE. /M064 AND PRX02 / ISOLATE THE RX02 BIT. SNA CLA / SKIP IF RX02 (RX28 DRIVE). DCA BTLCM2 / ZAP THE RX02 LCD 2ND XFR COMMAND. TAD BTRXID /0=DD 1=SD SNA CLA /IS DD? IAC BSW /NO SET 8 BIT MODE TAD BTCMND / ...COMMAND WORD. DCA BTCMND TAD BTRXID / LOAD THE DENSITY PARAMETER SNA CLA / ......DOUBLE DENSITY ? TAD BTBLKN / NO - MAKE IT 3*BLOCK NUM TAD BTBLKN / YES - MAKE IT 2*BLOCK NUM TAD BTBLKN DCA BTLSEC / ......AND SAVE IT. EJECT NXTBLK, TAD BTRXID / "DD" OPERATION ? SZA CLA JMP BTDBLD / YES - SKIP THE "UNPACK" PROCESS JMS BTPHYS / EFFECT A "READ SECTOR" OPERATION. JMP BTUNPK / ENTER UNPACKING LOOP DXUNPK, MQL / SAVE DATA BYTE MQA / UNPACK FIRST NYBBLE RTR / ...ALIGN TO HO END BSW AND DXNMSK / ......ISOLATE HIGH 4 BITS DCA I BTTBUF / .........AND PUT IT AWAY MQA / UNPACK SECOND NYBBLE RTL / ...ALIGN TO HO END BSW AND DXNMSK / ......ISOLATE HIGH 4 BITS DCA I BTTBUF / .........AND PUT IT AWAY BTUNPK, JMS BTXFER / GET DATA BYTE FROM SECTOR JMP DXUNPK / (TR) ...AND GO UNPACK IT BTDBLD, AC7776 / (DN) SET SECTOR COUNT DCA BTSCTR DYNEXT, JMS BTPHYS / EFFECT A "READ SECTOR" OPERATION. SKP / ENTER THE "MERGE" LOOP DYREAD, DCA I BTBFRB / SAVE WORD IN BUFFER. TAD I BTBFRA / LOAD CURRENT CONTENTS OF BUFFER. JMS BTXFER / LOAD A DATUM. /#(8 BIT MODE => INCLUSIVE OR INTO BITS 4-11) /#(12 BIT MODE => JAM XFER BITS 0-11) JMP DYREAD / (TR) CONTINUE FETCHING DATA CLA CMA /-1 TAD BTBFRA /RESET PTR TO LAST CHAR DCA BTBFRA /RESTORE ISZ BTSCTR / (DN) ALL SECTORS PROCESSED ? JMP DYNEXT / NO - PROCESS NEXT. ISZ BTBCTR / YES - ALL BLOCKS PROCESSED ? JMP NXTBLK / NO - DO ANOTHER BLOCK. AC0003 / JMS TTY /C=LOADER GOT IN OK TAD BTCMND AND MSK20 /MASK OUT UNIT NO SZA CLA /0=UNIT 0 DOCSKP=. /RXPRDF LDNOP SHOULD BE EQUAL THIS ADDRESS JMP I PRTMSG /NOT UNIT 0 JMP I WPSTRT / YES - START SYSTEM. TTY, 0 TAD P100 / MAKE ASCII. TLS TSF /WAIT TILL DONE JMP .-1 CLA JMP I TTY /RETURN PRTMSG, DCSTRT /START ADDRESS OF MESSAGE EJECT BTPHYS, 0 DCA BTTRAK / INITIALISE TRACK #. TAD BTLSEC / LOAD THE LOGICAL SECTOR #. BTDIV1, ISZ BTTRAK / INCREMENT THE TRACK #. DCA BTSECT / SAVE THE SECTOR #,... TAD BTSECT / ...THEN RETREIVE IT. TAD BTDVSR / "SUBTRACT" THE # OF SECTORS/TRACK. SMA / OVERFLOW ? JMP BTDIV1 / NO - CONTINUE. CLA CLL / YES - ENSURE REGISTER CLEAR TAD BTSECT / BUILD 3*Q. TAD BTSECT / TAD BTSECT BTDIV2, DCA BTSECT / SAVE "PHYSICAL" SECTOR #. TAD BTSECT / RETREIVE "PHYSICAL" SECTOR #. TAD BTDVSR / "SUBTRACT" # SECTORS/TRACK. P100, SMA / OVERFLOW ? JMP BTDIV2 / NO - REPEAT UNTIL OVERFLOW. ISZ BTSECT / YES - INCR TO BUILD CORRECT PHYSICAL SECTOR. AC0004 / SET "PHYSICAL" BIT JMS BTLCMD TAD BTSECT / () GET PHYSICAL SECTOR JMS BTXFER / () ...AND SEND IT CLA / (TR) "RXIXDR" DOESN'T CLEAR AC /M064 TAD BTTRAK / (DN) GET PHYSICAL TRACK JMS BTXFER / ...AND SEND IT JMS BTXFER / (TR) WAIT FOR CONTROLLER DONE DXNMSK, 7400 / (DN) (TR) (SPARE) JMS BTLCMD ISZ BTLSEC / BUMP LOGICAL SECTOR FOR NEXT TIME JMP I BTPHYS / EXIT FROM PHYSICAL I/O ROUTINE BTLCMD, 0 TAD BTCMND RXILCD /M064 TAD BTRXID SNA CLA BTLCM2, JMS BTXFER CLA JMP I BTLCMD BTDVSR, -32 / LOCAL STORAGE FOR THE TRACK/SECTOR CONSTANT. BTBLKN, DLRXLD / STARTING BLK OF RXHAN BTBCTR, -DSRXLD / LOCAL STORAGE FOR THE BLOCK COUNTER. MSK20, 20 / UNIT MASK BTHALT, HLT / THIS WILL PATCH BTPTCH WPADDR=.-200 / THIS ADDRESS SHOULD BE = LDSTRT IN RXPRDF WPSTRT, RXDRIN / ENTRY POINT TODRIVER SYSTEM INIT LOAD PRX02, 10 / RX02 BIT IN STATUS RESPONSE RELOC / BACK TO NORMAL ORIGIN /***********************************************************************/A032 / /A032 / RX50 BOOT BLOCK TEMPLATE /A032 / TAKEN FROM LOADB8.PA VERSION ??? 16-APR-82 074 /A032 / STRIPPED ALL BEFORE "HACK= " /A032 / THEN STRIPPED ALL COMMENT LINES /A032 / APPROPRIATELY DELETED *ORG STATEMENTS /A032 / AND ADDED RELOC STATEMENTS /A032 / REDEFINED DUPLICATE LABELS WHICH CAUSED PROBLEMS /A032 / /A032 /***********************************************************************/A032 / /A032 / THE FIRST 8 PDP-8 WORDS OF THE BOOT ARE RESERVED FOR /A042 / FOR THE BOOT BLOCK HEADER. THE HEADER WILL BE READ IN /A042 / 8 BIT MODE BY THE ROM. SINCE THE HEADER CANNOT BE WRITTEN /A042 / OUT PROPERLY IN 8 BIT MODE THE BOOT IS FIRST WRITTEN OUT /A042 / IN 12 BIT MODE. THEN THE BOOT IS READ BACK IN IN 8 BIT MODE /A042 / THE BOOT HEADER IS COPIED, AND THE BOOT IS WRITTEN BACK IN /A042 / 8 BIT MODE /A042 / /A042 / SIMON SZETO HAS PROPOSED THE BOOT HEADER STANDARD /A042 / CURRENTLY, IT REQUIRES ONLY 12 BYTES. /A042 / THESE 12 BYTES TRANSLATE INTO ONLY 6 PDP-8 WORDS /A042 / BECAUSE OF THE WAY THE RX50 IMPLEMENTS 12 BIT MODE /A042 / SO, WE ARE PROBABLY WASTING 2 WORDS /A042 / BUT WHATS A FEW WORDS AMONG FRIENDS, EH? /A042 / (I DECIDED TO LEAVE 'EM IN FOR NOW) /A042 RX50BEG, / LABEL FOR BLKMOV /A032 RELOC WPBOOT /A032 RX50BO, / BOOT TEMPLATE, RX50 /A032 / SPACE FOR STANDARD RX50 BOOT HEADER: / THE ACTUAL HEADER MUST BE WRITTEN IN 8 BIT MODE AS /A042 / 12 BIT MODE WRITES TWO CONSECUTIVE BYTES ON THE RX-50 /A042 / 4 BITS OF WHICH ARE INACCESIBLE IN 12 BIT MODE /A042 / THESE LOCATIONS HAVE LABELS AS THEY ARE USED FOR SCRATCH BY THE BOOT 0 / 1ST 12 BIT WORD R5RXID, 0 / 2ND 12 BIT WORD R5TRAK, 0 / 3RD 12 BIT WORD R5LSEC, 0 / 4TH 12 BIT WORD R5SECT, 0 / 5TH 12 BIT WORD R5SCTR, 0 / 6TH 12 BIT WORD 0 / 7TH 12 BIT WORD 0 / 8TH 12 BIT WORD R5TSEC, 0 IFDEF WINNIE < /A065 RXDLDP-201 /M065 R5BFRA, RXDLDP-201 /M065 R5BFRB, RXDLDP-201 /M065 > / END IFDEF WINNIE /A065 IFNDEF WINNIE < /A065 RXDLDP-1 R5BFRA, RXDLDP-1 R5BFRB, RXDLDP-1 > / END IFNDEF WINNIE /A065 R5BFFR, 377 SKPPTR, R5BOOX-1 SKPPTS, BOOT02-1 /WHEN LOC 50 GETS OVERLAYED R5INC, JMP R5PTCH /ONE TIME JMP. ON SUCCESFUL READ ISZ R5XFER /SET DONE RETURN JMP I R5XFER /RETURN R5MORE, DCA I R5BFFR / DEPOSIT DATUM IN CORE. R5EMPT, JMS R5XFER / TRANSFER A DATUM FROM SILO. JMP R5MORE / NOT DONE - REPEAT FOR ENTIRE SECTOR. ISZ R5SCTR / DONE - ALL SECTORS READ ? JMP R5NEXT / NO - READ NEXT. JMP I R5SCND / YES - ENTER SYSTEM BOOTSTRAP CODE. JMPOVR, R5READ RXISDN / DONE ? /M064 JMP R5BOO8 / NO - WAIT FOR READY FIRST. CLA CLL / INSURE AC CLEAR FOR DONE RETURN RXISER /ERROR? /M064 JMP R5INC /NO INC RET SKP /IS ERROR R5PTCH, DCA R5INC /CLEAR JMP ON SUCCESSFUL DONE JMP I JMPOVR /JMP OVER CRITICAL AREA R5SWCH, TAD SKPPTS /SET TO LOC 61 DCA SKPPTR /DO IT DCA R5BOOX /NOP JMP JMP R5BOOX /CONT /REMAINDER OF SECTOR WILL BE OVERLAYED /INDIRECT TO ENABLE PAGE LOAD INTO NEXT /PAGE. FOR RX50 JMS R5BOO7 / TRANSFER A DATUM DCA I SKPPTR-1 / ...AND INSERT IT IN-LINE.1ST TIME TO NEVER NEVER LAND R5BOOX, JMP R5SWCH /INC PTR....ONE TIME THEN CLEARD R5LOCS=.-RX50BO /ACTUAL CORE SPACE USED SO FAR /A032 RELOC / RETURN TO NORMAL ADDRESSING /A032 RELOC BOOT02-7 /A032 R5XFER, / ENTRY POINT TO "R5XFER". R5BOO7, / ### ENTRY POINT TO "READ" SUBROUTINE. ### RELOC / RETURN TO NORMAL ADDRESSING /A032 RELOC BOOT02-6 /A032 R5BOO8, / CONTROLLER READY ? RELOC / RETURN TO NORMAL ADDRESSING /A032 RELOC BOOT02-1 /A032 R5BOO0, / LINKAGE WITH ALTERNATE SECONDARY BOOT. RELOC / RETURN TO NORMAL ADDRESSING /A032 RELOC BOOT02 / 200-ENREAD /A032 R5READ, CLA CLL IAC RAL /=2 SET CMND FOR READ TAD R5BOO0 /GET DISK READ DCA R5CMND / ......DENSITY BIT IN COMMAND WORD CMA /-1 RX50 SECTOR COUNT DCA R5SCTR / ............THE CORRECT SECTOR COUNT. IAC / CALCULATE THE PROPER (SD OR DD) DCA R5SECT / ......PHYSICAL SECTOR NUMBER.(1) JMP I R5SCND /RX50 BOOT IN START LOAD R5NEXT, AC0004 / SET THE PHYSICAL I/O BIT TAD R5CMND / ...AND SUBMIT COMMAND TO CONTROLLER. RXILCD /M064 AC0003 / LOAD SECTOR # TO READ TAD R5SECT / ...INCREMENT IT BY INTERLEAVE JMS R5XFER / ......SUBMIT IT TO CONTROLLER DCA R5SECT / .........AND SAVE IT AGAIN CLA CLL IAC / LOAD "BOOT" TRACK NUMBER,... JMS R5XFER / ...AND SUBMIT IT TO CONTROLLER ALSO. JMS R5XFER / WAIT FOR CONTROLLER "DONE" R5SCND, R5W2BO / R5DENS, 400 /=400 FOR RX01 USED AS DENSITY BIT ALSO TAD R5CMND / GET "EMPTY SILO" COMMAND RXILCD / ...AND SUBMIT IT TO CONTROLLER. /M064 JMP R5EMPT / GO EMPTY THE SILO R5CMND, 22 /BITS=DD,UNIT#,READ 0 /STATUS SAVED HERE R5LOCS=R5LOCS+.-R5READ /UPDATE NUMBER OF ACTUAL LOCS USED /A032 RELOC / RETURN TO NORMAL ADDRESSING /A032 RX50MID, / LABEL FOR BLKMOV /A032 RELOC 200 R5W2BO, AC0001 / JMS R5TTY /TYPE A=GOT IN THIS FAR TAD R5HALT / PUT A HALT INSTRUCTION AT THE END DCA R5PTCH / ...OF THE ERROR BRANCH AC0002 / JMS R5TTY /B=UNIT 0 OK TAD R5CMND / LOAD COMMAND FROM PRIMARY BOOT. AND R5DENS /400 SNA CLA /IS SD OR DD IAC BSW /100 =MODE BIT FOR SD DCA R5RXID /0=DD TAD PRX02R /DO A REQUEST FOR STATUS TAD R5CMND /ADD DENSITY RXILCD / ... /M064 RXISDN /M064 JMP .-1 / WAIT FOR DONE. RXIXDR / GET STATUS RESPONSE. /M064 AND PRX110 / ISOLATE THE RX02 BIT. SNA CLA / SKIP IF RX02 (RX28 DRIVE). DCA R5LCM2 / ZAP THE RX02 LCD 2ND XFR COMMAND. TAD R5RXID / 0=DD 1=SD TAD R5CMND / ...COMMAND WORD. DCA R5CMND TAD ISRX50 SZA CLA JMP ISA50 /LOG BLOCK = LOG SECTOR IF 50 TAD R5RXID / LOAD THE DENSITY PARAMETER SZA CLA / ......DOUBLE DENSITY ? TAD R5BLKN / NO - MAKE IT 3*BLOCK NUM TAD R5BLKN / YES - MAKE IT 2*BLOCK NUM ISA50, TAD R5BLKN DCA R5LSEC / ......AND SAVE IT. R5NXTB,/--------------------------------------------------------------------- CLA CLL CMA / (DN) SET SECTOR COUNT =-1 DCA R5SCTR R5DYNX, JMS R5PHYS / EFFECT A "READ SECTOR" OPERATION. SKP / ENTER THE "MERGE" LOOP R5DYRD, DCA I R5BFRB / SAVE WORD IN BUFFER. TAD I R5BFRA / LOAD CURRENT CONTENTS OF BUFFER. JMS R5XFER / LOAD A DATUM. /#(8 BIT MODE => INCLUSIVE OR INTO BITS 4-11) /#(12 BIT MODE => JAM XFER BITS 0-11) JMP R5DYRD / (TR) CONTINUE FETCHING DATA CLA CMA /-1 TAD R5BFRA /RESET PTR TO LAST CHAR DCA R5BFRA /RESTORE ISZ R5SCTR / (DN) ALL SECTORS PROCESSED ? JMP R5DYNX / NO - PROCESS NEXT. ISZ R5BCTR / YES - ALL BLOCKS PROCESSED ? JMP R5NXTB / NO - DO ANOTHER BLOCK. AC0003 / JMS R5TTY /C=LOADER GOT IN OK TAD R5CMND AND R5MSK2 /MASK OUT UNIT NO SZA CLA /0=UNIT 0 DOCSKP=. /RXPRDF LDNOP SHOULD BE EQUAL THIS ADDRESS JMP I R5DMSG /NOT UNIT 0 JMP I R5STRT / YES - START SYSTEM. R5TTY, 0 TAD R5P100 / MAKE ASCII. TLS TSF /WAIT TILL DONE JMP .-1 CLA JMP I R5TTY /RETURN R5DMSG, DCSTRT /START ADDRESS OF MESSAGE R5PHYS, 0 CLA IAC /TRACK ==1 DCA R5TRAK /SET IT TAD R5LSEC /LOGICAL SECTOR RAL /*2=INTERLEAVE FOR RX50 DCA R5TSEC /TEMP SECTOR(*2) HOLD TAD R5TSEC TAD R5DVSR /-10 SPA CLA /IS<10 JMP R5DIV1 /YES IAC /=1 TAD R5DVSR / R5DIV1, TAD R5TSEC /SET SECTOR IAC DCA R5SECT /SET IT AC0004 / SET "PHYSICAL" BIT JMS R5LCMD TAD R5SECT / () GET PHYSICAL SECTOR JMS R5XFER / () ...AND SEND IT CLA / (TR) "RXIXDR" DOESN'T CLEAR AC /M064 TAD R5TRAK / (DN) GET PHYSICAL TRACK JMS R5XFER / ...AND SEND IT JMS R5XFER / (TR) WAIT FOR CONTROLLER DONE 7400 / (DN) (TR) (SPARE) JMS R5LCMD ISZ R5LSEC / BUMP LOGICAL SECTOR FOR NEXT TIME JMP I R5PHYS / EXIT FROM PHYSICAL I/O ROUTINE R5LCMD, 0 TAD R5CMND RXILCD /M064 TAD R5RXID SZA CLA /SD SB=100 DD/RX02=0 R5LCM2, JMS R5XFER CLA JMP I R5LCMD /--------------------------------------------------------------------- R5P100, 100 R5DVSR, -12 / LOCAL STORAGE FOR THE TRACK/SECTOR CONSTANT. R5BLKN, DLRXLD / STARTING BLK OF RXHAN R5BCTR, -DSRXLD / LOCAL STORAGE FOR THE BLOCK COUNTER. R5MSK2, 20 /UNIT MASK RELOC / RETURN TO NORMAL ADDRESSING /A032 R5W2ND, / LABEL FOR BLKMOV /A032 RELOC LDSTRT WPADDR=. /THIS ADDRESS SHOULD BE = LDSTRT IN RXPRDF IFNZRO WPADDR-LDSTRT R5STRT, RXDRIN / ENTRY POINT TODRIVER SYSTEM INIT LOAD R5HALT, HLT / THIS WILL PATCH R5PTCH PRX02R, 10 /RX02 BIT IN STATUS RESPONSE PRX110, 110 /CHECK RX02 OR RX50 BIT ISRX50, 1 /SET FOR RX50 LOADER, CLEAR FOR RX01/RX02 RELOC / RETURN TO NORMAL ADDRESSING /A032 EJECT /******************************************************************* /TAKEN FROM WINNIE BOOT 11/23/83 /TITLE WINBOOT 11/23/83 / /COMMAND CODES WINMNT=CLA /0=MOUNT VOLUME WINSTB=CLA CLL IAC /1=SET BLOCK WINFIL=CLA CLL IAC RAL /2=FILL BUFFER WINWRT=CLA CLL CML IAC RAL /3=WRITE WINRD=CLA CLL IAC RTL /4=READ WINDIS=5 /5=DISMOUNT VOLUME WINUPD=CLA CLL CML IAC RTL /6=UPDATE VOLUME WINEMT=25 /EMPTY BUFFER WINSTA=26 /26=READ STATUS WINERS=27 /27=READ ERROR STATUS WINVOL=30 /30=GET VOLUME DATA WINDIR=33 /33=GET VOLUME DIRECTORY / / TRANSFER COMMAND + 1 FOR DONE FOR COUNTS / SETCNT=4 /SET BLOCK COUNT DISCNT=2 /DISMOUNT COUNT MNTCNT=12 /MOUNT COUNT WNBOOT=200 /A074 WINBEG, /A074 RELOC WNBOOT /A074 WINPTR=WNBOOT /TEMP POINTER AREA RDCNT=WINPTR+1 /TRANSFER COUNT PRTPTR=RDCNT+1 ZBLOCK 10 /BOOT ID / / /COMES HERE IF A WINNIE / WINSTR, JMS PRINT WPSLOAD /LOADING MESSAGE / / /READ A RECORD / RDREAD, TAD M4 DCA RDCNT /SET TRNSFER COUNT TAD CMDPTR DCA WINPTR WINSTB /SET BLOCK CMND JMS TRLOOP /TRANSFER WINRD /SET UP READ CMND RDSC /SEND IT RDRD1, JMS RDXFER /CHECK DONE AND SWAP IF NOT JMP TRNERR /GOT TRANSFER INSTEAD OF DONE SKP /DONE JMP TRNERR /ERROR TAD WINEPT /SET UP EMPTY BUFFER JMS RDCMPT /EMPTY OR FILL ISZ LOBLK /BLOCK NUM ISZ RZBLKN /# BLOCKS TO LOAD JMP RDREAD /DO NEXT BLOCK TAD WINCOD /4001 = WINNIE MOUNTED DRIVE 0 JMP I WNSTRT / / /RDXFER USED TO CHECK AND RETURN / CALL+1 = TR READY / CALL+2 = DONE / CALL+3 = ERROR / / RDXFER, 0 RDXFRA, RDSR /SKIP TR READY SKP JMP I RDXFER /TR READY RDSD /SKIP IF DONE FLAG SET JMP RDXFRA /CHECK TR READY ISZ RDXFER /SET RET RDSE /SKIP ERROR JMP I RDXFER /DONE RET ISZ RDXFER /SET ERROR RET JMP I RDXFER /************************************************************ / /SET BLOCK FUNCTION / / / /EMPTY BUFFER COMMAND SET UP / / / /TRLOOP WILL SEND REMAINING TRANSFERS BASED ON RDCNT TRLOOP, 0 RDSC /SEND IT TRNCHK, JMS RDXFER /CHECK DONE JMP TRANOK /TR RDY ISZ RDCNT /IS DONE--WAS LAST TR? JMP TRNERR /TRANSFER ERROR JMP I TRLOOP /OK TRANOK, RD1SET, CDFSYS TAD I WINPTR /GET WORD TO BE TRANSFERED CDFSYS RDTD /TRANSFER IT ISZ WINPTR ISZ RDCNT JMP TRNCHK /MORE TO TRANS JMP TRNERR /PREMATURE END / / /EMPTY BUFFER ROUTINE / AFTER READ / /******DON'T FORGET CDF'S********* / RDCMPT, 0 RDSC /SEND IT RDCNXA, JMS RDXFER JMP RDCNXT /NEXT CHAR JMP I RDCMPT /DONE JMP RDERROR RDCNXT, RDENXT, RDTD /RECIEVE DATA RD2SET, CDFSYS DCA I RDBUFO /GET CHAR CDFSYS RDCCNT, ISZ RDBUFO NOP /FOR WRAP AROUND BUFFER JMP RDCNXA /FOR FIELD LOOP / /TRANSFER ERROR= DONE OR TR FLAG OUT OF SEQ /*****MUST GET ALL 4 WORDS****CHANGE WINSTA / RDERROR, WRTERROR, TRNERR, JMS PRINT ERRMES /=ERROR JMP . /HANG PRINT, 0 TAD I PRINT ISZ PRINT / DCA PRTPTR PRTA, TAD I PRTPTR SNA JMP I PRINT TLS TSF JMP .-1 CLA CLL ISZ PRTPTR JMP PRTA CR=15 LF=12 WPSLOAD, CR LF "W&177 "P&177 "S&177 " &177 "l&177 "o&177 "a&177 "d&177 "i&177 "n&177 "g&177 ".&177 0 /TERMINATOR ERRMES, CR LF "H&177 "A&177 "R&177 "D&177 " &177 "D&177 "I&177 "S&177 "K&177 " &177 "E&177 "R&177 "R&177 "O&177 "R&177 0 /TERMINATOR / / CMNDBF=. /COMMAND BUFFER START WRD1, 0 /BOOT DRIVE NUMBER(0) WRD2, LOBLK, DLRXLD /STOREAGE OF THE L/O BLK FOR I/O WRD3, HOBLK, 0 /STOREAGE OF THE H/O BLK FOR I/O RZBLKN, -DSRXLD /- COUNT OF BLOCKS TO BE READ RDBUFO, RXDLDP-200 /POINTER TO BUFFER AREA FOR WINNIE WINEPT, WINEMT /SET EMPTY BUFFER /A074 RELOC LDSTRT WPADDR=. /THIS ADDRESS SHOULD BE = LDSTRT IN RXPRDF WNSTRT, RXDRIN /START LOAD /A074 CMDPTR, CMNDBF /COMMAND BUFFER /A074 M4, -4 /A074 WINCOD, 4001 /H/O BIT=WINNIE L/O BIT=MOUNTED WNLOCS=.-WINBEG /SIZE TO BE WRITTEN OUT /A074 RELOC / RETURN TO NORMAL ADDRESSING /A074 IFDEF ITALIAN < PAGE / I DO NOT UNDERSTAND THE WAY THIS MODULE IS PUT / TOGETHER, BUT IT MEANS THAT, AS THE ITALIAN TEXT / TRANSLATION IS SHORTER THAN THE ENGLISH, A PAGE / IS REQUIRED HERE > IFDEF V30NOR < PAGE /A086 > IFDEF V30SWE < PAGE > / THIS IS THE RX50 BOOT HEADER FOR WPS IN 8 BIT FORMAT: /A042 R5BHDR, /A042 0 / BYTE 00 TYPE 2 BOOT BLOCK /A042 0 / BYTE 01 TYPE 2 BOOT BLOCK /A042 2 / BYTE 02 POINTER TO SECOND SECTION /A042 / (1/2 ACTUAL VALUE IN BYTES) /A042 1 / BYTE 03 1=SYSTEM, 0=DOCUMENT DISKETTE /A042 / SECOND SECTION: /A042 10 / BYTE 04 PDP-8 INSTRUCTION SET /A042 10 / BYTE 05 RX278 CONTROLLER /A042 10 / BYTE 06 WPS-8 OPERATING SYSTEM /A042 347 / BYTE 07 CHECKSUM SO BYTES 4,5,6,7 TOTAL 377 /A042 0 / BYTE 10 FILLER /A042 1 / BYTE 11 SINGLE SIDED, REV 1 OF BOOT STD /A042 R5BHSZ=.-R5BHDR / CALCULATE SIZE OF HEADER FOR BLKMOV /A042 RELOC DECIMAL /A066 RXMAP, 0; 5; 1; 6; 2; 7; 3; 8; 4; 9 / RX50 SECT TO RD50 BLOCK MAP /A066 RDMAP, 0; 7; 14; 5; 12; 3; 10; 1; 8; 15; 6; 13; 4; 11; 2; 9 /A066/C067 OCTAL / MAP CHANGED TO REFLECT AN INTERLEAVE /A067 / OF 7 WHICH IS THE ACTUAL WINNIE /A067 / /****DRVTST MOVED VER 075**************** /***********************************************************************/ / / / DRVTST--SKIP IF EITHER DRIVE IS DRIVE ZERO AND 0 NOT=WINNIE VOL./ / CALLING SEQUENCE: / / JMS DRVTST /SKIP IF EITHER DRIVE IS DRIVE 0 / / JMP SOMEPLACE /RETURNS HERE IF NEITHER / / ... /RETURNS HERE IF EITHER, OR 0=WINNIE / / MENU MUST CHECK THAT DRIVE NUMBERS ARE DIFFERENT / / ROUTINE ADDED V033 / / / /***********************************************************************/ DRVTST, XX TAD K20 /BIT 7=DRIVE 0=VOL /A075 CDFMNU /A075 AND I MNUPTR /PTR TO MNOPTION /A075 CDFMYF /A075 SZA CLA /DRIVE 0 = WINNIE? /A075 JMP I DRVTST /YES EXIT /A075 TAD DRVDST SNA CLA ISZ DRVTST TAD DRVSRC SNA CLA ISZ DRVTST JMP I DRVTST MNUPTR, MNOPTN+MUBUF /POINTER TO OPTION WORD /A075 K20, MNRX4X /20=7 BIT=WINNIE DRIVE 0 VOL /A075 /FMTSET--- SETS RXQSR1 TO THE NUMBER OF BLOCKS TO BE READ INTO / THE BUFFER AREA----WILL SET TO 10 BLOCKS TO FILL THE /...............FIELD IF THERE ARE ENOUGH BLOCKS REMAINING BETWEEN /...............THE END OF THE AREA AS SPECIFIED IN AC(-) UPON ENTRY /...............OR 10, WHICHEVER IS LESS / BLKCON=12 /READ FULL TRACK RX50 /A078 FMTSET, 0 /A078 TAD FMTQBK+RXQBLK /LAST BLOCK READ /A078 DCA BLKSAV /SAVE END BLOCK NUM /A078 TAD (-BLKCON /CHECK 1ST TIME /A078 TAD FMTQBK+RXQBLK /LAST BLOCK READ /A078 SPA /IS FIRST TIME? /A078 JMP FMTSE3 /YES-SET TO READ REST OF TRACK /A078 CLA /A078 TAD (BLKCON /NO BLOCKS TO FILL FIELD /A078 TAD BLKSAV /-# REMAINING TO BE PROCESSED /A078 SPA CLA /IS G.T. # REMAINING /A078 JMP FMTSE2 /NO SET TO 20 /A078 TAD BLKSAV /YES TO TO # REMAINING /A078 SKP /A078 FMTSE2, TAD (-BLKCON /A078 FMTSE3, DCA FMTQBK+RXQRS1 /SET BLOCK COUNT /A078 JMP I FMTSET /A078 BLKSAV, -BLKCON /# BLOCKS TO PROCESS NEXT /A078 OCTAL /A066 /CHECK VALID BLOCK NUMBER /A083 /THIS CHECK TO ALLOW FOR COPYING /A083 /..VOLUME SIZES LESS THAN SIZE OF FLOPPY /A083 /CODE NECESSARY TO ALLOW PARTIAL BLOCKS TO BE READ IN HARD DISK VOLUME/A083 /..PHYSIO COPIES IN BLOCKS OF 10 WHEN COPYING FROM WINNIE TO FLOPPY /A083 /...LEAVING A REMAINDER AT TIMES THAT VOLUME IS NOT MODULO 10 /A083 /... INTERLEAVE ALGORITHM WOULD THEN TRY TO READ BLOCKS GREATER THAN /A083 /....VOLUME SIZE. THIS CODE CAUSES ERROR RETURN WHEN ILLEGAL BLOCK /A083 /....REFERENCED. /A083 /-----------------------------------------------------------------------/A083 /WHEN COPYING FROM H.D. TO FLOPPPY THE RXMAP TABLE IS USED /A083 /...THIS MAP CONTAINS THE NUMBER OF TRACKS ON THE FLOPPY /A083 /....IT IS USED EVEN THOUGH THE SOURCE MAY BE VOLUME ON THE H.D. /A083 /..... THE BACKUP THEN CONTINUES TO COPY USING THIS 80 TRACK PARAMS. /A083 /...... TO TERMINATE THE BACKUP....THIS ROUTINE ALTHOUGH IT WORKS /A083 /...... WILL BE CALLED UNTILL THE NUM TRACKS ON THE FLOPPY HAVE BEEN /A083 /....... EXAUSTED.. NO PHYSICAL I/O WILL BE PERFORMED IF THE NUM OF /A083 /....... TRACKS ON THE H.D. HAS BEEN EXCEEDED... /A083 /....... DURING THE BACKUP AFTER SETPAR HAS BEEN CALLED /A083 /....... IF THE NUMBER OF TRACKS ON THE SOURCE DEVICE OVERLAYS THE NUM /A083 /....... OF TRACKS IN THE TABLE .. THE THIS SHOULD ELIMINATE THE XTRA /A083 /....... PROCESSING.. MOVE SRCSZE TO TRKMXK.... /A083 /....... THIS MOVE AT THE PRESENT TIME WILL NOT BE PUT INTO THE /A083 /....... AS WE ARE READY TO SHIP AND TESTING MAY NOT BE SUFFICIENT. /A083 / /------- THIS MESSAGE COURTESY OF DFB ---------------------------- /A083 CKBLNM, 0 /CHECK VALID BLOCK NUMBER /A083 TAD I T3 / NOW HAVE BLOCK # FOR THIS SECTOR /M083 TAD SVBLOC / ADD IN BLOCK WE STARTED AT /M083 DCA FMTQBK+RXQBLK / AND THIS IS THE BLOCK WE MUST R/W/V /M083 TAD WINSRC /CHECK SOURCE /M085 SNA CLA /IS IT WINNIE? /M085 JMP CKBLN1 /NO--CHECK NOT NECESSARY /M085 TAD FMTQBK+RXQBLK / /M083 CIA /A083 TAD SRCSZE /NUM BLOCKS IN SOURCE-NUM BLOCK TO BE READ/A083 SMA SZA CLA /IS ILLEGAL BLOCK? /A083 CKBLN1, /A083 ISZ CKBLNM /NO SKIP ERR RET /A083 JMP I CKBLNM /RET /A083 /-------------------- PAGE /+/+/ /+/+/ ____________________________________________________________ /+/+/ ALL MENU CODE WAS EDITED AND MADE A PART MN1 WITH EDIT 073 /+/+/ ------------------------------------------------------------ /+/+/ / /CKDKSZ CHECKS SIZE OF SOURCE AND DEST. DEVICES /A074 /IF SOURCE DEVICE IS G.T. DEST. DEVICE(NUMBER TRACKS) /A074 / ........ERROR RET.... /A074 / ELSE .....RET +1 /A074 / CKDKSZ, 0 /A074 TAD SRCSZE /GET SIZE OF SOURCE /A074 SNA /=RX50? /A074 DECIMAL TAD (79 /YES..SET # TRACKS TO COPY /A074 OCTAL CIA / /A074 DCA PARTBM /SET - NUM. TRACKS TO PROCESS /A074 TAD SRCSZE /IF SIZE=0 NON WINNIE /A074 JMS GETSZE /GET # BLOCKS /A074 DCA SRCSZE /A074 TAD DSTSZE /IF SIZE=0 NON WINNIE /A074 JMS GETSZE /GET # BLOCKS /A074 DCA DSTSZE /A074 CKDKS2, /A074 TAD SRCSZE /SOURCE SIZE /A074 CLL CMA CML IAC /SET NEG /C075 TAD DSTSZE /DEST SIZE /A074 SNA /ARE SOURCE AND DEST = /A074 JMP CKDKS7 /YES /A074 SNL /IS DEST G.T.SOURCE /C075 JMP CKDKS3 /YES /A074 CLA /A074 JMP FMTWER /A074 NOP /A074 CKDKS3, DCA CKDIF /A074 CIFMNU /A074 JMS I IOACAL /PRINT MESSAGE DESTG.T. SRCE /A074 0 /A074 TEXTDK /MESSAGE /A074 1305 /LINE 13 COL 05 /A074 DEVDST /PTR TO "DRIVE" "AREA" STRING /A074 IFNDEF ITALIAN < MEDDST /PTR TO "DISKETTE" "VOLUME" STRING /A074 CKDIF /PTR TO DIFFERENCE /A074 > IFDEF ITALIAN < CKDIF MEDDST > NOP /A074 NOP /A074 JMS FMTWTY /PRINT "ENTER CR OR G.M." /A074 JMP CPYDS2 /RET TO G.M. /A074 JMS TIMMSG /CLEAR AND PRINT TIME /A074 /C.R.--CONTINUE /A074 CKDKS7, /A074 ISZ CKDKSZ /SET NORMAL RET /A074 JMP I CKDKSZ /A074 / / /***********************************************************************/A066 DECIMAL /A074 MAXTRK=2000%16 /MAXIMUM TRACKS=BLKS/16 FOR WINNIE=2000/16/A074 MINTRK=800%16 /MINIMUM NUMBER WINNIE=800/16 /A074 DOCTRK=256%16 /MINIMUM NUMBER TRACKS FOR DOC INIT /A074 OCTAL /A074 /***********************************************************************/A066 /CKASGN CHECKS DEVICE NO AS SPECIFIED IN AC ON ENTRY /DETERMINES DEVICE TYPE AND SIZE IF WINNIE AND RETURNS /FOLLOWING CODES IN AC / / 0 = RX01/RX02/RX50 / 1 = VOLUME SIZE BETWEEN 800 AND 2000 BLOCKS / 2 = VOLUME SIZE BETWEEN 2000 AND 4096 BLOCKS / 3 = VOLUME SIZE BETWEEN 256 AND 800 BLOCKS / 4 = VOLUME SIZE 800 BLOCKS EXACTLY(SPECIAL CASE) / -1 = WINNIE NOT ASSIGNED / -2 = WINNIE VOLUME LESS THAN 256 BLOCKS / -3 = WINNIE VOLUME GREATER THAN THAN 4096 BLOCKS /***********************************************************************/A074 CKASGN, XX /A066 DCA FMTQBK+RXQDRV / PUT DRIVE # IN Q-BLK /A076 TAD (-10 /DEV 8 OR 9 MUST BE RX /A076 TAD FMTQBK+RXQDRV /CHECK FOR DEVICE G.T. 7 /A076 SPA CLA /SKP=8 OR 9, WINNIE BOOT CAN'T DO GET VOL/A076 JMS FMTGTV /GET VOLUME DATA DRV IN AC /C076 JMP CKASFL / UNASSIGNED - GO SEE IF DRIVE 1 /A066 TAD FMTQBK+RXQBAD / GET BUFFER ADDRESS /A066 TAD (15) / ADD IN AREA SIZE OFFSET-1 /A066 DCA X0 / SAVE FOR AUTOINDEX LOAD /A066 CDFMYF+10 / CHANGE TO BUFFER FIELD /A066 TAD I X0 /GET L/O /A074 DCA WINTRK /NUM WINNIE TRACKS IN VOLUME /A074 TAD I X0 /GET H/O /A074 SZA CLA /A074 JMP STCDM3 /VOLUME G.T. 4096 BLOCKS /A074 TAD WINTRK /A074 TAD (-DOCTRK /=256? /A074 SPA /A074 JMP STCDM2 /<256 BLOCKS /A074 TAD (DOCTRK-MINTRK /A074 SNA /=800 BLOCKS EXACTLY? /A074 JMP STCDP4 /YES /A074 SPA /A074 JMP STCDP3 /G.T 256 OR L.T. 800 BLKS /A074 TAD (MINTRK-MAXTRK /A074 SMA CLA /L.T. 2000 AND G.T. 800 BLOCKS /A074 JMP STCDP2 /NO /A074 JMP STCDP1 /YES /A074 CKASFL, TAD FMTQBK+RXQDRV / IF UNASSIGNED DEV# 1 IS A FLOPPY (V1.5/A066 TAD DENDV0 /POINTR TO START OF ACP DEV TABLE /A074 DCA DENPTR /SAVE POINTER TO DEN/DEV CODE /A074 CDFACP /SET TO ACP FIELD /A074 TAD I DENPTR /GET CODE /A074 CDFMYF /A074 SMA CLA /0 BIT SET =WINNIE /A074 JMP I CKASGN /NOT SET = RX DEVICE /A074 STCDM1, /NOT ASSIGNED /A074 AC7777 /A074 JMP CKZRET /A074 STCDM2, AC7776 /L.T. 256 BLOCKS /A074 JMP CKZRET /A074 STCDP2, AC0001 /2=G.T. 2000 /A074 STCDP1, IAC / AC=1 WINNIE AREA ASSIGNED & SIZE OK /A066 JMP CKZRET /A074 STCDP3, AC0003 /SIZE G.T. 256, L.T. 800 /A074 JMP CKZRET /A074 STCDP4, AC0004 /800 BLOCKS EXACTLY /A074 JMP CKZRET /A074 STCDM3, AC7775 /G.T. 4096 /A074 CKZRET, /A074 CDFMYF / CHANGE BACK TO OUR FIELD B4 WE GO /A066 JMP I CKASGN / /A074 / V1.5 MINIMUM SIZE =800 BLOCKS/16 BLOCK/A066 / -- ALLOCATION FACTOR = 50 /A066 DENDV0, RXSTRT+1 /POINTER TO DEV TABLE IN ACP /A074 DENPTR, 0 /TEMP PTR /A074 WINTRK, 0 /NUM TRACKS IN WINNIE VOLUME /A074 / / / CKDIF, 0 /DIF BETWEEN SOURCE AND DEST(TRACKS) /A074 /***********************************************************************/ / / / FMTHAB FORMAT THE DIRECTORY AND ALLOCATION BLOCKS / / STDBSW AND DSBLKC MUST BE SET UP BEFORE CALL / / / /***********************************************************************/ FMTHAB, XX / DO DIRECTORY AND ALLOCATION BLOCKS /A045 /D082 JMS CLBUF / CLEAR THE BUFFER /A046 JMS FMTDIR / GO SET UP DIRECTORY BLOCK HEADER /A031 AC0002 / LOAD BLOCK NUMBER FOR DIR BLOCK /A031 DCA FMTQBK+RXQBLK JMS FMTQRX / GO WRITE THE DIRECTORY BLOCK JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 / NOW DO THE ALLOCATION BLOCK /A044 /D082 JMS CLBUF / CLEAR FMTBUF /A031 JMS STDBL / GO SET UP ALLOC BLOCK /A014 /M031 TAD P377 / GET THE BLOCK # OF THE ALLOC BLOCK /M031 DCA FMTQBK+RXQBLK JMS FMTQRX JMP FMTER / ERROR--GO DISPLAY MESSAGE; WAIT FOR GM/A045 JMP I FMTHAB / RETURN IFZERO .&4000 FIELD CDFMYF&70+10 / BUFFER FIELD /A042 *0000 / THE WHOLE FIELD! /A042 FMTBUF, / IS THE BUFFER /A042   /CPYFIL (COPY FILE) MAINTENCE COMMAND TO COPY DOCUMENTS / .VERSION / / / / COPYRIGHT (C) 1983 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: GEORGE PANOS CREATION DATE: OCTOBER 31,1981 / /-- / /************************************************************************ / EDIT HISTORY /*************************************************************************** / / 046 EMcD 11-Sep-85 Add Nordic translations / conditionalised / 045 MART 02-AUG-85 FIX ITALIAN assembly bugs / 044 EJL 12-OCT-84 fix COPY ONE, COPY ALL copying / wrong file / 043 WCE 18-SEP-84 Change #'s to NUMBER in text messages / 042 DFB 24-AUG-84 Fix bug due to hard wired references / 041 WJY 07-AUG-84 Change "Not enough room..." error message / to reflect the possibility of a non-init / diskette (volume). Bug WPSV2-96. / 040 WCE 30-OCT-83 CHANGED CHRCNT TAG TO CHARCT / 039 WJY 27-SEP-83 DM II V1.5 WINCHESTER SUPPORT / *note* The term area has been replaced / by device. Since device is already used / in another context, I left the term area / in the comments & only changed TEXT statements / 038 HLP 23-SEP-83 Fix bug induced V10J when copy one by / number it thinks has no name / 037 HLP 01-SEP-83 QAR EZ-59 number over 200 in index doc / GENERAL CLEANUP & SOME RECONSTRUCTION / THRU TO SAVE SPACE FOR THE ABOVE FIXES / ADDED SCREEN FOR ILLEGAL DOCUMENT NUMBER / 19-SEP-83 REWORDED SCREEN TO SHOW THAT TYPING RETURN / TO A NUMBERED DOCUMENT ASSIGNS A NEW NUMBER / 036 HLP 07-SEP-83 Replace SOTFL with 100; VALUE, thus / eliminating the need for WPSRDF / in MASTER.INF / 035 WCE 19-JUL-83 Modify labels for new prefix file / 034 DFB 26-MAY-83 Fix copy one doc msg / 033 DFB 19-MAY-83 Fix to pass TBOE menu when input drive / =output drive. Go to "E"nter / 032 GJP 12-JAN-83 save and restore names of documents / when user types command keys when / copying docs and no room on diskette / 031 GJP 22-DEC-82 CAN'T COPY NUMBERED DOC BUG / 030 AIB 14-DEC-82 conditionalize "Rubout key" messages / 029 GJP 10-DEC-82 Clear out default drive and document / number upon returnn to Main Menu / 028 GJP 30-NOV-82 MAKE SURE WE'RE REPLACING DRIVE 0 / 027 GJP 29-NOV-82 TYPING GARGAGE HAS NO MEANING / 026 GJP 23-NOV-82 ERASE LINE FROM SCREEN ON ERROR / 025 GJP 18-NOV-82 FIX COPY ONE BY NUMBER / 024 GJP 17-NOV-82 REMOVE NOMEANING BUG (TOO LONG) / 023 GJP 12-NOV-82 FIX 'THEN PRESS RETURN' BUG / 022 GJP 10-NOV-82 CAN'T FIND DOC NAME AFTER HITTING GOLD KEYS / 021 GJP 09-NOV-82 FIX UP COSMETIC MESSAGES / 020 GJP 5-NOV-82 FIX SCREWS UP INDEX DOC ON COPY ONE / 019 GJP 26-OCT-82 FIX BUG THAT WILL NOT COPY NUMBERED DOC / 018 GJP 22-OCT-82 NO DISKETTE IN DRIVE-WRONG MESSAGE / 017 GJP 21-OCT-82 FIX UP ERROR MESSAGES / 016 GJP 21-OCT-82 REMOVE ADDITIONAL LINE ON ERROR MESS / 015 GJP 21-OCT-82 FIX ERASURE OF VALUE IN INBUF / 014 GJP 20-OCT-82 FIX WON'T OVERWRITE WITH LESS THAN 8-BLOCKS / 013 GJP 20-OCT-82 FIX ERASURE OF NAME ON WRONG INPUT / 012 GJP 10-OCT-82 FIX PRES RETURN TO RECALL MAIN MENU BUG / 011 GJP 05-OCT-82 FIX GOLD MENU RETURN / 010 AIB 29-SEP-82 changed RUB CHAR, RUB WORD to Rubout / 009 GDH 30-MAR-82 (another) fix to CREATE ordering. / 008 DFB 26-MAR-82 Write out dir block after copy / 007 GJP 22-MAR-82 Put code to display name to user / 006 GJP 19-MAR-82 Fixed no-name in index bug / 005 GDH 11-MAR-82 Fixed "create" ordering. / 004 GJP 2-MAR-82 FIX COPY ALL BAD FILE NAME BUG / 003 GJP 28-FEB-82 MAKE ROOM FOR ADDITIONAL FUNCTIONALITY / 002 GDH 08-JAN-82 Implemented "read error detection". / 001 PHA 21-JAN-82 CORRECTS LOSS OF HDR INFO DURING COPY / WRITE OUT COPY FILE UTITLITY FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLCPFL;100;CDF 30;-17 0 / CPYFIL.PA - COPY FILE UTILITY FIELD 3 /D036 *SOTFL *100 / THE FIRST 100 LOCATIONS CONTAIN COMMON SYSTEM CONSTANTS / (E.G. P177, ETCETERA.) VALUE, 0 TABLE, 0 / AREA TO SUPPORT DECIMAL CONVERSION DPREC, 0 / DECIMAL CONVERSION PRECISION COUNT FOR DEC CONVERT DPREC1, 0 / SIGNIFICANCE STARTER FOR DECIMAL CONVERSION RTNE CDFMYF=CDFEDT / BELOW ARE A BUNCH OF SAVE AREAS USED BY THIS PROGRAM STATUS, 0 / STATUS OF THE DOCUMENT. 0=EXISTS, -1=DOESN'T EXIST CPYCHR, 0 / HOLDS THE CHARACTER BEING COPIED WHEN / CHECKING FOR GOLD HALT. OPTION, 0 / OPTION THE USER WANTS, TOP,BOTTOM,OVERWRITE / -1=OVERWRITE DOC, 0=WRITE TO TOP, 1=WRITE TO BOTTOM SVIDCN, 0 / HOLDS THE INPUT DOCUMENT NUMBER SVODCN, 0 / HOLDS THE OUTPUT DOCUMENT NUMBER SVIFNO, 0 / FILE ID OF INPUT, DRIVE + FILE NO SVOFNO, 0 / FILE ID OF OUTPUT SVISIZ, 0 / SIZE OF INPUT DOCUMENT SVOSIZ, 0 / SIZE OF OUTPUT DOCUMENT TODRV, 0 / HOLDS THE DRIVE NUMBER WE'RE COPYING TO FROMDR, 0 / HOLDS THE DRIVE NUMBER WE'RE COPYING FROM OSXTY, 60 / TO MAKE ASCII NUMBERS WITH DISKID, 0 / HOLDS THE DISK ID OF THE SYSTEM DISKETTE RSIGN, 0 / HOLDS THE SIGNAL THAT WE WANT TO COPY BY NAME ONLY COPYTP, 0 / HOLDS THE TYPE OF COPY WE'RE DOING / 1=COPY ONE, 2=COPY SOME, 3=COPY ALL SIGNL, 0 / SIGNAL TO TELL US WE'RE DOING NUMBERED DOCUMENTS DRVNBR, 0 / SAVE DRIVE NUMBER WHEN DOING COPY ONE DCNBR, 0 / SAVE THE DOCUMENT NUMBER WHEN DOING COPY ONE PERIOD, 56 / A PERIOD. SVIDCH, 0 / HOLDS THE INPUT DOCUMENT HEADER BLOCK NUMBER HBLSIG, 0 / SIGNAL THAT THE HOME BLOCK HAS BEEN READ 1=READ M44, -44 / NUMBER OF WORDS TO MOVE FROM HEADER TO NEW DOCUMENT HDR / THIS IS USED FOR LOOP CONTROL IN MOVING THE HEADER WORDS / OF DATES, TIMES, RULERS, ETC TO THE NEW DOC HEADER FOUR, 4 / WHERE TO BEGIN MOVING WORDS FROM HDR TO HDR NINE, 11 / WHERE IN HDR TO PUT THE DOCUMENT NUMBER / HDRBLK, 0 /HEADER BLOCK NUMBER OF DOCUMENT TO BE COPIED /A001 MSEVN, -7 / CONSTANT OF MINUS 7 MSPACE, -40 / SPACE TO CHECK FOR A SPACE /A004 SEVEN, 7 / CONSTANT OF 7 (USED TO ELIMINATE WORD WRAPS) INBUF2=INBUF+1 / CONSTANT OF INBUF +1 FOR CHECKING LENGTH /A006 MSTRLN, -STRLEN / NEG OF STRING LENGTH, USED FOR LOOP CONTROL PLT, LT / LEFT ANGLE BRACKET MLT, -LT / NEG OF LEFT ANGLE BRACKET, TO REVERSE WHEN CHECKING / FOR LEFT ANGLE BRACKET SFTRET, -2012 / A SOFT RETURN CHAR (TO CHECK FOR THEM) WWRAPB, 2012-2040 / A WORD WRAP BLANK (TO CHECK FOR THEM AFTER CHKING FOR / WD WRP CHAR) PWWRPB, 2040 / POS WORD WRAP BLANK FOR RESTORING CHARACTERS DCNBRS=200 / LOCATION IN BUFFER FIELD WHERE FILE NUMBERS ARE STORED/A003 FLNBRS, DCNBRS-1 / WHERE FILE NUMBERS ARE IN BUFFER (FOR INDEX) /A003 M512, -1000 / CONSTANT OF -512 (OCTAL) /A007 ONE, 1 / CONSTANT OF 1 (OCTAL) /A007 SIGNL2, 0 / SIGNAL THAT THE USER WANTS TO COPY DOC ON COPY SOME /A007 SIGNL3, 0 / SIGNAL THAT THE USER GAVE DOC A NAME ON COPY SOME /A007 DOCSIG, 0 / SIGNAL THAT ROTINE 'DTAO' ROUTINE IS USING 'READMU' /A023 /M017 MOVED HERE FOR SPACE REASONS ERSTAT, 0000 /TYPE OF CREATE ERROR MESSAGE TO DISPLAY /0 = GENERAL CANNOT CREATE /1 = DOC # OUT OF RANGE /2 = NO DOCS AVAILABLE LSTSIZ, 0 /SIZE OF INPUT FILE OVRSPCE, 0 /SIZE OF RESULT FILE 0 WHEN ADDING TO TOP OR BOTTOM TOPSC, PTOPSC / ADDED FOR SPACE REASONS /A018 MDOCFS, 0 / MINUS (NEGATIVE) NUMBER OF DOCS IN FILE SYSTEM /A037 NDOCFS, 0 / (POSITIVE) NUMBER OF DOCS IN FILE SYSTEM /A037 IDNCNT, 0 / ILLEGAL DOCUMENT NUMBER COUNT /A037 IDNTMP, 0 / ILLEGAL DOCUMENT NUMBER TEMP /A037 DSTMED, 0 / PTR. TO THE MEDIA TYPE STRING ('DISKETTE'or'VOLUME') /A039 WINSRC, 0 / FLAG INDICATING FROM DRIVE IS A WINNIE AREA /A039 / IF = 0 NOT A WINNIE, IF .GT. 0 IT IS THE WINNIE AREA #/A039 WINDST, 0 / SAME AS ABOVE FOR TO DRIVE /A039 WINONE, 0 / TRUTH FLAG INDICATING DEVICE # 1 IS A WINNIE AREA /A039 /---------------------- PAGE BELL= 7 / BACKSP= 10 / TAB= 11 / TAB CHARACTER FF= 14 / FORM FEED LT= 74 / LEFT ANGLE BRACKET LF= 12 / CR= 15 / KVTWIDTH=121 / 81(10) IS THE WIDTH OF A LINE OF THE VT SREXT=10 /ADDED TO SIZE OF LIST DOC DURING SIZING TO ALLOW 8(10) EXTRA /BLOCKS /D042 MUIOFF=MUBUF+MNSYSA+4 / LOCATION OF MENU BUFFER OFFSET /D042 MUISTR=MUBUF+MNIBUF / BUFFER ADDR OF WHERE WP2CMF'S 'READ' AND / 'FILNAM' COMMANDS READ INTO A FROM. ADRASM= 0 /THIS ASSEMBLES THE CREATE MODULE SO IT WILL NOT /TRY TO DISPLAY ERROR MESSAGES BUT SET THE AC FOR /A PARTICULAR MESSAGE SO WPSTPR DISPLAYS APPROPRIATE /MESSAGE ON CREATE ERROR /WE GET HERE AFTER HITTING MC-C-X-# WHERE X IS {A,S,O} AND /A037 /N IS THE DRIVE NUMBER THAT CONTAINS THE SOURCE DISK /A037 /THE MENU FOR THE INSTRUCTIONS TO REMOVE THE SYSTEM DISK IS DONE /A037 /WITHIN THIS MODULE. WHY? SO THAT WE ARE GUARANTEED TO HAVE /A037 /CPYFIL LOADED BY THE TIME THE USER SEES THE TEXT ON THE SCREEN /A037 /WHICH TELLS HIM THAT HE MAY REMOVE THE SYSTEM DISK /A037 /THIS MAY BE DONE MORE EFFICIENTLY IN THE FUTURE WITH A MENU CALL...HLP /A037 CPYFIL, XX /FIRST GET THE DISK ID OF THE SYSTEM DISK SO WE CAN MAKE SURE THE SAME /SYSTEM DISK IS INSERTED WHEN WE LEAVE CPYFIL TO RETURN TO MAIN MENU JMS GTDKID / GET DISK ID DCA DISKID / SAVE IT DCA IDNCNT / CLEAR THE ILLEGAL DOCUMENT NUMBER COUNT/A037 / THIS SECTION GETS ALL THE PARAMETERS PASSED INITIALLY BY THE USER / IT GETS THE TO AND FROM DRIVES AND IF NECESSARY TELLS THE USER TO REMOVE / THE SYSTEM DISKETTE AND INSERT THE DISKETTE THAT EITHER WILL RECEIVE / THE DOCUMNTS OR FROM WHICH DOCUMENTS WILL BE COPIED. / THE PARAMETERS THAT ARE PASSED ARE THE COPY TYPE WE'RE DOING (1=COPY / ONE DOCUMENT, 2=COPY SOME OF THE DOCUMENTS, 3=COPY ALL OF THE DOCUMENTS) / AND THE DRIVE NUMBERS THAT WE'RE COPYING FROM AND TO. CDFMNU TAD I (MUBUF+MNTMP1) / GET THE COPY TYPE:1=ONE, 2=SOME, 3=ALL DCA COPYTP / SAVE IT FOR FUTURE USE TAD I (MUBUF+MNTMP4) / GET THE DRIVE WE'RE COPYING FROM DCA FROMDR / SAVE IT TAD I (MUBUF+MNTMP5) / GET THE DRIVE WE'RE COPYING TO DCA TODRV / SAVE IT JMP WINCHK / GO SEE IF WE'RE ON A WINNIE SYSTEM /A039 WINRET, / WINCHK ROUTINE IS IN 2 PIECES FOR /A039 / SPACE REASONS, SO WE ARE USING JUMPS /A039 /D039 CDFMYF DCA DSTMED / CDF IS DONE IN WINCHK RTNE., ADDRESS /A039 / OF "DISKETTE" OR "VOLUME" LEFT IN AC /A039 TAD TODRV / GET THE 'TO' DRIVE SNA CLA / IF ZERO, THEN SYSTEM DRIVE IS RECEIVING DRV JMP RCVING / GO ASK HIM TO REMOVE THE SYSTEM DRIVE TAD FROMDR / GET THE DRVIE NO WE'RE COPYING FROM SZA CLA / IF NON-ZERO, THEN NOT SYSTEM DRIVE JMP GOBCK / DON'T ASK FOR SYSTEM DRIVE TAD (COPYF / GET ADDRESS OF "CONTAINS" GODISP, / GO DISPLAY MESSAGE JMS DISP1 / GO DISPLAY GOBCK, JMP CUGSP / RCVING, TAD (RECEV / GET ADDRESS OF "TO RECEIVE" JMP GODISP / GO DISPLAY IT CUGSP, / PROMPT FOR COPY DOC NAME DCA RSIGN / CLEAR 'NAME ONLY' SIGNAL /M031 AC7777 / SEE WHAT TYPE OF COPY WE'RE DOING TAD COPYTP / ARE WE DOING A COPY ONE? SZA CLA / YES, THEN PROCEED JMP CPYSAL / GO PROCESS A COPY SOME OR COPY ALL / WE ARE DOING A COPY ONE AT A TIME DCA SIGNL / CLEAR 'DOING NUMBERED DOCUMENT' SIGNAL MQL AC0002 / SIGNAL MAIN MENU NOT DO FILNAM THIS TIME JMS STTMPS / GO SET UP FOR MAIN MENU CALL /ASK THE USER THE NAME OR NUMBER OF THE DOCUMENT /HE WISHES TO COPY JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 TXCS2 / G. P. TWO SUBSTRINGS /A037 1505 SPRMPT / "PLEASE ENTER THE NAME OR .. NOW WISH /C037 1605 / POSITION FOR A NEW LINE /M037 NARG / NULL ARGUMENT FOR A NEW LINE JMS APRORG / "AND PRESS RETURN OR GOLD MENU /A037 JMS READMU / PROCESS INPUT FROM MENU JMP GOLDMU / RETURN TO MM CDFMYF / READMU LEAVES DATA FIELD AT MENU JMS HMBLCK / GO GET HOME BLOCK INTO MAIN MEMORY JMS CPMNOV / GO COPY INPUT FROM MENU FLD TO CHECK IT JMS CKINPT / GO SEE WHAT WAS PUT IN JMP CUGSP / HE HIT RETURN JMP NMNING / NO MEANING TO WHAT HE PUT IN CUGSP1, CLA / MEANING TAD FROMDR / GET THE FROM DRIVE NBR TAD OSXTY / MAKE IT AN ASCII NUMBER JMS FIXNAM / GO SET UP THE NAME JMS CSTUFF / SUBROUTINE INVENTED TO SAVE SPACE /A037 MQL / Store number passed / A44 CUGSP2, TAD DCNBR / If DCNBR is zero we are doing / copy one. If non zero don't use / number passed. It can return a wrong / value if the filename lookup is a / subset of an existing name. This / should be fixed at the filename lookup / routine and not here..but thats field test / for you. SNA / A44 ACL / COPY ONE. used number passed by cstuff/ A44 / UPDATE menu locations so right / document number is being used. DCA SVIDCN / SAVE IT FOR FUTURE USE TAD I (MUBUF+MNFNO) / GET THE FILE ID AND (7400 / re-building menu words / A44 TAD SVIDCN / " " " " / A44 DCA SVIFNO / SAVE IT FOR FUTURE USE TAD SVIFNO /re-building menu words DCA I (MUBUF+MNFNO / / A44 CDFMYF / GET BACK TO THIS FIELD AC7777 TAD COPYTP / ONLY IF IT'S A COPY ONE... /A001 SNA CLA JMS FIXONE / FIND ITS HEADER BLK # /A001 TAD STATUS / GET THE STATUS SMA CLA JMP CTDIN / CONTINUE IF FILE EXISTS JMS NDERR / COMPLAIN THAT IT DOESN'T EXIST INBUF+1 / WHERE FILE NAME EXISTS, ALTERRED BY 'FIXNAME RTN JMP CUGSP / GO ASK FOR ANOTHER CTDIN, TAD SIGNL / ARE WE DOING A NUMBERED FILE? SZA CLA / NO, CONTINUE... JMP CTDIN3 / YES /C037 CTDIN2, / RETURN POINT AFTER NUMBER IS SET UP FOR FILNAM JMS GTNAM / GO GET FULL NAME OF DOCUMENT IF DOING COPY ONE TAD TODRV / GET THE TO DRIVE NBR TAD OSXTY / MAKE IT AN ASCII NUMBER CDFMNU / CHANGE TO MENU FIELD DCA I (MUBUF+MNIBUF / PUT DRIVE NUMBER AT MNIBUF /C042 TAD (MUBUF+MNIBUF / GET ADDRESS OF MENU STRING /C042 DCA I (MUBUF+MNPOS / PUT ADDR OF MENU STRING INTO MENU OFFSET/C042 CDFMYF JMP CTDIN1 CTDIN3, TAD SVIDCN / GET DOCUMENT NUMBER /A037 DCA DCNBR / PUT IT WHERE ASKNM CAN DISPLAY IT /A037 JMP MVNBR / GO TELL USER DOCUMENT HAS NO NAME /A037 GOLDMU, / WHERE THINGS COME ON GOLD MENU CDFMNU /A029 DCA I (MUBUF+MNFNO) / CLEAR OUT DEFAULT DOC AND DRV NUMBER /A029 CDFMYF /A029 JMS REPLC / GO GET THE SYSTEM DISKETTE BACK UP /D035 RETURN, DCA SIGNL / CLEAR THE 'DOING NUMBERED FILES' SIGNAL CDIMNU /A037 JMP I CPYFIL /-------------------- PAGE /DOCUMENT EXISTS ALREDY ON THE OUTPUT DRIVE SO DISPLAY TAO PROMPT DTAO, XX DTAO1, /A018 AC7777 / SIGNAL READMU ROUTINE TO RETURN HERE ON /A023 DCA DOCSIG / INCORRECT INPUT BY USER /A023 JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 DEXTS /ADDRESS OF TEXT STRING 305 /POSITION FIRST LINE ON SECOND ROW 5 COLUMN SVODCN / OUTPUT DOCUMENT NUMBER TAD SIGNL / CHECK TO SEE IF ITS NUMBER ONLY SMA CLA JMS DONAME / THERE IS A NAME TO IT, GO DISPLAY IT CIFMNU JMS I IOACAL 0 DREST 705 1105 1305 1505 1705 2105 2305 JMS ORGOLD ORAR JMS MVCPIN / GO SAVE NAME OF DOCUMENT IN CASE OF ERROR /A012 JMS READMU /READ INPUT FROM MENU MODULE JMP GOLDMU /GOLD M SO ASK FOR SYSTEM DISKETTE CDFMYF /CHANGE DATA FIELD TO MINE SMA /IF AC NEGATIVE INAPPROPRIATE INPUT JMP STORE /IF APPROPRIATE CONTINUE IAC / LETS SEE IF WE CAME FROM RTNWT /A023 SZA CLA / IF ZERO HERE WE CAME FORM MAIN MENU /A023 JMP DTAO1 / JUST A RETURN /A023 / CPMSGA -- SAVES THE NAME OF THE DOCUMENT BEING COPIED WHEN /A012 / THE USER TYPES IN THE WRONG THING /A012 / /A012 JMS MVINPT / COPY INPUT FROM MENU FIELD /A037 JMS NOMEAN / DISPLAY TYPING '' HAS NO MEANING HERE /A037 JMS COPOVR /A012 JMP DTAO1 /ASK AGAIN STORE, DCA OPTION /STORE THE OPTION WANTED DCA DOCSIG / CLEAR SIGNAL TO RETURN HERE ON INCORRECT INPUT/A023 JMP I DTAO /RETURN /********************************************************************** / / THIS CODE HANDLES COPY SOME AND COPY ALL OPERATIONS. / IT WILL FIRST GET FILE NAMES FROM THE INDEX DOCUMENT / AND COPY THEM OVER THEN IT WILL PROCEED TO COPY OVER THE / UNNAMED DOCUMENTS. IF A COPY SOME OPERATION, IT WILL DISPLAY / THE NAME TO THE USER AND ASK HIM IF HE WANTS TO COPY IT. / /************************************************************************** CPYSAL, DCA IDNTMP / CLEAR TEMPORARY IDN COUNT /A037 JMS HMBLCK / GO GET THE HOME BLOCK IN TO MEMORY AC0004 / SIGNAL MAIN MENU WE'VE GOT THE FILE CDFMNU DCA I (MUBUF+MNTMP3) TAD (MUBUF+MNIBUF / RE-INITALIZE MUISTR FOR 'FILNAM' RTNE/C042 DCA I (MUBUF+MNPOS / INITIALIZE IT /C042 CDFMYF TAD SIGNL / GET INDEX END OF FILE SIGNAL SZA CLA / IS IT ON? JMP CPYSL3 / YES, GO PROCESS NAMELESS DOCUMENTS TAD FROMDR / GET THE DRIVE NUMBER WE'RE COPYING FROM BSW CLL RTL / SET UP DRIVE AND FILE NBR FOR OPEN IAC / INDEX FILE= FILE 1 JMS OPENRD / GO OPEN THE FILE FOR READING CPYSL1, CLA JMS GTLIST / GET A FILE NUMBER FROM INDEX FILE JMP CPYSL3 / END OF INDEX FILE TAD MDOCFS / SEE IF A LEGAL DOCUMENT NUMBER /A037 SMA SZA / /A037 JMP CPYSL6 / NOT A LEGAL DOCUMENT NUMBER /A037 TAD NDOCFS / RESTORE DOCUMENT NUMBER /A037 JMS MKNBR / GO CHECK IF FILE HAS BEEN DONE JMP CPYSL1 / YES IT HAS BEEN DONE AC7776 / CHECK WHAT SORT OF COPY WE'RE DOING TAD COPYTP / IS IT A COPY SOME? SNA CLA JMP CPYSL2 / WE ARE DOING COPY SOME JMP CUGSP1 / WE'RE DOING COPY ALL, GO COPY IT CPYSL2, TAD T2 / GET THE FILE NUMBER FOR DISPLAY JMS CPWISH / GO DISPLAY IT INBUF+1 / THE NAME OF THE FILE JMP CUGSP1 / HE PRESSED YES CPYSL6, / ILLEGAL DOCUMENT NUMBER DETECTED /A037 CLA / CLEAR ILLEGAL EXCESS /A037 TAD IDNCNT / GET COUNT OF ILLEGAL DOC NOS /A037 CIA / SO WE CAN DETERMIN IF WE HAVE /A037 TAD IDNTMP / TOLD USER ABOUT THIS INVALID /A037 SZA CLA / INDEX DOCUMENT ENTRY /A037 JMP CPYSL8 / ... WE ALREAD TOLD HIM ONCE! /A037 ISZ IDNCNT / COUNT THIS INVALID ENTRY /A037 JMS I TOPSC / CLA, ERASE AND INITALIZE SCREEN /A037 CIFMNU /A037 JMS I IOACAL /A037 0 /A037 TXTIDN / "DOCUMENT ^A HAS AN ILLEGAL DOCUMENT NUMBER 1305 / SCREEN POSITION /A037 INBUF+1 / ADDRESS OF THE NAME OF THE DOCUMENT /A037 1505 / POSITION OF SUBSTRING /A037 TXTID1 / "HAS AN ILLEGAL DOCUMENT NUMBER /A037 CPYSL7, TAD (1700) / POSITION TO ERASE FROM /A037 JMS ERASE / ERASE ANY ..YOU TYPED GARBAGE /A037 CIFMNU / /A037 JMS I IOACAL / /A037 0 /A037 TXCS1 / G. P. CONTROL STRING ONE /A037 2305 / POSITION /A037 TXPRCN / "PRESS RETURN TO CONINUE..." /A037 JMS ORGOLD / "OR PRESS GOLD MENU TO RETURN TO MM /A037 ORAR / /A037 JMS ASK / GET RESPONSE /A037 JMP GOLDMU / GOLD MENU /A037 JMP CPYSL7 / NO MEANING--REPAINT /A037 / RETURN--CONTINUE /A037 CPYSL8, ISZ IDNTMP / BUMP TEMPORARY COUNTER /A037 JMP CPYSL1 / HE HIT RETURN. GO TO NEXT DOC /A037 /----------------- PAGE / LOGIC REWRITTEN BELOW TO SAVE 2 LOCS. /A039 CRERR, AC7776 / GET -2 IN AC /A039 TAD ERSTAT / ADD IN ERSTAT /A039 SNA CLA / IF ERSTAT .NE. 2 THEN SKIP /A039 JMP NSPCMSG / ELSE WAS 2, DISPLAY NO SPACE FOR DOC MSG /A039 TAD ERSTAT / GET BACK ERROR STATUS /A039 SZA CLA / IF STATUS=0 THEN DISPLAY SHORT MESSAGE /A039 JMP WRGMSG / ELSE DISP WRONG DOC # MSG /A039 STMSG, /C017 TAD CUB1 /A017 TAD P377 /A017 SZA CLA /A017 JMP NOTINT / NON INITIALIZED DIKSETTE /A017 TAD CUB1+1 / GET HOME BLOCK ID /A017 AND (6077) / STRIP OFF VERSION NBR /A017 CIA / COMPARE IT /A017 TAD (30) / CHECK OR VALID HOME BLOCK /A017 SZA CLA /A017 JMP NOTINT / NOT INITIALIZED, GO COMPLAIN /A017 TAD (CNRG) /GET NO DISPLAY ARGUMENT JMS CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE /C017 JMP PRETRN /A017 NOTINT, /A039 TAD DSTMED / PTR TO "DISKETTE" OR "VOLUME" TEXT /A039 DCA CRMED / PUT INTO IOACAL PARM LIST /A039 JMP NOTIN1 /A039 WRGMSG, TAD (WNUM) /GET WRONG DOCUMENT NUMBER ARGUMENT JMS CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE /C017 JMP PRETRN /A017 NSPCMSG,TAD (NMDC-NONIN)/ GET NO DOCUMENTS AVAILABLE ARGUMENT /C037 NOTIN1, / NOT INITIALIZED /C037/C039 TAD (NONIN) / GENERATE THE CORRECT MESSAGE POINTER /A037 JMS CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE /C017 PGOLD, JMS ORGOLD / ENTRY POINT FOR UNASSIGNED WINNIE ERROR RET /A017/C039 NARG /A017 JMS KBRD /A017 JMP GOLDMU /A017 CREMSG, XX /C017 DCA CRMSG /STORE APPROPRIATE MESSAGE ARGUMENT FOR DISPLAY /C017 CRMSG1, /A018 JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 JMS RBELL CIFMNU JMS I IOACAL 0 CNTCRE /DISPLAY CANNOT CREATE DOCUMENT 1505 /ON LINE 15 COLUMN 5 CIFMNU JMS I IOACAL 0 CRMSG, 0000 /DISPLAY DOC # OUT OF RANGE, OR NO MORE DOCS 1605 CRMED, NOP / WHEN ERROR IS "NOT INITIALIZED" THIS LOCATION /A039 / WILL HAVE "DISKETTE" OR "VOLUME" TEXT /A039 / FOR ALL OTHERS THE NOP WILL BE EXECUTED ON /A039 / RETURN FROM IOA /A039 JMP I CREMSG /A017 PRETRN, /A017 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU JMS I IOACAL /CALL IOA 0 TARTN /DISPLAY PRESS RETURN TO TRY ANOTHER NAME 2005 /LINE TO DISPLAY JMS ORGOLD /DISPLAY PRESS GOLD M ORAR /DISPLAY OR JMS ASK / GET RESPONSE /C037 JMP GOLDMU / GOLD MENU /A037 JMP CRERR / GARBAGE--REPAINT /C037 JMP MVNBR / RETURN--REASK ABOUT NUMBERED DOC /C037 /THIS ROUTINE READS INPUT IN RESPONSE TO ERROR MESSAGES WHICH REQUEST A RETURN /WHEN RETURN IS TYPED RETURN TO USER IF NOT RING BELL AND COMPLAIN AGAIN /CALLED BY JMS RTNWT;WRONG RETURN;OK RETURN RTNWT, XX TAD INBUF / GET NEG NBR OF LENGTH OF INPUT /A023 DCA CUPBF0+STRLEN / PUT IT IN FRONT OF BUFFER AREA /A023 CIFMNU JMS I INACAL CUPBF0+STRLEN /INPUT BUFFER TO RECEIVE INPUT /C023 JMP WRNG /GOLD KEY RING BELL COMPLAIN AGAIN CLA MQA /MQ HAS # OF CHARS IF NOT 0 THEN NOT RETURN SZA CLA /SEE IF IT IS 0 JMP WRNG /IF NOT RETURN RING BELL COMPLAIN AGAIN ISZ RTNWT /MUST BE RETURN SO INCREMENT FOR OK RETURN JMP .+2 /RETURN TO CALLER /C015 WRNG, JMS RBELL /RING BELL JMP I RTNWT /RETURN TO CALLER TO COMPLAIN AGAIN /********************************************************************* / / THIS ROUTINE WILL CHECK TO SEE IF THE FILE NUMBER THAT IS / PASSED TO IT IN THE AC HAS BEEN COPIED ALREADY. IF IT HAS, / IT RETURNS TO THE NEXT SEQUENTIAL INSTRUCTION AFTER THE / RETURN ADDRESS. IF IT HASN'T, IT MARKS IT AS HAVING BEEN DONE / BUMPS UP THE RETURN ADDRESS, AND THEN RETURNS. / CALL IT SO: / JMS MKNBR / ADDRESS TO COME TO IF THE FILE HAS BEEN COPIED / ADDRESS TO RETURN TO IF THE FILE HASN'T BEEN COPIED / /*************************************************************************** MKNBR, XX DCA DCNBR / SAVE THE FILE NUMBER /C004 TAD FROMDR / GET THE DRIVE WE'RE COPYING FROM BSW / CONSTRUCT A FILE ID - DRIV-FILE NBR CLL RTR TAD DCNBR /C004 DCA SVIFNO / SAVE THE FILE ID TAD DCNBR / GET THE FILE NUMBER /C004 TAD FLNBRS / GET ADDRESS WHERE FILE NUMBERS ARE KEPT /C003 CDFBUF /A003 DCA T1 / SAVE IT TAD I T1 / GET THE FILE HEADER BLOCK NBR SNA / IF ZERO, NOT IN USE JMP MKNBRX / NOT IN USE, RETURN SPA CLA JMP GOLDMU / IF MINUS HERE, WE HIT THE END OF THE FILE NUMBER TBL AC7777 TAD I T1 / SEE IF HAS ALREADY BEEN COPIED SNA CLA / ZERO HERE MEANS IT HASN'T JMP MKNBRX / GO BACK NSI TAD I T1 /SAVE A COPY OF HDR BLK # /A001 DCA HDRBLK / SO WE CAN FIND IT LATER /A001 AC0001 / MARK FILE AS HAVING BEEN COPIED DCA I T1 / MARK IT IN TABLE ISZ MKNBR / BUMP UP TO RETURN ADDR MKNBRX, CLA / CLEAR THE AC CDFMYF /A003 JMP I MKNBR / GO BACK / ********************************************************************* /A039 / /A039 / ISWIN - INPUT: AC=DEVICE # /A039 / OUTPUT: AC=WINNIE AREA # OR 0 IF DISKETTE /A039 / /A039 / ********************************************************************* /A039 ISWIN, XX /A039 DCA T1 / SAVE DEVICE # /A039 AC7777 / GET -1 IN AC /A039 TAD T1 / ADD IN DEVICE # /A039 SZA CLA / IF DEVICE # IS 1 CHECK FURTHER /A039 JMP ISWINX / ELSE IT IS DRIVE 0 OR AREA 2,3.... /A039 TAD WINONE / GET "DEVICE ONE IS A WINNIE" FLAG /A039 SZA CLA / IT ISN'T SO RETURN A CLEARED AC /A039 ISWINX, TAD T1 / RETURN DEVICE # (=0 DRIVE,.GT.0 AREA) /A039 JMP I ISWIN /A039 /------------------- PAGE /***************************************************************************** / / ASKNM -- ASK AND GET AN ANSWER FROM THE USER AS TO WHETHER / HE WISHES TO NAME AN UNNAMED DOCUMENT, OR GIVE IT A NUMBER, OR GO ON TO / THE NEXT DOCUMENT OR TO MAIN MENU. / / JMS ASKNM / JMP FOO1 / RETURN HERE HIT GOLD MENU / JMP FOO2 / RETURN HERE, HIT JUST RETURN / TAD ETC / RETURN HERE, NAME OR NUMBER / /******************************************************************************* ASKNM, XX ASKNM1, JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 TAD DCNBR / GET THE DOC NUMBER TO DISPLAY DCA DOCNBR / PUT IT WHERE IT CAN BE DISPLAYED CIFMNU JMS I IOACAL 0 GLST 1705 DOCNBR, 0 2105 2305 JMS ORGOLD ORAR TAD INBUF / GET INITIAL STRING LENGTH FOR INACAL DCA CUPBF0 / PUT INTO BUFFER AREA CIFMNU JMS I INACAL CUPBF0 JMP GOLDK CLA MQA SNA CLA JMP ASKNM3 / HE HIT RETURN JMS CPYOVR / GO COPY IT TO JMS CKINPT / GO CHECK WHAT THE USER TYPED IN /A003 JMP ASKNM1 / IF NO ARGUMENT TYPED IN, GO ASK AGAIN /A003 JMP ASKNM4 / NO MEANING TO WHAT HE TYPED IN /A003 ISZ ASKNM / BUMP UP TO RETURN ADDRESS ASKNM3, ISZ ASKNM JMP I ASKNM ASKNM4, /A003 JMS NOMEAN / GO TELL USER HIS INPUT IS MEANINGLESS /A003 JMP ASKNM1 / GO ASK HIM FOR IT AGAIN /A003 GOLDK, JMS GMTST 2105 / ERASE FROM THIS LINE /A026 JMP I ASKNM / HE HIT GOLD MENU JMP ASKNM1 / GO DISPLAY THE MESSAGE AGAIN /***************************************************************************** / / THIS ROUTINE GETS THE DRIVE NUMBER (PASSED TO IT IN THE AC) AND / THE CDF TO THIS FIELD INTO THE Q-BLOCK, AND THEN DOES A GET DENSITY / TO ESTABLISH THE DENSITY OF THE DRIVE SO [PASSED TO IT. / /***************************************************************************** GTDENS, XX DCA DRVDSP / PUT DRIVE NUMBER WHERE IT CAN BE DISPALYED /A018 TAD DRVDSP / GET DRIVE NUMBER BACK INTO AC /A018 JMS CUPDRS / GO PUT DRIVE NBR AND CDF INTO Q-BLOCK TAD (RXEDN+4000) / GET FUNCTION CODE FOR GET DENSITY DCA QUQBLK+RXQFNC / PUT IT INTO Q-BLOCK JMS QURX / GO ESTABLISH THE DENSITY OF THE DRIVE SMA CLA / ERROR RETURN? /C018 JMP I GTDENS / RETURN JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 JMS ERRWIN / GO SEE IF ERROR ON WINNIE & DISPLAY MS/A039 / ELSE RETURN HERE /A039 CIFMNU /A018 JMS I IOACAL /A018 0 /A018 YNAD / YOU NEED A DISKETTE IN DRIVE X. PUT A DISKETE ETC /A018 1505 /A018 DRVDSP, 0 / DRIVE NUMBER TO BE DISPLAYED /A018 JMS APRORG / "AND PRESS RETURN OR GOLD MENU /A037 JMS MVCPIN /A018 JMS KBRD /A018 JMS COPOVR /A018 JMP GTDENS+2 /A018 /DISPLAYS TYPING "" HAS NO MEANING HERE /CALLED BY: / JMS NOMEAN / GO READ INPUT AGAIN NOMEAN, XX NMNDSP, JMS RBELL /RING BELL DCA INBUF+17 / CUTOFF LENGTH OF ERROR MESSAGE /A024 CIFMNU /DISPLAY TYPING "" HAS NO MEANING HERE JMS I IOACAL 0 NMEAN TWOSIX, 2605 INBUF+1 /WE NEED THE +1 TO MOVE ONE ADDRESS BEYOND /THE BUFFER SIZE IN FIRST LOCATION JMS RTNWT /WAIT FOR RETURN JMP NMNDSP /NO RETURN COMPLAIN AGAIN TAD TWOSIX /RETURN SO ERASE SCREEN JMS ERASE JMP I NOMEAN /RETURN TO CALLER TO ASK AGAIN /************************************************************************* / / A COPY ROUTINE TO COPY FILE NAMES FROM ONE AREA TO ANOTHER / /**************************************************************************** CPYOVR, XX JMS CUCOPY CUPBUF CDFMYF CUPFNM CDFMYF STRLEN-1 / LENGTH OF MOVE JMP I CPYOVR / GO BACK CTDIN1, TAD TODRV / TAD OUTPUT DRIVE NUMBER /A018 JMS GTDENS / ESTABLISH DEN AND DRIVE /A018 JMS CSTUFF / SUBROUTINE INVENTED TO SAVE SPACE /A037 DCA SVODCN / SAVE IT FOR FUTURE USE TAD I (MUBUF+MNFNO) / GET THE FILE ID DCA SVOFNO / SAVE IT FOR FUTURE USE CDFMYF / GET BACK TO THIS FIELD TAD STATUS / GET THE STATUS SMA CLA JMP CTDDIN / GO TELL USER DOC ALREADY EXISTS JMS TSTSZ / GO SEE IF THERE IS ROOM FOR THE DOCUMENT JMP TSMLL / THE OUTPUT DOESN'T HAVE ENOUGH ROOM JMS ADRCRT / CREATE THE OUTPUT DOCUMENT JMP CRERR / ERROR ON CREATE, PROCESS /D036 DCA SOTFL / STORE IN DOC NUMBER IN SOTFIL DCA VALUE / STORE IN DOC NUMBER IN VALUE TAD CUPFNO / GET THE DRV+FILE NO OF FILE JUST CREATED DCA SVOFNO / PUT IT WHERE EVERYBODY CAN GET AT IT JMP DOIO / GO COPY DOCUMENT /-------------------- PAGE /IF CALLED WITH ZER0 IN AC THIS ROUTINE CHECKS SIZE OF SPACE ON RESULT /FLOPPY AGAINST SIZE OF INPUT FLOPPY + 8 BLOCKS /OTHERWISE AC CONTAINS SIZE OF INPUT DOC TO ADD TO TOTAL SPACE NEEDED ON RESULT /FLOPPY WHEN WRITING TO TOP OR BOTTOM ON THE RESULT DRIVE /IF THERE IS ENOUGH SPACE ON RESULT FLOPPY TO ACCOMMODATE OUTPUT PROGRAM /CONTINUES. TSTSZ, XX TAD OPTION / GET THE OPTION THE USER WANTED SMA CLA / WAS IT AN OVERWRITE OPTION? JMP NOTOVR / NOT AN OVERWRITE TAD SVOFNO / WE NEED TO GEWT THE SIZE OF THE OUTPUT JMS GTFLSZ / GO GET SIZE OF TOUTPUT DOCUMENT CIA / MAKE IT NEGATIVE DCA OVRSPCE / SAVE IT JMP GTIFSZ / GO GEET THE INPUT FILE SIZE /A014 NOTOVR, TAD (SREXT) /THIS IS EXTRA SPACE REQUIRED IF DOC IS TO BE /M014 / EDITED AFTERF BEING COPIED /C014 DCA OVRSPCE /A014 GTIFSZ, /A014 TAD SVIFNO /PUT INPUT DRIVE AND DOC NUMBER INTO AC JMS GTFLSZ / GO OPEN THE FILE FOR READING TO GET FILE SIZE DCA LSTSIZ /STORE IN MY FIELD TAD TODRV /TAD OUTPUT DRIVE NUMBER JMS CUPDRS /SET DRIVE NUMBER FOR QURX TAD (RXESP /GET SPACE LEFT ON DISKETTE DCA QUQBLK+RXQFNC JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX TAD OVRSPCE /ADD RESULT DOC SIZE (OR 0 FOR T, A, OR CREATE) TAD LSTSIZ /ADD THE SIZE OF INPUT DOC CIA /NEGATE TAD QUQBLK+RXQSPC /ADD FREE SPACE SPA CLA /IF RESULT IS NEGATIVE INPUT IS GREATER THAN JMP I TSTSZ /SPACE AVAILABLE ON FLOPPY ERROR RETURN ISZ TSTSZ /ELSE THERE IS ENOUGH SPACE INCREMENT FOR OK RETURN JMP I TSTSZ TSMLL, JMS TOSMAL / GO DISPLAY MESSAGE AND ASK WHAT TO DO TODRV / FILE NUMBER TO BE DISPLAYED INBUF+1 / FILE NAME JMP CUGSP / HE TYPED RETURN, GO ASK FOR NEXT ONE NMNING, / NO MEANING TO WHAT HE PUT IN JMS MVINPT / COPY INPUT FROM MENU FIELD /A037 JMS NOMEAN / TYPING "" HAS NO MEANING HERE /A037 JMP CUGSP / GO ASK AGAIN MVNBR, / THIS SETS UP A NUMBERED OUTPUT DOC FOR FILNAM TO READ JMS ASKNM / GO ASK USER IF HE WANTS TO NAME OR NUMBER DOC JMP GOLDMU / HE HIT GOLD MENU JMP MVNBR2 / HE HIT RETURN, GO SEE IF ITS A COPY SOME JMP MVNBR1 / HE ENTERED A NAME OR A NUMBER MVNBR2, / CHECK TO SEE IF WE'RE DOING A COPY SOME AC7776 / GET A MINUS 2 TAD COPYTP / GET THE COPY TYPE OPERATION SZA CLA / IF ZERO, THEN DOING SOME /C007 JMP DONBRD / NOT DOING COPY SOME, GO DO NUMBERED DOC /A007 TAD SIGNL / GET SIGNAL THAT HE WANTS TO COPY 1=YES /A007 SNA CLA / SKIP IF YES /A007 JMP CUGSP / CONTINUE TO NEXT FILE DCA SIGNL2 / TURN SIGNAL OFF FOR NEXT TIME /A007 DONBRD, /A007 JMS GTNBR / GO GET A NUMBER OFF THE OUTPUT DISKETTE MVNBR1, JMS COPOVR / GO COPY THE NUMBER TO THE INBUF AREA FOR FIXNAM TAD TODRV / GET THE NUMBER OF THE DRIVE WE'RE COPYING TO TAD OSXTY / MAKE IT AN ASCII NUMBER JMS FIXNAM / GO SET UP FOR READ JMP CTDIN2 / GO BACK AND READ IT /************************************************************************ / / THIS CODE OPENS A FILE FOR READING ONLY. / PASS IT THE DRIVE AND FILE NUMBER IN THE AC. / THE DRIVE NUMBER MUST BE IN THE HIGH ORDER 4 BITS OF THE AC. / THE FILE NUMBER MUST BE IN THE LOW ORDER 8 BITS OF THE AC. / JUST CALL IT AS FOLLOWS: / JMS OPENRD / WHEN IT RETURNS, THE FILE WILL BE OPEN FOR READING. / /*************************************************************************** OPENRD, XX CDFMYF / ENSURE DATA FIELD IS TO THIS FIELD CIFFIO / CHANGE INSTRUCTION FIELD TO IO FILEIO XRDFIN JMP I OPENRD / RETURN /**************************************************************************** / / THIS CODE WILL COPY OVER THE INFORMATION IN THE 1ST HEADER BLOCK / THAT IS RELEVANT TO THE DOCUMENT, SUCH AS THE CREATION DATE, THE / SETTINGS FOR THE DOCUMENT'S PRINT MENU, ETC. THIS CONSISTS OF THE / 35 (DECIMAL) WORDS BEGINNING AT THE SIXTH WORD OF THE HEADER / BLOCK EXCEPTING WORD ELEVEN WHICH IS THE DOCUMENT NUMBER. SINCE / IT IS UNLIKELY THAT THE DOCUMENT NUMBER WILL BE THE SAME ON THE / OUTPUT DISKETTE AS IT IS ON THE INPUT DISKETTE, THE OUTPUT / DOCUMENT NUMBER IS PUT OUT AFTER MOVING THESE 35 WORDS. / /****************************************************************************** CPHDRI, XX CLA TAD SVOFNO / GET THE FILE ID (DRV-DOC NBR) AND P377 / AND OUT THE DRIVE NUMBER TO GET ONLY DOC NBR DCA SVODCN / STORE IT IN ORDER TO RESTORE IT TAD HDRBLK / GET HDR BLK # FROM WHERE I STASHED IT DCA QUQBLK+RXQBLK / PUT IT INTO THE Q-BLOCK TAD FROMDR / GET THE INPUT DRIVE NUMBER JMS CUPDRS / GO PUT THE DRIVE NUMBER AND CDF INTO Q-BLOCK TAD (CUB1) / GET THE BUFFER ADDRESS DCA QUQBLK+RXQBAD / PUT IT INTO THE Q-BLOCK TAD (RXERD) / GET THE FUNCTION CODE (LOGICAL READ) DCA QUQBLK+RXQFNC / PUT IT INTO THE Q-BLOCK JMS QURX / GO DO THE I-O CLA / HEADER IS NOW AT CUB1 TAD (CUB1+5) / GET THE BEGINNING OF AREA TO MOVE DCA X1 / PUT THIS ADDRESS INTO INDEX 1 TAD M44 / GET A MINUS 44 (OCTAL)/36 (DECIMAL) DCA T1 / PUT IT WHERE WE CAN ISZ IT FOR LOOP CTL TAD FOUR / GET THE NUMBER FOUR (WHERE WE'RE COPYING TO IN HDR DCA T2 / PUT IT WHERE WE CAN ISZ IT CPDNXT, TAD I X1 / GET THE VALUE OF THE WORD TO BE MOVED MQL / PUT IT INTO THE MQ TAD T2 / GET THE WORD NUMBER TO PUT IT TO IN NEW HDR CIFFIO FILEIO XHDRPT ISZ T2 / BUMP UP THE WORD NUMBER WE'RE COPYING TO ISZ T1 / ARE WE ALL DON? JMP CPDNXT / GO DO THE NEXT ONE SINCE WE'RE NOT DONE CLA TAD SVODCN / GET THE OUTPUT DOCUMENT NUMBER MQL / PUT IT IN MQ SO WE CAN PUT IT OUT TO THE NEW HDR / BECAUSER WE OVERWROTE IT WITH THE INPUT DOC NBR ABOVE TAD NINE / GET THE WORD NUMBER WHERE DOC NBRS GO IN HEADER CIFFIO FILEIO XHDRPT JMP I CPHDRI / RETURN /THIS ROUTINE IS FOR "COPY ONE" TO READ THE HEADER BLOCK # OF THE DOCUMENT /ABOUT TO BE COPIED. HDR BLK # IS READ FROM THE HOME BLOCK BUFFER AT DCNBRS /THEN PLACED IN HDRBLK (PAGE 0), FOR LATER USE BY CPHDRI. / FIXONE, XX TAD FLNBRS / GET ADDRESS WHERE FILE NBRS ARE /C003 TAD SVIDCN /MAKE PTR FROM DOC # DCA T1 CDFBUF /A003 TAD I T1 /FIND HDR BLK # DCA HDRBLK CDFMYF /A003 JMP I FIXONE /------------------- PAGE /************************************************************************* / / THIS ROUTINE WILL CHECK TO SEE IF THE SYSTEM DISKETTE IS MOUNTED / AND WILL RETURN TO THE NEXT SEQUENTIAL INSTRUCTION IF IT IS. / OTHERWISE, IT WILL DIPLAY A MESSAGE TO MOUNT THE SYSTEM DISKETTE / AND PRESS RETURN,AND THEN CHECK TO SEE IF THE SYSTEM DISKETTE / IS MOUNTED, ETC, ETC. / /*************************************************************************** REPLC, XX / ROUTINE TO ASK USER TO REPLACE THE SYTEM DISKETTE REPLC1, JMS GTDKID / GO GET THE KEY-ID OF THE DISK ON DRIVE 0 CIA / SET IT UP FOR COMPARE TAD DISKID / GET KEY ID PREVIOUSLY GOTTEN SNA CLA / IF ZERO HERE, IT ISN'T THE SYSDTEM DISKETTE JMP I REPLC / RETURN, SYSTEM DISKETTE IS MOUNTED JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 RPLACE /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1505 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 JMS PRETURN / AND PRESS RETURN JMS RTNWT / GO GET A RETURN REPLY ONLY JMP REPLC1 / USER HIT SOMETHING OTHER THAN RETURN, GO DIPLAY JMP REPLC1 / USER HIT RETURN, GO SEE IF SYSTEM DISKETTE IS IN PLACE /******************************************************************************* / / THIS ROUTINE WILL GET THE FULL NAME OF THE DOCUMENT ON A COPY ONE / OPERATION. THE ROUTINE 'FILNAM' IN MAIN MENU WILL READ THE FILE NAME / FROM OUT OF THE INDEX FILE, BUT IF THE USER ONLY PUTS IN A PARTIAL / PART OF THE NAME, IT LEAVES ONLY THE PARTIAL PART OF THE NAME IN THE / BUFFER AREAS. THIS RESULTS IN COPYING THE DOCUMENT WITH ONLY THE / PARTIAL NAME ON THE OUTPUT INDEX FILE. TO GET AROUND THIS PROBLEM, / THIS ROUTINE WAS WRITTEN. HERE THE FULL NAME OF THE DOCUMENT IS READ / INTO THE BUFFER AREAS SO THAT THE ENTIRE NAME WILL BE WRITTEN OUT TO / THE OUTPUT DISKETTE'S INDEX FILE. / JUST CALL THE ROUTINE, NO PARAMETERS TO PASS... / /****************************************************************************** GTNAM, XX AC7777 / ARE WE DOING A COPY OINE? TAD COPYTP / GET THE COPY TYPE 1=COPY ONE SZA CLA / YES, GO GET FULL NAME JMP I GTNAM / RETURN TAD SVIDCN / GET THE DOCUMENT NUMBER OF INPUT FILE DCA DCNBR / PUT IT WHERE 'DTNAM' CAN GET IT TAD FROMDR / SIGNAL 'DTNAM' THAT WE'RE DOING FROM DRIVE JMS DTNAM / GO DETERMINE THE NAME OF THE FILE TAD FROMDR / GET THE FROM DRIVE NUMBER TAD OSXTY / MAKE IT AN ASCII NUMBER JMS FIXNAM / GO SET IT UP FOR WRITING IT JMP I GTNAM / RETURN /CALLED WITH POSITION OF CURSOR IN AC ERASE, XX DCA CRPOS /STORE POSITION FOR CURSOR CIFMNU JMS I IOACAL 0 PSCR /STRING TO ERASE SCREEN AND POSITION CURSOR CRPOS, 0000 /CURSOR POSITION PASSED IN AC FROM CALLER JMP I ERASE /RETURN TO CALLER /A018 ADDED FOR SPACE REASONS. THIS ROUTINE ERASES THE SCREEN AND PUTS OUT /A018 THE '---COPY DOCUMENT--' HEADER ONTHE SCREEN PTOPSC, /A018 XX /A018 CLA / ERASE WHOLE SCREEN, I.E. FROM ZERO /A018 JMS ERASE /A018 CIFMNU JMS I IOACAL / PUT OUT '--COPY DOCUMENT--' 0 CPY 0 JMP I PTOPSC /A018 /CALLED BY JMS ORGOLD / VALUE FOR FIRST WORD ARGUMENT (EITHER ORAR FOR OR PRESS GOLD / M OR NARG FOR PRESS GOLD M) ORGOLD,XX /DISPLAYS (OR) PRESS GOLD M TO RECALL MENU CLA TAD I ORGOLD DCA FWARG /STORE ARGUMENT IN FIRST WORD ARGUMENT ISZ ORGOLD /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID WILL READ SYSTEM FLOPPY CIFMNU JMS I IOACAL 0 DOGM /ADDRESS OF OR TYPE GOLD M TO RECALL MENU 2505 /POSITION OF LINE FWARG, 0 /FIRST WORD OF PROMPT EITHER "OR" OR " " JMP I ORGOLD /RETURN TO CALLER /***************************************************************************** / / THE ROUTINE BELOW COPIES THE FILE CPYFLE, XX JMS CPHDRI / GO COPY OUT HDR INFO (PRINTER CTL INFO, ETC) CPYNXT, JMS RDNXCH / GO GET A CHARACTER TO COPY JMP CPFLEX / ALL DONE COPYING DCA CPYCHR / STORE THE CHARACTER JUST GOT CDFSYS TAD I HLTFLG / DID THE USER PRESS GOLD HALT? CDFMYF SZA CLA / NO HE DIDN'T JMP CPFLHT / YES HE DID, GO CLOSE AND CONTINUE TAD CPYCHR / GET CHARACTER TO COPY JMS PDXCH / GO PUT CHAR OUT JMP CPYNXT CPFLEX, ISZ CPYFLE / NORMAL RETURN CPFLHT, / GOLD HALT WAS HIT/ ABNORMAL RETURN CIFFIO / CLOSE THE FILE FILEIO XDSKCL CLA /A008 DCA QUQBLK+RXQFNC /SET 0 FNCTION CODE(WRITE DIR IF NEC./A008 JMS QURX /DO IT /A008 CLA / INSURE THAT WE'RE DOING DRIVE ZERO /M029/A028 JMP I CPYFLE / GO BACK ALL DONE /************************************************************************* / / THIS CODE IS THE LAST PART OF THE CODE THAT PROCESSES COPY SOME / AND COPY ALL. PROCESSING COMES HERE WHEN ALL THE NAMED / DOCUMENTS HAVE BEEN PROCESSED, AND NOW ALL THAT NEEDS TO BE / DONE IS TO COPY UNNAMED DOCUMENTS. FOR A COPY SOME, IT WILL / DISPLAY A MESSAGE ASKING WHETHER THE USER WISHES TO COPY / THE NUMBERED DOCUMENT. FOR A COPY ALL, IT SIMPLY GETS THE / NUMBERED DOCUMENT AND COPIES IT. / /************************************************************************** CPYSL3, JMS GTFNO / GO GET A FILE NUMBER (UNNAMED) JMP GOLDMU / NO MORE OF THEM DCA FILNBR / PUT IT WHERE IT CAN BE DISPALYED TAD FILNBR / GET THE FILE NUMBER TO SAVE IT DCA DCNBR / SAVE IT ON PAGE ZERO SO OTHERS CAN GET IT DCA SIGNL2 / TURN OFF SIGNAL THAT USER WANTS TO COPY /A007 DCA SIGNL3 / TURN OFF SIGNAL THAT USER GAVE NAME TO DOC /A007 TAD FILNBR JMS MKNBR / GO SEE IF FIEL HAS BEEN DONE JMP CPYSL3 / IT HAS, GO GET ANOTHER ONE TAD FILNBR / GET THE NUMBER IN THE AC CPYSL4, JMS DONBR / GO CONVERTY IT TO ASCII JMS COPOVR / GO COPY IT TO INBUF AC7776 / CHECK TO SEE IF WE'RE DOING A COPY SOME TAD COPYTP SZA CLA / YES WE ARE JMP CUGSP1 / NO WE AREN'T TAD FILNBR / GET THE FILE NUMBER /A037 JMS CPWISH / GO DISPLAY DO YOU WISH 0 / NO NAME ISZ SIGNL2 / SIGNAL THAT USER WANTS TO COPY /A007 JMP CUGSP1 / GO ASK FILNBR, 0 / SPOT FOR THE FILE NUMBER /M039 CODE MOVE HERE IN SPACE WAR /****************************************************************************/M039 APRORG, XX / DISPLAY "AND PRESS RETURN" /A037/M039 / "OR PRESS GOLD MENU ... /A037/M039 JMS PRETURN / /A037/M039 JMS ORGOLD / /A037/M039 ORAR / /A037/M039 JMP I APRORG / RETURN /A037/M039 /---------------------- PAGE /********************************************************************** / / THIS ROUTINE WILL CHECK TO SEE IF FILES HAVE BEEN COPIED / /************************************************************************** GTFNO, XX AC7777 / GET SIGNAL THAT WE'RE DOING NUMBERS ONLY DCA SIGNL / SIGNAL CKINPT RTNE THAT WE'RE DOING NUMBERS TAD (DCNBRS / PREPARE TO SEARCH FILE TABLE /C037 DCA X0 / PUT IT INTO INDEX 0 CDFBUF /A003 GTFNO1, TAD I X0 / GET A FILE HEADER BLOCK NBR SNA / IF ZERO HERE, DOCUMENT DOES NOT EXIST JMP GTFNO2 / NO DOCUMENT, GO GO ON TO THE NEXT TAD (-1) / CHECK TO SEE IF ITS BEEN COPIED ALREADY SNA CLA / ZERO HERE MEANS IT HAS BEEN COPIED JMP GTFNO2 / HAS BEEN COPIED TAD X0 / GET THE ADDRESS OF THE HDR BLOCK NBR TAD (-DCNBRS+1) / SUBTRACT FILE TABLE BASE /C037 ISZ GTFNO / BUMP UP GOT NUMBER RETURN ADDRESS GTFNOX, CDFMYF /A003 JMP I GTFNO / RETURN TO CALLER EOF ADDRESS GTFNO2, / DONE OR NONEXISTENT, CHECK TO SEE IF AT END OF TABLE TAD X0 / GET INDEX REGISTER TAD (-DCNBRS+1) / COMPARE TO TABLE END POINT /A037 TAD MDOCFS / AND NO OF DOCS IN FILE SYSTEM /A037 SMA CLA / SKIP IF NOT DONE /A037 JMP GTFNOX / DONE, GO EXIT WITH NO ISZ, AC=0000 /A037 JMP GTFNO1 / GO LOOK AT NEXT NUMBER /A037 /**************************************************************************** / / CONTROL IS PASSED HERE WHENEVER THERE IS NO DOCUMENT ON THE INPUT DRIVE / BY THE NAME GIVEN BY THE USER TO COPY OVER TO THE OUTPUT DRIVE. IT / ASKS THE USER TO PRESS RETURN FOR ANOTHER NAME. / /****************************************************************************** NDERR, XX JMS CPYSL5 / GO SEE IF WE'RE DOING COPY ALL /C004 TAD I NDERR /PICK UP DOC NAME DCA DCNAM /STORE IT FOR ERROR MESSAGE ISZ NDERR /INCREMENT FOR RETURN CDFMNU /CHANGE TO MENU FIELD TAD I (MUBUF+MNDRV) /PICK UP DRIVE NUMBER CDFMYF /CHANGE BACK TO MY FIELD DCA DCRV /STORE IN DRIVE NUMBER FOR ERROR MESSAGE JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 NDDSP, CIFMNU JMS I IOACAL 0 NDOC ONE303, 1305 DCDEV, 0 / PTR TO "DRIVE" OR "AREA" TEXT /A039 DCRV, 0000 DCNAM, 0000 CIFMNU JMS I IOACAL 0 TARTN 2505 JMS RTNWT /WAIT FOR RETURN JMP NDDSP /NOT RETURN COMPLAIN AGAIN TAD ONE303 /RETURN ERASE SCREEN JMS ERASE DCA SIGNL / CLEAR OUT NUMBERED DOC SIGNAL JMP I NDERR /AND CONTINUE /*************************************************************************** / / A ROUTINE TO COPY THE INPUT FROM MENU FIELD TO THIS FIELD / /**************************************************************************** CPMNOV, XX JMS CUCOPY MUBUF+MNIBUF /C042 CDFMNU CUPFNM CDFMYF STRLEN JMP I CPMNOV /************************************************************************** / / ROUTINE TO CONVERT A OCTAL NUMBER TO DECIMAL AND PUT IT AT INBUF. / ENTER THE ROUTINE WITH A JMS INSTRUCTION WITH THE VALUE OF THE / NUMBER IN THE AC. UPON RETURN, THE VALUE IN DECIMAL WILL BE AT / 'INBUF+1', RIGHT JUSTIFIED. / /**************************************************************************** DONBR, XX DCA VALUE / SAVE THER OCTAL NUMBER TO BE CONVERTED TAD DPREC / GET THE PRECISION (ALWAYS 4) TAD (TENS-1) / GET THE POWERS OF TEN TABLE DCA TABLE / PUT IT HERE TO INDIRECT THRU TAD (CUPFNM-1) / GET THE ADDR WHERE THE NUMBER WILL BE PUT DCA X1 / PUT THE ADDR INTO THE INDEX REGISTER TAD DPREC / GET THE PRECISION DCA DPREC1 / STORE IT HERE TO ISZ IT DONBR1, DCA COUNT / ZERO THE COUNTER ISZ TABLE / GET THE POWER OF TEN TAD I TABLE SNA / ARE WE DONE? JMP DONBRX / YES GO BACK CMA SNA CLA ISZ DPREC1 / TURN ON SIGNIFICANCE STARTER DONBR2, TAD VALUE / GET THE OCTAL NUMBER TAD I TABLE / SUBTRACT OUT THE POWER OF TEN SPA / STILL POSITIVE? JMP DONBR3 / NO, GO CONSTRUCT THE DIGIT DCA VALUE / YES, STORE THE DECREMENTED OCTAL FOR NEXT LOOP ISZ COUNT / INCREMENT THE DIGIT OF THE DECIMAL NBR JMP DONBR2 / GO SEE IF WE'RE THRU WITH THIS DIGIT DONBR3, CLA TAD DPREC1 / GET THE SIGNIFICANCE STARTER TAD COUNT / GET THE DECIMAL DIGIT SNA CLA / IF ZERO HERE, SIGNIFICANCE HASN'T STARTED JMP DONBR1 / GO DO NEXT DIGIT TAD OSXTY / GET AN ASCII ZERO TAD COUNT / ADD IN THE BINARY NBR FOR THE DIGIT ISZ DPREC1 / SET UP SIGNIFICANCE STARTER DCA I X1 / PUT DIGIT AT INBUF JMP DONBR1 / GO DO NEXT DIGIT DONBRX, CLA DCA I X1 / NULL END OF ASCIZ STRING JMP I DONBR / RETURN COUNT, 0 / AREA TO CREATE DECIMAL DIGIT IN OCTAL DECIMAL TENS, -1000 -100 -10 -1 0 / END OF TABLE MARKER OCTAL /***********************************************************************/A012 / /A012 / DISPLAYS MESSAGE "IF YOU DO, TYPE Y AND PRESS RETURN, OR JUST /A012 / 'PRESS RETURN TO CONTINUE TO THE NEXT DOCUMENT, /A012 / /A012 /***********************************************************************/A012 MSIYDT, /A012 XX /A012 CIFMNU /M012 JMS I IOACAL /M012 0 /M012 TXCS2 / G. P. CONTROL STRING, TWO SUBSTRINGS /A037 2105 / POSITION OF 1ST SUBSTRING /A037 TXIYD / IF YOU DO PRESS Y, OF RETURN ETC, /M012 2305 /M012 TXPRCN / "PRESS RETURN TO CONTINUE TO NEXT..." /A037 JMS ORGOLD /M012 ORAR /M012 JMP I MSIYDT /A012 /------------------------ PAGE /M039 SPACE WARS MOVE /D039/**************************************************************************** /D039 /D039APRORG, XX / DISPLAY "AND PRESS RETURN" /A037 /D039 / "OR PRESS GOLD MENU ... /A037 /D039 JMS PRETURN / /A037 /D039 JMS ORGOLD / /A037 /D039 ORAR / /A037 /D039 JMP I APRORG / RETURN /A037 /**************************************************************************** PRETURN,XX /DISPLAYS "AND PRESS RETURN" CIFMNU JMS I IOACAL 0 PRTRN 2305 JMP I PRETURN /**************************************************************************** / GOLD MENU IF GOLD MENU IS TYPED, / NO MEANING IF GARBAGE KBRD, XX / RETURN IF RETURN IS TYPED, KBRD1, /A011 CIFMNU JMS I INACAL /CALL INA TO READ INPUT INBUF /LOCATION TO RECEIVE INPUT JMP GMTEST /A011 CLA MQA /MQ CONTAINS #CHARS IN BUFFER SNA CLA /IF THIS IS 0 RETURN WAS TYPED JMP I KBRD /GO BACK TO CALLER JMS NOMEAN /ELSE MUST BE INAPPROPRIATE RESPONSE COMPLAIN JMP KBRD1 /ASK AGAIN GMTEST, /A011 JMS GMTST / GO SEE WHAT KIND OF GOLD KEY WAS HIT /A011 2205 / ERASE FROM THIS LINE FORWARD /A026 JMP GOLDMU / HE HIT GOLD MENU /A011 JMP I KBRD / HE HIT RETURN AFTER MESG NOT TO HIT GOLD KEYS /A011 /CALLED WITH 0 OR 1 IN AC TO DETERMINE FROM WHICH FLOPPY THE HOME BLOCK /WILL BE READ GTDKID, XX TAD (NOP) / LOAD A NOP INSTRUCTION INTO AC /A039 DCA CRMED / & PLACE INTO CREATE ERROR IOACAL SEQUENCE /A039 / THIS MAKES "CRERR" RE-ENTRANT /A039 JMS GTDENS / GO PUT DRV NBR AND CDF INTO Q-BLOCK AND EST DENSITY TAD (CUB1) /BUFFER ADDRESS DCA QUQBLK+RXQBAD TAD (RXBDIR) /BLOCK TO READ (HOME BLOCK) DCA QUQBLK+RXQBLK TAD (RXERD /TELL QURX TO READ DCA QUQBLK+RXQFNC JMS QURX CLA /THIS CLOBBERS ANY QURX ERROR RETURN TAD CUB1+5 /INDEX TO FIFTH WORD (DISKETTE ID#) JMP I GTDKID /EXIT WITH CURRENT DISKETTE ID IN AC TOSMAL, XX TAD I TOSMAL / GET THE DRIV NUMBER DCA DISP31 / PUT IT TO BE DISPLAYED ISZ TOSMAL / BUMP UP TO THE DOCUMENT NAME TAD I TOSMAL / GET THE DOCUMENT NAME (IF ANY) DCA DISP33 / PUT IT WHERE IT WILL BE DISPLAYED TAD I DISP31 / PICK UP THE DRIVE NUMBER DCA DISP31 / PUT IT WHERE IT WILL BE DISPLAYED TSML1, JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 NERD / NOT ENOUGH ROOM ETC 1505 DSTDEV, 0 / PTR TO "DRIVE" OR "AREA" TEXT /A039 DISP31, 0 /DRIVE NUMBER CLA TAD I DISP33 / CHECK FOR DOCUMENT NAME SNA CLA / IF ZERO ADDRESS THEN NO NAME FOR DOCUMENT JMP NONAM / NO NAME FOR DOCUMENT CIFMNU JMS I IOACAL 0 DCNAME 1705 DISP33, 0 / DISPLAY NAME OF DOCUMENT NONAM, CIFMNU JMS I IOACAL 0 TXCS1 / G. P. ONE SUBSTRING /A037 2405 / POSITION /A037 TXPRCN / SUBSTRING "PRESS RETURN TO CONINUE..." /A037 JMS ORGOLD ORAR JMS MVCPIN / GO SAVE THE DOCUMENT NAME IN CASE USER WRONG /A032 JMS ASK / GO SEE WHAT HE TYPED IN JMP GOLDMU / GO BACK JMP RSTNAM / GO RESTORE THE NAME OF THE DOCUMENT /A032 ISZ TOSMAL /M032 JMP I TOSMAL / HIT FINALLY HIT RETURN RSTNAM, /A032 JMS COPOVR /RESTORE THE NAME OF THE DOCUMENT /A032 JMP TSML1 / GO DISPLAY AGIAN /M032 /***********************************************************************88 / / THIS ROUTINE DETERMINES WHAT THE USER TYPED IN WHEN ASKED / WHETHER OR NOT HE WANTS TO COPY A FILE THE NAME OR NUMBER OF / WHICH WAS PREVIOUSLY DISPLAYED ON THE SCREEN DURING A COPY / SOME OPERATION. IF THE USER TYPES THA LETTER "Y" AS THE FIRST / CHARACTER, IT WILL DO THE COPY OPERATION. IF HE TYPES RETURN, / IT WILL GO GET ANOTHER FILE NAME OR NUMBER TO DISPLAY, WITHOUT / COPYING. IF HE TYPES GOLD MENU, IT GOES TO MAIN MENU. ANY THING / ELSE IT WILL TREAT AS IF HE HIT RETURN. IF HE TYPES A GOLD KEY / OTHER THAN GOLD MENU, IT WILL GIVE HIM A LONG LECTURE ABOUT THE / USE OF GOLD KEYS AND MAKE HIM HIT RETURN. / /************************************************************************ WISHIN, XX JMS MVCPIN / GO SAVE WHAT'S IN INBUF /A022 WISHN1, CIFMNU JMS I INACAL INBUF /A027 JMP GLDKY CLA MQA / ANYTHING TYPED IN? SNA CLA / IF NON ZERO HERE THEN SOMETHING HAS BEEN TYPED JMP WISHN3 / IF ZERO, THEN RETURN WAS TYPED TAD INBUF+1 /GET WHAT WAS TYPED IN /A027 IFDEF ENGLSH < TAD (-131) / A "Y"? > IFDEF ITALIAN < TAD (-123) / A "S"? > IFDEF V30NOR < TAD (-112) / a "J" > IFDEF V30SWE < TAD (-112) / A 'J' > SNA JMP WISHN2 / YES, RETURN TO SECOND ADDRESS IFDEF ENGLSH < TAD (131-171) / A "y" ? > IFDEF ITALIAN < TAD (123-163) / A "s"? > IFDEF V30NOR < TAD (112-152) / A "j" > IFDEF V30SWE < TAD (112-152) / A 'J' > SNA JMP WISHN2 / YES, RETURN TO SECOND ADDRESS JMS NOMEAN / GO TELL HIM IT HAS NO MEANING HERE /A027 JMP WISHNR / NOT A "Y", SO TREAT IT AS IF HE HIT RETURN /C027 GLDKY, JMS GMTST / GO SEE WHAT KIND OF GOLD KEY HE HIT 2105 / ERASE FROM THIS LINE FORWARD /A026 JMP WISHN4 / HE HIT GOLD MENU JMS RBELL / GO RING THE BELL JMS MSIYDT / GO DISPLAY MESSAGE /A012 JMP WISHN1 WISHN2, ISZ WISHIN WISHNR, /A027 ISZ WISHIN / NO MEANING TO WHAT HE TYPED IN TRY AGAIN /A027 WISHN3, / TYPED RETURN ISZ WISHIN WISHN4, JMP I WISHIN /---------------------- PAGE /CALLS MENU TO READ INPUT TO DOC PROMPTS, TOA AND GO PROMPTS /CALLED BY: /JMS READMU / GOLD M DATA FIELD SET TO MY FIELD / CONTINUE PROCESSING DATA FIELD SET TO MENU FIELD / EDIT 035 CHANGED SYMBOL READ TO READLP /A035 READMU, XX READLP, CDFMYF /SET DATA FIELD TO MENU /M035 CIFMNU JMS I MNUCAL;DLMDU7 /CALL MENU CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNTMP3) /GET AND TEST CONTENTS OF TMP3 SZA /IF 0 THEN GOLD KEY WAS PRESSED JMP RDRTN2 /NOT GOLD KEY SO RETURN AND PROCESS INPUT TAD I (MUBUF+MNSYSA) /WAS GOLD KEY TO GET IT TAD (4000) /SET FIRST BIT TO 1 BECAUSE MENU STRIPS IT OFF CDFMYF /CHANGE DATA FIELD TO MINE JMS GMTST /PROCESS GOLD KEY 2105 / ERASE FROM HERE /A026 JMP RDRTN1 /GOLD M RETURN TAD DOCSIG / DID 'DTAO' CALL THIS ROUTINE? /A023 SMA / YES, THEN RETURN TO DTAO /A023 JMP RDRTN3 / NO, NORMAL PROCESSING /A023 AC7776 / SIGNAL THAT WE'RE COMING FROM HERE /A023 JMP RDRTN2 / RETURN TO DTAO /A023 RDRTN3, /A023 JMS APRORG / "AND PRESS RETURN OR GOLD MENU /A037 JMP READLP / GOLD GARBAGE, READ INUT AGAIN /M035 RDRTN2, ISZ READMU / GOLD M EXIT RDRTN1, JMP I READMU / CONTINUE EXIT /CALLED BY JMS GMTST;GOLD M;GOLD KEY NOT GOLD M GMTST, XX / TEST TO SEE IF GOLD KEY TAD (-EDMENU) /SEE IF GOLD M SNA CLA JMP GMRTN2 /C026 GMERDSP, TAD I GMTST /C026 /C016 JMS ERASE JMS RBELL CIFMNU JMS I IOACAL 0 TRYAGN 2205 /C026 2305 2405 2605 JMS RTNWT / WAIT FOR THE RETURN JMP GMERDSP / NOT RETURN GO COMPLAIN TAD I GMTST /C026 /C016 JMS ERASE ISZ GMTST /A026 GMRTN2, ISZ GMTST GMRTN1, JMP I GMTST /GO BACK /D44 *************************************************************************** /D44 /D44 A ROUTINE THAT WILL COMPARE TWO STRINGS OF CHARACTERS TO SEE IF THEY /D44 ARE EQUAL. /D44 THE ROUTINE SHOULD BE CALLED AS FOLLOWS: /D44 JMS COMPST /D44 ADDRESS OF THE FIRST STRING OF CHAR TO BE COMPARED /D44 ADDRESS OF THE 2ND STRING TO BE COMPARED /D44 RETURN POINT IF THEY DON'T MATCH /D44 RETURN POINT IF THEY DO MATCH /D44 THE FIRST STRING IS THE CONTROLLING STRING. IT MUST HAVE AS ITS LAST /D44 WORD A NULL TO STOP THE COMPARE. IF THE 2ND STRING HAS A NULL CHARACTER /D44 BEFORE THE ROUTINE REACHES THE NULL CHARACTER IN THE FIRST STRING, /D44 IT WILL RETURN A NON-MATCHING CONDITION. IF ALL THE CHARACTERS THAT /D44 PRECEDE THE NULL CHAR IN THE FIRST STRING MATCH THE CHARACTERS OF THE /D44 SECOND STRING, THEN A MATCH CONDITION IS RETURNED. /D44 /D44 ***************************************************************************** /D44 / This routine was never called. How about that. /D44 /D44 COMPST, /D44 XX /D44 AC7777 / DECREMENT FOR INDEXING /D44 TAD I COMPST / GET THE ADDR OF THE FIRST STRING /D44 DCA X1 / INTO INDEX 1 /D44 ISZ / POITN TO THE NEXT STRING ADDRESS /D44 AC7777 / DECREMENT FOR INDEXING /D44 TAD I COMPST / GET ADDRESS OF 2ND STRING /D44 DCA X2 /SET IT UP IN INDEX 2 /D44 ISZ / BUMP UP TO NO MATCH RETURN POINT /D44 COMPS1, /D44 TAD I X1 / GET CHAR FROM 1ST STRING /D44 SNA / IF ZERO, WE'RE ALL DONE /D44 JMP COMPSX / GO BUMP UP TO MATCH RETURN AND GO BACK /D44 CIA / COMPLEMENT FOR COMPARE /D44 TAD I X2 / GET CORRESPONDING CHAR FROM 2ND STRING /D44 SZA CLA / IF ZERO, THEY MATCH /D44 JMP I COMPST / IF NOT THEY DO'T, GO BACK /D44 JMP COMPS1 / GO GET ANOTHE RCHAR AND DO IT OVER AGAIN /D44 COMPSX, /D44 ISZ / BUMP UP TO MATCH RETURN /D44 JMP I COMPST / RETURN JMP CSTUFF, XX / A SUBROUTINE OF COMMON CODE /A037 / I DON'T HAVE TIME TO FIGURE OUT /A037 / EXACTLY WHAT THIS DOES RIGHT NOW /A037 CLA IAC MQL JMS STTMPS / GO DO THE SIGALING JMS READMU / GO READ IT JMP GOLDMU DCA STATUS / STORE AC IN STATUS -1 = NONEXISTENT DOCUMENT TAD I (MUBUF+MNDOCN) / GET THE DOCUMENT NUMBER JMP I CSTUFF /A037 /*************************************************************************** / / THIS ROUTINE WILL DETERMINE WHETHER OR NOT THERE IS FILENAME IN THE / INDEX DOCUMENT FOR A DOCUMENT NUMBER THAT IS AT LOCATION 'DCNBR' / ON A DRIVE PASSED TO IT IN THE AC. IF IT DOES NOT FIND SUCH A / DOCUMENT NAME IT WILL RESTORE THE FILE NUMBER AT 'INBUF' IN ASCII. / IF IT FINDS THE NAME, IT WILL PUT IT AT 'INBUF'. / /****************************************************************************** DTNAM, XX BSW / POSITION DRVE NUMBER IN THE UPPER SIX BITS CLL RTL / SET DRIVE NUMBER IN IT'S PLACE FOR RDFINI IAC / SET TO READ FILE ONE (INDEX FILE) JMS OPENRD / GO OPEN THE FILE FOR READING DTNAM1, JMS GTLIST / GET THE NAME AND NUMBER OF A FILE ON THE INDEX JMP DTNAM2 / END OF FILE JUMP CIA / GOT A NUMBER, COMPLEMENT IT FOR COMPARE TAD DCNBR / ADD IN THE NUMBER WANTED SZA CLA / THEY'RE EQUAL WE GOT IT JMP DTNAM1 / GO SEE IF THE NEXT ONE IS WHAT WE WANT DCA SIGNL / TURN OFF SIGNAL THAT SAYS DOC HAS NO NAME JMP I DTNAM / GO BACK DTNAM2, JMS COPOVR / GO MOVE THE FILENAME TO INBUF /C013 JMP I DTNAM / ALL DONE /********************************************************************** / / THIS IS A ROUTINE THAT GETS THE SIZE OF A DOCUMENT / YOU MUST PASS THE DRIVE-FILE NUMBER IN THE AC / DRIVE NUMBER IN THE UPPER 4 BITS / FILE NUMBER IN THE BOTTOM 8 BITS / /************************************************************************* GTFLSZ, XX JMS OPENRD / GO OPEN THE DOCUMENT PASSED IN THE AC CDFFIO / CHANGE DATA TO FILE IO FIELD TAD I (RDFSIZ) / GET THE SIZE OF THE FILE CDFMYF JMP I GTFLSZ /**************************************************************************** / / HMBLCK -- GET THE HOME BLOCK OF THE INPUT DISKETTE INTO MEMORY / COPY NUMBER OF DOCUMENTS IN FILE SYSTEM TO NDOCFS / /******************************************************************************* HMBLCK, XX AC7777 / GET MINUS 1 TO SEE IF THE HOME BLOCK TAD HBLSIG / HAS BEEN READ ALREADY SNA CLA / IF NOT ZERO, THEN IT HASN'T BEEN READ JMP I HMBLCK / IT HAS BEEN READ, RETURN TAD FROMDR JMS GTHMBL / GO GET IT INTO MEMORY CUB1 / BUFFER ADDRESS ISZ HBLSIG / SET SIGNAL THAT THE HOME BLOCK HAS BEEN READ / NOW MOVE IT INTO ITS PERMANENT LOCATION TAD I (CUB1+11) / GET #BLOCKS IN FILE SYSTEM /A037 DCA MDOCFS / SAVE AS A HANDY NEGATIVE NUMBER /A037 TAD MDOCFS / /A037 CIA / /A037 DCA NDOCFS / AND AS A HANDY POSITIVE NUMBER /A037 TAD NDOCFS / AND FOR THE COPY ROUTINE /A037 DCA HMBLT1 / SAVE IN CUCOPY CALL /A037 JMS CUCOPY CUB1+12 / COPY OVER THE FILE HEADER BLOCKS CDFMYF DCNBRS / AREA WHERE IT IS CDFBUF HMBLT1, 0 / NUMBER OF BLOCKS IN FILE SYSTEM /A037 / IS THE NUMBER OF WORDS TO COPY /A037 JMP I HMBLCK / RETURN /------------------ PAGE /************************************************************************ / / ROTUINE TO DISPLAY MESSAGE TO REMOVE THE SYSTEM DISKETTE / AND REPLACE WITH THE DISKETTE TO BE COPIED TO OR FROM / /************************************************************************** DISP1, XX DCA DISP11 / PUT MESSAGE INTO CALL LIST DISP10, /A018 JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 SYSTM / PRINT 'PLEASE REMOVE THE SYSTME D ISKEETE FROM LEFT 1305 / CURSOR POSITION CIFMNU JMS I IOACAL 0 AITDT 1505 CIFMNU JMS I IOACAL 0 DISP11, 0 / PLACE FOR MESSAGE ADDRESS IFDEF ENGLSH <1536> IFDEF ITALIAN <1532> / CURSOR POSITION IFDEF V30NOR <1536> IFDEF V30SWE <1536> JMS APRORG / "AND PRESS RETURN OR GOLD MENU /A037 JMS ASK / GO FIND OUT WHAT HE TYPED IN JMP GOLDMU / GO BACK TO MAIN MENU JMP DISP10 / GO DISPLAY MESSAGE AGAIN JMP I DISP1 / RETURN /*********************************************************************** / / THIS ROUTINE WILL READ WHAT THE USER TYPES IN, AND / A) IF HE TYPED RETURN, IT WILL RETURN TO NSI+2 / B) IF HE TYPES GOLD MENU, IT WILL RETURN TO NSI / B) IF HE TYPES A GOLD KEY THAT IS NOT GOLD MENU IT WILL.. / 1) RING THE BELL / 2) GIVE HIM A MESSAGE TO NOT USE THOSE KEYS / 3) TELL HIM TO TRY AGAIN TIL HE GETS IT RIGHT / C) IF HE TYPES ANYTHING ELSE IT WILL... / 1) RING THE BELL / 2) DISPLAY WHAT HE TYPED AND TELL HIM IT HAS NO MEANING / 3) GO BACK AND ASK HIM TO TYPE SOMETHING AGAIN / /***************************************************************************** ASK, XX / ASK USER FOR A "CARIAGE RETURN" OR "GOLD MENU" JMS MVCPIN / SAVE THE INBUF BUFFER AT CUPFNM /A037 CDFMYF CIFMNU JMS I INACAL / READ WHAT HE TYPES IN INBUF JMP GMKEYT / HE TYPED A GOLD KEY, GO SEE IF ITS GOLD M CLA MQA / SEE IF HE TYPED ANY CHARACTERS IN SZA CLA / IF 0 CHARACTERS THEN HE TYPED RETURN JMP ASK3 / GO TELL HIM ITS GARBAGE / NICE FELLOW TYPED RETURN SO.. ISZ ASK / INCREMENT PAST THE GOLD MENU RESPONSE RETURN ASK4, ISZ ASK / INCREMENT PAST THE NO MEANING RETURN JMS COPOVR / RESTORE THE INBUF BUFFER FROM CUPFNM /A037 JMP I ASK / AND RETURN THERE. ASK3, / GO TELL HIM THAT HIS GARBAGE IS NONSENSE JMS NOMEAN / TYPING 'X' HAS NO MEANING JMP ASK4 / GO BUMP ONCE AND RETURN GMKEYT, / GO SEE WHAT SORT OF GOLD KEY HE TYPED JMS GMTST / THIS ROUTINE OUTPUTS A MESSAGE IF NOT GOLD MENU 2205 / ERASE SCREEN FROM THIS LINE ON /A026 JMP I ASK / HE HIT GOLD MENU, SO RETURN NSI JMP ASK4 / HE FINALLY HIT RETURN /***************************************************************************/ / ROUTINE TO GET FILE NAMES AND/OR NUMBERS FROM THE INDEX DOCUMENT / EACH TIME YOU ENTER IT YOU WILL GET THE NEXT NAME ON THE FILE. / SIMPLY CALL THE ROUTINE. / /***************************************************************************** GTLIST, XX GTNXT, /A004 TAD (INBUF+1 / GET ADDRESS OF INPUT BUFFER FOR NAME DCA INDBUF / PUT IT FOR INDIRECTING THRU JMS NMSRC / GO SEARCH FOR NMIBN / JMP LISTEF / END OF FILE RETURN TAD MSTRLN / GET LENGTH OF STRING DCA LISTCT / SET IT UP FOR LOOP CONTROLL GTLIS1, JMS RDNXCH / GO GET NEXT CHARACTER OF FILE JMP LISTEF / END OF FILE TAD MLT / LEFT ANGLE BRACKET? SNA JMP GTLIS2 / YES, THEN ALL DONE TAD PLT / RESTORE CHARACTER TAD SFTRET / CHECK FOR SOFT RETURN CHARACTER SNA / IF NOT ZERO, NOT A SOFT RETURN JMP GTLIS1 / GO GET NEXT CHARACTER TAD WWRAPB / CHECK TO SEE OF IT IS A WORD WRAP BLANK SNA / IF NOPT ZERO, THEN ISN'T A WORD WRAP BLANK JMP GTLIS1 / GO GET NEXT CAHRACTER TAD PWWRPB / RESTORE THE CHARACTER AND P177 / WE'RE ONLY INTERSTED IN THE LOWER 7 BITS TAD MSEVN / WORD WRAP CHARACTER? SNA / IF IT IS, BYYPASS IT JMP GTLIS1 / GO GET NEXT CHARACTER FROM FILE TAD SEVEN / RESTORE CHARACTER DCA I INDBUF / PUT IT AT INBUF ISZ INDBUF / UPDATE BUFFER POINTER ISZ LISTCT / UPDATE THE LIST COUNTER JMP GTLIS1 / GO DO NEXT CHARACTER GTLIS2, AC7777 / GET A MINUS 1 TAD INDBUF / SUBTRACT 1 FROM POINTER TO MAKE ASCIZ STRING DCA INDBUF / THIS CUTS OUT THE FINAL BLANK FROM NAME TAD I INDBUF / GET THE CHARACTER /A004 TAD MSPACE / IS IT A SPACE? /A004 SZA CLA / IF IT IS, GO MAKE IT A ZERO /A004 JMP GTNXT / IF NOT A SPACE, TREAT IT AS NOT FOUND /A004 TAD INDBUF / CHECK TO SEE IF LENGTH OF NAME IS ZERO/A006 TAD (-INBUF2 / NEG VALUE OF BEGINNING OF NAME /A006 SNA CLA / IF NOT ZERO, NAME IS GREATER THAN ZERO/A006 JMP GTNXT / GO GET NEXT NAME FROM INDEX FILE /A006 DCA I INDBUF / ASCIZ STRING FINAL 0 JMS NMSRC / GO SEARCH FOR <#> NMIBNO+1 / #> JMP LISTEF / END OF FILE JMS GTNUM / GO GET THE NUMBER JMP LISTEF / END OF FILE ISZ GTLIST / INCREMNT TO RETURN ADDR LISTEF, JMP I GTLIST / NORMAL RETURN IS THE BUMPED RETURN / WITH AC CONTAINING THE FILE NO / END OF FILE RETURN IS NOT BUMPED, AC=0 LISTCT=T3 / COUNTER FOR LOOP CONTROL INDBUF=T2 / WPRD TO INDIRECT THRU /******************************************************************* / / A ROUTINE TO MOVE A FILENAME FROM CUPFNM AREA TO INBUF AREA / /********************************************************************** MVCPIN, XX JMS CUCOPY INBUF+1 / TARGET AREA /M013 CDFMYF / SOURCE FIELD NBR CUPFNM / SOURCE FIELD /M013 CDFMYF / IN MY FIELD STRLEN / LENGTH OF MOVE JMP I MVCPIN / RETURN / ********************************************************************* /A039 / / WINCHK -ROUTINE TO CHECK IF SOURCE & DEST. DEVICES ARE WINNIE / AREAS AND SET UP APPROPRIATE FLAGS & TEXT POINTERS / CALLER HAS LEFT US IN MENU DATA FIELD!!!! / / ********************************************************************* /A039 WINCHK, AC0004 / MASK FOR WINNIE BIT IN MNOPTN AND I (MUBUF+MNOPTN) / GET WORD WITH WINNIE BIT SNA CLA / SKIP IF WINNIE BIT SET JMP WINCHX / ELSE JUST EXIT AC0010 / MASK FOR "DEV # 1 IS WINNIE" BIT AND I (MUBUF+MNOPTN) / AND IN THE WORD DCA WINONE / WILL BE NON-ZERO IF BIT WAS SET TAD TODRV / GET DESTINATION DEVICE # JMS ISWIN / & CHECK IF A WINNIE AREA DCA WINDST / NON-ZERO IF WINNIE TAD FROMDRV / REPEAT SEQUENCE FOR SOURCE JMS ISWIN DCA WINSRC WINCHX, JMP WINSTR / NOW GO SET THE TEXT POINTERS /----------------- PAGE /**************************************************************************** / / CONTROL IS PASSED HERE WHENEVER WE'RE DOING A COPY ALL AND THE / FILE NAME WE GOT FROM THE INPUT DISKETTE WAS NOT FOUND. THIS / SITUATION ARISES WHEN THERE IS A CORRUPTED INDEX FILE. COPY FILE'S / ROUTINES THAT READ THE INDEX FILE TO GET A FILE NAME ARE NOT SMART / ENOUGH TO REALLIZE THAT THE FILE IS CORRUPTED, AND THUS PASSES / GARBAGE AS THE FILE NAME. IT IS THEN NOT FOUND BY THE REGULAR / ROUTINES THAT READ THE INDEX FILE. WHEN THIS SITUATION ARISES, / NO MORE FILE NAMES WILL BE COPIED. THIS ROUTINE WILL MAKE IT AS IF / ALL THE FILE NAMES HAVE BEEN COPIED AND ONLY THE NUMBERED DOCUMENTS / ARE COPIED. / /****************************************************************************** CPYSL5, XX AC7775 / CHECK TO SEE IF THIS IS A COPY ALL TAD COPYTP / GET THE COPY TYPE WE'RE DOING SZA CLA / IS IT A COPY ALL? C004 JMP I CPYSL5 / IF NOT, RETURN IAC / CLEAR SIGNAL FOR MNTMP3 /A004 ISZ SIGNL / SIGNAL THAT WE'RE DOING ONLY NUMBERED DOCUMENTS NOW CDFMNU /C004 DCA I (MUBUF+MNTMP3) / TURN OFF BAD FILE INDICATOR /A004 TAD (MUBUF+MNIBUF / GET ADDR OF MENU STRING /C042 DCA I (MUBUF+MNPOS / PUT ADR OF MENU STRING INTO MENU OFFSET/C042 CDFMYF /C004 TAD DCNBR / GET THE DOCUMENT NUMBER WE'RE COPYING /C004 JMP CPYSL4 / GO COPY IT /***********************************************************************/ / / / DSPLNM -- DISPLAYS THE NAME OF THE DOCUMENT BEING COPIED / / IF THERE IS NO NAME IT DISPLAYS THE NUMBER / / ALSO DISPLAYS THE NEW NUMBER ASSIGNED ON THE DESTINATION DISC / / AND DISPLAYS THE 'COPYING BLOCK MESSAGE' / / / / REV HISTORY / / 007 GJP CREATED / / 037 HLP DISPLAY NEW NUMBER / / / /***********************************************************************/ DSPLNM, / XX / CLA / TAD SVIFNO / GET THE DRV-FILE NBR / AND P377 / STRIP OFF THE DRIVE NUMBER / DCA CPYNBR / PUT DOCUMENT NBR TO DISPLAY IT / JMS I TOPSC / GO ERASE AND DISP CIFMNU / '--COPY DOCUMENT--' / JMS I IOACAL / 0 / NOWCOP / "YOU ARE NOW COPYING DOCUMENT N" / 1115 / CPYNBR, 0 / DOCUMENT NUMBER / CLA / TAD SIGNL / SEE IF WE'RE DOING NUMBERED DOCUMENTS / SMA CLA / IF YES, THEN CHECK IF THERE'S A NAME / JMP DSPNM / IF NOT, GO DISPLAY THE NAME / TAD SIGNL3 / GET SIGNAL IF THERE IS A NAME / SNA CLA / IF NON ZERO HERE, THEN NO NAME / JMP DSPLN1 / NO NAME, GO DISPLAY NEW NUMBER /A037 DSPNM, / CIFMNU / JMS I IOACAL / 0 / DCNAME / 'XXXXXXXXXXXXX' / 1315 / INBUF+1 / NAME OF DOCUMENT / DSPLRT, DCA CHARCT / CLEAR THE CHARACTER COUNTER /M040 TAD ONE / GET A CONSTANT OF ONE / DCA BLKCNT / INIT BLOCK COUNTER / CIFMNU / JMS I IOACAL / 0 / COPCNT / DISPLAY COPYING BLOCK #001 / 1515 / JMP I DSPLNM / RETURN / /M039 SPACE WAR MOVE /D039DSPLN1, / NO NAME, SO DISPLAY THE NEW NUMBER /A037 /D039 / THE NEW NUMBER IS ALREADY AT INBUF+1 /A037 /D039 CIFMNU /D039 JMS I IOACAL /D039 0 /D039 NWNBRT / NEW NUMBER TEXT /D039 1315 / POSITION ON SCREEN /D039 INBUF+1 / BUFFER POINTER /D039 JMP DSPLRT / GO DISPLAY "COPYING BLOCK ..." /***********************************************************************/A007 / /A007 / BLOCK COUNT ROUTINE. THIS ROUTINE WILL DISPLAY THE COUNT OF /A007 / OF THE BLOCK OF THE DOCUMENT BEING COPIED. EACH TIME IT IS /A007 / ENTERED, IT WILL INCREMENT THE BLOCK COUNT AND DISPLAY IT. /A007 / /A007 /***********************************************************************/A007 DSPCNT, /A007 XX /A007 DCA CHARCT / CLEAR THE CHARACTER COUNTER /M040 ISZ BLKCNT / INCREMENT THE BLOCK COUNTER /A007 CIFMNU /A007 JMS I IOACAL /A007 0 /A007 BLOCKS /A007 IFDEF ENGLSH <1534> /A007 IFDEF ITALIAN<1532> IFDEF V30NOR <1523> /A046 IFDEF V30SWE <1523> BLKCNT /A007 JMP I DSPCNT /A007 CHARCT, 0 /M040 BLKCNT, 0 /A007 /***********************************************************************/M007 / /M007 / THIS ROUTINE WAS MOVED HERE TO MAKE ROOM ELSEWHERE. /M007 / IT MERELY PUTS A CHARACTER WHICH IS IN THE AC OUT TO /M007 / THE OUTPUT FILE. THE OUTPUT FILE HAVING BEEN PREVIOUSLY /M007 / OPEDNED FOR UPDATE. /M007 / IT WILL ALSO COUNT THE CHARACTERS BEING PUT OUT, AND GO TO /A007 / THE BLOCK COUNT DISPLAY ROUTINE WHENEVER THE CHARACTER COUNT /A007 / GETS TO 512(10), 1000(8), I.E. ONE BLOCK. /A007 / /M007 /***********************************************************************/M007 PDXCH, /M007 XX /M007 CDFMYF /M007 CIFFIO /M007 FILEIO /M007 XPUTST /M007 ISZ CHARCT / INCREMENT THE CHARACTER COUNT /M040 TAD CHARCT / GET THE CHAR COUNT /M040 TAD M512 / ADD IN MINUS 512(10)/100)(8) /A007 SMA CLA / IF MINUS, BLOCK STILL NOT FULL /A007 JMS DSPCNT / IF ZERO, THEN BLOCK IS FULL /A007 JMP I PDXCH /M007 /COPIES INPUT FROM MENU FIELD TO INBUF FOR NO MEANING PROMPT MVINPT, XX CLA JMS CUCOPY /GO COPY INPUT FROM MENU FIELD TO INBUF MUBUF+MNIBUF /ADDRESS OF FROM FOR CUCOPY /C042 CDFMNU /DATA FIELD OF FROM INBUF+1 /ADDRESS OF FOR FOR CUCOPY CDFMYF /CHANGE DATA FIELD TO MINE STRLEN /NUMBER OF WORDS TO COPY (STANDARD) JMP I MVINPT /RETURN TO CALLED /************************************************************************* / / THIS ROUTINE WILL INSERT THE NUMBER OF THE DRIVE PASSED TO IT IN / THE AC (IN ASCII) IN FRONT OF THE NAME OR NUMBER THAT THE USER / TYPED IN AT THE TERMINAL AND THEN SET DRIVE NUMBER WITH THE NAME / OR NUMBER OF THE FILE IN THE PROPER BUFFERS SO THAT THE ROUTINE / 'FILNAM' OF MENU CAN USE IT AND GET THE FILE WANTED. / /************************************************************************** FIXNAM, XX DCA CUB1 / GET BUFFER ADDR TAD PERIOD / GET A PERIOD ".' DCA CUB1+1 / PUT IT INTO BUFFER JMS CUCOPY / GO COPY OVER FILENAME/NBR FROMIN, INBUF+1 / FROM ADDR CDFMYF / FROM FIELD CUB1+2 / TO FIELD CDFMYF / TO FIELD STRLEN / LENGTH OF MOVE JMS CUCOPY / GO COPY IT BACK CUB1 / FILENAME/NMBR WITH DRV. IN FRONT OF IT CDFMYF / FROM FIELD MUBUF+MNIBUF / TO ADDR /C042 CDFMNU / TO FIELD STRLEN / STRING LENGTH JMP I FIXNAM / ********************************************************************* /A039 / / WINSTR - A CONTINUATION OF WINCHK, SETS UP TEXT STRING POINTERS /A039 / & PASSES CONTROL BACK TO ORIGINAL "CALLER" /A039 / / ********************************************************************* /A039 WINSTR, CDFMYF / BACK TO OUR FIELD /A039 TAD WINSRC / GET WINNIE SOURCE FLAG /A039 SZA CLA / SKIP IF NOT WINNIE /A039 TAD (TXTARE-TXTDRV) / IS WINNIE SET OFFSET OF AREA TEXT IN AC/A039 TAD (TXTDRV) / ADD IN POINTER TO DRIVE TEXT STRING /A039 DCA DCDEV / & PLUG DIRECTLY INTO IOACAL SEQUENCE /A039 TAD WINDST / GET WINNIE DESTINATION FLAG /A039 SZA CLA / SKIP IF NOT WINNIE /A039 TAD (TXTARE-TXTDRV) / IS WINNIE SET OFFSET OF AREA TEXT IN AC/A039 TAD (TXTDRV) / ADD IN POINTER TO DRIVE TEXT STRING /A039 DCA DSTDEV / & PLUG DIRECTLY INTO IOACAL SEQUENCE /A039 TAD WINDST / GET WINNIE DESTINATION FLAG /A039 SZA CLA / SKIP IF NOT WINNIE /A039 TAD (TXTVOL-TXTDSK) / IS WINNIE SET OFFSET OF VOLUME TEXT IN AC /A039 TAD (TXTDSK) / ADD IN POINTER TO DISKETTE TEXT STRING /A039 / & LEAVE IN AC TO BE SAVED BACK AT "WINRET" /A039 JMP WINRET / GO BACK TO ORIGINAL "CALLER" /A039 /----------------------- PAGE /*********************************************************************** / / THE SITUATION IS AS FOLLOWS: / THE NAME OF THE DOCUMENT TO BE COPIED IS ALREADY IN THE / INDEX FILE OF THE DISKETTE TO WHICH THE USER WANTS IT COPIED. / THIS CODE SETS UP THE SIGNALS TO THE MAIN MENU CODE TO ASK THE USER / WHAT HE WANTS TO DO. HE IS GIVEN THE FOLLOWING CHOICES: / 1. WRITE TO THE TOP OF DOCUMENT (MAIN MENU RETURNS A 6 IN AC) / 2. WRITE TO THE BOTTOM OF DOCUMENT(MAIN MENU RETURNS A 5 IN AC) / 3. OVERWRITE THE DOCUMENT (MAIN MENU RETURNS A 4 IN AC) / 4. BYPASS THE DOCUMENT (MAIN MENU RETURNS A 3 IN AC) / 5. RENAME THE DOCUMENT (MAIN MENU RETURNS A 2 IN AC) / / BEFORE GOING TO MAIN MENU, THIS ROUTINE WILL SET UP MNTMP4 AND MNTMP5 / TO 0 AND 1 RESPECTIVELY WHICH SIGNALS MAIN MENU TO DISPLAY THE / RIGHT QUESTIONS ASKING FOR THE ABOVE INFORMATION. / / THEN CONTROL IS PASSED TO SUBROUTINE 'DTAO', WHICH CALLS MAIN MENU / AND PUTS THE VALUE RETURNED IN THE AC BY MAIN MENU INTO 'OPTION', / THE VALUE TELLING US WHAT TO DO. / / PLEASE NOTE THAT THE VALUE AT 'OPTION' IS CHANGED BY THIS ROUTINE / TO THE VALUES GIVEN IN PARENTHESIS BELOW WHENEVER A WRITE-TO-TOP (0), / WRITE-TO-BOTTOM (1), OR OVERWRITE (-1) ARE REQUESTED. THESE LAST VALUES / ARE THE CODES WHICH ARE THE SIGNALS TO 'WPFILS' TO WRITE TO THE TOP, / BOTTOM, OR OVERWRITE THE DOCUMENT. / NOTE ALSO THAT THE VALUE 1, IS DEFAULTED TO BY SUBTRACTING -4 / (THE VALUE MAIN MENU PASSES FOR AN OVERWRITE) FORM 5 (THE VALUE MAIN / MENU PASSES FOR A WRITE-TO-BOTTOM) / /******************************************************************************* CTDDIN, / DOCUMENT ALREADY ON OUTPUT DISKETTE MQL AC0001 / SIGNAL MAIN MENU TO READ TBO JMS STTMPS / GO SET UP TO READ MAIN MENU / TAD TODRV /DRIVE TO COPY TO /A033 CIA /2'S COM /A033 TAD FROMDR /DRIVE TO COPY FROM /A033 SNA CLA / INPUT DRIVE=OUTPUT DRIVE? /A033 JMP RENAME /YES /A033 JMS DTAO / GO ASK WHAT IS WANTED AC0006 / GET A SIX TO CHECK FOR WRITE TO TOP CIA / COMPLEMENT IT TO COMPARE IT TAD OPTION / IS OPTION A WRITE-TO-TOP? SNA CLA / IF NOT, FALL THRU JMP ZOPTN / GO ZERO OPTION(SIGNAL FOR WRITE-TO-TOP) AC7776 / GET A MINUS 2 TO CHECK FOR RENAME OPTION TAD OPTION / GET OPTION TO CHECK IT SNA CLA / BYPASS JMP IF NOT RENAME JMP RENAME / GO RENAME THE DOCUMENT AC7775 / GET A MINUS 3 FOR CHECKING TAD OPTION / ADD IN THE OPTION SNA CLA / BYPASS JMP IF NOT RETURN JMP CUGSP / HE HIT RETURN AC0004 / GET A +4 TO CHECK FOR OVERWRITE CIA // CONVERT IT TO COMPARE TAD OPTION / GET THE VALUE OF OPTION SZA CLA / IS IT AN OVERWRITE? JMP SIZCK / NO, GO CHECK THE SIZE AC7777 / GET A -1, WPFILS OVERWRITE CODE ZOPTN, DCA OPTION / PUT IT WHERE EVERYONE CAN GET AT IT SIZCK, JMS TSTSZ / GO SEE IF THERES ROOM ENOUGH JMP NOROOM / GO TELL USER NO ROOM DOIO, / SET UP TO DO THE IO TAD SVIFNO / GET INPUT DOC AND DRV NBR JMS OPENRD / GO OPEN THE FILE FOR READ ONLY TAD SVOFNO / GET OUTPUT DOC AND DRV NBR MQL /INOT MQ FOR OPEN TAD OPTION / GET THE OPTION DESIRED CIFFIO FILEIO XDSKIN JMS DSPLNM / GO DISPLAY THE NAME TO THE USER /A007 JMS CPYFLE / GO COPY THE FILE JMP GOLDMU / HE HIT GOLD HALT JMP CUGSP / GO BACK FOR MORE / THE CODE BELOW ALLOWS THE USER TO RENAME THE DOCUMENT BECAUSE THE / OUTPUT DISKETTE ALREADY HAS A DOCUMNET OF THE NAME THAT'S ON / THE INPUT DISKETTE RENAME, JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL / GET READY TO OUTPUT A MEASSAGE 0 TXCS3 / ^P^S^P^S^P /A037 1505 TXETND / ENTER A NEW NAME FOR THE DOC ETC. 1705 TXOR / "OR " 7777 TXPRCN / "PRESS RETURN TO CONTINUE TO NEXT JMS ORGOLD / OR GOLD MNU ORAR CAM / USE COMBINED MICROINST OF CLA MQL TO SAVE 1 LO/A039 AC7777 / GET SIGNAL FOR CKINPT ROUTINE TELLING IT THAT WE / WANT A NAME ONLY (NOT A NUMBER) DCA RSIGN / PUT IT WHERE CKINPT CAN GET IT AC0002 / SIGNAL MAIN MENU TO READ ONLY (DON'T DO FILNAM) JMS STTMPS / GO SET MAIN MENU SIGNALS JMS READMU / GO TO MAIN MENU TO READ WHAT USER PUT IN JMP GOLDMU / HE HIT GOLD MENU, GO GET OUTY CDFMYF JMS CPMNOV / GO COPY THE INPUT OVER FROM MENU FIELD JMS CKINPT / GO CHECK WHAT HE PUT IN JMP CUGSP / HE HIT RETURN, GO GET NEXT FILE JMP GARBAG / HE PUT IN A NUMBER, BAD, GO TELL HIM DCA RSIGN / CLEAR SIGNAL THAT WE'RE DOING A NAME ONLY FOR /A019 / FOR CKINPT ROUTINE /A019 TAD TODRV / GET DRIVE WE ARE COPYING TO TAD OSXTY / MAKE IT AN ASCII NUMBER JMS FIXNAM / GO FIX UP THE NAME JMP CTDIN1 / GO CONTINUE PROCESSING WITH NEW NAME GARBAG, / HE TYPED IN GARBAGE, TELL HIM AND ASK AGAIN JMS MVINPT / /A037 JMS NOMEAN / /A037 JMP RENAME / GO ASK AGAIN /***********************************************************************/ / / / GTNBR -- GET THE NEXT AVAILABLE FILE NUMBER FROM THE DRIVE / / THAT WE ARE COPYING TO SO THAT WE CAN COPY THE FILE WHEN THE / / USER DOESN'T WANT TO NAME THE FILE. / / / / IF THERE ARE NO MORE AVAILABLE DOCUMENT NUMBERS THEN / / / WE WILL JUMP TO NSPCMSG. THIS IS A TEMPORARY FIX /A037 / / FOR A HIGH PRIORITY BUG. WE USED TO JUMP TO NOROOM /A037 / / WHICH GIVES THE WRONG MESSAGE AND DOESN'T PROPERLY /A037 / / HANDLE ALL EXITS /A037 / / JUMPING TO NSPCMSG HAS THE DISADVANTAGE OF HAVING THE /A037 / / ONLY EXIT BE TO MAIN MENU--THE COPY CANNOT CONTINUE TO /A037 / / THE NEXT DOCUMENT (COPY SOME OR ALL) WHICH COULD BE /A037 / / COPIED IF IT EXISTED ON IN A TBO SITUATION (E ELIMINATED/A037 / / THAT'S ALL FOLKS. THERE'S ONLY SO MUCH YOU CAN DO /A037 / / WITH SHIP DATE BREATHING DOWN YOUR NECK HLP /A037 / / / /***********************************************************************/ GTNBR, XX TAD TODRV / GET THE 'TO' DRIVE NUMBER JMS GTHMBL / GET THE HOME BLOCK AND SET IT UP FOR PROCESSING CUB1 / INPUT BUFFER ADDRESS JMS GTNXAV / GO GET THE NEXT AVAILABLE FILE NUMBER CUB1+12 / WHERE THE FILE NUMBERS ARE IN BUFFER SNA / NON-ZERO HERE MEANS WE GOT ONE JMP NSPCMSG / ZERO MEANS NONE LEFT. SEE COMMENTS ABOVE /C037 JMS DONBR / GO CONVERT IT TO DECIMAL CUPFNM / ADDRESS WHERE ASCII NUMBER WILL BE PUT JMP I GTNBR / RETURN COPOVR, XX JMS CUCOPY CUPFNM CDFMYF INBUF+1 CDFMYF STRLEN-1 JMP I COPOVR /************************************************************************* / / THIS ROUTINE SETS UP 'MNTMP4' AND 'MNTMP5' TO THE VALUES PASSED / TO IT IN THE MQ AND AC. THIS IS USED PRIOR TO GOING TO MAIN MENU / TO TELL THE MAIN MENU CODE WHAT TO DO. BEFORE USING 'READMU' / YOU MUST SET MNTMP4 AND MNTMP5 SO THAT MAIN MENU KNOWS WHAT TO DO. / /************************************************************************** STTMPS, XX / SET PARAMETERS FOR MAIN MENU CDFMNU DCA I (MUBUF+MNTMP4) MQA DCA I (MUBUF+MNTMP5) CDFMYF JMP I STTMPS / GO BACK /-------------------- PAGE NOROOM, / NOT ENOUGH ROOM ON FLOPPY TO HANDLE FILE JMS TOSMALL / GO PUT THE MESSAGE TODRV / DRIVE NUMBER WE'RE CPYING TO INBUF+1 / AREA WHERE NAME OF FILE IS CIFMNU JMS I IOACAL 0 TARTN 2005 JMS ORGOLD ORAR JMS KBRD JMP CUGSP / GO ASK FOR ANOTHER NAME TO COPY / READ A CHARACTER FROM THE INPUT DOCUMENT / / JMS RDNXCH; EOF RETURNS TO HERE; OK RETURNS TO HERE / RDNXCH, .; CLA; CDFMYF; CIFFIO; FILEIO; XRDFNC SPA;CLA / Treat errors like E-O-F. /A002 SZA ISZ RDNXCH JMP I RDNXCH /************************************************************************** / / THIS ROUTINE WILL GET THE NEXT AVAILABLE FILE NUMBER ON A DISKET / IT LOOKS FOR THE FIRST ZERO WORD IN THE HOME BLOCK. AS IT LOKS AT / EACH WORD OF THE AREA OF THE HOME BLOCK THAT CONATAINS THE HEADER / BLOCK NUMBERS FOR THE FILE, IT INCREMENTS A COUNTER. WHEN IT FINDS / A ZERO IT PUTS A 1 IN THE WORD IN THE HEADER BLOCK TO INDICATE / THAT THE FILE IS IN USE, AND RETURNS. / CALLED BY: / JMS GTNXAV / ADDR OF BUFFER OF HOME BLOCK +12 (THE AREA WHERE FILE NOS ARE. / NOTE: 12 ABOVE IS OCTAL / /****************************************************************************** GTNXAV, XX TAD I GTNXAV / GET THE ADDR WHERE FILE NOS ARE ISZ GTNXAV / TO RETURN ADDRESS DCA X0 / PUT ADDR WHERE FILE NOS ARE IN INDEX IAC DCA COUNT1 / INITALIZE THE COUNT GTNXA1, ISZ COUNT1 / INCREMENT THE COUNT TAD I X0 / GET THE HEADER BLOCK FORTHE FILE SNA / IF NOT ZERO, THEN ITS THERE JMP GTTN / WE'VE GOT ONE SMA CLA / ARE WE AT END OF FILE AREA? JMP GTNXA1 / GO GET ANOTHER ONE JMP I GTNXAV / NO-SKIP RETURN GTTN, AC7777 / MINUS ONE TO DECREMENT INDEX TAD X0 / DECREMENT INDEX DCA X0 IAC / SIGNAL FILE NUMBER IN USE DCA I X0 TAD COUNT1 / GET THE FILE NUMBER JMP I GTNXAV / RETURN COUNT1=T1 / NEXT FILE NUMBER /****************************************************************************** / / THIS ROUTINE WILL GET THE HOME BLOCKS OF THE DISKETTE INTO MEMORY, / AND SET IT UP SO THE ROUTINE THAT GET NEXT FILE NUMBER WILL BE ABLE / TO FUNCTION. CALLED BY: / TAD DRIVENO /C037 / JMS GTHMBL / BUFFER ADDRESS / THE ROUTINE PUTS A MINUS ONE AT END OF THE FILE NUMBER AREA SO THAT / WE CAN KNOW WHEN WE ARE OUT OF FILE NUMBERS / /****************************************************************************** GTHMBL, XX / DRIVE NO IS IN AC AT CALL /C037 JMS GTDENS / GO GET DRIVE AND CDF INTO Q-BLOCK / ESTABLISH THE DENSITY OF THE DRIVE TAD I GTHMBL / GET THE BUFFER ADDRESS DCA QUQBLK+RXQBAD / PUT IT INTO Q-BLOCK TAD (RXBDIR) / GET BLOCK NUMBER OF HOME BLOCK DCA QUQBLK+RXQBLK TAD (RXERD) / SET THE FUNCTION TO READ DCA QUQBLK+RXQFNC / PUT IT INTO Q-BLOCK JMS QURX / GO READ THE HOME BLOCK CLA TAD I GTHMBL / GET BUFFER ADDRESS AGAIN TAD (322) / POSITITON TO THE END OF FILE NUMBERS AREA DCA TADIPL / PUT IT TO TAD THRU AC7777 DCA I TADIPL / PUT STOPPER INTO AREA ISZ GTHMBL / GET TO RETURN ADDR JMP I GTHMBL / GO BACK TADIPL=T1 / PLACE TO INDIRECT HRU /*************************************************************************** / / THIS ROTUTINE WILL SEARCH FOR A PARTICULAR SEQUENCE OF CHARACTERS / ON A FILE OPENED BY RDFILE. THE ADDRESS OF THE SEQUENCE OF / CHARACTERS TO BE SEARCHED FOR SHOULD FOLLOW THE JMS INSTRUCTION / THAT CALLS THIS ROUTINE. CALL IT AS FOLLOWS: / JMS NMSRC / ADDRESS OF STRING TO SEARCH FOR / WHERE TO GO AT EOF / RETURN POINT WHEN STRING IS GOTTEN / /*************************************************************************** NMSRC, XX NMSRC1, TAD I NMSRC / GET THE THING TO SEARCH FOR DCA NMISSP / SAVE THE STRING POINTER NMSRC2, JMS RDNXCH / GO GET A CHARACTER FOR THE FILE JMP NMSRC3 / END OF FILE CIA / COMPLEMENT THE CHAR TAD I NMISSP / IS IT EQUAL? SZA CLA JMP NMSRC1 / NO, GO RE-INITIALIZE ISZ NMISSP / BUMP UP TO NEXT CHAR OF STRING TAD I NMISSP / THIS THE END OF THE STRING? SZA CLA JMP NMSRC2 / NO, GO CHECK NEXT CHARACTER ISZ NMSRC / YES, AND WE HAVE A MATCH NMSRC3, ISZ NMSRC / END OF FILE RETURN (ONE ISZ ONLY) JMP I NMSRC / GO BACK NMISSP=T1 / CHAR STRING COUNTER / / A ROUTINE THAT WILL READ ASCII NUMBER AND CONVERT IT TO BINARY. / USED TO CONVERT FILE NUMBERS THAT EXIST ON THE INDEX FILE. / CALL IT AS FOLLOWS: / JMS GTNUM / EOF RETURN / NORMAL RETURN (GOT NUMBER) / /****************************************************************************** GTNUM, XX DCA GTNUMV / INIT BINARY TO ZERO GTNUM1, JMS RDNXCH / GO GET A FILE CHARACTER JMP I GTNUM / END OF FILE RETURN TAD (-72) / IS IT A NUMBER? SMA / IT MIGHT BE IF IT IS MINUS HERE JMP GTNUMD / ITS NOT, SO WE'RE DONE TAD (LF) / IS IT A NUMBER? SPA / IF ITS POSITIVE HERE THEN IT IS JMP GTNUMD / IF IT ISN'T, WE'RE ALL DONE DCA T1 / STORE THE NUMBER TAD GTNUMV / GET VALUE OF PREVIOUS NUMBER (IF ANY) CLL RTL / MULTIPLY BY FOUR TAD GTNUMV / ADD IN THE ORIGINAL NUMBER CLL RAL / DIVIDE BY 2 TAD T1 / ADD IN THE NEW NUMBER DCA GTNUMV / STORE IT FOR NEXT NUMBER JMP GTNUM1 / GO DO NEXT DIGIT GTNUMD, CLA TAD GTNUMV / GET THE VALUE OF THE NUMBER IN AC ISZ GTNUM / NORMAL RETURN JMP I GTNUM GTNUMV=T2 / RECONSTRUCTED BINARY OF THE DECIMAL ASCII / CODE MOVED HERE FOR SPACE REASONS /M039 DSPLN1, / NO NAME, SO DISPLAY THE NEW NUMBER /A037/M039 / THE NEW NUMBER IS ALREADY AT INBUF+1 /A037/M039 CIFMNU /M039 JMS I IOACAL /M039 0 /M039 NWNBRT / NEW NUMBER TEXT /M039 1315 / POSITION ON SCREEN /M039 INBUF+1 / BUFFER POINTER /M039 JMP DSPLRT / GO DISPLAY "COPYING BLOCK ..." /M039 NMIBN, "<-200;"N-200+40;">-200;0 / CONSTANT NMIBNO, "<-200;"#-200;">-200;0 / <#> CONSTANT /-------------------- PAGE /********************************************************************** / / THIS ROUTINE RINGS THE BELL ON THE TERMINAL AND RETURNS / /********************************************************************** RBELL, XX CIFMNU JMS I IOACAL 0 ASTRING BELTXT JMP I RBELL /*********************************************************************** / / THIS ROUTINE ASKS THE USER WHETHER OR NOT HE WANTS TO COPY / A DOCUMENT DURING A COPY SOME OPERATION. IT WILL DISPLAY / THE NUMBER AND NAME (IF ANY) THEN ASK HIM TO TYPE A "Y" / IF HE WANTS TO COPY IT, OR HIT RETURN IF HE WANTS TO GO ON / TO THE NEXT DOCUMENT WITHOUT COPYING, OR GOLD MENU IF HE / IS THROUGH COPYING. / /**************************************************************************** CPWISH, XX DCA CPWIS1 / SAVE DOCUMENT NUMBER IN DISPLAY STATEMENT TAD I CPWISH DCA CPWIS2 / PUT THE ADDRESS OF THE NAME TO BE DISPLAYED CPWISR, /A027 JMS I TOPSC / GO ERASE AND DISP '--COPY DOCUMENT--' /A018 CIFMNU JMS I IOACAL 0 DYWTC / DO YOU WISH TO COPY DOCUMNET NBR X 1115 CPWIS1, 0 / DOCUMNET NUMBER TAD I CPWISH / DOES THE NAME EXIST? SNA CLA / IF NOT DON'T DISPALY IT JMP NONAM2 CIFMNU JMS I IOACAL 0 DCNAME 1315 / CURSOR POSITION CPWIS2, 0 / NAME OF THE DOCUMENT NONAM2, JMS MSIYDT / GO DISPLAY MESSAGE /A012 JMS WISHIN / GO CHECK THE RESPONSE JMP GOLDMU / HE HIT GOLD MENU JMP CUGSP / HIT RETURN, HE DIDN'T WANT TO COPY JMP CPWIS3 / NO MEANING TO WHAT HE TYPED IN /A027 JMS COPOVR / GO COPY BACK WHAT WAS IN INBUF /A022 ISZ CPWISH / BUMP UP TO REURN ADDRESS JMP I CPWISH CPWIS3, /A027 JMS COPOVR / GO RESTORE INBUF /A027 JMP CPWISR / GO REPEAT THE QUESTION /A027 /************************************************************************** / / THIS ROUTINE CHECKS THE INITAL INPUT ON A COPY ONE OPERATION / IT WILL DISCARD ANY [, CURLY BRACKET, OR X. INPUTS. / IT WILL CHECK TO SEE IF A DOCUMENT NUMBER WAS PUT IN OR A / DOCUMENT NAME WAS PUT IN. IF ONLY A [, CURLY BRACKET OR X. WERE PUT / IN, IT ISSUES THE NOMEANING MESSAGE. IF NO ARGUMENT IS PUT IN / IT WILL RE-ISSUE THE ORIGINAL MESSAGE. / /**************************************************************************** CKINPT, XX TAD (CUPFNM) / GET ADDR WHERE INPUT COPIED TO DCA T1 / PUT IT FOR INDIRECTING THRU JMS NXACLL / GO GET THE ARGUMENT JMP NOARGT / GO HERE IF NO ARGUMENT JMS CVDCLL / GO SEE IF ITS A NUMBER JMP CURLY1 / NOT A NBR, GO CHECK CURLY BRACKET JMS NXACLL / GO GET THE NEXT ARGUMENT JMP ITSNBR / YEAH, NO ARG, ITS A NUMBERED DOC CLA / ARGUMENT GOTTEN, SEE WHAT IT IS TAD INBUF+1 / GET THE ARGUMNET CIA / COMPLEMENT FOR COMPARE TAD PERIOD / IS IT A PERIOD SZA CLA / YES. JMP CURLY2 / NO, GO SEE IF ITS A CURLY BRACKET NMNGER, /C003 JMS COPOVR / DOCUMENT NAME HAS A NBR. IN FRONT OF IT/C013 JMP NERR / GO TELL NO MEANING TO WHAT HE TYPED /C003 JMS NXACLL / GO GET NEXT ARGUMENT JMP NERR / NO MEANING ERROR JMS CVDCLL / GO SEE IF ITS A NUMBER JMP ITSOK / NOT A NUMBER, MUST BE A NAME JMP ITSNBR ITSOK, ISZ SIGNL3 / SIGNAL THAT USER GAVE DOC A NAME /A007 JMS COPOVR / GO MOVE IT OVER TO INBUF /C013 ITSOK1, ISZ CKINPT NERR, ISZ CKINPT NOARGT, JMP I CKINPT / RETURN CURLY, ACL / RELOAD CHR /A037 /C038 CURLY1, TAD (-173) / IS IT A CURLY BRACKET? SZA TAD (173-133) / IS IT A SQUARE BRACKET? SZA CLA JMP ITSOK / NEITHER, MUST BE A NAME JMP NMNGER / GO DO NO MEANING MESSAGE /C003 CURLY2, TAD INBUF+1 / REFETCH CHR /A037 JMP CURLY1 / CONTINUE /A037 ITSNBR, AC7777 / SIGNAL THAT WE'RE DOING A NUMBERED FILE DCA SIGNL TAD RSIGN / ARE WE SUPPOSED TO BE DOING A NAME ONLY? SMA CLA / YES, GO TELL HIM HIS INPUT IS GARBAGE. JMP SIG1 / NO, GO SEE IF THERE IS A NAME FOR THE DOC DCA SIGNL / CLEAR THE NUMBERED FILE FLAG DCA RSIGN / CLEAR THE SIGNAL FOR NEXT TIME JMP NERR / GO TELL HIM HIS INPUT IS GARBAGE SIG1, AC7777 / GET A MINUS 1 TO CHECK IF WE'RE DOING COPY ONE TAD COPYTP / GET THE COPY TYPE WE'RE DOING SZA CLA / IF ZERO HERE, THEN WE'RE DOING A COPY ONE JMP ITSOK / RETURN OK TAD DCNBR1 / GET DCNBR SAVED IN CVDCLL /A038 DCA DCNBR / AND PASS TO DTNAM /A038 TAD FROMDR / GET THE DRIVE NUMBER WE'RE COPYING FROM JMS DTNAM / GO GET THE NAME OF THE FILE JMS COPOVR / GO MOVE THE FILENAME TO INBUF /A025 JMP ITSOK1 / RETURN CVDCLL, XX / CHECKS FOR A NUMBER CIFMNU JMS I CVDCAL INBUF+1 JMP I CVDCLL /D037 MQA /D037 DCA DCNBR DCA DCNBR1 / SAVE MORE LOCALLY /A038 ISZ CVDCLL JMP I CVDCLL NXACLL, / GET THE NEXT ARGUMENT XX CIFMNU JMS I NXACAL T1 INBUF JMP I NXACLL / NO MORE ARGUMENTS IN LIST ISZ NXACLL / THERE IS AN ARGUMENT, AND ITS IN INBUF NOW JMP I NXACLL DCNBR1, XX /A038 /*********************************************************************** / / THIS ROUTINE WILL DISPALY THE NAME OF A DOCUMENT WHEN THE DOCUMENT / NAME ALREADY APPEARS IN THE OUTPUT DISKETTE SO THAT THE USER CAN / CHOOSE WHETHER HE WANTS TO COPY TO THE TOP OR BOTTOM, OR OVERWRITE / IT, OR RENAME IT. / /**************************************************************************** DONAME, XX CIFMNU JMS I IOACAL 0 DCNAME 505 INBUF+1 JMP I DONAME /-------------------- PAGE / ***** W A R N I N G ********** W A R N I N G ****************** /A039 / ALL LINKS ON THIS PAGE MUST BE HAND CODED !!!!! /A039 ERRWIN, XX / CHECKS IF ERROR RETURN ON A GET DENSIT/A039 / CALL WAS A WINNIE AREA /A039 TAD I DRVERR / IS THE ERROR ON THE SOURCE DRIVE?? /A039 CIA / NEGATE THE DRIVE WHERE ERROR OCCURRED /A039 TAD FROMDRV / GET SOURCE DRIVE # /A039 SNA CLA / IF AC .NE. 0 NOT A SOURCE ERROR, SKIP /A039 TAD WINSRC / WAS SOURCE ERROR, WAS IT A WINNIE? /A039 SZA / NO NOT A WINNIE SOURCE ERROR, SKIP /A039 JMP WINERR / WAS A WINNIE SOURCE ERROR, GO HANDLE /A039 TAD I DRVERR / IS THE ERROR ON THE DESTN. DRIVE?? /A039 CIA / NEGATE THE DRIVE WHERE ERROR OCCURRED /A039 TAD TODRV / GET DESTN. DRIVE # /A039 SNA CLA / IF AC .NE. 0 NOT A DESTN. ERROR, SKIP /A039 TAD WINDST / WAS DESTN. ERROR, WAS IT A WINNIE? /A039 SZA / NO NOT A WINNIE DESTN. ERROR, SKIP /A039 JMP WINERR / WAS A WINNIE DESTN. ERROR, GO HANDLE /A039 JMP I ERRWIN / NOT A WINNIE ERROR MUST BE A DISKETTE /A039 DRVERR, DRVDSP / POINTER TO DEV # WHICH FAILED GETDENS /A039 / ********************************************************************* /A039 / /A039 / WINERR - INPUT: AC=DEVICE # IN ERROR /A039 / /A039 / REPORTS UNASSIGNED WINNIE AREA # & REQUESTS USER TO /A039 / PRESS GOLD MENU ..... /A039 / *** N.B. *** IF LINKS ARE NECESSARY WRITE THEM IN BY HAND OR USE /A039 / BASE PAGE. /A039 / /A039 / ********************************************************************* /A039 WINERR, DCA WINDRV / PUT DEVICE # INTO IOACAL SEQUENCE /A039 CIFMNU /A039 JMS I IOACAL / GO DISPLAY "AREA ? DOES NOT HAVE A VOLUME..." /A039 0 WINTXT 1505 TXTARE WINDRV, 0 TXTVOL JMP I MENRET / GO ASK FOR GOLD MENU RESPONSE & RETURN TO MENU/A039 MENRET, PGOLD / LINK FOR ABOVE "JMP I" INSTRUCTION /A039 TXCS1, TEXT '^P^S' / GENERAL PURPOSE CONTROL STRING/A037 TXCS2, TEXT '^P^S^P^S' / GENERAL PURPOSE CONTROL STRING/A037 TXCS3, TEXT '^P^S^P^S^P^S' / GENERAL PURPOSE CONTROL STRING/A037 TXOR, IFDEF ENGLSH IFDEF ITALIAN /A037 IFDEF V30NOR < TEXT 'EL '> /A046 IFDEF V30SWE < TEXT ''> CPY, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE SPRMPT, IFDEF ENGLSH < TEXT '&PLEASE ENTER THE &NAME OR &NUMBER ' *.-1 TEXT ' OF THE DOCUMENT YOU NOW WISH TO COPY' /C034 > IFDEF ITALIAN < TEXT '&INTRODURRE NOME O NUMERO DEL DOCUMENTO DA COPIARE' > IFDEF V30NOR < TEXT '&SKRIV NAVN EL. NUMMER' /A046 *.-1 TEXT ' P\E DET DOKUMENTET DU VIL KOPIERE' /A046 > IFDEF V30SWE < TEXT '&SKRIV NAMNET ELLER NUMRET P\E DET' *.-1 TEXT ' DOKUMENT DU VILL KOPIERA' > TXTIDN, IFDEF ENGLSH /A037 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE TXTID1, IFDEF ENGLSH /A037 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE GLST, IFDEF ENGLSH < TEXT '^P&DOCUMENT NUMBER ^D HAS NO NAME ' /C043 *.-1 TEXT '^P&ENTER A NAME OR NUMBER AND &PRESS &R&E&T&U&R&N ' *.-1 TEXT '^P&OR JUST &PRESS &R&E&T&U&R&N TO ASSIGN A NEW NUMBER ' > IFDEF ITALIAN < TEXT '^P&NUMERO DOCUMENTO ^D HA NO NOME. ' *.-1 TEXT '^P&INTRODURRE NOME O NUMERO E PREMERE !&RITORNO. ' *.-1 TEXT '^P&PREMERE !&RITORNO PER ASSEGNA UN NUOVO NUMERO.' > IFDEF V30NOR < TEXT '^P&DOKUMENT NUMMER ^D HAR IKKE NOE NAVN ' /A046 *.-1 TEXT '^P&SKRIV INN ET NAVN ELLER NUMMER OG TRYKK P\E !&RETUR' /A046 *.-1 TEXT '^PEL. TRYKK P\E !&RETUR FOR \E GI DET ET NYTT NUMMER' /A046 > IFDEF V30SWE < TEXT '^P&DOKUMENT NUMMER ^D HAR IGNET NAMN' *.-1 TEXT '^P&SKRIV ETT NAMN ELLER NUMMER OCH TRYCK P\E RETUR' *.-1 TEXT '^P&F\VR ATT TILLDELA ETT NYTT NUMMER, TRYCK P\E RETUR ' > / END IFDEF V30SWE SYSTM, IFDEF ENGLSH < TEXT '^P&IF NECESSARY, REMOVE THE SYSTEM DISKETTE FROM DRIVE 0 AND THEN' > IFDEF ITALIAN < TEXT /^P&SE NECESSARIO, TOGLIERE IL DISCO SISTEMA DALL'UNIT\@ 0 \H/ > IFDEF V30NOR < TEXT '^P&TA EVT. SYSTEMDISKETTEN UT AV STASJON 0 OG'> /A046 IFDEF V30SWE < TEXT '^P&OM N\VDV\DNDIGT, TA UT SYSTEMDISKETTEN UR ENHET O OCH'> AITDT, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE RECEV, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE COPYF, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE DEXTS, IFDEF ENGLSH /C043 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE DREST, IFDEF ENGLSH < TEXT '^P&HOW WOULD YOU LIKE THE DOCUMENT MODIFIED?' *.-1 TEXT '^P&T = &ADD TEXT TO THE TOP ' *.-1 TEXT '^P&B = &ADD TEXT TO THE BOTTOM' *.-1 TEXT '^P&O = &OVERWRITE THE DOCUMENT' *.-1 TEXT '^P&E = &ENTER A NEW NAME FOR THIS DOCUMENT' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N, OR JUST ' *.-1 TEXT '^P&PRESS &R&E&T&U&R&N TO CONTINUE TO THE NEXT DOCUMENT,' > IFDEF ITALIAN < TEXT /^P&MODALIT\@ MODIFICA: / *.-1 TEXT /^P&I = &INSERIRE IL TESTO ALL'INIZIO / *.-1 TEXT /^P&F = &INSERIRE IL TESTO ALLA FINE / *.-1 TEXT /^P&S = &SOVRASCRITTURA / *.-1 TEXT /^P&N = &NUOVO NOME PER IL DOCUMENTO / *.-1 TEXT /^P&SCEGLIERE UN'OPZIONE E PREMERE !&RITORNO, / *.-1 TEXT /^P&PREMERE !&RITORNO PER PASSARE AL DOCUMENTO SUCCESSIVO,/ > IFDEF V30NOR < /A046 TEXT '^P&HVORDAN VIL DE ENDRE DOKUMENTET? ' *.-1 TEXT '^P&T = &TILF\XYE TEKST P\E TOPPEN ' *.-1 TEXT '^P&B = &TILF\XYE TEKST P\E BUNNEN ' *.-1 TEXT '^P&O = &OVERSKRIVE DOKUMENTET' *.-1 TEXT '^P&N = &GI DETTE DOKUMENTET NYTT VAVN ' *.-1 TEXT '^P&VELG ALTERNATIV OG TRYKK P\E !&RETUR EL.' *.-1 TEXT '^P&TRYKK P\E !&RETUR FOR \E G\E TIL NESTE DOKUMENT' > IFDEF V30SWE < TEXT '^P&HUR SKA DOKUMENTEN MODIFIERAS? ' *.-1 TEXT '^P&B = &L\DGGA TILL TEXT I B\VRJAN' *.-1 TEXT '^P&S = &L\DGGA TILL TEXT I SLUTET ' *.-1 TEXT '^P&\V = &SKRIVA \VVER DOKUMENTET' *.-1 TEXT '^P&N = &SKRIV ETT NYTT DOKUMENTAMN' *.-1 TEXT '^P&SKRIV KODEN OCH TRYCK P\E RETUR' *.-1 TEXT '^P&F\VR ATT FORTS\DTTA TILL N\DSTA DOKUMENT, TRYCK P\E RETUR' > / END IFDEF V30SWE NDOC, IFDEF ENGLSH /C039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE DYWTC, IFDEF ENGLSH /C043 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE DCNAME, TEXT '^P"^A"' NWNBRT, IFDEF ENGLSH < / NEW NUMBER TEXT /A037 TEXT '^P&THE NEW NUMBER IS ^A'> /A037 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE NOWCOP, IFDEF ENGLSH /C043 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE TXETND, IFDEF ENGLSH < TEXT '&ENTER THE NEW NAME FOR THE DOCUMENT AND THEN &PRESS &R&E&T&U&R&N,' > IFDEF ITALIAN < TEXT /&INTRODURRE IL NUOVO NOME PER IL DOCUMENTO E PREMERE !&RITORNO,/ > IFDEF V30NOR < TEXT '&ANGI NYTT NAVN FOR DETTE DOKUMENTET OG TRYKK P\E !&RETUR,'> /A046 IFDEF V30SWE < TEXT '&SKRIV DET NYA DOKUMENTNAMNET OCH TRYCK SEDAN P\E RETUR.'> TXPRCN, IFDEF ENGLSH < TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE TO THE NEXT DOCUMENT,'> IFDEF ITALIAN < TEXT /PREMERE !&RITORNO PER PASSARE AL DOCUMENTO SUCCESSIVO,/ > IFDEF V30NOR < TEXT 'TRYKK P\E !&RETUR FOR \E G\E TIL NESTE DOKUMENT,'> /A046 IFDEF V30SWE < TEXT '&F\VR ATT FORTS\DTTA TILL N\DSTA DOKUMENT, TRYCK P\E RETUR,> TXIYD, IFDEF ENGLSH < TEXT '&IF YOU DO, TYPE &Y AND &PRESS &R&E&T&U&R&N, OR JUST '> IFDEF ITALIAN < TEXT /&INTRODURRE !&SI E PREMERE !&RITORNO, OPPURE/ > IFDEF V30NOR < TEXT '&HVIS DU VIL DET, SKRIV &J OG TRYKK P\E !&RETUR , EL.'> /A046 IFDEF V30SWE < TEXT '&OM DU G\VR DET, SKRIV &J OCH TRYCK P\E RETUR'> NERD, /d041 TEXT '^P&THERE IS NOT ENOUGH ROOM ON &^S ^D TO CONTAIN THE DOCUMENT' IFDEF ENGLSH < TEXT '^P&^S ^D NOT INITIALIZED !&OR DOES NOT HAVE ROOM FOR THE DOCUMENT'/A041 > IFDEF ITALIAN < TEXT /^P&^S ^D NON INIZIALIZZATA O SPAZIO INSUFFICIENTE PER IL DOCUMENTO/ > IFDEF V30NOR < TEXT '^P&^S ^D ER IKKE KLARGJORT EL. HAR IKKE PLASS TIL DOKUMENTET'>/A046 IFDEF V30SWE < TEXT '^P&^S ^D \DR INTE INTE INITIERAD ELLER HAR INTE PLATS F\VR DOKUMENTET'> TRYAGN, IFDEF ENGLSH < TEXT '^P&WHEN TYPING TO THE MENU, USE NORMAL KEYS ON THE KEYBOARD ONLY. ' /C021 *.-1 IFDEF CONDOR < /A030 TEXT '^P&THE &RUBOUT KEY CAN ALSO BE USED. &A LINE MAY CONTAIN A' /C021M030 > / END IFDEF CONDOR /A030 IFNDEF CONDOR < /A030 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D CAN ALSO BE USED. ' /A030 *.-1 /A030 TEXT '&A LINE MAY CONTAIN A ' /A030 > / END IFNDEF CONDOR /A030 *.-1 /C021 TEXT '^PMAXIMUM OF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N.' /C021 *.-1 TEXT '^P&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.' > IFDEF ITALIAN < TEXT /^P&PER SCEGLIERE LE OPZIONI DEL MENU UTILIZZARE SOLO I TASTI AL / *.-1 TEXT /FANUMERICI^PE SE NECESSARIO IL TASTO !AX]. &UNA RIGA PU\R CONTENRE AL //m045 *.-1 TEXT /^PMASSIMO 71 CHARATTERE E DEVE TERMINARE CON !&RITORNO. / *.-1 TEXT /^P&PREMERE !&RITORNO PER CONTINUARE./ 74;0 /a045 > IFDEF V30NOR < /A046 TEXT '^P&BRUK BARE TEGN P\E HOVEDTASTATURET N\ER DU SKRIVER EN KOMMANDO ' *.-1 TEXT '^P!&SLETT-TASTEN KAN OGS\E BRUKES. &EN LINJE KAN HA ' *.-1 TEXT '^PMAKS. 71 TEGN OG M\E AVSLUTTES MED !&RETUR' *.-1 TEXT '^P&TRYKK P\E !&RETUR OG PR\XV IGJEN.' > IFDEF V30SWE < TEXT '&ANV\DND BARA "VANLIGA" TANGENTER N\DR DU SKRIVER I MENYN ' *.-1 TEXT '&DU KAN OCKS\E ANV\DNDA RADERA. &EN RAD KAN INNEH\ELLA' *.-1 TEXT '&DU KAN OCKS\E ANV\DNDA RADERA TKN ELLER RADERA ORD.' *.-1 TEXT '&EN RAD F\ER INNEH\ELLA' *.-1 TEXT 'MAXIMALT 71 TECKEN OCH M\ESTE AVSLUTAS MED RETUR' *.-1 TEXT '&TRYCK P\E RETUR OCH FVRSVK IGEN.' > / END IFDEF V30SWE TARTN, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE CNTCRE, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE WNUM, IFDEF ENGLSH IFDEF ITALIAN< TEXT /^P&I NUMERI DEI DOCUMENTI DEVONO ESSERE DA 1 E 200/ > /a045 IFDEF V30NOR < TEXT 'DOKUMENTNUMRENE G\ER FRA 1 TIL 200.'> /A046 IFDEF V30SWE < TEXT 'DOKUMENTNUMRET M\ESTE VARA MELLAN 1 OCH 200'> NMDC, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE NONIN, IFDEF ENGLSH < /A017 TEXT '^P&YOUR ^S IS NOT INITIALIZED.'> /A017 IFDEF ITALIAN < TEXT /^P&IL DICHETTO NON \H INITIALIZZETO./ > IFDEF V30NOR < TEXT '^P&^S ER IKKE KLARGJORT.'> /A046 IFDEF V30SWE < TEXT '^P&DIN ^S \DR INTE INITIERAD.'> CNRG, TEXT '^P ' NMEAN, IFDEF ENGLSH < TEXT '^P&TYPING "^A" HAS NO MEANING HERE. &PRESS &R&E&T&U&R&N TO TRY AGAIN.' /C021 > IFDEF ITALIAN < TEXT /^P&"^A" &OPZIONE NON VALIDA/ > IFDEF V30NOR < TEXT '^P"^A" KAN IKKE BRUKES HER. &TRYKK P/E !&RETUR OG PR\XV IGJEN' > /A046 IFDEF V30SWE < TEXT '^P"^A" BETYDER INGENTING H\DR, TRYCK P\E RETUR OCH FVRSVK IGEN.'> PRTRN, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE DOGM, IFDEF ENGLSH < TEXT '^P^A&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.'> IFDEF ITALIAN< TEXT /^P^APREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE./ > IFDEF V30NOR < TEXT '^P^A&TRYKK P\E &GULL !&MENY FOR \E F\E HOVEDMENYEN.'> /A046 IFDEF V30SWE < TEXT '^P^A&FVR ATT KOMMA TILL HUVUDMENYN, ANV\DND GULD MENY'> ORAR, IFDEF ENGLSH <"O&177;"R&177;40;0> IFDEF ITALIAN<"O&177;40;0> IFDEF V30NOR <"E&177;"L&177;40;0> IFDEF V30SWE <"E&177;"L&177;40;0> NARG, 0 RPLACE, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE YNAD, IFDEF ENGLSH < /A018 TEXT '^P&YOU NEED A DISKETTE IN DRIVE ^D. ' /A018 *.-1 /A018 TEXT '&PUT A DISKETTE IN THE DRIVE' /A018 > IFDEF ITALIAN < TEXT /^P&NECESSITA UN DISCHETTO NELL'UNIT\@ ^D. / *.-1 TEXT /&INSERIRE UN DISCHETTO NELL'UNIT\@/ > IFDEF V30NOR < TEXT '^P&DET M\E ST\E EN DISKETT I STASJON ^D. ' /A046 *.-1 TEXT '&SETT EN DISKETTE I STASJONEN' /A046 > IFDEF V30SWE < TEXT '^P&DU BEHVVER EN DISKETT I ENHET ^D.' *.-1 TEXT '&S\DTT I EN DISKETT I ENHETEN' > / END IFDEF V30SWE PSCR, TEXT '^P!E' ASTRING,TEXT '^A' BELTXT, BELL;0 COPCNT, IFDEF ENGLSH /A007 /C043 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE BLOCKS, TEXT '^P!3D' /A007 TXTARE, IFDEF ENGLSH /A039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE TXTDSK, IFDEF ENGLSH /A039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE TXTVOL, IFDEF ENGLSH /A039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE TXTDRV, IFDEF ENGLSH /A039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE WINTXT, IFDEF ENGLSH /A039 IFDEF ITALIAN IFDEF V30NOR /A046 IFDEF V30SWE CUB1, ZBLOCK 400 INBUF, -STRLEN ZBLOCK STRLEN+1 /-------------------- PAGE   /WPVFY - VERIFY IMAGE STRUCTURE / .TITLE Verify 3.3 / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / 058 KMD 30-Sep-85 Add Dutch & Spanish / 057 mdh 19/aug/85 fix italian IFDEF bugs / PS needs more translation / *** EDIT HISTORY *** / / 056 LAD Changes to recognize newly valid format: / a valid image may be smaller than the medium on which it / resides. This situation can only be true on RX50 and RD5x / A system image must always use all of an RX01/02 and must / be at least 800 blocks on RX50 and RD5x. / 055 LAD to 10/26/84 BP problems being addressed & going into / Version 2.0. This is a continuation of the clarifying / re-write and V2.0 functionality ongoing in 054. / / 054 LAD to 8/8/84 Add logic & modify logic to recognize & / properly handle RD50 based systems. Added ^P in CRSHM2 / from 1.5 bug fix. Added logic in WPSDET to look for / possible COS images & warn the user that the media may / not be in WPS format, added message "BEWARE". FIXED A / bug in CHKCOS: it has never checked COS COUNTS correctly / due to a data field error. / / 053 LAD 07-JAN-84 Add logic: unless the medium being ver- / ified has a valid WPS Home block or Allocation block, / it is considered to be of class "utility" and structure / checking and copying will not be allowed. / / 052 WJY 06-JAN-84 Add revised logic to handle non-existent / drives. / 051 LAD 20-DEC-83 Changed VEHBLK to look for a document / count of -1 to ease Spelling Checker problem. / 050 LAD 20-DEC-83 Compress and move most code in Field 5 / to Field 3. F5 now just the IOA calling routine & text. / 049 LAD 27-NOV-83 Make prompts re-entrant. / 048 LAD 22-NOV-83 Corrected bad Drive 0 prompt. / 047 LAD 20-N0V-83 Corrected "Insert Volume .... prompt. / Changed old /A047 entries to /A0X7. / 046 WJY 20-NOV-83 Modify to return system blocks to the / free pool when recovering a system disk / 045 LAD 20-NOV-83 Modified messages and calls to reflect / "WINNY" considerations. Modified VEPRMT to handle 3 / passed arguments. Added note for Natural Languages viz / IFDEFs in arguments to IOASET. / 044 WJY 16-NOV-83 ADD CODE TO CHECK SIZE OF WINNIE VOL. / 043 WCE 30-0CT-83 CHANGE REG0-REG7 TAGS TO AIR10-AIR17 / 042 LAD 01-0CT-83 "WINNYIZE" VERIFY. / 041 BCR 28-SEP-83 GOLD HALT return to MENU only / 040 WCE 19-JUL-83 Modify label for new prefix file / 039 DFB 21-FEB-83 Fix for ifndef condor / 038 GJP 09-JAN-83 NOT PICKING UP ALLOCATED BUT UNASSIGNED / BLOCKS, FIXED TO PICK THEM UP / 037 GJP 17-DEC-82 REMOVE SUPERFLUOUS CODE / 036 GJP 16-DEC-82 FIX REPORT BAD DISK BUG / 035 GJP 16-NOV-82 REMOVE RESIDUE LINE FROM SCREEN / 034 GJP 04-NOV-82 REMOVE ERROR MESSAGE FROM SCREEN (COSMETIC) / 033 GJP 01-NOV-82 FIX SYSTEM DISKETES NOT VERIFYING / 032 GJP 26-OCT-82 FIX OVERWRITE ON NO DISKETTE IN DRIVE / 031 GJP 16-OCT-82 FIX RING BUFFER BUG / 030 GJP 14-OCT-82 COPY COSCNT NOT IN HOME BLOCK BUG / 027 GJP 27-MAY-82 ALTER TO HANDLE RX50 DRIVES / 026 PHA 09-APR-82 INSERT LOOP FOR WHEN DRIVE #1 IS LEFT / OPEN, ALLOWS CONT AND GOLD+MENU / 025 PHA 22-MAR-82 EXTRA flag for go-to page test / 024 PHA 1-MAR-82 fix baddsc data field and message / 023 PHA 28-DEC-81 increase screen hold time on err msgs / 022 PHA 11-DEC-81 make sure object disk is same density / as source before copying / 021 PHA 10-DEC-81 FIX problem when copying large files / 020 PHA 5-DEC-81 ADD routine to copy go-to-page blocks / when copying from a bad diskette / 019 PHA 18-NOV-81 ADD rapid pagination structure test to / document header test / 018 PHA 03-NOV-81 Moved write out code into verify.pa / was previously WTVFY.PA / 017 PHA 23-Oct-81 Hold screen a moment and buzz terminal / on errors other than readability / 016 PHA 22-Oct-81 Changes for double density / 015 GDH 20-OCT-81 Deimplemented LOCK/UNLOCK. / 0014 DIM 3-SEPT-81 Changed left drive 0 and right / drive to drive 1 for French 278 / 0013 GDH 27-Aug-81 WPFILS calling seq changes. / 0012 TT 07-JUL-81 Removed superfluous conditionals / 0011 AJF 22-APR-81 CHANGED LEFT DRIVE TO DRIVE 0 / AND RIGHT DRIVE TO DRIVE 1 / 0010 JM 01-APR-81 Changes for CANADA / 0009 DM,JM 15-SEPT-80 Merged Scandi and Europe/English / 0008 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 0007 CMW 06-AUG-80 MADE GRAMMICAL CHANGES FOR DUTCH / 0006 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 0005 CMW 05-MAY-80 ENTERED CANADA TRANSLATIONS / 0004 DSS 17-APR-80 ENTERED DUTCH FIXES / 0003 GLT 18-Mar-80 Changed VEPRMT to use a different / / method of getting its arguments. Changed / / SETMS1,2 and 3 to reflect this change. / 0002 GLT 28-Feb-80 Changed VEPRMT to return +1 instead of / / +2 because it seems that it used to have / / a "No" branch which has been removed in a / / previous edit. (see VEPRMT) / 0001 CMW GLT 10-JAN-80 ADDED FRENCH,DUTCH,GERMAN TRANSLATIONS / / French diacritical substitutions: / / "["=L.A.E, "]"=L.G.E; "&" not used. / / German diacritical substututions: / / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" for U.C. / / Dutch diacritical substitution: / / "&["="ij" / 3.Y MB 11-MAY-78 FIX COS CONVERSION AGAIN / 2.7+ MB 02/28/78 TAKE CARE OF BAD SPACING IN MESSAGES / 2.7+ MB 03/15/78 FIX BAD MESSAGE AFTER VERIFY / / IT SAID DISK BAD / /WTVFY - WRITE OUT WPVFY FIELD 0 *200 JMP I .+2 JMP I .+2 RXLOAD 7605 *RXLDLS RXEWT 0 RXQBLK . DLOVFY 0 CDF 30 -DSOVFY /M027 DL3VFY 200 CDF 40 -DS3VFY 0 /-- / /WPF0,WPDL,RXDCL,WPKBDA,WTVFY,VERIFY /CONSTANTS /BUFFER DEFINITIONS: OCTAL ABLOCK=400 /256 DECIMAL WORDS IN A WPS BLOCK /A055 /FIELD 4 BUFFERS VBLKBF=0 /READ BUFFER HBLKBF=VBLKBF+ABLOCK /HOME BLOCK BUFFER /M054 HBBUF2=HBLKBF+ABLOCK /2ND HOME BLOCK BUFFER /A055 ABLKBF=HBBUF2+ABLOCK /ALLOCATION BLOCK BUFFER /M054 HDR1BF=ABLKBF+ABLOCK /FILE HEADER BUFFERS /M054 HDR2BF=HDR1BF+ABLOCK HDR3BF=HDR2BF+ABLOCK HDR4BF=HDR3BF+ABLOCK /A054 VVOLBU=HDR4BF+ABLOCK /VOLUME DATA BUFFER FOR 'VERIFY' VOLUME /C055 CVOLBU=VVOLBU+40 /VOLUME DATA BUFFER FOR 'COPY TO' VOLUME /A054 DOCLST=CVOLBU+40 /DOCUMENT ATTRIBUTE LIST. /A055 /BIT 0=NOT (TO BE) COPIED /C056 /BIT 1=MORE THAN ONE CLAIMING HEADER BLOCK /C056 /BIT 2=GO-TO-PAGE ERROR /A056 /BIT 3=A DATA BLOCK IS ANOTHER FILE'S HEADER /A056 /BIT 4=A DATA BLOCK IS A GO-TO-PAGE BLOCK ELSEWHERE /BIT 5=A DATA BLOCK IS CLAIMED AS DATA ELSEWHERE/A056 /BIT 6=A DATA BLOCK IS A AN EXTENSION HEADER ELSEWHERE /BIT 7=THE HEADER 1 IS A DATA BLOCK ELSEWHERE /A056 TOP=DOCLST+311 /A055 / /FIELD 5 BUFFER /STABUF=0 /HARD DISK READ STATUS BUFFER /A054 /CYLNO=1 /CYLINDER NUMBER /A054 /HEADNO=2 /HEAD NUMBER /A054 /SECTNO=3 /SECTOR NUMBER /A054 /CPVNO=4 /CONTROLLER PROGRAM VERSION NUMBER /A054 / /FIELD 6 BUFFERS BLKLST=0000 /2000 WORD BLOCK LIST IN FIELD 6 /A054 TYPLST=3720 /2000 WORD TYPE LIST IN FIELD 6 /A054 /BLKLST FLAGS/MASKS: ALLO FIX HOME FIX / 4000 FREE / 2000 READ FAILURE / 1000 COUNT NOT -255 / 0400 MULTIPLY USED / 0377 SYSTEM OR 'UNUSED' /A056 / 0376 A FAKE FILE # FOR BUILDING THE COPY'S ALLOCATION BLOCK /A056 / 0375 A FAKE FILE # TO INDICATE AN ILLEGAL FILE # WAS DETECTED/A056 / 0NNN 1 - 310, THE FILE # IN THE BLOCK OR THE CLAIMING FILE # /A056 / /D056/ 377 N, USED BY FILE N * / /TYPLST FLAGS/MASKS: / 4000 BAD SOMEHOW * / 2000 DATA / 1000 HEADER * / 0400 GO-TO-PAGE BLOCK /A056 / 0NNN 1 - 310, THE FILE # IN THE BLOCK; HEADERS & GO-TO-PAGE ONLY/A056 / /D056/ 400 SYSTEM * / / FIELD 3 /GLOBAL VARS CDFMYF=CDFEDT CDFLST=6261 /FIELD 6 IS THE "LIST" FIELD /A054 *10 AIR10, 0 /AUTO INDEX REGISTER 10 /M055 AIR11, 0 /AUTO INDEX REGISTER 11 /M055 AIR12, 0 /AUTO INDEX REGISTER 12 /M055 AIR13, 0 /AUTO INDEX REGISTER 13 /M055 AIR14, 0 /AUTO INDEX REGISTER 14 /M055 AIR15, 0 /AUTO INDEX REGISTER 15 /M055 AIR16, 0 /AUTO INDEX REGISTER 16 /M055 AIR17, 0 /AUTO INDEX REGISTER 17 /M055 *100 HOMEOK, 0 /FLAG BAD HOME BLOCK JMP I HOMEOK ALLOK, 0 /BAD ALLOCATION BLOCK FLAG /M054 JMP I ALLOK ERRORS, 0 /ERROR SUMARY FLAG JMP I ERRORS DSKNAM, ZBLOCK 7 /DISKETTE NAME, ASCIZ DENFLG, 0 /DENSITY FLAG... VALUES: / 0 - SINGLE /A016 / 1 - DOUBLE /A016 / 2 - RX50, SINGLE SIDED /AXXX / 3 - RX50, DOUBLE SIDED /A042 / 4 - RD50 VOLUME MOUNTED /A042 FILCNT, 0 /# CREATED FILES ON DISKETTE FILENO, 0 /CURRENT FILE # DRIVE, 0 /THE NUMBER OF THE CURRENT DRIVE OR DEVICE CPYDRV, 0 /"COPY TO" DRIVE NUMBER /M042 SVDRV, 0 /SAVE LOCATION FOR THE 'VERIFY' DEVICE NUMBER /A054 /D056VBLKPT, 0 TCOUNT, 0 /D056FLAG, 0 ERRCNT, 0 /ERRORS IN WHOLE DISKETTE VERIFY /C042 FILDLT, 0 /# FILES DELETED DUE TO ERRORS FRECNT, 0 /# FREE BLOCKS ON DISKETTE VEDBCT, 0 /BLOCK COUNT BY EXAM FILE HDR HOMPTR, 0 HOMCNT, 0 BLKOUT, 0 BLKIN, 0 HDRPTR, 0 SBLKNO, 0 /UTILITY 'CURRENT BLOCK' REGISTER /M055 SYSDSC, 0 /ADDRESS OF THE FIRST LEGAL DOCUMENT BLOCK /M055 SYSDSK, 0 /0 IF VERIFYING DOCUMENT IMAGE, 1 IF SYS IMAGE /A054 DSKSIZ, 0 /SIZE OF DISKETTE IN BLOCKS /C055 DSKIDX, 0 /-SIZE OF DISKETTE IN BLOCKS /C055 ALCCNT, 0 /# OF ALLOCATION WORDS IN ALLOCATION BLOCK /M054 RPBPTR, 0 /BUFFER POINTER FOR CPYRPB /M055 /THESE THREE WORDS MAKE COPY OF LARGE DOCUMENTS POSSIBLE EXTFLG, 0 /FLAG TO CONTROL SIZE OF HEADER BLOCKS /A024 EXTPTR, 0 /PTR TO NEXT EXTENSION HEADER BLOCK /A024 XTNFLG, 0 /FLAG TO MAKE COPY LOOP USE EXT HDR BLOCK MODE /A024 BLKNO, 0 /CURRENT BLOCK NUMBER /M042 CPDRV0, 0 /SAVES THE "COPY TO" # WHEN STARTED /A048 VMED, 0 /SOURCE MEDIUM TYPE /A049 VDEV, 0 /SOURCE DEVICE TYPE /A049 VCMED, 0 /"COPY TO" MEDIUM TYPE /A049 VCDEV, 0 /"COPY TO" DEVICE TYPE /A049 MAXDEV, 0 /HOLDS LARGEST DEVICE/DRIVE # AVAIL ON SYSTEM /A054 CLASSU, 0 /IF SET <>0 THE CLASS IS 'UTILITY' /A054 WINSYS, 0 /IF SET <>0 THERE IS A WINCHESTER PRESENT /A054 LINENO, 0 /LINE NUMBER FOR HARD DISK ERROR DISPLAY /A054 COLNO, 0 /COLUMN COUNT FOR SNDNUM & STATUS DISPLAY SUBS /A055 CHAIN, 0 /'CHAINED INTO VERIFY' FLAG /A055 DBLKCT, 0 /COUNT OF DATA BLOCKS IN A FILE /A055 IOASET, IOAOUT /POINTER FOR IOAOUT /A042 IQURX, QURX /INDIRECT FOR QURX CALLS /A054 IZERO, ZERO RX50SZ, 0 /FLAG INDICATING AN RX50 SIZE IMAGE /A056 SAVBLK, 0 /(BLKOUT) AT START OF EACH FILE COPY /A056 *175 REG10, 0 REG11, 0 REG12, 0 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VERIFY, XX /ENTRY FROM MNUFLD NOP /USE A HALT FOR TEST CLA RDF TAD CIDF0 DCA RTNCIF /GET RETURN FIELD CDFBUF AC7777 /ZERO MEM BUFFER DCA AIR17 /M043 AC7777 /MINUS 1 WILL CLEAR THE ENTIRE FIELD /A055 JMS I IZERO CDFLST /CLEAR THE LIST FIELD /A054 JMS I IZERO /WITH ARGUMENTS LEFT FROM CALL ABOVE /A054 JMS INITF5 /MOVE CONST TO FLD 5 /A039 JMS GETSYS /GO GET THE ID OF THE SYSTEM DISKET /C042 DCA SYSDID /STORE THE SYSTEM ID FOR FUTURE USE /A027 DCA CHAIN /CLEAR THE 'CHAINED INTO VERIFY FLAG /A055 DCA FILDLT /INIT GLOBAL COUNTERS DCA FILCNT DCA FRECNT /D056 DCA FLAG /RECYCLE SWITCH DCA HOMEOK /CLR IT DCA CLASSU /SET THE CLASSIFICATION TO WPS /A054 DCA RX50SZ /CLEAR THE RX50 SIZE FLAG /A055 JMS STARTM /SEND INITIAL DILOGUE /C045 JMS VEABLK /VERIFY ALLOCATION BLOCK /M054 JMS VEBLKS /VERIFY ALL BLOCKS. JMS VCHRX5 /GO ADJST NBR OF BLCKS ON RX50 DISKETEE /A027 JMS HLTCHK /CHECK FOR GOLD HALT /A041 JMP COPY6 /FOUND, CHECK SVDRV, DO GM PROMPT /C054 JMS WPSDET /GO DETERMINE IF WPS OR UTILITY IMAGE /A053 JMS VEABLK /VERIFY ALLOCATION BLOCK /M054 JMS VEHBLK /VERIFY HOME BLOCK JMS VBSTAT /SHOW DISKETTE STATISTICS JMS VEFCHK /CHECK EACH FILE'S STRUCTURE /A055 JMS I IOASET /CALL IOACAL /A042 -2 /NUMBER OF ARGUMENTS TO PASS /A042 VSCRNC /"CHECKING CONSISTENT BLOCK USAGE" /C049 -2600 /CURSOR POSITION AND ERASE /C049 /D056 JMS VEMCHK /BACK CHECK PREVIOUS FILES JMS FRECHK /CHECK FREE BLOCKS JMS VBSTAT /RE-DISPLAY STATISTICS TAD FILDLT /UPDATE FILE COUNT CIA TAD FILCNT DCA FILCNT JMS HDRCOL /FLAG ANY BLOCK MARKED BOTH HEADER AND DATA/M054 TAD HOMEOK /M026 TAD ALLOK TAD ERRORS /ANY ERRORS? SZA CLA JMP COPY1 /YES -TRY RECOVERY /M040 VER4, JMS I IOASET /CALL THE MESSAGE CALLER /A055 -2 /WITH 2 ARGUMENTS /A055 VSCRNF /'^P!E&NO ERRORS FOUND' /A055 2500 /POSITION AT LINE 25 /A055 JMP COPY6 /GO CHECK FOR SYS & PROMPT GM /A055 COPY1, JMS ERMSG /CALL ERROR NOTIFICATION MESSAGE /A042 JMS ASKNBR /GO ASK FOR THE "COPY TO" NUMBER /A050 JMS COPYFL /DO THE COPY VEMENU, RTNCIF, 0 JMP I VERIFY /RETURN TO MAIN MENU SYSDID, 0 /ID OF THE SYSTEM DISKETTE /A027 /THE FOLLOWING 2 TABLES HAVE VALUES CORRESPONDING TO DENSITY CODES /A055 SZTAB, /TABLE OF IMAGE SIZES IN OCTAL /M055 1170 /SIZE OF A SINGLE DENSITY DISKETTE; 632 DECIMAL /C055 1734 /SIZE OF A DOUBLE DENSITY DISKETTE; 988 DECIMAL /C055 1426 /SIZE OF A SINGLE SIDED RX50; 790 DECIMAL /C055 1426 /SIZE OF A SINGLE SIDED RX50. CODE'S FOR 2 SIDED/C055 1426 /SIZE OF SS RX50. CODE IS FOR MOUNTED WINNY /C055 ALTAB, /NUMBER OF ALLOCATION WORDS IN ALLOCATION BLOCK FOR DEVICES /A055 0120 /120 (OCTAL) WORDS FOR A SINGLE DENSITY DRIVE /A027 0175 /175 (OCTAL) WORDS FOR A DOUBLE DENSITY DRIVE /M042 0143 /143 (OCTAL) WORDS FOR A SINGLE SIDED RX50 DRIVE/M042 0143 /143 (OCTAL) WORDS FOR A SINGLE SIDED RX50 DRIVE/A042 0143 /143 (OCTAL) WORDS FOR A SINGLE SIDED RX50 DRIVE/A042 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE /GET DENSITY - UTILITY SUBROUTINE -GDENS /A050 /BEGIN GDENS /A050 /CALL QURX. FNC=RXEDN+4000 /A050 /IF ERROR THEN /A050 / CALL NODENS - PROMPT THE USER AND AWAIT RESPONSE /A050 / LOOP TO BEGIN /A050 /ELSE /A050 / (AC)=DENSITY VALUE /A050 / RETURN /A050 /END /A050 / /A050 GDENS, XX /A050 GDENS1, CDFBUF /POINT AT THE BUFFER FIELD /A054 JMS I IQURX /QUEUE A REQUEST TO RXHAN /A050 RXEDN+4000 /FNC=GET DENSITY /A050 0 /BLOCK /A050 VBLKBF /UTILITY BUFFER ADDRESS /A050 JMP GDENER /ERROR RETURN /A050 GDENRT, TAD QUQBLK+RXQSPC /(AC)=DENSITY VALUE /A050 JMP I GDENS /RETURN TO CALLER /A050 GDENER, JMS NODENS /GO INFORM THE USER /A050 JMP GDENS1 /TRY AGAIN /A050 VEHBLK, XX /READ AND VERIFY THE HOME BLOCK /M054 CDFBUF /A054 JMS I IQURX RXERD+4000 2 HBLKBF HBLKE1, JMS RECONH /ERROR RETURN, RECONSTRUCT THE HOME BLOCK/A054 CDFBUF /CHECK HOME BLOCK CONTENTS /M054 TAD I (HBLKBF+1) /GET FLAG WORD AND (70) /MASK OUT ALL BUT BITS 6-8 /C053 TAD (-30) /ADDING -30(8) SHOULD GIVE (AC)=0 /C053 SZA CLA JMP HBLKE1 /JUMP IF WRONG FLAG /C042 TAD I (HBLKBF+11) /GET FILE COUNT TAD (310 /CHECK FOR WPS DOCUMENT COUNT /C053 SZA CLA /SKIP IF OK /C051 JMP HBLKE1 /JUMP IF WRONG FILE COUNT /C042 TAD (HBLKBF+11) DCA AIR10 /COUNT FILES DEFINED /M056 TAD (-310) DCA T1 DCA FILCNT /INIT TO ZERO HBLLP, TAD I AIR10 /GET NEXT HEADER PTR /M056 SZA CLA ISZ FILCNT /BUMP COUNT IF NOT ZERO ISZ T1 JMP HBLLP /LOOP FOR ALL 200 SLOTS /C042 CDFMYF /A054 JMP I VEHBLK /RETURN TO CALLER /A053 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VBSTAT, XX /GET DISKETTE NAME AND SHOW COUNTS /C042 CLA CLL TAD (DSKNAM-1) /GET BEGINNING ADDR OF DISPLAY AREA /A037 DCA AIR11 /PUT IT INTO INDEX REGISTER 1 /M056 TAD (HBLKBF+2) DCA T1 TAD (-6) DCA T2 VBSTA3, CDFBUF TAD I T1 /GET 2-CHAR WORD /C037 CDFMYF /A037 SNL BSW /SWAP IF ODD BYTE NEEDED AND P77 /JUST LOOK AT THE LOW BYTE /A054 SNA JMP VBSTA2 /JUMP IF NO MORE TAD (37) /UNDO COS OFFSET DCA I AIR11 /STORE CHARACTER IN DISPLAY BUFFER /M056 CML /CHANGE TO OTHER BYTE SNL ISZ T1 /BUMP TO NEXT WORD IF ODD BYTE NEXT ISZ T2 JMP VBSTA3 /LOOP IF MORE BYTES POSSIBLE VBSTA2, DCA I AIR11 /MAKE LAST CHARATER A NULL /M056 JMS I IOASET /CALL IOACAL /A042 -7 /NUMBER OF ARGUMENTS TO PASS /A042 VSCRN7 /!S "NAME" HAS # DOCUMENTS, # FREE /C049 /BLOCKS, #UNREADABLE /A049 0200 /CURSOR POSITION /C054 IFNDEF ITALIAN < VMED /"DISKETTE" OR "VOLUME" /A049 > DSKNAM /DISKETTE OR VOLUME IMAGE NAME /C049 FILCNT /NUMBER OF DOCUMENTS FRECNT /NUMBER OF FREE BLOCKS ERRCNT /NUMBER OF BAD BLOCKS JMP I VBSTAT /RETURN TO CALLER GETSYS, XX /GET THE ID # OF THE IMAGE IN D0. /M054 CDFBUF /SET THE DF BEFORE QURX CALLS /A054 JMS I IQURX /READ HOME BLOCK OF DEVICE (DRIVE) /C054 RXERD /FUNCTION OF READ /A027 RXBDIR /INDICATE TO READ DIRECTORY BLOCK /A027 HBLKBF /BUFFER TO READ INTO /A027 NOP /FAKE ERROR HANDLER /A055 CDFBUF /A027 TAD I (HBLKBF+5 /GET THE SYSTEM ID /C054 CDFMYF /POINT BACK TO THIS DATA FIELD /A054 JMP I GETSYS /C042 / SWPDRV, XX /(DRIVE)=(CPYDRV) /A055 TAD CPYDRV /GET THE 'TO' DRIVE NBR /A027 DCA DRIVE /PUT IT TO COPY TO /A027 JMP I SWPDRV /RETURN /A027 / RTDRV, XX /(DRIVE)=(SVDRV) /A055 TAD SVDRV /GET THE FORM DRIVEW NBR /A027 DCA DRIVE /RESTORE IT /A027 JMP I RTDRV /RETURN /A027 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VEPRM4, DCA DRIVE /PREPARING TO EXIT, VALIDATE D0 AS SYS /M054 CDFBUF /POINT AT THE BUFFER FIELD /A054 JMS I IQURX RXEDN+4000 0 VBLKBF JMP VEPER /ERROR RETURN, GO TELL THE USER /A050 JMS GETSYS /GO GET THE SYSID OF THE DISK /C042 CIA /COMPL IT FOR COMPARE /A027 TAD SYSDID /ADD IN THE ORIG SYSTEM ID /A027 SNA CLA /A032 JMP VEMENU /ITS THE SYSTEM DISKETTE GO TO MAIN MENU/A032 /D055 JMS CLRLNS /GO CLEAR THE SCREEN /A032 JMP COPY6L /GO ASK FOR SYSTEM DISKETTE, PROMPT GM /A054 VEPER, /D055 JMS CLRLNS /GO CLEAR SCREEN /C053 JMS NODENS /"NO MEDIA IN DEVICE" /C050 JMP COPY6L /GO ASK FOR SYS DSK & PROMPT FOR GM /A054 RNGBEL, XX TAD (7) /SEND A CONTROL G TO THE KEY BOARD TO RING BELL JMS OUTCHR JMP I RNGBEL INCHR, 0 /INPUT A CHARACTER FROM THE TERMINAL /M054 JMP INCHR2 INCHR1, CIF 0 JWAIT INCHR2, CIF 0 XLTIN JMP INCHR1 JMP I INCHR OUTCHR, 0 /Output the character in the AC to the terminal JMP OUTCH2 OUTCH1, CIF 0 JWAIT OUTCH2, CIF 0 TTYOU JMP OUTCH1 JMP I OUTCHR DLTFIL, XX /DELETE CURRENT FILE (FILENO). /UTILITY SUBROUTINE. /A054 TAD (4000 /SET 'NOT COPIED' FLAG /C056 JMS DOCSET /IN THE DOCLST. RET DF=MYF /A055 TAD FILENO /GET HEADER NUMBER /A054 TAD (HBLKBF+11) /ADD THE BASE OF THE FILE POINTER LIST /A054 DCA T2 /T2 POINTS AT THE HEADER POINTER WORD /A054 CDFBUF /HBLKBF IS IN THE BUFFER FIELD /A054 TAD I T2 /GET THE BLOCK NUMBER FROM HOME BLOCK /A054 DCA T1 /SAVE IT FOR LATER /A054 TAD T1 /GET IT BACK /A054 TAD DSKIDX /COMPARE THE MINUS MAXIMUM BLOCK # /A055 SMA SZA CLA /OK IF THE BLOCK # IS LESS OR EQUAL /A055 JMP CALLOK /ON TOO BIG, SKIP THE LIST MODIFICATIONS/A055 TAD T1 /GET BACK THE BLOCK NUMBER /A055 TAD (TYPLST) /ADD THE BASE OF THE TYPE LIST /A054 DCA T2 /THEN, USING T2 AS THE POINTER /A054 CDFLST /GET TO FIELD WITH THE LISTS /A054 DCA I T2 /CLEAR THE TYPE LIST ENTRY /A054 TAD T1 /GET THE BLOCK NUMBER BACK /A054 TAD (BLKLST) /ADD THE BLOCK LIST BASE /A054 DCA T2 /THEN, USING T2 AS THE POINTER /A054 TAD I T2 /GET THE BLOCK LIST STATUS WORD /A054 AND (5000) /CLEAR FILE #. IF SET, LEAVE THE "FREE /A054 /AND "WRONG COUNT" MARKS. /A054 /D055 RE-ENABLED THE NEXT INSTRUCTION FOR TEST DURING C056 TAD (2000) /SET THE "READ FAIL" MARK TO FORCE COPY /A054 /TO GENERATE A NEW BLOCK. /A054 DCA I T2 /WRITE BACK THE NEW BLOCK LIST STATUS WORD/A054 CALLOK, JMS ALLOK /FLAG TO RECONSTRUCT ALLOCATION BLOCK /A054 JMS HOMEOK /FLAG TO RECONSTRUCT HOME BLOCK /A054 TAD DSKIDX /GET THE NEGATIVE OF THE NUMBER OF BLOCKS/A054 DCA T1 /TO T1 FOR COUNTING /A054 TAD (BLKLST) /GET THE BASE OF THE BLOCK LIST INTO /A054 DCA T2 /T2 FOR USE AS THE POINTER /A054 DLTFLC, TAD I T2 /GET NEXT STATUS WORD FROM THE BLOCK LIST/A054 AND P377 /MASK FOR THE FILE NUMBER ONLY /A054 CIA /MAKE THE RESULT NEGATIVE /A054 TAD FILENO /WAS IT THIS FILE? /A054 SZA CLA /A054 JMP DLTNXT /IF NOT, GO TRY THE NEXT /A054 TAD I T2 /YES, GET THE STATUS WORD TO FREE IT /A054 AND (400) /IS IT A MULTI-USED BLOCK? /A054 SZA CLA /THE CLA SAYS DON'T SAVE MULTI FLAG /A054 TAD P377 /IF SO SAVE FILE # AS FLAG AND SAVE STATES/A054 TAD (7000) /ELSE JUST SAVE STATES EXCEPT MULTI-USED/A054 AND I T2 /'AND' THE STATUS WORD WITH THE MASK /A054 DCA I T2 /WRITE THE NEW STATUS WORD BACK TO BLOCK LIST/A054 DLTNXT, ISZ T2 /POINT TO THE NEXT STATUS WORD IN BLKLST/A054 ISZ T1 /DECREMENT WORDS TO GO, DONE WHEN 0 /A054 JMP DLTFLC /LOOP FOR ALL STATUS WORDS /A054 CDFMYF /A054 ISZ FILDLT /INCREMENT THE COUNT OF DELETED FILES /A054 JMP I DLTFIL /AND RETURN TO CALLER /A054 VBLKOU, XX /UPDATE SCREEN ISZ SBLKNO /FOR DISPLAY, TO SHOW BLOCK N-1 AS N /M054 JMS I IOASET /CALL IOACAL /A054 -4 /NUMBER OF ARGUMENTS TO PASS /A054 VSCRN2 /^P!D BLOCKS CHECKED, !D ERRORS DETECTED./A054 700 /CURSOR POSITION /A054 SBLKNO /NUMBER OF BLOCKS CHECKED /A054 ERRCNT /NUMBER OF ERRORS DETECTED /A054 AC7777 /ADD MINUS 1 /A055 TAD SBLKNO /TO THE DISPLAYED NUMBER TO /A055 DCA SBLKNO /RESTORE THE CORRECT COUNT /A055 JMP I VBLKOU FNC=. /FIRST NON-CODE LOCATION /A042 PAGE CPYRPB, XX /COPY RAPID PAGINATION STRUCTURE OF DOCUMENT. PART OF CPYFIL /THE FILE HEADER BLOCK IS IN HDR1BF. ENTRY DF=BUF. /M056 TAD I (HDR1BF+53 /GET THE NUMBER OF THE FIRST GTP BLOCK /A056 SNA /OK IF ITS NOT ZERO /A056 JMP CPRPER /IF ZERO, GO RESET GO-TO-PAGE /A056 JMS CCKRPB /GO VALIDATE THE GTP BLOCK /A056 TAD (HDR2BF /GET THE BUFFER ADDRESS /A056 JMS READRP /READ IN THE FIRST GO-TO-PAGE BLOCK /A056 TAD I (HDR2BF+2 /CHECK THE 1ST EXTENSION POINTER WORD /A056 SNA /NON ZERO MEANS THERE IN AN EXTENSION /A056 JMP CPYR4 /ZERO MEANS NO EXTENSIONS, GO WRITE FIRST/A056 JMS CCKRPB /GO VALIDATE THE GTP BLOCK /A056 TAD (HDR3BF /GET THE BUFFER ADDRESS /A056 JMS READRP /READ IN THE SECOND GTP BLOCK /A056 TAD I (HDR2BF+3 /IS THERE A THIRD GTP BLOCK? /A056 SNA /NON ZERO MEANS MORE GTP BLOCKS /A056 JMP CPYR3 /ZERO MEANS NO MORE, GO WRITE THE 2ND /A056 JMS CCKRPB /GO VALIDATE THE GTP BLOCK /A056 TAD (HDR4BF /GET THE BUFFER ADDRESS /A056 JMS READRP /READ IN THE 3RD GTP BLOCK /A056 TAD (HDR4BF+362 /SET UP LOOP TO CHECK EXTRA EXT BLOCKS /A056 DCA T2 /!MUST USE T2 - HOOKED TO WRTEXT /A056 TAD (-15 /13 MORE POSSIBLE POINTER WORDS /A056 DCA T3 /USE T3 AS THE WORDS TO GO COUNTER /A056 TAD (VBLKBF /READ TO & WRITE FROM VBLKBF /A056 DCA RPBPTR /RPBPTR HOLDS THE BUFFER ADDRESS /A056 CPYR1, TAD I T2 /GET THE # OF THE GTP EXTENSION BLOCK /A056 SNA /NON ZERO MEANS THERE IS A BLOCK # /A056 JMP CPYR2 /0 IS THE LIST TERMINATOR, WRITE 1,2,3. /A056 JMS CCKRPB /GO VALIDATE THE GTP BLOCK /A056 TAD RPBPTR /PASS THE BUFFER ADDRESS TO READRP /A056 JMS READRP /READ IN THE RPG BLOCK /A056 JMS WRTEXT /WRITE IT OUT TO THE COPY DEVICE.RDF=BUF/A056 ISZ T2 /POINT AT THE NEXT GTP EXTENSION POINTER/A056 ISZ T3 /UNTIL THEY ARE ALL DONE /A056 JMP CPYR1 /GO READ THE NEXT GTP EXTENSION POINTER /A056 CPYR2, CLA /BE SURE THE ACC IS CLEAR /A056 TAD (HDR2BF+3 /GET THE LOCATION OF THE 3RD GTP BLOCK #/A056 DCA T2 /PUT IT IN T2 FOR WRTEXT LINKAGE /A056 TAD (HDR4BF /GET THE BUFFER ADDRESS /A056 DCA RPBPTR /USE RPBPTR TO PASS IT TO WRTEXT /A056 JMS WRTEXT /GO WRITE OUT THE 3RD GTP BLOCK.RET DF=BUF CPYR3, CLA /BE SURE THE ACC IS CLEAR /A056 TAD (HDR2BF+2 /GET THE LOCATION OF THE 2ND GTP BLOCK #/A056 DCA T2 /PUT IT IN T2 FOR WRTEXT LINKAGE /A056 TAD (HDR3BF /GET THE BUFFER ADDRESS /A056 DCA RPBPTR /USE RPBPTR TO PASS IT TO WRTEXT /A056 JMS WRTEXT /GO WRITE OUT THE 2ND GTP BLOCK. RET DF=BUF CPYR4, CLA /BE SURE THE ACC IS CLEAR /A056 TAD (HDR1BF+53 /GET THE LOCATION FOR THE FIRST GTP BLOCK #/A056 DCA T2 /PUT IT IN T2 FOR WRTEXT LINKAGE /A056 TAD (HDR2BF /GET THE BUFFER ADDRESS /A056 DCA RPBPTR /USE RPBPTR TO PASS IT TO WRTEXT /A056 JMS WRTEXT /WRITE THE FIRST GTP BLOCK.RET DF=BUF /A056 JMP I CPYRPB /DONE GO-TO-PAGE. RETURN TO MAIN FILE COPY/A056 CCKRPB, XX /PART OF CPYRPB. VALIDATE THE GTP BLOCK TO COPY /A056 /THE GTP BLOCKS ARE MARKED IN TYPLST WITH 0400 IOR FILE#/A056 DCA SBLKNO /SAVE THE NUMBER OF THE BLOCK UNDER TEST/A056 TAD SBLKNO /GET IT BACK /A056 TAD DSKIDX /COMPARE IT THE THE LARGEST POSSIBLE # /A056 SMA SZA CLA /OK WHEN LESS OR EQUAL /A056 JMP CPRPER /ELSE, GO RESET GTP FOR THIS FILE /A056 AC7777 /MASK FOR ALL THE BITS /A056 JMS TEST2 /GET THE TYPLST STATUS WORD. RET DF=LST /A056 CIA /NEGATE IT FOR COMPARISON TO /A056 TAD FILENO /THE CURRENT FILE NUMBER /A056 TAD (0400 /WITH THE GO-TO-PAGE FLAG /A056 SZA CLA /OK IF EQUAL /A056 JMP CPRPER /ELSE, GO RESET GTP FOR THIS FILE /A056 AC7777 /MASK FOR ALL THE BITS /A056 JMS TEST1 /GET THE BLKLIST STATUS WORD /A056 CIA /NEGATE IT FOR COMPARISON TO /A056 TAD FILENO /THE CURRENT FILE NUMBER /A056 SZA CLA /OK IF ITS THE CURRENT FILE # /A056 JMP CPRPER /ELSE, GO RESET GTP FOR THIS FILE /A056 CDFBUF /GET BACK TO THE BUFFER FIELD /A056 JMP I CCKRPB /IT WAS EQUAL, RETURN /A056 CPRPER, CDFBUF /GET BACK TO THE BUFFER FIELD /A056 DCA I (HDR1BF+53 /CLEAR THE GO-TO-PAGE POINTER /A056 AC7776 /MASK FOR ALL BUT BIT 11 /A056 AND I (HDR1BF+1 /AND IN THE TYPE WORD /A056 DCA I (HDR1BF+1 /WRITE BACK THE TYPE WORD SANS GTP FLAG /A056 TAD SAVBLK /GET THE BLKOUT VALUE AT START OF THIS FILE/A056 DCA BLKOUT /RESTORE THE 'PRE-GTP' VALUE /A056 JMP I CPYRPB /TERMINATE THE GTP COPY. RETURN TO FILE COPY/A056 READRP, XX /READ TO BUFFER IN AC, BLOCK # (SBLKNO) FROM VERIFY DEVICE/A056 DCA GTPBF /PASS THE BUFFER ADDRESS TO RXHAN /A056 JMS RTDRV /GO GET THE FROM DRIVE NUMBER /A056 TAD SBLKNO /INPUT BLOCK NUMBER /A056 DCA GTPSEC /PASS THE BLOCK # TO RXHAN /A056 JMS I IQURX /CALL RXHAN /A056 RXERD+4000 /READ IN /A056 GTPSEC, 0 /THE BLOCK NUMBER /A056 GTPBF, 0 /THE BUFFER ADDRESS /A056 JMP CPRPER /ERROR RETURN. ? WAS OK @ VEBLKS /A056 CDFBUF /GET BACK TO THE BUFFER FIELD /A056 JMP I READRP /RETURN TO CALLER /A056 /D056CPYRPB, XX /COPY RAPID PAGINATION STRUCTURE OF DOCUMENT. PART OF CPYFIL /D056 /THE FILE HEADER BLOCK IS IN HDR1BF. ENTRY DF=BUF. /M056 /D056 TAD I (HDR1BF+53 /D056 SNA /D056 JMP I CPYRPB /D056 DCA BLKIN /D056 TAD (HDR2BF /D056 JMS READIN /READ 1ST RPG BLOCK INTO CORE /D056 TAD I (HDR2BF+2 /CHECK 1ST EXT PTR /D056 SNA /D056 JMP CPYR4 /NONE FOUND, GO WRITE OUT 1ST /D056 DCA BLKIN /D056 TAD (HDR3BF /D056 JMS READIN /READ 2ND RPG BLOCK INTO CORE /D056 TAD I (HDR2BF+3 /IS THERE AN EXT BLOCK #3? /D056 SNA /D056 JMP CPYR3 /NO, GO WRITE OUT 1ST RPG BLOCK /D056 DCA BLKIN /YES, READ 3RD RPG BLOCK INTO CORE /D056 TAD (HDR4BF /D056 JMS READIN /D056 /TD056 TAD (HDR4BF+363 /SET UP LOOP TO CHECK EXTRA EXT BLOCKS /TD056 DCA T2 /TD056 TAD (-14 /TD056 DCA T3 /TD056 DCA RPBPTR /TD056CPYR1, TAD I T2 /TD056 SPA /TD056 JMP CPYR2 /RETURN IF ANY PTR IS -1 /D056 /D056 TAD (HDR4BF+362 /SET UP LOOP TO CHECK EXTRA EXT BLOCKS /TA056 /D056 DCA T2 /TA056 /D056 TAD (-15 /TA056 /D056 DCA T3 /TA056 /D056 TAD (VBLKBF /TA056 /D056 DCA RPBPTR /TA056 /D056CPYR1, TAD I T2 /TA056 /D056 SNA /ZERO IS THE EXTENSION BLOCK TERMINATOR /TA056 /D056 JMP CPYR2 /RETURN ON 0 /TA056 /D056 /D056 DCA BLKIN /D056 TAD RPBPTR /D056 JMS READIN /READ IN THE RPG BLOCK /M054 /D056 JMS WRTEXT /WRITE IT OUT TO THE COPY DEVICE /M056 /D056 ISZ T2 /D056 ISZ T3 /D056 JMP CPYR1 /D056CPYR2, CLA /D056 TAD (HDR2BF+3 /D056 DCA T2 /D056 TAD (HDR4BF /D056 DCA RPBPTR /D056 JMS WRTEXT /M056 /D056CPYR3, TAD (HDR2BF+2 /D056 DCA T2 /D056 TAD (HDR3BF /D056 DCA RPBPTR /D056 JMS WRTEXT /M056 /D056CPYR4, TAD (HDR1BF+53 /D056 DCA T2 /D056 TAD (HDR2BF /D056 DCA RPBPTR /D056 JMS WRTEXT /M056 /D056 JMP I CPYRPB FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VEBLKS, XX /READ AND VERIFY THE ENTIRE IMAGE. 1ST LEVEL SUBR. /M055 CLA /START WITH A CLEAR AC /A054 DCA ERRCNT /CLEAR ERROR COUNTER /A032 DCA ERRORS /CLEAR ERROR FLAG (RETURN LINK) /C054 TAD DSKIDX /A016 DCA REG12 /USE REG12 AS 'TO GO' COUNT /C055 DCA SBLKNO /START FROM BLOCK 0 /A056 TAD (-12) DCA T3 /USE T3 AS A TENS COUNTER /C055 TAD (1100 /GET STARTING LINENO -1 /A054 DCA LINENO /INITIALIZE LINENO /A054 VBLKLP, TAD SBLKNO /GET THE NUMBER OF THE BLOCK TO TEST /A056 DCA VBLKNO /INSERT IT AS AN ARGUMENT TO QURX CALL /A056 CDFBUF /POINT QURX AT THE BUFFER FIELD /A056 JMS I IQURX /CALL RXHAN VIA QURX /A056 RXERD+4000 /READ /A056 VBLKNO, 0 /THE BLOCK UNDER TEST /A056 VBLKBF /TO BUFFER VBLKBF /A056 JMP VBLKE1 /ON READ ERROR, GO REPORT /A056 CDFBUF /GET BACK INTO THE BUFFER FIELD /A056 TAD SYSDSC /GET THE LOWEST LEGAL DOCUMENT BLOCK # /A056 CIA /NEGATE IT FOR COMPARISONS /A056 TAD SBLKNO /GET THE BLOCK NUMBER BACK /A056 SPA CLA /IF LEGAL, CHECK FOR BLOCK 6 /A056 JMP ISSYS /MINUS MEANS ITS SYSTEM /A056 TAD SBLKNO /GET THE BLOCK NUMBER BACK /A056 TAD (-3 /SEE IF ITS BELOW 3 /A056 SPA /BLOCKS 0,1, & 2 /A056 JMP ISSYS /ARE ALWAYS SYSTEM /A056 TAD (-3 /SEE IF ITS BLOCK 6 /A056 SZA CLA /IF IT WASN'T, /M056 JMP COS310 /GO CHECK THE COS COUNT /A056 ISSYS, CLA /MAKE SURE THE ACC IS CLEAR /A056 TAD P377 /USE 377 TO /M056 JMS IORBLK /MARK AS UNUSED IN BLKLST /M056 TAD P377 /USE 377 TO /A056 JMS IORTYP /MARK AS UNUSED IN TYPLST /A056 JMP SYSBL2 /GO HOUSEKEEP THE END OF THE LOOP /A056 COS310, TAD I (VBLKBF+0 /GET THE ZERO WORD OF THE BLOCK /A056 TAD P377 /CHECK IT FOR COS 310 COUNT (7401) /A056 SNA CLA /NON ZERO SAYS WRONG COUNT /A056 JMP CKTYP /ON ZERO, GO CHECK TYPE /A056 TAD (1000) /MARK AS COS COUNT ERROR /A056 JMS IORBLK /IN THE BLOCK LIST STATUS WORD /A056 AC4000 /MARK AS 'BAD SOMEHOW' /A056 JMS IORTYP /OR IT INTO THE TYPE LIST STATUS WORD /A056 JMP SYSBL2 /GO HOUSEKEEP THE END OF THE LOOP /A056 CKTYP, TAD I (VBLKBF+1) /GET TYPE WORD /A056 AND (70 /CHECK THE TYPE NIBBLE /A056 MQL /SAVE IT IN THE Q REGISTER /A056 CKHDR, ACL /GET THE TYPE NIBBLE BACK /A056 TAD (-10 /CHECK FOR TYPE = HEADER 1 /A056 SZA CLA /0 MEANS ITS HEADER /A056 JMP CKGTP /ON NON ZERO, CHECK FOR GO-TO-PAGE /A056 TAD (1000 /MARK AS HEADER /A056 JMS IORTYP /OR IT INTO THE TYPE LIST STATUS WORD /A056 JMP CKFILE /GO CHECK THE FILE NUMBER /A056 CKGTP, ACL /GET BACK THE TYPE NIBBLE /A056 TAD (-70 /CHECK FOR TYPE = GO-T0-PAGE /A056 SZA CLA /0 MEANS ITS GO-TO-PAGE /A056 JMP SDATA /ELSE GO MARK IT AS DATA /A056 TAD (0400 /SET BIT 5 AS THE G0-TO-PAGE FLAG /A056 JMS IORTYP /OR IT INTO THE TYPE LIST STATUS WORD /A056 JMP SYSBL2 /GO HOUSEKEEP THE END OF THE LOOP /A056 SDATA, AC2000 /SET BIT 1 AS THE DATA FLAG /A056 JMS IORTYP /OR IT INTO THE TYPE LIST STATUS WORD /A056 JMP SYSBL2 /GO HOUSEKEEP THE END OF THE LOOP /A056 CKFILE, CDFBUF /GET BACK INTO THE BUFFER FIELD /A056 TAD I (VBLKBF+13 /GET THE WORD WITH THE FILE NUMBER /A056 SPA SNA /PLUS AND NON ZERO IS OK /A056 JMP FILERR /A FILE # OF 0 IS AN ERROR /A056 CIA /NEGATE THE FILE NUMBER WORD TO /A056 TAD (310 /CHECK FOR LEGAL FILE #S ONLY /A056 SPA CLA /1 THRU 310 ARE LEGAL /A056 JMP FILERR /OTHER FILE #S ARE ILLEGAL /A056 TAD I (VBLKBF+13 /GET BACK THE WORD WITH THE FILE # /A056 JMS IORTYP /OR THE FILE # INTO THE TYPLST WORD /A056 /D056 CDFBUF /GET BACK TO THE BUFFER FIELD /A056 /D056 TAD I (VBLKBF+13 /GET BACK THE WORD WITH THE FILE # /A056 /D056 JMS IORBLK /OR THE FILE # INTO THE BLKLST WORD /A056 JMP SYSBL2 /GO HOUSEKEEP THE END OF THE LOOP /A056 FILERR, AC4000 /SET BIT 0 AS THE 'BAD SOMEHOW' FLAG /A056 JMS IORTYP /OR THE 'BAD' FLAG INTO THE TYPLST WORD /A056 TAD (375 /USE FILE # 375 AS THE FILE ERROR FLAG /A056 JMS IORBLK /OR THE FILE ERROR FLAG INTO THE BLKLST /A056 JMS ERRORS /REPORT THAT AN ERROR WAS DETECTED /A056 SYSBL2, JMS HLTCHK /GO SEE IF HALT FLAG IS SET /M055 JMP VBLKH3 /IF IT WAS, DEPART INSTANTLY! /M055 ISZ T3 /TIME TO UPDATE SCREEN? /A055 JMP LOPTRM /A055 JMS VBLKOU /DO IT, IF SO /M055 TAD (-12) /M055 DCA T3 /AND RESET COUNTER /M055 LOPTRM, ISZ SBLKNO /INCREMENT THE BLOCK # TO CHECK /C056 ISZ REG12 /INC/DECREMENT THE BLOCKS TO GO COUNT /M056 JMP VBLKLP /LOOP FOR ALL BLOCKS VBLKH2, AC7777 /GET -1 TO COMPENSATE SBLKNO INFLATION /A056 TAD SBLKNO /ADD THE LAST BLOCK NUMBER /A056 DCA SBLKNO /WRITE LAST BLOCK -1 /A056 JMS VBLKOU /DISPLAY FINAL STATUS TAD (-1100 /GET THE -INITIALIZED VALUE FOR LINENO /A054 TAD LINENO /ADD THE CURRENT VALUE /A054 SZA CLA /IF EQUAL, JUST GET OUT /A054 JMS ASKPRT /ELSE ASK USER TO PRINT SCREEN /A054 VBLKH3, JMP I VEBLKS /AND RETURN TO CALLER FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VBLKE1, /HERE ON READ ERROR JMS ERRORS /FLAG BAD BLOCK FOR A COPY ISZ ERRCNT /BUMP ERROR COUNTER JMS VBLKOU /UPDATE STATUS ON SCREEN JMS RDERR /CALL THE HARD DISK ERROR DISPLAY ROUTINE/A054 AC2000 /SET 'READ FAIL' FLAG /A054 JMS IORBLK /IN THE BLOCK LIST STATUS WORD /A055 AC4000 /SET 'BAD SOMEHOW' FLAG /A056 JMS IORTYP /OR IT INTO THE TYPLST STATUS WORD /A056 JMP SYSBL2 /GO FINISH THE PASS THRU THE LOOP /A055 /TD056VEBLKS, XX /READ AND VERIFY THE ENTIRE IMAGE. 1ST LEVEL SUBR. /M055 /TD056 CLA /START WITH A CLEAR AC /A054 /TD056 DCA ERRCNT /CLEAR ERROR COUNTER /A032 /TD056 DCA ERRORS /CLEAR ERROR FLAG (RETURN LINK) /C054 /TD056 TAD (BLKLST) /TD056 DCA VBLKPT /TD056 TAD DSKIDX /A016 /TD056 DCA REG12 /USE REG12 AS 'TO GO' COUNT /C055 /TD056 DCA VBLKNO /TD056 TAD (-12) /TD056 DCA T3 /USE T3 AS A TENS COUNTER /C055 /TD056 TAD (1100 /GET STARTING LINENO -1 /A054 /TD056 DCA LINENO /INITIALIZE LINENO /A054 /TD056VBLKLP, CDFBUF /A054 /TD056 JMS I IQURX /READ A BLOCK /TD056 RXERD+4000 /TD056VBLKNO, 0 /TD056 VBLKBF /TD056 JMP VBLKE1 /JUMP IF ERROR /TD056 CDFBUF /ELSE CHECK COUNT WORD /TD056 TAD I (VBLKBF+1) /GET TYPE WORD /TD056 DCA X2 /SAVE IT /TD056 TAD VBLKNO /SET UP FUNNY FOR OUTSIDE WORLD /A054 /TD056 DCA SBLKNO /PUT IN ZERO PAGE FOR UNIVERSAL ACCESS /A054 /TD056 TAD SBLKNO /GET THE BLOCK NUMBER BACK /A055 /TD056 CIA /NEGATE IT FOR COMPARISONS /A055 /TD056 SMA /IF NON-0 CHECK BLOCK 6 /A055 /TD056 JMP ISSYS /DON'T CHECK BLOCK 0 /A055 /TD056 TAD (6 /SEE IF ITS BLOCK 6 /A055 /TD056 SNA CLA /IF IT WASN'T, GO CHECK THE COS COUNT /A055 /TD056 JMP ISSYS /IT WAS BLOCK 6, SKIP IT /A055 /TD056 TAD I (VBLKBF) /GET THE ZERO WORD OF THE BLOCK /A027 /TD056 TAD (-COSCNT) /CHECK IT FOR COS 310 /A027 /TD056 SZA CLA /RETURN IF OK /A027 /TD056 TAD (1000) /MARK IF NOT COS 310 COMPAT /A027 /TD056 CDFLST /A054 /TD056 DCA I VBLKPT /0 IF COS310 COMPATIBLE, ELSE =1000 OCT /C054 /TD056 DCA X0 /0 TYPE REGSTER /C042 /TD056 TAD X2 /GET TYPE BACK AGAIN /TD056 AND (70) /IF TYPE =0=DATA /M054 /TD056 SZA /THEN MARK AS DATA IN THE TYPE LIST /C054 /TD056 JMP VBLKL3 /IF NOT, DON'T MARK AS DATA /M054 /TD056 AC2000 /SET DATA FLAG FOR TYPLST STATUS WORD /A054 /TD056 DCA X0 /X0 IS THE STATUS WORD REGISTER /M054 /TD056VBLKL3, TAD (-10) /HEADER TYPE VALUE IS 1 /M054 /TD056 SZA CLA /TD056 JMP VBLKL5 /NOT A HEADER, SO PRESS ON /M054 /TD056 CDFBUF /POINT AT THE BUFFER FIELD /M054 /TD056 CLL /CLEAR THE LINK FOR COMPARISON /A055 /TD056 TAD I (VBLKBF+13 /GET THE WORD WITH THE FILE NUMBER /M054 /TD056 TAD (-311 /CHECK FOR LEGAL FILE #S ONLY /A055 /TD056 CLA /CLEAR AC FOR LATER USE /A055 /TD056 SZL /OK IF THERE WAS NO CARRY INTO THE LINK /A055 /TD056 JMP VBLKL4 /ELSE GO CLEAR THE TYPE REGISTER /A055 /TD056 TAD I (VBLKBF+13 /GET THE FILE NUMBER /A055 /TD056 TAD (1000) /SET THE HEADER FLAG /A055 /TD056VBLKL4, DCA X0 /TYPE REGISTER NOW HAS HEADER AND FILE #/A055 /TD056VBLKL5, TAD SYSDSC /LOWEST DOCUMENT BLOCK POSSIBLE /C055 /TD056 CIA /TD056 TAD SBLKNO /TD056 SMA CLA /TD056 JMP SYSBL2 /LEGAL DONT TOUCH /TD056ISSYS, TAD P377 /C054 /TD056 JMS IORBLK /MARK AS UNUSED IN BLKLST /M054 /TD056 TAD REG10 /ON RETURN (REG10)=BLKLST+(SBLKNO) /M054 /TD056 TAD (TYPLST-BLKLST) /(AC)=TYPLST+(SBLKNO) /M054 /TD056 DCA REG10 /USE THAT AS POINTER INTO TYPLST /M054 /TD056 TAD P377 /0377 MEANS "UNUSED" IN TYPLST /M054 /TD056 DCA I REG10 /WRITE "UNUSED" INTO THE STATUS WORD /M054 /TD056 DCA X0 /NEUTRALIZE X0 /M054 /TD056SYSBL2, TAD X0 /(AC)=TYPE FLAG HERE /TD056 JMS IORTYP /OR IN THE TYPE TO TYPE LIST /TD056 JMS HLTCHK /GO SEE IF HALT FLAG IS SET /M055 /TD056 JMP VBLKH3 /IF IT WAS, DEPART INSTANTLY! /M055 /TD056 ISZ T3 /TIME TO UPDATE SCREEN? /A055 /TD056 JMP LOPTRM /A055 /TD056 JMS VBLKOU /DO IT, IF SO /M055 /TD056 TAD (-12) /M055 /TD056 DCA T3 /AND RESET COUNTER /M055 /TD056LOPTRM, ISZ VBLKNO /BUMP BLOCK NUMBER /TD056 ISZ VBLKPT /BUMP POINTER /TD056 ISZ REG12 /INCREMENT THE BLOCK COUNT /C055 /TD056 JMP VBLKLP /LOOP FOR ALL BLOCKS /TD056VBLKH2, JMS VBLKOU /DISPLAY FINAL STATUS /TD056 TAD (-1100 /GET THE -INITIALIZED VALUE FOR LINENO /A054 /TD056 TAD LINENO /ADD THE CURRENT VALUE /A054 /TD056 SZA CLA /IF EQUAL, JUST GET OUT /A054 /TD056 JMS ASKPRT /ELSE ASK USER TO PRINT SCREEN /A054 /TD056VBLKH3, JMP I VEBLKS /AND RETURN TO CALLER /TD056VBLKE1, /HERE ON READ ERROR /TD056 JMS ERRORS /FLAG BAD BLOCK FOR A COPY /TD056 ISZ ERRCNT /BUMP ERROR COUNTER /TD056 JMS VBLKOU /UPDATE STATUS ON SCREEN /TD056 JMS RDERR /CALL THE HARD DISK ERROR DISPLAY ROUTINE/A054 /TD056 AC2000 /SET 'READ FAIL' FLAG /A054 /TD056 JMS IORBLK /IN THE BLOCK LIST STATUS WORD /A055 /TD056 JMP SYSBL2 /GO FINISH THE PASS THRU THE LOOP /A055 RDERR, XX /HARD DISK ERROR REPORTING SUBROUTINE. PART OF VEBLKS. /A054 TAD (-4 /GET THE VALUE OF MOUNTED WINNY DENSITY /A054 TAD DENFLG /COMPARE THE 'VERIFY' DENSITY /A054 SPA /PRESS ON WITH THE MESSAGE ON 4 & MORE /A054 JMP I RDERR /IMMEDIATE RETURN ON LESSER DENSITIES /A054 CDFLP /THE READ STATUS BUFFER IS IN FIELD 5 /A054 JMS I IQURX /CALL RXHAN /A054 RDESTA /WITH A READ STATUS COMMAND FOR RD /A054 0 /FAKE BLOCK NUMBER REQUIRED BY QURX /A054 STABUF /THE BUFFER FOR OUTPUT /A054 NOP /FAKE ERROR RETURN /A054 JMS I IOASET /CALL THE DISPLAY ROUTINE /A054 -2 /WITH 2 ARGUMENTS /A054 FMTERR /ERROR #: CYLINDER #: HEAD #: SECTOR #: /A054 -1000 /POSITION TO LINE 8 COL 0 AND ERASE EOL /A054 TAD LINENO /GET THE CURRENT LINE NUMBER /A054 TAD (100 /ADD ONE LINE TO IT /A054 DCA LINENO /UPDATE THE LINE COUNT /A054 /JUSTIFY THE COLUMN. PREVENT STACK UP ON THE RIGHT TAD LINENO /GET THE CURRENT LINE NUMBER /A054 MQL /SAVE IT IN THE Q REGISTER /A054 CDFLP /GET INTO THE TEXT FIELD /A054 TAD (11 /ERROR COLUMN VALUE FOR 1 DIGIT /A054 MQA /IOR THE CURRENT LINE NUMBER /A054 DCA ERRCOL /INITIAL ERROR COLUMN VALUE /A054 TAD (26 /CYLINDER COLUMN VALUE FOR 1 DIGIT /A054 MQA /IOR THE CURRENT LINE NUMBER /A054 DCA CYLCOL /INITIAL CYLINDER COLUMN VALUE /A054 TAD (43 /HEAD COLUMN VALUE FOR 1 DIGIT /A054 MQA /IOR THE CURRENT LINE NUMBER /A054 DCA HEDCOL /INITIAL HEAD COLUMN VALUE /A054 TAD (60 /SECTOR COLUMN VALUE FOR 1 DIGIT /A054 MQA /IOR THE CURRENT LINE NUMBER /A054 DCA SECCOL /INITIAL SECTOR COLUMN VALUE /A054 TAD (-12 /SEE IF MORE THAN ONE DIGIT /A054 TAD ERRCNT /GET THE CURRENT ERROR NUMBER /A054 SMA CLA /SKIP THE COLUMN SUBTRACT ON ONE DIGIT /A054 AC7777 /SUBTRACT 1 FROM THE /A054 TAD ERRCOL /ERROR COLUMN /A054 DCA ERRCOL /RESTORE THE UPDATED ERROR COLUMN /A054 TAD (-12 /SEE IF MORE THAN ONE DIGIT /A054 TAD I (CYLNO /GET THE CURRENT CYLINDER NUMBER /A054 SMA CLA /SKIP THE COLUMN SUBTRACT ON ONE DIGIT /A054 AC7777 /SUBTRACT 1 FROM THE /A054 TAD CYLCOL /CYLINDER COLUMN /A054 DCA CYLCOL /RESTORE THE UPDATED CYLINDER COLUMN /A054 TAD (-12 /SEE IF MORE THAN ONE DIGIT /A054 TAD I (SECTNO /GET THE CURRENT SECTOR NUMBER /A054 SMA CLA /SKIP THE COLUMN SUBTRACT ON ONE DIGIT /A054 AC7777 /SUBTRACT 1 FROM THE /A054 TAD SECCOL /SECTOR COLUMN /A054 DCA SECCOL /RESTORE THE UPDATED SECTOR COLUMN /A054 TAD (-144 /SEE IF MORE THAN TWO DIGITS /A054 TAD ERRCNT /GET THE CURRENT ERROR NUMBER /A054 SMA CLA /SKIP THE COLUMN SUBTRACT ON TWO DIGITS /A054 AC7777 /SUBTRACT 1 FROM THE /A054 TAD ERRCOL /ERROR COLUMN /A054 DCA ERRCOL /RESTORE THE UPDATED ERROR COLUMN /A054 TAD (-144 /SEE IF MORE THAN TWO DIGITS /A054 TAD I (CYLNO /GET THE CURRENT CYLINDER NUMBER /A054 SMA CLA /SKIP THE COLUMN SUBTRACT ON TWO DIGITS /A054 AC7777 /SUBTRACT 1 FROM THE /A054 TAD CYLCOL /CYLINDER COLUMN /A054 DCA CYLCOL /RESTORE THE UPDATED CYLINDER COLUMN /A054 JMS I IOASET /CALL THE DISPLAY ROUTINE /A054 -5 /NUMBER OF ARGUMENTS TO PASS /A054 HDERR /^P!D^P!D /A054 ERRCOL, 0 /ERROR COLUMN WITH EMBEDDED LINE # /A054 ERRCNT /THE ERROR NUMBER /A054 CYLCOL, 0 /CYLINDER COLUMN WITH EMBEDDED LINE # /A054 CYLNO /THE CYLINDER NUMBER /A054 JMS I IOASET /CALL THE DISPLAY ROUTINE /A054 -5 /NUMBER OF ARGUMENTS TO PASS /A054 HDERR /^P!D^P!D /A054 HEDCOL, 0 /HEAD COLUMN WITH EMBEDDED LINE # /A054 HEADNO /THE HEAD NUMBER /A054 SECCOL, 0 /SECTOR COLUMN WITH EMBEDDED LINE # /A054 SECTNO /THE SECTOR NUMBER /A054 TAD LINENO /GET THE LAST LINE NUMBER USED /A054 TAD (-2300 /IF IT WAS LINE 23 THEN RESET THE COUNT /A054 SNA CLA /IF IT WASN'T THEN PRESS ON /A054 JMS ASKPRT /GO ASK FOR PRINT & RESET LINENO /A054 JMP I RDERR /RETURN TO CALLER. RETURN DF=MYF /A054 ASKPRT, XX /ASK USER TO PRINT HARD DISK ERRORS, RESET LINENO. PART OF VEBLKS JMS SETMS1 /SET UP THE 'WHEN READY....PROMPT /A054 PTRCPY /'PLEASE PRESS PRINT SCREEN TO RECORD /A054 /THE ABOVE INFORMATION. /A054 NOP /NOOP AS NULL ARGUMENT /A054 NOP /NOOP AS NULL ARGUMENT /A054 TAD (1100 /START LINE -1, COLUMN 0 /A054 DCA LINENO /RE-INITIALIZE LINENO /A054 JMS I IOASET /CALL IOACAL /A054 -2 /NUMBER OF ARGUMENTS TO PASS /A054 PSCR /'^P!E'. POSITION & ERASE TO EOS /A054 1000 /FROM LINE 8 COLUMN 0 /A054 JMP I ASKPRT /RETURN TO CALLER. RETURN DF=MYF /A054 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VEABLK, XX /READ AND VALIDATE THE ALLOCATION BLOCK. 1ST LEVEL SUB. /M054 /WILL BE CALLED TWICE. THE FIRST TIME, NOTHING ELSE HAS BEEN /DONE; THE 2ND TIME, THE BLOCK LIST WILL BE IN F6. VEABLK WILL /IOR THE FREE BIT INTO THE BLOCK LIST STATUS WORD. JMS GTALLC /GET ALLOCATION BLOCK TO ABLKBF. RET DF=BUF/M054 JMP ABLKE1 /READ ERROR, GO REPORT ERROR /C050 DCA SYSDSC /SET FIRST AVAILABLE BLOCK TO 0 FIRST. /M054 DCA ALLOK /CLEAR THE ALLOCATION FLAG/LINK /M054 TAD I (ABLKBF+1) /CHECK THE TYPE WORD /M055 AND (70) /FOR THE TYPE NIBBLE ONLY /M054 TAD (-40) /'4' IS THE ALLOCATION BLOCK TYPE /M054 SZA CLA JMP ABLKE1 /JUMP IF WRONG FLAG WORD /C042 /TD056/CHECK FOR A MOUNTED WINNY /TD056 TAD (-4 /4 IS THE DENSITY CODE FOR A MOUNTED WINNY /TD056 TAD DENFLG /GET THE CURRENT DENSITY CODE /A054 /TD056 SPA CLA /POSITIVE RESULTS ARE WINNY OR MORE /A054 /TD056 JMP TRYRX /OTHERWISE, GO TEST FOR RX50 TYPE /A054 TAD I (ABLKBF+4 /GET THE IMAGE -ALLOCATION WORD COUNT /A054 TAD ALCCNT /ADD THE RESOLVED ALLOCATION WORD COUNT /A054 SPA CLA /OK IF ITS LESS OR EQUAL /A054 JMP ABLKE1 /ELSE ITS IN ERROR /A054 TAD I (ABLKBF+4 /GET THE IMAGE -ALLOCATION WORD COUNT /A056 CIA /NEGATE IT /A056 DCA ALCCNT /MAKE THAT THE ALLOCATION WORD COUNT /A056 /TD056 JMP ALCOK /ON OK, JUST PRESS ON /A054 /TD056/IF DOING RX50'S, THE ALLOCATION WORD COUNT FOR SYSTEM=141, DOC=143 /M054 /TD056TRYRX, AC7776 /CHECK TO SEE IF IT'S AN RX50 /A027 /TD056 TAD DENFLG /IS IT? /A027 /TD056 SZA CLA /IF EQUAL, THEN ITS RX50 SIZE /C055 /TD056 JMP NOTRX /RETURN IF NOT /A054 /TD056 ISZ RX50SZ /SET THE 'RX50 SIZE' FLAG /A055 /TD056 TAD SYSDSK /SYSDSK=1 IF SYSTEM DISKETTE /A027 /TD056 SNA CLA /IF /M054 /TD056 AC0002 /NOT SYS, ADD 2 FOR 143 WITH /A054 /TD056 TAD (141 /+141 FOR SYSTEM /M054 /TD056 JMP WASRX /DON'T ADD (ALCCNT) FOR RX50S /A054 /TD056NOTRX, TAD ALCCNT /NON RX50 USES (ALCCNT) /A054 /TD056WASRX, TAD I (ABLKBF+4 /GET THE ALLOCATION WORD COUNT FROM IMAGE/A054 /TD056 SZA /SHOULD BE EQUAL /A054 /TD056 JMP ABLKE1 /JUMP IF WRONG ALLOCATION COUNT /C042 /CHECK BIT MAP ALCOK,/TD056 AC7777 /A016 TAD ALCCNT /MAKE COUNTER OF # OF ALLOCATION WORDS /A016 CIA /A016 DCA ABLKC1 /NUMBER OF ALLOCATION WORDS /M054 TAD (ABLKBF+4) DCA ABLKP1 /INITIALLY POINT TO FIRST WORD -1 /M054 TAD (BLKLST) /GET THE BASE ADDRESS OF THE BLOCK LIST /M054 DCA ABLKP2 /ABLKP2 IS THE POINTER INTO THE BLOCK LIST/M054 DCA FRECNT /INITIALIZE THE FREE BLOCK COUNTER TO 0 /M054 ABLKL1, ISZ ABLKP1 /INCREMENT THE ALLOCATION WORD POINTER /M054 TAD (-10) DCA ABLKC2 /SET SHIFT COUNTER CDFBUF /POINT AT THE BUFFER FIELD /A054 TAD I ABLKP1 /GET THE ALLOCATION WORD /M054 AND (7400) /CHECK HI BITS SZA CLA JMP ABLKE1 /ON A HI BIT ERROR, CALL ALLOK AND QUIT /A054 TAD I ABLKP1 /GET AGAIN RTL RTL /ALIGN FIRST BIT MQL /SAVE CDFLST /POINT AT THE LIST FIELD /A054 ABLKL2, CLA MQA /GET SHIFTED ALLOCATION WORD /M054 RAL MQL /GET NEXT BIT, SAVE REMAINDER SZL ISZ FRECNT RAR /0 OR 4000, THIS BLOCK'S FLAG IS IN BIT 0 SPA /0 MEANS USED, 1 MEANS FREE /A055 TAD I ABLKP2 /IOR (ADD) THE BLOCK LIST STATUS WORD /M054 SPA /COULD BE 2ND PASS THRU & FREE COULD BE SET DCA I ABLKP2 /WRITE BACK THE UPDATED STATUS WORD /M054 CLA /ASSURE (AC)=0 FOR ABLKL1 /M054 ISZ ABLKP2 /INCR THE BLOCK LIST POINTER /M054 ISZ ABLKC2 /INCR THE SHIFT COUNTER /M054 JMP ABLKL2 /LOOP FOR ALL BITS IN THIS WORD /M054 ISZ ABLKC1 /INCREMENT THE ALLOCATION WORD COUNTER /M054 JMP ABLKL1 /LOOP FOR ALL WORDS CDFBUF /POINT AT THE BUFFER FIELD FOR ABLKBF /A054 TAD I (ABLKBF+1) /GET THE TYPE WORD /C054 AND (71) /LOOK AT TYPE AND SYSTEM NIBBLES /M054 TAD (-41) /FOR TYPE IS 4 AND SYSTEM BIT TRUE /M054 SZA CLA JMP ABLKL4 /IF BOTH WEREN'T TRUE, THEN SYSDSC=0 & EXIT TAD I (ABLKBF+2) /# 0F BLOCKS IN SYSTEM /M054 TAD DSKIDX /ADD NEGATIVE OF MAXIMUM BLOCKS /M054 SMA SZA CLA /DOES THE ALLOCATION BLOCK CLAIM TOO MANY? JMP ABLKE1 /IF SO, MARK IT AS BAD & EXIT /M054 AC7776 /LOOK FOR RX50 & HIGHER DENSITY CODES /A055 TAD DENFLG /GET THE CURRENT DENSITY CODE /A054 SPA CLA /POSITIVE RESULTS ARE RX50 OR MORE /A054 JMP OLDSYS /OTHERWISE, GO DO THE LOOK UP ROUTE /A054 TAD I (ABLKBF+2 /GET THE BLOCKS AVAILABLE PER THE IMAGE /A054 TAD DSKIDX /ADD THE NEGATIVE BLOCKS AVAIL PER VOL /A054 SZA SMA /OK ON =/< /C055 JMP ABLKE1 /ELSE ITS IN ERROR /A054 CIA /MAKE IT POSITIVE FOR LATER COMPARISONS /A055 DCA SYSDSC /SYSTEM SIZE- HIGHEST SYS BLOCK /A055 TAD RX50SZ /SEE IF WERE DOING RX50 OR 800 BLOCK VOL/A055 SNA CLA /IF NOT, THEN /A055 JMP ABLKL4 /JUST PRESS ON /A055 TAD SYSDSC /ELSE GET BACK THE SYSTEM SIZE /A055 TAD (-26 /COMPENSATE FOR FIRMWARE /A055 DCA SYSDSC /SYSTEM SIZE- HIGHEST SYS BLOCK /A054 JMP ABLKL4 /ON OK, JUST PRESS ON /A054 OLDSYS, TAD DENFLG /GET THE DENSITY OF THE DISKETTE /A033 TAD (SZTAB) /POINT TO DISKETTE SIZE (WAS SIZTAB) /C055 DCA T1 /USE T1 AS POINTER /M054 TAD I (ABLKBF+2) /GET # OF BLOCKS REMAINING AFTER SYSTEM /M054 CIA /SET UP TO SUBTRACT /A033 CDFMYF /A033 TAD I T1 /ADD IN SIZE OF DISKETTE /A033 DCA SYSDSC /RESULT IS SYSTEM SIZE IN BLOCKS. /M054 JMP ABLKL4 ABLKE1, JMS ALLOK /READ, FLAG, OR ALLOCATION COUNT ERROR /M054 ABLKL4, JMP I VEABLK /RETURN TO CALLER ABLKC1, 0 /COUNT OF ALLOCATION WORDS TO GO /M054 ABLKC2, 0 /SHIFT COUNTER FOR BITS IN A WORD /M054 ABLKP1, 0 /POINTER TO ALLOCATION WORD IN ABLKBF /M054 ABLKP2, 0 /POINTER TO STATUS WORD IN BLKLST IN F6 /M054 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VEHDR, XX /VERIFY HEADER BLOCKS FOR FILE (FILENO). PART OF VEFCHK /M054 CLA TAD FILENO /GET THE NUMBER OF THIS FILE /M054 TAD (HBLKBF+11) /ADD THE BASE TO LOCATE THE POINTER WORD/M054 /IN THE HOME BLOCK BUFFER. /A054 DCA T1 /USING T1 AS THE POINTER /M054 CDFBUF /IN THE BUFFER FIELD /M054 TAD I T1 /GET THE ACTUAL HEADER BLOCK NUMBER /M054 SNA /IF ZERO, THERE'S NO SUCH FILE /M054 JMP VEHDE1 /NO SUCH FILE DCA HDR1 /SAVE THE HEADER BLOCK NUMBER /M054 TAD HDR1 /GET IT BACK TO CHECK BLOCK ATTRIBUTES /M055 JMS VEHBCH /IN BLKLST STATUS WORD. RET DF=BUF /M054 JMP CHKFLE /IF BAD ATTRIBUTES, TAKE ERROR PATH /A054 JMS I IQURX /READ THE HEADER BLOCK /M054 RXERD+4000 HDR1, 0 /FOR THIS FILE NUMBER /M054 HDR1BF /INTO THE HEADER 1 BUFFER /M054 JMP VEHDE4 /READ ERROR /C042 CDFBUF /OK, CHECK TYPE WORD TAD I (HDR1BF+1) /GET THE TYPE WORD FROM THE BUFFER /M054 AND (70) /MASK OUT ALL BUT BITS 6-8 /M054 TAD (-10) /BITS 6-8 SHOULD BE 001 /M054 SZA CLA JMP VEHDE4 /WRONG TYPE TAD I (HDR1BF+4) /CHECK "INFORMATION" WORD COUNT /M054 TAD (-50) SZA CLA JMP VEHDE4 /WRONG INFO COUNT /C042 TAD I (HDR1BF+13) /COMPARE FILE NUMBER AT HDR1BF+13 /M054 CIA TAD FILENO SZA CLA JMP VEHDE4 /WRONG FILE NUMBER /A055 AC0001 /CHECK FOR THE GO-TO-PAGE BIT /A056 AND I (HDR1BF+1 /IN THE TYPE WORD /A056 SNA CLA /NON ZERO MEANS GO-TO-PAGE IS PRESENT /A056 /D056 TAD I (HDR1BF+1 /CHECK FOR GO-TO-PAGE STRUCTURE /M054 /D056 RAR /ROTATE BIT 11 INTO THE LINK /A025 /D056 SNL CLA /IF PRESENT, GO CHECK GTP STRUCTURE /M054 JMP HDR1A /IF NOT, CONTINUE HEADER CHECKS /M054 JMS VECRPB /GO VERIFY RAPID PAGINATION BLOCKS /A019 /DON'T DELETE A FILE DUE TO ITS OWN BAD GTP STRUCTURE...C056 /D056 JMP VEHDE4 /BAD GOTOPAGE STRUCTURE /C042 /D056HDR1A, CDFBUF HDR1A, TAD I (HDR1BF+5) /GET # DATA BLOCKS IN THIS FILE /M054 TAD (-310) /COMPARE TO 200 /M054 SMA CLA /IGNORE EXTENSIONS IF LESS THAN 200 BLOCKS/M054 TAD I (HDR1BF+2) DCA HDR2 /SAVE 1ST EXT HDR NUM TAD I (HDR1BF+3) DCA HDR3 /AND 2ND ONE TAD (HDR2BF-1) DCA AIR10 /CLEAR EXT HDR BUFRS /M056 TAD (-1000) DCA T1 HDRLP, DCA I AIR10 /M056 ISZ T1 JMP HDRLP /C042 TAD HDR2 /READ EXT HDRS SNA JMP VEHDOK /QUIT IF NO MORE JMS VEHBCH JMP VEHDE4 /ERROR RETURN /C054 JMS I IQURX /READ IT RXERD+4000 HDR2, 0 HDR2BF JMP VEHDE4 /ERROR (SHOULDN'T HAPPEN) /C042 TAD HDR3 /OK RETURN /C050 SNA JMP VEHDOK /QUIT IF NO MORE JMS VEHBCH JMP VEHDE4 /CHECK, QUIT IF ERROR /C042 JMS I IQURX RXERD+4000 HDR3, 0 HDR3BF JMP VEHDE4 /ERROR (SHOULDN'T HAPPEN) /C042 VEHDOK, ISZ VEHDR JMP I VEHDR / CHKFLE, /CHANGED TO PUT THE PREVIOUSLY UNREPORTED 'OTHER' FILE IN THE /A055 /'AFFECTED' LIST, MOVED THE ORIGINAL CALL TO THE 'AFFECTED' LIST/A055 /DOWN INTO BADHDR WHERE IT NOW PUTS THE CURRENT FILENO IN BOTH /A055 /'AFFECTED' AND 'NOT COPIED' LISTS. I BELIEVE THAT THIS IS A POINT/A055 /WHERE A DECISION THAT A FILE IS BAD IS SOMETIMES BEING MADE ON /A055 /THE BASIS OF SEQUENCE RATHER THAN COMPARATIVE ANALYSYS. /A055 AND P377 /GET THE NUMBER OF THE FILE CLAIMING THE/A055 DCA REG11 /THE BLOCK AND STORE IT IN REG11 /A055 TAD FILENO /GET THE FILE NUMBER WE'RE PROCESSING /A055 DCA REG12 /AND SAVE IT IN REG12 /A055 TAD REG11 /GET BACK THE 'OTHER' FILE NUMBER /A055 DCA FILENO /PUT IT IN FILENO TEMPORARILY /A055 AC4000 /SET THE NOT COPIED BIT /C056 JMS DOCSET /GO REPORT THE 'OTHER' FILE /A055 TAD REG12 /GET BACK THE FILENO WE WERE PROCESSING /A055 DCA FILENO /PUT IT BACK FOR FURTHER PROCESSING /A055 VEHDE4, JMS BADHDR /HDR VALIDITY CHECK ERROR VEHDE1, JMP I VEHDR /RETURN TO CALL+1 /M054 VEHBCH, XX /CHECK HEADER BLOCK /M054 MQL MQA CLL TAD DSKIDX /A016 SZL CLA JMP HBCNOK /OUT OF RANGE /C054 MQA TAD (BLKLST) /CHECK ATTRIBUTES DCA T1 CDFLST /GET INTO THE LIST FIELD /A054 TAD I T1 AND (2377) /FREE,ERROR,USED SNA /KEEP THE NUMBER FOR CHKFLE /A055 ISZ VEHBCH /BUMP TO OK RETURN HBCNOK, CDFBUF /A054 JMP I VEHBCH FNC=. /FIRST NON-CODE LOCATION /A042 PAGE VEFCHK, XX /CHECK CURRENT FILE'S STRUCTURE. 1ST LEVEL SUBROUTINE. /M056 DCA FILENO /INITIALIZE FILE NUMBER /A055 VEFLP, ISZ FILENO /UPDATE THE FILE NUMBER /A055 TAD FILENO /GET IT BACK FOR TERMINATION CHECK /A055 TAD (-311 /311 IS ONE COUNT TOO MANY /A055 SMA CLA /IF ITS = OR GREATER THEN /A055 JMP I VEFCHK /ALL DONE, RETURN TO MAIN /A055 JMS VEHDR /VERIFY HEADERS FOR THIS FILE /M055 JMP VEFLP /ERROR RETURN FROM VEHDR /A055 JMS I IOASET /CALL IOACAL - GOOD RETURN FROM VEHDR /M055 -3 /NUMBER OF ARGUMENTS TO PASS /A042 VSCRN3 /"CHECKING DOCUMENT ^D" /C049 -2600 /CURSOR POSITION AND ERASE /C049 FILENO /DOCUMENT NUMBER /CHECK FILE (FILENO)S DATA BLOCKS, HEADERS ALREADY LOADED & VALIDATED /A055 DCA VEDBCT /CLEAR BLOCK COUNT TAD HDR1 /ACCOUNT HEADERS SZA JMS VEDSUB TAD HDR2 SZA JMS VEDSUB TAD HDR3 SZA JMS VEDSUB AC7776 /A024 DCA EXTFLG /SO EXT BLOCK #2 IS SHORTER /A024 TAD (HDR1BF+55) DCA VEDBP1 /SET TO FIRST BLOCK TAD (55-400) DCA VEDBC1 /# PTRS IN FIRST BLOCK TAD (-3) DCA VEDBC2 /MAX # HDRS VEDLP1, CDFBUF TAD I VEDBP1 /GET NEXT DATA BLOCK # CDFMYF SNA JMP VEDBDN /JUMP IF NO MORE JMS VEDSUB /ACCOUNT IT ISZ VEDBCT /BUMP OUR BLOCK COUNT ISZ VEDBP1 /BUMP PTR NOP /AVOIDS PROBLEM WHEN BP1 PASSES 0 /A024 ISZ VEDBC1 JMP VEDLP1 /LOOP FOR ALL IN THIS HDR ISZ XTNFLG /CHECK FOR EXTENSION MODE /A024 SKP /A024 JMP VEDXTN /A024 ISZ VEDBP1 ISZ VEDBP1 /CROSS INTER-HDR GAP ISZ EXTFLG /SEE IF THIS IS 2ND EXT BLOCK /M054 SKP /A024 TAD (16 /IF SO, LESS PTRS IN THIS ONE /A024 TAD (-376) DCA VEDBC1 /# PTRS IN THIS HDR ISZ VEDBC2 JMP VEDLP1 /LOOP FOR ALL HDRS AC7776 /BACK UP TWO SPACES /A024 TAD VEDBP1 DCA EXTPTR VEDXTN, CDFBUF /? TAD I EXTPTR CDFMYF SNA JMP VEDBDN /DONE IF NO MORE BLOCK #'S /M054 ISZ EXTPTR /POINT TO NEXT EXT HDR BLOCK /M054 DCA BLKIN TAD BLKIN JMS VEDSUB /MARK EXT HDR BLOCK IN USE /M054 TAD (HDR4BF /NOW READ EXT HDR BLOCK TO HDR4BF /M054 JMS READIN TAD (HDR4BF+2 /SET POINTER AT START OF BLOCKS /A024 DCA VEDBP1 TAD (-376 /SET PTR COUNTER AT 376 /A024 DCA VEDBC1 AC7777 /MINUS 1 /M055 DCA XTNFLG /IN XTNFLG INDICATES EXTENSION HEADER /M055 JMP VEDLP1 /PROCESS THE EXTENSION HEADER'S DATA BLOCKS/A055 VEDBHE, JMS BADHDR /TOO BIG. GO REPORT & DELETE THE FILE /A055 VEDBDN, DCA XTNFLG /ZERO XTNFLG /A055 JMP VEFLP /LOOP TO CHECK NEXT FILE /A055 VEDSUB, XX /PART OF VEDBLK. ON CALL (AC)=(HDRX) 1,2,3. PART OF VEDBLK/A055 /IF THE HEADER BLOCK # IS OUT OF RANGE THEN GOTO VEDBHE /IF IT IS MARKED FREE THEN FLAG ALLLOCATION BLOCK REBUILD /IF IT IS MARKED READ FAIL THEN FLAG THE ERROR AND RETURN /IF IT IS MARKED WRONG COUNT, MULI-USE, OR A FILE # PRESENT THEN / MARK THE BLOCK LIST STATUS WORD AS MULTI-USE, FLAG / THE ERROR AND RETURN /ELSE IOR (FILENO) INTO THE BLOCK LIST STATUS WORD & RETURN DCA SBLKNO /THIS IS THE HEADER BLOCK NUMBER /A055 TAD SBLKNO /GET IT BACK FOR COMPARISON /A055 TAD DSKIDX /ADD -MAXIMUM COUNT /A055 SMA SZA CLA /ANY NUMBER UP THRU -DSKIDX IS OK /A055 JMP VEDBHE /TOO BIG, SO EXIT VEDSUB,VEDBLK, & VEFCHK/A055 AC4000 /MASK FOR THE 'FREE' FLAG /A055 JMS TEST1 /IN THE STATUS WORD @ (BLKLST+(SBLKNO) /A055 SZA CLA /IF ITS MARKED FREE /A055 JMS ALLOK /FLAG TO REBUILD THE ALLOCATION BLOCK /A055 AC2000 /MASK FOR THE 'READ FAIL' FLAG /A055 JMS TEST1 /IN THE STATUS WORD @ (BLKLST+(SBLKNO) /A055 SZA CLA /IF ITS MARKED 'READ FAIL' /A055 JMP VEDERR /GO FLAG THE ERROR AND EXIT /A055 TAD (1777 /MASK FOR 'WRONG COUNT', MULTI-USE, AND /A055 /FILE NUMBER PRESENCE /A055 JMS TEST1 /IN THE STATUS WORD @ (BLKLST+(SBLKNO) /A055 SNA CLA /IF NONE WERE PRESENT /A055 JMP ADFIL /GO IOR THE FILE NUMBER INTO THE LIST /A055 TAD (400 /ELSE SET THE MULTIPLY USED FLAG /A055 JMS IORBLK /IN THE STATUS WORD @ (BLKLST+(SBLKNO) /A055 JMP VEDERR /GO FLAG THE ERROR AND EXIT /A055 ADFIL, TAD FILENO /GET THE NUMBER OF THIS FILE /A055 JMS IORBLK /IOR IT IN STATUS WORD @ (BLKLST+(SBLKNO)/A055 JMP VEDSBX /GO RETURN /A055 VEDERR, JMS ERRORS /FLAG THE ERROR /A055 VEDSBX, CDFMYF /GET BACK TO THIS DATA FIELD /A055 JMP I VEDSUB /RETURN TO THE CALLER /A055 VEDBP1, 0 /DATA BLOCK PTR FOR VEDBLK /A055 VEDBC1, 0 /DATA BLOCK COUNTER FOR VEDBLK /A055 VEDBC2, 0 /HDR BLOCK COUNTER FOR VEDBLK /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE QURX, XX CLA RDF /GET THE CURRENT DATA FIELD /A054 TAD CDF0 /ADD THE CHANGE DATA FIELD INSTRUCTION /A054 DCA DESFLD /TELL RXHAN WHICH FIELD GETS THE DATA /A054 CDFMYF /A050 TAD DRIVE /GET DRIVE/DEVICE NUMBER /C042 DCA QUQBLK+RXQDRV /IN QBLK TAD I QURX DCA QUQBLK+RXQFNC /FUNCTION CODE ISZ QURX TAD I QURX DCA QUQBLK+RXQBLK /BLOCK NUMBER ISZ QURX TAD I QURX DCA QUQBLK+RXQBAD /BUFFER ADDRESS ISZ QURX CIF 0 ENQUE QUQB QURX1, CIF 0 JWAIT TAD QUQBLK+RXQCOD /DONE YET? SNA JMP QURX1 /LOOP IF NOT SMA CLA /IF ERROR, TAKE FIRST RETURN /A050 ISZ QURX /ELSE BUMP POINTER FOR OK RETURN /A050 JMP I QURX /RETURN /C050 QUQB, DSKQUE 0 0 QUQBLK, 0 0 0 0 0 0 0 0 0 0 0 0 DESFLD, 0 /CHANGE DATA FIELD INSTRUCTION FOR RXHAN/A054 0 0 FRECHK, XX /CHECK FREE BLOCKS FOR USED OR ERROR. FIRST LEVEL SUBR /M054 JMS TAKSYS /RESERVE THE KNOWN SYSTEM BLOCKS. RET DF=LST TAD (BLKLST) /GET THE BASE OF THE BLOCK LIST /M054 DCA T2 /USE IT AS A POINTER /M054 AC7777 /CHECK FOR 1 /A056 TAD DENFLG /AS THE DENSITY CODE /A056 SNA CLA /IF NOT RX02, RECALCULATE THE BLOCK COUNT JMP ISRX02 /IF IT WAS, USE THE LOOKED UP VALUE /A056 AC7777 /GET A MINUS 1 /A056 TAD ALCCNT /GET THE CURRENT ALLOCATION WORD COUNT /A056 CLL RTL /MULTIPLY BY 4 /A056 RAL /THEN MULTIPLY BY 2 FOR 8 /A056 CIA /NEGATE THE NEW BLOCK COUNT /A056 DCA DSKIDX /MAKE THAT THE INDEX FOR FREE CHECKING /A056 ISRX02, TAD DSKIDX /GET THE NEGATIVE MAXIMUM BLOCK COUNT /M054 DCA T1 /USE IT AS THE "TO-GO" COUNT /M054 FRECH1, TAD I T2 /GET NEXT BLOCK LIST STATUS WORD /M054 SPA /IF NOT "FREE", SEE IF IT IS FREE /A054 JMP FRCHUS /IF MARKED "FREE", GO CHECK IF USED /A054 AND P377 /JUST LOOK AT THE FILE NUMBER /M054 SNA CLA /THERE SHOULD BE ONE /M054 JMS ALLOK /IF NO FILE #, FLAG TO REBUILD ALLOCATION TAD I T2 /GET THE STATUS WORD BACK /A054 AND (2400) /CHECK FOR 'READ FAIL' AND 'MULTI-USE' FLAGS SZA CLA /CLA HERE FORCES JUMP TO FRNOUS BELOW /M054 JMS ALLOK /IF EITHER WAS SET, FLAG TO REBUILD ALLOCATION FRCHUS, AND P377 /CHECK USED BY "AND"ING FILE NUMBER /M054 SNA CLA /IF THERE IS A FILE #, 'UNFREE' THE BLOCK/A054 JMP FRNOUS /IF NO FILE #, JUST PRESS ON /A054 JMS ALLOK /FLAG TO REBUILD THE ALLOCATION BLOCK /M054 AC3777 /MASK TO CLEAR THE FREE BIT /A054 AND I T2 /T2 POINTS AT THE BLOCK LIST STATUS WORD/M054 DCA I T2 /RE-WRITE THE BLOCK LIST WORD SANS "FREE"/M054 AC2000 /MASK FOR THE 'READ FAIL' FLAG IN THIS FREE BLOCK AND I T2 /GET BACK THE UPDATED BLOCK LIST STATUS WD/A054 SZA CLA /OK IF 'READ FAIL' NOT SET /A054 JMS ERRORS /ELSE MARK THE ERROR /A054 FRNOUS, ISZ T2 /INCREMENT THE BLOCK LIST POINTER /M054 ISZ T1 /DECREMENT THE "TO-GO" COUNT /M054 JMP FRECH1 /LOOP FOR ALL BLOCK LIST WORDS /M054 JMS HLTCHK /SEE IF THE USER PRESSED GOLD HALT /A054 JMP COPY6 /IF SO, GO CHECK FOR SYS & PRMPT GM /A054 JMP I FRECHK /AND RETURN TO CALLER TAKSYS, XX /CLAIM ALL KNOWN SYSTEM BLOCKS IN BLKLST CLA TAD P377 /SYSTEM FLAG, FILE #0 /C054 MQL CDFLST /POINT AT THE LIST FIELD /A054 TAD (BLKLST) /SAVE IN BLOCK 0 JMS ORLST TAD (BLKLST+1) /1 JMS ORLST TAD (BLKLST+2) /2 JMS ORLST TAD (BLKLST+6) /6 JMS ORLST TAD (BLKLST+377) /377 JMS ORLST JMP I TAKSYS ORLST, XX /MQ IS BITS,AC IS ADDR, CDF IS SET DCA REG10 TAD I REG10 MQA DCA I REG10 JMP I ORLST FNC=. /FIRST NON-CODE LOCATION /A042 PAGE /D056VEMCHK, XX /CHECK FOR MULTI-USED BLOCKS. 1ST LEVEL SUBR. /M054 /D056 /DELETE EVERY FILE CLAIMING MULTIPLY USED BLOCKS WAS THE /D056 /INTENT, IT JUST DELETES THE FILES WHOSE NUMBER IS IN THE /D056 /BLOCK MARKED MULTI-USE. DON'T BELIEVE ANY USEFUL INFO IS /D056 /LOST IF THIS ROUTINE IS NEVER EXECUTED...JUMP BY IT BUT /D056 /LEAVE IT SO IT CAN BE ENABLED. /A055 /D056/ JMP I VEMCHK /FOR TEST BYPASS /A055 /D056 CLA /D056 DCA FILENO /D056VEMCH1, ISZ FILENO /GET NEXT FILE /D056 TAD FILENO /D056 TAD (400) /ADD MULTI-USE FLAG /D056 CIA /NEGATE THE NUMBER /M054 /D056 DCA T1 /SAVE FOR COMPARE /D056 DCA T3 /CLEAR COUNTER /C054 /D056 TAD (BLKLST-1) /D056 DCA X0 /D056 TAD DSKIDX /A016 /D056 DCA T2 /D056 CDFLST /POINT AT THE LIST FIELD /A054 /D056VEMLP, TAD I X0 /GET NEXT BLOCK LIST STATUS WORD /M054 /D056 AND (777) /IGNORE ALL BUT MULTI-USE STATUS /D056 TAD T1 /D056 SNA CLA /D056 ISZ T3 /COUNT MULTI-USED BLOCKS /C054 /D056 ISZ T2 /D056 JMP VEMLP /LOOP FOR ALL STATUS WORDS /M054 /D056 CDFMYF /D056 TAD T3 /ANY MULTI-USED BLOCKS? /C054 /D056 SZA CLA /IF THERE WERE THEN /A055 /D056 JMS DLTFIL /GO DELETE THE FILE /M055 /D056 TAD FILENO /LOOKED AT ALL FILES? /D056 TAD (-310) /D056 SPA CLA /D056 JMP VEMCH1 /LOOP UNTIL WE HAVE /D056 JMP I VEMCHK /THEN RETURN TO CALLER /THE SETMS(N) SUBROUTINES LOAD ONE OF THE STANDARD PROMPT MESSAGES INTO /A054 /VEPRMT THEN PASS THE LINK TO VEPRMT, WHICH GETS THE REMAINING /A054 /ARGUMENTS AND ISSUES THE MESSAGE AND THE PROMPT. /A054 / SETMS1, XX /"When ready Press Return or Press Gold Menu .... /A054 CDFMYF CLA TAD (VSCRNE) /Get "when ready" message DCA VEPRM5 /Install it TAD (VSCRNG) /Get "or press gold menu" message DCA VEPRM6 /Install it TAD SETMS1 /GET THE LINK FOR PASSING ON /C054 JMS VEPRMT /CALL VEPRMT /C054 / SETMS2, XX /"Press Gold Menu to recall the Main Menu" /A054 CDFMYF CLA TAD (VSCRNG) /Get "Press Gold menu" message DCA VEPRM5 /Install it TAD (VSNULL) /Get null message DCA VEPRM6 /Install it TAD SETMS2 /GET THE LINK FOR PASSING ON /C054 JMS VEPRMT /CALL VEPRMT /C054 / SETMS3, XX /"To do this press RETURN or Press Gold Menu ..... /A054 CDFMYF CLA TAD (VSCRNN) /Get "to do this..." message DCA VEPRM5 /Install it TAD (VSCRNG) /Get "or press gold menu" message DCA VEPRM6 /Install it TAD SETMS3 /GET THE LINK FOR PASSING ON /C054 JMS VEPRMT /CALL VEPRMT /C054 /VEPRMT IS A LOW LEVEL SUBROUTINE WHICH IS SLAVE TO THE SETMS(N) CALLS. /C054 /THE SETMS(N) LINK IS PASSED TO VEPRMT FOR ARGUMENT PASSING AND CORRECT /C054 /LINKAGE TO THE SETMS(N) CALLER. VEPRMT DISPLAYS THE PASSED MESSAGE /C054 /FOLLOWED BY THE STANDARD LOWER SCREEN PROMPTS. THE PROMPT SET UP BY /C054 /THE CALLING SETMS(N) WILL BE SEEN. THEY ARE LISTED HERE FOR REFERENCE: /A045 / SETMS1 - "When ready press return or press Gold Menu for Main Menu. /A045 / SETMS2 - "Press Gold Menu to return to Main Menu. /A045 / SETMS3 - "To do this press return or press Gold Menu for Main Menu. /A045 / / THERE MUST ALWAYS BE THREE ARGUMENTS TO SETMS(N): THE /C054 / MESSAGE LABEL OR "VSNULL" AND ARGUMENTS TO THE MESSAGE. FOR /A045 / NULL ARGUMENTS USE THE NOP INSTRUCTION. EXAMPLE: /A045 / JMS SETMS1 /SET UP THE "WHEN READY..." PROMPT, THEN/C054 / /DISPLAY THE MESSAGE AND PROMPT. /C054 / VSNULL /THE MESSAGE LABEL /A045 / MSGARG /LABEL OF THE ARGUMENT TO THE MESSAGE /A045 / NOP /USE THE NOP INS AS NULL ARG TO VEPRMT /A045 / CODE /THE RETURN POINT /A045 / / CURSOR POSITIONING FOR THE PASSED MESSAGE IS AT LINE 26 /A045 / VEPRMT, XX /THE CALL LINK WILL BE REPLACED WITH THE CALLERS LINK /C054 DCA VEPRMT /STORE THE CALLER'S LINK /C054 TAD I VEPRMT /GET ARG STRING DCA VEPRM2 /SAVE FOR IOA ISZ VEPRMT /POINT AT MESSAGE ARGUMENT /A045 TAD I VEPRMT /GET THE ARGUMENT /A045 DCA VPMT1 /STORE IT FOR PASSING /A045 ISZ VEPRMT /POINT AT MESSAGE ARGUMENT /A045 TAD I VEPRMT /GET THE ARGUMENT /A045 DCA VPMT2 /STORE IT FOR PASSING /A045 ISZ VEPRMT /POINT VEPRMT AT THE RETURN /A045 VEPRML, JMS I IOASET /CALL IOACAL /A042 -4 /NUMBER OF ARGUMENTS TO PASS /C045 VEPRM2, 0 /Passed message address 2600 /POSITION AT LINE 26 WITHOUT ERASE /A045 VPMT1, 0 /PASSED ARGUMENT FOR MESSAGE /A045 VPMT2, 0 /PASSED ARGUMENT FOR MESSAGE /A045 IFDEF CANADA < 141> /Accented character for Canada (L.G.A) IFDEF FRENCH < 141> /Accented character for French (L.G.A) IFDEF DUTCH < 154> /Accented character for Dutch (L.U.E) JMS I IOASET /CALL IOACAL /A042 -2 /NUMBER OF ARGUMENTS TO PASS /A042 PSCR /^P!E/ POSITION AND ERASE TO EOS /A049 IFNDEF FRENCH < 2700 > /POSITION AND ERASE TO EOS /C049 IFDEF FRENCH < 2600 > /The following message is set by the SETMS routines JMS I IOASET /CALL IOACAL /A042 -1 /NUMBER OF ARGUMENTS TO PASS /A042 VEPRM5, VSCRNE /ADDRESS OF FIRST PART "PRESS RETURN" IFDEF FRENCH < JMS I IOASET /CALL IOACAL /A042 -2 /NUMBER OF ARGUMENTS TO PASS /A042 PSCR /^P!E/ POSITION AND ERASE TO EOS /A049 2700 /CURSOR POSITION /C049 > JMS I IOASET /CALL IOACAL /A042 -1 /NUMBER OF ARGUMENTS TO PASS /A042 VEPRM6, VSCRNG /ADDRESS OF SECOND PART 'OR GOLD MENU JMS INCHR /GET RESPONSE TAD (-EDMENU) /CHECK FOR GOLD-MENU SNA JMP VEPRM4 /WAS GM, GO VALIDATE D0 VIZ-A-VIZ SYSDID/M054 TAD (EDMENU-EDNWLN) /IS IT AN EOL? SNA CLA JMP VEPRM3 /YES, SKIP RETURN. JMS RNGBEL /ELSE NOT VALID SO BUZZ JMP VEPRML /RESET LINE AND SEND LINES AGAIN VEPRM3, JMS I IOASET /CALL IOACAL /A042 -2 /NUMBER OF ARGUMENTS TO PASS /A042 IOATSP /^P..POSITION ONLY /C049 -2400 /POSITION CURSOR AT 24TH LINE, ERASE /C049 JMP I VEPRMT /RETURN TO CALLER FNC=. /FIRST NON-CODE LOCATION /A042 PAGE RECONH, XX /TALLY ALL HDRS AND REBUILD HOME JMS ALLOK /FLAG TO REBUILD THE ALLOCATION BLOCK /M054 JMS HOMEOK /FLAG TO MARK PASSAGE THRU THIS CODE /M055 CDFBUF CLA TAD (HBLKBF-1) /ZERO HOME BUFFER DCA AIR17 /M043 TAD (400) /* JMS I IZERO /* TAD (HBLKBF-1) /PRESET FILL IN PTR DCA AIR17 /M043 TAD (-FIXWRD) /FILL IN WC DCA REG10 TAD (FIXLOC-1) /SOURCE ADDR JMS MOVFLD /COPY DATA UP TAD (TYPLST-1) /BASE OF TYPE LIST /M054 DCA AIR17 /M043 TAD DSKIDX /GET THE MINUS MAXIMUM COUNT /M055 DCA REG12 /USE REG12 AS THE 'TOGO' COUNT /M055 DCA SBLKNO /ZERO THE BLOCK POINTER /M054 RHLP, CDFLST /POINT AT THE LIST DATA FIELD /A054 TAD I AIR17 /GET THE TYPE LIST STATUS WORD /M054 MQL /SAVE A COPY IN THE MQ REGISTER /M054 MQA /GET IT BACK /M054 AND (1000) /IS IT A HEADER BLOCK? /M054 SNA CLA /IF IT IS, PROCESS IT /A054 JMP NXTBLK /IF NOT, CONTINUE WITH NEXT BLOCK # /A054 /PROCESS HEADER IN LIST. MQA /TYPE WORD IS IN MQ, (AC)=0 /C050 AND (4000) /IS IT BAD ALSO SZA CLA JMP NXTBLK /YES-SKIP IT /C054 MQA AND P377 /GET THE FILE NUMBER /C054 DCA FILENO /SAVE FOR A POSSIBLE 'AFFECTED' REPORT /A055 TAD FILENO /GET IT BACK FOR FURTHER PROCESSING /A055 SNA /CANT BE FILE # 0 /M055 JMP NXTBLK /WAS 0. /M055 TAD (HBLKBF+11) /ADD TO IT BASE OF THE HOME BLOCK FILE LIST DCA REG11 /USE REG11 AS THE HOME BLOCK FILE LIST PTR/A055 TAD REG11 /GET THE POINTER VALUE /M055 TAD (-HBLKBF-321) /CHECK FOR OVER RUN /C042 SMA SZA CLA JMP NXTBLK /FILE NUMBER TOO BIG /C054 JMS DOCGET /CHECK THE DOCLST ENTRY FOR THIS FILENO /A055 AND (6000 /LOOK FOR THE 'NOT TO BE COPIED' /A056 /AND 'MULTIPLE CLAIMANTS' FLAGS /A056 /CHANGE THIS LOGIC TO REFLECT A MORE COMPREHENSIVE ANALYSIS SZA CLA /OK IF ZERO /A055 JMP NXTBLK /ELSE SKIP IT /A055 CDFBUF /LOOK IN THE BUFFER FIELD AT (HBLKBF+11+(FILENO)) TAD I REG11 /IS A BLOCK NUMBER ALREADY THERE? /M054 SZA CLA /NON-ZERO MEANS THERE WAS A COLLISION /M054 JMP COLISN /SO GO MARK THE DOCLST /A055 UPDH, TAD SBLKNO /GET THE BLOCK NUMBER /M055 DCA I REG11 /STORE IT IN THE HOME BLOCK FILE LIST /M055 /AS THE HEADER BLOCK FOR THE FILE /A055 JMP NXTBLK /AND GO CONTINUE THE LOOP /A055 COLISN, DCA I REG11 /CLEAR THE HOME BLOCK FILE LIST ENTRY /A055 AC2000 /SET 'MULTIPLE CLAIMERS' FLAG /C056 JMS DOCSET /IN THIS FILE'S DOCLST ENTRY /A055 /D056 AC7777 /CLEAR ALL THE DATA /A055 /D056 JMS CLR1 /FROM THE BLOCK LIST STATUS WORD /A055 /D056 AC4000 /SET THE FREE FLAG IN THE /A055 /D056 JMS IORBLK /BLOCK LIST STATUS WORD. RETURN DF=LST. /A055 NXTBLK, ISZ SBLKNO /SET THE NEXT BLOCK NUMBER /M054 ISZ REG12 /DONE ? JMP RHLP /NO /C042 CDFMYF JMP I RECONH /EXIT MOVFLD, XX /COPIES (REG10) WORDS FROM +((AIR16))MYF TO +((AIR7))BUF/M054 DCA AIR16 /M043 MFLP, CDFMYF /C042 TAD I AIR16 /COPY FIXED MATERIAL UP /M043 CDFBUF DCA I AIR17 /M043 ISZ REG10 /DONE? JMP MFLP /NO JMP I MOVFLD /EXIT ZDATA, XX /ZERO VBLKBF & SET UP AS DATA BLOCK /M054 CDFBUF CLA TAD (VBLKBF /GET THE ADDRESS OF VBLKBF /A055 DCA AIR17 /ZERO FROM VBLKBF+1 /M055 TAD P377 /C054 JMS I IZERO TAD (VBLKBF /GET THE ADDRESS OF VBLKBF /A056 DCA REG10 /SET PTR TAD (COSCNT) DCA I REG10 JMP I ZDATA DSPMSG, XX /PUT THE CURRENT BLOCK NUMBER IN DISPLAY & CALL CPYUPD /M054 TAD SBLKNO /PICK UP THE BLOCKNUMER /A033 DCA BLKNO /PUT IT WHERE IT CAN BE DISPLAYED /A033 JMS CPYUPD /A033 CBLKNB /DISPLAY 'CHECKING BLOCK NUMBER XXX' /A033 CDFBUF /A033 JMP I DSPMSG /A033 CPYABT, JMS I IOASET /CALL IOACAL /A042 -2 /PASS 2 ARGUMENTS /M054 CPYMS2 /"..© STOPPED /M054 2500 /POSITION AT LINE 25 /A054 IFDEF CANADA < 153 > /L.CFLX.E JMP COPY6 /GO CHECK SYS DSK & PROMPT GM - EXIT /A054 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE RECONA, XX /RECONSTRUCT THE ALLOCATION BLOCK. FORCE NEW IMAGE TO /M054 /BE DATA EVEN IF SOURCE WAS SYSTEM. /M054 JMS TAKSYS /BLOCKS 0,1,2,6,377 = SYSTEM FILE #377 /M054 /IN THE BLOCK LIST STATUS WORDS. DF=LST /A054 TAD (ABLKBF-1) /ZERO THE ALLOCATION BUFFER DCA AIR17 /USING AIR17 AS THE AUTO-INDEX POINTER /M054 TAD (400) /CLEAR A BLOCK SIZED AREA /M054 CDFBUF /POINT AT THE BUFFER FIELD /A054 JMS I IZERO /GO CLEAR ABLKBF+0 -> 377 /M054 JMS SWPDRV /MAKE (DRIVE)=(CPYDRV) /A054 JMS GDENS /GET THE DENSITY CODE TO AC. RET DF=MYF /A054 TAD (-4 /COMPARE TO 4 /A054 SPA CLA /OK IF 4 OR MORE /A054 JMP RXRCA /ELSE, NOT DOING RD50 /A054 CDFBUF /POINT AT THE BUFFER FIELD /A054 TAD I (CVOLBU+17 /CHECK THE HI BYTE OF BLOCK COUNT /A054 SZA CLA /OK IF 0 /A054 JMP SET2K /ELSE GO SET 2000 BLOCK MAXIMUM /A054 TAD I (CVOLBU+16 /GET THE LOW BYTE OF THE BLOCK COUNT /A054 TAD (-176 /175 IS THE MAXIMUM LEGAL VALUE FOR V2.0/A054 SMA CLA /SO MINUS RESULTS ARE GOOD /A054 JMP SET2K /ELSE GO SET 2000 BLOCK MAXIMUM /A054 TAD I (CVOLBU+16 /GET THE LOW BYTE OF THE BLOCK COUNT /A054 CLL RTL /CLEAR THE LINK & MULTIPLY BY FOUR /A054 RTL /TWICE TO GET ACTUAL BLOCK COUNT /A054 DCA DSKSIZ /THAT'S THE NEW BLOCK COUNT /A054 JMP SETCNT /GO USE IT TO SET DERIVATIVE COUNTS /A054 SET2K, TAD (3720 /GET 2000 DECIMAL - THE V2.0 MAX /A054 DCA DSKSIZ /THAT'S THE NEW BLOCK COUNT /A054 SETCNT, TAD DSKSIZ /GET THE # OF BLOCKS IN THE IMAGE /A054 TAD (-1440 /IF ITS 800 BLOCKS /A054 SZA CLA /MAKE IT LOOK LIKE AN RX50 /A054 JMP SETCB /ELSE CONTINUE SET UP AS IS /A054 TAD (1420 /MAKE IT 784 BLOCKS LIKE AN RX50 /A054 DCA DSKSIZ /MAKE THAT THE IMAGE SIZE /A054 SETCB, TAD DSKSIZ /GET THE # OF BLOCKS IN THE IMAGE /A054 CIA /NEGATE IT /A054 DCA DSKIDX /USE IT AS A COUNTER VALUE /A054 TAD DSKSIZ /GET THE # OF BLOCKS IN THE IMAGE /A054 CLL RTR /CLEAR THE LINK & DIVIDE BY 4 AND /A054 CLL RAR /DIVIDE AGAIN BY 2 FOR A TOTAL OF 8 /A054 IAC /ADD 1 FOR REVERSE COMPATABILITY /A054 DCA ALCCNT /THAT'S THE NEW ALLOCATION WORD COUNT /A054 RXRCA, CDFMYF TAD DSKSIZ /GET THE MAX BLOCK NUMBER IN THE IMAGE /M054 TAD (-5 /SUBTRACT THE 5 SYSTEM BLOCKS /M054 DCA ALODSZ /(ALODSZ)=(DSKSIZ)-5=BLOCKS AVAILABLE /M054 TAD ALCCNT /GET THE CALCULATED ALLOCATION WORD COUNT/M054 CIA /NEGATE IT TO MAKE A 'TO-GO' COUNT /M054 DCA ALOCNT /(ALOCNT)=-(ALCCNT). ALLOCATION WORD COUNT/M054 TAD (ABLKBF-1) / DCA AIR17 /AIR17 IS THE POINTER INTO ABLKBF /M054 TAD (-ALOWRD) /MOVE IN FORMAT DATA - 5 WORDS /M054 DCA REG10 /REG10 IS THE WORD COUNTER FOR MOVFLD /M054 TAD (ALODAT-1) /FROM HERE JMS MOVFLD /(AIR16)=(AC) THEN COPIES (REG10) WORDS /M054 /FROM +((AIR16)) MYF TO +((AIR17)) BUF. /M054 /RETURN DF=BUF /A054 DCA FRECNT /0 THE FREE BLOCK COUNTER /M054 TAD (BLKLST-1) DCA AIR10 /AIR10 IS THE BLOCK LIST POINTER /M054 DCA AIR12 /CLEAR AIR12 TO USE AS THE BLOCK COUNTER/M054 ALOLP2, TAD (20) /SET SHIFT MARK ALOLP1, DCA AIR11 /SAVE SHIFT REG /M043 TAD AIR12 /GET THE CURRENT BLOCK COUNT /M054 TAD DSKIDX /COMPARE IT TO THE -MAXIMUM COUNT /M054 SMA CLA /IF IT WAS EQUAL /M054 JMP ALODNE /THEN GO FINISH UP /M054 ISZ AIR12 /ELSE, INCREMENT THE BLOCK COUNT /M054 CLL /CLEAR THE FREE FLAG /M054 CDFLST /POINT AT THE LIST FIELD /A054 TAD I AIR10 /GET BLOCK STATUS WORD /M043 AND P377 /GET JUST THE FILE# /C054 SNA CLA /IF THERE'S A FILE#, THE BLOCK IS USED /M054 STL /IF NOT USED, SET THE FREE FLAG /M054 SZL /IF NOT FREE, DON'T UP THE FREE COUNT /M054 ISZ FRECNT /IF FREE, THEN COUNT THE FREE BLOCK /M054 TAD AIR11 /GET THE SHIFT REGISTER /M054 RAL /SHIFT THE LATEST FLAG INTO BIT 11 /M054 SNL /DID THE SHIFT MARK REACH US? /M054 JMP ALOLP1 /IF NOT, CONTINUE THE INNER LOOP /M054 CDFBUF /ELSE, POINT BACK AT THE BUFFER FIELD /A054 DCA I AIR17 /SAVE THE ASSEMBLED WORD IN ABLKBF /M054 JMP ALOLP2 /START A NEW ALLOCATION WORD /M054 ALODNE, CDFBUF /ALL BLOCKS DONE TAD DENFLG /GET THE VERIFY DEVICE'S DENSITY /M054 SNA CLA /IF AN RX01 /M054 JMP FREPUT /THEN GO WRITE THE FREE COUNT TO ABLKBF /M054 TAD AIR11 /ALL OTHERS, GET THE SHIFT WORD REGISTER/M054 ALDNLP, RAL /ROTATE IT /M054 SNL /--UNTIL THE MARK IS IN THE LINK /M054 JMP ALDNLP /CONTINUE THE ROTATION /M054 DCA I AIR17 /THEN STORE THE LAST ALLOCATION WORD /M054 FREPUT, TAD FRECNT /GET THE COUNT OF FREE BLOCKS /M054 DCA I (ABLKBF+3 /ENTER IT IN THE ALLOCATION BLOCK /A054 JMP I RECONA /RETURN. DF=BUF FNC=. /FIRST NON-CODE LOCATION /A042 PAGE ALOWRT, XX /WRITES OUT ALLOCATION BUFFER & FIXES BLOCK 6 TO DATA BOOT CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX /WRITE OUT NEW ALLOCATION BLOCK /M054 RXEWT+4000+2000 377 ABLKBF NOP /ERROR RETURN, NO HANDLING PROVIDED /A050 BLOCK6, CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX /OK RETURN, GO READ IN LAST BOOT BLOCK /C050 RXERD+4000 6 VBLKBF NOP /ERROR RETURN, NO HANDLING PROVIDED /A050 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 TAD (VBLKBF-1) /POINT TO WRD 0-1 DCA AIR17 /M043 TAD (5601) /@4400 JMP I .+1 DCA I AIR17 /M043 TAD (4600) /@4401 4600 DCA I AIR17 /MUST HAVE WANTED IT IN THE BUFFER VICE AIR17 /D054 DCA AIR17 /M043 JMS I IQURX /NOW A DATA DISC BOOT, REWRITE BOOT BLOCK /C042 RXEWT+4000+2000 6 VBLKBF NOP /ERROR RETURN, NO HANDLING PROVIDED /A050 JMP I ALOWRT /EXIT. DF=MYF /M054 ALODAT, -377 /FOR ALLO BLOCK REBUILD 40 /ALLO TYPE ALODSZ, 1163 /632(10)MAX AVAILABLE 0 ALOCNT, -120 /-80(10) WORDS USED ALOWRD=.-ALODAT IORBLK, XX /(BLKLST+(SBLKNO))=(BLKLST+(SBLKNO)) IOR (AC). UTILITY /M054 MQL /SAVE THE BITS TO IOR /M054 CDFLST /GET TO THE XXXLST FIELD /M054 TAD (BLKLST) /GET THE BLOCK LIST BASE /M054 TAD SBLKNO /ADD (SBLKNO) AS OFFSET /M054 DCA REG10 /USE REG10 AS THE POINTER /M054 TAD I REG10 /GET THE STATUS WORD /A054 MQA /OR IN THE BIT(S) /M054 DCA I REG10 /WRITE BACK THE UPDATED STATUS WORD /M054 JMP I IORBLK /DF=LST /M054 CLR1, XX /ACBAR&((SBLKNO)+BLKLST)->(BLKLST+(SBLKNO)) MQL CDFLST /POINT AT THE LIST FIELD /A054 TAD (BLKLST) TAD SBLKNO DCA REG10 MQA CMA AND I REG10 DCA I REG10 JMP I CLR1 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE READIN, XX /READ TO BUFFER IN AC, BLOCK # (BLKIN) FROM VERIFY DEVICE/M054 DCA RXBF /SAVE BUFFER ADDR JMS RTDRV /GO GET THE FROM DRIVE NUMBER /A027 TAD BLKIN /INPUT BLOCK NUMBER DCA RXSEC CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX RXERD+4000 RXSEC, 0 RXBF, 0 JMP CPYEX4 /ERROR RETURN, MAKE UNREADABLE /C050 CDFBUF /OK RETURN, DATA FIELD=BUF /A050 JMP I READIN WRITE0, XX /WRITE A SECTOR TO THE COPY DEVICE FROM THE BUFFER WHOSE/A055 /ADDRESS IS IN THE AC TO BLOCK # (BLKOUT) /A055 DCA WRXBF /PUT THE BUFFER ADDRESS IN RXHAN CONTROL BLOCK/M054 JMS SWPDRV /GO GET THE DRIVE NBR TO COPY TO /A027 TAD BLKOUT DCA WRXSEC /BLOCK ADDRESS /M054 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX RXEWT+6000 WRXSEC, 0 WRXBF, 0 JMS BADDSC /ERROR RETURN, BAD OUTPUT /C050 CDFBUF /OK RETURN, DATA FIELD=BUF /A050 JMP I WRITE0 /RETURN TO CALLER /C050 TEST1, XX /(BLKLST+(SBLKNO))&AC->AC IN LIST FIELD /M054 MQL CDFLST /POINT AT THE LIST DATA FIELD /A054 TAD (BLKLST) TAD SBLKNO DCA REG10 MQA AND I REG10 JMP I TEST1 TEST2, XX /(AC)=(TYPLST+(SBLKNO)) AND (AC) ON CALL /M054 MQL CDFLST /POINT AT THE LIST DATA FIELD /A054 TAD (TYPLST) TAD SBLKNO DCA REG10 MQA AND I REG10 JMP I TEST2 IORTYP, XX /OR (AC) INTO TYPLST STATUS WORD. PART OF VEBLKS /M056 MQL /(MQ)=(AC) /M056 TAD (TYPLST /GET THE BASE OF THE TYPE LIST /A056 TAD SBLKNO /GET THE NUMBER OF THE BLOCK UNDER TEST /A056 /D056 TAD VBLKPT /PTR IN LIST1 /D056 TAD (TYPLST-BLKLST) /OFFSET TO LST 2 DCA REG10 /WORKING ADDR CDFLST /POINT AT THE LIST FIELD /A054 TAD I REG10 /OLD WORD MQA /OR IN BITS DCA I REG10 /RESTORE JMP I IORTYP CPYUPD, XX /UPDATE PASSED MESSAGE EVERY TENTH CALL /M054 CDFMYF /A054 TAD I CPYUPD /GET CAPTION TO BE DISPLAYED /A033 DCA CPYUPM /PUT IT WHERE IT CAN BE DISPLAYED /A033 ISZ CPYUPD /BUMP UP TO RETURN ADDRESS /A033 ISZ AIR13 /TIME OUT /M043 JMP I CPYUPD /NO -EXIT TAD (-12) /TIMER RESET VALUE DCA AIR13 /M043 JMS I IOASET /CALL IOACAL /A042 -3 /NUMBER OF ARGUMENTS TO PASS /A042 CPYUPM, CPYMSG /^P!L !D &DOCUMENTS &COPIED /C049 2400 /CURSOR POSITION AND ERASE TO EOL /C054 BLKNO /NUMBER OF BLOCKS COPIED JMS HLTCHK /GO SEE IF HALT FLAG SET. RET DF=MYF /M054 JMP CPYABT /IT HAS BEEN SET /A027 JMP I CPYUPD /NO -EXIT FIXLOC, COSCNT 230 /VERSION /TYPE WORD /FIXED / /NAME TO BE PUT TO DISC 4752 /FI 7146 /XE 4500 /D ....ALL IN WPS CODES 143 /ASSIGN DISKETTE NUMBER "99" /C050 377 /ALLOCATION BLOCK NUMBER IS 255 /C050 0 /NO DATE 0 -310 /-200 POTENTIAL DOCUMENTS /C050 FIXWRD=.-FIXLOC FNC=. /FIRST NON-CODE LOCATION /A042 PAGE COPYMS, /RESOLVE THE "COPY TO" DEVICE TYPE FEED IT BACK TO THE USER, /A054 /PROMPT FOR ACTION. PART OF ASKNBR /A054 TAD CPYDRV /GET THE "COPY TO" NUMBER /A049 JMS RESDEV /FIND OUT THE TYPE /A049 JMP VCPDRV /ITS DISKETTE, GO SET UP FOR IT /A049 IFNDEF ITALIAN < TAD (CPYMSB /"WINNY" RETURN, SO GET CPYMSB ADDRESS /A049 DCA GODEF /AND INSERT IT AS THE POINTER IN DSPDRV /A049 TAD (ISVOL /ELSE, GET "VOLUME" LABEL /A049 DCA VCMED /STORE THE LABEL IN THE PAGE0 POINTER /A049 TAD (ISDEV /GET "DEVICE" LABEL /A049 DCA VCDEV /STORE THE LABEL IN THE PAGE0 POINTER /A049 JMP COPYGO /GO ON WITH THE COPY MESSAGES /A049 > VCPDRV, TAD (CPYMSA /DISKETTE, SO GET CPYMSA ADDRESS /A049 DCA GODEF /AND INSERT IT AS THE POINTER IN DSPDRV /A049 TAD (ISDSKT /GET "DISKETTE" LABEL /A049 DCA VCMED /STORE THE LABEL IN THE PAGE0 POINTER /A049 TAD (ISDRVE /GET "DRIVE" LABEL /A049 DCA VCDEV /STORE THE LABEL IN THE PAGE0 POINTER /A049 COPYGO, TAD CPYDRV /GET THE COPY-TO DRIVE NUMBER /M054 SZA CLA /IF 0, ASK TO REMOVE SYSTEM DISKETTE /A027 JMP ASKDRV /GO ASK FOR DRIVE ONLY /A027 JMS I IOASET /CALL IOACAL /A042 -5 /NUMBER OF ARGUMENTS TO PASS /C045 CPYMS1 /"REMOVE SYSTEM ^S FROM ^S ^D" /C049 2400 /CURSOR POSITION /A027 IFNDEF ITALIAN < ISDSKT /INSERT "DISKETTE" IN THE MESSAGE /A045 ISDRVE /INSERT "DRIVE" IN THE MESSAGE /A045 > CPYDRV /DRIVE/DEVICE TO COPY TO (ZERO HERE) /A042 ASKDRV, JMS I IOASET /CALL IOACAL /A042 -5 /NUMBER OF ARGUMENTS TO PASS /C045 GODEF, 0 /CPYMSA:"PLACE !S TO REC THE COPY IN !S !D/C049 /OR CPYMSB:"THE !S IN !S !D WILL REC THE COPY"/A049 2500 /CURSOR POSITION /C045 IFNDEF ITALIAN < VCMED /"DISKETTE" OR "VOLUME" /A049 VCDEV /"DRIVE" OR "DEVICE" /A049 > CPYDRV /DRIVE NUMBER TO BE DISPLAYED /A042 JMS SETMS1 /SET UP "WHEN READY .... PROMPT /A049 CPYMS5 /PRINT "THIS !S WILL BE OVERWRITTEN" /A049 VCMED /"DISKETTE" OR "VOLUME" /A049 NOP /NULL ARGUMENT /A049 JMS CHKINS /GO SEE IF THERE'S A DISKETTE MOUNTED /A054 CHKINS, XX /HERE TO CHECK FOR PRESENCE OF DISKETTE?????? /M054 JMS SWPDRV /GET THE COPY TO DRIVE INTO (DRIVE) /A052 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX /DO A GET DENSITY /A052 RXEDN+4000 /A052 0 /A052 VBLKBF /A052 JMP VUNAC /ERROR RETURN, GO REPORT TO USER /A054 JMP CHKIOK /ELSE OK, PRESS ON /A054 VUNAC, JMS I IOASET /CALL IOACAL /A054 -4 /NUMBER OF ARGUMENTS TO PASS /A054 CPYMS8 /"UNABLE TO ACCESS ^S IN !D /A054 1505 /A054 ISDRVE /"DRIVE" /A054 CPYDRV /DRIVE NUMBER /A054 JMS I IOASET /CALL IOACAL /A054 -6 /NUMBER OF ARGUMENTS TO PASS /A054 CPYMS9 /"CHECK THAT THE ^S EXISTS," /A054 1705 /AND A ^S IS PROPERLY INSERTED.^P^S" /A054 ISDRVE /"DRIVE" ADDRESS /A054 ISDSKT /"DISKETTE" ADDRESS /A054 2705 / /A054 TRYAGN /" TRY AGAIN." /A054 JMP REASK /GO LET 'EM TRY AGAIN /A054 /FROM INSIDE ASKNBR /A054 CHKIOK, JMS GDENS /GO GET ITS DENSITY /M054 MQL /SAVE DESTINATION DENSITY IN MQ /A042 MQA /AND COPY IT BACK TO AC /A042 CIA /NEGATE IT /M054 TAD DENFLG /COMPARE TO THE 'VERIFY' DEVICE DENSITY /M054 SNA CLA /OK WHEN DENSITIES ARE EQUAL /A042 JMP SETDR0 /IF OK, RETURN /A042 MQA /ELSE TEST FOR LEGAL COMBINATION /A042 TAD DENFLG /OF UNEQUAL DENSITY CODES /A042 TAD (-5 /COMBINATIONS OF 5 & UP ARE OK /A042 SMA CLA /SO ON LESS THAN 5 INFORM USER /A054 JMP SETDR0 /GOOD RESULT, SO GO DETERMINE DEVICE 0 /A054 JMS SETMS1 /SET UP 'WHEN READY....PROMPT /A054 CRSHM2 /'DENSITIES OF BOTH ^S MUST BE EQUAL.^S'/A054 ISDSKT /'DISKETTE' /A054 TRYAGN /' TRY AGAIN' /A054 JMP REASK /INVITE RETRY /A054 SETDR0, TAD CPYDRV /GET THE "COPY TO" DRIVE NUMBER /A048 SNA CLA /IF ITS NOT 0, MAKE CPDRV0 A 0 /A048 AC0001 /ELSE MAKE IT A 1 /A048 DCA CPDRV0 /STORE FOR LATER TEST IN NODENS /A048 JMS I IOASET /CALL IOACAL /A049 -2 /NUMBER OF ARGUMENTS TO PASS /A049 PSCR /^P!E/..POSITION AND ERASE TO EOS /A049 2000 /FROM THE START OF LINE 20 /A049 JMP ASKXIT /RETURN TO MAIN LINE IN ASKNBR /A054 ERMSG, XX /NOTIFY USER OF ERRORS & PROMPT FOR ACTION /A054 JMS SETMS3 /SET "TO DO THIS --- /C042 VSCRNM /"^P&YOUR !S HAS ERRORS, TO CORRECT /C049 /THEM YOU MUST COPY THE !S. /C049 VMED /"DISKETTE" OR "VOLUME" /A049 VMED /"DISKETTE" OR "VOLUME" /A049 /WAIT FOR RESPONSE /A054 JMS I IOASET /CLEAR THE SCREEN & PUT UP THE HEADER /M054 -4 /NUMBER OF ARGUMENTS TO PASS /A042 VSCRN1 /"VERIFY (ARG) UTILITY" /C042 0 /CURSOR POSITION FOR ERASE /C049 24 /CURSOR POSITION FOR HEADER /C049 VMED /"DISKETTE" OR "VOLUME" /A049 JMP I ERMSG /RETURN /A054 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE COPYFL, XX /COPY FILES FROM SOURCE TO DESTINATION. 1ST LEVEL SUBR. /M056 JMS RECONA /REBUILD THE ALLOCATION BLOCK /C049 JMS RECONH /REBUILD THE HOME BLOCK /C049 JMS ZDATA /CLEAR VBLKBF FOR WRITING ALL 0 TO OUTPUT/A055 DCA SBLKNO /START WITH BLOCK 0 /A055 AC7777 /USE MINUS 1 TO FORCE /A055 DCA AIR13 /THE BLOCK 0 DISPLAY /A055 INOLP, TAD DSKIDX /GET THE MINUS MAX COUNT /A055 TAD SBLKNO /ADD THE CURRENT BLOCK NUMBER /A055 SMA CLA /OK WHILE RESULTS ARE MINUS OR EQUAL /A055 JMP CPINIT /WHEN IT GOES PLUS THE OUTPUT IS ALL 0 /A055 JMS DSPMSG /DISPLAY 'CHECKING BLOCK NUMBER XXX' /A055 TAD SBLKNO /GET BACK THE CURRENT BLOCK /A055 DCA BLKOUT /PASS IT AS THE BLOCK NUMBER /A055 TAD (VBLKBF /GET THE BUFFER ADDRESS TO PASS ALONG /A055 JMS WRITE0 /CALL THE WRITE SUBROUTINE. RET DF=BUF /A055 ISZ SBLKNO /UPDATE THE BLOCK UNDER TEST /A055 JMP INOLP /CONTINUE THE LOOP /A055 CPINIT, AC7777 /USE MINUS 1 /A055 DCA AIR13 /TO FORCE /A055 JMS DSPMSG /TERMINAL COUNT DISPLAY /A055 CDFBUF /WORKING IN THE BUFFER FIELD /A055 TAD (HBLKBF-1 /LOAD START OF HOME BLOCK BUFFER -1 /A055 DCA AIR17 /INTO AIR 17 /A055 TAD (HBBUF2-1 /LOAD START OF 2ND HOME BLOCK BUFFER -1 /A055 DCA AIR16 /INTO AIR 16 /A055 TAD (-377 /LOAD A BLOCK COUNT /A055 DCA T1 /INTO T1 AS THE 'TO GO' COUNT /A055 HBMOV, TAD I AIR17 /GET A HOME BLOCK WORD /A055 DCA I AIR16 /PUT IT IN THE 2ND HOME BLOCK BUFFER /A055 ISZ T1 /REDUCE & TEST THE 'TO GO' COUNT /A055 JMP HBMOV /CONTINUE THE LOOP UNTIL T1 IS ZERO /A055 TAD (HBBUF2+11 /LOAD START -1 /A055 DCA AIR17 /INTO AIR17 /A055 TAD (-310 /LOAD -200 AS THE COUNT TO GO /A055 DCA T1 /IN T1 /A055 ZHLP, DCA I AIR17 /ZERO THE FILE LIST ENTRY IN HBLKBF /A055 ISZ T1 /REDUCE THE COUNT TO GO... /A055 JMP ZHLP /UNTIL 0, CONTINUE TO ZERO THE LIST /A055 JMS SWPDRV /GO MAKE (DRIVE)=(CPYDRV) /A055 /D056 CDFBUF /POINT AT THE BUFFER DATA FIELD /A055 JMS I IQURX /WRITE OUT CLEARED HOME BLOCK /A055 RXEWT+4000+2000 /VERIFY THE WRITE /A055 2 /HOME BLOCK IS TWO /A055 HBLKBF /FROM THE HOME BLOCK BUFFER /A055 JMS BADDSC /ON WRITE ERROR, GO TELL /A055 TAD (ABLKBF+4 /LOAD THE START -1 /A055 DCA AIR17 /INTO AIR17 /A055 TAD ALOCNT /GET THE 2S COMPLEMENT ALLO WORD COUNT /A055 DCA T2 /USE T2 AS THE 'TO GO' COUNT /A055 CDFBUF /GET BACK INTO THE BUFFER FIELD /A055 INALLP, DCA I AIR17 /WRITE EACH ALLO WORD TO 'NONE FREE' /A055 ISZ T2 /DECREMENT & TEST THE COUNT TO GO /A055 JMP INALLP /UNTIL THE COUNT IS DONE, CONTINUE /A055 AC0001 /GET A ONE /A055 DCA I (ABLKBF+3 /SET THE FREE BLOCK COUNT TO ONE /A055 JMS I IQURX /WRITE OUT FILLED ALLOCATION BLOCK /A055 RXEWT+4000+2000 /VERIFY THE WRITE /A055 377 /ALLOCATION BLOCK IS 255 /A055 ABLKBF /FROM THE ALLOCATION BLOCK BUFFER /A055 JMS BADDSC /WRITE ERROR? /A055 JMS RECONH /REBUILD HOME AGAIN FOR COPYING /A055 TAD (HBLKBF+11) /SET UP POINTERS DCA HOMPTR /(HOMPTR)=HBLKBF+11 /M054 TAD (-310) DCA HOMCNT /(HOMCNT)=-310 /M054 DCA FILENO /(FILENO)=0 /M054 DCA FILCNT /(FILCNT)=0 /A054 DCA BLKOUT /(BLKOUT)=0 /A055 CPYIFN, /LOOP POINT FOR CPYEND. /M056 ISZ FILENO /COUNT IT ISZ HOMPTR /& POINT TO IT TAD BLKOUT /GET THE CURRENT OUTPUT BLOCK NUMBER /A056 DCA SAVBLK /SAVE IT FOR POSSIBLE RESTORATION /A056 /D056 JMS CKFBAD /IF MARKED BAD IN DOCLST, GO TO CPYEND /A055 /D056CKFBAD, XX /PART OF CPYIFN - NOT ENOUGH ROOM THERE RIGHT NOW /A055 JMS DOCGET /(AC)=(F4+DOCLST+(FILENO)) /A055 AND (4000 /SEE IF THIS FILE IS NOT TO BE COPIED /C056 /D056 SNA CLA /IF SO, DON'T COPY IT /M056 /D056 JMP I CKFBAD /ELSE RETURN FOR FURTHER CHECKS /A055 /D056 CDFBUF /GET BACK TO THE BUFFER FIELD /A055 /D056 DCA I HOMPTR /CLEAR THE HOME BLOCK FILE ENTRY /A055 /D056 JMP CPYEND /GO CHECK FOR MORE FILES /A055 SZA CLA /IF NOT MARKED, PRESS ON /A056 JMP CPYEX4 /ELSE, CLEAR FROM LIST, SKIP COPY /A056 CDFBUF TAD (HDR1BF-1) /CLEAR THE HEADER AREA DCA AIR17 /STARTING AT HDR1BF /M054 AC2000 /CLEAR ALL 4 HEADER BUFFERS /A055 JMS I IZERO /GO CLEAR (AC) WORDS @ +((AIR17)) IN DF SET/M054 /D056 DCA FLAG /CLEAR THE READ INHIBIT FLAG /M054 TAD I HOMPTR /GET THIS FILE'S HEADER BLOCK NUMBER /M054 SNA /IF THE NUMBER IS ZERO /M054 JMP CPYEND /GO CHECK FOR DONE /M054 /PROVE BLOCK TO BE PROPER HEADER BEFORE COPYING. DCA SBLKNO /THIS FILE'S HEADER BLOCK # IS THE OFFSET/M054 TAD (1000) /TEST FOR HEADER FLAG IN THE TYPE LIST /M054 JMS TEST2 /RETURN (AC)=1000 AND (TYPLST+(SBLKNO)). DF=LST SNA CLA /LOOKING FOR THE HEADER FLAG IN THE /M054 /TYPE LIST STATUS WORD /A054 JMP RHD2 /NOT HEADER, SO DELETE IT /M054 TAD P377 /IS HEADER, SO GET FILE NUMBER MASK /C054 JMS TEST2 /GET THE FILE # IN THE TYPE LIST /M054 CIA /COMPARE IT TO /M054 TAD FILENO /THE CURRENT HOME FILE # /M054 SNA CLA JMP RHD1 /EXIT RHD2, AC2000 /MARK AS UNREADABLE IN THE BLOCK LIST /M054 JMS IORBLK /STATUS WORD, FORCES DELETE LATER /M054 RHD1, TAD SBLKNO /RESTORE ENTRY ACC (REQUIRED) JMP CPY1 /CONTINUE ON NEXT PAGE /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE CPY1, JMS CHKHDR /VERIFY IT IN TYPE & BLOCK LISTS. RET DF=BUF TAD (HDR1BF) JMS READIN /READ IN HDR1. RET DF=BUF /M054 AC0001 /MASK FOR BIT 11 TO CHECK FOR /M054 AND I (HDR1BF+1) /PRESENCE OF RAPID PAGINATION /M054 SNA CLA /NO RP IF 0 /A039 DCA I (HDR1BF+53) /CLEAR THE RP POINTER TO INDICATE NOT PRESENT JMS CPYRPB /GO COPY GO TO PAGE BLOCKS IF PRESENT /M054 TAD I (HDR1BF+2 /GET THE BLOCK NUMBER OF THE FIRST /M054 /HEADER EXTENSION BLOCK /A054 SNA JMP CPYEX3 /IF 0 PASS TO NEXT PHASE JMS CHKHDR /VERIFY IT IN TYPE & BLOCK LISTS. RET DF=BUF TAD (HDR2BF) JMS READIN /READ IN THE FIRST HEADER EXTENSION BLOCK./M054 TAD I (HDR1BF+3 /GET THE BLOCK NUMBER OF THE SECOND EXTENSION. SNA /NONE PRESENT IF THE NUMBER IS ZERO /M054 JMP CPYEX3 /PASS IF 0 JMS CHKHDR /VERIFY IT IN TYPE & BLOCK LISTS. RET DF=BUF TAD (HDR3BF) / JMS READIN /READ IN THE SECOND HEADER EXTENSION BLOCK./M054 CPYEX3, AC7776 /A024 DCA EXTFLG /FIX SO EXT BLOCK #2 IS SHORTER /A024 TAD (HDR1BF+55) /POINT TO THE NUMBER OF THE FIRST DATA BLOCK DCA HDRPTR TAD (55-400) /# OF POINTERS IN FIRST BLOCK DCA T2 /USE T2 AS THE "POINTERS TO GO" COUNTER /M054 AC7775 /NUMBER OF HEADERS /A054 DCA T1 /T1 COUNTS HEADERS TO GO /M054 DCA DBLKCT /CLEAR THE DATA BLOCK COUNT FOR THIS FILE/A055 CPYHDL, CDFBUF /HEADER LOOP TO FIND ALL DATA BLOCKS TAD I HDRPTR /GET NEXT DATA BLOCK SNA JMP CPYHDN /IF 0 THE FILE IS DONE DCA SBLKNO TAD SBLKNO DCA BLKIN /SET THE INPUT ADDR AC2000 /SET A MASK TO CHECK READABILITY /A054 JMS TEST1 /PER THE BLOCK LIST STATUS WORD? RET DF=LST/M054 SZA CLA JMP CPYEX4 /IF 0 THEN OK TAD (5400) /SEE IF MARKED BAD, HEADER, OR GO-TO-PAGE./M056 JMS TEST2 /IN THE TYPE LIST STATUS WORD. RET DF=LST./M054 SNA CLA JMP CPYEX5 /IF 0 ITS OK AC7777 /ELSE, ITS ILLEGAL. SO, CLEAR ALL FLAGS /M054 JMS CLR1 /FROM THE BLOCK LIST STATUS WORD. RET DF=LST CPYEX4,/D056 ISZ FLAG /ELSE BAD, INHIBIT READ /D056 JMP CPYEX6 CPYEX6, TAD SAVBLK /GET THE SAVED BLKOUT VALUE /A056 DCA BLKOUT /RESTORE IT FOR THE NEXT FILE /A056 AC4000 /SET THE NOT COPIED BIT /C056 JMS DOCSET /IN THIS FILE'S DOCLST ENTRY /A055 CDFBUF /A055 DCA I HOMPTR /CLEAR THE HOME BLOCK ENTRY /A055 JMP CPYEND /GO LOOP OR TERMINATE /A055 CPYEX5, TAD (400) /IS IT MULTI USED JMS TEST1 /PER THE BLOCK LIST? RET DF=LST /M054 /D056 SNA CLA /D056 JMP CPYEX8 /NOT MULTI, SO PRESS ON /M054 SZA CLA /OK IF NOT MULTI /A056 JMP CPYEX4 /ON MULTI, GO REWIND AND DELETE /A056 /D056CPYEX8, AC4000 /PASS THE "FREE" FLAG TO CLR1 /M054 /D056 JMS CLR1 /CLEAR IT FROM THE BLOCK LIST STATUS WORD. DF=LST /D056 TAD FLAG /IS READ SUPRESSED? /D056 SNA CLA /IF <>0 THEN READ IS SUPPRESSED, SKIP /A054 CPYEX8, TAD (VBLKBF /PASS THE BUFFER ADDRESS TO READIN /A056 JMS READIN /ELSE, READ THE CURRENT BLOCK TO VBLKBF. RET DF=BUF JMS NXTOUT /GET THE NEXT AVAILABLE BLKOUT /A055 TAD (VBLKBF) JMS WRITE0 /PUT IT OUT. RET DF=BUF. /M054 TAD BLKOUT /GET THE BLOCK # WE JUST WROTE OUT /A055 DCA I HDRPTR /PUT IT IN THIS HEADER'S BLOCK LIST /A055 ISZ DBLKCT /INCREMENT THE DATA BLOCK COUNT /A055 ISZ HDRPTR /STEP TO NEXT DATA BLOCK IN HDR /M055 ISZ T2 JMP CPYHDL /LOOP TILL END OF BLOCK ISZ XTNFLG /CHECK FOR EXT HDR MODE /A024 SKP JMP CPYEXT ISZ HDRPTR /END OF BLOCK, STEP OVER OVERHEAD WORDS ISZ HDRPTR /A021 ISZ EXTFLG /2ND EXT BLOCK IS SHORTER DUE TO EXTRA HDR EXT PTRS /A024 SKP /A024 TAD (16 /A024 TAD (-376) DCA T2 /BLOCK POINTER COUNT RESET ISZ T1 JMP CPYHDL /LOOP TILL END OF HDRS /HERE ONLY IF NO TERMINATER IN HDR /WHICH MEANS LOOK FOR EXT HDR BLOCK /A024 JMP CP14EX /GO CHECK EXTENSION HEADERS.. NEXT PAGE /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE /THIS SECTION MAKES USE OF THE 14 EXT HDR BLOCK PTRS AT END OF EXT BLOCK #2 CP14EX, AC7776 TAD HDRPTR DCA EXTPTR JMP CPYXTN /DON'T WRITE YET! THIS IS FIRST EXT BLOCK CPYEXT, JMS HDRWRT /WRITE OUT LAST HEADER BLOCK. RET DF=BUF/M056 CPYXTN,/D056 CDFBUF /READ NEXT EXT BLOCK POINTER TAD I EXTPTR /READ NEXT EXT BLOCK POINTER. /M056 /D056 CDFMYF SNA /LOOK FOR TERMINATOR JMP CPYHDN /ALL DONE! NO MORE HDR BLOCKS DCA BLKIN TAD (HDR4BF /READ NEXT EXT HDR BLOCK INTO CORE JMS READIN /AT HDR4BF. RET DF=BUF /M054 TAD (HDR4BF+2 DCA HDRPTR TAD (-376 DCA T2 AC7777 DCA XTNFLG JMP CPYHDL CPYHDN, ISZ XTNFLG /IF WE ARE IN EXT HDR MODE... SKP JMS HDRWRT /WRITE OUT LAST HDR EXT BLOCK. RET DF=BUF/M056 CLA CLL DCA XTNFLG /CLEAR EXT HDR BLOCK MODE /M054 /D056 CDFBUF TAD I (HDR1BF+2 /SEE IF THERE WAS A 2ND HEADER /M056 SNA /IF NOT /M056 JMP CPWHD1 /GO WRITE OUT THE FIRST HEADER & REPORT /A055 JMS NXTOUT /GET THE NEXT AVAILABLE BLKOUT /A055 TAD BLKOUT /GET THAT BLOCK NUMBER /A056 DCA I (HDR1BF+2 /PUT IT IN THE MAIN HEADER /A056 TAD (HDR2BF) /POINT AT THE BUFFER WITH THE 2ND HEADER/M056 JMS WRITE0 /WRITE OUT THE 2ND HEADER RETURN DF=BUF /M056 TAD I (HDR1BF+3 /SEE IF THERE WAS A 3RD HEADER /M056 SNA /IF NOT /M056 JMP CPWHD1 /GO WRITE OUT THE FIRST HEADER & REPORT /A055 JMS NXTOUT /GET THE NEXT AVAILABLE BLKOUT /A055 TAD BLKOUT /GET THAT BLOCK NUMBER /A056 DCA I (HDR1BF+3 /PUT IT IN THE MAIN HEADER /A056 TAD (HDR3BF) /POINT AT THE BUFFER WITH THE 3RD HEADER/M056 JMS WRITE0 /WRITE IT OUT. RET DF=BUF /M056 CPWHD1, TAD DBLKCT /GET THE COUNT OF DATA BLOCKS /A055 DCA I (HDR1BF+5 /PUT IT IN THE HEADER BLOCK BUFFER /A055 JMS NXTOUT /GET THE NEXT AVAILABLE BLKOUT /A055 TAD (HDR1BF) JMS WRITE0 /WRITE IT OUT. RET DF=BUF /M056 TAD (HBBUF2+11 /GET THE ADDRESS OF THE FILE LIST IN BUF 2 TAD FILENO /ADD THE CURRENT FILE NUMBER /A055 DCA T3 /USE T3 AS THE INDIRECT POINTER /A055 TAD BLKOUT /GET THE HEADER BLOCK NUMBER /A055 DCA I T3 /PUT IT IN THE HOME BLOCK BUF 2 FILE LIST/A055 TAD BLKOUT /GET THE CURRENT OUTPUT BLOCK NUMBER /A055 DCA T3 /SAVE IT IN T3 FOR RESTORATION /A055 AC0002 /GET A 2 FOR THE RUNNING HOME OUTPUT /A055 DCA BLKOUT /THAT'S THE OUTPUT BLOCK NUMBER /A055 TAD (HBBUF2 /GET THE ADDRESS OF THE OUTPUT BUFFER /A055 JMS WRITE0 /WRITE OUT THE CURRENT HOME BLOCK.RET DF=BUF TAD T3 /GET BACK THE RUNNING OUTPUT BLOCK # /A055 DCA BLKOUT /RESTORE BLKOUT FOR FURTHER USE /A055 ISZ FILCNT /COUNT FILES COPYIED TAD FILCNT DCA BLKNO AC7777 /FORCE DISPLAY ON EACH CALL WITH -1 /M054 DCA AIR13 /IN AIR13 JMS CPYUPD /CALL FOR COPY UPDATE /M054 CPYMSG /"# DOCUMENTS COPIED /M054 CPYEND, ISZ HOMCNT JMP CPYIFN /LOOP TILL ALL FILES POSSIBLE ARE CHECKED JMP CONA /GO CONSTRUCT A NEW ALLOCATION BLOCK /A055 HDRWRT, XX /DF=BUF ON CALL /M055 TAD EXTPTR /WRITE OUT PREVIOUS HDR BLOCK DCA T2 TAD (HDR4BF DCA RPBPTR JMS WRTEXT /WRITE OUT THE EXTENSION. RET DF=BUF /A056 /TD056 CDFLST /POINT AT THE LIST FIELD /A054 /TD056 JMS RPGWRT /TD056 CDFMYF ISZ EXTPTR /BUMP TO NEXT EXT BLOCK JMP I HDRWRT /RETURN TO CALLER. RET DF=BUF /A055 JMP CPYHDN /HERE IF LAST BLOCK EXCEEDED /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE CONA, DCA SBLKNO /START AT THE BEGINNING /A055 CONALP, ISZ SBLKNO /GET THE NEXT BLOCK NUMBER /A055 TAD SBLKNO /GET IT TO COMPARE /A055 TAD DSKIDX /WITH THE MINUS MAX COUNT /A055 SMA SZA CLA /WHEN IT GOES PLUS /A055 JMP SCANDN /THEN THE ENTIRE BLOCK LIST IS DONE /A055 TAD BLKOUT /GET THE HIGHEST BUSY BLOCK /A055 CIA /NEGATE IT FOR COMPARISON /A055 TAD SBLKNO /WITH THE CURRENT BLOCK NUMBER /A055 SMA SZA CLA /WHEN ITS EXCEEDED /A055 JMP CONLPB /GO DO THE 'FREE' BLOCKS /A055 TAD (376 /GET A UNIQUE FILE NUMBER /A055 JMS IORBLK /MARK THE BLOCK LIST ENTRY /A055 JMP CONALP /CONTINUE THE LOOP /A055 CONLPB, AC7777 /SET ALL BITS TO CLEAR THEM /A055 JMS CLR1 /IN THE REMAINING BLOCK LIST ENTRIES /A055 JMP CONALP /CONTINUE THE LOOP /A055 SCANDN, JMS RECONA /REBUILD UPDATED ALLOCATION BLOCK /M054 JMS SWPDRV /GO GET DRIVE NBR WE'RE COPYING TO /A027 JMS ALOWRT /REWRITE NEW ALLOCATION BLOCK /M054 JMP DISTAT /GO DISPLAY STATISTICS & TERMINATE /A055 DISTAT, DCA LINENO /DISPLAY DOCUMENT STATUS TO THE USER /A055 /START WITH 0 AS THE OUTPUT LINE NUMBER /A055 TAD (DOCDL /"!P!EDOCUMENT #'S NOT COPIED:/ /A055 DCA STAHD /PASS IT TO THE STATMS SUBROUTINE /A055 AC4000 /SET THE 'DELETED' FLAG /C056 DCA T3 /PUT IT IN T3 FOR THE SEND NUMBER LOOP /A055 TAD (0033 /GET THE POST HEADER CURSOR POSITION /A055 DCA COLNO /PUT IT IN COLNO FOR POSITIONING /A055 JMS DISPLA /GO DISPLAY ANY & ALL DELETED FILES /A055 JMP COPY6 /GO CHECK SYS DSK & PROMPT FOR GOLD MENU/A055 / DISPLA, XX /SCAN THE DOCUMENT LIST -DOCLST- IN FIELD 4. IF ANY FILE/A055 /HAS THE PATTERN IN T3 SET, SEND THE PASSED HEADER AND ALL/A055 /MATCHING FILES. DCA TCOUNT /TCOUNT IS A FLAG FOR HEADER ENABLING /A055 AC0001 /START THE FILE CHECKING WITH A 1 /A055 DCA FILENO /FOR THE FILE NUMBER /A055 SNDLP, TAD (-311 /THIS IS THE ESCAPE LIMIT /A055 TAD FILENO /IF THE FILE NUMBER /A055 SMA CLA /IS LESS, KEEP CHECKING /A055 JMP I DISPLA /IF EQUAL OR MORE, THEN RETURN /A055 JMS DOCGET /GET THE DOCLST ENTRY FOR THIS FILENO /A055 AND T3 /CHECK AGAINST ANY BIT(S) IN T3 /A055 SNA CLA /IF ANY WAS SET GO SEND HEADER &/ NUMBER/A055 JMP NEXTNO /IF NONE WAS SET, GO TRY THE NEXT FILE# /A055 TAD TCOUNT /GET THE PASS COUNT /A055 SNA CLA /IF IT IS ZERO /A055 JMS STATMS /GO SEND THE HEADER MESSAGE /A055 JMS SNDNUM /SEND THE NUMBER IN ANY CASE /A055 NEXTNO, ISZ FILENO /BUMP TO THE NEXT FILE NUMBER /A055 JMP SNDLP /GO BACK TO THE START OF THE SEND LOOP /A055 SNDNUM, XX /SEND DECIMAL NUMBER WITH SEPARATING COMMA AS REQUIRED. /A054 TAD TCOUNT /GET THE PASS COUNTER /M055 SNA CLA /IF NOT ZERO, THEN SEND A COMMA /M054 JMP DCAPP /IF 1ST TIME NO COMMA JMS I IOASET /CALL IOACAL /A042 -1 /NUMBER OF ARGUMENTS TO PASS /A042 SNDCOM /, /..SEND A COMMA AND A SPACE /C055 ISZ COLNO /ADD THE COMMA TO THE COLUMN COUNT /A055 ISZ COLNO /UP THE COLUMN COUNT FOR THE SPACE /A055 DCAPP, ISZ TCOUNT /UPDATE THE PASS COUNTER /M054 TAD COLNO /CHECK THE COLUMN COUNT /A055 TAD (-77 /FOR 63 - IOA LIMITS THE COLUMN COUNT /A055 SPA CLA /PLUS MEANS 63 OR MORE /A055 JMP CKTC /NOT 63, GO SEND THE NUMBER /A055 TAD LINENO /GET THE CURRENT LINE NUMBER /A055 AND (7700 /MASK OUT THE COLUMN /A055 TAD (0100 /ADD A LINE /A055 DCA LINENO /THATS THE NEW CURSOR POSITION @ COL 0 /A055 DCA COLNO /0 THE COLUMN COUNT FOR THE NEW LINE /A055 CKTC, TAD LINENO /GET THE LAST CURSOR POSITION /A055 AND (7700 /MASK OUT THE COLUMN DATA /A055 TAD COLNO /GET THE NEW COLUMN DATA /A055 DCA LINENO /STORE THE UPDATED CURSOR POSITION /A055 JMS I IOASET /CALL IOACAL /A042 -3 /NUMBER OF ARGUMENTS TO PASS /A042 DECNUM /!P!D/ /C055 LINENO /LINE & COLUMN FOR CURSOR /A055 FILENO /FILENO IS WHERE THE NUMBER IS /A055 ISZ COLNO /UP THE COLUMN COUNT FOR A DIGIT /A055 TAD FILENO /GET THE NUMBER WE JUST DISPLAYED /A055 TAD (-12 /SEE IF IT WAS 10 OR MORE /A055 SMA CLA /IF LESS, SKIP THE INCREMENT /A055 ISZ COLNO /UP THE COLUMN COUNT FOR A DIGIT /A055 TAD FILENO /GET THE NUMBER WE JUST DISPLAYED /A055 TAD (-144 /SEE IF IT WAS 100 OR MORE /A055 SMA CLA /IF LESS, SKIP THE INCREMENT /A055 ISZ COLNO /UP THE COLUMN COUNT FOR A DIGIT /A055 JMP I SNDNUM /RETURN TO CALLER, RET DF=MYF /A055 STATMS, XX /SUBROUTINE TO OUTPUT THE STATUS MESSAGES WHEN THE COPY /A055 /OPERATION IS COMPLETED. PART OF DISTAT /A055 TAD LINENO /GET THE CURRENT LINE NUMBER /A055 AND (7700 /MASK OUT THE COLUMN /A055 TAD (0200 /ADD 2 LINES IN ORDER TO SKIP ONE /A055 DCA LINENO /POSITION AT THE NEW LINE & COLUMN 0 /A055 JMS I IOASET /CALL IOACAL /A055 -2 /WITH LABEL & POSITION ARGUMENTS /A055 STAHD, 0 /LABEL ADDRESS FOR THE STATUS HEADER /A055 LINENO /CURSOR POSITION /A055 JMP I STATMS /RETURN TO CALLER, DF=MYF /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE DOCSET, XX /SET THE ATTRIBUTE PATTERN IN THE AC INTO THE DOCUMENT /A055 /ATTRIBUTE WORD IN FIELD 4 AT DOCLST+(FILENO) /A055 /(F4+DOCLST+(FILENO))=(F4+DOCLST+(FILENO)) IOR (AC) /A055 MQL /SAVE THE BIT(S) TO SET /A055 TAD FILENO /GET THE CURRENT FILE NUMBER /A056 CIA SZA /TEST FOR FILE # 0 /A056 TAD (311 /AND AN UPPER LIMIT OF FILE # 310 /A056 SNA SPA CLA /IF 0 OR >310 /A056 JMP RDOCST /GO BACK WITHOUT MARKING ANYTHING /A056 CDFBUF /GET INTO THE BUFFER FIELD /M056 TAD (DOCLST /GET THE BASE OF THE DOCUMENT LIST /A055 TAD FILENO /ADD THE OFFSET INTO THE LIST /A055 DCA REG10 /USE REG10 AS THE POINTER INTO THE LIST /A055 TAD I REG10 /GET THE CURRENT ATTRIBUTES FOR THE FILE/A055 MQA /IOR THE NEW ATTRIBUTES /A055 DCA I REG10 /WRITE BACK THE UPDATED ATTRIBUTES /A055 CDFMYF /GET BACK TO THIS DATA FIELD /A055 RDOCST, JMP I DOCSET /RETURN TO THE CALLER. /A055 DOCGET, XX /GET THE ATTRIBUTE PATTERN IN FIELD 4 AT DOCLST+(FILENO)/A055 /(AC)=(F4+DOCLST+(FILENO)) /A055 CLA /ENSURE THAT THE AC IS CLEAR /A055 TAD FILENO /GET THE CURRENT FILE NUMBER /A056 CIA SZA /TEST FOR FILE # 0 /A056 TAD (311 /AND AN UPPER LIMIT OF FILE # 310 /A056 SNA SPA CLA /IF 0 OR >310 /A056 JMP RDOCGT /GO BACK WITHOUT GETTING ANYTHING /A056 CDFBUF /THE DATA WE WANT IS IN FIELD 4 /A055 TAD (DOCLST /GET THE BASE OF THE LIST /A055 TAD FILENO /ADD THE OFFSET INTO THE LIST /A055 DCA REG10 /USE REG10 AS THE POINTER INTO THE LIST /A055 TAD I REG10 /GET THE ATTRIBUTES FOR THE DOCUMENT /A055 CDFMYF /RETURN TO THIS DATA FIELD /A055 RDOCGT, JMP I DOCGET /RETURN TO THE CALLER /A055 VECRPB, XX /CHECK GO-TO-PAGE STRUCTURE OF DOCUMENT. PART OF VEHDR/VEFCHK /MARK THE GTP BLOCKS WITH THE CURRENT FILE #. /A056 TAD I (HDR1BF+53 /GET RPG BLOCK # IN AC /A056 DCA RPBNO /PASS THE BLOCK NUMBER TO RXHAN /A056 TAD RPBNO /GET IT BACK TO VALIDATE /A056 JMS CKRPB /VALIDATE THIS BLOCK. RET DF=BUF /A056 JMS I IQURX /CALL RXHAN /A056 RXERD+4000 /READ THE /A056 RPBNO, 0 /BLOCK UNDER TEST /A056 HDR4BF /TO BUFFER HDR4BF /A056 JMS ERRORS /READ ERROR ON THE RPG BLOCK /A056 CDFBUF /GET BACK INTO THE BUFFER FIELD /A056 TAD I (HDR4BF+2 /LOOK FOR EXTENSION BLOCKS /A056 SNA /NON ZERO MEANS THERE IS AT LEAST ONE /A056 JMP CRP3 /NONE FOUND, STOP LOOKING /A056 JMS CKRPB /VALIDATE THIS BLOCK. RET DF=BUF /A056 TAD I (HDR4BF+3 /LOOK FOR A 2ND EXTENSION BLOCK /A056 SNA /NON ZERO MEANS THERE IS ONE /A056 JMP CRP3 /NONE FOUND, SO STOP LOOKING /A056 DCA RPBNN /SAVE THE BLOCK # FOR QURX /A056 TAD RPBNN /GET THE BLOCK # BACK /A056 JMS CKRPB /VALIDATE THIS BLOCK. RET DF=BUF /A056 JMS I IQURX /CALL RXHAN /A056 RXERD+4000 /READ THE /A056 RPBNN, 0 /3RD GTP (2ND EXTENSION) BLOCK /A056 HDR4BF /TO BUFFER HDR4BF /A056 JMS ERRORS /READ ERROR ON THE GTP BLOCK /A056 CDFBUF /GET BACK TO THE BUFFER FIELD /A056 TAD (HDR4BF+361 /LOOK FOR MORE EXTENSIONS DCA AIR10 /USE AIR10 AS THE AUTO INCREMENT POINTER/A056 TAD (-16 /THERE ARE 14 POSSIBLE BLOCK POINTERS /A056 DCA T3 /USE T3 AS THE 'TO-GO' COUNTER /A056 CRP1, TAD I AIR10 /READ THE BLOCK POINTER WORD /A056 SNA /NON ZERO MEANS THERE IS A POINTER /A056 JMP CRP3 /ZERO MEANS THE LIST TERMINATED /A056 JMS CKRPB /VALIDATE THIS BLOCK. RET DF=BUF /A056 ISZ T3 /REDUCE THE 'TO-GO' COUNT /A056 JMP CRP1 /CONTINUE IN LOOP UNTIL DONE OR 0 FOUND /A056 CRP3, CDFBUF /GET BACK TO THE BUFFER FIELD /A056 JMP I VECRPB /RETURN TO VEHDR. /A056 CKRPB, XX /PART OF VECRPB. VALIDATE THE GTP BLOCK UNDER TEST. /A056 /THE GTP BLOCKS ARE MARKED IN TYPLST WITH 0400. /A056 DCA SBLKNO /SAVE THE NUMBER OF THE BLOCK UNDER TEST/A056 TAD SBLKNO /GET IT BACK /A056 TAD DSKIDX /COMPARE IT THE THE LARGEST POSSIBLE # /A056 SMA SZA CLA /OK WHEN LESS OR EQUAL /A056 JMP RPGERR /ELSE, GO REPORT AN ERROR /A056 AC7777 /MASK FOR ALL THE BITS /A056 JMS TEST2 /GET THE TYPLST STATUS WORD. RET DF=LST /A056 CIA /NEGATE IT FOR COMPARISON TO /A056 TAD (0400 /WITH THE GO-TO-PAGE FLAG /A056 SZA CLA /OK IF EQUAL /A056 JMP RPGERR /ON NON EQUALITY, GO REPORT AN ERROR /A056 AC7777 /MASK FOR ALL THE BITS /A056 JMS TEST1 /CHECK THE BLKLST STATUS WORD /A056 SZA CLA /THERE SHOULD BE NO MARKS THERE /A056 JMP RPGERR /ON NON ZERO, GO REPORT AN ERROR /A056 TAD FILENO /GET THE CURRENT FILE NUMBER /A056 JMS IORBLK /MARK THE BLKLST STATUS WD WITH FILE # /A056 TAD FILENO /GET THE CURRENT FILE NUMBER /A056 JMS IORTYP /MARK THE TYPLST STATUS WD WITH FILE # /A056 CDFBUF /GET BACK TO THE BUFFER FIELD /A056 JMP I CKRPB /IT WAS EQUAL, RETURN /A056 RPGERR, JMS ERRORS /REPORT THAT AN ERROR WAS DETECTED /A056 JMP CRP3 /TERMINATE THE GO-TO-PAGE CHECKS /A056 /D056VECRPB, XX /CHECK GO-TO-PAGE STRUCTURE OF DOCUMENT. PART OF VEHDR /M054 /D056 CDFBUF /A025 /D056 TAD I (HDR1BF+53 /GET RPG BLOCK # IN AC /A025 /D056 DCA RPBNO /D056 TAD RPBNO /D056 TAD DSKIDX /CHECK BLOCK # FOR OUT OF BOUNDS /D056 SMA SZA CLA /D056 JMS RPGERR /D056 TAD RPBNO /D056 JMS FILMRK /MARK FILE # IN BLKLST /D056 JMS I IQURX /NOW READ THE RPG BLOCK /D056 RXERD+4000 /D056RPBNO, 0 /D056 HDR4BF /D056 JMS RPGERR /READ ERROR ON RPG BLOCK /D056 JMS RPGTYP /OK RETURN, CHECK FOR TYPE=RPG /C050 /D056 CDFBUF /D056 TAD I (HDR4BF+2 /LOOK FOR EXTENSION BLOCKS /D056 SNA /D056 JMP CRP2 /NONE FOUND, STOP LOOKING /D056 JMS FILMRK /D056 TAD I (HDR4BF+3 /D056 SNA /D056 JMP CRP2 /NONE FOUND, SO STOP LOOKING /D056 DCA RPBNN /D056 TAD RPBNN /D056 JMS FILMRK /D056 JMS I IQURX /READ 2ND EXT BLOCK INTO CORE /D056 RXERD+4000 /D056RPBNN, 0 /D056 HDR4BF /D056 JMS RPGERR /READ ERROR ON BLOCK /D056 JMS RPGTYP /OK RETURN, CHECK FOR TYPE=RPG /C050 /D056 TAD (HDR4BF+361 /LOOK FOR MORE EXTENSIONS /D056 DCA X0 /D056 TAD (-16 /D056 DCA T3 /D056CRP1, TAD I X0 /D056 SNA /D056 JMP CRP2 /DONE IF ANY PTR = 0 /D056 DCA T1 /D056 TAD T1 /D056 TAD DSKIDX /D056 SMA SZA CLA /D056 JMS RPGERR /THIS BLOCK # OUT OF RANGE /D056 JMS RPGTYP /CHECK FOR TYPE=RPG /A056 /D056 TAD T1 /D056 JMS FILMRK /D056 ISZ T3 /D056 JMP CRP1 /CONTINUE IN LOOP UNTIL DONE OR 0 FOUND /D056CRP2, ISZ VECRPB /NORMAL RETURN IS TO CALL+2 /M054 /D056CRP3, CDFMYF /D056 JMP I VECRPB /D056 /D056RPGERR, XX /ALL RAPID PAGINATION STRUCTURE ERRORS LAND YOU HERE! /D056 JMP CRP3 /RESTORE THE DATA FIELD & GO /A054 /D056RPGTYP, XX /MAKE SURE THIS BLOCK IS A GO-TO-PAGE BLOCK /A019 /D056 CDFBUF /D056 TAD I (HDR4BF+1 /D056 AND (70 /D056 TAD (-70 /D056 SZA CLA /D056 JMS RPGERR /IT WASN'T AN RPG BLOCK TYPE /D056 JMP I RPGTYP /D056/ /D056FILMRK, XX /MARK FILE # IN BLKLST FOR THIS BLOCK. PART OF VECRPB /M056 /D056 TAD (BLKLST /D056 DCA T1 /D056 TAD FILENO /D056 CDFLST /POINT AT THE LIST FIELD /A054 /D056 /D056 TAD I T1 /LOOK FOR A PRIOR /A056 /D056 AND P377 /FILE # ENTRY /A056 /D056 SZA CLA /OK IF NONE THERE /A056 /D056 JMS RPGERR /IF THERE WAS ONE, TAKE THE ERROR PATH /A056 /D056 TAD FILENO /MARK THE BLKLST SW WITH THIS FILE # /A056 /D056 /D056 DCA I T1 /D056 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 /D056 JMP I FILMRK /D056 WRTEXT, XX /WRITE OUT AN EXTENSION BLOCK. PART OF COPYFL /M056 /CALLED FROM HDRWRT AND CPYRPB. /A056 JMS NXTOUT /GET THE NEXT AVAILABLE BLKOUT /A055 TAD BLKOUT /GET IT TO THE AC /A055 DCA I T2 /PUT IT IN THE EXTENSION BLOCK LIST /M056 TAD RPBPTR /GET BUFFER ADDRESS JMS WRITE0 /WRITE OUT THE BLOCK. RET DF=BUF /M056 JMP I WRTEXT /M056 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE CHKHDR, XX /CHECK HDR OR EXT FOR STRUCTURE FAILURES. PART OF COPYFL/M054 DCA SBLKNO /SET THE BLOCK NUMBER TO TEST /M054 AC2000 /CHECK FOR THE UNREADABLE FLAG /M054 JMS TEST1 /IN THE BLOCK LIST STATUS WORD. RET DF=LST/M054 SZA CLA JMP CPYEX4 /GO MARK THE FILE, CLEAR FROM LIST, SKIP COPY/A056 /D056 JMP CPYFLD /IF 1 DELETE THIS FILE TAD (4400) /CHECK FOR "BAD" & "SYSTEM" FLAGS /M054 JMS TEST2 /IN THE TYPE LIST STATUS WORD. RET DF=LST/M054 SZA CLA JMP CPYEX4 /GO MARK THE FILE, CLEAR FROM LIST, SKIP COPY/A056 /D056 JMP CPYFLD TAD P377 /GET FILE # MASK /M054 JMS TEST1 /GET THE FILE # FROM THE BLOCK LIST STATUS WORD TAD (-377) /IS IT SYSTEM BLOCK? SNA CLA JMP CPYEX4 /GO MARK THE FILE, CLEAR FROM LIST, SKIP COPY/A056 /D056 JMP CPYFLD /IF SO, DELETE FILENO /M054 TAD SBLKNO /ELSE USE THE BLOCK NUMBER UNDER TEST /M054 DCA BLKIN /AS THE BLOCK NUMBER TO READ IN /M054 JMP I CHKHDR /RET DF=LST /M054 /D056CPYFLD, /XX /DELETES FILE DURING COPY. PART OF COPYFL. /M054 /D056 AC2000 /SET THE 'DELETED' BIT /A055 /D056 JMS DOCSET /IN THIS FILE'S ENTRY IN DOCLST. RET DF=MYF/A055 /D056 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 /D056 DCA I HOMPTR /ZERO THE HOME BLOCK ENTRY FOR THIS FILE #/M055 /D056 JMP CPYEND /TERMINATE THIS FILE ZERO, XX /FIELD=BUF, (AC)=WORD COUNT, AIR17=ADDRESS-1 /C050 CIA /AC=-WC NOW DCA REG10 ZEROLP, DCA I AIR17 /ZERO THIS SPACE /M043 ISZ REG10 JMP ZEROLP /C042 JMP I ZERO /EXIT NODENS, XX /THIS SUBROUTINE HANDLES A "NOT READY" RESPONSE FROM A /M054 /DRIVE OR WINNY, SOURCE OR DESTINATION. /A049 CDFMYF TAD DRIVE /ARE WE LOOKING AT DRIVE 0? /A053 SZA CLA /SKIP IF YES /A053 JMP NOT0 /GO FIND TYPE IF NOT /A053 TAD SVDRV /WAS THE VERIFY DRIVE 0? /A053 SNA CLA /SKIP IF IT WASN'T, CLA ANYWAY /A053 JMP I NODENS /ELSE, RETURN TO CALLER - NO MSG HERE /A048 TAD CPDRV0 /=1 WHEN "COPY TO" DRIVE WAS 0 /A048 SZA CLA /IF IT WAS DRIVE 0, /A048 JMP I NODENS /THEN RETURN TO CALLER - NO MSG HERE /A048 NOT0, /D055 JMS CLRLNS /GO CLEAR THE LINES FROM THE SCREEEN /C053 TAD DRIVE /GET THE NUMBER TO /A045 JMS RESDEV /GO FIND THE TYPE /A045 JMP GONOD /IS DRIVE TYPE, INSERT DRIVE ARGS /A045 TAD (ISDEV /GET "DEVICE" ADDRESS /A045 DCA CP8B /INSERT IT IN THE MESSAGE /A045 JMP GONODI /GO ISSUE THE VOL/DEV MESSAGE /A049 GONOD, TAD (ISDRVE /GET "DRIVE" ADDRESS /C049 DCA CP8B /INSERT IT IN THE MESSAGE /C049 GONODI, JMS I IOASET /CALL IOACAL /C049 -4 /NUMBER OF ARGUMENTS TO PASS /C052 CPYMS8 /"UNABLE TO ACCESS ^S IN !D /M054 1505 CP8B, 0 /"DRIVE" OR "DEVICE" /C049 DRIVE /DRIVE NUMBER /A027 TAD DRIVE /GET THE NUMBER /A047 JMS RESDEV /FIND OUT WHAT IT IS /A047 JMP NODSKT /NO DISKETTE, GO PROMPT FOR ONE /A047 JMS SETMS2 /NO VOLUME, SEND HER TO MAIN MENU /A047 IOATSP /^P /A054 NOP /NO OP AS NULL ARG /A054 NOP /NO OP AS NULL ARG /A054 JMP I NODENS /RETURN TO CALLER /C054 NODSKT, JMS I IOASET /CALL IOACAL /A042 -6 /NUMBER OF ARGUMENTS TO PASS /C042 CPYMS9 /"CHECK THAT THE ^S EXISTS," /C054 1705 /AND A ^S IS PROPERLY INSERTED.^P^S" /M054 ISDRVE /"DRIVE" ADDRESS /C049 ISDSKT /"DISKETTE" ADDRESS /A052 2700 /NEED A POSITION FOR CPYMS9 /A054 VSNULL /NO FURTHER TEXT HERE /A054 JMS SETMS1 /SET UP THE "WHEN READY ... " PROMPT /A047 IOATSP /^P /C049 NOP /NO OP AS NULL ARG /A047 NOP /NO OP AS NULL ARG /A047 JMP I NODENS /RETURN TO CALLER /A047 HLTCHK, XX /IF HALT TRUE THEN RETURN TO CALL+2, ELSE RETURN TO /M054 CLA /CALL +1. UTILITY SUBROUTINE. /M054 CDFSYS /A027 TAD I HLTFLG /GET THE HALT FLAG /A027 CDFMYF /A027 SNA CLA /IF ZERO, FLAG HASN'T BEEN SET /A027 ISZ HLTCHK /BUMP UP RETURN ADDR IF SET /A027 JMP I HLTCHK /A027 /***********************************************************************/A027 / /A027 / THIS CODE WILL ADD -26 TO THE AC IF WE'RE DOING RX50 DRIVES /A027 / TO ENABLE US TO DISPLAY AND READ ALL THE BLOCKS ON THE /A027 / DISKETTE. (INCLUDING THE FIRMAWARE BLOCKS) /A027 / /A027 /***********************************************************************/A027 VCHRX5, XX /A027 AC7776 /CHECK TO SEE IF WE ARE DOING RX50 DRIVES/A027 TAD DENFLG /GET THE DENSITY FLAG=2 IF RX50'S /A027 SPA CLA /SKIP IF RX50 SIZE /A042 JMP I VCHRX5 /A027 TAD SYSDSK /GET THE SYSTEM FLAG. 1=SYSTEM /M054 SZA CLA /IF ZERO HERE, ITS NOT SYSTEM /M054 JMP DOSYST /GO SET UP FOR SYSTEM DISKETTE /A027 TAD DSKSIZ /GET SIZE OF DISK /A027 TAD (-6) /TAKE AWAY 6 BLOCKS FROM IT /A027 DCA DSKSIZ /STORE SIZE OF DISKETTE /A027 JMP ADJIDX /GO ADJUST THE IMAGE INDEX /A055 DOSYST, TAD DSKSIZ /GET SIZE OF DISKETTE /A027 TAD (-26) /TAKE AWAY -26 (OCTAL) /A027 DCA DSKSIZ /STORE IT FOR FUTURE USE /A027 ADJIDX, TAD DSKSIZ /GET SIZE AGAIN /A027 CIA /MAKE IT NEGATIVE /A027 DCA DSKIDX /STORE FOR FUTURE USE /A027 JMP I VCHRX5 /RETURN /A027 FNC=. /FIRST NON-CODE LOCATION /A049 PAGE /A049 COPY6, /IF DRIVE 0 WAS VERIFIED OR COPIED TO, THEN ASK FOR THE SYSTEM /A054 /DISKETTE IN DRIVE 0; PROMPT FOR GOLD MENU. /A054 TAD MAXDEV /FIND THE HIGHEST DEVICE # /A054 TAD (-10 /SEE IF ITS MORE THAN 7 /A054 SMA CLA /IF SO, THE SYSTEM IS ON DEVICE 0 /A054 JMP COPY8 /SO JUST ASK FOR GOLD MENU /A054 TAD CPDRV0 /SEE IF WE COPIED TO D0 /A054 SNA CLA /IF SO, FORCE THE D0 PROMPT /A054 TAD SVDRV /SEE IF WE VERIFIED DRIVE 0 /A053 SZA CLA /SKIP IF WE DID, ELSE /A053 JMP COPY8 /IF NOT, GO DISP WITHOUT ASKING FOR SYS DSK /A027 COPY6L, JMS SETMS2 /SET UP FOR GM ONLY /C054 CPYMS6 /Replace the system ^S in ^S 0 etc /C049 ISDSKT /"DISKETTE" /A045 ISDRVE /"DRIVE" /C049 JMP COPY6L /USER HIT RETURN, GO REDISPLAY MESS /C042 COPY8, JMS SETMS2 /DISP JUST GOLD MENU /C054 PSCR /^P!E/..POSITION AND ERASE TO EOS /C049 NOP /NO OP AS NULL ARGUMENT /A045 NOP /NO OP AS NULL ARGUMENT /A045 JMP COPY8 /USER HIT RETURN, GO REDISPLAY MESS /C032 INITF5, XX /UTILITY ROUTINE. COPIES 30000-30177 TO 50000-50177 /M054 CLA /ASSURE A CLEAN AC /A054 TAD (-200 /A054 DCA T1 /A039 DCA T2 /A039 IF5A, TAD I T2 /A039 CDFLP /FIELD 5 /A039 DCA I T2 /A039 CDFMYF /A039 ISZ T2 /A039 ISZ T1 /A039 JMP IF5A /A039 JMP I INITF5 /A039 /IOAOUT - GLOBAL SUBROUTINE. LOADS THE CALLING ROUTINE'S ARGUMENTS INTO /A042 / THE IOACAL CALLING ROUTINE IN FIELD 5. THEN EXECUTES THE CALL /A042 / TO IOACAL IN FIELD FIVE AND RETURNS. THE FIRST ARGUMENT TO /A042 / IOAOUT IS THE NEGATIVE NUMBER OF SUCCEEDING ARGUMENTS. A MAXI- /A042 / MUM OF SEVEN ARGUMENTS MAY BE PASSED. AN EXAMPLE CALL: /A042 / /A042 / JMS IOAOUT /SEND A MESSAGE /A042 / -3 /THREE ARGUMENTS TO BE PASSED /A042 / MSGLAB /THE LABEL OF THE MESSAGE (IN FIELD 5) /A042 / ARG /ARGUMENT OR LABEL (IN FIELD 5) /A042 / ARG /ARGUMENT OR LABEL (IN FIELD 5) /A042 / CODE /THE RETURN POINT /A042 / /A042 /NOTE FOR NATURAL LANGUAGE OR OTHERS WHO MAY "IFDEF" PARTS OF THE /A045 /MESSAGE CALLS: IF THE NUMBER OF ARGUMENTS WILL CHANGE AS A RESULT /A045 /OF THE DEFINITION, THE -N ARGUMENT WILL HAVE TO BE INCLUDED IN THE /A045 /"IFDEF" /A045 / IOAOUT, XX /A042 JMS INITF5 /UPDATE THE ZERO PAGE /A042 CDFLP /POINT TO FIELD 5 /A042 DCA IOAARG /SET TO 0. 0=OUTPUT COMMAND /A042 CDFMYF /POINT BACK TO FIELD 3 /A042 TAD I IOAOUT /GET THE MINUS NUMBER OF CALLER ARGS /A042 DCA REG10 /REG10 HAS THE COUNT OF ARGS TO PASS /A042 TAD (-10 /GET 1 MORE THAN THE MAX ARGS /A042 DCA REG11 /REG11 IS THE TOTAL "TO GO" COUNTER /A042 TAD (IOAARG /GET THE ARGUMENT LIST MINUS 1 /A042 DCA AIR17 /AIR17 WILL AUTO-INDEX THE LIST /M043 IOALLP, ISZ IOAOUT /POINT AT THE ARGUMENT /A042 TAD I IOAOUT /GET IT TO THE ACCUMULATOR /A042 CDFLP /POINT TO FIELD 5 /A042 DCA I AIR17 /PUT THE ARGUMENT INTO THE LIST /M043 CDFMYF /COME BACK TO FIELD 3 /A042 ISZ REG11 /REDUCE THE "TO GO" COUNT. /A042 ISZ REG10 /UNTIL THE ARGUMENT LIST IS DONE, /A042 JMP IOALLP /CONTINUE LOADING ARGUMENTS. /A042 ISZ IOAOUT /HOUSEKEEP THE RETURN POINTER /A042 NOPLP, TAD NOOPS /THEN LOAD /A042 NOOPS, NOP /NO-OPS /A042 CDFLP /POINT TO FIELD 5 /A042 DCA I AIR17 /STORE NO-OPS AFTER THE ARGUMENTS /M043 CDFMYF /COME BACK TO FIELD 3 /A042 ISZ REG11 /UNTIL THE TOTAL COUNT IS DONE, /A042 JMP NOPLP /CONTINUE LOADING NO-OPS. /A042 CIF CDFLP /THEN GO TO FIELD 5 /A042 JMS I (IOAEX /EXECUTE THE IOACAL /A042 JMP I IOAOUT /RETURN TO THE CALLER /A042 RESDEV, XX /RESOLVE THE DEVICE WHOSE # IS IN THE AC TO BE VOLUME /A054 /OR DRIVE. /A054 MQL /SAVE THE # & CLEAR THE AC /A054 TAD WINSYS /IS THERE A WINNY PRESENT? /A054 SNA CLA /IF YES, WHERE IS THE RX50 /A054 JMP ISRX /IF NOT, RETURN TO CALL+1. DISKETTE /A054 TAD (-10 /THERE IS A WINNY, IS THE RX50 HIGH? /A054 TAD MAXDEV /GET THE HIGHEST # IN THE SYSTEM /A054 SPA CLA /POSITIVE RESULTS SAY RX50 IS HIGH /A054 JMP RESLO /ON NEGATIVE RESULTS, GO CHECK LOW END /A054 MQA /GET THE SAVED DEVICE # /A054 TAD (-10 /COMPARE TO RX50 NUMBERS (8 & 9) /A054 SMA CLA /POSITIVE MEANS RX50 /A054 JMP ISRX /TAKE THE DISKETTE (CALL+1) RETURN /A054 JMP ISWIN /NEGATIVE MEANS WINNY, RETURN TO CALL+2 /A054 RESLO, ACL /GET THE SAVED DEVICE # /A054 SNA CLA /CHECK FOR #0 FIRST /A054 JMP ISRX /DRIVE 0 IS DEFINITELY AN RX50 (V2.0) /A054 ACL /GET THE SAVED DEVICE # /A054 TAD (-1 /CHECK FOR #1 /A054 SZA CLA /A ZERO HERE SAYS ITS D1 /A054 JMP ISWIN /ANY OTHER NUMBER IS WINNY /A054 AC0010 /CHECK BIT 8 /A054 CDFMNU /IN MNOPTN /A054 AND I (MUBUF+MNOPTN /TO SEE IF #1 IS ASSIGNED TO WINNY /C055 CDFMYF /POINT BACK AT THIS FIELD /A054 SZA CLA /ON ZERO ITS NOT, SO TAKE CALL+1 /A054 ISWIN, ISZ RESDEV /ELSE IT IS, SO TAKE CALL+2 /A054 ISRX, JMP I RESDEV /RETURN TO CALLER /A054 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE WPSDET, XX /IF THE FLAG CLASSU WASN'T SET AND /M054 /IF THE IMAGE BEING VERIFIED HAS A VALID WPS FORMATTED /A053 /HOME BLOCK OR ALLOCATION BLOCK, IT IS CONSIDERED TO BE /A053 /OF CLASS "WPS", OTHERWISE, IT IS OF CLASS "UTILITY" /A053 / /A053 /IF (CLASSU)<>0 THEN /A054 / GO REPORT UTILITY AND PROMPT FOR RETURN TO MAIN MENU /A054 /ELSE /A054 /IF THE READ OF THE HOME BLOCK IS SUCCESSFUL THEN /A053 / IF HOMEBLOCK WORD 9 = -200 THEN /A053 / IF HOMEBLOCK WORD 6 = 255 THEN /A053 / IF HOMEBLOCK WORD 1 = XX3X(8) THEN /A053 / GO PROMPT FOR PASS 2 (THIS IS A WPS IMAGE) /A053 /ELSE /A053 /IF THE READ OF THE ALLOCATION BLOCK IS SUCCESSFUL THEN /A053 / IF ALLOCATION BLOCK WORD 1 = XX4X(8) THEN /A053 / IF ALLOCATION BLOCK WORD 2 <> 0 THEN /A053 / GO PROMPT FOR PASS 2 (THIS IS A WPS IMAGE) /A053 /ELSE /A053 /GO REPORT UTILITY AND PROMPT FOR RETURN TO MAIN MENU /A053 /END /A053 / /A053 CLA /START CLEAN /A054 TAD CLASSU /SEE IF STARTM HAS SET 'UTILITY' /A054 SZA CLA /IF NOT, CHECK HOME &/ ALLOCATION BLOCKS/A054 JMP UTMED /NON-WPS RETURN, GO REPORT UTILITY DONE /A053 CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX /QUEUE A REQUEST TO RXHAN /A053 RXERD+4000 /FNC=READ /A053 2 /BLOCK 2 IS THE HOMEBLOCK /A053 HBLKBF /BUFFER ADDRESS IN BUFFER FIELD /A053 JMP CKALLO /ERROR, GO CHECK THE ALLOCATION BLOCK /A053 CDFBUF /GET THE INDIRECTS FROM THE BUFFER FIELD/A053 TAD I (HBLKBF+11 /WORD 9 SHOULD HAVE -200(10) /A053 TAD (310 /ADDING 200(10) SHOULD GIVE (AC)=0 /A053 SZA CLA /IF TRUE, KEEP CHECKING /A053 JMP CKALLO /ERROR, GO CHECK THE ALLOCATION BLOCK /A053 TAD I (HBLKBF+6 /WORD 6 SHOULD HAVE 255(10) /A053 TAD (-377 /ADDING -255(10) SHOULD GIVE (AC)=0 /A053 SZA CLA /IF TRUE, KEEP CHECKING /A053 JMP CKALLO /ERROR, GO CHECK THE ALLOCATION BLOCK /A053 TAD I (HBLKBF+1 /WORD 1 SHOULD HAVE XX3X(8) /A053 AND (70 /MASK OUT ALL BUT BITS 6-8 /A053 TAD (-30 /ADDING -30(8) SHOULD GIVE (AC)=0 /A053 SNA CLA /IF NOT, KEEP CHECKING /A053 JMP ISWPS /THE HOME BLOCK IS VALID FOR WPS /A053 CKALLO, JMS GTALLC /READ ALLOCATION BLOCK TO ABLKBF. RET DF=BUF/M054 JMP UTMED /NON-WPS RETURN, GO REPORT UTILITY DONE /A053 TAD I (ABLKBF+1 /TYPEWORD SHOULD HAVE XX4X(8) /A053 AND (70 /MASK OUT ALL BUT BITS 6-8 /A053 TAD (-40 /ADDING -40(8) SHOULD GIVE (AC)=0 /A053 SZA CLA /IF TRUE, THEN KEEP CHECKING /A053 JMP UTMED /NON-WPS RETURN, GO REPORT UTILITY DONE /A053 TAD I (ABLKBF+2 /ANYTHING BUT 0 IS GOOD HERE /A053 SNA CLA /A053 JMP UTMED /NON-WPS RETURN, GO REPORT UTILITY DONE /A053 TAD I (HBLKBF+1 /THE COS TYPEWORD IS -1, SO /A054 IAC /ADD 1 TO IT. /A054 SZA CLA /IF 0 IT MIGHT BE A COS IMAGE /A054 JMP ISWPS /ELSE IT PROBABLY IS A WPS IMAGE /A054 JMS SETMS1 /PROBABLY COS, SO WARN THE USER /A055 BEWARE /"**CAUTION** THIS !S MAY NOT BE IN WPS FORMAT" VMED /"DISKETTE" OR "VOLUME" /A054 NOP /NULL ARGUMENT /A055 ISWPS, JMP I WPSDET /RETURN TO CALLER /A053 UTMED, /HERE BECAUSE THE MEDIA WAS DETERMINED TO BE OF CLASS "UTILITY" /A053 JMS I IOASET /SEND A MESSAGE /A053 -3 /WITH THREE ARGUMENTS /A053 UTMSG /"VERIFY DONE ON THIS UTILITY !S /A053 2500 /POSITION AT LINE 25 & CLEAR TO EOS /A053 VMED /TYPE OF MEDIA BEING VERIFIED /A053 JMP COPY6 /COPY6 WILL SET UP THE PROMPT /C054 BADDSC, XX /BAD DESTINATION MEDIA OR DEVICE /C049 CDFMYF /LET'S ALL COME BACK HERE! /A024 TAD CPYDRV /GET THE "COPY TO" NUMBER /A045 JMS RESDEV /GO FIND OUT WHAT IT IS /A045 JMP BADDSK /ITS A DISKETTE, GO REPORT IT /A045 JMS I IOASET /ITS A VOLUME SO REPORT THAT /A045 -4 /4 ARGUMENTS TO PASS /A045 CPYWM3 /"WRITE ERRORS. SELECT NEW .... /A045 -2400 /POSITION & ERASE /A045 ISDEV /"DEVICE" OR /A045 ISVOL /"VOLUME" /A045 JMP CPYABT /ABORT THE COPY OPERATION /A045 / BADDSK, /BAD DISKETTE OR DESTINATION DRIVE ERROR. /C049 JMS I IOASET /CALL IOACAL /A042 -3 /NUMBER OF ARGUMENTS TO PASS /C045 CPYMS3 /BAD SPOT ON NEW DISC -2400 ISDSKT /"DISKETTE" /C045 JMP CPYABT /ABORT THE COPY OPERATION /C049 / GTALLC, XX /GET THE ALLOCATION BLOCK INTO BUFFER FIELD /M054 CDFBUF /A054 JMS I IQURX /A027 RXERD+4000 /A027 377 /A027 ABLKBF /A027 JMP GTERRT /ERROR, TAKE NON-SKIP RETURN /A050 ISZ GTALLC /READ OK, TAKE SKIP RETURN /A050 GTERRT, CDFBUF /POINT AT THE BUFFER FIELD TO SEE ABLKBF/A054 JMP I GTALLC /A027 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE INAREA, -STRLEN /A027 ZBLOCK STRLEN+1 /A027 FNC=. /FIRST NON-CODE LOCATION /A049 PAGE /C044 ASKNBR, XX /RESOLVE THE USABLE 'COPY-TO' DEVICE. 1ST LEVEL SUBROUTINE/M054 AC7777 /GET A MINUS 1 TO CHECK FOR 2-DRIVE SYSTEM/A027 TAD MAXDEV /GET MAXDEV BACK FOR 2 DRIVE TEST /A054 SNA CLA /IF NOT ZERO, THEN IT ISN'T A 2-DRIVE SYSTEM/A027 JMP TWDRV /GO PROCESS A 2-DRIVE SYSTEM /A027 IFNDEF ITALIAN < TAD WINSYS /IS THERE A WINNY PRESENT? /A054 SNA CLA /ADD '/DEVICE' IF WINNIE BIT WAS SET /M054 JMP ASKAGN /NOT WINNY, PRESS ON /A054 TAD (SLSDEV) /GET ADDR OF "/DEVICE" SUBSTRING /A044 DCA DRVPMT /PUT INTO IOACAL SEQ /A044 TAD (SLSDEV) /GET ADDR OF "/DEVICE" SUBSTRING /A044 DCA DRVPMA /PUT INTO IOACAL SEQ /A044 TAD (SLSVOL) /DO SAME FOR "/VOLUME" /A044 DCA DSKPMT / /A044 > ASKAGN, JMS I IOASET /CALL IOA SET UP /M054 -7 /WITH 7 ARGUMENTS /M054 VASKNB /"TYPE THE NUMBER OF THE ^S^S THAT CONTAINS 1305 /THE ^S^S ^PYOU WANT TO RECEIVE THE COPY" ISDRVE /"DRIVE" /A054 DRVPMT, VSNULL /VSNULL OR "/DEVICE" /A054 ISDSKT /"DISKETTE" /A054 DSKPMT, VSNULL /VSNULL OR "/VOLUME" /A050 1505 /A027 JMS I IOASET /CALL IOA SET UP /A050 -3 /WITH 3 ARGUMENTS /A050 VPRTGM /AND PRESS RETURN /A027 2405 /OR PRESS GOLD MENU TO RECALL MAIN MENU /M054 2605 /A027 REASK, CIFMNU /A027 JMS I INACAL /GO GET WHAT THE USER TYPED IN /A027 INAREA /A027 JMP GOLDKY /HE HIT A GOLD KEY /A027 CLA MQA /A027 SNA CLA /A027 JMP ASKAGN /GO ASK FOR IT AGAIN /A027 CIFMNU /A027 JMS I CVDCAL /A027 INAREA+1 /A027 JMP BDNBR /USER DIDN'T TYPE IN A NUMBER /A027 DCA CPYDRV /SAVE DRIVE NUMBER PUT IN BY USER /A044 TAD CPYDRV /& GET IT BACK INTO AC /A044 CIA /FOR COMPARING TO /M054 TAD MAXDEV /THE MAXIMUM DEVICE NUMBER /A054 SPA CLA /SKIP IF VALID DRIVE NUMBER /A027 JMP BDNBR /WRONG NUMBER /A027 TAD SVDRV /GET THE SAVED "VERIFY" DEVICE NUMBER /A050 CIA /SET UP FOR COMPARE /A027 TAD CPYDRV /NOW COMPARE WITH THE "COPY TO" NUMBER /A050 SNA CLA /IF ZERO, THEY ARE EQUAL /A050 JMP EQDRV /GO COMPLAIN /A050 JMP CKASGN /GO SEE IF WINNIE & ASSIGNED & BIG ENUF /C054 CKSZOK, JMS I IOASET /CALL IOA SET UP /A050 -2 /WITH 2 ARGUMENTS /A050 PSCR /^P!E/ POSITION AND ERASE TO EOS /M054 1305 /FROM LINE 13 COL 5 /M054 JMP COPYMS /GO INFORM & PROMPT USER /A054 GOLDKY, TAD (-EDMENU /USER TYPED A GOLD KEY CHECK MENU ONLY /M054 SNA CLA /A027 JMP VEPRM4 /TAKE GOLD MENU EXIT PATH /A054 JMS RNGBEL /GO RING THE BELL /A050 JMP ASKAGN /GO ASK FOR NUMBER AGAIN /A027 BDNBR, TAD (VBDNBR /GET THE MESSAGE LABEL /A054 DCA INFOMS /PUT IT IN THE IOA SEQUENCE /A054 TAD (MAXDEV /GET THE ADDRESS OF THE MAX # ALLOWED /A054 DCA NUMER /PUT IT IN THE IOA SEQUENCE /A054 JMP INFORT /GO INFORM USER & INVITE RETRY /A054 EQDRV, TAD (VUSDFD /GET THE MESSAGE LABEL /A054 DCA INFOMS /PUT IT IN THE IOA SEQUENCE /A054 TAD (CPYDRV /GET THE ADDRESS OF THE # NOT TO USE /A054 DCA NUMER /PUT IT IN THE IOA SEQUENCE /A054 INFORT, JMS I IOASET /GO INFORM USER & INVITE RETRY /A054 -6 /WITH 6 ARGUMENTS /A054 INFOMS, 0 /"^S^S NUMBERS MUST BE 0 TO !D." /A054 /"USE A ^S^S OTHER THAN !D ON OUTPUT." /M054 2717 /LINE 27, COL 17 /A054 ISDRVE /"DRIVE" /A054 DRVPMA, VSNULL /VSNULL OR "/DEVICE /A054 NUMER, VSNULL /NUMERIC ARGUMENT /A054 TRYAGN /" TRY AGAIN. /A054 JMP REASK /GO ASK FOR NUMBER AGAIN /A054 TWDRV, CDFMNU /A054 TAD I (MUBUF+MNTMP5 /GET THE DRIVE NBR TO COPY TO /C050 DCA CPYDRV /PUT IT IN CPYDRV /A054 CDFMYF /A027 JMP COPYMS /GO INFORM & PROMPT USER /A054 ASKXIT, JMP I ASKNBR /RETURN /A027 FNC=. /FIRST NON-CODE LOCATION /A049 PAGE /C044 CKASGN, TAD WINSYS /IS THIS A WINNIE SYSTEM? /A044 SNA CLA /YES, SKIP & CONTINUE CHECKING /A044 JMP CKSZOK /NO, TAKE SUCESS RETURN /A044 JMS SWPDRV /MAKE (DRIVE)=(CPYDRV) /A050 TAD CPYDRV /GET DRIVE/DEVICE # /A044 SZA CLA /CHECK FOR DEVICE 0 /C054 JMP NOT0S /IF NOT COPYING TO 0, THEN PRESS ON /A054 JMS GDENS /ELSE ITS 0, GET ITS DENSITY CODE TO AC /A054 TAD (-4 /IF ITS 4 OR MORE, ITS THE SYSTEM VOLUME/A054 SPA CLA /IN WHICH CASE, INFORM THE USER /A054 JMP NOT0S /OTHERWISE, PRESS ON /A054 JMS SETMS1 /SET UP 'WHEN READY PROMPT /A054 NOT0V /'COPY NOT PERMITTED TO THE SYSTEM ^S..'/A054 ISVOL /'VOLUME' /A054 TRYAGN /' &TRY AGAIN.' /A054 JMP ASKAGN /GO ASK FOR A NUMBER AGAIN /A054 NOT0S, CDFBUF /POINT AT THE BUFFER DATA FIELD /A054 JMS I IQURX /QUEUE A REQUEST TO RXHAN /A050 RDEGTV+4000 /FNC=GET VOLUME DATA /A050 0 /DUMMY BLOCK FOR QURX /A050 CVOLBU /'COPY-TO' VOLUME BUFFER ADDRESS /C054 JMP CKASFL /ERROR RETURN, GO SEE IF DRIVE OR UNASG /A054 /CHECK THE VOLUME SIZE CDFBUF /NOW MAKE SURE DESTINATION LARGE ENOUGH /A054 TAD I (CVOLBU+17 /GET THE HI BYTE OF THE BLOCK COUNT /A054 SZA CLA /CERTAINLY BIG ENOUGH IF ITS NOT 0 /A054 JMP CKSZOK /SO THAT'S IT HERE /A054 TAD I (CVOLBU+16 /LOOK AT THE LOW BYTE OF THE BLOCK COUNT/A054 CLL RTL /CLEAR THE LINK & MULTIPLY BY 4 /A054 RTL /TWICE TO GET ACTUAL BLOCK COUNT /A054 TAD DSKIDX /ADD THE -MAX BLOCK COUNT FROM SOURCE /A054 SZL /OK IF IT CAUSED THE CARRY /A054 JMP CKSZOK /SO PRESS ON /A054 /TELL 'EM ITS TOO SMALL CLA /GET THE GARBAGE OUT /A054 TAD (VSMALL /'THE ^S ASSIGNED TO ^S ^D IS TOO SMALL.'/A054 DCA VDMSA /INSERT IT IN THE SEQUENCE /A054 JMP VDMS /GO INFORM & INVITE RETRY /A054 COMSD, TAD (1420 /784 BLOCKS IS THE MOST IT CAN TAKE /A054 TAD DSKIDX /ADD THE -BLOCKS IN THE SOURCE IMAGE /A054 SMA CLA /MINUS RESULTS MEAN SOURCE>DESTINATION /A054 JMP CKSZOK /ELSE SOURCE =< DESTINATION ERGO OK /A054 JMS I IOASET /CALL IOA SET UP /A054 -5 /WITH 5 ARGUMENTS /A054 NORX50 /'THE IMAGE IN ^S !D IS TOO BIG FOR A ^S/A054 1305 /@LINE 13 COL 5 /A054 ISVOL /'VOLUME' /A054 SVDRV /'#' /A054 ISDSKT /'DISKETTE' /A054 JMS SETMS1 /SET UP 'WHEN READY...PROMPT /A054 NORX5A /'CHOOSE A MOUNTED ^S OF !D BLOCKS.... /A054 ISVOL /'VOLUME' /A054 DSKSIZ /'####' /A054 JMP ASKAGN /GO ASK AGAIN AFTER THE RETURN /A054 CKASFL, TAD CPYDRV /GET THE COPY-TO # /A054 JMS RESDEV /GO FIND OUT WHETHER DRIVE OR DEVICE /A054 JMP COMSD /ITS DRIVE SO GO COMPARE SOURCE & DESTINATION /TELL 'EM ITS NOT ASSIGNED TAD (VUNASG /'THERE IS NO VOLUME ASSIGNED... /A054 DCA VDMSA /INSERT IT IN THE SEQUENCE /A054 VDMS, JMS I IOASET /CALL IOA SET UP /A054 -6 /WITH 6 ARGUMENTS /A054 VDMSA, VSNULL /'THERE IS NO VOLUME ASSIGNED... /A054 /'THE ^S ASSIGNED TO ^S ^D IS TOO SMALL.'/A054 2717 /LINE & COLUMN /A054 ISVOL /"VOLUME" ADDRESS /A054 ISDEV /"DEVICE" ADDRESS /A054 CPYDRV /OUTPUT DEVICE NUMBER /A054 TRYAGN /" TRY AGAIN" /A054 CDFMYF /CHANGE BACK TO OUR FIELD B4 WE GO /A050 JMS RTDRV /MAKE (DRIVE)=(SVDRV) /A050 JMP REASK /INVITE A RETRY /A054 FNC=. /FIRST NON-CODE LOCATION /A049 PAGE /FIRST LEVEL SUBROUTINE. DETERMINE (MAXDEV) & (WINSYS). (SVDRV)=(DRIVE)=MAIN /MENU SELECTION. (CPYDRV)=0. CALL RESDEV TO DETERMINE THE TYPE OF MEDIA/M054 /AND DEVICE BEING VERIFIED, SETS THE GLOBAL CONSTANTS "VMED" AND "VDEV" /A049 /IN PAGE 0, SELECTS AND ISSUES AN INFORMATIONAL MESSAGE, ISSUES A PROMPT/A049 / STARTM, XX /A049 CDFMNU /A027 TAD I (MUBUF+MNMXDR /GET HIGHEST DEVICE NUMBER /A054 DCA MAXDEV /STORE IT FOR LATER REFERENCES /A054 AC0004 /MASK TO ISOLATE WINNIE BIT /A054 AND I (MUBUF+MNOPTN /CHECK FOR PRESENCE OF WINCHESTER /A054 SZA CLA /ZERO MEANS THERE IS NO WINNY /A054 AC0001 /ELSE, GET A ONE /A054 DCA WINSYS /SET "THIS IS A WINNIE SYSTEM FLAG" /A054 AC4000 /MASK FOR THE 'CHAINED INTO VERIFY' FLAG/A055 AND I (MUBUF+MNTMP2 /LOOK FOR BIT 0 /A055 SZA /IF IT WAS SET /A055 ISZ CHAIN /SET THE CHAINED FLAG IN PAGE 0 /A055 AC3777 /MASK TO ALLOW ALL BUT BIT 0 /A055 AND I (MUBUF+MNTMP2 /TO LEAVE THE DRIVE NUMBER AND /A055 DCA I (MUBUF+MNTMP2 /ANYTHING ELSE THAT WAS THERE /A055 TAD I (MUBUF+MNTMP2) /GET THE VERIFY DRIVE NUMBER /A027 DCA DRIVE /STORE IT /A027 TAD DRIVE /GET THE DRIVE NUMBER /A027 DCA SVDRV /SAVE IT FOR COPYING /A027 DCA CPYDRV /INITIALIZE 'COPY-TO' TO 0 /A054 DCA CPDRV0 /ININIALIZE TO 'NOT DEVICE 0' /A054 TAD DRIVE /GET THE DEVICE NUMBER JMS RESDEV /GO FIND THE DEVICE TYPE JMP STTYP /"DRIVE" RETURN, SET UP DRIVE/DISKETTE /A049 TAD (ISVOL /"WINNY" RETURN, SO GET "ISVOL" ADDRESS /A049 DCA VMED /AND INSERT IT AS THE POINTER IN PAGE0 /A049 TAD (ISDEV /"DEVICE" ADDRESS /A049 DCA VDEV /INSERT FOR PROMPTS AND MESSAGES /A049 TAD (VWSCD /GET THE "WINNY" MESSAGE ADDRESS /A049 DCA STMS /INSERT IT FOR THE TYPE & # ID CALL /A049 JMP STSND /GO SEND THE VOLUME/DEVICE MESSAGES /A049 STTYP, TAD (ISDSKT /GET "DISKETTE" ADDRESS /A049 DCA VMED /INSERT IT AS THE POINTER IN PAGE0 /A049 TAD (ISDRVE /GET "DRIVE" ADDRESS /A049 DCA VDEV /INSERT IT AS THE POINTER IN PAGE0 /A049 TAD (VSCRND /GET THE DISKETTE/DRIVE FROMAT MESSAGE /A049 DCA STMS /INSERT IT FOR THE TYPE & # ID CALL /A049 STSND, JMS I IOASET /CALL IOACAL /A049 -4 /NUMBER OF ARGUMENTS TO PASS /A049 VSCRN1 /"VERIFY !S STRUCTURE" /A049 0 /CURSOR POSITION FOR ERASE /A049 26 /CURSOR POSITION FOR HEADER /A049 VMED /"DISKETTE" OR "VOLUME" /A049 TAD CHAIN /SEE IF WE CHAINED INTO VERIFY /A055 SZA CLA /IF WE DID /A055 JMP STDENS /SKIP THE PROMPT, GO GET DENSITY /A055 JMS I IOASET /IDENTIFY VERIFY DEVICE/DRIVE /A049 -5 /PASS 5 ARGUMENTS /A049 STMS, 0 /VSCRND: "PUT DISKETTE IN DRIVE N", OR /A049 /VWSCD: "VERIFYING VOL IN DEV N" /A049 2600 /CURSOR POSITIONING FOR PROMPT /A049 VMED /"DISKETTE" OR "VOLUME" /A049 VDEV /"DRIVE" OR "DEVICE" /A049 DRIVE /THE NUMBER OF THE DRIVE/DEVICE /A049 JMS SETMS1 /SET UP "WHEN READY.." PROMPT. /A049 IOATSP /ADDRESS OF POSITIONING NULL MESSAGE /A049 NOP /NULL ARG /A049 NOP /NULL ARG /A049 STDENS, JMS GDENS /GET DENSITY CODE INTO AC. RETURN DF=MYF/M054 DCA DENFLG /AND STORE IT IN DENFLG /A016 AC0004 /4 = DENSITY CODE FOR A MOUNTED WINNY /A054 CIA /NEGATE IT TO SUBTRACT FROM /A054 TAD DENFLG /THE CURRENT DENSITY CODE /A054 SPA CLA /IF 4 OR GREATER, GET THE VOLUME DATA /A054 JMP PREV2 /ELSE GO GET DATA FROM THE TABLE /A054 CDFBUF /POINT AT THE BUFFER FIELD /A054 JMS I IQURX /CALL RXHAN /A054 RDEGTV+4000 /GET VOLUME DATA /A054 0 /DUMMY BLOCK FOR RXHAN /A054 VVOLBU /BUFFER ADDRESS /A054 NOP /MAYBE CHANGE TO LET RXHAN DO ERRORS /A054 CDFBUF /POINT BACK AT THE BUFFER FIELD /A054 TAD I (VVOLBU+17 /LOOK AT THE HIGH WORD /A054 SZA CLA /OK IF ZERO /A054 JMP TOOBIG /ELSE, GO INFORM THE USER /A054 TAD (-176 /GET THE NEGATIVE OF MAX COUNT +1 /A054 TAD I (VVOLBU+16 /COMPARE THE LOW WORD @BLOCKS/20 OCT /A054 SMA CLA /ONLY NEGATIVE NUMBERS ARE GOOD /A054 JMP TOOBIG /IF TOO BIG, GO TELL /A054 TAD (-17 /GET THE SMALLEST LEGAL COUNT /A054 TAD I (VVOLBU+16 /COMPARE THE LOW WORD @ BLOCKS/20 OCT /A054 SPA CLA /OK ON PLUS RESULTS, CLEAR THE AC /A054 AC0001 /FOR MINUS RESULTS, GET A ONE /A054 DCA CLASSU /SET/CLEAR THE 'CLASS IS UTILITY' FLAG /A054 TAD I (VVOLBU+16 /GET THE BLOCKS/20 OCT /A054 CLL RTL /CLEAR THE LINK & MULTIPLY BY FOUR /A054 RTL /TWICE TO GET THE ACTUAL BLOCK COUNT /A054 DCA DSKSIZ /THAT'S THE # OF BLOCKS IN THIS IMAGE /A054 JMP SETIDX /GO CONTINUE RESOLVING AND SETTING UP /A054 TOOBIG, JMS I IOASET /CALL IOA SET UP /A054 -2 /PASS 2 ARGUMENTS /A054 EXBLK /'^P!E&ONLY THE 1ST 2000 BLOCKS....' /A054 0300 /PUT IT IN OVER 'READABILITY... /A054 TAD (3720 /GET 2000 DECIMAL /A054 DCA DSKSIZ /THAT'S THE # OF BLOCKS IN THIS IMAGE /A054 JMP SETIDX /GO SET THE SIZE AND INDEX. IN LINE CODE/A055 /ON ANOTHER PAGE. JUMPS BACK HERE TO RETURN/A055 STARTR, JMP I STARTM /RETURN TO CALLER. USED BY OFF PAGE SECTION FNC=. /FIRST NON-CODE LOCATION /A049 PAGE SETIDX, TAD DSKSIZ /GET THE RESOLVED IMAGE SIZE /A054 TAD (-1440 /IF ITS 800 BLOCKS /A054 SNA CLA / /A054 JMP PREV1 /GO TREAT IT LIKE AN RX50 /C055 TAD DSKSIZ /ELSE, GET THE # OF BLOCKS TO WORK WITH /A054 CIA /NEGATE IT /A054 DCA DSKIDX /MAKE IT THE BASE FOR COUNTING BLOCKS /A054 TAD DSKSIZ /GET THE # OF BLOCKS TO WORK WITH /A054 CLL RTR /DIVIDE BY THE 8 BITS PER ALLOCATION /A054 RAR /WORD /A054 IAC /ADD ONE FOR REVERSE COMPATABILITY /A054 DCA ALCCNT /THAT'S THE ALLOCATION WORD COUNT /A054 JMP STCG /GO MERGE WITH THE EARLIER LINE /A054 PREV1, ISZ RX50SZ /SET THE 'RX50 SIZE' FLAG /A055 PREV2, CDFMYF /POINT BACK TO THIS FIELD FOR INDIRECTS /A054 TAD DENFLG /NOW SET UP SIZE CONSTANT /A016 TAD (SZTAB /ADD IN THE ADDRESS OF THE TABLE /C055 DCA T1 /TO INDIRECT TO /A027 TAD I T1 /GET SIZE OF DISK /A027 DCA DSKSIZ /EQUALS THE SIZE OF THIS DISKETTE /A016 TAD DSKSIZ /NOW MAKE AN INDEX OF IT TOO! /A016 CIA /A016 DCA DSKIDX /A016 TAD DENFLG /SET UP SIZE OF ALLOCATION BLOCK AREA /M054 TAD (ALTAB /ALLOCATION WORD TABLE ADDRESS /CBP2 DCA T1 /TO INDIRECT THRU /A027 TAD I T1 /GET NUMBER OF WORDS IN ALLOCATION BLOCK/M054 DCA ALCCNT /A016 /IF VERIFYING A SYSTEM THEN (SYSDSK)<>0, IF AN RX50 SIZE DEVICE, SET /A054 /THE NUMBER OF ALLOCATION WORDS TO OCT 140 (VICE 142 FOR DOC DISKETTES) /A054 STCG, DCA SYSDSK /SET DISKETTE TO 0 TO INDICATE DOCUMENT /M054 JMS GTALLC /GET ALLOCATION BLOCK INTO BUFFER. RET DF=BUF JMP CKRDMS /ERROR GETTING ALLOCATION BLOCK, PRESS ON/A054 TAD I (ABLKBF+1) /IS IT A SYSTEM DISKETTE? /A027 AND (71 /LOOK AT TYPE NIBBLE & SYSTEM BIT ONLY /A054 TAD (-41) /SYSTEM DISKETTE? /A027 SZA CLA /A027 JMP CKRDMS /IF NOT SYSTEM, THEN PRESS ON NOW /A054 ISZ SYSDSK /SIGNAL SYSTEM DISKETTE /A027 AC7776 /CHECK IF WE ARE DOING RX50'S /M055 TAD DENFLG /DENSITY FLAG=2 FOR RX50'S /M055 SNA CLA /IF NOT EQUAL THEN ITS NOT AN RX50 /C055 ISZ RX50SZ /IF IT WAS THEN SET THE 'RX50 SIZE' FLAG/A055 TAD RX50SZ /ARE WE DOING AN RX50 SIZE? /A055 SNA CLA /WE ARE IF THE FLAG ISN'T 0 /A055 JMP CKRDMS /IF NOT RX50 THEN PRESS ON NOW /A054 AC7776 /GET A -2 TO DECREMENT /C042 TAD ALCCNT /DEC ALLOCATION WORD COUNT /A027 DCA ALCCNT /RETURN IT /A027 CKRDMS, JMS I IOASET /CALL IOACAL /A049 -2 /NUMBER OF ARGUMENTS TO PASS /A049 VSCRN0 /"CHECKING FOR READABILITY" /A049 500 /CURSOR POSITION /A049 JMP STARTR /RETURN VIA STARTM /A054 NXTOUT, XX /RETURN THE NEXT AVAILABLE OUTPUT BLOCK. UTILITY SUBR. /A055 /NEVER RETURN 0,1,2,6,255. /A055 CLA CLL /START ALL CLEAR /A055 NXTONE, ISZ BLKOUT /INCREMENT THE OUTPUT BLOCK NUMBER /A055 TAD BLKOUT /GET THE CURRENT NUMBER FOR COMPARISON /A055 TAD DSKIDX /WITH THE MINUS MAX BLOCK COUNT /A055 SMA CLA /MINUS RESULTS ARE OK /A055 JMP FULLUP /ELSE GO REPORT THE OUTPUT IS FULL /A055 AC7777 /GET MINUS 1 /A055 TAD BLKOUT /COMPARE WITH CURRENT BLOCK OUT /A055 SZA /CANT ALLOW THIS ONE, TAKE THE SKIP PATH/A055 TAD (-1 /NOW MAKE IT -2 /A055 SZA /CANT ALLOW THIS ONE, TAKE THE SKIP PATH/A055 TAD (-4 /NOW MAKE IT -6 /A055 SZA /CANT ALLOW THIS ONE, TAKE THE SKIP PATH/A055 TAD (-371 /NOW MAKE IT -255 /A055 SNA CLA /CANT ALLOW THIS ONE, TAKE THE SKIP PATH/A055 JMP NXTONE /ONE OF THE FORBIDDEN ONES, TRY AGAIN /A055 JMP I NXTOUT /RETURN WITH THE NEXT OUTPUT BLOCK # /A055 FULLUP, JMS I IOASET /CALL IOACAL /A055 -3 /NUMBER OF ARGUMENTS TO PASS /A055 OPFUL /^P!E&THERE IS NOT ENOUGH FREE SPACE /A055 /ON THE !S TO FINISH. / /A055 2400 /CURSOR POSITION AND ERASE TO EOS /A055 VCMED /THE COPY MEDUIM: VOL OR DSKT /A056 JMP CPYABT /GO FINISH TERMINATION /A055 FNC=. /FIRST NON-CODE LOCATION /A042 PAGE BADHDR, XX /BAD HEADER DETECTED. UTILITY SUBROUTINE. /A054 CLA /A054 JMS DLTFIL /A054 TAD (HBLKBF+11 /GET THE START OF THE FILE LIST /A055 TAD FILENO /ADD IN THIS FILE NUMBER /A055 DCA T1 /T1 POINTS TO THE WORD IN THE LIST /A054 CDFBUF /CHANGE TO THE BUFFER FIELD /A054 DCA I T1 /ZERO THE HOME BLOCK BUFFER ENTRY /A054 CDFMYF /A027 JMP I BADHDR /THIS AREA CAN BE BEEFED UP GREATLY HDRCOL, XX /IF ANY BLOCK IS BOTH DATA & HDR, MARK IT WITH 'READ FAIL' AND /'MULTI-USE' FLAGS IN THE BLOCK LIST & FLAG HOMEOK FOR REBUILD/A054 DCA SBLKNO /CLEAR THE NUMBER OF THE BLOCK TO CHECK /A055 TAD DSKIDX /GET THE -NUMBER OF BLOCKS IN THE IMAGE /A055 IAC /ADD +1 TO REDUCE THE COUNT TO GO BY 1 /A055 DCA REG12 /USE REG12 AS THE 'TO GO' COUNTER /A055 HDRC, ISZ SBLKNO /SBLKNO IS THE OFFSET POINTER INTO LISTS/M054 TAD P377 /MASK FOR THE FILE NUMBER ONLY /M055 JMS TEST2 /IN THIS BLOCK'S TYPE LIST STATUS WORD /M055 SNA /IF NO FILE # THEN ITS NOT A HEADER /M055 JMP HRCOL3 /SO SKIP IT /M055 DCA T1 /SAVE THE # TO COMPARE TO THE BLKLST # /M055 TAD P377 /MASK FOR THE FILE NUMBER ONLY /M055 JMS TEST1 /IN THIS BLOCK'S BLOCK LIST STATUS WORD /M055 /WHAT ABOUT FILE# 0? DCA FILENO /SAVE THE BLOCK LIST FILE # /A055 TAD FILENO /GET IT BACK FOR COMPARISON /A055 CIA /NEGATE IT /A055 TAD T1 /COMPARE THE TYPE LIST # /A055 SNA CLA /IF THE FILE #S WERE THE SAME THEN /M055 JMP HRCOL3 /ITS A LEGAL HEADER /M055 /D056 TAD (0400 /SEE IF IT WAS A GO-TO-PAGE BLOCK /A056 /D056 JMS TEST2 /IN THE TYPE LIST /A056 /D056 SZA CLA /IF NOT GTP THEN GO REPORT /A056 /D056 JMP HRCOL3 /IT WAS GTP SO DON'T BOTHER /A056 /D056 AC6000 /MARK THE BLOCK LIST FILE # /A055 TAD (4400 /SET BIT 0 'THIS FILE NOT TO BE COPIED /A056 /SET BIT 3 'A DATA BLOCK CLAIMED AS OTHER HEADER JMS DOCSET /IN THE DOCUMENT LIST /A055 TAD T1 /GET THE TYPE LIST FILE # /A055 DCA FILENO /MAKE IT THE NUMBER TO MARK /A055 /D056 AC6000 /MARK AS 'AFFECTED' & 'NOT COPIED' /A055 TAD (0020 /SET BIT 7 'HEADER 1 IS A DATA BLOCK ELSEWHERE' JMS DOCSET /IN THE DOCUMENT LIST /A055 JMS HOMEOK /A CONFLICT, FLAG TO REBUILD HOME /M055 TAD (0400) /MARK THE BLOCK AS MULTIPLY USED /C055 JMS IORBLK /IN THE BLOCK LIST STATUS WORD. /M055 HRCOL3, ISZ REG12 JMP HDRC /CYCLE TILL DONE /C054 JMP I HDRCOL /RETURN DF=LST FNC=. /FIRST NON-CODE LOCATION /A049 PAGE FIELD 4 /ASSEMBLES HERE, RUNS IN FIELD 5 /A050 CDFMYF=CDFLP /A050 CDFVFD=6231 /A050 *200 /A050 STABUF, 0 /HARD DISK READ STATUS BUFFER /A054 CYLNO, 0 /CYLINDER NUMBER /A054 HEADNO, 0 /HEAD NUMBER /A054 SECTNO, 0 /SECTOR NUMBER /A054 CPVNO, 0 /CONTROLLER PROGRAM VERSION NUMBER /A054 /IOAEX - SUBORDINATE SUBROUTINE TO IOAOUT IN FIELD 3. IOAEX IS LOADED /A042 / AND CALLED BY IOAOUT. IOAEX CALLS IOACAL, THEN RETURNS. /A042 / /A042 IOAEX, XX /A042 CIFMNU /POINT TO THE MENU FIELD /A042 JMS I IOACAL /CALL IOA /A042 IOAARG, 0 /OUTPUT COMMAND /A042 0 /FIRST IOA ARGUMENT /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 0 /IOA ARGUMENT OR NO-OP INSTRUCTION /A042 CIF CDFVFD /RETURN TO FIELD 3 /A042 JMP I IOAEX /RETURN TO CALLER /A042 IFDEF ENGLSH < VSMALL, TEXT '^P&THE ^S ASSIGNED TO ^S !D IS TOO SMALL.^S' /C054 VUNASG, TEXT '^P&THERE IS NO ^S ASSIGNED TO ^S !D.^S' /C054 SLSDEV, TEXT '/DEVICE' /A044 SLSVOL, TEXT '/VOLUME' /A044 VASKNB, TEXT '^P!E&TYPE THE NUMBER OF THE ^S^S THAT CONTAINS THE ' /C054 *.-1 /A042 TEXT '^S^S^PYOU WANT TO RECEIVE THE COPY' /C044 VPRTGM, /A027 TEXT '^P&AND PRESS &R&E&T&U&R&N ' /A027 *.-1 TEXT "^P&O&R &PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU." /M045 VBDNBR, TEXT '^P!E^S^S NUMBERS MUST BE 0 TO !D.^S' /A054 VUSDFD, TEXT '^P&USE A ^S^S OTHER THAN "!D" ON OUTPUT.^S' /C054 > IFDEF SPANISH < VSMALL, TEXT '^P&EL ^S ASIGNADO AL ^S !D ES MUY PEQUE\QO.^S' VUNASG, TEXT '^P&NO HAY ^S ASIGNADO A ^S !D.^S' SLSDEV, TEXT '/DISPOSITIVO' SLSVOL, TEXT '/VOLUMEN' VASKNB, TEXT '^P!E&TECLEE EL N\ZMERO DE ^S^S QUE CONTIENE EL ' *.-1 TEXT '^S^S^PQUE DESEA RECIBIR LA COPIA' VPRTGM, TEXT '^P&Y PULSE !&RET. ' *.-1 TEXT "^P&O &PULSE &DOR. !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL." VBDNBR, TEXT '^P!ELOS NUMEROS DE ^S^S HAN DE SER DE 0 A !D.^S' VUSDFD, TEXT '^P&USE ^S^S DISTINTO DE "!D".^S' > IFDEF DUTCH < VSMALL, TEXT '^P&^S TOEGEWEZEN AAN ^S NR. !D TE KLEIN.^S' /C054 VUNASG, TEXT '^P&GEEN ^S TOEGEWEZEN ^S NR. !D.^S' /C054 SLSDEV, TEXT '' /A044 SLSVOL, TEXT 'OF -GEBIED' /A044 VASKNB, TEXT '^P!E&TYP NUMMER VAN AANDRIJVER^S^S MET BESTEMMINGSDISKETTE^S^S.^P' VPRTGM, /A027 TEXT '^P&DRUK OP &R&E&T&U&R&N.' /A027 *.-1 TEXT "^P&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU."/M045 VBDNBR, TEXT '^P!E&NUMMER VAN AANDRIJVER^S^S MOET LIGGEN TUSSEN 0 EN !D.^S' /A054 VUSDFD, TEXT '^P&TYP ^S^SEEN ANDER NUMMER DAN "!D" ALS BESTEMMING.^S' /C054 > IFDEF ITALIAN < VSMALL, TEXT '^P&^S DEFINITO COME ^S !D TROPPO PICCOLO.^S' /C054 VUNASG, TEXT '^P&NON CI SONO ^S DEFINITI COME ^S !D.^S' /C054 SLSDEV, TEXT '/UNIT\@' /A044 SLSVOL, TEXT '/ARCHIVIO DOCUMENTI' /A044 VASKNB, TEXT /^P!E&INTRODURRE IL NUMERO DELL'^S^S CHE CONTIENE IL / /C054 *.-1 /A042 TEXT '^S^S^PDI COPIA' /C044 VPRTGM, /A027 TEXT '^P&PREMERE !&RITORNO ' /A027 *.-1 TEXT "^P&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE." /M045 VBDNBR, TEXT '^P!E^S^S DEVE ESSERE DA 0 A !D.^S' /A054 VUSDFD, TEXT /^P&USARE UN'^S^S DIVERSA DA "!D" IN USCITA.^S/ /C054 > PSCR, TEXT '^P!E' /A027 CPYMSG, IFDEF ENGLSH < TEXT /^P!L !D &DOCUMENTS &COPIED / > IFDEF SPANISH < TEXT /^P!L !D &DOCUMENTOS &COPIADOS / > IFDEF DUTCH < TEXT /^P!L !D &DOCUMENTEN &GEKOPIEERD./ > IFDEF ITALIAN < TEXT /^P!L !D &DOCUMENTI &COPIATI / > IFDEF CANADA < TEXT "^P!L !D &DOCUMENT(S) COPI[(S) " > IFDEF FRENCH < TEXT "^P!L !D &DOCUMENT(S) COPI[(S) " > /L.A.E IFDEF GERMAN < TEXT "^P!L !D KOPIERTE &DATEIEN " > IFDEF NORWAY < TEXT "^P!L !D DOKUMENTER KOPIERT " > IFDEF SWEDSH < TEXT "^P!L !D DOKUMENTER KOPIERAT " > IFDEF DANISH < TEXT "^P!L !D DOKUMENTER KOPIERET " > CPYMS1, /lines with *.-1 follwing them must contain an even # of chars IFDEF ENGLSH < TEXT '^P!E&REMOVE THE &SYSTEM ^S FROM ^S !D, ' /A045 CPYMSA, TEXT '^P&PLACE THE !S WHICH IS TO RECEIVE THE ' /A049 *.-1 /A049 TEXT 'COPY IN !S !D. ' /A049 > IFDEF SPANISH < TEXT '^P!E&RETIRE EL ^S &SISTEMA DEL ^S !D, ' /A045 CPYMSA, TEXT '^P&COLOQUE EL !S EN EL QUE RECIBIR\A LA ' /A049 *.-1 /A049 TEXT 'COPIA !S !D. ' /A049 > IFDEF DUTCH < TEXT '^P!E&HAAL DE SYSTEEM ^S UIT ^S !D, ' /A045 CPYMSA, TEXT '^P&ZET DE BESTEMMINGS !S IN !S !D.' /A049 > IFDEF ITALIAN < TEXT /^P!E&TOGLIERE DISCO SISTEMA DALL'UNIT\@ !D, / /A045 CPYMSA, TEXT /^P&INSERIRE IL SUPPORTO DI COPIA NELL'UNT\@ !D./ /A049 > IFDEF CANADA < TEXT "^P!E&RETIRER LA DISQUETTE-LOGICIEL DE " *.-1 TEXT "L'UNIT[ DE GAUCHE.^P&INS[RER LA DISQUETTE QUI DOIT" *.-1 TEXT " RECEVOIR LA COPIE DANS L'UNIT[ DE GAUCHE, " > IFDEF FRENCH < TEXT "^P!E&ENLEVEZ LA DISQUETTE SYST]ME DE L'UNIT[ 0^P" /M014 *.-1 TEXT "METTEZ LA DISQUETTE QUI DOIT RECEVOIR LA COPIE DANS L'UNIT[ 0, "/M014 > IFDEF GERMAN < TEXT "^P!E&DIE &SYSTEM &DISKETTE AUS DEM LI > IFDEF DANISH < TEXT "^P!E&FJERN SYSTEMDISKETTEN FRA VENSTRE STATION, " *.-1 TEXT "^P&PLACER DISKETTEN SOM SKAL MODTAGE KOPIEN I VENSTRE STATION." > CPYMSB, IFDEF ENGLSH < TEXT '^P&THE !S MOUNTED IN !S !D WILL RECEIVE THE COPY.'> /A049 IFDEF ITALIAN < TEXT '^P&THE !S MOUNTED IN !S !D WILL RECEIVE THE COPY.'> /A049 IFDEF SPANISH < TEXT '^P&EL !S MONTADO EN !S !D RECIBIR\A LA COPIA.'> /A049 IFDEF DUTCH < TEXT '^P&HET !S OP !S !D ONTVANGT DE KOPIE.'> /A049 CPYMS2, IFDEF ENGLSH < TEXT /^P!E...© &STOPPED / > /A054 IFDEF SPANISH < TEXT /^P!E...&COPIA &DETENIDA / > /A054 IFDEF DUTCH < TEXT /^P!E...&KOPIEERPROCEDURE GESTOPT. / > /A054 IFDEF ITALIAN < TEXT /^P!E...&COPIA &INTERROTTA / > /A054 IFDEF CANADA < TEXT "....ARR^ZT[(S) " > /M010 IFDEF FRENCH < TEXT "BLOQU[" > IFDEF GERMAN < TEXT "....ANGEHALTEN " > IFDEF NORWAY < TEXT "...STOPPET " > IFDEF SWEDSH < TEXT "...STOPPAT " > IFDEF DANISH < TEXT "...STOPPET " > CPYMS3, IFDEF ENGLSH < TEXT "^P!E&DISCARD THE NEW ^S, IT IS FAULTY." > /A045 IFDEF SPANISH < TEXT "^P!E&ELIMINE EL NUEVO ^S, EST\A AVERIADO." > /A045 IFDEF DUTCH < TEXT "^P!E&DE ^S IS ONBRUIKBAAR." > /A045 IFDEF ITALIAN < TEXT "^P!E&IL NOUVO ^S \H INUTILIZZABILE." > /A045 IFDEF CANADA < TEXT "^PDISQUETTE ENDOMMAGE[E, NE PLUS L'UTILISER" > /M010 IFDEF FRENCH < TEXT "^PMAUVAISE DISQUETTE, NE PLUS L'UTILISER" > IFDEF GERMAN < TEXT "^P&DISKETTE DEFEKT" > IFDEF NORWAY < TEXT "^P&DEFEKT DISKETT, M] IKKE BRUKES" /L.D.A > IFDEF SWEDSH < TEXT "^P&DEFEKT DISKETT, KAN INTE ANV[NDAS" /L.U.A > IFDEF DANISH < TEXT "^P&DEFEKT DISKETTE, KAN IKKE BRUGES" > CPYWM3, IFDEF ENGLSH < TEXT "^P!E&WRITE ERRORS. &SELECT A DIFFERENT ^S OR ^S FOR OUTPUT." >/A045 IFDEF ITALIAN < TEXT "^P!E&WRITE ERRORS. &SELECT A DIFFERENT ^S OR ^S FOR OUTPUT." >/A045 IFDEF SPANISH < TEXT "^P!E&ERRORES DE ESCRUTURA. &SELECCIONE UN ^S DIFERENTE O ^S." >/A045 IFDEF DUTCH < TEXT "^P!E&SCHRIJFFOUTEN. &KIES EEN ANDER(E) ^S OF ^S ALS BESTEMMING." >/A045 CPYMS5, IFDEF ENGLSH < TEXT /^P&THIS !S WILL BE OVERWRITTEN. / > /A049 IFDEF SPANISH < TEXT /^P&SE ESCRIBIR\A SOBRE ESTE !S. / > /A049 IFDEF DUTCH < TEXT /^P&BETREFFENDE !S ZAL WORDEN OVERSCHREVEN. / > /A049 IFDEF ITALIAN IFDEF CANADA < TEXT "ELLE SERA R[[CRITE. " > /M010 IFDEF FRENCH < TEXT "&CETTE DISQUETTE SERA R[[CRITE. " > /L.A.E, L.A.E IFDEF GERMAN < TEXT "&DIESE &DISKETTE WIRD ]BERSCHRIEBEN. " > /L.U.U. IFDEF NORWAY < TEXT "&DENNE DISKETT VIL BLI OVERSKREVET. " > IFDEF SWEDSH < TEXT "&DENNA DISKETT KOMMER ATT BLI \VERSKRIVEN. " /L.U.O > IFDEF DANISH < TEXT "&DENNE DISKETTE VIL BLIVE OVERSKREVET. " > CPYMS6, IFDEF ENGLSH < TEXT '^P&REPLACE THE &SYSTEM ^S IN ^S 0, THEN'> /A053 IFDEF ITALIAN < TEXT '^P&REPLACE THE &SYSTEM ^S IN ^S 0, THEN'> /A053 IFDEF SPANISH < TEXT '^P&CAMBIE EL ^S &SYSTEMA EN ^S 0, LUEGO'> /A053 IFDEF DUTCH < TEXT '^P&ZET DE SYSTEEM ^S IN ^S 0.'> /A053 IFDEF CANADA < TEXT "&R[INS[RER LA DISQUETTE-LOGICIEL DANS L'UNIT[ DE GAUCHE." > IFDEF FRENCH < TEXT "&REMETTEZ LA DISQUETTE SYST]ME DANS L'UNIT[ 0." > /L.G.E, L.A.E IFDEF GERMAN < TEXT "&SYSTEM &DISKETTE IM LINKEN &LAUFWERK ERSETZEN," *.-1 TEXT " UND" > IFDEF NORWAY < TEXT "&PLASSER P]NYTT SYSTEMDISKETTEN I VENSTRE " /L.D.A *.-1 TEXT "STASJON, OG RETURNER TIL &HOVEDMENYEN. " > IFDEF SWEDSH < TEXT "&L[GG TILLBAKA SYSTEMDISKETTEN I V[NSTRA " /L.U.A, L.U.A *.-1 TEXT "STATIONEN, OCH RETURNERA TIL &HUVUDMENYN. " > IFDEF DANISH < TEXT "&PLACER SYSTEMDISKETTEN IGEN I VENSTRE STATION, " *.-1 TEXT "OG RETURNER TIL &HOVEDMENUEN. " > IFDEF ENGLSH < CPYMS8, TEXT "!E^P&UNABLE TO ACCESS ^S !D." /A052 CPYMS9, TEXT "^P!E&CHECK THAT THE ^S EXISTS, " /A054 *.-1 TEXT " AND A ^S IS PROPERLY INSERTED.^P^S" /A054 CRSHM2, TEXT "^P!E&THE &DENSITIES OF BOTH ^SS &M&U&S&T BE THE &SAME.^S"/C054 > IFDEF SPANISH < CPYMS8, TEXT "!E^P&IMPOSIBLE ACCEDER A ^S !D." /A052 CPYMS9, TEXT "^P!E&COMPRUEBE QUE ^S EXISTE, " /A054 *.-1 TEXT " Y UN ^S EST\A INSERTADO CORRECTAMENTE.^P^S" /A054 CRSHM2, TEXT "^P!E&LA &DENSIDAD DE LOS DOS ^SS !&HA DE SUR LA MISMA.^S"/C054 > IFDEF DUTCH < CPYMS8, TEXT "!E^P&GEEN TOEGANG TOT ^S !D." /A052 CPYMS9, TEXT "^P!E&CONTROLEER OF DE ^S BESTAAT, " /A054 *.-1 TEXT " EN DE ^S JUIST IS INGEZET.^P^S" /A054 CRSHM2, TEXT "^P!E&DE ^SS MOETEN DEZELFDE DICHTHEID EN OMVANG HEBBEN.^S"/C054 > IFDEF ITALIAN < CPYMS8, TEXT "!E^P&IMPOSSIBLE UTILIZZARE ^S !D." /A052 CPYMS9, TEXT "^P!E&CONTROLLARE SE ^S EXISTE, " /A054 *.-1 TEXT " AND A ^S IS PROPERLY INSERTED.^P^S" /A054 CRSHM2, TEXT "^P!E&LA DENSITA DI ENTRAMBI I DISCHETTI DEVE ESSRE LA STESSA^S^S"/C054 > DECNUM, TEXT /!P!D/ /A055 / DOCDL, IFDEF ENGLSH < TEXT /!P!E&DOCUMENTS #'S NOT COPIED:/ > /A055 IFDEF SPANISH < TEXT /!P!E&DOCUMENTOS #'S NO COPIADOS:/ > /A055 IFDEF DUTCH < TEXT /!P!E&GEWISTE DOCUMENTEN:/ > /A055 IFDEF ITALIAN < TEXT /!P!E&DOCUMENTS #'S NOT COPIED:/ > /A055 IFDEF CANADA < TEXT "^P&DOCUMENTS D[TRUITS: ^P" > /L.A.E IFDEF FRENCH < TEXT "^P&DOC. D[TRUIT(S) :^P" > /L.A.E IFDEF GERMAN < TEXT "^PGEL\SCHTE &DATEIEN: ^P" > /L.U.O. IFDEF NORWAY < TEXT "^P&DOKUMENTER FJERNET: ^P" > IFDEF SWEDSH < TEXT "^P&STRYKNA DOKUMENTER: ^P" > IFDEF DANISH < TEXT "^P&DOKUMENTER FJERNET: ^P" > SNDCOM, TEXT /, / /A055 /Various prompts (and pieces of prompts) for action from the user / IOATSP, TEXT '^P' /M042 / /Various screen messages / VSCRN0, IFDEF ENGLSH < TEXT /^P!E&CHECKING FOR READABILITY.../ /A054 > IFDEF SPANISH < TEXT /^P!E&COMPROBANDO FIABILIDAD.../ /A054 > IFDEF ITALIAN < TEXT /^P!E&CHECKING FOR READABILITY.../ /A054 > IFDEF CANADA < TEXT "^P&V[RIFICATION DE LA LISIBILIT[ DE LA DISQUETTE..." > IFDEF FRENCH < /REMOVED:/ TEXT "^P&V[RIFICATION DE LA DISQUETTE COPI[E..." /L.A.E, L.A.E > IFDEF DUTCH < TEXT "^P&LEESBAARHEIDSTEST..." > IFDEF GERMAN < TEXT "^P&DISKETTE WIRD AUF &LESEFEHLER GEPR]FT" /L.U.U. > IFDEF NORWAY < TEXT "^P&KONTROLLERER DISKETTEN M.H.T. LESBARHET..." > IFDEF SWEDSH < TEXT "^P&KONTROLLERAR DISKETTEN F\R L[SBARHET..." /L.U.A > IFDEF DANISH < TEXT "^P&KONTROLLERER DISKETTEN FOR LESBARHED..." > VSCRN1, IFDEF ENGLSH < TEXT /^P!E^P&VERIFY !S &STRUCTURE / > /A049 IFDEF SPANISH < TEXT /^P!E^P&VERIFIUE &ESTRUCTURA DE !S / > /A049 IFDEF DUTCH < TEXT /^P!E^P&CONTROLE VAN DE !S-INDELING / > /A049 IFDEF ITALIAN < TEXT /^P!E^P&VERIFA &INTEGRIT\@ !S / > /A049 IFDEF CANADA < TEXT "^P!E^P&UTILITAIRE DE V[RIFICATION DE DISQUETTE " > /L.A.E IFDEF FRENCH < TEXT "^P!E^P&V[RIFICATION DE LISIBILIT[ DE LA DISQUETTE " /L.A.E > IFDEF GERMAN < TEXT "^P!E^P&DISKETTE PR]FEN " > /L.U.U. IFDEF NORWAY < TEXT "^P!E^P&KONTROLL AV DISKETTENS ANVENDBARHET " > IFDEF SWEDSH < TEXT "^P!E^P&KONTROLL AV DISKETTENS ANV[NDBARHET " > /L.U.A IFDEF DANISH < TEXT "^P!E^P&KONTROL AF DISKETTENS ANVENDBARHED " > VSCRN2, IFDEF ENGLSH < TEXT /^P!D BLOCKS CHECKED, !D ERRORS DETECTED./ > IFDEF SPANISH < TEXT /^P!D BLOQUE COMPROBADOS, !D ERRORES DETECTADOS./ > IFDEF ITALIAN < TEXT /^PCONTROLLATI !D BLOCCHI, TROVATI !D ERRORS./ > IFDEF CANADA < TEXT "^P!D BLOCS V[RIFI[S, !D ERREUR(S) D[CEL[E(S)"/L.A.E, L.A.E > IFDEF FRENCH < TEXT "^P!D &BLOC(S) V[RIFI[(S), !D &ERREUR(S) D[TECT[E(S)" /L.A.E, L.A.E, L.A.E > IFDEF DUTCH < TEXT "^P!D &BLOKKEN GETEST, !D FOUTEN GEVONDEN." > IFDEF GERMAN < TEXT "^P!D &GEPR]FTE &BL\CKE, !D ENTDECKTE &FEHLER" /L.U.U., L.U.O. > IFDEF NORWAY < TEXT "^P!D BLOKKER KONTROLLERT, !D FEIL FUNNET." > IFDEF SWEDSH < TEXT "^P!D BLOCK KONTROLLERADE, !D FEL UPPT[CKTA." > IFDEF DANISH < TEXT "^P!D BLOKKE KONTROLLERET, !D FEJL OPDAGET." > VSCRN3, IFDEF ENGLSH < TEXT /^P&CHECKING DOCUMENT !D.../ > IFDEF SPANISH < TEXT /^P&COMPROBANDO DOCUMENTO !D.../ > IFDEF DUTCH < TEXT /^P&CONTROLE VAN DOCUMENT !D.../ > IFDEF ITALIAN < TEXT /^P&CONTROLLO DOCUMENTO !D.../ > IFDEF CANADA < TEXT "^P&V[RIFICATION DU DOCUMENT !D..." > /L.A.E IFDEF FRENCH < TEXT "^P&V[RIFICATION DU DOCUMENT !D..." > /L.A.E IFDEF GERMAN < TEXT "^P&PR]FEN &DATEI !D..." > /L.U.U. IFDEF NORWAY < TEXT "^P&KONTROLLERER DOKUMENT !D..." > IFDEF SWEDSH < TEXT "^P&KONTROLLERAR DOKUMENT !D..." > IFDEF DANISH < TEXT "^P&KONTROLLERER DOKUMENT !D..." > VSCRN7, IFDEF ENGLSH < TEXT /^P!E!S "^A" HAS !D DOCUMENTS, !D FREE BLOCKS, !D / /A054 *.-1 TEXT / UNREADABLE BLOCKS./ /C045 > IFDEF SPANISH < TEXT /^P!E!S "^A" TIENE !D DOCUMENTOS, !D BLOQUES LIBRES, !D / /A054 *.-1 TEXT / BLOQUES QUE NO SE PUEDEN LEER./ /C045 > IFDEF DUTCH < TEXT /^P!E!S "^A" BEVAT !D DOCUMENTEN, !D VRIJE EN !D / /A054 *.-1 TEXT / ONLEESBARE BLOKKEN./ /C045 > IFDEF ITALIAN < TEXT /^P!E "^A" CONTIENE !D DOCUMENTI, !D BLOCCHI LIBERI, !D / /A054 *.-1 TEXT / BLOCCHI INUTILIZZABILI./ /C045 > IFDEF CANADA < TEXT '^P&LA DISQUETTE "^A" CONTIENT !D DOCUMENTS, !D BLOCS LIBRES ET !D' > IFDEF FRENCH < TEXT '^P&LA DISQUETTE "^A" A !D DOCUMENT(S),' *.-1 TEXT " !D BLOCS LIBRES, !D BLOC(S) ILLISIBLE(S)" > IFDEF GERMAN < TEXT '^P&LAUFWERK "^A" ENTH[LT !D &DATEIEN, !D' /L.U.A *.-1 TEXT " FREIE &BL\CKE, !D NICHT LESBARE &BL\CKE" /L.U.O, L.U.O > IFDEF NORWAY < TEXT '^P&DISKETT "^A" HAR !D DOKMNT, !D UBRUKTE BLOKKER, ' *.-1 TEXT "!D ULESBARE BLOKKER." > IFDEF SWEDSH < TEXT '^P&DISKETT "^A" HAR !D DOKMT, !D LEDIGA BLOCK, !D OL[SBARA BLOCK.' /L.U.A > IFDEF DANISH < TEXT '^P&DISKETTE "^A" HAR !D DOKMNT, !D LEDIGE BLOKKE, ' *.-1 TEXT "!D UL[SBARE BLOKKE." /"ae" > VSCRNC, IFDEF ENGLSH < TEXT /^P&CHECKING CONSISTENT BLOCK USAGE.../ > IFDEF SPANISH < TEXT /^P&COMPROBANDO CONSISTENCIA DE USE DE BLOQUES.../ > IFDEF ITALIAN < TEXT /^P&CHECKING CONSISTENT BLOCK USAGE.../ > IFDEF CANADA < TEXT "^P&V[RIFICATION D'UN USAGE COH[RENT DES BLOCS..." > /L.A.E, L.A.E IFDEF FRENCH < TEXT "^P&V[RIFICATION DES BLOCS UTILIS[S..." > /L.A.E, L.A.E IFDEF DUTCH < TEXT "^P&CONTROLE OP BLOKGEBRUIK..." > IFDEF GERMAN < TEXT "^P&PR]FEN AUF &BLOCKBELEGUNG..." > /L.U.U IFDEF NORWAY < TEXT "^P&KONTROLLERER BRUK AV BLOKKER..." > IFDEF SWEDSH < TEXT "^P&KONTROLLERAR BRUK AV BLOCK..." > IFDEF DANISH < TEXT "^P&KONTROLLERER BRUG AF BLOKKE..." > VSCRND, IFDEF ENGLSH < /A014 TEXT '^P!E&PUT THE !S TO BE VERIFIED IN !S !D, ' /A049 > /A014 IFDEF SPANISH < /A014 TEXT '^P!E&COLOQUE EL !S QUE VERIFICAR\A EN !S !D, ' /A049 > /A014 IFDEF DUTCH < /A014 TEXT '^P!E&ZET DE TE CONTROLEREN !S IN !S !D. ' /A049 > /A014 IFDEF ITALIAN < /A014 TEXT /^P!E&INTRODURRE !S NELL'!S !D, / /A049 > /A014 IFDEF CANADA < TEXT "!E&INS[RER LA DISQUETTE ^Z V[RIFIER DANS L'UNIT[ DE DROITE " > IFDEF FRENCH < TEXT "!E&METTEZ LA DISQUETTE ^Z V[RIFIER DANS L'UNIT[ 1, " > /L.A.E, L.G.A, L.A.E, L.A.E IFDEF GERMAN < TEXT "!E&ZU PR]FENDE &DISKETTE INS RECHTE &LAUFWERK LEGEN, " /L.U.U > IFDEF NORWAY < TEXT "!E&PLASSER DISKETTEN SOM SKAL KONTROLLERES I H\YRE STASJON. " /L.PHI > IFDEF SWEDSH < TEXT "!E&L[GG DISKETTEN SOM SKA KONTROLLERAS I H\GRA STATION. " /L.U.A,L.U.O > IFDEF DANISH < TEXT "!E&PLACER DISKETTEN SOM SKAL KONTROLLERES I H\JRE STATION. " /L.PHI > VWSCD, IFDEF ENGLSH /A049 IFDEF ITALIAN /A049 IFDEF SPANISH /A049 IFDEF DUTCH /A049 VSCRNE, IFDEF ENGLSH < TEXT /&WHEN READY PRESS &R&E&T&U&R&N &O&R / > IFDEF SPANISH < TEXT /&CUANDO EST\I LISTO PULSE !&RETORNO &O / > IFDEF DUTCH < TEXT /&DRUK OP !&RETURN. / > IFDEF ITALIAN < TEXT /E PREMERE !&RITORNO O / > IFDEF CANADA < TEXT "ET APPUYER SUR &RETOUR &O&U " / TEXT "&O&U " /HOPEFULLY ONLY THE OR IS NEEDED HERE > IFDEF FRENCH < TEXT "&SI TOUT EST CONFORME APPUYER SUR &RETOUR OU " > IFDEF GERMAN < TEXT "&RETURN DR]CKEN ODER " /L.U.U > IFDEF NORWAY < TEXT "&N]R DU ER FERDIG, TRYKK &RETUR ELLER " /L.D.A > IFDEF SWEDSH < TEXT "&N[R DU [R F[RDIG, TRYCK P] &RETUR ELLER " /L.U.A, L.U.A, L.U.A, L.D.A > IFDEF DANISH < TEXT "&N]R DU ER F[RDIG, TRYK &RETUR ELLER " /L.D.A > VSCRNF, IFDEF ENGLSH < TEXT /^P!E&NO ERRORS FOUND. / > /A045 IFDEF SPANISH < TEXT /^P!E&NO ERRORS FOUND. / > /A045 IFDEF ITALIAN < TEXT /^P!E&NO ERRORS FOUND. / > /A045 IFDEF CANADA < TEXT "!E&AUCUNE ERREUR D[CEL[E" > /L.A.E, L.A.E IFDEF FRENCH < TEXT "!E&SANS ERREUR." > IFDEF DUTCH < TEXT "!E&GEEN FOUTEN GEVONDEN. " > IFDEF GERMAN < TEXT "!E&KEINE &FEHLER GEFUNDEN. " > IFDEF NORWAY < TEXT "!E&INGEN FEIL FUNNET," > IFDEF SWEDSH < TEXT "!E&INGA FEL UPPT[CKTA," > IFDEF DANISH < TEXT "!E&INGEN FEJL FUNDET," > VSCRNG, IFDEF ENGLSH < TEXT /&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU. / > IFDEF SPANISH < TEXT /&PULSE &DOR. !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL. / > IFDEF DUTCH < TEXT /&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET MENU. / > IFDEF ITALIAN < TEXT /PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE. / > IFDEF CANADA < TEXT "APPUYER SUR &GOLD &MENU POUR RAPPELER LE &MENU PRINCIPAL." > IFDEF FRENCH < TEXT "&TAPER &GOLD &MENU POUR RAPPELER LE &MENU PRINCIPAL" > IFDEF GERMAN < TEXT "MIT &GOLD &MEN] ZUR]CK ZUM &HAUPT &MEN]." /L.U.U, L.U.U, L.U.U > IFDEF NORWAY < TEXT "TRYKK &GUL &MENY FOR ] F] &HOVEDMENYEN. " /L.D.A, L.D.A > IFDEF SWEDSH < TEXT "TRYCK P] &GUL &MENY F\R ATT F] &HUVUDMENYN. " /L.D.A, L.U.O, L.D.A > IFDEF DANISH < TEXT "TRYK &GUL &MENU FOR AT F] &HOVEDMENUEN. " /L.D.A > OPFUL, IFDEF ENGLSH < TEXT '^P!E&THERE IS NOT ENOUGH FREE SPACE ON THE !S TO FINISH. ' /A054 > IFDEF SPANISH < TEXT '^P!E& NO HAY SUFICIENTE ESPACIO EN EL !S PARA TERMINAR. ' /A054 > IFDEF DUTCH < TEXT '^P!E&ONVOLDOENDE RUIMTE OP !S OM VERDER TE GAAN. ' /A054 > IFDEF ITALIAN < TEXT '^P!E&THERE IS NOT ENOUGH FREE SPACE ON THE !S TO FINISH. ' /A054 > IFDEF CANADA < TEXT "^P!E&PLUS D'ESPACE LIBRE SUR LA DISQUETTE POUR TERMINER." > IFDEF FRENCH < TEXT "^P!E&IL N'Y A PLUS ASSEZ DE PLACE SUR LA DISQUETTE." > IFDEF GERMAN < TEXT "^P!E&NICHT GEN]GEND FREIER &PLATZ AUF DER &DISKETTE." /L.U.U > IFDEF NORWAY < TEXT "^P!E&DET ER IKKE NOK PLASS P] DISKETTEN TIL ] BLI FERDIG." /L.D.A, L.D.A > IFDEF SWEDSH < TEXT "^P!E&DET [R INTE PLATS P] DISKETTEN F\R ATT BLIVE F[RDIG." /L.U.A, L.D.A, L.U.A, L.U.O, L.U.A > IFDEF DANISH < TEXT "^P!E&DET ER IKKE PLADS P] DISKETTEN TIL AT BLIVE F[RDIG." /L.D.A, "ae" > /D055VSCRNK, /D055IFDEF ENGLSH < TEXT /^P&REPEATING THE COPY A DIFFERENT WAY. / > /A045 /D055 /D055IFDEF ITALIAN < TEXT /^P&REPEATING THE COPY A DIFFERENT WAY. / > /A045 /D055IFDEF CANADA < TEXT "&REPRENDRE LA TRANSCRIPTION DIFF[REMMENT" > /L.A.E /D055IFDEF FRENCH < TEXT "REFAIRE LA COPIE DIFF[REMMENT" > /L.A.E. /D055IFDEF DUTCH < TEXT "NOGMAALS OP ANDERE WIJZE KOPI^ZREN " /L.U.E> /D055IFDEF GERMAN < TEXT "&DAS &KOPIEREN AUFS &NEUE VERSUCHEN " > /D055IFDEF NORWAY < TEXT "KOPIERER IGJEN P] ANNEN M]TE. " > /L.D.A, L.D.A /D055IFDEF SWEDSH < TEXT "KOPIERAR IGEN P] ANNAT S]TT. " > /L.D.A /D055IFDEF DANISH < TEXT "KOPIERER IGEN P] ANDEN M]DE. " > /L.D.A, L.D.A /D055 /D055VSCRNL, /D055IFDEF ENGLSH < /D055 TEXT /^P!E&THE COPY IS DONE, BUT YOU MUST / /D055*.-1 /D055 TEXT /REPEAT THE VERIFY ON THE NEW !S./ /A049 /D055> /D055IFDEF CANADA < /D055 TEXT "^P!E&LA TRANSCRIPTION EST FAITE, MAIS IL FAUT REPRENDRE " /D055*.-1 /D055 TEXT "LA V[RIFICATION DE LA NOUVELLE DISQUETTE." /D055> /D055IFDEF FRENCH < /D055 TEXT "^P!E&LA COPIE EST FINIE, REFAIRE LA " /D055*.-1 /D055 TEXT "V[RIFICATION DE LA NOUVELLE DISQUETTE "/L.A.E /D055> /D055IFDEF DUTCH < /D055 TEXT "^P!E&KOPI^ZREN GEREED, CONTROLEER NIEUWE DISKETTE "/L.U.E /D055> /D055IFDEF GERMAN < /D055 TEXT "^P!E&FERTIG MIT &KOPIEREN. &VERIFIZIEREN WIEDERHOLEN. " /D055> /D055IFDEF NORWAY < /D055 TEXT "^P!E&KOPIERINGEN ER FERDIG, MEN DU M] P]NYTT KONTROLLERE" /L.D.A, L.D.A /D055*.-1 /D055 TEXT " DEN NYE DISKETTEN" /D055> /D055IFDEF SWEDSH < /D055 TEXT "^P!E&KOPIERINGEN [R F[RDIG, MEN DU M]STE IGEN " /L.U.A, L.U.A, L.D.A /D055*.-1 /D055 TEXT "KONTROLLERA DEN NYA DISKETTEN" /D055> /D055IFDEF DANISH < /D055 TEXT "^P!E&KOPIERINGEN ER FERDIG, MEN DU M] IGEN KONTROLLERE" /L.D.A, L.D.A /D055*.-1 /D055 TEXT " DEN NYE DISKETTEN" /D055> VSCRNM, IFDEF ENGLSH < TEXT "^P!E&YOUR !S HAS ERRORS," /A049 *.-1 /A049 TEXT " TO CORRECT THEM YOU MUST COPY THE !S." /A049 > IFDEF SPANISH < TEXT "^P!E&YOUR !S HAS ERRORS," /A049 *.-1 /A049 TEXT " PARA CORREGIRLO SE HA DE COPIAR EL !S." /A049 > IFDEF DUTCH < TEXT "^P!E&!S HEEFT FOUTEN. &CORRIGEER DOOR VAN !S EEN KOPIE TE MAKEN." > IFDEF ITALIAN < TEXT "^P!E&YOUR !S HAS ERRORS," /A049 *.-1 /A049 TEXT " TO CORRECT THEM YOU MUST COPY THE !S." /A049 > IFDEF CANADA < TEXT "!E&VOTRE DISQUETTE CONTIENT DES ERREURS; POUR LA CORRIGER," *.-1 TEXT " APPUYER SUR &RETOUR" > IFDEF FRENCH < TEXT "!E&VOTRE DISQUETTE A DES ERREURS, " *.-1 TEXT "POUR LES ENLEVER, COPIER LA DISQUETTE" > IFDEF GERMAN < TEXT "!E&IHRE &DISKETTE IST FEHLERHAFT, " *.-1 TEXT "ZUR &KORREKTUR DIE &DISKETTE KOPIEREN." > IFDEF NORWAY < TEXT "!E&DIN DISKETT HAR FEIL," *.-1 TEXT " FOR ] RETTE DISSE M] DU KOPIERE DISKETTEN. " /L.D.A, L.D.A > IFDEF SWEDSH < TEXT "!E&DIN DISKETT HAR FEL, " *.-1 TEXT "F\R ATT KORRIGERA M]STE DU KOPIERA DISKETTEN. " /L.U.O, L.D.A > IFDEF DANISH < TEXT "!E&DIN DISKETTE HAR FEJL, " *.-1 TEXT "FOR ] KORRIGERE DISSE M] DU KOPIERE DISKETTEN. " /L.D.A, L.D.A > VSCRNN, IFDEF ENGLSH < TEXT /&TO DO THIS PRESS &R&E&T&U&R&N &O&R / > IFDEF SPANISH < TEXT /&PARA HACER ESTO, PULSE !&RETORNO &O / > IFDEF DUTCH < TEXT /&DRUK HIERVOOR OP !&RETURN. / > IFDEF ITALIAN < TEXT /&TO DO THIS PRESS &R&E&T&U&R&N &O&R / > IFDEF CANADA < TEXT "&APPUYER SUR &RETOUR AFIN DE LA RECOPIER &O&U " /M010 > IFDEF FRENCH < TEXT "EN APPUYANT SUR &RETOUR OU " > IFDEF GERMAN < TEXT "&DAZU &RETURN DR]CKEN ODER " /L.U.U. > IFDEF NORWAY < TEXT "&FOR ] GJ\RE DETTE, TRYKK &RETUR ELLER " /L.D.A, L.PHI > IFDEF SWEDSH < TEXT "&F\R ATT G\RA DETTA, TRYCK P] &RETUR ELLER" /L.U.O, L.U.O, L.D.A > IFDEF DANISH < TEXT "&FOR ] LAVE DETTE, TRYK &RETUR ELLER" /L.D.A > VSNULL, 0000 /The null text IFDEF ENGLSH < CBLKNB, TEXT '^P!L&CHECKING BLOCK NUMBER !D' /C054 ISDRVE, TEXT '&DRIVE' /A042 ISDEV, TEXT '&DEVICE' /A042 ISVOL, TEXT '&VOLUME' /A042 ISDSKT, TEXT '&DISKETTE' /A042 UTMSG, TEXT '^P!E&VERIFY COMPLETED ON THIS &UTILITY !S.' /A053 BEWARE, TEXT '^P!E**&CAUTION** &THIS !S MAY NOT BE IN &W&P&S FORMAT.'/A054 EXBLK, TEXT '^P!E&ONLY THE FIRST 2000 BLOCKS WILL BE CHECKED.' /A054 NOT0V, TEXT '^P!E© IS NOT PERMITTED TO THE SYSTEM ^S.^S' /A054 NORX50, TEXT '^P!E&THE IMAGE IN ^S !D IS TOO LARGE FOR A ^S.' /A054 NORX5A, TEXT '^P!E&USE A MOUNTED ^S YOU NO LONGER NEED WITH !D BLOCKS OR MORE.' TRYAGN, TEXT ' &TRY AGAIN.' /A054 FMTERR, TEXT '^P &ERROR &CYLINDER &HEAD &SECTOR'/A054 HDERR, TEXT '^P!D^P!D' /A054 PTRCPY, TEXT '^P&PLEASE PRESS &PRINT &SCREEN TO RECORD THE ERROR INFORMATION.' > IFDEF ITALIAN < CBLKNB, TEXT '^P!L&CHECKING BLOCK NUMBER !D' /C054 ISDRVE, TEXT 'UNIT\@' /A042 ISDEV, TEXT 'UNIT\@' /A042 ISVOL, TEXT 'SUPPORTO' /A042 ISDSKT, TEXT 'SUPPORTO' /A042 UTMSG, TEXT '^P!E&VERIFY COMPLETED ON THIS &UTILITY !S.' /A053 BEWARE, TEXT '^P!E**&CAUTION** &THIS !S MAY NOT BE IN &W&P&S FORMAT.'/A054 EXBLK, TEXT '^P!E&ONLY THE FIRST 2000 BLOCKS WILL BE CHECKED.' /A054 NOT0V, TEXT '^P!E© IS NOT PERMITTED TO THE SYSTEM ^S.^S' /A054 NORX50, TEXT '^P!E&THE IMAGE IN ^S !D IS TOO LARGE FOR A ^S.' /A054 NORX5A, TEXT '^P!E&USE A MOUNTED ^S YOU NO LONGER NEED WITH !D BLOCKS OR MORE.' TRYAGN, TEXT ' &TRY AGAIN.' /A054 FMTERR, TEXT '^P &ERROR &CYLINDER &HEAD &SECTOR'/A054 HDERR, TEXT '^P!D^P!D' /A054 PTRCPY, TEXT '^P&PLEASE PRESS &PRINT &SCREEN TO RECORD THE ERROR INFORMATION.' > IFDEF SPANISH < CBLKNB, TEXT '^P!L&COMPROBANDO BLOQUE N\ZMERO !D' ISDRVE, TEXT '&UNIDAD' ISDEV, TEXT '&DISPOSITIVO' ISVOL, TEXT '&VOLUMEN' ISDSKT, TEXT '&DISKETTE' UTMSG, TEXT '^P!E&VERIFICACION TERMINADA EN ESTE !S &UTILITY.' BEWARE, TEXT '^P!E**&PRECAUCI\SN** &ESTE !S PUEDE NO TENER FORMATO &W&P&S.' EXBLK, TEXT '^P!E&S\SLO SE COMPROBAR\AN LOS PRIMEROS 2000 BLOQUES.' NOT0V, TEXT '^P!E&LA COPIA NO EST\A PERMITIDA EN ESTE ^S SISTEMA.^S' NORX50, TEXT '^P!E&LA IMAGEN EL EL ^S !D ES MUY GRANDE PARA UN ^S.' NORX5A, TEXT '^P!E&USE UN ^S INNECESARIO CON !D BLOQUES O M\AS.' TRYAGN, TEXT ' &INT\INTELO OTRA VEZ.' FMTERR, TEXT '^P &ERROR &CILINDRO &CABEZA &SECTOR' HDERR, TEXT '^P!D^P!D' /A054 PTRCPY, TEXT '^P&PULSE &IMPRIMIR &PANTALLA PARA REGISTRAR LA ' *.-1 TEXT 'INFORMACI\SN DE ERROR.' > IFDEF DUTCH < CBLKNB, TEXT '^P!L&BLOK NUMMER !D WORDT GECONTROLEERD.' ISDRVE, TEXT 'AANDRIJVER' /A042 ISDEV, TEXT 'AANDRIJVER' /A042 ISVOL, TEXT 'GEBIED' /A042 ISDSKT, TEXT 'DISKETTE' /A042 UTMSG, TEXT '^P!E&CONTROLE OP !S VOLTOOID.' /A053 BEWARE, TEXT '^P!E--&OPGELET-- &!S MOGELIJK NIET IN &W&P&S GEFORMATTEERD.'/A054 EXBLK, TEXT '^P!E&ALLEEN DE EERSTE 2000 BLOKKEN WORDEN GECONTROLEERD.' /A054 NOT0V, TEXT '^P!E&KOPIE NAAR SYSTEEM^S NIET TOEGESTAAN.^S' /A054 NORX50, TEXT '^P!E&KOPIE IN ^S !D TE GROOT VOOR ^S.' /A054 NORX5A, TEXT '^P!E&GEBRUIK EEN ^S MET !D OF MEER BLOKKEN.' TRYAGN, TEXT ' &PROBEER OPNIEUW.' /A054 FMTERR, TEXT '^P &FOUT &CYLINDER &KOP &SECTOR'/A054 HDERR, TEXT '^P!D^P!D' /A054 PTRCPY, TEXT '^P&DRUK OP !&SCHERMAFDRUK OM DE INFORMATIE VAST TE LEGGEN.'/A054 > LUC=.-1 /LAST LOCATION USED /A049   / MNCOM - COMMON SYSTEM MENU'S XLIST / 037 EMcD 22-Apr-85 Change display for Cuu symbol / 036 WCE 20-AUG-84 ADDED TEXT FOR AUTODIAL DIRECTORY DOCUMENT / 035 WCE 14-AUG-84 CHANGES FOR RD MENU ADDITIONS / 034 WJY 03-AUG-84 Update user dictionary support / 033 HLP 12-JUL-84 Use X05 page for printer messages / 032 JFS 06-JUN-84 FOOTNOTING changes for SBB / 031 WCE 13-MAY-84 Made space in menus by using MXDISP statements / Made changes for BRITISH date and currency / Added SYSTEM wide terminal reset routine / 030 SBB 30-MAR-84 ADDED TEXT FOR FOOTNOTES ETC / 029 TCW 27-MAR-84 Add PHONE capability / 028 WCE 19-FEB-84 SPLIT MNCOM OFF FROM MN1 AND MADE IT SEPARATE / ADDED BLOCKS FOR MXDISP TEXT MENU BLOCKS / CLEANED UP LISTING AND REMOVED OLD EDIT HISTORY / 027 WJY 06-FEB-84 DECmate I compatability / 026 WCE 19-JAN-84 Changed location of MM1S in MN1 / / THIS FILE CONTAINS 3 THINGS - / / - TEXT STRINGS FOR USE WITH THE NEW MXDISP MENU STATEMENT - THIS MENU / OPERATOR WILL ALLOW TWO MENU BLOCKS TO BE IN USE AT THE SAME TIME. / THERE IS A RESTRICTION IN THAT THIS SECOND MENU BLOCK CAN ONLY CONTAIN / TEXT STRINGS THAT HAVE NO PRAMATERS. THAT MEANS THAT YOU CAN NOT / USE ANY OF THE ^ OR ! FUNCTIONS THAT TAKE PRAMETERS. THE ADVANTAGE / IS THAT THE MAIN MENU BLOCK CAN ACT AS A CONTROL BLOCK THAT CALLS / TEXT STATEMENTS TO BE DISPLAYED ON THE SCREEN. / / - MENUS USED BY BOTH PARTS OF THE ASSEMBLY - THESE ARE LIKE A / 'SUBROUTINE' LIBRARY. THIS WORKS BECAUSE ALL REFERENCES TO SYMBOLS IN / OTHER MENUS (OUTSIDE THOSE CONTAINED IN THIS FILE) HAVE BEEN ELIMINATED. / / - SYMBOLS FOR 2 CRITICAL LOCATIONS - WHICH ARE USED THROUGHOUT BOTH PARTS. / THESE CANNOT BE ELIMINATED WITHOUT ASSEMBLING ALL PARTS AT ONCE. WHILE / THE NEED FOR THESE SYMBOLS WAS 'DESIGNED IN', IT SHOULD BE POSSIBLE TO / AVOID FURTHER SUCH SINS. / MM1S=0 / RETURN-TO-MAIN-MENU LOCATION PP2ER=0 / UNABLE-TO-CREATE ERROR, NEEDED FOR MENU / LEVEL 'CREATE' OPERATOR FIELD 1 / FIELD TO BEGIN LOADING MENU'S INTO *0 / LOCATION IN FEILD TO LOAD MENU'S INTO / CANNED ROUTINES MENU START RELOC ADMCR1=. X=DLMCR1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /*************************************************************************** /**** SYSTEM WIDE ROUTINE TO SET TERMINAL ESCAPE SEQUENCES **** /*************************************************************************** CR1EEQ, IFDEF ENGLSH < TSTBIT;MNFMAT;MNFM0X!MNFM1X;CR1EQ1 / CHECK IF INITIALIZED /A031 SET;"B&77^100;MNLANG / SET AMERICAN CHARACTER SET /A031 TSTBIT;MNFMAT;MNFM2X;CR1EQ2 / CHECK FOR BRITISH SET /A031 CR1EQ1, SET;"A&77^100;MNLANG / SET BRITISH CHARACTER SET /A031 > / END IFDEF ENGLSH /A031 IFDEF GERMAN < SET;"K&77^100;MNLANG > /A031 IFDEF FRENCH < SET;"R&77^100;MNLANG > /A031 IFDEF CANADA < SET;"3&77^100;MNLANG > /A031 IFDEF ENGCAN < SET;"3&77^100;MNLANG > /A031 IFDEF DUTCH < SET;"4&77^100;MNLANG > /A031 CR1EQ2, DISP;0;TEXT '!E^S&^S^A^S';CR1EQ3;MNLANG;CR1EQ4;CR1EQ5 /A031 RETURN / RETURN TO CALLER /A031 CR1EQ3, IFDEF CONDOR < TEXT '![[62;1"P!CO![(&' > /A031 IFNDEF CONDOR < TEXT '!CO![(&' > /A031 / ESC [ 6 2 ; 1 " p Set level 2 firmware /A031 / CTRL O Shift in to select G0 ROM /A031 / ESC ( & (A,B,K,R,3,4) Load Language set into G0 ROM /A031 CR1EQ4, IFDEF CONDOR < /A031 ESC; "*; 74 / Set G2 as DEC Multinational /A031 ESC; "+; 76 / SET G3 as Technical Character Set > / END IFDEF CONDOR /A031 0 / END OF LIST IDENTIFIER (MUST BE HERE) CR1EQ5, TEXT '![)0![[?3L![[?1;8H![[0M![='/ SEQUENCES DESCRIBED BELOW /A031 / ESC ) 0 Load Graphics ROM /A031 / ESC [ ? 3 l CLEAR 132 COLUMN MODE /A031 / ESC [ ? 1 ; 8 h APPLICATION MODE AUTO REPEAT ENABLED / THESE MUST BE COMBINED TO WORK ON 278 / ESC [ 0 m ATTRIBUTES OFF /A031 / ESC = ENTER ALTERNATE KEYPAD MODE /A031 CR1BR, DISP;2000;TEXT '!E!CG' /M031 MXDISP;2205;X01NKO;DLMX01 / WHEN TYPING, USE NORMAL KEYS ONLY DISP;2305 IFDEF CONDOR < TEXT '&THE &RUBOUT ^A KEY CAN ALSO BE USED.';CR1BRK > / END IFDEF CONDOR IFNDEF CONDOR < TEXT '!&RUB !&CHAR AND !&RUB !&WORD CAN ALSO BE USED.' > / END IFNDEF CONDOR DISP; -1; TEXT ' &A LINE MAY CONTAIN A' MXDISP;2405;X01MAX;DLMX01 / MAXIMUM OF 71 CHARACTERS END WITH RETURN MXDISP;2605;X02PRA;DLMX02 / PRESS RETURN TO TRY AGAIN CR1RD, READ;MNTMP1;CR1BR ARG;CR1RT;MNTMP1 GOTO;CR1BR CR1BRK, 074; 130; 135; 0 /*************************************************************** / / CR1NM IS A SUBROUTINE USED TO PRINT THE RESULTS OF A / READ OPERATION FOLLOWED BY "HAS NO MEANING HERE" / CALLING SEQUENCE: / READ; MNTMP1; LABEL1 / . / . / CALL; CR1MN; LABEL2 / \--WHERE TO GO WHEN RETURN HIT / PARAMETERS: / MNTMP1 POINTER TO ARGUMENT BUFFER / (MNTMP1 IS LOST) / /*************************************************************** CR1NM, DISP;-2717;TEXT '!CG&TYPING "!A" HAS NO MEANING HERE. &TRY AGAIN.' MNTMP1 CR1RT, RETURN /*************************************************************** / / CR1BR IS A SUBROUTINE USED TO PRINT THE MESSAGE / "USE ONLY THE ... KEYS" WHEN ERRONEOUS GOLD HAS BEEN TYPED / CALLING SEQUENCE: / READ; MNTMP1; LABEL / . / . /LABEL, CALL; CR1MN; LABEL1 / \--WHERE TO GO WHEN RETURN HIT / PARAMETERS: / MNTMP1 POINTER TO ARGUMENT BUFFER / (MNTMP1 IS LOST) / /*************************************************************** CR1ND, DISP;2000;TEXT '!E!CG' /M031 IFDEF CONDOR < TSTBIT; MNOPTN; MNRX2X; CR1NW1 / CK. FOR WINCHESTER TRNSFR; CR2CKW; DLMCR2 CR1TS1, TSTBIT; MNOPTN; MNRX3X; CR1NW1 / BRANCH IF DRIVE CR1SET, SET; CR1ARA; CR1STR / CHANGE POINTER > / END IFDEF CONDOR CR1NW1, DISP; 2205; TEXT '&^S !D DOES NOT HAVE A DOCUMENT NAMED !A' CR1STR, CR1DOA; MNDRV; MNFNAM CR1ND1, MXDISP;2505;X02NAM;DLMX02 / PRESS RETURN TO TRY ANOTHER NAME. CR1RD1, READ;MNTMP1;CR1ND ARG;CR1RT;MNTMP1 GOTO;CR1ND CR1DOA, TEXT 'DRIVE' CR1ARA, TEXT 'DEVICE' XTRCR1=400-. IFZERO .-401&4000 /MORE CANED ROUTINES RELOC ADMCR2=. X=DLMCR2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / THIS CODE CALLED BY WPCUT MUST BE ON BLOCK BOUNDRY. CR2PE1, SET;0;MNTMP1 GOTO;CR2PE2 CR2PER, SET;1;MNTMP1 CR2PE2, DISP;0;TEXT '!E ' DISP;2505;TEXT '&DOCUMENT (!D.!D) !A IS ' MNDRV;MNDOCN;MNFNAM CASE;MNTMP1 1;CR2PE3 DISP;-1;TEXT 'ALREADY IN USE.' GOTO;CR2PE4 CR2PE3, DISP;-1;TEXT '^S';CR2WTP / SUBSTRING 'WAITING TO PRINT' CR2PE4, MXDISP;-2605;X02NAM;DLMX02 / PRESS RETURN TO TRY ANOTHER NAME. READ;MNTMP1;.+1 CR2RT, RETURN CR2QDE, SET;CR2SSE;CR2STR CR2QD, DISP;0;TEXT '!E ' DISP;1505;TEXT '&UNABLE TO ^S DOCUMENT (!D.!D) !A' CR2STR, .-. ;MNDRV; MNDOCN; MNFNAM CR2QDA, DISP;1705;TEXT '&IT IS^S &PRESS !&RETURN.!CG';CR2WTP CR2QD1, READ;MNTMP1;CR2QDA ARG;CR2RT;MNTMP1 GOTO;CR2QDA CR2SSE, TEXT 'EDIT' CR2SSP, TEXT 'PRINT' CR2SSD, TEXT 'DELETE' CR2WTP, TEXT ' WAITING TO PRINT.' CR2QDP, SET;CR2SSP;CR2STR GOTO;CR2QD CR2QDD, SET;CR2SSD;CR2STR GOTO;CR2QD CR2FQ, DISP;0000;TEXT '!E !CG' DISP;1505;TEXT '&THERE ARE ' CASE;MNQCPY;0;CR2FQ2 DISP;-1;TEXT 'NO ' CR2FQ2, DISP;-1;TEXT 'DOCUMENTS^S';CR2WTP DISP;1705;TEXT '&PRESS !&RETURN.' READ;MNTMP1;.+1 RETURN / WAS GOTO;CR2FQ IFDEF CONDOR < CR2CKW, CASE; MNDRV 0; -1-CR1NW1; DLMCR1 1; -1-CR1TS1; DLMCR1 TRNSFR; CR1SET; DLMCR1 > / END IFDEF CONDOR XTRCR2=400-. IFZERO .-401&4000 /COMMUNICATIONS MENUS RELOC ADMCM1=. X=DLMCM1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CM1S, / CALLED FROM "WPCX". COPY;MNFNO;MNTMP2 / Save "remembered file name". SET;0;MNFNO / Clear "remembered file name". SET;5;MNTMP1 / 5 for "RECEIVE THE TEXT" prompt. CALL;CM2DSP;DLMCM2 / Display prompt for doc to put to. COPY;MNTMP2;MNFNO / Restore "remembered file name". CM1RD, READ;MNTMP1;CM1RE FILNAM;CM1RD;CM1ND PQUEUE;CM1PER;.+1 / ERROR IF DOC IN PRINT QUEUE. SET;0;MNTMP4 GOTO;CM1NX CM1PER, CALL;CR2PER;DLMCR2 / DOCUMENT IS WAITING TO PRINT GOTO;CM1S CM1RE, CASE;MNSYSA EDMENU&3777;CM1MM CALL;CR1BR;DLMCR1 GOTO;CM1S CM1ND, SET;3;MNTMP1 RETURN CM1RET, CASE; MNTMP6 /FOR FOOTNOTING, DON'T RETURN /A032 12; CM1MM0 /GO DIRECTLY TO MM. DO NOT PASS WPCUT /A032 CM1MM, SET;2;MNTMP1 CASE;MNTMP4 1;CM1MM0 / 1 MEANS SL OPTION RETURN CM1MM0, TRNSFR;MM1S;DLMMM1 / BACK TO MAIN MENU /CM1NX is called from various MN1 and MN2 locations to display T-B-O menu. CM1RE1, CASE;MNSYSA EDMENU&3777;CM1RET CALL;CR1BR;DLMCR1 CM1NX, DISP;0;TEXT '!E' MXDISP;305;X03DNE;DLMX03 / DOCUMENT NAME ALREADY EXISTS, MXDISP;505;X03HMD;DLMX03 / HOW WOULD YOU LIKE TO MODIFY THIS DOCUMENT? MXDISP;705;X03TOP;DLMX03 / T = ADD TEXT AT THE TOP MXDISP;1105;X03BOT;DLMX03 / B = ADD TEXT TO THE BOTTOM MXDISP;1305;X03OVR;DLMX03 / O = OVERWRITE THE DOCUMENT MXDISP;2320;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN MXDISP;2520;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU CM1RD1, READ;MNTMP1;CM1RE1 ARG;CM1RD1;MNTMP1 KEYWRD TEXT 'T ';CM1BGN TEXT 'B ';CM1BOT TEXT 'O ';CM1TOP CALL;CR1NM;DLMCR1 GOTO;CM1RD1 CM1BGN, SET;0;MNTMP1 GOTO;CM1RT CM1TOP, SET;-1;MNTMP1 CM1RT, DISP;0;TEXT '!E' CASE;MNTMP4;0;CM1NRS CMND;1;200;CIF CDF 20 CM1NRS, RETURN CM1BOT, SET;1;MNTMP1 GOTO;CM1RT XTRCM1=400-. IFZERO .-401&4000 /COMMUNICATIONS MENU (CONT.) RELOC ADMCM2=. X=DLMCM2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CM2FNM, / Routine to check filename for validity COPY; MNPOS; MNTMP2 / Save input pointer. ARG; CM2FOK; MNTMP1 / if no arg then ok. NUMBER; MNTMP1; CM2FOK / if name (not number) then ok. ARG; CM2FOK; MNTMP1 / see if anything follows. if not ok. KEYWRD; TEXT'.';CM2LB1 / see if it's a dot. GOTO; CM2FOK / no dot so ok. CM2LB1, ARG; CM2NFO; MNTMP1 / dot & nothing follows. bad,bad,bad!!! CM2FOK, COPY; MNTMP2; MNPOS / restore filename pointer. SET; 1; MNTMP1 / Return 1 for OK return. RETURN / and return... CM2NFO, MXDISP;-2717;X01DNI;DLMX01 / DOCUMENT NUMBER OR FORMAT INCORRECT /M031 SET; 0; MNTMP1 / Return 0 for not OK return. RETURN / and then return. CM2DSP, DISP;0;TEXT '!E' CM2NCS, SET;1;CM2TXT / SET FLAG TO DISPLAY 'RECALL THE MAIN MENU' MXDISP;1503;X01TND;DLMX01 / TYPE NAME OF DOCUMENT YOU WANT TO /M031 CASE;MNTMP1 / TEST FOR DISPLAY. 0; CM2DS0 / 0 FOR DELETE. 1; CM2DS1 / 1 FOR PRINT. 2; CM2DS2 / 2 FOR EDIT. 3; CM2DS3 / 3 FOR SEND. 4; CM2DS4 / 4 FOR USE (LOGON MENU) 5; CM2DS5 / 5 FOR RECEIVE THE TEXT" (CX TO DOC) 6; CM2DS6 / 6 FOR SPELL CHECK. 7; CM2DS7 / 7 FOR LOAD USER DICTIONARY 10; CM2DS4 / 10 FOR USE (PHONE MENU) /A029 11; CM2DS4 / 11 FOR USE (LOGIN FOR PHONE) /A029 12; CM2D12 / 12 FOR FOOTNOTING /A030 13; CM2D13 / 13 FOR UPDATE USER DIRECTORY /A034 CM2D13, DISP;-1;TEXT 'UPDATE' /A034 GOTO;CM2CNT /A034 CM2D12, DISP;-1;TEXT 'FOOTNOTE' /A030 GOTO;CM2CNT /A030 CM2DS7, DISP;-1;TEXT 'LOAD' GOTO;CM2CNT CM2DS6, DISP;-1;TEXT 'CHECK' GOTO;CM2CNT CM2DS5, DISP;-1;TEXT 'RECEIVE THE TEXT' GOTO;CM2CX / DISPLAY "MENU" INSTEAD OF "MAIN MENU" CM2DS0, DISP;-1;TEXT 'DELETE' GOTO;CM2CNT CM2DS1, DISP;-1;TEXT 'PRINT' GOTO;CM2CNT CM2DS2, DISP;-1;TEXT 'EDIT' GOTO;CM2CNT CM2DS3, DISP;-1;TEXT 'SEND' CM2CX, SET;0;CM2TXT / SET FLAG TO DISPLAY 'RECALL THE MENU' GOTO;CM2CNT / CONTINUE CM2DS4, DISP;-1;TEXT 'USE' CM2CNT, DISP;-1;TEXT ', AND PRESS !&RETURN' CASE;MNFNO 0;CM2F0 MXDISP;1703;X02JPR;DLMX02 / JUST PRESS RETURN IF DOCUMENT DESIRED/M031 DISP;-1;TEXT '(!D.!D) !A';MNDRV;MNDOCN;MNFNAM CM2F0, CASE;CM2TXT / CHECK FOR DISPLAY TYPE 1;CM2F1 / IF 1 THEN DISPLAY 'MAIN' MXDISP;2103;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU. RETURN / RETURN TO CALLER. CM2F1, MXDISP;2103;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. RETURN / RETURN TO CALLER. CM2TXT, 0 / FLAG FOR DISPLAYING 'THE MENU' OR 'THE MAIN MENU' XTRCM2=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 1 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX01=. X=DLMX01 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 X01NKO, TEXT '&WHEN TYPING TO THE MENU, USE NORMAL KEYS ON THE KEYBOARD ONLY.' X01MAX, TEXT 'MAXIMUM OF 71 CHARACTERS AND MUST END WITH !&RETURN.' X01DNI, TEXT '&DOCUMENT NUMBER OR FORMAT INCORRECT.' X01TND, TEXT '&TYPE THE NAME OF THE DOCUMENT YOU WANT TO ' X01MAT, TEXT '&D&E&CMATE ' X01WPS, TEXT '&WORD &PROCESSING &SYSTEM' X01DEC, TEXT '&DIGITAL &EQUIPMENT &CORPORATION' X01FLD, TEXT '&FIELD &TEST ' X01VER, TEXT '&SOFTWARE &VERSION ' X01DAT, TEXT '&PLEASE TYPE THE DATE AND TIME AS FOLLOWS:' X01IDV, TEXT '&INTERNAL &DATA &VERSION ' /A035 X01NED, TEXT ' (NEED' /A035 *.-1 /A035 4000+ROMHIG-200 /A035 ROMMID-200^100+ROMLOW-200 /A035 TEXT ' OR HIGHER)' /A035 X01ROM, TEXT '&INTERNAL !&ROM &VERSION ' /A035 X01COR, TEXT '&CORRECT ERRORS BY PRESSING ' /A035 X01DON, TEXT '&WHEN DONE, PRESS !&RETURN.' /A035 XTRX01=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 2 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX02=. X=DLMX02 RELOC 0 X02APR, TEXT 'AND PRESS !&RETURN' /MX00A X02PGM, TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' /MX00B X02JPR, TEXT '!&OR &JUST PRESS !&RETURN IF THE DOCUMENT DESIRED IS ' /MX00C X02TLS, TEXT '&TYPE THE LETTER(S) AND THEN PRESS !&RETURN' /C034 /MX00D X02PRM, TEXT '&PRESS !&RETURN TO RECALL THE &MAIN &MENU' /MX00F X02MMM, TEXT '&M = &MORE MAIN MENU SELECTIONS...' /MX00G X02NAM, TEXT '&PRESS !&RETURN TO TRY ANOTHER NAME' /MX00H X02NUM, TEXT '&PRESS !&RETURN TO TRY ANOTHER NUMBER' /MX00I X02PRA, TEXT '&PRESS !&RETURN TO TRY AGAIN' /MX00J XTRX02=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 3 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX03=. X=DLMX03 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 X03DNE, TEXT '&DOCUMENT NAME ALREADY EXISTS,' /MX01A X03HMD, TEXT '&HOW WOULD YOU LIKE TO MODIFY THIS DOCUMENT?' /C /MX01B X03TOP, TEXT '&T = &ADD TEXT AT THE TOP' /MX01C X03BOT, TEXT '&B = &ADD TEXT TO THE BOTTOM' /MX01D X03OVR, TEXT '&O = &OVERWRITE THE DOCUMENT' /MX01E X03PGM, TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' /MX01F X03JPR, TEXT '!&OR &JUST PRESS !&RETURN TO RESUME EDITING' /MX01G X03TLR, TEXT '&TYPE THE LETTER AND THEN PRESS !&RETURN ' /C034 /MX00E X03GMM, TEXT '!&OR PRESS &GOLD !&MENU TO RECALL THE MENU.' /MX01H X03GME, TEXT '!&OR PRESS &GOLD !&MENU TO RECALL THE EDITOR MENU.' /MX01I X03PRR, TEXT '&PRESS !&RETURN TO RECALL THE MENU' /MX01J XTRX03=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 4 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX04=. X=DLMX04 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 X04SCM, TEXT '![(&A-- !&SET !&CONVENTIONS !&MENU --' X04ADD, TEXT '&A = &AUTODIAL &DIRECTORY &DOCUMENT' X04SYM, TEXT '&C = &CURRENCY &SYMBOL' X04DDN, TEXT '&D = &DICTIONARY &DRIVE/&DEVICE &NUMBER' X04ELD, TEXT '&E = &EASYCOM &LOGON &DOCUMENT' X04FOR, TEXT '&F = &DATE &FORMAT' X04MDT, TEXT '&M = &MAIN &DICTIONARY &TYPE' X04PDD, TEXT '&P = &PERSONAL &DICTIONARY &DOCUMENT' X04UDN, TEXT '&U = &UTILITY &SOFTWARE &DRIVE/&DEVICE &NUMBER' X04NON, TEXT '&NONE)' X04BRT, TEXT '&BRITISH)' X04USA, TEXT '&AMERICAN)' X04MAY, TEXT ' &MAY BE 1 TO 9, OR &NONE' X04CER, TEXT ' &C &MAY BE $, OR #' XTRX04=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 5 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX05=. X=DLMX05 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 X05DMY, TEXT '&DAY/&MONTH/&YEAR' /M035 X05MDY, TEXT '&MONTH/&DAY/&YEAR' /M035 X05YMD, TEXT '&YEAR/&MONTH/&DAY' /M035 X05USD, TEXT ' WITH &AMERICAN &DICTIONARY' /M037 /M035 X05UKD, TEXT ' WITH &BRITISH &DICTIONARY' /M037 /M035 X05ERD, TEXT ' !&DMY = ' /M035 X05ERM, TEXT ', !&MDY = ' /M035 X05ERY, TEXT ', !&YMD = ' /M035 X05NEP, TEXT '&NON EXISTENT PRINTER' XTRX05=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 6 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX06=. X=DLMX06 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 XTRX06=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 7 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX07=. X=DLMX07 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 XTRX07=400-. IFZERO .-401&4000 / MXDISP TEXT BLOCK NUMBER 10 /*************************************************************************** /**** N O T E **** /**** **** /**** THIS BLOCK IS RESERVED FOR MXDISP TEXT STATEMENTS **** /**** **** /**** DO NOT PUT REGULAR MENU CODE HERE, USE ANOTHER MENU BLOCK **** /*************************************************************************** RELOC ADMX10=. X=DLMX10 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 XTRX10=400-. IFZERO .-401&4000 XLIST   / MM1 - FIRST PART OF THE MENU DISPLAYS /196 KMD 14-Sep-85 Stop print screen on spell, backup, copy /195 Mart 02-aug-85 Add convert utility /194 Mart 22-jul-85 Allow copy file on same drive DM III /193 EMcD 13-Jul-85 Change Start up display for FAO (conditional) /192 EMcD 04-Jul-85 Stop PRint while Print screen active /191 EMcD 22-Apr-85 Remove Pound Currency option /190 RCME 27-MAR-85 Insert % operator for bold options / /------------------ All below refer to V2.0 and earlier -------------------- / /189 HLP 05-DEC-84 Fix bad msg always insert front sheet / due to MNTMP7 confusion / Fix WPSV2-59 again! /188 HLP 23-OCT-84 Fix WPSV2-335 RL bad name problem /187 WCE 19-OCT-84 Fix to incorrect DATE problem /186 DFB 19-OCT-84 Fix to graphics message(bug 260) /185 DFB 12-OCT-84 Fix when loading GRAPHICS(utility) don't allow / ......graphics on device 0 /184 HLP 09-OCT-84 Add EO to 2nd page of print menu (WPSV2-261) /183 HLP 07-OCT-84 Fix SL from Stop Print Menu (WPSV2-192) /182 DFB 20-SEP-84 Fix restart from F cmnd for non winnie /181 ah 07-SEP-84 FIX EDITS 175,177 /180 DFB 06-SEP-84 Fix to graphics message /179 WCE 20-AUG-84 CHANGES FOR AUTODIAL DOCUNEMT FILE NUMBER /178 WCE 16-AUG-84 DELETED REFFERENCRS TO MNUSER /177 AH 15-AUG-84 ADD VERIFY DISKETTE MESSAGE TO "MC-B" COMMAND /176 WCE 14-AUG-84 CHANGES FOR RD MENU ADDITIONS /175 AH 14-AUG-84 CHANGE TEXT LINE FOR "MC-S" COMMAND /174 WCE 14-AUG-84 CHANGE TO UNBUNDLING CODE FOR DECSPELL /173 HLP 08-AUG-84 SE Odd and Even Support /172 WJY 03-AUG-84 Update user dictionary support /171 HLP 12-JUL-84 Fix N at PRINTER NOT IN USE bug WPSV2-59 /170 HLP 10-JUL-84 R1 and R2 may not be the same bug WPSV2-41 /169 WJY 10-JUL-84 Fix load personal dictionary bugs /168 HLP 09-JUL-84 Change HOST,HPRT to CHST,CPTR in DD settings /167 JAC 29-JUN-84 100 UDK INTEGRATION /166 HLP 29-JUN-84 Install GDH Fix for New Page problems /165 WCE 13-JUN-84 ADDED MULTIPLE DRIVES FOR ACTIVATE FEATURES /164 HLP 24-MAY-84 Changing DD HOST to HPRT / DD HOST now for a real HOST /163 WCE 13-MAY-84 Changes for British date and currency symbol /162 EJL 08-MAY-84 Set DMII into level 2 firmware /161 DFB 24-APR-84 Don't allow device 0 as dest. on backup / .... when booting from hard disk /160 AH 10-APR-84 MODIFY WINCHESTER (HARD DISK) /159 SBB 09-APR-84 Fixes to 156 (if no comm active) /158 WJY 06-APR-84 Unbundle the Spelling Corrector /157 TCW 28-MAR-84 Add PHONE capability & moved APU absent message /156 SBB 28-MAR-84 Added 4th Main Menu screen /155 SBB 23-MAR-84 Post Processor/footnoting menus /154 DFB 08-MAR-84 Fix volume/diskette error msges /153 DFB 01-MAR-84 Fix for VER 002. VOL/RX drive message changes /152 DFB 20-FEB-84 Fix to fs,fd, ADMCPM to use TMP6 stead of TMP5 /151 WJY 17-FEB-84 More DM I compatability. /150 DFB 07-FEB-84 Fix to cpydsk screens for winni ver. 2.0.0 /149 WJY 23-JAN-84 Make compatible with DM I. /------DECMATE II VERSION 1.5 SUBMISSION ------------------- /148 WCE 19-JAN-84 Modified feature unbundling menus /147 WJY 17-JAN-84 Moved ADMCPM block from end of CPYDSK /146 DFB 17-JAN-84 Fix winnie maint. menu not ret to MM on cr. /145 EH 10-JAN-84 Reset to Main Menu page 0 on Gold Menu /144 GDH 16-DEC-83 Spelling prompt menu changes. /143 SBB 30-NOV-83 Added ADM125 block for graphics option /142 HLP 28-NOV-83 Add mismatched controls error message / (detected when print) /141 GDH 22-NOV-83 Changed 'LU' command to 'PD'. /140 DFB 14-NOV-83 Fix to Finnish cmnd w/o winnie /139 GDH 14-NOV-83 Rewrote ADMSPL for better instructions re:DECSPEL /138 HLP 13-NOV-83 Change SE YES message into messages for / insert front, rear or envelope /137 TCW 08-NOV-83 MOVED "FINISHED USING SYSTEM" TEXT FROM WP2CMF / AND ADDED CK FOR WINCHESTER DRIVE /136 GDH 07-NOV-83 Changed main menu SC description. /135 DFB 03-NOV-83 Fix to Finnish cmnd w/o winnie /134 GDH 28-OCT-83 Text changes to ADMSPL per documentation request. /133 HLP 26-OCT-83 More changes for SL from Stop Menu / Make MM1S the same as MM1OK /132 GDH 26-OCT-83 Changes to spell menu (ADMSPL). /131 EH 25-OCT-83 Added support for LU (load user dictionary), / and check for APU board after SC or LU reqst. /130 DFB 21-OCT-83 Fix to call winutl to dismount volumes / if WINNIE on line. And master menu or rx50 boot / depending on firmware in Panel Mem. /129 WCE 17-OCT-83 Changes to UNBUNDLING to make software bundled / Changes to DATE & TIME menu to force field test / users to enter a valid (current) date. / Changes to Winchester menu to add menu headings /128 HLP 17-OCT-83 Add check for documents in queue before SL / Add check for no docs in queue before RL / Make R with no documents say so insd no mean / Rewrite MM M logic to save space / Change SE ALT to SE LETTERHEAD /127 HLP 29-SEP-83 ADD SE ENV TO PRINT MENU /126 TCW 12-SEP-83 ADDITION OF WINCHESTER PHRASES FOR V1.5 /125 GDH 14-SEP-83 Changed Spelling Corrector CMND at ED1SEX / Added ADMSPL Spelling Corrector menu support. /124 WCE 18-AUG-83 Changed PRQ??? labels to MNQ??? for prefix file /123 WCE 17-AUG-83 Added conditionals for STATUS display in editor /122 EPS 08-AUG-83 FINISHED EDIT 119 /121 GDH 04-AUG-83 Added "SPELLING CORRECTOR" Main Menu & / "ACTIVATION MENU" options. /120 GDH 02-AUG-83 Change LOGON to LOGON TO HOST SYSTEM msg. /119 EPS 01-AUG-83 PUT BACK IN SOMETHING THAT SHOULDN'T HAVE / BEEN DELETED BY 115 /118 WCE 21-JUL-83 Corrected incorrect GOTO menu line in DU3 /117 WCE 07-JUL-83 Replaced occurances of SYS+value in case / statements with standard menu definitions /116 DFB 10-JUN-83 Fix bug to allow access to drives 4,5 /115 WCE 27-MAY-83 Fix copy document - "one" message /114 DFB 25-MAY-83 Fix bug to perform copy to multi drive system /113 HLP 24-MAY-83 Change communicatins error msg to printer error /112 GDH 19-MAY-83 Added LOGON menu option. /111 WCE 16-MAY-83 CHANGE ERROR MESSAGES FOR EXPANDED 4095 RANGE /110 HLP 13-MAY-83 Add message for communications error in PS menu /109 GDH 13-MAY-83 Commonize filename prompt for "EDIT", "PRINT", / "DELETE", and now, CX/DX SEND. /108 GDH 15-APR-83 Implemented AX/DX/CX easylink interface. /107 HLP 29-APR-83 Remove hyphen from "half-lines" /106 DFB 25-APR-83 Condor fixes mc-c drive selection /105 HLP 22-APR-83 Add print menu error message (ADMPRD) /104 WCE 21-APR-83 Correct printer error messages for "PS" & "EX" /103 DFB 20-APR-83 Update to be compat. with DMII /102 HLP 05-APR-83 Make List queue menu accept only return /101 HLP 21-MAR-83 Make Error on Drive 0 a normal error /100 DFB 01-FEB-83 Set end(>) ifdef condor conditional /099 HLP 07-JAN-83 Delete auto-abort if PRSTTS is 0 /098 gjp 30-dec-82 fix "DRIVE NUMBERS MUST BE {867 to 2" bug /097 HLP 30-DEC-82 Lock out resume from main menu if que empty /096 HLP 30-DEC-82 Changes for resume non existent printer /095 HLP 21-DEC-82 Fix problem with N not being erased if L after / user stop /094 WCE 16-DEC-82 Correct problem with illegal date & time entry /093 HLP 14-DEC-82 Compress the holey stop menus /092 HLP 12-DEC-82 Change LQP01 CANCEL error code to 25 /091 AIB 10-DEC-82 conditionalize "Rubout key" messages /090 HLP 01-DEC-82 Restructure PS menus for selective options /089 GJP 30-NOV-82 Change so that MNTMP1 is not clobbered / when user hits command key improperly /088 HLP 30-NOV-82 Change nor to normal in darkness setting DA /087 HLP 28-NOV-82 Display only S (abort) option when enter / stop menu with printer locked /086 HLP 24-NOV-82 Change code sent to stop overlay to abort / instead of resume when printer is not in use /085 mjs 18-nov-82 continuation of "081" (so i forgot a couple) /084 EPS 18-NOV-82 FIX SCREENS FOR DECMATE II /083 EPS 17-NOV-82 FIX PROBLEM WITH AX/DX AND HARDWARE PRESENT /082 HLP 11-NOV-82 Gold or function keys hang system at FORMAT /081 mjs 11-nov-82 Change references from "Spelling Error Detector" / to "External Feature Option" (generic reference) /080 DFB 11-NOV-82 Change illegal drive printout /079 HLP 29-OCT-82 Delete spaces in print stop menu /078 HLP 28-OCT-82 Made Minimum Drive number=4 on FS,FD /077 HLP 27-OCT-82 Deleted "Format in Progress Message" /076 AIB 21-OCT-82 corrected icon RELOC ADMSM1=. X=DLMSM1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /D179 SM1S, TRNSFR;SM0S;DLMSM0 / CHECK IF INITIALIZATION IS NECESSARY SM1S, DISP;0;TEXT '!E-- !&DATE/!&TIME !&MENU --' /M179 MXDISP;0311;X01DEC;DLMX01 / DIGITAL EQUIPMENT CORPORATION DISP;-1;TEXT ' !&WPS-8 ' / WPS-8 MXDISP;-1;X01WPS;DLMX01 / WORD PROCESSING SYSTEM / STANDARD SOFTWARE DISPLAY /A032 MXDISP;620;X01MAT;DLMX01 / DECMATE IFDEF FLDTST < /A004 MXDISP;-1;X01FLD;DLMX01 / FIELD TEST > / END IFDEF FLDTST /A004 MXDISP;-1;X01VER;DLMX01 / SOFTWARE VERSION DISP;-1;TEXT '^A';SM1LST / DISPLAY THE VERSION NUMBER MXDISP;1020;X01IDV;DLMX01 / INTERNAL DATA VERSION /A176 DISP;-1;TEXT '!D!D!D';MNTMP5;MNTMP6;MNTMP7 / VERSION NUMBER /A176 MXDISP;-1;X01NED;DLMX01 / (NEED XXX OR HIGHER) /A176 MXDISP;1220;X01ROM;DLMX01 / INTERNAL ROM VERSION /A176 DISP;-1;TEXT '!D&^S';MNTMP8;MNTMP9 / VERSION NUMBER /A176 MXDISP;1520;X01DAT;DLMX01 / PLEASE TYPE THE DATE AND TIME AS FOLLOWS:/M176 COPY;MNFMAT;MNTMP1 / PICK UP THE FORMAT WORD CLRBIT;7774;MNTMP1 / MASK OFF THE DATE FORMAT BITS CASE;MNTMP1 / GO TO THE PROPER DISPLAY 1;SM1B / 1 = DAY - MONTH - YEAR 2;SM1C / 2 = MONTH - DAY - YEAR 3;SM1D / 3 = YEAR - MONTH - DAY SM1B, DISP;1733;TEXT 'DD^SMM^SYY HH:MM';MNDSEP;MNDSEP /M176 DISP;2120;TEXT '&EXAMPLE: !2D^S!2D^S!2D 09:25' /M176 SM1DY;MNDSEP;SM1MO;MNDSEP;SM1YR GOTO;SM1DSP / GO CONTINUE WITH THE DISPLAY SM1C, DISP;1733;TEXT 'MM^SDD^SYY HH:MM';MNDSEP;MNDSEP /M176 DISP;2120;TEXT '&EXAMPLE: !2D^S!2D^S!2D 09:25' /M176 SM1MO;MNDSEP;SM1DY;MNDSEP;SM1YR GOTO;SM1DSP / GO CONTINUE WITH THE DISPLAY SM1D, DISP;1733;TEXT 'YY^SMM^SDD HH:MM';MNDSEP;MNDSEP /M176 DISP;2120;TEXT '&EXAMPLE: !2D^S!2D^S!2D 09:25' /M176 SM1YR;MNDSEP;SM1MO;MNDSEP;SM1DY SM1DSP, MXDISP;2420;X01COR;DLMX01 / CORRECT ERRORS BY PRESSING /A176 IFDEF CONDOR < /A091 DISP;-1;TEXT 'THE &RUBOUT ^A KEY.';SM1BRK /M176 > / END IFDEF CONDOR /A091 IFNDEF CONDOR < /A091 DISP;-1;TEXT '!&RUB !&CHAR.' /M176 > / END IFNDEF CONDOR /A091 MXDISP;2520;X01DON;DLMX01 / WHEN DONE, PRESS RETURN. /M176 DISP;2700;TEXT '' / PUT CURSOR ON BOTTOM LINE /M176 TRNSFR;SM2RD;DLMSM2 / CONTINUE ON THE NEXT PAGE SM1DY, BLDDY / DAY SOFTWARE WAS BUILT /A129 SM1MO, BLDMO / MONTH SOFTWARE WAS BUILT /A129 SM1YR, BLDYR / YEAR SOFTWARE WAS BUILT /A129 SM1BRK, 074;130; 135; 0 /M076 SM1LST, SYSVER&177;".&177 / SYSTEM VERSION NUMBER /A004 SYSBAS&177;".&177 / SYSTEM BASE LEVEL NUMBER /A004 SYSREV&177 / BASE LEVEL REVISION NUMBER /A004 IFDEF V30FAO < / FAO start up display /A193 " &177;"(&177;"F&177;".&177;"A&177;".&177;"O&177;")&177 /A193 > /A193 0 /M193 XTRSM1=400-. IFZERO .-401&4000 /START MENU CONTINUED RELOC ADMSM2=. X=DLMSM2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / THIS MENU PAGE IS USED TO OBTAIN THE DATE AND TIME INFORMATION FROM THE / USER. SINCE WE NOW SUPPORT THREE DATE FORMATS, D-M-Y, M-D-Y AND Y-M-D, / IT IS LESS DISRUPTIVE TO THE SYSTEM TO LET IT THINK THAT IT IS ALWAYS / DELAING WITH THE SAME FORMAT AND TO SWAP THE ACTUAL VALUES THAT THE USER / INPUTS INTO THE LOCATIONS THAT THE SYSTEM IS HAPPY WITH. TO THAT END, WE / MAKE NO ASSUMPTIONS ABOUT THE NUMBERS THE USER ENTERES UNTIL WE SWAP THEM / INTO THE LOCATIONS THAT WE WANT THEM TO BE IN. AT THAT TIME WE RANGE CHECK / THEM FOR VALIDITY AND REPORT THE ERROR IF THEY ARE WRONG. /*************************************************************************** /**** **** /**** C A U T I O N **** /**** **** /**** DO NOT USE MNTMP5, MNTMP6, MNTMP7, MNTMP8, OR MNTMP9 **** /**** THESE REGISTERS ARE SET BY WPCU2 FOR DATA VERSION NUMBERS **** /**** **** /*************************************************************************** SM2RD, READ;MNTMP1;SM2RE / GET INPUT FROM USER SET;0;SM2SEP / CLEAR SEPARATOR INDICATOR /A163 /D179 SET;-1;MNDTDY / CLEAR DAY REGISTER /M094 SET;-1;MNDTHR / CLEAR HOUR REGISTER /M094 SET;0;MNDTMN / CLEAR MINUTE REGISTER /M094 ARG;SM2RTN;MNTMP1 / GET FIRST ENTRY. /M179 / RETURN IF NOTHING WAS TYPED /M094 NUMBER;MNTMP2;SM2BF / ERROR IF NOT NUMBER /M163 ARG;SM2BF;MNTMP1 / GET SEPARATOR. MUST BE VALID /M163 KEYWRD SM2SLA, TEXT '/';SM2SDS / SLASH FOR DATE SEPARATOR /M163 SM2DAS, TEXT '-';SM2DDS / DASH FOR DATE SEPARATOR /M163 SM2PER, TEXT '.';SM2PDS / PERIOD FOR DATE SEPARATOR /M163 TEXT ':';SM2TYM / COLON FOR TIME SEPARATOR /A022 TEXT ';';SM2TYM / SEMICOLON FOR TIME SEPARATOR /A022 GOTO;SM2BF / NOT VALID DATE OR TIME FORMAT /A022 SM2SDS, COPY;SM2SLA;SM2SEP / USE SLASH FOR DATE SEPARATOR /A163 GOTO;SM2DAT / CONTINUE IN LINE /A163 SM2DDS, COPY;SM2DAS;SM2SEP / USE DASH FOR DATE SEPARATOR /A163 GOTO;SM2DAT / CONTINUE IN LINE /A163 SM2PDS, COPY;SM2PER;SM2SEP / USE PERIOD FOR DATE SEPARATOR /A163 SM2DAT, ARG;SM2BF;MNTMP1 / GET SECOND ENTRY. /A163 NUMBER;MNTMP3;SM2BF / ERROR IF NOT NUMBER /A163 ARG;SM2BF;MNTMP1 / PICK UP NEXT DATE SEPARATOR /M094 KEYWRD /A094 SM2SEP, TEXT '?';SM2DT2 / CHECK FOR SLASH DASH OR PERIOD/A163 GOTO;SM2BF / NOT VALID DATE FORMAT /A094 SM2DT2, ARG;SM2BF;MNTMP1 / GET THIRD ENTRY. /A163 NUMBER;MNTMP4;SM2BF / ERROR IF NOT NUMBER /A163 ARG;SM2DON;MNTMP1 / GET HOUR. DONE IF NO MORE /M094 NUMBER;MNDTHR;SM2BF / GET NUMBER OR BARF /M094 RANGE;MNDTHR;0;27;SM2BF / RANGE CHECK THE HOUR (0-23.0 /M094 ARG;SM2DON;MNTMP1 / GET SEPARATOR, DONE IF NONE /M094 KEYWRD /A094 TEXT ':';SM2TIM / COLON FOR TIME SEPARATOR /A094 TEXT ';';SM2TIM / SEMICOLON FOR TIME SEPARATOR /A094 GOTO;SM2BF / NOT VALID TIME FORMAT /A094 SM2TYM, COPY;MNTMP2;MNDTHR / TRANSFER NUMBER TO HOUR REG. /M163 RANGE;MNDTHR;0;27;SM2BF / RANGE CHECK THE HOUR (0-23.) /M094 SM2TIM, ARG;SM2BF;MNTMP1 / PICK UP THE MINUTES /M094 NUMBER;MNDTMN;SM2BF / GET NUMBER OR BARF /M094 RANGE;MNDTMN;0;73;SM2BF / RANGE CHECK MINUTES (0-59.) /M094 SM2DON, CASE;SM2SEP / CHECK FOR DATE SEPARATOR /A163 0;SM2CKY / IF NONE, THEN NO DATE UPDATE /A163 COPY;MNFMAT;MNTMP1 / PICK UP THE FORMAT WORD /A163 CLRBIT;7774;MNTMP1 / MASK OFF THE DATE FORMAT BITS /A163 CASE;MNTMP1 / CHECK IF WE NEED TO SWAP WORDS/A163 2;SM2MDY / IF 2 THEN SWAP DAY WITH MONTH /A163 3;SM2YMD / IF 3 THEN SWAP DAY WITH YEAR /A163 SM2DMY, RANGE;MNTMP2;1;37;SM2BF / RANGE CHECK THE DAY (1-31.) /A163 RANGE;MNTMP3;1;14;SM2BF / RANGE CHECK THE MONTH (1-12.) /A163 RANGE;MNTMP4;0;143;SM2BF / RANGE CHECK THE YEAR (0-99.) /A163 SM2CKY, RANGE;MNTMP4;BLDYR;143;SM2BF / CHECK FOR YEAR IN RANGE /A129 CASE;MNTMP4;BLDYR;SM2CKM / GO CHECK MONTH IF BUILD YEAR /A129 GOTO;SM2DOK / CONTINUE, DATE IS OK /A129 SM2CKM, RANGE;MNTMP3;BLDMO;14;SM2BF / CHECK FOR MONTH IN RANGE /A129 CASE;MNTMP3;BLDMO;SM2CKD / GO CHECK DAY IF BUILD MONTH /A129 GOTO;SM2DOK / CONTINUE, DATE IS OK /A129 SM2CKD, RANGE;MNTMP2;BLDDY;37;SM2BF / CHECK FOR DAY IN RANGE /A129 SM2DOK, COPY;MNTMP2;MNDTDY / STORE VALUE IN DAY REGISTER /A163 COPY;MNTMP3;MNDTMO / STORE VALUE IN MONTH REGISTER /A163 COPY;MNTMP4;MNDTYR / STORE VALUE IN YEAR REGISTER /A163 COPY;SM2SEP;MNDSEP / STORE DATE SEPARATOR /A163 /D179 GOTO;SM2RTN / CONTINUE, DATE IS OK /M179 /D179 SM2NA, CMND;0;CMNNOP;CIF 0 SM2RTN, SET;-1;MNTMP1 RETURN /D179 SM2DOK, CMND;12;200;CIF CDF 20 /M129 /D179 GOTO;SM2RTN SM2MDY, COPY;MNTMP2;MNTMP1 / SAVE VALUE FOR MONTH /A163 COPY;MNTMP3;MNTMP2 / MOVE DAY VALUE INTO DAY REG /A163 COPY;MNTMP1;MNTMP3 / MOVE MONTH VALUE INTO MONTH REG/A163 GOTO;SM2DMY / GO TREAT AS DAY-MONTH-YEAR /A163 SM2YMD, COPY;MNTMP2;MNTMP1 / SAVE VALUE FOR YEAR /A163 COPY;MNTMP4;MNTMP2 / MOVE DAY VALUE INTO DAY REG /A163 COPY;MNTMP1;MNTMP4 / MOVE YEAR VALUE INTO YEAR REG /A163 GOTO;SM2DMY / GO TREAT AS DAY-MONTH-YEAR /A163 SM2RE, CALL;CR1BR;DLMCR1 TRNSFR;SM1S;DLMSM1 SM2BF, DISP;-2717;TEXT ' &DATE/&TIME TYPED INCORRECTLY. &TRY AGAIN.' GOTO;SM2RD XTRSM2=400-. IFZERO .-401&4000 / COMMAND DECODER FOR MAIN MENU RELOC ADMMM0=. X=DLMMM0 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 MM0S, /d172 DISP;2520;TEXT '&TYPE THE LETTER' /A020 CASE;MNMMSW / CHECK FOR FIRST MENU PAGE /A020 0;MM0S1 / SKIP DISPLAY OF "(S)" FOR FIRST PAGE /A020 MXDISP;2520;X02TLS;DLMX02 /A020 /M172 GOTO;MM0RD /A172 MM0S1, MXDISP;2520;X03TLR;DLMX03 /A020 /M172 MM0RD, CLRV / CLEAR ACCUMULATOR FOR TRANSFER TESTS /A179 READ;MNTMP1;MM0RE / GET USER COMMAND SELECTION MM0CA, ARG;MM0RD;MNTMP1 / CHECK FOR NULL ARGUMENT SET;0;MNTMP2 KEYWRD TEXT 'A ';-1-DU2UNB; DLMDU2 / UNBUNDLING TRANSFER TEXT 'C '; -1-PP1S; DLMPP1 / CREATE DOCUMENT TEXT 'D '; MM0DE / DELETE DOCUMENT /M179 TEXT 'E '; MM0ED / EDIT DOCUMENT /M179 TEXT 'F '; -1-PPMM0F; DLMPPM / FINISHED USING SYSTEM TEXT 'I '; -1-IN1S; DLMIN1 / INDEX OF DOCUMENTS TEXT 'L '; MM0NC / SPECIAL CASE FOR L.P. /A004 TEXT 'M '; -1-MM1M; DLMMM1 / MORE MAIN MENU TEXT 'N '; MM0PNP / PRINTER NEW PAGE /M020 TEXT 'P '; MM0PR / PRINT DOCUMENT /M179 TEXT 'R '; MM0RP / RESUME PRINTER /M020 TEXT 'S '; MM0SP / STOP PRINTER /M020 TEXT 'AD '; -1-ED1PH; DLMED1 / AUTO-DIAL (PHONE) /A157 TEXT 'AX '; MM0AX / AUTO DOC TRANSMISSION /M020 TEXT 'CI '; -1-CI2CI; DLMCI2 / COPY INDEX INTO DOCUMENT TEXT 'CX '; MM0CX / CHARACTER TRANSMISSION/M020 TEXT 'DK '; -1-DK1S; DLMDK1 / DEFINE USER KEYS TEXT 'DX '; MM0DX / DOCUMENT TRANSMISSION /M020 IFDEF CONDOR < /A121 TEXT 'DS '; -1-MM2SED;DLMMM2 / DECspell spelling checker/M139 TEXT 'FF '; -1-PPMFFF;DLMPPM / FOR FOOTNOTE FORMATING /A155 > / END IFDEF CONDOR /A121 TEXT 'LG '; -1-ED1LO; DLMED1 / LOGON invocation. /A112 TEXT 'LP '; -1-MM1LP; DLMMM1 / LIST PROCESSING /M174 TEXT 'MC '; -1-DU1S; DLMDU1 / DISKETTE UTILITIES IFDEF CONDOR < /A121 TEXT 'PD '; -1-MM2LPD;DLMMM2 / LOAD PERSONAL DICTIONARY/M141 > / END IFDEF CONDOR /A121 TEXT 'RD '; -1-SM0CU2;DLMSM0 / RESET DATE & TIME /M179 TEXT 'RL '; -1-RS1RL; DLMRS1 / RETRIEVE LIST OF PRINT DOCS. TEXT 'SL '; -1-RS1SL; DLMRS1 / STORE LIST OF PRINT DOCUMENTS TEXT 'SO '; MM0SO / SET SYSTEM OPTIONS /M020 TEXT 'SR '; -1-MM2SR; DLMMM2 / SORT PACKAGE /A067 IFDEF CONDOR < /A172 TEXT 'UD '; MM0UPD / UPDATE PERSONAL DICT /A172 TEXT 'CU '; MMCONV / CONVERT UTILITY /a195 > / END IFDEF CONDOR /A172 MM0NC, CALL;CR1NM;DLMCR1 / INVALID USER INPUT ERROR MESSAGE GOTO;MM0RD / RETURN TO READ ROUTINE MM0RE, / ACCUMULATOR IS CLEAR FOR PAGE 0 IF GOLD MENU /A145 CASE;MNSYSA / GOLD KEY SEQUENCE ENTERED BY USER /M117 / 0 MEANS TOO MANY CHARS. - ERROR MESSAGE EDSETUP&3777; MM0SET / USER TYPED "SETUP" /M068 EDMENU&3777; -1-MM1SD0;DLMMM1 / CHECK FOR GOLD MENU CALL;CR1BR;DLMCR1 / ERROR - ILLEGAL KEYPAD KEY USED MM0CMP, TRNSFR;MM1S;DLMMM1 / GO REDISPLAY CURRENT MENU PAGE /M020 MM0SET, CMND; 23; 200; CIF CDF 10 / READ IN "SETUP" OVERLAY /A067 RETURN /A067 MM0ED, INCV / EDIT DOCUMENT /A179 MM0PR, INCV / PRINT DOCUMENT /A179 MM0DE, STOV; MNTMP6 / SET UP INDICATOR FOR WHICH UTILITY /A179 TRNSFR;ED1PRM;DLMED1 / GO HANDLE USER SPECIFIED FILE NAME /A179 /D155MM0F, / FINISHED USING THE SYSTEM /D155 PQUEUE;MM0FNE;MM0FOK / CHECK FOR ANY DOCUMENTS BEING PRINTED /M020 /D155 / PQUEUE FALLS THROUGH IF QUEUE IS /A128 /D155 / NOT EMPTY AND MNFNO DOESN'T MATCH /A128 /D155MM0FNE, TRNSFR;MM2ERR;DLMMM2 / ERROR - CAN'T FINISH WHILE PRINTING /C128 /D155MM0FOK, SET;2525;MNTMP1 / REMEMBER WE'RE FINISHING UP /A024 /D155 CMND;2;223;CIF 10 / GO TO EDITOR TO CLEAR THE PASTE /A024 /D155 RETURN / BUFFER /A024 MM0F0K, CALL; DUAFN1; DLMDUA / PUT FINISH MESSAGE ON SCREEN /C137 CMND;12;210;CIF CDF 20 / SET UP OVERLAY CALLING INSTRUCTIONS /M020 RETURN / GO TO FINISH USING THE SYSTEM ROUTINE MM0SP, CMND;1;214;CIF CDF 20 / GO TO STOP PRINTER ROUTINE /M020 RETURN /M020 / RESUME PRINTER FROM MAIN MENU - SEE IF PRINTER Q IS EMPTY /A128 / PQUEUE FALLS THROUGH IF QUEUE NOT EMPTY AND MUFNO IS NOT IN QUEUE /A128 MM0RP, PQUEUE;MM0RNE;-1-MM2NDC;DLMMM2 / TELL USER QUEUE IS EMPTY /A128 MM0RNE, CMND;1;224;CIF CDF 20 / ELSE GO TO RESUME PRINTER ROUTINE /M020 RETURN /M020 MM0PNP, CMND;1;230;CIF CDF 20 / GO TO PRINTER NEW PAGE ROUTINE /M020 RETURN /M020 MM0SO, / SET SYSTEM OPTIONS CMND;24;200;CIF CDF 20 / SET UP OVERLAY INSTRUCTIONS RETURN / GO TO SET OPTIONS ROUTINE MMCONV, / CONVERT UTILITY /a195 CMND;32;6000;CIF CDF 40 / SET UP OVERLAY INSTRUCTIONS /a195 / hard to beleive I know but this routine/a195 / acctually runs in field 6 and 2CMF adds/a195 / 20 to this CIDF instruction /a195 RETURN / GO TO CONVERT UTILITY ROUTINE /a195 MM0LO, SET;6;MNTMP1 / 6 for LOGON. /A112 GOTO;MM0CK1 / check out Comm option. /A112 MM0PH, SET; 7; MNTMP1 / 7 for PHONE /A157 GOTO; MM0CK1 / check out Comm. option. /A157 MM0CX, SET;0;MNTMP1 / ZERO MEANS CX - SKIP HARDWARE CHECK /M004 GOTO; MM0CK1 / GO CHECK VALIDITY OF CALL /M052 MM0AX, SET;1;MNTMP1 / ONE MEANS AX - CHECK FOR HARDWARE /M004 GOTO; MM0CHK / GO CHECK VALIDITY OF CALL /M129 MM0DX, SET;2;MNTMP1 / TWO MEANS DX - CHECK FOR HARDWARE /M004 MM0CHK, / CHECK FOR VALIDITY OF COMMUNICATION CALL /M004 TSTBIT;MNOPTC;HWDBIT;-1-PS4NCM;DLMPS4 / HANDLE NO HARDWARE /M129 MM0CK1, IFDEF UNBUND < /A129 TSTBIT;MNOPTC;COMBIT;-1-UBENCM;DLMUBE / HANDLE NOT ACTIVE /M052 > / END IFDEF UNBUND /A004 SET;0;MNTMP6 / Set "FROM MAIN MENU" indicator. /A108 CMND;20;214;CIF CDF 20 / SET UP OVERLAY CALLING PARAMETERS /M004 RETURN / GO TO COMMUNICATIONS ROUTINES /M004 IFDEF CONDOR < /A172 MM0UPD, TSTBIT;MNOPTC;DEVBIT;MM0NC / CHECK IF UD OPTION ENABLED /A172 TRNSFR;MM2UPD;DLMMM2 / GO UPDATE PERSONAL DICT /A172 > / END IFDEF CONDOR /A172 XTRMM0=400-. IFZERO .-401&4000 /MAIN MENU DISPLAY RELOC ADMMM1=. X=DLMMM1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /******************************************************* /A004 /******************************************************* /A004 /****** ****** /A004 /****** C A U T I O N ****** /A004 /****** ****** /A004 /****** MM1S MUST BE LOCATED HERE IN OVERLAY ****** /A004 /****** BECAUSE OF MAIN MENU CALLS FROM MN2 ****** /A004 /****** ****** /A004 /******************************************************* /A004 /******************************************************* /A004 MM1S, GOTO;MM1OK /MM1S IS DEFINED IN MNCOM & USED IN MN2 /A133 MM1M, CLRV /SELECT NEXT MAIN MENU DISPLAY /M004 CASE; MNMMSW /CHECK NUMBER OF CURRENT DISPLAY /M004 0;MM1SD1 /IF PAGE ZERO, BUMP TO PAGE ONE /M004 1;MM1SD2 /IF PAGE ONE, BUMP TO PAGE TWO /M004 2;MM1SDA /IF PAGE TWO, BUMP TO PAGE THREE /M156 /M004 3;MM1SD4 /IF PAGE THREE, BUMP TO PAGE 4 /A156 4;MM1SD0 /IF PAGE 4 RETURN TO PAGE 0 /A156 MM1SDA,/D159 IFNDEF CONDOR < /M156 /A129 IFDEF UNBUND < /A129 TSTBIT;MNOPTC;COMBIT;MM1SD4 /IF NO COMM, BACK TO PAGE ZERO /M156/A128 > /END IFDEF UNBUND /A129 /D159 > /END IFNDEF CONDOR /A129 GOTO;MM1SD3 /A156 MM1SD4, INCV /SET TO DISPLAY PAGE 4 /A156 MM1SD3, INCV /SET UP TO DISPLAY PAGE 3 /M156 /A128 MM1SD2, INCV /SET UP TO DISPLAY PAGE 2 /A128 MM1SD1, INCV /SET UP TO DISPLAY PAGE 1 /A128 MM1SD0, STOV;MNMMSW /SET UP TO DISPLAY PAGE 0 /A128 MM1OK, CLRRTN /CLEAR ANY PREVIOUS RETURN! /A128 CASE;MNTMP1 /SET TO 2525 AT MM0FOK (FINISHING UP) /A024 2525;MM1WIN /COMPLETE FINISHING TOUCHES /A024 /C130 2526;-1-MM0F0K;DLMMM0 /COMPLETE FINISHING TOUCHES /A130 CALL;CR1EEQ;DLMCR1 /CALL SYSTEM ROUTINE TO RESET TERMINAL /A163 CLRBIT;4000;MNPULD /ALLOW PRINT SCREENS /A196 DISP;0;TEXT '!E-- !&MAIN !&MENU --' /M163 CASE;MNMMSW /CHECK WHICH PAGE TO DISPLAY 0;MM1D0 /SKIP "CONTINUE" FOR PAGE ZERO DISP;0015;TEXT '(CONTINUED) --' CASE;MNMMSW /CHECK WHICH PAGE TO DISPLAY 1;-1-MM2D1;DLMMM2 /GO DISPLAY MENU PAGE ONE 2;-1-MM2D2;DLMMM2 /GO DISPLAY MENU PAGE TWO 3;-1-MM3D3;DLMMM3 /GO DISPLAY MENU PAGE THREE /M148 4;-1-MM4D4;DLMMM4 /GO DISPLAY MENU PAGE FOUR /A156 MM1D0, DISP;505;TEXT '%C = &CREATE A NEW^S^S';MM1LET;MM1DOC/m190 /M004 DISP;705;TEXT '%E = &EDIT AN EXISTING^S^S';MM1LET;MM1DOC/m190 /M004 DISP;1105;TEXT '%P = &PRINT A^S^S';MM1LET;MM1DOC /m190 /M004 DISP;1305;TEXT '%I = &INDEX OF LETTERS AND^SS ON FILE';MM1DOC /m190 DISP;1505;TEXT '%D = &DELETE A^S';MM1DOC /m190 DISP;1705;TEXT '%F = &FINISHED USING THE SYSTEM' /m190 MM1MS, DISP;-1;TEXT '^A%M = &MORE MAIN MENU SELECTIONS...';MM1L2 /M148 TRNSFR;MM0S;DLMMM0 /DISPLAY "TYPE LETTER & PRESS RETURN /M020 MM1L2, 15;12;12;40;40;40;40;40;0 /DROP DOWN TWO LINES /A148 MM1LET, TEXT ' LETTER OR' /A004 MM1DOC, TEXT ' DOCUMENT' / IF WINNIE ON LINE DISMOUNT ALL VOLUMES FOR FINISH /A130 / ELSE SET TO MNTMP1 TO DISPLAY FINISH SCREEN /A130 MM1WIN, /C182 /D182 TSTBIT;MNOPTN;MNRX2X;-1-MM0F0K;DLMMM0 /WINNIE ON LINE? /C140 SET;2526;MNTMP1 /SET CODE /C140 CMND;31;202;CIF 10 /C135 RETURN /A130 MM1LP, IFDEF UNBUND < /A004 TSTBIT;MNOPTC;LPBIT;-1-UBENLP;DLMUBE/ CHECK FOR L.P. ENABLED /A004 > /END IFDEF UNBUND /A004 CMND;1;220;CIF CDF 20 / SET UP OVERLAY PARAMETERS RETURN / GOTO LIST PROCESSING ROUTINES XTRMM1=400-. IFZERO .-401&4000 /MAIN MENU DISPLAY PART 2 RELOC ADMMM2=. X=DLMMM2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /ED1QD, CALL;CR2QDD;DLMCR2 /M155 / TRNSFR;MM1S;DLMMM1 /M155 MM2D1, DISP;505;TEXT '%S = &STOP PRINTING' /m190 DISP;705;TEXT '%R = &RESUME PRINTING' /m190 DISP;1105 TEXT '%N = &NEW PAGE, BRING THE PRINTER TO THE TOP OF THE PAPER'/m190 DISP;1305;TEXT '%S%L = &STORE^S';MM2LOD /m190 DISP;1505;TEXT '%R%L = &RETRIEVE^S';MM2LOD /m190 DISP;1705;TEXT '%C%I = © &INDEX INTO A DOCUMENT' /m190 MM2LET, TRNSFR;MM1MS;DLMMM1 /DISPLAY "M = MORE SELECTIONS..." /A148 MM2LOD, TEXT ' LIST OF DOCUMENTS WAITING TO PRINT' /m190 IFDEF CONDOR < /A121 MM2UPD, SET;13;MNTMP6 / 13 FOR UPDATE PERSONAL DICT /A172 GOTO;MM2PDM /A172 MM2LPD, SET;7;MNTMP6 / 7 FOR LOAD PERSONAL DICTIONARY/A131 / CHECK FOR APU/XPU NOW - THE /A169 / LATER CHECK IS BYPASSED IF /A169 / THERE IS A DEFAULT "PD" /A169 MM2PDM, COPY;MNFNO;MNUTFN / SET UP UTILITY FILE NUMBER /A179 IFDEF UNBUND < /A174 TSTBIT;MNOPTC;SEDBIT;-1-UBENSD;DLMUBE / CHECK FOR SPELLING ENABLED/A174 > / END IFDEF UNBUND /A174 TSTBIT;MNOPTN;MNRX6X;-1-CI1NAP;DLMCI1 / CHECK FOR APU BOARD /M172 TSTBIT;MNPDFN;-1;MM2SE1 / SKIP IF NO DEFAULT FILE SET /A163 COPY;MNPOS;MNTMP2 / SAVE CURRENT POSITION /A163 ARG;MM2PDF;MNTMP1 / CHECK FOR A BLANK LINE /A163 COPY;MNTMP2;MNPOS / NO, RESTORE POSITION /A163 GOTO;MM2SE1 / GO HANDLE USER SPECIFIED FILE /A163 MM2PDF, COPY;MNPDFN;MNUTFN / SET UP DEFAULT DICTIONARY FILE/M179 PQUEUE;MM2ERR;-1-ED1RT;DLMED1 / CHECK IF PRINTING DOCUMENTS /A163 / FALL THROUGH IF QUEUE NOT EMPTY/A163 GOTO;MM2ERR / ERROR, PRINTING IN PROGRESS /A163 MM2SED, SET;6;MNTMP6 / 6 FOR SPELLING /A131 COPY;MNFNO;MNUTFN / SET UP UTILITY FILE NUMBER /A179 IFDEF UNBUND < /A174 TSTBIT;MNOPTC;SEDBIT;-1-UBENSD;DLMUBE / CHECK FOR SPELLING ENABLED/A174 > / END IFDEF UNBUND /A174 MM2SE1, PQUEUE;MM2ERR;-1-ED1SC;DLMED1 / CHECK IF PRINTING DOCUMENTS /A131 / FALL THROUGH IF QUEUE NOT EMPTY/A131 > / END IFDEF CONDOR /A121 MM2ERR, SET;0;MNQCPY / SET MNQCPY TO SPECIFY "DOCUMENTS" /A128 MM2ER1, CALL;CR2FQ;DLMCR2 / ERROR - NO SPELLING WHILE PRINTING /A021 TRNSFR;MM1S;DLMMM1 / GO REDISPLAY CURRENT MENU PAGE /A021 MM2NDC, SET;1;MNQCPY / SET MNQCPY TO SPECIFY "NO DOCUMENTS" /A128 GOTO;MM2ER1 / GO DISPLAY MESSAGE /A128 MM2SR, IFDEF UNBUND < /A004 TSTBIT;MNOPTC;SRBIT;-1-UBENSR;DLMUBE / CHECK FOR SORT ENABLED /A004 > / END IFDEF UNBUND /A004 PQUEUE;MM2ERR;MM2OKS / PQUEUE FALLS THROUGH IF QUEUE NOT /A056 GOTO;MM2ERR / EMPTY AND MUFNO IS NOT IN QUEUE /A128 MM2OKS, CMND;26;200;CIF CDF 10 / SET UP OVERLAY PARAMETERS /A004 RETURN / GOTO SORT ROUTINE /A004 MM2D2, DISP;505; TEXT '%S%O = &SET SYSTEM &OPTIONS' /m190 DISP;705;TEXT '%M%C = &MAINTENANCE &COMMANDS FOR DISKETTES' /m190 MM2NW1, TRNSFR;MM3NW1;DLMMM3 /CONTINUE DISPLAY ON NEXT PAGE /A148 XTRMM2=400-. IFZERO .-401&4000 /MAIN MENU DISPLAY PART 3 RELOC ADMMM3=. X=DLMMM3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 MM3NW1, IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; MM3NW2 /M172 DISP; -1; TEXT ' AND VOLUMES' /A126 > / END IFDEF CONDOR /A126 MM3NW2, DISP;1105;TEXT '%R%D = &RESET &DATE/&TIME' /m190 /M172 DISP;1305;TEXT '%D%K = &DEFINE USER KEYS' /m190 IFDEF UNBUND < TSTBIT;MNOPTC;LPBIT;MM3NLP > /A004 DISP;-1;TEXT '^A%L%P = &LIST PROCESSING PACKAGE';MM3L2 /m190 /M148 MM3NLP, IFDEF UNBUND < TSTBIT;MNOPTC;SRBIT;MM3NSR > /A004 DISP;-1;TEXT '^A%S%R = &SORT PACKAGE';MM3L2 /m190 /M026 MM3NSR, TRNSFR;MM1MS;DLMMM1 /DISPLAY "M = MORE SELECTIONS..." /A148 MM3D3, DISP;305;TEXT '' /SET DISPLAY LOCATION /A148 MN3NSD, IFDEF UNBUND < TSTBIT;MNOPTC;COMBIT;MM3NC > /M148 DISP;-1;TEXT '^A%C%X = &CHARACTER^SPACKAGE';MM3L2;MM3TRN/m190 /M148 DISP;-1;TEXT '^A%D%X = &DOCUMENT^SWITH A !&WP SYSTEM';MM3L2;MM3TRN/m190/M148 DISP;-1;TEXT '^A%A%X = &AUTOMATIC DOCUMENT^S';MM3L2;MM3TRN/m190 /M148 DISP;-1;TEXT '^A%L%G = &LOGON TO !&HOST SYSTEM';MM3L2 /m190 /M148 DISP;-1;TEXT '^A%A%D = &AUTOMATICALLY &DIAL A &TELEPHONE &NUMBER'/m190/A157 MM3L2 /A157 MM3NC, TRNSFR;MM1MS;DLMMM1 /DISPLAY "M = MORE SELECTIONS..." /A148 MM3TRN, TEXT ' TRANSMISSION ' MM3L2, 15;12;12;40;40;40;40;40;0 XTRMM3=400-. IFZERO .-401&4000 /THE FOURTH MAIN MENU RELOC ADMMM4=. X=DLMMM4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / T H I S M E N U P A G E I S / F O R T H E 4 T H MM S C R E E N /A156 MM4D4, DISP;505;TEXT "" /M174 IFDEF CONDOR < /A174 IFDEF UNBUND < /A174 TSTBIT;MNOPTC;SEDBIT;MM4FOR / CHECK FOR SPELLING ENABLED /A174 > / END IFDEF UNBUND /A174 TSTBIT;MNOPTN;MNRX6X;MM4FOR / CHECK FOR APU BOARD /M174 DISP;-1;TEXT '%D%S = &D&E&CSPELL - &SPELLING &CHECKER ' /m190 /M174 TSTBIT;MNOPTC;SEDBIT;MM4NCO /A158 DISP;-1;TEXT '^C& &CORRECTOR' /M174 MM4NCO, DISP;-1;TEXT '^A%P%D = &LOAD &PERSONAL &DICTIONARY';MM4L2/m190 /M158 TSTBIT;MNOPTC;DEVBIT;MM4FOR / CHECK IF UD OPTION ENABLED /A172 DISP;-1;TEXT '^A%U%D = &UPDATE &PERSONAL &DICTIONARY';MM4L2/m190/A172 > / END IFDEF CONDOR /A174 MM4FOR, DISP;-1;TEXT '^A%F%F = &FORMAT FOOTNOTES';MM4L2 /m190 /M172 DISP;-1;TEXT '^A%C%U = &CONVERT UTILITY';MM4L2 /A195 TRNSFR;MM1MS;DLMMM1 / AND GO WAIT FOR READ /A156 MM4L2, 15;12;12;40;40;40;40;40;0 XTRMM4=400-. IFZERO .-401&4000 /MORE OF THE MAIN MENU RELOC ADMMM5=. / X=DLMMM5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / T H I S M E N U P A G E I S / R E S E R V E D F O R F U T U R E U S E XTRMM5=400-. IFZERO .-401&4000 /DELETE DOCUMENT ENTRY MENU RELOC ADMDL1=. / X=DLMDL1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 XTRDL1=400-. IFZERO .-401&4000 / PRINTER ENTRY MENU RELOC FIELD 2 *0 ADMPR1=. X=DLMPR1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /PRINTER OPTIONS THESE LOCATIONS ARE DEFINED IN WPRINT /BUT ARE LOADED INTO THE MENU FIELD SYSTEM AREA /A124 MNQINI=MNPROP /SETTINGS NOT INITIALIZED /M124 MNQCPY=MNQINI+1 /NUMBER OF COPIES /M124 MNQIND=MNQCPY+1 /PRINTER MARGIN /M124 MNQLSZ=MNQIND+1 /EXTRA HALF LINE SPACING /M124 MNQTMG=MNQLSZ+1 /TOP MARGIN /M124 MNQBMG=MNQTMG+1 /BOTTOM MARGIN /M124 MNQPSZ=MNQBMG+1 /PAGE SIZE /M124 MNQPIT=MNQPSZ+1 /PITCH LP USES THIS VALUE /M124 MNQFRP=MNQPIT+1 /FROM /M124 MNQTOP=MNQFRP+1 /TO /M124 MNQPGO=MNQTOP+1 /INITIAL PAGE /M124 MNQSP=MNQPGO+1 /SHADOW PRINT IF BIT 11 IS SET /M124 MNQAPG=MNQSP+1 /AUTOMATIC PAGINATION /M124 MNQJUS=MNQAPG+1 /RESERVED /M124 MNQDBL=MNQJUS+1 /RESERVED /M124 MNQSSM=MNQDBL+1 /STOP /M124 MNQSTX=MNQSSM+1 /RESERVED BUT USED BY MENU CODE /M124 MNQOVP=MNQSTX+1 /DARKNESS /M124 MNQTW=MNQOVP+1 /TWO WHEEL /M124 MNQPNT=MNQTW+1 /PRINTER TYPE LIST PROCESSING USES THIS VALUE ALSO /M124 MNQCM=MNQPNT+1 /COLUMN MARGIN /M124 MNQSB1=MNQCM+1 /REPLACEMENT CHARACTER 1 LP USES THIS VALUE /M124 MNQSB2=MNQSB1+1 /REPLACEMTNE CHARACTER 2 LP USES THIS VALUE /M124 MNQUSD=MNQSB2+1 /M124 IFNZRO MNQUSD-MNPROP-PRSETZ /M124 DISP;0;TEXT '!E' CASE;MNTMP1;0;PR1S / 0 for no more room error message. /A112 DISP;1305;TEXT '&INCONSISTENT MARGIN SETTINGS' DISP;1505;TEXT '!&TM PLUS !&BM MUST BE LESS THAN !&PS' GOTO;PR1DSP / wait for RETURN. /A112 PR1S, DISP;1505;TEXT '&THERE ARE ALREADY 8 DOCUMENTS WAITING TO PRINT.' PR1DSP, DISP;1705;TEXT '&PRESS !&RETURN TO RECALL THE ' CASE;MNTMP1;1;PR1DS2 DISP;-1;TEXT '&MAIN ' PR1DS2, DISP;-1;TEXT '&MENU.' PR1RD, READ;MNTMP1;PR1RE ARG;PR1MM;MNTMP1 GOTO;PR1RD PR1RE, CASE;MNSYSA /M117 EDMENU&3777;PR1MM GOTO;PR1RD PR1MM, RETURN IFDEF CONDOR < /A131 / APU board has been loaded once, how does the user wish to modify the /A131 / user dictionary area /A131 PR1APU, DISP;0;TEXT '!E' /A131 DISP;1005;TEXT '&HOW WOULD YOU LIKE^S MODIFIED?';TCUSDC /A131 DISP;1205;TEXT '&A = &ADD TO^S';TCUSDC /A131 DISP;1405;TEXT '&O = &OVERWRITE ^S';TCUSDC /A131 DISP;2320;TEXT '&TYPE THE LETTER AND PRESS &R&E&T&U&R&N' /A131 DISP;2520;TEXT '&O&R &PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU' TRNSFR; ED1APU; DLMED1 /A131 TCUSDC, TEXT ' THE CURRENT USER DICTIONARY' /A131 > /END IFDEF CONDOR /A131 XTRPR1=400-. IFZERO .-401&4000 / PRINT MENU PARAMETER HANDLING RELOC ADMPR2=. X=DLMPR2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /This menu block is entered (called) directly from WPCUT CUQPRT routine./A075 PR2S, CASE;MNTMP1 / the old "what to do switch". /A075 1;PR2TWD / DD checked out ok. continue processing. /A075 2;PR2PIC / incorrect printer attached. /A075 3;PR2PNX / non-existent list processing printer. /A075 / other wise initial call. /A075 SET;0;MNQSTX /M124 PR2RDY, DISP;0;TEXT '!E' PR2RDN, CASE;MNQSTX /M124 1;-1-PR7D1;DLMPR7 2;-1-PR9D2;DLMPR9 TRNSFR;PR3D0;DLMPR3 PR2CA, PR2RD, READ;MNTMP1;PR2RE TRNSFR;PR5CA;DLMPR5 PR2RE, CASE;MNSYSA /M117 EDMENU&3777;PR2MM CALL;CR1BR;DLMCR1 GOTO;PR2RDY PR2MM, SET;2;MNTMP1 RETURN PR2SD1, SET;1;MNQSTX /M124 GOTO;PR2RDY / THE 2 WHEEL CHECK IS HERE INSTEAD OF PR6 OR PR5 PR2TW, ARG;PR2TWE;MNTMP2 KEYWRD TEXT 'YES ';PR2TWY TEXT 'NO ';PR2TWN PR2TWE, DISP;-2717;TEXT '!&TW YES OR !&TW NO' /C164 GOTO;PR2RD PR2TWY, SET;1;MNQTW /M124 GOTO;PR2TWD PR2TWN, SET;0;MNQTW /M124 SPDAXT, PR2TWD, DISP;-2700;TEXT '' GOTO;PR2RDN PR2SP, ARG; PR2SPN; MNTMP2 /A018 KEYWRD TEXT 'YES ';PR2SP1 /A018 TEXT 'NO ';PR2SP0 /A018 PR2SPN, DISP;-2717;TEXT '!&SP YES OR !&SP NO' /C164 GOTO;PR2RD /A018 PR2SP1, SETBIT;0001;MNQSP /SHADOW PRINT YES /C173 GOTO;SPDAXT /A034 PR2SP0, CLRBIT;0001;MNQSP /SHADOW PRINT NO /C173 GOTO;SPDAXT /A034 /THIS IS THE CHECK FOR THE DOCUMENT DESTINATION PR2PNT, ARG;PR2PNE;MNTMP2 KEYWRD TEXT 'LQP ';PR2PNQ TEXT 'DP ';PR2PNL TEXT 'CHST ';PR2DHO /TRUE HOST /C164 TEXT 'CPTR ';PR2PNH /PRINTER ON HOST PORT /C164 PR2PNE, DISP;-2717;TEXT '!&DD !&LQP, !&DP, !&CHST, OR !&CPTR' /C168 GOTO;PR2RD /MNQPNT IS USED TO IDENTIFY THE DOCUMENT DESTINATION. /M124 / POSSIBLE VALUES ARE: / DLQP = LQP (PARALLEL LQP) / DDP = DP (PARALLEL DRAFT PRINTER) / DHOST = CPTR (PRINTER ON HOST PORT) /C168 / DHOST2 = CHST (CONNECTION TO A TRUE HOST) /C168 / DDP2 = DP2 (SERIAL DRAFT PRINTER) / DSQ1 = SQ1 (SERIAL LQP, ONE HEAD) /NOT AN APPROVED OPTION / DSQ2 = SQ2 (SERIAL LQP, TWO HEADS) /THIS IS NOT SUPPORTED PR2PNQ, SET;DLQP;MNQPNT /DD=LQP /M124 GOTO;PR2PCK / CHECK ATTACHED PRINTER. /M075 PR2PNL, SET;DDP;MNQPNT /DD=DP /M124 GOTO;PR2PCK / CHECK ATTACHED PRINTER. /M075 PR2DHO, SET;DHOST2;MNQPNT /DD=CHST (TRUE HOST) /C164 GOTO;PR2PCK / CHECK ATTACHED PRINTER. /M075 PR2PNH, SET;DHOST;MNQPNT/DD=HPTR (PRINTER ON HOST PORT) /C168 PR2PCK, SET;5;MNTMP1 / RETURN TO WPCUT TO DO PRINTER VALIDATION. /A075 RETURN / ... /A075 PR2NUM, DISP;-2717 /M004 TEXT '&THE SETTING MUST BE FOLLOWED BY A NUMBER BETWEEN !D AND !D.' /M111 MNTMP4;MNTMP5 /A111 GOTO;PR2RD PR2PNX, MXDISP;-2717;X05NEP;DLMX05 /NON EXISTENT PRINTER /C173 GOTO;PR2RDN /A075 /A075 PR2PIC, DISP;-2717;TEXT 'INCORRECT PRINTER ATTACHED' /A075 GOTO;PR2RDN /A075 XTRPR2=400-. IFZERO .-401&4000 /START OF FIRST PRINT MENU RELOC ADMPR3=. X=DLMPR3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR3D0, DISP;0;TEXT '-- !&PRINT !&MENU --' DISP;200;TEXT '&THESE ARE THE CURRENT SETTINGS FOR PRINTING DOCUMENT:' DISP;404;TEXT '(!D.!D) !A';MNDRV;MNDOCN;MNFNAM CASE;MNQPIT /M124 0;PR3PPI DISP;-604;TEXT '!D CHARACTERS PER INCH (PITCH)';MNQPIT /M124 GOTO;PR3SPI PR3PPI, DISP;-604;TEXT 'THEME CHARACTER WIDTH' PR3SPI, CASE;MNQCPY /M124 1;PR3CP1 DISP;-704;TEXT '!D COPIES';MNQCPY /M124 GOTO;PR3CPD PR3CP1, DISP;-704;TEXT '1 COPY' PR3CPD, DISP;-1;TEXT ' WILL BE PRINTED' DISP;-1004;TEXT '!D IS THE NUMBER ON THE FIRST PAGE';MNQPGO /M124 DISP;-1104;TEXT '!D IS THE FIRST PAGE PRINTED';MNQFRP /M124 DISP;-1204;TEXT '' CASE;MNQTOP /M124 0;PR3NTO DISP;-1204;TEXT '!D IS THE LAST PAGE PRINTED';MNQTOP /M124 PR3NTO, DISP;752;TEXT '!D LINES IN THE TOP MARGIN';MNQTMG /M124 DISP;1052;TEXT '!D LINES IN THE BOTTOM MARGIN';MNQBMG /M124 DISP;-1404;TEXT '!D EXTRA HALF LINE SPACE BETWEEN LINES';MNQLSZ /M124 TRNSFR;PR4D0;DLMPR4 XTRPR3=400-. IFZERO .-401&4000 /FIRST PRINT MENU CONTINUED RELOC ADMPR4=. X=DLMPR4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR4D0, DISP;1152;TEXT '!D SPACES IN THE LEFT PRINT MARGIN';MNQIND /M124 DISP;0652;TEXT '!D TOTAL LINES PER PAGE';MNQPSZ /M124 DISP;1252;TEXT '!D SPACES BETWEEN COLUMNS';MNQCM /M124 CLRV / INITIALIZE SE RESULT /A127 DISP;-1504;TEXT '' /A127 CASE;MNQSSM /M124 0;PR4SS0 1;PR4SS1 2;PR4SS2 3;PR4SS3 4;PR4SS4 5;PR4SS5 6;PR4SS6 /A127 / NOTE: AN INVALID SETTING BECOMES SE NO /A127 / SHOULD WE HAVE A MESSAGE FOR AN INVALID SE SETTING? /A127 PR4SS0, DISP;-1;TEXT 'DO NOT ' /C127 PR4SS2, DISP;-1;TEXT 'STOP BEFORE EACH PAGE' /C127 GOTO;PR4SSE PR4SS1, DISP;-1;TEXT 'STOP ONLY BEFORE THE FIRST PAGE' GOTO;PR4SSE PR4SS3, DISP;-1;TEXT 'FEED FIRST SHEET FROM FRONT TRAY, REST FROM REAR' GOTO;PR4SSE PR4SS4, DISP;-1;TEXT 'FEED FROM FRONT TRAY' GOTO;PR4SSE PR4SS5, DISP;-1;TEXT 'FEED FROM REAR TRAY' GOTO;PR4SSE /A127 PR4SS6, DISP;-1;TEXT 'FEED FROM ENVELOPE TRAY' /A127 / END OF SE DISPLAY ON FIRST PRINT MENU PAGE -- FALL THROUGH /A173 / BEGIN AP DISPLAY ON FIRST PRINT MENU PAGE /A173 PR4SSE, DISP;-1604;TEXT '' CASE;MNQAPG /M124 1;PR4APG DISP;-1;TEXT 'DO NOT ' PR4APG, DISP;-1;TEXT 'AUTOMATICALLY BREAK INTO PAGES' DISP;-1704;TEXT '' CASE;MNQOVP /M124 0001; PR4OVP DISP;-1;TEXT 'DO NOT ' PR4OVP, DISP;-1;TEXT 'PRINT EXTRA DARK' TRNSFR; PR4TWA;DLMIN1 / XTRPR4=400-. IFZERO .-401&4000 /PRINTER ARGUMENTS RELOC ADMPR5=. X=DLMPR5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR5CA, SET;0;MNTMP4 / SET UP FOR ZERO LOWER LIMIT /A111 SET;7777;MNTMP5 / SET UP FOR 4095 UPPER LIMIT /A111 ARG;PR5RD;MNTMP1 KEYWRD TEXT 'T ';PR5NC TEXT 'S ';PR5NC TEXT 'P ';PR5NC TEXT 'D ';PR5NC TEXT 'PL ';PR5PL TEXT 'RS ';PR5RS TEXT 'SS ';PR5SS TEXT 'CP ';PR5CP TEXT 'IP ';-1-PR6IP;DLMPR6 /M111 TEXT 'FR ';-1-PR6FR;DLMPR6 /M111 TEXT 'TO ';-1-PR6TO;DLMPR6 /M111 TEXT 'EO ';-1-PR6EO;DLMPR6 /EVEN/ODD EVERY-OTHER /A173 TEXT 'NO ';-1-PR2SD1;DLMPR2 /M111 TEXT 'PI ';-1-PR6PI;DLMPR6 /M111 TEXT 'AP ';-1-PR6AP;DLMPR6 TEXT 'DA ';-1-PR6DA;DLMPR6 TEXT 'SP ';-1-PR2SP;DLMPR2 /M033 TEXT 'OK ';PR5OK TEXT 'YES ';PR5YES TEXT 'PM ';PR5PM TEXT 'SE ';-1-PR6SE;DLMPR6 TEXT 'TM ';PR5TM TEXT 'EX ';-1-QD1EX;DLMQD1 /M104 TEXT 'PS ';-1-QD1PS;DLMQD1 /M104 TEXT 'BM ';PR5BM TEXT 'TW ';-1-PR2TW;DLMPR2 TEXT 'DD ';-1-PR2PNT;DLMPR2 TEXT 'CM ';-1-QD1CM;DLMQD1 TEXT 'R1 ';-1-PRCS1;DLMPRC TEXT 'R2 ';-1-PRCS2;DLMPRC PR5NC, CALL;CR1NM;DLMCR1 PR5NC1, TRNSFR;PR2RD;DLMPR2 PR5RD, CASE;MNQSTX /M124 2;-1-PR2SD1;DLMPR2 /M111 1;-1-PR2S; DLMPR2 GOTO;PR5NC1 /A111 PR5PL, SET;2;MNQSTX /M124 TRNSFR;PR2RDY;DLMPR2 PR5SS, SET;3;MNTMP1 GOTO;PR5RDS PR5RS, SET;4;MNTMP1 PR5RDS, SET;11;MNTMP5 /A111 ARG;PR5NUM;MNTMP2 /M111 NUMBER;MNTMP2;PR5NUM /M111 RANGE;MNTMP2;0;11;PR5NUM /M111 RETURN PR5CP, SET;1;MNTMP4 /A111 SET;1747;MNTMP5 /A111 ARG;PR5NUM;MNTMP2 /M111 NUMBER;MNTMP2;PR5NUM /MAKE SURE IT'S A NUMBER /M111 RANGE;MNTMP2;1;1747;PR5NUM /DOES NOT ALLOW ZERO /M111 COPY;MNTMP2;MNQCPY /STORE NEW RESULT /M124 GOTO;PR5TWD /GOOD ARG /M111 PR5OK, PR5YES, TRNSFR;PR9PST;DLMPR9 /A192 PR5AOK, SET;1;MNTMP1 RETURN PR5PM, SET;1747;MNTMP5 /A111 ARG;PR5NUM;MNTMP2 /M111 NUMBER;MNTMP2;PR5NUM /A111 RANGE;MNTMP2;0;1747;PR5NUM /A111 COPY;MNTMP2;MNQIND /M124 GOTO;PR5TWD /A111 PR5TM, SET;310;MNTMP5 /A111 ARG;PR5NUM;MNTMP2 /M111 NUMBER;MNTMP2;PR5NUM /A111 RANGE;MNTMP2;0;310;PR5NUM /A111 COPY;MNTMP2;MNQTMG /M124 GOTO;PR5TWD /A111 PR5BM, SET;310;MNTMP5 /A111 ARG;PR5NUM;MNTMP2 /M111 NUMBER;MNTMP2;PR5NUM /A111 RANGE;MNTMP2;0;310;PR5NUM /A111 COPY;MNTMP2;MNQBMG /M124 PR5TWD, TRNSFR;PR2TWD;DLMPR2 /A111 PR5NUM, TRNSFR;PR2NUM;DLMPR2 /M111 XTRPR5=400-. IFZERO .-401&4000 /PRINT MENU ARGUMENT PROCESSING RELOC ADMPR6=. X=DLMPR6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR6NX, TRNSFR;PR2TWD;DLMPR2 /A111 PR6IP, ARG;PR6BN;MNTMP2 /A111 NUMBER;MNQPGO;PR6BN /M124 GOTO;PR6NX PR6FR, ARG;PR6BN;MNTMP2 /A111 NUMBER;MNQFRP;PR6BN /M124 GOTO;PR6NX PR6TO, ARG;PR6BN;MNTMP2 /A111 NUMBER;MNQTOP;PR6BN /M124 GOTO;PR6NX PR6AP, ARG;PR6APN;MNTMP2 KEYWRD TEXT 'YES ';PR6AP1 TEXT 'NO ';PR6AP0 PR6APN, DISP;-2717;TEXT ' !&AP YES OR NO' GOTO;PR6RD PR6AP0, SET;0;MNQAPG /M124 GOTO;PR6NX PR6AP1, SET;1;MNQAPG /M124 GOTO;PR6NX PR6DA, ARG;PR6DAN;MNTMP2 KEYWRD TEXT 'DARK ';PR6DA1 TEXT 'NORMAL';PR6DA0 /C088 PR6DAN, DISP;-2717;TEXT ' !&DA DARK OR NORMAL' /C088 GOTO;PR6RD PR6DA0, SET;0000;MNQOVP /DARKNESS NORMAL /M124 GOTO;PR6NX /A034 PR6DA1, SET;0001;MNQOVP /DARKNESS DARK /M124 GOTO;PR6NX /A034 PR6EO, ARG;PR6EON;MNTMP2 /EVEN ODD ENTERED AT PRINT MENU /A173 KEYWRD /A173 TEXT 'O'; PR6EOO /ODD /A173 TEXT 'E'; PR6EOE /EVEN /A173 TEXT 'N'; PR6EOX /NO /A173 PR6EON, DISP;-2710;TEXT '!&EO EVEN, ODD, OR NO' /A173 GOTO;PR6RD /A173 PR6EOX, CLRBIT;0002;MNQSP /NO--CLEAR BOTH BITS /A173 GOTO;PR6EN1 /A173 PR6EOO, SETBIT;0002;MNQSP /A173 PR6EN1, CLRBIT;0004;MNQSP /A173 GOTO;PR6NX /A173 PR6EOE, SETBIT;0004;MNQSP /A173 CLRBIT;0002;MNQSP /A173 GOTO;PR6NX /A173 PR6SE, CLRV /A127 ARG;PR6SEN;MNTMP2 KEYWRD TEXT 'NO ';PR6SE0 TEXT 'YES ';PR6SE2 TEXT 'FIR';PR6SE1 TEXT 'ALT';PR6SE3 TEXT 'LET';PR6SE3 /A128 TEXT 'FRO';PR6SE4 TEXT 'REA';PR6SE5 TEXT 'ENV';PR6SE6 /A127 PR6SEN, DISP;-2710;TEXT ' !&SE YES, NO, FIRST, LETTER, FRONT, REAR, OR ENV' PR6RD, TRNSFR;PR2RD;DLMPR2 PR6SE6, INCV /A127 PR6SE5, INCV /A127 PR6SE4, INCV /A127 PR6SE3, INCV /A127 PR6SE2, INCV /A127 PR6SE1, INCV /A127 PR6SE0, STOV;MNQSSM /A127 GOTO;PR6NX PR6PI, ARG;PR6PI2;MNTMP2 /A111 NUMBER;MNTMP3;PR6PIC RANGE;MNTMP3;1;31;PR6PI2 GOTO;PR6PIG PR6PID, SET;21;MNTMP3 PR6PIG, COPY;MNTMP3;MNQPIT /M124 GOTO;PR6NX PR6PIC, SET;0;MNTMP3 KEYWRD TEXT 'THEM';PR6PIG PR6PI2, TRNSFR;QD1PIE;DLMQD1 PR6BN, TRNSFR;PR2NUM;DLMPR2 XTRPR6=400-. IFZERO .-401&4000 /START OF SECOND PRINT MENU RELOC ADMPR7=. X=DLMPR7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR7D1, DISP;0;TEXT '-- !&PRINT !&MENU (CONT.) --' DISP;200;TEXT '&TO CHANGE A SETTING TYPE THE LETTERS AND THE NEW SETTING ' DISP;-1;TEXT 'AND PRESS !&RETURN.' DISP;400;TEXT '!&PL = &SHOW PAGE LAYOUT SETTINGS' DISP;-1;TEXT ' (PAGE SIZE, MARGINS, ETC.)' DISP;-600;TEXT '!&SE = &STOP BEFORE EACH SHEET (!&SE ' CASE;MNQSSM /test SE setting /M124 1;PR7SFI /SE FIRST 2;PR7SEY /SE YES 3;PR7SEL /SE LETTERHEAD 4;PR7SEF /SE FRONT 5;PR7SER /SE REAR 6;PR7SEE /SE ENV DISP;-1;TEXT 'NO)' /SE SETTING NOT RECOGNIZED GOTO;PR7PR7 /M008 PR7SFI, DISP;-1;TEXT 'FIRST)' GOTO;PR7PR7 PR7SEY, DISP;-1;TEXT 'YES)' GOTO;PR7PR7 PR7SEL, DISP;-1;TEXT 'LETTER)' GOTO;PR7PR7 PR7SEF, DISP;-1;TEXT 'FRONT)' GOTO;PR7PR7 PR7SER, DISP;-1;TEXT 'REAR)' GOTO;PR7PR7 PR7SEE, DISP;-1;TEXT 'ENV)' PR7PR7, DISP;652;TEXT '!&CP = &NUMBER OF COPIES (!&CP !D)' MNQCPY /M124 DISP;-700;TEXT '!&AP = &AUTO. PAGINATE (!&AP ' CASE;MNQAPG /M124 1;PR7APG DISP;-1;TEXT 'NO)' GOTO;PR7EXI PR7APG, DISP;-1;TEXT 'YES)' PR7EXI, TRNSFR;PR8D1;DLMPR8 XTRPR7=400-. IFZERO .-401&4000 /SECOND PRINT MENU CONTINUED RELOC ADMPR8=. X=DLMPR8 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR8S, /STANDARD LABEL AT MENU TOP PR8D1, DISP;752;TEXT '!&FR = &PRINT FROM PAGE NUMBER (!&FR !D)' MNQFRP /M124 DISP;-1000;TEXT '!&DD = &DOCUMENT DESTINATION (' /There are several values that the Document Destination (MNQPNT) may be /set at since this document may have been created on an RL based system /which has destionation codes from 0 to 16 (octal) which are mapped to /something more appropiate here and in WPRTOV.PA If a change is made /to this table, then a change must also be made to the way they are mapped /in WPRTOV.PA /The default for an unrecognized destination /is the LQP so any values which would map to that are left out /of the CASE statement CASE MNQPNT /M124 DDP1; PR8LP DDP2; PR8LP DHOST1; PR8HST DHOST2; PR8DHO /TRUE HOST /C164 DHOST3; PR8HST DHOST4; PR8HST DISP;-1;TEXT '!&LQP)' GOTO;PR8LND /A006 PR8LP, DISP;-1;TEXT '!&DP)' GOTO;PR8LND PR8DHO, DISP;-1;TEXT '!&CHST)' /C168 GOTO;PR8LND PR8HST, DISP;-1;TEXT '!&CPTR)' /C168 PR8LND, DISP;1052;TEXT '!&TO = &PRINT THRU PAGE NUMBER (!&TO !D)' MNQTOP /M124 DISP;-1100;TEXT '!&DA = &DARKNESS (!&DA ' CASE;MNQOVP /M124 0001; PR8OVP SET;PR8NRM;PR8NDK PR8OVP, DISP;-1;TEXT '^S)' PR8NDK, PR8DRK DISP;1152;TEXT '!&IP = &INITIAL PAGE NUMBER (!&IP !D)' MNQPGO /M124 DISP;-1200;TEXT '!&TW = &USE TWO WHEELS (!&TW ' CASE;MNQTW /M124 1;PR8TWY DISP;-1;TEXT 'NO)' GOTO; PR8SHP /A015 PR8TWY, DISP;-1;TEXT 'YES)' GOTO;PR8SHP /M015 PR8DRK, TEXT 'DARK' PR8NRM, TEXT 'NORMAL' PR8SHP, DISP; 1300; TEXT '!&SP = &SHADOW &PRINT (!&SP ' /A015 TSTBIT;MNQSP;0001;PR8SPN /C173 DISP; -1; TEXT 'YES)' /C173 TRNSFR; PR8OK; DLMQD1 /A015 PR8SPN, DISP; -1; TEXT 'NO)' /M124 TRNSFR; PR8OK; DLMQD1 /A015 XTRPR8=400-. IFZERO .-401&4000 /START OF THIRD PRINTER MENU - THE PAGE LAYOUT SETTINGS PRETTY PICTURE RELOC ADMPR9=. X=DLMPR9 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PR9QL, TEXT 'QQQQQQQQQQQQQQQQQQ' PR94Q=PR9QL+7 PR9D2, DISP;0;TEXT '!L !&PM !D (SPACES) !&CM !D (SPACES BETWEEN COLUMNS)' MNQIND;MNQCM /M124 DISP;100;TEXT '!CN+Q^S+';PR94Q DISP;200;TEXT 'LQ^SW^S^SK + +';PR94Q;PR9QL;PR9QL DISP;300;TEXT 'X &P &M X!P^S';PR9353;PR9X DISP;-400;TEXT 'X &R &A X!P!CO!&TOP !&MARGIN!CN!P X X';PR9422;PR9453 DISP;-1;TEXT ' X- !&TM !CO!D (LINES)!CN';MNQTMG /M124 DISP;500;TEXT 'X &I &R X!P^S';PR9553;PR9X DISP;600;TEXT 'X &N &G T^S^SU X';PR9QL;PR9QL TRNSFR;PRAD2;DLMPRA PR9353, 353 PR9453, 452 PR9422, 422 PR9553, 553 PR9X, TEXT 'X X X' PR9RT1, PQUEUE;PR9QD;PR9QOK / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND MUFNO /A128 / IS NOT IN QUEUE /A128 PR9QOK, / THIS DOC NOT ALREADY IN QUE SO /A128 CMND;1;210;CIF CDF 20 / QUEUE IT UP FOR PRINTING RETURN PR9QD, CALL;CR2QDP;DLMCR2 TRNSFR;MM1S;DLMMM1 /THIS IS PART OF THE PR4 STUFF, MOVED HERE BECAUSE /IT FITS HERE, PLUS IT WINDS UP ON THIS PAGE ANYWAY. PR2CNT, DISP;-2504 TEXT '&IF ALL SETTINGS ARE CORRECT TYPE !&YES, OTHERWISE TYPE !&NO,' DISP;-2604;TEXT 'THEN ^S.';PR9PRT /A192 TRNSFR;PR2CA;DLMPR2 PR9PST, TSTBIT;MNPULD;4000;PR9AOK /A192 DISP;0;TEXT '!E^P&PRINTER &BUSY';PR9PRC /A192 DISP;1614;TEXT '&^S';PR9PRT /A192 READ;MNTMP1;PR9PSX /A192 PR9PSX, TRNSFR;PR3D0;DLMPR3 /A192 PR9PRC, 1424 /A192 PR9AOK, TRNSFR;PR5AOK;DLMPR5 /A192 PR9PRT, TEXT 'PRESS !&RETURN' /M192 XTRPR9=400-. IFZERO .-401&4000 /THIRD PRINTER MENU CONTINUED RELOC ADMPRA=. X=DLMPRA / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PRA153, 1153 PRA353, 1353 PRA553, 1553 PRA653, 1653 PRA753, 753 PRA733, 1733 PRAD2, DISP;-1;TEXT ' +' /FINISH THE LINE 6 THERE IS NOT ENOUGH ROOOM ON /THE PREVIOUS MENU PR9 TO DISPLAY THIS DISP;700;TEXT 'X &T &I X!PX X';PRA753 DISP;1000;TEXT 'X &E &N X ' DISP;-1;TEXT ' X X +' DISP;-1100 TEXT 'X &R X!PX X X- !&EX !CO!D (EXTRA HALF LINES)!CN' /M107 PRA153;MNQLSZ /M124 DISP;1200;TEXT 'X X !CO!&THIS !&IS !&WHERE !&THE !&TEXT ' DISP;-1;TEXT '!&OF!CN X X +' DISP;1300;TEXT 'X X!PX X';PRA353 DISP;1400;TEXT 'X X !CO!&THE !&DOCUMENT !&WILL !&BE ' DISP;-1;TEXT '!&PRINTED!CN X X' DISP;-1500;TEXT 'X X!PX X- !&PS !CO!D (TOTAL LINES)!CN';PRA553;MNQPSZ /M124 DISP;1600;TEXT 'X X +-+!PX X' PRA653 DISP;-1700;TEXT 'X X!P!&PI !CN';PRA733 TRNSFR;PRBD2;DLMPRB XTRPRA=400-. IFZERO .-401&4000 /THIRD PRINTER MENU CONTINUED RELOC ADMPRB=. X=DLMPRB / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PRBD2, CASE;MNQPIT /M124 0;PRAPPI DISP;-1;TEXT '!D';MNQPIT /M124 DISP;2000;TEXT 'X X!CO!P(PITCH IN CHARS/IN.)!CN' PRB024 GOTO;PRASPI PRAPPI, DISP;-1;TEXT '!COTHEME!CN' DISP;-2000;TEXT 'X X!P!CO(PITCH)!CN';PRB037 PRASPI, DISP;1753;TEXT 'X X' DISP;2053;TEXT 'X X' DISP;2100;TEXT 'X X!PX X';PRBA53 DISP;2200;TEXT 'X T^SU X +';PRBHL DISP;2300;TEXT 'X X!PX X X';PRBC53 DISP;-2400;TEXT 'X X!CO!P!&BOTTOM !&MARGIN!CN';PRBD20 DISP;2453;TEXT 'X X X- !CO!&BM !D (LINES)!CN';MNQBMG /M124 DISP;2500;TEXT 'X X!PX X X';PRBE53 DISP;2600;TEXT 'MQQQQQV^SJ + +!CO';PRBHL DISP;2720;TEXT '&JUST PRESS !&RETURN TO GET BACK TO THE OTHER MENU.' TRNSFR;PR2CA;DLMPR2 PRB024, 2024 PRB037, 2034 PRBA53, 2153 PRBHL, TEXT 'QQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQQ' PRBC53, 2353 PRBD20, 2420 PRBE53, 2553 XTRPRB=400-. IFZERO .-401&4000 /MORE OF THE FIRST AND SECOND PRINT MENUS RELOC ADMPRC=. X=DLMPRC / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THIS IS THE CODE THAT WILL INTERPRET WHAT IS TYPED FOR R1 & R2 PRCS1, ARG;PRCSE1;MNTMP2 COPY;MNQSB2;PRCRN1 /SET UP VALUES FOR RANGE CHECK /A170 COPY;MNQSB2;PRCRN1+1 /... /A170 RANGE;MNARG /CHECK FOR EQUALITY /A170 PRCRN1, XX;XX /A170 PRCR1S /GO TO THIS LABEL IF DIFFERENT /A170 PRCRCE, DISP;-2700;TEXT '&R1 AND &R2 MUST BE DIFFERENT. &TRY AGAIN.' /A170 GOTO;PRCRE1 /A170 PRCR1S, COPY;MNARG;MNQSB1 /M124 PRCRED, DISP;-2700;TEXT '' PRCRE1, TRNSFR;PR2RDN;DLMPR2 PRCS2, ARG;PRCSE2;MNTMP2 COPY;MNQSB1;PRCRN2 /SET UP VALUES FOR RANGE CHECK /A170 COPY;MNQSB1;PRCRN2+1 /... /A170 RANGE;MNARG /CHECK FOR EQUALITY /A170 PRCRN2, XX;XX /...STORE VALUES HERE /A170 PRCR2S /GO TO THIS LABEL IF DIFFERENT /A170 GOTO; PRCRCE /REPLACEMENT CHARACTERS ARE SAME /A170 PRCR2S, COPY;MNARG;MNQSB2 /M124 GOTO;PRCRED PRCSE1, SET;0;MNQSB1 /M124 GOTO;PRCRED PRCSE2, SET;0;MNQSB2 /M124 GOTO;PRCRED /THE FIST PRINT MENU THE PART DEALING WITH SB1 AND 2 PRCCN2, DISP;-2204;TEXT '' CASE;MNQSB1 /M124 0;PRCSB1 COPY;MNQSB1;PRCSTR /M124 DISP;-1;TEXT "'^A' IS THE FIRST REPLACEMENT CHARACTER";PRCSTR PRCSB1, DISP;-2304;TEXT '' CASE;MNQSB2 /M124 0;PRCSB3 COPY;MNQSB2;PRCSTR /M124 DISP;-1;TEXT "'^A' IS THE SECOND REPLACEMENT CHARACTER";PRCSTR PRCSB3, TRNSFR;PR2CNT;DLMPR9 /THE SECOND PRINT MENU BOTTOM PRCCNT, DISP;2000;TEXT '!&SS = &STORE PRINT SETTINGS' DISP;2100;TEXT '!&RS = &RETRIEVE STORED PRINT SETTINGS' DISP;-2413;TEXT '&IF ALL SETTINGS ARE CORRECT, TYPE !&OK ' MXDISP;-1;X02APR;DLMX02 /'AND PRESS RETURN' /C170 MXDISP;-2513;X02PGM;DLMX02 /'OR Press Gold Menu ... DISP;2565;TEXT ' WITHOUT PRINTING.' /overwrite '.' in X02PGM TRNSFR;PR2CA;DLMPR2 PRCSTR, ZBLOCK 2 XTRPRC=400-. IFZERO .-401&4000 / PRINT QUEUE MESSAGES AND OTHER STUFF RELOC ADMQD1=. X=DLMQD1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 QD1CM, SET;1747;MNTMP5 /A111 ARG;QD1NUM;MNTMP2 NUMBER;MNTMP1;QD1NUM RANGE;MNTMP1;0;1747;QD1NUM /A111 COPY;MNTMP1;MNQCM /M124 QD1CM1, TRNSFR;PR2TWD;DLMPR2 /M111 QD1NUM, TRNSFR;PR2NUM;DLMPR2 QD1PIE, DISP;2717;TEXT '!&PI MAY BE FOLLOWED BY A NUMBER BETWEEN 1 AND 25' DISP;-1;TEXT ' OR THEME' TRNSFR;PR2RD;DLMPR2 QD1PS, SET;1;MNTMP4 /A111 SET;310;MNTMP5 /A111 ARG;QD1NUM;MNTMP2 / CHECK FOR A VALID PAGE SIZE < 200 /M111 NUMBER;MNTMP3;QD1NUM /M111 RANGE;MNTMP3;1;310;QD1NUM /M111 COPY;MNTMP3;MNQPSZ /M124 GOTO;QD1CM1 /M111 QD1EX, SET;3;MNTMP5 /A111 ARG;QD1NUM;MNTMP2 /M111 NUMBER;MNTMP3;QD1NUM /M111 RANGE;MNTMP3;0;3;QD1NUM /M111 COPY;MNTMP3;MNQLSZ /M124 GOTO;QD1CM1 /M111 PR8OK, DISP;-1252;TEXT '&E&O = &EVERY &OTHER PAGE (&E&O ' /A184 TSTBIT;MNQSP;6;EOPNO /IF NEITHER BIT IS SET WE AREN'T EO /A184 TSTBIT;MNQSP;4;EOPODD /IF NOT THIS BIT WE ARE ODD /A184 DISP;-1;TEXT 'EVEN)' /ELSE WE ARE EVEN /A184 GOTO;PR8OK1 / /A184 EOPNO, DISP;-1;TEXT 'NO)' /EO NO /A184 GOTO;PR8OK1 / /A184 EOPODD, DISP;-1;TEXT 'ODD)' /EO ODD /A184 PR8OK1, DISP;-1500;TEXT '&R1 = &R^S1 ';PR8REP CASE;MNQSB1 /M124 0;PR8SB1 COPY;MNQSB1;PR8STR /M124 DISP;-1;TEXT '(&R1 ^A)';PR8STR PR8SB1, DISP;-1600;TEXT '&R2 = &R^S2 ';PR8REP CASE;MNQSB2 /M124 0;PR8SB2 COPY;MNQSB2;PR8STR /M124 DISP;-1;TEXT '(&R2 ^A)';PR8STR PR8SB2, TRNSFR;PRCCNT;DLMPRC /CONTINUE DISPLAYING THE SENCOND PRINT MENU PR8REP, TEXT 'EPLACEMENT CHARACTER FOR EXTRA PRINT WHEEL POSITION ' PR8STR, ZBLOCK 2 XTRQD1=400-. IFZERO .-401&4000 /CREATE DOCUMENT ENTRY MENU RELOC ADMPP1=. X=DLMPP1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PP1S, CALL; CM2FNM; DLMCM2 / Check out dangling filename /A051 CASE; MNTMP1; 0; -1-MM0RD; DLMMM0/ check for erroroneous filename/A051 PP1S1, DISP;0;TEXT '!E ' FILNAM;PP1RD;PP1ND PP1DF, DISP; 2205; TEXT '^A'; PP1BEL /A126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; PP1NW1 / CK FOR WINCHESTER /A126 CASE; MNDRV / YES, CK FOR AREA 1 /A126 0; PP1NW1 / 0 MUST BE A DRIVE /A126 1; PP1A1T / 1 DRIVE OR DEVICE, GO CK. /A126 PP1DSW, DISP; -1; TEXT '&DEVICE' /A126 GOTO; PP1DF1 /A126 PP1A1T, TSTBIT; MNOPTN; MNRX3X; PP1NW1 / CK FOR VOLUME ASSIGNED /A126 GOTO; PP1DSW / YES /A126 > / END IFDEF CONDOR /A126 PP1NW1, DISP; -1; TEXT '&DRIVE' /A126 PP1DF1, DISP; -1; TEXT ' !D ALREADY HAS A DOCUMENT NAMED !A' /A126 MNDRV MNFNAM DISP;2405;TEXT '&PRESS !&RETURN TO TRY ANOTHER NAME.' READ;MNTMP1;PP1DF ARG;PP1RD;MNTMP1 GOTO;PP1DF PP1RD, DISP;0;TEXT '!E ' DISP;2105;TEXT '&TYPE THE NAME TO BE GIVEN TO THE DOCUMENT YOU WISH TO CREATE' DISP;2205;TEXT 'AND PRESS !&RETURN' DISP;2405;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ;MNTMP1;PP1RE GOTO;PP1S1 PP1RE, CASE;MNSYSA /M117 EDMENU&3777;PP1MM CALL;CR1BR;DLMCR1 GOTO;PP1RD PP1MM, TRNSFR;MM1S;DLMMM1 PP1ND, SET;0;MNTMP2 SET;0;MNMATH /INITIALIZE MATH FLAG TSTBIT;MNOPTC;MABIT;PP1EX /CHECK IF MATH IS SET SET;1;MNMATH /SET MATH FLAG PP1EX, CMND;1;204;CIF CDF 20 RETURN PP1BEL, BELL;0 XTRPP1=400-. IFZERO .-401&4000 / EDITOR ENTRY MENU RELOC ADMED1=. X=DLMED1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /****** THIS CODE MUST BE AT THE START OF A BLOCK *** /A157 / CALLED FROM "PHONE" WHEN GOING TO "LOGON" /A157 SET; 11; MNTMP6 / SHOW "PHONE" GETTING FILE FOR "LOGON" /A157 TSTBIT;MNLGFN;-1;ED1RD / TRANSFER IF NO DEFAULT FILE SET /A163 COPY;MNLGFN;MNUTFN / SET UP DEFAULT LONON FILE /M179 RETURN / GO USE DEFAULT LOGON FILE /A163 /D163 ED1PHL, ARG; ED1RD; MNTMP1/ DRAIN FILENAME AND GO GET FILE /A157 /D163 GOTO; ED1PHL / LOOP UNTIL EMPTY /A157 / EDIT, DELETE, PRINT, LOGON, PHONE pre-processing /M157 / THE FOLLOWING VALUES ARE DEFINED FOR MNTMP1 AND MNTMP6 / 0 FOR DELETE. / 1 FOR PRINT. / 2 FOR EDIT. / 3 FOR SEND. / 4 FOR USE (LOGON MENU) / 5 FOR RECEIVE THE TEXT" (CX TO DOC) / 6 FOR SPELL CHECK. / 7 FOR LOAD USER DICTIONARY / 10 FOR USE (PHONE MENU) / 11 FOR USE (LOGIN FOR PHONE) / 12 FOR FOOTNOTING / 13 FOR UPDATE USER DIRECTORY /D179 ED1DE, SET;0;MNTMP6 / 0 for DELETE. /A112 /D179 GOTO;ED1PRM / Prompt for filename. /A112 /D179 ED1PR, SET;1;MNTMP6 / 1 for PRINT. /A112 /D179 GOTO;ED1PRM / Prompt for filemane. /A112 /D179 ED1S, SET;2;MNTMP6 / 2 for EDIT. /A112 /D179 GOTO;ED1PRM / Prompt for filename. /A112 ED1PH, SET; 10; MNTMP6 / 10 for PHONE /A157 TSTBIT;MNADFN;-1;ED1PRM / SKIP IF NO DEFAULT FILE SET /A179 GOTO;ED1TFN / GO CHECK FOR A FILE NAME /A179 /D179 GOTO; ED1PRM /A157 ED1LO, DISP;0;TEXT '!E' / CLEAR SCREEN FOR LOGON ENTRY /A163 SET;4;MNTMP6 / 4 for LOGON. /A112 TSTBIT;MNLGFN;-1;ED1PRM / SKIP IF NO DEFAULT FILE SET /A163 ED1TFN, COPY;MNPOS;MNTMP2 / SAVE CURRENT POSITION /A163 ARG;ED1BL;MNTMP1 / CHECK FOR A BLANK LINE /M179 COPY;MNTMP2;MNPOS / NO, RESTORE POSITION /A163 GOTO;ED1PRM / GO HANDLE USER SPECIFIED FILE /A163 ED1BL, CASE;MNTMP6 / CHECK WHICH DEFAULT FILE TO USE /A179 10;ED1PHF / GO SET UP PHONE FILE /A179 ED1LGF, COPY;MNLGFN;MNUTFN / SET UP DEFAULT LONON FILE /M179 GOTO;ED1RT / GO USE DEFAULT LOGON FILE /A163 ED1PHF, COPY;MNADFN;MNUTFN / SET UP DEFAULT AUTODIAL FILE /A179 GOTO;ED1RT / GO USE DEFAULT AUTODIAL FILE /A179 IFDEF CONDOR < /A131 ED1SC, /USER WANTS SPELL, STOP HIM USING PRINT SCREEN THEN SETBIT;4000;MNPULD TSTBIT;MNOPTN;MNRX6X;-1-CI1NAP;DLMCI1 / Check for APU board /M157 > / End ifdef condor /A131 /D155 GOTO;ED1PRM / Prompt for filename. /A121 /A112 ED1PRM, CALL; CM2FNM; DLMCM2 / Check out dangling filename /A051 CASE; MNTMP1; 0; -1-MM0RD; DLMMM0/ check for erroroneous filename/A051 DISP;0;TEXT '!E' ED1PRF, FILNAM;ED1RD;ED1ND / CHECK VALIDITY OF FILE NAME /M179 ED1UFN, COPY;MNFNO;MNUTFN / SET UP UTILITY FILE NUMBER IF NEEDED /A179 ED1RT, CASE;MNTMP6 / Now determine which utility to startup/A112 0;ED1DEX / 0 for DELETE. /A112 1;-1-PR9RT1;DLMPR9 / 1 for PRINT. /A112 4;-1-MM0LO;DLMMM0 / 4 for LOGON. /A112 IFDEF CONDOR < / No spell on a DM I /A149 6;ED1SEX / 6 for Spell Check. /A121 7;ED1SE1 / 7 for Load user dictionary /A131 10; -1-MM0PH; DLMMM0 / 10 for PHONE /A157 11; ED1LV / 11 for ret. to PHONE with LOGON file /A157 12;-1-PPMOKR;DLMPPM / FOR FOOTNOTING /A155 13;ED1SEX / 13 for Update user dictionary /A172 > / END IFDEF CONDOR /A149 / 2;.+1 / 2 for EDIT. /A112 SET;0;MNMATH /INITIALIZE MATH FLAG TSTBIT;MNOPTC;MABIT;ED1EX /CHECK MATH BIT;TRANSFER IF OFF SET;1;MNMATH /IF ON, SET FLAG ED1EX, / DELETE DOCUMENT--CHECK PRINT QUEUE PQUEUE;QD1QD;QD1EDR / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND /A128 / MNFNO DOESN'T MATCH /A128 QD1EDR, CMND;2;200;CIF 10 / CALL DELETE DOCUMENT CU ED1LV, RETURN /M157 QD1QD, CALL;CR2QDE;DLMCR2 TRNSFR;MM1S;DLMMM1 ED1ND, CALL;CR1ND;DLMCR1 ED1RD, COPY;MNTMP6;MNTMP1 / Set for PROMPT. /M112 CASE; MNTMP6 / SPECIAL CASE WHEN CALLED FROM WPLOG /A157 11; ED1RD1 / ... /A157 CALL;CM2DSP;DLMCM2 / ... /A109 GOTO; ED1RD2 / /A157 ED1RD1, CALL; CM2NCS;DLMCM2 / DON'T CLEAR SCREEN ENTRY POINT /A157 ED1RD2, READ;MNTMP1;ED1RE CASE;MNFNO 0;ED1PRF /M179 FILNAM;ED1NN;ED1ND GOTO;ED1UFN / SET UP FILE NAME AND START /M179 /D179 ED1F01, FILNAM;ED1RD;ED1ND /D179 GOTO;ED1RT ED1RE, CASE;MNSYSA /M117 /D157 EDMENU&3777; -1-MM1S;DLMMM1 EDMENU&3777; ED1GM /A157 CALL;CR1BR;DLMCR1 GOTO;ED1RD ED1GM, CASE; MNTMP6 / FORCE A RETURN TO WPLOG IF REQUIRED /A157 11; ED1LV /A157 TRNSFR; MM1S; DLMMM1 / NORMAL GOLD MENU RETURN /A157 ED1NN, CASE;MNFNO 0;ED1ND GOTO;ED1UFN / SET UP FILE NAME AND START /M179 / Delete exit. ED1DEX, PQUEUE;ED1QD;ED1QOK / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND MUFNO /A128 / IS NOT IN QUEUE /A128 / THUS WE MAY EDIT WHILE PRINTING /A128 / PROVIDED THE PARTICULAR DOCUMNET /A128 / IS NOT IN THE PRINT QUEUE /A128 ED1QOK, /A128 CMND;20;200;CIF CDF 20 RETURN ED1QD, CALL;CR2QDD;DLMCR2 TRNSFR;MM1S;DLMMM1 IFDEF CONDOR < /A131 / Load user dictionary /A131 /D169 ED1SE1, TSTBIT; MNOPTN; MNRX7X; ED1SEX / Check if the APU has been loaded/A131 /D169 GOTO; ED1SE2 / It has been... /A131 ED1SE1, TSTBIT;MNFMAT;MNFM3X;ED1AMR / Check which dictionary req'std/A169 TSTBIT;MNPULD;MNRX1X;ED1SEX / British req. Is it loaded ? /A169 GOTO;ED1SE2 / Yes it is... /A169 ED1AMR, TSTBIT;MNPULD;MNRX0X;ED1SEX / American req. Is it loaded ? /A169 GOTO;ED1SE2 / Yes it is... /A169 / APU has been loaded once, how does the user wish to modify the /A131 / user dictionary area. /A131 SE2RD1, CASE; MNSYSA /A131 EDMENU&3777; -1-MM1S; DLMMM1 /A131 SE2RD2, DISP; 0; TEXT '^CG' /M169 ED1SE2, TRNSFR; PR1APU; DLMPR1 / Display the user prompt /A131 ED1APU, / Return here to read users response /A131 SE2RD, READ; MNTMP1; SE2RD1 /A131 ARG; SE2RD; MNTMP1 /A131 KEYWRD /A131 TEXT 'A ';SE2ADD / ADD to user dictionary /A131 TEXT 'O ';SE2OVR / OVERWRITE user dictionary /A131 GOTO; SE2RD2 / GARBAGE /A131 SE2ADD, SET; 0; MNTMP5 / 0 - TMP5 for ADD /A131 GOTO; ED1SEX /A131 SE2OVR, SET; 1; MNTMP5 / 1 - TMP5 for OVERWRITE /A131 /D179 GOTO; ED1SEX /A131 / Spelling Corrector exit. ED1SEX, SETBIT;4000;MNPULD / SWITH OFF PRINT SCREEN CMND;21;7400;CIF 10 /M132 RETURN / START UP THE SPELLING CORRECTOR /A121 /D169 ED1BEL, 7;0 /A131 > /END IFDEF CONDOR /A131 XTRED1=400-. IFZERO .-401&4000 / DISKETTE MAINTENANCE MENU RELOC FIELD 3 /A036 *0 /A036 ADMDU1=. X=DLMDU1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / THE BEGINNING OF THIS PAGE IS ENTERED FROM CPYDSK /A074 / AND HARD DISK MENU /A160 DU1SS, /A160 CLRRTN /CLEAR THE PENDING RETURN /A074 DU1S, SET;1;MNTMP1 /ENTRY POINT MC FROM MAIN MENU PQUEUE;DU1FQ;DU1EQU / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND /A128 / MNFNO DOESN'T MATCH /A128 DU1FQ, SET;0;MNQCPY /SPECIFY "DOCUMENTS" /A128 CALL;CR2FQ;DLMCR2 DU1MM, TRNSFR;MM1S;DLMMM1 DU1EQU, DISP; 0; TEXT '!E-- ' IFNDEF CONDOR < /A126 DISP; -1; TEXT '!&DISKETTE ' > / END IFNDEF CONDOR /A126 DISP; -1; TEXT '!&MAINTENANCE !&MENU --' /A126 /D129 IFDEF UNBUND < /A004 DISP;305;TEXT '&A = &ACTIVATE OPTIONAL FEATURES' /A004 /D129 > /END IFDEF UNBUND /A004 IFNDEF CONDOR < /A054 IFNDEF STORECPY < /A046 DISP;505;TEXT '&B = &MAKE !&BACKUP COPY OF YOUR^S';DU1DSK /A036 > /END STORECPY /A046 > /END IFNDEF CONDOR /A054 IFDEF CONDOR < /A054 DISP;505;TEXT '&B = &MAKE !&BACKUP COPY OF YOUR^S';DU1DSK /A054 > /END IFDEF CONDOR /A054 DISP;705;TEXT '&C = ©^S';DU1DOC /C181 DISP;1105;TEXT '&D = &^S^S^S';DU1INI;DU1DOC;DU1DSK /C181 IFNDEF CONDOR < /A054 IFNDEF STORECPY < /A046 DISP;1305;TEXT '&S = &^S^S AND COPY SYSTEM ONLY' /C181 DU1INI; DU1DSK; /C181 > /END STORECPY /A046 > /END IFNDEF CONDOR /A054 DISP;1305;TEXT '&S = &^S^S';DU1INI; DU1DSK /C181 IFDEF CONDOR < /A181 TSTBIT;MNOPTN;MNRX2X;DU1SMS /TEST FOR HARD DISK /A181 DISP;-1;TEXT '^S';DU1VOL /A181 > /A181 DU1SMS, DISP;-1;TEXT ' AND COPY SYSTEM ONLY' /A181 DISP;1505;TEXT '&V = &VERIFY STRUCTURE OF^S';DU1DSK /M004 IFDEF CONDOR < /A054 TSTBIT;MNOPTN;MNRX1X;DU1WIN /C126 > / END IFDEF CONDOR /A126 DISP;1704;TEXT '!&FD = &FORMAT DOUBLE DENSITY^S';DU1DSK DISP;2104;TEXT '!&FS = &FORMAT SINGLE DENSITY^S';DU1DSK IFDEF CONDOR < /A126 DU1WIN, TSTBIT;MNOPTN;MNRX2X;DU1RX2 /A126 DISP;0552;TEXT '^S';DU1VOL /A126 DISP;1147;TEXT '^S';DU1VOL /A126 DISP;1545;TEXT '^S';DU1VOL /A126 DISP;1705;TEXT '!&AV = &ASSIGN VOLUMES ON HARD DISK' /C181 > /END IFDEF CONDOR DU1RX2, SET;0;MNTMP4 / CLEAR TEMP 4 TO ZERO /A098 TRNSFR;DU2RD0;DLMDU2 /A058 DU1INI, TEXT 'INITIALIZE A' /A004 /C065 DU1DSK, TEXT ' DISKETTE' /A004 DU1DOC, TEXT ' DOCUMENT' /A181 IFDEF CONDOR < /A126 DU1VOL, TEXT ' OR VOLUME' /A126 > / END IFDEF CONDOR /A126 XTRDU1=400-. IFZERO .-401&4000 /MORE OF INITIALIZE UTILITY /REWROTE THIS TO MAKE IT MORE READABLE /A074 RELOC ADMDU2=. X=DLMDU2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU2RD0, DISP; 2405; TEXT '&TYPE THE LETTER(S) AND PRESS !&RETURN,' CALL;DU8PG;DLMDU8 / "OR PRESS GOLD ... /A074 DU2RD1, READ;MNTMP1;DU2RE / READ WHAT THE USER TYPED IN /A036 CLRV / CLEAR OUT THE VALUE /A074 STOV; MNTMP3 / CLEAR OUT SIGNAL FOR TWO INPUT TRANSACTIONS /A074 STOV; MNTMP5 / INITIALIZE MNTMP5 /A078 ARG;DU2RD1;MNTMP1 / GET ARGUMENT TYPED IN /A036 KEYWRD /A036 /D129 IFDEF UNBUND < /A036 TEXT 'A ';-1-DU2UNB;DLMDU2 /A036 /D129 > / END IFDEF UNBUND /A036 IFNDEF STORECPY < /A046 TEXT 'B ';DU2BB / BACK UP COPY WANTED? /A036 /D150 IFNDEF CONDOR < /A126 TEXT 'S '; DU2SC / SYSTEM DISKETTE INIT? /A036 /D150 > / END IFNDEF CONDOR /A126 /D150 IFDEF CONDOR < /A126 /D150 TEXT 'S '; DU2SC1 / SYSTEM DISKETTE INIT? /C126 / CK FOR WINCHESTER FIRST /A126 /D150 > / END IFDEF CONDOR /A126 > /END STORECPY /A046 TEXT 'C ';-1-DU6DSP;DLMDU6 / COPY UTILITY WANTED? /A036 TEXT 'D ';DU2DC / DOCUMENT INITIALIZATTION? /A036 TEXT 'V ';DU2VC / VERIFY A DISKETTE /A054 IFDEF CONDOR < /A054 TSTBIT;MNOPTN;MNRX1X;DU2WT / IF NOT RXO2, IGNORE FD/FS /A054 > / END IFDEF CONDOR /A054 KEYWRD / ALLOW FS/FD TO FALL THRU /A054 TEXT 'F ';DU2ER / ONLY F, ERROR /A054 TEXT 'FD ';DU2FD / GO PROCESS FORMAT DBL /A054 TEXT 'FS ';DU2FS / GO PROCESS FORMAT SNGL /A054 IFDEF CONDOR < /A126 DU2WT, TSTBIT;MNOPTN;MNRX2X;DU2ER /A126 KEYWRD /A126 TEXT 'AV '; DU2WUC / HARD DISK MAINT. MENU /M160 /A126 > / END IFDEF CONDOR DU2ER, CALL;CR1NM;DLMCR1 / GO TELL HIM HE MADE A MISTAKE GOTO;DU2RD1 / READ THE NEXT TRY. /A040 DU2RE, CASE; MNSYSA /A036 EDMENU&3777;DU2MM / CHECK FOR GOLD MENU AGAIN /A036 CALL;CR1BR;DLMCR1 / ERROR-TYPE ONLY LEGAL CHAR. /A036 TRNSFR;DU1S;DLMDU1 / GO DISPLAY MAIN MENU /A036 DU2MM, TRNSFR;DU1MM;DLMDU1 / GOLD MENU /A036 /DONT ALLOW PRINT SCREENS WHEN USER WANTS TO BACKUP AS IT MAY TRY /A196 /TO BLAST FROM THE SYSTEM DISK /A196 DU2BB, SETBIT;4000;MNPULD /AVOID PRINT SCREENS /A196 GOTO;DU2BBC DU2FD, INCV / USER TYPED "FD" /A074 DU2FS, INCV / "FS" /A074 DU2DC, INCV / "D" /A074 DU2SC, INCV / "S" /A074 DU2BBC, INCV / "B" /A074 DU2VC, STOV; MNTMP1 /A074 TRNSFR;DU5RD1;DLMDU5 / GO GET DRIVE NUMBERS /A054 / "DU2SC1" NOT REFERENCED IN CREF /A181 / TRANSFER TO "DU2SC1" WAS DELETED BY EDIT 150 /A181 /D181 DU2SC1, TSTBIT; MNOPTN; MNRX2X; DU2SC / CK FOR WINCHESTER /A126 /D181 TRNSFR; DUACKN; DLMDUA / YES - GO CK DRIVE NUMBER /A126 DU2WUC, CMND; 31; 200; CIF 10 / SET UP FOR OVERLAY /A126 RETURN /A126 DU2VRF, CMND;14;200;CIF 10 / SET UP OVERLAY PARAMETERS RETURN / TRANSFER TO VERIFY PROGRAM IFDEF UNBUND < /A004 DU2UNB, SET;0;MNTMP5 /CLEAR SCREEN REFRESH FLAG /A004 CMND;25;204;CIF CDF 20 /UNBUNDLING OPERATIONS /A004 RETURN /A004 > /END IFDEF UNBUND /A004 IFNDEF UNBUND < /A129 DU2UNB, TRNSFR;UB1AF;DLMUB1 /GO TO ACTIVATE FEATURES MENU /A129 > /END IFNDEF UNBUND /A129 DU2FDS, DISP;0;TEXT '!E-- !&FORMAT !&^S!&UTILITY --';DU2FDM /C177 DISP;1505;TEXT '&INSERT THE ^STHAT IS TO BE FORMATTED ' /C177 *.-1 /A177 TEXT 'INTO DRIVE !D';DU2FDM;MNTMP5 /DISPLAY DRIVE NBR /C177 DISP;1705;TEXT '&AND WHEN READY TYPE !&FORMAT AND THEN' /C177 *.-1 /A177 TEXT ' &PRESS !&RETURN' /C177 TRNSFR;DU3ORP;DLMDU3 /A054 / PART OF "VERIFY DISKETTE" MESSAGE FOR MC-B /A177 DU2MS2, DISP;1003;TEXT "&ANY ERRORS ON THE !&SOURCE !&^SWILL BE COPIED" /A177 *.-1 /A177 TEXT " TO THE DESTINATION";DU2FDM /A177 TRNSFR;DU4DS3;DLMDU4 /A181 /D181 RETURN /A177 DU2FDM, TEXT "DISKETTE " /A177 XTRDU2=400-. IFZERO .-401&4000 / MORE OF INITIALIZE UTILITY / THIS MENU DISPLAY IS CALLED FROM TWO PLACES. FROM THE 'MC' MENU DISPLAY / AND FROM COPY DISK FORMAT ROUTINE. THE CMND INSTRUCTIONS ARE INACTIVE / WHEN THE ORIGINAL MENU CALL IS FROM ASSEMBLY LANGUAGE LEVEL. RELOC ADMDU3=. X=DLMDU3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU3DSP, DISP;0;TEXT '!E -- !&INITIALIZE ' IFDEF CONDOR < /A126 SET; 0; MNTMP4 / RESET DISKETTE/VOLUME FLAG /A126 > / END IFDEF CONDOR /A126 CASE;MNTMP1 / CHECK FOR SYSTEM INITIALIZATION 2;DU3SYS DISP;-1;TEXT '!&DOCUMENT' GOTO;DU3SY1 /CHECK FOR WINNIE /A150 DU3SYS, DISP; -1; TEXT '!&SYSTEM' /A150 DU3SY1, /A150 IFNDEF CONDOR < /A126 GOTO; DU3NWN /A126 > / END IFNDEF CONDOR /A126 IFDEF CONDOR < /A126 TSTBIT;MNOPTN;MNRX4X;DU3SY2 /IS DRIVE 0 WINNIE? /A153 RANGE;MNTMP5;10;MNMXDR;DU3DSV /IF 8 OR 9 THEN DISKETTE /C154 GOTO;DU3NWN /C154 DU3SY2, /A153 TSTBIT;MNOPTN;MNRX2X;DU3NWN / CK FOR WINCHESTER /A126 CASE; MNTMP5 /A126 1; DU3TD1 / CK FOR DRIVE/DEVICE = 1 /A126 GOTO; DU3DSV / GO DISPLAY "VOLUME /A126 DU3TD1, TSTBIT; MNOPTN; MNRX3X; DU3NWN / IS A VOLUME ASSIGNED TO DEV 1 /A126 DU3DSV, DISP;-1;TEXT ' !&VOLUME !&MENU --' / YES /A126 SET; 1; MNTMP4 / FLAG AS A VOLUME /A126 GOTO; DU3NME /A126 > / END IFDEF CONDOR /A126 DU3NWN, DISP; -1; TEXT ' !&^S!&MENU --';DSKMS1 /C177 CASE;MNTMP3; / DON'T ASK HIM TO PUT DISK IN DRIVE 1 IF WE'RE 1;DU3NME / FOLLOWING A FORMAT COMMAND DISP;1505;TEXT '&PUT THE ^STO BE INITIALIZED INTO ';DSKMS1 /C177 DISP;-1;TEXT 'DRIVE !D.';MNTMP5 /DISPLAY DR NBR /A054 DU3NME, DISP;1705;TEXT '&TYPE A SIX CHARACTER NAME TO BE GIVEN TO THE ' IFDEF CONDOR < /A126 TSTBIT; MNTMP4; TEST1; DU3SVL /CK VOLUME OR DISKETTE /A126 DISP; -1; TEXT 'VOLUME ' /A126 GOTO; DU3SV2 /A126 > / END IFDEF CONDOR /A126 DU3SVL, DISP; -1; TEXT '^S';DSKMS1 /C177 DU3SV2, DISP; -1; TEXT 'AND PRESS !&RETURN,' CALL;DU8PG;DLMDU8 /"OR PRESS GOLD..." /A074 DU3RD, READ;MNTMP4;DU3RE DU3OVR, TRNSFR;CPMLOD;DLMCPM / GET CPYDSK'S MENU BLOCK IN & LET IT /C147 / DO THE "CMND" TO START CPYDSK /A147 /D147 RETURN DU3RE, SET;0;MNTMP4 / SET INDICATOR FOR GOLD MENU CASE; MNSYSA EDMENU&3777;-1-MM1S;DLMMM1 CALL;CR1BR;DLMCR1 /CLOBBER MNTMP1 /A074 STOV;MNTMP1 /RESTORE MNTMP1 /A074 GOTO;DU3DSP DU3ORP, CALL;DU8PG;DLMDU8 /"OR PRESS GOLD..." /A074 CASE;MNTMP1 / GO TO DBL/SGL DEN FORMAT /A036 4;-1-DU4RD;DLMDU4 / GO DO SINGLE DEN FORMAT /A036 5;-1-DU4FD;DLMDU4 / GO DO DOUBLE DEN FORMAT /A036 /DU3PG, DISP; -1 /A074 / TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' / RETURN /A074 DU3DS, SET;0;MNTMP3 / SIGNAL CALL FROM MAIN MENU /M074 GOTO;DU3DSP / JOIN CODE AT THE TOP /A074 /DU3DKM, TEXT ' !&DISKETTE !&MENU --' / PART OF "VERIFY DISKETTE" MESSAGE FOR MC-B /A177 DU3MS1, DISP;0703;TEXT "&REMEMBER TO VERIFY THE !&SOURCE !&^SBEFORE " /A177 *.-1 /A177 TEXT "THE COPY";DSKMS1 /A177 TRNSFR;DU2MS2;DLMDU2 /A181 /D181 RETURN /A177 DSKMS1, TEXT "DISKETTE " /A177 XTRDU3=400-. IFZERO .-401&4000 /MORE OF INITIALIZE UTILITY RELOC ADMDU4=. X=DLMDU4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU4FD, DISP;-633;TEXT '&C &A &U &T &I &O &N' /A036 DISP;-1005;TEXT '!&THE !&DOUBLE !&DENSITY ' /A036 DISP;-1;TEXT '!&DISKETTE !&THAT !&YOU !&ARE ' /A036 DISP;-1;TEXT '!&ABOUT !&TO !&FORMAT' /A036 DISP;-1105;TEXT '!&WILL !&NOT !&BE !&COMPATIBLE ' /A036 DISP;-1;TEXT '!&WITH !&OLDER !&SINGLE ' /A036 DISP;-1;TEXT '!&DENSITY !&WPS !&SYSTEMS' /A036 DU4RD, / READ WHAT USER TYPED IN /A036 COPY;MNTMP1;MNTMP2 /SAVE TEMP DU4RRD, READ;MNTMP1;DU4RE2 / IF GOLD MENU GO CHECK IT /A036 ARG;DU4RRD;MNTMP1 / SET UP FOR COMPARE /A036 KEYWRD /A036 TEXT 'FORMA ';DU4ERR / IF THIS MUCH THEN ERROR /A036 TEXT 'FORMAT ';DU4OK / GO PROCESS IT /A036 DU4ERR, CALL;CR1NM;DLMCR1 /NO MEANING MESSAGE - GO ISSUE IT GOTO;DU4RRD /READ USER AGAIN DU4OK, DISP;100;TEXT '!E' / ERASE SCREEN /A036 COPY;MNTMP2;MNTMP1 / RESTORE TEMP /A036 CMND;4;200;CIF 10 / CALL COPY /A036 RETURN /A036 DU4RE2, CASE; MNSYSA / CHECK FOR GOLD MENU /A036 EDMENU&3777;-1-MM1S;DLMMM1 / IF GOLD MENU DISPLAY IT /A082 CALL;CR1BR;DLMCR1 / WRONG KEYS MESSAGE /A036 DISP;2000;TEXT '!E' / ERASE SCREEN /C082 CALL;DU8PG;DLMDU8 / "OR PRESS GOLD MENU ..." /A074 GOTO;DU4RRD / GO BACK FOR USER INPUT DU4DS2, DISP; -2717; TEXT '&DO NOT USE DRIVE' /C126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU4NW1 /A126 DISP; -1; TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 DU4NW1, DISP; -1; TEXT ' "!D". &TRY AGAIN.'; MNTMP2 /C126 TRNSFR; DU9DSR; DLMDU9 /C126 DU4MC, DISP; -1; TEXT 'PRESS !&RETURN TO RECALL THE ' /A160 DISP; -1; TEXT '&MAINTENANCE &MENU,' /A160 RETURN /A160 / PART OF "VERIFY DISKETTE" MESSAGE FOR MC-B /A177 DU4DS0, /A177 CASE;MNTMP1 / TEST FOR DOING BACKUP /A177 1;DU4DS1 / YES; MAY NEED MESSAGE /A177 GOTO;DU4DS3 / NOT; RETURN /A177 DU4DS1, /A177 CASE;MNTMP3 / TEST FOR SOURCE DRIVE REQUEST /A177 1;DU4DS3 / OUTPUT DRIVE REQUEST, SKIP MESSAGE /A177 TRNSFR;DU3MS1;DLMDU3 / LINE ONE OF MESSAGE /A181 /D181 CALL;DU2MS2;DLMDU2 / LINE TWO /A177 DU4DS3, / EXIT /A177 RETURN /A181 /D181 TRNSFR;DU8DS0;DLMDU8 XTRDU4=400-. IFZERO .-401&4000 / LOADPOINT/COPY UTILITY DISPLAYS RELOC ADMDU5=. X=DLMDU5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU5CIT, SET;1;MNTMP3 / SIGNAL FIRST DISPLAY DONE /A036 DU5DS1, DISP;0;TEXT '!E-- !© !&DOCUMENT --' /A036 DISP; -1505; TEXT 'TO BE COPIED AND PRESS !&RETURN,' /C126 DISP; -1305; TEXT '&TYPE THE DRIVE' /C126 /DON'T ALLOW PRINT SCREENS WHEN COPYING INCASE SHE IS USING DRIVE ZERO /A196 /AS PRINT SCREEN MAY TRY TO BLAST FROM THE SYSTEM DISK !! /A196 SETBIT;4000;MNPULD /THIS SHOULD MAKE P.S. BACK OFF /A196 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU5NW1 /A126 DISP; -1; TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 DU5NW1, CASE;MNTMP3;1;DU5DS2 /A036 DISP; -1; TEXT '^S TO !&RECEIVE ^S'; DU5NUM; DU5DOC /A036 CALL; DU8PG; DLMDU8 / "OR PRESS GOLD MENU ..." /A126 TRNSFR;DU7RE3;DLMDU7 / GO READ DRIVE NUMBER /A036 DU5DS2, DISP; -1; TEXT '^S THAT !&CONTAINS ^S'; DU5NUM; DU5DOC /A036 CALL; DU8PG; DLMDU8 / "OR PRESS GOLD MENU ..." /A126 TRNSFR;DU7RE1;DLMDU7 / GO READ THE FIRST DRIVE NUMBER /A036 DU5RD1, ARG;DU5NCH;MNTMP5 /A054 NUMBER;MNTMP5;DU5NRG /A054 COPY;MNMXDR;DU5RNG / COPY MAXIMUM DRIVE NUMBER /A054 CASE;MNTMP1 / SET UP MINIMUM DRIVE NUMBER /A054 0;DU5MV2 / 0 ON VERIFY /C161 1;DU5MV0 / 0 ON BACK UP /A054 /****NEXT 2 LINE WILL ALLOW DRIVE #G.T. 1 /A100 IFDEF CONDOR < /A100 4;DU5MV4 / 4 ON FS /A078 5;DU5MV4 / 4 ON FD /A078 > /END IFDEF CONDOR /A100 SET;1;DU5RN1 / 1 ON ALL OTHERS /A054 DU5CPY, COPY;DU5RN1;MNTMP4 /A054 RANGE;MNTMP5 /A054 DU5RN1, 0 /A054 DU5RNG, 0;DU5NRG /A054 SET;0;MNTMP4 /A054 CASE;MNTMP1;0;DU5SV / SPECIAL FOR VERIFY /A054 1;DU5SC / SPECIAL FOR BACK UP COPY /A054 /D150 2;DU5SYS / SYSTEM /A074 DU5RTN, CASE;MNTMP1 0;-1-DU2VRF;DLMDU2 /A054 1;-1-DU3OVR;DLMDU3 /A054 /C074 2;-1-DU3DS;DLMDU3 /A054 /C074 3;-1-DU3DS;DLMDU3 /A053 /C074 4;-1-DU2FDS;DLMDU2 /A054 5;-1-DU2FDS;DLMDU2 /A054 IFDEF CONDOR < /A161 DU5MV0, /C161 CASE;MNTMP3;0;DU5MV2 /SOURCE DRIVE 0 OK /A161 TSTBIT;MNOPTN;MNRX4X;DU5MV2 /DEST DRIVE=0 BOOTING FROM WINNIE/A161 DU5MV1, SET;1;DU5RN1 /A161 GOTO;DU5CPY /A161 > /END IFDEF CONDOR /A161 IFNDEF CONDOR < /A161 DU5MV0, /C161 > /END IFNDEF CONDOR /A161 DU5MV2, /A161 SET;0;DU5RN1 / ALLOW DRIVE 0 /A054 GOTO;DU5CPY /A054 DU5MV4, SET;4;DU5RN1 / SET MINIMUM DRIVE NO.=4 /A078 GOTO;DU5CPY /A078 DU5NRG, SET;2;MNTMP3 / SIGNAL TO RETURN HERE /A054 TRNSFR;DU9DSP;DLMDU9 / GO DISPLAY THE MESSAGE /A054 DU5RD3, CASE; MNSYSA /A054 EDMENU&3777;-1-MM1S;DLMMM1 /A054 CALL;CR1BR;DLMCR1 /CLOBBER MNTMP1 /A074 STOV;MNTMP1 /RESTORE MNTMP1 /A074 GOTO;DU5NRG /A054 DU5NCH, / NO ARGUMENT AFTER COMMAND /A054 CASE;MNMXDR;1;DU5DR1 / TWO DRIVE SYSTEM? /A054 DU5TR1, TRNSFR;DU8DSP;DLMDU8 / NO /A054 DU5DR1, CASE;MNTMP1; / YES /A054 0;DU5SET / VERIFY? /A054 1;DU5TR1 / BACK UP; OUTPUT "VERIFY ... " /A181 /D181 1;DU5SET / BACK UP COPY? /A054 SET;1;MNTMP5 / NO, SET DRIVE NUMBER TO 1 /A054 GOTO;DU5RTN / CONTINUE /A054 DU5SET, SET;1;MNTMP2 / DEFAULT TO DRIVE 1 AS SOURCE /A054 SET;0;MNTMP5 / DEFAULT TO DRIVE 0 AS DESTINATION /A054 GOTO;DU5RTN / /A054 DU5SC, TRNSFR;DU9SC;DLMDU9 /A054 DU5SV, TRNSFR;DU9BCX;DLMDU9 /A054 /D150DU5SYS, RANGE; MNTMP5; 1; 3; DU5NOS / SYSTEM INITIALIZE /A074 /D150 GOTO; DU5RTN /D150DU5NOS, SET; 6; MNTMP1 / SIGNAL OUT OF RANGE /D150 TRNSFR; DU3OVR; DLMDU3 / GO TELL COPYDISK DU5DOC, TEXT 'THE DOCUMENTS' /A036 DU5NUM, TEXT ' NUMBER' /A126 XTRDU5=400-. IFZERO .-401&4000 / MAIN COPY MENU /A036 RELOC ADMDU6=. X=DLMDU6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU6DSP, DISP;0;TEXT '!E-- !© !&DOCUMENT --' /A036 DISP; 0705; TEXT '&A = © !&ALL^S^S'; DU6DOC; DU6FOD /C126/M115 DISP; 1105; TEXT '&S = © !&SOME^S^S'; DU6DOC; DU6FOD /C126/M115 DISP; 1305; TEXT '&O = ©^S, !&ONE AT A TIME,^S'; DU6DOC; DU6FOD IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU6NW1 /A126 DISP; -0755; TEXT '^S'; DU6VOA /A126 DISP; 1156; TEXT '^S'; DU6VOA /A126 DISP; 1371; TEXT '^S'; DU6VOA /A126 GOTO; DU6WM1 /A126 > / END IFDEF CONDOR /A126 DU6NW1, DISP; -0755; TEXT '^S'; DU6TAO /A126 DISP; 1156; TEXT '^S'; DU6TAO /A126 DISP; 1371; TEXT '^S'; DU6TAO /A126 DU6WM1, DISP; 2405; TEXT '&TYPE THE LETTER AND PRESS !&RETURN,' /A036 CALL;DU8PG;DLMDU8 / "OR, PRESS GOLD ..." /A078 DU6RD, READ;MNTMP1;DU6RE1 / READ SOMETHING FROM SCREEN /A036 ARG;DU6RD;MNTMP1 / SET UP TO DETERMINE WHAT READ /A036 KEYWRD / COMP WHAT'S READ TO FOLLOWING /A036 TEXT 'A ';DU6ALL / IS IT COPY ALL DOCUMENTS? /A036 TEXT 'S ';DU6SOM / IS IT COPY SOME DOCUMENTS? /A036 TEXT 'O ';DU6ONE / OR IS IT COPY 1 DOCUMENT? /A036 DU6ER, / NONE OF ABOVE MEANS ERROR /A036 CALL;CR1NM;DLMCR1 / CALL ERROR MESSAGE RTNE /A036 GOTO;DU6RD / GO READ THE SCREEN AGAIN /A036 DU6RE1, CASE; MNSYSA / GOLD MENU PRESSED? /A036 EDMENU&3777; -1-MM1S; DLMMM1 / YES, GO CALLMAIN MENU /A036 CALL;CR1BR;DLMCR1 / NO, USER PRESSED WRONG KEYS /A036 GOTO;DU6DSP / GO BRING UP UTITLITY MENU /A036 DU6ALL, / COPY ALL DOCUMENTS /A036 SET;3;MNTMP1 / TELL COPY WE WANT ALL DOCS /A036 GOTO;DU6OVR / GO CALL COPY /A036 DU6SOM, / TELL COPY WE WANT SOME DOCS /A036 SET;2;MNTMP1 / COPIED (NOT ALL) /A036 GOTO;DU6OVR / GO CALL COPY /A036 DU6ONE, / TELL COPY WE WANT TO COPY /A036 SET;1;MNTMP1 / ONLY ONE DOCUMENT AND THEN... /A036 DU6OVR, / DO THE CALL /A036 TRNSFR;DU5CIT;DLMDU5 / GO ASK FOR DRIVE NUMBERS /A036 DU6DS2, /C126 DISP; -2717; TEXT '&DO NOT USE DRIVE' /A036 /C126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU6DNW /A126 DISP; -1; TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 DU6DNW, DISP; -1; TEXT ' "!D". &TRY AGAIN.';MNTMP5 /C126 TRNSFR;DU7RE3;DLMDU7 /A036 DU6DOC, TEXT ' DOCUMENTS' DU6FOD, TEXT ' FROM ONE DISKETTE' /M115 DU6TAO, TEXT ' TO ANOTHER' /A126 IFDEF CONDOR < /A126 DU6VOA, TEXT '/VOLUME TO ANOTHER' /A126 > / END IFDEF CONDOR /A126 XTRDU6=400-. IFZERO .-401&4000 / INTERFACE PAGE FOR COPY FILE /A036 RELOC ADMDU7=. X=DLMDU7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DU7IRD, CASE;MNTMP5 /A036 1;DU7RDN / GO READ THE FILE NAME /A036 DU7RD, / ENTRY POINT FROM COPY FILE /A036 READ;MNTMP1;DU7RE / READ INPUT FROM TERMINAL /A036 CASE;MNTMP4 / SEE WHERE WE CAME FROM /A036 1;DU71AR / IS IT A TBO? /A036 2;DU72AR / IS IT A FILE NAME? /A036 / NOTE THAT THIS FALLS THRU ON ANY VALUE > 2 /A036 DU7RDN, FILNAM;DU7RD;DU7ND / CHECK FILE NAME /A036 RETURN /A036 DU7RE, SET;0;MNTMP3 / SIGNAL GOLD CHARACTER HIT /A036 RETURN /A036 DU7ND, SET;-1;MNTMP3 / SIGNAL BAD FILE NAME /A036 RETURN /A036 DU71AR, ARG;DU7RT;MNTMP1 / SET UP FOR CHECK /A036 KEYWRD; /A036 TEXT 'T ';DU7TOP / WRITE TO TOP OF DOCUMENT? /A036 TEXT 'B ';DU7BOT / WRITE TO BOTTOM OF DOC? /A056 TEXT 'O ';DU7OVR / OVERWRITE DOCUMENT? /A036 TEXT 'E ';DU7RNM / RENAME THE DOCUMENT? /A036 GOTO;DU7ND /A036 DU7TOP, SET;6;MNTMP3 / SIGNAL A WRITE TO TOP OF DOC /A036 RETURN /A036 DU7BOT, SET;1;MNTMP3 /A036 RETURN /A036 /D114DU7OVR, SET;4;MNTMP3 / SIGNAL OVERWRITE /A036 /D114 RETURN /A036 DU7RNM, SET;2;MNTMP3 / SIGNAL A RENAME /A036 RETURN /A036 DU7RT, SET;3;MNTMP3 / SIGNAL THAT HE HIT RETURN /A036 RETURN /A036 DU7CLL, SET;1;MNTMP2 / SIGNAL FIRST TIME THRU /A036 CMND;13;200;CIF CDF 10 /A036 RETURN /A036 DU7OVR, /A114 DU72AR, SET;4;MNTMP3 / SIGNAL IT BE SO /A036 RETURN /A036 DU7RE1, READ;MNTMP4;DU7RE2 /A036 ARG;DU7RE1;MNTMP4 / SET UP FOR RANGE STATEMENT /A036 NUMBER;MNTMP4;DU7CK / IS THIS A NUMBER? /A036 CASE;MNMXDR; / IS THIS A TWO DRIVE SYSTEM? /A054 1;DU7RA1 / YES /A054 DU7RH1, /a194 COPY;MNMXDR;DU7RG2 /A054 RANGE;MNTMP4;0 /A054 DU7RG2, 0;DU7CK /A054 SET;2;MNTMP3 / SIGNAL "TO" DRIVE IS READ/A036/M054 GOTO;DU7DS1 / GO GET THE 'TO' DRIVE NUMBER /A049 DU7RA1, CASE;MNTMP1; / ARE WE ONLY COPYING ONE FILE /A194 1;DU7RH1 / YES THEN ALLOW A RECIEVE DEV /A194 COPY;MNMXDR;DU7RG3 /A054 RANGE;MNTMP4;0 /A054 DU7RG3, 0;DU7CK2 /A054 CASE; MNTMP4 / 'FROM' DRIVE EQUAL 0 ? //A126 0; DU7ST1 / YES, GO SET 'TO' DRIVE TO 1 //A126 SET; 0; MNTMP5 / NO, SET 'TO' DRIVE TO 0 //A126 GOTO; DU7CLL / GO CALL CPYFIL PROGRAM TO DO COPY //A126 DU7ST1, SET; 1; MNTMP5 / SET 'TO' DRIVE TO 1 //A126 GOTO; DU7CLL / GO CALL CPYFIL PROGRAM TO DO COPY //A126 DU7RE3, READ;MNTMP5;DU7RE2 /READ THE DRIVE NUMBER /A036 ARG;DU7RE3;MNTMP5 / SET UP FOR RANGE STATEMENT /A036 NUMBER;MNTMP5;DU7CK / IF NOT A NUMBER THEN ERROR /A036 / /D116 RANGE;MNTMP5;0;3;DU7CK /IS DRIVE # VALID? /A114 / COPY;MNMXDR;DU7RG4 /A054 RANGE;MNTMP5;0 /A054 DU7RG4, 0;DU7CK /A054 COPY;MNTMP5;DU7CS1 /A054 CASE;MNTMP4; /A054 DU7CS1, 0;DU7ERR /A054 GOTO;DU7CLL / BOTH ARE DIFFERENT, OK /A036 DU7CK, /D114 DISP;-2717;TEXT '&DRIVE &NUMBERS MUST BE 0, 1, 2, OR 3. &TRY' /A036 /D114 DISP;-1;TEXT ' AGAIN.' /A036 /D125 DISP;-2717; TEXT '&DRIVE &NUMBERS MUST BE 0 TO !D. &TRY AGAIN';MNMXDR /A054 DISP; -2717; TEXT '&DRIVE' /A126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU7NW1 /A126 DISP; -1; TEXT '/&DEVICE' /A126 > / END IFDEF CONDOR /A126 DU7NW1, DISP; -1; TEXT ' NUMBERS MUST BE 0 TO !D.'; MNMXDR /A126 DISP; -1; TEXT ' &TRY AGAIN.' /A126 CASE;MNTMP3 / ARE WE READING THE 'FROM' DRIVE NBR? /A036 1;DU7RE1 / YES, GO ASK FOR 'FROM' DRIVE /A036 GOTO;DU7RE3 / MUST BE READING THE 'TO' DRIVE /A036 DU7ERR, CASE; MNTMP1 / ARE WE DOING A COPY 1 /A126 1; DU7CLL / YES /A126 / NO, THEN ERROR BOTH DRIVES EQUAL /A036 TRNSFR;DU6DS2;DLMDU6 / GO OUTPUT MESSAGE AND DO AGAIN /A036 DU7RE2, / CHECK TO SEE IF GOLD MENU HIT /C089 COPY;MNTMP1;MNTMP2 / SAVE WHATS IN MNTMP1 /A089 CASE; MNSYSA /A036 EDMENU&3777;-1-MM1S;DLMMM1 /A036 CALL;CR1BR;DLMCR1 / IF HIT GO RECALL MAIN MENU /A036 COPY;MNTMP2;MNTMP1 / RESTORE MNTMP1 PREVIOUSLY SAVED /A089 DU7DS1, TRNSFR;DU5DS1;DLMDU5 / GO ASK FOR DRIVE NUMBER /A036 DU7CK2, DISP;-2717;TEXT '&DRIVE &NUMBERS MUST BE 0 OR 1. &TRY AGAIN.' /A049 GOTO;DU7RE1 /A049 XTRDU7=400-. IFZERO .-401&4000 RELOC /A054 ADMDU8=. X=DLMDU8 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A054 / THIS IS THE ENTRY POINT WHEN CPYDSK DETERMINES THAT THE DISKS /A074 / ARE OF A DIFFERENT DIAMETER /A074 CLRRTN / CLEAR THE PENDING RETURN /A074 DU8BCD, SET;0;MNTMP3 /A054 DU8DSP, SET;0;MNTMP4 /A054 DISP;305;TEXT '!E' /A054 CALL;DU4DS0;DLMDU4 / OUTPUT "VERIFY DISKETTE ... " /C181 DU8DS0, / COME BACK TO HERE FROM "DU4DS0" /A177 DISP;1303;TEXT '&TYPE THE DRIVE' /A054M064 /C126 IFDEF CONDOR < /A126 TSTBIT;MNOPTN;MNRX2X;DU8NW1 /A126 DISP;-1;TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 DU8NW1, DISP;-1;TEXT ' NUMBER THAT !&CONTAINS THE ^S';DU8DSK /A126 IFDEF CONDOR < /A126 TSTBIT;MNOPTN;MNRX2X;DU8NW2 /A126 DISP;-1;TEXT '^S';DU8VOL /A126 > / END IFDEF CONDOR /A126 DU8NW2, DISP;1503;TEXT 'YOU WANT TO ' /C126 CASE;MNTMP1 0;DU8VER / VERIFY 1;DU8BCK / BACKUP /A054 2;DU8SYS / INIT SYS DISK 3;DU8DOC / INIT DOC DISK /A054 4;DU8FS / FORMAT SINGLE DENSITY 5;DU8FD / FORMAT DOUBLE DENSITY /A054 DU8VER, DISP;-1;TEXT 'VERIFY' /A054 GOTO;DU8BOT /A054 DU8SYS, DISP;-1;TEXT '^S SYSTEM ^S';DU8INT;DU8DSK /A054 GOTO;DU8DO2 /C150 DU8DOC, DISP;-1;TEXT '^S DOCUMENT ^S'; DU8INT; DU8DSK /A054 DU8DO2, /A150 IFDEF CONDOR < /A126 TSTBIT;MNOPTN;MNRX2X;DU8NW3 /A126 DISP;-1;TEXT '^S'; DU8VOL /A126 > / END IFDEF CONDOR /A126 DU8NW3, GOTO; DU8BOT DU8FS, DISP;-1;TEXT 'FORMAT SINGLE ^S';DU8DEN /A054 GOTO;DU8BOT /A054 DU8FD, DISP;-1;TEXT 'FORMAT DOUBLE ^S';DU8DEN /A054 GOTO;DU8BOT /A054 DU8BCK, CASE;MNTMP3 1;DU8TDR /A054 DISP;-1;TEXT 'COPY' /M064 GOTO;DU8BOT /A054 DU8TDR, DISP;-1;TEXT 'RECEIVE THE COPY' /M064 DU8BOT, DISP; -1;TEXT ' AND PRESS !&RETURN,' /A054 CALL;DU8PG;DLMDU8 / "OR, PRESS GOLD ..." /A078 TRNSFR;DU9RE1;DLMDU9 /A054 DU8DSK, TEXT 'DISKETTE' /A054 DU8DEN, TEXT 'DENSITY' /A054 DU8INT, TEXT 'INITIALIZE AS A' /A126 IFDEF CONDOR < /A126 DU8VOL, TEXT '/VOLUME' /A126 > / END IFDEF CONDOR /A126 DU8PG, DISP;2605;0 /C126 DISP;-1 /C126 TEXT '!&OR PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' /C126 RETURN /C126 XTRDU8=400-. IFZERO .-401&4000 /A054 RELOC /A054 ADMDU9=. X=DLMDU9 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A054 DU9RE1, READ;MNTMP5;DU9GLK /A054 ARG;DU9BC2;MNTMP5 / IF NONE ENTERED GO ASK AGAIN /A054 NUMBER;MNTMP5;DU9DSP / IF NOT NUMBER, GO TELL HIM /A054 COPY;MNMXDR;DU9RG2 / COPY HI DRIVE NUMBER FOR COMPARE /A054 CASE;MNTMP1 / SET UP MINIMUM DRIVE NUMBER /A054 0;DU9MV2 / 0 ON VERIFY /C161 1;DU9MV0 / 0 ON BACK UP /A054 IFNDEF CONDOR < 4;DU9MV1 / 1 ON FS /A103 5;DU9MV1 / 1 ON FD /A103 > /END IFDEF CONDOR /A103 IFDEF CONDOR < 4;DU9MV4 / 4 ON FS /A078 5;DU9MV4 / 4 ON FD /A078 > /END IFDEF CONDOR /A103 SET;1;DU9RG1 / 1 ON ALL OTHERS /A054 DU9RN1, COPY;DU9RG1;MNTMP4 / LO DR NBR, IN CASE WE DISPLAY IT /A054 RANGE;MNTMP5 / CHECK DRIVE NUMBER RANGE /A054 DU9RG1, 0 / LOWEST ALLOWABLE /A054 DU9RG2, 0 / HIGHEST ALLOWABLE /A054 DU9DSP / GO DISPLAY IT IF NOT IN RANGE /A054 CASE;MNTMP1 0;DU9BCX / GO DO 2ND DRIVE NBR ON VERIFY /A054 1;DU9BC1 / OR BACK UP COPY /A054 /D150 2;-1-DU5SYS;DLMDU5 / ON SYS GO CHECK SIZE /A074 DU9RTN, TRNSFR;DU5RTN;DLMDU5 /A054 IFDEF CONDOR < /A161 DU9MV0, CASE;MNTMP3;0;DU9MV2 /SOURCE DRIVE 0 OK /A161 TSTBIT;MNOPTN;MNRX4X;DU9MV2 /DEST DRIVE=0 BOOTING FROM WINNIE/A161 DU9MV1, SET;1;DU9RG1 /DEST DRIVE 0 ON WINNIE BOOT NOT ALLOWED/A161 GOTO;DU9RN1 /A161 > /END IFDEF CONDOR /A161 IFNDEF CONDOR < /A161 DU9MV0, > /END IFNDEF CONDOR /A161 DU9MV2, /A161 SET;0;DU9RG1 / SET MINIMUM DRIVE=0 /A054 GOTO;DU9RN1 / GO COMPARE DRIVE NUMBERS /A054 IFDEF CONDOR < DU9MV4, SET;4;DU9RG1 / SET MINIMUM DRIVE=4 /A078 > /END IFDEF CONDOR /A103 IFNDEF CONDOR < DU9MV1, SET;1;DU9RG1 / SET MINIMUM DRIVE=1 /A103 > /END IFNDEF CONDOR /A103 GOTO;DU9RN1 / GO CHECK DRIVE NUMBER RANGE /A078 DU9GLK, CASE; MNSYSA / CHECK IF GOLD KEY WAS HIT /A054 EDMENU&3777;-1-MM1S;DLMMM1 / GOLD MENU HIT /A054 CALL;CR1BR;DLMCR1 / GOLD JUNK--CLOBBER MNTMP1 /A074 STOV;MNTMP1 / RESTORE MNTMP1 /A074 TRNSFR; DU8DSP; DLMDU8 / GO REDISPLAY /A074 DU9BC1, CASE;MNTMP3;1;DU9RN3 / HAS FIRST DRIVE BEEN READ? /A054 SET;1;MNTMP3 / SHOW THAT 1ST DRV HAS BEEN READ /A054 COPY;MNTMP5;MNTMP2 / 1ST DR NBR TO TEMP 2 (BY CONVENTION) /A054 CASE;MNMXDR;1;DU9BC3 / IF ONLY A 2-DR SYSTEM, NEED NOT ASK /A054 DU9BC2, TRNSFR;DU8DSP;DLMDU8 / GO ASK FOR OTHER DRIVE /A054 DU9BCX, COPY;MNTMP5;MNTMP2 / 1ST DR NBR TO TEMP 2 (BY CONVENTION) /A054 CASE;MNMXDR;1;DU9BC3 / IF ONLY A 2-DR SYSTEM, NEED NOT ASK /A054 GOTO;DU9RTN /A054 DU9BC3, CASE;MNTMP2 0;DU9ST1 / IF SORCE DRV=0, MOVE 1 TO OTHER /A054 1;DU9ST2 / IF SOURC DRV=1, MOVE 0 TO OTHER /A054 DU9ST1, SET;1;MNTMP5 / SET TEMP 5 TO OTHER DRV NBR (BY CONVENTION) /A054 GOTO;DU9RTN /A054 DU9DSP, /D126 DISP;-2717;TEXT '&DRIVE NUMBERS MUST BE !D TO !D^S' /C074 /D126 MNTMP4;MNMXDR;DU9TRY /C074 DISP; -2727; TEXT '&DRIVE' /A126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; DU9NW1 /A126 DISP; -1; TEXT '/&DEVICE' /A126 > / END IFDEF CONDOR /A126 DU9NW1, DISP; -1; TEXT ' NUMBERS MUST BE !D TO !D. &TRY AGAIN.' /C126 MNTMP4; MNMXDR /C126 CASE;MNTMP3 /A054 2;-1-DU2RD1;DLMDU2 / DID WE GET HERE FROM DLMDU5? /A054 GOTO;DU9RE1 / GO READ IT AGAIN /A054 DU9RN3, COPY;MNTMP5;DU9CPY / COPY DRV NBR RO COMPARE IT /A054 CASE;MNTMP2 / WE MUST NOT PASS SAME DRV NBR ON BACK UP /A054 DU9CPY, 0;DU9DS2 / 'CAUSE WE'LL CONFUSE CPYDSK!!! /A054 GOTO;DU9RTN / NOT THE SAME SO RETURN /A054 DU9DS2, /D126 DISP;-2717;TEXT '&USE A DRIVE OTHER THAN !D" ON OUTPUT^S' /C074 /D126 MNTMP2; DU9TRY /C074 TRNSFR; DU4DS2; DLMDU4 DU9DSR, CASE;MNTMP4;1;DU9CMB / HAVE WE COME HERE FROM DU5? /A054 GOTO;DU9RE1 / NO, SO GO READ WHAT HE PUT IN /A054 DU9CHK, COPY;MNTMP5;DU9CK1 / LETS SEE IF DRIVE DIFFER /A054 CASE;MNTMP2 /A054 DU9CK1, 0;DU9DS3 / IF THE DRIVES DON'T DIFFER THEN A MISTAKE /A054 TRNSFR;DU5RTN;DLMDU5 / THEY DIFFER /A054 DU9DS3, SET;1;MNTMP4 / SIGANL TO REURN HERE /A054 GOTO;DU9DS2 / GO TELL HIM OF ERRROR /A054 DU9CMB, SET;0;MNTMP1 /A054 SET;0;MNTMP2 /A054 SET;0;MNTMP3 /A054 SET;0;MNTMP4 /A054 SET;0;MNTMP5 /A054 TRNSFR;DU2RD1;DLMDU2 / GO READ IN THE VALUES /A054 DU9SDR, CASE;MNTMP2;0;DU9ST3 / IF INPUT DRV NBR = 0, OUT=1 /A054 1;DU9ST4 / IF INPUT DRV NBR=1, OUTPUT=0 /A054 DU9ST3, SET;1;MNTMP5 / SET OUTPUT TO DRV 1 /A054 GOTO;DU9RTN /A054 DU9ST2, / SET TEMP 5 TO OTHER DRV NBR (BY CONVENTION) /M161 DU9ST4, SET;0;MNTMP5 / SET OUTPUT TO DRV 0 /A054 GOTO;DU9RTN /A054 DU9SC, CASE;MNTMP3 1;DU9CHK / IF DOING BACKUP, GO CHECK DRV NBRS /A054 SET;1;MNTMP3 / SIGNAL SOURCE DRIVE HAS BEEN READ /A054 COPY;MNTMP5;MNTMP2 / PUT SRC IN TEMP 2 (BY CONVENTION) /A054 CASE;MNMXDR 1;DU9SDR / TWO DRIV SYSTEM? /A054 TRNSFR;DU5RD1;DLMDU5 /A054 /***********************************************************************/ / / / SUBSTRINGS: / DU9TRY, TEXT '. &TRY AGAIN.' /SUBSTRING /A074 / / /***********************************************************************/ XTRDU9=400-. IFZERO .-401&4000 /A054 / ACTIVATE FEATURES MENU - THIS MENU IS CALLED FROM WPCU4 IF UNBUNDLING /A129 / IS DEFINED, OR FROM MAIN MENU IF UNBUNDLING IS NOT DEFINED /A129 RELOC /A129 ADMUB1=. X=DLMUB1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A129 UB1AF, DISP;0;TEXT '!E-- !&ACTIVATE !&FEATURES !&MENU --' /A129 DISP;204;TEXT '&THE FOLLOWING ^SAL FEATURES ';UB1OPT /A129 DISP;-1;TEXT 'ARE AVAILABLE ON YOUR DISKETTE:' /A129 DISP;420;TEXT '!&STATUS !&FEATURE' /A129 DISP;620;TEXT '^S&BASIC &WORD &PROCESSING';UB1ACT /A129 DISP;1020;TEXT '^S&COMMUNICATIONS &^S';UB1ACT;UB1OPT /A129 DISP;1220;TEXT '^S&LIST &PROCESSING &^S';UB1ACT;UB1OPT /A129 DISP;1420;TEXT '^S&SORT &^S';UB1ACT;UB1OPT /A129 DISP;1620;TEXT '^S&MATH &^S';UB1ACT;UB1OPT /A129 IFDEF CONDOR < /A129 DISP;2020;TEXT '^S&D&E&CSPELL &^S';UB1ACT;UB1OPT /M174 > / END IFDEF CONDOR /A129 IFDEF UNBUND < /A004 SET;1;MNTMP2 / SET TO INDICATE DRIVE 1 /A165 TSTBIT;MNOPTN;MNRX4X;UB1NOT / IS SYSTEM ON WINCHESTER ? /A165 SET;11;MNTMP2 / YES, SET TO INDICATE DRIVE 9 /A165 UB1NOT, TRNSFR;UB2S;DLMUB2 / DISPLAY POSSIBLE "NOT" WORDS /A004 > / END IFDEF UNBUND /A004 UB1RD, DISP;2605;TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.^E'/A129 READ;MNTMP1;UB1RE / GET USER INPUT FROM KEYBOARD /A129 ARG;UB1RTN;MNTMP1 / CHECK FOR BLANK LINE /A129 UB1ERR, CALL;CR1NM;DLMCR1 / ERROR - CHAR. HAS NO MEANING /A129 GOTO;UB1RD / NO MATCH - GO GET NEXT CHAR. /A129 UB1RTN, TRNSFR;MM1S;DLMMM1 / GO BACK TO MAIN MENU /A129 UB1RE, CASE;MNSYSA /A129 EDMENU&3777;UB1RTN / CHECK FOR GOLD MENU /A129 CALL;CR1BR;DLMCR1 / ERROR - TYPE ONLY LEGAL CHAR. /A129 GOTO;UB1AF /A129 UB1ACT, TEXT '&ACTIVE ' / DISPLAY "ACTIVE" WORD & SPACES/A129 UB1OPT, TEXT 'OPTION' / DISPLAY "OPTION" WORD /A129 XTRUB1=400-. IFZERO .-401&4000 /A129 / FEATURE UNBUNDLING MENU - PROCESS USER RESPONSE /A004 IFDEF UNBUND < /A004 RELOC /A004 ADMUB2=. X=DLMUB2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A004 UB2S, TSTBIT;MNOPTC;COMBIT;UB2NO1 /TRANSFER IF NO COMMUNICATIONS /A004 GOTO;UB2OK1 /DISPLAY OPTION IS ACTIVE /A004 UB2NO1, DISP;1014;TEXT '&NOT' /SET "NOT" WORD IN DISPLAY /A004 UB2OK1, TSTBIT;MNOPTC;LPBIT;UB2NO2 /TRANSFER IF NO LIST PROCESSING /A004 GOTO;UB2OK2 /DISPLAY OPTION IS ACTIVE /A004 UB2NO2, DISP;1214;TEXT '&NOT' /SET "NOT" WORD IN DISPLAY /A004 UB2OK2, TSTBIT;MNOPTC;SRBIT;UB2NO3 /TRANSFER IF NO SORT /A004 GOTO;UB2OK3 /DISPLAY OPTION IS ACTIVE /A004 UB2NO3, DISP;1414;TEXT '&NOT' /SET "NOT" WORD IN DISPLAY /A004 UB2OK3, TSTBIT;MNOPTC;MABIT;UB2NO4 /TRANSFER IF NO MATH /A004 GOTO;UB2OK4 /DISPLAY OPTION IS ACTIVE /A004 UB2NO4, DISP;1614;TEXT '&NOT' /SET "NOT" WORD IN DISPLAY /A004 UB2OK4, IFDEF CONDOR < /A121 TSTBIT;MNOPTC;SEDBIT;UB2NO5 /TRANSFER IF NO SPELL CORRECTION /M158 GOTO;UB2OK5 /DISPLAY OPTION IS ACTIVE /A121 UB2NO5, DISP;2014;TEXT '&NOT' /SET "NOT" WORD IN DISPLAY /A121 UB2OK5, > / END IFDEF CONDOR /A121 SET;0;MNTMP4 / CLEAR ALL OPTIONS ACTIVE FLAG /A004 TSTBIT;MNOPTC;COMBIT;UB2TSM / CHECK FOR COMM OPTION /A004 TSTBIT;MNOPTC;LPBIT;UB2TSM / CHECK FOR LP OPTION /A004 TSTBIT;MNOPTC;SRBIT;UB2TSM / CHECK FOR SR OPTION /A004 TSTBIT;MNOPTC;MABIT;UB2TSM / CHECK FOR MA OPTION /A004 IFDEF CONDOR < / /A121 TSTBIT;MNOPTC;SEDBIT;UB2TSM / CHECK FOR SED OPTION /A121 > / /A121 SET;1;MNTMP4 / SET ALL OPTIONS ACTIVE FLAG /A004 GOTO;UB2TSN / ALL OPTIONS PRESENT /A004 UB2TSM, DISP;2405;TEXT '&TO ACTIVATE AN OPTIONAL FEATURE, PLACE THE APPROPRIATE'/A004 DISP;2505 /A004 TEXT '!&FEATURE DISKETTE INTO &DRIVE !D AND PRESS !&RETURN, OR' /M165 MNTMP2 /CONTAINS DRIVE NUMBER TO USE /A165 UB2TSN, DISP;2605;TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.^E'/A129 UB2RD, READ;MNTMP1;UB2RE / GET USER INPUT FROM KEYBOARD /A004 COPY;MNPOS;MNTMP3 / SAVE STRING POINTER FOR ERROR /A115 ARG;UB2RTN;MNTMP1 / CHECK FOR BLANK LINE /A004 KEYWRD / CHECK STANDARD USER RESPONSE /A004 TEXT 'TURNOF ';UB2ERR / DON'T ALLOW SUBSETS OF WORD 'TURNOFF' /A004 TEXT 'TURNOFF ';UB2OFF / DEACTIVATE OPTIONS /A004 TEXT 'TURNON ';UB2ON0 / INITIALIZE OPTIONS /A004 UB2ERR, CALL;CR1NM;DLMCR1 / ERROR - CHARACTER HAS NO MEANING /A004 GOTO;UB2RD / NO MATCH - GO GET NEXT CHARACTER /A004 UB2RTN, CASE;MNTMP4 / CHECK ALL OPTIONS ACTIVE FLAG /A004 1;UB2MM / IF SET, DON'T TRY TO INSTALL OPTION /M032 SET;2;MNTMP3 / SET UP TO INSTALL NEW OPTION /A004 RETURN / GOTO WPCU4 MODULE FOR OPTIONS SETTING /A004 UB2RE, CASE;MNSYSA /M117 EDMENU&3777;UB2MM / CHECK FOR GOLD MENU /A004 CALL;CR1BR;DLMCR1 / ERROR - TYPE ONLY LEGAL CHAR. /A004 TRNSFR;UB1AF;DLMUB1 /A004 UB2MM, SET;0;MNTMP3 / HANDLE GOLD MENU RETURN /A004 RETURN / GO THROUGH WPCU4 TO MAIN MENU /A004 UB2OFF, SET;0;MNOPTC / DEACTIVATE DEVELOPMENT OPTIONS /A004 GOTO;UB2AF / GO PERFORM OPERATION /A004 UB2ON0, ARG;UB2ON1;MNTMP1 / CHECK FOR A BLANK LINE /A115 KEYWRD / NOT BLANK, CHECK OPTION /A115 TEXT 'DE ';UB2ON1 / DON'T ALLOW A SUBSET /A115 TEXT 'DEC ';UB2ON / GO PERFORM OPERATION /A115 UB2ON1, COPY;MNTMP3;MNPOS / RESTORE STRING POINTER /A115 ARG;UB2ERR;MNTMP1 / MOVE UP TO FIRST TOKEN /A115 GOTO;UB2ERR / REPORT ERROR - INVALID WORD /A115 UB2ON, SET;1777;MNOPTC / INITIALIZE OPTION WORD /A004 UB2AF, SET;1;MNTMP3 / SET UP TO STORE NEW OPTIONS /A004 RETURN / GO TO WPCU4 TO STORE SETTINGS /A004 XTRUB2=400-. IFZERO .-401&4000 / FEATURE UNBUNDLING ERROR MESSAGES /A004 RELOC /A004 ADMUBE=. X=DLMUBE / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A004 UBENCM, SET;COMBIT;MNTMP2 /SET UP NO COMMUNICATIONS MESSAGE /A004 GOTO; UBEDSP /A004 UBENLP, SET;LPBIT;MNTMP2 /SET UP NO LIST PROCESSING MESSAGE /A004 GOTO; UBEDSP /A004 /UBENMA, SET;MABIT;MNTMP2 /SET UP NO MATH MESSAGE /A004 / GOTO; UBEDSP /A004 IFDEF CONDOR < / /A121 UBENSD, SET;SEDBIT;MNTMP2 /SET UP NO SPELLING DETECTION MESSAGE /A004 GOTO; UBEDSP /A004 > / /A121 UBENSR, SET;SRBIT;MNTMP2 /SET UP NO SORT MESSAGE /A004 UBEDSP, DISP;0;TEXT '!E-- !&FEATURE !&NOT !&ACTIVE --^A' /A004 UBEBEL /CLEAR SCREEN & RING BELL /A004 CASE;MNTMP2 /SELECT OPTION NOT ACTIVE MESSAGE /A004 COMBIT;UBEMS1 /NO COMMUNICATIONS /A004 LPBIT;UBEMS2 /NO LIST PROCESSING /A004 SRBIT;UBEMS3 /NO SORT /A004 / MABIT;UBEMS4 /NO MATH /A004 IFDEF CONDOR < /A121 SEDBIT;UBEMS5 /NO SPELLING ERROR DETECTION /A004 > /A121 DISP;1305;TEXT '&THE &UNDEFINED^S';UBEUNA /ERROR - UNKNOWN /A004 GOTO;UBEMSG /A004 UBEMS1, DISP;1305;TEXT '&THE &COMMUNICATION^S';UBEUNA /A004 GOTO;UBEMSG /A004 UBEMS2, DISP;1305;TEXT '&THE &LIST &PROCESSING^S';UBEUNA /A004 GOTO;UBEMSG /A004 UBEMS3, DISP;1305;TEXT '&THE &SORT^S';UBEUNA /A004 GOTO;UBEMSG /A004 /UBEMS4, DISP;1305;TEXT '&THE &MATH^S';UBEUNA /A004 / GOTO;UBEMSG /A004 IFDEF CONDOR < /A121 UBEMS5, DISP;1305;TEXT '&THE &SPELLING^S';UBEUNA /A121 > / IFDEF CONDOR /A121 IFNDEF CONDOR < /A121 UBEMS5, DISP;1305;TEXT '&THE &EXTERNAL^S';UBEUNA /A121 > / IFNDEF CONDOR /A121 UBEMSG, DISP;1505 /A004 TEXT '&TYPE &A AND &PRESS !&RETURN^S';UBEACT /A004 DISP;1705 /A004 TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' /A004 UBERD, READ;MNTMP1;UBERE /READ CHARACTERS FROM KEYBOARD /A004 ARG;UBERD;MNTMP1 /GET POINTER TO CHARACTER & XFER IF NULL /A004 KEYWRD /A004 TEXT 'A ';UBEMNU /HANDLE TRANSFER TO ACTIVATE MENU /A004 TEXT 'AZ ';UBEALL /HANDLE TRANSFER TO UNBUNDLE MENU /A004 CALL;CR1NM;DLMCR1 /ERROR - CHARACTER HAS NO MEANING /A004 GOTO; UBEDSP /A004 UBERE, CASE;MNSYSA /M117 EDMENU&3777;-1-MM1S;DLMMM1 /HANDLE GOLD MENU /A004 CALL;CR1BR;DLMCR1 /ERROR - TYPE ONLY VALID CHARACTERS /A004 GOTO; UBEDSP /A004 UBEALL, SET;1777;MNOPTC / SET UP FEATURES /A004 UBEMNU, TRNSFR;DU2UNB;DLMDU2 / TRANSFER TO ACTIVATE MENU /A004 UBEBEL, 7;0 /A004 UBEACT, TEXT ' TO ACTIVATE THE OPTIONAL FEATURE, OR' /A004 UBEUNA, TEXT ' FEATURE THAT YOU ARE TRYING TO USE IS NOT ACTIVE.' /A004 XTRUBE=400-. IFZERO .-401&4000 /A004 > / END IFDEF UNBUND /A004 / MAINTENANCE MENU CONTINUED /A126 RELOC ADMDUA=. X=DLMDUA / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / IF WE HAVE A WINCHESTER ALLOW THE "S" OPTION ON DRIVE 1 /A126 / IF A VOLUME IS NOT ASSIGNED TO DEVICE 1 /A126 DUACKN, /C149 IFDEF CONDOR < /A149 ARG; DUACK1; MNTMP5 / LOOK FOR DRIVE NUMBER /A126 NUMBER; MNTMP5; DUANRG / IS IT A NUMBER /A126 CASE; MNTMP5 / YES - NOW CK FOR A 1 /A126 1; DUACK1 / YES - CK DEVICE 1 /A126 / NO - DISPLAY MESSAGE /A126 DUANRG, DISP; -2727; TEXT'&DRIVE NUMBER MUST BE 1. &TRY AGAIN.' /A126 TRNSFR; DU2RD1; DLMDU2 / GO BACK AND READ AGAIN /A126 DUANCH, SET; 1; MNTMP5 / FORCE DRIVE 1 /A126 DUARTN, SET; 2; MNTMP1 / SET INIT. SYS. DISKETTE FUNC. /A126 TRNSFR; DU3DSP; DLMDU3 / GO DISPLAY MENU /A126 DUACK1, TSTBIT; MNOPTN; MNRX3X; DUANCH / CK VOL ASSIGNED TO 1 /A126 DISP; 0305; TEXT '!E-- !&ERROR --'; / YES - ERROR /A126 DISP; 0505; TEXT '&A VOLUME IS ASSIGNED TO DEVICE 1'; /A126 / DISP; 2405; TEXT '&PRESS !&RETURN TO RECALL THE'; /D160 /A126 / DISP; -1; TEXT ' &MAINTENANCE &MENU,'; /D160 /A126 DISP; 2405; 0 /POSITION CURSOR /A160 CALL; DU4MC; DLMDU4 / MAINTENANCE MENU /A160 CALL; DU8PG; DLMDU8 / "OR PRESS GOLD MENU /A126 DUASC2, READ; MNTMP5; -1-DU2RE; DLMDU2 / READ INPUT /A126 ARG; -1-DU1S; DLMDU1; MNTMP5 / RET TO MAINT. MENU /A126 CALL; CR1NM; DLMCR1 / "NO MEANING /A126 GOTO; DUASC2 /A126 > / END IFDEF CONDOR /A149 /*** FINISHED USING THE SYSTEM *** MOVED HERE FROM WP2CMF *** /A137 DUAFN1, DISP;0;TEXT '!E^A' ; DUAFAK DISP;1020;TEXT '*^S^S'; DUASTS; DUASTS DISP;1120;TEXT '*' DISP;1176;TEXT '*' DISP;1220;TEXT '*' DISP;1276;TEXT '*' DISP;1320;TEXT '*' IFDEF ENGLSH < DISP;1333;TEXT '!&FINISHED !&USING !&THE !&SYSTEM' > / END IFDEF ENGLISH IFDEF CANADA < DISP;1332;TEXT "&FIN D'UTILISATION DU SYST]ME" > / END IFDEF CANADA IFDEF FRENCH < DISP;1332;TEXT "&FIN D'UTILISATION DU &SYST]ME" > / END IFDEF FRENCH IFDEF DUTCH < DISP;1332;TEXT "&EINDE &SYSTEEM &GEBRUIK" > / END IFDEF DUTCH IFDEF GERMAN < DISP;1331;TEXT "&ENDE DER &VERARBEITUNG" > / END IFDEF GERMAN IFDEF NORWAY < DISP;1343;TEXT "&A&V&S&L&U&T&T&E&T" > / END IFDEF NORWAY IFDEF SWEDSH < DISP;1333;TEXT "&SYSTEMANV[NDNING AVSLUTAD" /L.U.A > / END IFDEF SWEDSH IFDEF DANISH < DISP;1333;TEXT "&AFSLUTET BRUG AF SYSTEMET" > DISP;1376;TEXT '*' DISP;1420;TEXT '*' DISP;1476;TEXT '*' DISP;1520;TEXT '*' DISP;1576;TEXT '*' DISP;1620;TEXT '*^S^S'; DUASTS; DUASTS IFDEF ENGLSH < IFDEF CONDOR < /A149 TSTBIT; MNOPTN; MNRX2X; DUAFW1 / CK FOR WINCHESTER DRIVE /A137 SET; 2111; DUASTA / ADJUST COLUMN POS OF STRING /A137 SET; DUAVOL; DUASTB / INCLUDE TEXT "/VOLUMES /A137 > /END IFDEF CONDOR /A149 DUAFW1, DISP /C137 DUASTA, 2115 /C137 TEXT /&DON'T FORGET TO MAKE BACKUP COPIES OF YOUR DISKETTES^S/ /C137 DUASTB, DUANUL /A137 > / END IFDEF ENGLISH IFDEF CANADA < DISP;2717 TEXT "&N'OUBLIEZ PAS DE FAIRE UNE COPIE DE VOTRE DISQUETTE." > / END IFDEF CANADA IFDEF FRENCH < DISP;2717 TEXT " &NE PAS OUBLIER DE COPIER VOS DISQUETTES" > / END IFDEF FRENCH IFDEF DUTCH < DISP;2715 TEXT " &VERGEET NIET UW DOCUMENT DISKETTE TE KOPI^ZREN." 154 /L.U.E > / END IFDEF DUTCH IFDEF GERMAN < DISP;2715 TEXT " &VERGESSEN &SIE NICHT, &IHRE &DISKETTEN ZU KOPIEREN" > / END IFDEF GERMAN IFDEF NORWAY < DISP;2723 TEXT "&GLEM IKKE ] TA KOPIER AV DINE DISKETTER^!" /L.D.A > / END IFDEF NORWAY IFDEF SWEDSH < DISP;2721 TEXT "&GL\M INTE ATT G\RA KOPIOR AV DINA DISKETTER^!" /L.U.O, L.U.O > / END IFDEF SWEDSH IFDEF DANISH < DISP;2724 TEXT "&HUSK AT TAGE KOPIER AF DINE DISKETTER^!" > / END IFDEF DANISH RETURN DUAFAK, ESC;76;0 / LEAVE ALT KEYPAD MODE DUASTS, TEXT '***********************' DUANUL, TEXT '' / NULL STRING /A137 DUAVOL, TEXT '/VOLUMES' /A137 XTRDUA=400-. IFZERO .-401&4000 IFDEF CONDOR < /A149 / WINCHESTER MAINTENANCE MENU /A126 RELOC ADMDUB=. X=DLMDUB / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DUBWM, DISP; 0; TEXT '!E-- !&HARD !&DISK !&VOLUME !&MENU --' /M160 DISP; 0505; TEXT '!&A = &ASSIGN A^S'; DUBVOL /M160 DISP; 0705; TEXT '!&D = &DEASSIGN A^S'; DUBVOL /M160 DISP; 1205; TEXT '!&LA = &LIST OF ASSIGNED^SS ONLY'; DUBVOL /M160 DISP; 1405; TEXT '!&LI = &LIST ALL^SS'; DUBVOL /M160 DISP; 2205; TEXT '&TYPE THE LETTERS AND PRESS !&RETURN,' /M160 DISP; 2405; TEXT '!&OR ' /A160 CALL; DU4MC; DLMDU4 /A160 CALL; DU8PG; DLMDU8 / "OR PRESS GOLD MENU /A126 /D129 DUBRD1, CLRV /A126 DUBRD1, READ; MNTMP1; DUBRE / READ INPUT /A126 /D160 ARG; DUBRD1; MNTMP1 /M129 /C146 ARG; -1-DU1SS; DLMDU1; MNTMP1 / TO CLEAR PENDING RETURN /A160 KEYWRD /A126 /D129 TEXT 'A ' ; DUBER TEXT 'A '; DUBAV / ASSIGN A VOLUME /M160 /A126 /D129 TEXT 'D ' ; DUBER TEXT 'D '; DUBDV / DEASSIGN A VOLUME /M160 /A126 /D129 TEXT 'L ' ; DUBER TEXT 'LA '; DUBLV / LIST OF ASSIGNED VOLUMES /M160 /M129 TEXT 'LI '; DUBSV / LIST ALL VOLUMES /M160 /M129 DUBER, CALL; CR1NM; DLMCR1 / NO MEANING MESSAGE /A126 GOTO; DUBRD1 / TRY AGAIN /A126 DUBRE, CASE; MNSYSA / CK GOLD KEYS /A126 EDMENU&3777; DUBMM / GOLD MENU /A126 CALL; CR1BR; DLMCR1 / RING BELL /A126 GOTO; DUBWM / RECALL MAINT. MENU /A126 DUBSV, DISP;0;TEXT '!E-- !&LIST !&ALL !&VOLUMES --' /LI /M160 /M129 SET;4;MNTMP1;RETURN /A129 DUBLV, DISP;0;TEXT '!E-- !&LIST !&ASSIGNED !&VOLUMES --'/LA /M129 SET;3;MNTMP1;RETURN /A129 DUBDV, DISP;0;TEXT '!E-- !&DEASSIGN !&VOLUME --' /D /M129 SET;2;MNTMP1;RETURN /A129 DUBAV, DISP;0;TEXT '!E-- !&ASSIGN !&VOLUME --' /A /M129 SET;1;MNTMP1;RETURN /A129 DUBMM, SET;0;MNTMP1;RETURN /M129 DUBVOL, TEXT ' VOLUME' /A126 XTRDUB=400-. IFZERO .-401&4000 > / END IFDEF CONDOR /A126 /STORE AND RECALL PRINTER QUEUE RELOC FIELD 4 *0 RELOC ADMRS1=. X=DLMRS1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 RS1RL, SET;0;MNTMP9 /INDICATE MAIN MENU CALL /A128 PQUEUE;RS1RFQ;RS1REQ / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND /A128 / MNFNO DOESN'T MATCH /A128 RS1RFQ, / ERROR--RL NOT ALLOWED IF DOCS ALREADY IN QUEUE SET;0;MNQCPY / SPECIFY "DOCUMENTS" /A128 CALL;CR2FQ;DLMCR2 RS1MM, TRNSFR;MM1S;DLMMM1 RS1REQ, CALL; CM2FNM; DLMCM2 / Check out dangling filename /A051 CASE; MNTMP1; 0; -1-MM0RD; DLMMM0/ check for erroroneous filename/A051 DISP;0;TEXT '!E' SET;1;MNTMP3 FILNAM;RS1RRD;RS1ND1 RS1RET, CASE;MNTMP9;1;-1-PS6SL;DLMPS6 / TO STOP MENU PROCESSOROP MENU /A128 CMND;1;200;CIF CDF 20 /ELSE CALL COMMAND UTILITY /A128 RETURN RS1RND, CALL;CR1ND;DLMCR1 RS1RRD, DISP;0;TEXT '!E ' DISP;1605;TEXT '&T^SCONTAINING THE LIST TO BE';RS1TYP DISP;1705;TEXT 'PRINTED' RS1RR1, DISP;-1;TEXT ' AND PRESS !&RETURN' /M128 DISP;2205;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ;MNTMP1;RS1RRE CASE;MNTMP3 2;RS1SR1 FILNAM;RS1RRD;RS1RND GOTO;RS1RET RS1RRE, CASE;MNSYSA /M117 EDMENU&3777;RS1MM CALL;CR1BR;DLMCR1 CASE;MNTMP3 1;RS1RRD 2;RS1SRD RS1ND1, CALL;CR1ND;DLMCR1 /NO DOCUMENT GOTO;RS1REQ /USER HAS ENTERED RETURN /A188 RS1SLS, / SL FROM STOP MENU /A128 SET;10;MNTMP5 /LOAD CODE FOR SL FUNCTION /A183 SET;1;MNTMP9;GOTO;RS1SL1 /SET FLAG SO WE RETURN CORRECTLY/A128 RS1SL, / SL FROM MAIN MENU SET;0;MNTMP9 /SIGNAL RETURN TO COMMAND UTIL /A128 RS1SL1, PQUEUE;RS1SDC;-1-MM2NDC;DLMMM2 / SEE IF ANYTHING IN QUEUE /A128 / IF NOT TELL USER /A128 RS1SDC, / THERE ARE DOCUMENTS CALL; CM2FNM; DLMCM2 / Check out dangling filename /A051 CASE; MNTMP1; 0; -1-MM0RD; DLMMM0/ check for erroroneous filename/A051 DISP;0;TEXT '!E' SET;2;MNTMP3 FILNAM;RS1SRD;RS1SND RS1TBO, PQUEUE;-1-PS6ERR;DLMPS6;.+1 / DO ANY OF THE DOCUMENTS / IN THE QUEUE HAVE THE SAME / NAME AS THE RESULT DOCUMENT? SET;1;MNTMP4 TRNSFR;CM1NX;DLMCM1 / NO, EVERYTHING IS COOL--CHECK TBO RS1SND, SET;-2;MNTMP1 RS1SN1, SET;2;MNTMP3 /M133 GOTO;RS1RET RS1SRD, DISP;0;TEXT '!E ' DISP;1605;TEXT '&T^SINTO WHICH THE LIST WILL BE';RS1TYP DISP;1705;TEXT 'PLACED' GOTO;RS1RR1 RS1SR1, FILNAM;RS1SRD;RS1SND GOTO;RS1TBO RS1TYP, TEXT 'YPE THE NAME OF THE DOCUMENT ' XTRRS1=400-. IFZERO .-401&4000 /STOP PRINT MENUS /***********************************************************************/ / / / EQUATES FOR STOP MENU SELECTORS / / THE SELECTORS ARE BITS IN A TABLE / / INDEXED BY PRSTTS IN WPCUT. / / THE TABLE IS READ AND THE PROPER ENTRY IS / / COPIED TO MNTMP6 / / / / EACH SELECTOR BIT DETERMINES WHETHER OR NOT / / A PARTICULAR RESPONSE IS ALLOWABLE FOR THAT / / PARTICULAR ERROR CONDITION. ONLY ALLOWABLE / / RESPONSES ARE DISPLAYED AND ACCEPTED. / / / / THE SIX BITS OF EACH HALF WORD ARE ORGANIZED THUSLY: / R=01 /LSB P=02 B=04 T=10 N=20 C=40 / S AND L ARE ALWAYS ALLOWED / / / /***********************************************************************/ RELOC ADMPS1=. X=DLMPS1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS1S, SET;1;MNTMP8 /NOT LIST QUEUE /C189 DISP;0;TEXT '!E-- !&STOP !&PRINTER !&MENU --' /C171 CASE;MNQINI / USE MNQINI SINCE TBO USES MNTMP4 0; PS1T0 /"The printer is not in use now" /M005 1; -1-PS2C;DLMPS2 /PRINTING /C095 2; -1-PS2C;DLMPS2 /USER STOP /C095 3; -1-PS4T3;DLMPS4 /"stopped for SE first" /M005 4; -1-PS4T4;DLMPS4 /"stopped for SE yes" /M005 5; -1-PS4T5;DLMPS4 /"stopped at end of page" /M005 6; -1-PS2TW;DLMPS2 /"stopped for two wheel change" /M005 7; -1-PS2NP;DLMPS2 /"stopped for non-existent printer" /M005 10; -1-PS5T24;DLMPS5 /"Document Destination does not match.. /C070 11; -1-PS4T15;DLMPS4 /"Pause switch is on" (at PRTID) /A005 12; -1-PS4T12;DLMPS4 /"Communications line in use, try again"/M005 13; -1-PS4T13;DLMPS4 /"Stopped for a printer malfunction" /M005 14; -1-PS4T13;DLMPS4 /"Stopped for a printer malfunction" /M007 15; -1-PS4T15;DLMPS4 /"Pause switch is on" /A005 16; -1-PS4T16;DLMPS4 /"Stopped for ribbon out" /A005 17; -1-PS4T17;DLMPS4 /"Stopped for sheet feeder error" /A005 20; -1-PS5T20;DLMPS5 /"Printer cover is open" /A035 21; -1-PS5T21;DLMPS5 /"Printer paper is out" /A035 22; -1-PS5T22;DLMPS5 /"Document read error" /A035 23; -1-PS5T23;DLMPS5 /"Disk error drive 0" /A035 24; -1-PS4T17;DLMPS4 /LQPSE SHEET FEEDER ERROR /A090 25; -1-PS4T13;DLMPS4 /LQPSE CANCEL (FATAL) ERROR /A092 26; -1-PS5T26;DLMPS5 /COMMUNICATIONS ERROR /A110 27; -1-PS5T27;DLMPS5 /MISMATCHED CONTROLS /A142 PS1T0, SET;0;MNTMP8 /C189 DISP;1505;TEXT '&THE PRINTER IS NOT IN USE NOW.' MXDISP;2205;X02PRM;DLMX02 /"PRESS RETURN ... MAIN MENU /C171 PS1T0R, READ;MNTMP1;PS1RE ARG;PS1RT0;MNTMP1 CASE;MNTMP8 /C189 102;PS1FLQ /FINISHED LIST QUEUE /A090 /C102 000;PS1FLQ /PRINTER BUSY OR NOT IN USE /A166 GOTO;PS1S /REDISPLAY STOP PRINT MENU PS1FLQ, DISP;2700;TEXT '!E^A' /CLEAR OUT ANY TEXT /C166 PS1BEL /AND RING THE BELL /A171 GOTO;PS1T0R /ONLY RETURN IS ALLOWED /A102 PS1RT0, CASE;MNQINI;0;PS1MM / IF PRSTTS=0 THEN PASS NO ACTION /A099 SET;2;MNTMP1 / LOAD ABORT CODE /A086 GOTO; PS1MM1 /C065 PS1RE, CLRV / CLEAR FOR PAGE 0 IF GOLD MENU /A145 CASE;MNSYSA /M117 EDMENU&3777; -1-MM1SD0;DLMMM1 / CHECK FOR GOLD MENU /C128 CALL;CR1BR;DLMCR1 GOTO;PS1S PS1MM, SET;0;MNTMP1 /SET NO ACTION PS1MM1, SET;0;MNTMP2 /SET NO VALUE RETURN PS1BEL, BELL; 0 /A166 XTRPS1=400-. IFZERO .-401&4000 /STOP PRINTER MENU (CONT.) RELOC ADMPS2=. X=DLMPS2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS2S, / ENTER HERE AFTER WPCUT PUTS UP DOCS IN QUEUE /A062 SET;102;MNTMP8 / LOAD CODE FOR LIST QUEUE /C189 MXDISP;2620;X03PRR;DLMX03/"PRESS RETURN ... PREVIOUS MENU /A171 TRNSFR;PS1T0R;DLMPS1 / GO READ KEYBOARD /C171 /------------------------ PS2TW, DISP;311;TEXT '^STHE PRINT WHEEL CHANGE' /C062 PS2SS4 / "THE PRINTER IS STOPPED FOR " /C062 PS2C, DISP;-1; TEXT '^A'; PS2LF / MOVE THIS DOWN A LITTLE /A093 TSTBIT;MNTMP6; C ;PS2D /BRANCH IF NOT ALLOWED /A090 DISP;-1;TEXT '^A&C = &CHANGE THE^SDESTINATION TO ' /A065 /C093 PS2CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS2SS6 /"DOCUMENT" / CASE;MNTMP3 /A065 /C070 DDP;PS2LQP /A065 DDP2;PS2LQP /ANOTHER KIND OF DRAFT PRINTER /A070 PS2DP, DISP;-1;TEXT '!&DP' /A065 GOTO;PS2D /A065 PS2LQP, DISP;-1;TEXT '!&LQP' /A065 GOTO;PS2D PS2NP, DISP;311;TEXT '^SNON-EXISTENT^S' /C062 PS2SS4 / "THE PRINTER IS STOPPED FOR " /C062 PS2SS1 / " PRINTER " /A062 GOTO;PS2C / GO DO 1 BLANK LINE /A093 PS2D, TSTBIT;MNTMP6; N ;PS2R /BRANCH IF NOT ALLOWED /A090 DISP;-1;TEXT '^A&N = &NEW PAGE, BRING THE^STO THE TOP OF THE PAPER'/C065 PS2CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS2SS1 / " PRINTER " /A062 PS2R, TSTBIT;MNTMP6; R ;PS2P /BRANCH IF NOT ALLOWED /A090 CASE;MNQINI;07;PS2RDD /SPECIAL RESUME MSG FOR NON EXISTENT /A096 CASE;MNQINI;10;PS2RDD /SPECIAL RESUME MSG FOR DOC DEST ERR /A090 DISP;-1;TEXT '^A&R = &RESUME^S^SLAST MENU' /C065 PS2CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS2SS2 / "PRINTING" /A062 PS2SS5 / "AND RETURN TO THE " /A062 PS2P, TSTBIT;MNTMP6; P ;PS2K /BRANCH IF NOT ALLOWED /A090 DISP;-1;TEXT '^A&P = &CONTINUE^SUNTIL THE END OF THIS PAGE' /C065 PS2CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS2SS2 / "PRINTING" /A062 PS2K, TRNSFR;PS3K;DLMPS3 / PS2K MOVED TO PS3K /A093 PS2RDD, CALL;PS3RDD;DLMPS3 / A SLIGHTLY DIFFERENT RESUME MESSAGE /A090 GOTO;PS2P /A090 / ******** SUBSTRINGS ******** PS2SS1, TEXT ' PRINTER ' PS2SS2, TEXT ' PRINTING ' PS2SS4, TEXT '&THE PRINTER IS STOPPED FOR ' PS2SS5, TEXT 'AND RETURN TO THE ' PS2SS6, TEXT / DOCUMENT / /A065 PS2LF, 12;0 /ASCII LF /A093 PS2CLF, 15;12;12;40;40;40;40;40;0 /ASCII CR-LF-LF-SP-SP-SP-SP /A093 XTRPS2=400-. IFZERO .-401&4000 /STOP PRINTER MENU (CONT. AGAIN) RELOC ADMPS3=. X=DLMPS3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS3S, / PUT UP THE BUSY MENU FROM WPCUT /C171 / THIS MESSAGE OCCURS WHEN WE DO AN N /A128 / FROM MAIN MENU AND THE PRINTER IS STOPPED /A128 / OR BUSY /A128 DISP;0;TEXT '!E' /CLEAR SCREEN /A171 DISP;1505;TEXT '&THE PRINTER IS BUSY.' /A171 MXDISP;2205;X02PRM;DLMX02 /"PRESS RETURN ... MAIN MENU /A171 SET; 0; MNTMP8 /TELL READ STATEMENT WHO WE ARE /A189 TRNSFR;PS1T0R;DLMPS1 /GO READ KEYBOARD /A171 /------------------- PS3RDD, DISP;-1 /A090 TEXT '^A&R = &RECONNECT THE PRINTER AND RESUME^S' /A090 PS3CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS3SS1 RETURN /A090 /------------------- PS3K, DISP;-1;TEXT '^A&S = &STOP^STHIS^S AND RETURN TO THE &MAIN &MENU' PS3CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS3SS1 / "PRINTING " /A065 PS3SS2 / " DOCUMENT " /A065 TRNSFR;PS3D;DLMPS3 PS3D, TSTBIT;MNTMP6; B ;PS3T /BRANCH IF NOT ALLOWED /A090 DISP;-1;TEXT '^A&B = &START^STHIS^S FROM THE BEGINNING' /C065 PS3CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS3SS1 / " PRINTING " /A062 PS3SS2 / " DOCUMENT" /A065 PS3T, TSTBIT;MNTMP6; T ;PS3L /BRANCH IF NOT ALLOWED /A090 DISP;-1;TEXT '^A&T = &GO BACK A NUMBER OF PAGES AND RESUME' PS3CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 DISP;-1;TEXT '^SFROM THE TOP OF THE PAGE' PS3SS1 /" PRINTING " /A065 PS3L, DISP;-1;TEXT '^A&L = &LIST THE^S^S' PS3CLF /ASCII CR-LF-LF-SP-SP-SP-SP /A093 PS3SS2 /" DOCUMENT" /A065 PS3SS3 /"S WAITING TO PRINT" /A090 PQUEUE;PS3SL;PS378 /SEE IF THERE ARE ANY DOCUMENT TO SAVE /A128 / PQUEUE FALLS THROUGH IF /A128 / QUEUE NOT EMPTY AND /A128 / MNFNO DOESN'T MATCH /A128 PS3SL, DISP;-1;TEXT '^A!&SL = &STORE A &LIST OF^S^S' /A128 PS3CLF /NEW LINE STUFF /A128 PS3SS2 /" DOCUMENT" /A128 PS3SS3 /"S WAITING TO PRINT" /A128 PS378, DISP;-1;TEXT '^A ';PS3CLF /C171 MXDISP;-1;X02TLS;DLMX02 /"TYPE THE LETTER(S) ... RETURN /A171 PS3RD, TRNSFR;PS6RD;DLMPS6 /A090 PS3SS1, TEXT / PRINTING / /A065 PS3SS2, TEXT / DOCUMENT/ /A065 PS3SS3, TEXT 'S WAITING TO PRINT' /A090 PS3CLF, 15;12;12;40;40;40;40;40;0 /ASCII CR-LF-LF-SP-SP-SP-SP /A093 XTRPS3=400-. IFZERO .-401&4000 RELOC ADMPS4=. X=DLMPS4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS4T3, DISP;311;TEXT '^SFOR "!&SE FIRST"' PS4X1 GOTO;PS4D PS4T4, DISP;311;TEXT '^SFOR INSERTION OF ' /C138 PS4X1 TRNSFR;PS5SEY;DLMPS5 / GO DISPLAY WHAT TO INSERT /A138 PS4T5, DISP;311;TEXT '^SAT THE END OF THE PAGE' PS4X1 PS4D, TRNSFR;PS2C;DLMPS2 / GO DO A BLANK LINE & TRY C PS4T12, DISP;311 TEXT '&THE COMMUNICATIONS LINE IS IN USE' /C138 GOTO;PS4D PS4T13, DISP;304;TEXT '&^SDUE TO A MALFUNCTION, CHECK THE PRINTER' /M007 PS4X1 /A005 GOTO;PS4D PS4T15, DISP;311;TEXT '&THE PRINTER PAUSE SWITCH IS ON' /A005 GOTO;PS4D PS4T16, DISP;311;TEXT '&^SFOR RIBBON OUT.' /A005 PS4X1 /A005 GOTO;PS4D PS4T17, DISP;311;TEXT '&^SFOR SHEET FEEDER ERROR' /A005 PS4X1 /A005 GOTO;PS4D PS4X1, TEXT 'THE PRINTER IS STOPPED ' /A005 /*********FOLLOWING CODE ENTERED V100 TO MAKE DEC I DECII COMPAT /A100 /D129 IFNDEF CONDOR < PS4NCM, PS4DSP, DISP;0;TEXT '!E ^A';PS4BEL DISP;1505;TEXT 'HARDWARE FOR THE COMMUNICATION OPTION IS NOT PRESENT' DISP;1705;TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ;MNTMP1;PS4RE GOTO; PS4DSP PS4RE, CASE;MNSYSA /M117 EDMENU&3777;-1-MM1S;DLMMM1 GOTO; PS4DSP PS4BEL, 7;0 /D129 > /END IFNDEF CONDOR /A100 /********END OF VERSION 100 ADDED CODE /A100 XTRPS4=400-. IFZERO .-401&4000 /STOP THE PRINTER COMMAND RELOC ADMPS5=. X=DLMPS5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS5S, / FRIENDLY LABEL TO SEARCH FOR PS5T11, /A035 MXDISP;1505;X05NEP;DLMX05 /"NON EXISTENT PRINTER /C171 MXDISP;2205;X02PRM;DLMX02 /"PRESS RETURN ... MAIN MENU /A171 TRNSFR;PS1T0R;DLMPS1 / /C171 PS5T24, DISP;0311 TEXT '&THE DOCUMENT DESTINATION DOES NOT MATCH THE ATTACHED^S' /C065 PS5TX2 /"PRINTER" /A090 TRNSFR;PS2C;DLMPS2 /M065 PS5T20, DISP;0311;TEXT '^STHE COVER IS OPEN.'; PS5TX1 /A035 /M041 /C062 GOTO; PS5PS2 /A035 /M041 PS5T21, DISP;0311;TEXT '^STHE PAPER IS OUT.'; PS5TX1 /A035 /M041 /C062 GOTO; PS5PS2 /A035 /M041 PS5T22, DISP;0311;TEXT '^S^SREADING DOCUMENT'; PS5TX1; PS5TX3 /C142 PS5PS2, TRNSFR; PS2C; DLMPS2 / GO DO A BLANK LINE & TRY C /A035 PS5T23, DISP;0311;TEXT '^S^SON DRIVE 0.'; PS5TX1; PS5TX3 /C142 DISP;0511;TEXT '&PLEASE !&VERIFY THE SYSTEM DISKETTE.' /C101 GOTO;PS5PS2 /A101 PS5T26, DISP;0311;TEXT '^SOF A PRINTER ERROR.';PS5TX1 /A110 /C113 GOTO;PS5PS2 /A110 PS5T27, DISP;0311;TEXT '^SOF MISMATCHED START/END CONTROLS'; PS5TX1 /A142 DISP;0411;TEXT 'IN THE DOCUMENT.' /A142 GOTO;PS5PS2 /A142 PS5SEY, CASE;MNTMP7 /A138 5;PS5REAR /REAR SHEET /A138 6;PS5ENV /ENVELOPE /A138 DISP;-1;TEXT 'A FRONT SHEET' /FRONT SHEET /A138 GOTO;PS5PS2 /A138 PS5REAR,DISP;-1;TEXT 'A REAR SHEET' /A138 GOTO;PS5PS2 /A138 PS5ENV, DISP;-1;TEXT 'AN ENVELOPE' /A138 GOTO;PS5PS2 /A138 PS5TX1, TEXT '&THE PRINTER IS STOPPED BECAUSE ' /A035 PS5TX2, TEXT ' PRINTER ' /A090 PS5TX3, TEXT 'OF DISK ERROR ' /A142 XTRPS5=400-. IFZERO .-401&4000 RELOC ADMPS6=. X=DLMPS6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PS6ERR, DISP;0;TEXT '!E ' /A050 DISP;2505;TEXT '&DOCUMENT (!D.!D) !A IS ALREADY IN USE.' /A050 MNDRV;MNDOCN;MNFNAM /A050 DISP;-2605;TEXT '&PRESS !&RETURN.' /C128 READ;MNTMP1;.+1 /A050 TRNSFR;MM1S;DLMMM1 /A050 PS6RD, READ;MNTMP1;PS6RE ARG;PS6RD;MNTMP1 SET;0;MNTMP2 CLRV /A062 KEYWRD TEXT 'S ';PS6SC TEXT 'L ';PS6LC PQUEUE;.+2;PS6KWB /MAKE SURE SOMETHING IN PQUEUE /A128 KEYWRD; TEXT 'SL ';-1-RS1SLS;DLMRS1 /A128 PS6KWB, TSTBIT;MNTMP6; B ;PS6KWT /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'B ';PS6BC PS6KWT, TSTBIT;MNTMP6; T ;PS6KWR /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'T ';PS6TC PS6KWR, TSTBIT;MNTMP6; R ;PS6KWP /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'R ';PS6CC PS6KWP, TSTBIT;MNTMP6; P ;PS6KWC /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'P ';PS6PC PS6KWC, TSTBIT;MNTMP6; C ;PS6KWN /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'C ';PS6DC /C065 PS6KWN, TSTBIT;MNTMP6; N ;PS6RDC /BRANCH IF OPTION NOT ALLOWED /A090 KEYWRD; TEXT 'N ';PS6NC PS6RDC, CALL;CR1NM;DLMCR1 GOTO;PS6RD PS6RE, TRNSFR;PS1RE;DLMPS1 PS6SL, INCV /A128 PS6DC, INCV PS6CC, INCV PS6TC1, INCV PS6BC, INCV PS6PC, INCV PS6SC, INCV PS6NC, INCV STOV; MNTMP5; RETURN PS6LC, SET;-1;MNTMP5 DISP;300;TEXT '!E&THE^S^S ARE:' PS6SS2 /" DOCUMENT" /A065 PS6SS3 /"S WAITING TO PRINT" /A090 RETURN PS6TC, ARG;PS6TCN;MNTMP1 NUMBER;MNTMP2;PS6TCN GOTO; PS6TC1 /A062 PS6TCN, DISP;-2717;TEXT '&THE &T COMMAND MUST BE FOLLOWED BY A NUMBER.' GOTO;PS6RD PS6SS1, TEXT / PRINTING / /A065 PS6SS2, TEXT / DOCUMENT/ /A065 PS6SS3, TEXT 'S WAITING TO PRINT' /A090 XTRPS6=400-. IFZERO .-401&4000 /INDEX COMMAND STUFF RELOC ADMCI2=. X=DLMCI2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THE 'CI' COMMAND (PART 1) CI2CI1, DISP;0;TEXT '!E ' DISP;1005;TEXT '&TYPE THE NUMBER OF THE DISKETTE' /C126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; CI2NW1 /A126 DISP; -1; TEXT ' OR VOLUME' /A126 > / END IFDEF CONDOR /A126 CI2NW1, DISP; -1; TEXT ' WHOSE INDEX YOU WISH TO COPY.' /C126 DISP; 1205; TEXT '&THEN TYPE THE NAME OF THE DOCUMENT INTO WHICH THE INDEX ' DISP; -1; TEXT 'WILL BE PLACED.' /C126 DISP; 1405; TEXT '&THEN PRESS !&RETURN TO COPY THE INDEX.' IFDEF ENGLSH < IFNDEF ENGCAN < DISP;1720;TEXT '&EXAMPLE: 3 2.&OPERATOR &STATISTICS' > / END ENGCAN IFDEF ENGCAN < DISP;1720;TEXT '&EXAMPLE: 2.&OPERATOR &STATISTICS' > / END ENGCAN > / END ENGLSH DISP;2205;TEXT '!&OR PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ;MNTMP1;CI2ER GOTO;CI2CI CI2ER, CASE; MNSYSA 3777&EDMENU;CI2RET CALL;CR1BR;DLMCR1 GOTO;CI2CI1 CI2RET, TRNSFR;MM1S;DLMMM1 /START THE CI COMMAND. LOOK FOR EITHER A STRING OF THE FORM /'DRNO FILENAME' OR 'FILENAME' (WHERE 'FILENAME' CAN HAVE A SECOND DRIVE /NUMBER AS PART OF IT) CI2CI, COPY;MNPOS;MNTMP2 ARG;CI2CI1;MNTMP1 /LOOK FOR A NUMBER FOLLOWED BY A SPACE. IF PRESENT, 'DRNO' IS GIVEN. /IF NOT THERE, THE ARG MUST BE A FILE NAME NUMBER;MNTMP1;CI2DOT COPY;MNTMP1;MNTMP5 COPY;MNPOS;MNTMP3 ARG;CI2DOT;MNTMP1 KEYWRD TEXT '.';CI2DOT COPY;MNMXDR;CI2MDR RANGE;MNTMP5;0 CI2MDR, 0;CI2OFL COPY;MNTMP3;MNPOS /RESTORE TO THE START OF FILENAME STRING GOTO;CI2FN /ANY NUMBER WAS FOLLOWED BY AN EOL OR A PERIOD, AND IS THUS PART OF A /FILE NAME SPECIFICATION. BACK UP AND PROCESS AS A FILE NAME. CI2DOT, SET;77;MNTMP5 COPY;MNTMP2;MNPOS /PICK UP THE NAME OF THE DOCUMENT TO RECEIVE THE INDEX AND PROCEDE. CI2FN, FILNAM;CI2CI1;CI2CRE TRNSFR;CI1DEF;DLMCI1 CI2CRE, TRNSFR;CI1CRE;DLMCI1 CI2OFL, TRNSFR;CI1OFL;DLMCI1 XTRCI2=400-. IFZERO .-401&4000 /MORE CI COMMAND RELOC ADMCI1=. X=DLMCI1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THE FILE TO RECEIVE THE INDEX ALREADY EXISTS. CI1DEF, CASE;MNDOCN 1;CI1DER CASE;MNTMP5 77;CI1SAM GOTO;CI1DF1 CI1SAM, COPY;MNDRV;MNTMP5 /IF NO SEPERATE DRIVE GIVEN, USE INDEX OF THE /DOCUMENT DRIVE CI1DF1, PQUEUE; CI1PER; .+1 / SEE IF DOCUMENT IS WAITING TO PRINT. /A031 / REPORT ERROR IF SO. /A031 SET;1;MNTMP2 /1 TELLS INDEX 'CI' RATHER THAN 'I' SET;0;MNTMP4 /0 TELLS OVERWRITE CODE TO DO IT /A047 CMND;16;200;CIF CDF 20 TRNSFR;CM1NX;DLMCM1 /THE DOCUMENT MUST BE CREATED. FIRST TRY TO LOCK THE INDEX TO BE ALTERED. /THEN LOCK THE INDEX TO BE READ (IF THEY DIFFER). FINALLY, CALL CREATE. CI1CRE, CASE;MNTMP5 /A044 77;CI1CR2 /IF INDEX DRIVE NOT SPECIFIED USE DOC DRIVE/A044 /INDEX GOTO;CI1CR3 /A044 CI1CR2, COPY;MNDRV;MNTMP5 /A044 CI1CR3, SET;-1;MNTMP1 /-1 INDICATING OVERWRITE DOCUMENT SET;1;MNTMP2 /FLAG INDICATING 'CI' RATHER THAN 'I' COMMAND CMND;1;204;CIF CDF 20 RETURN CI1MM, TRNSFR;MM1S;DLMMM1 CI1PER, CALL;CR2PER;DLMCR2 / DISPLAY "DOC PRINTING" ERROR MESSAGE. /M050 GOTO;CI1RD1 / FINISH BELOW. CI1DER, DISP; 0; TEXT '!E' DISP; 2505; TEXT '!&CI CANNOT COPY TO AN INDEX.' CI1CNT, DISP; -2605; TEXT '&PRESS !&RETURN TO TRY ANOTHER NAME.' GOTO; CI1RD CI1OFL, DISP; 0; TEXT '!E' DISP; 2505; TEXT '&A DRIVE' /C126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; CI1NW1 /A126 DISP; -1; TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 CI1NW1, DISP; -1; TEXT ' NUMBER MUST BE BETWEEN 0 AND !D.' /C126 MNMXDR /C126 DISP; -1; TEXT '&PRESS !&RETURN TO TRY ANOTHER NUMBER.' /C126 CI1RD, READ;MNTMP1;CI1GLD / GET USER INPUT /M061 CI1RD1, ARG;CI1CI1;MNTMP3 / CHECK FOR NULL INPUT /M061 CI1ERR, CALL;CR1NM;DLMCR1 / INVALID INPUT /M061 GOTO;CI1RD / TRY AGAIN /M061 CI1GLD, CALL;CR1BR;DLMCR1 / ILLEGAL KEYPAD INPUT /A061 CI1CI1, TRNSFR;CI2CI1;DLMCI2 / GO RE-DISPLAY PROMPT /M061 IFDEF CONDOR < /A131 / / No APU board present /A131 / CI1RED, CASE; MNSYSA /A131 EDMENU&3777; -1-MM1S; DLMMM1 /A131 CI1NAP, DISP;0;TEXT '!E^A';CI1BEL /A131 DISP;1505;TEXT '&HARDWARE FOR THE SPELLING OPTION IS NOT PRESENT.' DISP;1705;TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ; MNTMP1; CI1RED /A131 GOTO; CI1NAP /A131 CI1BEL, 7;0 /A131 > / END IFDEF CONDOR /A131 XTRCI1=400-. IFZERO .-401&4000 RELOC ADMIN1=. X=DLMIN1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / THE INDEX COMMAND IN1S, ARG;IN1NUL;MNTMP1 NUMBER;MNTMP4;IN1CER COPY;MNMXDR;IN1TY RANGE;MNTMP4;0 IN1TY, 0;IN1OFL COPY;MNTMP4;MNTMP5 GOTO;IN1CBR IN1CER, SET;0;MNTMP5 /SET TO INDICATE DRIVE 0 /A178 CASE;MNARG 133;IN1CBR /TEST FOR SQUARE BRACKET 173;IN1CBR /TEST FOR CURLY BRACKET GOTO;IN1OFL IN1NUL, SET;1;MNTMP5 /SET TO INDICATE DRIVE 1 /D178 GOTO;IN1F /D178 IN1CBR, COPY;MNUSR2;MNTMP5 IN1CBR, SET;0;MNTMP2 /M178 CMND;16;200;CIF CDF 20 RETURN IN1RT2, TRNSFR;MM1S;DLMMM1 IN1OFL, DISP;0;TEXT '!E' IFDEF ENGLSH < IFNDEF ENGCAN < DISP;2205;TEXT '&I MAY BE FOLLOWED BY A DRIVE' /C126 IFDEF CONDOR < /A126 TSTBIT; MNOPTN; MNRX2X; IN1NW1 /A126 DISP; -1; TEXT '/DEVICE' /A126 > / END IFDEF CONDOR /A126 IN1NW1, DISP; -1; TEXT ' NUMBER BETWEEN 0 AND !D' /C080 MNMXDR /C080 > / END ENGCAN IFDEF ENGCAN < DISP;2205;TEXT '&I MAY BE FOLLOWED BY A DRIVE NUMBER.' > / END ENGCAN > / END ENGLSH MXDISP;2405;X02PRM;DLMX02 / Press Return ... Main Menu READ;MNTMP1;IN1RT2 GOTO;IN1RT2 /****** FOLLOWING CODE MOVED HERE FROM PR4 BECAUSE OF NO ROOM PR4TWA, DISP;-2004;TEXT '' CASE;MNQTW /M124 1;PR4TWY DISP;-1;TEXT 'DO NOT ' PR4TWY, DISP;-1;TEXT'PRINT WITH TWO WHEELS' PR4TWX, DISP;-1304;TEXT '' TSTBIT;MNQSP;0006;PR4DD / IF NO ODD/EVEN SKIP AHEAD /A173 DISP;1304;TEXT 'PRINT ONLY ' / /A173 TSTBIT;MNQSP;0004;PR4PO / /A173 DISP;-1;TEXT 'EVEN NUMBERED PAGES' / /A173 GOTO;PR4DD / /A173 PR4PO, DISP;-1;TEXT 'ODD NUMBERED PAGES' / /A173 PR4DD, DISP;-2104;TEXT 'DOCUMENT DESTINATION IS ' /The document destinations have been made to conform to the codes used /A006 /in the RL based systems (defined in WPF1.PA). Any unrecongnized /A006 /destinations are mapped to LQP (that is why those that would normally /A006 /map to LQP are not in the CASE statement). If this changes than it will/A006 /be necessary to change the way that WPRTOV.PA handles the destinations /A006 CASE MNQPNT /M124 DDP1;PR4LP DDP2;PR4LP /M011 DHOST1;PR4HST DHOST2;PR4DHO /C164 DHOST3;PR4HST /A006 DHOST4;PR4HST /A006 DISP;-1;TEXT '!&LQP' / DO SHADOW PRINT ON PAGE 1 ONLY IF DD=LQP DISP;-2152; TEXT 'SHADOW PRINT ' TSTBIT;MNQSP;0001;PR4SPN /C173 DISP;-1;TEXT 'YES' GOTO;PR4CNT PR4SPN, DISP;-1;TEXT 'NO' GOTO;PR4CNT /D006 PR4LP, DISP;-1;TEXT '!&DP' GOTO;PR4CNT PR4HST, DISP;-1;TEXT '!&CPTR' /C168 GOTO;PR4CNT PR4DHO, DISP;-1;TEXT '!&CHST' /C168 PR4CNT, TRNSFR;PRCCN2;DLMPRC XTRIN1=400-. IFZERO .-401&4000 /DEFINE USER KEYS RELOC ADMDK1=. X=DLMDK1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DK1S, DISP;0;TEXT '!E ' ARG;DK1RD;MNTMP1 NUMBER;MNTMP1;DK1ER RANGE;MNTMP1;0;CUUDNM-1;DK1ER /CUUDNM-1 WAS 11 /C166 CMND;15;200;CIF 20 RETURN DK1RD, DISP;0;TEXT '!E ' DISP;2205;TEXT '&TYPE THE NUMBER OF THE KEY YOU WISH TO DEFINE' DISP;-1;TEXT ' AND THEN PRESS !&RETURN' DISP;2405;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' READ;MNTMP1;DK1RE GOTO;DK1S DK1RE, CASE;MNSYSA /M117 EDMENU&3777;DK1MM CALL;CR1BR;DLMCR1 GOTO;DK1RD DK1MM, TRNSFR;MM1S;DLMMM1 DK1ER, DISP;1705;TEXT '^A&THE DEFINABLE KEYS ARE IDENTIFIED BY A NUMBER ' *.-1 TEXT ' BETWEEN 0 AND 99.' / (9+90) /C166 DK1BEL DISP;2105;TEXT '&PRESS !&RETURN AND TRY AGAIN.' READ;MNTMP1;DK1ER1 ARG;DK1RD;MNTMP1 GOTO;DK1ER DK1ER1, CASE;MNSYSA /M117 EDMENU&3777;DK1MM GOTO;DK1ER DK1BEL, 007;0 XTRDK1=400-. IFZERO .-401&4000 /************** W A R N I N G !!!!! *************************** / / The following menu code is loaded into memory by a TRANSFER to / a label at the end of the block, a CMND statement then starts up / CPYDSK. The net effect is that all of the menu code that CPYDSK / needs will then be memory resident. If any of the menu code is / moved from this block then the menu interpreter will request a / read of the block it is in and if the system disk is not in drive / 0 the system will blow up in a BIG!! way. The moral of this story: / / DO NOT MOVE ANY COPY DISK RELATED CODE FROM THIS BLOCK !!!!! / -- --- ---- --- ---- ---- ------- ---- ---- ---- ----- / /*********************************************************************** /***********************************************************************/ / / / MENU PORTION OF CPYDSK / / THIS PORTION EXISTS HERE SO THAT THE STANDARD ERROR MESSAGES / / CAN BE PRODUCED FROM A SINGLE MENU PAGE WHICH CONTAINS THE / / STRING PARSING FOR THE BACKUP FUNCTION. THIS IS BECAUSE / / THERE IS A POSSIBILITY THAT THE SYSTEM DISK MAY BE REMOVED / / AND THEREFORE OTHER MENU PAGES ARE INACCESSIBLE / / / / THIS CODE IS SLIGHTLY DIFFERENT FROM THE MNCOM CODE, AS / / DIFFERENT BLOCK NUMBERS ARE USED. IF CHANGES ARE MADE TO / / CR1BR OR CR1NM THEY SHOULD BE DUPLICATED HERE / / / /***********************************************************************/ RELOC ADMCPM=. X=DLMCPM / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /ENTRY POINT FROM CPYDSK TO GET KEYBOARD INPUT FOR STRING "COPY" / CLRV / INITIALIZE RESULT / DUCCP0, READ; MNTMP6; DUCCPG / READ STRING /C152 CASE; MNTMP3 / SEE WHICH CHECK WE ARE MAKING / 0; DUCCPY / THE COPY CHECK / ARG; DUCCP0; MNTMP6 / KEEP READING IF JUST RETURN/C152 KEYWRD / ELSE WE ACCEPT / TEXT 'S '; DUCCS / / TEXT 'D '; DUCCD / / CALL;CPMNM;DLMCPM;GOTO;DUCCP0 / BAD INPUT / DUCCPY, / CHECKING FOR "COPY" / ARG; DUCCP0; MNTMP6 / KEEP READING IF JUST RETURN/C152 KEYWRD / ELSE WE ACCEPT / TEXT 'COPY '; DUCCCP / ANY PART OF "COPY" / TEXT 'NO '; DUCCGM / TREAT LIKE GOLD MENU / CALL;CPMNM;DLMCPM;GOTO;DUCCP0 / BAD INPUT / DUCCPG, CASE;MNSYSA / A GOLD KEY HIT / EDMENU&3777; DUCCGM / GOLD MENU / CALL; CPMBR; DLMCPM / ALL OTHERS / SET;7777;MNTMP3;RETURN / TELL CPYDSK NEED TO PAINT SCREEN DUCCD, INCV / 3 "D" / DUCCS, INCV / 2 "S" / DUCCCP, INCV / 1 "COPY" / DUCCGM, STOV;MNTMP3 / 0 GOLD MEN OR NO / RETURN / TO CPYDSK / /------------------------- / THIS PORTION LIFTED FROM MNCOM / THE BLOCK NUMBERS HAVE BEEN MODIFIED CPMBEL, 007;0 / BELL ASCIZ STRING CPMBRK, 074; 130; 135; 0 / /*************************************************************** / / CPMNM IS A SUBROUTINE USED TO PRINT THE RESULTS OF A / READ OPERATION FOLLOWED BY "HAS NO MEANING HERE" / CALLING SEQUENCE: / READ; MNTMP6; LABEL1 /C152 / . / . / CALL; CPMMN; LABEL2 / \--WHERE TO GO WHEN RETURN HIT / PARAMETERS: / MNTMP6 POINTER TO ARGUMENT BUFFER / (MNTMP6 IS LOST) / /*************************************************************** CPMNM, DISP;-2717;TEXT ' ^A&TYPING "!A" HAS NO MEANING HERE. &TRY AGAIN.' CPMBEL; MNTMP6 /C152 CPMRT, RETURN /*************************************************************** / / CPMBR IS A SUBROUTINE USED TO PRINT THE MESSAGE / "USE ONLY THE ... KEYS" WHEN ERRONEOUS GOLD HAS BEEN TYPED / CALLING SEQUENCE: / READ; MNTMP6; LABEL /C152 / . / . /LABEL, CALL; CPMMN; LABEL1 / \--WHERE TO GO WHEN RETURN HIT / PARAMETERS: / MNTMP6 POINTER TO ARGUMENT BUFFER / (MNTMP6 IS LOST) / /*************************************************************** CPMBR, DISP;2000;TEXT '!E^A ';CPMBEL DISP;2205 TEXT '&WHEN TYPING TO THE MENU, USE NORMAL KEYS ON THE KEYBOARD ONLY.' DISP;2305 TEXT '&THE &RUBOUT ^A KEY CAN ALSO BE USED. &A LINE MAY CONTAIN A' / CPMBRK / DISP;2405 TEXT 'MAXIMUM OF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N.' DISP;2605;TEXT '&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.' READ;MNTMP6;CPMBR /C152 ARG;CPMRT;MNTMP6 /C152 GOTO;CPMBR /************************************************************************** / / Do Not Even THINK of moving the following CMND & RETURN / statements to another block. (See warning at start of block.) / /************************************************************************** CPMLOD, CMND;4;200;CIF 10 /NOW WE HAVE OUR MENU BLOCK, GO RUN CPYDSK RETURN /BACK TO MAIN MENU WHEN FINISHED XTRCPM=400-. IFZERO .-401&4000 /Spelling Corrector menu support. IFDEF CONDOR < /A149 RELOC ADMSPL=. X=DLMSPL / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /Called from Spelling corrector startup (and finishup) code. /when called, MNTMP3 = drive # of the SPELLING CORRECTOR diskette. / MNTMP2 = 0 - Prompt for SPELL CHECK diskette. / 1 - Prompt for DICTIONARY diskette. / 2 - 'Density error' error message. / /If the system is a 2 drive system, the dictionary drive is selected to be the /"other" drive from the file. If the system is a multi drive system, the user /is prompted to input the drive # of the dictionary diskette. / RANGE;MNTMP2;1;1;SPLS / If prompt for DICTIONARY diskette, change text. SET;SPLDD;SPLP1 / Reset prompt string value. SET;SPLDD;SPLP2 / ... SPLS, DISP;0;TEXT '!E' / Clear the screen. CASE;MNTMP2 / See which call this is. / 0;SPLINI / Prompt for SPELL CHECK diskette. /M144 / 1;SPLINI / Prompt for DICTIONARY diskette. /A144 2;SPLDEN / Density error error message. /M144 /STOP PRINT SCREEN RUNNING UNTIL WE RETURN TO THE MAIN MENU INCASE IT /A196 /TRIES A BLAST FROM THE POSSIBLY NONRESIDENT SYSTEM DISK /A196 SPLINI, SETBIT;4000;MNPULD / STOP PRINT SCREEN /A196 RANGE;MNMXDR;0;1;SPLGDR / Get dictionary drive # if not 2 drive system. SET;0;MNTMP3 / Assume doc on drive 1. CASE;MNDRV;1;SPLIN1 / Jmp if doc on drive 1. Default is set. SET;1;MNTMP3 / When doc on drive 0, Dictionary goes on 1. SPLIN1, DISP;1005;TEXT'!E&REMOVE^SFROM DRIVE !D AND INSERT^S.' SPLDSK MNTMP3 SPLP1, SPLSC SPLDSP, CALL;SPLCMN;DLMSPL / Display common text. READ;MNTMP1;SPLDS1 / Get input character. ARG;SPLIRT;MNTMP1 / Return if null. SPLERR, DISP;0;TEXT '^A';SPLBEL / BEEP at the user. SET;-1;MNTMP3 / Reset MNTMP3 value. GOTO;SPLS / Re-paint the screen. SPLDS1, CASE;MNSYSA / Check for GOLD:MENU. EDMENU&3777;SPLGM / Take Gold:Menu return if GM entered. GOTO;SPLERR / Report error. SPLGM, SET;4000;MNTMP2 / 4000 for GOLD:MENU abort return. SET;0;MNTMP3 / Return 0 for diskette #. RETURN / Return to caller. SPLGDR, RANGE;MNTMP3;-1;-1;SPLIN1/ If we've got a drive # then prompt. DISP;1005;TEXT '&TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS^S.' SPLP2, SPLSC CALL;SPLCMN;DLMSPL / Display common code. READ;MNTMP1;SPLDS1 / Get input character. ARG;SPLERR;MNTMP1 / Get 1st argument. NUMBER;MNTMP3;SPLERR / Convert to a #. Report error if not number. COPY;MNMXDR;SPLIN7 / Copy MAX DRIVE # for range check. RANGE;MNTMP3;0 / See if drive # is within range. SPLIN7, 0;SPLERR/ Report error if not within range. COPY;MNDRV;SPLIN8 / save doc drive # for comparison. CASE;MNTMP3 / See if requested drive is same as doc drive. SPLIN8, MNDRV;SPLERR/ If same as doc drive then error. SPLIRT, SET;0;MNTMP2 / return 0 if normal return. RETURN / ... SPLCMN, DISP;2305;TEXT '&AND &PRESS !&RETURN' DISP;2505;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' RETURN / Return to caller. SPLDEN, DISP;1505;TEXT '&PLEASE INSERT^SINTO DRIVE !D' SPLDSK MNTMP3 GOTO;SPLDSP / Display rest of the prompt. SPLDSK, TEXT ' THE DISKETTE ' SPLSC, TEXT ' THE &D&E&CSPELL DISKETTE' SPLDD, TEXT ' THE &DICTIONARY DISKETTE' SPLBEL, BELL;0 XTRSPL=400-. IFZERO .-401&4000 /THIS MENU BLOCK WAS ADDED AS /A155 RELOC ADMPPM=. X=DLMPPM / INDICATE DISK BLOCK WHERE MENU IS LOADED X=DLMPPM RELOC 0 PPMFFF, SET;12;MNTMP6 / 11 WILL CAUSE RETURN FROM ED1 TO THIS BLOCK/A155 PQUEUE;PPMERR;PPMOKP PPMERR, SET;0;MNQCPY CALL;CR2FQ;DLMCR2 TRNSFR;MM1S;DLMMM1 PPMOKP, TRNSFR;ED1PRM;DLMED1 /USE PROMPT FOR FILE NAME /A155 PPMOKR, SET;4;MNTMP4 /TO FAKE LP MENU TO ASK FOR "RESULT" FILE/156 CMND;1;234;CIF 20 RETURN PPMM0F, /FINISHED USING THE SYSTEM PQUEUE;MM0FNE;MM0FOK / CHECK FOR ANY DOCUMENTS BEING PRINTED /M020 / PQUEUE FALLS THROUGH IF QUEUE IS /A128 / NOT EMPTY AND MNFNO DOESN'T MATCH /A128 MM0FNE, TRNSFR;MM2ERR;DLMMM2 / ERROR - CAN'T FINISH WHILE PRINTING /C128 MM0FOK, SET;2525;MNTMP1 / REMEMBER WE'RE FINISHING UP /A024 CMND;2;223;CIF 10 / GO TO EDITOR TO CLEAR THE PASTE /A024 RETURN / BUFFER /A024 XTRPPM=400-. IFZERO .-401&4000 RELOC /VT125 PROMPTS FOR 1ST TIME LOADED ADM125=. X=DLM125 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A143 /CALLED WHEN LOADING GRAPHIC SOFTWARE SINCE LAST POWER ON /A143 /ALSO HANDLES ERROR MESSAGES FROM DISK DURING THE LOAD /A143 VTST, CASE;MNTMP2 /SEE WHICH CALL THIS IS /A143 0;VTDRVE /PROMPT TO TYPE DRIVE # /A143 1;VTCFND /ERROR MSGS /A143 2;VTDONE /IS INSTALLED CAN REMOVE DISKETTE /A143 / 3;VTDNSE /DENSITY ERROR /A143 VTDRVE, DISP;0;TEXT '!E-- !&GRAPHICS !&INSTALLATION !&PROCEDURE --' /A143 DISP;1005;TEXT '&TYPE THE NUMBER OF THE DRIVE/DEVICE THAT CONTAINS' DISP;1105;TEXT 'THE !&WPS &UTILITY &SOFTWARE AND PRESS !&RETURN' /C186 DISP;1305;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU' READ;MNTMP1;VTGM /A143 ARG;VTNULL;MNTMP1 /A143 NUMBER;MNTMP3;VTDERR /DRIVE # WILL BE PASSED IN MNTMP3 /A143 COPY;MNMXDR;VTMAX /A143 RANGE;MNTMP3; 1; /FIRST VALUE FOR RANGE TEST /C185 VTMAX, 4;VTDERR /2ND VALUE AND ERROR LOC /A143 RETURN /GO BACK TO (CU3?) CALLING ROUTINE /A143 / GOTO;VTDRVE /A143 VTGM, CASE;MNSYSA /CONTAINS VALUE OF KEY PRESSED /A143 EDMENU&3777;VTNULL /MASK OFF SIGN /A143 CALL;CR1BR;DLMCR1 /STANDARD GOLD KEY ACTION /A143 GOTO;VTST /MAY AS WELL START OVER /A143 / GOTO; VTDRVE /START OVER /A143 VTDERR, DISP;2105;TEXT '&DRIVE NUMBERS ARE 1 TO !D' /C185 MNMXDR /A143 GOTO;VTANOT /C185 /VTERRM, DISP;1005;TEXT '&THE DISKETTE/VOLUME IN DRIVE !D DOES' /A143 / MNTMP3 /TMP3 CONTAINS THE DRIVE # /A143 / DISP;1105;TEXT 'NOT CONTAIN THE REGIS GRAPHICS SOFTWARE' /A143 VTCFND, DISP;2105;TEXT '!L&CAN NOT FIND GRAPHICS SOFTWARE ON DRIVE !D' /C185 MNTMP3 /TMP3 CONTAINS THE DRIVE # /A143 VTANOT, DISP;2205;TEXT '!L&PRESS !&RETURN TO TRY ANOTHER NUMBER' /C185 READ;MNTMP1;VTGM /WAIT TILL USER READ MSG AND RESPONDS /A143 ARG;VTDRVE;MNTMP1 GOTO;VTDRVE /GIVE ANOTHER CHANCE TO TYPE DRIVE # /A143 VTDONE, READ;MNTMP1;VTEXIT /WILL GO BACK TO GOLD MENU NO MATTER WHAT ARG;VTEXIT;MNTMP1 /A143 / DISP;1305;TEXT '&DISKETTE MAY BE REMOVED FROM DRIVE !D' /A143 / MNTMP3 VTEXIT, RETURN /A143 VTNULL, SET;-1;MNTMP3 /WE WON'T NEED # IN THIS CASE /A143 RETURN /BACK TO CU3 /A143 XTR125=400-. IFZERO.-401&4000 > /END IFDEF CONDOR /A149 RELOC XXXXX, /END OF MENUES   / MN2 - SECOND PART OF THE MENU DISPLAYS / /121 EMcD 27-Jun-85 Add error message display for Printer / select in CX with Print Screen running /120 EMcD 09-May-85 Remove currency symbol from set conventions / menu /119 EMcD 15-Mar-85 Add VT228 option , move CX1 error messages / out to Mag card block /118 DFB 29-OCT-84 Fix DX trying to receive existing docs.(AS 117) /117 DFB 12-OCT-84 Fix DX halt when trying to receive existing docs /116 TCW 25-SEP-84 Ck FOOTNOTE Drv. & Doc. numbers /115 WCE 18-SEP-84 Fix MNFNO problem with SC menu /114 DFB 11-SEP-84 Insert message to prevent LOGON in Graphics mode /113 DFB 06-SEP-84 ADDITIONAL FIXES TO GRAPHICS TEXT DISPLAYS /112 WCE 20-AUG-84 ADDED WORD FOR AUTODIAL DIRECTORY DOCUMENT /111 DFB 15-AUG-84 FIX TO GRAPHICS TEXT DISPLAYS /110 AH 14-AUG-84 Fix message in global search /109 WJY 21-JUL-84 Fix "HALT when 'ES' is changed" bug WPSV2-128. /108 TCW 17-JUL-84 Add VT227 to SO MENU /107 BC 16-JUL-84 Manual screen width choice in Editor menu /106 JAC 28-JUN-84 100 UDK Integration /105 JFS 26-JUN-84 integrate 1.6 DMIII mods / no PB change / reduced comm. baud rates / DECmate as terminal id. /104 SBB 31-MAY-84 Some 1 liners for footnoting fixes /103 WCE 26-MAY-84 Changes for BRITISH date and time /102 TCW 21-MAY-84 INTEGRAL MODEM SUPPORT /101 SBB 14-MAY-84 For footnoting. Handle Create error, TBO option /100 WCE 07-MAR-84 Change CX MENU to "Press LOCAL-CMND R" for DM2 /099 WJY 16-FEB-84 Change DMI SO menu to look like DMII /098 WJY 06-FEB-84 DECmate I compatability /097 TCW 24-JAN-84 Limit comm. menu input to 64 chars. /096 TCW 10-JAN-84 Move "Documents Processed:" to line 7 in AX menu. /095 GDH 06-JAN-84 CX1 (communications) menu change. /094 EH 06-JAN-84 LP checks result doc 'in use' prior to TBO prompt /093 TCW 04-JAN-84 Bug fix to DX menu - long doc. name /092 WCE 17-NOV-83 Added clear screen for EDITOR out-of-space /091 FJL 17-NOV-83 Added comm. bug dx to ax fix, to ADMA15 /090 GDH 15-NOV-83 Bug fix to SO CT line. /089 WCE 08-OCT-83 Changes for STATUS line display in edit menu /088 TCW 07-OCT-83 Changed phrases for Winchester Drive. /087 WCE 19-SEP-83 Added status message for Blocks Free & Used /086 HLP 31-AUG-83 Added message for uninitialized diskette /085 SBB 24-AUG-83 Added VT125 terminal to System Options' pages /084 WCE 17-AUG-83 Added conditionals for editor STATUS line display /083 GDH 2-AUG-83 Fixed communications parity problem in CX3,CX5. /082 GDH 13-JUL-83 Corrected spelling of CC option in SO menu. /081 GDH 11-JUL-83 Conditionalized EZ-COMM option. /080 WCE 07-JUL-83 Replaced occurances of SYS+value in case / statements with standard menu definitions /079 GDH 6-JUN-83 Rewrote some of the AX/DX menues. /078 WCE 16-MAY-83 CHANGED L.P. MESSAGE FOR RANGE OF 4095 /077 GDH 13-APR-83 Added TM=EASYLINK for DM2 /076 GDH 13-APR-83 Moved CX "SEND" menu to DLMSO2 / Modified DX SEND menu to default to "remembered" /075 WCE 10-MAY-83 Allow LP to remember Result File Name /074 WCE 20-APR-83 Fixed S.O. Menu page for DECmate I /073 AIB 10-DEC-82 conditionalized "Rubout key" messages /072 MJS 10-DEC-82 cosmetic "DISP" wording at "EM3NER" /071 MJS 07-DEC-82 cosmetic "DISP" wording at "LP3S" /070 AIB 30-NOV-82 altered index display to avoid empty page /069 AIB 11-NOV-82 fixed up 50-char msg in global search /068 AIB 11-NOV-82 moved Index displays up 1 line /067 DFB 08-NOV-82 Fix cc menu so last line of BT, PB, B not / deleted when key pressed /066 AIB 21-OCT-82 corrected icon /MORE EDITOR MENUS RELOC ADMEM2=. X=DLMEM2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 EM2S, SET;0;MNTMP5 /CLEAR SVAL MOD FLAG EM2S1, DISP;0;TEXT '!E-- !&EDITOR !&MENU --' CASE;LINPGH-MUBUF;0;EM2S2 /A089 DISP;302;TEXT '&PAGE: !D!3D';LINPGH-MUBUF;LINPGL-MUBUF /A089 GOTO;EM2S3 /A089 EM2S2, DISP;202;TEXT '&PAGE: !D';LINPGL-MUBUF /A089 EM2S3, DISP;220;TEXT '&LINE: ' /A107 CASE;LINNUM-MUBUF;0;EM2S4 /A089 DISP;-1;TEXT '!D';LINNUM-MUBUF /A089 /M107 GOTO;EM2S5 /A089 EM2S4, DISP;-1;TEXT '&N/&A' /A089 /M107 EM2S5, DISP;236;TEXT '&BLOCKS AVAILABLE: !D';LINFRE-MUBUF /A087 DISP;270;TEXT '&BLOCKS USED: !D';LINUSD-MUBUF /A087 DISP;502;TEXT '&F = &FILE DOCUMENT AND RECALL &MAIN &MENU' DISP;555;TEXT '&R = &RESUME PRINTING' DISP;702;TEXT '!&PG = &PAGINATION (AUTOMATIC &GOLD !&PAGE)' /M051 DISP;755;TEXT '!&DK = &DEFINE USER KEYS' EM2RS, DISP;-1102;TEXT '!&MA = &MATH INTERACTIVE MODE (!&MA ' IFDEF UNBUND < TSTBIT;MNOPTC;MABIT;EM2RS1 /TEST IF MATH ENABLED, TRANSFER IF NOT > /ENDIF UNBUND TSTBIT;MNMATH;1;EM2RS1 /TEST INTERACTIVE MATH, TRANSFER IF OFF DISP;-1;TEXT '!&YES)' /SAY THAT WE HAVE INTERACTIVE MATH GOTO;EM2RS2 /NOW GOTO NEXT DISPLAY LINE EM2RS1, DISP;-1;TEXT '!&NO)' /SAY NO INTERACTIVE MATH EM2RS2, DISP;1155;TEXT '!&GS = &GLOBAL &SEARCH AND &REPLACE' TRNSFR;EM2AS;DLME2A IFDEF CONDOR < /A087 /M098 EM2ES, ARG;EM2ESR;MNTMP1 /GET ARGUMENT FOR EDITOR STATUS SIZE /A089 NUMBER;MNTMP1;EM2ESR /MAKE SURE ENTRY IS A VALID NUMBER /A089 RANGE;MNTMP1;0;3;EM2ESR /MAKE SURE IT IS WITHIN RANGE /A089 COPY;MNTMP1;MNSTAT /IF YES, UPDATE NEW EDITOR STATUS VALUE /A089 SET;1;MNTMP5 /SET SYSTEM OPTIONS MODIFIED FLAG /A089 TRNSFR;EM2AS2;DLME2A /GO FIX UP SCREEN DISPALAY /A089 /M107 EM2ESR, TRNSFR;EM4ESR;DLMEM4 /GO HANDLE ERROR BY USER /A089 > / END IFDEF CONDOR /A087 /M098 XTREM2=400-. IFZERO .-401&4000 /MORE OF THE EDITOR MENU - EXTENSION OF ADMEM2 RELOC ADME2A=. X=DLME2A / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 EM2AS, FBREAK;MNABRV /THIS IS TO GIVE YOU THE PROPER ABREV. DOC. NUMBER DISP;-1302;TEXT '!&AD = &ABBREVIATION DOCUMENT (!&AD !D.!D)' MNDRV;MNDOCN FBREAK;MNLBRY /THIS IS TO GIVE YOU THE PROPER LIBRY. DOC. NUMBER DISP;-1355;TEXT '!&LD = &LIBRARY DOCUMENT (!&LD !D.!D)' MNDRV;MNDOCN EM2AS1, DISP;-1502;TEXT '!&CT = &CURRENT TEXT LINES/PAGE (!&CT !D)' MNTMP3 IFDEF CONDOR < /A087 /M098 EM2AS2, DISP;-1555;TEXT '!&ES = &EDITOR STATUS (!&ES !D)' /A089 MNSTAT /A089 > / END IFDEF CONDOR /A087 /M098 DISP;-1702;TEXT '!&ST = &STANDARD TEXT LINES/PAGE (!&ST !D)' MNPGSZ EM2AS5, DISP;-1755;TEXT '!&SW = &SCREEN &WIDTH (!&SW ' /A107 TSTBIT;MNTMP8;1;EM2AS3 /SCREEN WIDE? TRANSFER IF SO /A107 DISP;-1;TEXT '!&NARROW)' /SAY SCREEN IS NARROW /A107 GOTO;EM2AS4 /NOW GOTO NEXT DISPLAY LINE /A107 EM2AS3, DISP;-1;TEXT '!&WIDE)' /SAY THAT WE HAVE WIDE SCREEN /A107 EM2AS4, FBREAK;MNFNO DISP;2312;TEXT '&TYPE THE LETTER(S) AND THEN PRESS !&RETURN' DISP;2412;TEXT '!&OR &JUST PRESS !&RETURN TO RESUME EDITING' DISP;2512;TEXT '!&OR &PRESS &GOLD !&MENU TO FILE DOCUMENT AND ' *.-1 /** CAREFUL IF YOU CHANGE ABOVE LINE ** /A107 TEXT 'RECALL &MAIN !&MENU.!E' /CLEAR TO BOTTOM LINE OF SCREEN /M107 /D107 DISP;-2700;TEXT '' /CLEAR BOTTOM LINE OF SCREEN TRNSFR;EM3RD;DLMEM3 XTRE2A=400-. IFZERO .-401&4000 /MORE OF THE EDITOR MENU RELOC ADMEM3=. X=DLMEM3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 EM3RD, READ;MNTMP1;EM3RE1 /GET USER INPUT, CHECK FOR GOLD KEY ARG;EM3RC;MNTMP1 /GET NEXT ARGUMENT, CHECK FOR BLANK LINE KEYWRD /CHECK USER INPUT AGAINST LIST TEXT 'AD ';EM3ADC /CHECK FOR ABBREVIATION DOCUMENT TEXT 'CT ';EM3PSC /CHECK FOR CURRENT TEXT SIZE TEXT 'DK ';-1-EM4S;DLMEM4 /CHECK FOR DEFINE USER KEYS IFDEF CONDOR < /A087 /M098 TEXT 'ES ';-1-EM2ES;DLMEM2 /CHECK FOR EDIT STATUS /A089 /M109 > / END IFDEF CONDOR /A087 /M098 TEXT 'F ';EM3FC /CHECK FOR FILE DOCUMENT TEXT 'GS ';EM3GSC /CHECK FOR GLOBAL SEARCH /A006 TEXT 'LD ';EM3LDC /CHECK FOR LIBRARY DOCUMENT TEXT 'MA ';-1-EM5S;DLMEM5 /CHECK FOR ENABLING MATH TEXT 'PG ';EM3PAG /CHECK FOR AUTO GOLD PAGE TEXT 'R ';EM3CC /CHECK FOR RESUME PRINTER TEXT 'ST ';EM3DPC /CHECK FOR STANDARD TEXT SIZE TEXT 'SW ';-1-EM5SW;DLMEM5 /CHECK FOR MANUAL SCREEN WIDTH /A107 EM3MAC, CALL;CR1NM;DLMCR1 /ERROR MESSAGE - "TYPING .... HAS NO MEANING" GOTO;EM3RD /GO GET FRESH USER INPUT EM3RE1, CASE;MNSYSA /CHECK GOLD KEY RESPONSE /M080 EDMENU&3777;EM3FC /CHECK FOR GOLD MENU CALL;CR1BR;DLMCR1 /ERROR MESSAGE - "WHEN TYPING TO ...." TRNSFR;EM2S;DLMEM2 /GO REDISPLAY THE EDIT MENU PAGE EM3DPC, ARG;EM3NER;MNTMP1 /GET ARGUMENT FOR STANDARD TEXT SIZE NUMBER;MNTMP1;EM3NER /MAKE SURE ENTRY IS A VALID NUMBER RANGE;MNTMP1;1;1747;EM3NER /MAKE SURE IT IS WITHIN RANGE /M078 COPY;MNTMP1;MNPGSZ /IF YES, UPDATE NEW STANDARD TEXT SIZE VALUE GOTO;EM3AD2 EM3PSC, ARG;EM3NER;MNTMP1 /GET ARGUMENT FOR CURRENT TEXT SIZE NUMBER;MNTMP1;EM3NER /MAKE SURE ENTRY IS A VALID NUMBER RANGE;MNTMP1;1;1747;EM3NER /MAKE SURE IT IS WITHIN RANGE /M078 COPY;MNTMP1;MNTMP3 /IF YES, UPDATE NEW CURRENT TEXT SIZE VALUE GOTO;EM3AD3 EM3NER, DISP; -2713 /m072 TEXT ' &FOLLOW THE COMMAND WITH A NUMBER BETWEEN 1 AND 999.' /M078 GOTO; EM3RD /GO BACK AND TRY AGAIN EM3LDC, COPY;MNFNO;MNTMP2 /SAVE CURRENT FILE NUMBER FILNAM;EM3FER;EM3FND /CHECK USER INPUT FOR VALID FILE NAME COPY;MNFNO;MNLBRY /IF YES, UPDATE LIBRARY DOCUMENT NUMBER GOTO;EM3AD1 EM3ADC, COPY;MNFNO;MNTMP2 /SAVE CURRENT FILE NUMBER FILNAM;EM3FER;EM3FND /CHECK USER INPUT FOR VALID FILE NAME COPY;MNFNO;MNABRV /IF YES, UPDATE ABBREVIATION DOCUMENT NUMBER EM3AD1, COPY;MNTMP2;MNFNO /RESTORE THE CURRENT FILE NUMBER EM3AD2, SET;1;MNTMP5 /SET SYSTEM OPTIONS MODIFIED FLAG EM3AD3, FBREAK;MNFNO /RESTORE FILE NAME PARAMETERS TRNSFR;EM2AS;DLME2A /GO BACK AND UPDATE SCREEN VALUES EM3FER, DISP;-2717;TEXT ' &FOLLOW THE COMMAND WITH A DOCUMENT NAME.' COPY;MNTMP2;MNFNO /RESTORE CURRENT FILE NUMBER FBREAK;MNFNO /RESTORE FILE NAME PARAMETERS GOTO;EM3RD /GO BACK AND TRY AGAIN EM3FND, CALL;CR1ND;DLMCR1 /ERROR MESSAGE - "DRIVE X DOES NOT HAVE ..." COPY;MNTMP2;MNFNO /RESTORE CURRENT FILE NUMBER TRNSFR;EM2S;DLMEM2 /GO REDISPLAY EDIT MENU PAGE EM3RC, SET;0;MNTMP4 /SET RESUME EDITING INDICATOR RETURN /GO BACK TO EDITOR TO RESUME EDITING EM3CC, SET;3;MNTMP4 /SET RESUME PRINTER INDICATOR RETURN /GO BACK TO EDITOR TO PERFORM RESUME FUNCTION EM3FC, SET;4;MNTMP4 /SET FILE DOCUMENT INDICATOR RETURN /GO BACK TO EDITOR TO FILE DOCUMENT AND EXIT EM3GSC, SET;5;MNTMP4 /SET INDICATOR FOR GLOBAL SEARCH /A006 RETURN /GO BACK TO EDITOR TO PERFORM SEARCH /A006 EM3PAG, / DISP;-2717;TEXT'FEATURE NOT READY, TRY AGAIN' /D014 / GOTO;EM3RD /GO BACK AND TRY AGAIN /D014 SET;6;MNTMP4 /INDICATE AUTO GOLD PAGE REQUEST RETURN /GO BACK TO EDITOR AND DO IT EM3S4, DISP;0;TEXT '!E' / CLEAR SCREEN /A086 /D088 DISP;1505;TEXT '&THE DISKETTE IS NOT AN INITIALIZED !&WPS' /A086 /D088 DISP;-1;TEXT ' DISKETTE.' /A086 DISP; 1505; TEXT '&THE ' /A088 CALL; EM4CKW; DLMEM4 / CK FOR WINI /A088 DISP; -1; TEXT ' IS NOT AN INITIALIZED !&WPS ' /A088 CALL; EM4CKW; DLMEM4 / CK FOR WINI /A088 DISP; -1; TEXT '.' /A088 TRNSFR;PP2ERT;DLMPP2 /A086 XTREM3=400-. IFZERO .-401&4000 /UDK MENU FOR EDITOR RELOC ADMEM4=. X=DLMEM4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 EM4S, DISP;0;TEXT '!E ' ARG;EM4RD;MNTMP1 NUMBER;MNTMP1;EM4ER RANGE;MNTMP1;0;CUUDNM-1;EM4ER /C106 SET;1;MNTMP4 RETURN EM4RD, DISP;0;TEXT '!E ' DISP;2205;TEXT '&TYPE THE NUMBER OF THE KEY YOU WISH TO DEFINE' DISP;-1;TEXT ' AND THEN PRESS !&RETURN' MXDISP;2405;X03GME;DLMX03 / OR PRESS GOLD MENU TO RECALL THE EDITOR MENU READ;MNTMP1;EM4RE GOTO;EM4S EM4RE, CASE;MNSYSA /M080 EDMENU&3777;EM4MM CALL;CR1BR;DLMCR1 GOTO;EM4RD EM4MM, TRNSFR;EM2S1;DLMEM2 EM4ER, DISP;1705;TEXT '^A&THE DEFINABLE KEYS ARE IDENTIFIED BY A NUMBER ' *.-1 TEXT ' BETWEEN 0 AND 99.' /C106 EM4BEL DISP;2105;TEXT '&PRESS !&RETURN AND TRY AGAIN.' READ;MNTMP1;EM4ER1 ARG;EM4RD;MNTMP1 GOTO;EM4ER EM4ER1, CASE;MNSYSA /M080 EDMENU&3777;EM4MM GOTO;EM4ER EM4BEL, 007;0 EM4CKW, TSTBIT; MNOPTN; MNRX2X; EM4DSK / CK FOR WINI INST /A088 CASE; MNTMP5 / YES - CK NUMBER /A088 0; EM4DSK / 0 - A DISKETTE /A088 1; EM4CD1 / 1 - DISKETTE OR VOL /A088 EM4VOL, DISP; -1; TEXT 'VOLUME' /A088 GOTO; EM4CKR / BRANCH TO EXIT /A088 EM4CD1, TSTBIT; MNOPTN; MNRX3X; EM4DSK / CK 1 = DRIVE /A088 GOTO; EM4VOL / NO - DISP "VOLUME /A088 EM4DSK, DISP; -1; TEXT 'DISKETTE' /A088 EM4CKR, RETURN /A088 IFDEF CONDOR < /A087 /M098 EM4ESR, DISP;-2717;TEXT "!&ES 0, 1, 2, OR 3 PLEASE" /A089 TRNSFR;EM3RD;DLMEM3 /GO BACK TO KEYWORD STATEMENTS /A089 > / END IFDEF CONDOR /A087 /M098 XTREM4=400-. IFZERO .-401&4000 /EDITOR MENU 5 RELOC ADMEM5=. X=DLMEM5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 EM5S, ARG;EM5RD;MNTMP1 /TEST MA ANSWER HERE FOR YES OR NO KEYWRD TEXT 'YES ';EM5YES TEXT 'NO ';EM5NO EM5RD, DISP;-2717;TEXT "!&MA YES OR NO, PLEASE" /IF MA GARBAGE, THEN MESSAGE TRNSFR;EM3RD;DLMEM3 /GO BACK TO KEYWORD STATEMENTS EM5YES, IFDEF UNBUND < TSTBIT;MNOPTC;MABIT;EM5ERR /CHECK TO SEE IF MATH BIT SET > /ENDIF UNBUNDLE SET;1;MNMATH EM5GO, TRNSFR;EM2RS;DLMEM2 /IF SET, PUT YES ON SCREEN;IF NO, PUT NO EM5NO, SET;0;MNMATH /IF MATH NOT ENABLED, PUT NO ON SCREEN GOTO;EM5GO EM5ERR, DISP;0;TEXT '!E-- !&FEATURE !&NOT !&ACTIVE --' DISP;1514;TEXT "&THE &MATH FEATURE THAT YOU ARE TRYING TO USE " DISP;-1;TEXT "IS NOT ACTIVE." DISP;2525;TEXT '&PRESS !&RETURN TO RECALL THE &EDITOR &MENU.' /M051 EM5ER1, READ;MNTMP1;EM5ER1 /THIS IS A WAIT LOOP IF THE PERSON TYPES ARG;EM5MM;MNTMP1 /ANYTHING BUT RETURN GOTO;EM5ER1 EM5SW, ARG;EM5SD;MNTMP1 /TEST SW ANSWER HERE FOR WIDE OR NARROW /A107 KEYWRD /A107 TEXT 'WIDE ';EM5WID /A107 TEXT 'NARROW ';EM5NAR /A107 EM5SD, DISP;-2717;TEXT "!&SW WIDE OR NARROW, PLEASE"/IF SW BAD THEN MSG/A107 TRNSFR;EM3RD;DLMEM3 /GO BACK TO KEYWORD STATEMENTS /A107 EM5WID, SET;0;MNTMP8 /A107 EM5WN, TRNSFR;EM2AS5;DLME2A /GO PUT WIDE OR NARROW ON SCREEN /A107 EM5NAR, SET;1;MNTMP8 /IF SW SET NARROW, PUT NARROW ON SCREEN /A107 GOTO;EM5WN /A107 EM5MM, TRNSFR;EM2S1;DLMEM2 /FINALLY WE GO BACK TO THE EDITOR MENU XTREM5=400-. IFZERO .-401&4000 /CREATE DOCUMENT COMMAND ERROR MESSAGES RELOC ADMPP2=. X=DLMPP2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 PP2ER, COPY; MNTMP2; PP2HLD DISP;0;TEXT '!E ^A';PP2BEL CASE;MNTMP1 /A101 4;PP2ZER /REPORT SIZE ERROR /A101 DISP;1505;TEXT '&UNABLE TO CREATE DOCUMENT.' CASE;MNTMP6 /TMP6 IS 12 FOR FOOTNOTING /A101 12;PP2FFF /GO HANDLE FOOTNOTE CASE /A101 CASE;MNTMP1 1;PP2OOR 2;PP2OON 3;PP2LPD GOTO;PP2ERT PP2BEL, 7;0 PP2OOR, DISP;1705;TEXT '&DOCUMENT NUMBERS MUST BE FROM 1 TO 200.' GOTO;PP2ERT PP2OON, DISP;1705;TEXT '&THERE ARE NO MORE DOCUMENTS AVAILABLE.' PP2ERT, DISP;2105;TEXT '!E&' MXDISP;-1;X02PRM;DLMX02 / PRESS RETURN TO RECALL THE MAIN MENU PP2RD, READ;MNTMP2;PP2RE ARG;PP2MM;MNTMP2 GOTO;PP2ERT /C086 PP2RE, CASE;MNSYSA /M080 EDMENU&3777;PP2MM CALL;CR1BR;DLMCR1 GOTO;PP2ERT /C086 PP2ZER, DISP;1705;TEXT '&NOT ENOUGH ROOM ON DRIVE/DEVICE.' /A101 PP2FFF, DISP;2105;TEXT '&PRESS !&RETURN TO TRY ANOTHER NAME.' /A101 SET;4;MNTMP4 /GOT CLEARED LEAVING LP2. NEED AGAIN /A104 MXDISP;2305;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. READ;MNTMP2;PP2GM /GOLD MENU LEADS BACK TO MM /A101 ARG;PP2MM;MNTMP2 /RETURN TO WPCUT TO TRY AGAIN /A101 GOTO;PP2FFF /TO REPEAT ABOVE MESSAGE /A101 PP2GM, SET;0;MNTMP6 /WPCUT CHECKS HERE TO RETURN TO MM /A101 PP2MM, RETURN PP2LPD, TRNSFR;LP4LPD;DLMLP4 PP2HLD, 0 /ENTRY VALUE OF MNTMP2 XTRPP2=400-. IFZERO .-401&4000 /LIST PROCESSING MENUS RELOC ADMLP1=. X=DLMLP1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 LP1S, SET;0;MNTMP6 /CLEAR PRIOR FOOTNOTING FLAG /A104 DISP;0;TEXT '!E-- !&LIST !&PROCESSING !&MENU --' DISP;705;TEXT '&P = &MERGE LIST WITH A FORM AND PRINT THE RESULT' DISP;1105;TEXT '&D = &MERGE LIST WITH A FORM AND PUT RESULT INTO A DOCUMENT' DISP;1305;TEXT '&T = &TEST A SELECTION SPECIFICATION FOR ERRORS' MXDISP;2020;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN MXDISP;2220;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. LP1RD, READ;MNTMP1;LP1RE ARG;LP1RD;MNTMP1 KEYWRD TEXT 'P ';LP1PC TEXT 'D ';LP1DC TEXT 'T ';LP1TC CALL;CR1NM;DLMCR1 GOTO;LP1RD LP1RE, CASE;MNSYSA /M080 EDMENU&3777;LP1MM CALL;CR1BR;DLMCR1 GOTO;LP1S LP1MM, SET;0;MNTMP3 RETURN LP1PC, SET;2;MNTMP3 RETURN LP1PER, SET;0;MNTMP3 /RETURN A GOLD-M FOR THIS ERROR TRNSFR;LP4PER;DLMLP4 LP1DC, SET;3;MNTMP3 RETURN LP1TC, SET;1;MNTMP3 RETURN LP1FF, DISP; 0; TEXT '!E ' / REPORT ERROR /A116 DISP; 2505; TEXT '!&FOOTNOTE AND !&RESULT DOCUMENTS MUST ' /A116 DISP; -1; TEXT 'BE ON THE SAME DRIVE.' /A116 MXDISP; -2605; X02NAM; DLMX02 / PRESS RETURN TO TRY ANOTHER NAME/A116 READ; MNTMP1; .+1 /A116 RETURN /A116 XTRLP1=400-. IFZERO .-401&4000 / ------------------------------------- / |LOTS OF SHORT LIST PROCESSING MENUS| / ------------------------------------- RELOC ADMLP2=. X=DLMLP2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 LP2S, DISP;0;TEXT '!E ' / ERASE THE SCREEN CASE;MNTMP4 /A094 5;LP2ED1 / to TBO screen /A094 DISP;1505;TEXT '&TYPE THE NAME OF THE ' CASE;MNTMP4 2;LP2DS / 'selection specification' 3;LP2DF / 'form' 4;LP2DR / 'result' / 'list' LP2DL, DISP;-1; TEXT '!&LIST DOCUMENT TO BE USED' GOTO;LP2RD LP2DS, DISP;-1;TEXT '!&SELECTION !&SPECIFICATION TO BE USED' GOTO;LP2RD LP2DF, DISP;-1; TEXT '!&FORM WITH WHICH YOU WISH TO MERGE THE LIST' GOTO;LP2RD LP2DR, DISP;-1; TEXT 'DOCUMENT INTO WHICH THE !&RESULT WILL BE PLACED' LP2RD, MXDISP;1605;X02APR;DLMX02 / AND PRESS RETURN MXDISP;2005;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. SET;1;MNTMP3 SET;0;MNFNO /TO AVOID ERROR MESSAGE IN FOOTNOTING /A104 /WHEN GOLD MENU INSTEAD OF RESULT NAME /A104 READ;MNTMP1;LP2RE FILNAM;LP2RD;LP2ND CASE;MNTMP4 4;LP2ED LP2RT, RETURN / /LP2LER,CALL;LCKER1; DLMLCK /D017 / GOTO;LP2S /D017 LP2RE, CASE;MNSYSA /M080 EDMENU&3777;LP2MM CALL;CR1BR;DLMCR1 GOTO;LP2S LP2MM, SET;0;MNTMP3 RETURN LP2ND, CASE;MNTMP4 4;LP2CD CALL;CR1ND;DLMCR1 GOTO;LP2S LP2CD, SET;-1;MNTMP3 GOTO;LP2RT / / go to "lp2ed2" if result doc name in print queue /a050 / LP2ED, PQUEUE;LP2ED2;LP2EFF CASE; MNTMP6 / CK FOR FOOTNOTE CALL /A116 12; LP2FF / GO CK DRV. & DOC. NUMBERS /A116 / / display T,B,O menu and do a return from cm1nx / LP2ED1, SET;0;MNTMP4 TRNSFR;CM1NX;DLMCM1 / / list processing "result" document name is in print queue /a050 / --get another name-- /a050 / LP2ED2, CALL;CR2PER;DLMCR2 /a050 GOTO;LP2S /a050 LP2EFF, CASE;MNTMP6 /IF FOOTNOTING /A101 12; LP2FF / CK DRV. & DOC. NUMBERS /M116 GOTO;LP2RT /OTHERWISE RETURN FIRST /A101 LP2FF, CASE; MNMXDR / CK FOR 2 - DRV SYS /A116 1; LP22DS / YES - GO CK DRIVE NUMBERS /A116 GOTO; LP2ED1 / NO - GO ASK T,B,O /A116 LP22DS, COPY; MNDRV; LP2FF2 / RESULT DRV NUMBER /A116 COPY; MNUTFN; MNTMP9 / FOOTNOTE FILENAME /A116 CLRBIT; 0377; MNTMP9 / LEAVE DRIVE NUMBER /A116 SHFBIT; 10; MNTMP9 / /A116 CASE; MNTMP9 / DRIVE NUMBERS MUST BE THE SAME /A116 LP2FF2, 0; LP2ED1 / YES - GO ASK T,B,O /A116 CALL; LP1FF; DLMLP1 / NO - GO REPORT ERROR /A116 GOTO; LP2S / TRY AGAIN /A116 XTRLP2=400-. IFZERO .-401&4000 /LIST PROCESSING START MENU - THE ONE YOU VERIFY AND START IT WITH RELOC ADMLP3=. X=DLMLP3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 LP3S, /D075 SET;0;MNFNO /DELETED SO LP RESULT FILE NUMBER CAN BE REMEMBERED DISP;0;TEXT '-- !&LIST !&PROCESSING !&START !&MENU --' DISP;1405;TEXT '!&FR = &START PROCESSING FROM THIS RECORD (!&FR !L!D)' MNTMP2 DISP;1605 TEXT '!&TO = &PROCESS UP TO AND INCLUDING THIS RECORD (!&TO !L!D)' MNTMP3 DISP;2005;TEXT '!&GO = &PROCESS THE LIST' DISP;2320;TEXT '&TYPE THE LETTERS AND PRESS !&RETURN' /m071 MXDISP;2520;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. LP3RD, READ;MNTMP1;LP3RE ARG;LP3RD;MNTMP1 KEYWRD TEXT 'FR ';LP3FR TEXT 'TO ';LP3TO TEXT 'GO ';LP3GO CALL;CR1NM;DLMCR1 GOTO;LP3RD LP3RE, CASE;MNSYSA /M080 EDMENU&3777;LP3MM CALL;CR1BR;DLMCR1 SET;1;MNTMP1 RETURN LP3MM, SET;0;MNTMP1 RETURN LP3GO, SET;2;MNTMP1 RETURN LP3FR, ARG;LP3ER;MNTMP1 NUMBER;MNTMP1;LP3ER COPY;MNTMP1;MNTMP2 GOTO;LP3ZAP /a071 LP3TO, ARG;LP3ER;MNTMP1 NUMBER;MNTMP1;LP3ER COPY;MNTMP1;MNTMP3 LP3ZAP, DISP;-2700;TEXT '' GOTO;LP3S LP3ER, DISP;-2717 TEXT ' &FOLLOW THE COMMAND WITH A NUMBER FROM 0 TO 4095.' /M078 GOTO;LP3RD XTRLP3=400-. IFZERO .-401&4000 /HELP MENU /LIST PROCESSING - MISCELLANIOUS MENU HELPERS RELOC ADMLP4=. X=DLMLP4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 LP4LPR, DISP;0;TEXT '!E ' /THE FOLLOWING IS A KLUDGE BECAUSE I'M NOT POSITIVE THAT PRINTER /NOT AVAILABLE MESSAGE IS NEVER USED. SO WE CHECK TMP2 FOR A SPECIAL /VALUE AND IF IT'S NOT THEN FALL THROUGH. CASE;MNTMP2 3777;LP4PBS 3776;LP4DED SET;1;MNTMP2 DISP;2205;TEXT '&THE PRINTER IS NOT AVAILABLE.' GOTO;LP4CNT LP4PER, SET;2;MNTMP2 DISP;0;TEXT '!E ' DISP;2205;TEXT '&THE PRINTER CANNOT BE USED WITH &USER &KEYS ACTIVE' DISP;-1;TEXT ' (!&AK !&YES).' LP4CNT, MXDISP;2405;X03PGM;DLMX03 / PRESS GOLD MENU TO RECALL THE MAIN MENU READ;MNTMP1;LP4RER GOTO;LP4BEP LP4RER, CASE;MNSYSA /M080 EDMENU&3777;LP4RTN LP4BEP, DISP;2717;TEXT '^A';LP4BEL CASE;MNTMP2 2;LP4PER GOTO;LP4LPR LP4RTN, RETURN LP4BEL, 007;0 LP4LPD, DISP;2105;TEXT '&PRESS !&RETURN TO TRY ANOTHER NAME.' READ;MNTMP2;LP4LPC ARG;LP4LRT;MNTMP2 LP4LPC, SET;3;MNTMP1 TRNSFR;PP2ER;DLMPP2 LP4LRT, TRNSFR;LP2S;DLMLP2 LP4DED, DISP;2005;TEXT '&PRINTER SETTINGS THAT REQUIRE DEDICATED PRINTING' DISP;2205;TEXT 'MAY NOT BE USED WITH LIST PROCESSING.' GOTO;LP4CNT LP4PBS, DISP;2205;TEXT '&LIST PROCESSING IS NOT ALLOWED WHILE THE PRINTER IS BUSY.' GOTO;LP4CNT XTRLP4=400-. IFZERO .-401&4000 /HELP MENU /ERROR MESSAGES FOR LIST PROCESSING LIST PROCESSING MATH RELOC ADMLP5=. X=DLMLP5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / ENTER WITH: / MNTMP1= 0 FOR LIST PROCESSING, 1 FOR EDITOR MATH / MNTMP2= ACTUAL # OF RECORDS PROCESSED (LIST PROCESSING) / MNTMP3= RECORDS SELECTED (LIST PROCESSING) / MNTMP4= CURRENT RECORD NUMBER (LIST PROCESSING) /D084 (NOT USED WITH STATUS) SQUAT SCREEN FLAG (EDITOR MATH) A038 / MNTMP5= ERROR NUMBER (BOTH LIST PROCESSING AND EDITOR MATH) / 0 = no error -- completion report only / 1 = continue report after error display CASE; MNTMP1 0; LPLPE CASE; MNTMP5 1; -1-ED5CNT; DLMLP8 DISP; 2700; TEXT "^A^A"; EDSCRL; EDSCRL CASE; MNSTAT / TEST NUMBER OF STATUS LINES /A084 0; LP5ZRO / SET UP FOR NO STATUS LINES /A084 1; LP5ONE / SET UP FOR ONE STATUS LINE /A084 2; LP5TWO / SET UP FOR TWO STATUS LINES /A084 / FALL THROUGH TO THREE LINES /A084 LP5TRE, DISP; 1600; TEXT "" / START POSITION FOR 3 LINES /A084 GOTO; LP5SQU / GO CONTINUE DISPLAY /A084 LP5TWO, DISP; 1700; TEXT "" / START POSITION FOR 2 LINES /A084 GOTO; LP5SQU / GO CONTINUE DISPLAY /A084 LP5ONE, DISP; 2000; TEXT "" / START POSITION FOR 1 LINE /A084 GOTO; LP5SQU / GO CONTINUE DISPLAY /A084 LP5ZRO, DISP; 2100; TEXT "" / START POSITION FOR 0 LINES /A084 LP5SQU, DISP; -1; TEXT "!&ERROR -- " /M038 GOTO; LPELST LPLPE, CASE; MNTMP5 /R038 1; -1-LP5CNT; DLMLP8 /R038 DISP; 0; TEXT "!E-- !&LIST !&PROCESSING --" /R038 CASE; MNTMP5 /R038 0; -1-LP5CNT; DLMLP8 /R038 DISP; 234; TEXT "* * * &E &R &R &O &R * * *" /R038 DISP; 405; TEXT "&RECORD &NUMBER: !D"; MNTMP4 /R038 DISP; 505; TEXT "" /R038 / RANGES FOR ERROR MESSAGES ARE AS FOLLOWS: / 0-7 MENU INIT STUFF / 10-77 LIST PROCESSING ERRORS SLPERB=10 / 100-177 SYNTAX ERRORS MSEBEN=100 / 200-277 DATA STRUCTURE OVERFLOW ERRORS DSOBEN=200 / 300-377 FORMULA ERRORS MLABEN=300 / 400-477 FORMAT ERRORS FSEBEN=400 / 500-577 CONTROL BLOCK NUMERIC SYNTAX NSEBEN=500 / 600-677 NUMERIC SYNTAX NSEBE1=600 / 700-777 MATH EXECUTION MEEBEN=700 / SPECIFIC ERROR MESSAGES LPELST, CASE; MNTMP5 EVLGRC; -1-ERR10; DLMLP6 /RECORD EXCEEDS 2500 CHARS. EVPEOF; -1-ERR11; DLMLP6 /RECORD NOT TERMINATED WITH <> EVCRBR; ERR12 /TEXT BETWEN RECORDS M036 EVLBFN; -1-ERR13; DLMLP6 /< WITHIN A FIELD NAME M033 EVLGFN; -1-ERR14; DLMLP6 /FIELD NAME EXCEEDS 30 CHARS. EVRBFD; -1-ERR15; DLMLP6 /> WITHIN A FIELD VALUE EVFULL; -1-ERR16; DLMLP6 /RESULT DOCUMENT DISKETTE FULL EVLGNM; -1-ERR17; DLMLP7 /FIELD VALUE # EXCEEDS 30 CHARS. /M015 EVFLW1; -1-ERR100; DLMLP7 /FORMULA CONTAINS TOO MANY OPERATIONS EVFLW2; -1-ERR101; DLMLP7 /TOO MANY FIELD NAMES SPECIFIED (SEE /M010 / NOTE AT ERR101) /A010 EVFLW3; -1-ERR102; DLMLP7 /NO ROOM LEFT TO STORE THIS FIELD NAME EVFLW4; -1-ERR103; DLMLP7 /CONTROL BLOCK EQUATIONS CONTAIN TOO /A010 / MANY TERMS /A010 EVFLW5; -1-ERR104; DLMLP7 /TOO MANY FORMULAS SPECIFIED /A010 EVFLW6; -1-ERR105; DLMLP7 /LINE HAS EXCEEDED 200 CHARS. /M010 EVFLW7; -1-ERR106; DLMLP7 /UNDEFINED COMMAND AT THIS POSITION /M010 ERRUB; ERR301 /UNMATCHED ANGLE BRACKETS M036 ERRLOF; ERR302 /FIELD NAME TOO LONG ERROVF; -1-ERR700; DLMLP7 /FORMULA CONTAINS TOO MANY OPERATIONS /M012 ERRDB0; ERR701 /DIVIDE BY ZERO ERROR M036 ERNOSP; -1-ERR702; DLMLP7 /NO ROOM IN DOCUMENT FOR RESULT ERNSP2; -1-ERR703; DLMLP7 /NO ROOM FOR THESE RESULTS A033 EVSYN3; -1-ERRSY3; DLMLP8 /MATH AREA ALREADY BEGUN A033 EVSYN4; -1-ERRSY4; DLMLP8 /BEGIN NOT SECOND COMMAND A033 EVSYN5; -1-ERRSY5; DLMLP8 /END NOT SECOND COMMAND A033 EVSYN6; -1-ERRSY6; DLMLP8 /TEXT IN BLOCK FOLLOWING END A033 EREXTR; -1-ERR710; DLMLP6 /NUMBER IN LINE IS IN ERROR A033 TRNSFR; LPNXT; DLMLP6 EDSCRL, 12; 12; 12; 12; 0 ERR12, DISP; -1; TEXT "&TEXT BETWEEN RECORDS" /R036 GOTO; LP5DEX /R036 ERR301, DISP; -1; TEXT "&UNMATCHED ANGLE BRACKETS" /R036 RETURN /R036 ERR302, DISP;-1;TEXT "&FIELD NAME TOO LONG" RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR701, DISP; -1; TEXT "&DIVIDED BY ZERO" /R036 LP5DEX, TRNSFR; LPEDEX; DLMLP8 /R036 XTRLP5=400-. IFZERO .-401&4000 /ERROR MESSAGES AND HANDLING FOR LIST PROCESSING AND LIST PROCESSING MATH RELOC ADMLP6=. X=DLMLP6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THESE RANGE STATEMENTS WERE TRANSFERED HERE FROM PREVIOUS PAGE /CAUSE THERE WAS NOT ENOUGH ROOM TO KEEP THEM WITH THE CASE STATEMENT / THESE ARE SHARED ERROR MESSAGES (DIFFERENT TYPES OF ERRORS SHARE / THE SAME MESSAGES.) LPNXT, RANGE;MNTMP5;DSOBEN;MLABEN+77;LPNXT2 /M012 DISP;-1;TEXT "&FORMULA^S^S";LPIE;LPTAG /M012 CASE;MNTMP5 / APPEND RETURN ERROR MESSAGE /A015 EYNR11;LPNXT4 /A015 ERRFTW;LPNXT4 /A015 RETURN /DSO AND LEXIC-ASCBCD ERROR MESSAGES LPNXT4, DISP;-1;TEXT " (UNEXPECTED RETURN)" /A015 RETURN /A015 LPNXT2, RANGE;MNTMP5;FSEBEN;FSEBEN+77;LPNXT1 /A012 DISP;-1;TEXT "&FORMAT^S^S";LPIE;LPTAG /A012 RETURN /A012 /HANDLE CONTROL BLOCK NUMERIC SYNTAX ERRORS /M012 LPNXT1, RANGE;MNTMP5;NSEBEN;NSEBEN+77;LPNXT3 /A012 DISP;-1;TEXT "&NUMBER^S^S";LPIE;LPTAG /M034 RETURN /D012 /HANDLE NUMERIC SYNTAX ERRORS OUTSIDE OF CONTROL BLOCK /A012 LPNXT3, DISP;-1;TEXT "&NUMBER WITHIN RECORD IS^S";LPIE /M034 GOTO;LPRTN /A012 ERR710, DISP;-1;TEXT "&NUMBER IN LINE IS^S";LPIE /M038 RETURN /M038 LPIE, TEXT " IN ERROR" /A012 LPTAG, TEXT " AT THIS POSITION" ERR10, DISP;-1;TEXT "&RECORD EXCEEDS 2500 CHARACTERS" GOTO;LPRTN /GO BACK TO LP CODE CAUSE NO ERROR DISPLAY ERR11, DISP;-1;TEXT "&RECORD NOT TERMINATED WITH ^S^S";LP5ALB;LP5ARB GOTO;LPRTN /GO BACK TO LP CODE CAUSE NO ERROR DISPLAY ERR13, DISP;-1;TEXT "^S'^SNAME";LP5ALB;LP6WAF /M034 GOTO;LPRTN /GO BACK TO LP CODE CAUSE NO ERROR DISPLAY ERR14, DISP;-1;TEXT "&FIELD NAME EXCEEDS 30 CHARACTERS" GOTO;LPRTN /GO BACK TO LP CODE CAUSE NO ERROR DISPLAY ERR15, DISP;-1;TEXT "'^S^SVALUE";LP5ARB;LP6WAF /M034 GOTO;LPRTN /GO BACK TO LP CODE CAUSE NO ERROR DISPLAY LP6WAF, TEXT " WITHIN A FIELD " /A034 /D088/ERR16, DISP;-1;TEXT "&RESULT DOCUMENT DISKETTE FULL" ERR16, DISP; -1; TEXT '&RESULT DOCUMENT ' /A088 CALL; EM4CKW; DLMEM4 / CK FOR WINI /A088 DISP; -1; TEXT ' FULL' /A088 /D015 LPRTN, TRNSFR;LPEDEX;DLMLP8 /RETURNS TO CODE IFNOT DISP. ERROR LINE A033 LP5ALB, 4774;0 / "'<" LP5ARB, 7647;0 / ">'" XTRLP6=400-. IFZERO .-401&4000 / ERROR HANDLING FOR LIST PROCESSING AND LIST PROCESSING MATH RELOC ADMLP7=. X=DLMLP7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 ERR17, DISP;-1;TEXT "&FIELD VALUE NUMBER EXCEEDS 30 CHARACTERS" /M015 ERR70A, TRNSFR;LPEDEX;DLMLP8 /DISPLAY MESSAGE ONLY /M012 ERR700, ERR100, DISP;-1;TEXT "&FORMULA CONTAINS T^SOPERATIONS";LP7OMN /M034 CASE; MNTMP5 700; ERR70A RETURN /DISPLAY MESSAGE AND THEN ERROR LINE / NOTE - DUE TO CURRENT MATH BUFFER ALLOCATION, ERROR 101 CAN NOT BE /A010 / GENERATED. SEE NOTES IN WPF1 AND EMATH. /A010 ERR101, DISP;-1;TEXT "&T^SFIELD NAMES SPECIFIED";LP7OMN /M034 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR102, DISP;-1;TEXT "&NO ROOM LEFT TO STORE THIS FIELD NAME" /M034 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR103, DISP;-1;TEXT "&CONTROL BLOCK EQUATIONS CONTAIN T^STERMS";LP7OMN /M034 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE /A010 ERR104, DISP;-1;TEXT "&T^SFORMULAS SPECIFIED";LP7OMN /M034 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE /A010 ERR105, DISP;-1;TEXT "&LINE HAS EXCEEDED 200 CHARACTERS" /M010 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR106, DISP;-1;TEXT "&UNDEFINED COMMAND AT THIS POSITION" /M010 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR702, DISP;-1;TEXT "&NO ROOM FOR THIS RESULT:" /M038 RETURN /DISPLAY MESSAGE AND THEN ERROR LINE ERR703, DISP;-1;TEXT "&NO ROOM FOR THESE RESULTS:" /M038 CASE; MNSTAT / TEST NUMBER OF STATUS LINES /A084 0; LP7ZRO / SET UP FOR NO STATUS LINES /A084 1; LP7ONE / SET UP FOR ONE STATUS LINE /A084 2; LP7TWO / SET UP FOR TWO STATUS LINES /A084 / FALL THROUGH TO THREE LINES /A084 LP7TRE, DISP; 1737; TEXT "AND:"; RETURN / START POSITION FOR 3 LINES /A084 LP7TWO, DISP; 2037; TEXT "AND:"; RETURN / START POSITION FOR 2 LINES /A084 LP7ONE, DISP; 2137; TEXT "AND:"; RETURN / START POSITION FOR 1 LINE /A084 LP7ZRO, DISP; 2237; TEXT "AND:"; RETURN / START POSITION FOR 0 LINES /A084 LP7OMN, TEXT "OO MANY " /A034 XTRLP7=400-. IFZERO .-401&4000 /A004 / LIST PROCESSING AND EDITOR MATH ERROR HANDLING RELOC ADMLP8=. X=DLMLP8 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 ERRSY3, DISP; -1; TEXT "&SECOND !&BEGIN COMMAND IN &MATH AREA" /M034 GOTO; LPEDEX /A033 ERRSY4, DISP; -1; TEXT "!&BEGIN^S!&WPSMATH"; CNSWIC /M034 GOTO; LPEDEX /A033 ERRSY5, DISP; -1; TEXT "!&END^S!&WPSMATH"; CNSWIC /M034 GOTO; LPEDEX /A033 CNSWIC, TEXT " COMMAND DOES NOT FOLLOW " /M036 ERRSY6, DISP; -1; TEXT "&TEXT IN CONTROL BLOCK AFTER !&END COMMAND" /A033 LPEDEX, CASE; MNTMP1 0; LP5CNT ED5CNT, CASE; MNSTAT / TEST NUMBER OF STATUS LINES /A084 0; LP8ZRO / SET UP FOR NO STATUS LINES /A084 1; LP8ONE / SET UP FOR ONE STATUS LINE /A084 2; LP8TWO / SET UP FOR TWO STATUS LINES /A084 / FALL THROUGH TO THREE LINES /A084 LP8TRE, DISP; 2305; TEXT "" / START POSITION FOR 3 LINES /A084 GOTO; LP8SQU / GO CONTINUE DISPLAY /A084 LP8TWO, DISP; 2405; TEXT "" / START POSITION FOR 2 LINES /A084 GOTO; LP8SQU / GO CONTINUE DISPLAY /A084 LP8ONE, DISP; 2505; TEXT "" / START POSITION FOR 1 LINE /A084 GOTO; LP8SQU / GO CONTINUE DISPLAY /A084 LP8ZRO, DISP; 2605; TEXT "" / START POSITION FOR 0 LINES /A084 LP8SQU, DISP; -1 /A084 TEXT "&TO CONTINUE: &PRESS !&RETURN AND CORRECT THE ERROR" /A084 DISP; 2700; TEXT "" /A084 ED5RD, PREAD; -1; MNTMP1; ED5BP /M034 ARG; LP5RE1; MNTMP1 /M034 ED5BP, DISP; -2700; TEXT "^A"; LP5BEL GOTO; ED5CNT LP5CNT, DISP; 1434; TEXT "&RECORDS &SELECTED: !D"; MNTMP3 /R038 DISP; 1634; TEXT "&RECORDS &PROCESSED: !D"; MNTMP2 /R038 MXDISP;2505;X03PGM;DLMX03 / PRESS GOLD MENU TO RECALL THE MAIN MENU LP5RD, READ; MNTMP1; LP5RE /WAIT FOR GOLD MENU RESPONSE /R038 ARG; LP5RE1; MNTMP1 /ALLOW RETURN TO ALSO MEAN EXIT /M078 LP5BP, DISP; -2700; TEXT "^A"; LP5BEL /BLEEP FOR ANY NON-GOLD ENTRY /R038 GOTO; LP5RD /R038 LP5RE, CASE;MNSYSA /CHECK FOR GOLD KEY /M080 EDMENU&3777; LP5RE1 /RETURN TO CALLER /R038 GOTO; LP5BP /BLEEP FOR ODD RESPONSE /R038 LP5RE1, SET; 0; MNTMP5 / SET MNTMP5 TO FLAG CALLER IT SHOULD NOT RETURN / RETURN TO PRINT ANY MORE LP5BEL, BELL; 0 XTRLP8=400-. IFZERO .-401&4000 /INDEX MENU COMMAND PROCESSOR RELOC FIELD 2 * 0 ADMIN2=. X=DLMIN2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 IN2S, COPY;MNTMP1;IN2CNT SET;0;MNTMP1 /M070 IN2D, CASE;IN2CNT 0;IN2ZC0 /M070 DISP;600;TEXT '*' /M068 SET;1;MNTMP1 /A070 IN2ZC0, CASE;MNTMP2 /M070 0;IN2FUL /M070 DISP;2540;TEXT '&PRESS !&RETURN TO DISPLAY MORE ENTRIES' /M070 GOTO;IN2CMN IN2FUL, DISP;2540;TEXT '&EITHER PRESS !&RETURN' /M070 IN2CMN, MXDISP;2640;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU. IN2S2, READ;MNTMP3;IN2RE /M070 ARG;IN2RT;MNTMP3 /M070 IN2ER, DISP;2700;TEXT '^A';IN2BEL GOTO;IN2ZC0 IN2RT, SET;0;MNTMP1 IN2RT1, DISP;600;TEXT '!E' /M068 RETURN IN2RE, CASE;MNSYSA /M080 3777&EDADVN;IN2ADV 3777&EDBKUP;IN2BKU 3777&EDMENU;IN2RT1 /M070 GOTO;IN2ER IN2ADV, CASE;MNTMP1 /M070 1;IN2AD2 2;IN2AD3 3;IN2AD4 4;IN2AD5 5;IN2RT /A070 GOTO;IN2ER /M070 IN2BKU, CASE;MNTMP1 /M070 2;IN2AD1 /R070 3;IN2AD2 /R070 4;IN2AD3 /R070 5;IN2AD4 /R070 GOTO;IN2ER /R070 IN2AD1, SET;1;MNTMP1 /M070 DISP;1100;TEXT ' ' /M068 DISP;600;TEXT '*' /M068 GOTO;IN2CK IN2AD2, SET;2;MNTMP1 /M070 DISP;600;TEXT ' ' /M068 DISP;1100;TEXT '*' /M068 DISP;1400;TEXT ' ' /M068 GOTO;IN2CK IN2AD3, SET;3;MNTMP1 /M070 DISP;1100;TEXT ' ' /M068 DISP;1400;TEXT '*' /M068 DISP;1700;TEXT ' ' /M068 GOTO;IN2CK IN2AD4, SET;4;MNTMP1 /M070 DISP;1400;TEXT ' ' /M068 DISP;1700;TEXT '*' /M068 DISP;2200;TEXT ' ' /M068 GOTO;IN2CK IN2AD5, SET;5;MNTMP1 /M070 DISP;1700;TEXT ' ' /M068 DISP;2200;TEXT '*' /M068 IN2CK, RANGE;MNTMP1;0 /M070 IN2CNT, 0;IN2RT DISP;-2700;TEXT '' GOTO;IN2ZC0 IN2BEL, 7;0 XTRIN2=400-. IFZERO .-401&4000 /DELETE DOCUMENT COMMAND PROCESSOR RELOC ADMDL2=. X=DLMDL2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DISP;2400;TEXT '!E' DL2S, CASE;MNTMP2 0;DL2D0 1;DL2D1 2;DL2D2 3;DL2D3 DL2D0, DISP;2500;TEXT '-- &IS THIS THE DOCUMENT YOU WISH TO DELETE? ' DL2D01, DISP;-1;TEXT '(YES OR NO) --' DL2RD0, READ;MNTMP1;DL2RE0 ARG;DL2RE1;MNTMP1 KEYWRD TEXT 'YES ';DL2YS0 TEXT 'NO ';DL2NO0 GOTO;DL2RE1 DL2RE0, CASE;MNSYSA /M080 EDMENU&3777;DL2NO0 DL2RE1, DISP;-2700;TEXT '^A';DL2BEL GOTO;DL2S DL2BEL, 7;0 DL2YS0, SET;0;MNFNO SET;1;MNTMP1 DL2RT0, RETURN DL2NO0, SET;0;MNTMP1 RETURN DL2D1, DISP;2500;TEXT '-- &INDEX DOCUMENT IMPROPERLY FORMATTED --' DL2D1D, DISP;2600;TEXT '-- &DO YOU STILL WISH TO DELETE DOCUMENT (!D.!D)? ' MNDRV;MNDOCN GOTO;DL2D01 DL2D2, DISP;2500;TEXT '-- &THERE IS A DISK ERROR IN DOCUMENT (!D.!D), ';MNDRV MNDOCN DISP;-1;TEXT 'THEREFORE IT CANNOT BE DELETED --' DISP;2600;TEXT '-- &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU --' READ;MNTMP1;DL2RE0 GOTO;DL2RE1 DL2D3, DISP;2500;TEXT '-- &DISK ERROR IN INDEX DOCUMENT --' GOTO;DL2D1D XTRDL2=400-. IFZERO .-401&4000 /AX MENU PROCESSOR /THE AX MENU THAT TAKES OF ALL PROMPTS THAT NEED A DOCUMENT FOR A RESPONSE /THAT IS LOG DOCUMENT, THE TEST LIST AND DEFAULT LIST RELOC ADMAD3=. X=DLMAD3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 ADR3ST, ADR3S, SET;3;MNTMP1 /a052 DISP;100;TEXT '!E ' DISP;1220;TEXT '!&PREPARATION' DISP;2205;TEXT '&TYPE THE NAME OF THE LOG DOCUMENT' DISP;2305;TEXT 'IF ONE IS DESIRED; THEN PRESS !&RETURN' MXDISP;2505;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU ADR3R, READ;MNTMP2;ADR3E /GET DOCUMENT NAME FILNAM;ADR3CR;ADR3ND /CHECK IF DOCUMENT EXISTS SET;1;MNTMP2 SET;MUBUF+MNIBUF;MNPOS /SET THE POINTER TO BEGINING OF TEXT /M080 RETURN ADR3GM, SET;7;MNTMP1 RETURN ADR3E, CASE;MNSYSA /TEST FOR "GOLD MENU" KEY /M080 EDMENU&3777;ADR3GM /D097 CALL; CR1BR; DLMCR1 /ERROR - TYPE ONLY VALID KEYS CALL; A18BR; DLMA18 / "WHEN TYPING TO THE MENU /A097 GOTO;ADR3S /GO BACK AND TRY AGAIN FOR DOC NAME ADR3CR, SET;-1;MNTMP2 RETURN ADR3ND, SET;MUBUF+MNIBUF;MNPOS /RESET TO BEGINNING OF TEST FOR THE COPY IN AX/M080 SET;0;MNTMP2 RETURN XTRAD3=400-. IFZERO .-401&4000 /THE OTHER PROMPTS FOR AX SETUP RELOC ADMAD4=. X=DLMAD4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 ADR4ST, COPY;MNTMP1;MNTMP5 /SAVE THE CALLING VALUE TO MAKE SURE IT IS RETURNED ADR4S, COPY ;MNTMP5;MNTMP1 DISP;100;TEXT '!E ' DISP;1220;TEXT '!&PREPARATION' CASE;MNTMP1 2;ADR4ID 4;ADR4WP 5;ADR4BP ADR4ID, DISP;2205;TEXT '&TYPE THE IDENTIFICATION MESSAGE' /M051 GOTO;ADR4C ADR4WP, DISP;2205;TEXT '&TYPE THE PASSWORD FOR SEND ONLY PROTECTION' GOTO;ADR4C ADR4BP, DISP;2205;TEXT '&TYPE THE PASSWORD FOR SEND AND RECEIVE PROTECTION' ADR4C, ADR4CN, DISP;2305;TEXT 'IF ONE IS DESIRED; THEN PRESS !&RETURN' MXDISP;2505;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU ADR4SR, READ;MNTMP2;ADR4E ADR4CR, RETURN ADR4E, CASE;MNSYSA /M080 EDMENU&3777;ADR4GM /D097 CALL;CR1BR;DLMCR1 CALL; A18BR; DLMA18 / "WHEN TYPING TO THE MENU /A097 GOTO;ADR4S ADR4GM, SET;7;MNTMP1 RETURN XTRAD4=400-. IFZERO .-401&4000 /THIS IS MORE OF THE SEND TO AUTOMATIC RECEIVE STATION RELOC ADMAD5=. X=DLMAD5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THE PROMPT DISP;1300;TEXT '!E ' DISP;2205;TEXT '&TYPE' DISP;2305;TEXT 'THEN PRESS !&RETURN' MXDISP;2505;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU RETURN /THIS IS THE SECOND HALF OF THE MENU ADMAD5 WITH THE TBO OPTIONS ADR5RX, READ;MNTMP1;ADR51X ARG;ADR5RX;MNTMP1 KEYWRD TEXT 'T ';ADR5T TEXT 'B ';ADR5A /M049 TEXT 'O ';ADR5O CALL;CR1NM;DLMCR1 GOTO;ADR5RX ADR51X, CASE;MNSYSA /M080 EDMENU&3777;ADR5GM /D097 CALL;CR1BR;DLMCR1 CALL; A18BR; DLMA18 / "WHEN TYPING TO THE MENU /A097 TRNSFR;ADR6R;DLMAD6 ADR5T, SET;0;MNTMP2 GOTO;ADR5G ADR5A, SET;1;MNTMP2 GOTO;ADR5G ADR5O, SET;-1;MNTMP2 ADR5G, SET;1;MNTMP1 RETURN ADR5GM, SET;2;MNTMP1 RETURN XTRAD5=400-. IFZERO .-401&4000 /DOCUMENT MODIFICATION MENU - TOP, BOTTOM, OVERWRITE /THE MENU FOR ADR TO SEE IF THE FILE HAS TO BE CREATED RELOC ADMAD6=. X=DLMAD6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CASE;MNTMP1 2;ADR6R /IF 2 THEN WANT THE SECOND MENU FILNAM;ADR6NO;ADR6BD CASE;MNTMP1 1;ADR6NL CASE;MNTMP2 / SEE IF SEND OR RECEIVE /A029 1;ADR6NL / IF SEND THEN OK. ELSE CANNOT RECEIVE /A029 / IF LOG DOC OR IN PRINT QUEUE!!!! /A029 /D118 COPY;MNFNO;ADR6LK / SEE IF DOC IS THE LOG DOC. /A021 /D118 CASE;MNLOCK / ... /A021 /D118ADR6LK, 0;ADR6NN / IF IT IS THEN TREAT AS IF LOCKED. /A021 RANGE;MNLOCK;MNFNO;MNFNO;ADR6LK /LOCKED? /A118 GOTO;ADR6NN /THIS CHECK TO CHECK DEV 8-9 H/O BIT /A118 ADR6LK, /A118 PQUEUE;ADR6NN;.+1 / ALSO, IF IN PRT QUEUE THEN LOCKED. /A021 ADR6NL, SET;1;MNTMP1 RETURN ADR6NN, SET;2;MNTMP1 RETURN ADR6NO, SET;-1;MNTMP1 RETURN ADR6BD, CASE;MNTMP1 1;ADR6NO SET;0;MNTMP1 RETURN ADR6R, DISP;200; TEXT '!E' MXDISP;205;X03DNE;DLMX03 / DOCUMENT NAME ALREADY EXISTS, MXDISP;305;X03HMD;DLMX03 / HOW WOULD YOU LIKE TO MODIFY THIS DOCUMENT? MXDISP;605;X03TOP;DLMX03 / T = ADD TEXT AT THE TOP MXDISP;1005;X03BOT;DLMX03 / B = ADD TEXT TO THE BOTTOM MXDISP;1205;X03OVR;DLMX03 / O = OVERWRITE THE DOCUMENT MXDISP;2205;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN, MXDISP;2405;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU TRNSFR;ADR5RX;DLMAD5 XTRAD6=400-. IFZERO .-401&4000 /COMMUNICATIONS ERROR MESSAGES RELOC ADMAD7=. X=DLMAD7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 ADR7E, DISP;0;TEXT '!E ' CASE;MNTMP1 4;ADR7CE /SPECIAL FOR A CREATE ERROR 6;ADR7LG /LOGON PROCESSOR IN GRAPHICS MODE /A114 7;ADR7PS / Print with Print screen /A121 DISP;2205;TEXT '&CANNOT CONNECT, ' CASE;MNTMP1 2;ADR7PT 3;ADR7NP / NON-EXISTANT PRINTER. /A034 5;ADR7NH / NO COMM HARDWARE PRESENT. /A042 ADR7NH, DISP;-1;TEXT '&COMMUNICATION &HARDWARE NOT PRESENT' /A042 GOTO;ADR7DL /A042 ADR7NP, DISP;-1;TEXT '&NON-EXISTENT PRINTER.' /A034M058 GOTO;ADR7DL /A034 ADR7PS, DISP;2205;TEXT '&YOU MAY NOT USE THE PRINTER WHILE &PRINT' /A121 DISP;2305;TEXT '&SCREEN IS RUNNING' /A121 GOTO;ADR7DL /A121 ADR7PT, DISP;-1;TEXT 'PRINTER IN USE.' ADR7DL, MXDISP;2505;X03PGM;DLMX03 / PRESS GOLD MENU TO RECALL THE MAIN MENU COPY;MNTMP1;MNTMP2 /ERR MSG ROUTINES USE MNTMP1 /A061 ADR72R, READ;MNTMP1;ADR72X ARG;ADR72R;MNTMP1 CALL;CR1NM;DLMCR1 /"...HAS NO MEANING HERE" GOTO;ADR72R ADR72X, CASE;MNSYSA /M080 EDMENU&3777;ADR7RT /GOLD MENU /D097 CALL;CR1BR;DLMCR1 /"WHEN TYPING..." CALL; A18BR; DLMA18 / "WHEN TYPING TO THE MENU /A097 COPY;MNTMP2;MNTMP1 /RESTORE MNTMP1 /A061 GOTO;ADR7E ADR7RT, RETURN ADR7LG, DISP;2205;TEXT '&CANNOT CALL !&LOGON PROCESSOR WHILE &T&M=!&GRAPHICS.' GOTO;ADR7DL /A114 ADR7CE, DISP;2205;TEXT '&CANNOT CREATE THE DOCUMENT !A' MNFNAM GOTO;ADR7DL XTRAD7=400-. IFZERO .-401&4000 /COMMUNICATIONS ERROR MESSAGES CONTINUED /DX SCREEN INFORMATION RELOC ADMA10=. X=DLMA10 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 A10S, DISP;305;TEXT '!L&STATUS: ' CASE;MNTMP1 0;A10S0 1;A10S1 2;A10S2 3;A10S3 4;A10S4 5;A10S5 6;A10S6 7;A10S7 /TEMP1 = STATUS A10S0, DISP;-1;TEXT '!&TRANSFER !&CANCELLED' /M049 GOTO;A10J1 A10S1, DISP;-1;TEXT '*** !&ERROR ***' GOTO;A10J1 A10S2, DISP;-1;TEXT '&TRANSFER COMPLETE' GOTO;A10J1 A10S3, DISP;0;TEXT '!E-- !&DOCUMENT !&TRANSFER --' DISP;305;TEXT '&STATUS: &TRYING TO CONNECT' DISP;2410;TEXT '&WAIT FOR CONNECTION' MXDISP;2610;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU RETURN A10S4, DISP;-1;TEXT '&CONNECTION ESTABLISHED' CASE;MNTMP2 /A059 1700;A10S41 / INITIAL PAINT OF AX SCREEN /A059 GOTO;A10S42 /A059 A10S41, DISP;400;TEXT '!E' / ERASE SCREEN /A059 A10S42, GOTO;A10J1 /M059 A10S5, A10S6, DISP;-1;TEXT '&WAITING FOR A RESPONSE' GOTO;A10J1 A10S7, DISP;-1;TEXT '&TRANSFER IN PROGRESS' A10J1, TRNSFR;A11S;DLMA11 XTRA10=400-. IFZERO .-401&4000 /DX OPTIONS MENU - COMMUNICATION STATISTICS RELOC ADMA11=. X=DLMA11 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 A11S, DISP;1000;TEXT '!E ' /M054/M059 CASE;MNTMP5 0;A11AX DISP; 0767; TEXT '&DOCUMENTS PROCESSED:!L !D'; MNTMP5 /C096 A11AX, CASE;MNTMP1 2;A11D2 3;A11D3 7;A11D7 GOTO;A11S3 A11D7, DISP;1405;TEXT '(&APPROXIMATE) PACKETS IN^S:';A11DOC /M031 DISP;1460;TEXT '!D';MNTMP4 RANGE;MNTMP3;0;200;A11PX1 GOTO;A11D2 A11PX1, DISP;-1;TEXT '0' A11D2, DISP;1205;TEXT '&PACKETS IN^S TRANSFERRED:';A11DOC /M031 A11S3, DISP;1005;TEXT '&PACKETS RE-SENT BECAUSE OF LINE ERRORS:' CASE;MNTMP2 0;A11O1B DISP;-1;TEXT '!P!&OPTIONS: ';MNTMP2 A11D3, CASE;MNTMP2 2100;A11O1 1700;A11O2 1500;A11O3 1300;A11O4 /TEMP2 = OPTIONS A11O4, DISP;1505;TEXT '&R = &RECEIVE A^S';A11DOC /M031 A11O3, DISP;1705;TEXT '&S = &SEND A^S';A11DOC /M031 A11O2, DISP;2105;TEXT '&M = &SEND A MESSAGE' A11O1, DISP;2305;TEXT '&B = &BYE, CANCEL TRANSFER' /M049 DISP;2510;TEXT'&TYPE THE OPTION DESIRED AND PRESS !&RETURN' /M031 DISP;2610;TEXT'!&OR ' /M031 GOTO;A11O1C /A031 A11O1B, DISP;2610;TEXT'' /A031 A11O1C, MXDISP;-1;X03PGM;DLMX03 / PRESS GOLD MENU TO RECALL THE MAIN MENU RETURN A11DOC, TEXT' DOCUMENT' /A031 XTRA11=400-. IFZERO .-401&4000 RELOC ADMA12=. X=DLMA12 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 DISP; 0405; TEXT '!L&PROBLEM: ' CASE;MNTMP1 1;A12E1 2;A12E2 3;A12E3 4;A12E4 5;A12E5 6;A12E6 7;A12E7 10;A12E8 11;A12E9 /D088/A12E1, DISP;-1;TEXT '&NOT ENOUGH ROOM ON DISKETTE TO RECEIVE DOCUMENT' A12E1, DISP; -1; TEXT '&NOT ENOUGH ROOM ON ' /C088 CALL; EM4CKW; DLMEM4 / CK FOR WINI /A088 DISP; -1; TEXT ' TO RECEIVE DOCUMENT' /C088 RETURN A12E2, DISP;-1;TEXT '&BAD CONNECTION, TRY AGAIN' RETURN A12E3, DISP;-1;TEXT '&COULD NOT CREATE THE DOCUMENT' RETURN A12E4, DISP;-1;TEXT '&CANNOT CONTINUE, DISK ERROR' RETURN A12E5, DISP;-1;TEXT '&OTHER SYSTEM CANNOT TO RECEIVE THE DOCUMENT' RETURN A12E6, DISP;-1;TEXT '&HAD TO REINITALIZE SINCE OTHER SYSTEM RESTARTED' RETURN A12E7, DISP;-1;TEXT '&CANNOT CONNECT, OTHER SYSTEM HAS A DIFFERENT VERSION' RETURN A12E8, DISP;-1;TEXT '&OTHER SYSTEM IS IN THE SAME STATE' RETURN A12E9, DISP;-1;TEXT '&OTHER USER RETURNED TO &MAIN &MENU' RETURN XTRA12=400-. IFZERO .-401&4000 /THE ERROR MESSAGES FOR TEST LIST DOCUMENT RELOC ADMA13=. X=DLMA13 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THESE MESSAGES ARE FOR THE TEST LIST DOCUMENT ERROR ROUTINE A13S, DISP;-1;TEXT '^A';A13BEL CASE;MNTMP2 2;A13RED DISP;0;TEXT '!E ' CASE;MNTMP2 0;A13E0 1;A13E1 3;A13E3 4;A13E4 5;A13E5 6;A13E6 A13E0, DISP;2205;TEXT '&CANNOT READ THE DOCUMENT !A' MNFNAM GOTO;A13RED A13E1, DISP;2205;TEXT '&ILLEGAL FORMATTED RECORD IN LIST DOCUMENT !A' MNFNAM DISP;2405;TEXT '&FORMAT: ^AN>NAME ^A>';A13BRK;A13BRK GOTO;A13RED A13E3, DISP;2205;TEXT '&DOCUMENT !A CONTAINS AN EMPTY LIST' MNFNAM GOTO;A13RED A13E4, DISP;2205;TEXT '&LOG DOCUMENT' GOTO;A13RE2 A13E5, DISP;2205;TEXT '&DEFAULT LIST DOCUMENT' GOTO;A13RE2 A13E6, DISP;2205;TEXT '&A LIST CAN HAVE ONLY 8 ENTRYS.' A13RE2, DISP;-1;TEXT 'IN USE, CANNOT CONTINUE' A13RED, DISP;2505;TEXT '&PRESS !&RETURN FOR THE MENU.' READ;MNTMP3;A13S RETURN A13BRK, 73;0 /PUT UP THE ANGLE BRACKET A13BEL, 0007;0 /CODE FOR A BELL XTRA13=400-. IFZERO .-401&4000 /THIS IS THE TYPE MESSAGE FOR OTHER SYSTEM PROMPT RELOC ADMA14=. X=DLMA14 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / Called from WPTRNS. / INPUTS: MNTMP1, MNTMP2, MNTMP3 are set to certain WPTRNS values / as a side effect of using the common menu caller DOMENU. / We ignore the inputs of these MNTMPs. / MNTMP4 - 0 for Message prompt. / 1 for error display (has no meaning). / MNIBUF - prior input string passed here. / / OUTPUTS: MNTMP1 - no change / MNTMP2 - ditto. / MNTMP3 - OUTPUT value defined as follows: / 2 Gold:Menu return / 3 normal return. / CASE;MNTMP4 / See which menu to display. 0;A14ST / 0 --> prompt for Message. DISP;2715;TEXT '!L&TYPING "^A" HAS NO MEANING HERE. &TRY AGAIN.' MNIBUF GOTO;A14OK / Take the OK return. A14ST, ARG;A14NG;MNTMP1 A14OK, SET;3;MNTMP3 / Take OK return RETURN A14NG, DISP;1300;TEXT '!E' DISP;2305;TEXT '&TYPE IN THE MESSAGE TO BE SENT TO THE OTHER SYSTEM' DISP;2405;TEXT 'THEN PRESS !&RETURN' MXDISP;2605;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU A14RED, READ;MNTMP1;A14GLD GOTO;A14ST /Try again. A14GLD, CASE;MNSYSA /M080 EDMENU&3777;A14GM / Gold menu return DISP;-1;TEXT '^A';A14BEL GOTO;A14RED / Loop again. A14GM, SET;2;MNTMP3 / Take GOLD MENU return. RETURN / ... A14BEL, 007;0 XTRA14=400-. IFZERO .-401&4000 /DX FILE ALREADY EXISTS MENU RELOC ADMA15=. X=DLMA15 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 GOTO;A15DSP /REQUIRED FOR ASSM. LANG. CALL /A091 A15AGN, ARG;A15DSP;MNTMP1 KEYWRD; TEXT 'T ';A15TOP TEXT 'B ';A15BOT /M051 CASE;MNTMP3 1;A15NOV /IF = 1 THEN TURN OFF OVERPRINT KEYWRD; TEXT 'O ';A15OVR A15NOV, CALL;CR1NM;DLMCR1 A15DSP, DISP;1300;TEXT '!E' DISP;1405;TEXT '&DOCUMENT NAME ALREADY EXISTS,' DISP;1505;TEXT 'WOULD YOU LIKE TO MODIFY THIS DOCUMENT?' DISP;1705;TEXT '&T = &ADD TEXT TO THE TOP' DISP;2105;TEXT '&B = &ADD TEXT TO THE BOTTOM' /M051 CASE;MNTMP3 1;A15NO2 DISP;2305;TEXT '&O = &OVERWRITE THE DOCUMENT' A15NO2, MXDISP;2520;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN MXDISP;2620;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU A15RD1, READ;MNTMP1;A15GCK GOTO;A15AGN A15GCK, CASE;MNSYSA / Check for /M080 EDMENU&3777;A15GM / GOLD:MENU DISP;-1;TEXT '^A';A15BEL/ Ring the bell, GOTO;A15RD1 / and try again. A15GM, SET;0;MNTMP1 / Return 0 for GOLD:MENU RETURN A15OVR, SET;1;MNTMP1 / Return 1 for OVERWRITE RETURN A15TOP, SET;2;MNTMP1 / Return 2 for TOP RETURN A15BOT, SET;3;MNTMP1 / Return 3 for BOTTOM RETURN A15BEL, 007;0 XTRA15=400-. IFZERO .-401&4000 /DX RECEIVE MENU RELOC ADMA16=. X=DLMA16 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / Called from WPTRNS. / INPUTS: MNTMP1 - PMTTMP value / MNTMP2 - AXPMT value (set if prompting for AX side info). / MNTMP3 - Pass indicator as follows: / 0 initialization call. Check input for filename. / 1 display prompt(s) & process input. / MNIBUF - filename passed as input here. / / OUTPUTS: MNTMP1 - no change / MNTMP2 - ditto. / MNTMP3 - OUTPUT value defined as follows: / 0 default filename accepted. process it in step 0. / 1 use default filename in prompt displays. / 2 Gold:Menu return / 3 normal return. filename is accepted. / 4 normal return. file needs to be created. / A16, CASE;MNTMP3 / See which pass to process. / 0;A16FNM / Check out the filename. 1;A16DSP / Display prompt(s). A16FNM, CASE;MNTMP2 0;A16S2 / Jmp if NOT AX prompt. ARG;A16NAR;MNTMP4 / See if there's something typed in. A16OK, SET;3;MNTMP3 / Yes! Return & accept it. RETURN / ... A16S2, COPY;MNPOS;MNTMP5 / Save current position pointer. ARG;A16NAR;MNTMP4 / See if there's anything there. A16FIL, COPY;MNTMP5;MNPOS / Restore filename pointer. FILNAM;A16NAR;A16ND / Parse filename. RANGE;MNLOCK;MNFNO;MNFNO;AD16LK /LOCKED /A117 GOTO;-1-A18LKE;DLMA18 /YES-TREAT IT AS LOCKED /A117 /D117 COPY;MNFNO;AD16LK / See if DOC is the LOG doc. /D117 CASE;MNLOCK / ... /D117AD16LK, 0;-1-A18LKE;DLMA18 / If yes, then treat as if it's locked. AD16LK, /A117 PQUEUE;-1-A18LKE;DLMA18;.+1/ Also, if DOC in PRINT QUE then it's locked. SET;3;MNTMP3 / Return FILE OK prompt. RETURN A16ND, SET;4;MNTMP3 / File needs to be created return. RETURN A16NAR, SET;1;MNTMP3 / Take "NO ARG PRESENT" return. RETURN / ... A16DSP, DISP;1300;TEXT '!E' DISP;2005;TEXT '&TYPE THE NAME OF THE DOCUMENT TO RECEIVE' /M049 DISP;-1;TEXT ' THE DOCUMENT BEING SENT' /M049 DISP;2105;TEXT 'THEN PRESS !&RETURN' /M051 A16S1, CASE;MNIBUF / See if there's a default filename prompt. 0;A16SR / Skip outputting prompt if no. DISP;2305;TEXT '!&OR JUST PRESS !&RETURN TO USE THE DOCUMENT NAME' DISP;-1;TEXT ' GIVEN ON THE NEXT LINE' DISP;2405;TEXT '^A';MNIBUF A16SR, DISP;2605;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE' CASE;MNTMP1 0;A16S3 DISP;-1;TEXT ' &MAIN' A16S3, DISP;-1;TEXT ' &MENU' A16RD1, READ;MNTMP3;A16GCK COPY;MNPOS;MNTMP5 / Save posn of filename (if present). ARG;A16NA1;MNTMP3 / See if anything entered. CASE;MNTMP2 / See if AX prompt. 0;A16FIL / JMP if NO. Go check out filename. GOTO;A16OK / JMP if yes. Accept the entered filename. A16GCK, CASE;MNSYSA / Check for /M080 EDMENU&3777;A16GM / GOLD:MENU /D093 DISP;-1;TEXT '^A';A16BEL/ Ring bell for error. CALL; A18BR; DLMA18 / DISPLAY "WHEN TYPING TO THE KEY... /A093 GOTO; A16NAR / and try again. A16NA1, SET;0;MNTMP3 / No filename entered. Return to process RETURN / the default filename. A16GM, SET;2;MNTMP3 / Take GOLD:MENU return. RETURN / ... A16BEL, 007;000 / Text string to ring bell. XTRA16=400-. IFZERO .-401&4000 /DX SEND MENU RELOC ADMA17=. X=DLMA17 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / Called from WPTRNS. / INPUTS: MNTMP1 - PMTTMP value / MNTMP2 - AXPMT value (set if prompting for AX side info). / MNTMP3 - Pass indicator as follows: / 0 initialization call. Check input for filename. / 1 display prompt(s) & process input. / MNIBUF - filename passed as input here. / / OUTPUTS: MNTMP1 - no change / MNTMP2 - ditto. / MNTMP3 - OUTPUT value defined as follows: / 0 default filename accepted. process it in step 0. / 1 use default filename in prompt displays. / 2 Gold:Menu return / 3 normal return. filename is accepted. / A17, CASE;MNTMP3 / See which pass to process. / 0;A17FNM / Check out the filename. 1;A17DSP / Display prompt(s). A17FNM, CASE;MNTMP2 0;A17S2 / Jmp if NOT AX prompt. ARG;A17NAR;MNTMP4 / See if there's something already typed. A17OK, SET;3;MNTMP3 / Yes! return & accept it. RETURN / ... A17S2, COPY;MNPOS;MNTMP5 / Save current position. ARG;A17NAR;MNTMP4 / See if possible filename present. A17FIL, COPY;MNTMP5;MNPOS / Restore pointer to start of filename. FILNAM;A17NAR;-1-A18ND;DLMA18 / Parse filename. GOTO;A17OK / Filename parsed. Accept it. A17NAR, SET;1;MNTMP3 / Take "NO ARG PRESENT" return. RETURN / ... A17DSP, DISP;1300;TEXT '!E' DISP;2005;TEXT '&TYPE THE NAME OF THE DOCUMENT YOU WISH TO ' CASE;MNTMP2 0;A17SS /IF AX SAY RECEIVE IF DX SAY SEND DISP;-1;TEXT 'RECEIVE FROM THE SYSTEM IN !&AX' GOTO;A17S1B A17SS, DISP;-1;TEXT 'SEND' A17S1B, DISP;2105;TEXT 'THEN PRESS !&RETURN' /M051 CASE;MNIBUF / See if default filename prompt. 0;A17SR / Skip prompt if no. DISP;2305;TEXT '!&OR JUST PRESS !&RETURN TO USE THE DOCUMENT NAME' DISP;-1;TEXT ' GIVEN ON THE NEXT LINE' DISP;2405;TEXT '^A';MNIBUF A17SR, DISP;2605;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE' CASE;MNTMP1 0;A17S3 DISP;-1;TEXT ' &MAIN' A17S3, DISP;-1;TEXT ' &MENU' A17RD1, READ;MNTMP3;A17GCK COPY;MNPOS;MNTMP5 / Save ptr to start of filename. ARG;A17NA1;MNTMP3 / See if anything typed. Process if no. CASE;MNTMP2 / AX PROMPT? 0;A17FIL / Jmp if NO. GOTO;A17OK / AX prompt. Accept whwatever we have. GOTO;A17FIL / Check out the user entered filename. A17GCK, CASE;MNSYSA / Check for /M080 EDMENU&3777;A17GM / GOLD:MENU /D093 DISP;-1;TEXT '^A';A17BEL/ Ring bell CALL; A18BR; DLMA18 / DISPLAY "WHEN TYPING TO THE KEY..." /A093 GOTO; A17NAR / and try again. A17NA1, SET;0;MNTMP3 / Return to do FILNAM on default file name. RETURN / ... A17GM, SET;2;MNTMP3 / Gold Menu return. RETURN A17BEL, 007;000 / Text string to ring the bell. XTRA17=400-. IFZERO .-401&4000 /DX - CANNED ROUTINES RELOC FIELD 3 *0 ADMA18=. X=DLMA18 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THE CANNED MESSAGES A18BR, DISP; 2100; TEXT '!E^A';A18BEL DISP;2205 TEXT '&WHEN TYPING TO THIS MENU, USE NORMAL KEYS ON THE KEYBOARD ONLY.' DISP;2305 IFDEF CONDOR < /A073 TEXT '&THE &RUBOUT ^A KEY CAN ALSO BE USED.' /M073 A18BRK /A064 > / END IFDEF CONDOR /A073 IFNDEF CONDOR < /A073 TEXT '!&RUB !&CHAR AND !&RUB !&WORD CAN ALSO BE USED.' /A073 > / END IFNDEF CONDOR /A073 DISP; -1; TEXT ' &A LINE MAY CONTAIN A' /A073 DISP;2405 TEXT 'MAXIMUM OF 64 CHARACTERS AND MUST END WITH !&RETURN.' GOTO;A18CN A18ND, DISP;1300;TEXT '!E^A';A18BEL TSTBIT; MNOPTN; MNRX2X; A18DRV / CK FOR WINI INST /A088 CASE; MNDRV / YES - CK NUMBER /A088 0; A18DRV / 0 - DRIVE /A088 1; A18CD1 / 1 - DRIVE OR DEVICE ? /A088 A18DEV, DISP; -1; TEXT '&DEVICE' /A088 GOTO; A18CKD / FINISH STRING /A088 A18CD1, TSTBIT; MNOPTN; MNRX3X; A18DRV / CK 1 = DRIVE /A088 GOTO; A18DEV / NO - DISP "DEVICE... /A088 A18DRV, DISP; -1; TEXT '&DRIVE' /A088 A18CKD, DISP; -1; TEXT ' !D DOES NOT HAVE A DOCUMENT NAMED !A' /C088 /D088 DISP;2205;TEXT '&^S !D DOES NOT HAVE A DOCUMENT NAMED !A' /D088 A18DOA MNDRV MNFNAM GOTO;A18CN A18LKE, DISP;1300;TEXT '!E' DISP;2505;TEXT '&DOCUMENT (!D.!D) !A IS ALREADY IN USE.' MNDRV;MNDOCN;MNFNAM A18CN, DISP;2605;TEXT '&PLEASE PRESS !&RETURN AND TRY AGAIN.' A18RD1, READ; MNTMP9; A18BR / TAKE ONLY A RETURN /M097 ARG; A18RT; MNTMP9 / /M097 GOTO; A18BR / Something present. beep. /M097 A18RT, SET; 1; MNTMP3 / No ARG present. RETURN A18BAD, CASE;MNSYSA /M080 EDMENU&3777;A18GM A18BA2, DISP;-1;TEXT '^A';A18BEL GOTO;A18RD1 A18GM, SET;2;MNTMP3 / Take GOLD:MENU return. RETURN A18BEL, 007;0 /A18DOA, TEXT 'DRIVE' A18BRK, 074; 130; 135; 0 /A064M066 XTRA18=400-. IFZERO .-401&4000 /THE MAIN MENU FOR THE DEFAULT COMMUNICATIONS DISPLAY /ALL THE DX AND AX MENUS USE TEMP 1 FOR ACTION VALUE TEMP 2 FOR DOCUMENT /STATUS AND TEMP5 FOR VALUES KEPT OVETR MENU CALLS RELOC ADMA19=. X=DLMA19 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 A19S, DISP;0;TEXT '-- !&AUTOMATIC !&TRANSFER !&MENU --' DISP;2205 TEXT '&IF THE SETTINGS ARE CORRECT, TYPE !&YES, OTHERWISE TYPE !&NO' DISP;2305;TEXT 'THEN PRESS !&RETURN.' MXDISP;2505;X03PGM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU A19RED, READ;MNTMP1;A19RER ARG;A19ERT;MNTMP1 KEYWRD TEXT 'YES ';A19YES TEXT 'NO ';A19NO TEXT 'ID ';A19ID TEXT 'LD ';A19LD TEXT 'SP ';A19SP TEXT 'BP ';A19BP CALL;CR1NM;DLMCR1 GOTO;A19RED A19YES, SET;0;MNTMP1 RETURN A19NO, SET;11;MNTMP1 RETURN A19RER, CASE;MNSYSA /M080 EDMENU&3777;A19MM CALL; A18BR; DLMA18 / CALL;CR1BR;DLMCR1 A19ERT, SET;7;MNTMP1 RETURN A19ID, SET;2;MNTMP1 GOTO;A19AG A19LD, SET;3;MNTMP1 COPY;MNPOS;MNTMP5 /M080 FILNAM;A19TR1;A19ND COPY;MNTMP5;MNPOS /M080 SET;1;MNTMP2 RETURN A19SP, SET;4;MNTMP1 GOTO;A19AG A19BP, SET;5;MNTMP1 A19AG, COPY;MNPOS;MNTMP5 /M080 ARG;A19TRN;MNTMP2 COPY;MNTMP5;MNPOS /M080 RETURN A19TRN, TRNSFR;ADR4ST;DLMAD4 A19TR1, TRNSFR;ADR3ST;DLMAD3 A19ND, COPY;MNTMP5;MNPOS /M080 SET;0;MNTMP2 RETURN A19MM, SET;10;MNTMP1 RETURN XTRA19=400-. IFZERO .-401&4000 /HOW TO CHANGE THE SETTINGS FOR ADR RELOC ADMA20=. X=DLMA20 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 A20S, DISP;100;TEXT '!E ' DISP;505;TEXT '!&ID = &IDENTIFICATION MESSAGE' /M051 DISP;705;TEXT '!&LD = &LOG DOCUMENT' DISP;1105;TEXT '!&SP = &SEND ONLY PASSWORD' DISP;1305;TEXT '!&BP = &BOTH SEND AND RECEIVE PASSWORD' MXDISP;2405;X02TLS;DLMX02 / TYPE THE LETTER(S) AND THEN PRESS RETURN MXDISP;2505;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU TRNSFR;A19RED;DLMA19 XTRA20=400-. IFZERO .-401&4000 /THIS IS THE MENU FOR THE CX ROUTINE THAT WILL TEST A DOCUMENT FOR VALID CX /PRINT CONTROLS FOR THE CX PROGRAM RELOC ADMCX0=. X=DLMCX0 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CASE;MNTMP1 0;CX0D0 1;CX0D1 2;CX0D2 CX0FER, CALL;CR1ND;DLMCR1 CX0D0, DISP;0;TEXT '!E ' DISP;1505;TEXT '&TYPE THE NAME OF THE DOCUMENT TO BE TESTED' DISP;-1;TEXT ' THEN PRESS !&RETURN' DISP;1705 TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &COMMUNICATIONS &MENU.' READ;MNTMP2;CX0ER FILNAM;CX0D0;CX0FER SET;0;MNTMP1 DISP;0;TEXT '!E ^P';1500 /CLEAR THE SCREEN AND POSTION THE CURSER /FOR ANY ERROR MESSAGES RETURN CX0D1, DISP;0;TEXT '!E ' DISP;1505;TEXT '&THERE ARE NO ERRORS IN DOCUMENT (!D.!D) !A' MNDRV;MNDOCN;MNFNAM MXDISP;1705;X03PRR;DLMX03 / PRESS RETURN TO RECALL THE MENU. CX0D2A, READ;MNTMP2;CX0ER3 SET;0;MNTMP1 RETURN CX0D2, DISP;-1;TEXT ' IN DOCUMENT (!D.!D) !A^A';MNDRV;MNDOCN;MNFNAM;CX0NLN MXDISP;-1;X03PRR;DLMX03 / PRESS RETURN TO RECALL THE MENU. DISP;-1;TEXT '^A';CX0NL2 GOTO;CX0D2A CX0ER, CASE;MNSYSA /M080 EDMENU&3777;CX0ER2 CALL;CR1BR;DLMCR1 GOTO;CX0D0 CX0ER2, SET;1;MNTMP1 RETURN CX0ER3, DISP;-2700;TEXT '^A';CX0BEL GOTO;CX0D2A CX0BEL, 7;0 CX0NL2, 15;12 CX0NLN, 15;12;15;12;40;40;40;40;40;0 XTRCX0=400-. IFZERO .-401&4000 /CX ERROR MESSAGES RELOC ADMCX1=. X=DLMCX1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THIS IS CALLED FROM WITHIN CX CASE;MNTMP1 1;CX1CRE /CREATE ERROR 2;CX1INT /FILE ERROR (BAD BLOCK) 3;-1-CX2OFL;DLMCX2 /DISK OVERFLOW ON WRITE TO DISK 4;-1-MGRNOH;DLMMGR /MAGCRD - MUST HAVE HOST IN OPTIONS/M119 5;-1-MGRONE;DLMMGR /MAGCRD - CANT HAVE 'DH HD' /M119 / ATTEMPT TO READ AND WRITE THE SAME FILE DISP;0;TEXT '!E ' DISP;2205;TEXT '&IT IS ILLEGAL TO READ FROM AND WRITE TO THE SAME ' DISP;-1;TEXT 'DOCUMENT.' GOTO;CX1RT CX1INT, DISP;0;TEXT '!E ' DISP;2205;TEXT '&THE DOCUMENT CONTAINS A BAD BLOCK.' GOTO;CX1RT CX1CRE, DISP;0;TEXT '!E ' DISP;2205;TEXT '&COULD NOT CREATE DOCUMENT !A';MNFNAM CX1RT, DISP;2405;TEXT '&PRESS !&RETURN^S' /C048 CX1REC /A048 READ;MNTMP1;CX1ER ARG;CX1RTN;MNTMP1 CX1ER, CALL;CR1NM;DLMCR1 GOTO;CX1RT CX1RTN, RETURN CX1BOT, CASE;MNCMTP 1;CX1DSP DISP; 2105; TEXT '^S&R^SOR' /M100 CX1TYP /A048 CX1REC /A048 DISP; 2205; TEXT '^S&H^SAND HANG UP THE MODEM' /M100 CX1TYP /A048 CX1REC /A048 CX1DSP, DISP;2305;TEXT '&PRESS &GOLD !&MENU TO RECALL THE' CASE;MNCMTP 1;CX1DS2 DISP; -1; TEXT ' &MAIN' CX1DS2, DISP; -1; TEXT ' &MENU.' CX1COM, DISP;2505;TEXT '&SPECIFY OPTIONS THEN PRESS !&RETURN.' DISP;2700;TEXT '' RETURN IFDEF CONDOR < /A099 CX1TYP, TEXT '&PRESS !&LOCAL-!&CMND ' /M100 > / END IFDEF CONDOR /A099 IFNDEF CONDOR < /A099 CX1TYP, TEXT '&TYPE &\' /M100 > / END IFNDEF CONDOR /A099 CX1REC, TEXT ' TO RECALL THIS MENU ' /A048 /M095 XTRCX1=400-. IFZERO .-401&4000 /THE COMMUNICATIONS MENU RELOC ADMCX2=. X=DLMCX2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THIS IS CALLED FROM WITHIN CX DISP;0;TEXT '!E ' DISP;0005;TEXT '-- ' CASE; MNCMTP 0; CX2RCX DISP; -1; TEXT '!&MAG !&CARD ' CX2RCX, DISP; -1; TEXT '!&COMMUNICATIONS !&MENU --' DISP;0205;TEXT '!&KS = &^S&^S';CX2KT;CX2SC DISP;0305;TEXT '!&KP = &^S&^S';CX2KT;CX2PR DISP;0405;TEXT '!&KH = &^S&^S';CX2KT;CX2HO CASE; MNCMTP 1; CX2RC2 DISP;0505;TEXT '!&KD = &^S&^S';CX2KT;CX2DO CX2RC2, DISP;0705;TEXT '!&HS = &^S&^S';CX2HT;CX2SC DISP;1005;TEXT '!&HP = &^S&^S';CX2HT;CX2PR DISP;1105;TEXT '!&HD = &^S&^S';CX2HT;CX2DO DISP;1305;TEXT '!&DS = &^S&^S';CX2DT;CX2SC DISP;1405;TEXT '!&DP = &^S&^S';CX2DT;CX2PR DISP;1505;TEXT '!&DH = &^S&^S';CX2DT;CX2HO CASE;MNCMTP 1;CX2DSP DISP;1705;TEXT '!&TD = &TEST DOCUMENT' CX2DSP, TRNSFR;CX1BOT;DLMCX1 CX2KT, TEXT 'KEYBOARD TO ' CX2HT, TEXT 'HOST TO ' CX2DT, TEXT 'DOCUMENT TO ' CX2SC, TEXT 'SCREEN' CX2PR, TEXT 'PRINTER' CX2HO, TEXT 'HOST' CX2DO, TEXT 'DOCUMENT' CX2OFL, DISP;0;TEXT '!E ' /D088 DISP;2205;TEXT '&THE DISKETTE BEING WRITTEN TO IS FULL.' DISP; 2205; TEXT '&THE ' /C088 CALL; EM4CKW; DLMEM4 / CK FOR WINI /A088 DISP; -1; TEXT ' BEING WRITTEN TO IS FULL.' /C088 TRNSFR;CX1RT;DLMCX1 XTRCX2=400-. IFZERO .-401&4000 / SO 0 - FIRST PAGE OF THE SYSTEMS OPTIONS MENU RELOC ADMSO0=. X=DLMSO0 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO0S, CASE; MNTMP4 / DON'T REFRESH SCREEN UNLESS WE NEED TO./A032 0;SO0SOK / JMP IF SCREEN DOESN'T NEED REFRESHING. /A032 DISP;0000; TEXT '!E-- !&SYSTEM !&OPTIONS !&MENU --' DISP;0305; TEXT '!&CC = &CHANGE CHARACTERISTICS OF COMMUNICATION' /M060/A105 TSTBIT; MNOPTN; MNRXAX; SO0S20 /CANNOT CHANGE DMIII PRINTER PORT /A105 DISP; -1; TEXT ' PORT' /DMIII /A105 GOTO; SO0S30 /A105 SO0S20, /DMII /A105 DISP;-1; TEXT ' AND PRINTER PORTS' /M060/A105 SO0S30, /A105 DISP;0505; TEXT '!&BC = &BUFFER CONTROL (!&BC' DISP;0705; TEXT '!&CD = &DOCUMENT WITH !&CX TRANSFER FORMAT' DISP;1205; TEXT '!&TM = &TERMINAL MODE (!&TM =' /M047 DISP;1405; TEXT '!&CT = &CONNECTION TIMEOUT DELAYS FOR !&AX/!&DX'/M047 DISP;1605; TEXT '!&SC = &SET &SYSTEM &CONVENTIONS' /AWCE SO0SOK, DISP;-1456; TEXT '(!&CT !D)' /M047 MNXDLY /A045 SO0CPE, TSTBIT; MNXONF; 1; SO0TS2 /M081 DISP; -0535; TEXT 'NO)' /A105 GOTO; SO0TS3 /A105 SO0TS2, DISP;-0535; TEXT 'YES)' /A105 SO0TS3, /A105 CASE; MNCXP 0;SO0CD1 GOTO; SO0CD2 SO0CD1, DISP;-1012; TEXT '&NONE' SO0CD2, CASE; CXTMOD /DM-I DM-II /A018 /C044 0; SO0TM0 /VT52 VT52 /A018 /C044 1; SO0TM1 /VT278 VT100 /A024 /C044 IFDEF CONDOR < /A085 2; SO0TM2 / DECMATE /A108 3; SO0TM3 / VT125 /A085 / 4; SO0TM4 / Vt227 /A119 / DISP;-1236; TEXT '228)' /VT227 /A108 / 4; SO0TM4; DLMSO1 / VT227 - CONTINUE ON NEXT PAGE /A108 / DISP;-1236; TEXT '&D&E&CMATE)' /M047 /A105 > /END IFDEF CONDOR /A085 / IFNDEF CONDOR < DISP;-1236; TEXT '&SPECIAL)'> /DECWORD /C099 / GOTO; SO0CTM / CONTINUE BELOW. /A024 TRNSFR; SO1TM4; DLMSO1 / HAndle others in next block /A119 SO0TM4, DISP;-1236; TEXT '228)' /VT228 GOTO; SO0CTM SO0TM2, IFDEF CONDOR / CONTINUE NEXT PAGE /A108 SO0TM0, DISP;-1236; TEXT '52)' /VT52 /M074 GOTO; SO0CTM / CONTINUE BELOW /A024 SO0TM3, /A085 IFDEF CONDOR < DISP;-1236; TEXT '!&GRAPHICS)' /GRAPHICS /C111 GOTO; SO0CTM /CONTINUE BELOW /A085 > /END IFDEF CONDOR /A085 SO0TM1, IFDEF CONDOR < DISP;-1236; TEXT '100)'> /VT100 /M047 IFNDEF CONDOR < DISP;-1236; TEXT '278)'> /VT278 /C099 SO0CTM, TRNSFR; SO0FIN; DLMSO1 /"TYPE...OR GOLD MENU" AND RETURN /A105 XTRSO0=400-. IFZERO .-401&4000 / SO 1 - FIRST PAGE OF THE SYSTEMS OPTIONS MENU RELOC ADMSO1=. X=DLMSO1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO1RDA, SET;1;MNTMP3 /MNTMP3 IS USED FOR THE SUBMENUS TO TELL IF FIRST TIME /THROUGH THE MENU SO SET BEFORE CALLING SET;0;MNTMP4 / SAY SO MENU DOESN'T NEED REFRESHING. /A033 SET;0; MNCMTP /ALWAYS SET STANDARD PROTOCALL /A046 READ; MNTMP1; SO1ERR ARG; SO1RDA; MNTMP1 KEYWRD TEXT 'BC '; SO1BC TEXT 'CC '; SO1CC TEXT 'CD '; -1-SO4S1;DLMSO4 TEXT 'CT '; SO1TO /M045 TEXT 'SC '; SO1SC /A103 TEXT 'TM '; SO1TM CALL; CR1NM; DLMCR1 GOTO; SO1RDB /M065 SO1ERR, SET; 2; MNTMP2 / SET UP TO TELL CU4 THIS IS GOLD MENU CASE;MNSYSA /M080 EDMENU&3777;SO1MM / GOTO CU4 IF THIS IS GOLD MENU CALL;CR1BR;DLMCR1 DISP;2000;TEXT '!E' / ERASE THE "CR1BR" ERROR MESSAGE. /A041 SO1RDB, MXDISP;2120;X02TLS;DLMX02 / TYPE THE LETTER(S) AND PRESS RETURN MXDISP;2320;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU GOTO; SO1RDA / DO ANOTHER READ... /A041 SO1TO, CALL; SOSUBD; DLMSO1 / CHECK FOR ARG & DO MENU. /M045 CASE; MNTMP2 1; -1-SO2AR2; DLMSO2 / ARG PRESENT. TRNSFR; SO2S; DLMSO2 / ARG NOT PRESENT. SO1BC, CALL; SOSUBD; DLMSO1 / CHECK FOR ARG & DO MENU. CASE; MNTMP2 1; -1-SO3AR2; DLMSO3 / ARG PRESENT. TRNSFR; SO3S; DLMSO3 / ARG NOT PRESENT. SO1CC, SET; 4; MNTMP2 / "CC" MENU SELECTED /A102 RETURN / TELL CU4 /A102 SO1TM, CALL; SOSUBD; DLMSO1 / CHECK FOR ARG & DO MENU. CASE; MNTMP2 1; -1-SO6AR2; DLMSO6 / ARG PRESENT. TRNSFR; SO6S; DLMSO6 / ARG NOT PRESENT. SO1SC, CALL; SO1NOA; DLMSO1 / DISPLAY COMMON MENU TEXT TRNSFR; SO5S; DLMSO5 SOSUBD, ARG; SO1NOA; MNTMP1 / SEE IF ARG PRESENT. /A021 SET; 1; MNTMP2 / SET ARG PRESENT FLAG. /A021 SO1MM, RETURN / RETURN TO PICK UP ARG. /A021 SO1NOA, SET; 0; MNTMP2 / SET ARG NOT PRESENT FLAG. /A021 SOSUB1, SET; 1; MNTMP4 / SAY SO MENU WILL NEED REFRESHING. /A033 DISP; 0; TEXT '!E' / SET UP COMMON MENU. /A021 SOSUB2, DISP; 2200; TEXT '!E' / CLEAR POSSIBLE "CR1BR" ERROR MESSAGE DISP; 2220; TEXT '&TYPE THE DESIRED OPTION AND PRESS !&RETURN' /M085 DISP; 2420 TEXT '!&OR &PRESS !&RETURN TO RECALL THE &SYSTEM &OPTIONS &MENU' /M085 MXDISP;2620;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU RETURN /---------------------------------------------------------------------------/ SO1TM4, CASE; CXTMOD /A119 4;SO1TM7 /A119 5;SO1TM8 /A119 SO1TMF, DISP;-1236; TEXT '22&F) ' /A119 GOTO; SO0FIN /A119 SO1TM8, DISP;-1236; TEXT '228) ' /A119 GOTO; SO0FIN /A119 SO1TM7, DISP;-1236; TEXT '227) ' /A119 GOTO; SO0FIN /A119 SO1TM2, /A108 IFDEF CONDOR < DISP;-1236; TEXT '&D&E&CMATE)' > / DECMATE /A108 SO0FIN, /EXIT FROM SO0 /A105 MXDISP; 2120; X02TLS; DLMX02 /TYPE THE LETTER(S) AND PRESS RETURN MXDISP; 2320; X02PGM; DLMX02 /OR PRESS GOLD MENU TO RECALL THE MAIN MENU DISP; -2700; TEXT '' / ERASE LAST LINE /A032 RETURN XTRSO1=400-. IFZERO .-401&4000 / PROMPT FOR TYPE OF PROTOCOL RELOC ADMSO2=. X=DLMSO2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /CM2S, / CALLED FROM "WPCX" MUST BE AT START OF BLOCK!!!! /A076 SO2RD, SET;3;MNTMP1 / 3 FOR "SEND" /A076 CALL;CM2DSP;DLMCM2 / PROMPT FOR FILE NAME. /A076 READ;MNTMP1;SO2RE / /A076 CASE;MNFNO / IS THERE A DEFAULT FILE NAME? /A076 0;SO2FN / JMP IF NO. TEST WHAT WAS JUST ENTERED./A076 FILNAM;SO2RT;SO2ND / CHECK OUT FILENAME. /A076 GOTO;SO2RT / RETURN. /A076 / /A076 SO2FN, FILNAM;SO2RD;SO2ND / CHECK OUT FILENAME. /A076 SO2RT, SET;2700;MNTMP3 / POSN CURSOR TO BOTTOM LINE. /A076 DISP;0;TEXT '!E !P';MNTMP3 / /A076 SET;0;MNTMP1 / SET FLAG THAT SAYS FILENAME. /A076 RETURN / RETURN TO CALLER (WPCX). /A076 / /A076 SO2RE, CASE;MNSYSA / /M080 EDMENU&3777;SO2GMR / /A076 CALL;CR1BR;DLMCR1 / /A076 GOTO;SO2RD / /A076 / /A076 SO2ND, CALL;CR1ND;DLMCR1 / NO DOCUMENT. /A076 GOTO;SO2RD / TRY AGAIN. /A076 / /A076 SO2GMR, SET;2;MNTMP1 / GOLD:MENU RETURN. /A076 RETURN / RETURN TO CALLER (WPCX). /A076 SO2S, DISP; 0000; TEXT '-- !&CONNECTION !&TIMEOUT !&MENU --' /A046 DISP;1405 TEXT '&ENTER CONNECTION TIMEOUT DELAY IN SECONDS (1 TO 90)' /M045 SO2ARG, ARG; SO2RDA; MNTMP1 SO2AR2, NUMBER; MNTMP5; SO2NUM /A045 RANGE; MNTMP5; 1; 132; SO2NUM /A045 COPY;MNTMP5;MNXDLY /A045 GOTO; SO2MM /A045 SO2NUM, DISP;-2710;TEXT'&MUST BE A NUMBER FROM 1 TO 90' /A045 CASE; MNTMP3 1; SO2SMR GOTO; SO2RDB /A021 SO2RDA, CASE; MNTMP3 / 1ST TIME THRU? /A021 0; SO2MM / IF NOT THEN RETURN TO SO MENU. /A021 SO2RDB, SET; 0; MNTMP3 READ; MNTMP1; SO2ERR GOTO; SO2ARG SO2MM, SET; 1; MNTMP2 RETURN SO2GM, SET; 2; MNTMP2 / GOLD MENU RETURN TO MAIN MENU. /A021 RETURN / TELL "CU4" /A021 SO2ERR, CASE;MNSYSA /M080 EDMENU&3777; SO2GM CALL; CR1BR; DLMCR1 SET; 1; MNTMP3 /A065 TRNSFR; SO1TO; DLMSO1 /M065 SO2SMR, TRNSFR; SO1RDA; DLMSO1 /----------------------------------------------------------------------- / CONTINUATION OF CONVENTIONS MENU COMMAND PARSING /----------------------------------------------------------------------- SO2CSR, ARG;SO2CER;MNTMP1 / CHECK IF USER HAS ENTERED ANYTHING KEYWRD / YES, NOW CHECK IF IT IS VALID TEXT '$';SO2DOL / AMERICAN DOLLAR SIGN REQUESTED TEXT '#';SO2PND / BRITISH POUND SIGN REQUESTED SO2CER, MXDISP;2710;X04CER;DLMX04 / C MAY BE $, OR # SO2XIT, TRNSFR;SO5RD;DLMSO5 / GO BACK AND TRY AGAIN SO2DOL, CLRBIT;4;MNFMAT / CLEAR CURRENCY BIT GOTO;SO2CEX / GO REDISPLAY MENU ENTRY SO2PND, SETBIT;4;MNFMAT / SET CURRENCY BIT SO2CEX, TRNSFR;SO5CSR;DLMSO5 / GO REDISPLAY MENU ENTRY SO2ADD, INCV / SET SWITCH TO INDICATE DIRECTORY /A112 SO2PDD, INCV / SET SWITCH TO INDICATE DICTIONARY SO2ELD, /D115 COPY;MNFNO;MNTMP2 / SAVE THE CURRENT FILE NUMBER SET;0;MNFNO / SET UP TO INDICATE "NONE" FILNAM;SO2SET;SO2FND / CHECK FOR VALID FILE NAME SO2SET, CASE;MNMUTM / NAME VALID, CHECK COMMAND TYPE 1;SO2PDF / GO HANDLE DICTIONARY FILE NAME 2;SO2ADF / GO HANDLE DIRECTORY FILE NAME COPY;MNFNO;MNLGFN / EASYCOMM LOGON FILE NUMBER GOTO;SO2MNU / GO REDISPLAY THE MENU SO2PDF, COPY;MNFNO;MNPDFN / PERSONAL DICTIONARY FILE NUMBER GOTO;SO2MNU / GO REDISPLAY THE MENU SO2ADF, COPY;MNFNO;MNADFN / AUTODIAL DIRECTORY FILE NUMBER SO2MNU, /D115 COPY;MNTMP2;MNFNO / RESTORE FILE NUMBER TRNSFR;SO5S;DLMSO5 / GO BACK TO REDISPLAY THE MENU SO2FND, /D115 COPY;MNTMP2;MNFNO / RESTORE FILE NUMBER CALL;CR1ND;DLMCR1 / ERROR "DRIVE X DOES NOT HAVE ..." TRNSFR;SO5CLR;DLMSO5 / CLEAR MESSAGE & REDISPLAY THE MENU XTRSO2=400-. IFZERO .-401&4000 / SO3 - PROMPT FOR BUFFER CONTROL AND OTHER SO STUFF RELOC ADMSO3=. X=DLMSO3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO3S, DISP; 0000; TEXT '-- !&BUFFER !&CONTROL !&MENU --' DISP; 1205 TEXT '&YES = &USE !&XOF (23 OCTAL) TO PAUSE TRANSMISSION AND' DISP; 1313; TEXT '!&XON (21 OCTAL) TO RESTART TRANSMISSION' DISP; 1505 TEXT '&NO = !&XON AND !&XOF ARE SENT AND RECEIVED AS NORMAL' DISP; 1613; TEXT 'CHARACTERS' SO3ARG, ARG; SO3RDA; MNTMP1 SO3AR2, KEYWRD TEXT 'YES '; SO3BCY TEXT 'NO '; SO3BCN CALL; CR1NM; DLMCR1 CASE; MNTMP3 1; -1-SO1RDA;DLMSO1 GOTO; SO3RDB /A021 /A021 SO3RDA, CASE; MNTMP3 / 1ST TIME THRU? /A021 0; SO3MM / IF NOT THEN RETURN TO SO MEMU. /A021 SO3RDB, SET; 0; MNTMP3 READ; MNTMP1; SO3ERR GOTO; SO3ARG SO3BCY, SET; 0; MNXONF GOTO; SO3MM SO3BCN, SET; 1; MNXONF SO3MM, SET; 1; MNTMP2 RETURN SO3GM, SET; 2; MNTMP2 / GOLD MENU RETURN TO MAIN MENU. /A021 RETURN / TELL "CU4" /A021 SO3ERR, CASE;MNSYSA /M080 EDMENU&3777; SO3GM CALL;CR1BR;DLMCR1 SET; 1; MNTMP3 /A065 TRNSFR; SO1BC; DLMSO1 /M065 / / BECAUSE OF ROOM PROBLEMS THIS PART OF THE "CC" MENU / DISPLAY IS ON THIS PAGE. / SO3CCD, IFNDEF CONDOR < DISP;0405; TEXT '&B = &B^S';SO3BRT /M018 DISP;0452; TEXT '!&BA = &B^S';SO3BRT /A018 DISP;1005; TEXT '&D = &DATA BITS' DISP;1205; TEXT '&S = &STOP BITS' DISP;1404; TEXT '!&PS = &PORT &SELECT' /M074 DISP;1604; TEXT '!&PB = &PRINTER &B^S';SO3BRT /M074 > / END IFNDEF CONDOR /A043 IFDEF CONDOR < /A043 DISP;0205;TEXT '!&PB = &PRINTER &B^S';SO3BRT DISP;0402;TEXT '&COMMUNICATIONS &PORT:' /A043 DISP;0605; TEXT '&B = &B^S';SO3BRT / DISP;1205; TEXT '&D = &DATA BITS' DISP;1405; TEXT '&S = &STOP BITS' > / END IFDEF CONDOR /A043 TRNSFR; CX3S; DLMCX3 /A021 SO3BRT, TEXT 'AUD RATE' XTRSO3=400-. IFZERO .-401&4000 RELOC ADMSO4=. X=DLMSO4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / SO4CC IS CALLED FROM WPCU4, MUST BE AT START OF BLOCK /A102 SO4CC, CALL; SOSUB1; DLMSO1 / CHECK FOR ARG & DO MENU. DISP;0;TEXT '-- !&COMMUNICATION !&SETTINGS !&MENU --' IFNDEF CONDOR < /A043 DISP;0210; TEXT '&PRIMARY &PORT (0)' /M018 DISP;0255; TEXT '&SECONDARY &PORT (1)' /A018 > /NDEF CONDOR /A043 TRNSFR; SO3CCD; DLMSO3 /THIS MENU IS CALLED BY SO WHEN MODIFING THE CX DOCUMENT TRANSFER FORMAT SO4S1, FILNAM;SO4S3;SO4ND GOTO;SO4SM2 SO4S2, FILNAM;SO4CLA;SO4ND /SECOND TIME THROUGH IF NOTHING THEN /ERASE THE DOCUMENT SO4SM2, COPY;MNFNO;MNCXP SO4SM, SET; 3; MNTMP2 SET; 1; MNTMP4 /SET TEMP4 SO SO MENU WILL BE REPAINTED /A037 RETURN SO4S, CASE;MNTMP3 1;SO4SM3 SO4S3, SET; 1; MNTMP4 / SAY THAT THE SO MENU NEEDS REFRESHING./A033 DISP;0000;TEXT '!E-- !&CX !&DOCUMENT !&NAME !&MENU --' DISP;1210 TEXT '&ENTER THE NAME OF THE DOCUMENT THAT CONTAINS THE FORMAT' DISP;1310;TEXT 'FOR !&CX TO USE WHEN TRANSFERRING A DOCUMENT, THEN' DISP;1410;TEXT '&PRESS !&RETURN' DISP;2320 TEXT '!&OR JUST &PRESS !&RETURN TO USE THE SYSTEM DEFAULT FORMAT' MXDISP;2520;X02PGM;DLMX02 / OR PRESS GOLD MENU TO RECALL THE MAIN MENU SO4RD, SET;0;MNTMP3 READ;MNTMP1;SO4ERR GOTO;SO4S2 SO4ERR, CASE;MNSYSA /M080 EDMENU&3777;SO4GM / GOLD MENU TO MAIN MENU. /M021 CALL;CR1BR;DLMCR1 GOTO;SO4S SO4SM3, SET; 1; MNTMP2 RETURN /A021 SO4GM, SET; 2; MNTMP2 / GOLD MENU RETURN TO MAIN MENU. /A021 RETURN / GO TELL "CU4". /A021 SO4ND, CALL;CR1ND;DLMCR1 DISP;2000;TEXT '!E ' / CLEAR ERROR MESSAGE FROM SCREEN /A039 GOTO;SO4S SO4CLA, SET;0;MNCXP GOTO;SO4SM XTRSO4=400-. IFZERO .-401&4000 / SO5 - SET CONVENTIONS MENU RELOC ADMSO5=. X=DLMSO5 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO5S, MXDISP; 0;X04SCM;DLMX04 / -- SET CONVENTIONS MENU -- SO5ADD, MXDISP; 214;X04ADD;DLMX04 / A = AUTODIAL DIRECTORY DOCUMENT /A112 DISP;270;TEXT '(&A ' /A112 FBREAK;MNADFN / SEPARATE THE FILE NUMBER COMPONENTS /A112 CALL;SO5CFN;DLMSO5 / GO DISPLAY FILE NUMBER OR "NONE" /A112 SO5CSR, /d120 MXDISP; 414;X04SYM;DLMX04 / C = CURRENCY SYMBOL /M112 /d120 DISP;470;TEXT '(&C $)' / DISPLAY AMERICAN DOLLAR SIGN /M112 /d120 TSTBIT;MNFMAT;MNFM2X;SO5DDN / TRANSFER IF DOLLAR SIGN /M112 /d120 DISP;-1;TEXT '^CH^CH#' / DISPLAY BRITISH POUND SIGN /M112 SO5DDN, MXDISP; 414;X04DDN;DLMX04 / D = DICTIONARY DRIVE NUMBER /M120 /M112 DISP;470;TEXT '(&D ' /M120 /M112 COPY;MNSDRV;MNTMP1 / PICK UP COPY OF MENU DRIVE SELECTION SHFBIT;10;MNTMP1 / MASK OFF DICTIONARY BITS CASE;MNTMP1;0;SO5DNO / CHECK FOR NULL DRIVE NUMBER DISP;-1;TEXT '!D)';MNTMP1 / DISPLAY THE DRIVE NUMBER GOTO;SO5ELD / CONTINUE DISPLAY SO5DNO, MXDISP;-1;X04NON;DLMX04 / DISPLAY NO DRIVE SELECTED NONE) SO5ELD, MXDISP;0614;X04ELD;DLMX04 / E = EASYCOM LOGON DOCUMENT /M120 /M112 DISP;0670;TEXT '(&E ' /M120 /M112 FBREAK;MNLGFN / SEPARATE THE FILE NUMBER COMPONENTS CALL;SO5CFN;DLMSO5 / GO DISPLAY FILE NUMBER OR "NONE" /A112 SO5FOR, MXDISP;1014;X04FOR;DLMX04 / F = DATE FORMAT /M120 /M112 DISP;1070;TEXT '(&F ' /M120 /M112 COPY;MNFMAT;MNTMP1 / PICK UP COPY OF MENU FORMAT WORD CLRBIT;7774;MNTMP1 / MASK OFF DATE FORMAT BITS CASE;MNTMP1 / CHECK WHICH FORMAT IS DESIRED 2;SO5MON / GO HANDLE MONTH-DAY-YEAR FORMAT 3;SO5YER / GO HANDLE YEAR-MONTH-DAY FORMAT / 0 AND 1 DEFAULT TO DAY-MONTH-YEAR SO5DAY, DISP;-1;TEXT '!&DMY)' / DISPLAY DAY FORMAT SELECTED GOTO;SO5MDT / CONTINUE IN LINE SO5MON, DISP;-1;TEXT '!&MDY)' / DISPLAY MONTH FORMAT SELECTED GOTO;SO5MDT / CONTINUE IN LINE SO5YER, DISP;-1;TEXT '!&YMD)' / DISPLAY YEAR FORMAT SELECTED SO5MDT, MXDISP;1214;X04MDT;DLMX04 / M = MAIN DICTIONARY TYPE /M120 /M112 DISP;1270;TEXT '(&M ' /M120 /M112 TSTBIT;MNFMAT;MNFM3X;SO5USA / IF CLEAR, THEN IT'S AMERICAN MXDISP;-1;X04BRT;DLMX04 / DISPLAY DICTIONARY TYPE BRITISH) GOTO;SO5PDD / CONTINUE DISPLAY SO5USA, MXDISP;-1;X04USA;DLMX04 / DISPLAY DICTIONARY TYPE AMERICAN) SO5PDD, MXDISP;1414;X04PDD;DLMX04 / P = PERSONAL DICTIONARY DOCUMENT/M120/M112 DISP;1470;TEXT '(&P ' /M120 /M112 FBREAK;MNPDFN / SEPARATE THE FILE NUMBER COMPONENTS CALL;SO5CFN;DLMSO5 / GO DISPLAY FILE NUMBER OR "NONE" /A112 SO5UDN, MXDISP;1614;X04UDN;DLMX04 / U = UTILITY SOFTWARE DRIVE NUMBER/M120/M112 DISP;1670;TEXT '(&U ' /M120 /M112 COPY;MNSDRV;MNTMP1 / PICK UP COPY OF MENU DRIVE SELECTION CLRBIT;7760;MNTMP1 / MASK OFF UTILITY SOFTWARE BITS CASE;MNTMP1;0;SO5UNO / CHECK FOR NULL DRIVE NUMBER DISP;-1;TEXT '!D)';MNTMP1 / DISPLAY THE DRIVE NUMBER GOTO;SO5FIN / CONTINUE DISPLAY SO5UNO, MXDISP;-1;X04NON;DLMX04 / DISPLAY NO DRIVE SELECTED NONE) SO5FIN, FBREAK;MNFNO / RESTORE FILE NAME PARAMETERS DISP;-2700;TEXT "" / CLEAR TEXT FROM BOTTOM LINE SO5RD, CLRV / CLEAR ACCUMULATOR FOR DOCUMENT TESTS SET;0;MNTMP3 READ;MNTMP1;SO5ERR ARG; SO5MM; MNTMP1 TRNSFR;SO7KEY;DLMSO7 / GO CHECK USER RESPONSE SO5NOM, CALL;CR1NM;DLMCR1 / TYPING "..." HAS NO MEANING HERE GOTO;SO5RD / GO TRY AGAIN SO5ERR, CASE;MNSYSA EDMENU&3777;SO5GM / GOLD MENU TO MAIN MENU. CALL;CR1BR;DLMCR1 / DISPLAY ERROR MESSAGE "WHEN TYPING.... SO5CLR, CALL;SOSUB2;DLMSO1 / CLEAR CR1BR ERROR MESSAGE GOTO;SO5S SO5MM, SET; 1; MNTMP2 / "RETURN" FOR REDISPLAY OF SO MENU RETURN / GO TELL "CU4" TO DO IT SO5GM, SET; 2; MNTMP2 / GOLD MENU RETURN TO MAIN MENU. RETURN / GO TELL "CU4" TO DO IT SO5CFN, CASE;MNDOCN;0;SO5NFN / CHECK FOR NULL FILE NUMBER /A112 DISP;-1;TEXT '!D.!D)';MNDRV;MNDOCN / DISPLAY FILE NUMBER /A112 RETURN / CONTINUE DISPLAY /A112 SO5NFN, MXDISP;-1;X04NON;DLMX04 / DISPLAY NO DRIVE SELECTED NONE) /A112 RETURN / CONTINUE DISPLAY /A112 XTRSO5=400-. IFZERO .-401&4000 / SO6 - PROMPT FOR TERMINAL MODE. RELOC ADMSO6=. X=DLMSO6 /INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO6S, DISP;0000;TEXT '-- !&TERMINAL !&MODE !&MENU --' IFNDEF CONDOR < /A044 DISP;0604;TEXT '52 = &SIMULATE A !&VT52^S';SO6BSM DISP;1004;TEXT '278 = &ACT AS A &D&E&CMATE !&VT278^S';SO6BSM /C044 DISP;1204;TEXT '!&SPECIAL = &ACT AS A &D&E&CWORD TERMINAL^S';SO6BSM/C044 > / END IFNDEF CONDOR /A044 IFDEF CONDOR < /A044 DISP;0414;TEXT '52^S!&VT52^S'; SO6AAA;SO6BSM /C113 DISP;0613;TEXT '100^S!&VT100^S'; SO6AAA;SO6BSM /C113 DISP;1013;TEXT '227^S!&VT220(7-BIT)^S';SO6AAA;SO6BSM /C113 DISP;1213;TEXT '22&F^S!&VT220(7-BIT &FALLBACK)^S';SO6AAA;SO6BSM /A119 DISP;1413;TEXT '228^S!&VT220(8-BIT)^S';SO6AAA;SO6BSM /A119 DISP;1606 /C113 TEXT '!&^S^CH^S!&^S&TERMINAL^S';SO6GRA;SO6AAA;SO6GRA;SO6BSM /C113 DISP;2007;TEXT '^S^S^S^S'; SO6DMT; SO6AAA; SO6DMT; SO6BSM /C113 > /DECMATE / END IFDEF CONDOR /A044 SO6ARG, ARG; SO6RDA; MNTMP1 SO6AR2, CLRV /A105 KEYWRD TEXT '52 '; SO6V52 IFNDEF CONDOR < /A044 TEXT '278 '; SO6278 TEXT 'SPECIAL ';SO6DWD > / END IFNDEF CONDOR A044 A024 IFDEF CONDOR < /A044 TEXT '100 '; SO6100 /A044 SO6GRA, TEXT 'GRAPHICS '; SO6125 /C111 TEXT 'DECMATE ';SO6DM2 / A044 M077 /A105 TEXT '227 '; SO6227 TEXT '228 '; SO6228 /A119 TEXT '22F '; SO622F /A119 > / END CONDOR /A108 CALL; CR1NM; DLMCR1 CASE; MNTMP3 1; -1-SO1RDA; DLMSO1 GOTO; SO6RDB /A021 SO6RDA, CASE; MNTMP3 / 1ST TIME THRU? /A021 0; SO6MM / IF NOT THEN RETURN TO SO MENU. /A021 SO6RDB, SET; 0; MNTMP3 READ; MNTMP1; SO6ERR GOTO; SO6ARG IFNDEF CONDOR < /A085 SO6DWD, INCV /SELECT DECWORD OPTION /A105 SO6278, INCV /A105 > /END IFNDEF CONDOR /A085 IFDEF CONDOR < /A085 SO622F, INCV / SELECT VT-220 MODE 7 BIT FALLBACK /A119 SO6228, INCV / SELECT VT-228 MODE /A108 SO6227, INCV / SELECT VT-227 MODE /A108 SO6125, INCV / SELECT VT-125 MODE /A085 /A105 SO6DM2, INCV / SELECT DECMATE-II MODE /A044 /A105 SO6100, INCV / SELECT VT-100 MODE /A044 /A105 > /END IFDEF CONDOR /A085 SO6V52, STOV; CXTMOD /A105 SO6MM, SET; 1; MNTMP2 RETURN SO6GM, SET; 2; MNTMP2 / GOLD MENU RETURN TO MAIN MENU. /A021 RETURN / TELL "CU4". /A021 SO6ERR, CASE;MNSYSA /M080 EDMENU&3777; SO6GM CALL;CR1BR;DLMCR1 SET; 1; MNTMP3 /A065 TRNSFR; SO1TM; DLMSO1 /M065 /****** COMMON STRINGS ****** SO6AAA, /A085 TEXT ' = &ACT AS A ' /C113 SO6BSM, /MODIFIED SUBSTRING TO CONTAIN MORE OF COMMON STRING /A044 TEXT ' WHEN IN !&CX BLANK SCREEN MODE.' SO6DMT, TEXT '&D&E&CMATE' /C113 /----- XTRSO6=400-. IFZERO .-401&4000 / SO7 - SET CONVENTIONS MENU CONT. RELOC ADMSO7=. X=DLMSO7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 SO7KEY, KEYWRD / CHECK USER RESPONSE TEXT 'A ';-1-SO2ADD;DLMSO2 / HANDLE AUTODIAL DIRECTORY DOCUMENT /D120 TEXT 'C ';-1-SO2CSR;DLMSO2 / HANDLE CURRENCY SYMBOL REQUEST TEXT 'D ';SO7DDN / HANDLE DICTIONARY DRIVE REQUEST TEXT 'E ';-1-SO2ELD;DLMSO2 / HANDLE EASY COMM LOGON DOCUMENT TEXT 'F ';SO7FOR / HANDLE DATE FORMAT REQUEST TEXT 'M ';SO7MDT / HANDLE DICTIONARY TYPE REQUEST TEXT 'P ';-1-SO2PDD;DLMSO2 / HANDLE PERSONAL DICTIONARY DOCUMENT TEXT 'U ';SO7UDN / HANDLE UTILITY DRIVE REQUEST SO7ERR, TRNSFR;SO5NOM;DLMSO5 / GO REPORT "TYPING ... HAS NO MEANING" SO7DDN, SET;0;SO7DDD / CLEAR THE BIT VALUE ARG;SO7DER;MNTMP1 / CHECK IF USER HAS ENTERED ANYTHING KEYWRD / YES, NOW CHECK IF IT IS VALID TEXT 'NONE ';SO7DDC / USER OPTS FOR NO DRIVE SELECTION NUMBER;SO7DDD;SO7DER / ELSE, MAKE SURE IT IS A NUMBER RANGE;SO7DDD;1;11;SO7DER / MAX DRIVE IS NINE SO7DDC, CLRBIT;7400;MNSDRV / CLEAR DICTIONARY DRIVE NUMBER SHFBIT;-10;SO7DDD / MOVE THE DRIVE NUMBER TO POSITION SETBIT SO7DDD, 0;MNSDRV / SET THE DICTIONARY DRIVE NUMBER TRNSFR;SO5DDN;DLMSO5 / GO REDISPLAY MENU ENTRY SO7DER, DISP;2710;TEXT ' &D' GOTO;SO7MAY / GO DISPLAY "MAY BE 1 TO 9, OR NONE" SO7FOR, ARG;SO7FER;MNTMP1 / CHECK IF USER HAS ENTERED ANYTHING KEYWRD / YES, NOW CHECK IF IT IS VALID TEXT 'DMY ';SO7DAY / DAY - MONTH - YEAR FORMAT REQUESTED TEXT 'MDY ';SO7MON / MONTH - DAY - YEAR FORMAT REQUESTED TEXT 'YMD ';SO7YER / YEAR - MONTH - DAY FORMAT REQUESTED TEXT 'SD ';SO7FER / DO NOT ALLOW SUBSET OF "SDC" WORD TEXT 'SDC ';SO7SDC / HANDLE SETUP FOR SDC SUBMISSION SO7FER, DISP;2710;TEXT ' &F' MXDISP;-1;X05ERD;DLMX05 / " DMY = " MXDISP;-1;X05DMY;DLMX05 / DAY/MONTH/YEAR MXDISP;-1;X05ERM;DLMX05 / ", MDY = " MXDISP;-1;X05MDY;DLMX05 / MONTH/DAY/YEAR MXDISP;-1;X05ERY;DLMX05 / ", YMD = " MXDISP;-1;X05YMD;DLMX05 / YEAR/MONTH/DAY GOTO;SO7XIT / GO BACK AND TRY IT AGAIN SO7DAY, CLRBIT;3;MNFMAT / CLEAR DATE FORMAT BITS SETBIT;1;MNFMAT / SET BIT FOR DAY - MONTH - YEAR FORMAT GOTO;SO7DXT / GO REDISPLAY MENU ENTRY SO7MON, CLRBIT;3;MNFMAT / CLEAR DATE FORMAT BITS SETBIT;2;MNFMAT / SET BIT FOR MONTH - DAY - YEAR FORMAT GOTO;SO7DXT / GO REDISPLAY MENU ENTRY SO7YER, SETBIT;3;MNFMAT / SET BITS FOR YEAR - MONTH - DAY FORMAT GOTO;SO7DXT / GO REDISPLAY MENU ENTRY SO7SDC, SET;0;MNFMAT / CLEAR FORMAT WORD FOR SDC SUBMISSION SO7DXT, TRNSFR;SO5FOR;DLMSO5 / GO REDISPLAY MENU ENTRY SO7MDT, ARG;SO7MER;MNTMP1 / CHECK IF USER HAS ENTERED ANYTHING KEYWRD / YES, NOW CHECK IF IT IS VALID SO7MTA, TEXT 'AMERICAN ';SO7USA / AMERICAN DICTIONARY REQUESTED SO7MTB, TEXT 'BRITISH ';SO7BRT / BRITISH DICTIONARY REQUESTED SO7MER, DISP;2710;TEXT ' &M &MAY BE &^S^R, OR &^S';SO7MTA;SO7MTB GOTO;SO7XIT / GO BACK AND TRY IT AGAIN SO7USA, CLRBIT;10;MNFMAT / CLEAR DICTIONARY BIT GOTO;SO7MTC / GO REDISPLAY MENU ENTRY SO7BRT, SETBIT;10;MNFMAT / SET DICTIONARY BIT SO7MTC, TRNSFR;SO5MDT;DLMSO5 / GO REDISPLAY MENU ENTRY SO7UDN, SET;0;SO7UUU / CLEAR BIT VALUE ARG;SO7UER;MNTMP1 / CHECK IF USER HAS ENTERED ANYTHING KEYWRD / YES, NOW CHECK IF IT IS VALID TEXT 'NONE ';SO7UDC / USER OPTS FOR NO DRIVE SELECTION NUMBER;SO7UUU;SO7UER / ELSE, MAKE SURE IT IS A NUMBER RANGE;SO7UUU;1;11;SO7UER / MAX DRIVE IS NINE SO7UDC, CLRBIT;17;MNSDRV / CLEAR UTILITY DRIVE NUMBER SETBIT SO7UUU, 0;MNSDRV / SET THE UTILITY DRIVE NUMBER TRNSFR;SO5UDN;DLMSO5 / GO REDISPLAY MENU ENTRY SO7UER, DISP;2710;TEXT ' &U' SO7MAY, MXDISP;-1;X04MAY;DLMX04 / MAY BE 1 TO 9, OR NONE SO7XIT, TRNSFR;SO5RD;DLMSO5 / GO BACK AND TRY AGAIN XTRSO7=400-. IFZERO .-401&4000 /CX3 SET COMMUNICATIONS SETTINGS MENU RELOC ADMCX3=. X=DLMCX3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CX3S, IFNDEF CONDOR < /A043 DISP;0605; TEXT '&P = &PARITY' DISP;0652; TEXT '!&PA = &PARITY' DISP;1052; TEXT '!&DA = &DATA BITS' DISP;1252; TEXT '!&SA = &STOP BITS' DISP;1452; TEXT '!&BT = &BREAK &TIME' /M074 > / END IFNDEF CONDOR /A043 IFDEF CONDOR < /A043 DISP;1005; TEXT '&P = &PARITY' DISP;1605; TEXT '!&BT = &BREAK &TIME' DISP;2005; TEXT '!&I = &INTEGRAL MODEM' /A102 > / END IFDEF CONDOR /A043 CX3AGN, IFDEF CONDOR < TSTBIT; MNFMAT; MNFM4X; CX3IMN / CK FOR INTEGRAL MODEM /A102 SET; CX3IEN; CX3IM / YES - SAY ENABLED /A102 GOTO; CX3IMD / SKIP /A102 CX3IMN, SET; CX3IDS; CX3IM / NO - SAY DISABLED /A102 CX3IMD, DISP; 2031; TEXT '(!&I ^S)' /A102 CX3IM, 0 /A102 > / END IFDEF CONDOR / DETERMINE THE BREAK TIME TO BE DISPLAYED. CALL; CX3BT; DLMCX3 IFNDEF CONDOR /M074 IFDEF CONDOR /A043 CX3BTY, 0 / NEXT, DETERMINE PARITY TO DISPLAY COPY; CX0PAR; MNTMP2 CALL; CX3PAR; DLMCX3 COPY; MNTMP4; CX3PT0 IFNDEF CONDOR < DISP;0625; TEXT '(&P ^S) ' > /C043 IFDEF CONDOR < DISP;1025; TEXT '(&P ^S) ' > /C043 /C099 CX3PT0, .-. / SUBSTRING POINTER IFNDEF CONDOR < / DON'T DISPLAY SECONDARY PORT PARITY /A043 COPY; CX1PAR; MNTMP2 CALL; CX3PAR; DLMCX3 COPY; MNTMP4; CX3PT1 DISP;0673; TEXT '(!&PA ^S) ' CX3PT1, .-. > / NDEF CONDOR / ON DM-II /A043 TRNSFR;CX4CNT;DLMCX4 CX3BT, CASE; CXBRTM 01; BRTM01 02; BRTM02 03; BRTM03 04; BRTM04 05; BRTM05 06; BRTM06 07; BRTM07 10; BRTM08 11; BRTM09 12; BRTM10 13; BRTM11 14; BRTM12 15; BRTM13 16; BRTM14 // 17; BRTM15 BRTM15, SET; BR15TM; CX3BTY; RETURN BRTM01, SET; BR01TM; CX3BTY; RETURN BRTM02, SET; BR02TM; CX3BTY; RETURN BRTM03, SET; BR03TM; CX3BTY; RETURN BRTM04, SET; BR04TM; CX3BTY; RETURN BRTM05, SET; BR05TM; CX3BTY; RETURN BRTM06, SET; BR06TM; CX3BTY; RETURN BRTM07, SET; BR07TM; CX3BTY; RETURN BRTM08, SET; BR08TM; CX3BTY; RETURN BRTM09, SET; BR09TM; CX3BTY; RETURN BRTM10, SET; BR10TM; CX3BTY; RETURN BRTM11, SET; BR11TM; CX3BTY; RETURN BRTM12, SET; BR12TM; CX3BTY; RETURN BRTM13, SET; BR13TM; CX3BTY; RETURN BRTM14, SET; BR14TM; CX3BTY; RETURN BR01TM, TEXT '.1' BR02TM, TEXT '.2' BR03TM, TEXT '.3' BR04TM, TEXT '.4' BR05TM, TEXT '.5' BR06TM, TEXT '.6' BR07TM, TEXT '.7' BR08TM, TEXT '.8' BR09TM, TEXT '.9' BR10TM, TEXT '1.0' BR11TM, TEXT '1.1' BR12TM, TEXT '1.2' BR13TM, TEXT '1.3' BR14TM, TEXT '1.4' BR15TM, TEXT '1.5' CX3PAR, SET; PEVEN; MNTMP4 CASE; MNTMP2 PEVNVL; CX3PR / Even parity selected. /A083 PODDVL; CX3ODD / Odd parity selected. /A083 / No parity selected. /A083 SET; PNO; MNTMP4 RETURN CX3ODD, SET; PODD; MNTMP4 CX3PR, RETURN IFDEF CONDOR /A083 IFNDEF CONDOR /A083 PEVEN, TEXT 'EVEN' PODD, TEXT 'ODD' PNO, TEXT 'NO' IFDEF CONDOR < CX3IDS, TEXT 'DISABLED' /A102 CX3IEN, TEXT ' ENABLED' /A102 > / END IFDEF CONDOR XTRCX3=400-. IFZERO .-401&4000 /MORE DISPLAY COMMUNICATIONS SETTINGS RELOC ADMCX4=. X=DLMCX4 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / NEXT, DISPLAY THE DATA BITS. CX4CNT, IFDEF CONDOR < DISP;1225;TEXT '(&D !D)'; CX0DBT > /C043 IFNDEF CONDOR < /A043 DISP;1025;TEXT '(&D !D)'; CX0DBT DISP;1073;TEXT '(!&DA !D)'; CX1DBT > /C043 / AND THEN DISPLAY STOP BITS. IFDEF CONDOR /C043 IFNDEF CONDOR < /A043 DISP;1225;TEXT '(&S !D)'; CX0SBT DISP;1273;TEXT '(!&SA !D)'; CX1SBT > /C043 / NEXT, DETERMINE THE BAUD RATE TO BE DISPLAYED. COPY; CX0BAU; MNTMP2 /M018 CALL; CX4BDR; DLMCX4 /M018 COPY; MNTMP4; CX4BD0 /M018 IFDEF CONDOR < DISP;0625;TEXT '(&B ^S) ' > /C043 /M018 IFNDEF CONDOR < DISP;0425;TEXT '(&B ^S) ' > /C043 /M018 CX4BD0, 0 /M018 IFNDEF CONDOR < /A043 COPY; CX1BAU; MNTMP2 /A018 CALL; CX4BDR; DLMCX4 /A018 COPY; MNTMP4; CX4BD1 DISP;0473;TEXT '(!&BA ^S) ' /A018 CX4BD1, 0 > /C043 / DISPLAY PRINTER BAUD RATE /A043 COPY; CXPBAU; MNTMP2 CALL; CX4BDR; DLMCX4 COPY; MNTMP4; CX4BDP IFDEF CONDOR < DISP;0235;TEXT '(!&PB ^S) ' > /C043 IFNDEF CONDOR < DISP;1633;TEXT '(!&PB ^S) ' > /M074 CX4BDP, 0 IFNDEF CONDOR < /A043 / AND FINALLY DISPLAY PORT SELECTION. CASE; CXPORT; 0; CX4CN2 SET; CX4SEC; CX4POR CX4CN2, DISP;1425;TEXT '(!&PS ^S) ' CX4POR, CX4PRI > / END IFNDEF CONDOR /C043 TRNSFR; CX5RD; DLMCX5 IFNDEF CONDOR < /A043 CX4PRI, TEXT 'PRIMARY' CX4SEC, TEXT 'SECONDARY' > / END IFNDEF CONDOR /C043 CX4BDR, SET;BD0;MNTMP4 CASE;MNTMP2 0;CX4RT 1;BAUD1 2;BAUD2 3;BAUD3 4;BAUD4 5;BAUD5 6;BAUD6 7;BAUD7 10;BAUD10 11;BAUD11 12;BAUD12 13;BAUD13 14;BAUD14 15;BAUD15 16;BAUD16 SET;BD17;MNTMP4 CX4RT, RETURN BAUD16, SET;BD16;MNTMP4 RETURN BAUD15, SET;BD15;MNTMP4 RETURN BAUD14, SET;BD14;MNTMP4 RETURN BAUD13, SET;BD13;MNTMP4 RETURN BAUD12, SET;BD12;MNTMP4 RETURN BAUD11, SET;BD11;MNTMP4 RETURN BAUD10, SET;BD10;MNTMP4 RETURN BAUD7, SET;BD7;MNTMP4 RETURN BAUD6, SET;BD6;MNTMP4 RETURN BAUD5, SET;BD5;MNTMP4 RETURN BAUD4, SET;BD4;MNTMP4 RETURN BAUD3, SET;BD3;MNTMP4 RETURN BAUD2, SET;BD2;MNTMP4 RETURN BAUD1, SET;BD1;MNTMP4 RETURN BD0, TEXT '50' BD1, TEXT '75' BD2, TEXT '110' BD3, TEXT '134.5' BD4, TEXT '150' BD5, TEXT '300' BD6, TEXT '600' BD7, TEXT '1200' BD10, TEXT '1800' BD11, TEXT '2000' BD12, TEXT '2400' BD13, TEXT '3600' BD14, TEXT '4800' BD15, TEXT '7200' BD16, TEXT '9600' BD17, TEXT '19200' /***************************************************************************** / INTEGRAL MODEM SUPPORT /A102 IFDEF CONDOR < /A102 CX4CIM, /A102 ARG; CX4SOP; MNTMP1 / IF NULL SHOW ARGS. /A102 KEYWRD /A102 TEXT 'ENABLED '; CX4ENA /A102 TEXT 'DISABLED '; CX4DIS /A102 CX4SOP, DISP; 2617; TEXT '!&I MAY BE ^S OR ^S' /A102 CX4IEN /A102 CX4IDS /A102 TRNSFR; CX5RD; DLMCX5 / GO BACK AND READ AGAIN /A102 CX4ENA, SETBIT; MNFM4X; MNFMAT / ENABLE FUNCTION /A102 GOTO; CX4IMC / /A102 CX4DIS, CLRBIT; MNFM4X; MNFMAT / DISABLE FUNCTION /A102 CX4IMC, TRNSFR; CX3AGN; DLMCX3 / DISP "CC" MENU /A102 CX4IEN, TEXT 'ENABLED' /A102 CX4IDS, TEXT 'DISABLED' /A102 > / END IFDEF CONDOR /A102 XTRCX4=400-. IFZERO .-401&4000 / INPUT PROCESSING FOR COMMUNICATIONS SETTINGS MENU RELOC FIELD 4 *0 ADMCX5=. X=DLMCX5 /INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CX5RD, READ;MNTMP1;CX5RDE DISP;2500;TEXT '!E' CX5CNT, ARG;CX5RET;MNTMP1 KEYWRD /REARRANGED ORDER /A043 TEXT 'P '; CX5P TEXT 'D '; CX5D TEXT 'S '; CX5S TEXT 'B '; -1-CX7B; DLMCX7 TEXT 'I '; -1-CX4CIM; DLMCX4 /A102 TEXT 'BT ';-1-CX6BT; DLMCX6 /A018 IFDEF CONDOR < /A105 TEXT 'PB '; CX5PB /A105 TEXT 'DP2 ';CX5PB /A105 > /END CONDOR /A105 IFNDEF CONDOR < /A043 TEXT 'PB '; -1-CX7PR; DLMCX7 /A018 TEXT 'DP2 ';-1-CX7PR; DLMCX7 TEXT 'PA ';CX5PA /A018 TEXT 'DA ';CX5DA /A018 TEXT 'SA ';CX5SA /A018 TEXT 'BA ';-1-CX7BA;DLMCX7 /A018 TEXT 'PS ';-1-CX6PS;DLMCX6 /A018 > /NDEF CONDOR /A043 CALL; CR1NM; DLMCR1 GOTO; CX5RD CX5RET, SET; 1; MNTMP2 /SO MENU RETURN RETURN IFDEF CONDOR < /A105 CX5PB, /CHANGE PB UNLESS NOT DMII /A105 TSTBIT; MNOPTN; MNRX9X+MNRXAX; -1-CX7PR; DLMCX7 /A105 DISP; 2617 /A105 TEXT '&YOU CANNOT CHANGE THE &PRINTER &BAUD RATE.' /A105 GOTO; CX5RD /A105 > / END CONDOR /A105 CX5P, IFNDEF CONDOR < /A105 SET; CX0PAR; CX5PAR /M018 SET; CX5AA; CX5TYP GOTO; CX5PB /A018 CX5PA, SET; CX1PAR; CX5PAR /A018 SET; CX5BB; CX5TYP CX5PB, > / END NDEF CONDOR /A105 ARG; CX5PER; MNTMP1 SET; PNOVAL; MNTMP2 /A105 KEYWRD TEXT 'ODD '; CX5POD TEXT 'EVEN '; CX5PEV TEXT 'NO '; CX5PC /A105 CX5PER, DISP;2617;TEXT '&P^A MAY BE &EVEN, &ODD, OR &NO.' /C067 CX5TYP, CX5AA /MAY CHANGE IFF DMI /A105 GOTO;CX5RD CX5POD, SET; PODDVL; MNTMP2 /M083 GOTO; CX5PC CX5PEV, SET; PEVNVL; MNTMP2 /M083 CX5PC, COPY; MNTMP2 CX5PAR, CX0PAR /MAY CHANGE IFF DMI /A105 CX5CX3, TRNSFR;CX3AGN;DLMCX3 CX5D, IFNDEF CONDOR < /A105 SET; CX0DBT; CX5DBT SET; CX5AA; CX5TYD GOTO; CX5DB CX5DA, SET; CX1DBT; CX5DBT SET; CX5BB; CX5TYD CX5DB, > / END NDEF CONDOR /A105 ARG;CX5DER;MNTMP1 NUMBER;MNTMP4;CX5DER RANGE;MNTMP4;5;10;CX5DER COPY;MNTMP4 CX5DBT, CX0DBT /MAY CHANGE IFF DMI /A105 GOTO; CX5CX3 CX5DER, DISP;2617;TEXT '&D^A MUST BE A NUMBER FROM 5 TO 8.' /C067 CX5TYD, CX5AA /MAY CHANGE IFF DMI /A105 GOTO;CX5RD CX5S, IFNDEF CONDOR < /A105 SET; CX0SBT; CX5SBT SET; CX5AA; CX5TYS GOTO; CX5SB CX5SA, SET; CX1SBT; CX5SBT SET; CX5BB; CX5TYS CX5SB, > /A105 ARG; CX5SER; MNTMP1 NUMBER;MNTMP4;CX5SER RANGE; MNTMP4; 1;2; CX5SER COPY; MNTMP4 CX5SBT, CX0SBT /MAY CHANGE IFF DMI /A105 GOTO; CX5CX3 CX5SER, DISP;2617;TEXT '&S^A MAY BE 1 OR 2.' /C067 CX5TYS, CX5AA /MAY CHANGE IFF DMI /A105 GOTO; CX5RD CX5RDE, CASE; MNSYSA /M080 EDMENU&3777; CX5GM /GOLD MENU PRESSED CALL; CR1BR; DLMCR1 TRNSFR; SO1CC; DLMSO1 /M065 CX5GM, SET; 2; MNTMP2 /GOLD MENU EXIT RETURN CX5BB, "A&177 CX5AA, 0 XTRCX5=400-. / INPUT PROCESSING FOR COMMUNICATIONS SETTINGS MENU RELOC ADMCX6=. X=DLMCX6 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CX6PS, ARG; CX6PER; MNTMP1 KEYWRD TEXT 'PRIMARY '; CX6P0 TEXT 'SECONDARY'; CX6P1 TEXT '0 '; CX6P0 TEXT '1 '; CX6P1 CX6PER, DISP;2717 / REPORT ERROR. TEXT '!&PS MUST BE FOLLOWED BY &PRIMARY, &SECONDARY, 0 OR 1.' TRNSFR; CX5RD; DLMCX5 CX6P0, SET; 0; CXPORT GOTO; CX6CX3 CX6P1, SET; 1; CXPORT CX6CX3, TRNSFR; CX3AGN; DLMCX3 CX6BT, ARG;CX6BER;MNTMP1 KEYWRD TEXT '.'; CX6OK1 TEXT '1 '; CX6OK2 GOTO;CX6BER CX6OK1, ARG; CX6BER; MNTMP1 CALL; CX6SU1; DLMCX6 GOTO; CX6CX3 CX6OK2, ARG; CX6BER; MNTMP1 / '1' ENTERED. '.' MUST FOLLOW. KEYWRD; TEXT '.'; CX6OK3 / CHECK FOR '.' GOTO; CX6BER / ERROR IF NOT '1.' CX6OK3, ARG; CX6BER; MNTMP1 / ERROR IF NOT '1.' SOMETHING. CALL; CX6SU2; DLMCX6 GOTO; CX6CX3 CX6SU1, CLRV / CLEAR THE ACCUMULATOR KEYWRD TEXT '1 '; BTIM01 TEXT '2 '; BTIM02 TEXT '3 '; BTIM03 TEXT '4 '; BTIM04 TEXT '5 '; BTIM05 TEXT '6 '; BTIM06 TEXT '7 '; BTIM07 TEXT '8 '; BTIM08 TEXT '9 '; BTIM09 GOTO; CX6BER CX6SU2, CLRV / CLEAR THE ACCUMULATOR KEYWRD TEXT '0 '; BTIM10 TEXT '1 '; BTIM11 TEXT '2 '; BTIM12 TEXT '3 '; BTIM13 TEXT '4 '; BTIM14 TEXT '5 '; BTIM15 CX6BER, DISP;2516; TEXT '!&BT MAY BE .1, .2, .3, .4, .5, .6, .7, .8,' /C067 DISP;2623; TEXT '.9, 1.0, 1.1, 1.2, 1.3, 1.4, OR 1.5' /C067 TRNSFR; CX5RD; DLMCX5 BTIM15, INCV / SET TO 17 BTIM14, INCV / SET TO 16 BTIM13, INCV / SET TO 15 BTIM12, INCV / SET TO 14 BTIM11, INCV / SET TO 13 BTIM10, INCV / SET TO 12 BTIM09, INCV / SET TO 11 BTIM08, INCV / SET TO 10 BTIM07, INCV / SET TO 07 BTIM06, INCV / SET TO 06 BTIM05, INCV / SET TO 05 BTIM04, INCV / SET TO 04 BTIM03, INCV / SET TO 03 BTIM02, INCV / SET TO 02 BTIM01, INCV / SET TO 01 STOV; CXBRTM; RETURN XTRCX6=400-. IFZERO .-401&4000 / THE LAST BLOCK OF THE COMMUNICATIONS SETTINGS MENU RELOC ADMCX7=. X=DLMCX7 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 CX7B, SET; CX0BAU; CX7BAU SET; CX7BB; CX7TYP GOTO; CX7C IFNDEF CONDOR < /A105 CX7BA, SET; CX1BAU; CX7BAU SET; CX7BBA; CX7TYP GOTO; CX7C > /END NCONDOR /A105 CX7PR, SET; CXPBAU; CX7BAU SET; CX7BBP; CX7TYP CX7C, ARG;CX7BER;MNTMP1 CLRV /INIT BAUD RATE INDEX TO 0 /A105 KEYWRD TEXT '300 ';B7D5 TEXT '1200 ';B7D7 TEXT '2400 ';B7D12 TEXT '4800 ';B7D14 TEXT '9600 ';B7D16 IFDEF CONDOR < /DONE IF NOT DMII /A105 TSTBIT; MNOPTN; MNRX8X; CX7T3E / /A105 KEYWRD /KEEP TESTING IF DMII /A105 > /END CONDOR /A105 TEXT '50 ';B7D0 TEXT '75 ';B7D1 TEXT '110 ';B7D2 TEXT '134 ';B7D3 TEXT '150 ';B7D4 TEXT '600 ';B7D6 TEXT '1800 ';B7D10 TEXT '2000 ';B7D11 TEXT '3600 ';B7D13 TEXT '7200 ';B7D15 TEXT '19200 ';B7D17 CX7BER, IFDEF CONDOR < /A105 TSTBIT; MNOPTN; MNRX8X; CX7T3E > /JUST IN CASE NULL INPUT /A105 DISP;2510;TEXT '^A MAY BE 50, 75, 110, 134.5, 150, 300, 600, 1200, 1800,' /C067 CX7TYP, XX /CHANGED TO POINT TO STRING CONTAINING TYPE DISP;2615;TEXT '2000, 2400, 3600, 4800, 7200, 9600 OR 19200.' /C067 IFDEF CONDOR < / /A105 GOTO; CX7TEX / /A105 CX7T3E, /DISPLAY IV,III ALLOWED BAUD RATES /A105 DISP; 2510 / /A105 TEXT '&B MAY BE 300, 1200, 2400, 4800 OR 9600.'/ /A105 CX7TEX, > /END CONDOR /A105 TRNSFR; CX5RD; DLMCX5 /ERRONEOUS INPUT /A105 B7D17, INCV /increment baud rate index /A105 B7D16, INCV /A105 B7D15, INCV /A105 B7D14, INCV /A105 B7D13, INCV /A105 B7D12, INCV /A105 B7D11, INCV /A105 B7D10, INCV /A105 B7D7, INCV /A105 B7D6, INCV /A105 B7D5, INCV /A105 B7D4, INCV /A105 B7D3, INCV /A105 B7D2, INCV /A105 B7D1, INCV /A105 B7D0, /A105 STOV /STORE COUNT /A105 CX7BAU, 0 /into previously set var. /A105 TRNSFR; CX3AGN; DLMCX3 CX7BB, "B&177;0 IFNDEF CONDOR < CX7BBA, "B&177; "A&177; 0 > /A105 CX7BBP, "P&177; "B&177; 0 XTRCX7=400-. RELOC ADMRLR=. X=DLMRLR / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /THIS MENU IS CALLED FROM WITHIN CX-MAGCRD / / WHEN CALLED - / MNTMP1 = 1; DISPLAY THE MESSAGE FOR A DOCUMENT TO BE SENT / MNTMP1 .GE. 2; DISPLAY THE DOCUMENT TO BE RECEIVED MESSAGE. WHEN / THIS VALUE IS .GT. 80, THIS WILL BE THE COLUMN THAT THE / RIGHT MARGINS IN. DISP;00;TEXT '!E ' CASE; MNTMP1 1; RLRRCV / MESSAGE THAT GOES WITH SENDING A DOCUMENT DISP; 1305 ; TEXT '&THE OPERATOR RECEIVING THIS DOCUMENT NEEDS TO KNOW ' DISP; -1; TEXT 'THE POSITIONS OF' GOTO; RLRCOM / MESSAGE FOR A DOCUMENT TO BE RECEIVED RLRRCV, DISP; 1305; TEXT '&PLEASE SET THE RULER FOR THE DOCUMENT YOU WILL ' DISP; -1; TEXT 'RECEIVE. &MARK ' / COMMON DISPLAY RLRCOM, DISP; 1405; TEXT 'THE LEFT AND RIGHT MARGINS AND ANY TABS. ' DISP; 1605; TEXT '&WHEN YOU ARE READY TO CONTINUE, PRESS !&RETURN.' RANGE; MNTMP1; 0; 120; RLRRMR /IF THE RIGHT MARGIN IS BEYOND /COLUMN 80, SAY SO. GOTO; RLRBOT RLRRMR, DISP; 2105; TEXT '&THE RIGHT MARGIN IS AT COLUMN !D'; MNTMP1 RLRBOT, DISP;2511;TEXT '1^S2^S3^S4^S5^S6^S7';RLRSP;RLRSP;RLRSP;RLRSP;RLRSP RLRSP DISP;-1;TEXT '^S8';RLRSP DISP;2600;TEXT '^S^S^S^S^S^S';RLR0;RLR0;RLR0;RLR0;RLR0;RLR0 DISP;-1;TEXT '^S^S';RLR0;RLR0 DISP;2700;TEXT '' RETURN RLRSP, TEXT ' ' RLR0, TEXT '....:....0' XTRRLR=400-. IFZERO .-401&4000 RELOC ADMMGS=. X=DLMMGS / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / MAG CARD DOCUMENT TRANSMISSION OPTION MENUS / - SEND A DOCUMENT / / WHEN DONE - / MNTMP1 RETURNED VALUE / 2 - GOLD-M TYPED / 1 - SEND ONLY INDEX CARRIAGE RETURNS OVER THE LINE / 0 - SEND CARRIAGE RETURNS AS IS (HARD AND SOFT) / DISP; 00; TEXT '!E ' DISP; 1005; TEXT '&WHAT TYPE OF CARRIAGE RETURNS WOULD YOU LIKE IN THE ' DISP; -1; TEXT 'DOCUMENT BEING SENT?' DISP; 1310; TEXT '&I = &END ALL LINES WITH INDEX CARRIAGE RETURNS' DISP; 1510; TEXT '&N = &END ALL LINES WITH CARRIAGE RETURNS LIKE THOSE ' DISP; -1; TEXT 'IN THE DOCUMENT' MXDISP;2120;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN MXDISP;2320;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU MGSRD, READ; MNTMP1; MGSERR ARG; MGSRD; MNTMP1 SET; 0; MNTMP1 KEYWRD TEXT 'I '; MGSNOR TEXT 'N '; MGSRTN CALL; CR1NM; DLMCR1 GOTO; MGSRD MGSNOR, SET; 1; MNTMP1 MGSRTN, RETURN MGSERR, CASE;MNSYSA /M080 EDMENU&3777; MGSMM DISP; 2700; TEXT '^A'; MGSBEL GOTO; MGSRD MGSMM, SET; 2; MNTMP1 RETURN MGSBEL, BELL; 0 XTRMGS=400-. IFZERO .-401&4000 RELOC ADMMGR=. X=DLMMGR / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / MAG CARD DOCUMENT TRANSMISSION OPTION MENUS / - RECEIVE AQ DOCUMENT / / WHEN DONE - / MNTMP1 RETURNED VALUE / 2 - GOLD-M TYPED / 1 - TRANSFORM CARRIAGE RETURNS TO HARD AND SOFT CARRIAGE RETURNS / 0 - RECORD THE DOCUMENT VERBATIM / DISP; 00; TEXT '!E ' DISP; 1005; TEXT '&HOW WOULD YOU LIKE TO RECORD THE DOCUMENT BEING ' DISP; -1; TEXT 'RECEIVED?' DISP; 1310; TEXT '&A = &ALTER CARRIAGE RETURNS TO MAKE THE DOCUMENT ' DISP; -1; TEXT 'EASIER TO EDIT' DISP; 1510; TEXT '&R = &RECORD CARRIAGE RETURNS AS RECEIVED' MXDISP;2120;X03TLR;DLMX03 / TYPE THE LETTER AND PRESS RETURN MXDISP;2320;X03GMM;DLMX03 / OR PRESS GOLD MENU TO RECALL THE MENU MGRRD, READ; MNTMP1; MGRERR ARG; MGRRD; MNTMP1 SET; 0; MNTMP1 KEYWRD TEXT 'A '; MGRALT TEXT 'R '; MGRRTN CALL; CR1NM; DLMCR1 GOTO; MGRRD MGRALT, SET; 1; MNTMP1 MGRRTN, RETURN MGRERR, CASE;MNSYSA /M080 EDMENU&3777; MGRMM DISP; 2700; TEXT '^A'; MGRBEL GOTO; MGRRD MGRMM, SET; 2; MNTMP1 RETURN MGRBEL, BELL; 0 /ERROR MESSAGE FROM CX1 MENU - HERE TO MAKE ROOM. /M119 MGRNOH, SET;MGRMES;MGRTXT / ERROR MESSAGE - CANT BOTH READ AND WRITE MGRONE, DISP; 0000; TEXT '!E!P^S' 2205 MGRTXT, MGRMS2 TRNSFR; CX1RT; DLMCX1 MGRMES, TEXT '&ONE OPTION MUST INCLUDE THE HOST.' MGRMS2, TEXT '&CANNOT BOTH SEND AND RECEIVE A DOCUMENT SIMULTANEOUSLY.' /A105 XTRMGR=400-. IFZERO .-401&4000 / ------------------------- / |ONE BLOCK OF SORT MENUS| ------ C A U T I O N ------ /A004 / ------------------------- RELOC /A004 ADMSR1=. X=DLMSR1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A004 /-----------------------------------------------------------------------/a050 / sort allows the user the option of REMOVING THE SYSTEM DISKETTE /a050 / therefore this is the only block of sort menu because... /a050 / /a050 / ...IT IS ILLEGAL TO "CALL" OR "TRNSFR" OUT OF THIS BLOCK... /a050 / (because the SYSTEM DISKETTE might no longer be in DRIVE 0) /a050 /-----------------------------------------------------------------------/a050 / /a050 SR1S, / ................................................. / enter here from WPSTPR with AC determining action /A004 / ................................................. / / "MNTMP4" - how to ENTER (PROCESS) menu: /A004 / / 0 = READ RESPONSE TO SPEC, LIST AND RESULT PROMPTS /A004 / 1 = PROCESS RESPONSE TO "TAO" PROMPT /A004 / 2 = PROCESS RESPONSE TO "GO" PROMPT /A004 / / "MNTMP3" - how to EXIT menu: /A004 / / 0 "GOLD" KEY /A004 / 1 NOT GOLD KEY /A004 / -1 NON-EXTISTENT DOC OR INVALID RESPONSE TO "TOA" OR "GO" PROMPTS /A004 / / "MNTMP1" - CONTAINS THE USER INPUT: /A004 / / - TOKEN IS EITHER DRIVE AND DOC NUMBER WITH DOC PROMPTS, /A004 / - (MNTMP1 token not applicable for "GO" prompt), /A004 / - OR WITH "TOA" PROMPT: "TOP" = 0 /A004 / "BOT" = 1 /A004 / "OVERWRITE" = 3 /A004 / SET; 1; MNTMP3 / default to (O.K.) "not gold key exit" /A004 / / read and store user input in "MNTMP1" /A004 / SR1RD, READ; MNTMP1; SR1RE / GOTO "SR1RE" IF INPUT IS "GOLD" KEY /A004 CASE; MNTMP4 / test "TYPE OF PROCESS" flag /A004 1; SR1AR / if (MNTMP4)=1 process test for "TAO" /A004 2; SR1AR / if (MNTMP4)=2 process test for "GO" / / fall through case (0) to read user input in response /A004 / to "specification", "list" and "result" prompts /A004 / / goto "SR1RD" when there was no input string typed in (read again), /a004 / goto "SR1ND" when string is not a name of an existing file /A004 / FILNAM; SR1RD; SR1ND / process user response for a FILE NAME /A004 SR1RT, RETURN / O.K. EXIT "ADMSR1" / ........................................ / came here because "GOLD" key was pressed / ........................................ / SR1RE, SET; 0; MNTMP3 / RETURN / ERROR EXIT / / ..................................................... / came here because the document name typed by the user / is not the name of an existing file / ..................................................... / SR1ND, SET; -1; MNTMP3 / SET TO -1 /A004 RETURN / ERROR EXIT /A004 / / .......................... / came here to process "TBO" /M058 / .......................... / / goto "SR1RD" if no input (token) from user, or / save the input within "MNTMP1" and test for "T", "B", "O" /M058 / SR1AR, ARG; SR1RD; MNTMP1 / read user input (save in mntmp1) /A004 CASE; MNTMP4 / TEST PROCESS FLAG 2; SR1GO / process user response to "GO" prompt /A004 / / fall thru cause mntmp4=0 to process user response to "TBO" prompt /M058 / KEYWRD / user input should be "T", "B", "O" /M058 TEXT 'T '; SR1TOP / user typed "T" (for TOP) /A004 TEXT 'B '; SR1BOT / user typed "B" (for BOTTOM) /M058 TEXT 'O '; SR1OVR / user typed "O" (for OVERWRITE) /A004 GOTO; SR1ND / ERROR - user typed none of the above /A004 / ................................................................. / came here while processing "TBO" because user typed "T" (for TOP) /M058 / ................................................................. SR1TOP, SET; 0; MNTMP1 / /A004 RETURN / EXIT /A004 / ................................................................. / came here while processing "TBO" because user typed "B" (for BOTTOM) /M058 / ................................................................. SR1BOT, SET; 1; MNTMP1 / /A004 RETURN / EXIT /A004 / ....................................................................... / came here while processing "TBO" because user typed "O" (for OVERWRITE)M058 / ....................................................................... SR1OVR, SET; 3; MNTMP1 / RETURN / EXIT / ................................................. / came here to process user response to "GO" prompt / ................................................. SR1GO, KEYWRD / TEXT 'GO '; SR1OK / GOTO; SR1ND / error - user didn't type "GO" /A004 SR1OK, RETURN / o.k. exit (user typed "GO") / ................................................ / came here to process a test of the printer queue / ................................................ XTRSR1=400-. IFZERO .-401&4000 /A004 RELOC ADMSR2=. / X=DLMSR2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A004 /SORT MENUS /A004 XTRSR2=400-. IFZERO .-401&4000 /A004 /GLOBAL SEARCH AND REPLACE MENU PHA 5-MAY-81 /A006 RELOC /A006 ADMGS1=. X=DLMGS1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 /A006 GS1, CALL;GS999;DLMGS1 /DISPLAY MENU HEADER /A006 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / TMP2=0 NO PREVIOUS GS HAS BEEN PERFORMED, /A006 / PROMPT FOR INITIAL SEARCH STRING. /A006 / TMP2=1 ENTER FOR SEARCH PROMPT WHERE A PREVIOUS /A006 / GS HAS BEEN PERFORMED. /A006 / TMP2=2 ENTER TO PROMPT FOR A REPLACEMENT STRING. /A006 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - CASE;MNTMP2 /A006 1;-1-GS100;DLMGS3 /A006 2;-1-GS20;DLMGS2 /A006 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / If TMP2 = 0. No previous GS performed by user. / / Display Message, return to get argument. /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GS10, DISP;1605;TEXT '&TYPE THE WORD OR PHRASE TO BE !&SEARCHED, ' DISP;-1;TEXT 'THEN PRESS !&ADVANCE' DISP;2005;TEXT '!&OR JUST &PRESS !&ADVANCE TO RESUME EDITING' DISP;2205;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &EDITOR &MENU.' DISP;-2700;TEXT'' SET;2;MNTMP2 /Set Return Address RETURN /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / Display Major Header in GS. /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GS999, DISP;0;TEXT '!E-- !&GLOBAL !&SEARCH !&MENU --' /A006 RETURN /A006 IFZERO .-401&4000 /A006 /GLOBAL SEARCH AND REPLACE MENU CONTINUED RELOC /A006 ADMGS2=. /A006 RELOC 0 /A006 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - / If TMP2 = 1. If there is a previous GS call by user. /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GS20, CALL;GS999;DLMGS1 /DISPLAY MENU HEADER /A006 GS25, DISP;1405;TEXT '&TYPE THE !&REPLACEMENT WORD OR PHRASE, ' DISP;-1;TEXT 'THEN PRESS !&ADVANCE,' /M008 DISP;1605;TEXT '!&OR JUST &PRESS !&ADVANCE TO REMOVE (DELETE) THE ' DISP;-1;TEXT 'SEARCHED PHRASE IN TEXT,' /A006 DISP;2005;TEXT '!&OR &PRESS THE !&PASTE KEY TO USE THE CURRENT ' DISP;-1;TEXT 'CONTENTS' /A006 DISP;2110;TEXT 'OF THE PASTE AREA AS THE REPLACEMENT PHRASE,' /M013 DISP;2305 TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &EDITOR &MENU.' DISP;-2700;TEXT'' GS30, SET;1;MNTMP2 /SET UP FOR RE-ENTER NEXT TIME AROUND /A006 RETURN /RETURN TO THE EDITOR TO START THE GLOBAL SEARCH/A006 IFZERO .-401&4000 /A006 /GLOBAL SEARCH AND REPLACE MENU CONTINUED RELOC ADMGS3=. /A006 RELOC 0 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /THE FOLLOWING CODE IS EXECUTED IF THERE HAS BEEN A PREVIOUS /A006 /GS OPERATION BY THE USER..... /A006 /- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - GS100, CALL;GS999;DLMGS1 /DISPLAY MENU HEADER /A006 DISP;1405;TEXT '&TYPE THE WORD OR PHRASE TO BE !&SEARCHED, THEN PRESS !&ADVANCE' DISP;1605;TEXT 'OR JUST PRESS !&ADVANCE TO CONTINUE THE PREVIOUS ' DISP;-1;TEXT 'SEARCH' /D110 TO THE END OF THE DOCUMENT' /A006 DISP;2005;TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE EDITOR MENU.'/A006 DISP;-2700;TEXT'' SET;2;MNTMP2 /ELSE,SET FLAG TO REQUEST REPLACEMENT STRING. /A006 RETURN /RETURN TO EDITOR TO SAVE SEARCH STRING. /A006 IFZERO .-401&4000 /A006 RELOC XXXXXX, /END OF MENUES   / WPCX - CHARACTER-ORIENTED COMMUNICATION PROGRAM / / / 059 EMcD 4-Sep-85 8 bit to 7 bit NRC conversion / support / 058 MART 09-JUL-85 RESTART ON RETURN FROM GRAPHICS / 057 EMcD 27-Jun-85 Stop CX with Printer while / Print Screen going / 051-056 EMcD 02-Apr-85 Patches for 8 bit and hole blaster / 050 EMCD 28-FEB-85 Add DECDEV switch / 049 DFB 29-NOV-84 Fix DS, DH, DP problems when Gold Halt / 048 ECH 30-AUG-84 ALLOW GOLD HALT TEST IN HP AND DP MODES / MOVED KBTICH AND KBTOCH TO WPCOM / 047 ECH 17-AUG-84 CHANGES BECAUSE OF MOVING DSKGCH FROM / WPCOM PHICS / 045 DFB 20-APR-84 FIX TO LOAD PAGE 0 PRTFLD VT125 MODE / 044 DFB 27-MAR-84 CHANGE GRAPHICS TO LOAD EVERY TIME / 043 WJY 17-FEB-84 IMPLEMENT DMIIV1.5 FUNCTIONALITY ON DMI / 042 SBB 20-JAN-84 STOP CRASH IN VT52 HD DOC ALMOST FULL / 041 SBB 26-SEP-83 CHANGES FOR VT125 EMULATION / 040 HLP 13-SEP-83 DELETE PRLOCK SINCE DECMATE / IS SINGLE USER / 039 GDH 20-JUL-83 CHANCE DECMATE / IS SINGLE USER / 039 GDH 20-JUL-83 CHANGES TO ACCOMODATE LOGON ENTRY TO / NOT CLEAR SCREEN WHEN ENTRING. / 038 HLP 10-JUN-83 CHANGE PRINTER PAGE SIZE FROM CT TO / SIZE OF LAST DOCUMENT PRINTED / 037 DFB 31-MAY-83 FIX TO HALT WHEN CX TD / 036 GDH 18-MAY-83 MOVED LARGE BUFFER TO FIELD 6. / 035 GDH 14-APR-83 ALTER RETURN TO MAIN MENU CODE TO / CALL COMM CLEANUP CODE. / 034 GDH 1-APR-83 FIX SO THAT HD REMEMBERS DOC NAME. / 033 HLP 25-FEB-83 PRASF NOW PART OF LPONLN / IN PRINTER FIELD / 032 GDH 10-JAN-83 SET TERMINAL TO NUMERIC KEYPAD & CURSOR / TO CURSOR MODE ON START UP. / 031 HLP 16-DEC-82 REMOVE JSTRT ON PRJOB WHEN EXIT CX / 030 HLP 02-DEC-82 FIX NO SHEETS FED TO LQPSE BUG #273 / 029 GJP 15-OCT-82 FIX WPCRE BUG / 028 SBB 15-OCT-82 CORRECTLY INITIALIZE TERMINAL MODES / 027 HLP 14-OCT-82 REWORKED HANDLING OF PRSTTS AND PRLOCK / ON ENTERING AND LEAVING BLANK SCREEN / (THIS FIXED DM-II BUG #152) / DELETED REFERENCES TO USERNO / 026 MJS 07-OCT-82 MOVED THE CALL TO "DLMCX2" TO "CONFG2" / (THIS MENU CALL WILL BE EXECUTED BEFORE / THE "AC7777; HS2OU" WHICH DOES AN "XON") / THEREFORE THE "XON" WILL BE ISSUED / AFTER THE USER SELECTS OPTIONS / 025 HLP 01-OCT-82 DO DCA PRSTTS ONLY IF "BUSY" / 024 HLP 29-SEP-82 RESET PRLOCK WHEN EXIT CX / 023 HLP 23-SEP-82 DELETED DCA PRSTTS SO PRINTER ERRORS / WILL NOT BE ERASED WHEN RETURN TO MENU / 022 HLP 09-SEP-82 CONDOR CONDITIONALIZED EDIT 021 / 021 HLP 03-SEP-82 FURTHER TERMINAL MODE CHANGES / 0020 HLP 29-JUL-82 APPARENT BUG AT CONFG2 FIXED / ELIMINATE EXTRA DEFINITIONS OF IO CALLS / 0019 GJP 16-JUN-82 DURING CX, USER CHOSE GOLD MENU, HUNG / SYSTEM BUG FIXED. / 0018 GDH 25-MAR-82 ALLOW CX TO RUN W/O HARDWARE BUT MAKE / SURE HARDWARE IS PRESENT FOR HOST. / 0017 GDH 15-MAR-82 FIXED CONDITIONAL FOR WPMAG. / 0016 GDH 08-MAR-82 CLEAR DOC TRANSFER "WAIT" FLAG. / 0015 GDH 24-DEC-81 RETRIEVE CXTMOD INTO VTMODE ON STARTUP. / 0014 GDH 17-NOV-81 DETECT NON-EXISTENT PRINTER FOR XP. / 0013 GDH 19-OCT-81 MERGED SOME BUG FIXES FROM THE WS200 / SYSTEM (V4.4). / 0012 GDH 18-OCT-81 REMOVED WS102 CONDITIONALS. / 0011 GDH 17-OCT-81 ADDED TM OPTION SUPPORT FOR DWORD. / ALSO BUG FIX FOR USER ESC SEQS. / 0010 GDH 13-OCT-81 DE-IMPLEMENTED LOCK/UNLOCK. / 0007 GDH 5-OCT-81 AUTO PAGINATION FOR ASF PRINTERS. / 0006 GDH 23-SEP-81 ELIMINATED PAGE ZERO CIF/CDF STUFF. / 0005 GDH 26-AUG-81 WPFILS CALLING SEQ CHANGES. / 0004 GDH 21-AUG-81 REMOVED SUPERFLUOUS CONDITIONALS. / ADDED VT52 EMULATION. / 0003 JM 17-JUN-81 ADDED WS80 TERMINAL MODE / 0002 JM 02-JUN-81 RESTORE TERMINAL ATTRIBUTES AFTER / GOLD MENU (FOR WS80 AND VT278) / AND SET TERMINAL TO VT100 MODE AFTER / \R (FOR WS80) / 0001 JM 12-MAY-81 CHANGES TO ALLOW COM TO WS80 / SERIAL LQP / / 3.0 MB 8-AUG-78 ADD FORMATABLE SEND DOCUMENT FEATURE / QA3.4 KEE 13-APR-78 FIX CX BUG WHEN DISKETTE OVERFLOWS / III.C KEE 27-FEB-78 REMOVE COMM SETTINGS STUFF AND FIX SO / THAT MAGCRD HAS SEPARATE BINARIES / FROM CX / III.3 KEE 3/7/78 CHANGE TRANSFER LOCATION FOR MAGCRD / 2.7-3 KEE 1/14/78 FIXES FOR MAG CRD INSTALATION / 2.7-2 KEE 1/5/78 MOVE CLEAR SCREEN AFTER OPTIONS / SPECIFIED / 2.5.1 KEE 11/9/77 FIX BUG IN \R PROCESSING WHEN ONLY / AN INPUT FILE AND NO OUTPUT FILE / IS SPECIFIED. / 2.5.1 KEE 11/7/77 PUT IN DISK OVERFLOW TESTS / 2.4B KEE 10/10/77 CLEAN UP CODE / 2.P-5 RLT 9/23/77 FIX FOR WT ASM / 2.P-4 KEE 9/21/77 PUT CX MENU DISPLAYS INTO 'MN' / 2.K-1 RLT 8/31/77 CHANGE PAGINATION TO ASSEMBLE FOR WS78 / 2.J KEE ADD 4-FLOPPY SPECIFICATIONS / 2.G-1 MB GET IT FROM THE 78 PACK 8/8/77 /WTXBAR - WRITES OUT XBAR *200 JMP I .+3 JMP I .+1 7605 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOCX1 100 IFNDEF DECDEV < CDF 20 /M050 > IFDEF DECDEV < CDF 30 /A050 > -DSOCX1 /WRITE OUT NORMAL CX DLOCX2 100 IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSOCX2 /M004 DLCX2C CX2BFA IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSCX2C DLCX2D CX2BFA IFNDEF DECDEV < CDF 30 /M050 > IFDEF DECDEV < CDF 40 /A050 > -DSCX2D DLCXHL /Start at block /A055 CXHOLE /From address /A055 CDF 60 /Resides in field 6 /A055 -DSCXHL /Size of CX Hole /A055 0 /WPCX - CHARACTER-ORIENTED COMMUNICATION PROGRAM /PATCH WRITE OUT ROUTINE FOR DISKETTE LOAD IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 3 > ADRASM=1 /INHIBIT CREATE ERROR MESSAGES /RE-CONFIGURE THE SWITCHES BKSPAC=10 LF=12 CR=15 BS=10 TAB=11 SRULER=16 ERULER=17 BLANK=40 SPACE=BLANK SPC=SPACE SP=SPC QUEST="?-200 RUBOUT=177 CNTRLG=7 ESC=33 BELL=7 FF=14 VT=13 NPAGE=14 GPAGE=2014 PARAGH=1012 CREATE=3 CUB1=6400 /THE BUFFER ADDRESS USED FOR THE CREATE *100 /THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM CIFOTH=CIFEDT /OTHER FIELD. /A005 CDFOTH=CDFEDT /"" "" /A005 CIFMYF=CIFBUF /WE RUN IN THE EDT FIELD. CDFMYF=CDFBUF /WE RUN IN THE EDT FIELD. IFDEF VT125R < /FOR VT125 /A041 RGFLD=10 /REGIS RUN-TIME FIELD=1 /C046 PRMFLD=50 /PRIMITIVES RUN TIME FIELD=5 /C046 PRGFLD=60 /PRIM/REGIS COMBO FIELD=6 /C046 PRIM= 200 /CALLING ADR FOR PRIMITIVES /A041 REGIS=177 /CALLING ADR FOR REGIS /A041 > /END IFDEF VT125R /A041 /HERE ARE SOME FLAGS AND IMPORTANT LOCATIONS USED BY THE ROUTINES /THE NEXT 4 LOCATIONS MUST BE IN THIS ORDER FOR MAGCRD ASSEMBLIES - THEY /ARE COPIED TO THE OTHER FIELD PRIOR TO CALLING THE COMM ROUTINES /ACTION FLAGS, WITH VALUES AS FOLLOW /THE FLAG WORD IS NONZERO WHEN THERE THERE IS SOMETHING COMING FROM /THE CORRESPONDING DEVICE. FOR EXAMPLE, THE KEYBOARD, OR A DISK FILE /TO BE READ. /THE BIT(S) WHICH ARE NONZERO CORRESPOND TO WHERE THE SOMETHING IS TO BE /PUT. FOR INSTANCE, TO THE PRINTER, THE SCREEN, ETC. DKTFLG, 0 /DISK INPUT H2TFLG, 0 /INPUT FROM THE HOST KBTFLG, 0 /KEYBOARD INPUT LPTCNT, 0 /# OF LINES LEFT ON THE PRINTER PAGE /A007 /THE BITS WHICH CAN BE SET ARE - CRT=1 /TO THE SCREEN LQP=2 /TO THE PRINTER HST=4 /TO THE SECONDARY COMMUNICATIONS LINE H2T=10 /PRIMARY COMMUNICATIONS LINE (H2T) IBM=H2T DOC=20 /WITH OUTPUT FILE (DISK) ERFLG, 0 /NONZERO CORRESPONDING TO TYPE OF ERROR DETECTED /(LAST OF THE 4 CRITICAL LOCATIONS) EXITFL, 0 /TIME TO EXIT WHEN SET! /A035 /THE KEYBOARD PROGRAM CRLFFL, 0 KBTCHR, 0 K2HCHR, 0 /TTY CHAR W/ 200 BIT (FOR USER ESC). /A011 KBTFL1, 0 KBTOXL, 0 /SOME VALUES USED BY HOST2 H2TCHR, 0 H2TOXL, 0 H2TFLX, 0 /LOCATIONS USED FOR THE DOCUMENT NUMBERS FOR READ AND WRITE /WHEN BOTH ARE NON-ZERO, THE DISK JOB IS ACTIVE AND THE CORRESPONDING /DOCUMENTS ARE OPEN. WHEN BOTH ARE ZERO, NO ASSUMPTIONS CAN BE MADE ABOUT /THE DISK JOB. OTFILE, 0 ITFILE, 0 /LOCATIONS CONTAINING THE FILE NUMBERS FOR UNOPENED FILES WHICH HAVE BEEN /SPECIFIED. IT IS ASSUMED THAT THE CORRESPONDING FILE NUMBERS (OTFILE AND /ITFILE) ARE ZERO WHEN THESE ARE NON-ZERO. OTFIL2, 0 ITFIL2, 0 /FLAG FOR THE PRINTER CNGPFG, 0 /THE FLAG THAT SAYS THAT THERE IS SOMETHING WORTH DOING NONBNK, 0 DKACTF, 0 /THE ACTION FLAG BETWEEN THE DISK ROUTINE /TO THE MAIN PROG. TSTFLG, 0 /FLAG INDICATING TEST MODE EXRLR, 0 /FLAG USED BY DSKJOB TO TELL IF IN A RULER RSNFLG, 0 /IF NON ZERO THIS TELLS DSKJOB TO PAUSE AND /WAIT FOR HT2JOB TO FINISH USING THE HOST /LINE FOR SENDING. TSTACF, 0 /SET WHEN THE TEST JOB IS RUNNING. /A013 HSTACF, 0 /SET WHEN THE HOST JOB IS RUNNING. /A013 DSKACF, 0 /SET WHEN THE DISK JOB IS RUNNING. /A013 EZLINK, 0 /SET WHEN TM=EZLINK. /A035 PLDADR, PRTLOD /Address of print load routine /A051 PRFLBK, 0 /Print Fallback flag /A051 PRTREQ, 0 / Printer requested flag /A051 / / N O T E ...... / / The "Options" tables TAB1 to TAB4 which used to reside in WPCOM /A059 / have been moved here for space reasons /A059 / TAB1, IFDEF ENGLSH < "K-200 /A059 "H-200 /A059 "T-200 /A059 "D-200 /A059 > IFDEF ITALIAN < "T-200 /A059 "O-200 /A059 "C-200 /A059 "D-200 /A059 > IFDEF V30NOR < "T-200 "V-200 "K-200 "D-200 > IFDEF V30SWE < "T-200 "A-200 "D-200 "X-200 > -1 /A059 TAB2, KBTFLG /A059 H2TFLG /A059 TSTFLG /A059 DKTFLG /A059 -1 /A059 TAB3, IFDEF ENGLSH < "S-200 /A059 "P-200 /A059 "H-200 /A059 "D-200 /A059 > IFDEF ITALIAN < "V-200 /A059 "S-200 /A059 "O-200 /A059 "D-200 /A059 > IFDEF V30NOR < "B-200 /A059 "S-200 /A059 "V-200 /A059 "D-200 /A059 > IFDEF V30SWE < "B-200 "S-200 "A-200 "D-200 > -1 /A059 TAB4, CRT / Screen /A059 LQP / LQP Printer /A059 H2T / Primary Host /A059 DOC / Output Document /A059 /------------------ PAGE /CX XBSTRT, XX /CALLED BY JMS FROM CVOVRL CLA RDF TAD CIDF0 DCA RTNCER CDFMYF JMS XBSBUF /SET THE BUFFERS UP FOR CX IN EDITOR /FIELD FOR CX2 AND SET UP TERMINAL /MODE FROM CXTMOD /A021 JMP CONFG1 /SKIP GOLD-HALT STUFF /CONFIG IS THE ENTRY POINT WHEN WE RETURN TO THE CX MENU /A021 /FROM A \R OR \H, OR FROM A GOLD HALT /A021 CONFIG, IFDEF CONDOR < /A022 JMS CFGXXX /SAVE TERMINAL MODE & STOP DISK JOB /C021 > /IFDEF CONDOR /A022 IFNDEF CONDOR < /A022 JMS DKACTS /STOP THE DISK JOB /A002 > /NDEF CONDOR /A022 CONFG0, CIFSYS TTYIN JMP CONFG1 /READ CHARACTERS UNTIL EMPTY BUFFER JMP CONFG0 CONFG1, JMS CLRFLG /CLEAR FLAGS /M003 /D049 DCA RSNFLG /A048 /D049 DCA HSTACF /A048 /D049 DCA DSKACF /A048 CONFG2, CLA / Clear out Rubbish /A057 TAD PRTREQ / Check if Print required flag was set /A057 SNA CLA / /A057 JMP CNFG2A / Wasn't set so forget it /A057 DCA PRTREQ / Was , so Unset it /A057 CDFMNU / Point to Menu field /A057 TAD I (MUBUF+MNPULD) / Get "Non Printer Printer Busy" Flag /A057 AND (3777) / Strip of the 4000 bit /A057 DCA I (MUBUF+MNPULD) / And replace it /A057 CDFMYF / Point back here /A057 CNFG2A, CIFMNU /CALL COMMUNICATIONS MENU /A026 JMS I MNUCAL /A026 DLMCX2 /A026 AC7777 CIFSYS HS2OU CLA TAD (CNLINE-1) DCA X2 CON1, TAD I X2 SNA JMP CON2 /DONE IF 0 JMS KBTOCH JMP CON1 CON2, JMS KBTICH /GET EDIT INPUT TAD (-EDMENU) /M057 SNA /M057 JMP RTNSY /GOLDM /M057 / / The "stuff" to handle most of the input cosmetics is now /A057 / Blasted in /A057 / JMS CLRPAN / clear panel if VT125 /a058 JMS BHOOK / Call Blaster /A057 CXKBIN /A057 JMP CONCR1 / End of Input seen /A057 JMS RESPAN / restore panel if /a058 JMP CON2 / Go try for more /A057 CONCR1, JMS RESPAN / restore panel if vt125 /a058 JMP CONCR / end of inpt screen /a058 /***********************************************************************/a058 / CLRPAN Clear out the first block of panel memoryry before / blaSTING IF it is a VT125 GRAPHICS term emulator /***********************************************************************/a058 CLRPAN, XX / return address /a058 DCA RESPAC / save ac /a058 JMS CHK125 / ARE WE A VT125? /A058 SKP / yes /a058 JMP CLRPN1 / NO JUST RETURN /A058 JMS BHOOK / CALL BLASTR /A058 -MVSWEN / MOVE OUT SWAP AREA TABLES /A058 CLRPN1, /A058 TAD RESPAC / restore ac /a058 JMP I CLRPAN / RETURN /***********************************************************************/a058 / RESPAN restore the fisrst block of panel memory once we have blasted /a058 / if it is a VT125 emulator /a058 /***********************************************************************/a058 RESPAN, XX / RETURN ADDRESS /A058 DCA RESPAC / save ac /a058 JMS CHK125 / ARE WE A VT125? /A058 SKP / yes /a058 JMP RESPN1 / NO JUST RETURN /A058 JMS BHOOK / CALL BLASTR /A058 MVSWEN / MOVE BACK SWAP AREA GRAPHICS TABLES /A058 RESPN1, /A058 TAD RESPAC / restore ac /a058 JMP I RESPAN / RETURN /A058 RESPAC, 0 /a058 /**************************************************************************** / TSTJB2 moved here from WPCOM because of the lake of the space /***********************************************************************/a058 TSTJB2, /a058 JMS BHOOK / call the blastr /a058 CXHLTB / run testst from blastr /a058 JMP TSTJB1 / return 1 go restore the swap if VT125 /a058 JMS RESPAN / restore here if return 2 /a058 JMP TSTXIT / and exit /a058 TSTJB1, JMS RESPAN / restore swap /a058 JMP TSTJOB / cont /a058 /**************************************************************************** CKCOMM, XX /ROUTINE TO SEE IF HOST IS REQUESTED /A018 TAD (H2T) /IF SO VALIDATE HARDWARE IS PRESENT. /A018 /SEE IF HOST IS ANY /A018 JMS CHKFLG /OF THE DESTINATIONS. /A018 SKP /SKIP IF NO. SEE IF IT IS A SOURCE. /A018 JMP CKHDWR /HOST IS A DESTINATION. CHECK HARDWARE. /A018 TAD H2TFLG /SEE IF HOST IS A SOURCE. /A018 SNA CLA /SKIP IF YES. VALIDATE THE HARDWARE. /A018 JMP I CKCOMM /HST NOT SRC & NOT DST SO OK TO RETURN. /A018 CKHDWR, AC0001 /LOAD THE HARDWARE PRESENT BIT MASK /A030 CDFMNU /C030 AND I (MUBUF+MNOPTC) /C030 CDFMYF /SEE IF COMM HARDWARE IS PRESENT /A018 SZA CLA /SKIP IF NO. REPORT ERROR. /A018 JMP I CKCOMM /HARDWARE IS PRESENT SO OK TO RETURN. /A018 JMP PTERM5 /PUT OUT ERROR MESSAGE /A030 RTNCER, XX /EXIT CIDF /MOVED /M041 JMP I XBSTRT /RETURN TO CALLER /MOVED /M041 / Moved here on edit 057 for space reasons CLRSCN, TEXT '^P!E' /M044 / / Moved here on edit 07 for space reasons /A057 / LPRINT, XX JMP LPTTSF LPTTSE, CIFSYS JWAIT LPTTSF, CIFSYS LPTOU JMP LPTTSE /NOT READY, WAIT JMP I LPRINT /------------------ PAGE /RELOAD PRINTER FOR VT125 MODE CXHOLE, /---------------------------------------------------------------/a055 / N.B. /A055 / THIS Page is used by Blaster as an overlay area for /A055 / dumping into (and restoring of course ) /A055 / /A055 /---------------------------------------------------------------/A055 PRTLOD, 0 /D058 DCA QUQBLK+RXQDRV /SET SYSTEM DRIVE /A044 /D058 TAD (DLFD1) /START BLOCK NUMBER /A044 /D058 DCA QUQBLK+RXQBLK /A044 /D058 TAD (-DSFD1) /BLOCK COUNT /A044 /D058 DCA QUQBLK+RXQRS1 /A044 /D058 TAD PRTFLD /PRINTER FIELD /A044 /D058 DCA QUQBLK+RXQBFD /PUT IT IN QBLK /A044 /D058 TAD (PRBOTM) /START OF BUFFER /A044 /D058 DCA QUQBLK+RXQBAD /PUT IT IN QBLK /A044 /D058 TAD (RXERD) /NO RETURN MUST REBOOT /A044 /D058 DCA QUQBLK+RXQFNC /FUNCTION CODE /A044 /D058 JMS QURX /DO IT /A024 /D058 CLA /MUST REBOOT ON ERROR AS PRINT FIELD /D058 /NOT IN MEM. /A044 /D058 TAD (PRJOB) /STATUS BLOCK POINTER /A044 /D058 CIFSYS /A044 /D058 JSTRT /RESTART JOB /A044 /D058 JMP I PRTLOD /RETURN /A044 /D058PRTFLD, CDFPRT /PRINTER FIELD /A044 /************************************************ / NOW RESTART THE SYSTEM /************************************************ /A058 / HLT CDFSYS / system field /a058 TAD I WRMSTR / get date for start /a058 CMA / make neg /a058 DCA I WRMSTR / and store /a058 JMS BHOOK / call BLASTR /a058 -GRESEN / to restore restart code from panel /a058 IOF / don't allow interrupts /a058 CLA / AC4000 / Get system type /a058 / CDFFIO / /a058 / TAD I PTR7 / /a058 CDISYS / call restart in sys /a058 DCA I VFYPTR / save type first /a058 JMP I RESPTR / now restart /a058 RESPTR, RXDRIN+1 / address of restart /a058 VFYPTR, SVFVFY-CLOCK+RANDOM /a058 WRMSTR, DAMNTH / date for restart /a058 CONCR, TAD (CR) JMS KBTOCH TAD (LF) JMS KBTOCH CNMERG, TAD (CNLINE-1) DCA X2 CNSCAN, TAD I X2 /ANOTHER FIELD THEN REINSERT IT SNA JMP CNDONE TAD (-BLANK) SNA JMP CNSCAN TAD (BLANK) MQL TAD (TAB1-1) JMS LOOKUP JMP CNERR TAD (TAB2-TAB1-1) DCA X3 TAD I X3 DCA CNLOC TAD I X2 SNA JMP CNERR MQL TAD (TAB3-1) JMS LOOKUP JMP CNERR TAD (TAB4-TAB3-1) DCA X3 TAD I X3 MQL TAD I CNLOC MQA DCA I CNLOC TAD DKTFLG AND (20) SZA CLA JMP CNERR TAD TSTFLG AND (20) SZA CLA JMP CNTDOC /TEST A DOCUMENT FOR VALID CX /PRINT CONTROLS AC0001 DCA NONBNK JMP CNSCAN CNERR, AC7777 TAD X2 DCA X2 TAD (QUEST) DCA I X2 DCA I X2 JMP CONFIG CNLOC, 0 /CHECK FOR A TRANSFER TO A DOCUMENT CNDONE, TAD NONBNK /IF ZERO DON'T CONTINUE SNA CLA JMP CONFIG JMS CKCOMM /CHECK FOR HOST I/O BUT NO HARDWARE. /A018 TAD (DOC) /SET THE MQ FOR DOCUMENT JMS CHKFLG /SEE IF A FLAG IS SET FOR OUTPUT TO A DOCUMENT JMP CHKREQ /NO TAD OTFILE /YES IS THE FILE ALREADY OPENED ? SNA CLA /SKIP IF YES. CONTINUE. /A035 JMS PMESFN /NO OPEN IT JMP CNTNUE CHKREQ, JMS CXSKCL /CLOSE THE FILE /CHECK FOR FILE NEEDED TO BE READ CNTNUE, TAD DKTFLG SNA CLA JMP CNTU1 /IF NOTHING FROM AN INPUT DOCUMENT JMS RDOCMS JMP CNTNU CNTU1, JMS CXRDCL /CLOSE IF OPEN FOR READ /IN THE NEW SYSTEM THE COM FLAG IS SET BEFORE ENTERING CX /BY CU3COM IN WPCU3 CNTNU, JMS PRTTST /SEE IF INITIALIZATION TO PRINTER TO BE DONE JMP CNTN6 / / The code below was moved here on edit 059 to free up a few /A059 / words in WPCOM and allow easier changing of NRC on term reset /A059 / / RESNRC, XX / Restore terminal NRC /A059 JMS DMTOSC / Output an escape seq /A059 ESC / /A059 "(&177 / /A059 RESNRX, "B&177 / /A059 ESC / /A059 ")&177 / /A059 "0&177 / /A059 0 / /A059 JMP I RESNRC / And return /A059 /------------------ PAGE /*********** MOVED HERE VER 044 ***********SPACE WARS LOOKUP, XX DCA X3 MQA CIA DCA LOOKC LOOKC1, TAD I X3 SPA JMP I LOOKUP TAD LOOKC SZA CLA JMP LOOKC1 TAD X3 ISZ LOOKUP JMP I LOOKUP LOOKC, 0 /CHKFLG - CHECKS FOR THE VALUE IN THE MQ TO THE FLAGS CHKFLG, XX MQL TAD (TAB2-1) /GET STARTING ADDRESS DCA CHKFLT CHKFLJ, ISZ CHKFLT TAD I CHKFLT DCA T1 TAD T1 SPA CLA JMP I CHKFLG /IF -1 THEN END OF STRING MQA AND I T1 SNA CLA JMP CHKFLJ ISZ CHKFLG JMP I CHKFLG CHKFLT, 0 /ROUTINES FOR ACCESSING DOCUMENTS PMESFN, XX CIFMNU /INSERT A CDF TO THE MENU FIELD JMS I MNUCAL /CALL MENU DLMCM1 AC7776 CDFMNU TAD I (MUBUF+MNTMP1) /GET TEMP 1 TO SEE ABOUT GOLD-M CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME SNA JMP CONFIG /IF 2 RETURN TO MENU TAD (2-CREATE) /ELSE SEE IF THE DOCUMENT HAS TO BE CREATED SZA /NEED TO CREATE? JMP PMESF1 /NO, JUMP DCA OPFLOP /WILL OVERWRITE THE DOCUMENT JMS ADRCRT /CREATE THE FILE JMP CRTERR /ERROR ENCOUNTERED CDFMNU /SET "REMEMBERED" FILE NUMBER. /A034 DCA I (MUBUF+MNFNO) /A034 TAD I (MUBUF+MNFNO) /GET DOC NUMBER. /A034 AND P377 /A034 DCA I (MUBUF+MNDOCN) /STORE IT TOO. /A034 JMP PMESF2 PMESF1, TAD (CREATE) DCA OPFLOP /STORE THE VALUE CDFMNU /INSERT A CDF FOR THE MENU FIELD /TO PICK UP AN ARG. PMESF2, TAD I (MUBUF+MNFNO) CDFMYF CIA TAD ITFIL2 /ASSUME AT MOST ONE OF ITFILE AND ITFIL2 /ARE NON-ZERO TAD ITFILE /COMPARE TO WHAT WAS THERE LAST SNA JMP FLERR /CAN'T READ AND WRITE TO SAME FILE CIA TAD ITFIL2 TAD ITFILE DCA OTFIL2 JMS CXSKOP /OPEN SCROLL FILE. /A013 SKP /IF ERROR SET ERFLG. /A013 JMP I PMESFN /RETURN /A013 AC0001 DCA ERFLG /SET RETURN ERROR FLAG. /A013 JMP I PMESFN /RETURN TO CALLER. OPFLOP, 0 RDOCMS, XX /TAKES CARE OF THE READ FILE CIFMNU /CALL THE MENU JMS I MNUCAL /MENU CALL DLMSO2 /M034 AC7776 /TEST FOR GOLD-M CDFMNU /GET AN ARGUEMENT FROM THE MENU FIELD TAD I (MUBUF+MNTMP1) CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME SNA CLA JMP RDOCM2 /IF 2 START AGAIN CDFMNU /GET TO THE MENU FIELD TAD I (MUBUF+MNFNO) /GET FILE NUMBER WITH DRIVE NUMBER CDFMYF /A CDF FOR THIS FIELD /WILL BE INSERTED AT RUN TIME CIA TAD OTFIL2 /ASSUME THAT AT LEAST ONE /OF OTFIL2 AND OTFILE IS ZERO TAD OTFILE SNA JMP FLERR /CHECK FOR R &W TO SAME FILE CIA TAD OTFIL2 TAD OTFILE DCA ITFIL2 JMP I RDOCMS CHK125, 0 /CHECK VT125 MODE /A044 CDFMNU /A044 AC7775 /CHECK FOR VT125 MODE(=3) /A044 TAD I (MUBUF+CXTMOD) /MODE SW /A044 CDFMYF /A044 SZA CLA /=VT125? /A044 ISZ CHK125 /NOT VT125 MODE..NO GRAPHICS LOADED /A044 JMP I CHK125 /RET /A044 /Moved here on edit 51 to make space at ID routine to check if fallback /A051 /required on printer (LA100 non PC etc) /A051 /MOVED HERE FROM NEXT PAGE TO MAKE ROOM /A041 /PRSTTS SHOULD BE NOT BE RESET WHEN LEAVING CX. /A030 /PRTID NO LONGER SETS IT TO 1 (BUSY) SO IT REMAINS (0) AS LONG /A030 /AS NO ERROR OCCURS. IF AN ERROR DOES OCCUR, IT WILL BE SEEN /A030 /WHEN THE USER RETURNS TO MAIN MENU /A030 /THE PRINTER JOB DOES NOT NEED TO BE STARTED WHEN WE LEAVE CX /A031 /SINCE IT CANNOT BE RUNNING. WE HAVE ELIMINATED THE WINDOW ON /A031 /PRSTTS BETWEEN JOBS, SO CX TO THE PRINTER CAN NOT BE UNLESS THE /A031 /PRINTER JOB IS NOT RUNNING. /A031 XPRTPT, XX IFDEF VT125R < /A044 JMS CHK125 /CHECK VT125 MODE /A044 SKP /IS VT125 MODE /A044 JMP I XPRTPT CIFEDT /CALL IN WPCX2 /A045 JMS I (SETPG0) /DO IT /A045 JMS I PLDADR /LOAD PRINTER CODE FIELD 1 /A044 > /END IFDEF VT125R /A044 JMP I XPRTPT /------------------ PAGE /WHEN A GOLD-M WAS ISSUED, MAKE SURE THAT ANY PREVIOUSLY SPECIFIED /(BUT NOT OPENED) OUTPUT FILE IS UNLOCKED. /THIS ASSUMES THAT, SHOULD BOTH AN INPUT AND AN OUTPUT FILE BE NEEDED AT /THE SAME TIME, THE MENU PROMPT FOR THE OUTPUT FILE WILL BE ISSUED FIRST. RDOCM2, DCA OTFIL2 TAD DSKACF /IS THE DISK JOB CURRENTLY ACTIVE? /A013 SZA CLA /SKIP IF NOT ACTIVE /A019 JMP CONFIG /TELL DSK JOB, KILL ITSELF & CLOSE FILE /A013 JMS CXSKCL /CLOSE ANY OPEN SCROLL FILE. /A013 JMP CONFG0 /SET UP FOR CX MENU. /A013 /PRTTST - checks for cx using the printer and if the printer is in use... PRTTST, XX TAD (LQP) /SET THE MQ FOR PRINTER JMS CHKFLG /SKIP IF PRINTER REQUESTED JMP PRTTSN /NO REQUEST FOR THE PRINTER JMS CHK125 /CHECK VT125 MODE /A044 JMP I PRTTST /YES SKIP BUSY CHECK(ALREADY DONE) /A044 CDFMNU / Point to Menu field /A057 AC4000 / Test for bit 0 /A057 AND I (MUBUF+MNPULD) / Check "Non-Printer Print Busy Flag" /A057 SZA CLA / /A057 JMP PTERM7 / Print Screen must be active /A057 CDFPRT TAD I (PRSTTS) /SEE IF THE STATUS IS ZERO SZA CLA JMP PTERM2 /NO, CX CANNOT BE DONE /C027 PRTTSC, ISZ CNGPFG /SET THE CHANGE FLAG /A025 TAD I (PRTID) /GET PRINTER ID ROUTINE ADDRESS. /A007 CDFMYF /BACK TO THE FUNNY FARM! /A007 CIFPRT /MAP SPOOLER. /A007 DCA T1 /SAVE ROUTINE ADDRESS. /A007 AC0001 /SAY THAT WE WANT TO TRAP THE ERROR!!! /A014 JMS I T1 /CHECK THE PRINTER ID. /A007 SKP /SUCCESS RETURN. /A014 JMP PTERM3 /NON-EXISTENT PRINTER RETURN. /A014 /PRTID WILL SET PRSTTS TO SOMETHING /A027 / / References to printing fallback for 8 bit (with 8 bit terminal /A056 / type) has been dropped since Martyn now gets the print driver to/A056 / handle 8 bit stuff to LQP's /A056 / /d056 TAD I (LPONLN) /Get printer status /A051 /d056 AND (MNMSK) /Has it got multinational capability? /A051 /d056 SZA CLA / /A051 /d056 JMP PRCKASF /Yes , check sheet feeder /A051 /d056 AC0001 / /A051 /d056 DCA PRFLBK /Set print fallback flag /A051 PRCKASF,CDFPRT /MAP PRINTER /A007 TAD I (LPONLN) /GET PRINTER ASF STATUS. /A007 AND (ASFMSK) /A033 SZA CLA /SKIP IF NOT ASF. /A007 TAD (FF) /SET FF IF ASF. /A007 DCA PRTSTS /DO INITIAL FF FOR ASF PRINTERS. /A007 CDFPRT /GET DEFAULT PAGE SIZE /A007 /C038 TAD I (PRQPSZ) /A007 /C038 CDFMYF CIA /COMPUTE THE NUMBER OF PAGES. /A007 DCA LPTCNT /SAVE. /A007 CDFMNU / Point to menu field /A057 AC4000 / Now set the flag /A057 TAD I (MUBUF+MNPULD) / to say the printer is busy /A057 DCA I (MUBUF+MNPULD) / and put it back /A057 AC0001 / Set Printer requested flag /A057 DCA PRTREQ / On /A057 CDFMYF / Back to this field /A057 /SEND EITHER NOTHING OR A FORM FEED TO PRINTER TAD PRTSTS /GET CHR /C038 SNA JMP I PRTTST /NOTHING, RETURN. /D057 JMP PRTTSF PRTTSE, JMS LPRINT /PRINT CHAR IN AC /A057 JMP I PRTTST /FF ACCEPTED, DONE /C038 PRTTSN, DCA CNGPFG /CLEAR THE CHANGE FLAG JMP I PRTTST PTERM7, TAD (2) / Print screen and printer requested /A056 PTERM5, TAD (2) /NO HARDWARE /A030 PTERM3, IAC /NON EXISTENT /A024 PTERM2, TAD (2) /BUSY /A024 PTERMS, CDFMNU DCA I (MUBUF+MNTMP1) /SAVE ERROR CODE FOR MENU CDFMYF CIFMNU JMS I MNUCAL /DISPLAY THE MESSAGE DLMAD7 JMP RTNSY /M013 PRTSTS, 0 /TABLE OF CHARACTERS TO SEND TO THE PRINTER /FF INSERTED HERE FOR ASF PRINTERS. /A007 FLERR, CLA JMP ERROUT INTERR, CDFMYF AC0001 TAD ERFLG /ADD INTERNAL ERROR TYPE (1 FOR BAD BLOCK, /2 FOR OVERFLOW. JMP ERROUT /PUT THE ERROR TYPE INTO A TEMP TO CALL THE MENU. /THEN, CLEAN UP AS FOLLOWS - /CLEAR ALL ACTION FLAGS TO STOP ALL NON-DISK JOBS /CLEAR ERROR INDICATION FLAG (ERFLG) /CLOSE ANY DISK INPUT FILE (CALL DKACTS ONCE) /FINALLY, CALL THE ERROR MENU TO DISPLAY THE ERROR. CRTERR, AC0001 ERROUT, CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF /CLEAR ALL ACTION FLAGS AND -ERFLG- JMS CLRFLG /M003 /CLOSE INPUT FILE TAD DSKACF /IS THE DISK JOB ACTIVE? /A013 SNA CLA /SKIP IF YES. TELL IT TO CLOSE UP SHOP. /A013 JMP ERROU1 /CLOSE THE OPENED FILES. /A013 DCA DSKCNT /DISK JOB WILL CLOSE FILE ONLY WHEN NO /CHAR TO OUTPUT JMS DKACTS JMP ERROU2 /MERGE BELOW TO DISPLAY ERROR MESSAGE. /A013 ERROU1, JMS CXRDCL /CLOSE ANY OPENED READ FILE (PROBABLY /A013 /NONE OPENED AT THIS POINT!) /A013 JMS CXSKCL /CLOSE THE OPENED SCROLL FILE (WHICH /A013 /MAY BE OPENED AT THIS POINT). /A013 /DISPLAY ERROR MENU ERROU2, JMS DMTOSC /OUT PUT STRING TO SET ANSI MODE /A042 ESC;74;0 /IS ESCAPE ANGLE BRACKET /A042 CIFMNU JMS I MNUCAL DLMCX1 JMP CONFG2 /DISPLAY COMMUNICATIONS MENU /THIS IS THE CROSS FIELD CALL FOR THE CX PRINT CONTROL TEST ROUTINE CNTDOC, AC0001 /SINCE THE ROUTINE CAN BE CALLED BY SO AND CX /THE 1 TELLS THE ROUTINE THAT CX IS CALLING CIFEDT JMS I (DBTDOC) NOP /A037 JMP CONFIG CXRDCL, XX CLA DCA ITFILE JMP I CXRDCL /------------------ PAGE /SEE IF THERE ARE DOCUMENTS TO BE OPENED CXRDOP, XX TAD ITFIL2 SNA JMP I CXRDOP /IF THERE IS NO INPUT FILE TO OPEN, JUMP DCA ITFILE DCA ITFIL2 CDFEDT /A047 DCA I (DSKRLF) /CLEAR THE FLAG USED BY DSKGCH THAT /A047 /SAYS IT IS IN THE MIDDLE OF A RULER /A047 DCA I (DSKSTF) /CLEAR THE FLAG IN DSKGCH THAT SAYS TO /GET INPUT FROM A BUFFER AND NOT RDFILL /A047 AC7776 DCA I (DSKSOD) /SET FOR FIRST TIME THROUGH DSKGCH /A047 DCA I (DSKBAK) /CLEAR THE TEMP CHAR WHEN LOOKIN FOR SOD/A047 DCA I (DSKSOL) /CLEAR THE START OF LINE FLAG /A047 CDFMYF /A047 TAD ITFILE CIFFIO FILEIO XRDFIN JMP I CXRDOP /OPEN THE OUTPUT FILE IF THERE IS ONE WAITING TO OPEN CXSKOP, XX TAD OTFIL2 SNA JMP XSKOP3 /NOBODY TO OPEN, RETURN. MQL TAD OPFLOP /PICK UP TYPE OF OPEN (TOP, BOTTOM, OVERWRITE) CIFFIO FILEIO XDSKIN SZA CLA /ERROR? JMP I CXSKOP /YES, JUMP TAD OTFIL2 DCA OTFILE DCA OTFIL2 /INITIALIZE THE OUTPUT BUFFER AND PUT AN INITIAL WORD-WRAP INDICATION IN /FOR THE EDITOR. TAD (DSKBUF) DCA DSKPT1 TAD (DSKBUF) DCA DSKPT2 DCA DSKCNT TAD (200+CNTRLG) JMP XSKOP2 XSKOP1, CIFSYS JWAIT XSKOP2, JMS DSKPUT JMP XSKOP1 XSKOP3, ISZ CXSKOP /SKIP OVER ERROR RETURN JMP I CXSKOP CXSKCL, XX CLA TAD OTFILE /CHECK THE INPUT FLAG FOR A FILE OPEN SNA CLA JMP I CXSKCL DCA OTFILE /CLOSE IT AND CLEAR FLAG CIFFIO FILEIO XDSKCL JMP I CXSKCL /FOLLOWING CODE MADE INTO A SUBROUTINE TO SAVE SPACE /A003 CLRFLG, XX /CLEAR FLAGS /A003 CDFEDT /CLEAR THE DOC XFR "WAIT" FLAG. /A016 AC7777 /SAY NOT "WAITING". /A016 DCA I (WATFLG) /A016 IFDEF VT125R < /VT125 ONLY /A041 DCA I (GRAFON) /SO HS CHARS GO TO SCREEN (NOT REGIS) /A041 > /END IFDEF VT125R /A041 CDFMYF /BACK TO OUR FIELD. /A016 DCA NONBNK /CLEAR THE SOMETHING TO DO FLAG /A003 DCA KBTFLG /CLEAR OUR FLAGS /A003 DCA EXRLR /A003 DCA H2TFLG /A003 DCA TSTFLG /A003 DCA DKTFLG /A003 DCA ERFLG /A003 JMP I CLRFLG /A003 /THIS IS THE RETURN LOGIC (GOLD MENU) RTNSY, JMS RESTOR /RESET TERMINAL CHARACTERISTICS /A002 JMS CXSKCL /CLOSE ANY OPEN SCROLL FILE. /A013 RTNCE1, TAD DSKACF /SEE IF ANY JOBS STILL RUNNING. /A013 TAD HSTACF /A013 TAD TSTACF /A013 SNA CLA /SKIP IF YES. /A013 JMP RTNCE2 /RETURN TO MAIN-MENU. /A013 CIFSYS /WAIT FOR JOBS TO FINISH-UP. /A013 JWAIT JMP RTNCE1 /CHECK AGAIN. /A013 RTNCE2, JMS XPRTPT /RETURN THE PRINTER /M044 CDFMNU /GET LINKAGE FLAG. /A035 TAD I (MUBUF+MNTMP6) /(IE, THE EZ-LINK FLAG). /A035 CDFMYF /BACK TO OUR FIELD. /A035 SZA CLA /SKIP IF NORMAL EXIT. (IE BACK TO MM) /A035 JMP RTNCER /JMP TO HANDLE CHAIN CALL TO AX/DX. /A035 IFDEF VT125R < JMS CHK125 /IS VT125 GRAPHICS MODE /A044 JMP CLRGRF /AVOID JUMPING TO NON EXISTING BUFFER /A041 >/END IFDEF VT125R /A041 CIF 60 /MAP COMM BUFFER FIELD. /A036 JMS I (COMXIT) /CALL COMM CLEAN-UP CODE. /A036 NOBUFF, CDFSYS DCA I (CMADSX) CDFMYF /CLEAR SYSTEM COMM FLAG JMP RTNCER /NEED TO EXIT ON SAME PAGE CALLED /A041 IFDEF VT125R /END IFDEF VT125R /A041 / / The code below is from H2TIO area moved here to give some space /A059 / / NRCTRN, CDFEDT / /A059 TAD I (NRCREP) / Get replaced char /A059 CDFBUF / Point back here /A059 JMP NRCRPD / and rejoin main code /A059 /------------------ PAGE / WPAX 3.3- AUTOMATIC DOCUMENT RECEIVE / / 037 CPH 19-SEP-85 Add Norwegian translations conditional / 036 EMcD 28-Feb-85 Add DECDEV switch / 036 TCW 30-AUG-84 Change var. ref. from abs. to relative / 035 WCE 11-MAY-84 Remove all occurances of USERNO / 034 TCW 24-JAN-84 Limit menu input to 64 chars. / 033 TCW 16-JAN-84 Add new label for menu display / 032 GDH 4-JAN-84 Don't display comm settings for EZLINK. / 031 TCW 30-DEC-83 ADD CK FOR PASSWORDS WITH EXTRA CHARS. / 030 TCW 16-MAY-83 ADD THE FETCH OF "LOGNO" WHEN TRUNCAT- / ING LD NAME / 029 EH 14-JAN-83 Modifications to 028 / 028 EH 04-JAN-83 Modifications to 027 / 027 EH 29-DEC-82 After trunc. AX LD to 64, check to see / if file already exists / 026 EH 21-DEC-82 Install missing CDF within AXRT7 / 025 EH 17-DEC-82 More work on 024 / 024 EH 14-DEC-82 Limit length of AX LD name to 64 chars / 023 AIB 22-OCT-82 fixed log doc entry for add to / bottom from "A" to "B" / 022 AIB 22-OCT-82 fixed wording in / "identification message" msgs / 021 EH 05-OCT-82 Check for leading space in Log Document / 020 MJS 21-NOV-81 big fix enabling 'settings' to be saved / at 'YES' prior to the start of sequence / 019 EH 9-NOV-81 modified text statement for AX menu / 018 EH 29-OCT-81 Merged differences from 78,1 into here / 017 GDH 23-OCT-81 Allow AX to send (but not recieve) LOG / 016 GDH 21-OCT-81 Merged some bug fixed from WS200 V4.4 / 015 GDH 21-OCT-81 Removed phoney CIF/CDF routines. Bug fix / to MNLOCK log document lock support. / 014 GDH 14-OCT-81 Removed log file lock/unlock code and / implemented menu lock word in it's place / 013 GDH 26-Aug-81 WPFILS calling seq changes. / 012 TT 07-JUL-81 Removed superfluous conditionals / 011 JM 01-APR-81 Changes for CANADA / 010 JM 19-FEB-81 Conditionalized PLCKFI for WS102 / 007 DRH 4-DEC-80 CLEAR AX LOG # & NAME IF CANNOT CREATE / 006 DM,JM 15-SEPT-80 Merged Scandi and Europe/English / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 6-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 3/20/80 GLT Changed LOCDOC to stop overwriting literals when / loading WPCRE. / 001 2/6/80 CMW GLT ADDED FRENCH,DUTCH,GERMAN TRANSLATIONS / French diacritical substitutions: / "["=L.A.E, "]"=L.G.E; "&" does not capitalize / German diacritical substitutions: / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "7" usable / 2.7+ MB PUT IN THE NEW AX INSTEAD OF ADR / 2.4B KEE REMOVE DEAD CODE FROM CREATE / 2.J 8/26/77 KEE PUT IN 4-FLOPPY SUPPORT / 2.G-2 8/10/77 MB PUT IN CHANGE FOR MENU AREA MOVE / 2.G-1 8/9/77 MSB PUT WT78 AND MASTER VERSIONS TOGETHER / / WTAX.PA - WRITES OUT SECOND FIELD OF THE DX, AX, SD COMM. / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOAX / ++++ 100 / ++++ IFNDEF DECDEV < CDF 20 / ++++ /M036 > IFDEF DECDEV < CDF 30 / ++++ /A036 > -DSOAX DLDCOM / ++++ DFCOMA / ++++ IFNDEF DECDEV < CDF 20 / ++++ /M036 > IFDEF DECDEV < CDF 30 / ++++ /A036 > -DSDCOM / INITALIZE THE SETTING TO ZEROS 0 / / THE SECOND FIELD OF DX AND AX / IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 3 > / / SET UP CONSTANTS FOR THE PROGRAM / BUFSIZ=100 / THE STANDARD BUFFER SIZE NAKLM=-41 / THE IS THE NUMBER OF RETRNANSMITS IT WILL DO TOLIM=-5 / THE NUMBER OF TIMES YOU RESEND AFTER A TIME OUT SPECHR=140 / THE CODE FOR SPECIAL CHARACTERS CR=15 / SEND AFTER A TRANSFER OF ANY KIND SO T-S CAN DETECT EOT SPACE=40 / / THE TIME OUT CONSTANTS / / SEC1=-2 /D018 / SEC3=-4 /D018 / SEC60=-75 /D018 / SEC5=-6 /D018 MIN3=-265 / / THE START OF TEXT CHARACTERS / ACKM=174 ACK=170 ACKY=140 NAK=160 NAKN=164 / / THE FLAG CHARACTERS FOR THE PACKET TYPE AND THE COMMANDS FOR THE LOW LEVEL / IF THE VALUES CHANGE TELL HSTTBL BECAUSE USE THEN AS OFFSETS / THEY ALL HAVE THE SAME PACKET FORMAT / TYPYES=140 / THE OK PACKET TYPE TYPMOD=141 / DOCUMENT OPTIONS PACKET RESPONDED WITH AN ANSWER TO PROMPT TYPMES=142 TYPSOD=144 / FIRST PACKET OF A DOCUMENT CONTAINING SIZE AND PRINTER SETTINGS TYPDOC=154 / PAKCET SENT BY AX TO DX TO ASK IF THE DOCUMENT SHOULD BE SENT. / THIS NAME IS AN ENTRY IN THE LIST DOCUNET DX PICKED / TYPHIT=147 / HIGH LEVEL INITALIZE PACKET THAT HAS THE TERMINAL MESSAGE IN IT / TYPHAK=150 / THE HIGH LEVEL ACK / TYPEOF=146 / LAST PACKET OF A DOCUMENT. CONTAINS THE LAST 64 BYTES OR LESS TYPBYE=143 / BYE MESSAGE PACKET, WILL TERMINATE A TRANSFER TYPDTA=145 / NORMAL TEXT PACKET OF A DOCUMENT TYPHLO=156 TYPNO=164 / ANO RESPONSE TO A PACKET TYPFLE=171 TYPPSW=172 TYPPMT=175 / PROMPT PACKET TYPPAN=172 / ANSWER TO PROMPT CONTAINS WHAT THE USER TYPED TYPPNE=176 / PROMPT WITH NO ECHO TYPOPT=153 / THE OPTION PACKET TYPRCV=152 / WANT TO RECEIVE A DOCUMENT TYPSND=151 / WANT TO SEND A DOCUMENT / / SOME CONSTANTS FOR THE DATA BUFFERS / BUFSTX=-1 / LOCATION OF THE STX FOR THE BUFFER CSLOC=BUFSIZ / THE FIRST HALF OF THE CHECK SUM CSLO1=CSLOC+1 / THE SECOND HALF WFLOC=CSLO1+1 / THIS TELLS IF THE BUFFER IS FULL (1) OR EMPTY (0) / / THE NUMBER OF TRYS BEFORE THE USER IS DECLARED INVALID / TRYPSW=-3 / / CONSTANT FOR THE CREATE / CUB1=6400 / / ADDRESS USED FOR THE GETBUF AND PUTBUF FOR OTHER FIELD / FREEPT=174 RECPT=FREEPT+1 SENDPT=RECPT+1 / GETBUA=5200 PUTBUA=GETBUA+1 / / ASSUME THAT THE SPFLAG IS IN EDITOR FIELD AT 173 / SPFLAG=173 / / THE OPTIONS THAT ARE SET TO THE DX SYSTEM WHEN SNEDING AND DOCUMENT / EXISTS THAT IS TO RECEIVE / TBOPT=43 / / VALUES FOR THE OPTIONS / OPTNUL=40 / NOTHING OPTBYE=41 / JUST BYE MESSAGE OPTBM=42 / BYE AND NORMAL MESSAGE OPTBMS=43 / BYE, NORMAL, AND SEND OPTALL=44 / EVERYTHING / / VALUE DEFINED TO GET THE CORRECT VERSION OF CREATE WPCRE ASSEMBLED / ADRASM=1 / / THESE CONSTANTS ARE USED BY THE CHECK LIST COMMAND / THE SYMBOLS ARE THE SAME AS DELETE SINCE THAT IS WHERE THE CODE WAS TAKED / DELIMB=-400 / THE SIZE OF THE BLOCK BUFFER DEBUF=4000 / ADDRESS OF THE RECORD BUFFER / TAB=11 / THE TAB VALUE LF=12 / VALUE FOR A LINE FEED CR=15 / CARRIGE RETURN BLANK=40 / ASPACE / RECLIM=-1000 / NEGATIVE THE LIMIT OR CHARACTERS IN A RECORD / DESTRP=1014 / THE START OF PRINTER CONTROL DENDP=1414 / END OF PRINTER CONTROL DESTRR=16 / START OF RULER DENDR=17 / END OF RULER / / / THE STARTING ADDRESSES OF THE BUFFERS / THIS IS THE AREA THAT IS USED FOR THE DEFAULT SETTINGS. THEY ARE STORED / FROM 5000 TO ABOUT 6000 MOST OF THE UNUSED PORTION IS USED FOR OTHER / BUFFERS AND INFORMATION IT IS ALWAYS IN COREAND WRITTEN OUT IF THERE IS A / MODIFICATION TO THE AREA. / / ADDRESS OF THE COMMUNICATIONS SETTINGS STARTING ADDRESS / DFCOMA=5000 / X=DFCOMA / DLNO=X / ++++ X=X+1 / DEFAULT LIST DOCUMENT DLSTAD=X / ++++ X=X+BUFSIZ+1 / THE LIST NAME / IDSTAD=X / ++++ X=X+BUFSIZ+1 / THE ID MESSAGE / LOGNO=X / ++++ X=X+1 / THE LOG DOCUMENT NUMBER LOGMOD=X / ++++ X=X+1 / HOW TO MODIFY IT LDSTAD=X / ++++ X=X+BUFSIZ+1 / THE LOG DOCUMENT NAME / WPSTAD=X / ++++ X=X+BUFSIZ+1 / WRITE ONLY PASSWORD BPSTAD=X / ++++ X=X+BUFSIZ+1 / READ/WRITE PASSWORD / AXIDB=X / ++++ X=X+BUFSIZ+1 / THIS IS THE DX USER'S ID TYPED. HERE TO USETHE ROOM / AXSNDA=X / ++++ X=X+11 / THE LIST OF DOCUMENTS TO SEND DX / INMBLK=X / ++++ X=X+BUFSIZ+1 / THE INPUT BUFFER FOR PACKETS RECEIVED / AXTIM=X / ++++ X=X+27 / BUFFER USED BU AXDON ROUTINE TO STORE THE TIME FOR LOG / / STARTING ADDRESS FOR THE LIST CHECK / LSTAD=6000 / THIS IS ALSO USED BY SCROLL / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / CDFMYF=CDFBUF / WE'RE IN THE BUFFER FIELD. /M015 / / THE FLAGS FOR AX / OPTFLG, 0 / THIS CONTAINS THE VALUE OF THE OPTIONS THAT THE CONNECTING / SYSTEM HAS AXFLG, 0 ERFLAG, 0 GETBUF, 0 PUTBUF, 0 AXDCF, 0 AXPCN, 0 AXSNT, 0 AXSNS, 0 AXST2, 0 / TOKOFF, 0 / POINTER TO THE INPUT THAT IS BEING LOOKED AT / SNDLST, 0 / IF SET TO 1 THEN JUST SEND THE LIST DONT DISPLAY / ERRORS USED WHEN CALLING CHKLST AXSNDL, 0 / THE POINTER TO THE NEXT AVAILABLE LOCATION IN THE / THE LIST OF DOCUMENTS TO SEND TO DX / PAGE / / THESE ADDRESSES HAVE TO BE IN THIS ORDER AND IN THESE LOCATIONS / ALL ENTRYS TO THIS VECTOR CHOULD NEVER BE CALLED IF ITS ENTRY IS NOTDEF / IF CALLED THE PROGRAM JUMPED INTO RANDOM CODE SO HALT / AXDIS / SET UP AX / AXEC / THIS ASKS THE DX USER FOR THE INFO NEEDED AT CONNECTION / AXDON / THIS IS CALLED TO CHECK TO SEE IF THE LOG DOCUMENT IS / SET AND IF IN AX AND A DOCUMENT HAS / BEEN TRANSFERRED THEN PUT THE ENTRY INTO THE LOG. / ADRCRT / CREATE A DOCUMENT / / AXLRT / RETURN LOG FILE /D018 0 /A018 / AXSR / THE SEND /RECEIVE PART OF AX / REDSIX / READS THE SPECIAL SEVEN BIT AND RETURNS IT FROM THE / SIX BIT READ ROUTINE / WRISIX / WRITES THE SEVEN BIT RECEIVED TO THE DOCUMENT / CLASIX / INITALIZES THE REDSIX AND WRISIX ROUTINES / / ARDPRG - WILL SET THE NEEDED VARIABLES FOR AUTOMATIC / DOCUMENT RECEIVE. / AXDIS, XX CDFMYF DCA AXDCF / CLEAR THE WWRITE OUT SETTINGS FLAG / AC0001 / ++++ DCA AXFLG / TELL THE FIELD THAT IT IS IN AX / / READ IN THE DX SETTINGS / TAD (RXERD) / READ IN THE SETTINGS. IF A DISK ERROR DONT RETURN JMS AXDST / /D032; JMS LOCDOC / LOCK THE DOCUMENTS THAT ARE TO BE USED /D014; JMP AXGLD / COULD NOT LOCK THE DOCUMENTS ALREADY IN USE AXDS2, DCA MNUFLG / IF ZERO PUT FIRST MENU /A033 / CIFMNU / CLEAR THE SCREEN JMS I IOACAL 0 CLASCR 0 / CDFMNU / See if we're in ezlink (from CX) /A032 TAD I (MUBUF+MNTMP6) / ... /A032 CDFMYF / ... /A032 SNA CLA / Skip if yes. Don't display comm setngs/A032 JMP AXDS2A / DISPLAY MENUS /A033 / / THE RETURNS FROM AXDIS / AXRTX, TAD (RXEWT+2000) / write out the settings /a020 JMS AXDST / /A020 TAD LOGNO / SEE IF A LOG DOCUMENT IS SET AND IF SO DOES IT EXIST SNA CLA / ++++ JMP AXRT7 / JMS CUCOPY / BEFORE CONTINUING MAKE SURE THE LOG DOCUMENT EXISTS LDSTAD / COPY NAME TO THE MENU AREA AND LET FILNAM DECIDE CDFMYF MUBUF+MNIBUF CDFMNU BUFSIZ / CDFMNU /A025 DCA MUBUF+MNIBUF+BUFSIZ / TERMINATE THE FILE NAME /A025 / TAD (MUBUF+MNIBUF) / TELL FILNAM WHERE TO LOOK CDFMNU DCA I (MUBUF+MNPOS / /M036 AC0001 DCA I (MUBUF+MNTMP1) CDFMYF / CIFMNU JMS I MNUCAL DLMAD6 / CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF / SMA CLA / ++++ JMP AXRT2 / FILE EXISTS IF +1 AND DOESNT IF -1 / CIFMNU JMS I IOACAL / PUT UP ERROR MESSAGE 0 LOGER1 0 1205 / USE MULTIPLE LINES SO WE CAN SEE /A034 1405 / COMPLETE DOC. NAME /A034 LDSTAD 1605 / /A034 / CIFMNU JMS I IOACAL 0 LOGER2 2005 / /A034 / JMP AXRT4 AXRT3, CIFSYS / ++++ JWAIT AXRT4, CIFSYS / ++++ XLTIN JMP AXRT3 / TAD (-EDNWLN) SNA CLA / ++++ JMP AXGLD / ACT IF A GOLD MENU RETURN - GO TO MAIN TAD (7) JMP AXRT5 AXRT6, CIFSYS / ++++ JWAIT AXRT5, CIFSYS / ++++ TTYOU JMP AXRT6 JMP AXRT4 AXRT2, CDFMNU / COPY THE DOCUMENT NUMBER TAD I (MUBUF+MNFNO) CDFMYF / DCA LOGNO AXRT7, TAD LOGNO / GET THE LOG DOC #. /A015 CDFMNU / STICK LOG FILE # INTO MENU FIELD. THIS/A015 DCA I (MUBUF+MNLOCK) / WILL EFFECTIVLY LOCK IT FROM UPDATE! /A015 CDFMYF / BACK TO MY FIELD /A026 ISZ AXDIS / OK SKIP RETURN MEANS CONTINUE AXGLD, CLA / IF USER TYPED GM TAD (RXEWT+2000) / DO A WRITE JMS AXDST / CDIEDT JMP I AXDIS / / AXLRT - UNLOCK THE LOG FILE / /AXLRT, XX /D018 /D014;/ /D014; IFDEF WS102 < /D014; CDFMYF /D014; CIFPRT /D014; JMS I (ULKFIL) /D014; LOGNO /D014; USERNO /D014;/ /D014; > /D014;/ / CLA /D018 /D015; CDFMNU / CHANGE TO MENU FIELD. /A014 /D015; DCA I (MUBUF+MNLOCK) / CLEAR MENU LOCK WORD. /A014 / CDIEDT /D018 / JMP I AXLRT /D018 / PAGE / / THE VALUES RETURNED BY THE MENU / DLVAL=1 IDVAL=DLVAL+1 LDVAL=IDVAL+1 WPVAL=LDVAL+1 BPVAL=WPVAL+1 / / THIS WILL DISPLAY THE MAIN AX MENU AXDS2A, / NEW LABEL /A033 / JMS AXDIL / DISPLAY THE LIST / MESFT2 0305 0405 IDSTAD / MESFT3 0605 0705 LDSTAD / MESFT4 1105 1205 WPSTAD / MESFT5 1405 1505 BPSTAD / MESFT1 1705 2005 DLSTAD / 0 / / / THE MENUS THAT ARE USED FOR THE COMMUNICATIONS SETTINGS / JMS A19SET / LIMIT INPUT TO 64 CHARS. /A034 CIFMNU / DISPLAY THE MENU PORTION JMS I MNUCAL DLMA19 / AXDS7, TAD T1 / RESTORE INPUT BUFFER LENGTH /A034 CDFMNU DCA I (MUBUF+MNILEN) / /A034 /D034 CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF / DCA AXDT6 / SAVE THE VALUE OF TEMP1 / TAD AXDT6 / USE THE VALUE TO GET THE ACTION / TAD (JMP I AXTBL) / USE THE VALUE IN MNTMP1 FOR AN INDEX TO THE DCA .+1 XX / ROUTINE TO CALL / AXDS4, CLA TAD AXDT6 TAD (AXPBA-1) DCA AXDT4 / COPY THE INPUT INTO THE CORRECT AREA TAD I AXDT4 DCA AXDT4 / CDFMNU / WANT TO COPY THE INPORTANT INFORMATION ONLY TAD I (MUBUF+MNPOS / /M036 CDFMYF / DCA AXDT5 / AXDJ2, CDFMNU TAD I AXDT5 / STRIP ANY LEADING SPACES CDFMYF / TAD (-40) SZA CLA / ++++ JMP AXDJ1 ISZ AXDT5 JMP AXDJ2 / AXDJ1, JMS CUCOPY AXDT5, XX CDFMNU AXDT4, XX CDFMYF BUFSIZ+1 / COPY THE LARGEST PLUS 1 / AC0100 / BUT A ZERO WORD ON THE END INCASE THE STRING TAD AXDT4 / TOO BIG DCA T1 DCA I T1 / AC0001 / ++++ DCA AXDCF / SET THE MODIFY FLAG / AXDS5, TAD MNUFLG / IF SET TO NOT ZERO DISPLAY THE SECOND MENU SNA CLA / ++++ JMP AXDS2 AXDS9, AC0001 / ++++ DCA MNUFLG / JMS A19SET / LIMIT INPUT TO 64 CHARS. /A034 CIFMNU JMS I MNUCAL DLMA20 / JMP AXDS7 / SEE WHAT WAS RETURNED AXMDL, CDFMNU / THE DEFAULT LIST TAD I (MUBUF+MNTMP2) CDFMYF / SNA SPA CLA / ++++ JMP AXMD1 / IF MINUS OR ZERO NOTHING THERE / CDFMNU TAD I (MUBUF+MNFNO) CDFMYF / AXMD1, DCA DLNO JMP AXDS4 / COPY THE NAME AXDGM, TAD MNUFLG / IF GM TYPED FROM THE SECOND MENU THEN DISPLAY THE FIRST SNA CLA / ++++ JMP AXGLD / IF IN THE FIRST RETURN TO MAIN MENU JMP AXDS2 / / THESE ADDRESS ARE THE LIST OF ROUTINES THAT CAN BE CALLED BY USING THE / VALUE IN MNTMP1 FOR AN OFFSET FOR THE LIST / AXTBL, AXRTX / 0START THE COMMUNICATIONS AXMDL / 1DEFAULT LIST DOCUMENT AXDS4 / 2ID MESSAGE AXDLG / 3LOG DOCUMENT AXDS4 / 4WRITE PASSWORD AXDS4 / 5READ/WRITE PASSWORD AXDS3 / 6TEST LIST AXDS5 / 7RE-DISPLAY THE MENU AXDGM / 10 GOLD MENU TYPED FROM THE MAIN COM MENUS AXDS9 / 11 NO RESPONSE TO FIRST COM MENU / / THIS IS THE TABLE OF ADDRESS FOR THE COMMUNICATIONS SETTINGS. THAT ARE / USED BY THE COPY COMAND USING THE POSITIVE NON ZERO VALUE FROM MENU IN TMP1 / AXPBA, DLSTAD IDSTAD LDSTAD WPSTAD BPSTAD / MNUFLG, 0 / IF ZERO DISPLAY THE FIRST MENU IF 1 THEN THE SECOND AXDT6, 0 / TEMP FOR TEMP1 FORM MENU / PAGE / / DISPLAY THE DEFAULT SETTINGS / / CALL: / JMS AXDIL / IOA TEXT STRING ADDRESS / AX1 / ARG2 / ADDRESS OF BUFFER IF CONTENTS IS ZERO THEN NOT DISPLAYED / TERMINATOR = 0 / / THE ROUTINE CAN BE CALLED WITH TRIPPLES ENDING WITH A 0. / AXDIL, XX AXDLP, TAD I AXDIL / GET THE FIRDT ARG AND CHECK FOR TERMINATOR ISZ AXDIL SNA / ++++ JMP I AXDIL DCA AXDT1 / TAD I AXDIL / GET THE SECOND ARG ISZ AXDIL DCA AXDT2 / TAD I AXDIL / THE THIRD ARG ISZ AXDIL DCA AXDT3 / TAD I AXDIL / GET THE BUFFER ADDRESS IF CONTENTS IS ZERO DONT DISPLAY ISZ AXDIL DCA AXDT7 / TAD I AXDT7 / SEE IF IT IS TO BE DISPLAYED / SNA CLA / ++++ JMP AXDLP / CIFMNU JMS I IOACAL 0 AXDT1, XX AXDT2, XX AXDT3, XX AXDT7, XX / JMP AXDLP / / PROCESS THE LOG DOCUMENT / AXDLG, CDFMNU TAD I (MUBUF+MNPOS / GET POINTER TO STRING /M036 DCA AXDLT / CAN ONLY BE DONE SINCE ON THE SAME PAGE / / The following check removes the leading space if the Log Document / name is entered using the short form (ie LD DOCUMENT) TAD I AXDLT / GET FIRST CHAR IN INPUT STRING /A021 TAD (-40 / IS IT A SPACE (40)? /A021 SNA CLA / SKIP IF: NOT A SPACE /A021 ISZ AXDLT / FIRST CHAR IS A SPACE, BUMP /A021 / POINTER TO FIRST VALID CHAR /A021 / TAD I (MUBUF+MNFNO) / GET THE DOCUMENT NUMBER CDFMYF / DCA LOGNO / JMS CUCOPY / FIRST COPY OVER THE NAME TYPED IN AXDLT, XX CDFMNU LDSTAD CDFMYF BUFSIZ+1 / DCA LDSTAD+BUFSIZ / THIS MAKES SURE OF A ASCIIZ STRING / CDFMNU / CHECK THE STATUS MNTMP2 TAD I (MUBUF+MNTMP2) / IF + = DOCUMENT EXISTS, 0 = CREATE, - = NOTHING CDFMYF / SMA SZA / ++++ JMP AXDL2 SZA CLA / ++++ JMP AXDL3 / JMS AXDL5 / BEFORE CREATING THE DOCUMENT, CHECK /A024 / THAT THE NAME IS .LT. OR .EQ. TO 64 /A024 / CHARACTERS /A024 / AXDL3, DCA LOGNO JMP AXDS5 AXJ1E, /ROUTINE CLEARS LOG # & NAME IF CANNOT CREATE /D021 CLA /CLEAR AC /A007 AC0004 / PUT UP CANNOT CREATE MESSAGE CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF / / The following 2 instructions were moved from AXJ1E to here in order / that the CLA could be removed to save room /M021 DCA LOGNO /CLEAR LOG DOCUMENT NUMBER /A007 DCA LDSTAD /CLEAR LOG DOCUMENT NAME /AOO7 / CIFMNU JMS I MNUCAL DLMAD7 / JMP AXGLD AXDL2, AC0002 / DOCUMENT EXISTS SO PUT UP THE HOW TO MODIFY MENU / CDFMNU DCA I (MUBUF+MNTMP1) CDFMYF / JMS A19SET / LIMIT INPUT BUFFER TO 64 CHARS /A034 CIFMNU JMS I MNUCAL DLMAD6 / TAD T1 / RESTORE INPUT BUFFER LENGTH /A034 CDFMNU DCA I (MUBUF+MNILEN) / /A034 AC7776 / FIRST CHECK FOR GOLD MENU TAD I (MUBUF+MNTMP1) CDFMYF / SNA CLA / ++++ JMP AXDL4 / CDFMNU TAD I (MUBUF+MNTMP2) / GET THE OPEN TYPE CDFMYF / DCA LOGMOD / SAVE THE VALUE / JMP AXDS5 / AXDL4, DCA LOGNO / CLEAR THE NUMBER DCA LDSTAD / AND THE DISPLAY / / Need room - now fall through and use same return as does AXDS3 /M021 /D021 JMP AXDS2 / / AXDS3 - CHECKS THE LIST DOCUMENT FOR VALID ENTRYS / AXDS3, JMP AXDS2 / NORMAL RETURN MESFT1, IFDEF ENGLSH < TEXT '^P&THE DEFAULT LIST IS:^P^A' > / / CHANGED FOR ROOM / IFDEF CANADA < TEXT "^P&LA LISTE ATTRIBU[E PAR D[FAUT:^P^A" > /L.A.E, L.A.E / IFDEF ITALIAN< TEXT /^P&LISTA STANDARD:^P^A/ > IFDEF CANADA < TEXT "^P&FAUTE DE LISTE:^P^A" > IFDEF FRENCH < TEXT "^P&FAUTE DE LISTE :^P^A" > IFDEF DUTCH < TEXT "^PAANNAME L[ST :^P^A" > IFDEF GERMAN < TEXT "^P&ANGENOMMENE &LISTE:^P^A" > IFDEF NORWAY < TEXT '^P"&DEFAULT"-LISTEN ER:^P^A' > IFDEF SWEDSH < TEXT '^P"&DEFAULT"-LISTAN [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P"&DEFAULT"-LISTEN ER:^P^A' > IFDEF V30SWE < TEXT '^P&SK\VNSV\DRDESLISTAN \DR: ^P^A'> / / PAGE / / ERROR MESSAGES FOR THE LOG DOCUMENT ERROR DISPLAY IN AXDIS / LOGER2, IFDEF ENGLSH < TEXT '^P&PRESS &R&E&T&U&R&N FOR THE &MAIN &MENU.' > IFDEF ITALIAN< TEXT /^P&PREMERE !&RITORNO PER TORNARE AL &MENU &PRINCIPALE./> IFDEF CANADA < TEXT "^P&APPUYER SUR &RETOUR POUR RAPPELER LE &MENU." > IFDEF FRENCH < TEXT "^P&APPUYER SUR &RETOUR POUR RAPPELER LE &MENU" > IFDEF DUTCH < TEXT "^P&RETURN INTOETSEN VOOR &HOOFD &MENU" > IFDEF GERMAN < TEXT "^P&MIT &RETURN ZUR]CK ZUM &HAUPT &MEN]" > /L.U.U, L.U.U IFDEF NORWAY < TEXT "^P&TRYKK &RETUR FOR ] F] &HOVEDMENYEN." > /L.D.A, L.D.A IFDEF SWEDSH < TEXT "^P&TRYCK P] &RETUR F\R ATT F] &HUVUDMENYN." > /L.D.A, L.U.O, L.D.A IFDEF DANISH < TEXT "^P&TRYK &RETUR FOR AT F] &HOVEDMENUEN." > /L.D.A IFDEF V30SWE < TEXT "^P&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY"> / LOGER1, IFDEF ENGLSH < TEXT '^P!E^P&LOG &DOCUMENT^P^A^PDOES NOT EXIST,' > IFDEF ITALIAN< TEXT /^P!E^P&PROCEDURA DI COLLEGAMENTO^P^A^PNON ESISTE,/> IFDEF CANADA < TEXT "^P!E^P&LE DOCUMENT-R[PERTOIRE ^A N'EXISTE PAS," > IFDEF FRENCH < TEXT "^P!E^P&LE DOCUMENT ^A N'EXISTE PAS," > IFDEF DUTCH < TEXT "^P!E^P&LOGBOEK ^A BESTAAT NIET," > IFDEF GERMAN < TEXT "^P!E^P&LOG &DATEI ^A EXISTIERT NICHT,"> IFDEF NORWAY < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EKSISTERER IKKE.' > IFDEF SWEDSH < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EXISTERAR INTE.' > IFDEF DANISH < TEXT '^P!E^P"&LOG"-DOKUMENT ^A EKSISTERER IKKE.' > IFDEF V30SWE < TEXT '^P!E^P"&INLOGGNINGSDOKUMENTET ^P^A^P FINNS INTE'> / / / CLASIX - INITALIZE THE VALUES IN REDSIX AND WRISIX / CLASIX, XX CLA RDF / IF CROSS FIELD CALLED MAKE SURE RETURNS CORRECTLY TAD CIDF0 DCA CLASXX / CDFMYF DCA WRSHIF / WRITE SHIFT FLAG DCA WRIVBF / VERTICAL BAR ESCAPE FLAG DCA WRIBES / ESCAPE / DCA REDNXT / BUFIF RETURNING A 2 CHARACTER ESCAPE THE SECOND CHARACTER / IS STORED HERE FOR NEXT CALL DCA REDESF DCA REDSHF DCA REDSXC / CLASXX, XX JMP I CLASIX / / AXCRT - CREATE THE DOCUMENT TO RECEIVE / AXCRT, CLA TAD AXSRT2 / IF RECEIVE RETURN ERROR SZA CLA / ++++ JMP AXSNO JMS ADRCRT JMP AXSNO / DCA AXSRNO DCA AXSRMO / TAD ("C-200) / SET THE MOD VALUE FOR LOG DOCUMENT IF SET FOR / AX AND LOG IN AFFECT DCA CUPMOD / JMP AXSROK / RETURN / / THE ROUTINE WILL SEND THE CHARACTER IN THE AC TO THE SCREEN / DELDIS, XX JMP DELDI2 DELDI1, CIF 0 / ++++ JWAIT DELDI2, CIF 0 / ++++ TTYOU JMP DELDI1 CLA JMP I DELDIS / / SPTEST - SEE IF THE SPFLAG IS SET WHICH MEANS TO RETURN / SPTEST, /M018 XX CLA CDFEDT TAD I (SPFLAG) CDFMYF / SNA CLA ISZ SPTEST JMP I SPTEST / / PART OF WRISIX / WRSEND, /A018 XX /A018 CLA /A018 TAD T1 / IF ZERO THEN ENO OF FILE /A018 SZA CLA /A018 JMP I WRSEND /A018 TAD (74) / END OF DOCUMENT IN UPPER CASE /A018 CIFFIO /A018 FILEIO /A018 XPUTSB /A018 CLA /A018 JMP I WRSEND /A018 PAGE / / AXDST - WILL READ OR WRITE THE COMMUNICATIONS SETTINGS DEPENDING ON THE / VALUE IN THE AC. THE AC CONTAINS THE FUNCTION TO EXECUTE. / AXDST, XX DCA QUQBLK+RXQFNC / SET THE FUNCTION / CDFMYF TAD .-1 / SET THE BUFFER FIELD DCA QUQBLK+RXQBFD / /D035 TAD USERNO / SET THE DRIVE /D035 TAD USERNO DCA QUQBLK+RXQDRV / TAD (DLDCOM) / SET THE BLOCK TO READ DCA QUQBLK+RXQBLK / TAD (DFCOMA) / SET THE BUFFER TO READ INTO DCA QUQBLK+RXQBAD / JMS QURX / GET THE BLOCK CLA / ISZ QUQBLK+RXQBLK / GET THE NEXT BLOCK / TAD (DFCOMA+400) DCA QUQBLK+RXQBAD / JMS QURX CLA / JMP I AXDST / / AXSNO - SENDS THE NO RESPONSE / THIS IS PART OF AXSR ROUTINE / AXSNO, JMS AXSRPK NOANS TYPNO / JMP AXSNOX / / / AXSRPK - SENDS A PACKET USING AXSNP. IT USES THE SAME CALL MINUS THE ERROR RETURNS / THIS ROUTINE CAN ONLY BE CALLED BY THE AXSR ROUTINE / / CALL / JMS AXSRPK / ADDRESS OF TEXT PART / TYPE OF PACKET / AXSRPK, XX TAD I AXSRPK ISZ AXSRPK DCA AXSRP1 / TAD I AXSRPK ISZ AXSRPK DCA AXSRP2 / JMS AXSNP AXSRP1, XX AXSRP2, XX / JMP AXSNOX / SPFLAG RETURN JMP AXSNOX / TIMED OUT / JMP I AXSRPK / / AXSNO2 - SEND LIST NOT IMPLEMENTED YET MESSAGE IF THE USER TRIES TO USE / ALIST SPECIFICATION. / AXSNO2, JMS AXSRPK NOEXST TYPNO / JMP AXSNOX / NOEXST, IFDEF ENGLSH < "L-200 / L "I-200 / I "S-200 / S "T-200 / T " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T " -200 / Space "O-200 / O "P-200 / P "T-200 / T "I-200 / I "O-200 / O "N-200 / N " -200 / Space "N-200 / N "O-200 / O "T-200 / T " -200 / Space "I-200 / I "M-200 / M "P-200 / P "L-200 / L "E-200 / E "M-200 / M "E-200 / E "N-200 / N "T-200 / T "E-200 / E "D-200 / D 0000 > IFDEF ITALIAN < "O-200 / O "P-200 / P "Z-200 / Z "I-200 / I "O-200 / O "N-200 / N "E-200 / E " -200 / SPACE "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / SPACE "L-200 / L "I-200 / I "S-200 / S "T-200 / T "A-200 / A " -200 / SPACE "N-200 / N "O-200 / O "N-200 / N " -200 / "I-200 / I "M-200 / M "P-200 / P "L-200 / L "A-200 / A "M-200 / M "E-200 / E "N-200 / N "T-200 / T "A-200 / A "T-200 / T "A-200 / A 0000 > / / THIS ROUTINE WILL CHANGE THE BUFFER LENGTH IN THE MENU FIELD /A034 / AND SAVE THE OLD VALUE IN T1. /A034 / UPON RETURN FROM THE MENU CALL THE OLD VALUE MUST BE RESTORED /A034 / A19SET, XX / /A034 CLA / /A034 CDFMNU / /A034 TAD I (MUBUF+MNILEN) / FETCH VALUE USED BY THE SYSTEM /A034 CDFMYF / /A034 DCA T1 / SAVE HERE /A034 TAD (-BUFSIZ-1 / THIS WILL LIMIT INPUT TO 64 CHARS. /A034 CDFMNU / /A034 DCA I (MUBUF+MNILEN) / INTO MENU AREA /A034 CDFMYF / /A034 JMP I A19SET / /A034 / PAGE / / AXEC - WILL CONNECT THE DX USER TO THE AX SYSTEM. IT / WILL PROMPT FOR THE INFORMATION NEEDED TO CONNECT. / AXEC, XX CLA / CDFEDT TAD I (GETBUA) / GET THE ADDRESS OF GET AND PUT BUFFER / DCA GETBUF / TAD I (PUTBUA) DCA PUTBUF CDFMYF / TAD (OPTALL) / SET THE OPTIONS TO ALL INITALLY DCA OPTFLG / /D016; CIFMNU /D016; JMS I IOACAL / PUT UP THE MESSAGE OF CONNECTION /D016; 0 /D016; TRYCON /D016; 505 /D016; 2700 / AXSG2, TAD IDSTAD / SEE IF THERE IS AN ID MESSAGE TO SEND SNA CLA / ++++ JMP AXECJ / JMS AXSPK / SEND THE MESSAGE IDSTAD TYPMES / CLA JMP AXECJ AXECX, CLA TAD OPTFLG / RETURN THE DX USER OPTIONS / CDIEDT ISZ AXEC / A2- SKIP RETURN IF OK ISZ AXEC JMP I AXEC AXSP, ISZ AXEC / GO AND WAIT FOR SOMETHING TO DO BUT DONT CONTINUE / THE CONNECTION SEQUENCE AXTO, CLA CDIEDT / RESTART AFTER A TIME OUT / JMP I AXEC AXFLE, 0 / / AXSPK - SENDS A PACKET AND TAKES CARE OF ALL THE ERROR RETURNS / FOR AXEC ROUTINE. IT CALLS AXSNP / AXSPK, XX CLA / Clear the AC TAD I AXSPK / Get the pointer to the message list ISZ AXSPK / Set to skip it on return DCA AXSPK1 / Store the argument / TAD I AXSPK / Get the Next argument ISZ AXSPK / Set to skip it on return DCA AXSPK2 / Store this argument too / JMS AXSNP / Send the packet AXSPK1, XX / Message address AXSPK2, XX / Second parameter / JMP AXSP / MAIN MENU SAID RETURN JMP AXTO / TIMED OUT TRYING TO SEND / JMP I AXSPK / Return / / / AXEJC - CLEARS THE DX USERS SCREEN AFTER A BAD PASSWORD TYPED / AXEJC, CLA TAD (-TRYPSW) / SEE IF THERE WAS A MISTAKE MADE TAD AXPCN SNA CLA / ++++ JMP AXEJ3 / JMS AXSPK CLAMES TYPMES / JMP AXEJ3 / / USED AXSR TO GET THE NAME OF THE DOCUMENT AND THE DRIVE NUMBER / AXSRFD, XX CLA CDFMNU TAD I (MUBUF+MNDRV) CDFMYF / DCA CUPDRV / JMS CUCOPY / NOW THE NAME MUBUF+MNIBUF CDFMNU CUPFNM CDFMYF BUFSIZ+1 / JMP I AXSRFD / / THIS ROUTINE CHECKS TO MAKE SURE THAT THE LD NAME TO BE CREATED IS / .LT. OR .EQ. TO 64 CHARACTERS IN LENGTH. IF LONGER, TRUNCATE THE / NAME TO BE 64 CHARACTERS IN LENGTH, AND THEN CHECK TO SEE IF THIS / FILE ALREADY EXISTS. AXDL5, /A024 XX / RETURN ADDRESS /A024 CDFMNU / /A029 TAD (MUBUF+MNIBUF) / POINTER TO THE INPUT STRING /A029 CIA / MAKE NEG FOR COMPARE /A029 CDFMYF / /A029 TAD AXDLT / TO START OF LOG DOC NAME /A029 TAD (100) / POINT TO 65TH CHAR /A028 CDFMNU / /A028 TAD (MUBUF+MNIBUF) / IN THE INPUT STRING (LD NAME) /A028 DCA TEMP / AND SAVE THE POINTER /A028 TAD I TEMP / GET THE 65TH CHAR /A028 SPA SNA CLA / SKIP IF: NON-VALID TERMINATOR /A028 JMP AXDL6 / VALID TERMINATOR /A028 DCA I TEMP / INSERT THE LD TERMINATOR /A028 AC0001 / /A027 CDFMNU / MENU FIELD /A027 DCA I (MUBUF+MNTMP5) / SIGNIFIES MENU TO CHECK FILENAME /A027 DCA I (MUBUF+MNTMP3) / CLEAR TMP3 /A028 CDFMYF / MY DATA FIELD /A027 CIFMNU / /A027 JMS I MNUCAL / /A027 DLMDU7 / CHECK TO SEE IF FILE EXISTS /A027 CDFMNU / RESULT OF CHECK /A027 TAD I (MUBUF+MNTMP3) / IS IN MNTMP3 /A027 CDFMYF / BACK TO MY FIELD /A027 SMA CLA / SKIP IF: DOCUMENT DOES NOT EXISTS /A027 /D030 JMP AXDL2 / DOCUMENT EXISTS, ASK HOW TO MODIFY /A027 JMP AXDL7 / DOC. EXISTS, FETCH LOGNO /A030 AXDL6, CDFMYF / BACK TO MY FIELD /A027 JMS ADRCRT / CREATE THE DOCUMENT /M024 JMP AXJ1E / ERROR /M024 JMP I AXDL5 / RETURN TO CALLER /A024 / TEMP, 0 / POINTER TO LD NAME /A024 AXDL7, CLA / .... /A030 CDFMNU / MENU FIELD /A030 TAD I (MUBUF+MNFNO) / FETCH LOGNO /A030 CDFMYF / THIS FIELD /A030 DCA LOGNO / SAVE THE DOC. NUMBER /A030 JMP AXDL2 / NOW ASK HOW TO MODIFY /A030 PAGE / / AXECJ - WILL CHECK FOR A VALID PASSWORD / AXECJ, TAD BPSTAD / SEE IF EITHER PASSWORD IS SET TAD WPSTAD SNA CLA / ++++ JMP AXEJ3 / TAD (TRYPSW) / ++++ DCA AXPCN / SET THE LIMIT ON PASSWORD TYRS / AXEJ1, JMS AXSPK / ASK FOR THE PASSWORD PASPMT TYPPNE / AXEJ2, JMS WAITDT / WAIT FOR A STX JMP AXSP / RETURN THE MAIN PROGRAM SAYS TO JMP AXTO / TIMED OUT WAITENG / TAD (-TYPPAN) / CHECK FOR PASSWORD SZA CLA / ++++ JMP AXEJ2 / JMS AXSAM / CHECK FOR EQUAL JMP AXDNO / JMP AXEJC / AXDNO, ISZ AXPCN JMP AXEJ5 / JMS AXSPK / ILLEGAL USER ILLUSE TYPMES / JMP AXSP AXEJ5, JMS AXSPK / TELL THE USER HE TYPED THE WRONG PASSWORD BADPAS TYPMES / JMP AXEJ1 / / AXEJ3 - ASKS FOR IDENTIFICATION / AXEJ3, CLA TAD LOGNO / SEE IF IT IS NEEDED SNA CLA / ++++ JMP AXECX / JMS AXSPK / SEND THE PROMPT IDPMT TYPPMT AXEJ4, JMS WAITDT / WAIT FOR A LEGAL STX JMP AXSP / RETURN SINCE SPFLAG IS SET JMP AXTO / TIMED OUT / TAD (-TYPPAN) / LOOKING FOR AN ANSWER TO THE PROMPT SENT SZA CLA / ++++ JMP AXEJ4 / JMS CUCOPY / STORE THE ID INMBLK+1 CDFMYF AXIDB CDFMYF BUFSIZ / JMP AXECX / DONE FOR NOW RETURN TO WPTRNS / / AXSNP - SENDS A PACKET . / / CALL / JMS AXSNP / TYPE VALUE / ADDRES OF THE TEXT PART / / SPFLAG SET RETURN / TIMED OUT / / OK / AXSNP, XX CLA TAD I AXSNP / GET THE STARTING ADDRESS OF THE MESSAGE ISZ AXSNP / Set to skip it on return DCA AXST2 / Store it for send / JMP AXSNG AXSNW, CIFSYS / ++++ JWAIT JMS SPTEST / SEE IF THE MAIN PROGRAM SAID STOP JMP I AXSNP / SPFLAG SET MUST RETURN AXSNG, CIFEDT JMS I GETBUF / ++++ FREEPT / GET A BUFFER JMP AXSNW DCA AXSNT / SAVE THE STARTING ADDRESS / TAD AXSNT / CLEAR A FEW LOCATIONS DCA X1 CDFEDT DCA I X1 / THE STATUS DCA I X1 / THE SEQ. CDFMYF / TAD I AXSNP / GET THE TYPE CHARACTER ISZ AXSNP / CDFEDT DCA I X1 CDFMYF AXSNL, TAD I AXST2 / GET A CAHRACTER ISZ AXST2 SNA / ++++ JMP AXSNZ CDFEDT DCA I X1 CDFMYF JMP AXSNL AXSNZ, CDFEDT DCA I X1 / INSERT THE TRAILER CDFMYF / TAD AXSNT / SEND THE BUFFER CIFEDT JMS I PUTBUF / ++++ SENDPT / AC0001 TAD AXSNT DCA AXSNS / GET THE STATUS POSITION JMP AXSNB / TEST IT AXSNJ, CIFSYS / ++++ JWAIT JMS SPTEST / ++++ JMP AXSN2 AXSNB, CDFEDT TAD I AXSNS / CHECK FOR DONE CDFMYF SNA / ++++ JMP AXSNJ DCA AXST2 AXSN2, / TAD AXSNT / RELEASE THE BUFFER CIFEDT JMS I PUTBUF / ++++ FREEPT JMS SPTEST / ++++ JMP I AXSNP / SEE IF HAVE TO RETURN TAD AXST2 SMA CLA / ++++ ISZ AXSNP / TIMED OUT ISZ AXSNP JMP I AXSNP / PAGE / / THIS IS THE SEND/RECEIVE PART OF AX. THE AC IS = 0 FOR RECEIVE AND 1 = SEND / ON RETURN THE AC = DOCUMENT NUMBER AND THE MQ = MOD TYPE / / CALL / CIFBUF / JMS I AXSR / ADDRESS OF THE POINTER TO THE PACKET RECEIVED / / NO RETURN / YES / AXSR, XX / DCA AXSRT2 / STORE THE VALUE OF THE ROUTINE CALLED IF 0 = RECEIVE / AND 1 = SEND / TAD I AXSR / GET THE BUFFER ISZ AXSR / THE DATA FIELD IS STILL SET FOR THE CALLING FIELD / CDFMYF / DCA AXSRT3 / SAVE THE ADDRESS OF THE DOCUMENT NAME DCA AXSRNO / CLEAR THE DOCUMENT NUMBER DCA AXSRMO / AND THE MODIFICATION CODE FOR RECEIVE DCA CUPMOD / CLEAR FOR LOG DOCUMENT SO NO OLD INFO IS LEFT AROUND DCA CUPDRV DCA CUPFNM / JMS CUCOPY / COPY THE NAME PART TO SEE IF VALID NAME AXSRT3, XX CDFEDT MUBUF+MNIBUF CDFMNU BUFSIZ+1 / TAD (MUBUF+MNIBUF) / SET THE MENU'S POINTERS FOR THE BUFFER / CDFMNU DCA I (MUBUF+MNPOS / /M036 DCA I (MUBUF+MNTMP1) TAD AXSRT2 / GET AXRS MODE (0/1) /A017 DCA I (MUBUF+MNTMP2) / SAVE FOR MENU TO ALLOW SEND LOG /A017 CDFMYF / / IF TRIES TO RECEIVE A LIST TAD (MUBUF+MNIBUF-1) DCA X1 / AXSRL8, CDFMNU TAD I X1 CDFMYF / TAD (-40) / SKIP LEADING SPACES SNA / ++++ JMP AXSRL8 TAD (40-"@+200) SNA CLA / ++++ JMP AXSNO2 / CIFMNU JMS I MNUCAL / LET THE MENU CHECK FOR A VALID NAME DLMAD6 / JMS AXSRFD / GET THE NAME AND DRIVE / CDFMNU TAD I (MUBUF+MNTMP1) / GET THE RETURN VALUE CDFMYF / SNA / ++++ JMP AXCRT / SEE IF RECEIVE CREATE IT TAD (-1) SZA CLA / ++++ JMP AXSNO / IF ANYTHING BUT EXITST THEN SEND A NO / CDFMNU TAD I (MUBUF+MNFNO) / GET THE DOCUMENT NUMBER CDFMYF DCA AXSRNO / TAD AXSRT2 SZA CLA / ++++ JMP AXSROK TAD (TBOPT) / IF EXISTS THEN SEND A OPTION PACKET IF RECEIVE DCA ANSBUF / JMS AXSRPK / SEND THE PACKET ANSBUF / STARTING ADDRES OF TEXT PART TYPMOD / TYPE / JMS WAITDT / WAIT FOR A RESPONSE JMP AXSNOP / NO RETURN /M018 JMP AXSNOP / TIMED OUT /M018 / TAD (-TYPPAN) / WAIT FOR RESPONSE IF GET SOMETHING ELSE SEND NO SZA CLA / ++++ JMP AXSNOP /M018 / TAD INMBLK+1 / GET THE RESPONSE TAD (-40) / CHECK FOR GOLD MENU SNA / ++++ JMP AXSNOP /M018 TAD (-2) / 40 = GM;41 = -1(OVERWRITE);42 = 0(TOP);43 = 1 (BOTTOM) / DCA AXSRMO / TAD AXSRMO / SET THE VALUE FOR THE LOG DOCUMENT OF MODIFY SNA CLA / ++++ IFDEF ENGLSH < TAD ("T-"B) /M023 TAD ("B-200) /M023 > IFDEF ITALIAN < TAD ("I-"F) /M023 TAD ("F-200) /M023 > IFDEF V30SWE < TAD ("T-"B) /M023 TAD ("B-200) /M023 > DCA CUPMOD AXSROK, CLA TAD AXSRNO / SEE IF DOC REQUESTED IS LOG DOC /A018 CIA /A018 TAD LOGNO /A018 SNA CLA /A018 / JMP AXSRO2 / JUMP IF OK /A018 / JMS CLFILE /A018 JMP AXSNO / SAY NO /A018 AXSRO2, /A018 TAD AXSRMO MQL TAD AXSRNO / THE AC = DOCUMENT NO AND THE MQ THE MODIFICATION / CDIEDT ISZ AXSR JMP I AXSR / RETURN AXSNOX, CLA CDIEDT JMP I AXSR AXSRT2, 0 / HAS TO BE ON THIS PAGE / ANSBUF, ZBLOCK 2 AXSRNO, 0 AXSRMO, 0 AXINDF, 0 / / MOVED TO ANOTHER PAGE /M018 / / SPTEST - SEE IF THE SPFLAG IS SET WHICH MEANS TO RETURN / /SPTEST, / XX / CLA / CDFEDT / TAD I (SPFLAG) / CDFMYF / / SNA CLA / ++++ / ISZ SPTEST / JMP I SPTEST / AXSNOP, CLA / CLOSE FILE (IT'S CURRENTLY OPEN) /A018 JMP AXSNOX / SEND 'NO' /A018 / PAGE / / AXSAM - COMPARES THE INPUT BUFFER TO THE PASSWORD / AXSAM, XX TAD BPSTAD / FIRST SEE IF THE READ/WRITE PWASSWORD IS SET SNA CLA / ++++ JMP AXSA2 / JMS AXCMP / COMPARE WHAT WAS SET TO WHAT IT IS BPSTAD INMBLK+1 / JMP AXSA2 / DOESNT MATCH / AC0001 / DOES MATCH SET THE OPTFLG / JMP AXSRT AXSA2, TAD WPSTAD / CHECK FOR WRITE PASSWORD SNA CLA / ++++ JMP I AXSAM / JMS AXCMP WPSTAD INMBLK+1 / JMP I AXSAM / DOESNT MATCH EITHER AXSRT, TAD (OPTBMS) / SET TO 43 TO NOT ALLOW READ DCA OPTFLG / 44 MEANS READ /WRITE ABILITY / ISZ AXSAM JMP I AXSAM / / AXCMP - COMPARES THE TEXT IN THE FIRST STRING WITH THE SECOND / IT RETURNS A MATCH IF THE SECOND ONE MATCHES THE FIRST. IT IS / NOT CASE DEPENDENT / CALL / JMS AXCMP / ADDRESS OF STRING ONE THE ONE IT HAS TO MATCH / ADDRESS OF THE STRING TO COMPARE / / DOESNT MATCH RETURN / MATCH RETURN / AXCMP, XX AC7777 TAD I AXCMP / GET THE FIRST STRINGS ADDRESS ISZ AXCMP DCA X1 / AC7777 TAD I AXCMP / GET THE STRING TO COMPARE ISZ AXCMP DCA X2 AXCPL, TAD I X1 SNA / ++++ JMP AXCPJ / JMS CNVUPR / CONVERT THE STRING TO CAPS CIA DCA AXCPT / TAD I X2 JMS CNVUPR TAD AXCPT SNA CLA / ++++ JMP AXCPL JMP I AXCMP AXCPJ, TAD I X2 / CK FOR EXTRA CHAR /A031 SNA CLA / IF PRESENT IT DOES NOT MATCH /A031 ISZ AXCMP JMP I AXCMP AXCPT, 0 / / CNVUPR - IF THE CHARACTER IN THE AC IS LOWER CASE IT IS CONVERTED TO UPPER / CNVUPR, XX TAD (-140) SPA / ++++ TAD (40) TAD (100) JMP I CNVUPR / / THE ROUTINE THAT MODIFIES THE FILE THAT KEEPS THE LOG IF WANTED / AXDON, XX CDFMYF CLA TAD LOGNO / SEE IF THE LOG IS WANTED SNA CLA / ++++ JMP AXDDN TAD LOGNO / OPEN THE LOG DOCUMENT MQL TAD LOGMOD CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKIN CLA / CDFMNU TAD I (DATESP) / GET THE ADDRESS OF THE DATE CDFMYF / DCA DATEAD / CIFMNU JMS I TIMCAL / SEE IF THE TIME HAS CHANGED NOP / JMS CUCOPY / COPY THE TIME TO THIS FIELD DATEAD, 0 CDFMNU AXTIM CDFMYF 26 / JMS CUPSH2 / SKIP OVER THE HEADER AND RULER STUFF / TAD AXSRNO / BREAK OUT FILE AND DRIVE NUMBERS AND P377 DCA CUPDAT CIFMNU JMS I IOACAL CUPOTD AXDMS CUPOS1 AXIDB CUPOS1 AXTIM CUPOS1 CUPFNM CUPOS3 CUPDRV CUPDAT, 0 CUPOS3 CUPMOD CUPOS3 CUPOS4 / CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKCL / AXDDN, TAD LOGMOD SPA CLA DCA LOGMOD CDIEDT JMP I AXDON CUPMOD, 0 / ++++ 0 / PAGE / / WAITING FOR SOMETHING TO BE SENT (RECEIVER) / WAITDT, XX CLA TAD (MIN3) / ++++ DCA DLYLIM JMP WAITDG / SEE IF THERE IS ANYTHING WAITDW, CIFSYS / ++++ JWAIT JMS SPTEST / ++++ JMP I WAITDT / SEE IF THE SPFLAG IS SET JMS GETTM SNA CLA / ++++ JMP WAITDG / NO CHANGE IN THE TIME CONTINUE ISZ DLYLIM / SECOND WENT BY CHOW OT JMP WAITDG ISZ WAITDT JMP I WAITDT / WAITED TOO LONG WAITDG, CIFEDT / SEE IF A PACKET HAS BEEN RECEIVED JMS I GETBUF / ++++ RECPT JMP WAITDW / DCA WAITDA / KEEP THE VALUE / AC0003 TAD WAITDA / GET THE START TO MOVE DCA WAITT1 / JMS CUCOPY / COPY THE BUFFER FOUND WAITT1, XX CDFEDT INMBLK CDFMYF BUFSIZ+1 / TAD WAITDA / DONE WITH THE BUFFER RETURN IT CIFEDT JMS I PUTBUF / ++++ FREEPT / TAD INMBLK ISZ WAITDT ISZ WAITDT / JMP I WAITDT / RETURN WITH THE FLAG CHARACTER WAITDA, 0 DLYLIM, 0 / / GET THE TIME CHANGE USING THE SYSTEMS CLOCK / IT RETURNS A 1 IF A SECOND WENT BY AND A 0 IF NO CHANGE / GETTM, XX CLA CDFSYS TAD I (CLOCK+2) / ++++ CIA CDFMYF / ACDF FOR THIS FIELD (MY FIELD) TAD TMPTME / COMPARE TO MY TIME FOR ANY CHANGE SNA / ++++ JMP I GETTM / NO CHANGE CIA / ++++ TAD TMPTME / IF CHANGE STORE THE NEW ONE DCA TMPTME AC0001 JMP I GETTM TMPTME, 0 / RDSIX1, TAD (74-41) / CHECK IF ALPHA SMA RDSIX3, TAD REDSHF / ADD IN SHIFT TAD (41+37) / CONVERT TO ASCII RDSIX2, DCA REDSXC / STORE IT JMP RDSIX4 / CLEAR ESCAPE FLAG AND RETURN / WRDWSF, TAD (40) / SHIFT TO LOWERCASE WRUPSF, DCA REDSHF / STORE NEW CASE JMP RDSIX4 / AND RETURN / REDSHF, 0 / SHIFT WORD REDSXC, 0 / TEMP THAT HOLDS THE CHARACTER TO RETURN / / THIS IS A CLOSE COPY OF THE WT78 REDSIX ROUTINE WHICH TOOK 6-BIT / INPUT AND STORED IT AS 7-BIT DATA. THIS ROUTINE WILL READ 6-BIT DATA FROM DISK / AND RETURN 7-BIT. / REDSIX, XX / CLA RDF TAD CIDF0 / MAKE CROSS FIELD CALLABLE DCA REDS2X DCA REDSXC / CLEAR THE CHARACTER TO RETURN BUFFER / CDFMYF / REDSIL, TAD REDNXT / SEE IF THERE IS A CHARACTER WAITING TO BE / RETURNED SNA / ++++ JMP REDSI2 / IF ZERO GET A CHAR IF NOT OUTPUT IT DCA T1 DCA REDNXT / CLEAR FLAG OUTPUT IT TAD T1 JMP RDSIX2 REDSI2, CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XRDFNB / GET A CHAR SNA SPA / ++++ JMP REDS2X / DONE OR AN ERROR SO RETURN DCA T1 / STORE UNTIL KNOW WHAT TO DO WITH IT TAD REDESF / SEE IF MIDDLE OF ESCAPE SZA CLA / ++++ JMP REDESC / YES TAD T1 TAD (-74) / SEE IF SPECIAL SPA / ++++ JMP RDSIX1 / NO, NORMAL SIXBIT CHAR SNA / ++++ JMP WRUPSF / SHIFT TO UPPERCASE TAD (74-75) / 75 ? SNA / ++++ JMP RDSIX4 / ILLEGAL, RETURN 0 TAD (75-76) / 76 ? SNA CLA / ++++ JMP WRDWSF / SHIFT TO LOWERCASE AC7777 / MUST BE ESCAPE RDSIX4, DCA REDESF / SET FLAG REDSXX, TAD REDSXC / IF CHARACTER IS ZERO THEN GET ANOTHER SNA / ++++ JMP REDSIL REDS2X, XX JMP I REDSIX / AND RETURN / REDESF, 0 / ESCAPE FLAG / PAGE / / THIS IS THE WT78 READ ROUTINE THAT READS 7-BIT CHARACTERS FROM THE DISK AND / TRANSLATES THEM TO 6-BIT. WHAT IT IS DOING HERE IS TAKING THE / 7-BIT INPUTAND STORING IT AS 6-BIT FOR THE WS SYSTEMS / WRISIX, XX DCA T1 / STORE CHARACTER RDF TAD CIDF0 DCA WRSI2X / CDFMYF TAD WRIVBF / SEE IF THE VERTICAL BAR FLAG IS SET SZA CLA / ++++ JMP WRIVB2 TAD WRIBES / NOW CHECK FOR LAST CHAR WAS A LEFT BRACKET ESCAPE CHAR SZA CLA / ++++ JMP WRIBE2 WRSIXE, CLA TAD WRICHR / SEE IF ANYTHING WAITING AROUND SZA / ++++ JMP WRSIX1 / YES GO PROCESS IT TAD T1 / NO, GET CHAR SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-173) / CHECK IF ESCAPE SEQUENCE SPA / ++++ JMP WRSIX5 / NO, NORMAL CHAR SNA CLA / WHICH TYPE ? JMP WRSIX2 / {ESCAPE AC0001 / ++++ DCA WRIVBF / SET FLAG JMP WRSIXX / RETURN WRIVB2, DCA WRIVBF / CLEAR FLAG TAD T1 SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-76) / SEE IF JUST SUPPOSED TO BE 173 - 176 SMA SZA / ++++ JMP WRSIX3 / NO, LOOK IN TABLE TAD (76+100) / MAKE INTO REAL ASCII JMP WRSIX1 / AND PROCESS AS NORMAL / WRSIX2, AC0001 / ++++ DCA WRIBES / SET FLAG FOR ESCAPE SEQUENCE JMP WRSIXX / RETURN WRIBE2, DCA WRIBES / CLEAR FLAG THAT GOT US HERE TAD T1 / GET THE NEXT CHARACTER OF ESCAPE SEQUENCE SNA / ++++ JMP WRSIXX / RETURN ON EOF TAD (-53) / MAKE SURE IT'S LEGIT SMA SZA / ++++ JMP WRSIXE / ERROR TAD (53-42) SPA / ++++ JMP WRSIXE / ERROR TAD (WRITA2) / COMPUTE TABLE ADDR JMP WRSIX4 / WRSIX3, TAD (76-117) / CHECK IF VALID TABLE ENTRY SMA SZA / ++++ JMP WRSIXE / ERROR TAD (117-107) SPA / ++++ JMP WRSIXE / ERROR TAD (WRITAB) / COMPUTE TABLE ADDR WRSIX4, DCA T1 TAD I T1 / PICK UP ENTRY WRSIX6, DCA WRICHR / SAVE AS NEXT CHAR TAD (77) / AND RETURN AN ESCAPE WRSIXX, SNA / ++++ JMP WRSI3X CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XPUTSB / STORE CHARACTER WRSI3X, TAD WRICHR / SEE IF ANOTHER TO STORE SZA CLA / ++++ JMP WRSIXE JMS WRSEND / END OF DOC. SO SHIFT TO UPPER /A018 WRSI2X, XX JMP I WRISIX / WRIVBF, 0 WRIBES, 0 WRICHR, 0 / WRSIXA, DCA WRICHR / CLEAR HOLD CHAR MQA / ++++ TAD (-37) / CONVERT TO SIXBIT JMP WRSIXX / AND RETURN / WRSIXC, TAD (61) JMP WRSIX6 WRSIX5, TAD (173) WRSIX1, MQL / ++++ MQA / SAVE CHAR IN MQ AND (100) / SEE IF SHIFTABLE SNA CLA / ++++ JMP WRSIXA / NO, CONVERT AND RETURN MQA / ++++ AND (40) / GET SHIFT BIT CIA / ++++ TAD WRSHIF / COMPARE WITH STATE WE'RE IN CLL SNA CLA / ++++ JMP WRSIXB / DIDN'T CHANGE MQA / ++++ AND (40) / STORE NEW STATE (SHIFT BIT) SZA / ++++ CML DCA WRSHIF RAL / FIGURE OUT IF NEED UPSHIFT OR DOWNSHIFT SZA / ++++ IAC TAD (74) DCA T1 / SAVE FOR A MINUTE MQA / ++++ DCA WRICHR / GET CHAR BACK AND SAVE FOR NEXT TIME TAD T1 / RETURN WITH SHIFT CODE JMP WRSIXX / WRSHIF, 0 / PAGE / / THESE TABLES ARE USED BY THE GET SEVEN BIT AND PUT SEVEN BIT ROUTINES / WRITAB, 66 46 45 52 66 / ILLEGAL 53 47 67 70 / WRITA2, 42 / ++++ 41 44 / ++++ 43 51 / ++++ 50 55 / ++++ 54 57 / ++++ 56 / REDTAB, 7343 / ++++ 7342 / TABLE TO CONVERT SIXBIT TO WPW 7-BIT 7345 / ++++ 7344 7411 7410 7415 7347 / ++++ 7346 7412 7414 7351 / ++++ 7350 7353 / ++++ 7352 7407 / ILLEGAL 133 134 135 136 137 7407 7416 7417 / / MESSAGES / CLASCR, TEXT '^P!E' / MESFT2, IFDEF ENGLSH < TEXT '^P&IDENTIFICATION MESSAGE IS:^P^A' > /M022 IFDEF ITALIAN< TEXT /^P&MESSAGGIO IDENTIFICAZIONE SISTEMA:^P^A/ > IFDEF CANADA < TEXT "^P&IDENTIFICATION DU TERMINAL:^P^A" > IFDEF FRENCH < TEXT "^P&IDENTIFICATION EST :^P^A" > /L.A.E IFDEF DUTCH < TEXT "^P&INDENTIFICATIE BERICHT IS:^P^A" > IFDEF GERMAN < TEXT "^P&TERMINAL &KENNUNG:^P^A" > IFDEF NORWAY < TEXT '^P&TERMINAL-&I&D ER:^P^A' > IFDEF SWEDSH < TEXT '^P&TERMINAL-&I&D [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P&TERMINAL-&I&D ER:^P^A' > IFDEF V30SWE < TEXT '^P&IDENTIFIERINGSMEDDELANDET \DR:'> / MESFT3, IFDEF ENGLSH < TEXT '^P&LOG DOCUMENT IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PROCEDURA DI COLLEGAMENTO:^P^A/ > IFDEF CANADA < TEXT "^P&DOCUMENT-R[PERTOIRE:^P^A" > /L.A.E IFDEF FRENCH < TEXT "^P&LE JOURNAL DE BORD EST :^P^A" > IFDEF DUTCH < TEXT "^P&LOGBOEK IS:^P^A" > IFDEF GERMAN < TEXT "^P&LOG &DATEI:^P^A" > IFDEF NORWAY < TEXT '^P"&LOG"-DOKUMENTET ER:^P^A' > IFDEF SWEDSH < TEXT '^P"&LOG"-DOKUMENTET [R:^P^A' > /L.U.A IFDEF DANISH < TEXT '^P"&LOG"-DOKUMENTET ER:^P^A' > IFDEF V30SWE < TEXT '^P"&INLOGGNINGSDOKUMENTET \DR:'> / MESFT4, IFDEF ENGLSH < TEXT '^P&SEND ONLY PASSWORD IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PAROLA CHIAVE PER INVIO:^P^A/ > IFDEF CANADA < TEXT "^P&MOT DE PASSE D'ENVOI:^P^A" > IFDEF FRENCH < TEXT "^P&LE MOT DE PASSE POUR ENVOYER EST :^P^A" > /L.A.E IFDEF DUTCH < TEXT "^P&SLEUTELWOORD VOOR ALLEEN ZENDEN:^P^A" > IFDEF GERMAN < TEXT "^P&SENDE &PASSWORT:^P^A" > IFDEF NORWAY < TEXT "^P&PASSORDET FOR ] SENDE ER:^P^A" > /L.D.A IFDEF SWEDSH < TEXT '^P&L\SENORD F\R "S[ND" [R:^P^A' > /L.U.O, L.U.O, L.U.A, L.U.A IFDEF DANISH < TEXT "^P&PASORDET FOR AT SENDE ER:^P^A" > IFDEF V30SWE < TEXT '^P"&S\DND ENDAST L\VSENORD" \DR:'> / MESFT5, IFDEF ENGLSH < TEXT '^P&SEND AND RECEIVE PASSWORD IS:^P^A' > IFDEF ITALIAN< TEXT /^P&PAROLA CHIAVE PER INVIO E RICEZIONE:^P^A/ > IFDEF CANADA < TEXT "^P&MOT DE PASSE D'ENVOI-R[CEPTION:^P^A" > /L.A.E IFDEF FRENCH < TEXT "^P&LE MOT DE PASSE POUR ENVOYER ET RECEVOIR EST :^P^A" /L.A.E > IFDEF DUTCH < TEXT "^P&SLEUTEWOORD VOOR ZENDEN EN ONTVANGEN IS:^P^A" > IFDEF GERMAN < TEXT "^P&SENDE UND &EMPFANGS &PASSWORT:^P^A" > IFDEF NORWAY < TEXT "^P&PASSORDET FOR ] SENDE OG MOTTA ER:^P^A" > /L.D.A IFDEF SWEDSH < TEXT '^P&L\SENORD F\R "S[ND OCH MOTTAG" [R:^P^A' > /L.U.O, L.U.O, L.U.A, L.U.A IFDEF DANISH < TEXT "^P&PASORDET FOR AT SENDE OG MODTAGE ER:^P^A" > IFDEF V30SWE < TEXT '^P"&S\DND OCH TA EMOT L\VSENORD" \DR:'> / /D016;TRYCON, /D016; IFDEF ENGLSH < TEXT '^P!L^P--!L &COMMUNICATIONS ACTIVE --' > /D016; IFDEF CANADA < TEXT "^P!L^P--!L &COMMUNICATION EN COURS --" > /D016; IFDEF FRENCH < TEXT "^P!L^P--!L &COMMUNICATION EN COURS --" > /D016; IFDEF DUTCH < TEXT "^P!L^P--!L &COMMUNICATIE AKTIEF --" > /D016; IFDEF GERMAN < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > /D016; IFDEF NORWAY < TEXT "^P!L^P--!L &KOMMUNIKASJON AKTIV --" > /D016; IFDEF SWEDSH < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > /D016; IFDEF DANISH < TEXT "^P!L^P--!L &KOMMUNIKATION AKTIV --" > / IFDEF ENGLSH < NOANS, "C-200 / C "A-200 / A "N-200 / N "N-200 / N "O-200 / O "T-200 / T " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "F-200 / F "E-200 / E "R-200 / R " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0 BADPAS, "I-200 / I "N-200 / N "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "C-200 / C "T-200 / T " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "D-200 / D 00000 PASPMT, 164 / T 150 / H 145 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "D-200 / D 00000 ILLUSE, "--200 / - "--200 / - " -200 / Space "I-200 / I "L-200 / L "L-200 / L "E-200 / E "G-200 / G "A-200 / A "L-200 / L " -200 / Space "U-200 / U "S-200 / S "E-200 / E "R-200 / R " -200 / Space "--200 / - "--200 / - 0000 IDPMT, 171 / Y 157 / O 165 / U 162 / R " -200 / Space "i-200 / I "d-200 / D "e-200 / E "n-200 / N "t-200 / T "i-200 / I "f-200 / F "i-200 / I "c-200 / C "a-200 / A "t-200 / T "i-200 / I "o-200 / O "n-200 / N " -200 / Space "m-200 / M "e-200 / E "s-200 / S "s-200 / S "a-200 / A "g-200 / G "e-200 / E 0000 > / END IFNDEF ENGLSH IFDEF ITALIAN < NOANS, "T-200 / T "R-200 / R "A-200 / A "S-200 / S "F-200 / F "E-200 / E "R-200 / R "I-200 / I "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / Space "D-200 / D "O-200 / O "C-200 / C "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T "O-200 / O " -200 / SPACE "I-200 / I "M-200 / M "P-200 / P "O-200 / O "S-200 / S "S-200 / S "I-200 / I "B-200 / B "I-200 / I "L-200 / L "E-200 / E CLAMES, 0 BADPAS, "P-200 / P "A-200 / A "R-200 / R "O-200 / O "L-200 / L "A-200 / A " -200 / SPACE "C-200 / C "H-200 / H "I-200 / I "A-200 / A "V-200 / V "E-200 / E " -200 / SPACE "N-200 / N "O-200 / O "N-200 / N " -200 / SPACE "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "T-200 / T "T-200 / T "A-200 / A 00000 PASPMT, "L-200 / L "A-200 / A " -200 / Space "P-200 / P "A-200 / A "R-200 / R "O-200 / O "L-200 / L "A-200 / A " -200 / SPACE "C-200 / C "H-200 / H "I-200 / I "A-200 / A "V-200 / V "E-200 / E 00000 ILLUSE, "--200 / - "--200 / - " -200 / Space "U-200 / U "T-200 / T "E-200 / E "N-200 / N "T-200 / T "E-200 / E " -200 / Space "N-200 / N "O-200 / O "N-200 / N " -200 / SPACE "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "Z-200 / Z "Z-200 / Z "A-200 / A "T-200 / T "O-200 / O " -200 / Space "--200 / - "--200 / - 0000 IDPMT, "i-200 / I "l-200 / L " -200 / SPACE "m-200 / M "e-200 / E "s-200 / S "s-200 / S "a-200 / A "g-200 / G "g-200 / G "i-200 / I "o-200 / O " -200 / SPACE "i-200 / I "d-200 / D "e-200 / E "n-200 / N "t-200 / T "i-200 / I "f-200 / F "i-200 / I "c-200 / C "a-200 / A "z-200 / Z "i-200 / I "o-200 / O "n-200 / N "e-200 / E " -200 / Space "s-200 / S "i-200 / I "s-200 / S "t-200 / T "e-200 / E "m-200 / M "a-200 / A 0000 > / END IFDEF ITALIAN IFDEF CANADA < NOANS, "I-200 / I "M-200 / M "P-200 / P "O-200 / O "S-200 / S "S-200 / S "I-200 / I "B-200 / B "L-200 / L "E-200 / E " -200 / Space "D-200 / D "E-200 / E " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "M-200 / M "E-200 / E "T-200 / T "T-200 / T "R-200 / R "E-200 / E " -200 / Space "L-200 / L "E-200 / E " -200 / Space "D-200 / D "O-200 / O "C-200 / C ".-200 / . CLAMES, 0 BADPAS, "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E " -200 / Space "I-200 / I "N-200 / N "C-200 / C "O-200 / O "R-200 / R "R-200 / R "E-200 / E "C-200 / C "T-200 / T 0000 PASPMT, "L-200 / L "E-200 / E " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 ILLUSE, "--200 / - "U-200 / U "T-200 / T "I-200 / I "L-200 / L "I-200 / I "S-200 / S "A-200 / A "T-200 / T "E-200 / E "U-200 / U "R-200 / R " -200 / Space "N-200 / N "O-200 / O "N-200 / N "--200 / - "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "[-200 / [ "--200 / - 0000 IDPMT, "V-200 / V "O-200 / O "T-200 / T "R-200 / R "E-200 / E " -200 / Space "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "O-200 / O "N-200 / N 0000 > / END IFDEF CANADA / IFDEF FRENCH < NOANS, "N-200 / N "E-200 / E " -200 / Space "P-200 / P "E-200 / E "U-200 / U "T-200 / T " -200 / Space "P-200 / P "A-200 / A "S-200 / S " -200 / Space "O-200 / O "B-200 / B "T-200 / T "E-200 / E "N-200 / N "I-200 / I "R-200 / R " -200 / Space "L-200 / L "E-200 / E " -200 / Space "D-200 / D "O-200 / O "C-200 / C ".-200 / . CLAMES, 0 BADPAS, "M-200 / M "A-200 / A "U-200 / U "V-200 / V "A-200 / A "I-200 / I "S-200 / S " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 PASPMT, "L-200 / L "E-200 / E " -200 / Space "M-200 / M "O-200 / O "T-200 / T " -200 / Space "D-200 / D "E-200 / E " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "E-200 / E 0000 ILLUSE, "--200 / - "U-200 / U "T-200 / T "I-200 / I "L-200 / L "I-200 / I "S-200 / S "A-200 / A "T-200 / T "E-200 / E "U-200 / U "R-200 / R " -200 / Space "N-200 / N "O-200 / O "N-200 / N " -200 / Space "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "[-200 / [ "--200 / - 0000 IDPMT, "V-200 / V "O-200 / O "T-200 / T "R-200 / R "E-200 / E " -200 / Space "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "O-200 / O "N-200 / N 0000 > / END IFDEF FRENCH IFDEF GERMAN < NOANS, "K-200 / K "E-200 / E "I-200 / I "N-200 / N " -200 / Space "D-200 / D "A-200 / A "T-200 / T "E-200 / E "I-200 / I " -200 / Space "T-200 / T "R-200 / R "A-200 / A "N-200 / N "S-200 / S "F-200 / F "E-200 / E "R-200 / R CLAMES, 0 BADPAS, "F-200 / F "A-200 / A "L-200 / L "S-200 / S "C-200 / C "H-200 / H "E-200 / E "S-200 / S " -200 / Space "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "T-200 / T 0000 PASPMT, "P-200 / P "A-200 / A "S-200 / S "S-200 / S "W-200 / W "O-200 / O "R-200 / R "T-200 / T 0000 ILLUSE, "--200 / - "K-200 / K "E-200 / E "I-200 / I "N-200 / N " -200 / Space "Z-200 / Z "U-200 / U "G-200 / G "R-200 / R "I-200 / I "F-200 / F "F-200 / F "--200 / - 0000 IDPMT, "I-200 / I "H-200 / H "R-200 / R "E-200 / E " -200 / "K-200 / K "E-200 / E "N-200 / N "N-200 / N "U-200 / U "N-200 / N "G-200 / G 0000 > / END IFDEF GERMAN IFDEF DUTCH < NOANS, "O-200 / O "N-200 / N "M-200 / M "O-200 / O "G-200 / G "E-200 / E "L-200 / L "I-200 / I "J-200 / J "K-200 / K " -200 / "T-200 / T "E-200 / E " -200 / "V-200 / V "E-200 / E "R-200 / R "Z-200 / Z "E-200 / E "N-200 / N "D-200 / D "E-200 / E "N-200 / N CLAMES, 0 BADPAS, "F-200 / F "O-200 / O "U-200 / U "T-200 / T "I-200 / I "E-200 / E "F-200 / F " -200 / "S-200 / S "L-200 / L "E-200 / E "U-200 / U "T-200 / T "E-200 / E "L-200 / L "W-200 / W "O-200 / O "O-200 / O "R-200 / R "D-200 / D 0000 PASPMT, "H-200 / H "E-200 / E "T-200 / T " -200 / "S-200 / S "L-200 / L "E-200 / E "U-200 / U "T-200 / T "E-200 / E "L-200 / L "W-200 / W "O-200 / O "O-200 / O "R-200 / R "D-200 / D 0000 ILLUSE, "--200 / - "V-200 / V "E-200 / E "R-200 / R "K-200 / K "E-200 / E "E-200 / E "R-200 / R "D-200 / D "E-200 / E " -200 / "G-200 / G "E-200 / E "B-200 / B "R-200 / R "U-200 / U "I-200 / I "K-200 / K "E-200 / E "R-200 / R "--200 / - 0000 IDPMT, "I-200 / I "D-200 / D "E-200 / E "N-200 / N "T-200 / T "I-200 / I "F-200 / F "I-200 / I "C-200 / C "A-200 / A "T-200 / T "I-200 / I "E-200 / E " -200 / "B-200 / B "E-200 / E "R-200 / R "I-200 / I "C-200 / C "H-200 / H "T-200 / T 0000 > / END IFDEF DUTCH IFDEF NORWAY < NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "O-200 / O "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "E-200 / E " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "Y-200 / Y "L-200 / L "D-200 / D "I-200 / I "G-200 / G " -200 / "P-200 / P "A-200 / A "S-200 / S "S-200 / S "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "P-200 / P "A-200 / A "S-200 / S "S-200 / S "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "--200 / - "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "T-200 / T " -200 / "B-200 / B "R-200 / R "U-200 / U "K-200 / K "E-200 / E "R-200 / R "--200 / - "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF NORWAY IFDEF SWEDSH < / NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "\-200 / \ "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "A-200 / A " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "I-200 / I "L-200 / L "T-200 / T "I-200 / I "G-200 / G " -200 / "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "A-200 / A "T-200 / T " -200 / "A-200 / A "N-200 / N "V-200 / V "[-200 / [ "N-200 / N "D-200 / D "A-200 / A "R-200 / R "E-200 / E "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF SWEDSH IFDEF DANISH < NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "O-200 / O "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "E-200 / E " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "Y-200 / Y "L-200 / L "D-200 / D "I-200 / I "G-200 / G " -200 / "P-200 / P "A-200 / A "S-200 / S "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "P-200 / P "A-200 / A "S-200 / S "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "--200 / - "I-200 / I "K-200 / K "K-200 / K "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "E-200 / E "T-200 / T " -200 / "B-200 / B "R-200 / R "U-200 / U "G-200 / G "E-200 / E "R-200 / R 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF DANISH IFDEF V30SWE < / NOANS, "K-200 / K "A-200 / A "N-200 / N " -200 / "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "\-200 / \ "V-200 / V "E-200 / E "R-200 / R "F-200 / F "\-200 / \ "R-200 / R "A-200 / A " -200 / "D-200 / D "O-200 / O "K-200 / K "U-200 / U "M-200 / M "E-200 / E "N-200 / N "T-200 / T CLAMES, 0000 BADPAS, "U-200 / U "G-200 / G "I-200 / I "L-200 / L "T-200 / T "I-200 / I "G-200 / G " -200 / "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D 0000 / PASPMT, "L-200 / L "\-200 / \ "S-200 / S "E-200 / E "N-200 / N "O-200 / O "R-200 / R "D-200 / D "E-200 / E "T-200 / T 0000 ILLUSE, "--200 / - "I-200 / I "N-200 / N "T-200 / T "E-200 / E " -200 / "A-200 / A "U-200 / U "T-200 / T "O-200 / O "R-200 / R "I-200 / I "S-200 / S "E-200 / E "R-200 / R "A-200 / A "T-200 / T " -200 / "A-200 / A "N-200 / N "V-200 / V "[-200 / [ "N-200 / N "D-200 / D "A-200 / A "R-200 / R "E-200 / E "--200 / - 0000 / IDPMT, "d-200 / d "i-200 / i "n-200 / n " -200 / "I-200 / I "D-200 / D 0000 > / End IFDEF V30SWE / CRLF, 15 CUPOS4, 12 / ++++ 0 AXDMS, / / The following foreign language code contains the closing angle bracket / character. This character causes the conditional code compilation to get / quite confused. Therefore it has been necessary to hide these characters / from PAL using their SIXBIT codes rather than the TEXT characters. This / makes quite a mess. The english for the following mess is: / TEXT "^AFROM>^A^ATIME>^A^AN>^A ^A#>!D.^D^Am>^A^A>^A" / IFDEF ENGLSH < TEXT "^AFROM" *.-1 7636 / closing angle and uparrow TEXT "A^ATIM" *.-1 0576 / "E" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A#" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFNDEF ENGLSH / IFDEF ITALIAN < TEXT "^ADA" *.-1 7636 / closing angle and uparrow TEXT "A^ADATA-OR" *.-1 0176 / "A" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A=" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFDEF ITALIAN / IFDEF CANADA < TEXT "^ADE" *.-1 7636 / closing angle and uparrow TEXT "A^ADAT" /M011 *.-1 0576 / "E" and closing angle /M011 TEXT "^A^A" /M011 *.-1 1676 / "N" and closing angle /M011 TEXT "^A ^A#" /M011 *.-1 7641 / closing bracket and "!" /M011 TEXT "D.^D^A" /M011 *.-1 1576 / "M" and closing angle /M011 TEXT "^A^A" /M011 *.-1 7636 / closing angle and uparrow /M011 TEXT "A" /M011 > / IFDEF FRENCH < TEXT "^ADE" *.-1 7636 / closing angle and uparrow TEXT "A^ATEMPS" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing bracket TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > / IFDEF DUTCH < TEXT "^AVA" *.-1 1676 / "N" and closing angle TEXT "^A^ATIJD" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing angle TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > / IFDEF GERMAN < TEXT "^AVO" *.-1 1676 / "N" and closing angle TEXT "^A^AZEIT" *.-1 7636 / closing angle and uparrow TEXT "A^AN" *.-1 7636 / closing angle and uparrow TEXT "A ^A" *.-1 4376 / "#" and closing angle TEXT "!D.^D^AM" *.-1 7636 / closing angle and uparrow TEXT "A^" *.-1 0176 / "A" and closing angle TEXT "^A" > IFDEF NORWAY < TEXT "^AFR" *.-1 0176 / "A"-closing bracket TEXT "^A^ATI" *.-1 0476 / "D"-Closing bracket > IFDEF SWEDSH < TEXT "^AFR]N" *.-1 7636 / Closing bracket-uparrow TEXT "A^ATID" *.-1 4076 / Space-Closing bracket > IFDEF DANISH < TEXT "^AFR" *.-1 0176 / "A"-closing bracket TEXT "^A^ATI" *.-1 0476 / "D"-Closing bracket > IFDEF V30SWE < TEXT "^AFR\EN" *.-1 7636 / closing angle and uparrow TEXT "A^ATIM" *.-1 0576 / "E" and closing angle TEXT "^A^A" *.-1 1676 / "N" and closing angle TEXT "^A ^A#" *.-1 7641 / closing angle and "!" TEXT "D.^D^A" *.-1 1576 / "M" and closing angle TEXT "^A^A" *.-1 7636 / closing angle and uparrow 0100 / "A" and null to terminate string > / End IFDEF V30SWE / / THE STRINGS THAT ARE USED FOR DELIMITERS / DEAX1, "<-200 / ++++ 156 / ++++ ">-200 / ++++ 0 DEAX2, "<-200 / ++++ "#-200 / ++++ ">-200 / ++++ 0 DEAX3, "<-200 / ++++ ">-200 / ++++ 0 / DECKDT, / USED TO COMPAY THE CURRENT CHARACTER IN DECKDS TO < DEAX4, "<-200 / ++++ 0 / IFDEF GERMAN < PAGE / The german TEXT is short enough to cause the code on / the next page to have severe problems. > IFDEF ENGLSH / DITTO FOR ENGLISH. IFDEF V30SWE / DITTO FOR V30SWE? / / / PART OF REDSIX ROUTINE TO AHNDLE THE ESCAPE SEQUENCES / REDESC, AC7776 / PART OF REDSIX ROUTINE TAD T1 / SEE IF LEGAL ESCAPE SEQUENCE SPA / ++++ JMP RDSIX4 / ERROR TAD (2-31) SMA SZA / ++++ JMP RDSIX4 / ERROR TAD (REDTAB+31-2) / COMPUTE TABLE ENTRY DCA T1 TAD I T1 / PICK UP ENTRY / DCA T1 / STORE THE ORIGINAL CHARACTER OUT OF THE TABLE TAD T1 / SMA / ++++ JMP REDES2 / IF NEGATIVE IT IS A ESCAPE SEQUENCE / IF POSITIVE IT IS EITHER 137 THAT IS SPECIAL / OR A CHARACTER THAT IS CASE DEPENDENT / CLA TAD T1 / ESCAPE AND P77 / GET THE SECOND BYTE THE CAHRACTER REPRESENTING DCA T2 / THE TYPE / TAD T1 / NOW GET THE ESCAPE BSW AND P77 TAD (100) REDES3, DCA T3 / TAD T3 / IF THE ESCAPE IS A 174 OR VERTICAL BAR THEN / ADD A 100 TO THE NEXT CHARACTER TAD (-173) SZA CLA / ++++ AC0100 TAD T2 AND P177 DCA REDNXT / SAVE IT FOR THE NEXT TIME THE ROUTINE IS CALLED / TAD T3 JMP RDSIX2 / SEND THE ESCAPE REDES2, TAD (-137) / IF SPECIAL THEN DOESNT MATTER IF UPPER OR LOWER SNA CLA / ++++ JMP REDES4 / SEND A 137 FOR UNDERSCORE TAD REDSHF / ELSE CASE DEPENDENT SNA / ++++ JMP REDES4 / NO CASE CHANGE THE CHARACTER IS OK TAD T1 DCA T2 / MAKE LOWER / TAD (174) / SEND AS A 174 ESCAPE JMP REDES3 REDES4, TAD T1 / GET THE OROGINAL JMP RDSIX2 REDNXT, 0 / / PART OF THE REDSIX ROUTINE / WRSIXB, DCA WRICHR / CLEAR HOLD CHAR MQA TAD (-140) / MAKE LOWER CASE SMA / ++++ TAD (-40) TAD (140-37) TAD (-74) / SEE IF SPECIAL CHAR SMA / ++++ JMP WRSIXC / YES, SEND ESCAPE SEQUENCE INSTEAD TAD (74) JMP WRSIXX / PAGE / / LOCDOC - WILL LOCK THE DOCUMENTS THAT WILL BE USED FOR AX. THIS IS / THE LOG AND DEFAULT LIST DOCUMENTS / Why this routine worked in the English system is anyone's guess. It was / just luck. The XXXXX symbol causes WPCRE to be loaded right after the last / instruction in this routine. This caused all the literals on this page / to be overwritten. It seems that the key literal was not changed when this / occurred--in the English system, that is, in the FORINized systems it is / and AX didn't work. To correct this all literals on this page have been / labeled so that they won't get overwritten. Take care if adding code to / to this page that you label your literals too. / /D032;LOCDOC, /D032; XX /D032; CLA /D032; CDFMYF /D015; TAD I PLOGNO / Get the log document number via pointer /D015; SNA CLA / ++++ /D015; JMP LOCDO2 /D014;/ /D014; CIFPRT /D014; JMS I PLCKFI / Jump to subroutine via pointer /D014; LOGNO /D014; ALTER /D014; USERNO /D014;/ /D014; JMP LOCER1 /D014;/ /D015; CDFMNU / CHANGE DATA FIELD TO MENU. /A014 /D015; DCA I PFLOCK / SET MENU LOCK WORD. /A014 /D015; CDFMYF / BACK TO US. /A014 /D032;LOCDO2, JMP I LOCDOC /D014;LOCER2, /D014; AC0001 / DISPLAY THAT THE DEFAULT LIST DOCUMENT IS LOCKED /D014;LOCER1, /D014; TAD VFOUR / LOG /D014;/ /D014; CDFMNU /D014; DCA I PMNUST / store via pointer to menu stuff /D014; CDFMYF /D014;/ /D014; CIFMNU /D014; JMS I MNUCAL /D014; DLMA13 /D014;/ /D014; JMP I LOCDOC /D014;/ /D015;PLOGNO, LOGNO / Pointer to log document number /D014;VFOUR, 4 / The value four /D014; /D014;/This line was causing an undefined symbol error for the 78. Since it /A010 /D014;/is only accessed when WS102 is defined I conditionalized it. /A010 /D014;IFDEF WS102 < /A010 /D014;PLCKFI, LCKFIL / Pointer to file locking routine /D014;> /A010 /D014;PMNUST, MUBUF+MNTMP2 / Pointer to menu stuff /D014;/ /D015;PFLOCK, MUBUF+MNLOCK / POINTER TO MENU LOCK WORD. /A014 / / CLEAR OUT THE SETTINGS WHEN AX IS LOADED OUT. THE ZBLOCK / MAKES SURE WHAT WE LOAD OUT IS ZEROS. THIS ALSO LIMITS THIS PROGRAM TO / THE VALUE OF DFCOMA / XXXXXX=. / CURRENT POSITION IS = XXXXXX / *DFCOMA / ZBLOCK 1000 / *XXXXXX / RESET THE CURRENT LOCATION COUNTER   /TITLE WPCUT - COMMAND UTILITY / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / / / 088 EMcD 12-Sep-85 Add Nordic translations (conditionalise) / 087 EMcD 12-Mar-85 Add DECDEV switch / 086 HLP 05-NOV-84 Allow for future use of header wds 18,42 / 085 HLP 13-JUL-84 Fix WPSV2-60 false nonexistent printer / 084 SBB 21-MAY-84 MAKE ROOM AND FIX SOME ERR AND GOLD RETURNS / 083 SBB 07-MAY-84 MAKE ROOM AND ADD POST-PROCESSOR STUFF / 082 GDH 14-FEB-84 rearranged some code to make source / more similar to the foreign source. / Deleted extraneous SPRJOB routine. / 081 HLP 18-JAN-84 Fix bug induced on 080 where LP to / newly created doc was printed instead / 080 EH 06-JAN-84 LP check for result doc 'in use' prior / to displaying TBO prompt / 079 HLP 04-JAN-84 ADD MISSING CDF! (DECII-158) / 078 HLP 08-DEC-83 Add SMTAB entry for mismatched controls / 077 HLP 14-NOV-83 Send current SE setting to MNTMP7 / Remove P option on SE YES / 076 HLP 17-OCT-83 Put SL on Stop Menu / Make Stop Menu use MNQINI instd MNTMP4 / since TBO uses MNTMP4 (CM1NX) / 075 HLP 13-SEP-83 Delete PRLOCK (DECmate is single user) / Delete refs to D2OGET,D2OPUT,D2OCNT / 074 HLP 10-AUG-83 LP checks doc dest in printer code / so escape sequences for quality mode / can be sent to LA50/LA100 / 073 HLP 26-JUL-83 Delete margin check on RS command / 072 HLP 02-JUN-83 New Page not to set PRSTOP so PRTRID / won't abort! / 071 HLP 23-MAY-83 Add JWAIT to CUSTOP / Simplify STOPPR routine / 070 GDH 19-MAY-83 Moved PRD error menu to PR1 / 069 HLP 18-MAY-83 Delete C option from BUSY in SMTAB / 068 HLP 16-MAY-83 Handle PRSTTS only in CUSTOP / 067 HLP 13-MAY-83 Don't re-call stop menu if PRSTT2=1 / Add C option to BUSY in SMTAB / Add code 26 comm. error in SMTAB / Delete unreferenced symbols / 066 WCE 10-MAY-83 Error message bug fixes / 065 HLP 02-MAY-83 Restore lines illegally deleted in / WS102 cleanup which broke LP / 064 HLP 27-APR-83 Move CUQMCK to end of WPCUT so it / can share a page with WPCRE and not / push CUB1 past 5400. Fixed bug where / SL would make disc not verify. / Remove WS102 conditionals / 063 HLP 18-APR-83 Move CUBs to WPCRE / Add CUQMCK to check consistency of margins / 062 HLP 01-APR-83 DELETE JSTRTs on PRJOB / 061 HLP 21-MAR-83 Only resume on doc read error / 060 HLP 18-FEB-83 LPONLN in printer field / 059 HLP 10-JAN-83 Delete STSTTS, create SPRJOB to save space / 058 HLP 10-JAN-83 Conditionalize resume on SMTAB / 057 HLP 07-JAN-83 If PRSTTS=0 then don't stop, start printer / 056 HLP 30-DEC-82 Allow resume non-existent printer / 055 DFB 15-DEC-82 Fix to return if hdr blk=0 / 054 HLP 13-DEC-82 Handle change in PRSTTS when in / stop printer menu / Deleted lock code in CUSTOP / Use PQFRST in CUSTOP rather than MN1 / 053 HLP 13-DEC-82 Add error code 25 to SMTAB / Delete N from LQP02 ASF error in SMTAB / DELETE R,P,B,T,N from paused at boot in SMTAB / 052 HLP 12-DEC-82 WAITPR to exit immediatley on resume / remove code to reset LQPSE from WAITPR / 051 HLP 07-DEC-82 WAITPR not call SQREST if draft printer / (this did NOT get into V133) / 050 EH 03-DEC-82 Fix for RL to print documents if name / is greater than 31 chars in length / 049 HLP 02-DEC-82 Add code for selective stop menu / 048 HLP 28-NOV-82 Copy PQFRST up to stop menu / 047 GDH 19-NOV-82 Removed LP setting PRSTTS to "-1". / 046 HLP 01-NOV-82 Delete automatic Resume after SL / 045 HLP 22-OCT-82 Change WAITPR routine to reset LQP02 / and added a JWAIT to let stop ov process / 044 GDH 20-OCT-82 Print menu changes re: list processing / printer validation. / 043 HLP 06-OCT-82 Use MNTMP4 for stop menu / 042 HLP 05-OCT-82 Move CURWBF / 041 HLP 05-OCT-82 Copy PRQPNT up to stop menu on DD change / 040 HLP 11-AUG-82 Changes to allow B and T after ASF error / WAITPR no longer sets LPDNFG / WAITPR issues reset via SQREST / 039 GDH 08-APR-82 Fixed call to RL code (routine CURWGN). / 038 WCE 26-FEB-82 MODIFIED ERROR CALL FOR FILE IN USE / 037 GDH 18-FEB-82 ADDED "GET DENSITY" TO PRINT COMMAND / UTILITY. / 036 GDH 08-FEB-82 ADDED "READ ERROR DETECTION". / 035 GDH 21-NOV-81 BUG FIX TO WAITPR TO NOT SET PABORT / FLAG ON RESUME COMMAND. ALSO INCREASED / THE WAITPR TIME DELAY. / 034 GDH 21-NOV-81 MADE USE OF THE PRINTER ID ROUTINE IN / THE PRINTER. / 033 AJF 19-OCT-81 MADE PRTRID ROUTINE MONITOR LPDNFG / 032 GDH 16-OCT-81 DE-IMPLEMENTED LOCK/UNLOCK CODE. / 031 AJF 12-OCT-81 CHANGED MNSLU3 TO MNPRTB / 030 AJF 09-OCT-81 FIXED ASF PROBLEM IN PRTRID / 029 AJF 15-SEP-81 REPLACED DDTABL WITH SMARTER ONE / 028 AJF 07-SEP-81 ADDED PRINTER ID ROUTINE AND DD CHECK / 027 AJF 06-SEP-81 DELETED EXTRANEOUS FIELD STUFF / FROM PAGE 0 AND UNLOCK/LOCK STUFF / TO MAKE ROOM FOR PRINTER ID ROUTINE / AND DD -LPONLN CHECK ROUTINE / 026 GDH 04-SEP-81 WPFILS CALLING SEQ CHANGES / 025 JM 01-SEP-81 FIXED DEFAULT DD IN DDTABLE / 024 TT 07-JUL-81 REMOVED SUPERFLUOUS CONDITIONALS / 023 JM 02-APR-81 CHANGES FOR CANADA / 022 JM 02-APR-81 CHANGED "TAD I (LPDNFG)" TO / "DCA I (LPDNFG)" / 021 DIM 13-MAR-81 CONDITIONALIZED PERIOD OF TIME THAT / WAITPR WAITS FOR VT278 / 020 JM 19-FEB-81 CONDITIONALIZED CODE AT STOPRT / FOR THE 278 / 017 JM 06-FEB-81 MOVED CANADIAN TEXT AT CULSBT TO / ANOTHER PAGE TO FIX A PAGE ERROR / 016 JM 06-FEB-81 MOVED DUTCH TEXT AT CULS5 TO ANOTHER / PAGE TO FIX A PAGE ERROR / 015 DAO 7-JAN-80 CHANGED PERIOD OF TIME THAT WAITPR / WAITS BEFORE IT DETERMINES THAT THE / PRINTER IS HUNG WHEN THE USE PICKS AN / OPTION FROM THE STOP PRINTER MENU. / 014 DAO 22-DEC-80 DELETED MESSAGE "ALL DOCUMENTS WAITING / TO PRINT ARE FOR THE SECOND USER" IN / THE CASE OF A VT278 / 013 DAO 18-DEC-80 CHANGED CHECKING OF IF PRINTER ON LINE / OR NOT IN LIST PROCESSING TO BE / CONSISTENT WITH THE WAY THE PRINTER / DOES IT. (MAINTAINING COMPATABILITY / WITH POSSIBLE DOCUMENT DESTINATIONS / IN TH RL BASE SYSTEMS) / 012 DAO 17-DEC-80 ADDED CHANGE TO TURN OFF FLASHING LED / AND BUZZING WHEN GOING TO STOP PRINTER / MENU / 011 DAO 4-DEC-80 DELETED EXTRA CDFMNU IN CUSL1 ROUTINE / 010 DAO 4-DEC-80 FIXED BUG WHICH HANGS SYSTEM WHEN / PRINTER HAS ERROR / 0009 DAO 18-SEP-80 MERGED WITH X3.5 / 0008 DM,JM 15-SEP-80 MERGED SCANDI AND EUROPE/ENGLISH / 0007 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 0006 CMW 07-AUG-80 MADE GRAMMATICAL CHANGES FOR DUTCH / 0005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 0004 CMW 6-MAY-80 ENTERED CANADIAN TRANSLATIONS / 0003 DSS 17-APR-80 ENTERED DUTCH FIXES / 0002 GLT 10-APR-80 CHANGED CODE SO GERMAN PART OF LP LISTS / WILL BE ABLE TO HAVE UC LETTERS. / 0001 GLT 31-MAR-80 ADD FRENCH GERMAN DUTCH CONDITIONAL CODE / DIACRITICAL SUBSTITUTIONS: / FRENCH: "]"=L.G.E, "["=L.A.E; "&" NO MAKE CAPS / GERMAN: "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" MAKE CAPS / QA3.5 LDB 19-APR-78 FIX LP PRINTER BUGS AND LP T OPTION / III.D KEE 29-MAR-78 CLEAN UP CODE + STUFF FOR WT FILE NUMBER / REPRESENTATION / 2.7-3 KEE 1/14/78 MAKE CREATE SEPERATE SOURCE FILE / 2.7-1 LDB 11/23/77 MERGE FROM WT78 PACK / 2.5-3 RLT 11/9/77 ADD ERROR HANDLING FOR DDNAM / 2.5-2 RLT 11/4/77 DO REAL DD STRING FOR WT PRINT / 2.5.1 KEE 11/4/77 FIX SL AND RL BUGS / 2.5-1 RLT 10/21/77 MERGED FROM WT78 PACK / 2.4D-1 LDB 10/18/77 CHG PRINTER CALLS FOR 100 & WS78 PROPORTIONAL / 2.4D+ KEE 10/17/77 FIX REST OF SL CODE / 2.Q-2 LDB 9/25/77 ADD PRINTER UNLOCK CODE / 2.Q-1 RLT 9/24/77 ELIM LQUE AND R/W PQUE FOR WT78 / 2.P-4 RLT 9/23/77 FIX FOR WT ASM / 2.P-3 LDB 9/22/77 FIX LOCKS FOR CREATE & LP AND MORE RL STUFF / 2.P-2 LDB 9/19/77 MORE RL&SL / 2.P-1 LDB 9/16/77 PUT IN RL & SL CODE / 2.O MB 9/15/77 PUT IN THE 78 CHANGES / 2.N-1 LDB 9/14/77 MOVE STUFF TO WPCU2 / 2.N KEE 9/9/77 ADD LOCK CODE FOR 2.5 / 2.L-1 LDB 9/11/77 FIX LIST Q BUG / 2.J KEE 8/26/77 ADD 4-FLOPPY SUPPORT / 2.G-1 MSB 8/9/77 MOVE FROM 78 TO MASTER PACK *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOCUT 100 IFNDEF DECDEV < CDF 20 > IFDEF DECDEV < CDF 40 /A087 > -DSOCUT /M026 DLPRQ 200 IFNDEF DECDEV < CDF 10 > IFDEF DECDEV < CDF 30 /A087 > -DSPRQ /M026 0 IFNDEF DECDEV < FIELD 1 > IFDEF DECDEV < FIELD 3 > *200 ZBLOCK 400 /INITIALIZE WRITEOUT OF PRINT QUEUE /THIS IS THE PATCH TO PAGE ZERO THAT WILL CONTAIN THE ROUTINES /THAT WILL TAKE CARE OF THE CDFS AND CIFS. CDIF00=CDF CIF /CONSTANT USED TO FORM A CDF CIF CALL TO CIDPAT IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 4 > *100 /THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM CDFMYF=CDFBUF /THIS FIELD SAME AS BUFFER FIELD CIFMYF=CIFBUF SPACTN, 0 /USER REQUESTED ACTION. /A035 TENADR, CLOCK+1 /ADDRESS OF TENTHS OF SEC (PAGE 0) /VARIABLES FOR WAITPR ROUTINE MOVED HERE REV051 COUNT, 0 /-NUMBER OF TENTHS OF SECONDS YET TO WAIT BUFCNT, 0 /ADDRESS (TAKEN FROM FIELD 0) OF HANDLER BUFFER COUNT TENTH, 0 /LAST TENTH OF A SECOND TEMP, 0 /A TEMPORARY CUQFNO, 0 CUQFLG, 0 CUSADR, 0 CUSDIF, 0 CURWBF, ZBLOCK 40 /ADD 1 WORD SO THAT ENDING ZERO WON'T CLOBBER /ANYTHING THAT FOLLOWS IFNZRO 155-.&4000 *156 /SO WE ALWAYS KNOW WHERE QBLOCK IS QUBLK, DSKQUE 0 0 QUQBLK, /QBLOCK-- SAVE LOTS OF LINKS BY MOVING HERE 0 /RXQCOD FLAGS RETURNED HERE 0 /RXQFNC FUNCTION CODE 0 /RXQDN1 0 /RXQDN2 0 /RXQENO 0 /RXQID1 0 /RXQSPC 0 /RXQCTL 0 /RXQDRV DRIVE NUMBER 0 /RXQBLK BLOCK NUMBER 0 /RXQRS1 0 /RXQBAD BUFFER ADDRESS CDFMYF+10 /RXQBFD BUFFER FIELD CDF 0 /RXQTRK TRACK 0 /RXQSEC SECTOR /-------------------- PAGE /THIS LABEL TRIGGERS A CONDITIONAL IN WPCRE /A054 WPCUT, XX /CURWPQ - READ AND WRITE PRINTER QUEUE JMS CURWPQ CDIMNU JMP I .-3 XX /CUPP - CREATE COMMAND JMS CUPP CDIMNU JMP I .-3 XX /CUQPRT - QUEUE TO PRINTER COMMAND JMS CUQPRT CDIMNU JMP I .-3 XX /CUSTOP - STOP THE PRINTER COMMAND JMS CUSTOP CDIMNU JMP I .-3 CULP, XX /CULPCM - LIST PROCESSING COMMAND JMS CULPCM CDIMNU JMP I .-3 XX /RESUME PRINTER JMS CURPRT CDIMNU JMP I .-3 XX /NEW PAGE ON PRINTER JMS CUNPRT CDIMNU JMP I .-3 CUFF, XX /POST PROCESS /A083 JMS CPOSTP /A083 CDIMNU /A083 JMP I .-3 /A083 CUPSOL, XX /SETS UP OVERLAY CHAIN INFO AC7775 DCA T1 /SET TO COPY THREE WORDS TAD MNUCAL+1 TAD (MNONUM-1) DCA X0 /TO MENU AREA CUPSO1, TAD I CUPSOL /GET NEXT WORD FROM CALLER ISZ CUPSOL /BUMP ARG PTR CDFMNU /CHANGE TO MENU FIELD DCA I X0 /STORE NEXT WORD IN MENU AREA CDFMYF /CHANGE BACK TO MY FIELD ISZ T1 JMP CUPSO1 /LOOP FOR ALL WORDS JMP I CUPSOL /THEN RETURN TO CALLER /*********************************************************************** /CUNPRT--NEW PAGE ON PRINTER /NO LONGER SETS PRSTOP ELSE PRTRID WILL ABORT /A072 CUNPRT, XX /NEW PAGE ON PRINTER CLA CDFPRT /CDF TO PRINTER TAD I (PRSTTS) /SEE IF PRINTER NOT BUSY SZA CLA JMP CUNPR1 /BUSY, GIVE MESSAGE ISZ I (PRSTTS) /SET STATUS TO BUSY /A072 AC0001 JMS STRTPR /GIVE NEW PAGE COMMAND JMP I CUNPRT CUNPR1, CDFMYF CIFMNU JMS I MNUCAL /CALL MENU DLMPS3 /FOR BUSY MESSAGE JMP I CUNPRT /AND RETURN /CUPP - CREATE COMMAND CUPP, 0 JMS ADRCRT /DO THE CREATE JMP CUPRTR /ERROR, RETURN TO MAIN MENU CDFMNU DCA I (MUBUF+MNFNO) TAD I (MUBUF+MNFNO) AND P377 DCA I (MUBUF+MNDOCN) CDFMYF /BACK TO US TO SET RETURN ADDR ISZ 204 /SET FOR CHAIN CALL /- IS USED BY CREATE TO SEE WHICH OVERLAY TO CALL IN WHEN DONE /0 = EDITOR /1 = INDEX CDFMNU TAD I (MUBUF+MNTMP2) CDFMYF SNA CLA JMP CUPCE3 /EDITOR JMS CUPSOL 16 200 CIF CDF 20 /INDEX JMP CUPRTR CUPCE3, JMS CUPSOL 2 200 CIF 10 CUPRTR, JMP I CUPP /RETURN TO MAIN MENU /A LITTLE ROUTINE TO GET THE SYSTEM VALUE LPONLN /CALLED BY JMS GTLP RETURNS WITH LPONLN IN AC GTLP, XX CLA /CLEAR AC CDFPRT /CHANGE DATA FIELD TO PRINTER TAD I (LPONLN) /GET LPONLN CDFMYF /CHANGE DATA FIELD TO MINE JMP I GTLP /RETURN TO CALLER /ROUTINE TO READ AND WRITE THE BLOCK CONTAINING /THE NAMES OF THE FILES IN THE PRINT QUEUE. /CALLED WITH: /JMS CURDQB /ACTION FOR RXHAN (RXERD OR RXEWT) CURDQB, XX /RETURN CLA TAD I CURDQB /GET ACTION FOR RXHAN ISZ CURDQB DCA QUQBLK+RXQFNC JMS CUPDRS /SET TO SYSTEM DRIVE TAD (DLPRQ) DCA QUQBLK+RXQBLK TAD (CUB1) DCA QUQBLK+RXQBAD JMS QURX CLA JMP I CURDQB /RETURN /-------------------- PAGE /CUQPRT - QUEUE TO PRINTER COMMAND FHPSET=23 CUQPRT, 0 DCA CUQOPT CDFMNU TAD I (MUBUF+MNFNO) CDFMYF DCA CUQFNO TAD CUQFNO BSW RTR /POSITION DRIVE NUMBER JMS CUPDRS TAD (RXEDN) /GET DENSITY OF DRIVE IN QUESTION. /A037 DCA QUQBLK+RXQFNC /A037 JMS QURX /A037 CLA /CLEAR THE AC /A037 TAD CUQFNO AND P377 DCA QUQBLK+RXQFNO TAD (RXEGF) DCA QUQBLK+RXQFNC JMS CUINDX /CHECK AND READ INDEX BLK(ERR IF=0) /A055 TAD (RXERD) DCA QUQBLK+RXQFNC TAD (CUB1) DCA QUQBLK+RXQBAD /READ INTO BUFFER 1 JMS QURX AC0001 /SET COPIES TO 1, FROM 1, TO 0 DCA CUB1+FHPSET+1 AC0001 DCA CUB1+FHPSET+10 DCA CUB1+FHPSET+11 TAD QUQBLK+RXQBLK /SAVE SOME VALUES FOR USE LATER DCA CUQHBK TAD QUQBLK+RXQDRV DCA CUQHDV TAD CUB1+FHPSET /GET FIRST WORD OF OUR INFO IN HDR BLK SZA CLA JMP CUQCPS /ALREADY SET - SO COPY SETTINGS INTO MENU CUQGTS, CMA /MAKE A NEGATIVE-1 STORED SETTING # /C086 DCA CUQTMP TAD (PRSETZ+2) /ALLOW FOR FUTURE EXPANSION OF PRSETZ BY 2/C086 ISZ CUQTMP /MULTIPLY DONE? JMP .-2 /NO - CONTINUE ADDING SO HAVE OFFSET TAD (CUB2-PRSETZ-1) /ADD TO START OF BUFFER,WITH CORRECTION FACTOR / ^ /C086 DCA CUQSS1 /SAVE PTR TO SETTING FOR LATER TAD (RXERD) /SET UP TO READ THE RIGHT BLOCK DCA QUQBLK+RXQFNC TAD (CUB2) DCA QUQBLK+RXQBAD /READ INTO BUFFER 2 JMS CUPDRS /SET TO SYSTEM DRIVE TAD (DLRLRP) /GET BLOCK NUMBER DCA QUQBLK+RXQBLK JMS QURX /READ IT IN JMS CUCOPY /COPY VALUES INTO HDR CUQSS1, 0 CDFMYF CUB1+FHPSET CDFMYF PRSETZ CUQCPS, JMS CUCOPY /COPY SETTINGS FROM HDR TO MENU CUB1+FHPSET CDFMYF MUBUF+MNPROP CDFMNU PRSETZ CUQCMU, CDFMNU /CALL MENU DCA I (MUBUF+MNTMP1) /SET REASON FOR CALL CDFMYF CIFMNU JMS I MNUCAL DLMPR2 CLA /CHECK RETURNED ACTION CODE CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF TAD (JMP I CUQATB-1)/GET JMP THROUGH TABLE DCA .+1 HLT /DO IT CUQATB, CUQWOQ /1- WRITE OUT VALUES TO HDR AND QUEUE CUQWON /2- WRITE OUT VALUES TO HDR AND DON'T QUEUE CUQWOB /3- WRITE OUT VALUES TO STORED SETTINGS CUQRDB /4- READ IN BLOCK OF SETTINGS TO HDR CUQCKP /5- CHECK PRINTER SETTING /A044 CUQRET, CLA JMP I CUQPRT /RETURN TO CALLER CUQTMP, 0 CUQHBK, 0 CUQHDV, 0 CUQOPT, 0 /THIS ROUTINE STICKS AN L.G.A (ACCENTED CHAR) ON THE SCREEN FOR CANADA /A023 /IF THE BOTTOM MESSAGE (L.P.) HAS BEEN DISPLAYED /A023 IFDEF CANADA < /A023 CANLGA, XX /A023 AC7777 /SET AC TO -1 /A023 TAD CULTBO /ADD CULTBO /A023 SZA CLA /IF CULTBO NE 1 /A023 JMP CULT2 /THEN CONTINUE /A023 CIFMNU /ELSE DISPLAY L.G.A /A023 JMS I IOACAL /A023 0 /A023 CULCAN /A023 1030 /CURSOR POS /A023 141 /L.G.A /A023 JMP I CANLGA /RETURN /A023 CULCAN, TEXT '^P^Z' /A023 > /END IFDEF CANADA /A023 CURLST, ZBLOCK 10 /LIST OF DOCUMENTS TO BE DELETED FROM QUEUE CUQCKP, JMS CULCKP /CHECK PRINTER DESTINATION /A044 /RETURNS 0 FOR DD OK /A044 / 1 FOR DD NON-EXISTENT /A044 / 2 FOR INCORRECT PRINTER ATCHD /A044 CUQCK1, IAC /MAP TO MENU PARAMETER VALU. /A044 JMP CUQCMU /BACK TO THE MENU. /A044 CUQRDB, CDFMNU TAD I (MUBUF+MNTMP2) CDFMYF JMP CUQGTS /NOW GO GET SETTING /-------------------- PAGE CUQWOB, JMS CUQMCK /CHECK VERTICAL MARGINS /A063 CDFMNU TAD I (MUBUF+MNTMP2) CDFMYF CMA /NEG-1 SETTINGS NUMBER /C086 DCA T1 /MAKE COUNTER TAD (PRSETZ+2) /C086 ISZ T1 JMP .-2 TAD (CUB2-PRSETZ-1) /C086 DCA CUQSS2 TAD (RXERD) /READ BLOCK IN DCA QUQBLK+RXQFNC TAD (CUB2) DCA QUQBLK+RXQBAD JMS CUPDRS /SET SYSTEM DRIVE AND BUFFER FIELD TAD (DLRLRP) DCA QUQBLK+RXQBLK JMS QURX JMS CUCOPY /COPY NEW VALUES MUBUF+MNPROP CDFMNU CUQSS2, 0 CDFMYF PRSETZ TAD (RXEWT+2000) /WRITE IT BACK OUT DCA QUQBLK+RXQFNC JMS QURX JMP CUQCMU /CALL MENU CUQWON, JMS CUQMCK /CHECK VERTICAL MARGINS /A063 AC7777 /SAY NOT TO QUEUE JMP CUQWQ1 /MERGE BELOW. /A044 CUQWOQ, JMS CUQMCK /CHECK VERTICAL MARGINS /A063 JMS CULCKP /CHECK LIST PROCESSING PRINTER. /A044 SZA /SKIP IF EXISTENT. /A044 JMP CUQCK1 /REPORT ERROR. /A044 CUQWQ1, DCA CUQFLG /SAVE WHETHER OR NOT TO QUEUE JMS CUCOPY MUBUF+MNPROP CDFMNU CUB1+FHPSET CDFMYF PRSETZ TAD CUQHBK /SET QUEUE BLOCK VALUES DCA QUQBLK+RXQBLK TAD (CUB1) DCA QUQBLK+RXQBAD TAD CUQHDV DCA QUQBLK+RXQDRV TAD (RXEWT+2000) DCA QUQBLK+RXQFNC JMS QURX /WRITE IT OUT CLA TAD CUQOPT /GET "LIST PROCESSING" FLAG. /A044 ISZ CUQFLG /ARE WE TO QUE? /A044 SZA CLA /SKIP IF NOT LIST PROCESSING. /A044 JMP CUQRET /RETURN IF LIST PROCESSING OR NOT Q-ING /A044 CDFMNU /SEE IF ANY FREE SPOTS IN THE QUEUE CLA TAD (-PQSZ) DCA T1 TAD I (PQADDR) /GET LENGTH AND FIRST ADDR DCA T2 CUQWO1, TAD I T2 /FIRST WORD (THE FILE NUMBER) FREE? SNA CLA JMP CUQWO2 /YES ISZ T2 /NO - SKIP OVER FLINK WORD TO NEXT ENTRY ISZ T2 ISZ T1 /ANY MORE? JMP CUQWO1 /YES DCA I (MUBUF+MNTMP1) /0 FOR NO MORE ROOM ERROR MESSAGE /A070 CDFMYF /NO MORE ROOM CIFMNU JMS I MNUCAL DLMPR1 /TELL USER BAD NEWS JMP CUQRET CUQWO2, TAD CUQFNO /GET FILE NUMBER TO BE QUEUED DCA I T2 /SAVE IN FIRST WORD OF QUEUE BLOCK TAD I (PQLAST) /GET ADDR OF LAST ENTRY IN QUEUE IAC /GET FLINK WORD DCA T1 /SAVE IN T1 TAD T2 /GET OUR ENTRY'S ADDR DCA I T1 /DO THE FLINKING JMP CUQWO3 /NEXT PAGE STRTPR, XX /START THE PRINTER DCA SPACTN /SAVE USER ACTION. /A035 TAD SPACTN /SEND IT TO THE PRINTER. /A035 CDFPRT /CDF TO PRINTER DCA I (PRACTN) /SET ACTION MQA DCA I (PRACTV) /AND AUX VALUE CDFMYF /BACK TO OUR FIELD. /A082 JMP I STRTPR /RETURN /-------------------- PAGE CUQWO3, TAD T2 /SET LASTP DCA I (PQLAST) ISZ T2 /ZERO OUR FLINK DCA I T2 TAD I (PQADDR) /GET ADDR OF QUEUE BLOCK START TO CALC OFFSET CDFMYF /BACK TO US CIA /NEGATE TAD T2 /SO WE GET OUR THING MINUS START CLL RTL /MULT BY 16 (ENTRY NUMBER TIMES 32.) CLL RTL AND (3740) /MAKE INTO OFFSET FROM BUFFER FOR NAME TAD (CUB1) DCA CUQWO5 /SAVE IN COPY CALL TAD (RXERD) /SET UP READ OF QUEUE NAME BLOCK DCA QUQBLK+RXQFNC TAD (DLPRQ) DCA QUQBLK+RXQBLK JMS CUPDRS /SET TO SYSTEM DRIVE JMS QURX /READ IT INTO BUF1 CLA /GET ADDR OF FILE NAME CDFMNU TAD I (FNAMSP) CDFMYF DCA CUQWO4 JMS CUCOPY /COPY NAME INTO BUFFER CUQWO4, 0 /WHERE IT COMES FROM CDFMNU CUQWO5, 0 /WHERE IT GOES CDFMYF 37 /ONLY FIRST 31. CHARS, LAST STAYS ZERO JMS CUQWO6 /MAKE SURE EVERY NAME ENDS WITH A SPACE /A050 TAD (RXEWT+2000) /NOW WRITE IT BACK OUT DCA QUQBLK+RXQFNC JMS QURX JMP CUQRET /DONE /THIS SUBROUTINE IS ENTERED WHEN THE USER HAS SELECTED AN OPTION FROM /THE STOP PRINT MENU. IT WILL POLE THE PRACTN FLAG AND EXIT WHEN IT WAS /CLEARED. IF NUMTEN/10 SECONDS OF REAL TIME PASSES AND THE NUMBER IN /BUFCNT HAS NOT CHANGED, THE PABORT FLAG IS SET (BECAUSE THE PRINTER IS /PROBABLY OFF LINE). THIS TELLS THE PRINTER CODE TO ABORT. THE PRINTER CODE /WILL THEN SET THE PRACTN FLAG AND THIS ROUTINE WILL EXIT NORMALLY. /A) THE PRINTER IS OFF LINE AND /B) THE USER HAS SELECTED AN OPTION FROM THE STOP PRINT MENU /CONSTANTS /HBCNT: IN FIELD 0, POINTS TO ADDRESS OF HANDLER BUFFER COUNT NUMTEN= -36 /NUMBER OF TENTHS OF SECONDS TO WAIT /M035 /CHANGED TO 3.0 SECS. /M035 /AND SEE IF HUNG WAITPR, XX WAITP1, /ADDED LABEL TO AVOID PROBLEMS /A040 CDFSYS /CHANGE TO SYSTEM DATA FIELD /M010 TAD I (HBCNT) /GET ADDRESS OF HANDLER BUFFER COUNT DCA TEMP /SAVE TO INDIRECT THROUGH TAD I TEMP /GET THE BUFFER COUNT CDFMYF /CDF BACK TO MY FIELD DCA BUFCNT /AND STORE IN BUFCNT TAD (NUMTEN) /NOW GET HOW MUCH TIME TO WAIT DCA COUNT /AND STORE IN COUNT WATPR, CDFPRT /CDF TO PRINTER FIELD TAD I (PRACTN) /DONE YET? CDFMYF SNA SPA CLA /SKIP IF AC GREATER THAN ZERO /C040 JMP I WAITPR /EXIT IF DONE CIFSYS JWAIT /ELSE WAIT /NOW CHECK TIME /IF THE SAVED ACTION WAS RESUME, THEN ENOUGH JWAITS /A045 /HAVE OCCURED TO LET THE STOP OVERLAY PROCESS THE ACTION /A045 /SO EXIT NOW /A045 TAD (-6) /CHECK FOR 'RESUME' ACTION /A035 TAD SPACTN /A035 SNA CLA /SKIP IF NOT RESUME. ABORT PRINTER /A035 JMP I WAITPR /JUST RETURN IF RESUME /A035 /C079 CDFSYS /CDF TO FIELD 0 TAD I TENADR /GET TENTHS OF A SECOND CDFMYF CIA TAD TENTH /IF TENTHS IS SAME SNA CLA JMP WATPR /THEN JUMP TO WATPR CDFSYS /ELSE CDF TO SYS TAD I TENADR /GET NEW TENTHS CDFMYF /CDF BACK TO MY FIELD DCA TENTH /AND STORE NEW TENTHS ISZ COUNT /INCREMENT COUNT JMP WATPR /IF TIME NOT UP THEN JUMP TO WATPR /AT THIS POINT THE TIMER HAS EXPIRED /A045 TAD BUFCNT /GET SAVED HANDLER BUF COUNT CLL CIA CDFSYS TAD I TEMP /COMPARE WITH NEW BUF COUNT SZA CLA /IF BUF COUNT HAS CHANGED /ADDED CLA /V045 JMP WAITP1 /THEN REENTER ROUTINE /AT THIS POINT THE BUFFER COUNT HAS NOT CHANGED /A045 /AND THE TIME IS UP /A045 CDFPRT TAD I (PABORT) /SEE IF ABORT FLAG IS SET /A052 SZA CLA /A052 JMP WAITP3 /YES, GO RESET HANDLER BUFFER /A052 AC0001 /SO SET THE ABORT FLAG DCA I (PABORT) CDFMYF /AND DO A JWAIT /A045 CIFSYS /A045 JWAIT /A045 JMP WAITP1 /GO TRY AGAIN /A052 /RESET THE HANDLER POINTERS /A052 WAITP3, CDFMYF /!!! *** (DECII-158) *** !!! /A079 CIFSYS /LET THE HANDLER DO IT /A075 AC7777 /BY CALLING WITH NEG. AC /A075 LPTOU /CALL HANDLER /A075 CIFSYS /A052 JWAIT /A052 JMP I WAITPR /AND RETURN /A045 /THIS ROUTINE IS HERE BECAUSE IT DOESN'T FIT WHERE IT BELONGS /A084 SAMFIL, XX /HERE TO SEE IF SOURCE AND RESULT = /A084 CDFMNU /NOW SEE WHAT CAME FROM MENU INPUT /A084 AC0004 /NEED TO RESTORE FLAG RESET BY 1ST LP2 /A084 DCA I (MUBUF+MNTMP4) /TO XFER AND RETURN TO/FROM TBO MENU /A084 TAD I (MUBUF+MNFNO) /FOR RESULT FILE NAME /A084 CIA /NEGATE IT FOR TEST /A084 CDFMTH /READ-ONLY-FILE # WAS STORED HERE /A084 TAD I (7500) /HERE TO BE SPECIFIC /A084 CDFMYF /NEED TO BE WHERE WE ARE /A084 SZA CLA /SKIP IF SAME FILE FOR SOURCE & RESULT /A084 JMP I SAMFIL /JUST LEAVE NOW. IS OK /A084 CIFMNU /GO CALL A LIST PROCESSING ERR MESSAGE /A084 JMS I MNUCAL /GO USE THIS ERROR MENU /A084 DLMCR2 /GIVES NO CHOICE BUT RETURN /A084 JMP RESRPT /GIVE ANOTHER CHANCE (OR GOLD MENU) /A084 /-------------------- PAGE /BUFFERS CUB1 AND CUB2 MOVED TO WPCRE, CONDITIONALIZED ON IFDEF WPCUT /A063 /************************************************************************ / CUSTOP--STOP THE PRINTER COMMAND / THIS ROUTINE IS CALLED WHEN THE USER HITS S FROM / MAIN MENU TO PUT UP THE STOP MENU / THE SELECTIONS ON THE STOP MENU ARE DEPENDENT ON / TWO PARAMETERS: 1) WHETHER OR NOT THE PRINT QUEUE / IS EMPTY, AND 2) THE ENTRIES IN A TABLE INDEXED / BY THE ERROR CODE. IF THE QUEUE IS EMPTY, THEN / THE ONLY OPTIONS WHICH APPEAR ON THE MENU ARE S AND L. / A071...PRSTOP IS SET FIRST. THEN WE HAVE SOME JWAITS / SO THE PRINTER CODE CAN SEE THAT WE WANT TO STOP / IF THE PRINTER CODE IS DOING AN ID IT WILL DECLARE / A NON EXISTENT PRINTER WHEN IT SEES THE STOP FLAG / AND THE STATUS WILL BE UPDATED BEFORE WE TAKE THE / SNAPSHOT FOR THE MENU. /C071 /************************************************************************ CDFQUE=CDFMNU /A048 CUSTOP, XX JMS STOPPR /STOP THE PRINTER /A071 CUSL1, CDFPRT /CDF TO PRINTER TAD I (PRSTTS) /GET STOP REASON CDFMNU DCA I (MUBUF+MNQINI) /SAVE FOR MENU /C076 CDFQUE /A048 TAD I (PQFRST) /SEE IF ANYTHING IN QUEUE /A048 CDFMNU /IF THERE IS /A048 SNA CLA /SET UP THE QUEMASK /A054 TAD (2020-7777) /2020 ALLOWS ONLY N /A054 TAD (7777) /INITIALIZE VALID ACTIONS /A058 DCA X5 /A058 TAD I (MUBUF+MNQINI) /GET STOP REASON /C076 SNA /IF PRINTER IS NOT IN USE /A057 JMP CUSL2M /BYPASS STOPPING PRINTER /A057 /WE READ SMTAB TO DETERMINE WHAT OPERATOR RESPONSES ARE ALLOWED /C068 JMS VACHK /CHECK FOR VALID ACTION /A058 CDFMNU /A049 DCA I (MUBUF+MNTMP6) /PASS VALUE TO MENU /A049 CDFPRT /A041 TAD I (PRQPNT) /PICK UP DOCUMENT DESTINATION /A041 CDFMNU /A041 DCA I (MUBUF+MNTMP3) /PASS TO MNTMP3 /A041 CDFPRT /A077 TAD I (PRQPNT-3) /PICK UP CURRENT SE SETTING /A077 CDFMNU /A077 DCA I (MUBUF+MNTMP7) /AND SEND UP TO MENU /A077 CUSL2M, CDFMYF /BYPASS JMS STOPPR /A057 CIFMNU /CALL THE MENU JMS I MNUCAL DLMPS1 /WITH PRINTER STOP MENU AS ARG /THE USER NOW RESPONDS TO THE STOP MENU /A054 CDFMNU /LOOK AT RESULTS TAD I (MUBUF+MNQINI) /FIRST, SEE IF WAS NOT IN USE /C076 SNA CLA /A057 JMP CUSNIU /WAS, GO RESET PRSTOP & EXIT /C085 TAD I (MUBUF+MNTMP5) SPA /CHECK FOR LIST QUEUE (-1) JMP CUSLQ /YES SNA JMP CUSTQT TAD (-10) /SEE IF SL /A076 SNA /A076 JMP CUSSL /YES /A076 IAC /NO, BUMP UP TO RESUME (-6) /A076 IAC /A076 SNA /SKIP IF NOT RESUME JMP CUSL3 /LET RESUME CODE PROCESS TAD (6) /NO, GET BACK AND FEED TO PRINTER MQL TAD I (MUBUF+MNTMP2) SWP JMS STRTPR /START PRINTER CUSL4, JMS WAITPR /WAIT FOR DONE CDFPRT /CDF TO PRINTER TAD I (PRSTOP) /STILL STOPPED? SZA CLA JMP CUSL1 /BACK TO MENU IF SO CUSTQT, CDFMYF /RETURN TO MAIN MENU JMP I CUSTOP /ALL DONE CUSL3, JMS CURPRT /DO A RESUME JMP CUSTQT /AND GO RETURN /A052 CUSLQ, CDFMYF /BACK TO OUR FIELD JMS CURDQB /READ QUEUE BLOCK WITH NAMES RXERD TAD (605) /INIT LINE FOR OUTPUT DCA CUSLIN CDFMNU TAD I (PQFRST) CDFMYF /GET ADDR OF FIRST ENTRY IN QUEUE SNA JMP CUSWAT /NONE - WAIT FOR RETURN JMP CUSLQ1 /GO TO ANOTHER PAGE COURTESY BUCK ROGERS CUSSL, /SL FROM STOP MENU /A076 JMS CURWPQ /CALL THE RL/SL SUBROUTINE FOR SL /A076 JMP CUSL1 /RETURN TO STOP PRINTER MENU /A076 /THIS CODED ADDED TO FIX WPWV2-60; S RETURN (THE PRINTER IS NOT IN /USE), RETURN (TO MAIN MENU), N RETURN (GAVE NEW PAGE AND /"PRINTER STOPPED" (NON EXISTENT PRINTER) CUSNIU, CDFPRT /PRINTER NOT IN USE /A085 DCA I (PRSTOP) /RESET STOP FLAG /A085 JMP CUSTQT /GO EXIT CUSTOP /A085 /*********************************************************************** /VACHK--VALID ACTION CHECK /THIS ROUTINE READS THE SMTAB AND PERFORMS A CONJUNCTION OF X5 AND THE /TABLE ENTRY. IT IS ENTERED WITH THE INDEX OF THE TABLE IN THE AC AND /THE SIX BIT CONJUNCTION RESULT IS IN THE AC UPON EXIT. /*********************************************************************** VACHK, XX /VALID ACTION CHECK /A058 CDFMYF /A054 TAD (SMTAB-1) /ADD TO TABLE BASE /A054 DCA X4 /SAVE IN AN INDEX REGISTER /A054 TAD I X4 /READ THIS ENTRY /A054 /NOW PERFORM THE CONJUNCTION /A054 AND X5 /BOTH MUST BE 1 TO BE ALLOWED /A054 DCA X5 /AND SAVE THE RESULT /A054 /NOW PICK THE CORRECT HALF OF THE WORD /A054 JMS GTLP /SEE WHAT KIND OF PRINTER IS ON LINE /C058 AND (LQPSE) /SEE IF IS LQPSE /A060 CIA /A060 TAD (LQPSE) /A060 CLL /CLEAR LINK /A060 SZA CLA /A060 STL /IF NOT LQPSE, SET THE LINK /A060 TAD X5 /GET THE TABLE ENTRY BACK /A049 SZL /SKIP IF LQPSE /A049 BSW /SWAP FOR LPQ02 OR DP /A049 AND P77 /MASK /A049 JMP I VACHK /A058 /-------------------- PAGE /CULPCM - LIST PROCESSING START COMMAND CULPCM, XX CLA CIFMNU JMS I MNUCAL DLMLP1 /PUT UP FIRST MENU DCA FORMNO /ZERO FILE NUMBERS FOR ERROR RECOVERY DCA OTFIL DCA LSTFIL DCA CULSFO CDFMNU TAD I (MUBUF+MNTMP3) CDFMYF /GET RETURNED VALUE SNA JMP CULRT1 /GOLD MENU - JUST RETURN DCA CULACT /SAVE AS ACTION DESIRED CDFMNU /GET ADDR OF FILENO TAD I (FNAMSP) CDFMYF DCA CULFNM AC7776 /SEE IF 2 (MEANING TO PRINTER) TAD CULACT SZA JMP CULPC1 /NO CDFPRT /YES, SEE IF PRINTER IDLE TAD I (PRSTTS) CDFMYF /SAVES 2 OF THESE ON NEXT PAGE /A084 SZA CLA JMP CULPSB /NO, TELL USER IT'S BUSY JMP CULPC0 CULRT1, JMP I CULPCM /RETURN TO CALLER IFDEF DUTCH < /A016 CULS5, TEXT "AFGEDRUKT" /A016 > /END IFDEF DUTCH /A016 CUSAGN, CDFMNU TAD I CUSADR CDFMYF /GET ENTRY IN QUEUE SNA JMP CUSWAT /DONE DCA T1 TAD T1 AND P377 DCA CUSFNO /SAVE FILENO FOR OUTPUTTING TAD T1 BSW RTR AND (17) DCA CUSDR2 /SAVE DRIVE NUMBER FOR OUTPUT TAD CUSADR TAD CUSDIF /CALC NAME ADDR CLL RTL CLL RTL TAD (CUB1) DCA CUSSAD CIFMNU JMS I IOACAL 0 CUSSTG /OUTPUT INFO CUSLIN, 0 CUSDR2, 0 CUSFNO, 0 CUSSAD, 0 AC0100 /INCR LINE NUMBER CLL RAL TAD CUSLIN DCA CUSLIN ISZ CUSADR /DO FLINK STUFF CDFMNU TAD I CUSADR CDFMYF SNA JMP CUSWAT /NONE - DONE DCA CUSADR /NEXT ENTRY JMP CUSAGN CUSSTG, TEXT '^P(^D.^D) ^A' CUSLQ1, DCA CUSADR /SAVE PQFRST CDFMNU TAD I (PQADDR) CDFMYF CIA /GET DIFFERENCE TO CALC POSITION DCA CUSDIF JMP CUSAGN CUSWAT, CIFMNU JMS I MNUCAL DLMPS2 /WAIT FOR RETURN JMP CUSL1 /DONE - BACK TO STOP MENU /********************************************************************** /SMTAB--SELECTIVE STOP MENU TABLE /TABLE IS INDEXED BY PRSTTS. THE ENTRIES ARE BIT PATTERN SELECTORS FOR /EACH OPTION ON THE STOP MENU, WHETHER OR NOT IT GETS DISPLAYED AND IS /THEREFORE ALLOWED ONLY ALLOWED OPTIONS ON THE MENU ARE DISPLAYED THE /TABLE IS DIVIDED IN HALF BITWISE THE LEFT HALF SERVES THE LQP02 AND /DRAFT PRINTERS THE RIGHT HALF SERVES THE LQPSE THE SIX BITS OF EACH /HALF WORD ARE ORGANIZED THUSLY: R=01 /LSB P=02 B=04 T=10 N=20 C=40 / S AND L ARE ALWAYS ALLOWED /*********************************************************************** SMTAB, /SELECTIVE STOP MENU TABLE /A049 7777 /0 -- NOT IN USE: /0 - A FULL LINE SO IF THERE IS NO 2ND ERROR /WE WILL NOT DISABLE OTHER OPTIONS R+P+B+T+N^100+R+P+B+T+N /1 - BUSY /C067 /C069 R+P+B+T+N^100+R+P+B+T+N /2 - USER REQUEST R+P+N^100+R+P+N /3 - SE FIRST R+B+T+N^100+R+B+T+N /4 - SE YES /C077 R+P+B+T+N^100+R+P+B+T+N /5 - END OF PAGE R+P+B+T+N^100+R+P+B+T+N /6 - TWO WHEEL CHANGE R^100+R /7 - NON EXISTENT PRINTER /C056 R+C^100+R+C /10 - CHANGE DOCUMENT DESTINATION 0^100+0 /11 - PAUSE ON AT PRTID R^100+R /12 - COMM BUSY 0^100+0 /13 - MALFUNCTION (HANDLER ABORT) 0^100+0 /14 - MALFUNCTION R+P+B+T+N^100+R+P+B+T+N /15 - PAUSE SWITCH ON R+P+B+T+N^100+R+P+B+T+N /16 - RIBBON OUT R+P+B+T^100+R+P+B+T /17 - LQP02 ASF ERROR R+P+B+T+N^100+R+P+B+T+N /20 - COVER OPEN R+P+B+T+N^100+R+P+B+T+N /21 - PAPER OUT R^100+R /22 - DOCUMENT READ ERROR /C061 0^100+0 /23 - SYSTEM DISK READ ERROR 0^100+B+T /24 - LQPSE ASF ERROR 0^100+0 /25 - LQPSE CANCEL RECEIVED /A053 B+T^100 /26 - COMMUNICATIONS ERROR /A067 0^100+0 /27 - MISMATCHED CONTROLS /A078 /-------------------- PAGE CULPSB, AC3777 /SET FLAG FOR BUSY MESSAGE CDFMNU DCA I (MUBUF+MNTMP2) CDFMYF CIFMNU JMS I MNUCAL /CALL MENU DLMLP4 CULRET, JMP CULRT1 /MADE INTO COMMON EXIT POINT /M083 CULPC1, IAC /SEE IF 1 (MEANING JUST DO SPEC CHECKING) SNA CLA JMP CULGSP /GET SPEC / *************** HANDLE THE LIST FILE NAME *************** /A066 CULPC0, CULPC2, AC0001 /GET LIST DOCUMENT NAME AND NUMBER JMS CULMCL /COPY NAME AND NUMBER TAD I (MUBUF+MNFNO) /GET NUMBER CDFMYF DCA LSTFIL /SAVE THE LIST FILE NUMBER TAD CULFNM /PATCH COPY COMMAND TO PICK UP STUFF DCA CULL1 JMS CUCOPY /COPY NAME TO OUR FIELD CULL1, 0 CDFMNU CULLFN CDFMYF STRLEN / *************** HANDLE THE SPEC FILE NAME *************** /A066 CULGSP, AC0002 /GET SPEC JMS CULMCL /CALL APPROPRIATE MENU TAD I (MUBUF+MNFNO) /PICK UP THE SPEC FILE NUMBER CDFMYF JMS FILCHK /CHECK TO SEE IF IT IS ALREADY IN USE /A066 JMP CULGSP /YES IT WAS, GO ASK FOR ANOTHER NAME /A066 DCA CULSFO /SAVE THE SPEC FILE NUMBER /A066 TAD CULFNM /GET POINTER TO FILE NAME BUFFER DCA CULL1A /STORE FOR COPY ROUTINE JMS CUCOPY /COPY THE NAME CULL1A, 0 CDFMNU CULSPN CDFMYF STRLEN AC7777 /CHECK IF SPEC (MEANING DONE) TAD CULACT SNA CLA JMP CULTSP /YES - JUST TEST SPEC / *************** HANDLE THE FORM FILE NAME *************** /A066 CULFOR, AC0003 /GET FORM NAME AND NUMBER /M066 JMS CULMCL TAD I (MUBUF+MNFNO) /PICK UP THE FORM FILE NUMBER CDFMYF JMS FILCHK /CHECK TO SEE IF IT IS ALREADY IN USE /A066 JMP CULFOR /YES IT WAS, GO ASK FOR ANOTHER NAME /A066 DCA FORMNO /SAVE THE FORM FILE NUMBER TAD CULFNM /GET POINTER TO FILE NAME BUFFER /A027 DCA CULL2 /STORE FOR USE OF COPY ROUTINE JMS CUCOPY CULL2, 0 CDFMNU CULFFN CDFMYF STRLEN AC7776 TAD CULACT /SEE IF TO PRINTER SZA CLA JMP CULTOD /NO - TO DOCUMENT DCA OTFIL /TELL MERGER ROUTINE AC0001 JMS CUQPRT /CALL PRINT COMMAND TAD CUQFLG SZA CLA JMP CULTTS /NO - TIME TO START? CULABT, JMP CULRET /DONE CPOSTP, XX /HERE FOR POST PROCESSING /A083 CDFMNU /NEED TO GET AT MENU FLD /A083 TAD I (MUBUF+MNFNO) /CONTAINS DRV AND FILE NO /A083 CDFMTH /MATH FLD IS SAME AS WPSFF AND WPSPEL /A083 DCA I (7500) /WPSFF WILL NEED THIS IN FLD 6 /A083 TAD I (7500) /NEED IT AGAIN /A084 CDFMYF /IF I HAD A $ FOR EACH 1 OF THESE I 4GOT/A084 CIFFIO /AM GOING TO GO TO FLD 7 /A084 FILEIO /WHERE THIS ROUTINE IS /A084 XRDFIN /OPEN FILE FOR READ ONLY /A084 CDFFIO /NOW REF RESULT OF THIS CALL /A084 TAD I (RDFSIZ) /THIS LOC HOLDS # OF FREE BLKS ON DSKET /A084 CIA /MAKE IT NEG /A084 CDFMYF /NEED TO BE WHERE WE ARE /A083 DCA CUFSIZ /SAVE FOR LATER TEST /A084 RESRPT, CIFMNU /GET READY FOR "RESULT" MENU /A083 JMS I MNUCAL /GO TO IT /A083 DLMLP2 /THERE IS STILL A 4 IN MNTMP4 /A083 JMS SAMFIL /CK THAT RESULT FILE NOT = SOURCE FILE /A084 /** WARNING** ERROR RETURN IS TO RESRPT ABOVE /A084 CDFMNU /TO PICK UP MNU RESPONSE /A083 TAD I (MUBUF+MNTMP3) /WAS -1 FOR NON-EXIST FILE /A083 CDFMYF /BACK HERE /A083 SNA /WAS 0 FOR GOLD MENU /A084 JMP POSTEX /LEADS BACK TO MAIN MENU /A084 SMA CLA /SKIP TO CREATE NEW FILE /A083 JMP CRTSKP /DONT NEED TO CREATE A NEW FILE /A083 JMS ADRCRT /GO CREATE DESIRED FILE ALLOCATION /A083 JMP CRTERR /MNTMP1 HAS BEEN SET FOR ERRORTYPE /A083 CDFMNU /I THINK THE AC CONTAINS DOC # /A083 DCA I (MUBUF+MNFNO) /PLUG IN FOR SUBSEQUENT OPEN /A083 CRTSKP, CDFMNU /NEED WHEN HERE BY JMP CRTSKP /A084 TAD I (MUBUF+MNDRV) /NEED DRIVE # FOR SPACE REMAINING TEST /A084 CDFMYF /NEVER FORGET TO COME BACK TO WHERE U R /A083 DCA CUPDRV /SIZE TEST LOOKS HERE FOR DRIVE # /A084 JMP CONTAP /CONTINUE ON A PAGE THAT HAS ROOM /A084 POSTEX, JMP I CPOSTP /NEED COMMON EXIT ON THIS PAGE(INCL.ERR /A084 IFDEF CANADA < /A017 CULSBT, TEXT "AJOUT[ LA FIN DU " /M023 > /END IFDEF CANADA /A017 /-------------------- PAGE /SUBROUTINE TO CHECK IF THE SPECIFIED FILE NUMBER HAS ALREADY /A066 /BEEN SPECIFIED AS AN INPUT FILE BY THE USER. IT CHECKS THE /A066 /FILE NUMBER AGAINST THE LIST DOCUMENT, SPEC DOCUMENT AND THE /A066 /FORM DOCUMENT NUMBER. THE CALLING CONVENTION IS AS FOLLOWS: /A066 / TAD FILE-NUMBER-TO-CHECK /A066 / JMS FILCHK /A066 / ERROR-RETURN /LOCATION FOR FILE ALREADY IN USE /A066 / NORMAL-RETURN /AC CONTAINS FILE NUMBER /A066 FILCHK, XX /CHECK IF FILE NUMBER HAS BEEN USED /A066 CIA /MAKE FILE NUMBER NEGATIVE /A066 DCA T1 /STORE NUMBER FOR CHECKS BELOW /A066 TAD LSTFIL /GET THE LIST FILE NUMBER /A066 TAD T1 /COMBINE WITH FILE NUMBER TO BE CHECKED /A066 SNA CLA /SKIP IF NUMBERS ARE DIFFERENT /A066 JMP FILERR /MATCH - GO REPORT THE ERROR /A066 TAD CULSFO /GET THE SPEC FILE NUMBER /A066 TAD T1 /COMBINE WITH FILE NUMBER TO BE CHECKED /A066 SNA CLA /SKIP IF NUMBERS ARE DIFFERENT /A066 JMP FILERR /MATCH - GO REPORT THE ERROR /A066 TAD FORMNO /GET THE FORM FILE NUMBER /A066 TAD T1 /COMBINE WITH FILE NUMBER TO BE CHECKED /A066 SNA CLA /SKIP IF NUMBERS ARE DIFFERENT /A066 JMP FILERR /MATCH - GO REPORT THE ERROR /A066 ISZ FILCHK /BUMP RETURN ADDRESS TO SUCCESS RETURN /A066 TAD T1 /GET THE FILE NUMBER TO BE CHECKED /A066 CIA /RETURN IT TO IT'S CORRECT FORM /A066 JMP I FILCHK /GO RETURN TO CALLER /A066 FILERR, CIFMNU /'THIS FILE IS ALREADY IN USE' MESSAGE /A066 JMS I MNUCAL /CALL THE MENU OUTPUT ROUTINE /A066 DLMCR2 /A066 JMP I FILCHK /ERROR RETURN TO SELECT NEW NAME /A066 / *************** HANDLE THE RESULT FILE NAME *************** /A066 CULTOD, AC0004 /GET RESULT DOCUMENT NAME AND NUMBER JMS CULMCL AC0001 /A080 TAD I (MUBUF+MNTMP3) /SEE IF SHOULD CREATE FILE /A080 SNA CLA /A080 JMP CULTD0 /CREATE THE FILE /A080 CDFMNU /M080 TAD I (MUBUF+MNFNO) /PICK UP THE OUTPUT RESULT FILE NUMBER /M080 CDFMYF /M080 JMS FILCHK /CHECK TO SEE IF IT'S ALREADY IN USE/A066/M080 JMP CULTOD /YES IT WAS, GO ASK FOR ANOTHER NAME/A066/M080 DCA OTFIL /SAVE THE OUTPUT RESULT FILE NUMBER /M080 TAD (5) /CHECK FOR TOP,BOTTOM,OVERWRITE /A080 JMS CULMCL /A080 JMP CULTD1 /DON'T CREATE THE FILE CULTD0, CDFMYF AC7777 /SET FOR OVERWRITE DCA CULTBO JMS CULCRE /CREATE THE DOCUMENT, RETURN WITH FILE NUMBER DCA OTFIL /SAVE NEW FILE INFO /A081 JMP CULTD2 /JOIN COMMON CODE CULTD1, TAD I (MUBUF+MNTMP1) /SAVE TOP, BOTTOM, OVERWRITE CDFMYF DCA CULTBO AC7776 TAD CULTBO SNA CLA /SEE IF GOLD MENU ? JMP CULTOD /YES, GIVE ANOTHER CHANCE CULTD2, TAD CULFNM /GET POINTER TO FILE NAME BUFFER DCA CULL3 /STORE FOR COPY ROUTINE JMS CUCOPY CULL3, 0 CDFMNU CULRFN CDFMYF STRLEN CULTTS, AC0001 CDFMNU DCA I (MUBUF+MNTMP2) /SET FROM-TO DCA I (MUBUF+MNTMP3) CDFMYF CULT0, TAD LSTFIL /GET FILE AND DRIVE NUMBERS AND P377 DCA CULSC1 TAD LSTFIL BSW RTR AND (17) DCA CULSC2 TAD CULSFO AND P377 DCA CULSC3 TAD CULSFO BSW RTR AND (17) DCA CULSC4 TAD FORMNO AND P377 DCA CULSC5 TAD FORMNO BSW RTR AND (17) DCA CULSC6 CIFMNU JMS I IOACAL /OUTPUT WHAT WE THINK THINGS ARE 0 CULS1 0 IFNDEF CANADA < 505 > IFDEF CANADA < 500;141 >/FRECAN WANTED 0 MARGIN CULSC2, 0 CULSC1, 0 CULLFN IFNDEF CANADA < 605 > IFDEF CANADA < 600 > /0MARGIN CULSC4, 0 CULSC3, 0 CULSPN IFNDEF CANADA < 705 > IFDEF CANADA < 700 > /0MARGIN CULSC6, 0 CULSC5, 0 CULFFN IFNDEF CANADA < 1005 > IFDEF CANADA < 1000 > /0MARGIN JMP CULTT0 /CONTINUE ON NEXT PAGE CULTBO, 0 CULSTB, CULSOV CULSTP CULSBT /-------------------- PAGE CULTT0, AC7776 /TO PRINTER? TAD CULACT SZA CLA JMP CULT1 /NO CIFMNU JMS I IOACAL /YES 0 CULS5 JMP CULT2 CULT1, AC0001 TAD CULTBO /GET CORRECT STRING FOR TOP, BOTTOM, OVERWRITE TAD (CULSTB) DCA CULT1A IFDEF GERMAN < JMS GERPHR /PRINT SPECIAL PHRASE > /END IFDEF GERMAN TAD OTFIL /BREAK OUT FILE AND DRIVE NUMBERS AND P377 DCA CULSC7 TAD OTFIL BSW RTR AND (17) DCA CULSC8 CIFMNU JMS I IOACAL 0 /DEFAULT OUTPUT ROUTINE CULS6 /'DOCUMENT: (X.Y)' CULT1A, XX CULSC8, 0 CULSC7, 0 CULRFN /IF BOTTOM MESSAGE HAS BEEN DISPLAYED MUST STICK A L.G.A ON SCREEN FOR CANADA /A023 IFDEF CANADA < JMS CANLGA > /A023 CULT2, CIFMNU JMS I MNUCAL DLMLP3 /CALL MENU FOR GO /CHECK WHAT TO DO (NOTE MENU SHOULD LEAVE AC 0) CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF SNA JMP CULABT /ABORT - GOLD MENU PRESSED TAD (-1) SNA CLA JMP CULT0 /ERROR - TRY AGAIN CDFMNU TAD I (MUBUF+MNTMP2) CDFMYF DCA CULFRM /COPY FROM-TO CDFMNU TAD I (MUBUF+MNTMP3) CDFMYF DCA CULTO CULT3, TAD CULTBO /SET TO OVERWRITE RESULT, IF ANY DCA OTACT TAD (CULSFO) /ADDR OF SPECIFICATION INFO DCA SPCADR JMS CUPSOL /SET OVERLAY CHAIN 6 200 CIF 10 /FOR PARSER ISZ CULP /DO SKIP RETURN JMP CULRT1 /TO CHAIN CULTSP, DCA FORMNO /TEST SPEC ONLY JMP CULT3 /GET TO PARSER /CALL THE MENUS. AC CONTINS THE NUMBER OF THE MENU TO CALL. CULMCL, 0 /CALL MENU FOR LIST, ETC. CDFMNU DCA I (MUBUF+MNTMP4) /WHAT TO DO IS IN AC CDFMYF CIFMNU JMS I MNUCAL DLMLP2 CDFMNU /CHECK FOR GOLD MENU - MENU LEAVES AC 0 TAD I (MUBUF+MNTMP3) /LEAVES FIELD AT MNUFLD SNA CLA JMP CULRET JMP I CULMCL /CREATE THE OUTPUT FILE CULCRE, XX JMS ADRCRT /CREATE OUTPUT FILE JMP CULRET /COULDN'T DO IT /ADRCRT RETURNS WITH CUPFNO IN AC ALREADY. JMP I CULCRE IFDEF GERMAN < /GERPHR /THIS ROUTINE WILL PRINT OUT "INSERTED AT THE TOP OF/BOTTOM OF" IN GERMAN /ALLOWING UPPERCASE AND LOWERCASE CHARACTERS GERPHR, 0000 TAD I CULT1A /GET THE ACTUAL STRING POINTER INSTEAD OF TABLE LOC. DCA CULT1A /SAVE IT AS THE IOA PARAMETER CIFMNU JMS I IOACAL /PRINT THE MESSAGE DESIRED 0 /USING DEFAULT OUTPUT ROUTINE CULT1A, XX /MESSAGE STRING JMP I GERPHR /RETURN > /END IFDEF GERMAN CULSOV, IFNDEF CANADA < 0 > /NO MORE TEXT /A023 IFDEF CANADA < TEXT 'LE ' > /A023 /THE FOLLOWING THREE LOCATIONS ARE ASSUMED TO BE IN THIS ORDER BY THE /PARSER. (SEE WPSSDF.PA FOR DETAILS) CULSFO, 0 /SPECIFICATIONS FILE NUMBER WITH DRIVE NUMBER CULFRM, 0 CULTO, 0 CUFSIZ, 0 /TO STORE NEG FREE SPACE /A084 WPSCEX, ISZ CUFF /TO EXIT CORRECTLY /A083 JMS CUPSOL /SET OVERLAY STUFF /A083 21 /OVERLAY # (TO CALL NEXT) /A083 7400 /STRTUP IN DLOPPI /A083 CIF 10 /WILL RUN IN FIELD 3 RETURN TO FLD 2 /A083 JMP POSTEX /EVENTUALLY GETS TO 2CMF TO CALL WPSC /A083 CONTAP, JMS CUPCSZ /CHECK FOR ROOM IN DISK /A084 JMP CSZERR /CAUSE NOT EVEN 8 BLOCKS LEFT /A084 TAD CULTO /RETRIEVE NEG SIZE OF READ ONLY FILE /A084 TAD QUQBLK+RXQSPC /SPACE LEFT (LOADED BY CUPCSZ) /A084 SMA CLA /SKIP TO HANDLE 'TOO BIG' /A084 JMP WPSCEX /GO TO SET UP FOR NORMAL EXIT /A084 CSZERR, AC0004 /CASE FOR ERROR MENU /A084 CDIMNU /IN MENU FLD /A084 DCA I (MUBUF+MNTMP1) /FOR SPECIAL CASE IN PP2 ERROR MENU /A084 CDFMYF /THIS IS WHERE WE WANT TO COME BACK TO /A084 JMS I MNUCAL /GO PUT UP ERROR MSG /A084 DLMPP2 /ERROR MENU BLK /A084 CRTERR, CDFMNU /SEE WHAT HAPPENED THERE /A083 TAD I (MUBUF+MNTMP6) /WAS SET TO 0 IF GOLD MENU /A083 CDFMYF /RETURN TO WHERE WE ARE /A083 SNA CLA /SKIP TO GIVE ANOTHER TRY /A083 JMP POSTEX /GOES BACK TO MM /A083 JMP RESRPT /REPEAT "RESULT" PROMPT IF NO GOLDMENU /A083 /-------------------- PAGE CULACT, 0 CULFNM, 0 CULLFN, ZBLOCK STRLEN CULFFN, ZBLOCK STRLEN CULRFN, ZBLOCK STRLEN CULSTP, IFDEF ENGLSH < TEXT 'INSERTED AT THE TOP OF ' > IFDEF ITALIAN < TEXT "INSERITO ALL'INIZIO DEL "> IFDEF DUTCH < TEXT "TOEVOEGEN AAN BOVENKANT VAN " > IFDEF V30NOR < TEXT 'TILF\XYET P\E TOPPEN AV'> /A088 IFDEF V30SWE < TEXT 'INSATT I B\VRJAN AV'> CULSBT, IFDEF ENGLSH < TEXT 'ADDED TO THE BOTTOM OF ' > IFDEF ITALIAN < TEXT "INSERITO ALLA FINE DEL " > IFDEF V30NOR /A088 IFDEF V30SWE < TEXT 'INSATT I SLUTET AV'> /EACH OF THE FOLLOWING TEXT STATEMENTS MUST HAVE AN EVEN /NUMBER OF CHARACTERS IF IT IS FOLLOWED BY A *.-1 CULS1, IFDEF ENGLSH < TEXT '^P!E^P&SELECTING FROM LIST DOCUMENT: (^D.^D) ^A ' *.-1 TEXT '^P&USING SELECTION SPECIFICATION: (^D.^D) ^A ' *.-1 TEXT '^P&THE SELECTED RECORDS WILL BE MERGED WITH DOCUMENT: (^D.^D) ' *.-1 TEXT ' ^A^P&THE RESULT WILL BE ' > /END IFDEF ENGLISH IFDEF ITALIAN < TEXT '^P!E^P&DOCUMENTO LISTA: (^D.^D) ^A ' *.-1 TEXT '^P&DOCUMENTO SPECIFICA DI SELEZIONE: (^D.^D) ^A ' *.-1 TEXT '^P&DOCUMENTO MODULO: (^D.^D) ' *.-1 TEXT ' ^A^P&DOCUMENTO USCITA ' > IFDEF V30NOR < TEXT '^P!E^P&VELGER UT FRA LISTEDOKUMENT: (^D.^D) ^A ' *.-1 TEXT '^P&BRUKER UTVALGSSPESIFIKASJON: (^D.^D) ^A ' *.-1 TEXT '^P&UTVALGTE POSTER BLIR SL\ETT SAMMEN MED DOKUMENT: (^D.^D) ' *.-1 TEXT ' ^A^P&RESULTATET BLIR' > /END IFDEF V30NOR IFDEF V30SWE < TEXT '^P!E^P&V\DLJ I REGISTERDOKUMENTET: (^D.^D) ^A ' *.-1 TEXT '^P&ANV\DND URVALSSPECIFIKATIONEN: (^D.^D) ^A ' *.-1 TEXT '^P&DE VALDA POSTERNA KOMMER ATT L\DGGAS IN I DOKUMENTET: (^D.^D) ' *.-1 TEXT '^A^P&SLUTRESULTATET BLIR: ' > /END IFDEF V30SWE CULS5, IFDEF ENGLSH < TEXT 'PRINTED' > IFDEF ITALIAN < TEXT /VIENE STAMPATO/ > IFDEF V30NOR < TEXT 'SKREVET UT'> /A088 IFDEF V30SWE < TEXT 'UTSKRIVET'> CULS6, IFDEF ENGLSH < TEXT '!SDOCUMENT: (^D.^D) ^A' > IFDEF ITALIAN < TEXT /!S: (^D.^D) ^A/ > IFDEF DUTCH < TEXT "!SDOCUMENT: (^D.^D) ^A" > IFDEF V30NOR< TEXT "!SDOKUMENT: (^D.^D) ^A" > /A088 IFDEF V30SWE < TEXT 'DOKUMENT'> CULSPN, ZBLOCK STRLEN /ONE OF THE LIST PROCESSING BUFFERS CURWST, TEXT '^^A^<#>^D^<>^A' CURWBN, ZBLOCK 4 /THIS ROUTINE MAKES SURE THAT THE PRINTER TYPE SPECIFIED FOR LIST /M044 /PROCESSING IS ON LINE. THE RETURNS ARE: /M044 / AC = 0 PRINTER (OR HOST) IS ONLINE. /M044 / AC = 1 PRINTER ON LINE DOESN'T MATCH DD /M044 / AC = 2 REQUESTED PRINTER TYPE NOT ONLINE /M044 CULCKP, XX TAD CUQOPT /GET CUQPRT OPTION. SEE IF CALLED FROM LP/A044 SNA CLA /SKIP IF CALLED FROM LIST PROCESSING. /A044 JMP I CULCKP /RETURN 0 (OK RETURN) IF REGULAR QUEING A DOC /A044 /WE MUST NOW MAP THE SETTINGS WHICH ARE POSSIBLE ON THE RL BASED SYSTEMS /TO MORE APPROPRIATE SETTINGS CDFMNU AC3777 /GET DOCUMENT DESTINATION AND MASK OUT /A013 AND I (MUBUF+MNPROP+23)/SIGN BIT TO ASSURE IT IS POSITIVE /A013 CDFMYF /CHANGE DATA FIELD TO MY FIELD /A013 DCA T1 /AND STORE ID TAD T1 /AND RETRIEVE IT AGAIN TAD (DDTABL-DDEND) /USE IT AS CHECK IF OUT OF RANGE OF TABL/A013 SMA CLA /IS PRQPNT OUT OF RANGE? /M044 JMP DDCHK /JMP IF YES. USE DEFAULT VALUE. /M044 /JUMP HERE IF PRQPNT IS IN THE RANGE OF OUR TABLE TAD (DDTABL) /GET ADDRESS OF TABLE OF DOCUMENT DEST'S/A013 TAD T1 /USE CURRENT DESTINATION AS OFFSET /A013 DCA T1 /STORE ADDRESS OF NEW DESTINATION /A013 TAD I T1 /PUT NEW DESTINATION INTO AC /A013 DDCHK, TAD DDEFAU /ADD IN DEFAULT BAIS. /A044 DCA T2 /SAVE DOC'S DD. /A044 TAD T2 /SEE IF DD HOST. /A044 TAD (-DHOST) /A044 SNA CLA /SKIP IF NO. GET PRINTER ID. /A044 JMP CHKHST /DO HOST CHECKING. /A044 TAD T2 /GET DECMATE DOC DEST /A074 CDFPRT /IN THE PRINTER FIELD DCA I (PRQPNT) /SET THE DOCUMENT DESTINATION /A074 TAD I (PRTID) /GET ADDRESS OF PRINTER ID CDFMYF DCA T1 /SAVE TO CALL THRU. /A034 CIFPRT /SET UP TO DO A CALL TO IT. /A034 AC0001 /SPECIFY PRINTER ID /A034 JMS I T1 /CALL PRTRID ROUTINE /A034 SKP /SUCCESS RETURN. PRINTER IS ONLINE. /A034 JMP CULCK2 /ERROR RETURN. NON-EXISTENT PRINTER. /A034 AC0002 /SPECIFY CHECK DOCUMENT DESTINATION /A074 CIFPRT /IN THE PRINTER FIELD /A074 JMS I T1 /CALL TO CHECK DOCUMENT DESTINATION /A074 JMP CULRTN /DD OK /A074 JMP CULCK1 /WRONG DD /A074 CHKHST, CDFSYS /CMONLN IS IN SYSTEM FIELD /A060 TAD I (CMONLN) /GET THE COMM FLAG WORD /A060 CDFMYF /A060 SZA CLA /SKIP IF NO COMM HARDWARE /A060 JMP CULRTN /COMM PRESENT. RETURN TO CALLER. /A044 CULCK2, IAC /RETURN AC = 2. NON-EXISTENT PRINTER ERROR/A044 CULCK1, IAC /RETURN AC = 1. PRINTER NOT ATTACHED ERROR/A044 CULRTN, JMP I CULCKP /EXIT /CHECK FOR INDEX BLOCK=0 /IF 0 EXIT.... CAN OCCUR IF DISKETTE DOES NOT CONTAIN / DOCUMENT SPECIFIED IN DEFAULT / OCCURS IF INDEX SET AT DOC THEN DISKETTE CHANGED / AND PRINT COMMAND REQUESTEDUSING DEFAULT CUINDX, 0 /A055 JMS QURX /A055 CLA /A055 TAD QUQBLK+RXQBLK /GET HDR BLK /A055 SZA CLA /IS 0? /A055 JMP I CUINDX /NO..CONT. /A055 JMP CUQRET /YES GO TO EXIT(IGNORE) /A055 /-------------------- PAGE CURWPQ, XX /ROUTINE TO STORE AND RECALL THE PRINTER QUEUE CLA CDFMNU TAD I (MUBUF+MNFNO) /PICK UP FILE NO. FROM MENU CDFMYF DCA CURWFN /AND SAVE CDFMNU AC7776 TAD I (MUBUF+MNTMP3) /PICK UP TMP 3 TO SEE WHETHER RL OR SL COMMAND CDFMYF SZA CLA /1= RL, 2 = SL JMP CURWRL /GO DO RL STUFF CDFMNU TAD I (MUBUF+MNTMP1) /TMP1 HAS TOP, BOTTOM, OR OVERWRITE CDFMYF DCA CURWOP AC0002 /NO, TEST IF NEED TO CREATE FILE TAD CURWOP SNA CLA JMS CURWCR /YES, CREATE -- WON'T RETURN IF USER GOLD MENU'S OUT TAD CURWFN /GET FILE AND DRIVE NOS. MQL /SET UP FOR SCROLL CALL TAD CURWOP /GET TOP, BOTTOM, OVERWRITE OPTION CIFFIO /A026 FILEIO /A026 XDSKIN /OPEN FILE TAD CURWFN /STRIP OUT DRIVE NO. BSW RTR AND (17) CIA /NEGATE FOR TEST LATER DCA CURWDR JMS CURDQB /GET Q NAMES BLOCK RXERD TAD (CURLST) /SET TO START OF LIST OF DOCS TO BE DELETED DCA CURLPP /FROM THE PRINT QUEUE CDFMNU TAD I (PQFRST) CDFMYF /GET PTR TO FIRST ENTRY SNA JMP CURWCL /NOTHING THERE, CLOSE FILE DCA CURWPT /SAVE PTR CDFMNU TAD I (PQADDR) CDFMYF /GET ADDR OF FIRST POSSIBLE Q ENTRY CIA DCA CURWDF /SAVE FOR LATER JMS STOPPR /ENSURE THAT THE PRINTER IS STOPPED CURWLP, CDFMNU TAD I CURWPT CDFMYF /GET FIRST ENTRY SNA JMP CURWCL /EMPTY, CLOSE FILE DCA CURWNO /SAVE FILE NO. TAD CURWNO /PICK OUT DRIVE NO. BSW RTR AND (17) TAD CURWDR /AND COMPARE WITH DRIVE WE ARE STORING ON SZA CLA /SAME ? JMP CURMNX /NO, GET NEXT ENTRY TAD CURWNO /YES, FIRST PUT INTO LIST OF FILES TO DELETE DCA I CURLPP ISZ CURLPP TAD CURWNO /YES, JUST SAVE FILE NO. WITHOUT DRIVE AND P377 DCA CURWNO TAD CURWPT /FIND NAME IN BLOCK TAD CURWDF CLL RTL CLL RTL TAD (CUB1) DCA CURWNM /AND SAVE PTR TO IT FOR IOA CALL CIFMNU JMS I IOACAL CUPOTD /OUTPUT TO FILE CURWST CURWNM, 0 /FOR PTR TO FILE NAME CURWNO, 0 /FOR FILE NO. CURWNL, CURWLF /NEWLINE CURMNX, ISZ CURWPT /GET FLINK CDFMNU TAD I CURWPT CDFMYF SNA JMP CURWCL /END,CLOSE FILE DCA CURWPT /SAVE AS NEW PTR JMS STOPPR /ENSURE THAT PRINTER IS STOPPED JMP CURWLP /AND TRY AGAIN CURWLF, 12 0 /DELETE THE AUTOMATIC RESUME SO THAT THE USER CAN DECIDE WHAT /A046 /ACTION HE WISHES TO TAKE. HE MAY WISH TO LOOK AT THE QUEUE, /A046 /CREATE ANOTHER SL DOCUMENT ON ANOTHER DOCUMENT DISK, /A046 /OR KILL THE FIRST DOCUMENT IN THE QUEUE BECAUSE IT IS GOING /A046 /TO BE PRINTED LATER. /A046 CURWRT, CLA JMP I CURWPQ /AND RETURN /THIS IS THE TABLE OF DOCUMENT DESTINATIONS POSSIBLE ON THE RL BASED SYSTEMS /WHICH WE ARE MAINTAINING COMPATABILITY WITH, IF NEW PRINTERS ARE PUT /ONTO A SYSTEM THEN THIS TABLE CAN BE EASILY BE CHANGED OR CONDITIONALIZED /THIS TABLE IS USED IN MN1 WHEN DISLPAYING DOCUMENT DESTINATIONS AND IN /WPRTOV.PA WHEN DECIDING WHICH PRINTER TO USE. /HOWEVER, HERE WE ARE MAPPING DOCUMENT DESTINATIONS TO HANDLER TYPES WHEREAS /IN MN1.PA AND WPRTOV.PA WE ARE MAPPING DOCUMENT DESTINATIONS TO DOCUMENT /DESTINATIONS /POSSIBLE DESTINATION TYPES ARE: / LQP=0 /PARALLEL LETTER QUALITY PRINTER / DP=1 /PARALLEL DRAFT PRINTER / HOST=2 /SERIAL COMMUNICATIONS / SERIAL=3 /SERIAL LQP /POSSIBLE DOCUMENT DESTINATIONS ARE / DLPQ (PARALLEL LETTER QUALITY PRINTER) / DSQ1 (SERIAL LETTER QUALITY PRINTER) / DSQ2 (TWO HEADED SERIAL LETTER QUALITY PRINTER) / DDP (PARALLEL DRAFT PRINTER) / DDP2 (SERIAL DRAFT PRINTER) / DHOST (SERIAL COMMUNICATIONS PORT) DFLTV=DSQ1 /M044 DDTABL, DSQ1-DFLTV /0 (LQP1)ON RL SYSTEMS) /M044 DDP2-DFLTV /1 (DP1 ON RL SYSTEMS) /M044 DHOST-DFLTV /2 (HOST1 ON RL SYSTEMS) /M044 DDP2-DFLTV /3 (DP2 ON RL SYSTEMS) /M044 DSQ1-DFLTV /4 (LQP2 ON RL SYSTEMS) /M044 DSQ1-DFLTV /5 (LQP3 ON RL SYSTEMS) /M044 DSQ1-DFLTV /6 (LQP4 ON RL SYSTEMS) /M044 DHOST-DFLTV /7 (HOST2 ON RL SYSTEMS) /M044 DHOST-DFLTV /10 (HOST3 ON RL SYSTEMS) /M044 DHOST-DFLTV /11 (HOST4 ON RL SYSTEMS) /M044 DSQ1-DFLTV /12 (NULL DEVICE ON RL SYSTEMS) /M044 DDEFAU, /THIS IS THE DEFAULT. IF THE ORIGINAL DOCUMENT DESTINATION IS /OUT OF RANGE THAN THIS DESTINATION IS USED DDEND, DFLTV /13 (LQP5 ON RL SYSTEMS) /M044 /14, 15 AND 16 ALSO MAP TO SERIAL BUT SINCE THEY FALL OUT OF /RANGE OF THE TABLE THEY GET MAPPED TO THE DEFAULT (DDEFAU) /WHICH HAPPENS TO BE SERIAL ALSO /A013 CURWFN, 0 CURWOP, 0 CURWDR, 0 CURWDF, 0 CURWPT, 0 CURLPP, 0 /POINTER INTO 'CURLST' /-------------------- PAGE CURWCL, CIFFIO /A026 FILEIO /A026 XDSKCL /CLOSE DOCUMENT FILE CLA /CALCULATE NEGATIVE NUMBER OF DOCUMENTS TO DELETE JMS STOPPR /ENSURE THAT PRINTER IS STOPPED TAD CURLPP /=-(ADDRESS OF LAST ENTRY - ADDRESS OF FIRST CIA /ENTRY) TAD (CURLST) SNA /ANY TO DELETE? JMP CURWRT /NONE, GO RETURN DCA CURLEN /YES, INITIALIZE AND THEN DELETE DOCUMENT CDFMNU TAD I (PQFRST) CDFMYF DCA CURPT2 /ADDRESS OF NEXT ENTRY TO CONSIDER TAD (PQFRST) /ADDRESS TO UPDATE IF A DELETION IS DONE DCA CURDF2 IAC /SET FLAG SAYING POTENTIAL FIRST DELETE DCA CURWFL /DELETE ENTRIES FROM THE QUEUE. GET THE NEXT QUEUE ENTRY AND SEE IF /IT IS ON THE LIST BUILT EARLIER. IF SO AND 'CURWFL' IS SET TO INDICATE /THAT THE FIRST ENTRY ON OUR QUEUE IS BEING PRINTED AND THIS IS THE FIRST /PASS THRU THE LOOP ('CURWFL' = 1), SET TO -1 INDICATING THAT THE FIRST /ENTRY IS ELIGIBLE TO BE DELETED AT THE END BY THE PRINTER. OTHERWISE DELETE /ANY MATCHES DIRECTLY. CURLP1, CDFMNU TAD I CURPT2 CDFMYF CIA DCA T1 /SAVE FILE NUMBER TO COMPARE AGAINST ISZ CURPT2 /INC POINTER TO POINT TO FLINK WORD TAD CURLEN DCA T2 /COUNTER OF NUMBER OF PASSES TAD (CURLST) /POINTER TO NEXT DELETION LIST ENTRY DCA T3 /COMPARE THE Q ENTRY WITH THE LIST CURLP2, TAD I T3 TAD T1 SNA CLA /MATCH? JMP CUROUT /YES, EXIT ISZ T3 ISZ T2 /NO, GET NEXT LIST ENTRY AND CONTINUE JMP CURLP2 /IF ANY REMAIN, LOOP JMP CURNX0 /ELSE GET NEXT Q ENTRY CUROUT, AC7777 TAD CURWFL SZA /FIRST ENTRY AND OUR DOC PRINTING?? JMP CUROU2 /NO, GO DELETE ENTRY DIRECTLY AC7777 /SET FLAG TO EVICT PRINTER JOB LATER DCA CURWFL JMP CURNX0 /GO GET NEXT Q ENTRY CUROU2, AC7777 /GET POINTER TO FIRST WORD OF Q ENTRY TAD CURPT2 DCA T1 CDFMNU TAD I CURPT2 /COPY FLINK TO LAST Q ENTRY DCA I CURDF2 DCA I T1 /ZERO FIRST WORD OF Q ENTRY BEING DELETED CDFMYF JMP CURNXT /SKIP OVER CURRENT Q ENTRY CURNX0, TAD CURPT2 DCA CURDF2 /UPDATE POINTER TO FLINK TO BE MODIFIED /DURING A DELETION /PICK UP NEXT Q ENTRY. CURNXT, CDFMNU TAD I CURDF2 /GET FLINK CDFMYF DCA CURPT2 /UPDATE CURRENT ENTRY POINTER AC7777 /IF 'CURWFL' = 1 (INDICATING FIRST PASS THRU LOOP), TAD CURWFL SNA CLA DCA CURWFL /THEN RESET FLAG TO ZERO TAD CURPT2 /CHECK FOR END OF Q SZA CLA /DONE? JMP CURLP1 /NO, LOOP /CLEAN UP AND RETURN. UPDATE 'PQLAST', AND, IF INDICATED, EVICT THE JOB /CURRENTLY PRINTING. AC7777 /GET ADDRESS OF FIRST WORD OF LAST Q ENTRY FOR TAD CURDF2 /'PQLAST' CDFMNU DCA I (PQLAST) CDFMYF AC0001 TAD CURWFL SZA CLA /OUR JOB CURRENTLY PRINTING? JMP CURWRT /NO, JUST RETURN TAD (-7) /ONLY EVICT PRINTING JOB WHEN WAITING FOR NO /SUCH PRINTER CDFPRT TAD I (PRSTTS) CDFMYF SZA CLA /WAITING FOR NO SUCH PRINTER? JMP CURWRT /NO, EXIT AC0002 /EVICT PRINTING JOB JMS STRTPR JMS WAITPR JMP CURWRT /RETURN CURLEN, 0 /NEG NUMBER OF ENTRIES IN DELETE LIST CURWFL, 0 /FLAG, 1 WHEN THIS IS FIRST Q ENTRY BEING CONSIDERED /AND OUR JOB IS PRINTING /- -1 WHEN THE PRINTING JOB IS ALSO BEING SAVED /WITH THE PRINT LIST /- 0 OTHERWISE CURDF2, 0 /POINTER TO FLINK WORD OF LAST Q ENTRY CONSIDERED CURPT2, 0 /CURRENT ENTRY POINTER (SOEMTIMES POINTS TO FIRST WORD /OF ENTRY, SOMETIMES TO SECOND WORD) CURPRT, XX /RESUME PRINTER CDFPRT /CDF TO PRINTER TAD I (PRSTOP) /WAS IT STOPPED? CDFMYF SNA CLA JMP I CURPRT /JUST RETURN, IF NOT AC7777 /INITIALIZE RESULT /A058 DCA X5 /A058 CDFPRT /A058 TAD I (PRSTTS) /GET STOP REASON /A058 JMS VACHK /DO VALID ACTION CHECK /A058 AND (R) /SEE IF RESUME IS ALLOWED /A058 SNA CLA /SKIP IF SO /A058 JMP I CURPRT /ELSE JUST RETURN /A058 AC0006 /LOAD RESUME CODE JMS STRTPR /RESTART IT JMP I CURPRT /MO83 MOVED HERE TO MAKE ROOM ON CPOSTP PAGE /AO83 /STOPPR SIMPLIFIED DUE TO STANDARDIZATION ON NEW FLABUZ ROUTINE /A071 /ALSO CONTAINS JWAIT SO PRINTER CODE CAN SEE STOP FLAG BEFORE THE /A071 /REST OF THE COMMAND UTITLITY PROCESSES /A071 STOPPR, XX /STOP THE PRINTER AC0001 /SET STOP FLAG /A071 CDFPRT /IN THE PRINTER FIELD /A071 DCA I (PRSTOP) /FOR REASON GIVEN IN COMMENTS ABOVE /A071 CDFMYF /BACK TO OUR FIELD /A071 CIFSYS /AND DO A JWAIT /A071 JWAIT /A071 JMP I STOPPR /-------------------- PAGE CURWCR, XX /CREATES A FILE USING MENU INFO JMS ADRCRT /DO CREATE JMP CURWRT /ERROR CAN'T CREATE /ADRCRT RETURNS WITH CUPFNO IN AC DCA CURWFN AC7777 /SET OVERWRITE DCA CURWOP JMP I CURWCR /AND RETURN CURWRL, TAD CURWFN /GET FILE NO. CIFFIO /A026 FILEIO /A026 XRDFIN /AND OPEN IT JMS CURDQB /READ Q BLOCK NAMES RXERD TAD CURWFN /SET DRIVE NO. FOR QURX BSW RTR JMS CUPDRS CURWRR, JMS CURWGN /GET FILE NAME JMP CURWEX /EOF JMP CURWEX /ERR ("READ ERROR") RETURN. /A036 JMS CURWGF /GET FILE NO. JMP CURWEX /EOF JMP CURWRR /ERROR, TRY NEXT ENTRY DCA CURWFR /SAVE FILE NO. TAD CURWFR /SET FILE NO. DCA QUQBLK+RXQFNO TAD (RXEGF) /GET FIRST BOCK DCA QUQBLK+RXQFNC JMS QURX CLA TAD QUQBLK+RXQBLK /SEE IF FILE EXISTS SNA CLA JMP CURWRR /NO, TRY NEXT ONE TAD (RXERD) /YEX, READ HEADER DCA QUQBLK+RXQFNC TAD (CUB2) DCA QUQBLK+RXQBAD JMS QURX CLA TAD CUB2+FHPSET /SEE IF PRINTER SETTINGS INIT'ED SNA CLA JMP CURWRR /NO, TRY NEXT ONE TAD CURWFN /YES, GET FILE NO. AND (7400) /AND OUT FILE NO. TAD CURWFR /OR FILE NO. WITH DRIVE NO. DCA CURWFR /AND STASH IT CDFMNU /START TO Q TAD (-PQSZ) /SAVE SIZE DCA T1 TAD I (PQADDR) /AND PTR TO FIRST ENTRY DCA T2 CURWQ1, TAD I T2 /GET A FREE ENTRY SNA CLA JMP CURWQ2 /FOUND A FREE ONE ISZ T2 /SKIP FILE NO. ENTRY ISZ T2 /AND FLINK ISZ T1 /ANY ROOM LEFT JMP CURWQ1 /YES TRY NEXT ENTRY CDFMYF /NO, CLEAN UP AND LEAVE CURWEX, JMS CURDQB /WRITE OUT Q NAME BLOCK RXEWT+2000 JMP CURWRT /AND RETURN CURWQ2, TAD CURWFR /GET FILE NO. DCA I T2 /AND SAVE IN Q TAD I (PQLAST) IAC DCA T1 TAD T2 /MAKE US LAST ENTRY DCA I T1 TAD T2 DCA I (PQLAST) ISZ T2 DCA I T2 /CLEAR MY FLINK TAD I (PQADDR) /CALCULATE POSITION IN Q NAME BLOCK CDFMYF CIA TAD T2 CLL RTL CLL RTL AND (3740) TAD (CUB1) DCA CURWQ5 /AN SAVE IT FOR COPY CALL JMS CUCOPY /COPY TO Q NAME BLOCK CURWBF CDFMYF CURWQ5, 0 CDFMYF 37 /ONLY FIRST 31 CHARS. COUNT JMP CURWRR /GO GET NEXT ENTRY CURWFR, 0 /-------------------- PAGE /READS THE FIRST 31 CHARS OF THE NEXT FILE NAME /INTO CURWBF. /CALLED BY: /JMS CURWGN /EOF END OF FILE RETURN /ERR (READ) ERROR RETURN /A036 /REGULAR RETURN (AC=0) CURWGN, XX CLA CURWG1, JMS CURGET /GET NEXT CHAR ISZ CURWGN /ERR RETURN. /A036 JMP I CURWGN /EOF TAD (-74) SZA CLA JMP CURWG1 /NOT A LEFT ANGLE BRACKET, KEEP LOOKING JMS CURGET /NEXT CHAR ISZ CURWGN /ERR RETURN. /A036 JMP I CURWGN /EOF TAD (-"N+200) SNA JMP CURWG2 /MATCHED A N, KEEP GOING TAD ("N-200-"N+140) /TRY LOWER CASE N SZA CLA JMP CURWG1 /NO, BACK TO THE BEGINNING CURWG2, JMS CURGET /GET CHAR ISZ CURWGN /ERR RETURN. /A036 JMP I CURWGN TAD (-76) SZA CLA JMP CURWG1 /NOT A RIGHT ANGLE BRACKET, START OVER TAD (CURWBF-1) /MATCHED, SET UP FOR COPYING NAME DCA X0 TAD (-37) /ONLY COPY FIRST 31 CHARS DCA T1 CURWG3, JMS CURGET /GET NEXT CHAR ISZ CURWGN /ERR RETURN. /A036 JMP I CURWGN /EOF TAD (-74) /CHECK IF LEFT ANGLE BRACKET MEANING DONE SNA JMP CURWG4 /YES, RETURN TAD (74) /MAKE BACK TO INITIAL CHAR DCA I X0 /AND STORE IT ISZ T1 /NEED MORE ? JMP CURWG3 /YES CURWG4, CLA DCA I X0 /STORE END OF STRING ISZ CURWGN /BUMP OVER EOF RETURN. /A039 ISZ CURWGN /BUMP FOR GOOD RETURN JMP I CURWGN /GET THE NEXT CHAR FROM THE FILE. /CALLED BY: /JMS CURGET /ERR RETURN /A036 /EOF RETURN /REGULAR RETURN (AC CONTAINS CHAR) CURGET, XX CLA CIFFIO /A026 FILEIO /A026 XRDFNC SZA SMA /SKIP IF CHAR. /A036 ISZ CURGET /CHAR. /A036 SMA /SKIP IF ERROR. /A036 ISZ CURGET /EOF OR CHAR. /A036 SPA CLA /RETURN 0 FOR ERROR CHAR. /A036 AND P177 JMP I CURGET /GETS THE NEXT FILE NO. AND RETURNS IT IN THE AC. /CALLED BY: /JMS CURWGF /EOF RETURN /ERROR RETURN /REGULAR RETURN (AC=FILE NO.) CURWGF, XX TAD T1 /NEG COUNT OF WORDS LEFT IN NAME BUFFER /A050 SZA CLA /SKIP IF: BUFFER FULL /A050 /IF THE BUFFER IS FULL, THEN WE ARE /A050 /POINTING AT THE LEFT BRACKET /A050 JMP CURWH0 /MAY HAVE ALREADY FOUND INITIAL LEFT /ANGLE BRACKET SO SKIP OVER TEST /FIRST TIME THROUGH CURWH1, JMS CURGET /GET NEXT CHAR ISZ CURWGF /ERR /A036 JMP I CURWGF /EOF TAD (-74) SZA CLA JMP CURWH1 /NOT A LEFT ANGLE BRACKET, KEEP LOOKING CURWH0, JMS CURGET /NEXT CHAR ISZ CURWGF /ERR /A036 JMP I CURWGF /EOF TAD (-"#+200) SZA CLA JMP CURWH1 /NO, BACK TO THE BEGINNING CURWH2, JMS CURGET /GET CHAR ISZ CURWGF /ERR /A036 JMP I CURWGF TAD (-76) SZA CLA JMP CURWH1 /NOT A RIGHT ANGLE BRACKET, START OVER TAD (-4) DCA T1 TAD (CURWBN-1) DCA X0 CURWH3, JMS CURGET ISZ CURWGF /ERR /A036 JMP I CURWGF TAD (-74) /SEE IF LEFT ANGLE BRACKET SNA JMP CURWH4 /YES, ALL DONE TAD (74) /GET CHAR BACK DCA I X0 /AND STORE IT ISZ T1 /NO. MUST BE LESS 1000 JMP CURWH3 JMP CURWH5 CURWH4, DCA I X0 /STORE TRAILING 0 CIFMNU JMS I CVDCAL /CONVERT TO BINARY CURWBN SKP /ERROR RETURN ISZ CURWGF /CONVERTED BUMP RETURN TWICE CURWH5, ISZ CURWGF JMP I CURWGF /THIS ROUTINE CHECKS THE NAME BEING STORED IN THE DOCUMENT CONTAINING /THE PRINT QUEUE. IT MAKES SURE THAT THE LAST CHARACTER IN THE NAME /IS A SPACE (FOR DISPLAY PURPOSES). IF A NAME IS LESS THAN 30 CHAR /IN LENGTH, THEIR WILL BE A TRAILING SPACE, HOWEVER IF THE NAME IS /LONGER THAN 31 CHAR, THE NAME IS TRUNCATED AND A SPACE MUST BE /ADDED. X1 IS LEFT OVER FROM CUCOPY AND WILL BE POINTING TO THE /LAST LEGAL CHAR IN THE NAME BUFFER (WORD 37). CUQWO6, XX /RETURN ADDRESS TAD X1 /POINTER TO THE 31ST CHAR IN THE DOC NAME DCA T1 /SAVE THE POINTER TAD I T1 /GET THE CHAR TAD (-40) /COMPARE TO A SPACE SPA SNA CLA /SKIP IF: CHAR IS .GT. A SPACE JMP CUQWO7 /CHAR IS A NULL OR A SPACE TAD (40) /CHAR IS TO BE REPLACED BY A SPACE DCA I T1 CUQWO7, JMP I CUQWO6 /RETURN TO CALLER /-------------------- PAGE /***********************************************************************/ / CUQMCK--CHECK VERTICAL MARGINS / PS-TM-BM MUST BE 1 OR GREATER, OR ELSE THE PRINT SPOOLER WILL DO / NOTHING EXCEPT PRINT HEADERS AND FOOTERS AND PAGE NUMBERS, / WHICH IS VERY ALARMING /***********************************************************************/ PRQTMG=4 /TOP MARGIN OFFSET PRQBMG=5 /BOTTOM MARGIN OFFSET PAGSIZ=6 /PAGE SIZE OFFSET CUQMCK, XX CLA CDFMNU TAD I (MUBUF+MNPROP+PRQTMG) TAD I (MUBUF+MNPROP+PRQBMG) CIA TAD I (MUBUF+MNPROP+PAGSIZ) /AC=PS-TM-BM CDFMYF SMA SZA CLA /WAS PS GREATER? JMP I CUQMCK /YES, RETURN CDFMNU /MAP MENU AREA BACK. /A070 AC0001 /SET MNTMP1 TO 1 FOR ERROR MESSAGE. /A070 DCA I (MUBUF+MNTMP1) /A070 CDFMYF /BACK TO OUR FIELD. /A070 CIFMNU JMS I MNUCAL DLMPR1 /PRINT ERROR MENU CLA JMP CUQCMU /ALWAYS RETURN ONLY TO PRINT MENU / WPCU2 - COMMAND UTILITIES II FLAGGED ESCAPE SEQUENCES / 043 Mart 08-jul-85 warm restart on return from GRAPHICS / to restore PANEL etc / 042 EMcD 06-Mar-85 Save term as 8bit Lvl 2 / 041 TCW 06-SEP-84 Disable Modem if not present / 040 DFB 31-AUG-84 FIX TO AUTO CALL VERIFY AT WARM STARTUP / 039 TCW 27-AUG-84 Change to Integral Modem init. routine / 038 WCE 23-AUG-84 ADD CHECKS FOR DMI SYSTEM - NO PRQ'S / REORGANIZED WPCU2 LAYOUT / 037 WCE 20-AUG-84 CHANGES FOR NEW RD MENU VALUES / 036 DFB 18-AUG-84 FIX FIX TO AUTO CALL VERIFY / 035 DFB 08-AUG-84 FIX TO AUTO CALL VERIFY AT WARM STARTUP / 034 DFB 07-AUG-84 FIX TO DATE FOR MASTER MENU VER 1.0 / 033 JAC 05-JUL-84 FIX UP F11 FOR TECH CHARS / 032 DFB 02-JUL-84 DATE FORMAT SUPPORT FROM MASTER MENU / 031 TCW 29-JUN-84 CLOCK ADJUSTMENT FOR #030 / 030 TCW 26-JUN-84 INTEGRAL MODEM SUPPORT / 029 JAC 19-JUN-84 100 UDK DEVELOPMENT / 028 WCE 06-JUN-84 CHANGES FOR BRITISH DATE & CURRENCY / 027 TCW 02-MAR-84 INIT. COMM LINE ON WARM BOOT / / WRITES OUT WPCU2 / / ** NOTE -- WPEDIT USES THIS OVERLAY, AND KNOW ABOUT ITS LENGTH AND ENTRIES ** / *200 / START ADDRESS USED BY OS8 "GO" COMMAND JMP I .+3 / LOCATION USED TO START UP RXHAN JMP I .+1 / LOCATION USED TO RETURN TO OS8 MONITOR 7600 / ADDRESS OF OS8 MONITOR RETURN POINT RXLOAD / ADDRESS OF START LOCATION FOR RXHAN *RXLDLS / ADDRESS WITHIN RXHAN TO OVERLAY RXEWT / WRITE FUNCTION CODE 0 RXQBLK / ADDRESS OF QUEUE BLOCK TO USE . / ADDRESS OF TABLE OF DISK COMMANDS DLOCU2 / DISK BLOCK TO WRITE 0 / STARTING AT MEMORY ADDRESS CDF 20 / IN THIS FIELD -DSOCU2 / FOR THIS MANY DISK BLOCKS 0 / END OF LIST INDICATOR CU2FLD= 4 / CU2 FIELD (THIS FIELD) /A032 PMFLD= 6 / PANEL MEMORY FIELD=6 /A032 WRPMEM= 4000 / WRITE PANEL MEM FRM MAIN (40XY)Y=INPUT FLD /A032 RDPMEM= 5000 / READ PANEL MEM. TO MAIN (50XY)Y=INPUT FLD /A032 CDFMYF= CDFBUF / DEFINE INSTRUCTION TO RETURN TO THIS FIELD CLKSK2= 6131 / DECMATE II CLOCK IOT PRQ3= 6236 / COMMAND CODE /A032 H2DTR= 6362 / DEFINE MODEM CONTROL REG. IOT /A030 PMDATE= 7600 / PANEL MEMORY DATE LOCATION /A032 PMSIGN= PMDATE+143+6 / LOC OF SIGNATURE IN P.M. (ALLOW FOR TIME) /A032 DTLEN= -10 / -LENGTH OF DATE FIELD"MM/DD/YY" /A032 /D038 SIGNAT= -7531 / -SIGNATURE FOR MASTER MENU /A032 /D038 SLASH= 257 / ASCII SLASH /A032 /D038 PR3= 6236 / PANEL MEMORY REQUEST SEQUENCE #3 FIELD 2 / FIELD TO ASSEMBLE THIS CODE INTO *76 / LOCATION OF TEMP REGISTER NUMBER TWO (T2) CUDTMP, 0 / LOCATION FOR INTERNAL DATA VERSION /A037 0 / LOCATION FOR INTERNAL ROM VERSION /A037 *100 / FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM CUDEXM, -EXPMN / SOFTWARE EXPIRATION MONTH /A038 CUDEXY, -EXPYR / SOFTWARE EXPIRATION YEAR /A038 CUDSYR, 0 CUDSMO, 0 CUDSDY, 0 CUDSMN, 0 CUDSHR, 0 F1DATE, ZBLOCK 2 / DATE FIELD 1 /A032 "/ / ASCII CODE FOR A "/" /A032 F2DATE, ZBLOCK 2 / DATE FIELD 2 /A032 "/ / ASCII CODE FOR A "/" /A032 F3DATE, ZBLOCK 2 / DATE FIELD 3 /A032 CUDFM4, MNFM4X / INTEGRAL MODEM BIT /A038 CUDC7, 7 / CONSTANT VALUE OF 7 /A038 CUDTP1, MUBUF+MNTMP1 / LOCATION OF MNTMP1 IN MENU FIELD /A038 CUDFMT, MUBUF+MNFMAT / LOCATION OF MNFMAT IN MENU FIELD /A038 CUDONL, CMONLN / LOCATION OF COM ON LINE FLAG WORD /A038 CUDDMT, DAMNTH / LOCATION OF DAY OF MONTH IN SYS FIELD /A038 CUDMTH, MONTH / LOCATION OF MONTH VALUE IN SYS FIELD /A038 CUDEAR, YEAR / LOCATION OF YEAR VALUE IN SYS FIELD /A038 CUDERD, RXERD / DISK HANDLER READ FUNCTION CODE /A038 CUDEWT, RXEWT+2000 / DISK HANDLER WRITE FUNCTION CODE /A038 CUDFOW, CUDBUF+MNOPTC-MNABRV / LOCATION OF MNOPTC FEATURE OPTION WORD/A038 VFYNUM, 14 / OVLAY NUMBER FOR VERIFY /A035 VFYADR, 200 / START ADDRESS OF VERIFY /A035 VFYFLD, CIF 10 / VERIFY FIELD -2 /A035 / ******************************* ORDER IMPORTANT *********************** PRQBLK, XSETUP, MUBUF+MNSECN XPBAUD, MUBUF+MNPRTB XCBAUD, MUBUF+MNPRIM / ******************************* END ORDER IMPORTANT ******************* QURX, XX CIFSYS / CHANGE TO SYSTEM FIELD ENQUE / CAUSE QUEUE BLOCK TO BE ENQUEUED QUBLK / ADDRESS OF QUEUE BLOCK CIFSYS / CHANGE TO SYSTEM FIELD JWAIT / WAIT FOR A SIGNIFICENT EVENT TAD QUQBLK+RXQCOD / PICK UP THE COMPLETION CODE SNA CLA / TEST AND CLEAR COMPLETION CODE /M028 JMP .-4 / IF ZERO, GO WAIT SOME MORE JMP I QURX / DONE, RETURN TO CALLER QUBLK, DSKQUE / ++++ 0 / ++++ 0 QUQBLK, ZBLOCK 17 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE /*************************************************************************** /**** OVERLAY ENTRY POINT NUMBER ONE **** /*************************************************************************** CUDRST, XX / LABEL ADDED FOR WARM RESTART /A035 JMS CUDSET / CUDSET - SETS DATE/TIME CDIMNU / CIF CDF MENU FIELD JMP I .-3 /*************************************************************************** /**** OVERLAY ENTRY POINT NUMBER TWO **** /*************************************************************************** XX / CUAK - ACTIVATE UDKS (YES/NO) /D038 JMS CUAK / WS-78 FUNCTION NO LONGER EXISTS /D038 .-. /D038 JMP I .-3 HLT / NOBODY SHOULD BE CALLING THIS ENTRY /A038 JMP .-1 / DO NOT ALLOW USER TO CONTINUE /A038 JMP .-2 / USED TO PRESERVE SPACE TILL NEXT CALL /A038 /*************************************************************************** /**** OVERLAY ENTRY POINT NUMBER THREE **** /*************************************************************************** CUFINI, XX / CUFINS - FINISH COMMAND JMP CUFINS /C038 CUFINX, CDIMNU / RETUNR TO CALLER /C038 JMP I .-3 /*************************************************************************** /**** OVERLAY ENTRY POINT NUMBER FOUR **** /*************************************************************************** XX / CUWOUD - WRITE OUT SYS VALUES BLOCK /D029 JMS CUWOUD /D038 CLA / DON'T DO *ANYTHING* (WAS JMS CUWOUD) /C029 /D038 CDIMNU / CUWOUD NO LONGER EXISTS /C029 /D038 JMP I .-3 / CALL TO THIS VECTOR IS UNKNOWN /C029 HLT / NOBODY SHOULD BE CALLING THIS ENTRY /A038 JMP .-1 / DO NOT ALLOW USER TO CONTINUE /A038 / CUFINS - FINISH COMMAND CUFINS, CIFMNU / ++++ /C038 JMS I MNUCAL / CALL MENU FOR RETURN PRESSING DLMFN1 ISZ CUFINI / SET FOR CHAIN CALL JMP CUFINX / DO IT /C038 / CUDPUT - SUBROUTINE TO UPDATE THE SYSTEM OPTIONS AREA ON DISK AFTER /A028 / THE DATE AND TIME MENU. THIS ROUTINE IS ACTUALLY ONLY USED ONCE TO /A028 / SAVE THE VALUE OF MNFMAT SO THAT THE STARTUP MENU IS ONLY USED ONCE. /A028 CUDPUT, XX / SAVE THE VALUE OF MNFMAT IF NEEDED /A028 TAD (-CUDTST) / PICK UP TEST ADDRESS /A028 TAD QURX / COMBINE WITH LAST QURX CALL /A028 SZA CLA / CHECK TO SEE IF WE JUST READ IN VALUES/A028 JMP I CUDPUT / NO, THEN RETURN TO CALLER /A028 TAD CUDBUF+MNFMAT-MNABRV / PICK UP THE VALUE FROM DISK /A028 AND (3) / MASK OFF THE DATE FORMAT BITS /A028 SZA CLA / CHECK IF THEY HAVE BEEN INITIALIZED /A028 JMP I CUDPUT / YES, THEN RETURN TO CALLER /A028 JMS CUCOPY / TRANSFER SYSTEM WORDS TO BUFFER /A028 MUSYSV / START OF SYSTEM VALUES /A028 CDFMNU / FIELD WHERE THEY RESIDE /A028 CUDBUF / OUR BUFFER TO USE /A028 CDFMYF / OUR FIELD /A028 MUSYSL / LENGTH OF SYSTEM VALUES AREA /A028 TAD CUDEWT / PICK WRITE FUNCTION CODE /C038 DCA QUQBLK+RXQFNC / STORE FUNCTION CODE IN QUEUE BLOCK /A028 JMS QURX / TRANSFER VALUES TO DISK /A028 JMP I CUDPUT / RETURN TO CALLER /A028 / ROUTINE TO CHECK FOR A DECMATE I DEVELOPMENT SYSTEM /A038 DM1TST, XX / CHECK FOR DECMATE I DEVELOPMENT SYSTEM /A038 CDFSYS / CHANGE TO SYSTEM FIELD /A038 TAD I (XCLKSKP) / PICK UP THE CLOCK IOT /A038 CDFMYF / RESET BACK TO THIS FIELD /A038 TAD (-CLKSK2) / COMBINE WITH DECMATE II CLOCK IOT /A038 SZA CLA / IS THIS A DECMATE II SYSTEM ? /A038 ISZ DM1TST / NO, BUMP RETURN ADDRESS /A038 JMP I DM1TST / YES, RETURN TO CALLER /A038 IFDEF CONDOR < RSTCON, TEXT '![C' / ISSUE AN ESCAPE "c" RESET COMMAND /C038 /D038 RSTESC, ESC; "c; 0 > / END IFDEF CONDOR / INTEGRAL MODEM SUPPORT /A030 / ISSUE ENABLE - CK FOR HARDWARE PRESENT AND AUTO BAUD IF TRUE /A030 IMINIT, XX / /A030 TAD (4003) / ENABLE BITS /A030 H2DTR / IOT - TURN MODEM ON /A030 JMS IMWAIT / WAIT FOR MODEM TO INIT ITSELF /A030 LAS / SEE IF ITS PRESENT /A030 AND (4000) / MODEM PRESENT BIT /A030 SZA CLA / BIT <0> = 0 IF PRESENT /A030 JMP IMINTE / NOT PRESENT - GO DISABLE /A041 IMINTL, CIFSYS / CLEAR INPUT BUFFER /A039 HS2IN / /A039 SZA CLA / SKIP WHEN EMPTY /A039 JMP IMINTL / LOOP UNTIL EMPTY /A039 AC0002 / SEND A ^B TO AUTO-BAUD /A039 CIFSYS / /A030 HS2OU / /A030 CLA / BUFFER SHOULD HAVE ROOM /A030 JMP I IMINIT / /A030 IMINTE, AC0003 / DISABLE MODEM /A041 H2DTR / /A041 CLA / AC MUST BE CLEARED /A041 JMP I IMINIT / /A041 IMWAIT, XX / WAIT HERE 1 SEC. /A030 CLA / /A030 DCA T1 / CLEAR STORAGE /A030 CDFSYS / FETCH CLOCK VALUE /A030 TAD I (CLOCK+2) / /A031 CDFMYF / /A030 CIA / /A030 DCA T1 / SAVE /A030 IMWTLP, CDFSYS / FETCH NEW VALUE /A030 TAD I (CLOCK+2) / /A031 CDFMYF / /A030 TAD T1 / COMPARE WITH OLD VALUE /A030 SZA CLA / ANY CHANGE ? /A030 JMP I IMWAIT / YES - RETURN /A030 IMWJW, CIFSYS / NO - JWAIT HERE /A030 JWAIT / /A030 JMP IMWTLP / /A030 /D038 CUAK, XX / ACTIVATE/DEACTIVATE UDKS /D038 RDF / ++++ /D038 TAD CIDF0 / GET RETURN FIELD /D038 CDFMYF / ++++ /D038 DCA I CUAK / STORE IN CALL SEQUENCE /D038 JMP I CUAK /D038 /THIS CODE WAS PUT IN FOR FIELD TEST PURPOSES SO THAT SOFTWARE PUT OUT FOR /D038 /FIELD TEST IS NOT AROUND FOREVER. /D038 CHKDAT, CDFSYS / CHANGE TO SYSTEM FIELD /D038 TAD I (YEAR) / GET YEAR INPUT /D038 TAD (-EXPYR) / GET EXPIRATION YEAR /D038 SMA SZA / YEAR BEYOND LIMIT? /D038 JMP CHKDT2 / YES, CLOBBER DISKETTE /D038 SZA CLA / TIME OUT YEAR? /D038 JMP CHKDT1 / NO, MUST BE EARLIER, OK, EXIT /D038 TAD I (MONTH) / NO, EXPIRATION YEAR, CHECK MONTH /D038 TAD (-EXPMN) / GET EXPIRATION MONTH /D038 SPA CLA / OK? /D038 CHKDT1, JMP CUDXIT / YES, EXIT /D038 CHKDT2, CDFMYF / NO, TIME TO CLOBBER DISKETTE /D038 DCA QUQBLK+RXQBAD / SET BUFFER ADDRESS TO 0 (OR CLOSE TO IT) /D038 DCA QUQBLK+RXQDRV / SET DRIVE TO 0 /D038 TAD CDF0 /D038 DCA QUQBLK+RXQBFD / SET FIELD OF BUFFER TO 0 /D038 TAD (RXEWT+2000) /D038 DCA QUQBLK+RXQFNC / SET FUNCTION TO WRITE /D038 DCA QUQBLK+RXQBLK / SET BLOCK NUMBER TO 0 /D038 JMS QURX / CLOBBER BOOT BLOCK /D038 JMP CUDXIT / EXIT, NEXT TIME SYSTEM WILL NOT BOOT X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE /D038 CUDSET, XX /D037 CDFMNU /D038 JMS CUDVAL / SET UP MENU VALUES, BACK WITH DF=MENU /A037 /D038 TAD I (MUBUF+MNTMP1) / FROM START MENU? OR MAIN MENU? /D038 CDFMYF /D038 SPA CLA /D037 JMP CUDCHG / RD, JUST CHANGE TIME/DATE /D038 JMP CUDLUP / MAIN MENU, CALL TIME/DATE MENU /A037 /D038 DCA QUQBLK+RXQDRV / SET SYSTEMS DRIVE TO READ UDK'S /D038 TAD (RXERD) /D038 DCA QUQBLK+RXQFNC /D029 TAD (DLUDKS) /D029 DCA QUQBLK+RXQBLK /D029 TAD (UDKSTR) /D029 DCA QUQBLK+RXQBAD /D029 TAD (CDFMNU) /D029 DCA QUQBLK+RXQBFD /D029 JMS QURX / READ THEM IN /D029 CDFMNU /D029 DCA I (UDKPTR) / MAKE SURE UDK STACK PTR IS EMPTY /D038 CDFSYS /A029 /D038 DCA I (U1STPT) /A029 /D038 CDFMYF /D038 CIFSYS / ++++ /D038 UDKOPS / TURN ON UDK'S /D038 TAD (DLSVAL) /D038 DCA QUQBLK+RXQBLK /D038 TAD CUDBAD / PICK UP POINTER TO BUFFER AREA /M037 /D038 DCA QUQBLK+RXQBAD /D038 TAD CUDMYF / PICK UP CDF INSTRUCTION TO THIS FIELD /M028 /D038 DCA QUQBLK+RXQBFD /D038 JMS QURX / READ IN SYSTEM VALUES /D038 CUDMOV, JMS CUCOPY / TRANSFER THEM /D038 CUDBAD, CUDBUF / BUFFER ADDRESS /M037 /D038 CUDMYF, CDFMYF /M028 /D038 MUSYSV / ++++ /D038 CDFMNU /D038 MUSYSL /D038 JMS CUDOPT / SET UP UNBUNDLING OPTIONS WORD /D038 / SET JSWAP IN DSKHND LOCATION RDOSWP AFTER PROPER INITIALIZATION /D038 CDFSYS /D038 TAD (JSWAP) /D038 DCA RDOSWP /D038 IFDEF WINNIE < /D038 / SET JSWAP IN DSKHND LOCATION RDOSWQ AFTER PROPER INITIALIZATION /D038 TAD (JSWAP) /D038 DCA RDOSWQ /D038 > / END IFDEF WINNIE /D038 CDFMYF / /A027 /D038 IFDEF CONDOR < /D038 JMS DTFRMT /FORMAT DATE /A032 /D038 AC0001 /SET SLUSHWARE FOR DECmate MODE /A033 /D038 PR3 /ISSUE PANEL REQUEST TO SLUSHWARE /A033 /D038 10 /FUNCTION CODE ARGUMENT /A033 /D038 7777 /END OF LIST INDICATOR /A033 /D038 CLA /SAFETY CLEAR THE SLATE /A033 /D038 > /END IFDEF CONDOR /A032 /D038 / ****** DO THE COMM LINE INIT ON A WARM BOOT /A027 /D038 IFDEF CONDOR < /D038 CIFSYS /D038 H2INIT / NO, INIT COMM LINE AND /D038 JMS INITTC / INITIALIZE TERMINAL CHARACTERISTICS /D038 CIFMNU /D038 JMS I IOACAL / /D038 0 / /D038 RSTCON / ^A /D038 RSTESC / "ESC c" /D038 / ****** CHECK FOR INTEGRAL MODEM ENABLED /A030 /D038 /D038 CDFMNU / SEE IF ITS ENABLED IN SYS AREA /A030 /D038 TAD I (MUBUF+MNFMAT) / /A030 /D038 CDFMYF / /A030 /D038 AND (20) / INTEGRAL MODEM BIT /A030 /D038 SZA CLA / SKIP IF DISABLED /A030 /D038 JMS IMINIT / ENABLE AND AUTO-BAUD IF PRESENT /A030 /D038 > / END IFDEF CONDOR /D038 CDFSYS / SYSTEM DATA FIELD /A027 /D038 TAD I (DAMNTH) / SEE IF ANYONE SET THE DATE YET /D038 CDFMYF /D038 SZA CLA / ON ACP ERROR IS SET TO - FOR WARM START /C036 /D038 JMP CUDWRM / WARM STARTUP..CALL VERIFY /C035 /D038 CUDLUP, CIFMNU / CALL DATE/TIME MENU /D038 JMS I MNUCAL /D038 DLMSM0 /M037 /D038 JMS CUDPUT / ONCE ONLY CALL TO SAVE MNFMAT /A028 /D038 TAD (MNDTYR-1+MUBUF) / SET UP X0 TO GET YEAR, ETC. /D038 DCA X0 /D038 CDFMNU /D038 TAD I X0 / GET VALUES AND SAVE HERE /D038 DCA CUDSYR /D038 TAD I X0 /D038 DCA CUDSMO /D038 TAD I X0 /D038 DCA CUDSDY /D038 TAD I X0 /D038 DCA CUDSHR /D038 TAD I X0 /D038 DCA CUDSMN /D038 CDFMYF /D038 TAD CUDSDY /D038 SPA CLA / DON'T CHANGE IF NEGATIVE /D038 IFDEF FLDTST / IF FIELD TEST, DON'T ALLOW NO INPUT /D038 IFNDEF FLDTST / IF NOT FIELD TEST, ALLOW NO INPUT /D038 TAD CUDSDY /D038 CDFSYS /D038 DCA I (DAMNTH) /D038 TAD CUDSMO /D038 DCA I (MONTH) /D038 TAD CUDSYR /D038 DCA I (YEAR) /D038 CDFMYF /D038 JMS FIXDAT /D038 CUDSND, TAD CUDSHR / DO WE CHANGE TIME? /D038 SPA CLA /D038 JMP CUDCHK / NO - JUST RETURN /D038 CDFSYS /D038 TAD (CLOCK) / ++++ /D038 DCA X0 /D038 DCA I X0 / TENTHS /D038 DCA I X0 / SECONDS /D038 TAD CUDSMN / ++++ /D038 DCA I X0 / MINUTES /D038 TAD CUDSHR / ++++ /D038 DCA I X0 / HOURS /D038 CUDCHK, /D038 IFDEF FLDTST / CHECK DATE ENTERED IF FIELD TEST /D038 IFNDEF FLDTST / RETURN IF NOT FIELD TEST /D038 CUDXIT, JMP I CUDSET / YES, BACK TO MAIN MENU / CUDSET - SETS DATE/TIME CUDSET, XX JMS DM1TST / CHECK FOR DECMATE I DEVELOPMENT SYSTEM/A038 JMS CUDVAL / NO, SET UP DECMATE II MENU VALUES /A037 CDFMNU / SET DATA FIELD TO MENU FIELD TAD I CUDTP1 / FROM START MENU? OR MAIN MENU? /C038 CDFMYF / MAIN MENU SETS VALUE TO -1 SPA CLA / START MENU SETS VALUE TO +1 JMP CUDLUP / MAIN MENU, CALL TIME/DATE MENU /C037 JMS CUDOPT / READ SYSTEM VALUES & SET OPTIONS WORD /C038 / SET JSWAP IN DSKHND LOCATION RDOSWP AFTER PROPER INITIALIZATION CDFSYS TAD (JSWAP) DCA RDOSWP IFDEF WINNIE < / SET JSWAP IN DSKHND LOCATION RDOSWQ AFTER PROPER INITIALIZATION TAD (JSWAP) DCA RDOSWQ > / END IFDEF WINNIE CDFMYF / /A027 IFDEF CONDOR < JMS DM1TST / CHECK FOR DECMATE I DEVELOPMENT SYSTEM/A038 JMS DM2INT / NO, GO INITIALIZE DECMATE II VALUES /A037 / ****** DO THE COMM LINE INIT ON A WARM BOOT /A027 CIFSYS H2INIT / INIT COMM LINE / ****** CHECK FOR INTEGRAL MODEM ENABLED /A030 CDFMNU / SEE IF ITS ENABLED IN SYS AREA /A030 TAD I CUDFMT / PICK UP VALUE OF MNFMAT /C038 CDFMYF / /A030 AND CUDFM4 / INTEGRAL MODEM BIT /C038 SZA CLA / SKIP IF DISABLED /A030 JMS IMINIT / ENABLE AND AUTO-BAUD IF PRESENT /A030 > / END IFDEF CONDOR / CHECK FOR POSSIBLE ERROR ENTRY FROM A DISK HANDLER FAILURE /A027 CDFSYS / SYSTEM DATA FIELD /A027 TAD I CUDDMT / SEE IF ANYONE SET THE DATE YET /C038 CDFMYF SNA / ON ACP ERROR IS SET TO - FOR WARM START /C036 JMP CUDLUP / COLD STARTUP..CALL START UP MENU /C035 SMA CLA / CHECK FOR "F" COMMAND /A036 JMP I CUDSET / YES, RETURN WITH CLEAN ACCUMULATOR /A036 / NO, WARM START ERROR /A036 / WARM START ROUTINE TO SET UP OVERLAY TO CALL VERIFY /A035 CDFSYS /A036 TAD I CUDDMT / GET DAY OF WEEK VALUE /C038 CMA / WARM START SET ON ERROR IN DSKACP /A036 DCA I CUDDMT / RESET FOR DISLPAY /C038 TAD I (SVFVFY-CLOCK+RANDOM /LOCATION PARAMETER PASSED FROM /A040 SNA / test for graphics restart /a043 JMP CUDGRE / go exit /a043 CDFMNU /A035 DCA I (MUBUF+MNTMP2) /SET IT FOR VERIFY /A040 TAD (MUBUF+MNONUM-1) / START OF OVLY TABLE -1 /A035 DCA X0 /A035 TAD VFYNUM / VERIFY OVERLAY NUMBER /A035 DCA I X0 /A035 TAD VFYADR / START ADDRESS OF VERIFY /A035 DCA I X0 /A035 TAD VFYFLD / VERIFY FIELD /A035 DCA I X0 /A035 CDFMYF / RESET FIELD /A035 ISZ CUDRST / SET RETURN TO CALL OVLAY /A035 CUDGRE, CLA / make sure the acc is clear /a043 CDFMYF / RESET FIELD /A043 JMP I CUDSET / RETURN TO TRANSFER TO VERIFY /A035 / CALL THE RESET DATE AND TIME MENU CUDLUP, CIFMNU / CALL DATE/TIME MENU JMS I MNUCAL DLMSM0 /M037 JMS CUDPUT / ONCE ONLY CALL TO SAVE MNFMAT /A028 TAD (MNDTYR-1+MUBUF) / SET UP X0 TO GET YEAR, ETC. DCA X0 CDFMNU TAD I X0 / GET VALUES AND SAVE HERE DCA CUDSYR TAD I X0 DCA CUDSMO TAD I X0 DCA CUDSDY TAD I X0 DCA CUDSHR TAD I X0 DCA CUDSMN CDFMYF TAD CUDSDY SPA CLA / DON'T CHANGE IF NEGATIVE JMP CUDLUP / DON'T ALLOW NO INPUT /C038 JMS FIXDAT CUDSND, TAD CUDSHR / DO WE CHANGE TIME? SPA CLA JMP CHKDAT / NO - GO CHECK THE DATE /C038 CDFSYS TAD (CLOCK) / ++++ DCA X0 DCA I X0 / TENTHS DCA I X0 / SECONDS TAD CUDSMN / ++++ DCA I X0 / MINUTES TAD CUDSHR / ++++ DCA I X0 / HOURS / THIS CODE WAS PUT IN FOR FIELD TEST PURPOSES SO THAT SOFTWARE / PUT OUT FOR FIELD TEST IS NOT AROUND FOREVER. CHKDAT, CDFSYS / CHANGE TO SYSTEM FIELD TAD I CUDEAR / GET YEAR INPUT /C038 TAD CUDEXY / GET EXPIRATION YEAR /C038 SMA SZA / YEAR BEYOND LIMIT? JMP CHKDT1 / YES, CLOBBER DISKETTE SZA CLA / TIME OUT YEAR? JMP CUDXIT / NO, MUST BE EARLIER, OK, EXIT TAD I CUDMTH / NO, EXPIRATION YEAR, CHECK MONTH /C038 TAD CUDEXM / GET EXPIRATION MONTH /C038 CHKDT1, CDFMYF / RESET BACK TO THIS FIELD IFDEF FLDTST / POSITIVE VALUE MEANS CLOBBER BOOT BLOCK IFNDEF FLDTST / RETURN IF NOT FIELD TEST CUDXIT, JMP I CUDSET / DATE OK, BACK TO MAIN MENU / DATE BAD, TIME TO CLOBBER DISKETTE DCA QUQBLK+RXQBAD / SET BUFFER ADDRESS TO 0 DCA QUQBLK+RXQDRV / SET DRIVE TO 0 TAD CDF0 DCA QUQBLK+RXQBFD / SET FIELD OF BUFFER TO 0 TAD CUDEWT / GET DISK HANDLER WRITE FUNCTION CODE /C038 DCA QUQBLK+RXQFNC / SET FUNCTION TO WRITE DCA QUQBLK+RXQBLK / SET BLOCK NUMBER TO 0 JMS QURX / CLOBBER BOOT BLOCK JMP I CUDSET / EXIT, NEXT TIME SYSTEM WILL NOT BOOT X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE / ROUTINE TO READ THE SYSTEM VALUES FOR MENU FIELD CUDOPT, XX / READ THE SYSTEM VALUES DCA QUQBLK+RXQDRV / SET TO SYSTEMS DRIVE TAD CUDERD / PICK UP READ FUNCTION CODE /C038 DCA QUQBLK+RXQFNC / STORE IN QUEUE BLOCK TAD (DLSVAL) / PICK UP DISK BLOCK FOR SYSTEM VALUES DCA QUQBLK+RXQBLK / STORE IN QUEUE BLOCK TAD CUDBAD / PICK UP POINTER TO BUFFER AREA /M037 DCA QUQBLK+RXQBAD / STORE IN QUEUE BLOCK TAD CUDMYF / PICK UP CDF INSTRUCTION TO THIS FIELD /M028 DCA QUQBLK+RXQBFD / STORE IN QUEUE BLOCK JMS QURX / READ IN SYSTEM VALUES / SET THE UNBUNDLING OPTIONS WORD INTO MNOPTC / GET HARDWARE OPTIONS BIT CUDTST, CDFSYS / CHANGE TO SYSTEM FIELD DCA I (U1STPT) / CLEAR UDK STACK POINTER /A029 TAD I CUDONL / GET COM ON LINE FLAG WORD /C038 CDFMYF / RETURN TO CURRENT DATA FIELD SZA CLA / CHECK FOR PRESENCE OF HARDWARE BIT AC0001 / SET BIT IF COMM INTERFACE PRESENT DCA T1 / USE LOCATION AS TEMPORARY STORAGE AC7776 / SET UP HARDWARE BIT MASK AND I CUDFOW / CLEAR BITS BAISED ON OPTIONS WORD /C038 TAD T1 / COMBINE WITH HARDWARE BIT DCA I CUDFOW / STORE NEW FEATURE OPTIONS WORD /C038 JMS CUCOPY / TRANSFER THEM TO MENU FIELD CUDBAD, CUDBUF / BUFFER ADDRESS TO START FROM /M037 CUDMYF, CDFMYF / FIELD OF SOURCE /M028 MUSYSV / LOCATION TO MOVE TO CDFMNU / FIELD OF DESTINATION MUSYSL / NUMBER OF WORDS TO MOVE / TURN ON UDK'S CIFSYS / SET UP TO GO TO SYSTEM FIELD UDKOPS / GO TURN ON UDK'S JMP I CUDOPT / RETURN TO CALLER FIXDAT, XX CDFSYS TAD CUDSDY DCA I CUDDMT / STORE DAY OF MONTY VALUE /C038 TAD CUDSMO DCA I CUDMTH / STORE MONTH VALUE /C038 TAD CUDSYR DCA I CUDEAR / STORE YEAR VALUE /C038 TAD I CUDMTH / GET MONTH VALUE /C038 CIA / ++++ DCA T1 AC0003 / ++++ AND I CUDEAR / MASK OFF YEAR VALUE /C038 SNA CLA / ++++ IAC CDFMYF TAD (34) / ++++ DCA CUDSMT+1 / SET FEB DAYS TAD (CUDSMT-1) / ++++ DCA X0 SKP TAD I X0 / GET DAYS SO FAR THIS YEAR ISZ T1 / ++++ JMP .-2 CDFSYS TAD I CUDDMT / GET DAY OF MONTH VALUE /C038 DCA I (DAYEAR) AC7777 / ++++ TAD I CUDEAR / GET DAY OF WEEK /C038 CLL RAR CLL RAR TAD I CUDEAR /C038 TAD I (DAYEAR) TAD (-7) SMA / ++++ JMP .-2 TAD (10) / ++++ DCA I (DAWEEK) / 1-7 = SUN-SAT TAD I CUDDMT / GET DAY OF MONTH VALUE /C038 BSW / ++++ TAD I CUDMTH / GET MONTH VALUE /C038 DCA I (PAKDAT) CDFMYF JMP I FIXDAT / 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 T1 / AND SAVE FOR USE CUCPY0, .-. / A CDF FOR FIRST FIELD TAD I X0 / GET WORD CUCPY1, .-. / A CDF FOR THE RECEIVING FIELD DCA I X1 / STORE WORD ISZ T1 / DONE? JMP CUCPY0 / NO - DO NEXT WORD /C038 CDFMYF / YES - BACK TO OUR FIELD JMP I CUCOPY / RETURN TO CALLER / TABLE OF DAYS IN THE MONTHS, USED BY 'RD' PROCESSING DECIMAL CUDSMT, 31 / JANUARY 28 / FEBRUARY 31 / MARCH 30 / APRIL 31 / MAY 30 / JUNE 31 / JULY 31 / AUGUST 30 / SEPTEMBER 31 / OCTOBER 30 / NOVEMBER 31 / DECEMBER OCTAL /D038 IFDEF CONDOR < /D038 / NOTE:: THIS CODE IS EXECUTED ONCE AFTER POWER-UP /D038 / /D038 / This code issues a PRQ3 request to panel memory to set the WPS user /D038 / defined terminal characteristics into panel memory program locations /D038 / 24, 25, and 26 thereby powering up to the WPS characteristics /D038 INITTC, XX / /D038 JMS DM1TST / IS THIS A DECMATE I SYSTEM ? /A038 /D038 JMP I INITTC / YES, DO NOT EXECUTE PRQ REQUESTS /A038 /D038 / SET THE WPS DEFINED TERMINAL CHARACTERISTIC INTO THE TERMINAL REMEMBERING /D038 / THAT SCREEN WIDTH IS FORCED TO 80 COLUMNS & TERMINAL MODE IS FORCED TO ANSI /D038 CDFMNU /D038 TAD I XSETUP / terminal characterics from "SETUP" /D038 DCA PRQBLK / TERMINAL CHARACTERISTICS /D038 TAD I XPBAUD / printer baud rate /D038 AND (17) / /D038 DCA PRQBLK+1 / PRINTER BAUD RATE /D038 TAD I XCBAUD / communications baud rate /D038 AND (17) / /D038 DCA PRQBLK+2 / COMMUNICATIONS BAUD RATE /D038 CDFMYF /D038 PRQ3 / EXECUTE PANEL REQUEST /D038 CDFMYF&70%10+4000 / 40 (dest field 0) (src field MYF) /D038 PRQBLK / source starting address /D038 24 / destination starting address /D038 -3 / three words to move /D038 7777 / PRQ3 terminator /D038 AC7777 / Disable blanking screen /D038 PRQ3 /D038 17 / Code /D038 7777 / Terminator /D038 CLA / (just in case ac dirty after prq) /D038 / NOTE THAT A "RST" (ESC c) IS ISSUED AFTER THE RETURN FROM THIS ROUTINE. /D038 JMP I INITTC /D038 / Order important /D038 PRQBLK, /D038 XSETUP, MUBUF+MNSECN /D038 XPBAUD, MUBUF+MNPRTB /D038 XCBAUD, MUBUF+MNPRIM /D038 / End order important /D038 > / END IFDEF CONDOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE /D038 /WARM START ROUTINE TO SET UP OVERLAY TO CALL VERIFY /A035 /D038 CUDWRM, CDFSYS /A036 /D038 TAD I (DAMNTH) / RESET FOR DISPLAY /A036 /D038 SPA / CHECK FOR "F" COMMAND /A036 /D038 JMP CUDWRP / NO, WARM START ERROR /A036 /D038 CLA / RETURN WITH CLEAN ACCUMULATOR /A036 /D038 CDFMYF / HERE THROUGH "F" COMMAND /A036 /D038 JMP CUDXIT /A036 /D038 CUDWRP, CMA / WARM START SET ON ERROR IN DSKACP /A036 /D038 DCA I (DAMNTH) /A036 /D038 CDFMNU /A035 /D038 TAD (MUBUF+MNONUM-1) / START OF OVLY TABLE -1 /A035 /D038 DCA X0 /A035 /D038 TAD VFYNUM / VERIFY OVERLAY NUMBER /A035 /D038 DCA I X0 /A035 /D038 TAD VFYADR / START ADDRESS OF VERIFY /A035 /D038 DCA I X0 /A035 /D038 TAD VFYFLD / VERIFY FIELD /A035 /D038 DCA I X0 /A035 /D038 CDFMYF / RESET FIELD /A035 /D038 ISZ CUDRST / SET RETURN TO CALL OVLAY /A035 /D038 JMP CUDXIT / RETURN /A035 /D038 VFYNUM, 14 / OVLAY NUMBER /A035 /D038 VFYADR, 200 / START ADDRESS OF VERIFY /A035 /D038 VFYFLD, CIF 10 / VERIFY FIELD -2 /A035 /D038 IFDEF CONDOR < /D038 / ROUTINE TO SET VALUES INTO MENU FIELD TEMP REGISTERS FOR RD DISPLAY /A037 /D038 CUDVAL, XX / GET PANEL VALUES INTO MENU TEMPS /A037 /D038 PRQ3 / ISSUE A PANEL REQUEST /A037 /D038 5041 / 50XY - X=DEST FIELD, Y=SRC FIELD /A037 /D038 20 / SOURCE ADDRESS IN PANEL MEMORY /A037 /D038 CUDTMP / DESTINATION ADDRESS IN THIS FIELD /A037 /D038 -2 / NUMBER OF WORDS TO MOVE /A037 /D038 -1 / TERMINATOR FOR PANEL REQUEST FUNCTION /A037 /D038 TAD (MUBUF+MNTMP5-1) / GET POINTER TO MENU FIELD TEMPS /A037 /D038 DCA X0 / STORE POINTER FOR INDIRECT STORAGE /A037 /D038 CDFMNU / CHANGE TO MENU FIELD /A037 /D038 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 /D038 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 /D038 AND (7) / MASK OFF LOW ORDER BITS /A037 /D038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 /D038 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 /D038 RTR;RAR / SHIFT VALUE THREE PLACES TO THE RIGHT /A037 /D038 AND (7) / MASK OFF LOW ORDER BITS /A037 /D038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 /D038 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 /D038 AND (7) / MASK OFF LOW ORDER BITS /A037 /D038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 /D038 TAD CUDTMP+1 / GET INTERNAL ROM VALUE TO BE SPLIT /A037 /D038 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 /D038 AND P77 / MASK OFF LOW ORDER BITS /A037 /D038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 /D038 TAD CUDTMP+1 / GET INTERNAL ROM VALUE TO BE SPLIT /A037 /D038 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 /D038 AND P7700 / MASK OFF HIGH ORDER BITS /A037 /D038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 /D038 JMP I CUDVAL / RETURN WITH DATA FIELD SET TO MENU /A037 /D038 / THIS ROUTINE TAKES THE DATE FROM PANEL MEMORY, WHEN CALLED FROM /D038 / MASTER MENU, AND PUTS IT INTO THE FORMAT REQUIRED BY WPS. /D038 / MASTER MENU STORES THE DATE IN THE FOLLOWING WAY: MM/DD/YY. /D038 / /D038 / WPS LOCATION "MNFMAT" DEFINES THE WAY THE DATE IS TO BE ENTERED: /D038 / CODE 0 = INVALID, 1= DD/MM/YY, 2=MM/DD/YY, 3=YY/MM/DD /D038 / /D038 DTFRMT, 0 /A032 /D038 TAD (PMDATE) / START OF DATE BUFFER /A032 /D038 DCA DTINBF / DATE INPUT BUFFER /A032 /D034 PRQ3 / READ SIGNATURE /A032 /D034 CU2FLD^10+PMFLD+RDPMEM / 50XY Y=INPUT FLD X=OUTPUT FIELD /A032 /D034 PMSIGN / LOC OF SIGNATURE IN P.M. /A032 /D034 F1DATE / TEMP USE /A032 /D034 -1 / -NUMBER WORDS TO BE READ /A032 /D034 -1 / TERMINATOR /A032 /D034 TAD (SIGNAT) / SIGNATURE=-7531 /A032 /D034 TAD F1DATE / WHAT IS SIGNATURE? /A032 /D034 SZA CLA / IS DATE IN P.M. IN FORMAT /A032 /D034 JMP DTSAME / NO DON'T WORRY ABOUT IT /A032 /D038 AC0003 / SET UP MASK FOR DATE BITS /A032 /D038 AND CUDBUF+MNFMAT-MNABRV / ISOLATE THE DATE BITS /A032 /D038 SNA / 0=INVALID /A032 /D038 JMP DTSAME / IGNORE /A032 /D038 CLL RAR / 1 INTO LINK 2 BIT TO 1 BIT /A032 /D038 SNA CLA / IS THIS CODE 1? FORMAT=DD/MM/YY /A032 /D038 JMP DTCOD1 / YES.. GO SET UP DD/MM/YY /A032 /D038 SNL / NO.. MUST BE CODE 2 OR 3 /A032 /D038 JMP DTSAME / CODE 2=MM/DD/YY (SET ALREADY) /A032 /D038 DTCOD3, JMS RDDATE / CODE 3=YY/MM/DD - READ DATE TO BUFFER /A032 /D038 F2DATE / MONTH TO 2ND DATE FIELD /A032 /D038 F3DATE / DAY TO 3RD DATE FIELD /A032 /D038 F1DATE / YEAR TI FIRST DATE FIELD /A032 /D038 0 / TERMINATOR /A032 /D038 JMP DTWRIT / CONT /A032 /D038 DTCOD1, JMS RDDATE / CODE 1 DD/MM/YY - READ DATE TO BUFFER /A032 /D038 F2DATE / MONTH TO 2ND DATE FIELD /A032 /D038 F1DATE / DAY TO FIRST DATE FIELD /A032 /D038 F3DATE / YEAR TO 3RD DATE FIELD /A032 /D038 0 / TERMINATOR /A032 /D038 DTWRIT, PRQ3 / WRITE IT OUT /A032 /D038 PMFLD^10+CU2FLD+WRPMEM / 4064- WRITE TO FIELD 6 P.M. FROM THIS /A032 /D038 F1DATE / START LOC /A032 /D038 PMDATE / PAN MEM DATE LOC /A032 /D038 DTLEN / =-8 DD/MM/YY OR OTHER FORMAT /A032 /D038 -1 / TERMINATOR /A032 /D038 DTSAME, JMP I DTFRMT / RETURN /A032 /D038 /READ DATE.... STORED IN FORMAT MM/DD/YY READ INTO PROPER FORMAT /A032 /D038 /..............2 CHARS. AT A TIME INTO LOCATION SPECIFIED BY PARAMS /A032 /D038 / /D038 RDDATE, 0 /A032 /D038 /D038 RDDAT2, TAD I RDDATE / GET ARG /A032 /D038 ISZ RDDATE / INC RET /A032 /D038 SNA / END READ? /A032 /D038 JMP I RDDATE / YES /A032 /D038 DCA DTOTBF / SET OUTPUT /A032 /D038 PRQ3 /A032 /D038 CU2FLD^10+PMFLD+RDPMEM / FROM P.M. TO CU2 BUFFER /A032 /D038 DTINBF, PMDATE / LOCATION IN P.M. DATE IS STORED /A032 /D038 DTOTBF, F1DATE / TO BE STORED /A032 /D038 -2 / #WORDS TO BE READ /A032 /D038 -1 / TERMINATOR /A032 /D038 AC0003 / LENGTH OF FLD +"/" /A032 /D038 TAD DTINBF / RESET INPUT FLD /A032 /D038 DCA DTINBF /A032 /D038 JMP RDDAT2 / NEXT /A032 /D038 > /END IFDEF CONDOR /A032 IFDEF CONDOR < / NOTE:: THIS CODE IS EXECUTED ONCE AFTER POWER-UP FOR DECMATE II SYSTEM /A038 / THIS ROUTINE TAKES THE DATE FROM PANEL MEMORY, WHEN CALLED FROM /A038 / MASTER MENU, AND PUTS IT INTO THE FORMAT REQUIRED BY WPS. /A038 / MASTER MENU STORES THE DATE IN THE FOLLOWING WAY: MM/DD/YY. /A038 / WPS LOCATION "MNFMAT" DEFINES THE WAY THE DATE IS TO BE ENTERED: /A038 / CODE 0 = INVALID, 1= DD/MM/YY, 2=MM/DD/YY, 3=YY/MM/DD /A038 DM2INT, 0 /A032 TAD (PMDATE) / START OF DATE BUFFER /A032 DCA DTINBF / DATE INPUT BUFFER /A032 AC0003 / SET UP MASK FOR DATE BITS /A032 AND CUDBUF+MNFMAT-MNABRV / ISOLATE THE DATE BITS /A032 SNA / 0=INVALID /A032 JMP DTSAME / IGNORE /A032 CLL RAR / 1 INTO LINK 2 BIT TO 1 BIT /A032 SNA CLA / IS THIS CODE 1? FORMAT=DD/MM/YY /A032 JMP DTCOD1 / YES.. GO SET UP DD/MM/YY /A032 SNL / NO.. MUST BE CODE 2 OR 3 /A032 JMP DTSAME / CODE 2=MM/DD/YY (SET ALREADY) /A032 DTCOD3, JMS RDDATE / CODE 3=YY/MM/DD - READ DATE TO BUFFER /A032 F2DATE / MONTH TO 2ND DATE FIELD /A032 F3DATE / DAY TO 3RD DATE FIELD /A032 F1DATE / YEAR TI FIRST DATE FIELD /A032 0 / TERMINATOR /A032 JMP DTWRIT / CONT /A032 DTCOD1, JMS RDDATE / CODE 1 DD/MM/YY - READ DATE TO BUFFER /A032 F2DATE / MONTH TO 2ND DATE FIELD /A032 F1DATE / DAY TO FIRST DATE FIELD /A032 F3DATE / YEAR TO 3RD DATE FIELD /A032 0 / TERMINATOR /A032 DTWRIT, PRQ3 / WRITE IT OUT /A032 PMFLD^10+CU2FLD+WRPMEM / 4064- WRITE TO FIELD 6 P.M. FROM THIS /A032 F1DATE / START LOC /A032 PMDATE / PAN MEM DATE LOC /A032 DTLEN / =-8 DD/MM/YY OR OTHER FORMAT /A032 -1 / TERMINATOR /A032 / THIS CODE ISSUES A PRQ3 REQUEST TO PANEL MEMORY TO SET THE WPS USER / DEFINED TERMINAL CHARACTERISTICS INTO PANEL MEMORY PROGRAM LOCATIONS / 24, 25, AND 26 THEREBY POWERING UP TO THE WPS CHARACTERISTICS / SET THE WPS DEFINED TERMINAL CHARACTERISTIC INTO THE TERMINAL REMEMBERING / THAT SCREEN WIDTH IS FORCED TO 80 COLUMNS & TERMINAL MODE IS FORCED TO ANSI DTSAME, CDFMNU TAD I XSETUP / TERMINAL CHARACTERICS FROM "SETUP" TAD (1200) / Set term Lvl 8 , 8 bit host /A042 DCA PRQBLK / TERMINAL CHARACTERISTICS TAD I XPBAUD / PRINTER BAUD RATE AND CUDC17 / MASK OFF LOW ORDER BITS DCA PRQBLK+1 / PRINTER BAUD RATE TAD I XCBAUD / COMMUNICATIONS BAUD RATE AND CUDC17 / MASK OFF LOW ORDER BITS DCA PRQBLK+2 / COMMUNICATIONS BAUD RATE CDFMYF PRQ3 / EXECUTE PANEL REQUEST CDFMYF&70%10+4000 / 40 (DEST FIELD 0) (SRC FIELD MYF) PRQBLK / SOURCE STARTING ADDRESS 24 / DESTINATION STARTING ADDRESS -3 / THREE WORDS TO MOVE 7777 / PRQ3 TERMINATOR AC7777 / DISABLE BLANKING SCREEN PRQ3 CUDC17, 17 / CODE 7777 / TERMINATOR CLA PRQ3 / Switch cursor on as disabled by V25st /a042 0025 / on start-up. Do this using PRQ3, #25 /a042 7777 / with AC=0 /a042 AC0001 / SET SLUSHWARE FOR DECMATE MODE /A033 PRQ3 / ISSUE PANEL REQUEST TO SLUSHWARE /A033 10 / FUNCTION CODE ARGUMENT /A033 7777 / END OF LIST INDICATOR /A033 CIFMNU / ISSUE RESET TO TERMINAL TO SET VALUES /A038 JMS I IOACAL / CALL SYSTEM DISPLAY ROUTINE /A038 0 / USE DEFAULT OUTPUT ROUTINE /A038 RSTCON / "ESC c" /A038 JMP I DM2INT / RETURN TO CALLER /A038 / SUBROUTINE TO READ DATE - STORED IN FORMAT MM/DD/YY READ INTO PROPER /A032 / FORMAT 2 CHARS. AT A TIME INTO LOCATION SPECIFIED BY PARAMS /A032 RDDATE, XX /A032 RDDAT2, TAD I RDDATE / GET ARG /A032 ISZ RDDATE / INC RET /A032 SNA / END READ? /A032 JMP I RDDATE / YES /A032 DCA DTOTBF / SET OUTPUT /A032 PRQ3 /A032 CU2FLD^10+PMFLD+RDPMEM / FROM P.M. TO CU2 BUFFER /A032 DTINBF, PMDATE / LOCATION IN P.M. DATE IS STORED /A032 DTOTBF, F1DATE / TO BE STORED /A032 -2 / #WORDS TO BE READ /A032 -1 / TERMINATOR /A032 AC0003 / LENGTH OF FLD +"/" /A032 TAD DTINBF / RESET INPUT FLD /A032 DCA DTINBF /A032 JMP RDDAT2 / NEXT /A032 / ROUTINE TO SET VALUES INTO MENU FIELD TEMP REGISTERS FOR RD DISPLAY /A037 CUDVAL, XX / GET PANEL VALUES INTO MENU TEMPS /A037 PRQ3 / ISSUE A PANEL REQUEST /A037 5041 / 50XY - X=DEST FIELD, Y=SRC FIELD /A037 20 / SOURCE ADDRESS IN PANEL MEMORY /A037 CUDTMP / DESTINATION ADDRESS IN THIS FIELD /A037 -2 / NUMBER OF WORDS TO MOVE /A037 -1 / TERMINATOR FOR PANEL REQUEST FUNCTION /A037 TAD (MUBUF+MNTMP5-1) / GET POINTER TO MENU FIELD TEMPS /A037 DCA X0 / STORE POINTER FOR INDIRECT STORAGE /A037 CDFMNU / CHANGE TO MENU FIELD /A037 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 AND CUDC7 / MASK OFF LOW ORDER BITS /C038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 RTR;RAR / SHIFT VALUE THREE PLACES TO THE RIGHT /A037 AND CUDC7 / MASK OFF LOW ORDER BITS /C038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 TAD CUDTMP / GET INTERNAL DATA VALUE TO BE SPLIT /A037 AND CUDC7 / MASK OFF LOW ORDER BITS /C038 DCA I X0 / STORE VALUE IN MENU TEMP /A037 TAD CUDTMP+1 / GET INTERNAL ROM VALUE TO BE SPLIT /A037 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 AND P77 / MASK OFF LOW ORDER BITS /A037 DCA I X0 / STORE VALUE IN MENU TEMP /A037 TAD CUDTMP+1 / GET INTERNAL ROM VALUE TO BE SPLIT /A037 BSW / SWAP HIGH ORDER WITH LOW ORDER BYTE /A037 AND P7700 / MASK OFF HIGH ORDER BITS /A037 DCA I X0 / STORE VALUE IN MENU TEMP /A037 JMP I CUDVAL / RETURN WITH DATA FIELD SET TO MENU /A037 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE > / END IFDEF CONDOR /A032 /CUDBUF, ZBLOCK 400 / MOVED TO 7000 (DEFINED IN WPF1) /C029 / WPCU3 - COMMAND UTILITIES III / / 044 KMD 02-Oct-85 Allow MNCs in file name to be deleted. / 043 EMcD 11-Sep-85 Fix bug dispalying MCS/Tech chars / if bolded when deleting / 042 EMcD 11-Sep-85 Add Nordic translations / (conditionalised) / 041 Mart 01-aug-85 fix assembly bug in ITALIAN / 040 WCE 29-SEP-84 DISPLAY TECH CHARACTER IN DELETE TEXT / 039 DFB 27-SEP-84 Fix to prevent AD when TM=GRAPHICS / 038 DFB 17-SEP-84 FIX TO CHECK GRAPHICS BOARD FOR DMIII / 037 DFB 11-SEP-84 FIX TO PREVENT LOGON IN GRAPHICS MODE / 036 DFB 07-SEP-84 FIX TM=125 REFERENCE / 035 TCW 16-JUL-84 Expand # of terminal modes / 034 DFB 11-JUN-84 CX GRAPHICS-clear/set call to flash buz / ...TIMDSP+3 -- WP2CMF -- / ...when PRTFLD loaded/deleted / 033 DFB 16-MAY-84 Fix load parameter DSPRM1 / 032 DFB 02-MAY-84 Add addtnl fld to graphics mode(vt125) / 031 DFB 20-APR-84 Reload printer page 0(20-76) on ret VT125 / 030 DFB 17-APR-84 Fixes to VT125 graphics mode / 029 DFB 02-APR-84 Change graphics to load each time called / 028 TCW 27-MAR-84 Add PHONE capability / 027 WCE 26-MAR-84 CHANGED NAME FROM VT-125 TO WPSUTL / 026 SBB 27-DEC-83 SOME GRFX CONSTANTS CHANGED etc. / 025 SBB 12-DEC-83 PUT IN DATE CHECK FOR GRFX DISKETTE / 024 SBB 26-SEP-83 DON'T PUT BUFFER IN 5 OR 6 FOR VT125 / LOAD GRAPHICS FROM DISK AND/OR CPMEM / 023 GDH 18-APR-83 Moved Buffer from field 5 to field 6. / 022 GDH 17-APR-83 Moved Buffer defns from WPF1 to local. / 021 GDH 13-APR-83 Implemented larger COMMUNICATIONS / buffer into field 5. / ---------------------------------------- / | EDIT HISTORY BELOW IS FOR DECmate II | / ---------------------------------------- / 020 DFB 14-DEC-82 Ignore blk 0 as hdr(error) / 019 SBB 25-aug-82 changed cursor position at "DEOPEN" / from top line to row 1 / / 018 mjs 10-aug-82 Deleted "H2INIT" (communications init) / within subroutine "CU3COM". The HOST / will be init only at POWER-UP and / "CC" menu. / / --------------------------------------- / | EDIT HISTORY BELOW IS FOR DECmate I | / --------------------------------------- / 017 GDH 23-MAR-82 Implemented the "valid goto page" bit / in header pointer. / 016 GDH 15-NOV-81 Take into consideration Extn blocks. / 015 GDH 12-NOV-81 Modified DELETE to delete RPG blocks. / 014 GDH 16-OCT-81 Implemented 3rd TM option (DWORD) / 013 GDH 14-OCT-81 added clear of menu lock word for / ax/dx upon their initialization. / De-implemented LOCK/UNLOCK. / 012 GDH 2-Oct-81 Moved COMM support to sys field. / 011 GDH 29-Sep-81 Fixed bug in loading port 0 / characteristics (port 1 was / always being selected). / 010 GDH 22-Sep-81 Primary/Secondary port support. / 009 GDH 26-Aug-81 WPFILS calling seq changes. / Removed SLAVE SCREEN/EXCHANGE KBDS / command utilities. / 008 TT 07-JUL-81 Removed superfluous conditionals / 007 JM 09-APR-81 Deleted patch into H2PAT since this / location is no longer used / 006 DAO 18-SEP-80 MERGED WITH X3.5 / 005 DM,JM 15-SEPT-80 MERGED SCANDI AND EUROPE/ENGLISH / 004 DSS 09-JUL-80 MOFIDIED FOR ENGLISH/FRENCH-CANADIAN / 003 CMW 5-MAY-80 ENTERED CANADA TRANSLATIONS / 002 DSS 17-APR-80 ENTERED DUTCH FIXES / 001 GLT 24-Mar-80 Inserted French, German and Dutch translations / French diacritical substitutions: / "["-L.A.E, "]"-L.G.E; "&" unavailable / German diacritical substitutions: / "["-L.U.A, "\"-L.U.O, "]"-L.U.U; "&" usable / III.D MB 1-APR-78 PUT IN SYSTEM OPTIONS / III.D KEE 29-MAR-78 CHANGED FOR WT FILENUMBER REP. PLUS CLEANUP / 2.N-1 RLT 9/14/77 CREATED FROM WPCU2 / WRITES OUT WPCU3 / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOCU3 / ++++ 0 / ++++ CDF 20 / ++++ -DSOCU3 0 / FIELD 2 / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / CIFMYF=CIFBUF / DEFINE OUR FIELD. CDFMYF=CDFBUF / ... CDFTFL=CDFSYS /A029 / ROUTINE TO GET A CHARACTER FROM THE DOCUMENT FILE /A040 CHRGET, XX / GET A CHARACTER FROM DOCUMENT /A040 CIFFIO / CHANGE TO HANDLER FIELD /A040 FILEIO / MAKE A REQUEST OF THE FILE SYSTEM /A040 XRDFNC / READ A CHARACTER FROM THE DOCUMENT /A040 SPA / CHECK FOR ANY READ ERRORS /A040 JMP DELERR / YES, GO HANDLE THE READ ERROR /A040 SNA / CHECK FOR END OF DOCUMENT /A040 JMP DELEOF / YES, GO HANDLE END OF DOCUMENT /A040 JMP MSKIT / Mask char /A043 CHRGEX, JMP I CHRGET / RETURN TO CALLER WITH CHARACTER IN AC /A040 / ROUTINE TO GET AND CHECK A CHARACTER FROM THE DOCUMENT /A040 DELCHK, XX / GET AND CHECK A DOCUMENT CHARACTER /A040 DELCK1, JMS CHRGET / GET CHARACTER FROM THE DOCUMENT /A040 JMS DELFLT / CHECK FOR A PRINTABLE CHARACTER /A040 JMP DELCK1 / NOT PRINTABLE, IGNORE IT /A040 TAD (-ECSTOV) / COMBINE WITH START DEAD KEY CODE /A040 SNA CLA / IS THIS A START OF DEAD KEY CODE ? /A040 JMP DELCK2 / YES, GO CHECK FOR A TEC CHARACTER /A040 DELXIT, TAD T2 / GET THE SAVED DOCUMENT CHARACTER /A040 ISZ DELCHK / BUMP PAST TECH CHARACTER RETURN /A040 DELTEC, ISZ DELCHK / BUMP PAST END OF FILE ERROR RETURN /A040 DELEOF, ISZ DELCHK / BUMP PAST READ ERROR RETURN /A040 DELERR, JMP I DELCHK / RETURN TO CALLER /A040 DELCK2, JMS CHRGET / GET THE NEXT CHARACTER FROM DOCUMENT /A040 TAD (-ECSPC) / COMBINE WITH SPACE CODE /A040 SZA CLA / IS THIS START OF A TEC CHARACTER ? /A040 JMP DELXIT / NO, GO RETURN TO CALLER /A040 JMS CHRGET / YES, GET NEXT CHARACTER FROM DOCUMENT /A040 TAD (-ECSPC) / COMBINE WITH SPACE CODE /A040 SNA CLA / IS THIS START OF A REQUIRED SPACE ? /A040 JMP DELXIT / YES, GO RETURN TO CALLER /A040 TAD T2 / NO, GET THE SAVED DOCUMENT CHARACTER /A040 TAD (-62) / COMBIND WITH SECOND G-SET CODE /A040 SZA / IS THIS THE SECOND G-SET ? /A040 JMP DELCK3 / NO, MUST BE FIRST OR THIRD /A040 TAD (7400) / YES, SET UP SECOND G-SET CODE /A040 JMP DELSET / GO SET UP CHARACTER SET SELECTION /A040 DELCK3, SMA CLA / IS THIS THE THIRD G-SET CODE ? /A040 TAD (7400) / YES, SET UP THIRD G-SET CODE /A040 TAD (200) / NO, SET UP FIRST G-SET CODE /A040 DELSET, DCA T1 / STORE CHARACTER SET SELECTION CODE /A040 JMS CHRGET / GET NEXT CHARACTER FROM DOCUMENT /A040 AND P177 / MASK OFF ANY HIGH ORDER BITS /A040 DCA DELMS1 / STORE CHARACTER TO BE DISPLAYED /A040 CDIMNU / CHANGE TO MENU FIELD /A040 TAD I (MUBUF+MNLANG) / PICK UP THE LANGUAGE WORD /A040 DCA T2 / STORE FOR RESET TO PROPER LANGUAGE /A040 CDFMYF / SET TO THIS FIELD FOR IOACAL RETURN /A040 JMS I IOACAL / CALL SYSTEM DISPLAY ROUTINE /A040 0 / USE DEFAULT OUTPUT ROUTINE /A040 DELMSG / CONTROL STRING TO USE /A040 T1 / CHARACTER SET SELECTION CODE /A040 DELMS1 / CHARACTER TO BE DISPLAYED /A040 T2 / RESET LANGUAGE SELECTION CODE /A040 JMP DELTEC / GO RETURN AND COUNT THE CHARACTER /A040 DELMS1, .-. / ASCII CHARACTER TO BE DISPLAYED /A040 0 / TERMINATOR FOR ASCII STRING /A040 /-------------------- PAGE /d021; CU3BF1=7400 / TEMP BUFFER THAT CAN BE USED BY ANY OF THE RROUTINES / XX / CUDELT - DELETE COMMAND JMS CUDELT CDIMNU JMP I .-3 / XX / CUSS - SLAVE SCREEN HLT / SHOULD NEVER GET HERE. /M009 CDIMNU JMP I .-3 / XX / CUXK - EXCHANGE KEYBOARDS HLT / SHOULD NEVER GET HERE. /M009 CDIMNU JMP I .-3 / CU3COX, XX JMS CU3COM / WILL CALL IN THE CORRECT COMMUNICATIONS OVERLAY AFTER CDIMNU JMP I .-3 / SETTING THE CORRECT OPTIONS FOR THE LINE / / THESE ARE CONSTANTS USED BY THE DELETE COMMAND / DELIMB=-400 / THE SIZE OF THE BLOCK BUFFER DEBUFR=5200 / STARTING ADDRESS OF THE BLOCK DEBUF=3000 / ADDRESS OF THE RECORD BUFFER /M0009 DERCAY=5600 / THE RECORD NUMBERS TO BE DELETED / TAB=11 / THE TAB VALUE LF=12 / VALUE FOR A LINE FEED CR=15 / CARRIGE RETURN BLANK=40 / ASPACE / LNCNT=-12 / THE LINE COUNTER CRCNT=-120 / NEGATIVE CHARACTER COUNT FOR A LINE RECLIM=-2577 / NEGATIVE THE LIMIT OR CHARACTERS IN A RECORD / DESTRP=1014 / THE START OF PRINTER CONTROL DENDP=1414 / END OF PRINTER CONTROL DESTRR=16 / START OF RULER DENDR=17 / END OF RULER / / / THIS IS THE DELETE COMMAND. / CUDELT, XX / CLA DCA DELERT / CLEAR THE ERROR FLAG / CDFBUF / CLEAR THE BEGINNING OF THE BUFFERS DCA I (DEBUF) / THE BUFFER FOR A RECORD WHEN CHECKING / THE INDEX DOCUMENT DCA I (DERCAY) / THE BUFFER CONTAINING THE RECORDS TO / DELETE FROM THE INDEX DOCUMENT CDFMYF / DCA DEPRNT / CLEAR THE PRINTER CONTROL FLAG DCA DERULE / CLEAR THE RULER FLAG TAD (CRCNT) / INITALIZE THE CHARACTER COUNT FOR A LINE DCA DELCTM TAD (LNCNT) / INITALIZE THE LINE COUNTER TO A NEGATIVE 10 DCA DELLTM DCA DELMT DCA DELERT / CLEAR THE ERROR CODE / CDFMNU / GET THE FILE NUMBER TO BE DELETED TAD I (MUBUF+MNFNO) CDFMYF / DCA DELFND / SAVE THE NUMBER TAD DELFND / CREATE AN ABSOLUTE FILE NUMBER AND P377 DCA DELFNO / CDFMNU / GET THE DRIVE THAT THE FILE IS ON TAD I (MUBUF+MNDRV) CDFMYF / DCA DELDRV / SAVE IT TAD DELDRV BSW / ++++ RTL CLL / POSITION DRIVE NUMBER AND INCLUDE A IAC / DOCUMENT MUNBER OF 1 DCA DELIND / BE USED FOR THE INDEX / THE FIRST 10 LINES OF THE DOCUMENT TO BE DELETED ARE DISPLAYED FOR / THE USER'S APPROVIAL / DEOPEN, JMS DEINDX / CHECK HDR BLOCK FOR 0 /A020 CIFMNU JMS I IOACAL / "Beginning of document to be deleted" 0 / default output routine DELNMS / message text address 0 / cursor position for clear screen 0100 / PUT HEADING ON 2ND LINE /A019 IFDEF CANADA < 141 / L.G.A--Accented character > IFDEF FRENCH < 141 / L.G.A--Accented character > 300 / cursor position for document text / DCA DEPRNT / CLEAR THE FLAG FOR PRINT CONTROL DCA DERULE / CLEAR THE RULER FLAG / TAD DELFND / GET THE FILE TO BE DELETED CIFFIO / FILEIO / XRDFIN / INITALIZE THE READFIL ROUTINE / DELLP1, JMS DELCHK / GET AND CHECK A DOCUMENT CHARACTER /A040 JMP DERRO2 / HANDLE READ ERROR ON FILE DETECTED JMP DEXT / HANDLE END OF DOCUMENT ENCOUNTERED JMP DELLP3 / TECH CHARACTER, GO COUNT IT /A040 AND P177 / MASK OF HIGH ORDER BITS TAD (-LF) / SEE IF A LINE FEED SNA / ++++ JMP DELRES TAD (LF-TAB) / CHECK FOR TAD CHANGE TO SPACE SNA / ++++ JMP DETAD2 TAD (TAB-40) / GET RID OF UNWANTED CONTROL CHARACTERS SPA / ++++ JMP DELLP1 TAD (40) DELLP2, JMS DELDIS / DISPLAY THE CHARACTER DELLP3, ISZ DELCTM / INCREMENT THE CHAR COUNT FOR A LINE JMP DELLP1 DELRES, TAD (CRCNT) / RESET THE CHARACTER COUNT FOR LINE OVERFLOW DCA DELCTM TAD (LF) / INSERT A LF TO THE SCREEN JMS DELDIS TAD (CR) / NOW A CR TO END THE LINE JMS DELDIS ISZ DELLTM / THE LINE COUNTER (COUNTS THE 10) JMP DELLP1 JMP DEXT / DONE WITH THE DOCUMENT DISPLAY DETAD2, TAD (BLANK) / INSERT A BLANK JMP DELLP2 DELRUT,/D013; JMS ULKSUB / UNLOCK THE DOCUMENT AND INDEX /D013; DELIND /D013; JMS ULKSUB /D013; DELFND CUEXIT, JMP I CUDELT DELFNO, 0 DELFND, 0 DELIND, 0 DELDRV, 0 DELCTM, 0 DELLTM, 0 MSKIT, AND P177 / Mask each char /A043 DCA T2 / SAVE THE CHARACTER /A040 TAD T2 / GET THE CHARACTER BACK AGAIN /A040 JMP CHRGEX / Go back now /A043 /-------------------- PAGE /D013; /D013;/ /D013;/ ULKSUB - ROUTINE TO UNLOCK A FILE /D013;/ /D013;/ CALL: JMS ULKSUB /D013;/ FNOADD ADDRESS OF THE FILE NUMBER WITH DRIVE NUMBER IN /D013;/ BITS 0-3 /D013;/ /D013;ULKSUB, XX /D013; CLA /D013; IFDEF WS102 < /D013; TAD I ULKSUB /D013; DCA ULKP1 /D013;/ /D013; CIFPRT /D013; JMS I (ULKFIL) /D013;ULKP1, 0 /D013; USERNO /D013;/ /D013; > /D013;/ /D013; ISZ ULKSUB /D013; JMP I ULKSUB / / NOW CHECK THE INDEX FILE FOR THE NAMES GIVEN TO THE FILE FOR DELETION / TO ASK THE USER IF THEY ARE CORRECT / DEXT, CLA DCA DERULE / CLEAR THE RULER FLAG DCA DEPRNT / AND THE PRINTER CONTROL / TAD DELIND / OPEN THE INDEX FILE FOR READING CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XRDFIN CLA DCA DERCNT / CLEAR THE RECORD COUNT OF THE INDEX TAD (DERCAY) / GET THE STARTING ADDRESS OF THE ARRAY / CONTAINING THE RECORDS TO BE DELETED DCA DETARY DELKIN, ISZ DERCNT / INCREMENT THE RECORD COUNTER JMS DERDNM / READ IN A RECORD DEADR3 / THIS IS THE SEQUENCE THAT DENOTES EOR JMP DEDONE / THERE IS NO MORE RECORDS / CLA TAD (DEBUF-1) / START CHECKING FOR THE PARTS DCA X2 / THAT ARE DEFINED IN A RECORD / JMS DECKTK / CHECK FOR THE DEADR1 JMP DERRO1 / NONE FOUND / CLA TAD X2 / SAVE THE LOCATION THAT IT WAS FOUND AT DCA DETMP2 / TO COMPARE TO THE LOCATION OF THE <#> / JMS DECKTK / SEE IF ANY MORE EXIST IN THE RECORD DEADR1 JMP DEJMP1 / NONE FOUND OK JMP DERRO1 / ANOTHER FOUND ITS AN ERROR / / / NOW THE CHECK FOR THE <#> TO FIND THE FILE NUMBER RELATED TO THE / RECORD BEING EXAMINED / DEJMP1, CLA TAD (DEBUF-1) / SET THE STARTING ADDRESS OF THE SEARCH DCA X2 / JMS DECKTK / LOOK FOR A <#> DEADR2 JMP DERRO1 / NONE FOUND-AN ERROR / CLA TAD X2 / SAVE THE LOCATION THAT THE <#> IS IN TO DCA DETMP3 / CHECK THAT THE <#> IS AFTER THE / JMS DECKTK / CHECK FOR ANY MORE <#> IN THE RECORD DEADR2 SKP JMP DERRO1 / YES / CLA / CHECK FOR THE RIGHT ORDER TAD DETMP2 CIA TAD DETMP3 SPA CLA / ++++ JMP DERRO1 / TAD DETMP3 / SET THE SEACH LOCATION TO THE LOCATION DCA X2 / AFTER THE <#> TO CHECK THE FILE NO. / JMS DEFNUM / CONVERT THE NUMBER IN THE RECORD TO JMP DERRO1 / BINARY TO COMPARE TO THE FILE NO. / TO BE DELETED CIA TAD DELFNO / COMPARE THE NUMBERS SZA CLA / ++++ JMP DELKIN TAD DERCNT / SAVE THE RECORD COUNT FOR DELETING / CDFBUF DCA I DETARY ISZ DETARY DCA I DETARY CDFMYF / TAD DETMP2 / GET THE LOCATION OF THE DCA X2 / SAVE IT AS THE POINTER / TAD DELMT / SEE IF THE MESSAGE IS ALREADY UP SZA CLA / ++++ JMP DEJMP2 / IF SO DONT DO IT AGAIN ISZ DELMT / TAD DELFND AND P377 DCA DEJNO CIFMNU JMS I IOACAL / Print "Entries in document for #.# --" 0 / default output routine DEDCNM / string address 1600 / cursor position DELDRV / drive number DEJNO, 0 / document number 2000 / cursor position / CLA DEJMP2, JMS DECKDS / DISPLAY THE NAME ON THE SCREEN JMP DERRO1 / JMP DELKIN DETARY, 0 DETMP2, 0 DETMP3, 0 DELMT, 0 DEXTNL, ZBLOCK 22 / 1 FOR HEADER /A016 / 16. FOR EXTENSIONS. /A016 / 1 FOR STOPPER (ALWAYS 0). /A016 /************ /************ THE NEXT 3 LOCATIONS MUST REMAIN IN ORDER FOR THE DELT ROUTINE. /************ DEHDBK, 0 DERHBK, 0 / RAPID PAGINATION HEADER BLOCK #1. /A015 0 / HEADER STOPPER. /A016 /-------------------- PAGE / / DELETE THE RECORDS IN THE INDEX DOCUMENT IF ANY / THAT ARE FOR THE DOCUMENT TO BE DELETED / DECONT, CLA DCA DELERT / CLEAR THE ERROR FLAG TAD (DERCAY) / GET THE START ADDRESS OF THE LIST OF RECORDS DCA DEBFT / TO BE DELETED / CDFBUF TAD I DEBFT CDFMYF / SNA CLA / ++++ JMP DEDON1 / IF ZERO SKIP THE PROCESS / TAD DELIND / OPEN THE INDEX FILE TO BE MODIFIED MQL CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XDSKIN / OPEN THE INDEX CLA DCA DERCNT / CLEAR THE RECORD COUNT DEWTIL, ISZ DERCNT / CDFBUF TAD I DEBFT / GET FIRST RECRD TO BE DELETED CDFMYF / SNA / ++++ JMP DEDON3 / IF ZERO DONE CIA / ++++ TAD DERCNT / SEE IF THE RECORD IS TO BE DELETED SZA CLA / ++++ JMP DEWTL2 / JMS DELCUR / DELETE RECORD DEADR3 JMP DERRO1 / ISZ DEBFT JMP DEWTIL DEWTL2, JMS DECOPY / COPY THE RECORD DONT DELETE DEADR3 JMP DEDON2 / JMP DEWTIL DEDON3, JMS DECOPY / DONE NOW SCROLL THROUGH THE REMAINING OF THE DEADR3 / INDEX JMP DEDON2 / JMP DEDON3 DEDON2, CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XDSKCL / CLOSE INDEX JMP DEDON1 / CONTINUE ON THE NEXT PAGE. DEBFT, 0 DERCNT, 0 / / ROUTINE TO CHECK HDR BLOCK=0(ILLEGAL) / MAYBE CHANGED DOC DISKETTE AFTER INDEX, OR COPY / AND USED DEFAULT CONDITION TO DELETE NON-EXISTENT DOC. / DEINDX, 0 /A020 TAD (4000+RXEDN) /GET DENSITY(OPEN) /A020 JMS DESETQ /SET Q BLOCK AND DO IT /A020 SPA CLA /ERROR RET? /A020 JMP DELRUT /YES /A020 TAD (RXEGF) /SET THE FNC FOR GET FIRST /A020 DCA QUQBLK+RXQFNC /SET IT /A020 JMS QURX /DO IT /A020 CLA TAD QUQBLK+RXQBLK /GET BLOCK NO /A020 SZA CLA /IS BOOT BLK(ERR) /A020 JMP I DEINDX /NO PROCESS /A020 JMP DELRUT /YES IS ERROR /A020 / /SET IO PARAMETERS----- / SUBROUTINE TO SAVE SPACE /A020 / MOVED VER 020--- / ENTERS WITH FUNCTION CODE IN AC /A020 DESETQ, 0 /A020 DCA QUQBLK+RXQFNC TAD DELFNO / SET THE DOCUMENT HEADER BLOCK TO READ DCA QUQBLK+RXQFNO TAD (DEBUFR) / SET THE BUFFER ADDRESS DCA QUQBLK+RXQBAD TAD (CDFBUF) / MAKE CDF BUFFER. DCA QUQBLK+RXQBFD DCA QUQBLK+RXQBLK / CLEAR THE BLOCK NUMBER TAD DELDRV / SET THE DRIVE IN THE QUEUE BLOCK DCA QUQBLK+RXQDRV JMS QURX JMP I DESETQ /A020 / / THE STRINGS THAT ARE USED FOR DELIMITERS / DEADR1, "<-200 / ++++ 156 / ++++ ">-200 / ++++ 0 DEADR2, "<-200 / ++++ "#-200 / ++++ ">-200 / ++++ 0 DEADR3, "<-200 / ++++ ">-200 / ++++ 0 IFDEF VT125R < /WE MUST RELOAD THE CRITICAL VALUES ON PAGE ZERO BEFORE WE LEAVE /A031 /....MOVES LOCS 20-76 FIELD 0 TO PRINT FIELD /A031 SETPG0, 0 /RESET PAGE 0 LOCS 20-76 /A031 TAD (20-T1) / INITIALIZE 10020-10076 /A031 DCA T1 / UP TO BUT NOT INCLUDING T1! /A031 TAD (20-1 / ELSE THIS LITTLE SECTION BLOWS AWAY! /A031 DCA X0 /A031 TAD (20-1 /A031 DCA X1 /A031 WAKEU1, CDFSYS /A031 TAD I X0 /A031 CDFPRT /A031 DCA I X1 /A031 ISZ T1 /A031 JMP WAKEU1 /A031 CDFMYF /A031 TAD (CIFPRT /RESET CALL TO FLABUZ NOW THAT PRTFLD IN/A034 JMS SETFLA /SET IT /A034 JMP I SETPG0 /RET /A031 > /END IFDEF VT125R /A031 /-------------------- PAGE / / NOW THE DOCUMENT WILL BE ACTUALLY DELETED / DEDON1, CLA TAD DELFND / OPEN THE DOCUMENT FOR OVERWRITE MQL AC7777 CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XDSKIN / CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XDSKCL / CLOSE IT / CLA TAD (RXEGF) / SET THE FUNCTION FOR GET FIRST JMS DESETQ /SET UP Q BLK /A020 / CLA TAD QUQBLK+RXQBLK / SAVE THE BLOCK NUMBER THAT THE HEADER DCA DEHDBK / IS IN TAD DEHDBK / READ THE HEADER BLOCK INTO OUR BUFFER./A015 SNA / SKIP IF THERE IS ONE. /A015 JMP DENOHD / JMP IF NO HEADER BLOCK. /A015 DCA QUQBLK+RXQBLK / SET BLOCK TO READ. /A015 TAD (RXERD) / SET FUNCTION CODE TO READ. /A015 DCA QUQBLK+RXQFNC / ... /A015 JMS QURX / GO GET IT. /A015 / /A015 AC0001 / SEE IF "VALID GOTO PAGE STRUCTURE" BIT/A017 AND DEBUFR+1 / IS SET. IF NOT THEN IGNORE GTP PNTR. /A017 SZA CLA / SKIP IF NOT SET. IGNORE PTR. /A017 TAD DEBUFR+53 / GET RAPID-PAGINATION HEADER BLOCK #. /A015 DCA DERHBK / SAVE RPG HEADER BLK # /A015 AC7776 / 2 HEADERS TO DE-ALLOCATE. /A016 DCA T1 / ... /A016 TAD (DEHDBK-1) / GET HEADER LIST POINTER. /A016 DCA X0 / ... /A016 / /A015 DECON1, TAD (DEXTNL-1) / SAVE HEADER EXTENSION LIST PTR. /A016 DCA X1 / ... /A016 TAD I X0 / GET HEADER POINTER. /A016 DCA QUQBLK+RXQBLK / SAVE IN QUEUE BLOCK. /A016 TAD QUQBLK+RXQBLK / GET HEADER BLOCK PTR. /A016 SNA / SKIP IF THERE IS ONE (MORE) TO PROCESS/A016 JMP DENOHD / JMP WHEN DONE. /A016 DCA I X1 / SAVE IN HEADER XTN LIST. /A016 TAD (RXERD) / SET FUNCTION TO "READ". /A016 DCA QUQBLK+RXQFNC / ... /A016 JMS QURX / GO DO IT. /A016 CLA / GET EXTN PTRS 1 & 2 FROM FILE HDR. /A016 TAD DEBUFR+2 / (GET EXT #1) /A016 DCA I X1 / SAVE IT. /A016 TAD DEBUFR+3 / (GET EXT #2) /A016 DCA QUQBLK+RXQBLK / SET UP TO READ IT TO. /A016 TAD QUQBLK+RXQBLK / SAVE IT IN THE HDR LIST TOO. /A016 SNA / SKIP IF THERE IS AN EXTENSION LIST /A016 JMP DEDNLS / JMP IF DONE LIST. /A016 DCA I X1 / SAVE PTR IN LIST. /A016 JMS QURX / READ 2ND XTN BLOCK. /A016 CLA / /A016 TAD (DEBUFR+361) / SET PTR TO XTN LIST. /A016 DCA X2 / ... /A016 TAD (-16) / PICK UP 14. POINTERS. /A016 DCA T2 / SET UP FOR ISZ LOOP. /A016 DEXTL1, TAD I X2 / TRANSFER FROM HDR XTN LIST TO /A016 SNA / (SKIP IF NOT DONE. /A016 JMP DEDNLS / JMP TO SET STOPPER). /A016 DCA I X1 / OUR XTN LIST. /A016 ISZ T2 / LOOP ON THE # OF PTRS IN THE XTN LIST./A016 JMP DEXTL1 / JMP IF MORE TO DO. /A016 DEDNLS, DCA I X1 / SET STOPPER. /A016 TAD (DEXTNL-1) / GET HEADER BLOCK LIST POINTER. /A016 DCA X1 / RESET LIST POINTER. /A016 JMS DECLBF / CLEAR THE BLOCK BUFFER. /A016 DECON2, CLA / /A016 TAD I X1 / GET NEXT BLOCK IN HEADER LIST. /A016 SNA / SKIP IF THERE IS ONE. /A016 JMP DECON1 / JMP IF ALL DONE DEALLOCATING THIS HDR./A016 DCA QUQBLK+RXQBLK / SET BLOCK TO INIT & DE-ALLOCATE. /A016 TAD (RXEWT) / 1ST INIT THE BLOCK. /A016 DCA QUQBLK+RXQFNC / SET WRITE OUT ZEROED BLOCK. /A016 JMS QURX / ... /A016 CLA / NOW TO DE-ALLOCATE THE BLOCK. /A016 TAD (RXEFR) / ... /A016 DCA QUQBLK+RXQFNC / .... /A016 JMS QURX / FREE IT UP. /A016 JMP DECON2 / GO DO NEXT HDR BLOCK. /A016 / /A016 / /A015 DENOHD, TAD (RXESF) / GET RID OF THE HEADER DCA QUQBLK+RXQFNC / TAD DELFNO / SET THE FILE DCA QUQBLK+RXQFNO / DCA QUQBLK+RXQBLK / BLOCK HAS TO BE SET TO ZERO JMS QURX / / CLA JMP DELRUT / GO BACK TO CALLER /-------------------- PAGE / / THE ERROR HANDLING / TVALUE IN MNTMP2 HAS THE TYPE OF ERROR / AND IN MNTMP1 IS THE RETURN VALUE FROM THE MENU / DERRO1, CLA CDFBUF / IF INDEX IS BAD THEN DONT TOUCH IT DCA I (DERCAY) CDFMYF JMP DERR1B DERRO3, ISZ DELERT DERRO2, ISZ DELERT DERR1B, ISZ DELERT JMP DEDONR / DEDONE, CLA DCA DERULE DCA DEPRNT DCA DELERT DEDONR, CLA TAD DELERT / CDFMNU DCA I (MUBUF+MNTMP2) CDFMYF / CIFMNU JMS I MNUCAL DLMDL2 / CDFMNU TAD I (MUBUF+MNTMP1) CDFMYF / SNA CLA / ++++ JMP DELRUT JMP DECONT DELERT, 0 / / DERDNM - READ IN A RECORD FROM THE INDEX FILE TO THE BUFFER / DEBUF. / DERDNM, XX CLA TAD (RECLIM) / SET THE RECORD SIZE LIMIT DCA DERCTM TAD (DEBUF-1) / SET THE STARTING ADDRESS DCA X1 DECLFG, TAD I DERDNM / GET THE TERMINATING STRING OF A RECORD DCA DETMP1 DELUP2, CLA CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XRDFNC / GET A CHARACTER SPA / ++++ JMP DERRO3 SNA / ++++ JMP DEOF / REACHED END OF FILE JMS DELFLT / CHECK FOR NOT PRINT THINGS JMP DELUP2 / NG / AND P177 ISZ DERCTM / INCREMENT CHARACTER COUNT SKP / ++++ JMP DERRO1 CIA TAD I DETMP1 / CHECK FOR A DELIMITER SNA / ++++ JMP DEUPDT CIA / ++++ TAD I DETMP1 / GET HTE ORIGINAL BACK / CDFBUF DCA I X1 CDFMYF / JMP DECLFG DEUPDT, CIA / ++++ TAD I DETMP1 / CDFBUF DCA I X1 CDFMYF / ISZ DETMP1 / CHECK THE NEXT CHARACTER IN THE STRING TAD I DETMP1 SZA CLA / ++++ JMP DELUP2 / FOR A ZERO / CDFBUF / END THE STRING READ IN WITH A ZERO DCA I X1 CDFMYF / ISZ DERDNM / SKIP 2 IF OK DEOF, ISZ DERDNM / SKIP 1 IF EOF JMP I DERDNM DERCTM, 0 DETMP1, 0 / / DECOPY - WILL MOVE TO THE NEXT RECORD IN THE INDEX DOCUMENT / COPYING EVERYTHING IN IT / DECOPY, XX DECOP1, CLA TAD I DECOPY / GET THE ADDRESS OF THE STRING THAT WILL DCA DECPTM / TERMINATE THE COPY DECOP2, CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XGETET / GET THE NEXT CHARACTER SPA / ++++ JMP DERRO3 / READ ERROR WITH INDEX SNA / ++++ JMP DECOPN / IF ZERO REACHED EOF DCA DECPCR / SAVE FOR LATER TAD DECPCR CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XPUTST / SAVE THE CHARACTER TAD DECPCR / SEE IF IT MATCHES THE DELIMITER AND P177 CIA / ++++ TAD I DECPTM / COMPARE CHARACTER TO DELIMITER SZA / ++++ JMP DECOP1 ISZ DECPTM / FOUND MATCH INCREMENT THE POINTER CLA TAD I DECPTM / GET THE NEXT CHARCATER OF THE DELIMITER SZA CLA / ++++ JMP DECOP2 / SEE IF ZERO ISZ DECOPY / YES DONE DECOPN, ISZ DECOPY JMP I DECOPY DECPTM, 0 DECPCR, 0 /-------------------- PAGE / / DELCUR - DELETES THE CURRENT RECORD / DELCUR, XX DELCR1, CLA TAD I DELCUR / GET THE ADDRES OF THE STRING TO STOP THE DELETE DCA DELCRT DELCR2, CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XGETET / GET THE NEXT CHARACTER OF THE INDEX SPA / ++++ JMP DERRO3 / READ ERROR WITH THE INDEX SNA / ++++ JMP DELCEN JMS DELFLT / SEE IF THE CHARACTER HAS A SPECIAL MEANING JMP DELCR3 / IF SO COPY IT / CIA / ++++ TAD I DELCRT / IF NOT CHECK FOR DELIMITER SZA CLA / ++++ JMP DELCR1 ISZ DELCRT / IF A DELIMITER CHECK FOR LAST TAD I DELCRT SZA CLA / ++++ JMP DELCR2 TAD (BELL) / INSERT A BELL FOR THE EDITOR CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XPUTST ISZ DELCUR / IF DONE INCREMENT DELCEN, ISZ DELCUR JMP I DELCUR DELCR3, CIFFIO / ++++ /M0009 FILEIO / ++++ /M0009 XPUTST / SAVE THE CHARACTER JMP DELCR2 DELCRT, 0 / / DECKDS - DISPLYS THE NAME PORTION OF THE CURRENT / RECORD TO THE SCREEN / DECKDS, XX DECKL3, CLA /D044 CDFBUF /D044 TAD I X2 /D044 CDFMYF JMS GETNXT / GET NEXT CHARACTER /A044 / SNA / ++++ JMP DECEND / ZERO MEANS EOF AND P177 TAD (-TAB) / CHECK FOR TABS AND CHANGE THEM TO SPACES SNA / ++++ JMP DETAB TAD (TAB-40) / GET RID OF CONTROL CHARS SPA / ++++ /D044 JMP DECKL3 JMP DECKST / GO CHECK FOR START-OF-DEAD /A044 TAD (40) CIA / ++++ TAD DECKDT / SEE IF A < HAS BEEN FOUND SNA / ++++ JMP DELFCR / YES CIA / ++++ TAD DECKDT / NO / DEDSOU, JMS DELDIS / DISPLAY THE CHARACTER / JMP DECKL3 DELFCR, CLA TAD (LF) / TERMINATE THE LINE JMS DELDIS TAD (CR) JMS DELDIS ISZ DECKDS / OK DECEND, JMP I DECKDS DETAB, CLA TAD (BLANK) JMP DEDSOU DECKDT, "<-200 / / GETCHR - GET A CHARACTER / GETCHR, XX CLA TAD I GETCHR DCA T1 ISZ GETCHR TAD I T1 CLL RAR TAD I GETCHR DCA T1 TAD I T1 SNL / ++++ BSW AND P77 ISZ GETCHR JMP I GETCHR / / THIS IS THE QUEUE ROUTINE TO RXHAN. THE REQUEST IS IN QUQBLK / USED BY DELETE AND SYSTEM OPTIONS / QURX, XX CIFSYS / ++++ ENQUE / ++++ QUBLK QURX1, CIFSYS / ++++ JWAIT TAD QUQBLK+RXQCOD SNA / ++++ JMP QURX1 JMP I QURX / QUBLK, DSKQUE / ++++ 0 / ++++ 0 QUQBLK, ZBLOCK 17 LOADMC, 23 / ++++ 200 / ++++ CIF 20 / MAG CARD I LOADCX, 3 / ++++ 200 / ++++ CIF 20 / CX LOADAX, LOADDX, 5 / ++++ 200 / ++++ CIF 10 / AX AND DX /-------------------- PAGE / / DELFLT - WILL CHECK FOR A RULER OR PRONTER CONTROL STRING / IF IT ISTHE CHARACTER WIL BE RETURNED ON A NON-SKIP RETURN / IF IT IS ANYTHING ELSE IT WILL RETURN THE CHARACTER IN THE AC ON / ASLIP RETURN / DELFLT, XX TAD (-DENDP) / CHECK FOR A END OF PRINTER CONTROL CHAR. SNA / ++++ JMP DELEP / CLEAR THE FLAG IF IT IS TAD (DENDP-DENDR) / CHEKC FOR END OF RULER SNA / ++++ JMP DELER / IF SO DELETE THE RULER FLAG MQL TAD DEPRNT / SEE IF THE PRINTER CONTROL FLAG IS SET TAD DERULE / CHECL THE RULER FLAG SZA CLA / ++++ JMP DELRTN MQA TAD (DENDR-DESTRP) / SEE IF IT IS A START OF SNA / ++++ JMP DELFP / PRINTER CONTROL TAD (DESTRP-DESTRR) / CHECK FOR START OF RULER SNA / ++++ JMP DELRP TAD (DESTRR) ISZ DELFLT / OK JMP I DELFLT DELFP, TAD (DESTRP) ISZ DEPRNT / SET PRINTER FLAG JMP I DELFLT DELRP, TAD (DESTRR) ISZ DERULE / SET RULER FLAG JMP I DELFLT DELEP, DCA DEPRNT TAD (DENDP) JMP I DELFLT DELER, DCA DERULE TAD (DENDR) / RETURN VALUE JMP I DELFLT DELRTN, MQA TAD (DENDR) / GET ORIGINAL VALUE JMP I DELFLT DERULE, 0 DEPRNT, 0 / / DECKTK - WILL SEARCH IN THE BUFFER FIELD STARTING WITH THE ADDRESS / IN X2 FOR THE STRING MATCH WHOSE STARTING ADDRESS IS IN THE NEXT LOCATION / AFTER THE CALL TO THIS ROUTINE / DECKTK, XX DECKL1, CLA TAD I DECKTK / GET THE ADDRESS OF THE COMPARE STRING DCA DECKTM DECKL2, CDFBUF TAD I X2 CDFMYF / AND P177 / GET ONLY 7 BITS SNA / ++++ JMP DECKEN / END OF SEARCH STRING CIA / ++++ TAD I DECKTM / COMPARETO DELIMITER STRING SZA CLA / ++++ JMP DECKL1 / IFNOT EQUAL START AGAIN ISZ DECKTM / INCREMENT THE POINTER TAD I DECKTM SZA CLA / ++++ JMP DECKL2 / RETURN IF ZERO ISZ DECKTK / SKIP 2 IF OK DECKEN, ISZ DECKTK / SKIP ONE IF END OF STRING JMP I DECKTK DECKTM, 0 / / DEFNUM - CONVERTS THE ASCII STRING STARTING AT THE ADDRESS / IN THE BUFFER FIELD IN X2 TO BINARY. / DEFNUM, XX CLA DCA DEFNM / CLEAR THE TEMP FOR THE NUMBER DEFNL1, CDFBUF TAD I X2 / GET HTE NEXT CHARACTER CDFMYF / AND P177 TAD (-72) / COMPARE IT TO A NUMBER SMA / ++++ JMP DEFNDN / IF NOT A NUMBER DONE TAD (12) SPA / ++++ JMP DEFNDN DCA DEFNMT / STORE THE VALUE TAD DEFNM / MULTIPLY BY 10 CLL RTL TAD DEFNM CLL RAL TAD DEFNMT DCA DEFNM JMP DEFNL1 DEFNDN, CLA TAD DEFNM SZA / ++++ ISZ DEFNUM / SKIP IF ANYTHING WAS FOUND JMP I DEFNUM DEFNM, 0 DEFNMT, 0 / / THE ROUTINE WILL SEND THE CHARACTER IN THE AC TO THE SCREEN / DELDIS, XX JMP DELDI2 DELDI1, CIF 0 / ++++ JWAIT DELDI2, CIF 0 / ++++ TTYOU JMP DELDI1 CLA JMP I DELDIS / / DECLBF - SETS THE BUFFER AREA DEBUFR TO ZEROS / DECLBF, XX CLA TAD (DEBUFR-1) / SET THE STARTING ADDRESS DCA X3 TAD (DELIMB) / SET THE COUNTER DCA DECLBT DELLBL, CDFBUF DCA I X3 CDFMYF ISZ DECLBT JMP DELLBL JMP I DECLBF DECLBT, 0 /-------------------- PAGE / /The following code is loaded into the start of the comm buffer. This /A021 /code is executed when comm (AX/DX/CX) is finished and returning to /A021 /Main Menu. The buffer pointers (in the sys COMM code) are reset to /A021 /their origonal values. /A021 / / THIS CODE MUST BE SELF CONTAINED AND MUST BE /A021 / ASSEMBLED AT THE START OF A PAGE.... /A021 / C3CODE, XX / The entry point. /A021 CLA / /A021 RDF / Get caller's field, make us x-field /A021 TAD CU3CDI / callable. /A021 DCA COMXXX / Set return CDI. /A021 CIF 60 / Hold interrupts. /A023 COMSYS, CDFSYS / Map sys field. /A021 TAD COMSYS / Reset buffer CDFs /A021 DCA I CU3BF1 / one, /A021 TAD COMSYS / ... /A021 DCA I CU3BF2 / two, /A021 TAD COMSYS / and /A021 DCA I CU3BF3 / three. /A021 TAD CU3BUF / Reset sys buffer pointer. /A021 DCA I CU3IGT / ... /A021 TAD CU3BUF / both of them. /A021 DCA I CU3IPT / ... /A021 DCA I CU3ICT / ZAP input buffer count. /A021 CDFTFL / Finally, Zap buffer size check./A021 /C029 TAD CU3TSZ / (check is done in the TSTFUL routine)/A021 DCA I CU3MAX / ... /A021 TAD M21 / and then reset the XOF point to 16 /A021 DCA I CU3XOF / chars from the end of the buffer. /A021 COMXXX, XX / return CIF CDF TO GO HERE. /A021 JMP I C3CODE / Now we can return to Main Menu. /A021 CU3CDI, CIF CDF 0 / CIF CDF for return. /A021 CU3BF1, CDFBF1 / Address of 1st CDF to patch. /A021 CU3BF2, CDFBF2 / Address of 2nd CDF to patch. /A021 CU3BF3, CDFBF3 / Address of 3rd CDF to patch. /A021 CU3IGT, H2IGET / Address of 1st buffer pointer. /A021 CU3IPT, H2IPUT / Address of 2nd buffer pointer. /A021 CU3BUF, H2IBUF / Address of sys buffer. /A021 CU3ICT, H2ICNT / Address of count word. /A021 CU3TSZ, -H2ISIZ / Max buffer size (for TSTFUL check). /A021 CU3MAX, H2IMAX / Loc of check word (in TSTFUL). /A021 M21, -21 / XOF point is reset to 16 chars from end/A021 CU3XOF, H2XOFP / Address of loc which holds XOF pointer/A021 BUFSTR=4000+.-C3CODE / Define start of Alternate buffer. /A021 BUFEND=7777 /Last location of buffer (ring pointer location). /A022 BUFSIZ=BUFEND-BUFSTR / max number of chars allowed into alternate buf/A022 / / MESSAGES / DEDCNM, IFDEF ENGLSH < TEXT '^P-- &ENTRIES IN THE INDEX DOCUMENT FOR !D.^D --^P' > IFDEF SPANISH < TEXT '^P-- &ANOTACIONES EN EL \MNDICE DE DOCS. PARA !D.^D --^P' > IFDEF DUTCH < TEXT '^P-- &NAAM OF NAMEN VAN DOCUMENT !D.^D IN DE INDEX --^P' > IFDEF ITALIAN < TEXT "^P-- &NOME DOCUMENTO CORRISPONDENTE ALL'INDICE !D.^D --^P" > IFDEF V30NOR < TEXT '^P-- OPPLYSNINGER OM !D.^D I DOK.-FORTEGNELSEN --^P' > IFDEF V30SWE < TEXT '^P-- &INF\VRD TEXT I INNEH\ELLSDOKUMENTET TILL !D.^D --^P' > / DELNMS, IFDEF ENGLSH < TEXT '^P!E ^P-- &BEGINNING OF THE DOCUMENT TO BE DELETED --^P' > IFDEF SPANISH < TEXT '^P!E ^P-- &COMIENZO DEL DOC. QUE SE HA DE BORRAR --^P' > IFDEF DUTCH < TEXT '^P!E ^P-- &BEGIN VAN TE WISSEN DOCUMENT --^P' > IFDEF ITALIAN < TEXT "^P!E ^P-- &INIZIO DEL DOCUMENTO DA CANCELLARE --^P" > /a041 IFDEF V30NOR < TEXT '^P!E ^P-- &BEGYNNELSEN AV DOKUMENTET SOM SKAL FJERNES --^P' > IFDEF V30SWE < TEXT '^P!E ^P-- &B\VRJAN AV DOKUMENTET SKA RADERAS --^P' > / CU3OVL, XX / SETS UP OVERLAY CHAIN INFO TAD I T1 / Get pointer to load info. DCA X1 / SAVE IN INDEX REG. AC7775 / ++++ DCA T1 / SET TO COPY THREE WORDS TAD (MUBUF+MNONUM-1)/ ++++ DCA X0 / TO MENU AREA / CUPSO1, TAD I X1 / GET NEXT WORD TO LOAD. CDFMNU / CHANGE TO MENU FIELD DCA I X0 / STORE NEXT WORD IN MENU AREA CDFMYF / CHANGE BACK TO MY FIELD / ISZ T1 / ++++ JMP CUPSO1 / LOOP FOR ALL WORDS JMP I CU3OVL / THEN RETURN TO CALLER CU3COE, CDFMNU DCA I (MUBUF+MNTMP1) / CLEAR VALUE FOR CORRECT MESSAGE CDFMYF CIFMNU JMS I MNUCAL DLMAD7 JMP CU3CMX / Then return to caller. CU3TBL, LOADAX-1 / 1 = AX /A023 LOADDX-1 / 2 = DX /A023 XX / 3 = printer. /A023 LOADCX-1 / 4 = CX /A023 LOADMC-1 / 5 = MAG-CARD /A023 LOADLO-1 / 6 = LOGIN processor. /A023 LOADPH-1 / 7 = PHONE utility /A028 /-------------------- PAGE / CU3COM - CALLS THE CORRECT OVERLAY FOR THE COMMUNICATIONS PACKAGE CALLED / IT FIRST SETS THE LINE SETTINGS BEFORE THE OVERLAY IS BROUGHT IN. / THIS ROUTINE ONLY SETS THE OPTIONS THAT CAN BE SET BY MORE THAN ONE / USER AS IN THE 102 WHICH EVER USER IS USING THE COMMUNICATIONS THE / LINE HAS TO BE CHANGED TO THEIR SPECIFICATION. IF THE CHANGES CAN / BE DONE AT THE TIME OF CHANGE LINE THOSE SPECIFIC TO THE 78 THEY ARE / DONE IN CU3OPT. / / CU3COM, XX CLA CDFSYS / SEE IF COMMUNICATIONS LINE IS IN USE. TAD I (CMADSX) CDFMYF SZA CLA / ++++ JMP CU3COE / IF NOT ZERO POST ERROR CDFMNU / LINE FREE SO TAKE IT TAD I (MUBUF+MNTMP1) / 0= CX;1 = AX;2 = DX SZA / ++++ JMP CU3CO1 AC0004 / IF 0 THEN CX BUT COULD BE STANDARD OR MAGCRD TAD I (MUBUF+MNCMTP) / 0= STANDARD;1 = MAG CARD I CU3CO1, CDFSYS / ++++ DCA I (CMADSX) / ++++ IFNDEF CONDOR < / ------------------------------------------------- /a0018 / now set the comm line to the users defined values CDFMYF /NOT SURE IF NECESSARY FOR IFNDEF CONDOR/M037 CIFSYS / /M0011 H2INIT /INIT APPROPRIATE HOST APPROPRIATELY. /M0011 / end ifndef condor ------------------------------------------------- /a0018 > CDFMNU TAD I (MUBUF+MNPRTB) / GET TM MODE FOR CX. RTL / MOVE TM MODE TO BITS 0,1 /M014 /D035 RAL / ... /M014 /D035 AND (3) / ISOLATE IT. /M014 RTL / TM IS NOW 3 BITS /A035 AND (7) / /A035 DCA I (MUBUF+CXTMOD) / IN THE MENU AREA. / ----------------------------------------------------------------------/A021 IFDEF VT125R < /TEST FOR (CMADSX=4 OR 6 AND TM =125 /A024 /TO BYPASS SETTING UP XPANDED BUFFER /A024 / /MOVED HERE VERSION 37......... / AC7775 /GET -3 /A024 TAD I (MUBUF+CXTMOD) /GET TERMINAL MODE /A024 SZA CLA /SKIP IF VT125 MODE /A024 JMP SETBUF /LOAD FLD 6 IF NOT VT125(IS FOR GRAFIX /A024 CDFSYS /A024 TAD I (CMADSX) /SEE IF CD DX ETC. /A024 TAD (-4 /CHECK FOR CX /A024 SNA /SKIP IF NOT CX /A024 JMP GINTST /FOR CX TEST IF GRFX IN CPMEM YET /A024 TAD (-2 /CHECK IF LOGON PROCESS /A024 SPA CLA /SKIP IF LOGON OR AD(PHONE) /C039 JMP SETBUF /RESUME IN LINE CODE /A024 DCA I (CMADSX) /CLEAR COMM SW /A037 AC0006 /MESSAGE NUMBER /A037 JMP CU3COE /BYPASS FOR LOGON /C037 > /END IFDEF VT125R /A024 SETBUF, TAD (BUFSTR) / Set up new larger COMM buffer /M024 DCA T1 / The new buffer resides in field 5 during CU3LP, CDF 60 / AX, DX, and CX. CU3SU1, DCA I T1 / Init buffer values to 0 ISZ T1 / The buffer is the balance of the field. JMP CU3SU1 / Loop to zap balance of the buffer. TAD (BUFSTR) / Set ring pointer at end of buffer DCA I (BUFEND) / to point to start of buffer. / TAD (COMXIT-1) / get start of buffer pointer. DCA X0 / set up to load from real buffer. TAD (C3CODE-1) / Copy exit code to start of buffer area. DCA X1 / ... TAD (4000-BUFSTR) / Get negative # of words to copy. DCA T1 / ... CU3SU2, CDFMYF / Map our field. TAD I X1 / Get word of exit routine. CDF 60 / Map buffer field. DCA I X0 / Stuff buffer. ISZ T1 / Loop on buffer size. JMP CU3SU2 / ... IOF / disable interrupts for a short while. CDFSYS / Map sys field (real buffer field). TAD I (H2ICNT) / get count of characters in current buffer. SNA / Skip if there is something to do. JMP CU3NTM / Jmp if nothing to move. CIA / compute negative of amount to move. DCA T1 / save ISZy count. TAD I (H2IGET) / get input character pointer. CU3WRP, DCA T2 / (re)init our input char pointer. CU3MVL, TAD I T2 / Get character from real ring buffer. SPA / Skip if not ring pointer. JMP CU3WRP / Jmp to wrap buffer pointer. CDF 60 / Map new buffer field. DCA I X0 / Move character to it's new buffer. ISZ T2 / Bump input pointer. CDFSYS / Back to sys field. ISZ T1 / Loop on input buffer size. JMP CU3MVL / ... CU3NTM, TAD (BUFSTR) / Get start of buffer pointer. DCA I (H2IGET) / Set 'rupt handler pointer. TAD CU3LP / Now Patch the CDF's to the buffer field. DCA I (CDFBF1) / one, TAD CU3LP / ... DCA I (CDFBF2) / two, TAD CU3LP / and DCA I (CDFBF3) / three. ISZ X0 / Get pointer to next available posn. TAD X0 / Get next avail pointer. DCA I (H2IPUT) / Set 'rupt handler for that one too. CDFTFL / Finally, inform TSTFUL routine of new size. /C029 TAD (-BUFSIZ) / ... DCA I (H2IMAX) / ... TAD (-2001) / and lastly, reset the XOF point to be DCA I (H2XOFP) / about half way into buffer. ION / Finally, we can re-enable 'rupts. / ----------------------------------------------------------------------/A021 CU3BYP, CDFMYF / WITHOUT ISZ WILL RETURN TO MAINMENU /M024 ISZ CU3COX / SET RETURN FOR CHAIN TO COMMUNICATIONS OVERLAY / -------------------------------------------------------------------------- CDFSYS / See who we reserved COMM line for... /A023 TAD I (CMADSX) / ... /A023 CDFMYF / Back to our field. /A023 TAD (CU3TBL-1) / Compute index into LOAD TABLE. /A023 DCA T1 / save pointer. /A023 JMS CU3OVL / Load OVRLAY info. /A023 CU3CMX, JMP I CU3COM /-------------------- PAGE IFDEF VT125R < /FOR VT125 /A024 /CONTROL PANEL REQUEST DEFINITIONS /A024 SKPGRB=6150 /SKIP IF GRAPHICS BOARD PRESENT(DMIII) /A038 PRQ3=6236 /A024 CP2MM=5000 /PANEL REQUEST OP CODES /A024 MM2CP=4000 /FOR BLOCK MEM TRANSFERS /A024 RCPFLD=7 /PANEL FLD FOR STORING REGIS /A024 PCPFLD=6 /PANEL FLD FOR STORING PRIM /A024 ACPFLD=5 /ALFA BITS CTRL PANEL FIELD /A024 REGFLD=6211 /REGIS FIELD /C032 PRMFLD=6251 /PRIM FIELD /C032 PRGFLD=6261 /PRIM-REGIS COMBINATION FIELD=6 /C032 /HERE IF LOADING CX IN VT125 MODE /A024 GINTST, /C038 CDFMNU /A038 AC2000 /2000 BIT = DMIII /A038 AND I (MUBUF+MNOPTN) /A038 CDFMYF /A038 SNA CLA /= DMIII? /A038 JMP GINSTU /NOT A DMIII /A038 SKPGRB /SKIP IF GRAPHICS BOARD PRESENT /A038 JMP NOBORD /NOT PRESENT /A038 CLA /IS PRESENT-SKPGRB READ STATUS /A038 JMP PRTFLD /CONTINUE /A038 GINSTU, /A038 /D038 CDFMYF /NEED TO MIND OUR OWN BUSINESS /A024 CLA OSR /WILL RETURN AC10 =0 IF GRFX HRDWR IN /A024 AND (2) /AC10= 1 IF GRFX HRDWR NOT INSTALLED /A024 SZA CLA /SKIP TO CONTINUE TEST FOR SOFTWARE IN /A024 JMP NOBORD /GRFX BOARD IS NOT PRESENT GO TO GOLD M /A024 PRTFLD, CDFPRT /PRINTER FIELD /A029 TAD I (PRSTTS) /PRINTER STATUS WORD /A029 CDFMYF /A029 SZA CLA /PRINTER IN USE /A029 JMP NOPRT /PRINTER IN USE ILEGAL IN VT125 MODE /A029 JMS CLEARQ /TEMP PATCH LOC /A029 /D037 JMP GRREAD /NO LOAD GRAPHICS /A029 /D029 TAD (PRBOTM /TEMP PATCH LOC /A029 /D029 DCA CLRPTR /TEMP PATCH LOC /A029 /D029 TAD (-2000 /TEMP PATCH LOC /A029 /D029 DCA CLRCNT /TEMP PATCH LOC /A029 /D029PRTFLD, CDFPRT /TEMP PATCH LOC /A029 /D029 DCA I CLRPTR /TEMP PATCH LOC /A029 /D029 ISZ CLRPTR /TEMP SET TO NEXT /A029 /D029 /D029 ISZ CLRCNT /TEMP PATCH LOC /A029 /D029 JMP PRTFLD+1 /TEMP PATCH LOC /A029 /D029 CDFMYF /TEMP PATCH LOC /A029 /D029 NOP /TEMP PATCH LOC /A029 /D029 NOP /TEMP PATCH LOC /A029 /D029CLRPTR, 0 /TEMP POINTER LOC /A029 /D029CLRCNT, -1000 /TEMP POINTER LOC /A029 /D029 PRQ3 /USE PANEL REQUESTS TO SEE IF GRFX IN /A024 /D029 CP2MM+40+RCPFLD /XFER TO MYFLD (4) FROM REGIS CP FLD /A024 /D029 0200 /SOURCE ADR (IN CP MEM) /A024 /D029 DEBUFR /DESTINATION ADR (IN MM) /A024 /D029 -10 /8 WORDS IS MORE THAN ENOUGH FOR POS ID /A024 /D029 7777 /TERMINATOR /A024 /D029 TAD (-3057) /IS OCT CODE AT 0200 OF REGIS /A024 /D029 TAD DEBUFR /IS LOC 0200 OF CP REGIS /A024 /D029 SZA CLA /NOT LOADED YET IF UNEQUAL /A024 /D029 JMP GRREAD /BETTER READ AND LOAD ALL 3 IF 1 NOT OK /A024 /D029 TAD (1564) /IS A NEG RDF INSTRUCTION /A024 /D029 TAD DEBUFR+2 /CORRESPONDING LOC IN READ BUFFER /A024 /D029 SZA CLA /NOT LOADED YET IF UNEQUAL /A024 /D029 JMP GRREAD /BETTER READ AND LOAD ALL 3 IF 1 NOT OK /A024 /D029 PRQ3 /PANEL REQUEST /A024 /D029 CP2MM+40+PCPFLD /TO MY FLD (4) FROM PRIM CPFLD /A024 /D029 0200 /SOURCE ADR (IN CP MEM) /A024 /D029 DEBUFR /MAY AS WELL USE THIS BUFFER /A024 /D029 -10 /NEG WORD COUNT /A024 /D029 7777 /TERMINATOR /A024 /D029 CLA CLL /NEVER TRUST A COMPUTER YOU CAN'T SEE /A024 /D029 TAD (-3066) /NEG VALUE OF INSTR. AT 201 OF PRIM CODE/A024 /D029 TAD DEBUFR+1 /CORRESPONDING LOC IN BUFFER /A024 /D029 SZA CLA /NOT LOADED YET IF UNEQUAL /A024 /D029 JMP GRREAD /BETTER READ AND LOAD ALL 3 IF 1 NOT OK /A024 /D029 TAD (-1233) /3RD INSTR OF PRIM /A024 /D029 TAD DEBUFR+3 /CORRESPONDING LOC IN BUFFER /A024 /D029 SZA CLA /NOT LOADED YET IF UNEQUAL /A024 /D029 JMP GRREAD /BETTER READ AND LOAD ALL 3 IF 1 NOT OK /A024 /D029 PRQ3 /PANEL REQUEST /A024 /D029 CP2MM+40+ACPFLD /TO MY FLD FROM ALFA BITS FLD OF CPMEM /A024 /D029 0200 /MAY AS WELL BE CONSISTENT /A024 /D029 DEBUFR /IF I CANT BE LOGICAL /A024 /D029 -10 /MINUS # OF WORDS TO MOVE /A024 /D029 7777 /TERMINATOR /A024 /D029 CLA CLL /WHO KNOWS /A024 /D029 TAD (-104) /NEG VALUE OF CHAR EXPECTED HERE /A026 /D029 TAD DEBUFR+1 /CORRESPONDING LOC IN BUFFER /A024 /D029 SZA CLA /NOT LOADED YET IF UNEQUAL /A024 /D029 JMP GRREAD /BETTER READ AND LOAD ALL 3 IF 1 NOT OK /A024 /D029 TAD (-202) /NEG VALUE OF CHAR EXPECTED HERE /A026 /D029 TAD DEBUFR+3 /CORRESPONDING LOC IN BUFFER /A024 /D029 SNA CLA /IF THIS = THEN PANEL MEM IS ALREADY IN /A024 /D029 JMP CU3BYP /RETURN TO MAINLINE CODE /A024 /HERE TO LOAD GRAPHICS CODE AND CONSTANTS INTO PANEL MEM FOR /SUSEQUENT LOAD BY CX /A024 GRREAD, CDIMNU /GET READY TO PUT UP ACTIVATION MSG /A024 DCA I (MUBUF+MNTMP2 /AC IS STILL 0 /A024 CDFMYF /NEED TO CALL FROM OWN FLD /A024 JMS I MNUCAL /GO PUT UP MSG TO ASK FOR DRIVE # /A024 DLM125 /A024 GOTNUM, CDFMNU /NEED TO GET DRIVE # ENTERED /A024 TAD I (MUBUF+MNTMP3) /WHAT IS IT /A024 MYFLD, CDFMYF /BACK HERE /A024 SPA /- IS FROM GOLD MENU /A024 JMP CU3GMX /LEAVE CU3 /A024 DCA QUQBLK+RXQDRV /PLUG IT IN /A024 DCA QUQBLK+RXQRS1 /SET BLOCK COUNT(0=1 BLOCK) /C030 TAD MYFLD /SET UP POINTER TO THIS MEM FIELD(BUFFR)/A024 DCA QUQBLK+RXQBFD /PUT IT IN QBLK /A024 TAD (DEBUFR) /GET POINTER TO BUFFER ADR /a024 DCA QUQBLK+RXQBAD /PUT IT IN QBLK /A024 TAD (4000+RXEDN /GET AND SET DENSITY /A024 DCA QUQBLK+RXQFNC /FUNCTION CODE /A024 JMS QURX /DO IT /A024 SPA CLA /+ AC MEANS NO ERROR /A024 JMP GRREAD /GO DEAL WITH DENSITY ERROR /A024 TAD (RXERD+4000) /GET READY TO READ ALLOCATION BLOCK /A024 DCA QUQBLK+RXQFNC /READ FUNCTION /A024 TAD (2) /GET HEADER BLOCK # /A024 DCA QUQBLK+RXQBLK /SET BLOCK # /A024 JMS QURX /REQUEST THE READ /A024 SPA CLA /+AC MEANS NO ERRORS /A024 JMP GRREAD /ALL I CAN THINK OF IS TO START OVER /A024 /NOW WE'RE GOING TO VERIFY THAT THE CORRECT VOLUME HAS BEEN MOUNTED /A024 TAD DEBUFR+2 /SECOND WORD STARTS ID /A024 TAD VTID1 /START OF ID CONSTANT /A024 SZA CLA /SKIP IF OK /A024 JMP INSERR /OTHERWISE PUT UP ERROR MSG /A024 TAD DEBUFR+4 /CK MORE TO EXCLUDE RANDOM BAD LUCK /A024 TAD VTID3 /3RD WORD OF ID CONSTANT /A024 SZA CLA /SKIP IF OK /M032 JMP INSERR /INSERTED WRONG VOLUME /M032 TAD DEBUFR+11 /WORD 9 MUST BE 1 FOR FEATURE DISKETTE /M032 JMP INLINE /JUST CONTINUES IN LINE ON NEXT PAGE /A024 VTID1, -7061 /NEG CONSTANT FOR WP /M027 VTID3, -6555 /NEG CONSTANT FOR TL /M027 CU3GMX, AC7775 /GET -3 /A029 CDFMNU /A029 TAD I (MUBUF+CXTMOD) /GET TERMINAL MODE /A029 CDFMYF /A029 SZA CLA /SKIP IF VT125 MODE /A029 JMP CU3GMY /IGNNORE RELOAD FOR NON 125 MODE /A029 DCA QUQBLK+RXQDRV /SET BRIVE TO SYSTEM /C030 TAD (DLFD1 /START BLOCK NUMBER /A029 DCA QUQBLK+RXQBLK /A029 TAD (-DSFD1 /BLOCK COUNT /A029 DCA QUQBLK+RXQRS1 /A029 TAD PRTFLD /PRINTER FIELD /A029 DCA QUQBLK+RXQBFD /PUT IT IN QBLK /A029 TAD (PRBOTM /START OF BUFFER /A029 DCA QUQBLK+RXQBAD /PUT IT IN QBLK /A029 TAD (RXERD /NO RETURN MUST REBOOT /A029 DCA QUQBLK+RXQFNC /FUNCTION CODE /A029 JMS QURX /DO IT /A024 SPA CLA /+ AC MEANS NO ERROR /A024 JMP CU3GMX /REPEAT /A029 JMS SETPG0 /RESTORE PAGE 0 FOR PRINTER /A031 TAD (PRJOB /STATUS BLOCK POINTER /A029 CIFSYS /A029 JSTRT /RESTART JOB /A029 CU3GMY, /A024 CDFSYS /SYSTEM FLD /A024 DCA I (CMADSX /MAKE COMM LINE AVAILABLE AGAIN /A024 CDFMYF /BACK HERE BEFORE WE GO ANYWHERE ELSE /a024 JMP CU3CMX /NOW EXIT FROM CU3 /A024 / / MOVED VER---037--- / LOADLO, 30;200;CIF 30 / Load info for LOGON processor. /A023 LOADPH, 30;202;CIF 30 / PHONE utility entry point - WPLOG /A028 /------------------- PAGE INLINE, IAC /WILL BE 0 IF WAS -1 /A024 SZA CLA /SKIP IF OK /A024 JMP INSERR /PROBABLY WAS DOC DISKETTE /A024 TAD (-BLDDY^100-BLDMO) /SYSTEM CONSTANT FOR BUILD DAY & MONTH /A025 TAD DEBUFR+7 /LOOK AT DATE ON FEATURE DISKETTE /A025 SZA CLA /SKIP IF RIGHT DATE /A025 JMP INSERR /REPEAT INSERT MSG FOR ANOTHER CHANCE /A025 TAD (-BLDYR) /SAME DEAL FOR YEAR /A025 TAD DEBUFR+10 /MUST BE RIGHT YEAR ALSO /A025 SZA CLA /SKIP IF MATCH OK /A025 JMP INSERR /PUT UP INSERT MSG AGAIN /A025 CIFMNU /GO TO MENU FLD TO /A024 JMS I IOACAL /PUT UP STANDBY MSG /A024 0 PRGMSG /'INSTALLATION IN PROGRESS etc.' /A024 0100 /POSITION TO ERASE ALL BUT TOP LINE /A024 1520 /LINE AND COL FOR DISP /A024 /NOW WE'RE GOING TO GET READY AND READ THE INSERTED VOLUME /A024 /********** /LOAD ALPHA BITS INTO FIELD 5 PANEL MEM.. /...USE REGIS FIELD 5 MAIN MEM AS TEMP AREA /*********** TAD DESADR /POINTER /A030 DCA QUQBLK+RXQBAD /SET BUFFER ADDRESS /A030 TAD (ACPFLD^10+1+MM2CP /INSTRUCTION TO LOAD FLD(PRNTR) /C030 DCA MM2CPM /PLUG IT IN /A024 TAD (DLPALF /POINTER TO BLOCK NUM /A029 DCA QUQBLK+RXQBLK /SET IT /A029 TAD (-DSPALF /BLOCK COUNT /A029 DCA QUQBLK+RXQRS1 /SET IT /A029 TAD PRTFLD /PRINT FIELD...=FIELD 1(TEMP )/A029 DCA QUQBLK+RXQBFD /SET IT /A029 JMS QURX /READ IT /A029 SPA CLA /ERROR? /A029 JMP GRREAD /YES RETRY IT /A029 TAD (-DSPALF^400 /NUMBER OF BLOCKS TIMES NUM WORDS IN BLK/A029 DCA DESCNT /SET COUNT /A029 JMS SETPAN /SET TO PANEL MEMORY /A029 /******* /LOAD REGIS TO FIELD 1 /A032 /LOAD PRIM TO FIELD 5 /A032 /LOAD REGIS /PRIM PARTIAL FIELDS TO FIELD 6 /A032 / /******** TAD (PRGFLD /REGIS/PRIM COMBO FIELD = FIELD 1 /A032 DCA QUQBLK+RXQBFD /SET IT /A032 TAD (DLPRM1 /DISK BLOCK # OF BEGINING OF GRFX STUFF /A032 DCA QUQBLK+RXQBLK /INTO Q BLOCK /A024 TAD (-DSPRM1-DSRGS1-DSPRM2 /BLOCK COUNT /A033 DCA QUQBLK+RXQRS1 /SET IT /A032 DCA QUQBLK+RXQBAD /BUFFER ADDRESS /A032 JMS QURX /READ IT /A032 SPA CLA /ERROR? /A032 JMP GRREAD /YES RETRY IT /A032 /******** /LOAD REGIS CODE /******** TAD (REGFLD /REGIS FIELD = FIELD 5 /A029 DCA QUQBLK+RXQBFD /SET IT /A029 TAD (DLORGS /DISK BLOCK # OF BEGINING OF GRFX STUFF /C029 DCA QUQBLK+RXQBLK /INTO Q BLOCK /A024 TAD (-DSORGS /BLOCK COUNT /A029 DCA QUQBLK+RXQRS1 /SET IT /A029 DCA QUQBLK+RXQBAD /BUFFER ADDRESS /A029 JMS QURX /READ IT /A029 SPA CLA /ERROR? /A029 JMP GRREAD /YES RETRY IT /A029 /******* /LOAD PRIM CODE INTO FIELD 6 MAIN MEMORY /******** TAD (DLOPRM /POINTER TO BLOCK NUM /A029 DCA QUQBLK+RXQBLK /SET IT /A029 TAD (-DSOPRM /BLOCK COUNT /A029 DCA QUQBLK+RXQRS1 /SET IT /A029 DCA QUQBLK+RXQBAD /BUFFER ADDRESS /A029 TAD (PRMFLD /PRIM FIELD...=FIELD 6 /A029 DCA QUQBLK+RXQBFD /SET IT /A029 JMS QURX /READ IT /A029 SPA CLA /ERROR? /A029 JMP GRREAD /YES RETRY IT /A029 RSKIP2, TAD QUQBLK+RXQDRV /RETRIEVE DRIVE # /A024 SZA CLA /SKIP IF JUST READ FROM DRIVE 0 /A024 JMP CU3BYP /BYPASS THE COMM BUFFER MOVE TO FLD 6 /A024 PROMPT, CIFMNU /PROMPT TO REPLACE SYSTEM DISK /A024 JMS I IOACAL /CANT USE MENU BLOCK CAUSE SYSTEM ON 0 /A024 0 SYDISK /ADR OF MSG TO REPLACE SYS IN 0 /A024 0100 /POSITION TO ERASE ALL BUT TOP LINE /A024 1105 /POSITION & LET USER KNOW WE'RE DONE /C040 1305 /POSITION FOR 2ND LINE OF PROMPT /A024 JMP SYPAP2 /MERGE BELOW /A024 SYPAP1, CIFSYS /SYS IS STILL RESIDENT /A024 JWAIT /WAIT A WHILE /A024 SYPAP2, CIFSYS /BAK TO SYS AGAIN /A024 XLTIN /GET AN INPUT CHAR /A024 JMP SYPAP1 /LOOP AND WAIT IF NONE /A024 TAD (-EDNWLN) /RETURN TYPED? /A024 SZA CLA /SKIP IF YES. /A024 JMP PROMPT /NO. BETTER TELL USER AGAIN /A024 JMP CU3BYP /CONTINUE LOADING CX /A024 INSERR, AC0001 /FLAG FOR INSERTION ERROR /A024 INSER2, CDIMNU /A024 DCA I (MUBUF+MNTMP2 /MAKE AVAIL TO MENU CODE /A024 CDFMYF /MENU NEEDS TO KNOW WHICH FLD CALLED /A024 JMS I MNUCAL /GO PUT UP MSG /A024 DLM125 /NAME OF MENU BLOCK WE'RE USING /A024 JMP GOTNUM /IF WE COME BACK HERE WE HAVE A NEW # /A024 SETPAN, 0 /SET PANEL MEM FROM MAIN /A029 PRQ3 /PANEL REQUEST #3 /A024 MM2CPM, ACPFLD^10+1+MM2CP /54 IS TO CPMEM FLD 5 FROM MM FLD 4 /C029 DESADR, /M030 0 /SOURCE ADDRESS /C029 0 /DESTINATION ADRESS IN CP MEM /C030 DESCNT, -400^DSPALF /WORD COUNT FOR MOVE /A024 7777 /TERMINATOR /A024 JMP I SETPAN /A029 /---------------------- PAGE / / SET TO MODIFY NOP TO SKIP FLABUZ CALL IN WP2CMF /A034 / /THIS ROUTINE EXECUTES TWO FUNCTIONS /A029 /THE FIRST FUNCTION CALLS THE PRINTER JOB TO PRINT A FF /A029 /THIS IS A TEMP FUNCTION USED TO EMULATE A FUNCTION NOW BEING DEVELOPED /A029 /THE REAL FUNCTION WILL BE A CALL TO THE PRINTER TO KILL ITSELF /A029 /BY CHANGING THE CODE PUT INTO PRTACT FROM A 1(FF) TO A -1(KILL SELF) /A029 /....AND DELETING THE TEMP CODE WHICH KILLS THE PRINTER JOB, THE /A029 /.....REAL CALL CAN BE TESTED.... /A029 / /BY PUTTING BOTH FUNCTIONS INTO CODE THIS WAY THE NEW GRAPHICS LOAD /A029 /...INTO THE PRINTER FIELD CAN BE TESTED WITHOUT WAITING UNTIL /A029 /...BOTH THE NEW REGIS GRAPHICS AND KILLING SELF FUNCTION CAN BE TESTED /A029 / /THIS FUNCTION WILL ACTUALLY CALL THE PRINTER JOB TO KILL ITSELF WHEN /A029 /...WHEN IN VT125 MODE.... /A029 / CLEARQ, 0 /A029 AC7777 /SET CODE TO -1=PRINTER KILL SELF /A029 /....CODE TO BE SET TO -1 FOR KILL SELF /A029 /........WHEN READY /A029 CDFPRT /SET TO PRINTER FIELD /A029 DCA I PRACTP /SET CODE /A029 CDFMYF /A029 CLEAR1, CIFSYS /NOT DONE.. SET TO SWAP OUT /A029 JSWAP /DO IT /A029 CDFPRT /PRINTER FIELD /A029 TAD I PRACTP /GET CODE /A029 CDFMYF /A029 SZA CLA /IS PRINTER DONE? /A029 JMP CLEAR1 /NO. REPEAT /A029 CLEAR4, TAD FLASKP /CX GRAPHICS BYPASS CALL FLABUZ IN WP2CMF/C034 JMS SETFLA /SET IT /A034 JMP I CLEARQ /RET /A029 FLASKP, SKP /SKIP OVER FLASH BUZ CALL /A034 PRACTP, PRACTN /POINTER TO PRINTER ACTION WORD /A029 /...SIMULATE CLOBBERING OF PREINTER FIELD/A029 /...WITH NEW REGIS CODE. /A029 /THE FOLLOWING CODE IS TEMP CODE USED TO ACTUALLY KILL PRINTER JOB /A029 /...WHEN THE FUNCTIONALITY IS PUT INTO THE PRINTER IT CAN BE DELETED /A029 /...AND THE CODE 1 CHANGED TO -1 TO EXECUTE IT(SEE CLEARQ+1) /A029 / /D029 TAD TPTR1 /LOAD POINTER TO PRJOB /A029 /D029 CDFSYS /SYS FIELD IS WHERE JOB STATUS BLOCKS LIVE/A029 /D029CLEAR6, DCA TPTR2 /SAVE IT /A029 /D029 TAD I TPTR2 /GET POINTER TO NEXT BLOCK /A029 /D029 CIA /NEGATE /A029 /D029 TAD TPTR1 /DOES IT POINT TO PRJOB /A029 /D029 SNA CLA /A029 /D029 JMP CLEAR8 /YES WE FOUND IT /A029 /D029 TAD I TPTR2 /GET PTR TO NEXT /A029 /D029 JMP CLEAR6 /REPEAT NEXT /A029 /D029CLEAR8, TAD I TPTR1 /GET POINTER IN PRJOB STATUS BLOCK /A029 /D029 DCA I TPTR2 /SET IT IN BLOCK POINTING TO PRJOB /A029 /D029 DCA I TPTR1 /CLR PNTR IN STAT BLK. (MUST FOR JSTRT) /A029 /D029 CDFMYF /A029 /D029 JMP I CLEARQ /RET /A029 SETFLA, 0 /SET/CLEAR FLASH BUZ CALL /A034 CDFMNU /WP2CMF FIELD /A034 DCA I SETLOC /SET IT /A034 CDFMYF /A034 JMP I SETFLA /RETURN /A034 SETLOC, TIMDS3 / /A034 /D029PTR1, PRJOB /TEMP POINTER1 /A029 /D029TPTR2, PRJOB /TEMP POINTER2 /A029 /------------------- NOPRT, TAD NOPPTR /LOAD POINTER TO ERR MESSAGE /A029 SKP /SET IT AND DO IT /A029 NOBORD, TAD NOBPTR /NO BOARD MESSAGE /A029 DCA PRTPTR /SET POINTER /A029 CIFMNU /NEED TO BE IN MENU FLD /A024 JMS I IOACAL /GO TO THE TTY I/O ROUTINE /A024 0 /DON'T WANT TO WRITE OWN I/O /A024 PRTMSG /CONTROL STRING TO USE FOR MESSAGE /A040 0100 /POSITION T0 2ND LINE BEFORE ERASING /A024 1505 /POSITION FOR MESSAGE /A024 PRTPTR, NOBMSG /MESSAGE THAT GRFX HARDWARE ISN'T IN /A024 1705 /PRESS RETURN AFTER READING MESSAGE /A024 RETMSG /MESSAGE PRESS RETURN TO RECALL MENU /A040 CDIMNU /MENU BLOCK IS EASIER TO WAIT IN /A024 AC0002 /FLAG FOR WHICH MENU PATH TO USE /A024 DCA I IMNTMP /PUT FLAG WHERE MENU CAN SEE IT /M026 /A024 CDFMYF /MENU NEEDS TO KNOW WHERE WE CAME FROM /A024 JMS I MNUCAL /GO TO IT /A024 DLM125 /NAME OF MENU BLOCK TO DO /A024 JMP I IU3GMX /TAKE GOLD MENU EXIT /A024 IU3GMX, CU3GMY /DONT WANT A LINK IN MIDDLE OF MSG/A024 /C029 IMNTMP, MUBUF+MNTMP2 /PUT FLAG WHERE MENU CAN SEE IT /A026 NOPPTR, PRTBSY /MESSAGE POINTER'PRINTER BUSY' /A029 NOBPTR, NOBMSG /POINTER 'NO GRAPHICS BOARD' /A029 /------------- SYDISK, IFDEF ENGLISH < TEXT '^P!E^P^CG&REPLACE THE SYSTEM DISKETTE IN DRIVE 0 '> /C040 IFDEF SPANISH < TEXT '^P!E^P^CG&COLOQUE EL DISKETTE SISTEMA EN LA UNI. 0 '> /C040 IFDEF DUTCH < TEXT '^P!E^P^CG&ZET DE SYSTEEMDISKETTE WEER IN AANDRIJVER 0 '> /C040 IFDEF ITALIAN < TEXT "^P!E^P^CG&METTERE DISCO SISTEMA NELL'UNIT\A 0 " > IFDEF V30NOR < TEXT '^P!E^P^CG&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0 '> /A042 IFDEF V30SWE < TEXT '^P!E^P^CG&BYT UT SYSTEMDISKETTEN I ENHET 0'> *.-1 SYDIS2, IFDEF ENGLSH /A024 IFDEF SPANISH /A024 IFDEF DUTCH /A024 IFDEF ITALIAN IFDEF V30NOR /A042 IFDEF V30SWE PRGMSG, IFDEF ENGLSH < TEXT '^P!E^P&INSTALLATION IN PROGRESS -- &PLEASE WAIT...'> /A024 IFDEF SPANISH < TEXT '^P!E^P&INSTALACION EN CURSO -- &ESPERE...'> /A024 IFDEF DUTCH < TEXT '^P!E^P&BEZIG MET INSTELLEREN -- &EVEN GEDULD.'> /A024 IFDEF ITALIAN < TEXT "^P!E^P&INSTALLAZIONE IN CORSO -- &PREGO ATTENDERE..."> IFDEF V30NOR < TEXT '^P!E^P&INSTALLASAJON P\EG\ER -- &VENT'> IFDEF V30SWE < TEXT '^P!E^P&INSTALLATION P\EG\ER - &V\DNTA EN STUND...'> PRTMSG, TEXT '^P!E^P^S^P^S^CG' /PRINT TWO MESSAGES AND RING THE BELL /A040 PRTBSY, IFDEF ENGLSH /C040 IFDEF SPANISH < TEXT '&IMPOSIBLE USAR GR\AFICOS CUANDO SE EST\A IMPRIM.'> IFDEF DUTCH /C040 IFDEF ITALIAN < TEXT "&IMPOSSIBILE UTILIZZARE &GRAFICA DURANTE LA STAMPA"> IFDEF V30NOR /A042 IFDEF V30SWE < TEXT '&DU KAN INTE ANV\DNDA GRAFIKFUNKTIONEN N\DR UTSKRIFT P\EG\ER'> NOBMSG, IFDEF ENGLSH < TEXT '&GRAPHICS HARDWARE MUST BE PRESENT WHEN !&TM=&GRAPHICS'> /C040 IFDEF SPANISH < TEXT '&EL HARDWARE GR\AFICOS HA DE ESTAR PRESENTE CUANDO !&TM=&GR\AFICOS'> /C040 IFDEF DUTCH < TEXT '!&TI=&GRAPHICS VEREIST EEN GRAFISCHE KAART'> /C040 IFDEF ITALIAN < TEXT "&OPZIONE &GRAFICA NON PRESENTE SE !&TT=&GRAFICO"> IFDEF V30NOR < TEXT '&MASKINUTSTYR FOR GRAFIKK M\E V\FRE TILKOBLET N\ER !&TM=&GRAFIKK'> IFDEF V30SWE < TEXT' &GRAFIKKORTET M\ESTE VARA INSTALLERAT N\DR!&TM=&GRAFIK'> RETMSG, IFDEF ENGLSH < TEXT '&PRESS !&RETURN TO RECALL THE &MAIN &MENU'> /C040 IFDEF SPANISH < TEXT '&PULSE !&RET. PARA VOLVER AL &MEN\Z &PRINC.'> /C040 IFDEF DUTCH < TEXT '&DRUK OP !&RETURN OM TERUG TE GAAN NAAR HET &HOOFDMENU'> /C040 IFDEF ITALIAN < TEXT "&PREMERE !&RITORNO PER TORNARE AL &MENU &PRINCIPALE"> > /END IFDEF VT125R /A024 IFDEF V30NOR < TEXT '&TRYKK P\E !&RETUR FOR \E F\E &HOVEDMENYEN'> /A042 IFDEF V30SWE < TEXT '&TILLBAKA TILL HUVUDMENYN: TRYCK P\E RETUR'> DELMSG, TEXT '![(&^S^A![(&^S' / CONTROL STRING FOR GRAPHICS DISPLAY /A040 /A044vvvvvA044vvvvvA044vvvvvA044vvvvvA044vvvvvA044vvvvvA044vvvvvA044 / / DECKST - CHECK FOR START OF DEAD / INT8BT=62 / EIGHT BIT INTRODUCER DECKST, TAD (40-ECSTOV) / IS THIS A START-OF-DEAD CHAR SZA / SKIP IF SO JMP DECKL3 / ELSE IGNORE CONTROL CHARACTER / JMS GETNXT / IF S-O-D CHECK THE NEXT 2 CHARS FOR A / MNC. IGNORING ALL ELSE / TAD (-ECSPC) / CHECK 2ND CHAR SZA / SKIP IF ITS OK JMP DENOTS / ELSE ITS NOT AN 8 BIT CHARACTER / JMS GETNXT / TAD (-INT8BT) / CHECK FOR 8 BIT INTRODUCER SZA / SKIP IF OK JMP DENOTI / ELSE ITS NOT AN 8 BIT CHARACTER / JMS GETNXT / GET THE 8 BIT CHARACTER / TAD (200) / MAKE IT REALY 8 BIT JMP DEDSOU / AND OUTPUT IT / DENOTI, TAD (INT8BT-ECSPC) / REPLACE INTRODUCED VALUE DENOTS, TAD (ECSPC-40) / REPLACE SPACE VALUE SPA / SKIP IF PRINTABLE JMP DECKL3 / ELSE IGNORE TAD (40) JMP DEDSOU / O/P CHARACATER / GETNXT, XX CDFBUF / GET A CHARACTER TAD I X2 CDFMYF AND P177 / AND MASK OFF ATTS JMP I GETNXT /A044^^^^^A044^^^^^A044^^^^^A044^^^^^A044^^^^^A044^^^^^A044^^^^^A044 PAGE /----------------- / WPCU4 - COMMAND UTILITIES VI / / 032 EMcD 12-Sep-85 Add Nordic translations / (conditionalised) / 031 RCME 1-MAY-85 Change DBTDOC to CU4DBT for global / definition and stand-alone assembly / 030 EMcD 12-Mar-85 Save terminal as Lvl2 , 8 bit / 029 TCW 06-SEP-84 Disable Modem if not present / 028 TCW 21-AUG-84 Change Integral Modem response loop / 027 TCW 25-JUL-84 Repos. cursor after disp. of CD name / 026 TCW 16-JUL-84 Expand # of terminal modes / 025 TCW 26-JUN-84 Change Integral Modem response loop / 024 WCE 13-JUN-84 SUPPORT DIFERENT DRIVES FOR ACTIVATE / 023 TCW 01-MAY-84 Integral modem support / 022 WCE 18-JAN-84 Removed BUILD code from unbundling / 021 GDH 4-AUG-83 Conditionalized MNSECN for DM2. / 020 GDH 2-AUG-83 Fixed BC YES/NO reboot problem. / Fixed Date Bits 6/7 DM2 bug. / 019 GDH 8-APR-83 Added TM = EASYLINK to SO options. / 018 MJS 6-JAN-83 added a "PAGE" at "CU4ST" to enable / wpcu4.pa to be assembled for either / DECmate I or DECmate II / / 017 EPS 18-NOV-82 CHANGE REV LEVEL FOR EF/SD FLOPPY / / 016 MJS 13-OCT-82 Added a subroutine called by 'CU4GVL" / to "stuff" into panel memory / field 0 locations 24,25,26 / the "terminal characteristics" / the user selected in "SO" menu / (printer & communication baud rates) / / 015 DFB 06-SEP-82 Fix to set CD to correct doc. / / 014 MJS 10-AUG-82 Added code within "CU4GVL" to init / the comm line (H2INIT) if the "SO" / values change--added "ZBLOCK CXSETZ" / / 013 HLP 17-JUN-82 Added GETDNS in Build activate disk / Conditionalized for DM-II (CONDOR) / / ------------------------------------ / | EDIT HISTORY BELOW FOR DECmate I | / ------------------------------------ / 012 EH 13-JAN-82 Added GETDNS before activating features / 011 GDH 27-OCT-81 SO menu enhancements. don't erase / screen when not necessary. / 010 GDH 16-OCT-81 Added 3rd TM option (DWORD). / 009 GDH 21-Sep-81 Primary/Secondary port support. / 008 DIM 3-SPET-81 Entered French and Dutch translations / 007 GDH 27-Aug-81 Deleted old CIF/CDF subroutines. / 006 TT 07-JUL-81 Removed superfluous conditionals / 005 AJF 01-MAY-81 FIXED SO CD LOSS BUG / 004 DIM 12-MAR-81 Changed message that appears when trying / to activate sort on the WS78 / 003 JM 10-MAR-81 Added CANADIAN text / 003 JM 09-MAR-81 Added DUTCH text / 002 JM 06-MAR-81 Added FRENCH text / 001 WCE 17-N0V-80 ADDED CHANGES FOR FEATURE UNBUNDLING / X3.5 JLZ ??-???-?? Changed VT78 to VT78C / 3.0+ MB 11-AUG-78 FOR THE 3.1 THERE WAS ENOUGH ADDED TO / SUPPORT THE CD OPTION THAT ANOTHER / COMMAND UTILITY HAD TO BE CREATED FOR / TIME 2 FIELDS HAVE TO BE OVERLAYED FOR / THIS TO WORK / WRITES OUT WPCU4 / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOCU4 / ++++ 100 / ++++ CDF 20 / ++++ -DSOCU4 /A001 0 FIELD 2 / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / CDFMYF= CDFBUF / DEFINE OUR FIELD. H2DTR=6362 / DEFINE MODEM CONTROL IOT /A023 / / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! o r d e r i m p o r t a n t !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / / THE FOLLOWING LOCATIONS ARE COPIED INTO THE MENU FIELD AND ARE / ASSUMED TO BE IN THE ORDER EXPECTED BY THE 'CX3' MENU. / CX0AD, 0 / DATA BITS CX0AP, 0 / PARITY CX0AS, 0 / STOP BITS CX0AB, 0 / PRIMARY LINE BAUD RATE (0-17 OCTAL) CX1AD, 0 / DATA BITS CX1AP, 0 / PARITY CX1AS, 0 / STOP BITS CX1AB, 0 / SECONDARY LINE BAUD RATE (0-17 OCTAL) CUPORT, 0 / PORT SELECT. CUBRTM, 0 / BREAK TIME. CUTMOD, 0 / TERMINAL MODE PRTBAB, 0 / PRINTER BAUD RATE. / / IF ANY ENTRIES ARE ADDED TO THIS AREA, 'CXSETZ' MUST BE ADJUSTED. / / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!! E N D o r d e r i m p o r t a n t !! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! IFNZRO PRTBAB-CX0AD-CXSETZ+1 SAVPRI, 0 / Saved value of MNPRIM word. /A020 SAVSEC, 0 / Saved value of MNSECN word. /A020 SAVPRT, 0 / Saved value of MNPRTB word. /A020 SAVXON, 0 / Saved value of MNXONF word. /A020 SAVMOD, 0 / Saved value of INTEGRAL MODEM BIT (MNFMAT) /A023 IFDEF CONDOR < /A014 PRQBLK, ZBLOCK 3 / /a016 > / END IFDEF CONDOR /A014 SAVDRV, 0 / Saved value of Activate Features Drive Number /A024 / AXDST - WILL READ OR WRITE THE COMMUNICATIONS SETTINGS DEPENDING ON THE / VALUE IN THE AC. THE AC CONTAINS THE FUNCTION TO EXECUTE. CU4ST, XX DCA QUQBLK+RXQFNC / SET THE FUNCTION CDFMYF TAD .-1 / SET THE BUFFER FIELD DCA QUQBLK+RXQBFD DCA QUQBLK+RXQDRV / SET TO SYSTEM DRIVE TAD (DLSVAL) / SET THE BLOCK TO READ DCA QUQBLK+RXQBLK TAD (CU4BF1) / SET THE BUFFER TO READ INTO DCA QUQBLK+RXQBAD JMS QURX / GET THE BLOCK CLA JMP I CU4ST / THIS IS THE QUEUE ROUTINE TO RXHAN. THE REQUEST IS IN QUQBLK / USED BY UNBUNDLING AND SYSTEM OPTIONS QURX, XX / ENTER TO QUEUE A REQUEST TO RXHAN CIFSYS / CHANGE TO SYSTEM FIELD ENQUE / CAUSE REQUEST TO BE ENTERED INTO SYSTEM QUBLK / ADDRESS OF REQUEST BLOCK TO BE QUEUED CIFSYS / CHANGE TO SYSTEM FIELD JWAIT / WAIT FOR A SIGNIFICENT EVENT TAD QUQBLK+RXQCOD / GET THE COMPLETION CODE FROM REQUEST BLOCK SNA / ARE WE DONE YET ? JMP .-4 / NO, GO CHECK AGAIN JMP I QURX / YES, RETURN TO CALLER QUBLK, DSKQUE / ADDRESS OF DISK QUEUE 0 / CDF TO NEXT QUEUE ENTRY 0 / ADDRESS TO NEXT QUEUE ENTRY QUQBLK, ZBLOCK 17 / QUEUE BLOCK X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE / CU4OPT - THE SYSTEM OPTIONS ROUTINE. THE REASON THAT THERE IS A CU4 / IS THAT CU3 WAS GETTING TOO CROUDED AND THIS IS THE ONLY ROUTINE THAT / TOOK UP TWO FIELDS. SO AS NOT TO SLOW DOWN THE OTHERS THEY WERE / SEPERATED. WHAT SHOULD BE NOTICED IS THAT WPCX2 IS ASSEMBLED TOGETHER / WITH WPCU4 BUT NOT LOADED OUT WITH IT. THERE IS ONLY ONE COPY LOADED / OUT WITH WPCX. / CU4BF1=5400 / TEMP BUFFER THAT CAN BE USED BY ANY OF THE / RROUTINES IS CURRENTLY USED ONLY IN CU4OPT XX / FIRST ENTRY FROM OVERLAY PROCESSOR JMS CU4OPT / CU4OPT - SET SYSTEMS OPTIONS CDIMNU / SET UP FOR RETURN TO MENU FIELD JMP I .-3 / RETURN BACK TO CALLER IFDEF UNBUND < /A001 XX / SECOND ENTRY FROM OVERLAY PROCESSOR /A001 JMS CU4UNB / CU4UNB - FEATURE UNBUNDLING OPERATION /A001 CDIMNU / SET UP FOR RETURN TO MENU FIELD /A001 JMP I .-3 / RETURN BACK TO CALLER /A001 > / END IFDEF UNBUND /A001 / ROUTINE TO HANDLE THE OPTION UNBUNDLING OPERATIONS /A001 / CALLED BY A COMMAND CALL IN DLMDU2 IN MN1 MODULE /A001 / / CALLS ACTIVATE MENU IN DLMUB1 TO DISPLAY OPTIONS AVAILABLE /A001 / / RETURN FROM MENU WITH MNTMP3 SET UP TO DEFINE ACTIONS /A001 / / MNTMP3 VALUES ARE: /A001 / 0 = JUST RETURN TO MAIN MENU /A001 / 1 = STORE OPTION SETTINGS AND RETURN TO ACTIVATE MENU /A001 / 2 = VERIFY OPTION DISKETTE, INSTALL OPTION, AND /M022 / RETURN TO ACTIVATE MENU /A001 / IFDEF UNBUND < /A001 CU4UNB, XX /A001 CU4OVR, CIFMNU /A001 JMS I MNUCAL / CALL OPTIONS ACTIVE MENU /A001 DLMUB1 /A001 CDFMNU / MAKE CDF INSTRUCTION FOR MENU FIELD /A001 TAD I (MUBUF+MNTMP2) / GET ACTIVATE FEATURE DRIVE NUMBER /A024 DCA SAVDRV / SAVE DRIVE NUMBER FOR LATER USE /A024 AC7776 / SET A.C. EQUAL TO MINUS 2 /M022 TAD I (MUBUF+MNTMP3) / PICK UP TEMP 3 VALUE FROM MENU FIELD /A001 CDFMYF / MAKE DCF INSTRUCTION FOR MY FIELD /A001 SNA / TEST FOR VALUE OF TWO /M022 JMP INSOPT / TEST FOR OPTION DISK & INSTALL OPTION /A001 IAC / INCREMENT VALUE FOR NEXT TEST /A001 SZA CLA / TEST FOR VALUE OF ONE /A001 UNBRTN, JMP I CU4UNB / ZERO VALUE - RETURN TO MAIN MENU /A001 / UPDATE OPTIONS ON SYSTEM DISK /A001 CU4WRT, JMS CU4SET / COPY SYSTEM OPTIONS AND XFER TO DISK /A001 JMP CU4OVR / GO RETURN TO ACTIVATE MENU /A001 > / END IFDEF UNBUND /A001 / ROUTINE TO MOVE A BLOCK OF MENORY WITHIN THIS FIELD /A001 / / CALL IS A FOLLOWS: /A001 / / JMS CU4MOV / CALL MOVE ROUTINE /A001 / ADDRESS OF FROM / DEFINE FROM ADDRESS /A001 / ADDRESS OF TO / DEFINE TO ADDRESS /A001 / NUMBER TO MOVE / DEFINE NUMBER OF WORDS TO MOVE /A001 / RETURN / NORMAL RETURN ADDRESS /A001 CU4MOV, XX /A001 AC7777 / SET A.C. EQUAL TO MINUS ONE /A001 TAD I CU4MOV / SUBTRACT ONE FROM THE FROM ADDRESS /A001 ISZ CU4MOV / INCREMENT RETURN ADDRESS /A001 DCA X0 / STORE VALUE IN AUTOINDEXING REGISTER /A001 AC7777 / SET A.C. EQUAL TO MINUS ONE /A001 TAD I CU4MOV / SUBTRACT ONE FROM THE TO ADDRESS /A001 ISZ CU4MOV / INCREMENT RETURN ADDRESS /A001 DCA X1 / STORE VALUE IN AUTOINDEXING REGISTER /A001 TAD I CU4MOV / GET VALUE FOR NUMBER OF WORDS /A001 ISZ CU4MOV / INCREMENT RETURN ADDRESS /A001 CIA / MAKE THE VALUE NEGATIVE /A001 DCA X2 / STORE VALUE IN AUTOINDEXING REGISTER /A001 CU4MOR, TAD I X0 / GET MEMORY VALUE FROM "FROM" ADDRESS /A001 DCA I X1 / STORE MEMORY VALUE IN "TO" ADDRESS /A001 ISZ X2 / INCREMENT NUMBER OF WORDS TO TRANSFER /A001 JMP CU4MOR / NOT DONE, GO DO SOME MORE /A001 JMP I CU4MOV / RETURN BACK TO CALLER /A001 / 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, 0 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, .-. / ACDF FOR FIRST FIELD TAD I X0 / GET WORD CUCPY1, .-. / ACDF 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 IFDEF CONDOR < /A016 PR3= 6236 / panel request #3 / SET THE USER DEFINED TERMINAL CHARACTERISTICS / (printer and comm baud rates) / SELECTIONS FROM THE "SO" MENU / INTO FIRMWARE PANEL MEMORY FIELD 0 LOCATIONS 24,25,26 / THEN A "RST" (RESTORE TERMINAL CHARACTERISTICS) ESCAPE SEQUENCE (ESC c) / WON'T BLOW US UP SETTC, XX / CDFMNU TAD I (MUBUF+MNSECN) / (note that ansi mode and 80 col mode forced) TAD (1200) / Lvl 2 8 bit also /A030 DCA PRQBLK / terminal characteristics from "SETUP" mode TAD I (MUBUF+MNPRTB) / AND (17) / DCA PRQBLK+1 / printer baud rate TAD I (MUBUF+MNPRIM) / AND (17) / DCA PRQBLK+2 / communications baud rate CDFMYF PR3 / 4004 / 40 (dest field) (source field) PRQBLK / source address 24 / destination address -3 / # of words to transfer (neg) 7777 / pr3 terminator CLA / cla just in case ac is dirty from prq JMP I SETTC / EXIT > / END IFDEF CONDOR /A016 / CU4DCD - DISPAY THE CD DOCUMENT NAME CU4DCD, XX CLA CDFMNU TAD I (MUBUF+MNCXP) / SEE IF A DOCUMENT HAS BEEN DEFINED CDFMYF SNA CLA / ++++ JMP I CU4DCD CIFMNU JMS I IOACAL 0 CU4DC1 1012 CU4BF1+SOCDV CU4BF1+SOCNO CU4BF1+SOFAD 2700 / REPOS. CURSOR AT BOTTOM OF SCREEN /A027 JMP I CU4DCD CU4DC1, TEXT '^P(!D.!D) ^A^P' / /M027 X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE / CU4OPT - SYSTEM OPTIONS ROUTINE / / THIS IS THE ROUTINE THAT CHANGES THE SYSTEM VALUES. IT NOW ONLY DEALS WITH THE / COMMUNICATIONS SETTINGS OF MAGCARD, XON/XOF CONTROL IN HOST BUFFER. / / WHAT IS ASUMED IS THAT THE SETTINGS DEALING WITH THE 78 WILL BE SET RIGHT AWAY / THAT IS IF THEY ARE LEAGAL. WHAT IS NOT LEGAL IS TO SET THE SLU3 BAUD RATE IF / SET FOR A WT78. / THE OTHER VALUES WILL BE SET AT THE TIME THAT A COMMUNICATIONS PROGRAM IS / CALLED SINCE IT COULD BE A 102 SYSTEM AND EACH USER COULD HAVE DIFFERENT SE / SETTING FOR THEIR COMMUNICATIONS. / / FIRST THE CONSTANTS THAT ARE USED. / / OFFSETS USED WITH CU4BF1 WHERE THE SYSTEM OPTIONS BUFFER IS READ INTO. SOOPTC=MUSYSL / UNBUNDLING OPTIONS WORD /M001 /C015 SOCDV=SOOPTC+1 / DRIVE NUMBER IN DISPLAYABLE FORMAT /M001 SOCNO=SOCDV+1 / DOCUMENT NUMBER IN DISPLAYABLE FORMAT /M001 SOFAD=SOCNO+1 / STARTING ADDRESS OF THE DOCUMENT'S ASCII NAME STRING /M001 / HERE ARE THE VALUES RETURNED FROM THE SO MENUS CU4SO0=1 / GO TO THE MAIN SYSTEM OPTION MENU CU4GM=2 / GO BACK TO MAIN MENU CU4CD=3 / RETURNED FROM THE CD OPTION CU4CC=4 / MISC CONSTANTS CTLB=2 / DEFINE CONTROL B /A023 CR=15 / DEFINE A CHAR /A023 / THE MAIN PROGRAM CU4OPT, XX JMS CUSM / SET THE MENU VALUES FOR THE DISPLAYS JMS CU4MNU / DISPLAY THE MENUS FOR THE SO OPTION JMS CU4GVL / STORE THE MENU VALUES IN PACKED FORMAT AGAIN JMS CU4CPY / COPY OPTION SETTINGS AND XFER TO DISK /A001 CU4OPX, JMP I CU4OPT / ROUTINE TO COPY THE COMMUNICATION AND OPTION SETTINGS TO THE /A001 / TEMPORARY BUFFER AND THEN TRANSFER THEM TO THE SYSTEM DISK /A001 CU4SET, XX /A001 CLA / MAKE SURE ACCUMULATOR IS CLEAR /A001 TAD (RXERD) / READ COMMAND FOR QUEUING TO RXHAN /A001 JMS CU4ST / READ SYSTEM OPTION WORDS INTO BUFFER /A001 JMS CU4CPY / COPY OPTIONS SETTINGS AND XFER TO DISK/A005 JMP I CU4SET / EXIT CU4CPY, XX / /A001 CLA / /A001 JMS CUCOPY / COPY NEW VALUES FROM THE MENU AREA /M001 MUSYSV / ++++ /M001 CDFMNU /M001 CU4BF1 / ++++ /M001 CDFMYF /M001 MUSYSL /M001 TAD (RXEWT) / WRITE COMMAND FOR QUEUING TO RXHAN /M001 JMS CU4ST / TRANSFER THE SETTINGS TO DISK /M001 JMP I CU4CPY / RETURN TO CALLER /M005 / CUSM - SETS THE VALUES FOR THE MENU TO BE DISPLAYED / THE VALUES THAT ARE SET FOR THE MENU ARE ALL VALUES PERTAINING TO SLU2 AND 3 / IN THE VT78. ALL VALUES ARE PACKED IN A FORM THAT CAN BE BROKEN DOWN FOR DISPLAY / AND USED BY THE ACTUAL SET COMMAND EASIER BUT IT MAY NOT LOOK THAT WAY. / ALL VALUES FOR SLU2 ARE FOUND IN PACKED FORMAT IN SLU2PM. / / THE SLU3 PORT CAN ONLY HAVE THE BAUS RATE CHANGED SO THIS IS THE ONLY VALUE / IT CONTAINS. / / FORMAT: / BITS INFORMATION / / 11 - 8 THE CHARACTER SIZE ONLY COUNTING THE BITS IN THE / CHARACTER NOT PARITY OR STOP BITS / / 7,6 PARITY / / 5,4 STOP BITS / / 3-0 /BAUD / / FORMAT FOR THE MNPRTB WORD: / BITS INFORMATION / / 11-10 TERMINAL MODE (0=VT52, 1=VT278, 2=DECWORD52, 3=EASYLINK) / / 9-6 BREAK TIME (IN TENTHS OF A SECOND). / / 5 UNUSED / / 4 PORT SELECT (0=PRIMARY, 1=ALTERNATE) / / 3-0 PRINTER BAUD RATE. / / ********************************************************** / LIMITS - VALUES THAT ARE CHECKED FOR IN THE MENU / / CHARACTER SIZE - CAN BE FROM 5 - 8 / / PARITY - 2 = NO PARITY, 1 = ODD, 0 = EVEN / / STOP BITS - 1 OR 2 NOTE: IF SET FOR 5 FOR CHARACTER SIZE AND 1 FOR STOP / IT WILL AUTOMATICALLY SET FOR 1.5 STOP BITS / / AND BAUD: / / VALUE BAUD / 0 50 / 1 75 / 2 110 / 3 134.5 (MAGCARD) / 4 150 / 5 300 (DEFAULT) / 6 600 / 7 1200 / 10 1800 / 11 2000 / 12 2400 / 13 3600 / 14 4800 / 15 7200 / 16 9600 / 17 19200 / / CUSM - SETS THE VALUES FOR THE MENU TO BE DISPLAYED / FIRST THE VALUE MNPRIM, MNSECN AND MNPRTB HAVE TO BE BROKEN DOWN TO READABLE VALUES / FOR THE MENU PROGRAM THEN COPIED OVER TO MENU FIELD. THE AREA USED FOR THE / VALUES IN THE MENU FIELD IS THE SAME AS THE ARE USED FOR THE PRINTER SETTINGS CUSM, XX / DISPLAY SETTINGS, AND CHANGE THEM, IF NEC. TAD (CX0AD-1) / SET PTR TO UNPACK AREA. /A009 DCA X0 / /A009 CDFMNU TAD I (MUBUF+MNPRIM) / GET PORT 0 SETTINGS. CDFMYF DCA SAVPRI / Save for later check. /A020 TAD SAVPRI / Get primary port settings. /A020 JMS CUXUPK / UNPACK. IFNDEF CONDOR < /A023 CDFMNU / GET SECONDARY PORT SELECTIONS. TAD I (MUBUF+MNSECN) / ... CDFMYF / DCA SAVSEC / Save for later check. /A020 TAD SAVSEC / Get secondary port settings. /A020 JMS CUXUPK / UNPACK PORT 1 SETTINGS. > / END IF NDEF CONDOR /A023 CDFMNU TAD I (MUBUF+MNFMAT) / GET INTEGRAL MODEM VALUE /A023 AND (MNFM4X / MASK IM BIT /A023 DCA SAVMOD / SAVE /A023 TAD I (MUBUF+MNXONF) / Get XON/XOF value. /A020 DCA SAVXON / Save for later check. /A020 TAD I (MUBUF+MNPRTB) / SAME FOR PRINTER BAUD RATE CDFMYF DCA SAVPRT / Save for later check. /A020 / (SAVPRT)= |TM TM xx|xx BT BT|xx PS BA|BA BA BA /a016 / THIS DEF. CHANGED FOR (026), TO EXPAND # OF TERMINAL MODES /A026 / (SAVPRT)= |TM TM TM|BT BT BT|BT PS BA|BA BA BA /A026 / /a016 / TM=terminal mode, BT=break time, PS=port select, BA=baud rate /a016 / xx=don't care (or don't know) /a016 IFNDEF CONDOR < /A016 TAD SAVPRT RTR / RTR / AND (1) / > / END IFNDEF CONDOR /A016 DCA CUPORT / SAVE PORT SELECT. (always 0 for DEcmate II) TAD SAVPRT CLL RAL / SHIFT BREAK TIME OVER ONE POSITION /A026 BSW AND (17) DCA CUBRTM / SAVE BREAK TIME. TAD SAVPRT / RTL / /M010 /D026 RAL / /M010 /D026 AND (3) / /M010 RTL / TM IS 3 BITS NOW /A026 AND (7) / /A026 DCA CUTMOD / SAVE TERMINAL MODE. TAD SAVPRT AND (17) DCA PRTBAB / PRINTER BAUD RATE. JMS CUCOPY CX0AD / COPY SETTINGS TO MENU FIELD CDFMYF MUBUF+MNPROP / USE COMMON AREA FOR MENU COMMUNICATIONS. CDFMNU CXSETZ JMP I CUSM IFNDEF CONDOR < /A014 / CU4GVL - GETS THE VALUES FROM THE MENU FOR WT78 AND PUTS THEN / BACK INTO THE PACKET FORMAT. CU4GVL, XX JMS CUCOPY MUBUF+MNPROP / COPY SETTINGS FROM MENU BACK CDFMNU CX0AD CDFMYF CXSETZ TAD (CX0AD-1) / SET INDEX REG. DCA X0 / ... JMS CUPACK / PACK CX0 SETTINGS. CDFMNU DCA I (MUBUF+MNPRIM) CDFMYF JMS CUPACK / PACK CX1 SETTINGS. CDFMNU DCA I (MUBUF+MNSECN) CDFMYF TAD CUPORT /CUPORT /M010 BSW / NOW DO HI BYTE. /M010 TAD CUTMOD /TERMINAL MODE /M010 CLL RTL /M010 RTL /M010 TAD CUBRTM /CUBRTM /M010 BSW /M010 TAD PRTBAB /PRTBAB /M010 CDFMNU DCA I (MUBUF+MNPRTB) CDFMYF JMP I CU4GVL > / END IFNDEF CONDOR /A014 IFDEF CONDOR < /A014 / CU4GVL - GETS THE USER DEFINED VALUES FROM THE COMMUNICATIONS MENU CU4GVL, XX JMS CUCOPY MUBUF+MNPROP / COPY SETTINGS FROM MENU BACK CDFMNU CX0AD CDFMYF CXSETZ TAD (CX0AD-1) / SET INDEX REGISTER DCA X0 / ... JMS CUPACK / PACK CX0 SETTINGS. CDFMNU DCA I (MUBUF+MNPRIM) CDFMYF /D021; JMS CUPACK / PACK CX1 SETTINGS. /D021; CDFMNU /D021; DCA I (MUBUF+MNSECN) /D021; CDFMYF /D026 TAD CUPORT /D026 BSW / NOW DO HI BYTE. TAD CUTMOD / TERMINAL MODE / TERMINAL MODE IS NOW 3 BITS /A026 CLL RTL RTL TAD CUBRTM /D026 BSW RTL / SHIFT OVER 5 PLACES /A026 RTL / /A026 RAL / /A026 TAD PRTBAB CDFMNU DCA I (MUBUF+MNPRTB) / IF THE "CC" VALUES OF THE COMMUNICATIONS LINE REMAIN THE SAME / THEN DO NOT "H2INIT" / / THE "CC" VALUES COMPARED ARE FROM "CX0AD" THRU "CX0AD+10" INCLUSIVE TAD I (MUBUF+MNPRIM) / Get new PRIMARY port settings. /A020 CIA / compare to original setting. /A020 TAD SAVPRI / ... /A020 SZA;JMP CU4INI / Init host line if different. /A020 /D021; TAD I (MUBUF+MNSECN) / Now check SECONDARY port settings. /A020 /D021; CIA / compare to original setting. /A020 /D021; TAD SAVSEC / ... /A020 /D021; SZA;JMP CU4INI / Init host line if different. /A020 TAD I (MUBUF+MNXONF) / Check BC setting. /A020 CIA / compare to original setting. /A020 TAD SAVXON / ... /A020 SZA / /A023 JMP CU4INI / INIT IF DIFF /A023 TAD I (MUBUF+MNFMAT) / CK INTEGRAL MODEM SETTING /A023 AND (MNFM4X / MASK IM BIT /A023 CIA / /A023 TAD SAVMOD / ORIGINAL SETTING /A023 CU4INI, CDFMYF / Map back to our field. /A020 SNA / SKIP IF DIFFERENCE IN SETTINGS /M023 JMP CU4IOK / Jmp if settings are the same. /A020 DCA CU4DFF / SET FLAG FOR INTEGRAL MOD. CK /A023 CIFSYS H2INIT / COMMUNICATIONS LINE INITIALIZATION CU4IOK, JMS SETTC / SET THE CHARACTERISTICS INTO P.M. /A016 JMP I CU4GVL > / END IFDEF CONDOR /A014 X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE CUXUPK, XX DCA T1 / GET SAVED SETTINGS TAD T1 BSW / ++++ RTR AND (17) IFDEF CONDOR < / /A020 TAD (DBMAP-5) / Map 5,7,6,8 to 5,6,7,8. /A020 DCA T2 / ... /A020 TAD I T2 / Voila.. /A020 > /ENDIF CONDOR /A020 DCA I X0 / DATA BITS. TAD T1 BSW AND (3) DCA I X0 / PARITY. TAD T1 RTR / ++++ RTR AND (3) DCA I X0 / STOP BITS. TAD T1 / AND SEPARATE THEM FOR DISPLAY/MODIFY AND (17) DCA I X0 / BAUD RATE. JMP I CUXUPK / RETURN TO CALLER. CUPACK, XX / PACK CX SETTINGS INTO PACKED WORD. TAD I X0 /CXAD IFDEF CONDOR < / /A020 TAD (DBMAP-5) / Map 5,6,7,8 to 5,7,6,8. /A020 DCA T2 / ... /A020 TAD I T2 / Voila.. /A020 > /ENDIF CONDOR /A020 CLL RTL TAD I X0 /CXAP CLL RTL TAD I X0 /CXAS RTL / ++++ RTL TAD I X0 /CXAB JMP I CUPACK / RETURN TO CALLER. DBMAP, 5;7;6;10 / table to map 5,6,7,8 to 5,7,6,8 /A020 / CU4MNU - READS IN THE BUFFER WITH THE SETTINGS TO GET THE DOCUMENT NAME / FOR CD OPTION IN SO THAT IS THE CX DOCUMENT TRANSFER PROTOCOL OPTION. / IT WILL THEN DISPLAY THE APPROPRIATE MENUS WHEN CHOSEN. THE ONLY REALLY / WIERD MENU DISPLAY IS THE FIRST THAT CAN CONTAIN THE CD DOCUMENT NAME SINCE / THE MENU DOES THE MAJORITY OF THE DISPLAY BUT THE ROUTINE DISPLAYS THE NAME. CU4MNU, XX CLA TAD (RXERD) / READ COMMAND FOR THE QUEUING TO RXHAN JMS CU4ST / READ IT IN CDFMNU / MAP MENU FIELD. /A011 AC0001 / SET REFRESH FLAG TO /A011 DCA I (MUBUF+MNTMP4) / REFRESH THE SO MENU THE INITIAL TIME./A011 CDFMYF / BACK TO US. /A011 CU4MN1, CIFMNU / DISPLAY THE SO MENU EXCEPT THE CD DOCUMENT NAME IF ANY JMS I MNUCAL DLMSO0 JMS CU4DCD / DISPLAY THE NAME CIFMNU JMS I MNUCAL / HAVE MENU DO THE READ AND DISPLAY ANY SUB MENUS DLMSO1 CDFMNU / ++++ TAD I (MUBUF+MNTMP2) / ++++ CDFMYF / GET THE RETURN VALUE TAD (-CU4CC) / CK FOR "CC" MENU /A023 SNA / /A023 JMP CU4MCC / "CC" MENU IS NOW A SPECIAL CASE /A023 TAD (CU4CC-CU4CD) / CK FOR CONTROL DOCUMENT /A023 SNA / /A023 JMP CU4MCD / /A023 TAD (CU4CD-CU4GM) / GOLD:M - IS RET TO MAIN MENU /A023 SNA CLA / /A023 JMP I CU4MNU / PATH TO MAIN MENU /A023 JMP CU4MN1 / REDISPLAY "SO" MENU /A023 / TAD (-CU4GM) / SEE IF THE VALUE RETURNED IS TO RETURN TO / / MAIN MENU / SNA / ++++ / JMP I CU4MNU / TAD (CU4GM-CU4SO0) / OR GO TO THE MAIN SYSTEM OPTION MENU / SNA CLA / ++++ / JMP CU4MN1 / AC7777 / SEE IF DOCUMENT HAS NO ERRORS / / -1 MEANS THAT DBTDOC IS CALLED BY SO CU4MCD, AC7777 CIFEDT JMS I (CU4DBT) JMP CU4MN5 / ERROR SO DONT CONTINUE CDFMNU / ++++ TAD I (MUBUF+MNFNAM) / ++++ CDFMYF DCA CU4MN2 / GET ADDRESS OF THE BUFFER THAT HAS THE NAME / HERE ASSUME IT IS A SPECIAL RETURN TO SYSTEM / OPTION MENU FROM THE CD SUB MENU SO THE NAME / HAS TO BE UPDATED AND THE DOCUMENT CHECKED JMS CUCOPY CU4MN2, XX / COPY FILE NAME CDFMNU CU4BF1+SOFAD CDFMYF 121 / LENGTH OF THE MNFNAM STRING CDFMNU / ++++ TAD I (MUBUF+MNDRV) CDFMYF / ++++ DCA CU4BF1+SOCDV / GET THE DRIVE NUMBER CDFMNU / ++++ TAD I (MUBUF+MNDOCN) CDFMYF / ++++ DCA CU4BF1+SOCNO / AND DOCUMENT NUMBER JMP CU4MN1 / GO TO THE MAIN DISPLAY CU4MN5, CLA / BEFORE CONTINUING ERASE THE VALID DOCUMENT FLAG CDFMNU / ++++ DCA I (MUBUF+MNCXP) / ++++ CDFMYF JMP CU4MN1 CU4MCC, CIFMNU / MENU FIELD /A023 JMS I MNUCAL / /A023 DLMSO4 / DISPLAY "CC" MENU /A023 JMS CU4DMC / DO MODEM CHECK /A023 SZA CLA / RETURNS AC=0 IF OK /A023 JMP CU4MCC / IM WILL NOT RESPOND - REDISPLAY "CC" /A023 CDFMNU / /A023 TAD I (MUBUF+MNTMP2) / FETCH RETURN VALUE FROM MENU /A023 CDFMYF / /A023 TAD (-CU4GM) / /A023 SZA CLA / /A023 JMP CU4MN1 / DISPLAY "SO" MENU /A023 ISZ CU4MNU / SKIP THE JMS CU4GVL /A023 JMP I CU4MNU / GOLD MENU RETURN /A023 X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE / INTEGRAL MODEM SUPPORT CU4DMC, XX / /A023 DCA CU4DFF / RESET DIFFERENCE FLAG /A023 JMS CU4GVL / COPY & COMPARE VALUES /A023 TAD CU4DFF / HAVE SETTINGS CHANGED ? /A023 SNA CLA / /A023 JMP CU4DME / NO - EXIT /A023 CDFMNU / SEE IF IM IS ENABLED /A023 TAD I (MUBUF+MNFMAT) / /A023 CDFMYF / /A023 AND (MNFM4X / MASK IM BIT /A023 SNA CLA / /A023 JMP CU4DME / NO - EXIT /A023 JMS CU4DSM / YES - FIRST ISSUE A DISABLE TO RESET MODEM /A029 JMS CU4WTT / WAIT /A029 JMS CU4ENM / ISSUE ENABLE /A023 JMS CU4CMP / IS MODEM PRESENT ? /A023 SZA CLA / /A023 JMP CU4ME1 / NO - GO DISABLE & EXIT /A029 JMS CU4SCB / YES - SEND ^B /A023 JMS CU4WTT / WAIT /A023 JMS CKMRES / CK FOR "READY" RESPONSE /A023 SNA CLA / /A023 JMP CU4DME / YES - EXIT /A023 JMS CU4MER / NO - SEND ERROR MESSAGE /A023 AC0001 / SET ERROR RETURN VALUE /A023 CU4DME, JMP I CU4DMC / RETURN /A023 CU4ME1, JMS CU4DSM / DISABLE MODEM SIGNAL /A029 JMP I CU4DMC / RETURN /A029 CU4DFF, 0 / FLAG - DIFFERENCE IN COMM SETTINGS /A023 CU4MER, XX CIFMNU / DISPLAY ERROR MESSAGE /A023 JMS I IOACAL / /A023 0 / /A023 CU4MET / TEXT STRING /A023 2205 / POSITION CURSOR /A023 2305 / POSITION CURSOR /A023 CU4MEW, JMS CU4INC / WAIT FOR USER TO TYPE "RET" /A023 TAD (-CR / /A023 SZA CLA / /A023 JMP CU4MEW / TRY AGAIN /A023 JMP I CU4MER CU4INC, XX / INPUT A CHAR FROM THE KB /A023 JMP C4INC2 / /A023 C4INC1, CIFSYS / /A023 JWAIT / /A023 C4INC2, CIFSYS / /A023 TTYIN / /A023 JMP C4INC1 / NOTHING RETURN /A023 JMP I CU4INC / HAVE A CHAR - RETURN /A023 / CHECK MODEM RESPONSE /A025 / RETURNS AC = 0 IF "Dialer Ready" RESPONSE /A025 / AC NOT EQUAL 0 IF NO MATCH /A025 / CKMRES, XX / /A025 TAD (-22 / MAX COUNT TO "R" /A025 CMPLP, DCA T3 / /A025 JMS HSINPT / ASK FOR CHAR /A025 JMP CKMREE / NONE PRESENT - ERROR /A025 DCA T1 / SAVE CHAR /A029 TAD T1 / /A029 AND (3400 / CK FOR TRANSMISSION ERRORS /A029 SZA CLA / /A029 JMP CKMREE / /A029 TAD T1 / /A020 AND P177 / 7 BITS /A028 CIA / CHAR PRESENT - COMPARE /A025 TAD ("D-200 / UPPER CASE "D" /A028 SNA / /A025 JMP CMPLP1 / FOUND - CLEAR INPUT BUFFER /A029 AC0001 / NOT YET - DEC. COUNT & CK LIMIT /A025 TAD T3 / LIMIT REACHED ? /A025 SZA / /A025 JMP CMPLP / NO - CONTINUE /A025 CKMREE, AC0001 / SET ERROR FLAG /A025 JMP I CKMRES / /A025 CMPLP1, CIFSYS / EMPTY INPUT BUFFER /A029 HS2IN / /A029 SZA CLA / /A029 JMP CMPLP1 / LOOP UNTIL EMPTY /A029 JMP I CKMRES / /A029 X=. /----------------------------------------------------------------------- PAGE HSINPT, XX / INPUT FROM HOST INPUT BUFFER /A023 CIFSYS / /A023 HS2IN / /A023 JMP I HSINPT / NOTHING RETURN /A023 ISZ HSINPT / HAVE A CHAR - TAKE SKIP RETURN /A023 JMP I HSINPT / /A023 HSOUT, XX / OUTPUT CHAR TO COMM CHIP /A023 HSOUT1, CIFSYS / /A023 HS2OU / /A023 SKP / OUTPUT BUFFER FULL - WAIT /A023 JMP I HSOUT / CHAR GONE - RETURN /A023 CIFSYS / /A023 JWAIT / /A023 JMP HSOUT1 / TRY AGAIN /A023 CU4SCB, XX / SEND A ^B /A023 TAD (CTLB) / CONTROL B CHAR /A023 JMS HSOUT / /A023 JMP I CU4SCB / /A023 CU4CMP, XX / CK FOR IM PRESENT /A023 CLA / /A023 LAS / READ BITS /A023 AND (4000) / MASK MODEM BIT /A023 JMP I CU4CMP / /A023 CU4ENM, XX / ENABLE INTEGRAL MODEM /A023 AC0003 / SET BITS 10 & 11 /A023 TAD (4000) / MODEM BIT /A023 H2DTR / IM IOT /A023 CLA / /A023 JMP I CU4ENM / /A023 CU4DSM, XX / DISABLE INTEGRAL MODEM /A023 AC0003 / SET BITS 10 & 11, MODEM BIT = 0 /A023 H2DTR / IM IOT /A023 CLA / /A023 JMP I CU4DSM / /A023 CU4WTT, XX / WAIT 1 SECOND /A028 DCA T1 / CLEAR STORAGE /A028 CDFSYS / FETCH CLOCK VALUE /A028 TAD I (CLOCK+2) / /A028 CDFMYF / /A028 CIA / /A028 DCA T1 / SAVE /A028 CU4WLP, CDFSYS / FETCH NEW VALUE /A028 TAD I (CLOCK+2) / /A028 CDFMYF / /A028 TAD T1 / COMPARE WITH OLD VALUE /A028 SNA CLA / ANY CHANGE /A028 JMP CU4WJW / NO - JWAIT /A028 JMP I CU4WTT / YES - RETURN /A028 CU4WJW, CIFSYS / JWAIT HERE /A028 JWAIT / /A028 JMP CU4WLP / /A028 CU4MET, IFNDEF V30NOR < /A032 TEXT '^P!E&THE &INTEGRAL &MODEM WILL' /A023 *.-1 /A023 TEXT ' NOT RESPOND TO THESE SETTINGS. ' /A023 *.-1 /A023 TEXT '^P&PRESS !&RETURN TO CHANGE THE SETTINGS.' /A023 > IFDEF V30NOR < /A032 TEXT '^P!E&INTEGRALMODEMET GODTAR IKKE DISSE VERDIENE.' /A032 *.-1 /A032 TEXT '^P&TRYKK P\E !&RETUR FOR \E ENDRE VERDIENE.' /A032 > X=. /----------------------------------------------------------------------- PAGE IFDEF UNBUND < /A001 / ACTIVATE OPTIONAL FEATURE / ROUTINE TO READ SPECIAL FEATURE DISKETTE AND EXTRACT OPTION WORD /A001 / PUT UP ACTIVATION MESSAGE AND PERFORM INITIALIZATION OPERATIONS /A001 INSOPT, CIFMNU /MAKE CIF INSTRUCTION FOR MENU FIELD /A001 JMS I IOACAL /CALL THE IOA DISPLAY ROUTINE /A001 0 /DEFAULT OUTPUT ROUTINE /A001 INSMNU /ADDRESS OF "ACTIVATING FEATURE MENU" MESSAGE /A001 0 /CURSOR POSITION TO CLEAR THE SCREEN /A001 23 /CURSOR POSITION TO BEGIN DISPLAY /A001 /IFDEF DUTCH <160> /A003 TAD INSMYF /GET POINTER TO THIS MENORY FIELD /M022 DCA QUQBLK+RXQBFD /SET UP BUFFER FIELD IN QUEUE BLOCK /M022 TAD (BLDBUF) /GET POINTER TO BUFFER ADDRESS /A001 DCA QUQBLK+RXQBAD /SET UP BUFFER ADDRESS IN QUEUE BLOCK /M022 TAD SAVDRV /SET TO DOCUMENT DRIVE /M024 DCA QUQBLK+RXQDRV /AND STORE IT IN QUEUE BLOCK /M022 / GET THE DENSITY OF THE ACTIVATION DISKETTE /A012 TAD (4000+RXEDN) /GET AND SET DENSITY /A012 DCA QUQBLK+RXQFNC /FUNCTION CODE /M022 JMS BLDQR0 /DO IT .... /A012 / READ THE ALLOCATION BLOCK /A001 TAD (RXERD+4000) /READ THE ALLOCATION BLOCK /A001 DCA QUQBLK+RXQFNC /M022 TAD (DLALOC) /GET ALLOCATION BLOCK NUMBER /A001 DCA QUQBLK+RXQBLK /SET THE BLOCK COUNTER /M022 JMS BLDQR0 /REQUEST THE READ /A001 / PERFORM VALIDATION OF ALLOCATION BLOCK /A001 TAD I (BLDBUF+1) /GET SECOND LOCATION OF ALLOC BLOCK /A001 TAD (-40) /40 MEANS DOCUMENT DISKETTE /A001 SZA CLA /CHECK IF THIS IS A DOCUMENT DISKETTE /A001 JMP INSERR /NO - NOT A VALID OPTIONS DISKETTE /A001 TAD I (BLDBUF+2) /GET THIRD LOCATION OF ALLOC BLOCK /A001 SZA CLA /IS NUMBER OF FILE SYSTEM BLOCKS = 0 /A001 JMP INSERR /NO - NOT A VALID OPTIONS DISKETTE /A001 / READ HOME BLOCK /A001 TAD (DLDIR) /LOCATION OF HOME BLOCK /A001 DCA QUQBLK+RXQBLK /M022 JMS BLDQR0 /REQUEST THE READ /A001 / ESTABLISH COMPATIBILITY OF OPTION WITH CURRENT SYSTEM REVISION LEVEL /A001 / BY EXTRACTING THE OPTION VERSION NUMBER FROM THE ACTIVATION DISK /A001 OCTAL /SET OCTAL MODE /A001 TAD I (BLDBUF+341) /SYSTEM 278 VERSION LEVEL FOR OPTION /A001 DCA T1 /SAVE FOR CURRENT USE /A001 TAD T1 /GET THE VERSION LEVEL NUMBER /A001 BSW /SWAP BYTES IN THE ACCUMULATOR /A001 AND (77) /MASK OF THE HIGH ORDER BITS /A001 TAD (200) /CONVERT TO ASCII VALUE /A001 DCA INSVER /STORE IN LIST FOR ERROR MESSAGE /A001 TAD T1 /GET THE VERSION LEVEL NUMBER /A001 AND (77) /MASK OFF THE HIGH ORDER BITS /A001 TAD (200) /CONVERT TO ASCII VALUE /A001 DCA INSREV /STORE IN LIST FOR ERROR MESSAGE /A001 TAD (SYSVER) /GET CURRENT SYSTEM VERSION LEVEL /A001 AND (77) /MASK OFF HIGH ORDER BITS /A001 BSW /MOVE TO HIGH ORDER POSITION /A001 MQL /SAVE IN MQ FOR INCLUSIVE OR OPERATION /A001 TAD (SYSBAS) /GET CURRENT SYSTEM BASE LEVEL REVISION /A001 AND (77) /MASK OFF HIGH ORDER BITS /A001 MQA /PERFORM INCLUSIVE OR OPERATION /A001 CMA CLL /MAKE ONE'S COMPLEMENT OF VALUE FOR TEST /A001 TAD T1 /COMBINE WITH OPTION VERSION NUMBER /A001 SZL CLA /LINK SET MEANS SYSTEM VERSION IS TOO LOW /A001 JMP INSLOW /GO REPORT THE ERROR /A001 / EXTRACT OPTION WORD AND COMBINE WITH EXISTING OPTIONS /A001 TAD I (BLDBUF+340) /GET OPTION MASK WORD /A001 MQL /SAVE IN MQ FOR INCLUSIVE OR OPERATION /A001 CDFMNU /MAKE CDF INSTRUCTION FOR MENU FIELD /A001 TAD I (MUBUF+MNOPTC) /GET CURRENT OPTION WORD /A001 MQA /OR IN THE OPTION MASK WORD /A001 DCA I (MUBUF+MNOPTC) /STORE NEW OPTION WORD IN MENU FIELD /A001 INSMYF, CDFMYF /MAKE CDF INSTRUCTION FOR MY FIELD /M022 / ADD BLUFF TIME TO MAKE CUSTOMER THINK SOMETHING REALY IS ON THIS DISK /A001 CIFMNU /MAKE CIF INSTRUCTION FOR MENU FIELD /A001 JMS I IOACAL /CALL THE IOA DISPLAY ROUTINE /A001 0 /DEFAULT OUTPUT ROUTINE /A001 INSPRG /ADDRESS OF "IN PROGRESS" MESSAGE /A001 1221 /CURSOR POSITION TO BEGIN DISPLAY /A001 TAD (-20) /SET UP FOR SIXTEEN PASSES /A001 DCA T1 /USE TEMPORARY REGISTER AS COUNTER /A001 INSOVR, DCA QUQBLK+RXQDRV /SET TO SYSTEM DRIVE /M022 JMS BLDQR0 /REQUEST THE READ OPERATION /A001 ISZ QUQBLK+RXQDRV /SET TO DOCUMENT DRIVE /M022 JMS BLDQR0 /REQUEST THE READ OPERATION /A001 ISZ T1 /INCREMENT THE COUNT /A001 JMP INSOVR /NOT DONE, GO DO SOME MORE /A001 JMP CU4WRT /GO UPDATE OPTIONS WORD ON SYSTEM DISK /A001 INSERR, CIFMNU /MAKE CIF INSTRUCTION FOR MENU FIELD /A001 JMS I IOACAL /CALL THE IOA DISPLAY ROUTINE /A001 0 /DEFAULT OUTPUT ROUTINE /A001 INSVAL /ADDRESS OF "DISKETTE NOT VALID" MESSAGE /A001 1316 /CURSOR POSITION FOR ERROR MESSAGE /A001 JMP BLDERN /GO PRINT "GOLD MENU" MESSAGE & RETURN /A001 INSLOW, CIFMNU /MAKE CIF INSTRUCTION FOR MENU FIELD /A001 JMS I IOACAL /CALL THE IOA DISPLAY ROUTINE /A001 0 /DEFAULT OUTPUT ROUTINE /A001 INSMS0 /ADDRESS OF TEXT CONTROL STRING /A022 1013 /CURSOR POSITION FOR ERROR MESSAGE /M022 INSMS1 /ADDRESS OF "THE FEATURE ---" MESSAGE /M022 1213 /CURSOR POSITION FOR ERROR MESSAGE /M022 INSMS2 /ADDRESS OF "WITH THIS VERSION" MESSAGE /M022 1413 /CURSOR POSITION FOR ERROR MESSAGE /M022 INSMS3 /ADDRESS OF "REQUIRES VERSION" MESSAGE /M022 INSVER /ADDRESS OF VERSION NUMBER LIST /M022 INSMS4 /ADDRESS OF "OR LATER..." MESSAGE /A022 JMP BLDERN /GO PRINT "GOLD MENU" MESSAGE & RETURN /A001 INSMS0, TEXT '^P^S^P^S^P^S^A^S' /CONTROL STRING FOR VERSION MESSAGE /A022 INSVER, 0;". /VERSION NUMBER FOR ERROR MESSAGE /M022 INSREV, 0;0 /REVISION NUMBER FOR ERROR MESSAGE /M022 X=. / LOCATION OF FIRST FREE LOCATION ON PAGE /----------------------- PAGE /A001 /*************************************************************************** /*************************************************************************** /**** CAUTION - THE CODE ON THIS PAGE WAS WRITTEN SO THAT IT DOESN'T **** /**** GENERATE ANY LITERAL OR OFF PAGE DEFINITIONS. THIS WAS DONE **** /**** SO THAT THE MESSAGES COULD FOLLOW THE CODE AND SAVE DISK SPACE **** /*************************************************************************** /*************************************************************************** BLDBAK, UNBRTN /RETURN ADDRESS FOR TYPING GOLD MENU /A022 BLDBEL, 7 /ASCII CODE FOR RINGING THE BELL /A022 BLDC1, 1 /MASK VALUE OF 1 /A022 BLDC77, 77 /MASK VALUE OF 77 /A022 BLDFNR, BLDRED /ADDRESS OF "READ" FOR ERROR MESSAGE /A022 BLDFNW, BLDWRT /ADDRESS OF "WRITE" FOR ERROR MESSAGE /A022 BLDLIN, EDMENU-EDNWLN /CHECK VALUE FOR TESTING RETURN /A022 BLDM4, -4 /CKECK VALUE FOR TESTING BLOCK WRITE /A022 BLDMNU, -EDMENU /CHECK VALUE FOR TESTING GOLD MENU /A022 BLDOVR, CU4OVR /RETURN ADDRESS FOR TYPING RETURN /A022 BLDQR0, XX /REQUEST A DISK FUNCTION & HANDLE ERRORS/A001 JMS QURX /QUEUE THE DISK REQUEST /M022 SMA CLA /WAS THERE AN ERROR ? /M022 JMP I BLDQR0 /NO, WE ARE DONE, RETURN TO CALLER /M022 /YES, HANDLE DISK DRIVE ERROR /M022 TAD QUQBLK+RXQDRV /GET THE ERROR DRIVE NUMBER /M022 DCA BLDDRV /STORE THE ERROR DRIVE NUMBER /A001 TAD BLDFNR /GET POINTER TO READ MESSAGE /M022 DCA BLDFNC /SET UP FOR READING ERROR /A001 TAD QUQBLK+RXQFNC /CHECK TO SEE IF IT IS READING ERROR /M022 AND BLDC77 /GET RID OF THE 4000 /A001 TAD BLDM4 /CHECK FOR A BLOCK WRITE /M022 SZA CLA /M022 JMP BLDER1 /NO, IT WAS A READ /M022 TAD BLDFNW /GET POINTER TO WRITE MESSAGE /M022 DCA BLDFNC /SET UP FOR WRITTING ERROR /M022 BLDER1, CIFMNU /M022 JMS I IOACAL /THE ERROR MESSAGE /A001 0 /A001 BLDERM /A001 520 /POSITION ON THE SCREEN ROW 5 COL.20 /A001 BLDDRV, 0 /THE DRIVE /A001 BLDFNC, 0 /THE ADDRESS OF THE MESSAGE READ/WRITE /A001 QUQBLK+RXQBLK /THE BLOCK NUMBER /M022 / FALL INTO RETURN ROUTINE /M022 /*************************************************************************** /*************************************************************************** /**** CAUTION - THE CODE ON THIS PAGE WAS WRITTEN SO THAT IT DOESN'T **** /**** GENERATE ANY LITERAL OR OFF PAGE DEFINITIONS. THIS WAS DONE **** /**** SO THAT THE MESSAGES COULD FOLLOW THE CODE AND SAVE DISK SPACE **** /*************************************************************************** /*************************************************************************** BLDERN, CIFMNU /MAKE CIF INSTRUCTION FOR MENU FIELD /A001 JMS I IOACAL /CALL DISPLAY ROUTINE /A001 0 /DEFAULT OUTPUT ROUTINE /A001 BLDTXT /ADDRESS OF TEXT CONTROL STRING /M022 2315 /CURSOR POSITION TO DISPLAY MESSAGE /M022 BLDRET /ADDRESS "PRESS RETURN" MESSAGE /M022 2523 /CURSOR POSITION TO DISPLAY MESSAGE /M022 BLDGMR /ADDRESS "PRESS GOLD MENU" MESSAGE /M022 2700 /MOVE CURSOR TO BOTTOM OF SCREEN /M022 /THIS ROUTINE WILL WAIT FOR A GOLD MENU OR RETURN TO BE TYPED /A001 /BY THE USER. A GOLD MENU WILL CAUSE A RETURN TO THE MAIN MENU, /A001 /AND A RETURN WILL CAUSE A RETURN TO THE ACTIVATE FEATURES MENU. /A001 /ALL OTHER CHARACTERS WILL RING THE BELL. /A001 JMP BLDWFR /CHECK FOR CHARACTER FROM THE KEYBOARD /A001 CIF 0 /CHANGE TO USER FIELD ZERO /A001 JWAIT /WAIT FOR SYSTEM INTERRUPT /A001 BLDWFR, CIF 0 /CHANGE TO USER FIELD ZERO /A001 XLTIN /READ THE KEYBOARD /A001 JMP .-4 /IF NOTHING TYPED THEN WAIT /A001 TAD BLDMNU /CHECK FOR A GOLD MENU /M022 SNA /A001 JMP I BLDBAK /A GOLD MENU TYPED - GO TO MAIN MENU /M022 TAD BLDLIN /NOW CHECK FOR A RETURN /M022 SNA CLA /A001 JMP I BLDOVR /RETURN WAS TYPED - GO TO ACTIVATE /M022 /THIS ROUTINE WILL RING THE BELL IN RESPONSE TO SOME USER ERROR /A001 TAD BLDBEL /GET ASCII BELL CODE /M022 JMP .+3 /SKIP OVER WAIT COMMAND /A001 CIF 0 /CHANGE TO USER FIELD ZERO /A001 JWAIT /WAIT FOR SYSTEM INTERRUPT /A001 CIF 0 /CHANGE TO USER FIELD ZERO /A001 TTYOU /TRY TO TYPE THE CHARACTER /A001 JMP .-4 /NOT SUCCESSFUL - GO TRY AGAIN /A001 JMP BLDWFR /GO BACK FOR ANOTHER CHARACTER /A001 BLDTXT, TEXT '^P^S^P^S^P' /CONTROL STRING FOR RETURN MESSAGE /A022 /THESE ARE THE CONSTANTS AND ADDRESSES USED BY THE ERROR MESSAGE. /A001 IFDEF ENGLSH < /A002 BLDWRT, TEXT 'WRITE' /A001 BLDRED, TEXT 'READ' /A001 BLDRET, TEXT '&PRESS !&RETURN TO RECALL THE &ACTIVATE &FEATURES &MENU, OR' BLDGMR, TEXT '&PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.' /M022 BLDERM, TEXT '^P&ERROR ON DRIVE ^D WHILE TRYING TO ^S BLOCK !D' /M022 INSMNU, TEXT '^P!E^P-- &ACTIVATING &SPECIAL &FEATURE &OPTION --' /A001 INSPRG, TEXT '^P&ACTIVATION IN PROGRESS, PLEASE STAND BY ...' /A001 INSVAL, TEXT '^P&DRIVE 1 DOES NOT CONTAIN A VALID !&FEATURE DISKETTE.' INSMS1, TEXT '&THE FEATURE YOU ARE TRYING TO ACTIVATE IS NOT COMPATIBLE'/M022 INSMS2, TEXT 'WITH THIS VERSION OF THE SYSTEM DISKETTE. &THIS FEATURE' /M022 INSMS3, TEXT 'REQUIRES VERSION ' /M022 INSMS4, TEXT ', OR LATER, OF THE !&WPS-8 &D&E&CMATE SOFTWARE.' /M022 > /END ENGLSH /A002 IFDEF SPANISH < /A002 BLDWRT, TEXT 'ESCRIBIR' /A001 BLDRED, TEXT 'LEER' /A001 BLDRET, TEXT '&PULSE !&RET. PARA VOLVER AL &MEN\Z DE &CHARACTER\MSTICAS,O' BLDGMR, TEXT '&PULSE &DOR. !&MENU PARA VOLVER AL &MENU &PRINC.' /M022 BLDERM, TEXT '^P&ERROR EN UNIDAD ^D MIENTRA TRATABA DE ^S BLOQUE !D' /M022 INSMNU, TEXT '^P!E^P-- &CARACTER\MSTICAS &ESPECIALES --' /A001 INSPRG, TEXT '^P&ACTIVACI\SN EN CURSO, ESPERE ...' /A001 INSVAL, TEXT '^P&LA UNI. 1 NO CONTIENE UN DISK. DE &CARACTER\MSTICA V\ALIDO' INSMS1, TEXT '&LA CARACTER\MSTICA NO ES COMPATIBLE'/M022 INSMS2, TEXT 'CON RSTA VERSI\SN DEL DISK. SISTEMA. &ESTA CARACTER\MSTICA' INSMS3, TEXT 'REQUIERE VERSI\SN ' /M022 INSMS4, TEXT ', O POSTERIOR, DEL SOFTWARE !&WPS-8 &D&E&CMATE.' /M022 > /END SPANISH /A002 IFDEF ITALIAN < BLDWRT, TEXT 'SCRITTURA' /A001 BLDRED, TEXT 'LETTURA' /A001 BLDRET, TEXT '&PREMERE !&RITORNO PER TORNARE AL &MENU DELLE &FUNZIONI &ADDIZIONALI,' BLDGMR, TEXT 'OPPURE PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE.' /M022 BLDERM, TEXT "^P&ERRORE SULL'UNIT\A ^D IN ^S BLOCCO !D" /M022 INSMNU, TEXT '^P!E^P-- &ABILITAZIONE &FUNZIONE &ADDIZIONALE --' /A001 INSPRG, TEXT '^P&ABILITAZIONE IN CORSO, PREGO ATTENDERE...' /A001 INSVAL, TEXT "^P&L'UNIT\A 1 NON CONTIENE &FUNZIONE &ADDIZIONALE VALIDA." INSMS1, TEXT '&FUNZIONI &ADDIZIONALI NON COMPATIBILI'/M022 INSMS2, TEXT 'CON LA VERSIONE ATTUALE DEL SISTEMA. &NECESSITA' /M022 INSMS3, TEXT 'LA VERSIONE ' /M022 INSMS4, TEXT ', O UNA SUCCESSIVA, DEL SISTEMA !&WPS-8 &D&E&CMATE.' /M022 > IFDEF V30NOR < /A032 /A002 BLDWRT, TEXT 'SKRIVE' /A001 BLDRED, TEXT 'LESE' /A001 BLDRET, TEXT '&TRYKK P\E !&RETUR FOR \E F\E MENYEN !&ACTIVERE !&FUNKSJONER, EL' BLDGMR, TEXT '&TRYKK P\E &GULL !&MENY FOR \E F\E &HJOVEDMENYEN.' /M022 BLDERM, TEXT '^P&FEIL P\E STASJON ^D VED FORS\XK P\E \E ^S BLOKK !D' /M022 INSMNU, TEXT '^P!E^P-- &AKTIVERING AV &SPESIALFUNKSJON --' /A001 INSPRG, TEXT '^P&ACTIVERING P\EG\ER.&VENT...' /A001 INSVAL, TEXT '^P&STASJON 1 HAR IKKE RIKTIG DISKETT FOR SPESIALFUNKSJON.' INSMS1, TEXT '&DEN FUNKSJONEN DU FORS\XKER \E AKTIVERRE, STEMMER IKKE.' INSMS2, TEXT 'OVERENS MED VERSJONEN P\E DIN SYSTEMDISKETT. &DENNE' /M022 INSMS3, TEXT 'FUNKSJONEN FORUTSETTER VERSJON' /M022 INSMS4, TEXT ', ELLER NYERE , AV PROGRAMMET !&WPS-8 &D&E&CMATE .' /M022 > /END V30NOR /A002 IFDEF DUTCH < /A002 BLDWRT, TEXT 'SCHRIJVEN' /M003 BLDRED, TEXT 'LEZEN' /M003 BLDRET, TEXT '&DRUK !&RETURN OM TEREG TE GAAN NAAR HET MENU' /M008 BLDGMR, TEXT '&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.' /M008 BLDERM, TEXT '^P&FOUT OP AANDRIJVER ^D BIJ ^S VAN BLOK !D' /M003 INSMNU, TEXT '^P!E^P-- &ACTIVEREN VAN OPTIES --' /M003 INSPRG, TEXT '^P&BEZIG MET ACTIVEREN, EVEN GEDULD. ...' /M003 INSVAL, TEXT '^P&IN AANDRIJVER 1 ZIT GEEN OPTIE-DISKETTE.' /M003 INSMS1, TEXT '&DEZE OPTIE KAN NIET WORDEN GEACTIVEERD' /M003 INSMS2, TEXT 'MET DEZE VERSIE VAN DE SYSTEEMDISKETTE. &DEZE OPTIE' /M003 INSMS3, TEXT 'VEREIST VERSIE ' /M003 INSMS4, TEXT ' OF EEN LATERE VERSIE VAN !&WPS-8 &D&E&CMATE.' /M003 > /END DUTCH /A002 BLDBUF, ZBLOCK 400 /A001 BLDEND=. /LAST LOCATION USED THIS FIELD /A001 > /END IFDEF UNBUND /A001 XLIST / .TITLE WPINDX - INDEX COMMAND / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / / WPINDX - INDEX COMMAND / / 029 EMcD 24-Sep-85 Add Dutch and Spanish Xlations (conditional) / 028 EMcD 12-Sep-85 Add Nordic translations / (conditionalised) / 027 EMcD 11-Apr-85 Allow Dead keys in Doc name / 026 WCE 20-AUG-84 CHANGED # TO "NO." IN HEADER / 025 DFB 19-JUN-84 Set to recognize hard disk for ver 2.0 / 024 JFS 26-APR-84 Line up time / 023 JFS 20-APR-84 British/American date / 022 JFS 20-APR-84 code moved to make space for 023 / 021 WJY 06-FEB-84 DECmate I compatability / 020 TCW 27-SEP-83 Add check and text for Winchester drive / 019 HLP 31-AUG-83 Detect Uninitialized Diskette / Fixed QAR EZ-65 wrong msg CI to full disk / 018 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 017 TCW 01-JUN-83 QAR#341 reset flags after disk error / 016 AIB 30-NOV-82 QAR#215 altered index display to avoid / empty final page / 015 AIB 11-NOV-82 QAR#181 removed blank line from Index / display header, moving everything else / up one line / 014 AIB 31-AUG-82 Changed title of index display from / "DOCUMENT INDEX" to "INDEX OF DOCUMENTS" / 013 GDH 08-FEB-82 Fixed elapsed time display in CUIDT2. / 012 DFB 05-NOV-81 Add get density to set den on device / 011 GDH 16-AUG-81 De-implemented LOCK/UNLOCK code. / 010 GDH 26-AUG-81 WPFILS calling seq changes. / 009 TT 07-JUL-81 Removed superfluous conditionals / 008 DM,JM 15-SEP-80 Merged Scandi and Europe/English / 007 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 006 GLT 23-JUL-80 French grammatical fixes / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 06-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 DSS 14-FEB-80 ADDED FOREIGN DATE STUFF / 001 CW GLT 09-JAN-80 Add French Dutch and German conditionals / / French diacritical substitution: / / "["=L.A.E, "]"=L.G.E; "&" does not capitalize / / German diacritical substitutions: / / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "7" usable / III.D KEE 29-MAR-78 CHANGES FOR WT78 FILE # REPRESENTATION / / AND PUT IN SYMBOLS FOR DX REQUESTS / 2.7-5 KEE 02/15/78 SOME CLEAN UP / 2.7A-2 LDB 01/28/78 FIX I{ BUG FOR WT78 AND * BUG FOR / / DOCUMENTS WITH NO NAME / 2.7.1 KEE 11/22/77 PUT IN WT78 INDEX SPEEDUP / 2.5.1 KEE 11/04/77 FIX INDEX NOT IGNORING WORD WRAP BLANKS / / AND CARRIAGE RETURNS / 2.5-1 RLT 10/21/77 MERGE FROM WT78 PACK / 2.4B KEE 10/10/77 FIX REMEMBERANCE BUG / 2.N KEE 09/09/77 PUT IN WS102 INTERLOCKS / 2.J KEE ALLOW 'NUMBER.DOC' FOR REFERENCES / 2.G-3 MB 08/13/77 PUT INDEX IN SEPERATE OVERLAY *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLONDX 100 CDF 20 -DSONDX 0 CDFMYF= CDFBUF FIELD 2 /LOADED INTO FIELD 4 *100 /THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM /LOCATIONS USED BY INDEX CUICPO, 0 /CURRENT POSITION IN THE LINE BUFFER CUIPCT, 0 /TEMP CUIDFG, 0 /DOCUMENT FLAG 0 = NORMAL INDEX; NOT 0 = TO DOCUMENT CUIEOF, 0 /WHEN NONZERO, EOF OF INDEX DOC WAS FOUND CUIREM, 0 / neg count of docs remaining to display /A016 CUIPGE, 0 / numb of docs displayed on current screen /A016 CUIOVR, 0 /FLAG SET TO NON ZERO IF THE DISK HAS 10 BLOCKS LEFT CUIDRV, 0 /DRIVE NUMBER OF THE DRIVE WHOSE INDEX IS BEING DONE CUIDC1, 0 /FILE NUMBER (DRIVE NUMBER W DOCUMENT NUMBER) OF INDEX DOCUMENT CUIDCN, 0 /FOR CI, FILE NUMBER (DRIVE NUMBER W DOC NUMBER) OF THE DOC /TO RECEIVE THE COPY OF THE INDEX CUIDFO, 0 /DOC NUMBER OF THE DOCUMENT WHOSE INFORMATION IS CURRENTLY /BEING DISPLAYED. CUCPYC, 0 CUISTP, 0 QUBLK, DSKQUE; 0; 0 QUQBLK, ZBLOCK 17 /--------------------- PAGE /WPINDX - INDEX FUNCTION, EITHER TO DOCUMENT OR TO THE SCREEN / THE INDEX PROGRAM PRODUCES A LIST OF DOCUMENTS CURRENTLY IN EXISTENCE FOR THIS / USER. THE LIST OF DOCUMENTS IS PLACED ON THE SCREEN, AND MAY OPTIONALLY BE / WRITTEN TO A NEW OR EXISTING DOCUMENT. / THE INDEX OPERATION IS DONE IN THE FOLLOWING STEPS: / I) GET THE INFORMATION FOR THE TOP FEW LINES OF THE SCREEN. / A) READ THE ALLOC BLOCK AND EXTRACT INFORMATION FOUND THERE ONLY / B) READ THE HOME BLOCK FOR THE REST OF THE TOP INFORMATION / C) COUNT THE NUMBER OF DOCUMENTS THAT EXIST AND DISPLAY THE HEADER LINES / II) LIST ALL OF THE EXISTENT DOCUMENTS. / A) OPEN THE INDEX DOCUMENT. / B) LIST ALL THE DOCUMENTS. LIST IN GROUPS OF FIVE AT A TIME. / 1) FIRST LIST EACH DOCUMENT FOR WHICH THERE IS AN INDEX DOCUMENT ENTRY / ALONG WITH SIZE INFORMATION, ETC. MARK EACH ENTRY WHICH HAS BEEN / LISTED IN THE COPY OF THE HOME BLOCK OR BITMAP SO THAT IT WILL NOT BE / LISTED ALONG WITH THOSE DOCUMENTS WITHOUT NAMES. / 2) LIST EACH DOCUMENT WHICH WAS NOT PREVIOUSLY LISTED. / 3) FOR EACH OF THE 5 DOCUMENTS LISTED, KEEP THE NUMBER AND NAME / IN A BUFFER. / C) WHEN NOT TO A DOCUMENT, WAIT FOR THE USER TO PRESS RETURN OR GOLD MENU. / 1) WHEN THE RETURN WAS ENTERED, DISPLAY THE NEXT INDEX PAGE. / 2) FOR GOLD MENU, UPDATE THE USERS CURRENT DEFAULT FILE NUMBER AND / TERMINATE THE INDEX. / THE INFORMATION EXPECTED FROM THE MENU IS AS FOLLOWS - / MNTMP1- FOR CI COMMANDS, TYPE OF MODIFICATION OF THE OUTPUT DOCUMENT / MNTMP2- FLAG TO INDICATE INDEX TO DOCUMENT (TO DOCUMENT WHEN NONZERO) / MNTMP5- CONTAINS THE DRIVE NUMBER OR AREA NUMBER WHOSE INDEX IS TO BE DONE / MNFNO - FILE NUMBER (INCLUDING DRIVE NUMBER) OF DOCUMENT TO RECEIVE INDEX / MNDRV - DRIVE NUMBER OF DOCUMENT TO RECEIVE COPY OF INDEX / MNFMAT- DATE/CURRENCY CODE /DEFINED CONSTANTS / BUFFERS LENBFD=400 LENBF1=400 LENTBF=1200 /NAMES AND DOCUMENT NUMBERS FOR 5 DOCUMENTS /(ENTRIES 200 WORDS EACH) LENBAD=300 /THE NEXT HIGHEST MULTIPLE OF 100 AFTER 2 LINES OF /80 CHARACTERS FOR AN ENTRY CUIBFD=3200 /BUFFER USED TO HOLD HOME BLOCK/BITMAP PACKET CUIBF1=CUIBFD+LENBFD /BUFFER TO HOLD HEADER BLOCK/INDEX INFORMATION PACKET /FOR DOCUMENT CURRENTLY BEING DISPLAYED. CUIBAD=CUIBF1+LENBF1 /BUFFER USED TO BUILD LINE FOR DISPLAY ON THE SCREEN CUITBF=CUIBAD+LENBAD /BUFFER USED TO STORE THE DOCUMENTS NAMES AND NO. THAT /ARE ON THE SCREEN. EACH ENTRY IS ALLOWED 200 WORDS, /SO THAT 5 ENTRIES MAY BE DISPLAYED AT A TIME IFNZRO 6000-CUITBF-LENTBF&4000 /(SCROLL BUFFERS BEGIN AT 6000) /STARTING COLUMN FOR EACH FIELD IN THE INDEX DECIMAL IFDEF ENGLSH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF ITALIAN < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF V30NOR < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF V30SWE < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF DUTCH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=52 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > IFDEF SPANISH < CUINMB=0 /NUMBER CUINME=8 /NAME CUICRE=29 /CREATION DATE CUIERO=29 /ERROR MESSAGE CUIMOD=38 /LATE MODIFIED DATE CUISIZ=53 /DOCUMENT SIZE CUIVER=58 /VERSION CUILTE=67 /THE TIME OF THE LATE EDIT (DELTA TIME) CUITTE=74 /THE TOTAL TIME SPENT ON THIS DOCUMENT EDITING > / MISCELLANEOUS CONSTANTS OCTAL OFSBTM=12 /OFFSET OF INDIVIDUAL FILE POINTERS WITHIN HOME BLOCK TAB=11 SPACE=40 BS=10 /BACK SPACE INDICATING START OF DEAD KEY WRAPBT=2000 /WORD WRAP BIT BELL=7 /CONTROL-G (NEEDS-WORD-WRAPPING) LT=74 /LEFT ANGLE BRACKET FF=14 /FORM FEED (NEW PAGE OF SOME VARIETY) ERBIT=4000 /ERROR BIT FOR HANDLER CALLS CUIRTZ, XX /CUINDX - INDEX COMMAND JMS CUINDX CDIMNU JMP I CUIRTZ /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 CUISTR, XX /STORE DOCUMENT NO. CONVERTED TO ASCIZ INTO FNAMBF. DCA T1 /SAVE CHAR RDF; TAD CIDF0 /COMPUTE RETURN FIELD DCA CUISTX /AND STORE FOR RETURN CDFMNU TAD T1 DCA I CUISTP /STORE INTO MENU NAME BUFFER ISZ CUISTP /BUMP PTR (NO. BETTER BE LESS THAN STRLEN) CUISTX, .-. JMP I CUISTR / CUICLS -- takes care of the positioning for the screen /R016 CUICLS, XX /R016 CLA /R016 TAD CUIDFG / don't erase if going to a document /R016 SZA CLA /R016 JMP I CUICLS /R016 CIFMNU /R016 JMS I IOACAL /R016 0 / go directly to the screen /R016 CUICSR / ^P!E /R016 600 /R016 JMP I CUICLS /R016 CUIFNO, 0 CUIDST, ZBLOCK STRLEN IFNZRO CUIFNO+1-CUIDST /---------------- PAGE CUINDX, XX /INDEX COMMAND / I) GET INFORMATION FOR THE TOP LINES OF THE LISTED INDEX CLA DCA CUIOVR /CLEAR THE OVERFLOW DISK FLAG TAD (CUIBAD) DCA CUICPO /SET THE STARTING POINTER TO LINE BUFFER DCA CUINFS /ZERO TOTAL DOCUMENTS PROCESSED CDFMNU TAD I (MUBUF+MNTMP5) CDFMYF DCA CUIDRV /SAVE TAD CUIDRV /BUILD INDEX NUMBER WITH DRIVE NUMBER BSW RTL CLL IAC DCA CUIDC1 JMS CUICKW / CK FOR WINCHESTER DRIVE INST. /A020 TAD CUIDRV /CURRENT DRIVE /A012 DCA QUQBLK+RXQDRV /A012 TAD (RXEDN+4000 /SET GET DEN CMND /A012 DCA QUQBLK+RXQFNC /A012 JMS QURX /A012 SPA CLA /ERROR? /A012 JMP CUIDER /YES /A012 JMS CUINGD /SEE IF GOING TO A DOCUMENT RIF TAD CDF0 DCA QUQBLK+RXQBFD /SET FIELD TAD (CUIBFD /GET BUFFER ADDRESS DCA QUQBLK+RXQBAD / A) FOR NON-78 ASSEMBLIES - / 1) READ THE ALLOC BLOCK AND EXTRACT ITS INFORMATION / - TOTAL NUMBER OF BLOCKS IN THE FILE SYSTEM / - NUMBER OF REMAINING FREE BLOCKS / 2) READ THE HOME BLOCK AND GET THE REST OF ITS INFORMATION / - THE FLOPPY NAME / - THE MAXIMUM NUMBER OF FILES ON THE FLOPPY (NEGATIVE) TAD (RXERD+ERBIT /ERROR RECOVER READ DCA QUQBLK+RXQFNC TAD CUIDRV /SET THE DRIVE IN THE Q BLOCK DCA QUQBLK+RXQDRV TAD (RXBALC /GET ALLOC BLOCK FIRST DCA QUQBLK+RXQBLK JMS QURX SPA CLA JMP CUIDER /DISK ERROR TAD CUIBFD+1 /GET BLOCK TYPE /A019 AND (70) /A019 TAD (-40) /SEE IF REALLY IS ALLOC BLOCK /A019 SZA CLA / /A019 JMP CUIINV /NO, INVALID DISK /A019 TAD CUIBFD+2 /GET # OF BLOCKS IN FILE SYSTEM DCA CUINBF TAD CUIBFD+3 /AND # FREE DCA CUINFB TAD (RXBDIR /NOW READ IN HOME BLOCK AND LEAVE IN CORE DCA QUQBLK+RXQBLK JMS QURX SPA CLA JMP CUIDER /DISK ERROR TAD CUIBFD+1 / GET THE BLOCK TYPE /A019 AND (70) /A019 TAD (-30) / SEE IF HOME BLOCK /A019 SZA CLA / /A019 JMP CUIINV / INVALID WPS DISK /A019 TAD (CUIBF1 /CONVERT THE FLOPPY NAME DCA CUIB1P /SAVE BUFFER 1 PTR, TO CONVERT NAME TO ASCII DCA CUICNT /INIT COUNT OF BYTES TAD (-6 /INIT MAX CHARACTERS COUNTER DCA CUITMP CUIND2, JMS GETCHR /GET NEXT BYTE CUICNT CUIBFD+2 SNA TAD (-37 /ZERO IS END TAD (37 /MAKE ASCII DCA I CUIB1P ISZ CUIB1P /SAVE AND DO NEXT BYTE ISZ CUICNT ISZ CUITMP JMP CUIND2 DCA CUIBF1+6 /ENSURE THAT IT'S ASCIZ TAD CUIBFD+11 /INITIAL NEG MAX NUMBER OF DOCUMENTS DCA CUIDPC / B) COUNT THE NUMBER OF DOCUMENTS AND DISPLAY THE HEADER TAD (CUIBFD+OFSBTM-1 /INIT ADDR TO CHECK TO COUNT DCA X0 TAD CUIDPC /NUMBER OF DOCS MAX (NEGATIVE) DCA T1 CUIND1, TAD I X0 /GET WORD SZA CLA ISZ CUINFS /GOT ANOTHER ONE ISZ T1 /INCR MAX COUNT JMP CUIND1 /TRY ANOTHER ONE JMP CUIN2A /NEXT PAGE / CLEAN UP AND TERMINATE / 1 - IF TO A DOCUMENT, / CLOSE THE DOCUMENT / CLEAR TO TO DOCUMENT FLAG / 2 - IF WT78 / CLOSE THE INDEX DOCUMENT / IF AT LEAST ONE DUCUMENT WAS LISTED, SEND A QUIT INDEX CUINDR, CLA TAD CUIDFG /IF GOING TO A DOCUMENT WHEN DONE CLOSE IT. SNA CLA JMP CUIN4D DCA CUIDFG /CLEAR FOR NEXT TIME CIFFIO FILEIO XDSKCL /CLOSE /M0010 CUIN4D, JMP I CUINDX /RETURN CUIB1P, 0 CUITMP, 0 /R016 /----------------- PAGE CUIN2A, TAD CUINFS / MAKE COUNTER FROM NUMBER OF DOCS /A016 CMA IAC /A016 DCA CUIREM /A016 TAD CUIDRV /PUT DRIVE NUMBER IN DISPLAY REQUEST DCA CUIDRN IFDEF CONDOR < /A020 JMS CUICKW / CK FOR WINCHESTER DRIVE /A020 > / END IFDEF CONDOR /A020 JMS CUIPDS /DISPLAY THE TOP LINES /II. LIST ALL EXISTENT DOCUMENTS. /R016 / A) OPEN THE INDEX DOCUMENT /R016 TAD (CUIBFD+OFSBTM /INIT PTR AND COUNT FOR ENTRY SEARCH /R016 DCA CUIDPT /R016 TAD (CUIBF1 /PATCH WHERE WE READ TO BE BUFFER DCA QUQBLK+RXQBAD DCA CUIEOF TAD CUIDC1 /OPEN INDEX DOCUMENT FOR READ CIFFIO FILEIO XRDFIN /M0010 / B) LIST ALL DOCUMENTS IN GROUPS OF FIVE AT A TIME. CUIND3, CLA /GET 5 ENTRIES TAD (-5 DCA CUICNT DCA CUIPGE / clear displayed doc count for this page /A016 JMS CUICLS /POSTIONS THE CURSOR AND CLEARS THE SCREEN CUIND4, JMS CUIENT /DO ENTRY PROCESSING / C) FOR EACH OF THE FIVE LISTED DOCUMENTS, KEEP ITS NAME AND NUMBER IN A / BUFFER. / FIRST COMPUTE THE BUFFER SLOT TO BE USED. THE FORMULA USED: / SLOT = BUFFER START + 200 * (NUMBER OF ENTRIES ON PAGE) - 200 TAD CUIPGE / this numb is bumped by CUIENT by CUIDSP /M016 BSW CLL RAL /TIMES 200 TAD (CUITBF-200) /PLUS BUFFER ADDRESS - 200 DCA CUIN4A /SAVE IN COPY CALL TAD CUID1 /GET DOCUMENT NUMBER (WITHOUT DRIVE) DCA CUIFNO JMS CUCOPY /COPY NAME AND NUMBER CUIFNO CDFMYF CUIN4A, 0 CDFMYF STRLEN+1 TAD CUIREM /END OF DOCUMENTS? /M016 SNA CLA /M016 JMP CUIND5 /YES ISZ CUICNT /NEXT? JMP CUIND4 JMS CUIWAT /WAIT FOR USER TO TYPE SOMETHING /A016 JMP CUINDR / :G:Menu -- return to main menu /A016 JMP CUIND3 / :RETURN -- continue with next entry /A016 CUIND5, JMS CUIWAT /WAIT FOR USER TO TYPE SOMETHING JMP CUINDR / :G:Menu -- return to main menu JMP CUINDR / :RETURN -- return to main menu anyway /M016 CUICNT, 0 CUIINV, / INVALID DISK INSTALLED /A019 CDFMNU / SET UP CODE FOR MENU /A019 AC0004 / /A019 DCA I (MUBUF+MNTMP1 / /A019 CDFMYF / /A019 CIFMNU / GO TO A MENU /A019 JMS I MNUCAL / AND TELL USER /A019 DLMEM1 / MENU BLOCK /A019 JMP CUINDR / /A019 IFNZRO 200-STRLEN-1&4000 /------------------------- PAGE /CUIWAT - WAIT FOR USER TO DO SOMETHING / C) WHEN NOT TO A DOCUMENT, WAIT FOR THE USER TO PRESS EITHER RETURN OR GOLD M / 1)WHEN RETURN IS PRESSED, SIMPLY GET THE NEXT SCREENFUL CUIWAT, XX CLA TAD CUIDFG /IF SET FOR DOCUMENT THE USER CANNOT RESPOND SO RETURN SNA CLA JMP CUIWAJ TAD CUIOVR /SEE IF THE DISK HAS OVERFLOWED IF SO PUT UP ERROR MESS SZA CLA JMP CUIFLL JMP CUIWAC /NOT OVERFLOWED RETURN CUIWAJ, TAD CUIPGE / GET NUMBER OF ENTRIES /M016 CDFMNU DCA I (MUBUF+MNTMP1) /SAVE IN TEMP1 TAD CUIREM / pass number of undisplayed docs /A016 DCA I (MUBUF+MNTMP2) /A016 CDFMYF CIFMNU JMS I MNUCAL /CALL MENU DLMIN2 CDFMNU TAD I (MUBUF+MNTMP1) /GET TEMP1 CDFMYF SZA /ZERO MEANS JUST RETURN PRESSED JMP CUIWA1 /OTHERWISE SET REMEMBERENCE AND RETURN TO CALLER CUIWAC, ISZ CUIWAT /SKIP RETURN CUIWAR, JMP I CUIWAT / 2) WHEN GOLD MENU IS PRESSED, REMEMBER THAT THE USERS LAST USED DOCUMENT / IS THE ONE MARKED BY THE ASTERISK CUIWA1, BSW /GET BUFFER ADDRESS = BASE + 200 * (ENTRY NUMBER FROM CLL RAL /SCREEN) TAD (CUITBF-200) /ADD OFFSET DCA CUIWA2 /SAVE TAD CUIDRV / DCA T3 TAD I CUIWA2 CDFMNU /SAVE SNA /DOCUMENT NUMBER NON-ZERO? JMP CUIWA6 /ZERO, DON'T ADD DRIVE NUMBER IN (THIS FILE NUMBER /IS IN ERROR) DCA I (MUBUF+MNDOCN /STORE DOCUMENT NUMBER, ETC. TAD T3 /THEN STORE DRIVE NUMBER DCA I (MUBUF+MNDRV) TAD T3 /PLACE DRIVE NUMBER WITH DOCUMENT NUMBER BSW RTL CLL TAD I (MUBUF+MNDOCN) CUIWA6, DCA I (MUBUF+MNFNO) /STORE ZERO OR FILE NUMBER 'MNFNO' TAD I (FNAMSP CDFMYF DCA CUIWA5 TAD CUIWA2 /NOW COPY NAME IAC /(SKIP THE WORD WITH THE FILE NUMBER) DCA CUIWA4 TAD I CUIWA4 /CHECK FOR NO NAME SNA CLA JMP CUIWA7 /YES, USE NO. JMS CUCOPY CUIWA4, 0 CDFMYF CUIWA5, 0 CDFMNU STRLEN JMP I CUIWAT /DONE - NON-SKIP CUIWA7, TAD CUIWA5 DCA CUISTP /SET UP PTR TAD CUIWA2 DCA CUIWA8 CIFMNU JMS I IOACAL /CONVERT NO. TO ASCIZ CUISTR CUISTT CUIWA8, .-. CLA JMS CUISTR /STORE 0 FOR END JMP I CUIWAT /RETURN CUISTT, TEXT '!D' CUIOUS, XX /OUTPUTS TO THE SCREEN AND P377 /GET RID OF ANY FUNNIES /M027 TAD (-TAB) /MAKE TABS SPACES SNA TAD (SPACE-TAB) TAD (TAB) JMP CUIOSS CUIOSW, CIF 0 JWAIT CUIOSS, CIF 0 TTYOU JMP CUIOSW JMP I CUIOUS CUIWA2, 0 /R016 CUIFLL, /DISPLAY ERROR IN CI COMMAND IF THERE ARE 10 BLOCKS OR FEWER / ON THE DISKETTE CIFMNU JMS I IOACAL /CLEAR THE SCREEN 0 CUICSR 0 CDFFIO / /M0010 TAD I (SCFSPC) /PUT UP THE NUMBER OF BLOCKS LEFT CDFMNU /THIS WAS MISSING CAUSING BUG EZ-65 /A019 DCA I (MUBUF+MNTMP2) AC0003 /SET TO 3 TO TELL THE MENU WHICH DISPLAY DCA I (MUBUF+MNTMP1) CDFMYF CIFMNU JMS I MNUCAL DLMEM1 JMP CUIWAR /-------------------- PAGE /CUIENT - DO NEXT ENTRY / B) LIST ALL THE DOCUMENTS. LIST IN GROUPS OF FIVE AT A TIME. / 1) FIRST LIST EACH DOCUMENT FOR WHICH THERE IS AN INDEX DOCUMENT ENTRY / ALONG WITH SIZE INFORMATION, ETC. MARK EACH ENTRY WHICH HAS BEEN / LISTED IN THE COPY OF THE HOME BLOCK OR BITMAP SO THAT IT WILL NOT BE / LISTED ALONG WITH THOSE DOCUMENTS WITHOUT NAMES. CUIENT, XX CLA /INIT NAME PTRS TAD (CUIDST DCA CUINP TAD CUIEOF /END OF FILE ON INDEX FILE - CHECK FOR UN-OUTPUTTED SZA CLA JMP CUIEN1 /GO LOOK FOR THEM JMS CUISRC /LOOK FOR NEXT CUIBN JMP CUIEO1 /EOF TAD (-STRLEN /MAX NUMBER OF CHARS IN DISPLAYED NAME DCA CUIECT CUIEL1, /ASSUME AC ZERO HERE JMS CUIGCH /GET NEXT CHAR JMP CUIEO1 /EOF TAD (-LF /IS IT EOL? SNA JMP CUIEGN /YES - END OF NAME, GET NUMBER TAD (LF-LT /LEFT ANGLE BRACKET? SNA JMP CUIEGN /YES TAD (LT-TAB /TAB? SNA JMP CUIEGN /YES TAD (TAB-FF /FF OF SOME SORT? SNA JMP CUIEGN TAD (FF DCA I CUINP /SAVE AS NEXT CHAR OF NAME ISZ CUINP /NEXT TIME NEXT CHAR ISZ CUIECT /INCR COUNT JMP CUIEL1 /LOOP CUIEGN, DCA I CUINP /ZERO LAST BYTE FOR ASCIZ JMS CUISRC /SEARCH FOR <#> CUIBNO JMP CUIEO1 JMS CUINUM /GET NUMBER JMP CUIEO1 /EOF DCA CUIFNO /SAVE NUMBER TAD CUIFNO JMS CUIDSP /DISPLAY INFO JMP I CUIENT /DONE CUIEO1, AC7777 /DON'T DO FILE STUFF NEXT TIME DCA CUIEOF / 2) LIST EACH DOCUMENT WHICH WAS NOT PREVIOUSLY LISTED. CUIEN1, CLA TAD I CUIDPT /GET DIR PTR SPA JMP CUIEN2 /NEGATIVE MEANS ENTRY ALREADY SHOWN SZA JMP CUIEN3 /NOT SHOWN - DO IT CUIEN2, ISZ CUIDPT /INCR PTR ISZ CUIDPC /AND COUNT JMP CUIEN1 /DO ANOTHER ENTRY JMP I CUIENT /DONE - RETURN CUIEN3, CLA TAD CUIDPT /GET ADDR CHECKED TAD (-CUIBFD-OFSBTM+1 /MAKE INTO A FILE NUMBER DCA CUIFNO DCA CUIDST /ZAP STRING TO ASCIZ EMPTY TAD CUIFNO /GET NUMBER JMS CUIDSP /DISPLAY IT JMP I CUIENT /RETURN TO CALLER CUINP, 0 CUIECT, 0 CUIDPT, 0 CUIDPC, 0 / GET THE NEXT CHARACTER FROM THE DOCUMENT THAT 'RDFIL' CURRENTLY HAS OPEN - / UPON ENTRY - / AC ZERO, GET THE NEXT CHARACTER FROM THE DOCUMENT / NONZERO, RETURN THE LAST CHARACTER A SECOND TIME / PAR 1 LOCATION RETURNED TO WHEN EOF IS ENCOUNTERED / 'RDFIL' HAS A DOCUMENT OPENED. / UPON RETURN - / AC NEXT CHARACTER, WITH THE FOLLOWING EXCEPTIONS - / WORD-WRAP BLANKS AND RETURNS / START AND END OF DEADKEY / 'NEEDS-WORD-WRAP' CHARACTERS CUIGCH, XX /GET CHAR FROM DOCUMENT SNA CLA /RETURN LAST CHARACTER AGAIN? JMP CUIGC2 /NO, GET NEXT ONE INSTEAD. TAD CUIBK JMP CUIGC1 CUIGC2, CIFFIO FILEIO XRDFNC /GET NEXT CHAR /M0010 SPA SNA JMP I CUIGCH /EOF OR DISKERR CUIGC1, DCA CUIBK /SAVE BACKUP TAD CUIBK TAD (-WRAPBT-LF) /IGNORE WORD WRAP CR SZA TAD (WRAPBT+LF-WRAPBT-SPACE) /OR WORD WRAP BLANKS SNA CLA /EITHER? JMP CUIGC2 /YES, ONE OR THE OTHER - GET NEXT CHARACTER TAD CUIBK /GET CHARACTER AND P177 /ONLY LOW ORDER BITS TAD (-BS /IGNORE BACKSPACE (START OF DEADKEY) /d027 SNA /d027 JMP CUIGC2 IAC /AND ALSO CNTRL-G ('NEEDS-WORD-WRAP') SNA JMP CUIGC2 /d027 TAD (BELL-CR /BETTER IGNORE CR ALSO (END OF DEADKEY) /d027 SNA /d027 JMP CUIGC2 TAD (BELL /GET CHAR BACK /M027 ISZ CUIGCH /SKIP EOF RETURN JMP I CUIGCH /RETURN CUIBK, 0 IFNZRO 7-BELL /-------------------------------- PAGE CUIBN, "<-200; "N-200+40; ">-200; 0 CUIBNO, "<-200; "#-200; ">-200; 0 CUIDSP, XX /DISPLAY INFO ABOUT DOCUMENT AND P377 DCA CUIDFO /SAVE THE FILE NUMBER DCA CUID1 /INIT FILENO ISZ CUIPGE / count docs displayed on this page /A016 TAD CUIDFO /CHECK IT SNA JMP CUIDBN SPA JMP CUIDBN TAD (-MAXDOC SMA CLA JMP CUIDBN /DISPLAY BAD NUMBER TAD CUIDFO /GET HEADER BLOCK NUMBER TAD (CUIBFD+OFSBTM-1 DCA T1 TAD I T1 SNA JMP CUIDBN /DOESN'T EXIST SMA / if >0, incr undisplayed doc counter /A016 ISZ CUIREM /A016 NOP /A016 SMA /MAKE IT NEGATIVE IF IT ISN'T ALREADY CIA /SO THAT WE REMEMBER THAT WE DISP'ED IT DCA I T1 TAD I T1 CIA /GET POSITIVE DCA QUQBLK+RXQBLK JMS QURX /GET HEADER SPA CLA /CHECK ERROR CODES JMP CUIDBN TAD CUIDFO DCA CUID1 CIFMNU JMS I IOACAL /RETURNS AC=0 CUIOUT CUID10 CUID1, 0 JMS CUIPOS CUINME /DO THE NAME CIFMNU JMS I IOACAL CUIOUT CUIDS2 CUIDST JMS NWLINE /NEXT LINE, RETURNS AC=0 JMS CUIPOS CUICRE TAD (CUIBF1+6) /DISPLAY THE CREATED DATE JMS CUIDDT /RETURNS AC=0 NOP /IGNORE 'NODATE' JMS CUIPOS CUIMOD /DISPLAY THE DATE/TIME LAST MODIFIED TAD (CUIBF1+10) /OUTPUT THE DATE JMS CUIDDT JMP CUIDN6 /SKIP IF NO DATE TAD CUIBF1+14 /ELSE, OUTPUT TIME /A022 BSW /A022 AND P77 /A022 DCA CUID6 /SAVE THE HOURS /A022 TAD CUIBF1+14 /FETCH MINUTES /A022 AND P77 /A022 DCA CUID7 /A022 JMS CUIPOS /TAB TO TIME COLUMN /A024 CUIMOD+11 /A024 CIFMNU /A022 JMS I IOACAL /A022 CUIOUT /A022 CUIDS4 /A022 CUID6, 0 /A022 CUID7, 0 /A022 CUIDN6, JMS CUIPOS CUISIZ /SIZE CIFMNU JMS I IOACAL CUIOUT CUIDS5 CUIBF1+5 JMS CUIPOS CUIVER /VERSION CIFMNU JMS I IOACAL CUIOUT CUIDS6 CUIBF1+12 JMS CUIPOS CUILTE /DISPLAY TIME EDITED IFNDEF ITALIAN < TAD CUIBF1+16 JMS CUIDT2 /RETURNS AC=0 JMS CUIPOS CUITTE /DISPLAY TOTAL TIME EDITED TAD CUIBF1+17 JMS CUIDT2 > CUIDSR, JMS NWLINE /GO TO NEXT LINE JMS NWLINE /GO TO NEXT LINE JMP I CUIDSP /AND RETURN TO CALLER /----------------------------- PAGE /CUIDDT - DISPLAY THE DATE THAT IS POINTED TO BY AC / THE FIRST WORD HAS DATE, PACKED MONTH, DAY / THE SECOND WORD CONTAINS THE YEAR. / CUIPCT CONTAINS THE DATE SEPARATOR CUIDDT, XX DCA T1 /SAVE THE DATE ADDRESS TAD I T1 SNA JMP CUIDTN /IF ZERO DISPLAY 'NODATE' AND P77 /ELSE, UNPACK MO/DAY DCA CUID3 TAD I T1 BSW AND P77 DCA CUID2 /SET UP AS IF DD/MM/YY ISZ T1 /POINT TO YEAR /A023 TAD I T1 DCA CUID4 CDFMNU /A023 TAD MNDSEP+MUBUF /A023 DCA CUIPCT /SET UP SEPARATOR FOR IOA /A023 AC0002 /A023 AND MNFMAT+MUBUF /DMYDAT SELECTED? /A023 SNA /A023 JMP CUIDD8 /DONE IF REALLY DMY /A023 AC0001 /A023 AND MNFMAT+MUBUF /NO, IS IT YMD? /A023 SNA CLA /A023 JMP CUIDD0 /A023 TAD CUID4 /YES, IT'S YMD, SO /A023 MQL / SWITCH Y,D /A023 TAD CUID2 /A023 DCA CUID4 /A023 JMP CUIDD5 /A023 CUIDD0, /NO, IT'S MDY, SO /A023 TAD CUID3 / SWITCH M,D /A023 MQL /A023 TAD CUID2 /A023 DCA CUID3 /A023 CUIDD5, /A023 ACL /COMPLETE DAY MOVE /A023 DCA CUID2 /A023 CUIDD8, /A023 CDFMYF /A023 CIFMNU JMS I IOACAL CUIOUT CUIDS3 CUID2, 0 /DATE VALUES /A023 CUISEP, CUIPCT /A023 CUID3, 0 CUIPCT /A023 CUID4, 0 ISZ CUIDDT JMP I CUIDDT CUIDTN, CIFMNU JMS I IOACAL CUIOUT CUIDN2 / "NO/DA/TE" JMP I CUIDDT CUIPOS, XX /SIMULATE TAB IN LINE BUFFER, CUIBAD / Call: AC=0 /A022 / JMS CUIPOS / / Return: AC = 0 TAD I CUIPOS /Get the column position TAD (CUIBAD) /MAKE IT A buffer pointer ISZ CUIPOS /Increment the argument pointer for return CIA /Negate the value of the buffer address TAD CUICPO /Get current pos.(AC=# columns to desired col) SMA JMP CUIPRT /Exit if currrent position after desired pos DCA CUIPCT /Store the # of columns to get to desired col TAD (TAB) /INSERT A TAB FOR A DOCUMENT JMS CUIOUT ISZ CUIPCT /Increment positions to move SKP /Skip if not done. JMP CUIPRT /IF ONLY ONE CHAR TO INSERT RETURN CUIPLP, TAD (WRAPBT+SPACE) /FILL REST WITH SPECIAL SPACES FOR THE EDITOR JMS CUIOUT /OUTPUT A JUSTIFYING SPACE ISZ CUIPCT /Increment the spaces-to-be-output counter JMP CUIPLP /Not done: loop CUIPRT, /Finished: Exit. CLA JMP I CUIPOS / CUISRC - SEARCH FOR STRING IN DOCUMENT CURRENTLY OPEN BY 'RDFIL' / CALL: / JMS CUISRC / ADDRESS OF ASCII STRING TO BE MATCHED, ENDING WITH ZERO / RETURN LOCATION WHEN NO MATCH FOUND BEFORE EOF / MATCH RETURN / ON RETURN - / AC NORMAL RETURN - 0 / ERROR RETURN - UNCERTAIN / T1,T2 CLOBBERED /A022 / THE LAST CHARACTER TAKEN FROM THE DOCUMENT MATCHED THE LAST CHARACTER / OF THE STRING. CUISRC, XX /SEARCH FOR STRING IN DOCUMENT AC7777 DCA CUIFRS /RETURN THE LAST CHARACTER A SECOND TIME CUISR1, TAD I CUISRC /GET ARG DCA CUISSP /SAVE AS STRING PTR CUISR2, AC0001 /RETURN LAST CHAR AGAIN ISZ CUIFRS /FIRST CALL? CLA /NO, RETURN NEXT CHARACTER FROM FILE JMS CUIGCH /GET NEXT CHAR JMP CUISR3 /NON-SKIP EOF RETURN CIA /COMPARE WITH NEXT CHAR IN STRING TAD I CUISSP /GET THE CHAR SZA CLA JMP CUISR1 /NO - RE-INIT ISZ CUISSP /GET NEXT CHAR FROM STRING TAD I CUISSP /END? SZA CLA JMP CUISR2 /NO - CHECK NEXT CHAR ISZ CUISRC /YES - ALL DONE - SKIP RETURN CUISR3, ISZ CUISRC JMP I CUISRC /RETURN CUISSP=T2 /CHAR PTR /A022 CUIFRS=T1 /FLAG TO INDICATE FIRST PASS THRU SEARCH LOOP - /IF FIRST PASS, RETURN LAST FILE CHARACTER A SECOND TIME. CUINUM, XX /PICK UP THE NUMBER FROM THE DOCUMENT CURRENTLY OPEN TO 'RDFIL' DCA CUINNV /INIT VALUE (ASSUME AC ZERO HERE) CUINL1, /ASSUME AC ZERO HERE JMS CUIGCH /GET CHAR JMP I CUINUM /NON-SKIP RETURN TAD (-72 /NUMERIC? SMA JMP CUINDN /DONE TAD (LF SPA JMP CUINDN /STILL NO DCA T1 /SAVE TAD CUINNV CLL RTL TAD CUINNV CLL RAL TAD T1 DCA CUINNV JMP CUINL1 /LOOP - NEXT CHAR CUINDN, CLA TAD CUINNV ISZ CUINUM /SKIP RETURN JMP I CUINUM /RETURN CUINNV=T2 /NUMBER ACCUMULATOR /A022 /------------------------------------------- PAGE CUIPDS, XX /THE FIRST N LINES DISPLAYED AND NOT ERASED CIFMNU JMS I IOACAL 0 CUICSR /CLEAR THE SCREEN 0 CIFMNU JMS I IOACAL /PUT THE RULER AND START IF PRINTER CONTROL IN CUIOUD CUIDS2 CUIDRL CIFMNU /DISPLAY THE DOCUMENT INDEX MESSAGE JMS I IOACAL CUIOUT CUILN1 JMS NWLINE CIFMNU JMS I IOACAL /OUTPUT THE STATUS LINE CUIOUT CUIIS1 CUISA1, CUIWS1 / ADDR OF SUB-STRING /A020 CUIDRN, 0 CUIBF1 CUINFS, 0 CUINFB, 0 CUINBF, 0 JMS NWLINE /NEXT LINE JMS CUIDOT /OUTPUT ------ JMS NWLINE /NEXT LINE JMS CUITLN /DISPLAY THE first line of COLUMN INFO CUITP1 /"Document" CUICRE /column for creation date CUITNL /"null" to INSERT A TAB (for document) CUIMOD /column for last modified date CUITNL /"null" to insert a tab (for document) CUISIZ /column for document size CUITNL /"null" to insert a tab (for document) CUIVER /column for document version number CUITNL /"null" to insert a tab CUILTE /column for the time of the last edit CUIP11 /"Elapsed Time" 0 /end of list JMS NWLINE JMS CUITLN /Display the second line of column info CUITP2 /"Number Name" CUICRE /column for creation date/time CUITP3 /"Created" CUIMOD /column for modification date/time CUITP4 /"modified" CUISIZ /column for document size CUITP5 /"Size" CUIVER /column for version number CUITP6 /"Version" CUILTE /column for time of last edit CUITPE /"Last" CUITTE /column for total time spent editing CUIP13 /"Total" 0 /end of list JMS NWLINE /NEXT LINE JMS CUIDOT /DISPLAY ----- JMS NWLINE /NEXT LINE CIFMNU JMS I IOACAL /PUT IN THE END OF PRINTER CONTROL CUIOUD CUIDS2 CUIDR2 JMP I CUIPDS CUIDT2, XX /DISPLAY THE TIME FROM WHAT IS IN THE AC. / THE FORMAT IS IN MINUTES AND IS DISPLAYED IN HOURS AND MINUTES. / the elapsed time is given in minutes and is to be taken to be a positive/M013 / value. ie. 4000 is taken to mean 34 hrs, 8 minutes. 4001 is 34:09, etc. /M013 / RETURNS AC=0 IFNDEF ITALIAN < MQL DCA CUID2T /CLEAR THE HOUR COUNTER MQA SMA JMP CUIDL2 /Skip if elapsed time more than 34:07 /A013 CUIDL1, TAD (-74) / 1 less Hr. /A013 SMA / skip if still more than 34:07 /A013 JMP CUIDL3 / Jmp if new time less than or equal to 34:07 /A013 ISZ CUID2T / 1 more Hr. /A013 JMP CUIDL1 / do this again. /A013 CUIDL2, TAD (-74) /GET HOURS SPA JMP CUIDL4 CUIDL3, ISZ CUID2T JMP CUIDL2 CUIDL4, TAD (74) DCA CUID3T /STORE THE MINUTES CIFMNU JMS I IOACAL CUIOUT CUIDS4 CUID2T, 0 CUID3T, 0 > JMP I CUIDT2 CUIOUT, XX /OUTPUT ROUTINE FOR SCREEN OR GO TO DOCUMENT OPTION DCA T1 /SAVE THE CHARACTER TO OUTPUT RDF TAD CIDF0 /MAKE CROSS FIELD CALLABLE DCA CUIOUX CDFMYF TAD T1 /Get the character to output SNA JMP CUIOUX /SKIP NULLS DCA I CUICPO /STORE IN BUFFER ISZ CUICPO /Increment the buffer pointer CUIOUX, 0 /Restore field JMP I CUIOUT /Exit CUITLN, XX /DISPLAY THE IOA TEXT STRINGS THAT ARE PASSED / TO IT BY ARGUMENTS BY THE CALLER. THE NEXT ARGUMENT TELLS WHERE / HORIZONTALLY TO MOVE AFTER THE DISPLAY. TO MAKE THE DOCUMENT APPEAR THE SAME / A TAB HAS TO BE INSERTED INTO THE DOCUMENT INSTEAD OF THE MOVE IF THE / DOCUMENT OPTION IS BEING USED. / CALL: JMS CUITLN / ADDRESS IF 6-BIT IOA STRING - NO ARGS. / LOCATION TO MOVE OR ZERO FOR THE END CUITLP, CLA /Clear the AC TAD I CUITLN /Get the string address ISZ CUITLN /Increment the arg pointer DCA CUITL1 /Store the string address CIFMNU JMS I IOACAL /Print the IOA string CUIOUT /Using this output routine CUITL1, 0 /Address of the string to be printed TAD I CUITLN /Get the column to print the next string at ISZ CUITLN /Increment the col pointer SNA JMP I CUITLN /If col is Zero then exit DCA CUITL2 /Otherwise store the column position JMS CUIPOS /Position the cursor or make tabs in document CUITL2, 0 /column position JMP CUITLP /Loop for next argument set /----------------------------------- PAGE / IOA OUTPUT STRINGS CUIIS1, IFDEF ENGLSH < TEXT '&^S: ^D, &NAME: ^A, &NO. OF &DOCS: ^D, &BLOCKS LEFT: ^D (OF ^D)' > /C026 IFDEF ITALIAN < TEXT '&^S: ^D, &NOME: ^A, &QUANTIT\A: ^D, &BLOCCHI LIBERI: ^D (SU ^D)' > IFDEF V30NOR < TEXT '&^S: ^D, &NAVN: ^A, &ANT. DOK.: ^D, &LEDIGE BLOKKER: ^D (AV ^D)'> /A028 IFDEF V30SWE < TEXT '&^S: ^D, &NAMN: ^A, &ANTALDOK: ^D, &LEDIGA BLOCK: ^D (AV ^D)'> IFDEF DUTCH < TEXT '&^S: ^D, &NAAM: ^A, &AANTAL DOCUMENTEN: ^D, &VRIJE BLOKKEN:' *.-1 TEXT '& ^D (UIT ^D)' > IFDEF SPANISH < TEXT '&^S: ^D, &NOM: ^A, &NO. DE &DOC: ^D, BLOQUES RESTANTES: ^D (OF ^D)'> CUIDS2, TEXT '^A' CUIDS3, /DATE FORMAT, WITHOUT TRAILING SPACE /A024 TEXT '^D^S^D^S^D' /A023 CUIDS4, TEXT '^D:^2D' /TIME IFNDEF DUTCH < CUIDS5, TEXT ' !D' /SIZE > IFDEF DUTCH < CUIDS5, TEXT ' !D' /SIZE > CUIDS6, TEXT ' !D' /VER# CUIDS7, IFDEF ENGLSH < TEXT '&THERE IS NO DOCUMENT WITH THE NUMBER !D' > IFDEF ITALIAN < TEXT '&NON ESISTE IL DOCUMENTO !D' > IFDEF V30NOR < TEXT '&DOKUMENT NR. !D FINNES IKKE'> /A028 IFDEF V30SWE < TEXT '&DET FINNS INGET DOUKMENT MED NUMMER !D'> IFDEF DUTCH < TEXT '&ER IS GEEN DOCUMENT MET NUMBER !D'> IFDEF SPANISH < TEXT '&NO HAY DOCUMENTO CON N\ZMERO !D'> CUIDE2, IFDEF ENGLSH < TEXT '^P!E ^P&UNABLE TO READ INDEX INFORMATION FROM ^S ^D.'> IFDEF ITALIAN IFDEF V30NOR < TEXT '^P!E ^P&KAN IKKE LESE DATA I DOK.-FORTEGNELSEN I ^S ^D.'> /A028 IFDEF V30SWE < TEXT '&KAN INTE L\DSA INNEH\ELLSF\VRTECKNINGEN I ^S ^D' > IFDEF DUTCH < TEXT '^P!E ^P&INDEX-INFORMATIE ONLEESBAAR VAN ^S ^D.'> IFDEF SPANISH < TEXT '^P!E ^P&IMPOSIBLE LEER LA INFORMACI\SN \MNDICE DE ^S ^D.'> CUILN2, TEXT '-^S^S' /Used for ------- in index display CUID10, TEXT ' ^D' CUIDN2, IFDEF ENGLSH < TEXT '&N&O/&D&A/&T&E' > IFDEF ITALIAN < TEXT '00/00/00' > IFDEF V30NOR < TEXT "&B&L/&A&N/&K&T" > /A028 IFDEF V30SWE < TEXT '00/00/00' > IFDEF DUTCH < TEXT '00-00-00'> IFDEF SPANISH < TEXT '00-00-00'> CUILN1, IFDEF ENGLSH < TEXT '-- !&INDEX !&OF !&DOCUMENTS --' > /M014 IFDEF ITALIAN < TEXT '-- !&INDICI !&DOCUMENTI --' > IFDEF V30NOR < TEXT '-- !&DOKUMENTFORTEGNELSE --'> /A028 IFDEF V30SWE < TEXT '-- &INNEH\ELLSF\VRTECKNING \VVER DOKUMENT --'> IFDEF DUTCH < TEXT '-- !&INDEX --'> IFDEF SPANISH < TEXT '-- !&INDICE !&DE !&DOCUMENTOS --'> CUITP1, IFDEF ENGLSH < TEXT '&DOCUMENT' > IFDEF ITALIAN < TEXT '&DOCUMENTO' > IFDEF V30NOR < TEXT "&DOKUMENT" > /A028 IFDEF V30SWE < TEXT '&DOKUMENT' > IFDEF DUTCH < TEXT '&DOCUMENT'> IFDEF SPANISH < TEXT '&DOCUMENTO'> CUITP2, IFDEF ENGLSH < TEXT '&NUMBER &NAME' > IFDEF ITALIAN < TEXT '&NUMERO &NOME' > IFDEF V30NOR < TEXT "&NUMMER &NAVN" > /A028 IFDEF V30SWE < TEXT '&NUMMER &NAMN' > IFDEF DUTCH < TEXT '&NUMMER &NAAM'> IFDEF SPANISH < TEXT '&NOMBRE &N\ZMERO'> CUITP3, IFDEF ENGLSH < TEXT '&CREATED' > IFDEF ITALIAN < TEXT '&CREATO' > IFDEF V30NOR < TEXT '&OPPRETTET'> /A028 IFDEF V30SWE < TEXT '&SKAPAT'> IFDEF DUTCH < TEXT '&GEEMAKT'> IFDEF SPANISH < TEXT '&CREADO'> CUITP4, IFDEF ENGLSH < TEXT '&MODIFIED' > IFDEF ITALIAN < TEXT '&MODIFICATO' > IFDEF V30NOR < TEXT '&REDIGERT'> /A028 IFDEF V30SWE < TEXT '&DNDRAD'> IFDEF DUTCH < TEXT '&BEWERKT'> IFDEF SPANISH < TEXT '&MODIFICADO'> CUITP5, IFDEF ENGLSH < TEXT '&SIZE' > IFDEF ITALIAN < TEXT '&DIMENS.' > IFDEF V30NOR < TEXT '&STR.'> /A028 IFDEF V30SWE < TEXT '&STORLEK'> IFDEF DUTCH < TEXT '&OMVNG'> IFDEF SPANISH < TEXT '&TAMA\QO'> CUITP6, IFDEF ENGLSH < TEXT '&VERSION' > IFDEF ITALIAN < TEXT '&VERS.' > IFDEF V30NOR < TEXT 'VERSJON'> /A028 IFDEF V30SWE < TEXT '&VERSION'> IFDEF DUTCH < TEXT '&VERSIE'> IFDEF SPANISH < TEXT '&VERSI\SN'> IFDEF ENGLSH < CUIWS1, TEXT 'DRIVE' /A020 CUIWS2, TEXT 'DEVICE' /A020 > IFDEF ITALIAN < CUIWS1, CUIWS2, TEXT 'UNIT\A' > IFDEF V30NOR < CUIWS1, TEXT 'STASJON' /A028 CUIWS2, TEXT 'ENHET' /A028 > IFDEF V30SWE < CUIWS1, TEXT 'ENHET' CUIWS2, TEXT 'ENHET' > IFDEF DUTCH < CUIWS1, TEXT 'DISKETTE' CUIWS2, TEXT 'GEBIED' > IFDEF SPANISH < CUIWS1, TEXT 'UNIDAD' CUIWS2, TEXT 'DISPOSITIVO'> CUINGD, XX /GET THE DOCUMENT THAT THE INDEX IS TO GO TO IF DESIRED. / OPEN THE DOCUMENT AND SET THE FLAGS FOR IT. CDFMNU TAD I (MUBUF+MNTMP2) /ZERO TO SCREEN, NONZERO TO DOCUMENT CDFMYF SNA JMP I CUINGD DCA CUIDFG /SET THE FLAG CDFMNU TAD I (MUBUF+MNFNO) /GET DOCUMENT NUMBER CDFMYF DCA CUIDCN TAD CUIDCN MQL /SAVE IN MQ FOR SCROLL AC7776 /IF 2 THEN GO TO MAIN MENU CDFMNU TAD I (MUBUF+MNTMP1) /GET TYPE OF OPEN CDFMYF SNA JMP CUINDR /RETURN TAD (2) CIFFIO FILEIO XDSKIN /M0010 JMP I CUINGD NWLINE, XX /FLUSH THE BUFFER TO THE SCREEN AND THE DOCUMENT IF HAVE TO CLA TAD (CR) /PUT A CR INTO THE BUFFER FOR THE SCREEN DCA I CUICPO ISZ CUICPO TAD (LF) /AND ADD THE LINE FEED DCA I CUICPO ISZ CUICPO TAD (CUIBAD) DCA CUIPCT /SET THE POINTER TO THE BEGINING NWLINL, TAD I CUIPCT JMS CUIOUS /OUTPUT TO SCREEN TAD I CUIPCT /NOW TO DOCUMENT JMS CUIOUD ISZ CUIPCT TAD CUICPO /COMPARE TO LAST CHAR CIA TAD CUIPCT SPA CLA JMP NWLINL TAD (CUIBAD) /RESET THE CURRENT POSITION DCA CUICPO JMP I NWLINE CUIDOT, XX CIFMNU JMS I IOACAL /DISPLAY THE ---- CUIOUT CUILN2 IN1DAS IN1DAS JMP I CUIDOT /-------------------------------------- PAGE / IOA OUTPUT STRING IN1DAS, TEXT '---------------------------------------' /RULER AND PRINTER CONTROLS CUIDRL, IFDEF ENGLSH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;";-200;"C-200 /Tab at column 59 "4-200;"4-200;"C-200 /Tab at column 68 "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 12 /End print control 0 > IFDEF ITALIAN < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;";-200;"C-200 /Tab at column 59 "4-200;"4-200;"C-200 /Tab at column 68 "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control "I-200 /I "N-200 /N "I-200 /I "Z-200 /Z "I-200 /I "O-200 /O 12 /End print control 0 > IFDEF DUTCH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;"4-200;"C-200 /Tab at column 20 "2-200;"2-200;"C-200 /Tab at column 34 "3-200;"0-200;"C-200 /Tab at column 48 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;"9-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 12 /End print control 0 > /End IFDEF DUTCH IFDEF NORWAY < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;76;"C-200 /Tab at column 30 (76 is closing angle brckt "2-200;"7-200;"C-200 /Tab at column 39 and cannot be used in "3-200;"6-200;"C-200 /Tab at column 54 conditional code.) "3-200;74;"C-200 /Tab at column 60 (74 is opening angle brkt "4-200;"4-200;"C-200 /Tab at column 68 see above.) "4-200;";-200;"C-200 /Tab at column 75 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 160 /p 12 /End print control 0 > /END IFDEF NORWAY IFDEF SWEDSH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "8-200;"C-200 /Tab at column 8 "1-200;":-200;"C-200 /Tab at column 26 "2-200;"3-200;"C-200 /Tab at column 35 "3-200;"1-200;"C-200 /Tab at column 49 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;":-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code 207 /Word wrap next line 1014 /Start print control 164 /t 157 /o 160 /p 160 /p 12 /End print control 0 > /END IFDEF SWEDSH IFDEF SPANISH < 16 /Begin ruler code "@-200 /Marker to introduce the forward pointing ruler "1-200;"D-200 /Left margin (single spacing) "9-200;"C-200 /Tab at column 9 "1-200;"4-200;"C-200 /Tab at column 20 "2-200;"2-200;"C-200 /Tab at column 34 "3-200;"0-200;"C-200 /Tab at column 48 "3-200;"9-200;"C-200 /Tab at column 57 "4-200;"2-200;"C-200 /Tab at column 66 "4-200;"9-200;"C-200 /Tab at column 74 "4-200;"?-200;"E-200 /Ragged Right margin at 79 17 /End ruler code / 207 /Word wrap next line 1014 /Start print control / 164 /t / 157 /o / 160 /p 151 /i 12 /End print control 0 > CUIDR2, 1414 CUITNL, 0 CUITPE, IFDEF ENGLSH < TEXT '&LAST' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&SIST'> /A028 IFDEF V30SWE < TEXT '&SENASTE'> IFDEF DUTCH < TEXT '&BEWERK'> IFDEF SPANISH < TEXT '&ULTIMO'> CUIP11, IFDEF ENGLSH < TEXT '&ELAPSED &TIME' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&MEDG\ETT TID'> /A028 IFDEF V30SWE < TEXT '&ANV\DND TID'> IFDEF DUTCH < TEXT '&LAATST/TOT.'> IFDEF SPANISH < TEXT '&TIEMPO &TRANSCURRIDO'> CUIP13, IFDEF ENGLSH < TEXT '&TOTAL' > IFDEF ITALIAN < TEXT ' ' > IFDEF V30NOR < TEXT '&I ALT'> /A028 IFDEF V30SWE < TEXT '&SAMMANLAGD'> IFDEF DUTCH < TEXT '&TIJD'> IFDEF SPANISH < TEXT '&TOTAL'> QURX, XX CLA CIFSYS; ENQUE; QUBLK CIFSYS; JWAIT TAD QUQBLK+RXQCOD SNA;JMP .-4 JMP I QURX GETCHR, XX CLA TAD I GETCHR DCA T1 ISZ GETCHR TAD I T1 CLL RAR TAD I GETCHR DCA T1 TAD I T1 SNL BSW AND P77 ISZ GETCHR JMP I GETCHR / / The following piece of code really belongs to CUIOUD but guess / what ... there isn't enough room on that page , quel surprise. / / CUI8BT, / Ouput 8 bit char as dead /A027 CLA / /A027 MQA / Get char back /A027 AND P177 / Strip off 8th bit /A027 DCA CUMNCH / Save char /A027 TAD (CUMNSTR / Get address of dead string /A027 DCA CUMNPTR / Save it /A027 CU8NXT, TAD I CUMNPTR / Get next char in loop /A027 SNA / Is it the zero terminator ? /A027 JMP CUIODX / Yes rejoin mailine /A027 CIFFIO / Off to Files /A027 FILEIO / Output to document /A027 XPUTST / Put char to scroll /A027 ISZ CUMNPTR / Bump to next /A027 JMP CU8NXT / And go again /A027 CUMNSTR,10;40;62 / Start of dead , space , MNC intro /A027 CUMNCH, 0 / MN char (modified in line) /A027 CUMNRST,15;0 / End of dead and terminator /A027 CUMNPTR,0 / Pointer into "dead thing" string /A027 /------------------------------------------ PAGE /THE ERROR ROUTINE THAT IS USED BY INDEX WHEN THE FILE DOESNT /MATCH THE NUMBER IN THE INDEX FILE CUIDBN, CLA TAD CUIDFO DCA CUID8 CIFMNU JMS I IOACAL CUIOUT CUID10 CUID8, 0 JMS CUIPOS CUINME CIFMNU JMS I IOACAL CUIOUT CUIDS2 CUIDST JMS NWLINE JMS CUIPOS CUIERO CIFMNU JMS I IOACAL /Print "No document with number !D" CUIOUT /Output routine CUIDS7 /Address of string CUID8 /Document number JMP CUIDSR /RETURN CUIDER, CLA TAD CUIDRV /GET DRIVE NUMBER FOR ERROR MESSAGE DCA CUIDE1 CIFMNU JMS I IOACAL 0 CUIDE2 0 700 CUISA2, CUIWS1 / ADDR OF SUB-STRING /A020 CUIDE1, 0 CLA DCA CUIPGE / SET ENTRIES = 0 /A017 DCA CUIREM / SET DOC. REMAINING = 0 /A017 TAD (-5) DCA CUICNT JMS CUIWAT / WAIT FOR USER RESPONSE JMP CUINDR / CLEAN UP AND TERMINATE JMP CUINDR /DON'T REMOVE THIS LINE CUIOUD, XX /OUTPUT TO A DOCUMENT IF NEEDED MQL /FIRST SEE IF SHOULD GO TO DOCUMENT RDF /MAKE CROSS FIELD CALLABLE TAD CIDF0 DCA CUIODX TAD (-13) /SEE IF THE DISK HAS 10 BLOCKS OR LESS ON IT FREE CDFFIO TAD I (SCFSPC) CDFMYF /M0010 SMA CLA JMP CUIOU2 AC0001 DCA CUIOVR /SET FLAG FOR OVERFLOW JMP CUIODX CUIOU2, CDFMYF TAD CUIDFG SNA CLA JMP CUIODX MQA TAD (-CR) /GET RID OF CR SNA TAD (-CR) TAD (CR) TAD (-200) / Is it 8 bit /A027 SMA SZA / /A027 JMP CUI8BT / yes , Go set it up /A027 TAD (200) / No , Add back 200 /A027 CIFFIO FILEIO XPUTST /M0010 CUIODX, XX JMP I CUIOUD /THIS IS USED IN CUIOVR, HERE FOR ROOM CUICSR, TEXT '^P!E' /**************************************************************************** / / THIS ROUTINE CHECKS FOR A WINCHESTER DRIVE ON THE SYSTEM. / /**************************************************************************** CUICKW, XX / RETURN ADDR /A020 CLA / CLEAR AC /A020 /D025 CDFMNU / MENU FIELD /A020 /D025 TAD MUBUF+MNOPTN / FETCH OPTION WORD /A020 /D025 CDFMYF / BACK TO THIS FIELD /A020 /D025 DCA CUIOPT / SAVE VALUE /A020 /D025 AC0004 / MASK VALUE FOR WINNIE /A020 /D025 AND CUIOPT / IS WINNIE BIT SET ? /A020 /D025 SNA CLA / YES - SKIP & CONTINUE /A020 /D025 JMP CUICTD / NO - INSERT "DRIVE /A020 /D025 TAD CUIDRV / CK FOR DRIVE 0 /A020 /D025 SNA / NO - SKIP & CONTINUE /A020 /D025 JMP CUICTD / YES - INSERT "DRIVE /A020 /D025 TAD (-1 / IS IT 1 ?, DRIVE OR DEVICE /A020 /D025 SZA CLA / YES - SKIP & CONTINUE /A020 /D025 JMP CUICTW / NO - INSERT "DEVICE /A020 /D025 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A020 /D025 AND CUIOPT / IS VOLUME ASSIGNED ? /A020 /D025 SNA CLA / YES - SKIP & CONTINUE /A020 TAD CUIDRV /CURRENT DRIVE NUMBER /A025 TAD (RXSTRT+1 /ACP DRIVE TABLE START ADDRESS /A025 DCA CUIPTR /POINTER TO DRIVE DATA IN ACP /A025 CDFACP /ACP DATA FIELD /A025 TAD I CUIPTR /GET DEVICE DATA /A025 CDFMYF /A025 SMA CLA /IS HARD DISK DEVICE? /A025 /....4000=H.D.UNMOUNTED /A025 /....4001 = H.D. MOUNTED /A025 /.... H. ORDER BIT =0 =RXDEVICE /A025 JMP CUICTD / NO - INSERT "DRIVE /A020 / ****** CHANGE TEXT TO "DEVICE /A020 CUICTW, TAD (CUIWS2) / ADDR OF "DEVICE /A020 DCA CUISA1 / INTO PARAMETER LIST /A020 TAD (CUIWS2) / AGAIN, THERE ARE 2 CALLS /A020 DCA CUISA2 / INTO PARAMETER LIST /A020 JMP CUICWE / BRANCH TO EXIT /A020 CUIPTR, RXSTRT+1 /POINTER TO ACP TABLE /A025 / ****** CHANGE TEXT TO "DRIVE /A020 CUICTD, CLA / CLEAR AC /A020 TAD (CUIWS1) / ADDR OF "DRIVE /A020 DCA CUISA1 / INTO PARAMETER LIST /A020 TAD (CUIWS1) / AGAIN, THERE ARE 2 CALLS /A020 DCA CUISA2 / INTO PARAMETER LIST /A020 CUICWE, JMP I CUICKW / THIS IS THE EXIT POINT /A020 CUIOPT, 0 / OPTION WORD /A020 /------------------------------------------- PAGE / IF CODE OVERFLOWS INTO BUFFER AREA, ERROR. IFNZRO CUIBFD-.&4000   / WPUDKD - UDK POINTERS & SYSTEM BLOCK VALUES / / 033 Mart 15-aug-85 modified date and time sep for DUTCH / 032 EMcD 28-Feb-85 Added DECDEV switch / 031 AH 29-OCT-84 EXTENSION TO 029 / 030 WCE 08-OCT-84 INITIALIZE MNOPTC FOR STANDARD SYSTEM / 029 AH 13-SEP-84 ADDED SYSTEM DATE, VERSION TO DIRECTORY / 028 WCE 20-AUG-84 ADDED TELEPHONE DIRECTORY WORD / 027 AH 10-AUG-84 CHANGED "RETURN" TO "ADVANCE" IN UDK 0 / 026 TCW 16-JUL-84 Definition of MNPRTB CHANGED / 025 JAC 03-JUL-84 Fix Loading Sequence / 024 JAC 15-APR-84 ZERO UNUSED UDK BLOCKS ON DISK / 023 JAC 25-APR-84 100 UDK DEVELOPMENT / 022 WCE 30-APR-84 Added words to system area for British / 021 WJY 02-FEB-84 DECmate I compatability. / 020 EPS 21-JUN-83 ADDED BOOKMARK UDK'S FOR CONDOR / 019 WCE 21-JUN-83 Added conditional for Develop options / 018 HLP 08-JUN-83 NCONDOR to use PB 4800 / 017 HLP 04-NOV-82 DM-II TM default to VT-100 / 016 MJS 12-OCT-82 Conditionalized "MNSECN" (the secondary / comm port characteristics on CONDOR / because "SETUP" mode uses this location / to save the terminal characteristics / (thus no other loc had to be defined) / / 015 SBB 17-SEP-82 Deleted ICP's for CONDOR. 4800 baudprt / / 014 AIB 11-AUG-82 Add UDK 5: editor math ICP, and UDK 6: / list processing math ICP / / 013 SBB 25-AUG-82 Made timeout delays variable from MNXDLY / (DEFAULT TO CT=5) / 012 HLP 30-JUN-82 TM default conditionalized for DM-II / 011 GDH 16-OCT-81 TM option changes. / 010 GR 05-OCT-81 Updated UDK's for ICP docs. for V2.0 / 009 GDH 23-SEP-81 made system value area location independent. / 008 GDH 01-SEP-81 New write-out code conventions. / 007 GR 06-AUG-81 ADDED MATH SWITCH FLAG / 006 TT 07-JUL-81 Removed superfluous conditionals / 005 DRH 2-FEB-81 INSTALLED SORT ICP IN UDK 9 / 004 DAO 21-JAN-81 Changed stop bit default to 1 (was 2) / Most timeshare systems use 1. / 003 DRH 20-JAN-81 INSTALLED KERNEL 1.0 SOFTWARE ICP IN / UDK 7 & LIST PROCESSING ICP IN UDK 8 / 002 WCE 17-NOV-80 ADDED INITIALIZE VALUE FOR UNBUNDILING / 001 DAO 11-NOV-80 Conditionalize DP2 baud rate to be set / to 9600 for a VT278 since it is used / for the LQPSE. / 2.N-1 RLT 14-SEP-77 CHANGE FOR UDKPRT OPTION / 2.N KEE 7-SEP-77 CHANGE 'MN' SYMBOLS FOR 4-FLOPPY SUPPORT / FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLUDKS / ++++ 1200 / ++++ /C023 CDF 10 / ++++ /D025 -DSUDKS -2 / Load Directory and next block only /A025 DLSVAL / ++++ 600 / ++++ CDF 10 / ++++ -DSSVAL / Below loads rest of zeroed udk blocks /A025 DLUDKS+2 / ZERO THE UNUSED BLOCKS /A024 ZEROLA / BLOCK 0, /A024 IFNDEF DECDEV < CDF 20 / FIELD 2 (ASS'Y TIME) /M032 /A024 > IFDEF DECDEV < CDF 50 / FIELD 2 (ASS'Y TIME) /A032 > -DSUDKS+2 / SHOULD BE -17 = 7761 /A024 0 / FIELD 1 *1200 RELOC CUDBUF / EACH LOCATION CONTAINS THE ADDRESS OF THE ASSOCIATED UDK. THAT IS, / WORD 0 CONTAINS THD ADDRESS OF UDK 0, WORD 1 CONTAINS THE ADDRESS OF / UDK 1, ETC. THE UDK DIRECTORY OCCUPIES ONE BLOCK; ONLY 100 DECIMAL / LOCATIONS ARE USED. THE ADDRESS WORD IS DECODED AS FOLLOWS: / BITS 0-3: RELATIVE BLOCK OF CORRESSPONDING UDK / BITS 4-11: WORD IN THE RELATIVE BLOCK / / UDK'S START IN THE BLOCK FOLLOWING THE DIRECTORY (ALTHOUGH THEY DON'T / NECESSARILY HAVE TO) AND USE 16 DECIMAL BLOCKS. UDK'S MAY BE ANY LENGTH / AND MAY CROSS BLOCK BOUNDRIES. THE FIRST WORD OF A UDK IS THE UDK NUMBER / PLUS 2001 OCTAL; THE FIRST WORD OF UDK 1 WILL BE 2001 OCTAL, THE FIRST / WORD OF UDK 2 WILL BE 2002 OCTAL, ... , THE FIRST WORD OF UDK 99 WILL / BE 2144 OCTAL. / / COMPUTATIONS FOR THE FIRST UDK DEFINED (NOT NECESSARILY UDK 0). / A SET OF THESE COMPUTATIONS IS REQUIRED FOR EACH UDK DEFINED. BLKSET= CUDBUF+400%400 / BLOCK OF UDK DIRECTORY BLKADR= UDK0%400-BLKSET / RELATIVE BLOCK OF UDK RELADR= UDK0-CUDBUF-400 / RELATIVE CORE ADDRESS BLKWRD= RELADR%400^400 / ADDRESS OF FIRST WORD OF BLOCK WRDADR= RELADR-BLKWRD / ADDRESS OF WORD IN BLOCK BLKADR^400+WRDADR / ADDRESS OF UDK 0 0 / 1 0 / 2 0 / 3 0 / 4 0 / 5 0 / 6 0 / 7 0 / 8 BLKADR= UDK9%400-BLKSET RELADR= UDK9-CUDBUF-400 BLKWRD= RELADR%400^400 WRDADR= RELADR-BLKWRD BLKADR^400+WRDADR / ADDRESS OF UDK 9 ZBLOCK 400-.+CUDBUF-14 /ZERO REST OF DIRECTORY /C029 DLRLRE / EDITOR RULERS /A031 DLRLRP / PRINTER SETTINGS /A031 DLSVAL / SYSTEM PARAMETERS /A031 DLUDKD / UDK DEFINITIONS /A031 SYSVER / VERSION NUMBER, 8-BIT ASCII /A029 SYSBAS / BASE LEVEL NUMBER /A029 SYSREV / BASE LEVEL REV. NUMBER /A029 BLDDY / BUILD DAY, BINARY /A029 BLDMO / MON /A029 BLDYR / YR /A029 TEXT "UDK" / UDK DIRECTORY BLOCK IDENTIFIER, 2WORDS/A029 NOP / PLACE HOLDER SO ADDRESS OF UDK 0 / IS NOT ZERO. THIS PREVENTS HAVING A UDK / DEFINED WHOSE ADDRESS IN THE DIRECTORY / IS ZERO. A ZERO ADDRESS IN THE DIRECTORY / WOULD INDICATE THAT THAT UDK WAS NOT / DEFINED. UDK0, 0+CUUDID EDFIND /SEARCH /A020 IFDEF ENGLSH < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > IFDEF ITALIAN < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > /D027 EDNWLN /RETURN /A020 EDADVN /ADVANCE NEW TERMINATOR FOR SEARCH /A027 EDRBCH /RUB CHAR /A020 EDDLTW /DEL WORD /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 EDDLTC /DEL CHAR /A020 0 /A015 UDK9, 11+CUUDID EDNWLN /RETURN /A020 IFDEF ENGLISH < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > IFDEF ITALIAN < "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 "B-200 /B /A020 "O-200 /O /A020 "O-200 /O /A020 "K-200 /K /A020 " -200 /SPACE /A020 "M-200 /M /A020 "A-200 /A /A020 "R-200 /R /A020 "K-200 /K /A020 "*-200 /* /A020 "*-200 /* /A020 "*-200 /* /A020 > EDSLCT /SEL /A020 EDBKUP /BACK-UP /A020 EDLINE /LINE /A020 EDBOLD /BOLD /A020 EDNWLN /RETURN /A020 EDFILE /GOLD:F /A020 0 ZBLOCK 400-.+CUDBUF+400 / ZERO REST OF BLOCK / / DLSVAL - SYSTEM BLOCK INITAL SETTINGS / THESE ARE THE DEFAULT SYSTEM SETTING THAT ARE STORED ON THE DISK WHEN NEW / RELOC *600 / STARTING ADDRESS TO LOAD FROM AT WRITEOUT TIME / X=MUSYSV-MUBUF-600 / BASE OFFSET OF SYSTEM AREA. *MNABRV-X; 2 / MNABRV, USED BY THE EDITOR FOR ABBREVIATION *MNLBRY-X; 3 / MNLBRY, USED BY THE EDITOR FOR LIBRARY *MNPGSZ-X; 66 / MNPGSZ, USED BY THE EDITOR FOR PAGE SIZE *MNSTAT-X; IFDEF CONDOR < 2 > / MNSTAT, USED BY THE EDITOR FOR STATUS LINE /C021 IFNDEF CONDOR < 0 > / HAVE DMI COME UP WITH ES=0 /A021 *MNFMAT-X; 0 / MNFMAT, FORMAT WORD FOR DATE, CURRENCY, DICT. /A022 *MNSDRV-X; 0 / USER DRIVE SELECTION FOR SPELLING /A022 *MNPDFN-X; 0 / PERSONAL DICTIONARY DRIVE & FILE NUMBER /A022 *MNLGFN-X; 0 / LOGON EASY COMM DRIVE AND FILE NUMBER /A022 *MNADFN-X; 0 / AUTODIAL DIRECTORY DRIVE & FILE NUMBER /A028 IFDEF DUTCH < *MNDSEP-X; 5500 / DATE SEPARATOR TYPED IN BY USER /A022 > IFNDEF DUTCH < *MNDSEP-X; 5700 / DATE SEPARATOR TYPED IN BY USER /A022 > *MNXTRA-X; 0 / ** EXTRA WORD AVALAIBLE FOR SAVING /A028 *MNCMTP-X; 0 / MNCMTP - THE COMMUNICATIONS / SET FOR 0 = CX 1 = MAGCARD *MNXONF-X; 0 / MNXONF - USE XON/XOF AT HANDLER LEVEL OF / COMM PORT 0 = YES 1 = NO / FOR A DETAILED DESCRIPTION OF THE TWO / LOCATIONS SLU2PM AND 3 LOOK AT WPSYS SLDATA=4000 / 8 Data bits DDD D-- --- --- /A004 SLPARA=0200 / No Parity --- -PP --- --- /A004 SLSTOP=0020 / 1 Stop bit --- --- SS- --- /A004 SLBAUD=0005 / 300 baud --- --- --B BBB /A004 SLDFLT=SLDATA+SLPARA+SLSTOP+SLBAUD *MNPRIM-X; SLDFLT / MNPRIM - Primary port (0) settings. IFNDEF CONDOR < /A016 *MNSECN-X; SLDFLT / MNSECN - Alternate port (1) settings. > / END IFNDEF CONDOR /A016 IFDEF CONDOR < /A016 *MNSECN-X; 0 / MNSECN - condor SETUP mode values /A016 > / END IFDEF CONDOR /A016 / FORMAT FOR THE MNPRTB WORD: / BITS INFORMATION / / 0-2 TERMINAL MODE (0=VT52, 1=VT100, 2=DECMATE, 3=VT125, 4=VT227 / / 3-6 BREAK TIME (IN TENTHS OF A SECOND). / / / / 7 PORT SELECT (0=PRIMARY, 1=ALTERNATE) / / 8-11 PRINTER BAUD RATE. / / ********************************************************** / / LIMITS - VALUES THAT ARE CHECKED FOR IN THE MENU / / CHARACTER SIZE - CAN BE FROM 5 - 8 / / PARITY - 2 = NO PARITY, 1 = ODD, 0 = EVEN / / STOP BITS - 1 OR 2 NOTE: IF SET FOR 5 FOR CHARACTER SIZE AND 1 FOR STOP / IT WILL AUTOMATICALLY SET FOR 1.5 STOP BITS / / AND BAUD: / / VALUE BAUD / 0 50 / 1 75 / 2 110 / 3 134.5 (MAGCARD) / 4 150 / 5 300 / 6 600 / 7 1200 / 10 1800 / 11 2000 / 12 2400 / 13 3600 / 14 4800 / 15 7200 / 16 9600 / 17 19200 / *MNPRTB-X; / MNPRTB - See WPCU3/WPCU4 for defn of bits IFNDEF CONDOR < 0514 > / Initialized for PB=4800, /C018 / Primary port (0), BT=5. /C012 / TM = WS52 /C012 IFDEF CONDOR < 1254 > / Initialized for PB=4800,/C017 /M026 / Primary port (0), BT=5. /A012 / TM = VT-100 /C017 *MNCXP-X; 0 / MNCXP - DOCUMENT NUMBER FOR CX DOCUMENT / TRANSFER PROTOCOL *MNOPTC-X; / MNOPTC - USED BY THE UNBUNDLING CODE /A002 IFDEF UNBUND < /A019 COMBIT!LPBIT!SRBIT!MABIT / TURN ON SYSTEM OPTIONS /C030 > / END IFDEF UNBUND /A019 IFNDEF UNBUND < -1 > / MAKE SURE ALL OPTIONS ARE ACTIVE /A019 *MNXDLY-X; 5 / MNXDLY is used as a multiplier to mod /A013 / the time out delays for DX /A013 / THE NEXT 3 ITEMS ARE NOT COPIED INTO THE SYSTEM AREA BECAUSE OF SPACE //*MNCDV-X; 0 / DOCUMENT DRIVE NUMBER (MNCDV) //*MNCNO-X; 0 / DOCUMENT NUMBER WITHOUT THE DRIVE (MNCNO) //*MNCFAD-X; 0 / START OF THE ASCII STRING THAT IS THE / DOCUMENT NAME (MNCFAD) ZBLOCK 400-.+600 / THE FOLLOWING SETS UP A DUMMY ZEROED FIELD TO LOAD TO UNUSED UDK BLOCKS/A024 IFNDEF DECDEV < FIELD 2 /M032 > IFDEF DECDEV < FIELD 5 /A032 > *0 ZEROLA, ZBLOCK 7777 $$$$$$   / WPUDKS 3.3 / .VERSION / / / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: CREATION DATE: / / MODIFIED BY: / / 039 EMcD 12-Sep-85 Add Nordic translations / 038 EMcD 28-Aug-85 Show insert_overstrike Key / 037 EMcD 13-JUl-85 Display FAO Gold Commands (conditional) / 036 AH 28-OCT-84 EXTENSION TO 035 / 035 AH 28-SEP-84 ADD CODE TO SAVE/RESTORE SYSTEM / VALUES ACROSS DIRECTORY READ/WRITES / 034 AH 17-AUG-84 CHANGE TEXT FOR ALT CHR DISPLAY / 033 AH 17-JUL-84 MORE OF ONE SCREEN; 20 LINES + 1 KEYSTR / 032 AH 13-JUL-84 SET UDK KEYSTROKE INPUT TO ONE SCREEN / 031 AH 12-JUL-84 ASSIGN NUMBER TO OLD EDITS / 030 AH 11-JUL-84 BELL ON ILLEGAL INPUT / 029 JAC 10-JUL-84 ALLOW DELETES AT END OF FULL UDKS / 028 AH 09-JUL-84 CHANGE TO LOAD FROM LOC 0 / 027 JAC 13-JUN-84 REFINEMENT OF BELOW / 026 JAC 12-JUN-84 FIX TO FULL UDK'S PROBLEMS / 025 JAC 08-JUN-84 MR. H'S FIX TO SQUEEZE ACROSS SECTORS / 024 JAC 30-MAY-84 ADAM'S FIX TO UNDEFINED UDK0 / 023 JAC 08-MAY-84 100 UDK DEVELOPMENT / 022 DKR 30-MAY-84 Changed "Tabcen" to "G-Tab" for when / Gold:Tab is entered / 021 EJL 08-may-84 added technical character / Removed all occurances of USERNO / 020 AH 21-MAR-84 ADDED CODE FOR COLUMN CUT / 019 WJY 03-FEB-84 DECmate I compatability. / 018 DMB 31-AUG-83 Added new key names for DM2V15 / 017 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 016 TCW 19-MAY-83 CHANGE POSITION OF COMMAND KEY / 015 EPS 28-SEP-82 FIXED CODE MODIFIED IN 0014 / 014 EPS 23-SEP-82 FIXED CODE MODIFIED IN 0013 / 013 EPS 10-SEP-82 ADDED END OF TABLE CHECK / 012 EPS 09-SEP-82 ADDED HELP KEY FOR DECMATE II / 011 EH 30-SEP-81 Removed "MAIN" from message at CUDMS3 / 010 GDH 01-SEP-81 New Write-out code conventions. / 009 JM 01-SEP-81 Fixed GOLD CONT SRCH & SEL for ENGCAN / 008 TT 07-JUL-81 Removed superfluous conditionals / 007 DM,JM 15-SEP-80 Merged Scandi and Europe/English / 006 REG 12-AUG-80 ADDED THIS STANDARD HEADER / 005 CMW 06-AUG-80 MADE GRAMMATICAL DUTCH CHANGES / 004 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 003 CMW 06-MAY-80 ENTERED CANADA TRANSLATIONS / 002 DSS 17-APR-80 ENTERED DUTCH FIXES / 001 CMW GLT 01/10/80 ADDED FRENCH, DUTCH, GERMAN TRANSLATIONS / / Note: changes other than text translation / / must be performed on this module. CUDTAB / / must be modified to reflect any keyboard / / changes. (see CUDTAB). / / French diacritical substitutions: / / "&["=degree;"["=L.A.E, "]"=L.G.E; "&" not usable / / German diacritical substitutions: / / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" causes / / capitalization / 2.L-1 RLT 09/09/77 CHANGE OVERLAY LENGTH / 2.K-1 RLT 08/31/77 CHANGE TO ASSEMBLE PROPERLY / 2.G-1 MB PUT IN NEW OVERLAY TO HELP EDITOR / /-- / / WPUDKS - USER DEFINED KEYS / / ***** NOTE-- THE EDITOR LOADS THIS OVERLAY, AND KNOWS ITS LENGTH ***** / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOUDK / ++++ 000 / ++++ /C028 CDF 20 / ++++ -DSOUDK 0 /D017 / /D017 / THIS IS THE PATCH TO PAGE ZERO THAT WILL CONTAIN THE ROUTINES /D017 / THAT WILL TAKE CARE OF THE CDFS AND CIFS. /D017 / /D017 / CONSTANT USED TO FORM A CDF CIF CALL TO CIDPAT /D017 / /D017 CDIF00=CDF CIF /D017 / /D017 / THE USER FIELD CONSTANTS /D017 / /D017 USRFL0=-20 /D017 USRFL1=-10 /D017 USRFL2=0 /D017 / FIELD 2 / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / /D017 CDIMNU=JMS . /D017 XX /D017 JMS CIDPAT / CALL THE ALL PURPOSE ROUTINE /D017 CDIF00+USRFL0 / FOR A CDF CIF MENU /D017 / /D017 CDFMNU=JMS . /D017 XX / THIS WILL CREATE A CDF FOR THE MENU FIELD /D017 JMS CIDPAT / CALL THE GENERAL ROUTINE THAT HANDLES ALL CDF OR CIFS /D017 CDF+USRFL0 / THE ARGUEMENT FOR CIDPAT /D017 / /D017 CIFMNU=JMS . /D017 XX / CREATE A CIF MENU FIELD /D017 JMS CIDPAT / RUOTINE THAT WILL CREATE THE INSRTUCTION /D017 CIF+USRFL0 /D017 / /D017 CDFMYF=JMS . /D017 XX / GENERATE A CDF INSTRUCTION FOR THIS FIELD /D017 JMS CIDPAT / ROUTINE THAT WILL CREATE THE INSTRUCTION /D017 CDF+USRFL2 / THIS FEILD IS USER FIELD ONE /D017 / /D017 CIDPAT, /D017 XX / THE ALL POURPOSE ROUTINE FOR THE INSTRUCTIONS /D017 DCA CIDTM1 / SAVE THE AC /D017 RAL / ++++ /D017 DCA CIDTM3 / SAVE LINK /D017 RIF / FIND OUT THE INSTRUCTION FIELD SO TO SET THE DATA /D017 / FIELD TO THE SAME /D017 TAD CDF0 /D017 DCA .+1 / STORE TO EXECUTE /D017 CIDTM2, /D017 XX / LOCATION LEFT FOR THE INSTRUCTION /D017 AC7776 / NOW GET THE ADDRESS OF THE CALLER /D017 TAD CIDPAT / SUBTRACTING THE 2 GETS YOU TO THE ADDRESS /D017 DCA CIDTM2 /D017 AC7777 /D017 TAD I CIDTM2 / GET THE ADDRESS OF THE CALLER FROM THE PROGRAM /D017 DCA CIDTM2 / STORE IT SO A RETURN CAN BE MADE FROM THE /D017 / INTERNAL ROUTINE /D017 RIF /D017 TAD I CIDPAT / GET AND STORE THE GENERATED INSTRUCTION /D017 DCA I CIDTM2 /D017 TAD CIDTM3 / ++++ /D017 CLL RAR / RESTORE LINK /D017 TAD CIDTM1 / GET THE OLD CONTENTS OF THE AC /D017 JMP I CIDTM2 / JUMP TO THE INSTRUCTION NOW CREATED /D017 / /D017 CIDTM1, /D017 0 /D017 CIDTM3, 0 / NOW TO USE SOME OF THE SPACE SAVED ON PAGE 0 TO REMOVE SOME /A024 / INDIRECTS AND MAKE ROOM FOR SOME MORE CODE /A024 CUDILX, CUDILM / CHECK FOR INPUT BUFFER OUT OF ROOM /A024 CUDFMX, CUDFMS / HANDLE OUT OF ROOM /A024 CUDSTX, CUDSTR / STORE KEYSTROKE IN UDK /A024 CURWUX, CURWUD / READ/WRITE UDK BLOCK /A024 CUDCOX, CUDCOD / DECODE UDK DIRECTORY ENTRY /A024 CURWDX, CURWDI / READ/WRITE UDK DIRECTORY /A024 CUDXBC, CUDXBF / BUFFER ADDRESS /A024 CUDREX, CUDRET / PROGRAM EXIT /A026 CUDPOX, CUDPOS / POSITION CURSOR /A026 CUDOUX, CUDOUT / OUTPUT CHARACTER TO SCREEN /A026 CUDP7, 7 / CONSTANT /A026 CUDSLX, CUDSLM / CHECK FOR ROOM IN OUTPUT BUFFER /A027 CUDGCX, CUDGCR / GET USER INPUT FROM KEYBOARD /A031 CUDIMX, CUDIMV / MOVE FROM PLACE TO PLACE /A031 CUM120, -120 / CHARACTERS ON LINE /A031 BUFEND, CUDBUF+CUBFSZ-1 / END OF BUFFER 1 /A033 XBFEND, CUDXBF+CUBFSZ-1 / END OF BUFFER 2 /A033 MDLUM1, -DLUDKS-1 / -START BLOCK -1 /A033 DLUDP1, DLUDKS+1 / START BLOCK + 1 /A033 DLUDM1, DLUDKS-1 / START BLOCK -1 /A033 DLUCUN, DLUDKS+CUNBLK / START BLOCK + NUMBER OF BLOCKS /A033 DECIMAL /A032 /D033 MSCRCT, -1600 / NUMBER OF CHARACTERS DISPLAYED /A032 MLINCT, -19 / NUMBER OF LINES /A033 OCTAL /A032 CUDFMY, CUDFMM / POINTER TO A MESSAGE DISPLAY /A032 CUDDSX, CUDDSP / POINTER TO KEYSTROKE DISPLAY /A032 CUDDIX, CUDDIS / POINTER TO UDK DISPLAY /A032 CNTSCX, CNTSCR / TEST NUMBER OF CHARS. ON SCREEN /A032 CUDCLX, CUDCL0 / CLOSE UDK /A033 CUDDGX, CUDDG0 / ACCEPT AND SCAN KEYBOARD INPUT /A033 CUDK4, CUUDF1 / POINTER; MOVED FOR ROOM /A035 / THE FOLLOWING ARE MOVED HERE FROM PAGE 2 /M024 6 LINES CUDIPT, 0 / ADDRESS OF UDK DIRECTORY SLOT CUUDKB, 0 / STARTING BLOCK CUUDKW, 0 CUUDKY, 0 / RELATIVE ADDRESS OF FIRST WORD OF UDK CUUDKD, 0 / USED ELSEWHERE AS WORKING POINTER CUUDKC, 0 / STARTING BLOCK / END M024 CUDRUB, 0 / VALUE FOR RUBOUT /M033 CUDNRB, 0 / NEGATIVE RUBOUT TO RESTORE VALUE /M033 CUDLIN, 0 / COUNTER FOR CUM120 /A031 LINCNT, 0 / COUNTER FOR NUMBER OF CHARS. /A032 CUGASW, 1 / MOVED FROM PAGE 3 /M024 / ......... A035 ......... / PLACE FOR SYSTEM VERSION, GENERATION DATE, OTHER VALUES / VALUES PLACED IN BLOCK "DLUDKS" IN SOURCE "WPUDKD" CUDP3, 3 / CONSTANT, MASK CUFUNC, 0 / TEMP STORE FOR DISK FUNCTION UDSYNM=14 / NUMBER OF PARAMETERS SAVED /A036 UDSYDA, ZBLOCK UDSYNM / EDITOR RULERS DLRLRE /A036 / PRINTER SETTINGS DLRLRP /A036 / SYSTEM PARAMETERS DLSVAL /A036 / START OF UDK DEFINITIONS DLUDKD /A036 / SYSTEM VERSION #; 8 BIT ASCII; 3 WORDS SYSVER / BASE LEVEL SYSBAS / REV. LEVEL SYSREV / BUILD DAY BLDDY / MONTH BLDMO / YEAR BLDYR / "UD" UDK DIRECTORY BLOCK IDENTFIER, WORD 1 CURWAA, 0 CUDILA, 0 / "K"0 WORD 2 ENDCOD=. / ........ END A035 .......... PAGE CDFMYF=CDFBUF / INSTRUCTION TO RETURN TO THIS FIELD /A017 CUDBUF=UDKSTR / THE BUFFER IS AT THE SAME ADDRESS AS IN THE / MENU FIELD / CUUDKR, XX / CUUDDF - DEFINE USER KEYS CLA RDF TAD CIDF0 DCA CUUDKX CDFMYF JMS CUUDDF CUUDKX, XX JMP I CUUDKR CURWDI, XX / POINTED TO BY CURWDX /C024 DCA QUQBLK+RXQDRV / SET DRIVE /C027 RDF TAD CDF0 DCA QUQBLK+RXQBFD / SET CDF TAD I CURWDI / FUNCTION DCA QUQBLK+RXQFNC / .......... A035 ............. / RESTORE VALUES BEFORE DIRECTORY WRITE TAD QUQBLK+RXQFNC / GET FUNCTION DCA CUFUNC / SAVE THE REQUESTED FUNCTION BECAUSE I DON'T / KNOW IF THE PARAMETER BLOCK IS INVIOLATE TAD CUFUNC / TEST FOR WRITE AND CUDP3 / 3=READ; (2)004=WRITE SZA CLA / SKIP IF WRITE JMP CURWYY / IS READ JMS I CUDIMX / MOVE VALUES TO BUFFER FOR WRITE CUDBUF+CUBFSZ-UDSYNM / DESTINATION /C036 UDSYDA / SOURCE -UDSYNM / COUNT /C036 CURWYY, / ........ END A035 ......... TAD (CUDBUF DCA QUQBLK+RXQBAD TAD (DLUDKS DCA QUQBLK+RXQBLK JMS QURX / WRITE OUT NEW UDK BLOCK CLA / ............ A035 ............... TAD CUFUNC / TEST ROR READ AND CUDP3 SNA CLA / 3=READ JMP CURWZZ / NOT READ JMS I CUDIMX / MOVE VALUES FROM BUFFER TO SAVE UDSYDA / DESTINATION CUDBUF+CUBFSZ-UDSYNM / SOURCE /C036 -UDSYNM / COUNT /C036 CURWZZ, /........... END A035 ........... ISZ CURWDI JMP I CURWDI QURX, XX CLA CIFSYS / ++++ ENQUE / ++++ QUBLK CIFSYS / ++++ JWAIT TAD QUQBLK+RXQCOD SNA / ++++ JMP .-4 JMP I QURX / QUBLK, DSKQUE / ++++ 0 / ++++ 0 QUQBLK, ZBLOCK 17 / /D023 PAGE CUDPTR= X0 CUDCUR= X1 CUDNXT= X2 / /D023 CDFUDK=CDFMNU / CUUDDF, 0 / THIS ROUTINE ACCEPTS CHARACTERS FROM THE / KEYBOARD AND STORES THEM IN THE UDK / SPECIFIED BY THE NUMBER IN MNTMP1. / TAD MNUCAL+1 / GET UDK TO MODIFY FROM THE MENU TAD (MNTMP1 DCA T1 CDFMNU TAD I T1 CDFMYF DCA CUDNUM / SAVE UDK NUMBER AC7777 / TURN OFF UDK'S CIFSYS / ++++ UDKOPS CIFMNU / JMS I IOACAL / Definition of user key #. Press gold halt to 0 / default output routine CUDMS1 / string address 0 / Cursor position IFNDEF FRENCH < IFNDEF CANADA < 10 / Cursor position (not in french or canada) >> CUDNUM, 0 / UDK number IFDEF V30NOR < CUTRYK > / /D033 TAD CUDNUM / UDK NO. /C023 /D033 TAD (CUDBUF / /C023 /D033 DCA CUDADR TAD CUDNUM / FIGURE OUT VALUE FOR RUBOUT CIA TAD (-EDUDK0 DCA CUDRUB / AND SAVE IT TAD CUDRUB / NOW GET NEG. RUBOUT VALUE CIA DCA CUDNRB / AND SAVE IT ALSO JMS I CURWDX /READ UDK DIRECTORY (CURWDI) /C024 RXERD TAD CUDNUM / CONSTRUCT ADDRESS OF DIRECTORY ENTRY TAD (CUDBUF DCA CUDIPT TAD CUDIPT / SAVE FOR INDIRECT USE DCA T3 IAC / SET HERE IN CASE CLEARED BY "CUUNDF" DCA CUGASW / AND PROGRAM NOT RELOADED TAD I T3 / GET ADDRESS OF UDK FROM DIRECTORY SZA CLA / IS THE UDK DEFINED JMP CUDK1 / YES, DO DECODE AND SQUEEZE JMS CUUNDF / NO, FIND LAST UDK; NO RETURN IF NO ROOM/C027 JMP CUDK2 CUDK1, JMS I CUDCOX / DECODE DIRECTORY ENTRY (CUDCOD) /C024 TAD CUUDKY / SET UP POINTER TO INPUT BUFFER TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR CUDK2, JMS I CURWUX / READ THE FIRST BLOCK OF THE UDK(CURWUD) /C024 RXERD CUDXBF CUUDKC /D031 JMS CUUDF1 / CONTINUATION OF CODE JMP I CUDK4 / CONTINUATION OF CODE /A031 CUDRET, / PROGRAM EXIT /M031 CIFSYS / ENABLE UDK'S /M031 UDKOPS /M031 JMP I CUUDDF / DONE /D035 CUDK4, CUUDF1 / MOVED TO PAGE 0 FOR ROOM /A031 PAGE CUUDF1, /D031 XX JMS I CUDDIX / SHOW USER THE UDK DEFINITION /C032 CUDINP, JMS I CUDDGX / GET FIRST CHAR /C023 /C033 JMP I CUDREX / HLT SET, JUST RETURN /C031 JMP CUDINP / ILLEGAL INPUT - NOT DIG, (DIG), RET /A030 DCA CUDCHR / SAVE CHAR TAD CUDCHR / GET CHAR BACK TAD CUDRUB / AND MAKE SURE IT WASN'T A RUBOUT SZA CLA JMP CUDIN2 / NOT, KEEP GOING TAD CUDP7 / WAS, RING THE BELL (WAS TAD (7 ) /C026 JMS I CUDOUX / DING-DONG AVON CALLING (CUDOUT) /C026 JMP CUDINP / AND LOOK FOR SOMETHING BETTER / CUDIN2, JMS CUDIN3 / DISPLAY HEADER /A032 TAD CUGASW / SQUEEZE ONLY IF WE ARE ACCESSING AN /A023 SZA CLA / EXISTING UDK; OTHERWISE WE ARE AT THE /A023 / RIGHT PLACE TO START INSERTING /A023 JMS CUDGAR / SQUEEZE /BACK FROM MOVING ALL THE UDK'S. /CUUDKB CONTAINS FIRST BLOCK OF THIS UDK /CUUDKY CONTAINS RELATIVE WORD / /READ BLOCK CONTAINED IN CUUDKB INTO CUDBUF /SET UP CUDPTR USING CONTENTS OF CUUDKY /STORE UDK # & WE ARE READY TO STORE INPUT / JMS I CURWUX / READ A BLOCK (CURWUD) /C024 RXERD CUDXBF CUUDKB TAD CUUDKB / REFERENCE POINTER DCA CUUDKD / WORKING CLA CMA / SET UP POINTER TAD CUUDKY TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR JMS I CUDSLX / CHECK BUFFER BOUNDRIES /A033 NOP / STORAGE CANNOT BE FULL / TESTED IN UNDEFINED UDK OR / DEFINED UDK HAS BEEN DELETED TAD CUDNUM / OK; ENCODE & STORE UDK NUMBER TAD (CUUDID JMS I CUDSTX / (CUDSTR) /C024 /D033 JMP CUNORM / STORAGE FULL; SHOULD NOT GET HERE /C027 / FULL STORAGE WITH UNDEFINED UDK /C027 / TAKEN CARE OF IN (CUUNDF) /C027 / JMP I CUDFMX / NO ROOM, QUIT (CUDFMS) /C024 /D026 / DCA I CUDPTR /D023 /D031 TAD (-120 / RESET LINE CHAR COUNT TAD CUM120 / RESET LINE COUNT /A031 DCA CUDLIN TAD MLINCT / NUMBER OF LINES TO DISPLAY /A033 DCA LINCNT JMS I CUDSLX / TEST FOR BUFFER FULL BEFORE STORE /A033 NOP /A033 TAD CUDCHR / GET CHAR BACK JMP CUDIN1 / AND STORE IT CUDIN4, /A033 JMS I CUDSLX / TEST FOR BUFEER AND STORAGE FULL /A033 JMP I CUDFMX / STORAGE FULL /A033 TAD LINCNT / TEST FOR FULL SCREEN /A033 SNA CLA /A033 JMP I CNTSCX / SCREEN FULL; LOOK FOR R.O. OR G-HALT /A033 CUDINL, JMS I CUDDGX / GET A CHAR /C023 /C033 JMP I CUDCLX / HALT SET, ALL DONE /C023 /C033 JMP CUDINL / ILLEGAL INPUT /A030 TAD CUDRUB / CHECK IF RUBOUT ? SNA JMP CUDRUT / YES, REMOVE LAST CHAR TAD CUDNRB / NO, GET CHAR BACK CUDIN1, /D033 JMS I CUDSLX / SEE IF ROOM, NEEDED WHEN IN LAST BLOCK/A027 /D033 / CHAR IN AC IN, & OUT IF OK TO STORE /A027 /D033 JMP I CUDFMX / NO ROOM, AC = 0 /A027 /D032 JMS CUDDSP / DISPLAY CHAR; ABLE TO STORE /C027 /D033 JMS I CNTSCX / COUNT CHARS. ON SCREEN /A032 JMS I CUDDSX / DISPLAY KEYSTROKE; ABLE TO STORE /A032 / EXCEPT IF SCREEN FULL /A032 JMP CUDINL / JUMP IF CHARACTER IGNORED /A015 JMS I CUDSTX / STORE CHAR (CUDSTR) /C024 /D033 JMP I CUDFMX / NO MORE ROOM (CUDFMS) /C024 TAD CUUDKD / KEEP POINTERS IN SYNC /A023 DCA CUUDKC /A023 /D033 JMP CUDINL / ALL O.K., KEEP GOING JMP CUDIN4 / SEE IF ROOM BEFORE NEXT KEYSTROKE /A033 / /M031 CUDRET, CIFSYS / ++++ /M031 UDKOPS / TURN UDK'S BACK ON /M031 JMP I CUUDF1 / AND RETURN /C023 CUDCHR, 0 /A023 /D033 CUDRUB, 0 /A023 /D033 CUDNRB, 0 /A023 /D033 CUDADR, 0 /A023 /D033 CUDSWT, 0 /A023 / /RUBOUT OUT A CHARACTER /WATCH OUT FOR UDK BEGINNING, BUFFER BOUNDRY, BLOCK HANDLING /CUUDKB: STARTING BLOCK; CUUDKY: STARTING WORD CUDRUT, JMS CUDRU0 / CHECK FOR END OF BUFFER, ADJUST POINTERS TAD CUDNUM TAD (CUUDID CIA TAD I T1 SNA CLA / IS CURRENT CHARACTER THE UDK ID? JMP CUDRBL / YES, SET SWITCH DCA I T1 / COMMAND; LEGAL TO REMOVE CHARACTER CMA TAD T1 / BACK UP POINTER DCA CUDPTR JMS I CURWUX / WRITE THE ALTERED BLOCK (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD JMS I CURWUX / SET UP TO REPAINT THE SCREEN (CURWUD) /C024 RXERD CUDXBF CUUDKB TAD CUUDKY / SET POINTER TO FIRST WORD TAD CUDXBC / (CUDXBF /C024 DCA CUDPTR TAD CUUDKB / RESET BLOCK POINTER DCA CUUDKC JMS CUDIN3 / DISPLAY HEADER /A032 JMS I CUDDIX / DISPLAY UDK /C032 TAD CUUDKC / KEEP POINTERS IN SYNC. DCA CUUDKD JMP CUDRU9 CUDRBL, TAD CUDP7 / MOURNING BELLS ARE RINGING (WAS (7 ) /C026 JMS I CUDOUX / (CUDOUT) /C026 CUDRU9, /D033 JMP CUDINL / TRY SOMETHING ELSE /C023 JMP CUDIN4 /A033 CUNORM, /A026 CIFMNU /A026 JMS I IOACAL /A026 CUDMSC, 0 /A026 /C033 /D033 CUDMS8 /^ANO ROOM --- ^A^S /A026 CUDMS3 / ^A UDK ... GOLD MENU ... ^S^S /A033 CUDMSA /CR,LF,LF /A026 /D033 CUDMSB /CR,LF /A026 IFDEF V30NOR < CUTRYK /A039 CUNUL /A039 > CUDMS7 /PRESS GOLD MENU ... /A026 CUDMSC / DUMMY ARG TO FILL CUDMS3 /A033 JMS I CUDPOX / POSITION CURSOR /A026 CUNOR1, /A026 JMS I CUDGCX / GET G. M. /A026 JMP CUNOR2 / GOLD HALT; NOT LEGAL /A026 TAD (-EDMENU /A026 SNA CLA /A026 JMP I CUDREX / (CUDRET) FOUND G.M., EXIT /A026 CUNOR2, /A026 TAD CUDP7 / (7 ;BELL /A026 JMS I CUDOUX / (CUDOUT) /A026 CLA /A031 CDFSYS / CLEAR HALT SWITCH SO NEXT /A031 DCA I HLTFLG / CALL TO READ DOESN'T FIND IT /A031 / CHAR GET ROUTINE RESETS DATA FIELD JMP CUNOR1 / TRY AGAIN /A026 / ************* M032 ************ / ****** MADE SUBROUTINE AND MOVED FROM "CUDIN2" ****** CUDIN3, 0 CIFMNU JMS I IOACAL / Modifying user key #. Press Gold HALT to 0 / default output routine CUDMS2 / string address 0 / cursor position IFNDEF FRENCH < IFNDEF CANADA < 10 / cursor position (not in french or canada) >> CUDNUM / UDK number /D033 100 / cursor position IFDEF V30NOR < CUTRYK > 200 JMP I CUDIN3 / *********** M032 *********** PAGE CUDCL0, / SET UP TO CLOSE UDK JMS I CURWDX / READ DIRECTORY (CURWDI) /C024 RXERD TAD CUDPTR / SAVE CURRENT ADDRESS DCA T3 TAD CUDNUM / CONSTRUCT DIRECTORY ADDRESS TAD CUDGBB / ADDRESS OF CUDBUF DCA T1 TAD CUDNUM / TEST FOR ID TAD (CUUDID CIA TAD I T3 SZA CLA / IF ID THEN NULL UDK JMP CUDCLS / NOT NULL, NORMAL EXIT DCA I T3 / NULL, CLEAR ID HERE JMP CUDCL1 / CLEAR DIRECTORY ENTRY /C033 CUDCLS, /D033 TAD (-DLUDKS-1 / CONSTRUCT DIRECTORY ENTRY TAD MDLUM1 / -DLUDKS-1; /A033 TAD CUUDKB BSW CLL RTL DCA I T1 / BLOCK PART OF ADDRESS TAD CUUDKY TAD I T1 CUDCL1, /C033 DCA I T1 / RELATIVE WORD PART OF ADDRESS JMS I CURWDX / WRITE THE DIRECTORY (CURWDI) /C024 RXEWT+2000 JMS I CURWUX / WRITE THE CURRENT BUFFER (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD JMP I CUDREX / (CUDRET) /C026 / CUDFMS MOVED FROM HERE TO A COUPLE OF PAGES HENCE /M023 / / / CUDDIS / THIS ROUTINE DISPLAYS THE UDK POINTED TO BY CUDADR / ON THE SCREEN STARTING FROM LINE 2. ON RETURN, IT LEAVES / THE AC ZERO AND CUDPTR POINTING TO THE END (FINAL 0) OF / THE UDK. / CUDDIS, 0 CIFMNU JMS I IOACAL / Clear from the second line to EOS 0 / Using default output routine CUDMS5 / String to clear screen 100 / cursor position 200 / cursor position /C033 / /D031 TAD (-120 / RESET LINE CHAR COUNT TAD CUM120 / RESET LINE COUNT /A031 DCA CUDLIN TAD MLINCT /A033 DCA LINCNT / CLEAR CHAR COUNTER /A032 JMP CUDDI2 / TEST FOR END OF STORAGE FIRST /A023 CUDDI1, TAD I CUDPTR / GET A CHAR SNA / END OF UDK STRING ? JMP CUDDID / YES, GO CHECK INPUT JMS I CUDDSX / NO, DISPLAY CHAR /C032 NOP /FILLER /A015 CLA CUDDI2, JMS I CUDILX / CHECK FOR BUFFER & BLOCK END (CUDILM) /C024 /D033 JMP CUDDID / OUT OF DATA /A023 NOP / CAN'T BE OUT OF DATA /A033 JMP CUDDI1 / AND BACK FOR MORE / CUDDID, AC7777 / SET CUDPTR BACK ONE TAD CUDPTR / SO THAT NEXT STORE WILL OVERWRITE DCA CUDPTR / TRAILING ZERO JMP I CUDDIS / RETURN / / CUDGAR / THIS ROUTINE TAKES THE UDK POINTED TO BY CUDADR / DELETES IT, MOVE ALL FOLLOWING UDK'S DOWN, AND / RETURNS THE NEW VALUE TO START STORING THIS UDK. / CALLED WITH: / JMS CUDGAR / RETURN (AC=0) / CUDGAR, 0 JMS I CURWDX /CLEAR DIRECT'Y ENTRY IN CASE THIS(CURWDI)/C024 RXERD / IS THE LAST UDK IN STORAGE JMS I CUDIMX / MOVE DIRECTORY TO BUFFER /A031 CUDIBB, DIRBUF / DESTINATION /A031 CUDBUF / SOURCE /A031 -CUUDNM / COUNT /A035 TAD CUDNUM /D031 TAD CUDGBB / ADDRESS OF CUDBUF TAD CUDIBB / ADDRESS OF BUFFER /A031 DCA T1 / CORE ADDRESS OF ENTRY DCA I T1 / CLEAR THE UDK ADDRESS /D031 JMS I CURWDX / WRITE THE DIRECTORY (CURWDI) /C024 /D031 RXEWT+2000 JMS CUDG01 / SET UP AND READ UDK BLOCK CUDG20, TAD CUDCUR / SET UP ZERO UDK WE ARE DELETING DCA CUDNXT / WE NEED TO DO THIS BECAUSE WE MAY SET / "CUDCUR" IN "CUDOLM" TAD I CUDCUR / GET A KEYSTROKE SNA CLA / TEST FOR END JMP CUDG21 / FOUND END OF UDK DCA I CUDNXT / NOT END, CLEAR KEYSTROKE JMS CUDOLM / BE CAREFUL ABOUT END OF STORAGE JMP CUDG20 / DO ANOTHER CUDG21, JMS CUDG01 / SET POINTERS AND READ BLOCK / WE GOT HERE AFTER DISPLAY OF UDK & A LEGAL KEYSTROKE / SO WE ARE GOING TO OVERWRITE UDK JUST DISPLAYED BY / MOVING EVERY THING ELSE UP. ASSUME NO HOLES, AND IF / NEXT CHAR FROM UDK IS NOT ID THERE ARE NO MORE UDK'S. /D031JMS I CUDILX /HAVE WE REACHED THE END OF INPUT?(CUDILM)/C024 /D031NOP / WE CANNOT BE AT END OF STORAGE /D031 / BECAUSE OF INPUT ALGORITHM ISZ CUDPTR / POINTER DECREMENTED AT END OF DISPLAY / SO ADJUST HERE JMS I CUDILX / IS THE INPUT BUFFER NOW EMPTY? /A031 NOP / CANNOT BE END OF STORAGE, /A031 / SO IGNORE OUT-OF-DATA RETURN /A031 CUDG05, TAD I CUDPTR / THERE IS AT LEAST ONE MORE CHARACTER. DCA CUDKNM / SAVE THE UDK # TAD CUDKNM / CHECK FOR UDK ID TAD (-CUUDID SPA JMP CUDG90 / NOT AN ID WHERE WE EXPECTED ONE, END TAD (-CUUDNM SMA CLA JMP CUDG90 / NOT AN ID, END JMS CUDOLM / CHECK FOR END OF BUFFER /A031 TAD CUDKNM / NOW WE CAN MOVE THIS UDK. DCA I CUDCUR / MOVES UDK # TO OUTPUT CUDG10, JMS CUDOLM / CHECK FOR ROOM IN OUTPUT BUFFER JMS I CUDILX / TEST FOR END OF INPUT BUFFER (CUDILM) /M025 NOP / INPUT CANNOT END W/O TERMINATING 0 /M025 TAD I CUDPTR DCA T1 / SAVE BECAUSE MIGHT BE TERMINATING 0 TAD T1 DCA I CUDCUR / AND STUFF IT TAD T1 SNA CLA JMP CUDG80 / FOUND END OF UDK / NEXT TWO LINES MOVED BACK 7 LINES /D025 JMS I CUDILX / TEST FOR END OF INPUT BUFFER (CUDILM) /C024 /D025 NOP / INPUT CANNOT END W/O TERMINATING 0 JMP CUDG10 CUDKNM, 0 CUDG01, / PART OF ZERO UDK 0 CLA CMA / SET UP POINTER TAD CUUDKY TAD CUDGBB / ADDRESS OF CUDBUF DCA CUDCUR TAD CUUDKB / SET UP WORKING BLOCK DCA CUUDKD JMS I CURWUX / READ UDK BLOCK (CURWUD) /C024 RXERD CUDGBB, CUDBUF CUUDKB JMP I CUDG01 PAGE / / CUDDSP / Display the character contained in the AC on the screen. Print the names / of the GOLD sequences, if there are names. If the name will not fit on the / line then go to the next line on the screen. / / If character to be displayed is negative (a WPKBDA character) /A013 / and beyond EDUKND, it will not be displayed or stored. /A013 / ROUTINE WILL EXIT TO CALL+1 IF CHARACTER IS NOT DISPLAYABLE /A015 / ROUTINE WILL EXIT TO CALL+2 IF CHARACTER IS DISPLAYABLE (AND STORABLE)/A015 CUDDSP, 0 DCA T1 / Save the character in the AC in a temporary TAD T1 / Get it back in AC TAD (-40 / Encode it for comparisons later DCA T2 / SAVE IT LIKE THIS TAD T2 / Get it back into AC SPA SNA / Is it a printable character? JMP CUDDS3 / No. SPECIAL CHAR: GO DISPLAY by name / Yes. Print it in UDK format... AC0001 JMS CUDLCK / SEE IF ROOM FOR ONE CHAR TAD T1 / Get the raw character JMS CUDIOT / Print it CUDDS2, TAD (40 / and print a trailing space JMS CUDIOT TAD T1 / Put the raw character back into AC ISZ CUDDSP /BUMP RETURN ADDRESS /A015 JMP I CUDDSP / and return to caller / / Special character printing code. Print the name of the sequence on the / screen. / CUDDS3, AC0006 / SEE IF ROOM FOR 6 CHARS on this line IFDEF SCANDI < IAC / check for 7 characters, if Scandinavian > IFDEF FRENCH < TAD (2 / check for 8 characters, if french > IFDEF GERMAN < TAD (2 / or German > JMS CUDLCK TAD T2 / Get the encoded character SZA / Is it a space? TAD (40 / Yes: decode it. CIA / Make encoded characters positive values. TAD (EDUKND /CHECK /A013 SMA SZA /FOR /A013 JMP CUDDS6 /BEYOND END OF TABLE, IF SO JUMP /A013 TAD (-EDUKND /RESTORE CODE /A013 JMS CUDSS0 / SPECIAL DISPLAY FOR UDK /A023 JMP CUDDS2 / UDK DISPLAYED /A023 CLL RAL / Multiply by two to skip table parameters. TAD (CUDTAB / Get beginning of table DCA T2 / Store the table pointer TAD I T2 / Get the character description DCA CUDDS4 / Install it in the IOA call TAD T2 / Get the table pointer again IAC / Increment it to point to the table parameter DCA CUDDS5 / Install pointer in IOA call TAD I CUDDS5 / Get the argument pointed to. SNA CLA / Is there one? DCA CUDDS5 / No, clear the argument parameter. CIFMNU JMS I IOACAL / Print the character name CUDIOT / Using the special I/O routine CUDDS4, XX / Description text CUDDS5, XX / Argument (if any--0000 if none.) JMP CUDDS2 / return to the subroutine mainline CUDDS6, CLA /CLEAR AC /A013 /D0014 ISZ CUDDSP /BUMP RETURN ADDRESS TO SKIP STORE /A013 JMP I CUDDSP /EXIT, GRACEFULLY /A013 / CUDLCK, 0 / CHECKS THE LINE COUNT TO SEE IF THERE / IS ENOUGH ROOM FOR THE NEXT GROUP OF CHARS. / SIZE OF THE GROUP IS IN THE AC, WHEN CALLED. / TAD CUDLIN / ADD IN LINE COUNT SMA CLA / SEE IF OVERFLOWED ? JMP CUDLC1 / YES, GIVE CR-LF, ETC. JMP I CUDLCK / NO, RETURN / CUDLC1, / TEST FOR LAST LINE /A032 TAD (15 / CR JMS I CUDOUX / (CUDOUT) /C026 TAD (12 / LF JMS I CUDOUX / (CUDOUT) /C026 /D031 TAD (-120 / RESET COUNTER TAD CUM120 /A031 DCA CUDLIN ISZ LINCNT / BUMP NUMBER OF LINES ON SCREEN /A033 NOP / ALL WE ARE DOING IS BUMPING THE / COUNTER; IT IS TESTED AT "CUDIN4" JMP I CUDLCK / AND RETURN / /D031 CUDLIN, -120 / CROSS-FEILD CALLABLE ROUTINE THAT INCREMENTS THE / NUMBER OF CHARS ON A LINE COUNT AND DISPLAYS THE CHAR / IN THE AC ON THE SCREEN USING CUDOUT. IT DOESN'T DISPLAY THE CHAR / IF THE CHAR COUNT (CUDLIN) GOES TO ZERO. CUDIOT, 0 DCA T2 / SAVE CHAR FOR A WHILE RDF TAD CIDF0 / MAKE CDF CIF DCA CUDIOR CDFMYF / MAKE SURE WE'RE IN THE RIGHT PLACE TAD T2 / GET CHAR BACK SNA / SEE IF END OF IOA STRING ? JMP CUDIOR / YES, RETURN ISZ CUDLIN / SEE IF END OF LINE REACHED JMS I CUDOUX / NO, DISPLAY CHAR /D033 JMS CUDIO1 / COUNT CHARS DISPLAYED /A032 CLA / YES, DON'T DISPLAY AND CLEAR AC CUDIOR, .-. JMP I CUDIOT / RETURN /D033 CUDIO1, / COUNT CHARS SENT TO SCREEN /A032 /D033 0 /A032 /D033 ISZ LINCNT /A032 /D033 JMS I CUDOUX /A032 /D033 JMP I CUDIO1 /A032 CUDGCR, 0 / THIS ROUTINE CHECKS THE KEYBOARD FOR INPUT. / IT NORMALLY RETURNS WITH THE NEXT INPUT CHARACTER / IN THE AC. / CALLED WITH: / JMS CUDGCR / HALT FLAG SET RETURN (AC=0) / REGULAR RETURN (AC CONTAINS CHARACTER) / JMP CUDGC2 / DON'T JWAIT YET CUDGC1, CIFSYS / ++++ JWAIT CUDGC2, CDFSYS TAD I HLTFLG / CHECK HALT FLAG CDFMYF SZA CLA JMP I CUDGCR / SET, JUST RETURN CIFSYS / ++++ XLTIN / ++++ JMP CUDGC1 / CHECK KEYBOARD TAD (-EDPWFL / SEE IF POWER FAIL SNA JMP I CUDGCR / YES, PRETEND IT'S A HALT TAD (EDPWFL / NO, GET CHAR BACK ISZ CUDGCR / AND RETURN WITH CHAR JMP I CUDGCR / CUDSTR / STORE A CHARACTER AWAY IN A UDK / CALLED WITH CHAR TO STORE IN AC: / JMS CUDSTR OR JMS I CUDSTX /C024 / NO MORE ROOM RETURN (AC=0) / REGULAR RETURN (AC=0) / CUDSTR, 0 / POINTED TO BY CUDSTX /C024 /D015 SNA /CHARACTER TO STORE? /A0014 /D015 JMP CUDST1 /NO, SKIP STORAGE STUFF /A0014 /D033 JMS I CUDSLX / ROOM FOR TWO CHARACTERS?(CUDSLM)/C027 /D033 JMP CUDST1 / NO DCA I CUDPTR / STORE CHAR JMS I CUDSLX / (CUDSLM) TO GET NEXT BUFFER /C027 NOP IAC TAD CUDPTR / GOING TO INSERT TERMINATING 0 DCA T1 DCA I T1 /D033 ISZ CUDSTR /M0014 JMP I CUDSTR / YES, RETURN / / Substring to cut down on message sizes for CUDMS6,7,1 and 2 /A039 / / IFDEF V30NOR < CUTRYK, TEXT ' &TRYKK P\E &GULL ' /Press Gold.. /A039 CUEL, TEXT '!&EL.' /Or /A039 CUNUL, TEXT ' ' / Dummy for CUDMS7 /A039 > /---------------------------- PAGE / CHECK FOR FULL OUTPUT BUFFER (CUDBUF) / BECAUSE WE ARE DELETING A UDK / WE CAN NEVER RUN OUT OF BLOCKS CUDOLM, XX TAD CUDCUR / CONTAINS ADDR OF LAST CHAR STORED CIA /D033 TAD (CUDBUF+CUBFSZ-1 TAD BUFEND / ADDRESS OF END OF BUFFER 1 /A033 SZA CLA JMP CUDOL9 / STILL ROOM, EXIT JMS I CURWUX / FULL, WRITE BLOCK (CURWUD) /C024 RXEWT+2000 CUDBUF CUUDKD ISZ CUUDKD / BUMP TO NEXT BLOCK TAD (CUDBUF-1 DCA CUDCUR / RESET POINTER CUDOL9, JMP I CUDOLM / CHECK FOR FULL INPUT BUFFER (CUDBUF+400) / CALL+1: OUT OF DATA; CALL+2: CONTINUE / IF FROM "CUUNDF" (UNDEFINED), AC = -3; ELSE AC = 0; USED IN LAST BLOCK CUDILM, XX DCA CUDILA / SAVE CHAR. COUNT FOR END CONDITION /A033 / SET = -2 BY UNDEFINED; ELSE = 0 /A033 TAD CUUDKC / CURRENT BLOCK IN CORE /M033 CIA /M033 /D033 TAD (DLUDKS+CUNBLK / LAST BLOCK /M033 TAD DLUCUN / LAST BLOCK /A033 SNA CLA / ANOTHER TO READ? /M033 JMP CUDIL7 / OUT OF DATA /M033 TAD CUDPTR / CONTAINS ADDR OF LAST CHAR RETRIEVED CIA /D033 TAD (CUDXBF+CUBFSZ-1 / ADDR OF END OF BUFFER TAD XBFEND / ADDR. OF END OF BUFFER 2 /A033 SZA CLA JMP CUDIL8 / BUFFER NOT EMPTY, CONTINUE ISZ CUUDKC / BUMP TO NEXT BLOCK JMS I CURWUX / READ IT (CURWUD) /C024 RXERD CUDXBF CUUDKC TAD (CUDXBF-1 / SET POINTER TO BUFFER-1 DCA CUDPTR CUDIL8, ISZ CUDILM / BUMP RETURN FOR MORE DATA CUDIL9, JMP I CUDILM / ************ A033 ************* CUDIL7, / IN LAST BLOCK; MUST BE AT LEAST 3 PLACES LEFT / IF FROM UNDEFINED UDK; ELSE DOESN'T MATTER / ZERO TERMINATOR WILL BE ENCOUNTERED TAD CUDPTR CIA TAD CUDILA / CONSTANT TO ADJUST FOR SPACE LEFT /D033 TAD (CUDXBF+CUBFSZ-1 TAD XBFEND / ADDR. OF END OF BUFFER 2 /A033 /D033 SZA CLA SMA CLA /A033 JMP CUDIL8 / STILL ROOM JMP CUDIL9 / NO ROOM / ************* END A033 ************ / READ/WRITE UDK BLOCK. / ARGUMENTS: FUNCTION, BUFFER, BLOCK CURWUD, / POINTED TO BY CURWUX /C024 XX DCA QUQBLK+RXQDRV / WAS JMS SETUSD /C027 RDF TAD CDF0 DCA QUQBLK+RXQBFD / RETURN FIELD TAD I CURWUD ISZ CURWUD DCA QUQBLK+RXQFNC / FUNCTION TAD I CURWUD ISZ CURWUD DCA QUQBLK+RXQBAD / BUFFER TAD I CURWUD ISZ CURWUD DCA CURWAA TAD I CURWAA DCA QUQBLK+RXQBLK / BLOCK JMS QURX CLA JMP I CURWUD / DECODE ADDRESS OF UDK IN DIRECTORY BLOCK CUDCOD, / POINTED TO BY CUDCOX /C024 XX TAD I CUDIPT / ADDRESS OF ADDRESS AND (CUBKMS / KEEP BLOCK PART BSW / TO BITS 6,7,8,9 CLL RTR / TO BITS 8,9,10,11 /D033 TAD (DLUDKS+1 / + STARTING BLOCK # TAD DLUDP1 / DLUDKS+1; STARTING BLOCK /A033 DCA CUUDKB TAD I CUDIPT AND (CUWDMS / KEEP WORD PART DCA CUUDKY / RELATIVE WORD ADDRESS TAD CUUDKB DCA CUUDKC / SET UP WORKING POINTER JMP I CUDCOD / CUDIPT, CUUDKB, CUUDKW, CUUDKY, CUUDKD, CUUDKC MOVED TO PAGE 0 /M023 CUDFMS, / NO MORE ROOM (POINTED TO BY CUDFMX) /C026 JMS CUDFMM / MESSAGE ROUTINE /A032 CUDMS3 / ARGUMENT /A032 JMP CUTSC1 / LOOK FOR LEGAL INPUT /A033 /D033 CUDFUL, /C026 / TAD (7 / RING-A-DING /D026 / JMS CUDOUT /D026 / CIFMNU /D026 / JMS I IOACAL /D026 / 0 /D026 / CUDMS4 /D026 / -2700 /D026 /D033 JMP I .+1 / GET NEXT INPUT /A029 /D033 CUDINL /A029 /D029 JMS CUDPOS /A026 /D029 JMS I CUDGCX / READ CHARACTER /C031 /D029 JMP CUDCL0 / HLT SET, FINISH UP (WAS CUDCLS) /C026 /D029 CLA /A027 / TAD (-EDMENU / SEE IF USER TYPED GOLD MENU /D027 / SNA CLA /C026 /D027 / JMP I CUDREX / (CUDRET) /A026 /D027 /D029 TAD CUDP7 / (TAD (7 ) /A026 /D029 JMS I CUDOUX / (CUDOUT) /A026 /D029 JMP CUDFUL / NO, KEEP CHECKING / ********** A032 *********** / MOVED FROM CUDFMS AND MADE SUBROUTINE CUDFMM, 0 TAD I CUDFMM / LOAD MESSAGE ADDRESS DCA CUDFM1 ISZ CUDFMM / BUMP FOR RETURN CIFMNU / GIVE MESSAGE /C026 JMS I IOACAL 0 /C026 CUDFM1, CUDMS3 /"^a---text---^s^s" /C026 /C029 /C033 CUDMSA /"RET,LF,LF" /C026 /D033 CUDMSB /"RET,LF" /C026 CUDMS9 /"DELETE KEYSTROKE(S)" /A029 /D033 CUDMSB /"RET,LF" /A029 IFDEF V30NOR < CUEL CUTRYK > CUDMS6 /"PRESS GOLD HALT ... " /A026 /D033 CUDMSB /"RET,LF" /A026 JMP I CUDFMM / *************** END A032 *********** CUDOUT, 0 JMP CUDOU2 CUDOU1, CIFSYS JWAIT CUDOU2, CIFSYS TTYOU JMP CUDOU1 JMP I CUDOUT CUDPOS, /A026 0 /A026 CIFMNU /A026 JMS I IOACAL /A026 0 /A026 CUDMS4 /"^P" /A026 -2700 /A026 JMP I CUDPOS /A026 / ********** A033 *********** CNTSCR, JMS I CUDFMY / MESSAGE ROUTINE CUDMS0 / UDK FULL CUTSC1, JMS I CUDDGX / GET KEYBOARD INPUT JMP I CUDCLX / G-HALT; CLOSE UDK JMP CUTSC1 / ILLEGAL INPUT TAD CUDRUB / IS IT R.O.? SNA CLA JMP CUDRUT / YES; R.O. LAST AND GO TO NORMAL INPUT TAD CUDP7 / NO; RING BELL AND TRY AGAIN JMS I CUDOUX JMP CUTSC1 / ************** END A033 ********** PAGE / BE SURE THERE IS ROOM FOR TWO CHARACTERS IN LAST BLOCK / ELSE CHECK BUFFER BOUNDRY; WRITE BLICK & ZERO BUFFER / AS NECESSARY. / CALL+1: NO ROOM, AC CLEAR, CHAR IN T1 / CALL+2: STILL ROOM, CHAR IN AC CUDSLM, XX DCA T1 / SAVE CHARACTER /D033 TAD (DLUDKS+CUNBLK / TEST FOR LAST BLOCK TAD DLUCUN / LAST BLOCK /A033 CIA TAD CUUDKD SNA CLA JMP CUDSL3 / LAST BLOCK FOUND /D033 TAD (CUDXBF+CUBFSZ-1 / NOT LAST; TEST FOR BUFFER END TAD XBFEND / ADDR. OF END OF BUFFER 2; BUFFER END? /A033 CIA TAD CUDPTR SZA CLA JMP CUDSL1 / STILL ROOM JMS I CURWUX / NO ROOM IN THIS BLOCK; WRITE (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKD ISZ CUUDKD / BUMP TO NEXT BLOCK TAD (CUDXBF-1 / SET TO BUFFER START-1 DCA CUDPTR JMS I CURWUX /A024 RXERD /A024 CUDXBF /A024 CUUDKD /A024 TAD CUUDKD /A024 DCA CUUDKC /A024 CUDSL1, TAD T1 / EXIT WITH ROOM ISZ CUDSLM CUDSL2, JMP I CUDSLM / WE ARE IN THE LAST BLOCK; NEED ROOM FOR TWO CHARACTERS / BECAUSE WE ARE TESTING BEFORE STORE C(CUDPTR) IS ONE LESS / THAN NEXT STORE LOCATION AND TWO LESS THAN TERMINATING 0. / LAST ALLOWABLE VALUE FOR "CUDPTR" IS BUFFER END - 3. CUDSL3, TAD CUDPTR /A026 CIA /A026 TAD (CUDXBF+CUBFSZ-3 /C033 SMA CLA /C026 JMP CUDSL1 / STILL ROOM JMP CUDSL2 / NO ROOM CUDSLA, 0 / PART OF SQUEEZE ROUTINE "CUDGAR" / FOUND END OF A UDK. UPDATE DIRECTORY IN BUFFER / AND COMPUTE NEXT UDK ADDRESS FOR NEXT ENTRY / CUDG80, /D031 JMS I CURWUX / WRITE OUTPUT BUFFER (CURWUD) /C024 /D031 RXEWT+2000 /D031 CUDBUF /D031 CUUDKD /D031 JMS I CURWDX / READ DIRECTORY INTO "CUDBUF" (CURWDI) /C024 /D031 RXERD TAD CUDKNM / DECODE UDK # FROM PTR. TO DIREC. TAD (-CUUDID / UDK WORD = UDK # + 2001 /D031 TAD (CUDBUF / UDK # + START OF BUFFER TAD (DIRBUF / UDK # + START OF BUFFER /A031 DCA CUDGAA / = ADDRESS OF SLOT IN DIREC. /D033 TAD (-DLUDKS-1 TAD MDLUM1 / -DLUDKS-1 /A033 TAD CUUDKB / ABSOLUTE BLOCK - FIRST BLOCK BSW / = RELATIVE BLOCK CLL RTL / TO BITS 0,1,2,3 DCA I CUDGAA / STORE IN SLOT TAD CUUDKY / RELATIVE WORD TAD I CUDGAA / ADD TO SLOT FOR COMPLETE ADDRESS DCA I CUDGAA /D031 JMS I CURWDX / WRITE DIRECTORY BACK OUT (CURWDI) /C024 /D031 RXEWT+2000 /D031 JMS I CURWUX / READ OUTPUT BLOCK BACK IN (CURWUD) /C024 /D031 RXERD /D031 CUDBUF /D031 CUUDKD TAD CUUDKD / SET UP TO COMPUTE NEXT UDK ADDRESS DCA CUUDKB TAD (-CUDBUF+1 TAD CUDCUR DCA CUUDKY / RELATIVE WORD JMS I CUDILX / IS THERE MORE INPUT? (CUDILM) /C024 NOP / CAN'T BE AT PHYSICAL END OF STORAGE JMP CUDG05 / YES, MOVE NEXT UDK / WE HAVE REACHED THE END OF INPUT / ZERO REMAINING WORDS OF BLOCK CUDG90, CLA DCA I CUDCUR TAD CUDCUR CIA /D033 TAD (CUDBUF+CUBFSZ-1 TAD BUFEND / ADDR. OF END OF BUFFER 1 /A033 SZA CLA JMP CUDG90+1 JMS I CURWUX / WRITE THE BLOCK (CURWUD) /C024 RXEWT+2000 CUDBUF CUUDKD JMS I CUDIMX / MOVE DIRECTORY TO DISK BUFFER /A031 CUDBUF / DESTINATION /A031 DIRBUF / SOURCE /A031 -CUUDNM / COUNT /A035 / ************* ADD 031 ************** / ZERO BALANCE OF DIRECTORY BUFFER FOR NEATNESS TAD (CUDBUF+CUUDNM / PLACE TO START DCA CUDGAA TAD (CUUDNM-CUBFSZ / NUMBER OF LOCATIONS DCA CUDSSA CUDG91, DCA I CUDGAA ISZ CUDGAA / BUMP POINTER ISZ CUDSSA / COUNT JMP CUDG91 / ***************** END ADD 031 ********** JMS I CURWDX / WRITE THE DIRECTORY /A031 RXEWT+2000 /A031 TAD CUDGAR / GET RETURN ADDRESS DCA CUDGAA JMP I CUDGAA / AND GO THERE CUDGAA, 0 / EXTENSION TO DISPLAY ROUTINE FOR UDK'S CUDSS0, 0 DCA CUDSSA TAD CUDSSA TAD (EDUDK0 / BOTTOM VALUE CIA DCA CUDSSB / SAVE BINARY VALUE TAD CUDSSB SPA JMP CUDSS9 / NOT A UDK TAD (-CUUDNM / RANGE SMA CLA JMP CUDSS9 / NOT A UDK CIFMNU / OUTPUT WITH IOA JMS I IOACAL 0 CUDSSM / MESSAGE ADDRESS CUDSSB / VALUE AC0006 / UPDATE LINE COUNT FOR UDK:NN /A031 TAD CUDLIN / UPDATE LINE COUNT /A023 /D031 TAD (7 / WITH 7 CHAR FOR GOLD:NN /A023 DCA CUDLIN /A023 JMP CUDSS8 CUDSS9, CLA TAD CUDSSA / NOT A UDK; RETURN VALUE ISZ CUDSS0 CUDSS8, JMP I CUDSS0 CUDSSA, 0 CUDSSB, 0 / TEXT CUDSSM: GOLD:!2D MOVED TO MESSAGE PAGE /M023 PAGE / UDK REQUESTED IS NOT DEFINED. / FIND LAST UDK SO WE CAN ADD THE REQUESTED ONE TO THE END OF UDK STORAGE / DIRECTORY IN CORE AT "CUDBUF" / SCAN DIRECTORY FOR HIGHEST UDK ADDRESS / WHEN ADDRESS FOUND, FIND END OF THAT UDK; KEEP TRACK OF AADDRESS / FOR DIRECTORY UPDATE WHEN REQUESTED UDK IS ENTERED CUUNDF, XX DCA T3 / GOING TO BE HIGHEST BLOCK ADDRESS DCA T2 / GOING TO BE HIGHEST WORD ADDRESS FOR T3 TAD (CUDBUF-1 / POINTER FOR DIRECTORY DCA CUDPTR TAD (-CUUDNM / COUNTER FOR NUMBER OF UDK'S DCA T1 CUUND1, TAD I CUDPTR SNA CLA / DOES UDK EXIST? JMP CUUND8 / NO, COUNT ENTRIES TAD CUDPTR DCA CUDIPT / SAVE THE ADDRESS JMS I CUDCOX / CUUDKB: STARTING BLOCK (CUDCOD) /C024 / CUUDKY: RELATIVE WORD / CUUDKW: ABSOLUTE CORE ADDRESS TAD T3 CIA TAD CUUDKB / COMPARE LAST BLOCK TO CURRENT BLOCK SPA JMP CUUND8 / CURRENT BLOCK .LT. LAST SZA JMP CUUND3 / CURRENT BLOCK .GT. LAST; UPDATE LAST TAD T2 / CURRENT BLOCK .EQ. LAST; CHECK WORD CIA TAD CUUDKY SPA CLA JMP CUUND8 / CURRENT WORD .LT. LAST; LAST STILL HIGH CUUND4, TAD CUUDKY / CURRENT WORD .GT. LAST; BLOCK #'S .EQ. DCA T2 / UPDATE WORD JMP CUUND8 CUUND3, CLA TAD CUUDKB / UPDATE BLOCK AND WORD DCA T3 JMP CUUND4 CUUND8, CLA ISZ T1 / COUNT UDK ENTRIES JMP CUUND1 / NOT DONE SCAN TAD T3 / NOW HAVE ADDRESS OF LAST UDK SNA / TEST FOR NO DEFINED UDK'S /A024 /D033 TAD (DLUDKS+1 / FIRST DATA BLOCK /A024 TAD DLUDP1 / DLUDKS + 1; FIRST DATA BLOCK /A033 DCA CUUDKC / SET UP FOR READ TAD (CUDXBF-1 TAD T2 DCA CUDPTR / POINTER = RELATIVE WORD + BUFFER START JMS I CURWUX / READ UDK (CURWUD) /C024 RXERD CUDXBF CUUDKC CUUND7, TAD I CUDPTR / GET CHARACTER FROM UDK SNA CLA JMP CUUND9 / FOUND END OF LAST DEFINED UDK JMS I CUDILX / END OF BUFFER OR STORAGE? (CUDILM) /C024 /D033 JMP I CUDFMX / END OF STORAGE (CUDFMS) /C024 NOP / CAN'T RUN OUT OF STORAGE HERE /A033 JMP CUUND7 CUUND9, TAD CUUNM3 / FOR LAST BLOCK TEST /A033 JMS I CUDILX / BE SURE NOT AT END OF BLOCK,ETC.(CUDILM)/C024 / JMP I CUDFMX / NO ROOM (CUDFMS) /C024 /D027 JMP CUNORM / AT END OF STORAGE; QUIT IMMEDIATELY /A027 TAD CUDPTR / PUT IN A TERMINATOR SO WE IAC / DON'T DISPLAY GARBAGE DCA T1 DCA I T1 JMS I CURWUX / (CURWUD) /C024 RXEWT+2000 CUDXBF CUUDKC TAD T3 / TEST FOR NO DEFINED UDK'S /A024 SZA CLA /A024 JMP CUUCUU / .+3 /A024 TAD CUDXBC /A024 DCA CUDPTR /A024 CUUCUU, TAD CUDPTR /C024 IAC AND P377 DCA CUUDKY / CONSTRUCT RELATIVE WORD TAD CUUDKC DCA CUUDKB / BE SURE TO HAVE COPY OF FIRST BLOCK DCA CUGASW / CLEAR SQUEEZE SWITCH FOR NO SQUEEZE JMP I CUUNDF CUUNM3, -3 /A033 /CUGASW, 1 / SET TO SQUEEZE INITIALLY /MOVED TO PAGE 0 /D023 / USED BY EXTENSION TO KEYBOARD INPUT ROUTINE "CUDDG0" CUDGL0, 0 JMS I CUDGCX / GET THE KEYSTROKE JMP CUDGL1 / HALT OR POWER FAIL; CALL+1; AC=0 DCA CUDGGA TAD CUDGGA TAD (-EDNWLN / {RETURN}? SNA CLA JMP CUDGL3 / FOUND {RETURN}; CALL+3; AC=0 TAD CUDGGA TAD CUDG60 / DIGIT? SPA JMP CUDGL2 / NOT {RETURN} OR DIGIT; CALL+2; AC=0 TAD (-11 / RANGE SMA SZA CLA JMP CUDGL2 / NOT {RETURN} OR DIGIT ISZ CUDGL0 / FOUND DIGIT; CALL+4; AC=0; CUDGGA=CHAR. CUDGL3, ISZ CUDGL0 CUDGL2, ISZ CUDGL0 CUDGL1, CLA JMP I CUDGL0 / TESTING FOR BEGINNING OF BUFFER WHEN DELETING KEYSTROKES / READS PREVIOUS BUFFER IF NECESSARY AND SETS POINTER AND / DISK BLOCK CUDRU0, 0 TAD CUDPTR TAD (-CUDXBF+1 SZA CLA JMP CUDRU1 / NOT AT START OF BUFFER CMA / DECREMENT BLOCK TAD CUUDKC DCA CUUDKC JMS I CURWUX / READ THE BLOCK (CURWUD) /C024 RXERD CUDXBF CUUDKC TAD CUUDKC / SET UP FOR NEXT WRITE IF DELETE DCA CUUDKD TAD (CUDXBF+377 / SET POINTER TO BUFFER TOP JMP CUDRU2 CUDRU1, TAD CUDPTR CUDRU2, DCA T1 JMP I CUDRU0 PAGE /A013 / EXTENSION TO CHAR. INPUT ROUTINE / {UDK}{RETURN}: ALWAYS A RUBOUT; SET RETURN CHARACTER / TO CONTENTS OF "CUDNUM"+EDUDK0 / {UDK}(M){RETURN}: WHERE (M) IS 0-99. A UDK ENTRY / C+1: GOLD HALT / C+2: ILLEGAL INPUT / C+3: KEYSTROKE IN AC CUDDG0, 0 JMS I CUDGCX / CHAR INPUT /C031 JMP CUDGG2 / POWER FAIL OR HALT DCA CUDGGA / SAVE INPUT TAD CUDGGA /D031 TAD MGOLDU / GOLD U TAD MEDUDK / UDK KEY (F14) /A031 SNA CLA JMP CUDD02 / FOUND GOLD U (UDK KEY - F14) /C033 CUDGG1, TAD CUDGGA CUDGG3, ISZ CUDDG0 CUDGG4, ISZ CUDDG0 CUDGG2, JMP I CUDDG0 CUDD01, / ILLEGAL INPUT; BELL AND EXIT C+2 TAD CUDP7 JMS I CUDOUX JMP CUDGG4 /D030 JMP CUDD02 / BYPASS ERROR FIRST TIME /D030 CUDD01, /D030 TAD CUDP7 / RING BELL FOR ILLEGAL CHARACTER /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD02, JMS I CUDGLX / GET KEYSTROKE AFTER {UDK} JMP CUDGG2 / GOT HALT OR POWER FAIL, EXIT JMP CUDD01 / NOT {RETURN} OR DIGIT, RING BELL JMP CUDD03 / GOT {RETURN}; {UDK}{RETURN} TAD CUDGGA / GOT DIGIT; {UDK}(M) TAD CUDG60 / MAKE INTO BINARY NUMBER DCA CUDGGB /D030 JMP CUDD05 /D030 CUDD04, /D030 TAD CUDP7 /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD05, JMS I CUDGLX / GET NEXT KEYSTROKE JMP CUDGG2 / HALT OR POWER FAIL, EXIT JMP CUDD01 / NOT DIGIT OR {RETURN}, RING BELL /C030 JMP CUDD10 / {RETURN}; {UDK}(M){RETURN} TAD CUDGGB / KEYSTROKE IN CUDGGA, MULTIPLY / LAST DIGIT BY 10 CLL RTL RAL TAD CUDGGB TAD CUDGGB DCA CUDGGB TAD CUDGGA / CONVERT CURRENT TO BINARY TAD CUDG60 TAD CUDGGB / ADD LAST TO CURRENT TO MAKE NUMBER DCA CUDGGB /D030 JMP CUDD07 / LOOK FOR RETURN /D030 CUDD06, /D030 TAD CUDP7 /D030 JMS I CUDOUX / (CUDOUT) /C026 CUDD07, JMS I CUDGLX / MUST HAVE {RETURN} JMP CUDGG2 / POWER FAIL OR HALT JMP CUDD01 / NOIT DIGIT OR RETURN /C030 JMP CUDD10 / FOUND {RETURN} JMP CUDD01 / FOUND DIGIT /C030 CUDD10, / FOUND {RETURN} AFTER {UDK}(M) TAD CUDGGB / BINARY NUMBER CUDD11, TAD CUDUDK / MAKE INTO UDK CODE JMP CUDGG3 / EXIT CALL+2 CUDD03, / FOUND {UDK}{RETURN} TAD I CUDNUX / CONVERT TO UDK TO BE USED AS R.O. JMP CUDD11 NOP / LEAVE SOME PATCH ROOM NOP NOP NOP CUDGGA, 0 CUDGGB, 0 CUDG60, -60 / -"0 /D031 MGOLDU, -EDGLDU MEDUDK, -EDUDKY /A031 /CUDP7, 7 / MOVED TO PAGE 0 /D026 /CUDOTX, CUDOUT / CHANGED TO CUDOUX AND MOVED TO PG 0 /D026 CUDUDK, EDUDK0 CUDNUX, CUDNUM CUDGLX, CUDGL0 /D031 CUDGCP, CUDGCR / ******** A031 ******** / MOVE UDK DIRECTORY FROM/TO CUDBUF/DIRBUF / DON'T USE AUTO-INCREMENT REGISTERS CUDIMV, 0 TAD I CUDIMV / DESTINATION DCA CUDIDE ISZ CUDIMV TAD I CUDIMV / SOURCE DCA CUDISO ISZ CUDIMV /D035 TAD CUDICN / COUNT TAD I CUDIMV /A035 DCA CUDICT ISZ CUDIMV /A035 CUDIM1, / LOOP FOR MOVE TAD I CUDISO DCA I CUDIDE ISZ CUDISO ISZ CUDIDE ISZ CUDICT JMP CUDIM1 JMP I CUDIMV NOP / SAVE SPACE FOR DEBUG CUDIDE, 0 CUDISO, 0 /D035 CUDICN, -CUUDNM CUDICT, -CUUDNM DECIMAL DIRBUF, ZBLOCK 100 / DIRECTORY BUFFER OCTAL / *************** END A031 ******** /MOVED FOR ROOM ON PAGE /A013 /C031 CUDSSM, TEXT "&G&O&L&D:!2D" /M023 CUDSSM, IFNDEF ITALIAN /A031 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE < TEXT '!&DT: !2D'> IFDEF DUTCH IFDEF SPANISH CUDMS3, IFDEF ENGLSH < /D033 TEXT '^A&NO MORE ROOM FOR KEYSTROKES.^A^S^A^S^A' /C026/C027/C029/C032 TEXT '^A !&UDK STORAGE FULL.^S^S' /A033 CUDMS9, TEXT ' &DELETE KEYSTROKE(S)' /A029 CUDMS0, TEXT '^A &NO MORE ROOM IN THIS !&UDK.^S^S' /A032 /C033 > IFDEF ITALIAN < TEXT '^A &ARCHIVIO !&TDU PIENO.^S^S' CUDMS9, TEXT ' &CANCELLARE CARATTERE/I' CUDMS0, TEXT '^A &SPAZIO INSUFFICIENTE.^S^S' > IFDEF V30NOR < TEXT '^A !&BDT-LAGERET ER FULLT.^S^S^S^S' CUDMS9, TEXT ' &FJERN TASTANSLAG' CUDMS0, TEXT '^A &IKKE MER PLASS I AKTUELL !&BDT.^S^S^S^S' > IFDEF V30SWE < TEXT '^A &MINNET D\DR !&DT LAGRAS, \DR FULLT ^S^S' /A033 CUDMS9, TEXT ' &TA BORT TANGENTNEDSLAG' /A029 CUDMS0, TEXT '^A &DET FINNS INTE PLATS F\VR FLER NEDSLAG I DENNA !&DT ^S^S' /A032 /C033 > / END IFDEF V30SWE IFDEF DUTCH < /D033 TEXT '^A&NO MORE ROOM FOR KEYSTROKES.^A^S^A^S^A' /C026/C027/C029/C032 TEXT '^A !&UDK STORAGE FULL.^S^S' /A033 CUDMS9, TEXT ' &DELETE KEYSTROKE(S)' /A029 CUDMS0, TEXT '^A &NO MORE ROOM IN THIS !&UDK.^S^S' /A032 /C033 > IFDEF SPANISH < TEXT '^A &ALMACENAMIENTO !&TDU COMPLETO .^S^S' /A033 CUDMS9, TEXT ' &BORRE PULSACI\SN(ES)' /A029 CUDMS0, TEXT '^A &NO HY M\AS ESPACIO EN ESTA !&TDU.^S^S' /A032 /C033 > / CUDMS5, TEXT '^P!E^P' / / CUDMS6, 7 & 8 ADDED FOR 100 UDK'S /A026 9 LINES CUDMS6, IFDEF ENGLSH < TEXT ' !&OR &PRESS &GOLD !&HALT TO SAVE !&UDK.' /C029 /C033 > /END IFDEF ENGLSH IFDEF ITALIAN < TEXT ' &PREMERE &ORO !&STOP PER MEMORIZZARE !&TDU.' > IFDEF V30NOR < TEXT '!&STOPP FOR \E LAGRE AKTUELL !&BDT' > IFDEF V30SWE < TEXT '&ANV\DND GULD STOPP F\VR ATT SPARA !&DT'> IFDEF DUTCH < TEXT ' !&OR &PRESS &GOLD !&HALT TO SAVE !&UDK.' /C029 /C033 > /END IFDEF DUTCH IFDEF SPANISH < TEXT ' &O &PULSE &DORADA !&PARAR SALVAR !&TDU.' > / ENd IFDEF SPANISH CUDMS7, IFDEF ENGLSH < TEXT ' &PRESS &GOLD !&MENU TO RECALL THE !&MENU' > /END IFDEF ENGLSH IFDEF ITALIAN < TEXT ' &PREMERE &ORO !&MENU PER TORNARE AL !&MENU' > IFDEF V30NOR < TEXT ' !&MENY FOR \E F\E MENYEN' > IFDEF V30SWE < TEXT ' &TILLBAKA TILL MENYN: ANV\DND GULD MENY'> IFDEF DUTCH < TEXT ' &PRESS &GOLD !&MENU TO RECALL THE !&MENU' > /END IFDEF ENGLSH IFDEF SPANISH < TEXT ' &PULSE &DORADA !&MENU PARA VOLVER AL !&MENU' > /END IFDEF SPANISH /D0033 CUDMS8, IFDEF ENGLSH < /D0033 TEXT '^A&NO MORE ROOM.^S' /C033 /D0033 > /END IFDEF ENGLSH / CUDMSA, 15 / ++++ 12 / ++++ 12 / ++++ 0 CUDMSB, 15 / ++++ 12 / ++++ 0 / CUDMS1, IFDEF ENGLSH < TEXT '^P!E ^P&DEFINITION OF USER KEY ^D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' RECALL THE &MENU.' > IFDEF ITALIAN < TEXT "^P!E ^P&DEFINIZIONE TASTO FUNZIONE ^D. &PREMERE &ORO !&STOP PER' *.-1 TEXT ' TORNARE AL &MENU.' > IFDEF V30NOR < TEXT '^P!E ^P&DEFINISJON AV BRUKERTAST ^D. ^S &STOPP FOR \E F\E MENYEN.' > IFDEF V30SWE < TEXT '^P!E ^P&DEFINITION AV TANGENT ^D. &ANV\DND GULD STOPP F\VR ATT ' *.-1 TEXT '\ETERG\E TILL MENYN'> IFDEF DUTCH < TEXT '^P!E ^P&DEFINITION OF USER KEY ^D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' RECALL THE &MENU.' > IFDEF SPANISH < TEXT '^P!E ^P&DEFINICI\SN DE TECLA DE USARIO ^D.&PULSE &DORADA' *.-1 TEXT ' !&PARAR PARA VOLVER AL &MEN\Z.' > / CUDMS2, IFDEF ENGLSH < TEXT '^P!E ^P&MODIFYING USER KEY !D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' TERMINATE DEFINITION.^P' > IFDEF ITALIAN < TEXT '^P!E ^P&MODIFICA TASTO FUNZIONE !D. &PREMERE &ORO !&STOP PER' *.-1 TEXT ' TERMINARE LA DEFINIZIONE.^P' > IFDEF V30NOR < TEXT '^P!E ^P&ENDRER BRUKERTAST !D. ^S &STOPP FOR' /L.D.A *.-1 TEXT " \E AVSLUTTE DEFINISJON.^P" > IFDEF V30SWE < TEXT '^P!E ^P&\DNDRING AV TANGENTDEF. !D. &ANV\DND GULD STOPP F\VR ATTL ' *.-1 TEXT 'AVSLUTA DEFINITIONEN.^P'> IFDEF DUTCH < TEXT '^P!E ^P&MODIFYING USER KEY !D. &PRESS &GOLD &H&A&L&T TO' *.-1 TEXT ' TERMINATE DEFINITION.^P' > IFDEF SPANISH < TEXT '^P!E ^P&MODIFICANDO TECLA USUARIO !D. &PULSE &DORADA !&PARAR' *.-1 TEXT ' PARA TERMINATE DEFINITION.^P' > / /D013 / / CUDTAB - Table of key names for UDK code. Format is : / IOA string / one IOA parameter (or zero) / / Any one word IOA argument can be used in the second slot as long as the / IOA arg is expecting it. Future foreign language work may require the use of / the second argument for accented character information. (GLT) / / Different keyboards require a different ordering of the entries in the / CUDTAB. / / Presently two special IOA arguments are defined. They are: / CUDGTL - Prints GOLD: / where is a TEXT string / "Calling" sequence: / CUDGTL / TEXT "*" (where "*" is one character) / / CDCMND - Prints GOLD: where list is an ASCII / list ending with a zero word / "Calling" sequence: / CDCMND / PTR (where ptr points to the beginning / of the ASCII list) / CUDTAB, /C016 / / Space / CDSPCE 0 / / Power Fail / XX 0 / / Rubout / CDRBCH 0 / / Rubword / CDRBWD 0 / / Return / CDNWLN 0 / / GOLD:CMND /C016 / IFDEF ENGLSH < / GOLD:{ in English IFNDEF V30FAO< /M037 CDCMND CUDLCB > IFDEF V30FAO< /A037 CDCMND /A037 ACUTE /A037 > > IFDEF ITALIAN < CDCMND ITAST1 > IFDEF V30NOR < CDCMND ARING > IFDEF V30SWE < CDCMND ARING > IFDEF DUTCH < CDCMND CUDLCB > IFDEF SPANISH < CDCMND /A037 ACUTE /A037 > / / Para marker / CDCRET 0 / / Tab / CDTAB 0 / / Tab Center / CDTABC 0 / / GOLD:FILE / CUDGTL TEXT 'F' / / GOLD:MENU / CUDGTL TEXT 'M' / / GOLD:CONT SRCH & SEL / IFDEF ENGLSH < / GOLD:/ in English IFNDEF V30FAO< /A037 CUDGTL TEXT '/' > / END IFNDEF V30FAO /A009 IFDEF V30FAO< /A037 CUDGTL /A037 TEXT '-' /A037 > > / END IFDEF ENGCAN /A009 IFDEF ITALIAN < CDCMND ITAST2 > IFDEF V30NOR < CUDGTL TEXT '-' > /A039 IFDEF V30SWE < CUDGTL TEXT '-' > IFDEF DUTCH < CUDGTL TEXT '/' > / END IFNDEF V30FAO /A009 IFDEF SPANISH < CUDGTL /A037 TEXT '-' /A037 > / / Rub Line / CDRBLN 0 / / Rub Sent / CDRBSE 0 / / Del Char / CDDLTC 0 / / Del Word / CDDLTW 0 / / Word / CDWORD 0 / / Sent / CDSENT 0 / / Line / CDLINE 0 / / TabPos / CDTABP 0 / / <> (Enter) / CDENTR 0 / / Page / CDPAGE 0 / / Para / CDPARA 0 / / Advance / CDADVN 0 / / Back up / CDBKUP 0 / / GOLD:ADVANCE / CDGADV 0 / / GOLD:BACKUP / CDGBKP 0 / / Bold / CDBOLD 0 / / Sel / CDSLCT 0 / / Uppercase / CDUPPR 0 / / Underline / CDUNDL 0 / / Cut / CDSCUT 0 / / Swap / CDSWAP 0 / / Paste / CDPSTE 0 / / GOLD:DEL (both Char and Word) / CDUDLT 0 / / GOLD:BOLD / CDUBLD 0 / / GOLD:UPPERCASE / CDLOWR / Gold:Uppercase (I.e. Lowercase) 0 / / GOLD:UNDERLINE / CDUUDL 0 / / Hyph Push / CDHYPS 0 / / Hyph Pull / CDHYPL 0 / / Print Hyph / IFDEF ENGLSH < / GOLD:- in English IFNDEF V30FAO < /A037 CUDGTL TEXT '-' > IFDEF V30FAO < /A037 CUDGTL /A037 TEXT "'" /A037 > > IFDEF ITALIAN < CUDGTL TEXT ')' > IFDEF V30NOR < CUDGTL TEXT '+'> /A039 IFDEF V30SWE < CUDGTL TEXT '+'> IFDEF DUTCH < CUDGTL TEXT '-' > IFDEF SPANISH < CUDGTL /A037 TEXT "'" /A037 > / / Shift Print Hyph / IFDEF ENGLSH < / GOLD:_ in English IFNDEF V30FAO < /A037 CUDGTL TEXT '_' > IFDEF V30FAO < CUDGTL TEXT '?' > > IFDEF ITALIAN < CDCMND ITAST3 > IFDEF V30NOR < CUDGTL TEXT '?'> IFDEF V30SWE < CUDGTL TEXT '?'> IFDEF DUTCH < CUDGTL TEXT '_' > IFDEF SPANISH < CUDGTL TEXT '?' > / / GOLD:DEAD KEY / CUDGTL TEXT 'D' / / GOLD:ABBREV / IFDEF ENGLSH < / GOLD:= in English IFNDEF V30FAO < /A037 CUDGTL TEXT '=' > IFDEF V30FAO < /A037 CUDGTL /A037 TEXT '+' /A037 > > IFDEF ITALIAN < CUDGTL TEXT '-' > IFDEF V30NOR < CDCMND OSLASH > /A039 IFDEF V30SWE < CDCMND UUMLAT > IFDEF DUTCH < CUDGTL TEXT '=' > IFDEF SPANISH < CUDGTL /A037 TEXT '+' /A037 > / / GOLD:LIBRY / CUDGTL TEXT 'L' / / GOLD:GET DOCMT / CUDGTL TEXT 'G' / / GOLD:TOP DOCMT / CUDGTL TEXT 'T' / / GOLD:BOT DOCMT / CUDGTL TEXT 'B' / / GOLD:SRCH / IFDEF ENGLSH < / GOLD:, in English CUDGTL TEXT ',' > IFDEF ITALIAN < CUDGTL TEXT ';' > IFDEF V30NOR < / GOLD:, in Scandinavian CUDGTL TEXT ',' > IFDEF V30SWE < CUDGTL TEXT ',' > IFDEF DUTCH < CUDGTL TEXT ',' > IFDEF SPANISH < CUDGTL TEXT ',' > / / GOLD:CONT SRCH / IFDEF ENGLSH < / GOLD:. in English CUDGTL TEXT '.' > IFDEF ITALIAN < CUDGTL TEXT ':' > IFDEF V30NOR < CUDGTL TEXT '.' /A039 > IFDEF V30SWE < CUDGTL TEXT '.' > IFDEF DUTCH < CUDGTL TEXT '.' > IFDEF SPANISH < CUDGTL TEXT '.' > / / GOLD:NEW PAGE / CUDGTL TEXT 'N' / / GOLD:PAGE MARKER / CUDGTL TEXT 'P' / / GOLD:RULER / CUDGTL TEXT 'R' / / GOLD:CENTER / CUDGTL TEXT 'C' / / GOLD:CUT / CDGCUT 0 / / GOLD:PASTE / CDGPST 0 / / GOLD:"Page" / CDGPGE 0 / / GOLD:REPLC / IFDEF ENGLSH < / GOLD:' in English IFNDEF V30FAO < CUDGTL TEXT \'\ > IFDEF V30FAO < /A037 CDCMND /A037 NENIA /A037 > > IFDEF ITALIAN < CDCMND ITAST4 > IFDEF V30NOR < CDCMND AE > /A039 IFDEF V30SWE < CDCMND AUMLAT > IFDEF DUTCH < CUDGTL TEXT \'\ > IFDEF SPANISH < CDCMND /A037 NENIA /A037 > / / GOLD:SUPER SCRIPT / IFNDEF FRENCH < CUDGTL TEXT 'A' > IFDEF FRENCH < CUDGTL TEXT 'Q' > / / GOLD:SUB SCRIPT / IFNDEF FRENCH < CUDGTL TEXT 'Q' > IFDEF FRENCH < CUDGTL TEXT 'A' > / / GOLD:VIEW / CUDGTL TEXT 'V' / / GOLD:DATE & TIME / IFDEF ENGLSH < IFNDEF V30FAO < CDCMND / GOLD:\ in English BSLASH > IFDEF V30FAO < /A037 CDCMND /A037 CCEDLA /A037 > > IFDEF ITALIAN < CUDGTL TEXT '*' > IFDEF V30NOR < CUDGTL TEXT "'"> IFDEF V30SWE < CUDGTL TEXT "'"> IFDEF DUTCH < CDCMND / GOLD:\ in English BSLASH > IFDEF SPANISH < CDCMND /A037 CCEDLA /A037 > IFDEF CONDOR < / / technical character /a021 / CDXTC 0 > / /A012 / HELP /A012 / /A012 CDHELP /A012 0 /A012 / /A018 / PREVIOUS SCREEN /A018 / /A018 CDPRSC /A018 0 /A018 / /A018 / NEXT SCREEN /A018 / /A018 CDNXSC /A018 0 /A018 / /A018 / UP ARROW (CURSOR UP) /A018 / /A018 CDUPAR /A018 0 /A018 / /A018 / DOWN ARROW (CURSOR DOWN) /A018 / /A018 CDDNAR /A018 0 /A018 IFDEF CONDOR < /A019 / /A018 / RIGHT ARROW (CURSOR RIGHT) /A018 / /A018 CDRARO /A018 0 /A018 / /A018 / LEFT ARROW (CURSOR LEFT) /A018 / /A018 CDLARO /A018 0 /A018 / /A018 / GOLD: RIGHT ARROW /A018 / /A018 CDGRAR /A018 0 /A018 / /A018 / GOLD: LEFT ARROW /A018 / /A018 CDGLAR /A018 0 /A018 > / END IFDEF CONDOR /M019 / /A018 / GOLD: SPACE (NONBREAKING SPACE - ALIAS REQUIRED SPACE) /A018 / /A018 CDRQSP /A018 0 /A018 IFDEF CONDOR < /A020 CDCOLM / COLUMN CUT /A020 0 /A020 > / END IFDEF CONDOR /A020 / / ??? / CDINOV /A038 0 / /D023 20 LINES / GOLD: for UDK activation / / CUDGTL / GOLD:9 / TEXT '9' / CUDGTL / GOLD:8 / TEXT '8' / CUDGTL / GOLD:7 / TEXT '7' / CUDGTL / GOLD:6 / TEXT '6' / CUDGTL / GOLD:5 / TEXT '5' / CUDGTL / GOLD:4 / TEXT '4' / CUDGTL / GOLD:3 / TEXT '3' / CUDGTL / GOLD:2 / TEXT '2' / CUDGTL / GOLD:1 / TEXT '1' / CUDGTL / GOLD:0 / TEXT '0' /END D023 20 LINES / CDSPCE, IFDEF ENGLSH < TEXT '&SPACE' > IFDEF ITALIAN < TEXT '&SPAZIO' > IFDEF V30NOR < TEXT '&ORDSKILLER'> /A039 IFDEF V30SWE < TEXT '&BLANK'> IFDEF DUTCH < TEXT '&SPATIE'> IFDEF SPANISH < TEXT '&ESPACE'> / CDRBCH, IFDEF ENGLSH < TEXT '&RUBCHR' > IFDEF ITALIAN < TEXT '&AN&CAR' > IFDEF V30NOR < TEXT '&SLETT TEGN'> /A039 IFDEF V30SWE < TEXT '&RATKN'> IFDEF DUTCH < TEXT '&R-TEK'> IFDEF SPANISH < TEXT 'BORCAR'> / CDRBWD, IFDEF ENGLSH < TEXT '&RUBWRD' > IFDEF ITALIAN < TEXT '&CANC&PA' > IFDEF V30NOR /A039 IFDEF V30SWE < TEXT '&RADRD'> IFDEF DUTCH < TEXT '&R-WRD'> IFDEF SPANISH < TEXT '&BORPAL'> / CDNWLN, IFDEF ENGLSH < TEXT '&RETURN' > IFDEF ITALIAN < TEXT '&RITORNO' > IFDEF V30NOR < TEXT '&RETUR'> /A039 IFDEF V30SWE < TEXT '&RET'> IFDEF DUTCH < TEXT '&RETURN> IFDEF SPANISH < TEXT '&RETORNO'> / CDCRET, IFDEF ENGLSH < TEXT '&PARMRK' > IFDEF ITALIAN < TEXT '&CRE&PAR' > IFDEF V30NOR < TEXT '&AVSNITMRK'> /A039 IFDEF V30SWE < TEXT '&STYMARK'> IFDEF DUTCH < TEXT '&ALIMRK'> IFDEF SPANISH < TEXT '&MRKPAR'> / CDTAB, IFDEF ENGLSH < TEXT '&TAB' > IFDEF ITALIAN < TEXT '&TAB' > IFDEF V30NOR < TEXT '&TAB'> IFDEF V30SWE < TEXT '&TABB'> IFDEF DUTCH < TEXT '&TAB'> IFDEF SPANISH < TEXT '&TAB'> / CDTABC, / /d022 IFDEF ENGLSH < TEXT '&TABCEN' > /d022 IFDEF CANADA < TEXT "&CENTAB" > /d022 IFDEF FRENCH < TEXT "&TABCEN" > /d022 IFDEF DUTCH < TEXT "&TABCEN" > /d022 IFDEF GERMAN < TEXT "&TABCEN" > /d022 IFDEF NORWAY < TEXT "&TABSEN" > /d022 IFDEF SWEDSH < TEXT "&TABCEN" > /d022 IFDEF DANISH < TEXT "&TABCEN" > / IFDEF ENGLSH < TEXT "&G-TAB" > /A022 IFDEF ITALIAN < TEXT "&O-&TAB" > IFDEF V30NOR < TEXT '&G-TAB'> /A039 IFDEF V30SWE < TEXT '&G-TABB'> IFDEF DUTCH < TEXT '&G-TAB'> IFDEF SPANISH < TEXT '&D-TAB'> / CDRBLN, IFDEF ENGLSH < TEXT '&RUBLIN' > IFDEF ITALIAN < TEXT '&AN&RIG' > IFDEF V30NOR < TEXT '&SLETT LINJE'> /A039 IFDEF V30SWE < TEXT '&RARAD'> IFDEF DUTCH < TEXT '&WISREG'> IFDEF SPANISH < TEXT '&BORLIN'> / CDRBSE, IFDEF ENGLSH < TEXT '&RUBSEN' > IFDEF ITALIAN < TEXT '&CANC&FR' > IFDEF V30NOR < TEXT '&SLETT SETN'> /A039 IFDEF V30SWE < TEXT '&RAMEN'> IFDEF DUTCH < TEXT '&WISZIN'> IFDEF SPANISH < TEXT '&BORFRA'> / CDDLTC, IFDEF ENGLSH < TEXT '&DELCHR' > IFDEF ITALIAN < TEXT '&CAN&CAR' > IFDEF V30NOR < TEXT '&TEGN UT'> /A039 IFDEF V30SWE < TEXT '&RATKN'> IFDEF DUTCH < TEXT '&WISTEK'> IFDEF SPANISH < TEXT '&BORCAR'> / CDDLTW, IFDEF ENGLSH < TEXT '&DELWRD' > IFDEF ITALIAN < TEXT '&CAN&PAR' > IFDEF V30NOR < TEXT 'ORD UT'> /A039 IFDEF V30SWE < TEXT '&RAORD'> IFDEF DUTCH < TEXT '&WISWRD'> IFDEF SPANISH < TEXT '&BORPAL'> / CDWORD, IFDEF ENGLSH < TEXT '&WORD' > IFDEF ITALIAN < TEXT '&PAROLA' > IFDEF V30NOR < TEXT '&ORD'> /A039 IFDEF V30SWE < TEXT '&ORD'> IFDEF DUTCH < TEXT '&WOORD'> IFDEF SPANISH < TEXT '&PALAB'> / CDSENT, IFDEF ENGLSH < TEXT '&SENT' > IFDEF ITALIAN < TEXT '&FRASE' > IFDEF V30NOR < TEXT '&SETN'> /A039 IFDEF V30SWE < TEXT '&MEN'> IFDEF DUTCH < TEXT '&ZIN'> IFDEF SPANISH < TEXT '&FRASE'> / CDLINE, IFDEF ENGLSH < TEXT '&LINE' > IFDEF ITALIAN < TEXT '&RIGA' > IFDEF V30NOR < TEXT '&LINJE'> /A039 IFDEF V30SWE < TEXT '!&RAD'> IFDEF DUTCH < TEXT '®EL'> IFDEF SPANISH < TEXT '&L\MNEA'> / CDTABP, IFDEF ENGLSH < TEXT '&TABPOS' > IFDEF ITALIAN < TEXT '&CER&TAB' > IFDEF V30NOR < TEXT '&TABPOS'> /A039 IFDEF V30SWE < TEXT '&TABBPOS'> IFDEF DUTCH < TEXT '&TABPOS'> IFDEF SPANISH < TEXT '&POSTAB'> / CDENTR, TEXT '!<>' CDPAGE, IFDEF ENGLSH < TEXT '&PAGE' > IFDEF ITALIAN < TEXT "&PAGINA" > IFDEF V30NOR < TEXT '&SIDE'> /A039 IFDEF V30SWE < TEXT '&SIDA'> IFDEF DUTCH < TEXT '&PAGINA'> IFDEF SPANISH < TEXT '&P\AG'> / CDPARA, IFDEF ENGLSH < TEXT '&PARA' > IFDEF ITALIAN < TEXT '&PARAGR' > IFDEF V30NOR < TEXT '&AVSNITT'> /A039 IFDEF V30SWE < TEXT '&STY'> IFDEF DUTCH < TEXT '&ALINEA'> IFDEF SPANISH < TEXT '&PARRA'> / CDADVN, IFDEF ENGLSH < TEXT '&ADVANC' > IFDEF ITALIAN < TEXT '&AVANTI' > IFDEF V30NOR < TEXT '&FREM'> /A039 IFDEF V30SWE < TEXT '&FRAM'> IFDEF DUTCH < TEXT '&VOORUIT'> IFDEF SPANISH < TEXT '&DELAN'> / CDBKUP, IFDEF ENGLSH < TEXT '&BACKUP' > IFDEF ITALIAN < TEXT '&INDIET' > IFDEF V30NOR < TEXT '&TILBAKE'> /A039 IFDEF V30SWE < TEXT '&BAK'> IFDEF DUTCH < TEXT '&TERUG'> IFDEF SPANISH < TEXT '&ATR\AS'> / CDGADV, IFDEF ENGLSH < TEXT '&G-&ADV' > IFDEF ITALIAN < TEXT '&O-&AVA' > IFDEF V30NOR < TEXT '&G-FREM'> /A039 IFDEF V30SWE < TEXT '&G-FRAM'> IFDEF DUTCH < TEXT '&G-&VRT'> IFDEF SPANISH < TEXT '&D-&ADEL'> / CDGBKP, IFDEF ENGLSH < TEXT '&G-&BACK' > IFDEF ITALIAN < TEXT '&O-&INDI' > IFDEF V30NOR < TEXT '&G-TILBAKE'> /A039 IFDEF V30SWE < TEXT '&G-BAK'> IFDEF DUTCH < TEXT '&G-&TRG'> IFDEF SPANISH < TEXT '&D-&ATR\AS'> / CDBOLD, IFDEF ENGLSH < TEXT '&BOLD' > IFDEF ITALIAN < TEXT '&NERET' > IFDEF V30NOR < TEXT '&FET'> /A039 IFDEF V30SWE < TEXT '&FET'> IFDEF DUTCH < TEXT '&VET'> IFDEF SPANISH < TEXT '&NEGR'> / CDSLCT, IFDEF ENGLSH < TEXT '&SEL' > IFDEF ITALIAN < TEXT '&SEL' > IFDEF V30NOR < TEXT '&VELG'> /A039 IFDEF V30SWE < TEXT '&MARK'> IFDEF DUTCH < TEXT '&SEL'> IFDEF SANISH < TEXT '&SEL'> / CDUPPR, IFDEF ENGLSH < TEXT '&UPPER' > IFDEF ITALIAN < TEXT '&MAIUS' > IFDEF V30NOR < TEXT 'STORE BOKST'> /A039 IFDEF V30SWE < TEXT '&VERS'> IFDEF DUTCH < TEXT '&HOOFDL'> IFDEF SPANISH < TEXT 'MAY\ZSC'> / CDUNDL, IFDEF ENGLSH < TEXT '&UNDER' > IFDEF ITALIAN < TEXT '&SOTTOL' > IFDEF V30NOR < TEXT 'UNDERSTREK'> /A039 IFDEF V30SWE < TEXT '&GEM'> IFDEF DUTCH < TEXT '&ONDER'> IFDEF SPANISH < TEXT 'SUBRY'> / CDSCUT, IFDEF ENGLSH < TEXT '&CUT' > IFDEF ITALIAN < TEXT '&TOGLI' > IFDEF V30NOR < TEXT '&TA UT'> /A039 IFDEF V30SWE < TEXT '&KLIPP'> IFDEF DUTCH < TEXT '&KNIP'> IFDEF SPANISH < TEXT '&CORTA'> / CDSWAP, IFDEF ENGLSH < TEXT '&SWAP' > IFDEF ITALIAN < TEXT '&SCAMB&C' > IFDEF V30NOR < TEXT '&BYTT OM'> /A039 IFDEF V30SWE < TEXT '&SKIFT'> IFDEF DUTCH < TEXT '&VERWIS'> IFDEF SPANISH < TEXT '&INTCAM'> / CDPSTE, IFDEF ENGLSH < TEXT '&PASTE' > IFDEF ITALIAN < TEXT '&METTI' > IFDEF V30NOR < TEXT '&SETT INN'> /A039 IFDEF V30SWE < TEXT '&KLISTRA'> IFDEF DUTCH < TEXT '&PLAK'> IFDEF SPANISH < TEXT 'PEGA'> / CDUDLT, IFDEF ENGLSH < TEXT '&G-&DEL' > IFDEF ITALIAN < TEXT '&O-&CAN' > IFDEF V30NOR < TEXT 'G-UT'> /A039 IFDEF V30SWE < TEXT '&G-RA'> IFDEF DUTCH < TEXT '&G-WIS'> IFDEF SPANISH < TEXT '&D-&BORRA'> / CDUBLD, IFDEF ENGLSH < TEXT '&G-&BOLD' > IFDEF ITALIAN < TEXT '&O-&NERE' > IFDEF V30NOR < TEXT 'G-FET'> /A039 IFDEF V30SWE < TEXT '&G-FET'> IFDEF DUTCH < TEXT '&G-&VET'> IFDEF SPANISH < TEXT '&D-&BOLD'> / CDLOWR, IFDEF ENGLSH < TEXT '&G-&UPPR' > IFDEF ITALIAN < TEXT '&O-&MAIU' > IFDEF V30NOR < TEXT '&G-STORE BOKST'> /A039 IFDEF V30SWE < TEXT '&G-VERS'> IFDEF DUTCH < TEXT '&G-HFDL'> IFDEF SPANISH < TEXT '&D-MAY\Z'> / CDUUDL, IFDEF ENGLSH < TEXT '&G-&UNDR' > IFDEF ITALIAN < TEXT '&O-&SOTT' > IFDEF V30NOR < TEXT '&G-U_STREK'> /A039 IFDEF V30SWE < TEXT '&G-GEM'> IFDEF DUTCH < TEXT '&G-ONDR'> IFDEF SPANISH < TEXT '&D-&SUBR'> / CDHYPS, IFDEF ENGLSH < TEXT '&HYPUSH' > IFDEF ITALIAN < TEXT '&CAR&SU' > IFDEF V30NOR < TEXT '&DEL ORD !C^'> /A039 IFDEF V30SWE < TEXT '&AVSTUPP'> IFDEF DUTCH < TEXT '&KPL-V'> IFDEF SPANISH < TEXT '&SBGUI\SN'> / CDHYPL, IFDEF ENGLSH < TEXT '&HYPULL' > IFDEF ITALIAN < TEXT '&CAR&GIU' > IFDEF V30NOR < TEXT '&DEL ORD V'> /A039 IFDEF V30SWE < TEXT '&AVSTNED'> IFDEF DUTCH < TEXT '&KPL-&!^'> IFDEF SPANISH < TEXT '&BAJAG'> / CDGCUT, IFDEF ENGLSH < TEXT '&G-&CUT' > IFDEF ITALIAN < TEXT '&O-&TOGL' > IFDEF V30NOR < TEXT '&G-TA UT'> /A039 IFDEF V30SWE < TEXT '&G-KLIPP'> IFDEF DUTCH < TEXT '&G-&KNIP'> IFDEF SPANISH < TEXT '&D-&CORTA'> / CDGPST, IFDEF ENGLSH < TEXT '&G-&PSTE' > IFDEF ITALIAN < TEXT '&O-&METT' > IFDEF V30NOR < TEXT '&G-SETT INN'> /A039 IFDEF V30SWE < TEXT '&G-KLISTRA'> IFDEF DUTCH < TEXT '&G-&PLAK'> IFDEF SPANISH < TEXT '&D-PEGA'> / CDGPGE, IFDEF ENGLSH < TEXT '&G-&PAGE' > IFDEF ITALIAN < TEXT '&O-&PAGI' > IFDEF V30NOR < TEXT '&G-SIDE'> IFDEF V30SWE < TEXT '&G-SIDA'> IFDEF DUTCH < TEXT '&G-&PAG'> IFDEF SPANISH < TEXT '&D-&P\AG'> / / The next text statements were removed from the previous "8" page to / make room / CDCMND, IFDEF ENGLSH < TEXT '&G&O&L&D:!A' > IFDEF ITALIAN < TEXT '&ORO:!A' > IFDEF V30NOR < TEXT '!&GOLD: !A'> IFDEF V30SWE < TEXT '&GULD:!A'> IFDEF DUTCH < TEXT '&GOUD:!A'> IFDEF SPANISH < TEXT '&DOR:!A'> / CUDGTL, IFDEF ENGLSH < TEXT '&G&O&L&D:&^S' > IFDEF ITALIAN < TEXT '&ORO:&^S' > IFDEF V30NOR < TEXT '!&GULL:&^S'> IFDEF V30SWE < TEXT '&GULG: &^S'> IFDEF DUTCH < TEXT '&GOUD:&^S'> IFDEF SPANISH < TEXT '&DOR:&^S'> / CUDMS4, TEXT '^P' / IFNDEF FRENCH < CUDLCB, "{-200 / curly bracket 0000 / end of list > IFDEF ITALIAN < ITAST1, "l;0 ITAST2, "r;0 ITAST3, "0;0 ITAST4, "y;0 > IFDEF V30NOR < OSLASH, 330;0 /O with slash /A039 ARING, 305;0 / A with ring /A039 AE, 306;0 / Ae ligature /A039 > IFDEF SPANISH < OSLASH, 330;0 /O with slash /A039 ARING, 305;0 / A with ring /A039 AE, 306;0 / Ae ligature /A039 > IFDEF V30SWE < ARING, 305;0 UUMLAT, 334;0 AUMLAT, 304;0 > IFDEF ENGLSH < BSLASH, 134;0 > / Backslash /A039 IFDEF DUTCH < BSLASH, 134;0 > / Backslash /A039 IFDEF V30FAO < CCEDLA, 347;0 NENIA, 321;0 > IFDEF SPANISH < CCEDLA, 347;0 NENIA, 321;0 > / IFDEF FRENCH < > / Not used in french / IFDEF V30FAO < ACUTE, 0140 / ` for CMND for FAO /A037 0000 /A037 > IFDEF SPANISH < ACUTE, 0140 / ` for CMND for FAO /A037 0000 /A037 > IFDEF CONDOR < CDXTC, IFDEF ENGLSH /C034 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > CDHELP, IFDEF ENGLSH /A012 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDPRSC, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDNXSC, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDUPAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDDNAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH IFDEF CONDOR < /A019 CDRARO, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDLARO, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDGRAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH CDGLAR, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > / END IFDEF CONDOR /M019 CDRQSP, IFDEF ENGLSH /A018 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH IFDEF CONDOR < /A020 CDCOLM, IFDEF ENGLSH / COLUMN CUT /A020 IFDEF ITALIAN IFDEF V30NOR /A039 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH > / END IFDEF CONDOR /A020 CDINOV, IFDEF ENGLSH /A038 IFDEF V30NOR /A039 IFDEF ITALIAN IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH   /FMTRUL -- WRITE RULERS 0-9 TO FLOPPY 0 AND CLEAR FIRST BLOCK OF CUT-PAST AREA / ******************************************************************** / E D I T H I S T O R Y C O M M E N T S / ******************************************************************** / / 001 EJL 20-JUN-84 EXPAND RULER SIZE FORM 160 TO 238 / / ******************* END EDIT HISTORY ******************************* *RXLDLS RXEWT;0;RXQBLK . DLRLRE;200;CDF 20;-DSRLRE DLCUTB;400;CDF 0;-1 0 *200 SKP CLA JMP I (7605) TAD (177) DCA X0 / INIT PTR TAD (-12) DCA T1 / INIT RULER COUNT CDF 20 / SET DATA FIELD 2 A1, TAD (COSCNT) DCA I X0 / SET COS COUNT WORD TAD (501) DCA I X0 / SET L=1 TAD (-37) DCA T2 / SET COUNT =62 TAD (101) DCA I X0 ISZ T2 JMP .-3 / 62 NULS TAD (601) DCA I X0 / SET R=65 TAD (42-170) / M001 Fill out page DCA T2 / SET CNT TO CLEAR REST OF RULER TAD (101) DCA I X0 ISZ T2 JMP .-3 DCA I X0 / SET 0 FOR STOPPER AC0001 DCA I X0 / SET LEFT MARGIN VALUE TAD (101) DCA I X0 / SET RIGHT MARGIN VALUE TAD (173-200) / M001 DCA T2 / CLEAR REST OF STORAGE DCA I X0 ISZ T2 JMP .-2 ISZ T1 JMP A1 / LOOP FOR ALL RULERS CDF 0 / RESET DATA FIELD JMP I (RXLOAD) / JUMP TO WRITE OUT ROUTINE PAGE ZBLOCK 400 / EMPTY BLOCK FOR CUT-PAST AREA   / WPTRNS - DOCUMENT TRANSFER / / 045 EMcD 14-Sep-85 Add Nordic translations / (conditionalised) / 044 RCME 08-Jul-85 Allow multiple option characters / in AX/DX menu. / 043 EMcD 28-Feb-85 Add DECDEV switch / / --------------- All below refer to V2.0 and earlier ------------------ / / 042 HLP 15-NOV-84 Search & Replace: / USOCHR=TTYOU / HTICHR=HS2IN / HTOCHR=HS2OU / 041 TCW 28-NOV-84 Terminate text packet before a QUIT / 040 TCW 24-OCT-84 Write all rec. packets before quiting / 039 TCW 12-OCT-84 Add flag cks & sets before IOA calls / 038 TCW 02-AUG-84 Add (CLA) before menu call / 037 GDH 31-JUL-84 Bug fix for losing packets. / Fix EZLINK BYE packet detection. / 036 JFS 18-JUN-84 DM-III mods / 035 WCE 11-MAY-84 Remove all occurances of USERNO / 034 TCW 02-MAR-84 Ring bell for invalid character / 033 TCW 21-FEB-84 Add ck for local init. of recrtn / 032 TCW 27-JAN-84 Limit menu input to 64 chars. / 031 TCW 29-DEC-83 a) Send back a "NO" packet when unable / to create document. / b) Close document when unable to create / c) Put any text in "NO" packet on / Problem: line. / d) Add special cases of "NO" packet; / 1) Response to "RCV" packet. / 2) Response to "SOD" packet. / e) Move "Problem:" to line 4. / f) Reset Status:, Problem: & Message: / lines on S & R options. / 030 FJL 17-NOV-83 Change to fix comm. bug, erroneous msg / 029 GDH 28-JUL-83 Changed default filename generator / to not generate "1." if drive 1. / 028 GDH 21-JUL-83 Eliminated bad "AC7773" reference. / 027 GDH 6-JUN-83 General Cleanup & Rewrite of terminal / I/O / 026 DFB 01-JUN-83 Fix to close DX doc / 025 GDH 26-MAY-83 Rearranged GTLINE char checks per WPF1 / 024 GDH 18-MAY-83 Moved LARGE BUFFER to field 6. / 023 GDH 18-APR-83 Eliminated unneeded label DLYINT. / Eliminated unreferenced pool DOCLSA. / Free list buffer linkage now done at / assembly time instead of run-time. / Eliminated redundant initialization / of CMADSX. / Eliminated DXSTLS initializations. / AX/DX is reloaded each time it's / invoked. / Implemented EZ-LINK chain back to CX. / 022 EH 08-OCT-82 Limit input chars for ID/PASSWORD to 64 / 021 SBB 25-AUG-82 Changed vt278 message to / DM-II(IFDEF'ed) / 020 SBB 15-JUL-82 Made timeout delays variable from menu. / 019 GDH 15-FEB-82 Fixed AX-DX to not clobber loc 53 in / header when copying print settings / to recieve document. / 018 GDH 30-NOV-81 Changed TIMOUT to TIMEOU due to WPF1 / definition of TIMOUT. / 017 EH 28-OCT-81 Merged differences from 78,1 into here / 016 GDH 21-OCT-81 Deleted phoney CIF/CDF mapping stuff. / 015 EH 16-OCT-81 Made dx clear error count prior to / each transmition. / 014 GDH 14-OCT-81 De-implemented LOCK/UNLOCK. / 013 GDH 26-AUG-81 WPFILS calling seq changes. / 012 TT 07-JUL-81 Removed superfluous conditionals / 011 JM 01-APR-81 Text change for CANADA / 010 DIM 27-MAR-81 FIXED PAGE ERROR FOR DUTCH / 009 DAO 1-JAN-81 PUT IN FIX TO DX BUG IN 278 WHICH / RESULTED IN TOO MANY PACKET ERRORS / WHEN 278 RECEIVED AT BAUD RATES GREATER / THAN 600. STILL HAS A PROBLEM AT / 19200 BAUD. / 008 DRH 4-DEC-80 CONNECTED TO "VT278" IN AX/DX ADDED / 007 GR,DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES / 006 DM,JM 15-SEPT-80 Merged Scandi and Europe/English / 005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 004 CMW 6-MAY-80 ENTERED CANADA TRANSLATIONS / 003 DSS 17-APR-80 ENTERED DUTCH FIXES / 002 GLT 2-APR-80 Change WS201, WS202 messages to WS81, / WS82 / 001 CMW GLT 10-JAN-80 Added French, German and Dutch / conditionals / French diacritical substitutions: / "["=L.A.E, "]"=L.G.E; "&" does not UPPERCASE / German diacritical substitutions: / "["=L.U.A, "\"=L.U.O, "]"=L.U.U; "&" usable / 3.0 MB 31-JUL-78 PUT IN NULLS AFTER CR IN A PACKET OPTION / QA3.3 MB 13-APR-78 FIX RESPONSE PACKET TO T,B OPTION IN AX-DX / 2.6+ MB NEW PROTOCOL / 2.5-1 MB FIX THE CREATE PROBLEMS IN THE WT78 10/15/77 / 2.P-4 KEE ADD CODE TO UNLOCK 102 FILES / 2.G-2 MB PUT IN CHANGE FOR MOVED MENU AREA 8/10/77 / 2.G-1 MB GET FROM THE 78 PACK / / THIS PAGE WRITES OUT WPTRNS / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLODWC / ++++ 100 / ++++ IFNDEF DECDEV < CDF 10 / ++++ > IFDEF DECDEV < CDF 30 / ++++ > -DSODWC DLODW2 / ++++ 7400 / ++++ IFNDEF DECDEV < CDF 20 / ++++ > IFDEF DECDEV < CDF 40 > -DSODW2 0 / / HERE ARE THE CONSTANTS USED BY WPTRNS / / THESE ARE THE CONSTANTS THAT HANDLE I/O FOR A CHAR / / / SET UP CONSTANTS FOR THE PROGRAM / BUFCNT=5 / THE NUMBER OF BUFFERS IN THE POOL BUFSIZ=100 / THE STANDARD BUFFER SIZE NAKLM=-41 / THE IS THE NUMBER OF RETRNANSMITS IT WILL DO TOLIM=-5 / THE NUMBER OF TIMES YOU RESEND AFTER A TIME OUT / BELL=7 CR=15 / SENT AS AN END OF LINE DESIGNATOR FOR A TIME SHARING SYSTEM LF=12 / LINE FEED SPACE=40 / BLANK BKSPAC=10 RUBOUT=177 / THE RUBOUT CHARACTER SPECHR=140 / USED TO TELL THE DIFFERENCE FROM A PACKET AND A COMMAND RESET=175 / VERSIO=40 / THE VERSION OF THE PROTOCOL SHOULD BE INCREMENTED WITH EVERY / CHANGE TO THE PROTOCOL THAT WOULDNOT ALLOW THE NEW / TO TALK TO THE OLD / TYPE=40 / THE TYPE OF THE PROTOCOL / ZERNUL=137 / NUMBER OF NULLS REQUESTED FROM THE OTHER SYSTEM AFTER A PACKET / 40 = ZERO. IT IS SENT IN THE INIT AND INIT-ACK PACKETS / / THE VALUES FOR SYSTY1. THEY TELL THE OTHER SYSTEM SOFTWARE / WHAT IS RUNNING / ON THIS SYSTEM AX OR DX / AXSYS=41 DXSYS=40 / / THE TIME OUT CONSTANTS / /D020 SEC1=-2 /D020 SEC3=-4 /D020 SEC30=-37 /D020 SEC15=-11 / 9 SEC /A017 /D020 SEC5=-6 / / VALUES FOR THE OPTIONS / OPTNUL=40 / NOTHING OPTBYE=41 / JUST BYE MESSAGE OPTBM=42 / BYE AND NORMAL MESSAGE OPTBMS=43 / BYE, NORMAL, AND SEND OPTALL=44 / EVERYTHING / / CONSTANTS FOR THE COMMAND COMPARE / /d044 IFDEF ENGLSH < /d044 SEND="S&177 /d044 RECEIV="R&177 /d044 MESSAG="M&177 /d044 BYE="B&177 /d044 > /d044 IFDEF ITALIAN < /d044 SEND="I&177 /d044 RECEIV="R&177 /d044 DOCMNT="D&177 /d044 MESSAG="M&177 /d044 BYE="T&177 /d044 > / / THE FLAG CHARACTERS FOR THE PACKET TYPE AND THE COMMANDS FOR / THE LOW LEVEL / IF THE VALUES CHANGE TELL HSTTBL BECAUSE USE THEN AS OFFSETS / THEY ALL HAVE THE SAME PACKET FORMAT / TYPYES=140 / THE OK PACKET TYPE TYPMOD=141 / DOCUMENT OPTIONS PACKET RESPOND WITH A PROMPT / ANSWER PACKET TYPMES=142 / THE NORMAL MESSAGE TYPBYE=143 / BYE MESSAGE PACKET, WILL TERMINATE A TRANSFER TYPSOD=144 / FIRST PACKET OF A DOCUMENT CONTAINING SIZE / AND PRINTER SETTINGS TYPDTA=145 / NORMAL TEXT PACKET OF A DOCUMENT TYPEOF=146 / LAST PACKET OF A DOCUMENT. CONTAINS THE LAST / 64 BYTES OR LESS TYPHIT=147 / HIGH LEVEL INITALIZE PACKET THAT HAS THE / TERMINAL MESSAGE IN IT TYPHAK=150 / THE HIGH LEVEL ACK TYPSND=151 / WANT TO SEND A DOCUMENT TYPRCV=152 / WANT TO RECEIVE A DOCUMENT TYPOPT=153 / THE OPTION PACKET TYPDOC=154 / USED WHEN SENDING A LIST IT IS A PROMPT FOR / THE DX USER TO ANSWER TYPNO=164 / ANO RESPONSE TO A PACKET TYPPAN=172 / ANSWER TO PROMPT CONTAINS WHAT THE USER TYPED TYPPMT=175 / PROMPT PACKET TYPPNE=176 / PROMPT WITH NO ECHO / / THE LOW LEVEL PACKET TYPES. HTE FORMATS ARE DIFFERENT THAN ABOVE'S. / NAK=160 ACK=170 QUIT=171 / TELLS THE SYSTEM THAT THE OTHER SYSTEM GOLD / MENUED INIACK=173 INIT=174 / / CONSTANTS FOR THE GET THE BLOCK SIZE / ISGBK1=INMBLK ISGBK2=ISGBK1+1 / / THE CONSTANTS USED IN THE PRINTER SETTINGS / RDFILB=7400 / START OF THE BUFFER THAT THE HEADER BLOCK IS / READ INTO / SETSAV=ISGBK2+1 / THE START OF THE PRINTER SETTING IN THE INCOMING SETSND=RDFILB+23 / START OF THE PRINTER SETTINGS IN THE RXHAN BUFFER SETSIZ=-30 / SIZE OF THE PRINTER SETTINGS IN WORDS /M019 PRTOFF=21 / THE OFFSET FOR THE FIRST WORD OF THE PRINTER SETTINGS SCHDR=6000 / OFFSET USED TO FIND THE SCROLL BUFFER WITH THE / SETTINGS / / CONSTANTS FOR THE OTHER FIELD / THESE ARE THE ADDRESS IN THE BUFFER FIELD THAT CONTAIN THESE ROUTINE'S / ADDRESS. / AXDIS=200 AXEC=AXDIS+1 AXDON=AXEC+1 ADRCRT=AXDON+1 AXLRT=ADRCRT+1 / RETURN THE LOG FILE AXSR=AXLRT+1 / AX SEND AND RECEIVE ROUTINE REDSIX=AXSR+1 / READ FROM RDFILL A 6-BIT CHARACTER AND TRANSLATE TO 7-BIT WRISIX=REDSIX+1 / TAKE A 7-BIT CHARACTER AND TURN INTO 6 AND WRITE TO DISK CLASIX=WRISIX+1 / INITALIZE THE REDSIX AND WRISIX ROUTINES IFNDEF DECDEV < FIELD 1 > IFDEF DECDEV < FIELD 3 > *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / / THE USER FIELD CONSTANTS / CDFMYF=CDFEDT / /M016 / / HERE ARE SOME OF THE MORE COMMONLY USED FLAGS / AXFLG, 0 / SET IF IN AX MODE SENDFL, 0 / THE STATUS FLAG: / -5 = TRANSFER ABORTED / -4 = ERROR AND WAITING / -3 = TRANSFER DONE " " / -2 = NOT CONNECTED YET " " / -1 = CONNECTED " " / 0= RECEIVE / 1= SEND INIFLG, 0 / IF 1 = TRANSFER IN PROGRESS DOCNCT, 0 / IN AX THE NUMBER OF DOCUMENTS TRANSFERRED AXREC, 0 / AX SETS THIS FLAG IF WANT TO RECEIVE SNDAD, 0 / AX SETS IF WANTS TO SEND RSTFLG, 0 / DXIPRG SETS IT TO POSITIVE IF INIT DETECTED AND MINUS / IF OTHER SYSTEM HAS WRONG VERSION OPTFLG, 0 / OPTIONS AVAILABLE TO THIS SYTEM'S USER TMPRST, 0 / CONTAINS THE VALUE THAT TELLS THE OTHER SYSTEM / THE OPTIONS IT HAS AVAILABLE AT CONNECT TIME CNGSCF, 0 / CAN BE SET BY ANYONE IF + MAINJOB WILL DISPLAY ONLY THE PART / THAT HAS BEEN SAID TO BY OTHER FLAGS, IF - REPAINT THE SCREEN INIFL3, 0 / THE FLAG IS SET TO NON ZERO IF HIGH LEVEL INIT HAS TAKEN / PLACE MGWTFG, 0 ERRFLG, 0 / SET BY ANYONE. IF - THE ERROR ALL OPTIONS EXCEPT GM / ARE NOT ALLOWED. IF + THEN JUST DISPLAY THE ERROR HSTRAD, 0 / THE ADDRESS OF THE PACKET THAT THE HOST SYSTEM RECEIVED DXGTPT, 0 / A POINTER FOR THE PACKET STARTING WORD MSGAST, 0 / THIS IS THE FLAG TO TELL THE MAINLP THAT A MESSAGE IS BEING / TRANSFERRED AND THE STATUS WORD'S ADDRESS IS ITS VALUE AXPMT, 0 / 1= ACT LIKE A SPECIAL PROMPT FOR AX OSYSAX, 0 / 1= OTHER USER IS IN AX TEMP, 0 / TEMP USED BY ANYONE GTBFPT, INBUFA / BUFFER AREA FOR THE INPUT FROM KEYBOARD /The following variables are modified during start up of /WPTRNS. They are on this page because there is room here. /They can be moved if you can find room. DLY1X, -6 /A020 DLY3X, -12 /A020 DLY6X, -37 /A020 DLY180, -264 /A020 / / THE FOLLOWING 9 WORDS MOVED HERE FOR ROOM AT (022) SENT2, 0 EOF, 0 SENT3, 0 SENTMP, 0 SENT4, 0 DXNONK, 0 DTARTM, 0 BYSETF, 0 NOFLAG, 0 / SPECIAL CASES OF "NO" PACKET /A031 PRBSFG, 0 / TEXT IN "NO" PACKET /A031 GTSTA3, INBUFA / NODSBL, 0 / Set to 0 for UPDATE; 1 for no update / /The following 9 locations must start with CLASXA and must terminate with 0 / CLASXA, CLASIX / Init REDSIX/WRISIX routines. REDSXA, REDSIX / Read SIX bit. WRISXA, WRISIX / Write SIX bit. ADRCRA, ADRCRT / Create a document. AXECA, AXEC / Ask DX user for info needed at connect time. AXDISA, AXDIS / Set up AX. AXSRA, AXSR / AX SEND/RECEIVE routine. AXDONA, AXDON / Log transaction to AX LOG file. 0 / *173 / / THESE FLAGS HAVE TO BE IN THESE LOCATIONS FOR AX TO WORK / SPFLAG, 0 / IF NEGATIVE TELLS THE OTHER JOBS TO EXIT, IF POSITIVE / TELLS THE HOST JOB TO WAIT / FREEPT, BUFBL1 / POINTER TO THE FIRST FREE BUFFER (START OF THE FREE LIST) RECPT, 0 / START OF THE BUFFERS RECEIVED LIST SENDPT, 0 / START OF THE SEND LIST / NULCNT, -2 / THIS IS THE NEGATIVE NUMBER OF NULLS TO SEND AT THE / END OF EVERY PACKET AFTER THE CR. IT IS SET BY THE / RECEIVED INIT PACKET. / SET TO -2 TO WORK CORRECTLY WITH RSX-11M / PAGE / / THE PROGRAM STARTS HERE / DWXTRT, XX CLA RDF TAD CIDF0 DCA RTNCER / SAVE THE CALLERS FIELD CDFMYF / CDF FOR THIS FIELD TAD (OPTALL) / SET THE OPTIONS TO ALL UNTIL LATER DCA TMPRST JMS SETSIX / SET THE CROSS FIELD CALLS JMS XDELAY /INITIALIZE TIME OUT DELAYS /A020 / /D023; TAD (DXSTLS-1) / Get the list of stuff to initialize /M023 /D023; JMS DXIOCL / at start-up /M023 /D023; /D023; / HAS TO BE DONE ONCE /D023; / THIS IS CHAINING THE BUFFERS TOGETHER TO /D023; / CREATE THE INITIAL FREE LIST /D023; TAD (BUFBL1) /D023; DCA FREEPT /D023; TAD (BUFBL2) /D023; DCA BUFBL1 /D023; TAD (BUFBL3) /D023; DCA BUFBL2 /D023; TAD (BUFBL4) /D023; DCA BUFBL3 /D023; TAD (BUFBL5) /D023; DCA BUFBL4 / JMS DXICLA / CLEAR THE FLAGS NEEDED FOR THE IO PROGRAMS TO START /D023; JMP CHKROT / CHECK FOR THE ROUTINE THAT WAS CALLED /D023; / CHKROT RETURNS TO TRNCN5 CHKROT, / /A023 / / CHKROT - SEES WHICH ROUTINE WAS CALLED FROM THE MENU / 1 AUTO TRANSMIT / 2 DOCUMENT TRANSFER / CHKROT, CDFMNU TAD I (MUBUF+MNTMP1) / SEE WHAT PACKAGE WAS CALLED CDFMYF DCA T3 / / INITALIZE THE SYSTEM MESSAGE SENT AT INIT TIME IFDEF ENGLSH < TAD ("D-200) / INITALIZE TO DX > IFDEF ITALIAN < TAD ("D-200) / INITALIZE TO DX > IFDEF V30NOR < TAD ("D-200) / INITALIZE TO DX > IFDEF V30SWE < TAD ("D-200) > DCA SYSTY2 / Save the "DX" name TAD (DXSYS) / TELL THE OTHER SYSTEM THAT THIS SIDE IS IN DX DCA SYSTY1 / / The following was deleted in edit 023 because CMADSX is initialized /A023 / in WPCU3.PA when communications is 1st loaded. /A023 /D023; IFDEF WS102 < /D023; TAD T3 / SET THE FLAG IS WS102 TO WHAT IS SELECTED /D023;/ /D023; CDFSYS / ++++ /D023; DCA I (CMADSX) / ++++ /D023; CDFMYF /D023; > / END IFDEF WS102 AC7777 / CHECK FOR "AX" TAD T3 SZA CLA / ++++ JMP TRNCN5 / IF NOT "AX" THEN RETURN CIFBUF / Call routine to start AX. JMS I AXDISA / ... JMP RTNSY / GOLD MENU RETURN ISZ AXFLG / SET THE TOP MESSAGE TO "AX" IFDEF ENGLSH < TAD ("A-200) / INITALIZE TO AX > IFDEF ITALIAN < TAD ("A-200) / INITALIZE TO AX > IFDEF V30NOR < TAD ("A-200) / INITALIZE TO AX > IFDEF V30SWE < TAD ("A-200) > DCA SYSTY2 / Save the "AX" name TAD (AXSYS) DCA SYSTY1 AC0002 / THE AX OPTIONS CAN NEVER CHANGE FROM 2 DCA OPTREC JMP TRNCN5 TRNCN2, JMS CLAMSL / CLEAR THE MESSAGE LINE OF ANY MESSAGES / OR ERRORS TRNCN5, AC7776 / ++++ DCA SENDFL / SET THE STATUS TO NOT CONNECTED DCA ERRFLG / CLEAR THE ERROR FLAG ON REINITALIZING DCA OSYSAX / CLEAR THE FLAG THAT TELLS THE USER THAT THE / OTHER / SYSTEM IS IN AX DCA INIFL3 / FOR THE HIGH LEVEL TAD OPTREC / RESET THE OPTIONS DCA OPTFLG JMS SETFLG / SET THE FLAGS DCA PMTTMP / CLEAR ALL PENDING PROMPTS DCA INIFL2 / CLEAR THE LOW LEVEL FLAG FOR INITALIZATION DCA INIFL1 / CLEAR THE FLAG FOR THE LOW LEVEL SAYING TO / SEND INIT DCA SPFLAG / CLEAR THE STOP THE HOST FLAG JMS STRJBS / START THE PROGRAMS JMP TRNCN6 / DISP SCREEN FIRST /A039 /D039 JMP MAINL3 / WAIT FOR THE LINE TO INITALIZE / / ******************************* / RTNSY, JMS DOCTRN / KILLS THE JOBS RUNNING AND CLOSES FILE / IFDEF WS102 < / JMS RTN102 / UNLOCK THE LOG DOCUMENT / > / END IFDEF WS102 /D023; CLA CDFMNU / Map MENU field. /A023 TAD I (MUBUF+MNTMP6) / Get EZ-LINK indicator. /A023 CDFMYF / Back to our field. /A023 SZA CLA / Skip if normal exit. /A023 JMP RTNCX / Jmp to chain back to CX. /A023 CIF 60 / Map Alternate buffer field. /A024 JMS I (COMXIT) / Undo field-6 buffers. /A024 / JMS RTCLCM / CLEAR THE FLAG FOR OTHER USER CDFSYS /A017 DCA I (CMADSX) /A017 CDFMYF /A017 / RTNCER, XX JMP I DWXTRT RTNCX, CDFMNU / Map MENU field. /A023 TAD (MUBUF+MNONUM-1)/ Set up to modify MENU Overlay info. /A023 DCA IX1 / ... /A023 TAD (3) / Set up menu code to re-load CX. /A023 DCA I IX1 / Overlay #3 is CX. /A023 TAD (200) / CX entry point is at 200. /A023 DCA I IX1 / ... /A023 TAD (CIF 20) / field to load CX into. /A023 DCA I IX1 / ... /A023 CDFMYF / back to our field. /A023 ISZ DWXTRT / Set to CHAIN to CX /A023 JMP RTNCER / go to it!!! /A023 /D023; /D023;/ /D023;/ THE LIST OF LOCATIONS THAT ON ENTERING THEY HAVE TO BE ZERO /D023;/ /D023;DXSTLS, /D023; DOCNCT / THE DOCUMENT COUNTER FOR AX /D023; AXFLG / THE ALL IMPORTANT AX FLAG IS SET SAYS THE PROGRAM IS AN AX /D023; INBUFA / CLEAR THE KEYBOARD BUFFER /D023; SENDPT / THE POINTER TO THE BUFFERS SENT LIST /D023; RECPT / THE POINTER TO THE RECEIVED LIST /D023; DSKBA1 / CLEAR THE BUFFER FOR DOCUMENT TRANSFER /D023; DSKBA3 / CLEAR THE SECOND BUFFER /D023; DXIHFP / RELEASE THE BUFFER THAT THE INPUT TASK USES /D023; BUFBL5 / THE ZERO IS INSERTED IN THE END OF THE FREE LIST /D023; PUTPRC / CLEAR THE COUNTER OF THE BUFFERS WAITING TO BE ACKED /D023; PTRHED / AND CLEAR THE FIRST ENTRY /D023; PTRHED-1 / AND THE TEMP LOCATION /D023; STRTJB / CLEAR THE FLAG THAT SAYS THE JOBS ARE RUNNING /D023; OPTREC / CLEAR THE OPTIONS OF THE OTHER SYSTEM /D023; HSFLAG / HOST FLAG /D023; TRNERC / CLEAR THE ERROR COUNTER /D023; RDFILF / FLAG SET IF OPEN DOCUMENT FOR READ /D023; 0 /D023;/ GETCHR, XX / Routine to display date & time and get a / character CIFPRT / Call FLABUZ in printer field. JMS I (FLABUZ) / ... (display printer error if appropriate) CIFMNU / Now display updated time. JMS I TIMCAL / ... JMP GETCH1 / no time change. don't update display. JMS CPYTIM / Copy new time values. CIFMNU / Now to update the screen. JMS I IOACAL / ... 0 / output directly to the terminal. TIMSTR / ... 0072 / Line 1, col 59. DATSTR / Time/Date string. JMS DISBL / update bottom line. GETCH1, CIFSYS / Now wait for RETURN or GOLD MENU. XLTIN / ... ISZ GETCHR / Take 2nd return for buffer full. JMP I GETCHR / Return to caller. / / FILMBF - FILLS THE MESSAGE BUFFER INMBLK / FILMBF, XX TAD (INMBLK) JMS FILIBF JMP I FILMBF /------------ PAGE / / SETFLT - CLEAR THE FLAGS FOR THE DX INIT / SETFLT, XX CLA DECIMAL TAD (-1000) / SET THE INITAL COMPARISON COUNTER FOR BLOCK / COUNT OCTAL DCA BLKTMP TAD DSKBA1 / SEE IF THE FIRST OF 2 BUFFERS ARE IN USE SNA / ++++ JMP SETFL2 JMS PUTBUF / ++++ FREEPT SETFL2, TAD DSKBA3 / CHECK FOR THE OTHER SNA / ++++ JMP SETFL3 JMS PUTBUF / ++++ FREEPT SETFL3, TAD (SETFLL-1) JMS DXIOCL CIFBUF JMS I CLASXA / INITALIZE THE RED AND WRI SIX ROUTINES JMS CLDOC / CLOSE ANY DOCUMENTS LEFT OPEN BEFORE OPENING ANOTHER JMP I SETFLT / / SETFLL - THE LIST OF FLAGS THAT ARE CLEARED FOR THE DX / SETFLL, INIFLG / CLEAR THE PROGRAM STARTED TO SEND A DOC FLAG SNDAD / USED FOR THE SEND PART OF AX AXREC / AND USED BY AX RECEIVE INMSFG / FLAG SAYING THAT THERE IS A MESSAGE TO PUT UP BYSETF / BYE COMMAND IS BEING SENT FLAG BLKNUM / THE NUMBER OF BLOCKS SENT CORRECTLY EOF / END OF DOCUMENT FLAG DOCSIZ / SIZE OF THE SENDING DOCUMENT IN BLOCKS RESBFS / CLEAR THE FLAG FOR THE BUFFERS HAVE BEEN CHOSEN DSKBA1 / THE ADDRESS OF THE FIRST BUFFER USED FOR THE TRANSFER DSKBA3 / THE SECOND BUFFER DSKBA4 / THE DISK BUFFER WRITE FLAG DSKBA2 / THE OTHER DISK BUFFER WRITE FLAG BLKOVR PMTFLG / CLEAR THE PROMT FLAG ERRFLG / CLEAR THE ERROR FLAG NOFLAG / SPECIAL CASES OF "NO" PACKET /A031 /D023; DOCLSA / CLEAR THE FIRST ENTRY INTO THE LIST EVERY TIME A /D023; / TRANSFER IS TO START RSTFLG / CLEAR THE RESTART FLAG 0 / / DXICLA - CLEARS THE MAJORITY OF THE FLAGS THAT ARE NEEDED FOR THE LOW / LEVEL INIT / DXICLA, XX TAD (TOCLST-1) JMS DXIOCL JMS HOSTIN / CLEAR THE INPUT BUFFER SKP CLA JMP .-2 JMP I DXICLA / / DXIOCL - CLEARS THE LIST SPECIFIED BY THE AC / DXIOCL, XX DCA IX1 / THE AC CONTAINS THE LIST ADDRESS MINUS 1 DXICLL, TAD I IX1 SNA / ++++ JMP I DXIOCL DCA T2 DCA I T2 / CLEAR THE FLAG JMP DXICLL / / START THE OTHER JOBS / STRJBS, XX CLA TAD STRTJB SZA CLA / ++++ JMP I STRJBS AC0001 / ++++ DCA STRTJB /D035 TAD USERNO /D035 SZA CLA / ++++ /D035 TAD (JSBSZ^4) TAD (JSBX0) / ++++ DCA X0 TAD (JLIST-1) / ++++ DCA IX1 JMP B A, MQL TAD X0 / ++++ DCA T1 CDFSYS RIF CLL RAL DCA I X0 DCA I X0 MQA / ++++ DCA I X0 DCA I X0 ISZ X0 CDFMYF / CDF FOR THIS FIELD (MY FIELD) TAD T1 CIFSYS / ++++ JSTRT B, TAD I IX1 SZA / ++++ JMP A JMP I STRJBS JLIST, HSTPRG / ++++ DXIHJB / ++++ DXOHJB 0 STRTJB, 0 / UNABLE TO CREATE DOCUMENT ERROR PATH /A031 RCVCR3, DCA PMTTMP / CLEAR FLAGS /A031 DCA AXPMT / /A031 TAD (-4) / SIGNAL - "***ERROR***" /A031 DCA SENDFL / /A031 AC7777 / SIGNAL - CHANGE SCREEN /A031 DCA CNGSCF / /A031 JMP MAINLW / RETURN TO MAIN LOOP /A031 / RECEIVED A "NO" PACKET - OTHER SYS UNABLE TO CREATE /A031 RECNO1, AC0003 / SIGNAL - "COULD NOT CREATE DOC." /A031 DCA ERRFLG / /A031 DCA PMTTMP / CLEAR FLAGS /A031 DCA AXPMT / /A031 TAD HSTRAD / RELEASE BUFFER /A031 JMS PUTBUF / /A031 FREEPT / /A031 JMP HSTRST / RESTART HOST /A031 GTLERD, XX / RING BELL HERE /C034 CIFMNU JMS I IOACAL / /C034 0 BELSTR / CONTROL STRING /C034 BELTXT / BELL CODE /C034 JMP I GTLERD / Return to caller. /------------- PAGE / / TRNAGN - WAITS FOR THE HOST JOB TO RESPOND TO THE SPFLAG / TRNAGN, AC0001 / SET THE FLAG INCASE IT WASNT SET JMS HSTSET / SET THE FLAG AND WAIT FOR THE HOST TO GET IT JMP RTNSY / GO BACK TO MAIN MENU JMS CLDOC / CLOSE THE DOCUMENT JMP TRNCN2 / / HSTSET - SETS SPFLAG TO TELL THE HOST SOMETHING AND WAITS / FOR HOST TO SAY IT RECEIVED IT / HSTSET, XX DCA SPFLAG HSTSE2, JMS HLTEST / ++++ JMP I HSTSET TAD HSFLAG / SEE IF THE HOST STOPPED SNA CLA / ++++ JMP HSTSE2 ISZ HSTSET JMP I HSTSET / / RSTPRG - THE HIGH LEVEL INIT ROUTINE / IT WILL SEND AN INITALIZE MESSAGE EVERY / 5 SECONDS AND WAIT FOR A INITALIZE ACK / RSTPRG, TAD (INITYP-1) JMS INIBFS JMP HSTWAT / SPFLAG IS SET SO WAIT JMP TIMEOU / TIMED OUT ISZ INIFL3 / SET IT SO ONLY ONE INIT IS SENT JMP HSTJWT / WAIT FOR OTHERS TO SEE WHAT IS DONE / / CPYITM - COPY FROM THE COMMUNICATIONS KEYBOARD BUFFER TO MENU'S / CPYITM, XX DCA TOKOFT / GET THE STARTING ADDRESS JMS DXCOPY CDFMYF TOKOFT, XX CDFMNU CPYDST, MUBUF+MNIBUF TAD CPYDST / SET THE POINTER TO THE MENU BUFFER CDFMNU DCA I (MUBUF+MNPOS) CDFMYF JMP I CPYITM / / CPYMTB -GET THE DOCUMENT NAME THAT WAS TYPED / CPYMTB, XX DCA CPYMT2 JMS DXCOPY CDFMYF CPYMT2, XX CDFMYF DOCNBF DCA INBUFA / CLEAR THE KEYBOARD BUFFER SINCE DONE WITH IT JMP I CPYMTB / / GTDCNO - GETS THE DOCUMENT NUMBER FROM THE MENU / GTDCNO, XX CDFMNU TAD I (MUBUF+MNFNO) / ALSO SET THE DOCUMENT NUMBER CDFMYF DCA DOCNO JMP I GTDCNO / / HITRTN - HOST ROUTINE THAT WILL TAKE CARE OF A HIGH LEVEL INIT PACKET / HITRTN, TAD AXFLG / KNOW WHAT THE OTHER SYSTEM IS RUNNING BUT DO SNA CLA / ++++ JMP HITRT2 / NEED MORE INFORMATION IF WE ARE AX? CIFBUF JMS I AXECA JMP HSTWAT / SPFLAG IS SET JMP TIMEOU / TIMED OUT DCA TMPRST / SAVE OPTIONS THAT THE OTHER SYSTEM CAN USE HITRT2, AC0004 / GET THE FIRST WORD THE ONE THAT HAS OTHER SYSTEMS TAD HSTRAD / TYPE IN IT IT CAN BE EITHER DX OR AX DCA T1 TAD I T1 TAD (-40) / IF 40 = DX 41=AX DCA OSYSAX TAD OSYSAX SZA CLA / ++++ JMP HITRT4 / IF AX THERE IS NO NEED TO SEND THE OPTIONS TAD TMPRST / RESPOND WITH THE OPTION PACKET DCA OPTSTR+1 TAD (OPTSTR-1) JMS INIBFS JMP HSTWAT JMP TIMEOU HITRT4, AC7777 / ++++ DCA SENDFL / SET STATUS TO WAITING AND INITALIZED TAD HSTRAD / ++++ DCA LN2FG / TELL THE MAINJOB THE ADDRESS OF THE BUFFER TO / DISPLAY AND RELEASE WHEN DONE. AC7777 / ++++ DCA CNGSCF / REPAINT THE SCREEN JMP HSTJWT / WAIT BUT FIRST CLEAR THE INTFLG LN2FG, 0 OPTSTR, TYPOPT XX 0 / / DISBL - DISPLAYS THE BOTTOM LINE AND POSITIONS THE CURSER / DISBL, XX TAD NODSBL / IF 1 THEN DONT DISPLAY THE BOTTOM LINE SZA CLA / ++++ JMP I DISBL CIFMNU JMS I IOACAL 0 CLALIN 2700 CIFMNU JMS I IOACAL / DISPLAY THE BOTTOM LINE KBOUTC BTLINE INBUFA JMP I DISBL / / THIS WILL CLEAR THE MESSAGE LINE ON THE SCREEN / CLAMSL, XX CIFMNU JMS I IOACAL 0 CLALIN 500 / PROBLEM LINE IS NOW ON 4, CLEAR IT TO /A031 CIFMNU /A031 JMS I IOACAL /A031 0 /A031 CLALIN /A031 400 / PROBLEM LINE /A031 JMP I CLAMSL /------------ PAGE / / DXICKV - CHECK THE VERSION OF THE CONNECTING PROTOCOL TO SEE IF SAME / DXICKV, XX AC0002 TAD DXGTPT DCA X5 TAD I X5 / GET WHAT IS SENT TAD (-VERSIO) SZA CLA / ++++ JMP DXICKE / ERROR TAD I X5 / ++++ SZA / ++++ JMS SBOFST / ++++ CIA / ++++ DCA NULCNT / STORE THE NUMBER OF NULLS THE / HOST NEEDS AFTER THE CR DCA ERRFLG / CLEAR ERROR STATUS /A017 / (FOR RECONNECT REASONS) /A017 / / *** NOTE *** / THE SZA IN THE ABOVE SEQUENCE IS THERE TO ALLOW PRE-VER3.1 / SOFWARE NAMELY 3.0 TO TALK TO EACH OTHER. 3.1 IS THE FIRST TO HAVE THE NULL / COUNT ADDED TO IT. SO IT ASSUMES ZERO IF TALKING TO 3.0 / ISZ DXICKV JMP I DXICKV DXICKE, TAD (7) / ++++ DCA ERRFLG / SET FOR THE CORRECT MESSAGE JMP I DXICKV / / INIBFS - SENDS A BUFFER BY PLACING IT IN THE SEND CHAIN / THE AC UPON ENTERING CONTAINS THE ADDRESS IF THE TEXT TO SEND IN THE / PACKET INCLUDING THE TYP. THE ADDRESS IS = TO / THE STRING ADDRESS -1 TO USE IN AN AUTO INDEX REGISTER. / CALL: JMS INIBFS / RETURN TO MAIN MENU / TIMED OUT / SENT OK / INIBFS, XX DCA INITM2 / SAVE THE CHARACTER TO SEND JMS GETFRE / GET A FREE BUFFER AND RETURN THE ADDRESS IN THE AC JMP I INIBFS / ERROR RETURN DCA IBFAX / SAVE THE ADDRES TO THE BUFFER TAD IBFAX DCA IX1 DCA I IX1 / CLEAR THE STATUS FLAG DCA I IX1 / CLEAR THE SEQUENCE WORD TAD INITM2 DCA IX0 INIGF4, TAD I IX0 SNA / ++++ JMP INIGF3 DCA I IX1 JMP INIGF4 INIGF3, DCA I IX1 / INSERT A ZERO TRAILER TAD IBFAX / SEND THE BUFFER JMS PUTBUF / ++++ SENDPT / SEND THE PACKET JMP INIBW3 INIBWT, JMS INIWAT / WAIT AND CHECK THE STOP FLAGS JMP INIBER / ONES SET INIBW3, AC0001 TAD IBFAX DCA T1 TAD I T1 SNA / ++++ JMP INIBWT DCA INITM2 TAD IBFAX / FREE IT JMS PUTBUF / ++++ FREEPT TAD INITM2 SMA CLA / ++++ ISZ INIBFS / ERROR DONT INCREMENT ISZ INIBFS JMP I INIBFS INIBER, TAD IBFAX JMS PUTBUF / ++++ FREEPT / EVEN IF ERROR RELEASE BUFFER JMP I INIBFS INITM2, 0 IBFAX, 0 / / THIS WILL STOP THE JOBS THAT ARE RUNNING AND / CLOSE THE FILE THAT YOU ARE WRITING TO SINCE IT IS A COMPLETE / COPY I DONT ALLOW MULTIPLE DOCUMENTS STORED IN A SINGLE ONE / DOCTRN, XX CLA TAD STRTJB / DONT STOP IF NOTHING STARTED SNA CLA / ++++ JMP I DOCTRN / IF NOTHING STARTED DONT BOTHER CLOSING AC7777 / ++++ DCA SPFLAG / TELL THE OTHER PROGRAMS TO STOP JMP EXTJMP / GO AND CHECK THE PROGRAMS FOR TERMINATION EXTWAT, CIFSYS / ++++ JSWAP / GET DONE AS SOON A IT CAN EXTJMP, TAD DXIFLG / ASSUME THAT THEY WILL BE - ONLY IF EXITED SMA CLA / ++++ JMP EXTWAT TAD DXOFLG SMA CLA / ++++ JMP EXTWAT TAD HSFLAG SMA CLA / ++++ JMP EXTWAT JMS CLDOC / CLOSE THE DOCUMENT JMP I DOCTRN / / CLDOC - CLOSES THE DOCUMENT THAT IS OPENED / CLDOC, XX CLA TAD RDFILF / IF FLAG IS SET THEN THE DOCUMENT WAS OPENED FOR READ SZA CLA / ++++ JMP CLDO2 JMS CLSCRL / CLOSE SCROLL JMP CLDO3 CLDO2, DCA RDFILF CLDO3, DCA DOCNO / CLEAR THE DOCUMENT NUMBER JMP I CLDOC / / HSTOU - USED TO SEND CHARACTERS TO THE HOST. SHOULD BE USED FOR ONLY SENDING / NULLS SINCE THE REGULAR ROUTINE TO SEND A CHARACTER IS HOSTOU. THE REASON / FOR HAVING THIS ROUTINE IS THAT IT IS CALLED BY HOSTOU THROUGH HOSTO2. THE / REASON FOR NOT DOING IT A CLEANER WAY IS ROOM. / HSTOU, XX JMP HSTO2 HSTO3, TAD SPFLAG / IF SET TO -1 THEN RETURN SINCE SYSTEM ABORTED SPA CLA / ++++ JMP I HSTOU CIFSYS / ++++ JWAIT HSTO2, CIFSYS / ++++ HS2OU JMP HSTO3 JMP I HSTOU / / DXIQIT - ROUTINE USED BY INPUT JOB TO ACT ON A RECEIVED QUIT PACKET / DXIQIT, AC7777 / ++++ DCA CNGSCF / MAKE SURE SCREEN IS UPDATED TAD (-11) / ++++ DCA ERRFLG / SET THE ERROR MESSAGE DCA INIFLG / STOP ANY TRANSFERRING JMP DXIHJB /------------ PAGE / / RTCLCM - SETS THE COMMUNICATIONS FLAG TO NOT IN USE. / THE FLAG WAS SET BY CU3COM IN WPCU3.PA BEFORE THIS OVERLAY WAS LOADED / /RTCLCM,XX / CDFSYS / DCA I (CMADSX) / CDFMYF / JMP I RTCLCM / / THIS IS THE MAIN KEYBOARD LOOP / THE LOGIC OF THIS JOB IS TO TAKE CARE OF THE SCREEN AND ALSO THE USER. / IT DISPLAYS MOST OF THE MESSAGES THAT ARE TO APPEAR ON THE SCREEN AND ALSO / PREFORM ANY REQUESTS FROM THE USER / MAINL3, DCA DISTMP / CLEAR DISPLAY LOCK FLAG /C039 MAINLP, JMS GTLINE / SEE IF ANYTHING IS BEING TYPED IN JMP MAINL3 / ERRO SO REDISPLAY JMP RTNSY / GOLD MENU RETURN SKP / OK NOW CHECK FLAGS WHILE WAITING FOR SOMETHING JMP KBDL1 / EOL JMS CHKMSG / Check Msg - See if one is outstanding./A037 NOP / Yes. ignore it. /A037 TAD CNGSCF / DISPLAY THE NEW SETTINGS SZA CLA / ++++ /C039 JMS CKDISF / CK FLAG FIRST AND THEN DISPLAY /C039 TAD RSTFLG / SEE IF HAVE TO RESTART SMA SZA / ++++ JMP TRNAGN / MEANS LOW LEVEL INITED IF + SZA CLA / ++++ JMP MAINLW / THE VERSION OF THE OTHER SYSTEM DOESNT MATCH TAD PMTFLG / SEE IF PROMT FLAG IS SET SZA / ++++ JMP PMTANS TAD SNDAD / SEE OF SENDING TO AX SZA CLA / ++++ JMP SNTOA1 TAD AXREC / SEE IF AX RECEIVE SZA CLA / ++++ JMP RCVRT6 MAINLW, CIFSYS / ++++ JWAIT / NOTHING SEEMS TO BE DONE SO WAIT JMP MAINLP / / MORE OF THE KEYBOARD ROUTINE / CHKMSG, XX / Routine to see if outstanding unanswered msg./A037 TAD MSGAST / IF NOT ZERO THEN A MESSAGE WAS SENT SNA CLA / Skip if there is an outstanding msg. /A037 JMP MSGOK / Jmp if no outstanding msg. /A037 TAD I MSGAST / IF NZ THE ADDRESS OF THE STATUS FOR THE PACKET SPA / ++++ JMP MESTO / TIMED OUT IF NEG. /C034 SNA CLA / If positive then sent ok. /M037 JMP MSGPND / If 0 then msg still pending. /M037 AC7776 / SEE IF JUST SENT A PROMPT ANSWER TAD PMTTMP SPA CLA / ++++ JMP MESSN2 TAD INIFLG / SEE IF ALREADY SET SNA / Skip if already set. AC7777 / ++++ DCA INIFLG MESSN2, DCA PMTTMP / CLEAR THE PROMPT FLAG ISZ MGWTFG TAD CNGSCF / IF SET DONT TOUCH SNA CLA / ++++ ISZ CNGSCF DCA MSGAST / CLEAR FLAG TAD MSGAX JMS PUTBUF / ++++ FREEPT MSGOK, ISZ CHKMSG / Return w/ no message pending. /A037 MSGPND, JMP I CHKMSG / Return w/ message pending. /A037 / / THIS IS THE CHECK FOR VALID COMMAND LOGIC / KBDL1, JMS INITKF / Set TOKOFF to start of input INBUFA string. CIFMNU / Parse 1st token from input string. JMS I NXACAL / This is done primarily for error msgs below. TOKOFF / ptr to input string. TOKBUF / buffer to contain parsed token. JMP MAINLW / No args, so forget it. KBDL3, IFDEF ENGLSH < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > IFDEF ITALIAN < TAD TOKBUF+3 > IFDEF V30NOR < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > IFDEF V30SWE < TAD TOKBUF+2 / SEE IF THE ARG IS TOO BIG > SZA CLA / ++++ JMP KBERRO DCA I GTBFPT / CLEAR THE BUFFER TAD TOKBUF+1 / GET THE ARG / This code changed to accept up to two characters per option (mainly /a044 / due to italian prompting. /a044 TAD (-140) / Convert to six bit packed /a044 SPA / /a044 TAD (40) / /a044 AND P77 / /a044 BSW / Move into top half of word /a044 DCA T1 / and save /a044 TAD TOKBUF+2 / Get the second letter (or zero) /a044 TAD (-140) / Convert it to six bit /a044 SPA / /a044 TAD (40) / /a044 AND P77 / /a044 TAD T1 / Combine it with the other character /a044 CIA / Compement them for the compare /a044 DCA T1 / And save them both together /a044 TAD (KBTBL-1) / Get the address of the valid ans. table/a044 DCA X1 / Save in an auto-index pointer /a044 KBDSRL, TAD I X1 / Get the valid word to compare with /a044 SNA / Is it the end of the table? /a044 JMP KBDEXT / Yes, error. /a044 TAD T1 / Compare it with what the user typed. /a044 SNA CLA / Are they the same? /a044 JMP KBDEXT / Yes, execute the associated routine /a044 ISZ X1 / No, move to cosider the next entry /a044 JMP KBDSRL / Test the next one. /a044 KBDEXT, TAD I X1 / Get the address to jump to /a044 DCA T1 / Save it /a044 JMP I T1 / Jump to it /a044 KBERRO, JMS DISBER / DISPLAY THE ERROR ON THE BOTTOM LINE ISZ NODSBL / SET THE FLAG USED BY RESETS TO TELL IF IT SHOULD UPDDATE / THE BOTTOM LINE AFTER UPDATING THE SCREEN / 0= UPDATE IT 1 = NO / IT IS CLEARED EVERYTIME SOMEONE TYPES A CHARACTER IN GTLINE JMP MAINLW KBTBL, IFDEF ENGLSH < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF ITALIAN < 2204; RECRTN / "R;"D / RECEIVE 1104; SENRTN / "I;"D / SEND 1115; RMESRT / "I;"M / MESSAGE 1124; RBYERT / "I;"T / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF V30NOR < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > IFDEF V30SWE < 2200; RECRTN / "R;0 / RECEIVE 2300; SENRTN / "S;0 / SEND 1500; RMESRT / "M;0 / MESSAGE 0200; RBYERT / "B;0 / BYE 0000; KBERRO / 0 / END OF TABLE, ERROR > /----------- PAGE / / GTLINE - WILL READ IN A CHARACTER FROM THE KEY BOARD AND / INTERPERATE IT FOR ANY SPECIAL MEANING. / / CALL: / JMS GTLINE / NOTHING / RETURN IF THE CHAR. IS A GOLD MENU / OK CHAR THAT HAS BEEN PUT IN THE BUFFER / EOL / GTLINE, XX JMS GETCHR / Get character & display DATE&TIME. SKP / CHAR in AC return. JMP GTLNOK / NOTHING DCA GTLTEM / SAVE THE CHARACTER TYPED DCA NODSBL / CLEAR THE FLAG SO RESETS WILL UPDATE BOTTOM LINE TAD (-INBUFA) / SEE IF IT WAS THE FIRST CHARACTER IN THE BUFFER TAD GTBFPT / IF SO CLEAR THE SCREEN SZA CLA / ++++ JMP GTLIN1 DCA I GTBFPT / FIRST MAKE SURE THE BUFFER IS CLEARED JMS DISBL GTLIN1, TAD GTLTEM TAD (-EDMENU) / CHECK FOR GOLD MENU SNA / ++++ JMP GTLNGM TAD (EDMENU-EDRBCH) / CHECK FOR A RUB CHARACTER SNA / ++++ JMP GTRBCR TAD (EDRBCH-EDRBWD) / NOW CHECK FOR RUB WORD SNA / ++++ JMP GTRBWD TAD (EDRBWD-EDNWLN) / CHECK FOR A RETURN SNA / ++++ JMP GTSTPR TAD (EDNWLN) SPA / ++++ JMP GTERED / SEE IF IT IS A NON VALID EDIT CHAR. AND P177 / IF EVERYTHING PASSES THEN STORE THE CHAR TAD (-40) / GET RID OF CONTROL CHARACTERS SPA / ++++ JMP GTLNOK TAD (40) DCA I GTBFPT TAD I GTBFPT / DISPLAY THE CHAR JMS KBOUTC TAD (-INBUFA-INBUFM)/ CHECK FOR MAX TAD GTBFPT /D034 SZA CLA / ++++ SNA CLA / ++++ /C034 JMP GTERED / MAX - RUB CHAR & RING BELL /A034 ISZ GTBFPT / NOT YET - BUMP POINTER /A034 DCA I GTBFPT / INSERT DELIMITER /A034 JMP GTLNOK / BRANCH TO OK EXIT /A034 GTRBCR, JMS GTRBCH / CALL RUB CHAR JMP GTLNOK / BEGINING OF BUFFER JMP GTLNOK / WORKED OK / / GTRBWR - RUBOUT A WORD / GTRBWD, AC7777 / SEE THE NEXT CHAR WHAT IS IT TAD GTBFPT DCA T1 TAD I T1 TAD (-40) SMA SZA CLA / Skip if space or less (ie not a character). JMP GTRBW2 / found a char (start of word). JMS GTRBCH / Rub out leading spaces (tabs, etc.) JMP GTLNOK / line empty return. JMP GTRBWD / do rest of leading spaces, tabs, etc. GTRBW2, AC7777 TAD GTBFPT / SEE WHAT THE NEXT CHAR IS DCA T1 TAD I T1 TAD (-40) SMA SZA CLA / Skip if not a word character. JMS GTRBCH / Rub out character of word. JMP GTLNOK / line empty so done. JMP GTRBW2 / check out next (preceding) character. GTERED, ISZ GTBFPT / ADJUST FOR RUB CHAR /A034 JMS GTRBCH / RUB CHAR /A034 JMP GTLNOK / NO CHAR RETURN /A034 JMS GTLERD / RING BELL /A034 JMP GTLNOK / TAKE THE NOTHING RETURN /A034 GTSTPR, TAD (INBUFA) / SET THE BEGINNING OF THE BUFFER DCA GTBFPT ISZ GTLINE GTLNOK, ISZ GTLINE GTLNGM, ISZ GTLINE GTERRT, JMP I GTLINE GTLTEM, 0 / / GTRBCH - RUB A CHARACTER IF THERE ARE NO CHARS IT WILL DO A NON SKIP RETURN / IF DID RUB OUT SOMETHING THEN A NORMAL RETURN / GTRBCH, XX CLA TAD (-INBUFA) / CHECK FOR THE POINTER IF IT HAS MOVED TAD GTBFPT SNA CLA / ++++ JMP I GTRBCH / RETURN ISZ GTRBCH AC7777 / DECREMENT THE POINTER TAD GTBFPT DCA GTBFPT DCA I GTBFPT / ERASE THE CHAR FROM THE BUFFER JMS KBOUT / Erase from the screen BKSPAC+4000 / BS SPACE+4000 / SP BKSPAC / BS JMP I GTRBCH / ERROR WHILE CREATING THE RECEIVE FILE /A031 RCVCR1, / ENTRY FOR THE RECEIVER OF THE "REC" PACKET /A031 / SENDS THE "NO" PACKET BACK /A031 DCA INIFLG / CLEAR INIT FLAG /A031 TAD (TYPNO) / "NO" PACKET /A031 DCA ANSBUF / TEMP STORAGE /A031 TAD (ANSBUF-1) / THE POINTER /A031 JMS INIBFS / SEND THE PACKET /A031 JMP HSTPRG / RETURN TO MAIN MENU /A031 JMP TIMEOU / TIMED OUT /A031 RCVCR2, / OK RETURN - PACKET WAS SENT /A031 / ENTRY POINT FROM NORTN - RECEIVER OF A "NO" PACKET /A031 AC0003 / "UNABLE TO CREATE" /A031 DCA ERRFLG / /A031 JMP RCVCR3 / /A031 BELSTR, TEXT '^A' / CONTROL STRING FOR KB ERROR ROUTINE /A034 BELTXT, 207;0 / /A034 /------------ PAGE / / THIS ROUTINE WILL INITALIZE THE PROGRAM FOR SENDING A FILE / SENRTN, JMS CLASTA / CLEAR THE STATUS LINE AND FLAGS /A031 TAD PMTTMP / is the SEND invoked by this user? SNA CLA / Skip if no. JMS INITFN / Set up default filename string. SNDDM1, JMS DOMENU / Prompt for a file name for doc to be sent. DLMA17 / ... JMP KBDL5 / GOLD MENU RETURN TAD TOKOFF / COPY THE LAST INPUT AREA NOT FROM MENU JMS CPYMTB / GET THE FILE NAME TAD AXPMT / SEE IF THE SECOND MENU FOR AX (AN AX PROMPT) SNA CLA / ++++ JMP SNDDM5 DCA AXPMT SNDDM2, AC7776 / TELL NORTN TO USE CANNED MESSAGE /A031 DCA NOFLAG / "UNABLE TO CREATE DOCUMENT" IF NO /A031 AC0002 / SEND THE SEND PAKCET JMP SNDPPK SNDDM5, JMS GTDCNO / GET THE DOCUMENT NUMBER AC0002 / ++++ DCA OPTFLG / SET THE OPTIONS TO SEND A MESSAGE ONLY SNTOA1, DCA SNDAD / CLEAR THE FLAG FOR AX SEND TAD DOCNO CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XRDFIN / OPEN THE FILE FOR READING ISZ RDFILF / SET THE REDFIL FLAG SO TO CLOSE IT / AC0001 / ++++ DCA SENDFL / SET FOR THE SYSTEM TO KNOW THAT IS SEND TAD OSYSAX / IF THE OTHER SYSTEM IS IN AX THEN DISPLAY SNA CLA / the other prompt to tell us what to do. JMP SNDDM2 / JMP if other system not in AX. ISZ AXPMT / SET FLAG FOR PROMT DISPLAY JMS INITKF / INITALIZE THE TOKEN OFFSET TOKOFF TO STARTING OF BUFFER DCA INBUFA / CLEAR BUFFER SO THE SECOND PROMPT ACT LIKE A PROMPT JMP RCVRT0 RCVGLD, JMS CLDOC / CLOSE RECIEVE FILE /A017 KBDL5, AC7777 / THE GOLD MENU RETURN FROM ANY OPTION IN THE KEYBOARD PROGRAM DCA CNGSCF / REDISPLAY THE SCREEN TAD AXFLG / IF SET FOR AX ACT IF NO PROMPT FLAG SET SZA CLA / ++++ JMP KBDL6 TAD PMTTMP / IF IT IS A PROMPT GOLD MENU MEANS GO TO MAIN SZA CLA / ++++ JMP RTNSY KBDL6, TAD INIFLG / IF IN THE MIDDLE OF TRANSFERING THEN JUST CONTINUE SZA CLA / ++++ JMP KBDL7 AC7777 / ++++ DCA SENDFL / SET FOR CONNECTION MADE STATUS TAD OPTREC / ++++ DCA OPTFLG / SET THE OPTIONS BACK TO WHAT THEY WERE KBDL7, DCA AXPMT / CLEAR THE PROMPT STATUS TO AX JMP MAINLW RDFILF, 0 / / ASSEMBLES THE INIT MESSAGE FOR THE OTHER USER / SETUPW, XX JMS GETFRE / GET A FREE BUFFER AND RETURN THE ADRESS IN THE AC JMP HSTWAT / ERROR RETURN DCA SETUPA / STORE THE STARTING ADDRESS CDFFIO / GET THE DOCUMENT SIZE /M013 TAD I (RDFSIZ) CDFMYF / A CDF FOR THIS FIELD (MY FIELD) DCA DOCSIZ TAD SETUPA DCA X1 DCA I X1 / CLEAR THE STATUS DCA I X1 / CLEAR THE SEQUENCE TAD (TYPSOD) / INSERT THE FLAG CHARACTER DCA I X1 TAD DOCSIZ / INSERT IT INTO THE INITAL MESSAGE BSW AND P77 JMS ADOFST DCA I X1 TAD DOCSIZ AND P77 JMS ADOFST DCA I X1 TAD X1 JMS GETPRC / INSERT THE PRINTER SETTINGS TAD SETUPA / PUT THE PACKET INTO THE SEND LIST JMS PUTBUF / ++++ SENDPT JMP SNDFS2 SNDFS1, JMS INIWAT / WAIT JMP HSTWAT / SPFLAG SET SNDFS2, AC0001 / CHECK THE STATUS TAD SETUPA DCA T1 TAD I T1 SNA / ++++ JMP SNDFS1 / NOT DONE DCA TEMP / SAVE STATUS TAD SETUPA / OK JMS PUTBUF / ++++ FREEPT / SO GET RID OF IT TAD TEMP SPA CLA / ++++ JMP TIMEOU / IF - THEN TIMED OUT JMP I SETUPW SETUPA, 0 /-------------- PAGE / / THE ROUTINE TO HANDLE THE RECEIVE COMMAND / RECRTN, JMS CLASTA / CLEAR STATUS LINE AND FLAGS /A031 TAD PMTTMP / who's initing this? SNA CLA / Skip if HOST initing the receive. DCA DOCNBF / For user initiated prompt, clear default. RCVRT0, JMS DOMENU / Put up the RECEIVE menu. DLMA16 / ... JMP KBDL5 / GOLD MENU RETURN TAD TOKOFF JMS CPYMTB / GET THE DOCUMENT NAME CDFMNU / Get MNTMP3 return value. TAD I (MUBUF+MNTMP3) / ... CDFMYF / 3 = ok return; 4 = have to create return. TAD (-4) / check for "have to create" return. SNA CLA / Skip if file already exists. JMP RCVCRT TAD AXPMT / WHATS IT USED FOR A SPECIAL PROMPT TO AX SNA CLA / ++++ JMP RCVMOD / NO DCA AXPMT RCVRT3, AC0003 / SET THE PROMPT RESPONSE TO = RECEIVE JMP SNDPPK RCVMOD, / ASKMOD Gets MNTMP3 value from AC. JMS ASKMOD / Display Top, Bottom, Overwrite & get option. DLMA15 / ... JMP RCVGLD / GOLD MENU RETURN /A017 TAD (-2) / GET BACK TO THE VALUE THAT WAS IN MNTMP1 DCA DOCMOD / STORE THE OPTION JMP RCVRT5 RCVCRT, CIFBUF JMS I ADRCRA / Call CREATE routine. JMP RCVCKP / CREATE ERROR FOR THE PUT ROUTINE /C033 CDFMNU / SET "REMEMBERED" FILE NUMBER. DCA I (MUBUF+MNFNO) / ... TAD I (MUBUF+MNFNO) / GET DOC NUMBER. AND P377 / ... DCA I (MUBUF+MNDOCN) / STORE IT TOO. / the below is not needed as GTDCNO does CDF for us & i need 1 more word. / CDFMYF / Back to our field. RCVRT5, JMS GTDCNO / Copy doc # from menu to DOCNO. RCVRT6, DCA AXREC / CLEAR THE AX RECEIVE FLAG TAD DOCNO MQL TAD DOCMOD / GET THE WAY THE FILE IS TO BE OPENED CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKIN / INITALIZE THE FILE AC0002 / ++++ DCA OPTFLG / SET TO ONLY SEND A MESSAGE AND BYE DCA SENDFL / SET TO RECEIVE TAD OSYSAX / IF THE OTHER SIDE IS AX THEN ANOTHER PROMPT SNA CLA / IS NEEDED JMP RCVRT3 / Jmp if other side NOT in AX. JMS INITKF / INITALIZE THE TOKEN OFFSET TOKOFF TH BEGINING OF BUFFER DCA INBUFA / CLEAR SO OTHER DISPLAY ACTS LIKE A PROMPT ISZ AXPMT JMP SNDDM1 DOCNO, 0 DOCMOD, 0 RCVCKP, CLA / CK FOR LOCAL INIT. OF REC /A033 TAD PMTTMP / /A033 SNA CLA / SKIP IF HOST /A033 JMP RCVCR2 / LOCAL ERROR ONLY /A033 JMP RCVCR1 / HOST REQUIRES A "NO" PACKET /A033 / / IT WILL SEND A MESSAGE TO THE OTHER SYSTEM / RMESRT, JMS WTMARG / WAIT FOR SOMETHING TO BE TYPED TAD (TYPMES) / INSERT THE TYP CODE MSGSET, DCA T3 / STORE THE FLAG CHARACTER / THIS IS A TEMP ON PAGE ZERO BUT I USE IT SINCE / GETBUF ONLY USES 1 AND 2 BUT WATCH OUT IF CHANGED JMP MSGST1 MSGST2, JMS HLTEST / ++++ JMP RTNSY / SEE IF A GOLD HALT WAS PRESSED MSGST1, JMS CHKMSG / See if there is a msg pending an ACK. /A037 JMP MSGST2 / Jmp if yes. Wait for it to be 'ack'ed /A037 JMS GETBUF / ++++ FREEPT JMP MSGST2 DCA MSGAX / SAVE THE ADDRESS OF THE BUFFER FOR LATER TAD MSGAX DCA X3 DCA I X3 / CLEAR THE STATUS FLAG TAD X3 DCA MSGAST / STORE THE ADDRESS OF THE CONDITION CODE DCA I X3 / CLEAR THE SEQUENCE POSITION TAD T3 / INSERT THE FLAG CHARACTER DCA I X3 JMS MSGFIL / FILL THE REMAINING OF THE PACKET TAD MSGAX / PUT IN SEND LIST JMS PUTBUF / ++++ SENDPT / BUT INTO THE SEND BUFFER JMS CLAINF ISZ MESSNF / PUT UP MESSAGE SENT JMP MAINLW / GO AND WAIT FOR THE MESSAGE TO BE SENT MESSNF, 0 MSGAX, 0 MESTO, AC7776 DCA ERRFLG / SET ERROR MESSAGE /A034 DCA MSGAST / MESSAGE SENT FLAG /A034 JMP RCVCR3 / CONTINUE ERROR PATH AT OLD MAINER /A034 /----------- PAGE / / SEND A GOOD-BYE TO THE OTHER TERMINAL / RBYERT, JMS WTMARG / WAIT FOR SOMETHING TYPED THAT CAN BE SENT JMS STPTRN / STOP A TRANSFER IN PROGRESS IF ANY TAD (TYPBYE) / SET THE TYP OF THE BUFFER JMP MSGSET / / PMTANS - WILL DISPLAY THE PROMPT AND WAIT FOR A RESPONSE / PMTANS, DCA PMTTMP / CLEAR THE REAL PROMPT FLAG FOR OTHERS TO BE ALLOWED DCA PMTFLG / WHILE THIS ONE IS BEING ANSWERED DCA INBUFA / CLEAR THE BUFFER FOR THE PROMT TO WORK CORRECTLY JMS INITKF / INITALIZE THE TOKEN POINTER TO BEGINING OF BUFFER TAD PMTTMP / SEE IF IT IS A DOCUMENT MOD PROMPT (4) SPA / ++++ JMP PMTAN3 / IF NEGATIVE TREAT SPECIAL TAD (-4) SNA / ++++ JMP MDRTN TAD (2) / NOW CHECK FOR A SEND/RECEIVE PROMPT (2 AND 3) SPA / ++++ JMP PMTAN3 CIA TAD SENDFL / SEE IF ALREADY IN THE SAME MODE SNA CLA / ++++ JMP PMTERR / YES TAD SENDFL / IF POSITIVE THEN ALREADY IN THE STATUS DESIRED SO DO NOTHING SMA CLA / ++++ JMP MAINLW AC7776 / IF A SEND PACKET RECEIVED GO TO THE SEND ROUTINE TAD PMTTMP / AND RECEIVE FOR A SEND PACKET RECEIVED SNA CLA / ++++ JMP RECRTN JMP SENRTN PMTAN3, CLA / CLEAR BEFORE MENU CALL /A038 CIFMNU JMS I MNUCAL DLMAD5 CIFMNU JMS I IOACAL / DISPLAY THE other half of the PROMPT 0 / that the MN2 starts PMTMES / IOA string for printing buffers IFDEF ENGLSH < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" IFDEF ITALIAN < 2212 > IFDEF V30NOR < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" IFDEF V30SWE < 2212 > / cursor position to start at for "TYPE PASSWORD/ID" DOCNBF / buffer address 2700 / where to position cursor after PMTANW, CIFSYS / ++++ JWAIT JMS GTLINE / READ IN THE TEXT FOR THE PROMT ANSWER JMP PMTAN3 / RE-DISPLAY THE PROMPT /M022 JMP RTNSY / GM /D034 JMP PMTAN0 / CHECK OF # OF CHARS WITHIN LIMITS /A022 JMP PMTANW / CHAR OK OR NOTHING /A034 CLA / CLEAR THE FLAG BECAUSE IF SET WHEN THE PACKET IS DCA PMTTMP / TRANSFERRED THEN INIFLG IS ACTIVATED. AC0001 / SEND THE NORMAL RESPONSE TO THE PROMPT JMP SNDPP2 / THIS ROUTINE CHECKS TO MAKE SURE THAT THE USER PUTS IN / 64 CHARACTERS OR LESS WHEN ENTERING AN ID OR PASSWORD. / THE REASON BEING, IS THAT THE BUFFERS FOR ID/PASS ARE / ONLY 64 LOC LONG /PMTAN0, TAD GTBFPT / POINTER TO INPUT BUFFER /A022 / TAD (-INBUFA-101) / REACHED MAX INPUT? /A022 / SZA CLA / SKIP IF: MAX INPUT REACHED /A022 / JMP PMTANW / WITHIN LIMIT, WAIT FOR MORE /A022 / JMS GTLERD / Display appropriate error msg. /M027 / JMP PMTAN3 / Re-display prompt. /M027 PMTERR, AC7777 / ++++ DCA CNGSCF / SET FLAG SO THE ENTIRE SCREEN IS CHANGED TAD (10) / ++++ DCA ERRFLG JMP MAINLW PMTTMP, 0 / / THE ROUTINE WILL WAIT FOR A YES OR NO SENT FROM THE HOST / IN RESPONSE OF A INITALIZE MESSAGE / WTFRYN, XX CLA WTFRLP, TAD DLY6X / SET THE TIME LIMIT /M020 JMS WAITDT / WAIT FOR 30 SECONDS FOR A RESPONSE JMP TIMEOU / TIMED OUT DCA WTFRT2 TAD HSTRAD / RELEASE IT JMS PUTBUF / ++++ FREEPT TAD WTFRT2 / GET THE CHAR BACK TAD (-TYPNO) / CHECK FOR NO SNA / ++++ JMP CKCSN / NO FOUND NOW VALIDATE TAD (TYPNO-TYPYES) SNA CLA / ++++ JMP CKCSY / CHECK FOR A REAL YES JMP WTFRLP / WAIT AGAIN CKCSY, ISZ WTFRYN CKCSN, JMP I WTFRYN WTFRTP, 0 WTFRT2, 0 / / FILLS THE BUFFER WITH THE CHARACTERS TYPED IN FROM THE / MESSAGE TYPED IN AFTER THE COMMAND OR THE ENTIRE INPUT BUFFER IF A PROMPT / MSGFIL, XX AC7777 / WANT THE SCREEN COMPLETELY DISPLAYED DCA CNGSCF TAD TOKOFF DCA MSGAG1 AC0001 / GET THE STARTING ADDRESS OF THE BUFFER FOR THE PACKET TAD X3 DCA MSGAG2 JMS DXCOPY / GET THE TEXT PART OF THE PACKET CDFMYF MSGAG1, XX CDFMYF MSGAG2, XX MSGFL3, DCA INBUFA / CLEAR THE INPUT BUFFER JMP I MSGFIL CKDISF, XX / /A039 TAD DISTMP / CK FLAG BEFORE CALL /A039 SZA CLA / /A039 JMP MAINLW / HOST IS ACTIVE - RET AND WAIT /A039 TAD CNGSCF / PICK UP VALUE /A039 JMS DISSCR / CALL DISPLAY ROUTINE /A039 JMP I CKDISF / RETURN /A039 /------------ PAGE / / DISSCR - CLEARS THE RESETC FLAG AND CALLS THE CORRECT DISPLAY ROUTINE / DISSCR, XX DCA DISTMP DCA CNGSCF TAD DISTMP SMA SZA / ++++ JMS RESTS SZA CLA / ++++ JMS RESETS DCA DISTMP / CLEAR FLAG FOR HOST PROGRAM JMP I DISSCR / / French needed one location on this page. It appears that / INITKF is not called while DISTMP is in use so for french the / return address location of INITKF is used for temporary storage / IFNDEF FRENCH < DISTMP, 0 > IFDEF FRENCH < DISTMP=INITKF > / / THIS IS RESTS - WHICH HANDLES MOEST OF THE SEPERATE LINES ON THE SCREEN / THAT ARE CHANGED THE MOST / RESTS, XX AC0002 / DONT DISPLAY IF NOT CONNECTED YET TAD SENDFL SNA CLA / ++++ JMP RESTA / CIFMNU JMS I IOACAL / THE NUMBER OF TRANSMIT ERRORS 0 NUMDIS IFDEF ENGLSH < 1060 > IFDEF ITALIAN < 1076 > IFDEF DUTCH < 1065 > IFDEF V30NOR < 1060 > IFDEF V30SWE < 1060 > TRNERC / RESTA, TAD LN2FG / CHECK FOR THE SECOND LINE FLAG SNA / ++++ JMP RESTC TAD (5) DCA LN2F2 CIFMNU JMS I IOACAL 0 OUTLN 205 LN2F2, XX / TAD LN2FG / RELEASE THE BUFFER JMS PUTBUF / ++++ FREEPT DCA LN2FG / CLEAR FLAG RESTC, TAD INIFLG / DISPLAY IF TRANSFER IN PROGRESS SZA SMA CLA / ++++ JMP RESTC2 AC0003 / ++++ TAD SENDFL / IF IN TRANSFER COMPLETE MODE STILL DISPLAY NO. SNA CLA RESTC2, JMS BLKNMD / UPDATE THE BLOCK COUNT ON THE SCREEN / TAD INMSFG / CHECK FOR A MESSAGE FOR THE SCREEN SNA CLA / ++++ JMP RESTI / NO DCA INMSFG / CLEAR THE MESSAGE FLAG / CIFMNU JMS I IOACAL 0 MESSTM / YES , PUT IT UP 505 INMBLK / RESTI, TAD BYSETF / SEE IF A BYE MESSAGE WAS RECEIVED SNA CLA / ++++ JMP RESTM DCA BYSETF / CLEAR THE BYE MESSAGE FLAG / CIFMNU JMS I IOACAL 0 BYESTM 505 INMBLK / RESTM, TAD MGWTFG / SEE IF A MESSAGE HAS BEEN SENT SNA CLA / ++++ JMP RESTN DCA MGWTFG / CLEAR THE FLAG SO IT IS ONLY SHOWN ONCE / CIFMNU JMS I IOACAL / Print " - Recieved" 0 / default output routine OKSTMT / string address IFDEF ENGLSH < 621 / cursor position for "sent - received" > IFDEF ITALIAN < 626 > / cursor position for "inviato - ricevuto" IFDEF V30NOR < 626 > / cursor position for "inviato - ricevuto" IFDEF V30SWE < 626 > / cursor position for "inviato - ricevuto" RESTN, TAD MESSNF / IF SET PUT UP THE MESSAGE FOR A MESSAGE BEING SENT SNA CLA / ++++ JMP RESTO DCA MESSNF / CIFMNU JMS I IOACAL / Print "Message sent" 0 / Default output routine MSGPRG / string address 605 / cursor position / RESTO, TAD ERRFL2 / IF THE ERROR FLAG IS SET THEN DISPLAY IT SNA / ++++ JMP RESTP / /C031 CDFMNU / Map menu field. /A037 TAD (-11) / see if 'other user returned to Main' /A037 SNA CLA / Skip if no. /A037 TAD I (MUBUF+MNTMP6) / Are we in EZLINK (i.e. from CX)? /A037 CDFMYF / Back to my field. /A037 SZA CLA / Jmp if time to return to CX. /A037 JMP RTNSY / Return to CX. /A037 TAD ERRFL2 / Get error code. /A037 CDFMNU DCA I (MUBUF+MNTMP1) / SET THE ERROR CDFMYF CIFMNU JMS I MNUCAL DLMA12 RESTP, TAD PRBSFG / CK FOR TEXT IN "NO" PACKET /A031 SNA CLA / SKIP IF PRESENT /A031 JMP RESTQ / NO - CONTINUE /A031 DCA PRBSFG / RESET FLAG /A031 CIFMNU / MENU /A031 JMS I IOACAL / UP ON SCREEN /A031 0 / /A031 PRBSTM / TEXT "PROBLEM:" /A031 0405 / SCREEN ADDRESS /A031 INMBLK / ADDRESS OF TEXT /A031 RESTQ, / /JMS DISBL / RESET THE BOTTOM LINE /D017 JMS DISBLF / RESET THE BOTTOM LINE AND CLEAR EVENT FLAG/A017 / JMP I RESTS /------------ PAGE / / RESETS WILL RESET THE VALUES ON THE SCREEN THAT ARE PRESENT / MOST OF THE TIME / RESETS, XX CLA / THIS WILL UPDATE THE SCREEN WITH THE INFO NEEDED TAD ERRFLG / ++++ DCA ERRFL2 / SET THE FLAG THAT IS USED TO DISPLAY AN ERROR TAD ERRFLG / SEE IF THE OPTIONS WILL CHANGE SPA / ++++ JMP RESETW SZA CLA / ++++ JMS STPTRN JMP RESETA / STOP ANY TRANSFER AND RESET THE OPTIONS RESETW, CIA / FIRST MAKE POSITIVE DCA ERRFL2 DCA INIFLG / CLEAR THE INIT FLAG TAD AXFLG / IF AX DISPLAY THE MESSAGE BUT DONT CHANGE OPTIONS SNA CLA / ++++ DCA OPTFLG / CLEAR THE OPTIONS RESETA, TAD INIFLG SPA SNA CLA / ++++ JMP CHKST3 TAD (7) JMP CHKST4 CHKST3, TAD (5) TAD SENDFL CHKST4, CDFMNU DCA I (MUBUF+MNTMP1) / SET TEMP 1 TO STATE CDFMYF TAD OPTFLG / SET OPTIONS INTO TEMP 2 TAD (OPTTBL) / GET THE POSITION FOR THE OPTION LINE ON SCREEN DCA T1 TAD I T1 CDFMNU DCA I (MUBUF+MNTMP2) TAD DOCSIZ / LET THE MENU DISPLAY THE APROXIMATE VALUE DCA I (MUBUF+MNTMP3) TAD DOCTMP / GIVE IT THE VALUE TO DISPLAY DCA I (MUBUF+MNTMP4) TAD DOCNCT / DISPLAY THE NUMBER OF DOCUMENTS TRANSFERRED IN AX DCA I (MUBUF+MNTMP5) CDFMYF CIFMNU JMS I MNUCAL DLMA10 RESETY, JMS RESTS / PUT UP THE MESSAGES THAT ARE SPECIAL JMP I RESETS / GO TO WHERE IT WAS CALLED FROM / The following 2 variables (DOCSIZ, DOCTMP) MUST BE ON THIS PAGE DOCSIZ, 0 DOCTMP, 0 ERRFL2, 0 / OPTTBL, 0 2100 1700 1500 1300 / / WTMARG - WAIT FOR AN AGRUMENT TO BE TYPED FOR THE MESSAGE ROUTINE TO SEND IT. / WTMARG, XX CDFMNU / Map menu field. DCA I (MUBUF+MNTMP4) / save switch. set to 0 for MESSAGE/BYE / Set to 1 for "has no meaning" error msg. CDFMYF / Back to our field. JMS DOMENU / Display the menu prompting for a MESSAGE. DLMA14 / ... JMP KBDL5 / GOLD MENU JMP I WTMARG / GOT SOMETHING THAT IT LIKES / / THE TIME OUT ROUTINE / TIMEOU, AC0002 / Set error flag to -2. / / THIS IS THE ERROR RECOVERY IF THERE IS AN ERROR ENCOUNTERED IN / READ DOCUMENT ROUTINE / DSKERR, TAD (-4) / Set error flag to -4 for disk error. DCA ERRFLG / Set to -2 for TIME-OUT, -4 for DISK ERROR. / / TELLS THE MAIN PROGRAM TO DISPLAY THE SCREEN AND ALSO THAT THE STATUS IS / NOW ERROR FOUND AND WAITING / HSTRST, TAD (-4) DCA SENDFL AC7777 / ++++ DCA CNGSCF / RESET THE ENTIRE SCREEN JMP HSTJWT SNDPPK, MQL TAD (DOCNBF) / SET THE INPUT COMING FROM THIS BUFFER INSTEAD DCA TOKOFF / THE USUAL INPUT BUFFER INBUFA MQA SNDPP2, TAD (PMTTBL-1) DCA T1 TAD I T1 JMP MSGSET PMTTBL, TYPPAN TYPRCV TYPSND / / HLTEST - USED TO CHECK THE HALT FLAG TO BE SET DOES A NON-SKIP RETURN IF NOT / HLTEST, XX / TAKES NON-SKIP RETURN IF HALT FLAG SET CLA CIFSYS / ++++ JWAIT CDFSYS / ++++ TAD I HLTFLG / ++++ CDFMYF SNA CLA / ++++ ISZ HLTEST JMP I HLTEST / / GETNXT - GETS THE NEXT PACKET TO SEND IN A RETRANSMIT / GETNXT, XX TAD I GTNXPT SNA / ++++ JMP GETNXD ISZ GTNXPT ISZ GETNXT GETNXD, JMP I GETNXT GTNXPT, 0 CPYTIM, XX / Routine to copy the DATE & TIME string CDFMNU / Get address of DATE&TIME string in menu field. TAD I (DATESP) / ... CDFMYF / Back to our field. DCA CPYTM1 / Save for DXCOPY. JMS DXCOPY / Copy ASCIZ string CDFMNU / from menu field CPYTM1, XX / from here, CDFMYF / to our field DATSTR / to here. JMP I CPYTIM / Return to caller when done. /---------- PAGE / / THE HOST PROGRAM , THIS WILL HANDLE THE DATA FLOW FROM THE / HOST TO THE BUFFER AND FROM THE BUFFER TO THE HOST / HSFLAG, 0 / HSTPRG USES IT TO TELL THE MAINJOB THAT IT / RECEIVED THE SPFLAG CHANGE HSTEXT, CIFSYS / ++++ JEXIT HSTJWT, JMS CLAINF / WAIT BUT FIRST CLEAR THE INTFLG WHICH / LETS THE OTHER PROGRAM SEE WHAT HAS CHANGED / AND RETURNS BACK HSTWAT, CIFSYS / ++++ JWAIT HSTPRG, CLA TAD SPFLAG / SEE IF ANYTHING IS TO BE DONE / IF SPFLAG IS NOT ZERO DO NOTHING DCA HSFLAG / SET THE HOST FLAG TO THE SPFLAG / TO SHOW THE MAIN PROGRAM THATWE SAW IT TAD HSFLAG SPA / ++++ JMP HSTEXT SZA CLA / ++++ JMP HSTWAT / IF NOT ZERO THEN WAIT TAD INIFL2 / SEE IF THE LOW LEVEL HAS INITED SPA SNA CLA / ++++ JMP HSTWAT / NO TAD INIFL3 / NOW SEE OF THE HIGH LEVEL HAS SNA CLA / ++++ JMP RSTPRG TAD INIFLG / IF TRANSFER NOT IN PROGRESS SEE IF ANY TO REC SPA / ++++ JMP HSTPR2 SNA CLA / ++++ JMP HSTCKL TAD SENDFL / CHECK MODE SMA SZA / ++++ JMP SENDMD / IN SEND MODE SZA HSTCKL, AC0001 / IN SOME SORT OF A WAIT STATE SNA / ++++ TAD DLY6X / IN RECEIVE /M020 HSTRC2, JMS WAITDT / WAIT FOR SOMETHING TO BE SENT JMP CWTAGN HOSREC, TAD (HSTTBL-140) / USE THE TYPE FOR AN INDEX DCA T1 / TO GET THE ROUTINE TO JUMP TO TAD I T1 DCA T1 JMP I T1 HOSRBF, TAD HSTRAD / RELEASE THE PACKET BUFFER ITS NOT NEEDED JMS PUTBUF / ++++ FREEPT JMP HSTPRG HSTPR2, CLA TAD SENDFL / IF SEND MODE AND INIFLG IS NEGATIVE SEND FIRST PACKET SNA SPA CLA / ++++ JMP HSTPR3 JMS SETUPW / SET UP THE FIRST PACKET OF THE DOCUMENT AC7777 / TELL NORTN TO USE CANNED MESSAGE /A031 DCA NOFLAG / "NOT ENOUGH ROOM ON DISKETTE" /A031 JMS WTFRYN / WAIT FOR A RESPONSE JMP NORTN / RECEIVED THE "NO" PACKET /A031 /D031 JMP SNDNO2 / NO JMP SNDYE2 HSTPR3, AC0001 / ++++ DCA INIFLG JMP HSTJWT / / THIS HANDLES THE NO PACKET IT IS JUST LIKE A NORMAL MESSAGE ONLY A / FEW DIFFERENCES THAT IS WHY IT IS HERE THE CODE FALLS TO THE MESSAGE ROTUINE / NORTN, JMS CLDOC / CLOSE THE DOCUMENT / AC7777 / ++++ DCA CNGSCF / SET SCREEN FLAG TO CHANGE EVERYTHING DCA INIFLG / CLEAR THE INIT FLAG TO DKILL A TRNAFER IS STARTRD / TAD OPTREC / RESET THE OPTIONS DCA OPTFLG / / CK FOR TEXT IN THE "NO" PACKET AND DISPLAY / IF PRESENT /A031 JMS FILMBF / FILL MESSAGE BUFFER /A031 TAD INMBLK / LOOK FOR A CHARACTER /A031 SZA / SKIP IF EMPTY /A031 JMP PROBMS / A MESSAGE IS PRESENT - DISPLAY /A031 AC0001 / CK FOR SPECIAL CASES OF "NO" PACKET /A031 TAD NOFLAG / a) RESPONSE TO "SENT" PACKET /A031 SNA / b) RESPONSE TO "SOD" PACKET /A031 JMP SNDNO2 / DISKETTE FULL MESSAGE /A031 SPA / /A031 JMP RECNO1 / UNABLE TO CREATE MESSAGE /A031 JMP MESRTN / CONTINUE TO MESSAGE ROUTINE /A031 / TEXT IN THE "NO" PACKET /A031 PROBMS, DCA PRBSFG / SIGNAL - TEXT IN THE "NO" PACKET /A031 JMP HSTJWT / / HSTTBL- THE TABLE OF THE ROUTINES THAT ARE CALLED DEPENDING ON THE / PACKET TYPE. THE VALUE OF THE PACKET TYPE BYTE IS USED AS AN INDEX TO THE TABLE / RESERV=HOSRBF / IF NOT WANTED OR UNDEFINED HSTTBL, YESRTN / 140 - TYPYES MODRTN / 141 - TYPMOD MESRTN / 142 - TYPMES BYERTN / 143 - TYPBYE SODRTN / 144 - TYPSOD DTARTN / 145 - TYPDTA EOFRTN / 146 - TYPEOF HITRTN / 147 - TYPHIT RESERV / 150 SNDRTN / 151 - TYPSND RCVRTN / 152 - TYPRCV OPTRTN / 153 - TYPOPT RESERV / 154 RESERV / 155 RESERV / 156 RESERV / 157 RESERV / 160 RESERV / 161 RESERV / 162 RESERV / 163 NORTN / 164 - TYPNO RESERV / 165 RESERV / 166 RESERV / 167 RESERV / 170 RESERV / 171 RESERV / 172 RESERV / 173 RESERV / 174 PMTRTN / 175 - TYPPMT PNERTN / 176 - TYPPNE /----------- PAGE / / CHKSM1 - DOES A TOTALING JOB FOR CHKSUM / CHKSM1, XX DCA T1 DCA T2 / CLEAR THE TOTALER CHKSUJ, TAD I T1 SNA / ++++ JMP I CHKSM1 / 0= DONE TAD T2 DCA T2 ISZ T1 JMP CHKSUJ / / SENDMD - ROUTINE THAT WILL TAKE CARE OF SENDING A TEXT PACKET / SENDMD, JMS GETBUF / ++++ RECPT / SEE IF THE BUFFER IS EMPTY JMP SENDCB / YES JMS STOBUF / STORE THE VALUES JMP HOSREC SENDCR, TAD EOF / SEE IF THE LAST PACKET HAS BEEN QUEUED SNA CLA / ++++ JMP SENDCT TAD DSKBA2 / CHECK FOR EVERYTHING SENT TAD DSKBA4 SZA CLA / ++++ JMP HSTWAT / IF NOT WAIT JMP DSKTL2 / IF SO THEN QUIT SENDCT, TAD (-BUFSIZ) / SET THE CHARACTER COUNTER DCA SENTMP JMS DSKBUF / SEE IF THERE IS AN AVAILABLE BUFFER JMP HSTWAT / NO DCA SENT2 TAD SENT2 / STORE IN X1 DCA X1 DCA I X1 / CLEAR THE STATUS WORD AC0003 TAD X1 / SET UP FOR THE INSERT CHARACTERS DCA SENT3 AC7777 TAD SENT3 / SAVE THE ADDRESS OF THE FLAG CHARACTER DCA SENT4 SENDJ1, TAD INIFLG / IF DOCUMENT ABORTED STOP SENDING SNA CLA / ++++ JMP HSTPRG CIFBUF / ++++ JMS I REDSXA / GET NEXT 7-BIT CHARACTER SPA SNA / Skip if valid char returned. JMP ENDDOC / ... DCA I SENT3 ISZ SENT3 / UPDATE THE COUNTER ISZ SENTMP / INCREMENT THE CHARACTER COUNTER JMP SENDJ1 DCA I SENT3 TAD (TYPDTA) JMP SENDJ3 / CONTINUE ENDDOC, SZA CLA / Skip if END-OF-FILE detected. JMP DSKERR / Report DISK ERROR. DCA I SENT3 ISZ EOF / SET LAST PACKET FLAG TAD (TYPEOF) SENDJ3, DCA I SENT4 TAD SENT2 JMS PUTBUF / ++++ SENDPT JMP HSTPRG / / SNDNAK - SENDS A NAK TO THE OTHER SYSTEM / SNDNAK, TAD DXNONK / SEE IF A NAK CAN BE SENT SZA CLA / ++++ JMP DXIHJB JMS UPDTER / UPDATE THE ERROR COUNTER TAD (NAK) ISZ DXNONK / SET FLAG SO CANNOT SEND ANOTHER NAK / THIS WILL SEND THE CONTENTS IN THE AC AS A COMMAND /A017 DXIBDY, DCA CMDFLG /A017 JMS CLAINF / CLEAR THE EVENT FLAG /A017 JMP DXIHJB / DONE CONTINUE /A017 / / DXOCPK - CREATE THE COMMAND PACKET TO SEND / DXOCPK, XX DCA CMDBUF / PUT THE TYPE ON THE PACKET DCA CMDFLG / CLEAR THE FLAG TAD (CMDBUF) / SET THE BUFFER ADDRESS TO FILL DCA X1 TAD ISEQNO / PUT THE SEQUENCE NUMBER IN AND P77 JMS ADOFST DCA I X1 / / IF THE PACKET IS AN INIT OR INIT-ACK THEN THE BODY OF THE PACKET IS / / TYPE VERSION NULCNT / / TYPE TELLS THE TYPE OF PROTOCOL. THIS IS FOR FUTURE USE. RIGHT / NOW IT IS ALWAYS 40. COULD BE USED TO TELL THE HOST THE / DIFFERENCE BETWEEN A WS78 AND A WT78 ON THE SAME LINE. / / VERSION IS THE VERSION OF THE PROTOCOL SO THE TWO SYSTEMS ARE / ABLE TO ALLOW FOR THE DIFFERENCES OR JUST TELL THE USER THAT / THEY CANNOT EVER CONNECT BECAUSE OF THE DIFFERENT VERSIONS. / / NULCNT IS THE NUMBER OF NULLS THE OTHER SYSTEM WANTS SENT TO IT / AFTER THE CR THAT TERMINATES ALL PACKETS. THE FORMAT IS 40 OCTAL / PLUS THE NUMBER DESIRED. / TAD CMDBUF / SEE IF THE COMMAND IS A INIT OF SOME KIND TAD (-INIT) / IF SO SEND THE TYPE AND VERSION OF THE PROTOCOL SZA / ++++ TAD (INIT-INIACK) / ELSE JUST ADD THE ZERO TERMINATOR SZA CLA / ++++ JMP DXOSTR TAD (TYPE) DCA I X1 TAD (VERSIO) DCA I X1 TAD (ZERNUL) / THIS SOFTWARE DOESNT REALLY NEED NULLS DCA I X1 DXOSTR, DCA I X1 TAD (CMDBUF) / SET THE CHECK SUM JMS CHKSUM JMP I DXOCPK TRNCN6, AC7777 / SET FLAG TO LOCK OUT HOST JOB /A039 DCA DISTMP / /A039 JMP TRNCN7 / CONTINUE /A039 /---------- PAGE / / DSKBUF - GETS THE NEXT BUFFER FREE FOR TEXT / IF NONE ARE FREE IT GET TWO / DSKBUF, XX CLA TAD RESBFS / SEE IF 2 HAVE BEEN ALOCATED SZA CLA / ++++ JMP DSKBU2 JMS GETFRE / GET A FREE BUFFER JMP HSTWAT / ERROR RETURN SPFLAG SET DCA DSKBA1 DCA DSKBA2 / CLEAR THE WRITE FLAG JMS GETFRE JMP HSTWAT / ERROR RETURN SPFLAG SET DCA DSKBA3 / STORE ADDRESS DCA DSKBA4 / CLEAR THE FULL FLAG ISZ RESBFS DSKBU2, TAD DSKBA2 SZA CLA / ++++ JMP DSKBU3 / NOT BEING SENT AC0001 / ++++ DCA DSKBA2 TAD DSKBA1 ISZ DSKBUF JMP I DSKBUF DSKBU3, TAD DSKBA4 SZA CLA / ++++ JMP I DSKBUF AC0001 / ++++ DCA DSKBA4 ISZ DSKBUF TAD DSKBA3 JMP I DSKBUF RESBFS, 0 / / ORDER DEPENDENT / DSKBA1, 0 DSKBA2, 0 DSKBA3, 0 DSKBA4, 0 / / GETFRE - GET A FREE BUFFER / WILL WAIT CHECKING FOR SPFLAG SET AND RETURN IF SO. / ON ENTRY THE AC VALUE DOESNT MATTER ON RETURN IT IS THE ADDRESS OF / THE BUFFER. / / CALL / JMS GETFRE / ERROR RETURN / OK / GETFRE, XX JMP GETFR1 / JUMP TO TRY TO GET A BUFFER GETFR2, JMS INIWAT / CHECK SPFLAG JMP I GETFRE / ITS SET RETURN GETFR1, JMS GETBUF / ++++ FREEPT JMP GETFR2 ISZ GETFRE / GOT A BUFFER RETURN JMP I GETFRE / / SENDCB - FREES THE PACKETS THAT ARE SENT CORRECTLY AND ARE DATA / SENDCB, TAD DSKBA2 / SEE IF THE FIRST IS TO SEND SNA CLA / ++++ JMP SENDC2 TAD DSKBA1 IAC DCA T1 / SEE IFTHE BUFFER IS BEING SENT TAD I T1 SPA / ++++ JMP TIMEOU / SEE IF -1 THEN COULDNT SEND SNA CLA / ++++ JMP SENDC2 DCA DSKBA2 JMS BLKNM / UPDATE THE PACKET COUNTER SENDC2, TAD DSKBA4 SNA CLA / ++++ JMP SENDCR TAD DSKBA3 / SEE IF THE OTHER IS FULL IAC DCA T1 TAD I T1 SPA / ++++ JMP TIMEOU SNA CLA / ++++ JMP SENDCR DCA DSKBA4 JMS BLKNM / UPDATE THE PACKET COUNTER JMP SENDCR / / DTARTN - WILL RECEIVE A PACKET OF TEXT / EOFRTN, ISZ EOF / THE ONLY DIFFERENCE BETWEEN ANY OF THE TEXT AND THE LAST / IS SETTING THE LAST PACKET FLAG DTARTN, AC0003 / GET THE STARTING ADDRESS TAD HSTRAD DCA DTARTM / SAVE IN TEMP JMS BLKNM / INCREMENT THE BLOCK COUNT CLA DXRCLP, /D040 TAD INIFLG / CALLED FROM DTARTN WHICH RECEIVES A DOCUMENT /D040 SNA CLA / ++++ /D040 JMP HOSRBF / IF TRANSFER TERMINATED THEN THROW AWAY PACKET ISZ DTARTM TAD I DTARTM / STORE THE CHARACTER FIRST GET IT SNA / ++++ JMP DTARTJ / RELEASE THE BUFFER CIFBUF / ++++ JMS I WRISXA / WRITE CHARACTER JMP DXRCLP DTARTJ, TAD HSTRAD / RELEASE THE BUFFER JMS PUTBUF / ++++ FREEPT JMP DSKTLB / SEE IF IT IS THE LAST / / BYERTN HANDLES THE BYE MESSAGE THAT CAN BE SENT FROM THE OTHER / SYSTEM TO TERMINATE THE TRANSFER.IT ACTS LIKE A TIME OUT / BYERTN, JMS FILMBF / FILL THE MESSAGE BUFFER WITH THE TEXT SENT AC7777 / ++++ DCA CNGSCF AC0001 / ++++ DCA BYSETF / SET THE STOP EVERYTHING FLAG JMS STPTRN / STOP ANY TRANSFER AND RESET OPTIONS JMP HSTJWT / SIMILAR TO A JWAIT INSTEAD OF A WAIT / / STPRTN - STOP A TRANSFER IF ANY AND SET THE OPTIONS BACK TO THOSE RECEIVED / STPTRN, XX CLA JMS SETOPT /A017 TAD INIFLG / IF TRANSFER IN PROGRESS PUT INTO ABORT STATE SNA CLA / ++++ JMP I STPTRN TAD (-5) / ++++ DCA SENDFL DCA INIFLG JMP I STPTRN SETOPT, XX /A017 TAD OPTREC /A017 DCA OPTFLG /A017 JMP I SETOPT /A017 OPTREC, 0000 / /M023 SNDQT1, AC7777 / CLEAR OUTPUT BUFFER /A041 JMS HOSTOU / /A041 CLA / BUFFER FULL RETURN /A041 AC0003 / GET READY FOR TEST /A041 JMP SNDQT2 / CONTINUE /A041 /----------- PAGE / / OPTRTN - HANDLES THE OPTION PACKET THAT IS SENT FROM THE OTHER SYSTEM / GIVING THE SYSTEM ITS OPTIONS / OPTRTN, TAD AXFLG / IF IN AX DONT LET THE OPTIONS CHANGE SZA CLA / ++++ JMP HOSRBF AC0004 / GET THE ONE CHARACTER THAT WILL BE THE OPTION TAD HSTRAD DCA T1 TAD I T1 / TAD (-40) / SET THE INTERNAL FLAG DCA OPTREC / / TAD OPTREC /D017 / DCA OPTFLG /D017 JMS SETOPT /A017 / AC7777 / ++++ DCA CNGSCF / RESETTHE SCREEN JMS CLAINF JMP HOSRBF / RELEASE THE BUFFER / / THIS HANDLES THE INCOMING MESSAGES FOR BOTH THE SENDER AND THE / / THE RECEIVER / MESRTN, JMS FILMBF / FILL THE INPUT MESSAGE BUFFER WITH THE / MESSAGE SENT . NO FLAGS ARE SET BECAUSE / NOTHING AT THIS POINT SHOULD BE GOING ON / THAT WOULD AFFECT THE ACTION / AC0001 / ++++ DCA INMSFG / SET THE MESSAGE FLAG SO WHEN / THE SRCEEN IS UPDATED THE MESSAGE WILL / APPEAR TAD CNGSCF / SET THE FLAG TO DISPLAY THE SCREEN MESSAGE SNA CLA / ++++ ISZ CNGSCF / IF NOT ALREADY SET / JMP HSTJWT / INMSFG, 0 RCVRTN, TAD AXFLG / IS IN AX THEN HAVE TO TREAT SPECIAL SZA CLA / ++++ JMP AXRRTN TAD SENDFL / IF SET TO NOT WAIT THEN JUST INIT DONT SET PROMPT SMA CLA / ++++ JMP PMTOK JMP PMT002 SNDRTN, TAD AXFLG SZA CLA / ++++ JMP AXSRTN TAD SENDFL / IF SET DONT SET FOR PROMPT SMA CLA / ++++ JMP PMTOK JMP PMT003 PNERTN, TAD (-5) / Set PMTFLG to -1 for PROMPT NO ECHO. /M028 MODRTN, IAC / Set PMTFLG to 4 for MODIFY prompt. PMT003, IAC / Set PMTFLG to 3 for SEND. PMT002, IAC / Set PMTFLG to 2 for RECEIVE. PMTRTN, IAC / set PMTFLG to 1 for PROMPT. PMTRT2, DCA PMTFLG JMS FIL2BF / FILL THE BUFFER PMTRT3, JMP HSTJWT / CLEAR THE EVENT FLAG AND WAIT THIS ALOWS QUICK RESPONSE PMTOK, AC7777 / ++++ DCA INIFLG / SAY START SENDING DOCUMENT JMP HOSRBF / RELEASE THE BUFFER PMTFLG, 0 / / FIL2BF - FILLS THE SECOND MESSAGE BUFFER / FIL2BF, XX TAD (DOCNBF) JMS FILIBF JMP I FIL2BF / / FILLS THE MESSAGE BUFFER WHOSE ADDRESS IS IN THE AC / FILIBF, XX DCA FILIB2 / STORE THE ADDRESS TO COPY INTO AC0004 / GET THE STARTING ADDRESS OF THE STRING TO COPY TAD HSTRAD DCA FILIB1 JMS DXCOPY CDFMYF FILIB1, XX CDFMYF FILIB2, XX TAD HSTRAD JMS PUTBUF / ++++ FREEPT / FREE IT JMP I FILIBF / / THE ROUTINES USED FOR THE COPY TO GET THE HOST SPECIFIED / / OUTPUT / HOSTOU, XX DCA HOSTOT / ++++ TAD HOSTOT / SAVE THE CARACTER FOR HOSTO2 CIFSYS / ++++ HS2OU JMP I HOSTOU ISZ HOSTOU JMS HOSTO2 / CHECK FOR A CR AND IF SO SEND NULLS (PAD) JMP I HOSTOU HOSTOT, 0 / / THE INPUT ROUTINE / HOSTIN, XX HOSTIL, CIFSYS / ++++ HS2IN JMP I HOSTIN AND P177 / GET THE 7 -BITS SNA / ++++ JMP HOSTIL / SKIP A NULL TAD (-RUBOUT) / NOT ALLOW A RUBOUT SNA / ++++ JMP HOSTIL TAD (RUBOUT-40) / CHECK FOR A CONTROL CHARACTER SMA / ++++ JMP HOSTI2 / IF A CONTROL CHARACTER THEN CHECK FOR A CR TAD (40-CR) SZA / ++++ JMP HOSTIL / SKIP ALL BUT A CR TAD (CR-40) HOSTI2, TAD (40) / RETURN THE CHARACTER FOUND ISZ HOSTIN JMP I HOSTIN / / CLAINF - CLEAR THE EVENT FLAG IN THE SYSTEM. BY CLEARING THE FLAG / YOU TELL THE SYSTEM AN EVENT HAS HAPPENED. / CLAINF, XX CLA CDFSYS / ++++ DCA I (INTFLG) / ++++ CDFMYF JMP I CLAINF / / THIS ROUTINE IS USED THROUGHOUT THE MAIN JOB. THE ROUTINE IS / USED TO SET THE TOKEN POINTER THAT IS THE POINTER TO THE INPUT BUFFER / TO THE BEGINNING / INITKF, XX CLA TAD (INBUFA) / INITALIZE THE POINTER DCA TOKOFF JMP I INITKF /------------ PAGE / / DISBER - DISPLAYS THE ERROR MESSAGE THAT THE INPUT WAS BAD / DISBER, XX TAD (TOKBUF+1) / Set token pointer to token buffer DCA TOKOFF / (where the bad input is stored). AC0001 / now call menu A14 to report the bad input. JMS WTMARG / ... JMP I DISBER / return to caller. / / SETFLG - SETS ALL THE FLAGS NEEDED FOR EACH TRANSFER AND ALSO CLEARS THE / MESSAGE LINE. THIS LINE IS CLEARED INCASE AN ERROR IS DISPLAYED / SETFLG, XX JMS SETFLT / CLEAR FLAGS DCA TRNERC / CLEAR THE ERROR COUNTER. /A015 JMS CLAMSL / CLEAR MESSAGE LINE JMP I SETFLG / / RECEIVES THE INITAL MESSAGE / SODRTN, TAD SENDFL / SEE IF A START OF DOCUMENT CAN BE ACCEPTED SZA CLA / ++++ JMP HOSRBF / JMS FILMBF / THIS WILL FILL THE INPUT MESSAGE BUFFER / AND CHECK THE CHECK SUMS FOR IT CLA DCA INMSFG / CLEAR THE MESSAGE FLAG SO THE CONTENTS WILL NOT / APPEAR ON THE SCREEN / TAD ISGBK1 / GET THE BLOCK COUNT JMS SBOFST BSW DCA T1 / SAVE THE FIRST HALF TAD ISGBK2 / GET SECOND HALF JMS SBOFST TAD T1 / ADD IT TI THE OTHER HALF DCA DOCSIZ / TAD DOCSIZ CIA / AVAILABLE / MQL / SEE IF OVERWRITE OPTION IF SO ADD THE DOC SIZE TAD DOCMOD / IF -1 = OVERWRITE CLL RAL CLA MQA SNL / ++++ JMP INIREJ / CDFBUF / SEE IF THERE IS ROOM ON THE DISKETTE FOR THE FILE TAD I (SCHDR+5) / SUBTRACT THE FILE SIZE BECAUSE OVERWRITE INIREJ, CDFFIO / /M013 TAD I (SCFSPC) / SUBTRACT THE AMOUNT LEFT ON THE DISK / CDFMYF / ACDF FOR THIS FIELD (MY FIELD) / TAD (-10) / MAKE SURE THAT I WILL NOT OVERFLOW / SPA SNA CLA / ++++ JMP SENNO / / THE YES ANSWER / TAD (TYPYES) / SEND A YES DCA ANSBUF TAD (ANSBUF-1) / JMS INIBFS JMP HSTPRG JMP TIMEOU / IF NEGATIVE RESTART / JMS STRPRT / STORE THE RULER SETTINGS SNDYE2, AC0001 / ++++ DCA INIFLG / SET THE FLAG SO THE INITAL MESSAGE WILL / SENT WHEN IT CAN IF IN SEND / JMS DISAPX / CALCULATE THE APPOXIMATE NO OF PACKETS SNDYE4, / CALLED BY AXRRTN AND AXSRTN AC7777 / ++++ DCA CNGSCF / REPAINT THE SCREEN SNDYE3, JMP HSTJWT / CLEAR THE EVENT FLAG SO PROGRAM IS RETURNED TO QUICKER / / THE YES ROUTINE USE FOR THE YES RESPONSE FROM AX ON A COMMAND PACKET / YESRTN, AC7777 / ++++ DCA INIFLG / START THE ITRANSFER OF A DOCUMENT PROCESS JMP SNDYE3 / / THE NO RESPONSE / SENNO, DCA INIFLG / CLEAR THE INIT FLAG TAD (TYPNO) DCA ANSBUF / TAD (ANSBUF-1) JMS INIBFS / SEND THE RESPONSE JMP HSTPRG / GOLD HALT JMP TIMEOU / IF NEGATIVE THEN RESTART / SNDNO2, AC0001 / ++++ DCA ERRFLG DCA INIFLG JMP SNDNO3 / CLOSE DOCUMENT FIRST /C031 ANSBUF, ZBLOCK 2 / / THIS WILL PUT THE ESTIMATE ON THE SCREEN / DISAPX, XX CLA TAD DOCSIZ / TO SEE IF THE NUMBER OF BLOCKS EXCEED 200 TAD (-201) SMA CLA / ++++ JMP DISJMP / IF SO JUMP TAD DOCSIZ / FIRST MULTIPLY BY 8 JMP DISAP2 DISJMP, DCA T1 / CLEAR THE COUNTER FOR THE DIVIDE BY 10 TAD DOCSIZ TAD (5) / ROUND BY ADDING 5 TO TOTAL BEFORE DEVIDING DISLUP, TAD (-12) / DEVIDE BY 10 ISZ T1 / INCREMENT THE COUNTER FOR EACH DEVIDE SMA / ++++ JMP DISLUP / NOTE :THIS PROCESS ROUNDS UP AC7777 / THIS WILL GET THE RIGHT NUMBER FOR THE DIVIDE TAD T1 / NOW MULTIPLY BY 8 DISAP2, CLL RAL / ++++ CLL RAL / ++++ CLL RAL DCA DOCTMP JMP I DISAPX / / THE UPDATING OF THE ERRORS ON THE SCREEN / UPDTER, XX ISZ TRNERC / INCREMENT THE COUNTER TAD CNGSCF / IF NOT SET SET IT SNA CLA / ++++ ISZ CNGSCF JMP I UPDTER TRNERC, 0 /---------- PAGE / / WAITING FOR SOMETHING TO BE SENT (RECEIVER) / WAITDT, XX DCA DLYLIM JMP WAITLP WAITWT, TAD DLYLIM / IF POSITIVE THEN RETURN DONT JWAIT SMA CLA / ++++ JMP I WAITDT CIFSYS / ++++ JWAIT JMS GETTM SNA CLA / ++++ JMP WAITLP ISZ DLYLIM JMP WAITLP JMP I WAITDT WAITLP, TAD SPFLAG / SEE IF THE JOB SHOULD STOP SZA CLA / ++++ JMP HSTWAT JMS GETBUF / ++++ RECPT JMP WAITWT JMS STOBUF / STORE THE ADDRESS IN HSTRAD ISZ WAITDT JMP I WAITDT DLYLIM, 0 / / STOBUF - WILL STORE THE ADDRESS OF THE RECEIVED BUFFER IN HSTRAD / STOBUF, XX DCA HSTRAD AC0003 TAD HSTRAD DCA T1 TAD I T1 JMP I STOBUF / / UPDATE THE BLOCK COUNTER AND SET THE DISPLAY FLAG / BLKNM, XX CLA ISZ BLKTMP / THIS IS THE BLOCK COUNTER FOR THE -1000 TO 0 RANGE JMP BLKN1 / IF THERE IS NO OVERFLOW THEN PROCEED / DECIMAL TAD (-1000) / SET THE COUNTER ON OVERFLOW OCTAL / DCA BLKTMP ISZ BLKOVR / INCREMENT THE THOUSAND COUNTER BLKN3, TAD BLKTMP / SET THE TEMP TO A DISPLAYABLE NUMBER FOR IOA / DECIMAL TAD (2000) / 1000 FOR POSITIVE AND 1000 FOR THE ZEROS OCTAL / JMP BLKN4 BLKN1, TAD BLKOVR / SEE IF THE BLOCK COUNTER IS OVER 1000 SZA CLA / ++++ JMP BLKN3 / IF SO GO TO BLKN3 / DECIMAL TAD (1000) / GET THE REAL NUMBER TO DISPLAY OCTAL / TAD BLKTMP BLKN4, DCA BLKNUM / TAD CNGSCF / SEE IF ALREADY SET IF NOT SET IT SNA CLA / ++++ ISZ CNGSCF / JMS CLAINF JMP I BLKNM / RETURN / BLKNUM, 0 BLKTMP, 0 BLKOVR, 0 / / UPDATE THE SCREEN FOR THE BLOCK COUNT / BLKNMD, XX CIFMNU JMS I IOACAL 0 NUMDIS IFDEF ENGLSH < 1260 > IFDEF ITALIAN < 1276 > IFDEF DUTCH < 1265 > / Keep messages from being clobbered by blk counts IFDEF V30NOR < 1260 > / cursor position for "inviato - ricevuto" IFDEF V30SWE < 1260 > / cursor position for "inviato - ricevuto" BLKNUM / TAD BLKOVR / SEE IF THE BLOCK COUNT IS OVER 1000 SNA CLA / ++++ JMP I BLKNMD / IF SO IOA WILL NOT HANDLE IT SO A NOTHER CALL / HAS TO BE MADE TO WRITE OUT THE 1000 DIGIT / CIFMNU JMS I IOACAL 0 BLKDS2 IFDEF ENGLSH < 1260 > IFDEF ITALIAN < 1276 > IFDEF DUTCH < 1265 > / Keep messages from being clobbered by blk counts IFDEF V30NOR < 1260 > IFDEF V30SWE < 1260 > BLKOVR / JMP I BLKNMD / / GET THE TIME CHANGE USING THE SYSTEMS CLOCK / IT RETURNS A 1 IF A SECOND WENT BY AND A 0 IF NO CHANGE / GETTM, XX JMS GETCLK / SEE IF THE TIME CHANGED TAD TMPTME / COMPARE TO SEE IF THE CLOCK CHANGED SNA / ++++ JMP I GETTM / NO CHANGE CIA / ++++ TAD TMPTME / IF CHANGE STORE THE NEW ONE DCA TMPTME AC0001 JMP I GETTM TMPTME, 0 / / THE TIME ROUTINE FOR THE LINE / GETTM2, XX JMS GETCLK TAD TMPTM2 / CHECK FOR A CHANGE IN THE TEMP SNA / ++++ JMP I GETTM2 CIA / ++++ TAD TMPTM2 / STORE THE DIFFERENT VALUE IF THERE IS ANY DCA TMPTM2 AC0001 JMP I GETTM2 TMPTM2, 0 GETCLK, XX CLA CDFSYS TAD I (CLOCK+2) / ++++ CIA CDFMYF / ACDF FOR THIS FIELD (MY FIELD) JMP I GETCLK SNDNO3, JMS CLDOC / CLOSE DOCUMENT /A031 JMP HSTRST / NOW RESTART /A031 / / KBOUT - OUTPUT A CHARACTER TO THE SCREEN / KBOUT, XX JMP KBOUL KBOUW, CIF 0 / ++++ JWAIT KBOUL, CLA TAD I KBOUT / Get character to output. AND P177 / Isolate the character bits. CIFSYS / ++++ TTYOU JMP KBOUW TAD I KBOUT / Get character just output. ISZ KBOUT / Bump to return/next character. SPA CLA / Skip if we're done. JMP KBOUL / Jmp if there's another one. JMP I KBOUT / Return to caller. /------------ PAGE CWTAGN, CLA TAD INIFLG / IF A TRANSFER IS IN PROGRESS SPA SNA CLA / ++++ JMP HSTWAT TAD SENDFL / AND IN RECEIVE MODE THEN AN ERROR SZA CLA / ++++ JMP HSTWAT JMP TIMEOU / / THIS CHECKS FOR END OF FILE ENCOUNTERED. IT BELONGS ON THE LAST / PAGE WITH DSKPRG BUT DOESNT FIT / DSKTLB, CLA TAD EOF / SEE IF LAST PACKET SNA CLA / ++++ JMP HSTPRG JMS CLDOC / CLOSE THE DOCUMENT IF ANY OPEN /M026 TAD AXFLG / SEE IF AX MODE SNA CLA / ++++ JMP DSKTL2 CIFBUF JMS I AXDONA DSKTL2, AC7775 / ++++ DCA SENDFL / SET TO DONE JMS SETOPT / Reset the options to what they were before. AC7777 / ++++ DCA CNGSCF / SET THE RESET SCREEN FLAG TAD AXFLG / IF IN AX MODE INCREMENT THE COUNTER FOR NUMBER / OF DOCUMENTS PROCESSED. SZA CLA / ++++ ISZ DOCNCT DCA INIFLG / CLEAR THE TRANSFER FLAG JMP HSTJWT / WAIT FOR RESTART / / DXOHJB - THE OUTPUT ROUTINE TO THE HOST / DXOHEX, /D041 JMS SNDQIT / BEFORE DYING SEND A QUIT TO TELL THE OTHER SIDE /D041 / WHATS GOING ON HAS NO EFFECT IF AX JMP SNDQT1 / SEND QUIT PACKET /A041 DXOSQR, / RETURNS HERE /A041 AC7777 / ++++ DCA DXOFLG / SET TO NEGATIVE A SIGN THAT EXITED CIFSYS / ++++ JEXIT DXOHWT, CIFSYS / ++++ JWAIT DXOHJB, CLA TAD SPFLAG / SEE IF IT IS TIME TO STOP SPA CLA / ++++ JMP DXOHEX TAD CMDFLG / SEE IF THERE IS A COMMAND TO OUTPUT SNA / ++++ JMP DXOHJ1 / JMS DXOCPK / SET UP THE COMMAND PACKET AC = 0 WHEN CALL DXOCPK / TAD (CMDBUF) JMS SNDPCK JMP DXOHTO / ERROR IN TRANSFER / TAD CMDBUF / SEE IF INIT ACK SENT IF SO SET FLAG TAD (-INIACK) SZA CLA / ++++ JMP DXOHJB AC0001 / ++++ DCA INIFL2 JMP DXOHJB DXOHJ1, TAD NAKFL2 TAD TOFL2 SNA CLA / ++++ JMP DXOHJ2 TAD PUTPRC SNA CLA / ++++ JMP DXOHJ4 / TAD (PTRHED) / SET THE POINTERS FOR THE RESENDING DCA GTNXPT / DXOHJ5, JMS GETNXT / GET THE NEXT PACKET TO SEND JMP DXOHJ4 / TAD (2) / GET THE ADDRES FOR THE DATA / JMS SNDPCK / SEND IT JMP DXOHTO JMP DXOHJ5 DXOHJ4, CLA DCA TOFL2 / CLEAR THE ERROR FLAGS DCA NAKFL2 DXOHJ2, TAD INIFL2 / SEE IF THE LINE HAS BEEN INITALIZED YET SNA CLA / ++++ JMP DXOHWT JMS GETBUF / ++++ SENDPT / SEE IF THERE IS A PACKET TO SENT JMP DXOHWT / NOTHING TO DO SO WAIT / JMS DXSNBF / SEND IT JMP DXOHTO / ERROR IN SENDING IT JMP DXOHJB DXOHTO, CLA TAD TOFL2 / SEE WHY SNA CLA / ++++ JMP DXOHT2 DXOHT3, AC7777 JMS HOSTOU / CLEAR THE BUFFERS NOP DXOHT2, TAD (RESET) / SEND A RESET CAHRACTER TO TERMINAT THE PACKET JMS SNDCHR JMP DXOHT3 TAD (CR) / TERMINATOR JMS SNDCHR JMP DXOHT3 / JMP DXOHJB DXOFLG, 0 TOTM2, 0 INIFL2, 0 TOFL2, 0 / / / DISBLF - DISPLAY THE BOTTOM LINE AND CLEAR EVENT FLAG INTFLG /A017 / DISBLF, XX /A017 JMS DISBL /A017 JMS CLAINF /A017 JMP I DISBLF /A017 PAGE / / DXSNBF - SEND THE PACKET AND PUT IT INTO THE SENT BUFFER / DXSNBF, XX DCA DXSNBA / SAVE THE STARTING ADDRESS AC0002 / GET THE START OF TEXT TAD DXSNBA DCA SEQPSN / ISZ OSEQNO / INCREMENT THE SEQ NUMBER CLA TAD OSEQNO / INSERT THE SEQ AND P77 JMS ADOFST DCA I SEQPSN / TAD SEQPSN JMS CHKSUM / TAD DXSNBA / PUT THE PACKET IN THE SEND LIST JMS PUTPTR / TAD SEQPSN JMS SNDPCK / SEND THE PACKET JMP I DXSNBF / ISZ DXSNBF JMP I DXSNBF DXSNBA, 0 SEQPSN, 0 OSEQNO, 0 / / ADOFST - ADDS THE OFFSET TO THE AC / ADOFST, XX SNA / ++++ TAD (100) / IF ZERO ADD 137 ELSE ADD 37 TAD (37) JMP I ADOFST / / SBOFST - TAKE OFF THE OFFSET FROM THE CONTENTS OF THE AC / SBOFST, XX TAD (-137) / IF ZERO SUBTRACT A 137 ELSE A 37 SZA / ++++ TAD (100) JMP I SBOFST / / CHKSUM - COMPUTES THE CHECK SUM OF THE PACKET WHOSE ADDRESS IS / IN THE AC.IT THEN INSERTS ATHE CHECK SUM AT THE END OF THE PACKET AND / ENDS IT WITH A ZERO. / CHKSUM, XX JMS CHKSM1 / GET THE SUM OF THE BUFFER TAD T2 BSW / PUT IN THE FIRST HALF AND P77 JMS ADOFST DCA I T1 ISZ T1 TAD T2 / NOW THE SECOND HALF AND P77 JMS ADOFST DCA I T1 / ISZ T1 DCA I T1 / INSERT THE TRAILER JMP I CHKSUM / / SNDCHR - SEND CHARACTER ROUTINE / SNDCHR, XX DCA SNDCHT AC0002 / ++++ DCA SNDTMO / SET TIME OUT FOR EACH CHARACTER JMP SNDCHJ SNDCHW, CLA CIFSYS / ++++ JWAIT TAD SPFLAG / IF NOT TIMED OUT CHECK TO SEE IF THE OTHER SPA CLA / ++++ JMP DXOHEX / PROGRAMS ARE RUNNING TAD SNDTMO / ++++ SZA CLA / ++++ JMP SNDCHJ TAD TOFL2 / OR THAT THE INPUT ROUTINE TIMED OUT TAD NAKFL2 / OR THAT IT RECEIVED A NAK SZA CLA / ++++ JMP SNDCHE SNDCHJ, TAD SNDCHT JMS HOSTOU JMP SNDCHW ISZ SNDCHR SNDCHE, JMP I SNDCHR SNDCHT, 0 SNDTMO, 0 / / DXIHJB - HOST INPUT ROUTINE / DXIHEX, AC7777 / ++++ DCA DXIFLG / SET TO SAY I HAVE EXITED. CIFSYS / ++++ JEXIT DXIHWT, CIFSYS / ++++ JWAIT DXIHJB, CLA TAD SPFLAG / SEE IF THE OHTER JOBS ARE DONE IF SO STOP SPA CLA / ++++ JMP DXIHEX TAD RSTFLG / IF SET WAIT SZA CLA / ++++ JMP DXIHWT TAD INIFL1 / SEE IF THE LINE IS INITIATED SNA CLA / ++++ JMP DXIHIN JMS GETTM2 SZA CLA / ++++ ISZ DLYLM2 SKP CLA / ++++ JMP DXIHTO / TIME OUT PROCESS DXIHJ1, JMP DXIHGP / GET A PACKET DXIHJ2, TAD I DXGTPT / SEE WHAT IT IS TAD (-SPECHR) SMA CLA / ++++ JMP DXICMD / ACOMMAND TO LOW LEVEL DW AC0002 / DID WE TIMEOUT? /A017 TAD ERRFLG / (IS ERROR STATUS TIMEOUT?) /A017 SZA CLA / IF YES THEN DON'T ACK /A017 TAD INIFL2 / IF NOT SET DONT ACCEPT THE PACKET SNA CLA / ++++ JMP DXIHWT / WAIT UNTIL SET JMP DXIPKT DXIFLG, 0 DLYLM2, 0 / PAGE / / THIS IS THE TIME OUT CHECK / DXIHTO, TAD INIFL2 SNA CLA / ++++ JMP DXIHIN / IF NOT INITALIZED THEN RESET THE INIT TAD PUTPRC / SEE IF IT IS OK TO TIME OUT SNA CLA / ++++ JMP DXIHWT JMS CLAINF / CLEAR THE EVENT FLAG SO OHTER JOBS WILL NOTICE ISZ TOFL2 AC7777 / ++++ TAD SNDTMO / UPDATE THE TIME OUT COUNTER FOR A CHARACTER SMA / ++++ DCA SNDTMO CLA TAD DLY3X / ++++ /M020 DCA DLYLM2 JMS UPDTER / INCREMENT THE ERROR COUNTER ISZ TOTM2 JMP DXIHWT JMS DXIHKP / KILL THE SEND PACKETS IF THE TRANSFER FAILED AC7777 / ++++ JMS HOSTOU / CLEAR THE OUTPUT BUFFER CLA JMP DXIHWT / / DXIHKP - KILLS ALL PACKETS TO BE SENT AND WAITING / DXIHKP, XX AC7777 / ++++ JMS HOSTOU / CLEAR THE OUTPUT BUFFER AND MAKE SURE ITS XONED CLA JMS DXICLA / CLEAR THE START THE LOW INIT FLAGS / DXIHK2, JMS GETBUF / ++++ SENDPT / CHECK THE SEND LIST JMP DXIHKJ / JMS DXIHKR / SET THE CONDITION FLAG JMP DXIHK2 / CONTINUE UNTIL EMPTY DXIHKJ, JMS GETPTR / GET THE ONES IN THE WAIT LIST JMP I DXIHKP / JMS DXIHKR JMP DXIHKJ DXIHKR, XX IAC DCA T1 AC7777 DCA I T1 JMP I DXIHKR / / DXIHIN - SENDS THE LINE INIT / DXIHIN, AC0001 / ++++ DCA INIFL1 JMS DXIHKP / CLEAR EVERYTHING TAD AXFLG / CHECK FOR AX SZA CLA / ++++ JMP DXIHJ1 TAD DLY1X / ++++ /M020 DCA DLYLM2 TAD (INIT) JMP DXIBDY INIFL1, 0 / / DXIPKT - RETRUN A PACKET / DXIPKT, TAD I DXGTPT / GET THE SEQUENCE NUMBER JMS SBOFST CIA DCA T1 AC0001 TAD ISEQNO AND P77 TAD T1 SZA CLA / ++++ JMP DXIPK2 / TAD DXGTPA / GET THE STARTING ADDRESS JMS PUTBUF / ++++ RECPT / CLA DCA DXIHFP / KEEP PACKET DCA DXNONK / CLEAR THE DONT SEND A NAK FLAG / ISZ ISEQNO / ++++ NOP / UPDATE THE PACKET INPUT SEQUENCE NUMBER DXIPK2, TAD (ACK) / SEND A ACK JMP DXIBDY /A017 / / / THIS WILL SEND THE CONTENTS IN THE AC AS A COMMAND / /DXIBDY, / DCA CMDFLG / / JMS CLAINF / CLEAR THE EVENT FLAG / JMP DXIHJB / DONE CONTINUE ISEQNO, 0 CMDFLG, 0 / / DXICMD - HANDLES THE INCOMING COMMAND / DXICMD, TAD I DXGTPT TAD (-ACK) / CHECK FOR AN ACK SNA / ++++ JMP DXICKS TAD (ACK-NAK) / NOW A NAK SNA / ++++ JMP DXINAK TAD (NAK-INIT) / AND INIT SNA / ++++ JMP DXINIT TAD (INIT-INIACK) SNA / ++++ JMP DXIACI TAD (INIACK-QUIT) / IF A QUIT LOW LEVEL COMMAND AND IN DX LEAVE SNA CLA / ++++ JMP DXIQIT JMP DXIHJB / / DXINAK - CHECK FOR A VALID NAK / DXINAK, ISZ NAKFL2 JMS UPDTER / UPDATE THE ERROR COUNTER JMP DXICKS NAKFL2, 0 /------------ PAGE / / ********************************************************* / / THE NEXT TWO LOCATIONS ARE IMPORTANT TO AX SO IF MOVED TELL AX / SHOULD BE LOCATIONS 5200 AND 5201 / / ********************************************************* / IFNZRO .-5200 / GETBUF PUTBUF / / ********************************************************* / / / DXICKS - CHECK FOR A VALID COMMAND / DXICKS, AC0001 TAD DXGTPT / GET ADDRESS OF THE SEQUENCE DCA T1 TAD I T1 / GET THE SEQUENCE JMS SBOFST / CIA / GET THE NEGATIVE SEQUENCE NUMBER SENT TAD OSEQNO / COMPARE TO THE OUTPUT SEQUENCE NUMBER AND P77 / AND IT TO KEEP IT POSITIVE CIA / MAKE NEGATINE TO SEE IF THE NUMBER IS IN RANGE TAD PUTPRC / COMPARE TO THE NUMBER OF PACKETS IN THE WAIT LIST CIA DCA DXIAKT / IF NEGATIVE IT IS THE NUMBER OF PACKETS ACKED TAD DXIAKT / ++++ SMA CLA / ++++ JMP DXIHJB / FORGET IF NOT NEGATIVE / DXIAK3, JMS GETPTR / GET THE BUFFERS OUT OF THE LIST JMP DXIAKD / RETURN / IAC DCA DXIAK2 / SET THE STATUS TO DONE IAC / DONE IS 1 DCA I DXIAK2 / ISZ DXIAKT JMP DXIAK3 DXIAKD, TAD DLY3X /M020 DCA DLYLM2 JMP DXIHJB DXIAKT, 0 DXIAK2, 0 / / DXIHGP - GETS A PACKET IF ONE IS COMMING / DXIHGP, TAD DXIHFP / SEE IF A BUFFER IS ALOCATED TO INPUT SZA CLA / ++++ JMP DXIHGJ / IF SO FILL IT JMS GETBUF / ++++ FREEPT JMP DXIHWT DCA DXGTPA / SAVE THE BUFFER ADDRESS ISZ DXIHFP / DXIHG1, JMS DXIHGX / SET THE POINTERS TO THE BEGINING DXIHGJ, / SHOULD HAVE A GETCHR ROUTINE SO TO GET FRAMING JMS HOSTIN / GET A CHARACTER JMP DXIHWT / TAD (-CR) / SEE IF END OF PACKET SNA / ++++ JMP DXIHG2 TAD (CR) DXIHGZ, DCA I DXGTPS ISZ DXGTPS ISZ DXGTPC JMP DXIHGJ JMP DXIHG1 / TOO BIG DXIHG2, DCA I DXGTPS / INSERT A ZERO FOR THE END OF A PACKET / AC7776 TAD DXGTPS / GET THE ADDRESS OF THE CHECK SUM CIA TAD DXGTPT / GET DATA CNT SMA / ++++ JMP DXIHG1 / IGNORE IF TOO SMALL DCA T2 / AC7777 / SEE IF THE RESET CHARACTER IS PART OF THE TAD DXGTPS DCA T1 TAD I T1 TAD (-SPECHR) SMA CLA / ++++ JMP DXIHG1 / TAD DXGTPT DCA T1 DXIHG3, TAD I T1 / GET THE CONTENTS ISZ T1 ISZ T2 / ++++ JMP DXIHG3 DCA T3 / SAVE CHECK SUM TAD I T1 / GET THE SENT CHECK SUM JMS SBOFST / GET RID OF THE OFFSET BSW DCA T2 / DCA I T1 / CLEAR THE TERMINATOR / ISZ T1 TAD I T1 JMS SBOFST / STRIP THE OFFSET TAD T2 CIA / ++++ TAD T3 SNA CLA / ++++ JMP DXIHG4 / SEE WHAT WAS FOUND TAD I DXGTPT / CHECK THE SEQUENCES JMS SBOFST CIA / ++++ IAC TAD ISEQNO AND P77 SZA CLA / ++++ JMP DXIHG1 / FORGET TI TF THE SEQUENCES DONT MATCH JMS DXIHGX / RESET THE POINTERS JMP SNDNAK DXIHG4, JMS DXIHGX / RESET THE POINTERS JMP DXIHJ2 / DXIHGX, XX AC0002 TAD DXGTPA DCA DXGTPS / STORE ADDRESS OF START OF TEXT TAD DXGTPS DCA DXGTPT / TAD (-BUFSIZ-5) / COUNTER MINUS THE CR DCA DXGTPC JMP I DXIHGX DXIHFP, 0 DXGTPA, 0 DXGTPS, 0 DXGTPC, 0 / PAGE / / DXINIT - FOR THE INITAL MESSAGE / DXINIT, JMS DXICKV / CHECK FOR A VALID VERSION OF THE PROTOCOL JMP DXIER1 / TAD INIFL3 / SEE IF ALREADY CONNECTED SNA CLA / ++++ JMP DXINI2 / JMS DXIHKP / CLEAR EVERYTHING / AC0001 DXIER2, DCA RSTFLG / IF - THEN CANNOT CONNECT IF + RESTARTED / JMP DXIHWT DXINI2, TAD (INIACK) / ++++ DCA CMDFLG / SET THE COMMAND FLAG DXIACI, JMS DXICKV / CHECK FOR VALIN VERSION JMP DXIER1 / AC0001 DCA INIFL2 / SET THE LINE IS INITALIZED FLAG DXIAC3, JMS CLAINF JMP DXIHJB DXIER1, AC7777 / ++++ DCA CNGSCF / SET TO REPAINT THE SCREEN AC7777 JMP DXIER2 / / HOSTO2 - WILL SEND THE DESIRED NUMBER OF NULLS THAT THE HOST SYSTEM REQUESTED / TO BE SEND AS PAD CHARACTERS AFTER A CR. / HOSTO2, XX TAD HOSTOT / ++++ TAD (-CR) / SEE IF A CR WAS THE LAST CHARACTER SENT SZA CLA / ++++ JMP I HOSTO2 / IF NOT RETURN TAD NULCNT / IF YES THEN SEE IF THE NULL COUNTER IS NON ZERO SNA / ++++ JMP I HOSTO2 / IF ZERO THEN RETURN ALSO DCA HOSTM1 HOSTJ1, JMS HSTOU / OUTPUT NULLS ISZ HOSTM1 JMP HOSTJ1 JMP I HOSTO2 HOSTM1, 0 / / / PUTPTR - INSERTS THE ADDRESS IN THE AC INTO THE SEND LIST OF PACKETS / AND STARTS THE TIMERS / PUTPTR, XX DCA T1 / STORE THE ADDRESS OF THE BUFFER TAD (PTRHED-1) / GET THE START OF THE LIST TAD PUTPRC / USE COUNTER FOR THE OFFSET DCA IX0 TAD T1 / TACK THIS ONE TO THE END OF THE LIST DCA I IX0 DCA I IX0 / TAD (TOLIM) / ++++ DCA TOTM2 TAD DLY3X /M020 DCA DLYLM2 / SET THE TIMERS / ISZ PUTPRC / INCREMENT THE COUNTER JMP I PUTPTR PUTPRC, 0 PUTPRQ, 0 / / GETPTR - GETS THE MOST RECENT PACKET OUT OF THE BUFFER OF / MESSAGES SENT BUT UNANSWERED / GETPTR, XX CLA TAD PUTPRC / SEE IF STACK EMPTY SNA / ++++ JMP I GETPTR CIA DCA T2 TAD (PTRHED-2) DCA IX1 TAD (PTRHED-1) DCA IX0 GETPTL, TAD I IX0 / GET THE NEXT ENTRY DCA I IX1 ISZ T2 JMP GETPTL DCA I IX1 ISZ GETPTR AC7777 TAD PUTPRC / DECREMENT THE COUNTER DCA PUTPRC TAD PTRHED-1 / GET THE NEXT ADDRESS JMP I GETPTR / / GETBUF - GETS THE NEXT BUFFER ADDRES IF THERE IS ON IN THE REQUESTED CHAIN / CALL / JMS GETBUF / THE CHAIN STARTING ADDRESS (FREEPT,RECPT,SENDPT) / EMPTY RETURN / NORMAL RETURN / GETBUF, XX CLA RDF / READ THE DATA FIELD TO SEE WHERE IT CAME FROM TAD CIDF0 / MAKE THE RETURN INSTRUCTION DCA GETBUX TAD I GETBUF / GET THE ADDRESS CDFMYF ISZ GETBUF DCA T1 TAD I T1 / GET THE NEXT BUFFER IN THE CHAIN SNA / ++++ JMP GETBUX / RETURN ZERO IN BUFFER DCA T2 TAD I T2 / CHANGE THE POINTERS BECAUSE THIS ONE IS NOW IN USE T1 DCA I T1 / CUT FROM CHAIN TAD T2 / RETRUN THE BUFFER ADDRESS ISZ GETBUF GETBUX, XX JMP I GETBUF / / PUTBUF - ADD THE SPECIFIED BUFFER WHOSE ADDRESS ISIN THE AC IN THE LIST / DESIRED BY THE NEXT LOCATION / PUTBUF, XX DCA T2 / SAVE THE BUFFER RDF / READ THE DATA FIELD FOR THE RETURN TAD CIDF0 DCA PUTBUX TAD I PUTBUF / GET THE CHAIN STARTER ISZ PUTBUF DCA T1 CDFMYF PUTBUJ, TAD I T1 / GO TO THE END SNA / ++++ JMP PUTJ2 DCA T1 JMP PUTBUJ PUTJ2, TAD T2 DCA I T1 DCA I T2 PUTBUX, XX JMP I PUTBUF /------------ PAGE / / SNDPCK - SENDS A PACKET / THE ADDRESS OF THE TEXT PART OF THE BUFFER IS IN THE AC / SNDPCK, XX DCA SNDTP2 / SAVE THE STARTING ADDRESS SNDCMJ, TAD I SNDTP2 / GET THE FIRST CHARACTER SNA / ++++ JMP SNDCMD JMS SNDCHR JMP SNDCME ISZ SNDTP2 JMP SNDCMJ SNDCMD, TAD (CR) / SEND THE TRAILER JMS SNDCHR JMP SNDCME ISZ SNDPCK SNDCME, JMP I SNDPCK SNDTP2, 0 / / CLSCRL - CLOSES THE FILE IF HAS BEEN OPENED FOR SCROLL / CLSCRL, XX TAD DOCNO / SEE IF IT IS OPEN SNA CLA / ++++ JMP I CLSCRL CIFBUF / Call the SIX BIT routine so as to /A017 JMS I WRISXA / TERMINATE THE FILE PROPERLY /A017 CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XDSKCL JMP I CLSCRL / / GETPRC - GETS THE PRINTER SETTING OUT OF THE BUFFER READ IN BY RDFIL INIT / GETPRC, XX DCA INISTT / SAVE THE ADDRESS FOR THE INSERT PRINTER CONTROLS DCA BYTCNT / INITALIZE THE BYTE COUNT TAD INISTT DCA X1 TAD (SETSIZ) / INITALIZE THE WORD COUNTER DCA SETCNT TAD (SETSND-1) / GET THE INITAL ADDRESS OF STRE THE SETTING DCA SETTMP / STORE THE INITAL ADDRES OF THE SETTINGS GETRLL, JMS GETPRB / GET A BYTE OF THE SETTINGS JMS ADOFST / ADD THE OFFSET DCA I X1 / STORE IN MESSAGE BUFFER JMS GETPRB JMS ADOFST / ADD THE OFFSET OFR THE LINE DCA I X1 ISZ SETCNT JMP GETRLL DCA I X1 JMP I GETPRC SETCNT, 0 INISTT, 0 / / GETRLB - GETS THE NEXT BYTE OF THE PRINTER SETTINGS / GETPRB, XX JMS GETBYT / FIND OUT WHICH HALF OF THE WORD TO RETURN JMP NOISZ / TOP HALF ISZ SETTMP / NEXT WORD TOP BYTE CDFBUF TAD I SETTMP BSW JMP GETCNT NOISZ, CDFBUF TAD I SETTMP GETCNT, CDFMYF AND P77 JMP I GETPRB SETTMP, 0 / / GETBYT - IF BYTCNT = 0 SET TO 1 AND SKIP RETURN / IF 1 THEN SET TO ZERO AND RETURN / GETBYT, XX CLA TAD BYTCNT SZA CLA JMP CLABYT AC0001 ISZ GETBYT CLABYT, DCA BYTCNT JMP I GETBYT BYTCNT, 0 / / STRPRT - STORES THE PRINTER SETTINGS INTO THE FILE HEADER THAT IS / RECEIVING THE DOCUMENT / STRPRT, XX CLA TAD (PRTOFF) / SEE IF THERE EXISTS ANY PRINTER SETTINGS CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XHDRGT SZA CLA / ++++ JMP I STRPRT / THERE EXISTS PRINTER SETTINGS TAD (SETSIZ) / INITALIZE THE COUNTER FOR THE PRINTER SETTINGS DCA SETCNT TAD (SETSAV-1) / GET THE STARTING ADDRESS DCA X5 TAD (PRTOFF) / INITLAIZE THE OFFSET FOR SAVING THE VALUES DCA SETTM2 STRRLL, TAD I X5 JMS SBOFST / TAKE OFF THE OFFSET BSW MQL / STORE IT TAD I X5 JMS SBOFST MQA MQL / ++++ TAD SETTM2 CIFFIO / ++++ /M013 FILEIO / ++++ /M013 XHDRPT ISZ SETTM2 ISZ SETCNT JMP STRRLL JMP I STRPRT SETTM2, 0 / CLEAR STATUS LINE AND RESET FLAGS /A031 CLASTA, XX / CLEAR STATUS LINE /A031 JMS SETFLG / FIRST RESET FLAGS /A031 CIFMNU / MENU /A031 JMS I IOACAL / GO DISPLAY /A031 0 / /A031 CONSTM / "CONNECTION ESTABLISHED" /A031 0315 / SCREEN POSITION /A031 JMP I CLASTA / RETURN /A031 / / INIWAT - JWAITS AND CHECKS THE SPFLAG / IT DOES A SKIP RETURN IF NOTHING IS SET. / INIWAT, XX CIFSYS / ++++ JWAIT / CLA TAD SPFLAG SNA CLA / ++++ ISZ INIWAT / JMP I INIWAT / /------------- PAGE / / DXCOPY - SIMILAR TO CUCOPY BUT THIS COPY MAKES ASCIIZ STRINGS OUT OF THE / RECEIVING STRING AND NEEDS AN ASCIIZ STRING FOR THE BEGINNING STRING. THAT IS / WHY IT HAS TO COUNT / / CALL: / JMS DXCOPY / CDF TO FIELD OF START STRING / ADDRESS OF THAT STRING / CDF TO RECEIVING STRING / ADDRESS OF STRING / DXCOPY, XX CLA TAD DXBSIZ / SET A LIMIT FOR PROTECTION DCA T1 TAD I DXCOPY DCA DXCOP1 ISZ DXCOPY AC7777 TAD I DXCOPY DCA X1 ISZ DXCOPY TAD I DXCOPY DCA DXCOP2 ISZ DXCOPY AC7777 TAD I DXCOPY DCA X2 ISZ DXCOPY DXCOP1, XX TAD I X1 DXCOP2, XX SNA / ++++ JMP DXCOPX DCA I X2 ISZ T1 JMP DXCOP1 DXCOPX, DCA I X2 CDFMYF JMP I DXCOPY DXBSIZ, -BUFSIZ / / KBOUTC - CROSS FIELD ROUTINE THAT WILL OUTPUT A CHARACTER IF ECHO IS TURNED / ON ELSE OUTPUT A BOX TO THE SCREEN / KBOUTC, XX DCA OUTCHR / CHARACTER IS IN THE AC TO BE PRINTED WHEN CALLED RDF TAD CIDF0 DCA KBOUTX / SET THE RETURN FIELD CDFMYF TAD OUTCHR SNA CLA / ++++ JMP KBOUTX TAD I LPMTFL / IF NEGATIVE ECHO IS TURNED OFF SMA CLA / ++++ JMP KBOUTL JMS I LKBOUT ESC+4000 / ESC /M007 "(+4000 / ( /A007 060+4000 / '0' put in special graphics mode /M017 141+4000 / a (outputs a square box) /M007 ESC+4000 / ESC /M007 "(+4000 /A007 102 / 'B' put back in ascii character set /M017 JMP KBOUTX / RETURN WHEN THE STRING IS SENT KBOUTL, JMS I LKBOUT OUTCHR, 0 / Character to be output. KBOUTX, XX JMP I KBOUTC LPMTFL, PMTTMP LKBOUT, KBOUT / / THIS IS THE LIST OF FLAGS TO CLEAR AT THE STARTOF THE LOW LEVEL ROUTINES / TOCLST / TOCLST, DXOFLG / CLEAR THE FLAG FOR THE OUTPUT JOB TOTM2 / CLEAR THE TIME OUT FLAG TOFL2 / CLEAR THE TIME OUT COUNTER OSEQNO / CLEAR THE OUTPUT SEQUENCE NUMBER SNDTMO / CLEAR THE FLAG FOR THE SEND CHARACTER ROUTINE FOR TIME DXIFLG / CLEAR THE INPUT FLAG ISEQNO / CLEAR THE INPUT SEQUENCE NUMBER NAKFL2 / CLEAR THE NAK FLAG DXNONK / CLEAR THE DONT SEND A NAK ONE HAS BEEN SENT ALREADY FLAG 0 / TERMINATOR / / THE BUFFERS / CMDBUF, ZBLOCK 10 / THE COMMAND BUFFER PTRHE1, 0 / THE NEXT ADDRESS THAT WILL BE RETURNED BY GETPTR PTRHED, ZBLOCK BUFCNT+1 / THE LIST OF PACKETS SENT AND WAITING FOR AN ACK INMBLK, ZBLOCK BUFSIZ+1 / MINUS THE CHECK SUM DOCNBF, ZBLOCK BUFSIZ+2 / SECOND MESSAGE BUFFER USED FOR FILE NAME / AND COMMUNICATIONS BETWEEN THE HOST AND MAIN / / / THIS IS THE BUFFER POOL. BUFBL1 - 5 / / FORMAT: / ADDRESS +0 LINK TO NEXT ENTRY IN LIST / +1 STATUS: 0 = NOTHING, 1 = SENT, -1 = TIMED OUT / +2 - 64 TEXT OF PACKET ASCIIZ FORMAT / / THE USE OF THE POINTER IS TO LINK TOGETHER THE THREE LIST: FREE, SEND / AND RECEIVE. THE LISTS ARE TERMINATED BY A ZERO POINTER. THE STARTING / ADDRESS OF THE LISTS ARE FOUND IN FREEPT, SENDPT, AND RECPT. TO GET A BUFFER / FROM ANY LIST OR TO ADD TO THE LIST THER ARE ROUTINES FOR THIS CALLED / PUTBUF AND GETBUF. / / CALL: / JMS PUTBUF/GETBUF / ADDRESS OF POINTER TO LIST / / ON CALLING PUTBUF THE AC CONTAINS THE STARTING ADDRESS OF THE BUFFER. / / WHEN RETURNING FROM GETBUF THE STARTING ADDRESS OF THE NEXT BUFFER IS IN / THE AC. IF THERE ARE NO BUFFERS GETBUF DOES A NON-SKIP RETURN, ELSE A / SKIP RETURN. / BUFBL1, BUFBL2 / LINK BUFF 1 TO BUFF 2. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL2, BUFBL3 / LINK BUFF TO TO BUFF 3. /A023 ZBLOCK BUFSIZ+6 /M023 *BUFBL2+2 /LEAVE A COUPLE OF ZERO WORDS AT BEG OF BUFFER /A020 DLYBAS, -1 /BASE CONSTANT FOR DEVLOPING VARIABLE DELAYS /A020 XDLYCT, -1 /DEFAULT MULTIPLIER /A020 XDELAY, XX /A020 CDFMNU /NEED TO ACCESS MENU AREA FOR DELAY ENTRY /A020 TAD I IMNXDL /GET DELAY MULTIPLIER /A020 CDFMYF /A020 CIA /CONVERT TO NEG COUNT /A020 DCA XDLYCT /SET COUNTER /A020 TAD DLYBAS /GET BASE DELAY CONSTANT /A020 ISZ XDLYCT /SKIP WHEN DELAY IS BIG ENOUGH /A020 JMP .-2 /LOOP TILL DELAY MULTIPLIED X TIMES /A020 DCA I IDLY1X /SET NEW BASE DELAY (TIMES X) /A020 TAD I IDLY1X /GET BASE DELAY /A020 TAD I IDLY1X /DEVELOP 3X DELAY /A020 TAD I IDLY1X /A020 DCA I IDLY3X /SET 3X DELAY /A020 TAD I IDLY3X /GET PACKET SEND/RECV TIMEOUT DELAY /A020 TAD I IDLY3X /DOUBLE IT /A020 DCA I IDLY6X /SET 6X DELAY (HOST ACK TIME OUT /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 TAD I IDLY6X /USE 6X DELAY TO DEVELOP 36X (180)DELAY /A020 DCA I IDLY18 /SET USER RESPONSE TIME DELAY /A020 AC7777 /MAKE SURE 1ST SECOND IS A WHOLE ONE /A020 TAD I IDLY1X /GET SHORT DELAY /A020 DCA I IDLY1X /PUT BACK ADJUSTED DELAY COUNT /A020 AC7777 /SAME PROCEDURE FOR 6X DELAY /A020 TAD I IDLY6X /GET IT /A020 DCA I IDLY6X /DON'T ADJUST 3X DELAY /A020 /D023; CLA /A020 /D023; TAD .-1 /GET A NOP INSTRUCTION /A020 /D023; DCA I ILYINT /OVERLAY JMS TO THIS ONCE ONLY ROUTINE /A020 XDLYEX, JMP I XDELAY /RETURN /A020 IMNXDL, MNXDLY+MUBUF /ADDRESS OF VARIABLE IN MENU AREA /A020 /D023;ILYINT, DLYINT /ADDRESS OF ENTRY JMS TO X DELAY /A020 IDLY1X, DLY1X /ADDRESS OF TIMES ONE CONSTANT /A020 IDLY3X, DLY3X /ADDRESS OF TIMES 3 CONSTANT /A020 IDLY6X, DLY6X /ADDRESS OF 6 etc. /A020 IDLY18, DLY180 /ESTIMATED AT 3 MIN. /A020 *BUFBL2+BUFSIZ+7 /CONTINUE WITH BUFFER DEFINITIONS /A020 BUFBL3, BUFBL4 / LINK BUFF 3 TO BUFF 4. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL4, BUFBL5 / LINK BUFF 4 TO BUFF 5. /A023 ZBLOCK BUFSIZ+6 /M023 BUFBL5, 0 / BUFF 5 IS GROUNDED BECAUSE IT'S LAST. /A023 ZBLOCK BUFSIZ+6 / / USED FOR THE INPUT ROUTINES FOR CHECKING FOR A VALID ENTRY / TOKOFF, 0 TOKBUF, -7 ZBLOCK 10 /D023;/ /D023;/ THIS IS THE BUFFER USED BY THE DOCUMENT LIST ROUTINE. DX IS ALOWED TO /D023;/ RECEIVE UP TO 8 DOCUMENTS FROM A AX SYSTEM ON REQUEST. THE LIST IS STORED /D023;/ HERE IN THE FORMAT: /D023;/ /D023;/ OPEN CODE -1 = OVERWRITE; 0 = TOP; 1 = BOTTOM /D023;/ /D023;DOCLSA, /D023; ZBLOCK LSTSIZ+1 / / MESSAGES / /THERE IS NO APPARENT REASON TO DO AN ERASE TO END OF LINE SO WE /CAN MAKE THESE TWO COMMAND STRINGS TO IOA THE SAME. ALSO, THIS LITTLE /CHANGE FIXES THE PROBLEM OF PACKET ERRORS WHEN THE 278 IS RECEIVING /A DOCUMENT AT GREATER THAN 600 BAUD. THERE IS STILL A PROBLEM AT 19200 /BAUD. SOMEONE SHOULD LOOK AT IOA TO SEE HOW IT IS DOING THE ERASE TO /END OF LINE AS IT IS THE CULPRIT. WE APPARENTLY LOOSE INPUT CHARACTERS /FROM THE HOST WHEN DOING THE ERASE TO END OF LINE IN A 278 /A009 NUMDIS,/TEXT '^P!L!D' /D009 BLKDS2, TEXT '^P!D' DRVSTR, TEXT /!D/ DATSTR, ZBLOCK 27 / filled in w/ the DATE & TIME string. OKSTMT, IFDEF ENGLSH < TEXT '^P - RECEIVED' > IFDEF ITALIAN < TEXT '^P - RICEVUTO' > IFDEF V30NOR IFDEF V30SWE / MESSTM, IFDEF ENGLSH < TEXT '^P!L&MESSAGE: ^A' > IFDEF ITALIAN < TEXT '^P!L&MESSAGGIO: ^A' > IFDEF V30NOR < TEXT '^P!L&MELDING: ^A' > IFDEF V30SWE < TEXT '^P!L&MEDDELANDE: ^A' > / CONSTM, IFDEF ENGLSH < TEXT '^P!L&CONNECTION ESTABLISHED'> /A031 IFDEF ITALIAN < TEXT '^P!L&CONNESSIONE IN CORSO' > IFDEF V30NOR < TEXT '^P!L&FORBINDELSE OPPRETTET'> IFDEF V30SWE < TEXT '^P!L&UPPKOPPLINGEN \DR KLAR'> PRBSTM, IFDEF ENGLSH < TEXT '^P!L&PROBLEM: ^A'> /A031 IFDEF ITALIAN < TEXT '^P!L&PROBLEMA: ^A' > IFDEF V30NOR IFDEF V30SWE BYESTM, IFDEF ENGLSH < TEXT '^P!L&BYE: ^A' > IFDEF ITALIAN < TEXT '^P!L&BYE: ^A' > IFDEF V30NOR IFDEF V30SWE / MSGPRG, IFDEF ENGLSH < TEXT '^P!L&MESSAGE SENT' > IFDEF ITALIAN < TEXT '^P!L&MESSAGGIO INVIATO' > IFDEF V30NOR < TEXT '^P!L&MELDING SENDT'> IFDEF V30SWE < TEXT '^P!L&ETT MEDDELANDE \DR S\DNT'> / PMTMES, TEXT '^P^A^P' / CLALIN, TEXT '^P!L' BTLINE, TEXT '^A' TIMSTR,/TEXT /^P^A!L/ OUTLN, TEXT '^P!L^A' INITYP, TYPHIT / HAS TO BE JUST BEFORE THE SYSTYP SYSTY1, 0 IFDEF ENGLSH < "Y-200 / Y "o-200 / o "u-200 / u " -200 / "a-200 / a "r-200 / r "e-200 / e " -200 / "c-200 / c "o-200 / o "n-200 / n "n-200 / n "e-200 / e "c-200 / c "t-200 / t "e-200 / e "d-200 / d " -200 / "t-200 / t "o-200 / o " -200 / "a-200 / a " -200 / > / End IFNDEF ENGLSH IFDEF ITALIAN < "C-200 "o-200 "n-200 "n-200 "e-200 "s-200 "s-200 "i-200 "o-200 "n-200 "e-200 " -200 > / End IFDEF ITALIAN IFDEF V30SWE < "K-200 / k "o-200 / o "p-200 / p "l-200 / l "e-200 / e "t-200 / t " -200 / "t-200 / t "i-200 / i "l-200 / l " -200 / "e-200 / e "t-200 / t " -200 / > / End IFDEF V30SWE IFDEF CONDOR < /A021 "D-200 / D CONNECTED TO /A036/M021/A008 "M-200 / M DECMATE /A036/M021/A008 > /END IFDEF CONDOR /A021 IFNDEF CONDOR < /A021 "V-200 / V SET UP MESSAGE /M021/A008 "T-200 / T SAYING THAT CONNECTED /M021/A008 "2-200 / 2 TO A "VT278" IN /A008 "7-200 / 7 AX OR DX MODE /M021/A008 "8-200 / 8 /M021/A008 > /END CONDOR NDEF /A021 " -200 / Space IFDEF ENGLSH < 151 / i 156 / n > IFDEF ITALIAN < "p-200 "e-200 "r-200 > IFDEF V30NOR < " -200 "i-200 / i " -200 > IFDEF V30SWE < " -200 "i-200 / i " -200 > / " -200 / Space / IFDEF ENGLSH < SYSTY2, "D-200 SYSTY3, "X-200 > IFDEF ITALIAN < SYSTY3, "T-200 SYSTY2, "D-200 " -200 "a-200 "t-200 "t-200 "i-200 "v-200 "a-200 > IFDEF V30NOR < SYSTY2, "D-200 SYSTY3, "X-200 > IFDEF V30SWE < SYSTY2, "D-200 SYSTY3, "X-200 > 0 / ENDFD1=. 0 / 1st word of KB: input buffer (INBUFA) /A023 / / USE OF THE AREA PAST ENDFD1 / INBUFA=ENDFD1 / THE END OF THE FIRST FIELD AT ASSEMBLY TIME (ENDFD1) / INPUT FROM THE KEYBOARD (INBUFA) INBUFM=100 / BUFFER MAX ENDINB=INBUFA+INBUFM / THE VALUE OF THE LAST WORD USED FOR THE INPUT BUFFER EXTSPC=ENDINB+1 / THE UNUSED AREA IN THE LAST BLOCK 7400 - 7777 / / THIS IS THE PART OF WPTRNS THAT IS IN THE AREA ENDFD1 TO 7777. THE REASON THAT / IT IS A SEPERATE AREA IS FOR ASSEMBLY REASONS. THIS AREA IS OCUPIED BY / OS-8 SO CANNOT USE WHEN LOADING OUT. FOR THIS REASON IT IS ASSEMBLED OUT / IN FIELD 2 BUT IS LOADED AT THE SAME TIME WPTRNS IS. / IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 4 > *EXTSPC / VALUE FOR THE END OF THIS AREA USED BY BUFFERS / / / DOMENU - Displays the MENU following the point of call. If the menu is / being displayed because of a packet received then the prompt version of / the MENU is displayed. / / /CALL: JMS DOMENU / MENU block # to call. / GOLD MENU return / Normal return / DOMENU, XX CLA / Inititialize. TAD I DOMENU / Get MENU to call. DCA DOMEN2 / ... ISZ DOMENU / Bump to return address. TAD PMTTMP / TELL THE MENU IF CALLED BY A PROMPT CDFMNU DCA I (MUBUF+MNTMP1) TAD AXPMT / THIS SETS FOR A SPECIAL TYPE OF PROMPT NEEDED FOR AX DCA I (MUBUF+MNTMP2) DCA I (MUBUF+MNTMP3) / Initializing call. CDFMYF TAD TOKOFF / First time, use any prior input. DOMEN1, JMS CPYITM / ... JMS BUFSET / CHANGE BUFFER LENGTH TO 64 CHARS. /A032 CIFMNU JMS I MNUCAL DOMEN2, XX JMS BUFRST / RESTORE BUFFER LENGTH /A032 AC7776 / First we check for Gold:MENU return (2). CDFMNU / Map menu field. TAD I (MUBUF+MNTMP3) / Get return value. CDFMYF / Map our field. SNA / Skip if NOT GOLD:MENU. JMP DOMEN4 / JMP to take the GOLD:MENU return. SMA CLA / Skip if have to call menu again. JMP DOMEN3 / Jmp to do final return. TAD (DOCNBF) / 2nd time (& thereafter) use default filename. JMP DOMEN1 / Go process it. DOMEN3, JMS INITKF / init TOKBUF to start of INBUFA area. JMS DXCOPY / copy input CDFMNU / from menu MUBUF+MNIBUF / input area, CDFMYF / to our INBUFA / input area. ISZ DOMENU / Take normal return. DOMEN4, JMP I DOMENU / Return to caller. INITFN, XX / Entry point. TAD AXPMT / See if we're supposed to use 'remembered fnam'' TAD PMTTMP / If both 0 then yes. SZA CLA / Skip if both 0 (ie yes). JMP INIFN2 / Jmp to use current DOCNBF. TAD (DOCNBF) / Create ptr to where to put default filename. DCA SENXXX / Save in an temp. CDFMNU / We're supposed to use 'remembered filename' TAD I (MUBUF+MNDRV) / Get drive of remembered doc. DCA T1 / Save in temp. TAD I (MUBUF+MNFNAM) / Get menu pointer to file name. DCA INIFN0 / save for later. TAD I (MUBUF+MNFNO) / Now see if there is one available. CDFMYF / ... SNA CLA / Skip if yes. JMP INIFN1 / Jmp if no. Set 'NO DEFAULT'. AC7777 / See if drive is drive 1. /A029 TAD T1 / ... /A029 SNA CLA / Skip if no. We must convert & output it/A029 JMP INIFN3 / Don't output default drive 1. /A029 CIFMNU / Convert to ascii. JMS I IOACAL / ... MYROUT / DRVSTR / text string to convert drive number to ascii. T1 / pointer to where it is. INIFN3, JMS DXCOPY / Copy filename string CDFMNU / from menu area, INIFN0, MUBUF+MNFNAM / ... CDFMYF / to our input string area. SENXXX, XX / Address of where to copy filename to. AC7777 / Now to remove terminating space. TAD X2 / X2 was pointing to terminating null. DCA SENXXX / So now SENXXX points to previous character. TAD I SENXXX / See if that prior character is a blank space. TAD (-40) / ... SNA CLA / Skip if no. If yes, then zap it. INIFN1, DCA I SENXXX / Zap Default filename pointer. INIFN2, JMP I INITFN MYROUT, XX / XFLD callable from MENU IOA call. DCA T2 / Save char in our temp. RDF / Get calling field. TAD CIDF0 / Make into a return CDI instruction. DCA MYEXIT / save for exit. CDFMYF / Map our field. TAD T2 / Get character being output. SNA / Skip if not terminator. TAD (".&177) / Convert terminator to a period. DCA I SENXXX / Stuff in buffer. ISZ SENXXX / Bump pointer. MYEXIT, CDIMNU / Return to IOACAL processor. JMP I MYROUT / ... / / / SETSIX - sets the XFIELD call vector in page 0 to their appropriate / values. At startup, the list entries contain the address of the / address (in the BUF field) of the routine. The list starts with / location CLASXA & is terminated with a zero entry. / SETSIX, XX TAD (CLASXA) / get address of list. DCA T1 / Save in a temp. SETSX1, TAD I T1 / Get address of address. SNA / Skip if not done. JMP I SETSIX / Return when done. DCA T2 / Save. CDFBUF TAD I T2 / Get address of routine. CDFMYF DCA I T1 / Save address in vector table. ISZ T1 / Bump to next entry. JMP SETSX1 / Go process it. TRNCN7, JMS RESETS / DISPLAY FIRST SCREEN /A039 JMP MAINL3 / NOW GO TO KB LOOP /A039 /------------ PAGE / / IF SET FOR 102 THEN THE LOG DOCUMENT HAS TO BE UNLOCKED IF USED / /RTN102,XX / / CLA /D017 / CDFBUF / TAD I (AXLRT) / GET THE ADDRESS OF THE ROUTINE THAT WILL UNLOCK / CDFMYF / / DCA T1 / / CIFBUF / UNLOCK LOG FILE / JMS I T1 / / JMP I RTN102 / / / THE SEND AND RECEIVE PART OF AX / AXRRTN, AC0001 AXSRTN, DCA TEMP / ZERO =RECEIVE AND 1 = SEND JMS FIL2BF / FILL THE DOCNBF BUFFER AND RELEASE THIS ONE JMP AXRT3 / SEE IF THE KEYBOARD ROUTINE IS USEING THE MENU AXRT4, JMS INIWAT / DO A JWAIT AND THEN CHECK SPFLAG / HAVE TO CHECK SPFLAG TO AVOID AN INFINITE LOOP JMP HSTWAT / RETURN AND WAIT AT MAIN LOOP AXRT3, TAD DISTMP SZA CLA / ++++ JMP AXRT4 AC7777 / SET FLAG BEFORE ENTERING THIS SECTION /A039 DCA DISTMP / /A039 JMS CLASTA / CLEAR THE FLAGS FOR A TRANSFER /C031 TAD TEMP / TELL THE OTHER FIELD WHICH MODE TO GO TO CIFBUF JMS I AXSRA DOCNBF / THE ADDRESS OF THE POINTER TO THE BUFFER RECEIVED /D039 JMP HSTWAT / NO RETURN JMP AXRTNO / NO RETURN /A039 DCA DOCNO / SAVE THE DOCUMENT NUMBER MQA DCA DOCMOD / AND THE MODIFICATION VALUE AC0002 TAD TEMP / SET THE PROMPT FLAG SO WHEN THE ANSWER PAKCET IS / SENT THE TRANSFER WILL BE ACTIVATED / SINCE IT WILL NOW ACT LIKE THE ANSWER TO A / SEND OR RECEIVE PROMPT DCA PMTTMP TAD TEMP / IF SET FOR RECEIVE OR SEND SET THE CORRECT FLAG SNA CLA / ++++ JMP AXRT2 ISZ SNDAD / SET AX SEND FLAG /D039 JMP HSTWAT JMP AXRTNO / /A039 AXRT2, ISZ AXREC / SET AX RECEIVE FLAG AXRTNO, CLA / /A039 DCA DISTMP / CLEAR DISTMP BEFORE LEAVING /A039 JMP HSTWAT / RELEASE BUFFER / / MDRTN - THE ROUTINE WILL ASK THE DX USER HOW TO MODIFY THE DOCUMENT / ON THE AX SIDE. THE TYPMOD PACKET WILL ONLY BE SENT TO THE DX USER IF THE / DX USER IS SENDING A DOCUMENT TO AX AND THAT DOCUMENT ALREADY EXITS / ON THE AX SIDE. / / THE VALUE OF THE FIRST BYTE OF THE PACKET IS USED TO TELL WHICH / OPTIONS CAN BE CHOSEN. SINCE THE ONLY TWO THAT / MEAN ANYTHING RIGHT NOW IN THE PROGRAM IS TOB AND BOTTOM OR TOB BOTTOM AND / OVERWRITE, THESE TWO CHOICES ARE LOOKED FOR. / / ALL VALUES THAT COULD EXIST IN THE FIRST BYTE / / 40 NONE / 41 TOP / 42 BOTTOM / 43 TOP AND BOTTOM / 47 ALL / / THE VALUES RETURNED IN THE PROMPT ANSWER PACKET IS ALSO THE / FIRST CHARACTER USED. THE VALUES ARE: / / 40 GOLD MENU TYPED / 41 OVERWRITE / 42 TOP / 43 BOTTOM / MDRTN, TAD (-43) / IF NOT TOP AND BOTTOM (43) ASSUME ALL FOR NOW TAD DOCNBF SNA CLA / ++++ AC0001 / 1= TOP AND BOTTOM 0 = ALL JMS ASKMOD / DISPLAY THE OPTIONS DLMA15 / and get the choice. JMS SETOPT / RE-SET OPTIONS & CLA. GOLD MENU IS 40 /A017 TAD (40) / SEND THE RESPONSE PLUS 40 TO MAKE IT A VALID CHARACTER / TO SEND DOWN THE COM LINE. DCA INBUFA DCA INBUFA+1 DCA DOCNBF / Clear out DEFAULT filename. DCA PMTTMP / CLEAR THE FLAG DONT WANT TO ACT LIKE A NORMAL PROMPT AC0001 / SET VALUE FOR RETURN PACKET TYPE JMP SNDPP2 / GO AND SEND RESPONSE / / SNDQIT - WILL SEND A QUIT MESSAGE TO THE OTHER SYSTEM NOT CARING IF THE OTHER / SYSTEM GETS IT OR NOT . IT TELLS THE OTHER SYSTEM THAT THIS USER IS GOING TO / THE MAIN MENU. / /D041SNDQIT, XX /D041 AC7777 / ++++ /D041 JMS HOSTOU / CLEAR THE OUTPUT BUFFER IF THERE IS ANYTHING /D041 CLA / FOR THE SKIP RETURN SNDQT2, / TEST FOR TRANSFER COMPLETE /A041 TAD SENDFL / /A041 SNA CLA / 0 = TRANSFER COMPLETE /A041 JMP SNDQT3 / /A041 TAD (CR) / PACKET TERMINATOR /A041 JMS HOSTOU / SEND IT /A041 CLA / FOR THE SKIP RETURN /A041 SNDQT3, TAD (QUIT) JMS DXOCPK / GENERATE A COMMAND TAD (CMDBUF-1) / SEND IT DCA X1 SNDQIL, TAD I X1 SNA / ++++ JMP SNDQI2 / SEND THE CR JMS HOSTOU JMP DXOSQR / BUFFER FULL RETURN /M041 JMP SNDQIL SNDQI2, TAD (CR) JMS HOSTOU NOP JMP DXOSQR / RETURN TO DX OUTPUT ROUTINE /M041 / / ASKMOD - DISPLAY THE MENU FOR THE OPTIONS TO A DOCUMENT THAT ALREADY / EXISTS. IF MNTMP3 IS SET TO ZERO ALL OPTIONS ARE GIVEN, IF SET TO 1 / THEN ALL BUT OVERWRITE. THIS CAN BE EXPANDED TO DISPLAY ANY COMBINATION / DESIRED, BUT THE ONLY TWO THAT ARE USED ARE THESE. THE MENU IS ONLY SET / FOR THESE TWO OPTIONS BUT THE PROTOCOL CAN HANDLE ANY. / IT CAN BE ALSO CALLED FOR ANY OTHER MENU BESIDES DLMA15. THE MENU IS / FOLLOWS THE CALL AND THE AC CONTAINS THE VALUE TO SET MNTMP3. / THIS IS USEFUL WHEN CALLING DLMA15 BUT CAN BE USED BY ANYONE. / ASKMOD, XX CDFMNU DCA I (MUBUF+MNTMP3) CDFMYF TAD I ASKMOD / Get MENU to call. ISZ ASKMOD / Bump past argument. DCA ASKMO4 / STORE THE MENU TO CALL JMS BUFSET / LIMIT INPUT BUFFER TO 64 CHARS /A032 CIFMNU JMS I MNUCAL / Get option (Top, Bottom, Overwrite) ASKMO4, XX JMS BUFRST / RESTORE BUFFER LENGTH /A032 CDFMNU / Get MNTMP1 response. TAD I (MUBUF+MNTMP1) / ... CDFMYF / Back to our field. SZA / Skip if GOLD:MENU. Return the value. ISZ ASKMOD / OK RETURN JMP I ASKMOD / Return to caller. / / / / THIS ROUTINE WILL CHANGE THE MENU INPUT BUFFER LENGTH TO 64 CHARS. / THIS WORD AT (MNILEN) MUST BE RESTORED UPON RETURN FROM THE MENU CALL / BUFSET, XX / /A032 CLA / /A032 CDFMNU / /A032 TAD I (MUBUF+MNILEN) / FETCH PRESENT LENGTH /A032 CDFMYF / /A032 DCA BUFLEN / SAVE HERE /A032 TAD (-BUFSIZ-1) / A NEG 64 /A032 CDFMNU / /A032 DCA I (MUBUF+MNILEN) / INSTALL VALUE /A032 CDFMYF / /A032 JMP I BUFSET / /A032 / / / / THIS ROUTINE WILL RESTORE THE MENU BUFFER LENGTH THAT WAS / / CHANGED BY BUFSET / / BUFRST, XX / /A032 CLA TAD BUFLEN / FETCH OLD VALUE /A032 CDFMNU / /A032 DCA I (MUBUF+MNILEN) / BACK INTO MENU FIELD /A032 CDFMYF / /A032 JMP I BUFRST / /A032 BUFLEN, 0 / STORAGE FOR BUFFER LENGTH /A032 /------------- PAGE   /WTRLRP - WRITES OUT INITIAL PRINTER SETTINGS /001 05-NOV-84 ALLOW FOR POSSIBLE FUTURE EXPANSION TO HEADER WORDS 18, 42 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLRLRP;200;CDF 20;-DSRLRP 0 FIELD 2 *200 DECIMAL 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 0 /POSSIBLE FUTURE SPARE--POSITION 18 /A001 1 /INIT 1 /CP 0 /PM 0 /EX 6 /TM 6 /BM 66 /PS 10 /PI 1 /FR 0 /TO 1 /IP 0 /SPARE 1 /AP 1 /SPARE 0 /SPARE 0 /SE 0 /SPARE 0 /DA 0 /TW 0 /DD 0 /CM 0 /R1 0 /R2 0 /POSSIBLE FUTURE SPARE--POSITION 42 /A001 OCTAL   / WPPARS--PARSER FOR SPECIFICATION OF SEARCH AND SELECT / / 018 RCME 03-Jul-85 Re-program comparison of keywords / to give greater flexibility in / changing text for foreign versions / 017 RCME 03-APR-85 Enable parsing of technical and / multinational characters. Fix dead / key blot substitution. / / ----------------------- All below refer to V2.0 and earlier -------------- / / 016 HLP 13-SEP-83 Delete PRLOCK, DECmate is single user / WPPARS CONSTANTS CR=15 / CARRIAGE RETURN LF=12 / LINE FEED CDFMYF=CDFEDT / This routine runs in the EDITOR FIELD FIELD 3 *100 / FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM DCAGPB=JMS I .;XDCAGP / Routine to access the GPBUF in LP field/a017 TADGPB=JMS I .;XTADGP / Routine to access the GPBUF in LP field/a017 ORPTR, 0 TOEFLG, 0 ERRCNT, 0 DISDKY, 0 DISCNT, -121 NEGSPC, -40 /a017 PZERR, ERR / GENERAL ERROR MESSAGE PZNRM, NOROOM / NO MORE ROOM MESSAGE NUMFLD, 0 / NUMERICAL FIELD FLAG 0=NOT A NUMERIC FIELD / ELSE IS A NUMERIC FIELD X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / PARSES A SPEC FILE AND LOADS THE RESULT INTO CORE. PARSE, XX CDFBUF / BUFFER FIELD HAS FILE NUMBERS CLA TAD I (FORMNO) / GET FORM FILE NUMBER CDFMYF / SET DATA FIELD SNA CLA / 0, MEANING JUST TEST SPEC SYNTAX? AC7777 / YES, SET FLAG TO TEST MODE DCA TOEFLG / SET OR CLEAR FLAG CIFMNU / OVERLAY THE SELCT PROGRAM JMS I OLAYCL / INTO FIELD 5 7 DCA ERRCNT / CLEAR ERROR COUNT DCA DISDKY / AND DEADKEY FLAG TAD (-121) / SET LINE COUNTER FOR DISPLAY ROUTINE DCA DISCNT JMS CLS / CLEARS SCREEN AND HOMES CURSOR CDFBUF / STORED IN BUFFER FIELD TAD I (SPCADR) / GET SPEC FILE NUMBER DCA ORPTR / STORE ANY PLACE LOCAL TAD I ORPTR / FOR INDIRECT CDFMYF / BACK HOME DCA SPECNO TAD SPECNO CIFFIO / OPEN FILE FOR READING FILEIO / XRDFIN TAD (SPECTB-1) / SET-UP SPEC TABLE PTR DCA SPCPTR TAD (SPCTBS+1) / AND COUNTER CIA DCA SPCCNT TAD (SYMTAB) / SET-UP SYMBOL TABLE PTR DCA SYTPTR TAD (SYTBSZ+1) / AND COUNTER CIA DCA SYTCNT TAD (CHRCOR-1) / SET-UP CHARACTER SPACE PTR DCA CHRPTR TAD (CHRCSZ+1) / AND COUNTER CIA DCA CRCNT JMS PSTSYM / STORE TRAILING 0 IN SYMBOL TABLE JMP I PZNRM / NO ROOM JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH < TAD ("P-200) / SEE IF CHAR IS 'P' ? > IFDEF ITALIAN < TAD ("E-200) / SEE IF CHAR IS 'E' ? > JMS PCMPAR / COMPARE JMP PIF1 / NO, MUST START WITH 'IF' THEN JMP PTHEN1 / YES, FINISH PARSE PIF, JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE PIF1, IFDEF ENGLSH / SEE IF CHAR IS 'I' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'F' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (4001) / STORE -1 FOR IF TYPE PAMLP, JMS PSTSPC JMP I PZNRM / NO ROOM JMS PRSFN / GO FIND AND STORE A FN IN THE SYM TAB JMP I PZERR / PROBLEMS!! AC0001 / STORE 1 FOR OR-COUNT JMS PSTSPC JMP I PZNRM / NO ROOM TAD SPCPTR / GET LOCATION OF OR-COUNT DCA ORPTR / AND SAVE IT POR, JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("=-200) / SEE IF CHAR IS '=' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PRSTRG / GO STORE STRING (FIELD) JMP I PZERR JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP PTHEN / NO MATCH RETURN, SEE IF THEN STATEMENT JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE / THE FOLLOWING 7 LINES WHERE MOVED HERE FROM ANOTHER PAGE IFDEF ENGLSH < TAD ("R-200) / SEE IF CHAR IS 'R' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > CDFLP / ADD ONE TO OR-COUNT ISZ I ORPTR CDFMYF JMP POR / AND STORE STRING SPECNO, 0 / SPEC FILE NUMBER ERRMTB, S2NRM S1SYN S0NUM / 'ERROR IN NUMBER' X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PTHEN, TAD THENST / GET THE FIRST CHARACTER TO COMPARE /A018 JMS PCMPAR / COMPARE /A018 JMP PBUTN / NO MATCH, SEE IF NOT COMMAND /A018 TAD (THENST+1) / GET THE START OF THE STRING /A018 DCA THENCT / SAVE IT IN THE COUNTER /A018 PTHENL, TAD I THENCT / GET THE NEXT CHARACTER TO COMPARE /A018 SNA CLA / IS THIS THE END OF THE STRING? /A018 JMP THENOK / YES, FINISHED COMPARE /A018 JMS PGTCHR / GET A CHARCTACTER /A018 JMP I PZERR / EOF /A018 MQL / SAVE FOR COMPARE /A018 TAD I THENCT / GET THE OTHER CHAR BACK /A018 JMS PCMPAR / NO, DO THE COMPARE /A018 JMP I PZERR / NO MATCH FOUND /A018 ISZ THENCT / INCRAMENT THE STRING POINTER /A018 JMP PTHENL / GO ROUND FOR THE NEXT CHARACTER /A018 THENOK, /D018 PTHEN, TAD ("T-200) / SEE IF CHAR IS 'T' ? /D018 JMS PCMPAR / COMPARE /D018 JMP PBUTN / NO MATCH, SEE IF BUT NOT /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("H-200) / SEE IF CHAR IS 'H' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("N-200) / SEE IF CHAR IS 'N' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("P-200) / SEE IF CHAR IS 'P' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN PTHEN1, TAD (ROCEST) / GET THE ADDRESS OF THE COMPARISON STRING/A018 DCA PROCCT / SAVE IT /A018 ROCESL, TAD I PROCCT / GET THE CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARISON? /A018 JMP PROCOK / YES, EXIT COMPARE /A018 JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE /M018 TAD I PROCCT / GET ORIGINAL CHARACTER BACK /A018 JMS PCMPAR / COMPARE /A018 JMP I PZERR / NO MATCH RETURN /A018 ISZ PROCCT / MOVE TO NEXT CHARACTER /A018 JMP ROCESL / AND LOOP /A018 /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("O-200) / SEE IF CHAR IS 'O' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("C-200) / SEE IF CHAR IS 'C' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("C-200) / SEE IF CHAR IS 'C' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("O-200) / SEE IF CHAR IS 'O' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTCHR / GET A CHAR /D018 JMP I PZERR / EOF /D018 MQL / SAVE FOR COMPARE /D018 TAD ("D-200) / SEE IF CHAR IS 'D' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN PROCOK, JMS PGTCHR / GET A CHAR JMP PARDN / EOF, DONE SPEC MQL / SAVE FOR COMPARE TAD (SPECTB-1) / SEE IF SPECTB IS EMPTY CIA TAD SPCPTR SNA CLA JMP I PZERR / NO, CAN ONLY HAVE 'PROCESS RECORD' JMP PORIF / YES, SEE IF 'OR IF' PROCCT, / COUNTER INTO ROCESS RECORD STRING /A018 THENCT, 0 / COUNTER INTO THEN STRING /A018 THENST, IFDEF ENGLSH < "T-200; "H-200; "E-200; "N-200; "P-200; 0> /A018 IFDEF ITALIAN< "A-200; "L-200; "L-200; "O-200; "C-200; "A-200; "E-200; 0> ROCEST, IFDEF ENGLSH < "R-200; "O-200; "C-200; "E-200; "S-200; "S-200; /A018 "R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0> /A018 IFDEF ITALIAN< "L-200; "A-200; "B-200; "O-200; "R-200; "A-200; "I-200; "L-200 "R-200; "E-200; "C-200; "O-200; "R-200; "D-200; 0> X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PORIF, TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("R-200) / SEE IF CHAR IS 'R'? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > JMP PIF / LOOP BACK TO BEGINNING PBUTN, IFDEF ENGLSH / SEE IF CHAR IS 'B' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP PAND / NO MATCH RETURN, SEE IF AND TYPE JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'U' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'T' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'N' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'O' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'T' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE IFDEF ENGLSH / SEE IF CHAR IS 'I' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("F-200) / SEE IF CHAR IS 'F' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > TAD (2003) / STORE 3 FOR BUT NOT IF TYPE JMP PAMLP PAND, IFDEF ENGLSH / SEE IF CHAR IS 'A' ? IFDEF ITALIAN JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN IFDEF ENGLSH < JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("N-200) / SEE IF CHAR IS 'N' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("D-200) / SEE IF CHAR IS 'D' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > TAD (4002) / STORE -2 FOR AND TYPE JMP PAMLP / LOAD WORD IN AC INTO SPEC TABLE USING SPCPTR AS A PTR. / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTSPC, XX ISZ SPCCNT / ANY ROOM LEFT JMP .+2 JMP I PSTSPC / NO, ERROR RETURN CDFLP / GET TO RIGHT FIELD DCA I SPCPTR / STORE CDFMYF / BACK TO LEFT FIELD ISZ PSTSPC / MAKE RETURN SUCCESSFUL JMP I PSTSPC / RETURN SPCCNT, 0 / LOAD WORD IN AC INTO SYMBOL TABLE, DOES NOT INCREMENT SYTPTR / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTSYM, XX DCA PSYMCR / SAVE CHAR ISZ SYTCNT / ANY ROOM LEFT JMP .+2 JMP I PSTSYM / NO, ERROR RETURN TAD SYTPTR / YES, GET ADDR TO STORE INTO DCA PSYMTP / SAVE FOR INDIRECT TAD PSYMCR / GET BACK CHAR CDFLP / GET TO RIGHT FIELD DCA I PSYMTP / STORE CDFMYF / BACK TO LEFT FIELD PSTSYR, ISZ PSTSYM / MAKE RETURN SUCCESSFUL JMP I PSTSYM / RETURN PSYMCR, 0 PSYMTP, 0 SYTCNT, 0 / LOAD WORD IN AC INTO CHARACTER CORE USING CHRPTR AS A PTR. / SKIP RETURNS IF STORED, JUST RETURNS IF NO ROOM PSTCHR, XX ISZ CRCNT / ANY ROOM LEFT JMP .+2 JMP I PSTCHR / NO, ERROR RETURN CDFLP / GET TO RIGHT FIELD DCA I CHRPTR / STORE CDFMYF / BACK TO LEFT FIELD ISZ PSTCHR / MAKE RETURN SUCCESSFUL JMP I PSTCHR / RETURN CRCNT, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / READS A FIELD NAME, CHECKS TO SEE IF IT IS ALREADY IN THE SYMBOL TABLE, LOADS / IT INTO THE SYMBOL TABLE AND STORES A PTR TO THE ENTRY IN THE SPEC TABLE. PRSFN, XX CLA JMS PGTCHR / GET A CHAR JMP I PZERR / EOF MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (GPBUF-1) / SET-UP PTR IN AUTO-INDEX DCA GPPTR TAD (GPBSIZ+1) / SET-UP SIZE COUNTER CIA DCA GPCNT AC7777 JMS PGTCHR / GET NEXT CHAR JMP I PRSFN / EXIT IF END OF FILE DCA PFNCHR / SAVE IT TAD PFNCHR / IF CHAR=':' TAD (-":+200) / SNA CLA / AC0001 / THEN NUMFLD = 1 ( IS A NUMERIC FIELD) DCA NUMFLD / ELSE NUMFLD = 0 (NOT A NUMERIC FIELD) JMP LFNLP1 / CONTINUE WITH NEXT CHARACTER LFNLP, AC7777 / SET FLAG TO GET 'ALL' CHARS JMS PGTCHR / GET NEXT CHAR JMP I PRSFN / EOF DCA PFNCHR / SAVE IT LFNLP1, TAD PFNCHR TAD (-76) / SEE IF '>' SNA JMP LFNDN / YES, DONE FIELD TAD (2) / SEE IF '<' SNA CLA JMP ERR1 / YES, NOT ALLOWED TAD DISDKY / Check the dead key status /a017 SNA CLA / Are we processing a dead key sequence?/a017 ISZ GPCNT / NO, SEE IF ROOM JMP .+2 JMP ERR2 / NO, SO TELL USER TAD PFNCHR / GET BACK CHAR DCAGPB / AND STORE IN STRING JMP LFNLP / LOOP BACK FOR MORE LFNDN, TAD GPCNT / GET COUNT OF WORDS USED TAD (GPBSIZ+1) SNA JMP NULL / EOR, JUST '<>' FOUND DCA FNCNT / SAVE FN LENGTH DCAGPB / STORE TRAILING 0 TAD (SYMTAB-1) / GET SYMBOL TABLE ADR - 1 DCA SYTPTR / PUT IN AUTO-INDEX SYTBLK, CDFLP / GO TO WHERE THE TABLE IS TAD I SYTPTR / GET AN ENTRY CDFMYF / COME BACK SNA JMP PNFN / LAST ONE, SO MAKE A NEW ENTRY DCA SYTSRC / OTHERWISE, STORE FOR COMPARE TAD FNCNT / GET SIZE OF FN TO SEARCH JMS XSCMP / SEE IF MATCHES GPBUF SYTSRC, XX CDFLP / FIELD OF SYMTAB FOR COMPARE SZA CLA JMP POFN / YES, FOUND AN ENTRY ISZ SYTPTR / NOPE, BUMP PTR JMP SYTBLK / TRY NEXT ENTRY POFN, CDFLP / DON'T FORGET TO CHANGE FIELDS ! TAD I SYTPTR / GET ADDR FN POINTS TO CDFMYF / AND TO CHANGE FIELD BACK JMS PSTSPC / STORE LINK IN SPEC TAB JMP I PZNRM / NO ROOM TAD SPCPTR / GET ADDR OF SPEC ENTRY JMS PSTSYM / AND MAKE IT NEW FN PTR IN SYM TAB JMP I PZNRM / NO ROOM ISZ PRSFN / NO ERRORS, RETURN JMP I PRSFN PNFN, TAD (GPBUF-1) / RESET GP PTR DCA GPPTR AC0001 / GET ADDR THAT FN WILL BE TAD CHRPTR / IN CHR CORE JMS PSTSYM / AND STORE AS PTR TO FN JMP I PZNRM / NO ROOM ISZ SYTPTR / BUMP PTR PNFNLP, TADGPB / GET A CHAR SNA / LAST ONE? JMP PNFNDN / YES, STORE FINAL STUFF JMS PSTCHR / NO, STORE CHARACTER JMP I PZNRM / NO ROOM JMP PNFNLP / BACK FOR MORE PNFNDN, JMS PSTCHR / STORE TRAILING 0 JMP I PZNRM / NO ROOM JMS PSTSPC / STORE 0 LINK JMP I PZNRM / NO ROOM TAD SPCPTR / GET ADDR OF SPEC ENTRY JMS PSTSYM / STORE IN SYM TAB AS FN PTR JMP I PZNRM / NO ROOM ISZ SYTPTR / BUMP PTR AC7777 / DON'T COUNT TRAILING ZERO TAD SYTCNT / AS PART OF SYMBOL TABLE COUNTER DCA SYTCNT JMS PSTSYM / STORE FINAL 0 JMP I PZNRM / NO ROOM ISZ PRSFN / NO ERRORS RETURN JMP I PRSFN NULL, AC7777 / -1 FOR EOR JMP I PZERR ERR2, AC0001 / 2FOR FIELD NAME TOO LARGE ERR1, IAC / 1FOR '<' FOUND BEFORE '>' IN FN JMP I PZERR FNCNT, 0 GPCNT, 0 PFNCHR, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / DOES A MATCH OF AN ASCII AND AN ASCIZ STRING. RETURNS AC OF 0 IF FAILED / AND -1 IF MATCHES. CALLED WITH AC EQUAL TO NUMBER OF CHARACTERS IN THE / 1ST STRING (ASCII) TO TRY TO MATCH / JMS XSCMP / ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD) / ADDR OF 2ND STRING -ASCIZ / FIELD FOR 2ND STRING / RETURN (TO THSFLD) XSCMP, XX CIA / MAKE NEGATIVE NUMBER OF CHARS TO SEARCH DCA XSCNT AC7777 TAD I XSCMP / GET ADDR OF 1ST STRING DCA TAI1 / SET-UP AUTO-INDEX ISZ XSCMP / MOVE TO NEXT ARG AC7777 TAD I XSCMP / ADDR OF SECOND STRING DCA TAI2 ISZ XSCMP TAD I XSCMP / GET CDF FOR STRINGS /m017 DCA XSCLP / SET-UP TO EXECUTE TAD XSCLP / Also for 1st string /a017 DCA XS1CLP / /a017 ISZ XSCMP / MAKE SURE WE RETURN TO THE RIGHT PLACE TAD XSCLP / GET THE CDF BACK DCA XSCLP1 / AND STORE CAUSE WE'LL NEED IT AGAIN XSCLP, XX / FOR THE CDF TAD I TAI2 / CHAR FROM 2ND STRING CDFMYF / BACK TO HOME FIELD SNA / SEE IF END OF STRING JMP I XSCMP / YES, SO RETURN WITH 0 IN AC CIA / NO, NEGATE XS1CLP, XX / For the CDF /a017 TAD I TAI1 / CHAR FROM 1ST STRING CDFMYF / Back to home field /a017 SZA CLA / ARE THEY THE SAME? JMP I XSCMP / NOPE, RETURN WITH A 0 IN AC ISZ XSCNT / DID WE LOOK AT ENOUGH CHARS? JMP XSCLP / NO, COMPARE SOME MORE XSCLP1, XX / YES, DO THE CDF TAD I TAI2 / MAKE SURE WE'RE AT THE END CDFMYF / BACK TO HOME FIELD SNA CLA / 0, FOR NOT AT THE END OF STRING AC7777 / -1 FOR SUCCESS JMP I XSCMP / RETURN XSCNT, 0 / READS IN A CHARACTER AND RETURNS IT IN THE AC / IF AC=0 THEN IGNORES ALL BLANKS, TABS, RULERS, ETC. / IF AC= -1 THEN ONLY DELETES RULERS, FUNNY SPACES AND LINE FEEDS / CALLED BY: / JMS PGTCHR / EOF RETURN (AC UNDEFINED) / REGULAR RETURN (AC CONTAINS CHAR) PGTCHR, XX DCA PGTDLA / SAVE FLAG PGTLP, JMS RDNXCH / GET A CHAR JMP I PGTCHR / EOF, GIVE RETURN DCA SSCHAR / SAVE CHAR TAD SSCHAR AND P177 / NO CONTROLS TAD (-41) / SEE IF PRINTING CHAR SPA JMP SSPCHR / NOPE, SPECIAL TAD (41) / YES, GET CHAR BACK JMS DISCHR / SHOW CHAR ON SCREEN ISZ PGTCHR / MAKE RETURN NORMAL JMP I PGTCHR / AND RETURN SSPCHR, TAD (25) / NO, SEE IF A FF (14) SNA JMP SSCPC / YES, NOW CHECK IF SPECIAL TAD (-2) / NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SSDLRR / YES, GO DELETE RULER TAD SSCHAR / NO, GET CHAR BACK AND (7600) / SEE IF HIGH PART ON SZA CLA JMP PGTLP / YES, SO IGNORE IT TAD SSCHAR / NO, GET CHAR ONCE MORE TAD (-7) / SEE IF ^G (MODIFIED FLAG) ? SNA CLA JMP PGTLP / YES, JUST IGNORE PGTCRR, TAD SSCHAR / GET CHAR TO RETURN WITH JMS DISCHR / SHOW CHAR ON SCREEN MQL / SAVE CHAR TAD PGTDLA / CHECK DELETE 'ALL' FLAG SNA CLA JMP PGTLP / YES, IGNORE CHARACTER MQA / NO, GET CHAR BACK ISZ PGTCHR / BUMP RETURN JMP I PGTCHR / RETURN SSCPC, TAD SSCHAR / SEE IF START OF PRINTER CONTROL TAD (-1014) SZA CLA / YES, GO SKIP ENTIRE THING JMP PGTCRR / NO, MUST HAVE BEEN NORMAL FF SSCPC1, JMS RDNXCH / GET A CHAR JMP I PGTCHR / ERROR, EOF TAD (-1414) / SEE IF END YET SZA CLA JMP SSCPC1 / NO, KEEP LOOKING JMP PGTLP / YES, BACK TO NORMAL PROCESSING SSDLRR, JMS RDNXCH / GET A CHAR JMP I PGTCHR / ERROR TAD (-17) / END OF RULER? SZA CLA JMP SSDLRR / NO, KEEP LOOKING JMP PGTLP / YES, BACK TO NORMAL PROCESSING SSCHAR, 0 PGTDLA, 0 RDNXCH, XX / SIMULATE RDFIL CLA CIFFIO / FILEIO / XRDFNC SZA ISZ RDNXCH JMP I RDNXCH OUTCHR, XX / OUTPUTS THE CHAR IN THE AC TO THE SCREEN AND P377 JMP OUTCH2 OUTCH1, CIFSYS / ++++ JWAIT OUTCH2, CIFSYS / ++++ TTYOU JMP OUTCH1 CLA JMP I OUTCHR IFDEF FRENCH < FS1SYN, / a"GRAV A" appears between the above and the below in french TEXT " PARTIR DE CE POINT" /L.A.E, L.G.A > IFDEF CANADA < CS1SYN, / aL.G.A appears before this string (pretend) TEXT " PARTIR DU SIGNE ^." > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / The GPBUF has been moved to Field 5 (the LP field) to allow /a017 / space to handle multinational and technical characters in field /a017 / names. /a017 / /d017 GPBUF, ZBLOCK GPBSIZ+1 DISCHR, XX / DISPLAYS CHAR IN AC ON SCREEN (WITH CR, LF SEQUENCES) DCA DISSCR / SAVE CHAR TAD DISSCR / CHECK FOR CR RIGHT AWAY TAD (-15) SNA CLA JMP DISLIV / YES, END OF DEADKEY TAD DISDKY / SEE IF IN MIDDLE OF DEADKEY SEQUENCE SZA CLA JMP INDEAD / YES, DEAL WITH CHARACTER /M017 TAD DISSCR TAD (-10) / BACKSPACE ? SNA JMP DISDOA / YES, START OF DEADKEY TAD (10-12) / SEE IF LF SZA CLA JMP DISCH1 / NO JMS DISCLF / YES, OUTPUT A CR-LF DISCH3, TAD DISSCR / GET CHAR BACK JMP I DISCHR / AND RETURN DISCH1, ISZ DISCNT / END OF LINE ANYWAY ? JMP DISCH2 / NO JMS DISCLF / YES, OUTPUT CR-LF AND RESET COUNTER JMP DISCH1 / TRY AGAIN DISCH2, TAD DISSCR / GET CHAR DISOAL, JMS OUTCHR / OUTPUT IT /M017 JMP DISCH3 / AND RETURN DISDOA, AC7777 / SET THE DEAD KEY FLAG DCA DISDKY /D017 JMS OSTRG / GOTO OUTPUT STRING ROUTINE /D017 ESC / START ESCAPE SEQUENCE TO SCREEN /D017 "[-200 / NEED "[" ONLY IN ANSI MODE /D017 "F-200 / "F" MEANS GOTO GRAPHIC CHARACTER SET /D017 "G-140 / DEADKEY SYMBOL /D017 ESC / GO BACK TO ANSI CHARACTER SET /D017 "[-200 / NEAD "[" ONLY IN ANSI MODE /D017 "G-200+4000 / G (+4000 MEANS END OF STRING) JMP DISCH3 / GET CHAR BACK AND RETURN DISLIV, DCA DISDKY / TURN OFF DEADKEY FLAG TAD (17) / OUTPUT SI IF DEAD KEY FINISHED TO /A017 / CLEAN UP AFTER LINE DRAWING SET MODE /A017 JMP DISOAL / CHAR BACK AND RETURN /M017 DISCLF, XX / OUTPUTS A CR-LF AND RESETS DISCNT BACK TO A FULL LINE JMS OSTRG / OUTPUT STRING ROUTINE CR / CARRIAGE RETURN LF+4000 / LINE FEED (4000 MEANS END OF STRING) TAD (-121) / RESET LINE COUNTER DCA DISCNT JMP I DISCLF / AND RETURN DISDCH, CLL RAL / Check that this is the 3rd character /a017 SNA CLA / Is this 3rd character? /a017 JMP DISCH2 / Yes, output it. /a017 JMP DISCH3 / No, accept and ignore it as is /a017 / trailing rubbish. /a017 GLDSPC, AC4000 / Deal with GOLD spaces. Is not dead key/a017 DCA DISDKY / sequence, so set flag to ignore rest. /a017 JMP DISCH2 / Display the space. /a017 /**************************************************************************** / / The following code handles dead key sequences found in the /a017 / list processing document. Technical and multinational /a017 / characters are now displayed using the correct character sets /a017 / and user dead key sequences are depicted by the conventional /a017 / blot rather than the +/- symbol previously used. /a017 / /**************************************************************************** INDEAD, ISZ DISDKY / This piece of code is used for each /a017 / character within the dead key sequence/a017 / Is this the first character in sequence?/a017 JMP INDNOT1 / No, deal with others /a017 ISZ DISDKY / Yes, set the dead key flag again /a017 TAD DISSCR / Get the character /a017 TAD NEGSPC / Test for space character /a017 SNA CLA / Is it a space? /a017 JMP DISCH3 / Yes, accept and forget it /a017 JMS OSTRG / Output the escape sequence to send a /a017 ESC / blob to the screen. /a017 "[-200 / ESC [ F puts us into graphics mode /a017 "F-200 / /a017 "a-200 / "a" in line drawing set is blob /a017 ESC / ESC [ G returns us to ASCII mode /a017 "[-200 / /a017 "G-200+4000 / +4000 is the end of string marker /a017 AC4000 / Set top bit of the dead key flag to /a017 DCA DISDKY / indicate a user dead key that requires/a017 JMP DISCH3 / no further processing /a017 INDNOT1,TAD DISDKY / Check the top bit of the flag for user/a017 SPA / Is this a user dead key sequence? /a017 JMP DISCH3 / Yes, ignore all further characters. /a017 CLL RTR / No, test for the 2nd char in sequence /a017 SZA / Is this the 2nd character? /a017 JMP DISDCH / No, its a later one. /a017 TAD DISSCR / Yes, get it. /a017 TAD NEGSPC / Test for a GOLD space /a017 SNA / Is it a GOLD space? /a017 JMP GLDSPC / Yes, deal with it /a017 TAD (-23) / No, test character set specifier /a017 SNA / Is it a technical character? /a017 JMP DISDTC / Yes, go send a SS3 /a017 IAC / Test for multinational character set /a017 SNA CLA / Is it multinational? /a017 JMP DISDMC / Yes, output a SS2 /a017 JMP DISDLC / No, is line drawing, so output SO /a017 DISDTC, AC0001 / Build value 217 for technical char /a017 DISDMC, TAD (200) / Build value 216 for multinational char/a017 DISDLC, TAD (16) / Build value 16 for a line drawing char/a017 JMP DISOAL / Output the built value to the screen /a017 DISSCR, 0 PARDN, JMS PSTSPC / STORE FINAL 0 IN SPEC TABLE JMP I PZNRM / NO ROOM TAD TOEFLG / TEST MODE? SZA CLA JMP NOERRT / YES, RETURN TO MAIN MENU TAD PARSE / NO, STORE AWAY RETURN ADDR CDFBUF DCA I (RETADR) CDILP / NOW GET TO RIGHT FIELD JMP I (SELINI) / AND JUMP TO START OF SELECT PROGRAM XDCAGP, XX / Routine to store AC to GPBUF in LP field/a017 CDFLP / Change to LP data field /a017 DCA I GPPTR / Save at the word pointed to /a017 CDFMYF / Back to home field /a017 JMP I XDCAGP / And return /a017 XTADGP, XX / Routine to add word in GPBUF to AC /a017 CDFLP / Change to LP data field /a017 TAD I GPPTR / Add word pointed to by GPPTR /a017 CDFMYF / Back to home field /a017 JMP I XTADGP / Return /a017 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / STORES A STRING IN CHAR CORE / CALLED BY: / JMS PRSTRG / EOF RETURN / REGULAR RETURN PRSTRG, XX AC0001 / GET PTR TO STRING IN CHR CORE TAD CHRPTR JMS PSTSPC / AND STORE IN STRING PTR WORD OF SPEC JMP I PZNRM DCA PSCNT / INIT S-COUNT DCA PMCNT / M-COUNT DCA PECNT / AND E-COUNT TAD (ISZ PSCNT) / INIT ISZ WORD DCA PCNTWD AC7775 / AND NUMBER OF <*> ALLOWED DCA PRWCNT PRSTLP, AC7777 / SET FLAG TO GET 'ALL' CHARS JMS PGTCHR / GET A CHAR PRSTRT, JMP I PRSTRG / EOF, GIVE ERROR RETURN TAD (-12) / SEE IF NEWLINE SNA JMP PRSTDN / YES, END OF STRING TAD (-62) / NO, SEE IF '<' ? SNA JMP PRSTWC / YES, PARSE WILD CARDS AND NUMBERS TAD (12+62) / NO, GET CHAR BACK PRSTL1, JMS PSTORE / AND STORE IT AWAY JMP I PZNRM / NO ROOM JMP PRSTLP / BACK FOR MORE PRSTWC, AC7777 / SET FOR 'ALL' CHARS JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, ERROR RETURN TAD (-52) / SEE IF '*' ? SNA JMP PRSTW1 / YES, BUMP TO NEXT COUNT WORD TAD (-25) / NO, SEE IF '?' ? SZA JMP PRSTNM / MUST BE A NUMBER PRSTW3, AC7777 JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, RETURN TAD (-77) / SEE IF ANOTHER '?' ? SNA JMP PRSTW2 / YES, GO STORE IT IAC / NO, BETTER BE '>' SZA CLA JMP I PZERR / NO, ERROR AC7777 / YES, STORE CODE FOR ? WILD CARD JMP PRSTL1 PRSTW1, ISZ PRWCNT / BUMP WILD CARD COUNT JMP .+2 JMP I PZERR / TOO MANY <*> WILD CARDS AC7777 JMS PGTCHR / GET CHAR JMP I PRSTRG / EOF, RETURN TAD (-76) / BETTER BE '>' SZA CLA JMP I PZERR / NO, ERROR ISZ PCNTWD / MOVE COUNTER TO NEXT WORD JMP PRSTLP / PROCESS REST OF LINE PRSTW2, AC7777 / STORE CODE FOR ? WILD CARD JMS PSTORE JMP I PZNRM / NO ROOM JMP PRSTW3 / LOOK FOR MORE '?' PRSTDN, AC0001 / SEE IF ANY WILD CARDS TAD PRWCNT SZA JMP PRSTD1 / 0OR 1, GO HANDLE PRSTD4, TAD PSCNT / 3, GET S-COUNT CIA / NEGATE CAUSE ALPHANUMERIC PRSTD2, JMS PSTSPC / AND STORE IN SPEC S-COUNT JMP I PZNRM / NO ROOM TAD PMCNT / SAME FOR M-COUNT CIA JMS PSTSPC JMP I PZNRM TAD PECNT / GET E-COUNT CIA PRSTD5, JMS PSTSPC / AND STORE IT JMP I PZNRM ISZ PRSTRG / NORMAL RETURN JMP I PRSTRG PRSTD1, IAC / DETERMINE IF ANY WILD CARDS SNA CLA JMP PRSTD3 / YES, 1, GO SWITCH COUNTS TAD PSCNT / 0IF NULL SEARCH, COUNT IF PLAIN SEARCH DCA PECNT / STORE IN E-COUNT AC0002 / STORE -2 IN M-COUNT DCA PMCNT AC0001 / STORE +1 IN S-COUNT JMP PRSTD2 / GO STORE PRSTD3, TAD PMCNT / DON'T REALLY WANT THIS IN M-COUNT DCA PECNT / SO MOVE TO E-COUNT DCA PMCNT / AND CLEAR M-COUNT JMP PRSTD4 / GO STORE COUNT WORDS PSTORE, XX / STORE CHAR AND BUMP THE RIGHT COUNTER PCNTWD, XX / FOR ISZ OF S, M, OR E COUNT JMS PSTCHR / STORE CHAR JMP I PZNRM / NO ROOM, ERROR RETURN ISZ PSTORE / BUMP RETURN JMP I PSTORE / RETURN PRWCNT, 0 PSCNT, 0 / ORDER IMPORTANT PMCNT, 0 PECNT, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / READS IN A CHARACTER FROM THE CURRENTLY OPEN FILE IGNORING ALL CHARACTERS / LESS THAN ASCII 41, EXCEPT FOR NEWLINE (ASCII 12). / CALLED BY: / JMS PGTNMC / EOF RETURN / REGULAR RETURN (AC=0 MEANS NEWLINE / ELSE CHAR RETURNED IN AC) PGTNMC, XX AC7777 / GET ALL CHARS JMS PGTCHR JMP I PGTNMC / EOF RETURN TAD (-12) / SEE IF NEWLINE SNA JMP PGTNM1 / YES, RETURN WITH AC = 0 TAD (-27) / NO, LESS THAN 41 ASCII ? SPA JMP PGTNMC+1 / YES, IGNORE CHAR TAD (12+27) / NO, GET CHAR BACK PGTNM1, ISZ PGTNMC / AND RETURN WITH IT JMP I PGTNMC PRSNLP, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YEP ! PRSNL1, TAD (-76) / SEE IF '>' ? SNA JMP PRSNXT / YES, PARSE REST OF NUMBER TAD (2) / NO, SEE IF '<' ? SNA JMP I PZERR / YES, NOT ALLOWED TAD (2) / NO, SEE IF ASCII 9 OR LESS SMA JMP PRSNLP / NO, SKIP IT TAD (12) / YES, SEE IF ASCII 0 OR MORE PRSNSZ, XX / MODIFIED TO IGNORE LEADING ZEROES JMP PRSNLP / SKIP CHAR TAD (60) / MAKE ASCII AGAIN ISZ NUMSIZ / SEE IF TOO LARGE JMP .+2 JMP I PZERR / YES JMS PSTORE / NO, STORE CHAR JMP I PZNRM / NO ROOM TAD (SPA) / TURN OFF ZERO SUPRESSION DCA PRSNSZ JMP PRSNLP / GET ANOTHER CHAR NUMSIZ, 0 PRSNXT, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP PRNMDN / YES, GO FINISH UP MQL / SAVE FOR COMPARE TAD PRWCNT / SEE IF SECOND PART OF 'THRU' SZA CLA JMP I PZERR / YES, SHOULDN'T BE HERE TAD ("O-200) / NO, SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP PTHRU / NO MATCH, SEE IF THRU IFDEF ENGLSH < JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("R-200) / SEE IF CHAR IS 'R' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN > JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD MOREST / SEE IF CHAR IS 'M' ? JMS PCMPAR / COMPARE JMP PLESS / NO MATCH, SEE IF LESS TAD (MOREST+1) / GET THE START OF THE MORE STRING /A018 DCA MORECT / SAVE IT IN THE COUNTER /A018 MORELP, TAD I MORECT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP MOREOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I MORECT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ MORECT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP MORELP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN MOREOK, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SZA CLA / SEE IF NEWLINE ? JMP I PZERR / NO JMP PRNMD1 / YES, GO FINISH UP MORECT, 0 / POINTER INTO MORE STRING /A018 MOREST, IFDEF ENGLSH < "M-200; "O-200; "R-200; "E-200; 0 > IFDEF ITALIAN< "M-200; "A-200; "G-200; "G-200; "I-200; "O-200; "R-200; "E-200; 0 > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE PLESS, TAD LESSST / SEE IF CHAR IS 'L' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (LESSST+1) / GET THE START OF THE MORE STRING /A018 DCA LESSCT / SAVE IT IN THE COUNTER /A018 LESSLP, TAD I LESSCT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP LESSOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I LESSCT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ LESSCT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP LESSLP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("E-200) / SEE IF CHAR IS 'E' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("S-200) / SEE IF CHAR IS 'S' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN LESSOK, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SZA CLA / SEE IF NEWLINE ? JMP I PZERR / NO TAD PECNT / YES, MOVE E-COUNT TO M-COUNT DCA T1 DCA PECNT / AND ZERO E-COUNT TAD T1 JMP PRNMD1 / GO FINISH UP PTHRU, TAD THROST / SEE IF CHAR IS 'T' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN TAD (THROST+1) / GET THE START OF THE MORE STRING /A018 DCA THROCT / SAVE IT IN THE COUNTER /A018 THROLP, TAD I THROCT / GET THE NEXT CHAR TO COMPARE AGAINST /A018 SNA CLA / IS THIS THE END OF THE COMPARE? /A018 JMP THROOK / YES, ALL DONE /A018 JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE /M018 TAD I THROCT / GET THE COMPARISON CHAR BACK /A018 JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN ISZ THROCT / INCRAMENT THE COMPARISON STRING COUNT /A018 JMP THROLP / AND GET THE PREVIOUS CHARACTER /A018 /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("H-200) / SEE IF CHAR IS 'H' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN /D018 JMS PGTNMC / GET A CHAR /D018 JMP PRSTRT / EOF /D018 SNA / SEE IF NEWLINE ? /D018 JMP I PZERR / YES, OUT OF SYNC /D018 MQL / SAVE FOR COMPARE /D018 TAD ("R-200) / SEE IF CHAR IS 'R' ? /D018 JMS PCMPAR / COMPARE /D018 JMP I PZERR / NO MATCH RETURN THROOK, IFDEF ENGLSH < JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("U-200) / SEE IF CHAR IS 'U' ? JMS PCMPAR / COMPARE JMP POUGH / NO MATCH,SEE IF OTHER WAY TO SPELL THRU > JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN PTHRU1, AC7777 / MOVE COUNT WORD BACK TAD PCNTWD / TO ADD INTO M-COUNT DCA PCNTWD ISZ PRWCNT / SET FLAG FOR DONE 1ST HALF OF THRU TAD (-GPBSIZ-1) / RE-INIT NUMBER SIZE COUNTER DCA NUMSIZ TAD NUMFLD / IF NUMERIC FIELD SZA CLA / JMP PTHRU2 / THEN USE NEW NUMERIC ROUTINE TAD (SPA SNA) / ELSE SET FOR LEADING ZERO SUPRESSION DCA PRSNSZ / JMP PRSNLP / AND GET 2ND HALF OF THRU PTHRU2, TAD (TOKVAL-1) / SET UP POINTER TO TOKVAL IN MATH FIELD DCA TAI1 / JMP PRSNL3 / IFDEF FRENCH < / FSPECL / Routine to process a special French string FSPECL, XX CLA / Clear the AC (insurance) TAD ERRMES / Get the error message TAD (-S1SYN) / Get the special message SZA CLA / Is it the special message? JMP I FSPECL / No, continue as usual. TAD (16) / Shift out (to alternate graphics) JMS OUTCHR TAD (141) / Print an "GRAV A" JMS OUTCHR TAD (17) / Shift back (to base character set) JMS OUTCHR JMS OUTSTR / Print the rest of the special string FS1SYN JMP I FSPECL / Return to mainline > / END IFDEF FRENCH IFDEF CANADA < / FSPECL / Routine to process a special CANADA string FSPECL, XX CLA / Clear the AC (insurance) TAD ERRMES / Get the error message TAD (-S1SYN) / Get the special message SZA CLA / Is it the special message? JMP I FSPECL / No, continue as usual. TAD (16) / Shift out (to alternate graphics) JMS OUTCHR TAD (141) / Print an "GRAV A" JMS OUTCHR TAD (17) / Shift back (to base character set) JMS OUTCHR JMS OUTSTR / Print the rest of the special string CS1SYN JMP I FSPECL / Return to mainline > / END IFDEF CANADA THROCT, / POINTER INTO THRO STRING LESSCT, 0 / POINTER INTO LESS STRING /A018 LESSST, IFDEF ENGLSH < "L-200; "E-200; "S-200; "S-200; 0 > IFDEF ITALIAN< "M-200; "I-200; "N-200; "O-200; "R-200; "E-200; 0 > THROST, IFDEF ENGLSH < "T-200; "H-200; "R-200; 0 > IFDEF ITALIAN< "F-200; "I-200; "N-200; "O-200; "A-200; 0 > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE POUGH, TAD ("O-200) / SEE IF CHAR IS 'O' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("U-200) / SEE IF CHAR IS 'U' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("G-200) / SEE IF CHAR IS 'G' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("H-200) / SEE IF CHAR IS 'H' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YES, OUT OF SYNC MQL / SAVE FOR COMPARE TAD ("<-200) / SEE IF CHAR IS '<' ? JMS PCMPAR / COMPARE JMP I PZERR / NO MATCH RETURN JMP PTHRU1 / MATCHED, GO SET WORDS CORRECTLY PRNMDN, TAD PRWCNT / SEE IF SECOND PART OF 'THRU' ? SZA CLA JMP PRNMD2 / YES, GET RIGHT WORD AC7777 / NO, STORE -1 IN M-COUNT FOR PLAIN SEARCH PRNMD1, JMS PSTSPC / STORE M-COUNT WORD IN SPEC JMP I PZNRM / NO ROOM TAD PECNT / GET E-COUNT JMP PRSTD5 / STORE AND RETURN PRNMD2, TAD PMCNT / GET M-COUNT JMP PRNMD1 / AND STORE IT PRSTNM, IAC / MAKE SURE IT WASN'T JUST AN IMMEDIATE '>' SNA JMP I PZERR / NOT ALLOWED TAD (25+52-1) / GET CHAR BACK DCA T1 / AND SAVE IT AC0003 / SEE IF ANY * WILD CARDS YET ? TAD PRWCNT SZA CLA JMP I PZERR / YES, CAN'T DO DCA PRWCNT / SET COUNT TO 0 TAD PSCNT / MAKE SURE NO CHARS ALREADY STORED TAD PMCNT TAD PECNT SZA CLA JMP I PZERR / CAN'T HAVE CHARS STORED YET AC0001 / STORE +1 IN S-COUNT JMS PSTSPC JMP I PZNRM / NO ROOM ISZ PCNTWD / SET TO BUMP E-COUNT ISZ PCNTWD TAD T1 / GET CHAR BACK TAD (-12) / MAKE SURE IT'S NOT A NEWLINE SNA CLA JMP I PZERR / SHOULDN'T BE TAD NUMFLD / IF NUMERIC FIELD NAME SPECIFIED SZA CLA JMP PRSTN1 / THEN SCAN FOR A REAL NUMBER / COME HERE FOR NON-NUMERIC FIELD TAD (SPA SNA) DCA PRSNSZ / SET FOR LEADING ZERO SUPPRESSION TAD (-GPBSIZ-1) DCA NUMSIZ / SET MAX NUMBER SIZE ALLOWED TAD T1 / GET BACK AGAIN JMP PRSNL1 / COME HERE FOR NUMERIC FIELD PRSTN1, TAD (TOKVAL-1) / INITIALIZE POINTER INTO TOKVAL IN MATH DCA TAI1 / FIELD FOR ASCII NUMBER TAD T1 JMP PRSNL2 PRSNL3, JMS PGTNMC / GET A CHAR JMP PRSTRT / EOF SNA / SEE IF NEWLINE ? JMP I PZERR / YEP ! PRSNL2, TAD (-76) / SEE IF '>' ? SNA JMP PRSNL4 / CALL ASCBCD ROUTINE TAD (2) / NO, SEE IF '<' ? SNA JMP I PZERR / YES, NOT ALLOWED TAD (74) / MAKE ASCII AGAIN ISZ NUMSIZ / SEE IF TOO LARGE JMP .+2 JMP I PZERR / YES CDFMTH / NO, STORE CHARACTER IN DCA I TAI1 / TOKVAL IN MATH FIELD CDFMYF JMP PRSNL3 / GET ANOTHER CHAR X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE / HERE WE CALL ASCBCD ROUTINE IN MATH FIELD THEN MOVE PACKED BCD TO OUR / SYMBLE TABLE FOR LATER USE BY WPSELC.PA PRSNL4, CDFMTH DCA I TAI1 / STORE TRAILING ZERO IN TOKVAL CDFMYF CIFMTH JMS ASCBCD / CONVERT TO PACKED BCD TOKVAL / ASCII INPUT IS AT TOKVAL IN MATH FIELD RESULT / PACKED BCD OUTPUT GOES TO RESULT IN / MATH FIELD JMP BADNUM / ERROR RETURN TAD (RESULT-1) / GET ADDRESS OF PACKED BCD DCA TAI1 / AND PUT IN AUTO-INDEX COUNTER TAD (-6) / GET SIZE OF PACKED BCD VALUE DCA T1 / AND USE T1 AS COUNTER PRSNL5, CDFMTH / LOOP TAD I TAI1 / | GET PACKED BCD VALUE CDFMYF / | JMS PSTORE / | PUT IN SYMBLE TABLE JMP I PZNRM / EXIT IF NO ROOM ISZ T1 / | JMP PRSNL5 / END_LOOP JMP PRSNXT / LOOK FOR 'OR MORE' / 'OR LESS' / 'THROUGH' / OR 'THRU' / OUTPUT A SIXBIT STRING (TERMINATED WITH A ZERO BYTE) TO THE SCREEN. / Code will lowercase all alphabetic characters and perform the following / character mapping if FORIN is defined: / open square bracket to open curly bracket / backslash to close square bracket / close square bracket to close curly bracket / / CALLED WITH: / JMS OUTSTR / ADDR OF STRING / RETURN (AC= 0) / / MAPCON defines which of the first "x" characters, starting with SIXBIT "A" / whould be mapped into lowercase. / / LCMAP is the mapping constant for the above mapping function. It should be / set to 140 to map UPPER to lower case and set to 0 to disable this mapping. / MAPCON=33 / Last SIXBIT character mapped into UPPERCASE /IFNDEF ENGLSH < MAPCON=36 > / Foreign includes the square brackets IFNDEF GERMAN < LCMAP=140 > / Map UPPER into lower case IFDEF GERMAN < LCMAP=100 > / If German, do not perform this mapping OUTSTR, XX / return address AC7777 / GET STRING ADDR - 1 TAD I OUTSTR DCA TAI1 / AND LOAD IN AUTO-INDEX ISZ OUTSTR / BUMP FOR RETURN OTSTLP, TAD I TAI1 / GET A WORD DCA IOTMP / SAVE IT TAD IOTMP BSW / GET LEFT BYTE AND (77) SNA / ZERO BYTE? JMP I OUTSTR / YES, RETURN TAD (-MAPCON) / NO, SEE IF needs mapping SPA / NO, LEAVE ALONE TAD (LCMAP) / YES, Map it into lowercase (or whatever) TAD (MAPCON) / GET CHAR BACK JMS OUTCHR / AND OUTPUT IT TAD IOTMP / GET WORD BACK AND (77) / GET RIGHT BYTE SNA / ZERO? JMP I OUTSTR / YES, RETURN TAD (-MAPCON) / NO, SEE IF needs mapping SPA / NO, LEAVE ALONE TAD (LCMAP) / YES, Map it into lowercase (or whatever) TAD (MAPCON) / GET CHAR BACK JMS OUTCHR / AND OUTPUT JMP OTSTLP / GET NEXT WORD IOTMP, 0 / THIS ROUTINE OUTPUTS ASCII CHARACTERS STORED IN THE WORDS FOLLOWING THE CALL / LAST ENTRY SHOULD BE NEGATIVE (I.E. AND 4000 TO LAST CHARACTER) OSTRG, XX CLA OSTRGL, TAD I OSTRG / PICK UP CHAR JMS OUTCHR / OUTPUT CHAR TAD I OSTRG / GET CHARACTER BACK ISZ OSTRG / BUMP FOR NEXT SPA CLA / CHECK FOR END JMP I OSTRG / END - RETURN JMP OSTRGL / DO NEXT CHAR / THIS ROUTINE COMPARES THE CHARACTER IN THE AC WITH MQ AFTER CONVERTING THE / CHARACTER IN THE MQ TO UPPER CASE IF NECESSARY. SKIP RETURNS ON MATCH. PCMPAR, XX CIA / NEGATE FOR COMPARE DCA PCMTMP / AND SAVE IN TMP MQA / GET THE MQ TAD (-173) / SEE IF >173 SMA JMP PCUOK / YES, DON'T CHANGE TAD (173-141) / SEE IF LOWER CASE SMA TAD (-40) / YES, MAKE UPPER TAD (141-173) / GET CHAR BACK PCUOK, TAD (173) TAD PCMTMP / SEE IF CHARS EQUAL SNA CLA ISZ PCMPAR / YES, SKIP RETURN JMP I PCMPAR / RETURN PCMTMP, 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE BADNUM, AC0002 / BAD NUMBER IN A NUMERIC FIELD <:NAME> JMP ERRR / NOROOM, AC0000 / NO ROOM LEFT JMP ERRR / ERR, AC0001 / NOT UNDERSTOOD AT THIS POINT ERRR, DCA ERRTYP ISZ ERRCNT / BUMP ERROR COUNT JMS OSTRG / OUTPUT A STRING BELL / RING BELL LF / LINE FEED 10 / BACK SPACE "^-200 / UP ARROW CR / CARRIAGE RETURN LF / LINE FEED IFDEF ENGLSH < "E-200 "R-200 "R-200 "O-200 "R-200+4000 / +4000 MEANS END OF STRING > IFDEF ITALIAN < "E-200 "R-200 "R-200 "O-200 "R-200 "E-200+4000 / +4000 MEANS END OF STRING > IFDEF CANADA < "E "R "R "E "U "R+4000 / +4000 MEANS END OF STRING > IFDEF FRENCH < "E "R "R "E "U "R+4000 / +4000 MEANS END OF STRING > IFDEF GERMAN < "F "E "H "L "E "R+4000 / +4000 MEANS END OF STRING > IFDEF DUTCH < "F "O "U "T+4000 / +4000 MEANS END OF STRING > IFDEF NORWAY < "F "E "I "L+4000 / +4000 MEANS END OF STRING > IFDEF SWEDSH < "F "E "L+4000 / +4000 MEANS END OF STRING > IFDEF DANISH < "F "E "J "L+4000 / +4000 MEANS END OF STRING > TAD (ERRMTB) / GET ADDR OF MESSAGE TAD ERRTYP DCA T1 TAD I T1 DCA ERRMES JMS OUTSTR / DISPLAY TYPE OF ERROR MESSAGE ERRMES, XX IFDEF FRENCH < JMS FSPECL / Special french processing > IFDEF CANADA < JMS FSPECL / Special Canadian processing > MENRET, JMS OSTRG / OUTPUT STRING CR / CARRIAGE RETURN LF / LINE FEED LF+4000 / ANOTHER LINE FEED, 4000 MEANS END OF STRING JMS OUTSTR / GOLD MENU MESSAGE SPACE IFDEF ENGLSH < TAD ("P-200) > IFDEF ITALIAN< TAD ("P-200) > IFDEF CANADA < TAD ("A) > IFDEF FRENCH < TAD ("A) > IFDEF GERMAN < TAD ("M) > IFDEF SCANDI < TAD ("T) > IFNDEF DUTCH < / "Press" not used in dutch JMS OUTCHR JMS OUTSTR RESS > IFNDEF ITALIAN IFDEF ITALIAN JMS OUTCHR JMS OUTSTR OLD TAD ("M-200) JMS OUTCHR IFDEF ENGLSH < / In english this is all UPPERCASE TAD ("E-200) JMS OUTCHR TAD ("N-200) JMS OUTCHR TAD ("U-200) JMS OUTCHR > IFDEF ITALIAN < TAD ("E-200) JMS OUTCHR TAD ("N-200) JMS OUTCHR TAD ("U-200) JMS OUTCHR > IFDEF SCANDI < TAD ("E) JMS OUTCHR TAD ("N) JMS OUTCHR IFDEF NORWAY < TAD ("Y) > IFDEF SWEDSH < TAD ("Y) > IFDEF DANISH < TAD ("U) > JMS OUTCHR > / END IFDEF SCANDI IFNDEF ENGLSH < / In Foreign languages this is only Capitalized IFNDEF SCANDI < IFNDEF ITALIAN< JMS OUTSTR ENU >>> JMS OUTSTR TORECA IFNDEF CANADA < IFNDEF FRENCH < / If not french then "MAIN MENU" IFNDEF ITALIAN< IFDEF ENGLSH < TAD ("M-200) > IFDEF DUTCH < TAD ("H) > IFDEF GERMAN < TAD ("H) > JMS OUTCHR JMS OUTSTR AIN IFDEF ENGLSH < TAD ("M-200) > IFDEF DUTCH < TAD ("M) > IFDEF GERMAN < TAD ("M) > IFDEF SCANDI < TAD ("H) > >>> / End IFNDEF FRENCH, CANADA, ITALIAN IFDEF CANADA < TAD ("M) > IFDEF FRENCH < TAD ("M) > IFDEF ITALIAN< TAD ("M-200) > JMS OUTCHR JMS OUTSTR ENU IFDEF CANADA < JMS OUTSTR AIN > IFDEF FRENCH < / Else "MENU MAIN" JMS OUTSTR / "principal" not capitalized AIN > IFDEF ITALIAN < JMS OUTSTR AIN > JMS OSTRG / CALL OUTPUT STRING ROUTINE ESC / START DIRECT CURSOR ADDRESS "[ / ESC [ PL ; PC H "2 / LINE 23 "3 "; / 1 IS DEFAULT "H+4000 / 4000 INDICATES END OF STRING JMP INPUT / WAIT FOR GOLD MENU WAIT, CIFSYS / ++++ JWAIT INPUT, CIFSYS / ++++ XLTIN / ++++ JMP WAIT TAD (-EDMENU) SNA CLA JMP XIT TAD (7) / OUTPUT BELL JMS OUTCHR JMP INPUT / AND KEEP LOOKING ERRTYP, 0 CLS, XX / ROUTINE TO PUT CURSOR HOME AND CLEAR / THE SCREEN JMS OSTRG / OUTPUT STRING ESC / ESCAPE "[ / NEED [ IF ANSI "H / HOME THE CURSOR ESC / ESCAPE "[ / NEED [ IF ANSI "J+4000 / CLEAR TO END OF SCREEN (4000 MEANS / END OF STRING JMP I CLS / RETURN / This message only comes up when there is an error in a numeric field / number, i.e. <:name> S0NUM, IFDEF ENGLSH IFDEF ITALIAN X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE S1SYN, IFDEF ENGLSH < TEXT '-- SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.' > IFDEF ITALIAN< TEXT '-- SPECIFICA NON COMPRESSA A PARTIRE DA QUESTO PUNTO.' > IFDEF CANADA < TEXT "-- SP[CIFICATION INCOMPRISE " > IFDEF FRENCH < TEXT "-- SP[CIFICATION INCOMPR[HENSIBLE " > IFDEF DUTCH < TEXT "-- SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT." > IFDEF GERMAN < TEXT "-- SPEZIFIKATION AB DIESEM PUNKT UNVERST[NDLICH" >/L.U.A IFDEF NORWAY < TEXT "-- SPESIFIKASJONEN IKKE FORST]TT FRA DETTE PUNKT." /L.D.A > IFDEF SWEDSH < TEXT "-- SPECIFIKATIONEN F\RST]S INTE FR]N DENNA PUNKT." /L.U.O, L.D.A, L.D.A > IFDEF DANISH < TEXT "-- SPECIFIKATION IKKE FORST]ET FRA DETTE PUNKT." /L.D.A > S2NRM, IFDEF ENGLSH < TEXT '-- SPECIFICATION TOO LARGE.' > IFDEF ITALIAN< TEXT '-- TROPPE CONDIZIONI NELLA SPECIFICA DI SELEZIONE.' > IFDEF CANADA < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E IFDEF FRENCH < TEXT "-- SP[CIFICATION TROP LONGUE" > /L.A.E IFDEF DUTCH < TEXT "-- SPECIFICATIE TE GROOT." > IFDEF GERMAN < TEXT "-- SPEZIFIKATION ZU LANG" > IFDEF NORWAY < TEXT "-- SPESIFIKASJONEN FOR STOR." > IFDEF SWEDSH < TEXT "-- SPECIFIKATIONEN F\R STOR." > /L.U.O IFDEF DANISH < TEXT "-- SPECIFIKATION FOR STOR." > SPACE, IFNDEF DUTCH < TEXT ' ' > IFDEF DUTCH < TEXT ' ' > RESS, IFDEF ENGLSH < TEXT 'RESS ' > IFDEF ITALIAN< TEXT 'REMERE ' > IFDEF CANADA < TEXT "PPUYER SUR " > IFDEF FRENCH < TEXT "PPUYER SUR " > IFDEF DUTCH <> / Not used in the Dutch IFDEF GERMAN < TEXT "IT " > IFDEF NORWAY < TEXT "RYKK " > IFDEF SWEDSH < TEXT "RYCK P] " > /L.D.A IFDEF DANISH < TEXT "RYK " > OLD, IFDEF ENGLSH < TEXT 'OLD ' > IFDEF ITALIAN< TEXT 'RO ' > IFDEF CANADA < TEXT "OLD " > IFDEF FRENCH < TEXT "OLD " > IFDEF DUTCH < TEXT "OUD " > IFDEF GERMAN < TEXT "OLD " > IFDEF NORWAY < TEXT "UL " > IFDEF SWEDSH < TEXT "UL " > IFDEF DANISH < TEXT "UL " > TORECA, IFDEF ENGLSH < TEXT ' TO RECALL THE ' > IFDEF ITALIAN< TEXT ' PER RICHIAMARE IL ' > IFDEF CANADA < TEXT "POUR RAPPELER LE " > IFDEF FRENCH < TEXT "POUR RAPPELER LE " > IFDEF DUTCH < TEXT " INTOETSEN VOOR " > IFDEF GERMAN < TEXT " ZUR]CK ZUM " > /L.U.U IFDEF NORWAY < TEXT " FOR ] F] " > /L.D.A, L.D.A IFDEF SWEDSH < TEXT " F\R ATT F] " > /L.U.O, L.D.A IFDEF DANISH < TEXT " FOR AT F] " > /L.D.A AIN, IFDEF ENGLSH < TEXT 'AIN ' > IFDEF ITALIAN< TEXT 'PRINCIPALE.' > IFDEF CANADA < TEXT "PRINCIPAL." > IFDEF FRENCH < TEXT "PRINCIPAL" >/Not capitalized in French IFDEF DUTCH < TEXT "OOFD " > IFDEF GERMAN < TEXT "AUPT " > IFDEF NORWAY < TEXT "OVED" > IFDEF SWEDSH < TEXT "UVUD" > IFDEF DANISH < TEXT "OVED" > ENU, IFDEF ENGLSH < TEXT 'ENU.' > IFDEF ITALIAN< TEXT 'ENU ' > IFDEF CANADA < TEXT "ENU " > IFDEF FRENCH < TEXT "ENU " > IFDEF DUTCH < TEXT "ENU" > IFDEF GERMAN < TEXT "EN]" >/L.U.U IFDEF NORWAY < TEXT "MENYEN." > IFDEF SWEDSH < TEXT "MENYN." > IFDEF DANISH < TEXT "MENUEN." > XIT, TAD PARSE / GET RETURN ADDR DCA T1 / MAKE IT LOCAL CDIMNU / AND GET THE RIGHT FIELD JMP I T1 / BYE, BYE NOERRT, TAD (15) / CR JMS OUTCHR TAD (12) / LF JMS OUTCHR TAD (12) / LF JMS OUTCHR JMS OUTSTR SPACE IFDEF ENGLSH < TAD ("N-200) JMS OUTCHR > IFDEF ITALIAN < > IFDEF CANADA < TAD ("A) JMS OUTCHR > IFDEF FRENCH < TAD ("P) JMS OUTCHR > IFDEF GERMAN < > / All of the message is in OERR IFDEF DUTCH < TAD ("G) JMS OUTCHR > IFDEF SCANDI < TAD ("I) JMS OUTCHR > JMS OUTSTR OERR JMP MENRET OERR, IFDEF ENGLSH < TEXT 'O ERRORS IN SPECIFICATION' > IFDEF ITALIAN< TEXT 'ERRORI NELLA SPECIFICA: 0' > IFDEF CANADA < TEXT "UCUNE ERREUR DANS LA SP[CIFICATION" > /L.A.E IFDEF FRENCH < TEXT "AS D'ERREUR DANS LA SP[CIFICATION" > /L.A.E IFDEF DUTCH < TEXT "EEN FOUTEN IN SPECIFICATIE." > IFDEF GERMAN < TEXT "KEINE FEHLER IN DER SPEZIFIKATION" > IFDEF NORWAY < TEXT "NGEN FEIL I SPESIFIKASJONEN" > IFDEF SWEDSH < TEXT "NGA FEL I SPECIFIKATIONEN" > IFDEF DANISH < TEXT "NGEN FEJL I SPECIFIKATION" > X=. / INDICATE FIRST FREE LOCATION ON PAGE /------------------ PAGE   / XLIST /WPSELC.PA /WPSELC.PA / / COPYRIGHT (C) 1980 / DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754 / / THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED / ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE / INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER / COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY / OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY / TRANSFERRED. / / THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE / AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT / CORPORATION. / / DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS / SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / / ABSTRACT: / / ENVIRONMENT: / / AUTHOR: CREATION DATE: / / MODIFIED BY: / / / , : VERSION / / 044 RCME 12-APR-85 Fix parsing of tech & multinational / characters in field names / / ------------------- All below refer to V2.0 and earlier --------------- / / 043 HLP 13-SEP-83 Delete PRLOCK since DECmate is single user / 042 WCE 06-MAY-83 Fixed L.P. to work with numbers to 4095 / 041 HLP 02-MAY-83 Delete JSTRTs on PRJOB,extra DCA PRSTTS / 040 GDH 1-Feb-83 Fixed =<*> selection. / 039 GDH 16-DEC-82 Fixed match logic when dealing w/ big recrds. / 038 DRH 2-15-81 FIXED TYPO IN CODE NOTICED BY G.HOSLER / ALSO ADDED PSUEDO-CODE TO "CNTROL" RTN / 037 DAO 26-OCT-81 ADDED WTSELC.PA TO TOP OF THIS FILE / SINCE NO MORE ROOM IN MASTER.INF / (ONLY NINE FILES ALLOWED PER LINE) / 036 EH 22-OCT-81 report error if illegal number in LP / 035 AIB 22-Oct-81 changes to accomodate editor math / error reporting, at REPORT et seq / 033 DRH 21-OCT-81 STRIP OUT SOFT RETURN (WITH HYPHEN) / 032 GDH 20-OCT-81 Deimplemented LOCK/UNLOCK. / 031 DRH 14-SEP-81 SET MATH INIT CALL FROM WPSELC TO ALSO / SET FLAG SAYING IN LP MATH / 030 DAO 19-AUG-81 Added changes for selectin on / numeric fields / 029 DAO 23-JUL-81 FIXED LP TO PRINTER BUG IN PRNQUE / 028 DRH 31-JUL-81 SET UP "ERRHAN" TO BYPASS "DOMATH" / 027 DRH 31-JUL-81 MADE CHECK MATH ACTIVE SUBRTN GENERAL / 026 JRF 28-JUL-81 Add CIF,CDF equates for menu field / 025A DRH 24-JUL-81 HANDLE MATH LINE BUFFER OVERFLOW ERROR / 025 JRF 23-JUL-81 Make modifications for error reporting / thru MN1 / 024 JRF 22-JUL-81 Corrected count of max. numeric chars. / allowed in a field value in LDFLD / 023 DRH 22-JUL-81 FIX TO DUMP CTRL BLOCK IF NOT MATH / 022 DRH 22-JUL-81 SCREEN OUT WRAPS & SOFT SPACES BEFORE / CHAR SENT TO MATH LINEBUFFER (LNEBUF) / 021 DRH 21-JUL-81 HANDLE END OF CTRL BLOCK SPECIAL CASES / 020 DRH 21-JUL-81 UNBUNDLED LIST PROCESSING MATH / 019 JRF 09-JUL-81 Added calls to IOA / 018 DAO 9-JUL-81 Added changes for LP math / 017 DAO 08-JUL-81 Changes to move LP to field 5 / 0016 TT 07-JUL-81 Removed superfluous conditionals / 0015 JM 01-APR-81 Changes for CANADA / 0014 JM 10-MAR-81 Added CANADIAN text / 0013 JM 09-MAR-81 Added DUTCH text / 0012 JM 06-MAR-81 Added FRENCH text / 0011 LDB 20-NOV-80 Add error for full diskette / 0010 GR,DAO 17-OCT-80 CONDITIONALIZED ESCAPE SEQUENCES / 0009 DIM 23-SEPT-80 Merge with x3.5 / 0007 DIM,JM 15-SEPT-80 Merged Scandi and Europe/English / 0006 REG 12-AUG-80 INSERTED THIS STANDARD HEADER / 0005 DSS 09-JUL-80 MODIFIED FOR ENGLISH/FRENCH-CANADIAN / 0004 CMW 05-MAY-80 ENTERED CANADA TRANSLATIONS / 0003 DSS 17-APR-80 ENTERED DUTCH FIXES / 0002 GLT 10-Apr-80 Add LCMAP value to control the mapping constant / / that gets added to an ASCII value to change it from / / UPPER to lower case. This allows the programmer / / to disable the case changing at will. Presently / / German disables the case value. / 0001 GLT 08-Feb-80 Add French German and Dutch translations / / and did amazing things with angle brackets and accented / / characters. By adding the value MAPCON. MAPCON / / defines the first "x" characters that will be mapped / / into lowercase starting with SIXBIT "A". For English / / MAPCON=33 (base 8, 26 base 10) to capitalize A-Z. / / In FORIN systems MAPCON=36 (base 8, 29 base 10) to / / capitalize A-Z plus the three special foreign / / characters. (See OUTSTR for current values). / / French diacritical substitutions: / / "["-L.A.E, "]"-L.G.E / / German diacritical substitutions: / / "["-L.U.A, "\"-L.U.O, "]"-L.U.U / 2.4D+ RLT 10/17/77 UNDERLINED SPACE (ETC) BUG IN GETCHAR / 2.Q-1 RLT 09/24/77 NOP'D PRNQUE ROUTINE FOR WT78 / 2.P-4 KEE ADD CODE TO UNLOCK FILES FOR 102 SYSTEMS / /-- / /WTSELC APPENDED TO TOP OF WPSELC TO CUT DOWN ON NUMBER OF FILES /A037 /ASSEMBLED FROM 10 TO 9 WHICH IS PALS LIMIT /A037 /WTSELC - WRITES OUT LIST PROCESSING SELECT PROGRAM /MODIFICATIONS /003 RCME 07-Aug-85 /allow MNC's in numeric fields / /******************* all below refer to v2.0 or earlier ************************ / /OO2 DAO 21-AUG-81 /DELETED WRITE OUT CODE FOR /SECOND OVERLAY NOT USED ANYMORE /001 DAO 26-JUN-81 /CHANGES TO MOVE LP TO FIELD 5 FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSEL; 200;CDF 20;-DSOSEL /WRITE OUT WPSELC /M001 DLOSOV;2200;CDF 30;-DSOSOV /WRITE OUT AN OVERLAY /MOO1 0 CDFMYF=CDFLP /M017 CDFBUF=CDF BUFFLD /M017 MNUFLD=20 /A026 CDFMNU=CDF MNUFLD /A026 CIFMNU=CIF MNUFLD /A026 CDIMNU=CIF CDF MNUFLD /A026 CDFMNU=CDF 20 /A020 FIELD 2 *200 /M017 / SELCT AND SELCTX ARE BOTH INITIALLY SET BY START ROUTINE. THIS WAS /A019 / DONE SO THAT A MATH ERROR ENCOUNTED WITHIN A MATH CONTROL BLOCK /A019 / PREVIOUS TO THE READING OF THE FIRST RECORD COULD BE REPORTED. /A019 / SELCT *** MUST *** RESIDE AT ADDRESS ZERO OF A PAGE. /A019 / IF MATH DETECTS AN ERROR, IT WILL MAKE A RETURN TO SELCTX. /A042 / THIS ROUTINE IS CROSS FIELD CALLABLE BECAUSE OF AN EDITOR CALL /A042 SELCT, 0 /MAIN ROUTINE TO MATCH AND SELECT RECORDS /CALLED BY: /CIFLP /M017 /JMS I (SELCT) /RETURN (AC =0 IF RECORD FOUND, AC = -1 IF NO MORE RECORDS) CLA RDF /GET FIELD FROM WHENCE I CAME TAD CIDF0 /MAKE CIF, CDF CDFMYF /SET DATA FIELD RIGHT DCA SELCTX /STORE INSTRUCTION TAD RECNUM /SEE IF FIRST TIME CALLED ? SNA CLA JMP SLTSFD /YES, DON'T BOTHER TO GET INITIAL '<' RECLP, JMS DISREC /SHOW REC NO. BEING PROCESSED SLBLP, JMS GETCHR /GET 1ST 'REAL' CHAR OF RECORD JMP SELDNX /EOF, GO FINISH UP AND P177 /LOSE CONTROL TAD (-41 /NON-PRINTING CHAR ? SPA JMP SLBLP /YES, KEEP LOOKING FOR '<' TAD (-33 /NO, SEE IF A '<' SZA CLA JMP REVCRBR / ERROR - TEXT BETWEEN RECORDS /M025 SLTSFD, JMS SINFLG /YES, INITIALIZE MATCH FOUND FLAGS JMS LRCBUF /LOAD A RECORD INTO EDIT BUFFER FIELD JMS CHKREC /CHECK FROM - TO RECORD NUMBER /M042 JMP SLBLP /SKIP RECORD, AND LOOK FOR NEXT RECORD /M042 JMP SELDNX /DONE ALL RECORDS OR HALT FLAG DETECTED /M042 JMS INCNUM /COUNT RECORD BEING PROCESSED /A042 RECPRO /POINTER TO RECORD BEING PROCESSED /A042 TAD (RECBUF /RESET PTR IN AUTO-INDEX DCA RCBPTR /AFTER FIRST '<' FNLP, JMS LFLDNM /LOAD INTO GPBUF JMP CHKMAT /EOR, GO CHECK RECORD MATCH TAD (SYMTAB-1 /GET SYMBOL TABLE ADR - 1 DCA SYTPTR /PUT IN AUTO-INDEX SYTBLK, TAD I SYTPTR /GET AN ENTRY SZA /ANY LEFT ? JMP SYTBL1 /YES JMS GFDEND /NO, GET TO END OF FIELD JMP FNLP /GET NEXT FIELD SYTBL1, DCA SYTSRC /STORE FOR COMPARE TAD FNCNT /GET SIZE OF FN TO SEARCH JMS XSCMP /SEE IF MATCHES GPBUF SYTSRC, 0 CDFMYF /FIELD OF SYMTAB FOR COMPARE SZA CLA JMP FNLP1 /YES, FOUND AN ENTRY ISZ SYTPTR /NOPE, BUMP PTR JMP SYTBLK /TRY NEXT ENTRY CKTRU, DCA SFFLG /SET FOR SUCCESSFUL MATCH /MJOE SSMAT, TAD SFFLG /SEE IF RECORD MATCHED SZA CLA JMP RECLP /NO, KEEP TRUCKING JMS INCNUM /COUNT THIS RECORD AS A SELECTED RECORD /A042 SUCREC /POINTER TO MERGED RECORD COUNT /M042 SKP /SKIP EOF FLAG SELDNX, AC7777 JMS DOMATH /DO MATH ON THIS RECORD /A018 SELCTX, 0 /FOR CIF CDF (DON'T FORGET - INITIALLY /A019 /SET BY START ROUTINE. SEE NOTE ABOVE /A019 JMP I SELCT /RETURN CHKMAT, AC7777 /SET FLAG FOR NO MATCH DCA SFFLG TAD (SPECTB /GET 1ST LOC OF SPEC TABLE DCA SPCSCN /AND SAVE IT TAD I (SPECTB /GET FIRST TYPE WORD SNA JMP CKTRU /0 TYPE, PROCESS ALL RECORDS SPA CLA /SEE IF 'TRUE' (POS.) JMP CKNG2 /NO, LOOK FOR A 'TRUE' ENTRY JMP CHKML /YES, GO GET NEXT TYPE CHKML1, DCA SFFLG /SET FOR MATCH CHKML, JMS GTYPE /GET A TYPE WORD SNA JMP CKTRU /0 TYPE, RECORD MATCHED, ALL DONE SPA /SEE IF 'TRUE' JMP CKNEG /PROBABLY NOT, GO MAKE SURE AND P177 /GET RID OF FLAGS TAD (-1 /SEE IF 'OR IF' FOUND SNA CLA JMP CHKML1 /YES, SUCCESS JMP CHKML /NO, BUT THAT'S O.K. CKNEG, AND P177 /GET RID OF FLAGS TAD (-1 /SEE IF FALSE 'OR IF' (-1) SNA CLA DCA SFFLG /YES, SET FOR RECORD MATCHED AND CONTINUE CKNG2, JMS GTYPE /LOOK FOR A 1 (OR IF) SNA JMP SSMAT /NOTHING LEFT, GO CHECK MATCH SPA JMP CKNG2 /'FALSE' DOESN'T HELP AND P177 /GET RID OF FLAGS TAD (-1 SNA CLA JMP CHKML /FOUND IT, START LOOKING AGAIN JMP CKNG2 /NOPE, KEEP LOOKING RECNUM, 0 / RECORD NUMBER /M025 RECPRO, 0 / RECORDS PROCESSED /A025 SUCREC, 0 / SUCCESSFULLY MERGED RECORDS /M025 SFFLG, -1 FNCNT, 0 NXTMCT, XX / Routine to test for MCS char in field /a003 SZA / Is this a Start of Dead? /a003 JMP I NXTMCT / No, skip the squish call /a003 CIFMTH / Yes, call the blaster in the maths code/a003 JMS MBHOOK / This is its address, as given in WPF1 /a003 SQUISH / This is the blast number of the 7 to /a003 / 8 bit squish routine. /a003 ISZ NXTMCT / Make skip return with result of dead /a003 JMP I NXTMCT /-------------- PAGE FNLP1, AC0001 /SAVE A PTR TAD RCBPTR /TO 1ST CHAR IN FIELD DCA FDSTRT DCA LDNMFL /CLEAR NUMBER LOADED FLAG JMS GFDEND /GET TO END OF FIELD AC7777 /PICK UP SPEC ADDR TAD I SYTPTR FNLP2, DCA SPCPTR /SAVE IN AUTO-INDEX TAD SPCPTR /GET PTR TO TYPE WORD DCA PTYWD /AND SAVE IT TAD I SPCPTR /GET FN LINK WORD DCA NXTSPR /AND SAVE TAD I SPCPTR /GET OR-COUNT IAC /PLUS 1 CIA DCA ORCNT /AND MAKE INTO A COUNTER ORLP, CLA /MAKE EVERYTHING CLEAR ISZ ORCNT /SEE IF ANY OR-GROUPS LEFT JMP .+2 JMP NXTSPC /NO, GET NEXT SPEC TAD FDSTRT /YES, SET UP SEARCH DCA RECSTR /THE RECORD PTR TAD I SPCPTR /AND THE SPEC PTR DCA SPCSTR TAD I SPCPTR /GET S-LENGTH DCA SLEN /AND SAVE IT TAD I SPCPTR /GET M-LENGTH DCA MLEN TAD I SPCPTR /GET E-LENGTH DCA ELEN TAD SLEN /SEE IF S-LENGTH IS POSITIVE SMA SZA CLA JMP SSPRC /YES, MEANS SPECIAL PROCESSING REQUIRED TAD SLEN /Test for existance test. /A040 TAD MLEN / ... /A040 TAD ELEN / .... /A040 SNA CLA / skip if some other test. /A040 JMP SSRCH / test was for existance. so succeed! /A040 AC7777 /NO, SEE IF TAD FDSTRT /THE LENGTH OF THE FIELD CIA TAD FDEND /IS LONGER THAN CLL / Reset overflow indicator. Record length/A039 / can be up to 2500 (4704) characters. /A039 TAD SLEN / S + TAD MLEN / M + TAD ELEN / E ? SNL / skip if no overflow. ie didn't have /A039 / to borrow. /A039 JMP ORLP /NO, FAIL IMMEDIATELY SSRCH, IAC /YES, ADD ONE CIA /AND MAKE INTO A COUNTER DCA RCRLFT /OF CHARS LEFT FOR M SEARCH TAD SLEN /GET LENGTH TO SEARCH SNA /ANYTHING? JMP ESRCH /NO, CHECK E JMS SRCH /YES, DO COMPARE SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP ESRCH, TAD SLEN /POINT TO RIGHT PLACE IN SPEC STR TAD MLEN CIA TAD SPCSTR DCA SPCSTR /AND MAKE NEW SPEC STR PTR TAD ELEN /GET E-LENGTH SNA /ANYTHING? JMP MSRCH /NO, CHECK M TAD FDEND /YES, GET TO END OF FIELD - ELEN IAC DCA RECSTR /AND MAKE NEW RECORD STR PTR TAD ELEN /GET BACK E-LENGTH JMS SRCH /DO COMPARE SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP MSRCH, TAD MLEN /TRUE, GET M-LENGTH SNA /ANYTHING? JMP TRUE /NO, SO MUST BE TRUE TAD SPCSTR /YES, MAKE NEW SPEC PTR DCA SPCSTR /BY SUBTRACTING M-LENGTH TAD SLEN /ADD S-LENGTH TO CIA TAD FDSTRT /ADDR OF START OF STRING DCA RECSTR /AND MAKE INTO NEW REC STR PTR MSRLP, TAD MLEN /GET M-LENGTH FOR SEARCH JMS SRCH /DO COMPARE SZA CLA JMP TRUE /MATCHED, SET RECORD MATCH ISZ RCRLFT /FALSE, SEE IF ROOM LEFT TO SHIFT SKP JMP ORLP /NO, TRY NEXT OR-GROUP ISZ RECSTR /YES, BUMP REC STR PTR JMP MSRLP /AND TRY TO MATCH AGAIN SSPRC, AC0002 TAD MLEN /NUMERIC COMPARE NEEDED ? SZA CLA JMP NUM /YES, GO FIGURE OUT WHICH TYPE AC7777 /NO, COMPUTE RECORD FIELD LENGTH TAD FDSTRT CIA TAD FDEND TAD ELEN /MINUS E-LENGTH, HAS 0 FOR NULL SEARCH AND LENGTH FOR EXACT SEARCH SZA CLA /EQUAL TO 0 ? JMP ORLP /NO, FAIL IMMEDIATELY TAD ELEN /OTHERWISE, GET BACK E-LENGTH SNA /NULL SEARCH ? JMP TRUE /YES, SET RECORD MATCH JMS SRCH /NO, DO EXACT SEARCH SNA CLA JMP ORLP /FALSE, TRY NEXT OR-GROUP JMP TRUE /TRUE, SET FLAG NXTSPR, 0 ORCNT, 0 FDSTRT, 0 FDEND, 0 SLEN, 0 MLEN, 0 ELEN, 0 RCRLFT, 0 /-------------- PAGE SSRBRD, 0 /READS A CHARACTER FROM THE EDIT BUFFER /FIELD INTO THE AC USING RCBPTR AS AN /AUTO-INDEX REGISTER CLA CDFBUF /CHANGE FIELDS TAD I RCBPTR /GET CHAR CDFMYF /BACK TO HOME FIELD AND P177 /NO CONTROLS TAD (-10) /Test for Start of Dead marker /a044 SNA /Is it SOD? /a044 ISZ DEADKEY /Yes, set dead key flag /a044 TAD (10-15) /No, test for End of Dead /a044 SNA /Is this End of Dead? /a044 DCA DEADKEY /Yes, reset dead key flag /a044 TAD (15) /Restore character value /a044 JMP I SSRBRD /RETURN DEADKEY,ZBLOCK 1 /Dead key sequence flag /a044 LRCBUF, XX / THIS ROUTINE LOADS A RECORD INTO THE EDIT /M025 / BUFFER FIELD FROM AFTER THE FIRST '<' USING /M025 / THE GETCHR ROUTINE. /M025 /CALLED BY: (AC MUST = 0) /M025 /JMS LRCBUF /REGULAR RETURN IF NO ERRORS ELSE ERROR EXIT /M025 DCA SSLBFD /SET LEFT BRACKET FLAG /M025 LRBLP5, TAD (RECBUF-1) /SET-UP PTR IN AUTO-INDEX DCA RCBPTR TAD (RECSIZ-1) /SET-UP COUNTER DCA SSCNT TAD ("<-200 /STORE THE INITIAL '<' DCA T1 / IN T1 /A025 JMS SSRBST LRBLP, JMS GETCHR /READ A CHAR JMP REVPEOF / ERROR - END OF FILE /M025 DCA T1 /SAVE CHAR TAD T1 AND P177 /STRIP OFF CONTROLS TAD (-74 /SEE IF A '<' SZA JMP LRBLP1 /NOPE DCA SSLBFD /YES, SET FLAG JMP LRBLP3 /AND STORE CHAR AWAY LRBLP1, TAD (-2 /IS IT A '>' SZA CLA JMP LRBLP2 /NO, CLEAR FLAG TAD SSLBFD /YES, IS FLAG SET? /M025 SNA CLA / SKIP IF: FLAG NOT SET FOR LEFT ANGLE /M025 / BRACKET LAST CHAR. READ /A025 ISZ SSLBFD /YES, SET FOR END OF RECORD LRBLP3, JMS SSRBST / STORE CHARACTER IN T1 /M025 TAD SSLBFD /SEE IF A '<>' HAS BEEN FOUND SPA SNA CLA JMP LRBLP /NO, KEEP LOOKING CDFBUF /YES, STORE TRAILING 0 DCA I RCBPTR CDFMYF JMP I LRCBUF /RETURN HOME NO ERRORS /M025 LRBLP2, AC7777 /CLEAR FLAG DCA SSLBFD JMP LRBLP3 /GO STORE CHAR SSCNT, 0 /COUNTER FOR RECORD SIZE SSLBFD, 0 /END OF RECORD FLAG /(-1 CLEAR, 0 LEFT BRACKET, 1 EOR) SSRBST, XX / STORES THE CHAR IN T1 INTO THE EDIT BUFFER /M025 / FIELD. RETURNS IF CHAR STORED. ERROR EXIT IF /M025 / NO MORE ROOM FOR CHAR. /M025 ISZ SSCNT /SEE IF ANY ROOM LEFT JMP SSRBS1 JMP REVLGRC / ERROR - NO ROOM LEFT - RECORD EXCEEDS /M025 / 2500 CHARACTERS /A025 SSRBS1, TAD T1 / GET THE CHARACTER IN T1 /M025 CDFBUF /NOW TAKE A TRIP DCA I RCBPTR /TO STORE IT AWAY CDFMYF /THEN COME HOME JMP I SSRBST /AND RETURN SOMEDAY GETCHR, XX /THIS ROUTINE READS CHARS FROM A FILE. /M025 / IT REMOVES ALL RULERS, PRINTER CONTROLS, AND /'FUNNY' SPACES AND LINE FEEDS. /CALLED BY: /JMS GETCHR /EOF RETURN /REGULAR RETURN (AC CONTAINS CHAR) CLA GTCHLP, JMS RDNXCH /GET NEXT CHAR SPA SNA JMP I GETCHR /EOF (RETURN IS ZERO) DCA T1 /SAVE CHAR TAD T1 AND P177 /IGNORE HIGHS FOR NOW TAD (-41 /SEE IF SPECIAL CHARACTER SPA JMP SSPCHR /MAYBE, LOOK DEEPER CLA TAD T1 /GET CHAR BACK ISZ GETCHR /BUMP RETURN RTNCHR, JMP I GETCHR /RETURN /M018 SSPCHR, TAD (25 /SEE IF A FF (14) SNA JMP SSCPC /YES, NOW CHECK IF SPECIAL TAD (-2 /NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SSDLRR /YES, GO DELETE RULER TAD T1 /GET CHAR BACK AND (2000 /HIGH PART ON? SZA CLA JMP GTCHLP /YES, IGNORE CHARACTER GTCHRT, TAD T1 /NO, MUST HAVE BEEN O.K. AFTER ALL ISZ GETCHR /BUMP RETURN JMP I GETCHR /AND GO SSCPC, TAD T1 /SEE IF START OF CONTROL BLOCK /M018 TAD (-1014 /GET NEGATIVE OF CONTROL BLOCK CHARACTER/M018 SZA CLA /IS IT THE START OF A CONTROL BLOCK? /M018 JMP GTCHRT / NO: MUST HAVE BEEN NORMAL FF /M018 /A018 /***** HOOK MADE HERE TO CHK AND SERVE MATH CONTROL BLOCK ***** /A018 /A018 JMP CNTROL / YES: CHECK IF MATH CONTROL BLOCK /A018 /A018 /***** END OF HOOK ********************************************* /A018 /A018 SSCPC1, JMS RDNXCH /GET A CHAR SPA SNA JMP I GETCHR /ERROR, EOF (RETURN IS NOT POSITIVE) TAD (-1414 /SEE IF END YET SZA CLA JMP SSCPC1 /NO, KEEP LOOKING JMP GTCHLP /YES, BACK TO NORMAL PROCESSING SSDLRR, JMS RDNXCH /GET A CHAR SPA SNA JMP I GETCHR /ERROR (RETURN IS NEGATIVE) TAD (-17 /END OF RULER? SZA CLA JMP SSDLRR /NO, KEEP LOOKING JMP GTCHLP /YES, BACK TO NORMAL PROCESSING /-------------- PAGE /**************************************************************************** / / W A R N I N G /a003 / /a003 / THIS AREA BLASTED FOR MCS CHARACTERS IN NUMERIC FIELDS /a003 / See WPMTHL, maths hole, for code /a003 / /**************************************************************************** LPHOLE=. NUMFLD, 0 / NUMERIC FIELD FLAG /A030 / 0= NOT A NUMERIC FIELD () /A030 / 1= A NUMERIC FIELD (<:NAME>) /A030 LFLDNM, XX /THIS ROUTINE LOADS A FIELD NAME FROM AFTER THE /M025 / '<' UNTIL THE FIRST '>' INTO THE GENERAL /M025 / PURPOSE BUFFER. IT DOES A SKIP RETURN IF ALL /M025 / O.K., AND A REGULAR RETURN IF AT END OF /M025 / RECORD. IF ERROR TAKE ERROR EXIT. THIS /M025 / ROUTINE MUST BE ENTERED WITH AC = 0! /M025 TAD (GPBUF-1 /SET-UP PTR IN AUTO-INDEX DCA GPPTR TAD (-GPBSIZ-1 /SET-UP SIZE COUNTER /M030 DCA SSCNT DCA FNCNT /Zero the absolute string length /a040 JMS SSRBRD /GET FIRS CHAR /A030 DCA T1 / STORE /A030 TAD T1 / GET BACK /A030 TAD (-":+200 / /A030 SNA CLA /IF ":" /A030 AC0001 /THEN NUMFLD = 1 /A030 DCA NUMFLD /ELSE NUMFLD = 0 /A030 JMP LFNLP1 /CONTINUE PROCESSING FIRST CHAR /A030 LFNLP, JMS SSRBRD /GET NEXT CHAR DCA T1 /SAVE IT LFNLP1, TAD T1 /M030 TAD (-76 /SEE IF '>' SNA JMP LFNDN /YES, DONE FIELD TAD (2 /SEE IF '<' SNA CLA JMP REVLBFN / ERROR - '<' IN FIELD NAME /M025 ISZ FNCNT /Incrament the absolute string length /a044 TAD DEADKEY /Check dead key status /a044 SNA CLA /Are we processing a dead key sequence? /a044 ISZ SSCNT /NO, SEE IF MORE THAN 30 PRINTING CHARS /m044 JMP .+2 JMP REVLGFN / ERROR - FIELD NAME EXCEEDS 30 CHARS. /M025 TAD T1 /GET BACK CHAR DCA I GPPTR /AND STORE IN STRING JMP LFNLP /LOOP BACK FOR MORE LFNDN, TAD SSCNT /GET COUNT OF WORDS USED TAD (GPBSIZ+1 SNA CLA /m044 JMP NULL /EOR, JUST '<>' FOUND /d044 DCA FNCNT /SAVE FN LENGTH DCA I GPPTR /STORE TRAILING 0 ISZ LFLDNM /DO A SKIP RETURN NULL, JMP I LFLDNM /RETURN XSCMP, 0 /DOES A MATCH OF AN ASCII AND AN ASCIZ STRING /RETURNS AC OF 0 IF FAILED AND -1 IF MATCHES /CALLED WITH AC EQUAL TO NO. OF CHARS. IN THE 1ST STRING (ASCII) /TO TRY TO MATCH. POSITIVE TO MAKE SURE MATCHED TO END /OF 2ND STRING, NEG. FOR DON'T CARE /JMS XSCMP /ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD) /ADDR OF 2ND STRING -ASCIZ /FIELD FOR 2ND STRING /RETURN (TO THSFLD) SMA /CHECK FOR TRAILING 0 ? JMP XSCM1 /YES DCA XSCNT /NO, JUST STORE COUNT DCA XSZFLG /AND RESET FLAG /m044 JMP XSCM2 XSCM1, CIA /NO. OF CHARS TO SEARCH DCA XSCNT AC7777 /a044 DCA XSZFLG /SET FLAG TO CHECK FOR TRAILING 0 XSCM2, AC7777 TAD I XSCMP /GET ADDR OF 1ST STRING DCA TAI1 /SET-UP AUTO-INDEX ISZ XSCMP /MOVE TO NEXT ARG AC7777 TAD I XSCMP /ADDR OF SECOND STRING DCA TAI2 ISZ XSCMP TAD I XSCMP /GET CDF FOR 2ND STRING DCA XSCLP /SET-UP TO EXECUTE ISZ XSCMP /MAKE SURE WE RETURN TO THE RIGHT PLACE TAD XSCLP /GET THE CDF BACK DCA XSCLP1 /AND STORE CAUSE WE'LL NEED IT AGAIN XSCLP, 0 /FOR THE CDF TAD I TAI2 /CHAR FROM 2ND STRING CDFMYF /BACK TO HOME FIELD SNA /SEE IF END OF STRING JMP I XSCMP /YES, SO RETURN WITH 0 IN AC AND P177 /NO, GET RID OF ALL CONTROL /d044 IAC /MAKE CHAR ONE LESS CMA /AND NEGATE /m044 DCA T1 /STORE IN TMP AC0001 /SET UP TO TEST FOR WILD CARD TAD I TAI1 /GET CHAR FROM 1ST STRING SNA /WILD CARD CHAR ? JMP XSCLP2 /YES, DO MATCH FOUND CODE TAD T1 /NO, SUBTRACT 2ND STRING CHAR - 1 SZA CLA /ARE THEY THE SAME? JMP I XSCMP /NOPE, RETURN WITH A 0 IN AC XSCLP2, ISZ XSCNT /DID WE LOOK AT ENOUGH CHARS? JMP XSCLP /NO, COMPARE SOME MORE ISZ XSZFLG /YES, CHECK ASCIZ FLAG /m044 /d044 SZA CLA JMP XSCM3 /NOPE, JUST SET FOR SUCCESS XSCLP1, 0 /YES, DO THE CDF TAD I TAI2 /MAKE SURE WE'RE AT THE END CDFMYF /BACK TO HOME FIELD SNA CLA /0, FOR NOT AT THE END OF STRING XSCM3, AC7777 / -1 FOR SUCCESS JMP I XSCMP /RETURN XSCNT, 0 XSZFLG, 0 / THIS ROUTINE IS USED TO INSURE THAT THE RECORD NUMBER COUNT (RECNUM), / THE RECORD PROCESSED COUNT (RECPRO), AND THE MERGED RECORD COUNT (SUCREC) / DOES NOT EXCEED THE LIMIT OF THE NUMBER OF RECORDS THAT WE CAN PROPERLY / DISPLAY (4095 DECIMAL, 7777 OCTAL). IOA'S ABILITY TO PRINT DECIMAL NUMBERS / FROM OCTAL HAS A RANGE OF 0 - 4095 DECIMAL (0 - 7777 OCTAL). THUS IF RECNUM / RECPRO, OR SUCREC REACH A VALUE OF 4095 DECIMAL (7777 OCTAL) WE WILL KEEP / IT AT THAT COUNT WITH OUT INCREMENTING IT TO ZERO. INCNUM, XX / INCREMENT NUMBER BUT NOT PAST 7777 /A042 TAD I INCNUM / PICK UP THE POINTER TO THE WORD /A042 DCA T2 / TO BE INCREMENTED AND THEN INCREMENT /A042 ISZ I T2 / THE WORD POINTED TO BY T2 /A042 JMP INCDON / IT'S OK, GO RETURN TO CALLER /A042 CMA / INCREMENT FAILED /A042 DCA I T2 / RESET THE COUNT BACK TO MINUS ONE /A042 INCDON, ISZ INCNUM / BUMP RETURN ADDRESS OVER POINTER /A042 JMP I INCNUM / RETRUN TO CALLER /A042 / WHEN CALLING ANY OF THE REV???? ERRORS YOU MUST ENTER WITH AC = 0! /A025 REVLGNM,TAD (EVLGNM-EVRBFD) / FIELD VALUE NUM. EXCEEDS 30 CHARS. /A025 REVRBFD,TAD (EVRBFD-EVLGFN) / '>' IN A FIELD /A025 REVLGFN,TAD (EVLGFN-EVLBFN) / FIELD NAME EXCEEDS 30 CHARACTERS /A025 REVLBFN,TAD (EVLBFN-EVCRBR) / '<' IN FIELD NAME /A025 REVCRBR,TAD (EVCRBR-EVPEOF) / TEXT BETWEEN RECORDS /A025 REVPEOF,TAD (EVPEOF-EVLGRC) / END OF FILE ERROR /A025 REVLGRC,TAD (EVLGRC) / RECORD EXCEEDS 2500 CHARACTERS /A025 ERRHAN, DCA ERRNUM /SAVE ERROR NUMBER /M025 AC7777 /GET -1 INTO THE AC /A028 JMP SELCTX /BYPASS "DOMATH" IF ERROR ENCOUNTERED BY LP /A028 ERRNUM, 0 /M025 ERRXIT, CIFMNU / CALL REPORTER /A025 JMS I OLAYCL /A025 11 JMP REPORT / GO REPORT RESULTS /A025 /-------------- PAGE /DISPLAY THE RECORD NO. BEING PROCESSED /M019 DISREC, XX /M019 AC0001 / SET RECORD NUMBER FOR OUTPUT /A019 TAD RECNUM DCA DISRE1 / STORE NUMBER FOR OUTPUT /A019 CIFMNU /A019 JMS I IOACAL /A019 0 /A019 DISMSG / ADDRESS OF TEXT STRING TO OUTPUT /A019 0000 / ^P - POSITION CURSOR TO HOME /A019 DISRE1, .-. / ^D - RECORD NUMBER TO OUTPUT /A019 / ^L - ERASE TO END OF LINE /A019 0100 / ^P - POSITION CURSOR (LINE 1, COL. 0) /A019 / ^L - ERASE TO END OF LINE /A019 2700 / ^P - POSITION CURSOR (LINE 27, COL. 0)/A042 JMP I DISREC /RETURN /A019 DISMSG, IFDEF ENGLSH < TEXT '^P&RECORD BEING PROCESSED: ^D^L^P^L^P' > /M042 IFDEF ITALIAN< TEXT '^P&RECORD IN ELABORAZIONE: ^D^L^P^L^P' > IFDEF CANADA < TEXT "^P&ENR. EN COURS DE TRAITEMENT: ^D^L^P^L^P" > /M042 IFDEF FRENCH < TEXT "^P&ENREGISTREMENT EN COURS : ^D^L^P^L^P" > /M042 IFDEF DUTCH < TEXT "^P&GEGEVENSGROEP VERWERKT: ^D^L^P^L^P" > /M042 IFDEF GERMAN < TEXT "^P&VERARBEITETER SATZ: ^D^L^P^L^P" > /M042 IFDEF NORWAY < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" > /M042 IFDEF SWEDSH < TEXT "^P&BEHANDLADE F\REKOMSTER: ^D^L^P^L^P" > /L.U.O /M042 IFDEF DANISH < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" > /M042 /SUBROUTINE TO HANDLE UNBUNDLING - CHECK IF MATH FEATURE IS ACTIVATED /A020 /THIS ROUTINE IS CALLED WHEN A CONTROL BLOCK IS FOUND IN LIST /A020 /PROCESSING. IF THE MATH FEATURE IS ON THEN THE BLOCK IS PROCESSED, /A020 /AND IF IT IS NOT THEN AN EXIT IS DONE FROM "CHKMTH" TO THROW OUT THE /A020 /CONTROL BLOCK AND CONTINUE NORMAL LIST PROCESSING /A020 /ROUTINE IS CALLED FROM INSIDE "CNTROL" ROUTINE /A020 IFDEF UNBUND < /A020 CHKMTH, XX /CHECK MATH FEATURE ROUTINE /A020 CDFMNU /SET TO MENU DATA FIELD /A020 TAD I (MUBUF+MNOPTC /GET ACTIVE FEATURES CONTROL WORD /A020 CDFMYF /RETURN TO LIST PROCESSING FIELD /A020 AND (MABIT /GET ACTIVATED MATH FEATURE CONTROL WORD /A020 SZA CLA /IS THE MATH FEATURE ACTIVATED? /M027 ISZ CHKMTH / YES: SKIP RETURN TO PROCESS LP CONTROL BLOCK /M027 JMP I CHKMTH / NO: NORMAL RETURN TO DUMP CTRL BLOCK &.... /M027 / ...RETURN TO REGULAR LP /M027 > /END IFDEF UNBUND /A020 /SUBROUTINE USED IN CONJUNCTION WITH LP MATH INTERFACE ROUTINE "CNTROL" /A021 /CHECKS FOR END OF CONTROL BLOCK CHAR. AND TREATS IT ACCORDINGLY /A021 /THIS RTN CAN ONLY BE UNDERSTOOD WITHIN THE CONTEXT OF "CNTROL" /A021 /NOTE: IN THIS ROUTINE THE "JMP EXITCB" TO EXIT VARIES WITH THE /A038 / PSUEDO-CODE FOR "CNTROL". THIS IS DONE TO SAVE ON LOCATIONS /A038 / SPACE AND EXECUTION TIME. NORMALLY WOULD SAY THE FOLLOWING IN /A038 / PLACE OF "JMP EXITCB". /A038 / ------------- / ------------- /A038 / JMP EXITC1 (THIS WOULD REPLACE "JMP EXITCB") /A038 / ------------- /A038 / EXITC1, DCA ENDCBF (THIS WOULD BE ADDED AT END OF "CHKEOB" /A038 / JMP NXCTRL (THIS WOULD BE ADDED AT END OF "CHKEOB" /A038 CHKEOB, XX /"END OF BLOCK" CHAR SERVICE ROUTINE /A021 TAD T1 /GET BACK CHAR JUST READ IN FROM CTRL BLOCK /A021 TAD (-1414 /GET NEGATIVE OF END OF CONTROL BLOCK CHAR /A021 SZA CLA /IS IT THE END OF THE CONTROL BLOCK? /A021 JMP I CHKEOB / NO: GO CONTINUE NORMAL PROCESSING OF BLOCK /A021 TAD STRTLN / YES: GET "START OF NEW LINE" FLAG /A021 SNA CLA /IS IT THE START OF A NEW LINE? /A021 JMP EXITCB / YES: GO EXIT CONTROL BLOCK PROCESSING /A021 JMP CTLOVR / NO: GO CONVERT CHAR, SET FLAG, & PROCESS /A021 /SUBROUTINE TO TAKE JUSTIFIED SPACE (ECJSPC) AND WRAPPED LINE (ECWWLN) /A022 /CHARACTERS AND STRIP THEM OUT BEFORE PUTTING CONTROL BLOCK CHARACTERS /A022 /INTO LINEBUFFER (LNEBUF) IN MATH FIELD. THIS ROUTINE UNDERSTOOD IN /A022 /CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE /A022 STRPCH, XX /STRIP WRAPS & SOFT SPACES ROUTINE /A022 TAD (-ECWWLN /GET NEGATIVE OF SOFT RETURN /A022 TAD T1 /GET CONTROL BLOCK CHAR READ FROM FILE /A022 SNA /IS IT A WRAPPED RETURN? /A022 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A022 TAD (ECWWLN-ECJSPC / NO: RESET CHAR & GET SOFT SPACE /A022 SNA /IS IT A JUSTIFIED SPACE? /A022 /M033 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A022 TAD (ECJSPC-ECHYLN / NO: RESET & GET SOFT RTN WITH HYPHEN /A033 SNA CLA /IS IT A SOFT RETURN WITH HYPHEN? /A033 JMP CATCH1 / YES: DUMP IT & GO READ IN NEXT CHAR /A033 JMP I STRPCH / NO: RETURN TO CALLER TO ENTER CHAR IN LNEBUF /A022 /SUBROUTINE USED TO THROW OUT A CONTROL BLOCK IF IT IS NOT MATH. /A023 /UNDERSTOOD IN THE CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE /A023 JNKBLK, XX /DUMP NON-MATH CONTROL BLOCK - ROUTINE /A023 CLA /CLEAR AC /A023 TAD ENDCBF /GET "END OF CONTROL BLOCK" FLAG /A023 SNA CLA /IS IT THE END OF THE BLOCK? /A023 JMP EXTJNK / YES: GO EXIT /A023 ENDBLK, JMS RDNXCH / NO: GO READ IN NEXT CHAR /A023 SPA SNA /IS IT AN "END OF FILE" CHAR? /A023 JMP RTNCHR / YES: RETURN TO CALLER WITH EOF ERROR /A023 TAD (-ECPCT2 / NO: ADD NEGATIVE OF "END OF CTRL BLOCK" CHAR /A023 SZA CLA /IS IT THE END OF THE CONTROL BLOCK? /A023 JMP ENDBLK / NO: DUMP CHAR & GO GET ANOTHER CHAR /A023 EXTJNK, JMP I JNKBLK / YES: GO EXIT TO CONTINUE NORMAL L.P. /A023 NUMCMP, 0 /COMPARES TWO NUMBERS OF EQUAL LENGTH /AND DETERMINES IF THEY ARE EQUAL OR WHICH IS LARGER. /FIRST NUMBER (IN ASCII) IS POINTED BY SPCSTR. /SECOND NUMBER (ASCIZ) IS IN THE GPBUF BUFFER. /CALLED BY: /JMS NUMCMP /RETURN (AC = 0 MEANS NUMBERS EQUAL, / AC = +1 MEANS NUMBER 2 > NUMBER 1, / AC = -1 MEANS NUMBER 2 < NUMBER 1) AC7777 /SET UP PTR TO FIRST NUMBER TAD SPCSTR /IN AUTO-INDEX DCA TAI1 TAD NUMFLD / IF NUMERIC COMPARE ( <:NAME> ) /A030 SZA CLA / THEN /A030 JMP NUMCM1 / USE BCD COMPARE ROUTINE /A030 TAD (GPBUF-1 /SET UP PTR TO NUMBER 2 DCA TAI2 /IN AUTO-INDEX NMCMLP, TAD I TAI2 /GET A CHAR SNA / NULL ? JMP I NUMCMP /YES, RETURN WITH NUMBERS EQUAL CIA /NO, SUBTRACT FROM TAD I TAI1 /FIRST NUMBER SNA /SAME ? JMP NMCMLP /YES, KEEP GOING SMA CLA /NO, SET AC AC7776 /-1 FOR LESS THAN IAC /+1 FOR GREATER THAN JMP I NUMCMP /AND RETURN /THIS IS FORM COMPARING NUMBERS THAT ARE IN NUMERIC FIELDS LIKE <:A> /A030 / AS OPPOSED TO /A030 NUMCM1, TAD (BCDAR2-1 /GET ADDRESS OF PLACE FOR BCD IN MATH FIELD /A030 DCA TAI2 / AND PUT IN AUTO INCREMENT REGISTER /A030 TAD (-6 / GET SIZE OF PACKED BCD WORD /A030 DCA T1 / AND INITIALIZE LOOP COUNTER /A030 NUMCM2, TAD I TAI1 / LOOP; GET BCD VALUE FORM SPEC TABLE /A030 CDFMTH / /A030 DCA I TAI2 / AND PUT IN MATH FIELD /A030 CDFMYF / /A030 ISZ T1 / /A030 JMP NUMCM2 / END_LOOP /A030 CIFMTH / NOW CALL ARITHMETIC COMPARE ROUTINE IN MATH /A030 JMS BCDCOM / FIELD /A030 BCDAR1 / ADDRESS OF NUMBER FROM SPEC DOC /A030 BCDAR2 / ADDRESS OF NUMBER FROM LIST /A030 JMP I NUMCMP /RETURN (AC = 0 MEANS NUMBERS EQUAL, /A030 / AC = +1 MEANS NUMBER 2 > NUMBER 1, /A030 / AC = -1 MEANS NUMBER 2 < NUMBER 1) /A030 /-------------- PAGE /THIS ROUTINE CHECKS TO SEE IF THE RECORD NUMBER IS WITHIN /A042 /THE RANGE OF THE FROM - TO SETTINGS. IT ALSO CHECKS TO SEE /A042 /IF THE HALT FLAG IS SET BY THE USER PRESSING GOLD-HALT /A042 / CALLED BY: /A042 / JMS CHKREC /A042 / SKIP RECORD RETURN /A042 / DONE ALL RECORDS RETURN OR HALT FLAG SET RETURN /A042 / PROCESS RECORD RETURN /A042 CHKREC, XX /A042 CDFSYS / CHANGE TO THE SYSTEM FIELD /A042 TAD I HLTFLG / PICK UP THE HALT FLAG /A042 CDFMYF / CHANGE BACK TO OUR FIELD /A042 SZA CLA / SKIP IF HALT FLAG IS NOT SET /A042 JMP CHKPRC / SET, RETURN WITH NO MORE RECORDS /A042 TAD FRREC / PICK UP THE FROM RECORD COUNT /A042 CIA STL / NEGATE IT AND SET THE LINK /A042 TAD RECNUM / COMBINE WITH CURRENT RECORD NUMBER /A042 SZL CLA / SKIP IF ABOVE LOWER RANGE /A042 JMP CHKXIT / TOO LOW, SKIP THIS RECORD /A042 ISZ CHKREC / BUMP RETURN ADDRESS /A042 TAD TOREC / GET THE RECORD NUMBER TO PROCESS UP TO/A042 SNA / IS TO-RECORD NUMBER ZERO ? /A042 JMP CHKPRC / YES, GO TO PROCESS RECORD RETURN /A042 CIA CLL / NEGATE IT AND CLEAR THE LINK /A042 TAD RECNUM / COMBINE WITH CURRENT RECORD NUMBER /A042 SNL CLA / IF LINK IS SET, THEN WE ARE ALL DONE /A042 CHKPRC, ISZ CHKREC / BUMP RETURN PAST ALL DONE RETURN /A042 CHKXIT, JMS INCNUM / BUMP THE RECORD COUNT TO NEXT RECORD /A042 RECNUM / POINTER TO THE RECORD NUMBER /A042 JMP I CHKREC / RETURN TO CALLER /A042 TOREC, 0 FRREC, 0 NUM, /LOADS A STRING FROM RECBUF INTO GPBUF REMOVING /M025 /ALL NON-NUMERIC CHARS. AND ALL LEADING ZEROES. /M025 CLA TAD LDNMFL /HAVE WE BEEN HERE BEFORE ? SZA CLA JMP NUM1 / YES - SO GET OUT! /M025 ISZ LDNMFL /NO, MAKE SURE WE DON'T COME AGAIN TAD (GPBUF-1 /SET UP AUTO-INDEX PTR DCA GPPTR TAD (GPBSIZ+1 /AND COUNTER CIA DCA NUMSIZ AC7777 /RESET REC BUFFER PTR TO BEGINNING OF FIELD TAD FDSTRT DCA RCBPTR TAD (SPA SNA) /SET TO IGNORE LEADING ZEROES DCA NUM4 /M025 TAD NUMFLD /IF NUMERIC FIELD ( <:NAME> ) /A030 SZA CLA /A030 JMP NUM6 /THEN HANDLE REAL NUMBER /A030 NUM3, JMS SSRBRD /GET A CHAR /M025 TAD (-74 /SEE IF '<' ? SNA JMP NUM5 /YES, ALL DONE /M025 TAD (-2 /NO, SEE IF '>' ? SNA / SKIP IF: NOT A '<' /M025 JMP REVRBFD / ERROR - '>' IN A FIELD /M025 TAD (4 /NO, SEE IF ASCII 9 OR LESS SMA JMP NUM3 /NO, SKIP IT /M025 TAD (12 /YES, SEE IF ASCII 0 OR MORE NUM4, XX /MODIFIED TO IGNORE LEADING ZEROES /M025 JMP NUM3 /SKIP CHAR /M025 TAD (60 /MAKE ASCII AGAIN ISZ NUMSIZ /SEE IF ROOM FOR CHAR JMP NUM2 CLA CLL /A025 JMP REVLGNM / ERROR - FIELD VALUE NUMBER EXCEEDS 30 /M025 / CHARACTERS /A025 NUM2, DCA I GPPTR /STORE CHAR TAD (SPA /TURN OFF ZERO SUPRESSION DCA NUM4 /M025 JMP NUM3 /GET ANOTHER CHAR /M025 NUM5, TAD NUMSIZ /CALCULATE SIZE OF NUMBER TAD (GPBSIZ+1 DCA NUMSIZ /AND SAVE IT DCA I GPPTR /STORE TRAILING ZERO NUM1, JMP ENUM / GO SEE IF EXACT COMPARE /M025 NUM6, JMS LDFLD / LOAD NUMBER INTO TOKVAL BUFFER IN /A030 / MATH FIELD /A030 JMP ORLP / NO NUMBER IN FIELD SO FAIL ON MATCH /A030 JMS TOKOUT / OUTPUT TRAILING ZERO IN TOKVAL /A030 CIFMTH / CALL ASCII TO BCD ROUTINE IN MATH FLD /A030 JMS ASCBCD / /A030 TOKVAL / ADDRESS OF ASCII (IN MATH FIELD) /A030 BCDAR1 / ADDRESS OF BCD OUTPUT (IN MATH FLD) /A030 JMP ABERR / INVALID NUMBER SO FAIL MATCH /A036 / CHECK NEXT OR GROUP /A030 AC0006 / MAKE NUMBER SIZE = LENGTH OF PACKED/A030/M036 DCA NUMSIZ / SO IT IS SAME AS MLEN AND ELEN /A030 JMP ENUM / NOT GO DO COMPARES /A030 NUMSIZ, 0 LDNMFL, 0 TRUE, TAD I PTYWD /TRUE, GET TYPE WORD CLL RTL /SEE WHICH WAY TO SET SIGN BIT SZL JMP TRUFLS /MUST WANT IT SET TO FALSE (1) RAR /OTHERWISE, GET IN POSITION CLL RAR /AND SET SIGN BIT TO TRUE (0 - POSITIVE) TRUE1, DCA I PTYWD /AND STORE BACK NXTSPC, TAD NXTSPR /GET PTR TO NEXT SPEC SNA /LAST ONE? JMP FNLP /YES, NEXT FIELD TAD (-1 /NO, MAKE THIS SPEC JMP FNLP2 TRUFLS, RAR /GET IN POSITION STL RAR /AND SET SIGN BIT TO FALSE (1 - NEGATIVE) JMP TRUE1 /AND STORE IT PTYWD, 0 /-------------- PAGE /++ / LIST PROCESSING CONTROL BLOCK EVALUAION CODE / /FUNTIONAL DESCRIPTION: "CNTROL" / / PSUEDO-CODE DESCRIPTION: / / SET END_OF_CONTROL_BLOCK FLAG = FALSE / IF MATH FEATURE NOT ACTIVE / THEN DUMP CONTROL BLOCK / RETURN TO NORMAL L.P. PROCESSING / ELSE SET CONTROL_BLOCK_FIRST_LINE FLAG = TRUE / DO WHILE END_OF_CONTROL_BLOCK FLAG = FALSE / SET START_OF_NEW_LINE FLAG = TRUE / INIT INPUT LINE BUFFER IN MATH FIELD / DO WHILE START_OF_NEW_LINE = FALSE / GET CHAR FROM RECORD / IF CHAR = EOF / THEN RETURN TO CALLER WITH EOF ERROR / ELSE SAVE CHAR / CASE OF CHAR = / / SPECIAL "END OF CTRL BLOCK" CHARACTERS: / IF START_OF_NEW_LINE = FALSE / THEN SET END_OF_CONTROL_BLOCK FLAG = FALSE / ELSE SET "END OF CTRL BLOCK" CHAR = HARD RETURN / ENDIF / / START OF RULER CHAR: / DUMP RULER CHARACTERS / RETURN TO GET NEXT CHAR / / SPECIAL CHAR: / IF START_OF_NEW_LINE = TRUE / THEN DUMP SPECIAL CHAR / RETURN TO GET NEXT CHAR / ENDIF / / SOFT WRAP OR JUSTIFIED SPACE: / DUMP CHARACTER / RETURN TO GET NEXT CHAR / / END PARAGRAPH OR CENTERED LINE: / SET CHAR = HARD RETURN / / END CASE / / PUT CHAR INTO INPUT LINE BUFFER / CASE RETURN FROM MATH = / / SINGLE SKIP RETURN: / PASS RETURNED ERROR NUMBER TO ERROR HANDLER / / DOUBLE SKIP RETURN: / THROW OUT CONTROL BLOCK BECAUSE IT IS NOT MATH BLOCK / / TRIPLE SKIP RETURN: / IF LAST CHAR PUT IN INPUT LINE BUFFER = HARD RETURN / THEN GO TO MATH & PROCESS LINE / CASE RETURN FROM MATH = / / REGULAR RETURN: / SET START_OF_NEW_LINE FLAG = TRUE / / SINGLE SKIP RETURN: / PASS RETURNED ERROR NUMBER TO ERROR HANDLER / / DOUBLE SKIP RETURN: / THROW OUT BLOCK CAUSE NOT MATH / / END CASE / ENDIF / END CASE / ENDIF / END DO / END DO / RETURN TO NORMAL LP PROCESSING / END PSUEDO-CODE / /CALLING SEQUENCE: . / /NOTE; THE HOOK IS MADE FROM LIST PROCESSING WITHIN THE "GETCHR" RTN /WHERE THE CODE CHECKS FOR A PRINT CONTROL BLOCK. THE FOLLOWING SHOWS /EXACTLY WHERE THIS IS DONE: / /GETCHR,0 . /THIS ROUTINE READS CHARS FROM A FILE / . / . /RTNCHR,JMP I GETCHR / . / . / . /SSCPC, TAD TI /SEE IF START OF CONTROL BLOCK / TAD (-1014 /GET NEGATIVE OF CONTROL BLOCK CHARACTER / SZA CLA /IS IT START OF CONTROL BLOCK? / JMP GTCHRT / NO: MUST HAVE BEEN NORMAL FF /*******JMP CNTROL******/ YES: HOOK MADE HERE TO CONTROL BLOCK PROCESSING *** / . / /INPUT PARAMETERS: FSTLNE,MNOPTC,MABIT,T1 / /IMPLICIT INPUT: ENDCBF, STRTLN, CALLS TO RTRN1, RTRN2, RTRN3, RDNXCH / /OUTPUT PARAMETERS: (TO THE MATH MODULE) / /IMPLICIT OUTPUT: ENDCBF,STRTLN, / /COMPLETION CODE: / / "JMP RTNCHR" - RETURN THRU GETCHR TO CALLER IN CASE OF EOF ERROR / "JMP ERRHAN" - PASSES ENCOUNTERED MATH ERRORS BACK THRU ERROR HANDLER / "JMP GTCHLP" - RETURN TO GETCHR RTN TO CONTINUE NORMAL PROCESSING ONCE / BLOCK PROCESSING COMPLETED. / /SIDE EFFECTS: SET UP OF DATA STRUCTURES & PARAMETERS IN THE MATH / MODULE; "CNTROL" INTERACTS DIRECTLY AND INDIRECTLY WITH / THE MATH. / THIS CODE IS USED IN LIST PROCESSING TO PARSE THE / CONTROL BLOCKS IN A LIST. IT CHECKS WHETHER IT IS A / MATH CONTROL BLOCK AND, IF SO, WHAT CONTROL WORDS ARE / USED IN THE BLOCK. IT ALSO MAKES USE OF THE COMMAND / PARSER AND TRANSLATOR TO PERFORM THIS PROCESSING. / /-- /LIST PROCESSING MATH CONTROL BLOCK PROCESSING CODE. /THIS CODE HANDLES ONLY CHARACTERS WITHIN THE CONTROL BLOCK /VALUES USED IN CONTROL BLOCK EVALUATION CODE ENDCBF, 0 /"END OF CONTROL BLOCK" FLAG STRTLN, 0 /"START OF NEW LINE" FLAG /CONTROL BLOCK MATH EVALUATION CODE /NOTE: WITHIN THE LIST PROCESSING CONTROL BLOCK CODE, "CIF'S" MADE TO THE MATH /FIELD ARE HANDLED IN THE CALLED MATH FIELD ROUTINE SO AS TO AUTOMATICALLY /RETURN PROGRAM CONTROL TO THE LIST PROCESSING FIELD ONCE THE CALLED MATH /FIELD ROUTINE HAS BEEN EXECUTED. /FIRST SET "END OF CONTROL BLOCK" FLAG ACCORDINGLY CNTROL, AC0001 /PUT 1 IN THE AC DCA ENDCBF /SET "END OF CONTROL BLOCK" FLAG = FALSE /BEFORE PROCESSING CONTROL BLOCK SEE IF UNBUNDLING IS DEFINED /A020 IFDEF UNBUND < /A020 JMS CHKMTH /IF UNBUNDLING DEFINED THEN GO SEE IF MATH /A020 /FEATURE IS ACTIVATED. IF IT IS THEN ROUTINE /A020 /WILL SKIP RETURN HERE TO PROCESS CONTROL BLOCK /M027 /IF NOT THEN THE BLOCK IS DUMPED AND A RETURN /A020 /IS DONE TO NORMAL LIST PROCESSING /A020 JMP ENDPCB /RETURN HERE FROM "CHKMTH" IF NOT MATH - DUMP /A027 /...BLOCK & GO BACK TO NORMAL LIST PROCESSING /A027 > /END IFDEF UNBUND /A020 /SKIP RETURN HERE FROM "CHKMTH" IF MATH ACTIVATED /A027 /GO INITIALIZE "CONTROL BLOCK FIRST LINE" FLAG CDFMTH /CHANGE DATA FIELD REGISTER TO MATH FIELD DCA I (FSTLNE /GO SET "CONTROL BLOCK FIRST LINE" FLAG = TRUE CDFMYF /RESET TO LP DATA FIELD /CHECK FOR END OF CONTROL BLOCK. IF NOT END OF BLOCK THAN /INITIALIZE "START OF NEW LINE" FLAG AND MATH FIELD INPUT /LINE BUFFER POINTER NXCTRL, TAD ENDCBF /GET "END OF CONTROL BLOCK" FLAG SNA CLA /IS IT THE END OF THE CONTROL BLOCK? JMP EXITCB / YES: GO EXIT CONTROL BLOCK PROCESSING CODE DCA STRTLN / NO: SET "START OF NEW LINE" FLAG = TRUE CIFMTH /CHANGE PROGRAM CONTROL TO MATH FIELD JMS RTRN1 /INITIALIZE INPUT LINE BUFFER POINTER IN MATH FIELD /PROCESS CHARACTERS WITHIN THE CONTROL BLOCK CATCH1, JMS RDNXCH /GET A CHARACTER FROM THE FILE SPA SNA /IS THE CHARACTER RETURNED AN END OF FILE? JMP RTNCHR / YES: RETURN TO CALLER WITH EOF ERROR DCA T1 / NO: SAVE IT /THE FOLLOWING CALL IS MADE TO "CHKEOB" AS A SUBROUTINE TO /A021 /HANDLE SPECIAL CASES OF "END OF CTRL BLOCK" CHAR /A021 /A RETURN IS DONE BACK HERE IF NONE OF THE SPECIAL CASES /A021 /WERE MET. OTHERWISE THEY WILL BE TREATED DIRECTLY FROM THAT /A021 /ROUTINE. (DONE THAT WAY DUE TO LACK OF SPACE ON THIS PAGE) /A021 JMS CHKEOB /CHECK ON SPECIAL "END OF CTRL BLOCK" CASES /A021 /RETURN TO CONTINUE PROCESSING IF ALL IS WELL /A021 /CHECK FOR RULERS IN THE BLOCK TAD T1 /GET CHARACTER BACK TAD (-16 /GET NEGATIVE OF START OF RULER SNA CLA /IS IT THE START OF A RULER? JMP ENDRUL / YES: GO DUMP RULER CHARACTERS / NO: THEN CHECK FOR START OF NEW LINE TAD STRTLN /GET "START OF NEW LINE" FLAG SZA CLA /IS IT THE START OF A NEW LINE? JMP INPCHK / NO: THEN CONTINUE TO PROCESS CHARACTER /A022 /SCREEN OUT LEADING SPECIAL CHARACTERS FROM INPUT LINE TAD T1 / YES: GET INPUT CHAR BACK AND P177 /SCREEN OUT HIGH BITS TAD (-41 /GET NEGATIVE OF UPPER LIMIT OF SPECIAL CHARACTERS SPA /IS IT A SPECIAL CHARACTER? JMP CATCH1 / YES: DUMP IT AND READ IN NEXT CHARACTER DCA STRTLN / NO: SET "START OF NEW LINE" FLAG = FALSE /GO STRIP OUT ANY SOFT RETURNS AND/OR SOFT SPACES /A022 INPCHK, JMS STRPCH /GO DUMP WRAPS & JUSTIFIED SPACES /A022 /PUT CHARACTER READ IN FROM FILE INTO INPUT LINE BUFFER IN MATH FIELD INPCHR, TAD T1 /GET CHARACTER BACK INTO AC DCA PASOVR /SAVE IT IN LOCATION AFTER CALL TO MATH FLD TO PASS IT CIFMTH /SET PROGRAM CONTROL TO MATH FIELD JMS RTRN2 /AND GO PUT INPUT CHARACTER INTO INPUT LINE BUFFER PASOVR, 0 /CONTAINS INPUT CHAR TO PASS TO RTRN2 RTN IN MATH FLD JMP ERRHAN /SKIP RETURN TO HERE FROM RTRN2 IF THERE WAS A /A025A /MATH FIELD INPUT LINE BUFFER OVERFLOW WITHIN /A025A /THE CONTEXT OF A MATH CONTROL BLOCK /A025A /THE AC CONTAINS THE PASSED ERROR NUMBER /A025A JMP ENDPCB /DOUBLE SKIP RETURN DONE HERE FROM "RTRN2" IF /INPUT LINE BUFF OVERFLOW AND NOT A MATH CONTROL BLOCK / - PROCEED TO THROW OUT THE CONTROL BLOCK. TAD T1 /TRIPLE SKIP RETURN FROM "RTRN2" DONE HERE IF INPUT /CHARACTER PLACED INTO INPUT LINE BUFFER WITHOUT AN /OVERFLOW. CONTINUE TO SEE IF LAST CHAR READ IN IS A /LINEFEED (I.E. HARD RETURN). TAD (-ECNWLN /GET NEGATIVE OF NEW LINE (HARD RETURN) SZA CLA /IS IT THE END OF THE LINE BEING READ IN? JMP CATCH1 / NO: GO GET NEXT CHARACTER CIFMTH / YES: GO TO MATH FIELD TO PROCESS INPUT LINE JMS RTRN3 /PROCESS STRING OF CHAR JUST READ INTO INPUT LINE BUFF JMP NXCTRL /GO START NEW INPUT LINE /NOTE: IF AN ERROR IS ENCOUNTERED IN THE MATH CODE WHILE PROCESSING /THE MATH CONTROL BLOCK THEN A SKIP RETURN IS DONE FROM "JMS RTRN3" /WITH ERROR NUMBER IN THE AC. JMP ERRHAN /GO PROCESS ERROR RETURNED FROM THE MATH MODULE /NOTE: IF THE ABOVE "JMS RTRN3" ROUTINE FINDS NO MATCH UP IN THE /SYMBOL TABLE WITH THE INPUTTED CONTROL WORD, AND IT IS THE FIRST LINE /OF CHARACTERS OF THE CONTROL BLOCK THAN, WHEN RETURNING TO /LIST PROCESSING, A DOUBLE SKIP RETURN IS DONE /TO THE FOLLOWING CODE IN ORDER TO PROCESS AS NOT BEING A "MATH" /CONTROL BLOCK. /THROW OUT CONTROL BLOCK IF IT IS NOT MATH, THEN RETURN TO L.P. ENDPCB, JMS JNKBLK /M023 /A NORMAL RETURN IS DONE FROM "ENDPCB" IF NO PROBLEM /M023 /IS ENCOUNTERED WHILE STRIPPING OUT NON-MATH CTRL BLOCK /M023 /OTHERWISE SPECIAL CASE OF EOF HANDLED FROM "JNKBLK" /M023 EXITCB, JMP GTCHLP /GO BACK TO CONTINUE NORMAL PROCESSING /RTN TO PROCESS END OF CONTROL BLOCK CHAR IN CONTROL BLOCK. THIS IS /DONE IN THE CASE WHERE AN "END OF CONTROL BLOCK" CHAR TERMINATES /THE BLOCK WHILE NOT PRECEDED BY A "LINE FEED" (I.E. HARD RETURN) /CHAR. IT IS REPLACED BY A HARD RETURN TO ACCOMODATE THE "LEXIC" /ROUTNE IN THE MATH AREA. CTLOVR, TAD (ECNWLN /GET ASCII FOR LINEFEED (HARD RETURN) CHARACTER /CHANGE END OF CONTROL BLOCK CHAR WITH A HARD RETURN /CHAR TO MAKE INPUT LINE COMPATIBLE WITH LEXIC SCANNER DCA T1 /REPLACE END OF CONTROL BLOCK CHAR WITH IT DCA ENDCBF /SET "END OF CONTROL BLOCK" FLAG = TRUE JMP INPCHR /GO PUT LINEFEED CHAR INTO INPUT BUFFER & PROCESS LINE /THIS CODE THROWS OUT ANY RULERS IN THE PRINT CONTROL BLOCK ENDRUL, JMS RDNXCH /READ IN NEXT CHARACTER FROM FILE SPA SNA /IS THERE AN ERROR CONDITION? JMP RTNCHR /ABOVE "JMP GETCHR" SHOULD BE AN INDIRECT. BUT /A038 /THIS WOULD CAUSE AN ERROR SINCE "GETCHR" IS OFF/A038 /PAGE. THEREFORE THE RETURN HAS BEEN DONE THRU A/A038 /LABEL ON THE SAME PAGE AS "GETCHR" /A038 TAD (-17 / NO: GET NEGATIVE OF END OF RULER CHARACTER SZA CLA /IS IT THE END OF THE RULER? JMP ENDRUL / NO: TRY AGAIN JMP CATCH1 / YES: GO GET A CHARACTER FROM THE FILE / GET_FIELD_VALUE / (NOTE: THIS ROUTINE IS EXITED FROM NXTCHR IN NORMAL CIRCUMSTANCES ) / (* THIS ROUTINE WILL PUT THE FIRST CONTIGUOS STRING OF PRINTABLE CHARACTERS / FROM THE FIELD VALUE INTO A BUFFER TO BE USED IN CALLING THE ASCII TO / BCD ROUTINE *) LDFLD, XX TAD (TOKVAL-1 / INITIALIZE POINTERS DCA TAI2 / INIT POINTER TO OUTPUT IN MATH FIELD TAD (-GPBSIZ-1 /M024 DCA T1 / INIT COUNTER TO MAX. CHARS ALLOWED LDFLD1, JMS NXTCHR / WHILE NEXT_CHAR NOT PRINTABLE DO JMP LDFLD1 / GET NEXT_CHAR / END_WHILE ISZ LDFLD / SET UP SKIP RETURN TO SHOW WE DON'T HAVE / A NULL FIELD VALUE JMS TOKOUT / OUTPUT FIRST PRINTABLE CHARACTER ISZ T1 / INCREMENT COUNTER LDFLD2, JMS NXTCHR / LOOP GET_CAHR JMP LDFLD3 / EXIT IF NEXT_CHAR NOT PRINTABLE JMS TOKOUT / PUT CHARACTER INTO TOKVAL ISZ T1 / EXIT IF TOO MANY CHARACTERS JMP LDFLD2 / END-LOOP JMP REVLGNM / ERROR - FIELD VALUE NUMBER EXCEEDS 30 /M025 / CHARACTERS LDFLD3, JMS GFDEND / READ TO END OF CURRENT FIELD VALUE JMP I LDFLD / EXIT ROUTINE NXTCHR, 0 / READS CHAR FROM EDIT BUFFER, STRIPS MODE BITS / REGULAR RETURN IF UNPRINTABLE CHARACTER (I.E. LESS / THAN 41 OCTAL) / SKIP RETURN IF A PRINTABLE CHARACTER / EXITS LDFLD IF '<' (END OF FIELD) FOUND JMS SSRBRD / CALL GET_CHAR ROUTINE (MODE BITS ARE STRIPED) TAD (-74 / IS IT A '<'? SNA JMP I LDFLD / YES SO EXIT LDFLD ROUTINE (NOTE: LDFLD CALLED US) TAD (74-76 / NO, IS IT A '>' SNA JMP REVRBFD / ERROR - '>' FOUND IN FIELD /d003 TAD (76-41 / NO, IS IT A PRINTABLE CHARACTER? TAD (76-ECSTOV) / Test for start of dead key sequence /a003 JMS NXTMCT / Test for a multi-national character /a003 TAD (ECSTOV) / Returns here if not dead key sequ. /a003 TAD (-41) / Test for non-printable character /a003 SMA ISZ NXTCHR / ITS PRINTABLE SO DO A SKIP RETURN TAD (41 / RESTORE CHARACTER JMP I NXTCHR / RETURN /-------------- PAGE / LP - PROCESS RECORD / THIS CODE WILL INTEGRATE WITH WPSELC.PA TO DO THE MATH ON ALL / RECORDS THAT ARE SELECTED AND TO SET UP A NEW RECORD CONSISTING / OF THE RESULTS OF ALL FORMULAE AFTER THE LAST RECORD IS PROCESSED. / MAJOR ROUTINES/MODULES TO INTEGRATE WITH: / / 1) SELCT- ROUTINE IN WPSELC.PA. GETS NEXT RECORD / SELCT WILL CALL THIS ROUTINE JUST / BEFORE IT RETURNS TO ITS CALLER / 2) LFLDNM- ROUTINE IN WPSELC.PA. GETS FIELD NAME / JMS LFLDNM / BUFFER_ADDRESS (TOKVAL IN OUR CASE) / ON RETURN / AC=0 OK / AC=-1 END OF RECORD / AC=+ ERROR / AC=1 '<' BEFORE '>' / AC=2 FIELD NAME TOO LARGE / / 3) ASCBCD- ROUTINE TO CONVERT A RAW ASCII NUMBER TO PACKED BCD / CDFMYF / MAKE SURE CDF IS SET TO MY FIELD SO ASCBCD KNOWS / / WHERE TO RETURN / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS ASCBCD / CALL CROSS-FIELD CALLABLE ROUTINE / ASCII_INPUT_ADDRESS / BCD_OUTPUT_ADDRESS / ON RETURN / AC=0 OK / AC=+ ERROR, NUMBER OF ERROR IN AC / / 4) BCDASC- ROUTINE TO CONVERT PACKED BCD TO ASCII USING CORRECT FORMAT / CDFMYF / MAKE SURE CDF IS SET TO MY FIELD SO BCDASC KNOWS / / WHERE TO RETURN / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS BCDASC / CALL CROSS-FIELD CALLABLE ROUTINE / BCD_INPUT_ADDRESS / IN MATH FIELD / ASCII_OUTPUT_ADDRESS / IN ANY FIELD / CDF TO ASCII_OUTPUT_ADDRESS FIELD / ON RETURN / AC=POINTER TO FIRST LOCATION AFTER LAST CHAR IN OUTPUT / / 5) SYMCHK- ROUTINE IN MATH FIELD TO LOOK UP A SYMBLE IN THE MATH / SYMBLE TABLE / CDFMYF / MKE SURE CDF IS SET TO MY FIELD / CIFMTH / CHANGE TO MATH INSTRUCTION FIELD / JMS SYMCHK / CALL CROSS-FIELD CALLABLE ROUTINE / RETURN HERE IF SYMBLE NOT FOUND / RETURN HERE IS SYMBLE FOUND AC=POINTER TO VALUE IN TABLE / / / ON ENTRY / AC=0 NEED TO DO MATH ON RECORD STORED IN EDIT BUFFER AND ADD / FIELDS TO RECORD IN EDIT BUFFER FROM RESULTS LIST. / / AC=-1 NO MORE RECORDS. NEED TO CREATE A RECORD IN EDIT BUFFER / OUT OF THE RESULTS LISTS. / / ON EXIT / RECORD IN EDIT BUFFER CREATED OR MODIFIED AS ABOVE / AC UNCHANGED / / PSUEDO-CODE / / PROCESS_RECORD (* CALLED BEFORE SELCT EXITS *) / / IF AC=0 (* A RECORD HAS BEEN SELECTED AND IS IN EDIT BUFFER *) / THEN DO_MATH_ON_CURRENT_RECORD / ELSE CREATE_RECORD_FROM_RESULTS / / / DO_MATH_ON_CURRENT_RECORD / / INITIALIZE / LOOP / CALL LFLDNM (* TO GET NEXT FIELD NAME *) / (* ON EXIT: AC=+ ERROR / AC=0 OK / AC=-1 END OF RECORD *) / EXIT IF END OF RECORD / SET_UP_TOKVAL (*PUT LENGTH OF FN INTO TOKVAL, ADD 4000 TO LAST CHAR *) / CALL SYMCHK (* LOOKS UP SYMBOL IN TOKVAL IN THE SYMBOL TABLE *) / IF FOUND / THEN GET_FIELD_VALUE / CALL ASCBCD (* ASCII TO BCD CONVERSION ROUTINE *) / ELSE READ_PAST_FIELD_VALUE / END-LOOP / / / (* AT THIS POINT WE EITHER HAVE AN END OF RECORD OR AN ERROR *) / IF END_OF_RECORD / THEN CALL ROUTINE TO EXECUTE THE FORMULAE / INSERT_RESULTS_INTO_EDIT_BUFFER / ELSE (* MUST BE AN ERROR *) / AC := 0 (* AS IT WAS WHEN WE TOOK CONTROL FORM SELCT *) / END DO_MATH_ON_CURRENT_RECORD / CREATE_RECORD_FROM_RESULTS / INSERT_RESULTS_INTO_EDIT_BUFFER / INSERT 0 (* RECORD TERMINATOR *) INTO EDIT BUFFER / INSERT_RESULTS_INTO_EDIT_BUFFER / INITIALIZE / WHILE NOT END OF RESULTS LIST / INSERT '<' INTO EDIT BUFFER / INSERT FIELD NAME EDIT BUFFER / INSERT '>' INTO EDIT BUFFER / CALL BCDASC (* TO CONVERT NUMBER TO FORMATTED ASCII *) / INSERT ASCII NUMBER INTO EDIT BUFFER / GET NEXT ENTRY IN RESULTS LIST / END-WHILE /DESCRIPTION OS NAMPTR (USED BELOW) /NAMPTR, 0 / POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE. / FORMAT OF SYMBLE TABLE ENTRY IS AS FOLLOWS: / N / A / M / E+4000 (LAST CHAR OF NAME HAS SIGN BIT SET) / FORMAT WORD (INDICATES HOW USER WANTS OUTPUT TO APPEAR) / 1ST BCD WORD / 2ND BCD WORD / 3RD BCD WORD / 4TH BCD WORD / 5TH BCD WORD / 6TH BCD WORD DOMATH, 0 SNA CLA / WERE THERE ANY MORE RECORDS? JMP DMOCR / YES, DO MATH ON CURRENT RECORD / NO, CREATE RECORD FROM RESULTS JMS INSRST / PUT RESULTS IN RECORD BUFFER AC7777 / RESTORE AC TO WHAT IT WAS JMP I DOMATH / RETURN TO SELCT (WHO CALLED US) / Do_Math_On_Current_Record DMOCR, TAD (RECBUF / INITIALIZE POINTERS ETC. DCA RCBPTR / INIT AUTO-INCR POINTER TO READ RECORD / TO AFTER FIRST LEFT ANGLE BRACKET DMNXT, JMS LFLDNM / LOOP PUT NEXT FIELD NAME INTO GPBUF JMP DMEOR / EXIT IF END OF RECORD JMS DMXFER / TRANSFER GPBUF TO TOKVAL IN MATH FIELD / CALL SYMBLE TABLE LOOKUP ROUTINE IN MATH FIELD CIFMTH / CHANGE TO MATH FIELD JMS SYMCHK / CALL SYMBLE TABLE LOOKUP ROUTINE JMP NOTFND / (RETURNS HERE IF FIELD NOT FOUND) DCA BCDPTR / IF FOUND (AC=POINTER TO VALUE) / THEN SET UP ARGUMENT TO ASBCD JMS LDFLD / LOAD FIELD VALUE INTO TOKVAL (IN MATH FIELD) JMP UNDEF / IF NOT A NULL FIELD VALUE JMS TOKOUT / THEN OUTPUT TRAILING ZERO AS TERMINATOR CIFMTH / CHANGE TO MATH FIELD JMS ASCBCD / CONVERT VALUE TO PACKED BCD TOKVAL / 1ST ARG: POINTER TO VALUE (IN MATH FIELD) BCDPTR, 0 / 2ND ARG: POINTS TO DESTINATION OF PACKED / BCD (IN MATH FIELD) JMP ABERR / ERROR RETURN, GO HANDLE IT /M025 JMP DMNXT / NOTFND, JMS GFDEND / ELSE (NOT FOUND) SKIP PAST FIELD VALUE JMP DMNXT / END-LOOP (GET NEXT FIELD NAME) / ADD OFFSET TO ASCBCD ERROR FOR PROPER REPORTING BY ERROR HANDLER /A025 ABERR, TAD (NSEBE1-NSEBEN) / ADD OFFSET TO ERROR NUMBER FROM ASCBCD/A025 JMP ERRHAN / GO REPORT THE ERROR /A025 / COMES HERE ON A NULL FIELD VALUE, SET VALUE IN MATH SYMBLE TABLE TO UNDEFINED UNDEF, AC2000 /PUT UNDEFINED BIT IN AC CDFMTH DCA I BCDPTR /PUT INTO FIRST WORD OF VALUE CDFMYF / JMP DMNXT /END-LOOP (GET NEXT FIELD NAME) / COME HERE TO HANDLE END OF RECORD. NEED TO CALL ROUTINE TO EXECUTE THE / MATH FORMULA THEN ADD RESULTS TO RECORD IN EDIT BUFFER DMEOR, CIFMTH / JMS EXECUT / CALL ROUTINE TO EXECUTE MATH FORMULAE SZA / WERE THERE ANY ERRORS? JMP ERRHAN / YES, GO TO ERROR HANDLING ROUTINE JMS INSRST / NO, INSERT RESULTS TO RESULT BUFFER JMP I DOMATH / RETURN WITH AC=0 TO SELC / ROUTINE TO TRANSFER FIELD NAME IN GPBUF TO TOKVAL (IN MATH FIELD) / FIRST LOCATION IN TOKVAL NEEDS TO HAVE THE CHARACTER COUNT AND THE / LAST CHARCTER IN THE FIELD NAME NEEDS TO HAVE ITS SIGN BIT SET. DMXFER, XX TAD (GPBUF-1 / INIT POINTERS AND COUNTER DCA TAI1 /INIT POINTER TO SOURCE TAD (TOKVAL-1 DCA TAI2 /INIT POINTER TO DESTINATION TAD FNCNT / FNCNT WAS SET UP BY LFLDNM TAD (-GPBSIZ / Take a maximum symbol length of /a044 SMA / GPBSIZ /a044 CLA / /a044 CIA / We want to use it as a counter /a044 TAD (-GPBSIZ / This gives us a counter no larger than/a044 DCA T1 / GPBSIZ /m044 TAD T1 / Get it back to store in TOCVAL /a044 CIA /d044 TAD FNCNT / GET COUNT OF CHARACTERS AGAIN DMLOOP, JMS TOKOUT / REPEAT; OUTPUT CHARARACTER TAD I TAI1 / GET NEXT CHAR IN FIELD NAME ISZ T1 / UNTIL LAST CHARACTER JMP DMLOOP / DMLAST, TAD (4000 / SET SIGN BIT JMS TOKOUT / OUTPUT LAST CHARCTER JMP I DMXFER / RETURN / OUTPUT A CHAR TO TOKVAL IN MATH FIELD USING TAI2 AS AUTO-INCREMENT REG. TOKOUT, XX CDFMTH / CHANGE TO MATH FIELD DCA I TAI2 / OUTPUT CHAR CDFMYF / CHANGE BACK TO MY DATA FIELD JMP I TOKOUT / RETURN / INSERT RESULTS INTO RECORD (EDIT) BUFFER INSRST, 0 TAD (RESBUF / INITIALIZE DCA RESPTR / INIT AUTO INCREMENT POINTER TO RESULTS TAD (RESULT / DCA NXTPTR / INIT POINTER TO RESULTANT POINTER LIST INS1, / LOOP CDFMTH / CHANGE DATA FIELD TO MATH FIELD TAD I NXTPTR / GET POINTER TO NEXT 'RESULT' FIELD NAME CDFMYF / CHANGE BACK TO BY FIELD / EXIT IF NO MORE RESULTS SNA / ARE WE ALL DONE (NO MORE RESULTS)? JMP INSEXT / YES, SO EXIT ROUTINE DCA NAMPTR / INITIALIZE POINTER TO FIELD NAME TAD ("<-200 / OUTPUT "<" TO RECORD BUFFER JMS RCBOUT / / OUTPUTS FIELD NAME POINTED TO BY NAMPTR TO RECORD BUFFER NAMOU1, CDFMTH / REPEAT TAD I NAMPTR / GET CHARACTER CDFMYF AND P177 / JMS RCBOUT / OUTPUT THE CHAR CDFMTH TAD I NAMPTR / GET CHARACTER AGAIN (TO SEE IF LAST ONE) CDFMYF / (LAST ONE HAS SIGN BIT SET) ISZ NAMPTR / INCREMENT POINTER SMA CLA / WAS IT LAST ONE? JMP NAMOU1 / NO, DO THE NEXT ONE / UNTIL-SIGN BIT SET (ON LAST CHAR OF NAME) TAD (">-200 / OUTPUT ">" TO RECORD BUFFER JMS RCBOUT / / NOW CALL ROUTINE IN IN THIS FIELD TO CONVERT BCD TO ASCII JMS BCDASC / CALL BCD TO ASCII ROUTINE WITH THREE PARAMETERS: NAMPTR, 0 / POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE. RESPTR, 0 / POINTER TO RESULT LIST CDFMYF / INSTRUCTION FOR BCDASC TO USE TO GET TO / CORRECT DATA FIELD FOR RESULTS DCA RESPTR / BCDASC RETURNS WITH POINTER TO END OF ASCII STRING / WHICH BECOMES MY UPDATED POINTER INTO RESBUF ISZ NXTPTR / INCREMENT NEXT RESULT POINTER JMP INS1 / END-LOOP INSEXT, TAD ("<-200 / OUTPUT TRAILING <> FOLLOWED BY A ZERO JMS RCBOUT TAD (">-200 JMS RCBOUT JMS RCBOUT / OUTPUT TRAILING ZERO JMP I INSRST / RETURN / OUTPUTS CHARACTER IN AC TO RESULT BUFFER IN THIS FIELD / CHECKS FOR OVERFLOW RCBOUT, 0 DCA I RESPTR / OUTPUT CHARACTER ISZ RESPTR / INCREMENT POINTER JMP I RCBOUT / NXTPTR, 0 / POINTS TO THE NEXT ENTRY IN THE RESULT POINTER LIST. (EACH / ENTRY POINTS TO A NAME IN THE MATH SYMBLE TABLE) /-------------- PAGE /GPBUF has been moved from here to the same area as the other buffers /a044 /to extend it and make room for multinational and technical characters /a044 /in field names. /a044 / /d044 GPBUF, *SELINI /START OF SELECT PROGRAM START, CIFMNU /M017 JMS I OLAYCL /CALL IN THE EDITOR (MERGE) 2 DCA RECPRO / INIT RECORDS PROCESSED /A025 DCA RECNUM /INIT RECORD COUNTER = 0 /M025 DCA SUCREC /INIT NO. OF MATCHED RECORDS = 0 /M025 DCA ERRNUM /INIT ERROR COUNT = 0 /M025 / THIS ROUTINE SETS PARAMETERS IN THE SELCT ROUTINE SO THAT A MATH /A019 / ERROR WITHIN A CONTROL BLOCK CAN BE REPORTED PREVIOUS TO THE READING /A019 / OF THE FIRST RECORD OF THE LIST. AFTER THE FIRST RECORD IS READ /A019 / THESE PARAMETERS ARE CHANGED BY SELCT ROUTINE AS NORMAL. /A019 TAD (5600) / GET INSTRUCTION JMP I, CURRENT PAGE, /A019 / ADDRESS ZERO /A019 DCA SELCTX / INSTALL IN SELCTX /A019 TAD (ERRXIT) / GET THE ADDRESS OF ERROR HANDLER /A019 DCA SELCT / INSTALL IN SELCT /A019 /CALL MADE FROM HERE TO MATH FIELD TO INITIALIZE MATH DATA STRUCTURES /A018 /FLAGS, ETC., USED IN PROCESSING OF MATH CONTROL BLOCKS. /A018 /NOTE - THIS CALL NOW SET UP TO ALSO SET "TYPMTH" FLAG IN MATH FIELD /A031 / THE VALUE TO SET THE FLAG IS PASSED TO "RTRN4" VIA THE AC /A031 / IN THIS CASE THE FLAG IS SET TO ZERO TO INDICATE THAT LP MATH /A031 / IS BEING USED. SINCE THE AC IS ZERO COMING INTO THE CALL NO /A031 / FURTHER CODE ENHANCEMENTS ARE NECESSARY /A031 CIFMTH /CHANGE PROGRAM CONTROL TO MATH FIELD /A018 JMS RTRN4 /GO INITIALIZE MATH MODULE VALUES /A018 CDFBUF /STORED IN BUFFER FIELD AC0001 /GET FROM RECORD NUMBER TAD I (SPCADR) DCA T1 / THE FROM RECORD COUNT RANGES FROM 1 TO 4095. A FROM COUNT OF /A042 / ZERO MEANS START AT THE FIRST RECORD. IN ORDER TO FACILATE THE /A042 / COUNTING OF RECORDS AND THE RANGE CHECKS, THE FROM COUNT HAS /A042 / SHIFTED DOWN BY ONE UNIT TO ALLOW FOR THE MAXIMUN OF 4095. /A042 TAD I T1 /PICK UP THE FROM RECORD COUNT CDFMYF SZA /OK IF ZERO START RECORD /A042 TAD (-1 /DECREMENT THE COUNT /A042 /D042 CIA /NEGATE DCA FRREC /AND STORE IT AWAY ISZ T1 /GET TO RECORD NUMBER CDFBUF TAD I T1 CDFMYF /D042 CIA /NEGATE DCA TOREC /AND STORE CDFBUF TAD I (OTFIL) /GET OUTPUT FILE NUMBER DCA OUTFIL /AND SAVE IT TAD I (LSTFIL) /GET LIST FILE NAME CDFMYF /BACK TO MY FIELD JMS RDINIT /OPEN FILE TAD FRREC /PICK UP THE FIRST RECORD TO PROCESS /A042 IAC /PUT BACK INTO CORRECT FORMAT /A042 JMS SEARCH /DISPLAY MESSAGE - SEARCHING FOR RECORD /A042 TITLP, CDFSYS /SEE IF HALT FLAG ON ? TAD I HLTFLG CDFMYF SZA CLA JMP FINUP /YES, FINISH UP JMS GETCHR /NO, GET A CHAR JMP FINUP /EOF RETURN, FINISH UP AND P177 /LOSE CONTROL TAD (-74 /SEE IF '<' SZA CLA JMP TITLP /NO, KEEP LOOKING JMS SELCT /GET FIRST MATCHED RECORD /M017 SZA CLA JMP FINUP /NO RECORDS SO TELL USER TAD OUTFIL /OTHERWISE, SEE IF TO PRINTER SNA CLA JMS PRNQUE /YES, QUEUE IT CIFEDT /CHANGE TO EDITOR FIELD /A017 JMS I (MERGE) /AND CALL MERGE PROGRAM SZA CLA /EDITOR RETURNS NON-ZERO IF DISK IS FULL/A0011 JMP DSKFUL /A0011 FINUP, JMP ERRXIT /YES, GIVE MESSAGE DSKFUL, TAD (EVFULL) / ERROR - DISK FULL /A0011/M025 DCA ERRNUM /A0011 JMP ERRXIT /GIVE MESSAGE /A0011 OUTFIL, 0 SINFLG, XX /THIS ROUTINE INITS THE SUCCESS FLAGS TO FALSE /M025 AC4000 /INIT THE MQ WITH A FALSE AND SET MQL /TO TRUE ON MATCH FLAG TAD (SPECTB /GET 1ST LOC OF SPECIFICATION TABLE DCA SPCSCN /SAVE AS PTR TAD I SPCSCN /GET TYPE WORD INFGLP, SNA JMP I SINFLG /0 TYPE, ALL DONE AND P177 /GET RID OF OLD FLAGS TAD (-3 /SEE IF IT'S A 3 (BUT NOT) SNA JMP INBNI /YES, NEEDS DIFFERENT FLAGS TAD (3 /NO, GET TYPE BACK MQA /OR IN FLAGS INFGL1, DCA I SPCSCN /STORE IT BACK JMS GTYPE /GET NEXT TYPE WORD JMP INFGLP /GO SET IT INBNI, TAD (2003) /INIT TO TRUE AND SET TO FALSE ON MATCH FLAGS JMP INFGL1 /STORE IT SPCSCN, 0 GTYPE, XX /GETS THE NEXT TYPE WORD AND RETURNS IT IN THE /M025 /AC USING SPCSCN AS A PTR. /M025 CLA ISZ SPCSCN /ADD TWO TO PTR. ISZ SPCSCN TAD I SPCSCN /TO GET OR-COUNT CLL RTL / * 4 IAC /PLUS 1 TO MOVE ALONG TAD SPCSCN /ADD IN ADDR. DCA SPCSCN /SHOULD GET NEXT TYPE WORD TAD I SPCSCN JMP I GTYPE /RETURN SRCH, 0 /JUST DOES AN EXACT COMPARE JMS XSCMP SPCSTR, 0 RECSTR, 0 CDFBUF JMP I SRCH /-------------- PAGE GFDEND, XX /READS UNTIL THE END OF THE CURRENT FIELD /M025 /USING RCBPTR AND RETURNS A PTR TO THE LAST /LOC. IN THE FIELD IN FDEND, EXCLUDING THE LAST CHAR /LESS THAN 41 IF ONE IS PRESENT. /CALLED BY: /JMS GFDEND / EXIT IF ERROR /REGULAR RETURN (AC 0) GFDLP, JMS SSRBRD /GET A CHAR TAD (-74 /SEE IF '<' ? SNA JMP GFDDN /YES, END OF FIELD TAD (-2 /NO, SEE IF '>' ? SZA CLA JMP GFDLP /NO, KEEP LOOKING JMP REVRBFD / ERROR - '>' FOUND IN FIELD /M025 GFDDN, AC7777 /GET LAST CHAR IN FIELD TAD RCBPTR DCA T1 CDFBUF TAD I T1 CDFMYF AND P177 /WITHOUT CONTROLS TAD (-15 /If last char is End Dead, do not ignore/a044 SZA /Is it End Dead? /a044 TAD (15-41 /NO, SEE IF LESS THAN 41 /a044 SPA CLA AC7777 /YES, DON'T TRY TO MATCH LAST CHAR TAD T1 /STORE PTR TO LAST CHAR TO MATCH DCA FDEND JMP I GFDEND /RETURN ENUM, TAD MLEN SMA CLA /SEE IF EXACT NUMERIC COMPARE ? JMP MNUM /NO TAD ELEN /YES, CHECK LENGTH CIA TAD NUMSIZ SZA CLA /EQUAL ? JMP ORLP /NO, FAIL JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SNA CLA /EQUAL ? JMP TRUE /YES, SET MATCHED FLAG JMP ORLP /NO, FAIL AND TRY NEXT OR-GROUP MNUM, TAD ELEN /NUMBER OR MORE COMPARE ? SNA JMP LNUM /NO CIA /YES, CHECK LENGTH TAD NUMSIZ SPA /LARGER JMP ORLP /NO, FAIL SZA CLA /YES, SEE IF SAME SIZE ? JMP TNUM /NO, SEE IF THRU COMPARE JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SPA CLA /CHECK IF GREATER THAN OR EQUAL TO ? JMP ORLP /NO, GET NEXT OR-GROUP TNUM, TAD MLEN /YES, NUMBER THRU NUMBER COMPARE ? SNA CLA JMP TRUE /NO, SET MATCH FOUND FLAG TAD ELEN /YES, MOVE SPEC STRG PTR TO NEXT NUMBER TAD SPCSTR DCA SPCSTR LNUM, TAD MLEN /CHECK IF SMALLER ? CIA TAD NUMSIZ SMA SZA JMP ORLP /NO, FAIL IMMEDIATELY SZA CLA /YES, SEE IF SAME SIZE JMP TRUE /NO, SET MATCH FOUND FLAG JMS NUMCMP /YES, DO CHAR BY CHAR COMPARE SMA SZA CLA /CHECK IF LESS THAN OR EQUAL TO ? JMP ORLP /NO, GET NEXT OR-GROUP JMP TRUE /YES, SET MATCH FOUND FLAG PRNQUE, 0 /QUEUES THE FORM FILE TO THE PRINTER /M029 CDFMNU /M029 TAD I (PQADDR) /GET PRINT QUEUE ADDRESS /M029 CDFMYF / IN COMMAND FIELD /M029 DCA T2 /STORE TO INDIRECT THROUGH /M029 CDFPRT /M029 AC0001 /M029 DCA I (PRIRFD) /SET FLAG IN PRINT FIELD TO SAY WE ARE DOING /LIST PROCESSING /M029 CDFBUF / /M029 TAD I (FORMNO) /GET FORM FILE NUMBER IN BUFFER FIELD /M029 CDFMNU / /M029 DCA I T2 /PUT AS FIRST ENTRY IN PRINT QUEUE /M029 ISZ T2 /NOW POINT TO NEXT LOCATION AND /M029 DCA I T2 / STORE A TERMINATING ZERO IN THE QUEUE /M029 TAD I (PQADDR) /M029 DCA I (PQFRST) /SET UP PRINT QUEUE FIRST AND LAST POINTERS TAD I (PQADDR) /TO POINT TO SAME PLACE TO INDICATE ONLY DCA I (PQLAST) /ONE ENTRY IN THE PRINT QUEUE /M029 CDFMYF /M029 /D041 TAD (PRJOB) /GET ADDRESS OF PRINTER STATUS BLOCK /M029 /D041 CIFSYS; JSTRT /START UP PRINTER JOB /M029 JMP I PRNQUE /RETURN /M029 / CLEAR SCREEN, HOME CURSOR AND OUTPUT SEARCH FOR RECORD MESSAGE /A042 SEARCH, XX /A042 DCA SRCREC /SAVE RECORD NUMBER TO BE SEARCH FOR /A042 CIFMNU /SET TO MENU FIELD /A042 JMS I IOACAL /CALL IOA TO DISPLAY A MESSAGE /A042 0 /USED FOR DEFAULT OUTPUT ROUTINE /A042 SRCMSG / MESSAGE ADDRESS /A042 0000 / ^P - POSITION CURSOR HOME /A042 / ^E - ERASE SCREEN /A042 SRCREC, 0 / ^D - RECORD NUMBER /A042 JMP I SEARCH / RETURN TO CALLER /A042 SRCMSG, IFDEF ENGLSH /A042 IFDEF ITALIAN /-------------- PAGE /THIS IS WHERE THE TABLES, ETC. GO FIELD 3 *SELINI / IT IS THROUGH THIS OVERLAY THAT WE CAN EITHER REPORT AN ERROR /A025 / CONDITION AND OR PLACE THE RESULT DATA OF THE LIST PROCESSING /A025 / OPERATION /A025 / REPORT, / DELETED CODE TO CHECK PRLOCK--DECMATE IS A SINGLE USER SYSTEM /A043 / DELETED CODE TO CLEAR PRSTTS. LEAVE IT IN CASE HAVE ERROR /A041 / WHILE PRINTER'S BUFFER IS EMPTYING /A041 / WE NO LONGER NEED TO START THE PRINTER JOB SINCE IT ALWAYS RUNS /A041 CDFMYF TAD RECNUM /M025 DCA T1 / HOLD UPDATED RECORD NUMBER IN T1 /M025 TAD RECPRO / GET # OF RECORD PROCESSED /A025 DCA T2 / HOLD NO. OF RECORDS PROCESSED /M025 TAD ERRNUM / GET ERROR NUMBER. IF ERRNUM = 0 THEN /A025 / THERE WAS NO ERROR SO WE'LL JUST /A025 / PRINT THE RECORD SUMMARY. /A025 REPOR2, DCA T3 / HOLD IT IN T3 /M035 / REPOR2 WILL SET UP THE LOCATIONS IN MNUFLD AS FOLLOWS: /A025 / MNTMP1 = 0, MEANING "LIST PROCESSING ERRORS" /A035 / MNTMP2 = NO. OF RECORDS PROCESSED /A025 / MNTMP3 = NO. OF RECORDS SELECTED /A025 / MNTMP4 = CURRENT RECORD COUNT /A025 / MNTMP5 = ERROR OR CONTROL NUMBER /A025 TAD SUCREC / GET NUMBER OF RECORDS SELECTED /M035 CDFMNU /A025 DCA I (MUBUF+MNTMP3) / STORE IT IN MENU FIELD /A025 TAD T1 / CURRENT RECORD COUNT /A025 DCA I (MUBUF+MNTMP4) / STORE IT IN MENU FIELD /A025 TAD T2 / NUMBER OF RECORDS PROCESSED /A025 DCA I (MUBUF+MNTMP2) / STORE IT IN MENU FIELD /A025 TAD T3 / GET ERROR NUMBER (OR CONTROL VALUE) /A025 DCA I (MUBUF+MNTMP5) / STORE IT IN MENU FIELD /A025 DCA I (MUBUF+MNTMP1) / SET FLAG TO INDICATE LIST PROCESSING /A035 CDFMYF /A025 CIFMNU /A025 JMS I MNUCAL / REPORT VIA MENU /A025 DLMLP5 /A025 CDFMNU / HAVE WE RETURNED HERE TO PRINT MATH /A025 / CONTROL BLOCK ERROR? /A025 TAD I (MUBUF+MNTMP5) / MNTMP5 IS EITHER SET OR UNCHANGED IN /A025 / MENU DEPENDING ON THE ERROR NUMBER. /A025 / IF MNTMP5 = 0 THEN EXIT ELSE PRINT /A025 / MATH CONTROL BLOCK LINE THAT /A025 / CONTAINS THE ERROR THEN RETURN TO /A025 / MENU TO PRINT RECORDS SELECTED /A025 / AND PROCESSED. /A025 CDFMYF /A025 SNA CLA / SKIP IF: NEED TO PRINT ERROR LINE /A025 JMP LEAVLP / WE'RE DONE. EXIT LIST PROCESSING /A025 TAD (600 / TELL PELINE TO PRINT ON LINE 7 /A035 CIFMTH / CHANGE INSTRUCTION FIELD TO MATH FIELD/A025 JMS PELINE / PRINT LINE IN CONTROL BLOCK THAT /A025 / CONTAINS THE ERROR AND POINT TO /A025 / ERROR /A025 AC0001 / CONTINUE FROM PRINTING ERROR MESSAGE /A025 JMP REPOR2 / SET CONTROL = CONTINUE FROM PRINTING /A025 / ERROR MESSAGE /A025 / TO EXIT WE MUST RETURN TO THE ROUTINE WHICH CALLED WPPARSE. THE /A017 / ADDRESS IS IN THE BUFFER FIELD (PUT THERE BY WPPARS) BUT THE ROUTINE /A017 / IS IN THE MENU FIELD /A017 LEAVLP, CDFBUF / CHANGE TO BUFFER FIELD /M025 TAD I (RETADR / GET RETURN ADDRESS (OF ROUTINE WHICH /A017 / ORIGINALLY CALLED WPPARS) /A017 DCA T3 / PUT INTO PLACE /M025 CDIMNU / CHANGE TO MENU FIELD /A017 JMP I T3 / AND RETURN /M025 FIELD 2 *RDFIL /THIS IS WHERE RDFILP GOES /QUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. / /++ / FACILITY: / ABSTRACT: / ENVIRONMENT: / AUTHOR:ALICIA FODEN/MIKE STURAK CREATION DATE: OCTOBER 27,1980 / / / 033 EMcD 27-Sep-85 Add Dutch/Spanish Xlations / 032 EMcD 15-Sep-85 Add Nordic translations / 031 RCME 10-APR-85 Add handling of multinational and / technical characters in field names / / -------------------- All below refer to V2.0 and earlier ---------------- / / 030 TCW 02-NOV-83 ADD CHECK & TEXT FOR WINCHESTER DRIVE / 029 HLP 29-AUG-83 If type incorrectly to GO prompt / do not repaint screen, show error / 028 WCE 17-AUG-83 Removed code that generates CDF/CIF's / 027 WCE 19-JUL-83 Modified labels for new prefix file / 026 WCE 06-JUL-83 Removed WS102 conditionals and code / / 025 MJS 01-JAN-83 Corrected some error messages that may / have been "misleading" to the user / (the corrections consistes of "NOP"ing / or "JMP"ing around code) / / 024 AIB 10-DEC-82 Conditionalized "Rubout key" messages / 023 MJS 12-NOV-82 Cosmetic wording changes to message / at "TRYAGN"....same wording if you were / typing to Main Menu and got an error / / 0022 AIB 28-SEP-82 MORE COSMETIC WORDING CHANGES / 0021 AIB 30-AUG-82 WORDING CHANGES IN SOME MENUS / 0020 MJS 1-APR-82 Bug fix added 'GET DENSITY' in 'GTDKID' / 0019 MJS 25-MAR-82 'Bug fix #dm-481' changed 'jmp cusgr' / to 'jmp cusr1' at 'dtao' permitting / GOLD Menu to return to MAIN Menu and / not sort menu asking for new 't a o'. / 0018 MJS 09-MAR-82 Cosmetic display fix in 'nomean' / 0017 MJS 16-FEB-82 CHANGED 'SREXT=10' to 'SREXT=20' / (double density and goto page increased / number of header blocks permitted) / ALSO-deleted 'wpssdf.pa' from the / wpstpr line within master.inf / (was never needed) / 0016 GDH 08-FEB-82 Implemented "read error detection". / 0015 MJS 19-NOV-81 Moved the 'xxsdfnbuffer' from field 5 / to field 4 / 0014 AJF 06-OCT-81 CHANGED DDCHK TO ONLY LOOK AT BLOCK / NUMBER OF ALLOC BLOCK / 0013 GR 30-SEP-81 Fixed Press Return problem / 0012 JM 03-SEP-81 FRENCH TEXT CHANGES / 0011 JM 03-SEP-81 FIXED TYPING "-" HAS NO MEANING MESSAGE / 0010 GDH 26-Aug-81 WPFILS calling seq changes. / 0009 TT 09-JULY-81 REMOVED SUPERFLUOUS CONDITIONALS / 0008 AJF 25-JUNE-81 MISCELLANEOUS COSMETIC FIXES / 0007 AJF 31-MAR-81 VERSION 1 CLEANUP AND MULIT KEY STUFF / 0006 JM 10-MAR-81 Entered CANADIAN text / 0005 JM 09-MAR-81 Entered DUTCH text / 0004 JM 05-MAR-81 Entered FRENCH text / 0003 AJF 18-MAR-81 CHANGED RD1CHAR CALL IN GETFNCHAR TO / PROCESS BLANKS / / 0002 AJF 20-FEB-81 DELETE 127 BLOCK SIZE RESTRICTION IN / TSTSZ / 0001 AJF 27-OCT-81 ADDED SORT/PARSER MODULE TO SYSTEM /-- / / WRITE OUT SORT PARSER / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSPR;100;CDF 30;-DSOSPR 0 / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / ***** ***** ***** ***** ***** ***** / WPSPAR.PA - SORT PARSER /D028 / THE 'USER FIELD' CONSTANTS /D028 / /D028 USRFL0= -10 / USER FIELD 0 /D028 USRFL1= 0 / USER FIELD 1 /D028 USRFL3= 20 / USER FIELD 3 (PHYSICAL FIELD 5) /D028 / /D028 / REPLACES THE 'JMS' WITHIN THE MAINLINE CODE WITH THE ACTUAL (CDF) (CIF) IOT FIELD 3 *SOTFL / THE FIRST 100 LOCATIONS CONTAIN COMMON SYSTEM CONSTANTS / (E.G. P177, ETCETERA.) / *SDFNBUFFER /THIS WILL BE DEFINED IN SORT IN SORT FIELD /D007 *FTYPE+1 CDFSDFN=6241 /A014 /D028 CDFSRT=JMS .; .; JMS CIDPAT; CDF+USRFL3 /D028 CDFEDT=JMS .; .; JMS CIDPAT; CDF+USRFL1 /D028 CDIMNU=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL0 /D028 CDFMNU=JMS .; .; JMS CIDPAT; CDF+USRFL0 /D028 CIFMNU=JMS .; .; JMS CIDPAT; CIF+USRFL0 /D028 CDISRT=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL3 CDFMYF=CDFEDT /DEFINE INSTRUCTION TO RETURN TO THIS FIELD /M028 CDFSRT=CDFLP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 CDISRT=CDILP /DEFINE INSTRUCTION TO CHANGE TO SORT FIELD /A028 /D028 /THE ALL PURPOSE ROUTINE FOR THE INSTRUCTIONS /D028 / /D028 CIDPAT, . /D028 DCA SAVEAC /SAVE THE AC AT ENTRY /D028 RAL; DCA SAVEL /AND THE LINK /D028 RIF /FIND THE INSTRUCTION FIELD /D028 TAD CDF0 /SAME AS 'TAD (CDF 0)' /D028 DCA CID /STORE THE MODIFIED INSTRUCTION FOR EXECUTION /D028 CID, . / CODE TO SET THE 'DATA FIELD' SAME AS 'INSTRUCTION FIELD' /D028 AC7776 / -2 FROM THE RETURN ADDRESS /D028 TAD CIDPAT /GET YOU THE ADDRESS OF THE CALLER /D028 DCA CID /SO AFTER ALL THAT SAVE IT /D028 AC7777 / -1 /D028 TAD I CID /GET THE ADDRESS OF THE CALLER /D028 DCA CID /STORE IT SO A EXIT CAN BE MADE FROM THE INTERNAL ROUTINE /D028 RIF /D028 TAD I CIDPAT /GET AND STORE THE GENERATED INSTRUCTION /D028 DCA I CID /D028 TAD SAVEL; CLL RAR /RESTORE LINK /D028 TAD SAVEAC /GET THE OLD CONTENTS OF THE AC /D028 JMP I CID /JUMP TO THE INSTRUCTION NOW CREATED /D028 SAVEAC, 0 /HOLDS THE AC AT ENTRY TO CIDPAT /D028 SAVEL, 0 /HOLDS THE LINK AT ENTRY TO CIDPAT / / / / / PZERR, ERR1 /STANDARD SPEC DOC ERROR MESSAGE PZNRM, ERR2 /MESSAGE OF SUCCESSFUL PARSING OF AT LEASE /ONE LINE OF SPEC DOC GIVING USER CHOICE OF /CONTINUING OR GOLD M ING OUT. OUTTMP, ZBLOCK 2 /Single character output store. /a031 NEGSPC, -40 /Negative ASCII value for space. /a031 CHR2VT, ZBLOCK 1 /Terminal output store /a031 PAGE BELL= 7 / BACKSP= 10 / LF= 12 / CR= 15 / /d0017 KVTWIDTH=121 / 81(10) IS THE WIDTH OF A LINE OF THE VT A12=X2 / auto index-register 12 A13=X3 / auto index-register 13 SREXT=20 /ADDED TO SIZE OF LIST DOC DURINGSIZING /m0017 MUISTR=MUBUF+MNIBUF ERR001= JMP I PZERR / 'GENERAL ERROR' CALL: ERR001 ERR002= JMP I PZNRM / 'ENOUGH FIELDS SPECIFIED' ERROR CALL: ERR002 ADRASM= 0 /THIS ASSEMBLES THE CREATE MODULE SO IT WILL NOT /TRY TO DISPLAY ERROR MESSAGES BUT SET THE AC FOR /A PARTICULAR MESSAGE SO WPSTPR DISPLAYS APPROPRIATE /MESSAGE ON CREATE ERROR /SORT START COMMAND CUSRCM, XX CLA /ZERO FILE NUMBERS FOR ERROR RECOVERY DCA SOTFL DCA SLSTFL DCA CUSRFO DCA ORDER DCA STATUS DCA DSKID /A007 CDFMNU TAD I (FNAMSP /THIS IS THE ADDRESS OF A BUFFER TO HOLD /THE DOCUMENT ADDRESS CDFMYF DCA CULFNM /STORE IT IN CULFMN /GET DISKETTE ID NUMBER /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO GET DISKETTE ID CIA /NEGATE DCA DSKNO /STORE IT IN DKSNO TAD DSKNO /GET IT BACK AND (777) /MASK OFF FIRST THREE BITS DCA DSKID /STORE FOR SORT M007 CUGSP, /PROMPT FOR SPEC DOC CLA /0 = ERASE FROM TOP OF SCREEN JMS ERASE JMS DCPRMT /GO DISPLAY PROMPT GSPEC /ADDRESS OF SPEC PROMPT CNRG /NULL ARGUMENT TO DISPLAY BLANK ON NEXT LINE A008 CDFMYF DCA STATUS /STORE AC IN STATUS -1 = NONEXISTENT DOCUMENT CDFMNU TAD I (MUBUF+MNFNO) /GET SPEC DRIVE & DOC NUMBER CDFMYF DCA CUSRFO /SAVE SPEC DOC AND DRIVE NUMBER TAD CULFNM /PATCH COPY COMMAND TO PICK UP STUFF DCA CUGSP1 JMS CUCOPY /COPY NAME TO OUR FIELD CUGSP1, 0 /ADDRESS OF FROM FOR CUCUPY CDFMNU /CDF FROM FIELD CUSSDN /ADDRESS TO RECEIVE SPEC DOC NAME CDFMYF /CDF TO FIELD STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD CUSRFO /GET SPEC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC3 /SAVE DOCUMENT NUMBER FOR USER VERIFICATION MSG TAD CUSRFO /GET SPEC DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC4 /SAVE DRIVE NUMBER TAD STATUS SMA CLA /-1 MEANS DOC DOESN'T EXIST NOTICE WE CLEAR AC HERE JMP GPARSE /IF NOT MINUS CONTINUE JMS NDERR CUSSDN /SPEC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUGSP /ASK FOR SPEC DOC AGAIN /ALL THIS LOCK CODE IS HERE TO ENSURE USER DOESN'T SPECIFY RESULT DOC A007 /AS ANY OTHER DOC. BECAUSE OF SPACE LIMITATIONS I WILL DO AN EQUALITY A007 /TEST TO ENSURE LIST OR SPEC IS NOT OVERWRITTEN BY RESULT. THE 278 IS A007 /A SINGLE USER SYSTEM, THEREFORE THERE IS NO NEED FOR ALL THESE LOCKS. A007 /HERE WE GO TEST SPEC DOC FOR SYNTAX ERRORS GPARSE, TAD CUSRFO /PUT SPEC DRIVE AND DOC NUMBER INTO AC FOR PARSER JMS PARSE /GO CHECK SPEC DOC IF IS OK WE WILL CONTINUE IF NOT /RETURN TO MAIN MENU WITH ERROR MESSAGE /THIS ROUTINE IS A WAIT SO USER WILL SEE THE SPEC AS THE PARSER DISPLAYS IT AC7776 /SET AC TO -2 SO LOOP WILL ITERATE TWICE DCA WTCTR1 /SET WAIT COUNTER TO 0 DCA WTCTR /SET OUTER LOOP COUNTER TO 0 LOOP, CIFSYS /MAKE INSTRUCTION FIELD SYSTEM FIELD JSWAP / ISZ WTCTR /WHEN AC IS BACK TO 0 INCREMENT OUTER LOOP JMP LOOP /OTHERWISE LOOP ISZ WTCTR1 /INCREMENT OUTER LOOP IF ZERO CONTINUE JMP LOOP /OTHERWISE LOOP AGAIN CUSGL, /PROMPT FOR NAME OF LIST DOC CLA TAD CULFNM DCA CUSGL1 /PATCH COPY COMMAND TO PICK UP STUFF JMS ERASE /WILL ERASE ENTIRE SCREEN BECAUSE AC 0 IFDEF FRENCH < /A011 AC0001 /SET GLSTFG TO INDICATE /A011 DCA GLSTFG / THAT GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 JMS DCPRMT /CALL DISPLAY ROUTINE GLST /ADDRESS OF LIST DOC PROMPT CNRG /DISPLAYS BLANK ON NEXT LINE A008 CDFMYF DCA STATUS CDFMNU TAD I (MUBUF+MNFNO) /GET DRIVE AND DOC NUMBER CDFMYF / DCA SLSTFL /SAVE JMP PCUSG RETMNU, CDIMNU /RETURN TO MAIN MENU /M027 JMP I CUSRCM PCUSG, JMS CUCOPY CUSGL1, 0 /ADDRESS OF FROM FOR CUCOPY CDFMNU /CHANGE TO MENU DATA FIELD TO PICK UP CHAR STRING CUSLDN /ADDRESS TO RECEIVE LIST DOC NAME CDFMYF /CHANGE BACK TO MY DATA FIELD (FIELD TO COPY TO) STRLEN /NUMBER OF WORDS TO COPY (THIS IS STANDARD) TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC1 /SAVE DOCUMENT TAD SLSTFL /GET LIST DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC2 /STORE AWAY TAD STATUS SMA CLA /CLEAR AC JMP CUSGR /IF POSITIVE DOC EXITST SO CONTINUE A007 JMS NDERR /ELSE GO TO NO DOCUMENT ERROR MSG CUSLDN /LIST DOC NAME CLA DCA STATUS /SET STATUS BACK TO 0 JMP CUSGL /DISPLAY PROMPT AGAIN STATUS, 0 /TELL NO DOC ERROR ROUTINE WHERE TO RETURN DSKNO, 0 /DISKETTE ID NUMBER WTCTR, 0 /THIS IS THE WAIT ROUTINE COUNTER WTCTR1, 0 /THIS IS WAIT ROUTINE COUNTER FOR OUTER LOOP CULFNM, 0 /ADDRESS OF BUFFER TO HOLD DOCUMENT ADDRESS CUSRFO, 0 IFDEF FRENCH < /A011 GLSTFG, 0 / SET WHEN GLST TO BE DISPLAYED /A011 > / END IFDEF FRENCH /A011 PAGE CUSGR, CLA /0 AC MEANS ERASE FROM TOP OF SCREEN JMS ERASE SRCUSRG,JMS DCPRMT /GO DISPLAY MESSAGE GRES /ADDRESS OF RESULT DOC PROMPT GRES2 /DISPLAYS SECOND LINE OF PROMPT CDFMYF /CHANGE DATA FIELD TO MINE DCA STATUS /STORE STATUS OF DOC (EXISTS OR NOT) CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNDRV) /GET RESULT DOC DRIVE CDFMYF /CHANGE DATA FIELD TO MINE DCA CUSRC6 /STORE JMS DDCHK /CHECK IF RESULT FLOPPY IS VALID DISKETTE JMP CUSGR /ERROR RETURN INVALID DISKETTE IS REPLACED /SO ASK FOR RESULT AGAIN TAD STATUS /DISKETTE IS VALID SO GO GET STATUS SPA CLA /SEE IF DOCUMENT EXISTS IF AC NEGATIVE JMP RESCRE /DOC DOESN'T EXIST SO GO CREATE IT CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNFNO);CDFMYF /ELSE GET DOC NUMBER DCA SOTFL /AND STORE IT JMS CUSGR1 /SEE IF RESULT DOC HAS BEEN PREVIOUSLY SPECIFIED A007 /NOTE AC IS 0 HERE TAD SOTFL /GET RESULT DOC NUMBER A007 CIA /NEGATE A007 TAD SLSTFL /GET NEGATIVE OF LIST DOC A007 SNA CLA /ARE THEY EQUAL? A007 JMS LCKMSG /IF YES DISPLAY ERROR MESSAGE A007 JMP TSTSPEC /CONTINUE ALSO OK RETURN FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 TSTSPEC,TAD SOTFL /GET RESULT DOC A007 CIA /NEGTATE A007 TAD CUSRFO /ADD SPEC DOC A007 SNA CLA /ARE THEY EQUAL A007 JMS LCKMSG /YES DISPLAY ERROR MESSAGE A007 JMP DTAO /NO CONTINUE THIS IS ALSO OK RETURN A007 /FROM LCKMSG A007 JMP CUSGR /ERROR RETURN PROMPT FOR RESULT AGAIN A007 /DOCUMENT EXISTS AND IS NOT IN USE SO DISPLAY TAO PROMPT DTAO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT CIFMNU JMS I IOACAL 0 DEXTS /ADDRESS OF TEXT STRING 205 /POSITION FIRST LINE ON SECOND ROW 5 COLUMN 305 505 705 1105 2305 JMS ORGOLD ORAR DTAOX, / /a025 AC0001 /SET AC TO 1 SO MENU WILL READ RESPONSE JMS READMU /READ INPUT FROM MENU MODULE JMP CUSR1 /GOLD M -- Return to MAIN Menu /a0019 /d0019 JMP CUSGR /GOLD M SO ASK FOR RESULT DOC AGAIN CDFMYF /CHANGE DATA FIELD TO MINE SMA CLA /IF AC NEGATIVE INAPPROPRIATE INPUT JMP STORE /IF APPROPRIATE CONTINUE JMS MVINPT /ELSE, COPY INPUT FROM MENU FIELD TO INBUF JMS NOMEAN /GO COMPLAIN ABOUT BAD INPUT /d025 JMP DTAO /ASK AGAIN /d025 JMP DTAOX / ask again /a025 /CALLED TO COPY RESULT DOC NAME FROM MENU FIELD AND ISOLATE DOC AND DRIVE /NUMBERS MADE INTO A SUBROUTINE SO IT CAN BE USED WHEN DOC EXISTS OR NOT CUSGR1, XX TAD CULFNM DCA CUSGR2 JMS CUCOPY CUSGR2, 0 /FROM FOR CUCOPY CDFMNU / CUSRDN /RESULT DOCUMENT NAME CDFMYF / STRLEN /SIZE OF DOCUMENT NAME FOR CUCOPY /NOTE CUCOPY RETURNS WITH AC 0 TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER AND P377 /MASK OFF DOCUMENT NUMBER DCA CUSRC5 /SAVE DOC NUMBER TAD SOTFL /GET RESULT DOC FILE AND DRIVE NUMBER BSW;RTR /POSITION DRIVE NUMBER AND (17) /MASK OFF DRIVE NUMBER DCA CUSRC6 /SAVE DRIVE NUMBER DCA STATUS /CLEAR STATUS VARIABLE JMP I CUSGR1 /RETURN /THIS ROUTINE IS CALLED BY ROUTINES WHICH PROCESS SPEC, INPUT DOCUMENT AND /RESULT DOCUMENT NAMES. /CALLED BY / JMS DCPRMT / ADDRESS OF PROMPT TO DISPLAY / ADDRESS OF SECOND LINE OF PROMPT, IS NULL (BLANK) FOR SPEC / AND LIST DOC, TEXT FOR RESULT DOC / RETURN WITH AC CONTAINING VALUE OF MNTMP3 / DATA FIELD SET TO MENU FIELD DCPRMT, XX CLA /CLEAR AC TAD I DCPRMT /GET FIRST PARAMETER PROMPT TO DISPLAY DCA WHCDOC /STORE IT ISZ DCPRMT /GET READY TO GET NEXT PARAMETER TAD I DCPRMT /GET SECOND LINE OF PROMPT, IS NULL (BLANK) FOR /SPEC AND LIST PROMPT BUT FOR RESULT CONTAINS /SECOND LINE OF PROMPT DCA WHC2ND /STORE ISZ DCPRMT /INCREMENT DCPRMT FOR RETURN DCPRM1, JMS DSORT CIFMNU JMS I IOACAL 0 SPRMPT 1505 LOC, 7777 /WILL DISPLAY PROMPT ON SAME LINE AS ABOVE PROMPT WHCDOC, 0000 CIFMNU JMS I IOACAL 0 WHC2ND, 0000 /SECOND LINE OF PROMPT 1605 /POSITION OF SECOND LINE JMS PRETURN JMS ORGOLD ORAR CLA /SET AC TO MENU WILL READ INPUT JMS READMU /PROCESS INPUT FROM MENU JMP CUSR1 /RETURN TO MM JMP I DCPRMT /GO BACK AND PROCESS INPUT NOTE DATA FIELD /STILL SET TO MENU FIELD PAGE RESCRE, CDFMNU /CHANGE DATE FIELD DO MENU TAD I (MUBUF+MNDRV) /NOTE AC 0 HERE, GET DRIVE NUMBER OF DOC /USER SPECIFIED CDFMYF /CHANGE DATA FIELD BACK TO MINE DCA CUSRC6 /STORE IN RESULT DRIVE NUMBER JMS TSTSZ /TEST IF THERE IS ROOM TO CREATE DOC JMP SMDRVS /ERROR RETURN GO PROCESS SIZE ERROR CLA CLL TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY ARE DCA DSKID /SET FROM PREVIOUS RESULT DOC M007 CLL /THERE IS ENOUGH ROOM SO CONTINUE CLEAR LINK AC0003 /SET FOR OVERWRITE RTR RTR /MOVE TO BITS 2 AND 2 CDFMYF TAD DSKID /COMBINE WITH CONTENTS OF DSKID M007 DCA DSKID /STORE M007 JMS ADRCRT /CREATE THE OUTPUT DOCUMENT JMP CRERR /ERROR ON CREATE, PROCESS DCA SOTFL /STORE IN DOC NUMBER IN SOTFIL JMS CUSGR1 /GO COPY DOC NAME AND ISOLATE DOC AND DRIVE #S /NOTE AC MUST BE 0 HERE TO ENSURE RESULT DOC /IN SIZE TESTING ROUTINE EQUALS ZERO /BECAUSE WE ARE NOT OVERWRITING THE RESULT JMP CUSGO /CONTINUE CRERR, CLA /CLEAR AC TAD ERSTAT /GET ERROR STATUS FROM CREATE SNA /IF AC 0 JMP STMSG /DISPLAY SHORT MESSAGE TAD (7776) /ELSE ADD -2 TO SEE IF AC = 2 SZA CLA /AC =2? JMP WRGMSG /DISPLAY WRONG DOC NUMBER MESSAGE JMP NSPCMSG /ELSE MUST BE A 2 DISPLAY NO SPACE FOR DOC MESSAGE STMSG, TAD (CNRG) /GET NO DISPLAY ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE WRGMSG, TAD (WNUM) /GET WRONG DOCUMENT NUMBER ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE NSPCMSG,TAD (NMDC) /GET NO DOCUMENTS AVAILABLE ARGUMENT JMP CREMSG /GO TO DISPLAY CREATE ERROR MESSAGE CREMSG, DCA CRMSG /STORE APPROPRIATE MESSAGE ARGUMENT FOR DISPLAY CRMSG1, JMS ERASE JMS RBELL JMS DSORT /DISPLAY SORT ON FIRST LINE /A008 CIFMNU JMS I IOACAL 0 CNTCRE /DISPLAY CANNOT CREATE DOCUMENT 1505 /ON LINE 15 COLUMN 5 CIFMNU JMS I IOACAL 0 CRMSG, 0000 /DISPLAY DOC # OUT OF RANGE, OR NO MORE DOCS 1605 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU JMS I IOACAL /CALL IOA A008 0 / A008 TARTN /DISPLAY PRESS RETURN TO TRY ANOTHER NAME A008 2005 /LINE TO DISPLAY A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 ORAR /DISPLAY OR M008 JMS KBRD /READ INPUT HANDLE GOLD KEYS D008 JMP CUSGR /RETURN WAS TYPED SO REQUEST RESULT AGAIN A008 STORE, CLA CLL /CLEAR LINK AND AC TAD DSKID /GET DSKID M007 AND (4777) /CLEAR BITS 1 AND 2 IN CASE THEY WERE SET /PREVIOUSLY WHEN RESULT WAS SPECIFIED DCA DSKID /STORE BACK M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD CLA CLL TAD I (MUBUF+MNTMP1) /GET INPUT CDFMYF /CHANGE BACK TO MY DATA FIELD RTR / RTR /MOVE INPUT TO BITS 1 AND 2 TAD DSKID /STORE IN DSKID M007 DCA DSKID / M007 CDFMNU /CHANGE DATA FIELD TO MENU FIELD TAD I (MUBUF+MNTMP1) /GET INPUT AGAIN CDFMYF /CHANGE DATA FIELD TO MINE CLL RAR /SEE IF WE ARE OVERWRITING /0 = ADD TO TOP /1 = ADD TO BOTTOM /3 = OVERWRITE (NOTE THESE ARE BINARY NUMBERS) /IF OVERWRITING AC NOT 0 SNA CLA /CONTINUE IF AC IS NOT EQUAL TO 0 JMP CLTSTSZ /GO TO TEST SIZE /ELSE TAD SOTFL /GET SIZE OF RESULT FILE CIFFIO /SET INSTRUCTION FIELD TO MENU /M0010 FILEIO / /M0010 XRDFIN CDFFIO /CHANGE DATA FIELD TO FILEIO /M0010 TAD I (RDFSIZ) /GET SIZE OF RESULT FILE CDFMYF /CHANGE DATA FIELD BACK TO MINE CLTSTSZ,JMS TSTSZ /GO TO TSTSZ WITH SIZE OF RESULT DOC IN AC JMP SMDRVS /ERROR RETURN CONTINUE SIZE ERROR HANDLING JMP CUSGO /OK RETURN CONTINUE /RTNWT MOVED HERE BECAUSE OF SPACE REASONS M007 / THIS ROUTINE READS INPUT IN RESPONSE TO ERROR MESSAGES WHICH REQUEST A RETURN / WHEN "RETURN" IS TYPED RETURN TO USER IF NOT RING BELL AND COMPLAIN AGAIN / called by: JMS RTNWT; WRONG RETURN; OK RETURN RTNWT, XX CIFMNU / JMS I INACAL / INBUF / INPUT BUFFER TO RECEIVE INPUT JMP .-3 / /a025 /d025 JMP WRNG / GOLD KEY RING BELL COMPLAIN AGAIN /a025 CLA MQA / MQ HAS # OF CHARS IF NOT 0 THEN NOT RETURN SZA CLA / SEE IF IT IS 0 JMP WRNG / IF NOT RETURN RING BELL COMPLAIN AGAIN ISZ RTNWT / MUST BE RETURN SO INCREMENT FOR OK RETURN JMP I RTNWT / RETURN TO CALLER WRNG, JMS RBELL / RING BELL JMP I RTNWT / RETURN TO CALLER TO COMPLAIN AGAIN PAGE /IF CALLED WITH ZER0 IN AC THIS ROUTINE CHECKS SIZE OF SPACE ON RESULT /FLOPPY AGAINS SIZE OF INPUT FLOPPY + 8 BLOCKS /OTHERWISE AC CONTAINS SIZE OF RESULT DOC TO ADD TO FREESPACE ON RESULT /FLOPPY WHEN OVERWRITING THE RESULT DOC /IF THERE IS ENOUGH SPACE ON RESULT FLOPPY TO ACCOMMODATE OUTPUT PROGRAM /CONTINUES. /WHEN THERE IS NOT ENOUGH SPACE ON RESULT FLOPPY DISPLAYS ARE DETERMINED /AS FOLLOWS: /IF INPUT AND OUTPUT ARE THE SAME, USER IS ASKED TO SPECIFY ANOTHER DRIVE /FOR OUTPUT AND IS RETURNED TO THE PROMPT FOR THE RESULT DOCUMENT SO /APPROPRIATE VALIDLITY TESTS ARE PERFORMED. /IF INPUT IS DRIVE 0 AND OUTPUT IS DRIVE 1 USER IS ASKED TO REPLACE /DISKETTE AND RESPECIFY RESULT DOCUMENT AS ABOVE. /IF OUTPUT AND ARE DIFFERENT AND OUTPUT IS DRIVE 0 USER IS ASKED TO /REMOVE SYSTEM FLOPPY TSTSZ, XX DCA FRESPCE /STORE RESULT DOC SIZE OR 0 DEPENDING HOW CALLED TAD SLSTFL /PUT INPUT DRIVE AND DOC NUMBER INTO AC CIFFIO /CALL RFDL TO OPEN INTPUT DOC /M0010 FILEIO / /M0010 XRDFIN CDFFIO / /M0010 TAD I (RDFSIZ) /GET SIZE OF LIST DOC CDFMYF /CHANGE TO MY DATA FIELD DCA LSTSIZ /STORE IN MY FIELD TAD CUSRC6 /TAD RESULT DRIVE NUMBER JMS CUPDRS /SET DRIVE NUMBER FOR QURX TAD (RXESP /GET SPACE LEFT ON DISKETTE DCA QUQBLK+RXQFNC JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX TAD QUQBLK+RXQSPC /GET FREE SPACE ON RESULT FLOPPY TAD FRESPCE /ADD RESULT DOC SIZE (OR 0 FOR T, A, OR CREATE) DCA FRESPCE /STORE TAD (SREXT) /THIS IS EXTRA SPACE REQUIRED IF DOC IS TO BE /EDITED AFTER SORT TAD LSTSIZ /ADD THE SIZE OF INPUT DOC CIA /NEGATE TAD FRESPCE /ADD FREE SPACE SPA CLA /IF RESULT IS NEGATIVE INPUT IS GREATER THAN JMP I TSTSZ /SPACE AVAILABLE ON FLOPPY ERROR RETURN ISZ TSTSZ /ELSE THERE IS ENOUGH SPACE INCREMENT FOR OK RETURN JMP I TSTSZ ERSTAT, 0000 /TYPE OF CREATE ERROR MESSAGE TO DISPLAY /0 = GENERAL CANNOT CREATE /1 = DOC # OUT OF RANGE /2 = NO DOCS AVAILABLE LSTSIZ, 0 /SIZE OF INPUT FILE FRESPCE,0 /SIZE OF RESULT FILE 0 WHEN ADDING TO TOP, BOTTOM OR CREATING /THE RESULT DOC AND THE SIZE OF THE RESULT DOCUMENT WHEN /OVERWRITING. THIS PROGRAM ALSO ADDS THE AMOUNT OF FREE SPACE /ON THE RESULT FLOPPY WHEN COMPUTING SIZING / IF GLST (FRENCH) HAS JUST BEEN DISPLAYED, DSPACC IMBEDS AN ACCENTED a /A011 / (^Z 141) ONTO THE SCREEN WITHIN GLST. THIS COULD NOT BE DONE NORMALLY /A011 / BECAUSE GLST IS A ^S ARGUMENT ITSELF. /A011 IFDEF FRENCH < /A011 DSPACC, XX /A011 CLA /A011 TAD GLSTFG /A011 SNA CLA / HAS GLST BEEN DISPLAYED ? /A011 JMP I DSPACC / NO, SO RETURN /A011 DCA GLSTFG / YES, CLEAR GLSTFG UNTIL NEXT DISPLAY /A011 CIFMNU / AND DISPLAY ACCENTED CHAR /A011 JMS I IOACAL /A011 0 /A011 ACCHAR /A011 1536 / CURSOR POS /A011 141 / ACCENTED a /A011 JMP I DSPACC / RETURN /A011 ACCHAR, TEXT '^P^Z' / STRING USED TO DISPLAY ACCENTED a /A011 > / END IFDEF FRENCH /A011 /**************************************************************************** / / The OUT2VT routine, which displays characters on the terminal has /a031 / been moved here to make room for the changes associated with outputing/a031 / multinational and technical characters. /a031 / /**************************************************************************** OUT2VT, XX / The moved output to terminal routine /m031 DCA CHR2VT / Save the character to be displayed /m031 TAD CHR2VT / Check for right away /m031 TAD (-CR) / /m031 SNA CLA / Is it an end dead char (CR)? /a031 JMP OU2LIV / Yes, tidy up after dead key sequence. /a031 TAD DEADKEY / No, check for in dead key sequence. /m031 SZA CLA / Are we in dead key sequence? /m031 JMP INDEAD / Yes, deal with the character. /a031 TAD CHR2VT / No. /m031 TAD (-BACKSP) / Check for a . /m031 SNA / Was it a start of dead character (BS)?/m031 JMP OU2DOA / Yes, start of dead key sequence. /a031 TAD (BACKSP-LF) / No, test for line feed. /m031 SZA CLA / Is it an LF? /m031 JMP NOTEOL / No, jump round handler. /m031 JMS NEWLN / Output a CR-LF. /m031 VTEXIT, TAD CHR2VT / Get back the character /m031 JMP I OUT2VT / Return /m031 NOTEOL, TAD CHR2VT / Output the character passed to the /a031 OU2ANY, JMS OUTCHR / routine origionally in the AC /a031 JMP VTEXIT / and return with it in AC /a031 OU2DOA, AC7777 / Set the dead key flag /a031 DCA DEADKEY / /a031 JMP VTEXIT / Get the character back and return /a031 /**************************************************************************** / / The following code handles dead key sequences found in the /a031 / sort specification document. Technical and multinational /a031 / characters are now displayed using the correct character sets /a031 / and user dead key sequences are depicted by the conventional /a031 / blot rather than the +/- symbol previously used. /a031 / /**************************************************************************** INDEAD, ISZ DEADKEY / This peice of code is used for each /a031 / character in the dead key sequence /a031 / Is this the first char in the sequence?/a031 JMP INDNOT1 / No, deal with others. /a031 ISZ DEADKEY / Yes, set the dead key flag again /a031 TAD CHR2VT / No, get the character. /a031 TAD NEGSPC / Test for space character. /a031 SNA CLA / Is it a space? /a031 JMP VTEXIT / Yes, accept and forget it. /a031 CIFMNU / No, output the escape sequence to send/a031 JMP I IOACAL / a blot to the screen /a031 0 / /a031 ASTRING / /a031 ASDK / /a031 AC4000 / Set the top bit of the dead key flag /a031 DCA DEADKEY / to indicate a user dead key that /a031 JMP VTEXIT / requires no further processing /a031 INDNOT1,TAD DEADKEY / Check the top bit of the flag for user/a031 SPA / Is this a user dead key sequence? /a031 JMP VTEXIT / Yes, ignore all further characters /a031 CLL RTR / No, test for the 2nd char in sequence /a031 SZA / Is this the 2nd character? /a031 JMP OU2DCH / No, it's a later one /a031 TAD CHR2VT / Yes, get it. /a031 TAD NEGSPC / Test for a GOLD space. /a031 SNA / Is it a GOLD space? /a031 JMP GLDSPC / Yes, deal with it. /a031 TAD (-23) / No, test character set specifier /a031 SNA / Is it a technical character? /a031 JMP OU2DTC / Yes, go send an SS3 /a031 IAC / Test for multinational character set /a031 SNA CLA / Is it multinational? /a031 JMP OU2DMC / Yes, output an SS2 /a031 JMP OU2DLC / No, is line drawing, so output SO /a031 OU2DTC, AC0001 / Build value 217 for technical char /a031 OU2DMC, TAD (200) / Build value 216 for multinational char/a031 OU2DLC, TAD (16) / Build value 16 for a line drawing char/a031 JMP OU2ANY / Output the built value to the screen /a031 OU2DCH, CLL RAL / Check that this is the 3rd character /a031 SZA CLA / Is this the 3rd character? /a031 JMP VTEXIT / No, exit /a031 JMP NOTEOL / Yes, print it /a031 GLDSPC, AC4000 / Deal with GOLD spaces. Is not dead key/a031 DCA DEADKEY / sequence, so set flag to ignore rest /a031 JMP NOTEOL / Display the space /a031 OU2LIV, DCA DEADKEY / Turn off the deadkey flag /a031 TAD (17) / Output SI when dead key finishes /a031 JMP OU2ANY / clean up after line drawing set mode /a031 OUTCHR, XX / Routine to display the character in AC/a031 DCA OUTTMP / Save the character /a031 CIFMNU / Change to the menu field /a031 JMS I IOACAL / to use IOA for character output /a031 0 / /a031 ASTRING / /a031 OUTTMP / /a031 JMP I OUTCHR / Return /a031 DEADKEY,ZBLOCK 1 / Dead key flag /m031 PAGE /SEE IF INPUT AND OUTPUT DOCS ARE IN SAME DRIVES SMDRVS, TAD CUSRC2 /GET INPUT DRIVE NUMBER CIA /NEGATE TAD CUSRC6 /RESULT DRIVE NUMBER SZA CLA /IF THEY ARE EQUAL TELL USER TO SPECIFY ANOTHER DRIVE JMP DKTST /OTHERWISE SEE IF 4 DRIVE SYSTEM M007 NDPRMT, JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 NWDRV /TEXT TELLING USER TO SPECIFY ANOTHER DRIVE 1205 /DISPLAY NEXT PROMPT ON LINE 12 COLUMN 5 NWSTR, 0000 / ADDR OF SUBSTRING /A030 JMP SRCUSRG /GO PROMPT FOR RESULT DOC AGAIN DKTST, CDF 0 /CHANGE DATA FIELD TO SYSTEM FIELD A007 TAD I (RXONLN) /GET NUMBER OF DISKETTES ON LINE NOTE AC IS ZERO A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 TAD (-4) /SEE IF IT IS 4 A007 SNA CLA /IF THERE OR 4 RX'S ON LINE A007 JMP NDPRMT /DISPLAY SPECIFY ANOTHER DRIVE A007 /OTHERWISE FALL THROUGH A007 /DRIVES ARE DIFFERENT AND THIS IS 2 DRIVE SYSTEM /SEE IF INPUT DRIVE IS 0 DFDRVS, TAD CUSRC6 /GET OUTPUT DRIVE NUMBER SNA CLA /IF IT IS NOT ZERO GO TO REPLACE DISKETTE ROUTINE JMP OUTPT0 /IF IT IS ZERO TELL USER TO REPLACE SYSTEM DISKETTE JMP DFMSG DFMSG, JMS PTRCHK /MAKE SURE NOTHING IS PRINTING. IF PRINTING USER /IS RETURNED TO THE MAIN MENU OF NOT CONTINUE JMS ERASE JMS TOSMALL /TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RPLACE /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /DISKETTE OK NOW PROMPT FOR RESULT DOC AGAIN OUTPT0, JMS PTRCHK /MAKE SURE USER IS NOT PRINTING IF SO RETURN TO MM /ELSE CONTINUE OT0MSG, JMS ERASE JMS TOSMALL /TELLS USER THERE IS NOT ENOUGH ROOM FOR RESULT CIFMNU JMS I IOACAL 0 RMOVE0 /ASK USER FOR NEW DISKETTE FOR RESULT DOC 1205 /DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5 1305 /DISPLAY SECOND LINE ON LINE 13 COLUMN 5 JMP SRCUSRG /GO BACK AND PROMPT FOR RESULT DOC AGAIN CUSGO, JMS ERASE /ERASE SCREEN A008 JMS DSORT /GO DISPLAY SORT CIFMNU /CHANGE TO MENU FIELD JMS I IOACAL /OUTPUT WHAT WE THINK THINGS ARE 0 CUSR1A /ADDRESS OF OUTPUT STRING 105 /TEXT TO DISPLAY ON 1 LINE 5 COLUMN 5 IFDEF CANADA <141> CUSRC2, 0 /DRIVE NUMBER OF LIST DOC CUSRC1, 0 /DOCUMENT NUMBER OF LIST DOC CUSLDN /LIST DOCUMENT NAME 205 /TEXT TO DISPLAY ON LINE 2 COLUMN 5 CUSRC4, 0 /SPEC DRIVE NUMBER CUSRC3, 0 /SPEC DOC NUMBER CUSSDN /SPEC DOCUMENT NAME 305 /TEXT TO DISPLAY ON LINE 3 COLUMN 5 CUSRC6, 0 /RESULT DRIVE NUMBER CUSRC5, 0 /RESULT DOC NUMBER CUSRDN /RESULT DOCUMENT NAME 405 NUMKEY /NUMBER OF KEY FIELDS WE WILL SORT ON CIFMNU JMS I IOACAL 0 TYPGO /TEXT STRING TYPE GO TO BEGIN SORT 1505 JMS PRETURN /AND PRESS RETURN JMS ORGOLD /OR PRESS GOLD M ORAR CUSGO1, /A029 AC0002 /SET AC TO 2 SO MENU WILL PROCESS GO PROMPT JMS READMU JMP CUSR1 /RETURN TO MM CDFMYF /SET DATA FIELD TO MY FIELD SPA CLA /TEST FOR NEGATIVE AC JMP GNMEAN /IF NEGATIVE RESPONSE WAS INAPPRIPRIATE SO COMPLAIN /ELSE CONTINUE / /A015 / IF THE OPERATOR SPECIFIED 'O' TO OVERWRITE THE OUTPUT DOCUMENT /A015 / THEN WE MUST DELETE ALL DOCUMENT BLOCKS FROM THE ALLOCATION BLOCK /A015 / ASSOCIATED WITH THAT OUTPUT DOCUMENT /A015 / OTHERWISE THE SORT COULD RUN OUT OF 'SCRATCH' DISK SPACE /A015 / AND A 'DISK ERROR UNIT n' WOULD OCCUR /A015 / /A015 TOSORT, TAD (3000) / /A015 AND DSKID / mask the 'T', 'B', AND 'O' MODE /A015 TAD (-3000) / /A015 SZA CLA / SKIP NEXT IF 'O' /A015 JMP SORT / JMP BECAUSE 'T' OR 'B' /A015 TAD SOTFL /that / OUTPUT DOCUMENT # AND DRIVE # /A015 MQL /is / INTO THE MQ FOR THE 'XDSKIN' /A015 AC7777 /all / -1 MEANS SET FOR 'OVERWRITE' /A015 CIFFIO /there / /A015 FILEIO /is / OPEN the document /A015 XDSKIN /to / /A015 CIFFIO /it / /A015 FILEIO /boo- / CLOSE the document /A015 XDSKCL /bie / /A015 SORT, CDFSRT /CHANGE TO SORT FIELD TAD I (PARSELIST) /GET THE ADDRESS OF SELECTER ROUTINE DCA T1 /STORE IT IN T1 CDFMYF TAD CUSRCM /TO PASS THE RETURN POINT IN AC TO SELECTOR CDISRT /INSTRUCTION FIELD TO SORT FIELD DCA MMRETURN /STORE IN A LOCATION IN SORT FIELD JMP I T1 /JUMP TO SELECTER GNMEAN, JMS MVINPT /COPY INPUT FROM MENU TO INBUF JMS NOMEAN /COMPLAIN ABOUT INCORRECT INPUT JMP CUSGO1 /ASK AGAIN /C029 PAGE /ROUTINES TO DISPLAY COMMON PROMPTS ON THE SCREEN DSORT, XX CIFMNU JMS I IOACAL 0 SRT 0 JMP I DSORT /CALLED BY JMS ORGOLD / VALUE FOR FIRST WORD ARGUMENT (EITHER ORAR FOR OR PRESS GOLD / M OR NARG FOR PRESS GOLD M) ORGOLD,XX /DISPLAYS (OR) PRESS GOLD M TO RECALL MENU CLA TAD I ORGOLD DCA FWARG /STORE ARGUMENT IN FIRST WORD ARGUMENT ISZ ORGOLD /NOTE AC MUST BE 0 HERE TO ENSURE GTDKID WILL READ SYSTEM FLOPPY JMS GTDKID /READ SYSTEM DISKETTE ID TAD DSKNO /ADD TO PREVIOUS ID # SZA CLA /IF EQUAL SYSTEM DISKETTE HAS NOT BEEN REMOVED JMP SDOUT /AC NOT 0 SYSTEM DISKETTE WAS REMOVED OGOLD1,CIFMNU JMS I IOACAL 0 DOGM /ADDRESS OF OR TYPE GOLD M TO RECALL MENU 2505 /POSITION OF LINE FWARG, 0 /FIRST WORD OF PROMPT EITHER "OR" OR " " JMP I ORGOLD /RETURN TO CALLER SDOUT, /THIS IS TO SEE OF GOLD M MESSAGE IS DISPLAYED WITH /OR OR NOT IF IT IS THEN REPLACE MESSAGE WILL BE /ALSO PRECEDED WITH AN OR ALSO TAD FWARG /GET CONTENTS OF FWARG CIA /NETATE IT TAD (NARG) /SEE IF IT IS NARG SZA CLA /IF IT IS CONTINUE JMP CHARG /IF NOT NARG CHANGE FIRST WORD OF REPLACE MESSAGE TAD (NARG) /IF NARG SET FIRST WORD ARGUMENT OF REPLACE MESSAGE TO DCA SDFW /NULL SDOUT1, TAD (AARG) /PUT ARGUMENT FOR AND IN FIRST WORD ARGUMENT OF GOLD DCA FWARG /M PROMPT SO WILL DISPLAY AND PRESS GOLD M JMS RSDSK /GO DISPLAY REPLACE SYSTEM DISK PROMPT JMP OGOLD1 /GO DISPLAY AND PRESS GOLD M CHARG, TAD (ORAR) DCA SDFW /MAKE OR FIRST WORD OF REPLACE MESSAGE JMP SDOUT1 /VERIFIES USER INSERTS INITIALIZED DOCUMENT FLOPPY INTO DRIVE WHEN /REPLACING A FLOPPY DUE TO SPACE PROBLEMS /CALLED BY JMS DDCHK;ERROR RETURN;OK RETURN /AC 0 ON RETURN DDCHK, XX DDCHK1, JMS ERASE CLA TAD CUSRC6 /MAKE AC EQUAL TO RESULT DRIVE /SO GTDKID READS FLOPPY IN APPROPRIATE DRIVE JMS GTDKID /READ HOME BLOCK INTO CUB1 CLA CLL /GTDKIT RETURNS WITH DISKETTE ID IN AC SO CLEAR / TAD CUB1+0 /GET WORD 0 OF HOME BLOCK /D014 / TAD (-7401) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECK /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 / TAD CUB1+1 /GET WORD 1 (BLOCK TYPE) OF HOME BLOCK /D014 / AND (0070) /ISOLATE BITS 6-8 /D014 / CLL RTR /CLEAR LINK AND /D014 / RAR /MOVE TO BITS 9-11 /D014 / TAD (-3) /ADD NEGATIVE OF VALUE IT SHOULD BE /D014 / SZA CLA /IF 0 CONTINUE CHECKING /D014 / JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID /D014 TAD CUB1+6 /GET BLOCK NUMBER OF HOME BLOCK TAD (-DLALOC) /ADD NEGATIVE OF VALUE IT SHOULD BE SZA CLA /IF 0 RETURN TO USER JMP DDERR /ELSE TELL USER DISKETTE IS NOT VALID ISZ DDCHK /INCREMENT FOR OK RETURN TAD (500) /ERASE SCREEN JMS ERASE /BEFORE CONTINUING CLA DCHKXT, JMP I DDCHK /RETURN AND CONTINUE DDERR, JMS ERASE JMS DSORT JMS DERCKW / CHECK FOR WINCHESTER DRIVE /A030 CIFMNU JMS I IOACAL 0 DERR / INVALID DISKETTE MESSAGE 505 DERST1, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 CUSRC6 / RESULT DOC DRIVE NUMBER DERST2, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 605 DERST3, 0000 / ADDR OF SUBSTRING - SET BY DERCKW /A030 JMS PRETURN JMS ORGOLD ORAR JMS KBRD /READ INPUT CLA /USER PRESSED RETURN SO TAD (RXERT /TO TELL SYSTEM TO FORGET INDEX INFORMATION DCA QUQBLK+RXQFNC /BECAUSE USER WILL PUT IN NEW FLOPPY JMS QURX CLA /THIS ERASES ANY ERROR RETURN FROM QURX JMP DCHKXT /USER PRESSED RETURN GO ASK FOR RESULT AGAIN PAGE /DISPLAYS THAT RESULT DOC IS ALREADY IN USE. /CALLED BY / JMS LCKMSG / NON ERROR RETURN CONTINUES / ERROR RETURN PROMPTS FOR RESULT AGAIN /TEST FOR REMOVAL OF SYSTEM FLOPPY, IF IT HAS BEEN REMOVED SURPRESS LOCK ERROR /MESSAGE BECAUSE DOCUMENTS ARE NOT THE SAME LCKMSG, XX /M007 JMS GTDKID /GET DISKETTE ID NOTE AC 0 HERE A007 TAD DSKNO /GET CURRENT SYSTEM DISKETTE ID A007 SZA CLA /HAS DISKETTE BEEN REMOVED A007 JMP LOKRTN /YES RETURN TO CALLER WITHOUT DISPLAYING ERROR A007 /ELSE DISPLAY LOCK ERROR MESSAGE TAD (2205) /ERASE GOLD M PROMPT JMS ERASE CIFMNU JMS I IOACAL 0 SRLCKER /TEXT STRING DOC ALREADY IN USE 2205 IFDEF FRENCH < 141 > /L.G.A. BELTXT /RING BELL CUSRC6 /RESULT DOC DRIVE NUMBER M007 CUSRC5 /RESULT DOC NUMBER M007 CUSRDN /RESULT DOC NAME M007 CIFMNU JMS I IOACAL 0 TARTN 2405 JMS RTNWT /READ INPUT AND WAIT FOR RETURN JMP LCKMSG /IF NOT RETURN REDISPLAY COMPLAINT TAD (2205) /RETURN WAS TYPED ERASE COMPLAINT JMS ERASE ISZ LCKMSG /INCREMENT FOR ERROR RETURN LOKRTN, JMP I LCKMSG /RETURN TO CALLER /CALLED BY JMS GMTST;GOLD M;GOLD KEY NOT GOLD M GMTST, XX /TEST IF KEY IN GOLD KEY. IF GOLD M GOES TO MM /IF GOLD KEY NOT GOLD M DISPLAYS WHEN TYPING TO MENU /ERROR MESSAGE. ASSUMES THAT CHARACTER IS IN AC GMTST1, TAD (-EDMENU) /SEE IF GOLD M SNA CLA /IF AC = 0 JMP CHKIT /GO SEE IF SYSTEM FLOPPY IS IN /ELSE RING BELL AND OUTPUT WHEN TYPING TO MENU ERROR /MESSAGE GMERDSP, / /d025 TAD (2205) /ERASES BEFORE DISPLAYING NEXT /d025 /d025 JMS ERASE / /d025 JMS RBELL / /d025 CIFMNU / /d025 /d025 JMS I IOACAL / /d025 /d025 0 / /d025 /d025 TRYAGN / /d025 /d025 2205 / /d025 /d025 2305 / /d025 /d025 2405 / /d025 /d025 IFDEF FRENCH < 153 > /L.CLFX.E /d025 /d025 2605 / /d025 /d025 IFDEF CANADA < 141 > /L.G.A. /d025 /d025 IFDEF FRENCH < 141 > /L.G.A. /d025 /d025 JMS RTNWT /WAIT FOR RETURN /d025 /d025 JMP GMERDSP /NOT RETURN DISPLAY COMPLAINT AGAIN /d025 /d025 TAD (2205) /ERASE SCREEN, RETURN TO CALLER, ASK AGAIN /d025 /d025 JMS ERASE / /d025 GMRTN2, ISZ GMTST /GOLD KEY NOT GOLD M RETURN GMRTN1, JMP I GMTST /GOLD M RETURN CHKIT, /AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY JMS GTDKID /GO READ DISKETTE ID TAD DSKNO /ADD CURRENT DISKETTE ID SNA CLA /IF ZERO SAME DISKETTE IS IN SO JMP GMRTN1 /SET FOR GOLM RETURN JMS RBELL /ELSE RING BELL JMS RSDSK /FLASH REPLACE SYSTEM FLOPPY DISPLAY CDFMYF CIFMNU JMS I INACAL INBUF JMP GMTST1 JMS RBELL JMP CHKIT / SUBROUTINE TO DISPLAY: 'TYPING "" HAS NO MEANING HERE' / CALLED BY: JMS NOMEAN; RETURN PC (and read input again) NOMEAN, XX / COSMETIC display mods /M0018 NOMNDSP,JMS RBELL / RING BELL /d025 /d025 IFDEF ENGLSH < /A011 /d025 CLA / TRUNCATE STUFF BETWEEN QUOTES /A011 /d025 DCA I (INBUF+14)/ SO MESSAGE WILL FIT ON 1 LINE /A011 /d025 / end 'ifdef english' /A011 > /d025 /d025 IFDEF FRENCH < /A011 /d025 CLA /A011 /d025 DCA I (INBUF+14) /A011 /d025 / end 'ifdef french' /A011 > /d025 /d025 CIFMNU / DISPLAY: 'TYPING "" HAS NO MEANING HERE' /d025 JMS I IOACAL /d025 0 /d025 NMEAN /d025 -2700 / LINE 27 COLUMN 0 /M011 /d025 /d025 IFNDEF DUTCH < /A011 /d025 INBUF+1 / WE NEED THE +1 TO MOVE ONE ADDRESS BEYOND /d025 / THE -BUFFER SIZE IN FIRST LOCATION /d025 / end 'ifndef dutch' / > /d025 /d025 IFDEF CANADA < 141 > / L.G.A. /d025 IFDEF FRENCH < 141 > / L.G.A. /d025 /d025 JMS RTNWT / WAIT FOR RETURN /d025 JMP NOMNDSP / NO RETURN COMPLAIN AGAIN /d025 TAD (2605) / RETURN SO ERASE SCREEN /d025 JMS ERASE / CLA / /a025 JMP I NOMEAN / RETURN TO CALLER TO ASK AGAIN NDERR, XX TAD I NDERR /PICK UP DOC NAME DCA DCNAM /STORE IT FOR ERROR MESSAGE ISZ NDERR /INCREMENT FOR RETURN CDFMNU /CHANGE TO MENU FIELD TAD I (MUBUF+MNDRV) /PICK UP DRIVE NUMBER CDFMYF /CHANGE BACK TO MY FIELD DCA DCRV /STORE IN DRIVE NUMBER FOR ERROR MESSAGE TAD (2205) JMS ERASE JMS NDERCW / CHECK FOR WINCHESTER DRIVE /A030 NDDSP, CIFMNU JMS I IOACAL 0 NDOC 2205 NDSTR, 0000 / ADDR OF SUBSTRING "DRIVE-DEVICE /A030 DCRV, 0000 DCNAM, 0000 CIFMNU JMS I IOACAL 0 TARTN 2505 JMS RTNWT /WAIT FOR RETURN JMP NDDSP /NOT RETURN COMPLAIN AGAIN TAD (2205) /RETURN ERASE SCREEN JMS ERASE JMP I NDERR /AND CONTINUE / CHECK FOR WINCHESTER DRIVE /A030 NDERCW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA NDOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER DRIVE /A030 AND NDOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 TAD DCRV / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP NDCTD / YES - INSERT TEXT "DRIVE /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP NDCTW / NO - INSERT TEXT "DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND NDOPTN / IS VOLUME ASSIGNED TO 1 /A030 SNA CLA / YES - SKIP AND INSERT "DEVICE /A030 JMP NDCTD / NO - INSERT TEXT "DRIVE /A030 NDCTW, TAD (SRDEV) / ADDR OF TEXT "DEVICE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 JMP NDCWEX / BRANCH TO EXIT /A030 NDCTD, TAD (SRDRV) / ADDR OF TEXT "DRIVE /A030 DCA NDSTR / INTO PARAMETER LIST /A030 NDCWEX, JMP I NDERCW / RETURN /A030 NDOPTN, 0 / OPTION WORD /A030 PAGE / READ FROM KEYBOARD / CALLED BY: JMS KBRD; RETURN TYPED KBRD, XX /COMPARE IS DESIRED CALLED WITH 0 IN AC KBRD1, CDFMYF CIFMNU JMS I INACAL / CALL INA TO READ INPUT INBUF / LOCATION TO RECEIVE INPUT JMP GOLDTST / PROCESS GOLD KEY CLA MQA / MQ CONTAINS #CHARS IN BUFFER SNA CLA / IF THIS IS 0 RETURN WAS TYPED JMP I KBRD / GO BACK TO CALLER JMS NOMEAN / ELSE MUST BE INAPPROPRIATE RESPONSE COMPLAIN JMP KBRD1 / ASK AGAIN GOLDTST,JMS GMTST / GO READ GOLD KEY JMP CUSR1 / GOLD MENU RETURN JMS PRETURN / DISPLAY PRESS RETURN A007 JMS ORGOLD / DISPLAY OR PRESS GOLD M A007 ORAR / A007 JMP KBRD1 / READ INPUT AGAIN NOT GOLD MENU / CALLED WITH 0 OR 1 IN AC TO DETERMINE / FROM WHICH FLOPPY THE 'HOME' BLOCK / WILL BE READ GTDKID, XX JMS CUPDRS TAD (CUB1) / BUFFER ADDRESS DCA QUQBLK+RXQBAD TAD (RXBDIR)/ BLOCK TO READ (HOME BLOCK) DCA QUQBLK+RXQBLK TAD (RXEDN) / TELL QURX TO 'get density' /A0020 DCA QUQBLK+RXQFNC /A0020 JMS QURX / /A0020 CLA / /A0020 TAD (RXERD) / TELL QURX TO 'read' DCA QUQBLK+RXQFNC JMS QURX CLA / THIS CLOBBERS ANY QURX ERROR RETURN TAD CUB1+5 / INDEX TO FIFTH WORD (DISKETTE ID#) JMP I GTDKID / EXIT WITH CURRENT DISKETTE ID IN AC /SEE IF PRINTER IS BUSY BEFORE TELLING USER TO REMOVE FLOPPY PTRCHK, XX CLA CDFPRT /CHANGE DATA FIELD TO PRINTER FIELD TAD I (PRSTTS) /GET PRINTER STATUS WORD CDFMYF /CHANGE DATE FIELD BACK TO MINE SNA CLA /IF NOT ZERO COMPLAIN JMP I PTRCHK /ELSE RETURN TO CALLER AND CONTINUE PTRMSG, JMS ERASE CIFMNU /DISPLAY PRINTER IS BUSY MESSAGE JMS I IOACAL 0 PTRBUS 505 605 JMS ORGOLD /DISPLAY PRESS GOLD M FOR MM NARG JMP INPUT /READ INPUT /HERE FOR SPACE REASONS M007 NEWLN, XX / A007 CDFMYF / A007 CIFMNU / A007 JMS I IOACAL / CALL IOA OUTPUT ROUTINE A007 0 / ADDRESS OF OUTPUT ROUTINE A007 ASTRING / A007 CRLF / STRING FOR CAR RETURN LINEFEED A007 JMP I NEWLN / A007 TOSMALL, XX JMS TOSCKW / CHECK FOR WINCHESTER /A030 CDFMYF CIFMNU /CHANGE INSTRUCTION FIELD TO MENU FIELD JMS I IOACAL /GO DISPLAY NOT ENOUGH ROOM SPECIFY ANOTHER DRIVE 0 TSMALL /ADDRESS OF FIRST PROMPT 505 /DISPLAY FIRST PROMPT ON LINE 5 COLUMN 5 TSSTRA, 0000 / ADDR OF SUBSTRING /A030 CUSRC6 /RESULT DRIVE NUMBER 605 JMP I TOSMALL /EXIT ROUTINE WHICH UNLOCKS DOCUMENTS BEFORE GOING TO MM CUSR1, JMP RETMNU /M027 /CALLS MENU TO READ INPUT TO DOC PROMPTS, TOA AND GO PROMPTS /CALLED BY: /JMS READMU / GOLD M DATA FIELD SET TO MY FIELD / CONTINUE PROCESSING DATA FIELD SET TO MENU FIELD READMU, XX CDFMNU DCA I (MUBUF+MNTMP4) /SET TMP4 FOR APPROPRIATE FUNCTION READLP, CDFMYF /SET DATA FIELD TO MENU /M027 CIFMNU;JMS I MNUCAL;DLMSR1 /CALL MENU CDFMNU /CHANGE DATA FIELD TO MENU TAD I (MUBUF+MNTMP3) /GET AND TEST CONTENTS OF TMP3 SZA /IF 0 THEN GOLD KEY WAS PRESSED JMP RDRTN2 /NOT GOLD KEY SO RETURN AND PROCESS INPUT TAD I (MUBUF+MNSYSA) /WAS GOLD KEY TO GET IT TAD (4000) /SET FIRST BIT TO 1 BECAUSE MENU STRIPS IT OFF CDFMYF /CHANGE DATA FIELD TO MINE JMS GMTST /PROCESS GOLD KEY JMP RDRTN1 /GOLD M RETURN /d025 JMS PRETURN /DISPLAY PRESS RETURN /A007 /d025 /d025 JMS ORGOLD /DISPLAY OR PRESS GOLD M /A007 /d025 /d025 ORAR / /A007 /d025 JMP READLP /GOLD GARBAGE, READ INPUT AGAIN /M027 RDRTN2, ISZ READMU /GOLD M EXIT RDRTN1, JMP I READMU /CONTINUE EXIT /COPIES INPUT FROM MENU FIELD TO INBUF FOR NO MEANING PROMPT MVINPT, XX CLA JMS CUCOPY /GO COPY INPUT FROM MENU FIELD TO INBUF MUISTR /ADDRESS OF FROM FOR CUCOPY CDFMNU /DATA FIELD OF FROM INBUF+1 /ADDRESS OF FOR FOR CUCOPY CDFMYF /CHANGE DATA FIELD TO MINE STRLEN /NUMBER OF WORDS TO COPY (STANDARD) JMP I MVINPT /RETURN TO CALLED PAGE / PARSE A SPECIFICATION DOCUMENT FOR SORT AND LOAD THE RESULT INTO MEMORY / PARSE, . DCA SPECNO /AJF PUT SPEC DRIVE & DOC FROM AC INTO SPECNO DCA DEADKEY / CLEAR DEADKEY FLAG / TAD (-KVTWIDTH); DCA VTWIDTH /SET LINE WIDTH FOR DISPLAY ROUTINE D007 /INITIALIZE FIELD NAME COUNTER MAXIMUM FIELD SIZE M007 DCA NUMKEY /SET KEY FIELD COUNTER TO ZERO A007 AC4000 /SET AC TO 4000 A007 DCA ORDWD /SET FIRST BIT OF ORDWRD TO 1 A007 DCA FTYPE /SET FIELD NAME TYPE TO 0 A007 / SETUP INTO AUTO INDEX #12 / AC7777 CDFSRT /CHANGE DATA FIELD TO SORT FIELD A007 TAD I (SDFNBUFFER) /GET LOCATION OF BUFFER M007 CDFMYF /CHANGE DATA BACK TO MY FIELD A007 DCA A12 TAD (-FNSIZE-1); DCA FNCOUNT JMS ERASE /ERASE SCREEN A008 JMS DSORT /DISPLAY SORT A008 CIFMNU JMS I IOACAL /CALL IOA 0 /ADDRESS OF OUTPUT ROUTINE HC /TEXT STRING TO POSITION CURSOR ON LINE 3 M008 0100 /SET TO LINE 3 SO THERE IS ROOM FOR 12 LINES /OF SPEC DOC AND ERROR MESSAGES / /OPEN THE FILE FOR READING / TAD SPECNO; CIFFIO; FILEIO; XRDFIN /M0010 /LOOKING FOR THE TEXT STRING: / / 'SORT ON IN ASCENDING ORDER' / /OR: 'SORT ON IN DESCENDING ORDER' / / WITHIN THE SORT SELECTION SPECIFICATION DOCUMENT / STPARS, JMS TXTCOM; MSORTON; ERR001 / PARSE THE FROM THE SPECIFICATION DOCUMENT / /GET A CHARACTER FROM THE SPEC DOC - *** ERR001 IF NO MORE / CLA; JMS RD1CHR; ERR001 / TEST CHARACTER FOR '<' LEFT ANGLE BRACKET *** ERR001 IF NOT / (AC) = CHARACTER FROM 'JMS RD1CHR' / TAD (-74); SZA CLA; ERR001 JMP GETFNCHAR DONE, CLA AC7777 /SET AC TO -1 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 /WRITE -1 BUFFER TERMINATOR XSDFN A007 CDFMYF /CHANGE DATA FIELD BACK TO MINE A007 JMP I PARSE /EXIT TO PROMPT FOR LIST DOC ERR, XX / A007 CDFMYF /MAKE SURE DATA FIELD IS MY FIELD A007 CIFMNU /MAKE INSTRUCTION FIELD MENU FIELD A007 JMS I IOACAL /CALL IOA A007 0 / A007 ASTRING / A007 ACARET /STRING TO POSITION THE CARET A007 JMS NEWLN / POSITION THE NEXT LINE A007 JMP I ERR /EXIT A007 / CHECK FOR WINCHESTER /A030 DERCKW, XX /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA DEOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND DEOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT1 / NO - INSERT TEXT - DISKETTE, DRIVE /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP AND CONTINUE /A030 JMP DERCT2 / YES - INSERT TEXT - DISKETTE,DRIVE,DISK/VOL /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP AND CONTINUE /A030 JMP DERCT3 / NO - INSERT TEXT - VOLUME,DEVICE,DISK/VOL /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND DEOPTN / IS VOLUME ASSIGNED ? /A030 SNA CLA / YES - SKIP & INSERT TEXT - VOL,DEV,DSK/VOL /A030 JMP DERCT2 / NO - GO INSERT TEXT - DSK,DRV,DSK/VOL /A030 DERCT3, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA DERST1 / INTO PARAMETER LIST /A030 TAD (DERVL2) / ADDR OF "VOLUME /A030 DCA DERST2 / INTO PARAMETER LIST /A030 TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO PARAMETER LIST /A030 JMP DERCEX / BBRANCH TO EXIT /A030 DERCT1, TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST3 / INTO LIST /A030 JMP DERCT4 /A030 DERCT2, TAD (DERDKV) / ADDR OF "DISKETTE/VOLUME /A030 DCA DERST3 / INTO LIST /A030 DERCT4, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA DERST1 / INTO LIST /A030 TAD (DERDS2) / ADDR OF "DISKETTE /A030 DCA DERST2 / INTO LIST /A030 DERCEX, JMP I DERCKW / RETURN /A030 DEOPTN, 0000 / OPTION WORD /A030 PAGE /GETFNCHAR, AC0000; JMS RD1CHR; ERR001 GETFNCHAR, AC7777; JMS RD1CHR; ERR001 /M003 MQL / TEMP SAVE IT IN THE MQ MQA TAD (-76) /SEE IF '>' SNA JMP FNEND /YES, DONE FIELD TAD (2) /SEE IF '<' SNA ERR001 / '<' FOUND WITHIN TAD (2) /SEE IF IT IS A : (COLON SIGNIFIES A007 SZA CLA /NUMERIC KEY FIELD) A007 JMP INCFCTR /IF NOT A COLON CONTINUE A007 TAD ORDWD /IF COLON SET APPROPRIATE BIT IN FTYPE A007 TAD FTYPE /A007 DCA FTYPE /STORE WORD WITH BIT SET FOR NUMERIC A007 INCFCTR,TAD DEADKEY / Check for the status of dead keys /a031 SNA CLA / Is one currently being evaluated? /a031 ISZ FNCOUNT / No, SEE IF ROOM /m031 SKP ERR001 / EXCEEDED 30(10) CHARACTERS MQA CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007M014 DCA I A12 /AND STORE IN STRING CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 JMP GETFNCHAR /LOOP BACK FOR MORE FNEND, CLA / A007 TAD FNCOUNT /GET COUNT OF WORDS USED A007 TAD (FNSIZE+1) /COMPARE WITH ORIGINAL BUFFER SIZE A007 SNA CLA /IF EQUAL A007 ERR001 /THERE IS AN ERROR ONLY <> FOUND A007 CDFSDFN /CHANGE DATA FIELD TO 'SDFN' FIELD /A007/M014 DCA I A12 / [0] /THERE ARE CHARACTERS STORE TRAILING 0 A007 CDFMYF /CHANGE DATA FIELD BACK TO MY FIELD A007 DCA FNCOUNT /SET FIELD CHARACTER COUNTER BACK TO 0 A007 /FOR NEXT FIELD A007 ISZ NUMKEY /INCREMENT KEY FIELD COUNTER A007 CMPORDER,JMS TXTCOM; MINA; JMP CHKD; JMP CHKETC CHKD, CLA TAD THCHAR /GET CHAR TXTCOM STORED IFDEF ENGLSH < TAD (4) /IS IT A D? > IFDEF ITALIAN < TAD (4) > IFDEF V30NOR < TAD (31) /IS IT A Y? > IFDEF V30SWE < TAD (6) /IS it an F > IFDEF DUTCH < TAD (1) > IFDEF SPANISH < TAD (4) > SZA /IF AC 0 THEN IT IS A D SEE IF NEXT CHAR IS AN E ERR001 /ELSE ERROR CHKE, JMS TXTCOM; ME; ERR001 CLA / A007 TAD ORDWD /GET ORDER WORD AND COMBINE WITH ORDER A007 /FIRST TIME HERE BIT 0 IS SET FOR DESCENDING, NEXT TIME BIT 1 ETC. A007 TAD ORDER /ADD CONTENTS OF ORDER A007 DCA ORDER /STORE BACK IN ORDER A007 CHKETC, JMS TXTCOM; MSCENDING; ERR001 /A SUCCESSFUL COMPARISON OF THE TEXT STRING 'ASCENDING ' OR 'DESCENDING ' /HAS BEEN COMPLETED /SET NEXT BIT IN ORDWD FOR KEY FIELD DESCRIPTOR WORDS ORDER AND FTYPE A007 CLA CLL TAD ORDWD /GET ORDER WORD A007 RAR /MOVE BIT ONCE TO RIGHT A007 DCA ORDWD /STORE BACK IN ORDER WORD A007 /THE TEXT STRING 'ORDER' MUST SUFFIX / JMS TXTCOM; MORDER; ERR001 / /PARSE FOR AND A007 PSAND, JMS TXTCOM; MAND; JMP ERRTST / A007 CLA /SEE IF MAX FIELDS HAVE BEEN SPECIFIED A007 TAD NUMKEY /GET KEY FIELDS SPECIFIED A007 TAD (-MXFLD) /IS MAX = TO NUMBER SPECIFIED A007 SNA CLA /IF AC 0 A007 ERR002 /DISPLAY ERROR A007 JMP STPARS /ELSE BEGIN PARSING NEXT LINE A007 SPECNO, 0000 ORDWD, 0000 /USED TO SET KEY FIELD NAME DESCRIPTOR WORDS A007 /ORDER AND FTYPE, 1 IN ORDER MEANS SORT IS DESCENDING A007 /ORDER, AND 1 IN FTYPE MEANS NUMERIC FIELD A007 /THIS VARIABLE IS FIRST SET TO 4000 AND THE 1 IN BIT 0 A007 /IS SHIFTED ONCE TO RIGHT EACH TIME THROUGH PARSER A007 FNCOUNT,0000 /**************************************************************************** / / The next routine has been moved to where OUT2VT was to make /a031 / room for changes to the parser for dead key sequence evaluation /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 /d031 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 /d031 CLA / CLEAR AC /A030 /d031 CDFMNU / MENU FIELD /A030 /do31 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 /d031 CDFMYF / BACK TO THIS FIELD /A030 /d031 DCA TSOPTN / SAVE VALUE /A030 /d031 AC0004 / MASK - WINCHESTER INSTALLED /A030 /d031 AND TSOPTN / IS WINNIE BIT SET ? /A030 /d031 SNA CLA / YES - SKIP AND CONTINUE /A030 /d031 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 /d031 TAD CUSRC6 / CK FOR DRIVE 0 /A030 /d031 SNA / NO - SKIP & CONTINUE /A030 /d031 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 /d031 TAD (-1 / CK FOR DRIVE 1 /A030 /d031 SZA CLA / YES - SKIP & CONTINUE /A030 /d031 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 /d031 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 /d031 AND TSOPTN / IS VOLUME ASSIGNED /A030 /d031 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 /d031 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 /d031 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 /d031 DCA TSSTRA / INTO PARAMETER LIST /A030 /d031 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 JMP TSCKEX / BRANCH TO EXIT /A030 /d031 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 /d031 JMP TSCTD3 / /A030 /d031 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 /d031 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 /d031 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 /d031 DCA TSSTRA / INTO LIST /A030 /d031 TSCKEX, JMP I TOSCKW / RETURN /A030 /d031 TSOPTN, 0000 / OPTION WORD /A030 PAGE /BEFORE YOU START TEARING YOUR HAIR OUT I WILL EXPLAIN A007 /EVERYTHING YOU ARE AFRAID TO ASK ABOUT THE FOLLOWING FEW A007 /LINES OF CODE. WE ARE HERE BECAUSE OF A TEXT COMPARISON A007 /FAILURE. THE CATCH IS THERE ARE TWO EXITS OUT OF TXTCOM A007 /IF THERE ARE NO MORE CHARACTERS IN THE SPEC DOC AND IF A007 /THERE IS A MATCH FAILURE WITH THE CONTENTS OF SPEC DOC A007 /AND THE WORD 'AND'. IF THERE ARE NO MORE CHARACTERS IN SPEC A007 /DOC THE VARIABLE THCHAR IS NOT UPDATED SO IT STILL CONTAINS A007 /THE R FROM THE WORD ORDER FROM LAST TXTCOM CALL. SO TO A007 /DETERMINE IF WE ARE EXITING BECAUSE IT IS END OF SPEC DOC A007 /I TEST FOR AN R. THE VARIABLE THCHAR CONTAINS THE NEGATIVE A007 /VALUE OF THE LAST CHARACTER. THIS SEEMED EASIER THAN REWRITING A007 /PARSER. A007 ERRTST, CLA /SEE WHAT KIND OF ERROR A007 TAD THCHAR /SEE IF THCAR IS UPDATED IF NOT DONE A007 IFDEF ENGLSH < TAD (22) /SEE IF LAST CHAR READ FROM SPEC IS R A007 > IFDEF V30NOR < TAD (5) > IFDEF ITALIAN < TAD (5) > IFDEF V30SWE < TAD (7) > IFDEF DUTCH < TAD (5) > IFDEF SPANISH < TAD (5) > SZA CLA /IF IT IS WE ARE DONE A007 ERR002 /ELSE JUST AN ORDINARY ERROR A007 JMP DONE / NOTE THAT (AC) = 0 HERE NATURALLY / / JMS RD1CHR; SKP /TRY TO GET ANOTHER CHAR FROM THE SPEC DOC / ERR002 /CALL ERROR 2 SPEC DOC TOO BIG / /THE SORT SELECTION SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY / ERR2, JMS ERR /POSITION CARET UNDER TEXT A007 CIFMNU / A007 JMS I IOACAL /DISPLAY ERROR MESSAGE A007 0 / A007 FSERR /DISPLAY # FIELDS SPECIFIED A007 NUMKEY, 0000 /NUMBER OF KEY FIELDS SPECIFIED A007 JMS NEWLN /CARRIAGE RETURN LINE FEED A007 CIFMNU /CHANGE INSTRUCTION FIELD TO MENU A007 JMS I IOACAL / A007 0 / A007 FSER2 /NEXT LINE OF PROMPT A007 JMS NEWLN /POSITION ON NEXT LINE A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 PRCON /PRESS RETURN TO CONTINUE A007 JMS ORGOLD / A007 ORAR / A007 JMS KBRD /Return was typed /A013 JMP DONE /Exit parser /A013 ERR1, JMS ERR / A007 CIFMNU / A007 JMS I IOACAL / A007 0 / A007 MWHAT /THIS OUTPUT ROUTINE ASSUMES SPEC DOC A007 IFDEF CANADA < 141 > /L.G.A. /WON'T EXCEED 12 LINES IFDEF FRENCH < 141 > /L.G.A. JMS ORGOLD / A007 NARG / A007 /D026 IFDEF WS102 < /D007 JMS ULKSUB; SPECNO; CDFMYF /D026 > /END IFDEF WS102 JMP INPUT /READ INPUT A008 / THE SORT SPECIFICATION DOCUMENT HAS BEEN PARSED OK / / THE RESIDES WITHIN 'SDFNBUFFER' / / READ A CHARACTER FROM THE SPECIFICATION DOCUMENT (OR THE DOCUMENT OPENED) / / JMS RDNXCH; EOF RETURNS TO HERE; OK RETURNS TO HERE / RDNXCH, .; CLA; CIFFIO; FILEIO; XRDFNC /M0010 SPA; CLA / Treat read errors like E-O-F. /A0016 SZA ISZ RDNXCH JMP I RDNXCH /SUBROUTINE TO READ IN A CHARACTER FROM THE SPECIFICATION DOCUMENT /AND EXIT WITH IT IN THE AC / / AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, FUNNY SPACES AND 'S / AC AT ENTRY =-1: IGNORES ONLY: RULERS, FUNNY SPACES AND LINE FEEDS / /CALLED WITH AC=0 OR AC=-1: / JMS RD1CHR /EOF RETURN (AC UNDEFINED) /NORMAL RETURN (AC CONTAINS CHARACTER) / RD1CHR, 0 DCA RDFLAG /SAVE FLAG RDNEXT, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** DISK EOF - EXIT *** DCA CHARIN /SAVE CHAR ( *** INCLUDING MODE BITS *** ) TAD CHARIN AND P177 /STRIP OFF MODE BITS TAD (-41) / IS IT A PRINTABLE CHARACTER ? SPA JMP NPC / NON PRINTABLE CHARACTER TAD (41) /GET BACK PRINTABLE CHARACTER JMS OUT2VT /AND OUTPUT TO THE SCREEN ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR /AND EXIT /NON PRINTING (SPECIAL) CHARACTER / NPC, TAD (25) / IS THE CHARACTER A FORM FEED: (-41)+(25)=- (14) SNA JMP LPTCTRL /YES, NOW CHECK IF SPECIAL TAD (-2) /NO, WHAT ABOUT START OF RULER (16) SNA CLA JMP SKPRULER /YES, GO IGNORE RULER TAD CHARIN /NO, GET CHAR BACK AND (7600) / LOOK AT MODE BITS SZA CLA JMP RDNEXT /YES, SO IGNORE IT TAD CHARIN /NO, GET CHAR ONCE MORE AND P177 / STRIP MODE BITS TAD (-BELL) / TEST FOR ^G (MODIFIED FLAG) ? SNA CLA JMP RDNEXT /YES, JUST IGNORE NORMFF, TAD CHARIN /GET CHARACTER TO RETURN WITH AND P177 / STRIP MODE BITS JMS OUT2VT /SHOW CHAR ON SCREEN MQL /SAVE CHAR TAD RDFLAG / TEST 'IGNORE ALL' FLAG SNA CLA JMP RDNEXT /YES, IGNORE CHARACTER MQA /NO, GET CHAR BACK ISZ RD1CHR / +1 TO RETURN ADDRESS JMP I RD1CHR / EXIT / /LOOKING FOR -1014 (START OF PRINTER CONTROL) / OR -1414 (END OF PRINTER CONTROL) / LPTCTRL,TAD CHARIN /TEST FOR 'START OF PRINTER CONTROL' TAD (-1014) SZA CLA /YES, IGNORE ALL CHAR UNTIL 'END OF PRINTER CONTROL' JMP NORMFF /NO, MUST HAVE BEEN NORMAL FF TILEND, JMS RDNXCH /GET A CHAR JMP I RD1CHR / *** ERROR EXIT, DISK EOF *** TAD (-1414) / 'END OF PRINTER CONTROL' YET ? SZA CLA JMP TILEND / KEEP LOOKING FOR 'END OF PRINTER CONTROL' JMP RDNEXT /YES, BACK TO NORMAL PROCESSING / /START OF RULER (16) WAS FOUND ... IGNORE THE RULER / SKPRULER,JMS RDNXCH /GET A CHARACTER JMP I RD1CHR / *** ERROR EXIT *** TAD (-17) /END OF RULER? SZA CLA JMP SKPRULER /NO, KEEP LOOKING JMP RDNEXT /YES, BACK TO NORMAL PROCESSING RSDSK, XX / DISPLAYS 'REPLACE SYSTEM DISKETTE, CALLED IF USER CIFMNU / TYPES GOLD M AND A DOCUMENT RATHER THAN SYSTEM JMS I IOACAL / DISKETTE IS IN DRIVE 0 0 RSYS / REPLACE SYSTEM DISKETTE TEXT 2405 SDFW, NARG / FIRST WORD EITHER OR OR " " JMP I RSDSK PAGE /DISPLAY (OUTPUT TO THE SCREEN) THE CHARACTER IN THE AC AT ENTRY / (INSERTING A WHEN THE CHAR IN THE AC AT ENTRY = / /This routine has been moved to page 1000 to make room for the dead key /a031 /changes. /a031 /d031 OUT2VT, 0 /d031 DCA CHR2VT /SAVE CHARACTER TO BE DISPLAYED /d031 TAD CHR2VT /CHECK FOR RIGHT AWAY /d031 TAD (-CR) /d031 SZA CLA /d031 JMP NOTCR /d031 DCA DEADKEY /d031 JMP VTEXIT /d031 NOTCR, TAD DEADKEY /SEE IF IN MIDDLE OF DEADKEY SEQUENCE /d031 SZA CLA /d031 JMP VTEXIT /YES, DON'T OUTPUT CHAR /d031 TAD CHR2VT /d031 TAD (-BACKSP) /BACKSPACE ? /d031 SZA /d031 JMP NOTBACKSPACE / / START OF DEADKEY SEQUENCE / /d031 AC7777; DCA DEADKEY /SET DEADKEY FLAG /d031 CIFMNU /d031 JMS I IOACAL /DISPLAY DEAD KEY SEQUENCE /d031 0 /d031 ASTRING /d031 ASDK /d031 JMP VTEXIT /GET CHARACTER BACK AND EXIT /d031 NOTBACKSPACE,TAD (BACKSP-LF) /SEE IF LF /d031 SZA CLA /d031 JMP NOTEOL /NO M007 /d031 JMS NEWLN /OUTPUT CARRIAGE RETURN LINE FEED A007 /d031 VTEXIT, TAD CHR2VT /GET CHAR BACK /d031 JMP I OUT2VT /AND EXIT /d031 /d031 NOTEOL, CIFMNU / CHANGE THE 'IF' TO THE 'MENU' FIELD A007 /d031 JMS I IOACAL / TO 'IOA' FOR CHARACTER OUTPUT A007 /d031 0 /d031 ASTRING / ^S MEANS AN ASCII STRING (OF 1 CHAR) A007 /d031 CHR2VT / 'CHR2VT' CONTAINS 7-BIT ASCII A007 /d031 JMP VTEXIT / /**************************************************************************** / / The following code was moved here to make room for changes to /a031 / the parsing code for dead key sequence evaluation. /a031 / /**************************************************************************** / CHECK FOR WINCHESTER DRIVE /A030 TOSCKW, XX / CK FOR WINCHESTER ON SYSTEM /A030 CLA / CLEAR AC /A030 CDFMNU / MENU FIELD /A030 TAD MUBUF+MNOPTN / FECTH OPTION WORD /A030 CDFMYF / BACK TO THIS FIELD /A030 DCA TSOPTN / SAVE VALUE /A030 AC0004 / MASK - WINCHESTER INSTALLED /A030 AND TSOPTN / IS WINNIE BIT SET ? /A030 SNA CLA / YES - SKIP AND CONTINUE /A030 JMP TSCTD1 / NO - INSERT TEXT "DRIVE" ONLY /A030 TAD CUSRC6 / CK FOR DRIVE 0 /A030 SNA / NO - SKIP & CONTINUE /A030 JMP TSCTD2 / YES - GO INSERT "DRIVE/DEVICE" /A030 TAD (-1 / CK FOR DRIVE 1 /A030 SZA CLA / YES - SKIP & CONTINUE /A030 JMP TSCTW / NO - INSERT "VOLUME ON DEVICE /A030 AC0010 / MASK - VOLUME ASSIGNED TO 1 /A030 AND TSOPTN / IS VOLUME ASSIGNED /A030 SNA CLA / YES - SKIP & INSERT "VOLUME ON DEVICE /A030 JMP TSCTD2 / NO - GO INSERT "DISKETTE ON DRIVE /A030 TSCTW, TAD (DERVL1) / ADDR OF "VOLUME ON DEVICE /A030 DCA TSSTRA / INTO PARAMETER LIST /A030 TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 JMP TSCKEX / BRANCH TO EXIT /A030 TSCTD1, TAD (SRDRV) / ADDR OF "DRIVE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE /A030 JMP TSCTD3 / /A030 TSCTD2, TAD (TSDEV) / ADDR OF "DRIVE/DEVICE /A030 DCA NWSTR / INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE /A030 TSCTD3, TAD (DERDS1) / ADDR OF "DISKETTE IN DRIVE /A030 DCA TSSTRA / INTO LIST /A030 TSCKEX, JMP I TOSCKW / RETURN /A030 TSOPTN, 0000 / OPTION WORD /A030 /**************************************************************************** / / END OF MOVED CODE /M031 / /**************************************************************************** CHARIN, 0 RDFLAG, 0 TOEFLG, 0 /d031 CHR2VT, ZBLOCK 1 / 7-BIT ASCII FOR OUTPUT TO THE SCREEN /d031 0 / [0] TERMINATOR FOR 'ASTRING' / 6-BIT TEXT STRING COMPARISON SUBROUTINE / JMS TXTCOM; MTEXT; ERROR RETURN; OK RETURN /THE ORDER OF CHAR COMPARS FROM THE 'TEXT' STRING IS: CX(1ST) CY(2ND) / TXTCOM, 0 AC7777 TAD I TXTCOM /ADDR-1 BECAUSE OF 'ISZ' THEN 'TAD I' ISZ TXTCOM / GET THE ADDRESS OF THE 'M'TEXT DCA TXTADR /SAVE THAT ADDRESS TSC1, AC7776 / -2 DCA COUNT /TWO 'TEXT' CHARACTERS PER 12-BIT WORD ISZ TXTADR / / NOTE THAT THE (AC) = 0 HERE NATURALLY / TSC2, TAD I TXTADR /GET TWO 'TEXT' CHARACTERS: CX CY ISZ COUNT BSW /AC LOOKS LIKE: CY CX AND (37) /KEEP ONE SNA JMP EXIT DCA T1 / AND TEMP (T1) SAVE IT JMS RD1CHR /READ 1 CHARACTER FROM THE SORT SPEC DOC JMP I TXTCOM / ** ERROR ** IF NO CHARACTERS REMAIN AND (37) / MAKE CHAR FROM SPEC DOC LOWER CASE CIA /THEN NEGATE IT FOR A COMP LATER DCA THCHAR /STORE THE NEGATED CHARACTER FROM SPEC DOC TAD THCHAR /GET IT BACK IN AC TAD T1 /GET BACK NEGATED CHAR VALUE FROM MTEXT SZA CLA /ARE THEY EQUAL? JMP I TXTCOM /NO ERROR RETURN TAD COUNT /YES CONTINUE COMPARE SNA CLA JMP TSC1 /TO RESET THE 'COUNT' JMP TSC2 /TO GET THE OTHER CHARACTER FROM THE TXTADR EXIT, ISZ TXTCOM /INCREMENT FOR NON ERROR RETURN JMP I TXTCOM /RETURN /D026 IFDEF WS102 < / INPUT, CDFMYF /MAKE SURE DATA FIELD IS SET TO MINE A008 CIFMNU /CHANGE INSTRUCTION FIELD TO MINE A008 JMS I INACAL /READ INPUT A008 INBUF /BUFFER TO HOLD KEYBOARD INPUT A008 JMP GLDKY /PROCESS GOLD KEY INPUT A008 JMS RBELL /NOT GOLD KEY RING BELL A008 JMP INPUT /READ INPUT AGAIN A008 GLDKY, JMS GMTST /TEST AND HANDLE GOLD KEY A008 JMP CUSR1 /GOLD M SO EXIT A008 JMS RBELL /GOLD GARBAGE RING BELL A008 JMS ORGOLD /DISPLAY PRESS GOLD M A008 NARG /DO NOT DISPLAY OR A008 JMP INPUT /READ INPUT AGAIN A008 RBELL, XX CIFMNU JMS I IOACAL 0 ASTRING BELTXT JMP I RBELL /D026 > / END IFDEF WS102 /d031 DEADKEY,0 TXTADR, 0 COUNT, -2 THCHAR, 0000 THRHRD, 0300 / CALLED WITH POSITION OF CURSOR IN AC ERASE, XX DCA CRPOS / STORE POSITION FOR CURSOR CIFMNU JMS I IOACAL 0 PSCR / STRING TO ERASE SCREEN AND POSITION CURSOR CRPOS, 0000 / CURSOR POSITION PASSED IN AC FROM CALLER JMP I ERASE / RETURN PRETURN,XX / DISPLAYS 'and press return CIFMNU JMS I IOACAL 0 PRTRN 2305 JMP I PRETURN PAGE PAGE CUSRDN, ZBLOCK STRLEN /RESULT DOCUMENT NAME CUSSDN, ZBLOCK STRLEN /SPEC DOCUMENT NAME CUSLDN, ZBLOCK STRLEN /LIST DOCUMENT NAME SRT, IFDEF ENGLSH < TEXT '^P--&S&O&R&T--' > IFDEF ITALIAN < TEXT /^P--!&ORDINAMENTO--/ > IFDEF V30NOR < TEXT '^P--!&SORTERING--'> IFDEF V30SWE < TEXT '^P--!&SORTERING--'> IFDEF DUTCH < TEXT '^P-- &SORTEREN --'> IFDEF SPANISH < TEXT '^P-!&CLASIFICAR--'> SPRMPT, IFDEF ENGLSH < TEXT '^P&TYPE THE NAME OF THE ^P^S' > IFDEF ITALIAN < TEXT /^P&INTRODURRE IL DOCUMENTO ^P^S/ > IFDEF V30NOR < TEXT '^P&SKRIV NAVNET P\E ^P^S'> IFDEF V30SWE < TEXT '^P&SKRIV NAMNET P\E ^P^S'> IFDEF DUTCH < TEXT '^P&TYPE DE NAAM VAN ^P^S'> IFDEF SPANISH < TEXT '^P&TECLEE EL NOMBRE DE ^P^S'> GSPEC, IFDEF ENGLSH < TEXT 'SORT SPECIFICATION DOCUMENT.' > IFDEF ITALIAN < TEXT /DI SPECIFICA ORDINAMENTO./ > IFDEF V30NOR < TEXT 'SORTERINGSPESIFIKASJONEN.'> IFDEF V30SWE < TEXT 'URVALSDOKUMENTET'> IFDEF DUTCH < TEXT 'DE SORTEERSPECIFICATIE'> IFDEF SPANISH < TEXT 'DOC. DE CLASIFICACI\SN DE ESPECIFICACI\SN.'> GLST, IFDEF ENGLSH < TEXT 'INPUT DOCUMENT YOU WANT TO SORT.' > IFDEF ITALIAN < TEXT /LISTA DA ORDINARE./ > IFDEF V30NOR < TEXT 'DET DOKUMENTET DU VIL SORTERE'> IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET SOM DU VILL HA SORTERAT'> GRES, IFDEF ENGLSH < TEXT 'OUTPUT DOCUMENT THAT WILL RECEIVE' GRES2, TEXT '^PTHE SORTED COPY OF THE INPUT DOCUMENT.' > IFDEF ITALIAN < TEXT 'DI USCITA.'> IFDEF V30NOR < TEXT 'DET DOKUMENTET DEN SORTERE' /M008 GRES2, /M008 TEXT '^PKOPIEN SKAL LEGGES I.' /M008 > IFDEF V30SWE < TEXT 'SLUTDOKUMENTET SOM DU VILL HA SORTERAT' GRES2, TEXT 'DET SORTERADE REGISTERDOKUMENTET' > IFDEF DUTCH < TEXT 'HET DOCUMENT WAARIN HET RESULTAAT MOET KOMEN' GRES2, TEXT '' > IFDEF SPANISH < TEXT 'DOC. SALIDA QUE RECIBIR\A' GRES2, TEXT '^PLA COPIA CLASIFICADA DEL DOC. DE ENTRADA.'> DEXTS, IFDEF ENGLSH < TEXT '^P&DOCUMENT ALREADY EXISTS. ' *.-1 TEXT '^P&HOW WOULD YOU LIKE THE DOCUMENT MODIFIED?' *.-1 TEXT '^P&T = &ADD TEXT TO THE TOP ' *.-1 TEXT '^P&B = &ADD TEXT TO THE BOTTOM' /M021 *.-1 TEXT '^P&O = &OVERWRITE THE DOCUMENT' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO ESISTENTE. ' *.-1 TEXT '^P&MODALIT\@ DI MODIFICA: ' *.-1 TEXT /^P&I = &INSERIMENTO TESTO ALL'INIZIO / *.-1 TEXT '^P&F = &INSERIMENTO TESTO ALLA FINE ' /M021 *.-1 TEXT '^P&S = &SOVRASCRITTURA ' *.-1 TEXT /^P&SCEGLIERE UN'OPZIONE E &PREMERE !&RITORNO./ > IFDEF V30NOR < TEXT '^P&DOKUMENTET FINNES ALLEREDE.' *.-1 TEXT '^P&HVORDAN VIL DU ENDRE DOKUMENTET? ' *.-1 TEXT '^P&T = &TILF\XYE TEKST P\E TOPPEN ' *.-1 TEXT '^P&B = &TILF\XYE TEKST P\E BUNNEN ' /M021 *.-1 TEXT '^P&O = &OVERSKRIVE DOCUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.' > IFDEF V30SWE < TEXT '^P&DOKUMENTET FINNS REDAN ' *.-1 TEXT '^P&HUR VILL DU \DNDRA I DOKUMENTET? ' *.-1 TEXT '^P%B = &L\DGGA TILL TEXT I B\VRJAN ' *.-1 TEXT '^P%S = &L\DGGA TILL TEXT I SLUTET' /M021 *.-1 TEXT '^P%S%K = &SKRIVA \VVER DOKUMENTET' *.-1 TEXT '^P&TYPE THE LETTER AND &PRESS !&RETURN.' > IFDEF DUTCH < TEXT '^P&DOCUMENT BESTAAT AL. ' *.-1 TEXT '^P&HOE WILT U DIT DOCUMENT WIJZIGEN?' *.-1 TEXT '^P&B = &VOEG TEKST TOE AAN HET BEGIN' *.-1 TEXT '^P&E = &VOEG TEKST TOE ANN HET EINDE' /M021 *.-1 TEXT '^P&O = &OVERSCHRIJF HET DOCUMENT' *.-1 TEXT '^P&MAAK EEN KEUZE EN DRUK OP !&RETURN.' > IFDEF SPANISH < TEXT '^P&EL DOCUMENTO Y EXISTE. ' *.-1 TEXT '^P\?&C\SMO LE GUSTAR\MA MODIFICAR EL DOCUMENTO? ' *.-1 TEXT '^P&T = &A\QADIR TEXTO EN PARTE SUPERIOR ' *.-1 TEXT '^P&B = &A\QADIR TEXTO EN PARTE INFERIOR ' /M021 *.-1 TEXT '^P&O = &ESCRIBIR SOBRE EL DOCUMENTO' *.-1 TEXT '^P&TECLEE LA LETRA Y PULSE !&RETORNO.' > NDOC, IFDEF ENGLSH < TEXT '^P&^S ^D DOES NOT HAVE A DOCUMENT NAMED ^A.' /M030 > IFDEF ITALIAN < TEXT /^P&^S ^D NON HA IL DOCUMENTO ^A./ > IFDEF V30NOR < TEXT '^P&^S ^D HAR IKKE NOE DOKUMENT KALT ^A.' /M030 > IFDEF V30SWE < TEXT '^P&^S ^D HAR INGET DOKUMENT SOM HETER ^A'> IFDEF DUTCH < TEXT '^P&^S ^D BEVAT GEEN DOCUMENT GENAAMD ^A.'> IFDEF SPANISH TRYAGN, /m023 IFDEF ENGLSH < / -------------------------------------------- /m023 TEXT '^P&WHEN TYPING TO THE MENU, USE THE NORMAL KEYS ON THE KEYBOARD ONLY. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&THE &RUBOUT KEY' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' CAN ALSO BE USED. &A LINE MAY CONTAIN A MAXIMUM ' /M024 *.-1 TEXT '^POF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N. ' *.-1 TEXT '^P&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.' > /Amdh / end ifdef ENGLSH -------------------------------------------------- IFDEF ITALIAN < TEXT'^P&PER SCEGLIERE LE OPZIONI DEL MENU UTILIZZARE SOLO I TASTI ALFANUMERICI ' *.-1 IFDEF CONDOR < /A024 TEXT '^P&E SE NECESSARIO IL TASTO' /M024 > / END IFDEF CONDOR /A024 IFNDEF CONDOR < /A024 TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D' /A024 > / END IFNDEF CONDOR /A024 *.-1 TEXT ' !A&X]. &UNA RIGA PU\R CONTENERE AL' /M024 /Mmdh *.-1 TEXT '^PMASSIMO 71 CARATTERI E DEVE TERMINARE CON !&RITORNO. ' *.-1 TEXT '^P&PREMERE !&RITORNO PER CONTINUARE.' 74;0 /amdh > IFDEF V30NOR < / -------------------------------------------- /m023 TEXT '^P&BRUK BARE TASTENE P\E HOVEDTASTATURET N\ER DU SKRIVER EN KOMMANDO. ' *.-1 IFDEF CONDOR < /A024 TEXT '^P!&SLETT-TASTEN' /M024 > / END IFDEF CONDOR /A024 *.-1 TEXT ' KAN OGS\E BRUKES. &EN LINJE KAN HA MAKS. ' /M024 *.-1 TEXT '^P71 TEGN OG M\E AVSLUTTES MED !&RETUR. ' *.-1 TEXT '^P&TRYKK P\E !&RETUR OG PR\XV IGJEN.' > /Amdh IFDEF V30SWE < TEXT '^P&ANV\DND BARA "VANLIGA" TANGENTER N\DR DU SKRIVER I MENYN ' *.-1 TEXT '^P!&BACKSTEG' *.-1 TEXT ' KAN OCKS\E ANV\DNDAS. &EN RAD F\ER BEST\E AV MAXIMALT' *.-1 TEXT '^P71 TCKEN OCH M\ESTE AVSLUTAS MED !&RETUR' *.-1 TEXT '^P&TRYCK P\E !&RETUR OCH F\VRS\VK IGEN' > IFDEF DUTCH < TEXT '^P&GEBRUIK ALLEEN DE TOETSEN OP HET HOOFDTOETSENBORD. ' *.-1 TEXT '^P&U KUNT DE TOETS X&] GEBRUIKEN OM TEKENS TE WISSEN.' *.-1 TEXT 'EEN REGEL MAG 71 TEKENS BEVATTEN GEVOLGD DOOR !&RETURN. ' *.-1 TEXT '^P' *.-1 TEXT '^P&DRUK OP !&RETURN PROBEER OPNIEUW.' > IFDEF SPANISH < TEXT '^P&CUANDO TECLEE EN EL MEN\Z, USE S\SLO LAS TECLAS DEL TECLADO NORMAL.' *.-1 TEXT '^P&LA TECLA &CORRECTORA TAMBI\IN SE PUEDE USAR. &UNA L\MNEA PUEDE ' *.-1 TEXT 'CONTENER UN M\AXIMO DE ^P71 CARACTERES Y HA DE TERMINAR CON !&RETORNO' > SRLCKER, IFDEF ENGLSH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS ALREADY IN USE.' > IFDEF ITALIAN < TEXT /^P^A&DOCUMENTO (!D.!D)^A GI\@ IN USO./ > IFDEF V30NOR < TEXT '^P^A&DOKUMENT (!D.!D)^A FINNES ALLEREDE.' > IFDEF V30SWE < TEXT '^P^A&DOKUMENT (!D.!D)^A ANV\DNDS REDAN'> IFDEF DUTCH < TEXT '^P^A&DOCUMENT (!D.!D)^A IS AL IN GEBRUIK.' > IFDEF SPANISH < TEXT '^P^A&EL DOCUMENTO (!D.!D)^A YA EST\A EN USO.'> TARTN, IFDEF ENGLSH < TEXT '^P&PRESS &R&E&T&U&R&N TO TRY ANOTHER NAME.' > IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO, USARE UN ALTRO NOME.'> IFDEF V30NOR < TEXT '^PTRYKK P\E !&RETUR OG ANGI ET ANNET NAVN.'> IFDEF V30SWE < TEXT '^PTRYCK P\E !&RETUR OCH SKRIV ETT ANNAT NAMN' > IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN EN PROBEER OPNIEUW'> IFDEF SPANISH < TEXT '^P&PULSE !&RETORNO PARA INTENTAR OTRO NOMBRE.'> CNTCRE, IFDEF ENGLSH < TEXT '^P&UNABLE TO CREATE DOCUMENT.' > IFDEF ITALIAN < TEXT '^P&IMPOSSIBILE CREARE DOCUMENTO.' > IFDEF V30NOR < TEXT '^PKAN IKKE OPPRETTE DOKUMENT.' > IFDEF V30SWE < TEXT '^PDET G\ER INTE ATT SKAPA DOKUMENT.'> IFDEF DUTCH < TEXT '^P&KAN DOCUMENT NIET AANMAKEN.'> IFDEF SPANISH < TEXT '^P&IMPOSIBLE CREAR EL DOCUMENTO.'> WNUM, IFDEF ENGLSH < TEXT '^P&DOCUMENT NUMBERS MUST BE FROM 1 TO 200.' > IFDEF ITALIAN < TEXT '^P&NUMERI DOCUMENTO DEVONO ESSERE DA 1 A 200.' > IFDEF V30NOR < TEXT '^PDOKUMENTNUMRENE G\ER FRA 1 TIL 200.'> IFDEF V30SWE < TEXT '^PDOKUMENTETS NUMMER M\ESTE VARA 1-200.' > IFDEF DUTCH < TEXT '^PDOCUMENTNUMMERS MOETEN LIGGEN TUSSEN 1 EN 200.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> NMDC, IFDEF ENGLSH < TEXT '^P&THERE ARE NO MORE DOCUMENTS AVAILABLE.' > IFDEF ITALIAN < TEXT '^P&NON CI SONO DOCUMENTI DISPONIBILI.' > IFDEF V30NOR < TEXT '^P&INGEN LEDIGE DOKUMENTER.' > IFDEF V30SWE < TEXT '^P&DET FINNS INGA FLER DOKUMENT.' > IFDEF DUTCH < TEXT '^P&MAXIMALE AANTAL DOCUMENTEN BEREIKT.'> IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'> CNRG, TEXT '^P ' TYPGO, IFDEF ENGLSH < TEXT '^P&TYPE !&GO TO BEGIN &SORT' /M021 > IFDEF ITALIAN < TEXT '^P&INTRODURRE &E PER INIZIARE &ORDINAMENTO' /M021 > IFDEF V30NOR < TEXT '^P&SKRIV !&ST FOR \E SORTERE DOKUMENTET.' /M021 > IFDEF V30SWE < TEXT '^P&SKRIV !&OK F\VR ATT B\VRJA SORTERA.' /M021 > IFDEF DUTCH < TEXT '^P&TYP !&SV OM MET SORTEREN.'> IFDEF SPANISH < TEXT '^P&TECLEE &G&O PARA COMENZAR A &CLASIFICAR'> NMEAN, /m0018 IFDEF ENGLSH < TEXT '^P &TYPING "^A" HAS NO MEANING HERE. &PRESS &R&E&T&U&R&N AND TRY AGAIN.' /M011 > IFDEF ITALIAN < TEXT '^P &OPZIONE NON VALIDA.' /M011 > IFDEF V30NOR < TEXT '^P "^A" KAN IKKE BRUKES HER. &TRYKK P\E !&RETUR OG PR\XV IGJEN.' /M011 > IFDEF V30SWE < TEXT '^P "^A" BETYDER INGENTING H\DR.&TRYCK P\E !&RETUR OCH F\VRS\VK IGJEN.' /M011 > IFDEF DUTCH < TEXT '^P &"^A" HEEFT HIER GEEN BETEKENIS. &DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P &"^A" IS INCORRECTO. &PULSE !&RETORNO E INT\INTELO OTRA VEZ.'> PRTRN, IFDEF ENGLSH < TEXT '^P&AND &PRESS &R&E&T&U&R&N.' >/M008 IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO.' >/M008 IFDEF V30NOR < TEXT '^POG TRYKK P\E !&RETUR.' >/M008 IFDEF V30SWE < TEXT '^POCH TRYCK P\E !&RETUR.' >/M008 IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN.'> IFDEF SPANISH < TEXT '^P&Y PULSE !&RETORNO.'> DOGM, IFDEF ENGLSH < TEXT '^P^A&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' >/M008 IFDEF ITALIAN < TEXT '^P^A&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE.' >/M008 IFDEF V30NOR < TEXT '^P^A&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.' >/M008 IFDEF V30SWE < TEXT '^P^A&TILLBAKA TILL HUVUDMENYN: AND\DND !&GULD !&MENY.' >/M008 IFDEF DUTCH < TEXT '^P^A&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.'> IFDEF SPANISH < TEXT '^P^A&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'> ORAR, IFDEF ENGLSH < "O-200;"R-200;40;0 > IFDEF ITALIAN < 0 > IFDEF V30NOR < "E-200; "L-200; ".-200;40;0> IFDEF V30SWE < "E-200; "L-200; ".-100;40;0> NARG, IFNDEF DUTCH < 0 > IFDEF DUTCH < 40;0 > AARG, IFDEF ENGLSH < "A-200;"N-200;"D-200;40;0 > IFDEF ITALIAN < "E-200;40;0 > IFDEF V30NOR < "O-200;"G-200;40;0> IFDEF V30SWE < "O-200;"C-200;"H-200;40;0> IFDEF DUTCH <40;0> IFDEF SPANISH < "Y-200;40;0> RSYS, IFDEF ENGLSH < TEXT '^P^A&REPLACE THE SYSTEM DISKETTE IN DRIVE 0' > IFDEF ITALIAN < TEXT /^P^A&INSERIRE IL DISCO SISTEMA NELL'UNIT\@ 0/ > IFDEF V30NOR < TEXT '^P^A&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0' > IFDEF V30SWE < TEXT '^P^A&S\DTT TILLBAKA SYSTEMDISKETTEN I ENHET 0' > IFDEF DUTCH < TEXT '^P^AZET DE SYSTEEMDISKETTE IN AANDRIJVER 0'> IFDEF SPANISH < TEXT '^P^AREPLACE THE DISKETTE IN UNIDAD 0'> CUSR1A, IFDEF ENGLSH < TEXT '^P&INPUT DOCUMENT: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&USING SORT SPECIFICATION DOCUMENT: (^D.^D) ^A' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&THE SORTED DOCUMENT WILL BE STORED IN: (^D.^D) ^A' *.-1 TEXT '^P&!D &KEY &SORT' > IFDEF ITALIAN < TEXT '^P&DOCUMENTO LISTA: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DOCUMENTO DI SPECIFICA ORDINAMENTO: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&DOCUMENTO USCITA: (^D.^D) ^A ' *.-1 TEXT '^P&!D &CHIAVI &ORDINAMENTO' > IFDEF V30NOR < TEXT '^P&DOKUMENT SOM SKAL SORTERES: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&BRUKER SORTERINGSSPESIFIKASJON: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&SORTERT KOPI LAGRES I: (^D.^D) ^A' *.-1 TEXT '^P&!D SORTERINGSN\XKLER' > IFDEF V30SWE < TEXT '^P&DU ANV\DNDER REGISTERDOKUMENT (^D.^D) ^A ' /M008 *.-1 TEXT '^P&URVALSDOKUMENTET \DR (^D.^D) ^A' *.-1 TEXT '^P&DET SORTERADE REG (SLUTDOKUMENTET) \DR: (^D.^D) ^A ' *.-1 /THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL TEXT '^P&!D SORTERINGSNYCKEL' > IFDEF DUTCH < TEXT '^P&HET TE SORTEREN BESTAND IS: (^D.^D) ^A ' /M008 *.-1 TEXT '^P&DE SORTEERSPECIFICTIE IS: (^D.^D) ^A' *.-1 TEXT '^P&HET RESULTAT KOMT IN DOCUMENT: (^D.^D) ^A' *.-1 TEXT '^P&ER WORDT GESORTEERD OP !D VELD(EN).' > IFDEF SPANISH < TEXT '^P&DOCUMENTO DE ENTRADA: (^D.^D) ^A ' *.-1 TEXT '^P&USANDO DOCUMENTO ESPECIFICACI\SN CLASIFICACI\SN:^A ' /M008 *.-1 TEXT '^P&EL DOC. CLASIFICADO SE ALMACENAR\A EN: (^D.^D) ^A' *.-1 TEXT '^P&!D &CLAVE &CLASIFICACI\SN' > TSMALL, IFDEF ENGLSH < TEXT '^P!E&THERE IS NOT ENOUGH ROOM ON THE ^S !D ' /A030 *.-1 TEXT '^PFOR THE SORTED DOCUMENT.' >/M008 IFDEF ITALIAN < TEXT /^P!E&SPAZIO INSUFFICIENTE SULL'^S !D / /A030 *.-1 TEXT '^P' >/M008 IFDEF V30NOR < TEXT '^P!E&IKKE NOK PLASS P\E ^S !D ' /A030 *.-1 TEXT '^PTIL DET SORTERE DOKUMENTET.' >/M008 IFDEF V30SWE < TEXT '^P!E&DET FINNS INTE TILLR\CKLIGT MED ^S !D ' /A030 *.-1 TEXT '^PF\VR DET SORTERADE DOKUMENTET.' >/M008 IFDEF DUTCH < TEXT '^P!E&ONVLDOENDE RUIMTE OP ^S !D VOOR HET RESULTAAT. ^P' > IFDEF SPANISH < TEXT '^P!E&NO HAY SUFICIENTE ESPACIO EN EL ^S !D' *.-1 TEXT '^PPARA EL DOCUMENTO CLASIFICADO.' > NWDRV, IFDEF ENGLSH < TEXT '^P&SPECIFY ANOTHER ^S.' /M030/M021 > IFDEF ITALIAN < TEXT /^P&SPECIFICARE UN'ALTRA ^S./ /M030/M021 > IFDEF V30NOR < TEXT '^P&ANGI EN ANNEN ^S.'> IFDEF V30SWE < TEXT '^P&V\DLJ ANNAN ^S.'> IFDEF DUTCH < TEXT '^P&GEBRUIK EEN ^S MET MEER RUIMTE.'> IFDEF SPANISH < TEXT '^P&ESPECIFIQUE OTRO ^S.'> PTRBUS, IFDEF ENGLISH < TEXT '^P&THERE ARE DOCUMENTS PRINTING > IFDEF ITALIAN < TEXT '^P&CI SONO DOCUMENTI IN STAMPA.' > IFDEF V30NOR < TEXT '^P&UTSKRIVING AV DOKUMENTER P\EG\ER.' > IFDEF V30SWE < TEXT '^P&UTSKRIFT P\EG\ER JUST NU.' > IFDEF DUTCH < TEXT '^P&DE PRINTER IS IN GEBRUIK.'> IFDEF SPANISH DERR, IFDEF ENGLSH < TEXT '^P&THE ^S !D IS NOT A VALID DOCUMENT ^S.' /M030 *.-1 TEXT '^P&USE ANOTHER DOCUMENT ^S.' /M030 > IFDEF ITALIAN < TEXT /^P&^S !D NON \H UN VALIDO ^S. / /M030 *.-1 TEXT '^P&USARE UN ALTRO ^S.' /M030 > IFDEF V30NOR < TEXT '^P&^S !D ER IKKE EN GYLDIG DOKUMENT^S.' /M030 *.-1 TEXT '^P&BRUK EN ANNAN DOKUMENT^S.' /M030 > IFDEF V30SWE < TEXT '^P&^S !D \DR INTE ETT DOKUMENT SOM G\ER ATT ANV\DNDA^S.' /M030 *.-1 TEXT '^P&ANV\DND ETT ANNAT DOKUMENT ^S.' /M030 > IFDEF DUTCH < TEXT '^P&DE ^S !D IS GEEN DOCUMENT ^S.' /M030 *.-1 TEXT '^P&GEBRUIK EEN DOCUMENT ^S.' /M030 > IFDEF SPANISH < TEXT '^P&^P&EL ^S !D NO ES UN DOCUMENTO V\ALIDO ^S. ' /M030 *.-1 TEXT '^P&USE OTRO DOCUMENTO ^S.' /M030 > RPLACE, IFDEF ENGLSH < TEXT '^P&REPLACE THE DISKETTE WITH AN EMPTY DOCUMENT DISKETTE ' *.-1 TEXT '^POR ONE WITH MORE AVAILABLE SPACE.' > /M008 IFDEF ITALIAN < TEXT '^P&UTILIZZARE UN ALTRO DISCHETTO.^P' > /M008 IFDEF V30NOR < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF V30SWE < TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET' *.-1 TEXT '^PSORTERTE DOKUMENTET.' > /M008 IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE DOOR EEN LEGE DOCUMENTDISKETTE ' *.-1 TEXT '^P OF EEN MET MEER RUIMTE.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DOCUMENTO Y C\AMIELO POR UN DISKETTE HAY ' *.-1 TEXT '^P M\AS ESPACIO'> RMOVE0, IFDEF ENGLSH < TEXT '^P&REMOVE THE DISKETTE IN DRIVE 0.' *.-1 TEXT'^P&REPLACE IT WITH A DOCUMENT DISKETTE TO ACCOMMODATE THE SORTED DOCUMENT.' > IFDEF ITALIAN < TEXT /^P&TOGLIERE IL DISCHETTO DALL'UNIT\@ 0 / *.-1 TEXT'^PE SOSTITUIRLO CON UN ALTRO.' > IFDEF V30NOR < TEXT '^P&FJERN DISKETTEN I STASJON 0 .' *.-1 TEXT '^P&ERSTATT DEN MED EN DOKUMENTDISKETT SOM HAR PLASS TIL DET SORTERTE' *.-1 TEXT ' DOKUMENTET' > IFDEF V30SWE < TEXT '^PTA UT DISKETTEN I ENHET 0 . ' *.-1 TEXT '^P&ERSTATT DEN MED DOK.DISKETT SOM KAN TA EMOT DET SORTERADE DOKUMENTET' > IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE IN AANDRIJVER 0.' *.-1 TEXT'^PDOOR DE DISKETTE WAAROP HET RESULTAAT MOET KOMEN.' > IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DEL LA UNIDAD 0.' *.-1 TEXT '^PC\AMIELO POR UN DISKETTE DOC. PARA ACOMODAR EL DOC. CALSIFICADO'> / NOTE THAT A DOES NOT EXIST BETWEEN THE WORDS 'SORT' AND 'ON' / BECAUSE THE SUBROUTINE ( 'RD1CHR' ) WHICH GETS A CHARACTER / FROM THE SPECIFICATION DOCUMENT IGNORES IF ENTERED WITH THE AC=0 / / THEREFORE THE SUBROUTINE 'TXTCOM' WHICH COMPARES TWO CHARACTERS / ( ONE OF WHICH IS A CHARACTER FROM THE SPEC DOC) - IGNORES / IFDEF ENGLSH < MSORTON, TEXT 'SORTON' / USED BY 'TXTCOM' MINA, TEXT 'INA' /USED BY TXTCOM ME, TEXT 'E' /USED BY TXTCOM MSCENDING, TEXT 'SCENDING' /USED BY TXTCOM MORDER, TEXT 'ORDER' /USED BY TXTCOM MAND, TEXT 'AND' /USED BY TXTCOM /A007 > IFDEF ITALIAN < MSORTON, TEXT 'ORDINAMENTODI' / USED BY 'TXTCOM' MINA, TEXT 'INORDINEC' /USED BY TXTCOM ME, TEXT 'EC' /USED BY TXTCOM MSCENDING, TEXT 'RESCENTE' /USED BY TXTCOM MORDER, TEXT '' /USED BY TXTCOM MAND, TEXT 'E' /USED BY TXTCOM /A007 > IFDEF V30NOR < MSORTON, TEXT 'SORTERETTER' MINA, TEXT 'ISTIG' ME, TEXT 'NK' MSCENDING, TEXT 'ENDE' MORDER, TEXT 'REKKEFOLGE' MAND, TEXT 'OG' > IFDEF V30SWE < MSORTON, TEXT 'SORTERAEFTER' MINA, TEXT 'ISTIG' ME, TEXT 'ALL' MSCENDING, TEXT 'ANDE' MORDER, TEXT 'ORDNING' MAND, TEXT 'OCH' > IFDEF DUTCH < MSORTON, TEXT 'SORTEEROP' MINA, TEXT 'INOP' ME, TEXT 'F' MSCENDING, TEXT 'LOPENDE' MORDER, TEXT 'VOLGORDE' MAND, TEXT 'EN' > IFDEF SPANISH < MSORTON, TEXT 'CLASIFICARSEGUN' MINA, TEXT 'ENORDENA' ME, TEXT 'E' MSCENDING, TEXT 'SCENDENTE' MORDER, TEXT '' MAND, TEXT ',' > HC, /POSITION CURSOR TEXT '^P' /M008 PSCR, TEXT '^P!E' ASTRING, /POSITION THE CARET TEXT '^A' ACARET, LF;BACKSP;"^-200;CR;LF;0 ASDK, ESC;"(;"0&177 /TURN ON GRAPHICS MODE ESC;"0;"G-140 /DISPLAY DEAD KEY SEQUENCE ESC;"(;"B&177 /TURN OFF GRAPHICS MODE AGAIN 0 CRLF, CR;LF;0 MWHAT, IFDEF ENGLSH < TEXT '&E&R&R&O&R--SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.' > IFDEF ITALIAN < TEXT '!&ERRORE--SPECIFICA NON CORRETA DA QUESTO PUNTO.' > IFDEF V30NOR < TEXT '!&FEIL--FORST\ER IKKE SPESIFAKASJONEN FRA DETTE PUNKTET." > IFDEF V30SWE < TEXT '!&FEL - URVALSDOKUMENTET KAN INTE INLEDAS P\E DETTA S\DTT'> IFDEF DUTCH < TEXT '!&FOUT: &SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT'> IFDEF SPANISH < TEXT '!&ERROR--NO SE HA ENTENDIDO LA ESPECIFICACI\SN COMENZANDO EN ESTE PUNTO.'> IFDEF ENGLSH < FSERR, TEXT '^D FIELD NAMES HAVE BEEN SPECIFIED. &TEXT FOLLOWING THE' /M021 FSER2, TEXT 'LAST COMPLETE KEY FIELD SPECIFICATION WILL BE IGNORED.' /M021 PRCON, TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE.' /A007 > IFDEF ITALIAN < FSERR, TEXT '^D CAMPI NOME SPECIFICATI. &IL TESTO CHE SEGUE' /M021 FSER2, TEXT /L'ULTIMO CAMPO SPECIFICATO VIENE IGNORATO./ /M021 PRCON, TEXT '&PREMERE !&RITORNO PER CONTINUARE.' /A007 > IFDEF V30NOR < FSERR, TEXT '^D FELTNAVN ER SPESIFISERT. &DET VIL IKKE BLI TATT HENSYN' /M021 FSER2, TEXT 'TIL TEKST SOM ST\ER ETTER SISTE FULLSTENDIGE FELTSPESIFIKASJON.'/M021 PRCON, TEXT '&TRYKK P\E !&RETUR FOR \E FORTSETTE.' /A007 > IFDEF V30SWE < FSERR, TEXT '^D F\DLTNAMN HAR SPECIFICERATS.&TEXT SOM FINNS EFTER DEN' FSER2, TEXT 'SISTA FULLST\DNDIGA SORTERINGNYCKELN KOMMER INTE ATT BEHANDLAS.' PRCON, TEXT '&TRYCK P\E !&RETUR F\VR ATT FORTS\DTTA.'> IFDEF DUTCH < FSERR, TEXT '&E ZIJN ^D VELDNAMEN OPGEGEVEN. &TEKST NA DE LAATSTE' FSER2, TEXT 'VELDNAAMSPECIFICATIE ZAL WORDEN GENEGEERD.' PRCON, TEXT '&DRUK OP !&RERTURN OM VERDER TE GAAN.'> IFDEF SPANISH < FSERR, TEXT '&SE HAN ESPECIFICADO NOMBRESS DE CAMPO^D. &TEXTO QUE SIGUE HA' FSER2, TEXT '&SE IGNORAR\A LA \ZLTIMA ESPECIFICACI\SN DE CAMPO DE CLAVE CPMPLETA.' PRCON, TEXT '&PULSE !&RETORNO PARA CONTINUAR' > BELTXT, BELL;0 GOTXT, IFDEF ENGLSH < TEXT 'GO' > IFDEF ITALIAN < TEXT 'E' > IFDEF V30NOR < TEXT 'ST' > IFDEF V30SWE < TEXT 'OK' > IFDEF DUTCH < TEXT 'SV'> IFDEF SPANISH < TEXT 'GO'> SRDRV, /A030 IFDEF ENGLSH < TEXT 'DRIVE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'STASJON'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIJVER'> IFDEF SPANISH < TEXT 'UNIDAD'> SRDEV, /A030 IFDEF ENGLSH < TEXT 'DEVICE'> /A030 IFDEF ITALIAN < TEXT 'UNIT\@'> /A030 IFDEF V30NOR < TEXT 'ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJVER'> IFDEF SPANISH < TEXT 'DISPOSITIVO'> DERDS1, /A030 IFDEF ENGLSH < TEXT 'DISKETTE IN DRIVE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'DISKETTEN I STASJON'> IFDEF V30SWE < TEXT 'DISKETTEN I ENHET'> IFDEF DUTCH < TEXT 'DISKETTE IN AANDRIJVER'> IFDEF SPANISH< TEXT 'DISKETTE EN UNIDAD'> DERDS2, /A030 IFDEF ENGLSH < TEXT 'DISKETTE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT'> IFDEF V30SWE < TEXT 'DISKETTEN'> IFDEF DUTCH < TEXT 'DISKETTE'> IFDEF SPANISH DERVL1, /A030 IFDEF ENGLSH < TEXT 'VOLUME ON DEVICE'> /A030 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/ > /A030 IFDEF V30NOR < TEXT 'OMR\EDET P\E ENHET'> IFDEF V30SWE < TEXT 'VOLYMEN I ENHET'> IFDEF DUTCH < TEXT 'GEBIED OP AANDRIJVER'> IFDEF SPANISH < TEXT 'VOLUMEN EN DISPOSITIVO'> DERVL2, /A030 IFDEF ENGLSH < TEXT 'VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'OMR\DE'> IFDEF V30SWE < TEXT 'VOLYMEN'> IFDEF DUTCH < TEXT 'GEBIED'> IFDEF SPANISH < TEXT 'VOLUMEN'> DERDKV, /A030 IFDEF ENGLSH < TEXT 'DISKETTE/VOLUME'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'DISKETT/OMR\DE'> IFDEF V30SWE < TEXT 'DISKETTEN/VOLYMEN'> IFDEF DUTCH < TEXT 'DISKETTE/GEBIED'> IFDEF SPANISH< TEXT 'DISKETTE/VOLUMEN'> TSDEV, /A030 IFDEF ENGLSH < TEXT 'DRIVE/DEVICE'> /A030 IFDEF ITALIAN < TEXT 'SUPPORTO'> /A030 IFDEF V30NOR < TEXT 'STASJON/ENHET'> IFDEF V30SWE < TEXT 'ENHET'> IFDEF DUTCH < TEXT 'AANDRIVJER'> IFDEF SPANISH < TEXT 'UNIDAD/DISPOSITIVO'> /XSDFNBUFFER,ZBLOCK FNSIZE+1^MXFLD+1 /MXFLD 12(10) FNSIZE+1 31(10) D007 /CHAR BUFFER EACH KEY /SEPARATED BY [0]TERM /BUFFER ENDS WITH [-1] TERM /THE XSDFNBUFFER BUFFER WILL BE DEFINED IN THE SORT FIELD DUE TO SPACE /CONSTRAINTS IN EDIT FIELD CUB1, ZBLOCK 400 INBUF, -STRLEN ZBLOCK STRLEN+1 PAGE / WPSR.PA - 278 MULTI KEY SORT / **************** / * EDIT HISTORY * / **************** / / 025 EMcD 27-Sep-85 Add Dutch and Spanish Xlations (conditionalised) / 024 EMcD 14-Sep-85 Add Nordic Translations (conditionalised) / 023 EMcD 03-Sep-85 Fix bug induced by moving stuff in panel / memory. / 022 RCME 25-Jun-85 Fix bug in 021 which caused errors on MC's in / numeric fields. / 021 RCME 03-APR-85 Sort multinational and tech characters / Accept dead key characters in field names / / ---------------- All below refer to V2.0 and earlier ----------------------- / / 020 EJL 06-SEP-84 Allow pound sign for numeric data / 019 WCE 31-OCT-83 Change CHRCNT label to CHARCT for prefix change / 018 TCW 31-OCT-83 ADD TEXT "OUTPUT VOLUME FULL" FOR WINCHESTER / 017 WCE 17-AUG-83 Change HDRBUF label to HEADBF because of prefix / module definition of HDRBUF for WPFILS & EDIT / 017 HLP 29-AUG-83 Make Beep if don't hit Gold Menu / when done / 016 DFB 12-MAY-83 Change collating sequence / 015 MJS 24-MAR-83 BUG FIX - algorithm at "TSTOK" was ok / but the constant didn't allow / that the values of the addresses / were of active (valid) data / not empty locations / 014 MJS 11-JUN-82 BUG FIX - to 'JMP E13' from within / subroutine 'QUXEAL' if no more / blocks remain to be allocated / 013 MJS 16-FEB-82 BUG FIX - to execute 'GET DENSITY' (via QURX) / of system diskette at Gold MENU / within 'WAITM' before reading the / HOME block. / / added - Memory Reference Map / / changed - the 4 occurances of 'T2' within / the MERGE to 'PEIOFFSET' because / subroutine 'KEYSEARCH' uses 'T2' / (and would clobber the value left / by the MERGE) / / renamed - references to 'T2VAT' (used by / the MERGE) to 'INVVAT' / / renamed - references to 'OFFSET' (used by / the MERGE) to 'HEADER' / 012 JRF 14-JAN-82 Improve RANDR2 for handling double density / header blocks. Fix code for handling / justify bit in GETBNO and PUTBNO / 011 MJS 06-NOV-81 BUG FIX - numeric value fields are / now ordered algebraically / / AND - changed cdf's and cif's to be / absolute equates / / AND - MOVED THE 'XXSDFNBUFFER' FROM / FIELD 5 (THIS FIELD) TO FIELD / 4 (THE BUFFER FIELD) / 010 EH 22-OCT-81 BUG FIX - FLAGGING ILLEGAL CHARS / DURING SORT ON NUMERIC FIELDS / 009 MJS 16-OCT-81 BUG FIX - 2nd half of '0008' bug fix / 008 WCE 09-OCT-81 BUG FIX - GOLD HALT FOLLOWED BY GOLD / MENU (REQUIRING SYSTEM DISK TO BE / REPLACED) FOLLOWED BY RETURN / DESTROYED SYSTEM DISK. / 007 DIM 3-SEPT-81 Merge Dutch forin changes / 006 GDH 26-AUG-81 WPFILS calling seq changes. / 005 DSS 17-APR-81 Addition of accented character / handling code for foreign systems. / 004 JM 11-MAR-81 Added CANADIAN text / 003 JM 09-MAR-81 Added DUTCH text / 002 JM 06-MAR-81 Added FRENCH text / 001 JM 06-MAR-81 Replaced all instances of '<' and / '>' within text statements with their / octal values of 74 and 76 so as to / allow foreign conditionals / WTSORT.PA FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . / ...................................... / NOTE THAT THE 'CDF 20' WITHIN THE FOLLOWING LINE / DEFINES TO THE 'WRITE OUT TO THE FLOPPY CODE' / WHICH FIELD WITHIN [STERNO] THE EMEULATOR / CONTAINS THE PROGRAM TO BE WRITTEN OUT / 'WPCMND.PA' DEFINES THE (USER) FIELD / IN WHICH THE PROGRAM WILL EXECUTE / CONFUSING, ISN'T IT ? IFNDEF DECDEV < DLOSRT; 100; CDF 20; -DSOSRT > IFDEF DECDEV < DLOSRT; 100; CDF 50; -DSOSRT > / ...................................... 0 ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// WPSRSL.PA - MULTIKEY SORT SELECTOR \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / This memory reference map was added for the convenience of future /a0013 / developers requiring an overall view of system resource referencing /a0013 / FIELD 3 0000-5377 open / 5400-6377 Merge 'INBLOCK' / 6400-6777 Merge 'OUTBLOCK' / 7000-7377 Random Read II 'READ DATA BUFFER' / 7400-7777 Random Read II 'HEADER BLOCK BUFFER' / / FIELD 4 0000-3427 'XXSDFNBUFFER' / 3430-3577 open / 3600-4027 'FNBUFFER' / 4030-5777 open / 6000-7777 'SCROLL's BUFFERS / / FIELD 5 0000-7777 WPSR.PA executable code / / FIELD 6 0000-appro- / aching-7777 'FNVBUFFER' / / 7775-appro- / aching-0000 'FNVARBUFFER' / .............................................................................. / .............................................................................. / ................. .... / .... CAUTION .... THIS PROGRAM [ONLY] ASSEMBLES 'INTO' [STERNO::] FIELD 2 .... / .... CAUTION .... IT IS LOADED INTO [WP-278] FIELD 5 (USER FIELD 3) .......... / .... CAUTION .... AS DEFINED WITHIN 'WPCMND.PA' .............................. / ................. .... / .............................................................................. / .............................................................................. IFNDEF DECDEV < FIELD 2 > IFDEF DECDEV < FIELD 5 > / PROGRAM LOCATIONS: T1, T2 AND T3 ARE USED (AT TIMES) FOR MORE THAN / JUST LOCAL TEMPORARY STORAGE ----- BE CAREFUL ----- / ----------------------------------------------------------------- / -------- THE FOLLOWING IS ORDER IMPORTANT -------- / -------- AND REFERRED TO IN:: 'WPSRDF.PA' -------- / ----------------------------------------------------------------- *SOTFL / 20-77 ARE USED FOR COMMON SYSTEM CONSTANTS / (E.G. T1, T2, T3, P177, ETCETERA.) 0 / F-3 /SOTFL, - 'OUTPUT' DRIVE AND DOCUMENT NUMBER 0 / F-3 /SLSTFL, - 'LIST' DRIVE AND DOCUMENT NUMBER 0 / F-3 /ORDER, - SORT ORDER: XXX XXX XXX XXX 0 / F-3 /MMRETURN, - RETURN ADDRESS TO MAIN MENU XXSDFNBUFFER/ F-4 /SDFNBUFFER, - SPEC DOC KEY BUFFER ADDRESS SELECTOR/ F-5 /PARSELIST, - STARTING ADDRESS OF THIS PROGRAM 0 / F-3 /DSKID, - SYSTEM DISK ID: 0YY III III III 0 / F-3 /FTYPE, - FIELD TYPE (ALP-NUM): TTT TTT TTT TTT / ----------------------------------------------------------------- / -------- END OF ORDER IMPORTANT CODE -------- / ----------------------------------------------------------------- MKSVAT, ZBLOCK 1 / ADDRESS POINTING TO [VAT] WITHIN FNV TABLE / DEFINE THE cdf and cif INSTRUCTIONS ABSOLUTELY (to gain useable memory)/a0011 /a0011 CDFMNU= 6221 /a0011 CIFMNU= 6222 /a0011 CIFIOA= CIFMNU /a0011 CDFEDT= 6231 /a0011 CDFSDFN=6241 /a0011 CDFMYF= 6251 /a0011 CDFF06= 6261 /a0011 CDFFNV= CDFF06 /a0011 CDFFNB= CDFSDFN /a0021 PR3=6236 /A021 /D0011 USRFL0= -30 / USER FIELD 0 (PHYSICAL FIELD 2) A.K.A. 'MENU' FIELD /D0011 USRFL1= -20 / USER FIELD 1 (PHYSICAL FIELD 3) A.K.A. 'EDITOR' FIELD /D0011 /USRFL2= -10 / USER FIELD 2 (PHYSICAL FIELD 4) A.K.A. 'BUFFER' FIELD /D0011 USRFL3= 0 / USER FIELD 3 (PHYSICAL FIELD 5) /D0011 USRFL4= +10 / USER FIELD 4 (PHYSICAL FIELD 6) /D0011 /D0011 CDFMNU= JMS .; XX; JMS CDFCIF; USRFL0+CDF / CDF TO THE 'MENU' FIELD /D0011 CIFIOA=CIFMNU / DEFINED FOR CREF CONTINUITY /D0011 / /D0011 CIFMNU= JMS .; XX; JMS CDFCIF; USRFL0+CIF / CIF TO THE 'MENU' FIELD /D0011 CDFFNV=CDFF06 / DEFINED FOR CREF CONTINUITY /D0011 / /D0011 CDFEDT= JMS .; XX; JMS CDFCIF; USRFL1+CDF / CDF TO THE 'EDITOR' FIELD /D0011 CDFF06= JMS .; XX; JMS CDFCIF; USRFL4+CDF / CDF TO THE PHYSICAL FIELD #6 /D0011 CDFMYF= JMS .; XX; JMS CDFCIF; USRFL3+CDF / CDF TO THE FIELD OF THIS PROGRAM FNVBUFFER= 0 / STARTS AT ADDRESS 0 OF FIELD: USRFL4 FNVARBUFFER= 7775 / STARTS AT ADDRESS 7775 OF FIELD: USRFL4 / (NOTE THAT 'FNVARBUFFER' CAN BE 7774; 7773, ETC) / (BUT NEVER 7776, OR 7777 BECAUSE OF 'ISZ'S IN 'TSTSIZE') FNBUFFER= 4600 / Starts at address 4600 of field 4 KCCRECORD= 4704 / 2500 PRINTABLE CHARACTERS IS A 'LIST' RECORD SIZE KCCFNSIZE= FNSIZE / 30 PRINTABLE CHARACTERS IS A 'LIST' SIZE KCCVALUE= 74 / 60 CHAR'S WITHIN 'VALUE' FIELD (OVER 60 IGNORED) DCAFNV= JMS I .; XFNVPSH/ CROSS DATA FIELDS FOR 'DCA I FNV' THEN BACK DCAFNB= JMS I .; XFNBPSH/ Cross data fields for 'DCA I FN' then back /a021 TADFNB= JMS I .; XFNBGET/ Cross data fields for 'TAD I FN' then back /a021 SORTKEY, ZBLOCK 1 / NUMBER OF KEY S DEFINED WITHIN SPEC DOC KEYNO, ZBLOCK 1 / THE ABSOLUTE KEY # 'KKKK' FROM WITHIN 'FNKEYFOUND' LABFLG, ZBLOCK 1 / 0 MEANS NO < FOUND, XXX MEANS < FOUND RECNUM, ZBLOCK 1 / RECORD # BEING PARSED [1 TO 4095 TO 0 TO 4095 ETC.] KEYFNTOTAL, ZBLOCK 1 / TOTAL # OF RECORDS WITHIN THE LIST DOCUMENT / CONTAINING ALL THE KEY S / DEFINED WITHIN THE SPECIFICATION DOCUMENT SRBUGSWITCH, ZBLOCK 1 / NOT = 0 MEANS WE'RE IN ERROR TYPEOUT ROUTINE / HANDLE TEXT TO SCREEN APPROPRIATELY CCFNSIZE,-KCCFNSIZE-1 / CHARACTER COUNTER [FNSIZE=30] CCRECORD,-KCCRECORD-1 / RECORD CHARACTER COUNTER [KCCRECORD=2500] CCVALUE,-KCCVALUE-1 / 'VALUE' CHARACTER COUNTER SFTSPC, 2040 / Soft space value defined here to make room /a021 CHARIN, ZBLOCK 1 / 12-BIT CHARACTER FROM 'ZRDNXCH': MMMMMCCCCCCC CHR177, ZBLOCK 1 / 7-BIT CHARACTER FROM 'CHARIN': 00000CCCCCCC DEADKEY,ZBLOCK 1 / Flag inicating dead key processing status /a021 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / PROGRAM LOCATIONS: / T1RR, T2RR ARE RESERVED EXCLUSIVELY / FOR USE BY THE RANDOM READ UTILITY / THE RANDOM READ UTILITY IS A REWORKED VERSION OF RDFILP.PA / AND NO LONGER RESEMBLES RDFILP.PA THAT'S WHY IT'S NOT CALLED RDFILP / BUT IT WASN'T TOTALLY REWRITTEN / WHICH MEANS RDFILP USED PROGRAMM LOCATIONS: T1, T2 T1RR, ZBLOCK 1 T2RR, ZBLOCK 1 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / AUTO-INDEX REGISTER DEFINITIONS FNV= 15 / X5 / FNV, FNVBUFFER-1 / OF FIELD: USRFL4 FN= 14 / X4 / FN, FNBUFFER-1 SDFN= 13 / X3 / SDFN, SDFNBUFFER-1 / X2 / X1 / X0 FNVAR, FNVARBUFFER+1 / THEN: FNVARBUFFER, FNVARBUFFER-1, ETC. /----------------- PAGE / THE SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY BY A PREVIOUS PROGRAM / AND THE KEY TO SORT ON HAVE BEEN LOADED INTO THE SDFN BUFFER / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! PARSE THE LIST DOCUMENT !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / PARSE THE LIST DOCUMENT RECORD BY RECORD BY / LOOKING FOR KEY S TO 'SORT ON' / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT SELECTOR, JMS MRGSETUP / 'MERGE' AND 'ODG' MERGE RELATED PARAMATER SETUP JMS SRWORKING / OUTPUT TO THE SCREEN: 'WORKING' / INITIALIZE SOME FLAGS DCA FLAG40 AC7777 DCA GETFIF / COPY THE CONTENTS OF PROGRAM LOCATIONS: / SOTFL, SLSTFL, ORDER, MMRETURN, DSKID, AND FTYPE / from the EDITOR FIELD into the same named locations of THIS FIELD CDFEDT TAD I (SOTFL) DCA SOTFL TAD I (SLSTFL) DCA SLSTFL TAD I (ORDER) DCA ORDER TAD I (MMRETURN) DCA MMRETURN TAD I (DSKID) DCA DSKID TAD I (FTYPE) DCA FTYPE CDFMYF AC7777 /AC = -1 BECAUSE (SDFNBUFFER) IS THE TAD SDFNBUFFER / ADDRESS OF THE SDFN BUFFER ADDRESS DCA SDFN /\ JMP .+1 /LOOK OUT CAUSE WE DROPPED HERE FROM ABOVE / ....... ... .. ... ... . .. . . .. ... . .... .. . . . . . . . . . .. / .. .. .. .. ... ... . . ... . . . . . . . . ..... .. . .... . / . . .. ...... ..... ...... . . . . .. .... . . . . .. . .... . ... /. .. . ... . ... ...... . . .. . . . . . . . . . . . . . .. . . ... / THIS PROGRAM IS CODED SO THAT MULTI-KEY SORT [UP TO 12 KEYS] IS TRANSPARENT / [ ACHIEVEING THAT TRANSPARENCY IS BY SCANNING THE CONTENTS OF THE SDFN BUFFER ] / [ FOR THE TERMINATORS [0] AND [-1] ] DCA SORTKEY / START WITH (SORTKEY)=0, THEN: / TOTALING THE NUMBER OF TERMINATORS FOUND WITHIN THE SDFN BUFFER / RESULTS IN DEFINING [TO THIS PROGRAM] THE MAXIMUM KEY SORT [12 KEYS] TSTSDFN,JMS TADISDFN / POP A CHARACTER FROM THE SDFN BUFFER /m0011 SPA JMP TSTOK / [-1] SDFN BUFFER TERMINATOR DETECTED SZA CLA JMP TSTSDFN / FOR MORE POPS UNTIL A [-1] TERMINATOR ISZ SORTKEY / [0] KEY TERMINATOR FOUND /*E11 - MEANS THE VALUE WITHIN 'SORTKEY' / IS GREATER THAN THE VALUE THAT 'MAXKEY' IS EQUATED TO / [ 'MAXKEY' IS THE MAXIMUM NUMBER OF KEY S ] / [ ALLOWED BY THIS PROGRAM TO SORT ON ] TAD (-MAXKEY) / THE MAX # OF KEY PERMITTED TO SORT ON TAD SORTKEY / THE # OF KEY DEFINED IN SPEC DOC SMA SZA CLA / SKIP NEXT IF (SORTKEY) <= #MAXKEY JMP E11 / E 11 /*-MEANS SPEC DOC DEFINED TO MANY KEYS TO SORT ON JMP TSTSDFN / UNTIL [-1] TERMINATOR FOUND / THE ABSOLUTE NUMBER OF KEY / DEFINED WITHIN THE SPECIFICATION DOCUMENT / TO SORT ON IN ASCENDING OR DESCENDING ORDER / NOW RESIDES WITHIN PROGRAM LOCATION 'SORTKEY' TSTOK, CLA /CLA CAUSE ENTRY WITH (AC) = [-1] SDFN TERMINATOR TAD SLSTFL / 'LIST' DRIVE AND DOCUMENT NUMBER JMS RDINIT / % RANDRD INITIALIZATION DCA RECNUM / RECORD NUMBER [ INTERNAL ATTRIBUTE ] DCA KEYFNTOTAL / KEY TOTALATOR [0 MEANS NONE] / COMPUTE THE VOLUME OF 'SLUSH' / (THAT NO MANS LAND BETWEEN THE FNVAR TABLE AND FNV BUFFER) / FOR OPTIMUM DYNAMIC MEMORY UTILIZATION TAD SORTKEY / 1; 12(10) CIA DCA SLUSH / TEMP FOR COUNTING TAD (4+1+2+3)/ 4 / 0; 0; 0; 0 (merge), / +1 / [-1] FNVAR term, / +2 / algorithm /a015 / +3 / (insurance) /a015 TAD (KCCVALUE%2+4) / NUMBER OF SLOTS PER KEY WITHIN FNV BUFFER ISZ SLUSH JMP .-2 / UNTIL (SLUSH)=0 DCA SLUSH / THIS IS THE REAL 'SLUSH' NEXTPACKET, TAD (FNVBUFFER-1) / ADDRESS-1 OF VALUE BUFFER DCA FNV TAD (FNVARBUFFER+1) / ADDRESS+1 OF VALUE ADDRESS PER RECORD BUFFER DCA FNVAR / !!!!!!!! PARSE A RECORD WITHIN THE LIST DOCUMENT !!!!!!!! NEXTRECORD, TAD (KEY01FNTOTAL-1) DCA X0 TAD SORTKEY / # OF KEYS TO SORT ON DEFINED WITHIN SPEC DOC CIA / MAKE ITS NEGATIVE VALUE DCA T2 / [ T2 GETS 'ISZ'D TO ZERO ] / CLEAR PROGRAM LOCATIONS:: KEY01FNTOTAL THRU KEYNNFNTOTAL / PRIOR TO PROCESSING EACH RECORD OF THE LIST DOCUMENT DCA I X0 / CLEAR KEY01FNTOTAL, THEN KEY02..., THRU KEYNN... ISZ T2 JMP .-2 / UNTIL (T2)=0 AC7777 DCA I X0 / [-1] FLOATING TERM [MEANS END OF 'KEY--FN..' ADDRESSES TAD FNV JMS DCAVAR AC0003 /\ 'CLL' ALSO TAD FNV DCA HHH1ST / IF THE FNVAR BUFFER HAS FILLED UP / THEN SORT THE 'VALUE' FIELDS / SELECTED THUS FAR / AND COME BACK HERE WHEN THAT SORT IS DONE / CLL /\ FROM 'AC0003' ABOVE TAD FNV / THIS ADDRESS --INCREMENTS-- TAD SLUSH SZL JMP .+5 CLL CIA TAD FNVAR / THIS ADDRESS --DECREMENTS-- SZL CLA / SKIP NEXT IF FNV/FNVAR BUFFERS FULL JMP FNVARNOTFULL / THE FNVAR BUFFER IS NOT FULL NOT FULL AC7777 JMS DCAVAR JMS SPDPRS / DISPLAY ON SCREEN THE # OF RECORDS SELECTED JMS SORT / ORDER THE CONTENTS OF THE FNVAR TABLE JMS MERGE / COMBINE THE FNV BUFFER WITH ANY FNV PACKET JMP NEXTPACKET / SLUSH, ZBLOCK 1 FNVARNOTFULL, / .............................................................................. CIFSYS JSWAP / LET OTHER JOBS HAVE THE SPOT LIGHT / .............................................................................. TAD (-KCCRECORD-1) DCA CCRECORD / 2500 PRINTABLE CHARACTERS ALLOWED PER RECORD DCA BORFLAG / 'BOR' FLAG = 0 MEANS WAITING FOR FIRST < OF RECORD TAD RECNUM AND (7) SNA CLA JMS SRWORKING / OUTPUT THE TEXT: 'WORKING' JMP PARSE / SUBROUTNE TO OUTPUT TO THE SCREEN THE NUMBER OF RECORDS SELECTED / WHICH IS THE NUMBER OF RECORDS WITHIN THE LIST DOCUMENT / THAT CONTAINED THE KEY / DEFINED WITHIN THE SPEC DOC TO SORT ON / ALL TEXT OUTPUT:: WILL NOT BE ABOVE LINE #4, NOT BE ABOVE LINE #4 / SO NOT TO WRITE OVER THE INFORMATION LEFT THERE BY THE SPEC DOC PARSER SPDPRS, XX CIFIOA / -IOA- JMS I IOACAL 0 / MSUMMARY / CONTROL AND TEXT STRING 0605 / ^P - LINE / COLUMN KEYFNTOTAL / !D RECNUM / !D 1600 / ^P JMP I SPDPRS / EXIT PAGE PARSE, / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! PARSE A WITHIN THE CURRENT RECORD !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! NEXTFN, LABSDFN,MQL / (MQ) <= (AC) <= ZERO [OR MMMMM0111100]; THEN CLA TAD (-KCCFNSIZE-1) / SIZE DCA CCFNSIZE TAD (-KCCVALUE-1) / 'VALUE' FIELD SIZE DCA CCVALUE TAD (FNBUFFER-1) / ADDRESS-1 OF HOLDING BUFFER DCA FN CLA MQA / (AC) = (MQ) PARSFN, DCA LABFLG / 0 MEANS WAITING FOR LAB; XXX MEANS LAB FOUND UNTILAB, / UNTIL < LEFT ANGLE BRACKET UNTILRAB, / UNTIL > RIGHT ANGLE BRACKET NPCFN, AC0000 /AC FLAG = 0 JMS RD1FNCHAR / READ 1 12-BIT CHAR FROM LIST DOC JMP DISKEOF / ...LIST DOCUMENT DISK END OF FILE [NO MORE DATA] JMP .+3 / ...THE CHARACTER READ IS NON-PRINTING JMP LAB / ...THE CHARACTER READ IS A < LEFT ANGLE BRACKET JMP RAB / ...THE CHARACTER READ IS A > RIGHT ANGLE BRACKET / ... (AC) = THE CHARACTER READ / THE 12-BIT CONTENTS OF THE AC IS (PROBABLY) A CHAR OF THE / OR TEXT PRIOR TO THE FIRST '<' OF THE FIRST AND P177 / MAKE 7-BIT ASCII STRIPPING MODE BITS DCA T3 / ...PROBABLY PART OF THE ; TEMP SAVE IT / GET 'PARAMATERS' AT THE TIME THE FIRST 'REAL' CHARACTER FROM THE / LIST DOCUMENT IS DETECTED FOR USE IN THE 'ERROR' ROUTINE WHEN AN ERROR / IS DETECTED PRIOR TO THE FIRST LEFT '<' ANGLE BRACKET EVER. ISZ GETFIF / SKIP NEXT IF 1ST 'REAL' CHAR EVER FROM DOC JMP .+3 / 1ST CHAR 'PARAMATERS' ALREADY GOTTEN AC7777 JMS GETBNO / get block #, char. offset, header block offset DCA GETFIF / set flag = 0 (next time through don't GETBNO) /\ JMP .+1 / TEXT MAY PRECEED THE FIRST < OF THE FIRST / OF THE FIRST RECORD +++ONLY+++ [THE RECORD NUMBER MUST = 1] TAD LABFLG /WAS A < FOUND EARLIER ? SZA CLA / SKIP NEXT MEANS WAITING FOR A < JMP ISZCCFNSIZE / JMP WITH CHAR STILL IN T3 / ............................................................................. /*E2 - MEANS THERE IS TEXT (PRINTABLE CHARS.) BETWEEN RECORDS / OR THE OF RECORD # GREATER THAN 1 IS MISSING A < TAD T3 / IS IT A NONPRINTING CHARACTER? TAD (-41) SMA CLA / SKIP IF IT IS; WE DON'T CARE ABOUT NON- / PRINTING CHARACTERS BETWEEN RECORDS / (INCLUDING 'SPACES') TAD RECNUM / IF RECNUM > 0 - THIS TEXT IS BETWEEN RECORDS SZA CLA JMP E2 / E 2 /*E2 JMP UNTILAB / IGNORE ALL CHARACTERS UNTIL A < IS FOUND / ............................................................................. /*E4 - MEANS THE EXCEEDED 30 PRINTABLE CHARACTERS ISZCCFNSIZE, TAD DEADKEY / Check the dead key status /a017 SNA CLA / Is a dead key sequence current? /a017 ISZ CCFNSIZE / No, INCREMENT CHARACTER COUNT SKP JMP E4 / E 4 /*ERROR / ............................................................................. / THE CHARACTER +++IS+++ PART OF THE TAD T3 /GET BACK CHARACTER HELD IN T3 DCAFNB / SAVE IT IN THE HOLDING BUFFER JMP UNTILRAB / JMP TO GET ANOTHER CHAR OF THE UNTIL > GETFIF, 0 / GETFIrst character Flag 0 = get parameters / 1 = don't get parameters BORFLAG,0 /BEGINNING OF RECORD FLAG: / 0 MEANS WAITING FOR FIRST < OF THAT RECORD / 1 MEANS FOUND IT / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . / . . A LEFT ANGLE BRACKET MEANING THE START OF A WAS DETECTED . . / . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E3 - MEANS (LABFLG) NOT = 0 BECAUSE TWO < WERE FOUND BEFORE A > LAB, CLA /VECTORED WITH (AC)=CHAR FROM FNBUFFER TAD LABFLG / (LABFLG) = 0 IF THIS IS THE < OF THE SZA CLA / SKIP NEXT MEANS THIS < IS OK JMP E3 / E 3 /* CONTAINED AN EXTRA < / IF THIS < MEANS THE BEGINNING OF A RECORD (BOR) / NOT THE START OF A WITHIN THE RECORD / THEN GET THE BLOCK # WHERE THE < WAS FOUND / AND THE MODE BITS AT THE DETECTION OF THE < / AND THE CHARACTER OFFSET OF THE < WITHIN THAT BLOCK # / ELSE JUST PARSE THE / BECAUSE THIS IS NOT THE FIRST OF THE RECORD TAD BORFLAG /DOES THE < FOUND MEAN BOR OR JUST A ? SZA CLA / SKIP NEXT IF < MEANS BEGINNING OF RECORD JMP TAD1 / JMP MEANS IT'S JUST A '<' OF A ISZ BORFLAG / TICKLE BORFLG SO WE DON'T DO THIS FOR EVERY < / GET: 'BLOCK #', 'CHARACTER OFFSET OF LAB <' AND 'PERFORMANCE ATTRIBUTES' AC7777 JMS GETBNO DCA GETFIF / [0] TAD1, AC0001 / MEANS '<' FOUND JMP PARSFN / JMP TO PARSE THE WHOSE < WAS JUST FOUND / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . A RIGHT ANGLE BRACKET WAS FOUND WHILE EXPECTING CHAR'S OF THE . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / IF NO CHARACTERS WERE DETECTED AFTER THE < AND BEFORE THE > / THEN THIS > IS A LIST DOC EOR DELIMITER <> NOT A DELIMITER RAB, CLA /CLA BECAUSE VECTORED WITH (AC)=CHAR FROM FNBUFFER TAD CCFNSIZE / TEST THE NUMBER OF CHAR PARSED TAD (KCCFNSIZE+1) SZA CLA / SKIP NEXT MEANS THE > FOUND IS <> DELIMITER JMP TST4KEY / JMP MEANS DELIMITER > DETECTED /*E2 - MEANS > DETECTED BEFORE < TAD LABFLG SNA CLA JMP E2 / E 2 /* A > WAS FOUND BEFORE A < / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . A LIST DOCUMENT END OF RECORD DIAMOND <> HAS BEEN DETECTED . . . . . / . . . . WHILE EXPECTING CHARACTERS OF THE . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ISZ RECNUM /UPDATE TOTAL RECORDS PROCESSED [1 TO NNNN] SKP ISZ RECNUM / IF THIS RECORD CONTAINED ANY NON EXISTANT KEY S / THEN FLAG IT (THEM) AS SUCH / OTHERWISE THE KEY 'VALUE' FIELD / HAS BEEN PARSED [SEE 'TST4KEY'] / AND STORED WITHIN THE VALUE BUFFER 'FNVBUFFER' / (EVEN IF THE KEY WAS BLANK) TAD (KEY01FNTOTAL-1) DCA X0 TAD SORTKEY CIA DCA T3 / FOR COUNTING TAD I X0 / K 1 / PRIMARY KEY INDICATOR SNA CLA / SKIP NEXT IF PRIMARY KEY 'EXISTANT' JMP .+7 / PRIMARY KEY NON EXISTANT ISZ KEYFNTOTAL SKP ISZ KEYFNTOTAL JMP .+4 TAD I X0 SNA CLA JMS NOKEYFIELD ISZ T3 JMP .-4 /\ JMP .+1 / IF THE RECORD CROSSED BLOCK BOUNDRIES / THEN MODIFY THE 'PERFORMANCE' ATTRIBUTE (BIT 0(R) FROM 0 TO 1) / (WHICH WAS PREVIOUSLY PUSHED INTO THE FNV BUFFER) / (BUT WHOSE ADDRESS POINTER -- THE POSITION WITHIN THE FNVBUFFER) / (IS BEING HELD WITHIN PROGRAM LOCATION 'HHH1ST') JMS NEWHHH / --UPDATE-- 'PERFORMANCE' ATTRIBUTE / CLEAR THE 'MKSBIT' WITHIN THE 'VAT' MEANS END OF MKS (MULTI-KEY SORT) RECORD TAD (-MKSBIT-1) CDFFNV AND I MKSVAT / [VAT] DCA I MKSVAT / [VAT] CDFMYF JMP NEXTRECORD / JMP TO PARSE THE NEXT RECORD OF THE LIST DOCUMENT / ............................................................................. / THE KEY FOR THIS RECORD IS NON EXISTANT / ............................................................................. NOKEYFIELD, XX JMS PSH3V TAD (-KEY01FNTOTAL+1) TAD X0 TAD (4000+MKSBIT) DCAFNV JMP I NOKEYFIELD /a021 The following code moved here from RD1CHR page to make room /a021 /a021 for recognition of dead keys in field names. /a021 / get a character from the 'xxsdfnbuffer' (located in field 4) /a0011 /a0011 TADISDFN, XX / /a0011 CDFSDFN / CHANGE DATA FIELD TO FIELD #4 /a0011 TAD I SDFN / GET THE CHARACTER FROM THE 'XXSDFNBUFFER' /a0011 CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD /a0011 JMP I TADISDFN/ AND EXIT /a0011 /a021 -------------- End of moved code ----------------- /a021 PAGE / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE 'SDFNBUFFER' AND 'FNBUFFER' !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / ASCII REPRE- ASCII REPRE- / SENTATION OF SENTATION OF / KEY S A / DEFINED WITHIN USED WITHIN / THE SPEC DOC: THE LIST DOC: /SDFNBUFFER, F FNBUFFER, F / I I / E E / L L / D D / N N / A A / M M / E E / [0]: SORTKEY=1 [0] / F / . / . / [0]: SORTKEY=2 / . / [0]: SORTKEY=NN / [-1]: SDFN BUFFER TERMINATOR / A FROM THE LIST DOCUMENT AFTER BEING PARSED / IS HELD WITHIN THE BUFFER 'FNBUFFER' / THE KEY S TO SORT ON IN ASCENDING OR DESCENDING ORDER / AS DEFINED WITHIN THE SORT SPECIFICATION DOCUMENT / HAVE BEEN PARSED BEFORE ENTRY INTO THIS PROGRAM / AND RESIDE WITHIN THE SDFN BUFFER / IN THE ORDER IN WHICH THEY WERE DEFINED WITHIN THE SPEC DOC / A FROM THE LIST DOCUMENT [THE DOCUMENT TO BE SORTED] / HAS BEEN PARSED AND IS BEING HELD WITHIN THE 'FNBUFFER' / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! TEST FOR A KEY !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / IF THE USED IN THE LIST DOCUMENT / IS A KEY DEFINED BY THE SPEC DOC / THEN INPUT [VIA JMS RD1VALUECHAR] THE 'VALUE' / AND HOLD IT WITHIN THE VALUE BUFFER [FNVBUFFER] / ELSE IGNORE ALL CHARACTERS UNTIL THE NEXT LEFT ANGLE BRACKET TST4KEY,DCAFNB /[0] IS THE 'FNBUFFER' TERMINATOR AC7777 TAD SDFNBUFFER DCA SDFN TAD (KEY01FNTOTAL-1) DCA T1 TSTNEXTFN, ISZ T1 / POINTER TO: KEY01FNTOTAL, THEN KEY02..., THRU KEYNN... TAD (FNBUFFER-1) DCA FN TSTNUFNCHAR, JMS TADISDFN /POP A CHAR DEFINED WITHIN THE SPEC DOC /M0011 SZA / SKIP NEXT IF [0] SDFN BUFFER TERMINATOR JMP TSTSMA / JMP TO TEST FOR THE [-1] SDFN BUFFER TERMINATOR TADFNB /POP A CHAR USED WITHIN THE LIST DOC SZA CLA JMP TSTNEXTFN / [0] OF SDFN, [NN] OF FN JMP FNKEYFOUND / [0] OF SDFN, [0] OF FN MEANS THIS IS A KEY / THE CHARACTER JUST POPPED FROM THE SDFN BUFFER / IS +++NOT+++ THE [0] TERMINATOR / IT MAY BE A CHARACTER / OR IT MAY BE THE [-1] TERMINATOR TSTSMA, SMA /SKIP NEXT IF [-1] FROM SDFN JMP DOCIA / JMP TO DO A CIA CAUSE IT'S A CHAR / A CHARACTER OF THE DEFINED WITHIN THE SPEC DOC / DID +++NOT+++ COMPARE WITH A CHAR OF THE USED WITHIN THE LIST DOC / THEREFORE IGNORE ALL CHAR'S RELATED TO THAT 'VALUE' /*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <> NOTKEYFN, AC0000 JMS RD1FNCHAR /READ ONE 12-BIT CHARACTER FROM THE LIST DOCUMENT JMP E7 / E 7 / ... (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA] JMP .-3 / ...THE 'VALUE' CHARACTER IS NON-PRINTING [SO WHAT] JMP LABSDFN / ...THE 'VALUE' CHARACTER IS A < [START OF A ] JMP .-5 / ...THE 'VALUE' CHARACTER IS A > [NOT LOOKING FOR THAT] JMP .-6 / ...THE 'VALUE' CHARACTER IS PRINTABLE [WHO CARES] / THE CHARACTER POPPED FROM THE SDFN BUFFER / IS NOT THE [0] OR [-1] TERMINATORS / THEREFORE IT IS A CHARACTER OF THE DOCIA, CIA /NEGATE IT FOR COMPARISON LATER DCA T2 / TEMP SAVE TADFNB /POP A CHARACTER USED IN THE LIST DOC SNA JMP NEXTSDFN / [0] OF FN BUFFER, [NN] OF SFDN / MATCHED 1 CHARACTER [POPPED FROM THE SDFN BUFFER] / WITH 1 CHARACTER [POPPED FROM THE FN BUFFER] / THEREFORE COMPARE A NEW CHARACTER TAD T2 /2'S COMP ADD SDFN CHAR WITH CHAR SNA CLA JMP TSTNUFNCHAR / COMPARE A NEW CHARACTER / CHARACTERS DID NOT MATCH / MOVE DOWN TO THE NEXT [0] TERMINATOR WITHIN SDFN BUFFER / RESET TO THE TOP OF THE FN BUFFER NEXTSDFN, JMS TADISDFN / /m0011 SPA JMP NOTKEYFN / [-1] SDFN TERMINATOR FOUND, NOT A KEY SZA CLA JMP NEXTSDFN JMP TSTNEXTFN / [0] OF SDFN MEANS THIS IS >NOT< A KEY / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! THE FOLLOWING IS A PSEUDO IMAGE OF THE: !!!! / !!!! 'FNVBUFFER', AND 'FNVARBUFFER' BUFFERS. !!!! / !!!! !!!! / !!!! ---- NOTE THAT THEY OCCUPY THE SAME FIELD ---- !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / PACKED 6-BIT ASCII REPRESENTATION OF THE 'VALUE' FIELD / FOR THE KEY FOUND IN THE LIST (INPUT) DOCUMENT / (FNV) / \/ BUFFER, BLOCKNO :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ LABOFFSET :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ PERFORMANCE :: APPLICABLE IF 1ST ENTRY FOR RECORD / \/ VAT :: ALWAYS APPLICABLE / \/ V A / \/ L U / \/ E F / \/ I E / \/ FNV +A, L D / \/ BLOCKNO :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ LABOFFSET :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ PERFORMANCE :: NOT APPLICABLE IF MULTI-KEY RECORD / \/ FNV +B, #4000 :: ALWAYS APPLICABLE / \/ BLOCKNO / \/ LABOFFSET / \/ PERFORMANCE / \/ FNV +C, #40KK / \/ \\\\//// / \/ (DUMMY), 0 / \/ 0 / \/ 0 / \/ 0 / MERGE FILLS-OUT THE 4 WORDS (THE 'DUMMY' ENTRY WITHIN 'FNVAR') / AFTER THE PREVIOUS (LAST VALAD) ENTRY WITH THE VALUE OF 0000 / BECAUSE THE MERGE AND THE OUTPUT DOCUMENT GENERATOR / NEED TO KNOW THE END / ? ? ? ? ? ? ? ? ? ?? ? ? ??? ? ? ? ?? ?? ?? ? ? ? ???? ? ?? ? ? ? ? / ???? ? ? ? ? ? ? ? ? ??? ? ? ? ? ? ??? ? ? ? ? ? ? ? ?? ? ? ? ??? / THE PC-1 FOR EACH 'VALUE' FIELD ENTRY WITHIN THE 'FNV' BUFFER / /\ [-1] / /\ (DUMMY) / /\ FNV+ / /\ FNV +E / /\ FNV +D / /\ FNV +C / /\ FNV +B / /\ (FNVAR) FNV +A / /\ BUFFER, FNVBUFFER-1 / BLOCKNO:: 0 1 2 3 4 5 6 7 8 9 10 11 / M1 M2 B B B B B B B B B B / / OFFSET:: 0 1 2 3 4 5 6 7 8 9 10 11 / M3 M4 M5 CO CO CO CO CO CO CO CO CO / / PERFORMANCE:: 0 1 2 3 4 5 6 7 8 9 10 11 / R - HO HO HO HO HO HO HO HO HO HO / / R = 0 MEANS SINGLE BLOCK READ / R = 1 MEANS MULTIPLE BLOCK READ / ------------------------------------------- / VAT MEANS: ! 0 1 2 ! 3 4 5 ! 6 7 8 ! 9 10 11 ! / (VALUE ATTRIBUTE) ! X V V V V V ! S M K K K K ! / ------------------------------------------- / / IF X = 0 THEN: VVVVV = THE NUMBER OF 'VALUE' LOCATIONS USED WITHIN FNV BUFFER / AND: S = 0 MEANS EVEN NUMBER OF 'VVVVV' CHARACTERS / = 1 MEANS ODD NUMBER OF 'VVVVV' CHARACTERS / AND: KKKKK = THE NUMBER OF THE KEY / / IF X = 4000 THEN: / THE #4000 MEANS: THE RECORD OF THE LIST DOCUMENT / DID +++NOT+++ CONTAIN ANY KEY S / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT / / THE #40KK MEANS: THE RECORD OF THE LIST DOCUMENT / CONTAINED A +++BLANK+++ 'VALUE' FIELD / FOR KEY NUMBER KK / DEFINED WITHIN THE SPECIFICATION DOCUMENT XBIT= 4000 VVVVV= 37 SBIT= 40 MKSBIT= 20 KKKK= 17 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . / A DEFINED WITHIN THE SPECIFICATION DOCUMENT / [ BEING HELD WITHIN THE SDFN BUFFER ] / +++ IS THE SAME AS +++ / A USED WITHIN THE LIST DOCUMENT / [ AND BEING HELD WITHIN THE FN BUFFER ] / . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E6 - MEANS THAT THIS IS DUPLICATED WITHIN THE SAME RECORD FNKEYFOUND, TAD I T1 /SAME AS 'TAD KEY01FNTOTAL' THRU 'KEY--FNTOTAL' SZA CLA / SKIP NEXT OF NO PREVIOUS OF THIS NAME JMP E6 / E 6 /* RECORD CONTAINS A DUPLICATE ISZ I T1 /+1 TO THE TOTAL # OF OF THIS NAME / A DEFINED WITHIN THE SPECIFICATION DOCUMENT / IS THE SAME AS A USED WITHIN THE LIST DOCUMENT / THEREFORE THE USED WITHIN THE LIST DOCUMENT / IS A +++KEY+++ JMS PSH3V /PUSH INTO THE FNV BUFFER THE:: / BLOCK#, OFFSET, PERFORMANCE ATTRIBUTES OF THIS TAD (-KEY01FNTOTAL+1) TAD T1 DCA KEYNO / SAVE IT FOR USE WITHIN 'NVFPROCESSOR' TAD KEYNO DCAFNV / [VAT] / THE ABSOLUTE # OF THIS KEY WITHIN SDFN BUFFER /\ JMP .+1 / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!! !!!!! / !!!!! GET THE 'VALUE' FIELD OF THE KEY SELECTED !!!!! / !!!!! !!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / GET THE 'VALUE' FIELD FOR THIS / AND PUSH IT INTO THE VALUE BUFFER 'FNVBUFFER' / THE 1ST 60 PRINTABLE CHARACTERS UP TO A < OF THE NEXT OR <> / ARE PART OF A 'VALUE' FIELD GETFNVALUE, AC7776 DCA VALCOUNT / TWO 6-BIT ASCII 'VALUE' CHAR PER FNV SLOT DCAPACK6BIT, BSW / AND PUT INTO HIGH ORDER BYTE OF THE WORD: CC00 DCA PACK6BIT / START WITH (PACK6BIT) CLEAR; IT'S MUCH CLEANER JMS XRD1VALUECHAR / READ 1 'VALUE' FIELD CHARACTER / CONVERT (AC): MMMMMCCCCCCC 'LOWER CASE' CHARACTERS TO 'UPPER CASE' AND P177 / STRIP MODE BITS MAKING 7-BIT ASCII CHAR TAD (-140) / MAKE 'LOWER CASE' SPA / 'UPPER CASE' TAD (140) / WHOOPS - NOT AN ALPHA CHARACTER / ONLY THE 1ST 60 CHARACTERS OF THE 'VALUE' FIELD ARE SORTED ON / ALL EXCESSIVE 'VALUE' FIELD CHARACTERS ARE IGNORED ISZ CCVALUE JMP ANDP77 / 'VALUE' FIELD OVERFLOW / THE 'VALUE' FIELD EXCEEDED 60 PRINTABLE CHARACTERS / WHICH IS NOT AN ERROR BUT MEANS ALL EXCESSIVE CHAR'S MUST BE IGNORED / BECAUSE THIS PROGRAM IS DESIGNED TO SORT ON ONLY THE 1ST 60 CHARS JMS XRD1VALUECHAR / READ 1 'VALUE' FIELD CHARACTER JMP .-1 / IGNORE THIS 'OVER 60' CHARACTER / THE CONTENTS OF THE AC IS A 12-BIT 'VALUE' CHARACTER: MMMMMCCCCCCC ANDP77, AND P77 /MAKE THE 12-BIT CHARACTER 6-BIT JMS NVFPROCESSOR / IF <:FN> THEN 'NVFPROCESSOR' CAPTURES MAIN-LINE IFNDEF ITALIAN < TAD (SBIT) /ADD 40 TO CHAR (SET FROM ASCII TO 6 BIT SEQ) /A016 AND P77 /MASK OUT L/O 6 BITS /A016 > ISZ VALCOUNT / +1 FROM 7776 TO 7777 TO 0 JMP DCAPACK6BIT / JMP TO GET ANOTHER CHARACTER / (VALCOUNT) WENT TO 0 MEANS GOT 2 PACKED 6-BIT 'VALUE' FIELD CHARACTERS TAD PACK6BIT / CC00 DCAFNV / PUSH THE TW0 6-BIT CHAR'S WITHIN THE FNV BUFFER JMP GETFNVALUE / JMP TO GET MORE OF THE 'VALUE' TIL THE NEXT < VALSTATUS, / 0 MEANS EVEN # OF 'VVVVV', 40 MEANS ODD VALCOUNT, -2 / TWO 6-BIT 'VALUE' CHARACTERS PER 1 FNV BUFFER SLOT PACK6BIT, 0 / LOCAL TEMP WORK / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . / . . A LEFT ANGLE BRACKET WAS DETECTED . . / . . WHILE EXPECTING CHARACTERS OF THE 'VALUE' FIELD FOR THAT . . / . . WHICH MEANS THIS MUST BE THE END OF THE 'VALUE' FIELD . . / . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . GOTALL, CLA /CLA CAUSE VECTOR HERE WITH (AC) = 12-BIT CHAR TAD PACK6BIT / 0000 IF (VALCOUNT) = 7776; ELSE CC00 CAUSE = 7777 ISZ VALCOUNT JMP .+3 DCAFNV / PUSH CC00 INTO THE FNV BUFFER TAD (SBIT) DCA VALSTATUS / IF THERE WERE NO 'VALUE' CHARACTERS BETWEEN THE LAST > AND THIS < / THEN THIS KEY HAS A +++BLANK+++ 'VALUE' FIELD AC0004 TAD FNVKEY / (AC) = ADDRESS OF THE [VAT] CIA / NEGATE FOR COMPARISON TAD FNV / CURRENT ADRS OF FNV SNA JMP FNVBLANK / THE 'VALUE' FIELD FOR THIS KEY IS NOT BLANK / / THE CONTENTS OF THE AC = THE NUMBER OF FNV BUFFER SLOTS / USED TO STORE THE VALUE FIELD BSW /MOVE INTO HIGH BYTE: 0VVVVV 000000 TAD VALSTATUS / 0VVVVV S00000 JMP FNVOK / THE FIELD NAME IS OK / THE 'VALUE' FIELD FOR THIS IS +++BLANK+++ / PUSH THE #40KK INTO THE FNV BUFFER SLOT / PREVIOUSLY RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT)' FNVBLANK, AC4000 / XBIT / THE 'VALUE' FIELD FOR THIS IS +++NOT+++ BLANK / PUSH THE #0V00 INTO THE FNV BUFFER SLOT / RESERVED FOR THE 'VALUE ATTRIBUTE' ELEMENT (VAT) FNVOK, CDFFNV TAD I MKSVAT / [VAT] / (AC) = 40KK OR 0VKK TAD (MKSBIT)/ MKSBIT DCA I MKSVAT / [VAT] / PUT BACK INTO THE FNV BUFFER CDFMYF AC0001 / MEANS '<' FOUND JMP NEXTFN / JMP TO PARSE THE NEXT OF THE LIST DOC FNVKEY, FNVBUFFER-1 / PUSH INTO THE 'FNVBUFFER' THE ATTRIBUTES FOR THIS KEY ; (OR NO KEY RECORD) / ....BLOCK #...., ....CHARACTER BYTE OFFSET...., ....PERFORMANCE.... PSH3V, XX TAD FNV / GET THE ADDRESS OF THE FNV BUFFER DCA FNVKEY / FNVKEY TAD BLOCKNO / GET BLOCK # WHEN THE < WAS DETECTED [AT 'LAB'] DCAFNV / PUSH IT INTO THE FNV BUFFER TAD LABOFFSET / GET CHAR OFFSET OF THE '<' WHEN IT WAS DETECTED DCAFNV / PUSH IT INTO THE FNV BUFFER TOO TAD PERFORMANCE DCAFNV TAD FNV / ADDRESS-1 OF [VAT] IAC DCA MKSVAT / MKSVAT/ ADDRESS OF [VAT] WITHIN FNV TABLE JMP I PSH3V PAGE / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . / . . . . A DISK END OF FILE [EOF] HAS BEEN DETECTED . . . . / . . . . WHILE EXPECTING CHAR'S OF THE . . . . / . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . /*E9 - MEANS NO RECORDS PROCESSED [INPUT DOC PROBABLY HAD ONLY TEXT] DISKEOF,TAD RECNUM SNA CLA JMP E9 / E 9 /*NO RECORDS PROCESSED /*E7 - MEANS THIS DISK EOF DETECTED AFTER < BUT BEFORE > TAD LABFLG SZA CLA JMP E7 / E 7 /*DISK EOF DETECTED AFTER < BUT BEFORE > OR <> /*E10- MEANS NO RECORDS SELECTED [LIST DOC HAD NO KEY 'S] TAD KEYFNTOTAL SNA CLA JMP E10 / E 10 /*E10 - NO RECORDS SELECTED FOR SORT / SET A [-1] TERMINATOR INTO THE FNVAR BUFFER AC7777; JMS DCAVAR / DISPLAY ON THE SCREEN THE # OF RECORDS SELECTED OUT OF # PARSED JMS SPDPRS / RECORDS SELECTED: S OUT OF X JMS SORT / SORT THE 'FNVAR' TABLE VIA THE 'FNV' TABLE JMS MERGE / MERGE THAT TABLE WITH ANY FNV PACKETS JMS ODG / TO THE OUTPUT DOCUMENT GENERATOR / IF WE GOT TO HERE / THEN WE ARE FINISHED: / SELECTING, SORTING, MERGING AND PRODUCING THE OUTPUT DOCUMENT / THEREFORE OUTPUT TO THE SCREEN THE MESSAGE: 'DONE' CIFIOA / -IOA- JMS I IOACAL 0 / MSRDONE / 'DONE' 1205 / ^P JMP NOERRORS / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!! !!!! / !!!! REPORT AN EXPLICIT ERROR CONDITION !!!! / !!!! !!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! E5CLA, CLA; JMP E5 / E 5 / THE CONTENTS OF THE AC AT ENTRY TO 'E-' MUST = 0 FOR THE IAC'S TO WORK E13A, IAC / OUTPUT VOLUME FULL /A018 E13, IAC / output diskette full (no more blocks to alloc) /a0014 E12P, /IAC / EXTRA RADIX POINT ('.') FOUND E12N, /IAC / ILLEGAL PLACEMENT OF ('$') CURRENCY SYMBOL E12M, /IAC / EXTRA ('$') CURRENCY SYMBOL FOUND E12L, /IAC / EXTRA SIGN BUT FOUND E12K, /IAC / ILLEGAL PLACEMENT OF ('+') PLUS SIGN E12J, /IAC / EXTRA RIGHT ')' PAREN FOUND E12I, /IAC / '()' FOUND -- BACK TO BACK PARENS E12H, /IAC / NO '(' BEFORE ')' E12G, /IAC / SIGN '+' OR '-' PRECEEDED RIGHT ')' PAREN E12F, /IAC / ILLEGAL PLACEMENT OF LEFT '(' PAREN E12E, /IAC / '(' BUT NO ')' DETECTED BEFORE E12D, /IAC / UNKNOWN CHARACTER -- NOT 0 THRU 9 OR 'NATURAL' E12C, /IAC / TO MANY CHAR'S -- 'KWHOLE' OR 'KFRACTION' OVFL E12B, /IAC / ILLEGAL PLACEMENT OF MINUS '-' SIGN E12A, /IAC / ILLEGAL PLACEMENT OF RIGHT ')' PAREN IAC / (INVALAD NUMERIC VALUE FIELD SYNTAX) E11, IAC / SPEC DOC DEFINED TO MANY KEYS TO SORT ON E10, IAC / LIST DOC HAD NO KEY S E9, IAC / LIST DOC HAD NO RECORDS TO PROCESS E8, IAC /*ODG: UNEXPECTED DISK EOF E7, IAC / A DISK EOF DETECTED AFTER < BUT BEFORE > OR <> E6, IAC / DUPLICATE WITHIN SAME RECORD E5, IAC / > DETECTED WITHIN VALUE E4, IAC / EXCEEDED 30 DECIMAL CHARACTERS E3, IAC / < DETECTED WITHIN A E2, IAC / HAS TEXT PRECEEDING THE /E1, IAC / E0, TAD (EMESTABLE) / RECORD EXCEEDED 2500 PRINTABLE CHARACTERS DCA ERMEADRS JMS SPDPRS / OUTPUT TO THE SCREEN: 'KEY RECORDS: X OF Y CIFIOA / -IOA- JMS I IOACAL 0 / MERROR / ^S - CONTROL AND TEXT ADDRESS 1200 / ^P 1300 / ^P ERMEADRS, (EMESTABLE) / !S - ADDRESS OF ADDRESS OF TEXT 1400 / ^P 1600 / ^P /\ JMP .+1 /DROP FROM ABOVE AND / OUTPUT TO THE SCREEN THE FIRST >7< LINES / OF THE RECORD BEING PROCESSED / WHEN THE ERROR WAS DETECTED TAD BLOCKNO / BLOCK # OF INPUT DOC AT TIME OF ERROR DCA EBNO TAD LABOFFSET / OFFSET OF > AT TIME OF ERROR DCA EOFF TAD PERFORMANCE / HHH AT TIME OF ERROR CLL RAL STL RAR / FORCE 'MULTIPLE READ' MODE DCA EHHH JMS PUTBNO / 'PUT' THE NEXT 3 PARAMATERS INTO % RANDRD EBNO, ZBLOCK 1 EOFF, ZBLOCK 1 EHHH, ZBLOCK 1 JMP NO7LINES / CAN'T TYPE -7- LINES; JUST ERRORED TRYING TO GET THEM TAD (-7) DCA SRBUGSWITCH / >>7<< LINES / OUTPUT UP TO >>7<< LINES / OF THE RECORD BEING PROCESSED / AT THE TIME OF THE ERROR SRLOOPE,AC0002 /'+2' FLAG FOR 'EORD1CHAR' JMS ERORD1CHAR / READ 1 CHAR FROM THE LIST DOCUMENT JMP SRERROR / ...RETURN TO HERE AT DISK EOF... (AC)=0 / ......(A DISK EOF COULD OCCUR) / ......(BECAUSE 7 LINES OF DATA TO READ) JMP ERRCR / ...NON-PRINTING RETURNS HERE / ......(IF IT IS A 'LF' THEN STUFF A 'CR') NOP / ... < RETURNS HERE; (TYPE IT) NOP / ... > RETURNS HERE; (TYPE IT) JMS TYPERD / ... 12-BIT CHAR DATA RETURNS HERE; (TYPE IT) JMP SRLOOPE / GET NEXT CHARACTER / IF THE CHARACTER JUST READ FROM THE LIST DOCUMENT / (WHICH IS PART OF THE >7< LINES FOR OUTPUT / IS A 'LINE FEED' THEN OUTPUT A 'CARRIAGE RETURN' ERRCR, JMS TYPERD / type nonprinting character TAD CHR177 / was character just typed a ? TAD (-LF) SNA CLA TAD (CR) / yes - type a JMS TYPERD / no - type a null character ISZ SRBUGSWITCH / UPDATE TYPED LINE COUNT JMP SRLOOPE / UNTIL UP TO >>7<< LINES ARE ECHOED TO THE VT NO7LINES, SRERROR,DCA SRBUGSWITCH / ZERO 'SRBUGSWITCH' /\ JMP .+1 NOERRORS, / IF WE DROPPED FROM ABOVE / THEN THE ODG SHOULD HAVE DEALLOCATED ALL MERGE SCRATCH BLOCKS (NATURALLY) / BUT BECAUSE THE MERGE CAN WRITE 'PARTIAL' BLOCKS (WITHIN THE CHAIN) / AND THE ODG IS DONE WHEN A '0' VAT IS FOUND / (NOT WHEN ALL BLOCKS ARE READ) / 'JMS MRGEFRALL' ANYWAY TO BE SURE ALL BLOCKS ARE DEALLOCATED / ELSE RUNNING 'MC::VERIFY' COMMAND (FROM MAIN MENU) / WILL DETECT ALLOCATION ERRORS JMS MRGEFRALL / DEALLOCATE ALL BLOCKS ALLOCATED BY:: MERGE / OUTPUT THE MESSAGE:: GOLD M TO THE SCREEN CIFIOA / -IOA- JMS I IOACAL 0 / MGOLD / 2703 / ^P AOK1, JMS WAITM / WAIT FOR KEY 'GOLD M' /C017 AOK, JMP AOK1 / RETURN HERE IF NOT GOLD M /C017 / RETURN HERE IF GOLD M / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /SRABORT,CDIMNU / CDF CIF TO THE MENU FIELD SRABORT,CDF CIF 20 / - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - JMP I MMRETURN / BACK TO THE 'MAIN' MENU / SUBROUTINE TO OUTPUT TO THE SCREEN THE TEXT: 'SR: WORKING' SRWORKING, XX JMS TIMEOUT CIFIOA / -IOA- JMS I IOACAL 0 MPROCESSING / ^S - CONTROL AND TEXT ADDRESS 1205 / ^P - LINE / COLUMN 1600 / ^P - LINE / COLUMN JMP I SRWORKING XRD1VALUECHAR, XX /*E7 - MEANS A DISK EOF DETECTED AFTER > BUT BEFORE < OR <> /*E5 - MEANS A > WAS DETECTED WITHIN THE 'VALUE' FIELD /*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS AC7777 / '-1' FLAG FOR 'RD1VALUECHAR' JMS RD1VALUECHAR / READ 1 'VALUE' 12-BIT CHARACTER FROM THE LIST DOCUMENT JMP E7 / E 7 /* (AC)=0; LIST DOCUMENT END OF FILE [NO MORE DATA] JMP .-3 / THIS 'VALUE' CHAR IS NON-PRINTING [NO BIG DEAL] JMP GOTALL / THIS 'VALUE' CHAR IS '<' MEANS END OF VALUE FIELD JMP E5CLA / E 5 /* > DETECTED WITHIN THE VALUE JMP I XRD1VALUECHAR / 12-BIT CHARACTER IS IN THE AC PAGE / AC???? /AC AT ENTRY IS A FLAG:: -1, 0, 1, 2 / JMS $$$$$$ /JMS IS THE CALL, (AC) AT EXIT = 12-BIT CHAR / JMP A / RETURN TO HERE WHEN A DISK EOF / JMP B / RETURN TO HERE WHEN A NON-PRINTING CHAR / JMP C / RETURN TO HERE WHEN A < LEFT ANGLE BRACKET / JMP D / RETURN TO HERE WHEN A > RIGHT ANGLE BRACKET / JMP E / RETURN TO HERE WHEN A CHAR / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT FOR ERROR TYPEOUT. / (WITHOUT 'SCROLLING' THEM TO THE OUTPUT DOCUMENT ERORD1CHAR, / ENTER HERE WITH THE AC = 0002 / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT / (FOR 'SCROLL'ING TO THE OUTPUT DOCUMENT) ODGRDCHAR, / ENTER HERE WITH THE AC = 0001 MEANS IGNORE NOTHING / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 'VALUE' FIELD CHARACTER / FROM THE LIST DOC RD1VALUECHAR, / ENTER HERE WITH THE AC = 7777 / ---------------------------------------------------------------------------- / SUBROUTINE TO READ 1 CHARACTER FROM THE LIST DOCUMENT RD1FNCHAR, / ENTER HERE WITH THE AC = 0000 / ---------------------------------------------------------------------------- XX JMS RD1CHR /'JMS' WITH (AC)=0000, 0001, 0002, OR 7777 JMP I RD1FNCHAR / 'JMP I' MEANS DISK EOF (OUT OF DATA) DETECTED / ENTRY TO HERE IS WITH THE AC = 7-BIT ASCII CHARACTER TAD (-40) / -40 SPA JMP NPCCHAR / THE CHARACTER IS: NON-PRINTING TAD (-34) / -74 SNA JMP LABCHAR / THE CHARACTER IS #74: A LEFT ANGLE BRACKET '<' TAD (-2) / -76 SNA CLA JMP RABCHAR / THE CHARACTER IS #76: A RIGHT ANGLE BRACKET '>' /\ JMP .+1 / DROP FROM ABOVE, AND / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / IF THE MAIN-LINE IS THE SELECTOR / SIGNIFIED BY THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = 0 OR -1 / THEN 'ISZ CCRECORD' /*E0 - MEANS RECORD EXCEEDED 2500 PRINTABLE CHARACTERS / - (EXCLUDING '<'S AND '>'S) TAD RDFLAG SMA SZA CLA JMP .+4 ISZ CCRECORD SKP JMP E0 / E 0 /*RECORD EXCEEDS 2500 CHARACTERS / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ISZ RD1FNCHAR / THE CHAR IS PRINTABLE RABCHAR,ISZ RD1FNCHAR LABCHAR,ISZ RD1FNCHAR NPCCHAR,ISZ RD1FNCHAR / EXIT WITH (AC) = 12-BIT CHARACTER: MMMMMCCCCCCC CLA /CLA CAUSE (AC) IS GARBAGE TAD CHARIN / GET BACK THE 12-BIT CHARACTER (INCLUDING MODE BITS) JMP I RD1FNCHAR / AND EXIT WITH IT IN THE AC / SUBROUTINE TO READ A CHARACTER FROM A DOCUMENT / JMS ZRDNXCH / DISK END OF FILE RETURNS TO THIS PC WITH (AC) = 0 / ELSE RETURN TO THIS PC ZRDNXCH,XX JMS XXHLTFLG / TEST FOR THE GOLD HALT FLAG JMS RDNXCH / % RANDRD READS 1 CHAR DCA CHARIN / MMMMM CCCCCCC TAD CHARIN / GET IT BACK AND P177 / STRIP OFF MODE BITS DCA CHR177 / SAVE 00000CCCCCCC TAD CHARIN / GET IT BACK FOR EXIT SZA / SKIP NEXT IF NO MORE DATA ISZ ZRDNXCH / 'ISZ' MEANS GOT DATA FROM INPUT DOC JMP I ZRDNXCH / /SUBROUTINE TO READ ONE CHARACTER FROM THE INPUT DOCUMENT (EXIT WITH AC= 7-BIT ASCII) / AC AT ENTRY =-1: IGNORES ONLY: RULERS, JUSTIFYING SPACES AND LINE FEEDS / AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, JUSTIFYING SPACES AND 'S / AC AT ENTRY =+1: IGNORE NOTHING AND 'JMS ODGSCROLL' (CAUSE MAIN-LINE IS ODG) / AC AT ENTRY =+2: IGNORE NOTHING SO WE CAN OUTPUT THE CHARACTER TO THE SCREEN / AS PART OF THE ERROR DETECTION AND REPORTING RDFLAG, ZBLOCK 1 / HOLDS THE CONTENTS OF THE AC:: -1, 0, 1, 2 /CALLED WITH AC=FLAG / JMS RD1CHR / DISK EOF RETURN TO THIS PC [WITH THE AC = 0] / ELSE RETURN TO THIS PC [WITH AC = THE 7-BIT CHAR: 00000CCCCCCC] RD1CHR, XX DCA RDFLAG / SAVE FLAG RDNEXT, JMS ZRDNXCH / READ 1 CHAR JMP I RD1CHR / DISK END OF FILE [EOF] CLA RDNOBUG,TAD RDFLAG / Get the read type flag. /a021 SPA CLA / Is this a field value? /a021 JMP SINGLE / Yes, CHECK FOR SINGLE ACCENTED CHARACTERS RDNOB1, TAD CHR177 / No, GET CHARACTER:: 00000CCCCCCC TAD (-41) SPA CLA / SKIP NEXT IF THE CHARACTER IS PRINTABLE JMP NPC RD1EXIT,CLA DCA FLAG40 / PRINTABLE CHARACTERS RESET 'FLAG40' NPCEXIT,TAD CHR177 / GET CHARACTER TO RETURN WITH ISZ RD1CHR / +1 TO RETURN ADDRESS RD1EOF, JMP I RD1CHR / NON PRINTING [SPECIAL] CHARACTER NPC, TAD RDFLAG SMA SZA CLA / SKIP IF AC<= 0 JMP ODGSKP / 'JMP' BECAUSE MAINLINE IS 'ODG' TAD CHR177 / GET CHARACTER:: 00000CCCCCCC /\ JMP NOTODG / THE CHARACTER IS NON-PRINTING / AND THE MAINLINE IS --NOT-- THE OUTPUT DOCUMENT GENERATOR (ODG) NOTODG, TAD (-10) / CHECK FOR 'BEGIN DEAD' SZA / Is it a begin sequence introducer? /m021 JMP NOTDEAD / No, deal with others /a021 CMA / Yes, set the dead flag. /a021 DCA DEADKEY / /a021 TAD RDFLAG / Test the read type. /a021 SMA / Is it a field value read? /a021 JMP RD1EXIT / No, exit with character as is. /a021 JMP DEAD / Yes, JMP TO DEAD KEY SEQUENCE PROCESSOR NOTDEAD,TAD (10-40) / /A021 SNA JMP SPHANDLER / THE CHARACTER IS A:: SPACE (40) OR (2040) TAD (40-12) SZA JMP NOTLF / NOT A LINE FEED TAD CHARIN / THE CHARACTER IS A:: LINE FEED (12) AND (3000) / IS IT A WRAPPED LINE OR END OF PARAGRAPH? SZA CLA / SKIP IF: REGULAR LINE FEED JMP WRAPHANDLER / IT'S WRAPPED OR E.O.P. - HANDLE IN SAME MANNER JMP LFHANDLER / REGULAR LINE FEED / LOOKING FOR -1014 [START OF PRINTER CONTROL] / OR -1414 [END OF PRINTER CONTROL] LPTCTRL,TAD CHARIN / TEST FOR 'START OF PRINTER CONTROL' TAD (-1014) SNA CLA JMP SOPC / JMP BECAUSE 'START OF PRINTER CONTROL' TAD RDFLAG SMA CLA JMP ODGTST JMP RD1EXIT SOPC, TILEND, JMS FLGTST JMS ZRDNXCH / READ 1 CHARACTER FROM THE PROPER DOCUMENT JMP I RD1CHR / THIS 'JMP I' IF DISK EOF TAD (-1414) / 'END OF PRINTER CONTROL' YET ? SZA CLA JMP TILEND / KEEP LOOKING FOR 'END OF PRINTER CONTROL' /\ JMP ODGTST / IF THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = +1 / THEN THE OUTPUT DOCUMENT GENETATOR (ODG) IS IN CONTROL / THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT / ELSE JUST EXIT ODGTST, JMS FLGTST / TEST THE CONTENTS OF 'RDFLAG' JMP RDNEXT / 'JMP' TO READ THE NEXT CHARACTER / SUBROUTINE TO TEST THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' / IF (RDFLAG) = +1 THEN 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT / IF (RDFLAG) = +2 THEN 'JMP NPCEXIT' FLGTST, XX TAD RDFLAG SPA CLA / /m021 JMP I FLGTST / 'JMP I' BECAUSE AC IS MINUS AC7777 / CHECK - IGNORE NOTHING EXCEPT RULERS IN/m021 / SPKRUL ROUTINE FOR ERROR TYPEOUT TAD RDFLAG SZA CLA / /m021 JMP NPCEXIT / THE (RDFLAG) = +2 / THE CONTENTS OF PROGRAM LOCATION 'RDFLAG' = +1 / THEREFORE 'SCROLL' THE CHARACTER TO THE OUTPUT DOCUMENT TAD CHARIN JMS ODGSCROLL JMP I FLGTST /d021/ get a character from the 'xxsdfnbuffer' (located in field 4) /a0011 /d021 /a0011 /d021TADISDFN, XX / /a0011 /d021 CDFSDFN / CHANGE DATA FIELD TO FIELD #4 /a0011 /d021 TAD I SDFN / GET THE CHARACTER FROM THE 'XXSDFNBUFFER' /a0011 /d021 CDFMYF / CHANGE DATA FIELD BACK TO THIS FIELD /a0011 /d021 JMP I TADISDFN/ AND EXIT /a0011 PAGE NOTLF, IAC SNA CLA JMP TABHANDLER / THE CHARACTER IS:: TAB (11) ODGSKP, TAD CHR177 TAD (-16) / -16 / Check for a start of ruler (16) /m021 SNA JMP SKPRULER / THE CHARACTER IS:: START OF RULER (16)/m021 IAC / Test for an End Dead character /a021 SNA / Is it End Dead (CR=15)? /a021 DCA DEADKEY / Yes, zero the dead key sequence flag /a021 IAC / -14 / Check for Form Feed (14) /m021 SNA CLA JMP LPTCTRL / THE CHARACTER IS:: FORM FEED (14) /m021 JMP ODGTST END40, IAC / +1 WRAPHANDLER, IAC / +1 LFHANDLER, IAC / +1 JMP IAC4 / THE CONTENTS OF PROGRAM LOCATION 'CHARIN' = 11 WHICH IS A TAB / CONVERT THIS TAB TO A (2040) FOR OUTPUT VISUAL CONTINUITY TABHANDLER, TAD SFTSPC DCA CHARIN IAC4, CMA DCA FLAG40 / -1, -2, -3, -4 JMP NPCEXIT / EXIT WITH THE CHARACTER IN THE AC FLAG40, ZBLOCK 1 SPHANDLER, / THE CHARACTER IS A SPACE (40) OR (2040) AC2000 / TEST FOR THE SPACE TO BE (2040) 'JUSTIFYING' AND CHARIN SNA CLA / SKIP NEXT IF A 'JUSTIFYING' SPACE (2040) JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / THE SPACE IS DEFINATELY A 'JUSTIFYING' (2040) SPACE / ... IS IT A [TAB] 'JUSTIFYING' SPACE ? TAD FLAG40 IAC SNA / SKIP NEXT IF (FLAG40) = '-1' JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / ... IS IT A 'JUSTIFYING SPACE' THAT FOLLOWS A NORMAL LINE FEED ? IAC SNA / SKIP NEXT IF (FLAG40) = '-2' JMP SPHAN1 / JUST IGNORE LEFT MARGIN JUSTIFY SPACES / ... IS IT A [WORD WRAP] OR [SOFT RETURN] IAC SNA / SKIP NEXT IF (FLAG40) = '-3' JMP RDNEXT / IGNORE THE CHAR AND READ THE NEXT ONE / ... IS IT A [CENTERING] 'JUSTIFYING' SPACE ? IAC SNA CLA / SKIP NEXT IF (FLAG40) = '-4' JMP NPCEXIT / EXIT 'RD1--CHAR' WITH THE AC=40 / WE GOT HERE BECAUSE THE CONTENTS OF PROGRAM LOCATION (FLAG40) = 0 SPHAN1, TAD TOCTALJUSTIFY / JUSTIFYING SPACE COUNT SNA JMP NPCEXIT / THE COUNT = 0 MEANS NO JUSTIFYING SPACES TO SKIP CIA / NEGATE IT DCA T3 SPHAN2, JMS ZRDNXCH / READ NEXT CHARACTER JMP RD1EOF TAD (-2040) / IS IT A SOFT SPACE? SZA CLA / SKIP NEXT IF A SOFT SPACE JMP RDNOBUG / WE'VE FINISHED JUSTIFYING SPACES / SO SEND THIS CHAR THROUGH REGULAR PROCESSING ISZ T3 / SOFT SPACE, COUNT OVERFLOW? JMP SPHAN2 / NO - GET THE NEXT CHARACTER UNTIL (T3) = 0 JMP END40 / GO SETUP FLAG40 FOR NORMAL WORDWRAP SEQENCE /++ /FUNCTIONAL DESCRIPTION: SKPRUL - SKiP RULer / / This routine will exam each ruler of the input document as it is / being read and calculate the proper number of left justify spaces to / ignore (due to the current left margin setting) while reading each / field name or value of a record. It will save the left margin / justification value of the ruler just preceding the first record / in the list as this ruler is the default ruler for our output / document. This routine also serves the purpose of ignoring all / rulers encounted during the typeout of an error message since the / characters that make up a ruler would appear as simply garbage to / the user. / / SKPRUL PSUEDO CODE: / / skprul: repeat /10) if [not ignoring ruler for error typeout] / go check for scrolling of character / read ruler character /15) if [character = "@ (forward ruler follows)] /20) if [already entered record list] /25) if [not in ODG] / flag user - more than one ruler in list / else /30) clear octal value computed from previous ruler / set flag (RULSEPDET) - ruler separator detected ("@) / else /40) if ["@ has been previously detected] /45) get character / if [left margin value character] /55) compute it's octal value / else /60) reset ruler separator detected flag / TOCTALJUSTIFY = TOCTALJUSTIFY - 1 / end if / if [first record in list not yet detected] / set default OCTALJUSTIFY for ODG = TOCTALJUSTIFY /65) get character /70) until [character = end of ruler marker] /75) if [ignore ruler for error typeout] / exit SKPRUL via RDNEXT (go read next character) / else / exit SKPRUL via ODGTST (see if e.o.r. needs to be scrolled) / /CALLING SEQUENCE: JMP SKPRUL /INPUT PARAMETERS: none /IMPLICIT INPUTS: CHARIN, RULSEPDET, T2, OCTALJUSTIFY, TOCTALJUSTIFY, / SRBUGSWITCH, BORFLAG, RECNUM, P7700 /OUTPUT PARAMETERS: none /IMPLICIT OUTPUT: RULSEPDET, OCTALJUSTIFY, T2, TOCTALJUSTIFY /COMPLETION CODE: none /SIDE EFFECTS: none /-- SKPRUL, TAD SRBUGSWITCH / [10] / ignore ruler for error typeout? SNA CLA / skip: if so JMS FLGTST / 'FLGTST' also 'SCROLLS' the (CHARIN) JMS ZRDNXCH / read NEXT ruler character JMP RD1EOF / 'JMP' CAUSE DISK EOF TAD P7700 / [15] / (-100)is char. @ ? SZA CLA / skip if so JMP SKPRU4 / no it's not TAD BORFLAG / [20] TAD RECNUM SNA CLA / SKIP NEXT IF 1ST '<' EVER DETECTED JMP SKPRU3 TAD RDFLAG / [25] SMA SZA CLA / skip if: not in ODG JMP SKPRU7 CIFIOA / -IOA- JMS I IOACAL 0 / MULTIRULERERR / 0705 / ^P IFDEF CANADA <141> / IFDEF / ^Z ................................ /A004 SKPRU3, DCA TOCTALJUSTIFY / [30] / clear for new value ISZ RULSEPDET / flag ruler forward/reverse separator detected JMP SKPRU7 SKPRU4, TAD RULSEPDET / [40] / has @ been detected already? SNA CLA / skip if so JMP SKPRU7 TAD CHARIN / [45] / get character back (IS IT AN ALPHA ?) TAD P7700 / (-100)is it a left margin value character? SMA CLA / skip if so JMP SKPRU6 / no - go reset RULSEPDET TAD TOCTALJUSTIFY / [55] CLL RTL RTL DCA TOCTALJUSTIFY TAD CHARIN AND (17) / MAKE BCD JMP SKPRU8 SKPRU6, DCA RULSEPDET / [60] / clear ruler separator detected flag AC7777 SKPRU8, TAD TOCTALJUSTIFY DCA TOCTALJUSTIFY STL / LINK = 1 TAD BORFLAG / have we hit the first record yet? TAD RECNUM SZA SNL CLA / skip: if not [SKIP IF EITHER OR AC=0, L=1] JMP SKPRU7 / yes - we've already got our default for ODG TAD TOCTALJUSTIFY / save this left margin value for ODG default DCA OCTALJUSTIFY SKPRU7, TAD CHARIN / [70] TAD (-17) / end of ruler? SZA CLA / skip if so JMP SKPRUL / go get next ruler character TAD SRBUGSWITCH / [75] / ignore end of ruler for error typeout? SZA CLA / skip: if not JMP RDNEXT / ignore e.o.r. for error typeout. get next char. JMP ODGTST / back to normal processing RULSEPDET, / 'RULER SEPERATOR DETECTOR' ZBLOCK 1 / if <> 0 then the char. which separates forwrd / and reverse ruler has been detected OCTALJUSTIFY, ZBLOCK 1 / holds octal number of justifying spaces that / must be inserted pervious to the OUTPUT DOC- / UMENT GENERATOR writing the first line of a / record to the output document. TOCTALJUSTIFY, ZBLOCK 1 / holds octal number of justifying spaces that / must be ignored as text while reading input / document while in selector. PAGE / SUBROUTINE TO OUTPUT THE TIME TO THE SCREEN TIMEOUT,XX CIFMNU JMS I TIMCAL JMP I TIMEOUT / RETURN THIS PC IF NO CHANGE / RETURN THIS PC IF TIME CHANGED (NEXT SECOND) / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . CNT27=INSERTJUST / NOTE THAT PROGRAM LOCATION 'INSERTJUST' / IS USED AS A LOCAL COUNTER / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . TAD (-27) DCA CNT27 CDFMNU AC7777 TAD I (DATESP) CDFMYF DCA X0 TAD (DATEST-1) DCA X1 LOOP27, CDFMNU TAD I X0 CDFMYF DCA I X1 ISZ CNT27 JMP LOOP27 CIFIOA / -IOA- JMS I IOACAL 0 / TDIO / 0072 / ^P DATEST / ^A 1600 / ^P JMP I TIMEOUT / 0072 / 1600 TDIO, TEXT '^P^A!L^P' DATEST, ZBLOCK 27 /++ / /FUNCTIONAL DESCRIPTION: INSERTJUST - INSERT JUSTification spaces / / This routine will insert into the output document a given number of / justification spaces (as per OCTALJUSTIFY). / / INSERTJUST PSEUDO CODE: / / if [justification needed (OCTALJUSTIFY > 0)] / set count to (1-OCTALJUSTIFY) / repeat / scroll justify-space to output document / increment count / until [count = 0] / return to caller / /CALLING SEQUENCE: JMS INSERTJUST /INPUT PARAMETERS: none /IMPLICIT INPUTS: OCTALJUSTIFY /OUTPUT PARAMETERS: none /IMPLICIT OUTPUT: T1 /COMPLETION CODE: none /SIDE EFFECTS: none / /-- INSERTJUST, XX AC7776 DCA T2 JUSTAGAIN, TAD (LF) JMS ODGSCROLL TAD OCTALJUSTIFY SNA JMP NOJUSTIFY CIA DCA T1 TAD (2040) JMS ODGSCROLL ISZ T1 JMP .-3 NOJUSTIFY, ISZ T2 JMP JUSTAGAIN / .............................................................................. CIFSYS JSWAP / LET OTHER JOBS HAVE THE SPOT LIGHT / .............................................................................. JMP I INSERTJUST /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... / DONE / THE OUTPUT DOCUMENT GENERATOR / HAS TRANSFERRED THE ENTIRE CONTENTS / OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT ODGFINI,TAD (207) / 'RULER' MODIFIED FLAG JMS ODGSCROLL CIFFIO /M0006 FILEIO /M0006 XDSKCL / CLOSES THE FILE OPENED BY XDSKIN / JMP I ODG / EXIT THE OUTPUT DOCUMENT GENERATOR TAD ODG DCA .+2 JMP I .+1 ZBLOCK 1 /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... /.... .... .... .... .... .... .... .... .... .... / .... .... .... .... .... .... .... .... .... DCAVAR, XX DCA VARTMP AC7777 TAD FNVAR DCA FNVAR TAD VARTMP CDFFNV DCA I FNVAR CDFMYF JMP I DCAVAR VARTMP, ZBLOCK 1 / SUBROUTINE TO PUSH 1 ELEMENT INTO THE FNV BUFFER XFNVPSH,XX CDFFNV /CHANGE DF TO THE 'EDITOR' FIELD DCA I FNV / PUSH THE CONTENTS OF THE AC INTO THE FNV BUF CDFMYF / CHANGE DF BACK TO 'MY' FIELD JMP I XFNVPSH / EXIT WITH THE AC = 0 / --UPDATE-- THE 'PERFORMANCE' ATTRIBUTE WITHIN THE FNV BUFFER NEWHHH, XX / AC0000 JMS GETBNO TAD PERFORMANCE CDFFNV DCA I HHH1ST / REPLACE UPDATED 'PERFORMANCE' ATTRIBUTE CDFMYF JMP I NEWHHH HHH1ST, FNVBUFFER+2 / HOLDS ADDRESS POINTER INTO THE FNV TABLE / FOR THE 1ST 'PERFORMANCE' ATTRIBUTE / OF THE CURRENT RECORD / SUBROUTINE TO WAIT FOR THE USER TO TYPE A CHARACTER AT THE KEYBOARD /A008 / THIS ROUTINE IS ON THIS PAGE BECAUSE OF SPACE LIMITATIONS /A008 GETCHR, XX / GET CHARACTER FROM USER KEYBOARD /A008 UNTILC, CIFSYS / CHANGE TO SYS FIELD /A008 JSWAP / LET OTHER JOBS GET A CHANCE TO RUN /A008 JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN /A008 CIFSYS / CHANGE TO SYS FIELD /A008 XLTIN / GO LOOK FOR A CHARACTER /A008 JMP UNTILC / NONE STRUCK, GO WAIT SOME MORE /A008 JMP I GETCHR / GOT IT, RETURN TO CALLER /A008 PAGE / SUBROUTINE TO TEST FOR THE 'GOLD' HALT FLAG / / CALL: JMS XXHLTFLG; RETURN PC (if no gold halt) / / NOTE THAT THIS SUBROUTINE / IS CALLED FROM WITHIN 'ZRDNXCH' / WHICH IS USED BY EVERYONE ---EXCEPT--- THE MERGE / K E E P I T T H A T W A Y / and from within 'WT1SCRATCH' / used --ONLY-- by the MERGE XXHLTFLG, XX / + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + / THE FOLLOWING 3 INSTRUCTIONS HAVE NOTHING FUNCTIONAL TO DO WITH THE SORT / THEY ARE REQUIRED BECAUSE OF THE SYSTEM SHORT COMMINGS / AS A VECHICLE BY WHICH PRINTER ERRORS ARE REPORTED TO THE OPERATOR CIFPRT / TO THE 'PRINTER' FIELD JMS I (FLABUZ) / FLASH AND BUZZ CLA / + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + CDFSYS TAD I HLTFLG CDFMYF SNA CLA JMP I XXHLTFLG / IF THE MAIN-LINE CODE IS 'THE MERGE' / THEN OUTPUT THE MESSAGE ' - PLEASE WAIT' / BECAUSE WE'D HAVE A HELLUVA TIME TRYING TO CLEAN-UP / ANY SCRATCH BLOCKS ALLOCATED WITHIN THE MERGE TAD MBUSY SNA CLA JMP NOTMERGE CIFIOA / -IOA- JMS I IOACAL 0 / MSRWAIT / 1220 / ^P 1600 / ^P JMP I XXHLTFLG / THE USER AFTER TYPING 'GOLD HALT' HAS THE OPTION TO: / PRESS 'RETURN' TO CONTINUE THE SR PACKAGE, OR / TYPE 'GOLD M' TO ABORT THE SR AND RETURN TO THE MAIN MENU NOTMERGE, CIFIOA / -IOA- JMS I IOACAL 0 MSRPAUSED 1205 / ^P 2603 / ^P 2703 / ^P JMS SPDPRS WAITMLOOP, JMS WAITM / JMS TO WAIT FOR KEY 'GOLD M' JMP TSTEDNWLN / RETURN TO THIS PC IF >not< GOLD M /\ CIFIOA / -IOA- / /D009 /\ JMS I IOACAL / /D009 /\ 0 / /D009 /\ MSRABORTED / /D009 /\ 1205 / ^P /D009 /\ IFDEF FRENCH <153> / ^Z ................................ /A002 /D009 /\ JMS MRGEFRALL / DEALLOCATE ALL MERGE 'WORK' BLOCKS /D009 JMP SRABORT / RETURN TO THIS PC IF 'GOLD M' / TEST FOR THE KEYBOARD INPUT 'NEW LINE' ALSO KNOWN AS KEY 'RETURN' TSTEDNWLN, TAD XLTINN / GET KEYBOARD INPUT TAD (-EDNWLN) SZA CLA /DEBUG JMS ODTIOA JMP WAITMLOOP / REQUIRED WHEN 'JMS ODTIOA' IS COMMENTED OUT JMS SRWORKING JMP I XXHLTFLG / SUBROUTINE TO WAIT FOR A KEYBOARD INPUT:: GOLD M / CALL: JMS WAITM; RETURN HERE IF >NOT< GOLD M; RETURN HERE IF GOLD M WAITM, XX JMS GETCHR / GO GET A CHARACTER FROM THE USER /A008 DCA XLTINN / SAVE CHARACTER FOR RETURN TEST /M008 TAD XLTINN / RETRIEVE CHARACTER FOR GOLD MENU TEST /M008 TAD (-EDMENU) / SUBTRACT VALUE FOR GOLD MENU /M008 SZA CLA / SKIP NEXT IF 'GOLD M' JMP BEEP / BEEP IF NOT GOLD MENU /C017 / if the return pc is the address 'AOK' /A009 / then do not output the message 'aborted' /A009 / (or execute the 'jms mrgefrall') /A009 / because the 'jms' was already executed at address 'NOERRORS' /A009 /A009 TAD (-AOK) / /A009 TAD WAITM / /A009 SNA CLA / SKIP NEXT IF RETURN PC IS not AOK /A009 JMP CHKDSK / /A009 /A009 CIFIOA / -IOA- / /A009 JMS I IOACAL / /A009 0 / /A009 MSRABORTED / /A009 1205 / ^P /A009 IFDEF FRENCH <153> / ^Z ................................ /A002/A009 JMS MRGEFRALL / DEALLOCATE ALL MERGE 'WORK' BLOCKS /A009 JMP CHKDSK / /A017 BEEP, CIFIOA /A017 JMS I IOACAL /A017 0 /A017 ASCS / ASCII STRING /A017 BELASC / BELL ASCII STRING /A017 JMP I WAITM / RETURN /A017 ASCS, TEXT '^A' / ASCII SUBSTRING /A017 BELASC, 7;0 / BELL CODE WITH ZERO TERMINATOR /A017 CHKDSK, DCA QDRV / 0 / THE 'SYSTEM' IS ALWAYS DRIVE # 0 TAD (RXEDN) / 'GET DENSITY' COMMAND /a0013 DCA QFNC / BECOMES FUNCTION CODE FOR QURX /a0013 JMS QURX / AND EXECUTE THE 'GET DENSITY' COMMAND /a0013 / ----------------------------------------------------------------------------- / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / THIS IS THE ONLY (AND SHOULD BE THE ONLY) / REFERENCE WHERE DATA IS READ 'INTO' / THE 'OUTBLOCK' BUFFER AC0002 / 'HOME' BLOCK DESIGNATION JMS RD1BLOCK / READ THE HOME BLOCK OF THE SYSTEM DISKETTE OUTBLOCK / INTO THE 'EDITOR' FIELD BUF ADDRESS 'OUTBLOCK' / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / ----------------------------------------------------------------------------- /d0013 JMS MGQDRV / RESET 'QDRV' TO THE OUTPUT DOCUMENT DRIVE # TAD DSKID / 0YY NNN NNN NNN CDFEDT TAD OUTBLOCK+5 / SYSTEM DISKETTE ID WITHIN 'HOME' BLOCK CDFMYF AND (777) SNA CLA JMP GOLDM / JMP BECAUSE THE SYSTEM DISKETTE IS IN DRV #0 CIFIOA / -IOA- / JMS I IOACAL / 0 / MREPLACE / 2603 / ^P CIFIOA / -ioa- / /a0013 JMS I IOACAL / /a0013 0 / /a0013 MGOLD / /a0013 2703 / ^P /a0013 UNTILM, JMS GETCHR / GET A CHARACTER FROM THE USER /A008 TAD (-EDMENU) / SUBTRACT VALUE FOR GOLD MENU /A008 SZA CLA / SKIP NEXT IF 'GOLD M' /A008 JMP UNTILM / NOT GOLD MENU, GO GET NEXT CHARACTER /A008 JMP CHKDSK / GO CHECK FOR THE CORRECT SYSTEM DISK /A008 GOLDM, ISZ WAITM / POINT TO GOLD MENU RETURN LOCATION /M008 JMP I WAITM / RETURN TO CALLER /M008 XLTINN, ZBLOCK 1 / HOLDS THE KEYBOARD CHARACTER / SUBROUTINE TO OUTPUT 1 CHARACTER TO THE SCREEN / (enter with the ac = character) TYPERD, XX / AND P177 / STRIP MODE BITS DCA VTCHAR / save it for output via IOA CIFIOA / -IOA- / JMS I IOACAL / 0 / CA / VTCHAR / ^A - ADDRESS OF STRING JMP I TYPERD / / VTCHAR, ZBLOCK 1 / holds the ascii character for display 0 / this 0 is the ascii string terminator CA, TEXT \^A\ / this is the control string for IOA /D011 / SUBROUTINE TO REPLACE THE 'CDF...' AND 'CIF...' [JMS] MAINLINE CODE /D011 / WITH THE ACTUAL '6FFN' IOT /D011 /D011 / THIS SUBROUTINE IS REQUIRED FOR MULTI-USER WPS-8 SYSTEMS /D011 /D011 CDFCIF, XX /D011 DCA TAC / TEMPORARILY SAVE THE CONTENTS OF THE AC /D011 RAL /D011 DCA TLINK / AND THE LINK /D011 RIF / 00F0: RIF GETS THE INSTRUCTION FIELD OF THIS PGM /D011 TAD CDF0 / 'TAD (CDF 0)' /D011 DCA CNNCNN /D011 CNNCNN, .-. / 'CDF' SAME AS 'IF' OF THIS PROGRAM /D011 AC7776 /D011 TAD CDFCIF / TO GET THE ADRS OF THE ADRS OF THE MAIN LINE CALLER /D011 DCA CNNCNN /D011 AC7777 /D011 TAD I CNNCNN / ADDRESS OF THE MAIN LINE CALLER /D011 DCA CNNCNN /D011 RIF / 00F0: /D011 TAD I CDFCIF / 'IF' 'ORED WITH CNN+USRFLX FOLLOWING JMS CIFCIF /D011 DCA I CNNCNN / REPLACES THE MAINLINE JMS WITH THE IOT /D011 TAD TLINK /D011 CLL RAR /D011 TAD TAC /D011 JMP I CNNCNN / JMP TO EXECUTE THAT IOT /D011 TAC, ZBLOCK 1 / HOLDS THE AC FOR THE SUBROUTINE CDFCIF /D011 TLINK, ZBLOCK 1 / HOLDS THE LINK FOR THE SUBROUTINE CDFCIF PAGE /***************************************************************************** / / The Field Name Buffer has been moved to field 4 and /a021 / has been enlarged to enable it to accomodate up to 30 /a021 / multinational and/or technical characters. /a021 / /***************************************************************************** / THE CONTENTS OF THE FN BUFFER [LOADED VIA JMS RD1CHR] / REPRESENT AN ASCII FROM A RECORD OF THE LIST DOCUMENT / / ONE ASCII CHARACTER PER 12-BITS / / FNBUFFER, F / I / E / L / D / N / A / M / E / [0] FNBUFFER TERMINATOR /d021 FNBUFFER, ZBLOCK KCCFNSIZE+1 / ----------------------------------------- / --THE FOLLOWING CODE IS ORDER IMPORTANT-- / ----------------------------------------- / 'KEY--FNTOTAL' COUNTERS ARE ORDER IMPORTANT / REPRESENTING 1 KEY WITHIN A RECORD / SINGLE KEY SORT: 1 'KEY--FNTOTAL' COUNTER IS NEEDED: KEY01FNTOTAL / 3 KEY SORT: 3 'KEY--FNTOTAL' COUNTERS ARE NEEDED: KEY01FNTOTAL / KEY02FNTOTAL / KEY03FNTOTAL / N KEY SORT: ETC. KEY01FNTOTAL, ZBLOCK 1 KEY02FNTOTAL, ZBLOCK 1 KEY03FNTOTAL, ZBLOCK 1 KEY04FNTOTAL, ZBLOCK 1 KEY05FNTOTAL, ZBLOCK 1 KEY06FNTOTAL, ZBLOCK 1 KEY07FNTOTAL, ZBLOCK 1 KEY08FNTOTAL, ZBLOCK 1 KEY09FNTOTAL, ZBLOCK 1 KEY10FNTOTAL, ZBLOCK 1 KEY11FNTOTAL, ZBLOCK 1 KEY12FNTOTAL, ZBLOCK 1 /KEY13FNTOTAL, ZBLOCK 1/ MUST EXPAND THE WORDS 'ORDER' AND 'FTYPE' /KEY14FNTOTAL, ZBLOCK 1 /KEY15FNTOTAL, ZBLOCK 1/ MUST REDEFINE DATA STRUCTURE AND 'KKKK' WITHIN [VAT] //////// KEEP GOING (REALISTICALLY NOW) UNTIL YOUR LITTLE HEART DESIRES //////// MAXKEY=.-KEY01FNTOTAL / MAX # OF KEY S TO SORT ON / PERMITTED BY THIS PROGRAM -1 / [-1] TERMINATOR /m0013 / MAKING MULTI-KEY SORT [ UP TO NN KEYS ] / INVISIBLE TO THIS PROGRAM / ----------------------------------------- / --THE PREVIOUS CODE WAS ORDER IMPORTANT-- / ----------------------------------------- / / ACCENTED CHARACTER PROCESSORS / / / THIS SERIES OF ROUTINES IS CURRENTLY USED TO CONVERT THE SINGLE AND / MULTI STROKE ACCENTED CHARACTERS PRESENT IN FOREIGN LANGUAGE SYSTEMS / TO A SINGLE CHARACTER TO BE USED IN THE SORT. / / AT PRESENT, ANY ACCENTED CHARACTER IS TREATED AS IF IT HAD APPEARED / WITH NO ACCENT. FOR EXAMPLE, AN ACCENT AGU 'A' WILL BE SORTED AS AN / 'A' WITH NO ACCENT. THIS SCHEME MAY OR MAY NOT BE MODIFIED FOR FUTURE / RELEASES OF THE SOFTWARE. / / / / / DEAD KEY SEQUENCE PROCESSOR DEAD, JMS ZRDNXCH / DEAL WITH DEAD KEY CHARACTERS IN THE /A021 JMP RD1EOF / SORT COLLATING SEQUENCE. /A021 AND P177 / GET THE FIRST CHARACTER OF THE DEAD /A021 TAD NEGSPC / SEQUENCE, MINUS MODE BITS, AND TEST /A021 SZA / IS IT A SPACE? /A021 JMP DEDNRM / NO, IT IS A USER DEAD KEY SEQUENCE /A021 JMS ZRDNXCH / YES, GET THE NEXT CHARACTER TO SEE /A021 JMP RD1EOF / WHICH CHARACTER SET IT COMES FROM OR /A021 / IF IT IS A HARD SPACE. /A021 AND P177 / GET THE CHARACTER WITHOUT MODE BITS /A021 TAD NEGSPC / TEST FOR A HARD SPACE /A021 SNA / IS IT A HARD SPACE? /A021 JMP DEDNRM / YES, OUTPUT SPACE /A021 TAD DEDSPC / NO, GET CHARACTER BACK /A021 RAR / GET THE LSB INTO THE LINK /A021 SZL CLA / IS THIS A TECH OR LINE CHARACTER? /A021 JMP DEADTL / YES, DEAL WITH IT /A021 JMS ZRDNXCH / NO, GET THE MULTINATIONAL CHARACTER /A021 JMP RD1EOF / CODE /A021 AND P177 / GET THE CODE SANS MODE BITS /A021 /D023 RAL / DOUBLE IT /A021 TAD (EQUTB) / ADD THE BASE ADDRESS OF THE EQUIVELENC/A021 DCA EQUTBA / TABLE IN PANEL AND SAVE IN THE PR3 /A021 PR3 / MAKE THE PANEL REQUEST TO GET THE /A021 5054 / EQUIVELENCE CHARACTER /M023 /A021 EQUTBA, XX / ADDRESS IN EQUIVALENCE TABLE /A021 DCHAR1 / THE EQUIVALENCE CHARACTER STORE /A021 -2 / THE MINIMUM NO OF WORDS YOU CAN XFER /A021 -1 / PR TERMINATOR /A021 JMP DEDOUT / RETURN CHARACTER TO MAIN LOOP /A021 DEADTL, JMS ZRDNXCH / GET THE TECHNICAL OR LINE DRAWING /A021 JMP RD1EOF / CHARACTER /A021 DCA DCHAR1 / SAVE IT WHILE LOOKING FOR END DEAD /A021 JMP DEDOUT DEDNRM, TAD DEDSPC / RECONSTITUTE FIRST CHARACTER OF USER /A021 DCA DCHAR1 / DEAD KEY SEQUENCE /A021 DEDOUT, JMS ZRDNXCH / GET A CHARACTER UNTIL END DEAD IS /A021 JMP RD1EOF / SEEN. /A021 TAD (-15) / /A021 SZA CLA / /A021 JMP DEDOUT / /A021 DCA DEADKEY / ZERO THE DEAD KEY FLAG, AS END FOUND /A022 SNGLXT, TAD DCHAR1 / COPY THE CHARACTER TO THE RETURN /A021 DCA CHARIN / RETURN VARIABLE /A021 TAD DCHAR1 / ALSO COPY INTO THE CHR177 VARIABLE /A021 AND P177 / AS THE MASKED VERSION /A021 DCA CHR177 / /A021 JMP RD1EXIT /A021 //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / SINGLE ACCENTED CHARACTER PROCESSOR SINGLE, TAD RDFLAG / CHECK MAINLINE CODE SMA SZA CLA / AC>0 MEANS 'ODG' JMP RDNOB1 / NO PROCESSING IF 'ODG' TAD CHARIN / GET CHARACTER AND (7600) / MASK OFF CHARACTER DCA DCHAR1 / SAVE MODE BITS TAD CHARIN / GET CHARACTERS AND P177 / MASK OFF MODE BITS DCA DCHAR2 / SAVE CHARACTERS TAD (TBL2) / GET TABLE ADDRESS DCA DADDR1 / SAVE IN TEMP POINTER SNGLP1, TAD I DADDR1 / GET TABLE ENTRY ISZ DADDR1 / INCREMENT POINTER SNA / CHECK FOR END OF TABLE JMP RDNOB1 / END OF TABLE DETECTED TAD DCHAR2 / CHECK FOR MATCH SNA CLA JMP SINGL2 / WE HAVE A MATCH ISZ DADDR1 / NO MATCH. INCREMENT ADDRESS. JMP SNGLP1 / CONTINUE SEARCH SINGL2, TAD I DADDR1 / GET SUBSTITUTE CHARACTER /D021 TAD DCHAR1 / RETRIEVE MODE BITS /D021 DCA CHARIN / SAVE NEW CHARACTER /D021 JMP RDNOB1 / RETURN TO MAIN PROCESSING JMP SNGLXT / EXIT VIA ROUTINE TO SAVE CHARS /A021 //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / / / TEMPORARY STORAGE / / DCHAR1, 0 / TEMP CHARACTER STORAGE DCHAR2, 0 / TEMP CHARACTER STORAGE DADDR1, 0 / TEMP ADDRESS POINTER DEDSPC, 40 / ASCII VALUE OF A SPACE /A021 NEGSPC, -40 / NEGATIVE ASCII VALUE OF A SPACE /A021 EQUTB=SORTBL / COLLATING SEQUENCE EQUIVALENCE TABLE //\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ / / / ACCENTED CHARACTER TABLES / / TBL1, IFDEF ENGCAN < -140 / ACCENT GRAVE -136 / CIRCUMFLEX -176 / UMLAUT > IFDEF CANADA < -140 / ACCENT GRAVE -136 / CIRCUMFLEX -176 / UMLAUT > IFDEF FRENCH < -136 / ACCENT AGU -176 / UMLAUT > 0 TBL2, IFDEF ENGCAN < -173; 141 / AGU E > IFDEF CANADA < -173; 141 / AGU E > IFDEF FRENCH < -100; 141 / GRAVE A -173; 145 / AGU E -174; 165 / GRAVE U -175; 145 / GRAVE E > 0 PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// MERGE .PA - MULTI-KEY MERGE \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / MERGE SUBROUTINE / TO 'SET-UP' PARAMATERS FOR THE MERGE MRGSETUP, XX TAD (7401) / WPS-8 DOCUMENT BLOCK IDENTIFIER CDFEDT DCA I (OUTBLOCK) / 7401 DCA I (OUTBLOCK+1) / 0 CDFMYF DCA FIRSTBLOCK / [0] MEANS NO SCRATCH CHAIN, YET JMP I MRGSETUP / MERGE SUBROUTINE / TO SET THE DRIVE NUMBER WITHIN QURX:: 'QDRV' / IDENTICAL TO THE OUTPUT DOCUMENT DRIVE MGQDRV, XX TAD SOTFL / DDDDNNNNNNNN AND (7400) BSW CLL RTR DCA QDRV JMP I MGQDRV / EXIT QUQDRV / ALLOCATE (SETUP) THE 1ST BLOCK OF THE SCRATCH CHAIN; AND 'WTQBLK' SETFIRSTBLOCK, XX JMS QUXEAL /ALLOCATE 1 SCRATCH BLOCK DCA FIRSTBLOCK / TO BECOME THE 1ST IN A CHAIN OF SCRATCH BLOCKS TAD FIRSTBLOCK DCA WTQBLK / SETTING UP 'WTQBLK' WITH NEXT BLOCK # TO BE 'WRITTEN' JMP I SETFIRSTBLOCK FIRSTBLOCK, ZBLOCK 1 / 1ST BLOCK # OF THE SCRATCH CHAIN SETINVLENGTH, XX TAD INVVAT / /m0013 BSW AND (VVVVV) CIA DCA INVLENGTH TAD (-4) TAD INVLENGTH DCA INLENGTH JMP I SETINVLENGTH / ........................................ /THIS IS THE START OF THE MERGE; THEREFORE / ........................................ / ENTRY TO HERE AFTER SORT HAS ORDERED THE FNVAR TABLE / BECAUSE THE FNV BUFFER - FNVAR TABLE VOLUME HAS FILLED-UP / OR AN INPUT DOCUMENT EOF OCCURED MERGE, XX / MERGE ENTRY PORT ISZ MBUSY / [1] MEANS 'MERGE' IS THE MAIN-LINE TAD (OUTBLOCK+HEADER) /m0013 DCA OUTTOP / MAKES THE 'OUTBLOCK' BUFFER LOOK EMPTY TAD (FNVARBUFFER+1) DCA FNVAR / SET TO THE TOP OF THE (SORTED) RECORD POINTER LIST TAD (INBLOCK) DCA INFLADR / 'FLOATING' TOP ADDRESS OF 'INBLOCK' BUFF (SEE 'NEXTIN') JMS MGQDRV / SET THE DRIVE # SAME AS OUTPUT DOC DRIVE # / FILL-OUT THE NEXT 4 WORDS WITHIN THE FNV BUFFER / BECAUSE 'ODG' LOOKS FOR THE CONTENTS OF 'VAT' = 0000 / WHICH IS THE INTERNAL SIGNAL MEANING THE END OF THE FNV BUFFER DCAFNV / [0] DCAFNV / [0] DCAFNV / [0] DCAFNV / [0] / IF DISKETTE SCRATCH BLOCKS HAVE BEEN PREVIOUSLY ALLOCATED / (WHICH CONTAIN SORTED FNV BUFFER PACKETS) / THEN MERGE THE PRESENT CONTENTS OF THE FNV BUFFER / WITH THE SORTED FNV BUFFER PACKETS TAD FIRSTBLOCK / 1ST BLOCK OF THE SCRATCH CHAIN SZA / SKIP NEXT MEANS [0] NO SCRATCH CHAIN YET JMP MERGE2 / MERGE THE FNV BUFFER WITH THE FNV PACKETS / WRITE-OUT THE CONTENTS / OF THE FNV BUFFER (AS PER THE SORTED ORDER OF THE FNVAR BUFFER) / INTO THE DISKETTE SCRATCH BLOCKS / WHICH WILL BE ALLOCATED AS NEEDED WITHIN 'WT1SCRATCH' JMS SETFIRSTBLOCK / SET THE 1ST BLOCK OF THE SCRATCH CHAIN (AND 'WTQBLK') /\ JMP WTFNV / WRITE ALL (RECORDS) WITHIN THE FNV BUFFER / ---------------- / --END OF MERGE-- THE LOGICAL END OF THE INPUT BUFFER HAS BEEN FOUND / ---------------- / WRITE-OUT THE CONTENTS OF THE FNV BUFFER IN THE SORTED ORDER OF THE FNVAR TABLE / THE DATA IS MOVED FROM THE FNVAR BUFFER TO THE OUTPUT BLOCK BUFFER / 1 WORD AT A TIME VIA 'FXOUT' WTFNV, JMS TADVAR / VTOP / GET A RECORD ADDRESS POINTER ENDI, JMS WT1FNV JMP .-2 / UNTIL A 0 VAT FOUND JMS FXOUT / 4-0'S ISZ LENGTH JMP .-2 JMP WTLASTOUT / WRITE THE FINAL (NOT NECESSARILY LAST) BLOCK / TRANSFER 1 RECORD'S WORTH OF DATA FROM THE FNV BUFFER TO THE OUTPUT BUFFER / (NOTE THAT THE POINTER TO THAT RECORD'S WORTH OF DATA WITHIN THE FNV BUFFER) / (WAS ALREADY POPPED FROM THE FNVAR TABLE WHICH MEANS THAT A 'JMS TADVAR') / (WAS EXECUTED SOME TIME PRIOR TO ENTERING 'WT1FNV') / JMS WT1FNV; RETURN HERE; BUT VAT=0 RETURNS HERE WT1FNV, XX UNTIL0, AC0003 TAD VTOP DCA VVTOP JMS GETVV / [VAT] DCA WT1TMP / TEMP TAD WT1TMP BSW AND (VVVVV) CIA TAD (-4) DCA LENGTH / -VVVVV-4 TAD WT1TMP SNA CLA JMP VAT0 / VAT=0 / EXIT IS TO RETURN+1 JMS FXOUT /'QUXEAL'/ MOVE THE DATA FOR THIS RECORD ISZ LENGTH / FROM THE FNV BUFFER TO THE OUTPUT BUFFER JMP .-2 / UNTIL ALL ELEMENTS MOVED TAD WT1TMP AND (MKSBIT) SZA CLA JMP UNTIL0 SKP VAT0, ISZ WT1FNV /RETURN+1 JMP I WT1FNV WT1TMP, ZBLOCK 1 LENGTH, ZBLOCK 1 / ---------------- / --END OF MERGE-- THE LOGICAL END OF THE FNV BUFFER HAS BEEN FOUND / ---------------- IXOLOOP,JMS INXOUT ENDFNV, TAD INTOP TAD PEIBLOCK / (-INBLOCK-400) SPA CLA / SKIP NEXT IF 'INPUT' BUFFER HAS BEEN EMPTIED JMP IXOLOOP TAD RDQBLK / GET NEXT BLOCK # TO BE 'READ' /\ JMP WTLASTOUT / AC = BLOCK # (NOT ZERO) / WRITE THE LAST SCRATCH BLOCK (COULD BE A PARTIAL BLOCK WITHIN THE CHAIN) / (NOTE THAT ENTRY WITH THE CONTENTS OF THE AC=0 MEANS AT THE END OF THE CHAIN) / (AND THAT WHEN THE AC IS NOT ZERO THAN WITHIN THE CHAIN) WTLASTOUT, JMS WT1SCRATCH / 'JMS' WITH (AC) = 0 MEANS --END OF CHAIN-- DCA MBUSY / [0] / CLEAR JMP I MERGE MBUSY, ZBLOCK 1 / =1 MEANS THE MAIN-LINE IS 'THE MERGE' PAGE / SCRATCH BLOCKS HAVE BEEN ALLOCATED / ON THE OUTPUT DOCUMENT DRIVE / THEREFORE [MERGE] THE CONTENTS OF THE FNV BUFFER / WITH THE CONTENTS OF THOSE SCRATCH BLOCKS / AS PER THE ORDER OF THE 'FNVAR' BUFFER / ............................................................................. / 'NEXTIN' MUST BE THE ONLY GUY TO READ SCRATCH BLOCKS / ............................................................................. MERGE2, DCA RDQBLK / ENTERED WITH (AC) = 1ST BLOCK OF SCRATCH CHAIN JMS SETFIRSTBLOCK /'WTQBLK'/ 'JMS' MAKES A NEW ('1ST' BLOCK) SCRATCH CHAIN / TAD (INBLOCK) / 'FYI' / (FOR YOUR INFORMATION) / DCA INFLADR / TAD (INBLOCK) DCA INTOP DCA PEIOFFSET/ [0] / /m0013 JMS NEXTIN /'RDQBLK' / NEWFNV, JMS TADVAR / SET 'VTOP' / FNVAR=FNVAR-1 NEWIN, TAD SORTKEY CIA DCA XSORTKEY DCA KEYID / 0 TAD ORDER JMP .+3 NEWKEY, TAD SORTORDER CLL RAL DCA SORTORDER ISZ KEYID / 1; 14 / ............................................................................. / TO INCREASE THE PERFORMANCE OF A SINGLE KEY SORT ONLY:: / IF THIS IS A SINGLE KEY SORT (THE CONTENTS OF 'SORTKEY' = 1) / THEN WE KNOW THE 'VAT' ADDRESS ALREADY / NO NEED TO 'KEYSEARCH' TAD SORTKEY / 1; 14 CLL RAR SZA CLA JMP .+4 / 'JMP' MEANS THIS IS A MULTI KEY SORT AC0003 / [3] TAD VTOP / (VTOP) PREVIOUSLY SET WITHIN 'TADVAR' JMP .+3 / 'JMP' TO 'DCA VVTOP' TAD FNVAR JMS KEYSEARCH / SEARCH FOR THE 'VAT' ADDRESS DCA VVTOP / SAVE THE [VAT] SLOT ADDRESS WITHIN THE FNV FOR THIS KEY / ............................................................................. JMS GETVV / [VAT] SNA JMP ENDFNV / [0] / ZERO [VAT] FOUND MEANS END IF FNV BUFFER BSW AND (VVVVV) CIA DCA VLENGTH / -VVVVV /\ JMP .+1 TAD INTOP DCA INVTOP SEARCH, TAD (3) TAD INVTOP DCA INVTOP JMS GETINV / [VAT] SNA JMP ENDI / END OF THE INPUT BUFFER FOUND [0 VAT] DCA INVVAT / /m0013 TAD INVVAT / /m0013 AND (KKKK) CIA TAD KEYID SNA CLA JMP FOUND / KEY FOUND TAD INVVAT / /m0013 BSW AND (VVVVV) SNA JMP SEARCH / VVVVV=0 CIA DCA INVVAT / /m0013 JMS GETINV CLA ISZ INVVAT / /m0013 JMP .-3 JMP SEARCH INVVAT, ZBLOCK 1 / /m0013 FOUND, JMS SETINVLENGTH / SETUP 'INVLENGTH' (AND 'INLENGTH') TAD VLENGTH TAD INVLENGTH SNA CLA JMP BOTH0 / BOTH 'VVVVV'ALUES ARE NULL TAD VLENGTH SNA CLA JMP FNVWINS TAD INVLENGTH SNA CLA JMP INWINS /\ JMP VALCOMP / THE FNV VAT ELEMENT AND THE SCRATCH VAT ARE BOTH (+) / THEREFORE COMPARE THE 6-BIT VALUE CHARACTERS 2X2 / AS 12-BIT WORDS / AND PUT THE WINNER TO THE 'OUT' BLOCK BUFFER VALCOMP,JMS GETVV / GET 1 ELEMENT FROM THE FNV BUFFER DCA GETVV / SAVE IT USING 'GETV' AS TEMP STORAGE JMS GETINV / [IN] / GET 1 ELEMENT FROM THE INPUT BUFFER CLL CIA TAD GETVV / [FNV] SNA CLA JMP .+4 / BOTH 2X2 CHARACTERS ARE THE SAME SZL JMP FNVWINS / 'FNV' BIGGER JMP INWINS / 'IN' BIGGER ISZ INVLENGTH / +1 TO THE INPUT 'V'ALUE COUNTER JMP ISZVLENGTH / / IN VALUE COUNTER OVERFLOW ISZ VLENGTH / +1 TO THE FNV 'V'ALUE COUNTER JMP FNVWINS / FNV HAS MORE TO GO SO IT'S THE WINNER BOTH0, ISZ XSORTKEY JMP NEWKEY JMP INWINS / IN VALUE COUNTER DID NOT OVERFLOW ISZVLENGTH, ISZ VLENGTH / +1 TO THE FNV 'V'ALUE COUNTER JMP VALCOMP / GET MORE 2X2 CHARACTERS / FNV VALUE COUNTER OVERFLOW JMP INWINS / 'IN' HAS MORE DATA TO GO SO IT'S THE WINNER VLENGTH, ZBLOCK 1 INVLENGTH, ZBLOCK 1 XSORTKEY, ZBLOCK 1 / THE NEGATIVE FROM 'SORTKEY' PAGE / TRANSFER THE RECORD ELEMENT WINNER / RESIDING WITHIN THE INPUT BUFFER / TO THE OUTPUT BUFFER INWINS, TAD SORTORDER SMA CLA JMP FNV2OUT IN2OUT, AC0003 TAD INTOP DCA INVTOP JMS GETINV / [VAT] DCA INVVAT / m0013 JMS SETINVLENGTH / SETUP 'INLENGTH' (AND 'INVLENGTH') IOLOOP, TAD INTOP TAD PEIBLOCK SPA CLA JMP JMSINXOUT TAD (INBLOCK) DCA INFLADR TAD (INBLOCK) DCA INTOP DCA PEIOFFSET/ [0] / /m0013 JMS NEXTIN JMSINXOUT,JMS INXOUT / INTOP+1/ POP INPUT/PUSH OUTPUT ISZ INLENGTH/-100;-4/ UNTIL (INLENGTH)=0 JMP IOLOOP / MEANS ALL KEYS FOR THAT RECORD MOVED TAD INVVAT / /m0013 AND (MKSBIT) SNA CLA JMP NEWIN JMP IN2OUT / UNTIL 'VAT' MKS-BIT = 0 INLENGTH, ZBLOCK 1 / TRANSFER THE RECORD ELEMENT WINNER / RESIDING WITHIN THE FNV BUFFER / TO THE OUTPUT BUFFER FNVWINS,TAD SORTORDER SMA CLA JMP IN2OUT FNV2OUT,JMS WT1FNV /'FXOUT'/ (IMBEDDED 'JMP ENDFNV' WITHIN 'WT1FNV' IF VAT=0) JMP NEWFNV / NORMAL RETURN FROM 'WT1FNV' JMP ENDFNV / VAT=0 / RETURN HERE WHEN THE VAT IS ZERO / POP AN ELEMENT FROM THE FNV BUFFER / AND PUSH IT INTO THE OUTPUT BLOCK BUFFER FXOUT, XX TAD FXOUT DCA INXOUT CDFFNV TAD I VTOP ISZ VTOP NOP JMP XXXOUT VTOP, FNVBUFFER / POP AN ELEMENT FROM OF THE INPUT BLOCK BUFFER / AND PUSH IT INTO THE OUTPUT BLOCK BUFFER INXOUT, XX TAD INTOP CIA TAD INFLADR SZA CLA JMP INXCDFEDT TAD (HEADER) / /m0013 TAD INTOP DCA INTOP AC7777 TAD INLENGTH DCA INLENGTH JMP I INXOUT INXCDFEDT, CDFEDT TAD I INTOP ISZ INTOP SKP / 'SKP' IS FASTER THAN AN 'IOT' XXXOUT, CDFEDT DCA I OUTTOP ISZ OUTTOP CDFMYF TAD OUTTOP TAD (-OUTBLOCK-400) SPA CLA / SKIP NEXT IF 'OUTPUT' BUFFER FULL JMP I INXOUT JMS QUXEAL / ALLOCATE 1 DISK BLOCK JMS WT1SCRATCH / OUTPUT BLOCK FILLED-UP JMP I INXOUT INTOP, INBLOCK+HEADER / /m0013 OUTTOP, OUTBLOCK+HEADER / /m0013 / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . / INBLOCK, 7401 OUTBLOCK, 7401 / 0 0 / NEXT BNO --CARRY-IT-OVER--> NEXT BNO / ALWAYS THE NEXT / / BLOCK # TO READ / [RESERVED] [RESERVED] / / DATA FROM READ DATA FOR WRITE / . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . GETI2, XX CDFEDT TAD I (INBLOCK+2) CDFMYF JMP I GETI2 GETI3, XX CDFEDT TAD I (INBLOCK+3) CDFMYF JMP I GETI3 GETO2, XX CDFEDT TAD I (OUTBLOCK+2) CDFMYF JMP I GETO2 PUTO2, XX CDFEDT DCA I (OUTBLOCK+2) CDFMYF JMP I PUTO2 TADVAR, XX AC7777 TAD FNVAR DCA FNVAR / FNVARBUFFER, ..-1, ..-2, ..-3, ..ETC CDFFNV TAD I FNVAR CDFMYF IAC DCA VTOP JMP I TADVAR PAGE PEIBLOCK,-INBLOCK-400 / (-#) FLOATING PHYSICAL END ADRS OF 'INBLOCK' BUFFER SLOP= KCCVALUE%2+4^MAXKEY&400 IFZERO SLOP OUTBLOCK= 6400 / OF THE 'EDITOR' FIELD INBLOCK= OUTBLOCK-400-SLOP/ OF THE 'EDITOR' FIELD RDQBLK, ZBLOCK 1 /NEXT # TO BE READ / WE RAN OUT OF CHARACTERS FROM THE 'INBLOCK' BUFFER NEXTIN, XX TAD RDQBLK /GET THE BLOCK # TO BE READ JMS RD1BLOCK / READ 1 SCRATCH BLOCK INFLADR, INBLOCK / FLOATS/ INTO MEMORY STARTING AT THE ADDRESS WITHIN 'INFLAD' TAD RDQBLK JMS QUXEFR / DEALLOCATE THE BLOCK JUST READ AC0002 TAD INFLADR DCA T3 / (INFLADR)+2 CDFEDT TAD I T3 / 'NEXT' BLOCK # TO BE 'READ' DCA RDQBLK / '--CARRY--IT--OVER-->' ISZ T3 / (INFLADR)+3 TAD I T3 /-400;-4/ NEGATIVE # OF 'VALAD' WORDS JUST READ CDFMYF TAD PEIOFFSET/-400;0/ NEGATIVE OFFSET; ELSE 0; REMEMBER ? /m0013 TAD (-INBLOCK) DCA PEIBLOCK / '-INBLOCK-400-X' JMP I NEXTIN PUSHUP, XX CDFEDT UPLOOP, TAD T1 TAD PEIBLOCK SMA CLA JMP .+6 TAD I T1 DCA I INFLADR ISZ T1 ISZ INFLADR JMP UPLOOP CDFMYF JMP I PUSHUP / GET 1 ELEMENT FROM THE FNV BUFFER GETVV, XX CDFFNV TAD I VVTOP CDFMYF ISZ VVTOP NOP JMP I GETVV VVTOP, FNVBUFFER+3 / GET 1 ELEMENT FROM THE INPUT BUFFER GETINV, XX INVLOOP,TAD PEIBLOCK / (-INBLOCK-400) TAD INVTOP SPA CLA JMP TADINVTOP / THERE IS NO MORE DATA IN THE INPUT BUFFER TO GET VIA 'GETINV' / THEREFORE 'PUSHUP' ALL DATA BETWEEN (INTOP) AND (INVTOP) TAD INTOP CIA TAD INFLADR / (COULD BE '#INBLOCK') SNA JMP MOVUP4 / (INTOP) IS SAME AS (INFLADR) SPA CLA JMP MOVTOP / (INTOP) IS GREATER THAN (INFLADR) / (INTOP) IS LESS THAN (INFLADR) TAD INFLADR TAD (HEADER)/ [4] / /m0013 DCA T1 JMS PUSHUP / ... USING 'T1' ... TAD (HEADER)/ [4] / /m0013 TAD PEIBLOCK DCA PEIBLOCK TAD (-HEADER) / /m0013 TAD INVTOP DCA INVTOP SKP MOVUP4, TAD (HEADER) / /m0013 MOVTOP, TAD INTOP DCA T1 TAD T1 CIA TAD INVTOP TAD (INBLOCK) DCA INVTOP TAD T1 TAD PEIBLOCK DCA PEIOFFSET / /m0013 TAD (INBLOCK) DCA INFLADR TAD (INBLOCK) DCA INTOP JMS PUSHUP / ... USING 'T1' ... JMS NEXTIN / JMP INVLOOP / BECAUSE (INVTOP) MAY STILL BE PAST (PEIBLOCK) PEIOFFSET, ZBLOCK 1 / /a0013 TADINVTOP, TAD INVTOP CIA TAD INFLADR SMA SZA JMP INVCLA / (INVTOP) IS LESS THAN (INFLADR) SMA JMP INVAC4 / (INVTOP) IS SAME AS (INFLADR) TAD (HEADER) / /m0013 SPA SNA CLA JMP INVCLA / (INVTOP) IS SAME AS (INFLADR) OR IS BETWEEN (INFLADR THRU INFLADR+header) INVAC4, TAD (HEADER)/ [4] / /m0013 TAD INVTOP DCA INVTOP JMP INVLOOP INVCLA, CLA CDFEDT TAD I INVTOP CDFMYF ISZ INVTOP NOP JMP I GETINV INVTOP, INBLOCK+HEADER+3 / THE SAME AS (INTOP)+3 /m0013 /***************************************************************************** / / Code here is inserted to access the new FNBUFFER, which now /a021 / resides in FIELD 4. This has been moved to provide enough /a021 / room for upto 30 multinational or technical characters in the /a021 / field name. /a021 / /**************************************************************************** XFNBPSH,XX / Routine to put a character in FNBUFFER/a021 / at the address given in FN /a021 CDFFNB / Change to the FNBUFFER field /a021 DCA I FN / Save the value via FN /a021 CDFMYF / Change back to my field /a021 JMP I XFNBPSH / Return /a021 XFNBGET,XX / Routine to get a character from the /a021 / FNBUFFER at the address given in FN /a021 CDFFNB / Change to the FNBUFFER field /a021 TAD I FN / Add the value pointed to by FN to AC /a021 CDFMYF / Change back to my field /a021 JMP I XFNBGET / Return /a021 PAGE HEADER= 4 /m0013 / ........................................................................... /0 OUTBLOCK, 7401 /1 0 /2 NEXT BLOCK # /3 -# ('VALAD' VOLUME) /4 DATA /5 DATA /THRU 255 WORDS / ........................................................................... / WRITE 1 SCRATCH BLOCK / CALL:: AC????; JMS WT1SCRATCH / ENTER WITH THE CONTENTS OF THE (AC) = NEXT BLOCK # OF CHAIN, WHILE / THE CONTENTS OF PROGRAM LOCATION 'WTQBLK' = 'THIS' BLOCK # TO BE WRITTEN WT1SCRATCH, XX JMS PUTO2 / NEW NEXT BLOCK (OF THE CHAIN) / CALCULATE THE USED VOLUME OF THE OUTPUT BUFFER / (INCLUDING THE 4 HEADER WORDS) / AND PLACE THAT N-E-G-A-T-E-D VALUE INTO 'OUTBLOCK+3' TAD OUTTOP CIA TAD (OUTBLOCK) CDFEDT DCA I (OUTBLOCK+3) TAD .-2 / 'CDFEDT' CDFMYF DCA QBFD / THE DATA ('EDITOR') FIELD OF THE DATA TAD (OUTBLOCK) DCA QBAD / TOP ADDRESS WITHIN THAT ('EDITOR') FIELD TAD WTQBLK DCA QBLK / THE BLOCK # TO BE WRITTEN WITH THAT DATA JMS QUXEWT TAD (OUTBLOCK+HEADER) /m0013 DCA OUTTOP / (MAKES THE OUTPUT BLOCK BUFFER LOOK EMPTY) JMS GETO2 DCA WTQBLK / THE NEXT BLOCK # TO BE WRITTEN / . . . . . . . . . . . . . . . . . . . . . . . . . . JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN JMS XXHLTFLG / TEST FOR 'GOLD HALT' / . . . . . . . . . . . . . . . . . . . . . . . . . . JMP I WT1SCRATCH WTQBLK, ZBLOCK 1 / PRESERVES THE BLOCK # TO BE WRITTEN 'NEXT' / MERGE SUBROUTINE / TO DEALLOCATE ALL BLOCKS ALLOCATED / ... THE DRIVE # MUST ALREADY BE SET WITHIN QDRV MRGEFRALL, XX FREEALL,TAD FIRSTBLOCK / FIRST TIME EVER IS FIRST BLOCK OF THE SCRATCH CHAIN SNA JMP I MRGEFRALL / 0 MEANS ALREADY FREED-UP THE LAST BLOCK ALLOCATED JMS FREE1 JMP FREEALL / UNTIL ALL BLOCKS ALLOCATED HAVE BEEN FREED-UP / SUBROUTINE TO DEALLOCATE (FREE-UP) 1 DISKETTE SCRATCH BLOCK / ENTER WITH THE (AC) = BLOCK # TO DEALLOCATE AFTER THE READ IS COMPLETE FREE1, XX JMS RD1BLOCK / 'READ' THE BLOCK (TO GET NEXT BLOCK # OF CHAIN) INBLOCK / INTO A BUFFER CALLED 'INBLOCK' (OF 'EDITOR' FIELD) TAD QBLK JMS QUXEFR / 'OFFICALLY' DEALLOCATE VIA 'QURX::' JMS GETI2 / GET NEXT BLOCK # WITHIN CHAIN (0 MEANS NO MORE) SNA JMS QUXERT / REWRITE' ALLOCATION BLOCK DCA FIRSTBLOCK / AND MAKE IT THE NEW FIRST BLOCK OF THE CHAIN JMP I FREE1 ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// QURX .PA - SUBROUTINES TO QUEUE RXHAN \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! QURX !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! QURX, XX CIFSYS ENQUE QUBLK QURXJWAIT, CIFSYS JWAIT CLA TAD QUQBLK+RXQCOD SNA CLA / CHANGE 'SNA CLA' TO 'SNA' WHEN DOING 'FNC+4000' JMP QURXJWAIT / EXIT WITH THE (AC) MINUS MEANS A DISK ERROR WAS DETECTED BY THE DISK HARDWARE / [EXITING WITH THE (AC) MINUS WAS MADE POSSIBLE BY THE FUNCTION+4000] / EXIT WITH THE (AC) POS MEANS THE QURX COMPLETED SUCCESSFULLY JMP I QURX / ------------------------------------ / -------- ORDER IMPORTANT -------- / ------------------------------------ QUBLK, DSKQUE; 0; 0 QUQBLK, QCOD, 0 / R ECCCCCCCCCCC: COMPLETETION CODE QFNC, 0 / W FFFFFFFFFFFF: FUNCTION TO DO:: / +2000 WITH A PHYSICAL OR / +4000 WITH ANY FUNCTION / LOGICAL WRITE / MEANS THAT RXHAN WILL / MEANS THAT AFTER THE / RETURN PROGRAM CONTROL / FUNCTION IS COMPLETED / TO THE CALLING PROGRAM / RXHAN WILL ISSUE A / INSTEAD OF THE OPERATING SYSTEM / HARDWARE READ OF THE / UPON THE DETECTION / BLOCK JUST WRITTEN. / OF A DISK ERROR. / / / THE DATA OF THAT / THE CALLING PROGRAM WILL / BLOCK WILL BE READ / PROCESS THE ERROR. / INTO THE HARDWARE / / SCRATCH PAD MEMORY. / / RXERT= 0 / :: RESET DIR AND ALLOC MEMORY BLOCK / RXEPR= RXERT+1 / :: PHYSICAL READ / RXEPW= RXEPR+1 / :: PHYSICAL WRITE / RXERD= RXEPW+1 / :: LOGICAL READ / RXEWT= RXERD+1 / :: LOGICAL WRITE / RXEAL= RXEWT+1 / :: ALLOCATE A BLOCK / RXEFR= RXEAL+1 / :: DEALLOCATE A BLOCK / RXEGF= RXEFR+1 / :: GET BLOCK # OF THE FIRST BLOCK [THE HDR] / FOR THE FILE # WITHIN QFNO / RXESF= RXEGF+1 / :: SET BLOCKNO TO FIRST BLOCK / RXESP= RXESF+1 / :: GET # OF FREE BLOCKS ON DISKETTE QDN1, 0 / DRIVE NAME WORD #1 QDN2, 0 / DRIVE NAME WORD #2 QFNO, 0 / R/W 0000NNNNNNNN: FILE # QID1, 0 / PLASTIC ID QSPC, 0 / R 00##########: # FREE BLOCKS ON DISKETTE QCTL, 0 / CONTROLLER BITS FOR PATCHING COMMANDS QDRV, 0 / W MMMMMMMMDDDD: MODE BITS FOR LCD; DRIVE # QBLK, 0 / R/W BLOCK # QRS1, 0 /* RESERVED QBAD, 0 / W AAAAAAAAAAAA: ADDRESS OF READ/WRITE BUFFER QBFD, 0 / W 62F1: CDF TO THE FIELD / OF THE ADDRESS / OF THE READ/WRITE BUFFER / WITHIN QBAD QTRK, 0 / TRACK # QSEC, 0 / SECTOR # / ------------------------------------- / -------- END ORDER IMPORTANT -------- / ------------------------------------- / QURX SUBROUTINE TO RESET ALLOCATION OR DIRECTORY BLOCK / ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV / EXIT WITH AC = 0 QUXERT, XX / TAD KRXERT DCA QFNC / 0 JMS QURX JMP I QUXERT / QURX SUBROUTINE TO GET THE # OF FREE BLOCKS REMAINING ON THE DISKETTE / ...THE DRIVE # MUST ALREADY BE SET WITHIN QDRV / EXIT WITH THE CONTENTS OF THE AC = THE NUMBER OF FREE BLOCK REMAINING / - HARDWARE ERROR WHILE TRYING TO GET AVAILABLE DISKETTE SPACE COULD OCCUR QUXESP, XX TAD KRXESP / FUNCTION DCA QFNC / INTO QUBLK JMS QURX / JMS TO EXECUTE THE FUNCTION TAD QSPC / GET THE # OF FREE BLOCK REMAINING JMP I QUXESP / EXIT QUXESP / QURX SUBROUTINE TO DEALLOCATE 1 DISKETTE BLOCK / ENTERED WITH THE CONTENTS OF THE AC = THE BLOCK # TO BE DEALLOCATED / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / - HARDWARE ERROR WHILE TRYING TO DEALLOCATE 1 BLOCK COULD OCCUR QUXEFR, XX DCA QBLK / TAD KRXEFR AC0006 DCA QFNC JMS QURX / JMS TO EXECUTE THE FUNCTION JMP I QUXEFR / EXIT QUXEFR / QURX SUBROUTINE TO ALLOCATE 1 DISKETTE BLOCK / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / EXIT WITH THE CONTENTS OF THE AC = BLOCK # ALLOCATED / - HARDWARE ERROR WHILE TRYING TO ALLOCATE 1 BLOCK COULD OCCUR QUXEAL, XX TAD KRXEAL DCA QFNC JMS QURX TAD QBLK / BLOCK # ALLOCATED SNA / /a0014 JMP E13CKW / OUTPUT DISK/VOL FULL - CK WHICH ONE /A018 /D018 JMP E13 /error / OUTPUT DISKETTE FULL (no more blocks) /a0014 JMP I QUXEAL / EXIT / QURX SUBROUTINE TO EXECUTE A LOGICAL READ OF 1 BLOCK / ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK / ...THE READ BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD / ...THE DATA FIELD OF THAT READ BUFFER MUST ALREADY BE SET WITHIN QBFD / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV QUXERD, XX TAD QUXERD DCA QUXEWT / TAD KRXERD / LOGICAL READ FUNCTION AC0003 JMP QURDWT / QURX SUBROUTINE TO EXECUTE A LOGICAL WRITE OF 1 DISKETTE BLOCK / ...THE BLOCK # MUST ALREADY BE SET WITHIN QBLK / ...THE WRITE BUFFER ADDRESS MUST ALREADY BE SET WITHIN QBAD / ...THE DATA FIELD OF THAT WRITE BUFFER MUST ALREADY BE SET WITHIN QBFD / ...THE DRIVE # MUST BE ALREADY SET WITHIN QDRV / * - HARDWARE ERRORS COULD OCCUR ON THE DISK READ OR WRITE QUXEWT, XX TAD KRXEWT / LOGICAL WRITE FUNCTION + 2000 QURDWT, DCA QFNC JMS QURX / EXECUTE THE FUNCTION: KRXEWT(2004); KRXERD(3) JMP I QUXEWT / EXIT QUEWT OR QUERD /KRXERT, RXERT / 0 KRXESP, RXESP /KRXEFR, RXEFR / 6 KRXEAL, RXEAL /KRXERD, RXERD / 3 KRXEWT, RXEWT+2000 / SUBROUTINE TO READ 1 DISKETTE BLOCK / TAD (BLOCK#); JMS RD1BLOCK; BUFFER; RETURN PC RD1BLOCK, XX / ENTER WITH THE CONTENTS OF THE AC = TO THE BLOCK # TO BE READ /*THE DRIVE NUMBER MUST ALREADY BE WITHIN QDRV / PC+1 IS THE BUFFER ADDRESS (ALWAYS IN THE 'EDITOR' FIELD) / PC+2 IS THE RETURN ADDRESS DCA QBLK / BLOCK # TAD I RD1BLOCK ISZ RD1BLOCK DCA QBAD / BUFFER ADDRESS CDFEDT TAD .-1 CDFMYF DCA QBFD / BUFFER DATA FIELD (ALWAYS 'EDITOR' FIELD) JMS QUXERD JMP I RD1BLOCK PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// ODG .PA - OUTPUT DOCUMENT GENERATOR \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / ********************************************************************** / * * / * NOTES: 1) INSERTJUST routine resides in SELECTOR due to lack of * / * space IN ODG. * / ********************************************************************** / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! OUTPUT DOCUMENT GENERATOR !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / LOGICAL READ ONE FNV BUFFER PACKET BLOCK / AND DEALLOCATE THAT BLOCK / THEN RANDOM READ THE INPUT DOCUMENT / STARTING AT THE BLOCK # AND CHARACTER OFFSET / SPECIFIED WITHIN THAT FNV BUFFER PACKET BLOCK CONTROL WORDS / OPEN THE OUTPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SOTFL' / FOR [TOP], [BOTTOM], OR [OVERWRITE] 'SCROLL'ING ODG, XX /-- DCA ODGCOUNT / 'OUTPUT' RECORD COUNTER TAD FIRSTBLOCK / 1ST BLOCK OF A CHAIN OF SCRATCH BLOCKS JMS FREE1 / READ THE 1ST SCRATCH BLOCK OF THE CHAIN TAD (INBLOCK+HEADER) /m0013 DCA T1ODG TAD SOTFL / OUTPUT DOCUMENT NAME & DRIVE MQL / INTO THE MQL FOR 'XDSKIN' TAD DSKID / 0QQ DNN NNN NNN AND K7000 / QQ = (0) TOP, (1) BOT, (11) OVERWRITE CLL RAL / QQ0 000 000 000 SNA JMP .+4 / 'TOP' SMA CLA AC7776 / 'BOT' CMA / 'OVR' CIFFIO /M0006 FILEIO /M0006 XDSKIN / WANTS MQ; THEN AC (0) TOP, (1) BOT, (-1) OVERWRITE / OPEN THE INPUT DOCUMENT # DEFINED WITHIN PROGRAM LOCATION 'SLSTFL' TAD SLSTFL / INPUT DOCUMENT NAME & DRIVE JMS RDINIT / % RANDRD INITIALIZATION / TRANSFER ALL CHARACTERS TO THE OUTPUT DOCUMENT / FROM THE BEGINNING OF THE INPUT DOCUMENT / UNTIL THE FIRST '<' OF THE FIRST IS DETECTED ODGRD1, AC0001 JMS ODGRDCHAR / READ 1 CHARACTER FROM THE INPUT DOCUMENT JMP E8 /*...UNEXPECTED DISK EOF SKP / ...NON-PRINTING CHAR RETURNS HERE JMP ODGLAB / ... < RETURNS HERE K7000, NOP / ... > RETURNS HERE / ...12-BIT CHARACTER RETURNS HERE / BLINDLY 'SCROLL' ALL 12-BIT DATA / FROM THE BEGINNING OF THE INPUT DOCUMENT / UNTIL THE FIRST '<' IS DETECTED JMS ODGSCROLL JMP ODGRD1 / ODG SUBROUTINE TO TRANSFER THE: / BLOCK #, CHARACTER OFFSET, PERFORMANCE (HHH), AND VAT / FROM THE 'INBLOCK' BUFFER TO INDIVIDUAL HOLDING LOCATIONS / FOR 'PUTBNO' ODGPOP, XX JMS ODGFNV DCA ODGBNO / SAVE THE BLOCK # JMS ODGFNV DCA ODGOFF / SAVE THE CHARACTER BYTE OFFSET JMS ODGFNV DCA ODGHHH / SAVE THE PERFORMANCE ACCELERATOR ATTRIBUTE JMS ODGFNV / GET THE 'VAT' WHICH SHOULD NEVER = 0000 SNA / XVV VVV SMK KKK JMP ODGFINI / VAT=0000 MEANS AT END OF FNV TABLE / MOVE THE POINTER T1ODG OVER THE 'VALUE' CHARACTERS / WHICH WERE BROUGHT ALONG WITH THE READING OF THE BLOCK / BUT WHICH ARE NOT NEEDED HERE / [THEY WERE NEEDED ONLY FOR THE SORT AND EARLY PACKET MERGES] DCA ODGVAT / TEMP SAVE THE WHOLE 'VAT' TAD ODGVAT BSW / SMKKKK XVVVVV AND (VVVVV) / 000000 0VVVVV SNA JMP ODGV0 CIA DCA T1 JMS ODGFNV CLA ISZ T1 JMP .-3 /*E8 - MEANS ERROR FROM WITHIN 'PUTBNO' ROUTINE ODGV0, JMS PUTBNO / SETUP RANDOM READ ATTRIBUTES: ODGBNO, ZBLOCK 1 / ...BLOCK # ODGOFF, ZBLOCK 1 / ...CHARACTER BYTE OFFSET ODGHHH, ZBLOCK 1 / ...PERFORMANCE ATTRIBUTE JMP E8 / SHOW ANY ERROR AS UNEXPECTED END OF FILE JMP I ODGPOP ODGVAT, ZBLOCK 1 / HOLDS THE WHOLE 'VAT': XVV VVV SMK KKK / A LEFT ANGLE BRACKET HAS BEEN FOUND / SIGNIFYING THE FIRST OF THE FIRST RECORD / WHILE BLINDLY 'SCROLL'ING ALL 12-BIT DATA / FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT ODGLAB, CLA / CLA BECAUSE AC = '<' ASCII CODE ODGNEXT,JMS ODGPOP / GET THE:: BLOCK #, C-OFFSET, HHH, AND VAT / TRANSFER THE CONTENTS OF ONE RECORD / BETWEEN THE '<' AND THE '<>' / FROM THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT /*E8 - MEANS UNEXPECTED DISK END OF FILE (OUT OF DATA) ODGRDNXCH, AC0001 JMS ODGRDCHAR JMP E8 /*...UNEXPECTED DISK EOF JMP .+3 / ...NON-PRINTING CHAR RETURNS HERE JMP .+4 / ... < RETURNS HERE JMP ODGRAB / ... > RETURNS HERE JMS ODGSCROLL / ... 12-BIT DATA: MMMMMCCCCCCC RETURNS HERE JMP .+3 / EACH CHAR (EXCEPT '<') CLEARS ODGFLAG JMS ODGSCROLL / SCROLL THE '<' LEFT ANGLE BRACKET AC7777 DCA ODGFLAG / 0-MEANS WAITING FOR '<'; -1 MEANS FOUND IT JMP ODGRDNXCH / UNTIL '<>' DETECTED / RIGHT ANGLE BRACKET '>' FOUND / IF THE CONTENTS OF PROGRAM LOCATION ODGFLAG = -1 / THEN THIS '>' MEANS AN END OF RECORD DIAMOND '<>' / ELSE IT IS JUST A DELIMITER ODGRAB, JMS ODGSCROLL / SCROLL THE '>' TO THE OUTPUT DOCUMENT ISZ ODGFLAG / SKIP NEXT IF (ODGFLAG) GOES TO 0 JMP ODGRDNXCH / JUST DELIMITER; MORE DATA IN RECORD TO MOVE JMS INSERTJUST / INSERT 'RULER JUSTIFYING' SPACES / 'JMS TIMEOUT' DOESN'T EXECUTE WHEN 'ODGCOUNT' GOES TO ZERO - THAT'S O.K. ISZ ODGCOUNT / OUTPUT TO THE SCREEN: 'RECORDS REPRODUCED: X' JMS TIMEOUT / OUTPUT THE TIME TO THE SCREEN CIFIOA JMS I IOACAL 0 MODG 1005 / ^P ODGCOUNT,ZBLOCK 1 / ^D 1600 / ^P /\ JMP .+1 / WHEN THE RECORD HAS MULTIPLE KEYS (AND MULTIPLE ATTRIBUTES) / THE OUTPUT DOCUMENT GENERATOR TRANSFERS THE ENTIRE RECORD / USING THE FIRST BLOCK #, C-OFFSET, HHH, AND VAT ONLY (SKIPPING THE OTHERS) TAD ODGVAT / GET THE WHOLE 'VAT': XVVVVVSMKKKK AND (MKSBIT) / TEST THE MULTI-KEY SORT BIT (MKSBIT) SNA CLA / SKIP NEXT IF PART OF MULTI-KEY ATTRIBUTES JMP ODGNEXT / JMP MEANS AT END OF MULTI-KEY RECORD JMS ODGPOP / UNTIL A 'VAT' WITH 'MKSBIT' = 0 IS FOUND JMP .-5 / UNTIL 'MKSBIT' WITHIN THE 'VAT' = 0 ODGFLAG,ZBLOCK 1 / 0 MEANS WAITING FOR >; -1 FOUND IT T1ODG, INBLOCK / / ODG SUBROUTINE / TO GET THE NEXT VALUE FROM THE ELEMENT TABLE / POINTED TO BY THE ADDRESS WITHIN T1ODG / IF A 'TAD I T1ODG' EXAUSTS THE DATA WITHIN THE BUFFER / THEN READ AND DEALLOCATE (FREE-UP) ANOTHER SCRATCH BLOCK OF THE CHAIN ODGFNV, XX JMS GETI3 TAD (-INBLOCK) TAD T1ODG /GET ADDRESS POINTER INTO THE FNV BUFFER SPA CLA / SKIP NEXT IF AT END OF 'INBLOCK' BUFFER LIMIT JMP .+6 / JMP CAUSE STILL WITHIN BUFFER ADDRESS LIMITS TAD (INBLOCK+HEADER) /m0013 DCA T1ODG / RESET WITH TOP OF 'INBLOCK' PHYSICAL ADDRESS JMS GETI2 JMS FREE1 / 'READ' 1 SCRATCH BLOCK THEN FREE IT UP JMP ODGFNV+1 CDFEDT TAD I T1ODG /EXIT 'ODGFNV' WITH THE (AC) = TO THE VALUE OF: CDFMYF / ....... ISZ T1ODG / ....... JMP I ODGFNV / 'BLOCK #', 'OFFSET', 'PERFORMANCE', OR 'VAT' /-- / DONE /-- /-- / THE OUTPUT DOCUMENT GENERATOR /-- / HAS TRANSFERRED THE ENTIRE CONTENTS /-- / OF THE INPUT DOCUMENT TO THE OUTPUT DOCUMENT /-- /-- ODGFINI,TAD (207) / 'RULER' MODIFIED FLAG /-- JMS ODGSCROLL /-- CIFFIO /-- FILEIO /-- XDSKCL / CLOSES THE FILE OPENED BY XDSKIN /-- JMP I ODG / EXIT THE OUTPUT DOCUMENT GENERATOR /-- / ODG SUBROUTINE / TO OUTPUT 1 CHARACTER TO THE OUTPUT DOCUMENT / VIA 'SCROLL' CROSS FIELD SYSTEM CALL ODGSCROLL, XX CIFFIO /M0006 FILEIO /M0006 XPUTST JMP I ODGSCROLL PAGE /RANDR2.PA - RANDOM ACCESS DISKETTE READ / /++ /TITLE: RANDR2.PA / /FACILITY: WPS - 8 / /ABSTRACT: RANDR2 is used to random access read a WPS diskette / by the WPS SORT routine. It is a modified copy of RDFILP.PA. / /ENVIRONMENT: WPS278 / /AUTHOR: Joe Famularo WPD, CREATION DATE: 12/15/80 / Pete Smith WPD / /-- / /Definitions: / SCHCNT= 774 / BYTES PER BLOCK BOFSET= 2 / BYTE OFFSET IN BLOCK / SCBKOF= 52 / OFFSET TO FIRST BLOCK PTR IN HEADER 1 / GETBY1=T1RR / FOR USE IN RDGTBY ROUTINE / HO1354=1354 / HEADER OFFSET OF EXTENTION HEADER 3 /A012 / / The following buffers reside in USER FIELD 1 (physical field 3) / RDBUF=7000 / read data buffer / HEADBF=RDBUF+400 / header block buffer /M017 HDBLEN=400 / length of header block buffer (HEADBF) /M017 / in words / / /***************************************************************************** / DESCRIPTION: RDINIT / / OPENS A FILE FOR READING. / / INPUTS: AC CONTAINS THE FILENAME / / OUTPUTS: / / RDINIT, XX DCA T1RR / SAVE THE FILE NAME TAD T1RR / RECOVER IT AND P377 / GET THE FILE NUMBER DCA RDFQBK+RXQFNO / WRITE THE FILE NUMBER / TAD T1RR / RECOVER THE FILE NAME BSW RTR AND (17) / GET THE DRIVE NUMBER DCA RDFQBK+RXQDRV / WRITE THE DRIVE NUMBER / / THIS CALL WILL DEPOSIT THE BLOCK NUMBER OF OUR FILE'S HEADER BLOCK / INTO RDFQBK+RXQBLK / JMS RDFIO RXEGF+4000 HEADBF /M017 / SMA CLA / A NEGATIVE RETURN INDICATES AN ERROR TAD RDFQBK+RXQBLK / GET THE HEADER BLOCK NUMBER RDINI2, JMS RDINI1 / INITITIALIZE SOME VARIABLES / JMS RDGETR / GET THE FIRST HEADER EXTENSION DCA RDHDRB+1 / SAVE ITS BLOCK NUMBER / AC0001 JMS RDGETR / GET THE SECOND HEADER EXTENSION DCA RDHDRB+2 / SAVE ITS BLOCK NUMBER / JMS GETHDREXT / GET 3RD & 4TH HEADER EXTENTIONS /A012 / JMP I RDINIT / AND RETURN /***************************************************************************** / DESCRIPTION: RDINI1 / / INITIALIZES A FEW VARIABLES FOR READING A FILE. / / INPUTS: AC = BLK # OF THE FILE'S HDR CTRL BLK, OR 0 IF NOT FOUND / OUTPUTS: / RDINI1, XX DCA RDHDRB / SET HEADER BLOCK NUMBER AC7777 DCA RDCHNO / INITIALIZE THE COUNT OF NUMBER OF CHARACTERS LEFT / IN THE BUFFER AC7777 DCA HDRTNO / INITIALIZE THE COUNT OF NUMBER OF BLOCK NUMBERS / LEFT IN HEADER BLOCK BUFFER (HEADBF) /M017 TAD (SCBKOF) / INITIALIZE THE OFFSET OF THE FIRST BLOCK NUMBER / IN THE HEADER BLOCK DCA HDROFF DCA RDMOD / CLEAR THE MODE VALUES (USED IN SIX BIT TRANSLATION) DCA RDMOD+1 DCA RDHDBN / SHOW HEADBF EMPTY OF A HEADER BLOCK /M017 DCA LBLKLD / INIT LAST BLOCK LOADED LOCATION JMP I RDINI1 / AND RETURN / / / / /***************************************************************************** / DESCRIPTION: RDNXCB / / RETURNS THE NEXT BYTE FROM THE FILE / / INPUTS: / / OUTPUTS: / RDNXCB, XX /*** THIS IS AN EXTERNALLY DEFINED ENTRY POINT / RDNXC1, CLA ISZ RDCHNO / INCREMENT THE NEGATIVE CHARACTER COUNT JMP RDNXC3 / JUMP IF THERE ARE ANY CHARACTERS LEFT IN THE BUFFER / ISZ HDROFF / INCREMENT THE OFFSET INTO HEADER BLOCK SKP JMP I RDNXCB / TO SIMULATE EOF FOR SINGLE BLOCK READ / TAD HDROFF / HAS THE OFFSET BEEN INCREMENTED INTO /A012 / HEADER EXTENTION POINTERS IN /A012 / EXTENTION HEADER BLOCK 2? /A012 TAD (-HO1354 /A012 SZA CLA / SKIP IF: SO /A012 JMP RDNXC4 /A012 TAD (HO1354+16 / OFFSET HDROFF OVER THE POINTERS TO /A012 / THE FIRST DATA BLOCK POINTER IN /A012 / HEADER EXTENTION BLOCK 3. /A012 DCA HDROFF /A012 JMP RDNXC5 /A012 / RDNXC4, ISZ HDRTNO / ANY BLOCK NUMBERS LEFT IN HEADBF? /M017 JMP RDNXC2 / SKIP IF SOME ARE LEFT / / THERE ARE NO BLOCK NUMBERS IN HEADBF. FILL THE BUFFER UP. /M017 / RDNXC5, JMS LDHDRB / LOAD HEADER BLOCK BUFFER /M012 JMP I RDNXCB / ERROR RETURN AC = 0 / / THERE ARE NO CHARACTERS. READ THE NEXT BLOCK INTO THE BUFFER. / RDNXC2, TAD (-SCHCNT) / RESET THE CHARACTER COUNT DCA RDCHNO JMS RDFBUF / FILL THE BUFFER JMP I RDNXCB / ERROR OR EOF RETURN / / NOW, READ THE NEXT BYTE FROM THE BUFFER / RDNXC3, TAD RDCHNO / GET THE CHARACTER COUNT TAD (SCHCNT) / SUBTRACT FROM THE END OF THE BUFFER JMS RDGTBY / GET THE NEXT BYTE FROM THE BUFFER RDBUF+BOFSET / SNA / IS THE VALUE A NULL? JMP RDNXC1 / JUMP TO GET A NEW ONE IF SO JMP I RDNXCB / ELSE, RETURN THE VALUE /***************************************************************************** / DESCRIPTION: RDFBUF / / READS THE NEXT BLOCK INTO RDBUF / / INPUTS: IMPLICIT: HDRPTR = BLK # TO BE READ / / OUTPUTS: AC = NEGATIVE IF AN ERROR WAS ENCOUNTERED / AC = POSITIVE IF OK / / AT EOF / AC = 0, RDCHNO = 0 RDFBUF, XX ISZ HDRPTR / INCREMENT THE POINTER INTO HEADER BLOCK BUFFER TAD LBLKLD / GET NEGATIVE NUMBER OF THE LAST BLOCK LOADED CDFEDT / change df to user field 1 (physical field 3) TAD I HDRPTR / GET THE NUMBER OF THE BLOCK WE WANT TO LOAD SNA CLA / ARE THEY THE SAME? JMP RDFBL3 / YES - DON'T BOTHER TO LOAD IT AGAIN TAD I HDRPTR / RECOVER THE NEXT BLOCK NUMBER SNA / IS THERE ANOTHER BLOCK NUMBER? JMP RDFBL1 / JUMP IF THERE ARE NO MORE / CDFMYF / change df back to my field JMS RDFIO / READ THE NEXT BLOCK INTO RDBUF RXERD+4000 RDBUF / SPA CLA / WAS THERE AN ERROR? JMP RDFBL2 / JUMP IF SO CDFEDT / change df to user field 1 (physical field 3) TAD I HDRPTR / GET BLOCK NUMBER OF THE BLOCK WE JUST LOADED CIA / MAKE IT NEGATIVE DCA LBLKLD / SAVE IT RDFBL3, ISZ RDFBUF / MAKE A SKIP RETURN TO SHOW ALL IS WELL SKP RDFBL1, DCA RDCHNO / CLEAR CHARACTER COUNT TO SIGNAL EOF CDFMYF / change df back to my field JMP I RDFBUF / AND RETURN / / THERE WAS AN ERROR READING A BLOCK. / RDFBL2, JMS RDINI1 / REINITIALIZE TO PREVENT READS JMP I RDFBUF / LBLKLD, 0 / NEGATIVE BLOCK NUMBER OF LAST BLOCK LOADED INTO RDBUFD / / HDRPTR, 0 / POINTER INTO THE HEADER BLOCK BUFFER HDROFF, 0 / OFFSET INTO HEADER BLOCK OF NEXT BLOCK NUMBER HDRTNO, 0 / NUMBER OF ENTRIES LEFT IN HEADBF /M017 RDMOD, 0 / MODES FOR DECODING 6-BIT 0 / MODE SHIFT (40)/UNSHIFT (0) RDCHNO, 0 / CHARACTER COUNT FOR RDBUF / / PAGE / /***************************************************************************** / DESCRIPTION: RDNXC / / RETURNS THE NEXT CHARACTER FROM THE FILE IN 6-BIT / / INPUTS: / OUTPUTS: / RDNXC, XX JMS RDNXCB / GET THE NEXT BYTE FROM THE FILE TAD (-77) / IS IT AN ESCAPE? SNA JMP RDNXCX / JUMP IF SO TAD P77 / ELSE RESTORE THE CHARACTER JMP I RDNXC / AND RETURN IT RDNXCX, JMS RDNXCB / GET ANOTHER BYTE SMA SZA TAD P7700 / SHOW IT IS AN ESCAPE CHARACTER JMP I RDNXC / AND RETURN IT / / / / /++ / GETHDREXT /A012 / /FUNTIONAL DESCRIPTION: GET_HEADER_EXTENTIONS / / THIS ROUTINE WILL LOAD THE ADDITIONAL HEADER BLOCK EXTENTION ADDRESSES / WHICH ARE USED BY A DOCUMENT THAT EXCEEDS 704 BLOCKS WHEN OPERATING IN / RX02 DOUBLE DENSITY, INTO THE RDHDRB BUFFER. IT IS IMPORTANT TO NOTE / THAT AT THIS TIME GETHDREXT IS SET UP TO GO NO FURTHER THAN THE 4TH / HEADER EXTENTION SINCE THIS PROVIDES THE MAXIMUM NUMBER OF BLOCKS / POSSIBLE FOR RX02 DOUBLE DENSITY DOCUMENT FLOPPY. IF RL BASED SYSTEM / IS DEVELOPED THAN THIS WILL NECESSITATE SLIGHT CHANGES TO GETHDREXT AS / WELL AS FURTHER MODIFICATIONS TO RANDR2. / /CALLING SEQUENCE: JMS GETHDREXT / /INPUT PARAMETERS: AC = 0 / /IMPLICIT INPUT: RDHDRB+2, GETHD1 / /OUTPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: GETHD4, GETHD1, GETHD2 / /COMPLETION CODE: NONE /SIDE EFFECTS: NONE / /-- / GETHDREXT, / ROUTINE TO GET HEADER BLOCK EXTENSIONS XX TAD RDHDRB+2 / IS THERE A 2ND HEADER EXTENTION? SNA CLA / SKIP IF: SO JMP GETHD6 / ELSE RETURN / TAD (RDHDRB+3 / GET PTR TO 3RD HDR EXT IN RANDRD CTL BLK DCA GETHD4 / SAVE FOR AUTOINDEXING / TAD (HO1354 / GET HEADER OFFSET OF EXT HEADER 3 POINTER / (EXT HDR 2 [362]) DCA GETHD1 / / / /*************************************************************************** /********************** YOUR ATTENTION PLEASE ****************************** /*************************************************************************** / NUMBER OF POSSIBLE HEADERS MUST BE CHANGED FOR RL'S. LOOP CONTROL IS / SET FOR -3 SO IF HEADER THAT IS BEYOND THE LIMITS OF AN RX02 (DOUBLE / DENSITY) DISKETTE IS CALLED WE'LL TERMINATE RDHDRB BUFFER AND RETURN. / THE MAXIMUM NUMBER OF BLOCKS ON A DOUBLE DENSITY FLOPPY IS 983. THIS MEANS / THAT THE MAXIMUM NUMBER OF HEADER BLOCKS NEEDED FOR A SINGLE DOCUMENT / WOULD BE THE MAIN HEADER BLOCK + 4 EXTENTION HEADERS. RANDR2 ROUTINE WILL / NEED MODIFIICATION TO HANDLE ADDITIONAL HEADER BLOCKS BEYOND THE 4TH / EXTENTION HEADER WHICH MAY BE NEEDED FOR VERY LARGE DOCUMENTS ON AN RL. /*************************************************************************** /*************************************************************************** /*************************************************************************** AC7775 / GET ITERATION COUNT FOR EXT HDRS 3 & 4 DCA GETHD2 / SAVE THE COUNT /************************************************************************** /************************************************************************** /************************************************************************** / GETHD3, TAD GETHD1 / GET 3RD & 4TH EXT HDR BLK NUMS JMS RDGETR SNA / SKIP IF: BLOCK NUMBER PRESENT JMP GETHD5 / ELSE ALL DONE DCA I GETHD4 / PUT BLK NBR INTO RDHDRB+X / ISZ GETHD1 / POINT TO NEXT HDR BLK NBR ISZ GETHD4 / INC POINTER INTO RDHDRB BUFFER ISZ GETHD2 / EXCEEDED RX02 DOUBLE DENSITY EXTENTION / HEADER LIMIT? JMP GETHD3 / NO- GO GET IT IF ITS THERE / GETHD5, DCA I GETHD4 / TERMINATE RDHDRB BUFFER GETHD6, JMP I GETHDREXT / RETURN / GETHD1, 0 / POINTER TO HDR BLK NBRS IN HEADER EXT 2 GETHD2, 0 / COUNTER FOR LOOP CONTROL GETHD4, 0 / POINTER INTO RDHDRB BUFFER / / / / /**************************************************************************** / DESCRIPTION: RDGTBY / / Returns either the upper or lower byte / in RDBUF for conversion to seven bit ASCII. / / INPUT: AC = character count of RDBUF / / OUTPUT: 6 bit COS-310 character / RDGTBY, XX CLL RAR / IF LINK = 0 GET UPPER BYTE / IF LINK = 1 GET LOWER BYTE / TAD I RDGTBY / GET RDBUF+OFFSET DCA GETBY1 ISZ RDGTBY / BUMP RETURN CDFEDT / change df to user field 1 (physical field 3) TAD I GETBY1 CDFMYF / change df back to my field SNL BSW / SWAP BYTES IF UPPER BYTE NEEDED AND P77 JMP I RDGTBY / PAGE / / MOVED RDGTBY /M012 /*************************************************************************** /DESCRIPTION: RDFIO / / Submits diskette read to queue. / RDFIO, XX DCA RDFQBK+RXQBLK / STORE BLOCK NUMBER TAD I RDFIO / GET FUNCTION CODE FROM CALLER DCA RDFQBK+RXQFNC / DEPOSIT IN QUEUE BLOCK ISZ RDFIO / BUMP TO RETURN ADDRESS TAD I RDFIO / GET WHICH BUFFER ARE TO READ DATA INTO DCA RDFQBK+RXQBAD / DEPOSIT IN QUEUE BLOCK ISZ RDFIO CDFEDT / change df to user field 1 (physical field 3) TAD .-1 / get cdf instruction CDFMYF / change df back to my field DCA RDFQBK+RXQBFD / DEPOSIT IN QUEUE BLOCK CIFSYS / ENQUE / SUBMIT TO QUEUE RDFQB / PASSED PARAMETER RDFIO1, CIFSYS / NOW JWAIT / WAIT TIL DONE TAD RDFQBK+RXQCOD / DONE YET? SNA / YES JMP RDFIO1 / NO JMP I RDFIO / RETURN STATUS (AC = MINUS ON ERROR) / /***************************************************************************** / QUEUE REQUEST BLOCK / RDFQB, DSKQUE 0 0 / QUEUE HEADER RDFQBK, 0 / +RXQCOD HANDLER STATUS (0 = NOT DONE) 0 / +RXQFNC RX FUNCTION REQUEST 0 / + 0 / +RXQFNO FILE NUMBER 0 0 0 0 0 / +RXQDRV DRIVE NUMBER 0 / +RXQBLK BLK # BEING RETURNED 0 0 / +RXQBAD ADDRESS OF LOCAL BUFFER 0 / +RXQBFD "CDF" TO BUFFER FIELD 0 0 / / /***************************************************************************** / DESCRIPTION: RDGETR / / RETURNS THE BLOCK NUMBER ADDRESSED BY THE OFFSET WHICH IS / IN THE AC UPON CALL. / / INPUTS: AC = OFFSET IN RANDRD CTRL BLK CONTAINING REQUESTED BLK # / / OUTPUTS: AC = PHYSICAL BLOCK NUMBER / AC = 0 - NO HEADER BLOCK IN HEADBF /M017 / RDGETR, XX DCA .+2 / SAVE THE OFFSET IN THE CALL BELOW RDGETA, JMS SCOFST / THIS ROUTINE RETURNS: / 1) THE ADDRESS IN HEADBF WHICH /M017 / CONTAINS A BLOCK NUMBER. SKIP RETURN / 2) IF HEADER BLOCK IS PRESENTLY NOT IN / "HEADBF", "RDHDBN" POINTS TO "RDHDRB" /M017 / OR AN OFFSET WHERE THE BLOCK # IS STORED. / RETURN AND READ THAT BLK 0 / THE DESIRED OFFSET RDBFCB / THE HEADER CONTROL BLOCK / JMP RDGTXR / NORMAL RETURN MADE--JUMP TO HANDLE IT / DCA T1RR / SAVE THE BLOCK NUMBER ADDRESS TO INDIRECT THROUGH CDFEDT / change df to user field 1 (physical field 3) TAD I T1RR / GET THE BLOCK NUMBER CDFMYF / change df back to my field JMP I RDGETR / RETURN IT / / WE MUST LOAD THE HEADER BLOCK INTO THE BUFFER AND TRY AGAIN / RDGTXR, TAD I RDHDBN / GET THE BLOCK NUMBER OF THE HEADER BLOCK SNA JMP RDGTXZ / JUMP IF NO HEADER BLOCK WAS SPECIFIED / JMS RDFIO / READ THE HEADER BLOCK RXERD+4000 HEADBF /M017 / SMA CLA / WAS THERE AN ERROR IN READING? JMP RDGETA / NO--LOOP TO GET THE BLOCK NUMBER DCA I RDHDBN / YES--CLEAR THE BLOCK NUMBER OF THE HEADER BLOCK / RDGTXZ, DCA RDHDBN / CLEAR TO INDICATE NO HEADER BLOCK IS IN THE BUFFER JMP I RDGETR / AND RETURN /***************************************************************************** / DESCRIPTION: SCOFST / / INPUTS: CALL+1 = DESIRED OFFSET / CALL+2 = ADDR OF RANDRD CONTROL BLOCK / RDHDBN (IMPLICIT) = 0 IF BUFFER EMPTY OR HDR BLK / / OUTPUTS: RDHDBN (IMPLICIT) = ADDRESS CONTAINING EITHER HDR, EXT1, EXT2 / SCOFST, XX DCA SCOFS1 / INIT REL BLK # TAD I SCOFST / GET DESIRED OFFSET INTO HEADER BLOCKS / UNTIL (OFFSET IS WITHIN A HEADER BLOCK'S BOUNDARY) TAD (-376) / COMPUTE REL BLK # ISZ SCOFS1 / INC OFFSET INTO RDHDRB TABLE SMA / JMP .-3 / END UNTIL DCA SCOFS2 / SAVE OFFSET-400 ISZ SCOFST / BUMP RETURN TAD I SCOFST / BUFCB PTR DCA SCOFS3 / STORE ADDRESS OF HEADER CONTROL BLOCK AC0001 TAD SCOFS3 / CUR BLK PTR PTR DCA SCOFS4 ISZ SCOFST / BUMP RETURN TAD I SCOFS4 SNA JMP SCOFSA / READ IF CURR BLK 0 (BUFFER EMPTY OF HEADER BLOCK) CIA / ELSE COMPARE WITH NEEDED PTR TAD SCOFS1 TAD SCOFS4 SNA CLA JMP SCOFSB / JUMP IF SAME (BLOCK ALREADY LOADED IN / HEADBF AREA) /M017 SCOFSA, TAD SCOFS1 TAD SCOFS4 / SET NEW BLK PTR DCA I SCOFS4 JMP I SCOFST / RETURN FOR READ SCOFSB, TAD SCOFS2 / GET WORD OFFSET TAD (400) TAD I SCOFS3 / +BUFFER PTR ISZ SCOFST / BUMP FOR NORMAL RETURN JMP I SCOFST / RETURN WORD PTR / SCOFS1, .-. / OFFSET INTO RDHDRB TABLE 1 --> RDHDRB / 2 --> RDHDRB+1 / 3 --> RDHDRB+2 / ETC. SCOFS2, .-. / WORD OFFSET - 400 SCOFS3, .-. / POINTS TO 1ST ENTRY IN RDFIL HDR CTRL BLK (RDBFCB) SCOFS4, .-. / POINTS TO RDHDRB / / / RANDRD CONTROL BLOCK / RDBFCB, HEADBF / HEADER BLOCK BUFFER ADDRESS /M017 RDHDBN, 0 / POINTER TO CURRENT HEADER BLOCK NUMBER RDHDRB, 0 / MAIN HEADER BLOCK NUMBER 0 / 1ST HEADER BLOCK EXTENTION 0 / 2ND HEADER BLOCK EXTENTION 0 / 3RD HEADER BLOCK EXTENTION /A012 0 / 4TH HEADER BLOCK EXTENTION /A012 0 / 5TH HEADER BLOCK EXTENTION /A012 0 / 6TH HEADER BLOCK EXTENTION /A012 0 / 7TH HEADER BLOCK EXTENTION /A012 0 / 8TH HEADER BLOCK EXTENTION /A012 0 / 9TH HEADER BLOCK EXTENTION /A012 0 / 10TH HEADER BLOCK EXTENTION /A012 0 / 11TH HEADER BLOCK EXTENTION /A012 0 / 12TH HEADER BLOCK EXTENTION /A012 0 / 13TH HEADER BLOCK EXTENTION /A012 0 / 14TH HEADER BLOCK EXTENTION /A012 0 / 15TH HEADER BLOCK EXTENTION /A012 0 / 16TH HEADER BLOCK EXTENTION /A012 0 / HEADER BLOCK NUMBERS ENDED BY ZERO / / PAGE /++ / TNOPRT / /FUNTIONAL DESCRIPTION: TNOPRT / / Calculate and save count of header block entries (HDRTNO) that will / be found in the header block buffer (HEADBF). Also calculate /M017 / and save header buffer pointer (HDRPTR). / / TNOPRT PSEUDO CODE: / / calculate count of header block entries / save it / calculate header buffer pointer / save it / return to caller / /CALLING SEQUENCE: JMS TNOPRT / /INPUT PARAMETERS: AC = header block offset value / /IMPLICIT INPUTS: HDRTNO / /OUTPUT PARAMETERS: none / /IMPLICIT OUTPUT: HDRTNO, HDRPTR / /COMPLETION CODE: none / /SIDE EFFECTS: none / /-- / TNOPRT, XX / TAD (-376) / calculate count of header block entries SMA JMP .-2 DCA HDRTNO / save it / TAD HDRTNO / calculate header buffer pointer TAD (HDBLEN+HEADBF-1) / add header buffer length + value /M017 / of first address of header buffer - 1 DCA HDRPTR / save result in header buffer pointer / JMP I TNOPRT / / /***************************************************************************** / DESCRIPTION: RDNXCH / / Reads the next character from the file and returns it in / seven bit ASCII along with it's mode bits. / / INPUTS: / / OUTPUTS: AC = mode bits and seven bit ASCII character / RDNXCH, XX TAD RDCHNO / IS THE COUNT CLEAR? SMA CLA JMP I RDNXCH / YES--EOF HAS BEEN REACHED. RETURN / / RDNXH1, JMS RDNXC SNA JMP I RDNXCH / RETURN IF NONE JMS XLTASC JMS GETMOD RDMOD SNA JMP RDNXH1 / DON'T RETURN NULLS JMP I RDNXCH / XLTASC, XX / XLAT 6-BIT TO ASCII / 1-73: NORMAL / 74: SHIFT / 76: UNSHIFT / 7702-7777: ESCAPE / / OUTPUT: -(1-6): MODE CHANGE (L=1 IF ON) / 0-200: ASCII CHAR (L=1 IF ALPHA) / SPA SNA JMP XLTAS1 / ESCAPE TAD (-74) SMA JMP XLTAS2 / SHIFT-UNSHIFT TAD (74-41) XLTAS4, CLL CML / SET LINK FOR ALPHA TAD (41+37) / CLEAR LINK IF NOT ALPHA JMP I XLTASC XLTAS1, TAD (100-MAXESC) SMA CLA / CHECK FOR OK TAD (MAXESC+ESCTAB) DCA T1RR TAD I T1RR SPA JMP XLTAS3 TAD (-100) / ADJUST FOR ALPHA TEST JMP XLTAS4 / XLTAS2, SNA CLA IAC CMA XLTAS3, CLL CML RAR JMP I XLTASC / ESCTAB, 0 0 -3 -4 -5 -6 11 10 15 -13 -14 12 14 -7 -10 -11 -12 0 133 / [ - SHIFT 134 / \ - RESERVED 135 / ] - UNSHIFT 136 / ^ - START OF 2 CHARACTER SPECIAL CODE 137 0 / NORMALLY 7 FOR NEED-WRAP CODE 16 17 MAXESC=.-ESCTAB -16 / ERROR / / GETMOD, XX / XLAT ESCAPES, ADD MODES TO ASCII MQL / TEMP HOLD CHAR. IN MQ TAD I GETMOD / GET ADDRESS OF RDMOD DCA T1RR ISZ GETMOD / BUMP RETURN MQA / GET CHAR. BACK FROM MQ SMA SZA JMP GETMD1 / NORMAL ASCII SNA / NULL CHARACTER ? JMP I GETMOD / YES - RETURN IAC SNA ISZ T1RR / ADJUST T1RR IF SHIFT-UNSHIFT CHANGE TAD (MODTAB) DCA T2RR / GET PTR TAD I T2RR SPA JMP I GETMOD / RETURN QUICK IF ERROR CMA AND I T1RR SNL TAD I T2RR DCA I T1RR / SET NEW MODE JMP I GETMOD GETMD1, TAD I T1RR / ADD MODE FLAGS ISZ T1RR SZL TAD I T1RR / AND UNSHIFT JMP I GETMOD / -1 / ERROR 2000 / JUSTIFY 1400 / SUPERSCRIPT 1000 / SUBSCRIPT 400 / UNDERSCORE 200 / BOLD MODTAB=. 40 / PAGE /++ / LDHDRB / /FUNTIONAL DESCRIPTION: LDHDRB / / Fills header block buffer with proper header block based on the header / offset value. Then calculate and save count of header block entries / (HDRTNO) as well as the header buffer pointer (HDRPTR). / / LDHDRB PSEUDO CODE: / / get header offset value / load in corresponding header block / if [no error] / get header offset / calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR) / increment return pointer / return to caller / /CALLING SEQUENCE: CALLER, JMS LDHDRB / CALLER+1, error return / /INPUT PARAMETERS: none / /IMPLICIT INPUTS: HDROFF / /OUTPUT PARAMETERS: none / /IMPLICIT OUTPUT: HDRTNO, HDRPTR / /COMPLETION CODE: none / /SIDE EFFECTS: If we error when loading header block into header / buffer then we return immediately to caller+1. / /-- / LDHDRB, XX TAD HDROFF / get the offset JMS RDGETR / load proper header block into HEADBF /M017 SNA CLA / error ? JMP I LDHDRB / yes - return ISZ LDHDRB / no - bump return TAD HDROFF JMS TNOPRT / calculate and save count of header block entries (HDRTNO) / calculate and save header buffer pointer (HDRPTR) JMP I LDHDRB / return / / /++ / GETBNO / /FUNCTIONAL DESCRIPTION: GETBNO / / Get mode, blocknumber, and offsets for WPSORT. The GETBNO routine / takes current mode bit information, breaks it up and then combines / it in part with the address of the current block read as well as / with the offset character pointer for RDBUF as shown below. Also / the offset into the header block which contained the physical block / number is aquired along with a flag which shows whether we did a / single or multiple block read during the reading of a record. All / three parameters are held in buffer locations. They are restored / to RANDR2 through the use of the PUTBNO routine. / / GETBNO PSEUDO CODE: / /10) save input parameter /20) get block no. of current block read / if (called to get parameters of current record) /40) scheme mode bits for 1st word / merge mode bits / save word in BLOCKNO / / scheme mode bits for 2nd word / get offset character pointer for RDBUF / mask 3 m.s.b. / merge mode bits / save word at LABOFFSET / /140) get offset into header block / save word at PERFORMANCE /160) else (e.o.r. call) / if (block number neq to block number at first call to routine) / set m.s.b. of LABOFFSET /190) return to caller / / 0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /10/11/12 / ---------------------------------------- / BLOCKNO, |m1|m2| block number | / ---------------------------------------- / LABOFFSET, |m3|m4|m5|offset char. pointer for RDBUF | / ---------------------------------------- / PERFORMANCE, |sm| offset into header block | / ---------------------------------------- / / mode bits m1 = shift/unshift / m2 = justify / m3 = super & subscript / m4 = underscore / m5 = bold / / block read - This bit is operated on if GETBNO called with AC = 0 / sm = 0 single block read / 1 multiple block read / /CALLING SEQUENCE: Aquire parameters of the record being read. / / 1) **** Use this call when beginning of record [<] is detected. **** / / AC7777 / JMS GETBNO / / / 2) We must check if the record being read was contained / within a single block or if more than one block had / to be read into RDBUF before reaching EOR. This must / be recorded in order to read the complete record properly / by using the PUTBNO routine. This is done by setting / bit 0 in PERFORMANCE if block numbers have changed / from the start of the record being read to its end. / When PERFORMANCE parameter is passed to PUTBNO routine / it is flagged whether a single or multiple block read / is necessary. / ****Use this call after detecting e.o.r. or e.o.f.**** / / CLA / JMS GETBNO / /INPUT PARAMETERS: AC = -1 Get all three parameters / AC = 0 Check if block number being read now is / different from block read at beginning of / record. If so set m.s.b. in PERFORMANCE. / /IMPLICIT INPUTS: RDFQBK+RXQBLK, RDCHNO, RDMOD, RDMOD+1, HDROFF, BLOCKNO, / PERFORMANCE, GPTEMP / /OUPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: CALLER+1, CALLER+2, CALLER +3, BLOCKNO, LABOFFSET, / PERFORMANCE, GPTEMP / /COMPLETION CODE: none / /SIDE EFFECTS: 1) In order to make room for the mode bits (3,4 & 5) / in the second word, the 3 m.s.b. are masked from / the offset char. pointer (RDCHNO). Since RDCHNO's / limits are 7004 to 7777 the 3 m.s.b. must be reset / by the routine using this parameter before restor- / ing it to RDCHNO. / /-- / GETBNO, XX / /..10.. DCA GPTEMP / save pass number flag / /..20.. TAD RDFQBK+RXQBLK / get no. of current block ISZ GPTEMP / get record's parameters? JMP CHKPAS / no - do check e.o.r. for multi block read DCA GPTEMP / hold block number while do mode bits TAD RDMOD+1 / get shift/unshift mode bit BSW / bit 0 gets bit 6 MQL / hold result in MQ AC2000 / GET JUSTIFY BIT /M012 AND RDMOD /M012 MQA / MERGE WITH SHIFT/UNSHIFT /M012 MQL / HOLD IN MQ /M012 TAD GPTEMP / merge block number with 2 mode bits MQA DCA BLOCKNO / save word / /..40.. TAD RDMOD / get mode bits m3,m4, and m5 RTL / bits 0,1,2 get 2,3,4 AND (7000) MQL / hold result in MQ AC7777 / offset = offset - 1 TAD RDCHNO AND (777) / mask to set mode bits MQA / merge mode bits DCA LABOFFSET / save word / /..140.. TAD HDROFF / get offset into header block DCA PERFORMANCE / save word JMP I GETBNO / return to caller / /..160.. CHKPAS, CIA / compare blk no. e.o.r. with blk no. beginning of record DCA GPTEMP / hold -block number TAD BLOCKNO / get block number beginning of record AND (1777) / mask mode bits TAD GPTEMP SZA CLA / are they same? AC4000 / no - set flag showing multiple block read TAD PERFORMANCE DCA PERFORMANCE / /..190.. JMP I GETBNO / return to caller / / /++ / PUTBNO / /FUNCTIONAL DESCRIPTION: PUTBNO / / Insert mode, blocknumber, and offsets into RANDR2 for WPSORT. / The PUTBNO routine restores mode bits into RANDR2 and then / reads the proper header block into HEADBF. The block specified / by BLOCKNO is read into the read buffer and the offset character / pointer (RDCHNO) is loaded so we can start reading characters from / that point on. Thus we're able to accomplish random access reads / for use in sorting. / / PUTBNO PSEUDO CODE: / /10)putbno: get parameters and save them /20) restore mode bits /30) if [single block read] /40) calculate and save count of header block entries (HDRTNO) / calculate and save header buffer pointer (HDRPTR) / reset count of header block entries to -2 (HDRTNO) / set header block offset to -1 (HDROFF) / save value pointed to by header block buffer pointer / place physical block number we want to read (BLOCKNO) in header buffer / offset header block buffer pointer by -1 / read block just placed in header buffer into read buffer (RDBUF) / escape putbno if (error) / restore value saved to header buffer / else /150) set header block offset / load header block, calculate and save count of header block entries (HDRTNO) and header buffer pointer (HDRPTR) / escape putbno if (error) / read block pointed to by header buffer pointer / escape putbno if (error) /200) set offset character pointer (RDCHNO) / bump return pointer (no errors) /220) end putbno / / return to caller / / /CALLING SEQUENCE: JMS PUTBNO / ---------------------------------------- / |m1|m2| block number | / ---------------------------------------- / |m3|m4|m5|offset char. pointer for RDBUF | / ---------------------------------------- / |sm| offset into header block | / ---------------------------------------- / errror return / normal return / / / mode bits m1 = shift/unshift / m2 = justify / m3 = super & subscript / m4 = underscore / m5 = bold / / block read sm = 0 - single block read / 1 - multiple block read / /INPUT PARAMETERS: none / /IMPLICIT INPUTS: CALLER+1, CALLER+2, LABOFFSET, BLOCKNO, HDROFF, HDBUFP / /OUTPUT PARAMETERS: AC = 0 / /IMPLICIT OUTPUT: BLOCKNO, LABOFFSET, PERFORMANCE, RDMOD, RDMOD+1, RDCHNO, / HDROFF, HDBUFP / /COMPLETION CODE: none / /SIDE EFFECTS: Errors could occur (highly unlikely but nevertheless / possible) during execution of PUTBNO. Upon detection / of any error we return to caller+4. / /-- / PUTBNO, XX / /..10.. CLA CLL TAD I PUTBNO / get mode & block no. from call + 1 DCA BLOCKNO / save it ISZ PUTBNO / bump return TAD I PUTBNO / get mode & char. offset pointer DCA LABOFFSET / save it ISZ PUTBNO / bump return TAD I PUTBNO / get offset into header block DCA PERFORMANCE / save it / /..20.. ISZ PUTBNO / bump return TAD LABOFFSET / get 3 mode bits in char, offset pointer AND (7000) RTR / place in proper bit position MQL / hold here until get justify bit AC2000 / GET JUSTIFY BIT /M012 AND BLOCKNO /M012 MQA / merge with 3 other mode bits DCA RDMOD / restore mode bits AC4000 / GET SHIFT/UNSHIFT MODE BIT /M012 AND BLOCKNO /M012 BSW / place in proper bit position (bit 6) DCA RDMOD+1 / restore mode bit / /..30.. TAD PERFORMANCE / single block read? SPA / JMP PUTBN1 / no - set up for multiple block read / /..40.. JMS TNOPRT / calculate and save header buffer pointer (HDRPTR) / AC7776 DCA HDRTNO / reset count of header block entries to -2 / AC7777 / set header block offset = -1 to simulate / eof if we read beyond end of the block. DCA HDROFF / TAD HDRPTR / get address pointed to by header pointer DCA HDBUFP / save it CDFEDT / change df to user field 1 (physical field 3) TAD I HDBUFP / get value in HEADBF /M017 DCA GPTEMP / temp. save it / TAD BLOCKNO / get block number we want to read AND (1777) / mask mode bits DCA I HDBUFP / place in header buffer CDFMYF / change df back to my field / AC7777 / offset header buffer pointer by -1 TAD HDRPTR DCA HDRPTR / JMS RDFBUF / read in block JMP I PUTBNO / error or end of file return / TAD GPTEMP / restore value we saved to header buffer CDFEDT / change df to user field 1 (physical field 3) DCA I HDBUFP CDFMYF / change df back to my field / JMP PUTBN2 / /..150.. PUTBN1, AND P3777 / mask multi/single block read flag DCA HDROFF / set header block offset (HDROFF) / JMS LDHDRB / load header block buffer with header block / that corresponds to this offset. JMP I PUTBNO / error return - error caused in RDGETR / JMS RDFBUF / read block pointed to by HDRPTR JMP I PUTBNO / error or end of file return / /..200.. PUTBN2, TAD LABOFFSET / setup and save RDBUF character counter AND (777) / mask mode bits TAD (7000) DCA RDCHNO ISZ PUTBNO / bump return / /..220.. JMP I PUTBNO / return to caller / HDBUFP, 0 / temporary pointer into header block buffer / / /Symbols shared by BOTH GETBNO and PUTBNO routines / BLOCKNO, 0 / mode bits and block number LABOFFSET, 0 / mode bits and offset character pointer PERFORMANCE, 0 / multi/single block read flag & offset / into header buffer / GPTEMP, 0 / temp for GETBNO and PUTBNO routine / / PAGE / ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// SHLSRT.PA - MULTI KEY SHELL SORT ALGORITHM \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ SUBKEY, ZBLOCK 1 /2; 14 / THE 'SECONDARY' KEY(S) SORTORDER, ZBLOCK 1 / FROM 'ORDER' FOR 'RAL'S LATER BREAKADDRESS, ZBLOCK 1 / adrs 'KEY01FNTOTAL' - 'KEY12FNTOTAL' BOTADR, ZBLOCK 1 / BOTTOM (LOGICAL ADDRESS) OF FNVAR LIST TOPADR, ZBLOCK 1 / TOP (LOGICAL ADDRESS) OF FNVAR LIST / MULTI-KEY SORT PROCESSOR SORT, XX AC0002 / 2 / (because of '-1' and 'DUMMY' in list) TAD FNVAR / PHYSICAL 'END' (BOTTOM) OF LIST DCA BOTADR TAD (FNVARBUFFER+1) / PHYSICAL 'START' (TOP) OF LIST + 1 DCA TOPADR TAD (FNVARBUFFER+1) / DCA KEY01FNTOTAL / TAD (KEY01FNTOTAL) / DCA BREAKADDRESS / TAD ORDER / XXX XXX XXX XXX; (0/1 ASCENDING/ DESC) DCA SORTORDER / FOR 'RAL'(S) LATER (IN 'XSORT') / ORDER (SORT) THE SEQUENCE OF THE 'FNVARTABLE' / AS PER THE 'VVVVVALUE' WITHIN THE 'FNVBUFFER' / for the 'PRIMARY' KEY (key #1) / USING SHELL'S SORTING METHOD AC0001 / # 1 / SORT THE 'PRIMARY' (#1) KEY JMS XSORT / (INITIALZES 'KEYID' TO KEY #1) TAD SORTKEY / / CLL RAR / SNA CLA / JMP I SORT /EXIT / SINGLE KEY SORT COMPLETED / PARTITION (RECALCULATE) THE SIZE OF THE 'LSTADR' / TO THAT OF THE PRIMARY KEY ('THISKEY') / AND SORT ON KEY #2; ETC / (THEN ITERATIONS THRU KEY #MAXKEY) AC0002 / 2 / (because of '-1' and 'DUMMY' in list) TAD FNVAR / PHYSICAL 'END' (BOTTOM) OF LIST DCA BOTADR TAD BOTADR / THE PHYSICAL (THEN LOGICAL) BOTTOM DCA TOPADR / BECOMES THE 'LOGICAL' TOP BREAKPRIMARY, JMS TSTTOPADR / 'ISZ TOPADR' JMP I SORT / DONE / ONLY 1 MULTIKEY RECORD IN 'FNVARTABLE' /\ JMP .+1 / TAD ORDER / DCA SORTORDER / AC0001 / / CONTINUE SORTING KEYS #2 THRU #14 DCA SUBKEY /SUBKEY=/ (BECAUSE PRIMARY KEY ALREADY SORTED) BREAKSUB, TAD SUBKEY / / the PRIMARY key identification (#1) JMS ADVANCE / ADVANCE TO A BREAK FOR THIS KEY CDFMYF /--------------------//CDF / / THE 'VVVVV'ALUES ARE DIFFERENT (LOGICAL BREAK), OR / THE 'VAT'S ARE DIFFERENT (LOGICAL BREAK); OR / AT THE PHYSICAL TOP OF THE 'FNVARTABLE' TAD TOPADR /TOPADR / CONTAINS THE BREAK ADDRESS ISZ BREAKADDRESS / SAVE IT INTO DCA I BREAKADDRESS / 'KEY02FNTOTAL THRU KEY12FNTOTAL' TAD SORTORDER / GET THE SORTING 'ORDER' CLL RAL / FOR THE NEXT KEY (2 THRU 14) DCA SORTORDER / (MAKING A WORKING MASTER) SZL / DON'T LOOSE THE LINK ISZ SORTORDER / (BIT 0 IS HELD IN BIT 12--ETC.) ISZ SUBKEY / +1 / TAD SUBKEY / 1; 14 / SORT THE LIST ON SECONDARY KEYS (2-14) JMS XSORT /'SORT' / (UPDATING 'KEYID' TO THE NEXT KEY #) TAD SORTKEY /MAX# / CIA / TAD SUBKEY / # OF CURRENT SUBKEY IN PROCESS SNA CLA / JMP NOMORESUBKEYS / TAD BOTADR / / RESET 'TOPADR' WITH THE ADDRESS OF THE DCA TOPADR / 'BOTTOM' OF THE LIST (DIDN'T MOVE YET) JMSTSTTOPADR, JMS TSTTOPADR / JMP NOMORESUBKEYS / JUMP / IF DONE WITH THIS KEY (OR 1 KEY REC) JMP BREAKSUB / NOMORESUBKEYS, TAD I BREAKADDRESS / RESET 'TOPADR' WITH 'BREAK' ADDRESS DCA TOPADR / OF THE SUB KEY (FROM A 'TOPADR') TAD TOPADR / and M O V E the bottom address DCA BOTADR / TO BECOME THE 'NEW' LOGICAL BOTTOM AC7777 / -1 / TAD BREAKADDRESS / DCA BREAKADDRESS / TAD BREAKADDRESS / TAD (-KEY01FNTOTAL) / SNA CLA / JMP BREAKPRIMARY / CONTINUE FORWARD SORT OF SUB KEYS / ALL SECONDARY KEYS IN THE FORWARD DIRECTION HAVE BEEN SORTED / BACKUP 1 SECONDARY KEY TO CONTINUS SORTING IN THE FORWARD DIRECTION / WHEN ALL SECONDARY KEYS HAVE BEEN SORTED TO THEIR RESPECTIVE / PRECEEDING SECONDARY KEYS FOR THIS PRIMARY KEY BREAK / (WHEN THE CONTENTS OF PROGRAM LOCATION 'BREAKADDRESS') / (EQUILS THE VALUE FOR THE ADDRESS 'KEY01FNTOTAL) / THEN FIND THE NEXT PRIMARY KEY BREAK / AND DO IT ALL OVER AGAIN AC7777 / -1 / TAD SUBKEY / DCA SUBKEY / TAD SORTORDER / CLL RAR / SZL / TAD (4000) / BIT 0 / DCA SORTORDER / JMP JMSTSTTOPADR / TSTTOPADR, XX TAD I BREAKADDRESS / CIA ISZ TOPADR TAD TOPADR SPA CLA ISZ TSTTOPADR JMP I TSTTOPADR /****************************************************************************** / / OUTPUT DISKETTE/VOLUME FULL - CK WHICH ONE IS IN USE AND USE CORRECT / TEXT STRING / / CK FOR WINCHESTER DRIVE INSTALLED / /****************************************************************************** E13CKW, CLA / CLEAR AC /A018 CDFMNU / MENU FIELD /A018 TAD MUBUF+MNOPTN / FETCH OPTION WORD /A018 CDFMYF / BACK TO THIS FIELD /A018 DCA SROPTN / SAVE VALUE /A018 AC0004 / MASK VALUE FOR WINCHESTER DRIVE /A018 AND SROPTN / IS WINNIE BIT SET ? /A018 SNA CLA / YES - SKIP AND CONTINUE /A018 JMP E13 / NO - USE "DISKETTE /A018 / /****** - SYSTEM HAS WINCHESTER, CK WHICH DRIVE HAS THE OUTPUT DOC. /A018 / TAD SOTFL / FETCH DRIVE # /A018 AND (7400) / MASK FOR DRIVE # /A018 BSW / SWAP /A018 CLL RTR / DRIVE # INTO LOW 4 BITS /A018 DCA SRDRVN / SAVE VALUE /A018 TAD SRDRVN / CK FOR DRIVE 0 /A018 SNA / NO - SKIP AND CONTINUE /A018 JMP E13 / YES - USE "DISKETTE /A018 TAD (-1 / IS IT 1 ? /A018 SZA CLA / YES - SKIP AND CONTINUE /A018 JMP E13A / NO - USE "VOLUME /A018 AC0010 / MASK - VOLUME ASSIGNED TO DEVICE 1 /A018 AND SROPTN / IS VOLUME ASSIGNED ? /A018 SNA CLA / YES - SKIP AND USE "VOLUME /A018 JMP E13 / NO - USE "DISKETTE /A018 JMP E13A / USE "VOLUME /A018 SROPTN, 0 SRDRVN, 0 PAGE / MORE THAN 1 MULTI-KEY RECORD IS IN THE 'FNVARTABLE' ADVANCE,XX / / ENTER WITH THE CONTENTS OF THE ACCUMULATOR EQUIVALENT KEY # DCA KEYID / RESET / (UPDATE) 'KEYID' USED BY 'KEYSEARCH' TAD BOTADR JMS KEYSEARCH / (KEYID) DCA BOTVATADR / 'PREVIOUS' KEY'S [VAT] ADDRESS LOOP, TAD TOPADR JMS KEYSEARCH / (KEYID) DCA TOPVATADR / 'THIS' KEY'S [VAT] ADDRESS CDFFNV /--------------------//CDF / TAD I BOTVATADR / [VAT] AND (-MKSBIT-1) / 7757 / X VVVVV S [0=M] KKKK DCA T1 TAD I TOPVATADR / [VAT] AND (-MKSBIT-1) CIA TAD T1 SZA CLA JMP I ADVANCE / EXIT - DIFFERENT 'VAT'S TAD BOTVATADR DCA T1 / 'T1' GETS 'ISZ'D TAD I T1 / [VAT] AND (VVVVV^100) SNA JMP NOVVVVV / 'VVVVV' = 0 MEANS NON-EXISTANT KEY BSW CIA DCA T2 /-VVVVV NEXTV, ISZ T1 ISZ TOPVATADR TAD I T1 / V V CIA TAD I TOPVATADR / V V SZA CLA JMP I ADVANCE / EXIT - DIFFERENT 'VVVVV'S ISZ T2 JMP NEXTV NOVVVVV, CDFMYF /--------------------//CDF / / THE 'VVVVV'ALUES ARE STILL EQUAL / MOVE DOWN THE 'FNVARTABLE' UNTIL THE 'VVVVV'ALUES CHANGE / WHICH MEANS AT A PRIMARY KEY BREAK JMS TSTTOPADR / 'ISZ TOPADR' JMP I ADVANCE / EXIT - AT 'TOPADR' OF LIST JMP LOOP BOTVATADR, ZBLOCK 1 / 'VAT' ADDRESS FOR THE 'BOTTOM' ELEMENT TOPVATADR, ZBLOCK 1 / 'VAT' ADDRESS FOR THE 'TOP' ELEMENT / MULTI-KEY SORT SUBROUTINE TO / SEARCH FOR THE KEY # (WITHIN PROGRAM LOCATION 'KEYID') / WITHIN THE FNVAR LIST / STARTING AT THE LOGICAL ADDRESS WITHIN THE AC AT ENTRY / UNTIL THE KEY # IS FOUND, OR / UNTIL 'VAT' MKS-BIT = 0 KEYSEARCH, XX DCA T1 / WORK / SEARCH STARTING ADDRESS FROM AC CDFFNV /--------------------//CDF / TAD I T1 / FNVAR / GET THE 'VAT' ADDRESS FOR THIS RECORD KEYLOOP,TAD (4) /OFFSET / 'VAT' ADDRESS OFFSET DCA T1 TAD I T1 / [VAT] DCA T2 / XVV VVV SMK KKK TAD T2 AND (KKKK) CIA TAD KEYID SZA CLA JMP .+4 KEYEND, CDFMYF /--------------------//CDF / TAD T1 JMP I KEYSEARCH / EXIT / WITH (AC) = 'VAT' ADDRESS OF KEY # TAD T2 AND (MKSBIT) / M SNA CLA JMP KEYEND / EXIT / BECAUSE MKS-BIT = 0 TAD T2 / [VAT] BSW AND (VVVVV) TAD T1 JMP KEYLOOP / UNTIL KEY IS FOUND; OR M-BIT = 0 KEYID, ZBLOCK 1 / 1; 15 PAGE / ** DESCIPTION / / THIS PAGE CONTAINS THE SHELL SORT ALOGRITHM. GIVEN THE / NUMBER OF ELEMENTS IN THE LSTADR TO BE SORTED, AN OPTIMUM / DISTANCE BETWEEN ELEMENTS IS CALCULATED. ALL ELEMENTS / WHICH ARE SEPERATED BY THE CALCULATED "DISTANCE" MAKE UP / A PARTITION. THE ELEMENTS IN THE PARTITION ARE SORTED. / AFTER A PARTITION IS SORTED THE DISTANCE IS RECOMPUTED, / AND NEW PARTITIONS ARE DEFINED USING THIS DISTANCE. WHEN / VALUE OF DISTANCE EQUALS "1", THE SORT IS COMPLETED. / / ** INPUT - IMPLICIT - / / COUNT -Autoindex Register (FNVAR) contains the last address / in which FNV pointers are stored / / LSTADR -The starting address (-1) of the LSTADR to be sorted / Assumed to be FNVARBUFFER-1 / / ** OUTPUT / / LSTADR -The Input LSTADR in sorted order / / ** LOCAL VARIABLES (TO THIS PAGE) / DISTNC, 0 / The distance between elements in a partition BOTINX, 0 / An index to the botINXtom element in a partition TOPINX, 0 / An index to the topINX element in a partition FREINX, 0 / An index to the free element in a partition BOTPTR, ZBLOCK 1 / Pointer (address) to the botINXtom element in a partition TOPPTR, ZBLOCK 1 / Pointer (address) to the topINX element in a partition FREPTR, ZBLOCK 1 / Pointer (address) to the free element in a partition TOPTMP, 0 / TOPTMPorary storage for the TOPINX element in a partition EXCHNG, 0 / A boolean, 0=FALSE, 1=TRUE NUMELM, 0 / Number of elements to be sorted (computed) LSTADR, ZBLOCK 1 / The address (-1) of the LSTADR to be sorted / FIND INITIAL DISTANCE FOR SHELL's SORT / .............................................................................. / IF NUMELM<=1 (No need to sort if there / THEN EXIT (are "1" or less elements / / DISTNC=1 / WHILE DISTNC0 / BOTINX=1 / TOPINX=BOTINX+DISTNC / / WHILE TOPINX<=NUMELM / DO "ORDER THE PARTITION" / BOTINX=BOTINX+1 / TOPINX=BOTINX+DISTNC / / DISTNC=DISTNC+1 / DO "FIND HIBBARD VALUE" / ..... ( SORT EXIT ) ................... SHLSORT,TAD DISTNC / IS DISTNC > 0 SPA SNA CLA / 7750 / YES, SKIP IF AC > 0 JMP I XSORT / NO, DONE AC0001 DCA BOTINX / BOTINX=1 TAD BOTINX TAD DISTNC DCA TOPINX / TOPINX=BOTINX+DISTNC PARTSRT,TAD TOPINX / IS TOPINX <= NUMELM CIA TAD NUMELM SPA CLA / YES, SKIP IF AC >= 0 JMP NXTDIS / NO, EXIT THE WHILE LOOP /-- JMS ORDPART / DO "ORDER THE PARTITION" / ..............ORDER THE PARTITION........................ / TOPTMP=LSTADR(TOPINX) / FREINX=TOPINX / DO "COMPARE ELEMENTS" / WHILE BOTINX>DISTNC AND EXCHNG=TRUE (Defined for an ascending sort) / BOTINX=BOTINX-DISTNC / DO "COMPARE ELEMENTS" / BOTINX=TOPINX-DISTNC (Need to restore BOTINX since it may have) / (changed by 'secondary' compares) / ...... (RETURN TO "SORT THE PARTITIONS") ..... /--ORDPART,XX TAD LSTADR TAD TOPINX DCA TOPPTR / CREATE "LSTADR(TOPINX)" POINTER CDFFNV /--------------------//CDF / TAD I TOPPTR CDFMYF /--------------------//CDF / DCA TOPTMP / TOPTMP=LSTADR(TOPINX) TAD TOPINX DCA FREINX / FREINX=TOPINX JMS CMPELMT / DO "COMPARE ELEMENTS" SCNDRY, TAD BOTINX / IS BOTINX > DISTNC CIA TAD DISTNC SMA CLA / YES, SKIP IF AC < 0 JMP DONEORD / NO TAD EXCHNG / IS EXCHNG TRUE SPA SNA CLA / YES JMP DONEORD / NO TAD DISTNC CIA TAD BOTINX DCA BOTINX / BOTINX=BOTINX-DISTNC JMS CMPELMT / DO "COMPARE ELEMENTS" JMP SCNDRY / STAY IN WHILE LOOP DONEORD,TAD DISTNC CIA TAD TOPINX DCA BOTINX / BOTINX=TOPINX-DISTNC /-- JMP I ORDPART ISZ BOTINX / BOTINX+1 NOP TAD BOTINX TAD DISTNC DCA TOPINX / TOPINX=BOTINX+DISTNC JMP PARTSRT / STAY IN INNER WHILE LOOP NXTDIS, ISZ DISTNC / DISTNC+1 NOP JMS FNDHIB / DO "FIND HIBBARD VALUE" JMP SHLSORT / STAY IN OUTER WHILE LOOP / .. COMPARE THE ELEMENTS ........................ / EXCHNG=FALSE / DO EVALUATION / IF EXCHNG=TRUE / THEN / LSTADR(FREINX)=LSTADR(BOTINX) / LSTADR(BOTINX)=TOPTMP / FREINX=BOTINX / ...... (RETURN TO "ORDER THE PARTITION") ....... CMPELMT,XX DCA EXCHNG / EXCHNG=FALSE (0) TAD LSTADR TAD BOTINX DCA BOTPTR / CREATE "LSTADR(BOTINX)" POINTER TAD LSTADR TAD FREINX DCA FREPTR / CREATE "LSTADR(FREINX)" POINTER JMS EVAL / COMPARE THE SORT FIELDS DCA EXCHNG / SAVE EXCHANGE INDICATOR TAD EXCHNG / IS EXCHNG=TRUE SNA CLA / YES, SKIP IF AC <> 0 JMP I CMPELMT / NO CDFFNV /--------------------//CDF / TAD I BOTPTR DCA I FREPTR / LSTADR(FREINX)=LSTADR(BOTINX) TAD TOPTMP DCA I BOTPTR / LSTADR(BOTINX)=TOPTMP CDFMYF /--------------------//CDF / TAD BOTINX DCA FREINX / FREINX=BOTINX JMP I CMPELMT PAGE BOTDAT, 0 / AN ADDRESS POINTER TO THE BOTINX DATA ELEMENT FREDAT, 0 / AN ADDRESS POINTER TO THE FREE DATA ELEMENT BINVALID,0 / A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (BOTINX) FINVALID,0 / A BOOLEAN (0=F, 1=T), TRUE = INVALID FIELD (FREINX) BOTCNT, 0 / A COUNT OF THE NUMBER OF CHARACTERS IN BOTINX FIELD FRECNT, 0 / A COUNT OF THE NUMBER OF CHARACTERS IN FREE FIELD CHARCT, 0 / THE NUMBER OF CHARACTERS TO BE COMPARED / EQUALS THE LESSER OF BOTCHR/FRECHR / ** INTEROGATE VAT ** / SET INVALID FIELD INDICATORS & DETERMINE SORT FIELD LENGHTS / INVLD=FALSE / BOTDAT=(BOTPTR)+4 (ADDR = (ADDR OF REC] - 1) / FREDAT=(FREPTR)+4 (ADDR = (ADDR OF REC] - 1) / IF (BOTDAT) IS INVALID / THEN / DO INVALD / BINVALID = TRUE / BOTCNT=(BOTDAT IS THE CHARACTER COUNT) / / IF (FREDAT) IS INVALID / THEN / DO INVALD / FINVALID = TRUE / FRECNT=(FREDAT IS THE CHARACTER COUNT) / / (FALL THROUGH TO "RESOLVE INVALID FIELD CONDITIONS") EVAL, XX / ENTRY POINT TO EVALUATION LOGIC TAD SORTKEY CLL RAR SZA CLA JMP EVALMKS / MULTI-KEY SORT TAD BOTPTR DCA BOTDAT TAD FREPTR DCA FREDAT CDFFNV /--------------------//CDF / AC0004 / ADDR = (ADDR OF REC) - 1 TAD I BOTDAT DCA BOTDAT / BOTDAT=(BOTPTR)+4 AC0004 / ADDR = (ADDR OF REC) - 1 TAD I FREDAT CDFMYF /--------------------//CDF / JMP .+6 / FREDAT=(FREPTR)+4 EVALMKS,TAD BOTPTR JMS KEYSEARCH DCA BOTDAT / 'VAT' ADDRESS OF RECORD ENTRY IN FNVTABLE TAD FREPTR JMS KEYSEARCH DCA FREDAT CDFFNV /--------------------//CDF / TAD I BOTDAT / [VAT] BSW AND (VVVVV) DCA BOTCNT / BOTCNT=(BOTDAT -CHARACTER COUNT-) TAD I FREDAT / [VAT] BSW AND (VVVVV) DCA FRECNT / FRECNT=(FREDAT -CHARACTER COUNT-) CDFMYF /--------------------//CDF / TAD BOTCNT / VVVVV SNA CLA AC0001 / [1] / MEANS 'BOTINX' DATA FIELD IS INVALID DCA BINVALID TAD FRECNT / VVVVV SNA CLA AC0001 / [1] / MEANS 'FRE' DATA FIELD IS INVALID DCA FINVALID /\ JMP CKINVL / ** RESOLVE INVALID FIELD CONDITIONS ** / IF THE "INVLD" FLAG WAS SET, CHECK WHICH FIELDS / WERE INVALID. INVALID FIELDS ARE TREATED AS IF THEY / CONTAINED HIGH VALUES. THEY GO TO THE BOTINX IN / ASCENDING SORTS, AND ON THE TOPINX IN DESCENDING SORTS. / THE COMPARISON ROUTINE WILL TAKE THE PROPER EXIT IF ONLY / ONE OF THE FIELDS WAS INVALID, AND IT WILL RETURN / IF BOTINXH WERE INVALID. IN THIS CASE THE ELEMENTS ARE / IN ORDER, AND THE ROUTINE IS EXITED. / IF INVLD=TRUE / THEN / DO COMPARISON (OF 'BINVALID' VS 'FINVALID') / EXIT (BOTINXH FIELDS WERE INVALID) / / (FALL THROUGH TO "SET UP COMPARE LOOP COUNTER") CKINVL, TAD BINVALID / IF INVLD=TRUE TAD FINVALID SNA CLA / THEN JMP SETLC / ELSE TAD BINVALID CLL CIA TAD FINVALID JMS VALCMP / DO COMPARISON JMP I EVAL / BOTH FIELS WERE INVALID / ** SET UP COMPARE LOOP COUNTER ** / FIND THE LESSER OF FRECNT, BOTCNT. THAT WILL BE THE NUMBER / OF CHARACTERS TO BE COMPARED. / CHARCT=FRECNT / IF BOTCNT0 / BOTCHR="UNPACK CHARACTER"(BOTINX) / FRECHR="UNPACK CHARACTER"(FRE) / DO COMPARISON (OF BOTCHR VS FRECHR / CHARCT=CHARCT-1 (CHARACTERS WERE EQUAL) / IF CHRPTR=0 / THEN / CHRPTR=1 / ELSE / RESET (CHRPTR, BOTDAT, FREDAT) / (FALL THROUGH TO "COMMON EVALUATION EXITS") CMPLOP, ISZ BOTDAT / V V NOP ISZ FREDAT / V V NOP TAD CHARCT / IF CHARCT > 0 SPA SNA CLA / THEN, SKIP IF AC > 0 JMP CKEXCH / ELSE CDFFNV /--------------------//CDF / TAD I BOTDAT / BOTCHR="UNPACK CHARACTER"(BOTINX) CLL CIA TAD I FREDAT / FRECHR="UNPACK CHARACTER"(FRE) CDFMYF /--------------------//CDF / JMS VALCMP / DO COMPARISON OF BOTCHR VS FRECHR AC7777 / -1 TAD CHARCT DCA CHARCT / CHARCT = CHARCT-1 JMP CMPLOP / COMPARE 2 VALUES / THIS ROUTINE IS USED FOR ALL COMPARISONS RELATING TO ORDER. / ............................................................................. / FOR ASCENDING:: ASCDSC, SZL / ............................................................................. / / FOR INVLD FLD FOR STRING LGTH FOR CHARACTER / COMPARISON COMPARISON COMPARISON / RELATION (VLD=0, INVLD=1) /----------------------------------------------------------------------------- / A > B | EXCHG ELEMENTS | EXCHG ELEMENTS | EXCHG ELEMENTS / | | | / A = B | RETURN TO RTN | RETURN TO RTN | RETURN TO RTN / | | | / A < B | ORDER IS OK | ORDER IS OK | ORDER IS OK /----------------------------------------------------------------------------- / / / / / / / / ............................................................................. / FOR DESCENDING:: ASCDSC, SNL / ............................................................................. / / FOR INVLD FLD FOR STRING LGTH FOR CHARACTER / COMPARISON COMPARISON COMPARISON / RELATION (VLD=0, INVLD=1) /----------------------------------------------------------------------------- / A < B | EXCHG ELEMENTS | EXCHG ELEMENTS | EXCHG ELEMENTS / | | | / A = B | RETURN TO RTN | RETURN TO RTN | RETURN TO RTN / | | | / A > B | ORDER IS OK | ORDER IS OK | ORDER IS OK /----------------------------------------------------------------------------- / A:: IS 'BOT...' / B:: IS 'FRE...' VALCMP, XX SNA CLA JMP I VALCMP / THE ELEMENTS ARE EQUAL /............................................................................... ASCDSC, ZBLOCK 1 / [ASC]ENDING = 'SZL' (7430); [DES]CENDING = 'SNL' (7420) /............................................................................... JMP EXCH / EXCHANGE THE ELEMENTS JMP I EVAL / ELEMENTS ARE ORDERED / ** COMMON EVALUATION EXITS ** / CKEXCH- IF THE FIELDS WERE EQUAL IN VALUE, THIS EXIT ROUTINE WILL / CHECK TO SEE IF THEY WERE EQUAL IN LENGTH. DIFFERENCES IN / FIELD LENGTH DETERMINES ORDER. / CKEXCH, TAD BOTCNT / IF BOTCNT > FRECNT CIA; CLL TAD FRECNT JMS VALCMP / DO COMPARISON OF BOTCNT VS FRECNT SKP EXCH, AC0001 / EXCHANGE THE ELEMENTS JMP I EVAL / COUNTS WERE EQUAL / ........ FIND HIBBARD VALUE ........ / DISTNC=DISTNC/2 / DISTNC=DISTNC-1 FNDHIB, XX TAD DISTNC CLL RAR / DISTNC=DISTNC/2 TAD (-1) DCA DISTNC / DISTNC=DISTNC-1 JMP I FNDHIB PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// NVFP .PA - NUMERIC VALUE FIELD PARSER \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / Numeric Value Field (NV) Parser / Subroutine to parse the <:FIELD NAME> 'value' field of a record / to determine its numeric (decimal) significence (and alignment) / IF the SELECTOR set (NVFFLAG)=7777 / (means <:FIELD NAME> not was found) / THEN capture program control and / parse the 'value' field of the record / for its numeric (decimal) significence / aligning [Kwhole] places to the left / of the decimal point and [KFraction] / places to the right of the point / ELSE exit with (AC) unchanged = 6-bit character at entry / Entry with the contents of the AC = the 6-bit character: 000000cccccc / FROM THE 'VALUE' FIELD OF THE RECORD / / Exit from the nvfprocessor with a 'jmp i nvfprocessor' / (if no numeric fields specified in the specification doc) / / else exit is with a 'jmp gotall' / / JMS NVFPROCESSOR; return pc (if no numeric fields defined) NVFPROCESSOR, XX / DCA T1NVF / Temporarily save the 6-bit char / IF THERE IS NO NUMERIC <:FN> / THAT MEANS THE CONTENTS OF 'FTYPE' = 0 / THEN NO NEED TO EXECUTE THIS TEST / BUT IF THERE IS AT LEAST ONE <:FN> / THAT MEANS THE CONTENTS OF 'FTYPE' ARE NOT ZERO / THEN WE MUST EXECUTE THIS TEST LOOP / BECAUSE THE KEY # DON'T COME FROM THE INPUT DOC IN ORDER TAD KEYNO CIA DCA T2NVF TAD FTYPE / TTT TTT TTT TTT SNA JMP FTYPE0 CLL RAL ISZ T2NVF JMP .-2 SZL CLA JMP NVFPARSE FTYPE0, TAD T1NVF / Get back the AC at entry JMP I NVFPROCESSOR / EXIT / <:FIELD NAME> was detected by the SELECTOR and (NVFFLAG) = 7777 / therefore this 'value' field will be parsed for its decimal significence NVFPARSE, TAD (NVFBUFFER-1) / Holding buffer for ASCII character string DCA X0 / Auto-index register #1 TAD (-KWHOLE-1) DCA NLCOUNT / left justification total (for ISZ) DCA NVFJUSTIFICATION/ combined left and right justification DCA NVFVAT / 'NVF' VALUE ATTRIBUTE JMP NVF1ST / Capture MAIN-LINE control to parse the 'value' field / Start the process then the first ascii character with / the code between 60 and 71 inclusive is detected / End the process when the first non-numeric character / is detected (except natural language characters) IGNORE, NEXTNVF,AC7777 JMS RD1VALUECHAR / Get a character of the 'value' field JMP E7 /* Disk EOF should not have happened here JMP .-3 / ignore this non-printing character JMP NVFLAB / JMP means '<' or start of '<>' detected JMP E5CLA /* found '>' within value field AND P177 / AC=mmmmmccccccc (mask mmmmmODE bits) DCA T1NVF / temporarily save the 7-bit character NVF1ST, TAD T1NVF / TAD (-71) / minus ASCII numeric 9 SMA SZA / JMP TSTNATURALS / JMP means character greater than ascii 9 TAD (11) / AC=-60 SPA CLA / JMP TSTNATURALS / JMP means character NOT between 60-71 / IF THE ASCII CHARACTER IS 61 THRU 71 / THEN SET THE 'X' BIT IN THE 'NVFVAT' TAD (-60) / TAD T1NVF / SNA CLA / SKIP NEXT BECAUSE ASCII 1 THRU 9 JMP SAVENVF / JMP CAUSE ASCII 0 TAD NVFVAT / AND (-10-1) / TAD (10) / SETS THE 'X' BIT DCA NVFVAT / / This particular character from the 'value' field / is between the ASCII codes 60-71 (0-9) inclusive / therefore save it within the holding buffer / for alignment (padding within the FNV table) later SAVENVF,AC0004 / cannot have numbers following a ')' /A0010 AND NVFVAT / do we have a ')' already? /A0010 SZA CLA /A0010 JMP E12A / yes, means illegal placement of ')' /A0010 TAD (1000) / cannot have numbers after trailing '-'/A0010 AND NVFVAT / is there a trailing '-'? /A0010 SZA CLA /A0010 JMP E12B / yes, no numbers may follow... /A0010 TAD T1NVF DCA I X0 / 'I' into the holding buffer ISZ NVFJUSTIFICATION/ 0-77 (will never overflow) ISZ NVFCOUNT / +1 to the 'V'alue JUSTIFICATION total JMP NEXTNVF JMP E12C /* JMP means to many 'value' characters / This particular character from the 'value' field / is NOT between the ASCII codes 60-71 (0-9) inclusive / therefore test for imbedded Natural language characters: / - decimal point / - decimal comma / - plus sign / - minus sign (LEADING or TRAILING) / - left paren (implied minus sign) / - right paren / - space (LEADing's are ignored but IMBEDDED's are kept) / - decimal colon / - asterisk TSTNATURALS, CLA / clean-up the AC TAD (NATURALS-2) DCA X1 NATLOOP,ISZ X1 TAD I X1 SNA JMP E12D /* - MEANS [0] TABLE TERMINATOR TAD T1NVF SNA CLA JMP I X1 JMP NATLOOP NATURALS, -55; JMP AMINUS / minus sign -50; JMP ALPAREN / left paren -51; JMP ARPAREN / right paren -40; JMP ASPACE / space -53; JMP APLUS / plus sign -54; JMP IGNORE / (ignore ALPHA) comma -52; JMP IGNORE / (ignore ALPHA) asterisk / ........................................................................ / CONDITIONALIZE the RADIX POINT and CURRENCY SYMBOL for NATURAL LANGUAGES -56; JMP APERIOD / period -44; JMP SPECIE / (ignore ALPHA) dollar sign -43; JMP SPECIE / (ignore ALPHA) pound sign / A20 / ........................................................................ 0 / TABLE TERMINATOR PAGE / A LEFT ANGLE BRACKET '<' HAS BEEN DETECTED / THEREFORE, ALIGN THE NUMERIC VALUE CHARACTERS / (BEING HELD WITHIN THE 'NVFBUFFER') / FOR DECIMAL SIGNIFICENCE / (PACK AS 6-BIT) INCLUDING LEADING AND TRAILING ZEROS IF APPLICABLE NVFLAB, AC6000 / CHECK FOR ')' FOLLOWING A '(' /A0010 AND NVFVAT / DO WE HAVE A '('? /A0010 TAD (-6000) /A0010 SZA CLA /A0010 JMP NVFL1 / NO... /A0010 AC0004 / YES, DO WE HAVE A MATCHING ')' ? /A0010 AND NVFVAT /A0010 SNA CLA /A0010 JMP E12E / NO, UNMATCHED PARENS. /A0010 NVFL1, AC7776 / COUNT OF -2 DCA VALCOUNT / USED FOR 6-BIT PACKING TAD (NVFBUFFER-1) / ADDRESS-1 OF THE NVFBUFFER DCA X0 / AUTO-INDEX REGISTER TAD NVFJUSTIFICATION/ LLLLLLRRRRRR SNA CLA / SKIP NEXT IF NO DIGITS 'LEFT OF' OR 'RIGHT OF' JMP GOTALL / EXIT BECAUSE A 'BLANK' VALUE FIELD AC0001 AND NVFVAT SZA CLA JMP .+4 TAD NVFJUSTIFICATION BSW DCA NVFJUSTIFICATION TAD NVFVAT / (N)UMERIC (V)ALUE (F)IELD (AT)TRIBUTE SPA CLA / SKIP NEXT IF + SIGN AC7776 / THE DECIMAL SIGNIFICENCE IS NEGATIVE /M0010 TAD (53) / THE DECIMAL SIGNIFICENCE IS POSITIVE JMS NVFPACK / STUFF SIGN (- OR +) INTO (FNV)TABLE TAD NVFJUSTIFICATION/ LLLLLLRRRRRR (L-LEFT OF, R-RIGHT OF) BSW / RRRRRRLLLLLL AND P77 / ACTUAL # DIGITS 'LEFT OF DECIMAL POINT' TAD (-KWHOLE) / MAXIMUM # PLACES ALLOWED TO THE LEFT SZA / (AC) = DIFFERENCE BETWEEN ACTUAL AND MAXIMUM JMS NVFPADZEROS / PAD LEADING 0'S (CAUSE ACTUAL LESS THAN MAX) TAD NVFJUSTIFICATION/ LLLLLLRRRRRR BSW / RRRRRRLLLLLL AND P77 CIA / 2'S COMP OF ACTUAL # DIGITS 'LEFT OF' SZA / SKIP NEXT IF NO DIGITS LEFT OF DECIMAL POINT JMS NVFFILL / STUFF THOSE DIGITS INTO THE (FNV)TABLE /-- TAD (KPERIOD) /------ /-- JMS NVFPACK /------ TAD NVFJUSTIFICATION/ LLLLLLRRRRRR AND P77 / ACTUAL # DIGITS 'RIGHT OF DECIMAL POINT' CIA / 2'S COMP OF THAT NUMBER SZA / SKIP NEXT IF NO DIGITS 'RIGHT OF' JMS NVFFILL / STUFF THOSE DIGITS INTO THE (FNV)TABLE TAD NVFJUSTIFICATION/ LLLLLLRRRRRR AND P77 / ACTUAL # 'RIGHT OF' TAD (-KFRACTION) / MAXIMUM # PLACES ALLOWED TO THE RIGHT SZA / SKIP NEXT IF ACTUAL=MAXIMUM JMS NVFPADZEROS / PAD TRAILING 0'S (CAUSE ACTUAL LESS THAN MAX) JMP GOTALL / EXIT / NVF SUBROUTINE to 'FIX' (correct by 9's complementing) /A011 / THE VALUE OF THE NUMERIC FIELD /A011 / (IF THE DECIMAL SIGNIFICENCE IS negative) /A011 / enabling negative value fields to sort algebraically /A011 / /A011 / -9999.99 /A011 / - 999.99 /A011 / - 99.99 /A011 / - 9.99 /A011 / - .99 /A011 / - .9 /A011 / + .99 /A011 / /A011 / BUT if the 'X' bit (within the NVFVAT = 0) is 0 /A011 / then the nvf (numeric value field) is all zeros /A011 / so don't fix /A011 / /A011 NVFFIX, XX / /A011 / /A011 / ENTER WITH THE AC = 6-BIT ASCII CHARACTER /A011 / IN THE RANGE OF 60 TO 71 /A011 / /A011 DCA T1FIX / save the character (temporarily) /A011 TAD NVFVAT / get the value attributes /A011 AND (10) / mask the 'X' bit /a011 SNA CLA / skip next if 'X' bit set /a011 JMP NVFNOFIX / jmp cause the nvf=00000000.000 /a011 TAD NVFVAT / get the attributes again /a011 SMA CLA / skip next if negative value /a011 JMP NVFNOFIX / jmp cause the nvf is positive /a011 TAD T1FIX / get back the 6-bit ascii at entry /a011 TAD (-71) / -9 / ... 9'S /A011 CIA / ... COMPLE- /A011 TAD (60) / 0 / ... MENT /A011 JMP I NVFFIX / EXIT with the ac=1's compliment value /a011 NVFNOFIX, TAD T1FIX / get back the character at entry /a011 JMP I NVFFIX / EXIT without complimenting /a011 T1FIX, ZBLOCK 1 / holds the 6-bit temporarily /a011 / NVF SUBROUTINE TO PRECEED OR POSTCEED / (PAD) THE DECIMAL VALUE WITH LEADING OR TRAILING 0'S NVFPADZEROS, XX / ENTER WITH (AC) = 2'S COMP # OF PLACES TO PAD DCA T1NVF / SAVE THAT 2'S COMP # FOR 'ISZ T1NVF' LATER TAD (60) / ASCII ZERO (0) JMS NVFFIX / FIX THE VALUE FOR NEGATIVE nvf's /a011 JMS NVFPACK / 6-BIT PACK IT ISZ T1NVF / UPDATE THE COUNT JMP .-4 / UNTIL (T1NVF) = 0 JMP I NVFPADZEROS / EXIT (PADDING COMPLETE) / NVF SUBROUTINE TO / TRANSFER THE 'LLLLLL' DIGITS TO THE LEFT OF THE DECIMAL POINT / (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0) / OR TO TRANSFER THE 'RRRRRR' DIGITS TO THE RIGHT OF THE DECIMAL POINT / (UNTIL THE CONTENTS OF PROGRAM LOCATION 'T1NVF'=0) NVFFILL, XX / ENTER WITH (AC) = 2'S COMP # OF DIGITS TO FILL DCA T1NVF / SAVE FOR 'ISZ T1NVF' LATER TAD I X0 / 'LEFT' OR 'RIGHT' PLACED DIGITS JMS NVFFIX / FIX THE VALUE FOR NEGATIVE nvf's /a011 JMS NVFPACK / 6-BIT PACK EM ISZ T1NVF / UPDATE THE COUNT JMP .-4 / UNTIL (T1NVF)=0 JMP I NVFFILL / DONE / NVF SUBROUTINE TO / STUFF THE CONTENTS OF THE AC (000000CCCCCC) / INTO THE (FNV)TABLE AS 6-BIT 'TEXT' NVFPACK,XX / ENTER WITH THE (AC) = 6-BIT CHAR TO PACK ISZ VALCOUNT / SKIP NEXT WHEN 2 CHAR'S READY FOR PACKING JMP .+5 / JMP MEANS POSITION 1ST OF 2 CHAR'S FOR PACKING TAD PACK6BIT / PACK THIS 2ND CHAR WITH THE 1ST DCAFNV / STUFF INTO THE (FNV)TABLE AC7776 / -2 DCA VALCOUNT / RESET THE COUNTER BSW / BSW MEANS POSITION THIS 1ST CHAR FOR PACKING DCA PACK6BIT JMP I NVFPACK PAGE / The character is a LEFT PAREN '(' ALPAREN,TAD NVFJUSTIFICATION SZA CLA JMP E12F /* - means ILLEGAL PLACEMENT of '(' AC6000 AND NVFVAT SZA CLA JMP E12G /* - means a '+' or '-' PRECEEDED '(' AC6000 JMP SETNVF / The character is a RIGHT PAREN ')' ARPAREN,AC6000 AND NVFVAT TAD (-6000) SZA CLA JMP E12H /* - means no '(' before ')' TAD NVFJUSTIFICATION SNA CLA JMP E12I /* - means '()' AC0004 AND NVFVAT SZA CLA JMP E12J /* - means extra ')' AC0004 JMP SETNVF / The character is a PLUS SIGN /*E12 - means syntax error for extra (or illegal placement of) '+' APLUS, TAD NVFJUSTIFICATION /A0010 SZA CLA /A0010 JMP E12K /* - means illegal placement of '+' /A0010 AC0002 /A0010 AND NVFVAT /A0010 SZA CLA /A0010 JMP E12K /* - means illegal placement of '+' /A0010 AC2000 JMP MINUS2 /M0010 / The character is a MINUS SIGN /*E12 - means syntax error for extra (or illegal placement of) '-' AMINUS, TAD NVFJUSTIFICATION/ |if NOT the first character /A0010 SZA CLA / |then /A0010 JMP MINUS1 / | go set trailing '-' bit /A0010 AC0002 / |else /A0010 AND NVFVAT / | |if previous '$' /A0010 SZA CLA / | |then /A0010 JMP E12B / | | illegal placement of '-' /A0010 / | |else /A0010 AC4000 / | | set '-' sign bit /A0010 SKP / /A0010 MINUS1, TAD (5000) / set trailing '-' bit /A0010 / .......................................................................... MINUS2, MQL / .......................................................................... CLA /A0010 TAD (7000) / check for previous SIGN /M0010 AND NVFVAT SZA CLA JMP E12L /* - means extra SIGN found / .......................................................................... CLA MQA / 2000; or 4000 / .......................................................................... SETNVF, TAD NVFVAT DCA NVFVAT JMP NEXTNVF / The character is a CURRENCY SYMBOL / [conditionalized for natural languages] SPECIE, AC0002 AND NVFVAT SZA CLA JMP E12M /* - means extra currency (money) symbol TAD NVFJUSTIFICATION /A0010 SZA CLA /A0010 JMP E12N /* - means illegal placement of '$' /A0010 / AC6000 /D0010 / AND NVFVAT /D0010 / SNA CLA /D0010 / JMP E12 /* - means no 'sign' before symbol /D0010 AC0002 JMP SETNVF / The character is a SPACE ' ' ASPACE, TAD NVFJUSTIFICATION SNA CLA JMP IGNORE / LEADING SPACE /\ JMP NVFEND / IMBEDDED SPACE TERMINATES NUMBER / This is the END of the numeric value field parse / IGNORE all characters until the next left angle bracket '<' NVFEND, AC7777 JMS RD1VALUECHAR / Get a character of the 'value' field JMP E7 /* Disk EOF should not have happened here JMP .-3 / ignore this non-printing character JMP NVFLAB / JMP means '<' or start of '<>' detected JMP E5CLA /* found '>' within value field JMP .-6 / ignore this printable character / The character is a DECIMAL POINT '.' [RADIX SEPERATOR] /*E12 - means syntax error for extra '.' (or illegal placement) APERIOD,AC0001 AND NVFVAT SZA CLA JMP E12P /* - means extra '.' found ISZ NVFVAT / set decimal point found indicator TAD (-KWHOLE) TAD NVFJUSTIFICATION TAD (KFRACTION) SPA CLA TAD (-KFRACTION-1) DCA NRCOUNT TAD NVFJUSTIFICATION BSW DCA NVFJUSTIFICATION JMP NEXTNVF T1NVF, ZBLOCK 1 / TEMPorary holding register / ............................................................................. KWHOLE= 15 / UP TO 13(10) places LEFT of DECIMAL KFRACTION= 06 / UP TO places RIGHT of DECIMAL / ............................................................................. / HOLDing buffer for NUMERIC VALUE characters / SIGN, LLLLLL, RRRRRR, (-1) SLUSH NVFBUFFER,ZBLOCK 1+KWHOLE+KFRACTION+1 / / / / / T2NVF, NLCOUNT, NRCOUNT, NVFCOUNT, -KWHOLE-1 / then -KFRACTION-1 NVFJUSTIFICATION, 0 / LLLLLL RRRRRR NVFVAT, ZBLOCK 1 / S S S - - - - - X R C D /______________________________ / 0 0 0 - (IMPLIED+)\ | | | | / 0 1 0 - PLUS sign \ | | | 1 - DECIMAL POINT found / 1 0 0 - MINUS sign\ | | 1 - CURRENCY SYMBOL found / | 1 - RIGHT PAREN found / 0 - nvf=000.000 / 1 1 0 - LEFT PAREN\ / (implied MINUS)\ / 1 0 1 - trailing \ /A0010 / MINUS\ /A0010 PAGE ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// WPSRTX.PA - TEXT \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ //////// \\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ////////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ / THE SCREEN SIZE IS 24 LINES X 80 COLUMNS / * COLUMNS 0 THRU 79: / * / *0 10 20 30 40 50 60 70 / *! ! ! ! ! ! ! ! / LINES *01234567890*********01234567890*********0*********0*********0*********0********* / 0-23:0 DATE/TIME / 1 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 2 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 3 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 4 X - INFORMATION LEFT BY SORT PARSER AND MENUS / 5 BLANK LINE / 6 Primary Key Records: X OUT OF Y / 7 Multiple ruler warning / 8 Records output: Z / 9 BLANK LINE / 10 --------- OR, WORKING, PAUSED, ABORTED, DONE / 11 --ERROR-- M1, THRU... / 12 --------- / 13 BLANK LINE / * ???????? LINES #14 THRU #21 / * ???????? CONTAINS UP TO 7 LINES / * ???????? OF INFORMATION / * ???????? FROM THE LIST DOCUMENT / * ???????? IF AN ERROR WAS DETECTED / * ???????? WITHIN THE SELECTOR / * ???????? OR THE OUTPUT DOCUMENT GENERATOR / 21 BLANK LINE / 22 Press RETURN to continue, or / 23 Press Gold MENU to return to MAIN MENU / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!! TEXT FOR OUTPUT !!!!!!!! / !!!!!!!! TO THE SCREEN !!!!!!!! / !!!!!!!! !!!!!!!! / !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! / 1205 1600 MPROCESSING, IFDEF ENGLSH < TEXT '^P^E&WORKING^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&IN &CORSO/ > IFDEF V30NOR < TEXT '^P^E&AKTIV^P'> IFDEF V30SWE < TEXT '^P^E&BEARBETAR^P'> IFDEF DUTCH < TEXT '^P^E&BEZIG...^P'> IFDEF SPANISH < TEXT '^P^E&TRABAJANDO^P'> / 1220 (OCTAL) 1600 MSRWAIT, IFDEF ENGLSH < TEXT '^P - &PLEASE WAIT^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P - &PREGO ATTENDERE.../ > IFDEF V30NOR < TEXT '^P - &VENT'> IFDEF V30SWE < TEXT '^P - V\DNTA EN STUND^P'> IFDEF DUTCH < TEXT '^P - &EVEN GEDULD.^P'> IFDEF SPANISH < TEXT '^P - &ESPERE^P'> / 0605 1600 MSUMMARY, IFDEF ENGLSH < TEXT '^P&PRIMARY &KEY &RECORDS: ^L!D OUT OF !D^P' /M002-MJS >/END ENGLSH IFDEF ITALIAN < TEXT /^P &CHIAVI &PRIMARIE: ^L!D DI !D^P/ > IFDEF V30NOR < TEXT '^PPOSTER UTVALGT ETTER PRIM\FRN\XKKEL: ^L!D AV !D^P'> IFDEF V30SWE < TEXT '^P&PRIM\DRA F\DLT MED SORTERINGSNYCKLAR: ^L!D AV !D'> IFDEF DUTCH < TEXT '^P&GESELECTEERDE GEGEVENSGROEPEN: ^L!D UIT !D^P'> IFDEF SPANISH < TEXT '^P®ISTROS &TECLA &PRIMARIA: ^L!D FUERA DE !D^P'> / 1005 1600 MODG, IFDEF ENGLSH < TEXT '^P&RECORDS &REPRODUCED: ^L^D^P' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P&RECORDS &COPIATI: ^L^D^P/ > IFDEF V30NOR < TEXT '^P&RECORD &REPRODUCED: ^L^D^P'> IFDEF V30SWE < TEXT '^P&ANV\DNDA POSTER: ^L^D^P'> IFDEF DUTCH < TEXT '^P&VERWERKTE GEGEVENSGROEPEN: ^L^D^P'> IFDEF SPANISH / 2603 MREPLACE, IFDEF ENGLSH < TEXT '^P^L-&REPLACE SYSTEM DISKETTE, THEN' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^L-&INSERIRE IL DISCO SISTEMA,/ > IFDEF V30NOR < TEXT '^P^L-&SETT SYSTEMDISKETTEN TILBAKE OG'> IFDEF V30SWE < TEXT '^P^L-&S\DTT TILLBAKA SYSTEMDISETTEN OCH'> IFDEF DUTCH < TEXT '^P^L-&ZET SYSTEEMDISKETTE TERUG.'> IFDEF SPANISH / 1205 MSRDONE, IFDEF ENGLSH < TEXT '^P^E&DONE' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&FINE/ > IFDEF V30NOR < TEXT '^P^E&UTF\XRT'> IFDEF V30SWE < TEXT '^P^E&F\DRDIGT'> IFDEF DUTCH < TEXT '^P^E&KLAAR!!'> IFDEF SPANISH / 1205 MSRABORTED, IFDEF ENGLSH < TEXT '^P^E&ABORTED' /M002 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^E&INTERRUZIONE/ > IFDEF V30NOR < TEXT '^P^E&AVBRUTT'> IFDEF V30SWE < TEXT '^P^E&AVBRUTEN'> IFDEF DUTCH < TEXT '^P^EAFGEBROKEN'> IFDEF SPANISH IFDEF ENGLSH < /A002 / 1205 MSRPAUSED, TEXT '^P^L&PAUSED ' *.-1 / 2603 TEXT '^P-&PRESS &R&E&T&U&R&N TO CONTINUE, OR ' *.-1 / 2703 MGOLD, TEXT '^P-&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.' >/END ENGLSH /A002 IFDEF ITALIAN < MSRPAUSED, TEXT '^P^L&SOSPENSIONE ' *.-1 / 2603 TEXT '^P-&PREMERE !&RITORNO PER CONTINUARE ' *.-1 / 2703 MGOLD, TEXT '^P-&PREMERE &ORO !&MENU PER RICHIAMARE IL &MENU &PRINCIPALE.' > IFDEF V30NOR < /A002 / 1205 MSRPAUSED, TEXT '^P^L&MIDLERTIDIG STANS' *.-1 / 2603 TEXT '^P-&TRYKK P\E !&RETUR FOR \E FORTSETTE EL.' *.-1 / 2703 MGOLD, TEXT '^P-&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.' >/END V30NOR /A002 IFDEF V30SWE < MSRPAUSED, TEXT '^P^L&PAUS ' *.-1 / 2603 TEXT '^P-&TRYCK P\E RETUR F\VR ATT FORTS\DTTA ' *.-1 / 2703 MGOLD, TEXT '^P-&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY' >/END V30SWE /A002 IFDEF DUTCH < MSRPAUSED, TEXT '^P^L&ONDERBROKEN' *.-1 / 2603 TEXT '^P-&DRUK OP !&RETURN OM VERDER TE GAAN. ' *.-1 / 2703 MGOLD, TEXT '^P-&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.' > IFDEF SPANISH < MSRPAUSED, TEXT '^P^L&PAUSA' *.-1 / 2603 TEXT '^P-&PULSE !& RETORNO PARA CONTINUAR, O' *.-1 / 2703 MGOLD, TEXT '^P-&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.' > / 0705 MULTIRULERERR, IFDEF ENGLSH < TEXT '^P^L&WARNING - &LIST CONTAINS MULTIPLE RULERS' >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /^P^L&ATTENZIONE - &PI\Y DI UN DESCRITTORE RIGA/ > IFDEF V30NOR < TEXT '^P^L&ADVARSEL - &LISTEN INNEHOLDER FLERE FORMATERINGSLINJER'> IFDEF V30SWE < TEXT '^P^L!&VARNING! - ®ISTRET INNEH\ELLER FLERA LINJALER'> IFDEF DUTCH < TEXT '^P^L!&OPGELET - &BESTAND HEEFT MEER DAN EEN REGELINDELING'> IFDEF SPANISH < TEXT '^P^L!&ADVERTENCIA - &LA LISTA CONTIENE REGLAS M\ZLTIPLES'> / --------- / --ERROR-- THE TEXT OF A SPECIFIC ERROR HERE. / --------- IFDEF ENGLSH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E---------^P--&E&R&R&O&R--&!S^P---------^P' >/END ENGLSH IFDEF ITALIAN < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E----------^P--!&ERRORE--&!S^P----------^P' > IFDEF V30NOR < MERROR, TEXT '^P^E----------^P--!&FEIL--&!S^P------------^P' > IFDEF V30SWE < MERROR, TEXT '^P^E----------^P--!&FEL--&!S^P-------------^P' > IFDEF DUTCH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E^P!&FOUT:&!S^P^P.' >/END ENGLSH IFDEF SPANISH < /A002 /1200 1300 1400 1600 MERROR, TEXT '^P^E---------^P--!&ERROR--&!S^P---------^P' >/END ENGLSH EMESTABLE, ME0 / RECORD EXCEEDS 2500 CHARACTERS /\ ME1 / NONE ME2 / FIELD NAME MISSING '<' OR TEXT BETWEEN RECORDS ME3 / FIELD NAME CONTAINS EXTRA '<' ME4 / FIELD NAME EXCEEDS 30 CHARACTERS ME5 / KEY VALUE FIELD CONTAINS '>' ME6 / RECORD CONTAINS DUPLICATE KEY ME7 / LIST NOT TERMINATED WITH '<>' ME8 / UNEXPECTED END OF FILE ME9 / LIST CONTAINS ONLY TEXT ME10 / PRIMARY KEY NOT FOUND ME11 / TO MANY KEYS DEFINED / (THIS IS A DEVELOPMENT ERROR MESSAGE) / (WHICH THE END USER SHOULD NEVER SEE) ME12 / INVALID NUMERIC SYNTAX / ME12A / INCORRECT PLACEMENT OF RIGHT PAREN ')' / ME12B / INCORRECT PLACEMT OF MINUS SIGN '-' / ME12C / TO MANY NUMERIC VALUE FIELD CHARACTERS / ME12D / UNKNOWN CHARACTER / ME12E / NO ')' AFTER '(' / ME12F / INCORRECT PLACEMENT OF LEFT PAREN '(' / ME12G / '+' OR '-' PRECEEDED '(' / ME12H / NO '(' BEFORE ')' / ME12I / '()' DETECTED / ME12J / 'EXTRA ')' FOUND / ME12K / INCORRECT PLACEMENT OF PLUS SIGN '+' / ME12L / EXTRA SIGN (+ OR - OR IMPLIED MINUS) FOUND / ME12M / EXTRA CURRENCY SYMBOL FOUND / ME12N / INCORRECT PLACEMENT OF CURRENCY SYMBOL / ME12P / EXTRA RADIX POINT '.' FOUND ME13 / output document diskette full /a0014 ME13A / OUTPUT DOCUMENT VOLUME FULL /A018 ME0, IFDEF ENGLSH < /A002 TEXT \RECORD EXCEEDS 2500 CHARACTERS\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /RECORD SUPERA 2500 CARATTERI/ > IFDEF V30NOR < TEXT 'POST OVER 2500 TEGN'> IFDEF V30SWE < TEXT '&POSTEN BEST\ER AV MER \DN 2500 TECKEN'> IFDEF DUTCH < /A002 TEXT \MEER DAN 2500 TEKENS IN GEGEVENSGROEP\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'REGISTRO CON M\AS DE 2500 CARACTERES\ >/END SPANISH /A002 ME2, IFDEF ENGLSH < /A002 TEXT "FIELD NAME MISSING '" *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ OR TEXT BETWEEN RECORDS\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /MANCA CAMPO NOME '/ *.-1 7447 TEXT / O TESTO TRA RECORDS/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN MANGLER '\ /M001 *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ EL. TEKST MELLOM POSTER\ /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT "&ETT F\DLTNAMN SAKNAS '" /M001 *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT ' ELLER OCKS\E HAR DU SKRIVIT TEXT MELLAN POSTERNA' /A001 >/END V30SWE /A002 IFDEF DUTCH < TEXT \ONTBREKENDE \ /M001 *.-1 4774 TEXT /' OF TEKST TUSSEN GEGEVENSGROEPEN/ > IFDEF SPANISH < /A002 TEXT "FALTA NOMBRE DE CAMPO '" *.-1 /A001 7447 /OPEN BRACKET,QUOTE /A001 TEXT \ O TEXTO ENTRE REGISTROS\ /A001 >/END SPANISH /A002 ME3, IFDEF ENGLSH < /A002 TEXT \FIELD NAME CONTAINS EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CAMPO NOME CONTIENE / *.-1 4774 TEXT /'/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN INNEHOLDER EKSTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT \&ETT F\DLTNAMN INNEH\ELLER EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \OVERBODIGE '\ /A001 *.-1 /A001 7447 /QUOTE,OPEN BRACKET /A001 TEXT \ IN VELDNAAM\ /A001 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NOMBRE DE CAMPO CONTIENE EXTRA \ /A001 *.-1 /A001 4774 /QUOTE,OPEN BRACKET /A001 TEXT \'\ /A001 >/END SPANISH /A002 ME4, IFDEF ENGLSH < /A002 TEXT \FIELD NAME EXCEEDS 30 CHARACTERS\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CAMPO NOME SUPERA 30 CARATTERI/ > IFDEF V30NOR < /A002 TEXT \FELTNAVN OVER 30 TEGN \ >/END V30NOR /A002 IFDEF V30SWE < TEXT '&F\DLTNAMNET BEST\ER AV MER \DN 30 TECKEN'> IFDEF DUTCH < /A002 TEXT \MEER DAN 30 TEKENS IN VELDNAAM\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NOMBRE DE CAMPO EXCEDE 30 CARACTERES\ >/END SPANISH /A002 ME5, IFDEF ENGLSH < /A002 TEXT \KEY VALUE FIELD CONTAINS '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CHIAVE CAMPO VALORE CONTIENE / *.-1 7647 0000 > IFDEF V30NOR < /A002 TEXT "N\XKKELFELTET INNEHOLDER '" /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END V30NOR /A002 IFDEF V30SWE < /A002 TEXT "&F\DLTET MED V\DRDEN F\VR SORTERINGSNYCKEL INNEH\ELLER '" /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \OVERBODIGE '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \CLAVE VALOR CAMPO CONTIENE '\ /M001 *.-1 /A001 7647 /CLOSE BRACKET,QUOTE /A001 0000 /ZERO WORD TO END TEXT /A001 >/END SPANISH /A002 ME6, IFDEF ENGLSH < /A002 TEXT \RECORD CONTAINS DUPLICATE KEY\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /RECORD CONTIENE CHIAVE DUPLICATA/ > IFDEF V30NOR < /A002 TEXT "POST HAR TO N\XKKELFELTER" >/END V30NOR /A002 IFDEF V30SWE < TEXT '&POSTERN INNEH\ELLER IDENTISKA SORTRINGSNYCKLAR'> IFDEF DUTCH < /A002 TEXT \DUBBELE VELDNAAM IN GEGEVENSGROEP\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \REGISTRO CONTIENE CLAVE DUPLICADA\ >/END SPANISH /A002 ME7, IFDEF ENGLSH < /A002 TEXT \LIST NOT TERMINATED WITH '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /LISTA NON TERMINA CON '/ *.-1 7476 TEXT /'/ > IFDEF V30NOR < /A002 TEXT "LISTE ER IKKE AVSLUTTET MED '" /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END V30NOR /A002 IFDEF V30SWE < TEXT \®ISTERDOKUMENTET SLUTAR INTE MED '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END V30SWE /A002 IFDEF DUTCH < /A002 TEXT \BESTAND NIET AFGESLOTEN MET '\ /A001 *.-1 /A001 4774 /OPEN BRACKET,CLOSE BRACKET /A001 7647 0000 >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \LISTA NO TERMINA CON '\ /A001 *.-1 /A001 7476 /OPEN BRACKET,CLOSE BRACKET /A001 TEXT \'\ /A001 >/END SPANISH /A002 ME8, IFDEF ENGLSH < /A002 TEXT \UNEXPECTED END OF FILE\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /FINE DEL DOCUMENTO INATTESA/ > IFDEF V30NOR < /A002 TEXT 'UVENTET SLUTT P\E FIL' >/END V30NOR /A002 IFDEF V30SWE < TEXT '&DOKUMENTET HAR FELAKTIGT "!&SLUT"-KOMMANDO'> IFDEF DUTCH < TEXT \ONVERWACHT EINDE VAN BESTAND\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'T\IRMINO DE FICHERO INESPERADO' >/END SPANISH /A002 ME9, IFDEF ENGLSH < /A002 TEXT \LIST CONTAINS ONLY TEXT\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /LISTA CONTIENE SOLO TESTO/ > IFDEF V30NOR < /A002 TEXT \LISTE INNEHOLDER BARE TEKST\ >/END V30NOR /A002 IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET INNEH\ELLER ENBART TEXT'> IFDEF DUTCH < /A002 TEXT \BESTAND BEVAT SLECHTS TEKST\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'LISTA CONTIENE S\SLO TEXTO' >/END SPANISH /A002 ME10, IFDEF ENGLSH < /A002 TEXT \PRIMARY KEY NOT FOUND\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /CHIAVE PRIMARIA INESISTENTE/ > IFDEF V30NOR < TEXT 'PRIM\FRN\XKKEL IKKE FUNNET'> IFDEF V30SWE < TEXT '&F\VRSTA SORTERINGSNYCKELN KAN INTE HITTAS'> IFDEF DUTCH < /A002 TEXT \ONJUISTE SORTEERSPECIFICATIE\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT \NO SE ENCUENTRA CLAVE PRIMARIA\ >/END SPANISH /A002 ME11, IFDEF ENGLSH < /A002 TEXT \TO MANY KEYS DEFINED\ >/END ENGLSH /A002 IFDEF ITALIAN < TEXT /TROPPE CHIAVI DEFINITE/ > IFDEF V30NOR < TEXT 'FOR MANGE SORTERINGSN\XKLER'> IFDEF V30SWE < TEXT '&F\VR M\ENGA SORTERINGSNYCKLAR \DR DEFINIERADE'> IFDEF DUTCH < /A002 TEXT \TE UITGEBREIDE SORTEERSPECIFICATIE\ >/END DUTCH /A002 IFDEF SPANISH < /A002 TEXT 'SE DEFINEN MUCHAS CLAVES' >/END SPANISH /A002 ME12, IFDEF ENGLSH < TEXT \INVALID NUMERIC SYNTAX\> IFDEF ITALIAN < TEXT /NUMERO NON VALIDO/ > IFDEF V30NOR < TEXT 'UGYLDIG TALLANGIVELSE'> IFDEF V30SWE < TEXT '&FELAKTIG NUMERISK SYNTAX'> IFDEF DUTCH < TEXT 'ONJUISTE GEGEVENS IN NUMERIEK VELD'> IFDEF SPANISH < TEXT '\SINTAXIS NUM\IRICA INV\ALIDA'> ME13, /a0014 IFDEF ENGLSH < TEXT \OUTPUT DISKETTE FULL\> /a0014 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ > IFDEF V30NOR < TEXT 'DISKETT FOR UTDATA ER FULL'> IFDEF V30SWE < TEXT '&DISKETTEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'> IFDEF DUTCH < TEXT '&BESTEMMINGSDISKETTE VOL'> IFDEF SPANISH < TEXT '&DISKETTE DE SALIDA LLENO'> ME13A, IFDEF ENGLSH < TEXT \OUTPUT VOLUME FULL\> /A018 IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI USCITA PIENO/ > IFDEF V30NOR < TEXT 'OMR\EDE FOR UTDATA ER FULLT'> IFDEF V30SWE < TEXT '&VOLYMEN D\DR DU VILL HA SLUTDOKUMENTET \DR FULL'> IFDEF DUTCH < TEXT '&BESTEMMINGSGEBIED VOL'> IFDEF SPANISH < TEXT '&VOLUMEN DE SALIDA LLENO'> / END WPSRTX.PA / --------------------------------------------------------------------- / ! ! I M P O R T A N T N O T I C E ! ! / --------------------------------------------------------------------- / / THE 'XXSDFNBUFFER' IS LOCATED IN FIELD #4 / / THE 'XXSDFNBUFFER' IS FILLED BY THE SORT PARSER / / THE BUFFER MAY BE MOVED ALMOST ANYWHERE IN THE FIELD / W/O ANY REDEFINITIONS IN THE SORT PARSER / HOWEVER, IF THIS BUFFER IS MOVED OUT OF THE FIELD / THEN THE APPROPRIATE 'CDFs' WITHIN THE PARSER MUST REFLECT THAT / / --------------------------------------------------------------------- / / THE 'XXSDFNBUFFER' HOLDS THE TO BE SORTED / AS DEFINED WITHIN THE SPECIFICATION DOCUMENT XXSDFNBUFFER=0 / of FIELD #4 /M011 / F / I / E / L / D / N / A / M / E / [0] / SEPARATOR / F / I / . / . / [0] / SEPARATOR / . / . / [0] / [-1] / XXSDFNBUFFER TERMINATOR / / / MAX # OF 'VVVVV'ALUE CHARS, TIMES 2, +1 [0 TERM], TIMES #MAXKEY, +1 [-1 TERM] / /D011 *KCCVALUE%2+1^MAXKEY+1+XXSDFNBUFFER PAGE /TMATH.PA / MODIFICATIONS BY: / / 047 KMD 23-Sep-85 Dutch Xlations / 046 KMD 10-Sep-85 Change keywords for Spanish / 045 KMD 02-AUG-85 Allow multinational control words / 044 RCME 24-Jun-85 Allow multinational currency symbols / / ------------------------ All below refer to V2.0 and earlier ---------------- / / 043 WCE 17-AUG-83 CHANGED NUMBER LABEL TO NUMTOK FOR PREFIX / 042 WCE 19-JUL-83 CHANGED SET LABEL TO SETCMD FOR PREFIX / 041 WCE 01-JUN-83 EXPAND SYMBOL TABLE BY REMOVING MTHTBL / 040 WCE 28-APR-83 FIX BUG - KEEP ONLY ONE COPY OF NUMBER / IN SYMBOL TABLE LIST / 039 WCE 24-APR-83 FIX BUG - ALLOW SET TO CHANGE FORMAT / 038 DRH 09-FEB-82 FIX BUG - RESET COUNTER IN COM PARSER / 037 DRH 27-JAN-82 FIX BUG - CATCH TRAPPED ERR "END" NOT / ON SECOND LINE / 036 DRH 27-JAN-82 FIX BUG - TRAP ERR ON LINES AFTER "END" / REF. WPEDIT.PA EDIT HISTORY "134" / 035 DRH 26-JAN-82 FIX BUG - 2ND LINE OF NON EDITOR MATH / BLK BLOWS LINE AFTER BLOCK OUT OF H2O / FIX BUG - INVALID PROCESSING OF "END" / IN EDITOR MATH CTRL BLOCK / 034 DRH 18-DEC-81 STRIP OUT BACK-UP RELATED CODE / 033 DRH 01-DEC-81 REINSTALLED "BEGIN" CTRL WORD PROCESS- / ING IN "BEGIN" RTN. REF EDIT HISTORY / NUMBER 025 / 032 DRH 01-DEC-81 FIXED BUG IN FORMULA TRANSLATOR / 031 DRH 18-NOV-81 CHANGED "RUNCHK" FLAG SETTING / 030 DRH 16-NOV-81 ADD SYM TO "DCHAR" IF MATCH IN TABLE / 029 JRF 16-NOV-81 Modified calls to ZROTBL since it was / made cross field callable. / 028 JRF 9-NOV-81 Add code for zeroing of DCHAR table / upon detectiion of WPSMATH in cntrl. / block. / 027 DAO 6-NOV-81 ADDED CODE TO BEGIN AND END ROUTINES / TO SET FLAGS FOR 'BACKUP' CODE / 026 JRF 4-NOV-81 Add error calls for cntl. word format / and syntax errors. / 025 JRF 02-NOV-81 Temporarily commented out "BEGIN" / processing code in "BEGIN" routine. / Must be reinstalled later as soon as / Editor Math Error Reporting is / operational!! (SEE /T025). See Joe / or Dave if you have any questions. / 024 DRH 30-OCT-81 ADDED EDIT MATH ERROR LABELS & / CALLS TO CHECK FOR CHAR ON LINE / AFTER "BEGIN" & "END" CTRL WORDS / 023 DAO 28-OCT-81 MINOR CHANGE TO CALL TO CHKNME / 022 DRH 23-OCT-81 RE-INIT RESULT TBL & PTR AT START OF / EVERY EDITOR MATH BLOCK / 021 DRH 16-OCT-81 ADDED EDITOR MATH ERROR HANDLING CODE / 020 DRH 23-SEP-81 ADDED INDIVIDUAL EDITOR MATH CTRL WORD / HANDLING ROUTINES / 019 DRH 14-SEP-81 ADDED EDIT MATH CTRL WORD PROCESSING / 018 DRH 14-SEP-81 ADDED EDIT MATH CONTROL WORDS "BEGIN, / END, & TOTAL" TO MATH MODULE / 017 DRH 14-SEP-81 ADDED CODE TO INDICATE WHETHER IN LP / OR EDITOR MATH / 016 DRH 02-SEPT-81 TRAP ILLEGAL HARD RETURN WITHIN A / FORMULA OR SET STATEMENT MATH EXPRSION / 015 DRH 18-AUG-81 SET "EVFLW7" COMPATIBLE TO ERR REPORTING / 014 DRH 11-AUG-81 SET UP "LNEBFC" IN "RDLNBF" TO RETURN / CONTENTS OF FULL INPUT LINE BUF WHEN / BUF OVERFLOWED IN MATH CTRL BLOCK / 013 DRH 08-AUG-81 SEND BACK EXACT LOC OF NON-ALLOWABLE / CHAR ON CTRL WRD LNE AFTER CTRL WORD / SET UP TO BE COMPATIBLE WITH "RDLNBF" / 012 DRH 31-JUL-81 SET CODE TO NOT RE-INIT SYMBOL TBL, / SYMBOL PTR TBL, & RESULT PTR TBL / BETWEEN CTRL BLKS OF SAME LP LIST DOC / 011 DRH 28-JUL-81 TRAP OUT CTRL WORD FORMAT/SYNTAX ERRS / 010 DRH 27-JUL-81 HANDLE MATH INPUT LINE BUFFER & WORK / BUFFER OVERFLOW ERRORS - TIED IN WITH / "WPSELC" MODULE EDIT NUMBER - "024" / 009 DAO/DRH 23-JUL-81 CHECK FOR MULTIPLE FORMAT STATEMENTS / FOR SAME RESULT VAR. IN ONE CTRL BLK / 008 DRH 17-JUL-81 ADDED CODE TO TRAP INCORRECT FORMULA / FORMAT FOLLOWED BY END OF LINE (HR) / 007 DAO 15-JUL-81 /Changes to fix bug in where format / /indicator got loaded / 006 DAO 14-JUL-81 /Played space wars on first page (some- / /body installed with page errors!!! / 005 DAO 12-JUL-81 /Changed SYMTSZ and so it now outputs / / char passed in AC. Also changed so / / address following PUSH points to / / actual value rather than format word / 004 DRH 10-JUL-81 /PLACE "INIT" INTO OUTPUT LIST FOR USE / /BY FORMULA EXECUTION CODE / 003 DAO 7-JUL-81 / CHANGE SYMCHK TO RETURN POINTER INTO / / SYMBOL TABLE / 002 DAO 14-JUN-81 / MODIFICATIONS TO MERGE WITH OTHER / / MATH FILES / 001 DRH 5/6/81 /ADDED CODE FOR "RESULTS POINTER LIST" / 000 DRH 30-APR-81 /CREATED /PCBMTH.PA /D002 /THIS PART OF CODE HANDLES INTERACTION WITH LIST PROCESSING/EDITOR REGARDING /THE PARSING OF THE PRINT CONTROL BLOCK. /START WITH INITIALIZATION PROCESS WHEN FIRST ENTER PRINT /CONTROL BLOCK /WARNING: IMPORTANT TO KEEP "FSTLNE", & "RTRN1 TO 4" IN PRESENT LOCATIONS / SINCE THEY ARE DEFINED AS SUCH IN WPF1 FOR L.P. AND THE EDITOR / AS ENTRY POINTS TO THE MATH MODULE. FSTLNE, 0 /"CONTROL BLOCK FIRST LINE" FLAG RTRN1, XX /ENTRY POINT TO RTN TO INITIALIZE INPUT LINE BUF PTR JMP RTRN1A /GO TO CODE WHICH INITIALIZES THE PTR RTRN2, XX /ENTRY POINT TO RTN TO PUT CHAR IN INPUT LINE BUF JMP RTRN2A /GO TO CODE WHICH INPUTS CHAR RTRN3, XX /ENTRY POINT TO RTN TO PROCESS INPUT LINE IN BUF JMP RTRN3A /GO PROCESS INPUT CHAR STRING IN LINE BUFFER RTRN4, XX /RTN TO INITIALIZE VALUES USED IN MATH CTRL BLK CODE DCA MTHTYP /GET VALUE PASSED IN AC FROM CALLER FIELD AND /A017 /USE IT TO SET THE "MTHTYP" FLAG TO INDICATE /A017 /WHICH TYPE OF MATH IS GOING TO BE INVOKED /A017 /IF LP MATH THEN "MTHTYP" = 0, IF EDIT MATH = 1 /A017 /NOTE - THIS FLAG SETTING PROCESS IS DONE /A017 /ONCE WHEN ENTERING THE PARTICULAR MODULE WHICH /A017 /REQUIRES MATH FUNCTIONALITY AND AGAIN EACH TIME/A020 /MATH IS RE-INITIALIZED AT THE START OF A MATH /A020 /WORK AREA FROM THE "BEGIN" ROUTINE /A020 /************ BE WARNED THAT *************** /A017 /A CROSS FIELD CALL IS MADE TO "RTRN4" FROM /A017 /THE MODULE (EDIT OR LP) USING MATH THEREFORE /A017 /IF "MTHTYP" IS MOVED OFF OF PAGE ZERO THEN /A017 /THERE WILL BE THE PROBLEM OF HAVING TO INDIRECT/A017 /TO THAT LOC FROM HERE, THUS USING THE DATA /A017 /FIELD FROM THE CALLING MODULE WHICH WILL RESULT/A017 /IN AN ERROR /A017 JMP RTRN4A /GO INITIALIZE VALUES /ROUTINE TO INITIALIZE INPUT LINE BUFFER POINTER RTRN1A, GOTFLD /GET CDI INTRUCTION /M041 DCA BCKFLD /SAVE THE CONSTRUCTED CDI INSTRUCTION FOR RETURN TAD (LNEBUF /GET START OF INPUT LINE BUFFER DCA LNEPTR /USE IT TO INITIALIZE THE INPUT LINE BUFFER PTR DCA FRMCHR /INIT VAL IN LEXIC RTN BEFORE ENTRY LATER BY XLTFRM BCKFLD, 0 /LOCATION TO HOLD CDI INSTRUCTION FOR RETURN TO CALLER JMP I RTRN1 /RETURN PROGRAM CONTROL TO FIELD FROM WHICH CALL MADE /ROUTINE TO PUT INPUT CHAR INTO INPUT LINE BUFFER. RTRN2A, /D006 RDF /GET THE DATA FIELD BITS FROM WHICH THE CALL WAS MADE TAD CIDF0 /ADD TO IT THE CDF,CIF OCTAL CODE VALUE DCA OLDFLD /SAVE THE CONSTRUCTED CDI INSTRUCTION FOR RETURN TAD I RTRN2 /GET INPUT CHAR PASSED FROM OTHER FIELD CDFMTH /CHANGE THE DATA FIELD REGISTER TO MATH FIELD DCA I LNEPTR /SAVE IT IN THE INPUT LINE BUFFER /IN CASE IN EDITOR MATH, BEFORE GOING BACK FOR NEXT CHAR, CHECK /A021 /TO SEE IF LAST VALID LINE PROCESSED IN THE EDITOR MATH CONTROL /A021 /BLOCK WAS AN "END" CONTROL WORD. IF SO THEN THERE SHOULD BE NO /A021 /OTHER LINES TO PROCESS IN THE CONTROL BLOCK. IF THERE ARE LINES/A021 /AFTER THE "END" CTRL WORD THEN THE LINE IS SPOTTED AS AN ERROR /A021 TAD MTHSND /GET EDITOR MATH "SECOND LINE" FLAG /A021 SMA CLA /HAS "END" CTRL WORD BEEN PREVIOUSLY FOUND? /A021 JMP SKPDN1 / NO: THEN CONTINUE PROCESSING /A021 TAD (EVSYN6 / YES: RETURN ERR - LINES AFTER "END" WORD/A021/M024 JMP ERROR6 /SETUP TO RETURN NUMBER TO EDITOR MATH /A021 SKPDN1, JMS LNETSZ /INCREMENT LINE BUFFER PTR & CHECK FOR OVERFLOW /M021 /NOTE: RETURN FROM "LNETSZ" WITHOUT A SKIP TO CONTINUE LOADING IN CHAR / TO INPUT LINE BUFFER: WITH A SKIP RETURN IF THERE WAS AN INPUT / LINE BUFFER OVERFLOW AND IT IS NOT A MATH CONTROL BLOCK: & A / DOUBLE SKIP RETURN IF A MATH CTLR BLK LINE BUF OVFLW ERROR /A010 ISZ RTRN2 /TRIPLE INCREMENT PC FOR NORMAL RETURN TO OTHER FIELD ISZ RTRN2 /DOUBLE INCREMENT PC & RTRN TO SERVE NOT MATH BLOCK ERROR6, ISZ RTRN2 /SINGLE INCRMNT PC TO RTRN MATH CTRL BLK ERR /M021 OLDFLD, 0 /LOCATION TO HOLD CDI INSTRUCTION FOR RETURN TO CALLER JMP I RTRN2 /RETURN PROGRAM CONTROL TO FIELD FROM WHICH CALL MADE / "RTRN3" - ROUTINE TO PROCESS INPUT CHAR STRING IN LINEBUFFER / /FUNTIONAL DESCRIPTION: RTRN3 /PSEUDO-CODE DESCRIPTION: / / | SAVE DATA FIELD TO RETURN TO CALLER / | PLACE LINEBUFFER CTRL WORD INTO WORK BUFFER / | IF WORK BUFFER OVERFLOW / | | THEN IF CONTROL BLOCK FIRST LINE = TRUE / | | | THEN RETURN TO CALLER AS NOT MATH BLOCK / | | | ELSE RETURN TO CALLER WITH MATH WORK BUFF ERROR / | | | ENDIF / | | ENDIF / | IF CTRL BLOCK FIRST LINE FLAG = TRUE / | | THEN COMPARE LINEBUFFER CTRL WORD TO WPSMTH TABLE / | | IF MATCH FOUND / | | | THEN SET CTRL BLOCK FIRST LINE = FALSE / | | | IF NON-ALLOW CHAR ON SAME LNE AS & AFTER CTRL WRD / | | | | THEN RETURN TO CALLER WITH MATH ERR IN AC / | | | | ENDIF / | | | INITIALIZE TRUNCATE/ROUND FLAG = ROUND / | | | " FORMULA CTRL WORD NOT FOUND = TRUE / | | | " FRMLA EXEC CDE ENTRY PT=START O/P LST / | | | " LEAD LOC OF O/P LST = SUBRTN SETUP / | | | " O/P LIST POINTER / | | | IF IN EDITOR MATH = TRUE / | | | | THEN INITIALIZE RESULT PTR TABLE & PTR / | | | | ENDIF / | | | INITIALIZE EDIT MATH "SECOND LINE" FLAG = TRUE / | | | ELSE RETURN TO CALLER TO PROCESS AS NOT MATH BLOCK / | | | ENDIF / | | RETURN TO CALLER TO CONTINUE NORMAL PROCESSING OF MTH BLK / | | ELSE COMPARE CTRL WORD TO "CTLWRD" OR "EDTCTL" TABLE / | | IF MATCH FOUND / | | | THEN PROCESS ACCORDING TO CTRL WORD FOUND / | | | IF ERROR FOUND WHILE PROCESSING / | | | | THEN RETURN TO CALLER WITH MATH ERR IN AC / | | | | ENDIF / | | | ELSE RETURN TO CALLER WITH FORMAT/SYNTAX ERR IN AC / | | | ENDIF / | | ENDIF / /CALLING SEQUENCE: CIFMTH /CROSS FIELD CALLABLE..... / JMS RTRN3 /......SUBROUTINE - WHERE RTRN3 IS A / /......SPECIFIC ENTRY POINT INTO MATH / /......AS DEFINED IN WPF1. /INPUT PARAMETERS: NONE /IMPLICIT INPUT: LNEBUF,FSTLNE /OUTPUT PARAMETERS: NORMAL RETURN = CONTINUE PROCESSING / SKIP RETURN = WITH MATH BLOCK ERROR IN THE AC / DOUBLE SKIP RETURN = ERROR BUT NOT MATH BLOCK /IMPLICIT OUTPUT: MATH INITIALIZATION,FSTLNE /COMPLETION CODE: NONE /SIDE EFFECTS: NONE /ROUTINE TO PROCESS CONTROL WORD OF INPUTTED LINE RTRN3A, GOTFLD /GET CDI TO CALLING FIELD /M041 DCA RTNFLD /SAVE THE CONSTRUCTED CDI INSTRUCTION FOR RETURN JMS XCTRLW /GO SET UP CONTROL WORD FOR COMPARISON WITH SYM TBL /THE "XCTRLW" RTN PERFORMS A VARIETY OF GYMNASTICS BEFORE /A010 /RETURNING. IN THE CASE OF A WORK BUFFER OVERFLOW A CHECK /A010 /IS DONE TO SEE WHAT LINE OF THE CONTROL BLOCK IS BEING /A010 /PROCESSED. IF A WORK BUFFER OVERFLOW OCCURS WITH THE FIRST /A010 /LINE THEN THE BLOCK IS NOT MATH BECAUSE IF IT WERE THERE /A010 /WOULD BE NO OVERFLOW. IF IT IS NOT THE FIRST LINE THEN /A010 /THE BLOCK HAS TO BE MATH TO HAVE GOTTEN BEYOND THE FIRST LINE /A010 /THE CASES SPECIFIED ARE HANDLED VIA SKIP RETURNS FROM "XCTRLW" /A010 JMP KPPROC /RETURN HERE TO CONTINUE NORMAL PROCESSING /A010 JMP ERBCK1 /RETURN HERE TO PROCESS AS NOT MATH CTRL BLOCK /A010 JMP ERRBCK /RETURN HERE TO PROCESS MATH WORK BUFFER ERROR /A010 /....ERROR NUMBER IN AC WHEN RTRN FROM "XCTRLW" /A010 /....SET UP TO RETURN TO FIELD ACCORDINGLY /A010 /CHK IF 1ST LINE OF CONTROL BLOCK KPPROC, TAD FSTLNE /GET CONTROL BLOCK 1ST LINE FLAG /M010 SNA CLA /IS IT THE FIRST LINE OF THE CONTROL BLOCK? JMP PRFRST / YES: GO SEE IF IT'S "WPSMATH" JMP PRCTRL / NO: HANDLE ANY OF OTHER CONTROL WORDS /HANDLE FIRST LINE OF CONTROL BLOCK - SEE IF IT IS "WPSMATH" PRFRST, JMS CMDPSR /RUN COMMAND PARSER ON CONTROL WORD WRKBUF /PASS START OF INPUT STRING TO COMMAND PARSER WPSMTH /PASS START OF SYMBOL TABLE TO COMMAND PARSER SZA /IS RETURNED VALUE IN THE AC A 1? i.e. A MATCH FOUND? JMP PRFRT1 / YES: GO INITIALIZE VALUES TO PROCESS MATH CTRL BLK ERBCK1, ISZ RTRN3 / NO: SET PC FOR DOUBLE SKIP RETURN TO PROCESS /M010 ISZ RTRN3 /....NOT MATH BLOC JMP RTNFLD /AND RETURN TO CALL FIELD PRFRT1, DCA FSTLNE /SET "CONTROL BLOCK FIRST LINE" FLAG = FALSE JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS AND..... /....AFTER CONTROL WORD JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN AC /A011 /.. TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A011 /RETURN HERE FROM "CHKLNE" IF ALL WENT WELL /M012 /AT THIS POINT DECIDED TO SAVE THE SYMBOL TABLE, SYM PTR TBL, /A012 /AND RESULT PTR TBL CONTENTS FROM ONE MATH CONTROL BLOCK TO THE /A012 /NEXT WITHIN THE SAME LP LIST DOC. IN THIS WAY THE USER CAN STILL/A012 /GET VALID TOTALS IN THE TRAILER FROM ACROSS THE WHOLE LIST, NOT /A012 /JUST THE PART COVERED BY THE LAST BLOCK, IF THE ABOVE MATH DATA /A012 /STRUCTURES WERE RE-INIT BEFORE EACH BLOCK THEN ANY PREVIOUS /A012 /CALCULATIONS DONE WITHIN THE LIST WOULD BE LOST. /A012 JMS ITLZO3 /..CALL MATH BLOCK INITIALIZATION ROUTINES /M012 /INIT TRUNCATE FLAG,"FORMULA CTRL WORD NOT FOUND"/A012 /FORMULA EXECUTION CODE ENTRY PT - "OUTENT", /A012 /OUTPUT LIST /A012 /D041 JMS ITLZO4 /AND OUTPUT LIST PTR /A012 /CONDITIONALIZE CODE TO RE-INITIALIZE RESULT TABLE & PTR AT THE /A022 /START OF EVERY MATH BLOCK IF IN EDITOR MATH. DONE THIS WAY TO /A022 /ALLOW MORE ROOM FOR RESULTS WITHIN THE CONTEXT OF ANY EDITOR /A022 /MATH WORK AREA. ALSO, NOTE THAT THIS CAN BE DONE THIS WAY IF IN /A022 /EDITOR MATH BECAUSE (UNLIKE THE L.P. MATH WHICH USES THE RESULTS/A022 /TABLE FOR POSSIBLE TRAILER TOTALS), THE EDITOR USES THE "TCHAR" /A022 /TABLE WHEN REFERENCING RESULTS VALUES FOR TOTALS AND THEREFORE /A022 /DOES NOT NEED RETENSION OF RESULTS BETWEEN BLOCKS. FOR MORE INFO/A022 /SEE ABOVE COMMENTS FOR "JMS ITLZO3". /A022 TAD MTHTYP /GET THE "MATH TYPE" FLAG /A022 SNA CLA /ARE WE IN EDITOR MATH? /M028 JMP PRFRT2 / NO: DON'T INIT. FOLLOWING TABLES /A028 /D041 JMS ITLZOL / YES: GO INITIALIZE THE RESULT TABLE & PTR /A022 TAD (RESULT /GET STARTING ADDRESS OF RESULT PTR TABLE /A041 DCA RESPTR /INITIALIZE PTR TO RESULT PTR TABLE /A041 DCA I RESPTR /INIT 1ST LOC OF RESULT PTR TABLE TO ZERO /A041 / AC0001 / ZERO DCHAR TABLE INCASE THIS WPSMATH CNTRL. /A028 / BLOCK IS TOTAL BLOCK. IF NOT A TOTAL BLOCK /A028 / BOTH DCHAR AND TCHAR TABLES WILL BE ZEROED /A028 / LATER. /A028 CIFLP / *** CAUTION *** - DF MUST EQUAL THIS FLD /M029 JMS ZROTBL /A028 / /NOTE THE EDIT MATH CTRL BLOCK "SECOND LINE" FLAG IS HERE INIT. /A020 /TO TRUE ONCE THE FIRST LINE OF THE BLOCK HAS BEEN PROCESSED /A020 /SUCCESSFULLY. THIS FLAG WILL BE NEEDED IF IN EDITOR MATH AND /A020 /IGNORED IF NOT. /A020 PRFRT2, DCA MTHSND / SET EDIT MATH "SECOND LINE" FLAG = TRUE /M028 JMP RTNFLD /GO BACK TO CALL FIELD TO PROCESS NEXT LINE OF BLOCK /RTN TO HANDLE ALL LINES (EXCEPT 1ST) OF MATH CONTROL BLOCK PRCTRL, JMS CMDPSR /CHECK CONTROL WORD FOR COMPARISON WRKBUF /PASS START OF INPUT STRING TO COMMAND PARSER SYMSTR, 0 /PASS START OF SYMBOL TABLE TO COMMAND PARSER /M019 /NOTE - THIS LOCATION IS PATCHED WITH THE RIGHT /A019 /ENTRY POINT INTO THE CTRL WORD PERMENANT SYMBOL/A019 /TABLE. THE PATCH IS MADE BY A CALL TO "SETCTL" /A019 /FROM THE INT ROUTINE "RTRN4" /A019 /THE ENTRY IS MADE AT "EDTCTL" IF EDITOR MATH /A019 /AND "CTLWRD" IF LP MATH /A019 SNA /IS RETURNED VALUE IN AC > 0 ? (i.e. IS MATCH FOUND?) JMP BCKERR / NO: PROCESS CONTROL BLOCK FORMAT/SYNTAX ERROR TAD OFFSET / YES: ADD OFFSET TO VALUE RETURNED IN THE AC /A019 /NOTE - "OFFSET" IS A VALUE PATCHED AT INIT TIME/A019 /THE SAME AS "SYMSTR" ABOVE. THE OFFSET IS USED /A019 /TO PAD THE RETURNED VALUE IN THE AC FROM /A019 /"CMDPSR" IF THE ENTRY POINT TO THE SYMBOL TABLE/A019 /STARTS AT "CTLWRD" FOR LP MATH /A019 /OTHERWISE THE RETURNED VALUE WILL NOT ADD UP /A019 /WITH "HNDCTL" TO GIVE THE RIGHT ROUTINE TO /A019 /SERVICE THAT CONTROL WORD /A019 /"OFFSET" = 3 IF LP MATH & 0 IF EDITOR MATH /A019 /TAKE TIME HERE TO CHECK TO SEE IF CONTROL WORD IS NOT "BEGIN" /A020 /IF NOT THEN GO SEE IF EDITOR MATH, IF YES THEN PROCESS EDITOR /A020 /MATH RELATED INFORMATION, IF NOT THEN JUST RETURN /A020 DCA TMPCTR /SAVE VALUE IN AC /A020 AC7777 /GET A -1 INTO THE AC /A020 TAD TMPCTR /ADD BACK VALUE TO IT /A020 SZA CLA /DOES NUM = 1? (I.E. IS THE CTRL WORD = "BEGIN")/A020 JMS RUNCHK / NO: THEN GO CHECK EDITOR MATH INFO /A020 TAD TMPCTR / YES: GET VALUE BACK INTO AC TO CONTINUE PROC /A020 /SET UP TABLE ADDR TO INDIRECT THRU TO PROCESS CTRL WORD /A020 TAD (HNDCTL-1 /ADD START OF TBL-1 TO RTRNED VALUE + OFFSET DCA HLDVAL /SAVE IT AS ADDR TO CONTROL WORD PROCESS TABLE ROUTINE TAD I HLDVAL /GET THE ROUTINE LOCATION CONTAINED IN OFFSET LOCATION DCA HLDVAL /SAVE IT TO INDIRECT THRU JMS I HLDVAL /GO PROCESS ACCORDING TO CONTROL WORD FOUND ERRBCK, ISZ RTRN3 /RETURN HERE FROM PROCESSING CTRL WORD IF THERE /M010 /....IS AN ERROR DETECTED IN THE MATH BLOCK RTNFLD, 0 /SKIP RETURN HERE FROM "JMS I HLDVAL" IF ALL /WENT OK. ( LOCATION OF CDI INSTRUCTION TO RETURN TO /CALLER FIELD ). JMP I RTRN3 /RETURN PROGRAM CONTROL TO FIELD FROM WHCH CALL MADE BCKERR, TAD (EVFLW7 /GET MATH BLK CTRL WORD FROMAT/SYNTAX ERROR NUM /M015 JMP ERRBCK /RETURN TO CALL FIELD WITH ERROR NUM IN AC /A011 OFFSET, 0 /CONTAINS OFFSET TO PERM SYM TBL FOR EDIT/LP MATH/A019 HLDVAL, 0 /KEEP ON SAME PAGE AS "PRCTRL" RTN, HOLDS INDIRECT /THRU WHICH CONTROL WORD PROCESS RTN IS CALLED /MOVED "FRMULA" RTN OFF THIS PAGE BECAUSE OF SPACE WARS. /M037 /INITIALIZATION SUBRTN CALLED FROM WPSELC.PA VIA "RTRN4" IN LOC 207. USED TO /PERFORM PRIMARY INIT OF MATH MODULE VALUES WHEN LP IS INVOKED. RTRN4A, GOTFLD /GET CDI TO CALLING FIELD /M041 DCA BAKFLD /SAVE THE CONSTRUCTED CDI INSTRUCTION FOR THE RETURN /D041 JMS ITLZOL /INIT RESULT PTR TABLE PTR & TABLE /M012 TAD (RESULT /GET STARTING ADDRESS OF RESULT PTR TABLE /A041 DCA RESPTR /INITIALIZE PTR TO RESULT PTR TABLE /A041 DCA I RESPTR /INIT 1ST LOC OF RESULT PTR TABLE TO ZERO /A041 /D041 JMS ITLZO2 /INIT SYMBOL PTR TBL PTR, SYMBOL TABLE PTR /M012 TAD (SYMTBL /GET STARTING ADDRESS OF SYMBOL TABLE /A041 DCA SYMPTR /INITIALIZE PTR TO SYMBOL TABLE /A041 JMS ITLZO3 /INIT TRUNCATE/FLAG, "FORMULA CTRL WORD NOT /A012 /FOUND" FLAG, FORMULA/EXECUTION CODE ENTRY /A012 /POINT - "OUTENT", OUTPUT LIST /A012 /D041 JMS ITLZO4 /INIT OUTPUT LIST PTR /A012 JMS SETCTL /GO INIT PATCHES TO "SYMSTR" AND "OFFSET" /A019 /TO COINCIDE WITH TYPE OF MATH TO BE USED /A019 /SEE "PRCTRL" RTN FOR EXPLANATION /A019 /ALSO, IF EDITOR MATH, THEN INIT "INCTLB" IN /A019 /LP FIELD TO 1 (I.E. IN CONTROL BLOCK = FALSE) /A019 BAKFLD, 0 /LOCATION OF CDI INSTRUCTION TO RETURN TO CALLER FIELD JMP I RTRN4 /RETURN TO FIELD CALLED FROM /TOTAL, MOVED HERE ON EDIT 041 TO MAKE SPACE /ROUTINE TO HANDLE "TOTAL" CONTROL WORD IN EDITOR MATH CONTROL BLOCK /A020 TOTAL, XX JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS... /A024 /....AND RIGHT AFTER CONTROL WORD /A024 JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN AC /A026 /.. TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A026 AC0001 /A020 DCA MTHTOT /SET "EDIT MATH TOTAL" FLAG = TRUE /A020 AC0001 /GET 1 INTO THE AC /A037 DCA MTHSND /SET "NOT PROCESSING SECOND LINE" = TRUE /A037 ISZ TOTAL /SET UP SKIP FOR NORMAL RETURN /A020 JMP I TOTAL /A020 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /RTN TO CHECK FOR NON-ALLOWABLE CHARACTERS FOLLOWING THE CONTROL /WORD AND ON THE SAME LINE. USED WITH "WPSMATH", "TRUNCATE", AND /"ROUND" TO DUMP TRAILING "SPECIAL" CHARACTERS AND TRAP AS AN /ERROR ANY OTHERS. DOES A SKIP RETURN IF ALL WENT WELL AND A /A011 /REGULAR RETURN WITH THE ERROR NUM IN THE AC IF NOT. /A011 CHKLNE, XX /NOTE: FIRST CALL TO "RDLNBF" HAS TO BE TO BACK IT UP ONE CHAR /A013 /FROM WHERE IT LEFT OFF IN "XCTRLW" WHEN PUTTING THE FIRST /A013 /WORD OF THE CTRL WORD LINE INTO THE WORK BUFFER /A013 /OTHERWISE "LNEPTR" IN "RDLNBF" IS SET TO THE CHAR AFTER THE /A013 /CHAR FOLLOWING THE FIRST WORD ON THE LINE. /A013 AC7777 /SET AC TO -1 TO TELL "RDLNBF" TO BACK UP ONE /A013 /CHAR IN THE LINE BUFFER /A013 JMS RDLNBF /GO CALL "RDLNBF" TO SET UP FOR CHAR RIGHT /A013 /AFTER CONTROL WORD ON THE LINE /A013 CHKLN1, JMS RDLNBF /GET ANY CHAR TRAILING CTRL WORD OF INPUT LINE /M013 TAD (-ECNWLN /GET NEGATIVE OF HARD RETURN SNA /IS NEXT CHAR FOLLOWING CONTROL WORD A HARD RETURN? JMP LINEOK / YES: END OF LINE SET UP TO RETURN TO CALLER /M011 TAD (ECNWLN-ECSPC/ NO: RESET AC AND GET NEGATIVE OF "SPACE" CHAR SPA SNA CLA /IS NEXT CHAR FOLLOWING CTRL WORD A "SPECIAL" CHAR?/m044 /d044 JMP LNOTOK / NO: THEN CONTROL WORD LINE SYNTAX ERROR JMP CHKLN1 / YES: DUMP IT & GO PICK UP NEXT CHAR ON LINE LNOTOK, TAD (EYNR10 /GET CONTROL WORD LINE SYNTAX ERROR INTO AC /m044 SKP /AND RETURN TO CALLER WITH IT IN AC /m044 LINEOK, ISZ CHKLNE /INCREMENT PC & RETURN CAUSE ALL WENT OK /A011 SAYBYE, JMP I CHKLNE /RETURN TO CALLER /A011 /RTN TO PLACE 1ST WORD OF INPUT LINE INTO WORK BUFFER WITH FIRST WORD OF INPUT /FORMATTED TO BE COMPATIBLE WITH COMMAND PARSER FOR SYMBOL TABLE COMPARISON. CTRLSZ, 0 /SIZE OF CONTROL WORD PUT IN WORK BUFFER, KEEP ON /SAME PAGE WITH "XCTRLW" ROUTINE WRKPTR, 0 /POINTER TO WORK BUFFER, KEEP ON SAME PAGE WITH /"XCTRLW" ROUTINE XCTRLW, XX / DCA CTRLSZ /SET WRKBUF WORD SIZE CHARACTER COUNTER = 0 TAD (WRKBUF+1 /INITIALIZE BUFFER PTR & SAVE FIRST LOCATION... DCA WRKPTR /...IN BUFFER FOR SIZE OF WORD AC0001 /SET AC TO 1 JMS RDLNBF /CALL READ LINE BUFFER RTN TO INITIALIZE FOR READ CYCLE1, JMS RDLNBF /READ A CHAR FROM LINE BUF AND GET IT BACK IN AC AND P177 /MASK OUT HIGH (MODE) BITS DON'T NEED FOR COMPARISON TAD (-ECSPC /ADD TO IT NEGATIVE OF "SPACE" CHAR SPA SNA /IS THE CHAR RETURNED A SPECIAL CHARACTER JMP ENDWRD / YES: GO PROCESS END OF CONTROL BLOCK WORD TAD (ECSPC / NO: RESET AC TO ORIGINAL CHAR READ IN DCA I WRKPTR /PUT CHAR IN WORK BUFFER ISZ CTRLSZ /INCREMENT WORD SIZE COUNT JMS WRKTSZ / " WORK BUFFER PTR & CHECK FOR OVERFLOW /RETURN FROM "WRKTSZ" WITH NORMAL RETURN IF PROCESSING WENT OKAY/A010 /WITH A SKIP RETURN IF IT IS A MATH CTRL BLK WRK BUF OVERFLOW /A010 /AND WITH A DOUBLE SKIP RTRN IF AN OVERFLOW BUT NOT MATH BLOCK /A010 CNTPRC, JMP CYCLE1 /NORMAL RETURN - GO CONTINUE PROCESSING /m044 ISZ XCTRLW /RETURN HERE FOR MATH CTRL BLK WRK BUF OVERFLOW /A010 ISZ XCTRLW /RETURN HERE FOR WRK BUF OVFLW & NOT MATH BLOCK /A010 JMP I XCTRLW /RETURN TO CALLER TO PROCESS ACCORDINGLY /A010 /d044 CNTPRC, JMP CYCLE1 /GO GET NEXT CHARACTER FROM LINE BUFFER /M010 ENDWRD, AC7777 /SET AC TO A MINUS ONE TAD WRKPTR /DECREMENT WORK BUFFER PTR BACK TO LAST CHAR INPUT DCA WRKPTR /AND SAVE IT AC4000 /PUT 4000 IN AC FOR COMPATIBILITY MATCH IN SYMBOL TBLE TAD I WRKPTR /GET LAST CHARACTER ENTERED INTO WORK BUFFER DCA I WRKPTR /SAVE IT BACK AS LAST CHAR IN INPUT CONTROL WORD TAD (WRKBUF /GET START OF WORK BUFFER DCA WRKPTR /INITIAL PTR TO THAT LOCATION TAD CTRLSZ /GET LENGTH OF WORD PLACED IN WORK BUFFER DCA I WRKPTR /SAVE IT AT THE START OF THE WORD IN WORK BUFFER JMP I XCTRLW /RETURN TO CALLER /ROUTINE PERFORMS THE FOLLOWING FUNCTIONS: INCREMENTS THE INPUT LINEBUF /A010 /PTR AND CHECKS FOR AN OVERFLOW. IF NONE THEN IT DOES A NORMAL RETURN /A010 /IF THERE IS ONE THEN A CHECK IS MADE TO SEE IF IT IS THE FIRST LINE OF /A010 /THE BLOCK. IF NOT THEN MUST BE MATH CTRL BLK INPUT LINBUF OVFLW ERROR /A010 /OTHERWISE WOULD NOT HAVE GOTTEN THAT FAR. IF IT IS THE FIRST LINE THEN /A010 /MUST PUT THE FIRST WORD OF THE OVERFLOWED INPUT LINE INTO THE WORK BUF /A010 /IF THE FIRST WORD OVERFLOWS THE WORK BUFFER THEN IT IS REGARDED AS NOT /A010 /BEING A MATH CONTROL BLOCK AND IS PROCESSED ACCORDINGLY. IF THE FIRST /A010 /WORD DOES FIT INTO THE WORK BUFFER THEN IT IS CHECKED BY THE COMMAND /A010 /PARSER TO SEE IF IT IS "WPSMATH". IF IT IS NOT THEN IT IS REGARDED AS /A010 /NOT BEING A MATH CONTROL BLOCK AND IS PROCESSED ACCORDINGLY. IF IT IS /A010 /"WPSMATH" THEN IT IS CONSIDERED A MATH INPUT LINEBUF OVERFLOW ERROR /A010 LNETSZ, XX /MATH CTRL BLK INPUT LINE BUF OVFLW CHECK RTN ISZ LNEPTR /INCREMENT LINE BUFFER POINTER TAD (-UPLNE /GET UPPER LIMIT OF INPUT LINE BUFFER TAD LNEPTR /GET LATEST ADDR AVAILABLE IN INPUT LINE BUFFER SPA CLA /IS THE INPUT LINE BUFFER OVERFLOWED? JMP I LNETSZ / NO: JUST RETURN TO CALLER TAD FSTLNE / YES: GET "CONTROL BLOCK FIRST LINE" FLAG SZA CLA /IS IT THE FIRST LINE OF THE CONTROL BLOCK? JMP YESMTH / NO: SERVICE MATH CTRL BLK LINBUF OVFLW ERROR /A010 /IF 1ST LINE OF CTRL BLK & IS OVERFLOW THEN SEE IF MATH CTRL BLK/A010 JMS XCTRLW /PUT 1ST WORD OF 1ST LINE OVERFLOW INTO WORK BUF/A010 /THE "XCTRLW" RTN PERFORMS A VARIETY OF GYMNASTICS BEFORE /A010 /RETURNING. IN THE CASE OF A WORK BUFFER OVERFLOW A CHECK /A010 /IS DONE TO SEE WHAT LINE OF THE CONTROL BLOCK IS BEING /A010 /PROCESSED. IF A WORK BUFFER OVERFLOW OCCURS WITH THE FIRST /A010 /LINE THEN THE BLOCK IS NOT MATH BECAUSE IF IT WERE THERE /A010 /WOULD BE NO OVERFLOW. IF IT IS NOT THE FIRST LINE THEN /A010 /THE BLOCK HAS TO BE MATH TO HAVE GOTTEN BEYOND THE FIRST LINE /A010 /THE CASES SPECIFIED ARE HANDLED VIA SKIP RETURNS FROM "XCTRLW" /A010 JMP MTHCHK /IF WORD PUT IN WRK BUF O.K. GO SEE IF MATH BLK /A010 JMP NOTMTH /IF OVERFLOW THEN NOT MATH, SET UP TO DUMP BLOCK/A010 /NOTE: NORMALLY "XCTRLW" WILL DO A DOUBLE SKIP /A010 /RETURN WHEN THE BLOCK IS MATH AND THE WORK BUF /A010 /IS OVERFLOWED. IN THIS CONTEXT, HOWEVER, IT CAN/A010 /NEVER DOUBLE SKIP RETURN BECAUSE THIS CODE IS /A010 /USED ONLY WHEN SERVICING A INPUT LINEBUF OVFLW /A010 /ON THE 1ST LINE OF THE BLOCK. THEREFORE IF THE /A010 /WORK BUF OVERFLOWS AT THIS POINT IT IS ASSUMED /A010 /TO NOT BE A MATH CONTROL BLOCK & IS PROCESSED /A010 /AS SUCH. MTHCHK, JMS CMDPSR /CHK IS 1ST WORD OF OVRFLOWED 1ST LINE "WPSMATH"/A010 WRKBUF / PASS START OF WORK BUFFER TO "CMDPSR" /A010 WPSMTH / PASS START OF PERMANENT SYM TBL FOR COMPARISON/A010 SNA CLA /IS RETURNED AC A 1 (I.E. MATCH FOUND)? /A010 JMP NOTMTH / NO: THEN PROCESS AS NOT MATH CTRL BLOCK /A010 YESMTH, /SINCE "RDLNBF" IS USED BE THE ERROR HANDLING CODE TO PLACE THE /A014 /INPUT LINE BUFFER ERROR UP ON THE SCREEN, IT MUST BE MADE /A014 /COMPATIBLE WITH THIS OVERFLOW ERROR ENCOUNTERED, BY SETTING THE/A014 /"LNEBFC" - LINE BUFFER COUNT TO THE MAX # OF CHAR. IN THIS WAY /A014 /THE WHOLE INPUT LINE, UP TO THE OVERFLOW, CAN BE PUT UP ON THE /A014 /SCREEN WHEN THE ERROR MESSAGE IS REPORTED TO THE USER. /A014 AC7777 / YES: GET MAX SIZE OF INPUT LINE BUFFER /A014 DCA LNEBFC /SET LINE BUF CHAR COUNT IN "RDLNBF" TO MAX SIZE/A014 /DOUBLE INCREMENT "LNETSZ" TO RETURN MATH CTRL BLOCK OVFLW ERROR/A010 ISZ LNETSZ /SINCE IT IS A MATH CTRL BLOCK, PROCESS AS /A010 / MTH CTRL BLK INPUT LINE BUF OVFLW ERROR /A010 / DOUBLE INCREMENT PC TO RETURN MTH ERROR /A010 NOTMTH, ISZ LNETSZ /SINGLE INCREMENT PC TO RETURN AS NOT MATH BLOCK/A010 TAD (EVFLW6 /GET INPUT LINE BUF OVERFLOW ERROR VALUE INTO AC/A010 JMP I LNETSZ /RETURN TO CALLER /A010 /RTN TO INCREMENT PTR AND TEST FOR OVERFLOW OF WORK BUFFER. IF THE WORK /A010 /BUFFER NOT OVERFLOWED THEN A NORMAL RETURN IS MADE. IF IT IS THEN A /A010 /CHECK IS MADE TO SEE IF IT IS THE FIRST LINE OF THE CONTROL BLOCK. /A010 /IF IT IS THE FIRST LINE THEN THE RETURN IS SET TO PROCESS AS NOT BEING /A010 /A MATH CTRL BLK. IF IT IS NOT THE FIRST LINE THEN MUST BE MATH BLOCK /A010 /OTHERWISE COULD NOT HAVE GOTTEN THAT FAR SO PROCESS AS MATH CTRL BLOCK /A010 /WORK BUFFER OVERFLOW ERROR /A010 WRKTSZ, XX / ISZ WRKPTR /INCREMENT WORK BUFFER POINTER TAD (-UPWRK /GET UPPER LIMIT OF WORK BUFFER TAD WRKPTR /GET LATEST ADDR AVAILABLE IN WORK BUFFER SPA CLA /IS THE WORK BUFFER OVERFLOWED? JMP I WRKTSZ / NO: JUST RETURN TO CALLER /M010 TAD FSTLNE / YES: GET "CONTROL BLOCK 1ST LINE" FLAG /A010 SZA CLA /IS IT THE FIRST LINE OF THE BLOCK? /A010 JMP OVWKBF / NO: THEN MATH CTRL BLK WRK BUFF OVERLOW ERROR/A010 ISZ WRKTSZ / YES: DOUBLE SET PC &RTRN TO DUMP NOT MATH BLK/A010 OVWKBF, ISZ WRKTSZ /SINGLE BUMP PC TO RTRN WRK BUF OVERFLOW ERROR /A010 TAD (EVFLW7 /GET MATH WORK BUFFER OVRFLW ERROR VALUE INTO AC/A010 JMP I WRKTSZ /RETURN TO CALLER /A010 /ROUTINE TO HANDLE "BEGIN" CONTROL WORD IN EDITOR MATH CONTROL BLOCK /A020 BEGIN, XX JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS... /A024 /....AND RIGHT AFTER CONTROL WORD /A024 JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN AC /A026 /.. TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A026 TAD MTHWRK /GET EDITOR MATH WORK AREA FLAG /M033 SNA CLA /ARE WE JUST BEGINNING AN EDITOR MATH WORK AREA?/M033 JMP ERROR3 / NO: RETURN ERROR - MATH AREA ALREADY BEGUN /M033 /THE FOLLOWING ERROR MIGHT NEVER BE REPORTED BECAUSE IT WILL /BE SUPERCEDED BY TRAPPING OUT THE PREVIOUS ERROR FIRST. HERE /FOR INSURANCE ANYWAY. TAD MTHSND / YES: GET MATH CTRL BLOCK SECOND LINE FLAG /M033 SZA CLA /ARE WE PROCESSING THE SECOND LINE? /M033 JMP ERROR4 / NO: REPORT ERROR - "BEGIN" ON WRONG LINE /M033 /DO FULL INITIALIZATION AT START OF EDIT MATH WORK AREA - BECOMES /A020 /MEANINGFUL WHEN HAVE TO BACK UP TO START OF MATH WORK AREA AND /A020 /REPROCESS EDIT MATH WORK AREA , OR IF FIND OTHER MATH WORK AREAS IN /A020 /SAME DOCUMENT /A020 AC0001 / YES: PUT 1 IN AC TO SET "MTHTYP" IN "RTRN4" /A020 JMS RTRN4 / YES: CALL MATH INITIALIZATION ROUTINES /A020 /ONCE RETURNED FROM "RTRN4" HAVE TO RESET "START OF EDIT MATH WORK AREA"/A020 /FLAG = TRUE BECAUSE NOT LIKE INITIALIZATION TIME ONCE GET THIS FAR /A020 /MEANS MUST BE IN MATH WORK AREA. ALSO MUST RESET "IN CONTROL BLOCK" /A020 /FLAG IN EDITOR MATH CODE IN LP FIELD BACK TO TRUE BECAUSE ONCE GET THIS/A020 /FAR MUST BE IN CTRL BLOCK TOO! /A020 DCA MTHWRK /RESET "START OF EDIT MATH WORK AREA"=TRUE /A020 CDFLP /CHANGE TO LP DATA FIELD /A020 DCA I (INCTLB /RESET "IN CONTROL BLOCK" = TRUE /A020 /D034 /SET BEGFLG FLAG TO TELL MTHBEG ROUTINE IN THE EDITOR TO SCROLL /A027 /D034 /BACK TO THE TOP OF THE CTRL BLOCK & INSERT THE MATH_BEGIN CODE. /A027 /D034 /THIS WILL HAPPEN NEXT TIME THE EDITOR GOES TO EINEXT ROUTINE. /A027 /D034 AC0001 / /A027 /D034 DCA I (BEGFL) /SET FLAG (IN LP FIELD) /A027 CDFMYF /RETURN TO MATH DATA FIELD ISZ BEGIN /SET UP SKIP FOR NORMAL RETURN /A027 JMP I BEGIN /RETURN TO CALLER /A027 ERROR4, TAD (EVSYN4-EVSYN3 /RTRN "BEGIN" ON WRONG LINE ERROR /M027 ERROR3, TAD (EVSYN3 /RTRN EDIT MATH WORK AREA ALREADY BEGUN ERR /M024 JMP I BEGIN /RETURN TO CALLER WITH ERROR NUMBER IN AC /A021 /**************************************************************************** / FLGCTL Moved here from location in LEXASC to create space /a044 /**************************************************************************** / FLaG_ConTroL / Enter with AC bits set to NUMFLG bits you want disabled. FLGCTL, XX CMA AND NUMFLG / AND NUMFLG with complemented bits in AC DCA NUMFLG / update NUMFLG JMP I FLGCTL X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE / /++ / "CMDPSR" - COMMAND PARSER / /FUNTIONAL DESCRIPTION: CMDPSR / /PSEUDO-CODE DESCRIPTION: / / COMMAND PARSER PSUEDO-CODE / /START PROGRAM / SAVE PASSED STARTING ADDRESS OF INPUT_WORD / SAVE " " " " SYMBOL_TABLE / INITIALIZE SYMBOL_TABLE_POINTER / INITIALIZE SYMBOL_TABLE_WORD_COUNTER = 0 / SAVE PASSED INPUT STRING CHARACTER LENGTH AS - INPUT_WORD_LENGTH / INCREMENT STARTING ADDRESS OF INPUT_WORD (TO FIRST CHAR OF INPUT STRING) / DO WHILE SEARCH NOT DONE / | INITIALIZE INPUT_STRING_POINTER / | INITIALIZE INPUT_STRING_CHARACTER_LENGTH_COUNTER = - INPUT_WORD_LENGTH / | INCREMENT SYMBOL_TABLE_WORD_COUNTER / | DO WHILE CHARACTER COMPARISON NOT DONE / | | IF INPUT_WORD_CHARACTER <> SYMBOL_TABLE_WORD_CHARACTER / | | | THEN / | | | CHARACTER COMPARISON DONE / | | | DO WHILE SYMBOL_TABLE_WORD_CHARACTER NOT NEGATIVE / | | | | INCREMENT SYMBOL_TABLE_POINTER / | | | | ENDD0 / | | | INCREMENT SYMBOL_TABLE_POINTER / | | | IF SYMBOL_TABLE_WORD_CHARACTER = 0 / | | | | THEN SEARCH DONE / | | | | ENDIF / | | | ELSE / | | | INCREMENT SYMBOL_TABLE_POINTER / | | | INCREMENT INPUT_STRING_POINTER / | | | INCREMENT INPUT_STRING_CHARACTER_COUNTER / | | | IF INPUT_STRING_CHARACTER_COUNTER = 0 / | | | | THEN SEARCH DONE / | | | | CHARACTER COMPARISON DONE / | | | | ENDIF / | | | ENDIF / | | ENDDO / | ENDDO / RETURN STATUS OF WORD COMPARED /END PROGRAM / / / /CALLING SEQUENCE: JMS CMDPSR / / /INPUT PARAMETERS: COME INTO THIS RTN WITH THE FOLLOWING / VALUES SET RIGHT AFTER THE CALL / JMS CMDPSR /THE CALL... / /...MADE TO THE COMMAND PARSER / XXXXX /#1 - THE ADDR OF THE START OF THE INPUT STRING TO BE COMPARED, / / ALONG WITH IT'S LENGTH IN THE FIRST LOC OF THAT STRING. / YYYYY /#2 - THE ADDR OF THE START OF THE SYMBOL TBLE WITH WHICH TO / / RUN THE COMPARISON. / / /IMPLICIT INPUT: RTNVAL / /OUTPUT PARAMETERS: VALUE IN THE AC / / IF THERE IS A MATCH THEN THIS ROUTINE PASSES BACK TO / THE CALLER IN THE AC THE NUMBER OF THE WORD IN THE / SYMBOL TABLE THAT HAS BEEN MATCHED. / IF THERE IS NO MATCH THEN THIS ROUTINE PASSES BACK TO / THE CALLER A ZERO VALUE IN THE AC. / /IMPLICIT OUTPUT: NONE / /COMPLETION CODE: NONE / /SIDE EFFECTS: NONE / /-- / /COMMAND PARSER ROUTINE CMDPSR, XX /MATH CONTROL BLOCK PARSER ROUTINE / CLA /CLEAR AC TAD I CMDPSR /GET LEAD ADDR OF INPUT STRING ROUTINE DCA SAVLOC /SAVE IT ISZ CMDPSR /INCREMENT PC TO SET UP FOR NEXT PARAMETER PASSED TAD I CMDPSR /GET LEAD ADDR OF SYMBOL TABLE TO BE USED DCA TEMPS4 /SAVE IT DCA RTNVAL /INITIALIZE SYMBOL TABLE WORD COUNTER TO ZERO ISZ CMDPSR /INCREMENT PC TO SET UP FOR RETURN TO CALLER TAD I SAVLOC /GET INPUT STRING CHARACTER LENGTH CIA /GET NEGATIVE AND DCA HLDSTN /SAVE AS INPUT STRING CHARACTER LENGTH ISZ SAVLOC /MOVE INPUT STRING CHARACTER POINTER TO FIRST CHAR /COMPARE INPUT WORD WITH WORD FROM SYMBOL NEXT2, TAD SAVLOC /GET START OF INPUT STRING DCA SAVTMP /INITIALIZE POINTER TO INPUT STRING TAD HLDSTN /GET INPUT STRING SIZE COUNTER /A038 DCA HLDST1 /INITIALIZE INPUT STRING CHAR COUNTER /A038 ISZ RTNVAL /INCREMENT SYMBOL TABLE WORD COUNTER NEXT3, TAD I SAVTMP /GET A CHARACTER FROM INPUT STRING AND (LOWMSK /IF CHAR IS LOWER CASE THAN STRIP AWAY LOWER CASE BIT CIA /GET IT'S NEGATIVE TAD I TEMPS4 /GET CHARACTER FROM SYMBOL TABLE SZA CLA /DO THE CHARACTERS MATCH? JMP MOVWRD / NO: GO MOVE TO START OF NEXT WORD IN SYMBOL TABLE ISZ SAVTMP / YES: INCREMENT INPUT STRING POINTER ISZ TEMPS4 /INCREMENT SYMBOL TABLE POINTER ISZ HLDST1 /IS IT THE END OF THE INPUT STRING? /M038 JMP NEXT3 / NO: GET NEXT SET OF CHARACTERS TO TRY MATCHUP / YES: THEN HANDLE INPUT WORD MATCHUP WITH SYMBOL TBL TAD RTNVAL /GET NUMBER OF SYMBOL TABLE WORD MATCHED AND BYENOW, JMP I CMDPSR /RETURN TO CALLER /SET UP SYMBOL TABLE POINTER FOR BEGINNING OF NEXT WORD MOVWRD, TAD I TEMPS4 /GET LAST CHARACTER CHECKED IN SYMBOL TABLE ISZ TEMPS4 /SET SYMBOL TABLE POINTER TO START OF NEXT WORD /A041 SMA CLA /IS IT A NEGATIVE (i.e. END OF WORD IN SYM TBL)?/A041 JMP MOVWRD / NO: THEN CHECK AGAIN UNTIL END OF WORD FOUND /A041 / YES: GO SET UP POINTER FOR NEXT WORD IN SYM TBL /D041 SPA CLA /IS IT A NEGATIVE (i.e. END OF THAT WORD IN SYM TBL)? /D041 JMP NEWRTN / YES: GO SET UP POINTER FOR NEXT WORD IN SYM TBL /D041 ISZ TEMPS4 / NO: THEN MOVE DOWN A CHARACTER....... /D041 JMP MOVWRD /......AND CHECK AGAIN UNTIL END OF WORD FOUND /D041 NEWRTN, ISZ TEMPS4 /SET SYMBOL TABLE POINTER TO START OF NEXT WORD /CHECK FOR END OF SYMBOL TABLE TAD I TEMPS4 /GET FIRST LETTER OF NEXT WORD IN SYMBOL TABLE SNA CLA /IS IT THE END OF THE SYMBOL TABLE? JMP BYENOW / YES: GO EXIT WITH ZERO IN AC FOR NO MATCH FOUND JMP NEXT2 / NO: GO COMPARE INPUT STRING TO NEXT WORD IN SYM TBL /VALUES USED IN COMMAND PARSER ROUTINE TEMPS4, 0 /POINTER TO PASSED SYMBOL TABLE SAVLOC, 0 /STORE STARTING ADDR OF INPUT STRING SAVTMP, 0 /STORE POINTER TO INPUT STRING RTNVAL, 0 /SYMBOL TABLE WORD COUNTER HLDSTN, 0 /NEGATIVE OF INPUT STRING LENGTH HLDST1, 0 /INPUT STRING CHAR COUNTER /A038 LOWMSK=4137 /MASK TO ELIMINATE BIT SIGNIFYING LOWER CASE CHARACTER /ITLZ ROUTINES MOVED TO ANOTHER PAGE FOR SPACE REASONS /D041 /BEGIN, MOVED TO ANOTHER PAGE FOR ROOM /D041 /END, MOVED TO ANOTHER PAGE FOR ROOM /D027 /TOTAL, MOVED TO ANOTHER PAGE FOR ROOM /D041 / THE FOLLOWING BUFFERS OF 123 LOCATIONS WERE MOVED TO TMATH FOR SPACE /A041 /STRING NUMBER BUFFERS USED BY LEXASC /A041 MAX=20 /DEFINE LENGTH OF MAX AREA FOR Z-BLOCK /A041 B, ZBLOCK MAX+3 /A041 C, ZBLOCK MAX+MAX /A041 SAC, ZBLOCK MAX+MAX /A041 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE / /++ / "XLTFRM" - INFIX TO POSTFIX TRANSLATOR / /FUNTIONAL DESCRIPTION: XLTFRM / /PSEUDO-CODE DESCRIPTION: THIS PSEUDO-CODE EXPLAINS THE FORMATTING / OPERATIONS OF THE TRANSLATOR CODE WHERE / EVERYTHING TO THE LEFT OF AND INCLUDING THE / EQUAL SIGN IS PUT INTO POLISH NOTATION. / /INITIALIZE OPERATOR HANDLING STACK TO EMPTY /PUSH "=" DELIMITER ONTO STACK-MATCHES END OF FORMULA TOKEN VALUE & PRECEDENCE /SET "OPERAND EXPECTED" = TRUE /SET "NEXT INPUT PROCESSED" = TRUE /DO WHILE STACK NOT EMPTY / | IF "NEXT INPUT PROCESSED" = TRUE / | THEN INPUT NEXT INPUT / | ENDIF / | "NEXT INPUT PROCESSED" = FALSE / | IF "OPERAND EXPECTED" = TRUE / | |THEN / | | IF NEXT INPUT IS AN OPERAND / | | | THEN / | | | OUTPUT NEXT INPUT TO POLISH STRING / | | | SET "OPERAND EXPECTED" = FALSE / | | | SET "NEXT INPUT PROCESSED" = TRUE / | | | ELSE / | | | IF NEXT INPUT = "(" / | | | | THEN PUSH NEXT INPUT INTO OPERATOR STACK / | | | | ELSE / | | | | IF NEXT INPUT = UNARY OPERATOR / | | | | | THEN / | | | | | IF NO UNARY OPERATOR ON TOP OF STACK / | | | | | | THEN PUSH UNARY OPRTR & PRECEDENCE ON STK / | | | | | | ELSE OUTPUT OPERAND NOT RECEIVED ERROR / | | | | | | ENDIF / | | | | | ELSE OUTPUT OPERAND NOT RECEIVED ERROR / | | | | | ENDIF / | | | | ENDIF / | | | SET "NEXT INPUT PROCESSED" = TRUE / | | | ENDIF / | |ELSE / | | IF NEXT INPUT IS AN OPERATOR / | | | THEN / | | | CASE PRECEDENCE NEXT INPUT LESS/EQUAL/OR GREATER THAN TOP OF STK / | | | | LOWER / | | | | IF TOP OF STACK = "(" / | | | | | THEN / | | | | | OUTPUT "TOO MANY LEFT PARENTHESIS" / | | | | | ELSE / | | | | | POP STACK AND OUTPUT TO POLISH STRING / | | | | | ENDIF / | | | | EQUAL / | | | | IF TOP OF STACK = "(" / | | | | | THEN / | | | | | POP STACK / | | | | | SET "NEXT INPUT PROCESSED" = TRUE / | | | | | ELSE / | | | | | POP STACK AND OUTPUT TO POLISH STRING / | | | | | ENDIF / | | | | HIGHER / | | | | IF NEXT INPUT = ")" / | | | | | THEN / | | | | | OUTPUT "TOO MANY RIGHT PARENTHESIS" / | | | | | ELSE / | | | | | PUSH NEXT INPUT INTO OPERATOR STACK / | | | | | SET "OPERAND EXPECTED" = TRUE / | | | | | ENDIF / | | | | SET "NEXT INPUT PROCESSED" = TRUE / | | | | END CASE / | | | ELSE / | | | OUTPUT "OPERATOR NOT RECEIVED" / | | | ENDIF / | | ENDIF / | ENDDO / / /CALLING SEQUENCE: JMS XLTFRM / /INPUT PARAMETERS: NONE / /IMPLICIT INPUT: TOKVAL, / /OUTPUT PARAMETERS: MATH OVERFLOW & SYNTAX ERROR NUMBERS IN THE AC / /IMPLICIT OUTPUT: SYMTBL,MTHTBL,OUTLST,RESULT / /COMPLETION CODE: NONE / /SIDE EFFECTS: NONE / /-- / /THE FOLLOWING ROUTINE CONTAINS THE TRANSLATOR CODE FOR THE MATH PACKAGE. /IT IS CALLED FROM A HIGHER ROUTINE WHEN THERE IS A NEED TO CHANGE A MATH /CONTROL BLOCK FORMULA FROM INFIX TO POSTFIX FORMAT. IF THERE ARE ANY ERRORS /IN CONJUNCTION WITH THE SCANNING AND/OR TRANSLATION PROCESS THEY ARE RETURNED /TO THE CALLING ROUTINE AS A CODED NUMBER IN THE AC WITHOUT A SKIP JUMP RETURN XLTFRM, XX /TRANSLATION FROM INFIX TO POSTFIX ROUTINE CLA /CLEAR AC JMS INTLZE /PUT DELIMITER IN STACK, INITIALIZE PTRS, AND FLAGS /DO WHILE STACK NOT EMPTY DOWHLE, JMS EMPTY /CHECK TO SEE - IS STACK EMPTY? JMP ASGNMT / YES: GO HANDLE ASSIGNMENT VALUE JMS TSTINP / NO: GO TO INPUT AND PROCESSING ROUTINE JMS OPERND /GO PROCESS IF INPUT IS OPERAND OR OPERATOR JMP DOWHLE /LOOP BACK TO CONTINUE PROCESSING /NUMBER OF DIFFERENT ERRORS ENCOUNTERED IN THE SCANNER AND /TRANSLATOR RETURNED TO THE CALLER VIA THE AC ERRTKN, TAD TOKVAL /GET ERROR # PASSED FROM LEXIC JMP RTNERR /GO EXIT TRANSLATOR ROUTINE /SYNTAX ERRORS SYNR11, TAD (EYNR11-EYNER6 /FORMULA FORMAT SYNTAX ERROR /A008 SYNER6, TAD (EYNER6-EYNER5 /OPERAND VARIABLE EXPECTED NEXT & NOT RECEIVED SYNER5, TAD (EYNER5-EYNER4 /FORMAT OR END OF FORMULA EXPECTED & NOT REC'D SYNER4, TAD (EYNER4-EYNER3 /TOO MANY RIGHT PARENTHESIS SYNER3, TAD (EYNER3-EYNER2 /TOO MANY LEFT PARENTHESIS SYNER2, TAD (EYNER2-EYNER1 /OPERATOR EXPECTED NEXT BUT NOT RECEIVED SYNER1, TAD (EYNER1-EVFLW5 /OPERAND EXPECTED NEXT BUT NOT RECEIVED /DATA STRUCTURE OVERFLOW ERRORS OVFLW5, TAD (EVFLW5-EVFLW4 /RESULT PTR TBL OVRFLW ERROR /A001 OVFLW4, TAD (EVFLW4-EVFLW3 /OUTPUT LIST (POLISH STRING) OVERFLOW ERR OVFLW3, TAD (EVFLW3-EVFLW2 /SYMBOL TABLE OVERFLOW ERROR /NOTE: PRESENTLY (V1.2.2) ERROR "OVFLW2" CANNOT TAKE PLACE BECAUSE OF THE /RELATIVE SIZE OF THE SYMBOL TABLE TO THE SYMBOL POINTER TABLE. A SYMBOL /TABLE OVERFLOW WILL ALWAYS OCCUR BEFORE THE SYMBOL POINTER TABLE CAN /OVERFLOW. (ref. WPF1.PA & WPMN2.PA - "EVFLW2"). OVFLW2, TAD (EVFLW2-EVFLW1 /SYMBOL PTR TABLE OVRFLW ERR (SEE ABOVE NOTE) OVFLW1, TAD (EVFLW1 /STACK OVERFLOW ERROR RTNERR, JMP ERRBCK /GO EXIT TRANSLATOR ROUTINE WITH ERROR # IN AC /EXIT TRANSLATOR ROUTINE EXTXLT, ISZ XLTFRM /SKIP JMP BACK FOR NORMAL RETURN JMP I XLTFRM /RETURN TO CALLER / /++ / "ASGNMT" - ASSIGNMENT ROUTINE / /FUNTIONAL DESCRIPTION: ASGNMT / /PSEUDO-CODE DESCRIPTION: NOTE: FOLLOWING PSEUDO-CODE HANDLES EVERYTHING / TO THE RIGHT OF THE EQUAL SIGN, AND THEN ONLY / AFTER THE INFIX TO POSTFIX TRANSLATION HAS / COMPLETED ON EVERYTHING TO THE LEFT OF THE / EQUAL SIGN. / /SET "NEXT INPUT PROCESSED" FLAG = TRUE /SET "OPERAND EXPECTED NEXT" = TRUE /INPUT NEXT INPUT /IF NEXT INPUT IS AN OPERAND VARIABLE / | THEN / | OUTPUT NEXT INPUT TO POLISH STRING / | SET "NEXT INPUT PROCESSED" FLAG = TRUE / | ELSE / | OUTPUT SYNTAX ERROR "OPERAND VARIABLE EXPECTED NEXT BUT NOT RECEIVED" / | ENDIF /INPUT NEXT INPUT /IF NEXT INPUT IS A FORMAT STATEMENT / | THEN / | PROCESS FORMAT STATEMENT / | SET "NEXT INPUT PROCESSED" FLAG = TRUE / | INPUT NEXT INPUT / | ENDIF /IF NEXT INPUT IS NOT AN "END OF FORMULA" / | THEN / | OUTPUT SYNTAX ERROR "END OF FORMULA EXPECTED BUT NOT RECEIVED" / | ENDIF / / /CALLING SEQUENCE: JMP ASGNMT / /INPUT PARAMETERS: NONE / /IMPLICIT INPUT: TOKVAL,SVDFLC,DFAULT / /OUTPUT PARAMETERS: NONE / /IMPLICIT OUTPUT: SYMTBL,MTHTBL,RESULT,OUTLST,POSTFX / /COMPLETION CODE: NONE / /SIDE EFFECTS: NONE / /-- / /SENT HERE IF TRANSLATION OF LEFT SIDE OF FORMULA WENT OKAY. THE FOLLOWING /RTN IS USED TO SERVICE THE ASSIGNMENT VALUE TO THE RIGHT OF THE EQUAL SIGN ASGNMT, CLA /SET AC TO ZERO DCA NXTPRS /SET "NEXT INPUT PROCESSED" FLAG = TRUE DCA OPDNXT /SET "OPERAND EXPECTED NEXT" FLAG = TRUE JMS TSTINP /CALL LEXIC AND REQUEST NEXT INPUT /DO A CHECK HERE TO SEE IF USER PUT A HARD RETURN RIGHT AFTER /A016 /THE "=" SIGN IN THE EQUATION. IF SO IT IS TRAPPED OUT TO BE /A016 /REPORTED BACK TO THE USER TO MAKE HIM AWARE OF THIS /A016 TAD TOKEN /GET INPUT TOKEN PASSED BACK FROM LEXIC /A032 TAD (-OPERAT /GET NEGATIVE OF OPERATOR TOKEN /A032 SZA CLA /IS THE TOKEN PASSED BACK AN OPERATOR? /A032 JMP ASGNM1 / NO: THEN CONTINUE TO PROCESS INPUT /A032 TAD TOKVAL / YES: GET ASCII VALUE OF OPERATOR PASSED BACK /A016 TAD (-ECNWLN /GET NEGATIVE OF END OF LINE (HARD RETURN) /A016 SNA CLA /IS THE OPERATOR A HARD RETURN? /A016 JMP SYNR11 / YES: SYNTAX ERROR - FORMULA FORMAT INCORRECT /A016 / NO: IF HARD RETURN NOT FOUND THEN COME HERE /A016 / TO CONTINUE PROCESSING INPUT /A016 ASGNM1, TAD TOKEN /GET INPUT TOKEN PASSED BACK /M032 TAD (-OPERAN /GET NEGATIVE OF OPERAND VARIABLE TOKEN SZA CLA /IS INPUT TOKEN AN OPERAND VARIABLE? JMP SYNER6 / NO: SYNTAX ERROR "OPERAND VARIABLE NOT RECEIVED" JMS OPERND / YES: PROCESS IT & PUT VALUE ADDR IN OUTPUT LIST JMS RLTOUT /PUT ASSIGNMENT OPERAND INFO INTO RESULT PTR TBL /A001 JMS TSTINP /CALL LEXIC AND REQUEST NEXT INPUT TAD TOKEN /GET INPUT TOKEN PASSED BACK TAD (-FORMAT /GET NEGATIVE OF FORMAT STATEMENT SZA CLA /IS IT A FORMAT STATEMENT TOKEN? JMP ENDTKN / NO: SEE IF IT IS AN "END OF FORMULA" TOKEN / YES: DO FORMAT CHECK ROUTINE /A009 /IF FORMAT STATEMENT IS PART OF A "SET" COMMAND /A039 /THEN ALWAYS PROCESS THE FORMAT. IF NOT THEN /A039 /CHECK IF USER FORMAT ALREADY SPECIFIED FOR THE /A009 /ASSIGNMENT VARIABLE FROM A PREVIOUS CTRL WORD /A009 /STATEMENT. CANNOT HAVE TWO DIFFERENT USER /A009 /SPECIFIED FORMATS IN THE SAME CTRL BLOCK FOR /A009 /THE SAME RESULT VARIABLE CAUSE OF MATH ERRORS /A009 TAD I SVDFLC /GET PRESENT FORMAT SETTING OF ASSIGNMENT VAR /A009 CIA /GET IT'S NEGATIVE /A009 TAD (DFAULT /ADD TO IT DFAULT FORMAT SETTING /A009 SZA CLA /HAS THE USER ALREADY SPECIFIED A FORMAT /A009 TAD SETFLG / YES: BUT FIND OUT WHAT KIND OF COMMAND /A039 SZA CLA / IS THIS A FORMULA COMMAND /A039 JMP SKPFMT / YES: IGNORE IT - FORMAT ALREADY SPECIFIED /A009 / NO: DO FORMAT STATEMENT PROCESSING ROUTINE TAD TOKVAL /GET FORMAT STATEMENT PASSED FROM LEXIC DCA I SVDFLC /OVERWRITE IT INTO LOCATION OF DEFAULT FORMAT ..../M007 /SETTING OF ASSIGNMENT VALUE OF INPUT OPERAND VARIABLE SKPFMT, DCA NXTPRS /SET "NEXT INPUT PROCESSED" = TRUE JMS TSTINP /CALL SCANNER AND REQUEST NEXT INPUT /END OF FORMULA PROCESSING ROUTINE ENDTKN, TAD TOKVAL /GET INPUT FROM TOKVAL INTO AC TAD (-ECNWLN /GET NEGATIVE OF END OF LINE (HARD RETURN) SZA CLA /IS IT THE END OF THE FORMULA? JMP SYNER5 / NO: SYNTAX ERROR "END OF FORMULA NOT RECEIVED" /PLACE JMP I OUTEXT AT END OF OUTPUT LIST SO IT CAN BE /USED AS A SUBROUTINE BY THE EXECUTION CODE TAD (JMP I OUTEXT /GET VALUE OF JMP I OUTEXT DCA I OUTPTR /SAVE IT AT THE END OF THE OUTPUT LIST /GO SET UP TO LEAVE THE TRANSLATOR JMP EXTXLT / YES: GO EXIT XLTFRM ROUTINE (i.e. TRANSLATOR) SVDFLC, 0 /POINTER TO LOCATION OF FORMAT STATEMENT OF /A007 /LAST OPERAND PROCESSED. SET UP BY 'MATCH' /A007 /OR 'SYMADD' ROUTINES /A007 SETFLG, 0 /FLAG WORD USED TO DETERMINE IF FORMAT SHOULD /A039 /BE PROCESSED. SETFLG = 0 FOR A SET COMMAND /A039 /AND SETFLG = 1 FOR A FORMAT COMMAND. /A039 /SINCE A SET STATEMENT ABSOLUTELY CHANGES THE /A039 /VALUE OF AN OUTPUT VARIABLE, IT'S FORMAT CAN'T /A039 /AFFECT THE ACCURACY OF ANY CALCULATIONS IN /A039 /PROGRESS. CHANGING THE FORMAT OF A FORMULA /A039 /OUTPUT VARIABLE CAN CAUSE INACCURACIES BY /A039 /INTRODUCING ROUNDING ERRORS. /A039 /THIS SUBOUTINE PLACES INPUT FORMULA ASSIGNMENT OPERAND VARIABLE PTR TO /A001 /START OF NAME INTO RESULT PTR TBL AFTER CHECKING TO SEE THAT A COPY OF /A001 /IT IS NOT THERE ALREADY. IF ONE IS THEN A RETURN IS MADE TO THE /A001 /CALLER WITHOUT FURTHER ACTION. /A001 /FIRST CHECK TO SEE IF ALREADY HAVE NAME IN RESULT PTR TBL /A001 RLTOUT, XX /OUTPUT TO RESULT PTR TABLE RTN /A001 TAD (RESULT /INITIALIZE TEMPORARY POINTER TO RESULT TBL /A001 DCA TMPTR1 /AND SAVE /A001 BCKOVR, TAD TMPTR1 /GET IT BACK AND /A001 CIA /CHECK TO SEE IF IT /A001 TAD RESPTR /IS THE END OF /A001 SNA CLA /THE RESULTS PTR TBL? /A001 JMP INJECT / YES: GO HANDLE ACCORDINGLY /A001 TAD NMEPTR / NO: GET INPUT OPERAND VARIABLE NAME PTR /A001 CIA /GET IT'S NEGATIVE /A001 TAD I TMPTR1 /GET OPRND VARIABLE NAME PTR FROM RESULT PTR TBL /A001 SNA CLA /IS THE PTR ALREADY IN THE TABLE? /A001 JMP SPLIT / YES: THEN GO EXIT RTN WITHOUT DOING ANYTHING /A001 ISZ TMPTR1 / NO: SET UP FOR NEXT OPRND VARIABLE NAME PTR /A001 JMP BCKOVR /GO COMPARE INPUT WITH NEXT PTR FROM TABLE /A001 /PLACE PTR TO UNMATCHED ASSIGNMENT OPERAND NAME INTO RSLT PTR TBL/A001 INJECT, TAD NMEPTR /GET PTR TO ASSIGNMENT OPERAND VARIABLE NAME /A001 DCA I RESPTR /PLACE IT IN THE RESULT PTR TBL /A001 JMS RESTSZ /INCREMENT RESULT PTR TBL PTR & CHK FOR OVERFLOW /A001 SPLIT, JMP I RLTOUT /RETURN TO CALLER /A001 /THE FOLLOWING ROUTINE IS USED TO INCREMENT THE STACK POINTER AND PUSH /A VALUE ONTO THE OPERATOR HANDLING STACK. THE VALUE TO BE PUT ON THE STACK /IS PASSED TO THE ROUTINE VIA THE AC WHEN A CALL IS MADE TO THIS ROUTINE. /THIS ROUTINE ALSO CHECKS FOR A OPERATOR HANDLING STACK OVERFLOW ERROR. PSHSTK, XX /"PUSH ON TO THE STACK" ROUTINE ISZ POSTSP /INCREMENT STACK POINTER DCA I POSTSP /PUSH VALUE PASSED IN THE AC ON TO THE STACK TAD (-UPOPSK /GET NEGATIVE OF UPPER LIMIT OF OPERATOR STACK TAD POSTSP /GET SIZE OF STACK POINTER SNA CLA /IS THERE A STACK OVERFLOW CONDITION? JMP OVFLW1 / YES: GO PROCESS STACK OVERFLOW ERROR JMP I PSHSTK / NO: RETURN TO CONTINUE PROCESSING /THIS ROUTINE CLEARS TOP OPERATOR & IT'S PRECEDENCE OFF STACK FLSHST, XX /FLUSH TOP OF STACK ROUTINE JMS POPSTK /GET PRECEDENCE OFF STACK JMS POPSTK /GET OPERATOR OFF STACK CLA /THROW AWAY VALUE RETURNED IN AC JMP I FLSHST /RETURN TO CALLER /D041 /ROUTINE TO INCREMENT SYMBOL POINTER TABLE POINTER AND TEST FOR OVERFLOW /D041 MTHTSZ, XX /SYM PTR TBL PTR INCREMENT AND OVERFLOW TEST /D041 ISZ MTHPTR /INCREMENT SYM PTR TBL POINTER /D041 TAD (-UPMTH /GET NEGATIVE OF SYM PTR TBL UPPER LIMIT /D041 TAD MTHPTR /GET ADDRESS IN POINTER TO TABLE /D041 SNA CLA /IS THERE AN OVERFLOW? /D041 JMP OVFLW2 / YES: GO PROCESS SYMBOL PTR TABLE OVERFLOW ERROR /D041 JMP I MTHTSZ / NO: RETURN TO CONTINUE PROCESSING /SYMTSZ, MOVED HERE ON EDIT 041 FOR SPACE REASONS /ROUTINE TO OUTPUT CHAR TO SYMBOL TABLE AND INCREMENT SYMBOL TABLE /M005 /POINTER AND TEST FOR OVERFLOW SYMTSZ, XX /SYM TABLE PTR INCREMENT AND OVERFLOW TEST DCA I SYMPTR /OUTPUT CHAR PASSED IN AC TO SYMBOL TABLE /A005 ISZ SYMPTR /INCREMENT SYMBOL TABLE POINTER TAD (-UPSMTB /GET NEGATIVE OF SYM TABLE UPPER LIMIT TAD SYMPTR /GET ADDRESS IN POINTER TO TABLE SNA CLA /IS THERE AN OVERFLOW? JMP OVFLW3 / YES: GO PROCESS SYMBOL TABLE OVERFLOW ERROR JMP I SYMTSZ / NO: RETURN TO CONTINUE PROCESSING X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /ROUTINE TO INCREMENT OUTPUT LIST POINTER AND TEST FOR OVERFLOW /SAVES VALUE PASSED TO IT IN THE AC THEN BUMPS AND TESTS POINTER OUTTSZ, XX /OUTPUT LIST PTR INCREMENT AND OVERFLOW TEST DCA I OUTPTR /PLACE PASSED VALUE IN OUTPUTLIST ISZ OUTPTR /INCREMENT OUTPUT LIST POINTER TAD (-UPOPLT /GET NEGATIVE OF OUTPUT LIST UPPER LIMIT TAD OUTPTR /GET ADDRESS IN POINTER TO TABLE SNA CLA /IS THERE AN OVERFLOW? JMP OVFLW4 / YES: GO PROCESS OUTPUT LIST OVERFLOW ERROR JMP I OUTTSZ / NO: RETURN TO CONTINUE PROCESSING /RTN INCREMENTS RESULT PTR TBLE PTR, TESTS FOR OVERFLOW, & INITS NXT LOC/A001 RESTSZ, XX /RESULT PTR TBL PTR INCREMENT AND OVERFLOW TEST /A001 ISZ RESPTR /INCREMENT RESULT POINTER TABLE POINTER /A001 TAD (-UPRES /GET NEGAIIVE OF RESULT PTR TABLE UPPER LIMIT /A001 TAD RESPTR /GET ADDRESS IN POINTER TO TABLE /A001 SNA CLA /IS THERE AN OVERFLOW? /A001 JMP OVFLW5 / YES: GO PROCESS RESULT PTR TABLE OVERFLOW /A001 DCA I RESPTR / NO: INIT NEXT LOC IN RESULT PTR TBL TO ZERO /A001 JMP I RESTSZ / NO: RETURN TO CONTINUE PROCESSING /A001 /INITIALIZE POSTFIX CONVERSION OPERATOR HANDLING STACK, POINTERS TO STACKS AND /BUFFERS OPERATION SPECIFICATION FLAGS (i.e. "NEXT INPUT PROCESSED" AND /"OPERAND EXPECTED NEXT"). ETC. INTLZE, XX /INITIALIZATION ROUTINE TAD (POSTFX-1 /GET LOCATION ONE LESS THAN OPERATOR HANDLING STACK DCA POSTSP /SET STACK POINTER TO ONE LESS THAN START OF STACK DCA OPDNXT /SET "OPERAND EXPECTED NEXT" FLAG TO TRUE DCA NXTPRS /SET "NEXT INPUT PROCESSED" FLAG TO TRUE TAD (EQUAL /GET BOTTOM DELIMITER OF STACK JMS PSHSTK /PUSH IT ONTO OPERATOR HANDLING STACK TAD EQLVAL+1 /GET PRECEDENCE OF STACK DELIMITER JMS PSHSTK /PUSH IT ONTO OPERATOR HANDLING STACK JMP I INTLZE /RETURN TO CALLER /ROUTINE TO CHECK TO SEE IF THE STACK IS EMPTY EMPTY, XX /STACK EMPTY TEST ROUTINE TAD (POSTFX /GET BASE OF STACK CIA /GET NEGATIVE TAD POSTSP /ADD TO IT ADDRESS IN STACK POINTER SMA CLA /IS STACK EMPTY? ISZ EMPTY / NO: INCREMENT PC FOR NORMAL RETURN JMP I EMPTY / YES: RETURN TO END TRANSLATOR ROUTINE /THE FOLLOWING ROUTINE IS DONE WHILE THE STACK IS NOT EMPTY. IT TESTS FOR /INPUTS AND PROCESSING STATUS AND REQUESTS THE NEXT INPUT WHEN THE CONDITIONS /ARE MET. TSTINP, XX /TEST INPUT AND PROCESSING ROUTINE TAD NXTPRS /GET "NEXT INPUT PROCESSED" FLAG SZA CLA /IS NEXT INPUT PROCESSED YET? JMP DWNOUT / NO: THEN GO SET "NEXT INPUT PROCESSED" FLAG = FALSE JMS LEXIC / YES: GO GET NEXT INPUT TOKEN DCA TOKEN /SAVE TOKEN RETURNED IN AC TAD TOKEN /GET IT BACK SNA CLA /IS AN ERROR CONDITION PASSED BACK FROM SCANNER? JMP ERRTKN / YES: GO PROCESS SCANNER ERROR AND EXIT TRANSLATOR / NO: THEN TOKEN HAS TO BE AN OPERAND OR OPERATOR /SO GET FLAG & RETURN TO HANDLE EITHER OF THEM DWNOUT, AC7777 /GET A MINUS 1 TO SET "NEXT INPUT PROCESSED" FLAG DCA NXTPRS /SET "NEXT INPUT PROCESSED" = FALSE JMP I TSTINP /RETURN TO CALLER /THIS ROUTINE CHECKS TO SEE IF AN OPERAND IS EXPECTED. IF ONE IS THEN /IF THE TOKEN VALUE IN TOKEN (JUST PICKED UP FROM INPUT ROUTINE) /IS AN OPERAND IT IS OUTPUT TO THE POLISH STRING. IF NOT THEN IT CHECKS /FOR EITHER A LEFT PARENTHESIS OR UNARY MINUS, (IN THAT ORDER). /IF EITHER IS FOUND IT IS PUSHED ON TO THE OPERATOR STACK. IF NOT THEN /A "SYNTACTICAL ERROR" IS OUTPUT. APPROPRIATE FLAGS ARE SET ACCORDINGLY. /ELSE IF AN OPERAND IS NOT EXPECTED THEN GO PROCESS AS AN OPERATOR. /ROUTINE TO PROCESS OPERAND/OPERATOR OPERND, XX /OPERAND PROCESSING ROUTINE TAD OPDNXT /GET "OPERAND EXPECTED NEXT" FLAG SZA CLA /IS OPERAND EXPECTED NEXT? JMP OPRTOR / NO: THEN GO PROCESS AS OPERATOR / YES: THEN CHECK IF INPUT IS AN OPERAND VARIABLE TAD TOKEN /GET TOKEN PASSED FROM LEXIC TAD (-OPERAN /SET AC TO NEGATIVE VALUE OF OPERAND TOKEN SNA /IS IT AN OPERAND VARIABLE? JMP OUTOP / YES: OUTPUT TO POLISH STRING, RESET FLAGS,& RETURN / NO: CHECK TO SEE IF THE OPERAND IS A NUMBER TAD (OPERAN-NUMTOK /RESET AC & GET NEGATIVE VALUE OF NUMBER TOKEN /M043 SNA CLA /IS THE OPERAND A NUMBER? JMP OPDNUM / YES: OUTPUT TO POLISH STRING, RESET FLAGS,& RETURN / NO: CONTINUE BY CHECKING FOR "(" OR UNARY OPERATOR TAD LTPVAL /GET LEFT PARENTHESIS NEGATED ASCII VALUE INTO AC TAD TOKVAL /GET ASCII VALUE OF TOKEN PASSED SNA CLA /IS THE OPERATOR A LEFT PARENTHESIS? JMP LFTPUT / YES: GO TO ROUTINE TO PUT IT ON THE STACK TAD TOKVAL / NO: GET ASCII VALUE OF TOKEN PASSED TAD SUBVAL /GET NEGATED ASCII VALUE OF "-" SIGN SNA CLA /IS THE OPERATOR A UNARY MINUS? JMP OUTUNY / YES: GO PROCESS IT TAD TOKVAL / NO: GET ASCII VALUE OF TOKEN PASSED TAD ADDVAL /GET NEGATED ASCII VALUE OF "+" SIGN SNA CLA /IS THE OPERATOR A UNARY PLUS? /M016 JMP OUTUNY / YES: GO PROCESS IT /M016 /DO A CHECK HERE TO SEE IF USER PUT A HARD RETURN IN PLACE OF AN/A016 /OPERAND IN THE LEFT SIDE OF THE EQUATION. IF SO IT IS TRAPPED /A016 /OUT TO BE REPORTED BACK TO THE USER TO MAKE HIM AWARE OF THIS /A016 TAD TOKVAL / NO: GET ASCII VALUE OF TOKEN PASSED BACK /A016 TAD (-ECNWLN /GET NEGATIVE OF END OF LINE (HARD RETURN) /A016 SNA CLA /IS THE OPERATOR A HARD RETURN? /A016 JMP SYNR11 / YES: SYNTAX ERROR - FORMULA FORMAT INCORRECT /A016 /AT THIS POINT EVEN IF A HARD RETURN HAS NOT BEEN FOUND, AN /A016 /ERROR CONDITION HAS BEEN DISCOVERED BECAUSE EITHER AN OPERAND /A016 /OR ONE OF THE ABOVE CONDITIONS SHOULD HAVE BEEN MET AT THIS /A016 /POINT IN THE MATH EXPRESSION /A016 JMP SYNER1 / NO: SYNTAX ERR PROCESS "OPERAND NOT RECEIVED"/A016 / YES: CHECK IF ALREADY HAVE UNARY OPTR ON TOP OF STK /MULTIPLY SEQUENTIAL UNARY OPERATOR INPUT CHECK RTN OUTUNY, TAD UNYMNS+1 /GET PRECEDENCE OF UNARY OPERATOR CIA /SET UP FOR COMPARISON TAD I POSTSP /GET PRECEDENCE OFF TOP OF STACK SNA CLA /IS THERE ALREADY A UNARY OPERATOR ON TOP OF THE STK? JMP SYNER1 / YES: SYNTAX ERROR, PROCESS "OPERAND NOT RECEIVED" / NO: THEN PUT UNARY OPTR & IT'S PRECEDENCE ON STK /NOTE UNARY "+" & "-" BY ADDING 1000 TO THEIR VALUE TAD TOKVAL /GET INPUTTED UNARY OPERATOR TAD (1000 /ADD 1000 TO DISTINGUISH UNARY FROM REGULAR OPERATOR JMS PSHSTK /PUT IT ON THE STACK TAD UNYMNS+1 /GET UNARY OPERATOR PRECEDENCE JMS PSHSTK /PUT IT ON THE STACK JMP FLAGST /GO SET "NEXT INPUT PROCESSED" FLAG = TRUE & EXIT /ROUTINE TO PUT LEFT PARENTHESIS & IT'S PRECEDENCE ON STACK LFTPUT, TAD TOKVAL /GET LEFT PARENTHESIS ASCII VALUE JMS PSHSTK /PUT IT ON THE STACK TAD LTPVAL+1 /GET LEFT PARENTHESIS PRECEDENCE VALUE JMS PSHSTK /PUT IT ON THE STACK JMP FLAGST /GO SET "NEXT INPUT PROCESSED" FLAG=TRUE /THE FOLLOWING CODE SETS THE FLAGS ACCORDINGLY AND THAN EXITS /THE OPERAND/OPERATOR HANDLING ROUTINE FLGFIX, AC7777 /GET NEGATIVE VALUE AND DCA OPDNXT /SET "OPERAND EXPECTED NEXT" FLAG = FALSE FLAGST, CLA /GET ZERO VALUE AND DCA NXTPRS /SET "NEXT INPUT PROCESSED" FLAG = TRUE BACKUP, JMP I OPERND /RETURN TO CALLER (i.e. EXIT OPERAND/OPERATOR... /...PROCESSING ROUTINE "OPERND"). /D041 /SUBRTN PUTS INPUT OPERAND VARIABLE VALUE ADDRESS /D041 /& "PUSH" RTN ADDRESS INTO OUTPUT LIST /D041 PUTLST, XX /RTN PUTS INPUT OPRND VAR & "PUSH" RTN INTO OUTPUT LST /D041 TAD (PUSH /GET STARTING ADDRESS OF OUTPUT "PUSH" ROUTINE /D041 JMS OUTTSZ /SAVE IT, INCREMENT OUTPUT LST PTR & TEST FOR OVERFLOW /D041 TAD SYMPTR /GET ADDR OF VALUE OF INPUT OPERAND FROM SYM PTR TABLE /D041 JMS OUTTSZ /SAVE IT, INCREMENT OUTPUT LST PTR & TEST FOR OVERFLOW /D041 JMP I PUTLST /RETURN TO CALLER PSHLST, XX /PUT INPUT OPRND VAR & "PUSH" RTN INTO OUTPUT LST /A041 DCA TMPCTR /SAVE INPUT OPERAND VARIABLE /A041 TAD (PUSH /GET STARTING ADDRESS OF OUTPUT "PUSH" ROUTINE /A041 JMS OUTTSZ /SAVE IT, INC OUTPUT LST PTR & TEST FOR OVERFLOW /A041 TAD TMPCTR /GET INPUT OPERAND VARIABLE /A041 JMS OUTTSZ /SAVE IT, INC OUTPUT LST PTR & TEST FOR OVERFLOW /A041 JMP I PSHLST /RETURN TO CALLER /A041 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /THIS CROSS FIELD CALLABLE ROUTINE WILL DO A SYMBOL TABLE LOOKUP /ON THE WORD IN TOKVAL. / REGULAR RETURN IF SYMBOL NOT FOUND / SKIP RETURN IF IT IS FOUND / / CALLING CONVENTION: / CDFMYF / MAKE SURE DATA FIELD IS SET TO CALLING FIELD / CIFMTH / INSTRUCTION FIELD SET TO MATH FIELD / JMS SYMCHK / RETURN HERE IF NOT FOUND WITH AC=0 / RETURN HERE IF FOUND WITH AC= ADDRESS OF VALUE IN SYMTAB SYMCHK, XX GOTFLD /GO SET UP TO SAVE CALLING FIELD FOR RETURN /M041 DCA SYMOUT / PUT CIF CDF INSTRUCTION IN PLACE /D041 TAD (MTHTBL /GET SYM POINTER TABLE STARTING ADDRESS TAD (SYMTBL /GET POINTER TO SYMBOL TABLE STARTING ADDRESS /D041 DCA TMPTR2 /SAVE IT AS TEMP PTR TO SYM PTR TABLE DCA NMEPTR /SAVE AS POINTER TO NAME IN SYMBOL TABLE /A041 /GET SYM TBL NAME FOR COMPARISON WITH INPUT STRING OVRAGN, TAD TOKVAL /GET INPUT CHARACTER STRING SIZE CIA /SET UP COUNTER FOR END OF STRING MARKER DCA TMPCTR /SAVE IT TO COUNT CHARACTERS FOR INPUT STRING COMPARE /D041 TAD MTHPTR /GET PRESENT POSITION OF SYM PTR TABLE PTR /D041 CIA /GET IT'S NEGATIVE /D041 TAD TMPTR2 /GET TEMPORARY POINTER TO SYM PTR TABLE TAD NMEPTR /GET CURRENT POSITION INTO SYMBOL TABLE /A041 CIA /MAKE IT NEGATIVE /A041 TAD SYMPTR /SUBTRACT LAST ADDRESS OF SYMBOL TABLE /A041 SPA SNA CLA /HAVE ALL SYMBOLS BEEN TRIED FOR COMPARISON? /M041 JMP SYMOUT / YES: INPUT NOT IN SYM TABLE, DO REGULAR RETURN /D041 TAD I TMPTR2 / NO: GET ADDR TO VARIABLE NAME IN SYMBOL TABLE TAD NMEPTR / NO: GET ADDR TO VARIABLE NAME IN SYMBOL TABLE /A041 DCA SYMVAR /SAVE STARTING ADDRESS TO VARIABLE NAME IN SYMBOL TABLE TAD (TOKVAL+1 /GET BEGINNING ADDRESS OF INPUT STRING DCA TMPTR1 /SAVE IT AS POINTER TO INPUT TAD I NMEPTR /GET FIRST CHARACTER OF VARIABLE NAME /A041 TAD (200-": /CHECK FOR A COLON - ALL NAMES BEGIN WITH ONE /A041 SNA CLA /IF NOT THEN WE ARE POINTING TO A NUMBER CONSTANT /A041 JMP REPEAT /IT'S A NAME SO GO CHECK FOR A MATCH /A041 JMP VALSKP /IT'S A NUMBER SO GO MOVE THE POINTER OVER IT /A041 /MOVE POINTER TO NEXT ENTRY IN THE SYMBOL TABLE /A041 NXTSTR, TAD I NMEPTR /PICK UP A CHARACTER FROM THE SYMBOL TABLE /A041 ISZ NMEPTR /BUMP UP TO NEXT LOCATION /A041 SMA CLA /CHECK FOR THE END OF THE SYMBOL NAME /A041 JMP NXTSTR /NOT YET, GO CHECK AGAIN /A041 AC0001 /GOT IT, NOW ADD IN LENGTH OF FORMAT WORD /A041 VALSKP, TAD (VALSIZ /LENGTH OF A STORED NUMBER IN THE SYMBOL TABLE /A041 TAD NMEPTR /ADD TO PRESENT POINTER LOC INTO SYMBOL TABLE /A041 DCA NMEPTR /BUMP POINTER TO NEXT TABLE ENTRY /A041 JMP OVRAGN /GO CHECK THE NEXT TABLE ENTRY /A041 /COMPARE INPUT TO SYM TABLE STRING REPEAT, TAD I SYMVAR /GET CHARACTER FROM SYMBOL TABLE ISZ SYMVAR /INCREMENT SYM TABLE ADDR TO NEXT CHARACTER /A041 CIA /GET NEGATIVE OF ASCII VALUE OF CHARACTER TAD I TMPTR1 /GET CHARACTER FROM INPUT STRING ISZ TMPTR1 /INCREMENT INPUT STRING ADDR TO NEXT CHARACTER /A041 SZA CLA /DO THE CHARACTERS MATCH? JMP NXTSTR / NO: START COMPARISON WITH NEXT NAME IN SYM TABLE ISZ TMPCTR /ARE WE THRU WITH INPUT STRING? /D041 JMP CONTNU / NO: GO COMPARE NEXT SET OF CHARACTERS JMP REPEAT / NO: GO COMPARE NEXT SET OF CHARACTERS /M041 ISZ SYMCHK / YES: WE FOUND A MATCH SO DO A SKIP RETURN ISZ SYMVAR /INCREMENT POINTER PAST FORMAT WORD /A041 TAD SYMVAR /GET POINTER TO VALUE OF SYMBOL IN TABLE /A041 /(NEEDED BY WPSELC.PA WHO CALLS SYMCHK) /A003 SYMOUT, 0 / THIS GETS STUFFED WITH A CIF CDF TO CALLING FIELD JMP I SYMCHK / RETURN /D041 ISZ TMPTR2 /SET POINTER TO VALUE OF SYMBOL /D041 TAD I TMPTR2 / AND PUT ADDRESS OF SYMTAB ENTRY INTO AC /A003 /D041 / (NEEDED BY WPSELC.PA WHO CALLS SYMCHK) /A003 /D041 IAC / INCREMENT TO GET PAST FORMAT INDICATER /A005 /D041 JMP SYMOUT / /D041 CONTNU, ISZ SYMVAR /INCREMENT SYM TABLE ADDR TO NEXT CHARACTER /D041 ISZ TMPTR1 /INCREMENT INPUT STRING ADDR TO NEXT CHARACTER /D041 JMP REPEAT /GO COMPARE NEXT CHARACTER OF BOTH STRINGS /RETURN TO GET ANOTHER SYMBOL TABLE VARIABLE NAME /D041 NXTSTR, ISZ TMPTR2 /DOUBLE INCREMENT POINTER TO SYM PTR TABLE... /D041 ISZ TMPTR2 /...TO SKIP OVER ADDRESS OF VALUE OF VARIABLE /D041 JMP OVRAGN /GO BACK AND RUN COMPARE WITH ANOTHER SYM TABLE NAME /D041 SYMOUT, 0 / THIS GETS STUFFED WITH A CIF CDF TO CALLING FIELD /D041 JMP I SYMCHK / RETURN /TAKE OPERAND VARIABLE NAME AND IT'S VALUE ADDRESS AND PUSH IT /INTO POLISH FORMATTED OUTPUT LIST. BUT BEFORE OUTPUTTING OPERAND /CHECK FOR IT'S PRESENCE ALREADY IN THE SYMBOL TABLE. / CALL THE SYMCHK ROUTINE TO LOOK UP THE WORD IN TOKVAL (OPERAND / VARIABLE NAME) TO SEE IF IT IS ALREADY IN THE SYMBOL TABLE OUTOP, JMS SYMCHK / IS THE SYMBOL NAME ALREADY IN SYMBOL TABLE? JMP SYMADD / NO, GO ADD IT TO THE SYMBOL TABLE AC7777 /DON'T NEED POINTER TO NAME WHICH SYMCHK RETURNED/A041 TAD SYMVAR /GET POINTER TO ADDRESS OF FORMAT WORD IN TABLE /A041 DCA SVDFLC /SAVE POINTER IN CASE WE GET A FORMAT LATER /A041 TAD SYMVAR /GET POINTER TO VALUE OF SYMBOL IN TABLE /A041 JMS PSHLST /PUT IT ON THE STACK /A041 JMS CHKTYP /DO SPECIAL CHECK FOR EDITOR MATH /A041 JMP FLGFIX /GO SET FLAGS AND EXIT OPERAND/OPERATOR ROUTINE /A041 /THIS ROUTINE PROVIDES A HOOK TO PROCESS THE EDITOR MATH SYMBOLS /A041 /":Dnn" & ":Tnn", IF IN EDITOR MATH THEN GO PROCESS SYMBOLS BEING /A041 /PUT IN THE TABLE. IF SYMBOL IS ONE OF THE AFOREMENTIONED THEN IT IS /A041 /SAVED IN A SPECIAL TABLE TO BE USED BY THE EXTRACTION/INSERTION /A041 /ROUTINES IN EDITOR MATH /A041 CHKTYP, XX /HANDLE SPECIAL CHECK FOR EDITOR MATH /A041 TAD MTHTYP /GET "MATH MODE" FLAG /A041 SNA CLA /ARE WE IN LIST PROCESSING MATH? /A041 JMP I CHKTYP / YES: THEN RETURN TO CALLER /A041 TAD (NMEPTR / NO: GET POINTER TO START OF VARIABLE NAME /A041 CIFLP /CHANGE TO LP INSTRUCTION FIELD /A041 JMS CHKNME /GO PROCESS EDITOR MATH SYMBOL /A041 JMP I CHKTYP /RETURN TO CALLER /A041 /D041 /\JMP MATCH / YES, FALL INTO MATCH ROUTINE /D041 /OUTPUT ADDR OF VALUE OF OPERAND VARIABLE MATCHED IN SYM TBL /D041 /THIS RTN USED FOR INPUT VAR WITH MATCHUP FOUND IN SYM TBL /D041 MATCH, CLA /DON'T NEED POINTER TO NAME WHICH SYMCHK RETURNED/A003 /D041 TAD (PUSH /GET STARTING ADDRESS OF OUTPUT "PUSH" ROUTINE /D041 JMS OUTTSZ /SAVE IT, INCREMENT OUTPUT LST PTR & TEST FOR OVERFLOW /D041 TAD I TMPTR2 /GET PTR ADDR OF VALUE OF INPUT VARIABLE /A007 /D041 DCA SVDFLC / SAVE POINTER TO FORMAT INDICATOR INCASE WE GET/A007 /D041 / ONE LATER /A005 /D041 TAD I TMPTR2 /GET PTR ADDR OF VALUE OF INPUT VARIABLE /A007 /D041 IAC / INCREMENT TO GET PAST FORMAT INDICATER /A005 /D041 JMS OUTTSZ /SAVE IT, INCREMENT OUTPUT LST PTR & TEST FOR OVERFLOW /D041 /ROUTINE TO SAVE ADDR OF LAST OPERAND VARIABLE NAME AND /A001 /D041 /VALUE FOR LATER OUTPUT TO RESULT PTR TABLE IF REQUIRED. /A001 /D041 AC7777 /GET AC TO MINUS ONE /A001 /D041 TAD TMPTR2 /DECREMENT PTR TO SYMBOL POINTER TABLE /A001 /D041 DCA TMPTR2 /SAVE IT /A001 /D041 TAD I TMPTR2 /GET ADDR OF NAME OF INPUT OPERAND VARIABLE /A001 /D041 DCA NMEPTR /SAVE IT TO BE USED IN "RLTOUT" RTN /A001 /D041/HOOK HERE TO PROCESS EDITOR MATH SYMBOLS ":Dnn" & ":Tnn", IF IN /A030 /D041/EDITOR MATH THEN GO PROCESS SYMBOLS BEING PUT IN THE TABLE. IF /A030 /D041/SYMBOL IS ONE OF THE AFOREMENTIONED THEN IT IS SAVED IN A SPECIAL /A030 /D041/TABLE TO BE USED BY THE EXTRACTION/INSERTION ROUTINES IN EDITOR MATH/A030 /D041 TAD MTHTYP /GET "MATH MODE" FLAG /A030 /D041 SNA CLA /ARE WE IN LIST PROCESSING MATH? /A030 /D041 JMP MATCH1 / YES: THEN CONTINUE TO PROCESS IT /A030 /D041 TAD TMPTR2 / NO: GET PTR TO START OF MATCHED VAR NAME /A030 /D041 CIFLP /CHANGE TO LP INSTRUCTION FIELD /A030 /D041 JMS CHKNME /GO PROCESS EDITOR MATH SYMBOL /A030 /D041MATCH1, JMP FLGFIX /GO SET FLAGS AND EXIT OPERAND/OPERATOR ROUTINE /ADD INPUT VARIABLE NAME TO SYMBOL TABLE. THIS RTN USED FOR /INPUT OPERAND VARIABLES NOT FOUND IN SYMBOL TABLE SYMADD, TAD TOKVAL /GET LENGTH OF VARIABLE NAME CIA /SET UP NEGATIVE DCA TMPCTR /SAVE NEGATIVE AS A COUNTER /SAVE ADDR OF LAST INPUT OPERAND VARIABLE NAME FOR POSSIBLE /A001 /LATER OUTPUT TO RESULT PTR TBL BY "RLTOUT" RTN /A001 TAD SYMPTR /GET ADDRESS OF NAME OF INPUT OPERAND VARIABLE /A001 DCA NMEPTR /SAVE IT TO BE USED IN "RLTOUT" RTN /A001 /PUT INPUT OPERAND VARIABLE ADDRESS AND DEFAULT FORMAT /STATEMENT VALUE INTO SYMBOL POINTER TABLE /D041 TAD SYMPTR /GET FIRST FREE LOCATION IN SYMBOL TABLE /D041 DCA I MTHPTR /SAVE ADDR OF THIS LOCATION IN SYM PTR TABLE /D041 JMS MTHTSZ /INCREMENT PTR AND CHECK FOR SYM PTR TABLE OVERFLOW TAD (TOKVAL+1 /GET START OF INPUT STRING DCA TMPTR1 /SAVE IT AS A POINTER RETRY, TAD I TMPTR1 /GET A CHARACTER FROM THE INPUT STRING JMS SYMTSZ /OUTPUT TO SYMBOL TABLE & CHECK FOR OVERFLOW /M005 ISZ TMPTR1 /SET TOKVAL PTR TO NEXT INPUT CHARACTER ISZ TMPCTR /IS IT THE END OF THE INPUT STRING? JMP RETRY / NO: GO BACK AND GET ANOTHER CHARACTER / YES: PUT INPUT OPRND VAR ADDR INTO SYM PTR TBL /D041 /PUT INPUT OPERAND VALUE ADDRESS INTO SYMBOL POINTER TABLE /D041 TAD SYMPTR /GET BEGINNING ADDRESS OF FORMAT & VALUE /D041 DCA I MTHPTR /SAVE ADDRESS IN SYMBOL POINTER TABLE /D041 JMS MTHTSZ /INCREMENT PTR AND CHECK FOR SYM PTR TABLE OVERFLOW /PUT INPUT OPERAND VALUE DEFAULT FORMAT IN SYMBOL TABLE TAD SYMPTR /GET POINTER TO PLACE FOR FORMAT WORD /A007 DCA SVDFLC /AND SAVE FOR POSSIBLE USE IF FORMAT WORD FOUND /A007 TAD (DFAULT /GET DEFAULT VALUE FOR FORMAT JMS SYMTSZ /OUTPUT TO SYMBOL TABLE & CHECK FOR OVERFLOW /M005 TAD SYMPTR /GET POINTER TO PLACE FOR SYMBOL VALUE WORDS /A041 DCA SYMVAR /SAVE POINTER TO START OF SYMBOL VALUE /A041 JMS CHKTYP /DO SPECIAL CHECK FOR EDITOR MATH /A041 /PUT OPRND VAR VALUE ADDR & "PUSH" RTN ADDR INTO OUTPUT LST TAD SYMPTR /GET POINTER ADDRESS TO VALUE IN SYMBOL TABLE /A041 JMS PSHLST /PUSH VALUES ONTO OUTPUT LIST /A041 /D041/HOOK HERE TO PROCESS EDITOR MATH SYMBOLS ":Dnn" & ":Tnn", IF IN /A030 /D041/EDITOR MATH THEN GO PROCESS SYMBOLS BEING PUT IN THE TABLE. IF /A030 /D041/SYMBOL IS ONE OF THE AFOREMENTIONED THEN IT IS SAVED IN A SPECIAL /A030 /D041/TABLE TO BE USED BY THE EXTRACTION/INSERTION ROUTINES IN EDITOR MATH/A030 /D041 TAD MTHTYP /GET "MATH MODE" FLAG /D041 SNA CLA /ARE WE IN LIST PROCESSING MATH? /D041 JMP PRSCLP / YES: THEN CONTINUE TO PROCESS IT /D041 AC7776 /THEN SET AC TO POINT TO LATEST ENTRY IN /A023 /D041 TAD MTHPTR / SYMBOL TABLE /A023 /D041 CIFLP / NO: CHANGE INSTRUCTION REGISTER TO LP FIELD /D041 JMS CHKNME /GO PROCESS AS EDITOR MATH SYMBOL /D041 /PUT OPRND VAR VALUE ADDR & "PUSH" RTN ADDR INTO OUTPUT LST /D041 PRSCLP, JMS PUTLST /M020 /ALLOW "VALSIZ" LOCATIONS IN SYM TBL FOR VALUE OF INPUT OPERND /NOTE: FIRST LOC OF VALUE TO HOLD DEFAULT BIT SETTING OF NUM. /OTHER LOCATIONS OF VALUE TO BE INITIALIZED TO ZEROES. TAD (NMDFLT /GET INPUT OPERND VALUE DEFAULT BIT SETTING JMS SYMTSZ /OUTPUT TO SYMBOL TABLE & CHECK FOR OVERFLOW /M005 TAD (VALSIZ-1 /ADD FLOATING POINT VALUE SIZE -1 IN NUM OF LOCATIONS CIA /GET NEGATIVE DCA TMPCTR /SAVE IT TO USE AS A COUNTER VALOOP, JMS SYMTSZ /OUTPUT 0 TO SYMBOL TABLE & CHECK FOR OVERFLOW /M005 ISZ TMPCTR /DONE ALLOCATING SPACE IN SYM TBL FOR THE VALUE? JMP VALOOP / NO: MOVE SYM TBL PTR DOWN ANOTHER LOCATION JMP FLGFIX / YES: GO SET FLAGS AND EXIT OPERAND/OPERATOR ROUTINE /ROUTINE TO PROCESS NUMERICAL INPUT OPERAND OPDNUM, JMS CHKNUM /GO CHECK IF NUMBER IS ALREADY IN SYMBOL TABLE /A040 TAD SYMPTR /IT'S NOT, GET POINTER TO BOTTOM OF SYMBOL TABLE /A041 JMS PSHLST /GO PUT INPUT OPRND NUM & "PUSH" RTN INTO OUTPUT LST /PUT NUMERICAL INPUT OPERAND INTO SYMBOL TABLE TAD (TOKVAL /GET STARTING ADDR OF PASSED NUMERICAL OPERAND DCA TMPTR1 /SAVE IT FOR USE AS A POINTER TAD (VALSIZ /GET FLOATING POINT NUMBER SIZE CIA /GET NEGATIVE DCA TMPCTR /SET UP COUNTER OF NUMBER OF LOCATIONS CONTAINING NUM LOOPNM, TAD I TMPTR1 /GET ONE LOCATION'S WORTH OF NUMBER PASSED JMS SYMTSZ /OUTPUT TO SYMBOL TABLE & CHECK FOR OVERFLOW /M005 ISZ TMPTR1 /MOVE PTR TO NEXT LOCATION OF INPUT NUMBER /M040 ISZ TMPCTR /IS THE NUMBER DONE BEING TRANSFERRED YET? JMP LOOPNM / NO: GET NEXT PART OF INPUT NUMERICAL OPERAND /M040 JMP FLGFIX / YES: GO SET FLAGS & EXIT /MOVED HERE ON EDIT 041 /PROCESS TABLE USED IN RELATION TO CONTROL WORD FOUND IN CONTROL BLOCK. THE /CONTROL WORD MATCHED UP IN THE SYMBOL TABLE IS GIVEN A NUMBER WHICH, WHEN /RETURNED IN THE AC, IS USED AS AN OFFSET TO JUMP INTO THE RELATED RTN HERE HNDCTL, BEGIN /ADDRESS OF "BEGIN" PROCESSING ROUTINE /A018 END / " " "END" " " /A018 TOTAL / " " "TOTAL" " " /A018 FRMULA / " " "FORMULA" " " ROUND / " " "ROUND" " " TRNCTE / " " "TRUNCATE" " " SETCMD / " " "SET" " " /M042 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /ROUTINE TO HANDLE INPUTED OPERATOR TOKEN, IT'S VALUE, AND PRECEDENCE /AS COMPARED TO WHAT IS PRESENTLY ON THE STACK. /NOTE: A BRANCH IS DONE TO HERE IF THE BEGINNING OF "OPERAND" ROUTINE IS NOT /AN OPERAND EXPECTED OR ONE OF SEVERAL SPECIAL CASES HANDLED THERE. ASCPTR, 0 /POINTER TO OPERATOR ASCII VALUE TABLE - KEEP ON SAME /PAGE AS "OPRTOR" ROUTINE TMPOPR, 0 /USED TO SAVE VALUE OF INPUT OPERATOR, KEEP ON SAME /PAGE AS "SKPDWN", "TYPOPR", AND "POPOUT" ROUTINES /CHECK TO SEE IF THE TOKEN PASSED IS AN OPERATOR OPRTOR, TAD (-OPERAT /SET AC TO NEGATIVE OF OPERATOR TOKEN TAD TOKEN /ADD TOKEN PASSED FROM LEXIC SZA CLA /IS THE TOKEN PASSED AN OPERATOR? JMP SYNER2 / NO: OUTPUT SYNTAX ERROR "OPERATOR NOT RECEIVED" / YES: CHECK FOR "END OF LINE" RETURNED /A008 TAD TOKVAL /GET VALUE PASSED FROM LEXIC /A008 TAD (-ECNWLN /ADD TO IT "END OF LINE" (I.E HARD RETURN) /A008 SNA CLA /IS OPERATOR PASSED BACK AN "END OF LINE"? /A008 JMP SYNR11 / YES: SYNTAX ERROR - FORMULA FORMAT INCORRECT /A008 /NOTE: ERROR "SYNR11" NOW INFORMS USER AS TO /A016 /ILLEGAL PLACEMENT OF A HARD RETURN WITHIN THE /A016 /CONTEXT OF A MATH EXPRESSION. THIS IS ONE OF /A016 /PLACES WHERE IT GETS TRAPPED OUT TO DO THIS /A016 / NO: CHECK FOR TYPE OF OPERATOR SKPDWN, TAD TOKVAL /GET VALUE OF INPUT OPERATOR FROM TOKVAL DCA TMPOPR /SAVE IT IN LOCATION WHERE CAN BE HANDLED BY "TYPOPR" JMS TYPOPR /GO FIND OUT WHICH TYPE OF OPERATOR HAS BEEN INPUT JMP FOUND /GO HANDLE OPERATOR MATCHUP FOUND /SUBROUTINE TO CHECK FOR TYPE OF OPERATOR INPUTTED /NOTE: THIS ROUTINE LEAVES THE OPERATOR NEGATIVE ASCII VALUE /TABLE POINTER POINTED TO THE NEGATIVE ASCII OPERATOR VALUE /THAT MATCHES THE INPUTTED OPERATOR! IT IS USED AS A REFERENCE /POINT FROM WHICH TO GET THE OPERATOR PRECEDENCE FOR STACK /MANIPULATIONS AND THE OPERATOR FUNCTION ROUTINE ADDRESS /WHICH MUST BE PLACED INTO THE OUTPUT LIST TYPOPR, XX /SUBROUTINE TO FIND OPERATOR MATCH IN TABLE TAD (ADDVAL /GET THE START OF OPERATOR ASCII VALUES TABLE DCA ASCPTR /SAVE IT TO USE AS POINTER BGNLOP, TAD I ASCPTR /GET NEGATIVE OF ASCII VALUE OF OPERATOR FROM TABLE TAD TMPOPR /GET ASCII VALUE OF INPUT OPERATOR TO BE FOUND SNA CLA /IS NEGATIVE ASCII VALUE OF OPERATOR FOUND? JMP I TYPOPR / YES: RETURN TO CALLER WITH PTR SET AT MATCH FOUND ISZ ASCPTR / NO: SET POINTER TO NEXT VALUE ISZ ASCPTR /DOUBLE INCREMENTED TO BYPASS PRECEDENCE IN TABLE ISZ ASCPTR /TRIPLE " TO BYPASS OPTR FUNCTION RTN ADDR IN TBL JMP BGNLOP /AND TRY AGAIN TO FIND RIGHT ASCII VALUE /RTN TO HANDLE THE TYPE OF OPERATOR FOUND BY DOING PRECEDENCE /COMPARISON OF OPERATOR ON TOP OF STACK WITH INPUT OPERATOR. FOUND, ISZ ASCPTR /MOVE TOKEN TBLE PTR TO PRECEDENCE OF OPERATOR FOUND TAD I ASCPTR /GET PRECEDENCE OF INPUT OPERATOR CIA /GET NEGATIVE TAD I POSTSP /GET PRECEDENCE OFF TOP OF OPERATOR STACK SNA /DOES THE PRECEDENCE OF NEXT INPUT=TOP OF STACK? JMP EQUALP / YES: GO HANDLE CASE OF EQUAL PRECEDENCE SPA CLA / NO: IS PRECEDENCE OF INPUT LESS THAN TOP OF STK? JMP HIGHRP / NO: THAN GO HANDLE CASE OF HIGHER PRECEDENCE / YES: THAN HANDLE CASE OF LOWER PRECEDENCE HERE /CASE OF PRECEDENCE OF NEXT INPUT IS LESS THAN THAT OF TOP OF STACK LOWERP, JMS TOPOPR /GET ASCII VALUE OF TOP OPERATOR OF STACK INTO AC TAD LTPVAL /ADD TO IT NEGATIVE ASCII VALUE OF "(" OPERATOR SNA CLA /IS THERE A LEFT PARENTHESIS ON THE TOP OF THE STACK? JMP SYNER3 / YES: SYNTAX ERROR "TOO MANY LEFT PARENTHESIS" JMS POPOUT / NO: THEN POP STACK AND OUTPUT TO POLISH STRING JMP BACKUP /GO EXIT OPERAND/OPERATOR PROCESSING ROUTINE /CASE OF PRECEDENCE OF NEXT INPUT IS EQUAL THAT OF TOP OF STACK EQUALP, JMS TOPOPR /GET ASCII VALUE OF TOP OPERATOR OF STACK INTO AC TAD LTPVAL /ADD TO IT NEGATIVE ASCII VALUE OF "(" OPERATOR SNA CLA /IS THERE A LEFT PARENTHESIS ON THE TOP OF THE STACK? JMP SVCLTP / YES: THEN GO PROCESS IT JMS POPOUT / NO: POP STACK AND PUT IN OUTPUT LIST JMP BACKUP /GO EXIT OPERAND/OPERATOR PROCESSING ROUTINE /EQUAL PRECEDENCE AND "(" ON TOP OF THE STACK SVCLTP, JMS FLSHST /GO CLEAR THE TOP OPERATOR & IT'S PRECEDENCE OFF STACK JMP FLAGST /GO SET "NEXT INPUT PROCESSED" FLAG=TRUE AND THEN EXIT /CASE OF PRECEDENCE OF NEXT INPUT IS GREATER THAN THAT OF TOP OF STACK HIGHRP, TAD TOKVAL /GET ASCII VALUE OF INPUT OPERATOR TAD RTPVAL /GET NEGATIVE ASCII VALUE OF RIGHT PARENTHESIS SNA CLA /IS NEXT INPUT A RIGHT PARENTHESIS? JMP SYNER4 / YES:PROCESS SYNTAX ERROR "TO MANY RIGHT PARENTHESIS TAD TOKVAL / NO: GET INPUT OPERATOR... JMS PSHSTK /...AND PUSH IT INTO THE STACK TAD I ASCPTR /GET INPUT OPERATOR PRECEDENCE (PTR SET IN 'FOUND'RTN) JMS PSHSTK /...AND PUSH IT INTO STACK DCA OPDNXT /SET "OPERAND EXPECTED NEXT" FLAG=TRUE JMP FLAGST /SET "NEXT INPUT PROCESSED" FLAG=TRUE AND EXIT /SUBROUTINES USED BY THE PREVIOUS OPERATOR PROCESSING CODE /THIS ROUTINE POPS THE TOP OPERATOR OFF THE STACK AND /OUTPUTS THE ADDRESS OF THE FUNCTION ROUTINE THAT /COINCIDES WITH THAT OPERATOR TO THE OUTPUT LIST. IT ALSO /ELIMINATES UNARY PLUS OPERATORS FROM BEING OUTPUT TO THE LIST POPOUT, XX /POP STACK & OUTPUT TO POLISH STRING ROUTINE JMS POPSTK /CLEAR PRECEDENCE OFF TOP OF STACK... JMS POPSTK /...AND GET TOP OPERATOR OFF OF STACK DCA TMPOPR /SAVE IT IN LOCATION TO HANDLE MATCHUP WITH TABLE JMS TYPOPR /GET POINTER TO MATCHING OPERATOR IN OPR VALUE TBL ISZ ASCPTR /DOUBLE INCREMENT POINTER TO LINE UP ON MATCHING... ISZ ASCPTR /...ROUTINE THAT PERFORMS OPERATOR FUNCTION TAD I ASCPTR /GET ADDRESS OF THAT OPERATOR FUNCTION ROUTINE SNA /IS THE TOP OPERATOR ON THE STACK A UNARY PLUS JMP I POPOUT / YES: THEN DUMP IT AND RETURN JMS OUTTSZ / NO: SAVE IT, INCREMENT O/P LST PTR & TEST FOR OVFLW JMP I POPOUT /RETURN TO CALLER /THIS ROUTINE RETURNS TO A CALLER THE ASCII VALUE OF THE TOP /OPERATOR IN THE OPERATOR STACK. IT'S ASCII VALUE IS RETURNED /TO THE CALLER IN THE AC TOPOPR, XX /GET TOP OPERATOR FROM STACK ROUTINE AC7777 /SET AC TO -1 TAD POSTSP /DECREMENT STACK POINTER 1 LOCATION TO REACH OPERATOR DCA TMPTR2 /SAVE IT TAD I TMPTR2 /GET TOP OPERATOR OFF OF STACK JMP I TOPOPR /RETURN TO CALLER WITH OPERATOR ASCII VALUE IN AC /SUBROUTINE CALLED FROM "RTRN4A" TO INITIALIZE PATCHES TO THE "PRCTRL" /A019 /ROUTINE. THIS IS DONE TO ALLOW FOR DIFFERENT ENTRY POINTS INTO THE /A019 /PERMENANT SYMBOL TABLE WHERE CTRL WORDS ARE EVALUATED FOR PROCESSING /A019 /THE CODE ENTERS AT "EDTCTL" FOR EDIT MATH & "CTLWRD" FOR LP MATH /A019 SETCTL, XX TAD MTHTYP /GET THE MATH MODE FLAG /A019 SNA CLA /IS IT EDITOR MATH THAT'S WANTED? /A019 TAD (3 / NO: GET THE OFFSET IF LP MATH /A019 DCA OFFSET / YES: PATCH IT TO USE IN MATH PROCESSING /A019 TAD MTHTYP /GET THE MATH MODE FLAG BACK /A019 SZA CLA /IS IT LP MATH THAT'S WANTED? /A019 TAD (EDTCTL-CTLWRD / NO: SET SYM TBL ENTRY FOR EDITOR MATH /A019 TAD (CTLWRD / YES: " " " " " LP " /A019 DCA SYMSTR /PATCH IT TO USE IN MATH PROCESSING /A019 TAD MTHTYP /GET THE MATH MODE FLAG /A019 SNA /IS IT EDIT MATH THAT IS WANTED? /A019 JMP I SETCTL / NO: JUST RETURN TO CALLER /A019 CDFLP / YES: SET DATA FIELD TO LP /A019 DCA I (INCTLB /INIT "IN CONTROL BLOCK" FLAG TO FALSE /A019 CDFMYF /RESET DATA FIELD TO MATH /A019 AC0001 /GET 1 IN THE AC /A020 DCA MTHWRK /SET "IN MATH WORK AREA" = FALSE /A020 AC0001 /GET 1 IN THE AC /A020 DCA MTHSND /SET "PROCESSING SECOND LINE" = FALSE /A020 DCA MTHTOT /SET "MATH TOTAL REQUIRED" = FALSE /A020 CIFLP /CHANGE PROGRAM CONTROL TO LP FIELD /M029 JMS ZROTBL /GO INIT "DCHAR" & "TCHAR" TABLES /A020 JMP I SETCTL /RETURN TO CALLER /A019 /MOVED HERE ON EDIT 041 /ROUTINE TO MAKE CDI INSTRUCTION TO CALLING FIELD AND PUT IN AC /A006 GETFLD, XX /A006 CLA /CLEAR AC /A006 RDF /GET DATA FIELD BITS FROM WHICH CALL WAS MADE /A006 TAD CIDF0 /ADD TO IT THE CDF,CIF OCTAL CODE VALUE /A006 CDFMTH /CHANGE THE DATA FIELD REGISTER TO MATH FIELD /A006 JMP I GETFLD /RETURN TO CALLER ON THIS PAGE /A006 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /PERMANENT SYMBOL TABLES - CONTAINS THE CONTROL WORDS WHICH MAY BE A PART /OF THE LIST PROCESSING AND/OR EDITOR MATH CONTROL BLOCK. /USED TO ANALYZE THE CONTENTS OF THE MATH CONTROL BLOCK IN LP & EDITOR MATH WPSMTH, IFDEF ENGLSH< /A045 "W-200 / W "P-200 / P "S-200 / S "M-200 / M "A-200 / A "T-200 / T "H-200+4000 / H+4000 > /A045 /A045 IFDEF DUTCH< /A047 "R-200 / W "E-200 / P "K-200 / S "E-200 / M "N-200 / A "E-200 / T "N-200+4000 / H+4000 > /A047 /A047 IFDEF ITALIAN< /A045 "W-200 / W /A045 "P-200 / P /A045 "S-200 / S /A045 "M-200 / M /A045 "A-200 / A /A045 "T-200+4000 / T+4000 /A045 > /A045 IFDEF SPANISH< /A046 "W-200 / W /A046 "P-200 / P /A046 "S-200 / S /A046 "M-200 / M /A046 "A-200 / A /A046 "T-200+4000 / T+4000 /A046 > /A046 IFDEF V30NOR< /A047 "R-200 / R /A047 "E-200 / E /A047 "G-200 / G /A047 "N-200 / N /A047 "I-200 / I /A047 "N-200 / N /A047 "G-200+4000 / G+4000 /A047 > /A047 IFDEF V30SWE< /A047 "W-200 / W /A047 "P-200 / P /A047 "S-200 / S /A047 "M-200 / M /A047 "A-200 / A /A047 "T-200+4000 / T+4000 /A047 / THE LAST BIT LOPPED OFF AS IT OVERFLOWS THE WRKBUF IN MATH. /A047 /D047 "E-200 / E /A047 / " "M-200 / M /A047 / " "A-200 / A /A047 / " "T-200 / T /A047 / " "I-200 / I /A047 /D047 "K-200+4000 / K+4000 /A047 > /A047 0 / NULL = END OF SYMBOL TABLE /START OF EDITOR MATH CONTROL BLOCK CONTROL WORDS /A005 EDTCTL, IFDEF ENGLSH< /a045 "B-200 / B /A005 "E-200 / E /A005 "G-200 / G /A005 "I-200 / I /A005 "N-200+4000 / N+4000 /A005 > /A045 IFDEF DUTCH< /a047 "B-200 / B /A047 "E-200 / E /A047 "G-200 / G /A047 "I-200 / I /A047 "N-200+4000 / N+4000 /A047 > /A047 IFDEF ITALIAN< /a045 "I-200 / I /A045 "N-200 / N /A045 "I-200 / I /A045 "Z-200 / Z /A045 "I-200 / I /A045 "O-200+4000 / O+4000 /A045 > /A045 IFDEF SPANISH< /a046 "E-200 / E /A046 "M-200 / M /A046 "P-200 / P /A046 "E-200 / E /A046 "Z-200 / Z /A046 "A-200 / A /A046 "R-200+4000 / R+4000 /A046 > /A046 IFDEF V30NOR< /a047 "B-200 / B /A047 "E-200 / E /A047 "G-200 / G /A047 "Y-200 / Y /A047 "N-200 / N /A047 "N-200+4000 / N+4000 /A047 > /A047 IFDEF V30SWE< /a047 "B-200 / B /A047 "V-200 / V /A047 "R-200 / R /A047 "J-200 / J /A047 "A-200+4000 / A+4000 /A047 > /A047 IFDEF ENGLSH< /A045 "E-200 / E /A005 "N-200 / N /A005 "D-200+4000 / D+4000 /A005 > /A045 IFDEF DUTCH< /A047 "E-200 / E /A047 "I-200 / E /A047 "N-200 / E /A047 "D-200 / N /A047 "E-200+4000 / D+4000 /A047 > /A047 IFDEF ITALIAN< /A045 "F-200 / F /A045 "I-200 / I /A045 "N-200 / N /A045 "E-200+4000 / E+4000 /A045 > /A045 IFDEF SPANISH< /A046 "F-200 / F /A046 "I-200 / I /A046 "N-200+4000 / N+4000 /A046 > /A046 IFDEF V30NOR< /A047 "S-200 / S /A047 "L-200 / L /A047 "U-200 / U /A047 "T-200 / T /A047 "T-200+4000 / T+4000 /A047 > /A047 IFDEF V30SWE< /A047 "S-200 / S /A047 "L-200 / L /A047 "U-200 / U /A047 "T-200+4000 / T+4000 /A047 > /A047 IFDEF ENGLSH< /A045 "T-200 / T /A005 "O-200 / O /A005 "T-200 / T /A005 "A-200 / A /A005 "L-200+4000 / L+4OOO /A005 > IFDEF DUTCH< /A047 "T-200 / T /A047 "O-200 / O /A047 "T-200 / T /A047 "A-200 / A /A047 "A-200 / A /A047 "L-200+4000 / L+4OOO /A047 > IFDEF ITALIAN< /a045 "T-200 / T /A045 "O-200 / O /A045 "T-200 / T /A045 "A-200 / A /A045 "L-200 / L /A045 "E-200+4000 / E+4000 /A045 > /A045 IFDEF SPANISH< /a046 "T-200 / T /A046 "O-200 / O /A046 "T-200 / T /A046 "A-200 / A /A046 "L-200+4000 / L+4000 /A046 > /A046 IFDEF V30NOR< /a047 "S-200 / S /A047 "U-200 / U /A047 "M-200+4000 / M+4000 /A047 > /A047 IFDEF V30SWE< /a047 "T-200 / T /A047 "O-200 / O /A047 "T-200 / T /A047 "A-200 / A /A047 "L-200 / L /A047 "T-200+4000 / T+4000 /A047 > /A047 /START OF LP MATH CONTROL BLOCK CONTROL WORDS CTLWRD, IFDEF ENGLSH< /A045 "F-200 / F "O-200 / O "R-200 / R "M-200 / M "U-200 / U "L-200 / L "A-200+4000 / A+4000 > /A045 IFDEF DUTCH< /A047 "F-200 / F "O-200 / O "R-200 / R "M-200 / M "U-200 / U "L-200 / L "E-200+4000 / A+4000 > /A047 IFDEF ITALIAN< /A045 "F-200 / F /A045 "O-200 / O /A045 "R-200 / R /A045 "M-200 / M /A045 "U-200 / U /A045 "L-200 / L /A045 "A-200+4000 / A+4000 /A045 > /A045 IFDEF SPANISH< /A046 "F-200 / F /A046 "O-200 / O /A046 "R-200 / R /A046 "M-200 / M /A046 "U-200 / U /A046 "L-200 / L /A046 "A-200+4000 / A+4000 /A046 > /A046 IFDEF V30NOR< /A047 "F-200 / F /A047 "O-200 / O /A047 "R-200 / R /A047 "M-200 / M /A047 "E-200 / E /A047 "L-200+4000 / L+4000 /A047 > /A047 IFDEF V30SWE< /A047 "F-200 / F /A047 "O-200 / O /A047 "R-200 / R /A047 "M-200 / M /A047 "E-200 / E /A047 "L-200+4000 / L+4000 /A047 > /A047 IFDEF ENGLSH< /A045 "R-200 / R "O-200 / O "U-200 / U "N-200 / N "D-200+4000 / D+4000 > IFDEF DUTCH< /A047 "A-200 / R "F-200 / R "R-200 / R "O-200 / O "N-200 / N "D-200 / N "E-200 / N "N-200+4000 / D+4000 > IFDEF ITALIAN< /A045 "A-200 / A /A045 "R-200 / R /A045 "R-200 / R /A045 "O-200 / O /A045 "T-200 / T /A045 "O-200 / O /A045 "N-200 / N /A045 "D-200 / D /A045 "A-200+4000 / A+4000 /A045 > /A045 IFDEF SPANISH< /A046 "R-200 / R /A046 "E-200 / E /A046 "D-200 / D /A046 "O-200 / O /A046 "N-200 / N /A046 "D-200 / D /A046 "E-200 / E /A046 "A-200 / A /A046 "R-200+4000 / R+4000 /A046 > /A046 IFDEF V30NOR< /A047 "A-200 / A /A047 "V-200 / V /A047 "R-200 / R /A047 "U-200 / U /A047 "N-200 / N /A047 "D-200+4000 / D+4000 /A047 > /A047 IFDEF V30SWE< /A047 "R-200 / R /A047 "U-200 / U /A047 "N-200 / N /A047 "T-200+4000 / T+4000 /A047 > /A047 IFDEF ENGLSH< /A045 "T-200 / T "R-200 / R "U-200 / U "N-200 / N "C-200 / C "A-200 / A "T-200 / T "E-200+4000 / E+4000 > /A045 IFDEF DUTCH< /A047 "K-200 / T "A-200 / R "P-200+4000 / E+4000 > /A047 IFDEF ITALIAN< /A045 "T-200 / T /A045 "R-200 / R /A045 "O-200 / O /A045 "N-200 / N /A045 "C-200 / C /A045 "A-200+4000 / A+4000 /A045 > /A045 IFDEF SPANISH< /A046 "T-200 / T /A046 "R-200 / R /A046 "U-200 / U /A046 "N-200 / N /A046 "C-200 / C /A046 "A-200 / A /A046 "R-200+4000 / R+4000 /A046 > /A046 IFDEF V30NOR< /A047 "K-200 / K /A047 "U-200 / U /A047 "T-200 / T /A047 "T-200+4000 / T+4000 /A047 > /A047 IFDEF V30SWE< /A047 "T-200 / T /A047 "R-200 / R /A047 "U-200 / U /A047 "N-200 / N /A047 "K-200 / K /A047 "E-200 / E /A047 "R-200 / R /A047 "A-200+4000 / A+4000 /A047 > /A047 IFDEF ENGLSH< /A045 "S-200 / S "E-200 / E "T-200+4000 / T+4000 > /A045 IFDEF DUTCH< /A047 "S-200 / S "T-200 / E "E-200 / E "L-200+4000 / T+4000 > /A047 IFDEF ITALIAN< /A045 "P-200 / P /A045 "O-200 / O /A045 "N-200 / N /A045 "I-200+4000 / I+4000 /A045 > /A045 IFDEF SPANISH< /A046 "P-200 / P /A046 "O-200 / O /A046 "N-200 / N /A046 "E-200 / E /A046 "R-200+4000 / R+4000 /A046 > /A046 IFDEF V30NOR< /A047 "S-200 / S /A047 "E-200 / E /A047 "T-200 / T /A047 "T-200+4000 / T+4000 /A047 > /A047 IFDEF V30SWE< /A047 "S-200 / S /A047 "T-200 / T /A047 "O-200 / O /A047 "L-200 / L /A047 "L-200 / L /A047 "_-200 / (underline) /A047 "I-200 / I /A047 "N-200+4000 / N+4000 /A047 > /A047 0 / NULL = END OF SYMBOL TABLE /THIS TABLE HOLDS NEGATIVE ASCII VALUES OF OPTRS FOR MATCHUP WHENEVER AN OPTR /TKN IS PASSED TO "XLTFRM" (TRANSLATOR) FROM LEXIC (SCANNER) VIA TOKVAL. /THE TBL INCLUDES PRECEDENCE OF OPTR TYPE, & ADDR OF EXECUTION ROUTINE THAT /WILL PERFORM (ON THE OUTPUT LIST) REQUIRED FUNCTIONALITY OF THAT OPERATOR. ADDVAL, -"++200;4;ADD /TWO'S COMPLIMENT OF ADDITION OPERATOR /PLUS PRECEDENCE /PLUS ADDRESS OF ROUTINE EXECUTING THIS FUNCTION SUBVAL, -"-+200;4;SUB / " " " SUBTRACTION OPERATOR / " " " / " " " MLTVAL, -"*+200;5;MUL / " " " MULTIPLICATION OPERATOR / " " " / " " " DIVVAL, -"/+200;5;DIV / " " " DIVISION OPERATOR / " " " / " " " EQLVAL, -"=+200;1;EQUATE / " " " EQUALS (OR ASSIGN) OPERATOR / " " " / " " " LTPVAL, -"(+200;2;0000 / " " " LEFT PARENTHESIS OPERATOR / " " " / PLACE ZERO HERE AS FILLER - NO LEFT PAREN RTN RTPVAL, -")+200;2;0000 / " " " RIGHT PARENTHESIS OPERATOR / " " " / PLACE ZERO HERE AS FILLER - NO RIGHT PAREN RTN UNYMNS, -"-+7000+200;6;MINUS/ " " " UNARY MINUS OPERATOR / " " " / " " " UNYPLS, -"++7000+200;6;0000 / " " " UNARY PLUS OPERATOR / " " " / " " " /"RUNCHK" IS CALLED FROM "RTRN3A". IT DETERMINES IF IN EDIT MATH, IF IN /A010 /EDITOR MATH WORK AREA, AND ACTS ACCORDINGLY. THIS RTN IS A KIND OF /A010 /CRUNCH JOB BECAUSE OF LACK OF SPACE AND TO SAVE ON EXECUTION TIME /A010 /WHILE IN THE EDITOR. RUNCHK, XX /A010 TAD MTHTYP /GET "MATH MODE" FLAG /A010 SNA CLA /ARE WE IN EDIT MATH MODE? /A010 JMP I RUNCHK / NO: JUST RETURN TO PROCESS CTRL WORD /A010 TAD MTHWRK / YES: GET "EDIT MATH WORK AREA" FLAG /A010 SNA CLA /ARE WE IN EDIT MATH WORK AREA? /M031 JMP I RUNCHK / YES: RETURN TO PROCESS CTRL WORD /A010 CDFLP / NO: CHANGE TO LP DATA FIELD /A010 AC0001 /GET 1 IN THE AC /A035 DCA MTHSND /SET "NOT MATH CTRL BLOCK SECOND LINE" = TRUE /A035 /TAKE TIME HERE TO MAKE SURE THAT THE 2ND LINE /A035 /FLAG IS SET TO SAY NOT PROCESSING THAT LINE /A035 /ANYMORE. DONE IN CASE 1ST WORD IN BLOCK WAS /A035 /"WPSMATH" & 2ND WORD (WHICH ENDS UP HERE IF /A035 /A VALID COMMAND BUT NOT "BEGIN") HAS CLEARED /A035 /THE FLAG TO SAY PROCESSING SECOND LINE /A035 /D031 DCA I (INCTLB /SET "IN CONTROL BLOCK" FLAG = FALSE /A010 DCA I (MTHCTL /SET "IN MATH CTRL BLOCK" FLAG = FALSE /A031 /D035 TAD I (CKCTRL /GET "CKCTRL" RTRN ADDR BACK TO EDIT CODE /A010 /D035 DCA RUNCHK /SET IT UP TO RTRN THRU BACK TO THE EDITOR /A010 CDILP /CHANGE PROGRAM CONTROL BACK TO LP FIELD /A010 /D035 JMP I RUNCHK /RETURN TO EDIT CODE /A010 JMP RTNMTH /THERE WAS A MAJOR BUG HERE SINCE THE CODE /A035 /CHANGE TO REFLECT SAVING AND RESTORING "CURPTR"/A035 /IN "CKCTRL" AND "EXTRACTNUMBER" FOR EDITOR MATH/A035 /ALLOWED A JMP INDIRECT THRU "RUNCHK" BACK /A035 /TO THE EDITOR TO NOW, AMONG OTHER THINGS, BLOW /A035 /THE LINE AFTER THE BLOCK RIGHT OUT OF THE WATER/A035 /UNDER THE RIGHT CONDITIONS BECAUSE A CALL WAS /A035 /NOT ADDED TO RESET "CURPTR" HERE WHEN THE CODE /A035 /WAS CHANGED EVERYWHERE ELSE! THIS FIX /A035 /TAKES THE ABOVE INTO ACCOUNT. /A035 /POPSTK, MOVED TO LEXASC TO CREATE ENOUGH ROOM FOR THE ITALIAN /A045 /TRANSLATIONS ABOVE. /A045 /SYMTSZ, MOVED TO ANOTHER PAGE FOR SPACE REASONS /D041 /D041 /SUBRTN TO INIT RESULT PTR TBL PTR, & 1ST LOC OF RES PTR TBL /M012 /D041 ITLZOL, XX /RESULT PTR TBL & RESULTS PTR INIT SUB RTN /M012 /D041 CLA /CLEAR AC /D041 TAD (RESULT /GET STARTING ADDRESS OF RESULT PTR TABLE /D041 DCA RESPTR /INITIALIZE PTR TO RESULT PTR TABLE /D041 DCA I RESPTR /INIT 1ST LOC OF RESULT PTR TABLE TO ZERO /D041 JMP I ITLZOL /RETURN TO CALLER /A012 /D041 /SUBRTN USED TO INSTALL SETUP VALUES IN BEGINNING LOCATIONS OF OUTPUT /D041 /LIST TO ENABLE OUTPUT LIST TO BE USED BY FORMULA EXECUTION CODE AS A /D041 /CALLABLE ROUTINE. /D041 ITLZO1, XX /PUT VALUES IN OUTPUT LIST /D041 TAD (INIT /GET JMP INDIRECT COMMAND TO HANDLE OUTPUT LIST /A004 /D041 JMS OUTTSZ /SAVE IT, INCREMENT PTR & TEST FOR OVERFLOW /A004 /D041 /PLACE "(JMP I OUTEXT" AT END OF OUTPUT LIST TO EXECUTE AS A ROUTINE /D041 TAD (JMP I OUTEXT /GET JMP I OUTEXT /D041 DCA I OUTPTR /PUT AT END OF OUTPUT LIST FOR USE BY EXECUTION CODE. /D041 JMP I ITLZO1 /RETURN TO CALLER /D041/SUBRTNS TO PERFORM TRANSLATOR INITIALIZATION PROCESS & /D041/INITIALIZE APPROPRIATE FLAGS /D041 ITLZO2, XX /TRANSLATOR INITIALIZATION SUBROUTINE /M012 /D041 TAD (MTHTBL /GET STARTING ADDRESS OF SYMBOL PTR TABLE /D041 DCA MTHPTR /INITIALIZE PTR TO SYMBOL PTR TABLE /D041 TAD (SYMTBL /GET STARTING ADDRESS OF SYMBOL TABLE /D041 DCA SYMPTR /INITIALIZE PTR TO SYMBOL TABLE /D041 JMP I ITLZO2 /RETURN TO CALLER ITLZO3, XX /TRANSLATOR INITIALIZATION SUBROUTINE /A012 / CLA /CLEAR AC /A012 DCA TRUNC /INITIALIZE TRUNCATION/ROUND FLAG = ROUND DCA MTHBLK /INITIALIZE "FORMULA CTRL WORD NOT FOUND" FLAG = TRUE TAD (OUTLST /GET LEAD ADDRESS OF OUTPUT LIST DCA OUTPTR /USE IT TO INIT OUTPUT LIST POINTER TAD (OUTLST /GET LEAD ADDRESS OF OUTPUT LIST DCA OUTENT /INIT FORMULA EXECUTION CODE ENTRY POINT /D041 JMS ITLZO1 /INIT LEAD LOCS OF OUTPUT LST TO SET UP AS SUBRTN TAD (INIT /GET JMP INDIRECT COMMAND TO HANDLE OUTPUT LIST /A041 JMS OUTTSZ /SAVE IT, INCREMENT PTR & TEST FOR OVERFLOW /A041 /PLACE "(JMP I OUTEXT" AT END OF OUTPUT LIST TO EXECUTE AS A ROUTINE TAD (JMP I OUTEXT /GET JMP I OUTEXT AND PUT AT END OF /A041 DCA I OUTPTR /OUTPUT LIST FOR USE BY EXECUTION CODE. /A041 TAD (OUTLST+1 /GET START ADDR OF OUTPUT LST + 1 TO SKIP "INIT"/A041 /VAL PUT AT START OF OUTPUT LIST FOR EXEC CODE /A041 DCA OUTPTR /INITIALIZE PTR TO OUTPUT LIST /A041 JMP I ITLZO3 /RETURN TO CALLER /A012 /D041 /SUBRTN TO INIT OUTPUT LIST PTR /A012 /D041 ITLZO4, XX /TRANSLATOR INIT SUBRTN /A012 /D041 TAD (OUTLST+1 /GET START ADDR OF OUTPUT LST + 1 TO SKIP "INIT"/A004 /D041 /VAL PUT AT START OF OUTPUT LIST FOR EXEC CODE /A004 /D041 DCA OUTPTR /INITIALIZE PTR TO OUTPUT LIST /D041 JMP I ITLZO4 /RETURN TO CALLER /A012 /WRKBUF, MOVED TO TMATH.PA TO MAKE ROOM FOR SYMBOL TABLE /A041 MAXWRK=12 /DEFINE LENGTH OF WORK BUFFER FOR Z-BLOCK /A041 WRKBUF, ZBLOCK MAXWRK /START ADDR OF CONTROL WORD WORK BUFFER /A041 UPWRK=. /UPPER LIMIT OF " " " " /A041 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE /THIS ROUTINE CALLED AS AN INDIRECT THRU "HLDVAL" /ROUTINE TO PROCESS THE "FORMULA" CONTROL WORD FOUND IN A MATH CONTROL BLOCK MTHBLK, 0 /"FORMULA CONTROL WORD NOT FOUND" FLAG, KEEP ON SAME /PAGE WITH "FRMULA" ROUTINE FRMULA, XX /RTN TO HANDLE "FORMULA" CONTROL WORD TAD MTHBLK /GET "FORMULA CONTROL WORD NOT FOUND" FLAG SNA CLA /IS "FORMULA CONTROL WORD NOT FOUND" = TRUE? JMP FORM1 / YES: GO INITIALIZE TRANSLATOR DATA STRUCTURES JMP FORM2 / NO: BYPASS INITIALIZATION & SET FLAG PROCESS FORM1, ISZ MTHBLK /SET FORMULA CONTROL WORD NOT FOUND = FALSE /D041 JMS ITLZO4 /GO INITIALIZE OUTPUT LIST PTR /M012 TAD (OUTLST+1 /GET START ADDR OF OUTPUT LST + 1 TO SKIP "INIT"/A041 /VAL PUT AT START OF OUTPUT LIST FOR EXEC CODE /A041 DCA OUTPTR /INITIALIZE PTR TO OUTPUT LIST /A041 FORM2, AC0001 /SET UP TO INDICATE A FORMULA COMMAND /A039 DCA SETFLG /STORE IN FORMAT FLAG WORD /A039 JMS XLTFRM /CALL TRANSLATOR TO CONVERT FORMULA /NOTE: RETURN HERE WITH ERROR NUMBER IN THE AC IF THERE IS AN ERROR /IN THE MATH TRANSLATION PROCESSING JMP I FRMULA /RETURN HERE WITH ERROR NO. IN THE AC /NOTE: RETURN HERE IF PROCESSING WENT ALL RIGHT AC0001 /GET 1 INTO THE AC /A037 DCA MTHSND /SET "NOT PROCESSING SECOND LINE" = TRUE /A037 ISZ FRMULA /INCREMENT AC FOR NORMAL RETURN JMP I FRMULA /RETURN TO CALLER /THIS ROUTINE USED TO HANDLE A "SET" CONTROL WORD IN MATH CONTROL BLOCK SETCMD, XX /RTN TO HANDLE "SET" CONTROL WORD /M042 TAD OUTPTR /GET PRESENT POSITION OF OUTPUT LIST PTR DCA OUTENT /INIT FORMULA EXECUTION CODE ENTRY POINT DCA SETFLG /CLEAR FORMAT FLAG WORD TO INDICATE SET COMMAND /A039 /D041 JMS ITLZO1 /PUT LEAD VALUES INTO OUTPUT LIST FOR EXECUTION TAD (INIT /GET JMP INDIRECT COMMAND TO HANDLE OUTPUT LIST /A041 JMS OUTTSZ /SAVE IT, INCREMENT PTR & TEST FOR OVERFLOW /A041 /PLACE "(JMP I OUTEXT" AT END OF OUTPUT LIST TO EXECUTE AS A ROUTINE TAD (JMP I OUTEXT /GET JMP I OUTEXT AND PUT AT END OF /A041 DCA I OUTPTR /OUTPUT LIST FOR USE BY EXECUTION CODE. /A041 JMS XLTFRM /GO TRANSLATE FORMULA /NOTE: RETURN HERE WITH ERROR NUMBER IN THE AC IF THERE IS AN ERROR /IN THE MATH TRANSLATION PROCESSING JMP I SETCMD /RETURN HERE WITH ERROR NO. IN THE AC /M042 /NOTE: RETURN HERE IF PROCESSING WENT ALL RIGHT /GO INVOKE THE FORMULA EXECUTION CODE FOR THE "SET" CONTROL WORD JMS EXECUT /GO EXECUTE THE FORMULA TRANSLATED SZA /WAS AN ERROR RETURNED FROM THE EXECUTION CODE? JMP I SETCMD / YES: RETURN TO CALLER WITH ERROR NUMBER IN AC /M042 TAD OUTENT /GET ORIGINAL POSITION OF OUTPUT LIST PTR DCA OUTPTR /RESTORE IT NOW THAT THRU PROCESSING "SET" CTRL WORD /RESTORE "(JMP I OUTEXT" TO END OF LIST WHEN THRU WITH "SET" CTRL WORD TAD (JMP I OUTEXT /GET JMP I OUTEXT DCA I OUTPTR /SAVE IT AT END OF OUTPUT LIST BEFORE "SET" CTRL WORD /RESTORE FORMULA EXECUTION CODE ENTRY POINT TO START OF OUTPUT LIST TAD (OUTLST /GET START OF OUTPUT LIST DCA OUTENT /RESTORE FORMULA EXECUTION CODE ENTRY TO START OF LIST AC0001 /GET 1 INTO THE AC /A037 DCA MTHSND /SET "NOT PROCESSING SECOND LINE" = TRUE /A037 ISZ SETCMD /INCREMENT P.C. FOR NORMAL RETURN /M042 JMP I SETCMD /RETURN TO CALLER /M042 /THIS ROUTINE CALLED AS AN INDIRECT THRU "HLDVAL" /THIS ROUTINE USED TO HANDLE A "ROUND" CONTROL WORD IN MATH CONTROL BLOCK ROUND, XX /RTN TO HANDLE "ROUND" CONTROL WORD JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS.... /....AND RIGHT AFTER CONTROL WORD JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN /A011 /AC TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A011 AC0000 /RETURN HERE FROM "CHKLNE" IF OK - SET AC TO ZERO DCA TRUNC /SET "TRUNCATE" FLAG = FALSE AC0001 /GET 1 INTO THE AC /A037 DCA MTHSND /SET "NOT PROCESSING SECOND LINE" = TRUE /A037 ISZ ROUND /SET P.C. FOR NORMAL RETURN JMP I ROUND /RETURN TO CALLER /THIS ROUTINE CALLED AS AN INDIRECT THRU "HLDVAL" /THIS ROUTINE USED TO HANDLE "TRUNCATE" CONTROL WORD IN MATH CONTROL BLOCK TRNCTE, XX /RTN TO HANDLE ":TRUNCATE" CONTROL WORD JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS.... /....AND RIGHT AFTER CONTROL WORD JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN /A011 /AC TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A011 AC0001 /RETURN HERE FROM "CHKLNE" IF OK - SET AC TO 1 DCA TRUNC /SET "TRUNCATE" FLAG = TRUE AC0001 /GET 1 INTO THE AC /A037 DCA MTHSND /SET "NOT PROCESSING SECOND LINE" = TRUE /A037 ISZ TRNCTE /SET P.C. FOR NORMAL RETURN JMP I TRNCTE /RETURN TO CALLER /ROUTINE TO HANDLE "END" CONTROL WORD IN EDITOR MATH CONTROL BLOCK /A020 /MOVED IN FROM ANOTHER PAGE /A027 END, XX JMS CHKLNE /CHK FOR NON-ALLOWABLE CHARS ON SAME LINE AS... /A024 /....AND RIGHT AFTER CONTROL WORD /A024 JMP ERRBCK /RETURN HERE FROM "CHKLNE" WITH ERROR NUM IN AC /A026 /.. TO PASS BACK IF NON-LEGAL CHARS FOUND ON LNE/A026 TAD MTHSND /GET MATH CONTROL BLOCK "SECOND LINE" FLAG /A020 SZA CLA /ARE WE PROCESSING THE SECOND LINE? /A020 JMP ERROR5 / NO: REPORT ERROR - "END" ON WRONG LINE /A020 /D036 AC0001 / YES: GET 1 IN THE AC /A020 /D036 DCA MTHWRK /SET "START OF MATH WORK AREA" = FALSE /A020 AC7777 /GET -1 IN THE AC /A020 DCA MTHSND /SET "SECOND LINE" FLAG = "END" CTRL FOUND /A020 /D034 SETTING THIS FLAG WILL CAUSE THE MATH_END CODE TO BE INSERTED /A027 /D034 AFTER THE NEXT END_CONTROL /A027 /D034 CDFLP / FLAG IS IN LPFIELD /A027 /D034 AC0001 / /A027 /D034 DCA I (ENDFL) / SET FLAG /A027 ISZ END /SET UP SKIP FOR NORMAL RETURN /A020 JMP I END /RETURN TO CALLER /A020 ERROR5, TAD (EVSYN5 /RTRN "END" CTRL WORD ON WRONG LINE ERROR /M024 JMP I END /RETURN TO CALLER WITH ERROR NUMBER IN AC /A021 /THE FOLLOWING ROUTINE IS CALLED FROM OPDNUM TO CHECK IF THE CURRENT /A040 /NUMBER FROM LEXIC IS ALREADY IN THE SYMBOL TABLE. IF IT IS, WE DO /A040 /NOT WANT TO ADD ANOTHER COPY OF THE SAME NUMBER TO THE TABLE. /A040 / ENTER WITH AC CLEAR AND TOKVAL POINTING TO START OF NUMBER /A040 / RETURN TO CALLER IF NUMBER IS NOT IN SYMBOL TABLE /A040 / OTHERWISE, SET UP CORRECT POINTERS AND RETURN TO FLGFIX /A040 CHKNUM, XX /CHECK IF NUMBER IS IN SYMBOL TABLE /A040 TAD (SYMTBL /GET START OF SYMBOL TABLE ADDRESS /A040 DCA NUMPTR /SET UP POINTER TO POSSIBLE NUMBER LOCATION /A040 /CHECK TO SEE IF WE HAVE REACHED THE END OF THE SYMBOL TABLE YET /A040 CHKEND, TAD NUMPTR /GET CURRENT POINTER WITHIN SYMBOL TABLE /A040 CIA /MAKE IT NEGATIVE /A040 TAD SYMPTR /COMBINE WITH LAST USED LOCATION OF TABLE /A040 SPA SNA CLA /WAS NUMBER IN TABLE (HAVE WE REACHED THE END) /A040 JMP I CHKNUM /IT WASN'T, RETURN TO ADD IT TO SYMBOL TABLE /A040 /ARE WE POINTING TO A SYMBOL - ALL SYMBOLS START WITH A COLON CHARACTER /A040 TAD I NUMPTR /GET CURRENT CHARACTER POINTED TO /A040 TAD (200-": /SUBTRACT VALUE OF COLON FROM CHARACTER /A040 SZA CLA /IS IT A COLON /A040 JMP CHKVAL /NO: GO CHECK FOR NUMBER VALUE /A040 /SKIP OVER SYMBOL NAME IN TABLE /A040 CHKSYM, ISZ NUMPTR /BUMP POINTER TO NEXT LOCATION /A040 TAD I NUMPTR /GET CURRENT CHARACTER POINTER TO /A040 SMA CLA /IS IT THE LAST ONE OF THE SYMBOL NAME /A040 JMP CHKSYM /NO: GO CHECK THE NEXT ONE /A040 /SKIP OVER SYMBOL VALUE IN TABLE /A040 AC0002 /SET UP TO SKIP OVER LAST CHARACTER & FORMAT /A040 CHKNOT, TAD (VALSIZ /NUMBER OF CHARACTERS IN NUMBER VALUE /A040 TAD NUMPTR /COMBINE WITH CURRENT POINTER INTO SYM TABLE /A040 DCA NUMPTR /STORE POINTER TO NEXT TABLE ENTRY POINT /A040 JMP CHKEND /GO CHECK TO SEE IF THERE ARE ANY MORE ENTRIES /A040 /CHECK FOR NUMBER MATCH IN SYMBOL TABLE /A040 CHKVAL, TAD NUMPTR /GET POINTER TO NUMBER /A040 DCA TMPTR1 /SET UP TEMPORARY POINTER TO NUMBER /A040 TAD (TOKVAL /STARTING ADDRESS OF PASSED NUMERICAL OPERAND /A040 DCA TMPTR2 /SET UP POINTER TO NUMBER VALUE /A040 TAD (-VALSIZ /GET NEGATIVE NUMBER OF CHARACTERS TO CHECK /A040 DCA TMPCTR /SET UP COUNTER OF DIGITS TO CHECK /A040 CHKMOR, TAD I TMPTR1 /GET VALUE WORD FROM SYMBOL TABLE /A040 CIA /MAKE IT NEGATIVE /A040 TAD I TMPTR2 /COMBINE WITH VALUE WORD FROM LEXIC /A040 SZA CLA /DO THEY MATCH /A040 JMP CHKNOT /NO: GO UP THE POINTERS TO NEXT ENTRY /A040 ISZ TMPTR1 /BUMP SYMBOL TABLE POINTER /A040 ISZ TMPTR2 /BUMP LEXIC POINTER /A040 ISZ TMPCTR /BUMP COUNTER OF DIGITS LEFT TO DO /A040 JMP CHKMOR /NOT DONE, GO CHECK NEXT VALUE WORD /A040 /MATCH FOUND - NUMBER IS ALREADY IN THE SYMBOL TABLE LIST /A040 /PUT INPUT NUMBER ADDRESS AND "PUSH" RETURN ADDRESS INTO OUTPUT LIST /A040 TAD NUMPTR /GET ADDRESS OF INPUT OPERAND FROM SYMBOL TABLE /A041 JMS PSHLST /SAVE IT ON OUTPUT LIST /A041 JMP FLGFIX /GO SET FLAGS & EXIT OPERAND/OPERATOR ROUTINE /A041 /D041 TAD (PUSH /GET STARTING ADDRESS OF OUTPUT "PUSH" ROUTINE /A040 /D041 JMS OUTTSZ /SAVE IT, INCREMENT LST PTR & TEST FOR OVFLOW /A040 /D041 TAD NUMPTR /GET ADDRESS OF INPUT OPERAND FROM SYMBOL TABLE /A040 /D041 JMS OUTTSZ /SAVE IT, INCREMENT LST PTR & TEST FOR OVFLOW /A040 /D041 JMP FLGFIX /GO SET FLAGS & EXIT OPERAND/OPERATOR ROUTINE /A040 NUMPTR, 0 /PLACE TO SAVE START OF NUMBER IN SYMBOL TABLE /A040 X=. / INDICATE FIRST FREE LOCATION /A041 / ------------------ PAGE   / MNHELP - HELP MENU OVERLAYS / 014 EMcD 13-Jul-84 Remove ref to Documentation / 013 EJL 16-OCT-84 Changed upper cased words to use !& / redesign ifdefs for HELPxx section / Broke case table into two parts / ( increased help menu by 1 block ) / added help for g:tab, g:tab pos / alt char, udk / 012 EJL 11-SEP-84 Changed text msg for gold srch / 011 WCE 07-AUG-84 FIX "GOLD GOLD SPACE" PROBLEM / 010 WJY 13-FEB-84 DECmate I compatability / THIS FILE CONTAINS THE THIRD PART OF THE MENU ASSEMBLY - THAT PART / WITH THE HELP MENUS CALLED IN BY THE EDITOR PROGRAM. / / CARE SHOULD BE TAKEN THAT MENUS IN THIS FILE DON'T CALL MENUS CONTAINED / IN ANY OTHER PART - WITH THE EXCEPTION OF THE MAIN MENU USING ENTRY 'MM1S'. / / HELP EDIT MENU***** / An attempt was made by the programmer to put 2 commands into / each block without splitting commands between pages. / Although not completely successful most blocks contain 2 commands / per page, and some commands cross block boundaries. / MODULE NAMES ARE HLaaa HL = Gold Commands / HMaaa HM = Editing Commands / / The dispatch table must be in order of the first Help Menu. / and case statement conditionals are contained in WTHLP1. / / An attempt was made to come up with some labeling conventions. / For the most part this also was done.. / labels use / CMKXXY WHERE XX=BLOCK NUMBER CONTAINED IN(DLHLXX) / Y= NUMBER OF CONSTANT WITHIN BLK. / CM= COMMON LABEL / other conventions tried to use throughout(?) / KMCxxy = KMC block common constant / xx block number constant contained in / KNzzzy = KN common to command / zzz abbreviated command name / / HOPE THESE COMMENTS ARE HELPFUL / HELP EDIT MENU RELOC FIELD 1 / BEGIN ASSEMBLING MENU'S IN FIELD ONE *0 RELOC ADHLP0=. X=DLHLP0 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HELP00, DISP;0;TEXT '!E--!&HELP !&MENU--' DISP;0117;TEXT '&GOLD &KEY &FUNCTIONS' DISP;0163;TEXT '&EDITING &KEYS &MISC. &KEYS' /C013 DISP;0217;TEXT '------------------' DISP;0263;TEXT '------------ ----------' /C013 / MISCELLANEOUS KEYS - PRINTED FIRST BECAUSE CANT DISPLAY GREATER THAN 77 OCT. /******************* START OF COLUMN NUMBER 5 ******************* Q=0277 /**************************************************************** Q=Q+100; DISP; Q; TEXT ' !&ALT !&CHAR' /C013 IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' !&CTRL &RUBOUT <&X&]' /C013 Q=Q+100; DISP; Q; TEXT ' !&FIND' /C013 > / END IFDEF CONDOR Q=Q+100; DISP; Q; TEXT ' !&HYPH !&PUSH' /C013 IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' !&INSERT !&HERE' /C013 Q=Q+100; DISP; Q; TEXT ' !&NEXT !&SCREEN' /C013 Q=Q+100; DISP; Q; TEXT ' !&PREV !&SCREEN' /C013 Q=Q+100; DISP; Q; TEXT ' !&REMOVE' /C013 Q=Q+100; DISP; Q; TEXT ' &RUBOUT <&X&]' /C013 > / END IFDEF CONDOR IFNDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' !&RUB !&CHAR !&OUT' /C013 Q=Q+100; DISP; Q; TEXT ' !&RUB !&WORD !&OUT' /C013 > / END IFNDEF CONDOR IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' !&SELECT' /C013 > / END IFDEF CONDOR IFNDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' !&SWAP' /C013 > / END IFNDEF CONDOR Q=Q+100; DISP; Q; TEXT ' !&UDK' /C013 Q=Q+100; DISP; Q; TEXT ' ^A'; UPARRW /C013 Q=Q+100; DISP; Q; TEXT ' V' /C013 IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT ' <-' /C013 Q=Q+100; DISP; Q; TEXT ' ->' /C013 > / END IFDEF CONDOR /******************* START OF COLUMN NUMBER 1 ******************* Q=0201 /**************************************************************** Q=Q+100; DISP; Q; TEXT '!&ABBRV' Q=Q+100; DISP; Q; TEXT '!&ADVANCE' Q=Q+100; DISP; Q; TEXT '!&BACKUP' Q=Q+100; DISP; Q; TEXT '!&BOLD' TRNSFR;HELPAA;DLHLP1 UPARRW, 136;0 / CODE FOR DISPLAYING AN UP ARROW XTRLP0=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHLP1=. X=DLHLP1 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HELPAA, Q=Q+100; DISP; Q; TEXT '!&BOT !&DOCMT' Q=Q+100; DISP; Q; TEXT '!&CENTR' Q=Q+100; DISP; Q; TEXT '!&CMND' Q=Q+100; DISP; Q; TEXT '!&CONT !&SRCH' Q=Q+100; DISP; Q; TEXT '!&CONT !&SRCH !C& !&SEL' /C013 IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT '!&CTRL &RUBOUT <&X&]' /C013 > / END IFDEF CONDOR Q=Q+100; DISP; Q; TEXT '!&CUT' Q=Q+100; DISP; Q; TEXT '!&DATE !C& !&TIME' /C013 Q=Q+100; DISP; Q; TEXT '!&DEAD !&KEY' Q=Q+100; DISP; Q; TEXT '!&DEL !&CHAR OR !&WORD' Q=Q+100; DISP; Q; TEXT '!&FILE !&DOCMT' Q=Q+100; DISP; Q; TEXT '!&GET !&DOCMT' /******************* START OF COLUMN NUMBER 2 ******************* IFNDEF CONDOR < Q=0223 > /**************************************************************** Q=Q+100; DISP; Q; TEXT '!&HALT' /******************* START OF COLUMN NUMBER 2 ******************* IFDEF CONDOR < Q=0223 > /**************************************************************** Q=Q+100; DISP; Q; TEXT '!&HYPH !&PULL' Q=Q+100; DISP; Q; TEXT '!&INSERT !&HERE' Q=Q+100; DISP; Q; TEXT '!&LIBRY' Q=Q+100; DISP; Q; TEXT '!&MENU' Q=Q+100; DISP; Q; TEXT '!&NEW !&PAGE' Q=Q+100; DISP; Q; TEXT '!&PAGE' Q=Q+100; DISP; Q; TEXT '!&PAGE !&MARKER' Q=Q+100; DISP; Q; TEXT '!&PARA !&MARKER' Q=Q+100; DISP; Q; TEXT '!&PASTE' Q=Q+100; DISP; Q; TEXT '!&PRINT !&HYPH' TRNSFR;HELPBB;DLHLP2 XTRLP1=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHLP2=. X=DLHLP2 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HELPBB, IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT '!&REMOVE' > / END IFDEF CONDOR Q=Q+100; DISP; Q; TEXT '!&REPLC' IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT '&RUBOUT <&X&]' /C013 > / END IFDEF CONDOR IFNDEF CONDOR < Q=Q+100; DISP; Q; TEXT '!&RUB !&LINE' Q=Q+100; DISP; Q; TEXT '!&RUB !&SENT' > / END IFNDEF CONDOR Q=Q+100; DISP; Q; TEXT '!&RULER' Q=Q+100; DISP; Q; TEXT '!&SHIFT !&PRINT !&HYPH' / MUST BE IN COLUMN 2 /******************* START OF COLUMN NUMBER 3 ******************* IFNDEF CONDOR < Q=0245 > /C013 /**************************************************************** Q=Q+100; DISP; Q; TEXT '&SPACE' Q=Q+100; DISP; Q; TEXT '!&SRCH' /******************* START OF COLUMN NUMBER 3 ******************* IFDEF CONDOR < Q=0245 > /C013 /**************************************************************** Q=Q+100; DISP; Q; TEXT '!&SRCH !&PAGE' Q=Q+100; DISP; Q; TEXT '!&SUB !&SCRIPT' Q=Q+100; DISP; Q; TEXT '!&SUPER !&SCRIPT' IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT '!&SWAP (<>)' > / END IFDEF CONDOR Q=Q+100; DISP; Q; TEXT '!&TAB' Q=Q+100; DISP; Q; TEXT '!&TAB !&POS' Q=Q+100; DISP; Q; TEXT '!&TOP !&DOCMT' Q=Q+100; DISP; Q; TEXT '!&UNDERLINE' Q=Q+100; DISP; Q; TEXT '!&UPPERCASE' Q=Q+100; DISP; Q; TEXT '!&VIEW' IFNDEF CONDOR < Q=Q+100; DISP; Q; TEXT '^A (!&PREV !&SCREEN)';UPAROW Q=Q+100; DISP; Q; TEXT 'V (!&NEXT !&SCREEN)' /C013 > / END IFNDEF CONDOR IFDEF CONDOR < Q=Q+100; DISP; Q; TEXT '^A'; UPAROW Q=Q+100; DISP; Q; TEXT 'V' /C013 Q=Q+100; DISP; Q; TEXT '<-' /C013 Q=Q+100; DISP; Q; TEXT '->' /C013 > / END IFDEF CONDOR /******************* START OF COLUMN NUMBER 4 ******************* Q=0264 /C013 /**************************************************************** Q=Q+100; DISP; Q; TEXT '!&ADVANCE' Q=Q+100; DISP; Q; TEXT '!&BACKUP' Q=Q+100; DISP; Q; TEXT '!&BOLD' Q=Q+100; DISP; Q; TEXT '!&CUT' Q=Q+100; DISP; Q; TEXT '!&DEL !&CHAR' Q=Q+100; DISP; Q; TEXT '!&DEL !&WORD' Q=Q+100; DISP; Q; TEXT '!&LINE' TRNSFR;HELPCC;DLHLP3 UPAROW, 136;0 XTRLP2=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHLP3=. X=DLHLP3 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HELPCC, Q=Q+100; DISP; Q; TEXT '!&PAGE' Q=Q+100; DISP; Q; TEXT '!&PARA' Q=Q+100; DISP; Q; TEXT '!&PASTE' Q=Q+100; DISP; Q; TEXT '!&SEL' Q=Q+100; DISP; Q; TEXT '!&SENT' Q=Q+100; DISP; Q; TEXT '!&TAB !&POS' Q=Q+100; DISP; Q; TEXT '!&UNDERLINE' Q=Q+100; DISP; Q; TEXT '!&UPPERCASE' Q=Q+100; DISP; Q; TEXT '!&WORD' Q=Q+100; DISP; Q; TEXT '<>' / ENTER KEY /C013 HELP19, IFDEF HELPDO < DISP; 2412; TEXT '&PRESS !&ADVANCE OR !&BACKUP TO MOVE CURSOR.' DISP; 2512; TEXT '^S&D&O TO DO FUNCTION.'; HLPIN3 > / END IFDEF HELPDO IFNDEF HELPDO < DISP; 2512; TEXT '&PRESS !&ADVANCE OR !&BACKUP TO MOVE CURSOR.' > / END IFNDEF HELPDO DISP; 2612; TEXT '^S!&HELP KEY FOR MORE INFORMATION ON SELECTED' HLPIN3 DISP;-1; TEXT ' FUNCTION' DISP;2712;TEXT '^S!&RETURN !&OR &GOLD !&MENU TO RESUME EDITING.' HLPIN3 RETURN HLPIN3, TEXT '!&OR PRESS ' XTRLP3=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL01=. X=DLHL01 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / ENTRY POINT FOR HELP TEXT DISPLAY / MNTMP1 = OFFSET IN DISPLAY TABLE AS DEFINED IN WTHLP1 / HLPXXX=BLOCK ENTRY POINT OF TEXT BLOCK XXX / CASE TABLE EQUATES = OFFSET IN TABLE / MUST EQUATE TO POSITION IN ADHL01,ADHL02 MENU BLOCKS HLPENT, DISP;0;TEXT '!E --&HELP FOR ' / CLEAR SCREEN AND DISPLAY TITLE RANGE;MNTMP1;HABBR;HVIEW;HLPEDA / CHECK FOR A GOLD KEY FUNCTION DISP;-1;TEXT '&GOLD ' / YES, ADD WORD "GOLD" TO TITLE HLPEDA, CASE;MNTMP1 HABBR;-1-HLABBR;DLHL12 / GOLD: ABBREVIATION HADV;-1-HLADV;DLHL03 / GOLD: ADVANCE HBACK;-1-HLBACK;DLHL03 / GOLD: BACKUP HBOLD;-1-HLBOLD;DLHL26 / GOLD: UN BOLD HBOTT;-1-HLBOTT;DLHL04 / GOLD: BOTTOM OF DOC HCNTR;-1-HLCNTR;DLHL25 / GOLD: CENTER HCMND;-1-HLCMND;DLHL05 / GOLD: COMMAND HCONTS;-1-HLCONT;DLHL04 / GOLD: CONTINUE SEARCH HCNTSS;-1-HLCNTS;DLHL21 / GOLD: CONTINUE SEARCH AND SELECT IFDEF CONDOR < /A010 HRUBS;-1-HLRUBS;DLHL31 / GOLD: RUBBOUT SENTENCE > / END IFDEF CONDOR /A010 HCUT;-1-HLCUT;DLHL06 / GOLD: CUT HDATM;-1-HLDATM;DLHL10 / GOLD: DATE AND TIME HDEAD;-1-HLDEAD;DLHL24 / GOLD: DEAD KEY HDELTX;-1-HLDELTX;DLHL23 / GOLD: DELETE TEXT HFILE;-1-HLFILE;DLHL11 / GOLD: FILE DOCUMENT HGET;-1-HLGET;DLHL11 / GOLD: GET DOCUMENT HLHLT;-1-HLHALT;DLHL30 / GOLD: HALT HHYPUL;-1-HLHYPU;DLHL22 / GOLD: HYPHEN PULL HINSH;-1-HLLINS;DLHL44 / GOLD: INSERT HERE = GOLD: PASTE HLIBRY;-1-HLLIBR;DLHL13 / GOLD: LIBRARY HMENU;-1-HLMENU;DLHL15 / GOLD: MENU HNEWP;-1-HLNEWP;DLHL10 / GOLD: NEW PAGE HPAGE;-1-HLPAGE;DLHL30 / GOLD: PAGE HPMARK;-1-HLMARK;DLHL25 / GOLD: PAGE MARKER HPAMAR;-1-HLPAMA;DLHL16 / GOLD: PARAGRAPH MARKER HPASTE;-1-HLPAST;DLHL13 / GOLD: PASTE HPHYP;-1-HLPHYP;DLHL02 / GOLD: PRINT HYPEN IFDEF CONDOR < /A010 HREMV;-1-HLLREM;DLHL44 / GOLD: REMOVE = GOLD CUT > / END IFDEF CONDOR /A010 HREPL;-1-HLREPL;DLHL16 / GOLD: REPLACE HRUBL;-1-HLRUBL;DLHL15 / GOLD: RUBOUT LINE IFNDEF CONDOR < /A010 HRUBS;-1-HLRUBS;DLHL31 / GOLD: RUB SENT /A010 > / END IFNDEF CONDOR /A010 HRULER;-1-HLRULE;DLHL05 / GOLD: RULER HSRCHP;-1-HLPSRC;DLHL06 / GOLD: SEARCH PAGE HINVPR;-1-HLINVP;DLHL14 / GOLD: INVISIBLE PRINT HSPACE;-1-HLSPAC;DLHL46 / GOLD: NON-BREAKING SPACE HSRCH;-1-HLSRCH;DLHL17 / GOLD: SEARCH HSUBSC;-1-HLSUBS;DLHL20 / GOLD: SUBSCRIPT HSUPER;-1-HLSUPE;DLHL20 / GOLD: SUPER SCRIPT IFDEF CONDOR < /A010 HSWAP;-1-HLSWAP;DLHL22 / GOLD: SWAP > / END IFDEF CONDOR /A010 HTAB;-1-HLTAB;DLHL53 / GOLD: TAB HTABP;-1-HLTABP;DLHL53 / GOLD: TAB POS HTOPD;-1-HLTOPD;DLHL32 / GOLD: TOP DOCUMENT HUNDER;-1-HLUNDE;DLHL26 / GOLD: UNDERLINE HUPPER;-1-HLUPER;DLHL23 / GOLD: UPPERCASE HVIEW;-1-HLVIEW;DLHL27 / GOLD: VIEW IFDEF CONDOR < /A010 HUPAR;-1-HLLUP;DLHL44 / GOLD: UP ARROW HDNAR;-1-HLLDN;DLHL44 / GOLD: DOWN ARROW HLFAR;-1-HLLLF;DLHL45 / GOLD: LEFT ARROW HRTAR;-1-HLLRT;DLHL45 / GOLD: RIGHT ARROW > / END IFDEF CONDOR /A010 IFNDEF CONDOR < /A010 HRPREV;-1-HNPREV;DLHL50 / GOLD: UP ARROW (PREV SCREEN)/A010 HRNEXT;-1-HNNEXT;DLHL50 / GOLD: DOWN ARROW (NEXT SCREEN)/A010 > / END INFDEF CONDOR /A010 TRNSFR;TWOBIG;DL2BIG / GO CHECK THE REST OF THE TABLE XTRL01=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC AD2BIG=. X=DL2BIG / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 / TABLE GOT TO BIG SO IT GOT SPLIT INTO TWO PICES. / THE FOLLOWING REPRESENTS THE EDITING KEYS AND MUST BE / IN THE SAME SEQUENCE AS IN WTHLP1.PA TWOBIG, CASE; MNTMP1 HKADV;-1-HMADV;DLHL33 / ADVANCE ONE CHARACTER HKBACK;-1-HMBACK;DLHL33 / BACKUP ONE CHARACTER HKBOLD;-1-HMBOLD;DLHL34 / BOLD HKCUT;-1-HMCUT;DLHL07 / CUT HKDELC;-1-HMDELC;DLHL35 / DELETE CHARACTER HKDELW;-1-HMDELW;DLHL35 / DELETE WORD HKLINE;-1-HMLINE;DLHL36 / MOVE BY LINE HKPAGE;-1-HMPAGE;DLHL36 / MOVE BY PAGE HKPARA;-1-HMPARA;DLHL36 / MOVE BY PARAGRAPH HKPAST;-1-HMPAST;DLHL37 / PASTE HKSEL;-1-HMSEL;DLHL41 / SELECT HKSENT;-1-HMSENT;DLHL40 / MOVE BY SENTENCE HKTABP;-1-HMTABP;DLHL40 / MOVE BY TAB POSITION HKUNDE;-1-HMUNDE;DLHL42 / UNDERLINE HKUPPE;-1-HMUPPE;DLHL42 / UPPER CASE HKWORD;-1-HMWORD;DLHL43 / MOVE BY WORD HKENTE;-1-HMENTE;DLHL43 / ENTER KEY IFDEF CONDOR < /A010 HALTC;-1-HLALTC;DLHL54 / ALTERNATE CHARACTER HRUBW;-1-HLRUBW;DLHL52 / CTRL RUBOUT = RUB WORD OUT /A010 HRFIND;-1-HNFIND;DLHL45 / FIND = GOLD SEARCH /C007 > / END IFDEF CONDOR /A010 HRHYPP;-1-HNHYPP;DLHL46 / HYPH PUSH /C007 IFDEF CONDOR < /A010 HRINSH;-1-HNINSH;DLHL44 / INSERT HERE = PASTE HRNEXT;-1-HNNEXT;DLHL50 / NEXT SCREEN HRPREV;-1-HNPREV;DLHL50 / PREV SCREEN HRREMV;-1-HNREMV;DLHL44 / REMOVE = CUT > / END IFDEF CONDOR /A010 HRUBC;-1-HLRUBC;DLHL52 / RUBOUT = RUB CHAR OUT /A010 IFNDEF CONDOR < /A010 HRUBW;-1-HLRUBW;DLHL52 / RUB WORD OUT /A010 HSWAP;-1-HLSWAP;DLHL22 / SWAP /A010 > / END IFNDEF CONDOR /A010 IFDEF CONDOR < /A010 HRSEL;-1-HNSEL;DLHL45 / SELECT = SELECT > / END IFDEF CONDOR /A010 HUDK;-1-HLUDK;DLHL54 / UDK HRUP;-1-HNUP;DLHL47 / UP ARROW HRDN;-1-HNDN;DLHL47 / DOWN ARROW IFDEF CONDOR < /A010 HRLF;-1-HNLF;DLHL51 / LFT ARROW HRRT;-1-HNRT;DLHL51 / RGHT ARROW > / END IFDEF CONDOR /A010 /**** ALL DISPLAYS WILL RETURN HERE TO AWAIT CHAR INPUT TO CONTINUE / RETURN TO EDITOR WITH 0 IN MNTMP1 TO RESUME WITH / HELP COMMAND MENU WITH NON ZERO TO RETURN TO EDITOR XTRBIG=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL02=. X=DLHL02 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLPRET, /d014 DISP;1504;TEXT '&FOR MORE INFORMATION, SEE THE &WORD ' /C013 /d014 DISP;-1;TEXT "&PROCESSING &USER'S &GUIDE, &CHAPTER !D.";MNTMP2 /C013 IFDEF HELPDO < DISP;2217;TEXT '&PRESS &D&O TO DO ' HLPRE2, RANGE;MNTMP1;HABBR;HVIEW;HLPEDB DISP;-1;TEXT '&GOLD ' HLPEDB, DISP;-1;TEXT 'FUNCTION' DISP;2317;TEXT '!&OR !&RETURN TO RETURN TO &GOLD &KEY &HELP &MENU' > / END IFDEF HELPDO IFNDEF HELPDO < DISP;2317;TEXT '&PRESS !&RETURN TO RETURN TO &GOLD &KEY &HELP &MENU' > / END IFNDEF HELPDO DISP;2417;TEXT '!&OR &GOLD !&MENU TO RESUME EDITING' HLPRED, READ;MNTMP1;HLPGLD ARG;HLPSET;MNTMP1 HLPERR, DISP;3000;TEXT '!E^CG' GOTO;HLPRED HLPGLD, CASE;MNSYSA / CHECK TERMINATION KEY EDMENU&3777;HLPEDT / RETURN TO EDIT MODE IFDEF HELPDO < EDDO&3777; HLPDOO / DO IT > / END IFDEF HELPDO GOTO;HLPERR HLPSET, SET;0;MNTMP1 RETURN IFDEF HELPDO < HLPDOO, SET;-1;MNTMP1 /-1=DO IT RETURN > / END IFDEF HELPDO HLPEDT, SET;1;MNTMP1 /1=RETURN TO EDIT RETURN HLPHYP, DISP;HLPLNS;TEXT '^S--';KNHYP1 DISP;HLPLNA TEXT '^S^S, &D&E&CMATE INSERTS A !&BREAKING !&HYPHEN IN THE' CMK02A;KNHYP1 TRNSFR;-1-HLHYPA;DLHL27 KNHYP1, TEXT '!&PRINT !&HYPH' CMK02A, TEXT '&WHEN YOU PRESS &GOLD ' XTRL02=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL03=. X=DLHL03 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLBACK, DISP;HLPLNS;TEXT '^S--';KNBK1 DISP;HLPLNA;TEXT '^S^S, ^S BEGINS SCROLLING BACKWARD THROUGH THE' CMK03A;KNBK1;CMK03B DISP;HLPLNB TEXT 'DOCUMENT. &THE TEXT MOVES DOWNWARD ON THE SCREEN. ^S ';CMK03B DISP;-1;TEXT 'DOES NOT STOP' DISP;HLPLNC;TEXT '^STOP^S';CMK03C;CMK03D SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNBK1, TEXT '!&BACKUP' HLADV, DISP;HLPLNS;TEXT '^S--';KNADV1 DISP;HLPLNA;TEXT '^S^S, ^S BEGINS SCROLLING FORWARD THROUGH THE' CMK03A;KNADV1;CMK03B DISP;HLPLNB TEXT 'DOCUMENT. &THE TEXT MOVES UPWARD ON THE SCREEN. ^S ';CMK03B DISP;-1;TEXT 'DOES NOT STOP' DISP;HLPLNC;TEXT '^SBOTTOM^S';CMK03C;CMK03D SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNADV1, TEXT '!&ADVANCE' CMK03A, TEXT '&WHEN YOU PRESS &GOLD ' CMK03B, TEXT '&D&E&CMATE' CMK03C, TEXT 'UNTIL IT REACHES THE ' CMK03D, TEXT ' OF THE DOCUMENT OR UNTIL YOU PRESS &GOLD !&HALT.' XTRL03=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL04=. X=DLHL04 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLBOTT, DISP;HLPLNS;TEXT '^S--';KNBOT1 DISP;HLPLNA;TEXT '^S^S,^S MOVES THE CURSOR TO THE' CMK04A;KNBOT1;CMK04B DISP;HLPLNB;TEXT 'BOTTOM OF THE DOCUMENT. ' DISP;-1;TEXT'&THE SCREEN SHOWS A REPOSITIONING MESSAGE' DISP;HLPLNC;TEXT 'UNTIL &D&E&CMATE REACHES THE BOTTOM OF THE DOCUMENT.' SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNBOT1, TEXT '!&BOT !&DOCMT' HLCONT, DISP;HLPLNS;TEXT '^S--';KNCNT1 DISP;HLPLNA;TEXT '^S^S,^S CONTINUES SEARCHING IN THE SAME' CMK04A;KNCNT1;CMK04B DISP;HLPLNB TEXT 'DIRECTION FOR THE SAME WORD OR PHRASE IT SEARCHED FOR LAST TIME.' DISP;HLPLNC;TEXT '&IT DOES NOT PROMPT YOU TO ENTER THE PHRASE AGAIN.' SET;16;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNCNT1, TEXT '!&CONT !&SRCH' CMK04A, TEXT '&WHEN YOU PRESS &GOLD ' CMK04B, TEXT ' &D&E&CMATE' XTRL04=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL05=. X=DLHL05 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLCMND, DISP;HLPLNS;TEXT '^S--';KNCMD1 DISP;HLPLNA;TEXT '^S^S,^S INSERTS A !&START^S AND' CMK05A;KNCMD1;CMK05B;KNCMD2 DISP;HLPLNB TEXT 'ENTERS COMMAND MODE. &YOU MAY THEN GIVE^S A CONTROL COMMAND.' CMK05B DISP;HLPLNC TEXT '&WHEN YOU ARE DONE, PRESS &GOLD ^S AGAIN;^S INSERTS AN' KNCMD1;CMK05B DISP;HLPLND;TEXT '&E&N&D^S.';KNCMD2 SET;12;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNCMD1, TEXT '!&CMND' KNCMD2, TEXT ' !&CONTROL MARKER' HLRULE, DISP;HLPLNS;TEXT '^S--';KNRUL1 DISP;HLPLNA;TEXT '^S^S,^S DISPLAYS THE CURRENT RULER SETTINGS.' CMK05A;KNRUL1;CMK05B DISP;HLPLNB;TEXT '&YOU CAN CHANGE THE MARGINS, OR PUT IN ' DISP;-1;TEXT 'TAB POSITIONS, CENTERING MARKS,' DISP;HLPLNC;TEXT 'PARAGRAPH INDENTS, AND SO FORTH.' SET;5;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNRUL1, TEXT '!&RULER' CMK05A, TEXT '&WHEN YOU PRESS &GOLD ' CMK05B, TEXT ' &D&E&CMATE' XTRL05=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL06=. X=DLHL06 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLPSRC, DISP;HLPLNS;TEXT '^S^S--';KNSCH1;KNSCH2 DISP;HLPLNA TEXT '&YOU CAN USE &GOLD ^S TO MOVE THE CURSOR TO A SPECIFIC PAGE. &PRESS' KNSCH1 DISP;HLPLNB TEXT '&GOLD ^S, THEN PRESS^S, ENTER THE PAGE NUMBER AND PRESS !&RETURN.' KNSCH1;KNSCH2 DISP;HLPLNC TEXT '^S MOVES THE CURSOR TO THAT PAGE. !&NOTE: &GOLD ^S^S ONLY WORKS' CMK06B;KNSCH1;KNSCH2 DISP;HLPLND;TEXT 'ON DOCUMENTS WITH PAGE-END MARKS IN THEM.' SET;16;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNSCH1, TEXT '!&SRCH' KNSCH2, TEXT ' !&PAGE' HLCUT, DISP;HLPLNS;TEXT '!&CUT--' DISP;HLPLNA;TEXT '&USE &GOLD !&CUT TO COPY^SCOPY; PUT A';KMCUTB TRNSFR;-1-HLCUTA;DLHL07 KMCUTB, TEXT ' TEXT. &FIRST SELECT THE TEXT YOU WANT TO ' CMK06B, TEXT '&D&E&CMATE' XTRL06=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL07=. X=DLHL07 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLCUTA, DISP;HLPLNB;TEXT '^S&GOLD ^S.';KMCUT3;KMCUT1 DISP;HLPLNC TEXT '^S COPIES THE TEXT INTO^S AREA WITHOUT REMOVING IT FROM' CMK07B;KMCUT4 DISP;HLPLND TEXT '^S. &GOLD ^S WILL ALSO COPY THE RULERS OF THE TEXT.' KMCUT5;KMCUT1 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMCUT, DISP;HLPLNS;TEXT '^S--';KMCUT1 DISP;HLPLNA;TEXT '&USE ^S TO MOVE OR DELETE^SMOVE;';KMCUT1;KMCUT2 DISP;HLPLNB;TEXT 'PUT A ^S^S.';KMCUT3;KMCUT1 DISP;HLPLNC;TEXT '^S MOVES THE TEXT AND RULERS OUT OF ^S, INTO^S' CMK07B;KMCUT5;KMCUT4 DISP;HLPLND;TEXT 'AREA. &ANY TEXT ALREADY IN^S AREA IS DESTROYED.' KMCUT4 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMCUT1, TEXT '!&CUT' KMCUT2, TEXT ' TEXT. &FIRST SELECT THE TEXT YOU WANT TO ' KMCUT3, TEXT 'SELECT MARK AT ONE END AND THE CURSOR AT THE OTHER. &THEN PRESS ' KMCUT4, TEXT ' THE PASTE' KMCUT5, TEXT 'THE DOCUMENT' CMK07B, TEXT '&D&E&CMATE' XTRL07=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL10=. X=DLHL10 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLNEWP, DISP;HLPLNS;TEXT '^S--';KNEWP1 DISP;HLPLNA;TEXT '^S^S, ^S INSERTS A ^S MARK IN THE TEXT.' CMK10A;KNEWP1;CMK10B;KNEWP1 DISP;HLPLNB TEXT '&THIS MARK IS NOT PRINTED. &IT FORCES THE TEXT FOLLOWING THE ^S MARK' KNEWP1 DISP;HLPLNC;TEXT 'TO THE TOP OF THE NEXT PRINTED PAGE.' SET;11;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNEWP1, TEXT '!&NEW !&PAGE' HLDATM, DISP;HLPLNS;TEXT '^S!C& !&TIME--';KNDAT1 DISP;HLPLNA;TEXT '^S^S!C& !&TIME, ^S INSERTS THE CURRENT DATE AND' CMK10A;KNDAT1;CMK10B DISP;HLPLNB;TEXT 'TIME INTO YOUR DOCUMENT. ' DISP;-1;TEXT '&HERE IS AN EXAMPLE: 9/24/84 &MON 12:51:25' DISP;HLPLNC TEXT '^S DOES NOT UPDATE THE DATE AND TIME RECORDED IN YOUR DOCUMENT.' CMK10B SET;3;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNDAT1, TEXT '!&DATE ' CMK10A, TEXT '&WHEN YOU PRESS &GOLD ' CMK10B, TEXT '&D&E&CMATE' XTRL10=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL11=. X=DLHL11 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLFILE, DISP;HLPLNS;TEXT '^S--';KNFLE1 DISP;HLPLNA;TEXT '^S^S, ^SENDS YOUR EDITING SESSION ON THE' CMK11A;KNFLE1;CMK11B DISP;HLPLNB;TEXT '^S^S. ^SFILES THE ^S, WITH ALL THE CHANGES YOU' CMKRU1;CMKRU2;CMK11B;CMKRU2 DISP;HLPLNC;TEXT 'HAVE PUT IN, AND DISPLAYS THE &MAIN &MENU.' SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNFLE1, TEXT '!&FILE !&DOCMT' HLGET, DISP;HLPLNS;TEXT '^S--';KNGET1 DISP;HLPLNA;TEXT '^S^S, ^SASKS YOU FOR^S OR NUMBER' CMK11A;KNGET1;CMK11B;KNGET3 DISP;HLPLNB; TEXT 'OF THE ^S YOU WANT TO GET. &ENTER^S AND PRESS !&RETURN.' CMKRU2;KNGET3 DISP;HLPLNC;TEXT '^SCOPIES^SD ^S INTO YOUR ^S^S, STARTING' CMK11B;KNGET3;CMKRU2;CMKRU1;CMKRU2 DISP;HLPLND;TEXT 'AT THE ^SPOSITION OF THE CURSOR.' CMKRU1 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNGET1, TEXT '!&GET !&DOCMT' KNGET3, TEXT ' THE NAME' CMKRU1, TEXT 'CURRENT ' CMKRU2, TEXT 'DOCUMENT' CMK11A, TEXT '&WHEN YOU PRESS &GOLD ' CMK11B, TEXT '&D&E&CMATE ' XTRL11=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL12=. X=DLHL12 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLABBR, DISP;HLPLNS;TEXT '^S--';KNAB1 DISP;HLPLNA TEXT '&YOU CAN SET UP AN !&^S !&DOCUMENT CONTAINING A LIST OF PHRASES' KNAB2 DISP;HLPLNB;TEXT 'AND THEIR^S ^SS. ^S^S AND' KNAB3;KNAB2;CMK12A;KNAB1 DISP;HLPLNC;TEXT 'TYPE THE^S ^S, ^S INSERTS THE PHRASE.' KNAB3;KNAB2;CMK12B SET;17;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNAB1, TEXT '!&ABBRV' KNAB2, TEXT 'ABBREVIATION' KNAB3, TEXT ' TWO-LETTER' CMK12A, TEXT '&WHEN YOU PRESS &GOLD ' CMK12B, TEXT '&D&E&CMATE' XTRL12=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL13=. X=DLHL13 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLLIBR, DISP;HLPLNS;TEXT '^S--';KNLIB1 DISP;HLPLNA TEXT '&YOU CAN SET UP A !&LIBRARY !&DOCUMENT CONTAINING A LIST' DISP;-1;TEXT ' OF ^SS AND THEIR';KNLIB2 DISP;HLPLNB;TEXT 'SHORT NAMES. ^S^S,^S PROMPTS YOU FOR A NAME.' CMK13A;KNLIB1;CMK13B DISP;HLPLNC TEXT '&ENTER THE NAME OF THE ^S AND PRESS !&RETURN. ^S INSERTS THE' KNLIB2;CMK13B DISP;HLPLND;TEXT '^S.';KNLIB2 SET;17;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNLIB1, TEXT '!&LIBRY' KNLIB2, TEXT 'PASSAGE' HLPAST, DISP;HLPLNS;TEXT '^S--';KNPST1 DISP;HLPLNA;TEXT '^S^S,^S COPIES THE CONTENTS OF THE PASTE AREA' CMK13A;KNPST1;CMK13B DISP;HLPLNB TEXT 'INTO THE TEXT, USING THE ORIGINAL RULERS OF THE TEXT BEING COPIED.' SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNPST1, TEXT '!&PASTE' CMK13A, TEXT '&WHEN YOU PRESS &GOLD ' CMK13B, TEXT ' &D&E&CMATE' XTRL13=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC FIELD 2 *0 ADHL14=. X=DLHL14 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLINVP, DISP;HLPLNS;TEXT '^S^S--';KNHLP1;KNHLP2 DISP;HLPLNA TEXT '&WHEN YOU HOLD DOWN THE ^S KEY AND PRESS &GOLD^S, &D&E&CMATE' KNHLP1;KNHLP2 DISP;HLPLNB TEXT 'INSERTS AN !&INVISIBLE !&HYPHEN IN THE TEXT, WHICH ONLY APPEARS IF THE' DISP;HLPLNC;TEXT 'WORD CONTAINING IT CROSSES THE RIGHT MARGIN. ' DISP;-1;TEXT '&THAT PART OF THE WORD' DISP;HLPLND;TEXT 'FOLLOWING^S MOVES TO^S AND^S APPEARS.' KNHLP3;CMKPR1;KNHLP3 SET;10;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNHLP1, TEXT '!&SHIFT' KNHLP2, TEXT ' !&PRINT !&HYPH' KNHLP3, TEXT ' THE HYPHEN' CMKPR1, TEXT ' THE NEXT LINE' XTRL14=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL15=. X=DLHL15 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLMENU, DISP;HLPLNS;TEXT '^S--';KNMEN1 DISP;HLPLNA;TEXT '^S^S WHILE EDITING A^S,^S DISPLAYS THE' CMK15A;KNMEN1;KNMEN2;CMK15B DISP;HLPLNB TEXT '&EDITOR &MENU. &FROM THIS MENU, YOU CAN CONTROL TEXT SIZE, ' DISP;-1;TEXT 'DEFINE USER KEYS,' DISP;HLPLNC;TEXT 'SELECT LIBRARY AND ABBREVIATION^SS, AND SO FORTH.' KNMEN2 SET;3;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNMEN1, TEXT '!&MENU' KNMEN2, TEXT ' DOCUMENT' HLRUBL, DISP;HLPLNS;TEXT '^S--';KNRBL1 DISP;HLPLNA;TEXT '^S^S,^S ERASES ALL TEXT BETWEEN THE CURSOR' CMK15A;KNRBL1;CMK15B DISP;HLPLNB TEXT 'AND THE BEGINNING OF THE CURRENT LINE. &IF THE CURSOR IS AT THE' DISP;HLPLNC;TEXT 'BEGINNING OF THE LINE,^S ERASES THE PRECEEDING LINE.' CMK15B SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNRBL1, IFDEF CONDOR < /A010 TEXT '&RUBOUT' > / END IFDEF CONDOR /A010 IFNDEF CONDOR < /A010 TEXT '!&RUB !&LINE' /A010 > / END IFNDEF CONDOR /A010 CMK15A, TEXT '&WHEN YOU PRESS &GOLD ' CMK15B, TEXT ' &D&E&CMATE' XTRL15=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL16=. X=DLHL16 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLPAMA, DISP;HLPLNS;TEXT '^S--';KNPAR1 DISP;HLPLNA;TEXT '^S^S, ^S INSERTS A^S MARKER IN THE' CMK16A;KNPAR1;CMK16B;KNPAR2 DISP;HLPLNB;TEXT 'TEXT. &TEXT FOLLOWING THE^S MARKER APPEARS ON^S,' KNPAR2;CMKPA1 DISP;HLPLNC TEXT 'INDENTED TO LINE UP WITH ANY^S INDENT POSITION IN THE RULER' KNPAR2 DISP;HLPLND;TEXT '(MARKED BY &P).' SET;5;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNPAR1, TEXT '!&PARA !&MARKER' KNPAR2, TEXT ' PARAGRAPH' CMKPA1, TEXT ' THE NEXT LINE' HLREPL, DISP;HLPLNS;TEXT '^S--';KNREP1 DISP;HLPLNA;TEXT '&FIRST, SELECT THE TEXT YOU WISH TO^S. ^S^S' KNREP2;CMK16A;KNREP1 DISP;HLPLNB TEXT '^S DELETES THE SELECTED TEXT AND^SS IT WITH THE TEXT IN THE' CMK16B;KNREP2 TRNSFR;-1-HLREPA;DLHL17 KNREP1, TEXT '!&REPLC' KNREP2, TEXT ' REPLACE' CMK16A, TEXT '&WHEN YOU PRESS &GOLD ' CMK16B, TEXT '&D&E&CMATE' XTRL16=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL17=. X=DLHL17 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLREPA, DISP;HLPLNC TEXT '!&PASTE !&AREA. &THIS FUNCTION DOES NOT WORK IF THE PASTE AREA' DISP;-1;TEXT ' IS EMPTY.' SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLSRCH, DISP;HLPLNS;TEXT '^S--';KNSRC1 DISP;HLPLNA;TEXT '^S^S,^S PROMPTS YOU FOR THE WORD OR PHRASE' CMK17A;KNSRC1;CMK17B DISP;HLPLNB / M012 TEXT 'YOU WANT TO ^S FOR. &ENTER THE PHRASE AND PRESS !&ADVANCE (TO ^S' KNSRC2;KNSRC2 DISP;HLPLNC;TEXT 'FORWARD), !&BACKUP (^S BACKWARD) OR !&CONT ^S' KNSRC2;KNSRC1 DISP;-1;TEXT ' !C& !&SEL (^S FORWARD';KNSRC2 DISP;HLPLND;TEXT 'AND SELECT THE PHRASE).' SET;16;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNSRC1, TEXT '!&SRCH' KNSRC2, TEXT 'SEARCH' CMK17A, TEXT '&WHEN YOU PRESS &GOLD ' CMK17B, TEXT ' &D&E&CMATE' XTRL17=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL20=. X=DLHL20 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLSUBS, DISP;HLPLNS;TEXT '^S--';KNSUB1 DISP;HLPLNA;TEXT '^S^S,^S INVISIBLY MARKS THE CHARACTER AT' CMK20A;KNSUB1;CMK20B DISP;HLPLNB;TEXT '^S &WHEN YOU PRINT';KNB20A DISP;HLPLNC TEXT 'THE DOCUMENT, THAT CHARACTER IS A HALF-LINE LOWER THAN THE OTHERS.' SET;15;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNSUB1, TEXT '!&SUB !&SCRIPT' HLSUPE, DISP;HLPLNS;TEXT '^S--';KNSUP1 DISP;HLPLNA;TEXT '^S^S,^S INVISIBLY MARKS THE CHARACTER AT' CMK20A;KNSUP1;CMK20B DISP;HLPLNB;TEXT '^S &WHEN YOU PRINT';KNB20A DISP;HLPLNC TEXT 'THE DOCUMENT, THAT CHARACTER IS A HALF-LINE HIGHER THAN THE OTHERS.' SET;15;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNSUP1, TEXT '!&SUPER !&SCRIPT' KNB20A, TEXT 'THE CURSOR (THOUGH YOU CAN SEE THE MARK WITH &GOLD !&VIEW).' CMK20A, TEXT '&WHEN YOU PRESS &GOLD ' CMK20B, TEXT ' &D&E&CMATE' XTRL20=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL21=. X=DLHL21 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLCNTS, DISP;HLPLNS;TEXT '^S!C& !&SEL--';KNSRR1 DISP;HLPLNA;TEXT '^S^S!C& !&SEL,^S CONTINUES SEARCHING IN THE' CMK21A;KNSRR1;CMK21B DISP;HLPLNB TEXT 'SAME DIRECTION FOR ^S IT SEARCHED FOR LAST TIME. &WHEN IT' KNSRR2 DISP;HLPLNC TEXT 'FINDS ^S, IT PUTS A SELECT MARK AT THE BEGINNING AND' KNSRR2 DISP;HLPLND;TEXT 'MOVES THE CURSOR TO THE END OF ^S.';KNSRR2 SET;16;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNSRR1, TEXT '!&CONT !&SRCH ' KNSRR2, TEXT 'THE WORD OR PHRASE' CMK21A, TEXT '&WHEN YOU PRESS &GOLD ' CMK21B, TEXT ' &D&E&CMATE' XTRL21=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL22=. X=DLHL22 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLHYPU, DISP;HLPLNS;TEXT '^S--';KNPUL1 DISP;HLPLNA;TEXT '^S^S,^S PULLS A CHARACTER DOWN FROM THE' CMK22A;KNPUL1;CMK22B DISP;HLPLNB TEXT 'PREVIOUS LINE TO THE LINE THE CURSOR IS ON. &GOLD ^S HAS NO EFFECT' KNPUL1 DISP;HLPLNC TEXT 'UNLESS THE PREVIOUS LINE ENDS WITH AN INVISIBLE HYPHEN.' DISP;-1;TEXT ' (&SEE &HELP FOR' DISP;HLPLND;TEXT '&GOLD !&SHIFT !&PRINT !&HYPH).' SET;10;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNPUL1, TEXT '!&HYPH !&PULL' HLSWAP, DISP;HLPLNS;TEXT '^S--';KNSWP1 DISP;HLPLNA;TEXT '^S^S,^S SWAPS THE POSITIONS OF THE CHARACTER AT' CMK22A;KNSWP1;CMK22B DISP;HLPLNB;TEXT 'THE CURSOR AND THE CHARACTER FOLLOWING THE CURSOR. ' DISP;-1;TEXT '&THE CURSOR MOVES AHEAD' TRNSFR;-1-HLSWPA;DLHL23 KNSWP1, TEXT '!&SWAP' CMK22A, IFDEF CONDOR < /A010 TEXT '&WHEN YOU PRESS &GOLD ' > / END IFDEF CONDOR /A010 IFNDEF CONDOR < /A010 TEXT '&WHEN YOU PRESS ' /A010 > / END IFNDEF CONDOR /A010 CMK22B, TEXT ' &D&E&CMATE' XTRL22=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL23=. X=DLHL23 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLSWPA, DISP;HLPLNC;TEXT 'ONE POSITION, STAYING WITH ITS FIRST CHARACTER.' SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLDELTX,DISP;HLPLNS;TEXT '^S^S--';KNDEL1;KNDEL2 DISP;HLPLNA;TEXT '^S^S&GOLD ^S,^S &U&NDELETES THE LAST' CMK23A;KNDEL1;KNDEL2;CMK23B DISP;HLPLNB TEXT 'PIECE OF TEXT YOU ERASED. &GOLD ^S!&WORD REVERSES THE EFFECTS OF' KNDEL1 DISP;HLPLNC TEXT 'THE !&DEL AND &RUBOUT KEYS. &ONLY THE LAST PIECE OF TEXT ERASED CAN BE' DISP;HLPLND;TEXT 'RECOVERED.' SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNDEL1, TEXT '!&DEL !&CHAR OR ' KNDEL2, TEXT '!&DEL !&WORD' HLUPER, DISP;HLPLNS;TEXT '^S--';KNUPP1 DISP;HLPLNA;TEXT '^S^S,^S STARTS CHANGING TEXT INTO' CMK23A;KNUPP1;CMK23B DISP;HLPLNB;TEXT 'LOWERCASE. &AS LONG AS YOU USE DISTANCE' TRNSFR;-1-HLUPPA;DLHL24 KNUPP1, TEXT '!&UPPERCASE' CMK23A, TEXT '&WHEN YOU PRESS &GOLD ' CMK23B, TEXT ' &D&E&CMATE' XTRL24=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL24=. X=DLHL24 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLUPPA, DISP;-1;TEXT ' KEYS TO MOVE THE CURSOR, ALL' DISP;HLPLNC TEXT 'CHARACTERS THE CURSOR MOVES OVER BECOME LOWERCASE. &GOLD ^S' KNUPP2 DISP;HLPLND;TEXT 'REVERSES ^S.';KNUPP2 SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNUPP2, TEXT '!&UPPERCASE' HLDEAD, DISP;HLPLNS;TEXT '^S--';KNDED1 DISP;HLPLNA TEXT '&USE &GOLD ^S TO PRINT ONE ^S ON TOP OF ANOTHER. &ENTER THE' KNDED1;KNDED2 DISP;HLPLNB TEXT 'TWO ^SS YOU WISH TO COMBINE, PLACE THE CURSOR ON THE SECOND' KNDED2 DISP;HLPLNC;TEXT '^S, THEN PRESS &GOLD ^S. &THE TWO ^SS VANISH AND THE' KNDED2;KNDED1;KNDED2 DISP;HLPLND;TEXT 'SYMBOL ![(0^A![(&^S APPEARS.';KNDED3;MNLANG SET;15;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNDED1, TEXT '!&DEAD !&KEY' KNDED2, TEXT 'CHARACTER' KNDED3, 141 / GRAPHIC BOX CHAR 0 / END SEQ CMK24A, TEXT '&WHEN YOU PRESS &GOLD ' CMK24B, TEXT ' &D&E&CMATE' XTRL24=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL25=. X=DLHL25 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLCNTR, DISP;HLPLNS;TEXT '^S--';KNCN1 DISP;HLPLNA;TEXT '^S^S,^S ';CMK25A;KNCN1;CMK25B DISP;-1;TEXT 'MOVES THE LINE LEFT OF THE' DISP;HLPLNB TEXT 'CURSOR TO THE CENTER OF THE RULER, OR UNDERNEATH A CENTERING' DISP;HLPLNC TEXT 'MARK IN THE RULER. &TEXT RIGHT OF THE CURSOR MOVES TO THE' DISP;-1;TEXT ' NEXT LINE.' SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNCN1, TEXT '!&CENTER' /C007 HLMARK, DISP;HLPLNS;TEXT '^S--';KNMRK1 DISP;HLPLNA;TEXT '^S^S,^S^S A ^S IN THE TEXT.' CMK25A;KNMRK1;CMK25B;CMKHY1;KNMRK1 DISP;HLPLNB TEXT '&THIS MARK IS NOT PRINTED. &IT FORCES THE TEXT FOLLOWING THE ^S TO ' KNMRK1 DISP;HLPLNC;TEXT 'THE TOP OF THE NEXT PRINTED PAGE, IF THE &A&P' TRNSFR;-1-HLMRKA;DLHL26 KNMRK1, TEXT '!&PAGE !&MARKER' CMKHY1, TEXT ' INSERTS' CMKHY3, TEXT ' HYPHEN' CMK25A, TEXT '&WHEN YOU PRESS &GOLD ' CMK25B, TEXT ' &D&E&CMATE' XTRL25=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL26=. X=DLHL26 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLMRKA, DISP;-1;TEXT ' PRINT SETTING IS SET TO !&NO.' SET;11;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLUNDE, DISP;HLPLNS;TEXT '^S--';KNUND1 DISP;HLPLNA;TEXT '^S^S,^S STARTS REMOVING^S.' CMK26A;KNUND1;CMK26B;KNUND2 DISP;HLPLNB;TEXT '^S^S^S';CMKUN1;CMKUN2;CMKUN3 DISP;HLPLNC;TEXT '^SLOSE^S. ^S^S^S^S.' CMKUN4;KNUND2;CMKUN5;KNUND1;CMKUN6;KNUND1 SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNUND1, TEXT '!&UNDERLINE' KNUND2, TEXT ' UNDERLINING' HLBOLD, DISP;HLPLNS;TEXT '^S--';KNBLD1 DISP;HLPLNA;TEXT '^S^S,^S STARTS &U&NBOLDING TEXT. ^S' CMK26A;KNBLD1;CMK26B;CMKUN1 DISP;HLPLNB;TEXT '^S^S^S';CMKUN2;CMKUN3;CMKUN4 DISP;HLPLNC;TEXT '^S&U&NBOLDED. ^S^S^S^S.' CMKUN7;CMKUN5;KNBLD1;CMKUN6;KNBLD1 SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNBLD1, TEXT '!&BOLD' CMKUN1, TEXT '&AS LONG AS YOU ' CMKUN2, TEXT 'USE DISTANCE KEYS TO MOVE THE CURSOR, ALL ' CMKUN3, TEXT 'CHARACTERS THE ' CMKUN4, TEXT 'CURSOR MOVES OVER ' CMKUN5, TEXT '&GOLD ' CMKUN6, TEXT ' REVERSES ' CMKUN7, TEXT 'BECOME ' CMK26A, TEXT '&WHEN YOU PRESS &GOLD ' CMK26B, TEXT ' &D&E&CMATE' XTRL26=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL27=. X=DLHL27 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLVIEW, DISP;HLPLNS;TEXT '^S--';KNVEW1 DISP;HLPLNA;TEXT '^S^S,^S DISPLAYS AN EXPANDED VIEW OF THE CURRENT' CMK27A;KNVEW1;CMK27B DISP;HLPLNB TEXT 'TEXT. &THIS VIEW IS DOUBLESPACED AND SHOWS THE TEXT PLUS ANY' DISP;-1;TEXT ' !&INVISIBLE' DISP;HLPLNC TEXT '!&CHARACTERS, SUCH AS TAB MARKS, SUPERSCRIPT AND SUBSCRIPT' DISP;-1;TEXT ' MARKS, AND HARD' DISP;HLPLND;TEXT 'RETURNS.' SET;17;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNVEW1, TEXT '!&VIEW' HLHYPA, DISP;HLPLNB;TEXT 'TEXT. &IF A COMPOUND WORD CONTAINS A ' DISP;-1;TEXT 'BREAKING HYPHEN AND CROSSES THE RIGHT' DISP;HLPLNC;TEXT 'MARGIN, THAT PART OF THE WORD FOLLOWING ' DISP;-1;TEXT 'THE HYPHEN MOVES TO THE NEXT LINE.' SET;10;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 CMK27A, TEXT '&WHEN YOU PRESS &GOLD ' CMK27B, TEXT ' &D&E&CMATE' XTRL27=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL30=. X=DLHL30 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLHALT, DISP;HLPLNS;TEXT '^S--';KNHLT1 DISP;HLPLNA;TEXT '^S^S,^S QUITS MANY FUNCTIONS IT WAS DOING' CMK30A;KNHLT1;CMK30B DISP;HLPLNB;TEXT 'AT THE TIME, SUCH AS^S';KNHLT2 DISP;-1;TEXT ' !&SRCH OR^S !&ADVANCE. ^S ^S ALSO ENDS THE' KNHLT2;KNHLT2;KNHLT1 DISP;HLPLNC TEXT 'DEFINITION OF A &USER-&DEFINED &KEY. &IF^S IS NOT DOING A ' CMK30B DISP;-1;TEXT 'FUNCTION' DISP;HLPLND;TEXT '(RIGHT NOW, FOR INSTANCE),^S ^S DOES NOTHING.' KNHLT2;KNHLT1 SET;2;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNHLT1, TEXT '!&HALT' KNHLT2, TEXT ' &GOLD' HLPAGE, DISP;HLPLNS;TEXT '^S--';KNPAG1 DISP;HLPLNA;TEXT '^S^S,^S COUNTS LINES FROM THE TOP OF THE' CMK30A;KNPAG1;CMK30B TRNSFR;-1-HLPAGA;DLHL31 KNPAG1, TEXT '!&PAGE' CMK30A, TEXT '&WHEN YOU PRESS &GOLD ' CMK30B, TEXT ' &D&E&CMATE' XTRL30=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL31=. X=DLHL31 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLPAGA, DISP;HLPLNB TEXT 'DOCUMENT OR FROM THE LAST PAGE-END MARK, UNTIL IT REACHES THE' DISP;HLPLNC TEXT 'CURRENT TEXT SIZE. &IT THEN INSERTS A !&PAGE !&MARKER.' DISP;HLPLND;TEXT '&THIS INDICATES THE BREAK BETWEEN PRINTED PAGES.' SET;11;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLRUBS, DISP;HLPLNS;TEXT '^S--';KNRUB1 DISP;HLPLNA;TEXT '^S^S,^S ERASES ALL TEXT BETWEEN THE' CMK31A;KNRUB1;CMK31B DISP;HLPLNB;TEXT '^S AND THE ^S THE CURRENT^S. &IF THE ^S IS' KNRUB3;KNRUB4;KNRUB2;KNRUB3 DISP;HLPLNC;TEXT 'AT THE ^S A^S,^S ERASES THE PRECEEDING^S.' KNRUB4;KNRUB2;CMK31B;KNRUB2 TRNSFR;-1-HLRUBA;DLHL32 KNRUB1, IFDEF CONDOR < /A010 TEXT '!&CTRL &RUBOUT' > / END IFDEF CONDOR /A010 IFNDEF CONDOR < /A010 TEXT '!&RUB !&SENT' /A010 > / END IFNDEF CONDOR /A010 KNRUB2, TEXT ' SENTENCE' KNRUB3, TEXT 'CURSOR' KNRUB4, TEXT 'BEGINNING OF' CMK31A, TEXT '&WHEN YOU PRESS &GOLD ' CMK31B, TEXT ' &D&E&CMATE' XTRL31=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL32=. X=DLHL32 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLRUBA, DISP;HLPLND TEXT '&SENTENCES END IN PERIODS, EXCLAMATION MARKS, AND QUESTION MARKS.' SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLTOPD, DISP;HLPLNS;TEXT '^S--';KNTOP1 DISP;HLPLNA;TEXT '^S^S,^S MOVES THE CURSOR TO^S' CMK32A;KNTOP1;CMK32B;CMK32C DISP;HLPLNB TEXT '^S. &THE SCREEN SHOWS A "!&^S !&FILING" MESSAGE UNTIL^S' CMK32D;CMK32D;CMK32B DISP;HLPLNC;TEXT 'REACHES THE^S ^S. &THE SCREEN THEN SHOWS ' CMK32C;CMK32D DISP;HLPLND;TEXT 'THE^S ^S.';CMK32C;CMK32D SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNTOP1, TEXT '!&TOP !&DOCMT';CMK32C;CMK32D CMK32A, TEXT '&WHEN YOU PRESS &GOLD ' CMK32B, TEXT ' &D&E&CMATE' CMK32C, TEXT ' TOP OF THE' CMK32D, TEXT 'DOCUMENT' XTRL32=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL33=. X=DLHL33 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMADV, DISP;HLPLNS;TEXT '^S--';KMADV1 DISP;HLPLNA;TEXT '^S^S,^SFORWARD TO THE NEXT CHARACTER.' CMK33A;KMADV1;KMC331 DISP;HLPLNB;TEXT '&IF ^S THE CURSOR';KMC332 DISP;HLPLNC;TEXT 'MOVES FORWARD ^SADVANCE PAST THE END';KMC334 DISP;HLPLND;TEXT 'OF ^S';KMC335 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMADV1, TEXT '!&ADVANCE' HMBACK, DISP;HLPLNS;TEXT '^S--';KMBAK1 DISP;HLPLNA;TEXT '^S^S,^SBACK TO THE LAST CHARACTER. &IF' CMK33A;KMBAK1;KMC331 DISP;HLPLNB;TEXT '^S^S';KMC332;KMC331 DISP;HLPLNC;TEXT 'BACK ^SBACK UP PAST THE BEGINNING OF';KMC334 DISP;HLPLND;TEXT '^S';KMC335 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMBAK1, TEXT '!&BACKUP' KMC331, TEXT ' THE CURSOR MOVES ' KMC332, TEXT 'YOU THEN PRESS !&WORD, !&LINE, !&PARA, OR ANOTHER DISTANCE KEY,' KMC334, TEXT 'THE SPECIFIED DISTANCE. &IF YOU TRY TO ' KMC335, TEXT 'THE DOCUMENT, THE KEYBOARD BUZZES.' CMK33A, TEXT '&WHEN YOU PRESS ' XTRL33=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC FIELD 3 *0 ADHL34=. X=DLHL34 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMBOLD, DISP;HLPLNS;TEXT '!&BOLD--' DISP;HLPLNA TEXT '&WHEN YOU PRESS !&BOLD, &D&E&CMATE STARTS BOLDING TEXT.' DISP;-1;TEXT ' &AS LONG AS YOU USE' DISP;HLPLNB TEXT 'DISTANCE KEYS TO MOVE THE CURSOR, ALL CHARACTERS THE CURSOR MOVES OVER' DISP;HLPLNC TEXT 'BECOME BOLDED. &IF YOU SELECT TEXT AND PRESS !&BOLD, THE SELECTED TEXT' DISP;HLPLND;TEXT 'BECOMES BOLDED.' SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 XTRL34=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL35=. X=DLHL35 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMDELC, DISP;HLPLNS;TEXT '^S--';CMK354 DISP;HLPLNA;TEXT '^S^S, ^STHE CHARACTER AT THE CURSOR.' CMC35A;CMK354;CMK351 DISP;HLPLNB;TEXT '&YOU ^S ^S&GOLD ^S' CMK352;CMK353;CMK354 DISP;HLPLNC;TEXT 'OR &GOLD ^S.';CMK355 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMDELW, DISP;HLPLNS;TEXT '^S--';CMK355 DISP;HLPLNA;TEXT '^S^S, ^SALL CHARACTERS FROM THE CURSOR TO' CMC35A;CMK355;CMK351 DISP;HLPLNB;TEXT 'THE BEGINNING OF THE NEXT WORD. &YOU ^S';CMK352 DISP;HLPLNC;TEXT '^S&GOLD ^S OR &GOLD ^S.' CMK353;CMK355;CMK354 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 CMK351, TEXT '&D&E&CMATE DELETES ' CMK352, TEXT 'CAN RECOVER THE LAST ITEM OF DELETED' CMK353, TEXT 'TEXT BY PRESSING ' CMK354, TEXT '!&DEL !&CHAR' CMK355, TEXT '!&DEL !&WORD' CMC35A, TEXT '&WHEN YOU PRESS ' XTRL35=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL36=. X=DLHL36 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMLINE, DISP;HLPLNS;TEXT '!&LINE--' DISP;HLPLNA;TEXT '^S!&LINE,^SLINE. &THE';CMK36A;KMC360 DISP;HLPLNB;TEXT '^S^S';KMC361;KMC362 DISP;HLPLNC;TEXT 'OR ^S';KMC363 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMPAGE, DISP;HLPLNS;TEXT '!&PAGE--' DISP;HLPLNA;TEXT '^S!&PAGE,^SPAGE-END MARK.';CMK36A;KMC360 DISP;HLPLNB;TEXT '&THE ^S^S';KMC361;KMC362 DISP;HLPLNC;TEXT 'OR ^S';KMC363 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMPARA, DISP;HLPLNS;TEXT '!&PARA--' DISP;HLPLNA;TEXT '^S!&PARA,^SPARAGRAPH. &THE';CMK36A;KMC360 DISP;HLPLNB;TEXT '^S^S';KMC361;KMC362 DISP;HLPLNC;TEXT 'OR ^S';KMC363 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMC360, TEXT ' THE CURSOR MOVES FORWARD TO THE NEXT ' KMC361, TEXT 'CURSOR MOVES BACKWARD IF THE LAST KEYS YOU' KMC362, TEXT ' PRESSED WERE THE !&BACKUP KEY' KMC363, TEXT 'THE !&BACKUP KEY FOLLOWED BY DISTANCE KEYS.' CMK36A, TEXT '&WHEN YOU PRESS ' XTRL36=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL37=. X=DLHL37 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMPAST, DISP;HLPLNS;TEXT '!&PASTE--' DISP;HLPLNA;TEXT '&USE THE !&PASTE KEY TO MOVE TEXT. &FIRST, SELECT' DISP;-1;TEXT ' THE TEXT YOU WANT TO MOVE' DISP;HLPLNB;TEXT 'AND !&CUT IT INTO THE PASTE AREA. ' DISP;-1;TEXT '&THEN MOVE THE CURSOR TO THE PLACE YOU' DISP;HLPLNC;TEXT 'WANT TO PUT THE TEXT. &PRESS !&PASTE. &D&E&CMATE' DISP;-1;TEXT ' COPIES THE TEXT, BUT NOT THE' DISP;HLPLND TEXT 'RULERS, INTO THE DOCUMENT, STARTING AT THE CURSOR POSITION.' SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 XTRL37=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL40=. X=DLHL40 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMSENT, DISP;HLPLNS;TEXT '!&SENT--' DISP;HLPLNA;TEXT '^S!&SENT^SBEGINNING OF THE NEXT';CMK40A;KMC401 DISP;HLPLNB;TEXT 'SENTENCE. ^S';KMC402 DISP;HLPLNC;TEXT '!&BACKUP KEY ^S';KMC403 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMTABP, DISP;HLPLNS;TEXT '!&TAB !&POS--' DISP;HLPLNA;TEXT '^S!&TAB !&POS^SNEXT TAB POSITION';CMK40A;KMC401 DISP;HLPLNB TEXT '-- THAT IS, THE NEXT PLACE IN THE DOCUMENT WHERE YOU PRESSED THE TAB KEY.' DISP;HLPLNC;TEXT '^S!&BACKUP KEY';KMC402 DISP;HLPLND;TEXT '^S';KMC403 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMC401, TEXT ', THE CURSOR MOVES FORWARD TO THE ' KMC402, TEXT '&THE CURSOR MOVES BACKWARD IF THE LAST KEYS YOU PRESSED WERE THE ' KMC403, TEXT 'OR THE !&BACKUP KEY FOLLOWED BY DISTANCE KEYS.' CMK40A, TEXT '&WHEN YOU PRESS ' XTRL40=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL41=. X=DLHL41 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMSEL, DISP;HLPLNS;TEXT '!&SEL--' DISP;HLPLNA;TEXT '^S!&SEL, A^S APPEARS AT THE CURSOR. &THE^S' CMK41A;KMSEL1;KMSEL1 DISP;HLPLNB;TEXT 'REMAINS IN PLACE WHEN YOU MOVE THE CURSOR. ' DISP;-1;TEXT '&TEXT BETWEEN THE MARK AND THE' DISP;HLPLNC TEXT 'CURSOR IS^S. &TO CANCEL THE MARK, PRESS !&SEL AGAIN. &YOU MAY' KMSEL2 DISP;HLPLND;TEXT 'CHANGE^S BY PRESSING !&BOLD, !&CUT, !&UNDERLINE,' KMSEL2 DISP;-1;TEXT ' OR !&UPPERCASE.' SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMSEL1, TEXT ' SELECT MARK' KMSEL2, TEXT ' SELECTED TEXT' CMK41A, TEXT '&WHEN YOU PRESS ' CMK41B, TEXT '&D&E&CMATE ' XTRL41=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL42=. X=DLHL42 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HMUPPE, DISP;HLPLNS;TEXT '^S--';HMUPP1 DISP;HLPLNA;TEXT '^S^S^S PUTTING TEXT IN^S LETTERS.' CMK42A;HMUPP1;KMC421;HMUPP2 DISP;HLPLNB;TEXT '^S ^S';KMC422;KMC423 DISP;HLPLNC;TEXT '^SBECOME^SIZED. ^S';KMC424;HMUPP2;KMC425 DISP;HLPLND;TEXT '^S, THE SELECTED TEXT BECOMES^SIZED.';HMUPP1;HMUPP2 SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMUPP1, TEXT '!&UPPERCASE' HMUPP2, TEXT ' CAPITAL' HMUNDE, DISP;HLPLNS;TEXT '^S--';HMUND1 DISP;HLPLNA;TEXT '^S^S^S^SING TEXT. ^S' CMK42A;HMUND1;KMC421;HMUND2;KMC422 DISP;HLPLNB;TEXT '^S^S';KMC423;KMC424 DISP;HLPLNC;TEXT 'BECOME^SED. ^S^S, THE SELECTED';HMUND2;KMC425;HMUND1 TRNSFR;-1-HLUNDA;DLHL43 HMUND1, TEXT '!&UNDERLINE' HMUND2, TEXT ' UNDERLIN' KMC421, TEXT ', &D&E&CMATE STARTS' KMC422, TEXT '&AS LONG AS YOU' KMC423, TEXT 'USE DISTANCE KEYS TO MOVE THE CURSOR, ALL CHARACTERS THE ' KMC424, TEXT 'CURSOR MOVES OVER ' KMC425, TEXT ' &IF YOU SELECT TEXT AND PRESS ' CMK42A, TEXT '&WHEN YOU PRESS ' XTRL42=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL43=. X=DLHL43 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLUNDA, DISP;HLPLND;TEXT 'TEXT BECOMES UNDERLINED.' SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMENTE, DISP;HLPLNS;TEXT '< >--' DISP;HLPLNA;TEXT '^S< >^SNEXT > CHARACTER.';CMK43A;KMC431 DISP;HLPLNB;TEXT '^S THE';KMC432 DISP;HLPLNC;TEXT '^S';KMC433 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HMWORD, DISP;HLPLNS;TEXT '!&WORD--' DISP;HLPLNA;TEXT '^S!&WORD^SBEGINNING OF THE';CMK43A;KMC431 DISP;HLPLNB;TEXT 'NEXT WORD. ^S';KMC432 DISP;HLPLNC;TEXT 'THE ^S';KMC433 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KMC431, TEXT ', THE CURSOR MOVES FORWARD TO THE ' KMC432, TEXT '&THE CURSOR MOVES BACKWARD IF THE LAST KEYS YOU PRESSED WERE' KMC433, TEXT '!&BACKUP KEY OR THE !&BACKUP KEY FOLLOWED BY DISTANCE KEYS.' CMK43A, TEXT '&WHEN YOU PRESS ' XTRL43=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL44=. X=DLHL44 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLLINS, DISP;HLPLNS;TEXT '^S--';HLK441 / INSERT HERE DISP;HLPLNA;TEXT '^S^S^S^S!&PASTE.';HLK442;HLK441;HLK440;HLK442 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNINSH, DISP;HLPLNS;TEXT '^S--';HLK441 / INSERT HERE DISP;HLPLNA;TEXT '^S^S!&PASTE.';HLK441;HLK440 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLLREM, DISP;HLPLNS;TEXT '^S--';HLK443 / GOLD: REMOVE DISP;HLPLNA;TEXT '^S^S^S^S!&CUT.';HLK442;HLK443;HLK440;HLK442 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNREMV, DISP;HLPLNS;TEXT '^S--';HLK443 / REMOVE DISP;HLPLNA;TEXT '^S^S!&CUT.';HLK443;HLK440 SET;7;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLLUP, DISP;HLPLNS;TEXT '^A (^S&UP^S--';HLK444;HLK442;HLK446 DISP;HLPLNA;TEXT '^S^A (^S&UP^S^S^S!&BACK !&UP.' HLK442;HLK444;HLK442;HLK446;HLK440;HLK442 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLLDN, DISP;HLPLNS;TEXT 'V (^S&DOWN^S--';HLK442;HLK446 DISP;HLPLNA;TEXT '^SV (^S&DOWN^S^S^S!&ADVANCE.' HLK442;HLK442;HLK446;HLK440;HLK442 SET;2;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLK440, TEXT ' PERFORMS THE SAME FUNCTION AS ' HLK441, TEXT '!&INSERT !&HERE' HLK442, TEXT '&GOLD ' HLK443, TEXT '!&REMOVE' HLK444, 136;0 / UP ARROW HLK446, TEXT ' &ARROW)' XTRL44=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL45=. X=DLHL45 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLLLF, DISP;HLPLNS;TEXT '<- (^S&LEFT^S--';HLK455;HLK456 DISP;HLPLNA;TEXT '^S^S<- (^S&LEFT^S^S' CMK45A;HLK455;HLK455;HLK456;HLK458 DISP;HLPLNB;TEXT 'ON THE FIRST^S';HLK459 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLLRT, DISP;HLPLNS;TEXT '-> (^S&RIGHT^S--';HLK455;HLK456 DISP;HLPLNA;TEXT '^S^S-> (^S&RIGHT^S^S' CMK45A;HLK455;HLK455;HLK456;HLK458 DISP;HLPLNB;TEXT 'ON THE LAST^S';HLK459 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNFIND, DISP;HLPLNS;TEXT '^S--';HLK457 / FIND DISP;HLPLNA;TEXT '^S^S^S!&SRCH.';HLK457;HLK450;HLK455 SET;16;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNSEL, DISP;HLPLNS;TEXT '^S--';HLK452 DISP;HLPLNA;TEXT '^S^S!&SEL';HLK452;HLK450 SET;6;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLK450, TEXT ' PERFORMS THE SAME FUNCTION AS ' HLK452, TEXT '&S&E&L&E&C&T' HLK455, TEXT '&GOLD ' HLK456, TEXT ' &ARROW)' HLK457, TEXT '&F&I&N&D' HLK458, TEXT ', &D&E&CMATE POSITIONS THE CURSOR' HLK459, TEXT ' EDITABLE CHARACTER ON THE LINE.' CMK45A, TEXT '&WHEN YOU PRESS ' XTRL45=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL46=. X=DLHL46 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HNHYPP, DISP;HLPLNS;TEXT '^S--';HLK462 / HYPH PULL DISP;HLPLNA;TEXT '^S^S,^S PUSHES A CHARACTER UP TO THE' CMK46A;HLK462;CMK46B DISP;HLPLNB;TEXT 'PREVIOUS LINE FROM THE LINE THE CURSOR IS ON.' SET;10;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLSPAC, DISP;HLPLNS;TEXT '^S--';HLK465 /M011 DISP;HLPLNA;TEXT '^S^S^S,^S INSERTS A^SINTO' CMK46A;HLK464;HLK465;CMK46B;HLK468 DISP;HLPLNB;TEXT 'THE DOCUMENT AT THE CURRENT CURSOR POSITION.' DISP;-1;TEXT ' &A^SJOINS';HLK468 DISP;HLPLNC;TEXT 'THE TWO WORDS ON EITHER SIDE INTO ONE ' DISP;-1;TEXT 'CONSTRUCT, TREATED AS A SINGLE WORD, ' DISP;HLPLND;TEXT 'THAT MAY NOT BE SPLIT ACROSS A LINE ENDING.' SET;10;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLK462, TEXT '!&HYPH !&PUSH' HLK464, TEXT '&GOLD ' HLK465, TEXT '&SPACE' HLK468, TEXT ' NON-BREAKING SPACE ' CMK46A, TEXT '&WHEN YOU PRESS ' CMK46B, TEXT ' &D&E&CMATE' XTRL46=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL47=. X=DLHL47 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HNUP, DISP;HLPLNS;TEXT '^A (&UP^S--';HLK471;HLK473 DISP;HLPLNA;TEXT '^S^A (&UP^S^SPREVIOUS' CMK47A;HLK471;HLK473;HLK476 DISP;HLPLNB;TEXT '^S^S^S' HLK477;HLK478;HLK479 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNDN, DISP;HLPLNS;TEXT 'V (&DOWN^S--';HLK473 DISP;HLPLNA;TEXT '^SV (&DOWN^S^SNEXT' CMK47A;HLK473;HLK476 DISP;HLPLNB;TEXT '^S^S^S';HLK477;HLK478;HLK479 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLK471, 136;0 /= UP ARROW HLK473, TEXT ' &ARROW)' HLK476, TEXT ', &D&E&CMATE MOVES THE CURSOR TO THE ' HLK477, TEXT 'LINE ' HLK478, TEXT 'OF THE DOCUMENT, LEAVING IT IN ' HLK479, TEXT 'THE CURRENT COLUMN POSITION.' CMK47A, TEXT '&WHEN YOU PRESS ' XTRL47=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL50=. X=DLHL50 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HNPREV, DISP;HLPLNS;TEXT '^S^S--';HLK501;HLK503 DISP;HLPLNA;TEXT '^S^S^S^SBACKWARD^S' CMK50A;HLK501;HLK503;HLK504;HLK505 DISP;HLPLNB;TEXT '^S^S';HLK506;HLK507 DISP;HLPLNC;TEXT '^S^S';HLK508;HLK509 DISP;HLPLND;TEXT '^S';HLK50A SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNNEXT, DISP;HLPLNS;TEXT '^S^S--';HLK502;HLK503 DISP;HLPLNA;TEXT '^S^S^S^SFORWARD^S' CMK50A;HLK502;HLK503;HLK504;HLK505 DISP;HLPLNB;TEXT '^S^S';HLK506;HLK507 DISP;HLPLNC;TEXT '^S^S';HLK508;HLK509 DISP;HLPLND;TEXT '^S';HLK50A SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 CMK50A, TEXT '&WHEN YOU PRESS ' HLK501, TEXT '!&PREV ' HLK502, TEXT '!&NEXT ' HLK503, TEXT '!&SCREEN' HLK504, TEXT ', &D&E&CMATE SCROLLS ' HLK505, TEXT ' THROUGH THE DOCUMENT' HLK506, TEXT 'A NUMBER OF LINES EQUAL TO THE NUMBER OF ' HLK507, TEXT 'LINES THAT CAN CURRENTLY BE' HLK508, TEXT 'DISPLAYED, DEPENDING ON THE DOCUMENT VIEW ' HLK509, TEXT 'WIDTH. &THE CURSOR IS LEFT' HLK50A, TEXT 'AT THE START OF THE LINE.' XTRL50=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL51=. X=DLHL51 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HNLF, DISP;HLPLNS;TEXT '<- (&LEFT^S--';HLK513 DISP;HLPLNA;TEXT '<- (&LEFT^S^S!&BACKUP.';HLK513;HLK510 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HNRT, DISP;HLPLNS;TEXT '-> (&RIGHT^S--';HLK513 DISP;HLPLNA;TEXT '-> (&RIGHT^S^S!&ADVANCE.';HLK513;HLK510 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 HLK510, TEXT ' PERFORMS THE SAME FUNCTION AS ' HLK513, TEXT ' &ARROW)' XTRL51=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL52=. X=DLHL52 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLRUBC, DISP;HLPLNS;TEXT '^S--';KNRBC1 DISP;HLPLNA;TEXT '^S^S,^S ERASES THE CHARACTER BEFORE^S.' CMK52A;KNRBC1;CMK52B;KNRBC2 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNRBC1, IFDEF CONDOR < TEXT '&RUBOUT' > / END IFDEF CONDOR IFNDEF CONDOR < TEXT '!&RUB !&CHAR !&OUT' > / END IFNDEF CONDOR KNRBC2, TEXT ' THE CURSOR' HLRUBW, DISP;HLPLNS;TEXT '^S--';KNRBW1 DISP;HLPLNA;TEXT '^S^S,^S ERASES ALL TEXT BETWEEN^S' CMK52A;KNRBW1;CMK52B;KNRBC2 DISP;HLPLNB;TEXT 'AND THE ^S THE CURRENT^S. &IF^S IS AT THE' KNRBW2;KNRBW3;KNRBC2 DISP;HLPLNC;TEXT '^S A^S,^S ERASES THE PRECEEDING^S.' KNRBW2;KNRBW3;CMK52B;KNRBW3 SET;4;MNTMP2 TRNSFR;-1-HLPRET;DLHL02 KNRBW1, IFDEF CONDOR < TEXT '!&CTRL &RUBOUT' > / END IFDEF CONDOR IFNDEF CONDOR < TEXT '!&RUB !&WORD !&OUT' > / END IFNDEF CONDOR KNRBW2, TEXT 'BEGINNING OF' KNRBW3, TEXT ' WORD' CMK52A, TEXT '&WHEN YOU PRESS ' CMK52B, TEXT ' &D&E&CMATE' XTRL52=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC ADHL53=. X=DLHL53 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLTAB, DISP; HLPLNS; TEXT '^S--';WRDTAB DISP;HLPLNA TEXT '&WHEN YOU PRESS ^S, &D&E&CMATE CREATES A NEW RULER WITH A^S' GLDTAB;WRDWAP DISP;HLPLNB TEXT 'INDENT AT ^SPOSITION. &ANY OLD^SSETTING IN THE RULER' THECUR;WRDWAP DISP;HLPLNC;TEXT 'BECOMES A TAB SETTING. &NO OTHER SETTINGS CHANGE.' SET; 5; MNTMP2 TRNSFR; -1-HLPRET; DLHL02 HLTABP, DISP; HLPLNS;TEXT '^S !&POS--';WRDTAB DISP;HLPLNA TEXT '&TO REMOVE A^S IN A TABLE, PUT THE SELECT MARK AT ONE END AND' HLTCOL DISP;HLPLNB;TEXT '^SAT THE OTHER, THEN PRESS ^S !&POS, THEN !&CUT.' THECUR;GLDTAB DISP;HLPLNC;TEXT '&TO INSERT A^S, PUT ^SWHERE YOU WANT THE^S TO GO' HLTCOL;THECUR;HLTCOL DISP;HLPLND;TEXT 'AND PRESS ^S !&POS, THEN !&PASTE.' GLDTAB SET; 7; MNTMP2 TRNSFR; -1-HLPRET; DLHL02 HLTCOL, TEXT ' COLUMN' THECUR, TEXT 'THE CURSOR ' WRDWAP, TEXT ' WORD-WRAP ' GLDTAB, TEXT '&GOLD ' *.-1 / BACK UP ONE SPACE WRDTAB, TEXT '!&TAB' / CONTINUE WITH TEXT FOR GOLD TAB XTRL53=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 RELOC FIELD 4 *0 ADHL54=. X=DLHL54 / INDICATE DISK BLOCK WHERE MENU IS LOADED RELOC 0 HLALTC, DISP;HLPLNS;TEXT '^S--';ALTCHR DISP;HLPLNA TEXT '&USED TO ENTER^SS SUCH AS &GREEK LETTERS OR MATHEMATICAL';ACHRTX DISP;HLPLNB TEXT 'SYMBOLS. &PRESS ^S, THEN THE KEY FOR THE^S YOU';ALTCHR;ACHRTX DISP;HLPLNC;TEXT 'WANT.' SET; 23; MNTMP2 TRNSFR; -1-HLPRET; DLHL02 HLUDK, DISP;HLPLNS;TEXT '!&UDK--' DISP;HLPLNA;TEXT '&USED TO RUN A USER-DEFINED KEY.' DISP;-1;TEXT ' &PRESS !&UDK, ENTER THE NUMBER FOR THE KEY' DISP;HLPLNB;TEXT 'YOU WANT, THEN PRESS !&RETURN. ' DISP;-1;TEXT '&D&E&CMATE RUNS THE KEYSTROKES STORED IN THAT' DISP;HLPLNC;TEXT 'KEY.' SET; 20; MNTMP2 TRNSFR; -1-HLPRET; DLHL02 ACHRTX, TEXT ' ALTERNATE CHARACTER' ALTCHR, TEXT '!&ALT !&CHAR' / HLRWRD, DISP;HLPLNS;TEXT '!&RUB !&WORD--' / DISP;HLPLNA / TEXT '&ERASES THE WORD TO THE LEFT OF THE CURSOR.' / SET; 2; MNTMP2 / TRNSFR; -1-HLPRET; DLHL02 XTRL54=400-. / FREE SPACE REMAINING ON PAGE IFZERO .-401&4000 XXXXXX, / END OF MENUES   / DECmate II - SETUP mode / ------------------------------------------------------------------------- / E_D_I_T H_I_S_T_O_R_Y / /019 EMcD 25-Sep-85 Add Dutch and Spanish Xlations (conditional) /018 EMcD 12-Sep-85 Allow DO key (its now the UDK key and causes / problems as entry of a discrete char !) /017 EMcD 12-Sep-85 Add Nordic translations (conditionalised) /016 Mart 01-aug-85 Fix ITALIAN assembly bugs / change ITALIAN boud to baud / change NERO BIANCO to NORMALE INVERSO /015 EMcD 26-Mar-85 Two new terminal types & fix VT125 message /014 EMcD 12-Mar-85 Set term to Lvl2 8 bit /013 TCW 16-JUL-84 Expand # of terminal modes /012 JFS 19-JUN-84 DM-III changes /011 FJL 19-JAN-84 Deleted "cursor (in)visibilty" feature / Removed old edit histories / ------------------------------------------------------------------------- / *****ORDER***** ***** IMP ***** ORT ***** ANT ***** FIELD 0 *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOSET; 100; CDF 30; -DSOSET 0 FIELD 3 *100 CDFMYF= CDF 30 / THIS field K0006, 6 / K0007, 7 / K0017, 17 / T4, ZBLOCK 1 / CURSOR, 0 / increments (always positive) SETUVL, 0 / THE "NON-REAL" SET-UP-VALUE / ---------------------------------------------------------------------------- / NOTE: that return from a PR3 request is with the ac=???? (unknown) / --yes it's sloppy so we must "CLA" after each PR3 sequence / PR3= 6236 / firmware "PANEL REQUEST" #3 / ---------------------------------------------------------------------------- / NOTE: "MNSECN" is not applicable for DECmate II / (because only one communications port on DECmate II) / / --------------------------------- / SET-UP-VALUE, | |H05| 6 | 7 | 8 | 9 | 10|H11| / --------------------------------- / | | | | | | | / | | | | | | SCREEN WIDTH (0=80, 1=132) / | | | | | | / | | | | | Cursor style (0=block, 1=underline) / | | | | Cursor Visibility (0=visible, 1=invis.) / | | | Scrolling (0=fast, 1=slow) / | | Screen Mode (0=Normal, 1=reverse) / | keyboard keyclick (0=ON, 1=OFF) / | / TERMINAL MODE (0=ANSI, 1=VT52) / / NOTE: that bit positions H05 and H11 are not modified within "SETUP" / because 132 column mode is a function of the EDITOR wide ruler / and terminal mode is set in the Systems Options Menu / they are only defined here to correspond to the hardware bit positions / within program location 24 of field 0 of panel memory, / / program location 25 is the printer baud rate (bits 8-11), / program location 26 is the comm baud rate (bits 8-11). SETUPV=MNSECN-MNABRV+CU4BF1 / DEFINE LOCATION FOR SET-UP-VALUES X=. / INDICATE FIRST FREE LOCATION ON PAGE /----------- PAGE / "SETUP" screen display /line1 TERMINAL CHARACTERISTIC SETUP MENU (single height/double width) /line2 /line3 /line4 Cursor Style Block Underline /line5 Cursor Visibility Visible Invisible /line6 Scrolling Jump Smooth /line7 Screen Mode Normal Reverse /line8 Keyclick ON OFF /line9 /line10 /line11 Press ADVANCE or BACKUP to step thru the selections, /line12 SEL to select a terminal characteristic, /line13 /line15 RETURN to leave this menu, using characteristice until next SETUP, /line16 ENTER to leave this menu, fixing characteristice until next ENTER, /line17 DO to use a new system diskette. /line18 /line19 Terminal Mode is set to a ?????? and may be changed in the /line20 SO (System Options) menu. /line22 The Printer is set to ???? baud. /line23 Communications is set to ???? baud. /line24 Baud rates may be changed in the SO CC (Communication Settings) menu, /line24 / ENTER here from "MAIN MENU" SETUP, XX / AC0001 / Set flag active /A018 CDFSYS / Point to System field /A018 DCA I (STUACF) / And say SETUP is active /A018 CDFMYF / now back to here /A018 / READ the "systems options" disk block (DLSVAL) / TAD (RXERD) / "READ" the systems option block (DLSVAL) JMS CU4ST / (into "CU4BF1") / / setup lines 19, 22, and 23 / / /D013 AC6000 / /D013 AND I (MNPRTB-MNABRV+CU4BF1) /D013 CLL RTL / /D013 RAL / TAD I (MNPRTB-MNABRV+CU4BF1) / FETCH PACKED WORD /A013 RTL / TM IS NOW 3 BITS /A013 RTL / /A013 AND (7) / /A013 TAD (TMTABL) / TERMINAL MODE TABLE DCA LIN19B / TAD I (MNPRTB-MNABRV+CU4BF1) AND K0017 / TAD (BAUDTB) / BAUD RATE TABLE DCA LIN22B / PRINTER BAUD RATE FROM USER "SO CC" SELECTION TAD I (MNPRIM-MNABRV+CU4BF1) AND K0017 / TAD (BAUDTB) / BAUD RATE TABLE DCA LIN23B / COMM BAUD RATE FROM USER "SO CC" SELECTION JMS INVISI / (make the cursor "INVISIBLE" for SETUP menu) CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL / CALL SYSTEM ROUTINE TO DISPLAY MESSAGE 0 / USE DEFAULT OUTPUT ROUTINE SETUPC / IOA "control" string IFDEF ENGLSH < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > IFDEF ITALIAN < ERASE / ^A 0105 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0310; LIN3A / ^P ^S / Cursor Style 0410; LIN4A / ^P ^S / Scrolling 0510; LIN5A / ^P ^S / Screen Mode 0610; LIN6A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1001; LIN8 / ^P ^S / 'PREMERE:' 1110; LIN9 / ^P ^S / 'AVANTI O INDIETRO...ETC.' 1210; LIN10 / ^P ^S / 'DESIDERATA.' 1310; LIN11 / ^P NS)MENU 0310; LIN3A / ^P ^S / Cursor Style 0410; LIN4A / ^P ^S / Scrolling 0510; LIN5A / ^P ^S / Screen Mode 0610; LIN6A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1001; LIN8 / ^P ^S / 'PREMERE:' 1110; LIN9 / ^P ^S / 'AVANTI O INDIETRO...E---------- 2101; LIN17L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN17R / ^S / / --------------------------------------------------------------------------- 2201; LIN18L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN18R / ^S / / --------------------------------------------------------------------------- 2301; LIN19L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN19R / ^S / / --------------------------------------------------------------------------- 2401; LIN20 / ^P ^S / IL TIPO TERMINALE...ETC. 2501; LIN21 / ^P ^S / IS (IMPOSTAZIONE SISTEMA)...ETC. 2601; LIN22 / ^P ^S / LE AELOCITA'...ETC. 2701; LIN23 / ^P ^S / IS CS (PARAMETRI...ETC. > / -- end --order -- important --/ IFDEF V30NOR < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > IFDEF V30SWE < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > / END IFDEF V30SWE IFDEF SPANISH < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L/ ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > IFDEF FRENCH < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > IFDEF DUTCH < ERASE / ^A 0101 / ^P / (really 0102 because of "double width" text) LIN1X / ^A / (ESC seq makes single height/double width) LIN1 / ^S / USER SELECTIONS MENU 0410; LIN4A / ^P ^S / Cursor Style 0510; LIN6A / ^P ^S / Scrolling 0610; LIN7A / ^P ^S / Screen Mode 0710; LIN8A / ^P ^S / keyclick / --------------------------------------------------------------------------- 1202; LIN11 / ^P ^S / 'PRESS ADVANCE...ETC.' 1302; LIN12 / ^P ^S / 'SEL TO SELECT...ETC.' 1502; LIN14 / ^P ^S / 'PRESS:' 1610; LIN15 / ^P ^S / 'RETURN TO LEAVE...ETC.' 1710; LIN16 / ^P ^S / 'ENTER TO LEAVE...ETC.' 2010; LIN17 / ^P ^S / 'DO TO USE...ETC.' / --------------------------------------------------------------------------- 2202; LIN19L / ^P ^S / SETRVS / ^A / LIN19B, 0 / !S / TERMINAL MODE user selection from "SO" CLRRVS / ^A / LIN19R / ^S / 2302; LIN20 / ^P^S / / --------------------------------------------------------------------------- 2502; LIN22L / ^P ^S / SETRVS / ^A / LIN22B, 0 / !S / PRINTER BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN22R / ^S / / --------------------------------------------------------------------------- 2602; LIN23L / ^P ^S / SETRVS / ^A / LIN23B, 0 / !S / COMM BAUD RATE user selection from "SO CC" CLRRVS / ^A / LIN23R / ^S / 2702; LIN24 / ^P ^S / > TAD SETUPV / GET "GLOBAL" VALUE AND (7703) / SAVE BITS DCA T4 / TAD SETUPV / AND (0070) / GET "SETUP" BITS RAR / MOVE TO ALIGN WITH DISPLAY TAD T4 / RESTORE OTHER BITS DCA SETUVL / STORE FOR THIS ROUTINE "LOCAL" JMP LOOP / / E X I T terminal characteristics "SETUP" mode EXIT, CLA / Get rid of the crap /A018 CDFSYS / Point to system field /A018 DCA I (STUACF) / Clear SETUP busy flag /A018 CDIMNU / CHANGE DATA AND INSTRUCTION FIELD JMP I SETUP / BACK TO MAIN MENU X=. / INDICATE FIRST FREE LOCATION ON PAGE /----------- PAGE / Fill in the "BLANKS" of the screen display LOOP, TAD CURSOR / CMA / DCA T4 / TAD (BLANKT) / BLANK TABLE DCA BLANKP / BLANK POSSITION TAD BLANKP / IAC / DCA BLANKL / BLANK LINE NUMBER TAD SETUVL / LOCAL SET-UP-VALUES WORD DCA T1 / TAD (ENDBLA-BLANKT%4) / CIA / DCA T2 / -6 /-4 LOOPA, TAD (-2) / DCA T3 / AC0002 / AND T1 / SNA CLA / JMS SETRV / Force only "REVERSE VIDEO" attribute JMP .+5 / LOOPB, AC0002 / AND T1 / SZA CLA / JMS SETRV / Force only "REVERSE VIDEO" attribute ISZ T4 / SKP CLA / JMS SETBLI / Append "BLINK" to active cursor position CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL / CALL SYSTEM DISPLAY ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE BLANKC / (Control string for blank lines) BLANKP, ZBLOCK 1 / !P / ADDRESS OF "^P" POSITION BLANKL, ZBLOCK 1 / !S / "ADDRESS OF ADDRESS" OF STRING JMS CLRRV / Set video to NORMAL AC0002 / TAD BLANKP / DCA BLANKP / AC0002 / TAD BLANKL / DCA BLANKL / ISZ T3 / JMP LOOPB / JMS T1DIV2 / ISZ T2 / JMP LOOPA / JMP LOOPC / CIFSYS JWAIT / LOOPC, CIFSYS XLTIN / JMP .-4 / TAD (-EDNWLN) / SNA / JMP KEYRET / User pressed "RETURN" TAD (EDNWLN-EDUDKY) / Fixed DO key to be USK key while I was / here /M017 SNA / JMP KEYDO / User pressed "DO" TAD (EDUDKY-EDSLCT) / SNA / JMP KEYSEL / User pressed "SELECT" TAD (EDSLCT-EDENTR) / SNA / JMP KEYENT / User pressed "ENTER" TAD (EDENTR-EDADVN) / SNA / JMP .+5 / User pressed "ADVANCE" (or "right arrow") TAD (EDADVN-EDBKUP) / SZA CLA / JMP LOOPC / User pressed an unknown key AC7776 / -2 / User pressed "BACKUP" IAC / +1 / AC = +1 OR -1 now TAD CURSOR / SPA / TAD (ENDBLA-BLANKT%2) / DCA CURSOR / TAD (ENDBLA-BLANKT%2-1)/ CIA / TAD CURSOR / SMA SZA CLA / DCA CURSOR / "Cursor position" = 0 now JMP LOOP / / The user pressed key "ENTER" KEYENT, TAD (RXEWT) / "WRITE" SYSTEM OPTION BLOCK (DLSVAL) JMS CU4ST / / Put the "setupvalues" into program location "mubuf+mnsecn" / (else when the user goes into the "SO" menu it will be clobbered) / The user pressed key "RETURN" KEYRET, JMP SETTC / Set the terminal characteristics / The user typed "SELECT" / IF the cursorposition is ODD then clear left column / ELSE the cursor position is EVEN to clear right column KEYSEL, TAD CURSOR / CLL RAR / (Divide by 2 gets "line #") CMA / DCA T4 / STL / RAL / RAL / ISZ T4 / JMP .-2 / DCA T4 / TAD CURSOR / CLL RAR / (Link is used) CLA / TAD T4 / CMA / AND SETUVL / LOCAL SET-UP-VALUES SZL / TAD T4 / DCA SETUVL / JMP REMAP / / ROTATE THE CONTENTS OF PROGRAM LOCATION "T1" ONCE TO THE RIGHT T1DIV2, XX / TAD T1 / CLL RAR / DCA T1 / JMP I T1DIV2 / X=. / INDICATE FIRST FREE LOCATION ON PAGE /----------- PAGE / REMAP BITS FROM SETUPV,TO CONFORM WITH / NEW DISPLAY (NO 'CURSOR VISIBILITY') REMAP, CLL CLA / BE SURE TAD SETUVL / AND (7703) / M7703 SAVE ALL BITS BUT B7-B9 DCA T4 / STORE TAD SETUVL / AND (0034) / M0034, CAPTURE B7-B9 RAL / REPOSITION TO MATCH NEW DISPLAY TAD T4 / ADD IN UNCHANGED BITS DCA SETUPV / SAVE REMAPPED BITS IN THE "REAL" SETUPVALUE JMP LOOP / RETURN FROM 'SELECT' ROUTINE BLANKC, TEXT \!P!S\ / CONTROL STRING TO BLANK LINES BLANKT, IFDEF ITALIAN < /a016 0340; LIN3B / Block 0360; LIN3C / Underline 0440; LIN4B / Jump 0460; LIN4C / Smooth 0540; LIN5B / Normal 0560; LIN5C / Reverse 0640; LIN6B / ON 0660; LIN6C / OFF > /a016 IFDEF ENGLSH < /a016 0440; LIN4B / Block /a016 0460; LIN4C / Underline /a016 0540; LIN6B / Jump /a016 0560; LIN6C / Smooth /a016 0640; LIN7B / Normal /a016 0660; LIN7C / Reverse /a016 0740; LIN8B / ON /a016 0760; LIN8C / OFF /a016 > IFDEF V30NOR < 0440; LIN4B / Block /a016 0460; LIN4C / Underline /a016 0540; LIN6B / Jump /a016 0560; LIN6C / Smooth /a016 0640; LIN7B / Normal /a016 0660; LIN7C / Reverse /a016 0740; LIN8B / ON /a016 0760; LIN8C / OFF /a016 > IFDEF V30SWE < 0440; LIN4B / Block /a016 0460; LIN4C / Underline /a016 0540; LIN6B / Jump /a016 0560; LIN6C / Smooth /a016 0640; LIN7B / Normal /a016 0660; LIN7C / Reverse /a016 0740; LIN8B / ON /a016 0760; LIN8C / OFF /a016 > / END IFDEF V30SWE IFDEF DUTCH < 0440; LIN4B / Block /a016 0460; LIN4C / Underline /a016 0540; LIN6B / Jump /a016 0560; LIN6C / Smooth /a016 0640; LIN7B / Normal /a016 0660; LIN7C / Reverse /a016 0740; LIN8B / ON /a016 0760; LIN8C / OFF /a016 > / END IFDEF V30SWE IFDEF SPANISH < 0440; LIN4B / Block /a016 0460; LIN4C / Underline /a016 0540; LIN6B / Jump /a016 0560; LIN6C / Smooth /a016 0640; LIN7B / Normal /a016 0660; LIN7C / Reverse /a016 0740; LIN8B / ON /a016 0760; LIN8C / OFF /a016 > / END IFDEF V30SWE ENDBLA=. / END OF BLANK TABLE BAUDTB, B50; B75; B110; B134; B150; B300; B600; B1200 B1800; B2000; B2400; B3600; B4800; B7200; B9600; B19200 B50, TEXT \50\ B75, TEXT \75\ B110, TEXT \110\ B134, TEXT \134.5\ B150, TEXT \150\ B300, TEXT \300\ B600, TEXT \600\ B1200, TEXT \1200\ B1800, TEXT \1800\ B2000, TEXT \2000\ B2400, TEXT \2400\ B3600, TEXT \3600\ B4800, TEXT \4800\ B7200, TEXT \7200\ B9600, TEXT \9600\ B19200, TEXT \19200\ PAGE CU4ST, XX DCA QUQBLK+RXQFNC / SET THE FUNCTION CDFMYF TAD .-1 / SET THE DATA FIELD TO THIS FIELD DCA QUQBLK+RXQBFD DCA QUQBLK+RXQDRV / SET THE DRIVE TO ZERO TAD (DLSVAL) / SET THE BLOCK TO READ DCA QUQBLK+RXQBLK TAD (CU4BF1) / SET THE BUFFER TO READ INTO DCA QUQBLK+RXQBAD JMS QURX / GET THE BLOCK CLA JMP I CU4ST / THIS IS THE QUEUE ROUTINE TO RXHAN. THE REQUEST IS IN QUQBLK / USED BY DELETE AND SYSTEM OPTIONS QURX, XX CIFSYS / ++++ ENQUE / ++++ QUBLK CIFSYS / ++++ JWAIT TAD QUQBLK+RXQCOD SNA / ++++ JMP .-4 JMP I QURX QUBLK, DSKQUE / ++++ 0 / ++++ 0 QUQBLK, ZBLOCK 17 / This code issues a PR3 request to panel memory to set the WPS user / defined terminal characteristics into panel memory program locations / 24, 25, and 26 thereby powering up to the WPS characteristics /d016PR3= 6236 / PANEL MEMORY REQUEST SEQUENCE #3 / set the wps defined terminal characteristice into the terminal / REMEMBERING THAT SCREEN WIDTH IS FORCED TO 80 COLUMNS / AND TERMINAL MODE IS FORCED TO ANSI SETTC, TAD SETUPV / GET THE REMAPPED BITS CDFMNU DCA I (MUBUF+MNSECN) / TAD I (MUBUF+MNSECN) / Terminal characterics from "SETUP" TAD (1200) / Set to Lvl 2 , 8 bit /A014 DCA PRQBLK / TERMINAL CHARACTERISTICS TAD I (MUBUF+MNPRTB) / Printer baud rate AND K0017 / DCA PRQBLK+1 / PRINTER BAUD RATE TAD I (MUBUF+MNPRIM) / Communications baud rate AND K0017 / DCA PRQBLK+2 / COMMUNICATIONS BAUD RATE CDFMYF PRQ3 / EXECUTE PANEL REQUEST /a016 4003 / 40 (dest field 0) (src field 3) PRQBLK / Source starting address 24 / Destination starting address -3 / Three words to move 7777 / PR3 terminator CLA / (Just in case ac dirty after prq) / issue the escape sequence "ESC c" to the terminal / which will 'reset the terminal characteristics' CIFMNU / CHANGE TO MENU FIELD JMS I IOACAL / CALL SYSTEM OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT ROUTINE CONTRL / RESTOR / JMP EXIT / EXIT setup mode RESTOR, ESC; "c&177; 0 / RESTORE TERMINAL CHARACTERISTIC SEQ PRQBLK, ZBLOCK 3 / The user pressed key "DO" / (Issue a PRQ3 request to the firmware to reboot the system /m016 KEYDO, AC0000; 6750 / Select diskette drive pair 0 AC0000 / PRQ3 / /m016 5 / 7777 / Terminator HLT / SHOULD NEVER HALT HERE X=. / INDICATE FIRST FREE LOCATION ON PAGE /----------- PAGE / SET REVERSE VIDEO for active cursor position SETRV, XX / CIFMNU / JMS I IOACAL / 0 / CONTRL / SETRVS / JMP I SETRV / / CONTRL, TEXT \^A\ / SETRVS, ESC; "[&177; "0&177; ";&177; "7&177; "m&177; 0 / CLEAR ALL ATTRIBUTES for active cursor position CLRRV, XX / CIFMNU / JMS I IOACAL / 0 / CONTRL / CLRRVS / JMP I CLRRV / / CLRRVS, ESC; "[&177; "0&177; "m&177; 0 / SET CURSOR INVISIBLE INVISI, XX CIFMNU JMS I IOACAL 0 CONTRL CURS0R JMP I INVISIBLE / CURS0R, ESC; "[&177; "?&177; "2&177; "5&177; "l&177; 0 / SET CURSOR VISIBLE VISIBL, XX / CIFMNU / JMS I IOACAL / 0 / CONTRL / CURS1R / JMP I VISIBLE / / CURS1R, ESC; "[&177; "?&177; "2&177; "5&177; "h&177; 0 / APPEND "BLINK" and "BOLD" attributes for the active cursor position SETBLI, XX / CIFMNU / JMS I IOACAL / 0 / CONTRL / SETSEQ / JMP I SETBLINK / / SETSEQ, / (bold) (blink) ESC; "[&177; "1&177; ";&177; "5&177; "m&177; 0 SETCHA, XX / DCA .+5 / CIFMNU / JMS I IOACAL / 0 / CONTRL / ^A / ZBLOCK 1 / JMP I SETCHA / ------ / |NOTE| - 80 COLUMN is forced cause 132 column is a function of "wide ruler" / ------ COL80S, / Screen width / 80 ESC; "[&177; "?&177; "3&177; "l&177; 0 / -------- ORDER IMPORTANT -------- / VSEQUE, / Cursor visibility / Visible ESC; "[&177; "?&177; "2&177; "5&177; "h&177; 0 / Invisible ESC; "[&177; "?&177; "2&177; "5&177; "l&177; 0 SCRLSE, / Scroll mode / Fast ESC; "[&177; "?&177; "4&177; "l&177; 0 / Slow ESC; "[&177; "?&177; "4&177; "h&177; 0 MODESE, / Video / Normal ESC; "[&177; "?&177; "5&177; "l&177; 0 / Reverse ESC; "[&177; "?&177; "5&177; "h&177; 0 / ---- END ORDER IMPORTANT ---- IFDEF ENGLSH < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 4 *.-1 TEXT \^P^S\ / CONTROL for lines 5 and 6 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 7 and 8 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 11,12,14,15,16,17 *.-1 TEXT \^P^S^A!S^A^S^P^S\/ CONTROL for line 19 (L and R) and 20 *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 22 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 23 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, ESC; "#&177; "6&177; 0 / (Text is single H/double W) LIN1, TEXT \&T&E&R&M&I&N&A&L &C&H&A&R&A&C&T&E&R&I&S&T&I&C&S &S&E&T&U&P &M&E&N&U\ LIN4A, TEXT \&CURSOR &STYLE\ LIN4B, TEXT \&BLOCK\ LIN4C, TEXT \&UNDERLINE\ LIN6A, TEXT \&SCROLLING\ LIN6B, TEXT \&JUMP\ LIN6C, TEXT \&SMOOTH\ LIN7A, TEXT \&SCREEN &BACKGROUND\ LIN7B, TEXT \&BLACK\ LIN7C, TEXT \&WHITE\ LIN8A, TEXT \&KEYCLICK\ LIN8B, TEXT \&ON\ LIN8C, TEXT \&OFF\ LIN11, TEXT \&PRESS &A&D&V&A&N&C&E OR &B&A&C&K&U&P TO\ *.-1 TEXT \ STEP THRU THE SELECTIONS, AND PRESS\ LIN12, TEXT \&S&E&L TO SELECT A TERMINAL CHARACTERISTIC.\ LIN14, TEXT \&PRESS:\ LIN15, TEXT \&R&E&T&U&R&N TO LEAVE THIS MENU \ *.-1 TEXT \(USING CHARACTERISTICS FOR THIS SESSION).\ LIN16, TEXT \&E&N&T&E&R TO LEAVE THIS MENU \ *.-1 TEXT \(STORING CHARACTERISTICS). \ LIN17, TEXT \&D&O TO USE A NEW SYSTEM DISKETTE.\ LIN19L, TEXT \&TERMINAL &MODE IS SET TO TYPE \ /M015 LIN19R, TEXT \ AND MAY BE CHANGED IN THE\ LIN20, TEXT \&S&O (&SYSTEM &OPTIONS) MENU.\ LIN22L, TEXT \&THE PRINTER IS SET TO \ LIN23R, / LIN22R, TEXT \ BAUD.\ LIN23L, TEXT \&COMMUNICATION IS SET TO \ LIN24, TEXT \&BAUD RATES MAY BE CHANGED IN THE &S&O &C&C \ *.-1 TEXT \(&COMMUNICATION &SETTINGS) &SUBMENU.\ LIN23, / replaced edit /a016 > IFDEF ITALIAN < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 1 *.-1 TEXT \^P^S\ / CONTROL for lines 3 and 4 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 5 and 6 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 8,9,10,11,12,13 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 14 and 15 *.-1 TEXT \^P^S^A!S^A^S\/ CONTROL for line 17 (L and R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 18 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 19 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 21 *.-1 TEXT \^P^S\ / CONTROL for line 22 *.-1 TEXT \^P^S^P^S\ / CONTROL for line 23,24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, 0 / (Text is single H/double W) LIN1, TEXT \-- !&MENU !&DI !&IMPOSTAZIONE !&CARATTERISTICHE !&TERMINALE --\ LIN3A, TEXT \&TIPO CURSORE\ / cursor style /a016 LIN3B, TEXT \&BLOCCO\ / block /a016 LIN3C, TEXT \&TRATTINO\ / Underline /a016 LIN4A, TEXT \&SCORRIMENTO IMMAGINE\ / Scroll /a016 LIN4B, TEXT \&VELOCE\ / jump /a016 LIN4C, TEXT \&LENTO\ / smooth /a016 LIN5A, TEXT \&SFONDO VIDEO\ / screen background /a016 LIN5B, TEXT \&NORMALE\ / black/normal /a016 LIN5C, TEXT \&INVERSO\ / white/inverse /a016 LIN6A, TEXT \&RUMORE DEI TASTI\ / keyclick /a016 LIN6B, TEXT \&ABILITATO\ / on /a016 LIN6C, TEXT \&DISABILITATO\ / off /a016 LIN8, TEXT \&PREMERE:\ LIN9, TEXT /!&AVANTI O !&INDIETRO PER POSIZIONARE IL CURSORE SULLA CARATTERISTICA/ LIN10, TEXT /DESIDERATA./ LIN11, TEXT \!&SELEZ PER RENDERE EFFETTIVA LA SCELTA FATTA.\ LIN12, TEXT \!&RITORNO PER USCIRE DAL MENU, UTILIZZANDO LE CARATTERISTICHE SCELTE\ LIN13, TEXT \PER LA SESSIONE DI LAVORO CORRENTE.\ LIN14, TEXT \!&INVIO PER USCIRE DAL MENU MEMORIZZANDO LE CARATTERISTICHE SELEZIONATE.\ LIN15, TEXT \!&ESECUZIONE PER UTILIZZARE UN NUOVO DISCHETTO SISTEMA.\ LIN17L, TEXT \&TIPO &TERMINALE : \ /M015 LIN17R, TEXT \.\ LIN18L, TEXT /&VELOCIT\@ DELLA STAMPANTE: / LIN19R, / LIN18R, TEXT \ BAUD.\ /m016 LIN19L, TEXT /&VELOCIT\@ DI TRASMISSIONE: / LIN20, TEXT /&IL &TIPO &TERMINALE PU\R ESSERE MODIFICATO UTILIZZANDO L'OPZIONE / LIN21, TEXT \!&IS (&IMPOSTAZIONE &SISTEMA) DEL &MENU &PRINCIPALE.\ LIN22, TEXT /&LE VELOCIT\@ POSSONO ESSERE MODIFICATE UTILIZZANDO L'OPZIONE/ LIN23, TEXT /!&IS !&CS (&PARAMETRI DI &COMUNICAZIONE E &STAMPA)./ > IFDEF V30NOR < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 4 *.-1 TEXT \^P^S\ / CONTROL for lines 5 and 6 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 7 and 8 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 11,12,14,15,16,17 *.-1 TEXT \^P^S^A!S^A^S^P^S\/ CONTROL for line 19 (L and R) and 20 *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 22 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 23 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, ESC; "#&177; "6&177; 0 / (Text is single H/double W) LIN1, TEXT '!&TERMINAL-!&OPPSETT' LIN4A, TEXT '&MARK\XTYPE' LIN4B, TEXT '&BLOKK' LIN4C, TEXT '&UNDERSTREK' LIN6A, TEXT '&RULLING' LIN6B, TEXT '&RYKK' LIN6C, TEXT '&JEVN' LIN7A, TEXT '&BAKGRUNN' LIN7B, TEXT '&M\XRK' LIN7C, TEXT '&LYS' LIN8A, TEXT '&TASTEKLIKK' LIN8B, TEXT '&P\E' LIN8C, TEXT '&AV' LIN11, TEXT '&TRYKK P\E !&FREM EL. !&TILBAKE FOR \E' *.-1 TEXT ' FLYTTE DEG MELLOM ALTERNATIVENE. &TRYKK P\E' LIN12, TEXT '!&VELG FOR \E VELGE ET ALTERNATIV.' LIN14, TEXT '&TRYKK P\E:' LIN15, TEXT '!&RETUR FOR \E G\E UT AV MENYEN ' *.-1 TEXT '(OG BRUKE OPPSETTET MIDLERTIDIG).' LIN16, TEXT '!&LEGG !&INN FOR \E G\E UT AV MENYEN ' *.-1 TEXT '(OG LAGRE OPPSETTET). ' LIN17, TEXT '!&UTF\XR HVIS DU HARR SATT INN EN NY SYSTEMDISKETT.' LIN19L, TEXT '&TERMINALMODUS ER SATT TIL' /M015 LIN19R, TEXT ' OG KAN ENDRES I MENYN ' LIN20, TEXT '&&ENDRE SYSTEMVERDIER (!&ES).' LIN22L, TEXT '&SKRIVER: ' LIN23R, / LIN22R, TEXT ' BAUD.' LIN23L, TEXT '&KOMMUNIKASJON: ' LIN24, TEXT '&OVERF\XRINGSHASTIGHETENE KAN ENDRES MED !&ES/!&EK I' *.-1 TEXT ' MENYEN &ENDRE KOMMUNIKASJONSVERDIER.' LIN23, / replaced edit /a016 > IFDEF V30SWE < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 4 *.-1 TEXT \^P^S\ / CONTROL for lines 5 and 6 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 7 and 8 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 11,12,14,15,16,17 *.-1 TEXT \^P^S^A!S^A^S^P^S\/ CONTROL for line 19 (L and R) and 20 *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 22 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 23 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, ESC; "#&177; "6&177; 0 / (Text is single H/double W) LIN1, TEXT '- !&VAL !&AV !&TERMINALINST\DLLNING -' LIN4A, TEXT '&MARK\VRENS UTSEENDE' LIN4B, TEXT '&BLOCK' LIN4C, TEXT '&UNDERSTRYKNING' LIN6A, TEXT '&BILDRULLNING' LIN6B, TEXT '&HOPPA' LIN6C, TEXT '&J\EMN' LIN7A, TEXT '&SK\DRMBILDENS BAKGRUNDSF\DRG' LIN7B, TEXT '&SVART' LIN7C, TEXT '&VIT' LIN8A, TEXT 'TANGENTBORDSSIGNAL' LIN8B, TEXT '&P\E' LIN8C, TEXT '&AV' LIN11, TEXT '&TRYCK P\E FRAM\ET ELLER BAK\ET F\VR ATT' *.-1 TEXT 'PLACERA MARK\VREN VID VALET, TRCK SEDAN P\E' LIN12, TEXT 'MARK F\VR ATT V\DLJA INST\DLLNING' LIN14, TEXT '&TRYCK P\E' LIN15, TEXT 'RETUR F\VR ATT \ETERGE TILL MENYN ' *.-1 TEXT 'ANV\DND G\DLLANDE INST\DLLNINGAR' LIN16, TEXT 'ENTER F\VR ATT KOMMA TILLBAKA TILL F\VRRA MENYN ' *.-1 TEXT '(LAGRA INST\DLLNINGAR)' LIN17, TEXT 'UTF\VR OM DU VILL ANV\DNDA EN NY SYSTEMDISKETT' LIN19L, TEXT '&TERMINALL\DGETS INST\DLLNING \DR' /M015 LIN19R, TEXT 'OCH KAN \DNDRAS' LIN20, TEXT 'I HUVUDMENYN UNDER !&SV (SYSTEMVAL)' LIN22L, TEXT '&SKRIVARENS INST\DLLNING \DR' LIN23R, / LIN22R, TEXT ' BAUD.' LIN23L, TEXT '&KOMMUNIKTIONSINST\DLLNINGEN \DR' LIN24, TEXT '&BAUDV\DRDET KAN \DNDRAS I HUVUDMENYN UNDER !&SV - !&IK ' *.-1 TEXT '(!&SYSTEMVAL -!&KOMMUNIKATIONS/ OCH SKRIVARUTG\ENGAR)' LIN23, / replaced edit /a016 > IFDEF DUTCH < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 4 *.-1 TEXT \^P^S\ / CONTROL for lines 5 and 6 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 7 and 8 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 11,12,14,15,16,17 *.-1 TEXT \^P^S^A!S^A^S^P^S\/ CONTROL for line 19 (L and R) and 20 *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 22 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 23 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, ESC; "#&177; "6&177; 0 / (Text is single H/double W) LIN1, TEXT \!&INSTELLINGEN !&VOOR &D&E !&TERMINAL\ LIN4A, TEXT \&CURSOR\ LIN4B, TEXT \&BLOKJE\ LIN4C, TEXT \&STREEPJE\ LIN6A, TEXT \&SCROLLEN\ LIN6B, TEXT \&SPRONGSGEWIJS\ LIN6C, TEXT \&GELIJKMATIG\ LIN7A, TEXT \&SCHERM \ LIN7B, TEXT \&ZWART\ LIN7C, TEXT \&WIT\ LIN8A, TEXT \&TOETSKLIK\ LIN8B, TEXT \&AAN\ LIN8C, TEXT \&UIT\ LIN11, TEXT \&DRUK OP !&VOORUIT OF !&TERUG OM LANGS DE OPTIES TE GAAN. \ LIN12, TEXT \&DRUK OP !&SELECT OM TE SELECTEREN.\ LIN14, TEXT \&DRUK OP:\ LIN15, TEXT \!&RETURN OM DE AFGEBEELD INSTELLINGEN TE GEBRUIKEN \ LIN16, TEXT \!&VOER !&IN OM DE AFGEBEELDE INSTELLINGEN TE GEBRUIKEN.\ LIN17, TEXT \!&VOER !&OPDR !&UIT OM &D&E&CMATE OPNIEUW TE STARTEN.\ LIN19L, TEXT \&TERMINAL-INSTELLING IS \ /M015 LIN19R, TEXT \ ,DEZE KAN WORDEN GEWIJZIGD MET\ LIN20, TEXT \&T&I IN HET &OPTIE-MENU (&B&S).\ LIN22L, TEXT \&DE PRINTERSNELHEID IS \ LIN23R, / LIN22R, TEXT \.\ LIN23L, TEXT \&COMMUNICATIESNELHEID IS \ LIN24, TEXT \&SNELHEDEN KUNNEN WORDEN GEWIJZIGD MET\ *.-1 TEXT \ &B&S &W&I (&COMMUNICATIE-INSTELLINGEN).\ LIN23, > IFDEF SPANISH < SETUPC, / TEXT \^A\ / CONTROL for erase screen *.-1 TEXT \^P^A^S\ / CONTROL for single H/double W *.-1 TEXT \^P^S\ / CONTROL for line 4 *.-1 TEXT \^P^S\ / CONTROL for lines 5 and 6 /D011 *.-1 TEXT \^P^S^P^S\ / CONTROL for lines 7 and 8 *.-1 TEXT \^P^S^P^S^P^S^P^S^P^S^P^S\ / CONTROL for 11,12,14,15,16,17 *.-1 TEXT \^P^S^A!S^A^S^P^S\/ CONTROL for line 19 (L and R) and 20 *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 22 (L AND R) *.-1 TEXT \^P^S^A!S^A^S\ / CONTROL for line 23 (L AND R) *.-1 TEXT \^P^S\ / CONTROL for line 24 ERASE, ESC; 74 / Set VT100 (ANSI) mode ESC; "[&177; "2&177; "J&177; 0 / ERASE entire screen LIN1X, ESC; "#&177; "6&177; 0 / (Text is single H/double W) LIN1, TEXT \!&MENU !&DE !&CARACTERISTICAS !&DE !&TERMINAL\ LIN4A, TEXT \&TIPO &CURSOR \ LIN4B, TEXT \&BLOQUE\ LIN4C, TEXT \&RAYA\ LIN6A, TEXT \&DESPLAZAMIENTO\ LIN6B, TEXT \&INCREMEN.\ LIN6C, TEXT \&CONTINUO\ LIN7A, TEXT \&FONDO &PANTALLA\ LIN7B, TEXT \&NEGRO\ LIN7C, TEXT \&BLANCO\ LIN8A, TEXT \&CLIC DE TECLAS\ LIN8B, TEXT '&S\M' LIN8C, TEXT \&NO\ LIN11, TEXT \&PULSE !&ADELANTE O !&ATRAS PARA\ *.-1 TEXT \ MOVERSE ENTRE LAS OPCIONES, Y PULSE\ LIN12, TEXT '!&SEL PARA SELECCIONAR LAS CARACTER\MSTICAS DE TERMINAL.\' LIN14, TEXT \&PULSE:\ LIN15, TEXT '!&RETORNO PARA ABANDONAR ESTE MEN\Z ' *.-1 TEXT '(USANDO CARACTER\MSTICAS PARA ESTA SESI\SN).' LIN16, TEXT '!&VALIDAR PARA ABANDONAR ESTE MEN\ZMENU ' *.-1 TEXT '(ALMACENANDO LAS CARACTER\MSTICAS).' LIN17, TEXT \!&EJECUTAR PARA USAR UN DISKETTE SISTEMA NUEVO.\ LIN19L, TEXT '&EL &MODO DEL &TERMINAL EST\A ESTABLECIDO PARA UN ' /M015 LIN19R, TEXT ' Y SE PUEDE CAMBIAR EN EL MEN\Z' LIN20, TEXT \&O&S (&OPCIONES DEL SISTEMA) MENU.\ LIN22L, TEXT '&LA IMPRESORA EST\A AJUSTADA EN ' LIN23R, / LIN22R, TEXT \ BAUDIOS.\ LIN23L, TEXT '&COMUNICACIONES EST\A AJUSTADA EN \ LIN24, TEXT \&LA VELOCIDAD EN BAUDIOS SE PUEDE CAMBIAR EN &S&O &C&C\ *.-1 TEXT ' &SUBMEN\ZU (&VALORES DE &COMUNICACI\SN).' LIN23, / replaced edit /a016 > / / Moved here on edit 015 for space reasons /A015 / / TERMINAL MODE TABLE / TMTABL, VT52; VT100; DMII; VT125; VT227 ;VT228 ;VT22F /A015 /M013 VT52, TEXT \&V&T52\ VT100, TEXT \&V&T100\ DMII, TEXT \&D&E&CMATE\ VT125, TEXT \&GRAPHICS\ /M015 VT227, TEXT \&V&T227\ /A013 VT228, TEXT \&V&T228\ /A015 VT22F, TEXT \&V&T22&F\ /A015 X=. / INDICATE FIRST FREE LOCATION ON PAGE /----------- PAGE CU4BF1=. /\zblock 400 / WPLOG - PHONE & LOGON UTILITIES / / 028 EMcD 26-Sep-85 Dutch & Spanish Xlations / 027 EMcD 13-Sep-85 Nordic translations / (conditionalised) / 026 EMcD 15-Jul_85 Change from ~ to + and ' to ! / in command lines / 025 TCW 06-DEC-84 Remove scrolling regions from logon / 024 TCW 04-DEC-84 Enlarge number buffer / 023 TCW 01-NOV-84 Ck. for non-valid edit chars / 022 TCW 04-OCT-84 Change screen output routines / 021 TCW 18-SEP-84 Reset LINBUF / 020 WCE 20-AUG-84 CHANGE FILE OPEN TO USE MNUTFN / 019 TCW 17-AUG-84 CHANGE INTEGRAL MODEM CK / 018 GDH 14-AUG-84 Fix DIAL routine -- coordinate TT output. / 017 GDH 7-AUG-84 Enhance keyboard input support. / 016 TCW 03-JUL-84 Integral Modem support / 015 TCW 12-APR-84 INCLUDE USE OF ARROW & FIND KEYS / 014 BCR 30-DEC-83 RESTRUCTURE AND ADD PHONE UTILITY / 013 BCR 4-NOV-83 GIVE ERROR ON MISSING WAIT OBJECT / 012 BCR 25-OCT-83 DISALLOW OCTAL 8 / 011 GDH 30-SEP-83 Fixed dangling EOF flag. / 010 GDH 30-SEP-83 CX 'call' to 'chain' / 009 BCR 21-SEP-83 HANGUP MODEM AT MENU TIME / 008 BCR 20-SEP-83 FIX ECHO OF USER KEYSTROKES / 007 BCR 19-SEP-83 CHANGE HOST DRAINING TIMES / 006 BCR 16-SEP-83 CHANGE '~' TO ACCEPT KBD INPUT / 005 BCR 16-SEP-83 ADD "MENU" COMMAND / 004 BCR 24-AUG-83 MIXED UC/LC GO TARGETS / 003 BCR 2-AUG-83 ALLOW CR IN WAIT HOST / 003 BCR 2-AUG-83 ECHO WAIT KBD ~ / 002 BCR 15-JUL-83 ' text delimiter, CR KBD delimiter / 001 GDH 20-MAY-83 Creation of stub module. / / WRITES OUT WPLOG / *200 JMP I .+3 JMP I .+1 7600 RXLOAD *RXLDLS RXEWT=4 RXEWT 0 RXQBLK=11 RXQBLK . DLOLOG / ++++ 100 / ++++ CDF 20 / ++++ -DSOLOG 0 / FIELD 2 / *100 / THE FIRST 100 LOCATIONS ARE USED FOR THE SYSTEM / / / THIS MODULE CONTAINS THE LOGON PROCESSOR AND / THE TELEPHONE DIRECTOR/AUTODIALER UTILITY. / THE LATTER IS THE CODE BETWEEN LOCATIONS / "PHSTRT" AND "LOG", THE SUBROUTINE "SUBSTR" / AND ASSORTED MESSAGE TEXTS AT THE END. / IT CAN EASILY BE MADE INTO AN OVERLAY. / THE PHONE DIRECTORY IS A USER DOCUMENT CONTAINING / AN UNLIMITED NUMBER OF ENTRIES CONTAINING NAME / FIELDS (WHICH BEGIN WITH ) AND TELEPHONE / NUMBER FIELDS (WHICH BEGIN WITH <#>). EACH / ENTRY ENDS WITH <> AND MAY CONTAIN OTHER / FIELDS WHICH ARE IGNORED. /-----------WARNING---------------- / THE PHONE DIRECTORY IS OPENED FOR READ/WRITE. / DOCUMENT CORRUPTION CAN RESULT FROM ABNORMAL / EXITING. DO NOT REMOVE THE DISKETTE WITHOUT / RETURNING TO MAIN MENU (AND BE CAREFUL WHEN / USING CPODT). / THESE ARE CONSTANTS USED BY THE LOGON UTILITY / CIFMYF=CIFLP / DEFINE OUR FIELD. CDFMYF=CDFLP / ... CIFCX=CIF 40 / CIF to the CX field. CDFCX=CDF 40 / CDF to the CX field. CXLINE=4600 / Address of DEFAULT CX SETTINGS line. / Set/reset by CX command. / This line buffer resides in the CX field (4). FORWRD=AC0004 IFNZRO XGETET-4 BCKWRD=AC0002 IFNZRO XGETST-2 H2DTR=6362 / MODEM CONTROL IOT /A016 / / FREQUENTLY USED LITERALS AND LOCATIONS / BUFPTR, BUFBEG / Ptr to buffer to store chars in. LINCTR, 1 / Line # for error reporting. CHAR, 0 / THE CURRENT CHARACTER FROM THE FILE HALT, XX / ADDRESS TO GO TO ON DETECTING GOLD HALT WTSPTR, 0 / WAIT PROCESSOR STRING POINTERS WTXPTR, 0 / .....HERE BECAUSE OF SCATTERED WTGPTR, 0 / .....INDIRECTS / EOF, 0 / Set only if E-O-F or ERROR is encountered. /D022TTCHRS, 0 / Count of # of chars in LINBUF (for RUBOUT)/A017 /D022TYPPTR, LINBUF / ptr into LINBUF tt buffer. /A017 / / OCTAL VALUES OF SOME ASCII CHARACTERS COLON=72 COMMA=54 AMPERS=46 SQUOTE=041 / Use ! for ' in V3 /m026 TILDA=053 / Use + for ~ in V3 /m026 SPACE=40 BSPACE=10 /D017 TAB=11 SLASH=57 ZERO=60 EIGHT=70 NINE=71 C=103 L=114 F=106 EOL=ECNWLN / SOME LOGON PARAMETERS ATMSIZ=17 /MAXIMUM CHARACTERS/ATOM LABSIZ=6 /MAXIMUM CHARACTERS/STATEMENT LABEL WTTSIZ=31 /MAXIMUM CHARACTERS/WAIT TEXT ITEM TXTSIZ=144 /MAXIMUM CHARACTERS/ ~ RESPONSE CXSIZ=26 /DOCUMENTED LENGTH OF CX COMMAND BUFFER SCRSIZ=120 /WIDTH OF SCREEN PHNSIZ=55 / NUMBER OF DIGITS IN A PHONE NUMBER /A024 / / SEE WPF1.PA FOR EQUATES DEFINING CHARACTERS COMING FROM THE FILE. / /-------------------- / THESE ARE CONSTANTS USED BY THE PHONE UTILITY / / OCTAL VALUES OF SOME ASCII CHARACTERS /BSPACE=10 ESIGN=75 CTLA=1 CTLB=2 BELL=7 LARR=74 RARR=76 NUMSGN=43 N=116 LPAR=50 RPAR=51 DASH=55 A=101 B=102 X=130 G=107 / / SOME PHONE PARAMETERS KEYSIZ=WTTSIZ /MAX LENGTH OF SEARCH KEY NAMSIZ=TXTSIZ /MAX LENGTH OF NAME FIELD NUMSIZ=WTTSIZ /MAX LENGTH OF NUMBER FIELD / / /------------ PAGE LOGON, /ENTRY POINT FOR LOGON. COME HERE BY TYPING LG EXIT, XX /COMMON SYSTEM RETURN FOR LOGON & PHONE JMP LOG /GO START UP LOGON / PHONE, XX /ENTRY POINT FOR PHONE. /COME HERE FROM MAIN MENU COMMAND "PH" CDFMYF /MAP OUR FIELD CLA TAD PHONE /SAVE RETURN POINT IN CASE OF EXIT DCA EXIT / VIA LOGON. JMP PHSTRT /GO START UP THE PHONE UTILITY /----------------------------------------- / / / / /----------------------------------------- / EXIT TO MAIN MENU OR CX FROM EITHER LOGON OR PHONE CLSRTN, JMS CLOSE / Close the directory document RTNSY, CLA / Hang up any modem connection /A009 TAD (7402 / Send hangup code to host /A009 JMS HSOUT CIF 60 / Map COMM buffer field. JMS I (COMXIT) / Call COMM Clean-Up code. CDFSYS / ++++ DCA I (CMADSX) / ++++ RTNXIT, /D025 CDFMYF /D025 CIFMNU / Clear date & time and reset scroll /D025 JMS I IOACAL /D025 0 /D025 SCROLR / Default scrolling region /D025 ESCAPE /D025 LFSTRG / Scroll to 1st line. /M017 CDIMNU JMP I EXIT / PHONE UTILITY PHSTRT, JMS INITER /INITIALIZE SOME COMMON STUFF TAD (CLSRTN /SET GOLD HALT RETURN DCA HALT JMS OPENRW / OPEN FILE FOR READ-WRITE /A023 /D023 SPA CLA /SKIP UNLESS OPEN ERROR SZA / SKIP UNLESS OPEN ERROR /A023 JMP ERR1 /OPEN ERROR DCA SCANSW /SET TO SCAN FORWARD FORWRD /FORWARD READ-WRITE DCA GETOP IFNZRO KEY-WTS1 < JMS NULSTR /CLEAR KEY STRING KEY > TAD (SKP CLA) /SET TO "NOSCREEN" MODE DCA SCRNSW / / ASK USER FOR A NAME SEARCH KEY. WE WILL SEARCH / THE DIRECTORY FILE FOR THE NEXT ENTRY WHOSE NAME / FIELD CONTAINS A MATCH FOR THIS KEY. / IF NONE IS SUPPLIED (IE ONLY A CR) THEN WE WILL / USE THE PREVIOUS KEY AGAIN. / IF THERE IS NO PREVIOUS KEY WE WILL MATCH THE / NEXT ENTRY. / / GETKEY, TAD (NEXMSG /INITIALIZE TO NOT DISPLAY OLD KEY /M015 DCA KEYDSP TAD KEY+1 /IS KEY A NULL STRING SNA CLA JMP ASKKEY /YES TAD (OKYMSG /NO, DISPLAY OLD KEY DCA KEYDSP / ASKKEY, CIFMNU /ASK USER FOR NAME KEY JMS I IOACAL 0 KEYMSG 0 0100 /POSITION TO LINE 1 0200 KEYDSP, XX /ADDRESS OF EITHER NULMSG OR OLD KEY MESSAGE KEY+1 0300 MENMSG /RETURN TO MM MESSAGE 0400 TAD (SKP CLA)/INITIALIZE OPTION DISPLAY SWITCH DCA OPTSW / JMS KBGET /GET FIRST CHARACTER DCA CHAR TAD CHAR /IS IT A CR TAD (-EDNWLN SNA JMP KEYGOT /YES, USE KEY AGAIN TAD (EDNWLN-EDMENU /NO, IS IT GOLD MENU SNA CLA JMP CLSRTN /YES, CLOSE DIRECTORY AND RETURN JMS NULSTR /CLEAR OLD KEY KEY /D022 JMS RSLNBF / RESET LINE INPUT BUFFER /A021 KEYGO, TAD CHAR / CK FOR NON-VALID CHARS /A023 TAD (-EDRBWD / SMA CLA / /A023 JMP KEYRUB / CHAR OK - GO PROCESS /A023 JMS BEEPER / RING BELL /A023 JMP KEYAGN / NO - NON VALID EDIT KEY /A023 KEYRUB, TAD CHAR / PICK UP CHAR /A023 JMS CHKRUB KEY /A022 / /D022 TAD CHAR /ADD TO PREVIOUS KEY STRING JMS ADDSTR KEY JMP KEYOVF /KEY TOO LONG KEYAGN, JMS KBGET /GET ANOTHER KEYSTROKE DCA CHAR /SAVE IT TAD CHAR /GET CHARACTER BACK TAD (-EDNWLN /CHECK FOR CR SNA CLA JMP KEYGOT /YES, END OF KEY JMP KEYGO /LOOP FOR NEXT KEY CHAR / KEYOVF, JMS BEEPER /BEEP FOR TOO LONG KEYGOT, JMS CLRSCN /CLEAR SCREEN JMP GETFIL /------------ PAGE / WE HAVE THE COMPLETE KEY. NOW SEARCH FOR / AN ENTRY WITH A MATCH. / GETFIL, JMS CHKHLT /CHECK FOR GOLD HALT JMS NXTNAM /GO GET A NEW NAME AND NUMBER FROM THE DIRECTORY JMP EOFOPT /END OF DIRECTORY ENCOUNTERED JMS SUBSTR /CHECK FOR A SUBSTRING MATCH KEY NAME JMP GETFIL /NO MATCH. GET ANOTHER ENTRY / MATCH FOUND. DISPLAY TO USER / DISPLAY KEY OPTIONS ONLY ONCE OPTSW, SKP CLA /SET TO "CLA" WHEN DISPLAY NEED NOT BE REPAINTED JMP DISPLY TAD (CLA) /SET NOT TO REDISPLAY THESE MESSAGES DCA OPTSW JMS SHOOPT /DISPLAY THE USER OPTIONS / DISPLAY THE USER EXITS CIFMNU JMS I IOACAL 0 XITMSG 1300 1400 CLA TAD (SKP CLA)/SET TO ALLOW BOTH ADVANCE & BACKUP DCA ADVAN TAD (SKP CLA) DCA BACK DISPLY, TAD (SKP /SET SWITCH TO ALLOW DIALING DCA CXLGSW / TAD NUMBR+1 /CHECK FOR NUMBER FOUND SZA JMP DODISP /YES, GO DO DISPLAY JMS MOVSTR /SHOW USER 'NO NUMBER' NONUM NUMBR NOP /SHOULD NEVER TAKE THIS ERROR RETURN DODISP, JMS DISPNM /DISPLAY NAME AND NUMBER / WAIT FOR USER RESPONSE TO OPTIONS DISPLAY OPTWT, JMS KBGET /GET A CHARACTER OPTCHK, TAD (-EDADVN /IS IT ADVANCE SNA JMP ADVAN /YES, GO GET NEXT ENTRY TAD (EDADVN-EDBKUP /IS IT BACKUP SNA JMP BACK /YES, GO GET PREVIOUS ENTRY TAD (EDBKUP-EDFIND /IS IT GOLD SEARCH SNA JMP GETKEY /YES, GO GET A NEW SEARCH KEY TAD (EDFIND-EDMENU /IS IT GOLD MENU SNA JMP CLSRTN /YES, BACK TO MAIN MENU / CXLGSW, SKP /SET TO NOP WHEN CX AND LG ARE NOT ALLOWED JMP BEEP / TAD (EDMENU-C /IS IT C AND (7737 /EITHER CASE SNA JMP CXTST TAD (C-L /NO, IS IT L SNA JMP LGTST BEEP, JMS BEEPER JMP OPTWT / CXTST, JMS KBGET /CHECK FOR POSSIBLE CX AND (7737 /EITHER CASE TAD (-X /DID WE GET IT SZA JMP BEEP /NO JMS DIALER /GO DIAL THE NUMBER JMP NOTANS /NOT ANSWERED JMS CLOSE /ANSWERED, CLOSE DIRECTORY AND JMP RTNCX /EXIT TO CX / NOT ANSWERED FOR SOME REASON NOTANS, JMS KBGET /WAIT FOR A KEYSTROKE DCA T1 /SAVE IT JMS DISPNM /REPAINT NAME AND NUMBER FOR POSSIBLE NEW TRY TAD T1 /GO CHECK OPTION SELECTION JMP OPTCHK LGTST, JMS KBGET /CHECK FOR POSSIBLE LG AND (7737 /EITHER CASE TAD (-G /DID WE GET IT SZA JMP BEEP /NO /D022 JMS RSLNBF / YES - RESET LINE BUFFER /A021 / / AT THIS POINT WE MUST GET THE NAME OF THE LOGON FILE / THE USER WANTS TO USE IF HIS PHONE CALL IS COMPLETED. / CURRENTLY WE GO TO MN1 AND PROMPT IN THE SAME WAY / AS FOR NORMAL LG REQUESTS. IN THE FUTURE BOTH THE / LOGON AND PHONE FILES MAY BE DEFAULTS, CHANGEABLE / THROUGH "SO". IN ANY EVENT, CONTROL MUST ALWAYS / RETURN HERE, EVEN IF GOLD MENU IS PRESSED, IN ORDER / TO CLOSE THE PHONE FILE (WHICH IS STILL OPEN IN CASE / THE USER WANTS A DIFFERENT ENTRY OR THE LINE IS BUSY) / AND TO CLEANUP CX. MENXIT, CIFMNU /YES, ASK FOR LOGON FILE NAME JMS I MNUCAL DLMED1 CLA CDFMNU TAD I (MUBUF+MNSYSA /CHECK FOR GOLD MENU CDFMYF TAD (-EDMENU!4000 SNA CLA /SKIP IF NOT JMP CLSRTN /YES, BACK TO SYSTEM JMS DISPNM /REPOSITION THE CURSOR / JMS DIALER /GO DIAL THE NUMBER JMP NOTANS /NOT ANSWERED JMS CLOSE /CLOSE DIRECTORY JMP LOG /EXIT TO LOGIN /------------ PAGE BACK, SKP CLA /SET TO NOP WHEN "BACK" NOT ALLOWED JMP BEEP AC7777 /SET TO SCAN BACKWARD JMP BACADV / ADVAN, SKP CLA /SET TO NOP WHEN "ADVAN" NOT ALLOWED JMP BEEP / BACADV, DCA SCANSW /SAVE SCAN DIRECTION JMS NXTNAM /GO GET ANOTHER ENTRY JMP GOTEOF /END OF DIRECTORY REACHED JMP OPTSW / END OF FILE ENCOUNTERED GOTEOF, CLA TAD SCANSW /WHICH WAY WERE WE GOING SZA JMP BACEOF /BACKWARD / END OF FILE IN FORWARD DIRECTION = END OF FILE AC7777 /SET TO BACK OVER ONE ENTRY DCA BACKUP TAD (ENDMSG /SHOW END OF FILE DCA ENDBEG TAD (BCKMSG /SHOW ONLY "BACKUP" DCA ADVBCK TAD (NOP) /DISALLOW "ADVANCE" NOW DCA ADVAN TAD (SKP CLA)/AND ALLOW "BACKUP" DCA BACK JMP SHOEND / END OF FILE IN BACKWARD DIRECTION = BEGINNING OF FILE BACEOF, AC7776 /SET TO BACK OVER TWO ENTRIES DCA BACKUP TAD (BEGMSG /SHOW BEGINNING OF FILE DCA ENDBEG TAD (ADVMSG /SHOW ONLY "ADVANCE" DCA ADVBCK TAD (NOP) /DISALLOW "BACKUP" NOW DCA BACK TAD (SKP CLA)/AND ALLOW "ADVAN" DCA ADVAN / SHOEND, CIFMNU JMS I IOACAL 0 EODMSG 0400 /M015 ENDBEG, XX /BEGINNING OR END OF FILE MESSAGE 0500 /M015 0700 /M015 1000 ADVBCK, XX ENTMSG 1300 TAD (SKP CLA)/SET TO REPAINT OPTIONS DCA OPTSW TAD (NOP) /SET TO DISABLE DIALING DCA CXLGSW DCA EOF /CLEAR EOF FLAG TAD SCANSW /FLIP SCAN TO OTHER DIRECTION CMA DCA SCANSW JMP OPTWT /GO WAIT FOR A KEYSTROKE / REPAINT THE USER OPTIONS EOFOPT, JMS SHOOPT JMP GOTEOF SCANSW, 0 /0 = FORWARD SCAN, -1 = BACKWARD / /CMPSTR - COMPARE 2 7-BIT ASCIIZ STRINGS / / JMS CMPSTR / ADDRESS OF FIRST STRING / ADDRESS OF SECOND STRING / NOT EQUAL RETURN (AC=0) / EQUAL RETURN (AC=0) / / A LOWER CASE CHARACTER IN THE FIRST / STRING WILL COMPARE EQUAL TO EITHER / LOWER OR UPPER CASE VERSIONS OF / THAT CHARACTER IN THE SECOND STRING. / / STRINGS MUST BE OF EQUAL LENGTH TO / COMPARE EQUAL. / CMPSTR, XX CLA TAD I CMPSTR /GET ADDR OF S1 DCA X1 ISZ CMPSTR TAD I CMPSTR /GET ADDR OF S2 DCA X2 ISZ CMPSTR /POINT TO NOT EQUAL RETURN CMPLOP, TAD I X1 /FETCH A CHARACTER FROM S1 SNA JMP CMPE1 AND (177 /COMPARE ONLY 7 BITS DCA CMPC1 TAD I X2 /FETCH A CHARACTER FROM S2 SNA JMP I CMPSTR /SECOND STRING SHORTER AND (177 CIA /SAVE -SECOND CHAR DCA CMPC2 DCA CMPULA /CLEAR UPPER/LOWER ADJUSTER TAD CMPC1 /IS FIRST STRING CHARACTER L/C TAD (-172 SMA SZA JMP CMPCMP /NO, >z TAD (172-141 SPA CLA JMP CMPCMP /NO, TAD (-RARR SZA CLA JMP NXT1 / JMS NULSTR /CLEAR NAME STRING NAME JMS NULSTR /CLEAR NUMBER STRING NUMBR GETNAM, JMS GETNXT /STUFF IN ALL CHARACTERS UP TO A < TAD (-LARR SNA JMP CHKNUM TAD (LARR JMS ADDSTR NAME JMP GETNAM /IGNORE OVERFLOW CHARACTERS JMP GETNAM / LOOKNU, JMS GETNXT /SKIP TO A < TAD (-LARR SZA JMP LOOKNU /NOT FOUND YET CHKNUM, JMS GETNXT /CHECK FOR # TAD (-RARR SNA JMP GETRTN /WE HAVE <> TAD (RARR-NUMSGN SNA JMP GETNAR /WE HAVE <# TAD (NUMSGN-N SZA CLA JMP LOOKNU /SKIP TO NEXT < JMS GETNXT /WE HAVE . SKIP TO <> GETNAR, JMS GETNXT TAD (-RARR SZA JMP LOOKNU /<#> NOT FOUND YET. LOOK FOR < / GETNUM, JMS GETNXT /STUFF CHARACTERS INTO NUMBER UP TO A < TAD (-LARR SNA JMP ENDNUM TAD (LARR JMS ADDSTR NUMBR JMP GETNUM /IGNORE OVERFLOW DIGITS JMP GETNUM / / < FOUND. SEE IF IT WAS <> ENDNUM, JMS GETNXT /GET PAST <> TAD (-RARR SNA JMP GETRTN GETDIA, JMS GETNXT /LOOK FOR THE < TAD (-LARR SZA JMP GETDIA /LOOP BACK FOR < JMP ENDNUM /< FOUND. NOW CHECK FOR > GETRTN, ISZ NXTNAM /TAKE NORMAL RETURN / GETEOF, JMP I NXTNAM /TAKE EOF RETURN / / BACK UP TO THE AT THE START OF THE PREVIOUS ENTRY NXBACK, BCKWRD /SET BACKWARD READ-WRITE DCA GETOP TAD BACKUP /GET -NUMBER OF ENTRIES TO GO BACK DCA BACKCT NXTB1, JMS GETNXT TAD (-RARR / > FOUND? SZA JMP NXTB1 /NOT YET JMS GETNXT TAD (-N / N> FOUND? SZA JMP NXTB1 /NOT YET JMS GETNXT TAD (-LARR SZA JMP NXTB1 ISZ BACKCT / FOUND. BACK ANOTHER ENTRY? JMP NXTB1 /YES JMP NXTBK /NOW READ ENTRY IN THE FORWARD DIRECTION BACKCT, XX /COUNT OF ENTRIES WHILE BACKING UP BACKUP, XX /-1 OR -2 ENTRIES TO BACKUP NEXT TIME / GET NEXT CHARACTER FROM PHONE DIRECTORY FILE / IGNORING HARD RETURN. / GO TO GETEOF IF EOF OR BOF. / GETNXT, XX GETNX1, JMS GETCHR /FETCH A CHARACTER JMP GETEOF /NONE FOUND MQL MQA TAD (-ECNWLN /CHECK FOR HARD RETURN SNA CLA JMP GETNX1 /IGNORE IT AND GET ANOTHER CHARACTER MQA /RESTORE CHARACTER JMP I GETNXT /D022CSTRNG, TEXT /^A^A!L/ / IOA text string to output LINBUF with. /D022CRSTRG, CR;0 / return to col 1 before display. LFSTRG, LF;0 / scroll to next line. /------------ PAGE / LOGON UTILITY / THIS IS THE START OF THE LOGON PROCESSOR / COME HERE FROM MAIN MENU COMMAND "LG" / LOG, CDFMYF / Map our field. JMS INITER / Initialize some common stuff AC0001 / Init some counters/pointers. /A011 DCA LINCTR / ... /A011 DCA LINBMP / /A011 TAD (BUFBEG) / Init ptr to saved text. /A011 DCA BUFPTR / ... /A011 TAD (BUFBEG-1) / Zero out saved text buffer. /A011 DCA X0 / ... /A011 TAD (BUFBEG-BUFEND-1)/ Buffer size. /A011 DCA T1 / ... /A011 INIT1, DCA I X0 / zero out the buffer. /A011 ISZ T1 / Loop on negative size count. /A011 JMP INIT1 / .... /A011 DCA TEMODE / SET INITIAL "TEXTSCAN" MODE TAD (NOP) / INITIALIZE TO "SCREEN" DCA SCRNSW TAD (SKP CLA) / INITIALIZE TO STUFF ERROR BUFFER DCA NEXTSW TAD (XRDFNC / SET FOR READ ONLY DCA GETOP TAD (LOGHLT /SET UP GOLD HALT ADDRESS DCA HALT JMS CLRSCN / CLEAR SCREEN /A025 /D025 CIFMNU / Set up to call IOA /D025 JMS I IOACAL / use IOA to clear the screen. /D025 0 / Do I/O to terminal. /D025 SCROLS / Set scrolling region to 2-24 /D025 0100 / Clear screen /D025 ESCAPE /D025 ESCAPE /D025 0100 CDFMNU / Get the file number from MENU area. TAD I (MUBUF+MNUTFN) / ... /M020 CDFMYF CIFFIO / Open file for READ-ONLY. FILEIO / ... XRDFIN SMA CLA / Skip if error condition occurs (shouldn't). JMP PARSE1 / And away we go... ERR1, JMS ABORT;1 / Report file open failure. /----------------------------------------- / / / END OF LOGON PRECESSING / / /----------------------------------------- RTNCX, JMS CLRSCN / Clear screen ENDCMD, CDFMNU / Map MENU field. AC7777 / Tell CX that we're bypassing init. DCA I (MUBUF+MNTMP6) / ... TAD LOADCX / Tell WPCMD that re're chaining to WPCX /A011 DCA I (MUBUF+MNONUM / CX overlay # /A011 TAD LOADCX+1 /A011 DCA I (MUBUF+MNONUM+1 / start address /A011 TAD LOADCX+2 /A011 DCA I (MUBUF+MNONUM+2 / CIF to CX field /A011 CDFMYF / Back to our field. ISZ EXIT / BUMP TO 'CHAIN' RETURN JMP RTNXIT / EXIT / INITIALIZE SOME THINGS COMMON TO PHONE AND LOGON INITER, XX JMS INITWS / INITIALIZE ASCIIZ WORK STRINGS DCA EOF / NOT AT END OF FILE DCA TEMODE / INITIAL "TEXTSCAN" MODE /D022 TAD (LINBUF) / Initialize Screen text pointer. /A017 /D022 DCA TYPPTR / ... /A017 /D022 DCA I TYPPTR / Init buffer to MT. /A017 TAD (SKP) DCA ECHOSW / SET TO ECHO KEYSTROKES JMS CPYTIM / COPY DATE & TIME JMP I INITER / CLEAR THE SCREEN CLRSCN, XX CIFMNU JMS I IOACAL 0 CLRMSG / Clear screen 0 JMP I CLRSCN / LOADCX, 3 /CX OVERLAY, ADDRESS, AND FIELD /A011 200 /A011 CIF 20 /A011 / / COME HERE ON GOLD HALT DURING LOGON LOGHLT, JMS ABORT;2 /EXIT THROUGH ABORT ROUTINE / OPEN FILE FOR READ-WRITE /A023 OPENRW, XX / /A023 CDFMNU / Get the file number from MENU area. TAD I (MUBUF+MNUTFN) / ... /M020 MQL /PUT IN MQ & CLEAR AC CDFMYF CIFFIO / Open file for READ-WRITE. FILEIO / ... XDSKIN JMP I OPENRW / /A023 / CLOSE THE DIRECTORY DOCUMENT CLOSE, XX CIFFIO FILEIO XDSKCL JMP I CLOSE /------------ X=. PAGE / THIS IS THE PARSER FOR THE LOGON PROCESSOR. / THE FIRST (OR ONLY) WORD OF A COMMAND IS / PARSED OFF HERE, AND CONTROL PASSED TO A / ROUTINE TO PERFORM THE REQUESTED ACTION. / / COME TO PARSE1 TO START PARSE1G THE FIRST STATEMENT / / JUMP TO "PARSER" WHEN THROUGH PROCESSING ANY STATEMENT LINE / PARSE1, JMS NEXTCH /FETCH NEXT/FIRST CHARACTER TAD EOF /CHECK FOR EOF SZA JMP ERR3 /GIVE ERROR MESSAGE IF SO PARSER, JMS SKIPBL /SKIP TO NON-BLANK JMP PARSE1 /GO GET NEW LINE IF EOL JMS GETATM /GET AN ATOM TAD CHAR TAD (-COLON /CHECK FOR COLON DELIMITER SZA JMP PBRNCH /GO CHECK ATOM FOR KNOWN COMMAND JMS NEXTCH /ATOM IS A LABEL. GO GET NEXT ATOM JMP PARSER PBRNCH, JMS LISTBR /EXIT TO A ROUTINE TO PROCESS COMMAND CMDLST JMP ERR5 /NO MATCH. NOT A VALID COMMAND ERR3, JMS ABORT;3 ERR5, JMS ABORT;5 NOSCRN, TAD (SKP CLA-NOP) / Load a SKP CLA instr for NOSCREEN. /M017 SCREEN, TAD (NOP) / load a NOP instr for SCREEN. /M017 DCA SCRNSW / SCRNSW = SKP CLA/NOP for NOSCREEN/SCREEN. JMP PARSER / Do next command. / / MENU, ABORT, AND END STATEMENTS ARE PROCESSED HERE. / EACH DRAINS THE COMM LINE UNDER THE CURRENT / SCREEN/NOSCREEN SPECIFICATION BEFORE RELINQUISHING / CONTROL. / / / MENU STATEMENT / MENU, JMS DRAINH / Drain HOST buffer JMP RTNSY / Back to MAIN MENU / / / ABORT STATEMENT / ABORTC, JMS DRAINH / Drain HOST buffer JMS ABORT;6 / Go to abort routine / / / END STATEMENT / ENDCM, JMS DRAINH / Drain HOST buffer JMP ENDCMD / Exit to CX / / CX COMMAND PROCESSED HERE / /CALL: JMP CXCMND / / parses CX command which looks like: CX KH HS KP etc. / note: the 'CX' is already parsed off. / CXCMND, TAD (CXLINE-1) / Get address of where to stuff CX commands. DCA X0 / Set aside. TAD (-CXSIZ / Get length OF CX buffer DCA CXCNT JMS NEXTCH / Get first character. JMS SKIPBL / Skip any leading blanks JMP CXDONE / Jump if EOL CXLOOP, TAD CHAR / Get character TAD (-SLASH) / Check for comments SNA CLA JMS EOLINE / Skip rest of line TAD CHAR TAD (-EOL / Line Terminator? SNA / Skip if no. JMP CXDONE / Jmp if yes. We are done. ISZ CXCNT / Bump buffer count SKP JMP ERR4 / Too long TAD (EOL / Restore character back to normal. JMS UPPER / Change character to upper case. CDFCX / Map CX field. DCA I X0 / Stuff char into CX Line buffer. CDFMYF / Back to our field. JMS NEXTCH / Get next character JMP CXLOOP / and go test it. CXDONE, CDFCX / Map CX field. DCA I X0 / Set line terminator (null) in CX line buffer. CDFMYF / Back to our field. JMP PARSER / Back to command decoder loop. UPPER, XX / Routine to UPPER-CASE a character. / Character is passed back & forth in AC. TAD (-173);SMA;JMP UPPER1 TAD (173-141);SMA;TAD (-40) TAD (141-173) UPPER1, TAD (173) JMP I UPPER CXCNT, 0 / / ROUTINE TO DELAY ONE SECOND WAIT1, XX JMS TIMER WAIT1L, JMS TIMER SNA CLA JMP WAIT1L JMP I WAIT1 / /TIMER / /CALL: JMS TIMER / / Returns w/ AC = # of secs since last call. / TIMER, XX / Entry point. CIFSYS JWAIT JMS CHKHLT / Check HALT FLAG and clear the AC. JMS DOTIME / Update date & time on screen TAD LSTIME / Get time of last time. CIA / Negate for compare. CDFSYS / Map SYS field. TAD I (CLOCK+2) / Get current SEC value. CDFMYF / Back to our field. DCA T1 / Save the difference. TAD T1 / Get back. TAD LSTIME / compute current time DCA LSTIME / and save for next time. TAD T1 / Get the difference back. SPA;TAD (74) / If negative then we bumped a minute. Fix. JMP I TIMER / Return to caller. LSTIME, 0 / Temp to hold the time of the last time. SECNDS, 0 ESCAPE, 33;0 /------------ PAGE / GO - LOGON PROCESSOR GO STATEMENT HANDLER / / THE CURRENT ATOM IS "GO" / / THE JOB OF THIS ROUTINE IS TO GET THE / STATEMENT NAME FOLLOWING THE "GO" AND / READ FILE LINES UNTIL ONE IS FOUND / THAT BEGINS WITH THAT NAME FOLLOWED BY / A COLON. IF FOUND, CONTROL IS TO BE / RETURNED TO THE PARSER. IF NOT FOUND, / IT IS A USER ERROR. / / "WAIT" ENTERS THIS ROUTINE AT "GOT" WHEN A / STRING WITH A TARGET IS MATCHED. THE TARGET / LABEL WILL BE IN "GOTRGT". / / GO, JMS SKIPTO /GET NEXT ATOM (SKIPPING OPTIONAL "TO") JMS MOVSTR /MOVE ATOM TO TARGET ATOM GOTRGT JMP ERR4 /TARGET MORE THAN 6 CHARACTERS / / GOTRGT CONTAINS THE LABEL TO GO TO GOT, TAD (NOP) /TELL NEXTCH TO STOP STUFFING DCA NEXTSW /THE ERROR MESSAGE BUFFER. TAD LINCTR /SAVE THE LINE NUMBER IN CASE OF ERROR DCA GOWLIN / GOTNXT, JMS EOLINE /GET TO NEXT LINE JMS NEXTCH /START NEW LINE JMS GETATM /LOOK FOR A STATEMENT LABEL TAD CHAR /IS ATOM FOLLOWED BY A : TAD (-COLON SZA CLA JMP GOTNXT /NO, TRY NEXT LINE / / FORCE ALL UPPERCASE ALPHAS IN ATOM TO LOWER CASE FOR MATCHING TAD (ATOM+1 DCA T1 /START OF STRING / GOTLCL, CLA TAD I T1 /FETCH A CHARACTER SNA JMP GOTLCC /END OF STRING TAD (-101 /CHECK FOR A SPA JMP GOTLCB /SMALLER THAN A. LEAVE ALONE TAD (101-132 /CHECK FOR Z SPA SNA TAD (40 /UPPER-CASE ALPHA. FORCE TO LOWER TAD (132 DCA I T1 /STORE BACK GOTLCB, ISZ T1 /BUMP TO NEXT CHARACTER JMP GOTLCL /AND TEST AGAIN / GOTLCC, JMS CMPSTR /SEE IF THIS LABEL IS THE ONE WE WANT ATOM GOTRGT JMP GOTNXT /NO, TRY FOR ANOTHER / / YES, TARGET FOUND. TAD (SKP CLA)/TURN ON THE BUFFER STUFFING AGAIN DCA NEXTSW / / CLEAR THE ERROR MESSAGE BUFFER / SO THAT IT WILL BE CURRENT. TAD (BUFBEG-1 DCA X1 GOCLR, DCA I X1 /CLEAR A CHARACTER TAD X1 /CHECK IF ALL DONE TAD (-BUFEND SZA CLA JMP GOCLR /NOT YET, DO NEXT TAD (BUFBEG /RESET POINTER TO START DCA BUFPTR / / PUT THE TARGET NAME IN THE BUFFER AS THE START OF THE LINE TAD (GOTRGT /GET TARGET NAME LOCATION DCA X1 GOTBUF, TAD I X1 /FETCH A CHARACTER SNA JMP GOCOL /END OF NAME. PUT OUT : JMS PUTBUF /PUT CHARACTER INTO BUFFER JMP GOTBUF /GO FOR ANOTHER GOCOL, TAD CHAR /PUT OUT THE DELIMITING : JMS PUTBUF / JMP PARSER /RETURN TO THE PARSER ERR4, JMS ABORT;4 /ELEMENT TOO LONG GOWLIN, 0 /LINE NUMBER OF GO OR WAIT FOR POSSIBLE ERROR MESSAGE / TYPE - LOGON PROCESSOR TYPE STATEMENT HANDLER / / THE CURRENT ATOM IS "TYPE" / / THIS ROUTINE DETERMINES WHETHER WE ARE TO / DO "TYPE [TO] HOST" OR "TYPE [TO] SCREEN" AND THEN / CALLS "TEXT" TO GET THE CHARACTERS TO BE SENT / OUT TO THE REQUESTED DESTINATION. / / / TYPE, JMS SKIPTO /GET NEXT ATOM (SKIPPING OPTIONAL "TO") JMS CMPSTR /LOOK FOR "SCREEN" OR "HOST" SCRENS ATOM SKP JMP TYPSLP /"SCREEN" FOUND JMS CMPSTR HOSTS ATOM JMP ERR7 /NEITHER FOUND / / DO TYPE HOST JMS DRAINH /DRAIN HOST INPUT BUFFER TO SCREEN OR BIT BUCKET TYPHLP, JMS TEXTSC /GO GET NEXT TEXT CHARACTER IN AC JMP ERR10 /TEXT ERROR JMP PARSER /END OF TEXT ENCOUNTERED JMS HSOUT /PUT CHARACTER OUT TO HOST JMP TYPHLP /LOOP FOR NEXT / / DO TYPE SCREEN TYPSLP, JMS TEXTSC /GO GET NEXT TEXT CHARACTER IN AC /D022 JMP TYPERR /TEXT ERROR /D022 JMP TYPDON /END OF TEXT ENCOUNTERED /D022 SPA /DON'T ALLOW BREAK OR DTR TO SCREEN /D022 JMP TYPERR /D022 JMS TTADD / Add character to IOA buffer. /D022 JMP TYPSLP /LOOP FOR NEXT /D022TYPDON, JMS TTDISP / Display stored up buffer. /D022 JMP PARSER / Return to perser. / JMP ERR10 / TEXT ERROR /A022 JMP PARSER / END OF TEXT /A022 SPA / DON'T ALLOW BREAK OR DTR /A022 JMP ERR10 / /A022 JMS KBOUT / OUTPUT CHAR /A022 JMP TYPSLP / LOOP FOR NEXT /A022 ERR7, JMS ABORT;7 /MUST BE SCREEN OR HOST /D022TYPERR, JMS TTDISP / Display stored up buffer. ERR10, JMS ABORT;10/BAD TEXT ELEMENT / FETCH THE NEXT ATOM. / IF IT IS "TO", AND NOT THE LAST ATOM OF THE LINE, / IGNORE IT AND FETCH AGAIN. SKIPTO, XX JMS GETATM /GET NEXT ATOM JMS SKIPBL /MAKE SURE THIS ATOM IS NOT THE LAST ONE JMP I SKIPTO /EOL FOUND, SO DO NOT IGNORE "TO" JMS CMPSTR /CHECK FOR OPTIONAL "TO" TOS ATOM SKP /NOT FOUND, SO RETURN JMS GETATM /IGNORE. GET NEXT ATOM JMP I SKIPTO /------------ PAGE / "TEXTSCAN" - LOGON PROCESSOR TEXT HANDLER / / JMS TEXTSCAN / ERROR RETURN (AC=0) / END OF TEXT RETURN (AC=0) / NORMAL RETURN (AC=NEXT TEXT CHARACTER) / (WARNING: USES X3 WHILE IN MODE 3!) / / ACCEPTABLE INPUTS VIA "NEXTCH": / CR (UPPER OR LOWER-CASE) / LF (DITTO) / BRK (DITTO) (RETURNS 7401) / DTR (DITTO) (RETURNS 7402) / OCTAL DIGIT STRINGS / ' TEXT ' / '~ TEXT ' / BLANKS OR TABS SURROUNDING ANY OF THE FOREGOING / & BETWEEN ANY OF THE FOREGOING / , AND EOL TERMINATING THE TEXT / TEMODE, 0 / / TEMODE IS USED TO KEEP TRACK OF THE CURRENT / STATE OF THE SCAN. IT SHOULD START OUT AT 0. / / / DISPATCH TO THE PROPER ENTRY POINT / BASED ON THE VALUE OF ARG. TEXTSC, XX TAD TEMODE /GET -ARG TAD (JMP I LOTABL) DCA .+1;XX / Dispatch. LOTABL, TEXT0 / MODE 0 --> Initial call. TEXT1 / MODE 1 --> Not initial call, but not inside of a ' TEXT2 / MODE 2 --> Currently inside of a ' TEXT3 / MODE 3 --> Cureently inside of a '~ / INITIAL CALL TEXT0, JMS SKIPBL /SKIP ANY LEADING BLANKS JMP TEDXIT /EOL FOUND TAKE DONE RETURN ISZ TEMODE /SET MODE TO 1 JMP TEXT11 /GO GET FIRST CHARACTER TEXT25, AC0001 /SET MODE TO 1 DCA TEMODE / JMP TEXT1 /GO SEE WHAT (IF ANYTHING) / ROUTINE INITIALIZED, BUT NOT INSIDE OF A ' TEXT1, JMS SKIPBL /SKIP ANY BLANKS JMP TEDXIT /EOL FOUND TAD CHAR /CHECK FOR COMMA TAD (-COMMA SNA JMP TEDXIT /TAKE THE DONE RETURN TAD (COMMA-AMPERS /CHECK FOR CONCATENATION & SZA CLA JMP TEXT11 /GO GET NEXT TEXT ITEM JMS NEXTCH /SKIP OVER CONCATENATION JMS SKIPBL JMP TEEXIT /EOL AFTER & IS AN ERROR / / CHECK NEXT ITEM FOR ', OCTAL DIGITS, CR, LF TEXT11, TAD CHAR TAD (-SQUOTE /IS IT ' SNA JMP TEXT16 /YES, CHECK FOR '~ TAD (SQUOTE-EIGHT /CHECK FOR OCTAL DIGIT SMA JMP TEXT14 /NOT OCTAL TAD (EIGHT-ZERO SPA JMP TEXT14 /NOT OCTAL DIGIT DCA TEOCT /SAVE BIT VALUE / / WE ARE SCANNING ONE OR MORE OCTAL DIGITS TEXT12, JMS NEXTCH /LOOK FOR ANOTHER DIGIT TAD CHAR TAD (-EIGHT /IS IT ANOTHER OCTAL SMA JMP TEXT13 /NO TAD (EIGHT-ZERO SPA JMP TEXT13 /NO DCA TEMP /YES, COMBINE WITH PREVIOUS RESULTS TAD TEOCT R3L /MAKE ROOM FOR 3 MORE BITS TAD TEMP /AND PUT IN CURRENT VALUE DCA TEOCT JMP TEXT12 TEXT13, CLA /LAST OCTAL DIGIT IN. TAD TEOCT /RETURN COMPOSITE RESULT AND P177 JMP TENXIT / / / CHECK FOR CR, LF, BRK, OR DTR TEXT14, JMS GETELM /GET WHATEVER ELEMENT COMES NEXT IN ATOM JMS LISTBR /BRANCH BY CONTENTS TXTLST JMP TEEXIT /NO MATCH FOUND. TAKE ERROR RETURN / / ACTION ROUTINES TCR, TAD (CR-LF /CR TLF, TAD (LF-7401 /LF TBRK, TAD (7401-7402 /BREAK CODE TDTR, TAD (7402 /DTR - HANGUP CODE / JMP TENXIT /RETURN TO CALLER / / RETURN POINTS TENXIT, ISZ TEXTSCAN /NORMAL RETURN SKP TEDXIT, DCA TEMODE /DONE RETURN. BACK TO MODE 0. ISZ TEXTSCAN TEEXIT, /ERROR RETURN JMP I TEXTSCAN / / / ' FOUND. CHECK FOR '~ TEXT16, ISZ TEMODE /SET MODE TO 2 JMS NEXTCH /GET NEXT CHAR TAD CHAR TAD (-TILDA /IS IT ~ SNA CLA JMP TEXT21 /YES, GO CHECK FOR '~' / JMP TEXT2 / CURRENTLY INSIDE OF A ' BUT NOT '~ TEXT2, TAD CHAR TAD (-EOL SNA CLA JMP TEEXIT /TAKE ERROR EXIT ON EOL TAD CHAR DCA TEMP /SAVE CURRENT CHAR TAD CHAR TAD (-SQUOTE /CHECK FOR ' SNA CLA JMP TEXT20 /' FOUND. GO CHECK FOR '' JMS NEXTCH /GET NEXT CHARACTER TAD TEMP /RETURN THE CURRENT CHARACTER JMP TENXIT / / ' FOUND. IT MAY BE THE LITERAL TERMINATOR / OR THE FIRST OF A '' PAIR TO BE TREATED / AS TEXT OF '. TEXT20, JMS NEXTCH TAD CHAR TAD (-SQUOTE /IS THE NEXT CHAR ' ALSO SZA JMP TEXT25 /NO. WE HAD A ' TERMINATOR JMS NEXTCH TAD (SQUOTE /YES, WE HAD ''. RETURN A SINGLE ' JMP TENXIT / / ROUTINE TO DO A CR LF / CRLF, XX CLA TAD (CR /D022 JMS TTADD /SEND CR JMS KBOUT /SEND CR /A022 TAD (LF /D022 JMS TTADD /SEND LF JMS KBOUT /SEND LF /A022 JMP I CRLF /------------ PAGE / / '~ HAS BEEN FOUND. IF IT IS '~' FOLLOWED BY / & OR , OR BLANK OR EOL WE WILL ACCEPT KEYBOARD TEXT AT ONCE /A006 / OTHERWISE WHAT FOLLOWS IT IS A PROMPT TO THE USER. /A006 TEXT21, JMS NEXTCH TAD CHAR /CHECK NEXT CHARACTER TAD (-EOL SNA JMP TEEXIT /ERROR IF IT WAS EOL TAD (EOL-SQUOTE SZA CLA JMP TEXT22 /PROMPT IF IT WAS NOT ' JMS NEXTCH /SEE WHAT FOLLOWS '~' TAD CHAR TAD (-SQUOTE SNA JMP TEXT22 /WE HAVE '~'' SO PROMPT SINGLE ' TAD (SQUOTE-SPACE /CHECK BLANK SZA TAD (SPACE-COMMA /CHECK , SZA TAD (COMMA-AMPERS /CHECK & SZA TAD (AMPERS-EOL SZA CLA /CHECK EOL JMP TEEXIT /ERROR IF '~' NOT FOLLOWED BY ONE OF THE ABOVE JMP TEXT26 /GO GET USER KEYSTROKES WITHOUT PROMPTING /A006 / / PROCESSING '~ / SEND REST OF TEXT ITEM TO SCREEN AS A PROMPT TEXT22, TAD CHAR /D022 JMS TTADD /SEND CHAR JMS KBOUT / SEND CHAR /A022 JMS NEXTCH /GET NEXT CHAR TAD CHAR TAD (-EOL /IS IT EOL SNA CLA /D022 JMP TEXT2E /YES. > ERROR JMP TEEXIT / YES. > ERROR /A022 TAD CHAR TAD (-SQUOTE /IS IT ' SZA CLA JMP TEXT22 /NO, GO DO ANOTHER JMS NEXTCH /YES, SEE WHAT FOLLOWS THE ' TAD CHAR TAD (-SQUOTE SNA CLA JMP TEXT22 /WE HAVE '', SO PROMPT WITH ' /D022 JMS TTDISP / Display (via IOA), the prompt. /A017 /D022 DCA TTCHRS / Reset # of rubout-able chars. /A017 / / WE HAVE REACHED THE PROMPT TERMINATOR, / ACCUMULATE THE RESPONSE IN TSTRNG. TEXT26, JMS NULSTR /INITIALIZE TSRTNG TO NULL /M006 TSTRNG /D022 DCA TTCHRS / Clear rubout character count. /M017 / CHECK THE FIRST RESPONSE CHAR & IF IT IS A RUBOUT / DO NOT ECHO THE RESPONSE ON THE SCREEN JMS KBGET /GET FIRST CHAR DCA TEMP /SAVE IT TAD TEMP TAD (-EDRBCH SZA CLA /SKIP IF A RUBOUT JMP TEXT28 /NOT RUBOUT, PROCEED NORMALLY TAD (CLA) /SET SWITCH TO NOT ECHO THIS TEXT DCA ECHOSW TEXT23, JMS KBGET /GET A RESPONSE CHARACTER DCA TEMP /SAVE RESPONSE TEXT28, TAD TEMP TAD (-EDNWLN /IS THIS THE END OF RESPONSE SNA CLA JMP TEXT24 /YES, GO SEND IT OUT TAD TEMP /NO, CHECK FOR RUBOUT AND ECHO JMS CHKRUB TSTRNG /A022 /D022 TAD TEMP /NO, ADD CHARACTER TO STRING JMS ADDSTR TSTRNG JMP TEEXIT /STRING FULL > ERROR JMP TEXT23 /GO BACK FOR MORE RESPONSE /D022TEXT2E, JMS TTDISP / Display the prompt. /A017 /D022 JMP TEEXIT / Take error exit. /A017 / / RESPONSE IS COMPLETE TEXT24, TAD (SKP) /SET ECHO SWITCH TO ECHO MODE DCA ECHOSW JMS CRLF / Echo CR-LF /A017 ISZ TEMODE /SET MODE TO 3 TAD (TSTRNG /POINT TO STRING ROOT DCA X3 / SEND THE USER RESPONSE TO A ~ PROMPT / FROM TSTRNG, ONE CHARACTER AT A TIME TEXT3, TAD I X3 /FETCH NEXT RESPONSE CHAR SZA /END OF STRING JMP TENXIT /NO, RETURN CHARACTER AC0001 /SET ARG TO 1 DCA TEMODE JMP TEXT1 /BACK TO MAIN TEXT SCAN / TEMP, 0 TEOCT, 0 / / / SCREEN LINES ARE USED AS FOLLOWS: / 0 date and time / 1 ENTER SEARCH KEY / 2 OR PRESS GOLD MENU TO RETURN TO THE MAIN MENU / 3 search key / 4 unused / 5 name selected / 6 phone number and dialing status / 7 unused /10 PRESS ADVANCE OR BACKUP TO SEE ANOTHER ENTRY /11 PRESS GOLD SEARCH TO ENTER A NEW SEARCH KEY /12 PRESS GOLD MENU TO RETURN TO THE MAIN MENU /13 TYPE CX TO DIAL AND ENTER CX /14 TYPE LG TO DIAL AND ENTER LOGON /15 + MN1 FILE SELECTION TEXT AFTER THE USER TYPES LG / / / DISPLAY THE NAME AND NUMBER DISPNM, XX CIFMNU JMS I IOACAL 0 NAMMSG 1500 0400 NAME+1 0500 NUMBR+1 JMP I DISPNM SHOOPT, XX CIFMNU /DISPLAY USER OPTIONS JMS I IOACAL 0 OPTMSG 0700 1000 1100 1200 MENMSG JMP I SHOOPT /------------ PAGE / / WAIT - LOGON PROCESSOR WAIT STATEMENT HANDLER / / THE CURRENT ATOM IS "WAIT" / / THIS ROUTINE DISCARDS OPTIONAL "FOR" AND CHECKS THE NEXT / ATOM FOR "KBD" OR "HOST" (IF NEITHER IS PRESENT THEN / THIS IS A SIMPLE TIME WAIT). THE NEXT ATOM / IS THE TIME INTERVAL IN SECONDS. / THE NEXT ATOM IS THE GO TO TARGET FOR TIME / EXPRIATION (IF NOT PRESENT THEN THE NEXT STATEMENT / IS IMPLIED). ANY REMAINING ITEMS WILL BE / TEXT / GO TO TARGET PAIRS (OF WHICH THERE MAY / BE UP TO FIVE). THE TEXT IS LIMITED TO 25 / CHARACTERS EACH. / / WTMODE WILL BE SET TO 0 FOR TIME ONLY WAIT / 1 FOR WAIT HOST / 2 FOR WAIT KBD WTMODE, 0 / WAIT, JMS GETATM /GET NEXT ATOM JMS CMPSTR /CHECK FOR "FOR" FORS ATOM SKP /SKIP IF NOT JMS GETATM /IGNORE. GET NEXT ATOM DCA WTMODE /SET WAIT MODE TO TIME ONLY DCA WTNSTR /CLEAR TEXT PAIRS COUNT JMS CMPSTR /CHECK NEXT ATOM HOSTS /IS IT HOST? ATOM SKP JMP WTHOST /YES JMS CMPSTR KBDS /IS IT KBD ATOM JMP WTT /NOT KBD OR HOST. MUST BE TIME / WAIT KBD / ISZ WTMODE / WAIT HOST / WTHOST, ISZ WTMODE JMS GETATM WTT, JMS MOVSTR /SAVE TIME INTERVAL ATOM WTTIME JMP ERR11 /BAD TIME SPEC / / TIME IS KEPT IN DOUBLE PRECISION DCA WTSECL /INITIALIZE TO 0 DCA WTSECH TAD (WTTIME DCA X1 / CONVERT TO DP BINARY WTCTL, TAD I X1 SNA JMP WTCTX /END OF TIME STRING. GO LOOK AT TEXTS DCA WTTMP TAD WTTMP /CHECK FOR NUMERIC TAD (-NINE SMA SZA JMP ERR11 /NOT NUMERIC TAD (NINE-ZERO SPA JMP ERR11 /NOT NUMERIC DCA WTTMP / MULTIPLY PREVIOUS RESULT BY 10 CLL TAD WTSECL RAL MQL TAD WTSECH RAL SWP RAL SWP RAL SWP TAD WTSECL SWP SZL IAC TAD WTSECH SWP RAL SWP RAL SWP TAD WTTMP /ADD IN NEW DIGIT DCA WTSECL SWP SZL IAC TAD WTSECH DCA WTSECH JMP WTCTL /LOOP BACK FOR NEXT DIGIT / ALL DIGITS NOW CONVERTED WTCTX, TAD WTSECH /STORE -NUMBER OF SECONDS CMA CLL DCA WTSECH TAD WTSECL CIA DCA WTSECL SZL ISZ WTSECH SKP JMP ERR11 /DON'T ALLOW WAIT 0 JMS NULSTR /CLEAR TIME GO TO TARGET WTGO JMS SKIPBC /SKIP TABS, BLANKS AND COMMAS JMP WTW /EOL FOUND. GO WAIT JMS GETATM /GET TIME TARGET JMS MOVSTR ATOM WTGO JMP ERR4 TAD (WTSLST /GET STRING LIST ADDRESS DCA WTSPTR TAD (WTGLST /SET POINTER TO LIST OF TARGETS DCA WTGPTR TAD (WTXLST /SET POINTER TO LIST OF STRING POSITIONS DCA WTXPTR JMP WTTL1 /GO GET TEXT STRING / TARGET PAIRS / ERR11, JMS ABORT;11 X=. /------------ PAGE / / GATHER TEXT STRING / GO TO TARGET PAIRS / WTTL1, JMS SKIPBC /SKIP DELIMITERS JMP WTW /EOL FOUND. GO WAIT TAD WTMODE /CHECK FOR TIME ONLY WAIT /A013 SNA CLA /NO, WAIT HOST OR KBD /A013 JMP ERR7 /YES, SHOULD NOT HAVE STRINGS /A013 TAD I WTSPTR /GET STRING ADDRESS SNA JMP ERR12 /END OF LIST REACHED. TOO MANY PAIRS DCA WTSS1 TAD I WTSPTR DCA WTSS2 TAD I WTSPTR /ADD TO LIST OF FIRST CHARACTERS IAC DCA I WTXPTR ISZ WTXPTR ISZ WTSPTR TAD I WTGPTR /GET TARGET ADDRESS DCA WTSS3 TAD I WTGPTR DCA WTSS4 ISZ WTGPTR ISZ WTNSTR /BUMP COUNT OF TEXT STRINGS JMS NULSTR /CLEAR A TEXT STRING WTSS1, 0 WTTXL, JMS TEXTSCAN /GO GET A TEXT CHARACTER JMP ERR10 JMP WTETX /END OF TEXT SPA /DON'T ALLOW BREAK OR DTR JMP ERR10 DCA WTTMP /SAVE TEXT CHARACTER TAD WTTMP SNA /DON'T ALLOW NULLS JMP ERR10 TAD (-177 SNA CLA /OR RUBOUTS JMP ERR10 TAD WTTMP TAD (-CR /CHECK FOR CR SZA CLA JMP WTTNCR /NOT CR AC7776 TAD WTMODE /CHECK FOR WAIT KBD SNA CLA /SKIP IF NOT JMP WTTCR /WAIT KBD ... CR FOUND, DO NOT PUT ON STRING WTTNCR, TAD WTTMP JMS ADDSTR /APPEND CHARACTER TO STRING WTSS2, 0 JMP ERR4 JMP WTTXL /GO GET ANOTHER / / WAIT KBD ... CR FOUND. SHOULD BE THE END OF TEXT ITEM WTTCR, JMS TEXTSCAN /SYNTAX ERROR IF MORE TEXT AFTER A CR JMP ERR10 SKP JMP ERR10 / / NOW GET THE TARGET ASSOCIATED WITH THE TEXT WTETX, JMS NULSTR /CLEAR TARGET WTSS3, 0 JMS SKIPBC JMP WTW /EOL FOUND JMS GETATM /GET TARGET JMS MOVSTR ATOM WTSS4, 0 JMP ERR4 JMP WTTL1 /GO LOOK FOR ANOTHER PAIR / / ALL TEXT / GO TO PAIRS ARE IN WTW, JMS TIMER /INITIALIZE THE SYSTEM TIMER AC7776 TAD WTMODE /SEE WHAT KIND OF WAIT THIS IS SZA JMP WTTIML /NOT WAIT KBD. GO CHECK TIME. / WAIT KBD JMS NULSTR /INITIALIZE THE KEYBOARD STRING WTKBS /D022 DCA TTCHRS /RESET KEYSTROKE COUNTER JMP WTTIML /START TIMING AND MONITORING THE KBD / ERR12, JMS ABORT;12 /D022TTADD, XX / Common routine to add character (from file) to IOA buffer. /D022 DCA I TYPPTR / Stuff character into buffer. /D022 TAD I TYPPTR / Get character back. /D022 ISZ TYPPTR / Bump buffer ptr. /D022 TAD (-LF) / Did we just output a LINE FEED? /D022 SNA CLA / Skip if no. If yes, dump stored buffer. /D022 JMS TTDUMP / Dump stored up buffer. /D022 JMP I TTADD / Return to caller. /D022TTDUMP, XX / Common routine to dump stored up buffer. /D022 JMS TTDISP / Display stored buffer (thus far). /D022 TAD (LINBUF) / Initialize buffer ptr. /D022 DCA TYPPTR / ... /D022 DCA TTCHRS / Reset # of characters in TT buffer (for Rubout). /D022 JMP I TTDUMP / Return to caller. /D022TTDISP, XX / Routine to display contents of stored buffer. /D022 DCA I TYPPTR / Set stopper. /D022 CIFMNU / Call IOA to output what we've got thus far. /D022 JMS I IOACAL / ... /D022 KBOUT / Use KBOUT routine to output (also check for HALT). /D022 CSTRNG / Control string /^A/ /D022 CRSTRG / 1st output a CR. /D022 LINBUF / where the actual text to output is. /D022 JMP I TTDISP / Return to caller. /D022TTADDD, XX / Called from IOACAL to output PUTMSG txt. /A018 /D022 DCA TTDISP / Save char. /D022 RDF / Get return field. /D022 TAD CIDF0 / Create a return CIF CDF instr. /D022 DCA TTADEX / Save for the exit. /D022 CDFMYF / Map our field. /D022 TAD TTDISP / Get char to output. /D022 SZA / Skip if the end. /D022 JMS TTADD / if not the end then add to buffer. /D022TTADEX, XX / Return CIF CDF instruction. /D022 JMP I TTADDD / Return to caller. FOFMES, IFDEF ENGLSH < TEXT /&FILE &OPEN &FAILURE/> IFDEF ITALIAN < TEXT /&DOCUMENTO DI COLLEGAMENTO NON ESITENTE/> IFDEF V30NOR < TEXT '&KAN IKKE FINNE FIL'> /A027 IFDEF V30SWE < TEXT '&FEL VID \VPPNING AV FIL'> IFDEF DUTCH < TEXT '&FOUT BIJ OPENEN BESTAND'> IFDEF SPANISH < TEXT '&FALLO AL &ABRIR &FICHERO'> /------------ PAGE / UPDATE THE TIME LIMIT FOR THIS WAIT / WTTIML, JMS TIMER /GET ELAPSED SECONDS CLL TAD WTSECL /APPLY TO LIMIT DCA WTSECL SZL ISZ WTSECH SKP JMP WTTEXP /TIME LIMIT HAS EXPIRED / TAD WTMODE /CHECK KIND OF WAIT WE ARE DOING CIA SNA JMP WTTIML /TIME WAIT ONLY IAC SNA CLA JMP WTH /GO TO WAIT HOST JMP WTK /GO TO WAIT KBD / / THE TIME LIMIT HAS EXPIRED / WTTEXP, CLA TAD (WTGO /GET THE ADDRESS OF THE GO TO TARGET JMP WTEXIT WTXGO, TAD (WTGLST /GET THE ADDRESS OF THE STRING'S TARGET TAD WTNSTR TAD WTSCTR DCA WTTMP TAD I WTTMP WTEXIT, DCA WTTARG /SAVE TARGET STRING ADDRESS TAD WTTARG /CHECK FOR NULL TARGET DCA X1 TAD I X1 SZA CLA JMP WTTGO /EXIT TO TARGET JMS EOLINE /NULL TARGET STRING. GO TO NEXT LINE JMP PARSER WTTGO, JMS MOVSTR /MOVE TARGET STRING WTTARG, 0 GOTRGT JMP ERR4 JMP GOT /EXIT VIA THE GO PROCESSOR WTTMP, 0 WTNSTR, 0 WTSCTR, 0 WTSECL, 0 /WAIT SECONDS, LOW ORDER WTSECH, 0 /WAIT SECONDS, HIGH ORDER / WAIT KBD WTK, JMS KBINPT /GET A CHAR JMP WTTIML DCA WTKCH /SAVE KEYBOARD CHARACTER TAD WTKCH JMS CHKRUB /ECHO IT WTKBS /A022 /D022 TAD WTKCH /IS IT CR TAD (-EDNWLN SNA CLA JMP WTKCR /YES TAD WTKCH /NO, APPEND TO KEYBOARD STRING JMS ADDSTR WTKBS JMP ERR4 JMP WTTIML /GO CHECK ON TIME AGAIN / / CR FOUND. THE KEYBOARD ENTRY IS COMPLETE WTKCR, TAD (LF /CR FOUND. ADD A LF JMS KBOUT / TAD WTNSTR /CHECK NUMBER OF STRINGS TO MATCH SNA JMP WTTIML /NONE. GO CHECK TIME CIA /SAVE -COUNT DCA WTSCTR TAD (WTSLST /GET LIST OF STRING ADDRESSES DCA WTKPTR WTKCR2, TAD I WTKPTR /GET A STRING ADDRESS DCA WTKSAD JMS CMPSTR /CHECK FOR A MATCH WTKSAD, 0 WTKBS SKP JMP WTXGO /MATCH FOUND. GO TO THE TARGET LABEL ISZ WTSCTR /THIS STRING DID NOT MATCH. ARE THERE MORE JMP WTKNXT /YES, TRY NEXT JMS NULSTR /NO, CLEAR KEYBOARD STRING WTKBS JMP WTTIML /GO CHECK TIME AND WAIT FOR MORE KB INPUT / WTKNXT, ISZ WTKPTR /BUMP TO NEXT STRING ADDRESS JMP WTKCR2 WTKCH, 0 WTKPTR, 0 / / PUSH THE AC CHARACTER INTO A CIRCULAR BUFFER FOR / USE BY THE ABORT ERROR PROCESSOR. DO IT / HERE RATHER THAN AT THE GETCHR LEVEL SO / THAT MISSING GO TARGETS DON'T WIPE OUT / THE EVIDENCE. / PUTBUF, 0 DCA I BUFPTR / Save character in character buffer. TAD BUFPTR / Now to update buffer pointer. TAD (-BUFEND) / See if currently at last buffer posn. SMA / Skip if not yet. TAD (BUFBEG-BUFEND-1) / Re-orient to start of buffer. TAD (BUFEND+1) / Bump ptr by 1. DCA BUFPTR / Save ptr. JMP I PUTBUF /RETURN /------------ PAGE / WAIT HOST WTH, JMS HSINPT /WAIT HOST. GET A CHAR JMP WTTIML /NONE FOUND AND P177 /KEEP ONLY 7 BITS SNA JMP WTTIML /SKIP NULLS DCA WTHCHR /SAVE CHARACTER TAD WTHCHR JMS SCROUT /GO DISPLAY IF "SCREEN" IN EFFECT / / / LATEST CHARACTER FROM THE HOST IS IN WTHCHR. / CHECK FOR A MATCH WITH ANY OF THE TEXT STRINGS. / A LOWER CASE ALPHA STRING CHARACTER WILL MATCH / EITHER A LOWER OR UPPER CASE HOST CHARACTER / IN WTHCHR. / / TAD WTNSTR /GET NUMBER OF STRINGS TO BE CHECKED SNA JMP WTTIML /NO STRINGS. GO CHECK TIME LIMIT CIA DCA WTSCTR TAD (WTXLST /INITIALIZE LIST POINTERS DCA WTXPTR TAD (WTSLST DCA WTSPTR WTXL1, TAD I WTXPTR /GET ADDRESS OF A STRING CHARACTER DCA WTADDR DCA WTUCLC /CLEAR THE UPPER/LOWER ADJUSTER TAD I WTADDR /GET THE CHARACTER TAD (-172 /IS IT LOWER CASE SMA SZA JMP WTNLC /NO TAD (172-141 SPA CLA JMP WTNLC /NOT LOWER CASE TAD (40 /STRING CHARACTER IS LOWER CASE DCA WTUCLC /STORE ADJUSTMENT WTNLC, CLA TAD I WTADDR /GET THE STRING CHARACTER AGAIN CIA TAD WTHCHR /DOES IT MATCH SZA TAD WTUCLC SZA CLA JMP WTXNO /DOES NOT MATCH ISZ WTADDR /MATCHES, BUMP TO NEXT CHARACTER IN STRING TAD I WTADDR /CHECK IF END OF STRING SNA CLA JMP WTXGO /YES. THIS STRING HAS BEEN MATCHED TAD WTADDR /NOT THE END YET. SET TO TEST NEW CHAR NEXT TIME DCA I WTXPTR JMP WTXNXT / THE LATEST CHARACTER DID NOT MATCH THE ONE / POINTED TO IN THIS STRING. BACK UP OVER ANY / REPEATED SEQUENCES AND TRY AGAIN. IF NO / REPEATS, RESET THE POINTER TO THE BEGINNING / OF THE STRING. WTXNO, TAD I WTSPTR /GET ADDRESS OF FIRST STRING CHAR IAC DCA WTLOPS TAD WTLOPS /SEE IF WE ARE BEYOND FIRST CHAR CIA TAD WTADDR SNA CLA JMP WTXNXT /NO, THE MISMATCH WAS AT THE BEGINNING TAD WTLOPS /GET ADDRESS OF SECOND CHAR IAC DCA WTHIPS WTXNO1, TAD WTHIPS /CHECK IF UP TO CURRENT MISMATCH CIA TAD WTADDR SNA CLA JMP WTXNO4 /YES, NO MORE REPEATS TO CHECK TAD WTLOPS /INITIALIZE THE LOW RUNNING POINTER DCA WTLOP TAD WTHIPS /INITIALIZE THE HIGH RUNNING POINTER DCA WTHIP WTXNO2, TAD I WTLOP /GET A LOW CHARACTER CIA TAD I WTHIP /COMPARE TO A HIGH CHARACTER SNA CLA JMP WTXNO3 /THEY MATCH, SO THIS MAY BE A REPEATED SEQUENCE ISZ WTHIPS /NO MATCH. TRY ONE FARTHER UP JMP WTXNO1 WTXNO3, ISZ WTLOP /BUMP BOTH RUNNING POINTERS ISZ WTHIP TAD WTHIP /CHECK IF WE ARE UP TO THE CURRENT MISMATCH CIA TAD WTADDR SZA CLA JMP WTXNO2 /NO, KEEP GOING ON THIS REPEAT TAD WTLOP /COMPLETE REPEAT FOUND. DCA I WTXPTR /RESUME MATCHING AFTER IT JMP WTXL1 WTXNO4, TAD WTLOPS /NO REPEAT. POINT BACK TO STRING START DCA I WTXPTR JMP WTXL1 /TEST FOR MATCH THERE WTXNXT, ISZ WTSCTR /CHECK FOR MORE STRINGS TO TEST SKP JMP WTTIML /NONE. GO CHECK TIME LIMIT ISZ WTXPTR /POINT TO THE NEXT ONE ISZ WTSPTR JMP WTXL1 WTLOP, 0 WTLOPS, 0 WTHIP, 0 WTHIPS, 0 WTUCLC, 0 WTHCHR, 0 WTADDR, 0 /D025SCROLS, TEXT /^P!E^A&[2;24R^A&[?6H^P/ /SET SCROLL 2 TO 24 /D025SCROLR, TEXT /!X^A&[R!L!Y^A/ /RESET SCROLL /------------ PAGE / / "DIAL" COMMAND. / PARSE OFF COMMA DELIMITED PHONE NUMBER TEXT / AND SEND TO THE DIALER. IF NOT ANSWERED, TRY / THE NEXT NUMBER (IF ANY). EXIT THROUGH ABORT / IF NO CALLS COMPLETED. DIAL, JMS DRAINH /CLEAR OUT THE COMM LINE JMS NULSTR /CLEAR OUT THE PHONE NUMBER NUMBR JMS CRLF /GET TO A FRESH LINE JMS PUTMSG /SHOW "DIALING" DIAMSG DIGET, JMS TEXTSC /GET A PHONE NUMBER CHARACTER JMP ERR10 /SYNTAX ERROR JMP DIGOT /FULL NUMBER NOW FETCHED SPA /DON'T ALLOW BREAK OR DTR JMP ERR10 DCA T1 TAD T1 /DISPLAY IF "SCREEN" IN EFFECT JMS SCROUT / Add to TT buffer (if SCREEN in effect). /D022 JMS TTDISP / Update screen. TAD T1 JMS ADDSTR /APPEND TO NUMBER NUMBR JMP ERR4 /TOO BIG JMP DIGET /GO BACK FOR ANOTHER DIGOT, JMS DIALER /GO TRY DIALING THE NUMBER JMP DINOA /NOT ANSWERED JMS EOLINE /ANSWERED. SKIP REST OF LINE JMP PARSE1 /BACK TO PARSE NEXT LINE DINOA, JMS CRLF /GET NEW LINE JMS SKIPBC /LOOK FOR ANOTHER NUMBER TO TRY SKP /NONE JMP DIAL /BACK TO TRY AGAIN JMS ABORT;14 /NO NUMBER ANSWERED. ABORT / /KBINPT / /CALL: JMS KBINPT / RETURN 1: no char return point (AC set to 0) / RETURN 2: char return in AC. / / if no character, JWAIT is executed before return. / KBINPT, XX / entry point. CIFSYS / Map SYS field. XLTIN / Get keyboard input character. JMP KBINP1 / Take nothing exit. ISZ KBINPT / Map return. TAD (-EDTAB / Check for TAB SNA TAD (ECTAB-EDTAB / Turn into a real TAB TAD (EDTAB JMP KBINP2 / Return w/ character in AC. KBINP1, CIFSYS / Map sys field. JWAIT / Let others run. KBINP2, JMP I KBINPT / Return to caller. w/ character (or 0) from XLTIN / /KBOUT / /CALL: JMS KBOUT (AC = character to output) / / character is output to terminal, JWAITing and checking HALT flag / as necessary. Return is made only after character is output. / This routine is made cross-field callable so that it may be used / as the output routine for IOA calls. / KBOUT, XX / entry point. DCA KBTEMP / Save character. /D022 RDF / Get field of caller. /D022 TAD CIDF0 / Make our return CIF CDF instr. /D022 DCA KBEXIT / Return to caller. /D022 CDFMYF / back to our field. KBOUT1, TAD KBTEMP / Get character to output. TAD (-TAB / TAB ? /A022 SNA / NO /A022 TAD (SPACE-TAB / CONVERT TABS TO SPACES /A022 TAD (TAB / RESTORE CHAR /A022 CIFSYS / Map SYS field. TTYOU / output character. SKP / Skip if couldn't. JMP I KBOUT / RETURN WHEN CHAR IS OUTPUTTED /A022 /D022 JMP KBEXIT / Return when character is outputted. JMS CHKHLT / Check HALT flag. CIFSYS / Map SYS field for JWAIT. JWAIT / Let others run. JMP KBOUT1 / Try again. /D022KBEXIT, XX / Set to return CIF CDF. /D022 JMP I KBOUT / Return to caller. KBTEMP, 0 / a temp for the char being output. / /HSINPT / /CALL: JMS HSINPT / RETURN 1: no char return point (AC set to 0) / RETURN 2: char return (AC set to 7 bit character). / / additionally, if no character, JWAIT is executed before return. / HSINPT, XX / entry point. JMS CHKHLT / See if to be halted. CIFSYS / Map SYS field. HS2IN / Get character from HOST line. JMP HSINP1 / Take nothing exit. ISZ HSINPT / Map return. JMP HSINP2 / Return w/ character in AC. HSINP1, CIFSYS / Map sys field. JWAIT / Let others run. HSINP2, JMP I HSINPT / Return to caller. w/ character (or 0) from TTYIN / /HSOUT / /CALL: JMS HSOUT (AC = character to output) / / MAY DESTROY T1 / / character is output to terminal, JWAITing and checking HALT flag / as necessary. Return is made only after character is output. / HSOUT, XX / entry point. HSOUT1, CIFSYS / Map SYS field. HS2OU / output character. SKP / Skip if couldn't. JMP I HSOUT / Return upon success. DCA T1 / Save character. JMS CHKHLT / Check HALT flag. TAD T1 / Get character back. CIFSYS / Map SYS field for JWAIT. JWAIT / Let others run. JMP HSOUT1 / Try again. / /CHKHLT / /CALL: JMS CHKHLT / / If HALT FLAG is set, reset it and go to halt address. / Otherwise, return with AC=0. / CHKHLT, XX / entry point. CLA / init AC. CDFSYS / Map SYS field. TAD I HLTFLG / Get halt flag indicator. CDFMYF / Back to our field. SNA CLA / Skip if set. JMP I CHKHLT / Return to caller. CDFSYS / Clear HLTFLG DCA I HLTFLG CDFMYF JMP I HALT / GOLD HALT HAS BEEN SENT TIMMSG, TEXT /!X^A&[?6L^P^A!L^A&[?6H!Y/ CLRMSG, TEXT /^P!E/ /------------ PAGE / / SUBROUTINE TO DIAL A NUMBER / / MOVE NUMBER TEXT TO ASCIIZ STRING "NUMBR" / JMS DIALER / NOT ANSWERED RETURN / ANSWERED RETURN DIALER, XX /D022 JMS RSLNBF / RESET LINE BUFFER /A021 CDFMNU / CK FOR INTEGRAL MODEM ENABLED /A016 TAD I (MUBUF+MNFMAT) / /A016 CDFMYF / /A016 AND (MNFM4X / /A016 SNA CLA / SKIP IF ENABLED /A019 JMP IMODC1 / NO - ASSUME DF03 /A019 TAD (4003 / ISSUE ENABLE /A019 H2DTR / /A019 CLA / MUST BE CLEARED /A019 LAS / CK IF THE MODEM IS PRESENT /A019 AND (4000 / BIT 0 IS MODEM BIT /A019 SNA CLA / 0 = ENABLED /A019 JMP ADIMCK / YES - GO INIT., RET. AT IMODEX, /A019 IMODC1, JMS DRAINH / NO - CLEAR INPUT BUFFER /A016 TAD (CTLA / ASSUME DF03 /A016 JMS HSOUT / /A016 JMS WAIT1 / /A016 TAD (CTLB / /A016 JMS HSOUT / /A016 JMS WAIT1 / /A016 IMODEX, TAD (-43 /INITIALIZE A 35 SECOND WAIT /M016 DCA SECNDS JMS PUTMSG /TELL USER TO BE PATIENT WATMSG TAD (NUMBR /POINT TO NUMBER DCA X1 / SEND DIGITS ONE AT A TIME NUMLOP, CLA TAD I X1 /FETCH A CHARACTER SNA JMP DIALWT /LAST DIGIT SENT. WAIT FOR RESPONSE TAD (-DASH /CHECK FOR IGNORED CHARACTERS SZA TAD (DASH-LPAR SZA TAD (LPAR-RPAR SZA TAD (RPAR-SPACE SNA JMP NUMLOP /IGNORE THIS CHAR AND GET ANOTHER TAD (SPACE) / RESTORE CHAR /A024 /D024 TAD (SPACE-ESIGN /CHECK FOR = /D024 SZA /D024 JMP NUMTST /GO CHECK FOR VALID DIGIT /D024 TAD (ESIGN /= IS A VALID DELAY CHAR /D024 JMP SEND /SEND IT OUT / /D024NUMTST, TAD (ESIGN-ZERO /CHECK FOR VALID DIGIT /D024 SPA /D024 JMP BADNUM /D024 TAD (ZERO-NINE /D024 SMA SZA /D024 JMP BADNUM /D024 TAD (NINE SEND, JMS HSOUT /SEND DIGIT TO DIALER JMP NUMLOP /GO GET NEXT DIGIT / NUMBER HAS BEEN COMPLETELY DIALED. WAIT FOR ANSWER DIALWT, TAD (43 / # SIGN FOR INTEGRAL MODEM /A016 JMS HSOUT / /A016 DIALW1, JMS CHKHLT /CHECK FOR GOLD HALT JMS TIMER /WAIT 35 SECONDS AFTER START OF DIALING TAD SECNDS DCA SECNDS TAD SECNDS SMA JMP UNKOWN /NO RESPONSE AT ALL JMS HSINPT /WAIT FOR A CHAR JMP DIALW1 /NONE YET AND (177 / SEVEN BITS ONLY /A016 TAD (-A /IS IT A SMA / /A016 SKP / /A016 JMP DIALW1 / LESS THAN "A" DON'T CARE /A016 SNA / GREATER THAN "A" - CONTINUE /A016 JMP ANSW /YES. LINE ANSWERED TAD (A-B /IS IT B SNA / NO - CONTINUE /M016 JMP DALBSY / YES - LINE IS BUSY /A016 TAD (B-N / CK FOR "No" /A016 SNA / /A016 JMP NOANS / YES - /A016 JMP DIALW1 / NO - GO BACK AND WAIT /A016 / LINE ANSWERED ANSW, JMS WAIT1 / WAIT FOR REST OF STRING /A016 JMS DRAINH / CLEAR INPUT BUFFER /A016 JMS PUTMSG /TELL USER ANSMSG ISZ DIALER /TAKE SECOND RETURN / DIALING COMPLETED. RETURN SUCCESS OR FAILURE DIALX, JMS WAIT1 /ALLOW A SECOND FOR USER TO SEE MESSAGE JMS CRLF /GET TO NEXT LINE ON SCREEN JMP I DIALER / BADNUM, JMS PUTMSG /BAD CHAR IN NUMBER. TELL USER BADMSG JMP DIALX /TAKE NO ANSWER RETURN / UNKOWN, JMS PUTMSG /UNKNOWN RESPONSE FROM DIALER UNKMSG JMP DIALX /TAKE NO ANSWER RETURN /------------ PAGE / /ABORT / /CALL: JMS ABORT / n / / n is an argument indicating which error message to display. / / 1 = FILE OPEN FAILURE / 2 = GOLD HALT DETECTED / 3 = MISSING END STATEMENT / 4 = ELEMENT TOO LONG / 5 = INVALID COMMAND / 6 = ABORT STATEMENT EXECUTION. / 7 = TYPE OR WAIT OBJECT NOT SPECIFIED /A013 / 10 = INVALID TEXT ELEMENT / 11 = INVALID TIME SPECIFICATION / 12 = TOO MANY WAIT STRINGS / 13 = MISSING GO/WAIT TARGET / 14 = DIALING NOT COMPLETED / USES T1 / ABORT, XX / Entry point. PURGEK, JMS KBINPT / Purge keystrokes SKP / Skip if none JMP PURGEK / Loop for more CIFMNU / Map menu field. JMS I IOACAL / Display start of message. 0 / No alternate routine for output. ABRMSG / Abortion message. 0 / Posn cursor to HOME. 0424 / Posn cursor to line 4 col 20. TAD I ABORT / Get calling argument. TAD (ABRTBL-1) / Index into message pointer table. DCA T1 / Get ptr to message address. TAD I T1 / Get Message address. DCA ABRTL1 / plop down. DCA NOTYET / Init 'seen EOL' flag. /A011 TAD ABRTL1 / Check for ABORT 13 TAD (-GOWMES / Which has a different format message SZA CLA / Skip if GO/WAIT message JMP ABRTT1 / Jump for all other messages CIFMNU / Map menu display JMS I IOACAL / Display the missing GO/WAIT label 0 GOWMES GOTRGT+1 / Start of target name JMP ABRTT2 / Rejoin other messages ABRTT1, CIFMNU / Map IOACAL. JMS I IOACAL / Display the reason 0 / to the screen. ABRTL1, XX / Set to message to display. ABRTT2, CIFMNU / Now display where the error occurred. JMS I IOACAL / ... 0 / To the terminal DSPMSG / the message. 0624 / line 6, col 20 LINCTR / ptr to the line #. 1000 / Where to put up the text. TAD BUFPTR / Get ptr to saved text. DCA T1 / initialize bufptr. JMP ABRTL3 ABRTL2, TAD T1 / Check for doneness. CIA / ... TAD BUFPTR / ... SNA CLA / Skip if not done. JMP ABRTL6 / Jmp when done outputting saved text. ABRTL3, TAD NOTYET / displaying yet? SNA CLA / Skip if yes. JMP ABRTL4 / JMP if no. TAD I T1 / Get character to output. SNA / Skip if not null. JMP ABRTL5 / Jmp if null character. Go to next. JMS KBOUT / Output character ABRTL4, TAD I T1 / Get character just output. SNA JMP ABRTL9 / Jump if null TAD (-ECNWLN) / Check for NEW LINE. SZA CLA / Skip if yes. JMP ABRTL5 / NOPE! continue below. TAD (CR) / get to start of next line. JMS KBOUT ABRTL9, ISZ NOTYET / time to display!!! ABRTL5, TAD T1 / Now check for buffer wrap. TAD (-BUFEND) / ... SMA / Skip if not at end. TAD (BUFBEG-BUFEND-1) / Wrap to start of buffer. TAD (BUFEND+1) / ... DCA T1 / Save in register. JMP ABRTL2 / Go do next character. ABRTL6, TAD NOTYET / Are we displaying SZA CLA / Skip if no. have to re-display. JMP ABRTL7 / Go finish up. ISZ NOTYET / enable display. JMP ABRTL3 / Go re-display the text. ABRTL7, CIFMNU / Map menu. JMS I IOACAL / Finish the display. 0 / No alternate output routine. FINMSG / Finish the display... 2014 / Line 16 col 12 MENMSG 2214 / Line 18 col 12 ABRTLP, JMS KBGET / Look for RETURN or GOLD MENU TAD (-EDMENU) / GOLD:MENU!!! return to Main Menu. SNA / Skip if no. JMP RTNSY / JMP if yes!!! Back to Main Menu. TAD (EDMENU-EDNWLN) / RETURN? SNA CLA / Skip if no. Report error. JMP RTNCX / YES! Onward to CX. JMS BEEPER / REPORT ERROR JMP ABRTLP / Get another input. / ROUTINE TO UPDATE OUR DISPLAY OF THE DATE & TIME DOTIME, XX CIFPRT / Call FLABUZ in printer field. JMS I (FLABUZ) / ... (display printer error if appropriate) CIFMNU / Now display updated time. JMS I TIMCAL / ... JMP I DOTIME / no time change. don't update display. JMS CPYTIM / Copy new time values. CIFMNU / Now to update the screen. JMS I IOACAL / ... 0 / output directly to the terminal. TIMMSG / ... ESCAPE 0072 / Line 1, col 59. DATTIM / Time/Date string. ESCAPE JMP I DOTIME NOTYET, 0 / set to <> 0 when start displaying saved lines. / / ROUTINE TO RING THE BELL / BEEPER, XX CLA TAD (BELL JMS KBOUT JMP I BEEPER /------------ PAGE / ROUTINE TO WAIT FOR A CHARACTER FROM THE KEYBOARD / AND RETURN IT IN THE AC. THE DATE AND TIME DISPLAY / WILL BE UPDATED WHILE WAITING. / KBGET, XX KBGETL, JMS DOTIME /UPDATE DATE & TIME DISPLAY JMS CHKHLT /CHECK FOR GOLD HALT JMS KBINPT /GET THE NEXT KEYSTOKE IN THE AC JMP KBGETL /NOT FOUND JMP I KBGET /FOUND. RETURN CHAR IN AC / / ROUTINE TO PUT THE AC ON THE SCREEN, TAKING / APPROPRIATE ACTION FOR RUBOUT. / / / ROUTINE TO PUT THE AC ON THE SCREEN, TAKING / APPROPRIATE ACTION FOR RUBOUT. / CHKRUB, XX DCA GTTEMP / Save incoming char. TAD I CHKRUB / Get string pointer. DCA CHKPTR / Save for positioning the pointers. ISZ CHKRUB / Bump to actual return. ECHOSW, SKP / SET TO (CLA) WHEN USER WANTS NO ECHOING/A022 JMP CHKXIT / RETURN IF ECHO IS OFF /A022 CKRUB1, ISZ CHKPTR / Bump string pointer. TAD I CHKPTR / Get next char of string. SZA CLA / Skip if not at string end yet. JMP CKRUB1 / Keep looping until just after last char. TAD GTTEMP / Get char back. TAD (-EDRBCH / RUB CHAR? SNA / Skip if no. JMP GTRBCH / JMP if so. Rubout the last character. TAD (EDRBCH-EDRBWD / RUB WORD? SNA / Skip if no. JMP GTRBWD / JMP if so. Rubout the last word. TAD (EDRBWD / Restore the character. JMS KBOUT / Display (echo) the character. CHKXIT, TAD GTTEMP / Get character. JMP I CHKRUB / return to caller. / / GTRBCH - RUBOUT A CHARACTER. / GTRBCH, JMS GTRBCR / CALL RUB CHAR CKBEEP, JMS BEEPER / NO CHARACTERS TO RUBOUT JMP CHKXIT / Something successfully rubbed out. exit. / / GTRBWD - RUBOUT A WORD / GTRBWD, JMS GTBKCR / Get character one back from here TAD (-40) SMA SZA CLA / Skip if a space or less (ie not a character). JMP GTRBW2 / found a character (start of word). JMS GTRBCR / Rub out leading spaces, tabs, etc. JMP CHKXIT / Line empty return. JMP GTRBWD / do rest of leading spaces, tabs, etc. GTRBW2, JMS GTBKCR / Get character one back from here TAD (-40) SMA SZA CLA / Skip if not a word character. JMS GTRBCR / Rub out a character of word. JMP CHKXIT / Line empty, so done. JMP GTRBW2 / check out next (preceding) character. / / GTRBCR - RUB A CHARACTER / IF THERE ARE NO CHARS IT WILL DO A NON SKIP RETURN / IF DID RUB OUT SOMETHING THEN A NORMAL (2ND) RETURN / GTRBCR, XX AC7777 / Decrement the character pointer. TAD CHKPTR DCA CHKPTR TAD I CHKPTR / ... SPA CLA / Skip if there's a char to rubout. JMP I GTRBCR / Take MT return. ISZ GTRBCR / Bump to successful return. TAD (BSPACE / OUTPUT BS SP BS JMS KBOUT / TAD (SPACE / JMS KBOUT / TAD (BSPACE / JMS KBOUT / JMP I GTRBCR / Return GTBKCR, XX AC7777 / Back up the char pointer. TAD CHKPTR / ... DCA T1 / .... TAD I T1 / ... SMA / Skip if buffer MT. JMP I GTBKCR / Return w/ prior character. JMP CKBEEP / Buffer MT. Report error & take early return. GTTEMP, 0 / Temp. CHKPTR, 0 / Pointer into string that holds prior (echoed) text. / / ROUTINE TO DRAIN TEXT FROM TTHE HOST. / PUT IT ON THE SCREEN IF "SCREEN" IN EFFECT; / OTHERWISE THROW IT AWAY. / DRAINH, XX DRLOOP, JMS HSINPT /SEE IF ANYTHING IN HOST BUFFER JMP I DRAINH /A022 /D022 JMP DREXIT / Update screen & return if not. JMS SCROUT /GO DISPLAY OR DISCARD JMP DRLOOP /GO CHECK FOR MORE /D022DREXIT, JMS TTDISP / Update screen. /A017 /D022 JMP I DRAINH / Return to caller. /A017 / ROUTINE TO PUT THE AC ON THE SCREEN IF / "SCREEN" IS IN EFFECT. SCROUT, XX SCRNSW, NOP /CHANGED TO SKP CLA FOR "NOSCREEN" JMS KBOUT /A022 /D022 JMS TTADD / Add char to display buffer. /M017 JMP I SCROUT / ROUTINE TO PUT THE NEXT CHARACTER FROM THE / FILE INTO CHAR. / IF NEXTSW IS NOP, PUSH CHAR INTO THE ERROR / MESSAGE BUFFER. IF IT IS SKP, DO NOT DO / THIS SO THAT THE USER WILL SEE THE GO/WAIT / THAT COULD NOT BE SATISFIED. / NEXTCH, 0 JMS GETCHR /GET NEXT FILE CHARACTER JMP ERR13 /END OF FILE REACHED DCA CHAR TAD LINBMP / Start of new line? SZA CLA ISZ LINCTR / Yes, bump line number DCA LINBMP TAD T1 / Get character. AND P177 / Check for line terminator. TAD (-ECNWLN) / this is one set, SZA / SKip if yes. TAD (ECNWLN-ECNWPG) / this one's the other set. SNA CLA / Skip if not line terminator. ISZ LINBMP / Set to bump line counter. NEXTSW, SKP CLA /CHANGED TO NOP DURING GO/WAIT TARGET SEARCHES JMP I NEXTCH TAD CHAR /PUT CHAR IN ERROR MESSAGE BUFFER JMS PUTBUF JMP I NEXTCH / ERR13, TAD GOWLIN /RECOVER LINE NUMBER OF GO OR WAIT DCA LINCTR /RESTORE TO LINE COUNTER JMS ABORT;13 /MISSING GO/WAIT TARGET / LINBMP, 0 X=. /------------ PAGE / ROUTINE TO GET THE NEXT ATOM. / ATOMS ARE ELEMENTS (SEE BELOW) THAT MAY / INCLUDE (IE ARE NOT TERNIMATED BY) & CHARACTERS. / THIS IS BECAUSE WE DIDN'T EXCLUDE & IN LABELS / IN THE DISTRIBUTED DOCUMENTATION. / GETATM, XX JMS GETELM /GO GET NEXT ELEMENT TAD CHAR /CHECK DELIMITER FOR & TAD (-AMPERS SZA CLA JMP I GETATM /NOT & SO RETURN ELEMENT AS ATOM JMP GETELN /GO BACK AND ADD TO CURRENT ELEMENT /UNTIL IT IS NOT DELIMITED BY &. / / / / ROUTINE TO GET THE NEXT ELEMENT IN ATOM. / ELEMENTS ARE DELIMITED BY BLANK, TAB, COMMA, / COLON, AMPERSAND, SLASH OR EOL. / THE DELIMITER IS RETURNED IN CHAR. / GETELM, XX JMS NULSTR /CLEAR THE ATOM ATOM JMS SKIPBL /GET TO FIRST CHARACTER JMP I GETELM /EOL FOUND GETELL, TAD CHAR TAD (-SPACE /CHECK FOR TERMINATORS SZA TAD (SPACE-TAB SZA TAD (TAB-COMMA SZA TAD (COMMA-COLON SZA TAD (COLON-AMPERS SZA TAD (AMPERS-SLASH SZA TAD (SLASH-EOL SNA CLA JMP I GETELM /ATOM COMPLETE GETELN, TAD CHAR JMS ADDSTR /APPEND CHAR TO ATOM ATOM JMP ERR4 JMS NEXTCH /GET NEXT CHARACTER JMP GETELL /GO TEST IT FOR TERMINATORS / / / ROUTINE TO CHECK ATOM AGAINST TEXT STRINGS AND BRANCH / TO THE ADDRESS ASSOCIATED WITH A MATCH. / / JMS LISTBR / LIST / NO MATCH RETURN (AC=0) / MATCH RETURN (AC=0) / . / . / . /LIST, ADDRESS OF TEXT1;MATCH ADDRESS1; / . / . / . / ADDRESS OF TEXTn; MATCH ADDRESSn; / 0 / LISTBR, XX AC7777 TAD I LISTBR /GET ADDRESS OF LIST DCA X0 ISZ LISTBR LSTCMP, TAD I X0 /CHECK FOR END OF LIST SNA JMP I LISTBR /END. WE DIDN'T RECOGNIZE THIS ATOM DCA LSTADD TAD I X0 /GET ROUTINE ADDRESS DCA LSTXIT JMS CMPSTR /CHECK IF ATOM IS A MATCH LSTADD, 0 ATOM JMP LSTCMP /NOT A MATCH. GO TEST NEXT CANDIDATE JMP I LSTXIT /MATCHED. GO TO PROCESSING ROUTINE LSTXIT, 0 / / ROUTINE TO SKIP TO A SCANNABLE CHARACTER / I.E. IF CHAR IS BLANK OR TAB CALL NEXTCH UNTIL IT IS NOT. / IF CHAR IS /, REST OF LINE IS A REMARK - SKIP IT. / IF AT EOL TAKE THE FIRST RETURN; / OTHERWISE TAKE SECOND RETURN / JMS SKIPBL / EOL RETURN (AC=0) / NORMAL RETURN (AC=0) SKIPBL, XX SK1, CLA TAD CHAR /GET CHAR TAD (-SPACE /SKIP BLANKS AND TABS SZA TAD (SPACE-TAB SZA JMP SK2 JMS NEXTCH JMP SK1 SK2, TAD (TAB-SLASH SNA CLA JMS EOLINE /SKIP ALL OF REMARK TAD CHAR /CHECK FOR EOL TAD (-EOL SZA CLA /FOUND. TAKE FIRST RETURN ISZ SKIPBL /TAKE NORMAL RETURN JMP I SKIPBL / / SKIP OVER COMMAS AS WELL AS CHARACTERS / SKIPPED BY SKIPBL / TAKE FIRST RETURN IF EOL ENCOUNTERED, / OTHERWISE RETURN TO SECOND LOCATION / WITH NEXT NON-BLANK, NON-COMMA IN "CHAR" / SKIPBC, XX SKIPCL, JMS SKIPBL /SKIP BLANKS AND TABS JMP I SKIPBC /TAKE EOL RETURN TAD CHAR TAD (-COMMA /ARE WE AT A COMMA SZA CLA JMP SKIPCX /NO, EXIT JMS NEXTCH /YES, FETCH NEXT CHARACTER JMP SKIPCL /NOW CHECK AGAIN SKIPCX, ISZ SKIPBC /TAKE NORMAL RETURN JMP I SKIPBC / ROUTINE TO MAKE SURE CHAR IS EOL / EOLINE, XX EL1, CLA TAD CHAR /IS CHAR EOL TAD (-EOL SNA CLA JMP I EOLINE /YES JMS NEXTCH /NO, GET NEXT AND TEST AGAIN JMP EL1 CPYTIM, XX / Routine to copy the DATE & TIME string AC7777 / less 1 for index registers CDFMNU / From the menu field to our field. TAD I (DATESP) / This will get the address of the string. DCA X0 / Set from pointer. TAD (DATTIM-1) / Where we will put it. DCA X1 / ... CPYTM1, CDFMNU / Map where to get from. TAD I X0 / Get Date & Time character. CDFMYF / Back to us. SNA / Skip if not at end of string. JMP I CPYTIM / Return to caller when done. DCA I X1 / ... JMP CPYTM1 / Loop until done the copy. / "No Answer" RESPONSE FROM MODEM /A016 NOANS, JMS PUTMSG / TELL USER /A016 NASMSG / /A016 JMP DIALX / TAKE NO ANSWER RETURN /A016 / LINE IS BUSY DALBSY, JMS PUTMSG /TELL USER BSYMSG JMP DIALX /WAIT A SECOND AND TAKE FIRST RETURN /------------ PAGE / /GETCHR / /CALL: JMS GETCHR / ERROR RETURN/END-FILE RETURN / NORMAL RETURN / AC = CHARACTER ON RETURN. / IF ERROR, AC IS NEGATIVE; IF E-O-F, AC IS 0. / / Characters are read from the LOGON file, one at a time, and / stripped/ignored as follows: / modified flags ignored / dead-key seqs ignore start & end sequence chars / hard return passed thru / soft return ignored / page markers ignored / soft spaces ignored / paragraph marker turn into hard return / centered line turn into hard return / select point ignore / position marker ignore / justification marker ignore / ruler ignore in entirty / normal chars strip attributes / / Additionally, the 1st time E-O-F is encountered, an end-of-line / is returned. Thereafter, return is made to the E-O-F/ERROR return. / GETCHR, XX / Routine to return next char from file. JMS CHKHLT / See if HALT FLAG is set. Return only if no. TAD EOF / See if E-O-F has been detected. SZA CLA / Skip if no. Continue processing. JMP GOTEND / Take E-O-F return w/ zero AC. GETCH1, JMS DOCHAR / Get a character. DCA T1 / Save character. TAD T1 / Get character. AND P177 / Isolate character bits. TAD (-ECSPC) / bigger than a space? SMA SZA / Skip if no. JMP GOTCHR / Jmp if yes. return char minus attributes. CLA / Get origional char back. TAD T1 / ... TAD (-ECMDFL) / Line modified? SZA / Skip if yes. Ignore. TAD (ECMDFL-ECRMFL) / RULER modified? SZA / Skip if yes. Ignore. TAD (ECRMFL-ECSTOV) / Start of DEAD-KEY sequence? SZA / Skip if yes. Ignore. TAD (ECSTOV-ECNDOV) / End of DEAD-KEY sequence? SZA / Skip if yes. Ignore. TAD (ECNDOV-ECNWPG) / NEW PAGE marker? SZA / Skip if yes. Ignore. TAD (ECNWPG-ECPMRK) / PAGE marker? SZA / Skip if yes. Ignore. TAD (ECPMRK-ECJSPC) / Justifing space? SZA / Skip if yes. Ignore. TAD (ECJSPC-ECWWLN) / Wrapped line? SZA / Skip if yes. Ignore. TAD (ECWWLN-ECHYLN) / Wrapped line w/ hyphen? SZA / Skip if yes. Ignore. TAD (ECHYLN-ECSLPT) / Select point? SZA / Skip if yes. Ignore. TAD (ECSLPT-ECTMRK) / position marker? SZA / Skip if yes. ignore. TAD (ECTMRK-ECCMRK) / REJUST posn marker? SNA / Skip if no. JMP GETCH1 / Ignore character. TAD (ECCMRK-ECSPC) / SPACE character? SNA / skip if no. JMP GOTCHR / return SPACE character. TAD (ECSPC-ECTAB) / TAB character? SNA / Skip if no. JMP GETCH4 / return TAB TAD (ECTAB-ECNWLN) / check for HARD return, SZA / skip if yes. TAD (ECNWLN-ECPGRF) / PARAgraph marker. SZA / Skip if yes. TAD (ECPGRF-ECENLN) / and CENTERED line. SNA / skip if none-of-the-above. JMP GETCH3 / Turn them into HARD returns. TAD (ECENLN-ECPCT1) / Start PRINT CONTROL? SNA / Skip if no. JMP GETCHA / Jmp if yes. process Print Control block. TAD (ECPCT1-ECSTRL) / Start of ruler? SZA / Skip if yes. Skip to end of ruler. JMP GETCH1 / other wise ignore character. GETCH2, JMS DOCHAR / Get next character from file. TAD (-ECNDRL) / END-OF-RULER? SNA CLA / Skip if no. ignore character & try next. JMP GETCH1 / Done PC/RULER. Process next character. JMP GETCH2 / we are still in PC or RULER. loop. GETCHA, JMS DOCHAR / Get next character from disk file. TAD (-ECPCT2) / END-OF-PRINT-CONTROL? SNA CLA / Skip if no. ignore character & try next. JMP GETCH1 / Done PC/RULER. Process next character. JMP GETCHA / we are still in PC or RULER. loop. EOLERR, CLA / return HARD return 1st time. ERRXIT, ISZ EOF / Set E-O-F flag for next time. GETCH3, TAD (ECNWLN-ECTAB) / Return HARD return. GETCH4, TAD (ECTAB-ECSPC / Return TAB character GOTCHR, TAD (ECSPC) / Turn back into a character. ISZ GETCHR / take normal (skip) return. GOTEND, JMP I GETCHR / Return w/ AC=character. / ROUTINE TO GET THE NEXT CHARACTER FROM THE / CURRENT DOCUMENT. FOR LOGON DOCUMENTS THIS / INVOLVES A READ-ONLY FETCH VIA XRDFIN. / FOR PHONE DIRECTORIES WE DO READ-WRITE / FETCHES: XGETET FOLLOWED BY XPUTST FOR / FORWARD FETCHES, AND XGETST FOLLOWED BY / XPUTET FOR BACKWARD FETCHES. DOCHAR, XX CIFFIO FILEIO GETOP, XX / GET A CHARACTER SPA SNA / Skip if got a character. JMP EOLERR / Take end exit. DCA T1 TAD GETOP / IS THIS READ-ONLY? TAD (-XRDFNC SNA JMP DOCRET / YES / CHANGE XGETET TO XPUTST OR XGETST TO XPUTET IFNZRO XRDFNC-7 IFNZRO XGETET-4 IFNZRO XPUTST-3 IFNZRO XGETST-2 IFNZRO XPUTET-5 CIA / NO, MAKE WRITE-BACK OPERATOR DCA PUTOP TAD T1 / PUT CHARACTER BACK IN FILE CIFFIO FILEIO PUTOP, XX / WRITE THE CHARACTER BACK DOCRET, TAD T1 / Get character to return. JMP I DOCHAR / return to caller w/ character in AC. / / ROUTINE TO PUT A TEXT MESSAGE AT THE CURRENT / CURSOR POSITION. / PUTMSG, XX CLA TAD I PUTMSG /GET ADDRESS OF TEXT DCA PUTMA ISZ PUTMSG CIFMNU JMS I IOACAL /SEND TO IO 0 /A022 /D022 TTADDD / add to TT buffer. PUTMA, XX /D022 JMS TTDISP / display tt buffer. JMP I PUTMSG /------------ PAGE / /ADDSTR - ADD A 7-BIT CHARACTER TO AN ASCIIZ STRING /THESE ASCIIZ STRINGS START WITH A WORD /CONTAINING THE NEGATIVE COUNT OF THE NUMBER /OF WORDS RESERVED FOR THE STRING (INCLUDING /THAT ONE). SO, THE MAXIMUM NUMBER OF /CHARACTERS IT CAN CONTAIN IS COUNT-2. / /RUBOUT CHARACTERS ARE PROPERLY HANDLED. / / PUT CHARACTER TO BE ADDED IN THE AC / JMS ADDSTR / ADDRESS OF STRING / "STRING FULL" RETURN (CHARACTER NOT ADDED) / NORMAL RETURN / (AC=0 FOR EITHER RETURN) / / ADDSTR, XX DCA ADDCHR /SAVE THE CHARACTER TAD I ADDSTR / Get string address. DCA ADDDST / Save. ISZ ADDSTR / point to 1st return. TAD I ADDDST / Get -max count. SMA / check for negative. JMP ADDERR / bad string. take error return. IAC / compute negative of one less than size. DCA ADDLEN / ... DCA MAXLEN / Init string size. ADDLOP, ISZ MAXLEN / Count size+1 of string. ISZ ADDDST / Bump to next char posn. TAD I ADDDST / Check for zero stopper. SZA CLA JMP ADDLOP TAD ADDCHR / Check for RUBOUT request. TAD (-EDRBCH SNA / Skip if not RUBCHR JMP ADRBCH / Process RUBCHR. TAD (EDRBCH-EDRBWD) / How 'bout RUBWRD? SNA CLA / Skip if not RUBWRD. JMP ADRBWD / Process RUBWRD. TAD MAXLEN / Get current size. TAD ADDLEN / Compare to negative of max size. SMA CLA / If >= 0 then string already at max size. JMP I ADDSTR / no more room. TAD ADDCHR / get character to add AND P177 DCA I ADDDST / store char in string. ISZ ADDDST / Bump to stopper. DCA I ADDDST / set stopper in string. ADDRET, ISZ ADDSTR / Take normal return. ADDERR, CLA JMP I ADDSTR / / ADRBCH - RUBOUT A CHARACTER. / ADRBCH, JMS ADRBCR / CALL RUB CHAR NOP / Ignore beginning of buffer. JMP ADDRET / Something successfully rubbed out. exit. / / ADRBWD - RUBOUT A WORD / ADRBWD, JMS ADBKCR / Get character one back from here TAD (-40) SMA SZA CLA / Skip if a space or less (ie not a character). JMP ADRBW2 / found a character (start of word). JMS ADRBCR / Rub out leading spaces, tabs, etc. JMP ADDRET / Line empty return. JMP ADRBWD / do rest of leading spaces, tabs, etc. ADRBW2, JMS ADBKCR / Get character one back from here TAD (-40) SMA SZA CLA / Skip if not a word character. JMS ADRBCR / Rub out a character of word. JMP ADDRET / Line empty, so done. JMP ADRBW2 / check out next (preceding) character. / / ADRBCR - RUB A CHARACTER / IF THERE ARE NO CHARS IT WILL DO A NON SKIP RETURN / IF DID RUB OUT SOMETHING THEN A NORMAL (2ND) RETURN / ADRBCR, XX IFDEF FORIN < AC7777 / Once-only check for ACCENT before character. DCA T1 / > / end IFDEF FORIN. AC7777 / Any chars to rubout? TAD MAXLEN / ... SNA CLA / Skip if YES. JMP I ADRBCR / Take 1st return if NO. ISZ ADRBCR ADRBC1, AC7777 / Decrement the character pointer. TAD ADDDST / ... DCA ADDDST / .... DCA I ADDDST / Set new stopper. AC7777 / Decrement the count of chars too. TAD MAXLEN / ... DCA MAXLEN / .... IFDEF FORIN < ISZ T1 / Already checked for ACCENT? JMP I ADRBCR / Return if yes. JMS ADBKCR / Get prior character. CIFMNU / Map MENU field. JMS I (SRTAB1 / to see if it's an accent. SKP CLA / No, Just return. JMP ADRBC1 / Yes, Delete it too. > / end ifdef FORIN JMP I ADRBCR / Return ADBKCR, XX AC7777 TAD MAXLEN / Any chars in line? SNA CLA / Skip if yes. JMP ADDRET / Take early exit if no. AC7777 / point back 1 char posn. TAD ADDDST / ... DCA ADTEMP / .... TAD I ADTEMP / Get prior char. JMP I ADBKCR / Return with char. ADDCHR, 0 ADDDST, 0 ADDLEN, 0 MAXLEN, 0 / Set to the maximum size. ADTEMP, 0 / /MOVSTR - MOVE AN ASCIIZ STRING / / JMS MOVSTR / ADDRESS OF SOURCE STRING / ADDRESS OF DESTINATION STRING / ERROR RETURN - DESTINATION TOO SHORT AC=0 / NORMAL RETURN (AC=0) /THESE ASCIIZ STRINGS START WITH A WORD /CONTAINING THE NEGATIVE COUNT OF THE NUMBER /OF WORDS RESERVED FOR THE STRING (INCLUDING /THAT ONE). SO, THE MAXIMUM NUMBER OF /CHARACTERS IT CAN CONTAIN IS COUNT-2. / MOVSTR, XX CLA TAD I MOVSTR /GET ADDR OF SOURCE DCA X1 ISZ MOVSTR TAD I MOVSTR /GET ADDR OF DESTINATION CIA;CMA /POINT TO -LENGTH DCA X2 TAD I X2 /GET -DESTINATION LENGTH DCA MOVMAX ISZ MOVSTR /POINT TO FIRST RETURN MOVLOP, ISZ MOVMAX /COUNT CHARACTERS SKP JMP I MOVSTR /TAKE ERROR RETURN TAD I X1 /FETCH A SOURCE CHARACTER SNA JMP MOVEND DCA I X2 /STORE IT JMP MOVLOP /GO FOR ANOTHER MOVEND, DCA I X2 /END OF STRING ISZ MOVSTR /NORMAL RETURN JMP I MOVSTR MOVMAX, 0 / INITIALIZE INTEGRAL MODEM - (SET TO BURST MODE) /A019 ADIMCK, JMS DRAINH / CLEAR INPUT BUFFER /A019 TAD (CTLA / ^A INIT. MODEM (ACU) /A019 JMS HSOUT / /A019 JMS WAIT1 / /A019 JMS HSINPT / CK RESPONSE /A019 JMP IMODEX / NOTHING PRESENT - IN BURST MODE /A019 JMS DRAINH / CLEAR INPUT BUFFER AGAIN /A019 TAD (CTLA / THIS ONE SHOULD DO IT. /A019 JMS HSOUT / /A019 JMP IMODEX / /A019 /------------ X=. PAGE / /SUBSTR - COMPARE 2 7-BIT ASCIIZ STRINGS / RETURN EQUAL IF THE FIRST STRING IS A / SUBSTRING OF THE SECOND STRING. / / JMS SUBSTR / ADDRESS OF FIRST STRING / ADDRESS OF SECOND STRING / NOT EQUAL RETURN (AC=0) / EQUAL RETURN (AC=0) / / UPPER/LOWER CASE INDEPENDENT / / SUBSTR, XX CLA TAD I SUBSTR /GET ADDR OF S1 DCA SUBS1 ISZ SUBSTR TAD I SUBSTR /GET ADDR OF S2 DCA SUBS2 ISZ SUBSTR /POINT TO NOT EQUAL RETURN SUBTRY, TAD SUBS1 /INITIALIZE FOR A SUBSTRING PASS DCA X1 TAD SUBS2 DCA X2 ISZ SUBS2 /BUMP STRING2 START POINT FOR NEXT TRY / SUBLOP, TAD I X1 /FETCH A CHARACTER FROM S1 SNA JMP SUBE1 AND (177 /COMPARE ONLY 7 BITS DCA SUBC1 TAD I X2 /FETCH A CHARACTER FROM S2 SNA JMP I SUBSTR /SECOND STRING SHORTER AND (177 CIA /SAVE -SECOND CHAR DCA SUBC2 TAD SUBC1 /IS FIRST STRING CHARACTER L/C TAD (-172 SMA SZA JMP SUBCMP /NO, >z TAD (172-141 SPA JMP SUBCMP /NO, IFDEF ITALIAN<-12;"N;"e;"s;"s;"u;"n;" ;"n;"u;"m;"e;"r;"o;0> IFDEF V30NOR<-12;"N;"o;" ;"n;"u;"m;"b;"e;"r;0> IFDEF V30SWE<-12;"N;"o;" ;"n;"u;"m;"b;"e;"r;0> IFDEF DUTCH<-12;"N;"o;" ;"n;"u;"m;"b;"e;"r;0> IFDEF SPANISH<-12;"N;"o;" ;"n;"u;"m;"b;"e;"r;0> / / / ALL LOWER CASE IN ORDER TO MATCH UPPER OR LOWER / CASE IN CMPSTR ROUTINE. / IFDEF ENGLSH < TYPES, -6;"t;"y;"p;"e;0 TOS, -4;"t;"o;0 GOS, -4;"g;"o;0 WAITS, -6;"w;"a;"i;"t;0 FORS, -5;"f;"o;"r;0 SCRENS, -10;"s;"c;"r;"e;"e;"n;0 NSCRNS, -12;"n;"o;"s;"c;"r;"e;"e;"n;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"d;"i;"a;"l;0 ABORTS, -7;"a;"b;"o;"r;"t;0 CXS, -4;"c;"x;0 ENDS, -5;"e;"n;"d;0 HOSTS, -6;"h;"o;"s;"t;0 KBDS, -5;"k;"b;"d;0 CRS, -4;"c;"r;0 LFS, -4;"l;"f;0 BRKS, -5;"b;"r;"k;0 DTRS, -5;"d;"t;"r;0 > IFDEF ITALIAN < TYPES, -6;"i;"n;"v;"i;"o;"_;"a;0 TOS, -4;"a;0 GOS, -4;"s;"a;"l;"t;"o;0 WAITS, -6;"a;"t;"t;"e;"s;"a;0 FORS, -5;"p;"e;"r;0 SCRENS, -10;"v;"i;"d;"e;"o;0 NSCRNS, -12;"n;"o;"_;"v;"i;"d;"e;"o;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"c;"h;"i;"a;"m;"a;"t;"a;0 ABORTS, -7;"i;"n;"t;"e;"r;"r;"u;"z;"i;"o;"n;"e;0 CXS, -4;"e;"t;0 ENDS, -5;"f;"i;"n;"e;0 HOSTS, -6;"o;"s;"p;"i;"t;"e;0 KBDS, -5;"t;"s;"t;0 CRS, -4;"r;"i;"t;0 LFS, -4;"l;"f;0 BRKS, -5;"i;"n;"c;0 DTRS, -5;"d;"t;"r;0 > IFDEF V30NOR < TYPES, -6;"t;"y;"p;"e;0 TOS, -4;"t;"o;0 GOS, -4;"g;"o;0 WAITS, -6;"w;"a;"i;"t;0 FORS, -5;"f;"o;"r;0 SCRENS, -10;"s;"c;"r;"e;"e;"n;0 NSCRNS, -12;"n;"o;"s;"c;"r;"e;"e;"n;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"d;"i;"a;"l;0 ABORTS, -7;"a;"b;"o;"r;"t;0 CXS, -4;"c;"x;0 ENDS, -5;"e;"n;"d;0 HOSTS, -6;"h;"o;"s;"t;0 KBDS, -5;"k;"b;"d;0 CRS, -4;"c;"r;0 LFS, -4;"l;"f;0 BRKS, -5;"b;"r;"k;0 DTRS, -5;"d;"t;"r;0 > IFDEF V30SWE < TYPES, -6;"t;"y;"p;"e;0 TOS, -4;"t;"o;0 GOS, -4;"g;"o;0 WAITS, -6;"w;"a;"i;"t;0 FORS, -5;"f;"o;"r;0 SCRENS, -10;"s;"c;"r;"e;"e;"n;0 NSCRNS, -12;"n;"o;"s;"c;"r;"e;"e;"n;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"d;"i;"a;"l;0 ABORTS, -7;"a;"b;"o;"r;"t;0 CXS, -4;"c;"x;0 ENDS, -5;"e;"n;"d;0 HOSTS, -6;"h;"o;"s;"t;0 KBDS, -5;"k;"b;"d;0 CRS, -4;"c;"r;0 LFS, -4;"l;"f;0 BRKS, -5;"b;"r;"k;0 DTRS, -5;"d;"t;"r;0 > / END IFDEF V30SWE IFDEF DUTCH < TYPES, -6;"t;"y;"p;"e;0 TOS, -4;"t;"o;0 GOS, -4;"g;"o;0 WAITS, -6;"w;"a;"i;"t;0 FORS, -5;"f;"o;"r;0 SCRENS, -10;"s;"c;"r;"e;"e;"n;0 NSCRNS, -12;"n;"o;"s;"c;"r;"e;"e;"n;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"d;"i;"a;"l;0 ABORTS, -7;"a;"b;"o;"r;"t;0 CXS, -4;"c;"x;0 ENDS, -5;"e;"n;"d;0 HOSTS, -6;"h;"o;"s;"t;0 KBDS, -5;"k;"b;"d;0 CRS, -4;"c;"r;0 LFS, -4;"l;"f;0 BRKS, -5;"b;"r;"k;0 DTRS, -5;"d;"t;"r;0 > IFDEF SPANISH < TYPES, -6;"t;"y;"p;"e;0 TOS, -4;"t;"o;0 GOS, -4;"g;"o;0 WAITS, -6;"w;"a;"i;"t;0 FORS, -5;"f;"o;"r;0 SCRENS, -10;"s;"c;"r;"e;"e;"n;0 NSCRNS, -12;"n;"o;"s;"c;"r;"e;"e;"n;0 MENUS, -6;"m;"e;"n;"u;0 DIALS, -6;"d;"i;"a;"l;0 ABORTS, -7;"a;"b;"o;"r;"t;0 CXS, -4;"c;"x;0 ENDS, -5;"e;"n;"d;0 HOSTS, -6;"h;"o;"s;"t;0 KBDS, -5;"k;"b;"d;0 CRS, -4;"c;"r;0 LFS, -4;"l;"f;0 BRKS, -5;"b;"r;"k;0 DTRS, -5;"d;"t;"r;0 > / / TEXT STRINGS / NULMSG, TEXT / / KEYMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH *.-1 TEXT /^P^S^A/ *.-1 IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH MENMSG, IFDEF ENGLSH < TEXT /&PRESS &GOLD !&MENU TO &RETURN TO THE &MAIN &MENU/> IFDEF ITALIAN < TEXT /&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE/> IFDEF V30NOR < TEXT '&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN'> /A027 IFDEF V30SWE < TEXT '&TILLBAKA TILL HUVUDMENYN: ANV\DND GULD MENY'> IFDEF DUTCH < TEXT /&DRUK OOP &GOUD !&MENU VOOR HET &HOOFDMENU./> IFDEF SPANISH < TEXT /&PULSE &DORADA !&MENU PARA &VOLVER AL &MEN\Z &PRINCIPAL/> NEXMSG, IFDEF ENGLSH < TEXT /&OR &JUST &PRESS &RETURN TO GET THE &NEXT &ENTRY/> IFDEF ITALIAN < TEXT /&PREMERE &RITORNO PER CONTINUARE LA RICERCA/ /A015> IFDEF V30NOR < TEXT '&EL. TRYKK P\E !&RETUR FOR \E F\E NESTE OPPSLAG'> /A027 IFDEF V30SWE < TEXT '&TILL N\DSTA POST: TRYCK P\E RETUR'> IFDEF DUTCH < TEXT /&OR &JUST &PRESS &RETURN TO GET THE &NEXT &ENTRY/> IFDEF SPANISH < TEXT /&OR &JUST &PRESS &RETURN TO GET THE &NEXT &ENTRY/> OKYMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A027 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH NAMMSG, TEXT /^P!E^P^A!L^P^A!L/ ADVMSG, IFNDEF V30SWE < IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR /A027 IFDEF DUTCH IFDEF SPANISH *.-1 7600 > IFDEF V30SWE BCKMSG, IFNDEF V30SWE < IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF DUTCH IFDEF SPANISH *.-1 7400 > IFDEF V30SWE ENTMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH OPTMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF DUTCH IFDEF SPANISH IFDEF V30SWE < TEXT '^P!E&TITTA P\E N\DSTA POST: TRYCK P\E FRAM\ET ELLER - '> *.-1 TEXT '> ' *.-1 IFDEF ENGLSH /M015 IFDEF ITALIAN IFDEF V30NOR < TEXT 'FOR \E SE P\E NEST OPPSLAG '> IFDEF V30SWE < TEXT ''> IFDEF DUTCH /M015 IFDEF SPANISH /M015 *.-1 IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE < TEXT '^P&TITTA P\E F\VREG\EENDE POST: TRYCK P\E BAK\ET ELLER -'> IFDEF DUTCH IFDEF SPANISH *.-1 TEXT '< ' *.-1 IFDEF ENGLSH /M015 IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH /M015 IFDEF SPANISH /M015 *.-1 IFDEF ENGLSH < TEXT /^P&PRESS &GOLD !&SRCH OR !&FIND TO &ENTER /> /M015 IFDEF ITALIAN < TEXT /^P&PREMERE &ORO !&CERCA O !&RICER PER SELEZIONARE /> IFDEF V30NOR < TEXT 'TRYKK &GULL !&FINN EL. !&FINN FOR \E &ANGI'> IFDEF V30SWE < TEXT '&TRYCK P\E GULD S\VK F\VR ATT B\VRJA'> IFDEF DUTCH < TEXT /^P&PRESS &GOLD !&SRCH OR !&FIND TO &ENTER /> /M015 IFDEF SPANISH < TEXT /^P&PRESS &GOLD !&SRCH OR !&FIND TO &ENTER /> /M015 *.-1 IFDEF ENGLSH /M015 IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH /M015 IFDEF SPANISH /M015 *.-1 TEXT /^P^S/ XITMSG, IFDEF ENGLSH IFDEF ITALIAN < TEXT /^P&INTRODURRE !&ET PER COLLEGAMENTO AUTOMATICO TRAMITE MODEM IN !&ET /> IFDEF V30NOR < TEXT 'LEGG INN !&CX FOR \E RINGE OPP OG G\E INN I !&CX'> IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH *.-1 IFDEF ENGLSH IFDEF ITALIAN < TEXT /^PINTRODURRE !&CO PER COLLEGAMENTO AUTOMATICO TRAMITE MODEM IN !&CO/> IFDEF V30NOR < TEXT '^P&SKRIV !&LG FOR \E RINGE OPP OG G\E INN I !&EASYCOM'> IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH WATMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH BSYMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH ANSMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH NASMSG, IFDEF ENGLSH /A016 IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE /A016 IFDEF DUTCH /A016 IFDEF SPANISH /A016 BADMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH UNKMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH BEGMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH ENDMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH EODMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH DIAMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH ABRMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH GHTMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF ENGLSH ENDMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH ITLMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH IVCMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH ABRMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH TYPMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH TXTMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH TIMMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF ENGLSH WAIMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR < TEXT 'FOR MANGE VARIABLER (MAKS. 5)'> IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH DNCMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH GOWMES, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH DSPMSG, IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH FINMSG, TEXT /^P^S / *.-1 IFDEF ENGLSH IFDEF ITALIAN IFDEF V30NOR IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH /D022LINBUF, ZBLOCK 200 / Buffer for TYPE SCREEN text so that we can IOA it. / AREAS TO BE INITIALIZED BY THE PROGRAM TO SAVE FLOPPY SPACE X=. / / / ASCIIZ STRING WORK SPACES TO BE INITIALIZED BY / CALLS TO INISTR. / ATOM=X;X=X+ATMSIZ+2 /CURRENT ATOM (LANGUAGE ELEMENT) TSTRNG=X;X=X+TXTSIZ+2 /USER REPLY TO ~ PROMPT NAME=TSTRNG WTTIME=X;X=X+7 /SECONDS TO WAIT GOTRGT=X;X=X+LABSIZ+2 /TARGET FOR "GO" AND "WAIT" / WTGO=X;X=X+LABSIZ+2 /TARGET FOR WAIT TIME / WTKBS=X;X=X+WTTSIZ /KEYSTROKES DURING "WAIT KBD" / / WAIT TARGET STRINGS WTG1=X;X=X+LABSIZ+2 WTG2=X;X=X+LABSIZ+2 WTG3=X;X=X+LABSIZ+2 WTG4=X;X=X+LABSIZ+2 WTG5=X;X=X+LABSIZ+2 / / WAIT TEXT STRINGS WTS1=X;X=X+WTTSIZ+2 WTS2=X;X=X+WTTSIZ+2 WTS3=X;X=X+WTTSIZ+2 WTS4=X;X=X+WTTSIZ+2 WTS5=X;X=X+WTTSIZ+2 WTS6=X;X=X+PHNSIZ+2 /A024 / KEY=WTS1 NUMBR=WTS6 /A024 /D024NUMBR=WTS2 / / BUFFER BLOCKS WTXLST=X;X=X+5 /WORK POINTERS FOR EACH WAIT STRING DATTIM=X;X=X+27 /HOLDS DATE & TIME BUFBEG=X;X=X+100 /HOLD LAST 100 STATEMENT CHARACTERS FOR ABORT BUFEND=X-1 /LAST LOCATION IFZERO BUFEND&4000   / WINUTL - WINCHESTER UTILITY / / 014 EMcD 26-Sep-85 Add Spanish and Dutch Xlations (cond) / 013 EMcD 11-Sep-85 Add Nordic translations (conditional) / 012 RCME 20-JUN-85 Move some text to make space for more / / ------------------- All below refer to V2.0 and earlier -------------------- / / 011 WCE 16-NOV-84 Reset DECmate mode on Winnie boot / 010 DFB 20-SEP-84 Fix power on boot for non winnie systems / 009 DFB 21-AUG-84 Set boot to power boot on floppy / 008 AH 07-MAY-84 FIX, ENHANCE MESSAGES / 007 DFB 08-MAR-84 Fix password check for error vol bug / 006 DFB 21-FEB-84 Do not allow assign/deassign dev. 0 / 005 DFB 20-JAN-84 Fix display messages / 004 DFB 17-JAN-84 Fix display if no volume password / 003 DFB 12-DEC-83 Allow assign if bootable vol / 002 DFB 03-OCT-83 Set MNOPTN bit 9=0 drive 1=RX, / Set MNOPTN bit 9=1 drive 1=WINNIE / 001 DFB 29-AUG-83 NEW MODULE /*************************************************************************** /**** WRITE OUT CODE FOR WINUTL **** /*************************************************************************** FIELD 0 / FIELD WHERE RXHAN IS LOADED *200 / START ADDRESS USED BY OS8 "GO" COMMAND JMP I .+3 / LOCATION USED TO START UP RXHAN JMP I .+1 / LOCATION USED TO RETURN TO OS8 MONITOR 7605 / ADDRESS OF OS8 MONITOR RETURN POINT RXLOAD / ADDRESS OF START LOCATION FOR RXHAN *RXLDLS / ADDRESS WITHIN RXHAN TO OVERLAY RXEWT / WRITE FUNCTION CODE 0 RXQBLK / ADDRESS OF QUEUE BLOCK TO USE . / ADDRESS OF TABLE OF DISK COMMANDS DLWINI / STARTING DISK BLOCK TO WRITE 0 / WRITEOUT ON PAGE BOUNDARY /C061 CDF 10 / FIELD TO WRITE FROM -DSWINI / NEGATIVE NUMBER OF BLOCKS TO WRITE 0 / END OF LIST INDICATOR / THE ACTUAL ROUTINE FIELD 1 / FIELD FOR ASSEMBLY CDFMYF=CDF 30 / MY NORMAL FIELD OF OPERATION IS THREE CDFACP=CDF 70 / ACP FIELD PASSWD=1 / ENABLE PASSWORD CHECK PRQ3=6236 / PRQ3 CODE LENVOL=30 / LENGTH OF 1 VOL DIR 24 WORDS LONG LENNAM=10 / LENGTH OF VOLUME NAME LENRD=2 / LENGTH OF READ PASSWORD LENWRT=2 / LENGTH OF WRITE PASSWORD LENPBL=2 / LENGTH OF PHYSICAL BLOCK LENSIZ=2 / LENGTH OF NO BLOCKS LENOS=7 / LENGTH OF OS DEPENDENT DATA LENDE=1 / LENGTH OF ENTRY DATA BITS VOLNM=0 / START VOLUME NAME VOLRD=VOLNM+LENNAM / START OF READ PASSWORD VOLWRT=VOLRD+LENRD / START OF WRITE PASSWORD VOLPBL=VOLWRT+LENWRT / START PHYSICAL BLOCK NUMBER VOLSIZ=VOLPBL+LENPBL / START OF #BLOCKS L/O FIRST WRD VOLDE=VOLSIZ+LENSIZ / START OF DATA BITS; / 4=READ ACCESS; 5=WRITE ACCESS; 6=UNIT / 7=VOLUME MOUNTED; 9=STARTUP; 10=MODIFIED VOLDAT=VOLDE+LENDE / START OF VOLUME OS/ DATA / 4=BOOTABLE; 5-11=VOLUME TYPE, SEE BELOW WPS8=-10 / VALUES ARE NEGATIVE FOR USE IN TABLE /A008 OS278=-11 /A008 COS310=-12 /A008 CPM=-100 /A008 *100 VOLBUF, VOLTB2 / VOLUME TABLE POINTER / LEN= 60 VOLS*24 WORDS/VOL 2440(8) / PLUS ACTIVE VOLUME DATA / LEN= 8 VOLS*24 WORDS/VOL 300(8) VOLPTR, 0 / POINTER TO CURRENT POSITIONS / IN BUFFER MOUNTED VOLUME VOLPT2, VOLTB2-1 / POINTER TO MOUNTED VOLUME /D008 WINCNT, 0 / -NUMBER DRIVES COUNT /D008 MNTCNT, 0 / NO OF MOUNTED DEVICES RPASS2, 0 / READ PASSWORD H/O RPASS3, 0 / READ PASSWORD L/O WPASS2, 0 / WRITE PASSWORD H/O WPASS3, 0 / WRITE PASSWORD L/O WINJMP, JMPTBL-1 / JUMP TABLE JMPTBL, WINMV / A - MOUNT DEVICE... ASSIGN VOLUME WINDV / D - DISMOUNT DEVICE...DEASSIGN VOLUME WINSA / LA - LIST ASSIGNED VOLUMES WINSAL / LI - LIST ALL VOLUMES DATA SVX0, 0 / SAVE CURRENT POINTER SVX1, 0 / SAVE CURRENT POINTER SVPT2, 0 / SAVE SYSDEV, 0 / SYSTEM DEVICE..0=RX50..ELSE WINNIE /A006 WINPAS, 0 PASSER, 0 / READ PASSWORD ERROR SW BNTMP1, 0 / TMP PNTR BNTMP2, 0 / TMP PNTR BNTMP3, 0 / TMP PNTR BNCNT, 0 / COUNTER CRERSW, 0 / CR-ERROR-SW. IF SET CLEAR BOT LINE. / DONT GO TO LAST MENU /A004 /D008 PRTCNT, 0 / ODD=FIRST TIME EVEN=SECOND PRTL06, 6 / STARTING CURSOR POSITION /A008 WINTMP, 0 / TEMP STORAGE.. VOLTMP, 0 / TEMP STRCNT, 0 / INPUT STRING COUNT SAVENO, 0 / SAVE AREA NUMBER /A007 AREANO, 0 PRTHO, 0 PRTLO, 0 / LO MUST FOLLOW IMMEDIATELY AFTER H/O GTGMCR, PRTLS0 / GET CR OR G.M. ONLY K20, MNRX4X / =20 M7, -7 / CONST M10, -10 / CONST M9, M11, -11 / CONST MVLCHP, MVLCHQ / POINTER TO STRING BUFFER MVLCHX, 0 / SAVE CHAR PRTVOL, MVLCHR / POINTER TO VOLUME NAME PRTLNO, 3 / LINE NO BEING PROCESSED, SET BY / WINSA, WINSAL FROM PRTL06 CLRSCX, CLRSCR / CLEAR SCREEN /A008 PRTHDX, PRTHDR / PRINT HEADER FOR BOTH LISTS /A008 WINP7X, WINPT7 / ERROR MESSAGE ROUTINE /A008 WINP5X, WINPT5 /A008 WINWFX, WINWFT / RING BELL /A008 PRTLSX, PRTLST / RETURN, GOLD MENU MESSAGE /A008 QUBLK1, DSKQUE / 0 / 0 WINQBK, / QBLOCK- 0 / RXQCOD FLAGS RETURNED HERE 0 / RXQFNC FUNCTION CODE 0 / RXQDN1 0 / RXQDN2 0 / RXQENO 0 / RXQID1 0 / RXQSPC 0 / RXQCTL 0 / RXQDRV DRIVE NUMBER 0 / RXQBLK BLOCK NUMBER 0 / RXQRS1 0 / RXQBAD BUFFER ADDRESS CDFMYF / RXQBFD BUFFER FIELD CDF 0 / RXQTRK TRACK 0 / RXQSEC SECTOR X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / ENTRY TO WINNIE UTILITY / ENTERS WITH CODE IN MNTMP1 / 1=MOUNT VOLUME / 2=DISMOUNT VOLUME / 3=SHOW ALL MOUNTED AREAS / 4=SHOW ALL DIRECTORY DATA WINUTL, XX JMP WINMNU / CALLED FROM WINNIE MENU WINFIN, XX / CALLED FROM FINISH COMMAND(MAIN MENU) JMP WINFN1 WINFNA, XX / CALLED FROM FINISH COMMAND(MAIN MENU) JMP WINFNB WINMNU, JMS WINFLD / GET CALL FLD DCA RETCIF / STORE IT WNCRET, / WINCHESTER MENU RETURN JMS WINCLR / CLEAR BUFFER AREA CIFMNU JMS I MNUCAL / CALL DLMDUB / WINNIE MAINT MENU NOP / SPARE CLA IAC BSW / 100 JMS I CLRSCX / CLEAR SCREEN FROM LINE 1 /C008 CDFMNU / MENU FLD TAD I (MUBUF+MNTMP1) / GET ARGUMENT CDFMYF SNA / 0=GOLD MENU JMP WINRET / YES TAD WINJMP / SET UP JMP ADDR DCA WINTMP TAD I WINTMP DCA WINTMP / SET POINTER JMS I WINTMP / DOIT JMP WNCRET / TO WINCHESTER MENU MVGOLD, / GOLD MENU RET WINRET, RETCIF, 0 JMP I WINUTL WINFN1, JMS WINFLD / GET CALL FLD DCA RETCF1 / STORE IT JMS WINCHK / SKIP IF NO WINNIE ON LINE /A010 JMS DEALL / DEASSIGN ALL RETCF1, 0 JMP I WINFIN WINMV, XX / MOUNT A WINNCHESTER VOLUME CLA CLL CMA RAL / -2 DCA WINPAS / NO OF PASSWORD RETRIES BEFORE RETURNING TO MM DCA PASSER / PASSWORD ERROR SW WINMVA, JMS GETVOL / GET MOUNTED VOLUME DATA WINMVB, JMS WINPT1 PRC / "TYPE DEVICE NUMBER ... " JMS GTVERA / GET AREA NUMBER, VERIFY JMP WINMVB / ERROR INPUT; ONLY 1-7 ALLOWED JMP WINMVD / NOT MOUNTED WINMVC, JMS I WINP7X /C008 PRTER5 / "DEVICE ALREADY ASSIGNED ... " JMP WINMVB / AREA ALREADY MOUNTED WINMVD, JMS CLRLST / CLEAR LAST LINE /D008 WINMVE, /D008 TAD AREANO / DEVICE NO /D008 SNA CLA / =0? /D008 JMP WINMVB / YES CANNOT MOUNT DRIVE 0 WINMVF, /D008 JMS WINPT1 JMS WINP31 / "TYPE VOLUME NAME ... " /A008 /D008 PRTMVB JMS WINNAM / GET VOLUME NAME SKP / ALREADY MOUNTED JMP WINMVG / NOT ALREADY MOUNTED JMS I WINP7X /C008 PRTER6 / "VOLUME ALREADY ASSIGNED. ... " JMP WINMVF / VOLUME ALREADY MOUNTED WINMVG, JMS CHKVOL / IS VOL NAME VALID? JMP WINMVF / NO. MSSGE PRINTED ALREADY. GET NEXT VOL. WINMVH, JMS CLRLST / CLEAR LST LINE JMS MOVNAM / MOVE NAME TO PRINT AREA /M004 WINMVK, JMS ZERPAS / CHECK PASSWORD=0 /A003 JMP WINMVL / PASSWORD=0 IGNORE /A003 JMS WINPT1 PRTMVC / "ENTER READ PASSWORD ... " JMS GETBIN / GET PASSWORD ISZ PASSER / RET HERE IF ERROR ON READ PASSWORD TAD T3 DCA RPASS3 / LO PASSWORD TAD T2 DCA RPASS2 / HO PASSWORD JMS WINPT1 PRTMVD / "ENTER WRITE PASSWORD ... " JMS GETBIN / GET PASSWORD ISZ PASSER / RET HERE IF ERROR ON WRITE PASSWORD TAD T2 DCA WPASS2 / SAVE TAD T3 DCA WPASS3 JMS CHKPAS / CHECK PASSWORD TAD PASSER / WAS READ PASS AN ERROR SZA CLA / ADDS 1 LEVEL OF PROTECTION JMP WINMVN / WAS AN ERR. WINMVL, TAD SVX0 / POINTER TO VOL PASSWRD-1 /C003 TAD (-VOLRD+1) / SET TO VOLUME NAME IN U.CASE JMS WINIO RDEMNT+4000 / WINNIE MOUNT CMND IAC JMS WINSET / SET TABLE AS MOUNTED WINNIE TAD (VOLSAR) DCA X0 / SET FOR PRINT JMS WINPT3 PRTMVE / "VOLUME IS ASSIGNED TO DEVICE" JMP WINMVQ WINMVN, DCA PASSER / CLEAR PASSWORD ERROR SW JMS WINPTF / "READ/WRITE PASSWORD ERROR" /C005 /D005 PRTER7 ISZ WINPAS / RETRY COUNT /D008 JMP WINMVK / DO IT AGAIN JMP WINMVR / WAIT FOR CR (GM MAYBE) /A008 /D008 JMP I WINMV / ERROR RETURN; WAIT FOR USER ENTRY WINMVQ, JMS I PRTLSX / PRINT MSSG FOR CR OR GOLD MENU /C008 JMS I GTGMCR / GET IT ISZ WINMV / CAR RET ENTERED JMP I WINMV / WAS G.M.-RET WINMVR, / WAIT FOR CR (GM) AFTER FIRST /A008 / WRONG ENTRY /A008 JMP .+2 / NO BELL ON ENTRY /A008 JMS I WINWFX / BELL /A008 JMS I GTGMCR / GET GM OR CR /A008 JMP .-2 / GM NOT ALLOWED, RING BELL /A008 JMP WINMVK / CR, TRY AGAIN /A008 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED WINDV, XX / WINNIE DISMOUNT A VOLUME WINDVA, CLA IAC BSW / 100 JMS I CLRSCX /C008 JMS GETVOL WINDVB, JMS WINPT1 PMA / "...AREA TO DISMOUNT.. JMS GTVERA / GET AREA # AND VOL NAME JMP WINDVB / ERROR AREA NO JMP WINDVS / AREA IS NOT MOUNTED-- RETURN TAD VOLPTR / AREA IS MOUNTED DCA X1 /D008 TAD M7 TAD M10 /A008 DCA T3 / SET UP TO MOVE TO PRINT AREA TAD X1 / POINTER TO VOLUME DCA WINPTD / SET IT UP JMS MOVT01 / X0 TO X1 JMS WINPTB / "VOLUME NAME ^A ASSIGNED TO DEVICE !D" JMS WINPT9 / "IS THIS THE VOLUME YOU WANT TO DEASSIGN" JMS I PRTLSX / "PRESS RETURN ... " /C008 WINDVG, JMS WNYORN / GET "Y" OR "N" JMP WINDVA / "N" RET JMP WINDVP / NOT "Y" OR "N" / "Y" RET TAD AREANO DCA WINQBK+RXQDRV / SET DRIVE TO BE DISMOUNTED TAD PRTVOL DCA WINQBK+RXQBAD / VOL NAME ADDRESS /D011 TAD MYFLD1 / PICK UP CDF INSTRUCTION TO THIS FIELD /C011 /D011 DCA WINQBK+RXQBFD / BUFFER FIELD TAD (RDEDIS+4000) / DISMOUNT COMMAND FUNCTION CODE /D011 DCA WINQBK+RXQFNC JMS QURX / DOIT JMP WINDVR / ERROR JMS WINSET / CLEAR MOUNTED BIT <11> TAD WINPTD DCA X0 / SET POINTER TO VOL FOR PRINT JMS WINPT3 PRTDME / "VOLUME HAS BEEN DEASSIGNED FROM DEVICE" JMS I PRTLSX / PRINT MSSG FOR CR OR GOLD MENU /C008 JMS I GTGMCR / GET IT ISZ WINDV / CAR RET ENTERED JMP I WINDV / WAS G.M.-RET WINDVP, /D008 JMS WINPT5 /D008 PRTER3 / ILLEG CHAR JMS I WINWFX / NOT Y OR N, RING BELL /A008 JMS I PRTLSX / CR GM OPTION /C008 JMP WINDVG /Y OR N WINDVR, JMS I WINP5X /C008 PRTER4 / DISK ERROR JMP WINDVB WINDVS, JMS I WINP5X /C008 PRTER2 / "NOT MOUNTED TO A VOLUME" JMP WINDVB WINSA, XX / SHOW ALL MOUNTED VOLUMES....LA JMS GETVOL / GET VOLUME DATA JMS I PRTHDX / PRINT HEADER /C008 /D008 IAC TAD PRTL06 /A008 DCA PRTLNO / SET RELATIVE LINE NO. /D008 DCA PRTCNT / CLEAR SWITCH TAD VOLPT2 / START OF BUFFER POINTER WINSA1, DCA VOLTMP /M006 TAD VOLTMP / GET POINTER TO TABLE DCA X0 TAD I X0 SMA / ENTRY HERE? JMP WINSA3 / YES CLA TAD X0 TAD (LENVOL) JMS I PRTLSX / PRINT MSSG FOR CR OR GOLD MENU /C008 JMS I GTGMCR / GET IT ISZ WINSA / CAR RET ENTERED JMP I WINSA / WAS G.M.-RET WINSA3, JMS WINSA7 / SET PRINT AREA JMP WINSA1 / NEXT / GET 1 LINE OF INPUT / IF CR RET / IF GOLD MENU RET+1 / ELSE RET+2 / ARG PASSED = MAX # INPUT CHARS / IN ORDER TO PRINT MSSG WITH OVFLOW CHAR MUST BE INCREMENTED / THEN CHECKED ON NORMAL RET.. ELSE NOT PUT INTO BUFFER MVLLIN, XX TAD I MVLLIN / GET INPUT STR COUNT DCA STRCNT ISZ MVLLIN MVLLN1, CIFMNU JMS I INACAL / GET A LINE MVLLN2, MVLCHQ / POINTER TO BUFFER...1ST LOC=-CNT OF CHARS+1 JMP MVLLN4 / OVFLOW ERR OR GOLD CHAR TAD I PRTVOL /1ST CHAR OF STRING /C008 SZA CLA /=CR? /C004 JMP MVLLN3 / NO-CHK LNGTH OF STRING /C004 TAD CRERSW / IS CR AFTER ERROR? /A004 SNA CLA /A004 JMP I MVLLIN / NO JMS CLCRER / CLEAR BOTTOM LINE AND ERROR SW /A004 JMP MVLLN1 / GET NEXT LINE /A004 MVLLN3, MQA TAD STRCNT SMA CLA / STRING TOO LONG JMP MVLLN5 / YES JMP MVLLN7 / NO MVLLN4, TAD (-EDMENU) SNA CLA / =GOLD MENU? JMP MVLLN8 / YES MVLLN5, TAD I MVLLN2 / GET LINE CHAR COUNT JMS MVLERM / ERROR MESSAGE JMP MVLLN1 / NEXT MVLLN7, ISZ MVLLIN / SET NORMAL RET MVLLN8, ISZ MVLLIN / GOLD MENU RET JMP I MVLLIN / RET WINFLD, XX CLA RDF TAD CIDF0 MYFLD1, CDFMYF / CDF INSTRUCTION TO THIS FIELD /C011 JMP I WINFLD X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED WINSAL, XX / SHOW ALL VOLUMES...LI JMS GETVOL / GET VOLUME DATA JMS I PRTHDX / PRINT HEADER /C008 IAC / PASS DEV # TAD VOLPTR DCA WINQBK+RXQBAD / BUFF. ADDR DCA WINQBK+RXQDRV / DEVICE # /D011 TAD MYFLD2 / GET CDF INSTRUCTION TO THIS FIELD /C011 /D011 DCA WINQBK+RXQBFD / BUFFER FIELD TAD (RDEGTD+4000) / GET DIRECTORY DATA FUNCTION CODE /D011 DCA WINQBK+RXQFNC JMS QURX JMP I WINSAL / ERROR TAD VOLPTR / PTR TO DIR DATA DCA SVX0 / CURRENT POINTER /D008 IAC TAD PRTL06 / STARTING CURSOR POSITION /A008 DCA PRTLNO / SET RELATIVE LINE NO. /D008 DCA PRTCNT / CLEAR IT DECIMAL /A008 TAD (-12) / LINE COUNT /A008 OCTAL /A008 DCA LINCNT WINSAA, TAD SVX0 DCA X0 / CURRENT POINTER TO DIR DATA TAD I X0 SNA / END DIR BUF AREA? JMP WINSXX / PRINT GOLD MENU MSSG CIA / NEG TAD P377 SNA CLA / DELETED IN MASTER MENU? JMP WINSAJ / YES IGNORE; BUMP POINTER TO NEXT ENTRY TAD VOLPT2 JMP WINSAC WINSAB, TAD SVPT2 TAD (LENVOL+1) / SET TO NEXT WINSAC, DCA SVPT2 DCA AREANO / CLEAR IT TAD SVX0 DCA X0 / CURRENT POINTER TO DIR DATA TAD SVPT2 DCA X1 / CURRENT POINTER TO MOUNTED VOL TBLE TAD I X1 / AREA # SPA / END OF AREA? JMP WINSAH / YES LAST ENTRY DCA AREANO / SET IT FOR DISPLAY JMS CMPVOL / NO-COMPARE TO ENTRY IN BUFFER; VOLUME NAMES JMP WINSAB / NOT EQUAL JMS WINSAE / DELETE A VOLUME FROM LIST WINSAH, CLA TAD SVX0 DCA X0 TAD AREANO / GET FOR DISPLAY JMS WINSA7 / ON PRINT LINE DCA VOLTMP / INCREMENTED AT WINSA8 /A006 ISZ LINCNT / TIME FOR NEXT SCREEN MSG? /A008 JMP WINSAJ / NO, NORMAL CONTINUE /A008 JMS PRTNXT / NEXT SCREEN, C.R., G.M. AND REPLY /A008 JMP WINSXX / NO MORE TO PRINT, NORMAL EXIT /A008 JMP WINNXT / NEXT SCREEN ENTERED /A008 JMP WINSXY / GOLD MENU /A008 JMP WINSXZ / RETURN /A008 WINSAJ, TAD SVX0 TAD (LENVOL) DCA SVX0 / SET TO NEXT ENTRY JMP WINSAA / NEXT WINSXX, CLA JMS PRTLST / PRINT MSSG FOR CR OR GOLD MENU JMS I GTGMCR / GET IT WINSXY, ISZ WINSAL / CAR RET ENTERED /C008 WINSXZ, JMP I WINSAL / WAS G.M.-RET /C008 WINNXT, JMS I PRTHDX / PRINT HEADER ON NEW SCREEN /A008 DECIMAL /A008 TAD (-12) / SET LINE COUNT /A008 OCTAL /A008 DCA LINCNT /A008 TAD PRTL06 / RESET CURSOR POSITION /A008 DCA PRTLNO /A008 JMP WINSAJ / AND CONTINUE /A008 LINCNT, 0 / LINE COUNTER FOR NEXT SCREEN /A008 WINSAE, XX / DELETE A VOLUME FROM THE ACTIVE VOLUME LIST TAD SVPT2 DCA X0 / SET TO DELETE VOLUME FROM MOUNTED AREA TAD SVPT2 TAD (LENVOL+1) / SET TO END OF THIS VOLUME + AREA NUM DCA X1 WINSAF, TAD I X1 SPA / END OF AREA? JMP WINSAG / YES DCA I X0 / NO STORE IT JMP WINSAF / REPEAT WINSAG, DCA I X0 / SET END JMP I WINSAE / SET WINNIE CODE IN TABLE 4000=WINNIE DEVICE / 1=MOUNTED / ADDS 4000 TO AC THEN SETS INTO DEVICE TABLE IN ACP / RXSTRT+1=POINTER TO STRT TABLE +DEV NO = LOCATION FOR DEVICE WINSET, XX MQL / SAVE MOUNT/DISMOUNT CODE /A002 CLA CMA /A002 TAD WINQBK+RXQDRV / DRIVE# /A002 SZA CLA / MOUNTING/DISMOUNTING DRIVE 1? /A002 JMP I WINSET / NO /A002 MQA / GET CODE /A002 CLL RTL / TO BIT 8 /A002 RAL /A002 MQL / SAVE IT /A002 CDFMNU / MENU FLD /A002 TAD I (MNOPTN+MUBUF) / OPTN CODE /A002 AND K7767 / CLEAR BIT 8 /A002 MQA / CLEAR/SET IT /A002 DCA I (MNOPTN+MUBUF) /A002 MYFLD2, CDFMYF / CDF INSTRUCTION TO THIS FIELD /C011 JMP I WINSET / RETURN K7767, 7767 PRTER1, IFDEF ENGLSH /A008 IFDEF ITALIAN /A008 IFDEF V30NOR /A013 IFDEF V30SWE IFDEF DUTCH IFDEF SPANISH X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / GET AREA NUMBER AND VOLUME NAME AND VERIFY / RET+0 IF ERROR ELST RET+1 GTVERA, XX TAD VOLPT2 / MOUNTED VOLUME TABLE DCA X0 TAD M7 DCA T3 / COUNT FOR MAX VOL NAME SIZE JMS MVLLIN / GET LINE -2 / STRING COUNT JMP MVCRET / CARRIAGE RET JMP MVGOLD / IS A GOLD MENU TAD I PRTVOL / CHAR /C008 TAD (-60) / SET TO BIN DCA WINTMP TAD WINTMP / GET DEV NUM. /C008 SNA / TRYING TO ASSIGN/DEASSIGN DEV. 0? /A006 JMP GTVERB / YES.......ERROR /A006 TAD M10 / IS DEV NUMBER G.T. 7 /C008 SPA CLA / .LE. 7? /C008 JMP GTVERC / OK CONT GTVERB, JMS I WINP5X / ERROR /C008 /D008 PRTER1 PRTERA / CHOOSE 1-7. ... /A008 JMP I GTVERA / ERROR RET. C+1 GTVERC, ISZ GTVERA / C+2 TAD WINTMP DCA AREANO / AREA NUMBER JMS GETNAM / CHECK IF AREA ALREADY MOUNTED JMP I GTVERA / AREA NUM NOT FOUND IN MOUNT TABLE. C+2 ISZ GTVERA / FOUND AREA # IN MOUNTED VOLUME TABLE JMP I GTVERA / C+3 / SET PRINT BUFFERS / ENTERS WITH AC=AREA # AND X0 POINTER TO VOLUME TABLE WINSA7, XX DCA AREANO / SET TO PRINT DEVICE NO. TAD (-10) / CHECK FOR DEVICE 10..FOR SOME REASON /A006 TAD AREANO /..IT SHOWS UP WHEN BOOTING FROM WINNIE /A006 SNA CLA / IS IT 8?...(THINK FIRMWARE SENDS IT) /A006 JMP WINSA8 / YES IGNORE IT...DOESNT HAPPEN W/FLOPPY BOOT/A006 TAD (VOLSAR-1) DCA X1 / SET TO VOLUME NAME TAD (-LENNAM) / LENGTH DCA T3 JMS MOVT01 / MOV FROM X0 TO X1 WHERE T3=COUNT TAD X0 TAD (VOLSIZ-VOLRD) / PTR SET TO VOLUME SIZE/16 DCA X0 TAD I X0 DCA T3 / LOW ORDER COUNT TAD I X0 / HIGH ORDER DCA T2 / JMS MULT16 / MULT T2-T3 * 16 TAD T3 CLL RTL / *8 RTL / *16 DCA T3 / FORMAT WAS 8BITS H/O 8BITS L/O / SHIFT L/O IS = DIV/16 DECIMAL TAD (999) OCTAL DCA NUMBLO / DIVISOR JMS DBLDVD / DIVIDE T2-T3 BY 999 TAD T3 / GET QUOTIENT DCA PRTHO / SET TO PRINT H/O TAD NUMBLO / GET REMAINDER(L/O) DCA PRTLO / SET TO PRINT L/O TAD PRTLNO / LINE NO TO DISPLAY BSW / TO H/O TAD (05) / CURSOR POSITION; COLUMN 05 FOR DEVICE /A008 DCA PRTLN2 /D008 TAD PRTCNT / SW--EVEN=FRST TIME FOR LINE /D008 RAR /D008 SZL CLA / FRST TIME? /D008 TAD (46) / NO SET COL AT END /D008 TAD (402) / SET UP FIRST LINE /D008 TAD PRTLN2 /D008 DCA PRTLN2 TAD PRTLN2 TAD (17) / COLUMN 24 FOR BLOCKS /C008 DCA PRTLN3 / CURSOR POSITION FOR BLOCKS /D008 SZL /1ST TIME TO PRINT LINE ISZ PRTLNO / NO INCREMENT LINE NO /D008 ISZ PRTCNT / NEXT LINE SW JMS PRTLN1 / DISPLAY LINE WINSA8, ISZ VOLTMP /A006 TAD VOLTMP TAD (LENVOL) / SET TO NEXT VOL /D006 DCA VOLTMP JMP I WINSA7 / RET MOVNAM, XX / MOVE NAME FROM INPUT BUFFER TO SET FOR PRINT TAD MVLCHP DCA X0 / FROM STRING PTR TAD (VOLSAR-1) DCA X1 / TO STRING POINTER TAD M9 / COUNT DCA T3 JMS MOVT01 / FROM X0 TO X1 JMP I MOVNAM / RET / / GET INPUT CHECK FOR "Y" OR "N" / "N" = NORMAL RET / NOT "Y" OR "N" = RET+1 / "Y" = RET+2 WNYORN, XX JMS MVLLIN / GET LINE -4 / STRING COUNT JMP MVCRET JMP MVGOLD TAD I PRTVOL / GET CHAR /C008 AND (337) / SET UPPER CASE TAD (-"N+200) SNA / =N? JMP I WNYORN / "N" RET IFDEF ENGLSH < TAD (-"Y+"N) > IFDEF ITALIAN < TAD (-"S+"N) > IFDEF DUTCH < TAD (-"J+"N) > IFDEF V30NOR < TAD (-"J+"N) > IFDEF V30SWE < TAD (-"J+"N) > IFDEF SPANISH < TAD (-"S+"N) > SNA CLA / =Y ISZ WNYORN / SET YES RET ISZ WNYORN / NOT Y OR N RET JMP I WNYORN / RET MVCRET, CLA / SET MNTMP2 TO 0 RETURN TO WINNIE MENU MVGLDA, CDFMNU DCA I (MUBUF+MNTMP2) CDFMYF JMP WNCRET X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / / MOUNT CHECK--CHECKS NAME STORED IN PRTVOL / AGAINST VOLUME MOUNTED TABLE / RET+0 =NO MATCH RET+1=MATCH(ALREADY MOUNTED) MNTCHK, XX TAD X1 DCA SVX1 TAD VOLBUF / POINTER TO MOUNTED VOLUME TABLE MNTCK2, DCA SVX0 TAD SVX1 DCA X1 TAD SVX0 / SAVE CURRENT POINTER DCA X0 TAD I SVX0 / GET DEVICE? SPA CLA / END OF MOUNTED VOLUME TABLE JMP I MNTCHK / MATCHES ISZ LCCLUG / LOWER CASE IGNORE CLUDGE JMS CMPVOL / CHECK IF VOLUME ALREADY MOUNTED SKP / NO JMP MNTCK3 / YES TAD SVX0 TAD (LENVOL+1) JMP MNTCK2 / NEXT VOL MNTCK3, ISZ MNTCHK JMP I MNTCHK PADNAM, XX / PADNAM PADS TABLE WITH SPACES MQA / GET COUNT TAD MVLCHP / START ADDRESS-1 DCA X0 / SET IT MQA / GET COUNT TAD M10 / SET TO LAST CHAR-1 SNA / FULL? JMP PADNM2 / YES DON'T NEED PAD DCA T3 PADNM1, TAD (" -200) / SPACE DCA I X0 ISZ T3 / END? JMP PADNM1 / NO PADNM2, DCA I X0 / SET 0 TERMINATOR FOR PRINT. TAD MVLCHP / PNTR TO NAME DCA X1 / RESET TAD M10 DCA T3 JMP I PADNAM / GET VOLUME AREA FROM DISMOUNT TABLE / VOLUME NUMBER IN AREANO / RETURNS WITH X0 POINTING TO NAME GETNAM, XX TAD VOLPT2 GETNM1, DCA X0 TAD I X0 SPA JMP GETNM9 / END TABLE CIA TAD AREANO SNA CLA / FOUND? JMP GETNM7 / YES TAD X0 TAD (LENVOL) / SET TO NEXT JMP GETNM1 GETNM7, ISZ GETNAM / SET FOUND RET GETNM9, CLA JMP I GETNAM IFDEF PASSWD < / GET DEC NO FROM KEYBOARD AND CONVERT IT TO BIN DBLE PREC. ADDED TO T2-T3 / GET DBLE PREC. # IN T2 T3. / RETURNS WITH H/O IN T2 L/O IN T3 GETBIN, XX DCA T2 / CLEAR DCA T3 GETBN1, JMS MVLLIN / GET LINE -106 / STRING COUNT JMP MVCRET / CARRIAGE RET JMP MVGOLD / IS A GOLD MENU GETBN2, MQA / CHAR COUNT SNA / ONLY CRET? JMP MVCRET / YES CIA / NEG DCA GETCNT / COUNTER TAD MVLCHP / ADDRESS OF BUFFER DCA X3 GETBN3, TAD I X3 / GET CHAR TAD (-"0+200) SPA / L.T. 0? JMP GETBNM / YES EXIT TAD (-"9+"0) SMA SZA / G.T.9? JMP GETBNM / YES TAD ("9-"0) / SET TO BINARY DCA BNTMP1 TAD M11 / -9 DEC DCA BNCNT / COUNT / MULTIPLY T2--T3 BY 10 / MULT23, 0 TAD T2 DCA BNTMP2 / SAVE TAD T3 DCA BNTMP3 / LO MULTLP, TAD T3 TAD BNTMP3 / ADD TO ITSELF DCA T3 RAL / CARRY BIT TAD T2 TAD BNTMP2 /H/O DCA T2 TAD T2 / AND K20 SZA CLA / G.T. 65000? JMP GETBNM / YES =ERROR ISZ BNCNT / COUNT JMP MULTLP / LOOP TAD T3 TAD BNTMP1 DCA T3 / SET IT RAL / SHIFT IN CARRY TAD T2 DCA T2 / CHAR ADDED TO T2,T3 ISZ GETCNT JMP GETBN3 / NEXT GETBN5, ISZ GETBIN / SET RETURN JMS SHIFT4 / SHIFTS H/O 4 BITS IN T3(LO WRD) / TO L/O 4 BITS IN T2(HO) GETBNM, CLA JMP I GETBIN / RET GETCNT, 0 / CHAR COUNTER > / END IFDEF PASSWD CLRLST, XX / CLEAR BOTTOM LINE OF SCREEN TAD (3000) / POINTER JMS I CLRSCX / DO IT /C008 JMP I CLRLST X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / DIVIDE T2-T3 BY NUMBLO LEAVING QUOTIENT IN T3 AND REM IN NUMB / USES T2-T3 NUMBLO DBLDVD, XX DCA PSMQHI DCA PSMQLO TAD (-31) DCA MQCNT TAD NUMBLO CLL CMA CML DCA NUMBLO RAL TAD NUMBHI CLA CMA CML DCA NUMBHI JMP DBDV2 DBDV1, TAD PSMQLO RAL DCA PSMQLO TAD PSMQHI RAL DCA PSMQHI TAD PSMQLO TAD NUMBLO MQL RAL TAD PSMQHI TAD NUMBHI SNL JMP DBDV2 DCA PSMQHI MQA DCA PSMQLO DBDV2, CLA TAD T3 RAL DCA T3 TAD T2 RAL DCA T2 ISZ MQCNT JMP DBDV1 TAD PSMQLO DCA NUMBLO TAD PSMQHI DCA NUMBHI JMP I DBLDVD /VARIABLES FOR MULT/DIV /SUBR----NEGATE NUMB PSMQHI, 0 PSMQLO, 0 MQCNT, 0 NUMBHI, 0 NUMBLO, 0 / /SHIFT4 ROUTINE....CONVERTS PASSWORD CONTAINED IN T2(L/O 4 BITS OF H/O WORD) / ............................. AND T3(12 BITS OF L/O D.P. WORD) / ..............INTO 2 8 BIT WORDS H/O IN T2 LO IN T3 SHIFT4, XX TAD (-4) / SHIFT COUNT DCA SHFTCT TAD T2 / H/O MQL TAD T3 / L/O SHFTNX, CLL RAL / SHIFT L/O LNK BIT NOT MATTER HERE SWP / GET H/O RAL / INTO BIT 11 SWP / RESET BACK ISZ SHFTCT / DONE? JMP SHFTNX / NO CLA TAD T3 / GET UNSHIFTED L/O WRD AND P377 / YES CLEAR BITS 0-3 L/O WORD DCA T3 / RESET CLA SWP / GET H/O DCA T2 / RESET JMP I SHIFT4 SHFTCT, 0 / TEMP STORE / CHKVOL ROUTINE READS IN DIRECTORY DATA / VERIFIES THAT THE VOLUME NAME IS VALID / IF VOLUME NAME NOT FOUND IT PRINTS ERROR MESSAGE AND RETURNS RET+0 / IF VOLUME NAME VALID IT RETURNS RET+1 / SVX0 LEFT POINTING TO PASSWORD CHKVOL, XX TAD VOLBUF / BUFFER DCA WINQBK+RXQBAD TAD (RDEGTD) / GET DIRECTORY DATA FUNCTION CODE /D011 DCA WINQBK+RXQFNC JMS QURX / DO IT JMP CHKVL2 / IO ERROR TAD VOLPT2 / BUFFER-1 CHKNXT, DCA X0 IAC / SET UP BUFFER TAD X0 DCA SVX0 / SAVE IT TAD MVLCHP / POINTER TO START OF NAME VOLUME-1 DCA X1 ISZ LCCLUG / LOWER CASE IGNORE CLUDGE JMS CMPVOL / VOLUME IN TABLE=VOLIME TO BE MNTED SKP / NO CHECK TABLE END JMP CHKVL1 / FOUND VOLUME..X0 POINTS TO PASSWORD-1 TAD I SVX0 / FIRST CHAR OF NAME SNA CLA / 0=END TABLE JMP CHKVL0 / ERROR TAD SVX0 TAD (LENVOL-1) / SET TO NEXT BUFFER -1 JMP CHKNXT / DO IT CHKVL0, JMS I WINP7X / PRINT ERROR MESSAGE /C008 PRTER8 / "^P ^A NOT A VOLUME NAME. ... " JMP CHKVL2 / ERR RET CHKVL1, TAD X0 / POINTES TO READ PASSWORD-1 DCA SVX0 TAD SVX0 TAD (VOLDAT-VOLRD+1) / SET POINTER TO OS/WPS DATA DCA SHFTCT / TEMP TAD (10) / -(WPS-8) CODE BIT /C003 AND I SHFTCT / REQUESTED VOLUME CODE /C003 SZA CLA / =WPS-8? /C003 JMP CHKVL3 / YES JMS I WINP7X / NO PRINT ERR MESSAGE /C008 PRTER9 / "NOT A WPS VOL ... " CHKVL2, TAD AREANO / SAVE IT AS GETVOL RESETS IT /A007 DCA SAVENO /A007 JMS GETVOL / RESET MOUNTED VOLUME DATA /A006 TAD SAVENO / GET IT BACK /A007 DCA AREANO / /A007 JMP I CHKVOL / RET CHKVL3, ISZ CHKVOL / SET NORMAL RET JMP I CHKVOL X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / CHKPAS ROUTINE ENTERS WITH SVX0 POINTING TO PASSWORD FOR DESIRED VOLUME / .... IT THEN CHECKS THE PASSWORD FOR THAT VOLUME AGAINST THE / .... ONE ENTERED.. IF ERROR IT SETS PASSER CHKPAS, XX TAD SVX0 DCA X0 TAD I X0 / GET L/O PASSWORD CIA TAD RPASS3 SZA CLA / =? JMP CHKPEE / NO TAD I X0 / GET H/O PASSWORD CIA TAD RPASS2 SZA CLA / =? JMP CHKPEE / NO TAD I X0 / GET L/O PASSWORD CIA TAD WPASS3 SZA CLA / =? JMP CHKPEE / NO TAD I X0 / GET H/O PASSWORD CIA TAD WPASS2 SZA CLA / =? CHKPEE, ISZ PASSER / SET ERROR JMP I CHKPAS WINFNB, / FINISH COMMAND /D009 JMS WINFLD / GET CALL FLD /D009 DCA RETCF2 / SET RET FLD SETPRQ, / BOOT WINNIE OR RX50D TAD (MNRX5X+MNRX4X) / WINNIE FIRMWARE BIT 6 OR SYS DEV = WINNIE/C009 CDFMNU AND I (MUBUF+MNOPTN) / STATUS WORD CDFMYF CLL RTR / SHIFT DRV 0 WINNIE BIT /A009 SNA CLA / WINNIE FIRMWARE? /C009 JMP POBOOT / NO DO POWER ON BOOT /C009 SZL / IS DRIVE 0 = WINNIE? /A009 JMP WNBOOT / YES REBOOT MASTER MENU /A009 CDFMNU /A009 TAD I (MNSYSA+MUBUF) / LAST CHAR ENTERED /A009 CDFMYF /A009 SZA CLA / CHECK FOR CARRIAGE RETURN /C011 JMP RX50BT / NO, GO BOOT THE FLOPPY /C011 / YES, FALL INTO WINNIE BOOT WNBOOT, CIFMNU JMS I IOACAL / SET TO KEYPAD MODE WINZRO, 0 / USE DEFAULT OUTPUT ROUTINE /C011 TXTKEY / CONTROL STRING TO OUTPUT RESET COMMANDS /D011 TXTPAD / CURSOR KEYPAD MODE ISZ WINZRO / WAIT TO INSURE COMPLETE SCREEN OUTPUT /A011 JMP .-1 / NOT DONE, GO DO IT AGAIN /A011 TAD DEALP7 / SET UP TO DISMOUNT VOL 0 /C011 DCA DEALP1 /A003 JMS DEALL / DISMOUNT DRIVE 0 /A003 DCA AREANO / SET DRIVE=0 JMS WINIO RDEMTS / MOUNT SYSTEM VOLUME PRQ3 / RESET DECMATE MODE /A011 10 / FUNCTION CODE ARGUMENT /A011 -1 / END OF LIST INDICATOR /A011 AC7775 / BOOT THE WINNIE /C011 SKP / SKIP OVER RX-50 BOOT CODE /A011 RX50BT, AC7776 / BOOT THE FLOPPY /C011 PRQ3 / ISSUE PANNEL REQUEST COMMAND 6 / COMMAND CODE -1 / TERMINATOR JMP . / TEST HALT /C009 POBOOT, PRQ3 / ISSUE PANNEL REQUEST COMMAND 5 / CODE FOR A POWER UP BOOT -1 / TERMINATOR JMP . / TEST HALT /C009 FRMTYP, 0 / FRIMWARE TYPE 0=FLOPPY -1=WINNIE DEALL, XX / DEALLOCATE ALL VOLUMES XCPT 0 JMS GETVOL / GET ALL ASSIGNED VOLUMES TAD VOLBUF / POINTER TO START OF TABLE DEALP0, DCA VOLTMP / SET IT TAD I VOLTMP / GET DEVICE # ISZ VOLTMP / POINTER TO NAME SNA / =0? DEALP1, JMP DEALP5 / YES SKIP DEASSIGN /C003 SPA / END OF TABLE? JMP DEALP7 / YES DCA WINQBK+RXQDRV / SET DRIVE TO BE DISMOUNTED TAD VOLTMP DCA WINQBK+RXQBAD / VOL NAME ADDRESS /D011 TAD (CDFMYF) /D011 DCA WINQBK+RXQBFD / BUFFER FIELD TAD (RDEDIS+4000) / DISMOUNT COMMAND FUNCTION CODE /D011 DCA WINQBK+RXQFNC JMS QURX / DO IT JMP DEALP5 / IGNORE ERROR DO NEXT DEALP5, TAD (LENVOL) TAD VOLTMP / SET TO NEXT JMP DEALP0 / DO NEXT DEALP7, CLA JMP I DEALL / RET QURX, XX DCA WINQBK+RXQFNC / STORE COMMAND CODE IN QUEUE BLOCK /A011 CIFSYS / CHANGE TO SYSTEM FIELD ENQUE / QUEUE TO RXHAN QUBLK1 / ADDRESS OF QUEUE BLOCK TO USE QURX1, CIFSYS / CHANGE TO SYSTEM FIELD JWAIT / WAIT FOR DONE /D011 CLA TAD WINQBK+RXQCOD / PICK UP THE COMPLETION CODE SNA / CHECK FOR DONE /C011 JMP QURX1 / NOT DONE, GO CHECK AGAIN /C011 SMA CLA / CHECK FOR AN ERROR /C011 ISZ QURX / BUMP FOR SUCESSFUL RETURN JMP I QURX / ERROR--RETURN WITH NO INCRMENT /D011 TAD WINQBK+RXQCOD /D011 SNA CLA / /D011 JMP QURX1 /D011 ISZ QURX / BUMP FOR SUCESSFUL RETURN /D011 JMP I QURX / DONE / GET DIRECTORY DATA / AC=POINTER TO VOL NAME WINIO, XX DCA WINQBK+RXQBAD / BUFFER ADDRESS TAD AREANO DCA WINQBK+RXQDRV /D011 TAD (CDFMYF) /D011 DCA WINQBK+RXQBFD TAD I WINIO / GET COMMAND FUNCTION CODE ISZ WINIO / SET RETURN ADDRESS /D011 DCA WINQBK+RXQFNC / FUNCTION CODE JMS QURX JMP WINMVN / DISK ERROR JMP I WINIO / RET IFDEF ENGLSH < TXTLN2, TEXT '^P!2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > IFDEF ITALIAN < TXTLN2, TEXT '^P!2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > IFDEF V30NOR < TXTLN2, TEXT '^P!2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > IFDEF V30SWE < TXTLN2, TEXT '^P!2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > IFDEF DUTCH < TXTLN2, TEXT '^P !2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > IFDEF SPANISH < TXTLN2, TEXT '^P !2D/!2D/!2D !2D:!2D' /MOVED HERE FOR SPACE REASONS /M012 > X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED / GET ALL MOUNTED VOLUME DIRECTORIES / AND SET POINTERS IN VOLTB1 POINTING TO THE NAMES IN THE DIRECTORIES GETVOL, XX TAD VOLBUF DCA VOLPTR / MAIN POINTER CDFMNU TAD I (MUBUF+MNMXDR) / MAX NUM DRIVES IN SYSTEM MYFLD3, CDFMYF / CDF INSTRUCTION TO THIS FIELD /C011 CMA DCA WINCNT / # DEVICES PROCESSED DCA AREANO / AREA/DRIVE BEING PROCESSED DCA MNTCNT / # DRIVES MOUNTED GTVOLA, TAD AREANO DCA I VOLPTR / SET DEV # AT BEG. OF TABLE /C006 ISZ VOLPTR TAD VOLPTR DCA WINQBK+RXQBAD / ADDRESS /D011 TAD MYFLD3 / GET CDF INSTRUCTION TO THIS FIELD /C011 /D011 DCA WINQBK+RXQBFD / FIELD TAD AREANO DCA WINQBK+RXQDRV / DEVICE # TAD (RDEGTV+4000) / GET VOLUME DATA FUNCTION CODE /D011 DCA WINQBK+RXQFNC / FUNCT. CODE JMS QURX SKP / IS AN ERROR JMP WINOK / IS MOUNTED CLA CMA TAD VOLPTR / RESET POINTER DCA VOLPTR CLA CMA / -1 DCA I VOLPTR / NOT MOUNTED JMP WINEXT / IS END? WINOK, TAD VOLPTR TAD (LENVOL) / SET TO NEXT DCA VOLPTR ISZ MNTCNT / NO OF MOUNTED DEVICES = +1 WINEXT, ISZ AREANO / NEXT ISZ WINCNT / MAX # DRIVES JMP GTVOLA CLA CMA DCA I VOLPTR / SET END JMP I GETVOL WINCNT, 0 / -NUMBER OF DRIVES /M008 MNTCNT, 0 / NUMBER OF MOUNTED DEVICES /M008 MOVT01, XX / MOVE FROM X0(POINTER) TO X1(PTR) T3=COUNT MOV01A, TAD I X0 DCA I X1 ISZ T3 JMP MOV01A JMP I MOVT01 MULT16, XX / MULTIPLY T2 T3 BY 16 TAD (-4) DCA MULCNT / COUNTER MULTLQ, TAD T3 / LOW ORDER CLL RAL / SHFT DCA T3 TAD T2 / HIGH ORDER RAL / SHIFT IN LINK DCA T2 ISZ MULCNT / DONE? JMP MULTLQ / NO JMP I MULT16 / YES MULCNT, 0 / COMPAR VOLUME NAME IN X0 TO NAME IN X1 T3=NUM CHARS TO COMP / RETURN+0 IF ERROR END TABLE / RETURN+1 IF MATCH CMPVOL, XX TAD (-LENNAM) DCA T3 CMPVL1, JMS SETUPC / SET UPPER CASE IF SW SET CMPVL2, TAD I X1 CIA TAD I X0 SZA CLA / =? JMP CMPVL3 / NOT EQ. ISZ T3 / END NAME? JMP CMPVL1 / NOT YET ISZ CMPVOL / SET RET CMPVL3, DCA LCCLUG / CLEAR SW JMP I CMPVOL / EXIT /-------------------- / THIS IS THE ERROR MESSAGE HANDLER / THIS ROUTINE WILL WAIT FOR A GOLD MENU OR A CR / RESPONSE FROM THE KEYBOARD. / CALLING SEQUENCE: / JMS WTFRRS / HERE / RETURNS HERE IF RETURN PRESSED / HERE+1 / RETURNS HERE IF GOLD-MENU PRESSED / HERE+2 / RET FOR OTHER CHAR / V036 CODE DELETED WHICH CHECKS SYSTEM DISK ID / MVLGET, XX CIFMNU JMS I (INAIN) / GET A CHAR AND UPDATE TIME DCA MVLCHX / SAVE CHAR AND EXIT TAD MVLCHX TAD (-EDMENU) / CHECK FOR A GOLD MENU SNA / JMP MVLGTC TAD (EDMENU-EDNWLN) / NOW FOR A CR SNA CLA / JMP I MVLGET / / JMS WINWFT / BELL REPLY / CLA ISZ MVLGET / NORMAL RET MVLGTC, / GOLD MENU WAS TYPED ISZ MVLGET / SKIP RETURN JMP I MVLGET MVLERM, XX DCA MVLERT / SAVE NUM CHARS SHOULD HAVE BEEN READ MQA / LOAD # CHARS READ -1 IAC TAD MVLERT / ADD -NUM CHARS SHOULD HAVE BEEN READ SNA CLA / WAS RETURN DUE TO TOO MANY CHARS ENTERED JMP MVLERP / NO JMS I WINP5X / PRINT ERR MSG /C008 PRTER1 / "INPUT TOO LONG /A008 JMP I MVLERM / RET MVLERP, CIFMNU JMS I MNUCAL / CALL ERROR MESSAGE DLMCR1 / MENU ERROR MSG TAD (2200) / LINE 22 JMS I CLRSCX / CLEAR BOTTOM OF SCREEN FROM LINE 22 /C008 JMS I PRTLSX / PAINT CR G.MENU MSG /C008 JMP I MVLERM / RETURN CLCRER, XX / CLEAR BOTTOM LINE AND ERROR SW DCA CRERSW / CLEAR ERROR SW /A004 TAD (2700) / LAST LINE /A004 JMS I CLRSCX / CLEAR IT /C008 JMP I CLCRER / RET /A004 MVLERT, 0 / TEMP HOLD BUFFER X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED PRTLN1, XX / PRINT LINE NO IN AC TAD AREANO / GET DEVICE # SZA / DEVICE 0? TAD K20 / NO SET TO NUMERIC TAD (40) / YES SET TO SPACE BSW / CHAR IN H/O AND TERMINATOR IN L/L DCA PRTLN4 / SET FOR PRINT / PRTLN3 = 24 TAD PRTLN3 / SET POSITION FOR TYPE IFDEF ENGLSH < TAD (7) / COLUMN 33(8) > IFDEF ITALIAN < TAD (7) / COLUMN 33(8) > IFDEF V30NOR < TAD (7) / COLUMN 33(8) > IFDEF V30SWE < TAD (7) / COLUMN 33(8) > IFDEF DUTCH < TAD (12) > IFDEF SPANISH < TAD (12) > DCA PRTLN5 TAD PRTLN5 / SET POSITION FOR ATTRIBUTES IFDEF ENGLSH < TAD (12) / COLUMN 45(8) > IFDEF ITALIAN < TAD (12) / COLUMN 45(8) > IFDEF V30NOR < TAD (12) / COLUMN 45(8) > IFDEF V30SWE < TAD (12) / COLUMN 45(8) > IFDEF DUTCH < TAD (13) > IFDEF SPANISH < TAD (13) > DCA PRTLN7 TAD PRTLN7 IFDEF ENGLSH < TAD (31) / COLUMN 76(8) FOR LAST BACKUP > IFDEF ITALIAN < TAD (31) / COLUMN 76(8) FOR LAST BACKUP > IFDEF V30NOR < TAD (31) / COLUMN 76(8) FOR LAST BACKUP > IFDEF V30SWE < TAD (31) / COLUMN 76(8) FOR LAST BACKUP > IFDEF DUTCH < TAD (25) > IFDEF SPANISH< TAD (25) > DCA PRTLN8 / ON ENTRY, X0 CONTAINS ADDRESS OF SECOND WORD (20(8)) OF NUMBER OF BLOCKS / START WITH 1, NOT 0 / WORD 21(8) CONTAINS READ/WRITE ACCESS (4,5); UNIT (6); VOLUME MOUNTED (7) / STARTUP (9); MODIFIED (10); / WORD 22(8) CONTAINS BOOTABLE (SYSTEM) (4); SYSTEM TYPE (5-11) / PUT TYPE (WPS, OS8, COS, CPM) INTO CALLING SEQUENCE NOP / FOR DEBUG ONLY CLL CLA IAC RAL / AC=2 TAD X0 DCA WORKX0 / POINT TO DATA BITS FOR TYPE; WORD 21(8) TAD (PTLN90-1) / SET UP TO SCAN TABLE DCA X1 PTLN30, TAD I X1 / GET FROM TABLE SNA / DONE? JMP PTLN32 / END OF TABLE W/O MATCH DCA PRTTMP / SAVE TABLE ENTRY A MOMENT TAD I WORKX0 / COMPARE TO DATA AND (0113) / KEEP BITS 5, 8, 10,11 TAD PRTTMP SZA CLA JMP PTLN30 / NO MATCH, TRY AGAIN TAD (-PTLN90) / FOUND TYPE, CALCULATE DISTANCE DOWN TABLE TAD X1 TAD (PTLN20) / PLUS ADDRESS OF START OF MESSAGES DCA PRTLN6 / INTO CALLING SEQUENCE TAD I PRTLN6 DCA PRTLN6 JMP PTLN40 PTLN32, CLA CMA / CHECK FOR RESERVED TYPE TAD WORKX0 / BACK TO WORD 20(8) FOR VOLUME MOUNTED BIT DCA WORKX0 / IF BIT=0, VOLUME NOT MOUNTED (RESERVED) TAD I WORKX0 AND (20) / CHECK BIT 7 SNA CLA TAD (PTLN19-PTLN18) / PRINT SPACES, NOT RESERVED TAD (PTLN18) DCA PRTLN6 / PUT ATTRIBUTES (SYSTEM, MODIFIED, STARTUP) INTO CALLING SEQUENCE PTLN40, TAD (PTLN50-1) / POINT TO TEXT ARRAY DCA X1 IAC TAD X1 DCA WORKX0 DCA I WORKX0 / SET TERMINATOR IN TEXT ARRAY CLL CLA IAC RAL / BUMP TO WORD 22(8) TAD X0 DCA WORKX0 TAD I WORKX0 / GET DATA BITS AND (200) / BIT 4 (SYSTEM) SNA CLA / CHECK FOR BOOTABLE (SYSTEM) JMP .+3 JMS PTLN80 / MOVE TEXT TO OUTPUT ARRAY PTLN50 PTSYST-1 / "SYSTEM" CLA CMA / BACK TO WORD 21(8) TAD WORKX0 DCA WORKX0 TAD I WORKX0 AND (2) / MODIFIED BY WRITE COMMAND SNA CLA JMP .+3 JMS PTLN80 / MOVE TEXT PTMODI-1 / "MODIFIED" TAD I WORKX0 AND (4) / STARTUP SNA CLA JMP .+3 JMS PTLN80 PTSTAR-1 / "STARTUP" CIFMNU JMS I IOACAL 0 TXTLN1 / ^P^S____^A^P!4D!3D^P^S^P^A PRTLN2, /D008 0402 0500 / ^P; CURSOR POSITION FOR DEVICE; COL. 05 /A008 PRTLN4 / ^S; ADDR. OF DEVICE # VOLSAR / ^A; ADDR. OF ASCII STRING(VOLUME NAME PRTLN3, 0 / ^P; CURSOR POSITION FOR BLOCKS; COL. 22 PRTHO / !4D; ADDR. OF BLOCK # HIGH ORDER PRTLO / !3D; ADDR. OF BLOCK # LOD ORDER PRTLN5, 0 / ^P; CURSOR POSITION FOR TYPE /A008 PRTLN6, 0 / ^S; ADDRESS OF TEXT FOR TYPE /A008 PRTLN7, 0 / ^P; CURSOR POSITION FOR ATTRIBUTES /A008 PTLN50 / ^A; ADDRESS OF TEXT FOR ATTRIBUTES /A008 JMS PTLN00 / DATE OF LAST BACKUP JMP I PRTLN1 PRTLN4, 0 / DEVICE NUM WORKX0, 0 PRTTMP, 0 PTLN20, PTLN10 / POINTERS TO TEXT MESSAGES PTLN11 PTLN12 PTLN13 PTLN90, WPS8 / LOOKUP TABLE FOR SYSTEM TYPE OS278 COS310 CPM 0 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED WINCLR, XX / CLEAR BUFFER AREA -PRIMARILY FOR DIR READ END TAD VOLBUF / STRT BUFFER POINTER DCA X0 TAD (VOLTB2-VLTBLE) / COUNTER DCA CLRCNT DCA CRERSW / CR-ERR-SW...INITIALIZE /A004 WINCL1, DCA I X0 ISZ CLRCNT JMP WINCL1 CDFMNU /A006 TAD I (MUBUF+MNOPTN) / GET OPTION CODE /A006 CDFMYF /A006 AND K20 / DEV 0=WINNIE(BIT 7) /A006 DCA SYSDEV / SET SYSTEM DEV. 0=RX50,ELSE WINNIE /A006 JMP I WINCLR / DONE CLRCNT, 0 / COUNTER / CHECK PASSWORD FOR 0...IF ZERO RET NORMAL / ..ELSE RET + 1 ZERPAS, XX /A003 TAD SVX0 / PNTR TO PASSWORD /A003 DCA X0 /A003 TAD M4 /-4 /A003 DCA BNTMP1 / TEMP /A003 ZERPS1, TAD I X0 / GET PASS /A003 SZA CLA /=0 /A003 JMP ZERPS3 / NO..MUST NOW CHECK IT /A003 ISZ BNTMP1 / DONE /A003 JMP ZERPS1 / NO /A003 JMP I ZERPAS / YES..0 RET /A003 ZERPS3, ISZ ZERPAS /A003 JMP I ZERPAS /A003 M4, -4 /A003 /SETUPC ..SETS UPPER CASE FOR STRING IN X1 IF SWITCH SET AND RETURNS .+1 /ELSE RETURNS NORMAL SETUPC, XX TAD LCCLUG / GET SW SNA CLA / SET? JMP I SETUPC / NO ISZ SETUPC TAD I X1 TAD (-140) / VOLUME NAME CAN NOT CONTAIN NON ALPHA CHRS SPA / L.C.ALPHA? TAD (40) / YES CLEAR LC BIT TAD (100) JMP I SETUPC / RET LCCLUG, 0 WINPT9, XX CIFMNU JMS I IOACAL 0 PRTDMC /C008 1505 JMP I WINPT9 PRTLS0, XX / GET A CHARACTER, BELL IF NOT CR OR GOLD MENU JMP PRTLS2 / IGNORE BELL 1ST TIME PRTLS1, JMS WINWFT / RING BELL PRTLS2, JMS MVLGET / GET A CHAR /D008 JMP PRTLS3 / CR ISZ PRTLS0 / CR /A008 JMP I PRTLS0 / GOLD MENU JMP PRTLS1 /D008 PRTLS3, ISZ PRTLS0 / CR /D008 JMP I PRTLS0 WINWFT, XX / PRINT BELL HERE TO SAVE SPACE TAD (7) / RING THE BELL IF BAD CHARACTER JMP .+3 CIF 0 / JWAIT CIF 0 / TTYOU JMP .-4 JMP I WINWFT / RETURN PRTLST, XX / PRINT LINE CIFMNU JMS I IOACAL 0 TLS1 / ^P PRESS RETURN TO RECALL ... ^P^S^P PRTLS9, 2205 / PRTLS9, PRTL10, PRTL11 SET /C008 / AND RESTORED BY PRTNXT PRTL10, 2305 /C008 TXTLS2 / OR PRESS GOLD MENU ... PRTL11, 2405 /C008 JMP I PRTLST / / / THIS ROUTINE CHECKS FOR A WINNIE ON LINE... / ...IF NO WINNIE IT RETURNS TO RET+1 WINCHK, XX /A010 TAD (MNRX5X+MNRX4X) / WINNIE FIRMWARE BIT 6 /A010 / OR SYS DEV = WINNIE /A010 CDFMNU /A010 AND I (MUBUF+MNOPTN) / STATUS WORD /A010 CDFMYF /A010 SNA CLA / IS WINNIE ON LINE? /A010 ISZ WINCHK / NO -- SKIP RETURN /A010 JMP I WINCHK /A010 WINNAM, XX / WINNAM GETS NAME OF VOLUME TO BE MOUNTED JMS MVLLIN / GET LINE -11 / COUNT JMP MVCRET / CR JMP MVGOLD JMS PADNAM / PADS TABLE WITH BLONKS JMS MNTCHK / CHECK IF VOL ALREADY MOUNTED ISZ WINNAM / NO MATCH RETURN JMP I WINNAM / MATCH RETURN /***********************************************************************/ / / / CLRSCR--ROUTINE TO CLEAR THE SCREEN FROM A GIVEN POSITION / / AC CONTAINS THE POSTION TO CLEAR THE SCREEN FROM / / / /***********************************************************************/ CLRSCR, XX / CLEAR THE SCREEN DCA CLRSCP / SET THE POSITION TO CLEAR FROM CIFMNU JMS I IOACAL 0 PSCR CLRSCP, 0 / POSTION TO CLEAR FROM JMP I CLRSCR PTLN80, XX TAD I PTLN80 / FROM DCA X3 ISZ PTLN80 PTLN81, TAD I X3 SNA JMP PTLN82 DCA I X1 JMP PTLN81 PTLN82, DCA I X1 / TERMINATING ZERO CMA / BACK UP X1 FOR NEXT STORE TAD X1 DCA X1 JMP I PTLN80 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED WINPT1, XX / PRINT LINE AND WAIT FOR CR OR GOLD MENU TAD I WINPT1 / POINTER TO STRING DCA WINPT2 ISZ WINPT1 / SET RETURN CIFMNU JMS I IOACAL 0 WINPT2, 0 / STRING ADDRESS (PRC, PRTMVC, PRTMVD, PMA) 1405 2700 / PTR TO RESPONSE JMS I PRTLSX / CR OR G.M. MSGE JMP I WINPT1 / RET WINPT5, XX TAD I WINPT5 DCA WINPT6 ISZ WINPT5 CIFMNU JMS I IOACAL 0 WINPT6, 0 2705 /D008 MVLCHQ+1 IFDEF V30NOR < PRTRYK > /A013 IFDEF V30SWE < PRTRYK > IFDEF SPANISH < PULSE > ISZ CRERSW / CR-RET-ERROR SW /A004 JMP I WINPT5 WINPT3, XX TAD X0 / PTR TO VOL NAME -1 DCA WINPTZ / SET IT TAD I WINPT3 DCA WINPT4 ISZ WINPT3 CIFMNU JMS I IOACAL 0 WINPT4, 0 / ADDRESS OF OUTPUT STRING 1405 / CURSOR POSITION WINPTZ, MVLCHR AREANO / AREA NUMBER 2700 JMP I WINPT3 WINPT7, XX TAD I WINPT7 DCA WINPT8 ISZ WINPT7 CIFMNU JMS I IOACAL 0 WINPT8, 0 / ADDRESS OF TEXT 3000 /C008 MVLCHR IFDEF V30NOR < PRTRYK > /A013 IFDEF V30SWE < PRTRYK > IFDEF SPANISH < PULSE > ISZ CRERSW / CR-RET-ERROR SW /A004 JMP I WINPT7 / ERROR RET WINPTB, XX CIFMNU JMS I IOACAL 0 PRTDMB / ^P!E ... ^A ... !D^P 1405 WINPTD, 0 / ADDRESS OF ASCII NAME AREANO / DEVICE NUMBER 1505 JMP I WINPTB WINPTE, XX /D008 JMS I WINWPT / BELL CIFMNU JMS I IOACAL 0 PRTERA / "CHOOSE 1-7. ... " 3014 IFDEF V30NOR < PRTRYK> /A013 IFDEF V30SWE < PRTRYK> IFDEF SPANISH < PULSE > ISZ CRERSW / CR-RET-ERROR SW /A004 JMP I WINPTE / ERROR RET WINPTF, XX / PASSWORD ERROR /D008 JMS I WINWPT / BELL CIFMNU JMS I IOACAL 0 PRTER7 / "READ/WRITE PASSWORD ERROR ... " 3000 IFDEF V30NOR < PRTRYK > /A013 IFDEF V30SWE < PRTRYK > IFDEF SPANISH < PULSE > ISZ CRERSW / CR-RET-ERROR SW JMP I WINPTF / ERROR RET /D008 WINWPT, WINWFT WINP31, XX CIFMNU JMS I IOACAL 0 PRTMVB / OUTPUT STRING 1405 / CURSOR POSITION AREANO / DEVICE NUMBER 1505 / CURSOR POSITION FOR SECOND LINE 2700 / CURSOR POSITION FOR INPUT JMS I PRTLSX / GET INPUT JMP I WINP31 PRTHDR, XX / PRINT MENU HDR CIFMNU JMS I IOACAL 0 TXTHD0 / FORMAT 0202 / POSITION CURSOR FOR ERASE 0212 / POSITION CURSOR FOR TEXT /C008 TXTHD1 / FIRST LINE OF HEADER; VOLUME... /D008 0250 /D008 TXTHD1 /D008 0302 /D008 D3 /D008 0405 0302 / POSITION CURSOR /A008 TXTHD2 / SECOND LINE OF HEADER /A008 0402 / POSITION CURSOR /A008 D3 / UNDERLINES /A008 0502 / POSITION CURSOR /A008 JMP I PRTHDR PTLN00, XX / TEST TO SEE IF DATE OF LAST BACKUP, / OUTPUT IF THERE CLL CLA IAC CML RAL / AC = 3 TAD X0 DCA PRTLN9 TAD I PRTLN9 / SEE IF DATE SNA CLA JMP I PTLN00 / NO DATE JMS I PTLNAA / SET ADDRESSES IN CALLING SEQ CIFMNU / OUTPUT DAATE OF LAST BACKUP JMS I IOACAL 0 TXTLN2 / ^P!2D/!2D/!2D !2D:!2D PRTLN8, 0 / CURSOR POSITION PRTLN9, 0 / ADDRESS OF MONTH 0 / DAY 0 / YEAR 0 / HOUR 0 / MINUTE JMP I PTLN00 PTLNAA, PTLN05 X=. / INDICATE FIRST FREE LOCATION ON PAGE /-------------------- PAGE DSKBLK=.%400+DLWINI / DISK BLOCK WHERE PAGE IS LOADED PTLN05, XX / SET UP ADDRESSES OF LAST BACKUP CLA CLL IAC RAL / AC = 2 TAD X0 DCA PTLN09 / FROM ADDRESS-1 TAD PRTLNA / TO ADDRESS DCA X1 TAD PRTLNB / 5 ITEMS DCA PTLN08 PTLN06, ISZ PTLN09 / BUMP FROM ADDRESS TAD PTLN09 / GET ADDRESS DCA I X1 / ADDRESS INTO CALLING SEQ ISZ PTLN08 / COUNT JMP PTLN06 JMP I PTLN05 PTLN09, 0 PTLN08, 0 PRTLNA, PRTLN9-1 PRTLNB, -5 PRTNXT, XX / NEXT SCREEN, CR, GM MESSAGES TAD SVX0 / TEST IF MORE TO DISPLAY TAD PRTNXG / SET POINTER TO NEXT ENTRY IAC / TO MAKE UP FOR AUTO INCREMENT REGISTER DCA T1 TAD I T1 / TEST FOR ENTRY SNA CLA JMP I PRTNXT / EXIT C+1 FOR NORMAL CONTINUATION TAD PR2510 / ADJUST CURSOR POSITION FOR NEXT SCREEN MSG. DCA I PRTNXF TAD PR2605 DCA I PRTNXH TAD PR2705 DCA I PRTNXI CIFMNU JMS I IOACAL 0 TLS00 / "^P; PRESS NEXT SCREEN ... ^POR " 2405 2505 JMS I PRTLSX / CR, GM MESSAGE TAD PR2205 / RESET CURSOR POSITION DCA I PRTNXF TAD PR2305 DCA I PRTNXH TAD PR2405 DCA I PRTNXI PRTNX1, JMS I PRTNXC / GET INPUT JMP PRTNX7 / CR: GOTO C+4 EXIT JMP PRTNX8 / GM: GOTO C+3 EXIT TAD MVLCHX / OTHER, TEST FOR NEXT SCREEN TAD PRTNXD SNA CLA JMP PRTNX9 / NS: GOTO C+2 EXIT JMS I WINWFX / NOT ANY, BELL JMP PRTNX1 / GET AGAIN NOP / IN CASE NOP PRTNX7, ISZ PRTNXT PRTNX8, ISZ PRTNXT PRTNX9, ISZ PRTNXT JMP I PRTNXT PR2510, 2510 PR2205, 2205 PR2605, 2605 PR2705, 2705 PR2305, 2305 PR2405, 2405 PRTNXC, MVLGET PRTNXD, -EDNXSC PRTNXF, PRTLS9 PRTNXG, LENVOL PRTNXH, PRTL10 PRTNXI, PRTL11 NOP / SAVE A LITTLE ROOM NOP PTLN10, TEXT "!&WPS-8 " PTLN11, TEXT "!&OS278 " PTLN12, TEXT "!&COS-310 " PTLN13, TEXT "!&CP/&M " PTLN18, IFDEF ENGLSH < TEXT "RESERVED" > IFDEF ITALIAN < TEXT "RESERVED" > IFDEF V30NOR < TEXT 'RESERVERT' > IFDEF V30SWE < TEXT 'RESERVERAD'> IFDEF DUTCH < TEXT " VOORBH. " > IFDEF SPANISH < TEXT "RESERVADO" > PTLN19, TEXT " " PTSYST, "S&177 "Y&177 "S&177 "T&177 "E&177 IFDEF DUTCH < "E&177 > "M&177 40 0 PTMODI, IFNDEF DUTCH < "M&177 "O&177 "D&177 "I&177 "F&177 "I&177 "E&177 "D&177 40 0 > IFDEF DUTCH < "H&177 "E&177 "R&177 "Z&177 "I&177 "E&177 "N&177 40 0 > PTSTAR, "S&177 "T&177 "A&177 "R&177 "T&177 IFNDEF DUTCH < "U&177 "P&177 > 0 / TEXT STRINGS TXTHD0, TEXT '^P!E^P^S^P^S^P^S^P' /C008 IFDEF ENGLSH < TXTHD1, TEXT '!&VOLUME !&SIZE' /C008 TXTHD2, TEXT '!&DEVICE !&NAME (!&BLOCKS) !&TYPE !&ATTRIBUTES ' /A008 *.-1 / CONTINUATION OF TXTHD2 /A008 TEXT ' !&LAST !&BACKUP' /A008 > IFDEF ITALIAN < TXTHD1, TEXT '!&ARCHIVIO !&DIM.' /C008 TXTHD2, TEXT '!&UNIT\@ !&DO.TI !&BLOCCHI !&FORMATO !&CARATTERISTICHE ' /A008 *.-1 / CONTINUATION OF TXTHD2 /A008 TEXT ' !&ULTIMO !&SALVA.IO' /A008 > IFDEF V30NOR < /A013 TXTHD1, TEXT '!&OMR\EDTS !&STR.' TXTHD2, TEXT '!&ENHETENS !&NAVN (!&BLOKKER) !&TYPE !&ATTRIBUTTER' *.-1 TEXT ' !&SISTE !&SIKKERHETSKOPIERING' > IFDEF V30SWE < TXTHD1, TEXT '!&VOLYM !&STORLEK' TXTHD2, TEXT '!&ENHET !&NAMN (!&BLOCK) !&SKRIV !&ATTRIBUT' *.-1 TEXT ' !&SENASTE !&S\DKERHETSKOPIERING'> IFDEF DUTCH < TXTHD1, TEXT ' &NAAM &GROOTE' TXTHD2, TEXT '&AANDR. GEBIED (BLOKKEN) &TYPE &KENMERK ' *.-1 TEXT ' &LAATSTE &KOPIE' > IFDEF SPANISH < TXTHD1, TEXT '!&VOLUMNE &TAMA\QO' TXTHD2, TEXT '&DISP. !&NOMBRE (!&BLOQUES) !&TIPO !&ATRIB ' *.-1 TEXT ' &ULT.&COP.&SEG' > TXTKEY, TEXT '![[61"P![C' / ESC [ 6 1 " p RESET TO LEVEL 1 /C011 / ESC c RESET TERMINAL /C011 /D011 TXTPAD, ESC;"[&177;"?&177;"1&177;57;0 / ESC[?1/ D3, IFDEF ENGLSH < TEXT '------ ------ -------- -------' /C008 *.-1 / CONTINUATION OF D3 /C008 TEXT '- ----------------------- ---------------' /C008 > IFDEF ITALIAN < TEXT '------ ------ -------- -------' /C008 *.-1 / CONTINUATION OF D3 /C008 TEXT '- --------------- ---------------' /C008 > IFDEF V30NOR < TEXT '------- ---- -------- ---- ------- ---- -----------' *.-1 TEXT ' ----- -------------------' > IFDEF V30SWE < TEXT '------ ------ -------- -------' /C008 *.-1 / CONTINUATION OF D3 /C008 TEXT '- ----------------------- ---------------' /C008 > IFDEF DUTCH < TEXT '------ ------ ---------- --------' *.-1 TEXT '- --------------------- --------------' > IFDEF SPANISH < TEXT '------ ------ ---------- --------' *.-1 TEXT '- --------------------- --------------' > TXTLN1, TEXT '^P^S ^A^P!4D!3D^P^S^P^A' /C008 IFDEF ENGLSH < TLS00, TEXT '^P&PRESS !&NEXT !&SCREEN FOR MORE,^P!&OR ' /A008 TLS1, TEXT '^P&PRESS !&RETURN TO RECALL THE &HARD &DISK &VOLUME &MENU,' /C008 *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU' PMA, TEXT '^P&TYPE THE DEVICE NUMBER YOU WANT TO DEASSIGN AND PRESS !&RETURN^P' PRTDMB, TEXT '^P!E&VOLUME NAME ^A IS NOW ASSIGNED TO &DEVICE !D^P' /C008 PRTDMC, TEXT '&IS THIS THE VOLUME YOU WANT TO DEASSIGN? (&Y OR &N)^P' /C008 PRTDME, TEXT '^P!E&VOLUME ^A HAS BEEN DEASSIGNED FROM &DEVICE !D.^P' / MOUNT MESSAGES PRC, TEXT '^P!L&TYPE THE DEVICE NUMBER YOU WANT TO ASSIGN AND PRESS !' /C008 *.-1 /A008 TEXT '&RETURN.^P' / CONTINUATION OF PRC /A008 PRTMVB, TEXT '^P!L&TYPE THE VOLUME NAME YOU WANT TO ASSIGN TO &DEVICE !D' /C008 *.-1 / CONTINUATION OF PRTMVB /A008 TEXT '^PAND &PRESS !&RETURN.^P' /A008 IFDEF PASSWD < PRTMVC, TEXT '^P!E&ENTER READ PASSWORD AND PRESS !&RETURN.^P' /C008 PRTMVD, TEXT '^P!E&ENTER WRITE PASSWORD AND PRESS !&RETURN.^P' > / END IFDEF PASSWD PRTMVE, TEXT '^P!E&VOLUME NAME ^A ASSIGNED TO DEVICE !D.^P' > IFDEF ITALIAN < TLS00, TEXT '^P&PREMERE !&SCHERM !&SUCC PER CONTINUARE,^PO ' /A008 TLS1, TEXT '^P&PREMERE !&RITORNO PER TORNARE AL &MENU &DEFINIZIONI SU &DISCO &RIGIDO ' /C008 *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE' PMA, TEXT /^P&INTRODURRE L'UNIT\@ DA ANNULLARE E PREMERE !&RITORNO^P' PRTDMB, TEXT /^P!E&ARCHIVIO DOCUMENTI ^A \H DEFINITO COME UNIT\@ !D^P//C008 PRTDMC, TEXT '&CONFERMA ANNULLAMENTO ? (&S/&N)^P' /C008 PRTDME, PRTMVE, TEXT '^P!E&ARCHIVIO DOCUMENTI ^A DEFINITO COME UNIT\@ !D ANNULLATO.^P' / MOUNT MESSAGES PRC, TEXT /^P!L&INTRODURRE L'UNIT\@ DA DEFINIRE E PREMERE !&RITORNO./ /C008 PRTMVB, TEXT /^P!L&INTRODURRE L'ARCHIVIO DOCUMENTI DA DEFINIRE COME UNIT\@ !D / /C008 *.-1 / CONTINUATION OF PRTMVB /A008 TEXT '^PE PREMERE !&RITORNO.^P' /A008 IFDEF PASSWD < PRTMVC, TEXT '^P!E&INTRODURRE PAROLA CHIAVE PER LETTURA E PREMERE !&RITORNO.^P' /C008 PRTMVD, TEXT '^P!E&INTRODURRE PAROLA CHIAVE PER SCRITTURA E PREMERE !&RITORNO.^P' > / END IFDEF PASSWD > IFDEF V30NOR < /A013 TLS00, TEXT '^P&TRYKK P\E !&SKJERM,FOR \E G\E TIL NESTE SIDE ^P!&EL ' /A008 TLS1, TEXT '^P&TRYKK P\E !&RETUR FOR \E F\E MENYEN FOR &PLATELAGER, ' /C008 *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '!&EL &TRYKK P\E !&GEULL !&MENY FOR \E F\E &HOVEDMENYEN' PMA, TEXT '^P&SKRIV NUMMERET P\E ENHETEN DU VIL TREKKE TILBAKE OG TRYKK P\E' *.-1 TEXT ' !&RETUR^P' PRTDMB, TEXT '^P!E&OMR\EDENAVNET ^A ER N\E TILDELT ENHET !D^P' /C008 PRTDMC, TEXT '&ER DET DETTE OMR\EDET DU VIL TREKKE TILBAKE (&J EL. &N)^P'/C008 PRTDME, TEXT '^P!E&OMR\EDE ^A ER TRUKKET TILBSKE FRA ENHET !D.^P' / MOUNT MESSAGES PRC, TEXT '^P!L&ANGI NUMMERET P\E ENHETEN DU VIL TILDELE, OG TRYKK P\E !'/C008 *.-1 /A008 TEXT '&RETUR.^P' / CONTINUATION OF PRC /A008 PRTMVB, TEXT '^P!L&ANGI NAVNET P\E OMR\EDET DU VIL TILDELE ENHET !D ' /C008 *.-1 / CONTINUATION OF PRTMVB /A008 TEXT '^POG TRYKK P\E !&RETUR.^P' /A008 IFDEF PASSWD < PRTMVC, TEXT '^P!E&ANGI PASSORD FOR !&LESE OG TRYKK P\E !&RETUR.^P' /C008 PRTMVD, TEXT '^P!E&ANGI PASSORD FOR !&SKRIVE OG TRYKK !&RETUR.^P' > / END IFDEF PASSWD PRTMVE, TEXT '^P!E&OMR\EDENAVNET ^A ER TILDELT ENHET !D.^P' > IFDEF V30SWE < TLS00, TEXT '^P&TRYCK P\E N\DSTA BILD FVR MER INFORMATION' /A008 TLS1, TEXT '^P&FVR ATT \ETERG\E TILL MENYN FVR FAST SKIVMINNE, TRYCK P\E RETUR' *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '&FVR ATT \ETERG\E TILL HUVUDMENYN, ANV\DND GULD MENY' PMA, TEXT '^P&SKRIV NR P\E ENHET D\DR DU VILL TA BORT TILLDELN. OCH TRYCK P\E RETUR^P' PRTDMB, TEXT '^P!E&VOLYMNAMN ^A \DR NU TILLDELAT ENHET !D^P' /C008 PRTDMC, TEXT '&\DR DETTA DEN VOLYM D\DR DU VILL TA BORT TILLDELNING (J ELLER N)^P' /C008 PRTDME, TEXT '^P!E&TILLDELNINGEN FVR VOLYM ^A HAR TAGITS BORT FR\EN ENHET !D.^P' / MOUNT MESSAGES PRC,TEXT '^P!L&SKRIV NUMRET P\E DEN ENHET DU VILL TILLDELA OCH TRYCK P\E RETUR' /C008 PRTMVB, TEXT '^P!L&SKRIV NAMET P\E DEN VOLYM DU VILL TILLDELA ENHET !D' /C008 *.-1 / CONTINUATION OF PRTMVB /A008 TEXT '^POCH TRYCK P\E RETUR^P' /A008 IFDEF PASSWD < PRTMVC, TEXT '^P!E&SKRIV L\DS LVSENORD OCH TRYCK P\E RETUR^P' /C008 PRTMVD, TEXT '^P!E&SKRIV SKRIV LVSENORD OCH TRYCK P\E RETUR^P' > / END IFDEF PASSWD PRTMVE, TEXT '^P!E&VOLYMNAMNET ^A \DR TILLDELAT ENHET !D.^P' > IFDEF DUTCH < TLS00, TEXT '^P&DRUK OP !&VOLG !&BEELD VOR VERVOLG.^P' /A008 TLS1, TEXT '^P!&RETURN OM TERUG TE GAAN NAAR HET MENU.' /C008 *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '&GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFMENU.' PMA, TEXT '^P&TYP HET NUMMER VAN DE TE ANNULEREN TOEWIJZING EN DRUK !&RETURN.^P' PRTDMB, TEXT '^P!E !D VERWIJST NU NAAR GEBIED ^A^P' /C008 PRTDMC, TEXT '&WEET U ZEKER DAT U DE TOEWIJZING WILT ANNULEREN (&JA/&NEE).^P'/C008 PRTDME, TEXT '^P!E&NAAM ^A TOEGEWEZEN AAN GEBIED !D.^P' / MOUNT MESSAGES PRC, TEXT '^P!L&TYP NUMMER VAN TOE TE WIJZEN GEBIED EN DRUK OP !&RETURN.^P'/C008 PRTMVB, TEXT '^P!L&TYP NAAM TOE TE WIJZEN GEBIED EN DRUK OP !&RETURN' /C008 IFDEF PASSWD < PRTMVC, TEXT '^P!E&TYP WACHTWOORD VOOR !&LEZEN EN DRUK OP !&RETURN .^P' /C008 PRTMVD, TEXT '^P!E&TYP WACHTWOORD VOOR !&SCHRIJVEN EN DRUK OP !RETURN.^P' > / END IFDEF PASSWD PRTMVE, TEXT '^P!E&NAAM ^A TOEGEWEZEN AAN GEBIED !D.^P' > IFDEF SPANISH < TLS00, TEXT '^P&PULSE !&PROX !&PANTALLA PARA M\AS INFO.,^P!&O ' /A008 TLS1, TEXT '^P&PULSE !&RETORNO PARA VOLVER AL &MEN\Z DE VOLUMEN DE DISCO DURO , '/C008 *.-1 /A008 TEXT '^P^S^P' / CONTINUATION OF TLS1 /A008 TXTLS2, TEXT '!&O &PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINC.' PMA, TEXT '^P&TECLEE EL N\ZMERO DE DISPOSITIVO QUE DESEA DESASIGNAR ' *.-1 TEXT 'Y PULSE !&RETORNO^P' PRTDMB, TEXT '^P!E&EL NOMBRE DE VOLUMEN ^A AHORA EST\A' *.-1 TEXT ' ASIGNADO AL &DISPOSITIVO !D^P' /C008 PRTDMC, TEXT '&ES ESTE EL VOLUMEN QUE DESEA DESASIGNAR? (&S O &N)^P' /C008 PRTDME, TEXT '^P!E&SE HA DESASIGNADO EL VOLUMEN ^A DEL &DISPOSITIVO !D.^P' / MOUNT MESSAGES PRC, TEXT '^P!L&TECLEE EL N\ZMERO DE DISPOSITIVO QUE DESEA ASIGNAR Y PULSE ' /C008 *.-1 /A008 TEXT 'RETORNO.^P' / CONTINUATION OF PRC /A008 PRTMVB, TEXT '^P!L&TECLEE EL NOMBRE DEL VOLUMEN QUE DESEA ASIGNAR AL' /C008 *.-1 / CONTINUATION OF PRTMVB /A008 TEXT ' DISPOSITIVO !D ^PY &PULSE !&RETORNO.^P' /A008 IFDEF PASSWD < PRTMVC, PRTMVD, TEXT '^P!E&TECLEE LA CLAVE DE LECTURA/ESCRITURA Y PULSE !&RETORNO.^P' > / END IFDEF PASSWD PRTMVE, TEXT '^P!E&EL NOMBRE DE VOLUMEN ^A ASIGNADO AL DISPOSITIVO !D.^P' > / TEXT ERROR MESSAGES IFDEF ENGLSH < /D008 PRTER1, TEXT '^P^A IS AN ILLEGAL DEVICE NUMBER' /C003 PRTER2, TEXT '^P!E IS NOT ASSIGNED TO A VOLUME. &PRESS !&RETURN' /A008 /D008 PRTER3, TEXT '^P!E^A IS AN ILLEGAL ENTRY. &PLEASE TYPE &Y OR &N.' PRTER4, TEXT '^P&DISK &ERROR. &PLEASE TRY AGAIN.' PRTER5, TEXT '^P!E &DEVICE ^A ALREADY ASSIGNED. &PRESS !&RETURN' /C008 PRTER6, TEXT '^P!E &VOLUME ^A ALREADY ASSIGNED. &PRESS !&RETURN' /C008 PRTER7, TEXT '^P!E &READ/WRITE PASSWORD ERROR. &PRESS !&RETURN' PRTER8, TEXT '^P!E ^A NOT A VOLUME NAME. &PRESS !&RETURN' /C008 PRTER9, TEXT '^P!E &VOLUME ^A IS NOT A &W&P&S-8 VOLUME. &PRESS !&RETURN'/C008 /D008 PRTERA, TEXT '^P !&ERROR ON INPUT..TOO MANY CHARACTERS.' PRTERA, TEXT '^P &CHOOSE 1-7. &PRESS !&RETURN' /A008 > IFDEF ITALIAN < /D008 PRTER1, TEXT '^P^A IS AN ILLEGAL DEVICE NUMBER' /C003 PRTER2, TEXT '^P!E NON DEFINITA. &PREMERE !&RITORNO' /A008 /D008 PRTER3, TEXT '^P!E^A IS AN ILLEGAL ENTRY. &PLEASE TYPE &Y OR &N.' PRTER4, TEXT '^P&ERRORE SU DISCO. &PROVARE ANCORA.' PRTER5, TEXT '^P!E &UNIT\@ ^A GI\@ DEFINITA. &PREMERE !&RITORNO' /C008 PRTER6, TEXT '^P!E &ARCHIVIO DOCUMENTI ^A GI\@ DEFINITO. &PREMERE !&RITORNO' /C008 PRTER7, TEXT '^P!E &ERRORE IN PAROLA CHIAVE. &PREMERE !&RITORNO' PRTER8, TEXT '^P!E ^A NON \H UN NOME DI UN ARCHIVIO. &PREMERE !&RITORNO'/C008 PRTER9, TEXT '^P!E &ARCHIVIO DOCUMENTI ^A NON \H DI TIPO &W&P&S-8. &PREMERE !&RITORNO'/C008 /D008 PRTERA, TEXT '^P !&ERROR ON INPUT..TOO MANY CHARACTERS.' PRTERA, TEXT '^P &SCEGLIERE 1-7. &PREMERE !&RITORNO' /A008 > IFDEF V30NOR < /D008 PRTER1, TEXT '^P^A IS AN ILLEGAL DEVICE NUMBER' /C003 PRTER2, TEXT '^P!E ER IKKE TILDELT ET OMR\EDE.&^S' /A008 /D008 PRTER3, TEXT '^P!E^A IS AN ILLEGAL ENTRY. &PLEASE TYPE &Y OR &N.' PRTER4, TEXT '^P&DISK-FEIL. &PR\XV IGJEN.^S' PRTER5, TEXT '^P!E &ENHET ^A ER ALLEREDE TILDELT. &^S' /C008 PRTER6, TEXT '^P!E &OMR\EDE ^A ER ALLEREDE TILDELT. &^S'/C008 PRTER7, TEXT '^P!E &FEIL I PASSORD . &^S' PRTER8, TEXT '^P!E ^A ER IKKE ET OMR\EDE-NAVN. &^S' /C008 PRTER9, TEXT '^P!E &OMR\EDE ^A ER IKKE ET !&WPS-8-OMR\EDE. &^S'/C008 /D008 PRTERA, TEXT '^P !&ERROR ON INPUT..TOO MANY CHARACTERS.' PRTERA, TEXT '^P &VELG 1-7. &^S' /A008 PRTRYK, TEXT 'TRYKK P\E !&RETUR' > IFDEF V30SWE < /D008 PRTER1, TEXT '^P^A IS AN ILLEGAL DEVICE NUMBER' /C003 PRTER2, TEXT '^P!E \OR INTE TILLDELAT EN VOLYM. &^S' /A008 /D008 PRTER3, TEXT '^P!E^A IS AN ILLEGAL ENTRY. &PLEASE TYPE &Y OR &N.' PRTER4, TEXT '^P&FEL P\E MINNE - &FVRSVK IGEN!' PRTER5, TEXT '^P!E &ENHET ^A \DR REDAN TILLDELAD. &^S' /C008 PRTER6, TEXT '^P!E &VOLYM ^A \DR REDAN TILLDELAD. &^S' /C008 PRTER7, TEXT '^P!E &L\DS/SKRIV-FEL FVR LVSENORD. &^S' PRTER8, TEXT '^P!E ^A \DR INTE ETT VOLYMNAMN. &^S' /C008 PRTER9, TEXT '^P!E &VOLYMEN ^A \DR INTE EN "&W&P&S-8"-VOLYM. &^S'/C008 /D008 PRTERA, TEXT '^P !&ERROR ON INPUT..TOO MANY CHARACTERS.' PRTERA, TEXT '^P &V\DLJ 1-7. &^S' /A008 PRTRYK, TEXT 'TRYCK P\E RETUR' > IFDEF DUTCH < PRTER2, TEXT '^P!E IS NIET TOEGEWEZEN AAN EEN GEBIED. DRUK OP !&RETURN.'/A008 PRTER4, TEXT '^P&SCHIJFFOUT &PROBEER OPNIEUW.' PRTER5, TEXT '^P!E &GEBIED ^A IS AL TOEGEWEZEN. &DRUK OP !&RETURN' /C008 PRTER6, TEXT '^P!E &GEBIED ^A IS AL TOEGEWEZEN. &DRUK OP !&RETURN' /C008 PRTER7, TEXT '^P!E &WACHTWOORD ONJUIST.&DRUK OP !&RETURN.' PRTER8, TEXT '^P!E ^A IS GEEN GEBIEDSNAAM. &DRUK OP !&RETURN.' /C008 PRTER9, TEXT '^P!E &GEBIED ^A IS GEEN &W&P&S-8 GEBIED. &DRUK OP !&RETURN'/C008 PRTERA, TEXT '^P &KIES 1-7. &DRUK OP !&RETURN' /A008 > IFDEF SPANISH < PRTER2, TEXT '^P!E NO SE HA ASIGNADO AL VOLUMEN. ^S' /A008 PRTER4, TEXT '^P&ERROR DE DOSCO. &INT\INTELO OTRA VEZ.' PRTER5, TEXT '^P!E &EL DISPOSITIVO ^A YA EST\A ASIGNADO. ^S' /C008 PRTER6, TEXT '^P!E &EL VOLUMEN ^A YA EST\A ASIGNADO.^S' /C008 PRTER7, TEXT '^P!E &ERROR DE CLAVE . ^S' PRTER8, TEXT '^P!E ^A NO UN NOMBRE DE VOLUMEN. ^S' /C008 PRTER9, TEXT '^P!E &EL VOLUMEN ^A NO ES UN VOLUMEN &W&P&S-8. ^S'/C008 PRTERA, TEXT '^P &SELECCIONE 1-7. ^S' /A008 PULSE, TEXT '&PULSE !&RETORNO' > /D008 TEXTG1, TEXT '^P^S^P' / GENERAL 1 SUBSTRING CONTROL STRING PSCR, TEXT '^P!E' / CLEAR SCREEN / BUFFER AREAS MVLCHQ, -107 / -NUM CHARS +1 MVLCHR, 0 / LAST CHAR ENTERED PRVTBL, 0 ZBLOCK 105 0 / TERMINATOR DECIMAL VOLSAR, ZBLOCK 9 / STORED VOL NAME IN ASCII VOLTB2, 0 / MOUNTED VOLUME BLOCK BUFFER ZBLOCK 193 / 8 VOLS * 24 WORDS PER VOL VLEND2, 0 / END 2 VOLTBL, 0 / VOLUME DIR TABLE ZBLOCK 1440 /60 VOLS * 24 WORDS PER VOL VLTBLE, 0 / END ALL OCTAL PTLN50, ZBLOCK 31 / ARRAY FOR "SYSTEM MODIFIED STARTUP" TEXT/A008 VOLEND=. /   / WPSC.PA - DECSPELL STARTUP CODE / / ******* EDIT HISTORY ******* / / 013 EMcD 29-Sep-85 Add Dutch- Spanish Xlations / 012 RCME 22-May-85 Enable use of multinational characters in the / personal dictionary. / / ---------------- All below refer to V2.0 and earlier ------------------- / / 011 WJY 22-OCT-84 Put OpeN FILe flag into MQ & pass control / off to WPSPEL to check & report file open / error (WPSV2-240). / 010 WJY 11-OCT-84 Give error message if drive specified for / utility and/or dictionary disk is already / in use (WPSV2-225). / 009 WJY 09-AUG-84 Return to main menu when the SPELL overlay / INITSP is unable to open the file. / 008 WJY 02-AUG-84 Support "Update personal dictionary ..." / 007 WJY 29-JUN-84 Fix mixed screen on "Loading ...." screen. / 006 BC 4-JUN-84 Modify FILLIO to do writes as well as reads. / 005 WJY 26-MAY-84 XPU support & American/British on same Utility dsk / 004 WCE 23-APR-84 ELIMINATED SECOND QURX ROUTINE IN FIELD TWO / 003 WCE 12-APR-84 REMOVED NECESSITY FOR MENU INTERPERTER BY / ADDING ONCE ONLY MENU MODULE FOR FIELD FOUR / 002 WCE 26-MAR-84 CHANGE DISK NAME FROM DECSPL TO WPSUTL / 001 GDH/EH AUG/SEP-83 Initial version / /*************************************************************************** /**** WRITE OUT CODE FOR WPSC **** /*************************************************************************** FIELD 0 / FIELD WHERE RXHAN IS LOCATED *200 / START ADDRESS USED BY OS8 "GO" COMMAND JMP I .+3 / LOCATION USED TO START UP RXHAN JMP I .+1 / LOCATION USED TO RETURN TO OS8 MONITOR 7605 / ADDRESS OF OS8 MONITOR RETURN POINT RXLOAD / ADDRESS OF START LOCATION FOR RXHAN *RXLDLS / ADDRESS WITHIN RXHAN TO OVERLAY RXEWT / WRITE FUNCTION CODE 0 RXQBLK / ADDRESS OF QUEUE BLOCK TO USE . / ADDRESS OF TABLE OF DISK COMMANDS IFNDEF DECDEV < DLOSPI;SPINIT;CDF 10;-DSOSPI / Write-out spell check init code. DLOSPS;SPSTAT;CDF 10;-DSOSPS / Write-out spell check status line stuff. DLOSPM;SPMENU;CDF 10;-DSOSPM / Write-out spell check menu routine > IFDEF DECDEV < DLOSPI;SPINIT;CDF 50;-DSOSPI / Write-out spell check init code. DLOSPS;SPSTAT;CDF 50;-DSOSPS / Write-out spell check status line stuff. DLOSPM;SPMENU;CDF 50;-DSOSPM / Write-out spell check menu routine > DLSPHL;SPHOLE;CDF 60;-DSSPHL / Write-out spell hole code /a012 0 / END OF LIST INDICATOR IFNDEF DECDEV < FIELD 1 / This is the auxillary field. > IFDEF DECDEV < FIELD 5 > / Note that the editor loads into 6400-7777 of this field and that several / editor routines use some of the globaly defined temps (X0, X1, X2, T1, etc.) IFNDEF OVLAY1 / for 1st pass only. OVLAY1 is defined in WPEDIT IFNDEF OVLAYM / for 1st pass only. OVLAYM is defined in WPEDIT *SWPBEG / Start assembling code at the begining of the SWAP area. / That is where the code will eventually load / at run-time (in field 2). CDFMYF=CDFMNU / A CDF to current field. SPSTAT=. DSKBLK= .-3000%400+DLOSPS / DISK BLOCK WHERE PAGE IS LOADED /*************************************************************************** /**** TRANSFER VECTOR ENTRY POINTS FOR EDITOR SWAP AREA ROUTINES **** /*************************************************************************** CALLN1, XX / ENTRY POINT FOR ROUTINE NUMBER 1 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD JMS UPDTSC / GO UPDATE STATUS LINE (SCREEN) INFO. JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN2, XX / ENTRY POINT FOR ROUTINE NUMBER 2 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / GO CHECK FOR STATUS VALUE CHANGES JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN3, XX / ENTRY POINT FOR ROUTINE NUMBER 3 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / GO HANDLE SCROLL DOWN EVENT JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN4, XX / ENTRY POINT FOR ROUTINE NUMBER 4 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / GO HANDLE SCROLL UP EVENT JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN5, XX / ENTRY POINT FOR ROUTINE NUMBER 5 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN6, XX / ENTRY POINT FOR ROUTINE NUMBER 6 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN7, XX / ENTRY POINT FOR ROUTINE NUMBER 7 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN8, XX / ENTRY POINT FOR ROUTINE NUMBER 8 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE CALLN9, XX / ENTRY POINT FOR ROUTINE NUMBER 9 JMS CALSUB / SET UP RETURN ADDRESS AND RETURN FIELD NOP / PLACE FOR TRANSFER TO SPECIAL CODE JMP CALXIT / GO TO RETURN TO CALLER CODE /*************************************************************************** /**** SET UP RETURN FIELD AND ADDRESS FOR CALLN# ROUTINES **** /*************************************************************************** CALSUB, XX / ROUTINE TO SET UP RETURN FIELD AND ADDRESS DCA T1 / SAVE CONTENTS OF ACCUMULATOR RDF / READ CALLERS DATA FIELD TAD CIDF0 / MAKE CDF-CIF INSTRUCTION BACK TO CALLER DCA CALXIT / STORE FOR RETURN TO CALLER CDFMNU / SET DATA FIELD BACK TO MY FIELD AC7776 / SET UP TO SUBTRACT A VALUE OF TWO TAD CALSUB / MAKE POINTER TO VECTOR ENTRY POINT DCA T2 / STORE FOR USE IN AN INDIRECT LOOKUP TAD I T2 / PICK UP CALLERS RETURN ADDRESS DCA CALRTN / STORE ADDRESS FOR LATER RETURN TO CALLER JMP I CALSUB / GO TRANSFER TO SPECIALIZED ROUTINES CALXIT, XX / LOCATION FOR CDF-CIF INSTRUCTION TO CALLER JMP I CALRTN / RETURN BACK TO CALLER CALRTN, XX / LOCATION FOR CALLERS RETURN ADDRESS /*************************************************************************** /**** THE CODE ASSEMBLED HERE IS USED BY THE EDITOR FOR STATUS LINE **** /*************************************************************************** / UPDTSC ROUTINE IS USED TO DISPLAY THE STATUS LINE INFORMATION IN THE EDITOR / / THE STATUS LINE AREA CONSISTS OF TWO LINES AS FOLLOWS: / LINE 1 = TOP LINE OF SCREEN - CURRENT PAGE NUMBER, CURRENT LINE NUMBER, / DRIVE NUMBER, DOCUMENT NUMBER AND DOCUMENT NAME BEING EDITED / LINE 24 = CURRENT RULER IN EFFECT FOR EDITING / / UPON ENTRY, THE VALUE CONTAINED IN THE T1 DETERMINES FUNCTION AS FOLLOWS: / / T1 = 0 CLEAR THE SCREEN AND DISPLAY COMPLETE STATUS AREA / DEFINE SCROLLING REGION AND SET RELITIVE SCREEN ADDRESSING / T1 = 1 UPDATE DISPLAY OF TOP STATUS LINE ONLY / T1 = 2 UPDATE DISPLAY OF BOTTOM STATUS LINE ONLY (DISPLAY RULER) / T1 = 3 CLEAR THE SCREEN AND RESET SCROLLING AREA TO FULL SCREEN UPDTSC, XX / Entry point. TAD T1 / PICK UP SAVED CONTENTS OF T1CUMULATOR TAD LITSC1 / Index into dispatch table. DCA .+1;XX / Go dispatch to routine to handle request. LITSC1, JMP I UPDTDS / Jmp thru dispatch table. UPDTDS, UPDT00 / Case 0. UPDT01 / Case 1. UPDT02 / Case 2. UPDT03 / and Case 3. UPDT00, CIFSPL / Map speller field. JMS I (SCRNIN) / Call screen initialization routine. UPDT01, UPDT02, JMP I UPDTSC / Return to caller. UPDT03, JMS I IOACAL / Clear the screen & region area. 0 / .... SCSTS1 / All the esc sequences to do it. JMP I UPDTSC / Return to caller. SYPRMP, XX / Prompt for system diskette. SYPRM1, JMS I IOACAL / ... 0 / Display to the screen. SYDISK / Replace the system diskette, etc. 0000 / Cursor Home address. 1505 / Error message address. 2305 / posn of 2nd part of prompt. JMP SYPAP2 / Merge below. SYPAP1, CIFSYS / JWAIT for a bit. JWAIT / ... SYPAP2, CIFSYS / Get an input character. XLTIN / ... JMP SYPAP1 / Loop & wait if none. TAD (-EDNWLN) / Return typed? SZA CLA / Skip if yes. Otherwise repeat error. JMP SYPRM1 / Repeat the message. CDIEDT / Return CIF CDF instruction to EDIT field. JMP I SYPRMP / Return to caller. SYDISK, IFDEF ENGLSH < TEXT '^P!E^CG^P&REPLACE THE SYSTEM DISKETTE IN DRIVE 0^P&AND &PRESS !&RETURN' > IFDEF ITALIAN < TEXT /^P!E^CG^P&INTORODURRE IL DISCO SISTEMA NELL'UNIT\@ 0 / *.-1 TEXT /^P&E PREMERE RITORNO/ > IFDEF DUTCH < TEXT '^P!E^CG^P&ZET DE SYSDISKETTE WEER IN AANDRIJVER 0 ' *.-1 TEXT /^P&^P EN DRUK OP !&RETURN' > IFDEF SPANISH < TEXT '^P!E^CG^P&CAMBIE EL DISKETTE SISTEMA EN LA UNIDAD 0^P&Y ' *.-1 TEXT 'PULSE !&RETORNO'> X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE DSKBLK= .-3000%400+DLOSPS / DISK BLOCK WHERE PAGE IS LOADED /FILLIO -- fills queue block with I/O parameters & then does I/O. / /CALL: JMS FILLIO / FUNCTION code /M006 / CDF to buffer field. / ADDRESS to read/write to/from. / -# of disk blocks to read/write. / START block #. / Rtn1: Return here if I/O error. / Rtn2: Normal completion return. / FILLIO, XX / Entry point. TAD I FILLIO / Get FUNCTION code. /A006 DCA FILLFN / Store in line. /A006 ISZ FILLIO / Bump to CDF. /A006 TAD I FILLIO / Get CDF to buffer. DCA CMDBLK+RXQBFD / Set into queue block. /M004 ISZ FILLIO / Bump to read/write address. TAD I FILLIO / Get read/write address. DCA CMDBLK+RXQBAD / Set into queue block. /M004 ISZ FILLIO / Bump to size (in blocks). TAD I FILLIO / Get minus number of blocks to read/write. DCA CMDBLK+RXQRS1 / Set into queue block. /M004 ISZ FILLIO / Bump to startint block #. RDF / Get return field. TAD CIDF0 / Convert into a return CIF CDF. DCA FILXIT / Save for final return. TAD I FILLIO / Get starting block #. ISZ FILLIO / Bump to return address. CDFMYF / Map current field. JMS RDFIO / Go do the read/write. FILLFN, 0 / ... /M006 SMA CLA / Skip if error returned. ISZ FILLIO / For normal return, bump address. FILXIT, XX / Return CIF CDF goes here. JMP I FILLIO / Return to caller. RDFIO, XX DCA CMDBLK+RXQBLK / STORE BLOCK NUMBER /M004 RDF / Get field of caller. TAD CIDF0 / Make a return CIF CDF. DCA RDFXIT / and save for the exit. TAD I RDFIO / ++++ CDFMYF / Now map our field. DCA CMDBLK+RXQFNC / AND FUNCTION CODE /M004 ISZ RDFIO JMS CMDQUX / USE SYSTEM QURX ROUTINE FOR CALL /A004 RDFXIT, XX / CIF CDF to return field goes here. JMP I RDFIO / ELSE RETURN STATUS / The code immediately below is called by the startup code. This code decides / whether or not the SC disk need to be loaded. This code runs in field 2. / CHKSC, XX / Entry point. TAD I (OLL301) / See if FIELD 5 need be re-loaded. /M005 TAD (-OLL301) / Check currently loaded OLAY block. /M005 SZA / Skip if no. /M005 DCA LOADSC / Set flag if yes. SC needs to be loaded./M005 TAD I (OLL400) / Now check FIELD 6. /M005 TAD (-OLL301) / ... /M005 SZA / Skip if no. /M005 DCA LOADSC / Set flag if yes. SC needs to be loaded./M005 TAD I (MUBUF+MNFMAT) / Get format word /A005 AND (MNFM3X) / Mask off "British dictionary in use" bit/A005 SNA CLA / Skip if British /A005 AC0001 / AC=1 if American /A005 TAD (-2) / AC=-2 if British else AC=-1 /A005 DCA T1 / & save for later /A005 TAD I (MUBUF+MNPULD) / Get APU/XPU loaded word /A005 AND (MNRX0X+MNRX1X) / Mask off American & British loaded bits/A005 / =0 if nothing loaded /A005 / =1 if American loaded /A005 / =2 if British loaded /A005 TAD T1 / Add back dictionary in use value /A005 SNA / Skip if nothing or wrong one loaded /A005 JMP NOLOAD / Else JMP, spell disk isn't needed /A005 DCA LOADSC / Set flag. SC needs to be loaded /A005 TAD (MNRX0X+MNRX1X) / Get American & British loaded bits /A005 CMA / Complement to form clearing mask /A005 AND I (MUBUF+MNPULD) / & clear them in the APU/XPU loaded wd /A005 DCA I (MUBUF+MNPULD) / & save the new APU/XPU loaded word /A005 NOLOAD, TAD LOADSC / Do we need to (re)load the spell disk /A005 SZA CLA / Skip if not /A005 ISZ CHKSC / Take bump return to (re)load the spell disk./M005 CDIEDT / Back to caller. JMP I CHKSC / ... LOADSC, 0 / Set if (re)load of spell disk is needed/A005 SCSTS1, TEXT '![[?6L![[2&J![[R' / ESCAPE SEQUENCES DESCRIBED BELOW /M004 / ESC [ ? 6 l / Set absolute mode. / ESC [ 2 J / Erase entire screen. / ESC [ r / Clear scrolling region. X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE SPINIT=. CDFMYF=CDFEDT / This code loads in the editor field. RELOC RELOC OVLAY1 / This code will load in editor from 7400-7777. DSKBLK= .-7400%400+DLOSPI / DISK BLOCK WHERE PAGE IS LOADED STRTUP, XX / Do initialization stuff. CDIMNU / Map MENU field. TAD I (MUBUF+MNOPTC) / Get options word. DCA OPTNWD / save it aside. TAD OPTNWD / Save it for editing w/o MABIT. AND (-1-MABIT) / Isolate all but MABIT. DCA I (MUBUF+MNOPTC) / ... /d008 TAD (-7) / Get a minus 7. /A006 TAD I (MUBUF+MNTMP6) / Pick up operation code from menu field DCA SAVET6 / SAVET6 IS USED AS A THREE WAY SWITCH /A006 / MINUS VALUE = SPELLING CORRECTOR /A006 / ZERO VALUE = LOAD USER DICTIONARY /A006 / PLUS VALUE = POST PROCESSING /A006 CDFMYF / Map data field back to our field. TAD (DLOSPS) / Load Spell-Check status line stuff. PGSWAP / ... CIFMNU / Map menu field, where FILLIO resides. JMS I (FILLIO) / Load ROOT-EDITOR Swap Area Code RXERD+4000 / Function /A006 CDFMNU / field two. SWPBEG+1400 / load address offset by three blocks. -DSSTAT+3 / size in blocks. DLSTAT+3 / start block #. JMP MYEXIT / If I/O error, abort. CIFMNU / Map menu field, where FILLIO resides. JMS I (FILLIO) / Load Spell-Check menu text module RXERD+4000 / Function /A006 CDFBUF / field. SPLMNU / load address. -DSOSPM / size in blocks. DLOSPM / start block #. JMP MYEXIT / If I/O error, abort. JMS MOV100 / Go copy 100 locations from MENU field CDFBUF / to field four JMS GTDKID / Get system disk id. SYSID-1 / ... TAD SAVET6 / Check for Post Processor Operation /M006 TAD (-12) /A008 SNA CLA / Is this post processing ? /M006 /M008 JMP UTLOAD / YES, skip test of APU loading CDIMNU / Map menu field. JMS I (CHKSC) / See if SC diskette needs to be loaded. JMP NOSC / JMP if no. We are currently loaded. UTLOAD, AC0001 / INDICATE UTILITY DISK REQUIRED UTLDER, CDIBUF / SWITCH TO BUFFER FIELD JMS GETDRV / ASK USER FOR DRIVE NUMBER AND VALIDATE IT JMP STRTGM / USER OPTED FOR GOLD MENU RETURN TAD SAVET6 / Check for Post Processor Operation /M006 TAD (-12) /A008 SZA CLA / Is this post processing ? /M006 /M008 JMP SCLOAD / NO, go load spelling corrector code PPLOAD, CIFMNU / Call routine down in menu field. JMS I (FILLIO) / Fill queue block parameters. RXERD+4000 / Function /A006 CDFSPL / Field. 100 / load address. -DSOFFF / Size in blocks. DLOFFF / Starting block #. JMP UTLDER / Report missing sc disk error. JMS MOV100 / Go copy 100 locations from MENU field CDFSPL / to field six JMP NODD / Go continue with main loop SCLOAD, CIFMNU / Call routine down in menu field. JMS I (FILLIO) / Fill queue block parameters. RXERD+4000 / Function /A006 CDFSPL / Field. 100 / load address. -DSOSPL / Size in blocks. DLOSPL / Starting block #. JMP UTLDER / Report missing sc disk error. JMS MOV100 / Go copy 100 locations from MENU field CDFSPL / to field six CIFMNU / Call routine down in menu field. JMS I (FILLIO) / Now read field 5 stuff. RXERD+4000 / Function /A006 CDFTXT / ... 200 / Load address. -DSOSPX / size in blocks. DLOSPX / Starting block #. JMP UTLDER / Report missing sc disk error. CIFTXT / Map field 5 code. JMS I (CHKAPU) / Do APU initialization. JMP STRTGM / Return if APU init failure. NOSC, CIFSPL / Map spelling field. JMS I (LODAPU) / Load the APU. TAD SAVET6 / See if operation is SC (6) /M006 TAD (-6) /A008 SZA CLA / If this is SC then dictionary required/M006 JMP NODD / Not SC, DD is not required. DDLOAD, CDFMNU / Map to MENU field. /A005 TAD I (MUBUF+MNFMAT) / Get format word. /A005 AND (MNFM3X) / Mask off "British dictionary" bit /A005 SZA CLA / Skip if AMERICAN dictionary in use /A005 AC0001 / INDICATE BRITISH DICTIONARY REQUIRED /A005 TAD (2) / INDICATE AMERICAN DICTIONARY REQUIRED /A005 CDIBUF / SWITCH TO BUFFER FIELD JMS GETDRV / ASK USER FOR DRIVE NUMBER AND VALIDATE IT JMP STRTGM / USER OPTED FOR GOLD MENU RETURN NODD, JMS INITSP / Go execute Spelling Checker editor initialization. TAD OPNFIL / See if file was opened. /A009 /d011 SNA CLA / Skip if it was /A009 /d011 JMP STRTGM / else just clean up & exit /A009 MQL / Leave file open flag in MQ register /A011 CIFSPL / Map spell field. JMS I (SPELL) / Start up the spell checker. STRTGM, JMS CHKID / Make sure original system diskette is installed. MYEXIT, AC7777 / Restore Menu field stuff. CIFMNU / ... PGSWAP / .... CDIMNU / Return CDI instruction to MENU field JMP I STRTUP / Return to caller. OPTNWD, 0 / Location for MNOPTC word during spell check. SAVET6, 0 / Location for value of MNTMP6 operation word. / *** SAVET6 = (MNTMP6) - 7 *** /A006 / SAVET6 IS USED AS A THREE WAY SWITCH /A006 / MINUS VALUE = SPELLING CORRECTOR /A006 / ZERO VALUE = LOAD USER DICTIONARY /A006 / PLUS VALUE = POST PROCESSING /A006 X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE DSKBLK= .-7400%400+DLOSPI / DISK BLOCK WHERE PAGE IS LOADED /*********************************************************************** / CHKID - MAKE SURE ORIGINAL SYSTEM DISKETTE IS INSTALLED BEFORE / RETURN TO MAIN MENU. / / WHEN WPSPEL IS CALLED, THE NAME AND DISK "RANDOM" ID ARE READ INTO / SYSID0-3. BEFORE WPSPEL IS EXITED, THE NAME AND "RANDOM" ID FOR THE / DISK IN DRIVE 0 ARE READ INTO SYSID4-7. THIS ROUTINE CHECKS TO MAKE / SURE THAT BOTH BLOCKS MATCH / / IF NO MATCH IS FOUND, THE OPERATOR IS ASKED TO INSERT THE ORIGINAL SYSTEM / DISKETTE. THE ROUTINE IS NOT EXITED UNTIL THE NAME AND "RANDOM" ID MATCH / /*********************************************************************** CHKID, XX / CHECK ORIGINAL SYSTEM DISKETTE TAD OPTNWD / Get original option word. CDFMNU / Map MENU field. DCA I (MUBUF+MNOPTC) / Restore it. CDFMYF / Back to our field. TAD OPNFIL / Did we open the file? SZA CLA / Skip if no. nothing to close. JMS CLOSEF / Call close file routine. JMS GTDKID / Go read current drive diskette name & ID. CHKID0, SYSID+4-1 / ... TAD (-4 / DCA T1 / SET UP COUNTER TAD (SYSID-1 / DCA X1 / SET UP SOURCE INDEX TAD CHKID0 / = (SYSID+4-1 /M006 DCA X2 / SET UP COMPARE INDEX CHKIDL, TAD I X1 / READ OLD WORD CIA / TAD I X2 / COMPARE WITH NEW WORD SZA CLA / JMP GTDKER / NO, GO ASK FOR ORIGINAL SYSTEM DISKETTE ISZ T1 / SEE IF LAST WORD JMP CHKIDL / NO, LOOP BACK JMP I CHKID / RETURN TO CALLER MOV100, XX / INITIALIZE PAGE ZERO LOCATIONS TAD I MOV100 / PICK UP FIELD TO MOVE TOO DCA MOV10F / STORE CHANGE FIELD INSTRUCTION ISZ MOV100 / BUMP RETURN ADDRESS OVER FIELD INSTRUCTION JMS CPYBUF / Copy locations 0-77 to memory field X -100 / 100 locations CDFMNU / from MENU field 0000-1 / location 0, MOV10F, XX / to field X, 0000-1 / location 0. JMP I MOV100 / RETURN TO CALLER /*********************************************************************** / / GTDKID GETS THE DISK ID OF THE SYSTEM DISK / THE ID IS THE THREE NAME WORDS AND THE "RANDOM" WORD / IT IS USED TO INSURE THAT THE SAME SYSTEM DISK IS REINSERTED / IN CASES WHERE IT MUST BE REMOVED. / /*********************************************************************** GTDKID, XX TAD I GTDKID / Get buffer address to copy NAME & ID into. ISZ GTDKID / Bump to return address. DCA GTDKIA / save buffer address. GTDK1, CDIMNU / Get density of drive 0. DCA I (CMDBLK+RXQDRV) / Set the drive # to 0. /M004 CDFMYF / Back to our field & Call RDFIO in MENU field. JMS I (RDFIO) / Do a GET DENSITY to establish drive density. RXEDN+4000 / "GET DENSITY" code. SPA CLA / Skip if no error. JMP GTDKER / Error. Display "replace" msg. CIFMNU / Go read in the home block. JMS I (FILLIO) / ... RXERD+4000 / Function /A006 CDFTXT / Read home block into block buffer. BUFADR / buffer address. -1 / Size (1 block). DLDIR / Read the home block. JMP GTDKER / Error. Display "replace" msg. JMS CPYBUF -4 / Size CDFTXT / Source field. BUFADR+2-1 / Source Address CDFMYF / DESTINATION FIELD GTDKIA, XX / DESTINATION ADDRESS JMP I GTDKID / RETURN TO CALLER AFTER OBTAINING ID WORDS GTDKER, CDIMNU / Prompt user to insert the system diskette. JMS I (SYPRMP) / ... JMP GTDK1 / Go retry. SYSID, 0;0;0;0 / System disk ID. 0;0;0;0 / ID of diskette in drive 0 at exit time. X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE RELOC / RESET RELOCATION COUNTER CDFMYF= CDFBUF / DEFINE OUR FIELD AS FIELD FOUR. SPMENU= . / DEFINE OUR LOAD POINT. SPLMNU= 200 / DEFINE OUR RUN LOCATION. RELOC SPLMNU / RELOCATE TO WHERE CODE RUNS IN FIELD FOUR /*************************************************************************** /**** PAGE ZERO LOCATIONS IN FIELD FOUR **** /*************************************************************************** / SET COUNTER TO LOCATION 100 ON PAGE ZERO X= 100; SPLFUN= X / LOCATION FOR SPELL FUNCTION CODE X= X+1; SPLDRV= X / LOCATION FOR USER SPECIFIED DRIVE NUMBER X= X+1; SPLMAX= X / LOCATION FOR MAXIMUM DRIVE NUMBER X= X+1; SPLDOC= X / LOCATION FOR CURRENT DOCUMENT NUMBER X= X+1; SPLMS1= X / LOCATION FOR POINTER TO UTILITY/DICTIONARY TEXT X= X+1; SPLMS2= X / LOCATION FOR POINTER TO DRIVE - DRIVE/DEVICE TEXT X= X+1; SPLOPT= X / LOCATION FOR SYSTEM OPTION CONFIGURATION BITS X= X+1; SPLSDR= X / LOCATION FOR USER DRIVE SELECTION FOR SPELL X= X+1; REDFLG= X / LOCATION FOR READ ROUTINE DRIVE REQUEST FLAG X= X+1; REDDRV= X / LOCATION FOR READ ROUTINE DRIVE NUMBER X= X+1; REDNUM= X / LOCATION FOR READ ROUTINE CHARACTER COUNTER X= X+1; REDCHR= X / LOCATION FOR READ ROUTINE INPUT CHARACTER X= X+1; VALADD= X / LOCATION FOR VALIDATION TABLE POINTER ADDRESS X= X+1; SPLFNR= X / LOCATION FOR FOOTNOTE RESULT DOC DRIVE NUMBER /A010 X= X+1; SPLOPR= X / LOCATION FOR SPell OPeRation flag /A010 / 0 IF FOOTNOTING, NOT 0 IF DECSPELL /A010 DSKBLK= .-200%400+DLOSPM / DISK BLOCK WHERE PAGE IS LOADED / GETDRV IS CALLED BY THE EDITOR TO OBTAIN A VALID DRIVE NUMBER FOR THE / UTILITY DISK AND THE DICTIONARY DISK. IT CALLS SPLGET TO PROMPT THE / USER FOR THE DRIVE NUMBER AND THEN CHECKS TO SEE IF THE USER SUPPLIED / NUMBER IS A VALID DRIVE NUMBER WITH THE PROPER DISKETTE LOADED. / IF NOT, IT CALLS SPLGET TO REPORT THE ERROR. / / GETDRV IS CALLED AS FOLLOWS: / / CDIBUF / CHANGE TO BUFFER FIELD / JMS I GETDRV / CALL ROUTINE TO GET DRIVE NUMBER / JMP GOLDMN / GOLD MENU RETURN / .... / NORMAL RETURN / / UPON ENTRY, THE AC CONTAINS ONE OF THE FOLLOWING VALUES: / / AC = 0 ERROR CALL INDICATING AN ERROR DETECTED WHILE READING / AC = 1 REQUEST FOR WPS UTILITY DISKETTE / AC = 2 REQUEST FOR AMERICAN DICTIONARY DISKETTE / AC = 3 REQUEST FOR BRITISH DICTIONARY DISKETTE GETDRV, XX / ROUTINE TO GET DRIVE # VIA MENU. GETBAD, DCA SPLFUN / SAVE SPELL FUNCTION CODE CDIBUF / SWICH TO FIELD FOUR FOR MENU ROUTINE JMS SPLGET / GO PROMPT USER FOR DRIVE NUMBER JMP GETXIT / USER OPTED FOR GOLD:MENU RETURN. CIFMNU / MAP MENU FIELD. JMS FILLIO / FIRST, READ IN THE ALLOC BLOCK. RXERD+4000 / FUNCTION /A006 CDFTXT / USE THE BUFFER DEFINED IN TXT FIELD. BUFADR / BUFFER ADDRESS. -1 / 1 BLOCK. DLALOC / ALLOCATION BLOCK. JMP GETBAD / REPORT BAD DISKETTE. CDFTXT / MAP BUFFER TAD I (BUFADR+1) / SEE IF DOCUMENT DISKETTE. TAD (-40) / 40 MEANS DOCUMENT DISKETTE. SZA CLA / SKIP IF DOCUMENT DISKETTE. JMP GETBAD / REPORT VALIDATION ERROR. TAD I (BUFADR+2) / CHECK MAX NUMBER OF DOCUMENTS ALLOWED. SZA CLA / SKIP IF NONE. JMP GETBAD / REPORT VALIDATION ERROR. CDFMYF / BACK TO OUR FIELD. CIFMNU / MAP MENU FIELD JMS FILLIO / NOW READ THE HOME BLOCK. RXERD+4000 / FUNCTION /A006 CDFTXT / USE THE SAME 2 PAGES. BUFADR / ... -1 / 1 BLOCK. DLDIR / HOME BLOCK. JMP GETBAD / REPORT BAD DISKETTE. VALDAT, TAD VALADD / GET TABLE ADDRESS POINTER TO NAME DCA X0 / SAVE IN AUTO INDEX REGISTER AC7775 / SET UP TO COMPARE 3 WORDS. DCA T1 / STORE COUNT IN COUNTER TAD (BUFADR+2-1) / POINTER TO ACTUAL DOCUMENT NAME. DCA X1 / SAVE IN AUTO INDEX REGISTER VAL001, CDFMYF / SWITCH BACK TO THIS FIELD TAD I X0 / PICK UP PART OF DESIRED NAME. CIA / SEE IF IT'S SAME AS DOCUMENT NAME. CDFTXT / SWITCH TO TEXT FIELD BUFFER TAD I X1 / GET WORD OF ACTUAL DOCUMENT NAME. SZA CLA / SKIP IF THE SAME. JMP GETBAD / REPORT VALIDATION ERROR. ISZ T1 / BUMP COUNT OF WORDS TO COMPARE. JMP VAL001 / LOOP UNTIL DONE WITH WORDS TO COMPARE ISZ X1 / POINT TO DATE OF BUILD. ISZ X1 / ... X=BLDDY^100+BLDMO / COMPUTE EXPECTED DAY-MONTH VALUE. TAD (-X) / SEE IF DATE OF BUILD MATCHES DISKETTE. TAD I X1 / IF NOT THEN DISKETTE IS OF A DIFFERENT BUILD SZA CLA / AND THEREFORE IS TO BE REJECTED. JMP GETBAD / REJECT DISKETTE IF FROM A DIFFERENT BUILD. TAD (-BLDYR) / COMPARE YEAR OF BUILD TOO. TAD I X1 / THAT SHOULD MATCH AS WELL. SZA CLA / SKIP IF MATCH. JMP GETBAD / REJECT DISKETTE IF FROM A DIFFERENT BUILD. CDFMYF / SWITCH BACK TO THIS FIELD ISZ GETDRV / BUMP RETURN POINT PAST GOLD MENU RETURN TAD SPLMS1 / GET THE MESSAGE POINTER TO UTL OR DIC TAD (-SPLUTL) / SUBTRACT POINTER TO UTILITY DISK SZA CLA / ARE WE ABOUT TO LOAD THE UTILITY DISK ? JMP GETXIT / NO, WE ARE DOING THE DICTIONARY DISK CIFMNU / YES, DISPLAY MESSAGE "LOADING SOFTWARE" JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL WRKTXT / POINTER TO MESSAGE CONTROL STRING 0200 / CLEAR SCREEN FROM TIME DISPLAY FIRST /A007 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLUTL / POINTER TO "WPS UTILITY SOFTWARE" GETXIT, CDIEDT / SWITCH BACK TO EDITOR FIELD JMP I GETDRV / RETURN TO CALLER. / / / SPLINU - Report IF Drive(/device) in use by spell (or footnoting) / for a document & accept user response. / / SPLINU, XX /A010 TAD SPLDOC / Get Spell or Footnote source drive no./A010 CIA / /A010 TAD SPLDRV / Compare to Utility drive /A010 SNA CLA / They're different, we're ok so far /A010 JMP INUDSP / Same - ERROR - Go tell user &get resp./A010 TAD SPLOPR / See if we're footnoting /A010 SZA CLA / Yes we are - continue checking /A010 JMP INUOK / No we're not - take OK exit /A010 TAD SPLFNR / Get Footnote result drive no. /A010 CIA / /A010 TAD SPLDRV / Compare to Utility drive /A010 SNA CLA / They're different - take OK exit /A010 JMP INUDSP / Same - ERROR - Go tell user &get resp./A010 INUOK, ISZ SPLINU / Begin setup of a RETURN+2 exit /A010 JMP INUXIT / Go finish housekeeping /A010 INUDSP, CIFMNU / Display IN USE message /A010 JMS I IOACAL / /A010 0 / /A010 INUERR / /A010 0 / /A010 1002 / /A010 SPLMS2 / /A010 AC7777 / Signal RETURN & GOLD MENU as only resp./A010 JMS REDSPL / & get the user response /A010 JMP INUDSP / Invalid response - redisplay msg. /A010 SKP / GOLD MENU - take "NORMAL" return /A010 / RETURN - take "RETURN+1" return /A010 INUXIT, ISZ SPLINU / /A010 JMP I SPLINU / /A010 VALTAB, 7061 / 'WP' 6466 / 'SU' 6555 / 'TL' Utility diskette name. 6664 / 'US' American 4552 / 'DI' 4465 / 'CT' Dictionary diskette name. 6654 / 'UK' British 4552 / 'DI' 4465 / 'CT' Dictionary diskette name. X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE DSKBLK= .-200%400+DLOSPM / DISK BLOCK WHERE PAGE IS LOADED / SPLGET IS CALLED FROM THE GETDRV ROUTINE TO PROMPT THE USER FOR A DISK / DRIVE NUMBER WHICH SHOULD CONTAIN EITHER THE WPS UTILITY SOFTWARE OR THE / AMERICAN OR BRITISH DICTIONARY. THIS ROUTINE IS ALSO CALLED TO HANDLE A / DISK ERROR THAT MAY BE CAUSED BY THE USER NOT HAVING THE PROPER DISKETTE / LOADED IN THE SPECIFIED DRIVE OR A READ ERROR ON THE SPECIFIED DRIVE. / / UPON ENTRY, THE VALUE STORED IN SPLFUN DETERMINES WHAT KIND OF REQUEST IS / BEING MADE. A ZERO ENTRY INDICATES THAT THIS ROUTINE HAS BEEN CALLED / BEFORE AND THAT ALL TEXT POINTERS ARE CORRECTLY SET UP. A NON-ZERO ENTRY / WILL CAUSE THE ROUTINE TO SET ITSELF UP TO HANDLE THE PROPER REQUEST. / AFTER THE USER HAS ENTERED A DRIVE NUMBER, IF NECESSARY, THE INDICATED / DRIVE NUMBER IS CHECKED VIA A GET-DENSITY CALL TO SEE IF IT CONTAINS A / DISKETTE OR FOR A WINCHESTER SYSTEM, THAT THE VOLUME IS MOUNTED. / UPON EXIT, CONTROL IS PASSED TO THE FIRST LOCATION FOLLOWING THE CALL IF / THE USER TYPED GOLD MENU TO ABORT THE OPERATION AND RETURN TO MAIN MENU. / CONTROL IS PASSED TO THE SECOND LOCATION FILLOWING THE CALL WHEN THE USER / ENTERS A VALID DRIVE NUMBER CONTAINING A MOUNTED DISKETTE OR VOLUME. SPLGET, XX / ENTRY POINT TO GET A DRIVE NUMBER FROM USER TAD SPLFUN / PICK UP THE SPELL FUNCTION CODE SNA / IS THIS A VALIDATION ERROR OPERATION ? JMP SPLVER / YES, GO HANDLE THE VALIDATION ERROR CLL RAL / MULTIPLY BY TWO TAD SPLFUN / MULTIPLY BY THREE TAD (VALTAB-1-3) / CONSTRUCT VALIDATION POINTER DCA VALADD / STORE TABLE POINTER ADDRESS TAD SPLFUN / GET THE FUNCTION CODE BACK TAD (-1) / DECREMENT THE FUNCTION CODE SNA / IS THIS A UTILITY DISK REQUEST ? JMP SPLGT1 / YES, GO SET UP FOR THE UTILITY DISK TAD (-1) / DECREMENT THE FUNCTION CODE SZA CLA / IS THIS AN AMERICAN DICTIONARY REQUEST ? TAD (SPLUKD-SPLUSD) / NO, SET UP FOR THE BRITISH DICTIONARY TAD (SPLUSD-SPLUTL) / YES, SET UP FOR THE AMERICAN DICTIONARY SPLGT1, TAD (SPLUTL) / ELSE SET UP FOR WPS UTILITY DISK DCA SPLMS1 / STORE POINTER TO UTL. OR DIC. TEXT STRING CDFMNU / CHANGE DATA FIELD TO THE MENU FIELD TAD MNMXDR+MUBUF / PICK UP THE MAXIMUM DRIVE NUMBER ALLOWED DCA SPLMAX / SAVE FOR LATER USE /D010 TAD MNFNO+MUBUF / PICK UP THE CURRENT DOCUMENT DRIVE NUMBER TAD MNUTFN+MUBUF / PICK UP SPELL/FOOT.SRC. DRIVE/DOC NO. /A010 BSW;RTR;AND (17) / & ISOLATE DRIVE NO. /A010 DCA SPLDOC / SAVE FOR LATER USE TAD MNFNO+MUBUF / PICK UP FOOTNOTE RESULT DRIVE/DOC NO. /A010 BSW;RTR;AND (17) / & ISOLATE DRIVE NO. /A010 DCA SPLFNR / SAVE FOR LATER USE /A010 TAD MNTMP6+MUBUF / PICK UP OPERATION CODE /A010 TAD (-12) / ADD IN NEGATIVE VALUE OF FOOTNOTE OPER./A010 DCA SPLOPR / & SAVE RESULT AS SPeLl OPeRation flag /A010 TAD MNOPTN+MUBUF / PICK UP THE SYSTEM OPTION CONFIGURATION BITS DCA SPLOPT / SAVE FOR LATER USE TAD MNSDRV+MUBUF / PICK UP THE USER DRIVE SELLECTION FOR SPELL DCA SPLSDR / SAVE FOR LATER USE CDFMYF / RETURN DATA FIELD TO OUR FIELD TAD SPLOPT / GET OPTION CONFIGURATION BITS AND (MNRX2X) / MASK OFF THE WINCHESTER ON LINE BIT SZA CLA / CHECK TO SEE IF THE WINCHESTER IS ON LINE TAD (DEVTXT-DRVTXT) / YES, SET UP TO DISPLAY "DRIVE/DEVICE" TAD (DRVTXT) / NO, SET UP TO DISPLAY "DRIVE" DCA SPLMS2 / STORE FOR MESSAGE DISPLAYS AC7776 / SET THE AC EQUAL TO A MINUS 2 TAD SPLMAX / COMBINE WITH THE MAXIMUM DRIVE NUMBER SMA CLA / IS THIS A MULTI DRIVE SYSTEM ? JMP SPLGDR / YES, GO REQUEST THE DRIVE NUMBER / NO, THIS IS A TWO DRIVE SYSTEM TAD SPLDOC / PICK UP THE DOCUMENT DRIVE NUMBER SNA CLA / IS DOCUMENT ON DRIVE NUMBER ONE ? AC0001 / NO, DOCUMENT IS ON DRIVE ZERO DCA SPLDRV / SELECT OTHER DRIVE FROM DOCUMENT JMP SPLVE1 / GO HANDLE AS A VALIDATION ERROR SPLGDR, CLA CLL CMA / SET AC TO MINUS ONE AND CLEAR THE LINK TAD SPLFUN / COMBINE WITH FUNCTION CODE - SETS LINK SNA CLA / IS THIS A UTILITY DISK REQUEST ? CLL / YES, CLEAR THE LINK FOR INDICATOR TAD SPLSDR / PICK UP THE USER DRIVE SELECTION FOR SPELL SNL / IS THE FLAG SET FOR THE DICTIONARY DISK JMP SPLGD1 / NO, GO HANDLE UTILITY DRIVE NUMBER BSW / YES, SWAP HIGH ORDER FOR LOW ORDER RTR / SHIFT DOWN TWO MORE PLACES SPLGD1, AND (17) / MASK OFF THE DIRVE BITS DCA SPLDRV / SAVE INDICATED DRIVE NUMBER TAD SPLDRV / GET DRIVE NUMBER BACK AGAIN SZA CLA / WAS A DRIVE NUMBER SPECIFIED BY USER JMP SPLDEN / YES, GO CHECK ITS DENSITY SPLGD2, CIFMNU / NO, PRINT "TYPE THE DRIVE/DEVICE NUMBER ..." JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL NUMTX1 / POINTER TO MESSAGE CONTROL STRING 0 / ADDRESS FOR CLEAR SCREEN COMMAND 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLMS2 / POINTER TO "DRIVE" OR "DRIVE/DEVICE" 1220 / SCREEN POSITION FOR SECOND TEXT LINE SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" SPLAND / POINTER TO "AND PRESS RETURN" JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLGD2 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT / USER TYPED "RETURN" - DO A DENSITY CHECK SPLDEN, TAD SPLMAX / PICK UP THE MAXIMUM ALLOWABLE DRIVE NUMBER CMA / MAKE IT NEGATIVE TAD SPLDRV / COMBINE WITH USER SELECTED DRIVE NUMBER SMA CLA / IS USER SELECTED DRIVE NUMBER WITHIN RANGE JMP SPLGD2 / NO, GO REQUEST A VALID DRIVE NUMBER /d010 TAD SPLDOC / PICK UP CURRENT DOCUMENT DRIVE NUMBER /d010 CIA / MAKE IT NEGATIVE /d010 TAD SPLDRV / COMBINE WITH USER SELECTED DRIVE NUMBER /d010 SNA CLA / DID USER SELECT THE DOCUMENT DRIVE ? /d010 JMP SPLGD2 / YES, GO REQUEST A VALID DRIVE NUMBER JMS SPLINU / CHECK TO SEE IF DRIVE ALREADY IN USE /A010 JMP SPLGMR / YES & USER GAVE GOLD-MENU /A010 JMP SPLGD2 / " " " " RETURN - TRY AGAIN /A010 TAD SPLDRV / PICK UP THE DRIVE NUMBER CDIMNU / GET DENSITY OF SC/DD DISKETTE. DCA I (CMDBLK+RXQDRV) / SET TO USER SPECIFIED DRIVE NUMBER. CDFMYF / BACK TO OUR FIELD & CALL RDFIO IN MENU FIELD. JMS I (RDFIO) / DO A GET DENSITY TO ESTABLISH DRIVE DENSITY. RXEDN+4000 / "GET DENSITY" CODE. SPA CLA / SKIP IF NO ERROR. JMP DENERR / GET DENSITY ERROR DETECTED, REPORT TO USER ISZ SPLGET / BUMP THE RETURN ADDRESS POINTER SPLGMR, JMP I SPLGET / RETURN TO CALLER X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE DSKBLK= .-200%400+DLOSPM / DISK BLOCK WHERE PAGE IS LOADED / TEXT SUBROUTINES TO PLACE COMMON TEXT STRINGS ON THE SCREEN SPLTX1, XX / PRINT "REMOVE THE DISKETTE FROM DRIVE ..." CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL REMTXT / POINTER TO MESSAGE CONTROL STRING 0 / ADDRESS FOR CLEAR SCREEN COMMAND 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLDRV / POINTER TO DRIVE NUMBER 1220 / SCREEN POSITION FOR SECOND TEXT LINE SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" SPLAND / POINTER TO "AND PRESS RETURN" JMP I SPLTX1 / RETURN TO CALLER SPLTX2, XX / PRINT "INSERT THE DISKETTE INTO DRIVE ..." CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL INSTXT / POINTER TO MESSAGE CONTROL STRING 0 / ADDRESS FOR CLEAR SCREEN COMMAND 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" 1220 / SCREEN POSITION FOR SECOND TEXT LINE SPLDRV / POINTER TO DRIVE NUMBER SPLAND / POINTER TO "AND PRESS RETURN" JMP I SPLTX2 / RETURN TO CALLER SPLTX3, XX / PRINT "TYPE THE DRIVE/DEVICE NUMBER ..." CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL NUMTX1 / POINTER TO MESSAGE CONTROL STRING 1600 / ADDRESS FOR CLEAR SCREEN COMMAND 1620 / SCREEN POSITION FOR FIRST TEXT LINE SPLMS2 / POINTER TO "DRIVE" OR "DRIVE/DEVICE" 2020 / SCREEN POSITION FOR SECOND TEXT LINE SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" SPLAND / POINTER TO "AND PRESS RETURN" JMP I SPLTX3 / RETURN TO CALLER SPLTX4, XX / PRINT "OR TYPE THE DRIVE/DEVICE NUMBER ..." CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL NUMTX2 / POINTER TO MESSAGE CONTROL STRING 1620 / SCREEN POSITION FOR FIRST TEXT LINE SPLMS2 / POINTER TO "DRIVE" OR "DRIVE/DEVICE" 2020 / SCREEN POSITION FOR SECOND TEXT LINE SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" SPLAND / POINTER TO "AND PRESS RETURN" JMP I SPLTX4 / RETURN TO CALLER / COME HERE TO HANDLE VALIDATION ERRORS SPLVER, AC7776 / SET THE AC EQUAL TO A MINUS 2 TAD SPLMAX / COMBINE WITH THE MAXIMUM DRIVE NUMBER SMA CLA / IS THIS A MULTI DRIVE SYSTEM ? JMP SPLTYP / YES, GO CHECK DRIVE TYPE SPLVE1, JMS SPLTX1 / PRINT "REMOVE THE DISKETTE FROM DRIVE ..." AC7777 / SET UP FOR NO DRIVE NUMBER ALLOWED JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLVE1 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT SPLTYP, JMS SPLSEL / CHECK IF DRIVE IS WINCHESTER OR FLOPPY JMP SPLVE3 / WINCHESTER, DISPLAY "VOLUME DOES NOT ..." SPLVE2, JMS SPLTX1 / PRINT "REMOVE THE DISKETTE FROM DRIVE ..." JMS SPLTX4 / PRINT "OR TYPE THE DRIVE/DEVICE NUMBER ..." AC0001 / SET UP FOR OPTIONAL DRIVE NUMBER JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLVE2 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT SPLVE3, CIFMNU / YES, HANDLE VOLUME DOES NOT CONTAIN... JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL SPLVNC / POINTER TO MESSAGE CONTROL STRING 0 / ADDRESS FOR CLEAR SCREEN COMMAND 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLDRV / POINTER TO DRIVE NUMBER SPLMS1 / POINTER TO "UTILITY" OR "DICTIONARY" JMS SPLTX3 / PRINT "TYPE THE DRIVE/DEVICE NUMBER ..." JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLVE3 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT / COME HERE TO HANDLE DENSITY ERRORS DENERR, AC7776 / SET THE AC EQUAL TO A MINUS 2 TAD SPLMAX / COMBINE WITH THE MAXIMUM DRIVE NUMBER SMA CLA / IS THIS A MULTI DRIVE SYSTEM ? JMP DENTYP / YES, GO CHECK DRIVE TYPE SPLDE1, JMS SPLTX2 / PRINT "INSERT THE DISKETTE INTO DRIVE ..." AC7777 / SET UP FOR NO DRIVE NUMBER ALLOWED JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLDE1 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT DENTYP, JMS SPLSEL / CHECK IF DRIVE IS WINCHESTER OR FLOPPY JMP SPLDE3 / WINCHESTER, DISPLAY "VOLUME NOT ASSIGNED" SPLDE2, JMS SPLTX2 / PRINT "INSERT THE DISKETTE INTO DRIVE ..." JMS SPLTX4 / PRINT "OR TYPE THE DRIVE/DEVICE NUMBER ..." AC0001 / SET UP FOR OPTIONAL DRIVE NUMBER JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLDE2 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT SPLDE3, CIFMNU / YES, HANDLE VOLUME NOT ASSIGNED JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL SPLNAS / POINTER TO MESSAGE CONTROL STRING 0 / ADDRESS FOR CLEAR SCREEN COMMAND 1020 / SCREEN POSITION FOR FIRST TEXT LINE SPLDRV / POINTER TO DRIVE NUMBER JMS SPLTX3 / PRINT "TYPE THE DRIVE/DEVICE NUMBER ..." JMS REDSPL / GO HANDLE USER INPUT REQUEST JMP SPLDE3 / USER ERROR - GO HANDLE IT JMP SPLGMR / USER TYPED "GOLD MENU", GO HANDLE IT JMP SPLDEN / USER TYPED "RETURN", GO HANDLE IT X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE DSKBLK= .-200%400+DLOSPM / DISK BLOCK WHERE PAGE IS LOADED / REDSPL IS THE ROUTINE THAT HANDLES THE USER RESPONSE. IT DISPLAYS / THE COMMON TEXT MESSAGE AND SELECTIVLY ACCEPTS ONLY THE KEYS FOR / "RETURN" AND "GOLD-MENU" OR IT ALSO ACCEPTS A DIRVE NUMBER OF ONE DIGIT / AND ALLOWS THE USER TO RUB-OUT A MISTAKE. / / UPON ENTRY: / / A NEGATIVE VALUE IN THE AC MEANS THAT NO DRIVE NUMBER IS ALLOWED AND THAT / ONLY THE "RETURN" KEY AND THE "GOLD-MENU" KEYS ARE VALID. / / A POSITIVE VALUE IN THE AC MEANS THAT THE DRIVE NUMBER IS OPTIONAL AND / THAT THE "RETURN" KEY AND THE "GOLD-MENU" KEYS ARE VALID. / / A ZERO VALUE IN THE AC MEANS THAT THE DRIVE NUMBER IS REQUIRED AND THAT / A NUL-RESPONSE WILL GENERATE AN ERROR. THE DRIVE NUMBER CAN ONLY BE ONE / DECIMAL CHARACTER AND IS TERMINATED BY PRESSING THE "RETURN" KEY. / THE RUBOUT KEY CAN BE USED TO CORRECT AN ERROR IN THE FIRST DIGIT. / TWO DIGITS OR ANY NON DIGIT KEY TERMINATES WITH AN ERROR. / / UPON EXIT: / / CONTROL IS TRANSFERED TO THE FIRST LOCATION FOLLOWING THE CALL WHEN A USER / INPUT ERROR IS DETECTED AND CAUSES THE TERMINAL BELL TO RING. AC IS CLEAR. / / CONTROL IS TRANSFERED TO THE SECOND LOCATION FOLLOWING THE CALL IF THE USER / PRESSES THE "GOLD-MENU" KEYS. AC IS CLEAR. / / CONTROL IS TRANSFERED TO THE THIRD LOCATION FOLLOWING THE CALL WHEN THE USER / SUCCESSFULLY PRESSES THE RETURN KEY OR ENTERS A ONE DIGIT DRIVE NUMBER AND / THEN PRESSES THE RETURN KEY. THE LOCATION SPLDRV IS UPDATED WITH THE / VALUE FROM REDDRV IF THE USER ACTUALLY TYPED A DRIVE NUMBER. AC IS CLEAR. REDSPL, XX / HANDLE THE USER RESPONSE DCA REDFLG / SAVE DRIVE NUMBER REQUEST VALUE CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL REDTXT / POINTER TO MESSAGE CONTROL STRING 2520 / ADDRESS FOR LINE OF COMMON TEXT GMTXT / "OR PRESS GOLD MENU ..." 2700 / POSSITION CURSOR TO BOTTOM SCREEN LINE DCA REDDRV / CLEAR THE SAVED DRIVE NUMBER REDNXT, DCA REDNUM / STORE NEW CHARACTER COUNT CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I (INAIN) / GO GET A CHARACTER AND DISPLAY TIME DCA REDCHR / SAVE CHARACTER THAT USER TYPED TAD REDFLG / GET THE DRIVE NUMBER REQUESTED FLAG SPA CLA / CAN USER ENTER A DRIVE NUMBER ? JMP RETTST / NO, ONLY RETURN AND GOLD MENU ALLOWED AC7777 / SET THE AC EQUAL TO A MINUS ONE TAD REDNUM / COMBINE WITH THE CHARACTER COUNT SNA CLA / HAS THE USER ENTERED ONE CHARACTER ? JMP RUBTST / YES, THEN NO MORE DIGITS ARE ALLOWED TAD REDCHR / GET CHARACTER THAT USER ENTERED SPA / IS IT A SPECIAL CHARACTER ? JMP RUBTST / YES, GO CHECK FOR A VALID ONE TAD (-60) / NO, CHECK FOR AN ASCII "0" CHARACTER SPA CLA / IS CHARACTER AT LEAST A "0" ? JMP REDERR / NO, IT'S LESS THAN "0", GO REPORT ERROR TAD REDCHR / GET CHARACTER THAT USER ENTERED TAD (-72) / CHECK FOR AN ASCII "9" CHARACTER SMA CLA / IS CHARACTER GREATER THAN A "9" JMP REDERR / YES, GO REPORT THE ERROR TAD REDCHR / PICK UP CHARACTER USER TYPED AND (17) / MASK OFF DRIVE BITS DCA REDDRV / SAVE DRIVE NUMBER TAD REDCHR / PICK UP CHARACTER THAT USER TYPED JMS REDOUT / ECHO CHARACTER ON SCREEN AC0001 / SET UP FOR AN INCREMENT JMP REDSET / GO UPDATE THE CHARACTER COUNT RUBTST, TAD REDCHR / PICK UP CHARACTER THAT USER TYPED TAD (-EDRBCH) / CHECK FOR THE "RUB-OUT" KEY SZA CLA / IS IT A MATCH ? JMP RETTST / NO, GO CHECK FOR THE OTHER CHARACTERS TAD REDNUM / YES, PICK UP THE CHARACTER COUNT SNA CLA / IS THERE ANYTHING TO RUB-OUT JMP REDNXT / NO, JUST IGNORE THE KEY TAD (10) / PICK UP THE BACK SPACE CHARACTER CODE JMS REDOUT / OUTPUT IT TO THE SCREEN TAD (40) / PICK UP THE SPACE CHARACTER CODE JMS REDOUT / OUTPUT IT TO THE SCREEN TAD (10) / PICK UP THE BACK SPACE CHARACTER CODE JMS REDOUT / OUTPUT IT TO THE SCREEN DCA REDDRV / CLEAR DRIVE NUMBER AC7777 / SET UP FOR A DECREMENT REDSET, TAD REDNUM / COMBINE WITH CHARACTER COUNT JMP REDNXT / GO STORE NEW CHARACTER COUNT RETTST, TAD REDCHR / PICK UP CHARACTER THAT USER TYPED TAD (-EDMENU) / COMBINE WITH GOLD MENU CODE SNA CLA / DID USER TYPE "GOLD-MENU" ? JMP GMXIT / YES, GO TAKE GOLD MENU EXIT TAD REDCHR / PICK UP CHARACTER THAT USER TYPED TAD (-EDNWLN) / COMBINE WITH RETURN KEY CODE SZA CLA / DID USER TYPE "RETURN" ? JMP REDERR / NO, GO REPORT ERROR TAD REDFLG / GET DRIVE NUMBER REQUEST FLAG SZA CLA / MUST THE USER ENTER A DRIVE NUMBER ? JMP RETXIT / NO, TAKE NORMAL RETURN WITH CLEAR AC TAD REDNUM / PICK UP THE CHARACTER COUNT SNA CLA / DID THE USER TYPE ANYTHING ? JMP REDERR / NO, GO REPORT THE ERROR RETXIT, TAD REDNUM / PICK UP THE CHARACTER COUNT SNA CLA / DID THE USER ENTER A DRIVE NUMBER JMP REDXIT / NO, THEN DO NOT UPDATE THE DRIVE NUMBER TAD REDDRV / PICK UP THE USER SPECIFIED DRIVE NUMBER DCA SPLDRV / SET UP THE NEW DRIVE NUMBER REDXIT, ISZ REDSPL / BUMP RETURN ADDRESS TO NORMAL RETURN GMXIT, ISZ REDSPL / BUMP RETURN ADDRESS TO GOLD MENU RETURN JMP I REDSPL / RETURN TO CALLER REDERR, CIFMNU / CHANGE INDTRUCTION FIELD TO MENU FIELD JMS I IOACAL / CALL STANDARD MESSAGE OUTPUT ROUTINE 0 / USE DEFAULT OUTPUT CHANNEL ERRTXT / POINTER TO CONTROL STRING TO RING BELL JMP I REDSPL / TAKE ERROR RETURN TO CALLER REDOUT, XX / ROUTINE TO OUTPUT A CHARACTER JMP REDOT2 / SKIP OVER JWAIT INSTRUCTION REDOT1, CIFSYS / CHANGE INSTRUCTION FIELD TO SYSTEM FIELD JWAIT / WAIT FOR NEXT SIGNIFICENT EVENT REDOT2, CIFSYS / CHANGE INSTRUCTION FIELD TO SYSTEM FIELD TTYOU / TRY TO OUTPUT THE CHARACTER TO THE SCREEN JMP REDOT1 / BUSY, GO TO SYSTEM WAIT ROUTINE JMP I REDOUT / DONE, RETURN TO CALLER / SPLSEL IS A ROUTINE THAT WILL DETERMINE IF THE SPECIFIED DRIVE NUMBER / BELONGS TO A WINCHESTER DEVICE OR A FLOPPY DISK DRIVE. / RETURN IS TO CALL+1 FOR WINCHESTER AND CALL+2 FOR FLOPPY. SPLSEL, XX / CHECK DRIVE SELECTION FOR DEVICE TYPE TAD SPLOPT / GET OPTION CONFIGURATION BITS AND (MNRX2X) / MASK OFF WINCHESTER ON LINE BIT SNA CLA / CHECK FOR WINCHESTER ON LINE JMP SPLFLP / NO, DRIVE MUST BELONG TO A FLOPPY TAD SPLDRV / PICK UP THE DRIVE NUMBER TAD (-10) / SUBTRACT FOR DRIVES 0 TO 7 SMA CLA / CHECK FOR DRIVES 8 AND 9 JMP SPLFLP / YES, THEN DRIVES ARE FLOPPY TAD SPLOPT / GET OPTION CONFIGURATION BITS AND (MNRX4X) / MASK OFF DRIVE 0 ASSIGNED TO WINNI BIT SZA CLA / CHECK FOR SYSTEM RUNNING ON WINCHESTER JMP SPLWIN / YES, DRIVE MUST BELONG TO WINCHESTER TAD SPLDRV / PICK UP THE DRIVE NUMBER SNA / CHECK FOR DRIVE ZERO JMP SPLFLP / YES, THEN IT'S A FLOPPY TAD (-1) / DECREMENT THE DRIVE COUNT SZA CLA / CHECK FOR DRIVE ONE JMP SPLWIN / NO, DRIVE MUST BELONG TO WINCHESTER TAD SPLOPT / GET OPTION CONFIGURATION BITS AND (MNRX3X) / MASK OFF DRIVE ONE ASSIGNED TO WINNI BIT SNA CLA / CHECK FOR DRIVE ONE ASSIGNED TO WINCHESTER SPLFLP, ISZ SPLSEL / NO, DRIVE BELONGS TO FLOPPY DRIVE SPLWIN, JMP I SPLSEL / YES, DRIVE BELONGS TO WINCHESTER X=. / FIRST FREE LOCATION ON PAGE /--------------------- PAGE / TEXT MESSAGES DISPLAYED WHEN REQUESTING THE WPS UTILITY SOFTWARE / /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE1 | WPS UTILITY SOFTWARE DISKETTE AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | INSERT THE WPS UTILITY SOFTWARE DISKETTE / GET DENSITY ERROR DE1 | INTO DRIVE 1 AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | TYPE THE DRIVE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE2 | WPS UTILITY SOFTWARE DISKETTE AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | INSERT THE WPS UTILITY SOFTWARE DISKETTE / GET DENSITY ERROR DE2 | INTO DRIVE 1 AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 DOES NOT CONTAIN THE WPS UTILITY SOFTWARE / VALIDATION ERROR VE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 IS NOT ASSIGNED. / GET DENSITY ERROR DE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | WPS UTILITY SOFTWARE AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / TEXT MESSAGES DISPLAYED WHEN REQUESTING THE AMERICAN DICTIONARY / /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE1 | AMERICAN DICTIONARY DISKETTE AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | INSERT THE AMERICAN DICTIONARY DISKETTE / GET DENSITY ERROR DE1 | INTO DRIVE 1 AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | TYPE THE DRIVE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE2 | AMERICAN DICTIONARY DISKETTE AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | INSERT THE AMERICAN DICTIONARY DISKETTE / GET DENSITY ERROR DE2 | INTO DRIVE 1 AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 DOES NOT CONTAIN THE AMERICAN DICTIONARY / VALIDATION ERROR VE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 IS NOT ASSIGNED. / GET DENSITY ERROR DE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | AMERICAN DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / TEXT MESSAGES DISPLAYED WHEN REQUESTING THE BRITISH DICTIONARY / /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE1 | BRITISH DICTIONARY DISKETTE AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / TWO DRIVE SYSTEM | INSERT THE BRITISH DICTIONARY DISKETTE / GET DENSITY ERROR DE1 | INTO DRIVE 1 AND PRESS RETURN / DRIVE NUMBER ERROR | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | TYPE THE DRIVE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | REMOVE THE DISKETTE FROM DRIVE 0 AND INSERT THE / VALIDATION ERROR VE2 | BRITISH DICTIONARY DISKETTE AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / MULTI DRIVE SYSTEM | INSERT THE BRITISH DICTIONARY DISKETTE / GET DENSITY ERROR DE2 | INTO DRIVE 1 AND PRESS RETURN / | / | OR TYPE THE DRIVE NUMBER THAT CONTAINS THE / | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER OPTIONAL | / RETURN OR GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / NO DEFAULT SET GDR | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 DOES NOT CONTAIN THE BRITISH DICTIONARY / VALIDATION ERROR VE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- / WINCHESTER SYSTEM | VOLUME 5 IS NOT ASSIGNED. / GET DENSITY ERROR DE3 | / | TYPE THE DRIVE/DEVICE NUMBER THAT CONTAINS THE / | BRITISH DICTIONARY AND PRESS RETURN / DRIVE NUMBER REQURIED | / GOLD MENU | OR PRESS GOLD MENU TO RECALL THE MAIN MENU. /----------------------------------------------------------------------------- /*************************************************************************** /**** N O T E **** /**** IF YOU CHANGE ANY OF THE TEXT STRINGS BELOW, MAKE SURE YOU **** /**** CHANGE THE MESSAGE LISTINGS ON THE THREE PREVIOUS PAGES **** /*************************************************************************** DSKBLK= .-200%400+DLOSPM / DISK BLOCK WHERE PAGE IS LOADED SPLUTL, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH SPLUSD, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH < TEXT '&DICCIONARIO &AMERICANO'> SPLUKD, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH DRVTXT, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH DEVTXT, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH REMTXT, IFDEF ENGLSH < TEXT '^P!E^P&REMOVE THE DISKETTE FROM DRIVE !D AND INSERT THE ' *.-1 TEXT '^P!S DISKETTE^S' > IFDEF ITALIAN < TEXT /^P!E^P&TOGLIERE IL DICHETTO DALL'UNIT\@ !D ED INSERIRE IL / *.-1 TEXT /^PDISCHETTO DEI !S/ > IFDEF DUTCH < TEXT '^P!E^P&VERVANG DE DISKETTE UIT AANDRIJVER !D DOOR DE ' *.-1 TEXT '^P!S DISKETTE^S'> IFDEF SPANISH < TEXT '^P!E^P&RETIRE EL DISKETTE DE LA UNIDAD !D E INSERTE LOS ' *.-1 TEXT '^P!S DISKETTE^S'> SPLAND, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH < TEXT ' EN DRUK OP !&RETURN'> IFDEF SPANISH < TEXT ' Y PULSE RETORNO'> INSTXT, IFDEF ENGLSH IFDEF ITALIAN< TEXT /^P!E^P&INSERIRE IL DISCHETTO DEI !S NELL'UNIT\@ !D^S/ > IFDEF DUTCH IFDEF SPANISH NUMTX1, IFDEF ENGLSH IFDEF ITALIAN< TEXT /^P!E^P&INTORDURRE IL NUMERO DELL'!SCHE CONTIENE I^P!S^S/> IFDEF DUTCH IFDEF SPANISH NUMTX2, IFDEF ENGLSH IFDEF ITALIAN< TEXT /^P&O INTRODURRE IL NUMERO DELL'!SCHE CONTIENE I^P!S^S/> IFDEF DUTCH IFDEF SPANISH SPLVNC, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH SPLNAS, IFDEF ENGLSH IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH WRKTXT, IFDEF ENGLSH /M007 IFDEF ITALIAN IFDEF DUTCH IFDEF SPANISH < TEXT '^P!E^P&CARGANDO ^S - &ESPERE'> REDTXT, TEXT '^P^S^P' GMTXT, IFDEF ENGLSH < TEXT '!&OR &PRESS &GOLD !&MENU TO RECALL THE &MAIN &MENU.'> IFDEF ITALIAN < TEXT /&O PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE./> IFDEF DUTCH < TEXT '!&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU'> IFDEF SPANISH < TEXT '!&O &PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'> ERRTXT, TEXT '^CG' / CONTROL STRING TO RING THE TERMINAL BELL INUERR, IFDEF ENGLSH < TEXT '^P!E^P&THAT!SIS ALREADY IN USE. &PRESS !&RETURN TO ' /A010 *.-1 /A010 TEXT 'ENTER ANOTHER NUMBER.' /A010 > IFDEF ITALIAN < TEXT /^P!E^P&!SGI\@ UTILIZZATA. &PREMERE !&RITORNO, USARE UN / *.-1 TEXT /ALTRO NUMERO./ > IFDEF DUTCH < TEXT '^P!E^P&DIE!S IS AL IN GEBRUIK. DRUK OP !&RETURN EN ' *.-1 TEXT 'PROBEER OPNIEUW.'> IFDEF SPANISH < TEXT '^P!E^P&ESTE!S YA EST\A EN USO. &PULSE !&RETORNO PARA' *.-1 TEXT ' TECLEE OTRO N\ZMERO.'> /*************************************************************************** /**** N O T E **** /**** IF YOU CHANGE ANY OF THE TEXT STRINGS ABOVE, MAKE SURE YOU **** /**** CHANGE THE MESSAGE LISTINGS ON THE THREE PREVIOUS PAGES **** /*************************************************************************** RELOC